./PaxHeaders/LoopTools-2.160000644000000000000000000000013214217172001012525 xustar0030 mtime=1648161793.715764879 30 atime=1648161793.715764879 30 ctime=1648161793.715764879 LoopTools-2.16/0000755000000000000000000000000014217172001013365 5ustar00rootroot00000000000000LoopTools-2.16/PaxHeaders/manual0000644000000000000000000000013214217172001013645 xustar0030 mtime=1648161793.715764879 30 atime=1648161793.715764879 30 ctime=1648161793.715764879 LoopTools-2.16/manual/0000755000000000000000000000000014217172001014642 5ustar00rootroot00000000000000LoopTools-2.16/manual/PaxHeaders/LT216Guide.tex0000644000000000000000000000007413266106237016212 xustar0030 atime=1648161785.691698199 30 ctime=1648161793.715764879 LoopTools-2.16/manual/LT216Guide.tex0000644000000000000000000030065413266106237017135 0ustar00rootroot00000000000000\documentclass[twoside,12pt]{report} \usepackage{a4wide,array,epsfig,amsmath,amssymb,axodraw,makeidx,calc,alltt,mathpple} \makeindex \def\indextt#1{\index{#1@{\tt#1}}} \renewcommand\bibname{References} \renewcommand{\baselinestretch}{1.2} \renewcommand{\arraystretch}{1.2} \renewcommand{\tabcolsep}{8pt} \renewcommand{\arraycolsep}{8pt} \renewcommand{\theenumi}{\alph{enumi}} \renewcommand{\labelenumi}{\theenumi)\,} \advance\footnotesep 4pt \def\thefootnote{\fnsymbol{footnote}} \parskip=4pt \parindent=0pt \pagestyle{headings} \raggedbottom \sloppy \makeatletter % from report.cls: \def\@makechapterhead#1{% % \vspace*{50\p@}% {\parindent \z@ \raggedright \normalfont \ifnum \c@secnumdepth >\m@ne \Huge\bfseries \thechapter~~~ % \par\nobreak % \vskip 20\p@ \fi \interlinepenalty\@M \Huge \bfseries #1\par\nobreak \vskip 20\p@ }} \def\@makeschapterhead#1{% % \vspace*{50\p@}% {\parindent \z@ \raggedright \normalfont \interlinepenalty\@M \Huge \bfseries #1\par\nobreak \vskip 20\p@ }} \def\bbox{\vskip .5\baselineskip\par \newbox\grey\setbox\grey=\vbox\bgroup\ignorespaces} \def\ebox{\egroup% \hbox{% \special{ps: gsave initmatrix currentpoint translate 1 65781 div dup scale % 1bp = 65781sp newpath 0 -\number\dp\grey\space moveto \number\wd\grey\space dup dup 0 rlineto \number\ht\grey\space lineto neg 0 rlineto closepath gsave .9 setgray fill grestore 0 setlinewidth stroke grestore}% \box\grey}% \vskip .5\baselineskip\par} \def\greyed#1{\special{ps: .7 setgray}#1\special{ps: 0 setgray}} \def\oldcr#1{\let\temp=\\#1\let\\=\temp} \def\biitab{\bbox% \begin{tabular}{>{\oldcr\raggedleft\hspace{0pt}}p{.35\linewidth}% >{\oldcr\raggedright\hspace{0pt}}p{.57\linewidth}}} \def\biiitab#1{\bbox% \hspace*{5pt} \begin{tabular}{>{\oldcr\raggedright\hspace{0pt}}p{.235\linewidth}% >{\oldcr\raggedright\hspace{0pt}}p{.185\linewidth}% >{\oldcr\raggedright\hspace{0pt}}p{.44\linewidth}} {\it #1} & {\it default value} \\ \hline} \def\etab{\end{tabular}\ebox} \let\dots\textellipsis \def\FA{\textit{FeynArts}} \def\FC{\textit{FormCalc}} \def\FO{\textit{FORM}} \def\FF{\textit{FF}} \def\LT{\textit{LoopTools}} \def\mma{{\it Mathematica}} \def\limfunc#1{\mathop{\rm #1}} \def\Re{\limfunc{Re}} \def\Retilde{\limfunc{\widetilde{Re}}} \def\unity{{\rm 1\mskip-4.25mu l}} \def\ie{i.e.\ } \def\eg{e.g.\ } \def\lbrac{\symbol{123}} \def\rbrac{\symbol{125}} \def\uscore{\symbol{95}} \def\home{\symbol{126}} \def\power{\symbol{94}} \def\i{{\rm i}} \def\d{{\rm d}} \def\M{{\cal M}} \def\O{{\cal O}} \def\mmin{\ensuremath{m_{\mathrm{min}}^2}} \def\zeroeps{\ensuremath{\varepsilon_{\mathrm{zero}}}} \def\diffeps{\ensuremath{\varepsilon_{\mathrm{diff}}}} \def\Code#1{\ensuremath{\texttt{#1}}} %\def\Code#1{\ensuremath{\texttt{\Red{#1}}}} \def\Name#1{\ensuremath{\textit{\rmfamily #1}}} %\def\Name#1{\ensuremath{\textit{\rmfamily\Green{#1}}}} \def\Var#1{\ensuremath{\mathit{#1}}} %\def\Var#1{\ensuremath{\mathit{\Blue{#1}}}} \def\Va{\Var{a}} \def\Vb{\Var{b}} \def\Vc{\Var{c}} \def\Vcp{\Var{c'}} \def\Vd{\Var{d}} \def\Ve{\Var{e}} \def\Vf{\Var{f}} \def\Vg{\Var{g}} \def\Vgp{\Var{g'}} \def\Vh{\Var{h}} \def\Vi{\Var{i}} \def\Vl{\Var{l}} \def\Vm{\Var{m}} \def\Vn{\Var{n}} \def\Vnp{\Var{n'}} \def\Vo{\Var{o}} \def\Vp{\Var{p}} \def\Vr{\Var{r}} \def\Vs{\Var{s}} \def\Vsp{\Var{s'}} \def\Vt{\Var{t}} \def\Vv{\Var{v}} \def\Vmu{\Var{\mu}} \def\Vnu{\Var{\nu}} \hyphenation{Feyn-Arts} \begin{document} \thispagestyle{empty} \vspace*{.7\textheight} \hfill\hbox{\underline{% \vrule width 0pt height 0pt depth 2ex% \Huge \LT~2.15~~~User's Guide}} \vspace*{1ex} \hfill\hbox{April 19, 2018~~~~~Thomas Hahn} \clearpage \vspace*{.5\textheight} \vfill \hrule \medskip \begin{scriptsize} The dreadful legal stuff: \LT\ is free software, but is not in the public domain. Instead it is covered by the GNU library general public license. In plain English this means: 1) We don't promise that this software works. (But if you find any bugs, please let us know!) 2) You can use this software for whatever you want. You don't have to pay us. 3) You may not pretend that you wrote this software. If you use it in a program, you must acknowledge somewhere in your publication that you've used our code. If you're a lawyer, you will rejoice at the exact wording of the license at \Code{http://gnu.org/licenses/lgpl.html}. \LT\ is available from \Code{http://feynarts.de/looptools}. \FC\ is available from \Code{http://feynarts.de/formcalc}. \FA\ is available from \Code{http://feynarts.de}. \FF\ is available from \Code{http://gjvo.home.xs4all.nl/FF.html}. If you make this software available to others please provide them with this manual, too. If you find any bugs, or want to make suggestions, or just write fan mail, address it to: \vspace*{-2ex} \begin{quote} Thomas Hahn \\ Max-Planck-Institut f\"ur Physik \\ (Werner-Heisenberg-Institut) \\ F\"ohringer Ring 6 \\ D--80805 Munich, Germany \\ e-mail: \Code{hahn@feynarts.de} \end{quote} \end{scriptsize} \clearpage \tableofcontents \clearpage \chapter{\LT} \LT\ is a package for evaluation of scalar and tensor one-loop integrals based on the \FF\ package by G.J.~van~Oldenborgh \cite{vOV90}. It provides the actual numerical implementations of the functions appearing in \FC\ output. These are the scalar one-loop functions of \FF\ and the 2-, 3-, 4-, and 5-point tensor-coefficient functions in the conventions of \cite{De93}. \LT\ offers three interfaces, Fortran, C/C++, and \mma, so most programming tastes should be served.% \index{FF@\FF}% \section{Installation} \index{installation!\LT}% To compile the package, a Fortran compiler and the GNU C compiler (\Code{gcc} or \Code{clang}) are required. \LT\ comes in a compressed tar archive \Code{LoopTools-2.12.tar.gz}. Execute the following commands to unpack and compile the package. \bbox \begin{verbatim} gunzip -c LoopTools-2.12.tar.gz | tar xvf - cd LoopTools-2.12 ./configure make make install make clean \end{verbatim} \ebox The \Code{configure} script finds out the necessary system information for the compilation. \Code{make} then makes the following objects in the \Code{LoopTools/\Var{hosttype}} directory: \begin{tabbing} \rlap{\Code{lib/libooptools.a}}\hspace{.3\linewidth} \= the \LT\ library \\ \Code{include/looptools.h} \> the include file for Fortran \\ \Code{include/clooptools.h} \> the include file for C/C++ \\ \Code{bin/lt} \> the LoopTools command-line executable \\ \Code{bin/fcc} \> a script to aid C/C++ compilation \\ \Code{bin/LoopTools} \> the MathLink executable \end{tabbing} Use ``\Code{make lib}'' to build only the library part (without the MathLink executable). \pagebreak The resulting directory structure is \begin{tabbing} \rlap{\Code{LoopTools/}}\hspace{.3\linewidth} \= the \LT\ directory \\ \Code{\greyed{LoopTools/}src/} \> directory of the source files \\ \Code{\greyed{LoopTools/}build/} \> (temporary) directory for object files (after \Code{make}) \\ \Code{\greyed{LoopTools/}\Var{hosttype}/} \> directory for programs and libraries (after \Code{make install}) \end{tabbing} \index{hosttype}% The \Var{hosttype} is a string identifying the system, \eg \Code{i686-Linux} or \Code{alpha-OSF1}. Its purpose as a directory name is to separate the binaries for different platforms. To see what its value is on your system, type the following command at the shell prompt: \begin{verbatim} echo `uname -m`-`uname -s` \end{verbatim} In contrast to the original \FF\ library, the \LT\ libraries and executables depend on no additional files (error message catalogues etc.), so they may be installed in some `public' place instead of \Code{LoopTools/\Var{hosttype}}. To this end, configure with \eg \begin{verbatim} ./configure --prefix=/usr/local \end{verbatim} whereupon \Code{make install} will put the libraries, include files, and executables in \Code{/usr/local/lib}, \Code{include}, and \Code{bin}, respectively. (Note: To write on \Code{/usr/local}, superuser privileges are usually required.) \clearpage \section{One-Loop Integrals} \label{sect:loopint} \index{momenta!conventions for}% Consider the following general one-loop diagram. \begin{center} \unitlength=1bp% \begin{picture}(130,125)(0,0) \ArrowLine(5,10)(30,30) \ArrowLine(5,115)(30,95) \ArrowLine(120,115)(95,95) \ArrowLine(120,10)(95,30) \ArrowLine(95,30)(30,30) \ArrowLine(30,30)(30,95) \ArrowLine(30,95)(95,95) \Vertex(30,30){2} \Vertex(30,95){2} \Vertex(95,30){2} \Vertex(95,95){2} \multiput(95,44)(0,17){3}{\makebox(0,0){$.$}} \Text(0,115)[r]{$p_1$} \Text(125,115)[l]{$p_2$} \Text(125,7)[l]{$p_{N - 1}$} \Text(0,7)[r]{$p_N$} \Text(23,62)[r]{$q$} \Text(62,100)[b]{$q + k_1$} \Text(62,25)[t]{$q + k_{N - 1}$} \Text(36,62)[l]{$m_1$} \Text(62,90)[t]{$m_2$} \Text(62,35)[b]{$m_N$} \end{picture} \end{center} The integral contained in this diagram is \begin{align} \label{eq:1loopint}%\tag{$*$} T_{\mu_1\ldots\mu_P}^N &= \frac{\mu^{4 - D}}{\i\pi^{D/2}\,r_\Gamma} %\frac{(2\pi\mu)^{4 - D}}{\i\pi^2} \int\d^Dq\, \frac{q_{\mu_1}\cdots q_{\mu_P}} {\bigl[q^2 - m_1^2\bigr]\, \bigl[(q + k_1)^2 - m_2^2\bigr] \cdots \bigl[(q + k_{N - 1})^2 - m_N^2\bigr]} \\[1ex] \notag r_\Gamma &= \frac{\Gamma^2(1 - \varepsilon)\Gamma(1+\varepsilon)} {\Gamma(1 - 2\varepsilon)}\,, \quad D = 4 - 2\varepsilon\,, \end{align} where the momenta $k_i$ that appear in the denominators are related to the external momenta $p_i$ as \begin{equation} \label{eq:ptok} \begin{aligned} p_1 &= k_1\,, & \qquad p_2 &= k_2 - k_1\,, & \qquad \ldots && \qquad p_N &= k_N - k_{N - 1}\,, \\ k_1 &= p_1\,, & k_2 &= p_1 + p_2\,, & \ldots && k_N &= \sum_{i=1}^N p_i\,. \end{aligned} \end{equation} The representation given in \eqref{eq:1loopint} is correct for dimensional regularization or dimensional reduction. (In the latter case the integrals are kept $D$-dimensional although the rest of the algebra is performed in 4 dimensions.) $\mu$ plays the r\^ole of a renormalization scale that keeps track of the correct dimension of the integral in $D$ space--time dimensions. In constrained differential renormalization the mass scale enters in a conceptually different way; however, the dependence of the one-loop integrals on $\mu$ is the same as for dimensional regularization (for details see \cite{HaP98}).% \index{renormalization scale}% The denominators arise from the propagators running in the loop. $P$, the number of $q$'s in the numerator, determines the Lorentz tensor structure of the whole integral, \ie $P = 0$ denotes a scalar integral, $P = 1$ a vector integral, etc. From the definition it is obvious that the integrals are symmetric under permutation of the Lorentz indices. The $q$'s in the numerator arise typically from fermion propagators or from vertices that correspond to terms with derivatives in the Lagrangian.% \index{tensor structure}% The nomenclature is $A$ for $T^1$, $B$ for $T^2$, etc. The scalar integrals are denoted by a subscripted zero: $A_0$, $B_0$, etc. \subsection{Tensor Coefficients} \index{tensor coefficients}% \index{Lorentz-covariant tensors}% The integrals with a tensor structure can be reduced to linear combinations of Lorentz-covariant tensors constructed from the metric tensor $g_{\mu\nu}$ and a linearly independent set of the momenta \cite{PaV79}. The choice of this basis is not unique. \index{decomposition}% \LT\ provides not the tensor integrals themselves, but the coefficients of these Lorentz-covariant tensors. It works in a basis formed from $g_{\mu\nu}$ and the momenta $k_i$, which are the sums of the external momenta $p_i$ (see Eq.\ (\ref{eq:ptok})) \cite{De93}. In this basis the tensor-coefficient functions are totally symmetric in their indices. For the integrals up to the four-point function the decomposition reads explicitly \begin{align*} B_\mu &= k_{1\mu} B_1\,, \displaybreak[0] \\ B_{\mu\nu} &= g_{\mu\nu} B_{00} + k_{1\mu} k_{1\nu} B_{11}\,, \displaybreak[0] \\[1ex] C_\mu &= k_{1\mu} C_1 + k_{2\mu} C_2 = \sum_{i=1}^2 k_{i\mu} C_i\,, \displaybreak[0] \\ C_{\mu\nu} &= g_{\mu\nu} C_{00} + \sum_{i,j=1}^2 k_{i\mu} k_{j\nu} C_{ij}\,, \displaybreak[0] \\ C_{\mu\nu\rho} &= \sum_{i=1}^2 \bigl( g_{\mu\nu} k_{i\rho} + g_{\nu\rho} k_{i\mu} + g_{\mu\rho} k_{i\nu}\bigr) C_{00i}+ \sum_{i,j,\ell=1}^2 k_{i\mu} k_{j\nu} k_{\ell\rho} C_{ij\ell}\,, \displaybreak[0] \\[1ex] D_\mu &= \sum_{i=1}^3 k_{i\mu} D_i\,, \displaybreak[0] \\ D_{\mu\nu} &= g_{\mu\nu} D_{00} + \sum_{i,j=1}^3 k_{i\mu} k_{j\nu} D_{ij}\,, \displaybreak[0] \\ D_{\mu\nu\rho} &= \sum_{i=1}^3\bigl( g_{\mu\nu} k_{i\rho} + g_{\nu\rho} k_{i\mu} + g_{\mu\rho} k_{i\nu}\bigr) D_{00i} + \sum_{i,j,\ell=1}^3 k_{i\mu} k_{j\nu} k_{\ell\rho} D_{ij\ell}\,, \displaybreak[0] \\ D_{\mu\nu\rho\sigma} &= (g_{\mu\nu} g_{\rho\sigma} + g_{\mu\rho} g_{\nu\sigma} + g_{\mu\sigma} g_{\nu\rho}) D_{0000} \\ & \hphantom{=} + \sum_{i,j=1}^3 \bigl( g_{\mu\nu} k_{i\rho} k_{j\sigma} + g_{\nu\rho} k_{i\mu} k_{j\sigma} + g_{\mu\rho} k_{i\nu} k_{j\sigma} \\[-1.5ex] & \hphantom{=+\sum_{i,j=1}^3\bigl(\,} + g_{\mu\sigma} k_{i\nu} k_{j\rho} + g_{\nu\sigma} k_{i\mu} k_{j\rho} + g_{\rho\sigma} k_{i\mu} k_{j\nu}\bigr) D_{00ij} \\[-1ex] & \hphantom{=} + \sum_{i,j,\ell,m=1}^3 k_{i\mu} k_{j\nu} k_{\ell\rho} k_{m\sigma} D_{ij\ell m}\,. \end{align*} Of all scalar and tensor-coefficient functions implemented in \LT, only $A_0$, $B_0$, $B_1$, $B_{00}$, $B_{11}$, $B_{001}$, $B_{111}$, $B'_{00}$, the C coefficients with at least two indices zero, and the D coefficients with at least four indices zero are actually UV divergent. \subsection{Conventions for the Momenta} \index{momenta!conventions for}% A large source of mistakes is the way of specifying the momenta in the one-loop integrals. The prime error in this respect is the confusion of the external momenta $p_i$ with the momenta $k_i$ appearing in the denominators, which are the sums of the $p_i$ (see Eq.\ (\ref{eq:ptok})). Consider for example the following diagram: \begin{center} \unitlength=1bp% \begin{picture}(155,140)(0,15) \ArrowLine(20,20)(40,40) \ArrowLine(20,140)(40,120) \ArrowLine(136,80)(105,80) \ArrowLine(40,40)(40,120) \ArrowLine(105,80)(40,40) \ArrowLine(40,120)(105,80) \Vertex(40,40){2} \Vertex(105,80){2} \Vertex(40,120){2} \Text(16,140)[br]{$p_1$} \Text(141,80)[cl]{$p_2$} \Text(16,20)[tr]{$p_3$} \Text(35,80)[cr]{$q$} \Text(75,102)[bl]{$q + k_1$} \Text(75,59)[tl]{$q + k_2$} \Text(44,80)[cl]{$m_1$} \Text(77,95)[tr]{$m_2$} \Text(77,65)[br]{$m_3$} \end{picture} \end{center} The three-point function corresponding to this diagram can be written either in terms of the external momenta as $$ C\bigl(p_1^2, p_2^2, (p_1 + p_2)^2, m_1^2, m_2^2, m_3^2\bigr) $$ or in terms of the momenta $k_i$ as $$ C\bigl(k_1^2, (k_1 - k_2)^2, k_2^2, m_1^2, m_2^2, m_3^2\bigr)\,. $$ In both cases the {\it same} function is called with the {\it same} arguments since of course $k_1 = p_1$ and $k_2 = p_1 + p_2$. (The arguments are given in the conventions of \LT.) It is however important to realize that \LT\ functions like $C_1$ and $C_{112}$ are the coefficients respectively of $k_{1\mu}$ and $k_{1\mu} k_{1\nu} k_{2\rho}$, not of $p_{1\mu}$ and $p_{1\mu} p_{1\nu} p_{2\rho}$. %\pagebreak \section{Functions provided by \LT} The distinction in the following for real and complex arguments is for Fortran and C/C++ only. Mathematica automatically chooses the correct version. \indextt{nocache}% The uncached LoopTools functions are not thread-safe, which may be rather dangerous in a concurrent environment as it can \emph{silently} lead to wrong results. Thread-safety has been achieved by serializing cache writes through mutexes. The scalar functions were moved into the cache system to make them thread-safe. The uncached versions (not thread-safe) are still available in Fortran and C/C++ with a `\Code{nocache}' epithet. \subsection{One-point function} \indextt{Aget}% \indextt{Aput}% \indextt{Aputnocache}% \indextt{A0i}% \indextt{A0}% \indextt{A00}% \begin{center} \begin{tabular}{|l|l|l|} \hline Function call (\Va\ real) & (\Va\ complex) & Description \\ \hline \Code{A0i(id, \Va)} & \Code{A0iC(id, \Va)} & one-point tensor coefficient \Code{id} \\ \Code{Aget(\Va)} & \Code{AgetC(\Va)} & all one-point tensor coefficients \\ \Code{Aput(res,\,\Va)} & \Code{AputC(res,\,\Va)} & all one-point tensor coefficients \\ \Code{Aputnocache(res,\,\Va)} & \Code{AputnocacheC(res,\,\Va)} & all one-point tensor coefficients \\ \textit{special cases of \Code{A0i}:} && \\ \Code{A0(\Va)} & \Code{A0C(\Va)} & one-point function \\ \Code{A00(\Va)} & \Code{A00C(\Va)} & coefficient of $g_{\mu\nu}$ \\ \hline \multicolumn{3}{|l|}{$\Va = m^2$} \\[.5ex] \multicolumn{3}{|l|}{$\displaystyle \lower 17pt\hbox{% \unitlength=1bp% \begin{picture}(100,40)(20,20) \Line(20,40)(50,40) \CArc(70,40)(20,0,360) \Vertex(50,40){2} \Text(96,40)[cl]{$m$} \end{picture}} = ~\frac{\mu^{4 - D}}{\i\pi^{D/2}\,r_\Gamma} \int\frac{\text{(numerator)}~\d^D q}{q^2 - m^2} $} \\[3ex] \hline \end{tabular} \end{center} \subsection{Two-point functions} \indextt{Bget}% \indextt{Bput}% \indextt{Bputnocache}% \indextt{B0i}% \indextt{B0}% \indextt{B1}% \indextt{B00}% \indextt{B11}% \indextt{B001}% \indextt{B111}% \begin{center} \begin{tabular}{|l|l|l|} \hline Function call (\Va\ real) & (\Va\ complex) & Description \\ \hline \Code{B0i(id, \Va)} & \Code{B0iC(id, \Va)} & two-point tensor coefficient \Code{id} \\ \Code{Bget(\Va)} & \Code{BgetC(\Va)} & all two-point tensor coefficients \\ \Code{Bput(res,\,\Va)} & \Code{BputC(res,\,\Va)} & all two-point tensor coefficients \\ \Code{Bputnocache(res,\,\Va)} & \Code{BputnocacheC(res,\,\Va)} & all two-point tensor coefficients \\ \textit{special cases of \Code{B0i}:} && \\ \Code{B0(\Va)} & \Code{B0C(\Va)} & scalar two-point function \\ \Code{B1(\Va)} & \Code{B1C(\Va)} & coefficient of $p_\mu$ \\ \Code{B00(\Va)} & \Code{B00C(\Va)} & coefficient of $g_{\mu\nu}$ \\ \Code{B11(\Va)} & \Code{B11C(\Va)} & coefficient of $p_\mu p_\nu$ \\ \Code{B001(\Va)} & \Code{B001C(\Va)} & coefficient of $g_{\mu\nu} p_\rho$ \\ \Code{B111(\Va)} & \Code{B111C(\Va)} & coefficient of $p_\mu p_\nu p_\rho$ \\ \hline \multicolumn{3}{|l|}{$\Va = p^2, m_1^2, m_2^2$} \\[1ex] \multicolumn{3}{|l|}{$\displaystyle \lower 29.5pt\hbox{% \unitlength=1bp% \begin{picture}(133,65)(10,8) \ArrowLine(20,40)(50,40) \ArrowLine(90,40)(120,40) \CArc(70,40)(20,0,360) \Vertex(50,40){2} \Vertex(90,40){2} \Text(16,38)[cr]{$p$} \Text(125,38)[cl]{$p$} \Text(72,63)[bc]{$m_1$} \Text(72,15)[tc]{$m_2$} \end{picture}} = \frac{\mu^{4 - D}}{\i\pi^{D/2}\,r_\Gamma} \int\frac{\text{(numerator)}~\d^D q} {\bigl[q^2 - m_1^2\bigr]\,\bigl[(q + p)^2 - m_2^2\bigr]} $} \\[5ex] \hline \end{tabular} \end{center} \subsection{Derivatives of Two-point functions} \indextt{DB0}% \indextt{DB1}% \indextt{DB00}% \indextt{DB11}% \begin{center} \begin{tabular}{|l|l|l|} \hline Function call (\Va\ real) & (\Va\ complex) & Description \\ \hline \Code{B0i(id, \Va)} & \Code{B0iC(id, \Va)} & two-point tensor coefficient \Code{id} \\ \Code{Bget(\Va)} & \Code{BgetC(\Va)} & all two-point tensor coefficients \\ \Code{Bput(res,\,\Va)} & \Code{BputC(res,\,\Va)} & all two-point tensor coefficients \\ \Code{Bputnocache(res,\,\Va)} & \Code{BputnocacheC(res,\,\Va)} & all two-point tensor coefficients \\ \textit{special cases of \Code{B0i}:} && \\ \Code{DB0(\Va)} & \Code{DB0C(\Va)} & derivative of \Code{B0} \\ \Code{DB1(\Va)} & \Code{DB1C(\Va)} & derivative of \Code{B1} \\ \Code{DB00(\Va)} & \Code{DB00C(\Va)} & derivative of \Code{B00} \\ \Code{DB11(\Va)} & \Code{DB11C(\Va)} & derivative of \Code{B11} \\ \Code{DB001(\Va)} & \Code{DB001C(\Va)} & derivative of \Code{B001} \\ \Code{DB111(\Va)} & \Code{DB111C(\Va)} & derivative of \Code{B111} \\ \hline \multicolumn{3}{|l|}{$\Va = p^2, m_1^2, m_2^2$\quad as above} \\ \hline \end{tabular} \end{center} All derivatives are with respect to the momentum squared. Note that the \Code{B0i}, \Code{Bget}, and \Code{Bput} coefficients include the derivatives, so there is no \Code{DB0i}, \Code{DBget}, or \Code{DBput}. \subsection{Three-point functions} \label{sect:3pt} \indextt{C0}% \indextt{C0i}% \indextt{Cget}% \indextt{Cput}% \indextt{C0nocache}% \begin{center} \begin{tabular}{|l|l|l|} \hline Function call (\Va\ real) & (\Va\ complex) & Description \\ \hline \Code{C0i(id, \Va)} & \Code{C0iC(id, \Va)} & three-point tensor coefficient \Code{id} \\ \Code{Cget(\Va)} & \Code{CgetC(\Va)} & all three-point tensor coefficients \\ \Code{Cput(res,\,\Va)} & \Code{CputC(res,\,\Va)} & all three-point tensor coefficients \\ \Code{C0nocache(res,\,\Va)} & \Code{C0nocacheC(res,\,\Va)} & scalar three-point function \\ \textit{special case of \Code{C0i}:} && \\ \Code{C0(\Va)} & \Code{C0C(\Va)} & scalar three-point function \\ \hline \multicolumn{3}{|l|}{$\Va = p_1^2, p_2^2, (p_1 + p_2)^2, m_1^2, m_2^2, m_3^2$} \\[1ex] \multicolumn{3}{|l|}{$\displaystyle \lower 67pt\hbox{% \unitlength=1bp% \begin{picture}(150,140)(5,10) \ArrowLine(20,20)(40,40) \ArrowLine(20,140)(40,120) \ArrowLine(136,80)(105,80) \Line(40,40)(40,120) \Line(105,80)(40,40) \Line(40,120)(105,80) \Vertex(40,40){2} \Vertex(105,80){2} \Vertex(40,120){2} \Text(16,140)[br]{$p_1$} \Text(141,78)[cl]{$p_2$} \Text(16,20)[tr]{$p_3$} \Text(36,80)[cr]{$m_1$} \Text(75,101)[bl]{$m_2$} \Text(75,58)[tl]{$m_3$} \end{picture}} ~~= \frac{\mu^{4 - D}}{\i\pi^{D/2}\,r_\Gamma} \int\frac{\text{(numerator)}~\d^Dq} {\begin{aligned} \bigl[q^2 - &m_1^2\bigr]\,\bigl[(q + p_1)^2 - m_2^2\bigr] \\ & \bigl[(q + p_1 + p_2)^2 - m_3^2\bigr] \end{aligned}} $} \\[12ex] \hline \end{tabular} \end{center} \subsection{Four-point functions} \indextt{D0}% \indextt{D0i}% \indextt{Dget}% \indextt{Dput}% \indextt{D0nocache}% \begin{center} \begin{tabular}{|l|l|l|} \hline Function call (\Va\ real) & (\Va\ complex) & Description \\ \hline \Code{D0i(id, \Va)} & \Code{D0iC(id, \Va)} & four-point tensor coefficient \Code{id} \\ \Code{Dget(\Va)} & \Code{DgetC(\Va)} & all four-point tensor coefficients \\ \Code{Dput(res,\,\Va)} & \Code{DputC(res,\,\Va)} & all four-point tensor coefficients \\ \Code{D0nocache(res,\,\Va)} & \Code{D0nocacheC(res,\,\Va)} & scalar four-point function \\ \textit{special case of \Code{D0i}:} && \\ \Code{D0(\Va)} & \Code{D0C(\Va)} & scalar four-point function \\ \hline \multicolumn{3}{|l|}{$\Va = p_1^2, p_2^2, p_3^2, p_4^2, (p_1 + p_2)^2, (p_2 + p_3)^2, m_1^2, m_2^2, m_3^2, m_4^2$} \\[1ex] \multicolumn{3}{|l|}{$\displaystyle \lower 61pt\hbox{% \unitlength=1bp% \begin{picture}(140,125)(-10,0) \ArrowLine(5,10)(30,30) \ArrowLine(5,115)(30,95) \ArrowLine(120,115)(95,95) \ArrowLine(120,10)(95,30) \Line(95,30)(30,30) \Line(30,30)(30,95) \Line(30,95)(95,95) \Line(95,95)(95,30) \Vertex(30,30){2} \Vertex(30,95){2} \Vertex(95,30){2} \Vertex(95,95){2} \Text(0,115)[r]{$p_1$} \Text(125,115)[l]{$p_2$} \Text(125,7)[l]{$p_3$} \Text(0,7)[r]{$p_4$} \Text(25,62)[r]{$m_1$} \Text(62,100)[b]{$m_2$} \Text(100,62)[l]{$m_3$} \Text(62,24)[t]{$m_4$} \end{picture}} = \frac{\mu^{4 - D}}{\i\pi^{D/2}\,r_\Gamma} \int\frac{\text{(numerator)}~\d^Dq} {\begin{aligned} \bigl[q^2 &- m_1^2\bigr] \bigl[(q + p_1)^2 - m_2^2\bigr] \\ & \bigl[(q + p_1 + p_2)^2 - m_3^2\bigr] \\ & \bigl[(q + p_1 + p_2 + p_3)^2 - m_4^2\bigr] \end{aligned}} $} \\[11ex] \hline \end{tabular} \end{center} \subsection{Five-point functions} \indextt{E0}% \indextt{E0i}% \indextt{Eget}% \indextt{Eput}% \indextt{E0nocache}% \begin{center} \begin{tabular}{|l|l|l|} \hline Function call (\Va\ real) & (\Va\ complex) & Description \\ \hline \Code{E0i(id, \Va)} & \Code{E0iC(id, \Va)} & five-point tensor coefficient \Code{id} \\ \Code{Eget(\Va)} & \Code{EgetC(\Va)} & all five-point tensor coefficients \\ \Code{Eput(res,\,\Va)} & \Code{EputC(res,\,\Va)} & all five-point tensor coefficients \\ \Code{E0nocache(res,\,\Va)} & \Code{E0nocacheC(res,\,\Va)} & scalar five-point function \\ \textit{special case of \Code{E0i}:} && \\ \Code{E0(\Va)} & \Code{E0C(\Va)} & scalar five-point function \\ \hline \multicolumn{3}{|l|}{$\begin{aligned} \Va = p_1^2, p_2^2, p_3^2, p_4^2, p_5^2, (p_1 + p_2)^2, (p_2 + p_3)^2, (p_3 + p_4)^2, (p_4 + p_5)^2, (&p_5 + p_1)^2, \\ &m_1^2, m_2^2, m_3^2, m_4^2, m_5^2 \end{aligned}$} \\ \multicolumn{3}{|l|}{$\displaystyle \lower 95pt\hbox{% \unitlength=1bp% \begin{picture}(160,152)(-10,-5) \Line(70.,40.)(108.042,67.6393) \ArrowLine(70.,12.)(70.,40.) \Line(108.042,67.6393)(93.5114,112.361) \ArrowLine(134.672,58.9868)(108.042,67.6393) \Line(93.5114,112.361)(46.4886,112.361) \ArrowLine(109.969,135.013)(93.5114,112.361) \Line(46.4886,112.361)(31.9577,67.6393) \ArrowLine(30.0306,135.013)(46.4886,112.361) \Line(31.9577,67.6393)(70.,40.) \ArrowLine(5.32816,58.9868)(31.9577,67.6393) \Vertex(70.,40.){2} \Vertex(108.042,67.6393){2} \Vertex(93.5114,112.361){2} \Vertex(46.4886,112.361){2} \Vertex(31.9577,67.6393){2} \Vertex(70.,40.){2} \Text(26,140)[r]{$p_1$} \Text(116,140)[l]{$p_2$} \Text(140,55)[l]{$p_3$} \Text(70,7)[t]{$p_4$} \Text(0,55)[r]{$p_5$} \Text(35,92)[r]{$m_1$} \Text(70,118)[b]{$m_2$} \Text(105,92)[l]{$m_3$} \Text(100,50)[t]{$m_4$} \Text(40,50)[t]{$m_5$} \end{picture}} = \frac{\mu^{4 - D}}{\i\pi^{D/2}\,r_\Gamma} \int\frac{\text{(numerator)}~\d^Dq} {\begin{aligned} \bigl[q^2 &- m_1^2\bigr] \bigl[(q + p_1)^2 - m_2^2\bigr] \\ & \bigl[(q + p_1 + p_2)^2 - m_3^2\bigr] \\ & \bigl[(q + p_1 + p_2 + p_3)^2 - m_4^2\bigr] \\ & \bigl[(q + p_1 + p_2 + p_3 + p_4)^2 - m_5^2\bigr] \end{aligned}} $} \\[11ex] \hline \end{tabular} \end{center} \subsection{Tensor Functions} \index{cache}% \index{tensor functions}% The ``\Code{$N$0i}'' functions (\Code{B0i}, \Code{C0i}, etc.) are generic functions for all tensor coefficients of the respective $N$-point function. A specific coefficient is selected with the first argument (denoted \Code{id} in the following). For example: $$ \begin{aligned} \text{\Code{C0i(cc0,\,\dots)}} &= C_0(\ldots) \\ \text{\Code{C0i(cc00,\,\dots)}} &= C_{00}(\ldots) \\ \text{\Code{C0i(cc112,\,\dots)}} &= C_{112}(\ldots) \qquad \text{etc.} \end{aligned} $$ The indices are symmetric and therefore the identifiers are assumed to be ordered, \ie there is only \Code{cc122} but not \Code{cc212}. \index{cache}% Internally, what happens when an \Code{$N$0i} is called is that actually \textit{all} $N$-point coefficients for the given set of momenta and masses are calculated. This is because there are a lot of intermediate results which would have to be recalculated every time the function is called for a different coefficient. These coefficients are then of course stored so that repeated calls to \Code{$N$0i} with the same set of arguments will simply retrieve the value from memory. So in a very real sense the identifiers \Code{cc0}, \Code{cc001}, etc.\ can be thought of as array indices (in fact, they are just integer constants to the compiler). In an unoptimized program, the savings incurred by this mechanism can be sizeable: typically 90\% of integrals requested can be retrieved from cache. The ``\Code{$N$get}'' functions (\Code{Bget}, \Code{Cget}, etc.) compute all $N$-point coefficients together. Their use is slightly more involved (one needs to keep track of an extra index) but results in faster code since only one cache lookup is needed, and not one for every coefficient. The ``\Code{$N$put$[$nocache$]$}'' subroutines (\Code{Aput}, \Code{Bput}, etc.) have the same functionality as the \Code{$N$get} functions but allow the user control over the storage location, \ie the first argument is a complex array of dimension \Code{Nbb}, \Code{Ncc}, \dots\ into which the coefficients are stored. This can be important \eg for parallel execution. \subsection{Cache Mechanism} \index{cache}% \index{internal heap}% \index{flushing the cache}% \index{reset heap} The cache functionality of \LT\ has already been alluded to above and for small calculations, the cache is just transparent to the user. In large calculations, however, it is worthwhile to flush the cache at strategic places, to reduce lookup times and avoid memory overflows. For example, when computing a cross-section in a loop over the energy, it makes sense to flush the cache every time one moves to another energy. Most loop integrals depend on the energy (and the few that don't are not very time-consuming to compute), so chances are slim that any of the cache integrals can be recycled. Cache memory is actually never really `freed' but only marked as overwritable. This is because, in a setup like above, every turn of the loop computes exactly the same number of integrals, so freeing and re-allocating the memory would just produce additional overhead. There are two ways to clear the cache. To completely remove all integrals from the cache, execute \begin{verbatim} call clearcache (Fortran) clearcache(); (C/C++) ClearCache[] (Mathematica) \end{verbatim} Alternately, the current cache pointers can be stored using \begin{verbatim} call markcache (Fortran) markcache(); (C/C++) MarkCache[] (Mathematica) \end{verbatim} and restored, at a later point, using \begin{verbatim} call restorecache (Fortran) restorecache(); (C/C++) RestoreCache[] (Mathematica) \end{verbatim} One can for example do the energy-independent integrals first, mark the cache, and restore it after every turn of the loop over the energy. Another issue concerns the depth of the comparison when looking up cache entries. Floating-point variables should in general never be compared verbatim, \ie one should always convert \Code{\Va\,.eq.\,\Vb} into \Code{abs(\Va\,-\,\Vb)\,.lt.\,$\varepsilon$}, because one does not want the comparison to fail due to numerical noise. For technical reasons, the cache-lookup precision is specified through the number of bits (rather than an $\varepsilon$) in \LT: \begin{alltt} call setcmpbits(\(b\)) \(b\) = getcmpbits() (Fortran) setcmpbits(\(b\)); \(b\) = getcmpbits(); (C/C++) SetCmpBits[\(b\)] \(b\) = GetCmpBits[] (Mathematica) export LTCMPBITS=\(b\) (bash) setenv LTCMPBITS \(b\) (tcsh) \end{alltt} \indextt{setcmpbits}% \indextt{getcmpbits}% \indextt{LTCMPBITS}% The defaults are 62 for double precision (a double precision number has 64 bits of which 52 are the mantissa) and 64 for quadruple precision (a quadruple precision number has 128 bits of which 112 are the mantissa). \subsection{Extended Precision} For most calculations, double precision is quite sufficient to yield satisfyingly accurate results. In some cases, however, cancellations between diagrams can cause double-digit loss of precision. Since the mantissa of a double precision number has only about 15 decimal digits, the result may thus be correct only to very few digits. Quadruple precision (16-byte real and 32-byte complex variables) has a mantissa of approximately 33 decimal digits and can cope much more severe cancellations. Quadruple precision does slow down the calculation, though, and is also not available on all platforms. To build the quadruple-precision version, configure with the \Code{--quad} option, \ie \begin{verbatim} ./configure --quad \end{verbatim} The resulting libraries and executables carry the suffix \Code{-quad}, \eg \Code{libooptools-quad.a}. As an intermediate solution -- more precise than double but faster than quadruple precision -- the \Code{--real10} flag may be added: \begin{verbatim} ./configure --quad --real10 \end{verbatim} This uses \Code{REAL*10} for extended precision, which is implemented in hardware on the x86 platform, though presently only available in gfortran 4.6+. For other compilers the extended precision type silently reverts to \Code{REAL*16}. \subsection{Versions and Debugging} \label{sect:versions} For checking the results, \LT\ has alternate implementations of various functions included, most of which are based on an implementation by Denner. The user can choose at run-time whether the default version `a' (mostly \FF) or the alternate version `b' (mostly Denner) is used and whether checking is performed. This is determined by the version key: \begin{tabbing} \Code{~~~0*key}\qquad \= compute version `a', \\ \Code{~~~1*key} \> compute version `b', \\ \Code{~~~2*key} \> compute both, compare, return `a', \\ \Code{~~~3*key} \> compute both, compare, return `b'. \end{tabbing} Usage is as in \begin{alltt} call setversionkey(\(k\)) \(k\) = getversionkey() (Fortran) setversionkey(\(k\)); \(k\) = getversionkey(); (C/C++) SetVersionKey[\(k\)] \(k\) = GetVersionKey[] (Mathematica) export LTVERSION=\(k\) (bash) setenv LTVERSION \(k\) (tcsh) \end{alltt} \indextt{setversionkey}% \indextt{getversionkey}% \indextt{LTVERSION}% where $k$ is \eg of the form \Code{2*KeyC0 + 3*KeyD0}. The following keys for alternate versions are currently available: \Code{KeyA0}, \Code{KeyBget}, \Code{KeyC0}, \Code{KeyD0}, \Code{KeyEget}, \Code{KeyEgetC}. \Code{KeyAll} comprises all of these. These symbols are not available in the shell, therefore it is most common to set all bits of the version key by putting the value $-1$. The comparison by default takes a relative deviation of $10^{-12}$ as a threshold for issuing warnings but this can be changed with \begin{alltt} call setmaxdev(\(\varepsilon\)) \(\varepsilon\) = getmaxdev() (Fortran) setmaxdev(\(\varepsilon\)); \(\varepsilon\) = getmaxdev(); (C/C++) SetMaxDev[\(\varepsilon\)] \(\varepsilon\) = GetMaxDev[] (Mathematica) export LTMAXDEV=\(\varepsilon\) (bash) setenv LTMAXDEV \(\varepsilon\) (tcsh) \end{alltt} \indextt{setmaxdev}% \indextt{getmaxdev}% \indextt{LTMAXDEV}% \index{cross-checks} Debugging output can be turned on likewise with \eg \begin{alltt} call setdebugkey(\(k\)) \(k\) = getdebugkey() (Fortran) setdebugkey(\(k\)); \(k\) = getdebugkey(); (C/C++) SetDebugKey[\(k\)] \(k\) = GetDebugKey[] (Mathematica) export LTDEBUG=\(k\) (bash) setenv LTDEBUG \(k\) (tcsh) \end{alltt} \indextt{setdebugkey}% \indextt{getdebugkey}% \indextt{LTDEBUG}% where $k$ is \eg of the form \Code{DebugC + DebugD}. Identifiers range from \Code{DebugB} to \Code{DebugE} and are summarized by \Code{DebugAll}. Again, these identifiers are not available in the shell, so the most common solution is to set all bits by choosing $-1$. The integrals are listed in the output with a unique serial number. If the list of integrals becomes too long, one can select only a range of serial numbers for viewing, as in \begin{alltt} call setdebugrange(\(f\), \(t\)) (Fortran) setdebugrange(\(f\), \(t\)); (C/C++) SetDebugRange[\(f\), \(t\)] (Mathematica) export LTRANGE=\(f\)-\(t\) (bash) setenv LTRANGE \(f\)-\(t\) (tcsh) \end{alltt} \indextt{setdebugrange}% \indextt{LTRANGE}% This makes it easy to monitor `suspicious' integrals. \subsection{On Warning Messages and Checking Results} Computing reliable numeric values for the one-loop integrals is a highly non-trivial task because of possible cancellations, and requires to take into account many special cases to achieve a reasonable accuracy also in ``problematic'' corners of phase space. Such regions are typically thresholds and high energies. \LT\ is built on the \FF\ library which tries very hard to produce correct values. Nevertheless, it is essential to have means of cross-checking the results, particularly if such tell-tale signs of numerical problems as unsmoothness of a curve (\eg unexpected bumps or peaks in the cross-section) are observable. \index{warning messages}% \index{error messages}% \index{FF@\FF}% \FF\ has a built-in warning system that checks for critical loss of accuracy. Unfortunately, the warnings issued by \FF\ concerning the loss of accuracy are somewhat overzealous, and particularly for a large number of consecutive calls to \FF\ (\eg when computing a cross-section over a sizeable region of phase space) can add up to ridiculous numbers, \eg ``lost a factor $10^5$.'' Unless a very detailed checking of these warnings is performed, they are pretty useless and tend to numb the user to a degree where severe errors are easily overlooked. For this reason, the \FF\ warning system has largely been disabled in \LT. \FF\ does report the estimated number of digits lost, however, on which \LT\ acts as follows: \begin{itemize} \item If more than the Warning Digits (default: 9) are lost, a more thorough version of the integral is used (which uses \eg different permutations of the input arguments). The Warning Digits can be set as follows: \begin{alltt} call setwarndigits(\(d\)) \(d\) = getwarndigits() (Fortran) setwarndigits(\(d\)); \(d\) = getwarndigits(); (C/C++) SetWarnDigits[\(d\)] \(d\) = GetWarnDigits[] (Mathematica) export LTWARN=\(d\) (bash) setenv LTWARN \(d\) (tcsh) \end{alltt} \indextt{setwarndigits}% \indextt{LTWARN}% \item If in the end more than the Error Digits (default: 100) are reported lost, \LT\ invokes the alternate version (see Sect.~\ref{sect:versions}). The Error Digits are set via \begin{alltt} call seterrdigits(\(d\)) \(d\) = geterrdigits() (Fortran) seterrdigits(\(d\)); \(d\) = geterrdigits(); (C/C++) SetErrDigits[\(d\)] \(d\) = GetErrDigits[] (Mathematica) export LTERR=\(d\) (bash) setenv LTERR \(d\) (tcsh) \end{alltt} \indextt{seterrdigits}% \indextt{LTERR}% \end{itemize} \subsection{Ultraviolet, Infrared, and Collinear Divergences} \paragraph{Ultraviolet divergences} are regularized dimensionally in \LT. They originate from the scalar integrals $A_0$ and $B_0$ and from there are passed on to certain tensor coefficients. UV-divergent loop integrals contain the combination $1/\varepsilon - \gamma_{\rm E} + \log 4\pi$, of which \LT\ puts the actual divergence into the $\varepsilon^{-1}$ component of the result (but see \Code{setuvdiv} below) and substitutes the finite part by $\Delta$. The dimensionful parameter $\mu$ is introduced to keep the integral's mass dimension the same in all dimensions $D$ (see Sect.\ \ref{sect:loopint}). \index{UV-regularization parameters}% The default value for $\Delta$ is 0, the $\overline{\text{MS}}$ value. Putting $\Delta = -2$ reproduces the one-loop functions of constrained differential renormalization as published in \cite{dACTP98}. $\Delta$ is a redundant parameter since $\mu$ can be adjusted to have the same effect: $\mu^2_{\text{new}} = {\rm e}^\Delta\mu^2_{\text{old}}$. \index{MS@$\overline{\text{MS}}$}% A UV-finite result must not depend on either $\Delta$ or $\mu$, hence it is straightforward to check the cancellation of the divergences numerically: calculate the expression with two different values for $\Delta$ (or $\mu$, or both), and check whether the result stays the same within numerical precision. Note that $\mu$ enters logarithmically; this means that to decisively check whether an expression is really independent of $\mu$, it must be varied on a large scale, \eg from 1 to $10^{10}$. \paragraph{Infrared divergences} appear in processes with charged external particles. They originate from the exchange of virtual massless particles between on-shell legs. More precisely they come from diagrams containing structures of the form \begin{center} \begin{picture}(130,125)(0,0) \Line(5,10)(30,30) \Line(30,30)(100,30) \Vertex(30,30){2} \Photon(30,30)(30,95){-2}{4.5} \Line(30,95)(5,115) \Line(30,95)(100,95) \Vertex(30,95){2} \multiput(100,44)(0,17){3}{\makebox(0,0){$.$}} \Text(0,115)[r]{$k_i$} \Text(0,7)[r]{$k_j$} \Text(23,62)[r]{$\gamma$} \Text(65,62)[]{loop} \Text(65,25)[t]{$m_{j-1}^2=k_j^2$} \Text(65,100)[b]{$m_i^2=k_i^2$} \end{picture} \end{center} Such diagrams are IR divergent because the photon is massless; if the photon had a mass $\lambda$, the divergent terms would be proportional to $\log\lambda$. NB: such a photon mass should \emph{not be introduced by hand:} if a requested integral is IR divergent, \LT\ automatically substitutes regularization parameters (see below). In QCD calculations, the custom is rather to regularize the IR divergences dimensionally, in which case they show up as poles in $1/\varepsilon$ and $1/\varepsilon^2$. \index{IR-regularization parameters}% \begin{itemize} \item For $\lambda^2 > 0$, photon-mass regularization is used with a photon mass $\lambda$, where $\lambda$ is treated as an infinitesimal quantity, however, which means that terms of order $\lambda$ or higher are discarded (\ie only the $\log\lambda$ terms are kept). Since the final result should not depend on $\lambda$ after successful removal of the IR divergences, $\lambda$ can be given an arbitrary numerical value despite its infinitesimal character. To test IR finiteness numerically, one can proceed just as in the ultraviolet case: calculate the expression for two values of $\lambda$ and check whether the results agree. As mentioned, the $\lambda$-dependence is logarithmic, hence one has to change $\lambda$ on a big scale (say from 1 to $10^{10}$) to decisively check IR finiteness. \item In dimensional regularization, $\lambda^2 = -2$ returns the coefficient of $\varepsilon^{-2}$, $\lambda^2 = -1$ the coefficient of $\varepsilon^{-1}$, and $\lambda^2 = 0$ the finite piece. In this case, testing IR finiteness numerically proceeds through checking the coefficients of $\varepsilon^{-1}$, $\varepsilon^{-2}$ coefficients, which have to add up to zero in observable quantities. This can be done particularly conveniently through the \Code{LTLAMBDA} environment variable (see below), such that no recompilation of the program is necessary. While a non-positive value of $\lambda$ immediately affects the functions returning complex values (\Code{$N$0i} and special cases) it has no impact on the output of the functions returning the full set of tensor coefficients (\Code{$N$get}, \Code{$N$put}). Rather, the sets contain all three $\varepsilon$-coefficients to start with, for example \begin{verbatim} i = Bget(...) e0coeff = Bval(bb0,i) e1coeff = Bval(bb0+1,i) e2coeff = Bval(bb0+2,i) \end{verbatim} The index 0, 1, 2 corresponding to the current value of $\lambda^2$ can be obtained with the \Code{getepsi} function. \end{itemize} \paragraph{Collinear singularities} arise for vanishing momentum-square of an external leg sandwiched between two massless internal propagators, as in: \begin{center} \begin{picture}(115,90)(0,10) \Gluon(10,100)(60,50){-4}{6} \Line(10,0)(60,50) \Line(60,50)(110,50) \Vertex(60,50){2} \multiput(10,13)(0,14){6}{\makebox(0,0){$.$}} \Text(70,55)[bl]{$p_i^2 = m_f^2\ll s$} \Text(35,84)[bl]{$m_1 = 0$} \Text(35,22)[tl]{$m_2 = 0$} \end{picture} \end{center} The divergence is logarithmic of the form $\log m_f^2/s$, so the fermion mass acts as a natural regulator. In sufficiently inclusive observables, these logs cancel due to the Kinoshita--Lee--Nauenberg theorem \cite{KLN}. In non-confined theories, for example the electroweak Standard Model, it is possible to observe non-inclusive observables where the large effects due to small fermion masses can be seen. In QCD it is again customary to regularize the collinear divergences dimensionally, such that instead of large logs the divergences manifest themselves as poles in $1/\varepsilon$ and $1/\varepsilon^2$. \begin{itemize} \item For dimensional regularization (QCD), the collinear divergences are controlled in the same way as the IR divergences above: setting $\lambda^2 = -2, -1, 0$ returns the coefficients of $\varepsilon^{-2}$, $\varepsilon^{-1}$, and the finite piece, respectively. \item To facilitate mass regularization, \LT\ acts on the variable \mmin\ in the following way: On calling a loop integral, all arguments less than \mmin\ are set to zero. If it is discovered that the function truncated thus has a collinear divergence, \mmin\ is substituted back into the $p_i^2$. This procedure makes it possible for \LT\ to use the regulator mass only in actually divergent configurations and avoid numerical problems due to small finite masses elsewhere. \end{itemize} \paragraph{The following routines} allow to set and retrieve the regularization parameters. Note that $\mu$, $\lambda$, and $m_{\text{min}}$ always enter squared. \begin{alltt} call setdelta(\(\Delta\)) \(\Delta\) = getdelta() (Fortran) call setmudim(\(\mu\sp2\)) \,\(\mu\sp2\) = getmudim() call setlambda(\(\lambda\sp2\)) \,\(\lambda\sp2\) = getlambda() call setminmass(\(\mmin\)) \,\(\mmin\) = getminmass() \end{alltt} \begin{alltt} setdelta(\(\Delta\)); \(\Delta\) = getdelta(); (C/C++) setmudim(\(\mu\sp2\)); \,\(\mu\sp2\) = getmudim(); setlambda(\(\lambda\sp2\)); \,\(\lambda\sp2\) = getlambda(); setminmass(\(\mmin\)); \,\(\mmin\) = getminmass(); \end{alltt} \begin{alltt} SetDelta[\(\Delta\)] \(\Delta\) = GetDelta[] (Mathematica) SetMudim[\(\mu\sp2\)] \,\(\mu\sp2\) = GetMudim[] SetLambda[\(\mu\sp2\)] \,\(\lambda\sp2\) = GetLambda[] SetMinMass[\(\mmin\)] \,\(\mmin\) = GetMinMass[] \end{alltt} \begin{alltt} export LTDELTA=\(\Delta\) \,(bash) export LTMUDIM=\(\mu\sp2\) export LTLAMBDA=\(\lambda\sp2\) export LTMINMASS=\(\mmin\) \end{alltt} \begin{alltt} setenv LTDELTA \(\Delta\) \,(tcsh) setenv LTMUDIM \(\mu\sp2\) setenv LTLAMBDA \(\lambda\sp2\) setenv LTMINMASS \(\mmin\) \end{alltt} \indextt{setdelta}% \indextt{getdelta}% \indextt{LTDELTA}% \indextt{setmudim}% \indextt{getmudim}% \indextt{LTMUDIM}% \indextt{setlambda}% \indextt{getlambda}% \indextt{LTLAMBDA}% \indextt{setminmass}% \indextt{getminmass}% \indextt{LTMINMASS}% If $\lambda^2\leqslant 0$ was chosen, the $\varepsilon^{-1}$ component of the results contains both UV and IR divergences, sometimes denoted $1/\varepsilon_{\text{UV}}$ and $1/\varepsilon_{\text{IR}}$. The UV part can be switched off ($x = 0$) and on ($x = 1$) with \begin{alltt} call setuvdiv(\(x\)) (Fortran) setuvdiv(\(x\)); (C/C++) SetUVDiv[\(x\)] (Mathematica) export LTUVDIV=\(x\) (bash) setenv LTUVDIV \(x\) (tcsh) \end{alltt} Note that $x$ is a real argument, not an integer one, as in: \Code{call setuvdiv(1D0)}. \subsection{Accuracy} In rare cases the user may want to set the following accuracy thresholds. \begin{itemize} \item A given quantity $x$ is tested for zero by $|x| < \zeroeps$. The comparator $\zeroeps$ has the default value $10^{-22}$ and can be set through \begin{alltt} call setzeroeps(\(\zeroeps\)) (Fortran) setzeroeps(\(\zeroeps\)); (C/C++) SetZeroEps[\(\zeroeps\)] (Mathematica) export LTZEROEPS=\(\zeroeps\) (bash) setenv LTZEROEPS \(\zeroeps\) (tcsh) \end{alltt} \item Two quantities $x$ and $y$ are tested for equality by $|x - y| < \diffeps$, where $\diffeps$ has the default value $10^{-12}$ and can be set through \begin{alltt} call setdiffeps(\(\diffeps\)) (Fortran) setdiffeps(\(\diffeps\)); (C/C++) SetDiffEps[\(\diffeps\)] (Mathematica) export LTDIFFEPS=\(\diffeps\) (bash) setenv LTDIFFEPS \(\diffeps\) (tcsh) \end{alltt} In particular in conjunction with phase-space generators the detection of \eg $p^2 = m^2$ may fail with the default $\diffeps$ due to rounding errors in the generation of $p$. \end{itemize} \section{Using \LT\ with Fortran} \label{sect:fortran} \index{Fortran}% \index{command line@command line}% \index{environment variable}% Some technical details concerning compilation: \begin{itemize} \item Specify the location of \LT\ once in an environment variable (this saves a lot of typing later on). For example, in the \Code{tcsh}, use \begin{verbatim} setenv LT $HOME/LoopTools/(hosttype) \end{verbatim} When compiling a program that uses \LT, use \begin{verbatim} -I$LT/include (source files) -L$LT/lib -looptools \end{verbatim} on the command line. As Unix linker are one-pass linkers, the library flags (\Code{-L...}, \Code{-l...}) must come after the Fortran or object files on the command line. In a makefile, you have to use parentheses around the environment variables, \ie \Code{\$(LT)} instead of \Code{\$LT}. \index{C preprocessor}% \item Fortran files that use \LT\ must have the extension \Code{.F}, not \Code{.f}. This tells the Fortran compiler that the files need to be run through the C preprocessor first. \indextt{RealType}% \indextt{ComplexType}% \item The user may wish to use \Code{RealType} instead of \Code{double precision} and \Code{ComplexType} instead of \Code{double complex}. These types are declared in \Code{looptools.h}, they are preprocessor-friendly (one word) and make it easier to switch \eg to quadruple precision. \end{itemize} \indextt{looptools.h}% \indextt{ltini}% \indextt{ltexi}% \index{summary of errors}% To use the \LT\ functions in a Fortran program, the file \Code{looptools.h} must be included in every function or subroutine in which the \LT\ functions are called. Before using any \LT\ function, the subroutine \Code{ltini} must be called. At the end of the calculation \Code{ltexi} may be called to obtain a summary of errors. A very elementary program would for instance be \begin{verbatim} program simple_program implicit none #include "looptools.h" call ltini print *, B0(1000D0, 50D0, 80D0) call ltexi end \end{verbatim} Note that, as for all preprocessor commands, the \Code{\#} must stand at the beginning of the line. It is important to include the \Code{looptools.h} via the preprocessor command {\tt\#include} instead of the \Code{include} directive many Fortran compilers offer. This is because preprocessor variables are used in \Code{looptools.h} which would otherwise not take effect. Incidentally, if you do run this program, the result should be \Code{(-4.40593283,2.7041431)}. \index{Higgs self-energy}% To give a more realistic example, here is the calculation of the bosonic part of the Higgs self-energy in the electroweak Standard Model. \begin{verbatim} program HiggsSE implicit none #include "looptools.h" RealType s ComplexType SigmaH external SigmaH call ltini do s = 100, 1000, 50 print *, s, " ", SigmaH(s) enddo call ltexi end ComplexType function SigmaH(k2) RealType k2 #include "looptools.h" RealType MH2, MZ2, MW2, Alfa, pi, SW2 parameter (MH2 = 126D0**2, & MZ2 = 91.188D0**2, MW2 = 80.39D0**2, & Alfa = 1/137.0359895D0, & pi = 3.14159265358979D0, & SW2 = 1 - MW2/MZ2) SigmaH = Alfa/(32*pi*SW2*MW2)* & ( 3*MH2*A0(MH2) + 9*MH2**2*B0(k2, MH2, MH2) & + 2*(MH2**2 - 4*MW2*(k2 - 3*MW2))*B0(k2, MW2, MW2) & + 2*(6*MW2 + MH2)*A0(MW2) - 24*MW2**2 & + (MH2**2 - 4D0*MZ2*(k2 - 3*MZ2))*B0(k2, MZ2, MZ2) & + (6*MZ2 + MH2)*A0(MZ2) - 12*MZ2**2 ) end \end{verbatim} \section{Using \LT\ with C/C++} \index{C++}% \index{c++ command line@\Code{c++} command line}% Some technical details: \begin{itemize} \item Like in the Fortran case, it saves a lot of typing to specify the location of \LT\ once in an environment variable. For example, in the \Code{tcsh}, use \begin{verbatim} setenv LT $HOME/LoopTools/(hosttype) \end{verbatim} Then compile the programs that use \LT\ with the following command: \begin{verbatim} $LT/bin/fcc -I$LT/include (source files) -L$LT/lib -looptools \end{verbatim} \Code{fcc} is a script to compile C and C++ programs and link them with Fortran libraries, in this case \Code{libooptools.a}. Note that in a makefile, you have to use parentheses around the environment variables, \ie \Code{\$(LT)} instead of \Code{\$LT}. \indextt{RealType}% \indextt{ComplexType}% \item The \Code{RealType} and \Code{ComplexType} types declared by \Code{clooptools.h} help produce code valid for both C and C++. The latter maps to \Code{std::complex} in C++, \Code{double complex} in C99, and \Code{struct \lbrac\ double re, im; \rbrac} in C89. \end{itemize} To use the \LT\ functions in a C/C++ program, the file \Code{clooptools.h} must be included. Similar to the Fortran case, before making the first call to any \LT\ function, \Code{ltini()} must be called and at the end \Code{ltexi()} may be called to get a summary of errors. In C++, an elementary program would be {\samepage \begin{verbatim} #include #include "clooptools.h" int main() { ltini(); cout << B0(1000., 50., 80.) << endl; ltexi(); } \end{verbatim}} In the following the same example as for the Fortran case is given: the bosonic part of the Higgs self-energy in the electroweak Standard Model. This code is given in C syntax though it compiles also with C++ thanks to the \Code{ComplexType} data type (a true C++ aficionado would eschew the use of stdio, however). \begin{verbatim} #include #include "clooptools.h" #define MH2 (126.*126.) #define MZ2 (91.188*91.188) #define MW2 (80.4*80.4) #define Alfa (1./137.0359895) #define pi 3.14159265358979 #define SW2 (1. - MW2/MZ2) static ComplexType SigmaH(double k2) { return Alfa/(32*pi*SW2*MW2)* ( 3*MH2*A0(MH2) + 9*MH2*MH2*B0(k2, MH2, MH2) + 2*(MH2*MH2 - 4*MW2*(k2 - 3*MW2))*B0(k2, MW2, MW2) + 2*(6*MW2 + MH2)*A0(MW2) - 24*MW2*MW2 + (MH2*MH2 - 4*MZ2*(k2 - 3*MZ2))*B0(k2, MZ2, MZ2) + (6*MZ2 + MH2)*A0(MZ2) - 12*MZ2*MZ2 ); } int main() { RealType s; ltini(); for( s = 100; s <= 1000; s += 50 ) { ComplexType sig = SigmaH(s); printf("%g\t%g%+gi\n", s, Re(sig), Im(sig)); } ltexi(); } \end{verbatim} \section{Using \LT\ with \mma} \index{Mathematica@\mma}% \index{setting the path}% Modify your path to include \Code{\home/LoopTools/(hosttype)/bin}, \eg in \Code{tcsh} use \begin{verbatim} set path=($path $HOME/LoopTools/(hosttype)/bin) \end{verbatim} It is probably a good idea to include this statement \eg in \Code{.cshrc}. \indextt{Install}% \indextt{LoopTools}% The \mma\ interface is probably the simplest to use: \begin{verbatim} In[1]:= Install["LoopTools"] Out[1]= LinkObject[LoopTools, 1, 1] In[2]:= B0[1000, 50, 80] Out[2]= -4.40593 + 2.70414 I \end{verbatim} \indextt{Cget}% \indextt{Dget}% The \Code{$N$get} routines return a list of rules containing all tensor coefficients, \eg \begin{verbatim} In[3]:= Cget[80, 80, 10000, 300, 100, 200] //InputForm Out[3]//InputForm= {cc0 -> 0.0003683322958259527 - 0.00144304878124425*I, cc1 -> 0.00003691991146686607 + 0.0008063637675463306*I, cc2 -> -0.0002186870966525929 + 0.0003255577507551812*I, cc00 -> -1.468122864600498 + 0.6620214671984382*I, cc11 -> -0.0001383963649940767 - 0.0005211388919006447*I, cc12 -> 0.00005607420875500784 - 0.0001466442566605745*I, cc22 -> 0.0001038232033882128 - 0.0001572866825209231*I, cc001 -> 0.4339544374355454 - 0.1905346035793642*I, cc002 -> 0.5179247985708856 - 0.2390535391455292*I, cc111 -> 0.0001637407816195954 + 0.0003561351446381443*I, cc112 -> -0.00001499429891688691 + 0.00008510756809075344*I, cc122 -> -0.00002351641063613291 + 0.00005055502592614985*I, cc222 -> -0.00005956786867352272 + 0.000101962969539097*I} \end{verbatim} One-loop functions containing non-numeric arguments (\eg \Code{B0[1000,\,MW2,\,MW2]}) remain unevaluated. If it becomes necessary to switch off the evaluation of the \LT\ functions, \Code{LoopTools} can be uninstalled: \begin{verbatim} In[10^37]:= Uninstall[%1] \end{verbatim} \begin{appendix} \chapter{The original \FF\ Manual} \newcommand\comp{\tt} \newcommand\ms{\,\mbox{ms}} % #[ Introduction: \section{Introduction} The evaluation of scalar loop integrals is one of the time consuming parts of radiative correction computations in high energy physics. Of course the general solution has long been known \cite{tHV79}, but the use of these formulae is not straightforward. If one encodes the algorithms directly in a numerical language one finds that for most physical configurations the answer is extremely unreliable due to numerical cancellations. It is not at all difficult to find examples where more than 80 digits accuracy are lost. There are two ways in which these problems have been solved. M.~Veltman has programmed these algorithms using a very large precision (up to 120 digits) for the intermediate results in the program FormF\null, which enabled him to do some very complicated calculations \cite{PaV79}. However, these routines are written in assembler language and thus only available on certain computers. Also, the use of multiple precision makes them fairly slow --- and even so there are many (soft t-channel) configurations for which the answer is incorrect, or correct only for one permutation of the input parameters. The other solution is to evaluate by hand all special cases needed and make sure that these are numerically stable, in this way building a library of physically interesting cases. This costs much time and has to be extended for every new calculation, as often the limits taken are no longer valid. We present here a set of Fortran routines that evaluate the one-loop scalar integrals using a standard precision. The algorithms used have been published before \cite{vOV90}. This paper describes version 1.0 which contains the following units: \begin{itemize} \item the scalar one, two, three, four and five-point functions, defined by \begin{equation} X_0 = \frac{1}{i\pi^2} \int \!\!\frac{d^n Q}{(Q^2 - m_1^2)((Q+P)^2 - m_2^2)\cdots} \end{equation} \item the vector three and four-point functions, \item some determinants. \end{itemize} Planned additions are: \begin{itemize} \item The other Form factors \`{a} la FormF. \item The six-point function. \end{itemize} Note however, that the reduction of these can be done analytically. The aim of the routines is to provide a reliable answer for any conceivable (physical) combination of input parameters. This has not been fully met in the case of the four-point function, but an impressive list of cases does indeed work. Problems normally occur when many parameters are (almost) equal, i.e.\ when an analytical calculation is most feasible. The layout of this paper is as follows. First we give a brief description of the design of the package and some details that may be of of relevance to the user, like timings. Next we give a complete user's guide. The problems which might be encountered when installing FF on a computer system are discussed in section \ref{sc:installation}. The initialisation of the routines, which has to be done by the user in the program which uses the FF routines, is outlined in section \ref{sc:initialization}. The next section is about the use of the error reporting facilities, which also need some assistance from the user. A list of the available routines for the scalar n-point functions (section \ref{sc:n-point}) and determinants (section \ref{sc:determinants}) is given, listing parameters, loss of precision and comments. % #] Introduction: % #[ Brief description of the scalar loop routines: \section{Brief description of the scalar loop routines} \label{ap:FFdescription} This section will give an overview of the structure of the scalar loop routines which implement the algorithms of \cite{vOV90}. The purpose of this is to provide a map for the adventurous person who wants to understand what is going on. Some details of the algorithms chosen are also given. \subsection{Overview} The language chosen is Fortran, mainly because so much of the calculations are done with complex variables. There are currently about 26000 lines of code. Some of it is repetitious, as many routines exist in a real and complex version which hardly differ. Global names (subprograms, common blocks) almost all start with the letters \Code{FF}, for FormFactor (the only exceptions are the functions \Code{dfflo1}, \Code{zfflo1}, \Code{zfflog} and \Code{zxfflg}). For this reason I refer to the set as the FF package. The third letter of the name often indicates whether a routine is complex (\Code{z} or \Code{c}) or real. The real four-point function is thus calculated with the routine \Code{ffxd0}, the complex dilogarithm in \Code{ffzli2}. All common blocks are included via a single include file, which also defines some constants such as one and $\pi$ in the precision currently used. I have tried hard to make switching between \Code{real} and \Code{double precision} as easy as possible. The packages roughly consists of six kind of routines: \begin{itemize} \item The high-level and user-callable routines, such as \Code{ffxd0}. \item Dotproduct calculation routines, such as \Code{ffdot4}. \item The determinant routines, such as \Code{ffdl4p}; the number indicates the size of the determinant and the letter the kind. \item Routines to get combinations of dilogarithms, for instance \Code{ffcxr}; the names roughly follow the names given in \cite{vOV90}. \item Low level routines: the logarithms, dilogarithms, $\eta$ functions. \item Support routines: initialisation, the error and warning system, taylor series boundaries and consistency checking. \end{itemize} The high-level routines first compute missing arguments such as the differences of the input parameters. Next the parameters are permuted to a position in which the evaluation is possible. All dotproducts are calculated and from these the necessary determinants are determined. In the case of the four-point function we now perform the projective transformation and compute all transformed dotproducts and differences. The determinants and dotproducts allow us to find the combinations of roots needed, which are passed on to the routines which evaluate the combinations of dilogarithms. The most difficult part is to anticipate the cancellations among the dilogarithms without actually calculating them. This is usually done by comparing the arguments mapped to the unit circle $c_i'$, with a safety margin. Unfortunately the choices made are not always the best, especially on the higher levels (complete $C_0$'s or $S_i$'s). This is the reason the user can influence the possibilities considered with the flags \Code{l4also} and \Code{ldc3c4}, which switch on or off the 16 dilogarithm algorithm and the expanded difference between two three-point functions. The dilogarithms are evaluated in \Code{ffxli2} and \Code{ffzli2}. These expect their arguments to lie in the region $|z| < 1, \Re(z) <1/2$ already, more general functions (used for testing) are \Code{ffzxdl} and \Code{ffzzdl}. The algorithm used is the expansion in $\log(1-z)$ described in \cite{tHV79}. As the precision of the computer is unknown in advance fancy Chebychev polynomials and the like are not used. The values of the logarithms and dilogarithms are placed in a big array which is only summed at the last moment. This is done to prevent false alarms of the warning system. {\em Every single addition} in the whole program of which one cannot prove that both operands have the same sign is checked for numerical problems with a line like \begin{verbatim} sum = x + y + z xmax = max(abs(x),abs(y)) if ( abs(sum) .lt. xloss*xmax ) call ffwarn(n,ier,sum,xmax) \end{verbatim} with \Code{xloss} set to 1/8 by \Code{ffini}. A theoretically better way would be to compare the result to the partial sums. We are however only interested in the order of magnitude of the cancellation, and for that this method suffices. The only other place where one can lose significant precision is in taking the logarithm of a number close to 1. All calls to the logarithm are checked by a wrapper routine for this case. A routine \Code{dfflo1/zfflo1} is provided to evaluate $\log(1-x)$. Finally a word on the determinant routines. They use in general a very simplistic algorithm to find the linearly independent combination of vectors which gives the most accurate answer: try until it works. All sets are tried in order until the sum in no smaller than \Code{xloss} times the largest term. In the larger determinants this set is remembered and tried first the next time the routine is called. \subsection{Timings} In table \ref{tab:timings} we give the timings of the scalar n-pint functions on different machines. The numbers given can only be an indication as the path taken varies wildly with the complexity of the problem. A numerical unstable set of parameters might mean much more time spent in the determinant routines and a bit less in the dilogarithms for instance. The flag \Code{ltest} was turned off for these tests. \begin{table}[htbp] \begin{center} \begin{tabular}{|l|rrrr|} \hline machine & $B_0$ & $C_0$ & $D_0$ & $E_0$ \\ \hline NP1 & 0.2 \ms & 4.5 \ms & 13 \ms & 65 \ms \\ Sun4 & 0.9 \ms & 8.1 \ms & 20 \ms & 90 \ms \\ Apollo 10020 & 0.08 \ms & 1.5 \ms & 4.9 \ms & 24 \ms \\ Atari ST & 40 \ms & 400 \ms & 900 \ms & 5800 \ms \\ \hline \end{tabular} \end{center} \caption{Timings of the scalar n-point functions.} \label{tab:timings} \end{table} For a $D_0$, approximately 10\% of the time is spent in the dilogarithms, 50\% in the determinants and the rest in the sorting out and summing. \subsection{Tests} The $B_0$ has been tested against FormF over all parameter space, the $C_0$ for some 100 physical configurations and the $D_0$ for about 30. The $E_0$ is as yet untested (except for internal consistency). The only differences were in very low t-channel configurations and I have reason to distrust FormF. The limit is not approached smoothly, and very extreme kinematical configurations such as those occurring in the ZEUS luminosity monitor \cite{vdH90} often give a \Code{DMPX}. FF approaches the theoretically correct limit smoothly. \section{Installation} \label{sc:installation} In this section the installation of the FF routines on a computer is discussed. We will first discuss the problems which may be caused by the Fortran used. Next the use of data files is discussed. The routines have been written in standard (ANSI) Fortran 77, with a few extensions, which most compilers allow. The package compiles without changes on the Gould/Encore (fort), Apollo/SR10 (ftn), Meiko (mf77) and VAX (fortran/g\_float). Changes are necessary for the Apollo/SR9 (ftn), Sun (f77), CDC (ftn5), Atari ST (Absoft) and possibly other compilers. The extensions used are: \begin{itemize} \item the use of tabs. \item the use of lower case letters. \item the use of \Code{implicit none}. \item the use of the \Code{include} directive to include the file 'ff.h', which contains parameters and common blocks used throughout the package. \item the use of \Code{DOUBLE COMPLEX} data type. In principle FF can also run in single precision, but the loss of 3--5 digits can often not be avoided in the evaluation of an n-point function. This may leave too little information. \end{itemize} All these extensions can easily be removed with a good editor. The following commands will convert the source to ANSI Fortran. (The syntax is that of the editor \textsc{STedi}). \begin{verbatim} mark /include 'ff.h'/ deleteline read ff.h /implicit none/=/implicit logical (a-z)/ /DBLE(/=/REAL(/ /DIMAG/=/AIMAG/ /DCMPLX/=/CMPLX/ /DOUBLE COMPLEX/=/COMPLEX/ end # convert to uppercase ctrl-u # expand the tabs te \end{verbatim} Note that all names that have to be converted when switching from single to double precision are in capitals. It is possible to run the package in double precision real and single precision complex (the error reporting system might underestimate the accuracy in this case). To convert to single precision real (for instance on a CDC) use \begin{verbatim} /DOUBLE PRECISION/=/REAL/ \end{verbatim} It may be necessary to convert to systems with other names for the double precision complex data types and functions (e.g.~IBM). The double complex functions to be transformed are \Code{zfflo1}, \Code{zfflog} and \Code{zxfflg}. They are now declared as \Code{DOUBLE COMPLEX function(args)}, change this to \Code{COMPLEX function*16(args)}. Generic names for the intrinsic functions \Code{sqrt}, \Code{log}, and \Code{log10} are used everywhere, so these need not be changed. Note that all subroutines have names starting with \Code{ff}, the functions have the \Code{ff} in the middle of the name. It is hoped that this naming convention will minimise conflicts with user-defined names. The author is aware of the possible conflict with the Cern-library package `ffread', but could not think up another key. The FF package uses three data files: \Code{fferr.dat}, \Code{ffwarn.dat} and \Code{ffperm5.dat}. The mechanism for locating these is very simple: in the subroutine which reads these files (\Code{ffopen} and \Code{ffwarn} in the file \Code{ffini}) the variable \Code{fullname} is defined. You will have to fill in here a directory (readable by everyone using the routines) that contains the datafiles\footnote{for VAX/VMS one has to add the non-standard \Code{READONLY} to the open statement}. \section{Initialization} \label{sc:initialization} When using the FF routines a few initialisations have to be performed in the program that calls these routines. The common blocks used are all listed in the file `ff.h'. If your system does not automatically save common blocks (like Absoft Fortran) it is easiest to include this file in the main program. Furthermore, before any of the subroutines are called, a call must be made to \Code{ffini} to initialise some arrays of Taylor series coefficients. This routine also tries to establish the machine precision and range, causing two underflows. If this is a problem (e.g.~with Gould dbx), edit this routine to a hardwired range. Finally it sets up reasonable defaults for the tracing flags (these are listed in \ref{sec:debugging}). This call is made automatically if one uses the \Code{npoin} entry point. A call to \Code{ffexi} will check the integrity of these arrays and give a summary of the errors and warnings encountered. Finally, on systems on which error trapping is possible it may be advantageous to use a call \begin{verbatim} call qsetrec(ffrcvr) \end{verbatim} This forwards any floating point errors to the error reporting system. The routine qsetrec is available in the CERN library. \section{The error reporting system} \subsection{Overview} One of the goals of this package was to give {\em reliable} answers. For this purpose a rather elaborate error reporting system has been built in. First, there are a few flags which govern the level of internal checking. Secondly, a count of the number of digits lost in numerical cancellations above some acceptable number (this number is defined for each function in section \ref{sc:n-point}) is default returned with any result. This count is quite conservative. {\em Do not forget the few digits normal everyday loss} on top of the reported losses, however: the `acceptable' loss. Finally, a message can be given to the user where the error or warning occurred. For this to be useful, the user has to update some variables. \subsection{Using the system} \subsubsection{Errors} A distinction is made between errors and warnings. An error is an internal inconsistency or a floating point error (if trapped). If an error occurs a message is printed on standard output like this (the output is truncated to fit on the page) \begin{verbatim} id nr 41/ 7, event nr 16 error nr 32: nffeta: error: eta is not defined for real ... \end{verbatim} The first part of the id must be defined by the user. It is given by the variable \Code{id} in the common block \Code{/ffflags/}. I tend to use '41' for the first four-point function, '42' for the second one, etc: \begin{verbatim} id = 41 call ffxd0(cd0,xpi1,ier) id = 42 call ffxd0(cd0,xpi2,ier) \end{verbatim} The second part (\Code{idsub}) is maintained internally to pinpoint the error. The event number is assumed to be \Code{nevent} in the same common block. It too has to be incremented by the user. The error number is used internally to fetch the message text from the file \Code{fferr.dat}, which also includes the name of the routine in which the error occurred. If an error has occurred the variable \Code{ier} is incremented by 100. A call to \Code{fferr} with the error number 999 causes a list of all errors so far to be printed out and this list to be cleared. This is used by \Code{ffexit}. \subsubsection{Warnings} A warning is a loss of precision because of numerical cancellations. Only losses greater than a certain default value are noticed. This is controlled by the variable \Code{xloss} in the common block \Code{/ffprec/}, which is set to 1/8 by \Code{ffini}. A power of 2 is highly recommended. If a loss of precision greater than this tolerable, everyday loss occurs the subroutine \Code{ffwarn} is called. The default action is to only increment the variable \Code{ier} by the number of digits lost over the standard tolerated loss of \Code{xloss}. Nothing is printed, but all calls occurring with the same value of the event counter \Code{nevent} are remembered. This queue is printed when \Code{ffwarn} is called with error number 998. The reason for this is simply that I do not like hundreds of meaningless warnings to clutter the important ones in a big Monte Carlo. I therefore include a line like \begin{verbatim} if ( ier .gt. 10 ) call ffwarn(998,ier,x0,x0) \end{verbatim} at the end of the calculation of one event, causing the system to report only those errors which led to a fatal loss of precision. The warning messages produced are similar to an error message: \begin{verbatim} id nr 41/ 4, event nr 2265 warning nr 138: ffdl3p: warning: cancellations in \delta_{... (lost 1 digits) \end{verbatim} The number of digits lost gives the number of digits which have become unreliable in the answer due to this step {\em over the normal loss of \Code{xloss}}. Another special error number is 999: this causes a list of all warnings which have occurred up to that point to be printed out plus the maximum loss suffered at that point. The routine \Code{ffexi} uses this. There is one warning message which does not increase \Code{ier}: the remark that there are cancellations among the input parameters. This is the responsibility of the user. Most routines have an alternative entry point with the differences of the parameters required as input. The user can edit the routines \Code{ffwarn} and \Code{fferr} (in the file \Code{ffini}) to customize the error and warning reporting. \subsection{Debugging possibilities} \label{sec:debugging} There are a few flags to control the package in great detail. These are contained in the common block \Code{/ffflags/}. The first one, \Code{lwrite}, if on, gives a detailed account of all steps taken to arrive at the answer. This gives roughly 1000 lines of output for a four-point function. It is turned off by \Code{ffini}. The second one, \Code{ltest}, turns on a lot of internal consistency checking. If something is found wrong a message like \begin{verbatim} ffdot4: error: dotproducts with p(10) wrong: -1795. ... -9.5E-12 \end{verbatim} is given. The last number gives the deviation from the expected result, in this case a relative precision of $10^{-15}$ was found instead of the expected $10^{-16}$. The \Code{ier} counter is {\em not} changed, as these are usually rounding off errors. Please report any serious errors. This flag is turned on by \Code{ffini}, turn it off manually once you are convinced that your corner of parameter space does not present any problems. The next two flags, \Code{l4also} and \Code{ldc3c4}, control the checking of some extra algorithms. This takes time and may even lead to worse results in some rare cases. If you are pressed for speed, try running with these flags off and only switch them on when you get the warning message ``\Code{Cancellations in final adding up}''. If you get mysterious warnings with the flags on, try turning them off. Another flag for internal use, \Code{lmem} controls a rudimentary memory mechanism which is mainly used when trying different permutations of the parameters of the three- and four-point functions. Its use is taken care of by the system. Next there is the possibility to save the array of dotproducts used by the three and four-point function. These arrays are used by the tensor integrals. Finally there is the possibility to to turn off all warning reporting by setting \Code{lwarn} to \Code{.FALSE.}. Do not do this until you are completely satisfied that there are no problems left! It will also invalidate the value of \Code{ier}, so you will have no warning whatsoever if something goes horribly wrong. It may be advantageous to change the flags to parameters and recompile for extra speed and smaller size. Approximately half the code of the package is for debugging purposes. \subsection{Summary} The following sequence has been found to be very convenient. \begin{enumerate} \item Make sure that the system can find \Code{fferr.dat} and \Code{ffwarn.dat} and that the routine \Code{ffini} is called. \item Do a pilot run with \Code{ltest} on to check for internal problems within the FF routines. One can also look for the best permutation of the input parameters at this stage. Please report anything irregular. \item Run a full Monte Carlo with \Code{ltest} off, but \Code{lwarn} still on to check for numerical problems. \item Only if there are {\em no} numerical problems left, you can turn off \Code{lwarn} to gain the last percents in speed. \end{enumerate} % #] the error reporting system: % #[ the scalar n-point functions: % #[ intro: \section{Scalar n-point functions} \label{sc:n-point} In general there are two routines for almost every task: one for the case that all parameters are real and one to use if one or more are complex. Infra-red divergent diagrams are calculated with a user-defined cutoff on the divergent logarithms. Planned extensions are \begin{itemize} \item the derivative of B0, \item fast special cases, \item six-point functions. \end{itemize} Please note that there is also an entry-point \Code{npoin} which returns the scalar integrals plus the supported tensor integrals in a form compatible with FormF\null. The number of digits lost cannot be included this way, however. It is provided on request to allow old code which used FormF to run without a CDC. % #] intro: % #[ 1point: \subsection{One-point function} The one-point function $\Code{ca0} = A_0(m^2) = \frac{1}{i\pi^2}\int d^n Q/(Q^2-m^2)$ is calculated with the subroutines \begin{verbatim} subroutine ffca0(ca0,d0,xmm,cm,ier) integer ier DOUBLE COMPLEX ca0,cm DOUBLE PRECISION d0,xmm subroutine ffxa0(ca0,d0,xmm,xm,ier) integer ier DOUBLE COMPLEX ca0 DOUBLE PRECISION d0,xmm,xm \end{verbatim} with $\Code{d0} = \Delta = -2/\epsilon - \gamma + \log(4\pi) $ the infinity from the renormalisation scheme and the mass $\Code{xmm} = \mu$ arbitrary. The final result should not depend on it. $\Code{xm} = m^2$ is the internal mass {\em squared}. This is of course a trivial function. % #] 1point: % #[ 2point: \subsection{Two-point function} \subsubsection{Calling sequence} The two-point function $\Code{cb0} = B_0(m_a^2,m_b^2,k^2)$ is calculated in the subroutines \begin{verbatim} subroutine ffcb0(cb0,d0,xmu,ck,cma,cmb,ier) integer ier DOUBLE COMPLEX cb0,ck,cma,cmb DOUBLE PRECISION xmu,d0 subroutine ffxb0(cb0,d0,xmu,xk,xma,xmb,ier) integer ier DOUBLE COMPLEX cb0 DOUBLE PRECISION d0,xmu,xk,xma,xmb \end{verbatim} with \Code{d0} and \Code{xmm} as in the one-point function. $\Code{xk} = k^2$ in Bj{\o}rken and Drell metric {\small $(+---)$} and $\Code{xma,b} = m_{a,b}^2$ are the internal masses {\em squared}. \subsubsection{Comments} The maximum loss of precision without warning in the scalar two-point function is $(\Code{xloss})^3$ in the basic calculation plus \Code{xloss} when adding the renormalisation terms. Numerical instabilities only occur very close to threshold ($k^2 \approx (m_a + m_b)^2$). The function can run into underflow problems if both $|m_a-m_b| \ll m_a$ and $|k^2| \ll m_a^2$. Note that this function uses Pauli metric {\small $(+++-)$} internally. % #] 2point: % #[ 3point: \subsection{Three-point function} \subsubsection{Calling sequence} The three-point function $\Code{cc0} = C_0(m_1^2,m_2^2,m_3^2,p_1^2, p_2^2,p_3^2)$ is calculated in the subroutines \begin{verbatim} subroutine ffcc0(cc0,cpi,ier) integer ier DOUBLE COMPLEX cc0,cpi(6) subroutine ffxc0(cc0,xpi,ier) integer ier DOUBLE COMPLEX cc0 DOUBLE PRECISION xpi(6) \end{verbatim} The array \Code{xpi} should contain the internal masses squared in positions 1--3 and the external momenta squared in 4--6. The momentum $\Code{xpi(4)} = p_1^2$ is the one between $\Code{xpi(1)} = m_1^2$ and $\Code{xpi(2)} = m_2^2$, and so on cyclically. The routine rotates the diagram to the best position, so only the swap $m_1^2 \leftrightarrow m_3^2$, $p_1^2 \leftrightarrow p_2^2$ can be used to test the accuracy. There is an alternative entry point which can be used if there are significant cancellations among the input parameters. \begin{verbatim} subroutine ffxc0a(cc0,xpi,dpipj,ier) integer ier DOUBLE COMPLEX cc0 DOUBLE PRECISION xpi(6),dpipj(6,6) \end{verbatim} All differences between the input parameters should be given in the array \Code{dpipj(i,j) = xpi(i) - xpi(j)}. In the testing stages one can use \begin{verbatim} subroutine ffcc0r(cc0,cpi,ier) integer ier DOUBLE COMPLEX cc0,cpi(6) subroutine ffxc0r(cc0,xpi,ier) integer ier DOUBLE COMPLEX cc0 DOUBLE PRECISION xpi(6) \end{verbatim} It tries 2 different permutations of the input parameters and the two different signs of the root in the transformation and takes the best one. This permutation can later be chosen directly in the code. If the requested three-point function is infra-red divergent (\ie one internal mass 0 and the other two on-shell) the terms $\log(\lambda^2)$, with $\lambda$ the regulator mass, are replaced by $\log(\delta)$. In all other terms the limit $\lambda \to 0$ is taken. The value of the cutoff parameter $\Code{delta} = \delta$ should be provided via the common block \Code{/ffcut/}, in which it is the first (and only) variable. This infra-red option does not yet work in case some of the masses have a finite imaginary part. \subsubsection{Comments} The maximum loss of precision without warning is $(\Code{xloss})^5$. Numerical instabilities again occur very close to thresholds ($p_i^2 \approx (m_i + m_{i+1})^2$). There are discrepancies with FormF for t-channel diagrams in case $t \to 0$, but there are good reasons to distrust FormF there (the limit is not approached smoothly). The $Z$ vertex correction to an $ee\gamma$ vertex with one of the electrons slightly off-shell is stable only for one mirror image. % #] 3point: % #[ 4point: \subsection{Four-point function} \subsubsection{Calling sequence} $\Code{cd0} = D_0(m_1^2,m_2^2,m_3^2,m_4^2, p_1^2,p_2^2,p_3^2,p_4^2,(p_1+p_2)^2,(p_2+p_3)^2)$, the four-point function, is calculated in the subroutine \begin{verbatim} subroutine ffxd0(cd0,xpi,ier) integer ier DOUBLE COMPLEX cd0 DOUBLE PRECISION xpi(13) \end{verbatim} The array \Code{xpi} should contain the internal masses squared in positions 1--4, the external momenta squared in 5--8 and $s = (p_1+p_2)^2$, $t = (p_2+p_3)^2$ in 9--10. Positions 11--13 should contain either 0 or \begin{gather} \Code{xpi(11) = u = +xpi(5)+xpi(6)+xpi(7)+xpi(8)-xpi(9)-xpi(10)}\nonumber\\ \Code{xpi(12) = v = -xpi(5)+xpi(6)-xpi(7)+xpi(8)+xpi(9)+xpi(10)}\nonumber\\ \Code{xpi(13) = w = +xpi(5)-xpi(6)+xpi(7)-xpi(8)+xpi(9)+xpi(10)}\nonumber \end{gather} Unfortunately the complex four-point function does not yet exist in a usable form. There are two alternative entry points. The first one can be used if there are significant cancellations among the input parameters. \begin{verbatim} subroutine ffxd0a(cd0,xpi,dpipj,ier) integer ier DOUBLE COMPLEX cd0 DOUBLE PRECISION xpi(13),dpipj(10,13) \end{verbatim} in which these last elements are required and all differences between the input parameters are given in \Code{dpipj(i,j) = xpi(i) - xpi(j)}. The second one can be used in the testing stages. \begin{verbatim} subroutine ffxd0r(cd0,xpi,ier) integer ier DOUBLE COMPLEX cd0 DOUBLE PRECISION xpi(13) \end{verbatim} It tries 6 different permutations of the input parameters and the two different signs of the root in the transformation and takes the best one. This permutation can later be chosen directly in the code. If the requested four-point function is infra-red divergent (i.e.\ one internal mass 0 and the adjoining lines on-shell) the terms $\log(\lambda^2)$, with $\lambda$ the regulator mass, are replaced by $\log(\delta)$. In all other terms the limit $\lambda \to 0$ is taken. The numerical value of $\Code{delta} = \delta$ should be placed in a common block \Code{/ffcut/}. {\em Due to problems in the transformation at this moment at most one propagator can have zero mass}. \subsubsection{Comments} The maximum loss of precision without warning is $(\Code{xloss})^7$. There may be problems with diagrams with masses and/or momenta squared exactly zero. If you get a division by zero or the like try with a small non-zero mass. The following diagrams are known not give an accurate answer: \begin{enumerate} \item Again, any configuration with an external momentum very close to threshold. \item $\gamma\gamma \to \gamma\gamma$ for $s \ll m^2$ \end{enumerate} % #] 4point: % #[ 5point: \subsection{Five-point function} \subsubsection{Calling sequence} The five-point function $\Code{ce0} = E_0(m_i^2,p_i^2,(p_i+p_{i+1})^2,i=1, 5)$ and the five four-point functions which one obtains by removing one internal leg are calculated in the subroutine \begin{verbatim} subroutine ffxe0(ce0,cd0i,xpi,ier) integer ier DOUBLE COMPLEX ce0,cd0i(5) DOUBLE PRECISION xpi(20) \end{verbatim} The array \Code{xpi} should contain the internal masses squared in positions 1--5, the external momenta squared in 6--10 and the sum of two adjacent external momenta squared in 11--15 (the analogons of $s$ and $t$ in the four-point function). Positions 16--20 should contain either 0 or $(p_i+p_{i+2})^2$ (the analogon of $u$). There are two alternative entry points. The first one can be used if there are significant cancellations among the input parameters. \begin{verbatim} subroutine ffxe0a(ce0,cd0i,xpi,dpipj,ier) integer ier DOUBLE COMPLEX ce0,cd0i(5) DOUBLE PRECISION xpi(20),dpipj(15,20) \end{verbatim} in which these last elements are required and all differences between the input parameters are given in \Code{dpipj(i,j) = xpi(i) - xpi(j)}. The second one can be used in the testing stages. \begin{verbatim} subroutine ffxe0r(ce0,cd0i,xpi,ier) integer ier DOUBLE COMPLEX ce0,cd0i(5) DOUBLE PRECISION xpi(20) \end{verbatim} It tries the 12 different permutations of the input parameters and the two different signs of the root in the transformation and takes the best one. This permutation can later be chosen directly in the code. \subsubsection{Comments} The five-point function has not yet been adequately tested. The maximum loss of precision without warning is $(\Code{xloss})^7$. There may be problems with diagrams with masses and/or momenta squared exactly zero. If you get a division by zero or the like try with a small non-zero mass. % #] 5point: % #] the scalar n-point functions: % #[ the tensor integrals: \section{Tensor integrals} At this moment only the vector two, three and four-point functions are available, of which the two-point functions is very badly implemented. These tensor integrals are scheme-independent, the higher order functions differ between the Passarino-Veltman scheme \cite{PaV79} and the kinematical determinant scheme described in \cite{vOV90}. \subsection{Vector integrals} \subsubsection{Two-point function} The vector two-point function $B_1 p^\mu = \int d^n Q^\mu/(Q^2-m_1^2)((Q+p)^2-m_2^2)$ is calculated in \begin{verbatim} subroutine ffxb1(cb1,cb0,ca0i,xp,xm1,xm2,ier) integer ier DOUBLE PRECISION xp,xm1,xm2 COMPLEX cb1,cb0,ca0i(2) \end{verbatim} The input parameters are $\Code{cb0} = B_0$ the scalar two-point function, $\Code{ca0i(i)} = A_0(m_i^2)$ the scalar one-point functions and the rest as in \Code{ffxb0}. {\em This function must/will be improved}. \subsubsection{Three-point function} The subroutine for the evaluation of the vector three-point function $C_{11} p_1^\mu + C_{12} p_2^\mu = \int d^n Q^\mu / (Q^2-m_1^2) ((Q+p_1)^2-m_2^2) ((Q+p_1+p_2)^2-m_3^2)$ is \begin{verbatim} subroutine ffxc1(cc1i,cc0,cb0i,xpi,piDpj,del2,ier) integer ier DOUBLE PRECISION xpi(6),piDpj(6,6),del2 COMPLEX cc1i(2),cc0,cb0i(3) \end{verbatim} The required input parameters are $\Code{cc0} = C_0$ the scalar three-point function, $\Code{cb0i(i)}$ the two-point functions with $m_i^2$ {\em missing}: $\Code{cb0i(1)} = B_0(p_2^2,m_2^2,m_3^2)$. Further \Code{xpi} are the masses as in \Code{ffxc0} and \Code{piDpj}, \Code{del2} the dotproducts and kinematical determinant as saved by \Code{ffxc0} when \Code{ldot} is \Code{.TRUE.} \subsubsection{Four-point function} The calling sequence for the vector four-point function \Code{cd1i} which returns $D_{11}$, $D_{12}$, $D_{13}$, the coefficients of $p_1^\mu$, $p_2^\mu$ and $p_3^\mu$ is \begin{verbatim} subroutine ffxd1(cd1i,cd0,cc0i,xpi,piDpj,del3,del2i,ier) integer ier DOUBLE PRECISION xpi(13),piDpj(10,10),del3,del2i(4) COMPLEX cd1i(3),cd0,cc0i(4) \end{verbatim} The input parameters are as follows. $\Code{cd0} = D_0$ is the scalar four-point function, $\Code{cc0i(i)} = C_0(\mbox{without }m_i)$ the scalar three-point functions, \Code{xpi} the masses as in \Code{ffxd0} and \Code{piDpj}, \Code{del3} and \Code{del2i} the dotproducts and kinematical determinant as saved by \Code{ffxd0} and \Code{ffxc0} when \Code{ldot} is \Code{.TRUE.} % #] the tensor integrals: % #[ determinants: \section{Determinants} \label{sc:determinants} A knowledge of a few of the determinant routines may be useful to the user as well. On the one hand they can be used in other parts of the calculation, e.g.\ in the reduction to scalar integrals, but they also are the place where the numerical instabilities have been concentrated. It is often useful or even necessary to import the required determinants directly from the kinematics section. We therefore list all the routines calculating determinants of external vectors and some containing internal vectors. \subsection{$2\times2$ determinants} To calculate the $2\times2$ determinant $\Code{del2} = \delta^{p_{i_1}p_{i_2}}_{p_{i_1}p_{i_2}}$, $p_3 = -(p_1+p_2)$, given the dotproducts use \begin{verbatim} subroutine ffcel2(del2,piDpj,ns,i1,i2,i3,lerr,ier) integer ns,i1,i2,i3,lerr,ier DOUBLE COMPLEX del2,piDpj(ns,ns) subroutine ffdel2(del2,piDpj,ns,i1,i2,i3,lerr,ier) integer ns,i1,i2,i3,lerr,ier DOUBLE PRECISION del2,piDpj(ns,ns) \end{verbatim} In this $\Code{piDpj(i,j)} = p_i \cdot p_j$ is the dotproduct of vectors $p_i$ and $p_j$, \Code{i1,i2,i3} give the position of the three vectors of which the determinant has to be calculated in this array. \Code{lerr} should be 1. If the dotproducts are not known there is a routine for $\Code{xlambd} = \lambda(a_1,a_2,a_3)$, which is -2 times the determinant if $\Code{ai} = p_i^2$. \begin{verbatim} subroutine ffclmb(clambd,cc1,cc2,cc3,cc12,cc13,cc23,ier) integer ier DOUBLE COMPLEX clambd,cc1,cc2,cc3,cc12,cc13,cc23 subroutine ffxlmb(xlambd,a1,a2,a3,a12,a13,a23,ier) integer ier DOUBLE PRECISION xlambd,a1,a2,a3,a12,a13,a23 \end{verbatim} The \Code{aij = ai - aj} are again differences of the parameters in these routines. An arbitrary $2\times2$ determinant $\delta^{p_{i_1} p_{i_2}}_{p_{j_1} p_{j_2}}$ can be obtained from \Code{ffdl2i}: \begin{verbatim} subroutine ffdl2i(dl2i,piDpj,ns,i1,i2,i3,isn,j1,j2,j3, + jsn,ier) integer ns,i1,i2,i3,isn,j1,j2,j3,jsn,ier DOUBLE PRECISION dl2i,piDpj(ns,ns) \end{verbatim} Here the vector $p_{i_3} = \mbox{\small\tt isn}(p_{i_1} + p_{i_2})$ and analogously for $j$. (Note that the sign is important here). If there is no connection between the two vectors one should use \begin{verbatim} subroutine ffdl2t(dlps,piDpj,i,j,k,l,lk,islk,iss,ns,ier) integer in,jn,ip1,kn,ln,lkn,islk,iss,ns,ier DOUBLE PRECISION dlps,piDpj(ns,ns) \end{verbatim} to calculate $\delta^{p_i p_j}_{p_k p_l}$ with $p_{lk} = \mbox{\small\tt islk} ( \mbox{\small\tt iss} p_l - pk)$ and no relationship between $p_i$, $p_j$ assumed. \subsection{$3\times3$ determinants} To calculate the $3\times3$ determinant $\Code{dl3p} = \delta^{p_{i_1}p_{i_2}p_{i_3}}_{p_{i_1}p_{i_2}p_{i_3}}$ given the dotproducts \Code{piDpj}, one can use \begin{verbatim} subroutine ffdl3p(dl3p,piDpj,ns,ii,ier) integer ns,ii(6),ier DOUBLE PRECISION dl3p,piDpj(ns,ns) \end{verbatim} The array \Code{ii(j)} gives the position of the vectors of the determinant has to be calculated in this array. We assume that $p_{ii(4)} = -p_{ii(1)} -p_{ii(2)} -p_{ii(3)}$, $p_{ii(5)} = p_{ii(1)} + p_{ii(1)}$ and $p_{ii(6)} = p_{ii(2)} + p_{ii(3)}$, with all vectors incoming. The $3\times3$ determinant $\Code{dl3q} = \delta^{s_{i_1} p_{i_2} p_{i_3} }_{p_{i_1}p_{i_2}p_{i_3}}$, which occurs in expressions for tensor integrals, is calculated by \begin{verbatim} subroutine ffdl3q(dl3q,piDpj,i1,i2,i3,j1,j2,j3, + isn1,isn2,isn3,jsn1,jsn2,jsn3,ier) integer i1,i2,i3,j1,j2,j3,isn1,isn2,isn3,jsn1,jsn2,jsn3, + ier DOUBLE PRECISION dl3q,piDpj(10,10) \end{verbatim} Now the only assumptions that are made are that $p_{j_n} = \mbox{\small\tt jsn}_n (p_{i_n} - \mbox{\small\tt isn}_n p_{i_{n+1}})$ if $\Code{j}_n$ is unequal to zero. {\em This routine should still be extended}. \subsection{$4\times4$ determinants} To calculate the $4\times4$ determinant $\Code{dl4p} = \delta^{p_{i_1}p_{i_2}p_{i_3}p_{i_4}}_{p_{i_1}p_{i_2}p_{i_3}p_{i_4}}$ given the dotproducts \Code{piDpj}, one can use \begin{verbatim} subroutine ffdl4p(dl4p,piDpj,ns,ii,ier) integer ns,ii(10),ier DOUBLE PRECISION dl4p,piDpj(ns,ns) \end{verbatim} The array \Code{ii(j)} gives the position of the vectors of the determinant has to be calculated in this array. We assume that $p_{ii(5)} = -p_{ii(1)} -p_{ii(2)} -p_{ii(3)} -p_{ii(4)}$, $p_{ii(n+5)} = p_{ii(n)} + p_{ii(n+11)}$, with all vectors incoming again. % #] determinants: \end{appendix} \begin{flushleft} \begin{thebibliography}{999} \itemsep 2pt plus 2pt minus 1pt \frenchspacing \bibitem[dACTP98]{dACTP98} F.~del~Aguila, A.~Culatti, R.~Mu\~noz Tapia, and M.~P\'erez-Victoria, \textsl{Nucl. Phys.} \textbf{B537} (1999) 561 [hep-ph/9806451]. \bibitem[De93]{De93} A.~Denner, \textsl{Fortschr. Phys.} \textbf{41} (1993) 307 [arXiv:0709.1075]. \bibitem[HaP98]{HaP98} T.~Hahn and M.~P\'erez-Victoria, \textsl{Comput. Phys. Commun.} \textbf{118} (1999) 153 [hep-ph/9807565]. \bibitem[PaV79]{PaV79} G.~Passarino and M.~Veltman, \textsl{Nucl. Phys.} \textbf{B160} (1979) 151. \bibitem[tHV79]{tHV79} G.~'t~Hooft and M.~Veltman, \textsl{Nucl. Phys.} \textbf{B153} (1979) 365. \bibitem[vdH90]{vdH90} M.~van~der~Horst, Ph.D.\ thesis, Universiteit van Amsterdam, 1990. \bibitem[vOV90]{vOV90} G.J.~van Oldenborgh, J.A.M.~Vermaseren, \textsl{Z. Phys.} \textbf{C46} (1990) 425. \bibitem[KLN]{KLN} T.~Kinoshita, \textsl{J. Math. Phys.} \textbf{3} (1962) 650, \\ T.D.~Lee, M.~Nauenberg, \textsl{Phys. Rev.} \textbf{133} (1964) 1549, \\ N.~Nakanishi, \textsl{Progr. Theor. Phys.} \textbf{19} (1958) 159. \end{thebibliography} \end{flushleft} \printindex \end{document} LoopTools-2.16/manual/PaxHeaders/LT216Guide.pdf0000644000000000000000000000007413266106246016163 xustar0030 atime=1648161785.695698232 30 ctime=1648161793.715764879 LoopTools-2.16/manual/LT216Guide.pdf0000644000000000000000000104076313266106246017111 0ustar00rootroot00000000000000%PDF-1.4 %Çì¢ 5 0 obj <> stream xœuRËn1ÌÙ_á[ÂåäÖnë•EcÙ‰9¦X»žVBžj7h¹r‹Õ;ÿïþñÎ->zv‹«þ[^¿Ä²zåÏÜåʯŸµ [ÅœåÔ7-†n\»¼O¶½Æîa. 0”¤f ókÌÚH0øSµÊ\áË(“I†°(†˜ð¨Ë.6©ÀŽC–ŽáɵŠPRA¼<†^¾÷~l´áEhl¦­…MÏ*‰ÀÒÏOTö†d.áª'™3ñþ¼·˜Ár‘~F¬ÝÃò¡Øendstream endobj 6 0 obj 436 endobj 15 0 obj <> stream xœíZËnÇ ²¼_q³ÊL;ì÷ëD¶3°K``v I‘¶IJ¢(Çü‘|ƒ?ÓUÓªžéKRŽäda0[w¦»««Nzô¼ÞŠInþ—ÿ_nžùíٛ؞m^oäüp›ÿ_nÁ ðO)§h­Ú½Ø¤™rëÕÖ‹°=ºÜ|5¨q'§à­Œÿ<úëæñÑæéæõÖØ˜ÖÙ™)l½ŒS[m¤`ìüèpspøùöæúíéæàË­Ü|Šÿ{ôÅÇðçð“ío6·Oï’ÊOÑ )Rie'•ä:ao-œÎÇdÔÎ §ãN©09e†“qçð¹öÃõ(á7¡Óó)aõð|Ô“4F‡ò¦uËQNÞ©à‡·£˜¼&˜áæh;Åah¦¨…Ri!ƒÒÃ*H©%['YøY¸áͨ&£ŒnPP¥ƒ|}ØÔMAEŶÿߌÖÔùÁ³ÀÕÌŒTrtzøŒ¶9úI{Üs¹Ç|UE:cœ¤p=¥£ƒ#z‰òÂÑ ˆ!Óæ­1´žÀܱìþMÕN³z²†#)^ZYô½Ÿ‡V*«FÅ‚hØÃ‰2Û®­  aƒÍ¶Q£ªÀ×þ#® Ú´~øâC!eߤ$ "‰.½#Ñåp•°hg"á$ JvlÎU^HTA­¨PÄéå˜R‚ ÀDÊD¹(LÀ‹º,mpŒóÃdaR¨—š u‰[i%|ÈJQ žF>”DÁœ VŠjÆ ‡ HPn´ü dv’ì)*h¦ó”ÉOàbl§¢R‰Ò#d”pH!L¹Ç3î<;Ä÷ãΣ1”ãVœMk£n~Ľµš¤W\s·¸9X/ 3 #85ü§/LþGŽBƒÏý°SÐfieæ[]ƒÔV›X¢g¿¡ ÖÏJN„àƒ²\þ«V¦zÔõ¢ewTæN+TÚv4m’F—p‚,š%EýÜ §}h+”°1D$Æž°´“°d³c89I¹ ÄœÄ‘­3á=<®\|E¬Îv){bž"Ûy¢î ±¦+X3y¼ÐØ‹œjå*¸UfhZ ŸFN>úlsô‡¯YÏøõˆû€­¾£ÃД`(Ìñ0•ÜÂX®÷ßWZ®nÖè•\eÉ óy8Ç¡äÆªº¹q{”D'/Äç{ÞµWŸ¤¤z¢‡:ª«%õYEž½HgL~†ï4 ¨¶-¸Ôqøz(;?š-!êtÂA£ªÉdJ*ôj ®¸·Š˜Às8…°ÃoaOXŠøA’YRFÑLˆ ¸p&DfÝBzO´:ëŽÅ¸•ƒ¡ø] ·þ›ÃowÎMöE $&I5¯**Gt£%™ëw¼àÉ 3¥e}ìÐkÀØI-ªë3ÿ#p¶Q‘°TÔ¯8k5ÞZø§‘ŸŸ¥÷Á¿Å´S;ÿ}`šgšÓð¶‘­Ã’[Z2ïè Ùb–ÛLá ¦ ïEóRzF~ª¥Tô0ágbXZOÂLÔÍ]nZ‚Ã)‰iTrbÉâ7”†,:'ü–'//Sö é9w:Tñ»ÖÛ(šrßA°J#Í£<º¬öfB0ô«£˜x£f²æ-Îö³&è5é'ü0‡î.ó·Î[LÄ*¶ê ®å'gDþó¶€Ñp²‘µ·óRœ^@%éSޱ,ªN ɤàÜI‰ÁûHàz"Y—ð¿Ee…KLöUu9éoЕ²ß°>¬‡ÁöüaD»Úïªlà({Œ÷ÓöÂÆ,/X5->Îrˆ¶¡!ýdé¸hºÌÄ îW›Lð½®6sƒX·Ì+z³¡õ¥¼wîyÞ!2UsÔ•–5³½ª£êè 3:«£«:z[GS½¬£ëÎ\Z¾©£ã::íìö†=E¢Òjöcoé3zñUçñD{Jº\Oéµ#¡Æ#«·$±h›B<n÷qQv,Û§Ô}hût½Cû4hjÞöÚ§äŸ,ÏíµøzÕ1bC¹êÍj» «˜žö€íDjr¼Wh¿èÀî¶ÀçhßtàIÎpÒY¹‡Ó—lÔAìÍÝ/^¬eèâ¹Û= ¨JbS!Õ–rãI¨×lP¼]¢åSrõ1Hb¡B`, 5È1„C”±f@Ý/Ιbݯè\ïÛ£tâÆc"‰pÁß IúR÷@R`m’ `S¨óÉ" J8¼­­ÝÜÂçPóçq9˜^xŽÙ›do)ïcM5Ù{.~e͆˞E êPƒŽtó¡½dö¤¢¤ R1…u5fw@¨!¬íŽöú?á#ã£ÿP‰à·uô}‡+Èžç§—ôÐŒ:ø0D]tF´ÊU/DÒAž°Q}±'õ =~hJ‰Ø“Bl…ß.“Àw©%sáæ‹ùƒá¥Aî…DJ âºW“¿Ðå‰û°ñš T[®¼ÌÝ_Uæš«t°j§Ýýì;¹º½÷nŒ)ŽÎjÑÓu-¹ÿz?â2µVw«b>·þØütÏù ögÑÈê¦;}¬Ze­Ré.÷"Bl6¥F )gå+¨…–¸–§Ì·d&ƸèD§[2ŽQöœÝì3®/Çdã4õrÌ5]Ѐ:v]¿a›²ÏCúØî6ðûNOá¾Ðg‹ô)©ûµP‚$íÌl«ËyÜ©ßõî•T,í¢ u¿‡Í¾åà=ýä¤]Hg‡Q¶¸Ke«õ•œ‘},/IH¶4Zˆ9*vct&æIÝVºNÑ^ïïÀÑ&ù¯‡Ð"d:iþÍjÍoéº÷ð„•"µÃ§ø¦°–'1l!2ðü…°Ú¼súÂàs<©5:F6™s»š¸|#+gð.ô©WÈàLë4x´À3t›ƒ7’Öúß»Õá|å"ñƒ2Ðà£ÁŒNú^§$¥sœ7Q$%QÈÈtS5hŠúògx°ôU†±‹KÓy¦Ÿ¦Ï‹€ àO¤2&{±÷Êúû\Ýÿ/?„š#:#‹¥M4}¶†+ÝA Ìu×6)¿æ«zX¿tÚ1CÈ¢•¼Úó4˜Ù£e <7Ë’ïèz:_z?ƒãXeLXw„óW@% ¸àŽg|2"C:5ü§òF¨€uÔûͦ@ `ÆôÄÄéuÙY’S˜"IúîÌy£{ë²ÄÕã=³Åy9ï×_Zµ7 ‹OLÛâEKè^Ñú¼“¢S¹ù§ÿ]:˜ütóŸÍ|Æendstream endobj 16 0 obj 2697 endobj 22 0 obj <> stream xœí›K·Ç÷S̱'öPÍâûh92À†cœ ì•´¬Ud)Žíoï?ÙÙÝÓ3ûÖÚêí®aóñcUñOöÏ›VÈMÿõÿ_^_<ùÆm®>\´›«‹Ÿ/dz¸éÿ»¼Þ<ÝÀô†´pÞÉÍþåE÷K¹q´±Ög7ûë‹ïšÏ·­°Æj×üw»k…ÓÒZß¼ÝJѶښæÛ.µ6ºy›Ê(Eýc#õðØ´ªù/UP$¿ßÿ£{½”"CñõF i[\~y±ÿëwŒÆÞzcË¥Þ·±Æûç¨ã—ј`+©DPžlåH7ïÆ«ýV¶AH%ÙÓ|õµv–”EUI(´Ÿ«©VFHÞmºŠjÛÛ¢™í®7Þšžš“׈ةx½ÒénkŒð²ùûv§9C] ‰òS’Ðd[‹nÕ·æ‡ñý¨?L[ï¼”ãÖ…Öq£üË×Ü<õ‚³¸j‹`ðP9„ÈxiZBݨº\58Åöá6±Uù®®.W N°Pii„Ö#íx.U°˜.|»Á0Ñf‚?DeÚ¾ÆØ·ÎhSÀöb»CÕBp®Ù¥‰!ñ«z¦%bº+Ô3mG†„ôn á? „Sù Ñ…æjœ‚ïqeT@QK\Ë„3…ŒG€™+1Sî·ÇŒT…Y° ³éÝh+½pÄûm@€°8pS§Hæì}äÌá¶F|Ú)a-Dª¶$ºúåµôŠLó„_;Û\F÷nZSºÀéû%͈záÃÛpæé„Š|¢l „Eœ?ŠÊÔLF=RÁ©ù?†8´­7ëÃ:#C½±2èß‘7/ŒÖàiH²q4¬ØWìe±HpPnóUÄ9bÈ^uM)xiˆ£ËkËE#:Ljì3U=pBgGNØ£)•CÛcdùy,º]{]pr9dz‡è#æ”: lÌ.cHÔqìý–@%Ã Ì ¾æÙó.zSø=Ü%K‚¬j~ÜÍù}hC—`ú"6ÈÎsœsÚÞÁﺞ";&ÁRΘ½‰ó :æ…¶äå\b‹Æ[–?vç’\2wÖ–A=vTÌTk1ó„„Ñ™I./½ °Žs.0?—f¦ ä¶c=Æ“…¬ÐØsܼS);k@2=L¸Š®áé¬{< /šKÉ~ÅÐ{ïTë™GÛd Wqáܬ ©î.¦± ÆÙ3]·¢K «^WE—Êtý cà4wXݺϗƒœCçº~m}^ñjˆÒc²yoAI*AG°ãiÝÐcAýûA[¨SË΋zºGÐyáÉ=h #<ðF"Øi¢pZ0¥jÚ𢩾‰»ÓÜÝad$9 Â+N»dNú"°Nbì,ÑKtƒ‰ttL+ëÂÙ÷%ƒÎáÉy‡Çxé}Ÿ¼¥ï3µ/JÕ9y¶0ÉÈW·”¨árˆ±Hµî.+œ¥?ÇØ[q¦pv£ ÎÎqVRÉSüØœKc&›uþé(‚I»æ›xnÄHÙú²^C Ø)Î…ÛôÚ¡ü|X¿s ;•+,«\3® §TJ[a”¶n¶,e³Ãoc¿ÒV.õ[Æ ýdû²Þ- c#–Ëý´Ã> G‚°P,>¯gkЋ"¡Pvûˆo²cñ&ퟆlãsçæº?%^ÆxQUÌHâsóë2uÎIfç$ï«qBó|‡å—†3iÅ{ éT¸À‚ëT©; ã*SýY¦:/#ÆN*¤µ´FÃß…ÆÀuñìáfo[€žã¦+Ž>õ¡ó©æë²ú°(d] G†gÎWXd÷ו »w¹ Õ‹ô¸>c‚Z;czc£û—³=ªÂ/e]äUç ã{k¥9ú¹<VœþÛØ•X‡Èœ±-±­ŽâÂ÷ ·æÌ-ã–è'¨42=äìæ'ãÍO¶)¦ô+ž³›=‘W·Äë$ã)?ùÙU"QŠùóÏâƒÃ2>ž$Á8ö¶ѬEš®µù#£÷y˜_CÊžáÞÛ\Pñ-Dÿ|î³(ï…’! Üs€ñj®qÒ +ØBʬ&ù@_•_òÂk©VJãöX"ËæeÕÇõ§RXÄÈz‰Àür1àœŽ¯\ÿÎ$oªgõî9oиF¨v)#e5 3Ù9øS$þÛ|N2_‚G®R· ËÔl3ʘ=ÍÄ䔹ulo"1Ó!ƽ…­‰-óªuöÛ’Ÿ@Ù½¶¤;y‘oQŒUQëŸ&d‘mœ K_aU¢GTžUe’ëç û>¬>+ ™¶·pPà-ÓBJÙÒz> stream xœíšMÛ6†ý+t” ˜á3òØhQ´hâöRôÐnšm€ì¶iÒé¯ïP”MJ–lÅõ¢¶cìaõARÔòÙwÞêU¥T:þt¿oîžpuûz¡«ÛÅ«´7«î×Í]õéJÈ)€ D¦Z=_¤žP±©Xûju·ø±Æf Ê3AøiõU×Ã(0šc­‚w!=Ø!C¨6×ÐQç³fi•s–Býmc•æ@XÓ,e,âzÕhÅ ¥Eý8>Òx7Ùài€t <¥í—`…¾r 2±4‡Oš%ª`ÐA­š¥ÌÓ²ÅÚ¤7DçWƒ&eäq«†äª–£ñ¾öì|}O¬Öp}ÃqÐ\ßǵ­oeª2 Áúµ h@iÛ>ƒQ2L<$m”3}¸·íé¶ÕÖæ«88ÜÛà}Ú |@¡ÉÖ6¯3n#A²*µÀóõbõñûQbKJ‚¬®3¡þ5BË!0Ë¢…†„7 *¯µnAðV+ÇxŽ+ú!àA=<–†•«–B‰ˆ—¨Ù³I%‘!˜Q±3õ—±a2ГƒÄƒÓ®àáçüà—¥¾¼,5¥h”{öäè÷¨4ì䲩þ[–5híi½˜’“l¨É7{Ôн•™;#žàøÌh9È¥ù¡‰Oöl—‰§£Hõ¾ÏݲuKî6ºe8 YÅ6(*Žäí½ópÄìOûƉ)ҾψŠ~8û¥Y·ü+FAÒè±(ä£hÅDf;ºÙP"•zJ•§ðb$©H'½;Ã)ÅëWÖ?âË#-†N¹|äÐé%tºk‰ýh¤¹i&(0óJ\îòŒ|õp¿µã˨ýýœ6ÿ †]R9¨‰ÆÚ|.›­KS¹®dŒŽå4ÌÛÿß ¹âvopÄñt1,bw·;Ñü¡Ä®õ8lFt§,nö)$¡`7‡2–´.†r·-w‘!~=v¥ëaS᮵¥Ùz泞–óóÏÖ–õèg€ÛxlË\÷QX[ãb:".¯ /x¦é'ÅKTÓd±žX¿±EâöƒVt*@ë‰|?¤•¬4ðèׯ&¥#9?6NÞmý,}UËÄ;ÐN› í¨zûàn}Ü6Ü\knAQgO×ÊÇÜ2} I<[Ô¶9Yè8…&ShŒB{¥ðü),ö#õ4…‡i¡ÍâƒQˆW /ŠÂþ¾ÕãÕâ;ùùpÞ°endstream endobj 32 0 obj 1466 endobj 38 0 obj <> stream xœÍ[Ks·®ÊqÅwïïGŽIW\rRvè\l$R¤‘’LQ¶åÊ¿H~pº ºÁìR6•J©Tg0@£Ÿ_wƒßoÅ$·ÿ•Ÿç7›G_ùíÕÛØ^m¾ßÈôr[~œßlÿp”Ù*3ùàåöìr“¿”[¯¶ÎÙI…íÙÍæ›ÜËI[­ÕwgŸã7Ž£ý¤à£³ ˜ø& a¥Ù½ÞÄät.4ã7l|¶—RÁ«“¯÷XÏX¡woq¨£ò…†°•rŠÖ*$áh8  9“¢§¨½BR`cd£7¸\ðVF¤BÄIJ9¿6!¬°H bL¨É8d¦ÉH°"ï]ñO!‚R†D{ “†áXD¨É)›IP&úˆO‘G>Ÿw~Yégo¯êÃg°Ô“rw L÷NidÃko…ÚÝâ>ÀíÓÌ H r÷,b š¯yIµÞE¿{·GæGãš)w{wŒ°ns®¼f÷ ©ÀŒòL‹/‘„8 á-ìk”ŽŽ·$ ¯ÉžÏgh&¿ÂÉÒ[<¸ÈÌF' ጰ;.ŸK$…uþ°|¤-,ÀÖ:$&ÓRKŸÑäªPå*·2k95w{Ô!-â¬/l'’ñ-Œ¬v1¬Š uR€fy»{ ’‹:ê øl:6Ûaæ›V…ì B¡÷LÜÏÍ´ÀÐmDwqžÙàŸëQêhd;ðÐ1̼Xšé†ï$„/,ñÚìÞÃC™Té3x&­À¼ —ß^MhÂÏÕ$u¶–(€Õþi ]ë°ûì)àkÙÊä"‘‚™eÀIßJŸè" ºÝ+°fð‡ì(À}­åd@zßTɆóþÖØÝ?’Ïà)Õ.­‚†ßÍê ç³àtƒ3»¿ìfR¸*HNå&Û3îgš”åVMÛ7® ÚYÃý— °17ÐN§²°äÒ*kŠ&ð¾ï²Å€£UQZ«Ð (ðºátrgäív7øX …<,$z¯˜5ÆJ$t›HdŽk'ó¥ûŠVÄ`uä[fW"r4Ã1“TÉpL>VZNÅè€É ’r榰¶÷Òð”©Pç|+  PV0.ÇS¢1°M@—-Áe»È{ξBr²N°¨“™,L0Íç5šÞ—°äs‘0„ÙÆ1¶²!ãN7:‘fåzq…ÐM`Ú£)HÇÀÇ)™‘è}[ ·!  ÍxÅÝáô IilP…/Ïq"¼tjäMœ¢Œ5J²8M–Å83|¾ l_ „^ð^*Ä,|ül»9Œ3Ô°1¶\NŠ‘§*…;9Ò¶G 3#(ͪƒè¿}l#Ö 8‘yµ«õ¡W †%STysKÍ,/j*4Šþ„š[;BI#ûsa²Þ4öWlj }Î-5ïxTu€8Iw–*ÑXÀªIE¯›¼Ó€öÕNчjýŸà)Hïô‰÷fí½ª[ì×üD¢ÙÙÑ Lí)ž®šþ®æ&éä/)PCH" (ZÐ<¶äåBSÐÁí~AÒžá†ÐÀ€4{—€jïvSlãsûàÉP{ŽDcz[)@Õ%1¾¢œ¤³G¬Ü‚¢è8äß,#+ÈæÖ?£í!0ÜtÐrS<Ю×-ãÕ;°É("tõ'A*WÈ •î!UÁŒÐ ì6x=ÛÇ˰AiçZý²R@,+åÉÙ¬’¤PìÄB‘uŽ Ã1„#Èd‰¸<~\¯L‰†ûYC`Èö"#W¢ 8 ˆY<:“å΋ÓI†)'³®é!דpÔGðÄ Ž=ü]}H#ü\CÈõǼ[AÎ#È¡“öÌòûLÞx©Å“>ïj¼{N;<[@›Rzò óG/XD'Ô[–i„íDuŸ”” âÿÀa&6FZ¹d“ù{¬÷T7}4#Áor¾ÔŠ0 8hÓ|ºy/-†ú©!­p¶k1÷àNPUfÌV± ª× ¦qš\óô¥ ÄAN԰㯯õ1"Z2è¹Sv¤À3e¿ÚÛåÀ®ˆ Z¦ØiVbË j¦Ûbbíà S× ™‡¡Tn$îñ׬_0Ü׸‡Åb4ºbeÀ9È2I‘qXl0³CkŒ±11ØÎ øíŽ'ñ¾2*1v¯€`OIzD”Òæ>)0Äfî` ±UŽv•¦)£Õà<ó®Oê³WõÙÕ1J´hÐË·{dwL¾~5¤"áÁ€h¢ë [‡²®|ŸD*„6<Ñj°]AÞJ üš·þ8 ›YZÜÂÿº;Ð ôœ-5',Üÿtá}í b)ðl*—€t“ˆŽíè!ŽqÔZѬœ®e¦Ú¥èу«VͰ–Lò9CWÍ‘º¸ÅJÍž^|\Uúõ`ô&пŸw]GoëèP¿UõÙTG²ŽFoïê·dr·Õäh¹†Ÿç·Ã\^EÝ|dPtc±‰äwŸ&¡F.ö'ŠA7@œ3K©ªú,©X‚<’ÔE²÷Ë É5%Î6iåú~À57g ½?îÑ_‚Œ+v•YÍÀ“ŠÎÇëU U¼&YÑg «ÕÍ“CÅ=*r$2Š¢;>i½í§g›/7Û%:ÊíÕÆ+±U6€ûÆF Õn%²Ù¹íí³ÍåFl„ÿŸ˜÷÷£­ëÎ+”Ö5,’R^lHI—û×ÅÊ,ñšP‰®£Ìo,Ø\¬n_C~y¦ÍÅëàÃÞ›äºâ<ê½}‘ͧõ:Q~§ÓÍãNç`=pݹݿ°1‡óó:>ùwZ'¿ÌÿS}øC]ÒëÇ9áË1÷¼Jábž?#ñÉ­ç>“Ë·…Þì®2ÉS%ùQ‹áºý_1F´Ê„#â÷»úì¶Žž­ñë¦nNbxÙ}£Ù§¾ÌÜ·ŽÑøjÀÁ»:¢e®;ž÷¦»î~Þ­åâh÷lh…Æv±ðìH$VM¡¦480ô9Yv`CÜn:ðl=SKò½É¨ðY/äæXCt›»#T©nyÑÒÊ)(sæØÁ5nÂðžŠÌðP y¹¦Ç/04£¤Þ“ñæHÛ2-D‹&LŽ•òaG‰æ°m‡ÝzÌ5/¶¼¯AˆÖðo8 i _/>öWf(aŽ])`Ñ_ÅÝýRO×Xqn–nó±¼>Ò'ÓÚ¤{£ úMiKVË»Mµ~­‘öA=ⱸ6²–ƒŒ³dwµª×š>®ø²>{6†9/àÅùTëõjŽ`S ¯K¬ëå³T¬§ŽlQÔèVUSÿY¹”ÁlÐ*o?#˜Õ¼-I¥¾Â3©1/|“}Í=İÄÍ™;ò\ϯҭ-óñó«Gó·£n§¤K…¬¬]3oJ·K)ÛÌ5m”Øûîâ@_¶Ú!Ë™w¼ ¬ª±ªQcØp뼊‘ûý »B÷… /] lÉf3¢ ý´‡'Ö3N÷óNƒ¬»ÁÛã ‹UõÃüÕ©ý&Cxªé}3»îØv{xݺÕ7õíÙјÝÇâ‡ñ_ J oóŠŜŪƒ.5ñ±7¤„ðÖ²M-ÈY4¦ë­Î¯óã$«¶°~ý¿kp˜ ŦÑz³ÄÀ]½ >Á3)QÙèé1y™HYÐÈT‡} âëX4Õ¢ë¡Ú±š·³ßgÑì.<8ιñê_Hq U½OéÇcXKÀÇįÀ–nmåÈl$Ë´’¦—åøV1–x¦+`Mo/‰”Ü.ïýžPØàŸ W]õ|›J½¤Ìsœ¢ ¹µ ôåæ¿­Öçendstream endobj 39 0 obj 3321 endobj 45 0 obj <> stream xœÕZ[o·ú¨_qÞº§ðÒ¼_ô¡-´…Q7‰Þš–uu#Y¶ä¤Ö¿ï É%‡\î‘Xn ?˜âáeÈùfæ›á¾ßq&vÿåÿOoŽžçv—÷G|wyôþHÄwù¿Ó›Ýaü) ÆÈÝñÅQš)vNî÷»ã›£Lv? æáŸÇÍ3$’;œÁYðVi‘6¶Ú‰°+}Ê+&}]êOûY1k…1ÓŸqU!d°Óö³fA«¦¿ïsÚs7ï9s‚[èü‡Jož¾ÛÏR¦¼™DK[?±ý [ª ¼L"úÑ™´ La^ìLrRO/«/©,eÛã½ðÌá6†Ö¥¾_Zõ®ª$³òE˜•e^ã äH'•"èé "àL\MçpT£˜SnºÛK¸6 ·† HpnºßK¦¥‘?á†k¯§k\€{ë\ᇽfžs®§7©Ûy!üô–lr‰›8Ƶ™ÎÒqqíðáæ§°¹ÒAû¼ (jºÅ£ƒ¦(f” ~z€)Ö÷’È‹S`™8PÀH‚Ç3À‚p™qmà YšüÅ1Á‡(ŽSÌ‹î|i#ËmRnT àŒ»ãGÇ¿CHœ¾-Ï}naß»Ò:N­xÄv¶®Ë¯÷¥ïùÒ¡@hάHFí×Cfå 0ŠW Ý^Œ˜…ß–*øn—›+wÉH¤æ,N †]£]€‚€CÀÎÚÊeçVvz°\.[ŸU9„™x¬W c+fT3Ø÷@Mèëã£oÁÇØÀ@¸1½åƬ”ÌØÅ⿈“̿XX¡ÀY6òÖõïÊž§Ÿ2¾=ÌÓ**·"?_ G LJ}Úѯ…j©dþÐÔ‹KÀÉ&Cßo ¼³‹ÓK'ZyHÍÅç7Ëþ€Dä}]Öÿ©ìù¦“[gå×_®&ŒÚV*KTNðtƒú‘Á #“C’:¸°‚Æ‹“Ôaúaút?{jH_”C¥âè] —ÆÈì×{$Néé_Ð' ÆÛõÖ1œÁd I|vg©=3B-×Ë•¤×sQ:ë‰È®ñHZŒƒ ”†»¨ï¦(ý[A3ýXúΗ¾¤feÐM–賘›ªäÿÇÌmH+“µQq¯ª–J„­aôU­ei=Ô)ïjó¼‹Åíe(&xÐ\•gö Æ‚G ‡x€ºc]ò²ûÊ+ ÕG_¢8G¶Œwj=òGjoI¬9C+‚\Öm ­9wµßzœ•B1Þ°Urhý$¶ªÑ¢­ÎFÀ¡ÉÞ;ß–÷¥ïCé;)}×¥¯ÊÐ÷«ŠºÖäg @Ëc+¸òG³›t}‚‹aÈÛ\•ô3ÛS{2 À#»v9Å,=˜‘z•^b|—Ò¤T+ÁÅN¹‚cÂwcˆYlQ4×àÚL¼ §^lg´»2pYËîΠgAáuzV.œêñPÿ ’ ,šÎ,¹:š[5õÜ àõCàpß²*f¬--ßõa:—¾é)f[•}\æŽàa ãÄ‹&•¸yv#Ñ…n|ïÈÜÞ•¾«YÎ¥ïeéû¾´¾)¿ŠCFkä5mƒëÖ˜f€ÿ‚E é¤0Ù7é  Úµ§Þ:•„m³ãŒÌ­€=ín€ jÜlÅøP7ÙrLeôÎP¹¸TÈÐÞ  Gȧ+Q8°`ZÔL‰04æªÌÊA À ¾ÍAÑHbKÄÈÕ él­-^Ø! Î V m›á×Fº­(o±Â6IÆÅ^ÂvZ;²ÀùÁ£ÀTDa“m™'ߕٴµL‚ÚÈ5æ(oœ ®¿¾„í´­Ö=‹Áø»hZ¢TUc`. X„ä¢YŒ[¢n͇ƺ-™ªšþ ZðÂN«§•x!9ž9ßDkFË-*.h¸Y4bìô3ˆáCð vÚC …(<ë·q\å-vÆj-‰UídÙ…çiC‚c=,·ä^ÔОáý“æu%¢s‚÷G b„ÚæŠš?*D’ ½Å,)ns™­n½ä|ué9×Ì5Âû,y=Ùã´)¤Ú¶ýhJÊÎX/}\alæ:éšK7`êθG… ­÷«¾,߆FÀ¹e¾£‹ç%™;mÃbNæf`ÌÚ_ JoKßIiUÆœÙqX‚j÷s]°þúª# ØW‰C Òí& 6WùÇ}·ÉF”ž…ß ß^IÑ:’Aà® ³D·Z3-á«'¤$œ(kæ |Ïâvd:7ï¢Á×Ξ¾G–¨W1µ‹—='Mo¡–šß¨ò©ì‚ëoÊÊ¥5,·Û¦ZþòÀ‡=pZ¼ýHq›B@ø5u|ËÓ+УŽÖZ á'Ç. %éP)©¨Sú÷ §ÖÕˆ3†’ÑêpÈInt=­{#‹-,œIb+àJbêœìcLKBѵ%~‘ ˆáƒ‚êÃ9Å?X[z,l S]BvsÓ›ÐÑê/u=Bke üˆ±± GTíÓa>/wÈnf ÀH¡—h¸b ¯ç$§0+H8ánÊô–[’\a«9G±Á ò 0¤È[ügTe"ï -jaÃwK¢úºCÙŸ¤³¹¢#wÑù"¦OYˇhJÞè!…q Êš”~†¤áÕƒËRÈ“›zCÑO±Ûr±DŽ×WHÁЄÎðšddVý>0ËÅð‡r¡ÖCÎùÌh,:ûUòi!¨U2 €ª‹Z”9rãj2øÛDÎë¼!ŸÜB— ³Û.ì> stream xœÕ<Û®$G‘ûÖ€Ä[‰—ítMÞ/B<`Y¼ìØŒ„„áÁŒ=3–Ï›ëììò‘—ʈ¬¬êîsŽ-ÐHsº«23"ã~Éì/&1ËIà¿ò÷Å›Ããýôê˃˜^¾8Èôr*^¼™Þyà«T³TÂOÏ_ăÓFæeœñ2NË3¯&/ÂôüÍᣣ¼9É9x+ãq¾9Áíµ9*öÔZ}üŸ= o=þòæp¤²ñøS!ÀÇÓœ½SÚßϽõdRûô ¦Û8+OoNfVÞ*I}~#f/•¶®Ký žJ…wÇqš•R„ãOðcTÖé ÖYsü³"Úß=ÿ¯B9GkR&ÓTNVÙFŸ÷k\ÈS”™¤Ÿ•´§œŒÕÓIÃéù'”f¶Ñ,z$ZŒavÎÀvOz66HwüîÌTý´Ì³@-ødƒÎäªïÿˆOÎÓ‚†(¤—œµñÊÔU5㫼–r¶p@ÐWy¨Ãñm›öqÙ§ÇÛ<Íü2_:5"˜6¸ï÷Ï¿ÿÑñ]Ü—sÊ"†zŽÞ …¸o€xBÃRˆ©…OŸáSž?i‚ò)ó1zˆ)ãg[0sB˜ãk²Ž´zöÚ_.ÒÕÀÞRå‹R†2ÆÁr© Ák•ÏèŠò+ãg”z…5*a„ ²ŽÕÀMúø-Œµ:"/ƒh(+g¡lABǸµ@ÖcF¸ã´ö %À)ÇP ‰RÎ6Dph›È(ºÈ^¿Ái*iÑxdü{Ïìô×C±/Ó/ÊH Ü~jøóæ œKßUú~{øÕ2öóƒ²@Eï'+§ \0”tÖž”áÀN ü€ÂÎ"¦'|ÒíáõáeëDà`C¨`—yÑE° X^Û *ÓÚ| <Ÿ”ië0­eL¥@—0mà“PmimŒ›­"ÐûI ØBÐ ¬t™·±®Ý¨¶€¯„í'`lñ÷Tt@‘6B ð!ø=M¼mßA¨ÙøÂ,¶êYå‰ `ÙÓľk ßaU—†’ït<‡¶¹Tp­#*®Qp܃ã{«+d(¡ÛKùnÀšI9ïð¯E»¤¦eçéÛ m 8ÛöÚðɆ¬£Ëw`Lj“%[[ÖÑtyøäÀÖn;Y¨Q¿G¾“((´ü줾6|²!k·ÏwÑY;#;©¯ŸØÚ(ÅšñdùžÉªµ¢i2¬)Y—å2Ñ+´Ê“™òº Z'ׯï¤u™œ‰¾hëvR_k>Yw<9ˆ®Ã-@`_4;“#.îz†[BǬ+^>þ0Pp' û/´%^ûS݆aŽÂ+œ‚‡ðkÇ,Ò‡ãÁ:Òy5"5D~ o:jÄi™‚F?º1”À8 Á•á¿,F¬õ! T!âh»Òú"}tMÐÒŒð÷³M«Šó´9I‡@'†È½ðfË«$ˆóœBÅ/`°òNk­"®£&£f+ÕØˆÇÂB`øõiÁP—­ý\È=¢ñ]e¡*c?‡XW[aG³ D›„JZˆu/ ˜ D€‹¨?$æ(NcÌG<@$þ$ L4jËdPª.¿Y2¾Ñò1ËÒ…zÁÛdy¹|iB”]ý…ÏÀx £A{$äDàb.3œôܸž”òhQO.±<£$Ð2n¦S5u€H×ôÄ:U1)\MTdŠ}B62ž(U&š€ÑD«eyd>K)*$Oü¤ä?N¯²8„-¥"ˆ¿&k°Ñ˜åš€…ƒ‡É¢RL ió_'ÜH AceŒÓ 2êˆ ·jc Þ 6æ ŠJ„—Õ*ÐF…µg ?5dѨ”Ó£þ2Í9Ù¬˜Ã¬3Xê¼¥P`’aU­ÁªÒ÷¡ÃÃååìîÕik$âad¨Â}ÅN$D\V­7â­¬díCÆ9o£D!ÏnN ª“qla}Òv­¼‹w6¾´æ&MLc$e*Æõ4ø”ÁÙÀYÃt—çnw¸56…êÖ8pcÌÆ>¡r•Š_Z!*'¤‚4à€ È#†“*`iò§‡ÇOÿ{úêíŸ?=<þõ$Žÿ½óì]øóôÉôèðÞÓéƒ+£E€¸M¿P¨EÕìÔwÈx²Üw+ƒ j@˜F|H¸Q`$ò Í{Ò)Ÿã®P'5‹¸Bô %‰tôž;ø7®c„4úm*:äBŒÁÒÜ>BÇ !õ)ÖÉ xb1PJÒž¼f‹Ãú ‚ECÖRUöÌ'I\³®;2Ç,Ú“í€Ï×° ,0’¶ÚÊaät¹eÑ:xTTx¹!ÈšÁ ¤ðÊ/jJL‹KQ¤mh+ÒßÂAö‹µdþ£5ß‚gÊŸqïm{‰yÓζ‡U{ѾÑi6µ©>bGÀw;jH”²&iøƒF†à€Æ “ zß¾9Apî­ÐrÚßâíë ÿبo¶z¯À˪8Ü }•m]õr–À(“ñ²ó7åXÚ`âhKÐû»¾ê¯1«œ`(Œ§GVõÆiÀå$\À ta–•ûûÂrdÇî“Ü),'JþÞ¦ÚéÿÞ£g³XjÔ¸[ªˆušrdD•ÖX% 9V¤žd)_¨+Q1ˆ!µ[ŠÌ ÃÝ=rÅ#·P<ÖI»‚móͯm™dâ‚Æ ËÛ è­4}Îz5Ži‘£1 äƒË ×ϳSë ‹q6Ë*#–}Ç=Fåx_·â¢Ñ×Åeƒ[÷ÄC×èÓ´Ê_猞wZ›6*uýµ,Iì…~·«Ù6R‰Y E0–úÝÿÛQ˜¬]ÃNtƒàðáâUfcäÖ6/D@‰(ñ¸[áQʳk¨?ÞÑ®Í_@è®Ú€,Jf_Þ€xÃ~”9VP.CÜjômØ·®sYzXÇï{mÃæÑ©znÙ<¶¥mCœUp[…•ÚóQxG%ZCääOEƒw:W ð%–±BjÖ¶‡£¨¾·ßÔ†56+›ç"`û†+2¢ôƒȨ«×¼’©ú$ò~·£j7dHغå0™_B„ì÷2y¼:ÚtÉ­H­QUjƒ_'°qï@ö “߆/?‚¡x[­+5+@ аÒì›k,,iêôü ¸ã”™AÌ6ºíã@˜rî|—~‘E’Lrÿ…Í¿—aöçQ´VóØa­|bî…[¼ÐSôo'} ¾«³`úªBÊ]†yÝÕA¶É?D€7êÁ¥d‹XgŽƒlc›ôYeJ²ãvêWÑ Mÿ#1Äy–±£ºBv†é¦ú⛎5©›f‡ÄU+%½à$Îê÷…ú_üÔ„ºkªÃ”¶¯°¥’Ð(UÑέ+l÷v#o ;ZAzYÅŸz¸LA64µÚòú})¦^ˆeU¢ºÜra8?Zðú9®,¥ˆÌ·>Ã÷VÀJ±= 7x´WyüÝ2½¤£©_<¡,—ó”ò9þ¦•œ Ö$apŽhú «å´,¸¯š‹ÕÙ¥›rþãåzendstream endobj 51 0 obj 5042 endobj 64 0 obj <> stream xœí\Ë®$G/ï€ÄªwTƒ»È÷‰…_%ƒ¹bc[ÂŒ=ãÁã±gÆ<ÌÿòœÈ¬ªŒ¬Êªîº¯1y1×}³*###Nœ8™}_D/‚þþ}ôÕÕ/>ô‡'¯®ÄáÉÕ‹+™~yþyôÕáík ÀÿJÙGkÕáúñU~R¼:x×_]}Ô…ãIöÁ[?¹þÝð„꥞ž} N™'vÆËx˜>ÓA÷*”W½s<éÞ9im÷z«”*ºî­ãÉôQY§»ßeïM¾»>ŠÞKáðá{4TgM÷áñ¤´íu°Ìfºþx”:ê ²‰¡µ&cco˜1ï5òÊt>à¶LÓ^eè}”~ehyÕÇŸŠ¯Š%'<™pÒ®:ÂŽÏ`G^©’Ñt_ÐB$Ö$t÷9–Š9£÷5)ò« •¥W¼€ÛüÖšÔöS™qèOi „‰Qw¯0ƒ ½5º{J‹àƒ”¡{ŽÏ6Ç©îÛ£éƒbišÓ½ŠÆNÿb… ¦ûŠ>ÖBТÊBº—ðŽÕ.†îÓ²{eޝÉyÞá§—4|åY¯ì}uT½QN¸b˜ÞŠê¾›6ç›´£&úX¿à^ ­°|®g|Àð?Ö»èñ¾d›ÀzS¸:¥LÖ8©Õ°#9AyÙk¼  lzƒ»ë)Ÿ«¼ìy~™ ’/#O«Oe$û5[Ï“É ×““Êã/EZÀ4)> ô00ˆöÈbŒ–'°úÁV±£”êþO‡ÃÞÞ+æ²¾ªöBÚ„•ÍOÁbxlrˆÞàØcC”Z·\g@K;iƒ @JŸ“(-1Ïá€l¸£aÞŒ~ÖòýËqgùÌå%†yj|F.ÀBVá~RÆõÑñÏÆÇ˜µ¶ûò-¯Å,Ê®~Ac f“#š1'.2*;¼lSˉõl‹-Í® Å,¡%$k+§M£wXd°ŽÕÉâf7Ádpº¶X\ZÙ°fŠˆ× ºâÕ èûW×?ÛÄ許 ²ÚíA+8Èg&”q>¢þ5’!lŠHC¤÷jA+]ƒÅVMD·Sz¿EyL`U«‚`¬¢j5Œ.XÆñzØ‹Ö\!WбÜÛ:ÍEœ4Ø÷Qƨ°Iÿ¦G$9@:ß´ÎöÒ§‡SõÈ›ÕnÎ,¢œÝÞ^ZÄÍɤ׷zµ½z‘ªûbõZ¨^ ‚³d/7<½1ªwc€{|6OGp¸`%«²gËeU²‘!º‚)O °°9“çÏêHÇ$(OÁ×S§Úè픦ø1Ã`®ª@J%œÙ•HH±~Lð—ãÈ:'À2eHFª R:—åÄ•?²§NcÙLeI ×;3+KCÚœ(eit)êJU„ĨËYîÊÖwÿ*^ªêMªÝJ1ûåVy›i쌰àÀIAuW ›gr;%jõÄ™ÔVœí©í­o§[Ι] #”^XDU-øÊß¶yºU¦+sÏÒÆåö@ŠÚð¼Âà—öJ»éq”*4?ÆhLÞc£©iAD?ú¼Œ}ŽèC"- Ñ;$h&>v)_ÁI™62´æ{ÁΫ{Ö‘ºgê@–Ô~„—ÉîÇ$1ÁCm4å8 XO“ž^‰)Ú­RL‚®ÂEM`ˆòìùl'Ž×Ô‘ÂŽFo€‚¸šüsþ˜wƒQ¯VyžwRê(× |\ ZŒ½ CÅHÞ«“º¤2ÁЉôêóÑ]ky3í‹…¡HÖ¦ÔIZ®Rr×ÿ©pÄΗcùñ“éýÐÅøÍö$©¾äö¬.”|hë}“":ùN¯¤÷¬ËÎJÇT<¨@²—½\<–àM®~¾lJø(LwÒWõüùÒ¼»/hëDŒZòáŸç"©B¯§"9禡V®óØé"vT®‹ìý5+'ãOß”"BT4&Õçk†åÃ&<«él8È&÷Ö‰|oÈ c5#FiëÂ5p“`#ëWÔÇD›ÛBη4À¡<šeB¡~Ñn Ø'ƒ8’÷Ý(§eš¸Q¹ƒ ­&-· HÕ›g*à(ÑŽ¡C2èš=ð¨d Hr/Š˜µœ#÷ZÓÓVY¼Ç&}|DŒ òôÆå~Œ˜òdU0–»”øZö¶Éa™ÜæMÍÜèÃ(íŠþÜtDù0s³ F7cNk%DW,{ Š4´Å lO;·v²¬Ìì'íèQ¼=Û£ß! †¸“Wÿ-°)ZAš éGp‘;/`DS뾜Ò»†žÝþòxK;I¤–Ö¥*2ø½à|Äpµ-®ÑÏÈj®Íy¦9æ`”µ² ¿oAäŒ_;çHÞM䌌^ÌÛkwŽÈ!ûz'üzÆhgziCÕ”U'IÓ§g¢Og©|úÄeÙ/Gd‡2•Èbu¤%%*~:T,[~уU=òf}D 0s3ò6( ñʼnڒ¸¤âŠ!ZR-– É3ãÄx(°JÇ%5WNp)ÞEÀoj†©QÓÔë1OPì?1V„ Wz°Ò ­tÜÏòº•1 ÞJÉ·Í[g*ÐfˆP '•¬èF5–Å™Œ2ʼnJ"çqBå.K‰ì‘» šE—¼ŠÎ6Z~+‚‘¼>ËÓX>Õò®Ý !*gºÓXü˜w–Qùwtf.ÏMaœ]1R/öN'Át´àá~<4¹’6¯Hl*ö:žª”™-€Î}|Ψ³µ9wS`Ô‹áÝ%­Tj’˶«/{e&,$޾ Dž©wUú¯ÿ“y"y°”–ÊíÓÆ²¼Š—¥pæI¥+0N¯Ã …¥ï¸Š·0g:Fä/StYÒX_QféÒA]”Ãs¿J\ۋغîhÕì—c°µ5-œ>jæ«­+{Ö可ñæälÍÛ–2.–ظgÑ>Œ]·»fP¨‡jôæÑðÉѹ&¼xRâ®¶[׸—Sã„ßÓÉZîžâê’PpD/ Ë—[t}Èèþ¾Ðúæ&+Až¬Œ¿x“«wÒA“Ãüð}æ3E4;Ö‡ï?ßô–Ê׸ª6OØ3yÃÞ~ó¼QFf÷šÞUyã¤Ýr)¡¦ª\ú VÛÔÆs«ç*@Ûl—àá¶‘ K$lf¾”ùJÀåCNRç[Ÿ:_™Ê¼ƒIPHõÍ¡_‹à¾FÎþ—À~º|±ö Ë g.^\xSBË3VW¾ô½M[^=qøýÅ3éÔ°GÝ<m¡áÄs€åîñacçç6W> C°TOÌC±žE†Œ¤xKùêÂlãQ“Qó™QIê¶e‡Fÿ†„°ª%£œè–xò?Êj‹(XID¨“H3\*ÓÐ-W0Çò{Ÿ³0›Ý#s´ÔÄQ³S Ü1ѧxqæòx¡Æ®†•YÀ„Ú a—ži}ª¥g®a­Çê@à|@K2ü"§ÊrS’EÜk!YZ¿J²@иñcjoȱØÃsx­'&8Ù ùv‚†t·ï,4Œœ7 afV o&2hÑÒø)ØØ¿žÁÏaä1G§ÊF¸ƒ|`Üqé«z¨f]un®‚sÃb7¸¹¶záíV{%+«/£«èf¨¬æÔyÈ”V¤“ô¹ù5zŽ·ž÷ §K7£NFdº-€štu#]Y -’(vÊèî'énfñ0µzÎS*÷NÎáýQ[m *|7­÷d‹Gw×Ê&aL\Cݺà(‘ÔÕùn/sÛy,wõÞ>)4T˜YP½L3_tgÏªÊæs퀻ƒÊ®0†{yL$ë—†¯@§£¯X¾_{Òa+gÏÀ~ÅÕôÅ÷஦#c1}™£5y-ŽF7“êsô<mÛf•tÓôµüÜ·Ä”¤†‘KÛF¶ÖušX9‰î;«@Ë¢güz5ÑJ‰¥î.1ðò’1‚:• cÄC³Êù‹+V910½ª]¹ÿž‰Q;ߪs”ê÷Ó"Ot5N4å¡Ë›IÈÁ´ÑP`è³涯þСztñîøª$(Zǃ¶Ý*u¬›]‡ 9nÌ“éjA6yT„Ø ¢-›šÙ|Å63zí—Þ®VêJ™-q~ÙÆ 4¼>*Zù›!é6ƒ!î²›žy7ÿÅãän/’\L…@Š¿ÝŠ1}7tT/&ÛE¼Ò“m¥¿÷d{B6F'Z]Ê[(´qKkÙN_Ù¥]ÝÕ4“°ïªM}wúc2Íj›‘vÏí²¢Ú±G¶ûNú¢7‹&ånBô[}:•t(t;åŽþY ÿûî.³}ëp”™>ßä:êcG˜*ÝnýXd¡Û™}8QD» qâA´ËaçaÁáO>u¥ Õí>®™^’FÀ"s[³93ú6š] ¶]}¡fçIÛȧ9hæh;{¯nw1~JìŠ{Òí¦ä6ðiBr”r„¢w&ÜI¦ ÷Ê%.ö¿—Â]^X¸›ïö>áŽïíƒP™Ù'Üq›J¸ã^¾©p÷Z|…;îì=ÂÝC»zî–1½K¸{Ž„;îè]ÂÔ~zpS¹›#ÈÅ‘­ó~E;6ÑYÑŽž¹çrásÉ(¥5ÿ¿h·C´Óa¯hw7Ie„ÏÀ9G¯s¢Î¹8‡³¢ÝÝVCàÂlbÁŠh·Œ¾OÉ.]Â#ƒÇÓíK%;“,F_ʱïO¸Óßk wï]_ýÿý¿n‘‘endstream endobj 65 0 obj 4207 endobj 69 0 obj <> stream xœÍ\I³GŽóì¸ÌqR™pxŸ‡)ïññt”ƒ³ŠìáƒôÒWMš>ýÓM…ï'=(g”¬½9ŠÁIå„)ëóR¿Â[©ƒpöðO3R x›?e,•m­Ñ‡y3#‚ùëÍo²däŒQ,™$S¹7ÊLR‰_m}šâë' r µ?‘‚x÷SÞK[k+Ó£÷aAsQþR«Áï­…tÚÿ 쯃‡7ñÑVi:üøh03?9ªÁ!\ÞKñYkãޤõƒÆºN"¯ûKˆ5¨Asøä€5¬—ÂvX”~°X#2öx&‹kÃ^Á®pFxœêQ™P°¬k&nAª¡çJ™*¥ßÊôg‘ '‚뱡îD8ýÎ)Aþ‰­ÃJÖ„ˆ-îJ‚VDT”¼yT4èàÕF:»¼J„Ú yR 4X=“¢ p’pS3Ú»r$a1ø®DIRÍä˜,ÞíìXû¢$^Ú†žOŽ+fÍ‚ðq¢qYð–£cô°WKž‡A»`Þ± Î¥9„ ~ñ#,DÚbÔ-á`P ZcM¶‹ëœK‡Â ^Ãã©ÝÂBXNJÞ™2¤r’ð£{þ/Ä"„Q£C¯v€H†×”ÇÆ4 –º4Á*A¾—׺³8±öNCÿ9[ò iåCZ×EÚó`¸k‹é$u7˜z°œ ¾9y=h ÚÀAüE&?`ZœÒÞtt øR¼½Ý)ö‚–ΰv^)î5ßEdì­–l»qöSœ%a:Ò6ƒž)ìü ¯òº*ú ®} ›ü­öÑÅm£Ùf ié>S”+è6–ñDEö6Çl-»‘šê×å˜=ô³Q5_Øy0p{÷¢&$(«w÷¼³µ²gW£ï†¯÷§#!ÞÕ:BpÜþ^t„´eèvæD¶©ÇìÞ‡vX3ÕHz“ߣíNïî•Ë9ÍѱŒóŽ™™×éAX/`MˆùN½ ´SFEhW‘~YCšºu˜&b¿ Ú+(¸!2Â_ë­W:RQ}› “a|EõFÔª<Å”îõk ƒD¥%‹ÉË‚Ó&ެ÷ $ÓbP‰{S”Q~جÕw®#D.Ƹëu„´™›ãëÒK±jRéÈb`Áq§Á}(‰…¤kuć{ô#üÜ̽Ÿé’­…Žè<¦’iâ/'41ÏÛ–ývø,y®Ëinè¦|!æ¶T”* KízÙ_ƒgVÞ¹·Û”ûÁ íŽ 2D¹1AŽ(ኹ˜'Èœ*¿Þy¾n“#ÏÖ5¶Í§M<ð<öoKd»’ÔpUçô’è<[÷y,v$4)=é|«Ê°N>Á¦*²ÐÆõo WȲ’š€XºÝÉä ¦ 0P»ÅËŒµ§‰è[¥ÄнDEô6ˆe8KZ&ºÕ6“µTë®Â] c¢Å“½ªöàh•ä™bdŠáwºª|Moâ¾’+þ½”a!mçˆUS;wË3ÏJ©¶7Jxt®á\=šÃ±S!~v*~Å ´âhoŽJt¤eº0ãáðæ"]q€¹Œ–.¾tЇGéâ ò?|:]¯=ã5„w€ªÄÊÊAØpx aj¬H‡ù8Ë,€œq–—Ò×ï¿â=Ü ©yû9–øˆÕò° K‡¯Ùã!ôá|ûæ\L3v¢á pà†5v~¶ÒSuã)‹¾—„¼ãˆož¼=ü(iˆ³SŸÕœœÓa¬Ò ô¤¼å‹@¬U6ý_bS0’Ç’Áfã‰;)l»E¢põ¬—,DV7#è9?¨à¥Q‡/ã£.´â¯8­‡W¯ë˜,p(TÍìÃ#+ V÷ EL{T+ôŒ‹8”Œaçf‘‹ÀlFü ½6‰‹¤7Gx–AJ™Ç)£«Ï¢uñ-j”Π­*›·f¡hUÅQåð-…,k/|sšYxÁ ù®ÐÚa‹h2á·y’ ^Ë^(õz€LP¤ xk [KµÉ¥“fÆ[É pu7 7¨å¨Aôñ¤+W ×$"Œ|½$É $Å‘WtÒÆ0N?1Ýà;ãMþÊzWO²\2 êûå„ò›Éo5¾yF£‡¯N˜Ì„y=Gm·'LŸç«I ĉtJLPÐ륳âf:õÝœ2Q ÙM\²\ f9"Au8ÀKìæÙ  æ~Qø4ƒb7Ù•æÄ ®y ^O*ωˆAIŠ9¼‹OÆi+x0E¶*²¤Økà‚_9öJ^òî@‡Þ¾=rSÂ\³ÁUÁíÉ1vÍ€¾ ‡|ÍTÇ[žNM[W£úÐBÆyˆÿÖªŠœŠ†/ø{"†ö¢fäãáè[’Œ/Sᜊ¬:° ±ýg"¨Šè!ÌO1ŽO!Q¡ƒ½ \±™É©9^ã*|0GçÆh‡lœU™jÖ” ¸B ±¦…åÐ): m>ôü&dX€Ñx誾]£ÑU®hH9?u¥í Ém?u‹Õªyê›f…ÿ êUf5åóía͘Q.Õé2ÓÚs‹Ùúñ?oÝBpþŽ;®x‚A¢CBtjÅÊÆo¾cúÜáOSóÛŸ“ä-$”±$0!×mz`òPàC„?g)ÐáñÏ!ìè’ös$€”Nš€Så)SqÒX{Ĺå¬) X¯\é9ì¼†Ž aQðz|?,©lÞ‚0$]ÞIœë7ñe°’ /KUßÍoW6ªIùøÅ8+ µ3ŸS,@“±”%‘•y¨ 2jtÓIY¯údZ ž=„§äáw±H©Éj¯çQ ,X9£5ίVýtЋ$ ¡„ë7ìn~q27-±›k2Ë*ã,œoOšÏ*4‰çÌÖŒ€›L³ ·óMY_™íLå1%H™±yL‹H ÌVkc/§²€§=Mdß,‚ã]¬Çd[0Ñ#iBp‡]UýÉOª˜É4à9ßT ÒH\ ÖáÎŽÉ3tõ‰M“½Šâ¢q}•ôÄÒ9âA–>¨E#˜›Œ ðrfQk4µ%…O4V¡,hhÀxïgÀm¦=Qhð[[F·ð3¸\ã!8K2­E÷ê»E¢¢(YUc*©üûÈ5COu¯°ãtpµ®¶q]—ê 5VýúíÅ<­Û« ‰Ø|™YøòlhS€—c޶|kІ;¥·Ó”M©Aa$Ú¨&}^/˜âÁÌÆHéŽëc›Xw}3\»*7§c™¼îi t¯tÛÊŒo‡šá•bTFÖ··e²–ùå|‡# KÔØ³1Q³s)²a4\4˜y¡š9YU'ÆŸ{ì&+(›OkL¦36²*⻫kÕzRÑЇóO&>—Àyaó¢&jBbf3eìÍË:dä ôJ¾—eÚ+~Fs¸Öv_]?9ŒÁyb·:õ<Êrb&ý‚¿! ÍR“ýNͬ:oÂ…ü‹¿;úä8Ž-!éöÊ%ºh¾Mà—«"lŒ«ÜBÿB£‰Æ§Ÿ15˜³¬AŸeŸ9§”³ñ5Sh¨t.+ŠTÒ»ö®“ #Gr’–=_É%{Éðr®8YW2O*¬z ¾ˆ {)a®8›C)¶Ü9ãù6ä͹½³ûpgößîò/Ùö¿Ý)ÍPm¯Úýó >>ëøül÷ñ8öéö °Á7Óœ‹H\o CÁxH š%WŽM%¾ig=Û=Ù=*û’n÷%5î[æGmânimBVÈ·ÌÏÆý‰»|¯v+³ÒnÐÖȕϻáÛê™w#®!…j„ÆyàÙ²ðˆòì•ÉÏõøÌS#».Oy„'þ‘!`°Í»˜%ƒ¼Ó·ÏõøÌKC{ïÄTÐQ>ÊçÈcBÐÜÿ3‰GcBn7©éÿÙÙ”†!R‹bƒš!hC´ßC8îÖ׿N¼˜¶o'•ÍìLzù™;¨™z#U)­øû‘ëøô€%oñƯU;YUkÇÑñ™‚„”É\ΜÖNO<:o]¾¶ídÛ¬Íh²Õ¶òœˆ!Îìx9I…š9!å1åk×L.bŸ]"fœì|½¶ËœŒ[ç¯3aerC÷ƒéLHµg‚ßœ RÆJnùi:“ñkÕNVÕÚã™ v7gB²>“ü4Éøµm'ÛfíG«?áíwL(nI!­ÇŸ|ÍÁ@{5aÓÍÄÙmËrw‘„Q3|°ccÃæª[Aµ²ÃI"¸éWÚ¡J-hŸÖ,·}ÄÑ/&•³¯ µISÊ&d>bÞ›çó΢ߔ7oFez›|aì¿i9«Z†Îî`dGb08ü¿_ËêÁvÀ¥µf½ÿÒ^!˜DÈ%«±qòÚ V Ãß'‰oZ~Y][ü}BÞÎsu¢ôqæÒçPó´7ýì:œUo­>N­:Ub9Ù ÏoHÚA#˜Õ_R1¸ÆÖS9x¢±Y¸ä17ëW}– dÇÊ×åšT¿d´„`»ir“¦w[kh¥ì|'ˆ™ËUºLs—˜ SŠÛ̲UýýXr§©4\%Êq]uA¥¶›)!íQÇ"«ß^®ç´J©D©¶T”›y…â6ÃÎǞʺIUU·¹w€R0A+©”E*åU?uë¶ÅUõâR³ª€€&ÝMy*^IÕ½í¹q„¸Øª|ûÝ#wv [éõÕ—ަI~ý'Â¥K·™r1”Ǧ&³èyÇДĝv€”´S.y\n1mWú6ܱL,S¨Ö)LܬRØFëÙ¯ôWÿP‡Éo+;Qööâ‡îïÆZßÓ‚–fÆ%üªö¿íÐqZ_­QT¤Ó̘ÿÕƒ9NŽqI¯N¦Ó趤Xªm¾„Ö•ê‚ÚoPªï“ºK*QÏ÷F ÁÊ ÎЖñ= ›ÍÌ<4hÕ¡¨æ¦”þôæãeáç¥ûE] !u(¨zMÚÆ#I-¾±Ø»¾mf]ë—HÚõsƒÙ=ÅCºîþHåæÒjÊÆpwâžgÆÍßkÀ3Ü[Á¿œj¦lI‘tLÔ«»†)©e7t›è!êèq‘ø·@Vs2¢6v˜ó–ê\ˆTÅŽëç­‘cš±-r,ßbäh¦\ãýn¯N›\U©ÛÅŽ[){‰l÷DÝÆÈvOÔ]ŠjåWÁl‹jnð3gÖ^¨Å‹™wÿ}B»Ãendstream endobj 70 0 obj 4192 endobj 74 0 obj <> stream xœí\Y·ò8?ÀAò4oé=-ÞG€<Ø’ +±ák‰D^Y+AZëtœÍ¯OÏb7»ggµ£äÁ0`õöð(ÖñÕA6_mÙÈ· ÿKÿž_nî~k·o6l{±yµááÇmúçürûÉ4€?9½Öb{öx{ò­[ËÜöìró÷ïö|tVs?°òø³?§Îbä‚YìÌFïŒT<Ò`”å~[ÞI'Gáê¨÷v{9õ>ÇQ9Þ ïöjôB9|½ã£UŽÙálÇFË™—ŸbSáŒV÷»½z”Ng •qøÛÔÒK'"‰®·<¥ý¨1_ì$t²B _U¾¢´”iÏvÜÖs»Ð´õ]~ª¼ª”쥳HÂ^šÑIt<:à8Â*;ü«|dÌ ?ìpEVªáŽh5ÃÛcL O ÐPèá|'F©¼rÃÃÈiÌð^*¡™~„–@¹·^î,CqÙŽb.6m;\txÁ—hlTF8óšéá22D‡ ?÷ø Ìhpùi¬Ç(t#¤~F¡k¦œB^ aÚSÏó ‘nЊá)þÌœuœ»Ä"é}à 2Fò¶EY»¨ƒ=¬ ôœ¶Mhk¼ )aP:¨øzøèt–W‰­‘>` È*KHZBô²¦:pOe¥…º¯¥ö‡y –ëóXdѯwŒQ€-^õ m¾Db…w\ Ê*—º2$h*’î™*#ï´ô¹Ç稳Né00R!³s ðÒT2 KhEd•„k˜á5¼Ô*g=ÈXo23žåÑ ãðW ›êQ У-ŒÆ2vá¸dîUê£*m£V‹mÓãOˆy /»ôŒžHçe‘N"3 °µNÑq”–#vá:tn”Áý'bÿ"àYݳ’jø¦¼÷ | L*¹aÜÄ."Pi¬Xç鑸Æ|šcùØÕRÄ×(²£-›®R$`B&Ž–ä2ZIê‘k@æ–"p|’6€Ù}?®Õ3Äm°I'D ÂÔ 3 <™¬Áéf9ï]ã¸Ô  Mc|¯caŽeŒ50Ÿ“õ_-¥†õLæmTdïxÃZEø@Q åÃd/DÁÖ•j0ñ‚ _F̪X•0€Iλ Ÿ£¶2ͼ&¤§YÊ"]EsI05|¿£Dï¥×àö@kù(±Ç$|y‹Ë6 Ÿ•I’A´‘ÙŠGÃØDw ;ÊÄ3p­ôåkËbpÓ "è©d €0²H(o=‘OpÒxª+DI[…µx¬Ò‹¸8l' ”eMÄ ¡ò?µQÖMk”— XôT‡¡ûôKÊ4>=$ÕFÍT‡6‹Š£œçG£ÔjH8 ã"~P:*Œ+½Úcu¦5]Ÿ•e¯±Vgbï `0ÒöàÙBd•]ÀéÃŽÖ%Xnz,è×£’X𳇈Ì~¶!­ÓòÔ'±F8·£ï¸HxRvÛ wç.Ãm·c‰ª¢Ô°Ÿà ¬×@°bc®hù ÊdeNu`¨^ZO¨áMŽCàxbº91ÊÙAò{M±·‹T²^EØÂ„­Â^1˜n8&$&—ê4à !B7¼Q[?2Ï´>˜´ ˆ(@ b¬œ*€ócÞÞÕ ”_ ¬ `?¹KèwC ‰æ³ïeåJc¹beåÝ‚ÐÝ"]ø{¥b#PJõoC¤ª9skdªŠw¤zÖAµuàdª*b¹×´ªgL¸e÷Gh^!¥iô¬zÿš€·­€”Q¨Ã#Å0¸A4•zoR©¨½ïhê´jP§Ž6>éLÔ£ºêëgƒ·B·7£9Þú›iñMø=ñíGЭ¸Â™;èœìÆ{…tî§x7«ÀÂèÅ9 Ÿd`æ |ÌÛs¬Ë:÷³´ƒÜí! „©Ÿa X¿±Sb( ‚ ©V~<ÇGc VG¡­vRçœ_ÔH·P®‚Ž2¸üüö5¶Jr„n°pîå1+ŒÅ@è&m(8±AЀo¥‡÷zø¡6¸*#$ÞÊžÞ‹¿—n„òø²>¦ >Ľ¦Ï#¹ŠÅÚ/ð‰‰®`÷‰Ó˜²ºTCÀtjR"F½‘š“jÑ´Ôš£©…h‰–œ†VM‚­$¶³áG¨—ËÚJÍàjŠRÇíÕ~§ùHLP¾»”ªHÓ’w§yT€Ëò¯‘?âŠL[¨™¸‚hËÑÚx¥–ÖlHDÛ¬ªÿŽ„+ ì¦u!T* Š_#VZî­Ùœ TV‹¶nžßƒÉ—2 ) ï8† ¡æ·õgšÚÇ™je¸eaT!=ϸOk„Då”,ì`A0?Ü…)€Ζ—0Û‡ñ¥Ä§½ÔãΟê~’‡± ôjÇÑ®`…XÓ Û jøM ˜áçŀ彛\ ãÕtO¨ökT˜n‡ :Å5 "¯:QµTvé,–çêKf9“œ‰VïžÂ@¥¢>õ¶Jþ׬¡[õ=sŠê• m‚5v[3Ý·Ñ BE6ƒn]±êël¯$²aV f4ñ±û4S¨Æé\Ú_Æm¡€v_ŒØ[µ€ÄD8S¾OU ý!¬þ¢ºƒªîþí<™^hبJNáî?eu uC©å’52ι•ÌBBfÁÕ‚rBû 9©¢TÒ Åš†¥hBÆ!‰Ù“¤V21À ¢g¬– ŸÔ2ú‚9_Å5z@§¸/ŠÃ„5]´` X˜é ZÜØA@H\fd‚g Ó92‡~Õ 5#ƒ´œx²=ÙÈã~Í>/»-/5¥¤Ÿp?%¨q€C{:žÔú@^M‡ì_G#ϪÄg;¥7(äfTK¿WyJFÌ~‰(*ÊN…,Õ¹%3a5þ-Ão7‰ëPÑ!Õ‘ 8NŒj¡J- *’ í§µØL6,ê–6Œ›åþ6ë?ix5O™È¬Š“RÒRÔ#J]Ѹ;x ž\5F–[•)²\ì‚Æ‰YÑ1;¥ ýDagXí§¶lMs>†šW¢ÊËë¢ FZuüÜàÏd¤`]¡òXÌI—v-ʨÁúÐOØim·žr!â˜ìü³Ö¬y¥0qc“]¤ÙŽb³ó„„«$fGs˜fë)ZtcK‡HrȶO/}Èê°69{æÕ€8ºW¶Ð’bæxeb¿Ytí™ É¸ÓÃÞkr#:àŠÊOPÝ1i§>6¹‡B.I>¯Ç£[SH…ébÆ+ÛÛÀ G£ªzÐd)âlœ~¿ö‚è>1Îù‰¤õM6†ãq—ê&ÃÝ’ÊkîϨñ¦P/r€$")óÆÑÔ%mZGíúê—¼A;©íˆ~1ÕZA‚bú‡ÏêË^/î‰u]õ©2ŸèId ¬VŽ9V‡R#——¸-è…+Ó³µ³d2ªLK¾· kr‚»MkYVÎ`5јRËBI0Š…¸,é‹üq¦OÖŠ›æ/¨üj{€ÚtX lU;FÀ*ª\Jë;úÊÙÝà#çHÕ*ІKµæÿ0áH¬a»|¿Ã€Û‡³ëG\ì¬FRï覕'ŒäYëCëÎâÃò|ÁU¿6;ϘRÝÙYÍÉ€i‰¥æÀíé‰ú® ÃY#:Áa.±`AÀ#9|·ÔMÈËN1Å]óìe¡!&<à*›Â?KøcFÕÆŒx´…›ZÇÈ£€6ùé¼<=ì¼{‚OžsÔ…ô®{êËî56ýCL¦€ïÔIÖ¼¼Ö„ÕÝÊY¼ˆm8-¯“0ïP€vk{xJÅ 95ˆmÁ¾ð04ƒØr9“·p02n,ö2’…c™Ÿžm¾Ù¼Ú*:lrìqÎú°¯ É€À­šóËÍ'6w|¹}ûúç7wÿºå›»Ÿãÿ>ùúüóàþöÎæÓÛ0Ðèâ8Ü=‰{Ül9b¤£ðCüh¶¸Õ"Ò†N5åƒUŸëÔß…å¨k}·ßG3M&väÄc©ÅKMÏ94GlüYi»†ô³p<dKDdi·BÌ*”ó©¥$x8EGå´Ê#‰K+"å#à}‡û96OÜ‹›Œ}æÉ´)xjæÁ’k”y÷wùC’nz]QýU£á„×­"Ú.³B ¶ToÀŠÂÝ u+¤˜9ʤ£VH„ù ›£ „h‹…'ŒížW j?ù¨¼û(?õh@ ¶€-iºE Pe2è 81·2Ìùl`婲æ^xÂ?ÙjUù[“‰Þa]¬f¢7±^ÓŽëqKŽb Š˜.n¢BÑEA˜¡ãò»jZ=_ÌFsrØ91g2ìÌy|¸(OSÞ ìÜ›B÷—Ìh›oÎN1·Æ§uˆ!|Zùd0‡»'G!=­äþ£P»pZŽç´ï—އáðlþZ^ùyZ0{i0ŸÞLüw?òA!’ÂÁ©PèÔLL(Ôa#¬ÿeyš²q …C[àš2T³ÞÇWFŽ ÉÕ­AÕí1sª(3…ªÓAÕ Ä¹UÖ[[ºT™P>? ª¦uO|w^ž¦uO|÷¤U‘o xÕ>¥zœáaü“ã݉%‘ñn.‹ƒxwÃtè[™}$jbçµ4’ÇDàĸykBYÇM"”_qó„¸y¼8—pS[};±÷㌛JàTA+ò‰%™?ÒÀ½DrJéw&4–ÁŸÖÃI岎çisÇ(Ò°YœÛfÈ7±“Ô&}ÔMÇãR>'øÖ4Õt93ûx—l— zºk:·KwñJšÔýq‹ÇÊ•BgÎã…±hðï>TQ¶w*+›4öôùD8ó½\5]M¸Ax’|®v2ybFd9gESy²~\/Ôœf¬#ŽëÎnvå$/÷34÷þ4mïwŽæ@¬¨*²†‹!@ Á¼Nv®‰á7–[¼bÑ&fQ?uÞ‹@6ïwA’0^1•ùácvé»õˆP½éˆ$¼·Rèέ`Ý[!Uºu‰uï?iý)¬…ÇYó‘µö:-`F;t¾uŠ\ðpão©¹É~æÀˆÌ+ø.…&ð7œFtý;Tð %$Š _®^!Iî¤Åôsïù×dÝ#À½ï„kÃp‚Úxˆ‚dçªçºuD÷—ok)Wa5^í—C’ðt·ƒ¦al¸øöL£ÓŽMF\Ç&(dCÛüªèÜ%&Ìu5 𣽮2h̾érçÀ}•ôäåe¹Ìx!*`øéä2EÓÈÝy‰ ŽöçKÁœˆQôõúfó_ ð´endstream endobj 75 0 obj 4630 endobj 81 0 obj <> stream xœí\K“ܶV9·ùN%'9‰†Âû‘ª\ôHE‰ËÖ&©$ÎAµz¹¢µõ,åççkÉî’®9¸\ååh°ñu÷‡nлŠ5¼bô_÷÷òjwï[[½ú°cÕ«Ý»«îÏåUuÿ 𓋆 f«‹—;Öxg¤âm7FYî«tÏŠÊ2W]\íþ]óý7Îjîëf@i¥ªeqWkYÿa/é™PõßöÕx¡ ¯ÿº?à•\h_?ØdcŒÄåÅž5– Ëtý˜Ú «ÐÏ×è€Y¥d.õ—Ê6ιúÉž7V3ÎëoIHsÉE'¤•®ÿNÊYÆ”y¯!…®¼©‘ÊÂ9M7BúÆ:[ßoï­êîÑ«ÐÒþçâOÀËUœ7^kApµ@óJhÝÕ£óUõ×í¨µ‘ñ’†ú¤ïþbÏ]c½tMû®žÆ«V2\¯‰0²±Ê\<ï­£ŒË.[1¨ÉU#• b¥lu¦qÒ»BV-kœ°Ñ´ÃÛbðÞ6ÂŒÄùÆ)ÆëÏdTEù1èìaóÉk' ÿ†–ÎrŒ¾}¿ïŸÿÐ?ÿ“hÑhÉë—„ —J™úSß mëœæ—ÆZÉ ‰Åβ~{eZ)#™¬?)ÏXÀçÑÅî›Ý»JAùÆã⥮‚K4°-ìÅé/"ëþãݽÇ©>¾ÿôbwïßÝû#ýïþ“øóøaug÷èqºŠýæòž¤mÔ¢žfâ÷Ø!­ \™‹Öû($謂É:˜‘Ã3€Âå^À'¼r€3΂EtµŽs×bg bÂ"z¬Î¤žEï0õ›\ì Ù˜ ]WS¤!ÍH YÄy`ç¿ÏbÇc®î90Wlû~/À ˆÀú„ÅØlÔ‡ Ðç»}®D´vi"Á üx{ ŽA»ÂN³Á†qS`¤™‡HÅf—]³Î‚ÒûúŠÞqpâÛÀDÊ[_•aù?xC°ðˆžRÓàaž?xðަĮ§ô ;|ØqD·h”0ðæ„Ã{à ¥ñ®tð ˆÙ »ÈÑFÌ ¡i.¹Y¨OòÁ3Wà)ôB&›0šäNtk›û0j[³på¡îexýñÍçéÞÝx5ð1A¥bº$ xrÖé5<°1V‘Žñ ,]õÐ<Wš‰ˆ\ùøyºº¯FCÆ¢†Œ›Øäìºn¯¡Õ°›¥ º>x?cªsÎ ÍÊB÷Ð1XïýÓ"Þ»(—<òƒŒ8g‡Œg2FÈ8§í˜|ø=Ƀðâ–ˆDL~Â{³ž^îf. ™/ÐÐ*¤9™H§ wZú‘÷sºM Z¯¼³%W®˜ÏxÎõ |¶Ü¤S$ÄùJsÄ$ iä¦q‚èIèUâ– é^Tc“0²ÅÍ gc\:ÂÁ8¼JWClˆp I{%ƒJÎû­Ée5œæÈ%‡i*­¤4W¡&²j}þ œBücL#ºàö0ʳO¯É œ²Ü’œ¢=[š"-æki†œò6ñǧYN¡z¥ ºú0˜²Ç“2!ßš~¶†0ÒÏ1ŒÿÛt5„qŠ~:@KÆ á@l&Ê©Õ8j=0g9*ÃògŽÚ†£n`É)޲lég¤ÅEéýQñ5ÏQ?¤{?¦{—éêYzÚß{=’GeÅÜéúÀ¼®¬ãŒ5zóç«‘n`)0†oœå+Íé Öä¬ÏÏ‹6$ÒÀ1(Åü?Ì΂Vƒf–2dÎŽVO0dkFÒ€‰ï3JBMQ`t%d<Óa -w‡)RZn]zP|ÌlÁbƒÈ;‹Ý[ã¹è›‰”„'.:«Ýëá4KLLgGL«ç'Â¥}dcùÉ$?µÔAu~Rоåºü:bàÎI~C-÷‹)†Jo]-1OÔ~BštN µ1.‘¡Ž±™È–Ε¡VÃi–¡2˜ÎŽ¡VO0ËS§ £Û§N™§ñ£2ÁVRB ÊÜr-–ñãr¯œÚ¯˜´7O B+ëIQÌo·Â)K³SGŒÞwà :¨´íÎŽØü˜É-ó£çßà] ­ Õæ2#]ØmŽø( !#ZAKÜX1vŒ%rÏ¡¹[¬W÷È•tu•Žiä1WLkÿ @\|µ»ø ‹›Õ”k°E%éœ?­¢¤]qã(‚«¥Xîk}WÆ“.×Jkü²TCWŸwÛVÞyð#­n€ÃèÄÒÕŽÓÉ2¿Ù=Mÿ»ã‰ÏÚ2¨B¿šÔ6ý¬ý]´³{½ƒ¿š¼ôá‡ïãnð;x‹¼Åð–î·Và!Sqí0…ê ÜMϹjŸ¶¿.S¨0yÿX”ÂB— 1),\«J¢è[ÄÖñÕÝcS ›²o !|9’ø3¯‚€@wF:¹ªí/ÒÍ„m\é±.…õ`$Ýo(#i Q˜}óØ:¾º{ìKa_ôM6ŒÄ”#1åHÌ`$¦‰)Gb#1åHL93‰)GbÊ‘˜áHæs“?;Œ|´¨O@Ü`d1 m­Ú½!¨>ˆnN%'¤K,{w„¸ ÊB«Ch®e«Ó‚î{^ÌåôeéŒ8G! 2>‰iuò¡w¡THi}úLÿå^#ÙÎiÛŸ”¯I ¶ rªT[J¤<0³óá L“Mwöð ò™4udï°eÛ‡#‡2…'@»tEHK‡fÉa7=…÷Pé*%O‰^žVß{N›÷÷«`Iô7L>#kI©ÓrCt09ö¶›YûŒp+˜³° )Oj-f|&É¿Ð>óî°rÜô•À(»LòA4Ý¡ÍRƒ :¼ƒ¶[Ð6‘®…ÌõHõ/z :Í|4¯þ,è¡˲•þìqqò­;0®ŒlÏ KƸWy…Ô¨Ív¡ô[OúR¬oˆ*I‰G„Êúyú·Æ\]—yOiÆØ­]Êdñ„52_fæRÛp.†Ô£Š`½ðÐãÿJ„·íkxúôüÅþE):VÄ¥ô×G÷)F3tLÝym$¤¿cî Òɹ’ü3›ñ‹â þUú7+¦ÓVf½ñãùuûÒÑüZB‚Ã$/ÿ<“ò†#Ë9.Iª2|1Ží¢‚>¬–x^-ýöì|¶™ç¨.:ŽÕRþÝ%SxhúVã%¦7‘šŽM/Æ·®`z߆n_±øDÉ´°íyXä´•I,r–—&“U¾d6$N§wõÍîÿ2@´"endstream endobj 82 0 obj 2909 endobj 86 0 obj <> stream xœí[[oÝ6^ìãùçQZø0ÞY`ê$‹¦èn/k`Ú>dØ1Pçâ8íþü¡Ä›Ž$¹G© j†‡—Ñ7ó}‰ä‡-g°åô_ÿ÷üzó份ü¸áÛË͇ „·ýŸóëíé6À0¯µØž]lºž°µbk¹Ûž]o~l ÝsVƒoD*þ|öußY0ÜRgμ3RAgƒQü6ÕI'™pyÔ§íN2c@ëæ+@xÓ|ÙîóBÙ|׳ÊqÛœµœYà+ŸSSáŒVÍíNHͤÓÑBe\ÃÚN)½t¢3Ñ=žÒž©Â˜oZ‰¬PÍ·Ù€oK[Ò´g-8f=؉¦y¨ÇRgˆP[PL*,ÙIgÉ„4ÌIv¼ÊPK£ãƒ'l#'«½·LÑ<#4Íÿ:·½!«@JÍÕj'°ö×`–³¦y™›Þæß÷šzì_Œú‘p—LËæ]úùë´fÜ ÄÇyæ‡æ·dSn¸Ëƒ¿G¯JŒ ^þ^Lþ6üî8Ö -pÊ0S|¦Oy€¢í9µ’›‰‡Ê“½Í| ½<玜õülóýæÃV¡ñÌ…ÁI1\Ðe1@‘_§/6O^üs{{óéõæÉ¶°yòýïô»§øçųí_6Ï_lÃPqÁ]9’ A°`¤E,vvk¤G~vQþšU< AÀ€ä¢pÞ P¯B‡sä!ÇÑVë\‡5^O¥ ÍÓPÒ\DäêŸ_¥ÒI, ‡‹¶*nR“C°ë‡½CŽ†Ý¬ Ðeòþ†Ks“·‚º»^ÁJ¾ç_+¾÷,—u$ä!SÛR )¡Ðœn`Šáê2€wB$0¡Ìó#]´W.}þŠ 1 ¶Pté ôNK?2?P5h½òrÌ— \fÌ f<€>@Ï–»tJ„Ž´FLŠÆ,9.Y„.“¶¼NܦºLª±E³ÅÕge\zÁÁq¸L¥!6$8O‡¢=’Á×6ï×—£á4'.%LSi%¥¹ ßÎ0«>ºþM!ý1†‰žÜ]ñÐÕ'[r€¦,÷䄦hÏ—¦H‹5Å&ÍPSÞ'ýø4«)ô¾R‰•>–ìñd‡\ˆ€¯-?kCågF|þ÷©4„qJ~z@kÅŠG5’M¼NM£Žæ¬FXþ©QëhÔ=<9¥Q–/ýŒ´X£(½ß{ùš×¨·©î]ª;O¥—é×\÷f$*^æ†J—‰y×kpÎôêyÖÚ~ˆB·ï‹;…n苌;•†¾ Ò›Ô7ƒ½P.©óÜ+# 3k¿1Ï)³‚YøäOÁ\I0—{rJ0qæã$ú£{B¤—°Oòi›ƒ)#dçÎnÿëuª<§}M_º¯h›ƒkîu"C4ô¥V “€Å±ÁæÃWÊÐIêŽî]Ó‹0ºòñ=ޚꃹd‰^§mß°ám4読:×Ïíº§¾ûÝÆ’•33“d.÷Ä$ÑÿP)Ò~ÿP1Ò„Ók¿>…Güf—æÓ´.ò¡h/‘B}ž—•‰kä>(ÀØgбŸ‡|§Ya¥:4³+UÌ«¼]õÞ†¾ xÛüŠOâ¼w²\àòJS­J¹-«%³ÒKÍEX߸cZž?(vØÅ{à8Å^níʉ5)M<;0Æ^xXì]ž½# Tì…‡ÈÞ£A3ÇÞ™GÄ^XÀÞå8N°W9ãWÞPcI²öæ}Ê?|;`m\"‰÷±™X‚ùÃÜ8N³Œ.`zDŒNëqöãÝܾ¢SÜ6VΫ•úftÀÊ ˆÛ+ã¹½ÍÄ ”ÛGÃi–ÛLˆÛiµÎ~<€ÛËâ¶Òrí¬›¸8“u­Ûfâcñ»ÑW)}¨;ñav~'啨¾­Eù£!6Kù°GDù‘å|IÒ~l§È/”^;içžù™¤}la`ä_¤Hþ} î\å*ù†Ø,ù ÀùGÖûEä_ŽíÔdÅ¥=RÁå‘Ô~j‹G:—”¾'ºï/3a[LiÛž·å9û¿Ó>Œ°ÜÛ±­tc! ïS4¤SùŽyc¤ ÇMÂ…Hì#º.‚¶ÁX1vŽ?2hWu9©6l†‡„jÒ]w÷“”1‹<¾áL[ã ξٜý®(ÍZ Ú[D™n ùy %ëfqŒ14«¶® nØ€sLƒ(kÿÛöÖÛª5›»PnytOQN:±ª2"$mŽ«Ž)_&·¤ÍqÉA†}Nð•“åâÖÈÄ5 Â.[é¡rb,ð´M²lѶWdn}p•pHV(G¨/!ØFǽz´w`CÞÍCq9aïúH±³_„Õ!„bUd¨ƒlú¯0ÐU¼w-E?ÝKÉŠYgá²gQYBPA¡Qm³Y£É†f~µÌ©òUÖ âßU;2'ÃÛ¤ÃÔÆ)ß›í2Í68>׿á¼Bå¯L'ßTì(Ýý1fÕNIA›…;:M[Y6vø ënciÔ2›-Ë7ýrtÙ0Q>ž0A­Ìܨ¸·ÆáþaVâ·A)vnôàL¾­ØŸ¶È-º°æÊ©¡$)Lº@ΰ0deþså€ýówܤû²äwƒÀ÷'±âI4Ü„“$Ó†'weÇ8ƒOƒSU¤®>X”¼9Nd“H1>ÿ9á*¾QãUNPOiæf\M,»ã´äÕëÝIwÕY[£ê½;Ч$&Œ  Îñ-6jpm=äßoþBo0Ëendstream endobj 87 0 obj 2417 endobj 91 0 obj <> stream xœíZێܸ56oýò¦Guâ¦y¿Ø_‚LÖÉzדI6ÆØc2ãËØFöósŠ)R-iºgº]`1À4%±Šä©â©*JÎDÃé¯ÿ=»Z=øÞ5¯?®xózõa%âæÿ9»jž¢.…dBrלž¯8 Þ*-:5V;š|ÏÉÆqßœ^­þÕŠõF0ïŒ-[oÐE9¥[UÝ5FµX+z&uû×õF³ µí_Ö )¤ í£õF1kš§kÎœŽ›ö„úJ§¡ç[(àNkUJ=GS;æ½oŸ­s† Ñ~OBF(!{!£Mû7šœã\Yj} )¨ ¶}BS–Þº¹‘*0ç]û°»knÿ±†Vi”û÷韀—o„`ÁIpu@‹FäÐyšWým·jcUjÒRŸ êO×Â3”Ÿé:¨zžZÝDÈpÃL¤UÌYLæôå`m}2 š¦)4SÚF±Ö®Ù(˼ ¾’UÖ$ËZ/]Ò3¾­×›“Vb%d«­mßÀ”Ê;õ]ÓR„ÒÚ¶¯EsCMã%šï±wq±Îr1<;<ÿD¶2N´çßcÏyê›ghZç·$–”z‡Á:)«¸j?F©ÀyîÉéê»Õ‡F+Óm é€l`FÁ`zl¸‡'«'n>]~µzð÷F¬ü‘þ=|ö?'›{«''MTñ¨Gr_jRŽé½4-lëm? ’éÆb,!;G¶'A‡}¤½°¯€Ë…³µ„³íæÌ@¼ çÜ;/„ï°s–G1i±­´.¤^$CÛö²Ã…4@Mšö‡–¶°•ÊNì0g°OCHŽý")žÚ[ æJ}¯×Ô‚­IÞ&á*Á¹4ÚÕ|~X—“HÖ®ŽÔÌßJR˜è …1‚,¶ÂÈp³Dg}×ÞŠ*„öŠP‘Á æûHS:¸PƒUàù#¼‚cÈ„ Öó*.&pt•òŒ×Ž>~œ<Ù lqìiáÒˆka” ¾öò‰Å}@öÛG/æ¡0Âߊ¸ô{RÒìIg3ÖÑ $$(|w¶yð£q-ïZ[jyîÉõSó"?~™ïÝO­‰¡“3ÌQOÍÔÛ®\(½ ŽŒV"ƒm¼Ã/juO — ¹úñËܺŸZÈ!ŸQcÚÍ”² v½Úxà`Ø-ó@ݰ{ßtÛÔX©Ç¡¢c‡‚å6‰}K""_Eo ½”¥Ë„/Ãg1DÙw £N19÷5ɃRHEª ¦)4¯%âšÌWèè4²¤B¤Ÿ`ðF…‰ñݦ º ƒš22R.fr„ySÂìÀtû{Ž „8PøX (ƒ¬6 ^ç•¿Ê ôiLUÓ[J!<:™žŒ&°"cl\Ì· ý–Q²¨O<Ãi‘xJœæOJ„5Ê)§ÿÜd†ýÖ°ÒO›†™ì@8ûy†pLàûæV· g™²cÂyŸ·ÍçEÂ!7éoÌôqë§³$QY~ôDéØ &nÚ†‘Û-oæ¦ÐšÎÆ€BxP«ØL1v0;˜ËV€ù }i»…‘çÌñ}O¨nA`(ôBI÷6óÒ»Ü:ËO_ŒîQëÍD¶U”ƒã:PÞPNgÞ¿0<6æ‰ï¶Q¯ ÷¹õ.óÝuן€t­1ê³Eå. 9Ð_¢¼<œ–I²°ÀĉÒo÷¯»×š‹ÃS(QYÏP`óà&ëÓŠ# \Éþ X˜è;C×ï²­˜o ÖBl’ÛßHs$z=LR?ùާã8…µËdkà¯zzd»WÝ=øÏâë(:ø¾ w\Üð`²§Ç¨©XÑ-QÒLZH¡V‰Û·{|õéJug«ì#Љ¹IæÑºï NH³¸XWòõr}÷.¨ÿ}~¹·ãío€Ù­{wUÙÁî®*9˜ôæøe€ ãüù(:Ä¿iã}‘TþÈ@¤Ð¶ EÚ¶Òöét\j˜Ÿ‹c›ƒa²l L~ 6{›ý4ý¶Åpçnµ,ü¬Ðtô¨¥ñßås¨È !tþÞ]Œë_ºòMâ×h¤ãaòÛÅòFy?úÈ3ópS«|ŒHL"¢`LI®D'"É÷„uqÇz&⸧OW§¿¥OŠgã ‘ö¨ŠqJwÚîWaj|ÀÁ|¹«ï:Yš¡¼ó kàÇÄC|f½˜~7ÃlT»×r°{ù0™Àõ\F¦¹T¿[tYå 7ÎHs©F3’K3JèT‘œ ŒêQLßuÞŒsVÛT"78Veµ«üÏÔŒ³78Õ n/ Øw/·?èìîîòÇœ*olH¸9ìϸƒ*¯ÂòаŸ*ÓüwÕ³wó ˆÜÑY!"ŒM_a#u×.^_®žç¾ÿY!Œf Ò¡z¦ÞBkJòa}ý…p)º@Ÿƒ]nI]®Þ¬ÎÓ¸ÚÕãj“ÇMrÚP q´N·¶ÊQ&r™ÇG¥B_R£%©n4I•º‰4ZÅ5&9%C)Pâš{¤k!mw]õï×Ta7¹¦jÜ)´k™©™ F£ô׎ AZ²Æµ¤çy„xu†ÞVÒ{ÔüØÔ¦ÐM½»k$Rt ›…­/uwWÔ»:=µp¨t¯ GVé¯ûÉÕó¨.!‘VDœL~Ìka^è¦ÞÝ5ï'“„¹/uó´’4tz¬ka]é>O6¬–®k›hSÚ¤¿l’›Zغ³M´®m¢ui“þj°I~jáPé>_üPw:½Ã-:HÓ(ÌÒ›Æt!ÂîáwzF‰X\6‹: ¢·Ï:ä V2á]±V²×JÔÒJ83yеUÐÍøEkÌLoB T(¨ô–ôÊ—«Û °ˆPì®}²vR?Í(í ”÷¡ø¶1¿œ®ŒÞùkqÚ pIZÞö§£¿^æ„ò“æÌÅ¿^´ä®'­TPÀH"ê}®Úg÷Ö¯DÎ8Š\Ý÷ñÄ犒ª¥\ëIkE÷H5öˆß{Ú˜—tú‰‹._zÝy^)ûM4"”M¡’'á|ǹ"+U"„ ØxðóIÓ×1ÕNr=e[Y*÷^rs*«yü(ÙôowÎêEFbB5yz¤ƒÞ8sÊ›Ê\ŒA' ttËܘKKÂ=‘Í?i(-¼³ÜÞœ–éíðMnùÉgw¤¡Ò¤î[ZÅ9BVy€2|cZË g1ÃQJì¨éŠd±ŒçÚ—ñÔ%p«¦œÜ4º7Í–—o!bB½©>@@:-C±/„ާ(yc(:DZ‡Üf2ºÑc…[ŠÄÑ%¿Zo 3Îð©£ë\Á…ä:Ýb¬š,*LïºÇaÊ5Á6u覹·T‡úÛì]Êœ¹Ù,’?U-¦Êü§Å м›ÇÙô9}®Ý||hÔŸô¤S£ýzf^(¤hû½ƒønõ?0hí³endstream endobj 92 0 obj 2741 endobj 96 0 obj <> stream xœí\Yܸ66oýäMRâ–Éâ`âc±N6Øk€ÉæÁÏxx|Œí$??UOµ¤nÍtOfÅkd±øUÕÇb‰ÓÖó†Ñáßó«Í£Lóêã†5¯66Ü¿lÂ?çWÍã3l€·œ÷N)hÎ.7COÞh ³ÍÙÕæ-ï¶¼·Fq×Êtùϳ?‡ÎÐs`†:³ÞY-$tÐÒpפgŠl–ú¤ÛŠ^k®Tû5IåœnÿÔmeï@iÑ~×ñÞHËL{Ö±Þp¦ñá3j V+ÙþÐmA¨^X5”Ú¶}·Å!…íÔô¤r½,”ù¦ØÉ€l¿Í |[ê’†=ë¸íãf¦iõc¼ÙpÙ ©½&[a ©°º·Â¡/3ÔB«8mÁ´bú±ê¶Î™4´_ù±œæí;en?#lxÁQéëͤœ´í–D) (ê}~ÿ.uß¿õïµ`¢ý„X+”Àl{ISåBÊj€¡­eLµçx©LS·(¬›+Føè{9Æ,¡õìlóýæC#“½ô6ÃAmc5ôÚ6hÞ£éÐÁ?ßù" Î!ŸÛZoßîº hÀx¾À0Dœ1QŠÌJ—ŸºRhîÚFÀœ7ΩÐ\W6ZÄÁ× ;”ø(¦¦áŒ ›ž‡¦Á‚¹öŠPg¹ Hb錫Á*ðü/zÈáA)ç‚;Š“S($†1T>í"£{åщ-LJ^‚FwN@\#Jhgk/XŒB0„ŽP–ÏC¡¸7ô¥Yàz{ VòÙŒ}ä2 qC a©Lˆ+0]Y$yôÿxù:½~™ž=ŒWÑ!]3ÔQk§êØ@.„îa„a/„aŒ]=ñWŠAD®~ý2]=ŒWÈ)LfƼ›xåì‚Ø=dp4ì–É Àî2’i±rùµ]3¦aá@2ئvEüç.Uü‡¨W×QÊN´î¶Ìï”m3 ‚ɯiaDÇŠ«¨‚˜y‚)$]v€Ë¥A_`CÌN /ºUÂMŒÏé1)hœtbʬ\±hÒ‘ó8ÎÕì¶Þ¶s”Äù‘–ŒeJRÐy͈”ô*Mþ"qΧ19M‘À4òäôsbpýL`ƒˆŒ±1>ÏŽôó$=[FIã†êôTs4œ©¦Äi.ߤÜ[;#ïš0oC»Üw6ÊšÀ2ëÍ:Ã2ʱµ)ÔÍXÆè^è1˼O±òy‘eÈ%ÂÃLGGKút2„vš<:5Ž‘vadzÆý„­9l (vž=pfãu4Ö:˜Ë¬U€ù+kžµn`Ö9Ö2lmùéf¬…¹°]{›Èè]º:Oo_ŒžÑÕÏyU±Õ‡eæ¹¼é›Î'¬=ý¦ïÔ°G’ÛE½Úô½MWïÉQ7¡Ä1\QŸÝ0B‹Óø£ËÜÁÖñxXfÆÂ%£9²,žItÆÁ›C¤ ¥š‹oº0 »¸›Óof–Ë[ ÎãÝ ¶õv™£6$Õãd쓟]³ œ>D #ÇKD~ÞsÜÅðŒ£ Îésƒ¢Zökú`Äs*ù·_ bV4Kô%“(öñA;¼¾ôò¤‹[q£«DÃQ\Å0yÚ…¶ÈQ‹×]Õ¿ž±¾ê„î¾Ú±`ÍÄsëm0°·•|ìö¢¢Uw’ôs*ÔÏ/Ÿyá›¶ß$î'Æ"®i»PTkÚN’>|ƒD?õ*s4L–W™“_W™CV™õv™ût¢˜17_°4:W!é.,é -X \88z2ჟ)¿ ~Ik Œö)Ž} ÷É­ÒgD‹î©…õ‹Q¸˜HÄ@|èTêæÚøH¥0§qϾٜýžÎïÆcSø%JÒV+Ô¸ŒÑÛ2šo«,i÷^Cqï5”·Ö°vÞ1iÓZ -ŸþXÕk/vÕt0cY™‘“Öº <Ô¥êñ‡Åp‚*åÚ«‘d FÁ’Fª‡_Ø ŒêQTh:oÆ9«m«.÷Êl‹ ÝÈl®È´n¢‘¸fèwÙlv!CºJ'Ȧ4r½ÞÃGgüUÚ)ç4¿ãžLÃ}øía{®œ1ÿ?í*¦ßIÓ|B”Ò´õQÅ`äÄä “}·N”jþ³ ÙUóL´œFiB+:r… ô÷Öß¿Ùü˜Úþ i@ "±AõAQkîèÌ"> Í9pŒLj"xÏœRwz³ùys‡•H8å°R±8lì'•CÓJjdc¶nz4Û4¼Ô,_wõ`ÎÎÈoŠÁp,ÖÏ¢ƒé(FwªË€ƒ€Æ~Æ(;£‡OÀŽ;+áSÖ«ŸL]=™B§~25%.ôh”pop²áÂv {zŸtòwçØšÎëüêÎPȦÖá^ú}sî,*Ù"¶ŽC‡×ºî¬+Ù—Qó<×xÕLð¾-Ü噤×Pw†Bvš‰”®š‰”¶”=Ü噤׺î¬+ÙèˆÈÕ¥MÒý+0VÙ$Ú4Ú÷¡¥Mp¿\Ú$ÞF›Äûkê,*ÙÁ&yhÿ )6t®õ.f’l’I=z+Ô3I¯Me“x˪™$Xcçzm’†DÅBçZošÉÒ!ÿéÍ­ðÙ²Ž#¶÷›ÛXƒ-øOgÍa»9‘Çö¸¸F¢òeûƒS¼¢,Œ±M]8Ã]–¼ù(bi.q]œÉ*´äZj(°)Ý£ ‰*wšÏå” û‘öšCÐJ/¥o¾Bú†@ŠÁˆ6ÍC/ÿMÃþܧÖÑŠVé0„ß6¬€(§nriÃ0TþÁ¤LãBŽ’ÿá Ðßš`¤aïƒì·ê vÒkRéVOUÔ¢q½`?wv^!ã|ÐaXH+xÊN‹1LÝöéÄIrŸ¦º(>#D΢Ov_åÂD|ÔËó 7@^S¥·÷;oF7…JF^ReXržÏ²Gxp|]¢nüw×´{ýÒï ¸&§l‹rËÖK±DõQ_ /áï+†e–' &D×Ñú€JÄ·±X‰cPј ß¹XI™c!6þNàÐÂ;ËÓݶ—>þ4m Ùüçåiü²îÿÌA0Æ,ÿœ!ÿ/êêù o>?’âÖ} ”7Ù¾ôEtÇ´˜rrE^"L´ãê;ˆe—Üø6ÆaÀÁéÜŽÍ‘!+¨*~¼ÈP“‹µðNè^…¯_t[¼1ŠM}€L…$×›¼±f¤Å$«àD¥se䜪ڣü¾x[uy°§ÜE•nïâÀ¶4Z®{«1$Æi×ÄŠ“—öt!ÕkŒù<ëeãFÒrPº§ØÆÊbÛüñ‡ƒª`pêJçbíõV%³K¹m;¾Kf»¾ÓÕ¡ú({hQjN£\”J*Žfp®±Ã^²¥³°@y$ëPËn”*….òú/Ê…æÓþ¹:pÑãÔí+ßûè¯zìuj?J\[×bîrL§ÖSÚ-th+ç7”¼CíEÖù´Éªý¢üz~ÿ4û}#÷8µF{¾¸ .7¥Ñ¬ÇÝì‹Ëx–½lnù(RÄC—ß^Z>´U©ÇžH“Ë‘6`°°tŒËø¡öëøë‹ï³Ç-„¤ó¹ÇÈMëß0(~,÷™éÏýÖýˆžúƒâ×þ~Ïà" Xý+þ}üPwø+ßoþ™ô)endstream endobj 97 0 obj 2935 endobj 101 0 obj <> stream xœíÉ’\GÑanýDpëc7¨Ÿk_ˆðÉ"cì01Ú$Ë–dŒ¿>˜ÌZ³ªë½žžé 0ŽÀ¯kª²²rϬÅ_¯ÙÄ× ÿIÿ¾|±úà3»~úzÅÖOW_¯xøã:ýëòÅúît€Ÿ\L\0»¾x²b“wF*Áe¹_—6+Ö–¹õŋ՟7|»ã“³šûÍ´ÝAi¥ÚȦUk¹ùùVâß„Úün»S“ÊðÍ'ÛLÉ…ö›{ÛœŒ‘ðy±e“åÂ2½y€}…Uç7€Y¥$õ9|*;9ç6Ÿnùd5ã|óÒ\r‘i¥7¿Gä,cJ õ# ¼ÙÜG”…swBúÉ:»¹›?nªÐÒþåâ—@/·æ|òZ $W$4_ ­'¡*u>.«þM\µ62âR?­à/¶ÜMÖK7Óµ‚ú<EDqaäd sñ¨rG·Ñå‡Ý¿XývõõZX§ÈÃDn lb®“|R%çîƒÕ~½~óê›Ç«þ°æ«~ÿw÷Ó{ð¯­ß[ݰ `x€#˜£²çH ò¹OpÇ&µ6ÆŒFŠW9ûÅHyoÕæKd>‡µ3¹¹ÜŠI*¯Üæ 0Ô1ÎÌæoøwæ¬ãÜm^"kX& ȇRdÔÃHGiÌæ9?„æzóÅeÑi¢b5œ÷™C3à3Èc.÷}µ # c›Ç¨Öf3>ÈâŸ/¶‰Ìï–IÜk5™ósI0„ði‘FÀøih¤™¾‰.S×ÄEéýæRExÇAó¿ ú¦¼õ-±=ÿ RÁÀÎñLA¥æ (¹5€ÀÙ (…™X+èÕräAß¼†å+a@¤ !^!´4ÞµRN(±¨HÁ¤>R;>O -A–®GŠY3dC'0C†ë# Ú Ô‚RluäÎ} ?RÛ _Ž!ýs×ÄTÚîä¯j¨H¨‘íhQÓ­b€0 ÌÁ™©•ÍÁ>½€ ¬|UÒÜ _š‰L¹öÏÊ×ü5 ¸fÙÞbT®B»ö€%8í–-¡Ýû€D>Ölþ_Î{'©MØ%+FU¾êv£òDÑÁ*€?3`n¨ `S_mÀÕV³S¿ÂñvRÙyBè¤ÈŸ ¤'[Lƒà‡•(g9’ôNK?˜Ÿc3"h½òrÄL¢*¼ì¤Æs®¯`ÓŽgêœ!RìDŽbÉ SÜD5DO‹}y\ÚÞ”¶ªX#Ì&sv£sfÊd£³O…§åëqùzSŒÎ½Ò¶L%iËù ÌÉè´l`æBL y¤|a¿{6…ú­Ø ŠÉ ËñÌœ3,‚+]ð00ƒ½]ùªØoí ¦/¯×ë=ÀCiØùãž3Ó0› =*Âò¿*_ß\Ñ%z¶F«§' ÐÓÈi&¹:™:-—ÍT¥å÷VêlVêx^ÎX)íý±…¥ã­”vX¨›Ïþ,m/KÛeÑ›‡]~=ë4¶ÈÀý?¿î²¹qÈàÜù³¹sÓ ˜±P«¹BRMe5lÑhy`zcâª%Ã[³kpcΚY'OŠ7¢1‹õüÄT ¿2BFªÇý•Ç¥ñ2ì{Hk$ˆ„;Ÿe:øA ËýŒ©&'ƒæ6TÆE~RàEÕŒh8ᱤ­³jÜßæ¹~iæ5 ÔŒo× $•¾hÖOË6ÒlÛñ˜UÒ›ƒ*vsPYÂtDî¼þRÉyg™Í¬n{¹[‰ËÏM…ìÁ::4îk/GÖBiaüÜådYv(™ ß{“y]?žsÛ`’íµ˜ýÒùˆz-Å÷>Ê9ôæ 0Ú¦:K7ó>DW"Q=2(r* ñU³aDÕMÞé‚Ï™ø ðÀ‰8D`úÅ šé&z\|¼ºø1n…“¿õ‚ŸuQ†½ÙíNãˆú’ЗhïM‘E Å;¡|ç1Tï<†úƶêÕ»ôNÆññØd†G-¬4SLÈ|¢¤A¿ÅÅÂ̈K3â'Qá™F¢‰ýbÀ¶‰%Œ2ušÁÕµ³èd7æÙ8ǵ]3äí±íX"Û¬7þvÙ&¿gÛ ‰t~mè¿:=ÛBףؤõfÛ"‘®Å6OÒ¬ë°-z¯©sm+“¡m^ºEº%ç¶H¥%¾‰qaãæV’ÿ·ð­Yø.œRÚ…Ó[ ‡/Ê©Ö^~2 8¹‰komÊÏâËCº!‡¯€n'e‡0ÕÞ¾€måߊKĬüŽ¿] ªw›‚©èK1/%‚ã³ñ ŠkÙvJì•wvbÇ€ÒëoW)³_ÿjTí_é¹}±â@¼ <‹â^WÖÏWŸ—>F¦>Íì‘áý½üÍz?Yì«¿aåúr#xû›ö¾z¶z²‡@qÒMÄ(Ds ¡Ù$± ØÜózC¡¸d–àRN`ƒ`a ô\©‰CÄÈLºA ­ ˜P‡õ™- ‚1Ê;I9ƒ<÷€´…‘VBF‘WxÚZ çä m“±³܆-í¨„W‡ÀòE×2kšžS¼Øs|P‚â%@À´¤X ã8Å´•ðê° Ž× NR&Žp‡ÿMJ&‚3Ã{•e0xè WûA )#ZyÏ¿…Ã{Üp5¿ƒ¬„ïKf/&]@¸›Áù'ϽÓoNN•ÁÎSØñôÎSç?‹fpƒ÷%¬­Ó’Ò"X€Æ ¼;ˆ<ö(ú‘~ÜÞB$éHÓA0Í8"·€8h½.¸mçH¿qDÂ"µT¼#„~—AÕt¯j¥Eã‡5wQX€jLèQ•,þ†yñع±¤ï ðf‘[„Gõ¯D7‡(#2¹‡î ènTW׫kiI˜5 *—1/ŠZÖ&ÃñÒCuT3ŽÈ- ³Ats”µ,r×ApݨòªWùÜ’%JHpU‹ºW™xëL’¬ƒÀš9.Wµ%Éd†e²˜”"“‹ÒCuT7Çÿ’åXºô7,ïs¦!Ð`(/¡º‚2a{è"TUy›¶œ ¨Õ.\§Kµcwä,1¼Õ`ÚD KÇõNc”väJjèªÍ+ÀÍÐf ÍýŽe¤º3%ªBƒ¼Qƒ§q54BV†ÏEÈWg¹‘2Ž8b²‚%v㸂^>œûŠAþb¹­eD²¡ ³S’HÔ±TZä´ÁþM÷cÁë¥Ê†Hã6Âå»Â“VW¾, äTk>1Šn!ŽG1”ʲÙ6‘Ðr²é°RGWý$•pÇ©TvIyÛ{Û?$yÙ®!sضïGƒû{ÈQw^!¶å˜O)¥ôY/@ê`ø•L+¦[Ú× ;Jbö£ÀB6"I%;ÞáPÓ³r0¦7”æ6œRpü0$ÖÜ‚Kq6'Êì°šbòŠI2›²Wéø’ã…Эµ|·ø¥æ&ï7øéD!û͘”êÓŸpJd“`âQ£A´©¤•+ªÍ©ƒt¯X¯–JÆ ›£WHë•Kr¢ž¼¥'¡£ÂãÂ_la8D`ºͣpü¹‰xº>¬‹ö}â¡tG: …Uµ€ÈVQ½Ü†£§Ó = 5`žPÖP¬œ%x»odõÐQéTÜùpÕ¦Y‘‘C+¯“8h*AbÏâ ½;Ý Ýr…^Jïa¿3Ë.oxlA÷ä}±Ð\ÜêðTÌdt8ïÞÒ²sK‡©!æ;£5öŽðý¹NÏ}œ{‡ã •òÐuÀ©2I/7: çHnfwŽ’€0Tž{‰{g½À)ÙqŽ·mºêý²$•=‚sIRSº=÷Îô#‘É·º{w‹Gæe;(s» tRÙ>nËbÖZåšy, ÿŸÉ5ÉŸ®(×dÄYäz>£ÛÃ(ÆqŒN»ßº—ìÏ{‘tN†Œ¸öñ†YM3ƒýÖÛÔ4ucM““ª(5‘ÿy5ûïuUÍnñXâš-G;F½ÐŸÊÅ>F{TøHï_\+í˜ÛÓ(~ÜLëâ÷Ûàiï:y={T^*s¢G°é±2M^ ‘èÞ¼q'ÎoÜá#Gù‘»¾Ùnw+óFà›nÌLÚ…ëÀ¹ï—[6Ig¹ÆÛÀ dÝñpß-sÖÄkø”„M™y‹iPodxˬŒƒh' Þµ*Ÿ/ 2*Îê«êAkÁ>–jSþ™ãà Ç3òЬ äßuÅèþåÔ¶,¡ŸtåÌöFŒoŸýÚ{9‰hÚ¼÷ûwÄŒIž.…`ý&^ aÊ-¿ÇX¹EJ\±xÝ”{ S7…÷ž1kdb=)£v·,¨äÈóáÊ\s™¨?âØÍÕ¯ÞW<¨43µ%0™”è8G/êÔûíå"yõ‹Xšc)G´÷€È³uQj6OË3}ûÕC•4Çr¹°o]"0à‚‘=£cqŽB+ØóÖYå³%3Ôç_!è¬Fðik`™Ï± „&Ú‘kGÇ= ¦0âvŸˆëfŠ RnXÅd86Þ’lªjQg+D”€ñ †qáàCèõ/ò÷ƒ/6â24gꨪ›÷yz[Ä—lÑ®ð®‚5xE /Ó•+jckD®¨+¤Š(*°èg0‹$ÂÔÓ42¾Ìõ7*®õšÞ%âíðÕÑ“Š„9Ü¥Á-ð½7éª …º _G ðÁ׺²‚¹÷T$£!T|=Öo¾.8g„3-ª¢>ÃÎ|Éj îã•j£‘t(E’i¼‚_ÞëÌåý¸ Çåj30‘VÃH.2¦}³¨½>^JÝIÏñ.(§j÷2œMÛ ášï>K‚ÐV¹® MºV#?6›ÇÖÐz¥Mëí ˜Ì_bÝòfüBhsf~ÓÊZá7ù\¬nq| Þwµ¤·Íú.ávñðAê|Õl+úy„¾% ŸOÙ…Ç‹¼x9ɸl¼‰ º\+Íß„í;"dä|²ÇBQƒDøß?IÏNÌœ£¨?¦€n/—9YÛ¸Òn9 ,œZö\É2q.E›U%WO½ú~6; < {ÂâQ}ô6&&5ÂÞËŽñ°ÉëHãç Ð+D« B²¤85ÊŽ_ønÇá4“Ø#¿ÄF ‘Üüu›ïäÐùi†È8×c/™,Ö ò÷vÒLÁ;9ýQm?ÕË@t$iŽ I@"åù(³œî ‰±I»Ÿºh‡\™) 5AiQ‰aUÇ6Æ¡>I×zlÝ×L¸  ̓#‡°~CòÒü´ŠsƒÌcæ&ßè±_Ɖ[¹'Ñá$ZÆš5Xw†0œìFÁIÈ›ÿ;}J>Èi¢Yå›® OJRþq¬ ƒ‚݉º€¥G’R<D ãÓ1JÍõ ‰À¸0ÒÕ$…E‡.hbûl\QäÊ@05cË9rßÛuµ“²Óp…:î᤮’î©SX?üüPS}ëÌž£Vjö؈wsx¨ÓÖA½!àt ÛâÁ”&Óåa©è=/²…·ÕðS€ ƒìùÒEº¾®³+&í´\̓cÁ°­3D±5·[$o•î¤ ¯‚›ý¤7ª½Åìï²é‹¼Íí›:^÷TUѹ :@¸Õ41K’ŠËlÄŒ×5¡Ní0c‚‡Q–Á/,Å=áfB{D•ôî}W\˱ݰJ•B |ãN©Ã*Y™NôbîͰ¹¢]v÷`öÚ®ùÏDQ…m¢€¢Þ‚…GŠjÅJ+ú0¥©’"êEµ´C‚h¹P*l#M-ÚˆlP $dÎL—«º×UÃBCy¾ä“Cå#? ŸÖ—@|F`ÕÿˆV£J{Î`Íø¡}˜4®·ÂJ±¯…5̸¿q>ó¬zB2®†9s"›Ã^ãæ¼Ek=Ò:«x¿Œæ B€yè(² eƒ…]_×bf€ ë %ݳ‰1FÏ)ÈwiUŠˆckëi¥³d¤jAi’üŸø?v~Ù[‹T¥O©èÜLÚˆòÅîâû«Ï©þ4?Z½ˆá‡©_Å|IÇÈË?›ŒGϪ$Ý•ìóíÝl¨˜]HYÝZ«"ÚÍ,bh¸•€%º9ý§ù˜€ç߇ʨ[r(¦1cÜÿaXk(Æ ¸)cÁͰÇ{7n´:"èýNRv9I{j#ÍÁÛŠEV¸êSe¨Xñfã9%1£]4ì (‘êVó¦gÚ/'ƒ~»úN ƽendstream endobj 102 0 obj 5070 endobj 106 0 obj <> stream xœ½\Y³\µ®JÞü+îKŠ™à9h_’'  ’TVâ7 *`c›p½&àüä§[k·Ž43×@ŠŽÏÕ‘ZR/_jÍ×7b“7ÿ+ÿøìÞ;ù›'ßÞ7Oî}}O¦?Þ”ÿ=|vóÞhÿ”r‹Öª›ïå/åW7^„›Ïî}|Ǔ܂·2\{üôÁÊÇj“JxüXl18md–Á/ãM{§ƒÞTè½¾<éÍ9iíáwØ«”*ºÃ»Ç“Ù¢²Nþz”›7AøÃƒ£Ø¼^~€MUpÖ>:ž”¶›¶Jh\8lÇ ©£*‹fÓ36n†óÇ£†¼2‡¿tþBeiÃ>8ʰù(ý¢iïêïõ©¯U—䤃GNÚmAGãÈñ2c¢‡/`z0NôþðY߀WG³!„¡Nm FxT›6Ñ„ú‘vîp‹k"‚Rþoñ˰٠IÏ/Pnï„™, › —1Éûçë:ó Ûj!°lëôæƒ&mÓZC¿i™àïnS°ytŒ‡Ç8@D¡Ý~sT á üIÓ‰ïP•a`«Ò¨*ià9¼O7ʇÍÁ°yAVÄzýn—qMàŸdlý褉ÚÝÒ._ãdý&@ÇÊd¼å‹aP…‚?ëÍÙ‰ÁêHÛþ ĈBGÕ¶CÐû…_…a7ÈÂ2ÓŠZiÓ6¡>i6­ªúÕX™ ¬,…]/ò¢ ["ð”†Êê¸ü…ÐGSX+Ø¢õ 7SÝÔE—†8”eë¦y„ †lí4râÚaì†@”&Ädž°6Á¬ð&“%ýÁg–Aš\O‰Yì­eÖuµ²g88w»týR @!³hËoVq®N¤ßÞCd†Á"·Èøè €ûc¶Ý:UL¦Ñy6 ðà þÝÒæugÀÎbo/úã¯ò¤#$•âÒv. Ü5¶W=q¡Ÿ¡Ï2‰¥$h63‡³ºJö^›Ù“6³qŽ0ÖlŽÊlîZÌ #ˆP¿ßúÿ±c*#“S¿³«¥€(7#ÕeìÑj½{Ó€Ñqœ´$n&1"u%ùsc¤f34òÔôˆÈÙh iDmˆ_¹MPcìó'&ÿøæÛP2;¼$¾}E”¡$¾ÎØD¦œÝ+÷QäêaxE¾~JúdÐÖkl‘qBNÓQÞqñ“¼¥/9? àˆ¤>žøð⸋g¼¤áÉ N3ðDŠxù[j»l[v)Y2änõìËר·ë”[²è…“Måò ¼l:§3…Güœú!ÉG-Ñ”b£)\RtÌå7ª/@sm¶Šûn[š—íiÜ´5Lé3èÜáwtþÞ–¢sÄ Â1뼌Îí†Å¤ìÌ@1u\’ŒEž¡ 9w†ˆ'I´m?~ZÝ3,ؾÏ'Áâí—óàû:ƒ’ÓR’vœr^é‰ÛHQœNŽÓ€²ß8θšë«únªø·î>~Æôƒ¢¬âÕ1‘£ÚÛÉ>äŽ'±GùÏ!)ta­fZbë9ŸÏÉx KÛwŒ§Ø1‘,’æK ©†È¬f˜ò6ßä¬ÁéxQøÿß{ÏQu8`y@ÒDù/ Í”¤ö“€Š¢š²Ì틆l/rË!qw`”ð(O¸–&SV Çþ~ª•WE&Ë„và*'ç;~W.Æ@ÎøÚ°ìrqL]g‹$B(Vè°ÇzšeÚd¼›Z  ù|ÕÀîää‡L€‘îÎù éžOËÙ)_;Ìæùž":v¦¼¯g8_N±à¹§V3s_±: !¥Æ>ß?-h< ~.±\Ž¢>ØäŒùºÁê)2(±´r³ìAc Ð s§„/òžxIJQhNÂ:¡YK-m¸XEð„بûàìŠsc$R]òjµ¾džXëÄXk²Àò;f(`êÍXýkÊ€ºÅwcí»¶Háj†˜ ¬;¶-ËïR´Gø-¼æ°;ʼn쬢(pg;H”ÞÒðÑ[󶔨¾CÞTyûåÅÒºâÑnñ žq³$†-­ë(ä¿FHeAsA”ójYUS· „þ8®¢‘º0ƒ=åaMÈ9Ä:ŸJ‹¯ÈSÁlb j9DÎR–.1A‚‚[ô¹ ¢@OŽvÈ­™gdE1Íj0:ÛŸ äåË£…±ìkžªõy7í²‡y©"Á¥—Þzðw¿ÖéÚ‹Rª¢òÂqØ6â3wBÄFÔ¤gn¤Þ}†©ãkåZ‚¼†?± àÞ/“àNÑÀØmõ)6•àF&•‰M Ëw9–H‰°RôœöŠ9–žÚ!?#ß•'¹F&nÎ$§;Á•eˆkRž›lZÖvfííƒ}Xê¡dç3ëò¬)Ž®Ì_ÍØ€—Y88ïA¬l‘Wåtñ\ðJ9 â=üuɘ™ôÓÆRá„Ó½LO\ª¢Ï§.­hÿx¡žè{O(ˆGè;|¶@èCźX¹Ö³¡{þ°çƒ%…] ~–•ä>HyðÂph”ÊIÙ}Ÿ‹ÍÕGI žä©ŠÌÜà a0¤„²G‰®²}aûÕSA¾ó¨Õº»&³‚ÅÜÀhæ¥Ø\Ì‹'¡xèéÇ+8Ï´ãA³)p$wVì)G™ÅØraÄè¦ :Ž(s«¸‹Ór†zkí|æ1–“ÿ§2YbÏ,Ö`ÚÃU±&Sj kiûqa!7†âCâ'`0wž¥U†ˆ±Ðiz+,î³ývB—$ˆ†7-i[3ƼœK8JÏÄz<.$5 hÊŸSË­ÄÀ$‚B'(üÔú_eó0†¶s@–ÆÌ¢Ü¾ ág)ÂÍëíô®8&æxÿro!=Ä>Í’£A–A®»¹3YP48à„±½~ÙÀw礽߬ …šµ©×` ¥MGÇÅéd ‘O¯‚جZ%,Ôó.å!Íç­DYX‘.!ÁðÙúæ‹&ÝgY‰¤ï!óžZ+èÀ+¸µŒp}åú½Xr8w‹Ö†ê(ã’Ði2HÑt¯îbÀmˆÂTÈÎY¤ËÃ~Ê“ÓØ0†ÿZÖ5ÜøAÕ/W[©€d ¿‚ !shd½/˜2T§ 1½‹ÁŠÙ¯½¼öT¼ü5‘Ïr¬QËL‹kke®Æó: GR&¢ ßábÒª¹Þô¾Ö9/È+»Ü\°v|0rt%¾M3Ÿ®ˆýRGë¼P¯´I ˜öub’Ÿê7§ÎõŸ€ÀFÕk®u .ìùr‚88è=åä¶¿÷×á,êAAXÌ^#˜`w˜aÇÉ•ŠÝͼéö\uHÒ¦ÿè¹r×s’k¿‹èæßž )‚] (jþ1¹DOu|%Ý«ÝišEÀ9ë†h§¨2ì×üv±‡ÝË¢G:Ê'ùäâêûôâ#a–‡+S¬ÆeÔfUΆ©—&ýÀ¡µZƒ’§e Þz ßÉ¡×HOüºJ™\Ã.5+·Î05™”œv1µD„©àgPFDóŒï³³_pœæ…D¯;–;-rBZŠ÷ÍXy8ÑóÞ2ݾéþ!xñLû3!¤Üξ*¥EúÒÊ—Üý.J᫪ÙÔòù¡éîŒ.z™|÷ƒ©¸CïS—6ãÝ­Ä3eveu¨¯$@‡¶.½·L¼ìP%­–Pþ1‚ã¸QÎqwÑ|¸„—3Î14Ÿ Ì„{4kY+‰ÁÜ·»7§ gîÎÂ||:£:CB¾0¹›U q;WÏuMމ¹Ïþ@`#@àp®vÓ{}¤ç¯Ë’XVÙÒ[kaS{Ôø Û1ýp•’DEHT ¨]¸•M2UÒ#¯€i3B—|´/˜Ô‡/‹ÓžÆ Yž p²vâA«Ò.Îýé1V‰îøZm¯ºÐÉF4 ÒLš:^¶X¢¥ïf?T‘Øö€W‹éÙÊ.vÉ 3ñR®Å™åš¿áuYŸÜi„µŒ©ß˜dõäÍUQe5™iæ2B½´°jîqèx‹xž<ÀX˜›SnMèÚÛLÌØñ㧦›Òîkyùgˆ4¬¸·ñLX¤llž USð¶NŠÊ%©ûÇRˆµ8Ò löû ³kçÓÒÉRŽxJ¥Æ1²ßËIy\­j¼m¥à°–ë÷-½ìqÛöšñ~䛡8òšë!' k·ˆ Zýû‡í©_8É}£O{5¼ó £Ô§çíé“#­Ðl›•ýUŸûO?¥úDfTdÁ·¿…)›*Äô{Ôï ïpÊo·wo¯§gêÜÞ¿óÜÞ¿óÜ>nýëX³›§óùÓdkÚ}“Ò#¿+þlù…OÉÛ‡(¥%íøZì~쪿ªrêM ^ž3ý!‡þc+‹Ê´éWƒkMD¾ÓÔäׇ0ôb:o!ØcüÑ”}rD\2ýÉO^ÂíJRÑ៥ÆH­ÀþgÃ~ñuUù¯ËóoïÈyÏ™ãWÔ£Üûü÷?¼±Êendstream endobj 107 0 obj 4842 endobj 111 0 obj <> stream xœÕ[IoÇrä¯xÈi^ì7ê}‰áC¤Ø)¶%&@ û QÖS´D2¶ôïSÕkuOÏE†lÍëéîÚ¾ZºæíŽÍ|Çð_ú{òúèÎC»{qqÄv/ŽÞñðã.ý9y½»{ à¿\Ì\0»;~~ÄfïŒT<.c”å~WžY±³ÌíŽ_=žøþÀgg5÷Ó¼?Ài¥šdóTk9}½—ø›PÓ¿÷5{¡ Ÿþµ?À–\h?ÝÛälŒ„áñžÍ– Ëôô ÎVÁ:ßÂÌ*%é[`¨ì윛¾ÛóÙjÆùô_Ò\r‘^ÒJOÿÁÃYÆ”tÕ¿Ã[°”7ÓWxdáœÆ‡!ýlîÆ§F«é¿{XUhi<þ'ðËí8Ÿ½ÖÙÍwBëY¨Êû…êo#ÕÚÈ‘Üÿßß?:þËãDHKñÍÉÏaXN0}„jeôl)¡÷ÊèN÷ ý¬<ûl(•)zpMŠî}0EËèG¤Â[;JŃ. ýŠ8z½úŽ^•Q8—ç\“y-z³8€q)”óôœ£‚?©8u†ÁÁ>˜œžh1 ¡‘U€K`ר“ Èœ.`+%4̼Pp `T¬Ò…W´wž¾ò,Z:Êásxjàh\æýÑ>/ÊÌÌ% *lïÀNñT@•ãÜåÙÒ²/Ùã<¢¡b|z¶SÞút0é=0,–è•Úñ´.泉éˆÂÊ+@¡H® "X®  `Ò‹“ZpóþÚàRµµjÊEyvYF=(Ô7>z„ó ‰Û†´Îó„߇¶«ÑHzÉ>1 ëm†£‡Ÿ„à›‚•R ÔóV)òªX}•VÍÌw’ð{ƒgø;ŸµñÓs ‘Œ&aRvŽ?Cå$y€Ü’š"ÔkÜU2.€”„/æ6…§1pMï—¸BIEš—= 2aCŠ<ŽˆÌ½¬ 3½/£C¡1a•¶ÆÛ«žÕ ‹,K“0bë½åŒK¤ÞÌÚ‰m¬…7õd‘JÉ9Œ´4ÞQÎ7,¾@fùéO l 5ä•‹=ª“„®D€u;€v¾r2KR ›È6a!…Âù ‰iGX‘XÐ:Œ]*ª¢ƒÀ»{ )¶6ž†ÁiTCè˜ÝHÔ!Ruˆ¡ Rv=Ï ?Se§žÙÊàbI/Ü0¦ÎU~—<ýŽâ(`Ö2R‹²r °àâíÌ Â¨K—«°­Ì;‹þ˜kâÆŸãvõiÝœ O™ar«9u‰¬¼Á Ô‘4PÀ£;ï\¡òÊm?ÖŠ9W 6’¤’({†ÉDv!« $Â*æ*úò%RP½Zé×@§êJRzÁ(ÔVVÒ²þÞl[„ZN…ÖlÜìž¯ÄÆ+«Y! ¾6­âLÌ›0À;Ù¯fTíhï8dÐdÏ?­pµ.†^ÉÁù@þ¿ƒ3@W>L¯+Å…¹m}Ž M€@°a¥2¦Óx§e‰ó9Ž_$Ç ÅÌ5œò ²A„³}¶E9 ”?9‡ ¤g›“tŒ,ãฒ%xéD„ÁHÁÁZYÉÌMÍ$9Õ2Fþ)hî‹+]d¸ìê ˆ¡à¢bà–š뙥3žîs!©.*ιYsAÔ‹Š£êIdNiHP’¼eZ# :dpŽÊ‹ëRå+¿“㚘?CQµy­ƒv– —•^?Ò:ƒe„ [Ù³°C-áU²J- 5²Í_³z7 5>ÜÀ ±™CtœžhŽ‚pRûîÙ¨€#Ìm*¾FÌû”Ú\dDîJÒÒ  ‹ÀJã蔊:a‚ŽzdzWº‹‡ÝE …GW@îIÞb”XH_ç΃ŒúmyV~ì' Ãò`Zè)@„°ZòQã;üÝŠ… [F§*¦C„Òxæ§] R«)gm£ã/WB;ºËmÂÖ aæ†qÓ2ÅH9ZVfy/ò\HAÙȼN|¯e6¡œ[²´ºv¹^29K³ƒœkÓ¡.ýg`<ÇŸGrËÅlÉ<¾@ß Faà[`J&;ô—‹JR”=àN´QA­8Á÷Ô¹3†Ö:Üjý葼™%–D+yG™¼‘û„“YMèí8!ÞFœDý„Áèo™ŒŽ€h}ŠIKF£4Ih!2¤0Âãš·Ýk,JÑ„½y£×±ÝÚ ~5(F^KL`Ü«%¤-\ñgW»ÎŠŸ+1fë@Ú,BššEÔ°iY )%Ñ.Ñ+ç¤ê@9°¤Š–cY$¦4'°djÍAÆN£þ^’iEÎý’L]¤ë-¯{ºúØ&j¦RÛá7Ž~.\íj'ðvDG~ +â}5>ÁYÍwºcz¶Z×èK=tk†¡q”ýlÁéZmiC&LŒ^ŠD¡Õã@¤F—/c6d¿ºÜB,FQ‡hMw”›Ótéyƒ9‰æC¹‹î,ý+ýTECøÕ.ðœo@gÇ…¬õÂAWdXÑã²#ô€'°Ÿ„×5wÒ¹YT7)3vËMrEÑ×Щ Γï\êéÚà„…Ø «Ü}P%ÜOƒ7‘ba½1Hs>˜†`3{„4+Ì0T–[ÄÆ´õ_à\Üs¶Q{S«ý?uaN[ůõõ7åÙÓ2z5x·®\ û>C¨Àõj Û‡k†F©n?޵ž=‘ßfCGÑ/= EÇ1ÿ^^5Ô(ð¤\Iôìiãáž=5FÆwɽêª2Fƒ§ZÜw…K‹î"&<»<[¿ïŸ¼p@hÓG4ýeÐïª &Fù7S…é‹­Ü`”0ý”‚\ * ’‹KÁ ö;ƒgÝ¥`xÖÞxU¨ŽæÑ¦6ÜÛÔ†»×ԆǷ£ ?nÀ§рljÀ½M ¸{M (ÌÁ;Ò(<ûeyÖÝ‘†g«w¤á×¹#%ñžÉ嫬1ï:ñK“ÍZøÙÃð~ùù¸ã#>{PFßu|Ägß Þ}Tž}¹¡ œ©Y]KÅHžU¸©bx:`ÖÅ@ úJ.så¸ÚÜ6×ëóŠé¿þ\᛹.ãÜì|«Šwò|[\ÎK‰ý1]ô“z1Ýíò.lÇÀž¤×$Þñ7—Ë‚IS¬Ì—“4äæn–ζušQÅñdêïßÂ|Ŭµæ%y{y?(¤oè¹·˜è Ë9Ùˆå@9,]ïèxL)nñè¹ÏK¤½Èæâ!i5?lÎuÙä4³Ðm*Õ”’ŽªªêI›:TLA•—a Ps%Ú”Vh‚C,¯îÂ!šÕ*·È”Rlç‚Æƒº–ÑEî“´¸ÞÊCÁØÙõ’Gè…u¢)FsE²FS©%–:"+„D/\Åëµ…I+a'¢t|a‰±ƒ0tÀ~Ó[9óŒ’èÙŒèûùŒO[ÕL%Ú¼PøTØ»M[ÕÉÎT‘tÃ?š¶`FBÏZ—dëJ*õ€J»Me¼!ZPÕzI¥r7ªÍäÞŠUkNLj¦“¨o9oÌ']Ö5±,åD-”r,ñ ÏS5C˜|å%C“Ý¢ìYN‹‰XÁå\Ð>tÞú£d«^¬©=otœlÛx×å:Pcd}ukãYuÛzò‡BíB¿Š‰59—â2Ïýw:¿dœ°ù³ˆþ±ß ˜…ÓWÀ`ðê´ð]|‰Cí„ <ÉOÏêÜguH&<‹üå•ßϱ{eèÔ˜€Ê¨²ÙEx â6ôiÐ éCû .k$Þ# Ÿí‚»Ê1` ¬ªHðZR)áܲ°Ž}ާ  3ÈÄéJ·Á ö×C¬ÝÁ¦g¦ÍMÂ¥tv›ìC¹¨‹'!`+(ÜuÅeËÁ#98²¡õtòÚó½¶‚g&sRX7s´·o±ønðò‹ô0ÆíñâÉY€Úò¹¶lÑ/<œƒBéfûBþ¥R¾ÜyÙbZKûMËÉû¨îÜ›åí ʶvïQo ‡Ç­J’Jø¦»6¼¢O2 ÏÛ®¨¶ Õ¹s¼þå`é*-«©³¦m®3ýU  ßy¸¾?<ëç1øw°?u?ÕR£rR4÷ñ»Â¶½ç{ žÃCˆ•Wårx9F]Hù˜f#áÑ÷Ý1‹«ïÜÂnð{Ã[öj=½ñ÷¶Y)ˆS¯ÚSF‹S5i¾¢™f'%EÐãËÿœ¯É•Fa¢èµé-'c<‡€ž9¾D#ñT#ˆÅí%Zî’ÑÊ_Œ-º-Yr¨¸V:îhÚpÒÍNÉ6 ’ÒϺ½ŠÚiµ’•¼d€ûý=1~ ºÎŒŸ20öî¦zµsUJó·qåVRÁ#?}ø%!œê»ž#Ó‚qJ@.ô ²ý@št·z#­xøè!%þBaN2±>Ù¿òêVÚ9]¯$ûÌÐ z×L1¥q†ïãz²m !{M ¿nfV¶ âuó]é!QIüϸð•ÔŒ|•lhENC+ ]ªáúÂ~—y u!áã;¿Q7HIÇu<ç ´¼ŒÝ1ܬVÞ§¿v#Þ´LÅ”Ìô-Wë½ µ5RÀV:7ê²# &ÛØL8´í‚±ÐäÖºX³ïÈ_;(IÊ?¥r˜™e)‡ý†aKÍ?«cÑ*[æ¢w:îuÀï Ê7Îß—¯ªH$DJNDçb ¹æKeå!jAÑÄÜä—õbš¤àT{¹«Õ8¶ï“b ÑpÔ Õ·eÐ/xrK±l²þµSìiUƒÜd”×ï}^ëõÖ5z»ÒŸUTa"[›F×ûÔ±Gij­PnUlCS;/U2Ç×>ÖZÐØDÿ9Kr­ø½“}I7­É‹ +ÛÖÄÌòC¯OüžÐJy%Ú¯~ܼÀ"0fQÑ,‰5qn=6Žêš 7œÃÞu}ÇÓçË(RæÀ#ú-#Á2‚ZÍ>ðžó‘æwl¡Dªzˆ'i*ñaQae—ò {ö¸ª§ù>ÑïàÏßv‘×OÒ·‰øÏÀ”(KjLb &€iÌíê,~5Ž"–rDrºMÁ·JÒÕð. _ÁdÃWÇGßÿÿ §endstream endobj 112 0 obj 3978 endobj 116 0 obj <> stream xœíZÙrVÇ®JîôºËù ÿaö%._86d#!…쪀ll½Hž7ݳöÌ™s$L‘¥¸`4ÿœYº¿îþºgÞ²™2ü—þ?~upë¾=<½8`‡§oxøñ0ýwüêð7G0þä|öZ‹Ã£§ñK~hÅ¡eîðèÕÁ£‰ïö|vVs?¹Òüöèéc1sÁ,~ÌfïŒT<îÁ(Ëýaé“NÎÂÕY¿Úíål ×zúÎʹðfúr·W³ÚÈé/;>[嘎vl¶œè¼C…3ZM÷w{!õ,Î;TÆMónKJ/ˆ[t£ã)ígE6sw'á#+Ôt¯nàÝKYöhÇÝl=·+CëTr«Êªîd/Å-쥙ô°ØÇ›°ŽòÖOç;ò žÀAaEoít¼³TÞûé9ž“9ë8wÓt+¡™l»_ã¬aj:ƒ)ÌÌÅtbµM¿k&èдn6’Nû2Nk¬gô³pZPµ6ãiÅ9g%seRNßíÔìèsz†Ór« H ·qJÅSj¦§ÇU¯/éÁâÚø¡¡¼2²A¾¬Ë „#A”gqR;>Ý„]x1ƒÈÆ»¬_‘•O‹ÊŸ ¦³!»9#“ ¨Å £zu&ðU \ìTR ¢x^ãg†øf•¸eÇP0À¾è´ï@–Î{'igÚŽ¶ÆÛ¼püƒ z²Ë––‡x§¥/š,PpIÿ¬Ü´ZÖAˆp€±ƒµÕQ?Ö+/§=: £‚™í“HöÜ’yF: 6Ï¡¥¥ñnz…+ï È B>9+ü‚ÏÒ0°Ü»GŸ='àùÌŒðAèÊÌÞˆ$ø cÃ[•%-§Q!j_ƒö…NXc¬HØÊQËÙJ;½EûdÞ"ÂÜš)×h‘˜ßùŽÃɬj†.w –†þ(F!͆‰²«ù ¼Ù44a@Áš€ŽL[5²9Sògß7㬾º±iÿ~iXCì•q8©ö.â×€ÜawÑrLk|`ô, ôO=F°NЃRÙ:ëAc8PM8€bX5å=ìN SÕÖÛÒú[žs4¥Üw’ûFÁFúcŠ£ÈVI4]í©9icÁ ™‹ÎUèK5»ʪ‹… DF+Áʸ÷q—s< úV9åqhán^—ÖYùõié{^Z§­ÔBßyiÁÁcÁÖ\4vö"Ǿúq'rìÆw` JÄE#¸_Ú¹D.$ÇA¿ú$bÐWÿÑØËYäýTçßT½WµCâ`b§kèhƒr³†±Œvaèï$Eé(4~„­ƒå’æ %û¬ÖµA¸é—‹}Åùq_TaÜVԳƚôeÕ:M´G½Ù&`æ†!Äß”3ŽÀN{†ÖÂð;s­ˆ=Œ^'¹ohî30£4'«âY-meWýá†*lžóeÙÓó⌞”¾×¥ïué{Sú¾kÇu_Ô™/Jß{;Áì<²ÌÖ#ç ªâu»Óïú$Œü:óó”ž(eÚŒ'L2ͪ±jŠX$úfû dD2†N‚XDŠïNûÖj<~g€ â:jìl,…x”'Ò†oÂÅôÏÈ\aáfÃu‘èȘ¦´þߦ…Xúãl=OVÄIMÞ†ô}ÉD).ˆ]ôG‘LëÌ.%b-²rOXyÝ~% é ¤]õ¤bíL!‹s‘r–·¤¹n#9s⃆ӡk»Z ÔeuE¾È¤H¼Û/y÷2]•ŒËAºº+7ÏD˜/"MÀ‚ë,9ÉÈcX©õ­m„§T`á_–>^ZlËó"ŸÏËý}…@uPÅ`–˜/ÈÆrȈ˔QxÞJ.àW´LšDG¤÷×M>³ `ÞÌcÆÛk@žo˜r¯^|G½z±ÅKkS½ ©ƒLSnòºó{ÈBfßúÜj #¾7R”Vq d÷‹Ln—#|Yúî–ÖgÝQ+’Wø«JvÌš Zš&ƒÞKcggšÝG²ƒµ‹EœCDÒŒl³f žûgLDi*#=ŒçM¶G 9Í$…D>ÃÓsˆÙvQ¼‰Šî>LUǵxßo¥ÃWÄ7Œ'(=ð—àÍÛÌì,mW­—(`\.ªL*IÄ3iù`¨z—FAFïšD1DAÅ€%güŒc[›ïl\)ƒˆõ6~e¥$ÕçÉDâ_-m ©ÑÇ õCÖ3;±r*Í!¦ÜC˜jpU=7"UÁ)6tm¨Êed œ«•bÇb´‰…ÁkþâwkÕaªÜë&f™†ÆÒ­”öŠˆ¤1'c.5-ëˆ2Q;©Tiá$‡"™©ßÜ€‰€ºÁ‚3‚5ˆéNÙO…obdš™¦tš«# ÜcËl1%á·îÛâ÷­ûBr4‘!Ò9à*B2ÙO—pÒèü¹q`¡rÜG \D’à ÒbKéìÈ#H ¼Í^˜V¶@É @G¤‚£im‚ZP½i^©9wEð°$h+X'6¶h} DšŽÊtb¥„Œc½Ä,s¥<ñ4½6 ‡_{…’…"݇¸ñOˆPÓßClÓ¬}Jñ+\K…šé7S05•ŠóQMºÉ> ÇÄjðø+½2—;í7ÝE‹¬…Ñov¸U?K«»´ 4c62›¤—µ÷#5Gk¬.‹x#—*J@÷KFßNµÐVÍΪ-§ê¸-¦6¢ÁøèªÑ ERnE Ý\)-g&¢ëên•¨Qž-ª:¨ÍøYôù}º 3W6Ó{' —[/¢05‡°±RŒ#Ö³nÀÄØ1“MMµÎŸKõ¬,pZ«)c1tié‚ ö¥Lýµõ}ñ>É…²X2â–°’á`çÖ®’† •+ËîGÞ9kjùWX-n¬Š|Yp@Ÿ5.gŸÏLBÕ•¤®HÃņþ5#¹uª0 SÕÂÃö]Êàå+÷(531¸zºÜ¼\R5U©•"(r‡W¼¥V'‚Ø<•ýôÈÅæÖ#SÎÅú$°»„ '$*çÿsbkÁûJ­&/â\=bucWž_™q1zÛ·’4ô‰MyÒ—T„“êp0.æÕ­4 ‹Èïý>4Úåÿ•öQ•6´µ¶ò¹·©.J|ùßè RÈ Ó&v¤Ø´` á­ïÊLùÝZíîªhS/î –F¯€$ÂNg§Ó#+0’‚Ü÷nðk½¹¯ß>/¿öo°õ¢»…¯ ÆÐÜÏmar³ó"jx1^zS]ŸQÚX³¾Æ”Ð4äÙì 5Rã’¼h襆­w¥ßK­Iü8=»FÕ诜ûó©1«ÿ.åæçÁ]âÕðUiÝjûxn”¾¥¯µC žÊTlâçáÁÏ7ñóèÃçÛ<óÏ‚™ßnbæáÁL/¯3E^pÒßùSi=n7 ñ¬:ô½Úü¢nõxà©Ö!V.¼3¾~,½)º¯h9'K—'eõýÔQ'âúâ [õZöAéû}iÝ+¿þ¹ô}±ÎT‡’5Ô ¼,-n«êàÉ@RtÞ]†*]kŸÛþ½ÚS ï>‚üV¤f®/6mr«¨;~¹Ý>:ø+üûîƒ!endstream endobj 117 0 obj 3379 endobj 121 0 obj <> stream xœÕ\Ys·Nå‘¿b+/™´cÜGTzÐA»[¶#Ñ®¤dVEeŠ%Q²ÎDùõé`€3Ü%W–]~ˆÝ__è¿^±ž¯þÿ}r~ðÅ}»:}{ÀV§¯øðã*þóä|uû€?¹è¹`vuôóë½3Rñ°ŒQ–ûUš³be™[<ìøzÃ{g5÷]¿ÞÀ#ÒJÕÉbVkÙ}¹–ø›PÝëê½P†wß®7°%ÚwwÖÙ#ax´f½åÂ2Ýý ŸVÁ:ßÁÌ*%é[`¨lïœë¾_óÞjÆyw_Ò\r_ÒJw?"q–1¥]õ.¼KyÓ"ÉÂ9“!}oín‡Y£U÷¯5¬*´´ÇG~¹ç½×Z »£ùJhÝ •¹óM:õwáÔÚÈqˆGý>/´æ®·^º™GóRÆQ —)FöÖ1G'Y:ʸΧ!¾¶QÊ®6ÒôNzžý°Ý9ë¸ëž!³8<Ëd÷¹í®{³ #Ì&­÷¶Å i{æix¾½T^¹¹¾O´žá¦ Þ¤ëòd/аÓÄŽ@ß½ÂIè~ÆIßkfºw 7 Ÿ©úXR©ž|c„4äý70Ò ‹s|E2Æ}ä¶*É÷0Æ#8*œ6ýK}FO‡®þ1ÍÝI#z"`9Æ»k0ä„e@‘v]ñ.Y1ŽZŒç Ñ<ŽJê$h¿¦Úù¥ pù%_À“š_Xû‚ ¯ø#<#½sRøRÖ/É6§(ÛKÇ7£„#9L~L“ˆq&Ĥˆ›9†XzmoÊGY "eÚo`X¯¼!fí(xãK²Èá-<!du÷Xí¼wÕRƒºÀú›‘ÀAõ„›cVnAõAO ¼…˜]ò&#ò%/œ]Xס,ìk D p¢{2j_÷«9ªD>d¤Qªft«¬=…T?ÂÓÎö\¼A6xü¥“g hë™2À«ÇëQ± Éÿ5é~K¹Nv¤Veõ¸•TfQ=$*÷ãš×77=¸ §¶#àv"à´ñÜ»%¢”, 뉺ó¹¹r÷sp˜F•X<çú2bO.v§jØ­¢j˜[¤*»‘&}¾§†~‰8°¼À^±q·ÒÜ‹4÷bœk²Q~•~0}*lí“§Î{pºÂ{öô—!BRÞzbµÎ¨‰–“IjÂÐB:‡eÃü‡÷^ K ·ˆ„óÀ77ä=c4âáH;Î{Òrà$8`§yœ4:GgGÂb*³k-Œæxv;ïp+0ÝÔÅe_þƒ0uµm.îÛþ -ØöáÈÓp`‹V<[# œÊä™eFçQlÿðNKÚ*@^LhâÙgV‰ÎR :Ù>fÛÀl/19ÆǦœNŽ]Ž"9ΕóISô2Ä3eHq‘jQPq†0À~i‰¼‚Im0ÿk££ÌðÒ’ºAàƒŒÎ€(9o‡l€ØNsQ©¦†S S࢔”†¨¤ZÅc£øFû‘¹Ø¶PÜ\:œv ‡ÁI ¹äÔj a`†Â9C­ «E`nyÜ)÷ÃÑuî&%&þJÛàa…Áà4êØ0+ æm;yó†ñ"Ù„™6µ›PV| ÞKÃDx>ÚG„_ma‡sÙyGÔ6¦î?1•³¶••íNBnnµ¥HêÎe÷’кàzR Yò^[~ à®Kh˜ç¢²ß-³ÖÌQ x˜Xë)OòY9#êlƪç5t}ÒÈ[#ÈdRb…p8xi†Ü—ÜM ¬À‡ oê¥ÝJÀ4½r’çKh„Œ(„1º&î‰:dè@5‡Œ£™‹]nŠ­È™“]âT4m¿Qú€$Û–£Êæ½pM'È@Ñã3.%díCpžF¸è‚Á!×J´*8Èf'7Dò_P70.EÞØÊð‡Ni?bž¬|R¦œ¢N¥‹UêVËfC%2c/ƒÿá\’Ýj[£s¬&µãTöMVQË€âR .ˆæ£ hUíõ+¤à&ÍtÖ¸Áƒ_"òìÐÙ`•·‹ØntðÑa²Î,qî<ò2ÿMs'w?¤¹ŸºqÈÖjë[cÀoÜJc:¢Âõ蟀‚1c›<ˆwªÜ¡:ïý´¾4¨¿ÖL¨àøó Fõ{7ó5Ýb*ŽÎ«f8ŽNï~H£Èp|N ZÐH=Nã_¦Ñ«4zÓÈó\¦âeÞgM37Ð{]㎊E‡øÛ•†!4þÙVÏBNß˰ên” õ%Vѳ5ÀÈ{Ÿ`ãìõF£ÁŒR¨åÛê/ʹV×Òܵ4——¬aóÿ‹˜º·ˆ©»‹˜zxeHq…†gwH‘÷ޝl¨*"¶Æyàè«EÝ[ÄÑÝE=Lï7ÍÔ½4zTî<àäYã¦é|ñ³4÷¤aØæq—ÍÙÓ½|Æ_|^¥Ñ²{¬Ñ˜î›ôóQuDœ»•Fÿ¬Ø‡s‡iôcúõæüªí=„Ç϶ZƒÔ®xHëqƒ÷oҪ܆ÄZPý^öOÓ({¢ŸŒÉ—`­ÃdXYPžK°–¼FX›ÕíɬܥJp¢ s5›Tm›±uŽ`ó¨§Ë=\EhzCRŠ×÷9ÓÈ‹rÔÖ¡¹'©&¹Æhêªx24!T;)-2õ"]yÞ ïçbúò7&[%áÌœæ‡snœ¥på b¯‰B+f{œæÞ§QNž74; ê(ÏÕi‘*éUÓ@ybݧòIiç«%!V÷¤Z4¬ ^“‰›È\ÈGÉ€E\^y$¯W³ÈpG5‹æª÷ÄN`¸¯8JÉ_!ÜGµÝÞnÿªÈ°¯sÄ%¡Ñˆæ‹Õ+$ÿûÉ8„]Å{Í÷²'häÐi9joÅåËèøzU$¿p/,¹D,ڹܽ-"–›~¦ÑqÓh|æà»6.{¼[aßíôëiî«4º¹`­q¯‹ºrÑ·]±R ·8—V¾[iôb:Ú¢+ `74CßÊÍçÁÓŽŸiùi útÉBµú&eÐ$–Š­µ©Ãr—Ö`RÁm7GEz¦ÍQ¨£©(¹usTÑt4)Õx`£DYü„Ø Ã‘É¬QJL<Žä_­'ªèÞÀË\>¹Õ ÝÊ©3h®HKnEÚ G´¥)ÜzO”›5æT´ì].UD³Ûc®#f«VlIsvâÕG4å5G\…óÈwÒ2×­³Ô+5v–ŒÛ¥*z£…¥YÓÎÇÊ£™†¨Ùö€I×ÚZ÷Ô6ûyÁkš>4 ‰ô•ÊBÓßg>IiXÛbŒq õÄÈæ}N(e_NÛtD ·®ë&¤¬-­;K=Ä ÷EßÍL3X–jâs­iéŠv§»KÒCV£\/ÖxGeÞK^w¤¡­+ŒAÓ|·š‘„QTaèÞïc×¨É Hl€ty•—Íé« +a_àtòŠjŒ-×CøNn·°Á…‰=£&vjôø™³CíF¬b¦_on‰V,ÊÀz…ß)üJ*oÒÜ£ÆEÏiã(ß±´Ê,¿²d ñZ¡gšùæí¦Æ5ò…Æõ¥e:u‘óÇx ÑZVÁ*,Ó€u§=°ïÓ×9?½ûDuŽ=‹ËÙÐ0]È p³¤)¯™jÛ•ä5çHN{0pz¿%†7]Ÿ¸äpgA=ü}É阒+˜l_SÖÊÞs*÷I+Y̹]äÛôk®ä‹ðÅÊ€,¾?ÜIÌ›1W.ŠY0‹L›©8T‚Ù²gGíÖêy‰’ÃÎrhsß_VÉöÉ}ÑR¤½µõ ½‡e9c&é-2]oÏÜ_6ÛZÈkÕC¼‹áôé"¶3ÙxÙP~-†_GÁ»³÷4u~X_kähƒF7¾ûw WêoBК'I–[lâø™¿&‹a¬úg¤ÿߢy=’ $ ìÚ.¯FÚË[ãƒÀÿ!5¤8endstream endobj 122 0 obj 3464 endobj 126 0 obj <> stream xœÝ\Y—µ~Ÿ—ü…y¼7á6Ú—äð@Àd9,‰™?Æc}°±±`ò7ÂN•Ô­*©¥ž;‹N´uÕR©TËWKϧb’§ÿ›ÿÿèÅÉû÷ýéÅ›qzqòÉL?žÎÿ{ôâôg0þ)å­U§gONò›òÔ«S/ÂéÙ‹“¯vjSðVÆ(ßœýu~YMR /‹)§Ì48ãe<-c:èIZõ£ýAOÎIkwÆU¥TÑí>ÜÌ•uz÷·½œ¼ ÂïÎöbòR8¼‡SUpÖìîïJÛI»“™,ãÂnÚ`KuP™ÄÐ;ž±q2Œ˜O÷^òÊì¾ ¾à´”mÏö2L>J?˜JK}¹¦áw lg& A¤Û“xP ŠrÅ# %gà^lÄ#)Öè=/ú e¨WyHÚóí…ËkSOÇe¤žl4Õ–ŒÀt-„„)iÓ d@‰F©ƒ3>ãë=BZÃd@I~ö‡á䌌j󴋉Æi~œ7y Œ|‚†Â)íf–:,€Ÿý";óÌÈM¢Ý:eèHv~KǸNÛ ù)iÓ0…^£'¸=¥Ô$\s`¾0Ògž°ã\«‘Yæb† @i&%‘ DEÁÂoëÝ–q‘© ,´³õéçéÖ»È÷æSžó)—³pYµ%ÍÉ"T£™]B+vÔt*ƒ—0oÈEºý(Ð,Uõ((B)[ýþV0ÊÁÂßqs{˜Ùv p‹™{$ÞŒõ``U,Û¢£c¢w°ÙØ(ðbÁJ¦¼O`0ÆÄl¦»$‰ô:=U·•‰  ãJé"¬"äB¢ d%]Åò4Á Ë¥¶ºÀjeÆ>âi%+•H»¯ß3&@Î-_‹OE»€&pM5ÊÄý€"Fð!L¿+ò{ ø{(Úàçœãzý9å'i,d„ÉXx¢ÛÒϤvÂÀ¯‹Úáà¯%_µð¼<Ð¥gñ‘VÔ×ô·w“–Å`*4[¢ÒyØTr)g2ÆØ’IPÖlêQ”UÇÉ+=’À÷Y5¼W4˜U*³¤V)òLÀ#°ÆàSW$Ò®ŽýÉþ‡é"yÔЉMþI[ À÷=Ûê¨btÜcåêò¾ÛWÍ.˜ìõ—¸ =g†Ž.·°0®ÄS[9ovÿ¦E˜(_Hs7|ùÌ8î´›u¨qÚó‘~j<€y»}Ü–\þ÷Y‘2MbÛãÞàù½*Ç\Êä\„w-?)—¢®À ´pÊ÷µ¦½$0ñ–Ë<lÀˆH¿ +buÛôÎL‰„Ãfõ˜Šúaòa»âJîva¯R3Â6áãlªÄ¼^tÃÃ契—evîJåV… ežQÉ Z"KQ ,îò”‘Ù=hf¿ÿõ”™W’”j‹sаðÌ. ºÞò.ô­JÕ(‹¦æ&s€õf¯uçžZý¡ÎQ(['èTt#¼P€ø²ØFzzE¦"Ml¹ülB~²9é„W²Œ€QAö è­õ¬-P„‹¸ÊÍ!ƒ>φžÌ İ\`õ1!ÞuØpÁ` <úIaÓ'û*Žn8cw`,T¥R‹1ºÄSx¿°û Þ 8ë*î›E˜a€0¯8 ¡e×BTÁk†*ïW‡PŒ0×D2+» yŸã\àu“ÒÁ¾®]‡·ÌôfeŒÂé•éK¸á1ÕÀ?4l\€ÉÇÇÅ…—}°‚R$AŠà÷­80+4£¤bßbã›ÌÏ 3±+Ÿã›€)EÂŽÚ=…+Eyè^[ä¿g¥n<|A†a­¡Ê-Øu°²­ âd•9X…hI@kU%·ˆD@V¤ÊZ ÕÜ=Ø×U`…Ðêx `>j&<%žbªEF™æOÉ —@+eÏÊ—ß¿cF>Ã~‡Æz1'ÜI\àÕ8rœRÐÉc:Õ•T&É•„ç`ÌÄÀôA )½^9BR·õ¾«0VkãzäC½ö“%ÔŸ„Ì<†€fù´v ó¢7uL œD´MrºÖ¬Žÿ9”œ½8‚2¸ Œäâ:Ï3ÈÕ°WîÛÚâî*6Kb«W„uw‹ñË\ óèbìs(ÞûçLeVuó_}Å@-®Á9Ó…“BnnËÓ+4Aª¾X“³¤ÌÒrýQî¾Þ•Ô£ƒ9& S¾„8ŠåÙ?ï10u 2pxUî/ÿLÞvÎ\%6Œ2WLyc¼P*“Û×ÂcVD®l4E¶TfH­6Üã—P¬qm3^Eu+Û=ˆSûéܯ÷˜M)ŠöŠH*võ«K étö†¾6Í+íÌFs-zý¸ƒ…cQ°›JŠ˜_KļÉ“£* Ÿ€]ׇýËe“n+K¬•Á3·¡³¹ùܬjÉ_2Ù\ä…±öEÖ_üÀ*UØÅ“u7AEIä°a@ó„䀦 8øˆ&a÷“"õ^.`úF³›qK€W/"pþvBÎE ±‡ MP[I[CfÆ15UJ!’n_Ö¶£.‰¦µîºQ·¸OQw' Èmo]h“ü.‡Iù‹9ÅïÝøNwSŒ;‚ïÇw—ùŤÔc‡ƒµo« ðB‡ZLš×)‰ž1ÃP²J¦ŽS IÉþE¯³ßG‘8ɘQ…,u nLêt ¨€¹%®çeÀ*v+Ô©"ò>”fš1ª{-KµiÎ帕!Ÿ!þì|Bê -»;`yn;«7Eˆ\èêæ—Þ+—+Ë48U‹®q25qP1Bتú5À^«F! ½U Ï’ÑÐujj¦¶c ´´à<äu-88–Mœ‘?^è1ÈŨi+`iFb‚WuSa¼Ì·jíHz3¨Àr¹˜å’s8û, ~ÕÉÆiQx½È``R¼Ê)šÁ\à™¥u…Ü KCU 8±£8s;ƒcìËi@*©Z“£º ’?è­}ªBçÕÔNû¸ë–¡W9þNù˦hjWÀUHEeJ9SbªÀf£2ÕÔóK\WåÔ —0yeu•ó¹'¦d35Wì¥f"¹Ô½å°ƒƒ­__u"çTy‘âšW&2Ïà•o=©/SI^Wù¤Ì…Zo˜dQ\Öd ðU•*,:°*ÕÔS³\xž¾ ³‚ϵ¢­CxÀÔ%¶º¥%s6 É †):§C2ƒˆ‰Ô)@^Î*ŸÓâÚ´¦[.ƒ"¤;=T¯0~ü’€Öå“ÕEmçÂQ –8ÔÎŽ«KÈC˜ÀŽMíö}<ë8¡e˜ÑŒÞ4k<¶Ù©dªlc8æ@kÜ•¶ÊŽá ÛU¤ºIÛ–î‘Ö‰\Ÿ5>:úMhÇ’^"K Ú»˜º@®µLUY¡©ÕPq‰«Pã•…˜qk5DÜ ~¹ØÏ«²¥h/^VÏ€qsX/m=sMø&Ée­*ì°22ôÓí\ÄÍ&îê š7sÖ„Éð¯’Ï×6Ø ƒœXº·*'ebrîk2ï„\Ò…ìçRlŠ58K²gq é4É­4Ÿ£Küª8z»« Tí$ßV7¹¨î£—€¬JEÙCåà ]T•Úk SGÉsþËÜZdÔÕ¸l!xàÙ(³U÷Õ‘=Å[EÈ…­4`¸4Çêub I ò:°´IÙGrÝ^ ~„%5L‘Ds¥îvsðÆÀã£Ëò%f|îœ:.%’oô¦éQíeª½[ªœÐYcêu¿AlbÜAæ­Û¶¢Ù̸¥~·XyˆÆE-G^%ÜÓÂÔìzœ¤eJ¸“©4ˆ%'z™3“[ûçKöõ bxEDÞM[ñÕæ›…°ì·ØY©}õÙBݯh§¸Óìn-fC¸þ/–æ-¾îRËÍØý¤®Ì¦uf‘A\zeƒc]…f¤æ¥Û$gÐ ÉØ$gRc'TÊT͈ʅ»N_ۤح˜¹š•䚘j\ NËɦ$×/§&”?ô/‹8{Þk𫃜lÔU—‹;ìƒÃ¯‘üÚ}²ŠÂºW¯MªyŸzª?Þ/Ÿ^_/±}Ü Ë/¶°6[Àn¼ÏŒK§ÌŠ[ÀÍZP=–1Ò{˜ Jw`ÇÅìÌ«#ª!´è¶P¦²AÏ›¤xÍ—>(“AdÇëjìŽG. Ò®XÑñƒ™yÞÍgôI8Ögü©p ežOIÝå©ežîÜËðX0:eßàS”Ò&p̨Hco;c;4fnâϹøï11Ù¤±Þ(áØEyj¹fÄœŸ6e)XŠ—o(I»?l¬±œbØúÿE¦èè0ƒØ¤À'|T¤æýÎØïÊØïÊX­—\’fõå¦=8RŒ>¾…}õ.¤è›w/:ÚGŠN˹ëˆNá·gŒ>ë™·eìiM{QÆzo5:+EçÞ—[ÿ¹¼÷ªŒ½,O¯Ùî«âáñÓòóYÃfû°<Ý/¿~^Æ>Ø27 s¬{RÊ3ìʘým‡%o:Ìnl;ÖBBûµÇX!‰$B?Þ ‹úŒ‘GûmdŒ3Æü<ºcÖ c&¬©˜P·N¾ä¿ ùp‚9ªÏ;°9Â(ç!T®÷¬gñîbûÔTõ®ã°ÇåØ-Ƕ£/»še9¢wZN&ü#ú›J áSËÇ÷1 VH޾ߛ…òÞ+˜¿vù¡Óö±ÿzô~oSd>¾…È|õŽ$f+l¿ 1ÙŽÙïmŠÉ8R¿ZLêH}mdþ—‘ú½³“¿Ãÿ\7Y;endstream endobj 127 0 obj 4719 endobj 131 0 obj <> stream xœÅ<Û²·qr÷R•·)¿d7áq¿8åÓ¢ËtäX—»R¢hžsHš7‰¢(Ë_ïntc0»{dÙ)U‰³3@£Ñè{7Îד˜å$ð¿òïÓ×»ûŸûéÙ7;1=Û}½“éãTþyúzzpà§T³TÂOW·;1Çà´‘Œ3^Æ©¾ójò"LW¯w_îåá(çà­Œûùp„!Úk³×ì­µzÿ«ƒÆoÊìÿ÷p4sTÆÉýÿް¤T6îy8êÙ9 W1{©¼°ûG8Vyp~„7FÓY_À£ñsaÿéAÎÞ )÷Ÿã$+µTe’5vÿ{DÎ a¬¢P?†Y*ºýCDY…`ñåQé8ûà÷ò[gÍþÿUYíÿxõ W˜¤œ£µ É• -'eí¬L£Î'u׿˻¶N/¸ÕOø«ƒ ³:l m ¾Xž2"xp åôì su ë«|Æ…å à1O3lÚQÇ8æ§£vsÐ1äù75‹DØÿ%=yáö_ÕwoëÓ»úõ=·Šs„ÇOêç«úùa}÷y÷„_¾¼ØPã²³ë“ÛQZS,cïë §(¥Ý?©ï¾©ïž×wËKÔàMGéá°„ÌP¿©¸!»çïðéMýúáï Í€"AÌÂu9E_м¯»zŠÜÿØ\šYWøÇÉÙ:9-®X¥u Óigíà‚ò‹zè_/£•FÆ!©P_À>£“Vèý+aƒ‚‰ïÛã;”©qpªò‡$&0qÿ¢ }[_P7mzu‹ž- ð(/{„Ó³5Èܶ·«%Åà]@–¸np mu:,q8€² ¤šAƒ¦î<’íPŽ"ê,8ßQT:d~£áÍp[ϲ*Šì{^4,%fç½øe€ÕÈ^ËÛÆJ„Sãì’údwõ_Rsñ U¼S™6=‚Æ ÌÀ„zÙÚœUW¾¨SÞÖw ÌMSpð°´@Y¶õdzI&-‹‡J þýMƒ„Â¥M4~G9ÓVØ‘"—ˆd}BU`)áÔ’öp!ò—j%ÅpúMªrÈ(E:H8XàuíbÀóo#þÚF$È>Fï‘D:À…VhÀØ´×øCÅ ÁÜŒÞàké­œpóF9@‰ÍLçäÁ-ƒµ ’"Ê6À~|X9?í9Hhd»A‚Å[(ÝììÛr:ùÁð"¾jh€½|YÆ)kÈÀW(MŠhaŸ “ŒŽ¼—¤.Ëê ]@¥£Š$#Ÿç H«#¥&î×Ã~áü3Õ²)îÎÑz=á…ò:„ö†@~B¥ÁàI zxÙºâ&€)4å["‹È„R©‚îA+P'Â'  @Ÿ–ý—õZ×èbáÔóOÒo;cÜ£™xêi‘¼´Ìj÷#|$$É4 ›«UV±6`†—óûNâ›vØ`Åà C²Ø6: T\! @ä¤ójÄÙCº‰ÍxÂTL•¨&Œ<kÂhº±Q?kðµÔÝuiä…ˆ‚w>î [¸G+¢{` ã-9Â瑆6Y ¶+„ÜÖ›"¶,ÐÊDÏØ¿©¦üd„ìµ¢j½ÉÝ›Œ*("=o3o–F-Áp^„µÍ!x0 ^Ðj(žº•*˜râÁ¥‘ú˜Bèt¸G‰‡ÏÜ]²ÿÛHtÐ"îÿy ž^ìZ„P ©é¬µ<¢*h2"¨>x¨íè¼Ðà+¯âÀ éqò¯U&ŒTsÅÁz¸`¢F71Í|ˆ¤Zè¦(ò‹ñ¬,°b¦Þvhw>(„ 5àn-ÊÁQ:ˆÉ°3¼ts0foúC»œb%Œáß^À$Ã$ÇB ܦøD©@³ÍÊ*¢ún™n3 óðt@– Ì7a¬Ú420´€‹9ëLb °íL¦ÏuFö%ae}Æ—´b¶JèeqbÛ²ÿ/À5eª¢ÏîcØvÍ0mà,Ó+U=4E’ÀÒNwÊLi8äR­ÂTÙ!Æ †¶Ûélfç’⫸Üä`Ý…µÞ(d``¥€m™ê»wffT³àZf³¥RâŒB)+kpšK¡ªJs´ÜpÑlr Å’i9á›yL^™âÓ¥ágtõ¾Áûq3 D#î÷<Ïny– \à–žù ¦¼’=µßFptA­’RÇh¿§Ó+Z¨’ÄêTcŠæWé•ð³€¥.X d'a¨Ì´·§èg:·sµaÈRÜÝe5¡Àq0‚¤¦­R„`ÑèýËQ°B¿Â¡VŸ2ÝÀc€Ë?0@ù÷옄(ñb€ ÍVLƺðOªÐí©ÜA¡Q¶æä´‘›Ý`õ¦Õ zÊæåü€^Y1½ÊCduˆ¢pšë®[°Oe®¢NÕƒø¸–‡'ö®q=ô3}v¹¸ 2Iõ·„¢nvál›ŠD bÃH"CZm&UN°qKš  @@]§ôW©*Å‹GÛ'#SæÈSaf©O 6¸èVv­ xFK’›Ø&¢12$5ÖTLÉTŽ,’ÚzÅ-úl`ǸM1Åð(¢÷rºÈu‘¿üðj÷ÙîëIz—|¾g˜jÞ pÅ‚SÀ¶„v÷ývzÿîÛ›Ýý?Lrwÿ×ø¿ŸþþyôñôÑîá£é³“- ƒ¼AÏÛ˜´HRó¿EE§ûp{xì-ô8y"Ùm!€Ö[Ãa*ÒqÐ98™>«ŒGMãU²=;åa€3;›MƒÇö©<Ý"Ò‹è‡) »Œû¨Ç© ŠŽ† 9 û,ÃRqŠed8QwDX†)Ñ…·cw­64USš\ ÷ =„Ðð/õ~°O“ßê帣7Ì9h%¾¦¹¶ ŘNCsèÂl½!0f2÷DÀ²d™¿8êÔ;Y46k#Ü-QN%¶e™sî×OÔSŸnµ1Äõêœ&]Ú”½°cN£ÀÚI6g…º[’½Uáìò•ƒ †»€¦äÉ‘o’ŸÝЏ•ˆÉš¢#Ü2YZõ||ã‰aºK­‹Êbk“ÞY¥€œé/ZѪóÊx8ݤÜLÛîÂt§ RíÿX3‹1áP‹aj®Ób&ŽtÉJ¡!ލ׭¤Ô®Ù¼Åµ(Ù¼Žo*o3ç|-¿×­l#<ÆÔ„‰Rû“eØö"kñqX‘|—ÛÙhU¤PÁù(üZÛÔ°â‡åª”L9dˆÀ–\UŠ¢¤ñTÜÎ6ª×V”]Â;„x¹™0柂R;¯¨¨4sE6T U ùŽÑ”u°ÓÀìY•'V'ª# Ú„ 5Ip\jf4Ö&Ÿ›)l òg#ɺ´¦ #xýÁ²ðxTS0É…4ÒÔY¥¼b4ÉE| rj˜Ž`³°½98l¶$ñ­ˆûï`–ÒR| 4c{P`þÊV B§´å¢ÌNöÑÒ6’ÓùD‰|«Ã?ð‚î^µ€˜L« ?|ºƒ)ÐNcŽÎƒ`Ñ@€d[ßRóË×Ôf1€F±s¶§k>òÞÅÁ@–L'·C¦¯6Z¢(ž BSԣXBûu“Iò¯3¢ ‘L=ª$£)¤¨ç2¬1޳#/Ké՞Ȣ¦ˆ†DµóÓ §(GmvY^W^2.½]ÕWJ$+̃'N˜Û„»ýçT[BAà§(‰#²‘—Ì\±jn8ÛÅÖu/¦–$8äŸåì®0rˆIý¡IAv«aŽûPH±S…¹rd·9 å Ú¢þÈΣï£:´TJ–r˜>wB¹*0Ëx^í%™VAKdâ‘ü (eú—ØV‘XŸÈ^‘íxªƒHac„²wÎ÷­XÐß9ý'HNïLöOfbð\. )̃æÌ„»ÄØÚÆçÝK,Ñb ‘ÒazU´Ïc}R²ÂÆäŽ{‰CNô&*›¶I߆A¯ß_æƒÇ~‰³NdP—JÚ¢ê¼z¦Hºz9Ó­^žjàjh; ij4±&~ÆØóÚâTTkeìE"ßWz—îåܬÁŽfv”J%‰ö‹úŽ.hNð®e:Û¹•Ù,2¬µL•·•öë<ß6Ÿ]Åö›Y‘Çl3¸Xh*ɵ·&¦¼Ö£[Fudî.Þ¯ùL [jvý2ñ†èÅ›Ì;› žz}:€–Ö[]šÍô—+gÖGÜ÷(PJÑ(„±ä1èˆÈåëz³yUƒI[Œ[åÀµê*•Á”¸ö!ncÜíê™wzÄ¡ {’m|Zï7 ²”+ãžm x4u¦†X‡Å>/bÜlõÝæÎ´ŠKO_b:¹.0ÑÂU|r§ƒ¸Ë‰½3–-ü憞‘°›—A/X¨u4ÑÌÈÒwsS®Ôúnäõ\„Rð.½›}-Œ$ÓˆïS5û¼§ý}ÖñÂŒ{]úÚj)Ô^ì.l]$ x¦é•f}‘Ól˜­%響ãRÞ8¤`žêØqªæÝÓ(!0ôôaNíBÒ\»(»Â:çð,B£zÁú¤j6Ñ JVBËÚ*h§ïv¥Áoúï2xKuŠèÐÆ8½Þ)çð…û1«éÕî‹îÍëÖýˆÜKØØúðÆÀÌK 7|¯Ó¯§0Ú:LxÔφO66Ž.¿ñov¸©MÖ ¶^F/K—ÏO öíj×Êa¹Ìà l¬´Sû ÿz_×Sè‡!ˆF¸ò aT—ðÆb:pj¿›úuBôˆ*ƒ‘_<°oO74ð® ûËxüÓÁ3åAüÃÖÐ0hiM…a þ £¼"hÕÛ†ö:WaXü³5’Á(¯ÖسBƒà`99Ê+‚‡>–¡áá°ó´‚p E¼e Ê+‚† hÛÈ£'y¼^ŒòŠ lFCÃy¬­0‚ÈüÕ@ä7¯ATBôr·ŒXä.ÃX~K.mAQ‰È¿ˆ´-Ÿ ŸlÆËo¹´ù@aç_DÚ–ÏO öíÙ¿•6È)hls–pʶtð€Æøü›Ñ"|tù\ CÉÀ#Iáf&£Ï<ã%‹Ä t1 E¯Z·È‹r¥ÔÆx€ð†0¬cRYÿ |Læ”?kAÖøs·Æ]²ÌØ1d,ž&»]DIf ¨„ZCºä&?iü]Úä–Dˆ.È_µz½¾)A¨8`RA -—Þi–I`¤©Íöy §hÇò7AZ#÷¾'Ú_Ç !ÀÉ@zE¼ï'ïþúÉ\6_ö¹Æ‚6åI~lÂðã2¥Y Â$ààð£Ÿ:>8R“®^”zŠÚb¿$"Q”6¼ý¨DEüq†ÚÄ?ùcŸíþä¯. endstream endobj 132 0 obj 5194 endobj 136 0 obj <> stream xœÍ\I³ÇqVøˆ‹O¾Oè4ccšµ/rÈ¢$‡å ) ~>@:P€RH’HÿzgÖšµõÌ<”ôëéªÎ¬ÊåË¥ú›Ûøá¿ôÿ³×>yb/ß=b‡—¾yÄÇôׇ߳Oïàø“óÍk-w/Å‘ü`ÅÁ2w¸{ýèéQœÎ|sVsO.w÷Ÿi°Ø¸`³Í;#4e¹?”{ÒÉM¸:ëÏOg¹õ>þÎÊ¹ðæø³ÓYm^h#ÿ}â›UŽÙã݉m–37‰ g´:>9…Ô›túÈ#Yʸãv:Ã+¥—NDÝŒ=¥ý¦1Ÿ$ ²B] ø5¥¥¼öîÄÝf=·‹GëTÿ“¯êZUJÎÒY$á,Íæ¤:ž8„i¦ÔñÏȳòު㳓Ø$\úã—À2CöÄñy¤Èj{ü YfÎ:ÎÝñ‹º/ %oáJËæÇ×8H2ƽ:¾ƒÛÞm¦%O¼= Ø ûó|-ÌÜý V ŽëϽބÐKbþ”{Æ\œbsŒ;žæå^ÉÏ÷8·RÃõûø /þý ù¶²y6¬Œ°+„î´r ½ƒß•PŒ`ÞŸg—_¥M¢ ð¨Ž_n”·¾yâ Rk Saë=äÞ}ÚÑ®@^ZÞ®8!7Òh€œzõŠNAø}wBQ’‚oÄ8HLô¯ðübƒ†„‘o%!¼cvcÓûŒ;æÆ%È$2ÎqåšA„C”/6ÆÃ]ÁJU^!¤¹°Q}´ºÚÔXxŽ{0Zn.høñŸNw\;U°>ÿôø(u" ƒ NÌ)ÃdØ Ïòµv¢«fm}7ˆ~üùž¼D_³ . ÍT(ÍÆš,ŒÛPwþ jàœ•°mUJ‰n42ö]‚eo-pÙ¨D5 UÈÏõf¤…¥ŠMZ"m·­ ÍH<ƒ£Jû©²0I`AÀ8­ñµgn6æ¯K{³ÜHjb®©õfZ©ï#yàÇÏq¯8—†?­Þã'¸A0HN•t²+Ñ¢1L½ƒQIi`R§äÃ5§’ü¥; í‚©¯7ç¯ Tk®«½òö;kp;qÀ@‰ÄE;sð~Ñ‚ÝUxS]~¿Cy„Ùq4rSÀÆWˆ<)Éè÷ˆ röö³kïyžQE#ÜJƒË‡3’Ï §nj hÉïÏs¡¦óÞ)z¿ÖU&,ŽÂ6 îƒ^þ kes·AÐ]üŸAT‡âÔ å~•¢¶ÊX,üØB!ëíˆÀ@ ޏçj‘µ'òDÖ3"L ÊÔ€k Ç‹fÖQCba §bdšüì|£)Çy'½.#f†×W½È±¿Ç÷™MÚÅv3¨pŨú$ìˆùÀì“÷›Éͪj37ªøPOX¢fЄ‰Ë Èê‚Öªì «¿y‹¨ÇnJ©5à­ÎcYßȺ©Ö‰P7”Àï*ó_Án‘†~*íÍ“ö"!7Û76¦B:p«ÁX‚ÚxÈÌ×a¦&?FŠ /‚½¼}2ì ðÖ;¡æ§~ya+ýñO³82ùYkiÁo•9 óÚ`ñ»rnHS7•ZÚla´¬ÔƬÞIDà©Ì­vgp˜~=dhZ…t•)C‹¢Ì†â»W @)«JQPÑW)À¹Ö4&ŽRã;ÄBÔËd9ÐÁì ¦è§R»€Ê€´•HæŠCsToB²Er ì[x‚ºÓY1¨\ ;È æÀ±/rž¡CÆ ƒbEl§©C¨¿f^&Relë/@€Á»¬ËËQlK÷€às? t3Æ/ ¨ž–„>VQµQ¶QúÊÀ-ñœ8kuŠ|/¸0âäé§óŒK†ìBwÉ[‘ Êí^¡¤,B„ÿ=ÒŠ5ÆEÄT_»P¦©ËZ÷E'ãûÖP0‘ðEþ»N1GW]¡ÉaÞ/E¶NЕÈÒBÎMÕ/b…ë'3zö„ò28#°N¹ö º.Ѩ;Û¦0» $'ªJ°>Ð<$%µÕ11éaÞ.\©¢ùåÜÓLz‹ê˜Áì±ÐAº äXRð¤¤pw‚@|]h&Áˆ¬ªBµÀý ÷]£’TàŒÛvúØ‚|ߺáñ͈¤l`|þ1E½>С¹(Åx%äÄ¢5Ö€¸¹š¾ã>ZxÕöÌz>f>©Å±A`þøGÃÁgˆUÙ$lÀ¤.¢Í Ú+L$°ÆGnSre^…dŠz ­¡¢š”Iç :¿¦rJ4™Ò ‰fѤV­ ”rïâ9³Ö >ZÙ,—k¸ßIì{ö„lú·ð,sNêQb¸[ô",²ÈbÝ u¾‚(šx žE;šx$ú›ø;×öv¯@êˆ[F‘å‹„þo‡•BC£¸‡xà T)CJ¼>¾›èì)mrTÝÛfIøýOiqü,§ÑçØª‚|Iª_-ˆ[±†Qhô~vÈwWGs¾B5É%ÚŠ2yA#7 &$ÈNôxб>S ²2¤RÈWYœ¶eïrÀÌ‹$´ë ÆÎé&ÍwT0»Y±½Õ 20ä² bS§!O?%)ü>Z‹|ôÑÚØ„C8]ÄsMÁ6—ÝjÏ•óWsÛQå! ‰0jU˜'@èf7†¿èÐãÚº¯ ôû\é‰.>+<°l§­åkšè‡Qà$¤%ïZŒ§o›ÐoÏú#Æ¿^°4³¨tT²šªy°ûMú8æÒºÓÎJto/û²óE8EòzCKnïw1ËÈÀ(¼ -‡Áß AÒ‘¯ceä‹°ÄÅ6½=è¤ L¤Cåá/zrÖÕk»‚ x‹Gëzi°Ùf{…SË΄쪂¿=!m%¢£ ð‹wn‘š©b6I~¢‹ŸôqtYöYBò&'vÁö„õçꃬ™½hjÒØxß«sï¦êÕpÖ¤+:sí6,T Lq1ù€¢3‰b0XW¹ezä U%ú Õ…ÙŠy¸ªóÉIù€ 8 p^©ƒuºX‘Ý­ìöæf^’´$õlX”d—~‹¦$TÇ€(ý&?Ú-Þ{ yé&§ý®á®ã2bߺ+tEI}],Hiô¢œusˆˆ¼8an\3GT³Œhò‹–«÷Ñ&q£›ì#i­ºÍmAÆ,>ô«ÀnxA„óMÕ–£ÛyØ0ËhUf6Àq»9(&^M»Â†_©s£ŠÉãÞÐÜT“7X˜¸V®••ؘ2Êu!xëâT¹à¥\—'wåšW¹^ÅfP@­âçjõ1Už&‹z1šËú“;AL)(HáA™e©Úž*Á˜±{2Ê­=`Ò=7T%•\]! |¿ûŠ;VAÄãèœ0›ºT›S!·Xf,3„Ú g”ýK–y‹zË<4K fµ5碅¼”$L:¦ lóqM¼›k”\êç’i@ŒÔ:>]ºÐí5£‰Êǧtþiq¬­?,0ø}ªi/€vþccÀ1UŽIýMÒ½‘oã>‡/q‹wQé!ôÞ«é ó°ÒªßÔ˜t: { »-Èá„ñWbÔõÂÕ4·KòY»ä~{Zî,]d‰Ú22ìD—H‡p»ƒÞÉœäs…V÷ý.v¿NçjÏ–t§üBÊ,ê½jBÙÎT‹SC™çÅ–îÄ®雤2>Ôx°Ô ±wèdäL61ï‚Å:ëyö>äih¯ÃâØÒ"™¥‰ArxÅ÷0èV5¶¹ˆ‡}oÑvÎÙy–i†¼è–¬újViÃk>#yMɈ÷ÛNþ*ªVÈ’$AQµ¥®åÂÙ÷ב Ñ'ÁÑîbE_éU’yq\qÌ<÷ªH/¼²C3q×~ÿ‹.à¹s<°iÈmÁ6h:rôT›.ýì¦V)é…shíuêàzhç×÷PØÇhV¹ƒP WørUpŠ¡?¤ðSظ0_¤ˆÚˆ×TSöÊ-fp)÷¥,©lÍR Цˆf/=œV»ÎIðÒ¼LºøxÁÜ”óbvÞP'#ï­j3I Ì#NgCîyǬ…»3%ðGlh©#Z0èWê7û6šVkÜÜ-²›|ºþ´6š4ùâ…×ó%Ÿ—î‡~èò±,x~ܯö0¶ï“¢ÖN+ Äo>e0ï)èã¦A°\%AG5Ÿ¦V¦GóêÍP~¾^RÐÂ^q>®úÊS.µ}–‰ÊÅWkÓ9<<Ñ*÷Nr ´Ðvž«©­5äõÍïÑó»®á;zÔŽïpB,:Ò/ë|tÉKÝCª©U}rTñ¬8§‘Õ´PYã*¢6¹‡ub Æh BûÔÎ9Ü&×›¼ñ˜EþÆ•Õspˆ;àM×Љ;à<ܤû¾@×U¬é§¹ æ‡LYĘüÄ®5B­Õ¢3F:ävÑËü¡\½ß5K §Ä,í~ȴﺉ°¯ 9~a Ý£a¤'ÇAÒ Œ©ç_äYSóuì`b@„ÙÓâÔ¸7µ—uTnn/â!fÉ"q!zÕ{ô<~ð¢s¡£+Œzú*V0˜XéæÔ&|@S]*©à÷ í<;¹8¢C}•Ž«0ùª ¥(r{Bz¢–áƒJýöRïOûq›aãh*'=íuçÚiÇF>¶¸jôÅ#¢Atµåxñ-¥bõù›™Þž%?çobä³iæÃ§ —à“ÔO ðé­N<€Ÿ¯ÀÖ執r³¿²r¤›HX‘õx¢ÎÌÊ€gåÞ›rUíÞ‹r\…†| >1R©ÿKñE¹÷ªU©ÿýäªó¸\E¨ãIIbâ¢WîÙáŸìüK¹â…žE²i•Řzê¹ï\Џ¾cœªM^‹$tÉsí|Ž€´¶5G b8šWÛ#K® 0ŸÞÅ6(ð–ÆÙ©I­µØ”j\ô¥O?34ik¾YØvÚv®ßDhí…¹ŒÝgñj{S}DŠ ÌŸQ†€ûúXç2SÒDvâg¡ø!Åú“þ³ïy4ògbÊúò‡,骋SN1nò´Î3 –Èï5Xº»ÐRSŽlµºò£/˜Äœ8Ì+üáãzVÐ0èåÄÔ¼ïîáU…©ïº°>y¥¡W à S§±ÎüôíMŸêk›X~y÷è7ðïÿ9Üvendstream endobj 137 0 obj 5218 endobj 141 0 obj <> stream xœÅ\K“$Er–tì‹NÒI‡2ªdS©x?0ã²/³Õ"í-™É`0³ˆîv!ôCö÷êóxdxDFVWOÈæ0Õ™ñp÷ð·{äw±Èƒ åÿç÷7ÿü‘?|ñúF¾¸ùîF¦—‡òßóûÃ/n1JµH%üáöåXbpÚȼŒ3^ÆÃúÌ«ƒáp{óÉQžÎr ÞÊx\Ng Ñ^›£îžZ«¿9iz§ÌñßOg³Deœ<þÛéŒ-¥²ñøËÓY/Îiü¼=‰ÅKå…=þ–Æ*o°Îï±€ðÆh>ëcü4~ !ÿp’‹·BÊãG4ÉJ-U™d=þç…0VñU…YX*ºã¯ d‚¥‡g¥ãâƒ?þ"?uÖÿó„U•Õþ·ÿz…ƒ”K´V¹2¡åAY»(Ó¨óÁŠõï3ÖÖéú“PýC[þö$Ãâ£;CÛR×_:¸‰rzñÀܾÀþ*Ÿƒq¡ ~æi“M;ãgí– cÈsIs1F£Žß¬›ß™Ò®þ‘¾Z½Êøxëj[Ö~þ¤•zQ@óõI-ÚDê|¬Éæ±nù}{ØvÖ\ ö—l¥7ë¯öŒ´n>£¡Ôf¦Ò°ÛI/V»H ƒ8"ø e^Ì('Ò„žöørÝ6Ï;a2ö~ÑBÿsBŒAóõ_ѪÒ[¬ËÖ»èËFÈã—yˆ¶ [Ÿûö8KcŽ÷ôX !£a€ð§3/zß­ñì„Rß“<‚VàG>ïœÄ ¸ïh)£–|RG@)‡`Ó¦ôSUò@2'B`Õ@%H±„ *€îÿðDÚ&@}4QWL<æ·“â8±Uï#H?¥Ù•ŠÎ°Þ9­'b$­dåšJz|6P `¨3Î^aí<âP(Ðá5nÒBêãóÌš1Ö³¶Rj~J/ðÓªEvŸŸªÆeïóÉAÕÕ-´ü}àÊÈE¸8Ÿõ må»cÿ¬¢|ð>wœ'1ۈ״fX¬õSNœÏ4BN°W©6J¿M:ÃD ÏA3NÓ ,{Íæ7•Ã69hÓ$ ­gØÜC‡ô OÈ +çÒš}oµ›Ä,¿¾½ùðÆ~¸)Vúð»e:i\Ôái¹} S¼˜xH[¿¡y„;á€ý<@!bYux› ¡Éñ€ôš>(ç<öÆß‘+‡uh¼–n6w‹ry›¬Z„% a fäЂ ¬÷iFP´4&*ZÒë6„4c#ÐE/Òàoc§óxŸWôD¬¤¢ ¬Âß Ž÷Ò’0Ð o5”üÁ‰ˆ‘˜€SÚöß&؈ ê¢òl´d,“P`:š@: 2‰•LAᨱ)ø®¶ 0fï 2‹ý¥ç Åb\4,è‰?h¸HB9%¬…ˆtN4#¦…,ì΢ev!Ј´±ŠX‰NV`åŒuÄniMhBÚØÅ`~ŒiÇõœ-t#þ(Ø0f"Ù°)F›VÀtH;à¤Òß8[-À«6$^}~óqæ][y—¿½Ã[þ7ÞÚþm•€¯1Îñqù/NŒ` ‘P¦·eEŸ÷×DÉèÚKÅ'*iù HHwhÓ4[SבuÃòÒñ‰Ž­ùòA‡{æA’Y,§Š¹têcÀe2ÆlDÞíKš¿$ÅQÃþåà ;•GÂt‚ê”o縃ÿàî‡4Ç¥} Và²âºB&¤óªnÂ&êp&: Q¶ùŠ‚a¢y@BLc¬O _m$–ÅB‡•¦¼OS âÔ­× ¢jÓïWÇ|†TäõÀúì¶~9À®5‡Ú2¡ YËÃÿ!QœgpC‘“ŸQà~½:ÈɉĪêÐÚzBãvÎ'kòxÙ#7RÚ‚•ÀÌ|ÆHéÑçf^1pK‡Û–B£ž½J\ðv𫟠~Ä’XûÃ4!*A.yTÅÍ3PûÉÝä\$7¯†=ë@‘C/ØÞ7"'G"œhNÌÖ±O[<_ã®5Z1c<  êݹ?L=¥Mtä|Üý’¹mÜ¥ìBçTXLPÌá¢ÈVThÏü1¾ÜƒWížü~Šù³»ˆàÜŸK2l¨MxOiØçpµ:8îG«3W` Æ uQŠVí÷~ÒË𘌞)f@NC§:aäf@Y>ËC,ÇœÝoJh$äcÎcêËï2B;=ŠR$d[G«!ÐEäðQò‡½O#B‡½€£…))ܵÒ‚„š‘}¬Xä(«cV p¬àúõ!a U©x"$ÅÔÑ›U.Sĸ‰VHØ2ù¬ X.­E–ÛÀû%/90«d"/<]¥jœk¡%2BƒÄùÃ7ÖÇ¿Ákà‹±ä¿ÚÄ{[Ó€êÔɉ„°­ût3Yr¡üFIæô ÁAëȸ7÷¹›¬fîŒkšÆ÷qb›½—:èÂBMyU.HÊfVÚÛQóЫ–ŸjüAMÁ\é¶ÍWôteÛße>ZÛƒðBsÎ.PEÆ÷¤ÊIˆK{8¢W0ù… ‹X*ICKÒïvB|µNA´ ’lo&‰YQ¬t)ÊINä/-wÍ2Íl‹"ÄÚ>v ?MËp ŸÀAŸÅ­q\½€2‹‹qÊ9É_“9sÀõɪg¡?hùå‚‹Æü?ÖÌÝR˜S®úó[R¨O´túx}ºfWŽjgÈÇ%ÕaIwlȸ²Z”‰ Ḛ̂ï)¢–¤z–i®Þñr /4GnšodœÀ­K)m´‚¡ Ú_D” Ø ŒSÍ2³d…34K¥æÌ{§×è_s7眱î•,€aLúY“ ÎïÌUÝ${¥RôÞ‚³9þ+èg¿˜Šd§øžË5ÚŠ7ààè òôÆ…&f3S/;d£ãWÆ2Þ—èƒxèkåÓLLY\…G Þn`´™—6¶“D£Ó«=@ýµ±;ˆe‰ÎDfDq(väu¢†£Ï½#žÅM‰ Â$ÎÐ¥PSþ‰Ýr ’4û"Wt´Ù2oÜT ·"4 qf[÷f§I‹XuMXÅX¨À’üE¸àó­‰qÉ%‚9b«*ÑŸ‡YŽJ³Ì{ÛIØßñ¸lÍ–¿‹Î¢êI·J{¹VÐ \çú¬yò×…`•xÝÛVÃ…±WÖd?¹ÍéÓW8%•‚ònnÿ铵4ìײ<›sé±*õ¯(P@§åF#Éh—h¶)áÁ’C>38ZäÎ\vè3ßç4ÚÙ’N)ß {…Vû!$©•±.$É€tzòá¢éÿ¶5éáÌÓ_LÜŒN„;(vʹM¤ò,ô¸2¦ 9N»qER~’ÀY3„—µÆÖ‡TÛA “(Ã]ðN;sŸc»tò¢7&-+Öæì×Ï6„ÌS<Édtr¢$´…b»0&hX}ÙÊÚ²PŠ©Ë¹óË|Œ7Y·ñ1¼þF[Ži1†«›6¡Ì’¡*•2°vn7·F¥‘f¼öSd«nSØ;-¦¯â;f`Çmk¼W=ã×®½à+t༬ÎÇ4z¥c386}EÌ›vFÔ*­škñ»,g‚2cEʦĨÖsL ­veã’$l==꤯Ú9gkçÓš¥î3tÁ.†ìŠèrsð³KnΚ«Û­ðe û\® ý#È*éõ4]JI&àL]7o·{!Ç^Ð5—±R1uÞVдÖhñühAËÂd;s0’ÂV‰gýfH 6)½­:g¡eå ³ü¤åJy»%ÍŸgkZØTlŒU{Js/QA:Åci7´n“ý‚Œùƒn–ÖÒ¸öÛÙžÁÙÑÞ$–bÍLlð4€j9r0Ú…y^®²R†!ò|ÙG´˜MúÏl¾µ‹fUSxÔNvØ=Oït§,”‘›ÚÝ&Lör,š= èúUµ5Ôpm~ü»Óíí*Z–R;I§ûw ¹R¦û ûK%WE=+µÅó¿÷z?–^‚Öo ëÉk|630[ÈÞfÙí"#ì¡ TuÆnð¾Í óì@/«zŸ|Ö²òBÎ’gB¨ŸÉ ùí6ã´I‘'W•XG!wì‹)y4KJï¨f 55]4ÇQ¸óëQFà¦Bä¼)©óŒÊ“p¦TtÕÒÌÜ­×qNÇÆ£ “ûz6~Ö%2‡bŒÔÎ5¢È|¯9ŠJØ4ï­P”—P4©5ImQ¤¼U.¸®)¨»”;(éõM âRMiçyä°Ç˜³z~šEij—m0[sGwyÚiÖ¼†íqÓ³5x»RAG*!oãîÞž"Õ‹Tj¤ Ð/:&€›B|iúïs‘Çkì™V¹Ù)]L­žëÙÈSËp)‚”t]”¬s­q[·ë‚WÞ}¯¶Hxv_kÅÔ2Á’r\î«$“2‚J“!˜eîˆO›»òm6.2<öªBS%g·‰Öµ´9±q#~Ê€³½™DvPb›¡õ®Nɬ턑½À–|×öÇXH§Á:,ÆïÙܹ­žˆ^º²p}CÝé{‚È3CäR òöÆ÷¤/U›Þd†‘ÛëÕš±ÞÑÇ€]x]»2ÄÚ•¡¤mò\5Œo-v'™›ÆÏFÉMŸÍ´çrÖ=Òähõî¢fž?­…Õ”œàUô™#÷uÎe =Ï‚®áwSr4Z\jÎnÙ‚Í êx©çøàE‘t~ïü¢Ènç¡ÝEÒÊŠÂkÃ/¨ï6'Vؘ‡î"Îr{,È”Dw{¶drw¢žÜÞÕps~ó²–YݤHö@³Tv%·nwKœ>LÝÑÕ7šµÚÓ5;µèäÌu-57¦Ù„:ýÀìX²Ñ;<¾x=wÛlz0z‡ ›é˜îq]“Ü®åä«Ê3IÆ÷êÕóð\| »-!Ó8y¡nº¸©Í¸Ñµeçr¬8¿)¾ïßÿX•“ÿÉÒí$ÊFNKF|dK)M}ð©÷…c’[K$]…e÷5<ݰôWdÂØˆFŠ&w¢ªµ_ÛW€wo:NÆ+öÃý‰´¹þPë-áEI<œµL æ½…óöÚàâvº£•Ëço›g|rëÜ^ÿp Ý­¶•cu3‚¡ëŒ3‰ÃwDTÌ Õ·¸š¤§˜¼O:‡‚ØŽ>®ð²¨b}é3#µU;½ý!Á+•–ëÇGƇ¥¤ù×A¾a"º}(dþ“¾’J ÛìØ¾"ky†\zÁ#‘•/œ¥9ê¡¶Ž6>õ<ÔFß«ÔdÔ®·ÿ?¤Y'yòi«Áü Ó»[;wCÌÇzžìd•Îô+é{Zý']ÒW}¤ºóy·½ò²“æ›&ÃtHŸ©€î¡S³•^/t“!Ê•’ô+i úU2ÙàÐ%Ø,hùáŸÖoÖg/&oÛ2m\ÛäÓc}ØX¶Alþ†BጿA´†C¤g¨…Ô-·²Ñ§§K+»r-¿[ÙE«f+KÓ( ɹ­ˆŒä _™6zOŽ~܆éç Û¸€øª{üú¡ÔR¤%JÒ¨>{3yÖVÅ/¯“Æ“Þ/³Ž‚wÀ÷ë¯ïºd縷Çk&Z‹ÚÓ¤“>(ù€i‘ÜäY£‹RcwÀŒÙ®„™ÂÄÞ˜uˆ—`&Æ™ëa–23ü¦9'c ©.±òýÊÊã1úZõ㶬\fgn ôQ §¿#^kS>¢gŸjªI={ ×EgýÆtNy-’ë*ݾ¼Š×lmÕ0­hòD~×A«ÒÇu®?ÍéÕÊònå°ñðè×ç®Û¨Mš\(ƒ§…×}êê'Vmÿ_MÞ¶MÚz¯GÆ+‰÷Tçkv»®QªÙµÜxwV<énTMºWÉz?=PŸµFW$ïI<÷Ÿw ¬RÙ[è€} 7žfωãi¶_‰ý6Z¯)}iîÛÿ­€ Œendstream endobj 142 0 obj 5178 endobj 146 0 obj <> stream xœ½[Ks·N®¼'ç­œfc-Œ÷#*d[Iœ’ìÄ¢|¡u¨‡•"­X´ëßçkÌ ^‹]Î.É«DƒG£ÑýáëôóŠ3±âô3ý>¿<ùü;·z{uÂWoO~>ñãjúu~¹úâ ð§,#W§oNÆžbåäÊq¿:½<9äz#˜wF„A§âóÓL%’;êÌYðVi1Ê`µa•ê”WLú<ê—ëbÖ c†¿Ó¨BÈ`‡‡ëfA«†®sÚs7œ®9s‚[T>¢¦Ò[£‡ïÖ© SÞ bK[?°õSª ¼Eô½åi˜.„y¼Vè䤾Í|[Ê’¦=] Ï\nGÓ<ÔÓ¹4 ¢+Eo” +üü ℸZKÆ¡\7¼KܿĒç~x•JùëEªËí^¤¯? så(€Ñ¥Æ0 ]Ä™+å‚S=Q=³QÏX§¹îÏsõ&ž¡‘¨ç°ÁÈÞBW¬7†æ…Þ¦õ´Z¡Ò¨Ãå–Vêv[Z‰Åuê} ç˜4eƒ/©„0ÃçºÏRÝg©nrRɆ†´+ü‚ñ`u ¶ù2•>6‹¤ºwM»]Û¼Ð'…†ÿÈ•5 Ú=ák_“Þ%÷,Àó|é>¤F?š0(¬ën®azÿP"¹Ä†J/d®'½òaŸôÒrf—K¢°\6+ °Pg¯±ÐËdcí†Ré]ÓnŸ…V†åíY–^bV)^43RÝËe²ÇPÝM Ì—W0§ã XŸþ{Yù¸1š3¿È¬ŒäJÜ•i)»Xp‰ãD.–ÅÖãÝE²‡v©ô²ca[ÈG3LmÙ”!D¬lÌ?u¾fA®RÝUkdi³ªcÛÂÊ阜N‡Ëñ´ÕVôÜ<q+åV›á™0ÁÁŸœþ9%æÕÒog’{ß2¢{B5\T<ºõuVW/$Œç}½ІÃÒ—^L²çz²KÉÆ«e?ÊڮͰÝé\ж·o3 p<8‰×?Êùt¯~u0?:»zô|ߨ·Ä‰þ¶w›¾:˜¥ÒsLb} –ûô$ñ›õ8±îÇZšX×3†Ü#›Ïygäj¿)<9˜CuLá0 e, y0ƒ2Û}…êØÙa¼iKäe´i±È×ò¦ýVüä`ÞTZñÔwWÚo>oÀ•n`H J€lb_è3lÖ%äÚúð&Jáh;q0D(8“Vˆ1˜MÀ4…VÊšyë¥T¿zn-µ ÞÆóVɃ&åˆÿ°+@º¢Hv‹@NÊ¥ nJëdi4IÑöS´ïºK9òÔé•cNE’©jøPŠvœ% ŸRÞG+³ /‹¼]Åö“uÉòäžÝE…“vÇšý J*Vþ‰¾[®AÖv”<¹ßè¸^îþ~Áê"`+¼+uÚÁáójBÎñhQe¹ª?²c¢{%ÃîôÕ[šÆ!ª©à0¦©0jöe‹P¶×ãÓ4 ¤¤Ù’ŽN•ÉEÊ%Nðêväô~Ü‚É),¡•o ™WùÿÎä~>:=ù~þmžÿ endstream endobj 147 0 obj 2829 endobj 153 0 obj <> stream xœÝ\I“Å&ì›.þ Õº”ûb›ƒ08dƒ¥!Ár­ÀH#´€Ä¯÷÷2«2_VgõLÏŒ°ƒÐA¥¬Êí-ß{ïËlý°£Üú3ý}ïÉ[wüæÑ‹bóèÆ7dz¹™þº÷dó—|€J5J%üæäá 1Æà´‘yg¼Œ›ÒæÕÆ‹°9yrã‹Anwr ÞÊ8ŒÛ>Ñ^›Á4­Öêá³íÎŒQ'‡»[= £>¦Få >û×v‡Ù¥Æû¿o1¥"ú¯Nþ•…”c´VÑÂò–äFê0*S×qƒbne†OêLìñSZ‘ ÁÆád+Ãè£+ŸÖ¡îÎOy!GˆHáCïêòþ³ÝéÑ›¨Ý¼i§4V"F/•vøû7jømR‚,åpg«í茵üû;4Š•ZªáÏyéÚr)ÖïËj©+SYUÆ…Á–ÇÜ[kÞ{gTÝf§ÝtDïûèý»¢èî„xM›>ÆBU°cÄTÊ>¿%«Áù(üðãV!Æ ‡´£÷ÃSH¦f)Üð¦UocgÑŒZÆ8/ýõB4í>ãh0Q˜?n¦{A›£sŠÍœv‡Ç ñ^F94ÒkìX(¾ùû0‘¾nåHfã†3Z¸wØÙsÝÖÊáç*6üó­Ò£“Z¡SúTb¤o¶³£.D@ÇdÖgõ ø‰šwõ ª­ŸEЈ £8!Ýš¸Úqݨ`@fm`ëøÇ~ŒÐCYÅŸÈ‘à38XsaŸÔÆd8/ñ*ÿï!rI¯‹V6âtàLý\õÔ²V´ù˜eG´'eÈHÛ–IØpUoºn0Pˆ(o i¶#wñÇÙ–­ƒ—Ð,Az¾·%iá}¶NOèK˜ ÙÆ³t&úÈýâ9¾µ†L5VƒËC1}¨] G‹×¸Ë‰£¬‰×é:S¤‹…”.zz%t•.—#Û}qL.ˆ¥Ì³Ñ4; ra³“q –ƾŸÃŠŸ–:9möT©›ù2`!°¹á´Å# ¿¥Îð$–÷k>f¨Gó9• (“¼´sƒØ÷<ÈÕ¨I6@ß„jÜTÞÃ;Û€iizj¸pÏV“j°Ep&W]'a¦]3Õ>R'IßOÁ¦«u·Ÿ*ø ”’!mßbû:2eÀWÄêîrõfdT–;R¯‰¡¦F¨©“¶aŠª¦ÙéŽ@5mU‹ì×i«´È¥¾NO>é}nƒR-Y³uiõ¹ñAùðeiû¹óöyi;ë¼}–ž¢œ¶°ê/‡ùíÑ^­`îˆl;#m÷Â^ ,ÊýÈ/šf šÉ Š[¹EO¡l—mÔüt¶Iâå¢Í'DœŸž–' N‰†”6ù¾: “|ßäÙߎ֨­Ž|µIˆh ŸÀ÷UmJç©MF•ûÁmj› çxµ¹Fgó†ÿˆ³Â”¸öþZžn-ÚH{ï•¶÷šš…´£DqÑwªêó ªêƒƒªú⪚²EH‰ŽÖ”úsýšúŠÔP˜rþÙq™—E9K[䓵äYÈ“ç¶{¥íës œvyŠø_w”SU÷œÍ½³KÄãíòú¤¼þ|¡mzºSÞ~Ò±…OËÓÝòôþ,’ãÁ  ·³ÈˆŒ9 lcê‡Ê™k[#·­6ðMG£/:6°Ð^Šßnᘇ1´j·Âò¿€þ.¥5Ô,–°ì˜Ä—´–ú©K×ûZÓ}µÕ¸wïµíQ*HJÚLç(àd GNÅá'äZ!x-r>¯ ½pÍ~ÓÌôœ1Z¡;¥l9»Påhsµò_YçýB>uæ£,”ø”iˆ7‡™†ÎL5‘¥j<£¹$×ÒpoW¹ üuš¹TXΞ÷ëÔ÷Ñïë)/›VŠ @]˜›À>Ž×ON„±ï,¸†°(pܚήDwnPW ;Œ”ûYG8¦—&w“ãJˆ‚Â?¤S¤>¸>f×d!0‘€¢é!íI‡ïº¿Ý¨9g¾IA!ÌgçwÈ0öKn[T3qõ¢?’“@°¸„ ¼ÍÝ®IahYq€‘а¿   ò«!$”Ðò„„¼!Q§úõv¦ê¯‰¸_žjúþ°´=ìô}+„„ñîØlKç~šfVœZ®»ô"Õ²Y²Å¥Q6‚Jµpq6â²*»n6ÂØPdLk¬+ò¬3ï 7i-J}®Ö(7Z{Ë||1–CIüí‚úzË”„A9aÂ%Ô¥ã8Ÿ.^¯ºþïH ®]ó–H‰j —§ +þR¤„Q¦hõR¨tlreÀÍçýÕs¯NI(ïm3×¢¼Ë2F¸£ÒÞ‰0¬§½Ç(¬«­Ë2m6‡LÓ¥ä·a"¦«ÈÛSŠËâà‰¨kBIûX‚Û$¾ÍP¹0¶ Âái®wé4ò¸ÀêiÎ|‡V$ÜÞðŒïiÍóêzVÈš2²ä”UYßò*¼)/”!B&p1uêåÌ”Ö!yi±+LAÍzû/[ Þ©¸3,©e™2ßws•4F«>p†M¨REeÝ“Á‡dGt—"”êzY\MÜI®¡àÒš¤y&›Æ¬×`,[H#êV/$j踷?$QÄQІS™nRERªJˆµöøAà0ïìÙ>‹Ä®ƒzT·UW®ž¢™Š.ŒÚ°".õh«§÷3;¡bGÛÔ~â|!­ÜåI¹gÕ[]0jŒ–t®EÄJ{Æ<]†Ø 7¢˜ŒgÄ{×xÒiö‰3Šr…`|<;'#3ÇfUáTš;Û{^Ù¯Ì3œvç=>"XšeƒšåȪÉúÜÏ•“…£bÂòâ B‚­öÃ$¶ÌDV}–«çèέ“9z° –È\ÿÑž8é>Øäéšû6å’LT5Ö¨}ègvÑçr¦MÂÀ}Vlž¹‹ ÇÉD=pè!“º&ŠÔ€ ûÖ%²¡ ÏJ!k#°Ö„ F¤“ 3ó3“8ùÁÖ[¤ØÙîb¤+:†îªÑ²Ì1'RsÚ/Y›Ö.íq4BCQ¨†¿Y'>€êu’’¨C‰YZh“´L³U'ä_ö& `TXµzwOÅ ñšåM½Åï%žÉË2þP®g÷ŽöR»S©¥:ê\¯^êf›èYA³Ò)<{ºz ŽFMûn¥QµÖµœƒšt.s¸œCr÷Ô‡®!è˜û¬êuzxVÓæ 5¤ì|vJžâ"±£ä–HÖ»w·ÓTQ¦î«¸1Vº.ªÃ~X I-TÝÚ ~- ¯÷²›áRh´1Ä•õðT¬½Ð]¼†Xñà¨hc“t/®6±}‘ø”+O–"w½2ë©üœbÝJ4nÆž/†z^Ò° —Ôç£UÈdZ› jœB/—Ed:×+ºîÑ2ùc*‰©D@°¤SÙêål´ƒã8ÂΤûPBÇ4]è~žûcÙzøÀ(Òg)-$ÂL³1ð”iªÉr^o‰T º9]YAÄfålŒ›¹® v%“+Ç-ËcÅ–¾PÄ” h´ðiÔ†[[\G6õœøf^0•'¬½Ó¢î¹Ž’:A´)?¿¸6¾jgQï–ÆJŸzq¦’­•°ªÄøíòtÖyzVHž“ƒßv$|«ôeLÒãNç 1´l𶘇`Q:1ÉC9I:š…&˜™sÊ¿ì±ä[ËxÅ~¿B…Ýlƒƒä9 @öì^¢Ñ¸¹Jî¤,lI6.Ô«œjõ±W[Pðz’S/úñMßš`[N8Ï1ïÚØ‹±1ü‚¬¡b·Ù«º«¢ßy,¤ECŒÜ\’I ˆÓÏKØñkÅ×ÓvîÔ¶|ºØ*¶`‹¸ß±£¡r¡4AÒžës Ë’(_r㚨5q÷çì©vZËk'è'â³IÔî]VqN[\X¤ñ©NáåL½•±ÞÙŠÙÑÕ$š0ümw´~¾¢;™¡m{>Õ;wóçüN’Wn)bñì|šNmKžÏÛ1ÿ~—n N§“ ÃÑ>$„æsµˆI$Ê—Ç–Ô—ã(vÚÕ›€å¤%‰§ÛìqCûà](úfa(d©¯ðkô¡Ml…p¾ˆAéÔ¨Â"Û¶ýhÛ[‚MúD´P«G´å;´Ä„.%÷ĺb2Ãîd9U0(uƒVëV˜v&W5ß ¡½HI8û{„¹s •d¹F•½¿ ¯2w¯„K̦dlË¥ð“Ìþg×­…ÃÔ+ñ5-Ì©k #5k<)mçpšîDÖP±ZGµ×ä÷X&£û¹ÌR%ûÈ„ÍàÝ­™|c¨ÙZMýË~¨må·ã†Ñ®õÿÜ ?8¹ñoüù/ü¬9æendstream endobj 154 0 obj 3764 endobj 158 0 obj <> stream xœå[K·rÜKþÂÀ¾Ìšߣ­Øp'Nä½YA ¯¤]Á»ZY’ëß§ŠìfÙdÏÈ–â²ù(ëù±æ‡˜äNà¿ùÿ«»‹?<ò»ë7bw}ñÃ…LwóWw»Ï.aü)å­U»Ëçy¦Üyµó"ì.ï.¾Ý«ÃQNÁ[÷®4ÿqùçy²š¤'‹)§Ì48ãeÜ•>ô¤­úðpÔ“sÒÚý—¸ª”*ºý§‡£™¢²Nïÿv“7AøýåAL^ ŸãPœ5ûG‡£ÒvÒÁîe&˸°ŸGØRGT&1ôŽglœ #櫃†I^™ý×DÀל–²íåA†ÉGéCi©o–V&DkNÉQ{1ÁöGí¦ #Ðñèø}‡¿Œzøž! þ¢ìt-ï„Ù¿†–Õ.†ýÛƒ™‚¥/쟗^ó•Þ©ýï Ø½Þß"ëDp>ÏŸwq¾û70XÀ™µg‹Þà` ‹ Í~ c¥›ŒpûñÖ¬0ÁÀ j2ÊA缬 ²w;Òà­ÌÇûŠOMÚ KWyGåÒ}ˆÒ#;ÃnQÆ€‚(ñ@ƒSËÆ5g­„‰³wx8-„Œ&ÃDWKÇÀc 7ioFX„2Fü ƆƒÆ#k™îgfHr5« `ÜÙÿCEÚ²IìóË<_Û g²Œûù­w°X ã27ˇ7µXi¨–³O°š¶ûbiueXìD™õ -ã»Í4‘ÅÑÇ(Tå¡Ú„çØŠRÚ JóYGA–åÌ`ÌŒ–VÇ…=1àEª‰4Îà[ÎÊÛS›ëd"~ÔnÇìŽÒƒûª«<˜KÍ+”sÍÀVᢛ´Dn—£û eè(:œÂ{Øí¨ŒŸP’ÎQt0w“ a,ÕÊj`SÌ&Æ P€[NÛµÓ„ÉJ]‰Á®æ)Y‹šm}Ÿé‰@Ïwô^W4¼>€ŠYÛ2…F^Zt=zpˆ×NJYË´‰Í¿.×x³ÜÊh%FÊC¤ß1ŠßмX”g ZiB1I«‘Ò*¦^Y‚±œQd¯¨ES𶽟,tf¼Ìgd™"£gb¾r®­O3àÜÁÂ?ße­U^ØJèà@ÀV Ó¯]ŠÍß™ÁP]éÛwÐ nòÀûÃb!xÐåZ;ˆWx©,U-h2 ¾ïZ·6µ®X¬GÅÎ=+­'¥u›ZØ~YúÞ•Ö«õÜ3[uоéºÆAÔ>;jîažc¬æL×½€Ô;f¦ŸÂïKëÇÒú®ú–ðÛóS¿îðîªL~QúÞ,„õÑÆ/7ý Ü=]Vm‚‹^?-‘a×±)Psò’kYwõ•¦¾Ûúp©ï§Ò׈Cúúj=£w$ˆ6ákëzR‘T<‹?`êVK…É«E*ð²T(íºb`K’Ì,h—Z±À¾ïJ« §X.¾¾Ú†¯+™ZZ…¯=~©ìþÀþyt#QwŒUë±H¥0À fRŠG€ïŠï`¦½2Þ0)‚žUÚGiYlÉ _ ¹« ³òº«Å„mœ+^$†!#cÑ5lÎb³0ê¶#è÷A»9ŽV!-¦ØðfKЯÂSƒº8Û·­  ]„0]öïí*¾ê²F™«ž¯kŒµ+WŠiÍÕ’½¬dÉ•ÄÓ*ø#Ýcqå‹A‚ÇUžÉR%6ÈëSb÷x_Ö&š°MkH_ôâd!ír+zá„l³Çœ'Ø S«µJ3ðîß'Š*Œ«Å7ȸ7÷F&ïÅ V}éܹ÷uT µ’xÔÅ_efos€§P  %m±Ôܶ®‚^z±°sÊ,‘öNò¡LR«|¨U|’Ú©œÒJ^*±$ù®ø¿´$¬3S ÔOt€7HûC~¼\0•ËC”“p*&Î@ª 6‡nÑ—@r¶¨(3v”þõðÂÆI²v„^¤¿¢+hà‹9›«ñ‹õiüÂ+¡—ÍIùYÄÌWl Ip‡Ý ;˜ƒD`P˜‚]û­Ab!N~‚M=Iàq›ãâjmŽ+·O @…J`t_hIR†ÕBqK Ä?hÄÇHÌl¸Næ¬ÝpOZˆN°iýœ $¤<òžY¡H.’’ר–ã9jΡ“µaL©¬7ÍÙïÀl ƒÀ¹¶³¾ÇbJ ó‚¼›iâl¼­@ Ì7 [ (UUÐ…°[@"÷o Šò§xPSy¦†$m$[P*rØHIL"ZIzÚËjÏÌ2F)Š7ìB åj‰$Âsˆy¢6³^lÂÍ|»¡&cWùˆ°ÜÿÅ…x[¬`’v.µäsÉ{V!%|„Èq =Ãw`#+4qàWge€ä&y98¨¥ÜF½³Ð{¯ZíïgZí›y¸Ü.‚GžOË>ÄR >×’ë )ë;A[QÒœŽ¨„ÞâIQùÕ\¦HJ‹¢ü<‰þÆ‚¿qfÃß(à{5þjFb—‚fí¸È5zòr²ôø«M•õ¤2¿Uî ¥JVB?XeöÒ8o­Cg‡ ë7˜’›H”6ÍŒÆóZ/ŒV)}w3üšÓ’ZÑgðûh‹øúϤ­‘ýûâi®;_Ÿ4»Í¦„=_]\~òíLS&¸Þ‹hªi¿jú²;‚B¡»˜Ý_ TS_±I2ËÉàœg@´DK¿,}W¥E¬"ü)Û#q>€¾|Ôáî}C Ýyôúk›lbÝj“l¦¾8ÇË)ëd/lß³2­ùAǺ®iy³ò!™¡ù~{"Ü[àí,®Òì?)fB\„ÈzéeÇûÒ);Ÿ{­?vú,[»½=c Êû¢6œ9åñ¡ÕH.ý¢û8éÓù}IuìÒ_n)•Ì‚WOPuEÍfÂ2`)Q1¦Æ{s5ÇÚ~ç ¾zDè;‘EŽž0á2=î¼?ð¯óÌcàŸžðÑMT š.2D¾òpbWq?ÄÀ`Ú«Ôõl¤0>RŸI—4ëã­@0¦28ósJ°êgʾ™âtÛÆÑÃZÒl$¹D«Æ–ˆ‹@È!DÆÛÃA×YÞðQ§Ð'#ݘ:Ç+oƒœL@ŽÕæö‚ÿÁã¬3S©ŽRE¸.°þ„™,Š G,˜¥ƒ5ø×ÄÁƒb¤qÍÓFìƒwT=D/…à{sWA“§æéT9v«¢i#…ö¼¾ô²MÛ×@¿©5•¹7[ÚäÀy°TöŠUOr-Ø©ñ‘Sí͆iË ðL›,5‹KuR )<‹zÛ6cÙƒ´i]¥@ÿñZc‰^k¥²“K€;ù²«Ò×i©Š[6«rŽô9ðÈp¨’ÂÍ’O|G5m s@cuÐÌa‚bÒÌóÞ´jÎx›‹“KùÐÚ¹ShA±Õóð¨u#€l›ƒEì% ’×®èm ¸yV]Š‹H¹Ôç8Dö\ð‹ß²D²2§¼ô‰‚ÍÎS4åò “öRWè$ðA^ PÍöA—ž‘ ¾¬»³KgU“#Ë›=Yé77ÙÅðºOQ8)"a6k$±`üÌ É$7Xv?|¡Úª¼¨P…%>J/O]è¦BÜØÊÞ·jcç«alââÉúÈÅDø1ѵ6!—¿ßæe¾´™ž÷}ÛÒQ­÷†yÀÙL¨T¤^QB«ž£Jò|aŽêçs¸ël?Èý¾X¨òX³-€3Tú”E«àá,".! J®°Á£RÕquªZÕl\ÕGõßy7ñ>üíQÏÍêôÑ  rAwhÝ ä™@6«»ã×~«9œåÄXµÕãå¹xAyû¾µ‘s‰{'Xú% H–,–ú÷Žëì"ÒŸ—2Ç߬$´yªÐö"­Þ³¶ciÔµb×g ı´LÇhPŸ(.±´tùªJ_(}šá6KK•¯†ùÒ'jªRŸìPª;_3j3¬@Æþ— ¥7¦ ôTÕN‹ø®ÒÓgÖ0þüæÄ,¸¤­ž]~ sB¨>Þ1zŒ| ž§®fÅ •WÌ¿ruuì –Z{Ö,þÌZ -¸Ârß¹*Ôú¤ž|¥"+<ÒDzµýíSó`” ¡^ª%pŒœé€rR\òH½¬mrà%Ú€4v1m¤”~xRLŽÝWH¦Ûo` 3±óÏImûƒ8Òj£–Ÿhgf0gU•.YW…¦Piűe¯ð&Y©f—ˆYÞÍz¥NégJj#‰›Õ÷Œ·¦˜A,¹IÎIÏsÌ´ªÊÒ«£‹?uVÄAp2€Wá,žpq&îÿ‚¼Ç"<&Àm­{ç¨uUèø¬üêöƒ<ƒ}¹ÆÆÙTjQ¸ûMi}ÎÃÝßΫ¥Fÿ7WžÔ—M»´?ɪŸ:ŸãßpÖâÕ>ìPÎsiýþrÞþ:ÌBÖKÚØ&m]ú¾ä,jÞ‘ZRê‹¡¯¤)$dœ…=còHøëg«Š¼Ï//þÿþcѱ)endstream endobj 159 0 obj 3730 endobj 163 0 obj <> stream xœÅZYoÇ~çKþÂB1ŒYJÛêûàùHƒŠk rò Ðâ“&MQŽüï]5=ÓUÝÛ³\!>°XÓ]]õÕ9=üy%…ZIü™~Ÿ^=ý6¬ÎßÉÕùÑÏGj|¸š~^¯>ßÂøSi¡´ «íÙ‘)zcUãmPiUxA¯‚Œ«íõÑ÷ƒZo”ˆÁ©4ˆõ–˜`ìà*®sføn½±"iëÕðrm„´)™á¯ÈÔÁ²¿­7pº2ðü/k8ÒI™Â¿¶_ƒfq¥”HÎiT,›¤VÊD¡-éqBálm‡oè$Fþ5Ò1º4l×*ŠL\XJ¢^ÎTVä# Ò°0xRïÕzcD°ÉøÙh¯ h"EP:H7<û­¾ÀuÞ+熧ëyc>.ÌB‘n»(Hb}B!ón[íÞ˜D\mŒÑ$Øýì>]k!c”qx3RAúáªð®ÀË*‰è8ó¾,¼,¼Ÿ u9?ETçHµÚžm¿~(«n&Á> @*=|6qƒƒœ—Êrœ,¼'¤×òB¢œÔãDRÆ; Geµ0^êÕ´¶Û"ün¯Ñ÷³>ÃñŽŽ£‰æ#p–4J„ä,üɆI¥õ‰HêºF~{^¨…|GÌ5·vÃÍÍNB‹ß6ÖáFrw`íf;ûø¿ (:ýÃAµW[\o¬ð!…yý»úOH"ï–©¹O£myúkgï[0Ñ@ A!:+Ì÷e )zZ\ØfR7lG¨ýï?J·Ñ»;8ˬ›7¼iÐ:í& Y4ƒÒ&Q%àóSvÒy§…"‡½ïëÛœû1Ù)Õjß4QAZãÓûÎSrÙNI.ÊÓ‹Â{ÄÍ,VRÞýî¿(L Ý+ /Êã×°( #[øja!bÓð¬A©³Æª¹$çªIh_îœì- ûÎÉm"4( îR׿ïxánÂÔ©9…ð9ñœ…rµt²¹AÕ`ùB}YР¦uÜ¡8ÐUÂbÕÑô)ŒÒ;á5‹îÞ ÚÜr§î›ÊJRY4<¤by3êÞÛšFÖñy¼Y¬âý¢¢aÊFE¤L9&}”b„oŽJ†/óY§zP‘Óñ?Ÿdž–=Ä3… ‹dcR4½¤¢slxõºOöT{f0%Óå<™Dn©/:ÆÙND¹ÂK øub¸b\ÏôžÁ¡̲éÊÁì~Y´ì„d•5ŠÀØ÷EwÿL=-úí/¾õÄVR‡š’ê/™‡æ}çM‘«‹áói–U˜>Ú»AÌ ÓQžr붘{Ùyº·¸³Ò±¿ýT$z·@Ž£`S ÁŒâ6 gÒ¯m¤ÕÐÂæ}P¶õÆŽú¹&x,å.uàjåÔUuë Þç¶óÀ€ˆÛK!´¥;2,ÍŠP“É+4¶/#»4éw6kjéBÛîEûÕ^´°›Ž1ã1Ó<`>úÛ½0ŸœIEwàL ·hëúó_RÊí(‰Ìýåp¿ú½ÉøŠ%czYîzLø³ÇƱ:© 4,¨hÁrx¡ åÚ·ÌûSæÁIuÚã PlµŽi¿¼Y"TΊ(¥´#S„”B¾G2NŽúJ¡‚óÚ¢c¶^´&€2ÉiµMv|ᛯÞBí•£hü&×Rì :˜íšä†¨Ô(‚ÁÛ$«œý§òý%caLõIëÆÆ(aJPþ¡|¥é~CPmÍÊVÊüX¾–0ðª?e‹•×̶ nô°1êáÏEZö‡¥w@9ãSdÛ3¯ pL²ä&ö8ãä¥ÏXƒeQa ÖnÄ VùùTVlö 0#d®áÂ0#\zƒ¤«ñ—›20¼ã NHœy†Û x€ùÙT%ñún†dLTmSH;—`MÔ6yþ.uŽj’è?íÙÓ&p¬#^;Dzò¼d*•€)µ¯Uc]³ŸOUs˜êMÌ¡ÃKôr¨×ÿ9’@͸Ô¤#â–4m›_–[€I=ÐœÄæ¤i–0YÁb_7Yj}íÄÔ«1£'kÍäú«ŽÛ>º«E^1Õw…ôùÔì oÖäåÉçŵîNEé<îB…(£*¼RŒåí«íÑ?àç7>=endstream endobj 164 0 obj 2281 endobj 168 0 obj <> stream xœå[Ko]·ºÔ¦á¢Íâ^×÷˜ï‡kHŒIá6­+ @“.dɲ˶bË ÿ½3$gÈÃse£ÖªÐB3Ùo¤~ÚˆInþ”ß§/î=ö›goÄæÙÑOG2}Ü”_§/7_ÃøSÊ)Z«6ÇçGy¦Üxµñ"lŽ_ý°U»½œ‚·2nCmþûøÏe²š¤'‹)§Ì48ãeÜÔ>ô¤­úp·×“sÒÚí·¸ª”*ºíW»½™¢²Noÿ¶““7AøíñNL^ ßàPœ5ÛÇ»½ÒvÒÁne&˸°v{ØRGT&1ŒØ36N†óh§a’Wfû=ð=§¥n{¼“aòQú•¡´Ô?æV&Ä4‚Þk'ò^»)ètœ_ìÔ$B–Á–6œûîÕÖ“úõ¢ö½êÆá×óÚwÊZ{ {ƒ„¶ûÚù]òEme¬P…ì»×mŒ­WµuZ[—uî»ÚwV[O$ÄíÛÚù¶¶^×Ö»ºÌ›Á&¸Œ‚e„,Œ¶t]²ó2´É»y¶/r ž?E—ƒŸä¥¨æ¾¥´Œ¿×µïj‡Z¢A#Y®×ftëU¦p P(5yŠ¥`)!óR½" ¡l™ôSéI ZR.Ь`Z2À~{íã$`hF=݉ £¬Ðiam……CÓ“Õ.†y¾ó(î«dM&ú,îupšöõÎLAa€Gèô` >/e¢ Ð Öä5èÌK\KÅ ­âK5$^ò?ž"‘ Xëê r3Hú ¯p´ôÖÕž!s (ò¢þ»{µƒV"ÎKÃ7õ„¡ÊZF糊$‡²©r&³¡…Ñ$‰Æˆ§qˆ¬dÅŽ·†ë2AÛ ·/2æ¢d}Œ ÀÏÙŠ —0ö%Ž´Õjû3`m°n^Úz}»†Žrr0øO•ÃÌ5ê×›¬È.lUäyr’„‘YsŸFȤ—|ÏB@ €W`H@ Ze% XÛì¥gJþd‡Ðïõ@àÚ¹¥6VíPH÷E…PwH;rÞ-$lÀJ¼²L_‹T P×*ú[d,N’©1£‡ †Žbä*$´I–c¼i᱊€âª¶®0ÒJ‡’SmpéÑÐ ÊgÁ ‘TcûWdMJídÑ'¸B>Ey@ Y䉪Áµ”©É5ŽuÄꙜ`SOáæÅyQU–éÿo€75¼lõ@}°  ˆJÿ>+0‘VˆÿlQËšÉá5vúÉIt˜íXi…cúØjÈ^‚š¤ý&KœAÛ”P‰)ù+¦­c^X„í;÷ʄɱÃͲ\²ó¯¼t`¦Àº”‹+§Ž›Y@\7;o(ÏcЭ.$"l ‘á0ŸÆµb)“´÷5îí&Û¤ás#láК:5@£lŠ©ÛåJ‹‹0:©w Oôü‚Ç’)Ô¡ «+ñ :`ÚZçøtp±KY«ÁYΔ{ß( ž>Ø’RYÐ9‡÷ž1kºÐ,Å@LJx€ˆÝ — xjs­ÛÐ<„)lö |KÌ;È|8DƒÓ¤ r¢<„@ »sóqxzA8¡æ5׈íi‡ÁØwY[“~¨}W˹#ªA¬’¡ö2òHTŸåÜÇ[?¤ÚN•䇧ò²sC¨p}`Ž­÷bCí܃ aÜÆcŽ ,Ø %cì/mÝÌ+æyl@Žg•5mèµÀ>aù¬3\þ€} >Ê %~ŸI|6Š£óퟒ,dßžúž*¤»LKVBÈé®2ëè©—1²·Ìì³À£€Ðù xç÷´Éý^Ÿ`tA ›¦ØÐ>;` ŸÛ(”Ρ‚dPõ MJ;æØÞàÂ@;Ú6¼©^U™âú‡Ø4Èí@ˆŸ¶„V2¹¦™u¨©'S_ÓY2&›] r¨ý!ÜJ$UNÖû”¾(«ÙªÕ]•!S}Û*qW,¸_•ýþ °Š4I±;¤I}„4ÚÝ:ãyWûž ̈ë˃žð1ôÎ3É«¢5ÏÔ6Oûnï®úJR˜´¹ÐYu}5…êGäHšj « ,ÄÛz—ȱïý¡ªB˜e>®&’<\àêIáXónô¡|¹ ùHfNÒ½7ÄP÷NÙ¸Z7úšß©™¾öò¦­÷}u7} !ؘÐEwØú#}þõ B(ÌÇ+`Ê»‹˜ö¬]Êi9iô %ê‰x| cj<ªÏ¨nQj(g#óCånÌ@E\ðÑR4øˆåc¥îôºz…+âáx'1—’}®3.QèÔ Ì&Hþçd¼‹™€c¦Áä²û&˜&z"EÈØ¨ý8OÁ‚Ö™^ H³¬“$Dn+÷*d¬U®ðT4¬ùù*W ¦ZÓZMà糆T.¥ÙVx·(Ï5‡Ýy h»ð qQ)§Þ~\„AH!«HD‘"tù;&•ѱÌš—Mo™U~}Ý+”ÄŸ ¾¨œÛ,V-¤æ–×EDÅÃ³Þ É^!£Ç[‹lM<ÄÏ|½ÒÚTÛöJ`ÚÊ®’H­¾Ä Þ,Š‹Y‘:’²-T´¸¥d*Q×j4û<*¬$§s¼µ,ªcß³­à ¥-°$ÂíáÊSTãšm:ëg(3Äks .Rv!c"´ú‚Êÿ© +#5Hõ.»ÃT À¾ äÊ¡­ÖÌ»¬¦Ek1Y%ÌZcŸñ8{®»¯ÁùÚ›ðZdKið¬i­4E©EÅMšr>í¦-(yæRðËúxàŠµïUm‘ó/eXJ6+Q–±M¹ƒë#óRTÚ»Nj×)=à^g+׽Π‹é/ñ`²ƒ)ŒÑ]‰WF› Çë(k,“{Îß´š…C—­—–$lR€A)ípÙìÀ0~? ¿`Zª‡œÂã»FÂ_gñêÎŽ]„džÍ™…®ü$Odc˜Â,†û;Þîˤ&×_ò¾ŽWÌÏq³0¡¢0hR©¨x¹åWKK ë#S̱±v'Yíî;¼WÞøAŽ—‚%D ¥&‘3 ÇÙ;•4»I”×ôÿp©¹+¿/êËI7 »þßC5å!d…H›Ýì‘C-A‚¡«·ÌG­Ñš¡/™æ ·›ãGGÇw~Øþ¾C0z¢€}§µE6Hé)%¯%I Ã=LÖ@ûÞÖVŸÇQ[õ‹%´_r0Í}K<ü®vö,%ÛmÚ}ÕñÕ~¥—$èòûj [(( ¥Íd1“*ìöî'ïZòLÍFB=?i1²~i¤¬rõqQ8¶ü 2cÆa ”3‡td$9ÊÒg^­cÊö`@Ü~];ň9ø,º>lÑêÝùˆßÚÁäÁ@LÐÛµÛIà‰‡ÀÊ[3žy7zµC¥ ºî…XMbtJ½ËüäSÚsu Äæ×y¯á½Ô\zÈt5¯¹m“xt9†v&U'F¥ÝKžö4 H°™±ò¬q0Ÿ¶y†I@r~í©£ƒb1æ:’Çî.ßú NmÓ–Ïc/bÒr²ÍŠöB¥—a½`rò“|òã멾‡UAKûä-'KŸ¼ás snLÞf6”–ùÇ‹ò ÂŠËè†wN&žîãk9K¨õg43Ó,³§ %S+£_ÉšÄÿ ØÈÕý9@ª·¬¹.PØj ˆ”Â-ˆâAÔþ€2â}  å9æ"Ó'QR %mBòmç1e¥’z.j z­DFÍEF=2h¶í‡]º 2}1 5"4côMl6açZ]µ+ìòAFƒ Us­Ø¤þ@Þ¥Ø\^Iy+©Ó2Eê2™åU£”*= ƒÍF½ý Ê«Œªþ.s­NÙ$´¦»öÖ¶ÈMZ*Oåx>ôÀoêÖ6Æ'Æ7z^WP²k†©->†Z”Ëò©[VÉ.ujÝÞR šn…gk”²Fä¶¾z~‹jCVŒ§‹§s~MŒ=Ÿéë ?*—´utÉñÿ†wŽÙ¾Ú':Z€WGQ|m‰O`ÖÇ=þÏk@ýV_GÂb&Ú\Ñõ ¢è˜&uÍ4( ¬g&Xõv·úH¡«9×ËÆaÝßNÒõ»ï.g+8h|ŒëyEjíIC26°ˆ¹æ:×pþ›V‹yRßßµƒ#R}­y%kN—ᚌ…ü¨ `tpñ¢æÀß¾šëÓ¯ó›,¬J³Ð«g–Ì®±ˆšÆÚÖ8/•Ÿ3]d€ó3ÎX¿ù¡K¥ÛòrùNyŽ1%×ý«)<†Ÿ!2°Gcœ˜>>M†ÌøÎ˜êç×/³{#0ˆÎg¯|øÙ-§÷ý•l;e”üÝ>©çiàÿA^úï—ìrâç¾óNm¶=ßR§#w}[‡©97VË<8ŸûÜ û½3ÈœUý:šÑ–\Ç•šÏÂâ¿n`1Öï²#³@¨}ÔºS¿ÆÁŒ©[™Vi[ QŒõû³HãŸ7H£/I´Ò0ƒ'iôEŒvÆ-øW™á0úO™* µ›¾7øªkŸhrf;Ê2 }˜íô¢=oê³½t`òmé¡Ô•Áô€23·HåG–Nãô€Ý‘0|×WdñÍñÑßáç¿[úðendstream endobj 169 0 obj 3520 endobj 173 0 obj <> stream xœ½YYo7~ׯhìn€[Mó>r<Ø c­@Žwí ØÎƒ#É’Év$#H~{ªú¨"{Ø£Q=¨¦H‹_,VÿÒH¡‰ãÿ£Ë½ÏCsz½'›Ó½_öT?ØŒÿŽ.›Gk˜?•JËЬßíI‘¢7V b¼ *5Ä º 26ë˽׭ZuJÄàTjŪƒ)&Ûú‚ëœi¿_uV$m½j_¬Œ6%Ó S Ó¾[u°»20þŸlé¤Lá‡õ· Yl”É9Š GR2QhËz‚PØ[ÛöÿEtŒ.µë•Š"$¦²¨5(rˆ4L žÕ{¹êŒ6?ÚkšH”ÒµOP?¥dÒ[­mb‘Oa± &×>\Ù$lr$öÇô΢D<‘ó¦}ÌÜÛV¬”@Ý|ûï•N;`"Ö§hãÀÊú ÜúTÒƒÙ­m"rXc‹5µ¡éŒѤ8¬ýçJ .Ú㞊2¶'Ä{GÔù@Iß¾ÏæuN'‘À`ë%M¥ÀEôº}ÓÒ¸¢qÁãÝH8O«’&Þâ=%êÕlRoV‰(+|”ªYî­ï½n¯éL7$øíŒWžøh<§DëLK>Ðð%ñ>uA£'Äû•¨5~®¬EX l‘ÂÀ²6§=•Ô¸¯“zRŸ0-‘ÇD±ÒŸhñÄË•îxiJíÏuxGÛÙö·iˆ>ã¥n:À¯rt±+‚”±¸™)‚¼«ÌÅÈ!V }7³[é™·¢Xù{ÄÏ+£/ˆ7÷Dž‡ð=Ý:=q\ÂHiŒADÊ0ÞtjVœVe¡ñdë±1YÃd.¦Œ°Þ´è|Úµ÷YŸ´yŠìàOŒ¹>µyK@>"Þ†ÞHÖqtÓ nÙeˆàÓ-G{>ËþŒ¸H¦tܽ»c}o6uL;º­øo‘O—ò Ÿ]öNù¤Ëóemçϵm0ë(g±W¶Q)M ˆšyŽ›y)`7/¥(<¼²¿Ç6OÖbŒô;¨bAIXç¢1ý‹Y +t0Jxý´µÏ·ŽXH5µŽ‡uÚXˆði]N~dr½‚]…‚bkÇÍÈ‹A+)©UíøÑŠ€Çuø?6鬋1L'B7©½kÏÆÃOMº K)b? ÃË8E„~¯ƒ‚ÄQÊB¬½V˜x”0;Ž—Œïæ2ÔæíU‚,};¥“ΦÖth(”o:¸Ç5+gƒ“ˆ°g+zûñÐ:N° 8‘P_¾£ŽàgØÆ!øÏÔ#xiÛOØÍtÒB x5Ì´ðfìí¦m€˜Úƒ7++¢”° 1uØúÔó2=6SI—¨¦8ø¡@‚4ýñ?»ÈgôJØd¡9æ®æ ÞU­©œÁ^òh¸?(⸕sHÔÊ|}$j=›WR´öº²G–‚Î*‹9-qvgêsE™,aò{Ž÷ãvÛ¼Ž³ÉÜ”Ã÷Û$TmÁœ6G7ÿpJ."ƒ?MÖtÁ§0YÓù©Á^šÊg‚‹–ïÏŽg¯Þ¢¤÷à¥ÊZí{¨¶ùȦét«`”½ۓÌT ðEývf,äe5W%»ÿkV›à0÷s1T¯ð®.žõTRÙóáñ®]Rií.®]V2híN®]:ô -®»v°#·yv ç¾ãhk¾={Zn¤K…EC£ÅûŒÞ[|úVÕ_Úz¡Ì,Qâ]ca‰ÒyÒƒJͯËRí+ ’ˆ»²œ8p1tŠŒ6e]È¥˜çîËþÓJ.r¹öP…xSæÏ,Ç÷.R ¡kñ{•S°êÍ3¦àXMÁÆA´ß5Cž…‚"ÛäŒ3@¹ a©²(Åu q_MÏnU1^£Rè•Ó9;×ýf8Ÿ‚‹ôîùkŠZÚ€H@Μ(ó×ÌóÏÈ߯ÊyK9múxFÒ{ÅÁ«ôð¦‡Üœ ´Ë(FûYãG•ì}•²/T>>‚ûÊl£á"9ôIÉ€¡ÑSpÆ–é¥Z¯{L_WßN>3¬Q¦·üôEø':ã= ¯ÞûáP£N‹5†sÈ>" l³Â&s§#:9lØtMQÉmanRÊz[”w!E¹_,~8" Åz§7R¢u3ÍŠm2WÏãjLh±ÿY@×®ÌöK šêí •~ß}-oкAùÝúšxЍ(¾Ì®Íñ{ï±ÞÏbª¼*kÝ¡‹ù¶ô*EÞ!Qóë®l,_‹˵k‘_¾t´±É6\6ÃSìðivämEÒ xøµVÕÏD=›…Èû‰(®pŽ*Ð2xsÈJðæErYBo¯$¨EwJ¹G0Ç€õY×»ÃéÝöšxÛpLíóçWY²Ï…dœÉÙ8äãõÞÿàïO³e]endstream endobj 174 0 obj 2282 endobj 178 0 obj <> stream xœÅZ[EN|Ü_q^Lfp§éû…D51(ŠÇøk‚ »ì² 1ÆÿnõôLWwOÍ9wÁð°MM_êòÕW=sê÷ gbÃã¿éïéåÑíns~uÄ7çG¿‰ñáfúsz¹ùb à¿B°`ŒÜlÏŽÒJ±qrã¸ßl/vªóΈÐñ<<Ù~;-–LHîâb΂·J‹¤ƒÕN„M–)¯˜ô¸ë—ý ˜µÂ˜î›¸«2Øîó~Ð,HcU÷C/˜Óž»nÛsæ· ü*N•ÞÝ=è© SÞt"©¥­ïX?À‘*(/“Šž2O›Àt¡Ì½^Á"'uw¸_ê’ÝöÂ3„[™Š[ý4’"ºrô ¼‹* Ê2¯èñô¸ßKÆÁ¿®{;Ž<÷Ý›,{˜G2¸íNò¼OûÁÈÀB7d‘ÎÓX#‹#žŸš, yQ7*D£ºO`ÈóBNÇç,¯vã(ˆiCÃeq°È#=éÇEww"ŠÐ3 <½ÙÞ;ÚÞz8E^Š »g1°bÌU÷B1Î1–Š>yɥߧÐh+¨0€>– ;O>Ïæ=Íz¿™e”²R0e¹œ×¿îát+Ó/cð]ôÅÛhƒfÜJ3Ï9×Ýóh ìï…ðÝ Ò´î †Æ3ñÆ}‹ç¸[:‚k¯a&˜¯Æ=¥…¬²¦{÷‘cø.Êc+®ÀJ-í¨$L·Lx?¡BèÎ@¨(©àGXX3«ƒÔWS6ˆîNP†›b×Épe¼˜¬,úÎÙL¹ÉXIûoÜæ<è7²Ü§Rï"Ú$átqè¨3 a‹òt jý:¡µ¦l*Œ?ë¾ûæ—¹è…#ÆäŸP3<$¡ˆˆâ¨© :¨B¥c˜ê"E¹ª`@ðÆLF ^lé¢$ÐZr•»› çEN $!•G'9Yî,éèË,:ÏÓž6ìVl O}CQqtŒtÔ>vÉôÌ[Y0_ż\.vv¶ieñq²Éû°ç”yGã ª¦&žàÄÛYˆ£L”S¢Þ¯²ìmÃQqôu½Ì£×yíeI¼J3ë‚›¹öÐÚ£ åçy·›êežV÷­îQö:²î­‚‘áþ12ð ¥lÿκžæÕ§…ó'—Û¢R~6ã'˜cÅš%"1ˆ*Ëlyâ)Ž8 M9ÆLÀy1†fç ÜÏIxÅF;§® ­[ëêì(ëörD¥‰Îk}¡ÃÒAèŠk5ñ­»EdÆq‰i¨[Pû$ðaÄiˆ¤FfŒ‚ÊZ@`°¢LäQhžÖî¡B`³£,áZKŒP¿ ¼ÐŽNlj㡪*TX®@™i ®ÍTÄ¨Ñ a*ŒŒ4§\WæZ[¡e˜žíG‹Üƒ¶Ý¼S‹ÆÉk”ⵊ (")éèFТvÜŽâZG˜iˆÓÚ§µ™­+ æ¹Zô:TÊ`ï®4(_ëµ6Õkik B¥^Û’ÈÚ•s/çÆ¤Ñ0]–(4P࣮@’ˆ EsŽ˜Pµ©®CxÚÞ ’© ÝŠèÒQ84ÂïN xŠjì­K •ø- × D„u£Á:[Ï´0ìÂnZ øˆª|T0}cÈ8¨s)wèÚà‰f2°ù5ín~º¤˜µ‡Ê„½é (ÊðKN›äQær©ýO•øÝ$KÑuåÓ7šu¦ B»ÿ6I­µÄ¹†0N×O¯9¾„­ß<Þnñ”"I<¥pC]ÑüN:¦^üµ^\(¸P”„† (­[öªÏ¥nSªÖê\=æQ.Q‡ƒoí»+šW“MK¦õ *káLêþ_Êòd‹´Å`-›¡WK›õû ¤@ì‡,B1ÐÞ;ÈÚÅƒŠ¯|÷øbÜZ{ê´oJdsïð;ýC•L¹’o›VõMfw¤[Y½–ª0>%±öÝî˜úÐ æ5òøPòÇWÌ6gëØï.òè;ÛÈj?íþ~¥‘ü÷¼iúÞIÕ{ê‚I½;R—Äö–]—¶¾›]ë®°ç›Ö7{øá:o(í»JÍÿÔÇ-Š )AÞ¦PE½ ´ÚÒÚÁøøËŠºÞ7 ŠÁ(´àZêË¥{i¨ÏÅב’µ–¸Ñyú÷V–­pÐxmù jI/kdCýèܾùÕå|(ˆ¾HQoSÔg1jÞ!ßòê{-Þ>ËÏKHyzï©}ŸSÿ'Tµ~ªeÔGiŠbZYòTé¡~ðqy­¼!TQ¸§¾ŒPŸæ¨ÏHT^½rÈ…uKTQúg–Q탊6ý,›:¦.Åxl<È?Õ QuN ±uÈJïòÿŠÃ ìÉH#Ëu÷ª´’ugi‘²e;EÙš1þاúe‡u»bÿrÙU' ó²‚m1#· U«b+à­hê©Òfα¿¢¦Žæ1^&Y,¸úO°Ã{ ¾…©ó²¬Ç3XĘªeŸWlYR°<:ÍÓʵÏÓœ‚B‡)ÍôŒ¹^¢¥oêr*šâšð‚g€@'å³ÁÕ cÒƒÎJLÂX¿gMC±¾Õ4E”èô€ó¬7ön¾,B9;fÏ+TtÛ (ÒBrâElmåPÆÍˆ ¦!‚,oZÄ”wð³\º&‚Œmj;«°jêµ*Ttíà?cR¡Í™oIØN„Í9¯òhK<ÅÑE~z5Ë(wÏtl…åxqL–NQÖŽ0±[X59«Ù|Õ“HÔÊ„'ºÁÁ³mZ·lrL<ñ»ƒïìtîjCtÇëŒ<¤ÅNä“_ó<|1ÂË'ödÕ­x±wNùîç,|‘—> stream xœ½ÉŽ]Å•dÙ›¬³‰Þòuâw]ó€”"£VˆbXÀ ÂØ&Ä_’ßÍ95žS·êu·ãDHôõ}5œ:óT÷ǃØäAàåïWO/îê×//ÄáúâÇ ™~<”?_==¼”9(³ùàåáêñEž)^œ³› ‡«§Žï]žb ›Wîxuy’›1Øã·—ð$¬4Ço.OÊŠMGs|~y›7Ò¹p|¼öø]šdŒ5Çëü»rV·×Ÿ¥µŒ³Ç/áI[¥ÍñIþÙ ýÅÕŸTÇ@àh¯¾ÿH¶%Ïe";£6› BÖ™ì›ÔFG²uç§5`w[_úMIkpý“ÂÍÜá‘N¨¼Í{¸‹Fêã†ðEí½•G™1ëœ9>ÀUµñ ·‡ÁFà^¯ð­ Fx@gðοîcê_¥SIéT]Ak—žË Q²[>pˆ”[´VtÁß?_\ýö+•:‹‡Þ8¡‘üZè-J•8aó1züç¥Ú¢1{uH6¤ /,g… †yui¶ ç.v>ÂéŸ_Â0Z!¼ZÈMEM^>Æ—qCü¾„ ð£,( ™XC@ÞvUô›†É[èË“À~€Í$nâ*Œy쳌mƒLÇD†“k\B#_À“Õ.†%l/ñD t–ïñáŽi§GÐèÆ•Ê“ =ªàW Wih2mˆAÀ6~ŠÿÐB õÅ Ž)4ÈHZÁ U³L‹&ª›hœÎKÂi¤Uu/P,º'Av{xi‰xº›è#§ldÞŒsuCžQ® BG‚#sÈB_§å£pºBc½‹~dμ‘y]ÇBlÀ^ˆƒSA ôƒÉˆHø2±ñ2of@ <Á'¬¥\S¦˜°" “ #Që:2«3.¥!A&Ä.}wɦ õ°,eÜ ‡ ~àä”ñ»|ÀACKP:òy}±&*}׸È3“œ”îü:*æ4Brˆ3k+°Z}(o¯a³ŽùÂk#c…2gâ@>•B_ñÄ(Ù€xN‚£Aû6Á…4ÂPKιÇNŠìã½Zªį5šˆf‡ù ¥Jfi›„ᘼvCåŒø¡“ÛvY@òaQ@€›Ï\õ ¨y½à2Ð *øM‚ ýÇe2§ÚP™!h߀ñè¾ïÚèZ}‡Ÿa©€û†je4@ðý§´#‚ð ,Ò_“¿/A‹ù~ÎØ¿H s¼‡‹*àO &üñ AuÀ r­¦ÁîÁ²–NëÄßüî,Wþ*FPá̪…‡öKغ*é\E• êÉB…Ö#Ľ] è )ÆÇ}CÄMt›Ö(±ˆm\ª Ý;\^b¢‡0„ËÍ„YDò9‰ áÌæÉjŠÓ’~a"Èó¨-eéÁ¥S`àQ{îý“¬ý;GC†Hb†b¾åH†ä¾ˆƒd%¯,3]Ewê1/ê5.ìP¨wÖH @™ˆ¨@(aiF……ŸÂÌNÕæ³±ó:•¶qqé€RÛÖqK  c¹úGBYµt“¬l“•_„@/ïØ â5?¨»Ðç(—ÂA´’øÝ7W ®º"Á]㤕,¾>o²ñÜ}“ì,ÁÌ\þ4"KTÆF2: .3j%Ò"=R';N;­£Û;NÔ_C¥68NZ…-¨•À4}Æ7e‰úKFä¾9!ì”or—¹-ø@!BЖ˜®æÈÀ…|0 ðººñšò4å¿âÅéõß-D§ÛR&\$¦!¼Mv/¦™»ŸðyTÒÁÔAŽo"`¸åvzhA›IW ~³`¦¿S:sïî õÃV6÷6n[Û¦‹š¯€\O­WµÃJñãåi²ŠXÁ—±¹×…+Z‡ÛW˜­Œé­·Ú/MjU+7š{e5_*˜j`‘.¿MAñeŒSb¡Ïóü2G–¢ÂL {¥ì\ˆÈ)¨ÀU7rowÊNJƒuBd¹vÀÊU5¬ƒ¡”–Ó˜fk©—£Í4ÒÁÈ "çHD:ø¾ÇÐߊ|ø •5FŠ®6¿ãÈ®â1MØl²É5Ò-jdër@"“iDßG¢`=°ŠÞ9mNyKqÅ„¨Uj§ª4•ThdÕ¢lý¦[êo5ëj™DýZÃè½oY]Ÿú{çL¢ëQy)ìDß’¥¨…¥ÀÜŒƒÂ¬´`¶¹·ƒ;ÿlŠieä1Aèîø_+ùŠÆÁ¡L§3qÅǘ³ 1Ýac,™¡åîvBŽ‹çÂæ Û ®E„˜ÇË¡ãôqfw'0mRù}C°h! !¦ÌóÒ2v–¤N—Ú ¸^ÇåÅý°JxKŒÅ©ºy™ç Ô$>Óœ˜Ù"š½h¿è‚³ŠÏ€&˜Ñ`< ´`¦:=HHo6Ö&ãmG-˜÷PpÏ’Ã-§é}Rè_â£N;e˜zP&™u 1K„!Ro@üT¦ÑÔàNÄâ”Ú¼~l¹‚’ 9[ %;Z9Š×›Œée?ŒbÖ8ΰNÒî¬ Œœ®§øü2ÓÍ ¹ Y:!êEôÓø,òÍ(‰!)§äy®ÎaÌT‘¡rR¨$|\º:»„­¤ !3’|ž½34ŠA)=x©÷±4&Ø”9#¬)•¤oRòg $Ê¥üµŠh›°ÊÇg9©â`õ‘5ýfÝMn;H ²oŒå®4€gÖ™ð§§:%³/û¶zçó’þlîV| Œ‹5·™uÃ4̵µ3&_çE¥ ʰh±7{W–Åmùƒ`äc­BqL„QTJTôz ÀŸìè™F¬xý¿¨y(@¿)’,þŸ¬Œ;î,FûŸÎæk¶â.â½Ê®"×)`b|Ó~/!ì óÀ3‰eÙëiujQ´© _»ôt$;è‹’ÍÒ¤ö¿‹&²Âæ:ÔP’ÙinåÅÑr—¨"£ƒ¦= ëg©Ç@€³>³äI¬ Ë8û<Ë”¢œeæ‹3vˆ?F¤h X8˜b•&bRCP"Àäu†‚Xäað¸wŒz+a<£S‘_ô”‚8²¦Àwæ[gbav† —ªÚ…×õAüT ¦K´`Cf3- ©c¥ ;÷2| Øg«•vá Öß½¯Þ˜Œ›k’…… þmŒû"OæÇE²L+«P©'Í<à8ç˜æ•I`æ˜*ƒýJn}?‘¢±D™qÂMÔQ p [{KÊg+¾Ï<14€ÔÒ…·ÄKcB —06¦Ôð¿1‹n6;Ñ+Mê%Ö 'fƒ8U[J<ë™?‘òý€‰›­Oé&ºµº—˜Y¶ŒÕõ‘×8. 8f>ÏãjM_e•$h2ûÔ¦RWoæÔQż°gŒvbÔ±íý´W¦/œÓŠÁïê?ÖÚ¸wˆ§‰Ý‰ÄnÖáaY¨AqâïÔ.’dHKýZžXKK¢¹YY¨ÛÔ3°¨`vk®_™}J[{ FO´0š ì ç^Ö/ÁJ¶JʺÁ{Ñe_'õÌʯóºÞLUÄÐŽµúDZÐ~ëž±D‰À´i©sQíï8¹w&) `{dCÛDή¬MÑË0|×åTÚXr¥1ÞØR6&í‹!¨ý¾ŒdžãV¢OW2ÂÂõdœDs6úq -ÜìÐ¢É ¨¹›‘ˆQç‰U'æmâžäB²…2çÀŸJ&%J}K¡Ñ%6èž!Ê€ƒà×-+Õ”ãK ®9‰OJL@H8Ž&å«®Áº’˜7Lƒ‹RNûºZ‹Ó.«\ëývó­r‚‡u ¢½²i$%q+G ±¯(s³JLÒk^ÒÐñVmÞÖTë¤Û<8e¡O:ö<ôáÎFén¡°Ý"-½ÈïR³J%ÓÖ2‚÷¢ˆ`îú.1{qs*é^ö2½TûÈ¥´·ÌuçÊ\ÓϪFb;ï[›qY g{&Uz]VÏ1_íÅaGftºY•wK]7‘™þcÝe’­’üEÞÀ|¦GôŒá†:AäÖèX*T;9X„^ψu¹.[ƒ€Mnõ{šì/·ž;]˜¯yhVLYÆåÍ7;‰°¶V¦ü4 MâÚðÛZçR+K6ö±ËdÏDKZHA1;;ÔͰwFM$X‡õ¼¢˜7»©Çf‘cfJžªþtˆ±pý/Ø®ÓhWšR¡Â­lÏÏ8B¤7^²èܶïV.*#çò"Ÿ;‡cà ¦õ 6^Ä]hå²Ç=S!{VJØÊ­mP!á,¿9ŸÚÏI)ª77áÈGœ†Kç2B‘f µ«S[ƒg\zYÀW’!æiC¦±»— ò@bêU¨|õäVéêm£Ï.ƒÃàPõf8Sœƒ‡&Ùt˜WØøîRë\7FmqKýö¹|­£%cæ[ಮ³Ž(3¼±n¯o(WÑþºI”_ou€U|Û)x„O„Uc8÷Ïo.,É¢ßrÑÀÊįÜiXyx=BK³u$N.ª•˜V½<]#ü€Ëc7,1¦76‘÷Æ4Ä8ñÎývwÁhò·ß™ˆƒ—[}ãNÛ¯¥[´O¼ÞÈ$Áúæ oðE'ÂXÞ7(ÕªrfÖJ²ºÛÄtDæ|ãlÛÁF£ *½V¾gòšåÂ@ÄÊ¥ŠCø‡EÇÝclg/—–y÷n¿3®ÌJò¸±.ǸE£R½ôÂR ûRòªrµÈ´ïB²ì(¶cHº mžr¤¹þr¯åQØoÕå«VÖØ\?ŠÀ>¤f*Æò)Nß7çMJÍ‹æ<&;­/Q-ÒEcZ€[Èå vM5É@M@.Â6»ÁÔÍïÔ™[.L””ö%Ý7Ý4§ÞNðQüt¦…:“ùn—ewÙÃe÷žÝ†¾¯ƒ¥™sæ¯Ã³]>hÐ*VG p¿Î:„¯É™â]`tÄY7ƒ«w9«ÞÿTkzdÃlûJÃ2¿jyÙ¥mx äŽû:WX|Ã7¿2|^Ò6Á»j[­´¹—yoÏi;m\›o5£=»Œ™èç>—K݆\™™véj™‰¨‚ÎLg.‰—Fsʨ{&JceÎ^%«KÅ,ÌÛ§ E Ùõ T‡šßJ£x!ʾµgŽ œƒ…ÝŒ9@H†Í¢1oô·¦Ì‡-:§ÎÁä'ü\²…iŽÀÓKç‹ ÀòýZ¯òˆ¨lÆïÁCƒHUä› £¨(À x€°±tBº± §|xuñðâǰuú<Æ 8¡ðžæA4~mãý÷||xõâ§o.îv÷?Âÿ½ÿÉàσï\|øàðpù%†¯ú!Øfsøy ‡®ÞÓÜí¶ÐŠX>>a "@*áqžÀû `„ów@œñ˜Àªï€ 6íèb¿N¨234 ÀЀá”pRïòD5P~ÅdLt™ SÄ„O¡óß‘u`Ñ'¬áaqŒúN.ý5-eM(€S`€yü^ÅÃ$wUÉ[d˜lb8ï‘vdÊÃÖkAÉl£ tv^ctþöèÌ9¶á;{Ç{ Ž??‚º ³×¿;PfW1;ÉHȈ·î<àIÀQÈS¢Åé`áÅy\þĦ¼3HgY•£÷ÑÓ rL|Í¡ I$uMÈs"_©ÁU@÷tùÅ_¼ã‡î< ‘>¯Q*-;ÀˆÒn*ë±2øw7`ÆküIÓ¾³…+æE; ƒ˜£ÑDÝ…°`¹ø¿$¬Ý{†¸HÑQ} •IVGŠ2<Œ§Ê»vÓàYñG´ ¶îÊíDîPôUé)Á ‚´c‘x‚:ÊY¶ýSÏÍWá ÐãýFÐÛuÞ¦þÿح˱´!]cËOcu|Ä[bNÉ–c¤ }Ìù*ͽgç:¹ñÞ,Ï©0.ݶû¸N$M¹£q%T2w¢ð¬> stream xœ½\I“\žëâ¿07w;4W{ÕQ„ÁKà ËGŒ<’f$$@ȿޙµfÖò¦¡ƒz^׫ÊÊÊåË¥úÛ«}W;þËÿuûàƒOÝÕÓ×ö«§¾} â—Wù¿¯n¯>| àO!¶`Œ¼z|ó ½)®œ¼r»¿z|û೓:_‹Í;#ÂIÖ_<þc~YnBî_Þ·à­Ò"Ñ`µáª>“^m0cõÑùZoA«N=‹Í™]òé#\IzkôéÏçkXCãN¿…ï…Øƒ<ý_—NQÿ‚ïµÝ´¤snð1ÈÍYqz|Þ7'¤ÛÍé÷8«2X\@¹I©O9iˆ<}Š¡D]@ súL ´Û•¦O YdÝO*݉C~Æ]m<Œi¼øÊ)õÓ;óW;½Ù6åŸÎrÓÀJF!ùíéõJÍÈ÷aÓWÖ'mZìW± ¯Áw~Ç—?Áä8ž¯a#NÛ]þƒç¡6§üé5Ò. <|Žvo]€üxÖðÙ)uºF1±RÙÓËH°.œ^ ëœÝuyËy!ü鎬ñ®a7áåé¦Nñ=Òcví5û¡tÐÞÒ›ß÷6q"'­§B(¯)ãÊÝŽ'¨"¯evÂÞ¯™öŸAî>OavIÖ¨|pŒ=mè ×à}»¹œ;ýä†}÷†>|uv0íé!Îψ,Eçÿ2¡¶¾qÉ/Æ_¥Ú¬4yYØ*ðàIÓÝÈ\à¢Í 5â¬@ ì…T;@`¨´ ^Ê.ßàª!*l"Kì¶e¬Ô”‚$AZ vd¯w‰/ §ŸóÁÅw4l @¶2?ï:覭dåÇÒêÓ7t»o«ÒS~ Ô(©‹²Ìhγgƒ+o€‚·g!4H­*b”—QqÊk)6ewÉÔP„ál•=ÖÙì>ü["6\°Iå > ›–/…&M,ˆÐ´÷“ þþR‘‰Œ¿†yµÙ|8>W~ó:qyݦ`0±==xƨO>¯ø¬DpC6d£ò(¥ÀN›¹B°có‘cmòÇĤòM®¬ {2 ^É@W•6í´!V¯)[ùZùÕo“TjT.™r¦ñ¥ö=!å9eDcñÀ”[εÂmýù)î9Bñ#¸¨Vã [º7êUR¥ÏÏe‘¤?yó×Âïk Ð!P-¸Å)dÈlç¹cft‹ŒNl"N}—´×:p1àè׋W÷¾‰ IÓ„ W°ˆQ60©ÈûóÂHz¬x&ve‚v`–ŒGG7€xtì˜P‡…‡cPl !¨ŽLøšt×}šÎÀg*‰%AGztØÌîSo¢Yq‰CjßÑ®’¹¿K*„¶G b[-‹{EÜAçÝÀˆo0ó\z“EV´• JŠIÑî`þlgnª~µ÷‰}N&nw"ã°ª#iw¨"óÄMÍ·vXõM”7Ò¾7€–u§¾H,J¢S c{sˆ&@«Î~S…<Ênæ˜d0Ji®f‰±crÖ9¸2Kæš®¦(Ã¥äÍDp„TI¬>s |:·‹CŸZžˆ¸³dW¢s`€«o2ò Û^ÁõQÅ–|]M;Ú’Nפ¨Qû½ÂQgˆäŽ%YxB=ÅŒ'¼—‹‚ó5Zèk+?ÂŒFõK“ÅÍ—Ò$¶9—ö)›¢à’φ׬³4è1:±k;·N£³/‚-“ÁÅéÈ1Œn½ Ýж›[t ÔŽ Åå£5XaJC“Xª$…píÉ&ŒßâÇ=¨Ä诖C3‚¡ùÞÉ‹ÿèlÈT˜œw:/ jQΫÆ™tPÜ6E+.щdO—‘YäCô:.¸ÄŠÃšRµ¼B q-Mó %IF¤sNVÅ++¸N¤jðõɃǿ9 ¿$Äì^TË‘œ$!¨c=ÿ²›×'J@zV!=sœ¯‘¿Yµ2ä)Ë6@Ô¶ÌË!KÓ‰¹Å§r•0¦²?šr“p'’ÞcFïðÁ-­Æè™ÓÂ5P?¢ ¸9§aÜéé|.æ³ãXµCzD¹4¨k«>_È ’ ˜Ôäž39FðïEÙÙÕ³ÇÙ5 ’¶‘ƒtžª[Þ`û›„cb°1 ŽkØX¶ˆç]9' .eë6~⺘KôŽ­ËeÜ=–÷¦¦æ¢[9Ö€ù¶QE&Z8Ê'%lˆhÜûÄœÛÌ'댛{J²Øó¥  îF1B,RaólÞÂû¿Mùsâylš‚ãu@?vAòƒ<Ÿ†ÿë BN²±\n,x¿Ì¦˜Ë‚á-ªCÜÒÇŒ)º–0uÓìMR¯¯Gq™(ZKÁ"û‚n¹É‹™•¤CIþžÐœòâ^™¶tŽÇâÎ ¾ÌXÑç´’× írbÚ¢ËááHШK1ÓêŽ0¤Å_s¡'ú·ò,ë]– ¾¬éw3Ö‚ïûükxkÛÍL“ñ´"û!8î ‹GüµCùF/’…iÒÞ—>\'óÊj”U…øMá!#¿Ú°gÈ5³Ùv–n#FpwÖX•í‰PtÇj°3ŒÙgÿºÁ[«èÓ³’CèÂÁX³Ó6´ò+d‰$í‰Vî$–‰ £ šŠ¶M½Ö!8ñ) ¬bå¼k–ˆX6œlƒ "Z´HLTA%ŠØ§A¢OG°ôÓ³º0mj¸ëR‡‰Ô‚s0› Ûz”±•ÄÊt–rÀ©Æ€À•ròn[RR”t2Æ®€T˜Ý_²Uh5 ,Ç Çê¸s/;„'Á}ï‰ÇÌäŒÅ"·x¼µ¬è¤tEÓ±Ë*:E7&‚½Ô«4ÇÒ.&añ«'"(éc  9¡Y…a9„Òæ.+¢ 8ZM|ÛlÀºn™Ujª'jc¢YÈ¥vÜ»Æ=ž«9Œ¡€%ÌÛt$rïêªJÒB^ŠÅÊ©ƒ”uÙÔÔäβ]q’€¸›Ê>!‘@Ã{òržÜ›jÆÔË ~+´»˜¡•ZF`l);üÔYÊ¡ÎÊËð±8^;k´¥'=1ËÊN5jdq¢ŒÙ¨‰Bè÷aísHJ péIõ·Öf :™ÉÚC8P³5-U9×P ,°*U"a6Qµd1}ŸQ±CU4]ЀDÈÛC†ç¸^Š-@•#U£!Ü–¦ó}³*ý±PÊ•"ò&‡Ä8IÌsì8bŽýYɽЉ#.Ù±ì_«SåbåÊ8°Q˜—ú’tXøÅ¼bÓ€ÓÄþpdwZ§úTYªeá’œˆZÿC!½MÉØÖŸ1ý4ÓN,ÆØ©GÏGôû™cc/Å¥/®œáj¤ö –÷RH¸òCNxk‹Ú˜„aEߨ”˜bC„÷í‹RÕÛ©i­¶V‡ô….ïž8«,¢†&£B =,¸²u1H5â _”ƒ“zõå`gQ±rpÍhZd:p:Ó¶I.UyÌAÙyOjq/¶ñ,–£LØŒ[fž¤šµµnQS=¨´…Җ³cµv±v›Yeý çTrY@]Ñž_€eQµ|Ç3b®fèAÝ$cßwñ’[ÝðÃ\@Pó¾­¤Ù¼®8‰ºîHhX)É^ yµì’ Yˆt€N³‡¥´…ùV‚ Ø]¨¥ZQå>ÐIQQ‹Éø W’b¶×̉hFìªKÓîÙ°û³¯Ru(­ÛÕ‘1OU­‹nœ•|“©Ü}ð©ÔWx\Âhìg†íƒE¥’÷çµA‹¦àpPØ*R:«OÆ´­µR¢t¡]ˆ¡0øS¯Rå1ž‰IXÐoJÅhèÙeŠAó÷¯Sx¨[)lÛ¬IÖqViãùà`AÑ–§y€Žñ“‡*Ý¥´‹–ôáMæs›ßzÆè’Úl>µMjaåS¸Ì@ž¾ÊûÕš 4/SBYC7L|ß(7Œï–" …§R̺וÞî+Ú²h­X ÞCø-"Í}ÌjBI­°NoE4[ƒåK#xB?&z‡'‹}½‚hSg.K ¾„‹6YbZßàZ{7ëM1ßPÍi@ÖsKûê 8Îx?é/g1!ù6Z(|¨¥†;¾3=¤­*aH`dñ÷¤®½µ‘Ò`ÜK䜌M>ï=:Ð WiöE¯,’q#F¦´cR ŠcõâÂúë¹µa]ý Y½ŒÞšn4Ÿ6”æÓÐù]ÝF¢ª çCëäOŸU˜Ôô$]62Úœþ‰39˜Ìghäîíãñ}{Ý46Êq”]Á­ó¶-¦e“Ó;3,_Ú®ø¦bÉ*Á8$W2_†ç}¢¬ ±’õû¥Ö3­&Ø‚Éþ`v’¨ò„² ÒŽ‘Ovd/SòJÉe<…ti8%K__CxÁ•€ÝέëˆNP‡\©Ç œLÍŒbÙ¨36ÀðFs€ˆº¶Â I÷z‹ÂS2‚µVðø!·ŒòæR’ k‡ö&ÅÚyO9-GiP£Ú69$¯yãDjÛ™J“loLPS–ñÕÓ¼SÛ•dêF·¤ÆšëßÏ¥À=¸(æìyÞ~Ó\ÃEI Üœ„Íu"€ñ›¹4›6@ܪ°º¶Åó0F^f‹wÙÒñq¸Ö•d÷²ð96M2ƒhC_$¨¬¾¬ql¢ù³ïvÙˆJcmK‰A`æ`î)¿h½tå¾.BfúX`lÖI[pG×jÓãý …I 6Î@¤ à¹%ßDM†¾)3ÍP´ `‚¿¿û1ÝqpËîÇy· ±~«n.0î±Wè§ G¹2ØLÄyZjšÊÓèÉàMïÕP;ÅVÆ;j‹†­%È.¥  ª=ÝÍ—i7ï»-ˆ  uizžºžÞ÷|V¸×Á¤tui}3U ¨ÑxéìÿÕLnÙË8š‡TQ)×sˆ!žOÕÌ´ÅeÙ‚¡jfS¸æßG+ÖÉ;a÷g»J<½Æ0òE÷ÇÂ>#€Å›àÙêêÛešèì¤[šhìÆO;OÚZcÌVÐ’]×A€[“‹¯Š†ÊX\¹˜c|‰$€÷ÕGþÛbR œ¤_+œzóÙ Îyz¹à‰w$|MáõÞ…–…5õ?VHO»#xbšmœCÝE’å°llw=oBÌ–B˜þ "!/¼^S® ^p zrK¾ï7é®n©EkèA% ›«û{mõ¶©¼÷rswWD¢í;¬d` +Ä}©Û mð{ŦYýWµuÞˆ06ϯÓÏñªŸžÝÕ¹'=’xÆ{-S…»#>b°0±ÁGÑ!lÁ›3°Ø£ j±j_]Ûl&¿ÁMüq³ï¡Ã\M&›}ëŽÓÚ¬n4/rï(¨Æo$k(¸¡’Ík ô,!… è =¸µ\ÃÒ=â q®z—*OÏ:ð¿°§…ëk³5!i-ã _µjÖ²ÆJÉ™ßnƒàxÝì—"j¶8˜¾/d¦°µ\[nW͈RL:7rp˜8spÕ8ûéÕå€öbi$ªDÿ)êÐ,êðäÒÌÇgì[DØ?!ÌôÇjÀ¾«Pã%YÓ+)³>™¨`{ƒXäÛ<Â¥Ò6²ïž!5mÁ5˜–òn3Àg¢Ię̈U8dQg,¶,Z‡ˆyÞžÕèš;àKº²(°ŽeFž’ã®I÷ÉùtgNÏïíSùNcõ­ªª3!ƒ0˜$lžT1»™|ú&~2•g¢|šVŸ0‰°K"Ž,)À)Á†¹Ð€à)+ÍR<× ê]Þ\£§%>k´<=¢Eã‰í³~yæpzn*yÁÂ'6ª¿¹ŒÂîàÚω nY›Iºxn8"6°ËòG‰3ÁÒEu~zÅ•{·fþæbðQ+ë½ÅÉ Ú)±/ÒCiZ¡ËPL[pÐÍ 0ê»] ðõ´98gÂjýü«‚í Qü}@"Wˆr.å‚BJŒAµŸJÀ®”r¯Mð f|\g>Õh1sPâ(³¸jNK+¥ÓÎò °hÀôFÐpŸ'íoU]ìnb–;•lLkë~h§üÒ¥øSzyÑ`S.¼J}¡6e.‘?ûW¯J¸eG á\ý!…÷TÏÅNQÅÔ~b·­Ìç̆è9ºßõ` ÒÙÂдßròÎÓD0} +¥…RKdl–¹7ˆmt+?#yx'0wÐ^áÒþ”ŸØ™7j/{ÎJ`ϳ7ôºô&WˆÒo2˜ƒ”ÍGü þýÇ×4endstream endobj 189 0 obj 4883 endobj 193 0 obj <> stream xœÍ\I³¹qvØ7^>úÖ7w;ôJ…ðr°d9lÇ„—틤ƒDÎp(q±È‘gÈ_ïL,•™( ºßÓãÐ1öÔC¡ÈÌ/Wà÷§uQ§ÿ«ÿ>{ýäÇ_†Ó‹÷OÖÓ‹'¿¢òOõŸg¯O?y à•^”^Ãéé×OÖ%Eo¬*ÓxT:mÏ‚>…5žž¾~ò‹ó?\îì’´õê¼\î`ˆ ÆžõåN-18•ð©sfY•9ÿŸjxÎ_âkN¥Ïÿ‚?upZFþér§_’;ÿãE-J©dùŸ~)mJæüÓËY¼×ÃI-ðð~p«Rç§—u Jùhùßÿ§¢Õùßà›Ö°H„ ð!SßÕauçF2”ÒÉ#EÚ®™"·Á•"ãRÛüùE!Þ;Ûž:odmÝbaZ6€((¿œu° ™\[§Z#ù_4)£•­Wd¿í3~j#ûWOÿµJ‚]w¥ È:‰ã¦ðÖúÈ~âÛwÖ†Ó0-šcŸÃØo/v‰ëºÚó7( †®æü¤˜ìù=¥"¬ßŸŸ]ôbl²ñüë2­ñþü _[cˆJE6"ÏàV œ¬#|Hkho"môé¯pá>ÎÏñs†§ów0E„À&¾ä)ï) HÖZ-+Ì;^N¬ÕÚß]Êw~ š‚I©-ÓGhRñ­7e2ã¢*T˜¨ '¬ä„ ¨ÝZ¶õë ®!Àtôëûí×óüË­ú¼¶g#æ’”Úœ?*«‚å ÎkK«­¬r+_ìk©STNŸÿ'‹—M!Iþ1F|ŒðK0yÒ„QlŽxµ|È^à/€ ÆìwðПŽx¹-äuY)¨£]ð)4nà˜! Œ° )åηg¯¶g/·gº=2 Î¯ƒ4u‚áÆp°xÅ©}…;Áó ØñìÀ1/xC#êr•3)k¯‰˜vºSðlZ!ä7—鑼̂"VuæûÝÆTꚊ ³DÀé‘:dÝÚDLˆÓûçd :žÇóÿ i…í’Š´M³™83éÅj?QÐ,6$x‚m1:Îuû`1˜´ùuþ^ƒÕ?U#TÚ€R*žy˜¤ {þôË€"ß”÷Ðn1‰¯Ð޼Å+0×ÑYðŠÑùæ‚¢d4šÄ YØH” @2—¬˜"Û¾ê¡|sÎÐT¨ð°3 —lY|( @R"©óìý"_ éÍEK›pÆfÝ^*ÊS—ŒÚc˲IG¸\•}Œ%±B'‰ Á.@áìÍŽ™‚¯ò€&¶Zë¿Dg8õ‘W˜¢Å‹½0k ¦PØÕÞ‚—Làè/U¾Ê,Yñ—Üt—ýt0×Ë1ð# a›S!2å«Êh.y\I„&ÀE>' ›‰éÀ´ÉîD@G Ü<`“¶† âQL)n2à“ejbÂ䇵lÓvö Zùóê˜ÆÀ>ŠlÑÐXaØ„áMNÙ0„yYõ\-YþÈÙ É&n8¡3c Èš7¾Øšd¢`1‹}Ÿý½JVúš¿3`”vî]1Ðٌ௸¢hÏ^µ_#íÑañmñ{¼*³¤H›BHãùFÀÛÍkøÃöì7Û¯WÛ_añ" víÏïØŸÛ³gÛ/rHޞчßùŽjU‹,AÕFŒM8‹F¨Ù´mü2Â|zwb­÷ÎJ¯B¢fÔV¨NñŽÀ&x_y95z€ó:Â1ò7PúÝÈC}!4«Bá¶b½ Ðn0kD¯s±Ï‡j¦!¶!ˆð90˜/÷&ß®Ša’è€DÐâÄ×ø0e$šLõ}šh¹_8õžŸLûÔ}$¼æQ£+Fñßiøñ—ÆGK~Q’t)¢ñç›Å*üi3‹Â‡rÅcAùŽÛyÈ&2<"¶à{]Ú ÒH./²WÅn¢û6)4Íø'ˆBû™/)þ‡ :PX[Ó§â<úÍ8§{߯L+üäêsÌ\¿¦cpñØzΨPlx µ °]9pY ³”k#à ‡oçÙ)­\±ˆŒÅiÛ^~‹{î4>Qªg'"X@v«ÇÍÓû×a³Ô|FAÒ$ÙH°ôÕeáÆh°|G…gÒkÌÏÞ·,êpƒ„e\ž‚˜²œr¶ ž)HŠÛ R(éOtzã>³òx!mÏ.GÙ»2v"Ißá0û;™Ë£`Yi–Ë6¢C.®BldƯjkóE;^ÐR¬¿ØÖJ3P!ø¿ñ­ËrQ¹^ÉNõ«íýÛ¡Ü~›ûãßd¬ˆ1¸é–æ¦ÆàZ¤zEv-µ ÎÔ›##3²cj;h·øÐTyBü?‚J!:÷(C€XãO0Ïâ|©&ürcMɨ£2|mÑâ=R{æKKk·ƒXÕÌ:ƒžh–ø@߀šT˜CÀ‚è]–³Ø Æ:°ëΠªø Õäe—a÷åÃÉϲ>ƒÜ¢—Ærç`w~Ì3H¯LÞŽ©î:ÊúAÙOüFÙDѵð_)>±á Óô†—vš–VQ}˜ïç œ.2ò0ñC­¦@Ð6ÓÝ5»H†›å¶3–WKúÊu‰d(fiÛ ’ìýZÕ‡B£˜·VCËRf½COyèe«²ÛëQl—N¿Çú(Íreçiˆs`:«C5ó«é;ãµ™-‹êWŽ+ôQæd4ĦF«bYN¦íKÊ4¦åö'.‚{!Á¾FÌ-*¿˜d'Õ†eûH+ Ó¢ά9ÿ^^'[Ž}¶õMµNOí’l¹³y%ñ m…hôY0p€”CêQ¯®ÇI“l)&ìèm c¡Ó24ð|§ KÍÈeî7¾ÅG`°2!¾¿z}­]!ÐM“mÌ©é­-H1*÷¼öØŽ&šA3×¾ƒB4Y´çYͺ‡l <›¤\¡ù®©eÑŠ¼Jiәȳv¦ŠÜÎIµQ™â°³®›0 c÷I»Pñ1"69ÏBOT”UçîCÖ¼Þ×+ øòÚî‰ÿIfv%1aLX(7Êú \6àÆÕ_U‚íí™ÛMrÁ¾9«ÀNuË~”1nþYayb†º¸9mB6rGÞ» ®[á\×ûÍx®‰‘Øw’ôè–Ý]ðÜÌŠ!˜ãFŒ¹áCß¼nD2½•mÈ´õTÔL>š¡‘q]ñyoØ×¬µ°‘æ” 4á–dnûè›÷w¹FiÉ€/͵’ÒH䥌äZ¦žKæúì£D°è+¬jMþE+´¶àoz0&Ëf Š˜Yyki xÓ.™®=W§;µ ôÀà Õ¬äšñx‘É~ûøoô¬ò:˜c5l%Kñ[ø¥LäéØoÓ.D‡]-H.—ðïÅŘLË(éÜ^®¡4ó±‹aB‘ˆ1-öMºi2‚kÔ nï àêñ¤ÒAkN !sC÷nË(#Øè€uñ¨=7‘ܾ6«A.æ–%’¡sßÃÁŸpëTk÷xTìäû~à¸e’‘¼«Û ý®y0oVØ¥?G™£¼8£Žò0 v!¦Ïê`Í›ÔDɨ£Ñ—“ ¾o¯FgASËODHÁÏÓe0«»sEñoªãf²`yí44™ä[ñLÐÆEëe$mV,P7wÓ(ôgÉÁí Eñé§>sz/k×rÿ£^;Ê™A©û¢:h°¤SK[‡Ÿž:NÇm¿}H²¥Né@RÎ8zþ´Š2¿vk(ûJe_›zä~¥­Å÷Þ‡ˆ°’éúQÉr¯hEÜ¡ÃZ@;o(Ò=TOJÔž»¿e{ þÞjRŽ4uù¦Üº<·!¯Æ3Ï«y<ý^Þ"›ö £‡ŒŠ¹_ç»BäUÂ>8ËܪòËj"Çu±÷Õxšz¼ Ô©?Ï#š=[å©ôI%Æè À̈ӭoËàè§ÕŸ‰"‘ǤIÁF½5ú@°a§]rØg)0ÕëχN#þ›kn¸m`6­ì «A=x–>*“ôULi¯>g¯ž*þ̪RVj<ç´›¤p:¦ÒEZ”­î”táX¾ŒÌ!?S6rä±P¯ ž"Ÿð$½8°Çý¹íãM6Õ rYŠC´:?èÞg<[ÇM4{åμ3ÒGT8nrþÚVú4Oz;j@~ƒbÆæC+@Û{Dp×Û7ªÙB,&½k[ï†Usº÷p®ªTx×õ%˜¬=ò(-òe~®pÜôÐmÄÆÅçݶ¬hQ]·LŸÍå-ŸÄe\b»Æ†\4³³©tÚ싞Y¾K[Hä]!|©+äYî•ÜúML©c±nQf9ÙŨ”ª]^/VZÏI-*n–Ê:í6°p€‡LÀЉc'™Ý11MþY.báB¸ó,;¼·Áô–Hšû,ù|Ë é€jß­D“dǼ'sÝvMU˜Ü÷JíEìh_“åÃ¥¸só!pu[ÖrOWO U†yÛÈ/δÞ5\ŽŽjD:«A70к_Ëãvù¬Æ{y6szûS·?Íëu/'wIØ=yÏGIÌà™=$Ožl깎xÏ>•6¤Øy½¶û8,ç*íÀÍUqj-‘9\€ªQ¶k~Èí.ê?@´Ù2üø°d¤°óv:ÁFØÅhVELò%xñ²¸>RÂâ<öef°L<ƒ8sGè#£Ýß°°¬y#B ßDÍ¥WǼqÂ(-iѸI<9Ð÷ÕÖ/­©_z»Ú/þ0u»ºšÇ¸´¦Ü2Çomrë¬Ö»Îê±°o_bư44÷öÆQzP${ZC*TŒ}Cƒhäîìß$‹4¾%k—¸®­Í[ºú‹'Oÿú0a±ž…è#Òp CMé·\íɶÓæ×nÁŒš©ó-哾ø4—ÇGË5^!qÓt´¼»épzBñ‘m݈¼y»‹s¼¨Ò,C¹ #mí²¬7˜\ƒ»¾W-ŸÝTìz[„84pÌé°›öÑ’}¥Þ5KÔa2(Ú>Q'î&½m–×ò9"c¾¤ðÈW bÝ$[´«Tàdtø xèBqú°;mNßoqfãü(Ç×iuèÇ{£iÝârno<-»ll€à—Íûwù6¿°¦á}d9AJ‰F…6ÀçB*©ì·ä‡±a¬¨àÓšZ;ºÇBôoTÓ™(ƒèŒòµC 0š³[:©bZ¹öˆ‡éhÞû®]ÑÍÄýÌ`CsØ_ÿ}¶1ÊikFS㈌MéÎDSè8þe¾Ì‡‹Rv1†îò4aPf->[ía¹¹îB€ý!¤a£¼¤ù5„»+>]ïqED<* «)$t¼þÌ®YÌ7¹ÂŒ[áÏ jgúú~ª ­ã“T5mbëýpQœau¸Þ -ÕZ P+vÆ ×ôýö«¿º¥º½dâyq˜=ìB[\*AaibØSøñ¾îoäYÔ¼à‡Y$ fÒÚxÆ8… zËeŸhÿïÎÈb6ÌÄ|¿Ý¼•ËÙøÐ€‡¼‰y¡Þ€ØÞ·}S–g˽Á Êåî”;lŒHÌÉ¢>öSMqœ=`®´z©Ô©Úà?)h®“Xx;a[àõ“")îˆ÷ôoW[°ˆor¶þú&6¤ágOŸü'ü÷Z®‘fendstream endobj 194 0 obj 5231 endobj 198 0 obj <> stream xœÍ\Y¯ÅŽ’7ÿŠûé\â3ô¾DÊ EdCÎ"Æ»°¯¶óëSÕ[U÷tϹV@Šx`ýíZnÞ )ÙÓG¸’ ΚÓ_®Ï°†”ÖŸ>„ߥQþˆÃ•7@Ô¿áwã6£øœFïO€_ÚDêvœÀ¼WÈFea®ºË e8½Äcò:Æ´ß3Ãôò1®‘‘…0)\%Ì:8æF˜É [Mþ¿T1HÛÑýåH„s¢YÓà1HØLê7«\Ola“ãÜ0b¾J2UèÞ9ßÁ°‚V´[=ð£º>ݧó{H:üí5 ”6b3dèÞCö%_83DYâ’RÀQ¡ÕåQo3$°áw 6›sÚÆÊ}iuä<ûö{á‚qU ³,cW£¾…BŒAã¦ÎeWgéa³BæÍ±sËœ´BžsM¡õn˜ÈÒÇI ´¨+L2<Ï ‹µ~¤4ùÃjóìÂX½yíû©»õ¿j„³ÏÙŠ½~¥ßãD´œ@µM¦[êÀ…3+륛 Ó†s:Y)%7í¨OîÜ{ï³jí‘kÃδ€eAOÛé-9™h±D€›ˆW8E€ÝHvJñeÜŒÔk–¦…õ°1áIãgÇD½YíâÀû݉¡\TJÀ´„•ª$ÕyH£ò¬VDtöU4ØR/+ð¼ÙÇ ó ƒ@¿œõhDeÄ£;Ðt°ßä|où’vÎt¢W‚Ëœ* #‡´³½Ê%Ë¥H{p.Á~Â?Vdu»løü)R’!å®#Ù`°Û ½ NŸÎ6*³°Úßý¾=7÷½](Lž+Ú`› ø‚¹8š•T÷*á 'ÙÏŒ¦.ê Ægã`!©sÃt6–Qp„—¼’ÑqsÅ->æ‘\’îS¢ßyŸÁ,yÆŽÑw`s˜„|y‘¨a°ã@ªìÞ-€ß LŽôðhå£ÇÒ̳–ÔuBahN¬G;9bš£¬ÝQ¡€Ì%¼wÊÊäx/¨`–$Àâ{.ÛÐiŠQtgö;«Þ‰1!£÷3K0’“ê@ˆ¡k~& í}á3’†SHÜÊÆÐtÆ‚_pt6^2Û´Œ‘”¨"oÒ“7›q'¯N¿GöïË[Pæ_Ñã[ú€½ý¡Î…”4Ä–ƒœïÛŠ/ÚŠ÷Û»ºŠuií2ß‹öûý6†æùü4ùùËöîÕø!ƧϯÓ#"²»A4>½¢!4ÏÛ6¸Ìæ¤ý›ºùg–ǕɧkL$NŒ ;%jÞ M^Ô`š"(ÁÖ¾|Þž^·§­2<0žÐ‡/*p§´ô{~ާšÍÔŸ)K›ÕI{ÇOŸ³§³Uða@¿W_ÒÓwÃ`¤ì›öîfvXô’NúYüŸÀEZ6ÍÝ~ûé×7ýVÓ»»=#Ò»9#’Î[&¸é|/.#Š9ƒ¥6èm¶@>P‚#gf¦îdf γÓâFÒ¦ñì{zuD*Dh)]tÖ»päZ»-ûôJ+„Ü‚Ÿ-É¿¦ "%€R~'­c6ûmýúíymo&@Ϲ°É¹mã.ÚhððlÊSk̵|ñ,iZ<w†è’D5ÑðC?‡±s&Ý?ÞfvƬé«T¬6~ó¯æÑÍÛüÆ–ìÂZ9%mVaòT˜Ð0 0¦ã3%pºâÞóeYB³œÂc.óð»DLÉ`ífŸL‚sÒøxÈ2L“î$Ü,õð¼WEÀZnÈXb Ú[z}†üœNì_í-‡4¼“”ØNÔæü`nê˜iÐ Èq§]·Y´Ú,z)[út ¬3IaL̈ØWTž_2Œ8VFYWΧTÎáµtôÝ2{íëCíj ¸u d\+YuÂÝÂ͵H§«™ÂdJ°Á áW†3d)8ש;œôϓĦ³ €ò…K9#gåò¦YJáb@S"Œ'&«‡ˆNÝfÆnWRX¨I!/(ÜÍÚ1L1–À`)!w±LENÍâ°‡ð~X%—WáØ"I¸3fCN‚…a$Ó,Ê/¤AØxú9üŒµV7e;¥Ýv… x{‹ÂE–öÀØ6I÷æƒdšL_ï¸Eá(œtŠëÒ(Â$Ó¾“Šn+m®º90Ú“˜·úĪ¡;žeR°ð'ä*“’p§f… œ¬¯ •µèe'(·ÐñÉù.ÔeÔƒ¿Z„͌䔱Éù”í$ÀÄyZ®•{Ç\iæ™erÏ6A!póüÍ“"[G0 µ»P{–®›&z»•wk$˜.¦3ñ™Î®4§B¼Ÿº *á¸qZøññ‘GÅêºà½ŠÐʽøEàIP~ ûP8RÇŽ,Ëé®e£ãäó\~—Æ®’6;ûN¥ 2!yë@#ce{+ñÞ®ôlw ˆ©ßµ ¨¢ÜÌ x¶3>¥Ô°DcÉ?§Œ`ZJ±¦&+ p‘”2B™Ž¯’£‰ÅÖÉi—!ʽ.KM–~èPa{©ôåýõ(|Ž+ºà·eè cÖÊš‹(»pr)ñ5¦ m’Hƒ+(-1‹O±6á›|ÈÒB} J9>Q6F¶§÷ÛÓ×û ÷q mg96Ë,ÜEAbáî ¡\ȱRÒ»›€UQG€íF]O!S˜—W%CwŒH±5Œ(88kzœ±($ ‘¹\‘ ?Öç4Ⱥ–ÂÁ$“ rÎI›r­yˆ gþXk>q@í ²ÕϰꥠµšZã<ƒ•ã!ÄMýTê‘AÌnìÊ‹s¯7ïÂØån< ×££ÈÂ3‡,—ÇõY¡ï„K¬ªo£â;9™d!RwT—àBÄ#önŽB>Æ\¯Ke7K5šˆxÝšþfM Ú·Ø*ËKÇÝ·S[w×$ªÆ¦vÅñ¤áÀI«K •òfY¬Ä a=zbIYR£iªhÞOÄeš`#sA]xUíϯ+–äúT¶(í-bµ¯9xã íPeÖ/D'$ÐØ1*) T~Ÿˆw‚3Wt¾Acƒ>ìå(f“0ñª¯•ÜRí7‹ÁPi™¢A‹`kH¸*¤Ñî4/õxxÛ >¥Q“†ÞÍ1D6 ^„U[ùÎß?¶Ñ¬VØ6‡´[0bÍa*a³c{n ³üÜéÞñàÈA¸ÅÈw. ºM˜Å´ ì´®€æÇ-*êÜ#-Fú:ÙåIsv°ÉåA‹³’‹Ë–Î"WpfSxÃmœ¢cÚ?E(ïÜ¹ÔøÓÖ :Øl×âèF¢{ÞŠJÚ‡ú0¥»jAøÊŸùކãö‰qøÚH³2HÅ"êÚ]#$õF³Ñ”Ñ`£¹f-,ûÂeŸf«=ÆÞ­¸@l/1•\–RPpÖxeÔ#‰ë¥Ë’G]ÿ5.^ »ïa’ éÄ$%2WÌ4ó¤í²ïxšçÞ="Jþ‰•>®wËDÞæFÇûŸ*s%  —ãhØDê Ì…’`":Y ­8ÐåOªš;¾†Ðu¿Y·é²” \n1ÑÖEÇ_ÞÀ:xi륇àQÏÇÏl¬ŠŸ´rN½ ˜Sj倆1ë ƒ.µ“z~ç8…)FϵDeÃT8̘=îÌÒÔãÎb¸/´ð.qÕĂ͚³ :eó1€v[›éÒâJxQê:#ømè—Ì¥ézmªß¹57(VÆÜŸôm#m¡_»Z¢3XÆ[†«±ÒrÇï\4ʳäðμö¹±p…¤û#8êB›Ë ù«\ŠŠ`ÏU½•+œÓ‹[vÙžgÞôðjWÂawV þs Ù‹YòvsôVJB7/𚣼ŗ¡vùuW«MÔ®jµ=¹¥^9TÇÄiw-¯$¡rUÂʽÖXí Ú³*¥PÓåÜvŽíÿ³”’’ûAÏšÄÚd…e¸T¦€¥1ü_$Œ+•F/­5\±ËÐÇç0qdùTïW³SQø×;ŠÂܶ3bÚêÂ=D¹w5kui,´rQú‡Ÿ=„|û¦Ÿ…µÊËíCæjLýûÌc™ Ìç4°•Pø)&§M–³T˜±ØÆÀ¸]ó]tûâÑ$öúB6ŒÏÉ‚§ë¤ê<ÚXιf¤wá}Nš±æAnÆ£ëà’A·q¤éŠ×Å^øÞ‹t7↼Ӭ ×asƒŸ}ÌA7V§±æ=V§ûÎÔåXŠsRhZÿ?lAm;£°Eˆ~Œå=!@¾Ô&S)?¸-é¼:*·w#îfÌ5Tç;3’QRÐvöJüC@,˜Zç]¹›®lwKCÐã/QšÔ‰ÔûlT¶GòPãÂ89¤ô‡Uƒ$—k„5¶üƒ0 þ‰ÿÅa!ÛêÝÖX)²—Žèråá¦Ç.õéåtÊA5p—ï4‘æÈeÖ=b¥œ}–NFÑe}I?Âß‘¹pñƒ5uï(ÝýœTÕÇ4'áXÁE8+í`çÂ ï´ íÁöŠïþžFÁå$U)ïíòG÷îüþû/–±l5endstream endobj 199 0 obj 4659 endobj 203 0 obj <> stream xœÍ[Y“ÅvØoûâ¿03¦U÷Á›ˆ›cmXBB$@Ëú÷þ²ª»+³»zvg%Ù"ØVw™Y_Þ5¿ìÔ wŠþÿÞzqëó¸{ôë…Ú=ºøåB—»ñÏý§»;—€j3h£âîòá…r ÖéºLpQçÝü.š]TiwùôâëýíÃÑ Ù¸ ÷Ãáˆ!6Z··‡£Rô:Ó[ïí ´Ýߣ±&z£÷9±™6>ï¿8à«WÙï/ ­ùªÓRkÅé1aÒíCðƒuÎ`’¢6Qy¾þ_iÑèg;}{ùÑȧ²÷†ø¬Ò;PÚx©w!íýüH³ï^^|vñËÎjëWfbôÓÎ%е ÉêÁ%ø{·î}²{ñü·ï/n}¹Ó·>¤ÿÝùô=ü¹÷þîwwïíh-š_2*‰¥LÒYK8×5¿G¢Í.„„Ó­\?¥ã³Jéìöß5 Ü?:»´ÿh¼Tvÿ˜žU 1«¸Æ>|OâNJÅ̶`ÒXå1ù 2™z<0G»0ïTïf0$ .ØDã`uÎdÊ)cw—0G@¾ÑÔ)b+”Ù‰ ïa‚7ÞÆþùÜ=¼\þýª>ØÞúTàúúë{CGÂGß-Rʪ¿C¼Ï1vwÈÎm»ó±÷ Ž}[å‚Qô÷M¨\ÐþLí½‘Ê38ÿGf?=è!zÛ§{&gKƒÞ2ÍÆÔͪ™fð @©íàTväW öÉ^ï]wžßž—Œlfâ »ì Û¸l¬ ƒ û ,÷beclÀ`38T¸NÏî&¶œú¯˜sHa2uÅ­ºœíþ7ò^¹ä„¥vçàì-Ó?áŒÑßÇY¾g©;O_‰3Óæ©+q–åà×ÄÙùÂÝÄ™QçšÃá ¨p«øïçâ6\ŽyÿÀ—9³Â…ñ1i0æhÈ®nòø±³GÓ{{ ؾeq› l›8ú¨eoÓ•ÖçÊ“v[a&,3Ùº×Çòùß²ÏùÜhú&Xö‰¢µ˜_P<£”±ðsÀÚÛDѯñzPÆ33Û‘«ù¶y3§!Xs×1oÚZ3 Ñr[ú¸Áq^¾áBãÞ¦7”sï½Ònåø. _“9ÿy˜´\XYJÁœd|{ÎÎpZâÝò¤T[x @Ð?%wÕLy›œ´7òÃKø`ÜþÙ{M5,’G [€Íyÿô%ß«^i`á6ŸH†:bp;ÓšyzäõŒeáA„f óNiAב¢êàÜÚ7Y=v¬O¤ü ¡H V °•0 ‰0ÄÇÎT6ÎÆusòvÚ.))°Æåx.Ù¦193@CÊ &Ž™²W¤˜GëëCI·nƒ×éÕ|²”VMÆÜ/^#rÎ9BÇ Ÿ }û+– tñ½õɈ·½Ò‰Éˆ*3ðùñÅ埾žÌi6/”z@Äæ±“z"ò @|áèÎ\ç¹"5‡(F줵’¾<Ø2RÌà¤1øµ8L¤æ\©éüñ …)ÉŽùö½ž,KD+Šì`z0a’íßô‡½Ü„gÝ‚°þ‚ˆÁižÌK4€W²ÔâˆèJàCÿ…5SΉŸi•õ0Ÿ@Ж>¡Å ©c+ŸI4°—œœQ8:éµÄèåD„¶Lkú{ÕZUr~b"F³óéh=p†°ti|ê^ˆZ«†ä&^]Úñ¶‹Ñ±0r-ŒV“£¬a¶ãy=³ B;½…˸¤ÅΓ¯Ÿï›î¿<¤€ÌØ•ò=rÚQ O¢ÅþO¸ âbŒ_Ãä‡[øÚ‚½Vi¥Q*Ì`–³ú ×|¬àÙ¾ÎÒ W+È 'EÞ»–“ ‹êÆFÄ<—Ç2÷j}¯òCÜFþªV)M0²ã2S¯˜ÜMA×e5‡ikNùs´³—Âò¤¸ÆÏ¶ÁOêGaç¨ål‹2l ióÝhjÆuS«±ägsØðoLŒ]*ßÁ`âÝɇ2ð¬ÄKÀ3wS©ïÈC›Ò©iº±jM0–ЬróñýëëMÇ/±E[Kœx&Ïw­~&,ýàC_¿˜¼7üÞê²ô\çsÔˆ¹Vul"ÌÒ×éUºÇo…Ý«ðe•¯©X2aiaÚÛZ k%»â§¼nß«z¯ Ål0ƒ-z…$Q­‹›p VÒ+äâ×pL“’!k? CŒ¥:0xW¯­Ó.#GÀb{«zûrIcTïw ¾'ä6ŒPÕ*±ÓÁZ ¤´{}€—4ëå´e hQ—E‘æD:YiféäF+¯ºS±¯•$µC@jYùEHØýÀÚ/À!Ÿ$áÚv¢´èl ð²Wt᳙˻n9¸vÔ¤tÝH¦WĊ˘õ%ÝÇ1¶Þ¾Hä?‚=QÃttÇ4™SmkO+muïÐBt#IÛ3b·k‰d2ýmüV§†fîô+GÂb]¢:³! xf¡-idå¤âi+Õ“ ÛãH¾tk½ VÍÕÿÙ»LfmZÉz˜û¸…ÁkÓTj¢—ýþT?G÷ÞQæÁ-ܲ¡[+:õÖas(¬ÉM T&®®âzx_à*\ÓÙž`O³ªŸÓºðÇ·¼Pà]ƒKkúo‹r³¿ ¢ ÷IuV…ï¸ý‘YqÚÊĶûM„ÂfÏä¼Seçí28ñF}°¿°÷Cœc9v«î+ Û`M‘d°Nîf'¶TIšÑnï6iÇ1kÿZhw]ÔTÙ!`±oóf)ô¾Ãhj¸×«‰(N7¥æÄm·Ñ6ž>ÉeQkb'y å=ĨC@t{ѲÑV¥C ’Œ0K*ìì:Æ;jH¿éVåVPÖ¸{Á«9«î}'Ê<Rü7ïiàs 'j|•>Ë·ºÉø†T;Ón¶´~nªÏåš•ã¿è”w&K~äcwýM]åë#ä@: lÔrÌ@Ì­,LÅl•MÜ$œX_'W¬iûÕ® jÚÔ~Ýè¶éòãñ† öâ·­¥]Ø1šØš5”' Ï—VÇÊCåRº¬‰ÕóEÒùp.ö~‚¶:ŒoehÙ¢FÎfw‘Õ˦„iÞª(°šqse+ /~3:w/¦^Û› qxÔ·¸{{n85-Øê2$ߺµ²¸ú{½;k¥S\?Å•‰ít’[ænú®àûÖçÖÊ{ldŠVwÿ8ÛÜî/¨5]½Ò²,Ø)PMBÛdcüÎ;Msû©[ÓmÙïÖ‰.9;NÄ ÙeõÿÃàfš1'WòZnQç× kºÙî³>Ò–^l¦ýürPžS3Zõ !›ÓÿZÈ£é5ýœÊ<.}C ]žÎ½ÄŸçwOæ§Çó×û‹wôô‚¢ÓL&Z< üi~jï¾?Õ¦DƯHn­SÉÄ]b¿Ï.þÀ¸dendstream endobj 204 0 obj 3836 endobj 208 0 obj <> stream xœµ[[oE–öÑ/û,íÇ(gèûå‡X–U Ù`$$؇çba'Á1lÂÙß»U}«êžžc‡°Šãžéîêꪯ®ç—c±ÈcÿÊÿŸ\}òÈ?s$ŽŸýr$ÓËãò¿'—Ç÷NáøSÊ%Z«ŽOŸå™òØ«c/ÂñéåÑ;}²—KðVÆkÿ>ýg™¬©„ÇÉb‰Ái#3 ÎxÛ˜ zÛªwOöf‰Ê:½{x"o…”ìé ÜIgÍ=ì!¥õ»Ïá½”"ªÝW8]yD}ï[Œâk.ðÕâÜžˆÅKå…ÝýW•RE‡(«¥ÌîÁ æÈÝ#\ÀJ-ÛJÚÝ—°€4^hÃGYlßûîÌ¡0ã®±¾!^üˆÚ)íé½ùk¼Y-ùõ‰Z °²#Ž‘ü ^ëù!.æØyà¤Ë›ýu"l¼ 'ŸžÁÇ×'f B³{q²‡sxã„Þ=Ò¤^l4»_ñ¾¬0ÁìÞà)”-ï¼·»WÈ"x¯vÏp,.B‡‹.>Fï3]¦£ `aÍJ×9ì%€Ð°{™ž¼p»'mì¢=ýÚÞžµ§§õiv~cÃÎF’}Ž´Â¼ eØ](½8'LdÃŒ Ú*øOGcw³~ƒBŒ!WЪpCa¯Eÿè§½Ì\Ò¶íÚqÁ¿H·`¢©`×k ‘mRXn2ížœÙýÖE týÂe $}t²ͳ"Z¸Kb¢>8¥ê°@mÐíV½lÖ\ >‡ÿô†à€ÌîãrꬎŒ›/p",î=Ì’¥c¬ìI'"Æ?Îbn\¨ËZï¢ï¾~ƒ ‡Å[^'¶™è#Ÿy›Xƒlcƒ—¸‚ OÍnÿúåIEËTña¯i©¬'.ËßÞHÀ(€„½„‰(yi"Ûî%Ó‘3DOÀAQ®<N8P§B™±&-„Å”,Ð~÷ÓI½¯rãÎG@ ú–vø¹ArÌ)Åe®ˆ¸Ð*ƒß>Ò!ºK¶èó¶)‘é§×°•wÀFs@Э^`ÞÆE7µ¢£²·D øüî+¿€Ó¥þ9È«Õ6êjàh ¾ƒÝ¢ 3PµìgŒuËÏl>h`ù]»×žî··`—­ŠK„ÇÏÚ Mþº==LOHŸ\Ÿ¾?„ÈQLÀ˜]Ý8 j+a,|×îŽÝ<Ó p­ê/·PO4`œ†Ø´¤ÃÚÅp |î¾`k\p0Ê×¹ðP¸[Ç0°´X•26Ú­šEBF”ƒ¼”@ÚÑ8]ÇJ ÌÁÅ´L8‚dÞ„ëv‡ÎåÌŸI=.ø'ípºçaÒzßYÎ}’R¡U‚D "Ü="bÑ‚¢sŽU$ûçsãØyÉ<²’AS$ ÖW{{@÷€‡ÑÅÞFþ=op±K3Àz†c࿪éæþK?Л>±¹&QÇMÁœy¿-9"­Ü…œ7Ür2ŒÃ) ŠZ«ÎnÒ‰‘i˜F†˜ú4þè –œÚ½;Èà¹Îp1dëZB‘2«ŠáÕ€³Î4øпÒÃdé‰BG5Ñ£,ÀLQ¼é|»LPç$ÒT=)bf»|7±íHe’üzˆÞàR¼oÓ)øNø<4‘÷<òÙ˜ôóoIÛHn¡`KQ0ððYÇ/â¼G)ðp¯Â¸ó.ÇŠ 3k§´HÇT¾ð½k/zçºÞºÙÎ/B Nô†VÑÓŠˆâRlâ4ížmŠÏÆ©i¿ó5Ê07íÐ;!{°Å*;ÀXC–Ÿ3¯ë4¢2ü!#8â7d½“!£^LŒüý[X|Í¡³‡æsödQ.R(#£Ú;&”…WÚ%û•NœX …ójk·Î\¾ÃE ìR¾Ç0<§GzéêT à‡.¦—@æ~ ð¸YÔÓi! F:HÙ¸G•bl~.Äõ©n`Æm#2îÅE2(FB¡âç’aW8µ¥Ì•C¢0ß ð:$íøM߬2s.rPlÕ4øãÁ¿•9ȶ€¿ª‡0¬œžù™8B†ª5ÝÊÊ„%E@cÜ€ÇA:²¨f4 ž: Œ n¸2’Ò0$O º™Êàl¯— #[þUW€…yÚé[Lµ™%zÆÊX /0?uÄ4ô‹ ¼hl}ºÀ¯HéÇ]ʵ°¥Ú’J“k?¦ZiŸ¬Ò~Ö—´>]´€ò×öÝY{zšcUÚà³6åY[ÚÓ‹ö–f|RŸ •ÙMË„ž5Rž¹Hçë!Ùç,ÏÛÛ—Œø~ׯ›«É–Ûøžü|tæñ¤óSÍØO7ùzÂ~úîÉäT G à *’ðÕ¡CWàí§ë‹`K_¶±×ã4²(UÜ!Y ¿ˆÊ4…Èz>L©²<ö¸=]Ô”ˆDX[¿ß·§ßÛ: Wu°/¢ç>¥gîµ±û퉲)eÛžGŸ;àØ£öD“ïY|b祢£DæWmìëöt·-õå-©¼;®×KýÛ/7‰œ 3Ñùل·m5âÃ÷·”ÇÏ&t>øJi¯¨dëƒ6ö]{º7!·&ç =}^ï0e_|À™´±q"ö@ñoé¿^ú‡›#ø$„h€;òíoøJ*$Ï{ÕæQÑè·m|r]êØueá5ª=¸¼KÐY™×mîëa=fâºÀ7ímžåäðtˆëqYB^x"tiÄ` ±ôíä('ì:£ÉDÈ v‚ü:¹±ýQñõOáç*zݨê¬Þè›´7Ï*~«ùß]4ªÁå‘îuïæi¬PÇ8I åüÇ~‚ɧÎÁ_—ˆRhß…Ñàò0ÇïEņ;ÚÅÚ€;çb—ï€AŸRw}f.}©)C8O,LcÙ™Ÿß»²žAì· |ìã—™‡Æðó: ³1ìIݰKÀ$v=GŠ|Êo?Ë.;òT·ŠGî)ŠÏ® Ì‘KN?|HîÅ­äª#_®„‡¡´1K7æCçzU/(üËAk9 ‹Z×™öš¹È"HQê ™ôIV&g‚»x®Û¢&ÇÇÛ¨Içi‡Ñ;¹qT-%$’±}ÄÃ!g% ×¢[ô˜Ù«©ù¾"DZ@—¾‘`ßì AéŽå´¥ÕŠ:h1ýRr¶ž‹ù¬išä¬ôöYÎ?%f§¨üÑ$*§ˆžr"ßc}¼ÿÍ$f¿œŠ‘U©¡Æcµç×§ Z`®ºáVt=ì¼Ë_Ä0Ä*V˜Åù>ÊšZÎi©’®qìèKF¥nêt¯ºVúÔCõ¡RZˆ€¡xƒiKåþ ‘j ÿ&ÚØæ}«ª¢M…yÞ>·mÛıaу£ÜB3io°›;.Æêia°T©p²i ¬„êC‚¥¼ÂÍiß„´­›XÈTlÒè ¥á®øg41ùþçxh‚G'š‹žë(Cß@‰˜€ù‹í:™¶ûàZnÂÂøÙ°‚1¶tÎNß÷^Ý Hƒ€#ÌÌL{.™ÙÄðÏ*ã#ÿî‘»EíõÅ%0yY·ëÛBxôYoމrn„ÍU©EÑÀ[cÜEì­‚UZ›(x¦`}WßÄnn¸’¤RÓ.’gH'냣4cX” |G.€ÕeÚhm&u»flŠ)òäÂ)‰¿éè›Ä6²»™8ðÛðXY÷÷fíÆâ`.ïT H¥!yÈj¬°S õN×°³¢|,MÅÚ÷'åù!R0óÇV¿U`t³ãÿ7·­Ä-Sƒ!6ó ʨf™ø¥—˜Ò‚QtZïÃÛ¿•uéǨÈ«ëßÒN¦V@ú%Μ[ˆb«uû&“»_Ùn.‘MGÅAC©;C¹eðjŠï†äFê!ujÈœwÈOC\Š(R _‚í[ç:kuUÆò”mšéÇ)¢K"¾_«r…ðBïA¦_«Å>ÛÀKÉ¥ÞöNnÝ‚B¼Šî¼jГ€RlÚº¿8=úüûNzÂendstream endobj 209 0 obj 3850 endobj 213 0 obj <> stream xœ­\WÇ6¬·ûûæ=ƒ7ìü¦hÓP°d²,0Í$A¼c–DÿzWu¬N³KJ ÎÍôtWWWø*Ì>?°þ—þ½}qû+{xüò‚_<¿àáá!ýsÿúðÁ]r±qÁìáî£ ¶yg¤âq£,÷‡rÏŠƒeîp÷úâÛãû—WjóB~Ü.¯`ˆ´RÕåßœÕÜã]­åƸ<ÞÁ±ÂjÁŸ_^Áb\hŸï*{÷’m–sã½K–øçε¯ýëRmZ(©a¨Ñ›TJ¤©„eš.ûÅ%PbµÒ„€ßýkÚ>߼ַǰºU7¥Œ;Úr‰o_)eWÒlNzûÆæé™;>…5½ÕL_Ž1¦Ž᱓›ÓäÞ÷È>s2y¼W—zC­Ù„¦7ŸàXæŒõÌâÂñKq|y)6%4Ìð÷¯™Vþ÷2Ë‹K!7À‘•¨8kf-?Äù­ãÜoaHøf½·Ö‚eÝft¦\¡(‘?1Î{'ëvyž¬{·…w\‹¸†cÜñ°†5ÒÆL"ÊÉë/`;ZïÒ8 œíAj˜ô1Rc7Rð3lÞ9#\®­ñ–,ò}}1 ŠjEX :²NýP +Ââåj*]b“†•·n!=‚PNù™Y§ÌÉ7k„4ñÌ”WF6»‹JÍ4!?íÊ;-}:tÇ\s ù;é™ôñh`ÇNˆ‘E…Üxv3n>nÚ,¸å9×Sné­¼ÒÒM”{!ÌYÄ\)»T‡+nÁ„0gL‚ç ˆi–‰ÆêA45V[zù„ ÌÏ=Œ®úôo:øC-t©bðV=¼^åM’1îU¸-î–¡&í®§7¯d+ñ/#’·Ç 5@Ó³°+å­§‡{õ+aìÌR1ý¸!g(ÿžÖr&VØ*çq3ÒûfdkwÒ¾è€A=âj•5(YŒfg PŠ$ˆpÇFž 0,r:@ºÚ‹lϤø`ùF4|®²Ü€%ˆ ZS¿ÄmF£ÿõµÊ|:à<Î6†¸FÐ¨È T(’  rEZçS`Â%wWј¹F»òHÉßÃë0“•+÷¯ ûqþ-Õ¨úHP(%Ŧaez] w®ñ6ÄüÎå¿žÊ œ˜4¨ˆûf|C/áº+LöÙ% 1– þ#4 ´Ë®ˆ±ñpþDãëÕ³Ö«†Ø zã‡Ô XœÐÇ$&ˆcÐ!`ºsY‰ÂÛ€St°) â’«ódì4‚ÁëŸØõ!Œ'µÏ‚`­  êNLUvU§!"rÄK—æPÈó)yƒ ‘6«KÜwë€È¡Ü«¨92Å'ÌSЗ›¸€×VÚãp— ^’èPa¨d4$A‚*™“èáÂLšDp¢Ã"\â™)àÓfšµ¤dd#=¨½Fl´†«¾ˆój˜×žåc¨¸ýˆYª¤Ïp.€ã®ÙïjÝ ò£Ž5ZƒÁ“Ž yþæ’søN‘xO$€¾»Ÿ^Üýã·Ùà mê ¼ —<~Rfÿoâ’v"-¸•¢€§…EZ˜ΕL5ˆ-º‡Ã{ncª)'›O Ƴ8ÝÁ†|–÷p¨ ÑÖkG=X˜Æf+˜öO S8Ñë‹ÃŒùêE¸B¼ö¢ÜÛÊÕƒru¯\½ÚCô¢Nî=Aô;D‚;vº=Bîh ½y+’áÝÉ(;4B‰Š…bÔSœ²[m{h¤µá|¸W·q]îéÕ†ÂÓnC«8Á¾– ö0ŒÒfçÎÀd æhÓ'á7<šgðc|@²ÚºEØN1Içû³—½Ž þ Vº/ð±E‹ÝªEµU•ˆ©†-ƒøÇqfÁå¨Û]àDÈEÝæ¸ôËL7u†qYÉWPƒ"6béžPçK¦[  –Vf "4Xù‚‰*%Äa  m¦è/pœE±oZ"A[oBЉ?‹›¬HÀœdqmcqGŽ­7s›=#4îN8±%Âogù’ùåµ „“Pà»cFø3Ë«Æ{ãÐ#^¹7Ë÷ž•«‡ „q3S €ÃkÃt ¢¹ak)CzzëŒ÷î•«Þ:ŸAÙ ³Rx:ÕÉ AàOúËÙ–´B–索€ v:DÈ;nO¢]­nï»K4>•µâ¥MTc1EÎ sȈ!ésêqA¦{]®žtW¸÷êg« ºÁÄ~Ædðì¨Q99(g‰}=3’&Uùnæ*K4ÓëÓsúøÍ¥ž[kH¢ï52œmJ­Cª&ÎyÅPXy^2øO)0ú袛*ËOˆšÄöY~CÆ ×¶`FÀÀ ªa8È…bóäƒeÔÞù‚Ÿu€úÒÀäMhÓÌÜaØÞµW¦^™º3 ‚c̶®FYRœ6ÒgIuØ Lñ¦Fd‰Î÷f¾ è"F'+ÿ¶pÓT*'jÔ*’cç »©7 LÉÚ2äçÆäÙÔûcýf9«.)¡1'³iÓŠÃ’2ÔnD¶ge¥ÓÖ‰ç$Ò:à:Ô$’&4)V„H­qÓ·¿\8#]pGàÑL©¾ˆ¸þ{°’’ŠÏ `dtÜWÍ+m¨ ˨š®¾s¥vSLÈ“À8ÅlÈ|Ã¥Œ)Ó|™¹£CBv|þ¿ò¼ŽœÏô/ æy2ÒÎÝ D¼9®ÿS'p$ni¬p.&Ö̃ðèIÎ`»0‹¼à7×&0Éôï­Ê}${1‰©XùÈÿŒtA¥FÃ^fn,b˜±ï/â«Ny&e®ï<ŸWØ ç²qáœ0uU­6ÉF6…—hý8)‹E£íC) ™ÉÀ—T‡^M:-ððÏX ì`£NæK'‰âtTjB©R3æÝ‘°dáÂöVÀ`@£iË @çH2t%OZ ¸ÊmšO ôXĦ¹¯”HýUz²^á]ó0[Â…J ˜éuÇ®TécD S‡VàSÓˆ¨ ÒmÎÈ“C<@¢ºÅó`I°“(Ì;‡°§³g©wU¸c–]K~"¼šÁ”Dß:¼Š#\Ê´‡üxÊ´ MLi„¡Id’UGÔdzÑTÊ…±–#„OVMñÚëR~r`öÊ&u²6't¥eÒW˜RLÔ²Òà¦Å˜ø¥iî.77ß4XšfLU#f·× ö°Üû¥cïyLŽìôiø¾)÷j ô>v‚ÇD¦Õ;Ù¤Pïòk_[•Š,1«þ-ª·(ªÏq…ÔïN·È´/Q(P.çö2ìˆA½¤8kÐÍø^(0Ë@áã9iÛk*1øšmˆ%êOóG‹\Rý~¤áU”²ü½™7cv§gZ"©OJ¨˜’é@ËÉì•g­=RàC…lÐ6Ѩ>ÆÓbBS1žÐ$¹4ko ®<˜XYŸšÌmJß0† ÒeS]W©Õ³Œô2¶cƒêéC%ë764È£‚!uHÏ+{éóEvjÌþñnú”É'§· 4‹]ù¾’5$À|Iƒ7Ù­üÅŒ¢É©©ÎoA.wãz5iGÇ:™U¿ýçn3sY¾2à‰Q‡%µÚ7É$+ßUÒ¼H 8¿ö[.Œ×45 ´h[(Á(M·DəᮼÙ3`ql£ð)Œ°c÷,ï\þ˜úbù4ˆÉeé »ßua×Þ]¼Â"›Óæø¼Ü|9qܯ&-Üõi]‚жcÚótÑ~œs¿\ýT®êS€é;èàªl3!œEWHcxÊ÷û~®ÅÀke£juÍ÷îó’O_À²vCE&qY]tÚ·¸åa9ÌȹÎîà“XÁi£ïƨú½ôáŠïr'>þ6ÄÉßcxû¾ž~27EÈgüžE¶/5«ñø²tú½[/H(øa4¶ò±÷íTøEyœ¥‡Ûkæ]tt7…5m „Ym¿HÜý4tª¿tÒ€ãà1Â4(áióÇØö;Aé{ÝÜÕ… ÑCÿäˆ×‘_jLKß1ƒ7=~\ÑÊW¨€na†ÏãŒíå(h8‹íâëåˆP|ˆ>¾{ñåÅóX ~'–w‹ÖÖ¼²øÏýë‹î\ܾóÙáÕ‹×/n}à·ÿ‚ÿûàoÂ?w>:üîâã;‡/—¿G$¸=ôµŒsú‹P 3 Jå›÷ðmç¼â¨YÇW¨GN…êKQ‡ÆÏG 0Æ/©bËkñ¥¨±ýš¡—9ß쉃@Ã5”¼1yƺv&Q!cK5î;~ç‰9 ¯yž{Ð=="‰ÇlÂ,ƒ-±þ¸^ÆS°–ùãGõîõòózùiûM¹; µ©Wå >ÛS|¬ÜI…Å–âër±ÃÉÀªpÓzaK%Øi¬‰Ç\¦7×¥Õ®ŠFÑÈ//þ\IŠendstream endobj 214 0 obj 4643 endobj 224 0 obj <> stream xœÝ[Yo]·Ú7ý ½åÞÂ÷˜û )’¶)Ò-U€M:–%‘¬DRœèßw†Û yx®¤y)ü`ЇËp8Ë73¼ßŸŠEž üWþ}}òòKzyw"N/O¾?‘éãiùïõõéïÎ`ü)å­U§g'y¦<õêÔ‹pzv}ò¯Þ伕qZóßg*“Õ"•ð8Y,18md¦Á/ãiëSA/°b[õ“ýÁ,QY§wÛËÅ[!%k}†;©à¬Ùýe€=¤´~÷)|—RDµû§+o€¨Âwã£øš 4£Z¼“»³½X¼T^ØÝqU)Ut¸²jQÊìþºÒ<¹û°R˶’v÷X@/´á½Œ,¶ïîÌ¡0ã®±Æ/~Dí”Öz67‹£%ÿ¼W‹VvÄ1’¿¢Þ#Ô+s*ý§5ƒp8/ºHµ¸hdbº@òA@vvˆ1,θÜÖ9¥vo±i„V¾Ák³KЛI¬ìî[Ú +j3ÚÝ 6öpmЫt€þÈÇ–œ’»ïh‡2-Âlì=6m0Àšw¹©œÝ½ÏÓ´w»Ë¼…ÓnwWæÔîc½÷´£ázÐ YJhb£í]’XØùÅÉÙoybÑI+÷\P¹‡‹iX—wKd*\ˆq ´°‡ÁKûd©$à¬[¼T© Œ¤ïïVÔâÐëJ$s$²*‚ Uéͪb¢A†ÂMýãU‚zíç°ÈÚ]@§ M¸d– „0xÿ8Ë8A³Œ–WÈó }•)4.ì®p–>H™¹P°âs6{——p>½·%4Š H¼‰>ò _ƒöh ãÛFûJÔÖ#€¼ÿ7‚åáCq'²Té’¡\*ï~ðwüŒ`ÿê“™´x¸t?±'J{Ðyqzvzx»Uu t;Ía 9fBL—M+@Ÿ^Õã}öTy§5HÓg[FcÝ•µJ„ƒÓÜ¡ùQ›ù´Šya`Ðu ç¶ÚÅÀF¢Éø‡e1_qI…ázaVf%ðD¨zÅiÏÂAë]ôÄøîŠ@W`AÛ\¦Ààu°ïy7## ©ŽÍl?—MgÈt™¨+]Òêù±‘³°–]€©4±>úÌPºð&öZ€Ž½"/üÍ>YYm˜Cz²ÈÁªÚA0†o@“n÷J/pZÙ- s<wùª¬å“Wl#2SÂN®ß3¼ÌËí³ÚÅç>#dŠÊI4± 2ñ:É@¯zÚÔIÆ0¶; ¥­\ЬÑÐ$+Ðåt†+.f÷8Ó$̪-lr b¸À-2¹îFÏ´Ný‚ôâ~‚£¥ÆW äÇïD ïLjÕîÞv²QîÔ§;Õ¾ƒy…CÁuMÅàž_]…pg»_' ‚ sˈÜ”×à 㦶f{«¬áC’Ž”³¢Ž˜|ÞÑW ØÍìeá*\aº_k·=Qæï] [ wˆèT;-{WW –GnËþJ¤…MwÞÏå¹n¢ÖÜÓ[&fìš&î«c7ߨ‰rjANÁ±þc_]ÅlUòÑ|¡sBìö2Ÿˆ‚¬#¢,ÇmX/S=®H¨l”-6¶±»*‡“µ¥U8ÝÌ'\c·Jéj3î©zãÞg›ha™gj$ØÂ„(Èhdޝü|5Õa ¾8Ð'{3óHÍýe ÉN^.*Ÿûw(þàÁµíd°09‚3+ç2n¸‡=¥ ƒÛ £t*vý.­ãx»ñ‰¯ã&6o·òg+¯2—Gä¨ áKŒ¾9ÛY­Ìœ`즟´LûNãìŒÌc’˜Ò6Z! ¶:†¸–Û¬$‰.ƒ´jîëPl…O6éë]2ì(âUaÔbÝLaF@•Øé&TJi@P€4þCŠ3"$CVíˆ$úLà "e»ÀVø(C8åuœµ`CÀ1‚DnÆèÜñl¥&§qNq–’…ÓZC¨m·0÷H&@¶Rª6FöÞLk°r@„ùrTd·&’Ø•šÚº¦âªrƒàbÜÖŸº)ó7S©F|Æ»•5èÀdJpDÍwØVá΋‰¦"䯦™ƒ’³¶Ï‹)ÆÌ;™buù–¬ÓÒCvLŽûÈ") 5wèµ*°ãÐÀÂ/È*,ÆÈUŽUƒ‚ìç$$ L¼ €Šå®On¾‹! ¡@؃£º© 4,¹ _àZ ¢oÐøŒÍn—T²Í,bÖÉ@ßô°L¶™cáÌ*O\}B¢Õnœ%°cÇ"í,e¤;,·2ž)(»âH“)U&BƆªª_‹X‡Â’ƒÑX§Žu.…@#¬CwLW1”W.U~†\°<_ÇQ 7!ÞÉÕ¤j¦ÕCF-köQLM}½¯neôˆžè ÉÃMÁ²oF‰D/ÒÇS°ÜuIW %»ÜQÍrj¹† Óžß6Ï`Nƒ-jmbòD§¹ÓÐqrå°³7~T«¥RºÔrœxÞãÎ|KxrécF|U5”àZ1„u)¨!Å`ˆÖ_•ß`½ÏÈIÉ Ð©Ñ·œ³ü<ù}G¦ªOwo¡E°É0d^€¢YãAê÷vÇÁñí3 ÞÈI‰‹•FP‚7á"úÄçx4¥Ì­ðŽ( C¦Äâ[8Ùñ%——Ý¢UÕ;çoeú×0EF‹=(æúå—¦9‡²üBkÍJ!÷rÆ Äq ©ÖP;slâ€B&u¢ØËühY?ÛoŸ_ÐBoÚÈ­E}y”áû2ÅÖ­…ã[Ó†®¶ð„í G†moÕ•–ÛÖwÃÏdÁ.FiÊnõ¡ DœÆítëTmßë™›sÑ>_´¾7­uß¾¾ê–Á­…dl¸´nknùd‰H&YîÚÉw)$šz©ÉvæNÏ{Ã&·)ç“û¡ó½k伟Œ;§S]Lv¹%ÞÝö³£”–qçªJ:´Ú¹´­oúB „Z ]e¡–úJyœ8Ô룦ñ XJo­ªûY—1u‡Û¯лÝ䕞×Hf*Š/ dKÑP`Lrô}0ßÓU#×aþ^¨RÊ6ÈmQÊÏbç¹Òñíø‚a^ú\úZ J´Ä­—³cŠÁå1S ÀS}Ô‡Ù),3͞ݔl>̑ߠ¼èá‘Îêã0âÕÊ&E5W–U¾:qŸ’A.Ué¤$ÒÂ97UdqÏ2éR†kÀÆ«?ЏÓoZ@æÙÏsg¿´rnu7~±T"6yéþÔ—ÒxZö$’> stream xœµ\Y·~ß_±3¶Å›M½9‘9A¬cµðJ²µŠäϧŠg›ì™•møA4§yëøêàþx)y)ð¿üïó7ûËë» qy}ñã…Œ?^æž¿¹üõøþWªE*á/Ÿ¼ºKX62M㌗á²öyuéÅzùäÍſ߯̔qò°¯àíµ9Øã•\VoeÀ^kõ"¤><9ŠÅKå…=ü?Rsøöx¥¬Z”rØ”‹‚qþðçµRKE›9ÂLÞ‹JÛE¯þN&øëQ.Þ )Ù âðC²•ßãpåÒ‡?ä¸+þ[Ü|ìáï8Þ hýó )­5é#3åÕ5‡?Õb`yÿï'ÈÄ•K°V!qÓµÈK O#¤N$3n=„ÚL£ }eŒ¿¼ÒnYu€±/`ì+XMÄS§Ö*ÖÃËÚ÷¾o ·R¾{Q[Ïê¯Jßh÷¨.°CZûjU‡O@†uõæy| aûBn° “®R®‡ç0­¶@¨×8H¥,,Z}›¾u>¸C èÃ;øØ{ÜŸí-Y¦Î|K¿ø/^ Æi8e½š—xÉ««„E`ê9Žl°Ÿ·oJß®zY)ËÅn²é7Ø­Â*­Š_{ø¶ÿø#xÜt\{g % Þ^œ²–Œ'‡hãG„ÐN„“˜,l>I7ù¢îç5xâ¢Òæ}BÍ6Oèúvo n4Hx 'BfÙY”)¼ó§÷‹Õ…`Ȇqq³‚¸¦m(¸³H+mœæÖ.¬enMW&÷ ŠÇ`"³WÒÂu€Z€A ws¥×u±îòJz$dÚÕ³¦¼nUº\$€÷y p)e Næý[ ÊzX×0I <ƒlg`a˜µ «4Oç&ó¯@‹¼d>³ p¿d?phå@ƒV‚¯ß‚ö@ç0ûÂÊ6ÔhÊØ€|ñݱ¨ö,aÖ»à åGšJ®0ÈÉrÛ7U¿¼¬­ª‘FšFÉÅà­Ôñdo•†r. •¤Õ«ô’›»éç;jG{eU¾¤K Id£š6›Œ<¨"“ÊË+8®vB¥Ã~ƒ¢a|E è™EÑi4¬·IL%0Hc€ÄZN˜ÑÕé$QâÍl¼ê. ûÞw­Éui¿µë"ÝÓ‚*€¸Z·Ã·QýêvÑ!ŠZ?ª.Qú‚_Ó×D‡Ò[o×ÇfæUM™dl‚ÁƒDOI!k%æ"-G6çY›‰Ù­ŽÑË$ðsŠJvæe `‘ýÀ”¦*wìÑK¢ƒ›BÀí‚’tŽîä]ÒÛ¨«>åú$éuCEˆ ú.Ùµãv!¦ö‡¨ÄMðX’L”°Â®ÙåvBÚÛ(c0ÃâL§ç›îÍw¼‰D¶ ¯êì@eJ”ò/ä„ko8ŽùÖhâFw܃²üÊ%Vt¨J;–Í:½Y ¡ˆÎbw3Ð…Ül@^ð¶ÔæßP Põ°žêçS1Q¨[j¨½”`¸òB•Õ+/l}Ž-¼å›ßÎÔRÔpžk뇽P0Žº˜øJ jpiÌ?ŽÎ-ÀOŽò ÅbÐÍxÛ¼”›(>J;Úy]ÎéovhJ4ÿxñäWÉb6hWTïÚlxÚ@ê·3n¥?\g“fÕôfŸ¥›[A¤sWÓC8»‚ÓDðP{Ùñ%úƒ —408Q7Û ‚DçAû­½ðlæÝSâFH*q\ÿƘs,ÎP¡7׿ˆB…²ÃŸ‡‡¬ÄÛmR½2 î ðâ\M™2)g䬇l´G¥¡Áuö+ñ¶é§l,ÝŽWi3Omhæ¥&+™k<;ûðh#O%¹‰,ÜLŒ•<7`Lv 5¸_ŒXSÊÏêv²ÁÇÆIa¦M3©’á•zË·ÉOb fEtp6âÿ €âS¸@X÷%n<'»1 E:õ ?KÎMú'Ü4bRn<¸‰nUçZ HÇõz*ök²à†+ÌOˆ4MVÇ ¿ì±ÔÈûí'D4ÖU3÷@GGWÍýèL鹃FaPÚÀÆA(YUqBJ™c¼W#C °öꉬ¼ÃNàiE=Þ‡@3P€gÖ¦ ÏDu8§Å†F¨®!¸·[T7äET¿Q³]ˆ–ðHÚ3w£y@„®Ü9Ä3GV¯°°˜òÕ=ÔQ S=Ö,Ùë¹á$ä»Ò ¶èCg®:ð”ŒÅ}Ä&WøÛ3°B¤1€€»€Þo³JF|@5aEàYoσŠ|C·vP@6ø¿$R42š7¨Â$ÌÌÃ^=lÂOb¾½ÅUš|»ßÑmÖL‡¶j6Ÿ%C%@õª­š6¹2*$(¡ÃÖ¢“Q™•ÚvrpDèkY ì8â^bâ±Ì£Ø-Œy•©å Lg"RfO`-h”+¡(Û‡Rü¶¶i£ñÏH9:‘‚ƒ;»O]&‡œ·{9#XènÃrn]±ŒùµsCtD؇i‰^@g4äÜá8Jz “¬MB¾fæ°õÀW/®$ƒSÕ N2*[ï1 ‘(̦<•žÀL¶1ä~‡_o35÷‰_ƒÆÅàACy]h,^„Ó雯ÆÉŸÄ{ªüs*ñˆÍBw9‚ˆ6O娅'0˜Kc,Òí,°™H¢˜tY¦Æ² )4õCȾ³_1ÈŒ&»ûfuXP¦í³ÄŽe8mDñî½C¢qc»ãÁn¥™ ™¥ÁèÂO“HÄXé7ëE ~#TúZK6sí[žÐrD¬­}AÂ2j½:ŽVËðßÄcŠ­Îcâ­óPªÆÃHAB³{cQÅÇ%¶¯ÓýJ!7˜4%"ôÏpG°P„0™Sp]ÜÚÁÔ&8]ð\hÁƒï›TàÞ õ}ížîöõY×.?:Ž–f4s^âKËèÌE.âNë«^ÏßuøNp§ŒãáL€ëý?¹³ nKo‰òÍ‚1dW<.“l‹_X–¨Gšc_¬^ƒKo~÷Ç©iß}(}C†Oy2Si–œØnÚM,;ô`6¯¸ìy±(jô2èBÆÕéD#õ ?â*À ZR¹ —Üõ‚wíÂÀg‰)0·Q4û2Õ ß(ýng5GãdþKŒ'AœQÄáSm=«‡SÏ´z`y¤Yeð?'äXÓf$XÁT<³©EÞ+“žëX~J.H¬CŸ@/ÍuSQ9W®>Z V1á^ Úeؤ?i]YMkâ_ʃPþXAxò8Õ™ _pJá:16paWÈØHªÔ‰ ô©)z:°€A;ÓÑ€­c¾ø»<—ž‡ïã ¶Ëî±cÕ i¼k–~GÝNöQyo¬Òá˜BX:e»J1šh<à€Ò†f.ÚLåH[?¦äŸpŒ·í™=(JãY\œ¥~ÓÌÁ²ŠL€ ¬Òá8²j±>œÌ*\œ[\ZŠà³<Õ¤œŒñ„C5߸wë>0×UÒå8\²W V”F |ϲÀó•“’¾ïžÌ•XÖoà¾0²níæúã‰'šb_í:b HÍÀA ŒP%NÕa « ÖI¸ #údð¸Ã:¦ÐZ—‰¼Õ‰¿§ŽD ~wS0;ņÑkw—W€«cy2 'ä =øË &âéÚ"ĶhMbþT‘2éë®xû°´À2@ƒ¬?‹<9lýé1Ïäi–§•Yß’VúÐnH÷@!x²Ò ƒÖZ?¤TE™ä»VF#¦¿¦ã×Í÷ÐÑ\| 9â…©Máí‡äN‰°WÒŠ`seéˆA–\Õ(‹0+Þ"óžö/‡N#Ë+n2$L3%Ö˜ÕwÈRÚc¬‹Š %9Ã+ æAZÈ~~9ã4bY½à½‚úH^šùBŒ^)¶éò*ÅmJYvÄjÕ¦ól¬“›ƒ }Ô&ÅáXEÛ~±$½ô%bÛI0¦O'’ºgmw²T~T‡™©•S‰ı#5_û0"4@À¯õñòÎÑBùñ–°.’Ø:|Õ½S±8·¡æ!¿J™Ì鿦b¬«·úó€õ"Ka““{éŠ †v`t²p,B¹ìnƒl ÜáÅQ(.d½kn0;ˆ„Á¾ZªBbð‡'xÄÈÓ߈ڹ¢øÁËy8$ƒ„ õ“4QW’ýÀ€AWbŒ Ué®Ä¸qçVfáqÛbà½ç,©GÜâÝûI\Z§îçQò~k•isΘ&Uzf›m£ŒTó¶v¦zœƒ©X¥”‡ågK~~Ð&šFȺ‹³KK|팠jgk¹Ú²e}úìFnlÞ|ÅcËøÊÎBzóÊ•˜îÊ)f’2h»³«I¤”–ÚyJÕlàõës}·*µ…±qÓÞNCaI¾ÓQÏ)È&8lòp§q%Itc@‘Ie£Kpä%†ˆøÌç@9µB…dçhè6i“•'.`Dew…ƒ>6ÊÇ™ŒS™ÑaÛ:º8¨¿æŸ‚c¢-ZòÂÛuÎ÷m¢7é­¿¶!êï"ÂÉñø·KâßUž»kÃïÒ§dîWq„£šÎè;$•˜–i/“ßó ÈЩڔ²R_Íßö$u RÊÁ–·õäî”’¦[ u««|…9LçhäŸ8/}&Rföi ÛSÁl+yÝ?HÖ Öú+lI«{>>ZÜ$5$¨:ÓÇ’¥ 8Æ€?iÃ,¼9›ù+_Y–áø&ˆ‚©ç3_YbdÔˆ.-ŽoC°ìrž¦KnU4Úü ìÏšPë²ìÊvЦ÷_'¦Ñ`c§†…”rjÃÃJË+þ|>Ÿv–€ 9‡Þ©’jX¬£,åKåU,üç 7ÖÙÍBx<V²ÄĴ³TO3^™KI.¡ÛËnoýa„ëE:±fÜÇþD®êrƒá¦ÄcP¥8©þ£€Ðïóßt¯º3Óôk¹ð¡±îߺŽ+®Rzδڎö#Á!àÁf”*A&¡õ›¿¹&ôéÐD¹ÙœÛ¨IÌðŒÒ¨M!F<ééB ‚1ú L+)Ž”ùé%Åý»WRÜþÀç­c44°š•²Yn¦o–R[YÙòÞnp@yÙh¹Uý«8;®v³ÄwŠÚsaj†¦iÈ8Ð:Š*‡Às_ÝêXwþsDÿ´ñˆû¹!XÎ 2ÏjŠóÛ‹Äi©ýAØRÝW_伩ܨv~ÊÖè8®“zâÓsÎCÿæÈ£öÒjîˆf*Ÿ¬ôB€ïó…Û³ÔR‚&³Ðm‚8ûwy‡Óà,}üm9ÕTÿ?²ùëKñƒòvHk˜NçÄúH÷ß’_mÙA¦/þ˜HxUrV¿Sƒ ;ÖšØnŽÁT/Ú1@?”þ¿U_Ù Á ÿ²8Ïÿ¤ÚîY¤›<äYqa·se˜`i;bV2á`AQB6­Å6™•U 1•÷ê³0C/ÉÁÑ‚¦ÎJ$gjï+Ò¥FuèL¼?F”d áè¨QÈ :iñí“‹¿Áÿ,rÌ¢endstream endobj 230 0 obj 4620 endobj 234 0 obj <> stream xœµ\Y“ÇR&àM¿bx;Cø´k_x3`s!ÌfD÷ò`$k K[ñ7à“Ykf-=32=¨§OwUVV._.Õ?߈CÞüWþööÉ—ßù›—žˆ›—O~~"Ó7å¿gooþâ)<JyDkÕÍÓOò›òÆ«/ÂÍÓ·O~1·Wyoe¼ˆvùoOÿ¶¼¬©„ǗŃÓFfœñ2Þ´{*èFl£~u{5GTÖéË?ÞÊÃ[!%¹úgRÁYsùûÛ+Ì!¥õ—¿‚ߥQ]þ_WÞQÿ ¿wEÇ<à2ªÃ;yyz+/•öò;UJN ¬:”2—¸Ò<yù°RË6’öò×0€4^hCï²È¼ß6º3‡ÂŠ»Æx¦óâ j¤´«Gó×xs¸>äßݪÃ+q„äéwO¨ß ‡óÀG—§z«ôᔵ—;¤&U—ÿ@ž›½¹|¼5G~~}{ >H.ïðéúòÒåáiù€›`Ôåyâû,xÆ…ËÂÊ¢Á¦× L ýýÞ•‡pŠÞ}“çv>K IÂЙßñV»ÈI#Cô·ØBžcЕëOã!ƒ¬£i ×8ÌäÙðê¾å/?%Ö›èca£Žqɱ2P’y©Ýå`uv­>n½‹žÌõªr¤®A W¹k2‘!\žw½c“¿¸UÀ„¾@u ff̰1ÄÝÊŸÝ¢DiÓƒ =}r³ÚuMÿnêk¼ŸjÂ<²a‰Ç_#7ßâZ¨¶€Lkç¹ÙhÊ*îÞÒ'ÆK£–Yô­´¢íG °Óå=iÙ Ï™Â]3®ÒÃ=!3›¾ïæ—(GÝ-€?T`3+¬•a‚!<ðY01:Í›ªíþöÉÓ?û}5•4êÕ Ÿˆ’*ö410“æ‚pkÀŽ«C›hB]v.)'Ì)@ ÉK… ì:”raÁÂI¢| Â,лµBy+6ÊKE”lK^š.›AÃÍ u`i‹ƒ^à`0C¿ú¥]}Ÿ®lÒ÷zï]½Z™Xwƒ;/ØÞ³Ö$ÿù`¦9}JNô1VþЮÞÏ.éÒYNʘ¸4#Àln¯ñ²þDgÓ†ÙËÃ|è \µÍyGºX¬Öf-vÅOܺ}ù27Ò€ri§Ñ9Ç誵û Ö%"˜d¡ë‹.(±Õ^Yv[ß^Z Ó½êà bú¡?ûï0œ^Á(—™6˜¥\ŸD@6(xé}2ùô!x×iQüazÿÜD¾Â6äKØ6V&±½û¦_’»—wÉjú+QÔÿA~ƒ'ʾGBÄ¥‰È¬9…¿+ñÑÅ5êø‡’æò' ˜ãXtÔ.è:C8ÒÊ«<ÝáL‰-:-,#nËÆ¬xq©È“Àa-Ñ麫—–l7H¥Mÿc#x¹ŠÊ©'eP)°äáAÕ²¹`xs0¯¥¨oÀDy1ä-6/³Üri…6†\¯2ðƒb·±e½WÝÕ6.…•`x"‘˜ài¿û)ožŠmOÇc`¦1–œüZâ¯?±Íyˆbhór¹¥-ˆ(R+—<ƒ£ñCñÕ¨?sk-ŒtQÁ“qãáL¶c®y ɽhP…™\#úŠÑ™ö{xõf5xïe»úÐ~ÍãE¹²à½5ñ´ 0šÎ†±U+“àb‡ ÝñtÙAYÖî;¿Ñ`²Ç_ >bàaH§/û—3u¬œÿ8c«%ÖûNFR´'+ãmE(hôf9ø"zgM­ÃIXÚã,­ÂÞì{¼Ô)LÎÚ…ÓT1³ ›¨·:ô†þ1(€P³0q¨²YHƒ±§$ÅõF‚mÕ‘<‹Ìÿc|XøŒ²x%…T¹9èc `¬]'ˆ©FïDö4w@&ÿ‘Zèúþ»ì´1Üç(Òè5–ª¨gÚË–òЀŸ>sC®"r©æ0©©Q±œ›ˆ¢kR{8ÌQ¦ì\BX$üÊNi™Œ4ÎÉÇ j}m ìPJjÅ~¯ˆ~0Çô ™¶Cöå‹Ýe…o²çù¦*ìyðX=Z¢ÝEË…¬yO%²dާóãcNˆ–Ò¬VS FîÑè>9Q9»¿îñÐÏ—PÌÒ€R¹ï=¦ßýöÒO®UÓÚÎ#Iäæ&8\„?‹õfH+©hYc’Å#ÛB16¡`BõIŽWD¤=ÂPÝÂâ´ŸŒMMwëוˆ¸­QŸœBK“ù%ÒÔ;D[i°)ÈÁ\Mj·¾ÎŠ|e„ÜE˜ÙéÅ$˜,‘­wÀ=-õüZà ÿ ÍŒŸõ$ÌxÞîݵ«n L{îÏ!v‹}È>t¼w·øµ¾ —χ»éÁ{?-^¾)èÞêÕ³aT°åÄåôâõílé^eºhÌOíæ.íR¶+ÑÇd¥ì2>é«ê®äåÌ `žÅ·«Ø^¶íÞÑ_>ÈMú3ÒNèÊljRb^-‰H}h–Ú¶_¿no\Û½N—:³þ×2f’4t- ¶s±b@–͈4=°D¤±^'8{ØjÜ´†ÀU9R ¡Vµ¯tR¨VwœÁüCJîze&VœT!~904\çˆú°¯ë4¬äÈž`FM™‚Ýn4WÖïm~к“êB¥–ø_ð,l•fÉ·•÷ùXRUɰTUk1ÁNYìF–à :ÊÇÞüzÎKålÏ® 0FWIƒ¼Óªá}¯JTd™Å’«Êëå±ñ2Oÿ†j ©Ì)ú¦G½R d’-XNѱ‹fdB„¨àS…= AlƒXÀGL cà˜=¢â ¶þ/¿Óú3£BLø\¦¹“¬‡ÊÌø£Û+¨gв·Eø†‰²UËLÔÖ"_¤ójÙM¡2N½²©`ûp…QÅ(c‹lqCt•Z§‹+Ja8rØÅtsŸúv˜:ø\•\…”ÔÇlkô×®¶TéÛê/.íj4Ë™˜B15ìêQò|ªv# ˜¥ò)Aùsü1 ì‘êY%ÿxZ¾ÊÛBV¹ómúmŠ€Ts”mQ±5‹Æ§«®VKZá]sSw-*ù˜e;ø¥¾D–<î± ·9½5 뮃/rÖGð˜ªÕŒÜœW›û–h3D[7fø¨±+õ/¢·ƒïÈ7çønQvÁ@+ø›ºîI•Q½ßõùŒQNy—ûÀ”w‚½±©–üÈË«Ô}-±FÀMKÀìÛÐrUŽ[ÉØœœ¹´ áUf¦T+‘§=8Œ#wiÒÊkíÖ‰“^Œg­?Ë \•.ÿ9å|Î?„_¨æÏÇ¢M}v„ʼn·ÅÔ"rzÓ‹ê³3l {º•nJV¢4šWƒeÿÿçÕÆLR2ÔWõb9`)öE? X¸W¡(àŸe1iðçÚ ·«)5§[,TnNìVº[Xv¨m¶V»ï«Óf„¨£âúBs\½ZDRìUfZ™jDɫꈙV3åÄi³Œt qY«ôY~ö¡­KÊ©!ÎÂv¦&âÓg­‹šÅQSf'«Ï„D‚ÖØlsн{ðe 8MGêú®­›5é^v8Š·î»¸?†LÛŽÙ<¶Ñ&cÛL ëÙú¦òùä^(' Û[&Z…û[_’OÚ5:gìµnªi—#鹺+Š açý].u»ÏóîRXžsGM0Í>ö ÿµWøïÎl¦ ¥}^#vÁu»Û«=åÖmºÙò~ÏœZõ©_­úoß”p!é6¢ÉæUýeʇÏå‚—¥ <¨`.ÄË~ŸW1ÔfäÒu³ ÐzÊ‚µS×"é®ÿrá86èh²àÉîÓ–É=ØI%?W<ꤚ ¢•ÿûÊùhöDHÞyS®-´˜løØ`‰e:³õöhÙ nŽ®3n<;)#XŒhëÔ– õ]™ 5IBt«¾Âžµ×OËŒXF+ŒÀ>寛=(€ä>¨ SúÔ;µF‘Q×è@Óüóý4Þ³†7k­´ž z‘å ¹¾†©Ž(ô‚¸  PvœYx´]ÊqéI{gOkK clð¢Ý Õ”v‚ºVl’!' ˆXmêT›c>­‚šOytØ*¸…âãdØõ,z‹W5ÁÜàÂEüæëQΚ‘Im9g«:I}7¾º`g6-šµse8ÊB0~êìÒþÄ7¦Ä1G¾ïm)¼{xè‘ QÙ¨ÒxÄïÙ‘5=WÕ”·9¾Á–DVÏ|Utþ‰³YƒJ„qãNC´‡1fLÝÔÎÔÒºúà~ÌD>qENB¯U`"{Bó÷Ê]-ÁžÖ]-«­ï:{sžT]þgHdŽÐM®íÄ_6|öýÝâ½gíªwQ¼Y\õw{5²·6ŽEÄÜ‹qµÀ¤#jý×\òó'17?ó¦/;ÏW–>ÊË^ìõ×V7]']o{ýß¾ 59 û_l¸Sº‡hz+/ÜÛIhŠ[G2Ÿ¨îZë×öèÙÃ2I>`µlS>èƒQCÿÐhÕÉÖ0²móâöKöÔô6»¢,ÀÕ' Õ…ú5ô—³pëf–/òdá5â‚’æ*û€\κö¶êQp*o3]½‚3:ˆZß9=©Wí'Y⡳¢»]˜àš˜€ÀÁú}XÙ"‹±è4`„­Ü$'æ| #’kPnps™ÄžßEù–WOÈ=XÖ²z‚T $~~ŒÈÒ¦Z†tB½´l`(/|—¨c8ž;iå›éüF—ì¶]QtŽUWGµ)’EL}^¥I!³t}Ã+ÚP~,˜^.§Ì½â:ÂßuœÌ a+êìDF˵²DøòÀl-ff@7U¦–wK›vÖ<×zÆð›P[¹úµ½[6+LµÝ±@D¥ŽHüRl»“d›½N+×ì!ÏÞr"ŸyJë}é³è(ç×F#p²<‰Å¿•V%Oðm¡uýÀ2Z$—×2Ã2?±ÈÑ]˲ „^Žäxx?ñwmžõ’ÏGFQ”œKžà·ê%g™¥±‚ g]å4=‘pŽß»¥ôñ‡ýÔ÷´[ öª…2éyJ$¸Éc´´=—tð}øiZ¤ÛË“mL ók¿LŠ}*ó›Q„ ºqSêóO*†ÈËDkÆŽ;HHûE#@;Àë–`^8-¤)êpb< ›i{“ùð«ÎÞ”ZÙoyöFåEî;_+ПŒãð¥žùÔ[ùÑùZyŽŠ4¿íŒWãõ)}z„e,ýkKÛ·>DGÁr.ÿšT6 „lçè9î…Ö–ÃiRuµY—+ñ¬Ô ¶®¥²ôè7PœD‰ ^ÖôÉþø”›ŽùLJ˜íܤ«&³Î¦²ƒZcOuyñטíd#>ÇlkãSu‚™îÄ1ÔQÒ“Z‘›Û6l|vûT1~&®ªlrAó“#“ŠÅ®Å4^ZÆiAZ]æN*çp·­T¼D45}³ÆŽš3I|òv0ÞU¦–ÜueŠVSœ5 aËîœwj©ìIÉ÷íÞù×{È×­ÆÏÀÀÞ.OÆLbÙH­~9Eîé›–ÀýªÝû¶]ýs£ïëöÜQ¯–Åy<³Ð¿ž“Îh¨Ô©˜?¬—?<jˆµÞÒĘ𢦟»R‚YAž? Ót}ÕŸ8ä.FUÅrÆ»Ö$-ðÃwûo‹ä2Î"Ca,ï]=uiµ§ÚŒÊæa‰ì61mGÛý›Òùùûë$üûdù« ˜™ªG"bSþEŽò ïʲ âº~ÙAQ|z€q\°ã«öaHW3ïDXÖÑPÏŠþ) °±eýhç.›Íò> stream xœ­[I·’Û\òÞ±_ ×æ¾äfg8›<9998–% ¬Ù–Gùõ©âZÅ&ߌÃõôc“UÅZ¾ZüýIìò$ð¿òï×÷7Ÿ<÷§WïnÄéÕÍ÷72ýx*ÿ|}úìÀŸRíR º}y#öœ62o㌗ñÔÞyuò"œnïo¾Ü>=_Ì•qrÛÏX¢½6›;_伕ßZ«w!õöÅþ51êí·ç‹ÞSÖÓ >ǯT6Ò·ÏÏ¥í®½Ýþ»” \Îr÷Ni·ý Ÿ¬rû+îï­±Ûñså­’ô›[x´bW@Ê`)ªÌö|’uº.•@U!PZ _‰ÝKåEÛŽ-g4èW™Áå¿nÿTD*÷h­B‘æË'JŸÉ‚2.l²=â×cüé¢Ýt„µ/`m9Ýøí=)Ý.tØîQè*FôöU—ú‡¼"„°ýû\oå|©wM]Šç¾ÈR÷@ÿÎj1ö­´sÛž ½u ¬÷g³!…£¼j²Äv£÷Û[| ×¢¶Q~Äb¶wð» »1u'! ¬„—@*¨Å×p¾¶ è×ùLmƒ¤'QRø©‰-Kè{M–âשÜöË$ÃàŒ™s€J ìÔè³ÛwIT&úH¿þ¾¶ÚÅ@_–{ Òª,Ø ˜éÛ’—}ƒz¼T+¶_à ªgà³Ä¨è7gT Ú"ªYR—,LeM¹ #£Š0s‡¯EˆÁ긽ÉXï¢o¢“f{™,NhUö Y‡Ÿý®5eç¿À£AçëðÑÀÍ&MQ¥AK,0«v£¼#¤}ÈcÑQgM²ÊéEzx+df˜¨‘˜rÓ·Q%”O´ ±$-„ä¶Pxw> _ÿðAÊ@U˜–Áï2¨º!œrG¿ü_ß‘|žP‰VAÝá<滕JCêr½£”Ñ;%¬dÙG¡( Œ¥(Pl ˜ZËQY^"ÛÜ™_›™ŒpÍÝŒ»âõ lË„'¿ãæ1àm>·Ávä·Í”*YŠŒ»Ñ±Z ç»L‰†Ç—-Æ0O—ïMá) §«ˆ½WÅÝFªç“Xéô'fuEc%>¿ªÃT‚ìÖ­‰üÞ…Ù ‹˜PYâ4’˜ã”2'ivm\ŠS—*‹Ñ{ =ŸÂÙ"B8M/Ÿ» üfk˜°ì5D5P7 ËAH; À—I ”Çût].ºú$e9…lv V.AIQ\Á»YHUqwFÀãç7·¿þ²Fj´é×Ä xíëŸÖ6Ÿ×8ˆQ?ÁÎh`ÊBýÌ+<Ƨ Üݱ½ïñQú‘4$’t³¤Ï&šì@à"<¸¯…•bÐ0a· Cë©mG(+­èƒr#›‰.84zŒ9VíJaÑ:€„#ÂH¢ŽKL#ŸÇ0s$þO7¢ î~ú¸¦{Ã=yP"ˆ ãZ‚©ÃÃAþy>_€Eüý¯Ä<η ä‹^<¹âìË…“m¥ÓÿPUeþœ€Å#kÉfݶ?$ƒïŒX`Ž{Ä  ]úpȈ¿ý⌡Zx7* ÇŸ<7Ü*…ØMõ­/a¸8¼?}Óž~HOh…?´w{{zÑž¾jOïëÓÌ€ùy¼LÁ®s¡®Q¯@¤àS®ÐÿÓ@§ÿáqN"d ×9q:ÿG9Qv1–(øÂK4}Š‹µMŸ²ô–>~:¬»£áaØ,kÚLÆ €Ú»„ß •3Ôå|×Þ=´§»kRÓšÝÿ׫—ìΕ¤9Ìó¯ É•z¶› )úÇÓ°°jùZw‹É™8 NqûÝý/ƨ·%Gs ·!ªwÖM`ù22¡ÞÕTP"4Á,ÈÉ@z|È‚Wl ¶fW&lÙ¬âÍщU¿kVqUÇá¶4±4æýæ]Uëñ&IËÌÓDâÛ,Y°œ†»–½¨iTËj{˜ÛÜn_ª#¨Ç„­óÚ•d¥s4Uiùa…$€e·Â¹qX3QÕWP2ê^(ùC΃Œý¬þa L/RÛÝ I^¯ñ<ðX¨ªæÆ k5hž¶r™íõКè\ô vëû÷ò\\)˜ò¸+Y–¸zŽÜºhÞãN.ÁæÉrVI¼Hª/ÐMK7ýúÙM1SL‚kYIÖ´ˆ©J±f+]G\Ö˜ÙT*3Ÿðx¥Øb6 Ë ¥_k!q¦ÕB+&"K[½ÃSø·A8 @‹4×*ËŒìA¯­~·®—ebFݯ Ù LqË&‚ˉç€@¸È+FÍ¿RÈ g2 E8—J¦G ’L¯#Î9L)@)à•|i@ðݹ–"ˆf·Ö¥G<3T¦- ATv × U‰±‡Gìâ;bì®ó9f£Vj©†Àš-#¹ ” äÝ ¥#´ÀïàúžWtÁSÑv¢Ai@ÏÐÊô´9ø¬ìŸ@OŽhSà!'ÿ™€aX›zˆÿAGú x1j—‘&œ37#>¤È°S?byž•<|õ3«¿n¾‹Õ@Žu × wÔ;…é%Ý1Z3äƒ jd²aU¸Õ úØÔ 6ILŠûÔVÞêŠÆ´¨|Œ¯ t$«S.캴+àÅŸï9`èi訆ðÑÚcç©Z„'$ßѹZÀ‹±lZq»Þ—š"xx%ao²–wñ%aDþÌœŽ:«``& ¡²åˆÍ1¾-øwÚ…2»#‰åáò³--ºd0Îg%„Š€~ü›Hz¹¼;ŒŽMž¡%þAÂU§áGŒØæÔ«jÈ1!ÂbÙž#ÆÅ—J5CœÖÀ*¬[8¨T0TzwÝAéÝ p>€ Òrëá”p<ÂöÌ~¸’-”ösq4"i¸É(Çj0Â…G˜Ú /ŒN*§ÝöPY,düö€A”~-×Í}JæŸËçàZ¤5©¶¡bNW.&BXK‹ŸâV€ÁdwNàh±Qc€xn¶/pø' nn)»Ž}jÌÉÝ#<}‹I¬(“ÄYÙá’×j õí[|ë ¬z .PÎÖÏ´Oinf½LØ5­¶àaJäûNÙ·œ†Ž’ñ®}¶ˆ©­œßûÝÕ® N›Í+/;iÌ¾ÉÆ[3öÉnAtðk7]~ï»’¢ ZœfÉ3ó‚Ó›ô¶3+<“»þN§A52ˆDùê.`êú²Òä$™Â³« ñi‹:cBzÜ ì?çÉ]2TqìÇ•A¢tµÂºåÓŠÉ£6RÔZó¹Ž^°ä‰K‘ ½@Ì¢^ŽÆ)’¾¢¸íèͲ1µÂX+-~ZYE䑚QíÑÅ£9ØYàB]ìsrÁ•ó§OÕ!vež†«1{7Æ·J!ûù¡²äÖ.º–ÉÜТ»üý+eý\ÛÓ‡‚I¥òŒ•k†Ú´Ë4gˆš<+w‡M“K{&ô6ÏÁèí, é䦙Æ"6K÷ꤱvAOe¦‹[ È+ØøÐN_'´Zó"ØajÊ+¡ó.¿j»LóYømÈqæ®L€Ì­àPÕèZ!ñ±s‹fý¹¾¶Fût“,d3>ë$ˆ¾í³!«àr¹T>yÁò£dÓ£ÃîØ”8ãÍ‹š#¸[x=Da3ïÇLVù²HÄ—Åbp/‹×šøÍC}Ü 3Åæ%ýLc188­χ|:5ÇJ‡†Y-sµÌ“ µÚ9Š¡Ú)¿‰xG²Ãi癎•”¥OkÉ£Ë~•ÉåCS_ääw•ßti!œyÞq¨îxŨúèìP¯õ2ÒEÁ0²ì€^-W#62¦éjáç»öôv˜’x¼Z­³ß({’ví¢Ïëz¯‹Œü!§šWe±v@­à©ÕÈ Ïýê²¥3–§¡¼ÀZï±Å¤h0sR9`í¾”>ñL¶„Ó[R™í Ëtm´¯÷ Û¬±eðk>=Ls–ÊÈa †ŠÖÎêÑíØæj¶í}šå½âÙÁy㧉º¹)=ò¼Üï!4ö ?^”Aê÷ù]uêI©Ù!øª3WªØ'¹ÂÓÚo•>tAÓÓœ³Ñ­åDéíß`ž1»Èó°Â¹6:𯋑*‡mQž’-z?dž™¥zåâ«tÃÆƒÖ9Ýaø™ ‘é€*3·$;c!¬Ç"ŽbRÓ^3¹Ž&q •¥í‡¡ ¼I3oh÷pŽ Åt€Äþ9öl°}2JÇ º1,+ªR„Ág‰Ãܬ<ËY&¶¥évãTsڀГS+?àI#ÝÀµ^…@¡—ÒÔ¹4‚zFÇ6àÿãÀ˜@ÍSa­µÍV.Ÿ8£ØIëWƒ7‰±8´dÓ„ÑËø@{ŸÄD~Â/ÁfE /ÙÚC¾ÍÿžQ´”‘Ùå9X©0år*£Êës™W–ÚP¸=¸«ƒËmÅ4œ!ÙEãM›$wëFDY÷qC «úzè_e0¸’©Š< )"{É‘öïooþÿý endstream endobj 240 0 obj 3611 endobj 244 0 obj <> stream xœí[I“ÇÆ>öÅ7GèVÇj›*r_>ˆÅŠ>Ì0€0ÌÈ `£WY•[g×Ì ¶ ŠIV¾%_¾ý5/;6òŽÑóŸN6רîé« ëžn^nøô±›ÿxtÒ]?Àü•óÑk-ºƒ'›É;+:Ë\wp²ù±WÛÎjî{—ÿ8øë ,F.˜%`6zg¤â£,÷]ÜNŽÀ±~½Ôè…6²¿·å£ÕŒólu‹( g´ê¿Ý Á¹¶ýM|çœyÑß&pa˜úß••ÈqŽXz1ZÃûƒ--–éþÂʹð†-F!TÿݬY0Ù? šK ®û¿W–I•ïfletïD¾ƒ„\KºJ;œI²ø3ðÒ‚•¸º´|•U£I(ïnŨ Ê‚¹ŒåïÓî ÷Bu\R™Z9Œ…Íò’ldÞpÍ&±ƒ#iœ°½ Ê".¶ùvðÞŽx2~£"§À!åxîÇ l ¥vË¥?O2ÁþYúž!xMú ÀïŸÐÕ¸T õ&gƒB<ÂÒX+™!°Y†7 PF2™Þ&=­ðÐ5†åÍÁ~\tŽ{ÕÿDwçVˆw“´x´Åg¨,¤cquX‚Òàæô&Ê[?C¦ˆCÝYǹ+P¼& fÔÒâò º;ˆ)§Š³ #Ryå¥FÈ#!6ÖCuš\†Û«ÒmGêÀºƒc(áoéa\±eÀÅVÚáA$ÜûþO¤°Wo[6d€‡ñåì×ĘñNñø*nôÆHG‡ÝHÏì:ˆ•I 0ŒnË-^4ôŸ@ ˆ‡=Ø7Ž/ìéùäÌÑI4§G~4 Ç;5ª„^œÃõÆwCòp 2Æäµjy•%T™4$(Ï©Ý:ØÜ߼츆ɼ:'Äl\g`9ä©J®ßÞ\»}·{}öæñæÚß;¾¹ö ýïú½øãöÍîÊæÖíîþÞ0ãr–G2iF9;“gt¦¼ž#ŒV‡waZŸë%ƒï6¶¯¶î!…ÓQ2-.ØÀc2@R—(`1& f‘j¼8Ù7ïE  Ig'‘>€¡À_8ÞP¼‘8»a>{ü›2n9œIÒžÞ¸xëSº󞻦öÍ*^€Ü¯”rÉT J˜ÙnʵP²¥|«vv!;àÓEY›…;Xµ)s6Ülbå%¯¬ú xÒ̧œk•—²ÈpÑ‹,dSÆ??ìÌÎìfµ5Þö¯pEº'‚KÖAê0ªIÿ"öNKŸ^a×”'fÈ)¤)„åcd±Vþ~Ôž÷ÿç ~ÉP€óðû^Ò@ÓU¹G±@¡^¸ã ù¸†¥ènÉ‹òp×W”Š­uàX!¾©þˆ L"éê϶BÂ)j…›,`턦ݘ—…Í™V;J)ްg‰ém⣄|èYÁixÉjY=­H„W4Ò+Ÿ!yÅ'š‰ª…âÍxø»xøû¸w=®îį·f:XÞhß{÷šÀËÞ ~áÇkˆ}‘!lö½Ü(ñü Ásºïíøõo½DøÛY½µ¼êÑ-kÕ›o)Q·dšòÉ,òígi‘­sÿ·Èc‘ )}6·®\­ÜehÎ: »—‘ÍË,\ÿ´^2 [ägÇñæ«•âT–¤ê¯®|P-ä) šÒÆåðo¨€—p¨ÍL—S{j?æ2­0׉húù7‚àZ •#*Å–|jïî1­™‚0Š´U ¼½ßcIåæŠ[¹¨ør`0Ìçì$ÛÙE¬„ú¸’æ²`3õ¨‰Ü®ô¹ªælfí¬„¯T\’ÒHWÙngiu-¨Û1 mÑN=|©·Q[=çzO`»ÉQ«ñ¤ Ëx§Æ“Wªí¼[½¾^Güvþb% ¶êØ]9]Xô>{° ïP‘âhé\…æ#úÒN§¬…;\ÄúŠè+# F/Q„Õ’CU—9e÷R3²ÜÌp7ÛG€¨[°¥”¥c|ƒ2(Õ®ÝN÷,üq¥Üd;ûÚ‘SÉ ë ö¬æ¦Óm³K%HG¡¡Û9½óa˜d:.²˜™|XÁÈ¿Àyï*þÚU 3y€l'ºÚt›j¶N+›CÆs—sSàøòF‘Œ[çBµ:—Qcšè­áÊWÆ‹Ô?•ñâ4S|?ãE¡êñ¢FÁ1—¥7ÂÔË{³Ï¿ˆ6¯%3Ëê48a«-²`¨^è–†`º˜ÓtÌiÒÁñ¸ÈA–ÝG5‚=&µ>Š,mæ]æêR2—Å“0…¸/?…ûEêà>îHTSUŒD)zµû;ù¤™U˜ë#Q&|óÙëÕ¿Œ8v”‚I~¹‘(×pô~$*§Ò¤5€)†dlš Ñ ä©§ã‡áÝ–x_Wja^#æð9A\­¼PÅ¿ÈÇ^çñ¯=,øâü»Ô;B^ˆjGÛf¼_WÔšxƟϺŶž+Á5¶Û£ñ¡9¯Þd¹W-³H²[“…³ÕØ«‘ÒVåYGY¶yœ~ðS» x|µäœ<”¯ë0| E%›Ë,Ëò,]ÍN¦ µÈÙN›éY"Ör/uiôç7Î:ºhó¼áUóüM£yž¨=o`©§.{Ø<?ƒ‹{‘;ÊÒg„ón|ê†gÝxPùdÝøÏ¯ ¿®—{¿ÔÕ?¨é¾×!ÅløïWùs g²e£ÄO?dû¬üD:×Ò³Ë>?ñö‹ñŸïÔnOöüÅNíj_×V‚mé|[[wµºðŠg ˆ„ô"SÀªk‹ñÛn|ªåŽcÚ¤¬h,'.ÑÀ®~ð+÷ñ@-8çñ•ï$šÒóÑ4Ä;À^Bïé›d©a(…U£& V%> stream xœí[K]ÅFÉnþA¤,î"‹sß“~?,À!ƒ ²0ÛŒ™¿†`ÿ‘üÞTõ³ºOŸs¯a(B,hŸÛêꪯžóbÇf¾cø_úÿÃë³?fwO^±Ý“³g<ü¸Kÿ{x½{ÿ&À?¹˜¹`vwþøŒÍÞ©xÜÆ(Ëý®|³bg™Û_Ÿ}9½·?¨Ù eø4ï0EZ©&³?ðÙYÍ=~ÕZÎŒËéó=ü_y/§ûûƒœÚÒ >ÂUÂ9íé×Ïö!õ,­ž>†á̹€ ‡=Ÿ­ÒLŸâH3ΧOp«•ž>ÄåÂjÁéšsj6 å¯0Hjú"ž¤ÌS9P•äZÃ*6[.,+Û±é,à]/è<ÿ×ùßKùìµÈÒø|L©ìS‘QʸI–a\-]}PÊîÒÌNzX{kï#¿÷^‰éY¹Ï5Ò(¥UžÕsn"—-Ð{[˜øj/f©¼r#Ê…‡Y †ÿñËÌîÕô ’Àa[&ñé=ÚàÁl–Œá”õä×{53礞.qsÖqîšÙßáÞx."=ÐgÍtE§‡«=*­àE%Œ`®Ÿ™Iœ€-Äô>:’Óópgå­Ÿ^€‡}„çw|zˆ××B«–²x€a¦ý€‘—ŠñÙ81}”;g„+“µ5y¬fë=Г˜%5X·7΃üÝânþ¥èn„/a•–¸×MÜKÑ‘|Cy‚ °³‹)ÈØp BÀý¾!û•‡$÷  Ô4¯ÒP ëíì ^åI*ÌábK®¹à˜Kê̤ OU™Ôp”ÞýÏ–1Ï·ˆBÄ5ÐMçÖG®o’6öØJÈÁwÔkŽ áÞF5õÌTÚFÅ{r±;p úÅx¼îW¬1Žé´F5ªÐý™7¯a. ªyFH˳òíU?bfD‡FuM{~µð<tÛÁ#NÖ3@Q;Š@HX"Q.¸±b„~VŽ~š% 3DÕ&cl‰F͈™_ï³Ñ "T5;ík¬g^ð‚=âÅÇDÀÊˤép¢ˆ,Ѱ5‘­Š°®èÒÂ܈€6Û‘cŠÞŒžl ¨d÷â̤Çѳ2ŠïŒ`Ö½xû$2¾â@Ã(æ¼#D¸p-ƒ !ü}BxÑvV\lIxe—Q×ꎊ2·ê^9…{%à Ð@-q'jd£À¯º·=¦ìñmÉTB嘞zTr{¼tA]BñÕ£Aì…°"'Þª¸¡ðÞ8O„íM0o¼ë¥¿ùÄ /É´>TжJkÕF²EÕÀf‡+zvóËŠ¶€=ÖÍ<­j©ij4ç ÞÁâË+ê[a›hØK< ˜¶ÃÏÎûÌAòfƒyo«êŽ›îØó°“•³£‚ý,žÈÜšÙ:•õcëßr­%Ó ½½§ì£EÅw­õ`ŠÓÜoÓÇ8¯Xh &“TŠ祤fă¼âŠC³äwèƒ3<6ØNMÏÔšž†ølyÒÜëâ‡ç¹„z¦i™Óe:Fd€æíÊÌ?EŠ…—"`‘$!Âìàau5z_CløçÔÐowÍô“-qÿB^©ìkˆÌ7Ý Á)Ùš€ LŽb–%‘# ¢¨ ZûVþSñÖࡳ—OE*Ìd€¬‡¡9bF5Ð…MŒGMB• lŒ ÈúUÔkU k÷(s/jL4Äá߆Ài#ºû} '™æãø¢Î¬{µ˜4BðORCDÛ\î1~÷ˆ!dÃzÈ•FŠ-$¸pYâŸ" `ÆsÔÙh‡Lj÷cTÔ»!ºôQAvËìw:`éÕTç5UŠj;dETQUYq‘Ôrú}EÉ”ïËOÇŒ#\i5Ú"|R®´:QT±ºg㎞GûÄ:ÃüÖ›uü-mHA¨–`}‡NHŒôæ(“™ZgrK˜Ÿ58Q|“°æY&º$—»ƒ¥K:£Ò£mÄgç"¶2ðÉ¢ êU¶¾¤>K¿L„×9«Y(ÌèIZo{l¥Uƒ³ &¡wAk ùªS¹íèùµ  ®&W“lVCµÎÿ &HzŽ\“¬ïÝLÄu&tƒˆdçÊÁš iPòaã¡E•6É=cè ñNåß:tƒ]?„ðÅ u7i‚åíÞé&·GgoªåèJ€@ê-`ãàº8’]ÀÒ›­›±5Tç‰s®+H2·f#áebªCp rº-1·‘Ôç=xUzˆÂÖ'lÎK£›ÏrzÁlš™Å4³AãÏîÀ;A9*LxT· õ0|^—Å\(Ð|Ë¿ßÔßoQ81,E‹Š@($R:#ô8Tc6 Z…¡SÙ‹l[Ϻ)ŒÒ·˜7¥ùÚ5A~U’°WEY/ˈdkŸ ݶ¦j+'Ìô¢¦Î¿k|™AÖ÷a¿AI9·B¸ë夬 )é„.Š‚I†5}¿È÷éªÑº|Ÿ€C—åwkyÙ0]#!DÏŠø°dfêˆmåâorqïn:92$ÔòÜû@8XbiGϦ¼!0Íd²I¬çZRr´Ð¬ø1Zoƒ Ø_,ƒKêïžK|+Á¨Ñ{€"»&a·{¹ÑŠ; ©ÛÔÅ›ülÔm&gó#¿ uŽR÷| „:Üpu„Â;Ý;§ðÈ ÿ(”Ûª< p]h< Iý®Ìhî`‚;^çfã®hb5­L¦Ázå‹kh­ÀÐE ß,Ü¢ªÃ=æ­ÅŠ—Œ{0L(’U#©Šc6Yf9ñÇÉÌJ×j]i”ÂY‡àæ:·ƒX ¼Eäî«R¼ù®˜‰¯Ë·—}i'Ü#»-£ËòëMùtg¯ÐyÉwVÉó4@óVÌSÄúÞz ìÈz^\}^F—ݼöÛ£²öe=xOMdLE;pYîpSfß’ËæÑ“nÿÈÆƒÀ ²É£2­ð83ññп”ùŸ”ù_”oï—ÑGå×ÒQ0¼?Xü÷òíÓáâüíŸy~G@^ÔôÜÖ1†”*9èñî?›d¾¾cÉ|½É˜_%ó#™Ù:ý(B+)Ÿ H©×ø°üúùà[=øã$yZ‘Š$f( uY©¬”ïѽöݬÇDJ@ˆìIJeƒñ8jŠwor×ÎÈ´h7wUbd@¯$H‹–ruy}MÒPŠkék™É)¸Â&jlªâM*"¦ŸÉûÄ…’'­×‹à•êëw’ñPŠ#Öz“ªKQGpP܇ÜWýýEÈZ0.?¤y|ôC°JA¶BžJú%{æÊ11¾|é=Yë/Z/o–à5@ ¸è…Èÿд`2¤®õõtŒuo-^8f2éRkLòxÉóž0+s͆Õ*º‰ñu±‹Føíëb7Wóº5Ä_É%.«E©2nþ,Œ jžšy/9Õ•åS‹þ©±þfäò©sû…>„©Ãy03’v"ŽÚ,Œ\µ{ûú)¯’’¸õdÝ „¤­ëdèU«ÐÛ•OEÄÜ“R'¦Iüà,U †ÙŠ•"ln‡jb±®i,v-q¹®+¹Of¬¶yøV$Ê!‚V÷%½?äw‘}‡ ¶ô,šØj_ÚóÞ „oÙ}ƒ!ï·Ø§îqY`þÉ‹]—Öà•ü cÒ·ýlo—¡p%Ããª|,q°+5¤-ÄmZñÌEŠŸŒ‹ëY¨¸x$‹’Êe”‹÷b}øµaX„\4Ê|3{×9¡eDÍZ‡jÑìÓt‹u ‚k¹Žfi*˜ØUœ5ëˆ+~vØдü[©¨Ç“[4Œ ]t}“Þ·Ö‡ÆÍÚ™ ›'¹,×à­w9rÆ“ÂëÚ!G~¾ŽO-h·maAð 8œ%Æm#_™YÛšZc6Ò·QLðaTÛ/>hg;­B$¤ÎsO¶CùTØÑÀWV5EÎ7©Eèu?8Œ«Œ;Âë=G*ï@ ONß纪Õc¸ÙûA´B)½±„Ø*òƒÙfï‚Â#ÙñXú8=³kÚöˆ“‹Ÿ”‡†ðð.(ÜÄu7ªŒ ´ôhñNo“hú¥;ç9Z× HÒ4µ†qµÕ5‚uh—H!T×üv xÒ4¸B]™ëç|Ùì ð|w€OœI¨‘mÈdÇ€K®ªþ5Ä"yß2?dÓí¨ða¨ÂÞV$ÝÇZ+`Ùvábš^m†Z} ǤׄÜÀÖ€Œò°Pƒ@ȵ¶÷±ÍÿÉ„â|Mxc5¢•ÝPô>Ir±ÄÑٙǰÞ2ª~ùÚÀÂI‰Âbr+_½·Eà)ª„Ð?ÛiRÕ`ßÐfÊo`¥UÎÒ¿ˆZqÔb%~fLŸ[„"MÑèjÅÉxËì©Ô2ˈƒAº.hëýØf§v‹u§$¸J ¨DIÎà6"o[C×ùRmYÚñ9l}_ü‰B1qÝß åç/ €µY&xðv\|¯ÛùxÁࢬͫߞÖ^–µ}¾ÿ×bÃ+6P.ý_’7Ú§•ƧýÞmýï^÷ ŸZä¨@þ;ÇÄ¡·þàBqÒ4ßÙ9prœªÝ§Ò,\í_óšþ4ÒQ x?k.ÇQ`…éèµÍúö,kñ¯·×Ͱ…ȉüñçÒíè±½ü¯µ.üÙ¶#8÷è.¼ãz‘ÓÛDw8‹ÍÊR{O¯1Ì74vö/ªfÑr4ß½º M€zzÁ31ó…É1)¼ÕSß[aÄbɺ7n­†Pfɯàn9·Y?;$ʈý¿ØLc>/£…†Õ‰8º×©bÈÞí«a{†ÌC%NOù]Rl(¨u€!÷!_v2Ê<Ý/Qf¤õÔ¸¼[ë!|p~öøï¿‚8õˆendstream endobj 250 0 obj 3738 endobj 254 0 obj <> stream xœÝ\K“GŽà¸n¸ ·ð´êý8p°-Lø…XG8Ä®VZ´«ç¤Of=³ª«{f0F†ÐaËÝ]UYYùøò«¿Þ°‰oþK/nÏî=´›§oÏØæéÙë3^nÒŸ‹ÛÍ'çðü'ç“×ZlίÎbO¾±bc™Ûœßž=ڪݞOÎjîIó¯çHÅijؙMÞ©x”Á(Ëý¦<NN0bõãÝ^M^h#·ßìød5㜴àL­¶_íö0çÚnïÃ{ΙÛϱ»° „úÞ+3)AÇœ éÅd ßžïØd¹°Lo£r.¼Á „“jûõD³ äö! ¹äeÁõöw0W–IEŸ±È¼_¹£†ÜH»J;ø¦êâ3ÀK ¢”ÖÉúUVM¦ùåNL TÙGDþ¶>]‘~Ñ8Œ=š8UÞ »};Á'fÜön§&ÇSÛg»=Hk•arû>0r²Nðád½·vû¥¾Œ¯93ÛkìÏœuœ;œ¡ öwÐNLèY?öq´Ui |™õæ‚÷ÖCèî&­·/ñ5èJ4Ãã§d•v{ÃK ö“ÆTÆÑµ~¦¼FA ˆfâŽGUªF•ÊOb³—Ð>Ùœ_‚±+sŽáxز0Èßʳ7¥õ²¼ý¾<»+­ëòöEy¢hé'¯ôöª<¼*^„–ç©z`åå›Òú˶ëѶXéüÑàí«Òª~Ô=þOFïr5Éí¤6ç_œÿúQꇫyQ¾¾#Ëέ§åí¢Ð½ 2H?9„þ Å$­¶ÆÛ”–¥÷Ym ƒ¿E`­š¼¿ÂõûI*G&xF:= z à‡pBjÇéŠHBÏ;"ý€_—L†ÕÖp- ‘‡u€´ÆËh„@Ìåä}ƒ¹ÄåÐà+ë^"R'Êý'¬Ê9ðT؉C3Ú ¸‘lµŸlEd[aR´Rƒ­d˜”žÑm"¦R1QšÀ;p/ÊR?ŽO‹òþÆ<$@Mì£*ö1| :±¦4jB°… Ô‹-â¨ÖLFº™qHÃÑõÏÐ{«ë béS‘juÁ*TîL½§s”(nE:¹· º/h:FÀbÍØŸ÷P7} ²—kþ4á0@vd@eª¹7$½ †3J‚[+ZÃÑy‹ÍRò.:÷‘€ôÏô¬pIÓ÷!Æ)®™!^³§¢!W;EõCav+¡U·Á Ôö†Ê=›AùÝ­E£€uÙÉÁº¢raDW_ìó÷­â:ƒÊƒŠ©ÝV{«ÖØF|¡C™¼˜HªC‘~i²&ßÐ^ï±úƒ‚ ¢RïhG—u’êÀIJ§›\4áÁQA̤a"ãšr1whÈÉž|¸ìרdÞKN]ShVãÔ¼—8¾˜„^ 3ÃYIs_ 1ûºÇ£„—C´€¸'4 E$óQ§,ð1H 7à:‹Á¸n ®/çß*Ä0¥ÆU*•3¦‘"ëÐðl H5Sý–à¼wržÅ¸— Eì’¾59^P9³Ú@ÀYæ&UÓëÂú•³º MÖ¶¿n‡k7-Ç !„ ©”(ïõfyðÈÕH3/&À¢Z1®¤Bí“Öö¥YOÏJÓ b«Ë˜| c¡²0 Ø*vØÀ{LcV§:K}³¹¢_¥Øe¬g¶ dña~à³%!†ÕÉC BÅœÁDœFÓ]yÏ DÅ«•ÆÒJ ‹Ð6ÒsMÁˆ¡61Žç2D«ã©Z0oRq‘ 9¾í/vç¥ Hg)Q:™]màs4šH \37VŒäÔ€Û úJW$Yw­¬mɤ0¥Ã§iaa’…pÄDÛ8Lu’gÕqOVƒ„òÒš±¬¨T Õ_?´–’mt¡=ÚF E4ö7Ä$5fÀØýoÏ­¬W©Úò&Hhõ@lÛˆM’ϼ‰ÉÛ)Má "R%&0 oÞSK©CǸ¢ÀÕ¢! \Dš.b' ¶ÔùÓödãðÑ€7"žKÛýs\6„w¦õpòd(œC¡=Or€ ™*Í0€_—ÐGê.î7!LŠ”f—˜è(â‚ÚŒÕcø2.ù1’A<XqÖ¹®1í&gÓØØ¼(cžÛ † ¢üìÔRŽöJ€GÕìÕ¯‚z%S~xFÒZÃeÊåz8ôãì eE!h ¯ƒŠk¡6B óö™ÛF”‡à>²3´‡Áü¤Ô ¸öûYkŸYA…• ´R {Œ¶0ú É¢:ÑØÖ‘,c„¤ŠÁ´‡1{[Á{Øri2c£’ØC¯Úc¹!  Œ™ò©o“j¤žV<#ROò ?â]qÝR„Ô¾ˆ×´tIºñ‰:Ø39z*,´qŸ1H«ëð|7§¹kÔ8Ó‹¹¤­ë!¿¸!ÂgU®–"¼÷ê6H%röý)~l¼÷*ÕZAÂ[Dà2œÎ‘擆-Éê]Ã=sÀ±ìÔÞåyS,@ ù¿¤Æw°N€-R/+$ú[,9¤íQšCª #ºr¡©Qô*Q"ÒŽ¡±ÊêV]@ëΉF§ "èí´ÊŸ ÑžìIÈáÑfãk† YqkŸ&êÉÌâ4ñÁ ‡Þú‚t§vu`=›¾)­zñâmAoW*8¨ƒB”0>zb êÿMCÞè–ëimYC:ƒßñ=X¼x ¯ ½’Fª…´Ï'!]–í±I[Þlž¤]!S[f>–'³”èˆfˆ†ÞhŽ‚N²—#²°9"' CBp ƒäas “íž:b»õ¨„¸9”óŒðˆªâ˜a5ÁÔÚ‰'0jàQŒ”s<7ü^Æ¡XsNóÜ0JÔAÇ®ÜW&` –pn2Ö~~tÓ;¬‹’á¿*Û>2|3 éa£Ô¤ÂßÐ¥#9퀣½>uyk¯±øcÊëD´ŒƒOSHôG¼Z‰]~Ù׋-¡$C@X ®uD†OßÞ–;ŸáCÞSà´à™U–^üžÔµÁÑ›.¿éÄoõ/bz=Z"æK„—@„ó!´‚bVdâÄI®F ÆMóuþ:ª²‘å`àƒ3ñúˆ¯YdXlô—›Ç Ü5{Ò];–•¡Ûðq€Yu Rað1¼d:œ\(µ©²;¤çÌd´Y&‹ºáxÙIz…ÇãsO‰™J:xÝ$êZÛÕ<…dVø%‚Ÿ› <> &ûFÏ}‚!*gpÙÚíÍÒ‡v®aiFW’x*É)P9É‘ò=ý•ó]¨¸ôÚ9f_ •¨£Ã„WhÝÓÕ©á÷#\®,@™£9?LJM$qï'ÚŸŒéÀû«P…¸¢ uÎ\â¨T¾Q1Ô]É!I-íÍ¡êÍ™år4íá("¨xù&¹îŸA.ûÒݼ…PêðHê]¬Ä„äÃëBµwJ[†ºÆ4(Hsî{)ʆå+R,ä½!Òx*•֌‘%ŽLAÖ;ýøZ(ˆNÁ`5"2¾ DžΨ՟÷ Mn¢=.ÏÌ•Ñ.™»CioW®ºÃIòAáV»Ô ôՠЦ~›ñÍ-§z%z9"§Õ/ohIØ,¸f *eUC#ÙûdHn~f&•&×r÷¥5«™(Ä ºí&ÞGTz”-xí{îPë4ò'"HÓpN*Ô9Ñ]®«§}õ^rÆøÂ×J,]ó!³-Æý|Ù¶ßc:Rò,¡¨!öjï{ÍØE„àÍé˜Æ_l| ZcÞpä×RGƒ8Lþ›n«Ýœ ³I‰Øgš°@¼Æ ®1ÚAÀÐÎö8@iêU}ÿ²t¿®ï_„÷FÆ;ÿ˜ytä«Á—À ó°÷ùÛ숦±°ßážoŒŒ['«3Œ¨×pó¦æJ½K»)–qS~®K‹¯O#1\X×ÌÏâo_×Ë£ß×c÷¢ Ðªgp¬ îE9+¾,'É,?²‚2Ô‹K§ÆmêPq®ôíýXF+ÃGu踲gëÕ.ŸöÿÕ°(‘aðyK)6•±ËGeòõªYXoü+X&d9mü°VP–à °+‚¢tGÕôL:y UûÁ¤SÿiÝ5üϱßš„‡l/Ì÷A%<`? ØàO@Âvx„„}mÜä@ì44v·œ6š¯r—vr§P´ðêhQ‚:ZQ\ޱú45̲¼KÛÕž?ý¤ökUIÿÝý’`¿Æºÿ÷Ã9þ"G®…áb$)¡jEذDXN*¬ÙOlâÚIUE‚Ì#7“ât.2Ø ?æwf¥[²e<¥LGŠ©R¯5G†…ÔäÇa ¦&O›:möãÄÁ›Ò…«Ù%›ô³ƒ”^½x@¤¨Uf%qjùÖ¿kÿ#‘ŽgC >8?û#üûùý”endstream endobj 255 0 obj 4057 endobj 259 0 obj <> stream xœí\I“TÇŽðq¾ùÞ¾u[ÓOµ/¬ÅR`I–FŽ}†@  $ðñïuf­Yõê½î0RØ ¯kÉÊÊåËÌ*~ذ‰oþIß¿:ùðk»¹|qÂ6—'?œððã&ýuÿjóÑt€r1qÁìæìâ„MÞ©xœÆ(Ëý¦|³bc™Ûœ]|·ýËn¯&/”áÛi·‡.ÒJµ5»=ŸœÕÜãW­åĸÜ~³ƒ¿•÷rûñn/'c„¶t‚;8J8§=ýúõn/¤ž¤ÕÛ/ 9q. Ã~Ç'k„4Û¯°¥çÛ/q~«•Þ~†Ã…Õ‚Ó1gÐÔl@Ê_¡+*ÔöÛ¸’62wå@U"k £Ød¹°¬L ˦µ€tTÜ óü_gŸ'–òÉk-¥ñ0ø˜RÙ§"£”q[]šq´jF亮“Û쥙œô0úF¿Ø‰‰9ÇÜöUhYf¶÷Ê·ëÒzV~}U¾½,­Gå×§åÛ85é'¼¼(/JÇסåùö<44[V~üç¶4ï—ÖyiÕŽ§eðëòíyi=êúµß”±×uá]n"¹Yb|svçäìOߥ¡¸§eÀK²ßܺ얈œÜkÜ “<(Ý ›Ó¢*¯øIéüeéümùöQiÝ)¿~šÖæÇƒÁ+ß¾Îßþ‘§áë0àÒ[Ñ\©úz@UÝÑgå×oßêÂ_$!Ôò€€$‰Ciàå£\‹^/÷ÊOb–aÒ†‰¨XIç¹WÛ‡hÕ8¨%“¨ÂÈÉ:·½[-Ü5h½–Æ»Ô*?¢V¿É†f¤Ô¬‰‚5Y\õuáF¿É$]=é‚O&F[ À¼É†âg¸¼5Læ34“Ê©íìÓ;ÎÈìIL°¯ ,RyåȰ§q2mÀT¾Ü© d¨"|D'ƒÞÂrìO:?$SÊÙ@ì#µãa¤õ{cÓZÂdJ¡ã ÎÌ'füö {HÆðøHÈ!ÕVXÈ„e_ wp:‚úûÁ¸ƒó2‰\·ÛíGþ…NUxÊçì¹pÂèë”·>1[zŸÖåÞæaÚøGeHúìèE-Ze nÃÀ6¬](dþ§6ÕEIr˜³Ïi$Ì¿[87²Ï×ЄSê4Jy™ÏÌZqÔ™•]"QàäHôLi §)¼7.‹3ê9=c"&O‰ìG d,,)EÀDMÂÑ2@#œêÆühE#‡ç8LáÄìh%¨£®è!Ûtà@,GÖ Œ9ðÇèd+\ƒ ѬÊ)#\BÐÀ›Ò6ôõ"¨ÜùÏ€Z€ÐŒ`(ãÙ6K6•1Ï;0vÇMÞé°§ fKnP7 ã&ŽáÈon¬ÑäáfĈ²YÅÓïw ?MNØoKŽX#G£×ÖŒ~‚p§]EÃÙá*j’Ü{1\¤5Ï:M¾o†œ˜<Ø´BºÒ¾_f”;>ff%ÇŒðÛƒÇ ^Ë¿ÍI¯²Ö%>ÝÞIËõ“Ž=ßëIûîŒÇ¦AnýÐ4;Íj'؇Bå˜%6ÿù )Ýä ÊáCrÆDÊæŒ`s~2*XmÕ`˜6ûΩñöA[±ˆÄý¦¿)ô™÷‹ë™-ÎV5¢9™eŒRPÇ^(Øž RæÀÏ×mÿ¶€íP=AT–«/ãXlVËëÏ»ˆÁ‡€¶kæA¯PP<‚ÑúU‚ƵÁÚ;ã&H´¦ˆye„lõ™cæÁÑ+X›vyž>hÜ[`¼`v<‘£•®û*ÉL[‚}JÒ>tU 2ýL¡gšÉð†&a˜´`‡²ñc݆qxT±Øm¶;Fk?S–Ä!Yúq(K‡8uÛ²ÔÓóËËÒ!m;Z–>¸MYR?[ä!Aúé½¥eüeŒÒþÿPfyé9f(Ñß霡ü¶æqŸ(pq­³#oJÜ2 ̨ó'.¿ââ¶›ÇtÝ€«…&û¬Ž†ØVÚ!ê ‘&‰Ú›5ÈÚ¯q639çò.¥éÓ0°‚‘)¾dšä²gY2J”¤| àR]Š,@“*agšÑ¼L3oMBdܤ ‰HÉïd¯†*á„l誤¿ŒÌàÖÔDM ¼L¹;é ó ­5=“ç÷-Æ-hØ¢’IàÔˆ(ÝÛa\æ%„öO(v.ò‘Ṳ̀ €ºÊmÊT8®E.†àlÑêÆ=î)¿CiÆ@£ŒèðÑʰ‘YŽB´¿W1ÿ p®ñ€áwP#˜ˆ˜‡º4Kâ,k`¿;ïSÂÈeÚÒ³güâjØzéå\se«éÃ(àñ” ¥)8ˆPC"åœô#ûÄöw0 lŽ5dë­Ä9ƒµ¥VeÊòy"Ft®Mø„ ©—IÞ°\Vή±/¢rˆ?Ü@90X²°×­ð_ þúI˜•T^š"e¸´ Ì¥Ëêr†J^4æeÑïÄ Ž_›.³ÊÙÌ¡ÕR.¬ž"ÌÀa&C ¼'‰x* µCÚ/®µÙè¯É35}Z’ÆÍN¨Ë¨ŽŽ» åa‡´(åD'ˆÈ{K:4'šEº'7Ù­Æ8gEjDf®µð; „KyEýÊë–wG(m¹€†ƒOwëh-·N»Y–pfýöx0¶âã¾ú8¯rÑBä­•>ßY%ñ«Ÿï¦\ûë/}Îdp)fÉ`"¬©Á»)¿f«’‚Åc8ãÀR{ÙÉât¢Ëâ/›ÙdsUˆÀ¨Æ[$s)!ÑÜZL‘/Gäûzɪ«°æ2žsàžê>&;ÝW·¢h€Âbé‘’+e*Ä€dq­áÈhÑXdŽ`Â’À¥G½Cú%ÀXùA ÁHÈ:ë&ˆ£…X3¿å âÐÆÅ‘ f‘=½¦Ò1ôHéÓ»ê‚ÙYóÔª+¶'ȯ}ŽER|!2Dª¥SÂÒl²Q#¹•è"A’ ôVð~•íK. TÃdðN×—=/¦r”Ÿz^Z3{Õ¢„Ó‘aËÙ+E’§:Úæ>jg Þ3Ë7Ÿéñ‘ö’£îeÎ´È xV4™ò˜»,éDk¹&ceÅ¢bcKJ5ãì ±¢$Foµ4 "©ŸáuBÀ€ŸGi“pX Ë¥çõ!§…·%>‰È£º\ôÎw.·_<ØÒYÚ#®3¾ÔKš¥Ï"bŒ*¼wõF&Ì™l®ákå[]ų\J›YeåßqùVÄA=튦ÀZ‡®–½n%cèHãFUÙ{“p"np)ëÓ¥š”—}„”ÝX°Œ“ „Ë)™äÆü·h­ ÃÓÅ;Øã ‘Y¼¼Yùºç =n þ³{žàñê¿l¬ÜÂó„xTÚ„{‡@±7~Ň[ãûÄ©Öò,ëR¨éIZD#Væ1lŠKkÕ1Ò<ú¡”º¼ 5©Æ-è°tH剅,CÕ½ñû—¥´lóLݳ³æRsùól¤`3G,,.`6­Ñ2ì¹¥x•øÑÅe!ð9f–ùþJ·VG?×D4Î Ä=o œ]lÿ°;{<»õœß'‚M‚©ªøDñÀ=z®> ЩūÕ4‘ˆ ÞY?F/%@¼p¡ùaµT7æØN|î2äÁà&x'` éþÝaÁ¦á«M#xfTXh!M5ç×Q{€ÝÇØÜÊ|Õ£tn[Îo?&²ç÷œfè(ú~¼NÐQ_b>Ò¡|Ñè Ò|- lñ@9`‹«Ê!e|ûöÚÁ9Ã3öñ5E<ëßãžÁ2­G‹g)Añp®z#ñŸâc"âA^,È·tS9¦ÚCbgªHHˆØç:²\•BÓâUŸÞŠ¥K^ª#ÿAgßÁ¿¹]3uš°?+µ”£ã«¶ÇõÇÀ`É”æÚAщ–›áY:Ì´ â7ã(îB9À]Y¹žÑ—ñí‹L‚²õL«: ‰žDÁc‚VsžëQ{F`!MÐç³²I©¶¾Sò®á~ê“6S¾ÝmsyEP} …¯ÊÝX¨´PPs XNÎÐá0KÃ’Çx›W0h@ÏÛø=ú—qžÝaªYÛk3ø cQf0 ç¡›°ó+Néj”0x…Jzcªg«"ø}ké;Q<^¡ÿ‡E,.­û%üªŸÐúp·’ 墪ޗcš÷j¦¾ºþ¤þï¯-Ç7mFÔ|áþ¥ˆFâ9uÉàÃÿƒñ,Gx÷`ˆ°FJdP¥™O>ìy¼F—DÃÃ`¡xÿ5÷ÅCžÉ¦å1[ø°®™DI„¢vþýz—_”5‹žýiÙR}pŠ1z^éY9Â4<>¾Fòx0-y¢ºN¤È0qtZ§P|·L‰Qž5 ©îÁ6ÈŽÛç°ÁRÊv\ÕkèÏJ&32_€PøÿzÄ-; ôÖ—"m$&SÀÔùI3˜S¹L ·¾Œ×ô÷:}J£(¥Wä!Œy^‹¦•Ë:ænÍ TaKŸ®£i¨Êôji¨#B²ÇR®–Ÿ~l&¤þüöß»rñ¢D¤™Kd\C¸&•Òz¤DŠúÌÝl  Ç¡2~zvòwøó_¢Ö!endstream endobj 260 0 obj 3882 endobj 264 0 obj <> stream xœÕ[Ys·®Ê#C6o»‰vŒûHUâ#‰Sò…®r•Y”(*$%‘”cå‡ä÷¦gƒ™]:tâ”8šiFŸ_cßnØÄ7 ÿ¥¿Ï®N>xb7ç·'ls~òö„‡›ôçÙÕæÃS €ÿr>y­ÅæôÅIÉ7Vl,s›Ó«“o¶j·ç“³šû­);ýs,&.˜ÅÁlòÎHÅ#FYî7åpr‚ˬ¿ßíÕä…6rûåŽOV3ÎÉÓ'¸’pF«íç»=¬Á¹¶Ûá;çÌ‹í§8\XL} ß•™” sNðèÅd ßžîØd¹°Loÿ„³r.¼Á„“jûÅX³Àäö N ¹äeÁõö0W–IE߶Ⱥ ßQBn$]¥ÐTYüðÒ+åéÞòUVM¦NùÙNL DÙ0GXþª¾]á^¨å0ähâRíöl2Þ{8×e'W8«”Vyúø<*2n{ײÀÌ»Òlom©¼ruÿu}áŠÁãã“Ó_“Ï•{µ}‰,p˜–I\B2àÎð _KÆäi]ù‡UtRo/€9ë8w õ;œ[3åÂF$0¡@<—”k°@K"'ö>ß~¥t‚Ž›ëeÑ`Ç”,À»Ž°²ðŽk‘N–{‹[ßKð!{«aÜgT+ÐW4B2.ƒŠ:ÆX0g!øÄàÀΪ—hÔ‡lï¼øœ¨šÍGjÔ·8­CSÍ<€±¶ÓF@ò•»äF¨Ùg%"ÁÕ8¬Æš³ 6sVcÜÀ9˜Ÿ4Ä­Ü v’Â4Tú6, nm³DÝÏSœ H'ì¾ „o’ÇãšuÆŽê“îì,NÅY㼪W%ã«G«¨ñ¢ïq.¼õ?ë°ç;ÔS±ÁĉD1'ôTÈH˜Áá p¸ âùû¢uÐ;ø ö͉Þ]ÜE~È%³µÐ3°ÇÆ«~ÛsÞ»îõÌaG{©<#ŠFvÚšI´:HK‚Œ”ÍòÁ<Œœv’‹@¹@FcIä¹ ã&ÕZ ”€ڹîHÏÆzÐý¿7BÒ@.-™/[Üû°öĘV‰@BcƃŒ! s\¡-Ø[Ãäeœƒ Ùè{5úvò ¥Zk}©öÎg®¼Ia$>MHŽ †„‰g(Y’/bæãè±]Rù/¤KB¾&Ëœ§3ãyh/ªdÉbî(r>vç‰òŒÏˆ$רŒ Ú,Тajï aµÙL5F"àÖõFµ“s®¬<OEa|#ŒªÈ‹ëþ«¢Ä½:)º0™¤Éžî·Q¥0Þæ:Aް‡ô ‰žVgÙÉÞhHÁ˹¼2Ô½Þ•åž*P)5ØJ H^èYÎÐç¶È~ß!’YI Ùô¢Dc”ZNp… æG&¸Ä½ N´*ÍñŒrÝÖ'E7¤"F“$ü*Ú8èN¯ÎPŽô\B¤½Œ:¥@ó\Ö©zÚ\ý¿çDx¯£™AQ9/·5Alr<éË™ñâ¢MÚHÒž©Wu%1BÖ‚É>‚¢'o™rvutu 9$ 6¥B([¿ áq’Vûð¬ÐAª”áKIË\ørî'ÓÎò«  Âk~ž¤F«?š§1R…ž3åE)§i.œú”pXœMA÷Å.˜ÛHˆ[0VˆÙí¾Ò(ÌfíUFE ( §žÒÑPˆDÀw` ©÷\‚:( ,BgR%ó#2™5Ë8a3j%n^ëÝlê“`Š>…OÚ  ý>¼tÖdÔ'Ø×ïo`9øÌuÒô~üuý~Ó0OÌNÕÄ¥RÑÜA¤ÑbWn!´£–Éȼu±8Ê@7‚k.!É…iHô¸,ÊrYr‘‹òD@šóèg BS¥ê$s„2b ö<ë'€ï hO<ÚcÑžyÐczPSM]nLAò¹Üu–f]‹‘1Á!pPİHD£´uo5EnÒéº6B58E%%xVŒç剭à£90~{€êˆy;²S„<½Ï´yÙ©t„.ÀÉikÃZcmyÑÉg4#zLǵø °È}ØR{¦Àˆˆ+ùª}$b¾n8lx9ˆ5‚O”«*Ók@œ|ß 9 Äœî!JG3¯G›è2‚ÞÓtIKëj8",Ž 2Ä=`‹î°]ÛÕ–¡Y²žkut‡“ Ø…”— ¥1Æ@Ìn³r èH‚IÑàM¤œÌ í¾쵎i`£k‚G•—6’7JÞ â ©–ðö@„ÒzTtu*d…¥é(ô@q3I©¥_¦²ʘñĹ1tå˜ò;i8‰£ªØÐl@6›4T'-|p>îºP캖œ3hoØÚÀF/q=•ª… oÎ.ÏÑ‚ ÓËÅÝJÙ beÆ·™#£?z¦ U¢°SµrlsÔ-ªb-2‰V7i$3UU3WÖŠôwmñžÑ£—M0b•l'<E5²¡ ËKØJØ‹¼Îr·ØŸèÕ6 zØ’ò¡Š¥xMl7E^r÷]ywSžj«ê]ywWž.Ê×ëòXÁOHÀúóË…0öëŒ>-_ÿ:xWþ<‚–¤ ÖŒIb6žÙüW}Ô1O€ÌÝåyóÌ׋`û,78æÌÊ.côö 4š¤¿)•óÆÑ|sƒO I3˜éV çʼ‡’Æü\E£„g±Ì¬™Ÿ+ƒ|…ó Mv2''Á°.“ö£¾L®^a¦äŠAù¢ês§Új@x\ÕÊ=ôÒì奅Z/Ø&`ªÎ¦—FýW0˜ó^¦D+Z—»ÕË,ÖñáØ0ix9â.jl),¶R{ˆ´ÜE%Cr|f®VÅe­_}I¯…Q£ø€&ÒLJ|Ó#Ý¢ÙH¼¿58\ç›F×»ùýùJk H#>ºuT÷6Þ¸É×¹yÍU<–ÐÅàÐWîH¥ïU¼X}‘EfÄ ÌÆNb·Vöô‘z¡-Ù^1qÀYlßvPWoÕÄë}BB¹W*«Å[ôõÑ +ÆCÔp/AПnŒâeêùjÌœêÖ«CÏÁÎê€'b|ˆ}’À]ád¬Iܼ-pj½tÓ¥x ¹nS<̳‡Òo¥jn|çÔ1q0×®t1ÏP©¥›¨Õòhs¡!©ŽÝ,½°^ UåhU–€ï) 2hJør5މùuϪ­kúÜç }¾Jöf'ó{[}žšn>,Ç×䵜ØDû;‹|£‘Ì~iÑÝ•£ÝŠæÞòbeÔÚDëêk’çŸ3rýô~6~4 ;ÃÆ±ë€â£Á|oÊØ‹ÁØW»½Å{½€ãg»CX’bÑÿ5ôûÁ ßÿküaz?ôûG©õ@”| Ô:õGà©“êu1l+ú[£ãšÕxËXèõTÅI.ׄ¬§õz\%FŸo!#QMÚ¶Ôý×åáŒä:w çTÛa¼Ç8cj²•EôÓ5!×ÊP)²Ùús<2 !6‡a!ÜN§°EŸz‡Ÿp,d­åSß›ÓÛшò]ž7 ®%ß ˆ]to­“Ž¡û MŸ/Dô¡èÎZº º~ …4»ÖwÉӈ͜U›§<yµ]NY,ÞtÒÌüh‡{ÑÎBÞL½ÿL¯Žt– /K¦Íý>9=ù üû7V-}'endstream endobj 265 0 obj 3761 endobj 269 0 obj <> stream xœÕZIod·rÔȹ­dú™ûrÈÁvŒÀãe¬ìY#Òx™qìɯÏW\‹l>IñĘƒÞ°Yd±Ö¯Šüæ 6yô¯ü}r{ñÆc¸~y!×ß\Èôã¡üyr{xë ð_©6©„?\=¿[ N™—qÆËxhc^¼‡«Û‹Oo^žÌ•qò¸]ž0E{mŽþò$·à­Œ4j­Þ„ÔÇ«K±y©¼°Çwh‚ ÁÆãû—'ì+>?¾ÄD+¢=~@_Þ}|ŒŸ­ÝŒöÇwi/å­’œè|UoýñÏ•& ïh³Y ªÂ¬uúø^žê¬é»~võ—"¹Ek "‹Pp”~h“g\¨'Å'QŸŒñ‡“v[ÐsŸbnaOFsü' Hb®ÐÇgt,½yëå¥Ú ÎhÓà„ðñøƒÚâL_»è­PÇŒü)‘«M©½ lý´”‰&?ÏÌjçh®²"ÔÇ/.«ÚÑwĶ&˜ÂŸ®ò'ƒì ˜ã—´­>HÒºFn¢yuih2èÊÁ­SlÈ&°…ûnô³+;X§L‹]ƒÎyü—tŸw=]“”´/ Ðï¾JÞn»ÙÌ`&nêpRqF¨¬V"!ˆIÑ—ÇÆ_´±oÛ×Wí×ïÚØ«öõeûõEVÇ-{|ÞŸ·‰?¤¯(1>Hï¢ýømûúDZ}>i_ÏÚ—hÄóžNó諳ú¨ÑþÐÆ¾Þ7Žu¦«—õ“d/ýfWï]\ýþÓBGçÑf¿b‚ª_×ÓúY' E¶È³IN+;*Ø^ÝôOmþmþßÚØ[íë½öë;e+|¾½ þkûpI\Çþ^—‘w¨lTÀCUƬÁ6â}¹ÿ$ôC>^² èÝöëÇ‹±¾ñûŬ¾ÇÞÊ!éhj!ñ¸sœ?uo¡»äãat'¥¢Z ZB‘Þ¬ö&¶¨)Ë ñda3V2²9 h½9뎲Ç*EdjsÁS˜­m³ˆ˜MIñù¥Ü¼SÚñaßà-",²Ažê,‰’¶0ÑÇq:Ñ["ÓBPKY©Äi¼Y”Ý Ù9Eé‡àMÒÑŽ lÂsŒ›Ôw¤œÍ)w–wh޶H!ìDÃåÈüwÆ{>±‹¦Ã«¤UÖVÙYÙ¦Üñ†s~¶‡‰-+xO†:O©£ˆ7êÀ2»K9ø©¡:ò!·ÝnsÝ"ǸŸ¡¾ÚM'Ý©]¯º™Üpª×}{{O °r6‡ (¶Iwâ§½8dìÌ]ž¿)g¼ ‚y›&;ÊËLNpK ]§”Í>Ÿ *­òyÕ\úeeq…¼%À÷½¿Úû-Vî^ÿ¯(`5ü”§´­„Ã[Þ3¯r^KèÖ¡T,±"ŽÏKê) ;’y,)•ƒíX7œ§˜¸ó*EP_Icɉ3Tâ¯Wáˆ~7ø]»u´YYòNŸöRž‘}CŸ"F-9X†_F58òë’Z½_O^•œŒ[Æ×h»ÈÆÚQ!yŸÍhyÉÝòvnÖ“û¶l·9›nÎó iªG—´w嘤µˆ›ðYž"GL—cgèa/á!å2„3¤…3”ÒL_b|ZºÍðµÎð^ì}žƒÎAå5±XÇCå耨 1`}ŽÞoQÕì• d;5 êØ'÷Zç¦}õfÂËV꼫šq «#K« \Ž ”Lp:ÐdK¥±ÄÅÄH"ñdø޾ ~ñFHw8 $”è}._²i ìPÕ•á9øô²Ù»ŽCg{]U §ÄYéÎí²Y0%tFtÃS>c‡ãý ¿"ߌÉ8›¬ Œàóœ]¤ú|y—-ªîäN]« e+Z„qÙØeü^án¿èôÑn»ÈrB¡5нÎá~ »„¢ÁHu}=¯WK ÂÐ-L^ðø›‚½r„}ƒ³“9šz˜©ö‚WªŒ¾G´€Î°Š$ŠÖÿéd¥:Ô0›^&N¬b†¹Q¤"FLí9(iSU$¨ç(YâìDßQv‚€æÖfϪT´ù„GV§&Ã^…HP$ÄôŒÁ—åÞ‘«Š²“¤“²¯gtñU8t30÷+œT*•³ÖeÑmwÕmJúðÌX v^æ½N{oâ¿jé'c™l!@©˜Ävœm`ò&¯!P¾­±ÍÈ5Ù`_c M-Ÿ"Â;½Ý ^̯ 5)­)Ýo£;Ä}“öt‘p@¥ƒ:é"$RUé ¢¾„Ýj'+´: 膢t_›ˆ”·ñ;ÒóIÏ:.%‰ËÍ­'{ÕGû²×yÄtZ€jeÒr…§*:¢RÎÖ}¥[æ2¦„f§¬÷Z„#œÛ¬ß³ÁÁÖ:¹@ú[D;;uö»siÇŽëÛ¾#¥E”aÆÝá#(t6 Û莾„kݼ;¢ú–¨=¼·½†Tù2#ðáÍNca  wJÈ;ò‹v°9h~n´“0ÈWЄ-ÎBó&è$+”W{]°FX±šË¨¼G„Orp7ž«Ñý!MÞÕ^ªóTEÈ…$ã 7; ®B68„í½nÄø'÷& BÉãx¦i]ÃãóÑZxF–óмÐZ¦RbßbáBóÆ9‹É]“gõòýŠn.†ªÓÊ3EïÔËtûŽ]3Ò.Z°a.ò¸ÙñÆÞ=&ÇpR‘ßÑ® ß‹–zQpˤ5Ðî`áóÖp:ãê^ s¡Ñ¡ç—Q‘ÝlƒEÌšÌÀÌ7©;Q·[Š\$~n-ÎÀòlá‰O—ƒ5uê]'úzùÔc%Ñ_ôÖÌ rŠpw²Gw»Ï*F¸¾ýYÐMݸїª‹>Ê-ÑîmäßÑùíÒŸ›Ò -ž¨°¶Ò i*AȨwúA¬ëú€Èþ#žúêT™0V×vf÷Ú.óhýºöª\6¡«~“ƒbÐ*N9•9 ¿ùX_0•nÿ‡Ä” Âß—×f»>Ö=òÔîŸ>IÑÅíÁ±:·;퀳â#É…?Á­JðiÓRr)Ÿ•‡#Bö‡@Çx¨c •|FKE é¸`¼=äA„$ô³ï1…›^Æìv©vÂ÷]×,9Ï77¹û+Æ ¾s:%°ùâk—åÐÇÚÂÝîšcîD†5®™çËÖ»&­äù-î`ØÙ1-ËsV{uîé*¤š™~îûf•WnÖØlIØ µ~ìòøD4•¨n>kä¥è"׫5/Æå‡ õ'£SW.ŸæM°-¢“Ôæ)+¸ |5[úˆKªæ¢ŒKžŠü¦m-»hî,ç ËtQÒ*¬|Ó‚]rÕîà¾Vsôû Péà¥5œŠ-{ÍòÕÆ4—§ß‡jŽ8t«ë º–ZìÑä‚ñûd8RiéÙÅPIŸ¡æÃ”íòÏ!½4¨ s¸ *¾­S§õâ,ueê6—߸ôD=”2õú¼ìÜ59ý »¦Ô 3¾\_ë a¦fåVáAä­¼ÛÀãÈ;¹öJÄYtaxʼnòÑ7¬ùV «68çhõš©»häØcܧ‰Á×ÃÃÐ7[s@©…µ÷¾¯¥°å°ƒ#Œ˜_œþŽáྫ.}£ª|'.ýÐ5šˆÅš,Ö$1Óï Bx#oCËåÉÓc zA-…QÙG§âétÎÀe 5Sóf¼R€ªÝÌɰ–¥…•NW µ‡»ÿ³0 ¨»…éVÂÔˆ©!ÌòIJȧF¯Ôà6“IJsÛV7'b}¾Ñ"ãf#bâ(E5¤Öœ‰•QŠ¿™ìat•/% G·÷päîà&T?ÈqjrQhDÒ7P²”zOu’ÔqC€ù÷¾H¥¥Ë¹°'ÒÉeÔ0ù÷H&°¹gŽ=­k|ãf„Ó+QFcÖŠÝQ*ªª_H©…ÒäÄÚÃ49ŸŸ±F/˜îÆÂæÊ+×6í¬>ƒ]ÿ 3 e»«ŸÞäô‹‘\J Fu¼”.øX6ûÕ¼ÿ¢]ËÕ«à'[ôÕ'®÷yóÃäq½Ïíþ[òÎéø¶wõÒü–ñwòtðh—ËܦŸ‘ÌØkàõ“ô4O ÿö&=5W}²g]ä;=£šuV¿T¥åÿs¼°/æ™ßŒœÑØ£öõs›;ó¸n”£­½suñþý:I¤endstream endobj 270 0 obj 3441 endobj 274 0 obj <> stream xœíÙŽ·1Èã~@žçq&Ö´yü [Jâ@¾”5` Ƀ¥Õ±¶´+É’¿OÉ&‹l²göc$Äía‘ÅbÝUݯ7lâ†ÿÒÿ_ž|øÐnžýpÂ6ÏN^Ÿððã&ý÷øåæãS˜r>y­ÅæôéI„ä+6–¹ÍéË“lÕnÏ'g5÷[—‡ÿ:ý[Ì"0›¼3RñˆƒQ–ûM~&œœ`żêÝÝ^M^h#·_îød5㜌îãN­¶Ÿïö°çÚnïÁïœ3/¶Ÿ"¸° ú~WfR‚®9ÁЋÉ¾=ݱÉra™ÞþWå\xƒ-&!Ôö‹ fÉíC\@sÉó‚ëí_`®,“Š>%h‘}d¼#…\ºJ;˜Shñg@ÀK ¨äѕ髬šLYò³˜²BŽ üuyº‚ý9Œ:š¸U¢/÷jû|·̬2LnŸÀfLNZÚí9>fÎJÆåö"ÎÑŽû*ì§¼õÛw¸ŠfÊ©í[xê5lkè„o#ï)ã¶ov¸®£^⪒1Äwžcôv§`Ä™¡gðp7IÞ,.äd„ÖÄzom¤†ª©!ÕÄäô ˆðè '„å›GÀà2•¶\À~Ò»þ£Ý^c1o{|ø&æ¹/oÉMÞép²$Ðow¦˜†!!¸±¢w±vR€ŠÚT…tÏÉÍ·jN# LÀÃK òEÈø"ݹãÜÕä¢Û Ø…ìð\¾sδ½D °Òûí•Q—”_Ïéú‰§¤v¹Gp3!«= +i"w)¯Œ¬æfÄ *Õºe; uÇ^zéD—14(#·dŒoqäAú cÀnó³n{wk,„JoÉBÂË> yîý<÷.ÁÀó 9¸ š¤ÇB^©.A*ˆp&ãøŒ~…‘žX`º„Ñˬ…zyÐm %Õ‹8]ÔÈ8:o gŠÍÞ%´Ì9ˆ)¯ýÚ €P†¡n 'ØÕ'èË +ꂉ…Ä o¹@ê½R°¥Úì¹Åýx„Œ¢¤AçŽFuGÊ’P€DâS ;_48ê¯$K( a2Lu…),ÂìÌh…)ªj:· ¥‰•…õ`‰úX‚ÆMÚVêƒZ‰3<&.ïW”’–j«½݉¦šÏã*:" P¿c¤Vz‚.¤E8ßþÓ,¿eôscðìU¨9J¢)-b:EM¾IG€L˜š­Âiñ˜ž—£Ež×ÌëxJ‰Wæ§ï²ïqF^8¸Itƒ¤7–”0YèrÖšHM rl‰ø’qÇIZçi&ÅöC¸BÏ%ØßŸðt–3ÎËÆ¹}ÞéEDÙƒÃòOøù¶+”Èö¯¨|€”iïyBYm~,??‰è–výkˆ¥ŸZí/ fï¥Ã‹ùr€ Àc&Þ<ñ&‘'Hêìb?)øµBëœNB {£™ÀŸÁ Á{kj\y ¼ä™úïÊ2— ì¼Óy]ƘAzÔ”X¡Ó'§\ó¥‡ Ô@QvÄ*?Ú%FOÌ 'ú"j®ƒ7ºe©´p/{TÇ ‹½ATìd«ÅZ\ѹ“œªÐm罓ͬ­ñ–‡L)V¡ãZ ò½Àí8Æ/ÅÝ@‚S?Vy‘žœ FTÞãÌðeÿ²<’@ Ähù®½™= ë¾Ý! I†*Šó/ ¬^ÒÒ;PSicǪ½:t¼ Ó'A(!@é»Ñ~v£yñ8:—AñÖ¡ ƒE½}Õè­6Ü<¦õáØÎHô´‡ KÄ ëHø±ë-å8àÜH8©Å×\¸Ùë« VJðŽ%f0U#b.¼¹š˜Á˽-b‚½D¯NL„s5Å59þ]EÍÖE×pRÔlÞ$Óáƒép¸Îˆ‘ª[Ù¡ h‡è¤û8÷¬ÉÍT.± Œ¯j„Lh޾{nÞû ä«hg•áW¦;g…ȃ¹Bw@9-f*&ºs ;2¿&J‡‚ æ`Peô&Q†…D®býó…ä¨ZJЏteCÁß­ú¢RP/aà „ZÁÈ¥+™f^c; lY Ÿ=ÄÒ ‘ŽÇ$åº:Ä‚ej1!V›'p€:4eÒꀚ:Àñ!­cØ£HPǰËì2±Wá Åö¦\qµH9aƒl Öiåá}±AÆúFlàI6ìÖÙ`–Û â}3æKùŸ`LyÆ\Iϸ:ÃT9¥9%Ð ì÷Âp´U{ð²J’†9ô2ß5a=>{“G—ù×wùÙÛ<:Ï¿^ägàXƒ;y¥Sî¶YÏS.cž$yÃÇQ™xžï¬B”äd;a;Ùmr¤; Î8z•a{ó@V,bøòó½ægíÄö»ðY=‰ó„—/òCÑ9/Ÿä‡o WÌÑYogûyžïæ"ƒ–‹}’GÏZ…=ö:OiöÇgiÓl±ïåÉ_äÉ_çgçуüëý´ ¿Ì??$?ÏÏ>É£Oó¯ï<+ž¸TËÅíÖ\X¯Ü”‡»Îmô ïeàòëwíÚ84MîîGfµüÀó݇ül¼‰B®BÏò³Bjzó³o滜µZ4ŽÈ!Å:[®ŒÝycT+;ËÎÎ=-»‡ E4ªr% „‰³ÈÓÆ¬ÂkB@"9Í1Wz;Âq!(Ü®+À'1ã¤Ð°Ô(%Æ îF¥F2œM©FpãCŽâ8°*kÅÆ\&XÔ”œÇègQSê¨ín±QblÏ+6êk%IR¤q°ÖècmfSAŒs\]äõkRÙÉ‚ù¸õ4©AÆì_æ‚ÁIfÊ–îÚ5ÈVú_0³ÍV¹ÌNR5Öh,™ë¾V2šÝç¼öÕkUÆ„2Ñ{¯U)Z²®Ø`Q,Õ£FÌÔt%ÏY ƒ…qñSõ Ÿ®ö’sÝ3„= B30úŸ¤žC†dÂE®<[­¨ÈèšÏÇÿSSæªYÙLÅw´ãC3vL1ývú1æÜçXGöc â@ËÐPç¸tÌSnε>èe ê»ÔÀeUPvg­h9‡²G2¾öÞðDÀ®6Þ&†]ÑL9áÔ»&x¹+µ*¥ÒK5R l3¤‹ŒXšà€(žj]Ö+/gÅÄѸô|•ž*bNï?X‰ó5#!8fd³û±ô¬¦5üãú(P¤>Š£¥Ëb“ž)U:¬©¦Š#“¤öHúÁÐ5Ó«ªMS€Tÿšœ¡,eߪ+ Ï—0Gë]ªjÞY¶IãtÖ”i›fUÔè8ìªöïV‘ª[Z™j¨‚ ³¤Ù¯‡-xÉU´{Ž`_¹°3U°-¢8nЏ©ð¬É<Lj“®1d ˜AH0nb//¬ÿ}ÔaËnôfÖÊÊÑý(µÒÚ?–dP§yt©“›k­ ª<,¡ Å`èò.ô z¯÷"cQd'&=OI¨‘ÀØ"øÇ§@a¨«F¤yÓÓ<*Y¥¯³Æ¸ŸŸM5±š&®5a±IÆå+/ì’˜2Ò.3wó¤°ÌÙ¹1»Y.‰T c´ŸÄ¯ØcB>ä`[ *ªySï‡qmõG«P#ð „PŒKbõ¦XúlI(1ãÉý°¥ÆØÉyX!_³]—_öó`@H4sVá×ïO=‡äï©y¸+ê 0\†8EÐ;Iü#L#‰PéU,ÍE ûs¼!°Ö4NIoÅ{éz—”ˆb©¼k뱺–ÕÚ½Þµšûy‰M‡=8m¢É¦D]dMjäjßúfȉ[Fn¯@gE3-÷ô(ëoÏAP£©ÞÆäÃÚ«€ï  Æøp–§("wDÏ€©Å¸¿‡‰ ^–8V• ”SAsà¿kMÓ6Y|»-EøÛ(X¾JO‹ÇÜ7vêiÑmié·!˜†˜”ƒp´3kÄš”3­R4«AlÓ|ƒ# ÞUZžÑp½vF„n¥g\ Ô=¾æ$y}Ʊ/=~ɪÉußäè`Huïzàœ«Ž.}y½W¨Vs¥'+0è1þFŠÕgÙ)ƒ§=¬ã Tu‚Tñ$«=‹¯9žK`C$>™XÅøâ¥«&Ê5ñWmR·o¦\¥Y¯1Ý(FZ-ÁcG½bMðÑøéBô8žWß»Ai^)hR!/•î*Æ 1½Ó>8qÔGI&Eó&©¬þsÅø=XÒ‰9º%ÆIé¦*¿¨³Î„Q[’šjGÍæ¢’i±æ%Žã2UeB}‰ãV ™«õ-’G­8´Ï–MRhÖb)PìœÝ žIû½ÇõÊtMƒN¹½2ªÞZ†krxí»Êžêq-¦wdç;%<èÓì“ý\Û²ºK¨ïƒ‡îZ,zÍUÊ“MqRÛEŒ…ªïU*NÒZg“^ÑªŠ“uœRÊ/²V½‹ ,m"¹n¡–ª¤ulÄq +UÕ°rð•Ò_¯hŠ i׊¦DÃ]§f*¼ãZñ*n1úMÍT`­TÓýzESŽ"SmCw“­>h@~ïVf ‚7‹£è£¬WG÷³º¥ïi–É’òù9?;Ë£«TH¯'2*šÿŠÊmÉ¢üæK·øÁ­"wªõø®jn¼¹‹Ô1ËŽsø¿ 9£0Š‘à«˜¿v Ã—žÂ ®ô!~!h’ eýeð]…`¡ qžz*¸LÈ,ZÓ‡iU¾5¿xeºôµ˜ ´wc'8»ú=-ñf(¥Â!/h¶îI˜?Øð,¯F¾K@ë°¯Ÿt”e ÌÈ­s’EBxˆÝïÁ¯„jñkb¡È6®£ª¤ýP÷ô÷Ü^oñ*‹¥ æaàç ô{êÍòŒWè,~‰_8ƒFšB)ÈÖ]ç«)¾ˆ¹UìgKçï2n)üJÛÜÏNín? ¡~[ .†ã‚w Xõ9Šêæ«%ût¢ããWðÐP (>ñªU{Påy(M pc•?7ðŒ÷K2ðKúäŒê|*Iš¨4~ãOÖ÷>÷º÷ŒË’Ù㺼ë-#¶i °ó« 4ô*·¨.g¦‚ÄﺬtXgtòp,XBŽQ´H%3°?JP¶nÃ|rçm ­8Í5e»ð“æ›XéÄÝŽ…Öâ¶ò1‘¸ï"´D— ~ÿôä+ø÷oš¹{·endstream endobj 275 0 obj 4262 endobj 279 0 obj <> stream xœíË’G8î÷9΀¦©÷ƒ6ÖÁ„mÀ^"l«ÕkíJZÉ`ÿ=™õ̪®î™AZdÖÔS]Y•••ïÌ~½aß0üKÿ_ÞœýöK»yöæŒmž½>ãáå&ýwy³ùø&ÀO.&.˜Ýœ?=c“wF*—1Êr¿)cVl,s›ó›³¯·íöjòB¾v{˜"­T[·ÛóÉYÍ=Žj-'Æåö“Ÿ8ç^mâ{ìö|Ç&Ë…e::í·_Ⲛ ¾ý|'&e5³ÛOqLX‹~±Û®\®4*ž¬úÕvWÞËœÿ1“O^kçŒâÀ´žIEì•q[_z¯”Ý쥙œô0÷1Ì}»S“cŒ©íËÝ^Z;)m¶og¡µÞ^“T^¹íE]ôŠ9ë8oÆï`c'§ÔöŠN¹Å¦0™öãÌlŸàiakë·Ïàˆ@x¡` 9i¹¼[ÄÌø  hníò½}‹dÓL9ÁqÌdà}=ãóˆ‰6°UÚŸ;¾ý>"®”?bã—ir{r!q+«J«&î<9j·mžð*ð‹ò@%’úk¡ œþN霮¬,5œ‚(âý< Ÿ[2( oäöf‡¼#¥ž€çXd›°—õÖŠteÆ»|éÚo æ-Iç'%e;™î\)[¯àd‰xÙ^:Ñ.ñ‚þHo¼ÓÒ§e<ë¹Þ ¨׆ìú/@Ê3é •Ȳç$ŸñHʉN@(úÇt l]ì% 5À¥T^êû¾(dîìÔ—úqUS ÜhMÄLÚIƒÊz‹è™I€&¸jeÆÝd$OÈJï·OA)Z£!swR»YÊPõ†É”uÈD¸Sá€Np‰uÃ;´pÒæ ñ‚œ÷NŽèluÃadFäR¦éXDO1Nmd=óû÷®9‘­—iwJ0I÷“6YŠˆ çËëã=8¸' q{ædP¸IYM‰ò˜ž4#×̴‘4…¦Œ"tgdÏŒ¤2_%s¨npÉ„¦•¹}¸d&E”H ” Bû¢Úà1¿#;7i«2K£=nˆÞèåæÎƒHÕ[kôo¾Wà°È•xŽD(!ÒUi¸‹›ÈŸr`b®¸©…ûábûÏbâF¦±×߀Â;¼—NœM©ª¶D…¬°{=y³RåBŠh ‰ì<ð·0¤ö*Êž‘“urÙ°tæHŠ¡ÀS֧ו8»¹š«(EÌ€Oå³Q‹‘4×¢‘TŠD…£tÌQ)ª"°hÉZ T'_6ŒU&ë ²_3#A‡Fñ®¢Ð%Úµ‹‘”ÄÕº(&²þ Åœ¡G¼èð‘C.‹±žU’HÖST>hn‚ÏwÄœkä¼® h¼|Í'üÑÙ *HøÊ½bÆ1"fó㚣Õb?S—¢”Ãý!À°’X£±V9#»ŽPXÔ3ÏpC;1-–ç ù]2aàÀeÑ£Ž-ç†METÁNé¡QÊê=VÚ¥à ý¾ µá 1!ÚG¬ö d7böˆó`Ù€°qà‡¤ÐNÝ ó2\캼k`Xñ~E7YJœ Å„˜ ®–û¢~“ üs£•áÑ®¬ÜžVödåÇpDé,ÑA>Õ[|ÔNMGïнãR)̇\f|ÐýyêmX …=ߣ,£F-sßÀ¨±4É($݃ÞÄÏ|ÅhžïÀdFøà!A  ÏÙ{O­ý‹™m ÆšÄvi†±ÂêEwõ¸0+¦ÙK„Ë4Wù‚ð6í´ Çñ oS“Û”àÎ2o‡á8úÒŒ“ÛD? ˜vEÁ1ËÖ2ë™C 6ˆê‚*Ê"â©<üŽàùˆÌ‚9yRž^”'ž@+Ç•`Bjðïï;òhutVÜɸV$"&2~‰ç£1©ârnQš1ÒÑ܇d!Ó<¾ÂÃscE3¨N² »0æÀañ+8¤qš‹r­D CÃÚpEÉQåá÷ ;@LCH·» œ“7¸w”ÄJ{Ž?P(Á;R —ï ©pð£éÄ*÷L§¥žN­ëDWƒ‚Ì’îzP2ƒ)*K 8“ÆtD›ÀòäÈ@}Ј щûÙž¹•0ð‚ÂYˆ^ÎZÅÑ &|~ÖKd·¸‹¦Éßl-‹Öp-iLÀý؃†»mÊ× :©=äo:ÔlàŒŒ¨°ÿ†ì"`ã•a£Ñ;fFßìZú´¼£W²Â5¨ýÁi& ÎÆK:¡·1¨òˆ…DçÕ}ªP$¿£f9™H »À\ã)i`ž’2ÌeµÙ5<È>¼¶ÔL§42£9™‘5G“\j<n~ˆ·²zTÆîÊÓËòöÛ2ö¶<]•··e ðË žš†#>-/ÓçÉ b Ò›A| R—-'WåéUyª~Ò½EØëìmyz3x{U`ùðíÞâÁ½¢_ƒÊhþö9f˜=]Þ-/ˆŸ´=ç:JRDŽˆŒöÙÙù¯¿NÇÀ‹©Ç­·ú¤<=ëHyc¯ÁëôäÊ{JUÖÀ§1¥æW>¢ò!BÍ©sW`G» mbœÉóIÁýOeþ_ËØÇåé³òöa" <þaüyûó8ý=/ÃõOäz|º.°DÈÖÙ¾€î’Áo(ü`êåñOêå'õòÿ¬^ªùr @ªòù´¼ýj0V7þ"É“–?6•3KŠ'¤†‚›“ûB¶V xUr|}¶"ÿÛŠ[5ò¥¤k2U¯úª^q}[ÕA"BËÇ:jáX:0<ŽÜgc&³”hýx=™%'Þµ>|ŒƒÀ“54»Âµ™òÚ!³i&ÿÝP ¾·;=Žkp±SÇu‡G{ý†(´G½©­JáÀ©wËå)D<ç’Œ¦µ“ 5÷úiB™“J+) í¥2S›„~Š{ûI÷ÿŽyóTYò„û=rB{xcÍôåÄ}"ÏG èœ9’E“þ$6‘%Ô³äCÍ|w©¼–m«˜ób ;kÆ:ÛÆ*¬\ÓeZ6*æ˜ØV‚ ÁåJ@KZ*¨ß·TÌJåºðö)5²TãÒFoV8 ± Ÿ¸6]ÉIƒ–^M§BÍx°ڜë¤F¤& ÐZ5:¶bkN¡L¦ZÁŒ8«¥¦ A¡Dûy¬ÏpΗµMØÑªFÚFœt û*À’úV)ÿuMQ·™îKÍìrÌyÿ‰âÁËu2òúûÇŠ‘Qó’Y«8ö‰T$Ë“*mŸ7•§‘R¶šñš÷¡ÒQû›æ•œÈ…jztq¥F‡§œšŒì>ì¾<¤ùzï …Äz,¾®‘2MÕ jnZ ' 49c×t‘kÞÞM–ËÅ.ÂŒÑ팄¥Ðzt–P!ªÔ&Š!wc©•fÀqÏF@FÏ\–ÜvS@¹ÚÃQÕq4Oú>ÜÏ“î›zœÂô#žF$Šaún(\”§›â¹?š‡Û#VñÆì%§Vä¾Ü*]Šƒ/ÊV.tìnµ;¿ží—Ë[J„ì5™0OÏiNÿ"+³Qb+gLòaš¾$Æû ‰ž×#fNJ‡‘zlÄ:6 ÛÆÿï°‘ŠslN-H\hF}n"ª¥zžd»¶Àe#‚Ê˜ÇØk¯˜Åê*Ñù1óÊQDõë8íÎi<¨Ô–æAPiûö̯xN«FKí<ïÖhT¼‰4·ŸÔWbªWrѺÏKú¼VKš3Öƒ^R ;®rÕÔHE_#¥•^ƒp ÝñáQf\™ê¤5²3ÿc^UuI_»©ùÑ›ƒ.¹z¹h–€kêÁ`•Ë;JûõóF @„Í“5¹:^0'WùâÒdæL+0'»TÁÄËAì˜y˜Üß,šX4@ÐÜch3fûÚF}ï%Y{ÕÔhÊ]Ñô𡼲̘— Ç ìiŒÙ²7eÌS÷¥+/1ÙŒ/ËÄCX—‰MôTèQúÐõŸïNVQË.ì)*ê¢#j{ÿ„~k°r–¯×.*jÄ<õ ÅêÄ[ÿ9F¥€Aµ?ôªÊ;„H+üÕ´Óøk vݲ8|Ì^­®×J¬';Iá‚ÜÊ>ÎDo´÷r—›\ *f$wœ0 ÞzÆé.Œ ¸üè=jæÃ—#Då¤÷¼öø:Ðóû뵃`*qOÓÉO'ïk‚w¥í<§I¶°s·ÇÏ9è'5¯8h1Û U’ãµRÜ!Ç)у©M’Î~àEé9Ç¥Acÿz‰Œ–v0Ó~È“0ϧ,tÙï9Ó„ÌšÔ¾tÖ—/–ñŠO¬~ Üõ ‘˜Æsøó(C?þh±ýÀÎÚ‰Gy]iÒ†IVWá:ؤ-ˆ$bØk€JÞOpzB“ö)ÝÒ Á±¼ÄÃoèNh—*ä‘8Ãw'µK»ê”¿¿à˜(Q¹÷ï^Q9Ü"Lt|‹4f’Ú^äë{¡Í‘íÑïŒÎzk4ØË3“¬9‚¢—[ÏÚmX€©Êº¾>úÛ¦þSIò¥ÕìcM)úo®¢æ|¸ªŒê³÷Ý[­¯T}‘ëëº&6ß§Õw¨0Ãàʱ¥emÔuV×¶¬Ús*ȼeíŠl\"‘ÛÁÄŠ5ű×%dé#ã#¹žgUd(«àœ‡çg¿ÿÄZ| endstream endobj 280 0 obj 3594 endobj 284 0 obj <> stream xœå\[“µ¦ò¸ù çñœ˜™è~yÈ’"¥’*Ȱïz½Ø^ ¿>ÝÒHji4sæ¬×ÆN¼UÞY.­V«õõEólÇF¾cø3ýþæÉÙo?³»ïnÏØî»³gg<¼ÜM¿¾y²{ÿ*ÀŸœ^k±;x[ò;ËÜîüÉÙ{}øè¬æ~Ïòã¿Îÿ<5#Ìbc6zg¤â‘£,÷»\&œ¡ÇÜë{‡A^h#÷Ÿøh5ãœ<}ˆ# g´Úÿõ0Àœk»ÿÞsμØ„Í…U@Ô?á½2£´Ï½­áûó-–éýŸ°WÎ…78€ÐbBí?9iˆÜ†h.y@p½ÿ#tÀ•eRÑRB÷ãLwäëqWiu /þxi”üt2•U£)]þå F¬¬ˆ#$^JW¨W]áà +vÆ/MîÁaÐÆø‘ùýŒÌœcnž,3û›\ön~ºÌo¿ÍOÏóÓ—‡ôˆ”p7*Çønàȃ‡ó ô2÷u“Û½Èeßæ§ïš‘°ì9,üè i…Ü–H|âÍ[|*S‹o5{¹Ú¶eS©‡m¯rY‚«E ê¶ò0XXG¤ncJB§"]ªðÚ‰²Ta}ì¨vçŸÿæ Ø£‰eŸäfŸç²÷óÓÇùí‡ÓZÀã§ùõgäu*û}~ú(¿ý{§¬ ¯%t­åþ"^w˜V«Lûi‡tÞ^å¶_î;kÙÊUïmh\‰|«™Ab7;:ÅDÜI) ›Ò{kqe䨽ó¡PËÑJ ûBŽ1¦öh« “´Â¿apÏ€ÚÕ7P(•WŽ´ÿU”5ðôž´4ÞuTÓ£€Ú /¥OãÁ¡L®ëFoŒtX×À`…v¨œ4 ›v÷jYy]ÎK§± ªvÚº5@—‹m$hjï…²Ó0@ èO¥m¤iê^ŽNz§b“ßá0p8x›Pªzaž/Ó$"X/øv‰ìÔÓÔ ˆƒq<­hÅ!=š@ÅF &ù© UkñÀ!f…íÑä×ÜyÐp§>ÎD¨ú*gÐYc±:ÒzaW‘5¨w(3“¦ðUž.1nmàT¾(Xa¡ÆT,ŒíŰçnÚ,Ò{8„Ò_Ê~@dÛËÈ ”0A;‘ö?ÃÈÆÂŸ~ÿ±‘ÒlÜ€“Æ,]WÑšyÝã‚ÄÓ•å…ì$Â…œF%à¡Ì ªOa@•DUê4Ú£9‡q/ ~¡jÖJž°å2²Å;Ðç„™78,(AåR m·¸M…r€åL]þÿLàŒ‚À å­'3 ÚuãfΤ@Ž ’0ˆõ“ü­Ø‘ Îežªs3½ÛÕÖS!mbûˆÍ`®2@2ÁGiPýdz6¡` Òóõ8슪§C.Õÿ—Tì2÷xšMèãûˆ´½äd(ÒH«Þô‡î(ÓÈÆÂ¦žzÃãW¦ãû¯ bW pPXDïGx휓ÂÓ÷ä»R|dÆ‘V­Ä¡ð:9ëÖ.WáœtÞ;IÓÒŒ•"ÑT¤p—bòÕ_a•Êë‰URODÏDŸRÚU×T³²2PeøóH›»t[èïý2Лq –Ï­#Úú!#˜¯ ¨NOßç·?ä²Í/ázDj€eæÂ‡¹bDožOà ¤€·ÅlØ7-j¼÷47î²-x¯†Õ=ˆÜÃ×’?îÔ» Zi¯«Âôô8cîuëáº@÷Þ(´I®Ø°Áƒz¯°i ä^QâžÂ¡Ô‚p¹E g‡Øôp½NŠwµø¶æIYûÖ̪W­×Ëõâ[lKr­—vIÛ¶«vÙ-yêTl—tI˜ZKhx›Í»§–¾ùæ]V¶Ôæ$À@%t:Aaƒ}Uür 3J˜£œ±áˆÐL¹ŒJã![a±4F9¥'\­6ûž¸Ä]½ƒm?B¿Æñ€8¦uÇÈž$¥`„rvÔ“'é)Ä©1Ôd õEƒgœí "ѬlŸ+¯u­AÂK·W+Ý`‚2ó»ìÉ`Ÿí<Ó P,“Ljɡ†èÙK*Œ!vU‹ÓǸ®'Ò?:˜b #›Wõ€$¹vSÇ쀾զЉ`õgbÀÊÚIT%Ȱ]+[â\ù.7X!^šx IØâÝEBO>aÔªz㸠. ô MUœ#O†›Ðšó 7j/ÂôÊ:œò0H‰W )`Žyb2V¼t¢µVâ€Ä¬h­°+­ C÷VC{t¾oö¹Øàr)zªãr©<I2H“w£ ŠSêyú6îwÎ7ÚïÕ*)x$`Õª Y²*µ¥®”j`f¬©A2&›É[•Œ{zô¡œaÄjÛXÞ°·á@µ¬Lt4a8 Gˆ°è=è™yÃ5“©¡qÂî]$X]‹\\¦Nú¶8ç¼È²©Œ›4‹r&‹ÇÑTùWXÙÀ?×ëíJÏõQ‘‘ž/`ŠÒY®ÃÒ¬^à#àI£iéstLp©”F£’0>8bR՛М::-©Ì¥F2I»½…RcáDê''#³8yÂܱç¿ðAE¬:Â!wwè$%œ¢J-;_€HObyÞ#µföfTè]*‹Yéå&X+ªsMâ À m¨Ù.:ˆ(žâœ ;¢:ú©ƒbA=gtÐs%Xb4ö`ºl@÷duÌŽ^_Én{蟀W% nbçG$ÀUŤꨮW%L .†°Ö'ÁÕdÕ\ô]ÞQÙ•“¼uØW„éÉ™žÐâv”ø2$µø†¤?_/Ir¤A²4ð9…(÷*–-ñè4þl$%†}6/W€Ž¯‡”v™Z ¶j•Š«¿ÒI6*8 ËIŽ™ ‹nÞ §¥E 陑è‹ʤ Ih` XN*’Öñ €sß̼ÀÊ“¸N7¡BÔ'=UþˆàYkü¡,»»ŽUg@7‰Î`-õ7ç»8%¢>uMt©ë|¦ jBZ•Ï¿7ñ޳ãMò,·ÒϲÌK“ûñ,¯{šJÞBÏ}Y<Ë’lˆ—ﵦÖ\ö˜l:TvçÝ™Ø4AðùÛä¶ìà¡·Ém9åÛ!Œl4)èL¢Gr{zraþ\gÃÕ:DCõÊ«³(Nu`}BRÆL3¶púD+ {ú OGb¢šX ÁÅBèyìn=oUq嫈º˜“B  LÈó+1O\=›Îé1Í0mÙŒÎåñÁ/J¦g7ºûÒ¶Š³ÙgÄ1ycòÂŒ E•g*ÀŒt5óÐÈÁ‘^9xbTÌ2;° ßH—×4{¡Ô ࡪ1µ J7! â!*ð#ÚLãøCTà““§Ä±`.ÈeU'öñýG¶)G¯Á”u pÀ±ýƒ3£†½÷ëÎÝ7ŠØ£»qÏH’%Ì‚4ÍŒò~Æ`ôQžà:‹éJ®øÆ/q& é”˜¹Ñ`(I8?åvT½à%•SÅ)MS5¯;N|Á«Úæ»ÙɃFæÐšÍµÿÖ‘&°­û…zè6ó3¥ø½n~ò—àgë6Ws8æ:g„ÇYäÅ/Á"q,ò“ÿøŒEò%XT# ´´+úßmüÌ®ö‚«»d‰¾nöèÀ¯Ô=(-3ßd“Ò‚c¤'A «Þ‡qýªõÐ}°¨»É¬²èÞ6ÙË¢6x@ÝøšEË¡Åå+;ƒ’®ñ‡À;QÀõ½¬·ès%µ]¦j‰S%€Ø§*/Gÿ#…¬¥k/[/½ÂOG,¢Žo/â8çOûèCÝöôÏNô%­s[lyQCÅþ(i-Ï8¶Èݶ%‚l̤ eãj~í6·hÅnºøF„iÒ†K‘å¼Á/Ÿð°KV¼ÍI€²eY|;S²µu_© e‰Yg±Û·wKM˜î° æÈEã1oÌW¿–½ÒÆx}=9W¨@Âχ %²Ž‘žî$8pvIš=rå:= `㬤@$œ<ÆÕQ^r…"&,ËŠ4R·ÛK°†Yº½TüVØà®ÚzÛè סDqBµ7ÜÂç&ˆíysÐ#à8ÛÿÞ Ì0}§Âü' +W½Ë@7íe êG˜”F턳2ô‰^”Ø¥nº®:šlhÇmÇTŠy]=b:,8˜Ê0Kkdþ¸Õd¡Ç~~¢'ÍÔ%y]fqѬA|ÑìíÆ©n KùŠY›ÏÏþ?ÿpm$•endstream endobj 285 0 obj 4051 endobj 289 0 obj <> stream xœÝYKs7NåèC~ÃgƒWÑûqÈ!¤I`S9xÄÆ.l 6Iåßçkiô× ÄV´º[ÝŸZênÍë31pú›~Ÿì}óÐ ‡ç{|8Ü{½'âä0ý<;noÀ€ÿ É„änØìq¼UZ$5V;†BsrpÜ›“½Çãw«µfAj+F¶ZƒE9¥G¿Z æ¨Æ(Æ…ï¬B=Þ¥y 7nVœ9!7™êM’Z#¤\I¦án¼G4é4”>X­a«PXµ1`¢JÈ7Z­°ºAý±ùaòS°`Œ$?Bb€¥Õ'“¬×Ö¢ “´ÔƒÐLi¥×Z»a­,ó*@öyă3¬0\e@¬—.#¢¬éȪ«uU¿vÀžKXuë³RÄ´·ÑΔ!3IÌÿü’f Ýͽ›ÐÍÏá¢òN=þY½º ¡ñÆú†vG(­íx‚TÆ;UÖÓ¨ËsìÓ“*•¨VÃFí9¨Ö9ÅíÒN®½J`­eH¾Ec7« ·2Œ¯ˆ·gdÂ!ä)H_Ò–pï¼>sh?¾¥(2\{9¬ ˆÄ'5@.VšÁ|±N1˜Ú_˜'\É Bf¼KXÑN"Ì‹®•ªî¤BÜóà#X2Ù0C³ôáå±OåÑÒÌ…àÜÌ` …Ø&ÅŒ \b—`°âœNéQ‹ÊiòD°7þOdc¥žT‹¼?º³Ó9fu¸çª¹²y¤Ëè,Ž —I44ðHßú·3xŒÞù"“LV ¦ÓÑÿŠÜg\é¤Ížk•oo &ˆ ¸y’àù.¬“Y̲à”7ñ#lƒ –l>‚Öã~+;Ú°KŠcaÈd± Äa@àI·`”™Øq7&î5En7…#õΦ ýû›¢>Sô6SÖgOr5¬-.@œÁw2(@RÜDÔd|T]àÆMº&zDDçÿ5iÇ(ºQ“¢ÛWGSáûÉSü"‡¸ÀQzÉÙ¥ýö!xÕf€SÊCÈ ¸íËU¼Ç‰×*æ –rHàV!b çyÊyPù³8­ƒ H!R1Ëhé”JQÙ”_4zR¤ƒBn‡÷Ò.§ÜåX$ß÷g%K¬<aPYv™#ÒŽ3m DÅ»»Oc6WëOg¤\IÚÖZÁWÚe‡˧]^¬,lCe¯L`ÞéÉ]ÃÛ}Yò )áÅUΣ[dßÛâôÓB{SF¯ÊìÛB»(££2{Zh05êI3âAaL;ˆ)a#9_JØ4ú}œI,åxc'ÓöÔTg{edOËè|aö¨È-ή9¨xÍÄ7Õ§UKeÓïïm¾~<éK“.Póè°ÌVÊcƒr54»07¾îV¿o ΢Œø‚É“žÞõ/'×töëNYô§Âük¡Ý.£ûeöîä †?—é‡Ít¦}_F÷Êì£Z]øÁ›FíZ9¾cTÑè¸È6àn«ùlî¢åRŸRÎtéPb«J÷¼[ [wgs¤BÝ?|[‹ÿ““ÀÒU‚Ü4Uó–"âqm÷j: üŠ4”ú¥Å4tNzˆË-ýåiÛ<“îg…[¶äŒ>ç՜֑«\¹’EC< ÅRGØ’i?Ì%wR 5Ïj”«úÚ`·Õlu„·P×/>uuÖt \ûà®Î;›ÉÒÔKiÙÌ¢&ìÈ#ôdÚtžG!Ôþ”ª…†TÂ6Š!%ÐÀÙ2·FåÔmOTަˆè8&In›ŠbŠ4çdS†¤äÍ ­¿N—]: E¯Tüæª>¾ã&ç½o)ÙÍ1ô¸bã‘V’ [yË ÎN4Ü+æµêAÎC ûæy¢Ý`R@OÁ\M—ž/JËËfkÕÕ¿Xte²Åa ž^ÀBíeF'Ê+M‰gáL( }@­$}HU6½ ¨¼T¼†¬ÍÓ¬•ÞFJ5húb¼Wœ«ñ¬xÕ+îŸ|¼åÐù0\èj°íûÜ3æMŽ}®¼×ãiÔÇÀS|ž=8vRÜù°" ³Þ¢ròcBŸš|û©B¤> ˆÐDÞD:B´~ˆúŒž¸:û÷ÓJ¹ ø¸ØLþ§ìCññ[àA¶T ¿¬X¶øÜ"fí[ÞÑÅ+lŸ1ÞøyÆ”¥Œ!ó÷¦>6ûÏ.ŸöÛ!²hm.%Õ[Û ZkZR§·ÔoRÈÐ× M[¾èЛ¹Ý‘âZ쎔·»G©ò;©€ñ„ J»­9L€Ýf5³|Qð¯¦ýÔ ÛñoÔ“žêZUGõ"·Nj¡ZO½ÞËÄÂ¥‰}RÀB¦mûê×µZ]§FÈbT g*¬ j2­®îXRgÀMÓIÅBX/Œ\”‹ðaüȸê>eÕæµ!^¹výÚMPßÝìý‚¿´ «endstream endobj 290 0 obj 1851 endobj 294 0 obj <> stream xœÍYÛr5}÷WÌ3TVQë.Þ¨ ¤–…“‡à\œ"6Ä©"_‡ðfF­]­½¶“‚ʃyÔjuŸsº%¿é¤ N¦ÓÏ£“ƒÛ}÷òü@v/ÞÐøËnúqtÒÝYãe:e„žºõ‹ƒ¼’:¯:ç¬P¡[Ÿö)œuÆ÷ÏÚjúyIvžÒª?Ûž:ÅHJãl4¬0•Wì×çyR+z²¾oà‘ˆÖªä!ANbxÿ`ýéa˜Ì;|ÿ,-ÃÀúþóaeDTÆQÿŰÒÂ9…Ù5ö¤¼´ýƒ´ÊJ¢>¦UÁúP†O` H!uèïÑÀ,é^ +eÓ–ïõ³ÂÇè}ÿ: •å¼´ˆÚ+Óÿ™°ÒÓ¿V0| i]úóQúþiñâìá¸^Lö¬Ën¤Y¥çѵٶ‰¼æ¶™¹·ƒA’tã.K5ûa½‹~ÜÏ!Ò ¹Åv–)·Cb¾”08€Çn+¢(\4ý߃±Zøxšl‘·Gý=Ú;iú÷)(JRH@DtœŠÜ«?ÆPšèc”8Lg³|»gÉI%(Fæ$Ë׃!AIk#Œ–×Ï€ß#5v9…ˆL  U!¢dŸ|_6]p“Æ£ÁDl„¹*†GØ^#Ö9# ˜gYíâÆ¢ú¬p‰:¨‚~œLIŸÐß§ eJƒ|»eÎø€äu¾Ï$ý>‚ˆ¬ŸÐGù´Êš+1XSÀøÞ+í½€³Ýмp°?†­Pç8'À ý_ ÈÏSü••z6çµÉ'ª0ϪBÚŠ`:'ð“Ów9x§}oK`túeØ… sš÷Y!´ë©˜ˆ— ˆœŽ‚læ…+C*À>\¶˜b¢-`ÃÄ@žd Ÿ;fP¾H‚ȰՖ&ÙtÆ”¡­\LCå mv±NË*B½l $pà£VdõKŒˆ”±\é&×,Ež—¤špòŽëߢWf²EP fë”ÁˆÙ'gƒ×ˆ¤]è±`ê ì ¯ûmÀ©„Ý]P[ôªP4ë% Ãtf*OÙäžËbé)ÙܿɸiæITa²i$íÉ5ªl¬ü7[©ÞÁ ²W¥CŒޠÇàÓ²"e’`ˆ7£¶×$‡?ôÖZ×"ø 1ݶdcƒÆ¶ÌóG~´¶…‰$P}2rSþ(º1â‰zl9jf|“l€±:ç>­E5õÐcCJM‡“ÕDfõ¸&IªkعQÇ/¦r¨®\Œu9\¹ LŒz®‚¶QõÅE¾N5Єºt/$)Gæ—F}Þ»^‡ãH 樳6,%5IÅ‹“´‡–2…ybï ï¢Jù®wR½Î~©ãXÅÚŽì7ŠæŒR£4ï ˆTêU«óSK$"›5”6ô"u<×-Ÿ´E»ºžç^Ã$Y£±×P>úŠl¥°nV†­ÂJzIhÀï·*«%syaÝŠrk9ŸwV/vjGÒÓRJ%8ðͰÎâáTÿ5€‚fNF_Zô°m7­*å+Ðkm+3cd¾ˆÔíü*Ý .tBJ¹v÷ýh …¯ää5'á§ÂŽ^ÿ&òàc¢…%·”ЩAÖhTù·ä,ló™\üàå]m*×JLMÊ‹)|Å6Ø—º%³Ù­ûƒ”; Pš«¹Œ{#LXû$‰­KÛÛD ×=/ªY‚ír-K=ß‹%6iÅwamÁnÿï`wpÃu&ªÍÛàv­Ó»ÖûÎrññÁ®›”³»Á®K„{×5ªt·ìíˆA?¶xÍoTÍF.YÈÚÀÏܶߩÎ1¼Hùj#„ÀªEÁì­Ò×´Q1ÅÅ×Ó}Oƪ‡*M!_ÆØR¶­ºÊ2ÍÞƒ~*ïb§ìê]-,¡¯zÜù:RÀ[­*n²U¯j"OZÙ­»w©(¸ä7„­fεð¡luㄸAI9dÜ A±“Xÿ²ˆõÇ,!UmûEZ‡>ÕùpWÄ%Éñ5®3²]ØÖj¯Ê ±0Lï­Òð-B¤b´¡¿?!ÉJµŒÒ„ƒ Fi=p"c³^´½ÜøªZXZ³s)S").:Úfy¬ÀMÛ:0£],–UôžÙ|r“{{që±ÓáJÓ¡6 5½¬µ; ¹+ +´©é¶îÌ&;QdŸòìºÜiÁZ­Ž“|Hܧo•o›½C(à û׶莹)¢[µ$‰¨Ò2ѽIë«­pH¢LÉI¼ÖË û3ÓÕwJºÐ¤ö…Úܨ*o@tkØT2‰åróaf/¸™6ÜÚ¶iZÛ@ž‚oãSMòhô‡Á½ø·AòÛ’ä—¬_C²ò'7R'™.!:á6¡RÊjÐÐúÙ‚ û#óV{›¡ÎŸBaÀg8­>¸ ú8v¾&\š50WCœ-ˆ WA\ó ?Ãl,Þ¦[i‹dOÇVªÊÿ¯Ö?â߿ݨ¹nendstream endobj 295 0 obj 2004 endobj 299 0 obj <> stream xœÍYKsÛ6>ô¦_¡#Õ”(Þc¦ÓtziF·LŽíØ™HŽcÇ™¸¿¾ >€R¢%;™¼!Å·‹ýöA}^R–Ôÿëþžm¿¾1ËË»]^.>/XórÙý9Û.OÖ°€Ë%—ÄXÖë÷‹v'[¾ÔZ¹\oo«×+F eªºRéªóFPLV Å­¨¾5’üßõ_ X‚FœRÜ+Ü+û{±þùmõÛŠj2m$Km»…%['\8 xÖçâ—UÍ#°¯b«º˜ ½X:µîuÔÌn)kUt<+B±DhÊ1 o©î¡Hm{( –¡t:<9ŽãÃsâ(¹ä2@¹ϾL‚ð‘^Ï! z”pNç n¨ûïªä©IPÀ•F‚?…ugA: o㳫ÜóT—LÓà"æ6ÍòfõûknÚHhÔœ‘”ì1¤,8)ÙlRNâ}‡ÝDIÐgÆAž)qûÞQLßɱ±'”ç ”Áí¯ýc"8êÜ[Ù‹ëjãÃÑ–1Ÿ°›ÿhã¨I6 Ç{HPªØþ¨{PŒ¿é,Ðù´@ö«ðöbÊJÁ»4ax+̸ u¿'u_ ÃÓxñáU=–Rn ÷—Ò1„—”xÞE0Äß§­0¢=M{Û‘ni”ÃF ˜TŸÃÃ,¦æd±—Y„z?o³²å¥Í0.aï¥uxûžÝä÷6§DñRÌà›B ìžSH‰ªOÓ)ˆ‰Ø)¯«•Ö¢(ÔE¨´µÿ:¢¹5ý^i‡ül##.øèU áUöéB%éÂMú1ÌpmÜü~Ä´/g¤ý@½€#¤}9;í—p|ß´¿Ã†rˆfœq(æÓ!Å4a|©€¡<õ&h9 Í$ Ç£™9 h„©%Pl*§Á7¡VÆÑIÇsΈ3Λßj%û~€YÖµö0%t)L@ZÃÅMqA›4€ø€+ß—•ôZóÇq_W …‚ƒ{KøŽ2>÷%é θ̘ç¥/»RÎk/fâMîŸõ4(¨Ì—ÔFÕ«!QU öI¿Å  ¯ÐsF%˜†’÷ý$Œ‹Aî½”ƒ3Ž] dnÃSSc"Ë Ô‚ÙþN·ÎAg¤†¦Rκ‘$3j’º%Js vA½Ö´÷nŠc|: ïø¬Ö(HÇ›iS΃)î üc¦Ïï}˜?—ï=.–Æîù6m ëN§PKK\VÚ»Ûà{×Ä^GÊÙið›>ômájÎ÷3c¼´ïoF¡´OÛ°-Øð­€<îýzp{²#ˆÊ³ê¾fD"_.%ywÍ÷¿‘@ó™×q_¸„C‹~$>|-ù¶àðhƧì²üÞç¾o¾ÝAÁï>â =Ö‰&}VóaÐ têÊ1I„#?‰iÜÄŸØbcËt”¹h‚ÏaÇ—ýX¢_8y—Pš‚6C©é)›/‡‘ž]¿'ìÑŽ«ä*ÔÇ$÷½™æ|Ü(t²Ì—UÕ¿QïÕuuA¸iæZVë£B›–mü¥TZÇš &RóþôÌÉb7åW×&¦-š¯þzøsɨg½W€ Mº¤ˆÍ"¦Gêp<åbÐûv*Ðb¿}Û.ì~Ýíë¦]÷¤­ÞxQ1F-"r¤)bFdlÓâ+¦¨Š‘éò¿¸bfyR2•übŸ'³ðí†5RSkGv5hlÄÌWn³oŠŒvñ˱qh¤J:yµ^üÿþŒ(ȱendstream endobj 300 0 obj 1752 endobj 304 0 obj <> stream xœÅY×n9]죾bG‹Í^ãØÈja§8Jûà•cňå$.i_¿—Sx9œ¢‘e$ѬçVžËùœQÂ2êÿU¿ËõdïÄd«› ÍV“ÏV fÕÏrí/`üÉqJñlq>)W²ÌðÌP›-Ö“r51bb.—¡ùïâïj1'ŒSãS⬒•´4Ìe¡O:N¤Å]çÓ™$Üp¦ò§Ól˜2ùÁ”AKQ–ú£¸£Zäo§’(®„)•}ˆµÅºÜþhÊ ¤&ÿX´,µUË÷} ­EÙ¢º5Ï·.ÃèM݇‚#¥`Œz$‹38ûO 8ar^*Lj›»ÐìcVï1c†pß(¶º)Æí¶bä$´Þ×£]¢iCs.ÍòX,ÝkVÏ÷bÈrÍQaÉJAœQ”ç×S.ˆæJåï¼õsÆäWÓ8ìEH$‰¥”Êü6÷0š /´NÚjO ¿@ŸuΊü´\"´†ƒQB;›_øÝAP˘­gøM›§Î¸Ö„³@B¯KÉ´žVŽJðd¯3 õÛA–?š,þˆ]xlõ8ô‡Öó`Ýý0oZèà/ïç 5eÆ»p°}[†ƒÐwZûå«0ïÉ^ ¦ÎãÝrõÍ ù(@Æyî9 '9ò€ŠåIÚêsA‰ŽUþcÃÀŠ EgÒÜu€½ }ßBëb7`z,°Ž¤ŠÀ.BßÕÏ6`Gì{”~#ÜìÁ,-qšòÝ<°ÚcsÐw€À$Îê[¯ï~‹ˆÀ¨‘ÏCëi@~Ü÷*·îeÇ ›( ‹ñ*´Ðy2ï×g­“‡Aµ?i;̯¿^w\ 'm_ˆ”ý,Œ>Ýù>Þ‚R¨ýM‡ÚOÆ¡š˜„¶ó MPÚf¬¶ù÷J/v:žR"ÔS+˜žs­ ög PÖP’äLB/Ë×¾¤p\jV.RTUk˜žþ Ba#ä&*ÏOkÙÉ}IÆ‘p¬”ý´~V¯‰t¾öœ‘;§­ˆpÑ+(e®—`"=mÂq5ÇF÷\=á!ñnÈŽ7W1em5=»ÝxS[¢¬ÍÏ)é½pôy­©ÂX}Œ{› <\L^L>gÌhPŸ¯ìÀRP5‚ÈÖfBrûÊv>Ù›g·×wï&{o26ÙûËÿ·ÿü1ü̲ß&‡óìÅöU¯¦,!}Z¼œÎ4†oû€÷Áan»¤õÈ/°@[†¾ÓÐZ†|ŸÐ§]2_Œ}™Ïƒ–àÇÅV˜˜€èe’S<äïaÞ§”ûí@MtÓÚÁج¯º®û¡ºS1&>ìk9#]ˆ`fD\8^Æe£ºüõg4¿`åd¬¯ÊüéB°¸\Ö©¬ïäHÎ`+RFMÌKìÔuú‚Xi´'ÀðfD°>•¾tÆûˆ¸rØ@‰ÁçŠÜY¼éðºÛ4< µ^‡¾ö_JìaÉþàc`ÉÜP4só°(gɨ‹Ü…Ö*Œ~hg„*ä¶zÆO%:žuZ¦ë$µøÖU]ËÆ•¤‘­ä¬×ïj¾Ëd^”1Ni6ÊHX_w˜á¬#†VI_´ß¦GR 2¹žš/‰^êõÍG†añj ʯÒE3Iœ…ÑÓ!º|e¤u‡ ß:Œ„Î÷ågc£Å@oº óÐ(§moºW¾o‘¯·4Ç]@šF JôpÑά"°X9I4â”\ÃùÅm v€¨ä¬¸î¤¿¡ÈTlCíëh.!šár7„r­{Mð+ òÂÅw{‹Ò¤Ë"2úHòø}”‹~}›x¸'i8z8Žo¡«}LœÎ¯ýÐqÆà-ú·KÓÙzäü°žvÈy•8`SâUX›R †ŽÆËÙ[ÒÜš¥ÞA5¯§b ¬ˆ_@K?g‚Ç[¯¼,Âð ¢bª £Ý>{>Fß[;3}¿ÝÊâU÷ÜÅq’ÑFM\åî%J®±RéiŒË¶ƒWé§’>Œ>À|ÍX«¹Õme8|æ*¼¤!kì™+LM=/yˆ½8:-ÕZSû{û mæÝâ­ìÅäÒ‰çendstream endobj 305 0 obj 1772 endobj 4 0 obj <> /Contents 5 0 R >> endobj 14 0 obj <> /Contents 15 0 R >> endobj 21 0 obj <> /Contents 22 0 R >> endobj 30 0 obj <> /Contents 31 0 R >> endobj 37 0 obj <> /Contents 38 0 R >> endobj 44 0 obj <> /Contents 45 0 R >> endobj 49 0 obj <> /Contents 50 0 R >> endobj 63 0 obj <> /Contents 64 0 R >> endobj 68 0 obj <> /Contents 69 0 R >> endobj 73 0 obj <> /Contents 74 0 R >> endobj 80 0 obj <> /Contents 81 0 R >> endobj 85 0 obj <> /Contents 86 0 R >> endobj 90 0 obj <> /Contents 91 0 R >> endobj 95 0 obj <> /Contents 96 0 R >> endobj 100 0 obj <> /Contents 101 0 R >> endobj 105 0 obj <> /Contents 106 0 R >> endobj 110 0 obj <> /Contents 111 0 R >> endobj 115 0 obj <> /Contents 116 0 R >> endobj 120 0 obj <> /Contents 121 0 R >> endobj 125 0 obj <> /Contents 126 0 R >> endobj 130 0 obj <> /Contents 131 0 R >> endobj 135 0 obj <> /Contents 136 0 R >> endobj 140 0 obj <> /Contents 141 0 R >> endobj 145 0 obj <> /Contents 146 0 R >> endobj 152 0 obj <> /Contents 153 0 R >> endobj 157 0 obj <> /Contents 158 0 R >> endobj 162 0 obj <> /Contents 163 0 R >> endobj 167 0 obj <> /Contents 168 0 R >> endobj 172 0 obj <> /Contents 173 0 R >> endobj 177 0 obj <> /Contents 178 0 R >> endobj 182 0 obj <> /Contents 183 0 R >> endobj 187 0 obj <> /Contents 188 0 R >> endobj 192 0 obj <> /Contents 193 0 R >> endobj 197 0 obj <> /Contents 198 0 R >> endobj 202 0 obj <> /Contents 203 0 R >> endobj 207 0 obj <> /Contents 208 0 R >> endobj 212 0 obj <> /Contents 213 0 R >> endobj 223 0 obj <> /Contents 224 0 R >> endobj 228 0 obj <> /Contents 229 0 R >> endobj 233 0 obj <> /Contents 234 0 R >> endobj 238 0 obj <> /Contents 239 0 R >> endobj 243 0 obj <> /Contents 244 0 R >> endobj 248 0 obj <> /Contents 249 0 R >> endobj 253 0 obj <> /Contents 254 0 R >> endobj 258 0 obj <> /Contents 259 0 R >> endobj 263 0 obj <> /Contents 264 0 R >> endobj 268 0 obj <> /Contents 269 0 R >> endobj 273 0 obj <> /Contents 274 0 R >> endobj 278 0 obj <> /Contents 279 0 R >> endobj 283 0 obj <> /Contents 284 0 R >> endobj 288 0 obj <> /Contents 289 0 R >> endobj 293 0 obj <> /Contents 294 0 R >> endobj 298 0 obj <> /Contents 299 0 R >> endobj 303 0 obj <> /Contents 304 0 R >> endobj 3 0 obj << /Type /Pages /Kids [ 4 0 R 14 0 R 21 0 R 30 0 R 37 0 R 44 0 R 49 0 R 63 0 R 68 0 R 73 0 R 80 0 R 85 0 R 90 0 R 95 0 R 100 0 R 105 0 R 110 0 R 115 0 R 120 0 R 125 0 R 130 0 R 135 0 R 140 0 R 145 0 R 152 0 R 157 0 R 162 0 R 167 0 R 172 0 R 177 0 R 182 0 R 187 0 R 192 0 R 197 0 R 202 0 R 207 0 R 212 0 R 223 0 R 228 0 R 233 0 R 238 0 R 243 0 R 248 0 R 253 0 R 258 0 R 263 0 R 268 0 R 273 0 R 278 0 R 283 0 R 288 0 R 293 0 R 298 0 R 303 0 R ] /Count 54 >> endobj 1 0 obj <> endobj 7 0 obj <>endobj 12 0 obj <> endobj 13 0 obj <> endobj 19 0 obj <> endobj 20 0 obj <> endobj 28 0 obj <> endobj 29 0 obj <> endobj 35 0 obj <> endobj 36 0 obj <> endobj 42 0 obj <> endobj 43 0 obj <> endobj 47 0 obj <> endobj 48 0 obj <> endobj 61 0 obj <> endobj 62 0 obj <> endobj 66 0 obj <> endobj 67 0 obj <> endobj 71 0 obj <> endobj 72 0 obj <> endobj 78 0 obj <> endobj 79 0 obj <> endobj 83 0 obj <> endobj 84 0 obj <> endobj 88 0 obj <> endobj 89 0 obj <> endobj 93 0 obj <> endobj 94 0 obj <> endobj 98 0 obj <> endobj 99 0 obj <> endobj 103 0 obj <> endobj 104 0 obj <> endobj 108 0 obj <> endobj 109 0 obj <> endobj 113 0 obj <> endobj 114 0 obj <> endobj 118 0 obj <> endobj 119 0 obj <> endobj 123 0 obj <> endobj 124 0 obj <> endobj 128 0 obj <> endobj 129 0 obj <> endobj 133 0 obj <> endobj 134 0 obj <> endobj 138 0 obj <> endobj 139 0 obj <> endobj 143 0 obj <> endobj 144 0 obj <> endobj 150 0 obj <> endobj 151 0 obj <> endobj 155 0 obj <> endobj 156 0 obj <> endobj 160 0 obj <> endobj 161 0 obj <> endobj 165 0 obj <> endobj 166 0 obj <> endobj 170 0 obj <> endobj 171 0 obj <> endobj 175 0 obj <> endobj 176 0 obj <> endobj 180 0 obj <> endobj 181 0 obj <> endobj 185 0 obj <> endobj 186 0 obj <> endobj 190 0 obj <> endobj 191 0 obj <> endobj 195 0 obj <> endobj 196 0 obj <> endobj 200 0 obj <> endobj 201 0 obj <> endobj 205 0 obj <> endobj 206 0 obj <> endobj 210 0 obj <> endobj 211 0 obj <> endobj 221 0 obj <> endobj 222 0 obj <> endobj 226 0 obj <> endobj 227 0 obj <> endobj 231 0 obj <> endobj 232 0 obj <> endobj 236 0 obj <> endobj 237 0 obj <> endobj 241 0 obj <> endobj 242 0 obj <> endobj 246 0 obj <> endobj 247 0 obj <> endobj 251 0 obj <> endobj 252 0 obj <> endobj 256 0 obj <> endobj 257 0 obj <> endobj 261 0 obj <> endobj 262 0 obj <> endobj 266 0 obj <> endobj 267 0 obj <> endobj 271 0 obj <> endobj 272 0 obj <> endobj 276 0 obj <> endobj 277 0 obj <> endobj 281 0 obj <> endobj 282 0 obj <> endobj 286 0 obj <> endobj 287 0 obj <> endobj 291 0 obj <> endobj 292 0 obj <> endobj 296 0 obj <> endobj 297 0 obj <> endobj 301 0 obj <> endobj 302 0 obj <> endobj 306 0 obj <> endobj 307 0 obj <> endobj 24 0 obj <> endobj 324 0 obj <> endobj 219 0 obj <> endobj 17 0 obj <> endobj 217 0 obj <> endobj 325 0 obj <> endobj 215 0 obj <> endobj 326 0 obj <> endobj 60 0 obj <> endobj 40 0 obj <> endobj 327 0 obj <> endobj 10 0 obj <> endobj 328 0 obj <> endobj 58 0 obj <> endobj 329 0 obj <> endobj 8 0 obj <> endobj 330 0 obj <>stream xœ]An! E÷œ‚ŒñŒ’ޱI6Y´ªÚ^€±ƒÈd‘Û›¦ªºxHƒý‡ãùtÎiÓÃ{]ý'm:¦*ÝÖ{õ¤º¤¬ êüö£äôWWÔp|uåëQH7Å®ßÜ•†q¹2½É¯nÅyª._Hì!F«(‡%½c‰¬ ¢AÛ¤±Xö,Ñv ˆŒV@@6›Ù ˆÓ KoÄkÛ3™Í8ÙŽ™§&Çö'ƒ0rµu{/s?ä8ŒçîÚßk¥¼Ib’‘2ý†ZÖÂ]º¡¾¢0p› endstream endobj 33 0 obj <> endobj 331 0 obj <> endobj 148 0 obj <> endobj 332 0 obj <> endobj 52 0 obj <> endobj 76 0 obj <> endobj 333 0 obj <>stream xœ]O1à Üy?BÕ)bI—­ª¶ `"†"dèï NÒ¡ÃY:Ûw>³áz¹_({äh^P¨óÁfXâš Ð&ˆè¨õ¦ì «™u"l¸éôþ$ uÜÆïzö”RbKl"-,IÈ:L@zÎUïœ"ìßè´ F·oJ£œ×Z©UÎ;×((DB¥çjÛÐ !Ñü°iwZâ# 5kÎ ¾…±[Zà÷yŠ©©hù[«^ endstream endobj 56 0 obj <> endobj 334 0 obj <> endobj 26 0 obj <> endobj 335 0 obj <>stream xœ]‘»nÃ0 Ew}…þÀzÔ \Ò%C‹¢íèA" Š3ôïKRMQt8ޝ˜WÓéü|®Ë¦§·¾¦ÜtYjîx[ï=¡ŽxYª²Nç%m?&gº†¦¦ÓKhŸ_ 5]À2ü5\qz÷~–Ov ¥5ã­…„=Ô ª£1p,Öü/²~LÄòçªàH-Ιk†’" ||b-0°I-Í1”îYgH%Ý`LœY÷ PšY Ÿ kÔ²FHù7œfgYò± ïËÍ=ŠÒéÞ;ÖMê•ú¸µ¥âï ´µñ”&Ô7ÄÝ|U endstream endobj 54 0 obj <> endobj 336 0 obj <> endobj 25 0 obj <> endobj 308 0 obj <>stream xœ¥Y TWÖ.ÄîjAC§B•˜F·d1n1Aqß@EADdß÷½›­hè®WÝ4½@³H³ïû¢€àNLÔ$šèD13ŽÉL&N&¯H9óÿ¯P'“Ì?gþÃú@½í»ßýîw_Ya“'aVVV6n~‘~‰aÑ1¯mŒ‰ äÿ²˜µ·bgMb_¶Îæ*~ˆ °’i˜f ¦M®šåpÜ–}éX5ÍÀ&[Y­rÞ”»ðÀ>EK–,u‰‰•Ƈ…„&Îv\¶Üi¶¿töÓÿÌÞ”={úè¶l¥ãl~QþÃOCÿ»É0 [»!zcŒK즸Íñ[“¶'§ø¥úï’ì–¹»…„î Ûïq ò`”ÇÊ7V­^³dÒÒ×^ÿͲåŽ+œ0l.抽‚¹a󰽨|l¶Û½Š¹c°ƒØbÌóÄ6b‡0ì5Ì Û„½ŽÆ6c[°eØVl9¶ ÛŽ­Àv`NØJlö¶[…íÁVc/av‰QØLl…=Ù` ˜-&Æ^Äl 6«·Zoõ—I«&鬭?›"X/è& ïá«ðS¢Õ¢–)ÎSnOÝ=õÊs‡§aÓ¼ž_ù|…Í6ÓgL7ÍØð¬ŽÛFÚÞ?|1À Oâ«—ÎÙ¥Øý #?£B¨[Ô?fÞ™ùwûyö›í½íߟå<«íeÇ—¡Öf¬Be‘YàžóìB‹­¸’ ƒþD?',Ph ‡éÙr9}PEãbgÍèc±ë*À}_-êÄ´1E™WÌ~+Ø$ÌVÄæË3qyrnûã¤,P–š¤Žz:üF'£±7 PO‹Ä•º4Ñh–CZ“UÊ) ×µÆ>8™„3à%⯜^Àù mXÈïµµ}màVhc'6×´hJOHhâ~ 8IÀï'T®U‚sŒÂÛ{[û¯4„­•puèAÍi sÌ^Ü_*éËü£á?>º7³»ââêJH¤”e®ÛMþW¾£tWQ!x¿ªZ­Í{(.î*e¸Jd3öÕ9 ‡mÑnç@¸ÃÅvb÷î1’èT ä3ùÌrê±;Âò2Ò³#¤¤Ø˜ˆ‹Ý540Íöµèì' ½tF{è­ïCâLʉÐZ‡àÚpã:Ýݦ†’–F‘¸¿ºª¤£kæ—{Np/JVÓñô: P+˜75˜ÌMBq/ ÿŠ÷‘9²lF+s`?œ\­-a,¾Ó¾Áéhð‡(„äÙIvÖI«8 úÁYÖ°‡ 8'''Ή{ýŽœî ߀K×~Ê-rÈ:L|ܶ™[ÄÙÄxnu ¾çA›¦3WlÆ‚eWØÏÏ[€‹­Ç¶Ý#²Šw„í”m·‰Ã{¡ó׃+>9™z謃n¥ [Xô¶ÔØ¥,"—uì/r"®säfrá\"|› ÁÞ)é½á€"Í,0úCO üû}ÛoP´c ­¸µ‘‹Cáæƒmàó*BM„&_χð7¸Ø;c¨LUcßÚ}xV¯Óë´Ú÷‡;nû¢ïߺõJ@Œ<&T²ÇKpWnN QÈò½””œ<ÚÇÑ¡…Žì QÙÚVÞ D7\_ë³c£_DyW,:úƒ> ÎaŸãîù¡…›y–ÝëaíëAÝŠBÛOWW³=|ÀI}¿½ñá퟈‡±· í½°ªŽ{ p³Ôä"€\‰ŽÅ-ÔŠ‚ñg©C‡äg¥g‹Ä©p%;JTkK™p ÜÎìKµ(*2ËeýG+·‚…`~‚³×a‘ØìuhS'°iL|h·ðÎe«ÓÐFCkxë,Ë@/}埇MÀA§®«è\r éá—Tä[égŽT(L_çãäå Џ¹;Á)õ©XòÕM'›À­ƒNø ÞïrôC8é/íÃoOñm“ }ä¿ãnïCzdóc¹]ŒÓ;Uûò|ªrÈîäââz³NØ7ƒzCcyOÍ`K}Õ©Þ–›à–Z;ßšóc÷˜üË•ùI‘ù)bÿïlø7%D÷´„¸=SBÖò%dþD ÑÉ#b*!¬ô_R„«¸mÃ=Ö°]C ‘<µ3AXÈS»]]J§•QÐññÂÄý‰ûÂÂB’‹ëäù¤ti}Vu^5 ®sgOÁ©ð0@×—–—hëø {]%È*‘mˆÔä1"ž˜å´)È)«ÎV+p:rŒ¦µ´F]@©ŒêšÉ+U#0›Œe̸ÿü‘U'œaÍ΄ÃDáe]«ñD®™Äx5ÄOkPV«EÐN8Né‡Ì".¤‰Èf#'1yHû¥ŒöÏ5=#ਠÐ,D­Ö ÙyöëóVƒp1» 5¬ËØN‚Ëçæp'ãâ¡꼤0uaö0ÆqvðE.ÉA±Ÿ8úÒÚCϹ7¿8¡ˆs{{·`¿YGˆÄýlÔCqð¨æö@w×éŠK`ÂÒ±?Œ"Öòpw²/ ¸e¨N Q±a7é囟«vùⱩ©òðtQ~['àjq°_•˜ï¯æ{]7Íh Sm/èQõx³â¥£5àká ¼h$ß°CO#› 1ü#så@e™RÚ$)Ó ž¶»ðô¬xÚZî†óìÄLw'ˆºKs·é°µþš+cÓð’ÂcÚ ú´ïèòu»²ÐÅ9Ð@ò…‚,ÕÓZ SSU*] Dð¥¯îC›ov s/äÊã°ö¤cQåD>qÉ¿øDWZ6‘:OTnyðÁ” ÛÖýq#œWÃéáÐÚNü[ÇN&t—ýó¥t" ø'ñoò6ïDýß‹Žç›Ãkâ*RJ³Û³6 9¹) “ g®=LŠÇÒ³åq±3>s‡$ê®§Þ‡3ïzw/HËê?:œÎBíí÷‘i&K™¡¨²Øám¢‹Qwt©º··¹ÙÜNrº8ÿ˜ˆó"Î4ú®w‰ >x0òÄ'×:Ï:ˆÇ,·pzcúŽ-Û=–;ºõ^ê´´7—8”é; †x.ü?nB×J!þ›[xç³;.'\y ÷Yë÷8ô§‹‡àñM\<†sÑÖž°ã©Œ‰û]Èž°£ˆîŸ:²fÕÞ}«¤Â\)Lä¾A’pŸ?Ø)ä}:ù±!zEaB ·Ö“ç«kJë›ZJ:@ŸèO;‡8[y Ã$±ôZÜž*‹þ=Uàèø®[ábÛ{p1Gò€ªÚÆÝ6hã¿úÔ/‡)òò(5PÒ¹´èû¢?Ž9âNßð?ßÖð¾Þ¶¶Þ¾ðVÞÈβ=euA¥†¶ÖC8çûË÷ÝÉü‘+ÄÀy_x¼»°Î6m°D4SÔµ³ƒ¿;Ó/ î’®ô ÁÝIcc^1¹­ÆÃ´ñwÝ¢uœý§v=Œq€³ýÎËê#ÁajÃN÷•[w6 FHr?ð÷Cö¼lÜž³ Ùÿ!àa?"ª>ט@ê¶z„šO´í†“JÉ5 ÂЬ ²A«Ì# ‡5¡Ú·E=BÝU}³†yÕ’)S…¨x¥çæ(•9ªøÿØÁ?e3¥b'®lGÝwõÊ_ ±­ ÿ7M ö-•]Ø\š*‚ÎmÂdMšIjá@~ÞÎa±w¬Ç˜qsÀ UY¨G}SK=Ã%N‰ƒ9™ÃBc¢dl[€OYlk\sö x$‚ îkPaîÔ’?7{ÏòqÎ=1gè Ýÿpn—Àþ§'¨iûhœäÿuáã²þ«±?<{âñ;Õ1îÁø¡èB‡¡DÉé|xçñ[ëUÕªJ¥UžÌy|Uð‰ÐT§3˜4…Z“ά)Ðê L0Í#Í-fs¥¦…?ÝFu$ @ bQw•ˆ~¢iTÕt‰¤S ]™|›Ëýä–³vÒ~•‰¿S5JÕûáù‰†€—³uO¾íÄåO$Í{ü`åÕà8ý.°XMxJ÷DÒÚzÛzF‚ß”pëù¹êÈq0¼571õöâòzÐL_ÿ¹þ4 ¡÷4ûÐ0­½?WA( ä°ˆ$e¦L²nwâ…€š-€Šø/aHGH¿Œ¾ˆ5¬XmDâe @qIqÓ7N‰©ˆéOîׯqoQU¨‹²ô1txügÁ5aÓ§‹± þ¢2³èñsúÔ CeŒjC²èºÐòea¾Ú°›Hó€¹²\ÓÊϺYMó]ª Ä1¹(‰¡(ÎȦ*ùbÞÕ¾ ¿JëÎjK¾Hùse‘2Ãy)õ¬à÷pª5\ÄvpžÖ„HuWMÑe Q JS¬«Ê7Üfå2M2³WKåælÕ„ƒPj>锼µr²­¡µ¸ˆ~úÀªÕ‡¾µÅ£ûf˜C”´â­ÂøÂª#­E‰þ œ çBë·¯qÏΉÛçÀïbEæÿE¸m„=¶x]í!ÝqèÕõ^³7¬®x»Õ§Óó\ÜG¼K¸÷šw½¾Ô-0iÏaÃ7%gšû{/^n»´ÀŒtiÉmç.#Ý{–9Exîw ºü—Ï{/:L´£F8•Å ›CpsT‚haØÇ8iàãË(rH­+ \‘ H¤DÝBÃåÂýÒ½$a’;ó¸´PŽzUM»‰1Ù3²;"±¼òkõCëºspL${>­hk;7ŽóiöÚiÛ¶/\Áß­ƒ“ìÄ_À%ð:ñf@ÐAà"Zpgê¬fþùÐv0£;ºU’T+-ö/‰o^¬í:?óÞ–ó¨ç¯qá&ojðýØO"þâ[âFxS(Ø'Ú~Äk—ËÁ‘[gÊ[NHÄ7Gà$bsS\#8):ÛÕ~á½>ß]¾iѾÁã†Ù3îÁ®ÓVÍh=W(¶þNF¼¯mа@ÉÅ;ð7‰à&ç?r³¹™«¹ùœÍ;[¿kµèË-’Kç”®ù±òP*ugˆ×‘øè4Ÿ¬ r&C“-%áFöñn›ÛÜÕ±An»‚.|õiÛÐÂû°@÷Q+hµ†fxŠà‚V .t†Â Q.¬œx¯¿{‰Áb—QÛè÷TšçóÂÐÆV²áDã’®Êóg 1á?9Õ¯ñÿÂoÖ|ÖÆÔÚ‹ëj‘jüþ‰j¨ øûÑZhë+ÍÂú"©·—ÌË2â©ön—(Ó3Ú¡ÍçEÄ“}Dˆõ¥¿¯u¢ôCíï¸YÄmhÛ2ÒqSVFz§‡gÈÈÙµä¨ci&‰TzÀIVÃp„È“ª•Y¡¹©ªì¼tC K„º†¢Ž²ŽlzL›—¡Îc™5Ê¡y„_p°Ÿ_Gh_ogGoopWZgH†ô'b,àÿž$¸/„‰cI‚ñôbo [µÂihiÖ°¥× à´-loÆ›€³q —–ÀpÙ5(€ºï³>ˆ>-‰8ïÞ´ˆ’ FZfñ-áÀÙ‹¸9áo¹F%kK“¤Ï‚VÎp²~ØÒYZ_in?ö¥Ð’¨Œý–×õæ4Ó„\²/ÓXŠíͨWæ_LT–‚ôßííÖj¥% ‰‚¿ÅÁmíuý·Y&’³9Ìá»3@|Aª)ξBj `€Öä‚(ÑcWDI3UK²-ßÙÂ÷øUuµ*B쵂Bqg¸MÃéju àßùU1fM}>²9çäjÜß~ÿJçup…úÆñcn†›ÌwŸDÊ­éTûÐÐt¢¶Pï÷ÝêøöúõÜ:ní8 çYËŸláEh½ ΰ_­‚Ë£6Á¼®WÖ–;Œ4ÊigžIî ¨wˆ/K.ôщÄwoõ´õ¿;óÎÛïÌuÈ ß+‰ä^´ +®v¶¼Dïu‡íßéã¿Õ!T˜ºAŸWYX®©”øêÍ!/çõžîCÃÌUq •™•IC'†óïð¦n 2up U„´wj|°z'-1ÈôjF$vcš+y¼ ämY'¢ ÒJkèAêì·qZ+X_‚ß3Wtpnn1Â=–qo¹pÄ>n.uí8QX¬)0ZŠêŠªtÆ÷ ˆ4WÕöv^qwqYùØú’ÀáÈT8ý¹!ã´ipzÅ´ç1ìHŸ< endstream endobj 220 0 obj <> endobj 309 0 obj <>stream xœmTkLWžeÙ»+ ´lWÄêÌ£Q£€Xm¡¦Ö¢Ø*ø¤¦Z#\Ø–aÀ²‚´x­(ïÇ®¼ •V­ObJj«í$ÖF#˜ÔšHZ[±jî´wtvQ“&“Ìœ¹'ß9ßw¾{d”¯%“É”1ñ ‹"ÜŸsÄ×eâ q¦HžØô\rð휡\„÷¿Š xë+”\&cÍûbØì|Φ7iç¦ÌÓ.ŠŠzk62""J»Â¨ã )IYÚø$“^gL2IA¦v3›bЙòµs—éM¦ìèðp«Õ–dÌ c¹´wç-ÐZ &½v“.WÇYt;µ±l–I».ɨӎu6öŠaÙf“ŽÓƳ;u\EQSVdm]¹*7nÝúM†ôŒLŠ ¥ÖSÑÔlj•@-¤Â©j1µ†ZKÅQñT D˜ò¥ò©g²Oe§|"}®ÉgÊ+ä}k|Ÿ)ôŠ¿P„èœ":ÂcaHÖ.¦Ë± iöôÙË2! l°GG&»Óì`‚’Ò⒒ݰKelƒú1jlÎ.+¤1ÇŸ(ðRt|–"Í ™Æhd£†6è¬Ù¬è0SRa†BP‘Ѭ)C׈  Ó§(äø ‡N‚Õ·p´øš¦êRè÷‘“€Ú –9K½^Œj%Ü.lL"^…ÔgÝìë¿\Ë®§‰u§Ò“×îÎ[81¯~|f­¾õì0äå©<µE;/Ãy‚\Ü ž×8P]«”ž+¥ÏB…3Є’b{4~{·#¤Å ]¾8nzÆð\rEAÖrÊñØß‹Äáµh¼Ô°€ù÷"Ö<'SÇ8]v3p2ÂÁ¿a-^‚ß\‚瓆(]ç5¢ý%V ¢"“6’@"gƤ3ó8Ñ£]°pVØ.é÷ïC^cô≠:qäh7s_ÙNƒ,V:–4+Õ.lÆÁÊd°õö€³‰y~lK¦I0NÄ¥[P˜{zÁÑLÿ¬ì*9f ]“PaŽÄÏÚéfTÂã[|Ð ñ™|°z÷ãJ鵂;œuhu5|¥jëîúýn­1§‚.+(/è•”õÐjÌ=`ßWJ':!O2Å;¦¨´ð§ìŒzäâÞ;»¶LOMMؾ¹ê6Gïoöà?}Çñ#Çð<Ħº"(]Ž>[—)-Á,(*/,/«€r8¢ê05XL悬åÂ)<ûKð­ÿþß’>Ø_²§ä¥¯¥+ƒ±RÑëí—„M0("KÉ~:v×xvÑeßæp˜WømCèÎMìOÂÇö°§}?/|&ziñáKâ/óõlØ©.;ÑLˆ‡½ød*šR\%ÆÅË«É?¢äýÚÏ7Ÿ ˜Ä“)ê?®±ƒ´ endstream endobj 18 0 obj <> endobj 310 0 obj <>stream xœ¥V{TçŸaav¢±tRSÍÌ *F1–4˜XH´(‰Æ(‰UX–…}°»<–‡ò¹»(ÊC‘—,+(!ÄEcj"aÒh4kÌ«Õhšâ‰±MÏݜϞvq±úOOÏÙ3g¿™oîýýîýýî74åéAÑ4Í„E­_<òÏß5vÍðp=&+&™®–ŸWy¯ |=3|¿ÀCSÑ47»|a`E­¥¢©©uÔj=õ2µz…ZAm¢b¨•T8AERÏS/P«¨ÕTµ†šNͤ¦PS5C* åI™©>z]B»<Š=®ÉVËÚÎi@¤1À‰aßÉ0WsHþù ÞßZ¸ØæÆº¶fËÑß¾¼ÁhòÃùžÐL®V ì€}‚“ ,s¯°Ê]“™ÌXx¥ˆq"ý£qvJŒÂñ ‡0‰ÑÕözþ;y=ØU*ÈHäÉ#‡Å™L0=»8–ïöT7Çm“v­…LM›”O ¹Â«î\±J”¹Â] ®Z5æâíE%|\ÌÀ’´gÔ ʾš+œ*¸´bØD•6(JÙøA:_¼ÿj°*0Z„ÅòÐwTÖ•9*ùšÓÐ =äÀ÷oÚ ;Um‚Ò_^Yµ¦:Ù{ÇÍkeÉ+oKn†*`GÀ chÞÿÞ@ã“N©Â2ÌtÑ15­d=ä$è fŒ½ÑÂ?,ÏÑÝÑÖ7$“!”3éÜ5qðÓÃ:(HÍË7–ò;â *`Cὦ»áï Ü5­Ö=²N`–®ÈQ…@[ä÷?·1ƒºoNvÕÔ7ó»tv¨öâ˺o‰t³Ë<’ƒæZ&ÀgÝ¡š˜YäÃYø¡W“ûuéù]·´0èIþ¼We‡Fx´ì°·‹ÓÇü¾é“NL—H„áîëUÉc¯Í†C}𣾥ºÓÆÃ«u¯­ÊZ ÕÀ~Õ›°^PWŒdJè'«ü⸣b¯Ð˜ÒSÒlËÁQh¹ª‚²ù²s¤ƒ9>Sm‰/ÝltÜ‘7O¢‡Y«à–þ14r(ÃY^o2ûw´4޼„矊¼æU;ó]µwI~&³ÈCd‘W3Ú»QÈÇ4©‡4á22_Æ+Ý0>3XwÕHqI†èjé^‰{„TÜZhr[ÕÎÊ ¨c;tÅ“%E.±fÖ »Kš¡¶kÌ+³7çlN{¡ÈÈ–2%ûŠêâzçL«&Ø]VQVY µ÷¼^l˨/Êw´J¯£‚ü4­¬ÐZ; $õ¹KVRª9¡¤¢~Zi{Z XC†E«lß2pyàÒÇã:“Lõ©57d. RܬŠôÜ\0ð–-ʼD`ƒÃÿtåDû?ѯ­vGé.¡¬ÔZ 6]cV3°Žú-—fÁfMøßßaü%>Þ>\{'ôYi‘><:ï$… =@ÅÌæÎØ]ɼ²¹ ˆ™|}zœì±·¶ zÈìåï‘ì2ü÷Òæ¥ËŸ_#^ýV/œ9±q=?–Êo}%­]ƽŸË\Ë0š«·CúFþ•pdJÀiJûÜœ3𱾫Í#³òKÓò…Œ?Ää'à XÑŸ}™µq5çÎá4…—obÇu„>’”VK¯ñ¸Ï“øcû+{ø²äƒ¹uÀ6ÜßþÑ3»@ˆ™ïöü 20a’6¹•0ª”Ì! êÂõCô_t”áÈsµù¹ÝÀÞ¸xñÊ‘m‡¶× U’Sl妺¼z`íõõöCÆÖ†­…©j¡ \Õ´Ø€ÐРä*ucªP¸m»ô «ÖWçÄšt1Ò8ü Rk¥£Å©®^Y6 ØÉk­¡;t;Ù-ðŽµºl·m—pí(·iKÏ©S}=Çz·nx%vËÁF"¸«è ÏÆ…ÅÎñ_ÙÛýVçÑ“ã>{´Ç<ŠqÕýcé¶éÿ?G»r)_—ºò‰ë=Îa²kµ&“Vk79v»ƒ'QÄsû–&Ä{‚ßqwÀ?cFQÞµìHäþa ”øø<0öæ{bO½íÏ@6¨RS“´…`c™4wçUçÖ¦C)°i†ì¤¥·à(>ÞƒÌEÁµL>žD—IRW†Äãô¸?Èbfbt™:a}Ù}*J÷g‘ùÉ\*<Å5z>¥‰ËIJå3;õ{uÒ¨Ô¥ŠZÍlòØ´C»@äɦ;e¾:&l$ &ÿº÷Xwc¥y#O²äùã:>ÿ?m‡ÓñiœNc N—á_ðß\wr«Z©OV+ÛõGº[Ûðä]ÏûîZúm¤ Ýwö›³¸\b6Ó•ËmßVaviD0ñ&^?ýeÿÍn û0›D©"äQNÂq2ù5ÎþöÊéöC)Ÿ^²#/OÐhÕù`güè뇛½í©ê}B49ÇmÝzúÒ}§zz{×…<·ååØ;ÈÇQ|?hiCpãÏæÚ¥üÙ‡Û½ß °‡µgÔXŒ…YyÅ<ùò_+^Ï.(|ÔÔS×¼§¶j×X·o‰.Vúhøì¬ì-´rÛ¤AΦìÚÖţ퉵œ±Ê­ùµ·.¸gÎ ¼Å.¨HâS#•nKgIÐm†Ã¼îE®Ë'çWºÂöàòJ†d–ËÅIN~’§Eïë-úú:}¢¨ÿf¼K endstream endobj 218 0 obj <> endobj 311 0 obj <>stream xœcd`ab`dddsö Ž´±T~H3þaú!ËÜÝý#áG*k7s7ËÂ’BßÓ¿§ðO``adÌ+nêsÎ/¨,ÊLÏ(QÐHÖT0´´4×Q020°TpÌM-ÊLNÌSðM,ÉHÍM,rr‚ó“3SK*4l2JJ ¬ôõËËËõs‹õò‹Òí4uÊ3K2‚R‹S‹ÊRSÜòóJüsSÀnÓ“Îù¹¥%©E ¾ù)©Ey‰Å@vfq6І FfÆ.&FF–µ?:ø~,_»à‡Ô|Æï G™~—ÒÚ×=¡›cöÌsç5ö×L’÷XU<-jþwΓûæM™Ü7ubßÔî)Ó[çåÊýVÑœù]£wNç’¼nÉÊîÚš¾ZŽzö™¿5K>ošØÑÝÖ-Y][WY1µ}V‹ü¹œÅ {Ês†I4wT45w4¶v4v7qTά›=¹·{î¹ïì·k~›²–Ïiš1cΔùSÛWwM—k_Û±±c_ñâŸö Ø~ËMgßɵ“{ç\ æe`ã|¢Å endstream endobj 216 0 obj <> endobj 312 0 obj <>stream xœcd`ab`dddsö Ž´±T~H3þaú!ËÜÝý#èG*k7s7ËÊüBßÓ¿§ðO``adÌ+nêsÎ/¨,ÊLÏ(QÐHÖT0´´4×Q020°TpÌM-ÊLNÌSðM,ÉHÍM,rr‚ó“3SK*4l2JJ ¬ôõËËËõs‹õò‹Òí4uÊ3K2‚R‹S‹ÊRSÜòóJüsSÀnÓ“Îù¹¥%©E ¾ù)©Ey‰Å@vfq6І FfÆ.&FF–Å?:ø~L]»à‡Ô|ÆïU™~×Ö4§~r7Çì³fÍ®ŸØÔ/ÿ[ùìëkgΘ$9u´ ݳ9fÕͪnéì®(–ûÍf=ó»댆ÕM5 r“Ìûòz‹{ó$3ßl˜R5½¹[²º®¦¦zzë”vùïÊžÚ±™µu-’m mÝÕ53jfOêíž·Xî;ÛíÚßV¬uÓêfÏ›2kš\ËýŽ‹;WHò/þi¿í·Ì4öm\Û¸å¸XÄÒêy8·Íááb^Ê¢ endstream endobj 41 0 obj <> endobj 313 0 obj <>stream xœ¥y XWÛöÄÀdÜÐj§‚µ3T­J­ÔºkÝ­Š î ¨(Ê$ìdrBX„=a «ŠÖµ*FkëRµ.µÖ·ÕZkmmÿöŒï¡¿$}k¯÷û¯ÿ¸`æœyÎy¶û¹Ÿ3<Â¥Áãñ |×®}o‚íßQÜëñ±‰X@Œ#6ÞÄb!ñ.±ˆO,&Þ#–K‰‰„1‰XFL&–S_b*±‚˜F¼F !Ü ‚O %\ˆ× WbAo‚!(‚%z}ˆ¾ÄL¢1‹èOÌ&܈9Äb.1˜G¼Bøƒˆb0H¼Jl%hbv'O<â…ðnöÒKÝë7þ~½Ë`­ËO®[]Ÿ‘±äÁzÁ1ÁŸT õSïøÞ¿÷Iès»ïÛ}õد¹ïþ¢þÏÝ|Üö 4@8Ðk ñ•…¯”š9¨y°`°vð³WÇ¿Z@¿G_{íƒ×N8$yÈî«=ø³<ž?ôÖëc_ÿeØÄaâa–7^{#„éÍ,dr™Y>;›ÝÁÖ³³?xŽðÜé¹ÿͱo&¾Y=|àp͈WGHFÜçŠÜ¸"`.®¿‘gæ¶ñáÇÜZ±OÄ ¤f(ÃÑÀŽz÷01ˆŠ2ƒö²Ä bA[]\á²¹¸FÄþuX ÂX¤†³éüƳ0-÷8¥%uâ’@s ÉÜí+Þ°ð~°ÂµV>7¥ 8:}ñÖ`iÓ Jv0KÉä,±K<„.9îàh²¤/’Ù ¸”|z¹íŒÅæÇ Ä ÁËg‘ëq ¶ÂÛ4@©k…}›Ñx|™ÝùZ%;yÏ€Þ®åµ]¯¾ãX×HÂþHŠ<ÑUêxúľŒHØ'Ðÿ9òwMˆî2ÄÇ$öÀD ²ðYa¢•‰ƒt§ÛÜšE¬}fPÌÂtòÏsçÚfëÌrödÙ¹ãàsêúª{¨ƒ£rÁ‚¯j|wûï\1•E:LÃD8Dð³qrèæ`ß ,^Me_Yx+4aûúþ2þžJŒƒ^Aƒ¾ûûïßý1h šF/ðýâÉãO/]½úéRï±¾sؤZ¸2 ï ž¹Ì碸{t¨ÊÔiÊ &S¡e*ƒö”n¢=ƒ£e°z‚½¿|üMS€Ä£3ç·½[Âêâ TF@µ€ £m9$²À Ý1‘cåÃ@$¢FÖD·Fµê·ÇOà`8`ê#ælM—³- ô¯ÑÒ±Ç)Z~ã’èsííÖÏ-óß»xñsw}}’é lžVlž@î]P r@Õ¤ ºK†)aìR ˆ›[@U%s ÐÝŽ4y ÈiaU ’OÉ–ü‚fö¾ T‡‡8)³5z¤ß³Âr+ÿb·Ÿ;ƒ¨C!q å-$¤Àápœ4 ŽE,rí8IsŠ'HÆV%QÿUÈ ñœ t×Â;d…F¼kΓîYX*w\„ÝÁó‡^Enߌ¼ë‡ÚªL,Š $w%|×÷¤„ôšÍÓÞŸã{ýá÷W¯Þþ¢m†¯Ý:0ÁwtúÂÝz{c27Õ™G±*±†ÙQ$ØcS㦅Õ÷HÙfYƒú^Êåݰ–Úâ½l{íçñŒº$³H(¼# ;Râê àP)s4ø£Ì&@A_ûþŠš¶ä³KW‚Ô¹©ùû'91ÙL¶¤"ÓàȳT œaÇ-¼V+¬ÃQ´†Ðƺ®ˆ@Nj"Õ+¢‡OÔŒÙ8u߆Þw»sütðèbV'ª…]á[›> ª4u&“Ö¸£b+ð@}F¡×‘ò}Ž<`ï¶Ã­{ؘNóš*»MnX~1v:z"ö@×›Æu¤ÇphÊ=Ò™>EÐ…Ï%ì”Kzúù™gæçFPââÍJ¿t1 f“5¬3Î>°Â¬á\î$]Õ ÓI,â9t¬BA(U9r&‰º«êPÄÙ©”²ç˜‡á6%Æ9¹G–v8²[ÅžúÆ ¥;ãæ/U-’œ¾8.p&Ø×ÄÀÁßÇ ä»„·>Þ_[ndv×€ræÒËkZ¶`Vò¹“«‚žw(Þrʇ*Ǭ·lBÔ&øÂ«æBøÜLì†:'[ôrèWKâÚqð¦kíËgÔ‘P€ž…bd•  í¡zÄ—rR>·‹¯©}I¨#7!‹«†Ì¨KlOo–Y3 a d¤Ê–I+£2e”†Ü-®Çœîz»Ô°Ðã¼²ÌjàqdëW ö–Õ™1ßЦä M³K²åûA90‚üVÊß,¼v+”b×L€­ô~wÑëÛß‹¢+“ªòZ²k«Õš² Úb`Õ`hí!ˆZ•µ:ÃW²)aÙn°˜úà“•›/æîûˆ1†ÌÚ¨š»ec$ÙyɬÏ%S¨ø iH‚?ÈÔªm͇Îÿ¾ög{|÷ kà¿i8npm¨îòËT‡»Ð.dr…&£ Çicɨ&?8ñ g Y”ëšÒ=þ¹}<ˆXÒî…"ëº×)xøv¡5ظsGÎþŵºæ?Flâö’°/‹¹Ä4×P§<èe—#Ñì8è!ä*Ší=¾c®¹kTOÉŸÌ}ö÷4é(°¡¯ :˜ ¨·Ë?×xHX¡ Ÿ‡3ä#'%ßvlº¥CæT{uº'(·W'ãƒT¶ê„¤°'±ðßù/¹"œî‡ÞOöÃq«®Ê(J7{C{õË'›Iè‰:rÒAÐx€¬˜IIBUºÈK®V§ËĤ:±L,JJ7ï8ù´ ÒzÓSTnà¾mcw<ºNâ E²š‰[»Y ¨) ®=>Õ€];ÄlÊÒ°ùYZ P낚4y€ªª,5_¶¢9k‘çTäöx4ì‡î}VæˆÌËí°ç‡C§%nQ…ae''ÁÒ¬œ´j À”n}w Ö± AŒ¨K¡/ìzŠ@ ËI´‚¼]ša÷5ëž­(6àt*×ë+rKÁPBuĽüE… ®(Ö“;*UCõíq+<„3w Ç£ E99 ¢‹µ=°³¶ÖV ó躚–‘d]¬í7»{O9ÈG(ª8‡ckg8bÔ~I8¢dbYО€zóݱhðÀëkÛªJv;H9øWˆöîôš€és¬¾þð‡Ë—¯Y­ÚàÌGí0[x%wƒNÝ#ñ€òù§Úó“Séᤸ“J+ˆ©Ø½:¦¹BqT£A·Ÿå ª=un´S™ëjÈÌ"yìTzž…¯c¼ +/ñ¹Ip-mª­°÷Òïq>SÞ£1çô³écßÖåeUEHUÊ$+Zí£–‚i`é'i·(íYºøkëÉOÀOÀ4%gÕÓ2œµB3¶ÞVh¡á‘x3ZŠ–ÆG£6tÄ —Â¥&3lcP 2ÐãA\MÚÑ”Sà!8>×ŠŽ—œm,¾î€æÔ’õ0 ¬¾`vÚº´q±Þ 'à«8­}¬Ïïò!°1‡þNiÝÿ$yû*hf²ô»Zʪ õçæ€¤9ïo›À¬ã ?¡ËNÔ;Þ§‹"úY èÄ¥¬Nò«¥á@RW¿ûöñ‚oÉ¢ˆâ¶°¯ÃWÑ$§pùü¡máz¿À%ãØ7m‘¬.j·´Ã vÞe+\c=pŽý>¦SÀ™J]NŽž5&·¤ìÔ£«×Ôªšâ[غ’]©6/¢A£”¡VßX™Ô²F˜¶ «Õ 5~áüÉq¹Áõ»Y©03¤‚r¡^¾6R²줦ý¼ÃåàŸ/Þ‡#ÑBÆøC’Þxäüù£GNœn ðóÛ°žm@?Ó^ó-ÍÝÛZÍV—‚+€úöæoõb»[ö.¸þ{×ýþNa:ÿÿ{ª% ‹±„n™õ¸uÈàøž£Ï67žg¨¯æßG}4ûGÜ„äàSw0¹lÍÂêx\Ÿ·… ª2´,¦. séKÆ+ûŒòâØÈ¬X¹2s‡,9wä¥×²ƒSRb©¢šèù0ê:ùÝ‘•›7o]ùnO9}ôÓq¼œå>¥k%F‘H"‰Œ’ÚZ£±–AsÑ0G#ø;ºŒH§¨irh=~MvZ²'£N]„‡.ò¹¥]Mx|–b{*³¹Í/?£Ðœ9WíÝ™§bo/Ïø?¢› åµÂЏBRë¶­œ9yAë7jFSª)ìj!ÓÙC˜²õ‡ ÌÙmW”‡pází_ß^Ýv$3‡ÝqHš3ªFœ·³@‘T¶|H>yâÊÍS;¦3:ivJ½S×.µpmz» gbÍ;^ªùÊnÍk@ Ý:Æ“ lXÜÅjr¨кS&N‰Zð#8¸ï8u’),ÜÜ¢¸E‚nsسΠ‡Z¡Gë…/iÏ^yI?´C±Å)Î&ÿGŸfG7 ïw Ê{¡g<ìãÚè-£þÚK¢)ÈÛþj_o…cäÃE “_G9µÛ÷ÉÛ70gšàÞ}V]â£íÁÎåXx7­0ç×2¬Ù‰5ôuÂô”D<ŸuÖ/; >5 þaÞ/$êÿÕ¸gϾúögþ³gèªoh´S–ºu(›ÓýE' ¸Ùö(7qû-¼ NÄçVà6u³Ö®c´ÐÈÎ@_¤lLX¨ òЪi‡Ó‡º7Ö8Ülâ«ñL- =:ª v›pó¨Â$½`Õs:xºR¶>· ¶ÓUºL MÜͨJãöo "J!×4Ç "»e6±è² <®kû÷»éh — îï;}¤^âÏ … çœîúÿÓ”qi|n76@~C—Zóv¯&·¡[J?¹¯&›@}ÍnÙJLÒäøŠòø y Ú¬^‚I•ÆœU¢>¸‘éîÔ†v‰jyØBŸwu’léàQL  :;ï#(É9;œœ€PB޼PbkÈ÷€l£®Â^‡á œjá}ÓY¿8w¼K‡‹Ép…"‚EFA25–åäê™Æ½GÊ>Ôíã|0cáò©Öד±99ùù˜\™Å% òpõΩ_-€½`ÿB—Ÿç>CTØV•x;× ì+=ßÇ.»«phõ…èBèþ¯Ÿ~Ä.­Î,MÌPg¨A%-‰¯«+­¬>tl‚/7ÌT¿ðÉïO¾Æ´÷¤oFlô“lc0+>H{ÆÁaZ­6èX—{1ÊrÆrïöÙ%3'ù¬\Ð &î…×f½€ÕìƒÕDPDR*„·4i›JÜx®€XbQ!f‹Å”Í ºCjU%âNþ·» &L5vÌ…úÎóƒsVXuù~Eß­ùð4h§îM»z£ÞÓfM_}|Ã-13*iY@å!+Mª¨Ê¯(Êaà_é›»,›7ïZ=wnëê'Z-7™Éóè4©ùرJsQQe´¿¿4:E«¸/é[Áç¶lÚ½jÞìý~ÇOî;Ã>³áÃã3£·Øfâ]3qþFÞYnŒí¨<….Ì/ÊÃhf’’˜,B“ÒèÚ™ªT¦T +RêÕðK잟¡Wª´Â`2¨ ÓòYt ®pµçî‡ZxõV}û½v8«9w fGœD¦1r׃bv·Wô‚Ø­¾•›RO?iŸSÇÝX´aã–wüõ«¾ÌŠ…±$ ¬÷˜dþgÛö7Õ0Í;F¶aZwõX³H›™"²Ø¬(yx  vo=—“­ËÍÎeM­KRȾJ'Z@;ÐRçªjö‚9±2lÕbFŠ\èýÓøå¨$Qá¡€ Hÿ¤þTyù‘c ³Éú/+¯•[ÎçÁçtq#ÎÅ0ÛÑèS2) „…7 Ÿ£wèÒÐÒRYô;™‰­ói›« ®Âd·Î‡µœ‘Ö*íÚ Ú¸1›3#}bYr‰éùgÐíVHKpD’8.¶"Þ\­Õæ0õÍrXOòó‹€T¤å+rÑ—0Ø]™£È“*I–/+R*Y؆–ãÒ7]‰CQæ_‘ZÊdkõÚlP¤÷èÌÃbŒ6³mç½~4(Væ$"æI(ž‚'Íp$ô|ZR˜oƒÿBuY¬hÞjŸfÍ,¡7x þAïëŽ.»¾3ÛšÜòÖ!°€§¸“·¥?/xztÞg˜E‹U òÔ|uE*fK“¢¡¹‚÷¢Ðh4bLŠ\¡)”ö¤ýsëNÛÉЊ1WyL1ÐP´ ­x†p©†¼áP¸ŒA;ž¹ö‡^ÐëÊOׯ_¼Ð˜åÈmf§xæ<<ÓÓŘiP öæ”·>ÎnTa‰ÞÔ¤þh˜rŒœEï @H‹KJCÔ¡*RªFUiJØO5—³·Qh†`'×Vš@C™¢XÆ 7u`/h¦àd0«?ô3_lGñ½½y¢-ϱ!xásÜÚVÄTò#ݶ~}F’&> ÄP …©Uím‡³uLǼ‰N_U†?‘t€L§/Þ {2äçŒ]á©/a%žø3Œ¦K ??OArÜ]Û‰ÝìIS·ïÍÌ«¨*1W*óÔ9LÉé£{-€úúææI³V­\çÏ¢h´&Mž™‰ m+ |NVåan^J™ºÎAãc¤"ÿn^¸„Ç¡±Ì\Ò”Û¨¥+µõ qZÜ£h׳Pp†àø­“á–+QŸRÁÀá™ „QÛO6^Œô ÇÀ¬F b’!OØå…QTž¤Œ‹ª§á‚§]ß&õa …wíK˜×.€gè_Î_·tµïÄÑgJ²µ¸~°9ù:=æ­¦ÄÊØxIJĤ'Ë0ùôõÃ'§„×&îg>Þo¾>¢nεâðâÏÚ2/¬6½Ìf™2EÐ2û¯d—êòÉÝþQÒiÕ쮬DLG$YêLE™@ygÀËaoÞøÄöõ{9¹$)M©–+f[P,PU®RÝ$5DÛ4IWˆ¤â £’J’K‹òs ôŒVÛv¨èAž:_aލL5Û¾!Õêk+«ËAEW‹ÛË Àîÿ¬¿*iy ÈÂ2BŠ3Ì ÌB½V:áÍÄ] {ÝtÜÍ…ÿ&[”úPFLƵ&UJ¡YhqE¿ÜR Ü‚8Ç@"Y¾ÀÒÇÚ—éã"öëmé×ÏÚ¯?Aü‰| endstream endobj 11 0 obj <> endobj 314 0 obj <>stream xœZt×¶#¤™$`‚Å„QL$JhÐB %¡ƒmš)WÀ7Ü{—»-ÍÉr“»ån¹Û`ƒ`zï%…Òó’üÜQ®ÿ_ÿŽ1yáAòßkyiii4wîÝgŸ}ö9²1|aff6ÊÖÕ×5ÔÛ?àím~®þÂGoñ–fü¸aü¢}¨å÷X“¯˜— À1¼dÜŒu|Øhxrô|•nf¶håÚÔivÛvMŸ1cæê€À¨`oO¯ÐñóæÌ?Þ-jüЕñkÜC¼=ýÇOÁoÂÝ}ýÜýCmç,˜7~ð©Â»ÞûŸ­F„ÃJûU«×­ ^²>Ô*Ì:Ü&ÂuC¤Ûƨ}›¢÷ovßâaë¹Õk›÷ö;|ì|wúíZ³pÑ„w/‘/å'·«¦ægO›î4Ã8l¦Èåmý¬Ù{çÌÍ›÷Î|‚˜Hl!“[b ñ&±•XJL&¶SˆíÄTb1°#¦;‰·ˆ]Ä ÂžXEÌ$ˆÕÄÛ„#±†˜E8k‰ÙÄ:b±ž˜KXók↘Ol ‰…Ä&b±™x—xˆ Æ 1Œ¯–D,1ŽÈ&$D¡$("žð&^"^&–#ˆdÂIøïæD1Šx•XIŒ&,5!%Æ4áˆãK 'JÍf™Æ».²µ ·~Gœ y$È`jUñÒœ—´/¾"yåÀ+F¬ñõÈpó·Í;F½5ª÷U»WëF{¾o‘ %-þ0ÆkÌoôÙ×\_ûil3‘i’Id¥¯{Ýøú¯–áã6¾ñòú7îÊ—ÈKä?+"ýã™ñ‹Æ‡ÿiBÐ턆 W'Ž›è<±hâ'“vNŠšÔü&ûfýä“MþŸ)£¦Ì™²rŠû”£SÇO;µlÚüiMPkn*U¢ Ðý?Û`!Õñ3M¶´$f_Ìþ”˜Ïçhw´n`:ï¦öP1~¤t…æZ9Wj)-+õìm5UGzh½´Ê,P$íeÇj¯2°]Ò…È’ÝÚ$( ±)Ajç¡›ï·pe–ÒÖrPÃ~$Üì­ ÊH(òº/˜ß ¡ƒè˜ØœÿXØÏœ·ø¼&õ•æó³T´Ô^ÓUÄ[J; A {TXÀ ?Í`/Ë  _Úq ÷O —/·?$“2ÃwÄíJ•´’í¬&[O¡0بҽU»wd¯¹TË5à@-{IXp7^Pð‚^dç•ÞóW8¼/77Íöcš†a*3«¡ý´‘Úø|¯2´6ÂYpû‰¼¼B¬]+®›B¢M¨¾¡m±Å‘¹24!PÔ©ªT7hÜ!ƒc7ÚŠ²Ui,P«dÁÞñ aª !|ô\Ž¥4!èÙz5œ Ó˜ÜÂÜ‚ªf¸eðõÎ"®À2è@£š’&XŒTuì7Àïšaæ! (þÆÿ°îç±R›ËZʆ’RÍùj®Â²Q"-T}È<ËÛàJIgãÙŽæ«à&8ÑîQ³¿Ö;çýÌÞÜŠœÚRJZÜÓXuøøëŸoêATê%òU,Ñ ¸p 5”Ù¢êNצqKdþ$pO M¥àKð3Zz@s0 ,ḋŽãÒîñë6¡WüÂ4™ÁrþëáÕ™M ¤½PÔåµè-.H¥?…98¢‘_ÚhÖðö>ÁÞ›FS¦¼‰¦£ ŸÏ€¯at‡ý߂㦋ÞPD _ŠÆ!ÊaÍâéÖ߉pDÏåÏO#ô¶Áÿf¬T—cZFû“FUsÚ±]«dðUä›™¨U‚hšH²KÓ“]ÔNƒ ÛjδpÇ1)ƒö¬@'­‹&=›½'ƒ4ɞȫ9ÿí](nîþè1U¸”t_åg·oã›hƒ&ÁŸ3nÝQj† ¨XÊÜäqÂ4²Ã¬ü7‘i^?”»ißúˆ÷ Ù#ŸÄn‚b8®üþ§}û«ëIpT×RpeAíêüUà°$|ý~$±Þ2 K ùÁyh2ŒÿôNIË ¹9ÿ=ª7@öovÙìË~ØùP”2h?òºÆÈÕ€`d¯ [wÑze°öŠ n%ë£êS:A¨Ê,Ê…’;Ì¡êîŸÁ% Šf?D”‡gblŒ|ñ ñ·/Ê’@²Ö¬Ú+‚#ùc4(Ðéó‹­¥½€úúœõ$4Üêݹ;ÜJÚ÷„ÿ©='Ç«¦Ñ¦tºQ,æ¨Äd£K_E‹9‚d ˆR{PM’Ì›bi™¦­" J5Œ”Ä'ÆF+£â¢ã¢ÐɆ‰‹Œ Û°œ Ài/kŵiB+øŠ…ÓÔà×¢;AyKR·‰¥+’­ÓÑ–BÕsS¡êˆ›Á4¢ïçoõÛXéÆÓ88œ 55sÕ–e ±˜çê(²„cÀ·7®ßºyà7 nFoÀ‘È+Y Øh¹t&»Õ›u±”:;‚]Ü›ûý™ý~Iá1É”´Žà¥«2›4ÇÀpOÙYžTWÕíT±Lh¸÷k»-޶ÑHœ€Ÿ&8“2çOôôn?¥Û¢ù!¬Ä*÷ <6Õ{šU#Žêåg¢Ê'‘Ü¥¬ŽÂ†H=ãèëP±7wù¯”ØÄEvÌ·Ö`>…˜ÁÑxïe (#?û—+ J{N©s+?œq!A±!ÊД@ÍÛrSrØ©Kßö6Çû7+ž*ÊÅXßaGâdR5aÅ#¥VšËuœÑ²”ƒ  Šýà$[g)µjíÜWp&óDîqÊK’v@®JJ HŠNÂìLŽ]žö–å.ÃùgQ°‘¬ÖÔr½¦UIRv0£³×IÔWØJP \æ å'IÛÅ&©“Ò’eQÉ*k Y ç…Ib ë³ Ü5ÐΦÖ'W¦jÓ@(eÓL‚sºý'ç‚À°µa]Ø0à\¹™BÌzT]ªŒT!fv$»D•朎ñW Vâ3‹_0ðº²ÁÚj®¹Z¬• •½/@¿Kë¢e9pMWçõöÖ•ÅùÉË$9pD|VtFùŸ˜ðàíÖÌÏQoðnÒ½Tø‰}ƒÕöO¸vB_x~ÈmPûg@®±ÀJ1 W‡Q%¥?H]V)wtƒÓ©uÏÒ­ïtÒøs»Áx–qd=Ùà…õûy4þ$„Vš³Í‚ªžÂ,ö™9¿,¢•_ÔhÖzzܵÃI4X§òKÞ×Ý–Ò(8öñõ’Ê# Š *Ÿ¼yÅ‹‹  ‹:ÚT{áÚQ/gyh-Éá*µõv%ÞY®€BÔšsË}ºÂ5ñ}1×b;K#À~ÊÎÁ}ͪ]ÍGåí¤¹)#¢Ã$Ä”÷üJd¢ù|º^ŽgvœD¢ûœex™<ô>š‚BœƒÅRyóz~§€ËHÐÀq¹Æ\&½j‹Úx™7®`›…óšR­ÎN!²)$Qǧ''DÙÆYãÅœÑhÈ@w¸p8´=v$5¾Mq&²*¸Sæðãø‹ö‹ï1Yʾç-hÔN®lôùP.Ý[*u™Y=}Œ²KZl2=ÂrŒ¡W á2çz#UÜF‚víáì3ñz&8Ö_雨 à"€/µ–|ÏKŽÏz{-ü›˜½¦c¦·è:r‹Ú“µÀ“ÛòLüÐ:2’b]ðÖ•ÅEr\Gr÷2²»4=Zæ¯ïü—ÈoŠ|ãó‘‡!8as1Ã(¨”tƒ\P­¦PÈ¿Üý¤€rÏßÍÛ‘Ü'™]ZÌþãÏ;ø•‹úaF±“¼;ý¢”YD‚°¸€ÐЀŸ¸ý˜·ú˜Ò¸¢”zp„‚=/L2ïµ™¾%Áå~m±§Ah+¨­ºz~l”j…]Þ±"®ÈòÓ8èñÌá£A×0Þð$![ᵿEü_p³ÂM÷÷'¿b0ã[øÕt-¹SÆF‚HÆíÔàÒÖ®.b³“±'Ñ©!J× ØkǸ¿‹^íLj*èA^Nf׫ajIkuÎãÄÙ77© ÕºT}0–¦©â£’Òã­Ùø2ÌgÊ» KJ5˜´Ю+¦ƒ|é¼ô÷gû”\°/8RW*OHÕ-/Vg±Mi[öÊzÏåp$ÅÛÿq*ÓÝo…6ûµwÑÎø€ hÒ"hdT9l6È…ùÙUÜ!aÛëñ¶CA(àÖ Û®Uתó#ªÞ“ý}!î–|£s œ¦ã‘ ŽC߈»$9ÕYeY¥†³åç3²®Á9LÝÕ¼ârmµ°Òvuè z¡Üö'T±ñ ÷êø4¥Ï$‡%…ú.C$<ÌÄ5§”&×`øUñB‘ßgÑðºÝ+„Þ§Óöj ¹ Ë™ I]ÆâlÙ¯ Ò²Zö¸ n á×>DíÙŸê.ßé#¶!«Sòë˺s³º€ìkpÐC;gZƒÆosïPÒü÷»vß+-Òê²äðU8†öwÛè¾PnÞ-GZ ÍÆREuáÉ‚ôµÏðM‡ ÀGtnü }.Æt:QÀåáêSòÙ6NášX.Fïk”¡OáeX Sjªªòª9Y‡F\GîQG±Qؘ‡q*äÒâ"cbQ=ªdàÿ@þ†Ìæ|þ`±ÄÉ+Ý Ûam÷’̬܌ +¨],A¯¢ÕË![‘¨÷j–!*BT¦.f+ãrâdpZ…½üš”$ej"E>dé5y%EµE•Y9w¾g~C Å҄ܘ¬Äœ 79myœ7Aú§(kã¹øì„B¼£ñƒøJ?¬|(‚o™Üè¤ì=Ñ’—ÅËN‘%Y ~ŠOlbýSÖ¥2‡Zµ$öÙAì‚Ë‹~¼ÅihþÜÆ ËŠûœ¢‚‚å;¶‹7¹%E%5ÆCÅí€êï³Ķï-ص²¡ü©ú#fÿ—F<õ…¾1ŒT*Û[‰}§ûÎ2l›tìãK¬ÑRjÛ q5™íµúŸ)I¼«bSXV–êŸ‘š†¿˜ \‚FYz0Á1ò¥ÿT”>ÔrÕ }@‡µ%TDõn€Ë˜Ô"UÈúìr®í‰Z¦]g%$K‰ºJ_è%ƒf¨°v}nH‰ƒ,t³ÏÂý.î@"sb (¥$dEiBQz)]‡[ÚÂ=¼sèËÒš*m­°¦NÀ(…ÐNX³§rAˆ“uRz"Þ˜mÄqž>nVý¹ˆŸ/Ñ KמӲ¯ÒKïÁŽÈ-îk÷x¬ó(dùõLhyünia®¼¬!±Ð=Â7É÷I¢U óÛÑs:»#ƒJY›Å濯SRžÀ/êâoáDþ>s0»ÅôÉnPá@ƒŠù¾mêp6Ó „sÛ„¸ùï?õ~{ºßÒTrØ_:ö¦@±=Zç •NÐíݤ46 |.6Hª/”täVÀu¼9“o̯(i¢v­á=4=èªÃ)sê¹ÆqPýµºî A~pê4ó²f iïįÁû¶Rû°®`XÌ¡Qµ=ŸºŽª“ä]Ó•d|ÈÉà$IøèÐ@oìm¼˜`¿¸hû­™B÷·™;‚£ |ÉÂ)jP¡©ÊêÎìfü$QËp#”å•:÷A–LÙø6‡‹íÞšÞ^å…mPHj°òf«Ÿç*°,­±îÙ×ìß­¼Œ-xy†.Š3i³Åøx%\%Ör``³ØRPÎ>ÓŒ Ï%Ÿ´s`Òp`£NT†8;ú:êŸÁ8qéQÛ!eH³Â—¯ÉX o!¨fpx¯ï þû/ƒ²Ÿäý>{2ÇfÉØ\6è(¾wå#‚ÌÙ`TÃ@¶ÆëŸ»9Æi§ÚÆ¥€íÙ‹(ÃÑšàŠF3Þú­ÌÝè’´Èl€1 7²!Ũ>CÁ)’[ +ãb.WÀå€< ’+ï"±ç^eˆ›|±ÓÍ`"ØThWã~hçß@hÉn/©Ö—çgdR[a m¯a=€3æìt ;£<¿¦ìpGMhÕÊ’ÀòYþZ+ LͶ·ê7?Åä@£H4MEAÈNA3àn ߇Ka ô@ã!ƒ‚Ñ®4\ñ#2Gû‘ãôšƒÞCñF€›¾ú¾«ÀF`°î¼vÅâ¿ú›óµÉ•ŽÈŽ×Æ_à´Õšñ?ïÆ®¥\Éu¾â0òz†µ Ê\†êà #–1ik5nKo<;lh¯’Y}hlºø3Rù5§kJRÂ+åy™bsþ§Ag{ºkÿˆ-ô5½F7çµMØXšv˜9wóÆùa±šì`E®geZk2øÆ¯áˆoß;‹¤©I€U*ØÍ¬/Þð.nšáNUWzf"·ü¯Üì üè rÖä_7ÁŒ&‹†vöCŸ~îã±Ò_ù"Þœ®jOÏCÓ=ê<ól°s Ùîãï6•]öw’—mfbÓ• ”ÄôÄÍwf¤(6YééóúœÏ7Â1p|å8ò¶Óѵr4_²+$¯&?[_U®ÈÊÔp¹l&¶F‡A_i»±³±ünd ª‚d…6Ÿ¦¯un[dí¶g“Bú_V»øQë‘ËŠ®;ІÚ,X¶a‚BÊÏ·=v§³ºýP±¢(»Vsd1Íþƒ*L$“™êº}¯Lís¶AŸ™©Ñ™T§5$Âi.LsB}Ê¡äþSLéÇ&àFrGáÒ¦ÍÕQ™®º³ZõÇpä;ðM îCáXŠÂÐ L¾Ç£IÐGžmZ5Ä6äüŽæ.\ßpÁAápÑïð#m¿ü.–¿`„›9Øcÿ›#WÔJþÿƽðñór4PøG÷mš3˜æOH˜ÿã`÷ýOþrÆiáìÕ[ÑKØ£pJEj¼^©UåÅÉ b2Ò²àF˜â°‚¨Ü8¡›h/lZ§°Ý®|´1™Êb{™SÕúÆŠ¾Öš£à õÝÚ>d‘ ë.ßÍÚ³,æ®Ì ìåf ômÿ³ ý‰¾öCôÍ}á‘ALû ÈâÍ ª í_tQaÏd¯ÕPöŸÏ^þ>-mõ òó¯2kªµµØ÷”G1í0«ì‡—úEüv¾‚'2šs/mØ“»7Óñ6ëïe T4ùvÅ|§ü ¡9¡&´:<Ï·ÌsWØL\ö^[Gš<ùªØGÞg}R÷œ:çü*hñ+œ|=°Ý¦Fá›”¹DÌ‹ö6‚©þ‹ç>?Øš[#oŒÖÇjý3·1æPÉßÁg>E³…þ¾óg~H¢%+¶&+9M’<ÏŠ´A‘¾%“ö9›vÑþAþþ5µuÕÕuÆ j|FÓ +D]ÂÀ0OuÁùC³®'Q0>?æ—’àgÐ)8[bdsR4Á˘z‰”—5u§‘LÍH§±ÛAŒ%š'‰;¹µ%eÖsºmšýÀFV/ÉøX,¦©ÊΪã„E´¾\(p¡–âr”žâ¢^¼!Ù08šÚ;8šº18ç5‚öÊ“Òø4eä$Æ£é¾5Š+Èà_ìS,àhƳ9!ë.ýÓÓR¥oTÝTrÃç=û}WÙ2¼ËßçJiÄÓ˸6‹¾áçt‰L`Ðn=)°á¸À®{¦À¢Û$š°ÞMFŠ-'á9üîßé>$Á{%;Úör»þ#ø\/ëììî)¿  ˆ‚ø§'”D¢ìÉnï•Ëž§ò‹,ÉŸÏå‘d0MÇçª<Ð µ/ˆí·òÉïµ>)ßOmÜê—çyÚÉŽJ —õÆÆOà*~1SqB_dÐÔ §B„Jœ&‰Å&ÓŸsçp‚W•³ù‰ VUq©±hÀƒø ,VZ!yú¬2Ž2ÿ|*Š?ôC?áo¬´¸hðXΚµî zëqÏ Çr}VÏhµ_.GëŸÉkç!0z«±šÞ|¶*ÿù®Vá«Å‚šö‚Rö¤ðUç?¾êFþ°õÂlÏ€äè(ùòõ>W÷U¯2½nóÙÿ1Ùü=ã:×`f N¢3 µœŽÓeUêÛàÛ|3“Yš›]®iP›¨'I i'éÍ*}#* bUˆˆcл¼kØ9UNr£ÌG¾)fïN47—ט©¼*Õƒ\(ÏÍ©Ñt FÁBXp+—È…ƒ;»Z•799ž2øÊ@ž.Lª—iR´Qºpê¨$§!»¢´Gr3G£¯çi“›‘öªˆNøëu3þåÏDPÊÿƒ†Òô“,t:F]²nÇA¶¦$MǬJßÃnÛÀnUFZÃmæ\€˜¯z[åjHeº{jò{õí¹õˆ@¢ 6Èl‡cIuœÂå~H\Ŷ<Ÿ‚=²Ú˜ƒÉGÀUpÓxªç\_Ãup‡‚â%÷ÄÉ3Þ}.š*ÓZÌÏaüúôí¶«M”ùŒg|¢Ê>6uiˆµÓû…‰ ̪ü×k)KBm¯ gi„_œ3køæ=Á±°Ÿ.ƒÖýßC«T6éQ<ÃÇ-Â~ìÍùÛ‘9@oPhÉÇSàkðµïþ߀亻ü”ζò_ûè¨ÍÔIVï-Ø} Z¶d”è‹åMÝ•Ý`¨£1ð÷>±&œÊ¥s”¸÷Ðs¸lœ’Ù ‡5ª; Yï/W°íßïã0ÍKßÎ.Ë73#1Ñlâ°ƒŠeƒÔ›qß“u*ûBfV7î{ ’}‹}·ºoÆI_Ÿ)þœÁìH‰ Šh¿À?ßš@cCmM}]@­¯¢œ¿G¯p×îÒküeÕèŒ&DœJ&’¹iµâ*²ÖsEœN[#ÓuhÚ@!UE Ø4™è&‹º›NwaÊ5{ìú¾€Ëà÷´[dtBX¸»{Än°‹št”À±¿ýŽþØó0"Ë¥~y¡¡ãÜëÖœ™€^™¿|âúj÷/¶ÉñÍ”}É¿Õ ØQ‹6Z/Y¸ãì×·]w:ñ¥_Ñë}£ÔÕž#7o÷8­Ú¼ßÆU0Ì9¿j43<€ÅEßFÐPÔÒSq¢ë»OaE„¯Sð½%?#™1½Ž¨»ïþÒtP_X"¿q&-Cfh²Þ#K&á:ÓTº4F–ï+ñÁfu5kצ÷–ÚÝüå§c?•›C-FFAÊìŠá¨A¿þ§Ïêê…Ïp§}x-}H‚äPV¥ÅÍt\ldTVrc8¾¬…ñ¢…E÷ÂÑt`RTêÎØ”åÁ6[g$0í¥ŸüÚv±öCÙzŒëó‹ó}J?¿1Ö`Ñ*üÜ;Vº±èµÚÐ çÄÒb×ÞC±-±‡Íàô3qíîÇÏVmÚ"–úrp-Ül‰¦Nšˆ¦Ûæ»6:(¤ð,¢‹3ÝñéѰ«–Ú¹Wö’Ç4Óq]©Í “‚’Þ+Ž µo”››>°¶¢[x³ƒ·àŠ[p¬ð*‚{Lké™ëÖ¾5÷Ò†G¯ßüö‹ —ßQ¨Béãõöï.ðÚa·Ó¯÷Áƒ¦'üNôý¿÷Í è&Í3ù‰÷I†ý·ŸûÑ ®ðÍGeYÙ DVW•&PgZL£Ñh©¸YGþ G¾‰ß Ñp)¾³^…_þFðý|ÃÉÄ“8#á)Ó:Ö#FâA|F¨ž’®¨±KІXJv¯8Ê(‘®¨Ï/*¨´,e)-‘”4!®®(­ÂòèéÎ8C=U!+ÓJzÛêýë,ÌW2-y¹Úc…™W^ëù 6—KBþòÞÍ9,>'ÐNzõA=AÂo%ÞÁ§97 —«?­é¾ýYd53i–Ûv÷·‚¬”k°4Œ¯šÜ=¯Åªaÿý÷…©5Üò@t ùÐ×/ë{Ï×)G‚”7ƒ®ºçvrÒבAÌí5ÎÕ‹Kmr×€wÁÂÄå᫃æ9­ž',ðy¿ès´‘>ª)U ”ƒ^uf&SM¦ëÄî’MÚø<î4Ð[Gµ’¼žl%¹ZP4ì}ÞE-Õ&ÉЉ«ÉÔLGu²`4IJ&3Xã V`ñRr‰”’Г¬»8‰L Á:µoj FîgwÊ ÖžÁZØA£Ðí0…Ÿ‚á0ô …!Û%B¨š~4+þñ‡E×L£i߈??CD]ÁPWaðW@§×žûÌœÿÇSã,´ð0Š&cëPøŸ4ò6‚e¨±”Ö€zöÖ“9±Ð ]U ”üÈçy¸­£“²ö„íˆÝöŒ y~qìGêŸ÷#BŸQõ|Ÿ%e/õ—JbÎÿúÏÙŒIøx¨“|ò¬ÎÁßɤ\×XŸäõq²Z2A£æ’4áº$.ñ߇É~¦ÎÂô§y™_{ºÃT'/Ï—uÅÙQŠîw„é¼ _Õ¦´æS0fTpÔ¤¦2AdFš¸Mr1]ŸÀnÅ.(’ó§<V f·s¶ Ó)wIzš8ˆÌLíÅl®²*Lç£êœ|&µRÝî€B܆æQùóI.›•"pGÓ˜Y9øhŸ[f°úÐuWÓtbT$ ´Ò¥‰…2pÆLx¥Ï ¨¶’Oê…ÙUAÖ_}Q­ÀÌæ‹ð ¶H¨ÿ~ >'R%¸êoDB(¹Í&i³™±–aŠ°Î¢ÙËp KC/•MivT4;ž ¸€ÛÁ@ê¡¿Í/ÂÿøxÑßœŽRШ„•NŠßH7@Mß÷TA¯Öûß(†,ˆi"nÚ­»Ê§s%>Ãqà€,S“¢ˆ"Á®„;Õö¡ùÕÃS\¹e>¨,%m-`k@7;V;m‚—ñÈ8•—UÀ¬2ìi„„WúÌÿÄn%ŸÚž/>´€_?ÂÏ,ª ƒ„U¡ùia*Ûzœe¡T­6€\!$ WS†È4mJ‡6ÐŽùî纓à.É÷n"éj§y4'6Jò»ŠÎ´T]²‡'v.Xîº ‰ÑáˆíðJ̺j¿¸ïˆ+åO‡ù4º^RrJßt±©È.õí²Yi»qMJÇÅ)Ô ¤pñ;™¬Ô¶â]-IÚ³sÎäÍV³œÝ kýÁñå‘'™²ÍÙž™}Q‡“ÛÀ=ðUçÉ«MíÅG@7èh÷¬ . ÉvÌ¡¤?Ý»P×yîõ/VžE¢õ.‘NÎò!à‚KÂ/A°#o„К^Aª7%'8¨6 þ‰¢³b>i2’sÕdwɳ Œ­UQ7I_U$ÎEJ% €[4_éªãuÌÊ@Ô2°O*††K4ò‘@ø«Ø<Â`²*–y¹ÿ•¦¬#úsGŒ$ˆÿÉqÉ] endstream endobj 59 0 obj <> endobj 315 0 obj <>stream xœURmL[U¾§·Ò»YЙTL¼+7DÌ0Wj2aNâˆs.c[ ‹lâ]¹¶Å~íöt¥Ël—Ay-%ì [;³MËjÄŒ-Ëu1ü šE%šh .1Úï…3‰—}$úãýxò>9ÏsÞsg6q„KCã«-5Õ+m…þ$ÑE“¾–›–ò•«ùãÅÂc8³§ÁÉG¹U„ÂGNž›úæfC Õ<.7•Ö9+¥šÚÚ ²ô\uu­ôŠOÕUºg±ê^iø‚aªjRc ]Õü?U]šâ¥j' *šê÷ªoÓý×Ýþ®7ì×ç;*½?º œÐî ½J”㸢&Ž˜ø½é#@> )ÒOÒœÅXgæbÜÏd q0­Õ{Ktïò™ìüâŸóÙ ùê–^z‹ÇܲÙc/ºÚš ¾þƒ§Î¦³0&œ vFÂ1ß¾«îo¦ù5c½6‰SƒÈŸÆÔc¸ýBî †óÉL§¿'Aá=ÁŸ‰ÏŒž›Þ3±Sn¦þ½ÛábqV,”èm"‹~(šŽ”çx½Fd ¤“©dë•׿Ü@‹ÿ ¿žø·£‚¤„áôtíÞÙ³W°âml+°°òkÅR¶i¸{¶þéA.ûŸÄá9¿¾3c,×°••â¦÷G¶ýáè‘d¢'Õ›î-›~c¶î3ö|¶zè)¨‚§ã*U&íÚØÒC’BâXràø—7ÆFìañ,n ÷xÁÉ/òÛò<®HÚБgòRåÕNÐÖån¹ªÜ@ycøù÷öŸpn¸Ž7/¢ç"¾ym#WŒt ÎC®3ÝÓ‘<MèȽ›ý(w|âúîKŽúfFØ[{ïa&Þéc¦Ê°gýlc+‹nne»êÀ¡l%‘ñ"Ãç¸åòêËÛW›£ëªü1«ÕˆbŽû(k•ó endstream endobj 9 0 obj <> endobj 316 0 obj <>stream xœ¥Ygt[Uº•“H¹2"÷b`™ “F`éNORìt÷*[n²,¹¨Zå~W½Ø–eI–‹Ü-·Øq!…0IH!PBÞ``˜92×óÖ»²)Ã<Þ{k½·üÇKò=÷œoïoïýG±fÍ`EEEÍK&g剞ÜVœ$ÌJ‰|¶8~pFø¡™ô*ºõÛuì0. æÎ„¹³<>x;¡_ ÷½({>kVTÔÓbµOx!~ÑâÅ¿Ù(Ê—fed?¼léS+N–>üÝ7oJ+ÊÊÈ{x!óKIšP”Ÿ›–W·t岇§ßùõLJÿo˱X¬ß®ÏKØ Ú˜xSÁæÂØ¢â­âm%’¤ÒäÒ”]²ÔÝi{Òã2öffíËÞŸ#Ì}v ‹õkëÖ£¬8Öc¬½¬ß±~Åzµµõ8k?ëkë ë׬xVkëk#ëIÖaÖ&ÖoYGX›YKX±¬¥¬-¬§X[YËXÛXÛY+X;X+Y;Y»X»Y1¬ù¬%L…Y³XÕQ+f<8ã/3÷Ì Í:0ë&»”Ãæ¼=ûvV3gÆ]QwµÜýÀÝ/ÎõܳêžOæÝ;ëÞàü¨ùw~QÍ~•Ëí¼oë}_ðn߯[ðà+ÎÅÄý„—øû¯ÅDÅD#Ó¼‰t½OæCΞ0æ‹æZÂÉx“s&ÿ=cŸ´,KMH´ìÜÙÜuÆk”?†ë@ ¼®Ç‚³ãM2ªÂìÖ_×—h#ŽHNGi( A)¨*ÐBY¹Jd8¡ÇE‘5n´Pn(Aòu³Fé¨õ0±b‚ÍŽ{”¢Ø´3/|Få Çû¢Ã8Ï&éð÷5Q`ÂeS–Ç'Óû’éÇ6E“-`m0^í¿rêµsï½qi0—U]Vª/Ug âéLUšN eD¡«ÜÛÔxý3¾²¾@–+)Q*ÐT9\VÊAYWQ«­ÍÜ õD@Q#IŠMÛÇOËeÅoèE+q³×èÖ v•—¤•\Ïÿ®^3ÅR„W4ñ¦N6ÚK1Õ^r4r²Bc²©ÒVÑHÐkÑT€,­Nk³‰ÙÁÙ4GÏ®àTA!•C¥QLi: †j-È PhUR1½’NÀEG”^ ìT×XÛŒ!#œ}ŒL$sÉ Ê —J¢ŽGn6Œi«5¾t-¤´Šî.—Ë‹ô„HÏžÞZ5ÃUœ„Nòddk9¦4³Ì Õ pf‡Õ޶£2ÝM—8¥æJPj¾_F²ç…QU–ÝìA¡èð‘6¸€»õó‰ßðÎI—¤Tèrµ9+&)\'•k’4ÚœëwŽ›>ˆA[9“ä?îaÏ›ðꇒ}Ñ}¼€ëï ð´lnâ'&¶•ãátpšÈ1{ð“~†¢17aÔyº-}ç3´гðçÜ뻇Û—ø–’t¢Wr*àq“^„ÿ ëõ2…FX…!É›ç¦,ÐBu=”0´ý½uô3ôœ´G¶Ä ìß(ZÇáˆe‹\”ÝTÏà˜¢ð…׌E5Þ˜æ…ó=y¶<ȇ"µH–!NÌ,.H9šJÿ Åâªsõö†¾ÝzåÔå×{¯k'—i‹”y%á¨h··Y›L„ùŒõ%Çø‡á£¸ë¢µÙÙ^aÅ—ÓÏñ âéÇâwì>šX…Ú×õùI´hp\Pí::!þªÑf3hÊ® ¢–Áhn>£Và¡9œvh'‡ Í$îÖÙžÓÅž"3ˆT¦:£Ýl'FŒT ÕÄePQåöex#ÇôŠý´3$1æSbÀÒ8ô\ƒ„Ì€" D¨£WzÑÙŸ—ù Ú©KL ”ðZáäÔBÕIaÜÄNÊÜcôYÚ£„¥™Ï)Û£ÌPÉÅZ¢D»Y÷$C>µÓŠ™gC-ØæPÄ´…„g…£x¦^s›ã¤Ê\eÔ‚„E ù©xê>yIY¦}7ìýÖk3n®7V3½áÿAëÿµ7*÷&ÒI)4OàÔ¸-u¦€…¨16£¹õïN'º‡›|pƒSëª`6pfªª]ƒèSU ꛈáõCT;\‚þïëe¾buõ•ó¨RÀ’9ô3zv§€»$êp¤V/ý´Vë&cqÙ “uz\'ê¢ØÜuTcÌõÐJöEh}š4w˜ò)•|Ø"׃Šð)<;øϺ†u¶?0Û2û]çR½"{6ÄÃî¼#‡1î'ùŠÂŒ`_{ÎÕÊWäøºN)ضc‰›˜g3 ×%jÄÞŸ=}¨òE¡_„àí£{H ©×+ˆª«¥×ÜcÂMÁ22Ùt1 QÉÔΙFÿ‰LB­0—Þ€3,Uø¤‘F‰æ&¢?çi u…P†MG¦†Ó‘©°¬H1U`›ÓN9ÍuÊ@3ÛÑým#4Ž-2eBùs…[„G‰=KÖnNL¥sxÜ”ËÚ,8?E¯Z¨!|ÿ­ã(´¤šÔ vÒã¥A åWQì–ú.£¹hâ¿ÏgØðcâúŠ ßA #@¥=ª+ÙÈ@P¾L¯MÑ3]¡uL¬ƒòÅøÊG æï` ? Á÷]ñoáÜÖkµöš»#c«8)†l²ž£ðFvÄiÇë|å¾èÛ7PýåÜ7Ñáßñ\¥Ld29º‹SèE¿¦W-?,¸úußÿŒæ ”õ¥ªr}¹jšä^Ťaä 2(´ùŠŒÊýXÇ3hóx]M@˜6Ô’v’ñh„jªÙDϤç&­†Ç±ç†\ì­8Å99z­ýzøçôcÜÕ/ö§W(tju$‰~¿Ç7Ñ+¨œÙæð‹ÿe› M?³RTÒ÷Ò¨ãrõà4Ú©±¯çÑ‹ä;+Ró)kÓRrË,î}Íøì ÄþžÄE5šô:¼J£«’•>õHÖFX…­î>pæòésèÑ7øªãúbcÛZ“†Þýú¯è¡KüÀ‹uW á®ù§Ó1a-BÍgÇ¢ÍLÔ …†…<¥#[šì–™ó#Ž"ÑæWîfç>±LHß k°î,oCoCW/0Ôwêìí<šËx‹AÆ0š›_ì»-×Þåkü• a~™ª¥Ö^ge8Ð<1UŸÿÂÓ»÷æ&¯ªi¹DX÷;‚ÆsúQ€O7X>•® ¯oo»Í=ãÿˆCeUŽANêIMÚ­«†Nèkm¹æà®Øš§)=@4@»§³ulWyÓ…Ee‘/w*}*¯"¤m•þï¹Òh$çjµ¥¼ÖŒ»?ÛÔ&fVI”Œ]KÒ÷ãU£l®ÿ y~O\LˆÕŒ­Æ=ʶ._­ˆ.ð'{¹vá)»NlÉŠ€(…Ù`QñHÞ ?ÏHê?nÌDò‰tžÜ_©ÚÀ(M {”ÓèÔÈÔ¤ŠÔNŽ’zОHÍ>zÑÛ~’ÿÙ«WÑC€pèUõÉÝG¥¥œ±ô\u~E|~Vîî5Zÿ^Kuñ¡’•Âí‚ìØ”œ€+ 6™ƒŽÀûNãXÿ@g÷é`+Lùâ`êt3ûÑ—L7ÿo »ò§!ÒÜíLF`FšHHø1"¬ë¤È€ëšK„#Û¥ÊQË”ZFJ´•»´±1 Gíú1|nešßf ™"hÒ­ƒ¨È>ä‹RŸ¿ts¦†ÞÊ#5ÀL¯Xb(sø4ÍG»~ÏG¿ ïT8DŠ¢*±È¤qùÑÌ Ù‡‰¬„Ã'˜´#W{ÛÕ³Ýè ±ÝØ AbXS/«¬Ðdá?³Ï%oóUX€¨µK³H¨"Õ­#S؉Qsèýûÿ0½6Þ|hÃf 2ó[º-”r”fFŒ+^ ?4ÕÄ -Bïñû[ÈÑ\T—eOƒc°!ã…„ý‡ÓG°Åƒ ïœõ Ÿã¨}åÊGÒd™@ìË뱺ÿ6Ö+ð{mí€ ÷” æ}»Iê3L£‘øísShˆÈRB2´+âęʄ¢xiVq*A““ÏÒ¿ßúÉ·zQ³á´®^ s"ACÿjÒŠ—Å—Wî×ê ð>ª‹k™3C3ÙÍü0:›fÊ1ÉàflËXmñ¢ùáTœArÑä-v€sþoï Ç>A+®¢Äé?¤Ozt"¹&AGõ +¦e½rÇÔ1>8@žŠ,—nÊ0I]¬eq£Ïíh5býx…¯G‘~ž#¿5Ðâ袚tg+/–·jƒÌ6ªÍáºdïr`bŽxOC² *¡Â(¶HÍx–=Ç,l(¨Ê(G‡£qk‡ÊQ\¬T*uÌž ‡í‡j¤<ÏVj®)”ê‹49ô<ÜÏi{Ùc¶GÎíé×uišõ~èFk§gJ<¾“5Ï”¬I~¶UŒ%j"ú·yŽ| #ñðä¦cË…{%O2RºÝÓÚò´tñÏuö_ûKñR\q\› ùŒÊ‰ 'àjîæß¹ ôžV(Ë4* TZG­ƒ²ÚÚTÄ“.?¼l×ÞÌì”"&vÊÔ5Í(úZÊp£Æéµ´À´VuʘAΫð©¾#RNlå=«gë9NGO•˜*£p­¨Ûà!4.áV¸% f<Â@êH-@ª ªå“y¸|W•:C'Ô3Œfšª‚Ïõ„%˜dJ6©mÐE€r]ï„Ó˜Yý‘!Â8çÓð¸±M–‘-Á2…Ì%K0mœN•FÞ;ÂDY§ʘ`èe¿›¬À# v$üÄ`”û6J{c&ºƒfòŠdÓŽH2€8" ]l66Y[ïú<æg“‹x?Ô .a#Ùí Ûé™±;Rù¹‡r™Ù| öüÉ£7^>ÛrûS>]„¶ó<×}'[›ëëÚ«kõJ„Ç3Æ D•i•‰ªH¤ƒ÷ Fù(\ÇLþ©y´Š^Oï Íô Ÿ<Ž6øšwàŠE¿ùzÐ2 Å>ú½•/Lâ¡Eo­ ×ÐÑ©4;v³àð¡íÏF?¶îCô;t?šsýº`dôBà6#œ¨n}% õ…¹<³×°Öêl¸ÆPRUI&0RÏñ£Yu{G€h…–rw‘ÓŒ›\5!›×âÆ¥v‘¥P¦WëŠOï‹‹åyŠÊ×àɉºP¥ãw8ª}¹t|:½[KHãr…P ›´¡B‡ëŠ+ŽhU­[ï‚8ÛÞ7rñFÃõ›èkS­Ë1ðÃé>ZÀµ|Í(ɹŸ ÊKI}Šþ‡ 7”=ÌìÒ‰µg˜”¶ÝT@)§c-˜Ì ï†ËpS%`ï豺Ìhý娉ßҬ˗‹KÍî4QØ+­×¶1#‘é9èÁsÒþôAaýê#$Í×ã2Ž Ò©CÔA ŸRú`ø¾”~ª±+:ýrðu´ÿêQ¦ ÿ#¼(<Ÿç1Ø™—Ö1é¥ÁäÆõV‘¦Ì„”SÖ¬t:KìE1$ÁáÒÙû’òöÂ&&¥ÓîÊÅON“•+¥PA05SÖÊ× ËÓ…Y¢ÒTf¼Ùxý8³¹ûѬïõ”ô$vó÷Œe+ëÁK€Ãâ¬óšÌe4aÜ/¿h|í½?>vÒjð`Üoé''7óNexó!‹ß’ôôê}ƒ{=Ý-üfƒóE7ÆýæVxïå`æÆÇŽlÞ¼;gàí?_¹%`I»xgHaeô+™`ˆÓëxo6öœimQ—ôóѯÖ^ÖWõq zN:?Ç 9UÄ…)Œ’IÍ.Zñ^à*3¶þPÂZl6ú÷‰o~ീ»†ÞûéB´iŠÚüÿ'µÃúéa)þ‹69"b¨aì2‰®Ñ‹Séµ%;›âz]ší¹Øz†¾óÕç'«v¨*¥Uéª,A L×K@B1cLs¨áÆçÿzóËŒLÖÁeä°5›Û¦o~K³wgÜÉÏÌ“IÅI q¦ß¦7ÕõÓKh§]Y©Ö•èÊÛh*‡—þ×÷¼‰Î›ë‘»rÚ!§K¬ã£gÑy^®(;«Ð]ÖØhím,÷”˜t$ÍõMDF#Ö Tòöîp8>ÜÅkã˜ÏÚzkOoLuõ°.ç@|RRÉ!ˆƒU½Gß—ü©?WÙœ{±Å›¶?v ­ºýÿ‹ÜÙÜ„ªýšãŠxŒ;\8~ºòL Z‚„¡ßN\Ø Ø^»­67W‰?\{åã±ÎÊœ6þ”Ì OlóEm¦xNmµ¡ú¡ÿdÏßpíxqo£¯"%5`ÅêT޲éÓLtÿT!-©ÒUH-Yäã“j\/Ídº¤Ö’ }»ôçÎŽ~óüá&àÝä¼=Z“ܤ¢*˜™uä´ ÕKÉ¥ä2ˆ,ØI=Eý†Â¥ôjv+Ç}Áâµy­6Âd°…C³8+'ëË–É!ô:Ñùéë’Vª.Æ íS×%Š!FrâþIr˜Ù<’ä]B•ÿÐþŠue±ñtáP^óÐ|ÇhãpWq>Ö±µ‰‰šáöS¸Ú›XT¡®20.¬Uåɼ,>›Šî­­Å/^<Õ4p<:Ï+x©µÌT Û`õóô/èØ£ùçB¹@/èÅUûwÓ—Ëñ Ú<ÿ÷\´QV“[`tDnH§™=‘÷ï§t5:,~Á-4nö˜êÀNÔ+eyéÒÄ]ü]'ÒÓliCáfó•ó*«Ër‰“öóOd—Š·-ïDn®ûîn¹ú'÷g?óß“âUw×hfËïÏ] O ·³™5•ébzF2+(ÛjQ\wûÿ^w§ëÖÐqîâxw`³ª¬Ð .^"(Ý(?*OSå銠xê¶¢¹Ó÷Æ_ö𴾍¿¡Y¼ì|ajžGÚÒÕÒÞÛRê/¼Œ¾øþÃ`ç÷ÎCcá' x{8“Ø?>a_à̓ևs\(½–3p×Í»{Msç²Xÿ Ž' endstream endobj 34 0 obj <> endobj 317 0 obj <>stream xœ­Rýoe¿§í¶sEMŠ4Ìö FX‚{%ÑÔá"/#è º0®ëtíuíÕrU¸Òž\¯OïúÞºÚºêèfdÑ‚™1H°ÑDbˆÑàoH&£Fá¹îæËÅ@Í“Ožïó<É'Ÿ—`hèíììXTÖ¥E§Ü¯‡ª´¸½ªƒÍzØl˜i1¼{/š½eW#án €òqÒé©3s½”›ñŒŽ8hb“½•èìéyx3ÑÕÑÑCls’žQ»ÍEôÛhé´ÑÚaŒ ì£$Í›¶:hÚýh{»ßïo³9½m”gäñÖÍ„”vÏ^Òóy„è£\4±Çæ$‰‰m+[/åtûhÒCôSGHËæñPþ;ln·‡:FŽûlcw.‡)ÚáöŒ:É1Òëuúì ÃuëÍxaõ-VQ±ĩÄh"°&-Ì€…°›€3àsð«nn^÷‹þ¸1Öò™¢Ò_h£â×+f4kR‡ÐVÄ04Ÿ< r¢ ZÑzPÕ äÌÁl(›EY¶ Ú²«v1š:•„f9ɉ0IX£¢Ú:?F»Ð®µ‰äk‰dLŒÇa Ï…3l˜çƒA‹qñ¨€êb£¾ö ˜öÙÜÃá‡ú»age˜žŒ‰ù¸eê§Ï®£ºå¸$ÂL½* ±ç'ÕUH´5"G¥ÄÃ,d…ÌîóOY βãƒñ?^®gè÷çaÞªy¬V¯Ußתµ‡ôµ£Ês¦"—áøOG-|ß“Ã;áÓppöÙ³ûçöÏí„xÛ¶íí¾t8™¿·&®_›¹?…Æ.:.\ùâ7¯~õƒU=a(³¢À‡NùþÉ__½±¬m9o¤¯mÔ˜ÌÃBëÒ{õ“V#šAƒ·Àw·ôh’LeoÉåòz]®’·\.•Êí]•Š‹Z‹M=ê®2i¾ý~È0–?·40)`>o1*‘jý\Uå>½²W£ºÝµ°AŶtmX¿Ð°ß¿_¸ýO'¨M™>9?}.=1ÿeú2Œá2 èÀðºuï#jÝP絿¹„å;|å±·TƒÄÆ"“OËPC—mW¬þ×ÙÃïàµÎúÿ¯[#:3_TœPFÇõ(©P¦„ÏÀ,^/Q̱q΢6-퀄Qsðm.ŒIÉeg;ŠÊPþRŠ&9•ŽÃ~:˜ q/ð–¥’zŽå¸dÍMEdN™R+keN‚qˆO¤²Ù\8Φ¬KQ4]WûMÿ7£·T{âÍzu]®¡ÒXi²4Öe›ïª¼Þܬa†ý ãl@° endstream endobj 149 0 obj <> endobj 318 0 obj <>stream xœcd`ab`ddd÷ vô541UH3þaú!ËÜý[ö§×OÖnæn–Õß_ }OüžÄÿ=^€…‘1¿´ªË9¿ ²(3=£DA#YSÁÐÒÒ\GÁÈÀÀRÁ17µ(391OÁ7±$#57±ÈÉQÎOÎL-©TаÉ())°Ò×///×KÌ-ÖË/J·ÓÔQ(Ï,ÉPJ-N-*KMQpËÏ+QðKÌMU€¸NB¹–æ¤å¤ç¥–&æç$æ•0000š10v1012²Ôÿèàû9÷·ì‚ŸóïýøÎüÓüÇ3Ñé'MèžÆ1­iJC[S{g»ÜŸ½¿gV5w´t7Kv7÷·Ìnù±÷÷ ‰-½Ý}ÝÓ¦L™6£©¿a‚üŸß»Yôý)Å”Úó}FݤÎîönÉú榰!ò|¥ ,ú]q6Ûï¤é웹6sËq±˜Ïçá\2‹‡ˆyB!“Ç endstream endobj 53 0 obj <> endobj 319 0 obj <>stream xœM]HSqÆÿgg;›sn~p ©mç&˜6§&a†¹0ìC+‚ðbÍ“[µMæ±3ÍeŽÆ”h©MlÇ]–v‡ nºèó&ÈÛèBºè¢²nß3ÿ"-Eðæå}xàyÞ÷Ç£0 Ãù»ºþo‡õƒŒ~È ;Y JA,¤L`cÁf|®oWâÍ ìuàårÂ2Lt0å ÇÃý!Iðk„Æ––f¯p´¡¡E8ãá` *t¤ HEq[è‰â4,xZC’4p¢¾^–e_ 2è‹ÅûÛk¼‚–BB·8(Æïˆ}Bg,* çQعͷ3ý±ÈÀ$Æ…®XŸB¸6O͵#½„¸H ±’Vb#íÄ\|ŠI'ÉÊT3}LJŸ°ž`µ†>yW¨c ~üÆ/æ@Utoýæ’ å,ºõ_ô ŸÝuFÝ[?¹Ñ]'ë¶ë¨²¼Ù£2?°¸Nð ÀÔÈ­ÀÊ[x°°ãv +/À(–ÙŒ’o> endobj 320 0 obj <>stream xœE“{LSwÇïµåîŠÈtÛUqzo18 ¢1n.Ûœ2TÜ0ŠèÄ'¯B –[JK)ôÁ«8@ik ¥@A¤E©¨Óh2c0†i5s2¶™%uÎL³e&Æ,¿k~,YA¦ý9¿s>¿ï÷’Ï H’¤S3Ò³²V§Lî„÷IaÑ a±j^ƾEAŒbÄÁEÔüwi.’½öÏ!D$©ÔZRy¥N%/’©%‰ù+$«×¯ÿ0I²&%e½d£Bª’çç–J2rÕ2©"W9‘ìâóåRµN’ø‰L­V~¼j•V«MÎU”'óª¢ÏV$I´rµL’)-—ª*¤’Í|©Z²=W!•LÓ%O¯©¼B©QKU’ ¾@ª*%bÖÆM|êiå•ò#)±”ˆ'vˈb9‘EdÛˆ b.ù)!&´ÄS2… _ÎðŠVˆŠKÄßEÍúb…>¿ ³ý¤ÀŒ‰„|á!3¬eyW³Ø51PJ°Øât Mh¢ù t²Ï)_BÁ2(ç.¿ˆBë¨Æx=”¥1Îh1›À@óà‹Du¦¢Ê¸L¡œin2â[Qx5UU„Ñ¡0)8!©€}óèàüŽ0DÉ)½rú5PhΟHôd<{ø‡ûÞ/ é9×’X¼l;ƒæR`[ýÞ¬Oã¹eT*>ÇŒ¢Š(´˜ºëÎ(KÝš¾š‹4‡Ñ/a½;†Ì·EB 0ÿ¤~Žgáh¼sÉ£if£…h9‹M˜göª/ ñDÞ¹Ú“™ƒÉ,Þ0™§&,¸Âä‹1ÑËY¯Lsk‹ ZiO}—¦Úb6Ô°u&h4éå¡ß~ ñGx.À‡pìË#ÙŸ¢ùWºMnMM5T4pEXœ¨+z½ôî}´±( ÅŽç}¥ml3W:_GKÐÉN©%"R5‹PîÿRƒ!nJ¨ÒWB'…:@¡µ(¢ìG24Ïæð¼íÌ_¹ðœ"ü&ðÇ­œv@F‡#šÔ¡o4jl°¡Ž®µëNöxÚŽ;ØãÏš-màŒ –‚™olÈ6±xuŽB6Ê¢©ÍÍG0»=ö~Ûû ÙÞâ{\#;M½6ôØ+C ßp ª ÚÁÕÙÚ6ˆhpÒnk÷ÞV+¯g«Ò£põư/ÃhkX$lBÿ2 ¶¨¥åƒ·?Ðy~äÀpN(JÉU- T°m—mÜxÒ|­¤Pe(‘ëŠ*ól¥`„,Pö¶¶vø ‹ö™úzYÝ×+Ñ¢¦PðFsè*{!0ø-\€ß—wpír:aŽ:C]'|gÁ ^‚>=ýšçÞStö‰yP,cÜ“cÐŒ.«×ïmé;í¯ö«Êùª}Oí½=pÁbC…Ãæ y ‰ÏÚ›úåeV£ÁÂUîÜ_RtIå±SGO;ú¹"\'ZÛ½¾8Ÿ¯÷¨/R·Ãl×ëê«¡š.ï©îóœk½yýà™¬|©V­b•¡bw1ÐK¶`2¯Þ®=°·{í\ïÍËÁСnU‰¹©¶Ñüºï{L"ãX 2Ý»…ÛÌ@e§F©Q©+½š`o û‹ó'v3£­´ôž‹²+ÏGQôÐ$¬Òj0YÙªù%  õz§ßé=íêå<î€'Ð}ï\‹#¢êHÎéÝ ™xfñ$Êñ6wgÛçb—èîöÚª:k]“íŠPqTÁHn2Ím‘Çzª]ð{”±tº9þ $­ÕP渴qåÈó3h¡o’Fe1¬¬¹B›–´y_ë©6h¶{ß %¢~B7"Ã}]XÇ Ù;ï¯Å‰8kpÎÒK‰£øÈd(ŒÅç'ÄL†òç{h š‰6?=½s ^ƒiœÏÅÖx„TÚä¡p¥ã­pôØ,6Z¬ãcf†]11ñ3Ñðc endstream endobj 57 0 obj <> endobj 321 0 obj <>stream xœ]oHqÇçfž:Ì‚‘RÞŽ P§QØj 2Ê‘¯ÂÇ<Ý`Ûól‰åÖí<Ï=îºÛ湕µ­"ûƒ½Hê…õ¢Ò›z#H¯{Uôê~ëF´ô]/žï÷ï—ÏC k"¢Áãõžëëý'áÃ>R‡;,`*•ó¡l°YŸá_ ö€1±ßkEV‚`§Eð°Ñ.8àéNÝçrõwÓÇ{{]ôP˜á‚~_„öúøöñ5¢GXágèNw€ç£§ÎX,Öã Oõ°Üä`W7 òú23Åp×™qú,á鋾0CïÑõì-ŽNó G{Ùq†‹„¦ü\0Ê#„¬îÁ1„:µ)T_û YÑ*¡m‚ÇrKåþx ¯‰oذTú±d_Ñ2*è¤.äò"ˆsTuÓ,$¤¤ñvˆg%]µC[^Lƒ¤žË麨Æ5Gµl,ÕÿWgܰëjV…XIª µºiÚæ2‹ ™„„ ÎD.›KÕÚÜ¥yÚ9AWÒÉS-X6•Òï‘"ñ²àáÊU»š‡;°´ 'Šò¼L™?ÿx¥9X€Ôn0¯dVµZðD¼\9Y&¾o¡G–{?싲,Ã)iIMU”µ5*›)>Èf—ÝO‡¾Â¼|Xº[X~û –IEÎ r*•¨á 7#@^›}·­¥ß(ª#­@ºXÜÙ1Ž`8ÉUøtéÔéâoS£&2Ál&·>ÛÓúkƒûh4>y_Úxä:LΚgL·é½âh™.c®çpyŸéÓž7}i¦š¬ýE[ãcÍfCè/r’ô endstream endobj 27 0 obj <> endobj 322 0 obj <>stream xœ‘kLSwÆO)ŽJ˜³kvÎp¥s‰º©‘/1a™qfºM–΂Šr±´Ç–¶BW¡0)-´§ç=mOiiË­-"(´Üµ€Ht87§n Ùã‡%3Ë2³‹Kf²ÿ!åÃh\2?ïÛ{IÞçyŸŸKOÃD"ÑKŠ m…‘Öé·í×kO¿o¬ÐÒU©ù›BŽHXŸ&¼*6%û–v/ÉdYd‰!+½w}ú½uˆ}5¾€j×bé"ÑžƒÂæ¢#Gߨ²eë»zCC-­Rå;òÞÚ)¯lÿ»‘PÖÑ*|ãJaRjõ†¥Î¨ÈÛµCž’–?ÓNõÿ]ø71 ËÔÞ«;\¨Å0ö1¶ +Ķa»°ŒXyKÇt¢­¢‡iei¿ˆ+ÅŸ#w¶pÓ<-l˜Í!™.F ´´ ÍGÏœ¦ËM4–ÚÊ ’Ø8_òÇì¤/<%»5xûztjp.üÜ%~ýda‹¬â”t.VUwöuuin­7k€(ÕNÝýyàéè|nÿÈ¥ž8)¥ëšˆùp°á/KxK²_ry¸.OÂv÷º‘ï¿Bú'ù(Çûî^è%"Ö@C­¦‰>)ÛS2ÄúºÞPí»åls~sIn~òñùÂVCs…J©´{18×£+Ü`Ž$zìïN~”<ì6pVD)èàüîî1TB.à#cŸ::¯‘v‰Sŵ Ïæ!kAôÝcDý)~€^“ÖàŽJ‡þ|Á·¦XÛ܇¯¿¼ À8ܨžú(¤‘GBõ]0JLÇ/_ŸŒ×NʼÇ3†pèwüsîŽw*ûÔþ28ÊÆCÇËΘupÊMÓVrÖÚ÷)¨ˆS´¾¨´,2F˲” lIº’V¹°sé©g4¹ž0U*n»Ë¡&o0l°Ì42†6íÞå"ÒZf³è=C:4‹®8w¨aøŠ½Ç ÛïƒÎɾ!HpO\¾ùöáðcB…ß±ê>k¡ªŠÙÍX¸:þ‰0E¶y½qñ¼“¨ph…Z…Ï2VÐ;öøÊoå“ÜŠµ  Ê î6;Y›ÌϘÀ;oûáîžBkñÝËöÆü³†¥Š™g„~ºÊ äH,0Ëþ–"¤xŽÏÝCd£GæˆèZ-FC—Ö뛌 P6ï¿àñäþ-˜¸vOï¥8¯»Ãlñ“ÇγljjÕ“3ø… Íle[˜æÜÍËÅMYДªÃÜ— ÿˆVɲÍ=BIRwâ‰Õ(cM›•…aÿ Œ2 endstream endobj 55 0 obj <> endobj 323 0 obj <>stream xœ-TkTSWÎ%<"Å ­·Ü« IÁÚºtftQ[ >*b©B “+ò  áa’¨åýª‚¶–.+ "ÕéèØYSgÍšÖNÏeN;3auÖ>kï}öŸï[ßwÎ&8în‚ ¼"OÆ ^n7°ëÖßý7Ç-E.ñ.ø¸wø{~ÿ*šXÚ|‘uÇ— 2s Št†ò*«ÃÙÖÙ5¡ÈÐ(e©ZøvâFaHhèŽÍÂ߇.çá^¹X)K¥ ŠÔR±\¤v]҄lj2±Z#|{·T­ÎÛº5;;{‹H®Ú¢PJÂ7nfËÔRaŒX%Vf‰“„éja”H.þÂwË/%23M¬Ì)¥ •L"í§©EEr¹(i¹g¨diŠtÉò@¬¥‰ä I¢ôÌÿC8ÎJzí:‚Ã\¹úuÒÏ—C ŒC˜ˆr¢‚¨$Ìœ‹„…¨"ª9|—ZwŽ™p#‰Ûn7‹Û¿¹ÉÜGî)î÷=6y4³z>û¯’ûè«i»…`7Üç¢(ö QM´{PŽ¢KÃMSÎêQ ç<•Øý$:„yÆèk¿ÒZXOé˜ÜÂèwD>ï(ÿ˜é˜ÍÝÆ®šÝ9¥5Ë4âÂ$ ùìŽv Ýƒìºâo_ Ó3.Z‰£É ;S^n#½P:£_4©«±CŠ›ÀC>BþÈ{²h.±WüñÙK§á$Ää$HþpÈØ++ƒx·Ù`òy+òAÜoìxEȶ„·‚vdýø0€Ï~Wx}­‡xü•=â"+›@âWKNaoÀÞý'¢žH¿<4`¬œÖÞÓÞ͕ͣÖ[%Õxþ,ùÒ‰ùÁ²1wÓ±Äé‘\AA‡¾:ys-ß= à/}P:±än'>Zz‹‹þ»ô[ÿùgOF4[1ÇÌVZ¥C«µwÚ)£ søwH±©iôÆÏkI¼ÂÅÂäâ"]ƒ¾–ZD¿_D!ߢ¼O0 m?­ïû5Ïî-v,­ ouµrÙ⥣ä1}”! x¸ÐSŸíÌthJbANÃÖRܢLJ« ¨‡Mzt–O$ ]ewºMv£Ãh‡)øÖXwær(uÙ“Ï–±ÿ!&"Ý].»f)‚L/W™2`É’î×å—äCˆoÆvKÃÃÃÞ„õ¼ÐÁm/‘ß÷È‘ãòOÄ=›¿Ù5¯´A ÝÞ^uuº»¸¬3 ®ßoÂÕäícóaÁÛºg»äÅÌ|ç§_θ ùcî:5ˆ¶ô§¹¬?»Lk”6$o{è‰Mr»¬é‚ Øë¤2íCˆáíž‹Ÿ{4Ó{k,@k-b’Rã}ø`ïìÍ‘–![¡´Nà¸VOéÑáÖÞÞ¾¬su5>û>ã`¿ž$”ìK.ÛÀ¦y%É›Cñ¶w±­e<ÐÊÁÃE²ðØ[~S‹½©×Ü´.ç5hf#®`+$¡Tý…KùŽâ'UqÃ4c`3Xê¨hís´jù¹ì¹…ãh—ƒõ¿CüõRÎqÙ7pù¸3ñË/ _EÖ|tx¿8ùx@£U:€Ž‡3 ’t›†j´¶64¯‹¥ ð3¯ªÂ™Ëú[¥_À0íÂ{Â4÷µ´]ÞÙBîzóï2|ö?˘{>cézy<@êy.«a“ÉðT&†‰h²Êöâ$IÇU—´ÚÙ jô*2ï<_®º¸NÐ8Ú ¶–¹¢VGÙó>Ó=€iº’©Ï¾XØô(ÌL^µ”P• 5Š0Ã}ÝZ+UÀ¨rå5ÐgK>ï ]^pÅtÝÔçÒ §À±Ä"ì.VJZ‹gàúÔŒÁFÁ”!ý»æ†êsù™ƒ©Ÿž·¥Âû›ûaŽEI5U´›ëà+Âáå2œóÓAêRÞT½s¡ª­AÍ´ÑĘÊå`Òõ.œZ+œ"ÒØ¿pÙIö=Ro‰±© S0)ÁnDZ7]ây½’ŒvžÏr¤ÔÈáœË”&ÙÏSuÕ˘…Mï´„ÛÂjÃÌÅÔD»ý“Æ‘æ×bºV0‰Â{ОâÙc.jG5¤¡ì°1t•³Ðùô…Ë g~ÿ{ªk,¹ëLãû@ãõx ³8'èJžÈ¿3p¿b0ßNiI)§sN-ø U³´S3R6ZQI9ýŒ®Á]øÈ`í§ø™lD=J¯©lôÄ µ^÷¼^ ðvßa÷YqÏêã³`ñYÉáü{ùds endstream endobj 337 0 obj <>stream 2018-04-19T14:33:42+02:00 2018-04-19T14:33:42+02:00 dvips(k) 5.997 Copyright 2017 Radical Eye Software LT215Guide.dvi endstream endobj 2 0 obj <>endobj xref 0 338 0000000000 65535 f 0000209012 00000 n 0000271901 00000 n 0000208541 00000 n 0000199515 00000 n 0000000015 00000 n 0000000521 00000 n 0000209078 00000 n 0000219371 00000 n 0000254462 00000 n 0000217913 00000 n 0000243979 00000 n 0000209119 00000 n 0000209149 00000 n 0000199683 00000 n 0000000540 00000 n 0000003309 00000 n 0000216402 00000 n 0000231777 00000 n 0000209190 00000 n 0000209220 00000 n 0000199853 00000 n 0000003330 00000 n 0000005624 00000 n 0000215524 00000 n 0000223086 00000 n 0000222088 00000 n 0000266822 00000 n 0000209272 00000 n 0000209302 00000 n 0000200015 00000 n 0000005645 00000 n 0000007183 00000 n 0000220066 00000 n 0000261033 00000 n 0000209365 00000 n 0000209395 00000 n 0000200177 00000 n 0000007204 00000 n 0000010597 00000 n 0000217301 00000 n 0000236032 00000 n 0000209438 00000 n 0000209468 00000 n 0000200339 00000 n 0000010618 00000 n 0000013471 00000 n 0000209542 00000 n 0000209572 00000 n 0000200501 00000 n 0000013492 00000 n 0000018606 00000 n 0000220904 00000 n 0000263102 00000 n 0000222663 00000 n 0000268313 00000 n 0000221746 00000 n 0000265880 00000 n 0000218861 00000 n 0000253236 00000 n 0000217239 00000 n 0000209624 00000 n 0000209654 00000 n 0000200671 00000 n 0000018627 00000 n 0000022906 00000 n 0000209772 00000 n 0000209802 00000 n 0000200833 00000 n 0000022927 00000 n 0000027191 00000 n 0000209909 00000 n 0000209939 00000 n 0000200995 00000 n 0000027212 00000 n 0000031914 00000 n 0000221174 00000 n 0000264071 00000 n 0000210057 00000 n 0000210087 00000 n 0000201165 00000 n 0000031935 00000 n 0000034916 00000 n 0000210227 00000 n 0000210257 00000 n 0000201335 00000 n 0000034937 00000 n 0000037426 00000 n 0000210386 00000 n 0000210416 00000 n 0000201505 00000 n 0000037447 00000 n 0000040260 00000 n 0000210501 00000 n 0000210531 00000 n 0000201675 00000 n 0000040281 00000 n 0000043288 00000 n 0000210660 00000 n 0000210690 00000 n 0000201845 00000 n 0000043309 00000 n 0000048453 00000 n 0000210819 00000 n 0000210850 00000 n 0000202019 00000 n 0000048475 00000 n 0000053391 00000 n 0000210980 00000 n 0000211011 00000 n 0000202185 00000 n 0000053413 00000 n 0000057465 00000 n 0000211086 00000 n 0000211117 00000 n 0000202351 00000 n 0000057487 00000 n 0000060940 00000 n 0000211192 00000 n 0000211223 00000 n 0000202517 00000 n 0000060962 00000 n 0000064500 00000 n 0000211287 00000 n 0000211318 00000 n 0000202683 00000 n 0000064522 00000 n 0000069315 00000 n 0000211393 00000 n 0000211424 00000 n 0000202849 00000 n 0000069337 00000 n 0000074605 00000 n 0000211499 00000 n 0000211530 00000 n 0000203023 00000 n 0000074627 00000 n 0000079919 00000 n 0000211638 00000 n 0000211669 00000 n 0000203189 00000 n 0000079941 00000 n 0000085193 00000 n 0000211766 00000 n 0000211797 00000 n 0000203355 00000 n 0000085215 00000 n 0000088118 00000 n 0000220656 00000 n 0000262429 00000 n 0000211905 00000 n 0000211936 00000 n 0000203521 00000 n 0000088140 00000 n 0000091978 00000 n 0000212057 00000 n 0000212088 00000 n 0000203687 00000 n 0000092000 00000 n 0000095804 00000 n 0000212207 00000 n 0000212238 00000 n 0000203853 00000 n 0000095826 00000 n 0000098181 00000 n 0000212302 00000 n 0000212333 00000 n 0000204019 00000 n 0000098203 00000 n 0000101797 00000 n 0000212419 00000 n 0000212450 00000 n 0000204185 00000 n 0000101819 00000 n 0000104175 00000 n 0000212514 00000 n 0000212545 00000 n 0000204351 00000 n 0000104197 00000 n 0000106685 00000 n 0000212620 00000 n 0000212651 00000 n 0000204517 00000 n 0000106707 00000 n 0000111591 00000 n 0000212704 00000 n 0000212735 00000 n 0000204691 00000 n 0000111613 00000 n 0000116570 00000 n 0000212843 00000 n 0000212874 00000 n 0000204857 00000 n 0000116592 00000 n 0000121897 00000 n 0000212949 00000 n 0000212980 00000 n 0000205023 00000 n 0000121919 00000 n 0000126652 00000 n 0000213077 00000 n 0000213108 00000 n 0000205189 00000 n 0000126674 00000 n 0000130584 00000 n 0000213194 00000 n 0000213225 00000 n 0000205363 00000 n 0000130606 00000 n 0000134530 00000 n 0000213300 00000 n 0000213331 00000 n 0000205529 00000 n 0000134552 00000 n 0000139269 00000 n 0000216999 00000 n 0000235314 00000 n 0000216759 00000 n 0000234593 00000 n 0000216118 00000 n 0000229939 00000 n 0000213395 00000 n 0000213426 00000 n 0000205703 00000 n 0000139291 00000 n 0000143449 00000 n 0000213520 00000 n 0000213551 00000 n 0000205869 00000 n 0000143471 00000 n 0000148165 00000 n 0000213615 00000 n 0000213646 00000 n 0000206035 00000 n 0000148187 00000 n 0000153384 00000 n 0000213721 00000 n 0000213752 00000 n 0000206201 00000 n 0000153406 00000 n 0000157091 00000 n 0000213827 00000 n 0000213858 00000 n 0000206367 00000 n 0000157113 00000 n 0000160176 00000 n 0000213933 00000 n 0000213964 00000 n 0000206541 00000 n 0000160198 00000 n 0000164010 00000 n 0000214083 00000 n 0000214114 00000 n 0000206707 00000 n 0000164032 00000 n 0000168163 00000 n 0000214200 00000 n 0000214231 00000 n 0000206873 00000 n 0000168185 00000 n 0000172141 00000 n 0000214328 00000 n 0000214359 00000 n 0000207039 00000 n 0000172163 00000 n 0000175998 00000 n 0000214445 00000 n 0000214476 00000 n 0000207205 00000 n 0000176020 00000 n 0000179535 00000 n 0000214573 00000 n 0000214604 00000 n 0000207371 00000 n 0000179557 00000 n 0000183893 00000 n 0000214723 00000 n 0000214754 00000 n 0000207537 00000 n 0000183915 00000 n 0000187583 00000 n 0000214873 00000 n 0000214904 00000 n 0000207703 00000 n 0000187605 00000 n 0000191730 00000 n 0000215001 00000 n 0000215032 00000 n 0000207869 00000 n 0000191752 00000 n 0000193677 00000 n 0000215142 00000 n 0000215173 00000 n 0000208035 00000 n 0000193699 00000 n 0000195777 00000 n 0000215270 00000 n 0000215301 00000 n 0000208201 00000 n 0000195799 00000 n 0000197625 00000 n 0000215345 00000 n 0000215376 00000 n 0000208367 00000 n 0000197647 00000 n 0000199493 00000 n 0000215440 00000 n 0000215471 00000 n 0000223486 00000 n 0000230220 00000 n 0000232100 00000 n 0000234810 00000 n 0000235531 00000 n 0000236689 00000 n 0000244589 00000 n 0000253533 00000 n 0000254798 00000 n 0000261333 00000 n 0000262658 00000 n 0000263373 00000 n 0000264351 00000 n 0000266118 00000 n 0000267076 00000 n 0000268597 00000 n 0000216034 00000 n 0000216905 00000 n 0000217145 00000 n 0000217807 00000 n 0000218738 00000 n 0000219197 00000 n 0000219774 00000 n 0000220464 00000 n 0000220805 00000 n 0000221495 00000 n 0000221989 00000 n 0000222359 00000 n 0000222919 00000 n 0000270441 00000 n trailer << /Size 338 /Root 1 0 R /Info 2 0 R /ID [] >> startxref 272110 %%EOF LoopTools-2.16/PaxHeaders/configure0000644000000000000000000000013114160661753014366 xustar0029 mtime=1640195051.61183041 30 atime=1648161785.703698298 30 ctime=1648161793.715764879 LoopTools-2.16/configure0000755000000000000000000002366114160661753015322 0ustar00rootroot00000000000000#! /bin/bash # configure script for LoopTools # note: has nothing to do with GNU autoconf # last modified 22 Dec 21 th exec 2> ${LOGFILE:-/dev/null} 3>&1 eval ${LOGFILE:+set -x} shopt -s nullglob export LC_ALL=C CONF_DIR="${0%/*}" CONF_OS="`uname -s`" CONF_MACH="`uname -m`" CONF_DEFPREFIX="$CONF_MACH-$CONF_OS" CONF_PREFIX="$CONF_DEFPREFIX" CONF_TARGET= CONF_STATIC= CONF_STATIC_EXT= CONF_STATIC_GFORTRAN= CONF_QUAD= CONF_QUADSIZE=16 CONF_REAL10= CONF_DEBUG= CONF_BITS= CONF_MCLIBS= CONF_ARCH= CONF_AS= CONF_EXE= CONF_LDFLAGS= case "$CONF_OS" in # Mma 5.1's mcc needs -lpthread for static linking Linux) CONF_MCLIBS=" -lpthread -lrt" ;; Darwin) CONF_LDFLAGS="-Wl,-no_compact_unwind" ;; # need static linkage at least for libgfortran, to reliably get # our constructor executed before libgfortran's in MathLink code CYG*) CONF_LDFLAGS="-Wl,--image-base,0x10000000" CONF_STATIC_GFORTRAN="-static-libgfortran" CONF_EXE=".exe" ;; esac for arg in "$@" ; do case "$arg" in --prefix=*) CONF_PREFIX="${arg#--prefix=}" ;; --host=*) CONF_TARGET="${arg#--host=}" ;; --static) test "$CONF_OS" = Darwin && CONF_STATIC_EXT=1 || CONF_STATIC="-static" ;; --quad) CONF_QUAD=1 ;; --real10) CONF_REAL10=1 CONF_QUADSIZE=10 ;; --debug) CONF_DEBUG="-O0 -g" ;; --32) CONF_BITS="-m32" ;; --64) CONF_BITS="-m64" ;; --native) test "$CONF_OS" = Darwin && CONF_AS="-Wa,-q" CONF_ARCH="-march=native" ;; --help) cat << _EOF_ 1>&3 $0 configures LoopTools, i.e. determines or guesses the compiler and flags and writes out a makefile. $0 understands the following options: --prefix=DIR use DIR as installation directory --host=HOST target host triplet, e.g. i386-pc-linux --static link the executables statically --quad compile with quadruple precision (ifort, gfortran 4.6+, xlf only) --real10 use REAL*10 instead of REAL*16 (gfortran 4.6+ only) --debug compile with debug flags and without optimization --32 force 32-bit compilation --64 force 64-bit compilation --native optimize code for the host machine _EOF_ exit 0 ;; -*) echo "Warning: $arg is not a valid option." 1>&3 ;; *=*) eval "$arg" ;; *) echo "Warning: $arg is not a valid argument." 1>&3 ;; esac done test=test$$ trap "rm -fr $test* =." 0 1 2 3 15 ## look for some programs findprog() { echo -n "looking for $1... " 1>&3 var="$2" set -- ${!var:+"${!var}"} "${@:3}" test -n "$CONF_TARGET" && for prog in "$@" ; do full="`type -P "$CONF_TARGET-$prog"`" && { echo "$full" 1>&3 printf -v "CONF_$var" "%q" "$CONF_TARGET-$prog" return 0 } done for prog in "$@" ; do full="`type -P "$prog"`" && { echo "$full" 1>&3 printf -v "CONF_$var" "%q" "$prog" return 0 } done echo "no $@ in your path" 1>&3 return 1 } findprog gcc CC gcc clang || exit 1 findprog g++ CXX g++ clang++ || exit 1 findprog fortran FC ${CONF_REAL10:+gfortran} ${CONF_QUAD:+ifort gfortran xlf} ifort pgf90 xlf gfortran g95 f90 || exit 1 CONF_DEF="-D" setflags() { rhs= ${2:+printf -v rhs "${IFS:0:1}%q" "${@:2}"} eval "CONF_$1=\"\${rhs//\\\\,/,}\"" } set -- `eval "$CONF_FC --version -c" | sed '/^$/d;s/(.*)//;q' 2>&1` case "$1,$2,$3" in GNU,Fortran,[123].*) eval setflags FFLAGS "\ ${FFLAGS-${CONF_DEBUG:--O1} ${CONF_DEBUG:+-Wall}} \ $CONF_ARCH $CONF_AS $CONF_BITS -ffixed-line-length-none -fno-range-check \ $CONF_STATIC" ;; GNU,Fortran,4.*) eval setflags FFLAGS "\ ${FFLAGS-${CONF_DEBUG:--O3} ${CONF_DEBUG:+-Wall -Wno-unused-dummy-argument -Wtabs -ffpe-trap=invalid,overflow,zero}} \ $CONF_ARCH $CONF_AS $CONF_BITS -ffixed-line-length-none -fno-range-check \ ${CONF_QUAD:+-freal-8-real-$CONF_QUADSIZE} \ ${CONF_STATIC:-$CONF_STATIC_GFORTRAN} ${CONF_STATIC_EXT:+-static-libgfortran -static-libgcc}" ;; GNU,Fortran,*) eval setflags FFLAGS "\ ${FFLAGS-${CONF_DEBUG:--O3} ${CONF_DEBUG:+-Wall -Wno-unused-dummy-argument -Wno-tabs -Wno-conversion -ffpe-trap=invalid,overflow,zero}} \ $CONF_ARCH $CONF_AS $CONF_BITS -ffixed-line-length-none -fno-range-check \ ${CONF_QUAD:+-freal-8-real-$CONF_QUADSIZE} \ ${CONF_STATIC:-$CONF_STATIC_GFORTRAN} ${CONF_STATIC_EXT:+-static-libgfortran -static-libgcc}" ;; pgf*) eval setflags FFLAGS "\ ${FFLAGS-${CONF_DEBUG:--O3} ${CONF_DEBUG:+-Minform=inform -Ktrap=fp}} \ ${CONF_ARCH:+-Mvect=simd} $CONF_BITS -Mextend -g77libs \ ${CONF_STATIC:+-Bstatic} ${CONF_STATIC_EXT:+-Bstatic_pgi}" ;; ifort*) CONF_QUADSIZE=16 eval setflags FFLAGS "\ ${FFLAGS-${CONF_DEBUG:--O3}} ${CONF_DEBUG:+-debug} \ $CONF_ARCH $CONF_BITS -extend_source -warn truncated_source -warn nouncalled -assume bscc \ ${CONF_QUAD:+-r16 -DDBLE=QEXT -DDIMAG=QIMAG -DDCONJG=QCONJG -DDCMPLX=QCMPLX} \ $CONF_STATIC ${CONF_STATIC_EXT:+-static-intel}" ;; *) eval setflags FFLAGS "\ ${FFLAGS-${CONF_DEBUG:--O}}" ;; esac ## find the Fortran libraries echo -n "extracting the Fortran libraries... " 1>&3 rm -fr $test* tee $test.f << _EOF_ 1>&2 program test integer i common /uscore/ i call exit(i) end _EOF_ while read line ; do set -- ${line//[:,()]/ } [[ "$1" =~ (/collect2|/ld|^ld)$CONF_EXE$ ]] && while test $# -gt 1 ; do shift case "$1" in *.o | -lc*) ;; -l* | -L* | *.a) FLDFLAGS+=" $1" ;; -Bstatic | -Bdynamic | *.ld) FLDFLAGS+=" -Wl,$1" ;; /*) FLDFLAGS+=" -L$1" ;; -rpath*) FLDFLAGS+=" -Wl,$1,$2" shift ;; -dynamic-linker) shift ;; esac done done < <(eval $CONF_FC$CONF_FFLAGS -v -o $test $test.f 2>&1) eval setflags LDFLAGS "$LDFLAGS $CONF_LDFLAGS $FLDFLAGS" echo "ok" 1>&3 [[ "`eval $CONF_CC --version -c 2>&1`" =~ gcc ]] && CONF_STATIC_GCC="$CONF_STATIC_EXT" eval setflags CFLAGS "\ ${CFLAGS-${CONF_DEBUG:--O3 -g} -fomit-frame-pointer -ffast-math -fPIC -Wall} \ $CONF_STATIC ${CONF_STATIC_GCC:+-static-libgcc}" eval setflags CXXFLAGS "\ ${CXXFLAGS-${CONF_DEBUG:--O3 -g} -fomit-frame-pointer -ffast-math -fPIC -Wall} \ $CONF_STATIC ${CONF_STATIC_GCC:+-static-libstdc++ -static-libgcc}" ## does Fortran append underscores to symbols? echo -n "does $CONF_FC append underscores... " 1>&3 tee $test-c.c << _EOF_ 1>&2 int uscore_ = 95; int uscore = 59; _EOF_ for CONF_BITS in ${CONF_BITS:--m64 -m32} "" ; do eval $CONF_CC$CONF_CFLAGS $CONF_BITS -c $test-c.c 1>&2 || continue eval $CONF_FC$CONF_FFLAGS -o $test$CONF_EXE $test.f $test-c.o $CONF_LDFLAGS 1>&2 && break done ./$test$CONF_EXE case $? in 95) echo "yes" 1>&3 CONF_NOUNDERSCORE=0 ;; 59) echo "no" 1>&3 CONF_NOUNDERSCORE=1 ;; *) echo "error linking Fortran and C" 1>&3 exit 1 ;; esac CONF_CFLAGS+=" $CONF_BITS" CONF_CXXFLAGS+=" $CONF_BITS" test "$CONF_OS$CONF_BITS" = "Linux-m64" && CONF_LIBDIRSUFFIX=64 ## does f77 support REAL*16? echo -n "does $CONF_FC support REAL*$CONF_QUADSIZE... " 1>&3 rm -fr $test* tee $test.f << _EOF_ 1>&2 program test real*$CONF_QUADSIZE a, b a = 2D0**(52/2+2) b = a + 1/a if( a .eq. b ) call exit(1) end _EOF_ eval $CONF_FC$CONF_FFLAGS -o $test$CONF_EXE $test.f 1>&2 ./$test$CONF_EXE 1>&2 && { echo "yes" 1>&3 } || { echo "no" 1>&3 CONF_QUADSIZE=0 } ## does Fortran need 'external' for U77 routines? echo -n "does $CONF_FC need 'external' for U77 routines... " 1>&3 rm -fr $test* tee $test.f << _EOF_ 1>&2 program test implicit none print *, iargc(), len_trim("Hi") end _EOF_ eval $CONF_FC$CONF_FFLAGS -c $test.f 1>&2 && { echo "no" 1>&3 CONF_U77EXT=0 } || { echo "yes" 1>&3 CONF_U77EXT=1 } ## are we on a big-endian machine? echo -n "are we big-endian... " 1>&3 rm -fr $test* tee $test.c << _EOF_ 1>&2 #include int main() { union { int i; char c; } u; u.i = 1; u.c = 0; return u.i; } _EOF_ eval $CONF_CC$CONF_CFLAGS -o $test$CONF_EXE $test.c 1>&2 ./$test$CONF_EXE && { echo "no" 1>&3 CONF_BIGENDIAN=0 } || { echo "yes" 1>&3 CONF_BIGENDIAN=1 } ## can we do MathLink compilations echo -n "do we have MathLink... " 1>&3 test "$CONF_QUAD${CONF_OS::3}" == 1CYG && { echo "no, no quad precision with Windows MathLink" CONF_ML=0 } || { rm -fr $test* tee $test.tm << _EOF_ 1>&2 :Begin: :Function: test :Pattern: Test[i_Integer] :Arguments: {i} :ArgumentTypes: {Integer} :ReturnType: Integer :End: #include "mathlink.h" static int test(const int i) { return i + 1; } int main(int argc, char **argv) { return MLMain(argc, argv); } _EOF_ CONF_MCC="${MCC:-mcc}" # eval setflags MCFLAGS "-st ${CONF_BITS/m/b} -n" eval setflags MCFLAGS "-n" eval setflags MCDEFS "-D__int64='long long int'" # this is a workaround for a bug in mcc 11.0: ln -s "$CONF_DIR" =. for CONF_STDCPP in "" " -stdlib=libstdc++" ; do CC="$CONF_DIR/src/tools/fcc.in" REALCC="$CONF_CC$CONF_CFLAGS$CONF_MCDEFS" \ CXX="$CONF_DIR/src/tools/f++.in" REALCXX="$CONF_CXX$CONF_CXXFLAGS$CONF_MCDEFS$CONF_STDCPP" \ PATH="$PATH:$CONF_DIR/src/tools" \ eval "$CONF_MCC$CONF_MCFLAGS -o $test$CONF_EXE $test.tm$CONF_MCLIBS" 1>&2 && break done test -x $test$CONF_EXE && { echo "yes" 1>&3 CONF_ML=1 } || { echo "no" 1>&3 CONF_ML=0 } } case "$CONF_OS" in Linux*) cores=`grep -c processor /proc/cpuinfo` ;; Darwin) [[ `system_profiler SPHardwareDataType` =~ Cores:\ *([0-9]*) ]] cores="${BASH_REMATCH[1]}" ;; esac test "${cores:-1}" -gt 1 && CONF_PARALLEL="-j $cores" echo "creating makefile" 1>&3 cat - "$CONF_DIR/makefile.in" > makefile << _EOF_ # --- variables defined by configure --- SRC = $CONF_DIR/src QUADSUFFIX = ${CONF_QUAD:+-quad} PREFIX = $CONF_PREFIX LIBDIRSUFFIX = $CONF_LIBDIRSUFFIX EXE = $CONF_EXE DEF = $CONF_DEF NOUNDERSCORE = $CONF_NOUNDERSCORE QUAD = ${CONF_QUAD:-0} QUADSIZE = $CONF_QUADSIZE FC = $CONF_FC FFLAGS =$CONF_FFLAGS \\ \$(DEF)QUAD=\$(QUAD) \$(DEF)QUADSIZE=\$(QUADSIZE) \\ \$(DEF)U77EXT=$CONF_U77EXT CDEFS = -DQUAD=\$(QUAD) -DQUADSIZE=\$(QUADSIZE) \\ -DNOUNDERSCORE=\$(NOUNDERSCORE) \\ -DBIGENDIAN=$CONF_BIGENDIAN CC = $CONF_CC CFLAGS =$CONF_CFLAGS CXX = $CONF_CXX CXXFLAGS =$CONF_CXXFLAGS$CONF_STDCPP ML = $CONF_ML MCC = $CONF_MCC MCDEFS =$CONF_MCDEFS MCFLAGS =$CONF_MCFLAGS MCLIBS =$CONF_MCLIBS LDFLAGS =$CONF_LDFLAGS PARALLEL = $CONF_PARALLEL # --- end defs by configure --- _EOF_ echo " now you must run make " 1>&3 exit 0 LoopTools-2.16/PaxHeaders/src0000644000000000000000000000013214217172001013157 xustar0030 mtime=1648161793.715764879 30 atime=1648161793.715764879 30 ctime=1648161793.715764879 LoopTools-2.16/src/0000755000000000000000000000000014217172001014154 5ustar00rootroot00000000000000LoopTools-2.16/src/PaxHeaders/util0000644000000000000000000000013214217172001014134 xustar0030 mtime=1648161793.715764879 30 atime=1648161793.715764879 30 ctime=1648161793.715764879 LoopTools-2.16/src/util/0000755000000000000000000000000014217172001015131 5ustar00rootroot00000000000000LoopTools-2.16/src/util/PaxHeaders/auxCD.F0000644000000000000000000000007412401072604015332 xustar0030 atime=1648161785.703698298 30 ctime=1648161793.715764879 LoopTools-2.16/src/util/auxCD.F0000644000000000000000000002343312401072604016252 0ustar00rootroot00000000000000* auxCD.F * auxillary functions used by the three- and four-point integrals * these functions are adapted from Ansgar Denner's bcanew.f * to the conventions of LoopTools; * they are used for double-checking the results of FF * last modified 1 Sep 14 th #include "externals.h" #include "types.h" #include "defs.h" ComplexType function lndiv0(x, y) implicit none RealType x, y #include "ff.h" RealType den den = 1 - x/y if( abs(den) .lt. 1D-7 ) then lndiv0 = -1 - den*(.5D0 + den/3D0) else lndiv0 = lnrat(x, y)/den endif end ************************************************************************ ComplexType function lndiv1(x, y) implicit none RealType x, y #include "ff.h" RealType den den = 1 - x/y if( abs(den) .lt. 1D-7 ) then lndiv1 = -.5D0 - den/3D0*(1 + .75D0*den) else lndiv1 = (lnrat(x, y)/den + 1)/den endif end ************************************************************************ * Li2omrat(x, y) = Li2(1 - (x - i eps)/(y - i eps)) for real x and y * hence arguments are typically negative invariants * original version by R.K. Ellis ComplexType function Li2omrat(x, y) implicit none RealType x, y #include "ff.h" ComplexType spence external spence ComplexType omarg omarg = x/y if( Re(omarg) .lt. 0 ) then Li2omrat = pi6 - spence(0, omarg, 0D0) - & log(1 - omarg)*lnrat(x, y) else Li2omrat = spence(1, omarg, 0D0) endif end ************************************************************************ ComplexType function cLi2omrat(x, y) implicit none ComplexType x, y #include "ff.h" ComplexType spence external spence ComplexType omarg omarg = x/y if( Im(omarg) .eq. 0 .and. Re(omarg) .lt. 0 ) then cLi2omrat = pi6 - spence(0, omarg, 0D0) - & log(1 - Re(omarg))*lnrat(Re(x), Re(y)) else cLi2omrat = spence(1, omarg, 0D0) endif end ************************************************************************ * Li2omx2 = Li2(1 - (z1 + i eps1) (z2 + i eps2)) for complex z1, z2 * for z1 z2 < 1: +Li2(1 - z1 z2) * for z1 z2 > 1: -Li2(1 - 1/(z1 z2)) - 1/2 (log(z1) + log(z2))^2 * original version by R.K. Ellis ComplexType function Li2omx2(z1, s1, z2, s2) implicit none ComplexType z1, z2 RealType s1, s2 #include "ff.h" ComplexType spence external spence ComplexType z12, l12 RealType s12 z12 = z1*z2 if( abs(z12) .lt. zeroeps ) then Li2omx2 = 0 else if( abs(z12 - 1) .eq. diffeps ) then Li2omx2 = pi6 else l12 = ln(z1, s1) + ln(z2, s2) s12 = sign(1D0, Re(z2))*s1 + sign(1D0, Re(z1))*s2 if( abs(z12) .le. 1 ) then Li2omx2 = pi6 - spence(0, z12, s12) - & l12*ln(1 - z12, -s12) else z12 = 1/z12 Li2omx2 = -pi6 + spence(0, z12, s12) - & l12*(ln(1 - z12, -s12) + .5D0*l12) endif endif end ************************************************************************ * Li2omx3 = Li2(1 - (z1 + i eps1) (z2 + i eps2)) for complex z1, z2 * for z1 z2 < 1: +Li2(1 - z1 z2) * for z1 z2 > 1: -Li2(1 - 1/(z1 z2)) - 1/2 (log(z1) + log(z2))^2 * original version by R.K. Ellis ComplexType function Li2omx3(z1, s1, z2, s2, z3, s3) implicit none ComplexType z1, z2, z3 RealType s1, s2, s3 #include "ff.h" ComplexType spence external spence ComplexType z123, l123 RealType s123 z123 = z1*z2*z3 if( abs(Im(z123)) .lt. zeroeps ) & s123 = sign(1D0, & Re(z2*z3)*s1 + Re(z1*z3)*s2 + Re(z1*z2)*s3) if( abs(z123) .le. 1 ) then Li2omx3 = pi6 - spence(0, z123, s123) if( abs(z123) .gt. zeroeps .and. abs(z123 - 1) .gt. diffeps ) & Li2omx3 = Li2omx3 - ln(1 - z123, 0D0)* & (ln(z1, s1) + ln(z2, s2) + ln(z3, s3)) else z123 = 1/z123 l123 = ln(z1, s1) + ln(z2, s2) + ln(z3, s3) Li2omx3 = -pi6 + spence(0, z123, s123) - & l123*(.5D0*l123 + ln(1 - z123, 0D0)) endif end ************************************************************************ * Li2omrat2 = Li2(1 - (n1 - i eps) (n2 - i eps)/(d1 - i eps)/(d2 - i eps)) * for real n1, n2, d1, d2 * original version by R.K. Ellis ComplexType function Li2omrat2(n1, d1, n2, d2) implicit none RealType n1, d1, n2, d2 #include "ff.h" ComplexType spence external spence RealType r12 ComplexType l12 r12 = n1*n2/(d1*d2) if( r12 .lt. 1 ) then Li2omrat2 = pi6 - spence(0, ToComplex(r12), 0D0) if( abs(r12*(1 - r12)) .gt. diffeps ) & Li2omrat2 = Li2omrat2 - & (lnrat(n1, d1) + lnrat(n2, d2))*log(1 - r12) else r12 = 1/r12 l12 = lnrat(n1, d1) + lnrat(n2, d2) Li2omrat2 = -pi6 + spence(0, ToComplex(r12), 0D0) - & l12*(.5D0*l12 + log(1 - r12)) endif end ************************************************************************ ComplexType function cLi2omrat2(n1, d1, n2, d2) implicit none ComplexType n1, d1, n2, d2 #include "ff.h" ComplexType spence external spence ComplexType r12, l12 r12 = n1*n2/(d1*d2) if( abs(r12) .lt. 1 ) then cLi2omrat2 = pi6 - spence(0, r12, 0D0) if( abs(r12*(1 - r12)) .gt. diffeps ) & cLi2omrat2 = cLi2omrat2 - & (lnrat(n1, d1) + lnrat(n2, d2))*log(1 - r12) else r12 = 1/r12 l12 = lnrat(n1, d1) + lnrat(n2, d2) cLi2omrat2 = -pi6 + spence(0, r12, 0D0) - & l12*(.5D0*l12 + log(1 - r12)) endif end ************************************************************************ * original version by R.K. Ellis ComplexType function Li2rat(r1, s1, r2, s2) implicit none ComplexType r1, r2 RealType s1, s2 #include "ff.h" ComplexType Li2omx2, spence external Li2omx2, spence ComplexType r12, l12 if( abs(Im(r1)) + abs(Im(r2)) .lt. zeroeps ) then Li2rat = Li2omx2(r1, s1, r2, s2) return endif r12 = r1*r2 if( abs(r12) .lt. 1 ) then Li2rat = pi6 - spence(0, r12, 0D0) if( abs(r12*(1 - r12)) .gt. diffeps ) Li2rat = Li2rat - & (ln(r1, s1) + ln(r2, s2))*log(1 - r12) else r12 = 1/r12 l12 = ln(r1, s1) + ln(r2, s2) Li2rat = -pi6 + spence(0, r12, 0D0) - & l12*(.5D0*l12 + log(1 - r12)) endif end ************************************************************************ ComplexType function spence(i_in, z_in, s) implicit none integer i_in ComplexType z_in RealType s #include "ff.h" ComplexType Li2series external Li2series ComplexType z(0:1) RealType az1 z(i_in) = z_in z(1-i_in) = 1 - z_in #ifdef WARNINGS if( s .eq. 0 .and. & Im(z) .eq. 0 .and. abs(Re(z1)) .lt. diffeps ) & print *, "spence: argument on cut" #endif if( Re(z(0)) .lt. .5D0 ) then if( abs(z(0)) .lt. 1 ) then spence = Li2series(z(1), s) else spence = -pi6 - & .5D0*ln(-z(0), -s)**2 - Li2series(-z(1)/z(0), -s) endif else az1 = abs(z(1)) if( az1 .lt. 1D-15 ) then spence = pi6 else if( az1 .lt. 1 ) then spence = pi6 - & ln(z(0), s)*ln(z(1), -s) - Li2series(z(0), -s) else spence = 2*pi6 + & .5D0*ln(-z(1), -s)**2 - ln(z(0), s)*ln(z(1), -s) + & Li2series(-z(0)/z(1), s) endif endif end ************************************************************************ ComplexType function Li2series(z1, s) implicit none ComplexType z1 RealType s #include "ff.h" ComplexType xm, x2, new integer j * these are the even-n Bernoulli numbers, already divided by (n + 1)! * as in Table[BernoulliB[n]/(n + 1)!, {n, 2, 50, 2}] RealType b(25) data b / & 0.02777777777777777777777777777777777777777778774D0, & -0.000277777777777777777777777777777777777777777778D0, & 4.72411186696900982615268329554043839758125472D-6, & -9.18577307466196355085243974132863021751910641D-8, & 1.89788699889709990720091730192740293750394761D-9, & -4.06476164514422552680590938629196667454705711D-11, & 8.92169102045645255521798731675274885151428361D-13, & -1.993929586072107568723644347793789705630694749D-14, & 4.51898002961991819165047655285559322839681901D-16, & -1.035651761218124701448341154221865666596091238D-17, & 2.39521862102618674574028374300098038167894899D-19, & -5.58178587432500933628307450562541990556705462D-21, & 1.309150755418321285812307399186592301749849833D-22, & -3.087419802426740293242279764866462431595565203D-24, & 7.31597565270220342035790560925214859103339899D-26, & -1.740845657234000740989055147759702545340841422D-27, & 4.15763564461389971961789962077522667348825413D-29, & -9.96214848828462210319400670245583884985485196D-31, & 2.394034424896165300521167987893749562934279156D-32, & -5.76834735536739008429179316187765424407233225D-34, & 1.393179479647007977827886603911548331732410612D-35, & -3.372121965485089470468473635254930958979742891D-37, & 8.17820877756210262176477721487283426787618937D-39, & -1.987010831152385925564820669234786567541858996D-40, & 4.83577851804055089628705937311537820769430091D-42 / xm = -ln(z1, -s) x2 = xm**2 Li2series = xm - x2/4D0 do j = 1, 25 xm = xm*x2 new = Li2series + xm*b(j) if( new .eq. Li2series ) return Li2series = new enddo #ifdef WARNINGS print *, "Li2series: bad convergence" #endif end ************************************************************************ integer function eta(z1, s1, z2, s2, s12) implicit none ComplexType z1, z2 RealType s1, s2, s12 RealType im1, im2, im12 im1 = Im(z1) if( im1 .eq. 0 ) im1 = s1 im2 = Im(z2) if( im2 .eq. 0 ) im2 = s2 im12 = Im(z1*z2) if( im12 .eq. 0 ) im12 = s12 if( im1 .lt. 0 .and. im2 .lt. 0 .and. im12 .gt. 0 ) then eta = 1 else & if( im1 .gt. 0 .and. im2 .gt. 0 .and. im12 .lt. 0 ) then eta = -1 else eta = 0 #ifdef WARNINGS if( .not. (im2 .eq. 0 .and. Re(z2) .gt. 0 .or. & im1 .eq. 0 .and. Re(z1) .gt. 0) .and. & (im1 .eq. 0 .and. Re(z1) .lt. 0 .or. & im2 .eq. 0 .and. Re(z2) .lt. 0 .or. & im12 .eq. 0 .and. Re(z1*z2) .lt. 0) ) & print *, "eta not defined" #endif endif end LoopTools-2.16/src/util/PaxHeaders/ffinit.F0000644000000000000000000000007413264372155015621 xustar0030 atime=1648161785.703698298 30 ctime=1648161793.715764879 LoopTools-2.16/src/util/ffinit.F0000644000000000000000000006653113264372155016547 0ustar00rootroot00000000000000#include "externals.h" #include "types.h" #include "defs.h" * $Id: ffinit.f,v 1.9 1996/04/26 10:39:03 gj Exp $ *###[ ltini: subroutine ltini ***#[*comment:*********************************************************** * calculate a lot of commonly-used constants in the common block * * /ffcnst/. also set the precision, maximum loss of digits and * * the minimum value the logarithm accepts in /prec/. * ***#]*comment:*********************************************************** * #[ declarations: implicit none integer i,j,init,ioldp(13,12),isgrop(10,12),ji save init RealType s,sold ComplexType cs #include "lt.h" character*32 env data init /0/ data ioldp/1,2,3,4, 5,6,7,8,9,10, 11,12,13, + 4,1,2,3, 8,5,6,7,10,9, 11,13,12, + 3,4,1,2, 7,8,5,6,9,10, 11,12,13, + 2,3,4,1, 6,7,8,5,10,9, 11,13,12, + 4,2,3,1, 10,6,9,8,7,5, 12,11,13, + 1,3,2,4, 9,6,10,8,5,7, 12,11,13, + 1,2,4,3, 5,10,7,9,8,6, 13,12,11, + 1,4,3,2, 8,7,6,5,9,10, 11,13,12, + 3,4,2,1, 7,10,5,9,6,8, 13,12,11, + 2,3,1,4, 6,9,8,10,5,7, 12,13,11, + 4,2,1,3, 10,5,9,7,8,6, 13,11,12, + 1,3,4,2, 9,7,10,5,8,6, 13,11,12/ data isgrop/ + +1,+1,+1,+1, +1,+1,+1,+1, +1,+1, + +1,+1,+1,+1, +1,+1,+1,+1, -1,+1, + +1,+1,+1,+1, +1,+1,+1,+1, -1,-1, + +1,+1,+1,+1, +1,+1,+1,+1, +1,-1, + +1,+1,+1,+1, -1,+1,+1,-1, +1,-1, + +1,+1,+1,+1, -1,-1,+1,+1, -1,+1, + +1,+1,+1,+1, +1,+1,-1,+1, +1,+1, + +1,+1,+1,+1, -1,-1,-1,-1, +1,-1, + +1,+1,+1,+1, -1,+1,+1,+1, -1,-1, + +1,+1,+1,+1, +1,+1,+1,-1, +1,-1, + +1,+1,+1,+1, -1,+1,+1,-1, -1,-1, + +1,+1,+1,+1, -1,-1,+1,+1, -1,-1/ * #] declarations: * #[ check: * check whether there is anything to do if ( init .ne. 0 ) return init = 1 print *,'====================================================' print *,' FF 2.0, a package to evaluate one-loop integrals' print *,'written by G. J. van Oldenborgh, NIKHEF-H, Amsterdam' print *,'====================================================' print *,'for the algorithms used see preprint NIKHEF-H 89/17,' print *,'''New Algorithms for One-loop Integrals'', by G.J. van' print *,'Oldenborgh and J.A.M. Vermaseren, published in ' print *,'Zeitschrift fuer Physik C46(1990)425.' print *,'====================================================' * #] check: * #[ LoopTools stuff * * we do this here because loading block data is unreliable * call clearcache serial = 0 call getenv("LTMINMASS", env) minmass = 0 read(env, *, end=90, err=90) minmass print *, "env LTMINMASS =", minmass 90 continue call getenv("LTMAXDEV", env) maxdev = 1D-10 read(env, *, end=91, err=91) maxdev print *, "env LTMAXDEV =", maxdev 91 continue call getenv("LTDIFFEPS", env) diffeps = 1D-12 read(env, *, end=92, err=92) diffeps print *, "env LTDIFFEPS =", diffeps 92 continue call getenv("LTZEROEPS", env) zeroeps = 1D-22 read(env, *, end=93, err=93) zeroeps print *, "env LTZEROEPS =", zeroeps 93 continue call getenv("LTCMPBITS", env) cmpbits = 62 + QUAD*4 read(env, *, end=94, err=94) cmpbits print *, "env LTCMPBITS =", cmpbits cmpbits = max(cmpbits, 12 + QUAD*4) 94 continue call getenv("LTVERSION", env) versionkey = 0 read(env, *, end=95, err=95) versionkey print *, "env LTVERSION =", versionkey 95 continue call getenv("LTDEBUG", env) debugkey = 0 read(env, *, end=96, err=96) debugkey print *, "env LTDEBUG =", debugkey 96 continue call getenv("LTRANGE", env) debugfrom = 0 debugto = 2**30 i = index(env, '-') if( i .eq. 0 ) then read(env, *, end=97, err=97) debugfrom debugto = debugfrom else read(env(1:i-1), *, end=971, err=971) debugfrom 971 read(env(i+1:), *, end=972, err=972) debugto 972 continue endif print *, "env LTRANGE =", debugfrom, debugto 97 continue call getenv("LTWARN", env) warndigits = 9 read(env, *, end=98, err=98) warndigits print *, "env LTWARN =", warndigits 98 continue call getenv("LTERR", env) errdigits = 100 read(env, *, end=99, err=99) errdigits print *, "env LTERR =", errdigits 99 continue * * regularization parameters * call getenv("LTDELTA", env) delta = 0 read(env, *, end=100, err=100) delta print *, "env LTDELTA =", delta 100 continue call getenv("LTMUDIM", env) mudimc = 1 read(env, *, end=101, err=101) mudim print *, "env LTMUDIM =", mudim 101 continue call getenv("LTLAMBDA", env) lambda = 1 epsi = 0 read(env, *, end=102, err=102) lambda print *, "env LTLAMBDA =", lambda call setlambda(lambda) 102 continue call getenv("LTUVDIV", env) uvdiv = 1 read(env, *, end=103, err=103) uvdiv print *, "env LTUVDIV =", uvdiv 103 continue * * #] LoopTools stuff * #[ precision etc: nevent = -1 * * the loss of accuracy in any single subtraction at which * (timeconsuming) corrective action is to be taken is * xloss = 0.125D0 * * the precision to which real calculations are done is * precx = 1 sold = 0 do 1 i=1,1000 precx = precx/2 call ffset(s, 1 + precx) s = exp(log(s)) if ( s .eq. sold ) goto 2 sold = s 1 continue 2 continue precx = precx*8 * (take three bits for safety) * * the precision to which complex calculations are done is * precc = 1 sold = 0 do 3 i=1,1000 precc = precc/2 call ffset(s, 1 + precc) cs = exp(log(ToComplex(s))) if ( Re(cs) .eq. sold ) goto 4 sold = Re(cs) 3 continue 4 continue precc = precc*8 * (take three bits for safety) * * for efficiency take them equal if they are not too different * if ( precx/precc .lt. 4 .and. precx/precc .gt. .25 ) then precx = max(precc,precx) precc = max(precc,precx) endif * * and the minimum value the logarithm accepts without complaining * about arguments zero is (RealType cq ComplexType) * s = 1 xalogm = 1 do 5 i=1,10000 call ffset(s, s/2) if ( 2*s .ne. xalogm ) goto 6 xalogm = s 5 continue 6 continue if ( xalogm.eq.0 ) xalogm = 1d-307 s = 1 xclogm = abs(ToComplex(s)) do 7 i=1,10000 call ffset(s, s/2) if ( 2*abs(ToComplex(s)) .ne. xclogm ) goto 8 xclogm = abs(ToComplex(s)) 7 continue 8 continue if ( xclogm.eq.0 ) xclogm = 1d-307 * * These values are for Absoft, Apollo fortran (68000): * xalogm = 1.D-308 * xclogm = 1.D-18 * These values are for VAX g_float * xalogm = 1.D-308 * xclogm = 1.D-308 * These values are for Gould fort (because of div_zz) * xalogm = 1.D-75 * xclogm = 1.D-36 xalog2 = sqrt(xalogm) xclog2 = sqrt(xclogm) * #] precision etc: * #[ constants: * * calculate the coefficients of the series expansion * li2(x) = sum bn*z^n/(n+1)!, z = -log(1-x), bn are the * bernouilli numbers (zero for odd n>1). * bf(1) = - 1.D+0/4.D+0 bf(2) = + 1.D+0/36.D+0 bf(3) = - 1.D+0/36.D+2 bf(4) = + 1.D+0/21168.D+1 bf(5) = - 1.D+0/108864.D+2 bf(6) = + 1.D+0/52690176.D+1 bf(7) = - 691.D+0/16999766784.D+3 bf(8) = + 1.D+0/1120863744.D+3 bf(9) = - 3617.D+0/18140058832896.D+4 bf(10) = + 43867.D+0/97072790126247936.D+3 bf(11) = - 174611.D+0/168600109166641152.D+5 bf(12) = + 77683.D+0/32432530090601152512.D+4 bf(13) = - 236364091.D+0/4234560341829359173632.D+7 bf(14) = + 657931.D+0/5025632054039239458816.D+6 bf(15) = - 3392780147.D+0/109890470493622010006470656.D+7 bf(16)=+172.3168255201D+0/2355349904102724211909.3102313472D+6 bf(17)=-770.9321041217D+0/4428491985594062112714.2791446528D+8 bf(18)=( 0.4157635644614046176D-28) bf(19)=(-0.9962148488284986022D-30) bf(20)=( 0.2394034424896265390D-31) * * inverses of integers: * do 10 i=1,30 xninv(i) = 1D0/i xn2inv(i) = 1D0/(i*i) 10 continue * * inverses of faculties of integers: * xinfac(1) = 1D0 do 20 i=2,30 xinfac(i) = xinfac(i-1)/i 20 continue * * inx: p(inx(i,j)) = isgn(i,j)*(s(i)-s(j)) * inx(1,1) = -9999 inx(2,1) = 5 inx(3,1) = 9 inx(4,1) = 8 inx(1,2) = 5 inx(2,2) = -9999 inx(3,2) = 6 inx(4,2) = 10 inx(1,3) = 9 inx(2,3) = 6 inx(3,3) = -9999 inx(4,3) = 7 inx(1,4) = 8 inx(2,4) = 10 inx(3,4) = 7 inx(4,4) = -9999 isgn(1,1) = -9999 isgn(2,1) = +1 isgn(3,1) = -1 isgn(4,1) = -1 isgn(1,2) = -1 isgn(2,2) = -9999 isgn(3,2) = +1 isgn(4,2) = +1 isgn(1,3) = +1 isgn(2,3) = -1 isgn(3,3) = -9999 isgn(4,3) = +1 isgn(1,4) = +1 isgn(2,4) = -1 isgn(3,4) = -1 isgn(4,4) = -9999 do 40 i=1,12 do 30 j=1,13 iold(j,i) = ioldp(j,i) 30 continue do 35 j=1,10 isgrot(j,i) = isgrop(j,i) 35 continue 40 continue inx5(1,1) = -9999 inx5(1,2) = 6 inx5(1,3) = 11 inx5(1,4) = 14 inx5(1,5) = 10 inx5(2,1) = 6 inx5(2,2) = -9999 inx5(2,3) = 7 inx5(2,4) = 12 inx5(2,5) = 15 inx5(3,1) = 11 inx5(3,2) = 7 inx5(3,3) = -9999 inx5(3,4) = 8 inx5(3,5) = 13 inx5(4,1) = 14 inx5(4,2) = 12 inx5(4,3) = 8 inx5(4,4) = -9999 inx5(4,5) = 9 inx5(5,1) = 10 inx5(5,2) = 15 inx5(5,3) = 13 inx5(5,4) = 9 inx5(5,5) = -9999 * isgn5 is not yet used. do i=1,5 do j=1,5 isgn5(i,j) = -9999 enddo enddo * inx6(1,1) = -9999 inx6(1,2) = 7 inx6(1,3) = 13 inx6(1,4) = 19 inx6(1,5) = 17 inx6(1,6) = 12 inx6(2,1) = 7 inx6(2,2) = -9999 inx6(2,3) = 8 inx6(2,4) = 14 inx6(2,5) = 20 inx6(2,6) = 18 inx6(3,1) = 13 inx6(3,2) = 8 inx6(3,3) = -9999 inx6(3,4) = 9 inx6(3,5) = 15 inx6(3,6) = 21 inx6(4,1) = 19 inx6(4,2) = 14 inx6(4,3) = 9 inx6(4,4) = -9999 inx6(4,5) = 10 inx6(4,6) = 16 inx6(5,1) = 17 inx6(5,2) = 20 inx6(5,3) = 15 inx6(5,4) = 10 inx6(5,5) = -9999 inx6(5,6) = 11 inx6(6,1) = 12 inx6(6,2) = 18 inx6(6,3) = 21 inx6(6,4) = 16 inx6(6,5) = 11 inx6(6,6) = -9999 * isgn6 is used. do i=1,6 do j=1,6 ji = j-i if ( ji.gt.+3 ) ji = ji - 6 if ( ji.lt.-3 ) ji = ji + 6 if ( ji.eq.0 ) then isgn6(j,i) = -9999 elseif ( abs(ji).eq.3 ) then if ( i.lt.0 ) then isgn6(j,i) = -1 else isgn6(j,i) = +1 endif elseif ( ji.gt.0 ) then isgn6(j,i) = +1 elseif ( ji.lt.0 ) then isgn6(j,i) = -1 else print *,'ltini: internal error in isgn6' stop endif enddo enddo * * #] constants: * #[ defaults for flags: nevent = 0 * * the debugging flags. * ldc3c4 = .FALSE. l4also = .FALSE. lmem = .FALSE. ldot = .FALSE. idot = 0 * * Specify which root to take in cases were two are possible * it may be advantageous to change this to -1 (debugging hook) * isgn34 = 1 isgnal = 1 * * the scheme used for the complex scalar functions: * * nschem = 1: do not use the complex mass at all * 2: only use the complex mass in linearly divergent terms * 3: also use the complex mass in divergent logs UNDEFINED * 4: use the complex mass in the C0 if there are * divergent logs * 5: include the almost-divergent threshold terms from * (m,m,0) vertices * 6: include the (s-m^2)*log(s-m^2) threshold terms from * (m1+m2),m1,m2) vertices * 7: full complex computation * (only in the ffz... functions): * onshel = .FALSE.: use the offshell p^2 everywhere * .TRUE.: use the onshell p^2 except in complex parts * nschem = 7 onshel = .TRUE. * * the precision wanted in the complex D0 (and hence E0) when * nschem=7, these are calculated via Taylor expansion in the real * one and hence expensive. * reqprc = 1.D-8 * * in some schemes, for onshel=.FALSE., * when |p^2-Re(m^2)| < nwidth*|Im(m^2)| special action is taken * nwidth = 5 * * a flag to indicate the validity of differences smuggled to the * IR routines in the C0 (ff internal only) * lsmug = .FALSE. * * #] defaults for flags: *###] ltini: end *###[ ffexi: subroutine ltexi ***#[*comment:*********************************************************** * check a lot of commonly-used constants in the common block * * /ffcnst/. * ***#]*comment:*********************************************************** * #[ declarations: implicit none integer i,ier #include "ff.h" * #] declarations: * #[ checks: * * calculate the coefficients of the series expansion * li2(x) = sum bn*z^n/(n+1)!, z = -log(1-x), bn are the * bernouilli numbers (zero for odd n>1). * if ( bf(1) .ne. - 1.D+0/4.D+0 ) + print *,'ffexi: error: bf(1) is corrupted' if ( bf(2) .ne. + 1.D+0/36.D+0 ) + print *,'ffexi: error: bf(2) is corrupted' if ( bf(3) .ne. - 1.D+0/36.D+2 ) + print *,'ffexi: error: bf(3) is corrupted' if ( bf(4) .ne. + 1.D+0/21168.D+1 ) + print *,'ffexi: error: bf(4) is corrupted' if ( bf(5) .ne. - 1.D+0/108864.D+2 ) + print *,'ffexi: error: bf(5) is corrupted' if ( bf(6) .ne. + 1.D+0/52690176.D+1 ) + print *,'ffexi: error: bf(6) is corrupted' if ( bf(7) .ne. - 691.D+0/16999766784.D+3 ) + print *,'ffexi: error: bf(7) is corrupted' if ( bf(8) .ne. + 1.D+0/1120863744.D+3 ) + print *,'ffexi: error: bf(8) is corrupted' if ( bf(9) .ne. - 3617.D+0/18140058832896.D+4 ) + print *,'ffexi: error: bf(9) is corrupted' if ( bf(10) .ne. + 43867.D+0/97072790126247936.D+3 ) + print *,'ffexi: error: bf(10) is corrupted' if ( bf(11) .ne. - 174611.D+0/168600109166641152.D+5 ) + print *,'ffexi: error: bf(11) is corrupted' if ( bf(12) .ne. + 77683.D+0/32432530090601152512.D+4 ) + print *,'ffexi: error: bf(12) is corrupted' if ( bf(13) .ne. - 236364091.D+0/4234560341829359173632.D+7 ) + print *,'ffexi: error: bf(13) is corrupted' if ( bf(14) .ne. + 657931.D+0/5025632054039239458816.D+6 ) + print *,'ffexi: error: bf(14) is corrupted' if ( bf(15) .ne. -3392780147.D+0/109890470493622010006470656.D+7 + ) print *,'ffexi: error: bf(15) is corrupted' if ( bf(16).ne.+172.3168255201D+0/2355349904102724211909.3102313 + 472D+6 ) + print *,'ffexi: error: bf(16) is corrupted' if ( bf(17).ne.-770.9321041217D+0/4428491985594062112714.2791446 + 528D+8 ) + print *,'ffexi: error: bf(17) is corrupted' if ( bf(18).ne.( 0.4157635644614046176D-28) ) + print *,'ffexi: error: bf(18) is corrupted' if ( bf(19).ne.(-0.9962148488284986022D-30) ) + print *,'ffexi: error: bf(19) is corrupted' if ( bf(20).ne.( 0.2394034424896265390D-31) ) + print *,'ffexi: error: bf(20) is corrupted' * * inverses of integers: * do 10 i=1,20 if ( abs(xninv(i)-1D0/i) .gt. precx*xninv(i) ) print *, + 'ffexi: error: xninv(',i,') is not 1/',i,': ', + xninv(i),xninv(i)-1D0/i 10 continue * * #] checks: * #[ print summary of errors and warning: ier = 0 call fferr(999,ier) * #] print summary of errors and warning: *###] ffexi: end *###[ fferr: subroutine fferr(nerr,ierr) ***#[*comment:*********************************************************** * * * generates an error message #nerr with severity 2 * * nerr=999 gives a frequency listing of all errors * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none integer nmax parameter (nmax=105) integer nerr,ierr integer noccur(nmax),i,inone,nnerr save error,noccur #include "ff.h" #include "fferr.h" * #] declarations: * #[ data: data noccur /nmax*0/ * #] data: * #[ nerr=999: if ( nerr .eq. 999 ) then * print out total numbers... print '(a)',' ' print '(a)','total number of errors and warnings' print '(a)','===================================' inone = 1 do 10 i = 1, nmax if ( noccur(i) .gt. 0 ) then print '(a,i5,a,a)','fferr: ',noccur(i), + ' times ',error(i) noccur(i) = 0 inone = 0 endif 10 continue if ( inone.eq.1 ) print '(a)','fferr: no errors' print '(a)',' ' return endif * #] nerr=999: * #[ print error: if ( nerr .lt. 1 .or. nerr .gt. nmax ) then nnerr = nmax else nnerr = nerr endif noccur(nnerr) = noccur(nnerr) + 1 ierr = ierr + 100 print '(a,a)', 'error in ', error(nnerr) * #] print error: *###] fferr: end *###[ ffwarn: subroutine ffwarn(nerr,ierr,som,xmax) ***#[*comment:*********************************************************** * * * The warning routine. A warning is aloss of precision greater * * than xloss (which is default set in ltini), whenever in a * * subtraction the result is smaller than xloss*max(operands) this * * routine is called. Now the strategy is to remember these * * warnings until a 998 message is obtained; then all warnings of * * the previous event are printed. The rationale is that one * * makes this call if too much preciasion is lost only. * * nerr=999 gives a frequency listing of all warnings * * * * Input: nerr integer the id of the warning message, see the * * file ffwarn.h or 998 or 999 * * ierr integer the usual error flag: number of digits * * lost so far * * som real the result of the addition * * xmax real the largest operand * * * * Output: ierr integer is raised by the number of digits lost * * the tolerated loss of xloss * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none integer nmax parameter (nmax=300) * * arguments * integer nerr,ierr RealType som,xmax * * local variables * integer memmax parameter (memmax = 1000) integer noccur(nmax),i,inone,nnerr,ilost, + nermem(memmax),losmem(memmax),idmem(memmax), + idsmem(memmax),laseve,imem RealType xlosti(nmax),xlost save warn,noccur,xlosti,nermem,losmem,idmem,idsmem, + laseve,imem * * common blocks * #include "ff.h" #include "ffwarn.h" * #] declarations: * #[ data: data noccur /nmax*0/ * #] data: * #[ nerr=999: if ( nerr.eq.999 ) then * print out total numbers... inone = 1 do 10 i=1,nmax if ( noccur(i) .gt. 0 ) then print '(a,i8,a,i3,a,a)','ffwarn: ',noccur(i), + ' times ',i,': ',warn(i) print '(a,g12.3,a)', + ' (lost at most a factor ',xlosti(i),')' noccur(i) = 0 xlosti(i) = 0 inone = 0 endif 10 continue if ( inone.eq.1 ) print '(a)','ffwarn: no warnings' return endif * #] nerr=999: * #[ print warning: if ( nerr .eq. 998 ) then if ( nevent .ne. laseve ) return do 20 i=1,imem-1 if ( nermem(i).ne.0 ) then print '(a,a)','warning in ',warn(nermem(i)) print '(a,i3,a)',' (lost ',losmem(i),' digits)' endif 20 continue imem = 1 return endif * #] print warning: * #[ collect warnings: * * bring in range * if ( nerr .lt. 1 .or. nerr .gt. nmax ) then nnerr = nmax else nnerr = nerr endif * * bookkeeping * noccur(nnerr) = noccur(nnerr) + 1 if ( som .ne. 0 ) then xlost = abs(xmax/som) elseif ( xmax .ne. 0 ) then xlost = 1/precx else xlost = 1 endif xlosti(nnerr) = max(xlosti(nnerr),xlost) if ( xlost*xloss .gt. xalogm ) then ilost = 1 + int(abs(log10(xlost*xloss))) else ilost = 0 endif ierr = ierr + ilost * * nice place to stop when debugging * if ( ilost.ge.10 ) then ilost = ilost + 1 endif * * add to memory * if ( laseve .ne. nevent ) then imem = 1 laseve = nevent endif if ( imem .le. memmax ) then idmem(imem) = id idsmem(imem) = idsub nermem(imem) = nerr losmem(imem) = ilost imem = imem + 1 endif * #] collect warnings: *###] ffwarn: end *###[ ffbnd: RealType function ffbnd(n1,n2,array) ************************************************************************* * * * calculate bound = (precx*|a(n1)/a(n1+n2)|^(1/n2) which is the * * maximum value of x in a series expansion sum_(i=n1)^(n1+n2) * * a(i)*x(i) to give a result of accuracy precx (actually of |next * * term| < prec * * * ************************************************************************* implicit none integer n1,n2 RealType array(n1+n2) #include "ff.h" if ( array(n1+n2) .eq. 0 ) then print *,'ffbnd: fatal: array not initialized; did you call ', + 'ltini?' stop endif ffbnd = (precx*abs(array(n1)/array(n1+n2)))**(1/Re(n2)) * added 22 Mar 11: be a bit more conservative: ffbnd = .8D0*ffbnd *###] ffbnd: end *###[ ffroot: subroutine ffroot(xm,xp,a,b,c,d,ier) ***#[*comment:*********************************************************** * * * Calculate the roots of the equation * * a*x^2 - 2*b*x + c = 0 * * given by * * x = (b +/- d )/a xp*xm = c/a * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments: * integer ier RealType xm,xp,a,b,c,d * * common blocks: * #include "ff.h" * #] declarations: * #[ check input: if ( a .eq. 0 ) then call fferr(39,ier) if ( b.gt.0 .eqv. d.gt.0 ) then xp = 1/xalogm xm = c/(b+d) else xp = c/(b-d) xm = 1/xalogm endif return endif * #] check input: * #[ calculations: if ( d .eq. 0 ) then xm = b / a xp = xm elseif ( b .gt. 0 .eqv. d .gt. 0 ) then xp = ( b + d ) / a xm = c / (a*xp) else xm = ( b - d ) / a xp = c / (a*xm) endif * #] calculations: *###] ffroot: end *###[ ffcoot: subroutine ffcoot(xm,xp,a,b,c,d,ier) ***#[*comment:*********************************************************** * * * Calculate the roots of the equation * * a*x^2 - 2*b*x + c = 0 * * given by * * x = (b +/- d )/a xp*xm = c/a * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments: * integer ier ComplexType xm,xp,a,b,c,d * * local variables: * ComplexType cc RealType absc * * common blocks: * #include "ff.h" * * statement function * absc(cc) = abs(Re(cc)) + abs(Im(cc)) * #] declarations: * #[ check input: if ( a .eq. 0 ) then call fferr(38,ier) if ( Re(b).gt.0 .eqv. Re(d).gt.0 ) then xp = 1/xclogm xm = c/(b+d) else xp = c/(b-d) xm = 1/xclogm endif return endif * #] check input: * #[ calculations: cc = b+d if ( d .eq. 0 ) then xm = b / a xp = xm elseif ( absc(cc) .gt. xloss*absc(d) ) then xp = ( b + d ) / a xm = c / (a*xp) else xm = ( b - d ) / a xp = c / (a*xm) endif * #] calculations: *###] ffcoot: end *###[ ffxhck: subroutine ffxhck(xpi,dpipj,ns,ier) ***#[*comment:*********************************************************** * * * check whether the differences dpipj are compatible with xpi * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none integer ns,ier RealType xpi(ns),dpipj(ns,ns) integer i,j RealType xheck,rloss #include "ff.h" * #] declarations: * #[ calculations: if ( ier.lt.0 ) then print *,'ffxhck: error: ier < 0 ',ier ier=0 endif rloss = xloss**2*Re(10)**(-mod(ier,50)) do 20 i=1,ns do 10 j=1,ns xheck = dpipj(j,i) - xpi(j) + xpi(i) if ( rloss*abs(xheck) .gt. precx*max(abs(dpipj(j,i)), + abs(xpi(j)),abs(xpi(i))) ) then print *,'ffxhck: error: dpipj(',j,i,') <> xpi(',j, + ') - xpi(',i,'):',dpipj(j,i),xpi(j),xpi(i), + xheck,ier endif 10 continue 20 continue * #] calculations: *###] ffxhck: end *###[ ffchck: subroutine ffchck(cpi,cdpipj,ns,ier) ***#[*comment:*********************************************************** * * * check whether the differences cdpipj are compatible with cpi * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none integer ns,ier ComplexType cpi(ns),cdpipj(ns,ns),c integer i,j ComplexType check RealType absc,rloss #include "ff.h" absc(c) = abs(Re(c)) + abs(Im(c)) * #] declarations: * #[ calculations: if ( ier.lt.0 ) then print *,'ffchck: error: ier < 0 ',ier ier=0 endif rloss = xloss**2*Re(10)**(-mod(ier,50)) do 20 i=1,ns do 10 j=1,ns check = cdpipj(j,i) - cpi(j) + cpi(i) if ( rloss*absc(check) .gt. precc*max(absc( + cdpipj(j,i)),absc(cpi(j)),absc(cpi(i))) ) then print *,'ffchck: error: cdpipj(',j,i,') <> cpi(',j, + ') - cpi(',i,'):',cdpipj(j,i),cpi(j),cpi(i), + check,ier endif 10 continue 20 continue * #] calculations: *###] ffchck: end *###[ nffeta: integer function nffeta(ca,cb,ier) ***#[*comment:*********************************************************** * calculates * * * * eta(a,b)/(2*i*pi) = ( thIm(-a)*thIm(-b)*thIm(a*b) * * - thIm(a)*thIm(b)*thIm(-a*b) ) * * * * with thIm(a) = theta(Im(a)) * ***#]*comment:*********************************************************** * #[ declarations: implicit none integer ier ComplexType ca,cb RealType a,b,ab,rab #include "ff.h" * #] declarations: * #[ calculations: a = Im(ca) b = Im(cb) if ( a*b .lt. 0 ) then nffeta = 0 return endif rab = Re(ca)*Re(cb) - a*b ab = Re(ca)*b + a*Re(cb) if ( abs(ab) .lt. precc*abs(Re(ca)*b) ) then call fferr(32,ier) endif if ( a .lt. 0 .and. b .lt. 0 .and. ab .gt. 0 ) then nffeta = 1 elseif ( a .gt. 0 .and. b .gt. 0 .and. ab .lt. 0 ) then nffeta = -1 elseif ( a .eq. 0 .and. Re(ca) .le. 0 .or. + b .eq. 0 .and. Re(cb) .le. 0 .or. + ab .eq. 0 .and. rab .le. 0 ) then call fferr(32,ier) nffeta = 0 else nffeta = 0 endif * #] calculations: *###] nffeta: end *###[ nffet1: integer function nffet1(ca,cb,cc,ier) ***#[*comment:*********************************************************** * calculates the same eta with three input variables * * * * et1(a,b)/(2*i*pi) = ( thIm(-a)*thIm(-b)*thIm(c) * * - thIm(a)*thIm(b)*thIm(-c) ) * * * * with thIm(a) = theta(Im(a)) * ***#]*comment:*********************************************************** * #[ declarations: implicit none integer ier ComplexType ca,cb,cc RealType a,b,ab #include "ff.h" * #] declarations: * #[ calculations: a = Im(ca) b = Im(cb) if ( a .gt. 0 .neqv. b .gt. 0 ) then nffet1 = 0 return endif ab = Im(cc) if ( a .lt. 0 .and. b .lt. 0 .and. ab .gt. 0 ) then nffet1 = 1 elseif ( a .gt. 0 .and. b .gt. 0 .and. ab .lt. 0 ) then nffet1 = -1 elseif ( a .eq. 0 .and. Re(ca) .le. 0 .or. + b .eq. 0 .and. Re(cb) .le. 0 .or. + ab .eq. 0 .and. Re(cc) .le. 0 ) then call fferr(33,ier) nffet1 = 1 else nffet1 = 0 endif * #] calculations: *###] nffet1: end *###[ ffcayl: subroutine ffcayl(cs,z,coeff,n,ier) ***#[*comment:*********************************************************** * * * Do a Taylor expansion in z with real coefficients coeff(i) * * * * Input: z complex * * coeff(n) real * * n integer * * * * Output cs complex \sum_{i=1} z^i coeff(i) * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments * integer n,ier RealType coeff(n) ComplexType z,cs * * local variables * integer i RealType absc ComplexType c,zi,csi * * common blocks * #include "ff.h" * * statement function * absc(c) = abs(Re(c)) + abs(Im(c)) * * #] declarations: * #[ work: cs = z*Re(coeff(1)) if ( absc(z) .lt. precc ) return zi = z do 10 i=2,n zi = zi*z csi = zi*Re(coeff(i)) cs = cs + csi if ( absc(csi) .lt. precc*absc(cs) ) goto 20 10 continue call ffwarn(9,ier,precc,absc(csi)) 20 continue * #] work: *###] ffcayl: end *###[ fftayl: subroutine fftayl(s,z,coeff,n,ier) ***#[*comment:*********************************************************** * * * Do a Taylor expansion in z with real coefficients coeff(i) * * * * Input: z real * * coeff(n) real * * n integer * * * * Output cs real \sum_{i=1} z^i coeff(i) * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments * integer n,ier RealType coeff(n),z,s * * local variables * integer i RealType zi,si * * common blocks * #include "ff.h" * * #] declarations: * #[ work: s = coeff(1)*z if ( abs(z) .lt. precx ) return zi = z do 10 i=2,n zi = zi*z si = coeff(i)*zi s = s + si if ( abs(si) .lt. precx*abs(s) ) goto 20 10 continue call ffwarn(9,ier,precx,si) 20 continue * #] work: *###] fftayl: end LoopTools-2.16/src/util/PaxHeaders/ff2dl2.F0000644000000000000000000000007411776502523015421 xustar0030 atime=1648161785.707698331 30 ctime=1648161793.715764879 LoopTools-2.16/src/util/ff2dl2.F0000644000000000000000000003036711776502523016345 0ustar00rootroot00000000000000#include "externals.h" #include "types.h" *###[ ff2dl2: subroutine ff2dl2(del2d2,del2n,xpi,dpipj,piDpj, i, + j,k,kj,iskj,l, m,n,nm,isnm, ns, ier) ***#[*comment:*********************************************************** * * * Calculate * * * * si mu mu sl * * d d = si.sj*sk.sm*sl.sn - si.sk*sj.sm*sl.sn * * sj sk sm sn - si.sj*sk.sn*sl.sm + si.sk*sj.sn*sl.sm * * * * with p(kj) = iskj*(sk-sj) * * with p(nm) = isnm*(sn-sm) * * * * Input: xpi(ns) as usual * * dpipj(ns,ns) -"- * * piDpj(ns,ns) -"- * * i,j,k,kj,iskj see above * * l,m,n,nm,isnm -"- * * * * Output: del2d2 see above * * del2n it is needed in fftran anyway * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments: * integer i,j,k,kj,iskj,l,m,n,nm,isnm,ns,ier RealType del2d2,del2n,xpi(10),dpipj(10,10),piDpj(10,10) * * local variables: * integer isii,ii,ik,ij,im,in,ier0,ier1 RealType s(5),del2m,del2nm,som,xmax,smax * * common blocks: * #include "ff.h" * #] declarations: * #[ get del2n: * we need this in any case ! ier1 = ier if ( i .eq. n ) then del2n = 0 elseif ( i .le. 4 ) then ii = inx(n,i) isii = isgn(n,i) call ffdl2s(del2n,piDpj,i,n,ii,isii,j,k,kj,iskj,10) else call ffdl2t(del2n,piDpj,i,n,j,k,kj,iskj,+1,10) endif * #] get del2n: * #[ special cases: ier0 = ier if ( i .eq. l .and. j .eq. m .and. k .eq. n ) then call ffdl3m(s,.FALSE.,0D0,0D0,xpi,dpipj,piDpj,ns,j,k,kj, + i,1) del2d2 = -s(1) ier = max(ier0,ier1) return endif if ( k .eq. l .and. j .le. 4 ) then call ffdl2s(del2m,piDpj, j,l,inx(l,j),isgn(l,j), + m,n,nm,isnm, 10) del2d2 = -piDpj(i,k)*del2m ier = max(ier0,ier1) return endif * #] special cases: * #[ calculations: ier0 = ier if ( i .eq. m ) then del2m = 0 elseif ( i .le. 4 ) then ii = inx(m,i) isii = isgn(m,i) call ffdl2s(del2m,piDpj,i,m,ii,isii,j,k,kj,iskj,10) else call ffdl2t(del2m,piDpj,i,m,j,k,kj,iskj,+1,10) endif s(1) = del2m*piDpj(n,l) s(2) = del2n*piDpj(m,l) smax = abs(s(1))*Re(10)**(ier0-ier) del2d2 = s(1) - s(2) if ( abs(del2d2) .ge. xloss*smax ) goto 60 som = del2d2 xmax = smax ier0 = ier call ffdl2t(del2nm,piDpj,i,nm,j,k,kj,iskj,+1,10) s(1) = del2n*piDpj(nm,l) s(2) = del2nm*piDpj(n,l) del2d2 = isnm*(s(1) - s(2)) smax = abs(s(2))*Re(10)**(ier0-ier) if ( abs(del2d2) .ge. xloss*abs(s(1)) ) goto 60 if ( smax .lt. xmax ) then som = del2d2 xmax = smax endif s(1) = del2m*piDpj(nm,l) s(2) = del2nm*piDpj(m,l) del2d2 = isnm*(s(1) - s(2)) smax = abs(s(2))*Re(10)**(ier0-ier) if ( abs(del2d2) .ge. xloss*abs(s(1)) ) goto 60 if ( smax .lt. xmax ) then som = del2d2 xmax = smax endif * One more special case: if ( k .eq. m ) then isii = -1 ik = j ij = k im = m in = n elseif ( j .eq. m ) then isii = +1 ik = k ij = j im = m in = n elseif ( j .eq. n ) then isii = -1 ik = k ij = j im = n in = m elseif ( k .eq. n ) then isii = +1 ik = j ij = k im = n in = m else goto 50 endif if ( ij .eq. im .and. i .le. 4 .and. ij .le. 4 .and. in .le. 4 ) + then if ( inx(ij,i) .gt. 0 .and. inx(im,l) .gt. 0 ) then if ( abs(dpipj(i,inx(ij,i))) .lt. xloss*abs(xpi(ij)) + .and. abs(dpipj(l,inx(im,l))) .lt. xloss*abs(xpi(im)) ) + then s(1) = piDpj(l,in)*piDpj(ik,ij)*dpipj(i,inx(ij,i))/2 s(2) = isgn(ij,i)*piDpj(l,in)*xpi(ij)*piDpj(ik, + inx(ij,i))/2 s(3) = -piDpj(i,ij)*piDpj(ik,in)*piDpj(l,im) s(4) = piDpj(i,ik)*piDpj(im,in)*dpipj(l,inx(im,l))/2 s(5) = isgn(im,l)*piDpj(i,ik)*xpi(im)*piDpj(in, + inx(im,l))/2 del2d2 = s(1) + s(2) + s(3) + s(4) + s(5) if ( isii .lt. 0 ) del2d2 = -del2d2 smax = max(abs(s(1)),abs(s(2)),abs(s(3)),abs(s(4)), + abs(s(5))) if ( abs(del2d2) .ge. xloss**2*abs(smax) ) goto 60 if ( smax .lt. xmax ) then som = del2d2 xmax = smax endif endif endif endif 50 continue * * give up * del2d2 = som 60 continue * #] calculations: *###] ff2dl2: end *###[ ff2d22: subroutine ff2d22(dl2d22,xpi,dpipj,piDpj, i, j,k,kj,iskj, + m,n,nm,isnm) ***#[*comment:*********************************************************** * * * Calculate * * * * / si mu mu nu \2 * * |d d | * * \ sj sk sm sn / * * * * = si.sj^2*sk.sm^2*sn.sn * * - 2*si.sj^2*sk.sm*sk.sn*sm.sn * * + si.sj^2*sk.sn^2*sm.sm * * - 2*si.sj*si.sk*sj.sm*sk.sm*sn.sn * * + 2*si.sj*si.sk*sj.sm*sk.sn*sm.sn * * + 2*si.sj*si.sk*sj.sn*sk.sm*sm.sn * * - 2*si.sj*si.sk*sj.sn*sk.sn*sm.sm * * + si.sk^2*sj.sm^2*sn.sn * * - 2*si.sk^2*sj.sm*sj.sn*sm.sn * * + si.sk^2*sj.sn^2*sm.sm * * * * Input: xpi(ns) as usual * * dpipj(ns,ns) -"- * * piDpj(ns,ns) -"- * * i,j,k,kj,iskj see above * * m,n,nm,isnm -"- * * * * Output: dl2d22 see above * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments: * integer i,j,k,kj,iskj,m,n,nm,isnm RealType dl2d22,xpi(10),dpipj(10,10),piDpj(10,10) * * local variables: * integer ii,isii RealType s(10),del2s,del23,del24,del27,som,smax,xmax * * common blocks: * #include "ff.h" * #] declarations: * #[ special cases: if ( i .eq. n .or. i .eq. m ) then call ffdl2s(del2s,piDpj, j,k,kj,iskj, m,n,nm,isnm, 10) dl2d22 = xpi(i)*del2s**2 return endif * #] special cases: * #[ calculations: * We use the product form if ( i .eq. 3 ) then del23 = 0 elseif ( i .le. 4 ) then ii = inx(3,i) isii = isgn(3,i) call ffdl2s(del23,piDpj,i,3,ii,isii,j,k,kj,iskj,10) else call ffdl2t(del23,piDpj,i,3,j,k,kj,iskj,+1,10) endif if ( i .eq. 4 ) then del24 = 0 elseif ( i .le. 4 ) then ii = inx(n,i) isii = isgn(n,i) call ffdl2s(del24,piDpj,i,4,ii,isii,j,k,kj,iskj,10) else call ffdl2t(del24,piDpj,i,4,j,k,kj,iskj,+1,10) endif s(1) = xpi(4)*del23**2 s(2) = -2*piDpj(3,4)*del23*del24 s(3) = xpi(3)*del24**2 dl2d22 = s(1) + s(2) + s(3) smax = max(abs(s(1)),abs(s(2)),abs(s(3))) if ( abs(dl2d22) .ge. xloss*smax ) goto 110 som = dl2d22 xmax = smax * try the special case k=4 (for use in ee->mumu among others) if ( i .lt. 4 .and. k .eq. 4 .and. abs(s(3)) .lt. xloss*smax + .and. ( abs(dpipj(i,inx(4,i))) .lt. xloss*xpi(i) .or. + abs(piDpj(j,inx(4,i))) .lt. xloss*abs(piDpj(j,4)) ) ) + then s(1) = -del23*piDpj(i,4)*piDpj(j,3)*xpi(4) s(2) = del23*dpipj(i,inx(4,i))*piDpj(j,4)*piDpj(3,4) s(4) = del23*piDpj(3,4)*xpi(4)*piDpj(j,inx(4,i))*isgn(4,i) dl2d22 = s(1) + s(2) + s(3) + s(4) smax = max(abs(s(1)),abs(s(2)),abs(s(3)),abs(s(4))) if ( abs(dl2d22) .ge. xloss*smax ) goto 110 if ( smax .lt. xmax ) then som = dl2d22 xmax = smax endif endif call ffdl2t(del27,piDpj,i,7,j,k,kj,iskj,+1,10) s(1) = xpi(7)*del24**2 s(2) = -2*piDpj(4,7)*del24*del27 s(3) = xpi(4)*del27**2 dl2d22 = s(1) + s(2) + s(3) smax = max(abs(s(1)),abs(s(2)),abs(s(3))) if ( abs(dl2d22) .ge. xloss*smax ) goto 110 if ( smax .lt. xmax ) then som = dl2d22 xmax = smax endif s(1) = xpi(7)*del23**2 s(2) = -2*piDpj(3,7)*del23*del27 s(3) = xpi(3)*del27**2 dl2d22 = s(1) + s(2) + s(3) smax = max(abs(s(1)),abs(s(2)),abs(s(3))) if ( abs(dl2d22) .ge. xloss*smax ) goto 110 * * We'll have to think of something more intelligent ... * if ( smax .lt. xmax ) then som = dl2d22 xmax = smax endif dl2d22 = som 110 continue * #] calculations: *###] ff2d22: end *###[ ff3dl2: subroutine ff3dl2(del3d2,xpi,dpipj,piDpj, i, + j,k,kj,iskj, l,m,ml,isml, n, o,p,po,ispo, ier) ***#[*comment:*********************************************************** * * * Calculate * * * * si mu mu nu mu sn * * d d d = ... * * sj sk sl sm so sp * * * * with p(kj) = iskj*(sk-sj) * * p(ml) = isml*(sm-sl) * * p(po) = ispo*(sp-so) * * * * Input: xpi(ns) as usual * * dpipj(ns,ns) -"- * * piDpj(ns,ns) -"- * * i,j,k,kj,iskj see above * * l,m,ml,isml -"- * * n,o,p,po,ispo -"- * * * * Output: del3d2 see above * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments: * integer i,j,k,kj,iskj,l,m,ml,isml,n,o,p,po,ispo,ier RealType del3d2,xpi(10),dpipj(10,10),piDpj(10,10) * * local variables: * integer isii,ii RealType s(2),dl2il,dl2im,dl2ln,dl2mn,dl2iml,dl2mln RealType d2d2j,d2d2k,d2d2kj,dum,d2d2o,d2d2p,d2d2po RealType som,xmax * * common blocks: * #include "ff.h" * #] declarations: * #[ split up l,m: if ( i .eq. l ) then dl2il = 0 elseif ( i .le. 4 ) then ii = inx(l,i) isii = isgn(l,i) call ffdl2s(dl2il,piDpj,i,l,ii,isii,j,k,kj,iskj,10) else call ffdl2t(dl2il,piDpj,i,l,j,k,kj,iskj,+1,10) endif if ( m .eq. n ) then dl2mn = 0 elseif ( i .le. 4 ) then ii = inx(n,m) isii = isgn(n,m) call ffdl2s(dl2mn,piDpj,m,n,ii,isii,o,p,po,ispo,10) else call ffdl2t(dl2mn,piDpj,m,n,o,p,po,ispo,+1,10) endif s(1) = dl2il*dl2mn if ( i .eq. m ) then dl2im = 0 elseif ( i .le. 4 ) then ii = inx(m,i) isii = isgn(m,i) call ffdl2s(dl2im,piDpj,i,m,ii,isii,j,k,kj,iskj,10) else call ffdl2t(dl2im,piDpj,i,m,j,k,kj,iskj,+1,10) endif if ( l .eq. n ) then dl2ln = 0 elseif ( i .le. 4 ) then ii = inx(n,l) isii = isgn(n,l) call ffdl2s(dl2ln,piDpj,l,n,ii,isii,o,p,po,ispo,10) else call ffdl2t(dl2ln,piDpj,l,n,o,p,po,ispo,+1,10) endif s(2) = dl2im*dl2ln del3d2 = s(1) - s(2) if ( abs(del3d2) .ge. xloss*abs(s(1)) ) return som = del3d2 xmax = abs(s(1)) * * rotate l,m * call ffdl2t(dl2mln,piDpj,ml,n,o,p,po,ispo,+1,10) call ffdl2t(dl2iml,piDpj,i,ml,j,k,kj,iskj,+1,10) s(1) = dl2im*dl2mln s(2) = dl2iml*dl2mn del3d2 = isml*(s(1) - s(2)) if ( abs(del3d2) .ge. xloss*abs(s(1)) ) return if ( abs(s(1)) .lt. xmax ) then som = del3d2 xmax = abs(s(1)) endif s(1) = dl2il*dl2mln s(2) = dl2iml*dl2ln del3d2 = isml*(s(1) - s(2)) if ( abs(del3d2) .ge. xloss*abs(s(1)) ) return if ( abs(s(1)) .lt. xmax ) then som = del3d2 xmax = abs(s(1)) endif * #] split up l,m: * #[ split up j,k: call ff2dl2(d2d2k,dum,xpi,dpipj,piDpj, k, l,m,ml,isml, n, + o,p,po,ispo, 10, ier) call ff2dl2(d2d2j,dum,xpi,dpipj,piDpj, j, l,m,ml,isml, n, + o,p,po,ispo, 10, ier) s(1) = piDpj(i,j)*d2d2k s(2) = piDpj(i,k)*d2d2j del3d2 = s(1) - s(2) if ( abs(del3d2) .ge. xloss*abs(s(1)) ) return if ( abs(s(1)) .lt. xmax ) then som = del3d2 xmax = abs(s(1)) endif call ff2dl2(d2d2kj,dum,xpi,dpipj,piDpj, kj, l,m,ml,isml, n, + o,p,po,ispo, 10, ier) s(1) = piDpj(i,k)*d2d2kj s(2) = piDpj(i,kj)*d2d2k del3d2 = iskj*(s(1) - s(2)) if ( abs(del3d2) .ge. xloss*abs(s(1)) ) return if ( abs(s(1)) .lt. xmax ) then som = del3d2 xmax = abs(s(1)) endif s(1) = piDpj(i,j)*d2d2kj s(2) = piDpj(i,kj)*d2d2j del3d2 = iskj*(s(1) - s(2)) if ( abs(del3d2) .ge. xloss*abs(s(1)) ) return if ( abs(s(1)) .lt. xmax ) then som = del3d2 xmax = abs(s(1)) endif * #] split up j,k: * #[ split up o,p: call ff2dl2(d2d2o,dum,xpi,dpipj,piDpj, i, j,k,kj,iskj, o, + l,m,ml,isml, 10, ier) call ff2dl2(d2d2p,dum,xpi,dpipj,piDpj, i, j,k,kj,iskj, p, + l,m,ml,isml, 10, ier) s(1) = piDpj(p,n)*d2d2o s(2) = piDpj(o,n)*d2d2p del3d2 = s(1) - s(2) if ( abs(del3d2) .ge. xloss*abs(s(1)) ) return if ( abs(s(1)) .lt. xmax ) then som = del3d2 xmax = abs(s(1)) endif call ff2dl2(d2d2po,dum,xpi,dpipj,piDpj, i, j,k,kj,iskj, po, + l,m,ml,isml, 10, ier) s(1) = piDpj(po,n)*d2d2p s(2) = piDpj(p,n)*d2d2po del3d2 = ispo*(s(1) - s(2)) if ( abs(del3d2) .ge. xloss*abs(s(1)) ) return if ( abs(s(1)) .lt. xmax ) then som = del3d2 xmax = abs(s(1)) endif s(1) = piDpj(po,n)*d2d2o s(2) = piDpj(o,n)*d2d2po del3d2 = ispo*(s(1) - s(2)) if ( abs(del3d2) .ge. xloss*abs(s(1)) ) return if ( abs(s(1)) .lt. xmax ) then som = del3d2 xmax = abs(s(1)) endif * #] split up o,p: * #[ give up: del3d2 = som * #] give up: *###] ff3dl2: end LoopTools-2.16/src/util/PaxHeaders/Li2omx.F0000644000000000000000000000007413262230227015503 xustar0030 atime=1648161785.707698331 30 ctime=1648161793.715764879 LoopTools-2.16/src/util/Li2omx.F0000644000000000000000000000107613262230227016422 0ustar00rootroot00000000000000* Li2omx.F * the dilogarithm function of 1 - x * this file is part of LoopTools * last modified 7 Apr 18 th #include "externals.h" #include "types.h" #include "defs.h" ComplexType function XLi2omx(x) implicit none ArgType x ComplexType spence external spence XLi2omx = spence(1, ToComplex(x), 0D0) end ************************************************************************ * adapter code for C++ subroutine XLi2omxsub(res, x) implicit none ComplexType res ArgType x ComplexType spence external spence res = spence(1, ToComplex(x), 0D0) end LoopTools-2.16/src/util/PaxHeaders/ffdcxs.F0000644000000000000000000000007411776502523015617 xustar0030 atime=1648161785.707698331 30 ctime=1648161793.715764879 LoopTools-2.16/src/util/ffdcxs.F0000644000000000000000000004124411776502523016537 0ustar00rootroot00000000000000#include "externals.h" #include "types.h" *--#[ log: * $Id: ffdcxs.f,v 1.7 1996/03/22 08:13:30 gj Exp $ * $Log: ffdcxs.f,v $ c Revision 1.7 1996/03/22 08:13:30 gj c Fixed bug in bugfix of ffdcxs.f c c Revision 1.6 1996/03/14 15:53:13 gj c Fixed bug in ffcb0: cp in C, cma=cmb=0 was computed incorrectly. c c Revision 1.5 1996/03/13 15:43:36 gj c Fixed bug, when ieps unknown already some things were computed and not zero'd. c Now I first check ieps, and then compute. c c Revision 1.4 1995/12/08 10:38:16 gj c Fixed too long line c *--#] log: *###[ ffdcxs: subroutine ffdcxs(cs3,ipi12,y,z,dyz,d2yzz,dy2z,dyzzy,xpi,piDpj, + ii,ns,isoort,ier) ***#[*comment:*********************************************************** * * * calculates the the difference of two S's with y(3,4),z(3,4) and * * y(4)z(3)-y(3)z(4) given. Note the difference with ffdcxs4, in * * which the y's are the same and only the z's different. Here * * both can be different. Also we skip an intermediate level. * * Note also that this routine is much less conservative than * * ffcxs3 in its expectations of the order of the roots: it knows * * that it is (z-,z+,1-z-,1-z+)! * * * * input: y(4,3:4) (real) y,1-y in S with s3,s4 * * z(4,3:4) (real) z,1-z in S with s3,s4 * * dyz(2,2,3:4) (real) y - z * * d2yzz(3:4) (real) 2*y - z+ - z- * * dy2z(4,3:4) (real) y - 2*z * * dyzzy(4) (real) y(i,4)*z(i,4)-y(i,3)*z(i,4) * * xpi(6,3:4) (real) usual * * piDpj(6,3:4) (real) usual * * cs3(40) (complex) assumed zero. * * * * output: cs3(40) (complex) mod factors pi^2/12, in array * * ipi12(6)(integer) these factors * * isoort(6)(integer) returns kind of action taken * * ier (integer) 0=ok 1=inaccurate 2=error * * * * calls: ffcrr,ffcxr,real/dble,ToComplex,log,ffadd1,ffadd2,ffadd3 * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments * ComplexType cs3(100) RealType y(4,3:4),z(4,3:4),dyz(2,2,3:4),d2yzz(3:4), + dy2z(4,3:4),dyzzy(4),xpi(6,3:4),piDpj(6,6,3:4) integer ipi12(10),ii,ns,isoort(10),ier * * local variables * integer i,j,k,l,m,iepsi(4),iepsj(2,2) logical normal RealType yy,zz,yy1,zz1,dyyzz,hulp3,hulp4,x00(3) save iepsi * * common blocks * #include "ff.h" * * data * data iepsi /-2,+2,+2,-2/ * * check constants * #] declarations: * #[ normal case: normal = .FALSE. 10 continue if ( normal .or. isoort(1) .ne. isoort(9) .or. isoort(1) .lt. + 10 ) then call ffcxs3(cs3( 1),ipi12(1),y(1,3),z(1,3),dyz(1,1,3), + d2yzz(3),dy2z(1,3),xpi(1,3),piDpj(1,1,3),ii,6, + isoort(1),ier) call ffcxs3(cs3(81),ipi12(9),y(1,4),z(1,4),dyz(1,1,4), + d2yzz(4),dy2z(1,4),xpi(1,4),piDpj(1,1,4),ii,6, + isoort(9),ier) return endif * #] normal case: * #[ rotate R's: if ( abs(y(2,3)) .lt. 1/xloss ) then do 102 i=1,2 do 101 j=1,2 * iepsi() = /-2,+2,+2,-2/ * BUT I AM NOT YET SURE OF THE SIGNS (29/6/89) k = 2*(i-1)+j if ( y(2*i,3) .gt. 0 ) then iepsj(j,i) = iepsi(k) else iepsj(j,i) = -iepsi(k) endif if ( y(2*i,3) .gt. 0 .neqv. y(2*i,4) .gt. 0 ) then * I have no clue to the ieps, take normal route * iepsj(j,i) = 0 normal = .TRUE. goto 10 endif 101 continue 102 continue * loop over y,z , 1-y,1-z do 120 i=1,2 * loop over z+ , z- do 110 j=1,2 if ( j .eq. 2 ) then * do not calculate if not there (isoort=0, one root) * (this is probably not needed as this case should * have been dealt with in ffdxc0) if ( isoort(9) .eq. 0 ) goto 110 * or if not needed (isoort=2, two equal roots) if ( mod(isoort(9),10) .eq. 2 ) then * we use that l still contains the correct value do 105 m=1,7 cs3(10*(l-1)+m) = 2*Re(cs3(10*(l-1)+m)) 105 continue ipi12(l) = 2*ipi12(l) goto 110 endif endif k = 2*(i-1)+j l = 8*(i-1)+j if ( dyzzy(k) .ne. 0 ) then * minus sign wrong in thesis (2.78) hulp3 = -dyz(2,j,3)/dyzzy(k) hulp4 = +dyz(2,j,4)/dyzzy(k) yy = y(2*i,3)*hulp4 yy1 = y(2*i,4)*hulp3 zz = z(k,3)*hulp4 zz1 = z(k,4)*hulp3 dyyzz = dyz(2,j,3)*hulp4 if ( i .eq. 2 ) then yy = -yy yy1 = -yy1 zz = -zz zz1 = -zz1 endif call ffcxr(cs3(10*l-9),ipi12(l),yy,yy1,zz,zz1,dyyzz, + .FALSE.,0D0,0D0,0D0,.FALSE.,x00,iepsj(j,i),ier) endif 110 continue 120 continue goto 800 endif * #] rotate R's: * #[ other cases (not ready): call ffcxs3(cs3( 1),ipi12(1),y(1,3),z(1,3),dyz(1,1,3), + d2yzz(3),dy2z(1,3),xpi(1,3),piDpj(1,1,3),ii,ns, + isoort(1),ier) call ffcxs3(cs3(81),ipi12(9),y(1,4),z(1,4),dyz(1,1,4), + d2yzz(4),dy2z(1,4),xpi(1,4),piDpj(1,1,4),ii,ns, + isoort(9),ier) return * #] other cases (not ready): 800 continue *###] ffdcxs: end *###[ ffdcs: subroutine ffdcs(cs3,ipi12,cy,cz,cdyz,cd2yzz,cdyzzy,cdyyzz, + cpi,cpiDpj,ii,ns,isoort,ier) ***#[*comment:*********************************************************** * * * calculates the the difference of two S's with cy(3,4),cz(3,4), * * cy(4)cz(3)-cy(3)cz(4) given. Note the difference with ffdcs4, * * in which the cy's are the same and only the cz's different. * * Here both can be different. Also we skip an intermediat * * level. * * * * input: cy(4,3:4) (complex) cy,1-cy in S with s3,s4 * * cz(4,3:4) (complex) cz,1-cz in S with s3,s4 * * cdyz(2,2,3:4)(complex) cy - cz * * cd2yzz(3:4) (complex) 2*cy - cz+ - cz- * * cdyzzy(4) (complex) cy(i,4)*cz(i,4)-cy(i,3)*cz(i,4) * * cdyyzz(2) (complex) cy(i,4)-cz(i,4)-cy(i,3)+cz(i,4) * * cpi(6,3:4) (complex) usual * * cpiDpj(6,3:4)(complex) usual * * cs3(40) (complex) assumed zero. * * * * output: cs3(40) (complex) mod factors pi^2/12, in array * * ipi12(6) (integer) these factors * * isoort(6) (integer) returns kind of action taken * * ier (integer) number of digits lost * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments * ComplexType cs3(100) ComplexType cy(4,3:4),cz(4,3:4),cdyz(2,2,3:4),cd2yzz(3:4), + cdyzzy(4),cdyyzz(2),cpi(6,3:4),cpiDpj(6,6,3:4) integer ipi12(10),ii,ns,isoort(10),ier * * local variables * integer i,j,k,l,m,n,ieps,ni(4,3:4),ntot(3:4), + n1a,nffeta,nffet1,ip ComplexType c,cc,clogy,zfflog, + zfflo1,cmip,yy,zz,yy1,zz1,dyyzz,hulp3,hulp4 RealType absc external nffeta,nffet1,zfflo1,zfflog * * common blocks * #include "ff.h" * * statement function * absc(c) = abs(Re(c)) +abs(Im(c)) * * check constants * #] declarations: * #[ normal case: if ( mod(isoort(1),5).ne.mod(isoort(9),5) .or. isoort(1).gt.-5 + ) then call ffcs3(cs3( 1),ipi12(1),cy(1,3),cz(1,3),cdyz(1,1,3), + cd2yzz(3),cpi(1,3),cpiDpj(1,1,3),ii,6,isoort(1),ier) call ffcs3(cs3(81),ipi12(9),cy(1,4),cz(1,4),cdyz(1,1,4), + cd2yzz(4),cpi(1,4),cpiDpj(1,1,4),ii,6,isoort(9),ier) return endif * #] normal case: * #[ rotate R's: if ( absc(cy(2,3)) .lt. 1/xloss .or. isoort(1) .le. -100 ) then * * loop over cy,cz , 1-cy,1-cz do 190 i=1,2 if ( isoort(1).le.-100 .and. i.eq.2 ) then * * special case del2s=0, a limit has been taken * if ( ii .eq. 2 ) then * * we took the wrong sign for the dilogs... * do 110 j=1,20 cs3(j) = -cs3(j) 110 continue ipi12(1) = -ipi12(1) ipi12(2) = -ipi12(2) endif * * now the remaining logs. take care to get the ieps * correct! * if ( i.eq.1 .eqv. Re(cy(2*i,3)).gt.0 ) then ieps = -3 else ieps = +3 endif call ffclg2(cs3(81),cdyz(2,1,3),cdyz(2,1,4), + cdyyzz(1),ieps,ier) if ( ii .eq. 2 ) then * we have the wrong sign do 120 j=81,83 cs3(j) = -cs3(j) 120 continue ipi12(9) = -ipi12(9) endif if ( mod(isoort(1),5).eq.0 .and. mod(isoort(9),5).eq.0 + ) then do 130 j=81,83 cs3(j) = 2*Re(cs3(j)) 130 continue ipi12(9) = 2*ipi12(9) else print *,'ffdcs: error: not yet tested' call ffclg2(cs3(91),cdyz(2,2,3),cdyz(2,2,4), + cdyyzz(2),-ieps,ier) if ( ii .eq. 2 ) then * we have the wrong sign do 140 j=91,93 cs3(j) = -cs3(j) 140 continue ipi12(10) = -ipi12(10) endif endif goto 190 endif * * loop over cz- , cz+ do 180 j=1,2 if ( j .eq. 2 ) then if ( isoort(9) .eq. 0 .or. isoort(1) .eq. 0 ) then * * (this is not correct as this case should * have been dealt with in ffdxc0,ffdcc0) * call fferr(79,ier) goto 180 elseif ( mod(isoort(9),5) .eq. 0 .and. + mod(isoort(1),5) .eq. 0 ) then * * or if not needed (isoort=-10, two conjugate roots) * * we use that l still contains the correct value do 150 m=1,9 cs3(10*(l-1)+m) = 2*Re(cs3(10*(l-1)+m)) 150 continue ipi12(l) = 2*ipi12(l) goto 180 elseif ( mod(isoort(9),10) .eq. 2 ) then * we use that l still contains the correct value do 160 m=1,9 cs3(10*(l-1)+m) = 2*cs3(10*(l-1)+m) 160 continue ipi12(l) = 2*ipi12(l) goto 180 endif endif k = 2*(i-1)+j l = 8*(i-1)+j if ( cdyzzy(k) .ne. 0 ) then hulp3 = -cdyz(2,j,3)/cdyzzy(k) hulp4 = cdyz(2,j,4)/cdyzzy(k) yy = cy(2*i,3)*hulp4 yy1 = cy(2*i,4)*hulp3 zz = cz(k,3)*hulp4 zz1 = cz(k,4)*hulp3 dyyzz = cdyz(2,j,3)*hulp4 if ( i .eq. 2 ) then yy = -yy yy1 = -yy1 zz = -zz zz1 = -zz1 endif * * ieps = 3 means: dear ffcrr, do not use eta terms, * they are calculated here. The sign gives the sign * of the imag. part of the argument of the dilog, not * y-z. * if ( i.eq.1 .eqv. j.eq.1 .eqv. Re(cy(2*i,3)).gt.0 + ) then ieps = -3 else ieps = +3 endif call ffcrr(cs3(10*l-9),ipi12(l),yy,yy1,zz,zz1,dyyzz, + .FALSE.,czero,czero,czero,isoort(j),ieps,ier) * * eta terms of the R's (eta(.)*log(c1)-eta(.)*log(c2)) * do 170 m=3,4 * no eta terms in the real case if ( Im(cz(k,m)) .eq. 0 .and. + Im(cdyz(2,j,m)) .eq. 0 ) then ni(k,m) = 0 elseif ( i .eq. 1 ) then ni(k,m) = nffeta(-cz(k,m),1/cdyz(2,j,m),ier) else ni(k,m) = nffeta(cz(k,m),1/cdyz(2,j,m),ier) endif 170 continue if ( ni(k,3) .ne. 0 .or. ni(k,4) .ne. 0 ) then if ( ni(k,3) .ne. ni(k,4) ) then do 175 m=3,4 c = cy(2*i,m)/cdyz(2,j,m) if ( i .eq. 2 ) c = -c cc = c-1 if ( absc(cc) .lt. xloss ) then c = cz(k,m)/cdyz(2,j,m) clogy = zfflo1(c,ier) else clogy = zfflog(c,0,czero,ier) endif n = 10*l + (m-3) - 2 if ( m .eq. 3 ) then cs3(n) = + ni(k,m)*c2ipi*clogy else cs3(n) = - ni(k,m)*c2ipi*clogy endif 175 continue else if ( i .eq. 1 ) then n1a = nffeta(cy(k,3)/cdyz(2,j,3), + cdyz(2,j,4)/cy(k,4),ier) else n1a = nffeta(-cy(k,3)/cdyz(2,j,3), + -cdyz(2,j,4)/cy(k,4),ier) endif if ( n1a .ne. 0 ) then call fferr(80,ier) endif c =cy(k,3)*cdyz(2,j,4)/(cdyz(2,j,3)*cy(k,4)) cc = c-1 if ( absc(cc) .lt. xloss ) then c = -cdyzzy(k)/(cdyz(2,j,3)*cy(k,4)) clogy = zfflo1(c,ier) else clogy = zfflog(c,0,czero,ier) endif n = 10*l - 2 if ( i .eq. 1 ) then cs3(n) = +ni(k,3)*c2ipi*clogy else cs3(n) = -ni(k,3)*c2ipi*clogy endif endif endif endif 180 continue 190 continue goto 700 endif * #] rotate R's: * #[ other cases (not ready): call ffcs3(cs3( 1),ipi12(1),cy(1,3),cz(1,3),cdyz(1,1,3), + cd2yzz(3),cpi(1,3),cpiDpj(1,1,3),ii,ns,isoort(1),ier) call ffcs3(cs3(81),ipi12(9),cy(1,4),cz(1,4),cdyz(1,1,4), + cd2yzz(4),cpi(1,4),cpiDpj(1,1,4),ii,ns,isoort(9),ier) return * #] other cases (not ready): * #[ get eta's: 700 continue ip = ii+3 do 740 k=3,4 l = 8*(k-3) + 1 if ( Im(cpi(ip,k)) .eq. 0 ) then * * complex because of a complex root in y or z * if ( (mod(isoort(l),10).eq.-1 .or. mod(isoort(l),10).eq.-3) + .and. isoort(l+1) .ne. 0 ) then * * isoort = -1: y is complex, possibly z as well * isoort = -3: y,z complex, but (y-z-)(y-z+) real * isoort = 0: y is complex, one z root only * isoort = -10: y is real, z is complex * isoort = -5,-6: y,z both real * cmip = ToComplex(0D0,-Re(cpi(ip,k))) if ( Im(cz(1,k)) .eq. 0 ) then ni(1,k) = 0 else ni(1,k) = nffet1(-cz(1,k),-cz(2,k),cmip,ier) i = nffet1(cz(3,k),cz(4,k),cmip,ier) if ( i .ne. ni(1,k) ) call fferr(53,ier) endif ni(2,k) = 0 if ( Re(cd2yzz(k)).eq.0 .and. ( Im(cz(1,k)).eq.0 .and. + Im(cz(2,k)).eq.0 .or. Re(cdyz(2,1,k)).eq.0 .and. + Re(cdyz(2,2,k)) .eq. 0 ) ) then * follow the i*epsilon prescription as (y-z-)(y-z+) real if ( Re(cpi(ip,k)) .lt. 0 ) then ni(3,k) = -1 else ni(3,k) = 0 endif ni(4,k) = -nffet1(cdyz(2,1,k),cdyz(2,2,k),cmip,ier) else if ( Re(cpi(ip,k)) .lt. 0 .and. Im(cdyz(2,1,k)* + cdyz(2,2,k)) .lt. 0 ) then ni(3,k) = -1 else ni(3,k) = 0 endif ni(4,k) = -nffeta(cdyz(2,1,k),cdyz(2,2,k),ier) endif elseif ( (mod(isoort(l),10).eq.-1 .or. mod(isoort(l),10).eq.-3) + .and. isoort(l+1).eq.0 ) then ni(1,k) = 0 if ( Im(cz(1,k)) .ne. 0 ) then ni(2,k) = nffet1(-cpiDpj(ii,ip,k),-cz(1,k),ToComplex(Re(0 + ),Re(-1)),ier) else ni(2,k) = nffet1(-cpiDpj(ii,ip,k),ToComplex(Re(0), + Re(1)),ToComplex(Re(0),Re(-1)),ier) endif ni(3,k) = 0 ni(4,k) = -nffeta(-cpiDpj(ii,ip,k),cdyz(2,1,k),ier) else if ( mod(isoort(l),5).ne.0 .and. mod(isoort(l),5).ne.-1 + .and. mod(isoort(l),5).ne.-3 ) then call fferr(81,ier) print *,'isoort(',l,') = ',isoort(l) endif ni(1,k) = 0 ni(2,k) = 0 ni(3,k) = 0 ni(4,k) = 0 endif else print *,'ffdcs: error: cpi complex should not occur' stop endif 740 continue * #] get eta's: * #[ add eta's: do 750 k=3,4 ntot(k) = ni(1,k)+ni(2,k)+ni(3,k)+ni(4,k) 750 continue do 760 k=3,4 if ( ntot(k) .ne. 0 ) call ffclgy(cs3(20+80*(k-3)), + ipi12(2+8*(k-3)),ni(1,k),cy(1,k),cz(1,k),cd2yzz(k),ier) 760 continue * #] add eta's: *###] ffdcs: end *###[ ffclg2: subroutine ffclg2(cs3,cdyz3,cdyz4,cdyyzz,ieps,ier) ***#[*comment:*********************************************************** * * * Calculate the finite part of the divergent dilogs in case * * del2s=0. These are given by * * * * log^2(-cdyz3)/2 - log^2(-cdyz4)/2 * * * * Note that often we only need the imaginary part, which may be * * very unstable even if the total is not. * * * * * * Input: cy3,cz3,cdyz3 (complex) y,z,diff in C with s3 * * cy4,cz4,cdyz4 (complex) y,z,diff in C with s4 * * cdyyzz (complex) y4 - z4 - y3 + z3 * * isort3,4 (integer) * * * * Output cs3(4) (complex) output * * ipi12 (integer) terms pi^2/12 * * ier (integer) error flag * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments * ComplexType cs3(3),cdyz3,cdyz4,cdyyzz integer ieps,ier * * local variables * integer n1,nffeta,nffet1,ipi3,ipi4 ComplexType c,cc,clog3,clog4,clog1,zfflo1,cipi RealType absc external nffeta,nffet1,zfflo1 * * common blocks * #include "ff.h" * * statement function * absc(c) = abs(Re(c)) + abs(Im(c)) * #] declarations: * #[ calculations: cipi = ToComplex(0D0,pi) if ( Re(cdyz3) .lt. 0 ) then clog3 = log(-cdyz3) ipi3 = 0 else clog3 = log(cdyz3) if ( Im(cdyz3) .gt. 0 ) then ipi3 = -1 elseif ( Im(cdyz3) .lt. 0 ) then ipi3 = +1 else ipi3 = sign(1,-ieps) endif endif if ( Re(cdyz4) .lt. 0 ) then clog4 = log(-cdyz4) ipi4 = 0 else clog4 = log(cdyz4) if ( Im(cdyz4) .gt. 0 ) then ipi4 = -1 elseif ( Im(cdyz4) .lt. 0 ) then ipi4 = +1 else ipi4 = sign(1,-ieps) endif endif cc = clog3-clog4 if ( absc(cc) .ge. xloss*absc(clog3) ) then cs3(1) = -(clog3+ipi3*cipi)**2/2 cs3(2) = +(clog4+ipi4*cipi)**2/2 else c = cdyyzz/cdyz4 clog1 = zfflo1(c,ier) * * notice that zfflog return log(a-ieps) (for compatibility * with the dilog) ^ * if ( Im(cdyz3) .eq. 0 ) then n1 = nffet1(ToComplex(Re(0),Re(-ieps)),-1/cdyz4,-c, + ier) elseif ( Im(cdyz3) .eq. 0 ) then n1 = nffet1(-cdyz3,ToComplex(Re(0),Re(ieps)),-c,ier) else n1 = nffeta(-cdyz3,-1/cdyz4,ier) endif if ( n1 .ne. 0 ) then clog1 = clog1 - n1*c2ipi endif cs3(1) = -clog3*clog1/2 cs3(2) = -clog4*clog1/2 cs3(3) = -(ipi3+ipi4)*cipi*clog1/2 * we could split off a factor 2*pi^2 if needed endif * ATTENTION: now (23-jul-1989) ffdcs assumes that only *3* cs are * set. Change ffdcs as well if this is no longer true! * #] calculations: *###] ffclg2: end LoopTools-2.16/src/util/PaxHeaders/ffcli2.F0000644000000000000000000000007411776502523015507 xustar0030 atime=1648161785.707698331 30 ctime=1648161793.715764879 LoopTools-2.16/src/util/ffcli2.F0000644000000000000000000003325511776502523016432 0ustar00rootroot00000000000000#include "externals.h" #include "types.h" *###[ ffzli2: subroutine ffzli2(zdilog,zlog,cx,ier) ***#[*comment:*********************************************************** * * * Computes the dilogarithm (Li2, Sp) for any (complex) cx * * to a precision precc. It assumes that cx is already in the * * area |cx|<=1, Re(cx)<=1/2. As it is available it also returns * * log(1-cx) = zlog. * * * * Input: cx (complex) * * * * Output: zdilog (complex) Li2(cx) * * zlog (complex) log(1-cx) = -Li1(cx) * * ier (integer) 0=OK,1=num,2=err * * * * Calls: log,zfflo1,(d/a)imag,real/dble * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments * integer ier ComplexType cx,zlog,zdilog * * local variables * RealType xprec,bdn02,bdn05,bdn10,bdn15, + xi,xr,xdilog,xlog,absc,xa,a,ffbnd ComplexType cc,cz,cz2,zfflo1 external ffbnd,zfflo1 save xprec,bdn02,bdn05,bdn10,bdn15 * * common blocks * #include "ff.h" * * statement function * absc(cc) = abs(Re(cc)) + abs(Im(cc)) * #] declarations: * #[ initialisations: data xprec /-1D0/ if ( xprec .ne. precc ) then xprec = precc bdn02 = ffbnd(1,2,bf) bdn05 = ffbnd(1,5,bf) bdn10 = ffbnd(1,10,bf) bdn15 = ffbnd(1,15,bf) * we don't have bf(21) ... endif * #] initialisations: * #[ exceptional cases: xi = Im(cx) xr = Re(cx) if ( xi .eq. 0) then call ffxli2(xdilog,xlog,xr,ier) zdilog = xdilog zlog = xlog return endif xa = abs(xi) + abs(xr) if ( xa .lt. precc ) then zdilog = cx zlog = -cx return endif * #] exceptional cases: * #[ get log,dilog: if ( xa .lt. xloss**2 ) then zlog = zfflo1(cx,ier) else zlog = log(1-cx) endif cz = -zlog if ( absc(cz) .lt. xclog2 ) then zdilog = cz else cz2 = cz*cz a = xa**2 if ( a .gt. bdn15 ) then zdilog = cz2*(Re(bf(16)) + cz2*(Re(bf(17)) + + cz2*(Re(bf(18)) + cz2*(Re(bf(19)) + + cz2*(Re(bf(20))))))) else zdilog = 0 endif if ( a .gt. bdn10 ) then zdilog = cz2*(Re(bf(11)) + cz2*(Re(bf(12)) + + cz2*(Re(bf(13)) + cz2*(Re(bf(14)) + + cz2*(Re(bf(15)) + zdilog))))) endif if ( a .gt. bdn05 ) then zdilog = cz2*(Re(bf(6)) + cz2*(Re(bf(7)) + + cz2*(Re(bf(8)) + cz2*(Re(bf(9)) + + cz2*(Re(bf(10)) + zdilog))))) endif if ( a .gt. bdn02 ) then zdilog = cz2*(Re(bf(3)) + cz2*(Re(bf(4)) + + cz2*(Re(bf(5)) + zdilog))) endif * watch the powers of z. zdilog = cz + cz2*(Re(bf(1)) + cz*(Re(bf(2)) + zdilog)) endif * #] get log,dilog: *###] ffzli2: end *###[ ffzzdl: subroutine ffzzdl(zdilog,ipi12,zlog,cx,ier) ***#[*comment:*************************************************** * * * Computes the dilogarithm (Li2, Sp) for any (complex) cx * * to about 15 significant figures. This can be improved * * by adding more of the bf's. For real cx > 1 an error is * * generated as the imaginary part is undefined then. * * For use in ffcdbd zlog = log(1-cx) is also calculated * * * * Input: cx (complex) * * * * Output: zdilog (complex) Li2(cx) mod factors pi^2/12 * * ipi12 (integer) these factors * * zlog (complex) log(1-cx) * * * * Calls: log,zfflo1,(d/a)imag,real/dble * * * ***#]*comment:*************************************************** * #[ declarations: implicit none * * arguments * integer ipi12,ier ComplexType zdilog,zlog,cx * * local variables * integer jsgn RealType xprec,bdn02,bdn05,bdn10,bdn15, + xi,xr,s1,s2,xa,a,absc,ffbnd ComplexType cfact,cx1,cy,cz,cz2,zfflo1,c external ffbnd,zfflo1 save xprec,bdn02,bdn05,bdn10,bdn15 * * common blocks * #include "ff.h" * * statement function * absc(c) = abs(Re(c)) + abs(Im(c)) * #] declarations: * #[ initialisations: data xprec /-1D0/ if ( xprec .ne. precc ) then xprec = precc bdn02 = ffbnd(1,2,bf) bdn05 = ffbnd(1,5,bf) bdn10 = ffbnd(1,10,bf) bdn15 = ffbnd(1,15,bf) endif * #] initialisations: * #[ exceptional cases: xi = Im(cx) xr = Re(cx) if ( xi .eq. 0 ) then if ( xr .gt. 1 ) call fferr(31,ier) call ffzxdl(zdilog,ipi12,zlog,xr,1,ier) return endif if ( abs(xi) .lt. xalog2 ) then s1 = 0 else s1 = xi**2 endif if ( abs(xr) .lt. xalog2 ) then s2 = 0 else s2 = xr**2 endif xa = sqrt(s1 + s2) if ( xa .lt. precc ) then zdilog = cx zlog = -cx ipi12 = 0 return endif * #] exceptional cases: * #[ transform to |x|<1, Re(x) < 0.5: if ( xr .le. .5D0) then if (xa .gt. 1) then if ( 1/xa .lt. xalogm ) then cfact = 0 elseif ( 1/xa .lt. xclogm ) then cx1 = cx*Re(1/xa) cfact = log(-cx1) + log(Re(xa)) else cfact = log(-cx) endif cy = - cfact**2/2 ipi12 = -2 if ( xa*xloss**2 .gt. 1) then if ( 1/xa .lt. xclogm ) then cx1 = cx*Re(1/xa) cx1 = 1/cx1 cx1 = cx1*Re(1/xa) else cx1 = 1/cx endif cz = -zfflo1(cx1,ier) else cz = -log(1-1/cx) endif zlog = log(1-cx) jsgn = -1 else cy = 0 ipi12 = 0 if ( xa .lt. xloss**2 ) then zlog = zfflo1(cx,ier) else zlog = log(1-cx) endif cz = -zlog jsgn = 1 endif else if (xa .le. sqrt(2*xr)) then cz = -log(cx) if ( abs(xr-1) + abs(xi) .lt. xclogm ) then cy = 0 else zlog = log(1-cx) cy = cz*zlog endif ipi12 = 2 jsgn = -1 else if ( 1/xa .lt. xalogm ) then cfact = 0 elseif ( 1/xa .lt. xclogm ) then cx1 = cx*Re(1/xa) cfact = log(-cx1) + log(Re(xa)) else cfact = log(-cx) endif cy = - cfact**2/2 ipi12 = -2 if ( xa*xloss .gt. 1) then if ( 1/xa .lt. xclogm ) then cx1 = cx*Re(1/xa) cx1 = 1/cx1 cx1 = cx1*Re(1/xa) else cx1 = 1/cx endif cz = -zfflo1(cx1,ier) else cz = -log(1-1/cx) endif zlog = log(1-cx) jsgn = -1 endif endif * #] transform to |x|<1, Re(x) < 0.5: * #[ get dilog: if ( absc(cz) .lt. xclogm ) then zdilog = cz else cz2 = cz*cz a = Re(cz)**2 + Im(cz)**2 if ( a .gt. bdn15 ) then zdilog = cz2*(Re(bf(16)) + cz2*(Re(bf(17)) + + cz2*(Re(bf(18)) + cz2*(Re(bf(19)) + + cz2*(Re(bf(20))))))) else zdilog = 0 endif if ( a .gt. bdn10 ) then zdilog = cz2*(Re(bf(11)) + cz2*(Re(bf(12)) + + cz2*(Re(bf(13)) + cz2*(Re(bf(14)) + + cz2*(Re(bf(15)) + zdilog))))) endif if ( a .gt. bdn05 ) then zdilog = cz2*(Re(bf(6)) + cz2*(Re(bf(7)) + + cz2*(Re(bf(8)) + cz2*(Re(bf(9)) + + cz2*(Re(bf(10)) + zdilog))))) endif if ( a .gt. bdn02 ) then zdilog = cz2*(Re(bf(3)) + cz2*(Re(bf(4)) + + cz2*(Re(bf(5)) + zdilog))) endif * watch the powers of z. zdilog = cz + cz2*(Re(bf(1)) + cz*(Re(bf(2)) + zdilog)) endif if(jsgn.eq.1)then zdilog = zdilog + cy else zdilog = -zdilog + cy endif * #] get dilog: *###] ffzzdl: end *###[ zfflog: ComplexType function zfflog(cx,ieps,cy,ier) ***#[*comment:*********************************************************** * * * Calculate the complex logarithm of cx. The following cases * * are treted separately: * * |cx| too small: give warning and return 0 * * (for Absoft, Apollo DN300) * * Im(cx) = 0, Re(cx) < 0: take sign according to ieps * * * ***#]*comment:*********************************************************** * #[ declarations: * * arguments * implicit none integer ieps,ier ComplexType cx,cy * * local variables * ComplexType c,ctroep RealType absc,xa,xlog1p * * common blocks, statement function * #include "ff.h" absc(c) = abs(Re(c)) + abs(Im(c)) * #] declarations: * #[ calculations: xa = absc(cx) if ( xa .lt. xalogm ) then if ( cx .ne. 0 ) call fferr(23,ier) zfflog = 0 elseif ( Re(cx) .lt. 0 .and. Im(cx) .eq. 0 ) then * + abs(Im(cx)) .lt. precc*abs(Re(cx)) ) then xlog1p = log(-Re(cx)) * checked imaginary parts 19-May-1988 if ( abs(ieps) .eq. 1 ) then if ( ieps*Re(cy) .lt. 0 ) then zfflog = ToComplex(xlog1p,-pi) elseif ( ieps*Re(cy) .gt. 0 ) then zfflog = ToComplex(xlog1p,pi) else call fferr(51,ier) zfflog = ToComplex(xlog1p,pi) endif elseif ( ieps .ge. 2 .and. ieps .le. 3 ) then zfflog = ToComplex(xlog1p,-pi) elseif ( ieps .le. -2 .and. ieps .ge. -3 ) then zfflog = ToComplex(xlog1p,pi) else call fferr(51,ier) zfflog = ToComplex(xlog1p,pi) endif elseif ( xa .lt. xclogm .or. 1/xa .lt. xclogm ) then ctroep = cx*Re(1/xa) zfflog = log(ctroep) + Re(log(xa)) else * print *,'zfflog: neem log van ',cx zfflog = log(cx) endif * #] calculations: *###] zfflog: end *###[ zfflo1: ComplexType function zfflo1(cx,ier) ***#[*comment:*************************************************** * calculates log(1-x) for |x|<.14 in a faster way to ~15 * * significant figures. * ***#]*comment:*************************************************** * #[ declarations: implicit none integer ier ComplexType cx,c,zfflog RealType xprec,bdn01,bdn05,bdn10,bdn15,bdn19, + absc,xa,ffbnd external zfflog,ffbnd save xprec,bdn01,bdn05,bdn10,bdn15,bdn19 #include "ff.h" absc(c) = abs(Re(c)) + abs(Im(c)) * #] declarations: * #[ initialisations: data xprec /-1D0/ if ( precc .ne. xprec ) then xprec = precc * determine the boundaries for 1,5,10,15 terms bdn01 = ffbnd(1,1,xninv) bdn05 = ffbnd(1,5,xninv) bdn10 = ffbnd(1,10,xninv) bdn15 = ffbnd(1,15,xninv) bdn19 = ffbnd(1,19,xninv) endif * #] initialisations: * #[ calculations: xa = absc(cx) if ( xa .gt. bdn19 ) then c = cx-1 xa = absc(c) zfflo1 = zfflog(1-cx,0,czero,ier) return endif if ( xa .gt. bdn15 ) then zfflo1 = cx*( Re(xninv(16)) + cx*( Re(xninv(17)) + + cx*( Re(xninv(18)) + cx*( Re(xninv(19)) + + cx*( Re(xninv(20)) ))))) else zfflo1 = 0 endif if ( xa .gt. bdn10 ) then zfflo1 = cx*( Re(xninv(11)) + cx*( Re(xninv(12)) + + cx*( Re(xninv(13)) + cx*( Re(xninv(14)) + + cx*( Re(xninv(15)) + zfflo1 ))))) endif if ( xa .gt. bdn05 ) then zfflo1 = cx*( Re(xninv(6)) + cx*( Re(xninv(7)) + + cx*( Re(xninv(8)) + cx*( Re(xninv(9)) + + cx*( Re(xninv(10)) + zfflo1 ))))) endif if ( xa .gt. bdn01 ) then zfflo1 = cx*( Re(xninv(2)) + cx*( Re(xninv(3)) + + cx*( Re(xninv(4)) + cx*( Re(xninv(5)) + + zfflo1 )))) endif zfflo1 = - cx*( Re(xninv(1)) + zfflo1 ) * #] calculations: *###] zfflo1: end *###[ zfflo2: ComplexType function zfflo2(x,ier) ***#[*comment:*************************************************** * calculates log(1-x)+x for |x|<.14 in a faster way to * * ~15 significant figures. * ***#]*comment:*************************************************** * #[ declarations: implicit none integer ier ComplexType x,zfflo1,cc RealType bdn01,bdn05,bdn10,bdn15,bdn18,xprec,xa, + ffbnd,absc external ffbnd,zfflo1 save xprec,bdn01,bdn05,bdn10,bdn15,bdn18 #include "ff.h" absc(cc) = abs(Re(cc)) + abs(Im(cc)) * #] declarations: * #[ initialisation: data xprec /-1D0/ if ( xprec .ne. precc ) then xprec = precx precx = precc * determine the boundaries for 1,5,10,15 terms bdn01 = ffbnd(1,1,xninv(2)) bdn05 = ffbnd(1,5,xninv(2)) bdn10 = ffbnd(1,10,xninv(2)) bdn15 = ffbnd(1,15,xninv(2)) bdn18 = ffbnd(1,18,xninv(2)) precx = xprec xprec = precc endif * #] initialisation: * #[ calculations: xa = absc(x) if ( xa .gt. bdn18 ) then zfflo2 = zfflo1(x,ier) + x return endif if ( xa .gt. bdn15 ) then zfflo2 = x*( Re(xninv(17)) + x*( Re(xninv(18)) + + x*( Re(xninv(19)) + x*( Re(xninv(20)) )))) else zfflo2 = 0 endif if ( xa .gt. bdn10 ) then zfflo2 = x*( Re(xninv(12)) + x*( Re(xninv(13)) + + x*( Re(xninv(14)) + x*( Re(xninv(15)) + + x*( Re(xninv(16)) + zfflo2 ))))) endif if ( xa .gt. bdn05 ) then zfflo2 = x*( Re(xninv(7)) + x*( Re(xninv(8)) + + x*( Re(xninv(9)) +x*( Re(xninv(10)) + + x*( Re(xninv(11)) + zfflo2 ))))) endif if ( xa .gt. bdn01 ) then zfflo2 = x*( Re(xninv(3)) + x*( Re(xninv(4)) + + x*( Re(xninv(5)) + x*( Re(xninv(6)) + zfflo2 )))) endif zfflo2 = - x**2*( Re(xninv(2)) + zfflo2 ) * #] calculations: *###] zfflo2: end *###[ zfflo3: ComplexType function zfflo3(x,ier) ***#[*comment:*************************************************** * calculates log(1-x)+x+x^2/2 for |x|<.14 in a faster * * way to ~15 significant figures. * ***#]*comment:*************************************************** * #[ declarations: implicit none integer ier ComplexType x,zfflo2,cc RealType bdn01,bdn05,bdn10,bdn15,xprec,xa,ffbnd, + absc external zfflo2,ffbnd save xprec,bdn01,bdn05,bdn10,bdn15 #include "ff.h" absc(cc) = abs(Re(cc)) + abs(Im(cc)) * #] declarations: * #[ initialisation: data xprec /-1D0/ if ( xprec .ne. precx ) then xprec = precx precx = precc * determine the boundaries for 1,5,10,15 terms bdn01 = ffbnd(1,1,xninv(3)) bdn05 = ffbnd(1,5,xninv(3)) bdn10 = ffbnd(1,10,xninv(3)) bdn15 = ffbnd(1,15,xninv(3)) precx = xprec xprec = precc endif * #] initialisation: * #[ calculations: xa = absc(x) if ( xa .gt. bdn15 ) then zfflo3 = zfflo2(x,ier) + x**2/2 return endif if ( xa .gt. bdn10 ) then zfflo3 = x*( Re(xninv(13)) + x*( Re(xninv(14)) + + x*( Re(xninv(15)) + x*( Re(xninv(16)) + + x*( Re(xninv(17)) ))))) else zfflo3 = 0 endif if ( xa .gt. bdn05 ) then zfflo3 = x*( Re(xninv(8)) + x*( Re(xninv(9)) + + x*( Re(xninv(10)) + x*( Re(xninv(11)) + + x*( Re(xninv(12)) + zfflo3 ))))) endif if ( xa .gt. bdn01 ) then zfflo3 = x*( Re(xninv(4)) + x*( Re(xninv(5)) + + x*( Re(xninv(6)) + x*( Re(xninv(7)) + zfflo3 )))) endif zfflo3 = - x**3*( Re(xninv(3)) + zfflo3 ) * #] calculations: *###] zfflo3: end LoopTools-2.16/src/util/PaxHeaders/ffcxs3.F0000644000000000000000000000013213576640511015531 xustar0030 mtime=1576747337.810442241 30 atime=1648161785.707698331 30 ctime=1648161793.715764879 LoopTools-2.16/src/util/ffcxs3.F0000644000000000000000000004212413576640511016454 0ustar00rootroot00000000000000#include "externals.h" #include "types.h" *###[ ffcxs3: subroutine ffcxs3(cs3,ipi12,y,z,dyz,d2yzz,dy2z,xpi,piDpj,ii,ns, + isoort,ier) ***#[*comment:*********************************************************** * * * calculates the s3 as defined in appendix b. * * (ip = ii+3, is1 = ii, is2 = ii+1) * * * * log( xk*y^2 + (-xk+xm1-xm2)*y + xm2 - i*eps ) * * /1 - log( ... ) |y=yi * * s3 = \ dy -------------------------------------------------- * * /0 y - yi * * * * = r(yi,y-,+) + r(yi,y+,-) * * * * with y+- the roots of the argument of the logarithm. * * the sign of the argument to the logarithms in r is passed * * in ieps * * * * input: y(4),z(4) (real) roots in form (z-,z+,1-z-,1-z+) * * dyz(2,2),d2yzz, (real) y() - z(), y+ - z- - z+ * * dy2z(4) (real) y() - 2z() * * xpi (real(ns)) p(i).p(i) (B&D metric) i=1,3 * * m(i)^2 = si.si i=4,6 * * ii (integer) xk = xpi(ii+3) etc * * ns (integer) size of arrays * * isoort (integer) returns kind of action taken * * cs3 (complex)(20) assumed zero. * * ccy (complex)(3) if i0 != 0: complex y * * * * output: cs3 (complex) mod factors pi^2/12, in array * * ipi12 (integer) these factors * * ier (integer) 0=ok 1=inaccurate 2=error * * * * calls: ffcrr,ffcxr,real/dble,ToComplex,log,ffadd1,ffadd2,ffadd3 * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments: * integer ipi12(2),ii,ns,isoort(2),ier ComplexType cs3(20) RealType y(4),z(4),dyz(2,2),d2yzz,dy2z(4), + xpi(ns),piDpj(ns,ns) * * local variables: * integer i,ip,ieps(2) RealType yy,yy1,zz,zz1,dyyzz,xdilog,xlog,x00(3) logical ld2yzz * * common blocks * #include "ff.h" * * #] declarations: * #[ get counters: ip = ii+3 if ( isoort(2) .ne. 0 ) then if ( (z(2).gt.z(1) .or. z(1).eq.z(2) .and. z(4).lt.z(3) ) + .eqv. xpi(ip) .gt. 0 ) then ieps(1) = +1 ieps(2) = -1 else ieps(1) = -1 ieps(2) = +1 endif else if ( piDpj(ip,ii) .gt. 0 ) then ieps(1) = +1 else ieps(1) = -1 endif endif * #] get counters: * #[ special case |z| >> |y|: if ( xpi(ip).lt.0 .and. max(abs(y(2)),abs(y(4))) .lt. + xloss*min(abs(z(1)), abs(z(2)))/2 ) then * * we will obtain cancellations of the type Li_2(x) + Li_2(-x) * with x small. * yy = dyz(2,1)/d2yzz yy1 = dyz(2,2)/d2yzz if ( y(2) .eq. 0 ) goto 10 zz = z(2)*yy/y(2) zz1 = 1-zz dyyzz = dyz(2,2)*yy/y(2) call ffcxr(cs3(1),ipi12(1),yy,yy1,zz,zz1,dyyzz,.FALSE., + 0D0,0D0,0D0,.FALSE.,x00,0,ier) 10 continue if ( y(4) .eq. 0 ) goto 30 zz = yy*z(4)/y(4) zz1 = 1-zz dyyzz = -yy*dyz(2,2)/y(4) call ffcxr(cs3(8),ipi12(2),yy,yy1,zz,zz1,dyyzz,.FALSE., + 0D0,0D0,0D0,.FALSE.,x00,0,ier) do 20 i=8,14 cs3(i) = -cs3(i) 20 continue 30 continue * And now the remaining Li_2(x^2) terms call ffxli2(xdilog,xlog,(y(2)/dyz(2,1))**2,ier) cs3(15) = +xdilog/2 call ffxli2(xdilog,xlog,(y(4)/dyz(2,1))**2,ier) cs3(16) = -xdilog/2 goto 900 endif * #] special case |z| >> |y|: * #[ normal: if ( xpi(ip) .eq. 0 ) then ld2yzz = .FALSE. else ld2yzz = .TRUE. endif if ( isoort(1) .ne. 0 ) call ffcxr(cs3(1),ipi12(1),y(2),y(4), + z(1),z(3),dyz(2,1),ld2yzz,d2yzz,z(2),z(4),.TRUE.,dy2z(1), + ieps(1),ier) if ( isoort(2) .ne. 0 ) then if ( mod(isoort(2),10) .eq. 2 ) then * both roots are equal: multiply by 2 do 60 i=1,7 cs3(i) = 2*Re(cs3(i)) 60 continue ipi12(1) = 2*ipi12(1) else call ffcxr(cs3(8),ipi12(2),y(2),y(4),z(2),z(4),dyz(2,2), + ld2yzz,d2yzz,z(1),z(3),.TRUE.,dy2z(2),ieps(2),ier) endif endif * * #] normal: 900 continue *###] ffcxs3: end *###[ ffcs3: subroutine ffcs3(cs3,ipi12,cy,cz,cdyz,cd2yzz,cpi,cpiDpj,ii,ns, + isoort,ier) ***#[*comment:*********************************************************** * * * calculates the s3 as defined in appendix b. * * * * log( cpi(ii+3)*y^2 + (cpi(ii+3)+cpi(ii)-cpi(ii+1))*y * * /1 + cpi(ii+1)) - log( ... ) |y=cyi * * s3 = \ dy ---------------------------------------------------- * * /0 y - cyi * * * * = r(cyi,cy+) + r(cyi,cy-) + ( eta(-cy-,-cy+) - * * eta(1-cy-,1-cy+) - eta(...) )*log(1-1/cyi) * * * * with y+- the roots of the argument of the logarithm. * * * * input: cy(4) (complex) cy(1)=y^-,cy(2)=y^+,cy(i+2)=1-cy(1) * * cz(4) (complex) cz(1)=z^-,cz(2)=z^+,cz(i+2)=1-cz(1) * * cpi(6) (complex) masses & momenta (B&D) * * ii (integer) position of cp,cma,cmb in cpi * * ns (integer) size of arrays * * isoort(2)(integer) returns the kind of action taken * * cs3 (complex)(14) assumed zero. * * * * output: cs3 (complex) mod factors ipi12 * * ipi12(2) (integer) these factors * * ier (integer) 0=ok, 1=numerical problems, 2=error * * * * calls: ffcrr,Im,Re,zfflog * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments: * integer ipi12(2),ii,ns,isoort(2),ier ComplexType cs3(20),cpi(ns),cpiDpj(ns,ns) ComplexType cy(4),cz(4),cdyz(2,2),cd2yzz * * local variables: * integer i,ip,ieps(2),ieps0,ni(4),ntot logical ld2yzz ComplexType c,zdilog,zlog,cyy,cyy1,czz,czz1,cdyyzz RealType absc,y,y1,z,z1,dyz,d2yzz,zz,zz1, + x00(3),sprec * * common blocks * #include "ff.h" * * statement function * absc(c) = abs(Re(c)) + abs(Im(c)) * #] declarations: * #[ get ieps: ip = ii+3 call ffieps(ieps,cz(1),cpi(ip),cpiDpj(ip,ii),isoort) * #] get ieps: * #[ special case |cz| >> |cy|: if ( isoort(2) .ne. 0 .and. max(absc(cy(2)),absc(cy(4))) .lt. + xloss*min(absc(cz(1)),absc(cz(2)))/2 ) then * * we will obtain cancellations of the type Li_2(x) + Li_2(-x) * with x small. * cyy = cdyz(2,1)/cd2yzz cyy1 = cdyz(2,2)/cd2yzz if ( absc(cy(2)) .lt. xclogm ) then if ( Im(cy(2)) .eq. 0 .and. abs(Re(cy(2))) .gt. + xalogm ) then czz = cz(2)*cyy*ToComplex(1/Re(cy(2))) cdyyzz = cyy*cdyz(2,2)*ToComplex(1/Re(cy(2))) elseif ( cy(2) .eq. 0 .and. cz(2) .ne. 0 .and. cyy + .ne. 0 ) then * the answer IS zero goto 30 endif else czz = cz(2)*cyy/cy(2) cdyyzz = cyy*cdyz(2,2)/cy(2) endif czz1 = 1-czz if ( isoort(1) .eq. -10 ) then * no eta terms. ieps0 = 99 else * do not know the im part ieps0 = 0 endif call ffcrr(cs3(1),ipi12(1),cyy,cyy1,czz,czz1,cdyyzz,.FALSE., + czero,czero,czero,-1,ieps0,ier) 30 continue if ( absc(cy(4)) .lt. xclogm ) then if ( Im(cy(4)) .eq. 0 .and. abs(Re(cy(4))) .gt. + xalogm ) then czz = cz(4)*cyy*ToComplex(1/Re(cy(4))) cdyyzz = -cyy*cdyz(2,2)*ToComplex(1/Re(cy(4))) elseif ( cy(4) .eq. 0 .and. cz(4) .ne. 0 .and. cyy + .ne. 0 ) then * the answer IS zero goto 50 endif else czz = cz(4)*cyy/cy(4) cdyyzz = -cyy*cdyz(2,2)/cy(4) endif czz1 = 1-czz call ffcrr(cs3(8),ipi12(2),cyy,cyy1,czz,czz1,cdyyzz,.FALSE., + czero,czero,czero,-1,ieps0,ier) do 40 i=8,14 cs3(i) = -cs3(i) 40 continue 50 continue * * And now the remaining Li_2(x^2) terms * stupid Gould NP1 * c = cy(2)*cy(2)/(cdyz(2,1)*cdyz(2,1)) call ffzli2(zdilog,zlog,c,ier) cs3(15) = +zdilog/2 * stupid Gould NP1 c = cy(4)*cy(4)/(cdyz(2,1)*cdyz(2,1)) call ffzli2(zdilog,zlog,c,ier) cs3(16) = -zdilog/2 goto 900 endif * #] special case |cz| >> |cy|: * #[ normal: if ( isoort(2) .eq. 0 ) then ld2yzz = .FALSE. else ld2yzz = .TRUE. endif if ( isoort(1) .eq. 0 ) then * do nothing elseif ( mod(isoort(1),10).eq.0 .or. mod(isoort(1),10).eq.-1 + .or. mod(isoort(1),10).eq.-3 ) then call ffcrr(cs3(1),ipi12(1),cy(2),cy(4),cz(1),cz(3), + cdyz(2,1),ld2yzz,cd2yzz,cz(2),cz(4),isoort(1), + ieps(1),ier) elseif ( mod(isoort(1),10) .eq. -5 .or. mod(isoort(1),10) .eq. + -6 ) then y = Re(cy(2)) y1 = Re(cy(4)) z = Re(cz(1)) z1 = Re(cz(3)) dyz = Re(cdyz(2,1)) d2yzz = Re(cd2yzz) zz = Re(cz(2)) zz1 = Re(cz(4)) sprec = precx precx = precc call ffcxr(cs3(1),ipi12(1),y,y1,z,z1,dyz,ld2yzz,d2yzz,zz,zz1 + ,.FALSE.,x00,ieps(1),ier) precx = sprec else call fferr(12,ier) endif if ( isoort(2) .eq. 0 ) then * do nothing elseif ( mod(isoort(2),5) .eq. 0 ) then do i=1,7 cs3(i) = 2*Re(cs3(i)) enddo ipi12(1) = 2*ipi12(1) elseif ( mod(isoort(2),10).eq.-1 .or. mod(isoort(1),10).eq.-3 ) + then call ffcrr(cs3(8),ipi12(2),cy(2),cy(4),cz(2),cz(4), + cdyz(2,2),ld2yzz,cd2yzz,cz(1),cz(3),isoort(2), + ieps(2),ier) elseif ( mod(isoort(2),10) .eq. -6 ) then y = Re(cy(2)) y1 = Re(cy(4)) z = Re(cz(2)) z1 = Re(cz(4)) dyz = Re(cdyz(2,2)) d2yzz = Re(cd2yzz) zz = Re(cz(1)) zz1 = Re(cz(3)) sprec = precx precx = precc call ffcxr(cs3(8),ipi12(2),y,y1,z,z1,dyz,ld2yzz,d2yzz,zz,zz1 + ,.FALSE.,x00,ieps(2),ier) precx = sprec else call fferr(13,ier) endif * #] normal: * #[ eta's: if ( mod(isoort(1),10).eq.-5 .or. mod(isoort(1),10).eq.-6 ) + then if ( mod(isoort(2),10).ne.-5 .and. mod(isoort(1),10).ne.-6 + ) then print *,'ffcxs3: error: I assumed both would be real!' ier = ier + 50 endif * we called ffcxr - no eta's elseif ( Im(cpi(ip)).eq.0 ) then call ffgeta(ni,cz(1),cdyz(1,1), + cpi(ip),cpiDpj(ii,ip),ieps,isoort,ier) ntot = ni(1) + ni(2) + ni(3) + ni(4) if ( ntot .ne. 0 ) call ffclgy(cs3(15),ipi12(2),ntot, + cy(1),cz(1),cd2yzz,ier) else * * cpi(ip) is really complex (occurs in transformed * 4pointfunction) * print *,'THIS PART IS NOT READY ', + 'and should not be reached' c stop endif * #] eta's: 900 continue *###] ffcs3: end *###[ ffclgy: subroutine ffclgy(cs3,ipi12,ntot,cy,cz,cd2yzz,ier) ***#[*comment:*********************************************************** * * * calculates the the difference of two S's with cy(3,4),cz(3,4), * * cy(4)cz(3)-cy(3)cz(4) given. Note the difference with ffdcs4, * * in which the cy's are the same and only the cz's different. * * Here both can be different. Also we skip an intermediat * * level. * * * * input: cy(4) (complex) cy,1-cy in S with s3,s4 * * cz(4) (complex) cz,1-cz in S with s3,s4 * * cdyz(2,2) (complex) cy - cz * * cd2yzz (complex) 2*cy - cz+ - cz- * * cdyzzy(4) (complex) cy(i,4)*cz(i,4)-cy(i,3)*cz(i,4) * * cpiDpj(6,6) (complex) usual * * cs3 (complex) assumed zero. * * * * output: cs3 (complex) mod factors pi^2/12, in array * * ipi12 (integer) these factors * * isoort (integer) returns kind of action taken * * ier (integer) number of digits lost * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments * ComplexType cs3 ComplexType cy(4),cz(4),cd2yzz integer ipi12,ntot,ier * * local variables * integer ipi ComplexType c,cc,clogy,c2y1,zfflog,zfflo1,csum RealType absc external zfflog,zfflo1 * * common blocks * #include "ff.h" * * statement function * absc(c) = abs(Re(c)) + abs(Im(c)) * #] declarations: * #[ calculations: ipi = 0 if ( 1 .lt. xloss*absc(cy(2)) ) then clogy = zfflo1(1/cy(2),ier) else if ( absc(cy(2)) .lt. xclogm .or. absc(cy(4)) .lt. xclogm ) + then if ( ntot .ne. 0 ) call fferr(15,ier) clogy = 0 else c = -cy(4)/cy(2) if ( Re(c) .gt. -abs(Im(c)) ) then clogy = zfflog(c,0,czero,ier) else * take out the factor 2*pi^2 cc = c+1 if ( absc(cc) .lt. xloss ) then c2y1 = -cd2yzz - cz(1) + cz(4) if ( absc(c2y1) .lt. xloss*max(absc(cz(1)), + absc(cz(4))) ) then c2y1 = -cd2yzz - cz(2) + cz(3) endif csum = -c2y1/cy(2) clogy = zfflo1(csum,ier) else csum = 0 clogy = zfflog(-c,0,czero,ier) endif if ( Im(c) .lt. -precc*absc(c) .or. + Im(csum) .lt. -precc*absc(csum) ) then ipi = -1 elseif ( Im(c) .gt. precc*absc(c) .or. + Im(csum) .gt. precc*absc(csum) ) then ipi = +1 else call fferr(51,ier) ipi = 0 endif endif endif endif cs3 = cs3 + ntot*c2ipi*clogy if ( ipi .ne. 0 ) then ipi12 = ipi12 - 24*ntot*ipi endif * #] calculations: *###] ffclgy: end *###[ ffieps: subroutine ffieps(ieps,cz,cp,cpDs,isoort) ***#[*comment:*********************************************************** * * * Get the ieps prescription in such a way that it is compatible * * with the imaginary part of cz if non-zero, compatible with the * * real case if zero. * * * * Input: cz complex(4) the roots z-,z+,1-z-,1-z+ * * cp complex p^2 * * cpDs complex p.s * * isoort integer(2) which type of Ri * * * * Output: ieps integer(2) z -> z-ieps*i*epsilon * * will give correct im part * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments: * integer ieps(2),isoort(2) ComplexType cp,cpDs,cz(4) * * #] declarations: * #[ work: if ( Im(cp) .ne. 0 ) then * do not calculate ANY eta terms, we'll do them ourselves. ieps(1) = 99 ieps(2) = 99 elseif ( isoort(2) .ne. 0 ) then if ( Im(cz(1)) .lt. 0 ) then ieps(1) = +1 if ( Im(cz(2)) .lt. 0 ) then ieps(2) = +1 else ieps(2) = -1 endif elseif ( Im(cz(1)) .gt. 0 ) then ieps(1) = -1 if ( Im(cz(2)) .le. 0 ) then ieps(2) = +1 else ieps(2) = -1 endif else if ( Im(cz(2)) .lt. 0 ) then ieps(1) = -1 ieps(2) = +1 elseif ( Im(cz(2)) .gt. 0 ) then ieps(1) = +1 ieps(2) = -1 else if ( (Re(cz(2)).gt.Re(cz(1)) + .or. (Re(cz(1)).eq.Re(cz(2)) + .and. Re(cz(4)).lt.Re(cz(3))) + ) .eqv. Re(cp).gt.0 ) then ieps(1) = +1 ieps(2) = -1 else ieps(1) = -1 ieps(2) = +1 endif endif endif else if ( Im(cz(1)) .lt. 0 ) then ieps(1) = +1 elseif ( Im(cz(1)) .gt. 0 ) then ieps(1) = -1 elseif ( Re(cpDs) .gt. 0 ) then ieps(1) = +1 else ieps(1) = -1 endif ieps(2) = -9999 endif * #] work: *###] ffieps: end *###[ ffgeta: subroutine ffgeta(ni,cz,cdyz,cp,cpDs,ieps,isoort,ier) ***#[*comment:*********************************************************** * * * Get the eta terms which arise from splitting up * * log(p2(x-z-)(x-z+)) - log(p2(y-z-)(y-z+)) * * * * Input: cz complex(4) the roots z-,z+,1-z-,1-z+ * * cdyz complex(2,2) y-z * * cd2yzz complex(2) 2y-(z-)-(z+) * * cp complex p^2 * * cpDs complex p.s * * ieps integer(2) the assumed im part if Im(z)=0 * * isoort integer(2) which type of Ri * * * * Output: ni integer(4) eta()/(2*pi*i) * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments: * integer ni(4),ieps(2),isoort(2),ier ComplexType cp,cpDs,cz(4),cdyz(2,2) * * local variables * integer i,nffeta,nffet1 ComplexType cmip external nffeta,nffet1 * * common * #include "ff.h" * * #] declarations: * #[ complex masses or imaginary roots: * * only complex because of complex roots in y or z * [checked and in agreement with ieps definition 23-sep-1991] * * isoort = +1: y is real, z is real * isoort = -1-n*10: y is complex, possibly z as well * isoort = -3-n*10: y,z complex, (y-z-)*(y-z+) real * isoort = 0: y is complex, one z root only * isoort = -10-n*10: y is real, z is complex * isoort = -5,6-n*10: y,z real * if ( isoort(1) .gt. 0 ) then * * really a real case * ni(1) = 0 ni(2) = 0 ni(3) = 0 ni(4) = 0 elseif ( mod(isoort(1),10) .ne. 0 .and. isoort(2) .ne. 0 ) then cmip = ToComplex(0D0,-Re(cp)) * * ni(1) = eta(p2,(x-z-)(x-z+)) = 0 by definition (see ni(3)) * ni(2) = eta(x-z-,x-z+) * ni(1) = 0 if ( ieps(1) .gt. 0 .neqv. ieps(2) .gt. 0 ) then ni(2) = 0 else ni(2) = nffet1(-cz(1),-cz(2),cmip,ier) if ( cz(3).ne.0 .and. cz(4).ne.0 ) then i = nffet1(cz(3),cz(4),cmip,ier) if ( i .ne. ni(2) ) call fferr(53,ier) endif endif * * ni(3) compensates for whatever convention we chose in ni(1) * ni(4) = -eta(y-z-,y-z+) * if ( mod(isoort(1),10).eq.-3 ) then * follow the i*epsilon prescription as (y-z-)(y-z+) real ni(3) = 0 ni(4) = -nffet1(cdyz(2,1),cdyz(2,2),cmip,ier) else if ( Re(cp) .lt. 0 .and. Im(cdyz(2,1)* + cdyz(2,2)) .lt. 0 ) then ni(3) = -1 else ni(3) = 0 endif ni(4) = -nffeta(cdyz(2,1),cdyz(2,2),ier) endif elseif ( (mod(isoort(1),10).eq.-1 .or. mod(isoort(1),10).eq.-3) + .and. isoort(2) .eq. 0 ) then ni(1) = 0 if ( Im(cz(1)) .ne. 0 ) then ni(2) = nffet1(-cpDs,-cz(1),ToComplex(Re(0), + Re(-1)),ier) else ni(2) = nffet1(-cpDs,ToComplex(Re(0),Re(1)), + ToComplex(Re(0),Re(-1)),ier) endif ni(3) = 0 ni(4) = -nffeta(-cpDs,cdyz(2,1),ier) else ni(1) = 0 ni(2) = 0 ni(3) = 0 ni(4) = 0 endif * #] complex masses or imaginary roots: *###] ffgeta: end LoopTools-2.16/src/util/PaxHeaders/cache.c0000644000000000000000000000013214044005731015423 xustar0030 mtime=1620052953.305006386 30 atime=1648161785.707698331 30 ctime=1648161793.715764879 LoopTools-2.16/src/util/cache.c0000644000000000000000000001106714044005731016350 0ustar00rootroot00000000000000/* cache.c caching of tensor coefficients in dynamically allocated memory this file is part of LoopTools last modified 3 May 21 th */ #define MUTEX #include #include #include #include #ifdef MUTEX #include #endif #include "cexternals.h" #if NOUNDERSCORE #define cacheindex_ cacheindex #define cachecopy_ cachecopy #define ltcache_ ltcache #endif #if QUAD #define MSB (1-BIGENDIAN) #else #define MSB 0 #endif typedef long long dblint; typedef unsigned long long udblint; typedef struct { dblint part[QUAD+1]; } RealType; typedef const RealType cRealType; typedef struct { RealType re, im; } ComplexType; typedef long long memindex; extern struct { int cmpbits; } ltcache_; enum { ncaches = 10 }; #ifdef MUTEX static pthread_mutex_t mutex[ncaches] = { PTHREAD_MUTEX_INITIALIZER, PTHREAD_MUTEX_INITIALIZER, PTHREAD_MUTEX_INITIALIZER, PTHREAD_MUTEX_INITIALIZER, PTHREAD_MUTEX_INITIALIZER, PTHREAD_MUTEX_INITIALIZER, PTHREAD_MUTEX_INITIALIZER, PTHREAD_MUTEX_INITIALIZER, PTHREAD_MUTEX_INITIALIZER, PTHREAD_MUTEX_INITIALIZER }; #endif static inline int IDim(const int i) { return i & (-i >> (8*sizeof i - 1)); } static inline int SignBit(const dblint i) { return (udblint)i >> (8*sizeof i - 1); } static inline memindex PtrDiff(const void *a, const void *b) { return (char *)a - (char *)b; } static dblint CmpPara(cRealType *para1, cRealType *para2, int n, const dblint mask) { while( n-- ) { const dblint c = (mask & para1->part[MSB]) - (mask & para2->part[MSB]); if( c ) return c; ++para1; ++para2; } return 0; } #if QUAD static dblint CmpParaLo(cRealType *para1, cRealType *para2, int n, const dblint mask) { while( n-- ) { dblint c = para1->part[MSB] - para2->part[MSB]; if( c ) return c; c = (mask & para1->part[1-MSB]) - (mask & para2->part[1-MSB]); if( c ) return c; ++para1; ++para2; } return 0; } #endif static void *Lookup(cRealType *para, double *base, void (*calc)(RealType *, cRealType *), const int npara, const int nval, const int cacheno) { typedef struct node { struct node *next[2], *succ; int serial; RealType para[2]; } Node; #define base_valid (int *)&base[0] #define base_last (Node ***)&base[1] #define base_first (Node **)&base[2] const int valid = *base_valid; Node **last = *base_last; Node **next = base_first; Node *node; #ifdef MUTEX pthread_mutex_t *mx = &mutex[cacheno-1]; #endif if( last == NULL ) last = next; { dblint mask = -(1ULL << IDim(64 - ltcache_.cmpbits)); #if QUAD dblint (*cmp)(cRealType *, cRealType *, int, const dblint) = CmpPara; if( ltcache_.cmpbits >= 64 ) { mask = -(1ULL << IDim(128 - ltcache_.cmpbits)); cmp = CmpParaLo; } #else #define cmp CmpPara #endif while( (node = *next) && node->serial < valid ) { const dblint i = cmp(para, node->para, npara, mask); if( i == 0 ) goto x0; next = &node->next[SignBit(i)]; } #ifdef MUTEX pthread_mutex_lock(mx); while( (node = *next) && node->serial < valid ) { const dblint i = cmp(para, node->para, npara, mask); if( i == 0 ) goto x1; next = &node->next[SignBit(i)]; } #endif } node = *last; if( node == NULL ) { /* The "RealType para[2]" bit in Node is effectively an extra Complex for alignment so that node can be reached with an integer index into base */ size_t mem = sizeof(Node) + npara*sizeof(RealType) + nval*sizeof(ComplexType); assert( (node = malloc(mem)) ); node = (Node *)((char *)node + (PtrDiff(base, &node->para[npara]) & (sizeof(ComplexType) - 1))); node->succ = NULL; node->serial = valid; *last = node; } *next = node; *base_last = &node->succ; *base_valid = valid + 1; node->next[0] = NULL; node->next[1] = NULL; memcpy(node->para, para, npara*sizeof(RealType)); calc(&node->para[npara], para); #ifdef MUTEX x1: pthread_mutex_unlock(mx); #endif x0: return &node->para[npara]; } memindex cacheindex_(cRealType *para, double *base, void (*calc)(RealType *, cRealType *), const int *pnpara, const int *pnval, const int *pcacheno) { ComplexType *val = Lookup(para, base, calc, *pnpara, *pnval, *pcacheno); return PtrDiff(val, base)/(long)sizeof(ComplexType); } void cachecopy_(ComplexType *dest, cRealType *para, double *base, void (*calc)(RealType *, cRealType *), const int *pnpara, const int *pnval, const int *pcacheno) { ComplexType *val = Lookup(para, base, calc, *pnpara, *pnval, *pcacheno); memcpy(dest, val, *pnval*sizeof *dest); } LoopTools-2.16/src/util/PaxHeaders/ini.F0000644000000000000000000000007413266126503015115 xustar0030 atime=1648161785.707698331 30 ctime=1648161793.715764879 LoopTools-2.16/src/util/ini.F0000644000000000000000000004103613266126503016034 0ustar00rootroot00000000000000* ini.F * routines for initializing and setting some parameters * this file is part of LoopTools * last modified 14 Apr 18 th #include "externals.h" #include "types.h" #include "defs.h" subroutine clearcache implicit none #include "lt.h" integer i do i = 1, ncaches cacheptr(1,0,i) = 0 cacheptr(2,0,i) = 0 savedptr(1,i) = 0 savedptr(2,i) = 0 enddo end ************************************************************************ subroutine markcache implicit none #include "lt.h" integer i do i = 1, ncaches savedptr(1,i) = cacheptr(1,0,i) savedptr(2,i) = cacheptr(2,0,i) enddo end ************************************************************************ subroutine restorecache implicit none #include "lt.h" integer i do i = 1, ncaches cacheptr(1,0,i) = savedptr(1,i) cacheptr(2,0,i) = savedptr(2,i) enddo end ************************************************************************ * Legacy function, provided for compatibility only. * Works only approximately as before! subroutine setcachelast(base, offset) implicit none ComplexType base(*) integer offset logical ini data ini /.TRUE./ if( ini ) then print *, "setcachelast is deprecated" print *, "use clearcache or restorecache instead" ini = .FALSE. endif if( offset .eq. 0 ) then call clearcache else call restorecache endif end ************************************************************************ * Legacy function, provided for compatibility only. * Works only approximately as before! integer function getcachelast(base) implicit none ComplexType base(*) logical ini data ini /.TRUE./ if( ini ) then print *, "getcachelast is deprecated" print *, "use markcache instead" ini = .FALSE. endif getcachelast = 1 call markcache end ************************************************************************ subroutine setmudim(mudim_) implicit none RealType mudim_ #include "lt.h" if( abs(mudim - mudim_) .gt. diffeps ) call clearcache mudim = mudim_ end ************************************************************************ RealType function getmudim() implicit none #include "lt.h" getmudim = mudim end ************************************************************************ subroutine setdelta(delta_) implicit none RealType delta_ #include "lt.h" if( abs(delta - delta_) .gt. diffeps ) call clearcache delta = delta_ end ************************************************************************ RealType function getdelta() implicit none #include "lt.h" getdelta = delta end ************************************************************************ subroutine setuvdiv(uvdiv_) implicit none RealType uvdiv_ #include "lt.h" if( abs(uvdiv - uvdiv_) .gt. diffeps ) call clearcache uvdiv = uvdiv_ end ************************************************************************ RealType function getuvdiv() implicit none #include "lt.h" getuvdiv = uvdiv end ************************************************************************ subroutine setlambda(lam_) implicit none RealType lam_ #include "lt.h" RealType lambda_ if( lam_ .ge. 0 .or. lam_ .eq. -1 .or. lam_ .eq. -2 ) then lambda_ = dim(lam_, 0D0) epsi = int(dim(0D0, lam_)) else print *, "illegal value for lambda" lambda_ = 0 epsi = 0 endif if( abs(lambda - lambda_) .gt. diffeps ) call clearcache lambda = lambda_ end ************************************************************************ RealType function getlambda() implicit none #include "lt.h" getlambda = lambda end ************************************************************************ integer function getepsi() implicit none #include "lt.h" getepsi = epsi end ************************************************************************ subroutine setminmass(minmass_) implicit none RealType minmass_ #include "lt.h" if( abs(minmass - minmass_) .gt. diffeps ) call clearcache minmass = minmass_ end ************************************************************************ RealType function getminmass() implicit none #include "lt.h" getminmass = minmass end ************************************************************************ subroutine setmaxdev(maxdev_) implicit none RealType maxdev_ #include "lt.h" maxdev = maxdev_ end ************************************************************************ RealType function getmaxdev() implicit none #include "lt.h" getmaxdev = maxdev end ************************************************************************ subroutine setdiffeps(diffeps_) implicit none RealType diffeps_ #include "lt.h" diffeps = diffeps_ end ************************************************************************ RealType function getdiffeps() implicit none #include "lt.h" getdiffeps = diffeps end ************************************************************************ subroutine setzeroeps(zeroeps_) implicit none RealType zeroeps_ #include "lt.h" zeroeps = zeroeps_ end ************************************************************************ RealType function getzeroeps() implicit none #include "lt.h" getzeroeps = zeroeps end ************************************************************************ subroutine setwarndigits(warndigits_) implicit none integer warndigits_ #include "lt.h" warndigits = warndigits_ end ************************************************************************ integer function getwarndigits() implicit none #include "lt.h" getwarndigits = warndigits end ************************************************************************ subroutine seterrdigits(errdigits_) implicit none integer errdigits_ #include "lt.h" errdigits = errdigits_ end ************************************************************************ integer function geterrdigits() implicit none #include "lt.h" geterrdigits = errdigits end ************************************************************************ subroutine setversionkey(versionkey_) implicit none integer versionkey_ #include "lt.h" versionkey = versionkey_ call clearcache end ************************************************************************ integer function getversionkey() implicit none #include "lt.h" getversionkey = versionkey end ************************************************************************ subroutine setdebugkey(debugkey_) implicit none integer debugkey_ #include "lt.h" debugkey = debugkey_ end ************************************************************************ integer function getdebugkey() implicit none #include "lt.h" getdebugkey = debugkey end ************************************************************************ subroutine setdebugrange(debugfrom_, debugto_) implicit none integer debugfrom_, debugto_ #include "lt.h" debugfrom = debugfrom_ debugto = debugto_ end ************************************************************************ subroutine setcmpbits(cmpbits_) implicit none integer cmpbits_ #include "lt.h" cmpbits = max(cmpbits_, 12 + QUAD*4) end ************************************************************************ integer function getcmpbits() implicit none #include "lt.h" getcmpbits = cmpbits end ************************************************************************ * This silly subroutine is called from ffini while determining * the working precision of the machine we're running on. * It works around the optimizer to guarantee that we're not in * fact determining the precision of the FPU registers. subroutine ffset(res, x) implicit none RealType res, x res = x end ************************************************************************ block data namedata implicit none #include "ltnames.h" data paraname(1:Paa,1) / & "m" / data paraname(1:Pbb,2) / & "m1", "m2", "p" / data paraname(1:Pcc,3) / & "m1", "m2", "m3", "p1", "p2", "p1p2" / data paraname(1:Pdd,4) / & "m1", "m2", "m3", "m4", & "p1", "p2", "p3", "p4", "p1p2", "p2p3" / data paraname(1:Pee,5) / & "m1", "m2", "m3", "m4", "m5", & "p1", "p2", "p3", "p4", "p5", & "p1p2", "p2p3", "p3p4", "p4p5", "p5p1" / data coeffname(1:Naa,1) / & "aa0", "aa0:1", "aa0:2", & "aa00", "aa00:1", "aa00:2" / data coeffname(1:Nbb,2) / & "bb0", "bb0:1", "bb0:2", & "bb1", "bb1:1", "bb1:2", & "bb00", "bb00:1", "bb00:2", & "bb11", "bb11:1", "bb11:2", & "bb001", "bb001:1", "bb001:2", & "bb111", "bb111:1", "bb111:2", & "dbb0", "dbb0:1", "dbb0:2", & "dbb1", "dbb1:1", "dbb1:2", & "dbb00", "dbb00:1", "dbb00:2", & "dbb11", "dbb11:1", "dbb11:2", & "dbb001", "dbb001:1", "dbb001:2" / data coeffname(1:Ncc,3) / & "cc0", "cc0:1", "cc0:2", & "cc1", "cc1:1", "cc1:2", & "cc2", "cc2:1", "cc2:2", & "cc00", "cc00:1", "cc00:2", & "cc11", "cc11:1", "cc11:2", & "cc12", "cc12:1", "cc12:2", & "cc22", "cc22:1", "cc22:2", & "cc001", "cc001:1", "cc001:2", & "cc002", "cc002:1", "cc002:2", & "cc111", "cc111:1", "cc111:2", & "cc112", "cc112:1", "cc112:2", & "cc122", "cc122:1", "cc122:2", & "cc222", "cc222:1", "cc222:2", & "cc0000", "cc0000:1", "cc0000:2", & "cc0011", "cc0011:1", "cc0011:2", & "cc0012", "cc0012:1", "cc0012:2", & "cc0022", "cc0022:1", "cc0022:2", & "cc1111", "cc1111:1", "cc1111:2", & "cc1112", "cc1112:1", "cc1112:2", & "cc1122", "cc1122:1", "cc1122:2", & "cc1222", "cc1222:1", "cc1222:2", & "cc2222", "cc2222:1", "cc2222:2" / data coeffname(1:Ndd,4) / & "dd0", "dd0:1", "dd0:2", & "dd1", "dd1:1", "dd1:2", & "dd2", "dd2:1", "dd2:2", & "dd3", "dd3:1", "dd3:2", & "dd00", "dd00:1", "dd00:2", & "dd11", "dd11:1", "dd11:2", & "dd12", "dd12:1", "dd12:2", & "dd13", "dd13:1", "dd13:2", & "dd22", "dd22:1", "dd22:2", & "dd23", "dd23:1", "dd23:2", & "dd33", "dd33:1", "dd33:2", & "dd001", "dd001:1", "dd001:2", & "dd002", "dd002:1", "dd002:2", & "dd003", "dd003:1", "dd003:2", & "dd111", "dd111:1", "dd111:2", & "dd112", "dd112:1", "dd112:2", & "dd113", "dd113:1", "dd113:2", & "dd122", "dd122:1", "dd122:2", & "dd123", "dd123:1", "dd123:2", & "dd133", "dd133:1", "dd133:2", & "dd222", "dd222:1", "dd222:2", & "dd223", "dd223:1", "dd223:2", & "dd233", "dd233:1", "dd233:2", & "dd333", "dd333:1", "dd333:2", & "dd0000", "dd0000:1", "dd0000:2", & "dd0011", "dd0011:1", "dd0011:2", & "dd0012", "dd0012:1", "dd0012:2", & "dd0013", "dd0013:1", "dd0013:2", & "dd0022", "dd0022:1", "dd0022:2", & "dd0023", "dd0023:1", "dd0023:2", & "dd0033", "dd0033:1", "dd0033:2", & "dd1111", "dd1111:1", "dd1111:2", & "dd1112", "dd1112:1", "dd1112:2", & "dd1113", "dd1113:1", "dd1113:2", & "dd1122", "dd1122:1", "dd1122:2", & "dd1123", "dd1123:1", "dd1123:2", & "dd1133", "dd1133:1", "dd1133:2", & "dd1222", "dd1222:1", "dd1222:2", & "dd1223", "dd1223:1", "dd1223:2", & "dd1233", "dd1233:1", "dd1233:2", & "dd1333", "dd1333:1", "dd1333:2", & "dd2222", "dd2222:1", "dd2222:2", & "dd2223", "dd2223:1", "dd2223:2", & "dd2233", "dd2233:1", "dd2233:2", & "dd2333", "dd2333:1", "dd2333:2", & "dd3333", "dd3333:1", "dd3333:2", & "dd00001", "dd00001:1", "dd00001:2", & "dd00002", "dd00002:1", "dd00002:2", & "dd00003", "dd00003:1", "dd00003:2", & "dd00111", "dd00111:1", "dd00111:2", & "dd00112", "dd00112:1", "dd00112:2", & "dd00113", "dd00113:1", "dd00113:2", & "dd00122", "dd00122:1", "dd00122:2", & "dd00123", "dd00123:1", "dd00123:2", & "dd00133", "dd00133:1", "dd00133:2", & "dd00222", "dd00222:1", "dd00222:2", & "dd00223", "dd00223:1", "dd00223:2", & "dd00233", "dd00233:1", "dd00233:2", & "dd00333", "dd00333:1", "dd00333:2", & "dd11111", "dd11111:1", "dd11111:2", & "dd11112", "dd11112:1", "dd11112:2", & "dd11113", "dd11113:1", "dd11113:2", & "dd11122", "dd11122:1", "dd11122:2", & "dd11123", "dd11123:1", "dd11123:2", & "dd11133", "dd11133:1", "dd11133:2", & "dd11222", "dd11222:1", "dd11222:2", & "dd11223", "dd11223:1", "dd11223:2", & "dd11233", "dd11233:1", "dd11233:2", & "dd11333", "dd11333:1", "dd11333:2", & "dd12222", "dd12222:1", "dd12222:2", & "dd12223", "dd12223:1", "dd12223:2", & "dd12233", "dd12233:1", "dd12233:2", & "dd12333", "dd12333:1", "dd12333:2", & "dd13333", "dd13333:1", "dd13333:2", & "dd22222", "dd22222:1", "dd22222:2", & "dd22223", "dd22223:1", "dd22223:2", & "dd22233", "dd22233:1", "dd22233:2", & "dd22333", "dd22333:1", "dd22333:2", & "dd23333", "dd23333:1", "dd23333:2", & "dd33333", "dd33333:1", "dd33333:2" / data coeffname(1:Nee,5) / & "ee0", "ee0:1", "ee0:2", & "ee1", "ee1:1", "ee1:2", & "ee2", "ee2:1", "ee2:2", & "ee3", "ee3:1", "ee3:2", & "ee4", "ee4:1", "ee4:2", & "ee00", "ee00:1", "ee00:2", & "ee11", "ee11:1", "ee11:2", & "ee12", "ee12:1", "ee12:2", & "ee13", "ee13:1", "ee13:2", & "ee14", "ee14:1", "ee14:2", & "ee22", "ee22:1", "ee22:2", & "ee23", "ee23:1", "ee23:2", & "ee24", "ee24:1", "ee24:2", & "ee33", "ee33:1", "ee33:2", & "ee34", "ee34:1", "ee34:2", & "ee44", "ee44:1", "ee44:2", & "ee001", "ee001:1", "ee001:2", & "ee002", "ee002:1", "ee002:2", & "ee003", "ee003:1", "ee003:2", & "ee004", "ee004:1", "ee004:2", & "ee111", "ee111:1", "ee111:2", & "ee112", "ee112:1", "ee112:2", & "ee113", "ee113:1", "ee113:2", & "ee114", "ee114:1", "ee114:2", & "ee122", "ee122:1", "ee122:2", & "ee123", "ee123:1", "ee123:2", & "ee124", "ee124:1", "ee124:2", & "ee133", "ee133:1", "ee133:2", & "ee134", "ee134:1", "ee134:2", & "ee144", "ee144:1", "ee144:2", & "ee222", "ee222:1", "ee222:2", & "ee223", "ee223:1", "ee223:2", & "ee224", "ee224:1", "ee224:2", & "ee233", "ee233:1", "ee233:2", & "ee234", "ee234:1", "ee234:2", & "ee244", "ee244:1", "ee244:2", & "ee333", "ee333:1", "ee333:2", & "ee334", "ee334:1", "ee334:2", & "ee344", "ee344:1", "ee344:2", & "ee444", "ee444:1", "ee444:2", & "ee0000", "ee0000:1", "ee0000:2", & "ee0011", "ee0011:1", "ee0011:2", & "ee0012", "ee0012:1", "ee0012:2", & "ee0013", "ee0013:1", "ee0013:2", & "ee0014", "ee0014:1", "ee0014:2", & "ee0022", "ee0022:1", "ee0022:2", & "ee0023", "ee0023:1", "ee0023:2", & "ee0024", "ee0024:1", "ee0024:2", & "ee0033", "ee0033:1", "ee0033:2", & "ee0034", "ee0034:1", "ee0034:2", & "ee0044", "ee0044:1", "ee0044:2", & "ee1111", "ee1111:1", "ee1111:2", & "ee1112", "ee1112:1", "ee1112:2", & "ee1113", "ee1113:1", "ee1113:2", & "ee1114", "ee1114:1", "ee1114:2", & "ee1122", "ee1122:1", "ee1122:2", & "ee1123", "ee1123:1", "ee1123:2", & "ee1124", "ee1124:1", "ee1124:2", & "ee1133", "ee1133:1", "ee1133:2", & "ee1134", "ee1134:1", "ee1134:2", & "ee1144", "ee1144:1", "ee1144:2", & "ee1222", "ee1222:1", "ee1222:2", & "ee1223", "ee1223:1", "ee1223:2", & "ee1224", "ee1224:1", "ee1224:2", & "ee1233", "ee1233:1", "ee1233:2", & "ee1234", "ee1234:1", "ee1234:2", & "ee1244", "ee1244:1", "ee1244:2", & "ee1333", "ee1333:1", "ee1333:2", & "ee1334", "ee1334:1", "ee1334:2", & "ee1344", "ee1344:1", "ee1344:2", & "ee1444", "ee1444:1", "ee1444:2", & "ee2222", "ee2222:1", "ee2222:2", & "ee2223", "ee2223:1", "ee2223:2", & "ee2224", "ee2224:1", "ee2224:2", & "ee2233", "ee2233:1", "ee2233:2", & "ee2234", "ee2234:1", "ee2234:2", & "ee2244", "ee2244:1", "ee2244:2", & "ee2333", "ee2333:1", "ee2333:2", & "ee2334", "ee2334:1", "ee2334:2", & "ee2344", "ee2344:1", "ee2344:2", & "ee2444", "ee2444:1", "ee2444:2", & "ee3333", "ee3333:1", "ee3333:2", & "ee3334", "ee3334:1", "ee3334:2", & "ee3344", "ee3344:1", "ee3344:2", & "ee3444", "ee3444:1", "ee3444:2", & "ee4444", "ee4444:1", "ee4444:2" / end LoopTools-2.16/src/util/PaxHeaders/ffabcd.F0000644000000000000000000000007411776502523015547 xustar0030 atime=1648161785.707698331 30 ctime=1648161793.715764879 LoopTools-2.16/src/util/ffabcd.F0000644000000000000000000001354711776502523016474 0ustar00rootroot00000000000000#include "externals.h" #include "types.h" *###[ ffabcd: subroutine ffabcd(aijkl,xpi,dpipj,piDpj,del2s,sdel2s, + in,jn,jin,isji, kn,ln,lkn,islk, ifirst, ier) ***#[*comment:*********************************************************** * * * Calculate the a,b,c,d of the equation for qij.qkl * * * * a = s4.s4^2 * * * * si sj sk sl / sm sn sm sn sm sn mu ro\ * * -b/2 = d d |d d - d s4 s4 | * * mu nu nu ro \ mu s4 ro s4 sm sn / * * * * _ si sj sk sl / mu s4 ro mu s4 ro\ * * vD/2 = d d |d s4 + d s4 | * * mu nu nu ro \ s3 s4 s3 s4 / * * * * with sm = s3, sn = s4 * * p(jin) = isji*(sj-si) * * p(lkn) = islk*(sl-sk) * * * * Input: xpi(ns) as usual * * dpipj(ns,ns) -"- * * piDpj(ns,ns) -"- * * in,jn,jin,isjn see above * * kn,ln,lkn,islk see above * * * * Output: del4d2 see above * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments: * integer in,jn,jin,isji,kn,ln,lkn,islk,ifirst, + ier RealType aijkl,xpi(10),dpipj(10,10),piDpj(10,10),del2s RealType sdel2s * * local variables: * integer i,j,ji,k,l,lk,isii integer ii integer iii(6,2) save iii logical ldet(4) RealType xa,xb,xc,xd,s(24),del3(4),som,somb,somd, + smax,save,xmax,del2d2,dum,del2i,del2j, + del2ji,d2d2i,d2d2j,d2d2ji save del3,ldet * * common blocks: * #include "ff.h" * * data * data iii / 0,3,4,0,7,0, + 0,3,4,0,7,0/ * #] declarations: * #[ initialisaties: if ( ifirst .eq. 0 ) then ifirst = ifirst + 1 ldet(2) = .FALSE. ldet(3) = .FALSE. ldet(4) = .FALSE. endif xa = xpi(4)**2 * #] initialisaties: * #[ prepare input: i = in j = jn ji = jin k = kn l = ln lk = lkn * #] prepare input: * #[ special cases: if ( k .eq. 3 ) then xb = 0 xc = 0 xd = 0 goto 990 elseif ( j .ge. 3 .and. l .ge. 3 ) then * the whole thing collapses to factor*det3 * we have a good memory of things already calculated ... if ( .not.ldet(i+k) ) then ldet(i+k) = .TRUE. iii(1,1) = i iii(4,1) = isgn(3,i)*inx(3,i) iii(6,1) = isgn(i,4)*inx(i,4) iii(1,2) = k iii(4,2) = isgn(3,k)*inx(3,k) iii(6,2) = isgn(k,4)*inx(k,4) call ffdl3s(del3(i+k),piDpj,iii,10) endif if ( l .eq. 4 .and. j .eq. 4 ) then xb = xpi(4)**2*del3(i+k)/del2s xd = 0 xc = xb**2/xa elseif ( l .eq. 4 .or. j .eq. 4 ) then xb = piDpj(3,4)*xpi(4)*del3(i+k)/del2s xd = -xpi(4)*del3(i+k)/sdel2s xc = xpi(4)*xpi(3)*del3(i+k)**2/del2s**2 else * l .eq. 3 .and. j .eq. 3 xd = -2*piDpj(3,4)*del3(i+k)/sdel2s s(1) = xpi(3)*xpi(4) s(2) = 2*piDpj(3,4)**2 som = s(2) - s(1) xb = som*del3(i+k)/del2s xc = xpi(3)**2*del3(i+k)**2/del2s**2 endif goto 900 endif if ( j .eq. 2 .and. l .eq. 4 ) then call ff3dl2(s(1),xpi,dpipj,piDpj, 4, 1,2,5,+1, + k,3,inx(3,k),isgn(3,k), 4, 3,4,7,+1, ier) xb = -xpi(4)*s(1)/del2s iii(1,1) = 1 iii(2,1) = 2 iii(4,1) = 5 iii(5,1) = 10 iii(6,1) = 8 iii(1,2) = k iii(4,2) = isgn(3,k)*inx(3,k) iii(6,2) = isgn(k,4)*inx(k,4) call ffdl3s(s(1),piDpj,iii,10) * restore values for other users iii(2,1) = 3 iii(5,1) = 7 xd = -xpi(4)*s(1)/sdel2s goto 800 endif * #] special cases: * #[ normal case b: * * First term: * call ff2dl2(del2d2,dum,xpi,dpipj,piDpj, 4, + i,j,ji,isji, 4, k,l,lk,islk, 10, ier) s(1) = -del2d2*del2s * * Second and third term, split i,j * if ( i .eq. 4 ) then del2i = 0 else ii = inx(4,i) isii = isgn(4,i) call ffdl2s(del2i,piDpj,i,4,ii,isii,3,4,7,+1,10) endif if ( j .eq. 4 ) then del2j = 0 else ii = inx(4,j) isii = isgn(4,j) call ffdl2s(del2j,piDpj,j,4,ii,isii,3,4,7,+1,10) endif call ff2dl2(d2d2i,dum,xpi,dpipj,piDpj, i, k,l,lk,islk, 4, + 3,4,7,+1, 10, ier) call ff2dl2(d2d2j,dum,xpi,dpipj,piDpj, j, k,l,lk,islk, 4, + 3,4,7,+1, 10, ier) s(2) = +del2i*d2d2j s(3) = -del2j*d2d2i somb = s(1) + s(2) + s(3) smax = max(abs(s(1)),abs(s(2)),abs(s(3))) if ( abs(somb) .ge. xloss*smax ) goto 90 xmax = smax save = somb * if the first term is wrong ... forget about it if ( abs(somb) .lt. xloss*abs(s(1)) ) goto 80 call ffdl2t(del2ji,piDpj, ji,4, 3,4,7,+1,+1, 10) call ff2dl2(d2d2ji,dum,xpi,dpipj,piDpj, ji, k,l,lk,islk, 4, + 3,4,7,+1, 10, ier) s(2) = +del2j*d2d2ji s(3) = -del2ji*d2d2j somb = s(1) + isji*(s(2) + s(3)) smax = max(abs(s(1)),abs(s(2)),abs(s(3))) if ( abs(somb) .ge. xloss*smax ) goto 90 if ( smax .lt. xmax ) then save = somb xmax = smax endif s(2) = +del2i*d2d2ji s(3) = -del2ji*d2d2i somb = s(1) + isji*(s(2) + s(3)) smax = max(abs(s(1)),abs(s(2)),abs(s(3))) if ( abs(somb) .ge. xloss*max(abs(s(1)),abs(s(2)),abs(s(3))) ) + goto 90 if ( smax .lt. xmax ) then save = somb xmax = smax endif 80 continue * * give up: * somb = save 90 continue xb = somb/del2s * #] normal case b: * #[ normal case d: call ff3dl2(s(1),xpi,dpipj,piDpj, 4, i,j,ji,isji, k,l,lk,islk, + 4, 3,4,7,+1, ier) if ( i .eq. k .and. j .eq. l ) then somd = -2*s(1) else call ff3dl2(s(2),xpi,dpipj,piDpj, 4, k,l,lk,islk, + i,j,ji,isji, 4, 3,4,7,+1, ier) somd = - s(1) - s(2) endif xd = -somd/sdel2s * #] normal case d: * #[ normal case c: 800 continue s(1) = xb - xd s(2) = xb + xd *** vvv Added 11 Feb 08: smax = abs(abs(xb) - abs(xd)) xmax = xloss*max(abs(xb), abs(xd)) if( smax .lt. xmax .and. xmax .gt. 0 ) then if( smax .ne. 0 ) then ier = ier + int(log10(xmax/smax)) else ier = ier + int(log10(xmax/xclogm)) endif endif *** ^^^ som = s(1)*s(2) xc = som/xa * #] normal case c: 900 continue * #[ and the final answer: 990 continue call ffroot(dum,aijkl,xa,xb,xc,xd,ier) * #] and the final answer: *###] ffabcd: end LoopTools-2.16/src/util/PaxHeaders/ffxxyz.F0000644000000000000000000000007412271427545015701 xustar0030 atime=1648161785.707698331 30 ctime=1648161793.715764879 LoopTools-2.16/src/util/ffxxyz.F0000644000000000000000000005054612271427545016626 0ustar00rootroot00000000000000#include "externals.h" #include "types.h" *###[ ffxxyz: subroutine ffxxyz(y,z,dyz,d2yzz,dy2z,ivert,sdel2p,sdel2s,etalam, + etami,delps,xpi,dpipj,piDpj,isoort,ldel2s,ns,ier) ***#[*comment:*********************************************************** * * * calculate in a numerically stable way * * * * z(1,2) = (-p(ip1).p(is2) +/- sdel2s)/xpi(ip1) * * y(1,2) = (-p(ip1).p(is2) +/- sdisc)/xpi(ip1) * * disc = del2s + etaslam*xpi(ip1) * * * * y(3,4) = 1-y(1,2) * * z(3,4) = 1-z(1,2) * * dyz(i,j) = y(i) - z(j) * * d2yzz = y(2) - z(1) - z(2) * * dy2z(j) = y(2) - 2*z(j) * * * * Input: ivert (integer) defines the vertex * * sdel2p (real) sqrt(lam(p1,p2,p3))/2 * * sdel2s (real) sqrt(lam(p,ma,mb))/2 * * etalam (real) det(si.sj)/det(pi.pj) * * etami(6) (real) si.si - etalam * * xpi(ns) (real) standard * * piDpj(ns,ns) (real) standard * * ns (integer) dim of xpi,piDpj * * * * Output: y(4),z(4),dyz(4,4) (real) see above * * * * Calls: fferr,ffroot * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments: * integer ivert,ns,ier,isoort(2) logical ldel2s RealType y(4),z(4),dyz(2,2),d2yzz,dy2z(4), + sdel2p,sdel2s,etalam,etami(6),delps,xpi(ns), + dpipj(ns,ns),piDpj(ns,ns) * * local variables: * integer i,j,n,ip1,ip2,ip3,is1,is2,is3,iwarn,ier1 RealType disc,hulp,s,smax,som(51),xmax RealType t1,t2,t4,t5,t8,t3,t7,t9,t12,t14,t21,t23,t24, + t28,t6,t35,t44,t42,t36,t55,t41,t19,t59,t25,t69,t82,t75,t84,t92, + t31,t98,t74,t101,t89,t106,t112,t113,t13,t117,t126,t127,t129, + t130,t133,t128,t132,t134,t137,t139,t146,t148,t149,t153,t131, + t160,t171,t169,t161,t182,t168,t144,t186,t150,t208,t201,t210, + t219,t156,t225,t200,t228,t215,t233,t239,t240,t138,t244 * * common blocks: * #include "ff.h" * #] declarations: * #[ set up pointers: if ( ldel2s .and. ivert .ne. 1 ) goto 100 is1 = ivert is2 = ivert+1 if ( is2 .eq. 4 ) is2 = 1 is3 = ivert-1 if ( is3 .eq. 0 ) is3 = 3 ip1 = is1 + 3 ip2 = is2 + 3 ip3 = is3 + 3 * #] set up pointers: * #[ xk = 0: if ( xpi(ip1) .eq. 0 ) then isoort(2) = 0 if ( piDpj(is1,ip1) .eq. 0 ) then isoort(1) = 0 return endif isoort(1) = 1 y(1) = etami(is2) / piDpj(is1,ip1) /2 y(2) = y(1) y(3) = - etami(is1) / piDpj(is1,ip1) /2 y(4) = y(3) z(1) = xpi(is2) / piDpj(is1,ip1) /2 z(2) = z(1) z(3) = - xpi(is1) / piDpj(is1,ip1) /2 z(4) = z(3) dyz(1,1) = - etalam / piDpj(is1,ip1) /2 dyz(1,2) = dyz(1,1) dyz(2,1) = dyz(1,1) dyz(2,2) = dyz(1,1) ier1 = ier do 10 i=1,3,2 dy2z(i) = y(i) - 2*z(i) smax = abs(y(i)) dy2z(i+1) = dy2z(i) 10 continue ier = ier1 return endif * #] xk = 0: * #[ get y(1,2),z(1,2): if ( sdel2s .eq. 0 ) then isoort(1) = 2 isoort(2) = 2 z(1) = piDpj(ip1,is2)/xpi(ip1) z(2) = z(1) else isoort(1) = 1 isoort(2) = 1 call ffroot(z(1),z(2),xpi(ip1),piDpj(ip1,is2),xpi(is2), + sdel2s,ier) endif disc = delps/sdel2p call ffroot(y(1),y(2),xpi(ip1),piDpj(ip1,is2),etami(is2),disc, + ier) * #] get y(1,2),z(1,2): * #[ get y(3,4),z(3,4): if ( isoort(1) .eq. 2 ) then z(3) = -piDpj(ip1,is1)/xpi(ip1) z(4) = z(3) else z(3) = 1-z(1) z(4) = 1-z(2) if ( abs(z(3)) .lt. xloss .or. abs(z(4)) .lt. xloss ) + call ffroot(z(4),z(3),xpi(ip1),-piDpj(ip1,is1), + xpi(is1),sdel2s,ier) endif y(3) = 1-y(1) y(4) = 1-y(2) if ( abs(y(3)) .lt. xloss .or. abs(y(4)) .lt. xloss ) then call ffroot(y(4),y(3),xpi(ip1),-piDpj(ip1,is1), + etami(is1),disc,ier) endif * #] get y(3,4),z(3,4): * #[ get dyz: * Note that dyz(i,j) only exists for i,j=1,2! if ( isoort(1) .eq. 2 ) then dyz(2,1) = disc/xpi(ip1) dyz(2,2) = dyz(2,1) elseif ( disc .gt. 0 .eqv. sdel2s .gt. 0 ) then dyz(2,1) = ( disc + sdel2s )/xpi(ip1) dyz(2,2) = etalam/(xpi(ip1)*dyz(2,1)) else dyz(2,2) = ( disc - sdel2s )/xpi(ip1) dyz(2,1) = etalam/(xpi(ip1)*dyz(2,2)) endif dyz(1,1) = -dyz(2,2) dyz(1,2) = -dyz(2,1) d2yzz = 2*disc/xpi(ip1) * * these are very rarely needed, but ... * iwarn = 0 ier1 = ier do 20 i=1,4 j = 2*((i+1)/2) dy2z(i) = y(j) - 2*z(i) smax = abs(y(j)) if ( abs(dy2z(i)) .lt. xloss*smax ) then if ( i/2 .eq. 1 ) then s = -y(j-1) - 2*sdel2s/xpi(ip1) else s = -y(j-1) + 2*sdel2s/xpi(ip1) endif if ( abs(y(j-1)) .lt. smax ) then dy2z(i) = s smax = abs(y(j-1)) endif if ( abs(dy2z(i)) .lt. xloss*smax ) then if ( iwarn .ne. 0 ) then else iwarn = i xmax = smax endif endif endif 20 continue if ( iwarn .ne. 0 ) then * * we should import the differences, but later... * if ( abs(dpipj(is3,ip1)) .lt. xloss*xpi(is3) + .and. abs(dpipj(is1,is2)) .lt. xloss*abs(xpi(ip1))) then * * give it another try - multiply roots (see dy2z.frm) * if ( iwarn.lt.3 ) then *prod1= * som(1)=+160*xpi(ip1)*xpi(ip2)*xpi(is2)*piDpj(ip1,ip2)**2* * + dpipj(is2,is1)**2 * som(2)=-40*xpi(ip1)*xpi(ip2)*piDpj(ip1,ip2)*piDpj(ip2, * + is2)*dpipj(is2,is1)**3 * som(3)=-32*xpi(ip1)*xpi(ip2)*piDpj(ip1,ip2)**2*dpipj(is2, * + is1)**3 * som(4)=+9*xpi(ip1)*xpi(ip2)**2*dpipj(is2,is1)**4 * som(5)=-128*xpi(ip1)*xpi(is2)*piDpj(ip1,ip2)**3*piDpj(ip2, * + is2)*dpipj(is2,is1) * som(6)=-128*xpi(ip1)*xpi(is2)*piDpj(ip1,ip2)**4*dpipj(is2, * + is1) * som(7)=+256*xpi(ip1)*xpi(is2)**2*piDpj(ip1,ip2)**4 * som(8)=-16*xpi(ip1)*piDpj(ip1,ip2)**2*piDpj(ip2,is2)**2* * + dpipj(is2,is1)**2 * som(9)=+96*xpi(ip1)*piDpj(ip1,ip2)**3*piDpj(ip2,is2)*dpipj(is2, * + is1)**2 * som(10)=+128*xpi(ip1)**2*xpi(ip2)*xpi(is2)*piDpj(ip1,ip2)*piDpj( * + ip2,is2)*dpipj(is2,is1) * som(11)=+320*xpi(ip1)**2*xpi(ip2)*xpi(is2)*piDpj(ip1,ip2)**2* * + dpipj(is2,is1) * som(12)=-512*xpi(ip1)**2*xpi(ip2)*xpi(is2)**2*piDpj(ip1,ip2)**2 * som(13)=-120*xpi(ip1)**2*xpi(ip2)*piDpj(ip1,ip2)*piDpj(ip2, * + is2)*dpipj(is2,is1)**2 * som(14)=-48*xpi(ip1)**2*xpi(ip2)*piDpj(ip1,ip2)**2*dpipj(is2, * + is1)**2 * som(15)=+40*xpi(ip1)**2*xpi(ip2)*piDpj(ip2,is2)**2*dpipj(is2, * + is1)**2 * som(16)=-96*xpi(ip1)**2*xpi(ip2)**2*xpi(is2)*dpipj(is2,is1)**2 * som(17)=+36*xpi(ip1)**2*xpi(ip2)**2*dpipj(is2,is1)**3 * som(18)=+128*xpi(ip1)**2*xpi(is2)*piDpj(ip1,ip2)**2*piDpj(ip2, * + is2)**2 * som(19)=-128*xpi(ip1)**2*xpi(is2)*piDpj(ip1,ip2)**3*piDpj(ip2, * + is2) * som(20)=-64*xpi(ip1)**2*xpi(is2)*piDpj(ip1,ip2)**4 * som(21)=-32*xpi(ip1)**2*piDpj(ip1,ip2)*piDpj(ip2,is2)**3* * + dpipj(is2,is1) * som(22)=-32*xpi(ip1)**2*piDpj(ip1,ip2)**2*piDpj(ip2,is2)**2* * + dpipj(is2,is1) * som(23)=+96*xpi(ip1)**2*piDpj(ip1,ip2)**3*piDpj(ip2,is2)* * + dpipj(is2,is1) * som(24)=+128*xpi(ip1)**3*xpi(ip2)*xpi(is2)*piDpj(ip1,ip2)*piDpj( * + ip2,is2) * som(25)=+160*xpi(ip1)**3*xpi(ip2)*xpi(is2)*piDpj(ip1,ip2)**2 * som(26)=-128*xpi(ip1)**3*xpi(ip2)*xpi(is2)*piDpj(ip2,is2)**2 * som(27)=+32*xpi(ip1)**3*xpi(ip2)*piDpj(ip1,ip2)*piDpj(ip2, * + is1)*piDpj(ip2,is2) * som(28)=-120*xpi(ip1)**3*xpi(ip2)*piDpj(ip1,ip2)*piDpj(ip2, * + is2)*dpipj(is2,is1) * som(29)=-32*xpi(ip1)**3*xpi(ip2)*piDpj(ip1,ip2)**2*dpipj(is2, * + is1) * som(30)=-16*xpi(ip1)**3*xpi(ip2)*piDpj(ip2,is1)*piDpj(ip2, * + is2)**2 * som(31)=+80*xpi(ip1)**3*xpi(ip2)*piDpj(ip2,is2)**2*dpipj(is2, * + is1) * som(32)=-192*xpi(ip1)**3*xpi(ip2)**2*xpi(is2)*dpipj(is2,is1) * som(33)=+256*xpi(ip1)**3*xpi(ip2)**2*xpi(is2)**2 * som(34)=+54*xpi(ip1)**3*xpi(ip2)**2*dpipj(is2,is1)**2 * som(35)=-16*xpi(ip1)**3*xpi(ip3)*piDpj(ip1,ip2)*piDpj(ip2, * + is1)*piDpj(ip2,is2) * som(36)=+8*xpi(ip1)**3*xpi(ip3)*piDpj(ip2,is1)*piDpj(ip2,is2)**2 * som(37)=+16*xpi(ip1)**3*xpi(is2)*piDpj(ip1,ip2)*piDpj(ip2, * + is1)*piDpj(ip2,is2) * som(38)=-8*xpi(ip1)**3*xpi(is2)*piDpj(ip2,is1)*piDpj(ip2,is2)**2 * som(39)=-16*xpi(ip1)**3*piDpj(ip1,ip2)*piDpj(ip2,is1)*piDpj(ip2, * + is2)*dpipj(is3,ip1) * som(40)=+8*xpi(ip1)**3*piDpj(ip2,is1)*piDpj(ip2,is2)**2* * + dpipj(is3,ip1) * som(41)=-40*xpi(ip1)**4*xpi(ip2)*piDpj(ip1,ip2)*piDpj(ip2,is2) * som(42)=-8*xpi(ip1)**4*xpi(ip2)*piDpj(ip1,ip2)**2 * som(43)=+40*xpi(ip1)**4*xpi(ip2)*piDpj(ip2,is2)**2 * som(44)=-96*xpi(ip1)**4*xpi(ip2)**2*xpi(is2) * som(45)=+36*xpi(ip1)**4*xpi(ip2)**2*dpipj(is2,is1) * som(46)=+9*xpi(ip1)**5*xpi(ip2)**2 * som(47)=-8*xpi(ip2)*piDpj(ip1,ip2)**2*dpipj(is2,is1)**4 * som(48)=-64*xpi(is2)*piDpj(ip1,ip2)**4*dpipj(is2,is1)**2 * som(49)=+32*piDpj(ip1,ip2)**3*piDpj(ip2,is2)*dpipj(is2,is1)**3 * print '(7g20.12)',(som(i),i=1,49) * * optimized by Maple (see ffxxyz.map) * t1 = xpi(ip1) t2 = xpi(ip2) t3 = t1*t2 t4 = xpi(is2) t5 = piDpj(ip1,ip2) t6 = t5**2 t7 = t4*t6 t8 = dpipj(is2,is1) t9 = t8**2 som(1) = 160*t3*t7*t9 t12 = piDpj(ip2,is2) t13 = t5*t12 t14 = t9*t8 som(2) = -40*t3*t13*t14 som(3) = -32*t3*t6*t14 t19 = t2**2 t21 = t9**2 som(4) = 9*t1*t19*t21 t23 = t1*t4 t24 = t6*t5 t25 = t24*t12 som(5) = -128*t23*t25*t8 t28 = t6**2 som(6) = -128*t23*t28*t8 t31 = t4**2 som(7) = 256*t1*t31*t28 t35 = t12**2 t36 = t35*t9 som(8) = -16*t1*t6*t36 som(9) = 96*t1*t24*t12*t9 t41 = t1**2 t42 = t41*t2 t44 = t13*t8 som(10) = 128*t42*t4*t44 som(11) = 320*t42*t7*t8 som(12) = -512*t42*t31*t6 som(13) = -120*t42*t13*t9 som(14) = -48*t42*t6*t9 som(15) = 40*t42*t36 t55 = t41*t19 som(16) = -96*t55*t4*t9 som(17) = 36*t55*t14 t59 = t41*t4 som(18) = 128*t59*t6*t35 som(19) = -128*t59*t25 som(20) = -64*t59*t28 som(21) = -32*t41*t5*t35*t12*t8 t69 = t35*t8 som(22) = -32*t41*t6*t69 som(23) = 96*t41*t24*t12*t8 t74 = t41*t1 t75 = t74*t2 som(24) = 128*t75*t4*t5*t12 som(25) = 160*t75*t7 som(26) = -128*t75*t4*t35 t82 = piDpj(ip2,is1) t84 = t5*t82*t12 som(27) = 32*t75*t84 som(28) = -120*t75*t44 som(29) = -32*t75*t6*t8 t89 = t82*t35 som(30) = -16*t75*t89 som(31) = 80*t75*t69 t92 = t74*t19 som(32) = -192*t92*t4*t8 som(33) = 256*t92*t31 som(34) = 54*t92*t9 t98 = t74*xpi(ip3) som(35) = -16*t98*t84 som(36) = 8*t98*t89 t101 = t74*t4 som(37) = 16*t101*t84 som(38) = -8*t101*t89 t106 = dpipj(is3,ip1) som(39) = -16*t74*t5*t82*t12*t106 som(40) = 8*t74*t82*t35*t106 t112 = t41**2 t113 = t112*t2 som(41) = -40*t113*t13 som(42) = -8*t113*t6 som(43) = 40*t113*t35 t117 = t112*t19 som(44) = -96*t117*t4 som(45) = 36*t117*t8 som(46) = 9*t112*t1*t19 som(47) = -8*t2*t6*t21 som(48) = -64*t4*t28*t9 som(49) = 32*t25*t14 * print '(7g20.12)',(som(i),i=1,49) n=49 else *prod3= * som(1)=+160*xpi(ip1)*xpi(ip2)*xpi(is2)*piDpj(ip1,ip2)**2* * + dpipj(is2,is1)**2 * som(2)=-40*xpi(ip1)*xpi(ip2)*piDpj(ip1,ip2)*piDpj(ip2, * + is2)*dpipj(is2,is1)**3 * som(3)=-88*xpi(ip1)*xpi(ip2)*piDpj(ip1,ip2)**2*dpipj(is2, * + is1)**3 * som(4)=+9*xpi(ip1)*xpi(ip2)**2*dpipj(is2,is1)**4 * som(5)=-128*xpi(ip1)*xpi(is2)*piDpj(ip1,ip2)**3*piDpj(ip2, * + is2)*dpipj(is2,is1) * som(6)=-256*xpi(ip1)*xpi(is2)*piDpj(ip1,ip2)**4*dpipj(is2,is1) * som(7)=+256*xpi(ip1)*xpi(is2)**2*piDpj(ip1,ip2)**4 * som(8)=-16*xpi(ip1)*piDpj(ip1,ip2)**2*piDpj(ip2,is2)**2*dpipj( * + is2,is1)**2 * som(9)=+64*xpi(ip1)*piDpj(ip1,ip2)**3*piDpj(ip2,is2)*dpipj(is2, * + is1)**2 * som(10)=+80*xpi(ip1)*piDpj(ip1,ip2)**4*dpipj(is2,is1)**2 * som(11)=+128*xpi(ip1)**2*xpi(ip2)*xpi(is2)*piDpj(ip1,ip2)*piDpj( * + ip2,is2)*dpipj(is2,is1) * som(12)=+576*xpi(ip1)**2*xpi(ip2)*xpi(is2)*piDpj(ip1,ip2)**2* * + dpipj(is2,is1) * som(13)=-512*xpi(ip1)**2*xpi(ip2)*xpi(is2)**2*piDpj(ip1,ip2)**2 * som(14)=-88*xpi(ip1)**2*xpi(ip2)*piDpj(ip1,ip2)*piDpj(ip2, * + is2)*dpipj(is2,is1)**2 * som(15)=-192*xpi(ip1)**2*xpi(ip2)*piDpj(ip1,ip2)**2*dpipj(is2, * + is1)**2 * som(16)=+40*xpi(ip1)**2*xpi(ip2)*piDpj(ip2,is2)**2*dpipj(is2, * + is1)**2 * som(17)=-96*xpi(ip1)**2*xpi(ip2)**2*xpi(is2)*dpipj(is2,is1)**2 * som(18)=+60*xpi(ip1)**2*xpi(ip2)**2*dpipj(is2,is1)**3 * som(19)=+128*xpi(ip1)**2*xpi(is2)*piDpj(ip1,ip2)**2*piDpj(ip2, * + is2)**2 * som(20)=-128*xpi(ip1)**2*xpi(is2)*piDpj(ip1,ip2)**3*piDpj(ip2, * + is2) * som(21)=-64*xpi(ip1)**2*xpi(is2)*piDpj(ip1,ip2)**4 * som(22)=-32*xpi(ip1)**2*piDpj(ip1,ip2)*piDpj(ip2,is2)**3* * + dpipj(is2,is1) * som(23)=+64*xpi(ip1)**2*piDpj(ip1,ip2)**3*piDpj(ip2,is2)* * + dpipj(is2,is1) * som(24)=+32*xpi(ip1)**2*piDpj(ip1,ip2)**4*dpipj(is2,is1) * som(25)=+128*xpi(ip1)**3*xpi(ip2)*xpi(is2)*piDpj(ip1,ip2)*piDpj( * + ip2,is2) * som(26)=+160*xpi(ip1)**3*xpi(ip2)*xpi(is2)*piDpj(ip1,ip2)**2 * som(27)=-128*xpi(ip1)**3*xpi(ip2)*xpi(is2)*piDpj(ip2,is2)**2 * som(28)=+32*xpi(ip1)**3*xpi(ip2)*piDpj(ip1,ip2)*piDpj(ip2, * + is1)*piDpj(ip2,is2) * som(29)=-88*xpi(ip1)**3*xpi(ip2)*piDpj(ip1,ip2)*piDpj(ip2, * + is2)*dpipj(is2,is1) * som(30)=-88*xpi(ip1)**3*xpi(ip2)*piDpj(ip1,ip2)**2*dpipj(is2, * + is1) * som(31)=-16*xpi(ip1)**3*xpi(ip2)*piDpj(ip2,is1)*piDpj(ip2, * + is2)**2 * som(32)=+48*xpi(ip1)**3*xpi(ip2)*piDpj(ip2,is2)**2*dpipj(is2, * + is1) * som(33)=-320*xpi(ip1)**3*xpi(ip2)**2*xpi(is2)*dpipj(is2,is1) * som(34)=+256*xpi(ip1)**3*xpi(ip2)**2*xpi(is2)**2 * som(35)=+118*xpi(ip1)**3*xpi(ip2)**2*dpipj(is2,is1)**2 * som(36)=-16*xpi(ip1)**3*xpi(ip3)*piDpj(ip1,ip2)*piDpj(ip2, * + is1)*piDpj(ip2,is2) * som(37)=+8*xpi(ip1)**3*xpi(ip3)*piDpj(ip2,is1)*piDpj(ip2,is2)**2 * som(38)=+16*xpi(ip1)**3*xpi(is2)*piDpj(ip1,ip2)*piDpj(ip2, * + is1)*piDpj(ip2,is2) * som(39)=-8*xpi(ip1)**3*xpi(is2)*piDpj(ip2,is1)*piDpj(ip2,is2)**2 * som(40)=-16*xpi(ip1)**3*piDpj(ip1,ip2)*piDpj(ip2,is1)*piDpj(ip2, * + is2)*dpipj(is3,ip1) * som(41)=+8*xpi(ip1)**3*piDpj(ip2,is1)*piDpj(ip2,is2)**2* * + dpipj(is3,ip1) * som(42)=-40*xpi(ip1)**4*xpi(ip2)*piDpj(ip1,ip2)*piDpj(ip2,is2) * som(43)=-8*xpi(ip1)**4*xpi(ip2)*piDpj(ip1,ip2)**2 * som(44)=+40*xpi(ip1)**4*xpi(ip2)*piDpj(ip2,is2)**2 * som(45)=-96*xpi(ip1)**4*xpi(ip2)**2*xpi(is2) * som(46)=+60*xpi(ip1)**4*xpi(ip2)**2*dpipj(is2,is1) * som(47)=+9*xpi(ip1)**5*xpi(ip2)**2 * som(48)=-8*xpi(ip2)*piDpj(ip1,ip2)**2*dpipj(is2,is1)**4 * som(49)=-64*xpi(is2)*piDpj(ip1,ip2)**4*dpipj(is2,is1)**2 * som(50)=+32*piDpj(ip1,ip2)**3*piDpj(ip2,is2)*dpipj(is2,is1)**3 * som(51)=+32*piDpj(ip1,ip2)**4*dpipj(is2,is1)**3 * print '(7g20.12)',(som(i),i=1,51) * * optimized by Maple (see ffxxyz.map) * t126 = xpi(ip1) t127 = xpi(ip2) t128 = t126*t127 t129 = xpi(is2) t130 = piDpj(ip1,ip2) t131 = t130**2 t132 = t129*t131 t133 = dpipj(is2,is1) t134 = t133**2 som(1) = 160*t128*t132*t134 t137 = piDpj(ip2,is2) t138 = t130*t137 t139 = t134*t133 som(2) = -40*t128*t138*t139 som(3) = -88*t128*t131*t139 t144 = t127**2 t146 = t134**2 som(4) = 9*t126*t144*t146 t148 = t126*t129 t149 = t131*t130 t150 = t149*t137 som(5) = -128*t148*t150*t133 t153 = t131**2 som(6) = -256*t148*t153*t133 t156 = t129**2 som(7) = 256*t126*t156*t153 t160 = t137**2 t161 = t160*t134 som(8) = -16*t126*t131*t161 som(9) = 64*t126*t149*t137*t134 som(10) = 80*t126*t153*t134 t168 = t126**2 t169 = t168*t127 t171 = t138*t133 som(11) = 128*t169*t129*t171 som(12) = 576*t169*t132*t133 som(13) = -512*t169*t156*t131 som(14) = -88*t169*t138*t134 som(15) = -192*t169*t131*t134 som(16) = 40*t169*t161 t182 = t168*t144 som(17) = -96*t182*t129*t134 som(18) = 60*t182*t139 t186 = t168*t129 som(19) = 128*t186*t131*t160 som(20) = -128*t186*t150 som(21) = -64*t186*t153 som(22) = -32*t168*t130*t160*t137*t133 som(23) = 64*t168*t149*t137*t133 som(24) = 32*t168*t153*t133 t200 = t168*t126 t201 = t200*t127 som(25) = 128*t201*t129*t130*t137 som(26) = 160*t201*t132 som(27) = -128*t201*t129*t160 t208 = piDpj(ip2,is1) t210 = t130*t208*t137 som(28) = 32*t201*t210 som(29) = -88*t201*t171 som(30) = -88*t201*t131*t133 t215 = t208*t160 som(31) = -16*t201*t215 som(32) = 48*t201*t160*t133 t219 = t200*t144 som(33) = -320*t219*t129*t133 som(34) = 256*t219*t156 som(35) = 118*t219*t134 t225 = t200*xpi(ip3) som(36) = -16*t225*t210 som(37) = 8*t225*t215 t228 = t200*t129 som(38) = 16*t228*t210 som(39) = -8*t228*t215 t233 = dpipj(is3,ip1) som(40) = -16*t200*t130*t208*t137*t233 som(41) = 8*t200*t208*t160*t233 t239 = t168**2 t240 = t239*t127 som(42) = -40*t240*t138 som(43) = -8*t240*t131 som(44) = 40*t240*t160 t244 = t239*t144 som(45) = -96*t244*t129 som(46) = 60*t244*t133 som(47) = 9*t239*t126*t144 som(48) = -8*t127*t131*t146 som(49) = -64*t129*t153*t134 som(50) = 32*t150*t139 som(51) = 32*t153*t139 * print '(7g20.12)',(som(i),i=1,51) n=51 endif * s = 0 smax = 0 do 30 j=1,n s = s + som(j) smax = max(smax,som(j)) 30 continue if ( iwarn .lt. 3 ) then hulp = 1/(16*xpi(ip1)**3*sdel2p**4*dy2z(3-iwarn)* + (y(1)-2*z(1))*(y(1)-2*z(2))) else hulp = 1/(16*xpi(ip1)**3*sdel2p**4*dy2z(7-iwarn)* + (y(3)-2*z(3))*(y(3)-2*z(4))) endif s = s*hulp smax = smax*hulp if ( smax .lt. xmax ) then dy2z(iwarn) = s xmax = smax endif else n=0 endif endif ier = ier1 * goto 200 * #] get dyz: * #[ special case, get indices: 100 continue if ( ivert.eq.2 ) then is1 = 2 ip1 = 5 else is1 = 1 ip1 = 6 endif * #] special case, get indices: * #[ xk = 0: if ( xpi(ip1) .eq. 0 ) then call fferr(88,ier) endif * #] xk = 0: * #[ get ypm,zpm: * * special case del2s = 0, hence the roots are not the real roots * but z_2'' = (z_2'-1)/delta, z''_3 = -z'_3/delta * hulp = sdel2s disc = delps/sdel2p if ( ivert .eq. 3 ) then hulp = -hulp disc = -disc endif if ( sdel2s .eq. 0 ) then isoort(1) = 102 isoort(2) = 102 z(1) = piDpj(is1,3)/xpi(3) z(2) = z(1) else isoort(1) = 101 isoort(2) = 101 call ffroot(z(1),z(2),xpi(3),piDpj(is1,3),xpi(is1),hulp,ier) endif call ffroot(y(1),y(2),xpi(3),piDpj(is1,3),etami(is1),disc,ier) * #] get ypm,zpm: * #[ get ypm1,zpm1: z(3) = 1 - z(1) z(4) = 1 - z(2) if ( abs(z(3)).lt.xloss .or. abs(z(4)).lt.xloss ) then if ( ivert.eq.2 ) then call ffroot(z(4),z(3),xpi(3),piDpj(ip1,3),xpi(ip1),hulp, + ier) else call ffroot(z(4),z(3),xpi(3),-piDpj(ip1,3),xpi(ip1),hulp + ,ier) endif endif y(3) = 1 - y(1) y(4) = 1 - y(2) if ( abs(y(3)) .lt. xloss .or. abs(y(4)) .lt. xloss ) then if ( ivert .eq. 2 ) then call ffroot(y(4),y(3),xpi(3),piDpj(ip1,3),etami(ip1), + disc,ier) else call ffroot(y(4),y(3),xpi(3),-piDpj(ip1,3),etami(ip1), + disc,ier) endif endif * #] get ypm1,zpm1: * #[ get dypzp, dypzm: if ( isoort(1) .eq. 2 ) then dyz(2,1) = disc/xpi(3) dyz(2,2) = dyz(2,1) elseif ( disc .gt. 0 .eqv. sdel2s .gt. 0 ) then dyz(2,1) = ( disc + hulp )/xpi(3) dyz(2,2) = etalam/(xpi(3)*dyz(2,1)) else dyz(2,2) = ( disc - hulp )/xpi(3) dyz(2,1) = etalam/(xpi(3)*dyz(2,2)) endif dyz(1,1) = -dyz(2,2) dyz(1,2) = -dyz(2,1) d2yzz = 2*disc/xpi(3) * * these are very rarely needed, but ... * do 220 i=1,4 j = 2*((i+1)/2) dy2z(i) = y(j) - 2*z(i) smax = abs(y(j)) 220 continue * #] get dypzp, dypzm: 200 continue *###] ffxxyz: end *###[ ffdwz: subroutine ffdwz(dwz,z,i1,j1,l,alpha,alph1,xpi,dpipj,piDpj, + sdel2i,ns,ier) ***#[*comment:*********************************************************** * * * Recalculate dwz(i1,j1) = w(i1) - z(j1) * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments: * integer i1,j1,l,ns,ier RealType dwz(2,2),z(4) RealType alpha,alph1,xpi(ns),dpipj(ns,ns),piDpj(ns,ns), + sdel2i(3) * * local variables: * RealType s(8),ssum,fac,xmax integer i * * common blocks: * #include "ff.h" * #] declarations: * #[ calculations: if ( l .eq. 1 ) then ier = ier + 100 elseif ( l .eq. 3 ) then if ( (i1.eq.2 .and. j1.eq.1) .or. (i1.eq.1 .and. j1.eq.2) ) + then fac = 1D0/(sdel2i(2) + sdel2i(3)) s(1) = dpipj(6,5)*z(j1) s(2) = -alph1*xpi(5)*z(j1+2) if ( max(abs(dpipj(2,1)),abs(dpipj(5,6))) .lt. + max(abs(dpipj(2,6)),abs(dpipj(5,1))) ) then s(3) = .5D0*dpipj(2,1) s(4) = .5D0*dpipj(5,6) else s(3) = .5D0*dpipj(2,6) s(4) = .5D0*dpipj(5,1) endif s(5) = piDpj(4,3)*piDpj(5,3)*fac s(6) = -piDpj(4,3)*piDpj(6,3)*fac s(7) = xpi(3)*dpipj(5,6)*fac if ( i1 .eq. 1 ) then ssum = s(1)+s(2)+s(3)+s(4) - (s(5)+s(6)+s(7)) else ssum = s(1)+s(2)+s(3)+s(4) + s(5)+s(6)+s(7) endif xmax = abs(s(1)) do 10 i=2,7 xmax = max(xmax,abs(s(i))) 10 continue if ( abs(ssum) .lt. xloss*xmax ) then * this result is not used if it is not accurate (see * ffxc0p) ier = ier + 1 xmax = xmax/abs(alpha*xpi(5)) dwz(i1,j1) = ssum/(alpha*xpi(5)) else dwz(i1,j1) = ssum/(alpha*xpi(5)) endif else ier = ier + 100 endif endif * #] calculations: *###] ffdwz: end LoopTools-2.16/src/util/PaxHeaders/fftran.F0000644000000000000000000000007411776502523015622 xustar0030 atime=1648161785.707698331 30 ctime=1648161793.715764879 LoopTools-2.16/src/util/fftran.F0000644000000000000000000004656411776502523016554 0ustar00rootroot00000000000000#include "externals.h" #include "types.h" *###[ ffai: subroutine ffai(ai,daiaj,aai,laai,del2s,sdel2s,xpi,dpipj,piDpj, + ier) ***#[*comment:*********************************************************** * * * calculates the coefficients of the projective transformation * * * * xi = ai*ui / (som aj*uj ) * * * * such that the coefficients of z^2, z*x and z*y vanish: * * * * a2/a1 = ( lij +/- lam1/2(xp1,xm1,xm2) ) / (2*xm2) * * a3 = ( xm2*a2 - xm1*a1 ) / ( xl23*a2 - xl13*a1 ) * * a4 = ( xm2*a2 - xm1*a1 ) / ( xl24*a2 - xl14*a1 ) * * * * the differences ai-aj = daiaj(i,j) are also evaluated. * * * * Input: del2s real delta(s3,s4,s3,s4) * * sdel2s real sqrt(-del2s) * * xpi(10) real masses, momenta^2 * * dpipj(10,10 real xpi(i) - xpi(j) * * piDpj(10,10) real dotproducts * * * * Output: ai(4) real Ai of the transformation * * daiaj(4,4) real Ai-Aj * * aai(4) real the other roots * * laai logical if .TRUE. aai are defined * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments * integer ier logical laai RealType ai(4),daiaj(4,4),aai(4),del2s,sdel2s,xpi(10), + dpipj(10,10),piDpj(10,10) * * local variables * integer i,j,ier0,ier1,ier2 RealType del2sa,del2sb,del3mi(2),aim(4),aaim(4),delps, + del3m(1),dum,da2a1m,da1a3m,da1a4m,da2a3m,da2a4m,da3a4m * for debugging purposes ComplexType ca1m * * common blocks * #include "ff.h" * * #] declarations: * #[ get ai: * * A4: some arbitrary normalisation ... * ai(4) = 1 aai(4) = 1 ier2 = ier if ( del2s .ne. 0 ) then * * A3: simple solution of quadratic equation * ier0 = ier call ffroot(aaim(3),aim(3),xpi(4),piDpj(4,3),xpi(3), + sdel2s,ier0) ier2 = max(ier2,ier0) if ( aim(3) .eq. 0 ) then * choose the other root ier = ier + 100 return endif ai(3) = ai(4)/aim(3) if ( aaim(3) .ne. 0 ) then laai = .TRUE. aai(3) = aai(4)/aaim(3) else laai = .FALSE. endif * * A2: a bit more complicated quadratic equation * ier1 = ier ier0 = ier call ffdl2s(del2sa,piDpj, 2,4,10,1, 3,4,7,1, 10) ier1 = max(ier1,ier0) ier0 = ier call ffdl3m(del3mi(2),.FALSE.,0D0,0D0,xpi,dpipj,piDpj,10, + 3,4,7, 2,1) ier1 = max(ier1,ier0) call ffroot(aim(2),aaim(2),xpi(4),piDpj(4,2),del3mi(2)/del2s + ,del2sa/sdel2s,ier1) ier2 = max(ier2,ier1) if ( aim(2) .eq. 0 ) then ier = ier + 100 return endif ai(2) = ai(4)/aim(2) if ( laai ) then if ( aaim(2) .eq. 0 ) then laai = .FALSE. else aai(2) = aai(4)/aaim(2) endif endif * * A1: same as A2, except for the special nasty case. * if ( .not.lnasty ) then ier0 = ier ier1 = ier call ffdl2s(del2sb,piDpj, 1,4,8,-1, 3,4,7,1, 10) ier1 = max(ier1,ier0) ier0 = ier call ffdl3m(del3mi(1),.FALSE.,0D0,0D0,xpi,dpipj,piDpj,10, + 3,4,7, 1,1) ier1 = max(ier1,ier0) call ffroot(aim(1),aaim(1),xpi(4),piDpj(4,1),del3mi(1)/del2s + ,del2sb/sdel2s,ier1) ier2 = max(ier2,ier1) if ( aim(1) .eq. 0 ) then ier = ier + 100 return endif ai(1) = ai(4)/aim(1) if ( laai ) then if ( aaim(1) .eq. 0 ) then laai = .FALSE. else aai(1) = aai(4)/aaim(1) endif endif else laai = .FALSE. ca1m = (c2sisj(1,4) - (c2sisj(1,3)*Re(xpi(4)) - + c2sisj(1,4)*Re(piDpj(3,4)))/Re(sdel2s))/ + Re(2*xpi(4)) ca1 = Re(ai(4))/ca1m ai(1) = ai(4)/Re(ca1m) endif else * * the special case del2s=0 with xpi(3)=xpi(4),xpi(7)=0 * laai = .FALSE. ai(3) = ai(4) if ( piDpj(7,2) .eq. 0 .or. piDpj(7,1) .eq. 0 ) then call fferr(55,ier) return endif ai(2) = ai(4)*xpi(3)/piDpj(7,2) ai(1) = ai(4)*xpi(3)/piDpj(7,1) endif ier = ier2 * #] get ai: * #[ get daiaj: ier2 = ier do 120 i=1,4 daiaj(i,i) = 0 do 110 j=i+1,4 daiaj(j,i) = ai(j) - ai(i) if ( abs(daiaj(j,i)) .ge. xloss*abs(ai(i)) ) goto 105 if ( del2s .eq. 0 ) then * #[ del2s=0: if ( i .eq. 1 .and. j .eq. 2 ) then daiaj(2,1) = -ai(1)*ai(2)*piDpj(5,7)/xpi(3) goto 104 elseif ( i .eq. 3 .and. j .eq. 4 ) then daiaj(4,3) = 0 goto 104 endif ier1 = ier call ffwarn(146,ier1,daiaj(j,i),ai(i)) goto 105 * #] del2s=0: elseif ( lnasty .and. i.eq.1 ) then ier1 = ier call ffwarn(146,ier1,daiaj(j,i),ai(i)) goto 105 endif ier0 = ier if ( i .eq. 1 .and. j .eq. 2 ) then * #[ daiaj(2,1): * * some determinants (as usual) * * as the vertex p1,s4,? does not exist we use ffdl2t * call ffdl2t(delps,piDpj, 5,4, 3,4,7,1,+1, 10) ier1 = max(ier1,ier0) ier0 = ier call ffdl3m(del3m,.FALSE.,0D0,0D0,xpi,dpipj,piDpj, + 10, 3,4,7, 5,1) ier1 = max(ier1,ier0) call ffroot(dum,da2a1m,xpi(4),piDpj(4,5), + del3m(1)/del2s,-delps/sdel2s,ier1) daiaj(2,1) = -ai(1)*ai(2)*da2a1m goto 104 * #] daiaj(2,1): elseif ( i .eq. 1 .and. j .eq. 3 ) then * #[ daiaj(3,1): * * Again, the solution of a simple quadratic equation * call ffdl2t(delps,piDpj, 9,4, 3,4,7,1,+1, 10) ier1 = ier0 ier0 = ier call ffdl3m(del3m,.FALSE.,0D0,0D0,xpi,dpipj,piDpj, + 10, 3,4,7, 9,1) ier1 = max(ier1,ier0) call ffroot(dum,da1a3m,xpi(4),-piDpj(4,9), + del3m(1)/del2s,delps/sdel2s,ier1) daiaj(3,1) = -ai(1)*ai(3)*da1a3m goto 104 * #] daiaj(3,1): elseif ( i .eq. 1 .and. j .eq. 4 ) then * #[ daiaj(4,1): * * Again, the solution of a simple quadratic equation * call ffdl2s(delps,piDpj,4,1,8,1,3,4,7,1,10) ier1 = ier0 ier0 = ier call ffdl3m(del3m,.FALSE.,0D0,0D0,xpi,dpipj,piDpj, + 10, 3,4,7, 8,1) ier1 = max(ier0,ier1) call ffroot(dum,da1a4m,xpi(4),piDpj(4,8),del3m(1)/ + del2s,delps/sdel2s,ier1) daiaj(4,1) = ai(1)*ai(4)*da1a4m goto 104 * #] daiaj(4,1): elseif ( i .eq. 2 .and. j .eq. 3 ) then * #[ daiaj(3,2): * * Again, the solution of a simple quadratic equation * call ffdl2t(delps,piDpj, 6,4, 3,4,7,1,+1, 10) ier1 = ier0 ier0 = ier call ffdl3m(del3m,.FALSE.,0D0,0D0,xpi,dpipj,piDpj, + 10, 3,4,7, 6,1) ier1 = max(ier1,ier0) call ffroot(dum,da2a3m,xpi(4),-piDpj(4,6), + del3m(1)/del2s,delps/sdel2s,ier1) daiaj(3,2) = ai(2)*ai(3)*da2a3m goto 104 * #] daiaj(3,2): elseif ( i .eq. 2 .and. j .eq. 4 ) then * #[ daiaj(4,2): * * Again, the solution of a simple quadratic equation * call ffdl2s(delps,piDpj,2,4,10,1,3,4,7,1,10) ier1 = ier0 ier0 = ier call ffdl3m(del3m,.FALSE.,0D0,0D0,xpi,dpipj,piDpj, + 10, 3,4,7, 10,1) ier1 = max(ier0,ier1) call ffroot(dum,da2a4m,xpi(4),piDpj(4,10),del3m(1)/ + del2s,delps/sdel2s,ier1) daiaj(4,2) = -ai(2)*ai(4)*da2a4m goto 104 * #] daiaj(4,2): elseif ( i .eq. 3 .and. j .eq. 4 ) then * #[ daiaj(4,3): * * Again, the solution of a very simple quadratic equation * ier1 = ier call ffroot(dum,da3a4m,xpi(4),-piDpj(4,7), + xpi(7),sdel2s,ier1) daiaj(4,3) = ai(3)*ai(4)*da3a4m goto 104 * #] daiaj(4,3): endif 104 continue 105 continue daiaj(i,j) = -daiaj(j,i) ier2 = max(ier2,ier1) 110 continue 120 continue ier = ier2 * #] get daiaj: *###] ffai: end *###[ fftran: subroutine fftran(ai,daiaj,aai,laai,xqi,dqiqj,qiDqj, + del2s,sdel2s,xpi,dpipj,piDpj,ier) ***#[*comment:*********************************************************** * * * Transform the impulses according to * * * * ti = Ai*si * * qij = (Ai*si - Aj*sj) * * * * In case del2s=0 it calculates the same coefficients but for * * for A1,A2 leave out the delta with 2*delta = 1-xpi(4)/xpi(3) * * infinitesimal. * * * * Input: ai(4) ai * * daiaj(4,4) ai-aj * * del2s \delta^{s(3) s4}_{s(3) s4} * * sdel2s sqrt(del2s) * * xpi(10) masses = s1-s2-s(3)-s4 * * dpipj(10,10) differences * * piDpj(10,10) dotproducts * * * * Output: xqi(10) transformed momenta * * dqiqj(10,10) differences * * qiDqj(10,10) dotproducts * * ier (integer) 0=ok,1=inaccurate,2=error * * * * Calls: ffxlmb,... * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments * integer ier logical laai RealType ai(4),daiaj(4,4),aai(4),xqi(10),dqiqj(10,10), + qiDqj(10,10),del2s,sdel2s,xpi(10),dpipj(10,10), + piDpj(10,10) * * local variables * integer i,j,ji,k,kj,l,lk,is,isgnji,isgnlk, + ifirst,i1,j1,k1,j2,kk,kkj,ier0,ier1,ier2 logical lgo RealType xmax,dum,delps,del2d2,dl2d22,aijk,aijkl, + smax,s(3),som * * common blocks * #include "ff.h" * ifirst = 0 * #] declarations: * #[ si.sj -> ti.tj: * * calculate the dotproducts of ti(i) = ai*si(i): no problems. * do 20 i=1,4 xqi(i) = ai(i)**2 * xpi(i) qiDqj(i,i) = xqi(i) do 10 j=i+1,4 qiDqj(j,i) = ai(j)*ai(i)*piDpj(j,i) qiDqj(i,j) = qiDqj(j,i) 10 continue 20 continue * * and the smuggled ones for the onshell complex D0 * if ( lsmug ) then do 40 j=1,3 do 30 i=i+1,4 c2sisj(i,j) = Re(ai(j)*ai(i))*c2sisj(i,j) c2sisj(j,i) = c2sisj(i,j) 30 continue 40 continue endif if ( lnasty ) then do 60 j=3,4 * * we also hide in this array the corresponding real value * in (j,2) and (2,j), and the untransformed in (j,j). * Not beuatiful, but we need these to get the correct * Riemann sheets. * c2sisj(j,j) = c2sisj(j,1) c2sisj(j,2) = ai(j)*ai(1)*Re(c2sisj(j,1)) c2sisj(2,j) = c2sisj(j,2) c2sisj(j,1) = Re(ai(j))*ca1*c2sisj(j,1) c2sisj(1,j) = c2sisj(j,1) * 60 continue endif * * #] si.sj -> ti.tj: * #[ si.pj -> ti.qj: * * The dotproducts ti.qjk are still not too bad * Notice that t3.p = t4.p, so qiDqj(3,5-10) = qiDqj(4,5-10) * ier2 = ier do 90 i=1,4 do 80 j=1,3 do 70 k=j+1,4 ier1 = ier kj = inx(k,j) is = isgn(k,j) if ( i.eq.4 .and. + (del2s.ne.0 .or. kj.eq.5 .or. kj.eq.7 )) then qiDqj(kj,4) = qiDqj(kj,3) goto 65 endif s(1) = qiDqj(k,i) s(2) = qiDqj(j,i) qiDqj(kj,i) = is*(s(1) - s(2)) if ( abs(qiDqj(kj,i)).ge.xloss*abs(s(1)) ) goto 65 ier0 = ier if ( del2s .eq. 0 ) then * * the special cases for del2s-0 * if ( kj .eq. 5 ) then call ffdl2t(delps,piDpj, 7,i, 1,2,5, 1,1,10) qiDqj(5,i) = ai(1)*ai(2)*ai(i)*delps/xpi(3) elseif ( kj .eq. 7 ) then qiDqj(kj,i) = ai(i)*ai(4)**2*piDpj(kj,i) else * * the pi has a mixed delta/no delta behaviour * call ffwarn(144,ier1,qiDqj(kj,i),s(1)) goto 65 endif goto 65 endif * * Normal case, from the quadratic equation ... * ier1 = ier0 ier0 = ier call ff2dl2(del2d2,delps,xpi,dpipj,piDpj, i, + j,k,kj,is, 4, 3,4,7,+1, 10, ier0) ier1 = max(ier1,ier0) ier0 = ier call ff2d22(dl2d22,xpi,dpipj,piDpj, i, j,k,kj,is, + 3,4,7,+1) ier1 = max(ier1,ier0) call ffroot(dum,aijk,xpi(4),delps,dl2d22/del2s, + -del2d2/sdel2s,ier1) * the minus sign is because we have aijk, not aikj. qiDqj(kj,i) = -is*aijk*ai(i)*ai(j)*ai(k) 65 continue qiDqj(i,kj) = qiDqj(kj,i) ier2 = max(ier2,ier1) 70 continue 80 continue 90 continue * #] si.pj -> ti.qj: * #[ pi.pj -> qi.qj: do 180 i=1,3 do 170 j=i+1,4 ji = inx(j,i) isgnji = isgn(j,i) do 160 k=i,3 do 150 l=k+1,4 if ( k .eq. i .and. l .lt. j ) goto 150 ier1 = ier lk = inx(l,k) isgnlk = isgn(l,k) * * Some are zero by definition, or equal to others * if ( del2s .ne. 0 .and. (ji.eq.7 .or. lk.eq.7) + .or. + del2s .eq. 0 .and. (ji.eq.7 .and. (lk.eq.7 + .or. lk.eq.5) .or. ji.eq.5 .and. lk.eq.7 + ) ) then qiDqj(lk,ji) = 0 goto 145 endif if ( j.eq.4 .and. (del2s.ne.0 .or. lk.eq.5) ) + then qiDqj(lk,ji) = isgnji*isgn(3,i)* + qiDqj(lk,inx(3,i)) goto 145 endif if ( l.eq.4 .and. (del2s.ne.0 .or. ji.eq.5) ) + then qiDqj(lk,ji) = isgnlk*isgn(3,k)* + qiDqj(inx(3,k),ji) goto 145 endif * * First normal try * if ( abs(qiDqj(k,ji)).le.abs(qiDqj(i,lk)) ) then s(1) = qiDqj(k,ji) s(2) = qiDqj(l,ji) is = isgnlk else s(1) = qiDqj(i,lk) s(2) = qiDqj(j,lk) is = isgnji endif qiDqj(lk,ji) = is*(s(2) - s(1)) if ( abs(qiDqj(lk,ji)) .ge. xloss**2*abs(s(1)) ) + goto 145 * * First the special case del2s=0 * if ( del2s .eq. 0 ) then if ( ji .eq. 5 .and. lk .eq. 5 ) then call ffdl3m(s(1),.FALSE.,0D0,0D0,xpi, + dpipj,piDpj, 10, 1,2,5, 7, 1) qiDqj(5,5) =ai(1)**2*ai(2)**2*s(1)/xpi(3 + )**2 else call ffwarn(145,ier1,qiDqj(lk,ji),s(1)) endif goto 145 endif * * Otherwise use determinants * call ffabcd(aijkl,xpi,dpipj,piDpj,del2s, + sdel2s, i,j,ji,isgnji, k,l,lk,isgnlk, + ifirst, ier1) qiDqj(lk,ji) = (isgnji*isgnlk)* + aijkl*ai(i)*ai(j)*ai(k)*ai(l) goto 145 * print *,'fftran: warning: numerical problems ', * + 'in qiDqj(',lk,ji,')' 145 continue if ( lk .ne. ji ) then qiDqj(ji,lk) = qiDqj(lk,ji) else xqi(ji) = qiDqj(lk,ji) endif ier2 = max(ier2,ier1) 150 continue 160 continue 170 continue 180 continue ier = ier2 * #] pi.pj -> qi.qj: * #[ si^2 - sj^2: * * the differences may be awkward * ier2 = ier do 140 i=1,4 dqiqj(i,i) = 0 do 130 j=i+1,4 ier0 = ier dqiqj(j,i) = xqi(j) - xqi(i) smax = abs(xqi(i)) if ( abs(dqiqj(j,i)) .ge. xloss*smax ) goto 125 if ( abs(daiaj(j,i)) .le. xloss*abs(ai(i)) ) + then s(1) = daiaj(j,i)*(ai(i)+ai(j))*xpi(j) s(2) = ai(i)**2*dpipj(j,i) som = s(1) + s(2) xmax = abs(s(1)) if ( xmax.lt.smax ) then dqiqj(j,i) = som smax = xmax endif if ( abs(dqiqj(j,i)) .ge. xloss*smax ) goto 125 endif * * give up * 125 continue dqiqj(i,j) = -dqiqj(j,i) ier2 = max(ier2,ier0) 130 continue 140 continue * #] si^2 - sj^2: * #[ si^2 - pj^2: do 210 i=1,4 do 200 j=1,4 do 190 kk=j+1,4 ier0 = ier k = kk kj = inx(k,j) kkj = kj * * Use that q_(i4)^2 = q_(i3)^2 * if ( del2s.ne.0 .and. k.eq.4 ) then if ( j .eq. 3 ) then dqiqj(7,i) = -xqi(i) else dqiqj(kj,i) = dqiqj(inx(j,3),i) endif goto 185 elseif ( kj .eq. 7 ) then dqiqj(7,i) = -xqi(i) goto 185 endif xmax = 0 181 continue som = xqi(kj) - xqi(i) if ( k.eq.kk .or. abs(xqi(i)).lt.xmax ) then dqiqj(kj,i) = som xmax = abs(xqi(i)) if ( abs(dqiqj(kj,i)) .ge. xloss*xmax ) goto 185 endif * * second try * we assume that qi.qj, i,j<=3 are known * if ( abs(dqiqj(k,i)) .lt. abs(dqiqj(j,i)) ) then j1 = k j2 = j else j2 = k j1 = j endif s(1) = dqiqj(j1,i) s(2) = xqi(j2) s(3) = -2*qiDqj(j1,j2) som = s(1) + s(2) + s(3) smax = max(abs(s(1)),abs(s(2)),abs(s(3))) if ( smax.lt.xmax ) then dqiqj(kj,i) = som xmax = smax if ( abs(dqiqj(kj,i)) .ge. xloss*xmax ) goto 185 endif * * third try: rearrange s(2),s(3) * this works if ai(j1)~ai(j2) * if ( abs(daiaj(j2,j1)) .lt. xloss*abs(ai(j1)) ) then s(2) = ai(j2)*daiaj(j2,j1)*xpi(j2) s(3) = ai(j2)*ai(j1)*dpipj(kj,j1) som = s(1) + s(2) + s(3) smax = max(abs(s(1)),abs(s(2)),abs(s(3))) if ( smax.lt.xmax ) then dqiqj(kj,i) = som xmax = smax if ( abs(dqiqj(kj,i)) .ge. xloss*xmax ) + goto 185 endif endif * * There is a trick involving the other root for j2=4 * Of course it also works for j2=3. * if ( laai .and. j2 .ge. 3 ) then s(2) = -ai(4)**2*(ai(j1)/aai(j1))*xpi(4) som = s(1) + s(2) smax = abs(s(1)) if ( smax.lt.xmax ) then dqiqj(kj,i) = som xmax = smax if ( abs(dqiqj(kj,i)) .ge. xloss*xmax ) + goto 185 endif endif * * If k = 3 we can also try with k = 4 -- should give * the same * if ( del2s.ne.0 .and. kk.eq.3 .and. k.eq.3 ) then k = 4 kj = inx(k,j) dqiqj(kj,i) = dqiqj(kkj,i) goto 181 endif if ( del2s.ne.0 .and. kk.eq.4 .and. k.eq.4 ) then k = 3 kj = inx(k,j) dqiqj(kj,i) = dqiqj(kkj,i) goto 181 endif * * give up * 185 continue if ( k .ne. kk ) then dqiqj(kkj,i) = dqiqj(kj,i) dqiqj(i,kkj) = -dqiqj(kj,i) else dqiqj(i,kj) = -dqiqj(kj,i) endif ier2 = max(ier2,ier0) 190 continue 200 continue 210 continue * #] si^2 - pj^2: * #[ pi^2 - pj^2: do 280 i=1,4 do 270 j=i+1,4 ji = inx(j,i) dqiqj(ji,ji) = 0 do 260 k=i,4 do 250 l=k+1,4 ier0 = ier if ( k .eq. i .and. l .le. j ) goto 250 lk = inx(l,k) if ( del2s .eq. 0 ) then * * special case: * if ( j.eq.4 .and. i.eq.3 ) then dqiqj(lk,7) = xqi(lk) goto 245 endif if ( l.eq.4 .and. k.eq.3 ) then dqiqj(7,ji) = -xqi(ji) goto 245 endif else * * Use that t_3.p_i = t_4.p_i * if ( k.eq.i .and. j.eq.3 .and. l.eq.4 ) then dqiqj(lk,ji) = 0 goto 245 endif if ( j.eq.4 ) then if ( i .eq. 3 ) then dqiqj(lk,7) = xqi(lk) else dqiqj(lk,ji) = dqiqj(lk,inx(i,3)) endif goto 245 endif if ( l.eq.4 ) then if ( k .eq. 3 ) then dqiqj(7,ji) = -xqi(ji) else dqiqj(lk,ji) = dqiqj(inx(k,3),ji) endif goto 245 endif endif * * We really have to calculate something * dqiqj(lk,ji) = xqi(lk) - xqi(ji) smax = abs(xqi(lk)) if ( abs(dqiqj(lk,ji)).ge.xloss*smax ) goto 245 * * First the special case j=k,l * i1 = i j1 = j k1 = k lgo = .FALSE. if ( j .eq. k ) then k1 = l lgo = .TRUE. elseif ( j .eq. l ) then lgo = .TRUE. elseif ( i .eq. k ) then i1 = j j1 = i k1 = l lgo = .TRUE. endif if ( lgo ) then s(1) = dqiqj(k1,i1) s(2) = 2*isgn(i1,k1)*qiDqj(j1,inx(i1,k1)) xmax = abs(s(1)) if ( xmax .lt. smax ) then smax = xmax dqiqj(lk,ji) = s(1) + s(2) if ( abs(dqiqj(lk,ji)).ge.xloss*smax ) + goto 245 endif endif * * Just some recombinations * if ( abs(dqiqj(l,ji)).lt.abs(dqiqj(k,ji)) ) then j1 = l j2 = k else j2 = l j1 = k endif s(1) = dqiqj(j1,ji) s(2) = xqi(j2) s(3) = -2*qiDqj(j1,j2) * only if this is an improvement xmax = max(abs(s(1)),abs(s(2)),abs(s(3))) if ( xmax .lt. smax ) then smax = xmax dqiqj(lk,ji) = s(1) + s(2) + s(3) if ( abs(dqiqj(lk,ji)) .ge. xloss*smax ) + goto 245 endif if ( abs(dqiqj(j,lk)).lt.abs(dqiqj(i,lk)) ) then j1 = j j2 = i else j2 = j j1 = i endif s(1) = -dqiqj(j1,lk) s(2) = -xqi(j2) s(3) = 2*qiDqj(j1,j2) * only if this is an improvement xmax = max(abs(s(1)),abs(s(2)),abs(s(3))) if ( xmax .lt. smax ) then dqiqj(lk,ji) = s(1) + s(2) + s(3) smax = xmax if ( abs(dqiqj(lk,ji)) .ge. xloss*smax ) + goto 245 endif * * give up * 245 continue dqiqj(ji,lk) = -dqiqj(lk,ji) ier2 = max(ier2,ier0) 250 continue 260 continue 270 continue 280 continue ier = ier2 * #] pi^2 - pj^2: *###] fftran: end LoopTools-2.16/src/util/PaxHeaders/ffcxyz.F0000644000000000000000000000007411776502523015653 xustar0030 atime=1648161785.707698331 30 ctime=1648161793.715764879 LoopTools-2.16/src/util/ffcxyz.F0000644000000000000000000001745011776502523016575 0ustar00rootroot00000000000000#include "externals.h" #include "types.h" *###[ ffcxyz: subroutine ffcxyz(cy,cz,cdyz,cd2yzz,ivert,sdelpp,sdelps, + etami,delps,xpi,piDpj,isoort,ldel2s,ns,ier) ***#[*comment:*********************************************************** * * * calculate in a numerically stable way * * * * cz(1,2) = (-p(ip1).p(is2) +/- sdelpp)/xpi(ip1) * * cy(1,2) = (-p(ip1).p(is2) +/- sdisc)/xpi(ip1) * * disc = slam1 + 4*eta*xpi(ip)/slam * * * * cy(3,4) = 1-cy(1,2) * * cz(3.4) = 1-cz(1,2) * * cdyz(i,j) = cy(i) - cz(j) * * * * Input: ivert (integer) 1,2 of 3 * * sdelpp (real) sqrt(lam(p1,p2,p3))/2 * * sdelps (real) sqrt(-lam(p,ma,mb))/2 * * etalam (real) det(si.sj)/det(pi.pj) * * etami(6) (real) si.si - etalam * * xpi(ns) (real) standard * * piDpj(ns,ns) (real) standard * * ns (integer) dim of xpi,piDpj * * * * Output: cy(4),cz(4),cdyz(4,4) (complex) see above * * * * Calls: ?? * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments: * integer ivert,isoort(2),ns,ier logical ldel2s ComplexType cy(4),cz(4),cdyz(2,2),cd2yzz RealType sdelpp,sdelps,etami(6),delps,xpi(ns), + piDpj(ns,ns) * * local variables: * integer ip1,is1,is2,is3 ComplexType c RealType absc,y(4) RealType disc,hulp * * common blocks: * #include "ff.h" absc(c) = abs(Re(c)) + abs(Im(c)) * #] declarations: * #[ set up pointers: if ( ldel2s .and. ivert .ne. 1 ) goto 100 is1 = ivert is2 = ivert+1 if ( is2 .eq. 4 ) is2 = 1 is3 = ivert-1 if ( is3 .eq. 0 ) is3 = 3 ip1 = is1 + 3 * ip2 = is2 + 3 * ip3 = is3 + 3 isoort(1) = -10 isoort(2) = -10 * #] set up pointers: * #[ get cypm,czpm: hulp = sdelps/xpi(ip1) cz(1) = ToComplex(piDpj(ip1,is2)/xpi(ip1),-hulp) cz(2) = ToComplex(piDpj(ip1,is2)/xpi(ip1),+hulp) disc = delps/sdelpp call ffroot(y(1),y(2),xpi(ip1),piDpj(ip1,is2),etami(is2),disc, + ier) cy(1) = y(1) cy(2) = y(2) * #] get cypm,czpm: * #[ get cypm1,czpm1: if ( xpi(is1) .eq. xpi(is2) ) then cy(4) = cy(1) cy(3) = cy(2) cz(4) = cz(1) cz(3) = cz(2) else cz(3) = 1 - cz(1) cz(4) = 1 - cz(2) if ( absc(cz(3)).lt.xloss .or. absc(cz(4)).lt.xloss ) then cz(3) =ToComplex(-piDpj(ip1,is1)/xpi(ip1),+hulp) cz(4) =ToComplex(-piDpj(ip1,is1)/xpi(ip1),-hulp) endif y(3) = 1 - y(1) y(4) = 1 - y(2) if ( abs(y(3)) .lt. xloss .or. abs(y(4)) .lt. xloss ) then call ffroot(y(4),y(3),xpi(ip1),-piDpj(ip1,is1), + etami(is1),disc,ier) endif cy(3) = y(3) cy(4) = y(4) endif * #] get cypm1,czpm1: * #[ get cdypzp, cdypzm: cdyz(2,1) = ToComplex(disc/xpi(ip1),+hulp) cdyz(2,2) = ToComplex(disc/xpi(ip1),-hulp) cdyz(1,1) = -cdyz(2,2) cdyz(1,2) = -cdyz(2,1) cd2yzz = 2*disc/xpi(ip1) goto 200 * #] get cdypzp, cdypzm: * #[ special case, get indices: 100 continue if ( ivert.eq.2 ) then is1 = 2 ip1 = 5 else is1 = 1 ip1 = 6 endif isoort(1) = -100 isoort(2) = -100 * #] special case, get indices: * #[ get cypm,czpm: * * special case del2s = 0, hence the roots are not the real roots * but z_2'' = (z_2'-1)/delta, z''_3 = -z'_3/delta * hulp = sdelps/xpi(3) disc = delps/sdelpp if ( ivert .eq. 3 ) then hulp = -hulp disc = -disc endif cz(1) = ToComplex(piDpj(is1,3)/xpi(3),-hulp) cz(2) = ToComplex(piDpj(is1,3)/xpi(3),+hulp) call ffroot(y(1),y(2),xpi(3),piDpj(is1,3),etami(is1),disc,ier) cy(1) = y(1) cy(2) = y(2) * #] get cypm,czpm: * #[ get cypm1,czpm1: cz(3) = 1 - cz(1) cz(4) = 1 - cz(2) if ( absc(cz(3)).lt.xloss .or. absc(cz(4)).lt.xloss ) then if ( ivert.eq.2 ) then cz(3) =ToComplex(piDpj(ip1,3)/xpi(3),+hulp) cz(4) =ToComplex(piDpj(ip1,3)/xpi(3),-hulp) else cz(3) =ToComplex(-piDpj(ip1,3)/xpi(3),+hulp) cz(4) =ToComplex(-piDpj(ip1,3)/xpi(3),-hulp) endif endif y(3) = 1 - y(1) y(4) = 1 - y(2) if ( abs(y(3)) .lt. xloss .or. abs(y(4)) .lt. xloss ) then if ( ivert .eq. 2 ) then call ffroot(y(4),y(3),xpi(3),piDpj(ip1,3),etami(ip1), + disc,ier) else call ffroot(y(4),y(3),xpi(3),-piDpj(ip1,3),etami(ip1), + disc,ier) endif endif cy(3) = y(3) cy(4) = y(4) * #] get cypm1,czpm1: * #[ get cdypzp, cdypzm: cdyz(2,1) = ToComplex(disc/xpi(3),+hulp) cdyz(2,2) = ToComplex(disc/xpi(3),-hulp) cdyz(1,1) = -cdyz(2,2) cdyz(1,2) = -cdyz(2,1) cd2yzz = 2*disc/xpi(3) * #] get cdypzp, cdypzm: 200 continue *###] ffcxyz: end *###[ ffcdwz: subroutine ffcdwz(cdwz,cz,i1,j1,l,calpha,calph1,cpi,cdpipj, + cpiDpj,csdeli,csdel2,ns,ier) ***#[*comment:*********************************************************** * * * Recalculate cdwz(i1,j1) = cw(i1) - cz(j1) * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments: * integer i1,j1,l,ns,ier ComplexType cdwz(2,2),cz(4),calpha,calph1,cpi(ns) ComplexType cdpipj(ns,ns),cpiDpj(ns,ns),csdeli(3),csdel2 * * local variables: * integer i,n ComplexType cs(8),csum,cfac,c,cddel RealType xmax,absc,afac * * common blocks: * #include "ff.h" * * statement function * absc(c) = abs(Re(c)) + abs(Im(c)) * #] declarations: * #[ calculations: if ( l .eq. 1 ) then if ( j1 .eq. 1 ) then if ( absc(csdeli(1)+csdel2) .lt. xloss*absc(csdel2) ) + then * for example in e-> e g* with eeg loop * first get the difference of csdeli(1) and csdel2: cs(1) = cpi(4)*cdpipj(2,5) cs(2) = -cpiDpj(4,3)*cpiDpj(4,2) cs(3) = cpiDpj(4,3)*cpiDpj(4,5) csum = cs(1)+cs(2)+cs(3) xmax = max(absc(cs(1)),absc(cs(2)),absc(cs(3))) if ( absc(csum) .lt. xloss*xmax ) then ier = 1 goto 5 endif cddel = csum/(csdel2-csdeli(1)) if ( i1 .eq. 1 ) then cs(1) = cpi(4)*csdeli(2) else cs(1) = -cpi(4)*csdeli(2) endif cs(2) = cddel*cpiDpj(4,2) cs(3) = -cpiDpj(4,3)*csdeli(1) cs(4) = cpiDpj(4,3)*cpiDpj(4,5) cs(5) = -cpi(4)*cpiDpj(5,3) cs(6) = -cddel*csdel2 n = 6 else ier = ier + 100 goto 5 endif csum = 0 xmax = 0 do 1 i=1,n csum = csum + cs(i) xmax = max(xmax,absc(cs(i))) 1 continue if ( absc(csum) .lt. xloss*xmax ) then ier = ier + 1 endif cdwz(i1,j1) = csum/calph1/cpi(4)/cpi(5) if ( cdwz(i1,j1) .eq. 0 .and. csum .ne. 0 ) then print *,'?#$&!! cdwz = 0 but csum != 0, try again' afac = 1/absc(csum) csum = csum*Re(afac) cdwz(i1,j1) = csum/calph1/cpi(4)/cpi(5) afac = 1/afac cdwz(i1,j1) = cdwz(i1,j1)*Re(afac) endif else ier = ier + 100 endif 5 continue elseif ( l .eq. 3 ) then if ( (i1.eq.2 .and. j1.eq.1) .or. (i1.eq.1 .and. j1.eq.2 ) ) + then cfac = 1/(csdeli(2) + csdeli(3)) cs(1) = cdpipj(6,5)*cz(j1) cs(2) = -calph1*cpi(5)*cz(j1+2) if ( max(absc(cdpipj(2,1)),absc(cdpipj(5,6))) .lt. + max(absc(cdpipj(2,6)),absc(cdpipj(5,1))) ) then cs(3) = cdpipj(2,1)/2 cs(4) = cdpipj(5,6)/2 else cs(3) = cdpipj(2,6)/2 cs(4) = cdpipj(5,1)/2 endif cs(5) = cpiDpj(4,3)*cpiDpj(5,3)*cfac cs(6) = -cpiDpj(4,3)*cpiDpj(6,3)*cfac cs(7) = cpi(3)*cdpipj(5,6)*cfac if ( i1 .eq. 1 ) then csum = cs(1)+cs(2)+cs(3)+cs(4) - (cs(5)+cs(6)+cs(7)) else csum = cs(1)+cs(2)+cs(3)+cs(4) + cs(5)+cs(6)+cs(7) endif xmax = absc(cs(1)) do 10 i=2,7 xmax = max(xmax,absc(cs(i))) 10 continue if ( absc(csum) .lt. xloss*xmax ) then * this result is not used if it is not accurate (see * ffxc0p) ier = ier + 1 xmax = xmax/absc(calpha*cpi(5)) if ( xmax .lt. min(absc(cz(j1)),absc(cz(j1+2))) ) + then cdwz(i1,j1) = csum/(calpha*cpi(5)) endif else cdwz(i1,j1) = csum/(calpha*cpi(5)) endif else ier = ier + 100 endif else ier = ier + 100 endif * #] calculations: *###] ffcdwz: end LoopTools-2.16/src/util/PaxHeaders/ffbndc.F0000644000000000000000000000007411776502523015564 xustar0030 atime=1648161785.707698331 30 ctime=1648161793.715764879 LoopTools-2.16/src/util/ffbndc.F0000644000000000000000000000141111776502523016474 0ustar00rootroot00000000000000#include "externals.h" #include "types.h" *###[ ffbndc: RealType function ffbndc(n1,n2,carray) ************************************************************************* * * * calculate bound = (precc*|a(n1)/a(n1+n2)|^(1/n2) which is the * * maximum value of x in a series expansion sum_(i=n1)^(n1+n2) * * a(i)*x(i) to give a result of accuracy precc (actually of |next * * term| < prec * * * ************************************************************************* implicit none integer n1,n2 ComplexType carray(n1+n2) #include "ff.h" if ( carray(n1+n2) .eq. 0 ) then print *,'ffbnd: fatal: array not intialized; did you call ', + 'ffini?' stop endif ffbndc = (precc*abs(carray(n1)/carray(n1+n2)))**(1/Re(n2)) *###] ffbndc: end LoopTools-2.16/src/util/PaxHeaders/ffxli2.F0000644000000000000000000000007411776502523015534 xustar0030 atime=1648161785.707698331 30 ctime=1648161793.715764879 LoopTools-2.16/src/util/ffxli2.F0000644000000000000000000003526411776502523016461 0ustar00rootroot00000000000000#include "externals.h" #include "types.h" *###[ ffxli2: subroutine ffxli2(xdilog,xlog,x,ier) ***#[*comment:*********************************************************** * * * Computes the dilogarithm (Li2, Sp) for (real) x to precision * * precx. It is assumed that -1<=x<=1/2. As it is available anyway* * log(1-x) = -Li1(x) is also passed. * * * * Input: x (real) * * * * Output: xdilog (real) Li2(x) * * xlog (real) log(1-x) = -Li1(x) * * ier (integer) 0=OK, 1=num prob, 2=error * * * * Calls: log,dfflo1 * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments * integer ier RealType xdilog,xlog,x * * local variables * integer ipi12 RealType dfflo1,u,u2,a,ffbnd, + xprec,bdn02,bdn05,bdn10,bdn15 ComplexType zxdilo,zlog external ffbnd,dfflo1 save xprec,bdn02,bdn05,bdn10,bdn15 * * common blocks * #include "ff.h" * #] declarations: * #[ initialisations: data xprec /-1D0/ if ( xprec .ne. precx ) then xprec = precx bdn02 = ffbnd(1,2,bf) bdn05 = ffbnd(1,5,bf) bdn10 = ffbnd(1,10,bf) bdn15 = ffbnd(1,15,bf) endif * #] initialisations: * #[ if the argument is too large... if ( x .lt. -1.5 .or. x .gt. .75 ) then call ffzxdl(zxdilo,ipi12,zlog,x,0,ier) if ( Im(zxdilo) .ne. 0 ) then call fferr(52,ier) endif xdilog = Re(zxdilo) + ipi12*pi12 xlog = Re(zlog) return endif * #] if the argument is too large... * #[ exceptional cases: if ( x .eq. -1 ) then xdilog = -pi12 xlog = log(2D0) return elseif ( x .eq. .5D0 ) then xdilog = - xlg2**2/2 + pi12 xlog = - xlg2 return elseif ( abs(x) .lt. precx ) then xdilog = x xlog = -x return endif * #] exceptional cases: * #[ calculate dilog: if ( abs(x) .lt. xloss ) then xlog = dfflo1(x,ier) else xlog = log(1-x) endif u = -xlog u2 = u*u a = abs(u2) if ( a .gt. bdn15 ) then xdilog = u2*(bf(16) + u2*(bf(17) + u2*(bf(18) + + u2*(bf(19) + u2*bf(20) )))) else xdilog = 0 endif if ( a .gt. bdn10 ) then xdilog = u2*(bf(11) + u2*(bf(12) + u2*(bf(13) + + u2*(bf(14) + u2*(bf(15) + xdilog))))) endif if ( a .gt. bdn05 ) then xdilog = u2*(bf(6) + u2*(bf(7) + u2*(bf(8) + + u2*(bf(9) + u2*(bf(10) + xdilog))))) endif if ( a .gt. bdn02 ) then xdilog = u2*(bf(3) + u2*(bf(4) + u2*(bf(5) + xdilog))) endif * watch the powers of u. xdilog = u + u2*(bf(1) + u*(bf(2) + xdilog)) * #] calculate dilog: *###] ffxli2: end *###[ ffzxdl: subroutine ffzxdl(zxdilo,ipi12,zlog,x,ieps,ier) ***#[*comment:*************************************************** * Computes the dilogarithm (Li2, Sp) for any (real) x * * to precision precx. If an error message is given add * * more bf's. For x > 1 the imaginary part is * * -/+i*pi*log(x), corresponding to x+ieps. * * The number of factors pi^2/12 is passed separately in * * ipi12 for accuracy. We also calculate log(1-x) * * which is likely to be needed. * * * * Input: x (real) * * ieps (integer,+/-1) * * * * Output: zxdilo (complex) the dilog mod factors pi2/12 * * ipi12 (integer) these factors * * zlog (complex) log(1-x) * * * * Calls: log,dfflo1 * * * ***#]*comment:*************************************************** * #[ declarations: implicit none * * arguments * integer ipi12,ieps,ier RealType x ComplexType zxdilo,zlog * * local variables * integer jsgn RealType fact,u,u2,dfflo1,ffbnd,a,xdilo, + xprec,bdn02,bdn05,bdn10,bdn15 ComplexType cy,cfact external ffbnd,dfflo1 save xprec,bdn02,bdn05,bdn10,bdn15 * * common blocks * #include "ff.h" * #] declarations: * #[ initialisations: data xprec /-1D0/ if ( xprec .ne. precx ) then xprec = precx bdn02 = ffbnd(1,2,bf) bdn05 = ffbnd(1,5,bf) bdn10 = ffbnd(1,10,bf) bdn15 = ffbnd(1,15,bf) endif * #] initialisations: * #[ exceptional cases: if ( x .eq. 1) then zxdilo = 0 zlog = -99999 ipi12 = 2 return elseif (x .eq. -1) then zxdilo = 0 zlog = xlg2 ipi12 = -1 return elseif (x .eq. .5D0) then zxdilo = - xlg2**2/2 zlog = -xlg2 ipi12 = 1 return elseif ( abs(x) .lt. precx ) then zxdilo = x zlog = -x ipi12 = 0 return endif * #] exceptional cases: * #[ transform to (-1,.5): if (x .lt. -1) then fact = log(-x) cy = - fact**2/2 ipi12 = -2 if ( -x*xloss .gt. 1 ) then u = -dfflo1(1/x,ier) else u = -log(1-1/x) endif zlog = log(1-x) jsgn = -1 elseif ( x .lt. .5D0) then cy = 0 ipi12 = 0 if ( abs(x) .lt. xloss ) then zlog = dfflo1(x,ier) else zlog = log(1-x) endif u = -Re(zlog) jsgn = 1 elseif ( x .le. 2 ) then u = -log(x) if ( abs(1-x) .lt. xalogm ) then cy = 0 elseif ( x .lt. 1 ) then zlog = log(1-x) cy = Re(u)*zlog elseif ( ieps .gt. 0 ) then zlog = ToComplex(log(x-1),-pi) cy = Re(u)*zlog else zlog = ToComplex(log(x-1),+pi) cy = Re(u)*zlog endif ipi12 = 2 jsgn = -1 else if ( ieps .gt. 0 ) then cfact = ToComplex(log(x),-pi) zlog = ToComplex(log(x-1),-pi) else cfact = ToComplex(log(x),+pi) zlog = ToComplex(log(x-1),+pi) endif cy = - cfact**2/2 ipi12 = -2 if ( x*xloss .gt. 1 ) then u = -dfflo1(1/x,ier) else u = -log(1-1/x) endif jsgn = -1 endif * #] transform to (-1,.5): * #[ calculate dilog: if ( abs(u) .lt. xalog2 ) then xdilo = u else u2 = u**2 a = abs(u2) if ( a .gt. bdn15 ) then xdilo = u2*(bf(16) + u2*(bf(17) + u2*(bf(18) + + u2*(bf(19) + u2*bf(20) )))) else xdilo = 0 endif if ( a .gt. bdn10 ) then xdilo = u2*(bf(11) + u2*(bf(12) + u2*(bf(13) + + u2*(bf(14) + u2*(bf(15) + xdilo))))) endif if ( a .gt. bdn05 ) then xdilo = u2*(bf(6) + u2*(bf(7) + u2*(bf(8) + + u2*(bf(9) + u2*(bf(10) + xdilo))))) endif if ( a .gt. bdn02 ) then xdilo = u2*(bf(3) + u2*(bf(4) + u2*(bf(5) + xdilo))) endif * watch the powers of u. xdilo = u + u2*(bf(1) + u*(bf(2) + xdilo)) endif if(jsgn.eq.1)then zxdilo = Re(xdilo) + cy else zxdilo = -Re(xdilo) + cy endif * #] calculate dilog: *###] ffzxdl: end *###[ zxfflg: ComplexType function zxfflg(x,ieps,y,ier) ***#[*comment:*********************************************************** * * * Calculate the complex logarithm of x. The following cases * * are treted separately: * * |x| too small: give warning and return 0 * * (for Absoft, Apollo DN300) * * |x| < 0: take sign according to ieps * * * ***#]*comment:*********************************************************** * #[ declarations: * * arguments * implicit none integer ieps,ier RealType x,y * * local variables * RealType xlog * * common blocks * #include "ff.h" * #] declarations: * #[ calculations: if ( abs(x) .lt. xalogm ) then zxfflg = 0 elseif ( x .gt. 0 ) then zxfflg = log(x) else xlog = log(-x) * checked imaginary parts 19-May-1988 if ( abs(ieps) .eq. 1 ) then if ( y*ieps .lt. 0 ) then zxfflg = ToComplex(xlog,-pi) else zxfflg = ToComplex(xlog,pi) endif elseif ( ieps .eq. 2 ) then zxfflg = ToComplex(xlog,-pi) elseif ( ieps .eq. -2 ) then zxfflg = ToComplex(xlog,+pi) else call fferr(52,ier) zxfflg = ToComplex(xlog,pi) endif endif * #] calculations: *###] zxfflg: end *###[ dfflo1: RealType function dfflo1(x,ier) ***#[*comment:*************************************************** * calculates log(1-x) for |x|<.14 in a faster way to ~15 * * significant figures. * ***#]*comment:*************************************************** * #[ declarations: implicit none integer ier RealType x,bdn01,bdn05,bdn10,bdn15,bdn19,xprec, + xa,ffbnd ComplexType zxfflg external ffbnd,zxfflg save xprec,bdn01,bdn05,bdn10,bdn15,bdn19 #include "ff.h" * #] declarations: * #[ initialisation: data xprec /-1D0/ if ( xprec .ne. precx ) then xprec = precx * determine the boundaries for 1,5,10,15 terms bdn01 = ffbnd(1,1,xninv) bdn05 = ffbnd(1,5,xninv) bdn10 = ffbnd(1,10,xninv) bdn15 = ffbnd(1,15,xninv) bdn19 = ffbnd(1,19,xninv) endif * #] initialisation: * #[ calculations: xa = abs(x) if ( xa .gt. bdn19 ) then dfflo1 = Re(zxfflg(1-x,0,0D0,ier)) return endif if ( xa .gt. bdn15 ) then dfflo1 = x*( xninv(16) + x*( xninv(17) + x*( xninv(18) + + x*( xninv(19) + x*xninv(20) )))) else dfflo1 = 0 endif if ( xa .gt. bdn10 ) then dfflo1 = x*( xninv(11) + x*( xninv(12) + x*( xninv(13) + + x*( xninv(14) + x*( xninv(15) + dfflo1 ))))) endif if ( xa .gt. bdn05 ) then dfflo1 = x*( xninv(6) + x*( xninv(7) + x*( xninv(8) + + x*( xninv(9) + x*( xninv(10) + dfflo1 ))))) endif if ( xa .gt. bdn01 ) then dfflo1 = x*( xninv(2) + x*( xninv(3) + x*( xninv(4) + + x*( xninv(5) + dfflo1 )))) endif dfflo1 = - x*( xninv(1) + dfflo1 ) * #] calculations: *###] dfflo1: end *###[ dfflo2: RealType function dfflo2(x,ier) ***#[*comment:*************************************************** * calculates log(1-x)+x for |x|<.14 in a faster way to * * ~15 significant figures. * ***#]*comment:*************************************************** * #[ declarations: implicit none integer ier RealType x,bdn01,bdn05,bdn10,bdn15,bdn18,xprec, + xa,ffbnd,dfflo1 external ffbnd,dfflo1 save xprec,bdn01,bdn05,bdn10,bdn15,bdn18 #include "ff.h" * #] declarations: * #[ initialisation: data xprec /-1D0/ if ( xprec .ne. precx ) then xprec = precx * determine the boundaries for 1,5,10,15 terms bdn01 = ffbnd(1,1,xninv(2)) bdn05 = ffbnd(1,5,xninv(2)) bdn10 = ffbnd(1,10,xninv(2)) bdn15 = ffbnd(1,15,xninv(2)) bdn18 = ffbnd(1,18,xninv(2)) endif * #] initialisation: * #[ calculations: xa = abs(x) if ( xa .gt. bdn18 ) then dfflo2 = dfflo1(x,ier) + x return endif if ( xa .gt. bdn15 ) then dfflo2 = x*( xninv(17) + x*( xninv(18) + x*( xninv(19) + + x*xninv(20) ))) else dfflo2 = 0 endif if ( xa .gt. bdn10 ) then dfflo2 = x*( xninv(12) + x*( xninv(13) + x*( xninv(14) + + x*( xninv(15) + x*( xninv(16) + dfflo2 ))))) endif if ( xa .gt. bdn05 ) then dfflo2 = x*( xninv(7) + x*( xninv(8) + x*( xninv(9) + + x*( xninv(10) + x*( xninv(11) + dfflo2 ))))) endif if ( xa .gt. bdn01 ) then dfflo2 = x*( xninv(3) + x*( xninv(4) + x*( xninv(5) + + x*( xninv(6) + dfflo2 )))) endif dfflo2 = - x**2*( xninv(2) + dfflo2 ) * #] calculations: *###] dfflo2: end *###[ dfflo3: RealType function dfflo3(x,ier) ***#[*comment:*************************************************** * calculates log(1-x)+x+x^2/2 for |x|<.14 in a faster * * way to ~15 significant figures. * ***#]*comment:*************************************************** * #[ declarations: implicit none integer ier RealType x,bdn01,bdn05,bdn10,bdn15,xprec, + xa,ffbnd,dfflo2 external ffbnd,dfflo2 save xprec,bdn01,bdn05,bdn10,bdn15 #include "ff.h" * #] declarations: * #[ initialisation: data xprec /-1D0/ if ( xprec .ne. precx ) then xprec = precx * determine the boundaries for 1,5,10,15 terms bdn01 = ffbnd(1,1,xninv(3)) bdn05 = ffbnd(1,5,xninv(3)) bdn10 = ffbnd(1,10,xninv(3)) bdn15 = ffbnd(1,15,xninv(3)) endif * #] initialisation: * #[ calculations: xa = abs(x) if ( xa .gt. bdn15 ) then dfflo3 = dfflo2(x,ier) + x**2/2 return endif if ( xa .gt. bdn10 ) then dfflo3 = x*( xninv(13) + x*( xninv(14) + x*( xninv(15) + + x*( xninv(16) + x*xninv(17) )))) else dfflo3 = 0 endif if ( xa .gt. bdn05 ) then dfflo3 = x*( xninv(8) + x*( xninv(9) + x*( xninv(10) + + x*( xninv(11) + x*( xninv(12) + dfflo3 ))))) endif if ( xa .gt. bdn01 ) then dfflo3 = x*( xninv(4) + x*( xninv(5) + x*( xninv(6) + + x*( xninv(7) + dfflo3 )))) endif dfflo3 = - x**3*( xninv(3) + dfflo3 ) * #] calculations: *###] dfflo3: end *###[ ffxl22: subroutine ffxl22(xl22,x,ier) ***#[*comment:*************************************************** * calculates Li2(2-x) for |x|<.14 in a faster way to ~15 * * significant figures. * ***#]*comment:*************************************************** * #[ declarations: implicit none integer ier,init RealType xl22,x,bdn01,bdn05,bdn10,bdn15,bdn20,bdn25, + xprec,xa,ffbnd,dilog2(29) external ffbnd save xprec,bdn01,bdn05,bdn10,bdn15,bdn20,bdn25,init,dilog2 #include "ff.h" data xprec /-1D0/ data init /0/ if ( init .eq. 0 ) then init = 1 * taylor(dilog(x-1),x,30); dilog2( 1) = 0.d0 dilog2( 2) = 1/4.d0 dilog2( 3) = 1/6.d0 dilog2( 4) = 5/48.d0 dilog2( 5) = 1/15.d0 dilog2( 6) = 2/45.d0 dilog2( 7) = 13/420.d0 dilog2( 8) = 151/6720.d0 dilog2( 9) = 16/945.d0 dilog2(10) = 83/6300.d0 dilog2(11) = 73/6930.d0 dilog2(12) = 1433/166320.d0 dilog2(13) = 647/90090.d0 dilog2(14) = 15341/2522520.d0 dilog2(15) = 28211/5405400.d0 dilog2(16) = 10447/2306304.d0 dilog2(17) = 608/153153.d0 dilog2(18) = 19345/5513508.d0 dilog2(19) = 18181/5819814.d0 dilog2(20) = 130349/46558512.d0 dilog2(21) = 771079/305540235.d0 dilog2(22) = 731957/320089770.d0 dilog2(23) = 2786599/1338557220.d0 dilog2(24) = 122289917/64250746560.d0 dilog2(25) = 14614772/8365982625.d0 dilog2(26) = 140001721/87006219300.d0 dilog2(27) = 134354573/90352612350.d0 dilog2(28) = 774885169/562194032400.d0 dilog2(29) = 745984697/582272390700.d0 endif * #] declarations: * #[ initialisation: if ( xprec .ne. precx ) then xprec = precx * determine the boundaries for 1,5,10,15,20 terms bdn01 = ffbnd(2,1,dilog2) bdn05 = ffbnd(2,5,dilog2) bdn10 = ffbnd(2,10,dilog2) bdn15 = ffbnd(2,15,dilog2) bdn20 = ffbnd(2,20,dilog2) bdn25 = ffbnd(2,25,dilog2) endif * #] initialisation: * #[ calculations: xa = abs(x) if ( xa .gt. bdn25 ) then call ffwarn(230,ier,precx,dilog2(27)*xa**25) endif if ( xa .gt. bdn20 ) then xl22 = x*( dilog2(22) + x*( dilog2(23) + x*( dilog2(24) + + x*( dilog2(25) + x*dilog2(26) )))) else xl22 = 0 endif if ( xa .gt. bdn15 ) then xl22 = x*( dilog2(17) + x*( dilog2(18) + x*( dilog2(19) + + x*( dilog2(20) + x*dilog2(21) )))) endif if ( xa .gt. bdn10 ) then xl22 = x*( dilog2(12) + x*( dilog2(13) + x*( dilog2(14) + + x*( dilog2(15) + x*dilog2(16) )))) endif if ( xa .gt. bdn05 ) then xl22 = x*( dilog2(7) + x*( dilog2(8) + x*( dilog2(9) + + x*( dilog2(10) + x*( dilog2(11) + xl22 ))))) endif if ( xa .gt. bdn01 ) then xl22 = x*( dilog2(3) + x*( dilog2(4) + x*( dilog2(5) + + x*( dilog2(6) + xl22 )))) endif xl22 = - x**2*( dilog2(2) + xl22 ) * #] calculations: *###] ffxl22: end LoopTools-2.16/src/util/PaxHeaders/Li2.F0000644000000000000000000000007413262230260014754 xustar0030 atime=1648161785.707698331 30 ctime=1648161793.715764879 LoopTools-2.16/src/util/Li2.F0000644000000000000000000000131613262230260015670 0ustar00rootroot00000000000000* Li2.F * the dilogarithm function * this file is part of LoopTools * last modified 7 Apr 18 th #include "externals.h" #include "types.h" #include "defs.h" ComplexType function XLi2(x) implicit none ArgType x RealType pi12 parameter (pi12 = .822467033424113218236207583323D0) ComplexType res, dummy integer ier, ipi12 ier = 0 #ifdef COMPLEXPARA call ffzzdl(res, ipi12, dummy, x, ier) #else call ffzxdl(res, ipi12, dummy, x, -1, ier) #endif XLi2 = res + ipi12*pi12 end ************************************************************************ * adapter code for C++ subroutine XLi2sub(res, x) implicit none ComplexType res ArgType x ComplexType XLi2 external XLi2 res = XLi2(x) end LoopTools-2.16/src/util/PaxHeaders/ffcrr.F0000644000000000000000000000007411776502523015444 xustar0030 atime=1648161785.707698331 30 ctime=1648161793.715764879 LoopTools-2.16/src/util/ffcrr.F0000644000000000000000000004043211776502523016362 0ustar00rootroot00000000000000#include "externals.h" #include "types.h" *--#[ log: * $Id: ffcrr.f,v 1.5 1995/11/10 19:04:23 gj Exp $ * $Log: ffcrr.f,v $ c Revision 1.5 1995/11/10 19:04:23 gj c Added nicer logging header... c c Revision 1.4 1995/10/17 06:55:07 gj c Fixed ieps error in ffdcrr (ffcxs4.f), added real case in ffcrr, debugging c info in ffxd0, and warned against remaining errors for del2=0 in ffrot4 c (ffxd0h.f) c c Revision 1.3 1995/10/06 09:17:20 gj c Found stupid typo in ffxc0p which caused the result to be off by pi^2/3 in c some equal-mass cases. Added checks to ffcxs4.f ffcrr.f. c *--#] log: *###[ ffcrr: subroutine ffcrr(crr,ipi12,cy,cy1,cz,cz1,cdyz,ld2yzz,cd2yzz,czz, + czz1,isoort,ieps,ier) ***#[*comment:*********************************************************** * * * calculates R as defined in appendix b: * * * * /1 log(y-y1+ieps) - log(y0-y1+ieps) * * r(y0,y1,iesp) = \ dy -------------------------------- * * /0 y-y0 * * * * = li2(c1) - li2(c2) * * + eta(-y1,1/(y0-y1))*log(c1) * * - eta(1-y1,1/(y0-y1))*log(c2) * * with * * c1 = y0 / (y0-y1), c2 = (y0-1) / (y0-y1) * * * * the factors pi^2/12 are passed separately in the integer ipi12 * * ier is a status flag: 0=ok, 1=numerical problems, 2=error * * * * Input: cy (complex) * * cy1 (complex) 1-y * * cz (complex) * * cz1 (complex) 1-z * * cdyz (complex) y-z * * ieps (integer) denotes sign imaginary part of * * argument logs (0: don't care; * * +/-1: add -ieps to z; +/-2: * * direct in dilogs, no eta's) * * * * Output crr (complex) R modulo factors pi^2/12 * * ipi12 (integer) these factors * * ier (integer) lost ier digits, >100: error * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments * integer ipi12,isoort,ieps,ier logical ld2yzz,lreal ComplexType crr(7),cy,cy1,cz,cz1,cdyz,cd2yzz,czz,czz1 * * local variables * ComplexType cfact,cc1,cc2,cc1p,cc2p,carg1,carg2,carg3, + cli1,cli2,cli3,clo1,clo2,clo3,clog1p,clog2p,chill, + cd2,cd21,cd2n,cd21n1,cc1n,cterm,ctot,zfflo1,clog1,clog2, + cc,cli4,clo4 ComplexType ctroep,zfflog RealType xa,xr,absc,xprec,bndtay,ffbnd RealType y,y1,z,z1,dyz,d2yzz,zz,zz1 integer i,nffeta,nffet1,iclas1,iclas2,n1,n2,n3,ntot, + i2pi,n3p external zfflog,zfflo1,ffbnd,nffeta,nffet1 save xprec,bndtay * * common blocks * #include "ff.h" * * statement function * absc(cc) = abs(Re(cc)) + abs(Im(cc)) * #] declarations: * #[ initialisations: data xprec /-1D0/ if ( xprec .ne. precx ) then xprec = precx bndtay = ffbnd(2,18,xn2inv) * print *,'bndtay = ',bndtay endif * #] initialisations: * #[ real case: if ( Im(cy).eq.0 .and. Im(cy1).eq.0 .and. Im(cz).eq.0 + .and. Im(cz1).eq.0 ) then y = Re(cy) y1 = Re(cy1) z = Re(cz) z1 = Re(cz1) dyz = Re(cdyz) d2yzz = Re(cd2yzz) zz = Re(czz) zz1 = Re(czz1) call ffcxr(crr,ipi12,y,y1,z,z1,dyz,ld2yzz,d2yzz,zz,zz1, + .FALSE.,0D0,ieps,ier) return endif * #] real case: * #[ arguments: * * get the arguments * xa = absc(cdyz) if ( xa .eq. 0 ) then return * This line is for 68000 compilers that have a limited range for * complex division (Absoft, Apollo, Gould NP1): elseif ( Re(cdyz) .lt. xclogm .or. Im(cdyz) .lt. xclogm + .or. 1/xa .lt. xclogm ) then ctroep = cdyz*Re(1/xa) cfact = 1/ctroep cfact = Re(1/xa)*cfact else cfact = 1/cdyz endif cc1 = cy * cfact cc2 = - cy1 * cfact * * see if we just need the real part * lreal = mod(isoort,5) .eq. 0 * #] arguments: * #[ which area?: * * determine the area: 1={|x|<=1,Re(x)<=1/2}, * 2={|1-x|<=1,Re(x)>1/2} * 3={|x|>1,|1-x|>1} * xr = Re(cc1) xa = absc(cc1) if ( xa .gt. 1 .and. xa .lt. 1+sqrt(2.) ) then * we need a more accurate estimate xa = xr**2 + Im(cc1)**2 endif if ( ld2yzz .and. absc(cc1+1) .lt. xloss/2 ) then iclas1 = 4 cc1p = cc1 elseif ( xa .le. 1 .and. xr .le. 0.5 ) then iclas1 = 1 cc1p = cc1 elseif ( xa .lt. 1+sqrt(2.) .and. xa .lt. 2*xr ) then iclas1 = 2 cc1p = -cz * cfact if ( abs(Im(cc1p)) .lt. precc*abs(Re(cc1p)) ) + cc1p = Re(cc1p) else iclas1 = 3 if ( 1/xa .lt. xclogm ) then ctroep = cc1*Re(1/xa) ctroep = 1/ctroep cc1p = ctroep*Re(1/xa) else cc1p = 1/cc1 endif endif xr = Re(cc2) xa = absc(cc2) if ( xa .gt. 1 .and. xa .lt. 1+sqrt(2.) ) then xa = xr**2 + Im(cc2)**2 endif if ( ld2yzz .and. absc(cc2+1) .lt. xloss ) then iclas2 = 4 cc2p = cc2 elseif ( xa .le. 1 .and. xr .le. 0.5 ) then iclas2 = 1 cc2p = cc2 elseif ( xa .lt. 1+sqrt(2.) .and. xa .lt. 2*xr ) then iclas2 = 2 cc2p = cz1 * cfact if ( abs(Im(cc2p)) .lt. precc*abs(Re(cc2p)) ) + cc2p = Re(cc2p) else iclas2 = 3 if ( 1/xa .lt. xclogm ) then ctroep = cc2*Re(1/xa) ctroep = 1/ctroep cc2p = ctroep*Re(1/xa) else cc2p = 1/cc2 endif endif * * throw together if they are close * if ( iclas1 .ne. iclas2 .and. absc(cc1-cc2) .lt. 2*xloss ) + then * we don't want trouble with iclasn = 4 if ( iclas1 .eq. 4 ) iclas1 = 1 if ( iclas2 .eq. 4 ) iclas2 = 1 if ( iclas1 .eq. iclas2 ) goto 5 * go on if ( iclas1 .le. iclas2 ) then iclas2 = iclas1 if ( iclas1 .eq. 1 ) then cc2p = cc2 else cc2p = cz1*cfact endif else iclas1 = iclas2 if ( iclas1 .eq. 1 ) then cc1p = cc1 else cc1p = -cz*cfact endif endif endif 5 continue * #] which area?: * #[ eta's: * * get eta1 and eta2 * if ( abs(ieps) .ge. 2 .or. isoort .eq. -2 ) then n1 = 0 n2 = 0 else if ( Im(cz) .eq. 0 .or. Im(cz1) .eq. 0 ) then if ( Im(cz1) .eq. 0 ) then if ( Im(cz) .eq. 0 ) then * cz is really real, the hard case: if ( cz .eq. 0 ) then * multiplied with log(1), so don't care: n1 = 0 * look at ieps for guidance * n2 = nffet1(ToComplex(Re(0),Re(ieps)),cfact,cfact,ier) = 0 n2 = 0 elseif ( cz1 .eq. 0 ) then n1 = nffet1(ToComplex(Re(0),Re(ieps)),cfact, + -cfact,ier) n2 = 0 else n1 = nffet1(ToComplex(Re(0),Re(ieps)),cfact, + -cz*cfact,ier) n2 = nffet1(ToComplex(Re(0),Re(ieps)),cfact, + cz1*cfact,ier) endif else n1 = nffet1(-cz,cfact,-cz*cfact,ier) n2 = nffet1(-cz,cfact,cz1*cfact,ier) endif else n1 = nffet1(cz1,cfact,-cz*cfact,ier) n2 = nffet1(cz1,cfact,cz1*cfact,ier) endif else * the imaginary part of cc1, cc1p is often very unstable. * make sure it agrees with the actual sign used. if ( iclas1 .eq. 2 ) then if ( Im(cc1p) .eq. 0 ) then * if y (or y1 further on) is purely imaginary * give a random shift, this will also be used in * the transformation terms. Checked 7-mar-94 that it * is independent of the sign used. if ( Re(cy).eq.0 ) cy = cy + + isgnal*Re(precc)*Im(cy) n1 = nffet1(-cz,cfact,ToComplex(Re(0),ieps*Re(cy)), + ier) else n1 = nffet1(-cz,cfact,cc1p,ier) endif else if ( Im(cc1) .eq. 0 ) then if ( Re(cy1).eq.0 ) cy1 = cy1 + + isgnal*Re(precc)*Im(cy) n1 = nffet1(-cz,cfact,ToComplex(Re(0), + -ieps*Re(cy1)),ier) else n1 = nffet1(-cz,cfact,-cc1,ier) endif endif if ( iclas2 .eq. 2 ) then if ( Im(cc2p) .eq. 0 ) then if ( Re(cy).eq.0 ) cy = cy + + isgnal*Re(precc)*Im(cy) n2 = nffet1(cz1,cfact,ToComplex(Re(0),ieps*Re(cy)), + ier) else n2 = nffet1(cz1,cfact,cc2p,ier) endif else if ( Im(cc2) .eq. 0 ) then if ( Re(cy1).eq.0 ) cy1 = cy1 + + isgnal*Re(precc)*Im(cy) n2 = nffet1(cz1,cfact,ToComplex(Re(0), + -ieps*Re(cy1)),ier) else n2 = nffet1(cz1,cfact,-cc2,ier) endif endif endif endif * #] eta's: * #[ calculations: * 3-oct-1995 changed code to only use second criterium if the * Taylor expansion is used - otherwise the Hill identity will * only make things worse if ( iclas1 .eq. iclas2 .and. isoort .ne. -2 .and. + ( absc(cc1p-cc2p) .lt. 2*xloss*absc(cc1p) + .or. lreal .and. abs(Re(cc1p-cc2p)) .lt. 2*xloss* + abs(Re(cc1p)) .and. (abs(Re(cc2p)) + + Im(cc2p)**2/4) .lt. xloss .and. + abs(Im(cc2p)) .lt. bndtay ) ) then * Close together: * -#[ handle dilog's: if ( .not. lreal .and. absc(cc2p) .gt. xloss + .or. lreal .and. ( (abs(Re(cc2p)) + Im(cc2p)**2/4) + .gt. xloss .or. abs(Im(cc2p)) .gt. bndtay ) ) + then *--#[ Hill identity: * * Use the Hill identity to get rid of the cancellations. * * * first get the arguments: * if ( iclas1 .eq. 1 .or. iclas1 .eq. 4 ) then carg1 = 1/cy carg2 = 1/cz1 carg3 = carg2/cc1p elseif ( iclas1 .eq. 2 ) then carg1 = 1/cz carg2 = 1/cy1 carg3 = carg2/cc1p elseif ( iclas1 .eq. 3 ) then carg1 = 1/cy1 carg3 = 1/cz1 carg2 = carg3*cc1p endif call ffzli2(cli1,clo1,carg1,ier) call ffzli2(cli2,clo2,carg2,ier) call ffzli2(cli3,clo3,carg3,ier) if ( absc(cc2p) .lt. xloss ) then clog2p = zfflo1(cc2p,ier) else clog2p = zfflog(1-cc2p,0,czero,ier) endif chill = clo1*clog2p *--#] Hill identity: else *--#[ Taylor expansion: * * if the points are close to zero do a Taylor * expansion of the first and last dilogarithm * * Li2(cc1p) - Li2(cc2p) * = sum cc1p^i ( 1-(1-cd2)^i ) /i^2 * * with cd2 = 1-cc2p/cc1p = ... * if ( iclas1 .eq. 1 .or. iclas1 .eq. 4 ) then cd2 = 1/cy elseif ( iclas1 .eq. 2 ) then cd2 = 1/cz elseif ( iclas1 .eq. 3 ) then cd2 = 1/cy1 endif cd21 = 1-cd2 cd21n1 = 1 cc1n = cc1p cd2n = cd2 ctot = cc1p*cd2 do 50 i=2,20 cc1n = cc1n*cc1p cd21n1 = cd21n1*cd21 cd2n = cd2n + cd2*cd21n1 cterm = cc1n*cd2n*Re(xn2inv(i)) ctot = ctot + cterm if ( absc(cterm) .le. precc*absc(ctot) .or. + lreal .and. abs(Re(cterm)) .le. precc* + abs(Re(ctot)) ) goto 51 50 continue 51 continue cli1 = ctot cli2 = 0 cli3 = 0 chill = 0 * for the eta+transformation section we also need if ( iclas1.ne.1 .or. n1.ne.0 .or. n2.ne.0 ) + clo1 = zfflo1(cd2,ier) if ( iclas1.eq.2 ) clo2 = zfflo1(1/cy1,ier) *--#] Taylor expansion: endif * * -#] handle dilog's: * -#[ handle eta + transformation terms: if ( iclas1.eq.1 .or. iclas1.eq.4 ) then *--#[ no transformation: * * no transformation was made. * * crr(5) = 0 if ( n1 .ne. n2 ) then if ( absc(cc1) .lt. xclogm ) then call fferr(23,ier) else * imaginary part not checked ier = ier + 50 crr(5) = (n1-n2)*c2ipi*zfflog(cc1,ieps,-cy,ier) endif endif * crr(6) = 0 * crr(7) = 0 if ( n2.ne.0 ) then crr(6) = - n2*c2ipi*clo1 n3 = nffeta(cc2,1/cc1,ier) if ( n3 .ne. 0 ) then crr(7) = n2*n3*c2ipi**2 * else * crr(7) = 0 endif endif *--#] no transformation: elseif ( iclas1 .eq. 2 ) then *--#[ transform 1-x: * * we tranformed to 1-x for both dilogs * if ( absc(cc1p) .lt. xloss ) then clog1 = zfflo1(cc1p,ier) else clog1 = zfflog(cc1,ieps,-cy,ier) endif if ( Im(cc2p).eq.0 ) then if ( Im(cc1p).eq.0 ) then * use the ieps instead n3 = 0 else n3 = nffet1(ToComplex(Re(0),ieps*Re(cy)), + 1/cc1p,cc2p/cc1p,ier) endif else if ( Im(cc1p).eq.0 ) then n3 =nffet1(cc2p,ToComplex(Re(0),-ieps*Re(cy1)), + cc2p/cc1p,ier) else n3 = nffet1(cc2p,1/cc1p,cz,ier) endif endif ntot = n1-n2-n3 crr(5) = (ntot*c2ipi + clo1)*clog1 clog2p = zfflog(cc2p,ieps,cy,ier) crr(6) = clo2*(n2*c2ipi - clog2p) *--#] transform 1-x: elseif ( iclas1 .eq. 3 ) then *--#[ transform 1/x: * * we transformed to 1/x for both dilogs * clog2p = zfflog(-cc2p,ieps,cy1,ier) if ( Im(cc2p).eq.0 .or. Im(cc1).eq.0 ) then * we chose the eta's already equal, no worry. n3 = 0 n3p = 0 else n3 = nffet1(-cc2p,-cc1,-cy/cy1,ier) n3p = nffet1(cc2p,cc1,-cy/cy1,ier) endif if ( n3.ne.0 .or. n3p.ne.0 .or. n1.ne.n2 ) then * for the time being the normal terms, I'll have to think of * something smarter one day clog1p = zfflog(-cc1p,ieps,-cy,ier) crr(5) = -clog1p**2/2 crr(6) = +clog2p**2/2 crr(7) = (n1*zfflog(cc1,ieps,cy,ier) - + n2*zfflog(cc2,ieps,-cy1,ier))*c2ipi else crr(5) = clo1*(n2*c2ipi + clog2p - clo1/2) endif *--#] transform 1/x: endif * -#] handle eta + transformation terms: * -#[ add up: if ( iclas1 .eq. 1 .or. iclas1 .eq. 4 ) then crr(1) = cli1 crr(2) = cli2 crr(3) = - cli3 crr(4) = chill else crr(1) = - cli1 crr(2) = - cli2 crr(3) = cli3 crr(4) = - chill endif * -#] add up: else * Normal case: * -#[ handle dilogs: * * the dilogs will not come close together so just go on * only the special case cc1p ~ (-1,0) needs special attention * if ( iclas1 .ne. 4 .or. .not. ld2yzz ) then call ffzli2(cli1,clo1,cc1p,ier) else cd2 = cd2yzz + czz if ( absc(cd2) .lt. xloss*absc(cd2yzz) ) then cd2 = cy + cdyz endif cd2 = cd2/cdyz cfact = 1/(2-cd2) call ffzli2(cli1,clo1,cd2*cfact,ier) call ffzli2(cli3,clo3,-cd2*cfact,ier) call ffzli2(cli4,clo4,cd2,ier) endif if ( iclas2 .ne. 4 .or. .not. ld2yzz ) then call ffzli2(cli2,clo2,cc2p,ier) else if ( iclas1 .eq. 4 ) call fferr(26,ier) cd2 = cd2yzz - czz1 if ( absc(cd2) .lt. xloss*absc(cd2yzz) ) then cd2 = cdyz - cy1 endif cd2 = cd2/cdyz cfact = 1/(2-cd2) call ffzli2(cli2,clo2,cd2*cfact,ier) call ffzli2(cli3,clo3,-cd2*cfact,ier) call ffzli2(cli4,clo4,cd2,ier) endif * -#] handle dilogs: * -#[ handle eta terms: * * the eta's * if ( n1 .ne. 0 ) then if ( iclas1 .ne. 2 .or. absc(cc1p) .gt. xloss ) then if ( Re(cc1) .gt. -abs(Im(cc1)) ) then clog1 = zfflog(cc1,ieps,cy,ier) else * take apart the factor i*pi^2 if ( iclas1 .eq. 4 ) then clog1 = zfflo1(cd2,ier) else clog1 = zfflog(-cc1,0,cy,ier) endif if ( Im(cc1) .lt. 0 ) then i2pi = -1 elseif ( Im(cc1) .gt. 0 ) then i2pi = +1 elseif ( Re(cy)*ieps .lt. 0 ) then i2pi = -1 elseif ( Re(cy)*ieps .gt. 0 ) then i2pi = +1 else call fferr(51,ier) i2pi = 0 endif ipi12 = ipi12 - n1*24*i2pi endif else clog1 = zfflo1(cc1p,ier) endif crr(5) = n1*c2ipi*clog1 * else * crr(5) = 0 endif if ( n2 .ne. 0 ) then if ( iclas2 .ne. 2 .or. absc(cc2p) .gt. xloss ) then if ( Re(cc2) .gt. -abs(Im(cc2)) ) then clog2 = zfflog(cc2,ieps,cy,ier) else * take apart the factor i*pi^2 if ( iclas2 .eq. 4 ) then clog2 = zfflo1(cd2,ier) else clog2 = zfflog(-cc2,0,czero,ier) endif if ( Im(cc2) .lt. 0 ) then i2pi = -1 elseif ( Im(cc2) .gt. 0 ) then i2pi = +1 elseif ( Re(cy)*ieps .lt. 0 ) then i2pi = -1 elseif ( Re(cy)*ieps .gt. 0 ) then i2pi = +1 else call fferr(51,ier) i2pi = 0 endif ipi12 = ipi12 + n2*24*i2pi endif else clog2 = zfflo1(cc2p,ier) endif crr(6) = n2*c2ipi*clog2 * else * crr(6) = 0 endif * -#] handle eta terms: * -#[ handle transformation terms: * * transformation of cc1 * if ( iclas1 .eq. 1 ) then * crr(3) = 0 elseif( iclas1 .eq. 2 ) then cli1 = -cli1 ipi12 = ipi12 + 2 crr(3) = - clo1*zfflog(cc1p,ieps,cy,ier) elseif ( iclas1 .eq. 3 ) then cli1 = -cli1 ipi12 = ipi12 - 2 clog1p = zfflog(-cc1p,ieps,cy1,ier) crr(3) = - clog1p**2/2 elseif ( iclas1 .eq. 4 ) then * Note that this sum does not cause problems as d2<<1 crr(3) = -cli3 - cli4 + clo4*zfflog(cfact,0,czero,ier) ipi12 = ipi12 - 1 else call fferr(25,ier) endif * * transformation of cc2 * if ( iclas2 .eq. 1 ) then elseif( iclas2 .eq. 2 ) then cli2 = -cli2 ipi12 = ipi12 - 2 crr(4) = clo2*zfflog(cc2p,ieps,cy,ier) elseif ( iclas2 .eq. 3 ) then cli2 = -cli2 ipi12 = ipi12 + 2 clog2p = zfflog(-cc2p,ieps,cy1,ier) crr(4) = clog2p**2/2 elseif ( iclas2 .eq. 4 ) then * Note that this sum does not cause problems as d2<<1 crr(4) = cli3 + cli4 - clo4*zfflog(cfact,0,czero,ier) ipi12 = ipi12 + 1 else call fferr(27,ier) endif * -#] handle transformation terms: * -#[ sum: crr(1) = cli1 crr(2) = - cli2 crr(6) = - crr(6) * crr(7) = 0 * -#] sum: endif * #] calculations: *###] ffcrr: end LoopTools-2.16/src/util/PaxHeaders/Dump.F0000644000000000000000000000007413262230206015233 xustar0030 atime=1648161785.711698365 30 ctime=1648161793.715764879 LoopTools-2.16/src/util/Dump.F0000644000000000000000000000230113262230206016142 0ustar00rootroot00000000000000* Dump.F * dumps the parameters and coefficients on screen * this file is part of LoopTools * last modified 7 Apr 18 th #include "externals.h" #include "types.h" #include "defs.h" subroutine XDumpPara(npoint, para, origin) implicit none integer npoint ArgType para(1,*) character*(*) origin #include "lt.h" #include "ltnames.h" integer i integer npara(5) data npara /Paa, Pbb, Pcc, Pdd, Pee/ #ifdef COMPLEXPARA if( len(origin) .gt. 1 ) print *, origin, "C", serial #else if( len(origin) .gt. 1 ) print *, origin, serial #endif do i = npoint + 1, npara(npoint) print *, " ", paraname(i,npoint), "=", para(1,i) enddo do i = 1, npoint print *, " ", paraname(i,npoint), "=", para(1,i) enddo call flush(6) end ************************************************************************ subroutine XDumpCoeff(npoint, coeff) implicit none integer npoint ComplexType coeff(*) #include "lt.h" #include "ltnames.h" integer i integer ncoeff(5) data ncoeff /Naa, Nbb, Ncc, Ndd, Nee/ do i = 1, ncoeff(npoint) if( coeff(i) .ne. 0 ) & print *, coeffname(i,npoint), "=", coeff(i) enddo print *, "====================================================" call flush(6) end LoopTools-2.16/src/util/PaxHeaders/ffcxs4.F0000644000000000000000000000013213576640432015534 xustar0030 mtime=1576747290.714915856 30 atime=1648161785.711698365 30 ctime=1648161793.715764879 LoopTools-2.16/src/util/ffcxs4.F0000644000000000000000000005002713576640432016460 0ustar00rootroot00000000000000#include "externals.h" #include "types.h" * $Id: ffcxs4.f,v 1.3 1995/10/17 06:55:09 gj Exp $ * $Log: ffcxs4.f,v $ c Revision 1.3 1995/10/17 06:55:09 gj c Fixed ieps error in ffdcrr (ffcxs4.f), added real case in ffcrr, debugging c info in ffxd0, and warned against remaining errors for del2=0 in ffrot4 c (ffxd0h.f) c c Revision 1.2 1995/10/06 09:17:22 gj c Found stupid typo in ffxc0p which caused the result to be off by pi^2/3 in c some equal-mass cases. Added checks to ffcxs4.f ffcrr.f. c *###[ ffcxs4: subroutine ffcxs4(cs3,ipi12,w,y,z,dwy,dwz,dyz,d2yww,d2yzz, + xpi,piDpj,ii,ns,isoort,ier) ***#[*comment:*********************************************************** * * * Calculate the 8 Spence functions = 4 R's = 2 dR's * * * * * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments: * integer ipi12(4),ii,ns,isoort(4),ier ComplexType cs3(40) RealType w(4),y(4),z(4),dwy(2,2),dwz(2,2),dyz(2,2), + d2yww,d2yzz,xpi(ns),piDpj(ns,ns),x00(3) * * local variables: * integer iepz(2),iepw(2) logical ld2yzz,ld2yww * * common blocks * #include "ff.h" * #] declarations: * #[ groundwork: if ( isoort(2) .eq. 0 ) then ld2yzz = .FALSE. else ld2yzz = .TRUE. endif if ( isoort(4) .eq. 0 ) then ld2yww = .FALSE. else ld2yww = .TRUE. endif if ( isoort(2) .ne. 0 ) then if ( z(2) .gt. z(1) .eqv. xpi(ii+3) .gt. 0 ) then iepz(1) = +1 iepz(2) = -1 else iepz(1) = -1 iepz(2) = +1 endif else print *,'ffcxs4: error: untested algorithm' if ( piDpj(ii,ii+3) .gt. 0 ) then iepz(1) = +1 else iepz(1) = -1 endif endif if ( isoort(4) .ne. 0 ) then if ( w(2) .gt. w(1) .eqv. xpi(5) .gt. 0 ) then iepw(1) = 1 iepw(2) = -1 else iepw(1) = -1 iepw(2) = 1 endif else print *,'ffcxs4: error: untested algorithm' if ( piDpj(2,5) .gt. 0 ) then iepw(1) = +1 else iepw(1) = -1 endif endif * #] groundwork: * #[ zm and wp: if ( isoort(4) .eq. 0 ) then call ffcxr(cs3(1),ipi12(1),y(2),y(4),z(1),z(3),dyz(2,1), + ld2yzz,d2yzz,z(2),z(4),.FALSE.,x00,iepz(1),ier) else if ( .not. ( dwz(2,1).eq.0 .and. iepz(1).eq.iepw(2) ) ) + call ffdcxr(cs3( 1),ipi12(1),y(2),y(4),z(1),z(3), + z(2),z(4),d2yzz,w(2),w(4),w(1),w(3),d2yww, + dyz(2,1),dwy(2,2),dwz(2,1),iepz(1),iepw(2),ier) endif * #] zm and wp: * #[ zp and wm: if ( isoort(2) .eq. 0 ) then call ffcxr(cs3(1),ipi12(1),y(2),y(4),w(1),w(3),-dwy(1,2), + ld2yww,d2yww,w(2),w(4),.FALSE.,x00,iepw(1),ier) else if ( .not. ( dwz(1,2).eq.0 .and. iepz(2).eq.iepw(1) ) ) + call ffdcxr(cs3(21),ipi12(3),y(2),y(4),z(2),z(4), + z(1),z(3),d2yzz,w(1),w(3),w(2),w(4),d2yww, + dyz(2,2),dwy(1,2),dwz(1,2),iepz(2),iepw(1),ier) endif * #] zp and wm: *###] ffcxs4: end *###[ ffcs4: subroutine ffcs4(cs3,ipi12,cw,cy,cz,cdwy,cdwz,cdyz,cd2yww,cd2yzz + ,cpi,cpiDpj,cp2p,ii,ns,isoort,ier) ***#[*comment:*********************************************************** * * * Calculate the 8 Spence functions = 4 R's = 2 dR's * * * * * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments: * integer ipi12(4),ii,ns,isoort(4),ier ComplexType cs3(40) ComplexType cw(4),cy(4),cz(4),cdwy(2,2),cdwz(2,2),cdyz(2,2) ComplexType cd2yww,cd2yzz,cpi(ns),cp2p,cpiDpj(ns,ns) * * local variables: * logical ld2yzz,ld2yww integer i,j,ip,iepz(2),iepw(2),nz(4),nw(4),ntot,i2pi ComplexType c,cc,clogy,c2y1,cdyw(2,2) ComplexType zfflo1,zfflog RealType absc external zfflo1,zfflog * * common blocks * #include "ff.h" * * statement function * absc(c) = abs(Re(c)) + abs(Im(c)) * #] declarations: * #[ get counters: ip = ii+3 if ( isoort(2) .eq. 0 ) then ld2yzz = .FALSE. else ld2yzz = .TRUE. endif if ( isoort(4) .eq. 0 ) then ld2yww = .FALSE. else ld2yww = .TRUE. endif call ffieps(iepz,cz,cpi(ip),cpiDpj(ip,ii),isoort) call ffieps(iepw,cw,cp2p,cpiDpj(ip,ii),isoort(3)) if ( isoort(4) .eq. 0 ) then print *,'ffcs4: error: case not implemented' ier = ier + 50 endif * #] get counters: * #[ R's: if ( isoort(4) .eq. 0 ) then call ffcrr(cs3(1),ipi12(1),cy(2),cy(4),cz(1),cz(3),cdyz(2,1) + ,ld2yzz,cd2yzz,cz(2),cz(4),isoort(4),iepz(1),ier) else if ( .not. ( cdwz(2,1).eq.0 .and. iepz(1).eq.iepw(2) ) ) + call ffdcrr(cs3( 1),ipi12(1),cy(2),cy(4),cz(1),cz(3),cz(2), + cz(4),cd2yzz,cw(2),cw(4),cw(1),cw(3),cd2yww,cdyz(2,1), + cdwy(2,2),cdwz(2,1),isoort(4),iepz(1),iepw(2),ier) endif if ( isoort(2) .eq. 0 ) then call ffcrr(cs3(1),ipi12(1),cy(2),cy(4),cw(1),cw(3),-cdwy(1,2 + ),ld2yww,cd2yww,cw(2),cw(4),isoort(2),iepw(1),ier) else if ( .not. ( cdwz(1,2).eq.0 .and. iepz(2).eq.iepw(1) ) ) + call ffdcrr(cs3(21),ipi12(3),cy(2),cy(4),cz(2),cz(4),cz(1), + cz(3),cd2yzz,cw(1),cw(3),cw(2),cw(4),cd2yww,cdyz(2,2), + cdwy(1,2),cdwz(1,2),iepz(2),isoort(2),iepw(1),ier) endif * #] R's: * #[ eta's: if ( Im(cpi(ip)) .eq. 0 ) then call ffgeta(nz,cz,cdyz, + cpi(ip),cpiDpj(ii,ip),iepz,isoort,ier) do i=1,2 do j=1,2 cdyw(i,j) = cdwy(j,i) enddo enddo call ffgeta(nw,cw,cdyw, + cp2p,cpiDpj(ii,ip),iepw,isoort(3),ier) else print *,'ffcs4: error: not ready for complex D0 yet' endif ntot = nz(1)+nz(2)+nz(3)+nz(4)-nw(1)-nw(2)-nw(3)-nw(4) if ( ntot .ne. 0 ) then i2pi = 0 if ( 1/absc(cy(2)) .lt. xloss ) then clogy = zfflo1(1/cy(2),ier) else c = -cy(4)/cy(2) if ( Re(c) .gt. -abs(Im(c)) ) then clogy = zfflog(c,0,czero,ier) else * take out the factor 2*pi^2 cc = c+1 if ( absc(cc) .lt. xloss ) then c2y1 = -cd2yzz - cz(1) + cz(4) if ( absc(c2y1) .lt. xloss*max(absc(cz(1)), + absc(cz(4))) ) then c2y1 = -cd2yzz - cz(2) + cz(3) endif clogy = zfflo1(-c2y1/cy(2),ier) else clogy = zfflog(-c,0,czero,ier) endif if ( Im(c) .lt. 0 ) then i2pi = -1 elseif ( Im(c) .gt. 0 ) then i2pi = +1 else call fferr(51,ier) i2pi = 0 endif ipi12(2) = ipi12(2) - ntot*24*i2pi endif endif if ( cs3(40) .ne. 0 ) print *,'ffcs4: error: cs3(40) != 0' cs3(40) = ntot*c2ipi*clogy endif * #] eta's: *###] ffcs4: end *###[ ffdcxr: subroutine ffdcxr(cs3,ipi12,y,y1,z,z1,zp,zp1,d2yzz, + w,w1,wp,wp1,d2yww,dyz,dwy,dwz,iepsz,iepsw,ier) ***#[*comment:*********************************************************** * * * Calculate * * * * R(y,z,iepsz) - R(y,w,iepsw) * * * * Input: * * a = [yzw] (real) see definition * * a1 = 1 - a (real) * * dab = a - b (real) * * ieps[zw] (integer) sign of imaginary part * * of argument logarithm * * cs3(20) (complex) assumed zero * * * * Output: * * cs3(20) (complex) the results, not added * * ipi12(2) (integer) factors pi^2/12 * * * * Calls: ffcxr * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments: * integer ipi12(2),iepsz,iepsw,ier ComplexType cs3(20) RealType y,z,w,y1,z1,w1,dyz,dwy,dwz,zp,zp1,d2yzz,wp,wp1, + d2yww * * local variables: * integer i,ieps logical again RealType yy,yy1,zz,zz1,dyyzz,xx1,xx1n,term,tot,d2,d3, + d21,d31,d2n,d3n,d21n1,d31n1,dw,x00(3) ComplexType chulp RealType dfflo1 external dfflo1 * * common blocks * #include "ff.h" * #] declarations: * #[ groundwork: if ( dwz .eq. 0 .and. iepsz .eq. iepsw ) return if ( dyz .eq. 0 ) then call fferr(75,ier) return endif xx1 = y/dyz dw = dwz/dyz if ( xx1 .le. .5D0 .or. xx1 .gt. 2 ) then d2 = 1/y dw = dw*y/w else d2 = 1/z1 endif again = .FALSE. 123 continue * #] groundwork: * #[ trivial case: if ( dw .eq. 0 ) then * #] trivial case: * #[ normal case: elseif ( abs(dw) .gt. xloss .or. again ) then * nothing's the matter call ffcxr(cs3( 1),ipi12(1),y,y1,z,z1,dyz, + .TRUE.,d2yzz,zp,zp1,.FALSE.,x00,iepsz,ier) call ffcxr(cs3(11),ipi12(2),y,y1,w,w1,-dwy, + .TRUE.,d2yww,wp,wp1,.FALSE.,x00,iepsw,ier) do i=11,20 cs3(i) = -cs3(i) enddo ipi12(2) = -ipi12(2) * #] normal case: * #[ only cancellations in w, not in y: elseif ( abs(d2) .gt. xloss ) then * there are no cancellations the other way: if ( iepsz .ne. iepsw .and. ( y/dyz .gt. 1 .or.-y/dwy .gt. + 1 ) ) then again = .TRUE. goto 123 endif yy = dwy/dwz zz = yy*z/y yy1 = dyz/dwz zz1 = yy1*w/y dyyzz = yy*dyz/y if ( y .lt. 0 ) then ieps = iepsz else ieps = -iepsz endif call ffcxr(cs3( 1),ipi12(1),yy,yy1,zz,zz1,dyyzz,.FALSE., + 0D0,0D0,0D0,.FALSE.,x00,2*ieps,ier) zz = yy*z1/y1 zz1 = yy1*w1/y1 dyyzz = -yy*dyz/y1 if ( y1 .gt. 0 ) then ieps = iepsz else ieps = -iepsz endif call ffcxr(cs3(11),ipi12(2),yy,yy1,zz,zz1,dyyzz,.FALSE., + 0D0,0D0,0D0,.FALSE.,x00,2*ieps,ier) do 20 i=11,20 cs3(i) = -cs3(i) 20 continue ipi12(2) = -ipi12(2) * #] only cancellations in w, not in y: * #[ Hill identity: elseif ( ( 1 .gt. xloss*abs(y) .or. abs(xx1) .gt. xloss ) + .and. ( 1 .gt. xloss*abs(z) .or. abs(z/dyz) .gt. xloss ) + .and. ( 1 .gt. xloss*abs(y) .or. abs(dyz/y) .gt. xloss ) + ) then * do a Hill identity on the y,y-1 direction yy = -y*w1/dwy yy1 = w*y1/dwy zz = -z*w1/dwz zz1 = w*z1/dwz dyyzz = -w*w1*(dyz/(dwy*dwz)) if ( y*dwz .gt. 0 .eqv. (y+dwz) .gt. 0 ) then ieps = 2*iepsw else ieps = -2*iepsw endif call ffcxr(cs3( 1),ipi12(1),yy,yy1,zz,zz1,dyyzz,.FALSE., + 0D0,0D0,0D0,.FALSE.,x00,ieps,ier) yy = w1 yy1 = w zz = -w1*z/dwz zz1 = w*z1/dwz dyyzz = w*w1/dwz call ffcxr(cs3( 9),ipi12(2),yy,yy1,zz,zz1,dyyzz,.FALSE., + 0D0,0D0,0D0,.FALSE.,x00,ieps,ier) do 30 i=9,16 cs3(i) = -cs3(i) 30 continue ipi12(2) = -ipi12(2) * the extra logarithms ... if ( 1 .lt. xloss*abs(w) ) then chulp = dfflo1(1/w,ier) elseif ( w1 .lt. 0 .or. w .lt. 0 ) then chulp = log(-w1/w) else chulp = ToComplex(Re(log(w1/w)),Re(-iepsw*pi)) endif cs3(20) = -Re(dfflo1(dwz/dwy,ier))*chulp * #] Hill identity: * #[ Taylor expansion: elseif ( (w.lt.0..or.w1.lt.0) .and. (z.lt.0..or.z1.lt.0) ) then * do a Taylor expansion if ( abs(xx1) .lt. xloss ) then d3 = dwz/dwy xx1n = xx1 d2n = d2 d3n = d3 d21 = 1-d2 d21n1 = 1 d31 = 1-d3 d31n1 = 1 tot = xx1*d2*d3 do 50 i=2,20 xx1n = xx1n*xx1 d21n1 = d21n1*d21 d31n1 = d31n1*d31 d2n = d2n + d2*d21n1 d3n = d3n + d3*d31n1 term = xx1n*d2n*d3n*xn2inv(i) tot = tot + term if ( abs(term) .le. precx*abs(tot) ) goto 51 50 continue 51 continue cs3(1) = tot elseif ( abs(z/dyz) .lt. xloss ) then call ffcxr(cs3( 1),ipi12(1),y,y1,z,z1,dyz, + .TRUE.,d2yzz,zp,zp1,.FALSE.,x00,iepsz,ier) call ffcxr(cs3(11),ipi12(2),y,y1,w,w1,-dwy, + .TRUE.,d2yww,wp,wp1,.FALSE.,x00,iepsw,ier) do i=11,20 cs3(i) = -cs3(i) enddo else call fferr(22,ier) return endif else call ffcxr(cs3( 1),ipi12(1),y,y1,z,z1,dyz,.FALSE., + 0D0,0D0,0D0,.FALSE.,x00,iepsz,ier) call ffcxr(cs3(11),ipi12(2),y,y1,w,w1,-dwy,.FALSE., + 0D0,0D0,0D0,.FALSE.,x00,iepsw,ier) do i=11,20 cs3(i) = -cs3(i) enddo ipi12(2) = -ipi12(2) endif * #] Taylor expansion: *###] ffdcxr: end *###[ ffdcrr: subroutine ffdcrr(cs3,ipi12,cy,cy1,cz,cz1,czp,czp1,cd2yzz,cw,cw1 + ,cwp,cwp1,cd2yww,cdyz,cdwy,cdwz,isoort,iepsz,iepsw,ier) ***#[*comment:*********************************************************** * * * Calculate * * * * R(cy,cz,iepsz) - R(cy,cw,iepsw) * * * * Input: * * a = [yzw] (real) see definition * * a1 = 1 - a (real) * * dab = a - b (real) * * ieps[zw] (integer) sign of imaginary part * * of argument logarithm * * cs3(20) (complex) assumed zero * * * * Output: * * cs3(20) (complex) the results, not added * * ipi12(2) (integer) factors pi^2/12 * * * * Calls: ffcrr * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments: * integer ipi12(2),isoort,iepsz,iepsw,ier ComplexType cs3(20) ComplexType cy,cz,czp,cw,cwp,cy1,cz1,czp1,cw1,cwp1, + cdyz,cdwy,cdwz,cd2yzz,cd2yww * * local variables: * integer i,ieps,ieps1,ieps2, + nffeta,nffet1,n1,n2,n3,n4,n5,n6 logical ld2yyz ComplexType cyy,cyy1,czz,czz1,cdyyzz,chulp,zfflo1,zfflog, + cc1,cdw,cc1n,cterm,ctot,cd2,cd3, + cd21,cd31,cd2n,cd3n,cd21n1,cd31n1, + cc2,cfactz,cfactw,czzp,czzp1,cd2yyz ComplexType c RealType absc external nffeta,nffet1,zfflo1,zfflog * * common blocks * #include "ff.h" * * statement function * absc(c) = abs(Re(c)) + abs(Im(c)) * #] declarations: * #[ groundwork: if ( cdwz .eq. 0 ) then if ( abs(Im(cz)) .gt. precc*abs(Re(cz)) .or. + iepsz .eq. iepsw ) return if ( Re(cz) .ge. 0 .and. Re(cz1) .ge. 0 ) return call fferr(76,ier) return endif if ( cdyz .eq. 0 ) then call fferr(77,ier) return endif cc1 = cy/cdyz cdw = cdwz/cdyz if ( Re(cc1) .le. .5D0 .or. abs(cc1-1) .gt. 1 ) then cd2 = 1/cy cdw = cdw*cy/cw else cd2 = 1/cz1 endif * #] groundwork: * #[ trivial case: if ( absc(cdw) .eq. 0 ) then * #] trivial case: * #[ normal case: * * if no cancellations are expected OR the imaginary signs differ * and are significant * elseif ( absc(cdw) .gt. xloss .or. (iepsz.ne.iepsw .and. + (Re(cy/cdyz).gt.1 .or. Re(-cy1/cdyz).gt.1) ) ) then * nothing's the matter * special case to avoid bug found 15-oct=1995 if ( iepsz.eq.iepsw ) then if ( Im(cz).eq.0 .and. Im(cz1).eq.0 ) then print *,'ffdcrr: flipping sign iepsz' iepsz = -iepsz elseif ( Im(cw).eq.0 .and. Im(cw1).eq.0 ) then print *,'ffdcrr: flipping sign iepsw' iepsw = -iepsw else print *,'ffdcrr: error: missing eta terms!' ier = ier + 100 endif endif call ffcrr(cs3(1),ipi12(1),cy,cy1,cz,cz1,cdyz,.TRUE., + cd2yzz,czp,czp1,isoort,iepsz,ier) call ffcrr(cs3(8),ipi12(2),cy,cy1,cw,cw1,-cdwy,.TRUE., + cd2yww,cwp,cwp1,isoort,iepsw,ier) do 10 i=8,14 cs3(i) = -cs3(i) 10 continue ipi12(2) = -ipi12(2) * #] normal case: * #[ only cancellations in cw, not in cy: elseif ( absc(cd2) .gt. xloss ) then * there are no cancellations the other way: cyy = cdwy/cdwz czz = cz*cyy/cy cyy1 = cdyz/cdwz czz1 = cyy1*cw/cy cdyyzz = cdyz*cyy/cy if ( Re(cy) .gt. 0 ) then ieps1 = -3*iepsz else ieps1 = +3*iepsz endif * Often 2y-z-z is relevant, but 2*yy-zz-zz is not, solve by * introducing zzp. czzp = czp*cyy/cy cd2yyz = cd2yzz*cyy/cy czzp1 = 1 - czzp if ( absc(czzp1) .lt. xloss ) then * later try more possibilities ld2yyz = .FALSE. else ld2yyz = .TRUE. endif call ffcrr(cs3(1),ipi12(1),cyy,cyy1,czz,czz1,cdyyzz, + ld2yyz,cd2yyz,czzp,czzp1,isoort,ieps1,ier) czz = cyy*cz1/cy1 czz1 = cyy1*cw1/cy1 if ( Re(-cy1) .gt. 0 ) then ieps2 = -3*iepsz else ieps2 = +3*iepsz endif cdyyzz = -cyy*cdyz/cy1 czzp = czp1*cyy/cy1 cd2yyz = -cd2yzz*cyy/cy1 czzp1 = 1 - czzp if ( absc(czzp1) .lt. xloss ) then * later try more possibilities ld2yyz = .FALSE. else ld2yyz = .TRUE. endif call ffcrr(cs3(8),ipi12(2),cyy,cyy1,czz,czz1,cdyyzz, + .TRUE.,cd2yyz,czzp,czzp1,isoort,ieps2,ier) do 20 i=8,14 cs3(i) = -cs3(i) 20 continue ipi12(2) = -ipi12(2) * eta terms (are not calculated in ffcrr as ieps = 3) cfactz = 1/cdyz if ( Im(cz) .eq. 0 ) then if ( Im(cy) .eq. 0 ) then n1 = 0 n2 = 0 else n1 = nffet1(ToComplex(Re(0),Re(iepsz)),cfactz, + -cz*cfactz,ier) n2 = nffet1(ToComplex(Re(0),Re(iepsz)),cfactz, + cz1*cfactz,ier) endif else n1 = nffeta(-cz,cfactz,ier) n2 = nffeta(cz1,cfactz,ier) endif cfactw = -1/cdwy if ( Im(cw) .eq. 0 ) then if ( Im(cy) .eq. 0 ) then n4 = 0 n5 = 0 else n4 = nffet1(ToComplex(Re(0),Re(iepsw)),cfactw, + -cw*cfactw,ier) n5 = nffet1(ToComplex(Re(0),Re(iepsw)),cfactw, + cw1*cfactw,ier) endif else n4 = nffeta(-cw,cfactw,ier) n5 = nffeta(cw1,cfactw,ier) endif * * we assume that cs3(15-17) are not used, this is always true * n3 = 0 n6 = 0 if ( n1.eq.n4 ) then if ( n1.eq.0 ) then * nothing to do else cc1 = cdwz/cdyz if ( absc(cc1) .lt. xloss ) then cs3(15) = n1*c2ipi*zfflo1(cc1,ier) else cc1 = -cdwy/cdyz cs3(15) = n1*c2ipi*zfflog(cc1,0,czero,ier) endif cc1 = cy*cfactz cc2 = cy*cfactw if ( Im(cc1).eq.0 .or. Im(cc2).eq.0 ) then n3 = 0 else n3 = nffeta(cc1,1/cc2,ier) endif if ( n3.ne.0 ) then print *,'ffdcrr: error: untested algorithm' ier = ier + 50 ipi12(1) = ipi12(1) + 4*12*n1*n3 endif endif else cc1 = cy*cfactz cc2 = cy*cfactw cs3(15) = (n1*zfflog(cc1,ieps1,czero,ier) + + n4*zfflog(cc2,ieps1,czero,ier))*c2ipi endif if ( n2.eq.n5 ) then if ( n2.eq.0 ) then * nothing to do else cc1 = cdwz/cdyz if ( absc(cc1) .lt. xloss ) then cs3(16) = n2*c2ipi*zfflo1(cc1,ier) else cc1 = -cdwy/cdyz cs3(16) = n2*c2ipi*zfflog(cc1,0,czero,ier) endif cc1 = -cy1*cfactz cc2 = -cy1*cfactw if ( Im(cc1).eq.0 .or. Im(cc2).eq.0 ) then n6 = 0 else n6 = nffeta(cc1,1/cc2,ier) endif if ( n6.ne.0 ) then print *,'ffdcrr: error: untested algorithm' ier = ier + 50 ipi12(2) = ipi12(2) + 4*12*n2*n6 endif endif else cc1 = -cy1*cfactz cc2 = -cy1*cfactw cs3(15) = (n2*zfflog(cc1,ieps2,czero,ier) + + n5*zfflog(cc2,ieps2,czero,ier))*c2ipi endif * #] only cancellations in cw, not in cy: * #[ Hill identity: elseif ( ( 1.gt.xloss*absc(cy) .or. absc(cc1).gt.xloss ) + .and. ( 1.gt.xloss*absc(cz) .or. absc(cz/cdyz).gt.xloss ) + .and. ( 1.gt.xloss*absc(cy) .or. absc(cdyz/cy).gt.xloss ) + ) then * do a Hill identity on the cy,cy-1 direction cyy = -cy*cw1/cdwy cyy1 = cw*cy1/cdwy czz = -cz*cw1/cdwz czz1 = cw*cz1/cdwz cdyyzz = -cw*cw1*(cdyz/(cdwy*cdwz)) ieps = -2*iepsz call ffcrr(cs3(1),ipi12(1),cyy,cyy1,czz,czz1,cdyyzz, + .FALSE.,czero,czero,czero,isoort,ieps,ier) cyy = cw1 cyy1 = cw czz = -cw1*cz/cdwz czz1 = cw*cz1/cdwz cdyyzz = cw*cw1/cdwz call ffcrr(cs3(8),ipi12(2),cyy,cyy1,czz,czz1,cdyyzz, + .FALSE.,czero,czero,czero,isoort,0,ier) do i=8,14 cs3(i) = -cs3(i) enddo ipi12(2) = -ipi12(2) * the extra logarithms ... if ( 1 .lt. xloss*absc(cw) ) then chulp = zfflo1(1/cw,ier) else chulp = zfflog(-cw1/cw,0,czero,ier) endif cs3(15) = -zfflo1(cdwz/cdwy,ier)*chulp * #] Hill identity: * #[ Taylor expansion: else * Do a Taylor expansion if ( absc(cc1) .lt. xloss ) then cd3 = cdwz/cdwy * isign = 1 cc1n = cc1 cd2n = cd2 cd3n = cd3 cd21 = 1-cd2 cd21n1 = 1 cd31 = 1-cd3 cd31n1 = 1 ctot = cc1*cd2*cd3 do 50 i=2,20 cc1n = cc1n*cc1 cd21n1 = cd21n1*cd21 cd31n1 = cd31n1*cd31 cd2n = cd2n + cd2*cd21n1 cd3n = cd3n + cd3*cd31n1 cterm = cc1n*cd2n*cd3n*Re(xn2inv(i)) ctot = ctot + cterm if ( absc(cterm) .lt. precc*absc(ctot) ) goto 51 50 continue 51 continue cs3(1) = ctot elseif ( absc(cz/cdyz) .lt. xloss ) then call ffcrr(cs3(1),ipi12(1),cy,cy1,cz,cz1,cdyz,.TRUE., + cd2yzz,czp,czp1,isoort,iepsz,ier) call ffcrr(cs3(8),ipi12(2),cy,cy1,cw,cw1,-cdwy,.TRUE., + cd2yww,cwp,cwp1,isoort,iepsw,ier) do i=8,14 cs3(i) = -cs3(i) enddo ipi12(2) = -ipi12(2) else call fferr(20,ier) return endif endif * #] Taylor expansion: *###] ffdcrr: end LoopTools-2.16/src/util/PaxHeaders/solve.F0000644000000000000000000000007413262607105015464 xustar0030 atime=1648161785.711698365 30 ctime=1648161793.715764879 LoopTools-2.16/src/util/solve.F0000644000000000000000000001073113262607105016401 0ustar00rootroot00000000000000* solve-LU.F * Solution of the linear system A.x = B by LU decomposition * with partial pivoting * this file is part of LoopTools * last modified 9 Apr 18 th * Author: Michael Rauch, 7 Dec 2004 * Reference: Folkmar Bornemann, lecture notes to * Numerische Mathematik 1, Technical University, Munich, Germany #include "externals.h" #include "types.h" #include "defs.h" #define EPS 2D0**(-51) ************************************************************************ * XDecomp computes the LU decomposition of the n-by-n matrix A * by Gaussian Elimination with partial pivoting; * compact (in situ) storage scheme * Input: * A: n-by-n matrix to LU-decompose * n: dimension of A * Output: * A: mangled LU decomposition of A in the form * ( y11 y12 ... y1n ) * ( x21 y22 ... y2n ) * ( x31 x32 ... y3n ) * ( ............... ) * ( xn1 xn2 ... ynn ) * where * ( 1 0 ... 0 ) ( y11 y12 ... y1n ) * ( x21 1 ... 0 ) ( 0 y22 ... y2n ) * ( x31 x32 ... 0 ) ( 0 0 ... y3n ) = Permutation(A) * ( ............... ) ( ............... ) * ( xn1 xn2 ... 1 ) ( 0 0 ... ynn ) * perm: permutation vector subroutine XDecomp(n, A,ldA, perm) implicit none integer n, ldA, perm(*) ArgQuad A(ldA,*) integer i, j, k, pj, invperm(MAXDIM) ArgQuad tmp RealQuad absA, pabsA do j = 1, n invperm(j) = j enddo do j = 1, n * do U part (minus diagonal one) do i = 2, j - 1 tmp = 0 do k = 1, i - 1 tmp = tmp + A(i,k)*A(k,j) enddo A(i,j) = A(i,j) - tmp enddo * do L part (plus diagonal from U case) pabsA = -1 pj = j do i = j, n tmp = 0 do k = 1, j - 1 tmp = tmp + A(i,k)*A(k,j) enddo A(i,j) = A(i,j) - tmp * do partial pivoting ... * find the pivot absA = abs(A(i,j)) if( absA .gt. pabsA ) then pabsA = absA pj = i endif enddo perm(invperm(pj)) = j * exchange rows if( pj .ne. j ) then invperm(pj) = invperm(j) do k = 1, n tmp = A(j,k) A(j,k) = A(pj,k) A(pj,k) = tmp enddo endif * division by the pivot element if( abs(A(j,j)) .gt. EPS ) then tmp = 1/A(j,j) do i = j + 1, n A(i,j) = A(i,j)*tmp enddo endif enddo end ************************************************************************ * XSolve computes the x in A.x = b from the LU-decomposed A. * Input: * A: LU-decomposed n-by-n matrix A * b: input vector b in A.x = b * n: dimension of A * p: permutation vector from LU decomposition * Output: * b: solution vector x in A.x = b subroutine XSolve(n, A,ldA, b) implicit none integer n, ldA ArgQuad A(ldA,*) ComplexQuad b(0:2,*) integer i, j ComplexQuad tmp(0:2) * forward substitution L.y = b do i = 1, n tmp = 0 do j = 1, i - 1 tmp = tmp + A(i,j)*b(:,j) enddo b(:,i) = b(:,i) - tmp enddo * backward substitution U.x = y do i = n, 1, -1 tmp = 0 do j = i + 1, n tmp = tmp + A(i,j)*b(:,j) enddo b(:,i) = (b(:,i) - tmp)/A(i,i) enddo end ************************************************************************ * Det computes the determinant of a matrix. * Input: * A: n-by-n matrix A * n: dimension of A * Output: * determinant of A * Warning: A is overwritten subroutine XDet(n, A,ldA, det) implicit none integer n, ldA ArgQuad A(ldA,*), det integer i, j, s, perm(MAXDIM) call XDecomp(n, A,ldA, perm) det = 1 s = 0 do i = 1, n det = det*A(i,i) j = i do while( perm(j) .ne. i ) j = j + 1 enddo if( j .ne. i ) then perm(j) = perm(i) s = s + 1 endif enddo if( iand(s, 1) .ne. 0 ) det = -det end ************************************************************************ * Inverse computes the inverse of a matrix. * Input: * A: n-by-n matrix A * n: dimension of A * Output: * A: mangled LU decomposition of A * Ainv: inverse of A * perm: permutation vector subroutine XInverse(n, A,ldA, Ainv,ldAinv, perm) implicit none integer n, ldA, ldAinv, perm(*) ArgQuad A(ldA,*), Ainv(ldAinv,*) integer i, j, k ArgQuad tmp call XDecomp(n, A,ldA, perm) do i = 1, n do j = 1, n Ainv(j,i) = 0 enddo Ainv(perm(i),i) = 1 * forward substitution L.y = b do j = 1, n tmp = 0 do k = 1, j - 1 tmp = tmp + A(j,k)*Ainv(k,i) enddo Ainv(j,i) = Ainv(j,i) - tmp enddo * backward substitution U.x = y do j = n, 1, -1 tmp = 0 do k = j + 1, n tmp = tmp + A(j,k)*Ainv(k,i) enddo Ainv(j,i) = (Ainv(j,i) - tmp)/A(j,j) enddo enddo end LoopTools-2.16/src/util/PaxHeaders/ffcxr.F0000644000000000000000000000007411776502523015452 xustar0030 atime=1648161785.711698365 30 ctime=1648161793.715764879 LoopTools-2.16/src/util/ffcxr.F0000644000000000000000000002364711776502523016401 0ustar00rootroot00000000000000#include "externals.h" #include "types.h" *--#[ log: * $Id: ffcxr.f,v 1.2 1995/11/10 19:04:24 gj Exp $ * $Log: ffcxr.f,v $ c Revision 1.2 1995/11/10 19:04:24 gj c Added nicer logging header... c *--#] log: *###[ ffcxr: subroutine ffcxr(crr,ipi12,y,y1,z,z1,dyz,ld2yzz,d2yzz,zz,zz1, + ldy2z,dy2z,ieps,ier) ***#[*comment:*********************************************************** * * * calculates R as defined in appendix b: * * * * /1 log(x-z+i*eps) - log(y-z+i*eps) * * r(y,z) = \ dx ----------------------------------- * * /0 x-y * * * * = li2(y/(y-z)+i*eps') - li2((y-1)/(y-z)+i*eps') * * * * y,z are real, ieps integer denoting the sign of i*eps. * * factors pi^2/12 are passed in the integer ipi12. * * * * Input: y (real) * * y1 (real) 1-y * * z (real) * * z1 (real) 1-z * * dyz (real) y-z * * * * ld2yzz (logical) if .TRUE. also defined are: * * d2yzz (real) 2*y - z^+ - z^- * * zz (real) the other z-root * * zz1 (real) 1 - zz * * * * ieps (integer) if +/-1 denotes sign imaginary * * part of argument logs * * ieps (integer) if +/-2 denotes sign imaginary * * part of argument dilogs * * * * Output crr (complex) R modulo factors pi^2/12 * * ipi12 (integer) these factors * * ier (intger) 0=ok, 1=num prob, 2=error * * * * Calls: ffxli2,(test: ffzxdl),dfflo1,zxfflg * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments * integer ipi12,ieps,ier logical ld2yzz,ldy2z RealType y,y1,z,z1,dyz,d2yzz,zz,zz1,dy2z(3) ComplexType crr(7) * * local variables * integer i,iclas1,iclas2 RealType fact,xx1,xx2,xx1p,xx2p,arg2,arg3, + xli1,xli2,xli3,xlo1,xlo2,xlo3,xhill,xlog1, + xlog2p,xx1n,d2,d21,d2n,d21n1,term,tot,xtroep,xli4, + xlo4,som,xmax ComplexType clog1p,clog2p RealType dfflo1 ComplexType zxfflg external dfflo1,zxfflg * * common blocks * #include "ff.h" * #] declarations: * #[ groundwork: * * get the arguments * if ( dyz .eq. 0 ) return fact = 1/dyz xx1 = y * fact xx2 = - y1 * fact * * #] groundwork: * #[ which area?: * * determine the area: 1 = [-1+xloss,1/2] * 2 = (1/2,2-xloss] * 3 = [2+xloss,->) U (<-,-1-xloss] * 4 = [-1-xloss,-1+xloss] * 5 = [2-xloss,2+xloss] * if ( xx1 .lt. -1-xloss/2 ) then iclas1 = 3 xx1p = 1/xx1 elseif( xx1 .lt. -1+xloss/2 ) then if ( ld2yzz ) then iclas1 = 4 else iclas1 = 1 endif xx1p = xx1 elseif( xx1 .le. .5D0 ) then iclas1 = 1 xx1p = xx1 elseif ( xx1 .lt. 2-xloss ) then iclas1 = 2 xx1p = -z*fact elseif ( ldy2z .and. xx1 .lt. 2+xloss ) then iclas1 = 5 xx1p = dy2z(1)*fact else iclas1 = 3 xx1p = 1/xx1 endif if ( xx2 .lt. -1-xloss/2 ) then iclas2 = 3 xx2p = 1/xx2 elseif( xx2 .lt. -1+xloss/2 ) then if ( ld2yzz ) then iclas2 = 4 else iclas2 = 1 endif xx2p = xx2 elseif ( xx2 .le. .5D0 ) then iclas2 = 1 xx2p = xx2 elseif ( xx2 .lt. 2-xloss ) then iclas2 = 2 xx2p = z1*fact elseif ( ldy2z .and. xx2 .lt. 2+xloss ) then iclas2 = 5 xx2p = -dy2z(3)*fact else iclas2 = 3 xx2p = 1/xx2 endif * * throw together if they are close * if ( iclas1 .ne. iclas2 .and. abs(xx1-xx2) .lt. 2*xloss ) + then * we don't want trouble with iclasn = 4,5 if ( iclas1 .eq. 4 ) then iclas1 = 1 elseif ( iclas1 .eq. 5 ) then iclas1 = 3 xx1p = 1/xx1 endif if ( iclas2 .eq. 4 ) then iclas2 = 1 elseif ( iclas2 .eq. 5 ) then iclas2 = 3 xx2p = 1/xx2 endif if ( iclas1 .eq. iclas2 ) goto 5 * go on if ( iclas1 .le. iclas2 ) then iclas2 = iclas1 if ( iclas1 .eq. 1 ) then xx2p = xx2 else xx2p = z1*fact endif else iclas1 = iclas2 if ( iclas1 .eq. 1 ) then xx1p = xx1 else xx1p = -z*fact endif endif endif * #] which area?: * #[ calculations: 5 if ( iclas1 .eq. iclas2 .and. + abs(xx1p-xx2p) .lt. 2*xloss*max(abs(xx1p),abs(xx2p)) + .and. iclas1 .ne. 5 ) then * |----->temporary! * Close together: * -#[ handle dilog's: if ( abs(xx2p) .gt. xloss ) then *--#[ Hill identity: * * Use the Hill identity to get rid of the cancellations. * * * first get the arguments: * if ( iclas1 .eq. 1 .or. iclas1 .eq. 4 ) then d2 = 1/y arg2 = 1/z1 arg3 = arg2/xx1p elseif ( iclas1 .eq. 2 ) then d2 = 1/z arg2 = 1/y1 arg3 = arg2/xx1p elseif ( iclas1 .eq. 3 ) then d2 = 1/y1 arg3 = 1/z1 arg2 = arg3*xx1p endif call ffxli2(xli1,xlo1,d2,ier) call ffxli2(xli2,xlo2,arg2,ier) call ffxli2(xli3,xlo3,arg3,ier) if ( abs(xx2p) .lt. xloss ) then xlog2p = dfflo1(xx2p,ier) else xlog2p = Re(zxfflg(1-xx2p,0,1D0,ier)) endif xhill = xlo1*xlog2p *--#] Hill identity: else *--#[ Taylor expansion: * * if the points are close to zero do a Taylor * expansion of the first and last dilogarithm * * Li2(xx1p) - Li2(xx2p) * = sum xx1p^i ( 1-(1-d2)^i ) /i^2 * * with d2 = 1-xx2p/xx1p = ... * if ( iclas1 .eq. 1 .or. iclas1 .eq. 4 ) then d2 = 1/y elseif ( iclas1 .eq. 2 ) then d2 = 1/z elseif ( iclas1 .eq. 3 ) then d2 = 1/y1 endif * flag to the print section that we did a Taylor expansion d21 = 1-d2 d21n1 = 1 xx1n = xx1p d2n = d2 tot = xx1p*d2 * check for possible underflow on the next line if ( abs(xx1p) .lt. xalog2 ) goto 51 do 50 i=2,20 xx1n = xx1n*xx1p d21n1 = d21n1*d21 d2n = d2n + d2*d21n1 term = xx1n*d2n*xn2inv(i) tot = tot + term if ( abs(term) .le. precx*abs(tot) ) goto 51 50 continue 51 continue xli1 = tot xli2 = 0 xli3 = 0 xhill = 0 * for the eta+transformation section we also need if ( iclas1 .ne. 1 ) then if ( abs(d2) .lt. xloss ) then xlo1 = dfflo1(d2,ier) else xlo1 = Re(zxfflg(d21,0,1D0,ier)) endif endif if ( iclas1 .eq. 2 ) xlo2 = dfflo1(1/y1,ier) *--#] Taylor expansion: endif * * -#] handle dilog's: * -#[ handle transformation terms: if ( iclas1 .eq. 1 .or. iclas1 .eq. 4 ) then * * no transformation was made. * * crr(5) = 0 * crr(6) = 0 elseif ( iclas1 .eq. 2 ) then * * we tranformed to 1-x for both dilogs * if ( abs(xx1p) .lt. xloss ) then xlog1 = dfflo1(xx1p,ier) else xlog1 = Re(zxfflg(xx1,0,1D0,ier)) endif crr(5) = xlo1*xlog1 clog2p = zxfflg(xx2p,ieps,-y1,ier) crr(6) = -Re(xlo2)*clog2p elseif ( iclas1 .eq. 3 ) then * * we transformed to 1/x for both dilogs * clog2p = zxfflg(-xx2p,-ieps,-y1,ier) crr(5) = Re(xlo1)*(clog2p - Re(xlo1)/2) endif * -#] handle transformation terms: * -#[ add up and print out: if ( iclas1 .eq. 1 .or. iclas1 .eq. 4 ) then crr(1) = xli1 crr(2) = xli2 crr(3) = - xli3 crr(4) = xhill else crr(1) = - xli1 crr(2) = - xli2 crr(3) = xli3 crr(4) = - xhill endif * -#] add up and print out: else * Normal case: * -#[ handle dilogs: * * the dilogs will not come close together so just go on * only the special case xx1p ~ -1 needs special attention * - and the special case xx1 ~ 2 also needs special attention * if ( iclas1 .eq. 4 ) then d2 = d2yzz + zz xmax = abs(d2yzz) if ( abs(d2) .lt. xloss*xmax ) then som = y + dyz if ( abs(y).lt.xmax ) then d2 = som xmax = abs(y) endif endif d2 = d2/dyz fact = 1/(2-d2) call ffxli2(xli1,xlo1,d2*fact,ier) call ffxli2(xli3,xlo3,-d2*fact,ier) call ffxli2(xli4,xlo4,d2,ier) elseif ( iclas1 .eq. 5 ) then call ffxl22(xli1,xx1p,ier) ipi12 = ipi12 + 3 else call ffxli2(xli1,xlo1,xx1p,ier) endif if ( iclas2 .eq. 4 ) then if ( iclas1 .eq. 4 ) call fferr(26,ier) d2 = d2yzz - zz1 xmax = abs(d2yzz) if ( abs(d2) .lt. xloss*xmax ) then som = dyz - y1 if ( abs(y1).lt.xmax ) then d2 = som xmax = abs(y1) endif endif d2 = d2/dyz fact = 1/(2-d2) call ffxli2(xli2,xlo2,d2*fact,ier) call ffxli2(xli3,xlo3,-d2*fact,ier) call ffxli2(xli4,xlo4,d2,ier) elseif ( iclas2 .eq. 5 ) then call ffxl22(xli2,xx2p,ier) ipi12 = ipi12 - 3 else call ffxli2(xli2,xlo2,xx2p,ier) endif * -#] handle dilogs: * -#[ handle transformation terms xx1: * * transformation of c1 * if ( iclas1 .eq. 1 ) then crr(1) = xli1 elseif( iclas1 .eq. 2 ) then crr(1) = -xli1 ipi12 = ipi12 + 2 clog1p = zxfflg(xx1p,ieps,y,ier) crr(3) = - Re(xlo1)*clog1p elseif ( iclas1 .eq. 3 ) then crr(1) = -xli1 ipi12 = ipi12 - 2 clog1p = zxfflg(-xx1p,-ieps,y,ier) crr(3) = - clog1p**2/2 elseif ( iclas1 .eq. 4 ) then crr(1) = xli1 * Note that this sum does not cause problems as d2<<1 crr(3) = Re(-xli3-xli4) + Re(xlo4)* + zxfflg(fact,0,0D0,ier) ipi12 = ipi12 - 1 elseif ( iclas1 .eq. 5 ) then crr(1) = xli1 * supply an imaginary part clog1p = zxfflg(-1/xx1,-ieps,y,ier) xtroep = -Im(clog1p)*Re(clog1p) crr(3) = ToComplex(0D0,xtroep) else call fferr(26,ier) endif * -#] handle transformation terms xx1: * -#[ handle transformation terms xx2: * * transformation of c2 * if ( iclas2 .eq. 1 ) then crr(2) = -xli2 elseif( iclas2 .eq. 2 ) then crr(2) = +xli2 ipi12 = ipi12 - 2 clog2p = zxfflg(xx2p,ieps,-y1,ier) crr(4) = + Re(xlo2)*clog2p elseif ( iclas2 .eq. 3 ) then crr(2) = +xli2 ipi12 = ipi12 + 2 clog2p = zxfflg(-xx2p,-ieps,-y1,ier) crr(4) = clog2p**2/2 elseif ( iclas2 .eq. 4 ) then crr(2) = -xli2 * Note that this sum does not cause problems as d2<<1 crr(4) = Re(xli3+xli4) - Re(xlo4)* + zxfflg(fact,0,0D0,ier) ipi12 = ipi12 + 1 elseif ( iclas2 .eq. 5 ) then crr(2) = -xli2 * supply an imaginary part clog2p = zxfflg(-1/xx2,-ieps,-y1,ier) xtroep = Im(clog2p)*Re(clog2p) crr(4) = ToComplex(0D0,xtroep) else call fferr(28,ier) endif * -#] handle transformation terms xx2: endif * #] calculations: *###] ffcxr: end LoopTools-2.16/src/PaxHeaders/tools0000644000000000000000000000013214217172001014317 xustar0030 mtime=1648161793.715764879 30 atime=1648161793.715764879 30 ctime=1648161793.715764879 LoopTools-2.16/src/tools/0000755000000000000000000000000014217172001015314 5ustar00rootroot00000000000000LoopTools-2.16/src/tools/PaxHeaders/mcc0000644000000000000000000000013214033321001015051 xustar0030 mtime=1617797633.598928393 30 atime=1648161785.711698365 30 ctime=1648161793.715764879 LoopTools-2.16/src/tools/mcc0000755000000000000000000000543714033321001016005 0ustar00rootroot00000000000000#! /bin/bash # this script jumps in if there is no working mcc on the path: # - on Mac OS it (hopefully) figures out the location of mcc, # - on Cygwin it substitutes mcc completely # last modified 7 Apr 21 th sdkpath() { mathcmd=`IFS=: PATH="$PATH:${*:2}" type -p $1 | head -1` eval `"$mathcmd" -run ' Print["sysid=\"", $SystemID, "\""]; Print["topdir=\"", $TopDirectory, "\""]; Exit[]' < /dev/null | tr '\r' ' ' | tail -2` # check whether Cygwin's dlltool can handle 64-bit DLLs test "$sysid" = Windows-x86-64 && { ${DLLTOOL:-dlltool} --help | grep x86-64 > /dev/null || sysid=Windows } topdir=`cd "$topdir" ; echo $PWD` for sdk in \ "$topdir/SystemFiles/Links/MathLink/DeveloperKit/$sysid/CompilerAdditions" \ "$topdir/SystemFiles/Links/MathLink/DeveloperKit/CompilerAdditions" \ "$topdir/AddOns/MathLink/DeveloperKit/$sysid/CompilerAdditions" ; do test -d "$sdk" && return done echo "MathLink SDK not found" 1>&2 exit 1 } cygmcc() { w64="`cygpath -u "${ProgramW6432:-/cygdrive/c/Program Files}"`" w32="`cygpath -u "${PROGRAMFILES:-/cygdrive/c/Program Files (x86)}"`" eval sdkpath math `ls -tdQ {"$w64","$w32"}/"Wolfram Research"/Mathematica/*` cache=MLcyg-cache test -d $cache || mkdir $cache mprep="`find "$sdk"/m* -name mprep.exe`" mathlink_h="`find "$sdk"/m* -name mathlink.h`" libname="`find "$sdk"/m* -name ml\*m.lib | sort -r | head -1`" dllname="`basename "$libname" m.lib`" OSbits=32 case "$dllname" in *64*) OSbits=64 ;; esac lib="$cache/${dllname}m" test -f "$lib.a" || { ( echo "EXPORTS" ${NM:-nm} -C --defined-only "$libname" | awk '/ T [^.]/ { print $3 }' ) > "$lib.def" ${DLLTOOL:-dlltool} -k --dllname "$dllname.dll" \ --def "$lib.def" --output-lib "$lib.a" } tmp= args="-DWIN$OSbits -I'${mathlink_h%/*}'" for arg in "$@" ; do case "$arg" in *.tm) cp "$arg" "$arg.tm" "$mprep" -lines -o "$arg.c" "$arg.tm" tmp="$tmp '$arg.c' '$arg.tm'" args="$args '$arg.c'" ;; *) args="$args '$arg'" ;; esac done trap "rm -f $tmp" 0 1 2 3 15 eval "set -x ; ${CC:-gcc} $args $lib.a -mwindows" } macmcc() { sdkpath MathKernel:WolframKernel \ /Applications/Mathematica*/Contents/MacOS \ $HOME/Desktop/Mathematica*/Contents/MacOS trap "rm -f /tmp/mcc.$$" 0 1 2 3 15 ln -s "$sdk" /tmp/mcc.$$ exec /tmp/mcc.$$/mcc "$@" } defaultmcc() { sdkpath math:MathKernel:WolframKernel \ /usr/local/bin \ /usr/local/Wolfram/bin \ /usr/local/Wolfram/Mathematica/*/Executables \ /opt/Wolfram/bin \ /opt/Wolfram/Mathematica/*/Executables trap "rm -f /tmp/mcc.$$" 0 1 2 3 15 ln -s "$sdk" /tmp/mcc.$$ exec /tmp/mcc.$$/mcc "$@" } shopt -s nullglob 2> /dev/null case `uname -s` in Darwin) macmcc "$@" ;; CYG*) cygmcc "$@" ;; *) defaultmcc "$@" ;; esac LoopTools-2.16/src/tools/PaxHeaders/alias.tcsh0000644000000000000000000000007412305311015016351 xustar0030 atime=1648161785.711698365 30 ctime=1648161793.715764879 LoopTools-2.16/src/tools/alias.tcsh0000644000000000000000000000100312305311015017256 0ustar00rootroot00000000000000alias versionkey 'echo "keya0=2^0; keybget=2^2; keyc0=2^4; keyd0=2^6; keye0=2^8; keyeget=2^10; keyceget=2^12; keyall=keya0+keybget+keyc0+keyd0+keye0+keyeget+keyceget; \!*:agl" | bc' alias debugkey 'echo "debuga=2^0; debugb=2^1; debugc=2^2; debugd=2^3; debuge=2^4; debugall=debuga+debugb+debugc+debugd+debuge; \!*:agl" | bc' alias setversionkey 'setenv LTVERSION `versionkey \!*`' alias setdebugkey 'setenv LTDEBUG `debugkey \!*`' alias setdebugrange 'setenv LTRANGE \!:1-\!:2' alias setmaxdev 'setenv LTMAXDEV \!*' LoopTools-2.16/src/tools/PaxHeaders/q770000644000000000000000000000007411305527751014755 xustar0030 atime=1648161785.711698365 30 ctime=1648161793.715764879 LoopTools-2.16/src/tools/q770000755000000000000000000000271011305527751015673 0ustar00rootroot00000000000000#! /bin/sh # compile script for quadruple precision # this file is part of LoopTools # last modified 2 Dec 09 th f77290=`dirname $0`/f77290 [ ! -x $f77290 -a -f $f77290.c ] && gcc -O -o $f77290 $f77290.c if [ ! -x $f77290 ] ; then echo "Cannot find the f77290 utility." exit 1 fi tmpdir=${TMPDIR:-/tmp} f90="f90 -r16" cc="gcc" cpp="$cc -E -P -C -x f77-cpp-input" fppflags="" cppflags="" ldflags="" fflags="" ffiles="" cfiles="" while [ $# -gt 0 ] ; do case "$1" in *.[fF]) ffiles="$ffiles $1" ;; *.c) cfiles="$cfiles $1" ;; -I*) fppflags="$fppflags $1" ;; -D*) cppflags="$cppflags $1" ;; -looptools) ldflags="$ldflags -looptools-quad" ;; -[lL]*) ldflags="$ldflags $1" ;; -extend_source | -old_f77) ;; *) fflags="$fflags $1" ;; esac shift done if [ -n "$ffiles" ] ; then tmpfiles="" for file in $ffiles ; do tmp=$tmpdir/`basename $file | sed s/.$/f90/g` tmpfiles="$tmpfiles $tmp" tmpfppflags="-I`dirname $file` $fppflags" sed " /^[cC*]/d /^[^#].*include / { s/^[^i]*/#/ s/'/\"/g }" $file | $cpp $tmpfppflags $cppflags - | $f77290 - > $tmp done (set -x; $f90 $tmpfppflags $fflags $tmpfiles $ldflags) || exit $? rm -f $tmpfiles fi if [ -n "$cfiles" ] ; then tmpfiles="" for file in $cfiles ; do tmp=$tmpdir/`basename $file` tmpfiles="$tmpfiles $tmp" sed 's/sizeof(double)/2*&/g' $file > $tmp done (set -x; $cc $fppflags $cppflags $fflags $tmpfiles $ldflags) || exit $? rm -f $tmpfiles fi LoopTools-2.16/src/tools/PaxHeaders/f++.in0000644000000000000000000000013214217172001015277 xustar0030 mtime=1648161793.715764879 30 atime=1648161793.715764879 30 ctime=1648161793.715764879 LoopTools-2.16/src/tools/f++.in0000777000000000000000000000000014217172001017277 2fcc.inustar00rootroot00000000000000LoopTools-2.16/src/tools/PaxHeaders/fcc.in0000644000000000000000000000007414131222703015464 xustar0030 atime=1648161785.711698365 30 ctime=1648161793.715764879 LoopTools-2.16/src/tools/fcc.in0000755000000000000000000000254114131222703016404 0ustar00rootroot00000000000000#! /bin/bash # script to compile C programs that are linked # against Fortran libraries # last modified 12 Oct 21 th exec 3>&2 exec 2> /tmp/fcc.log.$$ set -x args= compileonly= objs= ldflags= fldflags= cdefs= cc="${REALCC:-cc}" cc+=" $cdefs" cxx="${REALCXX:-c++}" cxx+=" $cdefs" [[ "${0%.in}" =~ f++$ ]] && cc="$cxx" while test $# -gt 0; do printf -v arg "%q" "$1" case "$1" in -st | -b32 | -b64) ;; # ignore mcc-specific flags -arch) shift ;; -lstdc++) cc="$cxx" ;; # or else -static-libstdc++ has no effect -Wno-long-double) ;; # mcc adds this on Macs & gcc 4 doesn't like it -L*CompilerAdditions*) ldflags+=" $arg" mldir="${1#-L}" mldir="${mldir%%CompilerAdditions*}" mldir="${mldir/Links\/MathLink\/DeveloperKit/Libraries}" [[ "$cc" == *-m32* ]] && mldir="${mldir//-x86-64}" test -f "$mldir/libuuid.a" && ldflags+=" -L'$mldir'" fldflags+=" -luuid" ;; -[Ll]* | -Wl*) ldflags+=" $arg" ;; *.tm.o) objs="$arg $objs" ;; *.a | *.o | *.so) objs+=" $arg" ;; *.cc) args+=" $arg" cc="$cxx" ;; -c) compileonly="-c" ;; -o) args+=" -o '$2'" shift ;; *.tm.c) args+=" $arg" tmc+=" $arg" ;; *) args+=" $arg" tmargs+=" $arg" ;; esac shift done test -n "$DEBUG" && for tm in $tmc; do eval "$cc $tmargs -E -P -o ${tm//.c}.i $tm 2>&3" done eval "set -x; exec $cc $args ${compileonly:-$objs $ldflags $fldflags} 2>&3" LoopTools-2.16/src/tools/PaxHeaders/mkexternalsh0000644000000000000000000000013213722121540017026 xustar0030 mtime=1598595936.614051308 30 atime=1648161785.711698365 30 ctime=1648161793.715764879 LoopTools-2.16/src/tools/mkexternalsh0000755000000000000000000000634213722121540017756 0ustar00rootroot00000000000000#! /bin/bash # a script to generate externals.h # the latter is included by all LoopTools code, with the purpose # of making internal symbols "invisible" from the outside # this file is part of LoopTools # last modified 28 Aug 20 th base="${0%/*}/../.." ext="$base/src/include/externals.h" cext="$base/src/include/cexternals.h" lib="$base/build/libooptools.a" prefix=lj shopt -s nullglob set -- `nm "$lib" | awk ' /\.o:$/ { file = $1; sub(".o:$", "", file); } /\.o\):$/ { file = $1; sub("^.*\\\\(", "", file); sub("\\\\.o\\\\):$", "", file); } $2 ~ /^(T|C)$/ && $3 !~ /^_*('"$prefix"')*(\ a00c|a00|a0ic|a0i|a0c|a0|\ agetc|aget|aputnocachec|aputnocache|aputc|aput|\ b001c|b001|b00c|b00|b0c|b0ic|b0i|b0|b111c|b111|b11c|b11|b1c|b1|\ bgetc|bget|bputnocachec|bputnocache|bputc|bput|bcoeffc|bcoeff|\ db001c|db001|db00c|db00|db0c|db0|db11c|db11|db1c|db1|\ c0ic|c0i|c0nocachec|c0nocache|c0c|c0|\ cgetc|cget|cputnocachec|cputnocache|cputc|cput|ccoeffc|ccoeff|\ d0ic|d0i|d0nocachec|d0nocache|d0c|d0|\ dgetc|dget|dputnocachec|dputnocache|dputc|dput|dcoeffc|dcoeff|\ e0ic|e0i|e0nocachec|e0nocache|e0c|e0|\ egetc|eget|eputnocachec|eputnocache|eputc|eput|ecoeffc|ecoeff|\ li2c|li2csub|li2|li2sub|li2omxc|li2omxcsub|li2omx|li2omxsub|\ ltini|ltexi|ltcache|ltvars|ltregul|\ clearcache|markcache|restorecache|getcachelast|setcachelast|\ setmudim|getmudim|\ setdelta|getdelta|\ setuvdiv|getuvdiv|\ setlambda|getlambda|getepsi|\ setminmass|getminmass|\ setmaxdev|getmaxdev|\ setdiffeps|getdiffeps|\ setzeroeps|getzeroeps|\ setwarndigits|getwarndigits|\ seterrdigits|geterrdigits|\ setversionkey|getversionkey|\ setdebugkey|getdebugkey|setdebugrange|\ setcmpbits|getcmpbits)_$/ { sub("^_", "", $3); sub("^" PREFIX, "", $3); sub("_*$", "", $3); print file " " $3; } ' PREFIX="$prefix"` fdefs= cdefs= c_defs= test -f "$ext" && mv -f "$ext"{,.old} touch "$ext" test -f "$cext" && mv -f "$cext"{,.old} touch "$cext" cd build while test $# -gt 1; do file= cppflags= for file in "$1".[Fc]; do break done test -z "$file" && case "$1" in *C) file=`echo "$1.F" | sed 's/C\.F$/\.F/'` cppflags="-DCOMPLEXPARA" ;; esac case "$file" in *.c) sym=`gcc -E -P "$file" | sed -n " s|^[^ ]* *\($2\)_*(.*|\1|pI s|} \($2\)_*;|\1|pI T q"` test ${sym}x = x && { echo "$0 bug for file $file sym $2" exit 1 } c_defs+=" #define ${sym}_ $prefix${sym}_" cdefs+=" #define $sym $prefix$sym" fdefs+=" #define $sym $prefix$sym" ;; *) sym=${2:0:29} sym=`gfortran -E -P $cppflags "$file" | sed -n " s|^[^c*].*subroutine *\($sym\).*|\1|pI s|^[^c*].*function *\($sym\).*|\1|pI s|^[^c*].*entry *\($sym\).*|\1|pI s|^[^c*].*block data *\($sym\).*|\1|pI s|^[^c*].*common */\($sym\).*|\1|pI T q"` test "${sym}x" = x && { echo "$0 bug for file $file sym $2" exit 1 } fdefs+=" #define $sym $prefix$sym" ;; esac echo "$sym" test -z "$sym" && echo "Symbol $2 not found in $file." 1>&2 shift 2 done cat > "$ext" << _EOF_ #if 0 This file was generated by ${0##*/} on `date`. Do not edit. #endif `echo "$fdefs" | sort -u` _EOF_ cat > "$cext" << _EOF_ #if 0 This file was generated by ${0##*/} on `date`. Do not edit. #endif #if NOUNDERSCORE `echo "$cdefs" | sort -u` #else `echo "$c_defs" | sort -u` #endif _EOF_ LoopTools-2.16/src/PaxHeaders/A0000644000000000000000000000013214217172001013337 xustar0030 mtime=1648161793.715764879 30 atime=1648161793.715764879 30 ctime=1648161793.715764879 LoopTools-2.16/src/A/0000755000000000000000000000000014217172001014334 5ustar00rootroot00000000000000LoopTools-2.16/src/A/PaxHeaders/ffxa0.F0000644000000000000000000000007411776502522014550 xustar0030 atime=1648161785.711698365 30 ctime=1648161793.715764879 LoopTools-2.16/src/A/ffxa0.F0000644000000000000000000000114511776502522015464 0ustar00rootroot00000000000000* ffxa0.F * the one-point function for real mass * original code by G.J. van Oldenborgh * this file is part of LoopTools * last modified 7 Dec 10 th #include "externals.h" #include "types.h" * Input: xm (real) mass2, * Output: ca0 (complex) A0, the one-point function, * ier 0 (ok) subroutine ffxa0(ca0, xm, ier) implicit none ComplexType ca0 RealType xm integer ier #include "ff.h" RealType xmu, xlogm xmu = xm if( mudim .ne. 0 ) xmu = xmu/mudim if( xmu .gt. xalogm ) then xlogm = log(xmu) else xlogm = 0 if( xmu .ne. 0 ) call fferr(2, ier) endif ca0 = -(xm*(xlogm - 1 - delta)) end LoopTools-2.16/src/A/PaxHeaders/Aget.F0000644000000000000000000000007413262227751014424 xustar0030 atime=1648161785.711698365 30 ctime=1648161793.715764879 LoopTools-2.16/src/A/Aget.F0000644000000000000000000000574113262227751015346 0ustar00rootroot00000000000000* Aget.F * retrieve the one-point tensor coefficients * this file is part of LoopTools * last modified 7 Apr 18 th #include "externals.h" #include "types.h" #define npoint 1 #include "defs.h" memindex function XAget(m) implicit none ArgType m #include "lt.h" memindex cacheindex external cacheindex, XAcoeff ArgType para(1,Paa) M(1) = m if( abs(M(1)) .lt. minmass ) M(1) = 0 XAget = cacheindex(para, Aval(1,0), XAcoeff, RC*Paa, Naa, Ano) end ************************************************************************ subroutine XAput(res, m) implicit none ComplexType res(*) ArgType m #include "lt.h" external XAcoeff ArgType para(1,Paa) M(1) = m if( abs(M(1)) .lt. minmass ) M(1) = 0 call cachecopy(res, para, Aval(1,0), XAcoeff, RC*Paa, Naa, Ano) end ************************************************************************ subroutine XAputnocache(res, m) implicit none ComplexType res(*) ArgType m #include "lt.h" ArgType para(1,Paa) M(1) = m if( abs(M(1)) .lt. minmass ) M(1) = 0 call Acoeff(res, para) end ************************************************************************ ComplexType function XA0i(i, m) implicit none integer i ArgType m #include "lt.h" memindex XAget external XAget memindex b b = XAget(m) XA0i = Aval(i+epsi,b) end ************************************************************************ ComplexType function XA0(m) implicit none ArgType m #include "lt.h" ComplexType XA0i external XA0i XA0 = XA0i(aa0, m) end ************************************************************************ ComplexType function XA00(m) implicit none ArgType m #include "lt.h" ComplexType XA0i external XA0i XA00 = XA0i(aa00, m) end ************************************************************************ subroutine XAcoeff(A, para) implicit none ComplexType A(*) ArgType para(1,*) #include "lt.h" ArgType m ComplexType res(0:1) integer key, ier logical dump m = M(1) key = ibits(versionkey, KeyA0, 2) serial = serial + 1 dump = ibits(debugkey, DebugA, 1) .ne. 0 .and. & serial .ge. debugfrom .and. serial .le. debugto if( dump ) call XDumpPara(1, para, "Acoeff") if( key .ne. 1 ) then ier = 0 call Xffa0(res(0), m, ier) if( ier .gt. warndigits ) key = ior(key, 2) endif if( key .ne. 0 ) then res(1) = 0 if( m .ne. 0 ) res(1) = m*(1 - log(m/mudim) + delta) if( key .gt. 1 .and. & abs(res(0) - res(1)) .gt. maxdev*abs(res(0)) ) then #ifdef COMPLEXPARA print *, "Discrepancy in CA0:" print *, " m =", m print *, "A0C a =", res(0) print *, "A0C b =", res(1) #else print *, "Discrepancy in A0:" print *, " m =", m print *, "A0 a =", res(0) print *, "A0 b =", res(1) #endif endif endif A(aa0) = res(iand(key, 1)) A(aa00) = .25D0*m*(A(aa0) + .5D0*m) A(1+aa0) = 0 A(1+aa00) = 0 A(2+aa0) = 0 A(2+aa00) = 0 if( lambda .le. 0 ) then A(1+aa0) = m*uvdiv A(1+aa00) = .25D0*m**2*uvdiv endif if( dump ) call XDumpCoeff(1, A) end LoopTools-2.16/src/A/PaxHeaders/ffca0.F0000644000000000000000000000007411776502522014523 xustar0030 atime=1648161785.711698365 30 ctime=1648161793.715764879 LoopTools-2.16/src/A/ffca0.F0000644000000000000000000000152511776502522015441 0ustar00rootroot00000000000000* ffca0.F * the one-point function for complex mass * original code by G.J. van Oldenborgh * this file is part of LoopTools * last modified 7 Dec 10 th #include "externals.h" #include "types.h" * Input: cm (complex) mass2, re > 0, im < 0. * Output: ca0 (complex) A0, the one-point function, * ier 0 (OK) subroutine ffca0(ca0, cm, ier) implicit none ComplexType ca0, cm integer ier #include "ff.h" ComplexType cmu, clogm RealType absc ComplexType c absc(c) = abs(Re(c)) + abs(Im(c)) * the real case: * adapted to log-and-pole scheme 25-mar-1992 if( Im(cm) .eq. 0 .or. nschem .lt. 7 ) then call ffxa0(ca0, cm, ier) return endif cmu = cm if( mudim .ne. 0 ) cmu = cmu/mudim if( absc(cmu) .gt. xclogm ) then clogm = log(cmu) else clogm = 0 if ( cmu .ne. 0 ) call fferr(1, ier) endif ca0 = -cm*(clogm - 1 - delta) end LoopTools-2.16/src/PaxHeaders/D0000644000000000000000000000013214217172001013342 xustar0030 mtime=1648161793.715764879 30 atime=1648161793.715764879 30 ctime=1648161793.715764879 LoopTools-2.16/src/D/0000755000000000000000000000000014217172001014337 5ustar00rootroot00000000000000LoopTools-2.16/src/D/PaxHeaders/ffxd0h.F0000644000000000000000000000007411776502523014727 xustar0030 atime=1648161785.711698365 30 ctime=1648161793.715764879 LoopTools-2.16/src/D/ffxd0h.F0000644000000000000000000004147411776502523015654 0ustar00rootroot00000000000000#include "externals.h" #include "types.h" *--#[ log: * $Id: ffxd0h.f,v 1.6 1996/01/22 13:33:49 gj Exp $ * $Log: ffxd0h.f,v $ c Revision 1.6 1996/01/22 13:33:49 gj c Added the word 'error' to print statements in ffxuvw that u,v,w were wrong c c Revision 1.5 1995/12/08 10:48:32 gj c Changed xloss to xlosn to prevent spurious error messages. c c Revision 1.4 1995/11/10 18:55:46 gj c JUst added some comments in ffrot4 c c Revision 1.3 1995/10/29 15:37:43 gj c Revision 1.2 1995/10/17 06:55:13 gj c Fixed ieps error in ffdcrr (ffcxs4.f), added real case in ffcrr, debugging c info in ffxd0, and warned against remaining errors for del2=0 in ffrot4 c (ffxd0h.f) c *--#] log: *###[ ffrot4: subroutine ffrot4(irota,del2,xqi,dqiqj,qiDqj,xpi,dpipj,piDpj,ii, + itype,ier) ***#[*comment:*********************************************************** * * * rotates the arrays xpi, dpipj into xqi,dqiqj over irota places * * such that del2(s3,s4)<=0. itype=0 unless del2(s3,s4)=0 (itype=1)* * itype=2 if the 4pointfunction is doubly IR-divergent * * ((0,0,0)vertex) * * * * Input: xpi(13) real momenta squared * * dpipj(10,13) real xpi(i) - xpi(j) * * piDpj(10,10) real if ( ii>4) pi.pj * * ii integer 4: from Do, 5: from E0 * * Output: irota integer # of positions rotated + 1 * * del2 real delta(s3,s4,s3,s4) chosen * * * xqi,dqiqj,qiDqj real rotated (q->p) * * itype integer 0:normal, -1:failure, 1:del2=0 * * 2:doubly IR * * ier integer usual error flag * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments: * integer irota,ier,ii,itype RealType del2,xpi(13),dpipj(10,13),piDpj(10,10), + xqi(13),dqiqj(10,13),qiDqj(10,10) * * local variables * integer i,j,izero,ier0,init ComplexType chulp(4,4) save init * * common blocks * #include "ff.h" * * data * data init /0/ * * #] declarations: * #[ find out which del2 is negative: (or zero) izero = 0 do 40 irota = 1,12 * * first check if we have a doubly IR divergent diagram * if ( xpi(iold(3,irota)) .eq. 0 .and. + xpi(iold(4,irota)) .eq. 0 .and. + xpi(iold(7,irota)) .eq. 0 .and. + dpipj(iold(1,irota),iold(8,irota)) .eq. 0 .and. + dpipj(iold(2,irota),iold(6,irota)) .eq. 0 ) then del2 = 0 goto 41 endif * * We can at this moment only handle s3^2 = 0 * (Hope to include two masses 0 later) * I hope nothing goes wrong if we leave out: * >xpi(iold(1,irota)) .eq. 0 .or. * + xpi(iold(2,irota)) .eq. 0 .or. * + < * 'cause I can't see why it was included in the first place.. * if ( xpi(iold(4,irota)) .eq. 0 ) goto 40 * * Well, the combination s2=0, p6=s3, p10=s4 gives 1/A2=0 twice * if ( xpi(iold(2,irota)) .eq. 0 .and. + dpipj(iold( 6,irota),iold(3,irota)) .eq. 0 .and. + dpipj(iold(10,irota),iold(4,irota)) .eq. 0) + goto 40 * * phenomenologically this combo also gives an infinite result * if ( xpi(iold(1,irota)) .eq. 0 .and. + xpi(iold(2,irota)) .eq. 0 .and. + dpipj(iold( 8,irota),iold(4,irota)) .eq. 0 .and. + dpipj(iold( 9,irota),iold(3,irota)) .eq. 0) + goto 40 * * I just found out that this gives two times 1/A1 = 0 * if ( xpi(iold(7,irota)) .eq. 0 .and. + dpipj(iold(9,irota),iold(3,irota))+ + dpipj(iold(4,irota),iold(8,irota)) .eq. 0 ) + goto 40 if ( xpi(iold(1,irota)) .eq. 0 .and. + dpipj(iold(9,irota),iold(3,irota)) .eq. 0 .and. + dpipj(iold(4,irota),iold(8,irota)) .eq. 0 .and. + .not.lnasty ) + goto 40 * * the nasty case wants xpi(1)=0, xpi(2) real: * if ( lnasty ) then if ( xpi(iold(1,irota)).ne.0 .or. Im( + c2sisj(iold(1,irota),iold(2,irota))).ne.0 ) then print *,'no good: nasty but s1!=0 or s2 not real' goto 40 endif endif * * all masses equal, three momenta zero: * added by TH 24 Dec 09 * #if 0 if( xpi(iold(5,irota)) .eq. 0 .and. & xpi(iold(6,irota)) .eq. 0 .and. & xpi(iold(7,irota)) .eq. 0 .and. & abs(xpi(iold(1,irota)) - xpi(iold(2,irota))) + & abs(xpi(iold(1,irota)) - xpi(iold(3,irota))) + & abs(xpi(iold(1,irota)) - xpi(iold(4,irota))) & .lt. precx ) then itype = 3 return endif #endif * ier0 = 0 call ffxlam(del2,xpi,dpipj,10, + iold(3,irota),iold(4,irota),iold(7,irota)) * * we can only handle del2=0 if p_i^2 = 0 (and thus m_i=m_{i+1}) * if ( del2 .lt. 0 ) then itype = 0 goto 50 endif if ( del2 .eq. 0 .and. izero .eq. 0 .and. xpi(iold(7,irota)) + .eq. 0 ) then izero = irota endif 40 continue ier = ier + ier0 if ( izero .eq. 0 ) then call fferr(54,ier) itype = -1 irota = 1 else irota = izero del2 = 0 itype = 1 if ( init.lt.10 ) then init = init + 1 print *,'ffrota: warning: the algorithms for del2=0 have not ' print *,' yet been tested thoroughly, and in fact are ' print *,' known to contain bugs.' print *,' ==> DOUBLECHECK EVERYTHING WITH SMALL SPACELIKE p^2' endif endif goto 50 41 continue itype = 2 50 continue * #] find out which del2 is negative: * #[ rotate: do 20 i=1,13 xqi(i) = xpi(iold(i,irota)) do 10 j=1,10 dqiqj(j,i) = dpipj(iold(j,irota),iold(i,irota)) 10 continue 20 continue if ( ii .eq. 5 ) then do 120 i=1,10 do 110 j=1,10 qiDqj(j,i) = isgrot(iold(j,irota),irota)* + isgrot(iold(i,irota),irota)* + piDpj(iold(j,irota),iold(i,irota)) 110 continue 120 continue endif if ( lsmug .or. lnasty ) then do 220 j=1,4 do 210 i=1,4 chulp(i,j) = c2sisj(i,j) 210 continue 220 continue do 240 j=1,4 do 230 i=1,4 c2sisj(i,j) = chulp(iold(i,irota),iold(j,irota)) 230 continue 240 continue endif * #] rotate: *###] ffrot4: end *###[ ffxlam: subroutine ffxlam(xlam,xpi,dpipj,ns,i1,i2,i3) ************************************************************************* * * * calculate in a numerically stable way * * xlam(xpi(i1),xpi(i2),xpi(i3)) = * * = -((xpi(i1)+xpi(i2)-xpi(i3))/2)^2 + xpi(i1)*xpi(i2) * * or a permutation * * ier is the usual error flag. * * * ************************************************************************* implicit none * * arguments: * integer ns,i1,i2,i3 RealType xlam,xpi(ns),dpipj(ns,ns) * * local variables * RealType s1,s2 * * common blocks * #include "ff.h" * * calculations * if ( abs(xpi(i1)) .gt. max(abs(xpi(i2)),abs(xpi(i3))) ) then s1 = xpi(i2)*xpi(i3) if ( abs(dpipj(i1,i2)) .lt. abs(dpipj(i1,i3)) ) then s2 = ((dpipj(i1,i2) - xpi(i3))/2)**2 else s2 = ((dpipj(i1,i3) - xpi(i2))/2)**2 endif elseif ( abs(xpi(i2)) .gt. abs(xpi(i3)) ) then s1 = xpi(i1)*xpi(i3) if ( abs(dpipj(i1,i2)) .lt. abs(dpipj(i2,i3)) ) then s2 = ((dpipj(i1,i2) + xpi(i3))/2)**2 else s2 = ((dpipj(i2,i3) - xpi(i1))/2)**2 endif else s1 = xpi(i1)*xpi(i2) if ( abs(dpipj(i1,i3)) .lt. abs(dpipj(i2,i3)) ) then s2 = ((dpipj(i1,i3) + xpi(i2))/2)**2 else s2 = ((dpipj(i2,i3) + xpi(i1))/2)**2 endif endif xlam = s1 - s2 *###] ffxlam: end *###[ ffdot4: subroutine ffdot4(piDpj,xpi,dpipj,ns,ier) ***#[*comment:*********************************************************** * * * calculate the dotproducts pi.pj with * * * * pi = si i1=1,4 * * pi = p(i-3) i1=5,10 * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none integer ns,ier RealType xpi(13),dpipj(10,13),piDpj(10,10) integer is1,is2,is3,ip1,ip2,ip3,i,j,ier0,ier1 RealType xmax,som,xmxp #include "ff.h" * #] declarations: * #[ check input: if ( ns .ne. 10 ) print *,'ffdot4: error: ns <> 10 ' * #] check input: * #[ special case: already known: if ( idot.ge.3 ) then do 2 i=1,10 do 1 j=1,10 piDpj(j,i) = isgrot(iold(j,irota4),irota4)* + isgrot(iold(i,irota4),irota4)* + fpij4(iold(j,irota4),iold(i,irota4)) 1 continue 2 continue return endif * #] special case: already known: * #[ indices: ier1 = ier do 10 is1=1,4 is2 = is1 + 1 if ( is2 .eq. 5 ) is2 = 1 is3 = is2 + 1 if ( is3 .eq. 5 ) is3 = 1 ip1 = is1 + 4 ip2 = is2 + 4 if ( mod(is1,2) .eq. 1 ) then ip3 = 9 else ip3 = 10 endif * #] indices: * #[ all in one vertex: * * pi.pj, si.sj * piDpj(is1,is1) = xpi(is1) piDpj(ip1,ip1) = xpi(ip1) * * si.s(i+1) * if ( xpi(is2) .le. xpi(is1) ) then piDpj(is1,is2) = (dpipj(is1,ip1) + xpi(is2))/2 else piDpj(is1,is2) = (dpipj(is2,ip1) + xpi(is1))/2 endif piDpj(is2,is1) = piDpj(is1,is2) ier0 = ier ier1 = max(ier1,ier0) * * si.s(i+2) * if ( is1 .le. 2 ) then if ( xpi(is1) .le. xpi(is3) ) then piDpj(is3,is1) = (dpipj(is3,ip3) + xpi(is1))/2 else piDpj(is3,is1) = (dpipj(is1,ip3) + xpi(is3))/2 endif piDpj(is1,is3) = piDpj(is3,is1) ier0 = ier ier1 = max(ier1,ier0) endif * * pi.si * if ( abs(xpi(ip1)) .le. xpi(is1) ) then piDpj(ip1,is1) = (dpipj(is2,is1) - xpi(ip1))/2 else piDpj(ip1,is1) = (dpipj(is2,ip1) - xpi(is1))/2 endif piDpj(is1,ip1) = piDpj(ip1,is1) ier0 = ier ier1 = max(ier1,ier0) * * pi.s(i+1) * if ( abs(xpi(ip1)) .le. xpi(is2) ) then piDpj(ip1,is2) = (dpipj(is2,is1) + xpi(ip1))/2 else piDpj(ip1,is2) = (dpipj(ip1,is1) + xpi(is2))/2 endif piDpj(is2,ip1) = piDpj(ip1,is2) ier0 = ier ier1 = max(ier1,ier0) * * p(i+2).s(i) * if ( abs(xpi(ip3)) .le. xpi(is1) ) then piDpj(ip3,is1) = (dpipj(is1,is3) + xpi(ip3))/2 else piDpj(ip3,is1) = (dpipj(ip3,is3) + xpi(is1))/2 endif if ( is1 .eq. 2 .or. is1 .eq. 3 ) + piDpj(ip3,is1) = -piDpj(ip3,is1) piDpj(is1,ip3) = piDpj(ip3,is1) ier0 = ier ier1 = max(ier1,ier0) * * #] all in one vertex: * #[ all in one 3point: * * pi.s(i+2) * if ( min(abs(dpipj(is2,is1)),abs(dpipj(ip3,ip2))) .le. + min(abs(dpipj(ip3,is1)),abs(dpipj(is2,ip2))) ) then piDpj(ip1,is3) = (dpipj(ip3,ip2) + dpipj(is2,is1))/2 else piDpj(ip1,is3) = (dpipj(ip3,is1) + dpipj(is2,ip2))/2 endif piDpj(is3,ip1) = piDpj(ip1,is3) ier0 = ier ier1 = max(ier1,ier0) * * p(i+1).s(i) * if ( min(abs(dpipj(is3,is2)),abs(dpipj(ip1,ip3))) .le. + min(abs(dpipj(ip1,is2)),abs(dpipj(is3,ip3))) ) then piDpj(ip2,is1) = (dpipj(ip1,ip3) + dpipj(is3,is2))/2 else piDpj(ip2,is1) = (dpipj(ip1,is2) + dpipj(is3,ip3))/2 endif piDpj(is1,ip2) = piDpj(ip2,is1) ier0 = ier ier1 = max(ier1,ier0) * * p(i+2).s(i+1) * if ( min(abs(dpipj(is1,is3)),abs(dpipj(ip2,ip1))) .le. + min(abs(dpipj(ip2,is3)),abs(dpipj(is1,ip1))) ) then piDpj(ip3,is2) = (dpipj(ip2,ip1) + dpipj(is1,is3))/2 else piDpj(ip3,is2) = (dpipj(ip2,is3) + dpipj(is1,ip1))/2 endif if ( is1 .eq. 2 .or. is1 .eq. 3 ) + piDpj(ip3,is2) = -piDpj(ip3,is2) piDpj(is2,ip3) = piDpj(ip3,is2) ier0 = ier ier1 = max(ier1,ier0) * * #] all in one 3point: * #[ all external 3point: if ( idot.le.0 ) then * * pi.p(i+1) * if ( abs(xpi(ip2)) .le. abs(xpi(ip1)) ) then piDpj(ip1,ip2) = (dpipj(ip3,ip1) - xpi(ip2))/2 else piDpj(ip1,ip2) = (dpipj(ip3,ip2) - xpi(ip1))/2 endif piDpj(ip2,ip1) = piDpj(ip1,ip2) ier0 = ier ier1 = max(ier1,ier0) * * p(i+1).p(i+2) * if ( abs(xpi(ip3)) .le. abs(xpi(ip2)) ) then piDpj(ip2,ip3) = (dpipj(ip1,ip2) - xpi(ip3))/2 else piDpj(ip2,ip3) = (dpipj(ip1,ip3) - xpi(ip2))/2 endif if ( is1 .eq. 2 .or. is1 .eq. 3 ) + piDpj(ip2,ip3) = -piDpj(ip2,ip3) piDpj(ip3,ip2) = piDpj(ip2,ip3) ier0 = ier ier1 = max(ier1,ier0) * * p(i+2).p(i) * if ( abs(xpi(ip1)) .le. abs(xpi(ip3)) ) then piDpj(ip3,ip1) = (dpipj(ip2,ip3) - xpi(ip1))/2 else piDpj(ip3,ip1) = (dpipj(ip2,ip1) - xpi(ip3))/2 endif if ( is1 .eq. 2 .or. is1 .eq. 3 ) + piDpj(ip3,ip1) = -piDpj(ip3,ip1) piDpj(ip1,ip3) = piDpj(ip3,ip1) ier0 = ier ier1 = max(ier1,ier0) * else * * idot > 0: copy the dotproducts from fpij4 * piDpj(ip1,ip2) = isgrot(iold(ip1,irota4),irota4)* + isgrot(iold(ip2,irota4),irota4)* + fpij4(iold(ip1,irota4),iold(ip2,irota4)) piDpj(ip2,ip1) = piDpj(ip1,ip2) piDpj(ip1,ip3) = isgrot(iold(ip1,irota4),irota4)* + isgrot(iold(ip3,irota4),irota4)* + fpij4(iold(ip1,irota4),iold(ip3,irota4)) piDpj(ip3,ip1) = piDpj(ip1,ip3) piDpj(ip2,ip3) = isgrot(iold(ip2,irota4),irota4)* + isgrot(iold(ip3,irota4),irota4)* + fpij4(iold(ip2,irota4),iold(ip3,irota4)) piDpj(ip3,ip2) = piDpj(ip2,ip3) endif 10 continue * #] all external 3point: * #[ real 4point: * * the awkward 4point dotproducts: * piDpj(9,9) = xpi(9) piDpj(10,10) = xpi(10) if ( idot.le.0 ) then *--#[ p5.p7: if ( abs(xpi(7)) .lt. abs(xpi(5)) ) then piDpj(5,7) = (-xpi(7) - dpipj(5,11))/2 else piDpj(5,7) = (-xpi(5) - dpipj(7,11))/2 endif xmax = min(abs(xpi(5)),abs(xpi(7))) if ( abs(piDpj(5,7)) .lt. xloss*xmax ) then * * second try (old algorithm) * if ( min(abs(dpipj(6,9)),abs(dpipj(8,10))) .le. + min(abs(dpipj(8,9)),abs(dpipj(6,10))) ) then som = (dpipj(6,9) + dpipj(8,10))/2 else som = (dpipj(8,9) + dpipj(6,10))/2 endif xmxp = min(abs(dpipj(6,9)),abs(dpipj(8,9))) if ( xmxp.lt.xmax ) then piDpj(5,7) = som xmax = xmxp endif ier0 = ier ier1 = max(ier1,ier0) endif piDpj(7,5) = piDpj(5,7) *--#] p5.p7: *--#[ p6.p8: if ( abs(xpi(6)) .lt. abs(xpi(8)) ) then piDpj(6,8) = (-xpi(6) - dpipj(8,11))/2 else piDpj(6,8) = (-xpi(8) - dpipj(6,11))/2 endif xmax = min(abs(xpi(6)),abs(xpi(8))) if ( abs(piDpj(6,8)) .lt. xloss*xmax ) then * * second try (old algorithm) * if ( min(abs(dpipj(5,9)),abs(dpipj(7,10))) .le. + min(abs(dpipj(7,9)),abs(dpipj(5,10))) ) then som = (dpipj(5,9) + dpipj(7,10))/2 else som = (dpipj(7,9) + dpipj(5,10))/2 endif xmxp = min(abs(dpipj(5,9)),abs(dpipj(7,9))) if ( xmxp.lt.xmax ) then piDpj(6,8) = som xmax = xmxp endif ier0 = ier ier1 = max(ier1,ier0) endif piDpj(8,6) = piDpj(6,8) *--#] p6.p8: *--#[ p9.p10: if ( abs(xpi(9)) .lt. abs(xpi(10)) ) then piDpj(9,10) = (-xpi(9) - dpipj(10,13))/2 else piDpj(9,10) = (-xpi(10) - dpipj(9,13))/2 endif xmax = min(abs(xpi(9)),abs(xpi(10))) if ( abs(piDpj(9,10)) .lt. xloss*xmax ) then * * second try (old algorithm) * if ( min(abs(dpipj(5,6)),abs(dpipj(7,8))) .le. + min(abs(dpipj(7,6)),abs(dpipj(5,8))) ) then som = (dpipj(5,6) + dpipj(7,8))/2 else som = (dpipj(7,6) + dpipj(5,8))/2 endif xmxp = min(abs(dpipj(5,6)),abs(dpipj(7,6))) if ( xmxp.lt.xmax ) then piDpj(9,10) = som xmax = xmxp endif ier0 = ier ier1 = max(ier1,ier0) endif piDpj(10,9) = piDpj(9,10) *--#] p9.p10: else *--#[ copy: * * idot > 1: just copy from fpij4... * piDpj(5,7) = isgrot(iold(5,irota4),irota4)* + isgrot(iold(7,irota4),irota4)* + fpij4(iold(5,irota4),iold(7,irota4)) piDpj(7,5) = piDpj(5,7) piDpj(6,8) = isgrot(iold(6,irota4),irota4)* + isgrot(iold(8,irota4),irota4)* + fpij4(iold(6,irota4),iold(8,irota4)) piDpj(8,6) = piDpj(6,8) piDpj(9,10)= isgrot(iold(9,irota4),irota4)* + isgrot(iold(10,irota4),irota4)* + fpij4(iold(9,irota4),iold(10,irota4)) piDpj(10,9) = piDpj(9,10) *--#] copy: endif ier = ier1 * #] real 4point: *###] ffdot4: end *###[ ffgdt4: subroutine ffgdt4(piDpj,xpip,dpipjp,xpi,ier) ***#[*comment:*********************************************************** * * * calculate the dotproducts pi.pj with * * and store results in common when asked for * * * * pi = si i1=1,4 * * pi = p(i-3) i1=5,10 * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments * RealType piDpj(10,10),xpip(13),dpipjp(10,13),xpi(13) integer ier * * local variables * integer i,j,ii(6) RealType dl3p * * common blocks: * #include "ff.h" * * #] declarations: * #[ get dotproducts: * * Calculate the dotproducts * call ffdot4(piDpj,xpip,dpipjp,10,ier) if ( ldot .and. idot.lt.3 ) then do 65 i=1,10 do 64 j=1,10 fpij4(iold(j,irota4),iold(i,irota4)) = + isgrot(iold(j,irota4),irota4)* + isgrot(iold(i,irota4),irota4)*piDpj(j,i) 64 continue 65 continue endif if ( ldot ) then if ( abs(idot).lt.2 ) then ii(1)= 5 ii(2)= 6 ii(3)= 7 ii(4)= 8 ii(5)= 9 ii(6)= 10 fidel3 = ier call ffdl3p(dl3p,piDpj,10,ii,ii) fdel3 = dl3p else dl3p = fdel3 endif if ( dl3p .lt. 0 ) then call fferr(44,ier) print *,'overall vertex has del3 ',dl3p print *,'xpi = ',xpi endif endif * #] get dotproducts: *###] ffgdt4: end LoopTools-2.16/src/D/PaxHeaders/ffxd0.F0000644000000000000000000000007411776502523014557 xustar0030 atime=1648161785.711698365 30 ctime=1648161793.715764879 LoopTools-2.16/src/D/ffxd0.F0000644000000000000000000004437011776502523015502 0ustar00rootroot00000000000000#include "externals.h" #include "types.h" *--#[ log: * $Id: ffxd0.f,v 1.4 1996/01/22 13:32:52 gj Exp $ * $Log: ffxd0.f,v $ c Revision 1.4 1996/01/22 13:32:52 gj c Added sanity check on ier; if it is larger than 16 some routines will not c compute anything. c c Revision 1.3 1995/11/28 13:37:47 gj c Found wrong sign in ffcdna, fixed typo in ffcrp. c Killed first cancellation in ffcdna - more to follow c Added warnings to ffwarn.dat; slightly changed debug output in ffxd0.f c c Revision 1.2 1995/10/17 06:55:12 gj c Fixed ieps error in ffdcrr (ffcxs4.f), added real case in ffcrr, debugging c info in ffxd0, and warned against remaining errors for del2=0 in ffrot4 c (ffxd0h.f) c *--#] log: *###[ ffxd0: subroutine ffxd0(cd0,xpi,ier) ***#[*comment:*********************************************************** * * * 1 / * * calculate cd0 = ----- \dq [(q^2 + 2*s_1.q)*(q^2 + 2*s2.q) * * ipi^2 / *(q^2 + 2*s3.q)*(q^2 + 2*s4.q)]^-1 * * * * |p9 * * \p8 V p7/ * * \ / * * \________/ * * | m4 | * * = | | /____ * * m1| |m3 \ p10 * * | | all momenta are incoming * * |________| * * / m2 \ * * / \ * * /p5 p6\ * * * * * * following the two-three-point-function method in 't hooft & * * veltman. this is only valid if there is a lambda(pij,mi,mj)>0 * * * * Input: xpi = mi^2 (real) i=1,4 * * xpi = pi.pi (real) i=5,8 (note: B&D metric) * * xpi(9)=s (real) (=p13) * * xpi(10)=t (real) (=p24) * * xpi(11)=u (real) u=p5.p5+..-p9.p9-p10.10 or 0 * * xpi(12)=v (real) v=-p5.p5+p6.p6-p7.p7+.. or 0 * * xpi(13)=w (real) w=p5.p5-p6.p6+p7.p7-p8.p8+.. * * output: cd0 (complex) * * ier (integer) <50:lost # digits 100=error * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments * RealType xpi(13) ComplexType cd0 integer ier * * local variables * logical luvw(3) RealType dpipj(10,13) * * common blocks: * #include "ff.h" * #] declarations: * #[ catch totally massless case: * if (abs(xpi(1) + xpi(2) + xpi(3) + xpi(4)) .lt. 1D-10) then call ffxd0m0(cd0,xpi,ier) return endif * * #] catch totally massless case: * #[ call ffdif4, ffxd0a: * call ffdif4(dpipj,luvw,xpi) call ffxd0a(cd0,xpi,dpipj,ier) * * restore the zeros for u,v,w as we have calculated them * ourselves and the user is unlikely to do this... * if ( luvw(1) ) xpi(11) = 0 if ( luvw(2) ) xpi(12) = 0 if ( luvw(3) ) xpi(13) = 0 * * #] call ffdif4, ffxd0a: *###] ffxd0: end *###[ ffxd0a: subroutine ffxd0a(cd0,xpi,dpipj,ier) * * glue routine which calls ffxd0b with ndiv=0 * implicit none * * arguments * integer ier RealType xpi(13),dpipj(10,13) ComplexType cd0 * * locals * ComplexType cs,cfac * * and go! * call ffxd0b(cs,cfac,xpi,dpipj,0,ier) cd0 = cs*cfac * *###] ffxd0a: end *###[ ffxd0b: subroutine ffxd0b(cs,cfac,xpi,dpipj,ndiv,ier) ***#[*comment:*********************************************************** * * * 1 / * * calculate cd0 = ----- \dq [(q^2 + 2*s_1.q)*(q^2 + 2*s2.q) * * ipi^2 / *(q^2 + 2*s3.q)*(q^2 + 2*s4.q)]^-1 * * * * |p9 * * \p8 V p7/ * * \ / * * \________/ * * | m4 | * * = | | /____ * * m1| |m3 \ p10 * * | | all momenta are incoming * * |________| * * / m2 \ * * / \ * * /p5 p6\ * * * * * * following the two-three-point-function method in 't hooft & * * veltman. this is only valid if there is a lambda(pij,mi,mj)>0 * * * * Input: xpi = mi^2 (real) i=1,4 * * xpi = pi.pi (real) i=5,8 (note: B&D metric) * * xpi(9)=s (real) (=p13) * * xpi(10)=t (real) (=p24) * * xpi(11)=u (real) u=p5.p5+..-p9.p9-p10.10 * * xpi(12)=v (real) v=-p5.p5+p6.p6-p7.p7+.. * * xpi(13)=w (real) w=p5.p5-p6.p6+p7.p7-p8.p8+.. * * dpipj(10,13) (real) = pi(i) - pi(j) * * output: cs,cfac (complex) cd0 = cs*cfac * * ier (integr) 0=ok 1=inaccurate 2=error * * calls: ffcxs3,ffcxr,ffcrr,... * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments * integer ndiv,ier RealType xpi(13),dpipj(10,13) ComplexType cs,cfac * * local variables * integer i,j,itype,ini2ir,ier2,idone,ier0 logical ldel2s ComplexType c,cs1,cs2 RealType absc,xmax,xpip(13),dpipjp(10,13),piDpjp(10,10), + qiDqj(10,10),del2s,lambda0 save ini2ir,lambda0 * * common blocks: * #include "ff.h" * * memory * integer iermem(memory),ialmem(memory),memind,ierini,nscsav, + isgnsa logical onssav RealType xpimem(10,memory),dl4mem(memory) ComplexType csmem(memory),cfcmem(memory) save memind,iermem,ialmem,xpimem,dl4mem,nscsav,onssav,csmem, + cfcmem * * statement function: * absc(c) = abs(Re(c)) + abs(Im(c)) * * data * data memind /0/ data ini2ir /0/ data lambda0 /1D0/ * * #] declarations: * #[ initialisations: cs = 0 cfac = 1 idsub = 0 idone = 0 * #] initialisations: * #[ check for IR 4point function: * call ffxdir(cs,cfac,idone,xpi,dpipj,4,ndiv,ier) if ( idone .le. 0 .and. ndiv .gt. 0 ) then cs = 0 cfac = 1 ier = 0 return endif if ( idone .gt. 0 ) then return endif * * #] check for IR 4point function: * #[ rotate to calculable position: call ffrot4(irota4,del2s,xpip,dpipjp,piDpjp,xpi,dpipj,qiDqj,4, + itype,ier) if ( itype .lt. 0 ) then print *,'ffxd0b: error: Cannot handle this ', + ' masscombination yet:' print *,(xpi(i),i=1,13) return endif if ( itype .eq. 1 ) then ldel2s = .TRUE. isgnal = +1 else ldel2s = .FALSE. endif * #] rotate to calculable position: * #[ treat doubly IR divergent case: if ( itype .eq. 2 ) then * * double IR divergent diagram, i.e. xpi(3)=xpi(4)=xpi(7)=0 * if ( ini2ir .eq. 0 ) then ini2ir = 1 print *,'ffxd0b: using the log(lam) prescription to' print *,' regulate the 2 infrared poles to match' print *,' with soft gluon massive, lam^2 =',lambda endif ier2 = 0 call ffx2ir(cs1,cs2,xpip,dpipjp,ier2) del2s = -lambda**2/4 * * correct for the wrongly treated IR pole * cs = cs + (cs1 + cs2)/cfac ier = max(ier,ier2) xmax = max(absc(cs1),absc(cs2))/absc(cfac) if ( absc(cs) .lt. xloss*xmax ) + call ffwarn(172,ier,absc(cs),xmax) if ( .not.ldot ) return endif if( itype .eq. 3 ) then call ffd0tra(cs, & xpi(iold(9,irota4)), xpi(iold(10,irota4)), & xpi(iold(1,irota4)), xpi(iold(8,irota4)), ier) return endif * * #] treat doubly IR divergent case: * #[ look in memory: ierini = ier isgnsa = isgnal * * initialise memory * if ( lmem .and. idone .eq. 0 .and. (memind .eq. 0 .or. nschem + .ne. nscsav .or. (onshel .neqv. onssav) ) ) then memind = 0 nscsav = nschem onssav = onshel do 2 i=1,memory do 1 j=1,10 xpimem(j,i) = 0 1 continue ialmem(i) = 0 2 continue endif * if ( lmem .and. idone .eq. 0 .and. lambda .eq. lambda0 ) then do 150 i=1,memory do 130 j=1,10 if ( xpip(j) .ne. xpimem(j,i) ) goto 150 130 continue * we use ialmem(i)==0 to signal that both are covered as * the sign was flipped during the computation if ( ialmem(i).ne.isgnal .and. ialmem(i).ne.0 ) goto 150 * we found an already calculated masscombination .. * (maybe check differences as well) cs = csmem(i) cfac = cfcmem(i) ier = ier+iermem(i) if ( ldot ) then fdel4s = dl4mem(i) * we forgot to calculate the dotproducts idone = 1 goto 51 endif return 150 continue elseif ( lmem ) then lambda0 = lambda endif 51 continue * #] look in memory: * #[ get dotproducts: * * Calculate the dotproducts (in case it comes out of memory the * error is already included in ier) * ier0 = ier call ffgdt4(piDpjp,xpip,dpipjp,xpi,ier0) if ( idone .gt. 0 ) return ier = ier0 if ( ier.ge.100 ) then cs = 0 cfac = 1 return endif * * #] get dotproducts: * #[ calculations: * call ffxd0e(cs,cfac,xmax, .FALSE.,ndiv,xpip,dpipjp,piDpjp,del2s, + ldel2s,ier) * * #] calculations: * #[ add to memory: * * memory management :-) * if ( lmem ) then memind = memind + 1 if ( memind .gt. memory ) memind = 1 do 200 j=1,10 xpimem(j,memind) = xpip(j) 200 continue csmem(memind) = cs cfcmem(memind) = cfac iermem(memind) = ier-ierini ialmem(memind) = isgnal dl4mem(memind) = fdel4s if ( isgnal.ne.isgnsa ) then ialmem(memind) = 0 endif endif * #] add to memory: *###] ffxd0b: end *###[ ffxd0e: subroutine ffxd0e(cs,cfac,xmax,lir,ndiv,xpip,dpipjp,piDpjp, + del2s,ldel2s,ier) ***#[*comment:*********************************************************** * * * Break in the calculation of D0 to allow the E0 to tie in in a * * logical position. This part gets untransformed momenta but * * rotated momenta in and gives the D0 (in two pieces) and the * * maximum term back. * * * * Input xpip real(13) * * dpipjp real(10,13) * * piDpjp real(10,10) * * del2s real * * ldel2s logical * * lir logical if TRUE it can still be IR-div * * ndiv integer number of required divergences * * * * Output: cs complex the fourpoint function without * * overall factor (sum of dilogs) * * cfac complex this overall factor * * xmax real largest term in summation * * ier integer usual error flag * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments * integer ndiv,ier logical lir,ldel2s RealType xpip(13),dpipjp(10,13),piDpjp(10,10),xmax,del2s ComplexType cs,cfac * * local variables * ComplexType c,cs4(175),cs3(2) logical laai integer i,ier0,itime,maxlos,init,isoort(16),ipi12(28), + ipi123(2),ipi12t,idone RealType absc,sdel2s,ai(4),daiaj(4,4),aai(4), + dt3t4,xqi(10),dqiqj(10,10),qiDqj(10,10),xfac save maxlos * * common blocks: * #include "ff.h" * * statement function: * absc(c) = abs(Re(c)) + abs(Im(c)) * * data * data init /0/ * #] declarations: * #[ check for IR 4point function: if ( lir ) then * ier0 = ier call ffxdir(cs,cfac,idone,xpip,dpipjp,4,0,ier) if ( idone .le. 0 .and. ndiv .gt. 0 ) then cs = 0 cfac = 1 xmax = 0 ier = 0 return endif if ( idone .gt. 0 ) then xmax = abs(cs)*10d0**(-mod((ier0-ier),50)) return endif endif * * #] check for IR 4point function: * #[ init: * * initialize cs4: * do 80 i=1,175 cs4(i) = 0 80 continue do 90 i=1,28 ipi12(i) = 0 90 continue cs = 0 * * #] init: * #[ transform the masses and momenta: itime = 1 25 continue * * Transform with the A's of gerard 't hooft's transformation: * * NOTE: for some odd reason I cannot vary isgnal,isgn34 * independently! * isgn34 = isgnal sdel2s = isgn34*sqrt(-del2s) ier0 = ier call ffai(ai,daiaj,aai,laai,del2s,sdel2s,xpip,dpipjp,piDpjp, + ier0) if ( ier0 .ge. 100 ) goto 70 call fftran(ai,daiaj,aai,laai,xqi,dqiqj,qiDqj,del2s,sdel2s, + xpip,dpipjp,piDpjp,ier0) if ( ier0 .ge. 100 ) goto 70 if ( .not.ldel2s ) then dt3t4 = -2*ai(3)*ai(4)*sdel2s if ( dt3t4 .eq. 0 ) then * don't know what to do... call fferr(85,ier) return endif else * this value is modulo the delta of xpip(4)=xpip(3)(1+2delta) dt3t4 = -2*ai(4)**2*xpip(3) endif 70 continue * * If we lost too much accuracy try the other root... * (to do: build in a mechanism for remembering this later) * if ( init .eq. 0 ) then init = 1 * go ahead if we have half the digits left maxlos = -int(log10(precx))/2 endif if ( ier0-ier .gt. maxlos ) then if ( itime .eq. 1 ) then itime = 2 if ( ier0-ier .ge. 100 ) itime = 100 isgnal = -isgnal goto 25 else if ( ier0-ier .lt. 100 ) then * it does not make any sense to go on, but do it anyway elseif ( itime.eq.100 ) then call fferr(72,ier) cfac = 1 return elseif ( itime.le.2 ) then * the first try was better isgnal = -isgnal itime = 3 goto 25 endif endif endif ier = ier0 * #] transform the masses and momenta: * #[ calculations: call ffxd0p(cs4,ipi12,isoort,cfac,xpip,dpipjp,piDpjp, + xqi,dqiqj,qiDqj,ai,daiaj,ldel2s,ier) xfac = -ai(1)*ai(2)*ai(3)*ai(4)/dt3t4 * * see the note at the end of this section about the sign * if ( Im(cfac) .eq. 0 ) then cfac = xfac/Re(cfac) else cfac = Re(xfac)/cfac endif * * sum'em up: * cs3(1) = 0 cs3(2) = 0 xmax = 0 do 110 i=1,80 cs3(1) = cs3(1) + cs4(i) xmax = max(xmax,absc(cs3(1))) 110 continue do 111 i=81,160 cs3(2) = cs3(2) + cs4(i) xmax = max(xmax,absc(cs3(2))) 111 continue cs = cs3(1) - cs3(2) do 112 i=161,175 cs = cs + cs4(i) xmax = max(xmax,absc(cs)) 112 continue ipi123(1) = 0 ipi123(2) = 0 do 113 i=1,8 ipi123(1) = ipi123(1) + ipi12(i) 113 continue do 114 i=9,16 ipi123(2) = ipi123(2) + ipi12(i) 114 continue ipi12t = ipi123(1) - ipi123(2) do 120 i=17,28 ipi12t = ipi12t + ipi12(i) 120 continue cs = cs + ipi12t*Re(pi12) * * If the imaginary part is very small it most likely is zero * (can be removed, just esthetically more pleasing) * if ( abs(Im(cs)) .lt. precc*abs(Re(cs)) ) + cs = ToComplex(Re(cs)) * * it is much nicer to have the sign of cfac fixed, say positive * if ( Re(cfac) .lt. 0 .or. (Re(cfac) .eq. 0 .and. Im(cfac) + .lt. 0 ) ) then cfac = -cfac cs = -cs endif * #] calculations: *###] ffxd0e: end *###[ ffxd0r: subroutine ffxd0r(cd0,xpi,ier) ***#[*comment:*********************************************************** * * * Tries all 12 permutations of the 4pointfunction * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none integer ier RealType xpi(13),xqi(13) ComplexType cd0,cd0p integer inew(13,6),irota,ier0,ier1,i,j,ialsav save inew #include "ff.h" data inew /1,2,3,4,5,6,7,8,9,10,11,12,13, + 4,1,2,3,8,5,6,7,10,9,11,13,12, + 3,4,1,2,7,8,5,6,9,10,11,12,13, + 2,3,4,1,6,7,8,5,10,9,11,13,12, + 4,2,3,1,10,6,9,8,7,5,12,11,13, + 1,3,2,4,9,6,10,8,5,7,12,11,13/ * #] declarations: * #[ calculations: cd0 = 0 ier0 = ier ier = 999 ialsav = isgnal do 30 j = -1,1,2 do 20 irota=1,6 do 10 i=1,13 xqi(inew(i,irota)) = xpi(i) 10 continue ier1 = ier0 ner = 0 id = id + 1 isgnal = ialsav print '(a,i1,a,i2)','---#[ rotation ',irota,': isgnal ', + isgnal call ffxd0(cd0p,xqi,ier1) ier1 = ier1 + ner print '(a,i1,a,i2,a)','---#] rotation ',irota, + ': isgnal ',isgnal,' ' print '(a,2g28.16,i3)','d0 = ',cd0p,ier1 if ( ier1 .lt. ier ) then cd0 = cd0p ier = ier1 endif 20 continue ialsav = -ialsav 30 continue * #] calculations: *###] ffxd0r: end *###[ ffxd0d: subroutine ffxd0d(cd0,xpi,piDpj,del3p,del4s,info,ier) ***#[*comment:*********************************************************** * * * Entry point to the four point function with dotproducts given. * * Necessary to avoid cancellations near the borders of phase * * space. * * * * Input: xpi(13) real 1-4: mi^2, 5-10: pi^2,s,t * * optional: 11:u, 12:v, 13:w * * info integer 0: no extra info * * 1: piDpj(i,j), i,j>4 is defined * * 2: del3p is also defined * * 3: all piDpj are given * * 4: del4s is also given * * piDpj(10,10) real pi.pj in B&D metric; * * 1-4:si.sj=(m_i^2+m_j^2-p_ij^2)/2* * cross: si.pjk=si.pj-si.pk * * 5-10: pi.pj * * del3p real det(pi.pj) * * del4s real det(si.sj) (~square overall fac)* * ier integer #digits accuracy lost in input * * Output: cd0 complex D0 * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments * integer info,ier RealType xpi(13),piDpj(10,10),del3p,del4s ComplexType cd0 * * local vars * integer i,j * * common blocks * #include "ff.h" * * #] declarations: * #[ hide information in common blocks: * idot = info if ( idot.ne.0 ) then if ( idot.gt.0 .and. idot.le.2 ) then do 20 i=5,10 do 10 j=5,10 fpij4(j,i) = piDpj(j,i) 10 continue 20 continue elseif ( idot.ge.3 ) then do 40 i=1,10 do 30 j=1,10 fpij4(j,i) = piDpj(j,i) 30 continue 40 continue endif if ( abs(idot).ge.2 ) then fdel3 = del3p endif if ( abs(idot).ge.4 ) then fdel4s = del4s endif endif * * #] hide information in common blocks: * #[ call ffxd0: * call ffxd0(cd0,xpi,ier) * * invalidate all the common blocks for the next call * idot = 0 * * #] call ffxd0: *###] ffxd0d: end *###[ ffdif4: subroutine ffdif4(dpipj,luvw,xpi) ***#[*comment:*********************************************************** * * * Compute the elements 11-13 in xpi and the differences dpipj * * Note that the digits lost in dpipj are not counted towards * * the total. * * * * Input: xpi(1:10) real masses, momenta^2 * * * * Output: xpi(11:13) real u and similar vars v,w * * luvw(3) logical TRUE if xpi(10+i) has * * been computed here * * dpipj(10,13) real xpi(i) - xpi(j) * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments * logical luvw(3) RealType xpi(13),dpipj(10,13) * * local variables * integer i,j * * common blocks * #include "ff.h" * * #] declarations: * #[ get differences: * simulate the differences in the masses etc.. if ( xpi(11) .eq. 0 ) then xpi(11) = xpi(5)+xpi(6)+xpi(7)+xpi(8)-xpi(9)-xpi(10) luvw(1) = .TRUE. else luvw(1) = .FALSE. endif if ( xpi(12) .eq. 0 ) then xpi(12) = -xpi(5)+xpi(6)-xpi(7)+xpi(8)+xpi(9)+xpi(10) luvw(2) = .TRUE. else luvw(2) = .FALSE. endif if ( xpi(13) .eq. 0 ) then if ( max(abs(xpi(5)),abs(xpi(7))) .gt. + max(abs(xpi(9)),abs(xpi(10))) ) then xpi(13) = -xpi(12) + 2*(xpi(9)+xpi(10)) else xpi(13) = -xpi(11) + 2*(xpi(5)+xpi(7)) endif * xpi(13) = xpi(5)-xpi(6)+xpi(7)-xpi(8)+xpi(9)+xpi(10) luvw(3) = .TRUE. else luvw(3) = .FALSE. endif do 20 i=1,13 do 19 j=1,10 dpipj(j,i) = xpi(j) - xpi(i) 19 continue 20 continue * #] get differences: *###] ffdif4: end LoopTools-2.16/src/D/PaxHeaders/D0func.F0000644000000000000000000000007413603060172014655 xustar0030 atime=1648161785.711698365 30 ctime=1648161793.715764879 LoopTools-2.16/src/D/D0func.F0000644000000000000000000013436213603060172015601 0ustar00rootroot00000000000000* D0func.F * the scalar four-point function * this file is part of LoopTools * last modified 1 Jan 20 th #include "externals.h" #include "types.h" #define npoint 4 #include "defs.h" subroutine D0func(res, res00, para) implicit none ComplexType res(0:2), res00(0:2) RealType para(1,*) #include "lt.h" external D0softDR, D0collDR, D0soft, D0coll res = 0 res00 = 0 res00(0) = -999 if( lambda .le. 0 ) then call DDispatch(res, res00, para, D0softDR, D0collDR) else call DDispatch(res, res00, para, D0soft, D0coll) endif end ************************************************************************ subroutine DDispatch(res, res00, para, soft, coll) implicit none ComplexType res(0:2), res00(0:2) RealType para(1,*) external soft, coll #include "lt.h" #include "perm.h" integer i, z, s, perm, key, ier ComplexType alt integer pperm(12), mperm(0:7) data pperm / & p1234, p1243, p1324, & p2341, p2431, p2314, & p3412, p3142, p3421, & p4123, p4132, p4213 / data mperm / p1234, p1234, & p1324, p1234, p1432, & p1243, p1342, p1234 / * 0 1 1xxx O'1234561234' * 1 2 12xx O'1234561234' * 2 2 13xx O'5264131324' * 3 3 123x O'1234561234' * 4 2 14xx O'4321561432' * 5 3 124x O'1635421243' * 6 3 134x O'5361421342' * 7 4 xxxx O'1234561234' #define pj(p,j) ibits(p,3*(10-j),3) #define mj(p,j) ibits(p,3*(4-j),3) #define Px(j) P(pj(perm,j)) #define Mx(j) M(mj(perm,j)) z = 0 s = 0 do i = 1, 12 perm = pperm(i) if( abs(Mx(1)) .lt. zeroeps ) then if( abs(Px(1)) + abs(Mx(2)) .lt. zeroeps ) then if( DEBUGLEVEL .gt. 0 ) & print '("collinear D0, perm = ",O10)', perm call coll(res, para, perm) if( perm .eq. 0 ) return endif if( s .eq. 0 .and. & abs(Px(1) - Mx(2)) + & abs(Px(4) - Mx(4)) .lt. diffeps ) s = perm if( z .eq. 0 ) z = perm endif enddo if( s .ne. 0 .and. lambda .le. 0 ) then if( DEBUGLEVEL .gt. 0 ) & print '("soft D0, perm = ",O10)', s call soft(res, para, s) return endif if( abs(P(1)) + abs(P(2)) + abs(P(3)) + abs(P(4)) + & abs(P(5)) + abs(P(6)) .lt. zeroeps ) then if( DEBUGLEVEL .gt. 0 ) print '("D0z")' call D0z(res, res00, para) return endif key = ibits(versionkey, KeyD0, 2) if( key .ne. 1 ) then P(7) = 0 P(8) = 0 P(9) = 0 ier = 0 call ffxd0(res(0), para, ier) if( ier .gt. warndigits ) then ier = 0 call ffxd0r(res(0), para, ier) if( ier .gt. warndigits ) key = ior(key, 2) if( ier .ge. errdigits ) key = ior(key, 3) endif if( key .eq. 0 ) return alt = res(0) endif if( s .ne. 0 ) then if( DEBUGLEVEL .gt. 0 ) & print '("soft D0, perm = ",O10)', s call soft(res, para, s) goto 9 endif if( z .eq. 0 ) then call D0m4(res(0), para) goto 9 endif perm = z z = 0 if( abs(Mx(2)) .lt. zeroeps ) z = 1 if( abs(Mx(3)) .lt. zeroeps ) z = z + 2 if( abs(Mx(4)) .lt. zeroeps ) z = z + 4 s = mperm(z) if( s .ne. p1234 ) perm = & pj(perm,pj(s,1))*8**9 + & pj(perm,pj(s,2))*8**8 + & pj(perm,pj(s,3))*8**7 + & pj(perm,pj(s,4))*8**6 + & pj(perm,pj(s,5))*8**5 + & pj(perm,pj(s,6))*8**4 + & mj(perm,mj(s,1))*8**3 + & mj(perm,mj(s,2))*8**2 + & mj(perm,mj(s,3))*8**1 + & mj(perm,mj(s,4))*8**0 goto (2, 2, 3, 2, 3, 3, 4) z call D0m3(res(0), para, perm) goto 9 2 call D0m2(res(0), para, perm) goto 9 3 call D0m1(res(0), para, perm) goto 9 4 call D0m0(res(0), para) 9 if( key .gt. 1 .and. & abs(res(0) - alt) .gt. maxdev*abs(alt) ) then print *, "Discrepancy in D0:" print *, " p1 =", P(1) print *, " p2 =", P(2) print *, " p3 =", P(3) print *, " p4 =", P(4) print *, " p1p2 =", P(5) print *, " p2p3 =", P(6) print *, " m1 =", M(1) print *, " m2 =", M(2) print *, " m3 =", M(3) print *, " m4 =", M(4) print *, "D0 a =", alt print *, "D0 b =", res(0) endif if( .not. btest(key, 0) ) res(0) = alt end ************************************************************************ subroutine DDump(s, para,ldpara, perm) implicit none character*(*) s integer ldpara, perm RealType para(ldpara,*) #include "lt.h" print '(A,", perm = ",O4)', s, iand(perm, O'7777') if( DEBUGLEVEL .gt. 1 ) then print *, "p1 =", Px(1) print *, "p2 =", Px(2) print *, "p3 =", Px(3) print *, "p4 =", Px(4) print *, "p1p2 =", Px(5) print *, "p2p3 =", Px(6) print *, "m1 =", Mx(1) print *, "m2 =", Mx(2) print *, "m3 =", Mx(3) print *, "m4 =", Mx(4) endif end ************************************************************************ subroutine D0soft(res, para, perm) implicit none ComplexType res RealType para(1,*) integer perm #include "lt.h" RealType m3, p1, p2, p3, p4, p1p2, p2p3 RealType r1, r3, r4 ComplexType xs, x2, x3, y, c, fac ComplexType lxs, lx2, lx3, l1x2, l1x3, ly, lm integer ier ComplexType bdK, zfflo1, spence external bdK, zfflo1, spence m3 = Mx(3) p1 = Px(1) p2 = Px(2) p3 = Px(3) p4 = Px(4) p1p2 = Px(5) p2p3 = Px(6) if( DEBUGLEVEL .gt. 0 ) call DDump("D0soft", para,1, perm) ier = 0 r1 = sqrt(p1) r4 = sqrt(p4) fac = .5D0/(r1*r4*(p1p2 - m3)) xs = bdK(p2p3, r1, r4) lxs = -1 if( xs .ne. 1 ) then lxs = log(xs) fac = 2*xs/((1 - xs)*(1 + xs))*fac endif * massless case if( abs(m3) .lt. zeroeps ) then if( abs(p1 - p2) + abs(p3 - p4) .lt. diffeps ) then res = -2*ln(-lambda/p1p2, 1)*lxs*fac return endif y = (r1*(p3 - p4 + cIeps))/(r4*(p2 - p1 + cIeps)) ly = log(y) c = ln(lambda/(r1*r4), 0) + & ln((p2 - p1)/p1p2, p1 - p2) + & ln((p3 - p4)/p1p2, p4 - p3) if( xs .eq. 1 ) then res = fac*(c - 2 - (1 + y)/(1 - y)*ly) else res = fac*(pi6 - & spence(0, xs/y, 0D0) - & (lxs + log(1/y))*zfflo1(xs/y, ier) - & spence(0, xs*y, 0D0) - & (lxs + ly)*(zfflo1(xs*y, ier) + .5D0*(lxs - ly)) + & spence(0, xs**2, 0D0) + & lxs*(2*zfflo1(xs**2, ier) - c)) endif goto 9 endif * massive case r3 = sqrt(m3) x2 = bdK(p2, r1, r3) x3 = bdK(p3, r4, r3) lx2 = log(x2) lx3 = log(x3) l1x3 = log(1/x3) lm = 2*ln(r3*sqrt(lambda)/(m3 - p1p2), 1) if( xs .eq. 1 ) then c = -2 if( abs(x2 - x3) .gt. diffeps ) then c = (1 + x2/x3)/(1 - x2/x3)*(lx2 + l1x3) + & (1 + x2*x3)/(1 - x2*x3)*(lx2 + lx3) + 2 else if( abs(x2 - 1) .gt. diffeps ) then c = -2*(x2**2 + 1)/((x2 - 1)*(x2 + 1))*lx2 endif res = fac*(lm - c) else l1x2 = log(1/x2) res = fac*( .5D0*pi**2 + & lxs*(2*zfflo1(xs**2, ier) - lm) + & spence(0, xs**2, 0D0) + lx2**2 + lx3**2 - & spence(0, xs/(x2*x3), 0D0) - & (lxs + l1x2 + l1x3)*zfflo1(xs/(x2*x3), ier) - & spence(0, xs*x2/x3, 0D0) - & (lxs + lx2 + l1x3)*zfflo1(xs*x2/x3, ier) - & spence(0, xs/x2*x3, 0D0) - & (lxs + l1x2 + lx3)*zfflo1(xs/x2*x3, ier) - & spence(0, xs*x2*x3, 0D0) - & (lxs + lx2 + lx3)*zfflo1(xs*x2*x3, ier) ) endif 9 if( DEBUGLEVEL .gt. 1 ) print *, "D0soft =", res end ************************************************************************ ComplexType function bdK(x, m1, m2) * this is actually -K from the Beenakker/Denner paper for D0soft implicit none RealType x, m1, m2 #include "lt.h" RealType d ComplexType t d = x - (m1 - m2)**2 if( abs(d) .lt. diffeps ) then bdK = 1 else t = 4*m1*m2/(d + cIeps) bdK = -t/(sqrt(1 - t) + 1)**2 endif end ************************************************************************ subroutine D0coll(res, para, perm) implicit none ComplexType res RealType para(1,*) integer perm #include "lt.h" logical ini data ini /.FALSE./ if( DEBUGLEVEL .gt. 0 ) call DDump("D0coll", para,1, perm) Px(1) = max(minmass, 1D-14) if( ini ) return print *, "collinear-divergent D0, using mass cutoff ", Px(1) ini = .TRUE. end ************************************************************************ * IR-divergent D0 in dim reg * from W. Beenakker and A. Denner, NPB 338 (1990) 349 subroutine D0softDR(res, para, perm) implicit none ComplexType res(0:2) RealType para(1,*) integer perm #include "lt.h" RealType m2, m3, m4, p2, p3, t, p2p3, q2, q3 RealType r1, r3, r4, m24, sy ComplexType c, fac, xs, x2, x3, lxs, lx2, lx3, lm, y ComplexType bdK, Li2omx2, Li2omx3 external bdK, Li2omx2, Li2omx3 if( DEBUGLEVEL .gt. 0 ) call DDump("D0softDR", para,1, perm) m3 = Mx(3) t = m3 - Px(5) p2p3 = Px(6) m2 = Px(1) p2 = Px(2) q2 = m2 - p2 m4 = Px(4) p3 = Px(3) q3 = m4 - p3 r1 = sqrt(m2) r4 = sqrt(m4) fac = .5D0/(r1*r4*t) xs = bdK(p2p3, r1, r4) lxs = -1 if( xs .ne. 1 ) then lxs = log(xs) fac = 2*xs/((1 - xs)*(1 + xs))*fac endif res(1) = fac*lxs res(2) = 0 if( abs(m3) .lt. zeroeps ) then if( abs(q2) + abs(q3) .lt. diffeps ) then * qlbox14: D0(m2, m2, m4, m4; p1p2, p2p3; 0, m2, 0, m4) if( DEBUGLEVEL .gt. 1 ) print *, "D0softDR: qlbox14" res(1) = 2*res(1) res(0) = res(1)*lnrat(mudim, t) goto 9 endif * qlbox15: D0(m2, p2, p3, m4; p1p2, p2p3; 0, m2, 0, m4) * Beenakker-Denner Eq. (2.11) if( DEBUGLEVEL .gt. 1 ) print *, "D0softDR: qlbox15" if( abs(q2*q3) .lt. diffeps ) then m24 = m2 if( abs(q2) .lt. diffeps ) m24 = m4 res(0) = fac*( lxs*(lxs + log(mudim/m24) + & 2*lnrat(q2 + q3, t)) + & Li2omx2(xs, 1D0, xs, 1D0) ) goto 9 endif y = r1*q3/(r4*q2) sy = sign(.5D0, r1*q3) - sign(.5D0, r4*q2) if( xs .eq. 1 ) then res(0) = fac*( -log(mudim/(r1*r4)) + & lnrat(q2, t) + lnrat(q3, t) + 2 + & (1 + y)/(1 - y)*ln(y, sy) ) else res(0) = fac*( -.5D0*ln(y, sy)**2 + & lxs*(.5D0*lxs + lnrat(q2, t) + lnrat(q3, t) + & log(mudim/(r1*r4))) + & Li2omx2(xs, 1D0, xs, 1D0) - & Li2omx2(xs, 1D0, y, sy) - & Li2omx2(xs, 1D0, 1/y, -sy) ) endif goto 9 endif * qlbox16: D0(m2, p2, p3, m4; p1p2, p2p3; 0, m2, m3, m4) * Beenakker-Denner Eq. (2.9) if( DEBUGLEVEL .gt. 1 ) print *, "D0softDR: qlbox16" r3 = sqrt(m3) x2 = bdK(p2, r1, r3) x3 = bdK(p3, r4, r3) lx2 = log(x2) lx3 = log(x3) lm = 2*lnrat(sqrt(m3*mudim), t) if( xs .eq. 1 ) then c = -2 if( abs(x2 - x3) .gt. diffeps ) then c = (1 + x2/x3)/(1 - x2/x3)*(lx2 + log(1/x3)) + & (1 + x2*x3)/(1 - x2*x3)*(lx2 + lx3) + 2 else if( abs(x2 - 1) .gt. diffeps ) then c = -2*(x2**2 + 1)/((x2 - 1)*(x2 + 1))*lx2 endif res(0) = fac*(c - lm) else res(0) = fac*(lm*lxs - lx2**2 - lx3**2 + & Li2omx2(xs, 1D0, xs, 1D0) - & Li2omx3(xs, 1D0, x2, 1D0, x3, 1D0) - & Li2omx3(xs, 1D0, 1/x2, -1D0, 1/x3, -1D0) - & Li2omx3(xs, 1D0, x2, 1D0, 1/x3, -1D0) - & Li2omx3(xs, 1D0, 1/x2, -1D0, x3, 1D0)) endif 9 if( DEBUGLEVEL .gt. 1 ) then print *, "D0softDR:0 =", res(0) print *, "D0softDR:1 =", res(1) print *, "D0softDR:2 =", res(2) endif end ************************************************************************ subroutine D0collDR(res, para, perm_) implicit none ComplexType res(0:2) RealType para(1,*) integer perm_ #include "lt.h" #include "perm.h" integer perm, z, s * # of non-zero momenta integer nz1, nz2, nz3 parameter (nz1 = 1073741824) ! O'10000000000' parameter (nz2 = -2147483648) ! O'20000000000' parameter (nz3 = -1073741824) ! O'30000000000' integer nz1p1234, nz2p1234, nz3p1234 parameter (nz1p1234 = nz1 + p1234) parameter (nz2p1234 = nz2 + p1234) parameter (nz3p1234 = nz3 + p1234) integer nz1p1243, nz2p1243, nz3p1243 parameter (nz1p1243 = nz1 + p1243) parameter (nz2p1243 = nz2 + p1243) parameter (nz3p1243 = nz3 + p1243) integer nz1p2134, nz2p2134, nz3p2134 parameter (nz1p2134 = nz1 + p2134) parameter (nz2p2134 = nz2 + p2134) parameter (nz3p2134 = nz3 + p2134) integer nz1p2143, nz2p2143, nz3p2143 parameter (nz1p2143 = nz1 + p2143) parameter (nz2p2143 = nz2 + p2143) parameter (nz3p2143 = nz3 + p2143) integer nz1p3214, nz2p3214, nz3p3214 parameter (nz1p3214 = nz1 + p3214) parameter (nz2p3214 = nz2 + p3214) parameter (nz3p3214 = nz3 + p3214) integer nz1p4213, nz2p4213, nz3p4213 parameter (nz1p4213 = nz1 + p4213) parameter (nz2p4213 = nz2 + p4213) parameter (nz3p4213 = nz3 + p4213) integer pperm(0:127) data pperm / * 1ppppp12mm 0ppp 1 * 3m 0ppp 1 * m4 0ppp 1432652143 * 34 0ppp 1 & nz3p1234, nz3p1234, nz3p2143, nz3p1234, * 12pppp12mm 0ppp 1 * 3m 00pp 1 * m4 0ppp 1432652143 * 34 00pp 1 & nz3p1234, nz2p1234, nz3p2143, nz2p1234, * 1p3ppp12mm 0ppp 1 * 3m 0ppp 1 * m4 0ppp 1432652143 * 34 0p0p 1 & nz3p1234, nz3p1234, nz3p2143, nz2p1234, * 123ppp12mm 0ppp 1 * 3m 00pp 1 * m4 0ppp 1432652143 * 34 000p 1 & nz3p1234, nz2p1234, nz3p2143, nz1p1234, * 1pp4pp12mm 0ppp 1 * 3m 0ppp 1 * m4 00pp 1432652143 * 34 00pp 1432652143 & nz3p1234, nz3p1234, nz2p2143, nz2p2143, * 12p4pp12mm 0ppp 1 * 3m 00pp 1 * m4 00pp 1432652143 * 34 000p 2143563214 & nz3p1234, nz2p1234, nz2p2143, nz1p3214, * 1p34pp12mm 0ppp 1 * 3m 0ppp 1 * m4 00pp 1432652143 * 34 000p 1432652143 & nz3p1234, nz3p1234, nz2p2143, nz1p2143, * 1234pp12mm 0ppp 1 * 3m 00pp 1 * m4 00pp 1432652143 * 34 0000 1 & nz3p1234, nz2p1234, nz2p2143, p1234, * 1ppp5p12mm 0ppp 1 * 3m 00pp 1536242134 * m4 0ppp 1432652143 * 34 00pp 1536242134 & nz3p1234, nz2p2134, nz3p2143, nz2p2134, * 12pp5p12mm 0ppp 1 * 3m 00pp 1 * m4 0ppp 1432652143 * 34 00pp 1 & nz3p1234, nz2p1234, nz3p2143, nz2p1234, * 1p3p5p12mm 0ppp 1 * 3m 00pp 1536242134 * m4 0ppp 1432652143 * 34 000p 1536242134 & nz3p1234, nz2p2134, nz3p2143, nz1p2134, * 123p5p12mm 0ppp 1 * 3m 00pp 1536242134 * m4 0ppp 1432652143 * 34 000p 1 & nz3p1234, nz2p2134, nz3p2143, nz1p1234, * 1pp45p12mm 0ppp 1 * 3m 00pp 1536242134 * m4 00pp 1432652143 * 34 00pp 1432652143 & nz3p1234, nz2p2134, nz2p2143, nz2p2143, * 12p45p12mm 0ppp 1 * 3m 00pp 1 * m4 00pp 1432652143 * 34 000p 2143563214 & nz3p1234, nz2p1234, nz2p2143, nz1p3214, * 1p345p12mm 0ppp 1 * 3m 00pp 1536242134 * m4 00pp 1432652143 * 34 000p 1432652143 & nz3p1234, nz2p2134, nz2p2143, nz1p2143, * 12345p12mm 0ppp 1 * 3m 00pp 1 * m4 00pp 1432652143 * 34 0000 1 & nz3p1234, nz2p1234, nz2p2143, p1234, * 1pppp612mm 0ppp 1 * 3m 0ppp 1 * m4 00pp 1635421243 * 34 00pp 1635421243 & nz3p1234, nz3p1234, nz2p1243, nz2p1243, * 12ppp612mm 0ppp 1 * 3m 00pp 1 * m4 00pp 1635421243 * 34 00pp 1 & nz3p1234, nz2p1234, nz2p1243, nz2p1234, * 1p3pp612mm 0ppp 1 * 3m 0ppp 1 * m4 00pp 1635421243 * 34 000p 1635421243 & nz3p1234, nz3p1234, nz2p1243, nz1p1243, * 123pp612mm 0ppp 1 * 3m 00pp 1 * m4 00pp 1635421243 * 34 000p 1 & nz3p1234, nz2p1234, nz2p1243, nz1p1234, * 1pp4p612mm 0ppp 1 * 3m 0ppp 1 * m4 00pp 1635421243 * 34 00pp 1432652143 & nz3p1234, nz3p1234, nz2p1243, nz2p2143, * 12p4p612mm 0ppp 1 * 3m 00pp 1 * m4 00pp 1635421243 * 34 000p 2143563214 & nz3p1234, nz2p1234, nz2p1243, nz1p3214, * 1p34p612mm 0ppp 1 * 3m 0ppp 1 * m4 00pp 1635421243 * 34 000p 1432652143 & nz3p1234, nz3p1234, nz2p1243, nz1p2143, * 1234p612mm 0ppp 1 * 3m 00pp 1 * m4 00pp 1635421243 * 34 0000 1 & nz3p1234, nz2p1234, nz2p1243, p1234, * 1ppp5612mm 0ppp 1 * 3m 00pp 1536242134 * m4 00pp 1635421243 * 34 000p 6153424213 & nz3p1234, nz2p2134, nz2p1243, nz1p4213, * 12pp5612mm 0ppp 1 * 3m 00pp 1 * m4 00pp 1635421243 * 34 000p 6153424213 & nz3p1234, nz2p1234, nz2p1243, nz1p4213, * 1p3p5612mm 0ppp 1 * 3m 00pp 1536242134 * m4 00pp 1635421243 * 34 0000 6153424213 & nz3p1234, nz2p2134, nz2p1243, p4213, * 123p5612mm 0ppp 1 * 3m 00pp 1 * m4 00pp 1635421243 * 34 0000 6153424213 & nz3p1234, nz2p1234, nz2p1243, p4213, * 1pp45612mm 0ppp 1 * 3m 00pp 1536242134 * m4 00pp 1635421243 * 34 000p 6153424213 & nz3p1234, nz2p2134, nz2p1243, nz1p4213, * 12p45612mm 0ppp 1 * 3m 00pp 1 * m4 00pp 1635421243 * 34 0000 6254314231 & nz3p1234, nz2p1234, nz2p1243, p4231, * 1p345612mm 0ppp 1 * 3m 00pp 1536242134 * m4 00pp 1635421243 * 34 0000 6153424213 & nz3p1234, nz2p2134, nz2p1243, p4213, * 12345612mm 0ppp 1 * 3m 00pp 1 * m4 00pp 1635421243 * 34 0000 1 & nz3p1234, nz2p1234, nz2p1243, p1234 / if( DEBUGLEVEL .gt. 0 ) call DDump("D0collDR", para,1, perm) perm = perm_ perm_ = 0 z = 0 if( abs(Mx(3)) .lt. zeroeps ) z = 1 if( abs(Mx(4)) .lt. zeroeps ) z = z + 2 if( abs(Px(2)) .lt. zeroeps ) z = z + 4 if( abs(Px(3)) .lt. zeroeps ) z = z + 8 if( abs(Px(4)) .lt. zeroeps ) z = z + 16 if( abs(Px(5)) .lt. zeroeps ) z = z + 32 if( abs(Px(6)) .lt. zeroeps ) z = z + 64 s = pperm(z) if( iand(s, O'7777777777') .ne. p1234 ) perm = & pj(perm, pj(s, 1))*8**9 + & pj(perm, pj(s, 2))*8**8 + & pj(perm, pj(s, 3))*8**7 + & pj(perm, pj(s, 4))*8**6 + & pj(perm, pj(s, 5))*8**5 + & pj(perm, pj(s, 6))*8**4 + & mj(perm, mj(s, 1))*8**3 + & mj(perm, mj(s, 2))*8**2 + & mj(perm, mj(s, 3))*8**1 + & mj(perm, mj(s, 4))*8**0 goto (22,22,22,23, 22,22,22,23, 10,11,12,13) & ibits(s, 30, 2) + ibits(z, 0, 2)*4 - 3 call D0m2p3(res, para, perm) return 23 call D0m1p3(res, para, perm) return 22 call D0m1p2(res, para, perm) return 13 call D0m0p3(res, para,1, perm) return 12 call D0m0p2(res, para,1, perm) return 11 call D0m0p1(res, para,1, perm) return 10 call D0m0p0(res, para,1, perm) end ************************************************************************ * qlbox1: D0(0, 0, 0, 0; p1p2, p2p3; 0, 0, 0, 0) * Bern, Dixon, Kosower, NPB 412 (1994) 751 [hep-ph/9306240], Eq. (I.11) subroutine D0m0p0(res, para,ldpara, perm) implicit none ComplexType res(0:2) integer ldpara, perm RealType para(1,*) #include "lt.h" RealType s, t, fac ComplexType lsm, ltm, lts if( DEBUGLEVEL .gt. 0 ) & call DDump("D0m0p0: qlbox1", para,ldpara, perm) s = -Px(5) t = -Px(6) fac = 1/(s*t) lsm = lnrat(s, mudim) ltm = lnrat(t, mudim) lts = lnrat(t, s) res(0) = fac*((ltm - pi)*(ltm + pi) - (lts - lsm)*(lts + lsm)) res(1) = -2*fac*(lsm + ltm) res(2) = 4*fac if( DEBUGLEVEL .gt. 1 ) then print *, "D0m0p0:0 =", res(0) print *, "D0m0p0:1 =", res(1) print *, "D0m0p0:2 =", res(2) endif end ************************************************************************ * qlbox2: D0(0, 0, 0, p4; p1p2, p2p3; 0, 0, 0, 0) * One-mass integral as given in * Ellis, Giele, Zanderighi, Eq. (A22). subroutine D0m0p1(res, para,ldpara, perm) implicit none ComplexType res(0:2) integer ldpara, perm RealType para(ldpara,*) #include "lt.h" RealType s, t, m4, fac ComplexType ls, lt, l4, l1, l2 ComplexType Li2omrat external Li2omrat if( DEBUGLEVEL .gt. 0 ) & call DDump("D0m0p1: qlbox2", para,ldpara, perm) s = -Px(5) t = -Px(6) m4 = -Px(4) fac = 1/(s*t) ls = lnrat(s, mudim) lt = lnrat(t, mudim) l4 = lnrat(m4, mudim) l1 = sqrt(lt**2 + ls**2 + lnrat(m4, s)**2 + lnrat(m4, t)**2) l2 = sqrt(l4**2 + lnrat(t, s)**2) res(0) = fac*((l1 - l2)*(l1 + l2) + & 2*(Li2omrat(t, m4) + Li2omrat(s, m4) - pi6)) res(1) = 2*fac*(l4 - lt - ls) res(2) = 2*fac if( DEBUGLEVEL .gt. 1 ) then print *, "D0m0p1:0 =", res(0) print *, "D0m0p1:1 =", res(1) print *, "D0m0p1:2 =", res(2) endif end ************************************************************************ subroutine D0m0p2(res, para,ldpara, perm) implicit none ComplexType res(0:2) integer ldpara, perm RealType para(ldpara,*) #include "lt.h" RealType s, t, q2, q3, q4, fac, r ComplexType ls, lt, lq2, lq3, lq4, lsq3 ComplexType lndiv0, lndiv1, Li2omrat, Li2omrat2 external lndiv0, lndiv1, Li2omrat, Li2omrat2 if( DEBUGLEVEL .gt. 0 ) call DDump("D0m0p2", para,ldpara, perm) s = -Px(5) t = -Px(6) fac = 1/(s*t) q4 = -Px(4) q3 = -Px(3) if( abs(q3) .lt. zeroeps ) then * qlbox3: D0(0, p2, 0, p4; p1p2, p2p3; 0, 0, 0, 0) * Bern, Dixon, Kosower, NPB 412 (1994) 751 [hep-ph/9306240], Eq. (I.13) if( DEBUGLEVEL .gt. 1 ) print *, "D0m0p2: qlbox3" q2 = -Px(2) r = 1 - q2*q4*fac * Use expansion only in cases where signs (s,t,m2,m4) are not * ++-- or --++ if( abs(r) .lt. 1D-6 .and. & (fac .lt. 0 .or. q2*q4 .lt. 0) ) then * expanded case res(0) = fac*(2 - .5D0*r + & (2 + r)*(lnrat(s, mudim) + lnrat(t, q4)) + & 2*(lndiv0(q4, t) + lndiv0(q4, s)) + & r*(lndiv1(q4, t) + lndiv1(q4, s))) res(1) = -(2 + r)*fac res(2) = 0 else * general case fac = 1/(s*t - q2*q4) ls = lnrat(s, mudim) lt = lnrat(t, mudim) lq2 = lnrat(q2, mudim) lq4 = lnrat(q4, mudim) res(0) = fac*( & (ls - lq2)*(ls + lq2) + & (lt - lq4)*(lt + lq4) - lnrat(s, t)**2 + & 2*(Li2omrat2(q2, s, q4, t) - & Li2omrat(q2, s) - Li2omrat(q2, t) - & Li2omrat(q4, s) - Li2omrat(q4, t)) ) res(1) = 2*fac*(lnrat(q2, s) + lnrat(q4, t)) res(2) = 0 endif else * qlbox4: D0(0, 0, p3, p4; p1p2, p2p3; 0, 0, 0, 0) * Bern, Dixon, Kosower, NPB 412 (1994) 751 [hep-ph/9306240], Eq. (I.14) if( DEBUGLEVEL .gt. 1 ) print *, "D0m0p2: qlbox4" ls = lnrat(s, mudim) lt = lnrat(t, mudim) lq3 = lnrat(q3, mudim) lq4 = lnrat(q4, mudim) lsq3 = lnrat(s, q3) res(0) = fac*( & .5D0*((ls - lq3)*(ls + lq3) + & (lt - lq4)*(lt + lq4) + lt**2) + & lsq3*lnrat(s, q4) - lnrat(s, t)**2 - & 2*(Li2omrat(q3, t) + Li2omrat(q4, t)) ) res(1) = -fac*(lsq3 + lnrat(t, q4) + lt) res(2) = fac endif if( DEBUGLEVEL .gt. 1 ) then print *, "D0m0p2:0 =", res(0) print *, "D0m0p2:1 =", res(1) print *, "D0m0p2:2 =", res(2) endif end ************************************************************************ * qlbox5: D0(0, p2, p3, p4; p1p2, p2p3; 0, 0, 0, 0) * Bern, Dixon, Kosower, NPB 412 (1994) 751 [hep-ph/9306240], Eq. (I.15) * or from hep-ph/0508308v3 Eq. (A27) * (v3 corrects previous versions) subroutine D0m0p3(res, para,ldpara, perm) implicit none ComplexType res(0:2) integer ldpara, perm RealType para(ldpara,*) #include "lt.h" RealType s, t, q2, q3, q4, fac, r ComplexType l2, l4 ComplexType lndiv0, lndiv1, Li2omrat, Li2omrat2 external lndiv0, lndiv1, Li2omrat, Li2omrat2 if( DEBUGLEVEL .gt. 1 ) & call DDump("D0m0p3: qlbox5", para,ldpara, perm) s = -Px(5) t = -Px(6) fac = 1/(s*t) q2 = -Px(2) q3 = -Px(3) q4 = -Px(4) r = 1 - q2*q4*fac * Use expansion only in cases where signs of (s,t,q2,q4) are * not ++-- or --++ if( abs(r) .lt. 1D-6 .and. & (fac .lt. 0 .or. q2*q4 .lt. 0) ) then * expanded case l4 = lndiv0(q4, t) res(0) = fac*( & .5D0*(2 + r)*(2 + (1 + q4/t)*l4 - & lnrat(mudim, s) - lnrat(q3, t)) + & r*(lndiv1(q4, t) - l4 - 1) ) res(1) = -.5D0*(2 + r)*fac res(2) = 0 else * general case fac = 1/(s*t - q2*q4) l2 = lnrat(q2, t) l4 = lnrat(q4, s) res(0) = fac*( & (lnrat(q3, t) + lnrat(mudim, t))*l2 + & (lnrat(q3, s) + lnrat(mudim, s))*l4 - & .5D0*(lnrat(t, q2)**2 + lnrat(s, q4)**2) - & lnrat(s, t)**2 - & 2*(Li2omrat(q2, s) + Li2omrat(q4, t) - & Li2omrat2(q2, s, q4, t)) ) res(1) = fac*(l2 + l4) res(2) = 0 endif if( DEBUGLEVEL .gt. 1 ) then print *, "D0m0p3:0 =", res(0) print *, "D0m0p3:1 =", res(1) print *, "D0m0p3:2 =", res(2) endif end ************************************************************************ subroutine D0m1p2(res, para, perm) implicit none ComplexType res(0:2) RealType para(1,*) integer perm #include "lt.h" RealType m4, s, t, q3, q4, fac ComplexType lm, ls, lt, lq integer ir ComplexType Li2omrat, Li2omrat2 external Li2omrat, Li2omrat2 if( DEBUGLEVEL .gt. 1 ) call DDump("D0m1p2", para,1, perm) m4 = Mx(4) s = -Px(5) t = m4 - Px(6) fac = 1/(s*t) q3 = m4 - Px(3) q4 = m4 - Px(4) ir = 0 if( abs(q3) .lt. diffeps ) ir = 1 if( abs(q4) .lt. diffeps ) then ir = ir + 1 q4 = q3 endif res(2) = .5D0*(2 + ir)*fac goto (1, 2) ir * qlbox8: D0(0, 0, p3, p4; p1p2, p2p3; 0, 0, 0, m4) if( DEBUGLEVEL .gt. 1 ) print *, "D0m1p2: qlbox8" lm = lnrat(s, mudim) ls = lnrat(s, m4) res(0) = fac*(-2*(Li2omrat(q3, t) + Li2omrat(q4, t)) - & Li2omrat2(q3, s, q4, m4) - pi6 + & .5D0*(lm - ls)*(lm + ls) + 2*lm*lnrat(t, m4) - & lnrat(q3, mudim)*lnrat(q3, m4) - & lnrat(q4, mudim)*lnrat(q4, m4)) res(1) = fac*(lnrat(q3, t) + lnrat(q4, t) - lm) goto 9 1 continue * qlbox7: D0(0, 0, m4, p4; p1p2, p2p3; 0, 0, 0, m4) if( DEBUGLEVEL .gt. 1 ) print *, "D0m1p2: qlbox7" ls = lnrat(s, m4) lt = lnrat(t, m4) lm = lnrat(mudim, m4) lq = lnrat(q4, m4) res(0) = fac*(2*ls*lt - lq**2 - 5*pi12 + & lm*(.75D0*lm - 2*lt - ls + lq) - & 2*Li2omrat(q4, t)) res(1) = fac*(1.5D0*lm - 2*lt - ls + lq) goto 9 2 continue * qlbox6: D0(0, 0, m4, m4; p1p2, p2p3; 0, 0, 0, m4) if( DEBUGLEVEL .gt. 1 ) print *, "D0m1p2: qlbox6" ls = lnrat(s, m4) lt = lnrat(t, m4) lm = lnrat(mudim, m4) res(0) = fac*((lm - ls)*(lm - 2*lt) - .5D0*pi**2) res(1) = fac*(2*(lm - lt) - ls) 9 if( DEBUGLEVEL .gt. 1 ) then print *, "D0m1p2:0 =", res(0) print *, "D0m1p2:1 =", res(1) print *, "D0m1p2:2 =", res(2) endif end ************************************************************************ subroutine D0m1p3(res, para, perm) implicit none ComplexType res(0:2) RealType para(1,*) integer perm #include "lt.h" RealType s, t, m4, q2, q3, q4, m4mu, fac ComplexType ll ComplexType Li2omrat, Li2omrat2 external Li2omrat, Li2omrat2 if( DEBUGLEVEL .gt. 1 ) call DDump("D0m1p3", para,1, perm) q2 = -Px(2) s = -Px(5) m4 = Mx(4) q3 = m4 - Px(3) q4 = m4 - Px(4) t = m4 - Px(6) if( abs(t) .lt. diffeps ) then t = q4 q4 = 0 s = q2 q2 = -Px(5) endif m4mu = sqrt(m4*mudim) * qlbox9: D0(0, p2, p3, m4; p1p2, p2p3; 0, 0, 0, m4) if( abs(q4) .lt. diffeps ) then if( DEBUGLEVEL .gt. 1 ) print *, "D0m1p3: qlbox9" fac = 1/(s*t) ll = lnrat(t, m4mu) + lnrat(s, q2) res(0) = fac*(Li2omrat2(q3, q2, t, m4) + & 2*Li2omrat(s, q2) + ll**2 + pi12) res(1) = -fac*ll res(2) = .5D0*fac else * qlbox10: D0(0, p2, p3, p4; p1p2, p2p3; 0, 0, 0, m4) if( DEBUGLEVEL .gt. 1 ) print *, "D0m1p3: qlbox10" fac = 1/(s*t - q2*q4) ll = lnrat(q2, mudim) + lnrat(q4, mudim) - & lnrat(s, mudim) - lnrat(t, mudim) res(0) = fac*( & 2*ll*lnrat(m4mu, t) + & Li2omrat2(q3, q2, t, m4) - & Li2omrat2(q3, s, q4, m4) + & 2*(Li2omrat2(q2, s, q4, t) - & Li2omrat(q2, s) + Li2omrat(t, q4)) ) res(1) = fac*ll res(2) = 0 endif if( DEBUGLEVEL .gt. 1 ) then print *, "D0m1p3:0 =", res(0) print *, "D0m1p3:1 =", res(1) print *, "D0m1p3:2 =", res(2) endif end ************************************************************************ subroutine D0m2p3(res, para, perm) implicit none ComplexType res(0:2) RealType para(1,*) integer perm #include "lt.h" RealType s, t, m3, m4, q3, q4, p3, fac, m3mu RealType p34, c, s3t, s4s, tmp ComplexType ls, lt, lq3, lq4, d ComplexType x43(4), r3t, r4s, r43p, r43m ComplexType logs, dilogs integer ir, case ComplexType Li2rat, Li2omrat, Li2omrat2 external Li2rat, Li2omrat, Li2omrat2 if( DEBUGLEVEL .gt. 1 ) call DDump("D0m2p3", para,1, perm) m3 = Mx(3) s = m3 - Px(5) q3 = m3 - Px(2) m4 = Mx(4) t = m4 - Px(6) q4 = m4 - Px(4) if( abs(s) .lt. diffeps .or. abs(t) .lt. diffeps ) then * switch from p1234 to p2134 = 1536242134 tmp = s s = q3 q3 = tmp tmp = t t = q4 q4 = tmp endif fac = 1/(s*t - q3*q4) ir = 0 if( abs(q3) .lt. diffeps ) ir = 1 if( abs(q4) .lt. diffeps ) then ir = ir + 1 q4 = q3 tmp = s s = t t = tmp m4 = m3 m3 = Mx(4) endif res(2) = .5D0*fac*ir p3 = Px(3) if( abs(p3) .lt. zeroeps ) then case = 1 logs = lnrat(m3, m4)**2 else p34 = p3 + m3 - m4 c = -4*p3*m3 d = sqrt(ToComplex(p34**2 + c)) x43(1) = -p34 - d x43(2) = p34 - d if( abs(x43(1)) .lt. abs(x43(2)) ) then x43(1) = c/x43(2) else x43(2) = c/x43(1) endif p34 = -p3 + m3 - m4 c = -4*p3*m4 x43(3) = -p34 - d x43(4) = p34 - d if( abs(x43(3)) .lt. abs(x43(4)) ) then x43(3) = c/x43(4) else x43(4) = c/x43(3) endif if( abs(Im(d)) .lt. zeroeps ) then case = 2 logs = lnrat(x43(1), x43(3))**2 + & lnrat(x43(2), x43(4))**2 else case = 3 r43p = x43(1)/x43(3) r43m = x43(2)/x43(4) logs = ln(r43p, 0)**2 + ln(r43m, 0)**2 endif endif goto (1, 2) ir * qlbox13: D0(0, p2, p3, p4; p1p2, p2p3; 0, 0, m3, m4) if( DEBUGLEVEL .gt. 1 ) print *, "D0m2p3: qlbox13" ls = lnrat(s, mudim) lt = lnrat(t, mudim) lq3 = lnrat(q3, mudim) lq4 = lnrat(q4, mudim) if( case .eq. 1 ) then dilogs = Li2omrat2(q3, t, -1D0, -1D0) + & Li2omrat2(q3, t, m4, m3) + & Li2omrat2(q4, s, m3, m4) + & Li2omrat2(q4, s, -1D0, -1D0) else if( case .eq. 2 ) then dilogs = Li2omrat2(q3, t, Re(x43(4)), Re(x43(2))) + & Li2omrat2(q3, t, Re(x43(3)), Re(x43(1))) + & Li2omrat2(q4, s, Re(x43(1)), Re(x43(3))) + & Li2omrat2(q4, s, Re(x43(2)), Re(x43(4))) else r3t = q3/t s3t = sign(.5D0, q3) - sign(.5D0, t) r4s = q4/s s4s = sign(.5D0, q4) - sign(.5D0, s) dilogs = Li2rat(r3t,s3t, 1/r43m,0D0) + & Li2rat(r3t,s3t, 1/r43p,0D0) + & Li2rat(r4s,s4s, r43p,0D0) + & Li2rat(r4s,s4s, r43m,0D0) endif res(0) = -fac*(dilogs + .5D0*logs + lq3**2 + lq4**2 + & 2*(Li2omrat(q3, s) + Li2omrat(q4, t) - & Li2omrat2(q3, s, q4, t) - ls*lt) + & (lt - lq3)*log(m3/mudim) + (ls - lq4)*log(m4/mudim)) res(1) = fac*(lq3 + lq4 - ls - lt) goto 9 1 continue * qlbox12: D0(0, m3, p3, p4; p1p2, p2p3; 0, 0, m3, m4) if( DEBUGLEVEL .gt. 1 ) print *, "D0m2p3: qlbox12" m3mu = sqrt(m3*mudim) ls = lnrat(s, m3mu) lt = lnrat(t, m3mu) lq4 = lnrat(q4, m3mu) if( case .eq. 1 ) then dilogs = Li2omrat2(q4, s, m3, m4) + & Li2omrat2(q4, s, -1D0, -1D0) else if( case .eq. 2 ) then dilogs = Li2omrat2(q4, s, Re(x43(1)), Re(x43(3))) + & Li2omrat2(q4, s, Re(x43(2)), Re(x43(4))) else r4s = q4/s s4s = sign(.5D0, q4) - sign(.5D0, s) dilogs = Li2rat(r4s,s4s, r43p,0D0) + & Li2rat(r4s,s4s, r43m,0D0) endif res(0) = -fac*(dilogs + .5D0*logs + pi12 + & 2*(Li2omrat(q4, t) - ls*lt) + & lq4**2 + (ls - lq4)*log(m4/m3)) res(1) = fac*(lq4 - ls - lt) goto 9 2 continue * qlbox11: D0(0, m3, p3, m4; p1p2, p2p3; 0, 0, m3, m4) * qlbox11a: D0(0, p2, p3, p4; m3, m4; 0, 0, m3, m4) if( DEBUGLEVEL .gt. 1 ) print *, "D0m2p3: qlbox11" ls = lnrat(s, sqrt(m3*mudim)) lt = lnrat(t, sqrt(m4*mudim)) res(0) = fac*(.25D0*log(m3/m4)**2 - & .5D0*(logs + pi**2) + 2*ls*lt) res(1) = -fac*(ls + lt) 9 if( DEBUGLEVEL .gt. 1 ) then print *, "D0m2p3:0 =", res(0) print *, "D0m2p3:1 =", res(1) print *, "D0m2p3:2 =", res(2) endif end ************************************************************************ * this routine is adapted from Ansgar Denner's bcanew.f * to the conventions of LoopTools; * it is used for double-checking the results of FF * M. Rauch: implemented the log branch cuts for k13 < 2 * (from Denner, Nierste, Scharf; Nucl Phys B367 (1991) 637) cc#define AddEps(k) k*ToComplex(1D0, -sign(eps, k)) c#define AddEps(k) k*(1 - sign(1D0, k)*cIeps) #define AddEps(k) (k - max(abs(k), 1D0)*cIeps) c#define k2r(k) (.5D0*k*(1 + sqrt(ToComplex((1 - 2/k)*(1 + 2/k))))) #define k2r(k) (.5D0*(k + sign(1D0, Re(k))*sqrt(ToComplex((k - 2)*(k + 2))))) subroutine D0m4(res, para) implicit none ComplexType res RealType para(1,*) #include "lt.h" #include "perm.h" RealType tmp, ir1324, gamma, s1, s2 RealType kij(6), irij(6), ix(2,4) ComplexType rij(6), x(2,4), l(2,4), q13, q24 ComplexType a, b, c, d, disc, ki, etas integer j, try RealType k12, k13, k14, k23, k24, k34 RealType ir12, ir13, ir14, ir23, ir24, ir34 ComplexType r12, r14, r13, r23, r24, r34 equivalence (kij(1), k12), (rij(1), r12), (irij(1), ir12) equivalence (kij(2), k23), (rij(2), r23), (irij(2), ir23) equivalence (kij(3), k34), (rij(3), r34), (irij(3), ir34) equivalence (kij(4), k14), (rij(4), r14), (irij(4), ir14) equivalence (kij(5), k13), (rij(5), r13), (irij(5), ir13) equivalence (kij(6), k24), (rij(6), r24), (irij(6), ir24) ComplexType xspence, xeta, xetatilde integer eta external xspence, xeta, xetatilde, eta if( DEBUGLEVEL .gt. 0 ) call DDump("D0m4", para,1, p1234) k12 = (M(1) + M(2) - P(1))/sqrt(M(1)*M(2)) k23 = (M(2) + M(3) - P(2))/sqrt(M(2)*M(3)) k34 = (M(3) + M(4) - P(3))/sqrt(M(3)*M(4)) k14 = (M(1) + M(4) - P(4))/sqrt(M(1)*M(4)) k13 = (M(1) + M(3) - P(5))/sqrt(M(1)*M(3)) k24 = (M(2) + M(4) - P(6))/sqrt(M(2)*M(4)) * test if r_13 can be made real by a permutation * if one of the r_ij is real r_13 must be made real => case 1 if( abs(k13) .ge. 2 ) then * nothing to do * otherwise try all permutations else if( abs(k12) .ge. 2 ) then * 2 <-> 3 tmp = k12 k12 = k13 k13 = tmp tmp = k24 k24 = k34 k34 = tmp else if( abs(k14) .ge. 2 ) then * 3 <-> 4 tmp = k13 k13 = k14 k14 = tmp tmp = k23 k23 = k24 k24 = tmp else if( abs(k23) .ge. 2 ) then * 1 <-> 2 tmp = k13 k13 = k23 k23 = tmp tmp = k14 k14 = k24 k24 = tmp else if( abs(k24) .ge. 2 ) then * 1 -> 4, 2 -> 1, 3 -> 2, 4 -> 3 tmp = k12 k12 = k23 k23 = k34 k34 = k14 k14 = tmp tmp = k13 k13 = k24 k24 = tmp else if( abs(k34) .ge. 2 ) then * 1 <-> 4 tmp = k12 k12 = k24 k24 = tmp tmp = k13 k13 = k34 k34 = tmp * else * nothing found => all r_ij on the complex unit circle => case 2 endif r12 = k2r(k12) r23 = k2r(k23) r34 = k2r(k34) r14 = k2r(k14) r13 = 1/k2r(k13) do try = 1, 10 r24 = 1/k2r(k24) do j = 1, 6 if( Im(rij(j)) .eq. 0 ) then ki = kij(j) - cIeps irij(j) = sign(1D0, abs(rij(j)) - 1)* & Im(k2r(ki)) else irij(j) = 0 endif enddo ir1324 = sign(1D0, Re(r24))*ir13 - & sign(1D0, Re(r13))*ir24 a = k34/r24 - k23 + (k12 - k14/r24)*r13 b = (1/r13 - r13)*(1/r24 - r24) + k12*k34 - k14*k23 c = k34*r24 - k23 + (k12 - k14*r24)/r13 d = k23 + (r24*k14 - k12)*r13 - r24*k34 disc = sqrt(b**2 - 4*a*(c + d*cIeps)) ix(1,4) = Im(.5D0/a*(b - disc)) ix(2,4) = Im(.5D0/a*(b + disc)) disc = sqrt(b**2 - 4*a*c) if( abs(disc) .gt. diffeps ) exit k24 = k24 - diffeps enddo x(1,4) = .5D0/a*(b - disc) x(2,4) = .5D0/a*(b + disc) if( abs(x(1,4)) .gt. abs(x(2,4)) ) then x(2,4) = c/(a*x(1,4)) else x(1,4) = c/(a*x(2,4)) endif x(1,1) = x(1,4)/r24 x(2,1) = x(2,4)/r24 x(1,2) = x(1,4)*r13/r24 x(2,2) = x(2,4)*r13/r24 x(1,3) = x(1,4)*r13 x(2,3) = x(2,4)*r13 s1 = sign(1D0, Re(x(1,4))) s2 = sign(1D0, Re(x(2,4))) ix(1,1) = ix(1,4)*Re(x(1,1))*s1 ix(2,1) = ix(2,4)*Re(x(2,1))*s2 ix(1,2) = ix(1,4)*Re(x(1,2))*s1 ix(2,2) = ix(2,4)*Re(x(2,2))*s2 ix(1,3) = ix(1,4)*Re(x(1,3))*s1 ix(2,3) = ix(2,4)*Re(x(2,3))*s2 res = 0 do j = 1, 4 res = res + Sgn(j)*( & xspence(x(1,j), ix(1,j), rij(j), irij(j)) + & xspence(x(1,j), ix(1,j), 1/rij(j), -irij(j)) ) enddo gamma = sign(1D0, Re(a*(x(2,4) - x(1,4)))) l(1,4) = c2ipi*eta(r13, ir13, 1/r24, -ir24, ir1324) l(2,4) = l(1,4) if( Im(r13) .eq. 0 ) then r12 = k12 - r24*k14 r23 = k23 - r24*k34 r34 = k34 - r13*k14 r14 = k23 - r13*k12 q13 = k13 - 2*r13 q24 = k24 - 2*r24 c = gamma*sign(1D0, Im(r24) + ir24) l(1,1) = ln(-x(1,1), -ix(1,1)) + & ln(r14 - q13/x(1,1), -1) + & ln((r12 - q24*x(1,4))/d, c) l(2,1) = ln(-x(2,1), -ix(2,1)) + & ln(r14 - q13/x(2,1), -1) + & ln((r12 - q24*x(2,4))/d, -c) c = gamma*sign(1D0, Re(r13)*(Im(r24) + ir24)) l(1,2) = ln(-x(1,2), -ix(1,2)) + & ln(r14 - q13/x(1,1), -1) + & ln((r23 - q24*x(1,3))/d, c) l(2,2) = ln(-x(2,2), -ix(2,2)) + & ln(r14 - q13/x(2,1), -1) + & ln((r23 - q24*x(2,3))/d, -c) l(1,3) = ln(-x(1,3), -ix(1,3)) + & ln(r34 - q13/x(1,4), -1) + & ln((r23 - q24*x(1,3))/d, c) l(2,3) = ln(-x(2,3), -ix(2,3)) + & ln(r34 - q13/x(2,4), -1) + & ln((r23 - q24*x(2,3))/d, -c) etas = & xetatilde(x(1,4), ix(1,4), r13, ir13, l(1,3)) + & xetatilde(x(1,4), ix(1,4), 1/r24, -ir24, l(1,1)) - & xetatilde(x(1,4), ix(1,4), r13/r24, ir1324, l(1,2)) + & xetatilde(x(1,4), ix(1,4), -r13/r24, -ir1324, l(1,4)) else do j = 1, 3 l(1,j) = log(-x(1,j)) + & ln(kij(j) - 1/x(1,j) - x(1,j), -x(1,j)*b*gamma) l(2,j) = log(-x(2,j)) + & ln(kij(j) - 1/x(2,j) - x(2,j), -x(2,j)*b*gamma) enddo etas = & xeta(x(1,4), ix(1,4), r13, ir13, ix(1,3), l(1,3)) + & xeta(x(1,4), ix(1,4), 1/r24, -ir24, ix(1,1), l(1,1)) - & xeta(x(1,4), ix(1,4), r13/r24, ir1324, ix(1,2), l(1,2)) + & xeta(x(1,4), ix(1,4), -r13/r24, -ir1324, ix(1,4), l(1,4))* & (1 - sign(1D0, Re(b))*gamma) endif res = (res - c2ipi*etas + (l(2,2) - l(1,2))*l(1,4))/ & (sqrt(M(1)*M(2)*M(3)*M(4))*disc) if( DEBUGLEVEL .gt. 1 ) print *, "D0m4 =", res end ************************************************************************ subroutine D0m3(res, para, perm) implicit none ComplexType res RealType para(1,*) integer perm #include "lt.h" RealType m2, m3, m4, p1, p2, p3, p4, p1p2, p2p3 RealType m, k12, k13, k14, k23, k24, k34 RealType ir12, ir14, ir24, ix1(2), ix4(2) ComplexType r12, r14, r24, q12, q24 ComplexType x1(2), x4(2), l4(2) ComplexType a, b, c, d ComplexType xspence, xetatilde external xspence, xetatilde if( DEBUGLEVEL .gt. 1 ) call DDump("D0m3", para,1, perm) m2 = Mx(2) m3 = Mx(3) m4 = Mx(4) p1 = Px(1) p2 = Px(2) p3 = Px(3) p4 = Px(4) p1p2 = Px(5) p2p3 = Px(6) m = sqrt(m3*m4) k23 = (m4 - p4)/m k12 = (m4 + m3 - p3)/m r12 = k2r(k12) ir12 = 0 if( k12 .lt. -2 ) ir12 = sign(10D0, 1 - abs(r12)) m = sqrt(m2*m3) k34 = (m2 - p1)/m k14 = (m2 + m3 - p2)/m r14 = k2r(k14) ir14 = 0 if( k14 .lt. -2 ) ir14 = sign(10D0, 1 - abs(r14)) k13 = (m3 - p1p2)/m3 m = sqrt(m2*m4) k24 = (m2 + m4 - p2p3)/m r24 = k2r(k24) ir24 = 0 if( k24 .lt. -2 ) ir24 = sign(10D0, 1 - abs(r24)) q24 = r24 - 1/r24 q12 = k12 - r24*k14 a = k34/r24 - k23 b = k12*k34 - k13*q24 - k14*k23 c = k13*q12 + r24*k34 - k23 d = sqrt(ToComplex((k12*k34 - k13*k24 - k14*k23)**2 - & 4*(k13*(k13 - k23*(k12 - k14*k24)) + & k23*(k23 - k24*k34) + k34*(k34 - k13*k14)))) x4(1) = .5D0/a*(b - d) x4(2) = .5D0/a*(b + d) if( abs(x4(1)) .gt. abs(x4(2)) ) then x4(2) = c/(a*x4(1)) else x4(1) = c/(a*x4(2)) endif d = -k34*r24 + k23 ix4(1) = sign(1D0, Re(d)) ix4(2) = -ix4(1) x1(1) = x4(1)/r24 x1(2) = x4(2)/r24 ix1(1) = sign(1D0, ix4(1)*Re(r24)) ix1(2) = -ix1(1) c = ln(k13, -1) l4(1) = c + ln((q12 + q24*x4(1))/d, Re(q24*ix4(1)/d)) l4(2) = c + ln((q12 + q24*x4(2))/d, Re(q24*ix4(2)/d)) res = ( & xspence(x4, ix4, r14, ir14) + & xspence(x4, ix4, 1/r14, -ir14) - & xspence(x4, ix4, ToComplex(k34/k13), -k13) - & xspence(x1, ix1, r12, ir12) - & xspence(x1, ix1, 1/r12, -ir12) + & xspence(x1, ix1, ToComplex(k23/k13), -k13) - & c2ipi*xetatilde(x4, ix4, 1/r24, -ir24, l4) & )/(m3*m*a*(x4(2) - x4(1))) if( DEBUGLEVEL .gt. 1 ) print *, "D0m3 =", res end ************************************************************************ subroutine D0m2(res, para, perm) implicit none ComplexType res RealType para(1,*) integer perm #include "lt.h" RealType m3, m4, p1, p2, p3, p4, p1p2, p2p3 RealType m, k12, k13, k14, k23, k24, k34 ComplexType k12c, k13c, k23c, k24c, k34c ComplexType r14, x4(2) ComplexType a, b, c, disc ComplexType xspence external xspence RealType imzero(2) data imzero /0D0, 0D0/ if( DEBUGLEVEL .gt. 1 ) call DDump("D0m2", para,1, perm) m3 = Mx(3) m4 = Mx(4) p1 = Px(1) p2 = Px(2) p3 = Px(3) p4 = Px(4) p1p2 = Px(5) p2p3 = Px(6) k12 = (m3 - p2)/m3 k12c = AddEps(k12) k13 = (m3 - p1p2)/m3 k13c = AddEps(k13) k23 = -p1/m3 k23c = AddEps(k23) m = sqrt(m3*m4) k24 = (m4 - p2p3)/m k24c = AddEps(k24)/k12c k34 = (m4 - p4)/m k34c = AddEps(k34)/k13c k14 = (m3 + m4 - p3)/m r14 = k2r(k14) r14 = r14*(1 + cIeps*sign(1D0, Re(1/r14 - r14))) c r14 = r14*ToComplex(1D0, sign(eps, Re(1/r14 - r14))) a = k34*k24 - k23 b = k13*k24 + k12*k34 - k14*k23 c = k13*k12 - k23*(1 - cIeps) disc = sqrt(b**2 - 4*a*c) x4(1) = .5D0/a*(b - disc) x4(2) = .5D0/a*(b + disc) if( abs(x4(1)) .gt. abs(x4(2)) ) then x4(2) = c/(a*x4(1)) else x4(1) = c/(a*x4(2)) endif res = ( & xspence(x4, imzero, r14, 0D0) + & xspence(x4, imzero, 1/r14, 0D0) - & xspence(x4, imzero, k34c, 0D0) - & xspence(x4, imzero, k24c, 0D0) + & (log(x4(2)) - log(x4(1)))* & (log(k12c) + log(k13c) - log(k23c)) & )/(m3*m*a*(x4(2) - x4(1))) if( DEBUGLEVEL .gt. 1 ) print *, "D0m2 =", res end ************************************************************************ subroutine D0m1(res, para, perm) implicit none ComplexType res RealType para(1,*) integer perm #include "lt.h" RealType m4, k12, k13, k14, k23, k24, k34 ComplexType k12c, k13c, k14c, k23c, k24c, k34c RealType a, b ComplexType c, disc, x4(2) ComplexType xspence external xspence RealType imzero(2) data imzero /0D0, 0D0/ if( DEBUGLEVEL .gt. 1 ) call DDump("D0m1", para,1, perm) m4 = Mx(4) k12 = (m4 - Px(3))/m4 k12c = AddEps(k12) k13 = (m4 - Px(4))/m4 k13c = AddEps(k13) k14 = (m4 - Px(6))/m4 k14c = AddEps(k14) k23 = -Px(5)/m4 k23c = AddEps(k23) k24 = -Px(2)/m4 k24c = AddEps(k24)/k12c k34 = -Px(1)/m4 k34c = AddEps(k34)/k13c a = k34*k24 b = k13*k24 + k12*k34 - k14*k23 c = k13*k12 - k23*(1 - cIeps) disc = sqrt(b*b - 4*a*c) x4(1) = .5D0/a*(b - disc) x4(2) = .5D0/a*(b + disc) if( abs(x4(1)) .gt. abs(x4(2)) ) then x4(2) = c/(a*x4(1)) else x4(1) = c/(a*x4(2)) endif res = ( & xspence(x4, imzero, k14c, 0D0) - & xspence(x4, imzero, k34c, 0D0) - & xspence(x4, imzero, k24c, 0D0) + & (log(x4(2)) - log(x4(1)))* & (log(k12c) + log(k13c) - log(k23c)) & )/(m4**2*a*(x4(2) - x4(1))) if( DEBUGLEVEL .gt. 1 ) print *, "D0m1 =", res end ************************************************************************ subroutine D0m0(res, para) implicit none ComplexType res RealType para(1,*) #include "lt.h" #include "perm.h" RealType m2, k12, k13, k14, k23, k24, k34 ComplexType k12c, k13c, k14c, k23c, k24c, k34c RealType a, b ComplexType c, disc, x4(2) ComplexType xspence external xspence RealType imzero(2) data imzero /0D0, 0D0/ if( DEBUGLEVEL .gt. 1 ) call DDump("D0m0", para,1, p1234) m2 = abs(P(6)) k12 = -P(1)/m2 k12c = AddEps(k12) k13 = -P(5)/m2 k13c = AddEps(k13) k14 = -P(4)/m2 k14c = AddEps(k14) k23 = -P(2)/m2 k23c = AddEps(k23) k24 = -P(6)/m2 k24c = AddEps(k24)/k12c k34 = -P(3)/m2 k34c = AddEps(k34)/k13c a = k34*k24 b = k13*k24 + k12*k34 - k14*k23 c = k13*k12 + k23*cIeps disc = sqrt(b*b - 4*a*c) x4(1) = .5D0/a*(b - disc) x4(2) = .5D0/a*(b + disc) if( abs(x4(1)) .gt. abs(x4(2)) ) then x4(2) = c/(a*x4(1)) else x4(1) = c/(a*x4(2)) endif res = ( & (log(x4(2)) - log(x4(1)))* & (-.5D0*(log(x4(2)) + log(x4(1))) + & log(k12c) + log(k13c) - log(k23c) - log(k14c)) - & xspence(x4, imzero, k34c, 0D0) - & xspence(x4, imzero, k24c, 0D0) & )/(m2**2*a*(x4(2) - x4(1))) if( DEBUGLEVEL .gt. 1 ) print *, "D0m0 =", res end ************************************************************************ ComplexType function xspence(z1, im1, z2, im2) implicit none ComplexType z1(2), z2 RealType im1(2), im2 #include "lt.h" ComplexType cspence external cspence xspence = cspence(z1(2), im1(2), z2, im2) - & cspence(z1(1), im1(1), z2, im2) end ************************************************************************ ComplexType function cspence(z1, im1, z2, im2) implicit none ComplexType z1, z2 RealType im1, im2 #include "lt.h" ComplexType spence integer eta external spence, eta ComplexType z12 RealType im12 integer etas z12 = z1*z2 im12 = im2*sign(1D0, Re(z1)) if( Re(z12) .gt. .5D0 ) then cspence = spence(1, z12, 0D0) etas = eta(z1, im1, z2, im2, im12) if( etas .ne. 0 ) cspence = cspence + & etas*ln(1 - z12, -im12)*c2ipi else if( abs(z12) .lt. 1D-4 ) then cspence = pi6 if( abs(z12) .gt. 1D-14 ) cspence = cspence - & spence(0, z12, 0D0) + & (ln(z1, im1) + ln(z2, im2))*z12* & (1 + z12*(.5D0 + z12*(1/3D0 + z12/4D0))) else cspence = pi6 - spence(0, z12, 0D0) - & (ln(z1, im1) + ln(z2, im2))*ln(1 - z12, 0) endif end ************************************************************************ ComplexType function xeta(z1, im1, z2, im2, im12, l1) implicit none ComplexType z1(2), z2, l1(2) RealType im1(2), im2, im12 #include "lt.h" integer eta external eta xeta = l1(2)*eta(z1(2), im1(2), z2, im2, im12) - & l1(1)*eta(z1(1), im1(1), z2, im2, im12) end ************************************************************************ ComplexType function xetatilde(z1, im1, z2, im2, l1) implicit none ComplexType z1(2), z2, l1(2) RealType im1(2), im2 #include "lt.h" integer etatilde external etatilde xetatilde = l1(2)*etatilde(z1(2), im1(2), z2, im2) - & l1(1)*etatilde(z1(1), im1(1), z2, im2) end ************************************************************************ integer function etatilde(c1, im1x, c2, im2x) implicit none ComplexType c1, c2 RealType im1x, im2x RealType im1, im2 integer eta external eta im1 = Im(c1) if( im1 .eq. 0 ) im1 = im1x im2 = Im(c2) if( im2 .ne. 0 ) then etatilde = eta(c1, im1x, c2, 0D0, 0D0) else if( Re(c2) .gt. 0 ) then etatilde = 0 else if( im1 .gt. 0 .and. im2x .gt. 0 ) then etatilde = -1 else if( im1 .lt. 0 .and. im2x .lt. 0 ) then etatilde = 1 else etatilde = 0 #ifdef WARNINGS if( im1 .eq. 0 .and. Re(c1) .lt. 0 .or. & im2x .eq. 0 .and. Re(c1*c2) .lt. 0 ) & print *, "etatilde not defined" #endif endif end LoopTools-2.16/src/D/PaxHeaders/D0z.F0000644000000000000000000000007413361302710014171 xustar0030 atime=1648161785.711698365 30 ctime=1648161793.715764879 LoopTools-2.16/src/D/D0z.F0000644000000000000000000000502313361302710015104 0ustar00rootroot00000000000000* D0z.F * D0, D00 for zero momenta, from arXiv:0811.2891 * this file is part of LoopTools * last modified 16 Oct 18 th #include "externals.h" #include "types.h" #define npoint 4 #include "defs.h" subroutine D0z(res, res00, para) implicit none ComplexType res, res00 RealType para(1,*) #include "lt.h" RealType m1, m2, m3, m4, mx, my, lm, l1, l3 RealType safelog, d0, d00, x safelog(x) = merge(log(x), Re(nan), x .gt. zeroeps) d0(m1, m2, m3, m4) = m1*safelog(m1)/ & ((m2 - m1)*(m3 - m1)*(m4 - m1)) d00(m1, m2, m3, m4) = m1/4*d0(m1, m2, m3, m4) if( abs(M(1) - M(2)) .lt. diffeps ) then m1 = M(3) m2 = M(4) m3 = M(1) else if( abs(M(1) - M(3)) .lt. diffeps ) then m1 = M(2) m2 = M(4) m3 = M(1) else if( abs(M(1) - M(4)) .lt. diffeps ) then m1 = M(2) m2 = M(3) m3 = M(1) else if( abs(M(2) - M(3)) .lt. diffeps ) then m1 = M(1) m2 = M(4) m3 = M(2) else if( abs(M(2) - M(4)) .lt. diffeps ) then m1 = M(1) m2 = M(3) m3 = M(2) else if( abs(M(3) - M(4)) .lt. diffeps ) then m1 = M(1) m2 = M(2) m3 = M(3) else res = & d0(M(1), M(2), M(3), M(4)) + & d0(M(2), M(1), M(3), M(4)) + & d0(M(3), M(1), M(2), M(4)) + & d0(M(4), M(1), M(2), M(3)) res00 = & d00(M(1), M(2), M(3), M(4)) + & d00(M(2), M(1), M(3), M(4)) + & d00(M(3), M(1), M(2), M(4)) + & d00(M(4), M(1), M(2), M(3)) return endif if( abs(m1 - m2) .lt. diffeps ) then if( abs(m1 - m3) .lt. diffeps ) then * case D0z(m1, m1, m1, m1) res = 1/6D0/m1**2 res00 = -1/12D0/m1 return endif * case D0z(m1, m1, m3, m3) if( m3 .lt. zeroeps ) then res = .5D0/m1**2 res00 = -.25D0/m1 return endif mx = 1/(m3 - m1) lm = mx*log(m3/m1) l1 = lm*m1 - 1 l3 = lm*m3 - 1 res = mx**2*(l1 + l3) res00 = mx**2/4*(m1*l3 + m3*l1) return endif if( abs(m3 - m1) .lt. diffeps ) then * case D0z(m3, m1, m3, m3) mx = m1 m1 = m2 m2 = mx endif mx = 1/(m3 - m1) if( abs(m3 - m2) .lt. diffeps ) then * case D0z(m1, m3, m3, m3) if( m1 .lt. zeroeps ) then res = -.5D0/m3**2 res00 = -.125D0/m3 return endif lm = mx*log(m3/m1) l1 = mx*(1 - m1*lm) res = mx*(l1 + 1/m3) res00 = .25D0*mx*(m1*l1 - .5D0) return endif * case D0z(m1, m2, m3, m3) my = 1/(m3 - m2) lm = log(m3) l1 = (m1*mx + m2*my)*lm - 1 res = mx*my*(lm + l1) + & d0(m1, m2, m3, m3) + & d0(m2, m1, m3, m3) res00 = mx*my*l1*m3/4 + & d00(m1, m2, m3, m3) + & d00(m2, m1, m3, m3) end LoopTools-2.16/src/D/PaxHeaders/Dget.F0000644000000000000000000000007413361302320014414 xustar0030 atime=1648161785.711698365 30 ctime=1648161793.715764879 LoopTools-2.16/src/D/Dget.F0000644000000000000000000003431313361302320015333 0ustar00rootroot00000000000000* Dget.F * retrieve the four-point tensor coefficients * this file is part of LoopTools * improvements by M. Rauch * last modified 16 Oct 18 th #include "externals.h" #include "types.h" #define npoint 4 #include "defs.h" subroutine XDpara(para, p1, p2, p3, p4, p1p2, p2p3, & m1, m2, m3, m4) implicit none ArgType para(1,*) ArgType p1, p2, p3, p4, p1p2, p2p3 ArgType m1, m2, m3, m4 #include "lt.h" P(1) = p1 P(2) = p2 P(3) = p3 P(4) = p4 P(5) = p1p2 P(6) = p2p3 M(1) = m1 if( abs(M(1)) .lt. minmass ) M(1) = 0 M(2) = m2 if( abs(M(2)) .lt. minmass ) M(2) = 0 M(3) = m3 if( abs(M(3)) .lt. minmass ) M(3) = 0 M(4) = m4 if( abs(M(4)) .lt. minmass ) M(4) = 0 end ************************************************************************ memindex function XDget(p1, p2, p3, p4, p1p2, p2p3, & m1, m2, m3, m4) implicit none ArgType p1, p2, p3, p4, p1p2, p2p3 ArgType m1, m2, m3, m4 #include "lt.h" memindex cacheindex external cacheindex, XDcoefx #ifdef COMPLEXPARA memindex Dget external Dget #endif ArgType para(1,Pdd+3) #ifdef COMPLEXPARA if( abs(Im(p1)) + abs(Im(p2)) + & abs(Im(p3)) + abs(Im(p4)) + & abs(Im(p1p2)) + abs(Im(p2p3)) .gt. 0 ) & print *, "Complex momenta not implemented" if( abs(Im(m1)) + abs(Im(m2)) + & abs(Im(m3)) + abs(Im(m4)) .eq. 0 ) then XDget = Dget(p1, p2, p3, p4, p1p2, p2p3, & m1, m2, m3, m4) - offsetC return endif #endif call XDpara(para, p1, p2, p3, p4, p1p2, p2p3, m1, m2, m3, m4) XDget = cacheindex(para, Dval(1,0), XDcoefx, RC*Pdd, Ndd, Dno) end ************************************************************************ subroutine XDput(res, p1, p2, p3, p4, p1p2, p2p3, & m1, m2, m3, m4) implicit none ComplexType res(*) ArgType p1, p2, p3, p4, p1p2, p2p3 ArgType m1, m2, m3, m4 #include "lt.h" external XDcoefx ArgType para(1,Pdd+3) #ifdef COMPLEXPARA if( abs(Im(p1)) + abs(Im(p2)) + & abs(Im(p3)) + abs(Im(p4)) + & abs(Im(p1p2)) + abs(Im(p2p3)) .gt. 0 ) & print *, "Complex momenta not implemented" if( abs(Im(m1)) + abs(Im(m2)) + & abs(Im(m3)) + abs(Im(m4)) .eq. 0 ) then call Dput(res, p1, p2, p3, p4, p1p2, p2p3, m1, m2, m3, m4) return endif #endif call XDpara(para, p1, p2, p3, p4, p1p2, p2p3, m1, m2, m3, m4) call cachecopy(res, para, Dval(1,0), XDcoefx, RC*Pdd, Ndd, Dno) end ************************************************************************ subroutine XD0nocache(res, p1, p2, p3, p4, p1p2, p2p3, & m1, m2, m3, m4) implicit none ComplexType res(*) ArgType p1, p2, p3, p4, p1p2, p2p3 ArgType m1, m2, m3, m4 #include "lt.h" ArgType para(1,Pdd+3) ComplexType res00(0:2) #ifdef COMPLEXPARA if( abs(Im(p1)) + abs(Im(p2)) + & abs(Im(p3)) + abs(Im(p4)) + & abs(Im(p1p2)) + abs(Im(p2p3)) .gt. 0 ) & print *, "Complex momenta not implemented" if( abs(Im(m1)) + abs(Im(m2)) + & abs(Im(m3)) + abs(Im(m4)) .eq. 0 ) then call D0nocache(res, p1, p2, p3, p4, p1p2, p2p3, & m1, m2, m3, m4) return endif #endif call XDpara(para, p1, p2, p3, p4, p1p2, p2p3, m1, m2, m3, m4) call XD0func(res, res00, para) end ************************************************************************ ComplexType function XD0i(i, p1, p2, p3, p4, p1p2, p2p3, & m1, m2, m3, m4) implicit none integer i ArgType p1, p2, p3, p4, p1p2, p2p3 ArgType m1, m2, m3, m4 #include "lt.h" memindex XDget external XDget memindex b b = XDget(p1, p2, p3, p4, p1p2, p2p3, m1, m2, m3, m4) XD0i = Dval(i+epsi,b) end ************************************************************************ ComplexType function XD0(p1, p2, p3, p4, p1p2, p2p3, & m1, m2, m3, m4) implicit none ArgType p1, p2, p3, p4, p1p2, p2p3 ArgType m1, m2, m3, m4 #include "lt.h" ComplexType XD0i external XD0i XD0 = XD0i(dd0, p1, p2, p3, p4, p1p2, p2p3, m1, m2, m3, m4) end ************************************************************************ subroutine XDcoefx(D, para) implicit none ComplexType D(*) ArgType para(1,*) #include "lt.h" memindex c234, c134, c124, c123 memindex XCget external XCget c234 = XCget(P(2), P(3), P(6), M(2), M(3), M(4)) c134 = XCget(P(5), P(3), P(4), M(1), M(3), M(4)) c124 = XCget(P(1), P(6), P(4), M(1), M(2), M(4)) c123 = XCget(P(1), P(2), P(5), M(1), M(2), M(3)) call XDcoeff(D, para, & Cval(1,c234), Cval(1,c134), Cval(1,c124), Cval(1,c123)) end ************************************************************************ subroutine XDcoeff(D, para, C234, C134, C124, C123) implicit none ComplexType D(*), C234(*), C134(*), C124(*), C123(*) ArgType para(1,*) #include "lt.h" ArgType p1, p2, p3, p4, p1p2, p2p3, m1, m2, m3, m4 ArgType f1, f2, f3 ArgQuad G(3,3) ComplexQuad c0sum(0:2), c1sum(0:2), c2sum(0:2), csum(0:2) ComplexQuad c00sum(0:2), c11sum(0:2), c12sum(0:2), c22sum(0:2) ComplexQuad in(0:2,3) logical dump integer perm(3) #define IN(i) in(:,perm(i)) #define OUT(i) in(:,i) #define SOLVE_SETUP XDecomp(3, G,3, perm) #define SOLVER(b) XSolve(3, G,3, b) integer finite(0:2) data finite /1, 0, 0/ serial = serial + 1 dump = ibits(debugkey, DebugD, 1) .ne. 0 .and. & serial .ge. debugfrom .and. serial .le. debugto if( dump ) call XDumpPara(4, para, "Dcoeff") m1 = M(1) m2 = M(2) m3 = M(3) m4 = M(4) p1 = P(1) p2 = P(2) p3 = P(3) p4 = P(4) p1p2 = P(5) p2p3 = P(6) f1 = m2 f1 = f1 - m1 f1 = f1 - p1 f2 = m3 f2 = f2 - m1 f2 = f2 - p1p2 f3 = m4 f3 = f3 - m1 f3 = f3 - p4 G(1,1) = 2*p1 G(2,2) = 2*p1p2 G(3,3) = 2*p4 G(1,2) = p1 G(1,2) = G(1,2) + p1p2 G(1,2) = G(1,2) - p2 G(2,1) = G(1,2) G(1,3) = p1 G(1,3) = G(1,3) + p4 G(1,3) = G(1,3) - p2p3 G(3,1) = G(1,3) G(2,3) = p1p2 G(2,3) = G(2,3) - p3 G(2,3) = G(2,3) + p4 G(3,2) = G(2,3) call SOLVE_SETUP c0sum = C234(CC0) + C234(CC1) + C234(CC2) c1sum = C234(CC1) + C234(CC11) + C234(CC12) c2sum = C234(CC2) + C234(CC12) + C234(CC22) csum = c0sum + c1sum + c2sum c00sum = C234(CC00) + C234(CC001) + C234(CC002) c11sum = C234(CC11) + C234(CC111) + C234(CC112) c12sum = C234(CC12) + C234(CC112) + C234(CC122) c22sum = C234(CC22) + C234(CC122) + C234(CC222) call XD0func(D(DD0), D(DD00), para) IN(1) = f1*D(DD0) - C234(CC0) + C134(CC0) IN(2) = f2*D(DD0) - C234(CC0) + C124(CC0) IN(3) = f3*D(DD0) - C234(CC0) + C123(CC0) call SOLVER(in) D(DD1) = OUT(1) D(DD2) = OUT(2) D(DD3) = OUT(3) if( Re(D(dd00)) .eq. -999 ) D(DD00) = m1*D(DD0) - & .5D0*(D(DD1)*f1 + D(DD2)*f2 + D(DD3)*f3 - C234(CC0)) IN(1) = f1*D(DD1) + c0sum - 2*D(DD00) IN(2) = f2*D(DD1) + c0sum + C124(CC1) IN(3) = f3*D(DD1) + c0sum + C123(CC1) call SOLVER(in) D(DD11) = OUT(1) D(DD12) = OUT(2) D(DD13) = OUT(3) IN(1) = f1*D(DD2) - C234(CC1) + C134(CC1) IN(2) = f2*D(DD2) - C234(CC1) - 2*D(DD00) IN(3) = f3*D(DD2) - C234(CC1) + C123(CC2) call SOLVER(in) D(DD12) = .5D0*(D(DD12) + OUT(1)) D(DD22) = OUT(2) D(DD23) = OUT(3) IN(1) = f1*D(DD3) - C234(CC2) + C134(CC2) IN(2) = f2*D(DD3) - C234(CC2) + C124(CC2) IN(3) = f3*D(DD3) - C234(CC2) - 2*D(DD00) call SOLVER(in) D(DD13) = .5D0*(D(DD13) + OUT(1)) D(DD23) = .5D0*(D(DD23) + OUT(2)) D(DD33) = OUT(3) IN(1) = f1*D(DD00) - C234(CC00) + C134(CC00) IN(2) = f2*D(DD00) - C234(CC00) + C124(CC00) IN(3) = f3*D(DD00) - C234(CC00) + C123(CC00) call SOLVER(in) D(DD001) = OUT(1) D(DD002) = OUT(2) D(DD003) = OUT(3) IN(1) = f1*D(DD11) - csum - 4*D(DD001) IN(2) = f2*D(DD11) - csum + C124(CC11) IN(3) = f3*D(DD11) - csum + C123(CC11) call SOLVER(in) D(DD111) = OUT(1) D(DD112) = OUT(2) D(DD113) = OUT(3) IN(1) = f1*D(DD22) - C234(CC11) + C134(CC11) IN(2) = f2*D(DD22) - C234(CC11) - 4*D(DD002) IN(3) = f3*D(DD22) - C234(CC11) + C123(CC22) call SOLVER(in) D(DD122) = OUT(1) D(DD222) = OUT(2) D(DD223) = OUT(3) IN(1) = f1*D(DD33) - C234(CC22) + C134(CC22) IN(2) = f2*D(DD33) - C234(CC22) + C124(CC22) IN(3) = f3*D(DD33) - C234(CC22) - 4*D(DD003) call SOLVER(in) D(DD133) = OUT(1) D(DD233) = OUT(2) D(DD333) = OUT(3) IN(1) = f1*D(DD13) + c2sum - 2*D(DD003) IN(2) = f2*D(DD13) + c2sum + C124(CC12) IN(3) = f3*D(DD13) + c2sum - 2*D(DD001) call SOLVER(in) D(DD113) = .5D0*(D(DD113) + OUT(1)) D(DD123) = OUT(2) D(DD133) = .5D0*(D(DD133) + OUT(3)) D(DD0000) = 1/3D0*(m1*D(DD00) - & .5D0*(f1*D(DD001) + f2*D(DD002) + f3*D(DD003) - & C234(CC00) - finite/6D0)) D(DD0011) = 1/3D0*(m1*D(DD11) - & .5D0*(f1*D(DD111) + f2*D(DD112) + f3*D(DD113) - csum)) D(DD0012) = 1/3D0*(m1*D(DD12) - & .5D0*(f1*D(DD112) + f2*D(DD122) + f3*D(DD123) + c1sum)) D(DD0013) = 1/3D0*(m1*D(DD13) - & .5D0*(f1*D(DD113) + f2*D(DD123) + f3*D(DD133) + c2sum)) D(DD0022) = 1/3D0*(m1*D(DD22) - & .5D0*(f1*D(DD122) + f2*D(DD222) + f3*D(DD223) - & C234(CC11))) D(DD0023) = 1/3D0*(m1*D(DD23) - & .5D0*(f1*D(DD123) + f2*D(DD223) + f3*D(DD233) - & C234(CC12))) D(DD0033) = 1/3D0*(m1*D(DD33) - & .5D0*(f1*D(DD133) + f2*D(DD233) + f3*D(DD333) - & C234(CC22))) c1sum = c1sum + c11sum + c12sum c2sum = c2sum + c12sum + c22sum csum = csum + c1sum + c2sum IN(1) = f1*D(DD111) + csum - 6*D(DD0011) IN(2) = f2*D(DD111) + csum + C124(CC111) IN(3) = f3*D(DD111) + csum + C123(CC111) call SOLVER(in) D(DD1111) = OUT(1) D(DD1112) = OUT(2) D(DD1113) = OUT(3) IN(1) = f1*D(DD113) - c2sum - 4*D(DD0013) IN(2) = f2*D(DD113) - c2sum + C124(CC112) IN(3) = f3*D(DD113) - c2sum - 2*D(DD0011) call SOLVER(in) D(DD1113) = .5D0*(D(DD1113) + OUT(1)) D(DD1123) = OUT(2) D(DD1133) = OUT(3) IN(1) = f1*D(DD122) + c11sum - 2*D(DD0022) IN(2) = f2*D(DD122) + c11sum - 4*D(DD0012) IN(3) = f3*D(DD122) + c11sum + C123(CC122) call SOLVER(in) D(DD1122) = OUT(1) D(DD1222) = OUT(2) D(DD1223) = OUT(3) IN(1) = f1*D(DD222) - C234(CC111) + C134(CC111) IN(2) = f2*D(DD222) - C234(CC111) - 6*D(DD0022) IN(3) = f3*D(DD222) - C234(CC111) + C123(CC222) call SOLVER(in) D(DD1222) = .5D0*(D(DD1222) + OUT(1)) D(DD2222) = OUT(2) D(DD2223) = OUT(3) IN(1) = f1*D(DD233) - C234(CC122) + C134(CC122) IN(2) = f2*D(DD233) - C234(CC122) - 2*D(DD0033) IN(3) = f3*D(DD233) - C234(CC122) - 4*D(DD0023) call SOLVER(in) D(DD1233) = OUT(1) D(DD2233) = OUT(2) D(DD2333) = OUT(3) IN(1) = f1*D(DD333) - C234(CC222) + C134(CC222) IN(2) = f2*D(DD333) - C234(CC222) + C124(CC222) IN(3) = f3*D(DD333) - C234(CC222) - 6*D(DD0033) call SOLVER(in) D(DD1333) = OUT(1) D(DD2333) = .5D0*(D(DD2333) + OUT(2)) D(DD3333) = OUT(3) c00sum = c00sum + & C234(CC001) + C234(CC0011) + C234(CC0012) + & C234(CC002) + C234(CC0012) + C234(CC0022) c11sum = c11sum + & C234(CC111) + C234(CC1111) + C234(CC1112) + & C234(CC112) + C234(CC1112) + C234(CC1122) c12sum = c12sum + & C234(CC112) + C234(CC1112) + C234(CC1122) + & C234(CC122) + C234(CC1122) + C234(CC1222) c22sum = c22sum + & C234(CC122) + C234(CC1122) + C234(CC1222) + & C234(CC222) + C234(CC1222) + C234(CC2222) c1sum = c1sum + c11sum + c12sum c2sum = c2sum + c12sum + c22sum csum = csum + c1sum + c2sum IN(1) = f1*D(DD0000) - C234(CC0000) + C134(CC0000) IN(2) = f2*D(DD0000) - C234(CC0000) + C124(CC0000) IN(3) = f3*D(DD0000) - C234(CC0000) + C123(CC0000) call SOLVER(in) D(DD00001) = OUT(1) D(DD00002) = OUT(2) D(DD00003) = OUT(3) IN(1) = f1*D(DD0011) - c00sum - 4*D(DD00001) IN(2) = f2*D(DD0011) - c00sum + C124(CC0011) IN(3) = f3*D(DD0011) - c00sum + C123(CC0011) call SOLVER(in) D(DD00111) = OUT(1) D(DD00112) = OUT(2) D(DD00113) = OUT(3) IN(1) = f1*D(DD0022) - C234(CC0011) + C134(CC0011) IN(2) = f2*D(DD0022) - C234(CC0011) - 4*D(DD00002) IN(3) = f3*D(DD0022) - C234(CC0011) + C123(CC0022) call SOLVER(in) D(DD00122) = OUT(1) D(DD00222) = OUT(2) D(DD00223) = OUT(3) IN(1) = f1*D(DD0033) - C234(CC0022) + C134(CC0022) IN(2) = f2*D(DD0033) - C234(CC0022) + C124(CC0022) IN(3) = f3*D(DD0033) - C234(CC0022) - 4*D(DD00003) call SOLVER(in) D(DD00133) = OUT(1) D(DD00233) = OUT(2) D(DD00333) = OUT(3) IN(1) = f1*D(DD0023) - C234(CC0012) + C134(CC0012) IN(2) = f2*D(DD0023) - C234(CC0012) - 2*D(DD00003) IN(3) = f3*D(DD0023) - C234(CC0012) - 2*D(DD00002) call SOLVER(in) D(DD00123) = OUT(1) D(DD00223) = .5D0*(D(DD00223) + OUT(2)) D(DD00233) = .5D0*(D(DD00233) + OUT(3)) IN(1) = f1*D(DD1111) - csum - 8*D(DD00111) IN(2) = f2*D(DD1111) - csum + C124(CC1111) IN(3) = f3*D(DD1111) - csum + C123(CC1111) call SOLVER(in) D(DD11111) = OUT(1) D(DD11112) = OUT(2) D(DD11113) = OUT(3) IN(1) = f1*D(DD2222) - C234(CC1111) + C134(CC1111) IN(2) = f2*D(DD2222) - C234(CC1111) - 8*D(DD00222) IN(3) = f3*D(DD2222) - C234(CC1111) + C123(CC2222) call SOLVER(in) D(DD12222) = OUT(1) D(DD22222) = OUT(2) D(DD22223) = OUT(3) IN(1) = f1*D(DD3333) - C234(CC2222) + C134(CC2222) IN(2) = f2*D(DD3333) - C234(CC2222) + C124(CC2222) IN(3) = f3*D(DD3333) - C234(CC2222) - 8*D(DD00333) call SOLVER(in) D(DD13333) = OUT(1) D(DD23333) = OUT(2) D(DD33333) = OUT(3) IN(1) = f1*D(DD1122) - c11sum - 4*D(DD00122) IN(2) = f2*D(DD1122) - c11sum - 4*D(DD00112) IN(3) = f3*D(DD1122) - c11sum + C123(CC1122) call SOLVER(in) D(DD11122) = OUT(1) D(DD11222) = OUT(2) D(DD11223) = OUT(3) IN(1) = f1*D(DD1133) - c22sum - 4*D(DD00133) IN(2) = f2*D(DD1133) - c22sum + C124(CC1122) IN(3) = f3*D(DD1133) - c22sum - 4*D(DD00113) call SOLVER(in) D(DD11133) = OUT(1) D(DD11233) = OUT(2) D(DD11333) = OUT(3) IN(1) = f1*D(DD2233) - C234(CC1122) + C134(CC1122) IN(2) = f2*D(DD2233) - C234(CC1122) - 4*D(DD00233) IN(3) = f3*D(DD2233) - C234(CC1122) - 4*D(DD00223) call SOLVER(in) D(DD12233) = OUT(1) D(DD22233) = OUT(2) D(DD22333) = OUT(3) IN(1) = f1*D(DD1123) - c12sum - 4*D(DD00123) IN(2) = f2*D(DD1123) - c12sum - 2*D(DD00113) IN(3) = f3*D(DD1123) - c12sum - 2*D(DD00112) call SOLVER(in) D(DD11123) = OUT(1) D(DD11223) = .5D0*(D(DD11223) + OUT(2)) D(DD11233) = .5D0*(D(DD11233) + OUT(3)) IN(1) = f1*D(DD2223) - C234(CC1112) + C134(CC1112) IN(2) = f2*D(DD2223) - C234(CC1112) - 6*D(DD00223) IN(3) = f3*D(DD2223) - C234(CC1112) - 2*D(DD00222) call SOLVER(in) D(DD12223) = OUT(1) D(DD22223) = .5D0*(D(DD22223) + OUT(2)) D(DD22233) = .5D0*(D(DD22233) + OUT(3)) IN(1) = f1*D(DD2333) - C234(CC1222) + C134(CC1222) IN(2) = f2*D(DD2333) - C234(CC1222) - 2*D(DD00333) IN(3) = f3*D(DD2333) - C234(CC1222) - 6*D(DD00233) call SOLVER(in) D(DD12333) = OUT(1) D(DD22333) = .5D0*(D(DD22333) + OUT(2)) D(DD23333) = .5D0*(D(DD23333) + OUT(3)) if( dump ) call XDumpCoeff(4, D) end LoopTools-2.16/src/D/PaxHeaders/ffS2.F0000644000000000000000000000013213722123637014341 xustar0030 mtime=1598597023.046946476 30 atime=1648161785.711698365 30 ctime=1648161793.715764879 LoopTools-2.16/src/D/ffS2.F0000644000000000000000000000600613722123637015263 0ustar00rootroot00000000000000* ffS2.F * calculate S2 = \int_0^1 dy ln(a y^2 + b y + c), * where a is real and can be zero; b and c complex * input: ra=a (real), cb=b, cc=c * signc=sign(img(c)) in case c is real. * cza and czb are the 2 roots of: a y^2 + b y + c == 0 * remarks: ieps is needed for cza, czb. * this file is part of LoopTools * last modified 8 Dec 10 th * Written by Le Duc Ninh, MPI, Munich (2008). * Spence, log and eta functions are taken from FF. * Oct 28 2008 #include "externals.h" #include "types.h" ComplexType function ffS2(ra, cb, cc, signc, ier) implicit none RealType ra, signc ComplexType cb, cc integer ier #include "ff.h" ComplexType crdisc, cza, czb RealType sza, szb, sy1, sy2, sc ComplexType ffS2_linr, zfflog integer nffet1 external ffS2_linr, zfflog, nffet1 sc = Im(cc) if( sc .eq. 0 ) sc = signc if( abs(ra) .lt. precx ) then if( abs(cb) .lt. precx ) then * 0 roots: if( abs(cc) .lt. precx ) then call fferr(89, ier) ffS2 = 0 return endif ffS2 = zfflog(cc, 1, ToComplex(signc), ier) return endif * 1 root: cza = -cc/cb sza = -signc*Re(cb) if( sza .eq. 0 ) sza = -signc ffS2 = zfflog(cb, 1, ToComplex(sc), ier) + & ffS2_linr(cza, sza, ier) if( abs(Im(cb)) .lt. precx ) return * complex b szb = Im(cza) if( szb .eq. 0 ) szb = sza ffS2 = ffS2 + c2ipi*nffet1(cb, & ToComplex(0D0, -szb), ToComplex(0D0, sc), ier) return endif * 2 roots: cza = y1, czb = y2 * eq.: y**2 + (b/a) y + (c/a) = 0 * the ieps is irrelevant here since we take into account * the contributions of both roots *** Ninh changed: 14 Aug 2009 crdisc = sqrt(cb**2/ra**2 - 4*cc/ra) cza = -.5D0*(cb/ra + crdisc) czb = -.5D0*(cb/ra - crdisc) if( abs(cza) .gt. abs(czb) ) then czb = cc/(ra*cza) else cza = cc/(ra*czb) endif * calculate the sign of im(cza) and im(czb) which are related to ieps sza = signc/ra if( abs(Re(crdisc)) .gt. precx ) sza = sza/Re(crdisc) szb = -sza sy1 = Im(cza) if( sy1 .eq. 0 ) sy1 = sza sy2 = Im(czb) if( sy2 .eq. 0 ) sy2 = szb * calculate the log and etas * ieps=1 to choose the cut along the real axis ffS2 = & zfflog(ToComplex(ra), 1, ToComplex(sc), ier) + & c2ipi*nffet1(ToComplex(0D0, -sy1), ToComplex(0D0, -sy2), & ToComplex(0D0, sc/ra), ier) + & ffS2_linr(cza, sza, ier) + & ffS2_linr(czb, szb, ier) end ************************************************************************ * calculate S2 = \int_0^1 dy ln(y - z), * where z is complex * input: cz, signz = sign(im(z)) in case z is real. * remarks: ieps is needed. ComplexType function ffS2_linr(cz, signz, ier) implicit none ComplexType cz RealType signz integer ier #include "ff.h" ComplexType zfflog external zfflog if( abs(cz) .lt. precx ) then ffS2_linr = -1 else if( abs(cz - 1) .lt. precx ) then ffS2_linr = zfflog(-cz, 1, ToComplex(-signz), ier) - 1 else ffS2_linr = & zfflog(1 - cz, 1, ToComplex(-signz), ier)*(1 - cz) + & zfflog(-cz, 1, ToComplex(-signz), ier)*cz - 1 endif end LoopTools-2.16/src/D/PaxHeaders/ffTn.F0000644000000000000000000000007411776502523014445 xustar0030 atime=1648161785.715698398 30 ctime=1648161793.715764879 LoopTools-2.16/src/D/ffTn.F0000644000000000000000000002766711776502523015402 0ustar00rootroot00000000000000* ffTn.F * calculate T(ra, rb, rc, rg, rh; cd, ce, cf, cj) defined as: * T = \int_0^1 dx \int_0^x dy * 1/((rg x + rh y + cj) * (ra x^2 + rb y^2 + rc x y + cd x + ce y + cf + I signf)) * with signf = -eps, * {ra,rb,rc,rg,rh} are real, {cd,ce,cf,cj} are complex. * important: variables "signX" is the sign of im(X) in case X becomes real. * this file is part of LoopTools * last modified 8 Dec 10 th * Written by Le Duc Ninh, MPI, Munich (2008). * Spence, log and eta functions are taken from FF. * Oct 27 2008 #include "externals.h" #include "types.h" #include "defs.h" ComplexType function ffTn(ra, rb, rc, rgx, rhx, & cd, ce, cf, signf, cjx, signj, key, ier) implicit none RealType ra, rb, rc, rgx, rhx, signf, signj ComplexType cd, ce, cf, cjx integer key, ier #include "ff.h" ComplexType cj, crdetq4, crdetq42, cy(2), cy2(2) ComplexType crdisc, cbeta1, cbeta2, cbeta ComplexType ctv, ctemp, cresd, cyij ComplexType cbj(6), ccj(6), cbk(6), cck(6) RealType rg, rh, reps RealType sj, scj, sy(2), sy2(2), stv, syij RealType rminuv, rminuv2, raj(6) integer i, j, ny, ny2, chketa(2), chketa2(2) ComplexType ffT_lin, ffS2, ffS3n, zfflog integer nffet1 external ffT_lin, ffS2, ffS3n, zfflog, nffet1 ier = 0 * calculate ieps and the sign of im(J) reps = Im(cf) if( reps .eq. 0 ) reps = signf reps = sign(1D0, -reps) sj = Im(cjx) if( sj .eq. 0 ) sj = signj sj = sign(1D0, sj*reps) * change the sign of G,H,J * sj = 1 or -1 rg = -sj*rgx rh = -sj*rhx cj = -sj*cjx if( abs(rb) .lt. precx ) then ffTn = sj*ffT_lin(ra, rc, rg, rh, cd, ce, cf, cj, & signf, reps, ier) return endif if( abs(ra) .lt. precx ) then * change the integration variables to get rb = 0 as above ffTn = sj*ffT_lin(rb + rc, -rc, -rg - rh, rg, & -2*(rb + rc) - cd - ce, & rc + cd, & rb + rc + cd + ce + cf, & rg + rh + cj, & signf, reps, ier) return endif * calculate beta * beta is one root of: B beta^2 + C beta + A = 0 * we do not need the ieps for beta crdisc = sqrt(ToComplex(rc**2 - 4*rb*ra)) cbeta1 = -.5D0/rb*(rc + crdisc) cbeta2 = -.5D0/rb*(rc - crdisc) if( abs(cbeta1) .gt. abs(cbeta2) ) then cbeta2 = ra/(rb*cbeta1) else cbeta1 = cbeta2 cbeta2 = ra/(rb*cbeta2) endif * Ninh added: 14 Aug 2009 * be careful with this approximation, IMG can be wrong if( abs(1 - cbeta1) .lt. precx ) cbeta1 = 1 if( abs(1 - cbeta2) .lt. precx ) cbeta2 = 1 * which one for beta? if( abs(cbeta1) .gt. abs(cbeta2) ) then ctemp = cbeta1 cbeta1 = cbeta2 cbeta2 = ctemp endif * look at the prefactor 1/(S V - T U) * eq. (S V - T U) = K y^2 + L y + N == 0 * to decide which beta is the best. * The two roots are calculated. * Leading Landau Sing. can occur if y1 = y2 and eps -> 0 * the ieps is needed for the roots cbeta = cbeta1 if( abs(cbeta2 - 1) .lt. precx ) then cbeta = cbeta2 cbeta2 = cbeta1 endif call ffwbeta(rb, rc, rg, rh, cd, ce, cf, cj, signf, & cbeta, crdetq4, ny, cy, sy, chketa, rminuv, key, ier) * to check whether there is numerical cancellation * at the border of the triangle if( rminuv .lt. 1D-10 ) then call ffwbeta(rb, rc, rg, rh, cd, ce, cf, cj, signf, & cbeta2, crdetq42, ny2, cy2, sy2, chketa2, rminuv2, & key, ier) if( rminuv2 .lt. rminuv ) then call ffwarn(254, ier, 1D0, 0D0) else * choose the beta2-parameters cbeta = cbeta2 crdetq4 = crdetq42 ny = ny2 do i = 1, ny sy(i) = sy2(i) cy(i) = cy2(i) chketa(i) = chketa2(i) enddo endif endif * the coefficients of the 6 log arguments raj(1) = 0 raj(2) = 0 raj(3) = 0 raj(4) = rb raj(5) = ra + rb + rc raj(6) = ra cbj(1) = rh cbj(2) = rg + rh cbj(3) = rg cbj(4) = rc + ce cbj(5) = ce + cd cbj(6) = cd ccj(1) = rg + cj ccj(2) = cj ccj(3) = cj ccj(4) = ra + cd + cf ccj(5) = cf ccj(6) = cf * the ieps for the log arguments scj = -reps * the cck(6)-coefficients before the logs cck(1) = 1 cck(2) = -1 + cbeta cck(3) = -cbeta cck(4) = -1 cck(5) = 1 - cbeta cck(6) = cbeta if( ny .eq. 0 ) then * no extra term is needed ffTn = -sj/crdetq4*( & cck(1)*ffS2(raj(1), cbj(1), ccj(1), scj, ier) + & cck(2)*ffS2(raj(2), cbj(2), ccj(2), scj, ier) + & cck(3)*ffS2(raj(3), cbj(3), ccj(3), scj, ier) + & cck(4)*ffS2(raj(4), cbj(4), ccj(4), scj, ier) + & cck(5)*ffS2(raj(5), cbj(5), ccj(5), scj, ier) + & cck(6)*ffS2(raj(6), cbj(6), ccj(6), scj, ier) ) return endif * cbk(6)-coefficients of cj/(aj y - bj - yi) cbk(1) = cbeta cbk(2) = 0 cbk(3) = 0 cbk(4) = cbeta cbk(5) = 0 cbk(6) = 0 ffTn = 0 do i = 1, ny cresd = 0 if( chketa(i) .ne. 0 ) then * extra term needed * calculate the residue * the denominator was checked above in ffS3n therefore the (V/T)_pole * should be safe now: ctv = (rh*cy(i) + cj)/(cy(i)*(rb*cy(i) + ce) + cf) ctemp = (rg + cbeta*rh)/ & ((rc + 2*cbeta*rb)*cy(i) + cd + ce*cbeta) if( abs(Im(ctemp)) .gt. abs(Im(ctv)) ) ctv = ctemp * if im(ctv) = 0 then take the ieps from T/V stv = -signf*Re(rh*cy(i) + cj) if( stv .eq. 0 ) stv = -signf ctv = zfflog(ctv, 1, ToComplex(stv), ier) if( abs(ctv) .gt. precx ) then do j = 1, 3 if( abs(cck(j)) .gt. precx ) then cyij = -Sgn(j)*(cy(i) + cbk(j))/cck(j) syij = -Sgn(j)*sy(i)*Re(cck(j)) if( syij .eq. 0 ) syij = sy(i) cresd = cresd - Sgn(i+j)* & zfflog((cyij - 1)/cyij, 1, ToComplex(syij), ier) endif enddo cresd = cresd*ctv endif endif * calculate the main part do j = 1, 6 if( abs(cck(j)) .gt. precx ) then cyij = -Sgn(j)*(cy(i) + cbk(j))/cck(j) syij = -Sgn(j)*sy(i)*Re(cck(j)) if( syij .eq. 0 ) syij = sy(i) cresd = cresd + Sgn(i+j)* & ffS3n(cyij, syij, raj(j), cbj(j), ccj(j), scj, ier) endif enddo ffTn = ffTn + cresd enddo * the prefactor of Landau det. ffTn = sj/crdetq4*ffTn end ************************************************************************ * calculate the roots of the eq. ck x^2 + cl x + cn = 0 * and check if the roots are inside the triangle [0, -cbeta, 1 - cbeta] * the ieps part for the roots is needed. * Nov 17 2008 * input: rb, rc, rg, rh, cd, ce, cf, cj, signf, cbeta * output: ru, rv, ny, cy, signy, ck, cl, cn subroutine ffwbeta(rb, rc, rg, rh, cd, ce, cf, cj, signf, & cbeta, crdetq4, ny, cy, signy, chketa, rminuv, key, ier) implicit none RealType rb, rc, rg, rh, signf, signy(2), rminuv ComplexType cd, ce, cf, cj, cbeta, cy(2), crdetq4 integer ny, chketa(2), key, ier #include "lt.h" ComplexType ck, cl, cn ComplexType cab, cac, cay RealType dotyc, dotyb, dotbc, dotbb, dotcc RealType sn, ru, rv, abc2 integer i chketa(1) = 0 chketa(2) = 0 rminuv = 1D300 ck = rb*rg - rh*(rc + cbeta*rb) cl = rg*ce - rh*cd - cj*(rc + 2*rb*cbeta) cn = (rg + rh*cbeta)*cf - cj*(cd + ce*cbeta) * the ieps for cn sn = signf*Re(rg + rh*cbeta) if( sn .eq. 0 ) sn = signf if( abs(ck) .lt. precx ) then if( abs(cl) .lt. precx ) then * the case ny = 0, (S V - T U) = N = constant if( abs(cn) .lt. precx ) then call fferr(104, ier) cbeta = 0 return endif ny = 0 crdetq4 = cn else * the case ny = 1, (S V - T U) = L y + N ny = 1 cy(1) = -cn/cl * ieps for this pole signy(1) = -sn*Re(cl) if( signy(1) .eq. 0 ) signy(1) = signf crdetq4 = cl endif else * the case ny = 2, (S V - T U) = K y^2 + L y + N ny = 2 crdetq4 = sqrt(cl**2 - 4*ck*cn) cy(1) = -.5D0/ck*(cl + crdetq4) cy(2) = -.5D0/ck*(cl - crdetq4) if( abs(cy(1)) .gt. abs(cy(2)) ) then cy(2) = cn/(ck*cy(1)) else cy(1) = cn/(ck*cy(2)) endif * calculate the sign of img(cy1) and img(cy2) which are related to ieps signy(1) = sn*Re(crdetq4) if( signy(1) .eq. 0 ) signy(1) = signf signy(2) = -signy(1) endif if( ny .eq. 0 .or. abs(Im(cbeta)) .lt. precx ) return if( key .eq. 1 ) then chketa(1) = 1 chketa(2) = 1 else * check if the poles are inside the triangle [0, -cbeta, 1 - cbeta] * using the barycentric technique abc2 = 1/Im(cbeta)**2 do i = 1, ny cay = cy(i) + cbeta cac = cbeta cab = 1 dotyc = Re(cay)*Re(cac) + Im(cay)*Im(cac) dotyb = Re(cay)*Re(cab) + Im(cay)*Im(cab) dotbc = Re(cab)*Re(cac) + Im(cab)*Im(cac) dotcc = Re(cac)*Re(cac) + Im(cac)*Im(cac) dotbb = 1 ru = (dotyc*dotbb - dotbc*dotyb)*abc2 rv = (dotcc*dotyb - dotyc*dotbc)*abc2 if( ru .ge. 0 .and. rv .ge. 0 .and. ru + rv .le. 1 ) & chketa(i) = 1 rminuv = min(rminuv, abs(ru), abs(rv)) enddo endif end ************************************************************************ * calculate T(ra, rc, rg, rh; cd, ce, cf, cj) defined as: * T = \int_0^1 dx \int_0^x dy * 1/( (rg x + rh y + cj) * (ra x^2 + rc x y + cd x + ce y + cf + I signf) ) * with signf = -eps, * {ra, rc, rg, rh} are real, {cd, ce, cf, cj} are complex. * important: variables "signX" is the sign of img(X) in case X becomes real. * No extra term is needed. * Written by Le Duc Ninh, MPI, Munich (2008). * Spence, log and eta functions are taken from FF. * Nov 10 2008 ComplexType function ffT_lin(ra, rc, rg, rh, & cd, ce, cf, cj, signf, reps, ier) implicit none RealType ra, rc, rg, rh, signf, reps ComplexType cd, ce, cf, cj integer ier #include "ff.h" ComplexType ck, cl, cn, cy(2), crdetq4 ComplexType cbj(4), ccj(4) ComplexType ffS3nAll1, ffS3nAll2 RealType sn, scj, sy(2), raj(4) ComplexType ffS2, ffS3n external ffS2, ffS3n * the coefficients of the 4 log arguments raj(1) = rc + ra raj(2) = 0 raj(3) = 0 raj(4) = ra cbj(1) = ce + cd cbj(2) = rh + rg cbj(3) = rg cbj(4) = cd ccj(1) = cf ccj(2) = cj ccj(3) = cj ccj(4) = cf * the ieps is the same for all scj = -reps * the prefactor 1/(S V - T U) * eq. (S V - T U) = K y^2 + L y + N = 0 * Leading Landau Sing. can occur if y1 == y2 and eps -> 0 * the ieps is needed for the roots ck = rh*ra - rc*rg cl = rh*cd - rc*cj - ce*rg cn = rh*cf - ce*cj * the ieps for cn sn = -reps*rh if( sn .eq. 0 ) sn = -reps if( abs(ck) .lt. precx ) then if( abs(cl) .lt. precx ) then if( abs(cn) .lt. precx ) then call fferr(105, ier) ffT_lin = 0 return endif * the case ny = 0, (S V - T U) = N = constant ffT_lin = 1/cn*( & ffS2(raj(1), cbj(1), ccj(1), scj, ier) - & ffS2(raj(2), cbj(2), ccj(2), scj, ier) + & ffS2(raj(3), cbj(3), ccj(3), scj, ier) - & ffS2(raj(4), cbj(4), ccj(4), scj, ier) ) return endif * the case ny = 1, (S V - T U) = L y + N cy(1) = -cn/cl * ieps for this pole sy(1) = -sn*Re(cl) if( sy(1) .eq. 0 ) sy(1) = signf ffS3nAll1 = & ffS3n(cy(1), sy(1), raj(1), cbj(1), ccj(1), scj, ier) - & ffS3n(cy(1), sy(1), raj(2), cbj(2), ccj(2), scj, ier) + & ffS3n(cy(1), sy(1), raj(3), cbj(3), ccj(3), scj, ier) - & ffS3n(cy(1), sy(1), raj(4), cbj(4), ccj(4), scj, ier) ffT_lin = -ffS3nAll1/cl return endif * the case ny = 2, (S V - T U) = K y^2 + L y + N crdetq4 = sqrt(cl**2 - 4*ck*cn) cy(1) = -.5D0/ck*(cl + crdetq4) cy(2) = -.5D0/ck*(cl - crdetq4) if( abs(cy(1)) .gt. abs(cy(2)) ) then cy(2) = cn/(ck*cy(1)) else cy(1) = cn/(ck*cy(2)) endif * calculate the sign of im(cy1) and im(cy2) which are related to ieps sy(1) = sn*Re(crdetq4) if( sy(1) .eq. 0 ) sy(1) = signf sy(2) = -sy(1) ffS3nAll1 = & ffS3n(cy(1), sy(1), raj(1), cbj(1), ccj(1), scj, ier) - & ffS3n(cy(1), sy(1), raj(2), cbj(2), ccj(2), scj, ier) + & ffS3n(cy(1), sy(1), raj(3), cbj(3), ccj(3), scj, ier) - & ffS3n(cy(1), sy(1), raj(4), cbj(4), ccj(4), scj, ier) ffS3nAll2 = & ffS3n(cy(2), sy(2), raj(1), cbj(1), ccj(1), scj, ier) - & ffS3n(cy(2), sy(2), raj(2), cbj(2), ccj(2), scj, ier) + & ffS3n(cy(2), sy(2), raj(3), cbj(3), ccj(3), scj, ier) - & ffS3n(cy(2), sy(2), raj(4), cbj(4), ccj(4), scj, ier) ffT_lin = (ffS3nAll2 - ffS3nAll1)/crdetq4 end LoopTools-2.16/src/D/PaxHeaders/ffdel4.F0000644000000000000000000000007411776502523014714 xustar0030 atime=1648161785.715698398 30 ctime=1648161793.715764879 LoopTools-2.16/src/D/ffdel4.F0000644000000000000000000002071511776502523015634 0ustar00rootroot00000000000000#include "externals.h" #include "types.h" *###[ ffdel4: subroutine ffdel4(del4,piDpj) ***#[*comment:*********************************************************** * * * Calculate del4(piDpj) = det(si.sj) with * * the momenta as follows: * * p(1-4) = s(i) * * p(4-10) = p(i) * * * * Input: piDpj(ns,ns) (real) * * * * Output: del4 (real) det(si.sj) * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments: * RealType del4,piDpj(10,10) * * local variables: * integer mem,nperm parameter(mem=10,nperm=125) integer i,jj(8),iperm(4,nperm),imem,jmem,memarr(mem,4),memind, + inow,jnow,icount RealType s(24),xmax,del4p,xmaxp save iperm,memind,memarr,inow,jnow * * common blocks: * #include "ff.h" * #] declarations: * #[ data: data memind /0/ data memarr /mem*0,mem*0,mem*1,mem*1/ data inow /1/ data jnow /1/ * * these are all permutations that give a non-zero result with the * correct sign. This list was generated with getperm4. * (note: this used to be well-ordened, but then it had more than * 19 continuation lines) * data iperm/ + 1,2,3,4,1,2,3,7,1,2,8,3,1,2,3,10,1,2,6,4,1,2,4,7,1,2,4,9,1,2,6,7 + ,1,2,8,6,1,2,6,10,1,2,7,8,1,2,7,9,1,2,10,7,1,2,9,8,1,2,10,9,1,3, + 4,5,1,3,6,4,1,3,10,4,1,3,7,5,1,3,5,8,1,3,10,5,1,3,6,7,1,3,8,6,1, + 3,6,10,1,3,10,7,1,3,8,10,1,4,5,6,1,4,7,5,1,4,9,5,1,4,6,7,1,4,6,9 + ,1,4,6,10,1,4,10,7,1,4,10,9,1,5,6,7,1,5,8,6,1,5,6,10,1,5,7,8,1,5 + ,7,9,1,5,10,7,1,5,9,8,1,5,10,9,1,6,8,7,1,6,9,7,1,6,8,9,1,6,8,10, + 1,6,9,10,1,7,10,8,1,7,10,9,1,8,9,10,2,3,4,5,2,3,8,4,2,3,9,4,2,3, + 7,5,2,3,5,8,2,3,10,5,2,3,8,7,2,3,9,7,2,3,8,9,2,3,8,10,2,3,9,10,2 + ,4,5,6,2,4,7,5,2,4,9,5,2,4,6,8,2,4,6,9,2,4,8,7,2,4,9,7,2,4,8,9,2 + ,5,6,7,2,5,8,6,2,5,6,10,2,5,7,8,2,5,7,9,2,5,10,7,2,5,9,8,2,5,10, + 9,2,6,8,7,2,6,9,7,2,6,8,9,2,6,8,10,2,6,9,10,2,7,10,8,2,7,10,9,2, + 8,9,10,3,4,5,6,3,4,8,5,3,4,9,5,3,4,5,10,3,4,6,8,3,4,6,9,3,4,10,8 + ,3,4,10,9,3,5,6,7,3,5,8,6,3,5,6,10,3,5,7,8,3,5,7,9,3,5,10,7,3,5, + 9,8,3,5,10,9,3,6,8,7,3,6,9,7,3,6,8,9,3,6,8,10,3,6,9,10,3,7,10,8, + 3,7,10,9,3,8,9,10,4,5,6,7,4,5,8,6,4,5,6,10,4,5,7,8,4,5,7,9,4,5,1 + 0,7,4,5,9,8,4,5,10,9,4,6,8,7,4,6,9,7,4,6,8,9,4,6,8,10,4,6,9,10,4 + ,7,10,8,4,7,10,9,4,8,9,10/ * #] data: * #[ get starting point from memory: * * see if we know were to start, if not: go on as last time * do 5 i=1,mem if ( id .eq. memarr(i,1) .and. idsub .eq. memarr(i,2) ) then inow = memarr(i,3) jnow = memarr(i,4) goto 6 endif 5 continue 6 continue * #] get starting point from memory: * #[ calculations: imem = inow jmem = jnow del4 = 0 xmax = 0 icount = 0 10 continue jj(1) = iperm(1,inow) jj(3) = iperm(2,inow) jj(5) = iperm(3,inow) jj(7) = iperm(4,inow) jj(2) = iperm(1,jnow) jj(4) = iperm(2,jnow) jj(6) = iperm(3,jnow) jj(8) = iperm(4,jnow) s( 1) = +piDpj(jj(1),jj(2))*piDpj(jj(3),jj(4))* + piDpj(jj(5),jj(6))*piDpj(jj(7),jj(8)) s( 2) = +piDpj(jj(1),jj(4))*piDpj(jj(3),jj(6))* + piDpj(jj(5),jj(2))*piDpj(jj(7),jj(8)) s( 3) = +piDpj(jj(1),jj(6))*piDpj(jj(3),jj(2))* + piDpj(jj(5),jj(4))*piDpj(jj(7),jj(8)) s( 4) = -piDpj(jj(1),jj(2))*piDpj(jj(3),jj(6))* + piDpj(jj(5),jj(4))*piDpj(jj(7),jj(8)) s( 5) = -piDpj(jj(1),jj(6))*piDpj(jj(3),jj(4))* + piDpj(jj(5),jj(2))*piDpj(jj(7),jj(8)) s( 6) = -piDpj(jj(1),jj(4))*piDpj(jj(3),jj(2))* + piDpj(jj(5),jj(6))*piDpj(jj(7),jj(8)) s( 7) = -piDpj(jj(1),jj(2))*piDpj(jj(3),jj(4))* + piDpj(jj(7),jj(6))*piDpj(jj(5),jj(8)) s( 8) = -piDpj(jj(1),jj(4))*piDpj(jj(3),jj(6))* + piDpj(jj(7),jj(2))*piDpj(jj(5),jj(8)) s( 9) = -piDpj(jj(1),jj(6))*piDpj(jj(3),jj(2))* + piDpj(jj(7),jj(4))*piDpj(jj(5),jj(8)) s(10) = +piDpj(jj(1),jj(2))*piDpj(jj(3),jj(6))* + piDpj(jj(7),jj(4))*piDpj(jj(5),jj(8)) s(11) = +piDpj(jj(1),jj(6))*piDpj(jj(3),jj(4))* + piDpj(jj(7),jj(2))*piDpj(jj(5),jj(8)) s(12) = +piDpj(jj(1),jj(4))*piDpj(jj(3),jj(2))* + piDpj(jj(7),jj(6))*piDpj(jj(5),jj(8)) s(13) = -piDpj(jj(1),jj(2))*piDpj(jj(7),jj(4))* + piDpj(jj(5),jj(6))*piDpj(jj(3),jj(8)) s(14) = -piDpj(jj(1),jj(4))*piDpj(jj(7),jj(6))* + piDpj(jj(5),jj(2))*piDpj(jj(3),jj(8)) s(15) = -piDpj(jj(1),jj(6))*piDpj(jj(7),jj(2))* + piDpj(jj(5),jj(4))*piDpj(jj(3),jj(8)) s(16) = +piDpj(jj(1),jj(2))*piDpj(jj(7),jj(6))* + piDpj(jj(5),jj(4))*piDpj(jj(3),jj(8)) s(17) = +piDpj(jj(1),jj(6))*piDpj(jj(7),jj(4))* + piDpj(jj(5),jj(2))*piDpj(jj(3),jj(8)) s(18) = +piDpj(jj(1),jj(4))*piDpj(jj(7),jj(2))* + piDpj(jj(5),jj(6))*piDpj(jj(3),jj(8)) s(19) = -piDpj(jj(7),jj(2))*piDpj(jj(3),jj(4))* + piDpj(jj(5),jj(6))*piDpj(jj(1),jj(8)) s(20) = -piDpj(jj(7),jj(4))*piDpj(jj(3),jj(6))* + piDpj(jj(5),jj(2))*piDpj(jj(1),jj(8)) s(21) = -piDpj(jj(7),jj(6))*piDpj(jj(3),jj(2))* + piDpj(jj(5),jj(4))*piDpj(jj(1),jj(8)) s(22) = +piDpj(jj(7),jj(2))*piDpj(jj(3),jj(6))* + piDpj(jj(5),jj(4))*piDpj(jj(1),jj(8)) s(23) = +piDpj(jj(7),jj(6))*piDpj(jj(3),jj(4))* + piDpj(jj(5),jj(2))*piDpj(jj(1),jj(8)) s(24) = +piDpj(jj(7),jj(4))*piDpj(jj(3),jj(2))* + piDpj(jj(5),jj(6))*piDpj(jj(1),jj(8)) del4p = 0 xmaxp = 0 do 20 i=1,24 del4p = del4p + s(i) xmaxp = max(xmaxp,abs(s(i))) 20 continue if ( abs(del4p) .lt. xloss*xmaxp ) then if ( inow .eq. imem .or. xmaxp .lt. xmax ) then del4 = del4p xmax = xmaxp endif * as the list is ordered we may have more luck stepping * through with large steps inow = inow + 43 jnow = jnow + 49 if ( inow .gt. nperm ) inow = inow - nperm if ( jnow .gt. nperm ) jnow = jnow - nperm icount = icount + 1 if ( icount.gt.15 .or. inow.eq.imem .or. jnow.eq.jmem + ) goto 800 goto 10 endif del4 = del4p xmax = xmaxp * #] calculations: * #[ into memory: memind = memind + 1 if ( memind .gt. mem ) memind = 1 memarr(memind,1) = id memarr(memind,2) = idsub memarr(memind,3) = inow memarr(memind,4) = jnow 800 continue * #] into memory: *###] ffdel4: end *###[ ffdl3p: subroutine ffdl3p(dl3p,piDpj,ns,ii,jj) ***#[*comment:*********************************************************** * calculate in a numerically stable way * * * * p1 p2 p3 * * delta * * p1' p2' p3' * * * * with pn = xpi(ii(n)), p4 = -p1-p2-p3, p5 = -p1-p2, p6 = p2+p3 * * with pn'= xpi(jj(n)), p4'= etc. (when ns=15 p5=p1+p2) * * * * Input: piDpj real(ns,ns) dotpruducts * * ns integer either 10 or 15 * * ii,jj integer(6) location of pi in piDpj * * Output: dl3p real see above * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments: * integer ns,ii(6),jj(6) RealType dl3p,piDpj(ns,ns) * * local variables * integer i,j,k,l,iperm(3,16),ii1,ii2,ii3,jj1,jj2,jj3,i0 logical lsymm RealType s(6),som,xmax,smax,trylos * * common blocks * #include "ff.h" * * data * data iperm /1,2,3, 2,4,3, 3,4,1, 4,2,1, + 1,2,6, 6,4,3, 3,1,6, 2,4,6, + 2,5,3, 5,4,1, 1,3,5, 2,4,5, + 1,6,5, 2,5,6, 3,6,5, 4,5,6/ * #] declarations: * #[ calculations: if ( ii(1).eq.jj(1) .and. ii(2).eq.jj(2) .and. ii(3).eq.jj(3) ) + then * * symmetric - fewer possibilities * lsymm = .TRUE. else lsymm = .FALSE. endif * * try all (8.5,16)*16 permutations * xmax = 0 trylos = 1 do 101 l=1,16 if ( lsymm ) then i0 = l else i0 = 1 endif do 100 i=i0,16 ii1 = ii(iperm(1,i)) ii2 = ii(iperm(2,i)) ii3 = ii(iperm(3,i)) j = i+l-1 if ( j .gt. 16 ) j=j-16 jj1 = jj(iperm(1,j)) jj2 = jj(iperm(2,j)) jj3 = jj(iperm(3,j)) s(1) = +piDpj(ii1,jj1)*piDpj(ii2,jj2)*piDpj(ii3,jj3) s(2) = +piDpj(ii2,jj1)*piDpj(ii3,jj2)*piDpj(ii1,jj3) s(3) = +piDpj(ii3,jj1)*piDpj(ii1,jj2)*piDpj(ii2,jj3) s(4) = -piDpj(ii1,jj1)*piDpj(ii3,jj2)*piDpj(ii2,jj3) s(5) = -piDpj(ii3,jj1)*piDpj(ii2,jj2)*piDpj(ii1,jj3) s(6) = -piDpj(ii2,jj1)*piDpj(ii1,jj2)*piDpj(ii3,jj3) som = 0 smax = 0 do 80 k=1,6 som = som + s(k) smax = max(smax,abs(som)) 80 continue if ( ns .eq. 15 .and. (i.gt.8 .neqv. j.gt.8) ) + som = -som if ( i .eq. 1 .or. smax .lt. xmax ) then dl3p = som xmax = smax endif if ( abs(dl3p) .ge. xloss*smax ) goto 110 * give up a bit more easily if I have tried many times if ( trylos*abs(dl3p) .ge. xloss*smax ) goto 109 trylos = trylos*1.3D0 100 continue 101 continue 109 continue 110 continue * #] calculations: *###] ffdl3p: end LoopTools-2.16/src/D/PaxHeaders/ffxd0p.F0000644000000000000000000000007411776502523014737 xustar0030 atime=1648161785.715698398 30 ctime=1648161793.715764879 LoopTools-2.16/src/D/ffxd0p.F0000644000000000000000000004230711776502523015660 0ustar00rootroot00000000000000#include "externals.h" #include "types.h" *(##[ ffxd0p: subroutine ffxd0p(cs4,ipi12,isoort,cfac,xpi,dpipj,piDpj, + xqi,dqiqj,qiDqj,ai,daiaj,ldel2s,ier) ***#[*comment:*********************************************************** * * * calculate D0/pi^2/(A1*A2*A3*A4/dt3t4) * * * * = C0(t1,t2,t3) - C0(t1,t2,t4) * * * * The transformed momenta of the fourpoint functions are * * input. * * * * Input: xpi(10) untransformed fourpoint momenta * * dpipj(10,10) differences of xpi * * piDpj(10,10) dotproducts of xpi * * xqi(10) transformed fourpoint momenta * * dqiqj(10,10) differences of xqi * * qiDqj(10,10) dotproducts of xqi * * ai(4) the transformation parameters * * daiaj(4,4) their deifferences * * ldel2s if .TRUE. we took out factors delta * * * * Output: cs4(170) not added (assumed 0 on input) * * cfac the factor of cs4 from C0 (ie lam(pi)) * * ier 0=ok 1=inaccurate 2=error * * * * Calls: ffxc0p,ffpi34,ffxhck,ffdl3m,ffdel2,... * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments * ComplexType cs4(175),cfac integer ipi12(28),isoort(16),ier logical ldel2s RealType xpi(10),dpipj(10,10),piDpj(10,10), + xqi(10),dqiqj(10,10),qiDqj(10,10),ai(4),daiaj(4,4) * * local variables * integer i,j,k,ip,jp,m,ilogi(6),ii(6,2),jj(6,2),ier0,ier1 ComplexType c,clogi(6),cipi RealType xpi3(6,3:4),dpipj3(6,6,3:4),piDpj3(6,6,3:4), + del2,del2s(3,3:4),del3(3:4),del3mi(6,3:4), + del4,etalam(3:4),etami(6,3:4),ddel2s(2:3),delpsi(3,3:4), + alph(3),blph(3),sdel2,hulp,som,s(4),smax,xmax ComplexType cpi(6,3:4),cpiDpj(6,6,3:4),cdpipj(6,6,3:4), + cetalm(3:4),cetami(6,3:4),calph(3),csdel2, + cel2s(3,3:4),celpsi(3,3:4),zqi(10),zqiDqj(10,10), + cddl2s(2:3) logical lcroot save ii,jj * * common blocks: * #include "ff.h" * * data * data ii/1,2,3,5,6,9,1,2,3,5,6,9/ data jj/1,2,4,5,10,8,1,2,4,5,10,8/ * * #] declarations: * #[ preparation: * Note that the piDpj3(,,3) contain now the threepoint function * with s3, (,,4) with s4 (and NOT *without* as before) call ffpi43(xpi3(1,3),dpipj3(1,1,3),piDpj3(1,1,3), + xqi,dqiqj,qiDqj,7-3) call ffpi43(xpi3(1,4),dpipj3(1,1,4),piDpj3(1,1,4), + xqi,dqiqj,qiDqj,7-4) * * set the logarithms to be calculated to -999 * do 40 i=1,6 clogi(i) = 0 ilogi(i) = 0 40 continue if ( ai(1) .lt. 0 .neqv. ai(2) .lt. 0 ) then ilogi(1) = -999 ilogi(4) = -999 endif if ( ai(2) .lt. 0 .neqv. ai(3) .lt. 0 ) then ilogi(2) = -999 endif if ( ai(3) .lt. 0 .neqv. ai(1) .lt. 0 ) then ilogi(3) = -999 endif if ( ai(2) .lt. 0 .neqv. ai(4) .lt. 0 ) then ilogi(5) = -999 endif if ( ai(4) .lt. 0 .neqv. ai(1) .lt. 0 ) then ilogi(6) = -999 endif * * #] preparation: * #[ determinants: * * some determinants * * note that not all errors are additive, only when a previous * result is used as input do we need to add ther ier's, otherwise * we can take the maximum value to get a decent estimate of the * number of digits lost. * ier1 = ier if ( .not.ldel2s ) then ier0 = ier call ffdel2(del2,qiDqj,10, 5,6,9, 0,ier0) ier1 = max(ier1,ier0) else s(1) = xqi(5)*xqi(3) s(2) = qiDqj(5,3)**2 del2 = s(1) - s(2) if ( abs(del2) .lt. xloss*s(2) ) ier1 = 100 endif if ( ier1 .ne. ier ) then ier0 = ier call ffdel4(del4,piDpj) if ( ldel2s ) then hulp = -(ai(1)*ai(2)*ai(3)*ai(4)/xqi(3))**2 * del4 else hulp = -(2*ai(1)*ai(2)*ai(3)*ai(4)/dqiqj(3,4))**2 * del4 endif del2 = hulp ier1 = ier0 fdel4s = del4 else if ( ldel2s ) then fdel4s = -del2*(xqi(3)/ai(1)*ai(2)*ai(3)*ai(4))**2 else fdel4s=-del2*(dqiqj(3,4)/(2*ai(1)*ai(2)*ai(3)*ai(4)))**2 endif endif if ( del2 .gt. 0 ) then * use complex routines * call fferr(44,ier) lcroot = .TRUE. sdel2 = isgnal*sqrt(del2) csdel2 = ToComplex(0D0,sdel2) elseif ( del2 .eq. 0 ) then call fferr(45,ier) else lcroot = .FALSE. sdel2 = isgnal*sqrt(-del2) endif ier0 = ier call ffdl3s(del3(3),piDpj,ii,10) ier1 = max(ier0,ier1) ier0 = ier call ffdl3s(del3(4),piDpj,jj,10) ier1 = max(ier1,ier0) del3(3) = ai(1)**2*ai(2)**2*ai(3)**2*del3(3) del3(4) = ai(1)**2*ai(2)**2*ai(4)**2*del3(4) do 108 m=3,4 ier0 = ier if ( .not.ldel2s ) then call ffdl3m(del3mi(1,m),.TRUE.,del3(m),del2,xpi3(1,m) + ,dpipj3(1,1,m),piDpj3(1,1,m), 6, 4,5,6,1,3) else * * the special case del2s = 0. Note that del3mi(i) and * del3mi(i+3) are used in S_{i-1}. * call ffdl3m(del3mi(1,m),.FALSE.,0D0,0D0,xpi3(1,m), + dpipj3(1,1,m),piDpj3(1,1,m), 6, 4,3,0, 1,2) ier1= max(ier1,ier0) ier0 = ier call ffdl3m(del3mi(5,m),.FALSE.,0D0,0D0,xpi3(1,m), + dpipj3(1,1,m),piDpj3(1,1,m), 6, 4,3,0, 5,2) del3mi(3,m) = 0 del3mi(4,m) = 0 endif ier1 = max(ier1,ier0) do 105 i=1,3 j = i+1 if ( j .eq. 4 ) j = 1 ip = i jp = j if ( m .eq. 4 ) then if ( jp .eq. 3 ) jp = 4 if ( ip .eq. 3 ) ip = 4 endif if ( i.eq.1 .and. m.eq.4 ) then del2s(1,4) = del2s(1,3) else ier0 = ier call ffdel2(del2s(i,m),piDpj,10,inx(ip,jp),ip, + jp,1,ier0) del2s(i,m) = ai(ip)**2*ai(jp)**2*del2s(i,m) ier1 = max(ier1,ier0) endif k = i-1 if ( k .eq. 0 ) k = 3 ier0 = ier if ( .not.ldel2s ) then call ffdl2p(delpsi(i,m),xpi3(1,m),dpipj3(1,1,m), + piDpj3(1,1,m),i+3,j+3,k+3,i,j,k,6) else call ffdl2t(delpsi(i,m),qiDqj, m,5, ip,jp,inx(ip,jp) + ,+1,+1, 10) endif ier1 = max(ier1,ier0) etami(i,m) = del3mi(i,m)/del2 if ( ldel2s .and. i.gt.1 ) + etami(i+3,m) = del3mi(i+3,m)/del2 105 continue etalam(m) = del3(m)/del2 108 continue * * the error analysis * ier = ier1 * * get alpha,1-alpha * if ( .not. lcroot ) then if ( .not.ldel2s ) then if ( xpi3(5,3).eq.0 .and. (piDpj3(5,6,3).gt.0 .eqv. + sdel2.gt.0) ) then alph(1) = -xpi3(6,3)/(piDpj3(5,6,3)+sdel2) alph(3) = -xpi3(4,3)/(piDpj3(5,4,3)-sdel2) else call ffroot(blph(1),alph(1),xpi3(5,3), + -piDpj3(5,6,3),xpi3(6,3),sdel2,ier) call ffroot(alph(3),blph(3),xpi3(5,3), + -piDpj3(5,4,3),xpi3(4,3),sdel2,ier) endif * We cannot change the sign as it is fixed by the choice * of sign in fftrans (sqrt(delta(s3,s4))) WRONG * if ( l4also .and. ( alph(1) .gt. 1 .or. alph(1) .lt. 0 * + ) .and. abs(blph(1)-.5D0) .lt. abs(alph(1)-.5D0) ) then * alph(1) = blph(1) * alph(3) = blph(3) * sdel2 = -sdel2 * isgnal = -isgnal * endif else alph(1) = 1 alph(3) = 0 endif cfac = 2*sdel2 else do 4 k=3,4 do 3 i=1,6 cpi(i,k) = xpi3(i,k) do 2 j=1,6 cdpipj(j,i,k) = dpipj3(j,i,k) cpiDpj(j,i,k) = piDpj3(j,i,k) 2 continue 3 continue 4 continue if ( .not.ldel2s ) then call ffcoot(c,calph(1),cpi(5,3),-cpiDpj(5,6,3), + cpi(6,3),csdel2,ier) call ffcoot(calph(3),c,cpi(5,3),-cpiDpj(5,4,3), + cpi(4,3),csdel2,ier) else calph(1) = 1 calph(3) = 0 endif cfac = 2*csdel2 endif * #] determinants: * #[ convert to complex: if ( lcroot ) then do 110 k=3,4 cetalm(k) = etalam(k) do 109 i=1,3 cel2s(i,k) = del2s(i,k) celpsi(i,k) = delpsi(i,k) cetami(i,k) = etami(i,k) 109 continue 110 continue endif * #] convert to complex: * #[ simple case: if ( ldel2s .or. abs(dqiqj(3,4)) .lt. xloss*abs(xqi(3)) ) then if ( .not.lsmug .and. (ldel2s .or. ldc3c4) ) goto 500 endif * * and the calculations * ier0 = ier ier1 = ier if ( lcroot ) then call ffcc0p(cs4( 1),ipi12(1),isoort(1),clogi(1),ilogi(1), + cpi(1,3),cdpipj(1,1,3),cpiDpj(1,1,3),csdel2,cel2s(1,3), + cetalm(3),cetami(1,3),celpsi(1,3),calph,4,ier0) call ffcc0p(cs4(81),ipi12(9),isoort(9),clogi(4),ilogi(4), + cpi(1,4),cdpipj(1,1,4),cpiDpj(1,1,4),csdel2,cel2s(1,4), + cetalm(4),cetami(1,4),celpsi(1,4),calph,4,ier1) else if ( lsmug ) call ffsm43(xpi3(1,3),7-3) call ffxc0p(cs4( 1),ipi12(1),isoort(1),clogi(1),ilogi(1), + xpi3(1,3),dpipj3(1,1,3),piDpj3(1,1,3),sdel2,del2s(1,3), + etalam(3),etami(1,3),delpsi(1,3),alph,4,ier0) if ( lsmug ) call ffsm43(xpi3(1,4),7-4) call ffxc0p(cs4(81),ipi12(9),isoort(9),clogi(4),ilogi(4), + xpi3(1,4),dpipj3(1,1,4),piDpj3(1,1,4),sdel2,del2s(1,4), + etalam(4),etami(1,4),delpsi(1,4),alph,4,ier1) endif ier = max(ier0,ier1) goto 600 * #] simple case: * #[ cancellations: 500 continue * * There are cancellations between the dilogarithms or the vertex * is on threshold. * we need the differences ddel2s(i) = del2s(i,3)-del2s(i,4) * do 510 i=2,3 if ( i .eq. 2 ) then j = 2 else j = 1 endif ddel2s(i) = del2s(i,3) - del2s(i,4) xmax = abs(del2s(i,3)) if ( abs(ddel2s(i)) .ge. xloss*xmax ) goto 510 * * Very first try with transformation * s(1) = (ai(3)+ai(4))*daiaj(3,4)*del2s(i,3)/ai(3)**2 s(2) = ai(j)**2*ai(4)**2*xpi(j)*dpipj(3,4) s(3) = ai(j)**2*ai(4)**2*piDpj(j,7)*piDpj(j,3) s(4) = ai(j)**2*ai(4)**2*piDpj(j,7)*piDpj(j,4) som = s(1) + s(2) + s(3) + s(4) smax = max(abs(s(1)),abs(s(2)),abs(s(3)),abs(s(4))) if ( abs(som) .ge. xloss*smax ) goto 510 if ( smax .lt. xmax ) then ddel2s(i) = som xmax = smax endif 510 continue if ( .not. lcroot ) then call ffdxc0(cs4,ipi12,isoort,clogi,ilogi,xpi3,dpipj3,piDpj3, + xqi,qiDqj,sdel2,del2s,etalam,etami,delpsi,alph, + ddel2s,ldel2s,4,ier) else cddl2s(2) = ddel2s(2) cddl2s(3) = ddel2s(3) do 530 i=1,10 zqi(i) = xqi(i) do 520 j=1,10 zqiDqj(j,i) = qiDqj(j,i) 520 continue 530 continue call ffdcc0(cs4,ipi12,isoort,clogi,ilogi,cpi,cpiDpj, + zqi,zqiDqj,csdel2,cel2s,cetalm,cetami,celpsi, + calph,cddl2s,ldel2s,4,ier) endif 600 continue * #] cancellations: * #[ Ai<0 terms: cipi = ToComplex(0D0,pi) if ( ai(3) .lt. 0 .neqv. ai(4) .lt. 0 ) then * we need the S term if ( ai(1) .lt. 0 .eqv. ai(2) .lt. 0 ) then if ( lcroot ) then call ffcxra(cs4(167),ipi12(23),xqi,qiDqj,sdel2,1,ier) else * call ffxtro(cs4(167),ipi12(23),xqi,qiDqj,sdel2,1,ier) call ffxtra(cs4(167),ipi12(23),xqi,qiDqj,sdel2,1,ier) endif else if ( lcroot ) then call ffcxra(cs4(167),ipi12(23),xqi,qiDqj,sdel2,2,ier) call ffcxra(cs4(169),ipi12(26),xqi,qiDqj,sdel2,3,ier) else call ffxtra(cs4(167),ipi12(23),xqi,qiDqj,sdel2,2,ier) call ffxtra(cs4(169),ipi12(26),xqi,qiDqj,sdel2,3,ier) * call ffxtro(cs4(167),ipi12(23),xqi,qiDqj,sdel2,2,ier) * call ffxtro(cs4(169),ipi12(26),xqi,qiDqj,sdel2,3,ier) endif endif endif * * The normal correction terms * if ( ai(1) .lt. 0 .neqv. ai(2) .lt. 0 ) then cs4(161) = -cipi*clogi(1) ipi12(17) = 12*ilogi(1) if ( ilogi(1) .eq. -999 ) call fferr(46,ier) cs4(164) = cipi*clogi(4) ipi12(20) = -12*ilogi(4) if ( ilogi(4) .eq. -999 ) call fferr(46,ier) endif if ( ai(2) .lt. 0 .neqv. ai(3) .lt. 0 ) then cs4(162) = -cipi*clogi(2) ipi12(18) = 12*ilogi(2) if ( ilogi(2) .eq. -999 ) call fferr(46,ier) endif if ( ai(3) .lt. 0 .neqv. ai(1) .lt. 0 ) then cs4(163) = -cipi*clogi(3) ipi12(19) = 12*ilogi(3) if ( ilogi(3) .eq. -999 ) call fferr(46,ier) endif if ( ai(2) .lt. 0 .neqv. ai(4) .lt. 0 ) then cs4(165) = cipi*clogi(5) ipi12(21) = -12*ilogi(5) if ( ilogi(5) .eq. -999 ) call fferr(46,ier) endif if ( ai(4) .lt. 0 .neqv. ai(1) .lt. 0 ) then cs4(166) = cipi*clogi(6) ipi12(22) = -12*ilogi(6) if ( ilogi(6) .eq. -999 ) call fferr(46,ier) endif * #] Ai<0 terms: *###] ffxd0p: end *###[ ffpi43: subroutine ffpi43(xpi3,dpipj3,piDpj3,xpi,dpipj,piDpj,imiss) ***#[*comment:*********************************************************** * * * Fill the threepoint arrays xpi3 and dpipj3 with masses from the * * the fourpoint array xpi with leg imiss cut out. * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments * RealType xpi3(6),dpipj3(6,6),piDpj3(6,6) RealType xpi(10),dpipj(10,10),piDpj(10,10) integer imiss * * local variables * integer i,j integer iinx(6,4) save iinx * * common blocks * #include "ff.h" * * data * data iinx /2,3,4,6,7,10, + 1,3,4,9,7,8, + 1,2,4,5,10,8, + 1,2,3,5,6,9/ * #] declarations: * #[ calculations: do 20 i=1,6 xpi3(i) = xpi(iinx(i,imiss)) do 10 j=1,6 dpipj3(j,i) = dpipj(iinx(j,imiss),iinx(i,imiss)) piDpj3(j,i) = piDpj(iinx(j,imiss),iinx(i,imiss)) 10 continue 20 continue * #] calculations: *###] ffpi43: end *###[ ffxtra: subroutine ffxtra(cs4,ipi12,xqi,qiDqj,sdel2,ii,ier) ***#[*comment:*********************************************************** * * * calculate the extra terms S_ii^{\infty\prime}, put them in * * cs4 and ipi12. * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments * integer ipi12(3),ii,ier ComplexType cs4(3) RealType xqi(10),qiDqj(10,10),sdel2 * * local variables * integer i,ip(5) RealType x(2,3),dfflo1,s,s1 external dfflo1 * * common blocks * #include "ff.h" * * data * data ip/5,6,8,5,6/ * #] declarations: * #[ calculations: if ( ii .eq. 3 ) return do 10 i=1,3 if ( ii .eq. 1 .and. i .eq. 2 ) goto 10 call ffroot(x(1,i),x(2,i),xqi(ip(i)),-qiDqj(ip(i), + ip(i+1)),xqi(ip(i+1)),sdel2,ier) s = -x(2,i)/x(1,i) if ( abs(s-1) .lt. xloss ) then s1 = dfflo1(-2*qiDqj(ip(i),ip(i+1))/(xqi(ip(i))*x(1,i)), + ier) elseif ( s .gt. 0 ) then s1 = log(s) else if ( abs(s+1) .lt. xloss ) then s1 = dfflo1(-2*sdel2/(xqi(ip(i))*x(1,i)),ier) else s1 = log(-s) endif * also here an minus sign (-i*pi*log(-(p.p-sqrt)/(p.p+sqrt))) if ( qiDqj(ip(i),ip(i+1))*xqi(ip(i))*sdel2 .gt. 0 ) then ipi12(i) = +12 else ipi12(i) = -12 endif * ier = ier + 50 * print *,'ffxtra: imaginary part may well be wrong -> ', * + 'n*pi^2 fout' * print *,' ipi12(i) = ',ipi12(i) * print *,' qiDqj = ',qiDqj(ip(i),ip(i+1)) * print *,' qi^2 = ',xqi(ip(i)) endif * there is an overall minus compared with Veltman cs4(i) = ToComplex(0D0,-pi*s1) if ( sdel2 .lt. 0 ) then cs4(i) = -cs4(i) ipi12(i) = -ipi12(i) endif if ( ii .ne. 1 ) then cs4(i) = -cs4(i) ipi12(i) = -ipi12(i) endif if ( i .eq. 2 ) then cs4(i) = 2*cs4(i) ipi12(i) = 2*ipi12(i) endif 10 continue * #] calculations: *###] ffxtra: end *###[ ffcxra: subroutine ffcxra(cs4,ipi12,xqi,qiDqj,sdel2,ii,ier) ***#[*comment:*********************************************************** * * * calculate the extra terms S_ii^{\infty\prime}, put them in * * cs4 and ipi12 for qi real but sdel2 complex. * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments * integer ipi12(3),ii,ier ComplexType cs4(3) RealType xqi(10),qiDqj(10,10),sdel2 * * local variables * integer i,ip(5) ComplexType x(2,3),zfflo1,s,s1,c RealType absc external zfflo1 * * common blocks * #include "ff.h" * * data * data ip/5,6,8,5,6/ * * statement function * absc(c) = abs(Re(c)) + abs(Im(c)) * #] declarations: * #[ calculations: if ( ii .eq. 3 ) return do 10 i=1,3 if ( ii .eq. 1 .and. i .eq. 2 ) goto 10 x(1,i) = ToComplex(-qiDqj(ip(i),ip(i+1))/xqi(ip(i)), + -sdel2/xqi(ip(i))) x(2,i) = ToComplex(-qiDqj(ip(i),ip(i+1))/xqi(ip(i)), + +sdel2/xqi(ip(i))) s = -x(2,i)/x(1,i) c = s-1 if ( absc(c) .lt. xloss ) then s1 = zfflo1(Re(-2*qiDqj(ip(i),ip(i+1))/xqi(ip(i)))/ + x(1,i),ier) elseif ( abs(s+1) .lt. xloss ) then s1 = zfflo1(ToComplex(0D0,-2*sdel2/xqi(ip(i)))/x(1,i),ier) if ( Im(c).gt.0 ) then ipi12(i) = +12 else ipi12(i) = -12 endif else s1 = log(s) endif * there is an overall minus compared with Veltman cs4(i) = ToComplex(pi*Im(s1),-pi*Re(s1)) if ( ii .ne. 1 ) then cs4(i) = -cs4(i) ipi12(i) = -ipi12(i) endif if ( sdel2 .lt. 0 ) then cs4(i) = -cs4(i) ipi12(i) = -ipi12(i) endif if ( i .eq. 2 ) then cs4(i) = 2*cs4(i) ipi12(i) = 2*ipi12(i) endif 10 continue * #] calculations: *###] ffcxra: end *###[ ffsm43: subroutine ffsm43(xpi3,imiss) ***#[*comment:*********************************************************** * * * Distribute the smuggled 4point momenta to the 3point smuggled * * momenta. Note that because of the common block smuggling this * * cannot be included in ffpi43. * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments * integer imiss RealType xpi3(6) * * local variables * integer i,j,iinx(6,4) save iinx * * common blocks * #include "ff.h" * * data * data iinx /2,3,4,6,7,10, + 1,3,4,9,7,8, + 1,2,4,5,10,8, + 1,2,3,5,6,9/ * * #] declarations: * #[ parcel out: if ( lsmug ) then * * parcel out the smuggled diffs * do 30 i=1,3 j = mod(i,3)+1 if ( xpi3(j) .eq. 0 ) then cmipj(i,i) = c2sisj(iinx(i,imiss),iinx(j,imiss)) elseif ( xpi3(i) .eq. 0 ) then cmipj(j,i) = c2sisj(iinx(i,imiss),iinx(j,imiss)) endif 30 continue endif * #] parcel out: *)##] ffsm43: end LoopTools-2.16/src/D/PaxHeaders/ffT13.F0000644000000000000000000000007411776502523014433 xustar0030 atime=1648161785.715698398 30 ctime=1648161793.715764879 LoopTools-2.16/src/D/ffT13.F0000644000000000000000000000655211776502523015356 0ustar00rootroot00000000000000* ffT13.F * part of the complex four-point function * this file is part of LoopTools * last modified 8 Dec 10 th #include "externals.h" #include "types.h" * T13 = \int_0^1 dx \int_0^x dy * y/( (rg y^2 + rh xy + cd x + cj y + cf + I signf) * * (ra y^2 + rc xy + cd x + ce y + cf + I signf) ) * with signf = -eps * variables "signX" is the sign of im(X) in case X becomes real. * No extra term is needed. * Nov 11 2008 ComplexType function ffT13(ra, rc, rg, rh, & cd, ce, cf, signf, cj, ier) implicit none RealType ra, rc, rg, rh, signf ComplexType cd, ce, cf, cj integer ier #include "ff.h" ComplexType ck, cl, cn, cy(2), crdetq4 ComplexType cbj(4), ccj(4) ComplexType ffS3nAll1, ffS3nAll2 RealType sn, scj, sy(2), raj(4) ComplexType ffS2, ffS3n external ffS2, ffS3n * the coefficients of the 4 log arguments raj(1) = ra raj(2) = rg raj(3) = rg + rh raj(4) = ra + rc cbj(1) = ce + rc cbj(2) = cj + rh cbj(3) = cd + cj cbj(4) = ce + cd ccj(1) = cf + cd ccj(2) = cf + cd ccj(3) = cf ccj(4) = cf * the ieps is the same for all scj = signf * the prefactor 1/(S V - T U) * eq. (S V - T U) = K y^2 + L y + N == 0 * Leading Landau singularity can occur if y1 = y2 and eps -> 0 * the ieps is needed for the roots ck = rh*ra - rc*rg cl = (ra - rg)*cd + rh*ce - rc*cj cn = (rh - rc)*cf + cd*(ce - cj) * the ieps for cn sn = signf*(rh - rc) * if (rh - rc) = 0 then we are at the boundary of phase space * and sn is irrelevant if( abs(ck) .lt. precx ) then if( abs(cl) .lt. precx ) then if( abs(cn) .lt. precx ) then call fferr(99, ier) ffT13 = 0 return endif * the case ny = 0, (SV - TU) = N = constant * no extra term is needed ffT13 = -1/cn*( & ffS2(raj(1), cbj(1), ccj(1), scj, ier) - & ffS2(raj(2), cbj(2), ccj(2), scj, ier) + & ffS2(raj(3), cbj(3), ccj(3), scj, ier) - & ffS2(raj(4), cbj(4), ccj(4), scj, ier) ) return endif * the case ny = 1, (S V - T U) = L y + N cy(1) = -cn/cl * ieps for this root sy(1) = -sn*Re(cl) if( sy(1) .eq. 0 ) sy(1) = signf ffS3nAll1 = & ffS3n(cy(1), sy(1), raj(1), cbj(1), ccj(1), scj, ier) - & ffS3n(cy(1), sy(1), raj(2), cbj(2), ccj(2), scj, ier) + & ffS3n(cy(1), sy(1), raj(3), cbj(3), ccj(3), scj, ier) - & ffS3n(cy(1), sy(1), raj(4), cbj(4), ccj(4), scj, ier) ffT13 = -ffS3nAll1/cl return endif * the case ny = 2, (SV - TU) = K y^2 + L y + N crdetq4 = sqrt(cl**2 - 4*ck*cn) cy(1) = -.5D0/ck*(cl + crdetq4) cy(2) = -.5D0/ck*(cl - crdetq4) if( abs(cy(1)) .gt. abs(cy(2)) ) then cy(2) = cn/(ck*cy(1)) else cy(1) = cn/(ck*cy(2)) endif * calculate the signs of img(cy1) and img(cy2) which are related to ieps sy(1) = sn*Re(crdetq4) if( sy(1) .eq. 0 ) sy(1) = signf sy(2) = -sy(1) ffS3nAll1 = & ffS3n(cy(1), sy(1), raj(1), cbj(1), ccj(1), scj, ier) - & ffS3n(cy(1), sy(1), raj(2), cbj(2), ccj(2), scj, ier) + & ffS3n(cy(1), sy(1), raj(3), cbj(3), ccj(3), scj, ier) - & ffS3n(cy(1), sy(1), raj(4), cbj(4), ccj(4), scj, ier) ffS3nAll2 = & ffS3n(cy(2), sy(2), raj(1), cbj(1), ccj(1), scj, ier) - & ffS3n(cy(2), sy(2), raj(2), cbj(2), ccj(2), scj, ier) + & ffS3n(cy(2), sy(2), raj(3), cbj(3), ccj(3), scj, ier) - & ffS3n(cy(2), sy(2), raj(4), cbj(4), ccj(4), scj, ier) ffT13 = (ffS3nAll1 - ffS3nAll2)/crdetq4 end LoopTools-2.16/src/D/PaxHeaders/D0funcC.F0000644000000000000000000000013214044043405014753 xustar0030 mtime=1620068101.325037443 30 atime=1648161785.715698398 30 ctime=1648161793.715764879 LoopTools-2.16/src/D/D0funcC.F0000644000000000000000000006027014044043405015700 0ustar00rootroot00000000000000* D0funcC.F * the scalar four-point function with complex masses * this file is part of LoopTools * last modified 3 May 21 th #include "externals.h" #include "types.h" #define npoint 4 #include "defs.h" subroutine D0funcC(res, res00, para) implicit none ComplexType res(0:2), res00(0:2), para(1,*) #include "lt.h" external D0CsoftDR, D0CcollDR, D0Csoft, D0Ccoll res = 0 res00 = 0 res00(0) = -999 if( lambda .le. 0 ) then call DCDispatch(res, para, D0CsoftDR, D0CcollDR) else call DCDispatch(res, para, D0Csoft, D0Ccoll) endif end ************************************************************************ subroutine DCDispatch(res, para, soft, coll) implicit none ComplexType res(0:2), para(1,*) external soft, coll #include "lt.h" #include "perm.h" integer i, z, s, perm, ier, key ComplexType alt integer pperm(12) data pperm / & p1234, p1243, p1324, & p2341, p2431, p2314, & p3412, p3142, p3421, & p4123, p4132, p4213 / * 0 1 1xxx O'1234561234' * 1 2 12xx O'1234561234' * 2 2 13xx O'5264131324' * 3 3 123x O'1234561234' * 4 2 14xx O'4321561432' * 5 3 124x O'1635421243' * 6 3 134x O'5361421342' * 7 4 xxxx O'1234561234' #define pj(p,j) ibits(p,3*(10-j),3) #define mj(p,j) ibits(p,3*(4-j),3) #define Pc(j) P(pj(perm,j)) #define Mc(j) M(mj(perm,j)) #define Px(j) Re(Pc(j)) z = 0 s = 0 do i = 1, 12 perm = pperm(i) c PRINT '(I3,O12)', i, perm c PRINT '(6F14.2)', Px(1), Px(2), Px(3), Px(4), Px(5), Px(6) c PRINT '(8F14.2)', Mc(1), Mc(2), Mc(3), Mc(4) if( abs(Mc(1)) .lt. zeroeps ) then if( abs(Px(1)) + abs(Mc(2)) .lt. zeroeps ) then if( DEBUGLEVEL .gt. 0 ) & print '("collinear D0C, perm = ",O10)', perm call coll(res, para, perm) if( perm .eq. 0 ) return endif if( s .eq. 0 .and. & abs(Px(1) - Mc(2)) + & abs(Px(4) - Mc(4)) .lt. diffeps ) s = perm if( z .eq. 0 ) z = perm endif enddo if( s .ne. 0 ) then if( DEBUGLEVEL .gt. 0 ) & print '("soft D0C, perm = ",O10)', s call soft(res, para, s) return endif key = ibits(versionkey, KeyD0C, 2) if( key .ne. 1 ) then call ffd0c(res(0), para, 0, ier) if( key .eq. 0 ) return alt = res(0) endif ier = 0 call ffd0c(res(0), para, 1, ier) if( key .gt. 1 .and. & abs(res(0) - alt) .gt. maxdev*abs(alt) ) then print *, "Discrepancy in D0C:" print *, " p1 =", P(1) print *, " p2 =", P(2) print *, " p3 =", P(3) print *, " p4 =", P(4) print *, " p1p2 =", P(5) print *, " p2p3 =", P(6) print *, " m1 =", M(1) print *, " m2 =", M(2) print *, " m3 =", M(3) print *, " m4 =", M(4) print *, "D0C a =", alt print *, "D0C b =", res(0) if( ier .le. errdigits ) res(0) = alt endif if( .not. btest(key, 1) ) res(0) = alt end ************************************************************************ subroutine DCDump(s, para, perm) implicit none character*(*) s ComplexType para(1,*) integer perm #include "lt.h" print '(A,", perm = ",O4)', s, iand(perm, O'7777') if( DEBUGLEVEL .gt. 1 ) then print *, "p1 =", Px(1) print *, "p2 =", Px(2) print *, "p3 =", Px(3) print *, "p4 =", Px(4) print *, "p1p2 =", Px(5) print *, "p2p3 =", Px(6) print *, "m1 =", Mc(1) print *, "m2 =", Mc(2) print *, "m3 =", Mc(3) print *, "m4 =", Mc(4) endif end ************************************************************************ subroutine D0Csoft(res, para, perm) implicit none ComplexType res, para(1,*) integer perm #include "lt.h" RealType p1, p2, p3, p4, p1p2, p2p3 RealType r1, r4 ComplexType m3, r3 ComplexType xs, x2, x3, y, c, fac ComplexType lxs, lx2, lx3, l1x2, l1x3, ly, lm integer ier ComplexType spence, bdK, bdKC, zfflo1 external spence, bdK, bdKC, zfflo1 m3 = Mc(3) p1 = Px(1) p2 = Px(2) p3 = Px(3) p4 = Px(4) p1p2 = Px(5) p2p3 = Px(6) if( DEBUGLEVEL .gt. 0 ) call DCDump("D0Csoft", para, perm) ier = 0 r1 = sqrt(p1) r4 = sqrt(p4) fac = .5D0/(r1*r4*(p1p2 - m3)) xs = bdK(p2p3, r1, r4) lxs = -1 if( xs .ne. 1 ) then lxs = log(xs) fac = 2*xs/((1 - xs)*(1 + xs))*fac endif * massless case * (should have been re-routed to real D0, keep here for safety) if( abs(m3) .lt. zeroeps ) then if( abs(p1 - p2) + abs(p3 - p4) .lt. diffeps ) then res = -2*ln(-lambda/p1p2, 1)*lxs*fac return endif y = (r1*(p3 - p4 + cIeps))/(r4*(p2 - p1 + cIeps)) ly = log(y) c = ln(lambda/(r1*r4), 0) + & ln((p2 - p1)/p1p2, p1 - p2) + & ln((p3 - p4)/p1p2, p4 - p3) if( xs .eq. 1 ) then res = fac*(c - 2 - (1 + y)/(1 - y)*ly) else res = fac*(pi6 - & spence(0, xs/y, 0D0) - & (lxs + log(1/y))*zfflo1(xs/y, ier) - & spence(0, xs*y, 0D0) - & (lxs + ly)*(zfflo1(xs*y, ier) + .5D0*(lxs - ly)) + & spence(0, xs**2, 0D0) + & lxs*(2*zfflo1(xs**2, ier) - c)) endif return endif * massive case r3 = sqrt(m3) x2 = bdKC(p2, r1, r3) x3 = bdKC(p3, r4, r3) lx2 = log(x2) lx3 = log(x3) l1x3 = log(1/x3) lm = 2*ln(r3*sqrt(lambda)/(m3 - p1p2), 1) if( xs .eq. 1 ) then c = -2 if( abs(x2 - x3) .gt. diffeps ) then c = (1 + x2/x3)/(1 - x2/x3)*(lx2 + l1x3) + & (1 + x2*x3)/(1 - x2*x3)*(lx2 + lx3) + 2 else if( abs(x2 - 1) .gt. diffeps ) then c = -2*(x2**2 + 1)/((x2 - 1)*(x2 + 1))*lx2 endif res = fac*(lm - c) else l1x2 = log(1/x2) res = fac*( .5D0*pi**2 + & lxs*(2*zfflo1(xs**2, ier) - lm) + & spence(0, xs**2, 0D0) + lx2**2 + lx3**2 - & spence(0, xs/(x2*x3), 0D0) - & (lxs + l1x2 + l1x3)*zfflo1(xs/(x2*x3), ier) - & spence(0, xs*x2/x3, 0D0) - & (lxs + lx2 + l1x3)*zfflo1(xs*x2/x3, ier) - & spence(0, xs/x2*x3, 0D0) - & (lxs + l1x2 + lx3)*zfflo1(xs/x2*x3, ier) - & spence(0, xs*x2*x3, 0D0) - & (lxs + lx2 + lx3)*zfflo1(xs*x2*x3, ier) ) endif end ************************************************************************ ComplexType function bdKC(x, m1, m2) * this is actually -K from the Beenakker/Denner paper for D0soft implicit none RealType x, m1 ComplexType m2 #include "lt.h" ComplexType d, t d = x - (m1 - m2)**2 if( abs(d) .lt. diffeps ) then bdKC = 1 else t = 4*m1*m2/(d + cIeps) bdKC = -t/(sqrt(1 - t) + 1)**2 endif end ************************************************************************ subroutine D0Ccoll(res, para, perm) implicit none ComplexType res, para(1,*) integer perm #include "lt.h" logical ini data ini /.FALSE./ if( DEBUGLEVEL .gt. 0 ) call DCDump("D0coll", para, perm) Pc(1) = max(minmass, 1D-14) if( ini ) return print *, "collinear-divergent D0C, using mass cutoff ", Px(1) ini = .TRUE. end ************************************************************************ * IR-divergent D0 in dim reg * from W. Beenakker and A. Denner, NPB 338 (1990) 349 subroutine D0CsoftDR(res, para, perm) implicit none ComplexType res(0:2), para(1,*) integer perm #include "lt.h" RealType m2, m4, p2, p3, p2p3 RealType r1, r4, m24, sy, q2, q3 ComplexType m3, r3, t, fac ComplexType c, xs, x2, x3, lxs, lx2, lx3, lm, y ComplexType bdK, bdKC, Li2omx2, Li2omx3 external bdK, bdKC, Li2omx2, Li2omx3 if( DEBUGLEVEL .gt. 0 ) call DCDump("D0CsoftDR", para, perm) m3 = Mc(3) t = m3 - Px(5) p2p3 = Px(6) m2 = Px(1) p2 = Px(2) q2 = m2 - p2 m4 = Px(4) p3 = Px(3) q3 = m4 - p3 r1 = sqrt(m2) r4 = sqrt(m4) fac = .5D0/(r1*r4*t) xs = bdK(p2p3, r1, r4) lxs = -1 if( xs .ne. 1 ) then lxs = log(xs) fac = 2*xs/((1 - xs)*(1 + xs))*fac endif res(1) = fac*lxs res(2) = 0 if( abs(m3) .lt. zeroeps ) then * (should have been re-routed to real D0, keep here for safety) if( abs(q2) + abs(q3) .lt. diffeps ) then * qlbox14: D0(m2, m2, m4, m4; p1p2, p2p3; 0, m2, 0, m4) if( DEBUGLEVEL .gt. 1 ) print *, "D0CsoftDR: qlbox14" res(1) = 2*res(1) res(0) = res(1)*lnrat(mudim, t) return endif * qlbox15: D0(m2, p2, p3, m4; p1p2, p2p3; 0, m2, 0, m4) * Beenakker-Denner Eq. (2.11) if( DEBUGLEVEL .gt. 1 ) print *, "D0CsoftDR: qlbox15" if( abs(q2*q3) .lt. diffeps ) then m24 = m2 if( abs(q2) .lt. diffeps ) m24 = m4 res(0) = fac*( lxs*(lxs + log(mudim/m24) + & 2*lnrat(q2 + q3, t)) + & Li2omx2(xs, 1D0, xs, 1D0) ) return endif y = r1*q3/(r4*q2) sy = sign(.5D0, r1*q3) - sign(.5D0, r4*q2) if( xs .eq. 1 ) then res(0) = fac*( -log(mudim/(r1*r4)) + & lnrat(q2, t) + lnrat(q3, t) + 2 + & (1 + y)/(1 - y)*ln(y, sy) ) else res(0) = fac*( -.5D0*ln(y, sy)**2 + & lxs*(.5D0*lxs + lnrat(q2, t) + lnrat(q3, t) + & log(mudim/(r1*r4))) + & Li2omx2(xs, 1D0, xs, 1D0) - & Li2omx2(xs, 1D0, y, sy) - & Li2omx2(xs, 1D0, 1/y, -sy) ) endif return endif * qlbox16: D0(m2, p2, p3, m4; p1p2, p2p3; 0, m2, m3, m4) * Beenakker-Denner Eq. (2.9) if( DEBUGLEVEL .gt. 1 ) print *, "D0softDR: qlbox16" r3 = sqrt(m3) x2 = bdKC(p2, r1, r3) x3 = bdKC(p3, r4, r3) lx2 = log(x2) lx3 = log(x3) lm = 2*lnrat(sqrt(m3*mudim), t) if( xs .eq. 1 ) then c = -2 if( abs(x2 - x3) .gt. diffeps ) then c = (1 + x2/x3)/(1 - x2/x3)*(lx2 + log(1/x3)) + & (1 + x2*x3)/(1 - x2*x3)*(lx2 + lx3) + 2 else if( abs(x2 - 1) .gt. diffeps ) then c = -2*(x2**2 + 1)/((x2 - 1)*(x2 + 1))*lx2 endif res(0) = fac*(c - lm) else res(0) = fac*(lm*lxs - lx2**2 - lx3**2 + & Li2omx2(xs, 1D0, xs, 1D0) - & Li2omx3(xs, 1D0, x2, 1D0, x3, 1D0) - & Li2omx3(xs, 1D0, 1/x2, -1D0, 1/x3, -1D0) - & Li2omx3(xs, 1D0, x2, 1D0, 1/x3, -1D0) - & Li2omx3(xs, 1D0, 1/x2, -1D0, x3, 1D0)) endif end ************************************************************************ subroutine D0CcollDR(res, para, perm_) implicit none ComplexType res(0:2), para(1,*) integer perm_ #include "lt.h" #include "perm.h" integer perm, z, s * # of non-zero momenta integer nz1, nz2, nz3 parameter (nz1 = 1073741824) ! O'10000000000' parameter (nz2 = -2147483648) ! O'20000000000' parameter (nz3 = -1073741824) ! O'30000000000' integer nz1p1234, nz2p1234, nz3p1234 parameter (nz1p1234 = nz1 + p1234) parameter (nz2p1234 = nz2 + p1234) parameter (nz3p1234 = nz3 + p1234) integer nz1p1243, nz2p1243, nz3p1243 parameter (nz1p1243 = nz1 + p1243) parameter (nz2p1243 = nz2 + p1243) parameter (nz3p1243 = nz3 + p1243) integer nz1p2134, nz2p2134, nz3p2134 parameter (nz1p2134 = nz1 + p2134) parameter (nz2p2134 = nz2 + p2134) parameter (nz3p2134 = nz3 + p2134) integer nz1p2143, nz2p2143, nz3p2143 parameter (nz1p2143 = nz1 + p2143) parameter (nz2p2143 = nz2 + p2143) parameter (nz3p2143 = nz3 + p2143) integer nz1p3214, nz2p3214, nz3p3214 parameter (nz1p3214 = nz1 + p3214) parameter (nz2p3214 = nz2 + p3214) parameter (nz3p3214 = nz3 + p3214) integer nz1p4213, nz2p4213, nz3p4213 parameter (nz1p4213 = nz1 + p4213) parameter (nz2p4213 = nz2 + p4213) parameter (nz3p4213 = nz3 + p4213) integer pperm(0:127) data pperm / * 1ppppp12mm 0ppp 1 * 3m 0ppp 1 * m4 0ppp 1432652143 * 34 0ppp 1 & nz3p1234, nz3p1234, nz3p2143, nz3p1234, * 12pppp12mm 0ppp 1 * 3m 00pp 1 * m4 0ppp 1432652143 * 34 00pp 1 & nz3p1234, nz2p1234, nz3p2143, nz2p1234, * 1p3ppp12mm 0ppp 1 * 3m 0ppp 1 * m4 0ppp 1432652143 * 34 0p0p 1 & nz3p1234, nz3p1234, nz3p2143, nz2p1234, * 123ppp12mm 0ppp 1 * 3m 00pp 1 * m4 0ppp 1432652143 * 34 000p 1 & nz3p1234, nz2p1234, nz3p2143, nz1p1234, * 1pp4pp12mm 0ppp 1 * 3m 0ppp 1 * m4 00pp 1432652143 * 34 00pp 1432652143 & nz3p1234, nz3p1234, nz2p2143, nz2p2143, * 12p4pp12mm 0ppp 1 * 3m 00pp 1 * m4 00pp 1432652143 * 34 000p 2143563214 & nz3p1234, nz2p1234, nz2p2143, nz1p3214, * 1p34pp12mm 0ppp 1 * 3m 0ppp 1 * m4 00pp 1432652143 * 34 000p 1432652143 & nz3p1234, nz3p1234, nz2p2143, nz1p2143, * 1234pp12mm 0ppp 1 * 3m 00pp 1 * m4 00pp 1432652143 * 34 0000 1 & nz3p1234, nz2p1234, nz2p2143, p1234, * 1ppp5p12mm 0ppp 1 * 3m 00pp 1536242134 * m4 0ppp 1432652143 * 34 00pp 1536242134 & nz3p1234, nz2p2134, nz3p2143, nz2p2134, * 12pp5p12mm 0ppp 1 * 3m 00pp 1 * m4 0ppp 1432652143 * 34 00pp 1 & nz3p1234, nz2p1234, nz3p2143, nz2p1234, * 1p3p5p12mm 0ppp 1 * 3m 00pp 1536242134 * m4 0ppp 1432652143 * 34 000p 1536242134 & nz3p1234, nz2p2134, nz3p2143, nz1p2134, * 123p5p12mm 0ppp 1 * 3m 00pp 1536242134 * m4 0ppp 1432652143 * 34 000p 1 & nz3p1234, nz2p2134, nz3p2143, nz1p1234, * 1pp45p12mm 0ppp 1 * 3m 00pp 1536242134 * m4 00pp 1432652143 * 34 00pp 1432652143 & nz3p1234, nz2p2134, nz2p2143, nz2p2143, * 12p45p12mm 0ppp 1 * 3m 00pp 1 * m4 00pp 1432652143 * 34 000p 2143563214 & nz3p1234, nz2p1234, nz2p2143, nz1p3214, * 1p345p12mm 0ppp 1 * 3m 00pp 1536242134 * m4 00pp 1432652143 * 34 000p 1432652143 & nz3p1234, nz2p2134, nz2p2143, nz1p2143, * 12345p12mm 0ppp 1 * 3m 00pp 1 * m4 00pp 1432652143 * 34 0000 1 & nz3p1234, nz2p1234, nz2p2143, p1234, * 1pppp612mm 0ppp 1 * 3m 0ppp 1 * m4 00pp 1635421243 * 34 00pp 1635421243 & nz3p1234, nz3p1234, nz2p1243, nz2p1243, * 12ppp612mm 0ppp 1 * 3m 00pp 1 * m4 00pp 1635421243 * 34 00pp 1 & nz3p1234, nz2p1234, nz2p1243, nz2p1234, * 1p3pp612mm 0ppp 1 * 3m 0ppp 1 * m4 00pp 1635421243 * 34 000p 1635421243 & nz3p1234, nz3p1234, nz2p1243, nz1p1243, * 123pp612mm 0ppp 1 * 3m 00pp 1 * m4 00pp 1635421243 * 34 000p 1 & nz3p1234, nz2p1234, nz2p1243, nz1p1234, * 1pp4p612mm 0ppp 1 * 3m 0ppp 1 * m4 00pp 1635421243 * 34 00pp 1432652143 & nz3p1234, nz3p1234, nz2p1243, nz2p2143, * 12p4p612mm 0ppp 1 * 3m 00pp 1 * m4 00pp 1635421243 * 34 000p 2143563214 & nz3p1234, nz2p1234, nz2p1243, nz1p3214, * 1p34p612mm 0ppp 1 * 3m 0ppp 1 * m4 00pp 1635421243 * 34 000p 1432652143 & nz3p1234, nz3p1234, nz2p1243, nz1p2143, * 1234p612mm 0ppp 1 * 3m 00pp 1 * m4 00pp 1635421243 * 34 0000 1 & nz3p1234, nz2p1234, nz2p1243, p1234, * 1ppp5612mm 0ppp 1 * 3m 00pp 1536242134 * m4 00pp 1635421243 * 34 000p 6153424213 & nz3p1234, nz2p2134, nz2p1243, nz1p4213, * 12pp5612mm 0ppp 1 * 3m 00pp 1 * m4 00pp 1635421243 * 34 000p 6153424213 & nz3p1234, nz2p1234, nz2p1243, nz1p4213, * 1p3p5612mm 0ppp 1 * 3m 00pp 1536242134 * m4 00pp 1635421243 * 34 0000 6153424213 & nz3p1234, nz2p2134, nz2p1243, p4213, * 123p5612mm 0ppp 1 * 3m 00pp 1 * m4 00pp 1635421243 * 34 0000 6153424213 & nz3p1234, nz2p1234, nz2p1243, p4213, * 1pp45612mm 0ppp 1 * 3m 00pp 1536242134 * m4 00pp 1635421243 * 34 000p 6153424213 & nz3p1234, nz2p2134, nz2p1243, nz1p4213, * 12p45612mm 0ppp 1 * 3m 00pp 1 * m4 00pp 1635421243 * 34 0000 6254314231 & nz3p1234, nz2p1234, nz2p1243, p4231, * 1p345612mm 0ppp 1 * 3m 00pp 1536242134 * m4 00pp 1635421243 * 34 0000 6153424213 & nz3p1234, nz2p2134, nz2p1243, p4213, * 12345612mm 0ppp 1 * 3m 00pp 1 * m4 00pp 1635421243 * 34 0000 1 & nz3p1234, nz2p1234, nz2p1243, p1234 / if( DEBUGLEVEL .gt. 0 ) call DCDump("D0CcollDR", para, perm) perm = perm_ perm_ = 0 z = 0 if( abs(Mc(3)) .lt. zeroeps ) z = 1 if( abs(Mc(4)) .lt. zeroeps ) z = z + 2 if( abs(Px(2)) .lt. zeroeps ) z = z + 4 if( abs(Px(3)) .lt. zeroeps ) z = z + 8 if( abs(Px(4)) .lt. zeroeps ) z = z + 16 if( abs(Px(5)) .lt. zeroeps ) z = z + 32 if( abs(Px(6)) .lt. zeroeps ) z = z + 64 s = pperm(z) if( iand(s, O'7777777777') .ne. p1234 ) perm = & pj(perm, pj(s, 1))*8**9 + & pj(perm, pj(s, 2))*8**8 + & pj(perm, pj(s, 3))*8**7 + & pj(perm, pj(s, 4))*8**6 + & pj(perm, pj(s, 5))*8**5 + & pj(perm, pj(s, 6))*8**4 + & mj(perm, mj(s, 1))*8**3 + & mj(perm, mj(s, 2))*8**2 + & mj(perm, mj(s, 3))*8**1 + & mj(perm, mj(s, 4))*8**0 goto (22,22,22,23, 22,22,22,23, 10,11,12,13) & ibits(s, 30, 2) + ibits(z, 0, 2)*4 - 3 call D0Cm2p3(res, para, perm) return 23 call D0Cm1p3(res, para, perm) return 22 call D0Cm1p2(res, para, perm) return 13 call D0m0p3(res, para,2, perm) return 12 call D0m0p2(res, para,2, perm) return 11 call D0m0p1(res, para,2, perm) return 10 call D0m0p0(res, para,2, perm) end ************************************************************************ subroutine D0Cm1p2(res, para, perm) implicit none ComplexType res(0:2), para(1,*) integer perm #include "lt.h" ComplexType s ComplexType m4, t, q3, q4, fac ComplexType lm, ls, lt, lq integer ir ComplexType Li2omrat, cLi2omrat, cLi2omrat2 external Li2omrat, cLi2omrat, cLi2omrat2 if( DEBUGLEVEL .gt. 1 ) call DCDump("D0Cm1p2", para, perm) m4 = Mc(4) s = -Px(5) t = m4 - Px(6) fac = 1/(s*t) q3 = m4 - Px(3) q4 = m4 - Px(4) ir = 0 if( abs(q3) .lt. diffeps ) ir = 1 if( abs(q4) .lt. diffeps ) then ir = ir + 1 q4 = q3 endif res(2) = .5D0*(2 + ir)*fac goto (1, 2) ir * qlbox8: D0(0, 0, p3, p4; p1p2, p2p3; 0, 0, 0, m4) if( DEBUGLEVEL .gt. 1 ) print *, "D0Cm1p2: qlbox8" lm = lnrat(s, mudim) ls = lnrat(s, m4) res(0) = fac*(-2*(cLi2omrat(q3, t) + cLi2omrat(q4, t)) - & cLi2omrat2(q3, s, q4, m4) - pi6 + & .5D0*(lm - ls)*(lm + ls) + 2*lm*lnrat(t, m4) - & lnrat(q3, mudim)*lnrat(q3, m4) - & lnrat(q4, mudim)*lnrat(q4, m4)) res(1) = fac*(lnrat(q3, t) + lnrat(q4, t) - lm) return 1 continue * qlbox7: D0(0, 0, m4, p4; p1p2, p2p3; 0, 0, 0, m4) * (should have been re-routed to real D0, keep here for safety) if( DEBUGLEVEL .gt. 1 ) print *, "D0Cm1p2: qlbox7" ls = lnrat(s, m4) lt = lnrat(t, m4) lm = lnrat(mudim, m4) lq = lnrat(q4, m4) res(0) = fac*(2*ls*lt - lq**2 - 5*pi12 + & lm*(.75D0*lm - 2*lt - ls + lq) - & 2*Li2omrat(q4, t)) res(1) = fac*(1.5D0*lm - 2*lt - ls + lq) return 2 continue * qlbox6: D0(0, 0, m4, m4; p1p2, p2p3; 0, 0, 0, m4) * (should have been re-routed to real D0, keep here for safety) if( DEBUGLEVEL .gt. 1 ) print *, "D0Cm1p2: qlbox6" ls = lnrat(s, m4) lt = lnrat(t, m4) lm = lnrat(mudim, m4) res(0) = fac*((lm - ls)*(lm - 2*lt) - .5D0*pi**2) res(1) = fac*(2*(lm - lt) - ls) end ************************************************************************ subroutine D0Cm1p3(res, para, perm) implicit none ComplexType res(0:2), para(1,*) integer perm #include "lt.h" ComplexType s, q2 ComplexType m4, m4mu, q3, q4, t, fac, ll ComplexType Li2omrat, cLi2omrat, Li2omrat2, cLi2omrat2 external Li2omrat, cLi2omrat, Li2omrat2, cLi2omrat2 if( DEBUGLEVEL .gt. 1 ) call DCDump("D0Cm1p3", para, perm) q2 = -Px(2) s = -Px(5) m4 = Mc(4) q3 = m4 - Px(3) q4 = m4 - Px(4) t = m4 - Px(6) if( abs(t) .lt. diffeps ) then t = q4 q4 = 0 s = q2 q2 = -Px(5) endif m4mu = sqrt(m4*mudim) * qlbox9: D0(0, p2, p3, m4; p1p2, p2p3; 0, 0, 0, m4) * (should have been re-routed to real D0, keep here for safety) if( abs(q4) .lt. diffeps ) then if( DEBUGLEVEL .gt. 1 ) print *, "D0Cm1p3: qlbox9" fac = 1/(Re(s)*Re(t)) ll = lnrat(t, m4mu) + lnrat(s, q2) res(0) = fac*(Li2omrat2(q3, q2, t, m4) + & 2*Li2omrat(s, q2) + ll**2 + pi12) res(1) = -fac*ll res(2) = .5D0*fac return endif * qlbox10: D0(0, p2, p3, p4; p1p2, p2p3; 0, 0, 0, m4) if( DEBUGLEVEL .gt. 1 ) print *, "D0Cm1p3: qlbox10" fac = 1/(Re(s)*t - Re(q2)*q4) ll = lnrat(q2, mudim) + lnrat(q4, mudim) - & lnrat(s, mudim) - lnrat(t, mudim) res(0) = fac*( & 2*ll*lnrat(m4mu, t) + & cLi2omrat2(q3, q2, t, m4) - & cLi2omrat2(q3, s, q4, m4) + & 2*(cLi2omrat2(q2, s, q4, t) - & cLi2omrat(q2, s) + cLi2omrat(t, q4)) ) res(1) = fac*ll res(2) = 0 end ************************************************************************ subroutine D0Cm2p3(res, para, perm) implicit none ComplexType res(0:2), para(1,*) integer perm #include "lt.h" RealType p3, m3mu ComplexType m3, m4, s, t, q3, q4, tmp, fac ComplexType p34, c, s3t, s4s ComplexType ls, lt, lq3, lq4, d ComplexType x43(4), r3t, r4s, r43p, r43m ComplexType logs, dilogs integer ir, case ComplexType minus1 parameter (minus1 = -1) ComplexType Li2rat, cLi2omrat, cLi2omrat2 external Li2rat, cLi2omrat, cLi2omrat2 if( DEBUGLEVEL .gt. 1 ) call DCDump("D0Cm2p3", para, perm) m3 = Mc(3) s = m3 - Px(5) q3 = m3 - Px(2) m4 = Mc(4) t = m4 - Px(6) q4 = m4 - Px(4) if( abs(s) .lt. diffeps .or. abs(t) .lt. diffeps ) then * switch from p1234 to p2134 = 1536242134 tmp = s s = q3 q3 = tmp tmp = t t = q4 q4 = tmp endif fac = 1/(s*t - q3*q4) ir = 0 if( abs(q3) .lt. diffeps ) ir = 1 if( abs(q4) .lt. diffeps ) then ir = ir + 1 q4 = q3 tmp = s s = t t = tmp m4 = m3 m3 = Mc(4) endif res(2) = .5D0*fac*ir p3 = Px(3) if( abs(p3) .lt. zeroeps ) then case = 1 logs = lnrat(m3, m4)**2 else p34 = p3 + m3 - m4 c = -4*p3*m3 d = sqrt(p34**2 + c) x43(1) = -p34 - d x43(2) = p34 - d if( abs(x43(1)) .lt. abs(x43(2)) ) then x43(1) = c/x43(2) else x43(2) = c/x43(1) endif p34 = -p3 + m3 - m4 c = -4*p3*m4 x43(3) = -p34 - d x43(4) = p34 - d if( abs(x43(3)) .lt. abs(x43(4)) ) then x43(3) = c/x43(4) else x43(4) = c/x43(3) endif if( abs(Im(d)) .lt. zeroeps ) then case = 2 logs = lnrat(x43(1), x43(3))**2 + & lnrat(x43(2), x43(4))**2 else case = 3 r43p = x43(1)/x43(3) r43m = x43(2)/x43(4) logs = ln(r43p, 0)**2 + ln(r43m, 0)**2 endif endif goto (1, 2) ir * qlbox13: D0(0, p2, p3, p4; p1p2, p2p3; 0, 0, m3, m4) if( DEBUGLEVEL .gt. 1 ) print *, "D0Cm2p3: qlbox13" ls = lnrat(s, mudim) lt = lnrat(t, mudim) lq3 = lnrat(q3, mudim) lq4 = lnrat(q4, mudim) if( case .eq. 1 ) then dilogs = cLi2omrat2(q3, t, minus1, minus1) + & cLi2omrat2(q3, t, m4, m3) + & cLi2omrat2(q4, s, m3, m4) + & cLi2omrat2(q4, s, minus1, minus1) else if( case .eq. 2 ) then dilogs = cLi2omrat2(q3, t, x43(4), x43(2)) + & cLi2omrat2(q3, t, x43(3), x43(1)) + & cLi2omrat2(q4, s, x43(1), x43(3)) + & cLi2omrat2(q4, s, x43(2), x43(4)) else r3t = q3/t s3t = sign(.5D0, Re(q3)) - sign(.5D0, Re(t)) r4s = q4/s s4s = sign(.5D0, Re(q4)) - sign(.5D0, Re(s)) dilogs = Li2rat(r3t,s3t, 1/r43m,0D0) + & Li2rat(r3t,s3t, 1/r43p,0D0) + & Li2rat(r4s,s4s, r43p,0D0) + & Li2rat(r4s,s4s, r43m,0D0) endif res(0) = -fac*(dilogs + .5D0*logs + lq3**2 + lq4**2 + & 2*(cLi2omrat(q3, s) + cLi2omrat(q4, t) - & cLi2omrat2(q3, s, q4, t) - ls*lt) + & (lt - lq3)*log(m3/mudim) + (ls - lq4)*log(m4/mudim)) res(1) = fac*(lq3 + lq4 - ls - lt) return 1 continue * qlbox12: D0(0, m3, p3, p4; p1p2, p2p3; 0, 0, m3, m4) if( DEBUGLEVEL .gt. 1 ) print *, "D0Cm2p3: qlbox12" m3mu = sqrt(Re(m3)*mudim) ls = lnrat(s, m3mu) lt = lnrat(t, m3mu) lq4 = lnrat(q4, m3mu) if( case .eq. 1 ) then dilogs = cLi2omrat2(q4, s, m3, m4) + & cLi2omrat2(q4, s, minus1, minus1) else if( case .eq. 2 ) then dilogs = cLi2omrat2(q4, s, x43(1), x43(3)) + & cLi2omrat2(q4, s, x43(2), x43(4)) else r4s = q4/s s4s = sign(.5D0, Re(q4)) - sign(.5D0, Re(s)) dilogs = Li2rat(r4s,s4s, r43p,0D0) + & Li2rat(r4s,s4s, r43m,0D0) endif res(0) = -fac*(dilogs + .5D0*logs + pi12 + & 2*(cLi2omrat(q4, t) - ls*lt) + & lq4**2 + (ls - lq4)*log(m4/m3)) res(1) = fac*(lq4 - ls - lt) return 2 continue * qlbox11: D0(0, m3, p3, m4; p1p2, p2p3; 0, 0, m3, m4) * qlbox11a: D0(0, p2, p3, p4; m3, m4; 0, 0, m3, m4) * (should have been re-routed to real D0, keep here for safety) if( DEBUGLEVEL .gt. 1 ) print *, "D0Cm2p3: qlbox11" ls = lnrat(s, sqrt(Re(m3)*mudim)) lt = lnrat(t, sqrt(Re(m4)*mudim)) res(0) = fac*(.25D0*log(Re(m3)/Re(m4))**2 - & .5D0*(logs + pi**2) + 2*ls*lt) res(1) = -fac*(ls + lt) end LoopTools-2.16/src/D/PaxHeaders/ffxdbd.F0000644000000000000000000000007411776502523015005 xustar0030 atime=1648161785.715698398 30 ctime=1648161793.715764879 LoopTools-2.16/src/D/ffxdbd.F0000644000000000000000000004341411776502523015726 0ustar00rootroot00000000000000#include "externals.h" #include "types.h" *###[ ffxdir: subroutine ffxdir(cs,cfac,idone,xpi,dpipj,ipoin,ndiv,ier) ***#[*comment:*********************************************************** * * * Check if this 4point function is IRdivergent and if so, get it * * using ffxdbd and set idone to 1 (or 2 if 2 IR poles) * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments * integer ipoin,idone,ndiv,ier ComplexType cs,cfac RealType xpi(13),dpipj(10,13) * * local variables * integer i,j,k,l,ier0,ii(6),notijk(4,4,4) save notijk * * common blocks * #include "ff.h" * * data * data notijk/ + 0,0,0,0,0,0,4,3,0,4,0,2,0,3,2,0,0,0,4,3,0,0,0,0,4,0,0,1,3,0,1,0, + 0,4,0,2,4,0,0,1,0,0,0,0,2,1,0,0,0,3,2,0,3,0,1,0,2,1,0,0,0,0,0,0/ * * #] declarations: * #[ work: * idone = 0 do 25 i=1,4 if ( xpi(i) .ne. 0 ) goto 25 do 24 j=1,3 if ( j .eq. i ) goto 24 if ( dpipj(j,inx(j,i)) .ne. 0 ) goto 24 do 23 k=j+1,4 if ( k .eq. i ) goto 23 if ( dpipj(k,inx(k,i)) .ne. 0 ) goto 23 * * we found an IR divergent function; * first check whether it is linearly divergent * l = notijk(k,j,i) * * do we have a linear divergence on our hands? * if ( dpipj(l,inx(l,i)) .eq. 0 ) then if ( ndiv.eq.-1 ) ndiv = 1 elseif ( ndiv.gt.0 ) then cs = 0 cfac = 1 idone = 1 return endif * * the complex case * if ( lsmug ) then * * use Wim & Ansgard's formulae whenever possible * if ( c2sisj(i,j).eq.0 .and. c2sisj(i,k).eq.0 ) + then call ffxdbd(cs,cfac,xpi,dpipj,i,j,k,l,ier) goto 98 endif if ( c2sisj(i,j).eq.0 .and. dpipj(i,inx(i,l)) + .eq.0 .and. c2sisj(i,l).eq.0 ) then call ffxdbd(cs,cfac,xpi,dpipj,i,j,l,k,ier) goto 98 endif if ( c2sisj(i,k).eq.0 .and. dpipj(i,inx(i,l)) + .eq.0 .and. c2sisj(i,l).eq.0 ) then call ffxdbd(cs,cfac,xpi,dpipj,i,k,l,j,ier) goto 98 endif * * is it nasty? * if ( dpipj(i,inx(i,l)).eq.0 ) then if ( c2sisj(j,i).eq.0 ) then goto 99 elseif ( c2sisj(k,i).eq.0 ) then goto 99 elseif ( c2sisj(l,i).eq.0 ) then goto 99 else call fferr(71,ier) return endif endif * * then it just is logarithmiocally divergent * let the ffxc0i handle this * else * * the real case * if ( dpipj(i,inx(i,l)).eq.0 ) then call fferr(73,ier) idone = 1 return endif call ffxdbd(cs,cfac,xpi,dpipj,i,j,k,l,ier) goto 98 endif 23 continue 24 continue 25 continue idone = 0 lnasty = .FALSE. if ( ndiv.eq.-1 ) ndiv = 0 return * * clean up * 98 continue if ( ldot .and. ipoin.eq.4 ) then ier0 = 0 if ( idot.lt.1 ) then call ffdot4(fpij4,xpi,dpipj,10,ier0) endif ii(1)= 5 ii(2)= 6 ii(3)= 7 ii(4)= 8 ii(5)= 9 ii(6)= 10 if ( abs(idot).lt.2 ) then fidel3 = ier0 call ffdl3p(fdel3,fpij4,10,ii,ii) endif endif * * and finito * if ( ndiv.eq.-1 ) ndiv = 0 idone = 1 if ( xpi(j) .eq. 0 .or. xpi(k) .eq. 0 ) idone = 2 if ( xpi(j) .eq. 0 .and. xpi(k) .eq. 0 ) idone = 3 return * * nasty - set some flags * 99 continue lnasty = .TRUE. return * * #] work: *###] ffxdir: end *###[ ffxdbd: subroutine ffxdbd(csom,cfac,xpi,dpipj,ilam,i1,i4,ic,ier) ***#[*comment:*********************************************************** * * * The IR divergent fourpoint function with real masses * * according to Beenakker & Denner, Nucl.Phys.B338(1990)349. * * * * Input: xpi(13) real momenta^2 * * dpipj(10,13) real xpi(i)-xpi(j) * * ilam integer position of m=0 * * i1,i4 integer position of other 2 IR masses * * ic integer position of complex mass * * lambda real cutoff to use instead of lam^2 * * * * Output: csom,cfac complex D0 = csom*cfac * * ier integer number of digits lost * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments * integer ilam,i1,i4,ic,ier ComplexType csom,cfac RealType xpi(13),dpipj(10,13) * * local variables * integer ier0,ier1,ipi12,ip,init,is,i2,i3,i,iepst,iepss,ieps2, + ieps3 RealType absc,xmax RealType xxs(3),xxt(1),xx2(3),xx3(3),xm0,xm1,xm4,xlam, + d,dfflo1,fac ComplexType c,cs(21),z,zlg,som,cxt ComplexType zxfflg,zfflog external dfflo1,zxfflg,zfflog save init * * common blocks * #include "ff.h" * * statement function * absc(c) = abs(Re(c)) + abs(Im(c)) * * data * data init /0/ * * #] declarations: * #[ check input: * if ( init .eq. 0 ) then init = 1 print *,'ffxdbd: using IR cutoff lambda^2 = ',lambda endif if ( xpi(i1).eq.0 .or. xpi(i4).eq.0 ) then call fferr(98,ier) return endif * * #] check input: * #[ preliminaries: * csom = 0 cfac = 1 xm0 = sqrt(xpi(ic)) xm1 = sqrt(xpi(i1)) xm4 = sqrt(xpi(i4)) xlam = sqrt(lambda) * * #] preliminaries: * #[ special case m0=0, m1=m2, m3=m4: if ( xpi(ic) .eq. 0 ) then * * even more special case: 2 points of IR divergence: * if ( dpipj(i1,inx(ic,i1)).eq.0 .and. + dpipj(i4,inx(ic,i4)).eq.0 ) then ier0 = 0 call ffxkfn(xxs,iepss,xpi(inx(i1,i4)),xm1,xm4,ier0) if ( ier0.ge.100 ) then call fferr(44,ier) return endif ier = ier + ier0 if ( abs(xxs(2)).gt.xloss ) then zlg = zxfflg(xxs(1),iepss,0D0,ier) else zlg = Re(dfflo1(xxs(2),ier)) endif csom = -2*zlg* + zxfflg(-lambda/xpi(inx(ilam,ic)),-2,0D0,ier) fac = xxs(1)/(xm1*xm4*xpi(inx(ilam,ic))*xxs(2)*xxs(3)) cfac = fac if ( ldot .and. abs(idot).lt.4 ) then fdel4s = 1/(16*fac**2) endif return endif * #] special case m0=0, m1=m2, m3=m4: * #[ special case m0=0, m1=m2, m3!=m4: if ( dpipj(i1,inx(ic,i1)).eq.0 .or. + dpipj(i4,inx(ic,i4)).eq.0 ) then if ( dpipj(i1,inx(ic,i1)).ne.0 ) then i = i4 i4 = i1 i1 = i endif * * From Wim Beenakker, Priv.Comm. * ier0 = 0 call ffxkfn(xxs,iepss,xpi(inx(i1,i4)),xm1,xm4,ier0) if ( ier0.ge.100 ) then call fferr(44,ier) return endif ier = ier + ier0 ier0 = ier ier1 = ier if ( abs(xxs(2)).gt.xloss ) then zlg = zxfflg(xxs(1),iepss,0D0,ier0) else zlg = Re(dfflo1(xxs(2),ier0)) endif cs(1) = zlg**2 ier1 = max(ier0,ier1) ier0 = ier if ( xxs(1)**2.lt.xloss ) then cs(2) = -2*Re(dfflo1(xxs(1)**2,ier0))*zlg else cs(2) = -2*zxfflg(xxs(2)*xxs(3),0,0D0,ier0)*zlg endif ier1 = max(ier0,ier1) ier0 = ier cs(3) = zxfflg(lambda/xpi(i4),0,0D0,ier0)*zlg ier1 = max(ier0,ier1) ier0 = ier cs(4) = 2*zxfflg(dpipj(inx(ic,i4),i4)/xpi(inx(ilam,ic)), + -1,dpipj(inx(ic,i4),i4),ier0)*zlg ier1 = max(ier0,ier1) ier0 = ier call ffzxdl(cs(5),ip,zlg,xxs(1)**2,iepss,ier0) cs(5) = -cs(5) ipi12 = -ip + 2 ier1 = max(ier0,ier1) ier = ier1 som = cs(1) + cs(2) + cs(3) + cs(4) + cs(5) + + ipi12*Re(pi12) xmax = max(absc(cs(1)),absc(cs(2)),absc(cs(3)), + absc(cs(4)),absc(cs(5))) csom = som fac = -xxs(1)/(xm1*xm4*xpi(inx(ilam,ic))*xxs(2)*xxs(3)) cfac = fac if ( ldot .and. abs(idot).lt.4 ) then fdel4s = 1/(16*fac**2) endif return endif * #] special case m0=0, m1=m2, m3!=m4: * #[ special case m0=0, m1!=m2, m3!=m4: * * This also crashes... * xm0 = precx*max(xm1,xm4) endif * #] special case m0=0, m1!=m2, m3!=m4: * #[ get dimensionless vars: * * we follow the notation of Wim & Ansgar closely * remember that for -pi we have ieps=+2 and v.v. * if ( lsmug ) then * all is not what it seems if ( nschem .ge. 3 ) then cxt = Re(xm0*xlam)/c2sisj(ic,ilam) else cxt = Re(xm0*xlam)/Re(c2sisj(ic,ilam)) endif else if ( dpipj(ic,inx(ilam,ic)) .eq. 0 ) then call fferr(73,ier) return endif xxt(1) = xm0*xlam/dpipj(ic,inx(ilam,ic)) endif iepst = -2 ier1 = 0 ier0 = 0 call ffxkfn(xxs,iepss,xpi(inx(i1,i4)),xm1,xm4,ier0) ier1 = max(ier0,ier1) ier0 = 0 call ffxkfn(xx2,ieps2,xpi(inx(i1,ic)),xm1,xm0,ier0) ier1 = max(ier0,ier1) ier0 = 0 call ffxkfn(xx3,ieps3,xpi(inx(i4,ic)),xm4,xm0,ier0) ier1 = max(ier0,ier1) if ( ier1 .ge. 100 ) then call ffzdbd(csom,cfac,xpi,dpipj,ilam,i1,i4,ic,ier) return endif ier = ier + ier1 * * #] get dimensionless vars: * #[ fill array: * ier1 = 0 ier0 = 0 zlg = zxfflg(xxs(1),iepss,0D0,ier) d = xxs(1)**2 if ( abs(d) .lt. xloss ) then cs(1) = 2*zlg*Re(dfflo1(d,ier0)) else cs(1) = 2*zlg*zxfflg(xxs(2)*xxs(3),-iepss,0D0,ier0) endif ier1 = max(ier0,ier1) ier0 = 0 if ( lsmug ) then cs(2) = -2*zlg*zfflog(cxt,iepst,czero,ier0) else cs(2) = -2*zlg*zxfflg(xxt(1),iepst,0D0,ier0) endif ier1 = max(ier0,ier1) * ipi12 = 6 * ier0 = 0 call ffzxdl(cs(3),ip,zlg,xxs(1)**2,iepss,ier0) ipi12 = ipi12 + ip ier1 = max(ier0,ier1) ier0 = 0 if ( abs(xx2(2)) .gt. xloss ) then z = zxfflg(xx2(1),ieps2,0D0,ier0) else z = dfflo1(xx2(2),ier0) endif cs(4) = z**2 ier1 = max(ier0,ier1) ier0 = 0 if ( abs(xx3(2)) .gt. xloss ) then z = zxfflg(xx3(1),ieps3,0D0,ier0) else z = dfflo1(xx3(2),ier0) endif cs(5) = z**2 ier1 = max(ier0,ier1) * is = 6 do 110 i2=-1,+1,2 do 100 i3=-1,+1,2 * ier0 = 0 call ffzxdl(cs(is),ip,zlg,xxs(1)*xx2(1)**i2*xx3(1)**i3, + 0,ier0) cs(is) = -cs(is) ipi12 = ipi12 - ip is = is + 1 ier1 = max(ier0,ier1) * ier0 = 0 if ( abs(xxs(2)) .gt. xloss ) then cs(is) = -zlg*zxfflg(xxs(1),iepss,0D0,ier0) else cs(is) = -zlg*Re(dfflo1(xxs(2),ier0)) endif is = is + 1 ier1 = max(ier0,ier1) * ier0 = 0 if ( abs(xx2(2)) .gt. xloss ) then cs(is) = -zlg*zxfflg(xx2(1)**i2,i2*ieps2,0D0,ier0) elseif ( i2.eq.1 ) then cs(is) = -zlg*Re(dfflo1(xx2(2),ier0)) else cs(is) = -zlg*Re(dfflo1(-xx2(2)/xx2(1),ier0)) endif is = is + 1 ier1 = max(ier0,ier1) * ier0 = 0 if ( abs(xx3(2)) .gt. xloss ) then cs(is) = -zlg*zxfflg(xx3(1)**i3,i3*ieps3,0D0,ier0) elseif ( i3.eq.1 ) then cs(is) = -zlg*Re(dfflo1(xx3(2),ier0)) else cs(is) = -zlg*Re(dfflo1(-xx3(2)/xx3(1),ier0)) endif is = is + 1 ier1 = max(ier0,ier1) * 100 continue 110 continue ier = ier + ier1 * * #] fill array: * #[ sum: * som = 0 xmax = 0 is = is - 1 do 200 i=1,is som = som + cs(i) xmax = max(xmax,absc(cs(i))) 200 continue som = som + ipi12*Re(pi12) * * #] sum: * #[ overall factors: * csom = som if ( lsmug ) then if ( nschem .ge. 2 ) then cfac = -Re(xxs(1)/((xm1*xm4*xxs(2)*xxs(3))))/ + c2sisj(ilam,ic) else cfac = -Re(xxs(1))/(Re(xm1*xm4*xxs(2)*xxs(3))* + Re(c2sisj(ilam,ic))) endif if ( ldot .and. abs(idot).lt.4 ) then fdel4s = 16*(xm1*xm4*dpipj(inx(ilam,ic),ic)*xxs(2)* + xxs(3)/xxs(1))**2 endif else fac = xxs(1)/(xm1*xm4*dpipj(inx(ilam,ic),ic)*xxs(2)*xxs(3)) cfac = fac if ( ldot .and. abs(idot).lt.4 ) then fdel4s = 1/(16*fac**2) endif endif * * #] overall factors: *###] ffxdbd: end *###[ ffxkfn: subroutine ffxkfn(x,ieps,xpi,xm,xmp,ier) ***#[*comment:*********************************************************** * * * Calculate the K-function in this paper: * * * * 1-sqrt(1-4*m*mp/(z-(m-mp)^2)) * * K(p^2,m,mp) = ----------------------------- * * 1+sqrt(1-4*m*mp/(z-(m-mp)^2)) * * * * and fill x(1) = -K, x(2) = 1+K, x(3) = 1-K * * ieps gives the sign of the imaginary part: -2 -> +ieps and v.v. * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments * integer ieps,ier RealType x(3),xpi,xm,xmp * * local variables * RealType wortel,xx1,xx2,xx3 * * common blocks * #include "ff.h" * * #] declarations: * #[ work: * * special case * if ( xpi.eq.0 .and. xm.eq.xmp ) then x(1) = 1 x(2) = 0 x(3) = 2 return endif * * normal case * xx1 = xpi - (xm-xmp)**2 xx2 = 1 - 4*xm*xmp/xx1 if ( xx2 .lt. 0 ) then ier = ier + 100 return endif wortel = sqrt(xx2) xx3 = 1/(1+wortel) x(1) = -4*xm*xmp*xx3**2/xx1 x(2) = 2*xx3 x(3) = 2*wortel*xx3 * ieps = -2 * * #] work: *###] ffxkfn: end *###[ ffzdbd: subroutine ffzdbd(csom,cfac,xpi,dpipj,ilam,i1,i4,ic,ier) ***#[*comment:*********************************************************** * * * The IR divergent fourpoint function with real masses * * according to Beenakker & Denner, Nucl.Phys.B338(1990)349. * * but in the case at least one of the roots is complex * * * * Input: xpi(13) real momenta^2 * * dpipj(10,13) real xpi(i)-xpi(j) * * ilam integer position of m=0 * * i1,i4 integer position of other 2 IR masses * * ic integer position of complex mass * * lambda real cutoff to use instead of lam^2 * * * * Output: csom,cfac complex D0 = csom*cfac * * ier integer number of digits lost * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments * integer ilam,i1,i4,ic,ier ComplexType csom,cfac RealType xpi(13),dpipj(10,13) * * local variables * integer ier0,ier1,ipi12,ip,init,is,i2,i3,i,iepst,iepss,ieps2, + ieps3 RealType absc,xmax RealType xm0,xm1,xm4,xlam,xxt(1) ComplexType c,cs(21),z,zlg,som,cxt,cxs(3),cx2(3),cx3(3) ComplexType zxfflg,zfflog,zfflo1 external zxfflg,zfflog,zfflo1 save init * * common blocks * #include "ff.h" * * statement function * absc(c) = abs(Re(c)) + abs(Im(c)) * * data * data init /0/ * * #] declarations: * #[ check input: * if ( init .eq. 0 ) then init = 1 print *,'ffzdbd: using IR cutoff lambda^2 = ',lambda endif * * #] check input: * #[ preliminaries: * xm0 = sqrt(xpi(ic)) xm1 = sqrt(xpi(i1)) xm4 = sqrt(xpi(i4)) xlam = sqrt(lambda) * * #] preliminaries: * #[ get dimensionless vars: * * we follow the notation of Wim & Ansgar closely * remember that for -pi we have ieps=+2 and v.v. * if ( lsmug ) then * all is not what it seems if ( nschem .ge. 3 ) then cxt = Re(xm0*xlam)/c2sisj(ic,ilam) else cxt = Re(xm0*xlam)/Re(c2sisj(ic,ilam)) endif else xxt(1) = xm0*xlam/dpipj(ic,inx(ilam,ic)) endif iepst = -2 ier1 = 0 ier0 = 0 call ffzkfn(cxs,iepss,xpi(inx(i1,i4)),xm1,xm4) ier1 = max(ier0,ier1) ier0 = 0 call ffzkfn(cx2,ieps2,xpi(inx(i1,ic)),xm1,xm0) ier1 = max(ier0,ier1) ier0 = 0 call ffzkfn(cx3,ieps3,xpi(inx(i4,ic)),xm4,xm0) ier1 = max(ier0,ier1) ier = ier + ier1 * * #] get dimensionless vars: * #[ fill array: * ier1 = 0 ier0 = 0 zlg = zfflog(cxs(1),iepss,czero,ier) c = cxs(1)**2 if ( absc(c) .lt. xloss ) then cs(1) = 2*zlg*zfflo1(c,ier0) else cs(1) = 2*zlg*zfflog(cxs(2)*cxs(3),-iepss,czero,ier0) endif ier1 = max(ier0,ier1) ier0 = 0 if ( lsmug ) then cs(2) = -2*zlg*zfflog(cxt,iepst,czero,ier0) else cs(2) = -2*zlg*zxfflg(xxt(1),iepst,0D0,ier0) endif ier1 = max(ier0,ier1) * ipi12 = 6 * ier0 = 0 call ffzzdl(cs(3),ip,zlg,cxs(1)**2,ier0) ipi12 = ipi12 + ip ier1 = max(ier0,ier1) ier0 = 0 z = zfflog(cx2(1),ieps2,czero,ier0) cs(4) = z**2 ier1 = max(ier0,ier1) ier0 = 0 z = zfflog(cx3(1),ieps3,czero,ier0) cs(5) = z**2 ier1 = max(ier0,ier1) * is = 6 do 110 i2=-1,+1,2 do 100 i3=-1,+1,2 * ier0 = 0 call ffzzdl(cs(is),ip,zlg,cxs(1)*cx2(1)**i2*cx3(1)**i3, + ier0) cs(is) = -cs(is) ipi12 = ipi12 - ip is = is + 1 ier1 = max(ier0,ier1) * ier0 = 0 cs(is) = -zlg*zfflog(cxs(1),iepss,czero,ier0) is = is + 1 ier1 = max(ier0,ier1) * ier0 = 0 cs(is) = -zlg*zfflog(cx2(1)**i2,i2*ieps2,czero,ier0) is = is + 1 ier1 = max(ier0,ier1) * ier0 = 0 cs(is) = -zlg*zfflog(cx3(1)**i3,i3*ieps3,czero,ier0) is = is + 1 ier1 = max(ier0,ier1) * 100 continue 110 continue ier = ier + ier1 * * #] fill array: * #[ sum: * som = 0 xmax = 0 is = is - 1 do 200 i=1,is som = som + cs(i) xmax = max(xmax,absc(cs(i))) 200 continue som = som + ipi12*Re(pi12) * * #] sum: * #[ overall factors: * csom = som if ( lsmug ) then if ( nschem .ge. 2 ) then cfac = -cxs(1)/(Re(xm1*xm4)*cxs(2)*cxs(3)* + c2sisj(ilam,ic)) else cfac = -cxs(1)/(Re(xm1*xm4)*cxs(2)*cxs(3)* + Re(c2sisj(ilam,ic))) endif if ( ldot .and. abs(idot).lt.4 ) then c = 16*(Re(xm1*xm4*dpipj(inx(ilam,ic),ic))* + cxs(2)*cxs(3)/cxs(1))**2 fdel4s = Re(c) if ( xloss*Im(c) .gt. precc*Re(c) ) then print *,'ffzdbd: error: Del4s is not real ',c endif endif else cfac = cxs(1)/(Re(xm1*xm4*dpipj(inx(ilam,ic),ic))* + cxs(2)*cxs(3)) if ( ldot .and. abs(idot).lt.4 ) then fdel4s = 1/(16*Re(cfac)**2) if ( xloss*abs(Im(cfac)) .gt. precc*abs(Re(cfac)) ) + then print *,'ffzdbd: error: fac is not real: ',cfac endif endif endif * * #] overall factors: *###] ffzdbd: end *###[ ffzkfn: subroutine ffzkfn(cx,ieps,xpi,xm,xmp) ***#[*comment:*********************************************************** * * * Calculate the K-function in this paper: * * * * 1-sqrt(1-4*m*mp/(z-(m-mp)^2)) * * K(p^2,m,mp) = ----------------------------- * * 1+sqrt(1-4*m*mp/(z-(m-mp)^2)) * * * * and fill x(1) = -K, x(2) = 1+K, x(3) = 1-K * * the roots are allowed to be imaginary * * ieps gives the sign of the imaginary part: -2 -> +ieps and v.v. * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments * integer ieps RealType xpi,xm,xmp ComplexType cx(3) * * local variables * RealType xx1,xx2 ComplexType wortel,cx3 * * common blocks * #include "ff.h" * * #] declarations: * #[ work: * xx1 = xpi - (xm-xmp)**2 xx2 = 1 - 4*xm*xmp/xx1 if ( xx2 .ge. 0 ) then wortel = sqrt(xx2) else wortel = ToComplex(Re(0),Re(sqrt(-xx2))) endif cx3 = 1/(1+wortel) if ( xx1.eq.0 ) then print *, 'ffzkfn: error: xx1=0, contact author' cx(1) = 1/xclogm else cx(1) = Re(-4*xm*xmp/xx1)*cx3**2 endif cx(2) = 2*cx3 cx(3) = 2*wortel*cx3 * ieps = -2 * * #] work: *###] ffzkfn: end LoopTools-2.16/src/D/PaxHeaders/ffdcc0.F0000644000000000000000000000007411776502523014675 xustar0030 atime=1648161785.715698398 30 ctime=1648161793.715764879 LoopTools-2.16/src/D/ffdcc0.F0000644000000000000000000002111411776502523015607 0ustar00rootroot00000000000000#include "externals.h" #include "types.h" *###[ ffdcc0: subroutine ffdcc0(cs3,ipi12,isoort,clogi,ilogi,xpi,piDpj, + xqi,qiDqj,sdel2,del2s,etalam,etami,delpsi,alph, + ddel2s,ldel2s,npoin,ier) ***#[*comment:*********************************************************** * * * Calculates the difference of two threepoint functions * * C(3,...a) - C(4,...b) * * * * Input: xpi(6,3:4) (complex) transformed mi,pi squared in Ci * * piDpj(6,6,3:4)(complex) pi(i).pi(j) * * xqi(10,10) (complex) transformed mi,pi squared in D * * qiDqj(10,10) (complex) qi(i).qi(j) * * sdel2 (complex) sqrt(delta_{p_1 p_2}^{p_1 p_2}) * * del2s(3,3:4) (complex) delta_{p_i s_i}^{p_i s_i} * * etalam(3:4) (complex) delta_{s_1 s_2 s_3}^{s_1 s_2 s_3} * /delta_{p_1 p_2}^{p_1 p_2} * * etami(6,3:4) (complex) m_i^2 - etalam * * ddel2s(2:3) (complex) del2s(i,3) - del2s(i,4) * * alph(3) (complex) alph(1)=alpha, alph(3)=1-alpha * * * * Output: cs3 (complex)(160) C0(3)-C0(4), not yet summed. * * ipi12 (integer)(6) factors pi^2/12, not yet summed * * slam (complex) lambda(p1,p2,p3). * * isoort (integer)(16) indication of he method used * * clogi (complex)(6) log(-dyz(2,1,i)/dyz(2,2,i)) * * ilogi (integer)(6) factors i*pi in this * * ier (integer) 0=ok, 1=inaccurate, 2=error * * * * Calls: ... * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments: * integer ipi12(16),isoort(16),ilogi(6),npoin,ier logical ldel2s ComplexType cs3(160),clogi(6) ComplexType xqi(10),qiDqj(10,10), + xpi(6,3:4),piDpj(6,6,3:4), + sdel2,del2s(3,3:4),etalam(3:4),etami(6,3:4),alph(3), + ddel2s(2:3),delpsi(3,3:4) * * local variables: * integer i,j,k,ip,ii,ifirst,ieri(8) ComplexType c,cc ComplexType sdel2i(3,3:4),s(5),som,zfflo1, + y(4,3:4,3),z(4,3:4,3),dyz(2,2,3:4,3),d2yzz(3:4,3), + dyzzy(4,3),dsdel2,dyyzz(2,3) RealType smax,absc,xmax ComplexType zfflog external zfflo1,zfflog * * common blocks: * #include "ff.h" * * statement function * absc(c) = abs(Re(c)) + abs(Im(c)) * #] declarations: * #[ get y,z-roots: do 20 k=3,4 do 10 i=1,3 * * get roots (y,z) * ip = i+3 sdel2i(i,k) = sqrt(-del2s(i,k)) * then handle the special case Si = 0 if ( xpi(ip,k) .eq. 0 ) then if ( i .eq. 1 .and. alph(3) .eq. 0 .or. + i .eq. 3 .and. alph(1) .eq. 0 ) then isoort(2*i-1+8*(k-3)) = 0 isoort(2*i+8*(k-3)) = 0 goto 10 endif endif call ffccyz(y(1,k,i),z(1,k,i),dyz(1,1,k,i),d2yzz(k,i),i, + sdel2,sdel2i(i,k),etalam(k),etami(1,k),delpsi(i,k), + xpi(1,k),piDpj(1,1,k),isoort(2*i-1+8*(k-3)),ier) 10 continue 20 continue * #] get y,z-roots: * #[ get differences: * * the only important differences are y4z3-z3y4 and (1-y4)(1-z3)- * (1-y3)(1-z4). Note that the errors work in parallel. * do 199 i=1,8 ieri(i) = 0 199 continue if ( isoort(1) .eq. isoort(9) ) then * #[ vertices (1): som = qiDqj(7,2)/sdel2 * * flag if we have a cancellation * if ( absc(som) .lt. xloss ) then isoort(1) = isoort(1) - 10 isoort(9) = isoort(9) - 10 endif do 201 k=1,4 dyzzy(k,1) = som*z(k,3,1) if ( k .gt. 2 ) dyzzy(k,1) = -dyzzy(k,1) 201 continue dyyzz(1,1) = som dyyzz(2,1) = som * #] vertices (1): endif if ( isoort(3) .eq. isoort(11) ) then * #[ vertices (2): ifirst = 0 do 22 j=1,2 do 21 k=1,2 ii = 2*(j-1) + k dyzzy(ii,2) = y(2*j,4,2)*z(ii,3,2)-y(2*j,3,2)*z(ii,4,2) xmax = absc(y(2*j,4,2)*z(ii,3,2)) if ( absc(dyzzy(ii,2)) .ge. xmax ) goto 21 isoort(3) = isoort(3) - 10 isoort(11) = isoort(11) - 10 if ( ifirst .eq. 0 ) then if ( ddel2s(2) .eq. 0 ) then dsdel2 = 0 else dsdel2 = ddel2s(2)/(sdel2i(2,3)+sdel2i(2,4)) endif endif if ( ifirst .le. 1 ) then if ( j .eq. 1 ) then s(1) = xqi(6)*qiDqj(7,4)*qiDqj(5,4)/sdel2 s(2) = -qiDqj(7,4)*sdel2i(2,3) s(3) = +qiDqj(6,4)*dsdel2 else s(1) = xqi(6)*qiDqj(7,2)*qiDqj(5,2)/sdel2 s(2) = -qiDqj(7,2)*sdel2i(2,3) s(3) = +qiDqj(6,2)*dsdel2 endif endif if ( ifirst .le. 0 ) then ifirst = 2 s(4) = -qiDqj(5,10)*qiDqj(7,4)*sdel2i(2,3)/sdel2 s(5) = delpsi(2,3)*dsdel2/sdel2 endif if ( k .eq. 1 ) then som = s(1) + s(2) + s(3) + s(4) + s(5) else som = s(1) - s(2) - s(3) - s(4) - s(5) endif smax = max(absc(s(1)),absc(s(2)),absc(s(3)),absc(s(4)), + absc(s(5)))/Re(xqi(6))**2 if ( smax .lt. xmax ) then dyzzy(ii,2) = som*(1/Re(xqi(6))**2) xmax = smax endif 21 continue * * get dyyzz * if ( ldel2s ) then dyyzz(j,2) = dyz(2,j,4,2) - dyz(2,j,3,2) xmax = absc(dyz(2,j,4,2)) if ( absc(dyyzz(j,2)) .ge. xloss*xmax ) goto 22 print *,'ffdcc0: under construction!' * * (could be copied from real case) * endif * * bookkeeping * ifirst = ifirst - 1 22 continue * #] vertices (2): endif if ( isoort(5) .eq. isoort(13) ) then * #[ vertices (3): ifirst = 0 do 26 j=1,2 do 25 k=1,2 ii = 2*(j-1) + k dyzzy(ii,3) = y(2*j,4,3)*z(ii,3,3)-y(2*j,3,3)*z(ii,4,3) xmax = absc(y(2*j,4,3)*z(ii,3,3)) if ( absc(dyzzy(ii,3)) .ge. xmax ) goto 25 isoort(5) = isoort(5) - 10 isoort(13) = isoort(13) - 10 if ( ifirst .eq. 0 ) then if ( ddel2s(2) .eq. 0 ) then dsdel2 = 0 else dsdel2 = ddel2s(3)/(sdel2i(3,3)+sdel2i(3,4)) endif endif if ( ifirst .le. 1 ) then if ( j .eq. 1 ) then s(1) = xqi(8)*qiDqj(7,1)*qiDqj(5,1)/sdel2 s(2) = +qiDqj(7,1)*sdel2i(3,3) s(3) = +qiDqj(9,1)*dsdel2 else s(1) = xqi(8)*qiDqj(7,4)*qiDqj(5,4)/sdel2 s(2) = +qiDqj(7,4)*sdel2i(3,3) s(3) = +qiDqj(9,4)*dsdel2 endif endif if ( ifirst .le. 0 ) then ifirst = 2 s(4) = -qiDqj(5,9)*qiDqj(7,1)*sdel2i(3,3)/sdel2 s(5) = delpsi(3,3)*dsdel2/sdel2 endif if ( k .eq. 1 ) then som = s(1) + s(2) + s(3) + s(4) + s(5) else som = s(1) - s(2) - s(3) - s(4) - s(5) endif smax = max(absc(s(1)),absc(s(2)),absc(s(3)),absc(s(4)), + absc(s(5)))/Re(xqi(8))**2 if ( smax .lt. xmax ) then dyzzy(ii,3) = som*(1/Re(xqi(8))**2) xmax = smax endif 25 continue * * get dyyzz * if ( ldel2s ) then dyyzz(j,3) = dyz(2,j,4,3) - dyz(2,j,3,3) xmax = absc(dyz(2,j,4,3)) if ( absc(dyyzz(j,3)) .ge. xloss*xmax ) goto 24 print *,'ffdcc0: under construction!' * * (could be copied from real case) * endif * * bookkeeping * 24 continue ifirst = ifirst - 1 26 continue * #] vertices (3): endif ier = ier + max(ieri(1),ieri(2),ieri(3),ieri(4),ieri(5),ieri(6), + ieri(7),ieri(8)) * #] get differences: * #[ logarithms for 4point function: if ( npoin .eq. 4 ) then do 96 k = 3,4 do 95 i = 1,3 ii = i+3*(k-3) if ( ilogi(ii) .ne. -999 ) goto 95 if ( isoort(2*i+8*(k-3)) .ne. 0 ) then * maybe add sophisticated factors i*pi later c = -dyz(2,1,i,k)/dyz(2,2,i,k) cc = c-1 if ( absc(cc) .lt. xloss ) then s(1) = d2yzz(i,k)/dyz(2,2,i,k) clogi(ii) = zfflo1(s(1),ier) ilogi(ii) = 0 elseif ( Re(c) .gt. 0 ) then clogi(ii) = zfflog(c,0,czero,ier) ilogi(ii) = 0 else cc = c+1 if ( absc(cc) .lt. xloss ) then s(1) = -2*sdel2i(i,k)/dyz(2,2,i,k)/ + Re(xpi(i+3,k)) clogi(ii) = zfflo1(s(1),ier) else s(1) = 0 clogi(ii) = zfflog(-c,0,czero,ier) endif if ( Im(c) .lt. -precc*absc(c) .or. Im(s(1)) + .lt. -precc*absc(s(1)) ) then ilogi(ii) = -1 elseif ( Im(c) .gt. precc*absc(c) .or. + Im(s(1)) .gt. precc*absc(s(1)) ) then ilogi(ii) = +1 elseif ( Re(dyz(2,2,i,k)) .eq. 0 ) then ilogi(ii) = -nint(sign(1D0,Re(xpi(i+3,k)))) ier = ier + 50 print *,'doubtful imaginary part ',ilogi(ii) else call fferr(78,ier) print *,'c = ',c endif endif endif 95 continue 96 continue endif * #] logarithms for 4point function: * #[ integrals: do 100 i=1,3 j = 2*i-1 if ( isoort(j) .eq. 0 ) then if ( isoort(j+8) .ne. 0 ) then call ffcs3(cs3(20*i+61),ipi12(j+8),y(1,4,i), + z(1,4,i),dyz(1,1,4,i),d2yzz(4,i), + xpi(1,4),piDpj(1,1,4),i,6,isoort(j+8),ier) endif elseif ( isoort(j+8) .eq. 0 ) then call ffcs3(cs3(20*i-19),ipi12(j),y(1,3,i), + z(1,3,i),dyz(1,1,3,i),d2yzz(3,i), + xpi(1,3),piDpj(1,1,3),i,6,isoort(j),ier) else call ffdcs(cs3(20*i-19),ipi12(j),y(1,3,i),z(1,3,i), + dyz(1,1,3,i),d2yzz(3,i),dyzzy(1,i),dyyzz(1,i), + xpi,piDpj,i,6,isoort(j),ier) endif 100 continue * #] integrals: *###] ffdcc0: end LoopTools-2.16/src/D/PaxHeaders/ffRn.F0000644000000000000000000000007411776502523014443 xustar0030 atime=1648161785.715698398 30 ctime=1648161793.715764879 LoopTools-2.16/src/D/ffRn.F0000644000000000000000000000710511776502523015361 0ustar00rootroot00000000000000* ffRn.F * calculate Rn = \int_0^1 dx (x - cz - I signz) (x - cy - I signy) * Input: cy, cz, signz, signy * i*sign=-i*eps is needed in the case of real masses * this file is part of LoopTools * last modified 8 Dec 10 th * Written by Le Duc Ninh, MPI, Munich (Dec 15, 2008). * Spence, log and eta functions are taken from FF. * 14 Aug 2009: changed ieps of cdyza to "signy" (before used "signza"). #include "externals.h" #include "types.h" ComplexType function ffRn(cy, signy, cz, signz, ier) implicit none ComplexType cy, cz RealType signy, signz integer ier #include "ff.h" ComplexType c1, c2, c1yz, cab1, cab2, dummy RealType sz, syz, sab1, sab2 integer n ComplexType zfflog integer nffet1 external zfflog, nffet1 if( abs(cy - cz) .lt. precx ) then * cy == cza and check for singularities * be careful with log(0) singularity. sz = signz c1 = 0 c2 = 0 if( abs(Im(cy)) .lt. precx .and. signy*sz .lt. 0 ) then sz = signy if( Re(cy) .ge. 0 ) then c2 = sign(2D0, signz)*c2ipi if( Re(cy) .le. 1 ) then call ffwarn(255, ier, 1D0, 0D0) c1 = c2*(zfflog(-cy, 1, ToComplex(-sz), ier) - & zfflog(ToComplex(-1D-16), 1, ToComplex(-sz), ier)) c2 = 0 endif endif endif ffRn = .5D0*(c1 + & zfflog((cy - 1)/cy, 1, ToComplex(sz), ier)*( & zfflog(1 - cy, 1, ToComplex(-sz), ier) + & zfflog(-cy, 1, ToComplex(-sz), ier) - c2 )) return endif * calculate the sign of imaginary parts and eta functions * we do not need the ieps for y0 * if im(y0) == im(y1) we may need the ieps for the logs sz = Im(cz) if( sz .eq. 0 ) sz = signz syz = Im(cy - cz) if( syz .eq. 0 ) syz = signy c1yz = 1/(cy - cz) sab1 = Im(-cz*c1yz) if( sab1 .eq. 0 ) then sab1 = Re(cz)*signy c if( sab1 .eq. 0 ) call ffwarn(256, ier, 1D0, 0D0) * this step: not checked but same as below * choose +signy since this ieps is relevant if cza in (0,1) if( sab1 .eq. 0 ) sab1 = signy endif sab2 = Im((1 - cz)*c1yz) if( sab2 .eq. 0 ) then sab2 = -Re(1 - cz)*signy c if( sab2 .eq. 0 ) call ffwarn(257, ier, 1D0, 0D0) * this step: checked and worked * choose -signy since this ieps is relevant if cza in (0,1) if( sab2 .eq. 0 ) sab2 = -signy endif * calculate R-func from Sp-func * def: R(y0, y1) = * Sp(y0/(y0-y1)) + ln(y0/(y0-y1))*eta(-y1,1/(y0-y1)) - * Sp((y0-1)/(y0-y1)) - ln((y0-1)/(y0-y1))*eta(1-y1,1/(y0-y1)) * calculate the two dilogs * calls "ffzzdl(zdilog,ipi12,zlog,cx,ier)" in "ffcli2.F" or Li2C(z) cab1 = cy*c1yz if( Im(cab1) .eq. 0 .and. Re(cab1) .ge. 1 ) then call ffzzdl(c1, n, dummy, 1/cab1, ier) c1 = -c1 - n*pi12 - pi6 - & .5D0*zfflog(-cab1, 1, ToComplex(sab1), ier)**2 else call ffzzdl(c1, n, dummy, cab1, ier) c1 = c1 + n*pi12 endif cab2 = (cy - 1)*c1yz if( Im(cab2) .eq. 0 .and. Re(cab2) .ge. 1 ) then call ffzzdl(c2, n, dummy, 1/cab2, ier) c2 = -c2 - n*pi12 - pi6 - & .5D0*zfflog(-cab2, 1, ToComplex(sab2), ier)**2 else call ffzzdl(c2, n, dummy, cab2, ier) c2 = c2 + n*pi12 endif * calculate the two logs * ieps=1 to choose the cut along the real axis, n = nffet1(ToComplex(0D0, -sz), ToComplex(0D0, -syz), & ToComplex(0D0, sab1), ier) if( n .ne. 0 ) & c1 = c1 + n*c2ipi*zfflog(cab1, 1, ToComplex(-sab1), ier) n = nffet1(ToComplex(0D0, -sz), ToComplex(0D0, -syz), & ToComplex(0D0, sab2), ier) if( n .ne. 0 ) & c2 = c2 + n*c2ipi*zfflog(cab2, 1, ToComplex(-sab2), ier) ffRn = c1 - c2 + & zfflog((cy - 1)/cy, 1, ToComplex(signy), ier)* & zfflog(cy - cz, 1, ToComplex(signy), ier) end LoopTools-2.16/src/D/PaxHeaders/ffd0c.F0000644000000000000000000000007412271264441014525 xustar0030 atime=1648161785.715698398 30 ctime=1648161793.715764879 LoopTools-2.16/src/D/ffd0c.F0000644000000000000000000001035512271264441015444 0ustar00rootroot00000000000000* ffd0c.F * the scalar four-point function with complex masses * this file is part of LoopTools * last modified 26 Jan 14 th * Written by Le Duc Ninh, MPI, Munich (2008). * Spence, log and eta functions are taken from FF. * Please cite arXiv:0902.0325 [hep-ph] if you use this function. #include "externals.h" #include "types.h" subroutine ffd0c(cd0c, cpi, key, ier) implicit none ComplexType cd0c, cpi(10) integer key, ier #include "ff.h" #include "perm.h" integer o RealType ra, rb, rg, rc, rh, rj RealType d, a ComplexType cd, ce, ck, cfx RealType signf parameter (signf = -1) ComplexType ffT13, ffTn external ffT13, ffTn #define PP(i) Re(cpi(i+4)) #define LightLike(i) abs(PP(i)) .lt. precx * 2 lightlike momenta if( LightLike(1) .and. & LightLike(3) ) then o = p1234 else if( LightLike(2) .and. & LightLike(4) ) then o = p4123 else if( LightLike(5) .and. & LightLike(6) ) then o = p1342 else if( LightLike(1) .and. & LightLike(2) ) then o = p1234 else if( LightLike(2) .and. & LightLike(3) ) then o = p2341 else if( LightLike(3) .and. & LightLike(4) ) then o = p3412 else if( LightLike(4) .and. & LightLike(1) ) then o = p4123 * 1 lightlike momentum else if( LightLike(1) ) then o = p1234 else if( LightLike(2) ) then o = p2341 else if( LightLike(3) ) then o = p3412 else if( LightLike(4) ) then o = p4123 else if( LightLike(5) ) then o = p1342 else if( LightLike(6) ) then o = p2413 * kallen(pi, pj, pk) >= 0 #define SIDE(i,j) PP(i)*(PP(i) - 2*PP(j)) else if( SIDE(5,1) + & SIDE(1,2) + & SIDE(2,5) .ge. 0 ) then o = p1234 else if( SIDE(6,2) + & SIDE(2,3) + & SIDE(3,6) .ge. 0 ) then o = p2341 else if( SIDE(5,3) + & SIDE(3,4) + & SIDE(4,5) .ge. 0 ) then o = p3412 else if( SIDE(6,4) + & SIDE(4,1) + & SIDE(1,6) .ge. 0 ) then o = p4123 else call fferr(103, ier) return endif #define RP(i) PP(ibits(o,3*(10-i),3)) #define CM(i) cpi(ibits(o,3*(4-i),3)) rg = RP(1) rb = RP(2) rj = RP(5) - rb ra = RP(3) rc = RP(6) - ra rh = RP(4) - RP(6) cfx = CM(4) cd = CM(3) - cfx - ra ce = CM(2) - CM(3) - rc ck = CM(1) - CM(2) - rh rc = rc - rb rh = rh - rj rj = rj - rg * D0C = \int_0^1 dx \int_0^x dy \int_0^y dz * 1/(ra x^2 + rb y^2 + rg z^2 + rc xy + rh xz + rj yz + * cd x + ce y + ck z + cfx + I signf) * with signf = -eps. * important: variables "signX" is the sign of img(X) in case X becomes real. * 2 opposite lightlike momenta if( ra .eq. 0 .and. rg .eq. 0 ) then cd0c = ffT13(rb + rj, rc + rh, rb, rc, & cd, ce + ck, cfx, signf, ce, ier) return endif * 2 adjacent lightlike momenta if( rb .eq. 0 .and. rg .eq. 0 ) then cd0c = ffTn(ra, rb, rc, rh, rj, & cd, ce, cfx, signf, ck, signf, key, ier) - & ffTn(ra, rj, rc + rh, rh, rj, & cd, ce + ck, cfx, signf, ck, signf, key, ier) return endif * 1 lightlike momentum if( rg .eq. 0 ) then cd0c = ffTn(ra, rb, rc, rh, rj, & cd, ce, cfx, signf, ck, signf, key, ier) - & ffTn(ra, rj + rb, rc + rh, rh, rj, & cd, ce + ck, cfx, signf, ck, signf, key, ier) return endif * alpha is one root of: rg*alpha^2 + rj*alpha + rb == 0 * we do not need the ieps for alpha d = rj**2 - 4*rg*rb d = sqrt(d) a = -.5D0/rg*(rj + d) d = -.5D0/rg*(rj - d) * choose the bigger root or unity if( abs(a) .gt. abs(d) ) then d = rb/(rg*a) else a = rb/(rg*d) endif * which one for alpha? if( abs(d) .lt. abs(a) ) a = d cd0c = ffTn(ra + rb + rc, rg, rj + rh, & -rc - 2*rb - (rj + rh)*a, -rj - 2*a*rg, & cd + ce, ck, cfx, signf, -ce - ck*a, -signf, key, ier) if( a .ne. 1 ) then d = 1/(1 - a) cd0c = cd0c + ffTn(ra, rg + rj + rb, rc + rh, & d*(rc + rh*a), rj + 2*a*rg, & cd, ce + ck, cfx, signf, d*(ce + ck*a), d*signf, key, ier) endif if( abs(a) .lt. precx ) then call ffwarn(253, ier, 1D0, 0D0) else d = 1/a cd0c = cd0c + ffTn(ra, rb, rc, & d*rc + rh, -rj - 2*a*rg, & cd, ce, cfx, signf, d*ce + ck, d*signf, key, ier) endif end LoopTools-2.16/src/D/PaxHeaders/ffS3n.F0000644000000000000000000000007411776502523014527 xustar0030 atime=1648161785.715698398 30 ctime=1648161793.715764879 LoopTools-2.16/src/D/ffS3n.F0000644000000000000000000000532011776502523015442 0ustar00rootroot00000000000000* ffS3n.F * calculate S3n = \int_0^1 dy (ra y^2 + cb y + cc + I signc)/(y - cy) * where ra can be zero. * input: cy=y0, ra=a (real), cb=b, cc=c * signc=sign(im(c)), signy=sign(im(cy)) in case they are real. * cza and czb are the 2 roots of: a y^2 + b y + c == 0 * remarks: ieps is needed for cza, czb and y0. * this file is part of LoopTools * last modified 8 Dec 10 th * Written by Le Duc Ninh, MPI, Munich (2008). * Spence, log and eta functions are taken from FF. * Oct 27 2008 #include "externals.h" #include "types.h" ComplexType function ffS3n(cy, signy, ra, cb, cc, signc, & ier) implicit none RealType ra, signy, signc ComplexType cy, cb, cc integer ier #include "ff.h" ComplexType cl, crdisc, cza, czb RealType sza, szb, sy1, sy2, sc ComplexType ffRn, zfflog integer nffet1 external ffRn, zfflog, nffet1 * check for end-point sing. if( abs(cy) .lt. precx .or. abs(cy - 1) .lt. precx ) then call fferr(90, ier) ffS3n = 0 return endif cl = zfflog((cy - 1)/cy, 1, ToComplex(signy), ier) sc = Im(cc) if( sc .eq. 0 ) sc = signc if( abs(ra) .lt. precx ) then if( abs(cb) .lt. precx ) then * 0 roots: if( abs(cc) .lt. precx ) then call fferr(91, ier) ffS3n = 0 return endif ffS3n = cl*zfflog(cc, 1, ToComplex(signc), ier) return endif * 1 root: * eq.: b y + c == 0 cza = -cc/cb sza = -signc*Re(cb) if( sza .eq. 0 ) sza = -signc ffS3n = cl*zfflog(cb, 1, ToComplex(signc), ier) + & ffRn(cy, signy, cza, sza, ier) if( abs(Im(cb)) .gt. precx ) then szb = Im(cza) if( szb .eq. 0 ) szb = sza ffS3n = ffS3n + cl*c2ipi* & nffet1(cb, ToComplex(0D0, -szb), ToComplex(0D0, sc), ier) endif return endif * 2 roots: cza = y1, czb = y2 * eq.: y**2 + (b/a) y + (c/a) = 0 * the ieps is irrelevant here since we take into account * the contributions of both roots *** Ninh changed: 14 Aug 2009 crdisc = sqrt(cb**2/ra**2 - 4*cc/ra) cza = -.5D0*(cb/ra + crdisc) czb = -.5D0*(cb/ra - crdisc) if( abs(cza) .gt. abs(czb) ) then czb = cc/(ra*cza) else if( abs(czb) .gt. 1D-13 ) then cza = cc/(ra*czb) endif * calculate the sign of im(cza) and im(czb) which are related to ieps sza = sc/ra if( abs(Re(crdisc)) .gt. precx ) sza = sza/Re(crdisc) szb = -sza sy1 = Im(cza) if( sy1 .eq. 0 ) sy1 = sza sy2 = Im(czb) if( sy2 .eq. 0 ) sy2 = szb * calculate the log, etas, and the 2 R-functions * ieps=1 to choose the cut along the real axis ffS3n = & cl*( zfflog(ToComplex(ra), 1, ToComplex(sc), ier) + & c2ipi*nffet1(ToComplex(0D0, -sy1), ToComplex(0D0, -sy2), & ToComplex(0D0, sc/ra), ier) ) + & ffRn(cy, signy, cza, sza, ier) + & ffRn(cy, signy, czb, szb, ier) end LoopTools-2.16/src/D/PaxHeaders/ffxd0i.F0000644000000000000000000000007411776502523014730 xustar0030 atime=1648161785.715698398 30 ctime=1648161793.715764879 LoopTools-2.16/src/D/ffxd0i.F0000644000000000000000000000704511776502523015651 0ustar00rootroot00000000000000#include "externals.h" #include "types.h" *###[ ffx2ir: subroutine ffx2ir(cs1,cs2,xpip,dpipjp,ier) ***#[*comment:*********************************************************** * * * Get the terms to correct for the second IR pole which is * * treated incorrectly if the first one is regulated with a small * * mass lam and they are adjacent. It is assumed that xpi(3)= * * xpi(4)=xpi(7)=0, xpi(1)=xpi(8), xpi(2)=xpi(6). The correction * * terms are * * * * cs1 = -C0(m2^2,0,lam^2;m2^2,0,p10^2)/(s-m1^2) * * cs2 = +C0(m2^2,lam^2,0;m2^2,0,p10^2)/(s-m1^2) * * * * when xpi(4) = lambda is taken in the D0, * * * * cs1 = -C0(lam^2,0,m1^2;0,m1^2,p9^2)/(t-m2^2) * * cs2 = +C0(0,lam^2,m1^2;0,m1^2,p9^2)/(t-m2^2) * * * * when xpi(3) = lambda. Not yet tested. * * * * 10-oct-1991 Geert Jan van Oldenborgh * * * * Input: xpip(13) (real) usual 4point pi.pi * * dpipjp(10,13) (real) xpip(i) - xpip(j) * * output: xpip(13) (real) usual 4point pi.pi modified * * dpipjp(10,13) (real) xpip(i) - xpip(j) modified * * cs1,cs2 (complex) * * ier (integer) * * calls: ffxc0 * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments * integer ier ComplexType cs1,cs2 RealType xpip(13),dpipjp(10,13) * * local vars * integer itest,ier0,ier1,i,j,iinx(6,4) ComplexType cc0 RealType xpi3(6),dpipj3(6,6) save itest,iinx * * common * #include "ff.h" * * data * * 3=put mass on xpi(3) * 4=put mass on xpi(4) data itest /4/ data iinx /2,3,4,6,7,10, + 1,3,4,9,7,8, + 1,2,4,5,10,8, + 1,2,3,5,6,9/ * * #] declarations: * #[ work 3: if ( itest .eq. 3 ) then * * modify xpip,dpipjp * xpip(3) = lambda do 10 i=1,10 dpipjp(i,3) = dpipjp(i,3) - lambda 10 continue do 20 i=1,13 dpipjp(3,i) = dpipjp(3,i) + lambda 20 continue * * call first C0 * do 120 i=1,6 xpi3(i) = xpip(iinx(i,2)) do 110 j=1,6 dpipj3(j,i) = dpipjp(iinx(j,2),iinx(i,2)) 110 continue 120 continue idsub = idsub + 1 ier1 = 0 call ffxc0a(cc0,xpi3,dpipj3,ier1) cs1 = -cc0/Re(dpipjp(9,2)) * * call second C0 * xpi3(2) = 0 xpi3(3) = lambda do 130 i=1,6 dpipj3(i,2) = dpipj3(i,2) + lambda dpipj3(i,3) = dpipj3(i,3) - lambda 130 continue do 140 i=1,6 dpipj3(2,i) = dpipj3(2,i) - lambda dpipj3(3,i) = dpipj3(3,i) + lambda 140 continue idsub = idsub + 1 ier0 = 0 call ffxc0a(cc0,xpi3,dpipj3,ier0) cs2 = +cc0/Re(dpipjp(9,2)) ier1 = max(ier1,ier0) ier = ier + ier1 * #] work 3: * #[ work 4: elseif ( itest .eq. 4 ) then * * modify xpip,dpipjp * xpip(4) = lambda do 210 i=1,10 dpipjp(i,4) = dpipjp(i,4) - lambda 210 continue do 220 i=1,13 dpipjp(4,i) = dpipjp(4,i) + lambda 220 continue * * call first C0 * do 320 i=1,6 xpi3(i) = xpip(iinx(i,1)) do 310 j=1,6 dpipj3(j,i) = dpipjp(iinx(j,1),iinx(i,1)) 310 continue 320 continue idsub = idsub + 1 ier1 = 0 call ffxc0a(cc0,xpi3,dpipj3,ier1) cs1 = -cc0/Re(dpipjp(10,1)) * * call second C0 * xpi3(3) = 0 xpi3(2) = lambda do 330 i=1,6 dpipj3(i,3) = dpipj3(i,3) + lambda dpipj3(i,2) = dpipj3(i,2) - lambda 330 continue do 340 i=1,6 dpipj3(3,i) = dpipj3(3,i) - lambda dpipj3(2,i) = dpipj3(2,i) + lambda 340 continue idsub = idsub + 1 ier0 = 0 call ffxc0a(cc0,xpi3,dpipj3,ier0) cs2 = +cc0/Re(dpipjp(10,1)) ier1 = max(ier1,ier0) ier = ier + ier1 * #] work 4: * #[ error: else print *,'ffx2ir: error: itest should be either 3 or 4!',itest endif * #] error: *###] ffx2ir: end LoopTools-2.16/src/D/PaxHeaders/ffxd0tra.F0000644000000000000000000000007412024320660015251 xustar0030 atime=1648161785.715698398 30 ctime=1648161793.715764879 LoopTools-2.16/src/D/ffxd0tra.F0000644000000000000000000000716112024320660016171 0ustar00rootroot00000000000000* ffd0tra.F * a special case of the D0 function * original code by Francesco Tramontano * this file is part of LoopTools * last modified 13 Sep 12 th #include "externals.h" #include "types.h" subroutine ffd0tra(res, S, T, ML2, ME2, ier) implicit none ComplexType res RealType S, T, ML2, ME2 integer ier c===============================c c c c p1 S p2 c c \ / c c \ / c S = (p1+p2)^2 c \========/ c T = (p2+p3)^2 c || || c ML2= mass-square of the particle in the loop c || || T c ME2= mass-square of the external particle p4 c || || c c E========\ c c E ML2 \ c c E \ c c p3 c c p4^2=ME2 c c c c===============================c ComplexType xp, xm, ypS, ymS, ypT, ymT, ypE, ymE ComplexType xr, yr integer iepsS, iepsT, iepsE ComplexType ffint3 external ffint3 call fftraroot(xm, xp, xr, -ML2*(ME2 - S - T)/(S*T)) call fftraroot(ymS, ypS, yr, ML2/S) call fftraroot(ymT, ypT, yr, ML2/T) call fftraroot(ymE, ypE, yr, ML2/ME2) iepsS = 0 if( S .gt. 0 ) iepsS = 1 iepsT = 0 if( T .gt. 0 ) iepsT = 1 iepsE = 0 if( ME2 .gt. 0 ) iepsE = 1 res = ( & ffint3(ypS, xm, iepsS, ier) - ffint3(ypS, xp, iepsS, ier) + & ffint3(ymS, xm, -iepsS, ier) - ffint3(ymS, xp, -iepsS, ier) + & ffint3(ypT, xm, iepsT, ier) - ffint3(ypT, xp, iepsT, ier) + & ffint3(ymT, xm, -iepsT, ier) - ffint3(ymT, xp, -iepsT, ier) - & ffint3(ypE, xm, iepsE, ier) + ffint3(ypE, xp, iepsE, ier) - & ffint3(ymE, xm, -iepsE, ier) + ffint3(ymE, xp, -iepsE, ier) & )/(xr*S*T) end ************************************************************************ subroutine fftraroot(xm, xp, r, c) ***#[*comment:*********************************************************** * * * roots of quadratic equation x^2 + x + c == 0 * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none ComplexType xm, xp, r RealType c * #] declarations: r = sqrt(ToComplex(1 - 4*c)) xp = .5D0*(1 + r) xm = .5D0*(1 - r) if( abs(xp) .gt. abs(xm) ) then xm = c/xp else xp = c/xm endif end ************************************************************************ ComplexType function ffint3(y, x, ieps, ier) implicit none ComplexType y, x integer ieps, ier * compute \int_0^1 dz log(z - y)/(z - x) #include "ff.h" ComplexType arg1, arg2, dd1, dd2, zlog integer ipi121, ipi122 c RealType rarg1, rarg2 c equivalence (arg1, rarg1), (arg2, rarg2) c RealType ddilog c ComplexType li2 c external ddilog, li2 if( Im(x) .ne. 0 ) call ffwarn(258, ier, 1D0, 0D0) arg1 = x/(x - y) if( abs(Im(arg1)) .lt. 1D-15 ) then call ffzxdl(dd1, ipi121, zlog, arg1, ieps, ier) c dd1 = ddilog(rarg1) c if( rarg1 .gt. 1 ) c & dd1 = dd1 + eps*sign(pi, x)*log(rarg1)*cI else call ffzzdl(dd1, ipi121, zlog, arg1, ier) c dd1 = li2(arg1) endif arg2 = (x - 1)/(x - y) if( abs(Im(arg2)) .lt. 1D-15 ) then call ffzxdl(dd2, ipi122, zlog, arg2, ieps, ier) c dd2 = ddilog(rarg2) c if( rarg2 .gt. 1 ) c & dd2 = dd2 - eps*sign(pi, 1 - x)*log(rarg2)*cI else call ffzzdl(dd2, ipi122, zlog, arg2, ier) c dd2 = li2(arg2) endif ffint3 = dd1 - dd2 + (ipi121 - ipi122)*pi12 end LoopTools-2.16/src/D/PaxHeaders/ffxd0m0.F0000644000000000000000000000007411776502523015014 xustar0030 atime=1648161785.715698398 30 ctime=1648161793.715764879 LoopTools-2.16/src/D/ffxd0m0.F0000644000000000000000000000334011776502523015727 0ustar00rootroot00000000000000#include "externals.h" #include "types.h" *###[ ffxd0m0: subroutine ffxd0m0(cd0, xpi, ier) ***#[*comment:*********************************************************** * * * D0 function for 4 masses = 0 * * input parameters as for ffxd0 * * * * algorithm taken from * * Denner, Nierste, Scharf, Nucl. Phys. B367 (1991) 637-656 * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments * RealType xpi(13) ComplexType cd0 integer ier RealType a, b, c, d ComplexType x(2), z(2), k1, k2, t1, t2 ComplexType dl1, dl2, zl, ww, tlg ComplexType k12, k23, k34, k14, k13, k24 integer j, ipi1(2), ipi2(2), nffeta #include "ff.h" a = xpi(10)*xpi(7) b = xpi(9)*xpi(10) + xpi(5)*xpi(7) - xpi(8)*xpi(6) c = xpi(5)*xpi(9) d = -xpi(6) k1 = ToComplex(c, precx*d) k2 = sqrt(b*b - 4*a*k1) x(1) = (-b - k2)/2D0/a x(2) = (-b + k2)/2D0/a if( abs(x(1)) .gt. abs(x(2)) ) then x(2) = k1/(a*x(1)) else x(1) = k1/(a*x(2)) endif k12 = ToComplex(-xpi(5), -precx) k13 = ToComplex(-xpi(9), -precx) k23 = ToComplex(-xpi(6), -precx) k34 = ToComplex(-xpi(7), -precx) k14 = ToComplex(-xpi(8), -precx) k24 = ToComplex(-xpi(10), -precx) k1 = k34/k13 k2 = k24/k12 ww = log(k12) + log(k13) - log(k14) - log(k23) do 100 j = 1, 2 t1 = 1 + k1*x(j) t2 = 1 + k2*x(j) call ffzzdl(dl1, ipi1(j), zl, t1, ier) call ffzzdl(dl2, ipi2(j), zl, t2, ier) tlg = log(-x(j)) z(j) = tlg*(ww - .5D0*tlg) - dl1 - dl2 - + c2ipi*( nffeta(-x(j), k1, ier)*log(t1) + + nffeta(-x(j), k2, ier)*log(t2) ) 100 continue ww = z(2) - z(1) + + (ipi1(1) + ipi2(1) - ipi1(2) - ipi2(2))*pi12 cd0 = ww/(a*(x(1) - x(2))) end LoopTools-2.16/src/PaxHeaders/makefile0000644000000000000000000000013214160650070014740 xustar0030 mtime=1640190008.866500106 30 atime=1648161785.715698398 30 ctime=1648161793.715764879 LoopTools-2.16/src/makefile0000644000000000000000000001752714160650070015674 0ustar00rootroot00000000000000default: frontend mma$(ML) all: frontend mma1 frontend: lib $(FE) mma1: lib $(MFE) mma0 lib: $(LIB) clooptools.h $(FCC) .SUFFIXES: .SUFFIXES: .F .f90 .c OBJS = $(OBJS-quad) \ Aget.o AgetC.o \ ffxa0.o ffca0.o \ Bget.o BgetC.o Bcoeff.o BcoeffC.o \ BcoeffAD.o BcoeffFF.o BcoeffFFC.o \ ffxb0.o ffcb0.o ffxb1.o ffcb1.o \ ffxb2p.o ffcb2p.o \ ffxdb0.o ffcdb0.o ffxdb1.o \ ffdel2.o ffcel2.o \ C0func.o C0funcC.o Cget.o CgetC.o \ ffxc0.o ffcc0.o ffxc0i.o ffxc0p0.o \ ffxc0p.o ffcc0p.o ffdxc0.o ffdcc0.o \ ffdel3.o ffcel3.o \ D0func.o D0funcC.o D0z.o Dget.o DgetC.o \ ffxd0.o ffxd0h.o ffxd0i.o ffxd0p.o \ ffxd0m0.o ffxd0tra.o ffxdbd.o ffdel4.o ffd0c.o \ ffTn.o ffT13.o ffS2.o ffS3n.o ffRn.o \ E0func.o E0funcC.o Eget.o EgetC.o \ Ecoeffa.o EcoeffaC.o Ecoeffb.o EcoeffbC.o \ ffxe0.o ffdel5.o \ ini.o auxCD.o solve.o solveC.o \ Dump.o DumpC.o Li2.o Li2C.o Li2omx.o Li2omxC.o \ cache.o ffinit.o \ ffxli2.o ffcli2.o ffxxyz.o ffcxyz.o \ ffcrr.o ffcxr.o fftran.o ffabcd.o ff2dl2.o \ ffcxs3.o ffcxs4.o ffdcxs.o ffbndc.o FFINC = ff.h $(OBJS-quad) LTINC = defs.h lt.h $(FFINC) CFC = $(XFC) $(DEF)COMPLEXPARA qcomplex.o qcomplex.mod: qcomplex.f90 $(F90) -O -c -o qcomplex.o qcomplex.f90 Aget.o: Aget.F $(LTINC) $(XFC) -c -o Aget.o Aget.F AgetC.o: Aget.F $(LTINC) $(CFC) -c -o AgetC.o Aget.F ffxa0.o: ffxa0.F $(FFINC) $(XFC) -c -o ffxa0.o ffxa0.F ffca0.o: ffca0.F $(FFINC) $(XFC) -c -o ffca0.o ffca0.F Bget.o: Bget.F $(LTINC) $(XFC) -c -o Bget.o Bget.F BgetC.o: Bget.F $(LTINC) $(CFC) -c -o BgetC.o Bget.F Bcoeff.o: Bcoeff.F $(LTINC) $(XFC) -c -o Bcoeff.o Bcoeff.F BcoeffC.o: BcoeffC.F $(LTINC) $(XFC) -c -o BcoeffC.o BcoeffC.F BcoeffAD.o: BcoeffAD.F $(LTINC) $(XFC) -c -o BcoeffAD.o BcoeffAD.F BcoeffFF.o: BcoeffFF.F $(LTINC) $(XFC) -c -o BcoeffFF.o BcoeffFF.F BcoeffFFC.o: BcoeffFF.F $(LTINC) $(CFC) -c -o BcoeffFFC.o BcoeffFF.F ffxb0.o: ffxb0.F $(FFINC) $(XFC) -c -o ffxb0.o ffxb0.F ffcb0.o: ffcb0.F $(FFINC) $(XFC) -c -o ffcb0.o ffcb0.F ffxb1.o: ffxb1.F $(FFINC) $(XFC) -c -o ffxb1.o ffxb1.F ffcb1.o: ffcb1.F $(FFINC) $(XFC) -c -o ffcb1.o ffcb1.F ffxb2p.o: ffxb2p.F $(FFINC) $(XFC) -c -o ffxb2p.o ffxb2p.F ffcb2p.o: ffcb2p.F $(FFINC) $(XFC) -c -o ffcb2p.o ffcb2p.F ffxdb0.o: ffxdb0.F $(FFINC) $(XFC) -c -o ffxdb0.o ffxdb0.F ffcdb0.o: ffcdb0.F $(FFINC) $(XFC) -c -o ffcdb0.o ffcdb0.F ffxdb1.o: ffxdb1.F $(FFINC) $(XFC) -c -o ffxdb1.o ffxdb1.F ffdel2.o: ffdel2.F $(FFINC) $(XFC) -c -o ffdel2.o ffdel2.F ffcel2.o: ffcel2.F $(FFINC) $(XFC) -c -o ffcel2.o ffcel2.F C0func.o: C0func.F $(LTINC) perm.h $(XFC) -c -o C0func.o C0func.F C0funcC.o: C0funcC.F $(LTINC) $(XFC) -c -o C0funcC.o C0funcC.F Cget.o: Cget.F $(LTINC) $(XFC) -c -o Cget.o Cget.F CgetC.o: Cget.F $(LTINC) $(CFC) -c -o CgetC.o Cget.F ffxc0.o: ffxc0.F $(FFINC) $(XFC) -c -o ffxc0.o ffxc0.F ffcc0.o: ffcc0.F $(FFINC) $(XFC) -c -o ffcc0.o ffcc0.F ffxc0i.o: ffxc0i.F $(FFINC) $(XFC) -c -o ffxc0i.o ffxc0i.F ffxc0p.o: ffxc0p.F $(FFINC) $(XFC) -c -o ffxc0p.o ffxc0p.F ffxc0p0.o: ffxc0p0.F $(FFINC) $(XFC) -c -o ffxc0p0.o ffxc0p0.F ffcc0p.o: ffcc0p.F $(FFINC) $(XFC) -c -o ffcc0p.o ffcc0p.F ffdxc0.o: ffdxc0.F $(FFINC) $(XFC) -c -o ffdxc0.o ffdxc0.F ffdel3.o: ffdel3.F $(FFINC) $(XFC) -c -o ffdel3.o ffdel3.F ffcel3.o: ffcel3.F $(FFINC) $(XFC) -c -o ffcel3.o ffcel3.F D0func.o: D0func.F $(LTINC) perm.h $(XFC) -c -o D0func.o D0func.F D0funcC.o: D0funcC.F $(LTINC) $(XFC) -c -o D0funcC.o D0funcC.F D0z.o: D0z.F $(LTINC) $(XFC) -c -o D0z.o D0z.F Dget.o: Dget.F $(LTINC) $(XFC) -c -o Dget.o Dget.F DgetC.o: Dget.F $(LTINC) $(CFC) -c -o DgetC.o Dget.F ffxd0.o: ffxd0.F $(FFINC) $(XFC) -c -o ffxd0.o ffxd0.F ffxd0h.o: ffxd0h.F $(FFINC) $(XFC) -c -o ffxd0h.o ffxd0h.F ffxd0i.o: ffxd0i.F $(FFINC) $(XFC) -c -o ffxd0i.o ffxd0i.F ffxd0p.o: ffxd0p.F $(FFINC) $(XFC) -c -o ffxd0p.o ffxd0p.F ffxd0m0.o: ffxd0m0.F $(FFINC) $(XFC) -c -o ffxd0m0.o ffxd0m0.F ffxd0tra.o: ffxd0tra.F $(FFINC) $(XFC) -c -o ffxd0tra.o ffxd0tra.F ffxdbd.o: ffxdbd.F $(FFINC) $(XFC) -c -o ffxdbd.o ffxdbd.F ffdcc0.o: ffdcc0.F $(FFINC) $(XFC) -c -o ffdcc0.o ffdcc0.F ffdel4.o: ffdel4.F $(FFINC) $(XFC) -c -o ffdel4.o ffdel4.F ffd0c.o: ffd0c.F $(FFINC) perm.h $(XFC) -c -o ffd0c.o ffd0c.F ffTn.o: ffTn.F $(FFINC) $(XFC) -c -o ffTn.o ffTn.F ffT13.o: ffT13.F $(FFINC) $(XFC) -c -o ffT13.o ffT13.F ffS2.o: ffS2.F $(FFINC) $(XFC) -c -o ffS2.o ffS2.F ffS3n.o: ffS3n.F $(FFINC) $(XFC) -c -o ffS3n.o ffS3n.F ffRn.o: ffRn.F $(FFINC) $(XFC) -c -o ffRn.o ffRn.F E0func.o: E0func.F $(LTINC) $(XFC) -c -o E0func.o E0func.F E0funcC.o: E0func.F $(LTINC) $(CFC) -c -o E0funcC.o E0func.F Eget.o: Eget.F $(LTINC) $(XFC) -c -o Eget.o Eget.F EgetC.o: Eget.F $(LTINC) $(CFC) -c -o EgetC.o Eget.F Ecoeffa.o: Ecoeffa.F $(LTINC) $(XFC) -c -o Ecoeffa.o Ecoeffa.F EcoeffaC.o: Ecoeffa.F $(LTINC) $(CFC) -c -o EcoeffaC.o Ecoeffa.F Ecoeffb.o: Ecoeffb.F $(LTINC) $(XFC) -c -o Ecoeffb.o Ecoeffb.F EcoeffbC.o: Ecoeffb.F $(LTINC) $(CFC) -c -o EcoeffbC.o Ecoeffb.F ffxe0.o: ffxe0.F $(FFINC) $(XFC) -c -o ffxe0.o ffxe0.F ffdel5.o: ffdel5.F $(FFINC) $(XFC) -c -o ffdel5.o ffdel5.F ini.o: ini.F $(LTINC) $(XFC) -c -o ini.o ini.F auxCD.o: auxCD.F $(LTINC) $(XFC) -c -o auxCD.o auxCD.F solve.o: solve.F $(LTINC) $(XFC) -c -o solve.o solve.F solveC.o: solve.F $(LTINC) $(CFC) -c -o solveC.o solve.F Dump.o: Dump.F $(LTINC) $(XFC) -c -o Dump.o Dump.F DumpC.o: Dump.F $(LTINC) $(CFC) -c -o DumpC.o Dump.F Li2.o: Li2.F defs.h $(XFC) -c -o Li2.o Li2.F Li2C.o: Li2.F defs.h $(CFC) -c -o Li2C.o Li2.F Li2omx.o: Li2omx.F defs.h $(XFC) -c -o Li2omx.o Li2omx.F Li2omxC.o: Li2omx.F defs.h $(CFC) -c -o Li2omxC.o Li2omx.F cache.o: cache.c $(LTINC) $(CC) $(CFLAGS) $(CDEFS) -c -o cache.o cache.c ffinit.o: ffinit.F $(LTINC) fferr.h ffwarn.h $(XFC) -c -o ffinit.o ffinit.F ffxli2.o: ffxli2.F $(FFINC) $(XFC) -c -o ffxli2.o ffxli2.F ffcli2.o: ffcli2.F $(FFINC) $(XFC) -c -o ffcli2.o ffcli2.F ffxxyz.o: ffxxyz.F $(FFINC) $(XFC) -c -o ffxxyz.o ffxxyz.F ffcxyz.o: ffcxyz.F $(FFINC) $(XFC) -c -o ffcxyz.o ffcxyz.F ffcrr.o: ffcrr.F $(FFINC) $(XFC) -c -o ffcrr.o ffcrr.F ffcxr.o: ffcxr.F $(FFINC) $(XFC) -c -o ffcxr.o ffcxr.F fftran.o: fftran.F $(FFINC) $(XFC) -c -o fftran.o fftran.F ffabcd.o: ffabcd.F $(FFINC) $(XFC) -c -o ffabcd.o ffabcd.F ff2dl2.o: ff2dl2.F $(FFINC) $(XFC) -c -o ff2dl2.o ff2dl2.F ffcxs3.o: ffcxs3.F $(FFINC) $(XFC) -c -o ffcxs3.o ffcxs3.F ffcxs4.o: ffcxs4.F $(FFINC) $(XFC) -c -o ffcxs4.o ffcxs4.F ffdcxs.o: ffdcxs.F $(FFINC) $(XFC) -c -o ffdcxs.o ffdcxs.F ffbndc.o: ffbndc.F $(FFINC) $(XFC) -c -o ffbndc.o ffbndc.F $(LIB): $(OBJS) $(AR) $(ARFLAGS) $(LIB) $? -$(RANLIB) $(LIB) $(FE): lt.F $(LTINC) $(LIB) $(XFC) -o $(FE) lt.F $(LIB) $(LDFLAGS) -rm -f lt.o clooptools.h: clooptools.h.in ftypes.h sed "s:NOUNDERSCORE:$(NOUNDERSCORE):g" ftypes.h clooptools.h.in > clooptools.h $(FCC): fcc.in sed -e 's|^fldflags=.*|fldflags="$(LDFLAGS) $(MCLIBS)"|' \ -e 's|^cdefs=.*|cdefs="$(CDEFS)"|' \ -e 's|^cc=.*|cc="$${REALCC:-$(CC) $(CFLAGS)}"|' \ -e 's|^cxx=.*|cxx="$${REALCXX:-$(CXX) $(CXXFLAGS)}"|' fcc.in > $(FCC) chmod 755 $(FCC) rm -f $(FXX) ln -s $(FCC) $(FXX) LoopTools$(EXE): LoopTools.tm clooptools.h fortranflush.o $(LIB) $(FCC) test -d =. || ln -s . =. NM="$(NM)" DLLTOOL="$(DLLTOOL)" \ CC="./fcc" REALCC="$(CC) $(CFLAGS) $(CDEFS) $(MCDEFS)" \ CXX="./f++" REALCXX="$(CXX) $(CXXFLAGS) $(CDEFS) $(MCDEFS)" \ PATH="$$PATH:." \ "$(MCC)" LoopTools.tm -o LoopTools$(EXE) $(MCFLAGS) \ fortranflush.o $(LIB) rm -f LoopTools.tm.c LoopTools-quad$(EXE): LoopTools.tm clooptools.h fortranflush.o $(LIB) $(FCC) sed '/:Begin:/,/:End:/ s/Real/Real128/g' LoopTools.tm > LoopTools-quad.tm NM="$(NM)" DLLTOOL="$(DLLTOOL)" \ CC="./fcc-quad" REALCC="$(CC) $(CFLAGS) $(CDEFS) $(MCDEFS)" \ CXX="./f++-quad" REALCXX="$(CXX) $(CXXFLAGS) $(CDEFS) $(MCDEFS)" \ PATH="$$PATH:." \ "$(MCC)" LoopTools-quad.tm -o LoopTools-quad$(EXE) $(MCFLAGS) \ fortranflush.o $(LIB) -lpthread rm -f LoopTools.tm.c fortranflush.o: fortranflush.F $(XFC) -c -o fortranflush.o fortranflush.F LoopTools-2.16/src/PaxHeaders/C0000644000000000000000000000013214217172001013341 xustar0030 mtime=1648161793.715764879 30 atime=1648161793.715764879 30 ctime=1648161793.715764879 LoopTools-2.16/src/C/0000755000000000000000000000000014217172001014336 5ustar00rootroot00000000000000LoopTools-2.16/src/C/PaxHeaders/Cget.F0000644000000000000000000000007413262607352014427 xustar0030 atime=1648161785.715698398 30 ctime=1648161793.715764879 LoopTools-2.16/src/C/Cget.F0000644000000000000000000001476713262607352015361 0ustar00rootroot00000000000000* Cget.F * the three-point tensor coefficients * this file is part of LoopTools * improvements by M. Rauch * last modified 9 Apr 18 th #include "externals.h" #include "types.h" #define npoint 3 #include "defs.h" subroutine XCpara(para, p1, p2, p1p2, m1, m2, m3) implicit none ArgType para(1,*) ArgType p1, p2, p1p2, m1, m2, m3 #include "lt.h" P(1) = p1 P(2) = p2 P(3) = p1p2 M(1) = m1 if( abs(M(1)) .lt. minmass ) M(1) = 0 M(2) = m2 if( abs(M(2)) .lt. minmass ) M(2) = 0 M(3) = m3 if( abs(M(3)) .lt. minmass ) M(3) = 0 end ************************************************************************ memindex function XCget(p1, p2, p1p2, m1, m2, m3) implicit none ArgType p1, p2, p1p2, m1, m2, m3 #include "lt.h" memindex cacheindex external cacheindex, XCcoefx #ifdef COMPLEXPARA memindex Cget external Cget #endif ArgType para(1,Pcc) #ifdef COMPLEXPARA if( abs(Im(p1)) + abs(Im(p2)) + abs(Im(p1p2)) .gt. 0 ) & print *, "Complex momenta not implemented" if( abs(Im(m1)) + abs(Im(m2)) + abs(Im(m3)) .eq. 0 ) then XCget = Cget(p1, p2, p1p2, m1, m2, m3) - offsetC return endif #endif call XCpara(para, p1, p2, p1p2, m1, m2, m3) XCget = cacheindex(para, Cval(1,0), XCcoefx, RC*Pcc, Ncc, Cno) end ************************************************************************ subroutine XCput(res, p1, p2, p1p2, m1, m2, m3) implicit none ComplexType res(*) ArgType p1, p2, p1p2, m1, m2, m3 #include "lt.h" external XCcoefx ArgType para(1,Pcc) #ifdef COMPLEXPARA if( abs(Im(p1)) + abs(Im(p2)) + abs(Im(p1p2)) .gt. 0 ) & print *, "Complex momenta not implemented" if( abs(Im(m1)) + abs(Im(m2)) + abs(Im(m3)) .eq. 0 ) then call Cput(res, p1, p2, p1p2, m1, m2, m3) return endif #endif call XCpara(para, p1, p2, p1p2, m1, m2, m3) call cachecopy(res, para, Cval(1,0), XCcoefx, RC*Pcc, Ncc, Cno) end ************************************************************************ subroutine XC0nocache(res, p1, p2, p1p2, m1, m2, m3) implicit none ComplexType res(*) ArgType p1, p2, p1p2, m1, m2, m3 #include "lt.h" ArgType para(1,Pcc) #ifdef COMPLEXPARA if( abs(Im(p1)) + abs(Im(p2)) + abs(Im(p1p2)) .gt. 0 ) & print *, "Complex momenta not implemented" if( abs(Im(m1)) + abs(Im(m2)) + abs(Im(m3)) .eq. 0 ) then call C0nocache(res, p1, p2, p1p2, m1, m2, m3) return endif #endif call XCpara(para, p1, p2, p1p2, m1, m2, m3) call C0func(res, para) end ************************************************************************ ComplexType function XC0i(i, p1, p2, p1p2, m1, m2, m3) implicit none integer i ArgType p1, p2, p1p2, m1, m2, m3 #include "lt.h" memindex XCget external XCget memindex b b = XCget(p1, p2, p1p2, m1, m2, m3) XC0i = Cval(i+epsi,b) end ************************************************************************ ComplexType function XC0(p1, p2, p1p2, m1, m2, m3) implicit none ArgType p1, p2, p1p2, m1, m2, m3 #include "lt.h" ComplexType XC0i external XC0i XC0 = XC0i(cc0, p1, p2, p1p2, m1, m2, m3) end ************************************************************************ subroutine XCcoefx(C, para) implicit none ComplexType C(*) ArgType para(1,*) #include "lt.h" memindex b12, b23, b13 memindex XBget external XBget b12 = XBget(P(1), M(1), M(2)) b23 = XBget(P(2), M(2), M(3)) b13 = XBget(P(3), M(1), M(3)) call XCcoeff(C, para, Bval(1,b12), Bval(1,b23), Bval(1,b13)) end ************************************************************************ subroutine XCcoeff(C, para, B12, B23, B13) implicit none ComplexType C(*), B12(*), B23(*), B13(*) ArgType para(1,*) #include "lt.h" memindex XBget external XBget ArgType p1, p2, p1p2, m1, m2, m3 ArgType f1, f2 ArgQuad G(2,2) ComplexQuad bsum(0:2), b1sum(0:2), b00sum(0:2), b11sum(0:2) ComplexQuad in(0:2,2) logical dump integer perm(2) #define IN(i) in(:,perm(i)) #define OUT(i) in(:,i) #define SOLVE_SETUP XDecomp(2, G,2, perm) #define SOLVER(b) XSolve(2, G,2, b) integer finite(0:2) data finite /1, 0, 0/ serial = serial + 1 dump = ibits(debugkey, DebugC, 1) .ne. 0 .and. & serial .ge. debugfrom .and. serial .le. debugto if( dump ) call XDumpPara(3, para, "Ccoeff") m1 = M(1) m2 = M(2) m3 = M(3) p1 = P(1) p2 = P(2) p1p2 = P(3) f1 = m2 f1 = f1 - m1 f1 = f1 - p1 f2 = m3 f2 = f2 - m1 f2 = f2 - p1p2 G(1,1) = 2*p1 G(2,2) = 2*p1p2 G(1,2) = p1 G(1,2) = G(1,2) + p1p2 G(1,2) = G(1,2) - p2 G(2,1) = G(1,2) call SOLVE_SETUP bsum = B23(BB0) + B23(BB1) b1sum = B23(BB1) + B23(BB11) b00sum = B23(BB00) + B23(BB001) b11sum = B23(BB11) + B23(BB111) call XC0func(C(CC0), para) IN(1) = f1*C(CC0) - B23(BB0) + B13(BB0) IN(2) = f2*C(CC0) - B23(BB0) + B12(BB0) call SOLVER(in) C(CC1) = OUT(1) C(CC2) = OUT(2) C(CC00) = .5D0*(m1*C(CC0) - & .5D0*(f1*C(CC1) + f2*C(CC2) - B23(BB0) - finite)) IN(1) = f1*C(CC1) + bsum - 2*C(CC00) IN(2) = f2*C(CC1) + bsum + B12(BB1) call SOLVER(in) C(CC11) = OUT(1) C(CC12) = OUT(2) IN(1) = f1*C(CC2) - B23(BB1) + B13(BB1) IN(2) = f2*C(CC2) - B23(BB1) - 2*C(CC00) call SOLVER(in) C(CC12) = .5D0*(C(CC12) + OUT(1)) C(CC22) = OUT(2) C(CC001) = 1/3D0*(m1*C(CC1) - & .5D0*(f1*C(CC11) + f2*C(CC12) + bsum + finite/3D0)) C(CC002) = 1/3D0*(m1*C(CC2) - & .5D0*(f1*C(CC12) + f2*C(CC22) - B23(BB1) + finite/3D0)) bsum = bsum + b1sum IN(1) = f1*C(CC11) - bsum - 4*C(CC001) IN(2) = f2*C(CC11) - bsum + B12(BB11) call SOLVER(in) C(CC111) = OUT(1) C(CC112) = OUT(2) IN(1) = f1*C(CC22) - B23(BB11) + B13(BB11) IN(2) = f2*C(CC22) - B23(BB11) - 4*C(CC002) call SOLVER(in) C(CC122) = OUT(1) C(CC222) = OUT(2) C(CC0000) = 1/4D0*(m1*C(CC00) - & .5D0*(f1*C(CC001) + f2*C(CC002) - B23(BB00) - & finite*(m1 + m2 + m3 - .25D0*(p1 + p2 + p1p2))/6D0)) IN(1) = f1*C(CC001) + b00sum - 2*C(CC0000) IN(2) = f2*C(CC001) + b00sum + B12(BB001) call SOLVER(in) C(CC0011) = OUT(1) C(CC0012) = OUT(2) IN(1) = f1*C(CC002) - B23(BB001) + B13(BB001) IN(2) = f2*C(CC002) - B23(BB001) - 2*C(CC0000) call SOLVER(in) C(CC0012) = .5D0*(C(CC0012) + OUT(1)) C(CC0022) = OUT(2) bsum = bsum + b1sum + b11sum IN(1) = f1*C(CC111) + bsum - 6*C(CC0011) IN(2) = f2*C(CC111) + bsum + B12(BB111) call SOLVER(in) C(CC1111) = OUT(1) C(CC1112) = OUT(2) IN(1) = f1*C(CC222) - B23(BB111) + B13(BB111) IN(2) = f2*C(CC222) - B23(BB111) - 6*C(CC0022) call SOLVER(in) C(CC1222) = OUT(1) C(CC2222) = OUT(2) IN(1) = f1*C(CC122) + b11sum - 2*C(CC0022) IN(2) = f2*C(CC122) + b11sum - 4*C(CC0012) call SOLVER(in) C(CC1122) = OUT(1) C(CC1222) = .5D0*(C(CC1222) + OUT(2)) if( dump ) call XDumpCoeff(3, C) end LoopTools-2.16/src/C/PaxHeaders/ffdxc0.F0000644000000000000000000000007411776502522014720 xustar0030 atime=1648161785.715698398 30 ctime=1648161793.715764879 LoopTools-2.16/src/C/ffdxc0.F0000644000000000000000000005462111776502522015643 0ustar00rootroot00000000000000#include "externals.h" #include "types.h" *###[ ffdxc0: subroutine ffdxc0(cs3,ipi12,isoort,clogi,ilogi,xpi,dpipj,piDpj, + xqi,qiDqj,sdel2,del2s,etalam,etami,delpsi,alph, + ddel2s,ldel2s,npoin,ier) ***#[*comment:*********************************************************** * * * Calculates the difference of two threepoint functions * * C(3,...a) - C(4,...b) * * For this we not only calculate the roots of the three-point * * function y,z(1-4,3-4,1-3) but also the combinations * * * * yzzy = y(,4,)*z(,3,) - z(,4,)*y(,3,) * * and * * yyzz = y(,4,) - z(,4,) - y(,3,) + z(,3,) * * * * This is done explicitly for most special cases, so a lot of * * lines of code result. This may be shortened with a smart use * * of indices, however, it is readable now. * * * * Input: xpi(6,3:4) (real) transformed mi,pi squared in Ci * * dpipj(6,6,3:4) (real) xpi(i)-xpi(j) * * piDpj(6,6,3:4) (real) pi(i).pi(j) * * xqi(10,10) (real) transformed mi,pi squared in D * * qiDqj(10,10) (real) qi(i).qi(j) * * sdel2 (real) sqrt(delta_{p_1 p_2}^{p_1 p_2}) * * del2s(3,3:4) (real) delta_{p_i s_i}^{p_i s_i} * * etalam(3:4) (real) delta_{s_1 s_2 s_3}^{s_1 s_2 s_3} * /delta_{p_1 p_2}^{p_1 p_2} * * etami(6,3:4) (real) m_i^2 - etalam * * ddel2s(2:3) (real) del2s(i,3) - del2s(i,4) * * alph(3) (real) alph(1)=alpha, alph(3)=1-alpha * * ldel2s (logical) indicates yes/no limit del2s->0 * * * * Output: cs3 (complex)(160) C0(3)-C0(4), not yet summed. * * ipi12 (integer)(6) factors pi^2/12, not yet summed * * slam (complex) lambda(p1,p2,p3). * * isoort (integer)(16) indication of he method used * * clogi (complex)(6) log(-dyz(2,1,i)/dyz(2,2,i)) * * ilogi (integer)(6) factors i*pi in this * * ier (integer) 0=ok, 1=inaccurate, 2=error * * * * Calls: ... * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments: * integer ipi12(16),isoort(16),ilogi(6),npoin,ier logical ldel2s ComplexType cs3(160),clogi(6) RealType xqi(10),qiDqj(10,10), + xpi(6,3:4),dpipj(6,6,3:4),piDpj(6,6,3:4), + sdel2,del2s(3,3:4),etalam(3:4),etami(6,3:4),alph(3), + ddel2s(2:3),delpsi(3,3:4) * * local variables: * integer i,j,k,l,ip,ier0,ii,ifirst,ieri(12),idone(6) logical lcompl ComplexType c,csom,cs(5),csdeli(3,3:4),csdel2, + cy(4,3:4,3),cz(4,3:4,3),cdyz(2,2,3:4,3),cd2yzz(3:4,3), + cpi(6,3:4),cpiDpj(6,6,3:4),cdyzzy(4,3),cdyyzz(2,3) RealType sdel2i(3,3:4),s(5),som,smax,absc,dfflo1, + y(4,3:4,3),z(4,3:4,3),dyz(2,2,3:4,3),d2yzz(3:4,3), + dy2z(4,3:4,3),dyzzy(4,3),dsdel2,xmax ComplexType zxfflg,zfflo1 external dfflo1,zxfflg,zfflo1 * * common blocks: * #include "ff.h" * * statement function * absc(c) = abs(Re(c)) + abs(Im(c)) * #] declarations: * #[ get y,z-roots: lcompl = .FALSE. do 20 k=3,4 do 10 i=1,3 * * get roots (y,z) and flag what to do: 0=nothing, 1=normal, * -1=complex * ip = i+3 * first get the roots if ( del2s(i,k) .le. 0 ) then * real case sdel2i(i,k) = sqrt(-del2s(i,k)) * then handle the special case Si = 0 if ( xpi(ip,k) .eq. 0 ) then if ( i .eq. 1 .and. alph(3) .eq. 0 .or. + i .eq. 3 .and. alph(1) .eq. 0 ) then isoort(2*i-1+8*(k-3)) = 0 isoort(2*i+8*(k-3)) = 0 goto 10 endif endif call ffxxyz(y(1,k,i),z(1,k,i),dyz(1,1,k,i),d2yzz(k,i), + dy2z(1,k,i),i,sdel2,sdel2i(i,k),etalam(k),etami(1,k), + delpsi(i,k),xpi(1,k),dpipj(1,1,k),piDpj(1,1,k), + isoort(2*i-1+8*(k-3)),ldel2s,6,ier) else * complex case sdel2i(i,k) = sqrt(del2s(i,k)) csdeli(i,k) = ToComplex(0D0,sdel2i(i,k)) lcompl = .TRUE. call ffcxyz(cy(1,k,i),cz(1,k,i),cdyz(1,1,k,i),cd2yzz(k,i),i, + sdel2,sdel2i(i,k),etami(1,k),delpsi(i,k),xpi( + 1,k),piDpj(1,1,k),isoort(2*i-1+8*(k-3)),ldel2s,6,ier) endif 10 continue 20 continue * #] get y,z-roots: * #[ convert to complex if necessary: do 60 i=2,3 l = 2*i-1 if ( isoort(l).gt.0 .and. isoort(l+8).lt.0 ) then k = 3 * we get -5, -105 if they have equal roots, isoort=+2 * -6, -106 if they have unequal roots, isoort=+1 if ( .not.ldel2s ) then isoort(l) = isoort(l)-7 isoort(l+1) = isoort(l+1)-7 else isoort(l) = isoort(l)-207 isoort(l+1) = isoort(l+1)-207 endif elseif ( isoort(l).lt.0 .and. isoort(l+8).gt.0 ) then k = 4 if ( .not.ldel2s ) then isoort(l+8) = isoort(l+8)-7 isoort(l+9) = isoort(l+9)-7 else isoort(l+8) = isoort(l+8)-207 isoort(l+9) = isoort(l+9)-207 endif else k = 0 endif if ( k .ne. 0 ) then do 30 j=1,4 cy(j,k,i) = y(j,k,i) cz(j,k,i) = z(j,k,i) 30 continue do 50 j=1,2 do 40 l=1,2 cdyz(l,j,k,i) = dyz(l,j,k,i) 40 continue 50 continue cd2yzz(k,i) = d2yzz(k,i) csdeli(i,k) = sdel2i(i,k) endif 60 continue * #] convert to complex if necessary: * #[ get differences: * * the only important differences are y4z3-z3y4 and (1-y4)(1-z3)- * (1-y3)(1-z4) * do 100 i=1,12 ieri(i) = 0 100 continue * #[ vertices (1): som = qiDqj(7,2)/sdel2 if ( isoort(1) .ge. 0 ) then * Note that the isoorts are equal as the vertex is equal. * * flag if we have a cancellation * if ( abs(som) .lt. xloss ) then isoort(1) = isoort(1) + 10 isoort(9) = isoort(9) + 10 endif do 110 k=1,4 dyzzy(k,1) = som*z(k,3,1) if ( k .gt. 2 ) dyzzy(k,1) = -dyzzy(k,1) 110 continue else if ( abs(som) .lt. xloss ) then isoort(1) = isoort(1) - 10 isoort(9) = isoort(9) - 10 endif do 120 k=1,4 cdyzzy(k,1) = Re(som)*cz(k,3,1) if ( k .gt. 2 ) cdyzzy(k,1) = -cdyzzy(k,1) 120 continue cdyyzz(1,1) = som cdyyzz(2,1) = som endif * #] vertices (1): * #[ vertices (2): if ( isoort(3) .ge. 0 ) then * #[ real case: (note that this implies isoort(11)>0) ifirst = 0 do 150 j=1,2 do 140 k=1,2 ii = 2*(j-1) + k dyzzy(ii,2) = y(2*j,4,2)*z(ii,3,2)-y(2*j,3,2)*z(ii,4,2) xmax = abs(y(2*j,4,2)*z(ii,3,2)) if ( abs(dyzzy(ii,2)) .ge. xmax ) goto 140 isoort(3) = isoort(3) + 10 isoort(11) = isoort(11) + 10 if ( ldel2s ) then print *,'ffdxc0: not ready for del2s=0, real case' goto 130 endif if ( ifirst .le. 0 ) then if ( ddel2s(2) .eq. 0 ) then dsdel2 = 0 else dsdel2 = ddel2s(2)/(sdel2i(2,3)+sdel2i(2,4)) endif endif if ( ifirst .le. 1 ) then if ( j .eq. 1 ) then s(1) = xqi(6)*qiDqj(7,4)*qiDqj(5,4)/sdel2 s(2) = -qiDqj(7,4)*sdel2i(2,3) s(3) = +qiDqj(6,4)*dsdel2 else s(1) = xqi(6)*qiDqj(7,2)*qiDqj(5,2)/sdel2 s(2) = -qiDqj(7,2)*sdel2i(2,3) s(3) = +qiDqj(6,2)*dsdel2 endif endif if ( ifirst .le. 0 ) then ifirst = 2 s(4) = -qiDqj(5,10)*qiDqj(7,4)*sdel2i(2,3)/sdel2 s(5) = delpsi(2,3)*dsdel2/sdel2 endif if ( k .eq. 1 ) then som = s(1) + s(2) + s(3) + s(4) + s(5) else som = s(1) - s(2) - s(3) - s(4) - s(5) endif smax = max(abs(s(1)),abs(s(2)),abs(s(3)),abs(s(4)), + abs(s(5)))/xqi(6)**2 if ( smax .lt. xmax ) then dyzzy(ii,2) = som/xqi(6)**2 xmax = smax endif 130 continue 140 continue ifirst = ifirst - 1 150 continue * #] real case: else * #[ complex case: ifirst = 0 do 180 j=1,2 do 170 k=1,2 ii = 2*(j-1) + k cdyzzy(ii,2) = cy(2*j,4,2)*cz(ii,3,2)-cy(2*j,3,2)* + cz(ii,4,2) xmax = absc(cy(2*j,4,2)*cz(ii,3,2)) if ( absc(cdyzzy(ii,2)) .ge. xmax ) goto 170 isoort(3) = isoort(3) - 10 isoort(11) = isoort(11) - 10 if ( ldel2s ) then ip = 3 else ip = 6 endif if ( mod(isoort(3),10).ne.0 .or. mod(isoort(11),10).ne.0 + ) then * * one of the roots is really real * if ( ifirst .le. 0 ) then csdel2=Re(ddel2s(2))/(csdeli(2,3)+csdeli(2,4)) endif if ( ifirst .le. 1 ) then if ( j .eq. 1 .neqv. ldel2s ) then if ( .not.ldel2s ) then cs(1)=xqi(6)*qiDqj(7,4)*qiDqj(5,4)/sdel2 cs(2) = -Re(qiDqj(7,4))*csdeli(2,3) cs(3) = +Re(qiDqj(6,4))*csdel2 else cs(1)=-xqi(3)*qiDqj(5,10)*qiDqj(7,2)/ + sdel2 cs(2) = -Re(qiDqj(7,2))*csdeli(2,3) cs(3) = -Re(qiDqj(6,3))*csdel2 endif else cs(1) = xqi(ip)*qiDqj(7,2)*qiDqj(5,2)/sdel2 cs(2) = -Re(qiDqj(7,2))*csdeli(2,3) cs(3) = +Re(qiDqj(ip,2))*csdel2 endif endif if ( ifirst .le. 0 ) then ifirst = 2 if ( .not.ldel2s ) then cs(4) = -Re(qiDqj(5,10)*qiDqj(7,4)/sdel2)* + csdeli(2,3) else cs(4) = -Re(qiDqj(5,3)*qiDqj(7,2)/sdel2)* + csdeli(2,3) endif cs(5) = Re(delpsi(2,3)/sdel2)*csdel2 endif else * * both roots are complex * if ( ifirst .eq. 0 ) then dsdel2 = -ddel2s(2)/(sdel2i(2,3)+sdel2i(2,4)) csdel2 = ToComplex(0D0,dsdel2) endif if ( ifirst .le. 1 ) then if ( j .eq. 1 .neqv. ldel2s ) then if ( .not.ldel2s ) then cs(1)=xqi(6)*qiDqj(7,4)*qiDqj(5,4)/sdel2 cs(2)=-ToComplex(0D0,qiDqj(7,4)*sdel2i(2,3)) cs(3)=+ToComplex(0D0,qiDqj(6,3)*dsdel2) else cs(1)=-xqi(3)*qiDqj(5,10)*qiDqj(7,2)/ + sdel2 cs(2)=-ToComplex(0D0,qiDqj(7,2)*sdel2i(2,3)) cs(3)=-ToComplex(0D0,qiDqj(6,3)*dsdel2) endif else cs(1) = xqi(ip)*qiDqj(7,2)*qiDqj(5,2)/sdel2 cs(2) = -ToComplex(0D0,qiDqj(7,2)*sdel2i(2,3)) cs(3) = +ToComplex(0D0,qiDqj(ip,2)*dsdel2) endif endif if ( ifirst .eq. 0 ) then ifirst = 2 if ( .not.ldel2s ) then cs(4) = -ToComplex(0D0,qiDqj(5,10)*qiDqj(7,4)* + sdel2i(2,3)/sdel2) else cs(4) = -ToComplex(0D0,qiDqj(5,3)*qiDqj(7,2)* + sdel2i(2,3)/sdel2) endif cs(5) = ToComplex(0D0,delpsi(2,3)*dsdel2/sdel2) endif endif if ( k .eq. 1 ) then csom = cs(1) + cs(2) + cs(3) + cs(4) + cs(5) else csom = cs(1) - cs(2) - cs(3) - cs(4) - cs(5) endif smax = max(absc(cs(1)),absc(cs(2)),absc(cs(3)), + absc(cs(4)),absc(cs(5)))/xqi(ip)**2 if ( smax .lt. xmax ) then cdyzzy(ii,2) = csom/Re(xqi(ip))**2 xmax = smax endif 170 continue * * get cdyyzz * if ( ldel2s ) then cdyyzz(j,2) = cdyz(2,j,4,2) - cdyz(2,j,3,2) xmax = absc(cdyz(2,j,4,2)) if ( absc(cdyyzz(j,2)) .ge. xloss*xmax ) goto 175 if ( ifirst .le. 0 ) then if ( mod(isoort( 3),10).ne.0 .or. + mod(isoort(11),10).ne.0 ) then csdel2=Re(ddel2s(2))/(csdeli(2,3)+csdeli(2,4)) else dsdel2 = -ddel2s(2)/(sdel2i(2,3)+sdel2i(2,4)) csdel2 = ToComplex(0D0,dsdel2) endif endif cs(2) = csdel2/Re(xqi(3)) cs(1) = qiDqj(5,3)*qiDqj(7,2)/(sdel2*xqi(3)) if ( j .eq. 1 ) then csom = cs(1) + cs(2) else csom = cs(1) - cs(2) endif smax = absc(cs(1)) if ( smax .lt. xmax ) then cdyyzz(j,2) = csom xmax = smax endif endif * * bookkeeping * 175 continue ifirst = ifirst - 1 180 continue * #] complex case: endif * #] vertices (2): * #[ vertices (3): if ( isoort(5) .ge. 0 ) then * #[ real case: (note that this implies isoort(15)>0) ifirst = 0 do 210 j=1,2 do 200 k=1,2 ii = 2*(j-1) + k dyzzy(ii,3) = y(2*j,4,3)*z(ii,3,3)-y(2*j,3,3)*z(ii,4,3) xmax = abs(y(2*j,4,3)*z(ii,3,3)) if ( abs(dyzzy(ii,3)) .ge. xmax ) goto 200 isoort(5) = isoort(5) + 10 isoort(13) = isoort(13) + 10 if ( ldel2s ) then print *,'ffdxc0: not ready for del2s=0, real case' goto 190 endif if ( ifirst .le. 0 ) then if ( ddel2s(2) .eq. 0 ) then dsdel2 = 0 else dsdel2 = ddel2s(3)/(sdel2i(3,3)+sdel2i(3,4)) endif endif if ( ifirst .le. 1 ) then if ( j .eq. 1 ) then s(1) = xqi(8)*qiDqj(7,1)*qiDqj(5,1)/sdel2 s(2) = +qiDqj(7,1)*sdel2i(3,3) s(3) = +qiDqj(9,1)*dsdel2 else s(1) = xqi(8)*qiDqj(7,4)*qiDqj(5,4)/sdel2 s(2) = +qiDqj(7,4)*sdel2i(3,3) s(3) = +qiDqj(9,4)*dsdel2 endif endif if ( ifirst .le. 0 ) then ifirst = 2 s(4) = -qiDqj(5,9)*qiDqj(7,1)*sdel2i(3,3)/sdel2 s(5) = delpsi(3,3)*dsdel2/sdel2 endif if ( k .eq. 1 ) then som = s(1) + s(2) + s(3) + s(4) + s(5) else som = s(1) - s(2) - s(3) - s(4) - s(5) endif smax = max(abs(s(1)),abs(s(2)),abs(s(3)),abs(s(4)), + abs(s(5)))/xqi(8)**2 if ( smax .lt. xmax ) then dyzzy(ii,3) = som/xqi(8)**2 xmax = smax endif 190 continue 200 continue ifirst = ifirst - 1 210 continue * #] real case: else * #[ complex case: ifirst = 0 do 240 j=1,2 do 230 k=1,2 ii = 2*(j-1) + k cdyzzy(ii,3) = cy(2*j,4,3)*cz(ii,3,3)-cy(2*j,3,3)* + cz(ii,4,3) xmax = absc(cy(2*j,4,3)*cz(ii,3,3)) if ( absc(cdyzzy(ii,3)) .ge. xmax ) goto 230 isoort(5) = isoort(5) - 10 isoort(13) = isoort(13) - 10 if ( ldel2s ) then ip = 3 else ip = 8 endif if ( mod(isoort(3),10).ne.0 .or. mod(isoort(11),10).ne.0 + ) then * * one of the roots is really real * if ( ifirst .le. 0 ) then csdel2=Re(ddel2s(3))/(csdeli(3,3)+csdeli(3,4)) endif if ( ifirst .le. 1 ) then if ( j .eq. 1 ) then cs(1) = xqi(ip)*qiDqj(7,1)*qiDqj(5,1)/sdel2 cs(2) = +Re(qiDqj(7,1))*csdeli(3,3) if ( .not.ldel2s ) then cs(3) = +Re(qiDqj(9,1))*csdel2 else cs(3) = +Re(qiDqj(3,1))*csdel2 endif else if ( .not.ldel2s ) then cs(1) = xqi(ip)*qiDqj(7,4)*qiDqj(5,4)/ + sdel2 cs(2) = Re(qiDqj(7,4))*csdeli(3,3) else cs(1) = xqi(ip)*qiDqj(7,1)*qiDqj(5,9)/ + sdel2 cs(2) = Re(qiDqj(7,1))*csdeli(3,3) endif cs(3) = +Re(qiDqj(9,3))*csdel2 endif if ( ldel2s ) cs(3) = -cs(3) endif if ( ifirst .le. 0 ) then ifirst = 2 if ( .not.ldel2s ) then cs(4) = -Re(qiDqj(5,9)*qiDqj(7,1)/sdel2)* + csdeli(3,3) else cs(4) = Re(qiDqj(5,4)*qiDqj(7,1)/sdel2)* + csdeli(3,3) endif cs(5) = Re(delpsi(3,3)/sdel2)*csdel2 endif else * * both roots are complex * if ( ifirst .eq. 0 ) then dsdel2 = -ddel2s(3)/(sdel2i(3,3)+sdel2i(3,4)) csdel2 = ToComplex(0D0,dsdel2) endif if ( ifirst .le. 1 ) then if ( j .eq. 1 ) then cs(1) = xqi(ip)*qiDqj(7,1)*qiDqj(5,1)/sdel2 cs(2) = +ToComplex(0D0,qiDqj(7,1)*sdel2i(3,3)) if ( .not.ldel2s ) then cs(3) = +ToComplex(0D0,qiDqj(9,1)*dsdel2) else cs(3) = +ToComplex(0D0,qiDqj(3,1)*dsdel2) endif else if ( .not.ldel2s ) then cs(1)= xqi(ip)*qiDqj(7,4)*qiDqj(5,4)/ + sdel2 cs(2)=ToComplex(0D0,qiDqj(7,4)*sdel2i(3,3)) else cs(1)= xqi(ip)*qiDqj(7,1)*qiDqj(5,9)/ + sdel2 cs(2)=ToComplex(0D0,qiDqj(7,1)*sdel2i(3,3)) endif cs(3) = +ToComplex(0D0,qiDqj(9,3)*dsdel2) endif if ( ldel2s ) cs(3) = -cs(3) endif if ( ifirst .le. 0 ) then ifirst = 2 if ( .not.ldel2s ) then cs(4) = -ToComplex(0D0,qiDqj(5,9)*qiDqj(7,1)* + sdel2i(3,3)/sdel2) else cs(4) = ToComplex(0D0,qiDqj(5,4)*qiDqj(7,1)* + sdel2i(3,3)/sdel2) endif cs(5) = ToComplex(0D0,delpsi(3,3)*dsdel2/sdel2) endif endif if ( k .eq. 1 ) then csom = cs(1) + cs(2) + cs(3) + cs(4) + cs(5) else csom = cs(1) - cs(2) - cs(3) - cs(4) - cs(5) endif smax =max(absc(cs(1)),absc(cs(2)),absc(cs(3)), + absc(cs(4)),absc(cs(5)))/xqi(ip)**2 if ( smax .lt. xmax ) then cdyzzy(ii,3) = csom/Re(xqi(ip))**2 xmax = smax endif 230 continue * * get cdyyzz * if ( ldel2s ) then cdyyzz(j,3) = cdyz(2,j,4,3) - cdyz(2,j,3,3) xmax = absc(cdyz(2,j,4,3)) if ( absc(cdyyzz(j,3)) .ge. xloss*xmax ) goto 235 if ( ifirst .le. 0 ) then if ( mod(isoort( 5),10).ne.0 .or. + mod(isoort(13),10).ne.0 ) then csdel2=Re(ddel2s(3))/(csdeli(3,3)+csdeli(3,4)) else dsdel2 = -ddel2s(3)/(sdel2i(3,3)+sdel2i(3,4)) csdel2 = ToComplex(0D0,dsdel2) endif endif cs(2) = -csdel2/Re(xqi(3)) cs(1) = qiDqj(5,3)*qiDqj(7,1)/(sdel2*xqi(3)) if ( j .eq. 1 ) then csom = cs(1) + cs(2) else csom = cs(1) - cs(2) endif smax = absc(cs(1)) if ( smax .lt. xmax ) then cdyyzz(j,3) = csom xmax = smax endif endif * * bookkeeping * 235 continue ifirst = ifirst - 1 240 continue * #] complex case: endif * #] vertices (3): ier0 = 0 do 250 i = 1,12 ier0 = max(ier0,ieri(i)) 250 continue ier = ier + ier0 * #] get differences: * #[ logarithms for 4point function: * * Not yet made stable ... * if ( npoin .eq. 4 ) then do 420 i = 1,3 do 410 k = 3,4 ii = i+3*(k-3) if ( ilogi(ii) .ne. -999 ) then idone(ii) = 0 goto 410 endif l = 2*i+8*(k-3)-1 if ((isoort(l).gt.0 .or. mod(isoort(l),10).le.-5) .and. + (isoort(l+1).ge.0 .or. mod(isoort(l+1),10).le.-5)) then * #[ real case: * * the real case (isoort=-5,-6: really real but complex for ffdcs) * s(1) = -dyz(2,1,k,i)/dyz(2,2,k,i) if ( abs(s(1)-1) .lt. xloss ) then clogi(ii) = dfflo1(d2yzz(k,i)/dyz(2,2,k,i),ier) ilogi(ii) = 0 else if ( abs(s(1)+1) .lt. xloss ) then clogi(ii) = dfflo1(-2*sdel2i(i,k)/(xpi(i+3,k)* + dyz(2,2,k,i)),ier) else clogi(ii) = zxfflg(abs(s(1)),0,0D0,ier) endif if ( dyz(2,2,k,i).gt.0 .and. dyz(2,1,k,i).gt.0 ) + then ilogi(ii) = -1 elseif ( dyz(2,1,k,i).lt.0 .and. dyz(2,2,k,i).lt.0) + then ilogi(ii) = +1 else ilogi(ii) = 0 endif * in case del2s=0 and i=3 we pick up a minus sign, I think if ( ldel2s .and. i .eq. 3 ) ilogi(ii) = -ilogi(ii) endif idone(ii) = 1 * #] real case: elseif ( isoort(l) .lt. 0 ) then * #[ complex case: * for stability split the unit circle up in 4*pi/2 * (this may have to be improved to 8*pi/4...) * ier0 = 0 if ( Re(cdyz(2,1,k,i)) .gt. abs(Im(cdyz(2,1,k,i)))) + then som =2*atan2(Im(cdyz(2,1,k,i)),Re( + cdyz(2,1,k,i))) clogi(ii) = ToComplex(0D0,som) if ( Im(cdyz(2,1,k,i)) .gt. 0 ) then ilogi(ii) = -1 else ilogi(ii) = +1 endif elseif ( Re(cdyz(2,1,k,i)) .lt. + -abs(Im(cdyz(2,1,k,i))) ) then if ( Im(cdyz(2,1,k,i)) .eq. 0 ) then call fferr(82,ier) print *,'isoort = ',isoort(l),isoort(l+1) endif som = 2*atan2(-Im(cdyz(2,1,k,i)),-Re( + cdyz(2,1,k,i))) clogi(ii) = ToComplex(0D0,som) if ( Im(cdyz(2,1,k,i)) .gt. 0 ) then ilogi(ii) = +1 else ilogi(ii) = -1 endif else s(1) = -Re(cdyz(2,1,k,i)) s(2) = Im(cdyz(2,1,k,i)) som = 2*atan2(s(1),s(2)) clogi(ii) = ToComplex(0D0,som) ilogi(ii) = 0 endif idone(ii) = 1 * #] complex case: endif 410 continue if ( idone(ii) .ne. 0 .and. idone(ii-3) .ne. 0 .and. + absc(clogi(ii)-clogi(ii-3)).lt.xloss*absc(clogi(ii)) .and. + ilogi(ii).eq.ilogi(ii-3) ) then * #[ subtract more smartly: if ( isoort(l).gt.0 .and. isoort(l+1).ge.0 ) then goto 420 else cs(1) = cdyzzy(1,i) cs(2) = cdyzzy(2,i) if ( i .eq. 1 ) then cs(3) = 0 else goto 420 endif csom = cs(1) - cs(2) + cs(3) xmax = max(absc(cs(1)),absc(cs(2)),absc(cs(3))) * change this to "no warning and quit" later c = csom/(cdyz(2,2,3,i)*cdyz(2,1,4,i)) c = zfflo1(c,ier) * * the log is never much bigger than 1, so demand at least * accuracy to 0.1; this will catch all i*pi errors * if ( abs(clogi(ii-3)-clogi(ii)-c).gt.0.1 ) then print *,'ffdxc0: error in smart logs: ',clogi(ii-3)- + clogi(ii),c,' not used' goto 420 endif clogi(ii-3) = c clogi(ii) = 0 endif * #] subtract more smartly: endif 420 continue * An algorithm to obtain the sum of two small logarithms more * accurately has been put in ffcc0p, not yet here endif * #] logarithms for 4point function: * #[ real case integrals: if ( .not. lcompl ) then * normal case do 510 i=1,3 j = 2*i-1 if ( isoort(j) .eq. 0 ) then if ( isoort(j+8) .ne. 0 ) then call ffcxs3(cs3(20*i+61),ipi12(j+8),y(1,4,i), + z(1,4,i),dyz(1,1,4,i),d2yzz(4,i),dy2z(1,4,i), + xpi(1,4),piDpj(1,1,4),i,6,isoort(j+8),ier) endif elseif ( isoort(j+8) .eq. 0 ) then call ffcxs3(cs3(20*i-19),ipi12(j),y(1,3,i), + z(1,3,i),dyz(1,1,3,i),d2yzz(3,i),dy2z(1,3,i), + xpi(1,3),piDpj(1,1,3),i,6,isoort(j),ier) else call ffdcxs(cs3(20*i-19),ipi12(j),y(1,3,i),z(1,3,i), + dyz(1,1,3,i),d2yzz(3,i),dy2z(1,3,i),dyzzy(1,i), + xpi,piDpj,i,6,isoort(j),ier) endif 510 continue isoort(7) = 0 isoort(8) = 0 * #] real case integrals: * #[ complex case integrals: else * convert xpi do 540 k=3,4 *not cetami(1,k) = etami(1,k) *used cetami(3,k) = etami(3,k) do 530 i=1,6 cpi(i,k) = xpi(i,k) do 520 j=1,6 cpiDpj(j,i,k) = piDpj(j,i,k) 520 continue 530 continue 540 continue do 550 i=1,3 j = 2*i-1 if ( isoort(j) .eq. 0 ) then if ( isoort(j+8) .ne. 0 ) then call ffcxs3(cs3(20*i+61),ipi12(j+8),y(1,4,i), + z(1,4,i),dyz(1,1,4,i),d2yzz(4,i),dy2z(1,4,i), + xpi(1,4),piDpj(1,1,4),i,6,isoort(j+8),ier) endif elseif ( isoort(j+8) .eq. 0 ) then call ffcxs3(cs3(20*i-19),ipi12(j),y(1,3,i), + z(1,3,i),dyz(1,1,3,i),d2yzz(3,i),dy2z(1,3,i), + xpi(1,3),piDpj(1,1,3),i,6,isoort(j),ier) elseif ( isoort(j) .gt. 0 ) then if ( isoort(j+8) .gt. 0 ) then call ffdcxs(cs3(20*i-19),ipi12(j),y(1,3,i), + z(1,3,i),dyz(1,1,3,i),d2yzz(3,i),dy2z(1,3,i), + dyzzy(1,i),xpi,piDpj,i,6,isoort(j),ier) else print *,'ffdxc0: error: should not occur!' call ffcxs3(cs3(20*i-19),ipi12(j),y(1,3,i), + z(1,3,i),dyz(1,1,3,i),d2yzz(3,i),dy2z(1,3,i), + xpi(1,3),piDpj(1,1,3),i,6,isoort(j),ier) call ffcs3(cs3(20*i+61),ipi12(j+8),cy(1,4,i), + cz(1,4,i),cdyz(1,1,4,i),cd2yzz(4,i), + cpi(1,4),cpiDpj(1,1,4),i,6,isoort(j+8),ier) endif else if ( isoort(j+8) .lt. 0 ) then call ffdcs(cs3(20*i-19),ipi12(j),cy(1,3,i), + cz(1,3,i),cdyz(1,1,3,i),cd2yzz(3,i), + cdyzzy(1,i),cdyyzz(1,i),cpi,cpiDpj, + i,6,isoort(j),ier) else print *,'ffdxc0: error: should not occur!' call ffcs3(cs3(20*i-19),ipi12(j),cy(1,3,i), + cz(1,3,i),cdyz(1,1,3,i),cd2yzz(3,i), + cpi(1,3),cpiDpj(1,1,3),i,6,isoort(j),ier) call ffcxs3(cs3(20*i+61),ipi12(j+8),y(1,4,i), + z(1,4,i),dyz(1,1,4,i),d2yzz(4,i),dy2z(1,4,i), + xpi(1,4),piDpj(1,1,4),i,6,isoort(j+8),ier) endif endif 550 continue isoort(7) = 0 isoort(8) = 0 endif return * #] complex case integrals: *###] ffdxc0: end LoopTools-2.16/src/C/PaxHeaders/C0funcC.F0000644000000000000000000000007412301357736014767 xustar0030 atime=1648161785.715698398 30 ctime=1648161793.715764879 LoopTools-2.16/src/C/C0funcC.F0000644000000000000000000000132112301357736015677 0ustar00rootroot00000000000000* C0funcC.F * the scalar three-point function for complex parameters * this file is part of LoopTools * last modified 20 Feb 14 th #include "externals.h" #include "types.h" #define npoint 3 #include "defs.h" subroutine C0funcC(res, para) implicit none ComplexType res, para(1,*) integer ier #include "lt.h" ier = 0 call ffcc0(res, para, ier) if( ier .gt. warndigits ) then ier = 0 call ffcc0r(res, para, ier) if( ier .gt. warndigits ) then print *, "C0C claims ", ier, " lost digits" print *, " p1 =", P(1) print *, " p2 =", P(2) print *, " p1p2 =", P(3) print *, " m1 =", M(1) print *, " m2 =", M(2) print *, " m3 =", M(3) endif endif end LoopTools-2.16/src/C/PaxHeaders/ffcc0.F0000644000000000000000000000007411776502522014527 xustar0030 atime=1648161785.715698398 30 ctime=1648161793.715764879 LoopTools-2.16/src/C/ffcc0.F0000644000000000000000000006075211776502522015454 0ustar00rootroot00000000000000#include "externals.h" #include "types.h" * $Id: ffcc0.f,v 1.2 1996/06/30 19:03:55 gj Exp $ *###[ ffcc0: subroutine ffcc0(cc0,cpi,ier) ***#[*comment:*********************************************************** * * * Calculates the threepoint function closely following * * recipe in 't Hooft & Veltman, NP B(183) 1979. * * B&D metric is used throughout! * * * * p2 | | * * v | * * / \ * * m2/ \m3 * * p1 / \ p3 * * -> / m1 \ <- * * ------------------------ * * * * 1 / 1 * * = ----- \d^4Q---------------------------------------- * * ipi^2 / [Q^2-m1^2][(Q+p1)^2-m2^2][(Q-p3)^2-m3^2] * * * * If the function is infra-red divergent (p1=m2,p3=m3,m1=0 or * * cyclic) the function is calculated with a user-supplied cutoff * * lambda in the common block /ffregul/. * * * * the parameter nschem in the common block /fflags/ determines * * which recipe is followed, see ffinit.f * * * * Input: cpi(6) (complex) m1^2,m2^3,p1^2,p2^2,p3^2 * * of divergences, but C0 has none) * * /ffregul/ lambda (real) IR cutoff * * /fflags/..nschem(integer) 6: full complex, 0: real, else: * * some or all logs * * /fflags/..nwidth(integer) when |p^2-Re(m^2)| < nwidth|Im(m^2) * * use complex mass * * ier (integer) number of digits lost so far * * Output: cc0 (complex) C0, the threepoint function * * ier (integer) number of digits lost more than (at * * most) xloss^5 * * Calls: ffcc0p,ffcb0p * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments * integer ier ComplexType cc0,cpi(6) * * local variables: * integer i,j,init ComplexType cdpipj(6,6) RealType xpi(6),sprecx save init * * common blocks: * #include "ff.h" * * data * data init/0/ * * #] declarations: * #[ the real case: * * take a faster route if all masses are real or nschem < 3 * if ( nschem .ge. 3 ) then do 10 i = 1,6 if ( Im(cpi(i)) .ne. 0 ) goto 30 10 continue elseif ( init .eq. 0 ) then init = 1 print *,'ffcc0: disregarding complex masses, nschem= ', + nschem endif do 20 i = 1,6 xpi(i) = Re(cpi(i)) 20 continue sprecx = precx precx = precc call ffxc0(cc0,xpi,ier) precx = sprecx if ( ldot ) call ffcod3(cpi) return 30 continue * * #] the real case: * #[ check input: * idsub = 0 * * #] check input: * #[ convert input: do 70 i=1,6 cdpipj(i,i) = 0 do 60 j = 1,6 cdpipj(j,i) = cpi(j) - cpi(i) 60 continue 70 continue * #] convert input: * #[ call ffcc0a: call ffcc0a(cc0,cpi,cdpipj,ier) * #] call ffcc0a: *###] ffcc0: end *###[ ffcc0r: subroutine ffcc0r(cc0,cpi,ier) ***#[*comment:*********************************************************** * * * Tries all 2 permutations of the 3pointfunction * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none integer ier ComplexType cc0,cc0p,cpi(6),cqi(6) integer inew(6,2),irota,ier1,i,j,ialsav save inew #include "ff.h" data inew /1,2,3,4,5,6, + 1,3,2,6,5,4/ * #] declarations: * #[ calculations: cc0 = 0 ier = 999 ialsav = isgnal do 30 j = -1,1,2 do 20 irota=1,2 do 10 i=1,6 cqi(inew(i,irota)) = cpi(i) 10 continue print '(a,i1,a,i2)','---#[ rotation ',irota,': isgnal ', + isgnal ier1 = 0 ner = 0 id = id + 1 isgnal = ialsav call ffcc0(cc0p,cqi,ier1) ier1 = ier1 + ner print '(a,i1,a,i2)','---#] rotation ',irota,': isgnal ', + isgnal print '(a,2g28.16,i3)','c0 = ',cc0p,ier1 if ( ier1 .lt. ier ) then cc0 = cc0p ier = ier1 endif 20 continue ialsav = -ialsav 30 continue * #] calculations: *###] ffcc0r: end *###[ ffcc0a: subroutine ffcc0a(cc0,cpi,cdpipj,ier) ***#[*comment:*********************************************************** * * * see ffcc0 * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments * integer ier ComplexType cc0,cpi(6),cdpipj(6,6) * * local variables: * integer i,j,irota,inew(6,6),i1,i2,i3,initlo,ithres(3),ifound logical ljust * ComplexType cs,cs1,cs2 ComplexType cqi(6),cqiqj(6,6),cqiDqj(6,6) RealType xqi(6),dqiqj(6,6),qiDqj(6,6),sprec save initlo * * common blocks: * #include "ff.h" * * memory * integer iermem(memory),ialmem(memory),nscmem(memory),memind, + ierini ComplexType cpimem(6,memory) ComplexType cc0mem(memory) RealType dl2mem(memory) save memind,iermem,ialmem,cpimem,cc0mem data memind /0/ * * data * data inew /1,2,3,4,5,6, + 2,3,1,5,6,4, + 3,1,2,6,4,5, + 1,3,2,6,5,4, + 3,2,1,5,4,6, + 2,1,3,4,6,5/ data initlo /0/ * * #] declarations: * #[ initialisations: if ( lmem .and. memind .eq. 0 ) then do 2 i=1,memory do 1 j=1,6 cpimem(j,i) = 0 1 continue ialmem(i) = 0 nscmem(i) = -1 2 continue endif idsub = 0 ljust = .FALSE. * #] initialisations: * #[ handle special cases: if ( Im(cpi(1)).eq.0 .and. Im(cpi(2)).eq.0 .and. + Im(cpi(3)).eq.0 ) then do 4 i=1,6 xqi(i) = Re(cpi(i)) do 3 j=1,6 dqiqj(j,i) = Re(cdpipj(j,i)) 3 continue 4 continue sprec = precx precx = precc call ffxc0a(cc0,xqi,dqiqj,ier) precx = sprec if ( ldot ) call ffcod3(cpi) return endif * goto 5 * No special cases for the moment... ** * The infrared divergent diagrams cannot be complex ** * The general case cannot handle cpi=0, pj=pk. These are simple * though. ** * if ( cpi(4) .eq. 0 .and. cdpipj(5,6) .eq. 0 .and. cdpipj(1,2) * + .ne. 0 ) then * call ffcb0p(cs1,-cpi(5),cpi(1),cpi(3),cdpipj(1,6), * + cdpipj(3,5),cdpipj(1,3),ier) * call ffcb0p(cs2,-cpi(5),cpi(2),cpi(3),cdpipj(2,5), * + cdpipj(3,5),cdpipj(2,3),ier) * cs = cs1 - cs2 * cc0 = cs/cdpipj(1,2) * elseif ( cpi(6) .eq. 0 .and. cdpipj(4,5) .eq. 0 .and. * + cdpipj(3,1) .ne. 0 ) then * call ffcb0p(cs1,-cpi(4),cpi(3),cpi(2),cdpipj(3,5), * + cdpipj(2,4),cdpipj(3,2),ier) * call ffcb0p(cs2,-cpi(4),cpi(1),cpi(2),cdpipj(1,4), * + cdpipj(2,4),cdpipj(1,2),ier) * cs = cs1 - cs2 * cc0 = cs/cdpipj(3,1) * elseif ( cpi(5) .eq. 0 .and. cdpipj(6,4) .eq. 0 .and. * + cdpipj(2,3) .ne. 0 ) then * call ffcb0p(cs1,-cpi(6),cpi(2),cpi(1),cdpipj(2,4), * + cdpipj(1,6),cdpipj(2,1),ier) * call ffcb0p(cs2,-cpi(6),cpi(3),cpi(1),cdpipj(3,6), * + cdpipj(1,6),cdpipj(3,1),ier) * cs = cs1 - cs2 * cc0 = cs/cdpipj(2,3) * else * goto 5 * endif ** * common piece - excuse my style ** * print *,'ffcc0: WARNING: this algorithm has not yet been tested' * if ( absc(cs) .lt. xloss*absc(cs1) ) * + call ffwarn(26,ier,absc(cs),absc(cs1)) ** * return * 5 continue * #] handle special cases: * #[ rotate to alpha in (0,1): call ffcrt3(irota,cqi,cqiqj,cpi,cdpipj,6,2,ier) * #] rotate to alpha in (0,1): * #[ look in memory: ierini = ier+ner if ( lmem ) then do 70 i=1,memory do 60 j=1,6 if ( cqi(j) .ne. cpimem(j,i) ) goto 70 60 continue if ( ialmem(i) .ne. isgnal .or. + nscmem(i) .ne. nschem ) goto 70 * we found an already calculated masscombination .. * (maybe check differences as well) cc0 = cc0mem(i) ier = ier+iermem(i) if ( ldot ) then fodel2 = dl2mem(i) fdel2 = fodel2 * we forgot to recalculate the stored quantities ljust = .TRUE. goto 71 endif return 70 continue endif 71 continue * #] look in memory: * #[ dot products: call ffcot3(cqiDqj,cqi,cqiqj,6,ier) * * save dotproducts for tensor functions if requested * if ( ldot ) then do 75 i=1,6 do 74 j=1,6 cfpij3(j,i) = cqiDqj(inew(i,irota),inew(j,irota)) 74 continue 75 continue if ( irota .gt. 3 ) then * * the signs of the s's have been changed * do 77 i=1,3 do 76 j=4,6 cfpij3(j,i) = -cfpij3(j,i) cfpij3(i,j) = -cfpij3(i,j) 76 continue 77 continue endif * * also give the real dotproducts as reals * do 79 i=4,6 do 78 j=4,6 fpij3(j,i) = Re(cfpij3(j,i)) 78 continue 79 continue endif if ( ljust ) return * #] dot products: * #[ handle poles-only approach: sprec = precx precx = precc if ( nschem.le.6 ) then if ( initlo.eq.0 ) then initlo = 1 if ( nschem.eq.1 .or. nschem.eq.2 ) then print *,'ffcc0a: disregarding all complex masses' elseif ( nschem.eq.3 ) then print *,'ffcc0a: undefined nschem=3' elseif ( nschem.eq.4 ) then print *,'ffcc0a: using the scheme in which ', + 'complex masses are used everywhere when ', + 'there is a divergent log' elseif ( nschem.eq.5 ) then print *,'ffcc0a: using the scheme in which ', + 'complex masses are used everywhere when ', + 'there is a divergent or almost divergent log' elseif ( nschem.eq.6 ) then print *,'ffcc0a: using the scheme in which ', + 'complex masses are used everywhere when ', + 'there is a singular log' elseif ( nschem.eq.7 ) then print *,'ffcc0a: using complex masses' endif if ( nschem.ge.3 ) then print *,'ffcc0a: switching to complex when ', + '|p^2-Re(m^2)| < ',nwidth,'*|Im(m^2)|' endif endif do 9 i=1,6 xqi(i) = Re(cqi(i)) do 8 j=1,6 dqiqj(j,i) = Re(cqiqj(j,i)) qiDqj(j,i) = Re(cqiDqj(j,i)) 8 continue 9 continue i1 = 0 ithres(1) = 0 ithres(2) = 0 ithres(3) = 0 if ( nschem.le.2 ) goto 21 * do 10 i1=1,3 * * search for a combination of 2 almost on-shell particles * and a light one * i2 = mod(i1,3)+1 i3 = mod(i2,3)+1 call ffbglg(ifound,cqi,cqiqj,cqiDqj,6,i1,i2,i3,i1+3, + i3+3) if ( ifound .ne. 0 ) goto 11 10 continue i1 = 0 11 continue if ( nschem.ge.4 .and. i1.ne.0 ) goto 30 if ( nschem.le.3 ) goto 21 * do 20 i=1,3 i2 = mod(i,3)+1 call ffthre(ithres(i),cqi,cqiqj,6,i,i2,i+3) 20 continue * if ( nschem.eq.5 .and. (ithres(1).eq.2 .or. + ithres(2).eq.2 .or. ithres(3).eq.2) ) goto 30 if ( nschem.eq.6 .and. (ithres(1).eq.1 .or. + ithres(2).eq.1 .or. ithres(3).eq.1) ) goto 30 * 21 continue * * The infrared divergent diagrams are calculated in ffxc0i: * if ( dqiqj(2,4).eq.0 .and. dqiqj(3,6).eq.0 .and. xqi(1).eq.0 + .or. dqiqj(3,5).eq.0 .and. dqiqj(1,4).eq.0 .and. xqi(2).eq.0 + .or. dqiqj(1,6).eq.0 .and. dqiqj(2,5).eq.0 .and. xqi(3).eq.0 + ) then call ffxc0i(cc0,xqi,dqiqj,ier) else call ffxc0b(cc0,xqi,dqiqj,qiDqj,ier) endif * the dotproducts are already set, but I forgot this if ( ldot ) fodel2 = fdel2 goto 31 * * the complex case * 30 continue precx = sprec call ffcc0b(cc0,cqi,cqiqj,cqiDqj,ier) 31 continue * * #] handle poles-only approach: * #[ call ffcc0b: else precx = sprec call ffcc0b(cc0,cqi,cqiqj,cqiDqj,ier) endif * #] call ffcc0b: * #[ add to memory: if ( lmem ) then memind = memind + 1 if ( memind .gt. memory ) memind = 1 do 200 j=1,6 cpimem(j,memind) = cqi(j) 200 continue cc0mem(memind) = cc0 iermem(memind) = ier+ner-ierini ialmem(memind) = isgnal nscmem(memind) = nschem dl2mem(memind) = fodel2 endif * #] add to memory: *###] ffcc0a: end *###[ ffcc0b: subroutine ffcc0b(cc0,cqi,cqiqj,cqiDqj,ier) ***#[*comment:*********************************************************** * * * see ffcc0 * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none integer nerr parameter (nerr=6) * * arguments * ComplexType cc0,cqi(6),cqiqj(6,6),cqiDqj(6,6) integer ier * * local variables: * integer isoort(8),ipi12(8),i,j,k,ipi12t,ilogi(3),ier0,ieri(nerr) ComplexType cs3(80),cs,cs1,cs2,cslam,c,cel2,cel3,cel2s(3), + cel3mi(3),clogi(3),calph(3),cblph(3),cetalm,cetami(6), + csdel2,celpsi(3) RealType xmax,absc,del2,qiDqj(6,6) * * common blocks: * #include "ff.h" * * statement function: * absc(c) = abs(Re(c)) + abs(Im(c)) * * #] declarations: * #[ calculations: * * some determinants * do 98 i = 1,nerr ieri(i) = 0 98 continue do 104 i=4,6 do 103 j=4,6 qiDqj(j,i) = Re(cqiDqj(j,i)) 103 continue 104 continue call ffdel2(del2,qiDqj,6,4,5,6,1,ier) fodel2 = del2 fdel2 = fodel2 cel2 = ToComplex(Re(del2)) call ffcel3(cel3,cqiDqj) if ( Im(cel3).ne.0 .and. + abs(Im(cel3)).lt.precc*abs(Re(cel3)) ) then cel3 = Re(cel3) endif call ffcl3m(cel3mi,.TRUE.,cel3,cel2,cqi,cqiqj,cqiDqj,6, 4,5,6, + 1,3) do 105 i=1,3 j = i+1 if ( j .eq. 4 ) j = 1 call ffcel2(cel2s(i),cqiDqj,6,i+3,i,j,1,ieri(i)) k = i-1 if ( k .eq. 0 ) k = 3 call ffcl2p(celpsi(i),cqi,cqiqj,cqiDqj,i+3,j+3,k+3,i,j,k,6) 105 continue cetalm = cel3*Re(1/del2) do 108 i=1,3 cetami(i) = cel3mi(i)*Re(1/del2) 108 continue csdel2 = isgnal*Re(sqrt(-del2)) ier0 = 0 do 99 i=1,nerr ier0 = max(ier0,ieri(i)) 99 continue ier = ier + ier0 * * initialize cs3: * do 80 i=1,80 cs3(i) = 0 80 continue do 90 i=1,8 ipi12(i) = 0 90 continue * * get alpha,1-alpha * call ffcoot(cblph(1),calph(1),cqi(5),-cqiDqj(5,6),cqi(6),csdel2, + ier) call ffcoot(calph(3),cblph(3),cqi(5),-cqiDqj(5,4),cqi(4),csdel2, + ier) cs1 = cblph(1) - chalf cs2 = calph(1) - chalf if ( l4also .and. ( Re(calph(1)) .gt. 1 .or. Re(calph(1)) + .lt. 0 ) .and. absc(cs1) .lt. absc(cs2) ) then calph(1) = cblph(1) calph(3) = cblph(3) csdel2 = -csdel2 isgnal = -isgnal endif cslam = 2*csdel2 * * and the calculations * call ffcc0p(cs3,ipi12,isoort,clogi,ilogi,cqi,cqiqj,cqiDqj, + csdel2,cel2s,cetalm,cetami,celpsi,calph,3,ier) * * sum'em up: * cs = 0 xmax = 0 do 110 i=1,80 cs = cs + cs3(i) xmax = max(xmax,absc(cs)) 110 continue ipi12t = ipi12(1) do 120 i=2,8 ipi12t = ipi12t + ipi12(i) 120 continue cs = cs + ipi12t*Re(pi12) * * check for imaginary part zero (this may have to be dropped) * if ( abs(Im(cs)) .lt. precc*abs(Re(cs)) ) + cs = ToComplex(Re(cs)) cc0 = - cs/cslam * #] calculations: *###] ffcc0b: end *###[ ffcrt3: subroutine ffcrt3(irota,cqi,cdqiqj,cpi,cdpipj,ns,iflag,ier) ***#[*comment:*********************************************************** * * * rotates the arrays cpi, cdpipj into cqi,cdqiqj so that * * cpi(6),cpi(4) suffer the strongest outside cancellations and * * cpi(6) > cpi(4) if iflag = 1, so that cpi(5) largest and cpi(5) * * and cpi(6) suffer cancellations if iflag = 2. * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments: * integer irota,ns,iflag,ier ComplexType cpi(ns),cdpipj(ns,ns),cqi(ns),cdqiqj(ns,ns) * * local variables * RealType a1,a2,a3,xpimax,absc ComplexType c integer i,j,inew(6,6) save inew * * common blocks * #include "ff.h" * * data * data inew /1,2,3,4,5,6, + 2,3,1,5,6,4, + 3,1,2,6,4,5, + 1,3,2,6,5,4, + 3,2,1,5,4,6, + 2,1,3,4,6,5/ * * statement function * absc(c) = abs(Re(c)) + abs(Im(c)) * * #] declarations: * #[ get largest cancellation: if ( iflag .eq. 1 ) then a1 = absc(cdpipj(6,4))/max(absc(cpi(6)+cpi(4)),xclogm) a2 = absc(cdpipj(5,4))/max(absc(cpi(5)+cpi(4)),xclogm) a3 = absc(cdpipj(5,6))/max(absc(cpi(6)+cpi(5)),xclogm) if ( a1 .le. a2 .and. a1 .le. a3 ) then if ( absc(cpi(6)) .lt. absc(cpi(4)) ) then irota = 4 else irota = 1 endif elseif ( a2 .le. a3 ) then if ( absc(cpi(4)) .lt. absc(cpi(5)) ) then irota = 6 else irota = 3 endif else if ( absc(cpi(5)) .lt. absc(cpi(6)) ) then irota = 5 else irota = 2 endif endif elseif ( iflag .eq. 2 ) then xpimax = max(Re(cpi(4)),Re(cpi(5)),Re(cpi(6))) if ( xpimax .eq. 0 ) then if ( Re(cpi(5)) .ne. 0 ) then irota = 1 elseif ( Re(cpi(4)) .ne. 0 ) then irota = 2 elseif ( Re(cpi(6)) .ne. 0 ) then irota = 3 else call fferr(40,ier) return endif elseif ( Re(cpi(5)) .eq. xpimax ) then if ( Re(cpi(4)) .le. Re(cpi(6)) ) then irota = 1 else irota = 4 endif elseif ( Re(cpi(4)) .eq. xpimax ) then if ( Re(cpi(5)) .ge. Re(cpi(6)) ) then irota = 2 else irota = 5 endif else if ( Re(cpi(4)) .ge. Re(cpi(6)) ) then irota = 3 else irota = 6 endif endif else call fferr(35,ier) endif * #] get largest cancellation: * #[ rotate: do 20 i=1,6 cqi(inew(i,irota)) = cpi(i) do 10 j=1,6 cdqiqj(inew(i,irota),inew(j,irota)) = cdpipj(i,j) 10 continue 20 continue * #] rotate: *###] ffcrt3: end *###[ ffcot3: subroutine ffcot3(cpiDpj,cpi,cdpipj,ns,ier) ***#[*comment:*********************************************************** * * * calculate the dotproducts pi.pj with * * * * pi = si i1=1,3 * * pi = p(i-3) i1=4,6 * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments * integer ns,ier ComplexType cpi(ns),cdpipj(ns,ns),cpiDpj(ns,ns) * * locals * integer is1,is2,is3,ip1,ip2,ip3,ier1 ComplexType c RealType absc * * rest * #include "ff.h" absc(c) = abs(Re(c)) + abs(Im(c)) * * #] declarations: * #[ calculations: * ier1 = 0 do 10 is1=1,3 is2 = is1 + 1 if ( is2 .eq. 4 ) is2 = 1 is3 = is2 + 1 if ( is3 .eq. 4 ) is3 = 1 ip1 = is1 + 3 ip2 = is2 + 3 ip3 = is3 + 3 * * pi.pj, si.sj * cpiDpj(is1,is1) = cpi(is1) cpiDpj(ip1,ip1) = cpi(ip1) * * si.s(i+1) * if ( absc(cdpipj(is1,ip1)) .le. absc(cdpipj(is2,ip1)) ) then cpiDpj(is1,is2) = (cdpipj(is1,ip1) + cpi(is2))/2 else cpiDpj(is1,is2) = (cdpipj(is2,ip1) + cpi(is1))/2 endif cpiDpj(is2,is1) = cpiDpj(is1,is2) * * pi.si * if ( absc(cdpipj(is2,is1)) .le. absc(cdpipj(is2,ip1)) ) then cpiDpj(ip1,is1) = (cdpipj(is2,is1) - cpi(ip1))/2 else cpiDpj(ip1,is1) = (cdpipj(is2,ip1) - cpi(is1))/2 endif cpiDpj(is1,ip1) = cpiDpj(ip1,is1) * * pi.s(i+1) * if ( absc(cdpipj(is2,is1)) .le. absc(cdpipj(ip1,is1)) ) then cpiDpj(ip1,is2) = (cdpipj(is2,is1) + cpi(ip1))/2 else cpiDpj(ip1,is2) = (cdpipj(ip1,is1) + cpi(is2))/2 endif cpiDpj(is2,ip1) = cpiDpj(ip1,is2) * * pi.s(i+2) * if ( (absc(cdpipj(is2,is1)) .le. absc(cdpipj(ip3,is1)) .and. + absc(cdpipj(is2,is1)) .le. absc(cdpipj(is2,ip2))) .or. + (absc(cdpipj(ip3,ip2)) .le. absc(cdpipj(ip3,is1)) .and. + absc(cdpipj(ip3,ip2)).le.absc(cdpipj(is2,ip2))))then cpiDpj(ip1,is3) = (cdpipj(ip3,ip2)+cdpipj(is2,is1))/2 else cpiDpj(ip1,is3) = (cdpipj(ip3,is1)+cdpipj(is2,ip2))/2 endif cpiDpj(is3,ip1) = cpiDpj(ip1,is3) * * pi.p(i+1) * if ( absc(cdpipj(ip3,ip1)) .le. absc(cdpipj(ip3,ip2)) ) then cpiDpj(ip1,ip2) = (cdpipj(ip3,ip1) - cpi(ip2))/2 else cpiDpj(ip1,ip2) = (cdpipj(ip3,ip2) - cpi(ip1))/2 endif cpiDpj(ip2,ip1) = cpiDpj(ip1,ip2) 10 continue ier = ier + ier1 * #] calculations: *###] ffcot3: end *###[ ffbglg: subroutine ffbglg(ifound,cqi,cqiqj,cqiDqj,ns,i1,i2,i3,ip1,ip3) ***#[*comment:*********************************************************** * * * Find a configuration which contains big logs, i.e. terms which * * would be IR divergent but for the finite width effects. * * We also use the criterium that delta^{s1 s2 s[34]}_{s1 s2 s[34]}* * should not be 0 when m^2 is shifted over nwidth*Im(m^2) * * * * Input: cqi(ns) (complex) masses, p^2 * * cqiqj(ns,ns) (complex) diff cqi(i)-cqi(j) * * * cqiDqj(ns,ns) (complex) cqi(i).cqi(j) * * * ns (integer) size of cqi,cqiqj * * i1,i2,i3 (integer) combo to be tested * * small,~onshell,~onshell * * ip1,ip3 (integer) (i1,i2) and (i1,i3) inx * * Output: ifound (integer) 0: no divergence, 1: IR * * -1: del(s,s,s)~0 * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments * integer ifound,ns,i1,i2,i3,ip1,ip3 ComplexType cqi(ns),cqiqj(ns,ns),cqiDqj(ns,ns) * * locals vars * integer i123 RealType absc ComplexType cel3,cdm2,cdm3,c * * common blocks * #include "ff.h" * * statement function * absc(c) = abs(Re(c)) + abs(Im(c)) * * #] declarations: * #[ work: ifound = 0 if ( abs(Re(cqi(i1))) .lt. -xloss*(Im(cqi(i2)) + + Im(cqi(i3))) + .and. abs(Re(cqiqj(ip1,i2))) .le. -nwidth*Im(cqi(i2)) + .and. abs(Re(cqiqj(ip3,i3))) .le. -nwidth*Im(cqi(i3)) + ) then ifound = 1 return endif if ( nschem.ge.5 .and. cqi(i1).eq.0 ) then i123 = 2**i1 + 2**i2 + 2**i3 if ( i123.eq.2**1+2**2+2**3 .or. i123.eq.2**1+2**2+2**4 ) + then cel3 = - cqiDqj(i1,i2)**2*cqi(i3) + - cqiDqj(i1,i3)**2*cqi(i2) + + 2*cqiDqj(i1,i2)*cqiDqj(i1,i3)*cqiDqj(i2,i3) cdm2 = cqiDqj(i1,i2)*cqiDqj(ip3,i3) + + cqiDqj(i1,i3)*cqiDqj(ip1,i3) cdm3 = -cqiDqj(i1,i2)*cqiDqj(ip3,i2) - + cqiDqj(i1,i3)*cqiDqj(ip1,i2) if ( 2*absc(cel3) .lt.-nwidth*(absc(cdm2)*Im(cqi(i2)) + + absc(cdm3)*Im(cqi(i3))) ) then ifound = -1 endif endif endif * #] work: *###] ffbglg: end *###[ ffthre: subroutine ffthre(ithres,cqi,cqiqj,ns,i1,i2,ip) ***#[*comment:*********************************************************** * * * look for threshold effects. * * ithres = 1: 3 heavy masses * * ithres = 2: 2 masses almost equal and 1 zero * * * * Input: cqi(ns) (complex) usual masses,p^2 * * cqiqj(ns,ns) (complex) cqi(i)-cqi(j) * * ns (integer) size * * i1,i2 (integer) position to be tested * * ip (integer) (i1,i2) index * * * * Output: ithres (integer) see above, 0 if nothing * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments * integer ithres,ns,i1,i2,ip ComplexType cqi(ns),cqiqj(ns,ns) * * local variables * integer ier0 ComplexType c RealType absc,xq1,xq2,xq3,dq1q2,dq1q3,dq2q3,xlam,d1,d2, + sprecx * * common blocks * #include "ff.h" * * statement function * absc(c) = abs(Re(c)) + abs(Im(c)) * * #] declarations: * #[ work: ithres = 0 if ( Im(cqi(i1)).eq.0 .and. Im(cqi(i2)).eq.0 .or. + nschem.le.4 ) return if ( Re(cqi(i1)).lt.-Im(cqi(i2)) .and. + abs(Re(cqiqj(ip,i2))).lt.-nwidth*Im(cqi(i2)) + .or. Re(cqi(i2)).lt.-Im(cqi(i1)) .and. + abs(Re(cqiqj(ip,i1))).lt.-nwidth*Im(cqi(i1)) ) then ithres = 2 elseif ( nschem.ge.6 .and. Re(cqi(i1)).ne.0 .and. + Re(cqi(i2)).ne.0 ) then ier0 = 0 xq1 = Re(cqi(i1)) xq2 = Re(cqi(i2)) xq3 = Re(cqi(ip)) dq1q2 = Re(cqiqj(i1,i2)) dq1q3 = Re(cqiqj(i1,ip)) dq2q3 = Re(cqiqj(i2,ip)) sprecx = precx precx = precc call ffxlmb(xlam,xq1,xq2,xq3, dq1q2,dq1q3,dq2q3) precx = sprecx d1 = absc(cqiqj(i1,ip) - cqi(i2)) d2 = absc(cqiqj(i2,ip) - cqi(i1)) * if ( d1 .lt. -nwidth*Im(cqi(i1)) .or. ** + d2 .lt. -nwidth*Im(cqi(i2)) ) ** + call ffwarn(182,ier0,x1,x1) if ( abs(xlam) .lt. -nwidth*(Re(d1)* + Im(cqi(i1)) + d2*Im(cqi(i2))) ) then ithres = 1 endif endif * #] work: *###] ffthre: end *###[ ffcod3: subroutine ffcod3(cpi) ***#[*comment:*********************************************************** * * * Convert real dorproducts into complex ones, adding the * * imaginary parts where appropriate. * * * * Input: cpi(6) complex m^2, p^2 * * /ffdots/fpij3(6,6) real p.p real * * * * Output: /ffcots/cfpij3(6,6) complex p.p complex * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments * ComplexType cpi(6) * * local variables * integer i,i1,i2,ip * * common blocks * #include "ff.h" * * #] declarations: * #[ add widths: * do 25 i=1,3 ip = i+3 i1 = 1 + mod(i,3) i2 = 1 + mod(i1,3) * s.s cfpij3(i,i) = cpi(i) cfpij3(i1,i) = ToComplex(Re(fpij3(i1,i)), + (Im(cpi(i1))+Im(cpi(i)))/2) cfpij3(i,i1) = cfpij3(i1,i) * s.p cfpij3(i,ip) = ToComplex(Re(fpij3(i,ip)), + (Im(cpi(i1))-Im(cpi(i)))/2) cfpij3(ip,i) = cfpij3(i,ip) cfpij3(i1,ip) = ToComplex(Re(fpij3(i1,ip)), + (Im(cpi(i1))-Im(cpi(i)))/2) cfpij3(ip,i1) = cfpij3(i1,ip) cfpij3(i2,ip) = ToComplex(Re(fpij3(i2,ip)), + (Im(cpi(i1))-Im(cpi(i)))/2) cfpij3(ip,i2) = cfpij3(i2,ip) * p.p cfpij3(ip,ip) = cpi(ip) cfpij3(ip,i1+3) = fpij3(ip,i1+3) cfpij3(i1+3,ip) = cfpij3(ip,i1+3) 25 continue fodel2 = fdel2 * * #] add widths: *###] ffcod3: end LoopTools-2.16/src/C/PaxHeaders/ffxc0p0.F0000644000000000000000000000007411776502522015014 xustar0030 atime=1648161785.719698432 30 ctime=1648161793.715764879 LoopTools-2.16/src/C/ffxc0p0.F0000644000000000000000000000276511776502522015741 0ustar00rootroot00000000000000#include "externals.h" #include "types.h" *###[ ffxc0p0 subroutine ffxc0p0(cc0, xpi) ***#[*comment:*********************************************************** * * * C0 function for all three momenta^2 = 0 * * input parameters as for ffxc0 * * * * original code from David Garcia * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments * ComplexType cc0 RealType xpi(6) RealType m1, m2, m3, m #include "ff.h" m1 = xpi(1) m2 = xpi(2) m3 = xpi(3) * sort the masses such that m1 >= m2 >= m3 * this is important to avoid complex logs later if( m1 .lt. m2 ) then m = m2 m2 = m1 m1 = m endif if( m2 .lt. m3 ) then m = m3 m3 = m2 m2 = m endif if( m1 .lt. m2 ) then m = m2 m2 = m1 m1 = m endif m = (m1 + m2 + m3)*1D-6 if( m3 .gt. m ) then * non-zero masses: if( m2 - m3 .gt. m ) then if( m1 - m2 .gt. m ) then * m1 != m2 != m3 cc0 = (log(m3/m2) + m1/(m3 - m1)*log(m3/m1) - & m1/(m2 - m1)*log(m2/m1))/(m2 - m3) else * m1 = m2 != m3 cc0 = (1 - m3/(m2 - m3)*log(m2/m3))/(m3 - m2) endif else if( m1 - m2 .gt. m ) then * m1 != m2 = m3 cc0 = (1 - m1/(m2 - m1)*log(m2/m1))/(m1 - m2) else * m1 = m2 = m3 cc0 = -.5D0/m1 endif endif else * zero masses: if( m1 - m2 .gt. m ) then * m1 != m2, m3 = 0 cc0 = log(m2/m1)/(m1 - m2) else * m1 = m2, m3 = 0 cc0 = -1/m1 endif endif end LoopTools-2.16/src/C/PaxHeaders/ffxc0.F0000644000000000000000000000007411776502522014554 xustar0030 atime=1648161785.719698432 30 ctime=1648161793.715764879 LoopTools-2.16/src/C/ffxc0.F0000644000000000000000000004162511776502522015477 0ustar00rootroot00000000000000#include "externals.h" #include "types.h" * $Id: ffxc0.f,v 1.5 1996/08/15 09:36:47 gj Exp $ *###[ ffxc0: subroutine ffxc0(cc0,xpi,ier) ***#[*comment:*********************************************************** * * * Calculates the threepoint function closely following * * recipe in 't Hooft & Veltman, NP B(183) 1979. * * Bjorken and Drell metric is used nowadays! * * * * p2 | | * * v | * * / \ * * m2/ \m3 * * p1 / \ p3 * * -> / m1 \ <- * * ------------------------ * * * * 1 / 1 * * = ----- \d^4Q---------------------------------------- * * ipi^2 / [Q^2-m1^2][(Q+p1)^2-m2^2][(Q-p3)^2-m3^2] * * * * If the function is infra-red divergent (p1=m2,p3=m3,m1=0 or * * cyclic) the function is calculated with a user-supplied cutoff * * lambda in the common block /ffregul/. * * * * Input: xpi (real) i=1,3: mass^2, i=4,6: pi.pi * * Output: cc0 (complex) C0, the threepoint function. * * ier (integer) 0=ok, 1=inaccurate, 2=error * * Calls: ffxc0p,ffxb0p * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments * ComplexType cc0 RealType xpi(6) integer ier * * local variables: * integer i,j RealType dpipj(6,6) * * common blocks: * #include "ff.h" * #] declarations: * #[ special case: all momenta^2 = 0 * if (abs(xpi(4)) + abs(xpi(5)) + abs(xpi(6)) .lt. 1D-10) then call ffxc0p0(cc0, xpi) return endif * #[ convert input: do 40 i=1,6 do 39 j = 1,6 dpipj(j,i) = xpi(j) - xpi(i) 39 continue 40 continue * #] convert input: * #[ call ffxc0a: call ffxc0a(cc0,xpi,dpipj,ier) * #] call ffxc0a: *###] ffxc0: end *###[ ffxc0a: subroutine ffxc0a(cc0,xpi,dpipj,ier) ***#[*comment:*********************************************************** * * * See ffxc0. * * * * Input: xpi (real) i=1,3: mass^2, i=4,6: pi.pi * * dpipj (real) = xpi(i) - xpi(j) * * Output: cc0 (complex) C0, the threepoint function. * * ier (integer) 0=ok, 1=inaccurate, 2=error * * Calls: ffxc0p,ffxb0p * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments * ComplexType cc0 RealType xpi(6),dpipj(6,6) integer ier * * local variables: * logical ljust integer i,j,inew(6,6) * ComplexType cs,cs1,cs2 RealType xqi(6),dqiqj(6,6),qiDqj(6,6),lambda0,dum66(6,6) save inew,lambda0 * * common blocks: * #include "ff.h" * * memory * integer iermem(memory),ialmem(memory),memind,ierini RealType xpimem(6,memory),dl2mem(memory) ComplexType cc0mem(memory) save memind,iermem,ialmem,xpimem,dl2mem,cc0mem data memind /0/ * * data * data lambda0 /1.D0/ data inew /1,2,3,4,5,6, + 2,3,1,5,6,4, + 3,1,2,6,4,5, + 1,3,2,6,5,4, + 3,2,1,5,4,6, + 2,1,3,4,6,5/ * #] declarations: * #[ initialisations: if ( lmem .and. memind .eq. 0 ) then do 2 i=1,memory do 1 j=1,6 xpimem(j,i) = 0 1 continue ialmem(i) = 0 2 continue endif idsub = 0 ljust = .FALSE. * #] initialisations: * #[ handle special cases: * * The infrared divergent diagrams are calculated in ffxc0i: * if ( dpipj(2,4).eq.0 .and. dpipj(3,6).eq.0 .and. xpi(1).eq.0 + .or. dpipj(3,5).eq.0 .and. dpipj(1,4).eq.0 .and. xpi(2).eq.0 + .or. dpipj(1,6).eq.0 .and. dpipj(2,5).eq.0 .and. xpi(3).eq.0 ) + then call ffxc0i(cc0,xpi,dpipj,ier) return endif * #] handle special cases: * #[ rotate to alpha in (0,1): call ffrot3(irota3,xqi,dqiqj,qiDqj,xpi,dpipj,dum66,2,3,ier) * #] rotate to alpha in (0,1): * #[ look in memory: ierini = ier+ner if ( lmem .and. lambda .eq. lambda0 ) then do 70 i=1,memory do 60 j=1,6 if ( xqi(j) .ne. xpimem(j,i) ) goto 70 60 continue if ( ialmem(i) .ne. isgnal ) goto 70 * we found an already calculated mass combination .. * (maybe check differences as well) cc0 = cc0mem(i) ier = ier+iermem(i) if ( ldot ) then fdel2 = dl2mem(i) * we forgot to recalculate the stored quantities ljust = .TRUE. goto 71 endif return 70 continue elseif ( lmem ) then lambda0 = lambda endif 71 continue * #] look in memory: * #[ dot products: call ffdot3(qiDqj,xqi,dqiqj,6,ier) * * save dotproducts for tensor functions if requested * if ( ldot ) then do 75 i=1,6 do 74 j=1,6 fpij3(j,i) = qiDqj(inew(i,irota3),inew(j,irota3)) 74 continue 75 continue if ( irota3 .gt. 3 ) then * * the sign of the s's has been changed! * do 77 i=1,3 do 76 j=4,6 fpij3(j,i) = -fpij3(j,i) fpij3(i,j) = -fpij3(i,j) 76 continue 77 continue endif endif if ( ljust ) return * #] dot products: * #[ call ffxc0b: call ffxc0b(cc0,xqi,dqiqj,qiDqj,ier) * #] call ffxc0b: * #[ add to memory: if ( lmem ) then memind = memind + 1 if ( memind .gt. memory ) memind = 1 do 200 j=1,6 xpimem(j,memind) = xqi(j) 200 continue cc0mem(memind) = cc0 iermem(memind) = ier+ner-ierini ialmem(memind) = isgnal dl2mem(memind) = fdel2 endif * #] add to memory: *###] ffxc0a: end *###[ ffxc0b: subroutine ffxc0b(cc0,xqi,dqiqj,qiDqj,ier) ***#[*comment:*********************************************************** * * * See ffxc0. * * * * Input: xpi (real) i=1,3: mass^2, i=4,6: pi.pi * * dpipj (real) = xpi(i) - xpi(j) * * Output: cc0 (complex) C0, the threepoint function. * * ier (integer) 0=ok, 1=inaccurate, 2=error * * Calls: ffxc0p,ffxb0p * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments * ComplexType cc0 RealType xqi(6),dqiqj(6,6),qiDqj(6,6) integer ier * * local variables: * integer nerr parameter(nerr=6) integer isoort(8),ipi12(8),i,j,k,ipi12t,ilogi(3),ier0,ieri(nerr) ComplexType cs3(80),cs,c,clogi(3),cslam,cetalm, + cetami(6),cel2s(3),calph(3),cblph(3),csdel2, + cqi(6),cdqiqj(6,6),cqiDqj(6,6),celpsi(3) RealType del2,del2s(3),del3,delpsi(3), + del3mi(3) RealType xmax,absc,alph(3),etalam,etami(6),sdel2, + blph(3) * * common blocks: * #include "ff.h" * * statement function: * absc(c) = abs(Re(c)) + abs(Im(c)) * * #] declarations: * #[ calculations: * * some determinants * do 98 i = 1,nerr ieri(i) = 0 98 continue call ffdel2(del2,qiDqj, 6, 4,5,6, 1,ier) if ( ldot ) fdel2 = del2 if ( del2 .gt. 0 ) then * shouldn't occur ... * 12-10-1993 three spacelike momenta are OK if ( .not.(xqi(4).lt.0 .and. xqi(5).lt.0 .and. xqi(6).lt.0) + ) then call fferr(41,ier) print *,'xpi = ',xqi endif elseif ( del2 .eq. 0 ) then call fferr(42,ier) return endif call ffdel3(del3,qiDqj) call ffdl3m(del3mi,.TRUE.,del3,del2,xqi,dqiqj,qiDqj,6, 4,5,6, + 1,3) do 101 i=1,3 j = i+1 if ( j .eq. 4 ) j = 1 call ffdel2(del2s(i),qiDqj,6, i+3,i,j, 1,ieri(i)) k = i-1 if ( k .eq. 0 ) k = 3 call ffdl2p(delpsi(i),xqi,dqiqj,qiDqj,i+3,j+3,k+3,i,j,k,6) 101 continue ier0 = 0 do 99 i=1,nerr ier0 = max(ier0,ieri(i)) 99 continue ier = ier + ier0 * * initialize cs3: * do 80 i=1,80 cs3(i) = 0 80 continue do 90 i=1,8 ipi12(i) = 0 90 continue do 100 i=1,3 clogi(i) = 0 ilogi(i) = 0 100 continue * #[ complex case: * in case of three spacelike momenta or unphysical real ones if ( del2 .gt. 0 ) then do 102 i=1,3 cel2s(i) = del2s(i) celpsi(i) = delpsi(i) cetami(i) = del3mi(i)/del2 102 continue do 104 i=1,6 cqi(i) = xqi(i) do 103 j=1,6 cdqiqj(j,i) = dqiqj(j,i) cqiDqj(j,i) = qiDqj(j,i) 103 continue 104 continue cetalm = del3/del2 csdel2 = isgnal*ToComplex(0D0,sqrt(del2)) * * get alpha,1-alpha * call ffcoot(cblph(1),calph(1),cqi(5),-cqiDqj(5,6),cqi(6), + csdel2,ier) call ffcoot(calph(3),cblph(3),cqi(5),-cqiDqj(5,4),cqi(4), + csdel2,ier) cslam = 2*csdel2 call ffcc0p(cs3,ipi12,isoort,clogi,ilogi,cqi,cdqiqj,cqiDqj, + csdel2,cel2s,cetalm,cetami,celpsi,calph,3,ier) goto 109 endif * #] complex case: etalam = del3/del2 do 106 i=1,3 etami(i) = del3mi(i)/del2 106 continue if ( abs(isgnal).ne.1 ) then print *,'ffxc0b: error: isgnal should be +/-1, not ',isgnal print *,' forgot to call ltini?' call ltini endif sdel2 = isgnal*sqrt(-del2) * * get alpha,1-alpha * call ffroot(blph(1),alph(1),xqi(5),-qiDqj(5,6),xqi(6),sdel2,ier) call ffroot(alph(3),blph(3),xqi(5),-qiDqj(5,4),xqi(4),sdel2,ier) if ( l4also .and. ( alph(1) .gt. 1 .or. alph(1) .lt. 0 ) .and. + abs(blph(1)-.5D0) .lt. abs(alph(1)-.5D0) ) then alph(1) = blph(1) alph(3) = blph(3) sdel2 = -sdel2 isgnal = -isgnal endif cslam = 2*sdel2 * * and the calculations * call ffxc0p(cs3,ipi12,isoort,clogi,ilogi,xqi,dqiqj,qiDqj, + sdel2,del2s,etalam,etami,delpsi,alph,3,ier) * * sum'em up: * 109 continue cs = 0 xmax = 0 do 110 i=1,80 * if ( cs3(i) .ne. 0 ) then cs = cs + cs3(i) xmax = max(xmax,absc(cs)) * endif 110 continue ipi12t = 0 do 120 i=1,8 ipi12t = ipi12t + ipi12(i) 120 continue cs = cs + ipi12t*Re(pi12) * * A imaginary component less than precc times the real part is * zero (may be removed) * if ( abs(Im(cs)) .lt. precc*abs(Re(cs)) ) + cs = ToComplex(Re(cs)) * * Finally ... * cc0 = - cs/cslam * #] calculations: *###] ffxc0b: end *###[ ffrot3: subroutine ffrot3(irota,xqi,dqiqj,qiDqj,xpi,dpipj,piDpj, + iflag,npoin,ier) ***#[*comment:*********************************************************** * * * rotates the arrays xpi, dpipj into xqi,dqiqj so that * * xpi(6),xpi(4) suffer the strongest outside cancellations and * * xpi(6) > xpi(4) if iflag = 1, so that xpi(5) largest and xpi(5) * * and xpi(6) suffer cancellations if iflag = 2. * * if iflag = 3 make xqi(3)=0. * * If npoin=4, rotate piDpj into qiDqj as well. * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments: * integer irota,iflag,ier,npoin RealType xpi(6),dpipj(6,6),piDpj(6,6),xqi(6),dqiqj(6,6), + qiDqj(6,6) * * local variables * RealType a1,a2,a3,xpimax ComplexType chulp(3,3) integer i,j,inew(6,6) save inew * * common blocks * #include "ff.h" * * data * data inew /1,2,3,4,5,6, + 2,3,1,5,6,4, + 3,1,2,6,4,5, + 1,3,2,6,5,4, + 3,2,1,5,4,6, + 2,1,3,4,6,5/ * #] declarations: * #[ get largest cancellation: if ( iflag .eq. 1 ) then a1 = abs(dpipj(6,4))/max(abs(xpi(6)+xpi(4)),xalogm) a2 = abs(dpipj(5,4))/max(abs(xpi(5)+xpi(4)),xalogm) a3 = abs(dpipj(5,6))/max(abs(xpi(6)+xpi(5)),xalogm) if ( a1 .le. a2 .and. a1 .le. a3 ) then irota = 1 if ( abs(xpi(6)) .lt. abs(xpi(4)) ) then irota = 4 endif elseif ( a2 .le. a3 ) then irota = 3 if ( abs(xpi(4)) .lt. abs(xpi(5)) ) then irota = 6 endif else irota = 2 if ( abs(xpi(5)) .lt. abs(xpi(6)) ) then irota = 5 endif endif elseif ( iflag .eq. 2 ) then xpimax = max(xpi(4),xpi(5),xpi(6)) if ( xpimax .eq. 0 ) then if ( xpi(5) .ne. 0 ) then irota = 1 elseif ( xpi(4) .ne. 0 ) then irota = 2 elseif ( xpi(6) .ne. 0 ) then irota = 3 else call fferr(40,ier) irota = 1 endif elseif ( xpi(5) .eq. xpimax ) then if ( xpi(4) .le. xpi(6) ) then irota = 1 else irota = 4 endif elseif ( xpi(4) .eq. xpimax ) then if ( xpi(5) .ge. xpi(6) ) then irota = 2 else irota = 5 endif else if ( xpi(4) .ge. xpi(6) ) then irota = 3 else irota = 6 endif endif elseif ( iflag .eq. 3 ) then if ( dpipj(2,4).eq.0 .and. dpipj(3,6).eq.0 .and. + xpi(1).eq.0 ) then irota = 3 elseif ( dpipj(1,6).eq.0 .and. dpipj(2,5).eq.0 .and. + xpi(3).eq.0 ) then irota = 1 elseif ( dpipj(3,5).eq.0 .and. dpipj(1,4).eq.0 .and. + xpi(2).eq.0 ) then irota = 2 else call fferr(35,ier) irota = 1 endif else call fferr(35,ier) irota = 1 endif * #] get largest cancellation: * #[ rotate: do 20 i=1,6 xqi(inew(i,irota)) = xpi(i) do 10 j=1,6 dqiqj(inew(i,irota),inew(j,irota)) = dpipj(i,j) 10 continue 20 continue * * when called in a 4pointfunction we already have the dotproducts * if ( npoin .eq. 4 ) then do 80 j=1,6 do 70 i=1,6 qiDqj(inew(i,irota),inew(j,irota)) = piDpj(i,j) 70 continue 80 continue endif *DEBUG if ( iflag .eq. 3 .and. lsmug ) then if ( lsmug ) then * * do not forget to rotate the smuggled differences * do 40 j=1,3 do 30 i=1,3 chulp(i,j) = cmipj(i,j) 30 continue 40 continue do 60 j=1,3 do 50 i=1,3 cmipj(inew(i,irota),inew(j+3,irota)-3) = chulp(i,j) 50 continue 60 continue endif * #] rotate: *###] ffrot3: end *###[ ffdot3: subroutine ffdot3(piDpj,xpi,dpipj,ns,ier) ***#[*comment:*********************************************************** * * * calculate the dotproducts pi.pj with * * * * pi = si i1=1,3 * * pi = p(i-3) i1=4,6 * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments * integer ns,ier RealType xpi(6),dpipj(6,6),piDpj(6,6) * * locals * integer is1,is2,is3,ip1,ip2,ip3,i,j,ier1,inew(6,6) save inew * * rest * #include "ff.h" * * data * data inew /1,2,3,4,5,6, + 2,3,1,5,6,4, + 3,1,2,6,4,5, + 1,3,2,6,5,4, + 3,2,1,5,4,6, + 2,1,3,4,6,5/ * * #] declarations: * #[ check input: if ( ns .ne. 6 ) print *,'ffdot3: error: ns /= 6 ' * #] check input: * #[ copy if known: * if ( idot.ge.3 ) then do 2 i=1,6 do 1 j=1,6 piDpj(inew(j,irota3),inew(i,irota3)) = fpij3(j,i) 1 continue 2 continue if ( irota3 .gt. 3 ) then * * the sign of the s's has been changed! * do 4 i=1,3 do 3 j=4,6 piDpj(j,i) = -piDpj(j,i) piDpj(i,j) = -piDpj(i,j) 3 continue 4 continue endif return endif * * #] copy if known: * #[ calculations: ier1 = ier do 10 is1=1,3 is2 = is1 + 1 if ( is2 .eq. 4 ) is2 = 1 is3 = is2 + 1 if ( is3 .eq. 4 ) is3 = 1 ip1 = is1 + 3 ip2 = is2 + 3 ip3 = is3 + 3 * * pi.pj, si.sj * piDpj(is1,is1) = xpi(is1) piDpj(ip1,ip1) = xpi(ip1) * * si.s(i+1) * if ( xpi(is2) .le. xpi(is1) ) then piDpj(is1,is2) = (dpipj(is1,ip1) + xpi(is2))/2 else piDpj(is1,is2) = (dpipj(is2,ip1) + xpi(is1))/2 endif piDpj(is2,is1) = piDpj(is1,is2) * * pi.si * if ( abs(xpi(ip1)) .le. xpi(is1) ) then piDpj(ip1,is1) = (dpipj(is2,is1) - xpi(ip1))/2 else piDpj(ip1,is1) = (dpipj(is2,ip1) - xpi(is1))/2 endif piDpj(is1,ip1) = piDpj(ip1,is1) * * pi.s(i+1) * if ( abs(xpi(ip1)) .le. xpi(is2) ) then piDpj(ip1,is2) = (dpipj(is2,is1) + xpi(ip1))/2 else piDpj(ip1,is2) = (dpipj(ip1,is1) + xpi(is2))/2 endif piDpj(is2,ip1) = piDpj(ip1,is2) * * pi.s(i+2) * if ( min(abs(dpipj(is2,is1)),abs(dpipj(ip3,ip2))) .le. + min(abs(dpipj(ip3,is1)),abs(dpipj(is2,ip2))) ) then piDpj(ip1,is3) = (dpipj(ip3,ip2) + dpipj(is2,is1))/2 else piDpj(ip1,is3) = (dpipj(ip3,is1) + dpipj(is2,ip2))/2 endif piDpj(is3,ip1) = piDpj(ip1,is3) * * pi.p(i+1) * if ( idot.le.0 ) then if ( abs(xpi(ip2)) .le. abs(xpi(ip1)) ) then piDpj(ip1,ip2) = (dpipj(ip3,ip1) - xpi(ip2))/2 else piDpj(ip1,ip2) = (dpipj(ip3,ip2) - xpi(ip1))/2 endif piDpj(ip2,ip1) = piDpj(ip1,ip2) else piDpj(inew(ip2,irota3),inew(ip1,irota3)) = + fpij3(ip1,ip2) piDpj(inew(ip1,irota3),inew(ip2,irota3)) = + piDpj(inew(ip2,irota3),inew(ip1,irota3)) endif 10 continue ier = ier1 * * #] calculations: *###] ffdot3: end *###[ ffxc0r: subroutine ffxc0r(cc0,xpi,ier) ***#[*comment:*********************************************************** * * * Tries all 2 permutations of the 3pointfunction * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none integer ier RealType xpi(6),xqi(6) ComplexType cc0,cc0p integer inew(6,2),irota,ier1,i,j,ialsav save inew #include "ff.h" data inew /1,2,3,4,5,6, + 1,3,2,6,5,4/ * #] declarations: * #[ calculations: cc0 = 0 ier = 999 ialsav = isgnal do 30 j = -1,1,2 do 20 irota=1,2 do 10 i=1,6 xqi(inew(i,irota)) = xpi(i) 10 continue print '(a,i1,a,i2)','---#[ rotation ',irota,': isgnal ', + isgnal ier1 = 0 ner = 0 id = id + 1 isgnal = ialsav call ffxc0(cc0p,xqi,ier1) ier1 = ier1 + ner print '(a,i1,a,i2)','---#] rotation ',irota,': isgnal ', + isgnal print '(a,2g28.16,i3)','c0 = ',cc0p,ier1 if ( ier1 .lt. ier ) then cc0 = cc0p ier = ier1 endif 20 continue ialsav = -ialsav 30 continue * #] calculations: *###] ffxc0r: end LoopTools-2.16/src/C/PaxHeaders/ffdel3.F0000644000000000000000000000007411776502522014711 xustar0030 atime=1648161785.719698432 30 ctime=1648161793.715764879 LoopTools-2.16/src/C/ffdel3.F0000644000000000000000000001371311776502522015631 0ustar00rootroot00000000000000#include "externals.h" #include "types.h" *###[ ffdel3: subroutine ffdel3(del3,piDpj) ***#[*comment:*********************************************************** * * * Calculate del3(piDpj) = det(si.sj) with * * the momenta as follows: * * p(1-3) = s(i) * * p(4-6) = p(i) * * * * Input: xpi(ns) (real) m^2(i),i=1,3; p^2(i-3),i=4,10 * * piDpj(ns,ns) (real) * * ns (integer) * * ier (integer) * * * * Output: del3 (real) det(si.sj) * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments: * RealType del3,piDpj(6,6) * * local variables: * integer mem,nperm parameter(mem=10,nperm=16) integer i,jj(6),iperm(3,nperm),imem,memarr(mem,3),memind,inow RealType s(6),xmax,del3p,xmaxp save iperm,memind,memarr,inow * * common blocks: * #include "ff.h" * #] declarations: * #[ data: data memind /0/ data memarr /mem*0,mem*0,mem*1/ data inow /1/ * * these are all permutations that give a non-zero result with the * correct sign. This list was generated with getperm3. * data iperm/ + 1,2,3, 1,2,5, 1,6,2, 1,4,3, + 1,3,5, 1,4,5, 1,6,4, 1,5,6, + 2,4,3, 2,3,6, 2,4,5, 2,6,4, + 2,5,6, 3,4,5, 3,6,4, 3,5,6/ * #] data: * #[ starting point in memory?: * * see if we know were to start, if not: go on as last time * do 5 i=1,mem if ( id .eq. memarr(i,1) .and. idsub .eq. memarr(i,2) ) then inow = memarr(i,3) goto 6 endif 5 continue 6 continue * #] starting point in memory?: * #[ calculations: imem = inow del3 = 0 xmax = 0 10 continue jj(1) = iperm(1,inow) jj(3) = iperm(2,inow) jj(5) = iperm(3,inow) jj(2) = iperm(1,inow) jj(4) = iperm(2,inow) jj(6) = iperm(3,inow) s(1) = +piDpj(jj(1),jj(2))*piDpj(jj(3),jj(4))*piDpj(jj(5),jj(6)) s(2) = +piDpj(jj(1),jj(4))*piDpj(jj(3),jj(6))*piDpj(jj(5),jj(2)) s(3) = +piDpj(jj(1),jj(6))*piDpj(jj(3),jj(2))*piDpj(jj(5),jj(4)) s(4) = -piDpj(jj(1),jj(2))*piDpj(jj(3),jj(6))*piDpj(jj(5),jj(4)) s(5) = -piDpj(jj(1),jj(6))*piDpj(jj(3),jj(4))*piDpj(jj(5),jj(2)) s(6) = -piDpj(jj(1),jj(4))*piDpj(jj(3),jj(2))*piDpj(jj(5),jj(6)) del3p = 0 xmaxp = 0 do 20 i=1,6 del3p = del3p + s(i) xmaxp = max(xmaxp,abs(s(i))) 20 continue if ( abs(del3p) .lt. xloss*xmaxp ) then if ( inow .eq. imem .or. xmaxp .lt. xmax ) then del3 = del3p xmax = xmaxp endif inow = inow + 1 if ( inow .gt. nperm ) inow = 1 if ( inow .eq. imem ) goto 800 goto 10 endif del3 = del3p xmax = xmaxp * #] calculations: * #[ into memory: 800 continue memind = memind + 1 if ( memind .gt. mem ) memind = 1 memarr(memind,1) = id memarr(memind,2) = idsub memarr(memind,3) = inow * #] into memory: *###] ffdel3: end *(##[ ffdl3s: subroutine ffdl3s(dl3s,piDpj,ii,ns) ***#[*comment:*********************************************************** * * * Calculate dl3s(piDpj) = det(si.sj) with * * the momenta indicated by the indices ii(1-6,1), ii(1-6,2) * * as follows: * * p(|ii(1,)|-|ii(3,)|) = s(i) * * p(|ii(4,)|-|ii(6,)|) = p(i) = sgn(ii())*(s(i+1) - s(i)) * * * * At this moment (26-apr-1990) only the diagonal is tried * * * * Input: xpi(ns) (real) m^2(i),i=1,3; p^2(i-3),i=4,10 * * piDpj(ns,ns) (real) * * ii(6,2) (integer) see above * * ns (integer) * * ier (integer) * * * * Output: dl3s (real) det(si.sj) * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments: * integer ii(6,2),ns RealType dl3s,piDpj(ns,ns) * * local variables: * integer mem,nperm parameter(mem=10,nperm=16) integer i,jj(6),jsgn,iperm(3,nperm),imem,memarr(mem,3), + memind,inow RealType s(6),xmax,dl3sp,xmaxp save iperm,memind,memarr,inow * * common blocks: * #include "ff.h" * #] declarations: * #[ data: data memind /0/ data memarr /mem*0,mem*0,mem*1/ data inow /1/ * * these are all permutations that give a non-zero result with the * correct sign. This list was generated with getperm3. * data iperm/ + 1,2,3, 1,2,5, 1,6,2, 1,4,3, + 1,3,5, 1,4,5, 1,6,4, 1,5,6, + 2,4,3, 2,3,6, 2,4,5, 2,6,4, + 2,5,6, 3,4,5, 3,6,4, 3,5,6/ * #] data: * #[ starting point in memory?: * * see if we know were to start, if not: go on as last time * do 5 i=1,mem if ( id .eq. memarr(i,1) .and. idsub .eq. memarr(i,2) ) then inow = memarr(i,3) goto 6 endif 5 continue 6 continue * #] starting point in memory?: * #[ calculations: imem = inow dl3s = 0 xmax = 0 10 continue jj(1) = abs(ii(iperm(1,inow),1)) jj(3) = abs(ii(iperm(2,inow),1)) jj(5) = abs(ii(iperm(3,inow),1)) jj(2) = abs(ii(iperm(1,inow),2)) jj(4) = abs(ii(iperm(2,inow),2)) jj(6) = abs(ii(iperm(3,inow),2)) jsgn = sign(1,ii(iperm(1,inow),1)) + *sign(1,ii(iperm(2,inow),1)) + *sign(1,ii(iperm(3,inow),1)) + *sign(1,ii(iperm(1,inow),2)) + *sign(1,ii(iperm(2,inow),2)) + *sign(1,ii(iperm(3,inow),2)) s(1) = +piDpj(jj(1),jj(2))*piDpj(jj(3),jj(4))*piDpj(jj(5),jj(6)) s(2) = +piDpj(jj(1),jj(4))*piDpj(jj(3),jj(6))*piDpj(jj(5),jj(2)) s(3) = +piDpj(jj(1),jj(6))*piDpj(jj(3),jj(2))*piDpj(jj(5),jj(4)) s(4) = -piDpj(jj(1),jj(2))*piDpj(jj(3),jj(6))*piDpj(jj(5),jj(4)) s(5) = -piDpj(jj(1),jj(6))*piDpj(jj(3),jj(4))*piDpj(jj(5),jj(2)) s(6) = -piDpj(jj(1),jj(4))*piDpj(jj(3),jj(2))*piDpj(jj(5),jj(6)) dl3sp = 0 xmaxp = 0 do 20 i=1,6 dl3sp = dl3sp + s(i) xmaxp = max(xmaxp,abs(s(i))) 20 continue if ( abs(dl3sp) .lt. xloss*xmaxp ) then if ( inow .eq. imem .or. xmaxp .lt. xmax ) then dl3s = jsgn*dl3sp xmax = xmaxp endif inow = inow + 1 if ( inow .gt. nperm ) inow = 1 if ( inow .eq. imem ) goto 800 goto 10 endif dl3s = jsgn*dl3sp xmax = xmaxp * #] calculations: * #[ into memory: 800 continue memind = memind + 1 if ( memind .gt. mem ) memind = 1 memarr(memind,1) = id memarr(memind,2) = idsub memarr(memind,3) = inow * #] into memory: *)##] ffdl3s: end LoopTools-2.16/src/C/PaxHeaders/ffcel3.F0000644000000000000000000000007411776502522014710 xustar0030 atime=1648161785.719698432 30 ctime=1648161793.715764879 LoopTools-2.16/src/C/ffcel3.F0000644000000000000000000000536111776502522015630 0ustar00rootroot00000000000000#include "externals.h" #include "types.h" *###[ ffcel3: subroutine ffcel3(del3,piDpj) ***#[*comment:*********************************************************** * * * Calculate del3(piDpj) = det(si.sj) with * * the momenta as follows: * * p(1-3) = s(i) * * p(4-6) = p(i) * * * * Input: piDpj(6,6) (real) * * * * Output: del3 (real) det(si.sj) * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments: * ComplexType del3,piDpj(6,6) * * local variables: * integer mem,nperm parameter(mem=10,nperm=16) integer i,jj(6),iperm(3,nperm),imem,memarr(mem,3),memind,inow ComplexType s(6),del3p,cc RealType xmax,xmaxp,absc save iperm,memind,memarr,inow * * common blocks: * #include "ff.h" * * statement function * absc(cc) = abs(Re(cc)) + abs(Im(cc)) * #] declarations: * #[ data: data memind /0/ data memarr /mem*0,mem*0,mem*1/ data inow /1/ * * these are all permutations that give a non-zero result with the * correct sign. This list was generated with getperm3. * data iperm/ + 1,2,3, 1,2,5, 1,6,2, 1,4,3, + 1,3,5, 1,4,5, 1,6,4, 1,5,6, + 2,4,3, 2,3,6, 2,4,5, 2,6,4, + 2,5,6, 3,4,5, 3,6,4, 3,5,6/ * #] data: * #[ starting point in memory?: * * see if we know were to start, if not: go on as last time * do 5 i=1,mem if ( id .eq. memarr(i,1) .and. idsub .eq. memarr(i,2) ) then inow = memarr(i,3) goto 6 endif 5 continue 6 continue * #] starting point in memory?: * #[ calculations: imem = inow del3 = 0 xmax = 0 10 continue jj(1) = iperm(1,inow) jj(3) = iperm(2,inow) jj(5) = iperm(3,inow) jj(2) = iperm(1,inow) jj(4) = iperm(2,inow) jj(6) = iperm(3,inow) s(1) = +piDpj(jj(1),jj(2))*piDpj(jj(3),jj(4))*piDpj(jj(5),jj(6)) s(2) = +piDpj(jj(1),jj(4))*piDpj(jj(3),jj(6))*piDpj(jj(5),jj(2)) s(3) = +piDpj(jj(1),jj(6))*piDpj(jj(3),jj(2))*piDpj(jj(5),jj(4)) s(4) = -piDpj(jj(1),jj(2))*piDpj(jj(3),jj(6))*piDpj(jj(5),jj(4)) s(5) = -piDpj(jj(1),jj(6))*piDpj(jj(3),jj(4))*piDpj(jj(5),jj(2)) s(6) = -piDpj(jj(1),jj(4))*piDpj(jj(3),jj(2))*piDpj(jj(5),jj(6)) del3p = 0 xmaxp = 0 do 20 i=1,6 del3p = del3p + s(i) xmaxp = max(xmaxp,absc(s(i))) 20 continue if ( absc(del3p) .lt. xloss*xmaxp ) then if ( inow .eq. imem .or. xmaxp .lt. xmax ) then del3 = del3p xmax = xmaxp endif inow = inow + 1 if ( inow .gt. nperm ) inow = 1 if ( inow .eq. imem ) then goto 800 endif goto 10 endif del3 = del3p xmax = xmaxp * #] calculations: * #[ into memory: 800 continue memind = memind + 1 if ( memind .gt. mem ) memind = 1 memarr(memind,1) = id memarr(memind,2) = idsub memarr(memind,3) = inow * #] into memory: *###] ffcel3: end LoopTools-2.16/src/C/PaxHeaders/ffxc0p.F0000644000000000000000000000007411776502522014734 xustar0030 atime=1648161785.719698432 30 ctime=1648161793.715764879 LoopTools-2.16/src/C/ffxc0p.F0000644000000000000000000003327411776502522015660 0ustar00rootroot00000000000000#include "externals.h" #include "types.h" * $Id: ffxc0p.f,v 1.3 1995/10/06 09:17:26 gj Exp $ * $Log: ffxc0p.f,v $ c Revision 1.3 1995/10/06 09:17:26 gj c Found stupid typo in ffxc0p which caused the result to be off by pi^2/3 in c some equal-mass cases. Added checks to ffcxs4.f ffcrr.f. c *###[ ffxc0p: subroutine ffxc0p(cs3,ipi12,isoort,clogi,ilogi,xpi,dpipj,piDpj, + sdel2,del2s,etalam,etami,delpsi,alph,npoin,ier) ***#[*comment:*********************************************************** * * * calculates the threepoint function closely following * * recipe in 't Hooft & Veltman, NP B(183) 1979. * * Bjorken and Drell metric is used nowadays! * * * * p2 ^ | * * | | * * / \ * * m2/ \m3 * * p1 / \ p3 * * <- / m1 \ -> * * ------------------------ * * * * Input: xpi(1-3) (real) pi squared * * xpi(4-6) (real) internal mass squared * * dpipj(6,6) (real) xpi(i)-xpi(j) * * piDpj(6,6) (real) pi(i).pi(j) * * sdel2 (real) sqrt(delta_{p_1 p_2}^{p_1 p_2}) * * del2s(3) (real) delta_{p_i s_i}^{p_i s_i} * * etalam (real) delta_{s_1 s_2 s_3}^{s_1 s_2 s_3} * /delta_{p_1 p_2}^{p_1 p_2} * * etami(6) (real) m_i^2 - etalam * * alph(3) (real) alph(1)=alpha, alph(3)=1-alpha * * * * Output: cs3(80) (complex) C0, not yet summed. * * ipi12(8) (integer) factors pi^2/12, not yet summed * * slam (complex) lambda(p1,p2,p3). * * isoort(8) (integer) indication of he method used * * clogi(3) (complex) log(-dyz(2,1,i)/dyz(2,2,i)) * * ilogi(3) (integer) factors i*pi in this * * ier (integer) number of digits inaccurate in * * answer * * * * Calls: ffroot,ffxxyz,ffcxyz,ffdwz,ffcdwz, * * ffcxs3,ffcs3,ffcxs4,ffcs4 * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments: * integer ipi12(8),isoort(8),ilogi(3),npoin,ier ComplexType cs3(80),clogi(3) RealType xpi(6),dpipj(6,6),piDpj(6,6),sdel2,del2s(3), + etalam,etami(6),delpsi(3),alph(3) * * local variables: * integer i,j,k,m,ip,jsoort(8),ierw,iw,ier0,ier1,irota, + ilogip(3) logical l4,lcompl,lcpi,l4pos ComplexType c,cs,calph(3),csdl2i(3),csdel2 ComplexType cy(4,3),cz(4,3),cw(4,3),cdyz(2,2,3),cdwy(2,2,3), + cdwz(2,2,3),cd2yzz(3),cd2yww(3) ComplexType cpi(6),cdpipj(6,6),cpiDpj(6,6),clogip(3) RealType y(4,3),z(4,3),w(4,3),dyz(2,2,3),dwy(2,2,3), + dwz(2,2,3),d2yzz(3),d2yww(3),dy2z(4,3) RealType sdel2i(3),s1,s2 RealType absc,s,xqi(6),dqiqj(6,6),qiDqj(6,6) RealType dfflo1 ComplexType zxfflg external dfflo1,zxfflg * * common blocks: * #include "ff.h" * * statement function * absc(c) = abs(Re(c)) + abs(Im(c)) * #] declarations: * #[ IR case: * * but only the off-shell regulator case - the log(lam) has been * caught before * if ( lsmug ) then do 5 i=1,3 if ( xpi(i) .eq. 0 ) then j = mod(i,3)+1 k = mod(j,3)+1 if ( piDpj(i,j).eq.0 .and. piDpj(i,k).eq.0 ) then call ffrot3(irota,xqi,dqiqj,qiDqj, + xpi,dpipj,piDpj,3,4,ier) if ( npoin.eq.4 ) call ffrt3p(clogip,ilogip, + irota,clogi,ilogi,+1) call ffxc0j(cs3(1),ipi12(1),sdel2,clogip,ilogip, + xqi,dqiqj,qiDqj,0D0,4,ier) if ( npoin.eq.4 ) call ffrt3p(clogi,ilogi,irota, + clogip,ilogip,-1) return endif endif 5 continue endif * #] IR case: * #[ get roots etc: * #[ get z-roots: * if ( npoin .eq. 3 ) then l4pos = l4also * else * l4pos = .FALSE. * endif lcompl = .FALSE. ier1 = ier do 10 i=1,3 * * get roots (y,z,w) and flag what to do: 0=nothing, 1=normal, * -1=complex * ip = i+3 * first get the roots ier0 = ier if ( del2s(i) .le. 0 ) then * real case sdel2i(i) = sqrt(-del2s(i)) csdl2i(i) = sdel2i(i) * then handle the special case Si = 0 if ( xpi(ip) .eq. 0 ) then if ( i .eq. 1 .and. alph(3) .eq. 0 .or. + i .eq. 3 .and. alph(1) .eq. 0 ) then isoort(2*i-1) = 0 isoort(2*i) = 0 l4pos = .FALSE. goto 10 endif endif call ffxxyz(y(1,i),z(1,i),dyz(1,1,i),d2yzz(i),dy2z(1,i), + i,sdel2,sdel2i(i),etalam,etami,delpsi(i),xpi, + dpipj,piDpj,isoort(2*i-1),.FALSE.,6,ier0) else * complex case sdel2i(i) = sqrt(del2s(i)) csdl2i(i) = ToComplex(0D0,sdel2i(i)) lcompl = .TRUE. call ffcxyz(cy(1,i),cz(1,i),cdyz(1,1,i),cd2yzz(i),i, + sdel2,sdel2i(i),etami,delpsi(i),xpi, + piDpj,isoort(2*i-1),.FALSE.,6,ier0) endif ier1 = max(ier1,ier0) 10 continue ier = ier1 * #] get z-roots: * #[ get w-roots: * * get w's: * ierw = ier l4 = .FALSE. lcpi = .FALSE. if ( isoort(4) .eq. 0 ) then * no error message; just bail out ierw = ierw + 100 goto 90 endif do 70 iw = 1,3,2 if ( .not. l4pos .or. alph(4-iw) .eq. 0 ) then jsoort(2*iw-1) = 0 jsoort(2*iw) = 0 l4pos = .FALSE. else if ( isoort(4) .gt. 0 .and. isoort(2*iw) .ge. 0 ) then jsoort(2*iw-1) = 1 jsoort(2*iw) = 1 d2yww(iw) = -d2yzz(2)/alph(4-iw) do 20 j=1,2 w(j+iw-1,iw) = z(j+3-iw,2)/alph(4-iw) w(j+3-iw,iw) = 1 - w(j+iw-1,iw) if ( abs(w(j+3-iw,iw)) .lt. xloss ) then s = z(j+iw-1,2) - alph(iw) if ( abs(s) .lt. xloss*alph(iw) ) then ierw = ierw + 15 goto 70 endif w(j+3-iw,iw) = s/alph(4-iw) endif dwy(j,2,iw) = dyz(2,j,2)/alph(4-iw) do 15 i=1,2 dwz(j,i,iw) = w(j,iw) - z(i,iw) if ( abs(dwz(j,i,iw)) .ge. xloss*abs(w(j,iw)) ) + goto 14 dwz(j,i,iw) = z(i+2,iw) - w(j+2,iw) if ( abs(dwz(j,i,iw)) .ge. xloss*abs(w(j+2,iw)) ) + goto 14 dwz(j,i,iw) = dwy(j,2,iw) + dyz(2,i,iw) if ( abs(dwz(j,i,iw)) .ge. xloss*abs(dwy(j,2,iw)) ) + goto 14 l4 = .TRUE. call ffdwz(dwz(1,1,iw),z(1,iw),j,i,iw, + alph(1),alph(3),xpi,dpipj,piDpj,sdel2i,6,ierw) 14 continue 15 continue 20 continue else * convert to complex ... jsoort(2*iw-1) = -10 jsoort(2*iw) = -10 if ( isoort(4).ge.0 .and. (iw.eq.1 .or. isoort(2).ge.0) ) + then cd2yzz(2) = d2yzz(2) do 21 i=1,4 cy(i,2) = y(i,2) cz(i,2) = z(i,2) 21 continue do 23 i=1,2 do 22 j=1,2 cdyz(j,i,2) = dyz(j,i,2) 22 continue 23 continue endif if ( isoort(2*iw) .ge. 0 ) then cd2yzz(iw) = d2yzz(iw) do 24 i=1,4 cy(i,iw) = y(i,iw) cz(i,iw) = z(i,iw) 24 continue do 26 i=1,2 do 25 j=1,2 cdyz(j,i,iw) = dyz(j,i,iw) 25 continue 26 continue endif cd2yww(iw) = -cd2yzz(2)/Re(alph(4-iw)) do 30 j=1,2 cw(j+iw-1,iw) = cz(j+3-iw,2)/Re(alph(4-iw)) cw(j+3-iw,iw) = 1 - cw(j+iw-1,iw) if ( absc(cw(j+3-iw,iw)) .lt. xloss ) then cs = cz(j+iw-1,2) - Re(alph(iw)) if ( absc(cs) .lt. xloss*alph(iw) ) ierw = ierw + 15 cw(j+3-iw,iw) = cs/Re(alph(4-iw)) endif cdwy(j,2,iw) = cdyz(2,j,2)/Re(alph(4-iw)) do 29 i=1,2 cdwz(j,i,iw) = cw(j,iw) - cz(i,iw) if ( absc(cdwz(j,i,iw)) .ge. xloss*absc(cw(j,iw)) ) + goto 31 cdwz(j,i,iw) = cz(i+2,iw) - cw(j+2,iw) if ( absc(cdwz(j,i,iw)) .ge. xloss*absc(cw(j+2,iw))) + goto 31 cdwz(j,i,iw) = cdwy(j,2,iw) + cdyz(2,i,iw) if ( absc(cdwz(j,i,iw)).ge.xloss*absc(cdwy(j,2,iw))) + goto 31 l4 = .TRUE. if ( .not. lcpi ) then lcpi = .TRUE. calph(1) = alph(1) calph(3) = alph(3) csdel2 = sdel2 do 28 k=1,6 cpi(k) = xpi(k) do 27 m=1,6 cdpipj(m,k) = dpipj(m,k) cpiDpj(m,k) = piDpj(m,k) 27 continue 28 continue endif call ffcdwz(cdwz(1,1,iw),cz(1,iw),j,i,iw, + calph(1),calph(3),cpi,cdpipj,cpiDpj,csdl2i, + csdel2,6,ierw) 31 continue 29 continue 30 continue endif endif 70 continue 90 continue ierw = ierw-ier * #] get w-roots: * #[ which case: if ( l4 ) then * 21-aug-1995. added check for isoort(2*i-1).eq.0 to avoid * undefined variables etc in ffdcs, ffdcrr. They should be * able to handle this, but are not (yet?) if ( ierw .ge. 1 .or. isoort(1).eq.0 .or. isoort(3).eq.0 + .or. isoort(5).eq.0 ) then l4pos = .FALSE. else ier = ier + ierw endif endif * #] which case: * #] get roots etc: * #[ logarithms for 4point function: if ( npoin .eq. 4 ) then do 95 i = 1,3 if ( ilogi(i) .ne. -999 ) goto 95 if ( isoort(2*i) .gt. 0 .and. + isoort(2*i-1) .ge. 0 ) then s1 = -dyz(2,1,i)/dyz(2,2,i) if ( abs(s1-1) .lt. xloss ) then clogi(i) = dfflo1(d2yzz(i)/dyz(2,2,i),ier) ilogi(i) = 0 else if ( abs(s1+1) .lt. xloss ) then clogi(i) = dfflo1(-2*sdel2i(i)/(xpi(i+3)* + dyz(2,2,i)),ier) else clogi(i) = zxfflg(abs(s1),0,0D0,ier) endif if ( dyz(2,2,i).gt.0 .and. dyz(2,1,i).gt.0 ) then ilogi(i) = -1 elseif ( dyz(2,1,i).lt.0 .and. dyz(2,2,i).lt.0) then ilogi(i) = +1 else ilogi(i) = 0 endif endif elseif ( isoort(2*i-1) .lt. 0 ) then * for stability split the unit circle up in 4*pi/2 * (this may have to be improved to 8*pi/4...) ier0 = 0 if ( Re(cdyz(2,1,i)) .gt. Im(cdyz(2,1,i)) ) then s = 2*atan2(Im(cdyz(2,1,i)),Re(cdyz(2,1,i))) clogi(i) = ToComplex(0D0,s) ilogi(i) = -1 elseif ( Re(cdyz(2,1,i)) .lt. -Im(cdyz(2,1,i))) + then if ( Im(cdyz(2,1,i)) .eq. 0 ) then call fferr(84,ier) endif s = 2*atan2(-Im(cdyz(2,1,i)),-Re(cdyz(2,1,i))) clogi(i) = ToComplex(0D0,s) ilogi(i) = 1 else s1 = -Re(cdyz(2,1,i)) s2 = Im(cdyz(2,1,i)) s = 2*atan2(s1,s2) clogi(i) = ToComplex(0D0,s) ilogi(i) = 0 endif endif 95 continue * An algorithm to obtain the sum of two small logarithms more * accurately has been put in ffcc0p, not yet here endif * #] logarithms for 4point function: * #[ real case integrals: ier1 = ier if ( .not. lcompl ) then if ( .not. l4 .or. .not. l4pos ) then * normal case do 100 i=1,3 j = 2*i-1 if ( isoort(j) .ne. 0 ) then ier0 = ier call ffcxs3(cs3(20*i-19),ipi12(j),y(1,i),z(1,i), + dyz(1,1,i),d2yzz(i),dy2z(1,i),xpi,piDpj, + i,6,isoort(j),ier0) ier1 = max(ier1,ier0) endif 100 continue isoort(7) = 0 isoort(8) = 0 else do 110 i=1,3,2 j = 2*i-1 isoort(j+2) = jsoort(j) isoort(j+3) = jsoort(j+1) ier0 = ier call ffcxs4(cs3(20*i-19),ipi12(j),w(1,i),y(1,i), + z(1,i),dwy(1,1,i),dwz(1,1,i),dyz(1,1,i), + d2yww(i),d2yzz(i),xpi,piDpj,i,6,isoort(j),ier0) ier1 = max(ier1,ier0) 110 continue endif * #] real case integrals: * #[ complex case integrals: else * convert xpi if ( .not.lcpi ) then do 190 i=1,6 cpi(i) = xpi(i) 190 continue endif if ( .not. l4 .or. .not. l4pos ) then * normal case do 200 i=1,3 j = 2*i-1 ier0 = ier if ( isoort(j) .gt. 0 ) then call ffcxs3(cs3(20*i-19),ipi12(2*i-1),y(1,i), + z(1,i),dyz(1,1,i),d2yzz(i),dy2z(1,i), + xpi,piDpj,i,6,isoort(j),ier0) elseif( isoort(j) .ne. 0 ) then call ffcs3(cs3(20*i-19),ipi12(2*i-1),cy(1,i), + cz(1,i),cdyz(1,1,i),cd2yzz(i),cpi, + cpiDpj,i,6,isoort(j),ier0) endif ier1 = max(ier1,ier0) 200 continue isoort(7) = 0 isoort(8) = 0 else isoort(3) = jsoort(1) isoort(4) = jsoort(2) ier0 = ier if ( isoort(1) .gt. 0 .and. isoort(3) .gt. 0 ) then call ffcxs4(cs3(1),ipi12(1),w(1,1),y(1,1), + z(1,1),dwy(1,1,1),dwz(1,1,1),dyz(1,1,1), + d2yww(1),d2yzz(1),xpi,piDpj,1,6,isoort(1),ier0) else call ffcs4(cs3(1),ipi12(1),cw(1,1),cy(1,1), + cz(1,1),cdwy(1,1,1),cdwz(1,1,1),cdyz(1,1,1), + cd2yww(1),cd2yzz(1),cpi,cpiDpj, + ToComplex(xpi(5)*alph(3)**2),1,6,isoort(1), + ier0) endif ier1 = max(ier1,ier0) isoort(7) = jsoort(5) isoort(8) = jsoort(6) ier0 = ier if ( isoort(5) .gt. 0 .and. isoort(7) .gt. 0 ) then call ffcxs4(cs3(41),ipi12(5),w(1,3),y(1,3), + z(1,3),dwy(1,1,3),dwz(1,1,3),dyz(1,1,3), + d2yww(3),d2yzz(3),xpi,piDpj,3,6,isoort(5),ier0) else call ffcs4(cs3(41),ipi12(5),cw(1,3),cy(1,3), + cz(1,3),cdwy(1,1,3),cdwz(1,1,3),cdyz(1,1,3), + cd2yww(3),cd2yzz(3),cpi,cpiDpj, + ToComplex(xpi(5)*alph(1)**2),3,6,isoort(5), + ier0) endif ier1 = max(ier1,ier0) endif endif ier = ier1 * #] complex case integrals: *###] ffxc0p: end *###[ ffrt3p: subroutine ffrt3p(clogip,ilogip,irota,clogi,ilogi,idir) ***#[*comment:*********************************************************** * * * rotates the arrays clogi,ilogi also over irota (idir=+1) or * * back (-1) * * * * Input: irota (integer) index in rotation array * * clogi(3) (complex) only if idir=-1 * * ilogi(3) (integer) indicates which clogi are needed* * (idir=+1), i*pi terms (idir=-1) * * idir (integer) direction: forward (+1) or * * backward (-1) * * Output: clogip(3) (integer) clogi rotated * * ilogip(3) (integer) ilogi rotated * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments: * integer irota,idir,ilogi(3),ilogip(3) ComplexType clogi(3),clogip(3) * * local variables * integer i,inew(6,6) save inew * * common blocks * #include "ff.h" * * data * data inew /1,2,3,4,5,6, + 2,3,1,5,6,4, + 3,1,2,6,4,5, + 1,3,2,6,5,4, + 3,2,1,5,4,6, + 2,1,3,4,6,5/ * #] declarations: * #[ rotate: * * the clogi, ilogi are numbered according to the p_i * if ( idir .eq. +1 ) then do 10 i=1,3 ilogip(inew(i+3,irota)-3) = ilogi(i) clogip(inew(i+3,irota)-3) = clogi(i) 10 continue else do 20 i=1,3 ilogip(i) = ilogi(inew(i+3,irota)-3) clogip(i) = clogi(inew(i+3,irota)-3) 20 continue endif * * #] rotate: *###] ffrt3p: end LoopTools-2.16/src/C/PaxHeaders/ffcc0p.F0000644000000000000000000000007411776502522014707 xustar0030 atime=1648161785.719698432 30 ctime=1648161793.715764879 LoopTools-2.16/src/C/ffcc0p.F0000644000000000000000000003010211776502522015616 0ustar00rootroot00000000000000#include "externals.h" #include "types.h" *###[ ffcc0p: subroutine ffcc0p(cs3,ipi12,isoort,clogi,ilogi,cpi,cpipj, + cpiDpj,sdel2,cel2si,etalam,etami,delpsi,alpha,npoin,ier) ***#[*comment:*********************************************************** * * * Calculates the threepoint function closely following * * recipe in 't Hooft & Veltman, NP B(183) 1979. * * Bjorken and Drell metric is used nowadays! * * * * p2 ^ | * * | | * * / \ * * m2/ \m3 * * p1 / \ p3 * * <- / m1 \ -> * * ------------------------ * * * * Input: cpi(1-3) (complex) pi squared (,2=untransformed * * when npoin=4) * * cpi(4-6) (complex) internal mass squared * * cpipj(6,6) (complex) cpi(i)-cpi(j) * * cpiDpj(6,6) (complex) pi(i).pi(j) * * * * Output: cs3 (complex)(48) C0, not yet summed. * * ipi12 (integer)(3) factors pi^2/12, not yet summed * * cslam (complex) lambda(p1,p2,p3). * * isoort (integer)(3) indication of he method used * * ier (integer) 0=ok, 1=inaccurate, 2=error * * * * Calls: ffcel2,ffcoot,ffccyz,ffcdwz,ffcs3,ffcs4 * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments: * integer ipi12(8),isoort(8),ilogi(3),npoin,ier ComplexType cs3(80),clogi(3),cpi(6),cpipj(6,6), + cpiDpj(6,6),sdel2,cel2si(3),etalam,etami(6), + delpsi(3),alpha(3) * * local variables: * integer i,j,k,ip,ierw,jsoort(8),iw,ismall(3) logical l4,l4pos ComplexType c,cs,zfflog,cs1,cs2,cs4 ComplexType cy(4,3),cz(4,3),cw(4,3),cdyz(2,2,3), + cdwy(2,2,3),cdwz(2,2,3),cd2yzz(3),cd2yww(3) ComplexType csdl2i(3) * ComplexType cyp,cym,ca,cb,cc,cd ComplexType zfflo1 RealType absc external zfflo1,zfflog * * common blocks: * #include "ff.h" absc(c) = abs(Re(c)) + abs(Im(c)) * #] declarations: * #[ get roots etc: * #[ get z-roots: if ( npoin .ne. 3 ) then l4pos = .FALSE. else l4pos = l4also endif do 10 i=1,3 * * get roots (y,z) * ip = i+3 * first get the roots j = i+1 if ( j .eq. 4 ) j = 1 csdl2i(i) = sqrt(-cel2si(i)) if ( cpi(ip) .eq. 0 ) then if ( i .eq. 1 .and. alpha(3) .eq. 0 .or. + i .eq. 3 .and. alpha(1) .eq. 0 ) then isoort(2*i-1) = 0 isoort(2*i) = 0 l4pos = .FALSE. goto 10 endif endif call ffccyz(cy(1,i),cz(1,i),cdyz(1,1,i),cd2yzz(i),i, + sdel2,csdl2i(i),etalam,etami,delpsi(i), + cpi,cpiDpj,isoort(2*i-1),ier) 10 continue * #] get z-roots: * #[ get w-roots: * * get w's: * ierw = 0 l4 = .FALSE. if ( isoort(4) .eq. 0 ) then call fferr(10,ierw) goto 90 endif do 70 iw = 1,3,2 if ( .not. l4pos .or. alpha(4-iw) .eq. 0 ) then jsoort(2*iw-1) = 0 jsoort(2*iw) = 0 l4pos = .FALSE. else jsoort(2*iw-1) = -1 jsoort(2*iw) = -1 cd2yww(iw) = -cd2yzz(2)/alpha(4-iw) do 20 j=1,2 cw(j+iw-1,iw) = cz(j+3-iw,2)/alpha(4-iw) cw(j+3-iw,iw) = 1 - cw(j+iw-1,iw) if ( absc(cw(j+3-iw,iw)) .lt. xloss ) then cs = cz(j+iw-1,2) - alpha(iw) if ( absc(cs) .lt. xloss*absc(alpha(iw)) ) then ierw = 1 goto 70 endif cw(j+3-iw,iw) = cs/alpha(4-iw) endif cdwy(j,2,iw) = cdyz(2,j,2)/alpha(4-iw) do 15 i=1,2 cdwz(j,i,iw) = cw(j,iw) - cz(i,iw) if ( absc(cdwz(j,i,iw)) .ge. xloss*absc(cw(j,iw)) ) + goto 14 cdwz(j,i,iw) = cz(i+2,iw) - cw(j+2,iw) if ( absc(cdwz(j,i,iw)) .ge. xloss*absc(cw(j+2,iw)) ) + goto 14 cdwz(j,i,iw) = cdwy(j,2,iw) + cdyz(2,i,iw) if ( absc(cdwz(j,i,iw)) .ge. xloss*absc(cdwy(j,2,iw)) ) + goto 14 l4 = .TRUE. call ffcdwz(cdwz(1,1,iw),cz(1,iw),j,i,iw, + alpha(1),alpha(3),cpi,cpipj,cpiDpj,csdl2i, + sdel2,6,ierw) 14 continue 15 continue 20 continue endif 70 continue * #] get w-roots: * #[ which case: 90 if ( l4 ) then if ( Im(alpha(1)) .ne. 0 ) then l4pos = .FALSE. elseif ( ierw .ge. 1 ) then l4pos = .FALSE. else ier = max(ier,ierw) endif endif * #] which case: * #] get roots etc: * #[ logarithms for 4point function: if ( npoin .eq. 4 ) then do 95 i = 1,3 ismall(i) = 0 if ( ilogi(i) .ne. -999 ) goto 95 if ( isoort(2*i) .ne. 0 ) then * maybe add sophisticated factors i*pi later c = -cdyz(2,1,i)/cdyz(2,2,i) if ( absc(c-1) .lt. xloss ) then cs = cd2yzz(i)/cdyz(2,2,i) clogi(i) = zfflo1(cs,ier) ilogi(i) = 0 ismall(i) = 1 elseif ( Re(c) .gt. 0 ) then clogi(i) = zfflog(c,0,czero,ier) ilogi(i) = 0 else if ( absc(c+1) .lt. xloss ) then cs = -2*csdl2i(i)/cdyz(2,2,i)/ + Re(cpi(i+3)) clogi(i) = zfflo1(cs,ier) ismall(i) = -1 else cs = 0 clogi(i) = zfflog(-c,0,czero,ier) endif if ( Im(c).lt.0 .or. Im(cs).lt.0 ) then ilogi(i) = -1 elseif ( Im(c).gt.0 .or. Im(cs).gt.0 ) then ilogi(i) = +1 elseif ( Re(cdyz(2,2,i)) .eq. 0 ) then ilogi(i)=-nint(sign(1D0,Re(cpi(i+3)))) ier = ier + 50 print *,'doubtful imaginary part ',ilogi(i) endif if ( abs(Im(c)).lt.precc*absc(c) .and. + abs(Im(cs)).lt.precc*absc(cs) ) then print *,'ffcc0p: error: imaginary part doubtful' ier = ier + 50 endif endif endif 95 continue do 96 i=1,3 j = i + 1 if ( j .eq. 4 ) j = 1 if ( abs(ismall(i)+ismall(j)) .eq. 2 .and. absc(clogi(i)+ + clogi(j)) .lt. xloss*absc(clogi(i)) ) then * assume that we got here because of complex sqrt(-delta) cs1=-2*cI*Im(cy(2,i))*csdl2i(j)/Re(cpi(j+3))/ + (cdyz(2,2,i)*cdyz(2,2,j)) cs2=-2*cI*Im(cy(2,j))*csdl2i(i)/Re(cpi(i+3))/ + (cdyz(2,2,i)*cdyz(2,2,j)) cs = cs1 + cs2 if ( absc(cs) .lt. xloss*absc(cs1) ) then k = j+1 if ( k .eq. 4 ) k = 1 cs1 = cpipj(j+3,i+3)*cpi(j) cs2 = cpiDpj(k+3,j)*cpiDpj(j+3,j) cs4 = -cpiDpj(k+3,j)*cpiDpj(i+3,j) cs = cs1 + cs2 + cs4 if ( absc(cs) .lt. xloss*max(absc(cs1),absc(cs2), + absc(cs4)) ) then print *,'ffcc0p: cancellations in delj-deli' goto 96 endif cs1 = cI*Im(cy(2,j))*cs/(csdl2i(i)+csdl2i(j)) call ffcl2t(cs2,cpiDpj,k+3,j,4,5,6,+1,-1,6) cs2 = -cs2*csdl2i(j)/sdel2/Re(cpi(j+3)) cs = cs1 + cs2 if ( absc(cs) .lt. xloss*absc(cs1) ) then print *,'ffcc0p: cancellations in extra terms' goto 96 endif cs = -2*cs/Re(cpi(i+3))/(cdyz(2,2,i)* + cdyz(2,2,j)) endif clogi(i) = zfflo1(cs,ier) clogi(j) = 0 endif 96 continue endif * #] logarithms for 4point function: * #[ integrals: if ( .not. l4 .or. .not. l4pos ) then * normal case do 200 i=1,3 j = 2*i-1 if ( isoort(2*i-1) .ne. 0 ) then call ffcs3(cs3(20*i-19),ipi12(2*i-1),cy(1,i), + cz(1,i),cdyz(1,1,i),cd2yzz(i),cpi,cpiDpj, + i,6,isoort(j),ier) endif 200 continue isoort(7) = 0 isoort(8) = 0 else isoort(3) = jsoort(1) isoort(4) = jsoort(2) call ffcs4(cs3(1),ipi12(1),cw(1,1),cy(1,1), + cz(1,1),cdwy(1,1,1),cdwz(1,1,1),cdyz(1,1,1), + cd2yww(1),cd2yzz(1),cpi,cpiDpj, + cpi(5)*alpha(3)**2,1,6,isoort(1),ier) isoort(7) = jsoort(5) isoort(8) = jsoort(6) call ffcs4(cs3(41),ipi12(1),cw(1,3),cy(1,3), + cz(1,3),cdwy(1,1,3),cdwz(1,1,3),cdyz(1,1,3), + cd2yww(3),cd2yzz(3),cpi,cpiDpj, + cpi(5)*alpha(1)**2,3,6,isoort(5),ier) endif * #] integrals: *###] ffcc0p: end *###[ ffccyz: subroutine ffccyz(cy,cz,cdyz,cd2yzz,ivert,csdelp,csdels,etalam, + etami,delps,xpi,piDpj,isoort,ier) ***#[*comment:*********************************************************** * * * calculate in a numerically stable way * * * * cz(1,2) = (-p(ip1).p(is2) +/- csdelp)/xpi(ip1) * * cy(1,2) = (-p(ip1).p(is2) +/- sdisc)/xpi(ip1) * * cdisc = csdels + etaslam*xpi(ip1) * * * * cy(3,4) = 1-cy(1,2) * * cz(3,4) = 1-cz(1,2) * * cdyz(i,j) = cy(i) - cz(j) * * * * Input: ivert (integer) defines the vertex * * csdelp (complex) sqrt(lam(p1,p2,p3))/2 * * csdels (complex) sqrt(lam(p,ma,mb))/2 * * etalam (complex) det(si.sj)/det(pi.pj) * * etami(6) (complex) si.si - etalam * * xpi(ns) (complex) standard * * piDpj(ns,ns) (complex) standard * * ns (integer) dim of xpi,piDpj * * * * Output: cy(4),cz(4),cdyz(4,4) (complex) see above * * ier (integer) usual error flag * * * * Calls: fferr,ffroot * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments: * integer ivert,ier,isoort(2) ComplexType cy(4),cz(4),cdyz(2,2),cd2yzz,csdelp,csdels ComplexType etalam,etami(6),delps,xpi(6),piDpj(6,6) * * local variables: * integer ip1,is1,is2,is3 ComplexType cdisc,c RealType absc * * common blocks: * #include "ff.h" * * statement function * absc(c) = abs(Re(c)) + abs(Im(c)) * #] declarations: * #[ set up pointers: is1 = ivert is2 = ivert+1 if ( is2 .eq. 4 ) is2 = 1 is3 = ivert-1 if ( is3 .eq. 0 ) is3 = 3 ip1 = is1 + 3 * #] set up pointers: * #[ xk = 0: if ( xpi(ip1) .eq. 0 ) then isoort(2) = 0 if ( piDpj(is1,ip1) .eq. 0 ) then isoort(1) = 0 return endif if ( Im(etalam).ne.0 ) then isoort(1) = -1 else isoort(1) = -3 endif cy(1) = etami(is2) / piDpj(is1,ip1) /2 cy(2) = cy(1) cy(3) = - etami(is1) / piDpj(is1,ip1) /2 cy(4) = cy(3) cz(1) = xpi(is2) / piDpj(is1,ip1) /2 cz(2) = cz(1) cz(3) = - xpi(is1) / piDpj(is1,ip1) /2 cz(4) = cz(3) cdyz(1,1) = - etalam / piDpj(is1,ip1) /2 cdyz(1,2) = cdyz(1,1) cdyz(2,1) = cdyz(1,1) cdyz(2,2) = cdyz(1,1) return endif * #] xk = 0: * #[ get cy(1,2),cz(1,2): if ( Im(etalam).ne.0 ) then isoort(1) = -1 isoort(2) = -1 else isoort(1) = -3 isoort(2) = -3 endif call ffcoot(cz(1),cz(2),xpi(ip1),piDpj(ip1,is2),xpi(is2), + csdels,ier) cdisc = delps/csdelp call ffcoot(cy(1),cy(2),xpi(ip1),piDpj(ip1,is2),etami(is2), + cdisc,ier) * #] get cy(1,2),cz(1,2): * #[ get cy(3,4),cz(3,4): cz(4) = 1-cz(2) cz(3) = 1-cz(1) if ( absc(cz(3)) .lt. xloss .or. absc(cz(4)) .lt. xloss ) then call ffcoot(cz(4),cz(3),xpi(ip1),-piDpj(ip1,is1), + xpi(is1),csdels,ier) endif * the imaginary part may not be accurate in these cases, take * some precautions: if ( cz(3) .eq. 0 ) cz(1) = 1 if ( cz(4) .eq. 0 ) cz(2) = 1 if ( Im(cz(1)).eq.0 ) + cz(1) = ToComplex(Re(cz(1)),-Im(cz(3))) if ( Im(cz(2)).eq.0 ) + cz(2) = ToComplex(Re(cz(2)),-Im(cz(4))) if ( Im(cz(1)) .gt. 0 .neqv. Im(cz(3)) .lt. 0 ) then if ( abs(Re(cz(1))) .ge. abs(Re(cz(3))) ) then cz(1) = ToComplex(Re(cz(1)),-Im(cz(3))) else cz(3) = ToComplex(Re(cz(3)),-Im(cz(1))) endif endif if ( Im(cz(2)) .gt. 0 .neqv. Im(cz(4)) .lt. 0 ) then if ( abs(Re(cz(2))) .ge. abs(Re(cz(4))) ) then cz(2) = ToComplex(Re(cz(2)),-Im(cz(4))) else cz(4) = ToComplex(Re(cz(4)),-Im(cz(2))) endif endif cy(4) = 1-cy(2) cy(3) = 1-cy(1) if ( absc(cy(3)) .lt. xloss .or. absc(cy(4)) .lt. xloss ) then call ffcoot(cy(4),cy(3),xpi(ip1),-piDpj(ip1,is1), + etami(is1),cdisc,ier) endif if ( cy(3) .eq. 0 ) cy(1) = 1 if ( cy(4) .eq. 0 ) cy(2) = 1 if ( Im(cy(1)).eq.0 ) + cy(1) = ToComplex(Re(cy(1)),-Im(cy(3))) if ( Im(cy(2)).eq.0 ) + cy(2) = ToComplex(Re(cy(2)),-Im(cy(4))) if ( Im(cy(1)) .gt. 0 .neqv. Im(cy(3)) .lt. 0 ) then if ( abs(Re(cy(1))) .ge. abs(Re(cy(3))) ) then cy(1) = ToComplex(Re(cy(1)),-Im(cy(3))) else cy(3) = ToComplex(Re(cy(3)),-Im(cy(1))) endif endif if ( Im(cy(2)) .gt. 0 .neqv. Im(cy(4)) .lt. 0 ) then if ( abs(Re(cy(2))) .ge. abs(Re(cy(4))) ) then cy(2) = ToComplex(Re(cy(2)),-Im(cy(4))) else cy(4) = ToComplex(Re(cy(4)),-Im(cy(2))) endif endif * #] get cy(3,4),cz(3,4): * #[ get cdyz: * Note that cdyz(i,j) only exists for i,j=1,2! if ( absc(cdisc+csdels) .gt. xloss*absc(cdisc) ) then cdyz(2,1) = ( cdisc + csdels )/xpi(ip1) cdyz(2,2) = etalam/(xpi(ip1)*cdyz(2,1)) else cdyz(2,2) = ( cdisc - csdels )/xpi(ip1) cdyz(2,1) = etalam/(xpi(ip1)*cdyz(2,2)) endif cdyz(1,1) = -cdyz(2,2) cdyz(1,2) = -cdyz(2,1) cd2yzz = 2*cdisc/xpi(ip1) * #] get cdyz: *###] ffccyz: end LoopTools-2.16/src/C/PaxHeaders/ffxc0i.F0000644000000000000000000000007412274401122014711 xustar0030 atime=1648161785.719698432 30 ctime=1648161793.715764879 LoopTools-2.16/src/C/ffxc0i.F0000644000000000000000000004255012274401122015632 0ustar00rootroot00000000000000#include "externals.h" #include "types.h" *--#[ log: * $Id: ffxc0i.f,v 1.3 1996/06/03 12:11:43 gj Exp $ * $Log: ffxc0i.f,v $ c Revision 1.3 1996/06/03 12:11:43 gj c Added an error message for ffxc0j with zero masses, which is ill-defined. c c Revision 1.2 1995/12/01 15:04:40 gj c Fixed a ridiculous bug: wrong sign for p4^2=0, m20 for * the time being - we calculate a complete 3point function so it * should not be a problem (just a sign). Of course this spoils a * good check on the correctness. * sdel2 = abs(sdel2i) * if ( xpi(4).eq.0 ) then zm = xpi(2)/dpipj(2,1) zm1 = -xpi(1)/dpipj(2,1) else call ffroot(zm,zp,xpi(4),piDpj(4,2),xpi(2),sdel2,ier) if ( dpipj(1,2) .ne. 0 ) then call ffroot(zp1,zm1,xpi(4),-piDpj(4,1),xpi(1),sdel2,ier) else zm1 = zp zp1 = zm endif endif * imag sign ok 30-oct-1989 ieps = -1 if ( xpi(4).ne.0 ) dyzp = -2*sdel2/xpi(4) * * #] get determinants, roots, ieps: * #[ the finite+divergent S1: * if ( xpi(4).ne.0 ) then call ffcxr(cs(1),ipi12,zm,zm1,zp,zp1,dyzp, + .FALSE.,0D0,0D0,0D0,.FALSE.,dum,ieps,ier) endif * * Next the divergent piece * if ( .not.lsmug ) then * * Here we dropped the term log(lam/lamsq)*log(-zm/zm1) * if ( abs(zm1) .gt. 1/xloss ) then clog1 = dfflo1(1/zm1,ier) elseif ( zm.ne.0 ) then clog1 = zxfflg(-zm/zm1,-2,0D0,ier) else call fferr(97,ier) return endif hulp = zm*zm1*4*del2/lamsq**2 * * 14-jan-1994: do not count when this is small, this was * meant to be so by the user carefully adjusting lamsq * ier0 = ier if ( hulp.eq.0 ) call fferr(97,ier) clog2 = zxfflg(hulp,2,0D0,ier0) cs(8) = -clog1*clog2/2 else * * checked 4-aug-1992, but found Yet Another Bug 30-sep-1992 * cdyzm = cel3*Re(1/(-2*sdel2*del2)) dyzm = del3/(-2*sdel2*del2) carg1 = +cdyzm*Re(1/zm) arg1 = +dyzm/zm clog1 = zfflog(-carg1,+ieps,ToComplex(Re(zm),Re(0)),ier) if (Im(cdyzm) .lt. 0 .and. arg1 .gt. 0 ) then clog1 = clog1 - c2ipi * ier = ier + 50 endif cs(8) = -clog1**2/2 carg2 = -cdyzm*Re(1/zm1) arg2 = -dyzm/zm1 clog2 = zfflog(-carg2,ieps,ToComplex(Re(-zm1),Re(0)),ier) if ( Im(cdyzm) .lt. 0 .and. arg2 .gt. 0 ) then clog2 = clog2 + c2ipi endif cs(9) = +clog2**2/2 endif * #] the finite+divergent S1: * #[ log(1) for npoin=4: if ( npoin .eq. 4 ) then if ( ilogi(1) .eq. -999 ) then if ( .not.lsmug ) then hulp = xpi(4)*lamsq/(4*del2) ier0 = ier if ( hulp.eq.0 ) call fferr(97,ier) clogi(1) = -zxfflg(abs(hulp),0,0D0,ier0) if ( hulp .lt. 0 ) then if ( xpi(4) .gt. 0 ) then ilogi(1) = -1 else ilogi(1) = +1 endif else ilogi(1) = 0 endif else if ( xpi(4).eq.0 ) then print *,'ffxc0i: cannot handle t=0 yet, sorry' print *,'Please regularize with a small mass' stop endif chulp = -cdyzm*Re(1/dyzp) chulp1 = 1+chulp if ( absc(chulp1) .lt. xloss ) + call ffwarn(129,ier,absc(chulp1),1D0) call ffxclg(clogi(1),ilogi(1),chulp,chulp1,dyzp, + ier) endif endif endif * #] log(1) for npoin=4: * #[ the log(lam) Si: if ( .not.lsmug ) then * * Next the divergent S_i (easy). * The term -2*log(lam/lamsq)*log(xpi(2)/xpi(1)) has been discarded * with lam the photon mass (regulator). * If lamsq = sqrt(xpi(1)*xpi(2)) the terms cancel as well * if ( dpipj(1,2).ne.0 .and. xloss*abs(xpi(1)*xpi(2)-lamsq**2) + .gt.precx*lamsq**2 ) then if ( xpi(1) .ne. lamsq ) then ier0 = ier if ( xpi(1).eq.0 ) call fferr(97,ier) cs(9) = -zxfflg(xpi(1)/lamsq,0,0D0,ier0)**2 /4 endif if ( xpi(2) .ne. lamsq ) then ier0 = ier if ( xpi(2).eq.0 ) call fferr(97,ier) cs(10) = zxfflg(xpi(2)/lamsq,0,0D0,ier0)**2 /4 endif endif * #] the log(lam) Si: * #[ the logs for A_i<0: if ( npoin.eq.4 ) then clogi(2) = 0 ilogi(2) = 0 clogi(3) = 0 ilogi(3) = 0 endif * #] the logs for A_i<0: * #[ the off-shell S3: else * * the divergent terms in the offshell regulator scheme - not * quite as easy * wm = p3.p2/sqrtdel - 1 = -s1.s2/sqrtdel - 1 * wp = p3.p2/sqrtdel + 1 = -s1.s2/sqrtdel + 1 * Note that we took the choice sdel2<0 in S1 when * \delta^{p1 s2}_{p1 p2} < 0 by using yp=zm * wm = -1 - piDpj(1,2)/sdel2 wp = wm + 2 if ( abs(wm) .lt. abs(wp) ) then wm = -xpi(5)*xpi(6)/(del2*wp) else wp = -xpi(5)*xpi(6)/(del2*wm) endif * * the im sign * if ( -Re(cmipj(1,3)) .gt. 0 ) then ieps = -1 else ieps = +1 endif * if ( nschem .lt. 3 .or. Im(cmipj(1,3)).eq.0 .and. + Im(cmipj(2,2)).eq.0 ) then * #[ real case: * * first z-,z+ * dyzp = -Re(cmipj(1,3))*Re(wm)/(2*Re(xpi(6))) - + Re(cmipj(2,2))/(2*Re(sdel2)) dyzm = -Re(cmipj(1,3))*Re(wp)/(2*Re(xpi(6))) - + Re(cmipj(2,2))/(2*Re(sdel2)) * * the (di)logs * clog1 = zxfflg(-dyzp,-ieps,1D0,ier) cs(10) = -clog1**2/2 ipi12 = ipi12 - 4 clog2 = zxfflg(-dyzm,+ieps,1D0,ier) cs(11) = -clog2**2/2 ipi12 = ipi12 - 2 hulp = dyzp/dyzm if ( dyzp .lt. 0 ) then ieps1 = -ieps else ieps1 = +ieps endif call ffzxdl(cli,i,cdum(1),hulp,+ieps1,ier) cs(12) = -cli ipi12 = ipi12 - i * * the log for npoin=4 * if ( npoin.eq.4 ) then if ( ilogi(3) .eq. -999 ) then if ( Re(cmipj(1,3)) .eq. 0 ) then chulp = -1 chulp1 = 0 elseif ( dyzp .lt. dyzm ) then chulp = -dyzm/dyzp chulp1 = +Re(cmipj(1,3))/Re(xpi(6)*dyzp) else chulp = -dyzp/dyzm chulp1 = -Re(cmipj(1,3))/Re(xpi(6)*dyzm) endif call ffxclg(clogi(3),ilogi(3),chulp,chulp1,dyzp, + ier) endif endif * #] real case: else * #[ complex case: * * first z+ * cdyzp = -cmipj(1,3)*Re(wm)/(2*Re(xpi(6))) - + cmipj(2,2)/(2*Re(sdel2)) clog1 = zfflog(-cdyzp,-ieps,cone,ier) if ( ieps*Im(cdyzp).lt.0 .and. Re(cdyzp).gt.0 ) then clog1 = clog1 - ieps*c2ipi endif cs(10) = -clog1**2/2 ipi12 = ipi12 - 4 * * now z- * cdyzm = -cmipj(1,3)*Re(wp)/(2*Re(xpi(6))) - + cmipj(2,2)/(2*Re(sdel2)) clog2 = zfflog(-cdyzm,+ieps,cone,ier) if ( ieps*Im(cdyzm).gt.0 .and. Re(cdyzm).gt.0 ) then clog2 = clog2 + ieps*c2ipi endif cs(11) = -clog2**2/2 ipi12 = ipi12 - 2 * * the dilog * chulp = cdyzp/cdyzm hulp = Re(cdyzp)/Re(cdyzm) if ( Re(cdyzp) .lt. 0 ) then ieps1 = -ieps else ieps1 = +ieps endif if ( Im(chulp) .eq. 0 ) then hulp = Re(chulp) call ffzxdl(cli,i,cdum(1),hulp,+ieps1,ier) else call ffzzdl(cli,i,cdum(1),chulp,ier) if ( hulp.gt.1 .and. ieps1*Im(chulp).lt.0 ) then cli = cli + ieps1*c2ipi*zfflog(chulp,0,czero,ier) endif endif cs(12) = -cli ipi12 = ipi12 - i * * the log for npoin=4 * if ( npoin.eq.4 ) then if ( ilogi(3) .eq. -999 ) then if ( cmipj(1,3) .eq. 0 ) then chulp = -1 chulp1 = 0 elseif ( Re(cdyzp) .lt. Re(cdyzm) ) then chulp = -cdyzm/cdyzp chulp1 = +cmipj(1,3)/cdyzp*Re(1/xpi(6)) else chulp = -cdyzp/cdyzm chulp1 = -cmipj(1,3)/cdyzm*Re(1/xpi(6)) endif dyzp = Re(cdyzp) call ffxclg(clogi(3),ilogi(3),chulp,chulp1,dyzp, + ier) endif endif * #] complex case: endif * #] the off-shell S3: * #[ the off-shell S2: * * the im sign * if ( -Re(cmipj(2,2)) .gt. 0 ) then ieps = -1 else ieps = +1 endif * if ( nschem .lt. 3 ) then * #[ real case: * * first z- * dyzm = -Re(cmipj(2,2))*Re(wp)/(2*Re(xpi(5))) - + Re(cmipj(1,3))/(2*Re(sdel2)) clog1 = zxfflg(+dyzm,-ieps,1D0,ier) cs(13) = +clog1**2/2 ipi12 = ipi12 + 4 * * now z+ * dyzp = -Re(cmipj(2,2))*Re(wm)/(2*Re(xpi(5))) - + Re(cmipj(1,3))/(2*Re(sdel2)) clog2 = zxfflg(+dyzp,+ieps,1D0,ier) cs(14) = +clog2**2/2 ipi12 = ipi12 + 2 hulp = dyzm/dyzp if ( dyzm .lt. 0 ) then ieps1 = -ieps else ieps1 = +ieps endif call ffzxdl(cli,i,cdum(1),hulp,-ieps1,ier) cs(15) = +cli ipi12 = ipi12 + i * * the log for npoin=4 * if ( npoin.eq.4 ) then if ( ilogi(2) .eq. -999 ) then if ( Re(cmipj(2,2)) .eq. 0 ) then chulp = -1 chulp1 = 0 elseif ( dyzp .lt. dyzm ) then chulp = -dyzm/dyzp chulp1 = +Re(cmipj(2,2))/Re(xpi(5)*dyzp) elseif ( dyzp .gt. dyzm ) then chulp = -dyzp/dyzm chulp1 = -Re(cmipj(2,2))/Re(xpi(5)*dyzm) endif call ffxclg(clogi(2),ilogi(2),chulp,chulp1,dyzp, + ier) endif endif * #] real case: else * #[ complex case: * * first z- * cdyzm = -cmipj(2,2)*Re(wp)/(2*Re(xpi(5))) - + cmipj(1,3)/(2*Re(sdel2)) clog1 = zfflog(+cdyzm,-ieps,cone,ier) if ( Re(cdyzm).lt.0.and.ieps*Im(cdyzm).gt.0 ) then clog1 = clog1 - ieps*c2ipi endif cs(13) = +clog1**2/2 ipi12 = ipi12 + 4 * * now z+ * cdyzp = -cmipj(2,2)*Re(wm)/(2*Re(xpi(5))) - + cmipj(1,3)/(2*Re(sdel2)) clog2 = zfflog(+cdyzp,+ieps,cone,ier) if ( Re(cdyzp).lt.0.and.ieps*Im(cdyzp).lt.0 ) then clog2 = clog2 + ieps*c2ipi endif cs(14) = +clog2**2/2 ipi12 = ipi12 + 2 * * and ghe dilog * chulp = cdyzm/cdyzp hulp = Re(dyzm)/Re(dyzp) if ( Re(cdyzm) .lt. 0 ) then ieps1 = -ieps else ieps1 = +ieps endif if ( Im(chulp ) .eq. 0 ) then hulp = Re(chulp) call ffzxdl(cli,i,cdum(1),hulp,-ieps1,ier) else call ffzzdl(cli,i,cdum(1),chulp,ier) if ( hulp.gt.1 .and. ieps1*Im(chulp).gt.0 ) then cli = cli - ieps1*c2ipi*zfflog(chulp,0,czero,ier) endif endif cs(15) = +cli ipi12 = ipi12 + i * * the log for npoin=4 * if ( npoin.eq.4 ) then if ( ilogi(2) .eq. -999 ) then if ( cmipj(2,2) .eq. 0 ) then chulp = -1 chulp1 = 0 elseif ( Re(cdyzp) .lt. Re(cdyzm) ) then chulp = -cdyzm/cdyzp chulp1 = +cmipj(2,2)/cdyzp*Re(1/xpi(5)) elseif ( Re(cdyzp) .gt. Re(cdyzm) ) then chulp = -cdyzp/cdyzm chulp1 = -cmipj(2,2)/cdyzm*Re(1/xpi(5)) endif dyzp = Re(cdyzp) call ffxclg(clogi(2),ilogi(2),chulp,chulp1,dyzp, + ier) endif endif * #] complex case: endif endif * #] the off-shell S2: * #[ sdel2<0!: if ( sdel2i.gt.0 .neqv. xpi(4).eq.0.and.xpi(1).gt.xpi(2) ) then if ( .not.lsmug ) then n = 10 else n = 15 endif do 10 i=1,n cs(i) = -cs(i) 10 continue ipi12 = -ipi12 if ( npoin.eq.4 ) then do 20 i=1,3 ilogi(i) = -ilogi(i) clogi(i) = -clogi(i) 20 continue endif endif * #] sdel2<0!: *###] ffxc0j: end *###[ ffxclg: subroutine ffxclg(clg,ilg,chulp,chulp1,dyzp,ier) ***#[*comment:*********************************************************** * * * compute the extra logs for npoin=4 given chulp=-cdyzm/cdyzp * * all flagchecking has already been done. * * * * Input: chulp (complex) see above * * chulp1 (complex) 1+chulp (in case chulp ~ -1) * * dyzp (real) (real part of) y-z+ for im part * * Output: clg (complex) the log * * ilg (integer) factor i*pi split off clg * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments * integer ilg,ier RealType dyzp ComplexType clg,chulp,chulp1 * * local variables * RealType hulp,hulp1,dfflo1 ComplexType zxfflg,zfflog,zfflo1 external dfflo1,zxfflg,zfflog,zfflo1 * * common blocks * #include "ff.h" * * #] declarations: * #[ work: * if ( Im(chulp) .eq. 0 ) then hulp = Re(chulp) hulp1 = Re(chulp1) if ( abs(hulp1) .lt. xloss ) then clg = Re(dfflo1(hulp1,ier)) else clg = zxfflg(abs(hulp),0,0D0,ier) endif if ( hulp .lt. 0 ) then if ( dyzp.lt.0 ) then ilg = +1 else ilg = -1 endif else ilg = 0 endif else * * may have to be improved * if ( abs(Re(chulp1))+abs(Im(chulp1)) .lt. xloss ) then clg = zfflo1(chulp1,ier) else clg = zfflog(chulp,0,czero,ier) endif ilg = 0 if ( Re(chulp) .lt. 0 ) then if ( dyzp.lt.0 .and. Im(clg).lt.0 ) then ilg = +2 elseif ( dyzp.gt.0 .and. Im(clg).gt.0 ) then ilg = -2 endif endif endif * #] work: *###] ffxclg: end LoopTools-2.16/src/C/PaxHeaders/C0func.F0000644000000000000000000000007412401077674014665 xustar0030 atime=1648161785.719698432 30 ctime=1648161793.715764879 LoopTools-2.16/src/C/C0func.F0000644000000000000000000003565712401077674015620 0ustar00rootroot00000000000000* C0.F * the scalar three-point function * this file is part of LoopTools * last modified 1 Sep 14 th #include "externals.h" #include "types.h" #define npoint 3 #include "defs.h" subroutine C0func(res, para) implicit none ComplexType res(0:2) RealType para(1,*) #include "lt.h" external C0soft, C0coll, C0softDR, C0collDR res(0) = 0 res(1) = 0 res(2) = 0 if( lambda .le. 0 ) then call CDispatch(res, para, C0softDR, C0collDR) else call CDispatch(res, para, C0soft, C0coll) endif end ************************************************************************ subroutine CDispatch(res, para, soft, coll) implicit none ComplexType res(0:2) RealType para(1,*) external soft, coll #include "lt.h" #include "perm.h" integer i, z, c, s, perm, ier, key ComplexType alt ComplexType C0p3, C0p2, C0p1, C0p0 external C0p3, C0p2, C0p1, C0p0 integer paraperm(3) data paraperm /p123, p231, p312/ #define Px(j) P(ibits(perm,3*(3-j),3)) #define Mx(j) M(ibits(perm,3*(3-j),3)) c = 0 555 z = 0 s = 0 do i = 1, 3 perm = paraperm(i) if( abs(Mx(1)) .lt. zeroeps ) then if( abs(Px(1) - Mx(2)) + & abs(Px(3) - Mx(3)) .lt. diffeps ) then if( DEBUGLEVEL .gt. 0 ) & print '("soft C0, perm = ",O3)', perm s = perm goto 556 endif if( abs(Px(1)) + abs(Mx(2)) .lt. zeroeps ) c = perm endif if( abs(P(i)) .lt. zeroeps ) z = z + 1 enddo if( c .ne. 0 ) then if( DEBUGLEVEL .gt. 0 ) & print '("collinear C0, perm = ",O3)', perm call coll(res, para, c) if( c .eq. 0 ) goto 555 return endif 556 if( lambda .lt. 0 .or. (s .ne. 0 .and. lambda .eq. 0) ) then res(0) = 0 if( s .ne. 0 ) call soft(res, para, s) return endif key = ibits(versionkey, KeyC0, 2) if( key .ne. 1 ) then ier = 0 call ffxc0(res(0), para, ier) if( ier .gt. warndigits ) then ier = 0 call ffxc0r(res(0), para, ier) if( ier .gt. warndigits ) key = ior(key, 2) if( ier .ge. errdigits ) key = ior(key, 3) endif if( key .eq. 0 ) return alt = res(0) endif if( s .ne. 0 ) then call soft(res, para, s) goto 9 endif goto (1, 2, 3) z res(0) = C0p3(para, p123) + C0p3(para, p231) + C0p3(para, p312) goto 9 1 res(0) = C0p2(para, p123) + C0p2(para, p231) + C0p2(para, p312) goto 9 2 res(0) = C0p1(para, p123) + C0p1(para, p231) + C0p1(para, p312) goto 9 3 res(0) = C0p0(para) 9 if( key .ne. 0 ) then if( key .gt. 1 .and. & abs(res(0) - alt) .gt. maxdev*abs(alt) ) then print *, "Discrepancy in C0:" print *, " p1 =", P(1) print *, " p2 =", P(2) print *, " p1p2 =", P(3) print *, " m1 =", M(1) print *, " m2 =", M(2) print *, " m3 =", M(3) print *, "C0 a =", alt print *, "C0 b =", res(0) if( ier .gt. errdigits ) alt = res(0) endif endif if( .not. btest(key, 0) ) res(0) = alt end ************************************************************************ subroutine CDump(s, para, perm) implicit none character*(*) s RealType para(1,*) integer perm #include "lt.h" print '(A,", perm = ",O3)', s, perm if( DEBUGLEVEL .gt. 1 ) then print *, "p1 =", Px(1) print *, "p2 =", Px(2) print *, "p3 =", Px(3) print *, "m1 =", Mx(1) print *, "m2 =", Mx(2) print *, "m3 =", Mx(3) endif end ************************************************************************ * the following routines are adapted from Ansgar Denner's bcanew.f * to the conventions of LoopTools; * they are used for double-checking the results of FF * all mom-squares != 0 ComplexType function C0p3(para, perm) implicit none RealType para(1,*) integer perm #include "lt.h" RealType m1, m2, m3, p1, p2, p3, pp1, pp2, pp3 RealType m12, m13, m23, a2, n, n1, n2, n3, n123, s ComplexType a, b, c ComplexType y1, y2, y3, y4, x1, x2, x3, x4, z3, z4 integer z3z4, x1z3, x3z3, x2z4, x4z4 ComplexType spence integer eta external spence, eta if( DEBUGLEVEL .gt. 0 ) call CDump("C0p3", para, perm) m1 = Mx(1) m2 = Mx(2) m3 = Mx(3) p1 = Px(1) p2 = Px(2) p3 = Px(3) m12 = m1 - m2 m13 = m1 - m3 m23 = m2 - m3 a2 = (p1 - p2 - p3)**2 - 4*p2*p3 a = sqrt(ToComplex(a2)) n = .5D0/p1 c = (p1*(p1 - p2 - p3 - m13 - m23) - m12*(p2 - p3))/a n123 = p1*(p2*p3 + m13*m23) + m12*(m13*p2 - m23*p3) pp1 = p1*(p1 - p2 - p3) pp2 = p2*(p1 - p2 + p3) pp3 = p3*(p1 + p2 - p3) n1 = n123 - m23*pp1 - m12*pp2 n2 = n123 - m13*pp1 + m12*pp3 n3 = n123 + m3*pp1 - m1*pp2 - m2*pp3 y1 = n*(c + (p1 - m12)) y4 = n*(c - (p1 - m12)) if( abs(y1) .lt. abs(y4) ) y1 = n1/(a2*p1*y4) y2 = n*(c - (p1 + m12)) y4 = n*(c + (p1 + m12)) if( abs(y2) .lt. abs(y4) ) y2 = n2/(a2*p1*y4) b = sqrt(ToComplex((p1 - m12)**2 - 4*p1*m2)) y3 = n*(c + b) y4 = n*(c - b) if( abs(y3) .lt. abs(y4) ) then y3 = n3/(a2*p1*y4) else y4 = n3/(a2*p1*y3) endif s = Re(a*b) y3 = y3 + sign(abs(y3), s)*cIeps y4 = y4 - sign(abs(y4), s)*cIeps C0p3 = spence(0, y2/y3, 0D0) + spence(0, y2/y4, 0D0) - & spence(0, y1/y3, 0D0) - spence(0, y1/y4, 0D0) if( Im(a) .ne. 0 ) then c = cIeps if( abs(b) .ne. 0 ) c = abs(b)/b*c x1 = c - n*( p1 - m12 + b) x2 = c - n*( p1 - m12 - b) x3 = c - n*(-p1 - m12 + b) x4 = c - n*(-p1 - m12 - b) z3 = 1/y3 z4 = 1/y4 z3z4 = eta(z3, 0D0, z4, 0D0, 0D0) x1z3 = eta(x1, 0D0, z3, 0D0, 0D0) x3z3 = eta(x3, 0D0, z3, 0D0, 0D0) x2z4 = eta(x2, 0D0, z4, 0D0, 0D0) x4z4 = eta(x4, 0D0, z4, 0D0, 0D0) c = log(y1)*(eta(x1, 0D0, x2, 0D0, 0D0) + & z3z4 - x1z3 - x2z4) - & log(y2)*(eta(x3, 0D0, x4, 0D0, 0D0) + & z3z4 - x3z3 - x4z4) + & log(y3)*(x1z3 - x3z3) + & log(y4)*(x2z4 - x4z4) if( Im(a) .gt. 0 .and. p1 .lt. 0 ) c = c - log(y1/y2) C0p3 = C0p3 + c2ipi*c endif C0p3 = C0p3/a if( DEBUGLEVEL .gt. 1 ) print *, "C0p3 =", C0p3 end ************************************************************************ * one mom-square zero ComplexType function C0p2(para, perm) implicit none RealType para(1,*) integer perm #include "lt.h" RealType m1, m2, m3, p1, p2, p3 RealType m12, m23, m13, a, c, y1, y2 ComplexType b, y3, y4 ComplexType spence external spence if( DEBUGLEVEL .gt. 0 ) call CDump("C0p2", para, perm) if( abs(Px(1)) .lt. zeroeps ) then C0p2 = 0 return endif m1 = Mx(1) m2 = Mx(2) m3 = Mx(3) p1 = Px(1) p2 = Px(2) p3 = Px(3) m12 = m1 - m2 m23 = m2 - m3 m13 = m1 - m3 if( abs(p3) .lt. zeroeps ) then a = p1 - p2 y1 = -2*p1*(m13 - a) y2 = -2*p1*m13 else a = p3 - p1 y1 = -2*p1*m23 y2 = -2*p1*(m23 + a) endif c = p1*(p1 - p2 - p3 - m13 - m23) - m12*(p2 - p3) b = a*sqrt(ToComplex((p1 - m12)**2 - 4*p1*m2)) y3 = c + b y4 = c - b c = 4*p1*( & p1*((p1 - p2 - p3)*m3 + p2*p3 + m13*m23) + & p2*((p2 - p3 - p1)*m1 + m12*m13) + & p3*((p3 - p1 - p2)*m2 - m12*m23) ) if( abs(y3) .lt. abs(y4) ) then y3 = c/y4 else y4 = c/y3 endif c = a/p1 y3 = y3 + sign(abs(y3), c)*cIeps y4 = y4 - sign(abs(y4), c)*cIeps C0p2 = (spence(0, y2/y3, 0D0) + spence(0, y2/y4, 0D0) - & spence(0, y1/y3, 0D0) - spence(0, y1/y4, 0D0))/a if( DEBUGLEVEL .gt. 1 ) print *, "C0p2 =", C0p2 end ************************************************************************ * two mom-squares zero ComplexType function C0p1(para, perm) implicit none RealType para(1,*) integer perm #include "lt.h" RealType m1, m2, m3, p1, p2, p3 RealType m12, m23, m13, c, y1, y2 ComplexType b, y3, y4 ComplexType spence external spence if( DEBUGLEVEL .gt. 0 ) call CDump("C0p1", para, perm) if( abs(Px(1)) .lt. zeroeps ) then C0p1 = 0 return endif m1 = Mx(1) m2 = Mx(2) m3 = Mx(3) p1 = Px(1) p2 = Px(2) p3 = Px(3) m12 = m1 - m2 m23 = m2 - m3 m13 = m1 - m3 C0p1 = 0 if( abs(m13) .gt. diffeps ) then y1 = m23 - p1 y2 = m23 c = m23 + p1*m3/m13 y3 = c - sign(c, p1/m13)*cIeps C0p1 = spence(0, y1/y3, 0D0) - spence(0, y2/y3, 0D0) endif y1 = -2*p1*m23 y2 = -2*p1*(m23 - p1) c = p1*(p1 - m13 - m23) b = p1*sqrt(ToComplex((p1 - m12)**2 - 4*p1*m2)) y3 = c - b y4 = c + b c = 4*p1**2*(p1*m3 + m13*m23) if( abs(y3) .lt. abs(y4) ) then y3 = c/y4 else y4 = c/y3 endif y3 = y3 - abs(y3)*cIeps y4 = y4 + abs(y4)*cIeps C0p1 = (C0p1 + & spence(0, y1/y3, 0D0) + spence(0, y1/y4, 0D0) - & spence(0, y2/y3, 0D0) - spence(0, y2/y4, 0D0))/p1 if( DEBUGLEVEL .gt. 1 ) print *, "C0p1 =", C0p1 end ************************************************************************ ComplexType function C0p0(para) implicit none RealType para(1,*) #include "lt.h" #include "perm.h" RealType m1, m2, m3 RealType m12, m23, m13 if( DEBUGLEVEL .gt. 0 ) call CDump("C0p0", para, p123) m1 = M(1) m2 = M(2) m3 = M(3) m12 = m1 - m2 m23 = m2 - m3 m13 = m1 - m3 if( abs(m23) .lt. diffeps ) then if( abs(m13) .lt. diffeps ) then C0p0 = -.5D0/m1 else C0p0 = (m13 - m1*log(m1/m3))/m13**2 endif else if( abs(m12) .lt. diffeps ) then C0p0 = (-m23 + m3*log(m2/m3))/m23**2 else if( abs(m13) .lt. diffeps ) then C0p0 = (m23 - m2*log(m2/m3))/m23**2 else C0p0 = m3/(m13*m23)*log(m1/m3) - m2/(m12*m23)*log(m1/m2) endif endif if( DEBUGLEVEL .gt. 1 ) print *, "C0p0 =", C0p0 end ************************************************************************ subroutine C0soft(res, para, perm) implicit none ComplexType res RealType para(1,*) integer perm #include "lt.h" ComplexType spence external spence RealType s, m1, m2 RealType a, h1, h2, h3, ps ComplexType ls logical ini data ini /.FALSE./ if( DEBUGLEVEL .gt. 0 ) call CDump("C0soft", para, perm) s = Px(2) m1 = Px(1) m2 = Px(3) a = sqrt(4*m1*m2) if( abs(a) .lt. zeroeps ) then ps = max(minmass, 1D-14) if( abs(m1) .lt. zeroeps ) m1 = ps if( abs(m2) .lt. zeroeps ) m2 = ps if( .not. ini ) then print *, "collinear-divergent C0, using mass cutoff ", ps ini = .TRUE. endif endif if( abs(s) .lt. diffeps ) then if( abs(m1 - m2) .lt. diffeps ) then res = -.5D0*log(m1/lambda)/m1 else res = -.25D0*log(m2*m1/lambda**2)* & log(m1/m2)/(m1 - m2) endif return endif ps = s - m1 - m2 a = (ps - a)*(ps + a) if( a .lt. 0 ) then print *, "C0soft: complex square-root not implemented" a = 0 endif a = sqrt(a) if( ps .le. 0 ) then h1 = .5D0*(a - ps) else h1 = -2*m1*m2/(a + ps) endif ps = s - m1 + m2 if( ps .le. 0 ) then h2 = .5D0*(a - ps) else h2 = -2*s*m2/(a + ps) endif ps = s + m1 - m2 if( ps .le. 0 ) then h3 = .5D0*(a - ps) else h3 = -2*m1*s/(a + ps) endif ls = ln(-a/s, -1) res = (-pi6 + & spence(0, ToComplex(h2/a), -1D0) + & spence(0, ToComplex(h3/a), -1D0) - & .5D0*(ln(-h2/s, -1)**2 + ln(-h3/s, -1)**2) + & .25D0*(ln(-m1/s, -1)**2 + ln(-m2/s, -1)**2) - & ls*(ln(-h1/s, -1) - ls) + & ln(-lambda/s, -1)*ln(h1/sqrt(m1*m2), 1))/a if( DEBUGLEVEL .gt. 1 ) print *, "C0soft =", res end ************************************************************************ subroutine C0coll(res, para, perm) implicit none ComplexType res RealType para(1,*) integer perm #include "lt.h" logical ini data ini /.FALSE./ if( DEBUGLEVEL .gt. 0 ) call CDump("C0coll", para, perm) Px(1) = max(minmass, 1D-14) if( ini ) then print *, "collinear-divergent C0, using mass cutoff ", Px(1) ini = .TRUE. endif perm = 0 end ************************************************************************ subroutine C0softDR(res, para, perm) implicit none ComplexType res(0:2) RealType para(1,*) integer perm #include "lt.h" RealType s, m1, m2 RealType m, dm, r, f ComplexType root, fac, ls, lm, mK, lmK ComplexType Li2omx2, spence external Li2omx2, spence if( DEBUGLEVEL .gt. 0 ) call CDump("C0softDR", para, perm) s = Px(2) m1 = Px(1) m2 = Px(3) m = sqrt(m1*m2) if( abs(m) .lt. zeroeps ) then if( abs(m1) .lt. zeroeps ) then m1 = m2 if( abs(m1) .lt. zeroeps ) then if( abs(s) .lt. zeroeps ) then print *, "C0softDR: all scales zero" res(0) = nan res(1) = nan res(2) = nan goto 9 endif * qltri1 if( DEBUGLEVEL .gt. 1 ) print *, "C0softDR: qltri1" lm = lnrat(mudim, -s) res(2) = 1/s res(1) = lm/s res(0) = .5D0*lm*res(1) goto 9 endif endif if( abs(s - m1) .lt. diffeps ) then * qltri5 if( DEBUGLEVEL .gt. 1 ) print *, "C0softDR: qltri5" f = -.5D0/m1 res(1) = f res(0) = f*(lnrat(mudim, m1) - 2) res(2) = 0 goto 9 endif * qltri4 if( DEBUGLEVEL .gt. 1 ) print *, "C0softDR: qltri4" ls = lnrat(m1, m1 - s) lm = lnrat(mudim, m1) f = .5D0/(s - m1) res(2) = f res(1) = f*(lm + 2*ls) res(0) = f*((ls + lm*(1 - 1/sqrt2))*(ls + lm*(1 + 1/sqrt2)) + & pi6 - 2*spence(0, ToComplex(s/(s - m1)), 0D0)) goto 9 endif * qltri6 if( DEBUGLEVEL .gt. 1 ) print *, "C0softDR: qltri6" dm = sqrt(m1) - sqrt(m2) r = s - dm**2 root = sqrt(ToComplex((r - 4*m)/r)) mK = -4*m/(r*(1 + root)**2) if( abs(mK - 1) .lt. diffeps ) then r = 0 if( abs(m1 - m2) .gt. diffeps ) & r = 2 + .5D0*(sqrt(m1) + sqrt(m2))/dm*log(m2/m1) f = .5D0/m res(1) = f res(0) = f*(log(mudim/m) - r) res(2) = 0 goto 9 endif lmK = ln(mK, 1) fac = 1/(r*root) res(0) = fac*( lmK*(.5D0*lmK + log(mudim/m)) - & .125D0*log(m1/m2)**2 + & Li2omx2(mK, 1D0, mK, 1D0) - & Li2omx2(mK, 1D0, ToComplex(sqrt(m1/m2)), 0D0) - & Li2omx2(mK, 1D0, ToComplex(sqrt(m2/m1)), 0D0) ) res(1) = fac*lmK res(2) = 0 9 if( DEBUGLEVEL .gt. 1 ) then print *, "C0softDR:0 =", res(0) print *, "C0softDR:1 =", res(1) print *, "C0softDR:2 =", res(2) endif end ************************************************************************ subroutine C0collDR(res, para, perm) implicit none ComplexType res(0:2) RealType para(1,*) integer perm #include "lt.h" RealType s1, s2, m RealType m1, m2, r ComplexType l1, l2, lm ComplexType Li2omrat external Li2omrat if( DEBUGLEVEL .gt. 0 ) call CDump("C0collDR", para, perm) m = Mx(3) s1 = Px(2) s2 = Px(3) if( abs(m) .lt. zeroeps ) then * qltri2 if( DEBUGLEVEL .gt. 1 ) print *, "C0collDR: qltri2" r = .5D0*(s2 - s1)/s1 if( abs(r) .lt. diffeps ) then res(0) = (lnrat(mudim, -s1)*(1 - r) - r)/s1 res(1) = (1 - r*mudim/s1)/s1 res(2) = 0 goto 9 endif l1 = lnrat(mudim, -s1) l2 = lnrat(mudim, -s2) res(1) = (l1 - l2)/(s1 - s2) res(0) = .5D0*(l1 + l2)*res(1) res(2) = 0 goto 9 endif * qltri3 if( DEBUGLEVEL .gt. 1 ) print *, "C0collDR: qltri3" m1 = m - s1 m2 = m - s2 l2 = lnrat(m2, m) lm = lnrat(mudim, m) r = .5D0*(s1 - s2)/m1 if( abs(r) .lt. diffeps ) then m = m/s1 res(0) = (lm - (m + 1)*(l2 + r) - & r*((m*(m - 2) - 1)*l2 + lm))/m1 res(1) = (1 - r)/m1 res(2) = 0 goto 9 endif l1 = lnrat(m1, m) res(0) = ((lm - l1 - l2)*(l2 - l1) + & Li2omrat(m1, m) - Li2omrat(m2, m))/(s1 - s2) res(1) = (l2 - l1)/(s1 - s2) res(2) = 0 9 if( DEBUGLEVEL .gt. 1 ) then print *, "C0collDR:0 =", res(0) print *, "C0collDR:1 =", res(1) print *, "C0collDR:2 =", res(2) endif end LoopTools-2.16/src/PaxHeaders/frontend0000644000000000000000000000013214217172001014776 xustar0030 mtime=1648161793.715764879 30 atime=1648161793.715764879 30 ctime=1648161793.715764879 LoopTools-2.16/src/frontend/0000755000000000000000000000000014217172001015773 5ustar00rootroot00000000000000LoopTools-2.16/src/frontend/PaxHeaders/lt.F0000644000000000000000000000013214044020632015601 xustar0030 mtime=1620058522.382316906 30 atime=1648161785.719698432 30 ctime=1648161793.715764879 LoopTools-2.16/src/frontend/lt.F0000644000000000000000000000477214044020632016533 0ustar00rootroot00000000000000* lt.F * the LoopTools command-line interface to Aget, Bget, Cget, Dget, Eget * this file is part of LoopTools * last modified 3 May 21 th #include "externals.h" #include "types.h" #include "defs.h" program LoopTools implicit none #include "lt.h" #if U77EXT integer iargc external iargc #endif integer argc character argv*100 ComplexType x(Pee) RealType re, im integer i, npoint, fail memindex b memindex AgetC, BgetC, CgetC, DgetC, EgetC integer getdebugkey external AgetC, BgetC, CgetC, DgetC, EgetC, getdebugkey integer npara(5), key(5) integer Kaa, Kbb, Kcc, Kdd, Kee parameter (Kaa = KeyA0) parameter (Kbb = KeyBget) parameter (Kcc = KeyC0) parameter (Kdd = KeyD0 + KeyD0C) parameter (Kee = KeyEget + KeyEgetC) data npara /Paa, Pbb, Pcc, Pdd, Pee/ data key /Kaa, Kbb, Kcc, Kdd, Kee/ argc = iargc() do npoint = 1, 5 if( argc .eq. npara(npoint) .or. & argc .eq. npara(npoint) + 1 ) goto 1 enddo 999 print *, "Usage: lt `parameters' [versionkey]" print *, "computes the n-point one-loop integrals" print *, "n depends on `parameters':" print *, " n = 1: m" print *, " n = 2: p m1 m2" print *, " n = 3: p1 p2 p1p2 m1 m2 m3" print *, " n = 4: p1 p2 p3 p4 p1p2 p2p3 m1 m2 m3 m4" print *, " n = 5: p1 p2 p3 p4 p5 p1p2 p2p3 p3p4 p4p5 p5p1"// & " m1 m2 m3 m4 m5" print *, "enter complex parameters as re,im (no space)" print *, "versionkey can be one of:" print *, " 0 = compute version a (same as no versionkey)" print *, " 1 = compute version b" print *, " 2 = compute a and b, compare, return a" print *, " 3 = compute a and b, compare, return b" call exit(1) 1 do i = 1, npara(npoint) call getarg(i, argv) re = 0 im = 0 read(argv, *, iostat=fail, err=999) re, im x(i) = re + cI*im enddo call ltini if( argc .eq. i ) then call getarg(i, argv) read(argv, *, iostat=fail, err=999) i if( i .lt. 0 .or. i .gt. 3 ) goto 999 print *, "using versionkey =", i versionkey = ishft(i, key(npoint)) endif call setdebugkey(ior(getdebugkey(), 2**(npoint - 1))) if( npoint .eq. 1 ) then b = AgetC(x(1)) else if( npoint .eq. 2 ) then b = BgetC(x(1), x(2), x(3)) else if( npoint .eq. 3 ) then b = CgetC(x(1), x(2), x(3), x(4), x(5), x(6)) else if( npoint .eq. 4 ) then b = DgetC(x(1), x(2), x(3), x(4), x(5), x(6), & x(7), x(8), x(9), x(10)) else b = EgetC(x(1), x(2), x(3), x(4), x(5), x(6), & x(7), x(8), x(9), x(10), & x(11), x(12), x(13), x(14), x(15)) endif call ltexi end LoopTools-2.16/src/frontend/PaxHeaders/LoopTools.tm0000644000000000000000000000013214217171732017361 xustar0030 mtime=1648161754.131435931 30 atime=1648161785.719698432 30 ctime=1648161793.715764879 LoopTools-2.16/src/frontend/LoopTools.tm0000644000000000000000000010616414217171732020311 0ustar00rootroot00000000000000:Evaluate: BeginPackage["LoopTools`"] :Evaluate: A0i::usage = "A0i[id, m] is the generic one-point loop integral. A0i[aa0, m] is the scalar function A_0, A0i[aa00, m] is the tensor coefficient A_00. m is the mass squared."; Aget::usage = "Aget[m] returns a list of all one-point coefficients." :Evaluate: B0i::usage = "B0i[id, p, m1, m2] is the generic two-point loop integral which includes both scalar and tensor coefficients, as well as certain derivatives. B0i[bb0, ...] is the scalar function B_0, B0i[bb11, ...] the tensor coefficient function B_11 etc. p is the external momentum squared and m1 and m2 are the masses squared."; Bget::usage = "Bget[p, m1, m2] returns a list of all two-point coefficients." :Evaluate: C0i::usage = "C0i[id, p1, p2, p1p2, m1, m2, m3] is the generic three-point loop integral which includes both scalar and tensor coefficients, specified by id. C0i[cc0, ...] is the scalar function C_0, C0i[cc112, ...] the tensor coefficient function C_112 etc. p1, p2, and p1p2 are the external momenta squared and m1, m2, m3 are the masses squared."; Cget::usage = "Cget[p1, p2, p1p2, m1, m2, m3] returns a list of all three-point coefficients." :Evaluate: D0i::usage = "D0i[id, p1, p2, p3, p4, p1p2, p2p3, m1, m2, m3, m4] is the generic four-point loop integral which includes both scalar and tensor coefficients, specified by id. D0i[dd0, ...] is the scalar function D_0, D0i[dd1233, ...] the tensor function D_{1233} etc. p1...p4 are the external momenta squared, p1p2 and p2p3 are the squares of external momenta 1 + 2 and 2 + 3, respectively, and m1...m4 are the masses squared."; Dget::usage = "Dget[p1, p2, p3, p4, p1p2, p2p3, m1, m2, m3, m4] returns a list of all four-point coefficients." :Evaluate: E0i::usage = "E0i[id, p1, p2, p3, p4, p5, p1p2, p2p3, p3p4, p4p5, p5p1, m1, m2, m3, m4, m5] is the generic five-point loop integral which includes both scalar and tensor coefficients, specified by id. E0i[ee0, ...] is the scalar function E_0, E0i[ee3444, ...] the tensor function E_{3444} etc. p1...p5 are the external momenta squared, pipj are the squares of (pi + pj), and m1...m5 are the masses squared."; Eget::usage = "Eget[p1, p2, p3, p4, p5, p1p2, p2p3, p3p4, p4p5, p5p1, m1, m2, m3, m4, m5] returns a list of all five-point coefficients." :Evaluate: PaVe::usage = "PaVe[ind, {pi}, {mi}] is the generalized Passarino-Veltman function used by FeynCalc. It is converted to A0i, B0i, C0i, D0i, or E0i in LoopTools." :Evaluate: Li2::usage = "Li2[x] returns the dilogarithm of x." :Evaluate: Li2omx::usage = "Li2omx[x] returns the dilogarithm of 1 - x." :Evaluate: SetMudim::usage = "SetMudim[m^2] sets the renormalization scale squared."; GetMudim::usage = "GetMudim[] returns the current value for the renormalization scale squared." :Evaluate: SetDelta::usage = "SetDelta[d] sets the numerical value of Delta which replaces the finite part of the divergence 2/(4 - D) - EulerGamma + Log[4 Pi] in LoopTools."; GetDelta::usage = "GetDelta[] returns the current numerical value of Delta which replaces the finite part of the divergence 2/(4 - D) - EulerGamma + Log[4 Pi] in LoopTools." :Evaluate: SetUVDiv::usage = "SetUVDiv[uvdiv] turns the UV part of the eps^-1 component off (uvdiv = 0) and on (uvdiv = 1)."; GetUVDiv::usage = "GetUVDiv[] returns whether the UV part of the eps^-1 component is currently off (0) or on (1)." :Evaluate: SetLambda::usage = "SetLambda[l^2] sets the infrared regulator mass squared."; GetLambda::usage = "GetLambda[] returns the current value for the infrared regulator mass squared."; GetEpsi::usage = "GetEpsi[] returns the integer governing selection of coefficients of 1/eps in the X0i functions." :Evaluate: SetMinMass::usage = "SetMinMass[m^2] sets the collinear cutoff mass squared."; GetMinMass::usage = "GetMinMass[] returns the current value for the collinear cutoff mass squared." :Evaluate: ClearCache::usage = "ClearCache[] clears the internal LoopTools caches."; MarkCache::usage = "MarkCache[] marks the current positions of the internal LoopTools caches."; RestoreCache::usage = "RestoreCache[] restores the internal LoopTools caches to the position when the last MarkCache was issued." :Evaluate: SetMaxDev::usage = "SetMaxDev[d] sets the maximum relative deviation a result and its alternate derivation may have before a warning is issued."; GetMaxDev::usage = "GetMaxDev[d] returns the maximum relative deviation a result and its alternate derivation may have before a warning is issued." :Evaluate: SetWarnDigits::usage = "SetWarnDigits[n] sets the number of LoopTools' warning digits. If the number of digits presumed lost by FF is larger than the warning digits, either an alternate version is tried (if available) or a warning is issued."; GetWarnDigits::usage = "GetWarnDigits[] returns the number of LoopTools' warning digits. If the number of digits presumed lost by FF is larger than the warning digits, either an alternate version is tried (if available) or a warning is issued." :Evaluate: SetErrDigits::usage = "SetErrDigits[n] sets the number of LoopTools' error digits. If the number of digits presumed lost by FF is larger than the error digits, the alternate result is used instead of the FF result."; GetErrDigits::usage = "GetErrDigits[] returns the number of LoopTools' error digits. If the number of digits presumed lost by FF is larger than the error digits, the alternate result is used instead of the FF result." :Evaluate: SetVersionKey::usage = "SetVersionKey[key] sets the LoopTools version key. It determines which version of a loop integral is returned, and whether checks are performed."; GetVersionKey::usage = "GetVersionKey[] returns the LoopTools version key. It determines which version of a loop integral is returned, and whether checks are performed." :Evaluate: SetDebugKey::usage = "SetDebugKey[key] sets the LoopTools debug key. It determines how much debug information is printed for a loop integral."; GetDebugKey::usage = "GetDebugKey[] returns the LoopTools debug key. It determines how much debug information is printed for a loop integral."; SetDebugRange::usage = "SetDebugRange[from, to] sets the LoopTools debug range. The integrals printed out on screen as determined by the debug key are numbered consecutively. Setting a debug range restricts printing to the given range." :Evaluate: SetCmpBits::usage = "SetCmpBits[bits] sets the number of bits compared in cache lookups. Setting it to less than 64 (double precision) makes the comparison more robust against numerical noise."; GetCmpBits::usage = "GetCmpBits[] returns the number of bits compared of each real number in cache lookups." :Evaluate: SetDiffEps::usage = "SetDiffEps[diffeps] sets the tolerance in comparing two numbers, i.e. a and b are considered equal if |a - b| < diffeps."; GetDiffEps::usage = "GetDiffEps[] returns the tolerance used for comparing two numbers."; SetZeroEps::usage = "SetZeroEps[zeroeps] sets the tolerance in determining that a number is zero, i.e. a is considered zero if |a| < zeroeps."; GetZeroEps::usage = "GetZeroEps[] returns the tolerance used in testing numbers for zero." :Evaluate: LTini::usage = "LTini[] (re-)initializes LoopTools."; LTexi::usage = "LTexi[] gives a summary of all errors and warnings since the last LTini[]."; LTnop::usage = "LTnop[] does nothing."; LTwrite::usage = "LTwrite[s] is the function LoopTools calls for printing s." :Evaluate: DRResult::usage = "DRResult[c0, c1, c2] arranges the coefficients of DR1eps into the final returned to the user."; DR1eps::usage = "DR1eps represents 1/eps where D = 4 - 2 eps." :Evaluate: LTids = Thread[# -> 3 Range[Length[#]] - 2]&/@ { {aa0, aa00}, {bb0, bb1, bb00, bb11, bb001, bb111, dbb0, dbb1, dbb00, dbb11, dbb001}, {cc0, cc1, cc2, cc00, cc11, cc12, cc22, cc001, cc002, cc111, cc112, cc122, cc222, cc0000, cc0011, cc0012, cc0022, cc1111, cc1112, cc1122, cc1222, cc2222}, {dd0, dd1, dd2, dd3, dd00, dd11, dd12, dd13, dd22, dd23, dd33, dd001, dd002, dd003, dd111, dd112, dd113, dd122, dd123, dd133, dd222, dd223, dd233, dd333, dd0000, dd0011, dd0012, dd0013, dd0022, dd0023, dd0033, dd1111, dd1112, dd1113, dd1122, dd1123, dd1133, dd1222, dd1223, dd1233, dd1333, dd2222, dd2223, dd2233, dd2333, dd3333, dd00001, dd00002, dd00003, dd00111, dd00112, dd00113, dd00122, dd00123, dd00133, dd00222, dd00223, dd00233, dd00333, dd11111, dd11112, dd11113, dd11122, dd11123, dd11133, dd11222, dd11223, dd11233, dd11333, dd12222, dd12223, dd12233, dd12333, dd13333, dd22222, dd22223, dd22233, dd22333, dd23333, dd33333}, {ee0, ee1, ee2, ee3, ee4, ee00, ee11, ee12, ee13, ee14, ee22, ee23, ee24, ee33, ee34, ee44, ee001, ee002, ee003, ee004, ee111, ee112, ee113, ee114, ee122, ee123, ee124, ee133, ee134, ee144, ee222, ee223, ee224, ee233, ee234, ee244, ee333, ee334, ee344, ee444, ee0000, ee0011, ee0012, ee0013, ee0014, ee0022, ee0023, ee0024, ee0033, ee0034, ee0044, ee1111, ee1112, ee1113, ee1114, ee1122, ee1123, ee1124, ee1133, ee1134, ee1144, ee1222, ee1223, ee1224, ee1233, ee1234, ee1244, ee1333, ee1334, ee1344, ee1444, ee2222, ee2223, ee2224, ee2233, ee2234, ee2244, ee2333, ee2334, ee2344, ee2444, ee3333, ee3334, ee3344, ee3444, ee4444} } :Evaluate: KeyAll = Plus@@ ({KeyA0, KeyBget, KeyC0, KeyD0, KeyE0, KeyEget, KeyCEget} = 4^Range[0, 6]); DebugAll = Plus@@ ({DebugA, DebugB, DebugC, DebugD, DebugE} = 2^Range[0, 4]) :Evaluate: A0 = A0i[aa0, ##]&; A00 = A0i[aa00, ##]&; B0 = B0i[bb0, ##]&; B1 = B0i[bb1, ##]&; B00 = B0i[bb00, ##]&; B11 = B0i[bb11, ##]&; B001 = B0i[bb001, ##]&; B111 = B0i[bb111, ##]&; DB0 = B0i[dbb0, ##]&; DB1 = B0i[dbb1, ##]&; DB00 = B0i[dbb00, ##]&; DB11 = B0i[dbb11, ##]&; DB001 = B0i[dbb001, ##]&; C0 = C0i[cc0, ##]&; D0 = D0i[dd0, ##]&; E0 = E0i[ee0, ##]& :Evaluate: If[!ValueQ[LTwrite], LTwrite = WriteString[$Output, #]&] :Evaluate: Begin["`Private`"] :Begin: :Function: mA0i :Pattern: A0i[id_, m_?r] :Arguments: {id /. LTids[[1]], N[m]} :ArgumentTypes: {Integer, Real} :ReturnType: Manual :End: :Begin: :Function: mA0ic :Pattern: A0i[id_, m_?c] :Arguments: {id /. LTids[[1]], N[Re[m]], N[Im[m]]} :ArgumentTypes: {Integer, Real, Real} :ReturnType: Manual :End: :Begin: :Function: mAget :Pattern: Aget[m_?r] :Arguments: {N[m]} :ArgumentTypes: {Real} :ReturnType: Manual :End: :Begin: :Function: mAgetc :Pattern: Aget[m_?c] :Arguments: {N[Re[m]], N[Im[m]]} :ArgumentTypes: {Real, Real} :ReturnType: Manual :End: :Begin: :Function: mB0i :Pattern: B0i[id_, p_?r, m1_?r, m2_?r] :Arguments: {id /. LTids[[2]], N[p], N[m1], N[m2]} :ArgumentTypes: {Integer, Real, Real, Real} :ReturnType: Manual :End: :Begin: :Function: mB0ic :Pattern: B0i[id_, p_?c, m1_?c, m2_?c] :Arguments: {id /. LTids[[2]], N[Re[p]], N[Im[p]], N[Re[m1]], N[Im[m1]], N[Re[m2]], N[Im[m2]]} :ArgumentTypes: {Integer, Real, Real, Real, Real, Real, Real} :ReturnType: Manual :End: :Begin: :Function: mBget :Pattern: Bget[p_?r, m1_?r, m2_?r] :Arguments: {N[p], N[m1], N[m2]} :ArgumentTypes: {Real, Real, Real} :ReturnType: Manual :End: :Begin: :Function: mBgetc :Pattern: Bget[p_?c, m1_?c, m2_?c] :Arguments: {N[Re[p]], N[Im[p]], N[Re[m1]], N[Im[m1]], N[Re[m2]], N[Im[m2]]} :ArgumentTypes: {Real, Real, Real, Real, Real, Real} :ReturnType: Manual :End: :Begin: :Function: mC0i :Pattern: C0i[id_, p1_?r, p2_?r, p1p2_?r, m1_?r, m2_?r, m3_?r] :Arguments: {id /. LTids[[3]], N[p1], N[p2], N[p1p2], N[m1], N[m2], N[m3]} :ArgumentTypes: {Integer, Real, Real, Real, Real, Real, Real} :ReturnType: Manual :End: :Begin: :Function: mC0ic :Pattern: C0i[id_, p1_?c, p2_?c, p1p2_?c, m1_?c, m2_?c, m3_?c] :Arguments: {id /. LTids[[3]], N[Re[p1]], N[Im[p1]], N[Re[p2]], N[Im[p2]], N[Re[p1p2]], N[Im[p1p2]], N[Re[m1]], N[Im[m1]], N[Re[m2]], N[Im[m2]], N[Re[m3]], N[Im[m3]]} :ArgumentTypes: {Integer, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real} :ReturnType: Manual :End: :Begin: :Function: mCget :Pattern: Cget[p1_?r, p2_?r, p1p2_?r, m1_?r, m2_?r, m3_?r] :Arguments: {N[p1], N[p2], N[p1p2], N[m1], N[m2], N[m3]} :ArgumentTypes: {Real, Real, Real, Real, Real, Real} :ReturnType: Manual :End: :Begin: :Function: mCgetc :Pattern: Cget[p1_?c, p2_?c, p1p2_?c, m1_?c, m2_?c, m3_?c] :Arguments: {N[Re[p1]], N[Im[p1]], N[Re[p2]], N[Im[p2]], N[Re[p1p2]], N[Im[p1p2]], N[Re[m1]], N[Im[m1]], N[Re[m2]], N[Im[m2]], N[Re[m3]], N[Im[m3]]} :ArgumentTypes: {Real, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real} :ReturnType: Manual :End: :Begin: :Function: mD0i :Pattern: D0i[id_, p1_?r, p2_?r, p3_?r, p4_?r, p1p2_?r, p2p3_?r, m1_?r, m2_?r, m3_?r, m4_?r] :Arguments: {id /. LTids[[4]], N[p1], N[p2], N[p3], N[p4], N[p1p2], N[p2p3], N[m1], N[m2], N[m3], N[m4]} :ArgumentTypes: {Integer, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real} :ReturnType: Manual :End: :Begin: :Function: mD0ic :Pattern: D0i[id_, p1_?c, p2_?c, p3_?c, p4_?c, p1p2_?c, p2p3_?c, m1_?c, m2_?c, m3_?c, m4_?c] :Arguments: {id /. LTids[[4]], N[Re[p1]], N[Im[p1]], N[Re[p2]], N[Im[p2]], N[Re[p3]], N[Im[p3]], N[Re[p4]], N[Im[p4]], N[Re[p1p2]], N[Im[p1p2]], N[Re[p2p3]], N[Im[p2p3]], N[Re[m1]], N[Im[m1]], N[Re[m2]], N[Im[m2]], N[Re[m3]], N[Im[m3]], N[Re[m4]], N[Im[m4]]} :ArgumentTypes: {Integer, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real} :ReturnType: Manual :End: :Begin: :Function: mDget :Pattern: Dget[p1_?r, p2_?r, p3_?r, p4_?r, p1p2_?r, p2p3_?r, m1_?r, m2_?r, m3_?r, m4_?r] :Arguments: {N[p1], N[p2], N[p3], N[p4], N[p1p2], N[p2p3], N[m1], N[m2], N[m3], N[m4]} :ArgumentTypes: {Real, Real, Real, Real, Real, Real, Real, Real, Real, Real} :ReturnType: Manual :End: :Begin: :Function: mDgetc :Pattern: Dget[p1_?c, p2_?c, p3_?c, p4_?c, p1p2_?c, p2p3_?c, m1_?c, m2_?c, m3_?c, m4_?c] :Arguments: {N[Re[p1]], N[Im[p1]], N[Re[p2]], N[Im[p2]], N[Re[p3]], N[Im[p3]], N[Re[p4]], N[Im[p4]], N[Re[p1p2]], N[Im[p1p2]], N[Re[p2p3]], N[Im[p2p3]], N[Re[m1]], N[Im[m1]], N[Re[m2]], N[Im[m2]], N[Re[m3]], N[Im[m3]], N[Re[m4]], N[Im[m4]]} :ArgumentTypes: {Real, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real} :ReturnType: Manual :End: :Begin: :Function: mE0i :Pattern: E0i[id_, p1_?r, p2_?r, p3_?r, p4_?r, p5_?r, p1p2_?r, p2p3_?r, p3p4_?r, p4p5_?r, p5p1_?r, m1_?r, m2_?r, m3_?r, m4_?r, m5_?r] :Arguments: {id /. LTids[[5]], N[p1], N[p2], N[p3], N[p4], N[p5], N[p1p2], N[p2p3], N[p3p4], N[p4p5], N[p5p1], N[m1], N[m2], N[m3], N[m4], N[m5]} :ArgumentTypes: {Integer, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real} :ReturnType: Manual :End: :Begin: :Function: mE0ic :Pattern: E0i[id_, p1_?c, p2_?c, p3_?c, p4_?c, p5_?c, p1p2_?c, p2p3_?c, p3p4_?c, p4p5_?c, p5p1_?c, m1_?c, m2_?c, m3_?c, m4_?c, m5_?c] :Arguments: {id /. LTids[[5]], N[Re[p1]], N[Im[p1]], N[Re[p2]], N[Im[p2]], N[Re[p3]], N[Im[p3]], N[Re[p4]], N[Im[p4]], N[Re[p5]], N[Im[p5]], N[Re[p1p2]], N[Im[p1p2]], N[Re[p2p3]], N[Im[p2p3]], N[Re[p3p4]], N[Im[p3p4]], N[Re[p4p5]], N[Im[p4p5]], N[Re[p5p1]], N[Im[p5p1]], N[Re[m1]], N[Im[m1]], N[Re[m2]], N[Im[m2]], N[Re[m3]], N[Im[m3]], N[Re[m4]], N[Im[m4]], N[Re[m5]], N[Im[m5]]} :ArgumentTypes: {Integer, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real} :ReturnType: Manual :End: :Begin: :Function: mEget :Pattern: Eget[p1_?r, p2_?r, p3_?r, p4_?r, p5_?r, p1p2_?r, p2p3_?r, p3p4_?r, p4p5_?r, p5p1_?r, m1_?r, m2_?r, m3_?r, m4_?r, m5_?r] :Arguments: {N[p1], N[p2], N[p3], N[p4], N[p5], N[p1p2], N[p2p3], N[p3p4], N[p4p5], N[p5p1], N[m1], N[m2], N[m3], N[m4], N[m5]} :ArgumentTypes: {Real, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real} :ReturnType: Manual :End: :Begin: :Function: mEgetc :Pattern: Eget[p1_?c, p2_?c, p3_?c, p4_?c, p5_?c, p1p2_?c, p2p3_?c, p3p4_?c, p4p5_?c, p5p1_?c, m1_?c, m2_?c, m3_?c, m4_?c, m5_?c] :Arguments: {N[Re[p1]], N[Im[p1]], N[Re[p2]], N[Im[p2]], N[Re[p3]], N[Im[p3]], N[Re[p4]], N[Im[p4]], N[Re[p5]], N[Im[p5]], N[Re[p1p2]], N[Im[p1p2]], N[Re[p2p3]], N[Im[p2p3]], N[Re[p3p4]], N[Im[p3p4]], N[Re[p4p5]], N[Im[p4p5]], N[Re[p5p1]], N[Im[p5p1]], N[Re[m1]], N[Im[m1]], N[Re[m2]], N[Im[m2]], N[Re[m3]], N[Im[m3]], N[Re[m4]], N[Im[m4]], N[Re[m5]], N[Im[m5]]} :ArgumentTypes: {Real, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real, Real} :ReturnType: Manual :End: :Begin: :Function: mLi2 :Pattern: Li2[x_?r] :Arguments: {N[x]} :ArgumentTypes: {Real} :ReturnType: Manual :End: :Begin: :Function: mLi2c :Pattern: Li2[x_?c] :Arguments: {N[Re[x]], N[Im[x]]} :ArgumentTypes: {Real, Real} :ReturnType: Manual :End: :Begin: :Function: mLi2omx :Pattern: Li2omx[x_?r] :Arguments: {N[x]} :ArgumentTypes: {Real} :ReturnType: Manual :End: :Begin: :Function: mLi2omxc :Pattern: Li2omx[x_?c] :Arguments: {N[Re[x]], N[Im[x]]} :ArgumentTypes: {Real, Real} :ReturnType: Manual :End: :Begin: :Function: msetmudim :Pattern: SetMudim[mudim_?r] :Arguments: {N[mudim]} :ArgumentTypes: {Real} :ReturnType: Manual :End: :Begin: :Function: mgetmudim :Pattern: GetMudim[] :Arguments: {} :ArgumentTypes: {} :ReturnType: Manual :End: :Begin: :Function: msetdelta :Pattern: SetDelta[delta_?r] :Arguments: {N[delta]} :ArgumentTypes: {Real} :ReturnType: Manual :End: :Begin: :Function: mgetdelta :Pattern: GetDelta[] :Arguments: {} :ArgumentTypes: {} :ReturnType: Manual :End: :Begin: :Function: msetuvdiv :Pattern: SetUVDiv[uvdiv_?r] :Arguments: {N[uvdiv]} :ArgumentTypes: {Real} :ReturnType: Manual :End: :Begin: :Function: mgetuvdiv :Pattern: GetUVDiv[] :Arguments: {} :ArgumentTypes: {} :ReturnType: Manual :End: :Begin: :Function: msetlambda :Pattern: SetLambda[lambda_?r] :Arguments: {N[lambda]} :ArgumentTypes: {Real} :ReturnType: Manual :End: :Begin: :Function: mgetlambda :Pattern: GetLambda[] :Arguments: {} :ArgumentTypes: {} :ReturnType: Manual :End: :Begin: :Function: mgetepsi :Pattern: GetEpsi[] :Arguments: {} :ArgumentTypes: {} :ReturnType: Manual :End: :Begin: :Function: msetminmass :Pattern: SetMinMass[minmass_?r] :Arguments: {N[minmass]} :ArgumentTypes: {Real} :ReturnType: Manual :End: :Begin: :Function: mgetminmass :Pattern: GetMinMass[] :Arguments: {} :ArgumentTypes: {} :ReturnType: Manual :End: :Begin: :Function: mclearcache :Pattern: ClearCache[] :Arguments: {} :ArgumentTypes: {} :ReturnType: Manual :End: :Begin: :Function: mmarkcache :Pattern: MarkCache[] :Arguments: {} :ArgumentTypes: {} :ReturnType: Manual :End: :Begin: :Function: mrestorecache :Pattern: RestoreCache[] :Arguments: {} :ArgumentTypes: {} :ReturnType: Manual :End: :Begin: :Function: msetmaxdev :Pattern: SetMaxDev[maxdev_?r] :Arguments: {N[maxdev]} :ArgumentTypes: {Real} :ReturnType: Manual :End: :Begin: :Function: mgetmaxdev :Pattern: GetMaxDev[] :Arguments: {} :ArgumentTypes: {} :ReturnType: Manual :End: :Begin: :Function: msetwarndigits :Pattern: SetWarnDigits[warndigits_Integer] :Arguments: {warndigits} :ArgumentTypes: {Integer} :ReturnType: Manual :End: :Begin: :Function: mgetwarndigits :Pattern: GetWarnDigits[] :Arguments: {} :ArgumentTypes: {} :ReturnType: Manual :End: :Begin: :Function: mseterrdigits :Pattern: SetErrDigits[errdigits_Integer] :Arguments: {errdigits} :ArgumentTypes: {Integer} :ReturnType: Manual :End: :Begin: :Function: mgeterrdigits :Pattern: GetErrDigits[] :Arguments: {} :ArgumentTypes: {} :ReturnType: Manual :End: :Begin: :Function: msetversionkey :Pattern: SetVersionKey[versionkey_Integer] :Arguments: {versionkey} :ArgumentTypes: {Integer} :ReturnType: Manual :End: :Begin: :Function: mgetversionkey :Pattern: GetVersionKey[] :Arguments: {} :ArgumentTypes: {} :ReturnType: Manual :End: :Begin: :Function: msetdebugkey :Pattern: SetDebugKey[debugkey_Integer] :Arguments: {debugkey} :ArgumentTypes: {Integer} :ReturnType: Manual :End: :Begin: :Function: mgetdebugkey :Pattern: GetDebugKey[] :Arguments: {} :ArgumentTypes: {} :ReturnType: Manual :End: :Begin: :Function: msetdebugrange :Pattern: SetDebugRange[debugfrom_Integer, debugto_Integer] :Arguments: {debugfrom, debugto} :ArgumentTypes: {Integer, Integer} :ReturnType: Manual :End: :Begin: :Function: msetcmpbits :Pattern: SetCmpBits[cmpbits_Integer] :Arguments: {cmpbits} :ArgumentTypes: {Integer} :ReturnType: Manual :End: :Begin: :Function: mgetcmpbits :Pattern: GetCmpBits[] :Arguments: {} :ArgumentTypes: {} :ReturnType: Manual :End: :Begin: :Function: msetdiffeps :Pattern: SetDiffEps[diffeps] :Arguments: {diffeps} :ArgumentTypes: {Real} :ReturnType: Manual :End: :Begin: :Function: mgetdiffeps :Pattern: GetDiffEps[] :Arguments: {} :ArgumentTypes: {} :ReturnType: Manual :End: :Begin: :Function: msetzeroeps :Pattern: SetZeroEps[zeroeps] :Arguments: {zeroeps} :ArgumentTypes: {Real} :ReturnType: Manual :End: :Begin: :Function: mgetzeroeps :Pattern: GetZeroEps[] :Arguments: {} :ArgumentTypes: {} :ReturnType: Manual :End: :Begin: :Function: mltini :Pattern: LTini[] :Arguments: {} :ArgumentTypes: {} :ReturnType: Manual :End: :Begin: :Function: mltexi :Pattern: LTexi[] :Arguments: {} :ArgumentTypes: {} :ReturnType: Manual :End: :Begin: :Function: mltnop :Pattern: LTnop[] :Arguments: {} :ArgumentTypes: {} :ReturnType: Manual :End: :Evaluate: r = Head[# + 1.] === Real & :Evaluate: c = Head[# + 1. I] === Complex & :Evaluate: A0i[_, 0] = 0 :Evaluate: MapThread[ (Derivative[0,1,0,0][B0i][#1, args__] := B0i[#2, args])&, {{bb0, bb1, bb00, bb11, bb001}, {dbb0, dbb1, dbb00, dbb11, dbb001}} ] :Evaluate: PaVe[i__Integer, {p___}, {m__}] := ToExpression[#1 <> "0i"][ ToExpression[#2 <> #2 <> ToString/@ Sort[{i}]], p, m ]&[ FromCharacterCode[Length[{m}] + 64], FromCharacterCode[Length[{m}] + 96] ] :Evaluate: DRResult[c0_, c1_, c2_] := c0 + c1 DR1eps + c2 DR1eps^2; idlist[n_, x_] := MapThread[#1[[1]] -> #2 &, {LTids[[n]], DRResult@@@ Partition[ Complex@@@ Partition[Chop[x, 10^-14], 2], 3]}] :Evaluate: ltdef1[off_][id_, n_] := {"#define ", ToString[id], " ", ToString[n + off], "\n"}; ltdef2[off_][id_, n_] := {##, #1, ToUpperCase[#2], #3, #4, ":", ToString[n + off + 2], #5}&@@ ltdef1[off][id, n]; ltdefs[off_, h_] := StringJoin@@ MapThread[{ h[off]@@@ #, "#define ", #2, " ", ToString[3 Length[#]], "\n\n" }&, {LTids, {"Naa", "Nbb", "Ncc", "Ndd", "Nee"}}]; ltwritedefs[] := { WriteString["for_looptools.h", ltdefs[0, ltdef1]]; WriteString["for_clooptools.h.in", ltdefs[-1, ltdef1]]; WriteString["for_defs.h", ltdefs[0, ltdef2]] } :Evaluate: End[] :Evaluate: EndPackage[] :Evaluate: ($Post := (LTnop[]; OwnValues[$Post] = #; $Post /. $Post -> Identity))& @ OwnValues[$Post]; ($Epilog := (LTexi[]; OwnValues[$Epilog] = #; $Epilog))& @ OwnValues[$Epilog]; /* LoopTools.tm provides the LoopTools functions in Mathematica this file is part of LoopTools last modified 24 Mar 22 th */ #include #include #include #include #include #include #include #include #include #include #include #include #include "mathlink.h" #ifndef MLCONST #define MLCONST #endif #define CQUADSIZE 10 #include "clooptools.h" typedef unsigned char byte; typedef MLCONST char cchar; typedef const int cint; typedef const long clong; #if QUAD #define MLPutREAL MLPutReal128 static inline void MLPutREALList(MLINK mlp, CREAL *s, long n) { RealType d[n]; int i; for( i = 0; i < n; ++i ) d[i] = ToReal(s[i]); MLPutReal128List(mlp, d, n); } #else #define MLPutREAL MLPutReal #define MLPutREALList MLPutRealList #endif static int stdoutorig = 1, stdoutpipe[2] = {2, 2}, stdoutthr = 0; static byte *stdoutbuf = NULL; //#define DEBUG #ifdef DEBUG static FILE *deb; #define DEB(...) fprintf(deb, __VA_ARGS__) #else #define DEB(...) #endif static inline void mlPutFunction(MLINK mlp, cchar *fun, cint args) { MLPutFunction(mlp, fun, args); DEB("MLPutFunction(\"%s\", %d)\n", fun, args); } static inline void mlPutSymbol(MLINK mlp, cchar *sym) { MLPutSymbol(mlp, sym); DEB("MLPutSymbol(\"%s\")\n", sym); } static inline void mlPutReal(MLINK mlp, cRealType r) { MLPutReal(mlp, r); DEB("MLPutReal(%lg)\n", r); } static inline void mlPutInteger(MLINK mlp, cint i) { MLPutInteger(mlp, i); DEB("MLPutInteger(%d)\n", i); } static inline void mlPutByteString(MLINK mlp, byte *s, size_t len) { MLPutByteString(mlp, s, len); DEB("MLPutByteString(\"%*s\", %lu)\n", (int)len, s, len); } static inline void mlEndPacket(MLINK mlp) { MLEndPacket(mlp); DEB("MLEndPacket\n"); } static inline void mlNewPacket(MLINK mlp) { MLNewPacket(mlp); DEB("MLNewPacket\n"); } static inline void mlNextPacket(MLINK mlp) { MLNextPacket(mlp); DEB("MLNextPacket\n"); } /******************************************************************/ #define CaptureStdout() \ DEB("%s\n", __FUNCTION__); \ dup2(stdoutpipe[1], 1) #define ReleaseStdout() \ dup2(stdoutorig, 1) static inline void mlPutStdout(MLINK mlp) { long len; extern void FORTRAN(fortranflush)(); FORTRAN(fortranflush)(); fflush(stdout); if( stdoutthr ) { write(1, "", 1); read(1, &len, sizeof len); if( len > 1 ) { DEB("MLPutStdout <<\n"); mlPutFunction(mlp, "EvaluatePacket", 1); mlPutFunction(mlp, "LoopTools`LTwrite", 1); mlPutByteString(mlp, stdoutbuf, len - 1); mlNextPacket(stdlink); mlNewPacket(stdlink); DEB(">>\n"); } } ReleaseStdout(); } /******************************************************************/ static void *capturestdout(void *pfd) { cint fd = ((int *)pfd)[0]; long size = 0, len = 0, n; enum { unit = 10240 }; do { if( size - len < 128 ) stdoutbuf = realloc(stdoutbuf, size += unit); len += n = read(fd, stdoutbuf + len, size - len); if( len > 0 && stdoutbuf[len-1] == 0 ) { write(fd, &len, sizeof len); len = 0; } } while( n > 0 ); return NULL; } /******************************************************************/ #define SetReal(fun,val) \ CaptureStdout(); \ fun(val); \ mlPutStdout(stdlink); \ mlPutReal(stdlink, val); \ mlEndPacket(stdlink) #define GetReal(fun) \ mlPutReal(stdlink, fun()); \ mlEndPacket(stdlink) #define SetInteger(fun,val) \ CaptureStdout(); \ fun(val); \ mlPutStdout(stdlink); \ mlPutInteger(stdlink, val); \ mlEndPacket(stdlink) #define GetInteger(fun) \ mlPutInteger(stdlink, fun()); \ mlEndPacket(stdlink) /******************************************************************/ #define ReturnComplex(expr) \ ComplexType result; \ CaptureStdout(); \ result = expr; \ mlPutStdout(stdlink); \ mlPutComplex(stdlink, result); \ mlEndPacket(stdlink) #define ReturnList(i, expr, n) \ COMPLEX *list; \ CaptureStdout(); \ list = expr; \ mlPutStdout(stdlink); \ mlPutList(stdlink, i, list, n); \ mlEndPacket(stdlink) #define ReturnVoid() \ mlPutSymbol(stdlink, "Null"); \ mlEndPacket(stdlink) #define _Id_(v) v #define _Mr_(v) cRealType v #define _Mri_(v) cRealType re_##v, cRealType im_##v #define _Mc_(v) ToComplex2(re_##v, im_##v) /******************************************************************/ static inline void mlPutComplex(MLINK mlp, cComplexType c) { DEB("MLPutComplex(%lg,%lg)\n", Re(c), Im(c)); if( Im(c) == 0 ) MLPutREAL(mlp, Re(c)); else { MLPutFunction(mlp, "Complex", 2); MLPutREAL(mlp, Re(c)); MLPutREAL(mlp, Im(c)); } } /******************************************************************/ static inline void mlPutList(MLINK mlp, cint i, COMPLEX *list, cint n) { DEB("MLPutList(%d, %d)\n", i, n); MLPutFunction(mlp, "LoopTools`Private`idlist", 2); MLPutInteger(mlp, i); MLPutREALList(mlp, (REAL *)list, 2*n); } /******************************************************************/ static void mA0i(cint i, AARGS(_Mr_)) { ReturnComplex(A0i(i-1, AARGS(_Id_))); } static void mA0ic(cint i, AARGS(_Mri_)) { ReturnComplex(A0iC(i-1, AARGS(_Mc_))); } /******************************************************************/ static void mAget(AARGS(_Mr_)) { ReturnList(1, Acache(Aget(AARGS(_Id_))), Naa); } static void mAgetc(AARGS(_Mri_)) { ReturnList(1, AcacheC(AgetC(AARGS(_Mc_))), Naa); } /******************************************************************/ static void mB0i(cint i, BARGS(_Mr_)) { ReturnComplex(B0i(i-1, BARGS(_Id_))); } static void mB0ic(cint i, BARGS(_Mri_)) { ReturnComplex(B0iC(i-1, BARGS(_Mc_))); } /******************************************************************/ static void mBget(BARGS(_Mr_)) { ReturnList(2, Bcache(Bget(BARGS(_Id_))), Nbb); } static void mBgetc(BARGS(_Mri_)) { ReturnList(2, BcacheC(BgetC(BARGS(_Mc_))), Nbb); } /******************************************************************/ static void mC0i(cint i, CARGS(_Mr_)) { ReturnComplex(C0i(i-1, CARGS(_Id_))); } static void mC0ic(cint i, CARGS(_Mri_)) { ReturnComplex(C0iC(i-1, CARGS(_Mc_))); } /******************************************************************/ static void mCget(CARGS(_Mr_)) { ReturnList(3, Ccache(Cget(CARGS(_Id_))), Ncc); } static void mCgetc(CARGS(_Mri_)) { ReturnList(3, CcacheC(CgetC(CARGS(_Mc_))), Ncc); } /******************************************************************/ static void mD0i(cint i, DARGS(_Mr_)) { ReturnComplex(D0i(i-1, DARGS(_Id_))); } static void mD0ic(cint i, DARGS(_Mri_)) { ReturnComplex(D0iC(i-1, DARGS(_Mc_))); } /******************************************************************/ static void mDget(DARGS(_Mr_)) { ReturnList(4, Dcache(Dget(DARGS(_Id_))), Ndd); } static void mDgetc(DARGS(_Mri_)) { ReturnList(4, DcacheC(DgetC(DARGS(_Mc_))), Ndd); } /******************************************************************/ static void mE0i(cint i, EARGS(_Mr_)) { ReturnComplex(E0i(i-1, EARGS(_Id_))); } static void mE0ic(cint i, EARGS(_Mri_)) { ReturnComplex(E0iC(i-1, EARGS(_Mc_))); } /******************************************************************/ static void mEget(EARGS(_Mr_)) { ReturnList(5, Ecache(Eget(EARGS(_Id_))), Nee); } static void mEgetc(EARGS(_Mri_)) { ReturnList(5, EcacheC(EgetC(EARGS(_Mc_))), Nee); } /******************************************************************/ static void mLi2(XARGS(_Mr_)) { ReturnComplex(Li2(XARGS(_Id_))); } static void mLi2c(XARGS(_Mri_)) { ReturnComplex(Li2C(XARGS(_Mc_))); } static void mLi2omx(XARGS(_Mr_)) { ReturnComplex(Li2omx(XARGS(_Id_))); } static void mLi2omxc(XARGS(_Mri_)) { ReturnComplex(Li2omxC(XARGS(_Mc_))); } /******************************************************************/ static void mclearcache(void) { clearcache(); ReturnVoid(); } static void mmarkcache(void) { markcache(); ReturnVoid(); } static void mrestorecache(void) { restorecache(); ReturnVoid(); } /******************************************************************/ static void msetmudim(cRealType mudim) { SetReal(setmudim, mudim); } static void mgetmudim(void) { GetReal(getmudim); } /******************************************************************/ static void msetdelta(cRealType delta) { SetReal(setdelta, delta); } static void mgetdelta(void) { GetReal(getdelta); } /******************************************************************/ static void msetuvdiv(cRealType uvdiv) { SetReal(setuvdiv, uvdiv); } static void mgetuvdiv(void) { GetReal(getuvdiv); } /******************************************************************/ static void msetlambda(cRealType lambda) { SetReal(setlambda, lambda); } static void mgetlambda(void) { GetReal(getlambda); } static void mgetepsi(void) { GetInteger(getepsi); } /******************************************************************/ static void msetminmass(cRealType minmass) { SetReal(setminmass, minmass); } static void mgetminmass(void) { GetReal(getminmass); } /******************************************************************/ static void msetmaxdev(cRealType maxdev) { SetReal(setmaxdev, maxdev); } static void mgetmaxdev(void) { GetReal(getmaxdev); } /******************************************************************/ static void msetwarndigits(cint warndigits) { SetInteger(setwarndigits, warndigits); } static void mgetwarndigits(void) { GetInteger(getwarndigits); } /******************************************************************/ static void mseterrdigits(cint errdigits) { SetInteger(seterrdigits, errdigits); } static void mgeterrdigits(void) { GetInteger(geterrdigits); } /******************************************************************/ static void msetversionkey(cint versionkey) { SetInteger(setversionkey, versionkey); } static void mgetversionkey(void) { GetInteger(getversionkey); } /******************************************************************/ static void msetdebugkey(cint debugkey) { SetInteger(setdebugkey, debugkey); } static void mgetdebugkey(void) { GetInteger(getdebugkey); } /******************************************************************/ static void msetdebugrange(cint debugfrom, cint debugto) { setdebugrange(debugfrom, debugto); mlPutFunction(stdlink, "List", 2); mlPutInteger(stdlink, debugfrom); mlPutInteger(stdlink, debugto); mlEndPacket(stdlink); } /******************************************************************/ static void msetcmpbits(cint cmpbits) { SetInteger(setcmpbits, cmpbits); } static void mgetcmpbits(void) { GetInteger(getcmpbits); } /******************************************************************/ static void msetdiffeps(cRealType diffeps) { SetReal(setdiffeps, diffeps); } static void mgetdiffeps(void) { GetReal(getdiffeps); } /******************************************************************/ static void msetzeroeps(cRealType zeroeps) { SetReal(setzeroeps, zeroeps); } static void mgetzeroeps(void) { GetReal(getzeroeps); } /******************************************************************/ static void mltini(void) { CaptureStdout(); ltini(); mlPutStdout(stdlink); ReturnVoid(); } static void mltexi(void) { CaptureStdout(); ltexi(); mlPutStdout(stdlink); ReturnVoid(); } static void mltnop(void) { CaptureStdout(); mlPutStdout(stdlink); ReturnVoid(); } /******************************************************************/ static inline void openstdout() { int fd = open("/dev/null", O_WRONLY); dup2(fd, 1); close(fd); } static void __attribute__((constructor(4711))) make_sure_stdout_is_open() { if( fcntl(1, F_GETFD) == -1 ) openstdout(); } /******************************************************************/ int main(int argc, char **argv) { int mlerr; pthread_t stdouttid; void *thr_ret; #ifdef DEBUG deb = fopen("/tmp/ltdebug.out", "w"); setbuf(deb, NULL); #endif stdoutorig = dup(1); if( stdoutorig == -1 && getenv("LTRESPAWN") == NULL ) { openstdout(); putenv("LTRESPAWN=1"); execv(argv[0], argv); exit(1); } if( getenv("LTFORCESTDERR") == NULL ) stdoutthr = socketpair(AF_LOCAL, SOCK_STREAM, 0, stdoutpipe) != -1 && pthread_create(&stdouttid, NULL, capturestdout, stdoutpipe) == 0; CaptureStdout(); ltini(); ReleaseStdout(); DEB("begin MLMain\n"); mlerr = MLMain(argc, argv); DEB("end MLMain\n"); if( stdoutthr ) { close(stdoutpipe[1]); pthread_join(stdouttid, &thr_ret); } return mlerr; } LoopTools-2.16/src/frontend/PaxHeaders/fortranflush.F0000644000000000000000000000007413262070066017713 xustar0030 atime=1648161785.719698432 30 ctime=1648161793.715764879 LoopTools-2.16/src/frontend/fortranflush.F0000644000000000000000000000023413262070066020625 0ustar00rootroot00000000000000* fortranflush.F * flush Fortran stdout from C * this file is part of LoopTools * last modified 7 Apr 18 th subroutine fortranflush call flush(6) end LoopTools-2.16/src/PaxHeaders/E0000644000000000000000000000013214217172001013343 xustar0030 mtime=1648161793.715764879 30 atime=1648161793.715764879 30 ctime=1648161793.715764879 LoopTools-2.16/src/E/0000755000000000000000000000000014217172001014340 5ustar00rootroot00000000000000LoopTools-2.16/src/E/PaxHeaders/Ecoeffa.F0000644000000000000000000000007413262607705015101 xustar0030 atime=1648161785.719698432 30 ctime=1648161793.715764879 LoopTools-2.16/src/E/Ecoeffa.F0000644000000000000000000016311613262607705016024 0ustar00rootroot00000000000000* Ecoeffa.F * the five-point tensor coefficients * this file is part of LoopTools * written by M. Rauch * last modified 9 Apr 18 th #include "externals.h" #include "types.h" #define npoint 5 #include "defs.h" subroutine XEcoeffa(E, para, D2345, D1345, D1245, D1235, D1234) implicit none ComplexType E(*) ComplexType D2345(*), D1345(*), D1245(*), D1235(*), D1234(*) ArgType para(1,*) #include "lt.h" ArgType p1, p2, p3, p4, p5 ArgType p1p2, p2p3, p3p4, p4p5, p5p1 ArgType m1, m2, m3, m4, m5 ArgQuad Y(5,5), Yi(5,5), Z(4,4), Zij(3,3) ArgQuad eta(5), zeta(4,4), detY, detZ RealType del, del4 integer i, j, k, l, finite logical dump ComplexQuad help1(0:2), help2(0:2), help3(0:2), help4(0:2) ComplexQuad dabbr41(0:2), dabbr48(0:2), dabbr65(0:2) ComplexQuad dabbr60(0:2), dabbr55(0:2), dabbr50(0:2) ComplexQuad dabbr49(0:2), dabbr45(0:2), dabbr42(0:2) ComplexQuad dabbr10(0:2), dabbr84(0:2), dabbr91(0:2) ComplexQuad dabbr81(0:2), dabbr52(0:2), dabbr88(0:2) ComplexQuad dabbr77(0:2), dabbr90(0:2), dabbr46(0:2) ComplexQuad dabbr87(0:2), dabbr74(0:2), dabbr80(0:2) ComplexQuad dabbr71(0:2), dabbr83(0:2), dabbr76(0:2) ComplexQuad dabbr79(0:2), dabbr43(0:2), dabbr70(0:2) ComplexQuad dabbr73(0:2), dabbr35(0:2), dabbr37(0:2) ComplexQuad dabbr39(0:2), dabbr27(0:2), dabbr31(0:2) ComplexQuad dabbr24(0:2), dabbr20(0:2), dabbr16(0:2) ComplexQuad dabbr30(0:2), dabbr13(0:2), dabbr23(0:2) ComplexQuad dabbr26(0:2), dabbr5(0:2), dabbr7(0:2) ComplexQuad dabbr9(0:2), dabbr33(0:2), dabbr92(0:2) ComplexQuad dabbr89(0:2), dabbr86(0:2), dabbr85(0:2) ComplexQuad dabbr82(0:2), dabbr78(0:2), dabbr75(0:2) ComplexQuad dabbr72(0:2), dabbr69(0:2), dabbr68(0:2) ComplexQuad dabbr38(0:2), dabbr36(0:2), dabbr34(0:2) ComplexQuad dabbr32(0:2), dabbr29(0:2), dabbr28(0:2) ComplexQuad dabbr25(0:2), dabbr22(0:2), dabbr21(0:2) ComplexQuad dabbr3(0:2), dabbr8(0:2), dabbr6(0:2) ComplexQuad dabbr4(0:2), dabbr1(0:2), dabbr61(0:2) ComplexQuad dabbr66(0:2), dabbr57(0:2), dabbr47(0:2) ComplexQuad dabbr51(0:2), dabbr64(0:2), dabbr44(0:2) ComplexQuad dabbr56(0:2), dabbr59(0:2), dabbr14(0:2) ComplexQuad dabbr17(0:2), dabbr19(0:2), dabbr67(0:2) ComplexQuad dabbr63(0:2), dabbr62(0:2), dabbr58(0:2) ComplexQuad dabbr54(0:2), dabbr53(0:2), dabbr11(0:2) ComplexQuad dabbr18(0:2), dabbr15(0:2), dabbr12(0:2) ComplexQuad dabbr2(0:2), dabbr40(0:2) serial = serial + 1 dump = ibits(debugkey, DebugE, 1) .ne. 0 .and. & serial .ge. debugfrom .and. serial .le. debugto if( dump ) call XDumpPara(5, para, "Ecoeffa") m1 = M(1) m2 = M(2) m3 = M(3) m4 = M(4) m5 = M(5) p1 = P(1) p2 = P(2) p3 = P(3) p4 = P(4) p5 = P(5) p1p2 = P(6) p2p3 = P(7) p3p4 = P(8) p4p5 = P(9) p5p1 = P(10) finite = 0 del = 0 if( lambda .ge. 0 ) then finite = 1 del = (delta + log(mudim))/24D0 else if( lambda .eq. -1 ) then del = 1/24D0 endif del4 = .25D0*del Y(1,1) = 2*m1 Y(2,2) = 2*m2 Y(3,3) = 2*m3 Y(4,4) = 2*m4 Y(5,5) = 2*m5 Y(1,2) = m1 Y(1,2) = Y(1,2) + m2 Y(1,2) = Y(1,2) - p1 Y(2,1) = Y(1,2) Y(1,3) = m1 Y(1,3) = Y(1,3) + m3 Y(1,3) = Y(1,3) - p1p2 Y(3,1) = Y(1,3) Y(1,4) = m1 Y(1,4) = Y(1,4) + m4 Y(1,4) = Y(1,4) - p4p5 Y(4,1) = Y(1,4) Y(1,5) = m1 Y(1,5) = Y(1,5) + m5 Y(1,5) = Y(1,5) - p5 Y(5,1) = Y(1,5) Y(2,3) = m2 Y(2,3) = Y(2,3) + m3 Y(2,3) = Y(2,3) - p2 Y(3,2) = Y(2,3) Y(2,4) = m2 Y(2,4) = Y(2,4) + m4 Y(2,4) = Y(2,4) - p2p3 Y(4,2) = Y(2,4) Y(2,5) = m2 Y(2,5) = Y(2,5) + m5 Y(2,5) = Y(2,5) - p5p1 Y(5,2) = Y(2,5) Y(3,4) = m3 Y(3,4) = Y(3,4) + m4 Y(3,4) = Y(3,4) - p3 Y(4,3) = Y(3,4) Y(3,5) = m3 Y(3,5) = Y(3,5) + m5 Y(3,5) = Y(3,5) - p3p4 Y(5,3) = Y(3,5) Y(4,5) = m4 Y(4,5) = Y(4,5) + m5 Y(4,5) = Y(4,5) - p4 Y(5,4) = Y(4,5) * calculate the Y(i), their determinants, and eta(i) do i = 1, 5 Yi = Y Yi(:,i) = 1 call XDet(5, Yi,5, eta(i)) enddo * Y is no longer needed, now calculate its determinant and * add the missing factor 1/detY to eta call XDet(5, Y,5, detY) eta = eta/detY Z(1,1) = 2*p1 Z(2,2) = 2*p1p2 Z(3,3) = 2*p4p5 Z(4,4) = 2*p5 Z(1,2) = p1 Z(1,2) = Z(1,2) + p1p2 Z(1,2) = Z(1,2) - p2 Z(2,1) = Z(1,2) Z(1,3) = p1 Z(1,3) = Z(1,3) - p2p3 Z(1,3) = Z(1,3) + p4p5 Z(3,1) = Z(1,3) Z(1,4) = p1 Z(1,4) = Z(1,4) - p5p1 Z(1,4) = Z(1,4) + p5 Z(4,1) = Z(1,4) Z(2,3) = p1p2 Z(2,3) = Z(2,3) - p3 Z(2,3) = Z(2,3) + p4p5 Z(3,2) = Z(2,3) Z(2,4) = p1p2 Z(2,4) = Z(2,4) - p3p4 Z(2,4) = Z(2,4) + p5 Z(4,2) = Z(2,4) Z(3,4) = p5 Z(3,4) = Z(3,4) + p4p5 Z(3,4) = Z(3,4) - p4 Z(4,3) = Z(3,4) * calculate the zeta(i,j) do i = 1, 4 do j = i, 4 * generate the submatrix Z_ij forall(l = 1:3, k = 1:3) & Zij(k,l) = Z(k+merge(1,0,k.ge.i),l+merge(1,0,l.ge.j)) call XDet(3, Zij,3, detZ) zeta(i,j) = Sgn(i + j)*detZ/detY zeta(j,i) = zeta(i,j) enddo enddo call XDet(4, Z,4, detZ) help1 = D2345(DD003) + 2*D2345(DD0033) + D2345(DD00333) help2 = D2345(DD002) + 2*D2345(DD0023) + D2345(DD00233) help3 = D2345(DD001) + 2*D2345(DD0013) + D2345(DD00133) help4 = D2345(DD00) + 2*D2345(DD003) + D2345(DD0033) dabbr41 = D2345(DD00223) + D2345(DD00233) dabbr48 = D2345(DD00113) + D2345(DD00133) dabbr65 = D2345(DD0023) + D2345(DD00123) dabbr60 = D2345(DD0013) + D2345(DD00123) dabbr55 = D2345(DD0012) + D2345(DD00123) dabbr50 = D2345(DD00112) + D2345(DD00122) dabbr49 = D2345(DD2233) + D2345(DD2333) dabbr45 = D2345(DD2223) + D2345(DD2233) dabbr42 = D2345(DD1223) + D2345(DD1233) dabbr10 = D2345(DD223) + D2345(DD233) dabbr84 = D2345(DD0033) + D2345(DD00233) + D2345(DD00333) dabbr91 = D2345(DD0033) + D2345(DD00133) + D2345(DD00333) dabbr81 = dabbr41 + D2345(DD0023) dabbr52 = D2345(DD0033) + D2345(DD00133) + D2345(DD00233) dabbr88 = dabbr65 + D2345(DD00233) dabbr77 = D2345(DD0022) + D2345(DD00222) + D2345(DD00223) dabbr90 = dabbr65 + D2345(DD00223) dabbr46 = D2345(DD0022) + D2345(DD00122) + D2345(DD00223) dabbr87 = D2345(DD0022) + D2345(DD00122) + D2345(DD00222) dabbr74 = dabbr60 + D2345(DD00133) dabbr80 = dabbr48 + D2345(DD0013) dabbr71 = dabbr55 + D2345(DD00122) dabbr83 = dabbr60 + D2345(DD00113) dabbr76 = dabbr55 + D2345(DD00112) dabbr79 = dabbr50 + D2345(DD0012) dabbr43 = D2345(DD0011) + D2345(DD00112) + D2345(DD00113) dabbr70 = D2345(DD0011) + D2345(DD00111) + D2345(DD00113) dabbr73 = D2345(DD0011) + D2345(DD00111) + D2345(DD00112) dabbr35 = (D2345(DD0000) - del) + & (D2345(DD00002) + del4) + (D2345(DD00003) + del4) dabbr37 = (D2345(DD0000) - del) + & (D2345(DD00001) + del4) + (D2345(DD00003) + del4) dabbr39 = (D2345(DD0000) - del) + & (D2345(DD00001) + del4) + (D2345(DD00002) + del4) dabbr27 = D2345(DD003) + D2345(DD0023) + D2345(DD0033) dabbr31 = D2345(DD003) + D2345(DD0013) + D2345(DD0033) dabbr24 = D2345(DD002) + D2345(DD0022) + D2345(DD0023) dabbr20 = D2345(DD003) + D2345(DD0013) + D2345(DD0023) dabbr16 = D2345(DD002) + D2345(DD0012) + D2345(DD0023) dabbr30 = D2345(DD002) + D2345(DD0012) + D2345(DD0022) dabbr13 = D2345(DD001) + D2345(DD0012) + D2345(DD0013) dabbr23 = D2345(DD001) + D2345(DD0011) + D2345(DD0013) dabbr26 = D2345(DD001) + D2345(DD0011) + D2345(DD0012) dabbr5 = D2345(DD00) + D2345(DD002) + D2345(DD003) dabbr7 = D2345(DD00) + D2345(DD001) + D2345(DD003) dabbr9 = D2345(DD00) + D2345(DD001) + D2345(DD002) dabbr33 = dabbr35 + (D2345(DD00001) + del4) dabbr92 = D2345(DD333) + D2345(DD1333) + & D2345(DD2333) + D2345(DD3333) dabbr89 = dabbr49 + D2345(DD233) + D2345(DD1233) dabbr86 = dabbr45 + D2345(DD223) + D2345(DD1223) dabbr85 = D2345(DD222) + D2345(DD1222) + & D2345(DD2222) + D2345(DD2223) dabbr82 = D2345(DD133) + D2345(DD1133) + & D2345(DD1233) + D2345(DD1333) dabbr78 = dabbr42 + D2345(DD123) + D2345(DD1123) dabbr75 = D2345(DD122) + D2345(DD1122) + & D2345(DD1222) + D2345(DD1223) dabbr72 = D2345(DD113) + D2345(DD1113) + & D2345(DD1123) + D2345(DD1133) dabbr69 = D2345(DD112) + D2345(DD1112) + & D2345(DD1122) + D2345(DD1123) dabbr68 = D2345(DD111) + D2345(DD1111) + & D2345(DD1112) + D2345(DD1113) dabbr38 = dabbr27 + D2345(DD0013) dabbr36 = dabbr24 + D2345(DD0012) dabbr34 = dabbr13 + D2345(DD0011) dabbr32 = D2345(DD33) + D2345(DD133) + & D2345(DD233) + D2345(DD333) dabbr29 = dabbr10 + D2345(DD23) + D2345(DD123) dabbr28 = D2345(DD22) + D2345(DD122) + & D2345(DD222) + D2345(DD223) dabbr25 = D2345(DD13) + D2345(DD113) + & D2345(DD123) + D2345(DD133) dabbr22 = D2345(DD12) + D2345(DD112) + & D2345(DD122) + D2345(DD123) dabbr21 = D2345(DD11) + D2345(DD111) + & D2345(DD112) + D2345(DD113) dabbr3 = dabbr5 + D2345(DD001) dabbr8 = D2345(DD3) + D2345(DD13) + D2345(DD23) + D2345(DD33) dabbr6 = D2345(DD2) + D2345(DD12) + D2345(DD22) + D2345(DD23) dabbr4 = D2345(DD1) + D2345(DD11) + D2345(DD12) + D2345(DD13) dabbr1 = D2345(DD0) + D2345(DD1) + D2345(DD2) + D2345(DD3) dabbr61 = help1 + 2*D2345(DD0023) + & D2345(DD00223) + 2*D2345(DD00233) dabbr66 = help1 + 2*D2345(DD0013) + & D2345(DD00113) + 2*D2345(DD00133) dabbr57 = help2 + 2*D2345(DD0022) + & D2345(DD00222) + 2*D2345(DD00223) dabbr47 = help2 + 2*D2345(DD0012) + & D2345(DD00112) + 2*D2345(DD00123) dabbr51 = D2345(DD003) + 2*D2345(DD0013) + & 2*D2345(DD0023) + D2345(DD00113) + & 2*D2345(DD00123) + D2345(DD00223) dabbr64 = D2345(DD002) + 2*D2345(DD0012) + & 2*D2345(DD0022) + D2345(DD00112) + & 2*D2345(DD00122) + D2345(DD00222) dabbr44 = help3 + 2*D2345(DD0012) + & D2345(DD00122) + 2*D2345(DD00123) dabbr56 = help3 + 2*D2345(DD0011) + & D2345(DD00111) + 2*D2345(DD00113) dabbr59 = D2345(DD001) + 2*D2345(DD0011) + & 2*D2345(DD0012) + D2345(DD00111) + & 2*D2345(DD00112) + D2345(DD00122) dabbr14 = help4 + 2*D2345(DD002) + & D2345(DD0022) + 2*D2345(DD0023) dabbr17 = help4 + 2*D2345(DD001) + & D2345(DD0011) + 2*D2345(DD0013) dabbr19 = D2345(DD00) + 2*D2345(DD001) + & 2*D2345(DD002) + D2345(DD0011) + & 2*D2345(DD0012) + D2345(DD0022) dabbr67 = D2345(DD33) + 2*D2345(DD133) + & 2*D2345(DD233) + 2*D2345(DD333) + & D2345(DD1133) + 2*D2345(DD1233) + & 2*D2345(DD1333) + D2345(DD2233) + & 2*D2345(DD2333) + D2345(DD3333) dabbr63 = D2345(DD23) + 2*D2345(DD123) + & 2*D2345(DD223) + 2*D2345(DD233) + & D2345(DD1123) + 2*D2345(DD1223) + & 2*D2345(DD1233) + D2345(DD2223) + & 2*D2345(DD2233) + D2345(DD2333) dabbr62 = D2345(DD22) + 2*D2345(DD122) + & 2*D2345(DD222) + 2*D2345(DD223) + & D2345(DD1122) + 2*D2345(DD1222) + & 2*D2345(DD1223) + D2345(DD2222) + & 2*D2345(DD2223) + D2345(DD2233) dabbr58 = D2345(DD13) + 2*D2345(DD113) + & 2*D2345(DD123) + 2*D2345(DD133) + & D2345(DD1113) + 2*D2345(DD1123) + & 2*D2345(DD1133) + D2345(DD1223) + & 2*D2345(DD1233) + D2345(DD1333) dabbr54 = D2345(DD12) + 2*D2345(DD112) + & 2*D2345(DD122) + 2*D2345(DD123) + & D2345(DD1112) + 2*D2345(DD1122) + & 2*D2345(DD1123) + D2345(DD1222) + & 2*D2345(DD1223) + D2345(DD1233) dabbr53 = D2345(DD11) + 2*D2345(DD111) + & 2*D2345(DD112) + 2*D2345(DD113) + & D2345(DD1111) + 2*D2345(DD1112) + & 2*D2345(DD1113) + D2345(DD1122) + & 2*D2345(DD1123) + D2345(DD1133) dabbr11 = dabbr14 + 2*D2345(DD001) + & D2345(DD0011) + 2*D2345(DD0012) + & 2*D2345(DD0013) dabbr18 = D2345(DD3) + 2*D2345(DD13) + & 2*D2345(DD23) + 2*D2345(DD33) + & D2345(DD113) + 2*D2345(DD123) + & 2*D2345(DD133) + D2345(DD223) + & 2*D2345(DD233) + D2345(DD333) dabbr15 = D2345(DD2) + 2*D2345(DD12) + & 2*D2345(DD22) + 2*D2345(DD23) + & D2345(DD112) + 2*D2345(DD122) + & 2*D2345(DD123) + D2345(DD222) + & 2*D2345(DD223) + D2345(DD233) dabbr12 = D2345(DD1) + 2*D2345(DD11) + & 2*D2345(DD12) + 2*D2345(DD13) + & D2345(DD111) + 2*D2345(DD112) + & 2*D2345(DD113) + D2345(DD122) + & 2*D2345(DD123) + D2345(DD133) dabbr2 = D2345(DD0) + 2*D2345(DD1) + & 2*D2345(DD2) + 2*D2345(DD3) + & D2345(DD11) + 2*D2345(DD12) + & 2*D2345(DD13) + D2345(DD22) + & 2*D2345(DD23) + D2345(DD33) dabbr40 = D2345(DD0) + 4*D2345(DD1) + & 4*D2345(DD2) + 4*D2345(DD3) + & 6*D2345(DD11) + 12*D2345(DD12) + & 12*D2345(DD13) + 6*D2345(DD22) + & 12*D2345(DD23) + 6*D2345(DD33) + & 4*D2345(DD111) + 12*D2345(DD112) + & 12*D2345(DD113) + 12*D2345(DD122) + & 24*D2345(DD123) + 12*D2345(DD133) + & 4*D2345(DD222) + 12*D2345(DD223) + & 12*D2345(DD233) + 4*D2345(DD333) + & D2345(DD1111) + 4*D2345(DD1112) + & 4*D2345(DD1113) + 6*D2345(DD1122) + & 12*D2345(DD1123) + 6*D2345(DD1133) + & 4*D2345(DD1222) + 12*D2345(DD1223) + & 12*D2345(DD1233) + 4*D2345(DD1333) + & D2345(DD2222) + 4*D2345(DD2223) + & 6*D2345(DD2233) + 4*D2345(DD2333) + & D2345(DD3333) call XE0func(E(EE0), para, & D2345, D1345, D1245, D1235, D1234, 1) E(EE1) = dabbr1*eta(1) - eta(3)*D1245(DD1) - & eta(4)*D1235(DD1) - eta(5)*D1234(DD1) + & 2*(zeta(1,1)*D1345(DD00) + & zeta(1,2)*D1245(DD00) + & zeta(1,3)*D1235(DD00) + & zeta(1,4)*D1234(DD00) - & (zeta(1,1) + zeta(1,2) + zeta(1,3) + zeta(1,4))* & D2345(DD00)) E(EE2) = -(eta(2)*D1345(DD1)) - & eta(4)*D1235(DD2) - eta(5)*D1234(DD2) - & eta(1)*D2345(DD1) + & 2*zeta(1,2)*D1345(DD00) + & 2*zeta(2,2)*D1245(DD00) + & 2*zeta(2,3)*D1235(DD00) + & 2*zeta(2,4)*D1234(DD00) - & 2*(zeta(1,2) + zeta(2,2) + zeta(2,3) + zeta(2,4))* & D2345(DD00) E(EE3) = -(eta(2)*D1345(DD2)) - & eta(3)*D1245(DD2) - eta(5)*D1234(DD3) - & eta(1)*D2345(DD2) + & 2*zeta(1,3)*D1345(DD00) + & 2*zeta(2,3)*D1245(DD00) + & 2*zeta(3,3)*D1235(DD00) + & 2*zeta(3,4)*D1234(DD00) - & 2*(zeta(1,3) + zeta(2,3) + zeta(3,3) + zeta(3,4))* & D2345(DD00) E(EE4) = -(eta(2)*D1345(DD3)) - & eta(3)*D1245(DD3) - eta(4)*D1235(DD3) - & eta(1)*D2345(DD3) + & 2*zeta(1,4)*D1345(DD00) + & 2*zeta(2,4)*D1245(DD00) + & 2*zeta(3,4)*D1235(DD00) + & 2*zeta(4,4)*D1234(DD00) - & 2*(zeta(1,4) + zeta(2,4) + zeta(3,4) + zeta(4,4))* & D2345(DD00) E(EE00) = -(eta(2)*D1345(DD00)) - & eta(3)*D1245(DD00) - eta(4)*D1235(DD00) - & eta(5)*D1234(DD00) - eta(1)*D2345(DD00) E(EE11) = -(dabbr2*eta(1)) - eta(3)*D1245(DD11) - & eta(4)*D1235(DD11) - eta(5)*D1234(DD11) + & 4*(dabbr3*(zeta(1,1) + zeta(1,2) + zeta(1,3) + & zeta(1,4)) + zeta(1,2)*D1245(DD001) + & zeta(1,3)*D1235(DD001) + & zeta(1,4)*D1234(DD001)) E(EE12) = dabbr4*eta(1) - eta(4)*D1235(DD12) - & eta(5)*D1234(DD12) + & 2*(dabbr5*(zeta(1,2) + zeta(2,2) + zeta(2,3) + & zeta(2,4)) + zeta(1,1)*D1345(DD001) + & zeta(2,2)*D1245(DD001) + & zeta(2,3)*D1235(DD001) + & zeta(2,4)*D1234(DD001) + & zeta(1,3)*D1235(DD002) + & zeta(1,4)*D1234(DD002) - & (zeta(1,1) + zeta(1,3) + zeta(1,4) - zeta(2,2) - & zeta(2,3) - zeta(2,4))*D2345(DD001)) E(EE13) = dabbr6*eta(1) - eta(3)*D1245(DD12) - & eta(5)*D1234(DD13) + & 2*(dabbr7*(zeta(1,3) + zeta(2,3) + zeta(3,3) + & zeta(3,4)) + zeta(2,3)*D1245(DD001) + & zeta(3,3)*D1235(DD001) + & zeta(3,4)*D1234(DD001) + & zeta(1,1)*D1345(DD002) + & zeta(1,2)*D1245(DD002) + & zeta(1,4)*D1234(DD003) - & (zeta(1,1) + zeta(1,2) + zeta(1,4) - zeta(2,3) - & zeta(3,3) - zeta(3,4))*D2345(DD002)) E(EE14) = dabbr8*eta(1) - eta(3)*D1245(DD13) - & eta(4)*D1235(DD13) + & 2*(dabbr9*(zeta(1,4) + zeta(2,4) + zeta(3,4) + & zeta(4,4)) + zeta(2,4)*D1245(DD001) + & zeta(3,4)*D1235(DD001) + & zeta(4,4)*D1234(DD001) + & zeta(1,1)*D1345(DD003) + & zeta(1,2)*D1245(DD003) + & zeta(1,3)*D1235(DD003) - & (zeta(1,1) + zeta(1,2) + zeta(1,3) - zeta(2,4) - & zeta(3,4) - zeta(4,4))*D2345(DD003)) E(EE22) = -(eta(2)*D1345(DD11)) - & eta(4)*D1235(DD22) - eta(5)*D1234(DD22) - & eta(1)*D2345(DD11) + & 4*zeta(1,2)*D1345(DD001) + & 4*zeta(2,3)*D1235(DD002) + & 4*zeta(2,4)*D1234(DD002) - & 4*(zeta(1,2) + zeta(2,2) + zeta(2,3) + zeta(2,4))* & D2345(DD001) E(EE23) = -(eta(2)*D1345(DD12)) - & eta(5)*D1234(DD23) - eta(1)*D2345(DD12) + & 2*(zeta(1,3)*D1345(DD001) + & zeta(1,2)*D1345(DD002) + & zeta(2,2)*D1245(DD002) + & zeta(3,3)*D1235(DD002) + & zeta(3,4)*D1234(DD002) + & zeta(2,4)*D1234(DD003) - & (zeta(1,3) + zeta(2,3) + zeta(3,3) + zeta(3,4))* & D2345(DD001) - & (zeta(1,2) + zeta(2,2) + zeta(2,3) + zeta(2,4))* & D2345(DD002)) E(EE24) = -(eta(2)*D1345(DD13)) - & eta(4)*D1235(DD23) - eta(1)*D2345(DD13) + & 2*(zeta(1,4)*D1345(DD001) + & zeta(3,4)*D1235(DD002) + & zeta(4,4)*D1234(DD002) + & zeta(1,2)*D1345(DD003) + & zeta(2,2)*D1245(DD003) + & zeta(2,3)*D1235(DD003) - & (zeta(1,4) + zeta(2,4) + zeta(3,4) + zeta(4,4))* & D2345(DD001) - & (zeta(1,2) + zeta(2,2) + zeta(2,3) + zeta(2,4))* & D2345(DD003)) E(EE33) = -(eta(2)*D1345(DD22)) - & eta(3)*D1245(DD22) - eta(5)*D1234(DD33) - & eta(1)*D2345(DD22) + & 4*zeta(1,3)*D1345(DD002) + & 4*zeta(2,3)*D1245(DD002) + & 4*zeta(3,4)*D1234(DD003) - & 4*(zeta(1,3) + zeta(2,3) + zeta(3,3) + zeta(3,4))* & D2345(DD002) E(EE34) = -(eta(2)*D1345(DD23)) - & eta(3)*D1245(DD23) - eta(1)*D2345(DD23) + & 2*(zeta(1,4)*D1345(DD002) + & zeta(2,4)*D1245(DD002) + & zeta(1,3)*D1345(DD003) + & zeta(2,3)*D1245(DD003) + & zeta(3,3)*D1235(DD003) + & zeta(4,4)*D1234(DD003) - & (zeta(1,4) + zeta(2,4) + zeta(3,4) + zeta(4,4))* & D2345(DD002) - & (zeta(1,3) + zeta(2,3) + zeta(3,3) + zeta(3,4))* & D2345(DD003)) E(EE44) = -(eta(2)*D1345(DD33)) - & eta(3)*D1245(DD33) - eta(4)*D1235(DD33) - & eta(1)*D2345(DD33) + & 4*zeta(1,4)*D1345(DD003) + & 4*zeta(2,4)*D1245(DD003) + & 4*zeta(3,4)*D1235(DD003) - & 4*(zeta(1,4) + zeta(2,4) + zeta(3,4) + zeta(4,4))* & D2345(DD003) E(EE001) = dabbr3*eta(1) - eta(3)*D1245(DD001) - & eta(4)*D1235(DD001) - eta(5)*D1234(DD001) + & 2*(zeta(1,1)*(D1345(DD0000) - del) + & zeta(1,2)*(D1245(DD0000) - del) + & zeta(1,3)*(D1235(DD0000) - del) + & zeta(1,4)*(D1234(DD0000) - del) - & (zeta(1,1) + zeta(1,2) + zeta(1,3) + zeta(1,4))* & (D2345(DD0000) - del)) E(EE002) = -(eta(2)*D1345(DD001)) - & eta(4)*D1235(DD002) - eta(5)*D1234(DD002) - & eta(1)*D2345(DD001) + & 2*zeta(1,2)*(D1345(DD0000) - del) + & 2*zeta(2,2)*(D1245(DD0000) - del) + & 2*zeta(2,3)*(D1235(DD0000) - del) + & 2*zeta(2,4)*(D1234(DD0000) - del) - & 2*(zeta(1,2) + zeta(2,2) + zeta(2,3) + zeta(2,4))* & (D2345(DD0000) - del) E(EE003) = -(eta(2)*D1345(DD002)) - & eta(3)*D1245(DD002) - eta(5)*D1234(DD003) - & eta(1)*D2345(DD002) + & 2*zeta(1,3)*(D1345(DD0000) - del) + & 2*zeta(2,3)*(D1245(DD0000) - del) + & 2*zeta(3,3)*(D1235(DD0000) - del) + & 2*zeta(3,4)*(D1234(DD0000) - del) - & 2*(zeta(1,3) + zeta(2,3) + zeta(3,3) + zeta(3,4))* & (D2345(DD0000) - del) E(EE004) = -(eta(2)*D1345(DD003)) - & eta(3)*D1245(DD003) - eta(4)*D1235(DD003) - & eta(1)*D2345(DD003) + & 2*zeta(1,4)*(D1345(DD0000) - del) + & 2*zeta(2,4)*(D1245(DD0000) - del) + & 2*zeta(3,4)*(D1235(DD0000) - del) + & 2*zeta(4,4)*(D1234(DD0000) - del) - & 2*(zeta(1,4) + zeta(2,4) + zeta(3,4) + zeta(4,4))* & (D2345(DD0000) - del) E(EE111) = -6*dabbr11* & (zeta(1,1) + zeta(1,2) + zeta(1,3) + zeta(1,4)) - & eta(3)*D1245(DD111) - eta(4)*D1235(DD111) - & eta(5)*D1234(DD111) + & eta(1)*(3*dabbr10 + D2345(DD0) + & 3*D2345(DD1) + 3*D2345(DD2) + & 3*D2345(DD3) + 3*D2345(DD11) + & 6*D2345(DD12) + 6*D2345(DD13) + & 3*D2345(DD22) + 6*D2345(DD23) + & 3*D2345(DD33) + D2345(DD111) + & 3*D2345(DD112) + 3*D2345(DD113) + & 3*D2345(DD122) + 6*D2345(DD123) + & 3*D2345(DD133) + D2345(DD222) + & D2345(DD333)) + & 6*zeta(1,2)*D1245(DD0011) + & 6*zeta(1,3)*D1235(DD0011) + & 6*zeta(1,4)*D1234(DD0011) E(EE112) = -(dabbr12*eta(1)) - & 2*dabbr14*(zeta(1,2) + zeta(2,2) + zeta(2,3) + & zeta(2,4)) - eta(4)*D1235(DD112) - & eta(5)*D1234(DD112) + & 2*(2*dabbr13*(zeta(1,1) + zeta(1,3) + zeta(1,4) - & zeta(2,2) - zeta(2,3) - zeta(2,4)) + & zeta(2,2)*D1245(DD0011) + & zeta(2,3)*D1235(DD0011) + & zeta(2,4)*D1234(DD0011) + & 2*zeta(1,3)*D1235(DD0012) + & 2*zeta(1,4)*D1234(DD0012) + & (2*zeta(1,1) + zeta(1,2) + 2*zeta(1,3) + 2*zeta(1,4) - & zeta(2,2) - zeta(2,3) - zeta(2,4))* & D2345(DD0011)) E(EE113) = -(dabbr15*eta(1)) - & 2*dabbr17*(zeta(1,3) + zeta(2,3) + zeta(3,3) + & zeta(3,4)) - eta(3)*D1245(DD112) - & eta(5)*D1234(DD113) + & 2*(2*dabbr16*(zeta(1,1) + zeta(1,2) + zeta(1,4) - & zeta(2,3) - zeta(3,3) - zeta(3,4)) + & zeta(2,3)*D1245(DD0011) + & zeta(3,3)*D1235(DD0011) + & zeta(3,4)*D1234(DD0011) + & 2*zeta(1,2)*D1245(DD0012) + & 2*zeta(1,4)*D1234(DD0013) + & (2*zeta(1,1) + 2*zeta(1,2) + zeta(1,3) + 2*zeta(1,4) - & zeta(2,3) - zeta(3,3) - zeta(3,4))* & D2345(DD0022)) E(EE114) = -(dabbr18*eta(1)) - & 2*dabbr19*(zeta(1,4) + zeta(2,4) + zeta(3,4) + & zeta(4,4)) - eta(3)*D1245(DD113) - & eta(4)*D1235(DD113) + & 2*(2*dabbr20*(zeta(1,1) + zeta(1,2) + zeta(1,3) - & zeta(2,4) - zeta(3,4) - zeta(4,4)) + & zeta(2,4)*D1245(DD0011) + & zeta(3,4)*D1235(DD0011) + & zeta(4,4)*D1234(DD0011) + & 2*zeta(1,2)*D1245(DD0013) + & 2*zeta(1,3)*D1235(DD0013) + & (2*zeta(1,1) + 2*zeta(1,2) + 2*zeta(1,3) + zeta(1,4) - & zeta(2,4) - zeta(3,4) - zeta(4,4))* & D2345(DD0033)) E(EE122) = dabbr21*eta(1) - eta(4)*D1235(DD122) - & eta(5)*D1234(DD122) + & 2*(2*dabbr13*(zeta(1,2) + zeta(2,2) + zeta(2,3) + & zeta(2,4)) + zeta(1,1)*D1345(DD0011) + & 2*zeta(2,3)*D1235(DD0012) + & 2*zeta(2,4)*D1234(DD0012) + & zeta(1,3)*D1235(DD0022) + & zeta(1,4)*D1234(DD0022) - & (zeta(1,1) - zeta(1,2) + zeta(1,3) + zeta(1,4) - & 2*(zeta(2,2) + zeta(2,3) + zeta(2,4)))* & D2345(DD0011)) E(EE123) = dabbr22*eta(1) - eta(5)*D1234(DD123) + & 2*(dabbr24*(zeta(1,2) + zeta(2,2) + zeta(2,3) + & zeta(2,4)) + & dabbr23*(zeta(1,3) + zeta(2,3) + zeta(3,3) + & zeta(3,4)) + zeta(1,1)*D1345(DD0012) + & zeta(2,2)*D1245(DD0012) + & zeta(3,3)*D1235(DD0012) + & zeta(3,4)*D1234(DD0012) + & zeta(2,4)*D1234(DD0013) + & zeta(1,4)*D1234(DD0023) + & (-zeta(1,1) - zeta(1,4) + zeta(2,2) + 2*zeta(2,3) + & zeta(2,4) + zeta(3,3) + zeta(3,4))* & D2345(DD0012)) E(EE124) = dabbr25*eta(1) - eta(4)*D1235(DD123) + & 2*(dabbr27*(zeta(1,2) + zeta(2,2) + zeta(2,3) + & zeta(2,4)) + & dabbr26*(zeta(1,4) + zeta(2,4) + zeta(3,4) + & zeta(4,4)) + zeta(3,4)*D1235(DD0012) + & zeta(4,4)*D1234(DD0012) + & zeta(1,1)*D1345(DD0013) + & zeta(2,2)*D1245(DD0013) + & zeta(2,3)*D1235(DD0013) + & zeta(1,3)*D1235(DD0023) + & (-zeta(1,1) - zeta(1,3) + zeta(2,2) + zeta(2,3) + & 2*zeta(2,4) + zeta(3,4) + zeta(4,4))* & D2345(DD0013)) E(EE133) = dabbr28*eta(1) - eta(3)*D1245(DD122) - & eta(5)*D1234(DD133) + & 2*(2*dabbr16*(zeta(1,3) + zeta(2,3) + zeta(3,3) + & zeta(3,4)) + 2*zeta(2,3)*D1245(DD0012) + & 2*zeta(3,4)*D1234(DD0013) + & zeta(1,1)*D1345(DD0022) + & zeta(1,2)*D1245(DD0022) + & zeta(1,4)*D1234(DD0033) - & (zeta(1,1) + zeta(1,2) - zeta(1,3) + zeta(1,4) - & 2*(zeta(2,3) + zeta(3,3) + zeta(3,4)))* & D2345(DD0022)) E(EE134) = dabbr29*eta(1) - eta(3)*D1245(DD123) + & 2*(dabbr31*(zeta(1,3) + zeta(2,3) + zeta(3,3) + & zeta(3,4)) + & dabbr30*(zeta(1,4) + zeta(2,4) + zeta(3,4) + & zeta(4,4)) + zeta(2,4)*D1245(DD0012) + & zeta(2,3)*D1245(DD0013) + & zeta(3,3)*D1235(DD0013) + & zeta(4,4)*D1234(DD0013) + & zeta(1,1)*D1345(DD0023) + & zeta(1,2)*D1245(DD0023) + & (-zeta(1,1) - zeta(1,2) + zeta(2,3) + zeta(2,4) + & zeta(3,3) + 2*zeta(3,4) + zeta(4,4))* & D2345(DD0023)) E(EE144) = dabbr32*eta(1) - eta(3)*D1245(DD133) - & eta(4)*D1235(DD133) + & 2*(2*dabbr20*(zeta(1,4) + zeta(2,4) + zeta(3,4) + & zeta(4,4)) + 2*zeta(2,4)*D1245(DD0013) + & 2*zeta(3,4)*D1235(DD0013) + & zeta(1,1)*D1345(DD0033) + & zeta(1,2)*D1245(DD0033) + & zeta(1,3)*D1235(DD0033) - & (zeta(1,1) + zeta(1,2) + zeta(1,3) - zeta(1,4) - & 2*(zeta(2,4) + zeta(3,4) + zeta(4,4)))* & D2345(DD0033)) E(EE222) = -(eta(2)*D1345(DD111)) - & eta(4)*D1235(DD222) - eta(5)*D1234(DD222) - & eta(1)*D2345(DD111) + & 6*zeta(1,2)*D1345(DD0011) + & 6*zeta(2,3)*D1235(DD0022) + & 6*zeta(2,4)*D1234(DD0022) - & 6*(zeta(1,2) + zeta(2,2) + zeta(2,3) + zeta(2,4))* & D2345(DD0011) E(EE223) = -(eta(2)*D1345(DD112)) - & eta(5)*D1234(DD223) - eta(1)*D2345(DD112) + & 2*zeta(1,3)*D1345(DD0011) + & 4*zeta(1,2)*D1345(DD0012) + & 2*zeta(3,3)*D1235(DD0022) + & 2*zeta(3,4)*D1234(DD0022) + & 4*zeta(2,4)*D1234(DD0023) - & 2*(zeta(1,3) + zeta(2,3) + zeta(3,3) + zeta(3,4))* & D2345(DD0011) - & 4*(zeta(1,2) + zeta(2,2) + zeta(2,3) + zeta(2,4))* & D2345(DD0012) E(EE224) = -(eta(2)*D1345(DD113)) - & eta(4)*D1235(DD223) - eta(1)*D2345(DD113) + & 2*zeta(1,4)*D1345(DD0011) + & 4*zeta(1,2)*D1345(DD0013) + & 2*zeta(3,4)*D1235(DD0022) + & 2*zeta(4,4)*D1234(DD0022) + & 4*zeta(2,3)*D1235(DD0023) - & 2*(zeta(1,4) + zeta(2,4) + zeta(3,4) + zeta(4,4))* & D2345(DD0011) - & 4*(zeta(1,2) + zeta(2,2) + zeta(2,3) + zeta(2,4))* & D2345(DD0013) E(EE233) = -(eta(2)*D1345(DD122)) - & eta(5)*D1234(DD233) - eta(1)*D2345(DD122) + & 4*zeta(1,3)*D1345(DD0012) + & 2*zeta(1,2)*D1345(DD0022) + & 2*zeta(2,2)*D1245(DD0022) + & 4*zeta(3,4)*D1234(DD0023) + & 2*zeta(2,4)*D1234(DD0033) - & 4*(zeta(1,3) + zeta(2,3) + zeta(3,3) + zeta(3,4))* & D2345(DD0012) - & 2*(zeta(1,2) + zeta(2,2) + zeta(2,3) + zeta(2,4))* & D2345(DD0022) E(EE234) = -(eta(2)*D1345(DD123)) - & eta(1)*D2345(DD123) + & 2*(zeta(1,4)*D1345(DD0012) + & zeta(1,3)*D1345(DD0013) + & zeta(1,2)*D1345(DD0023) + & zeta(2,2)*D1245(DD0023) + & zeta(3,3)*D1235(DD0023) + & zeta(4,4)*D1234(DD0023) - & (zeta(1,4) + zeta(2,4) + zeta(3,4) + zeta(4,4))* & D2345(DD0012) - & (zeta(1,3) + zeta(2,3) + zeta(3,3) + zeta(3,4))* & D2345(DD0013) - & (zeta(1,2) + zeta(2,2) + zeta(2,3) + zeta(2,4))* & D2345(DD0023)) E(EE244) = -(eta(2)*D1345(DD133)) - & eta(4)*D1235(DD233) - eta(1)*D2345(DD133) + & 4*zeta(1,4)*D1345(DD0013) + & 4*zeta(3,4)*D1235(DD0023) + & 2*zeta(1,2)*D1345(DD0033) + & 2*zeta(2,2)*D1245(DD0033) + & 2*zeta(2,3)*D1235(DD0033) - & 4*(zeta(1,4) + zeta(2,4) + zeta(3,4) + zeta(4,4))* & D2345(DD0013) - & 2*(zeta(1,2) + zeta(2,2) + zeta(2,3) + zeta(2,4))* & D2345(DD0033) E(EE333) = -(eta(2)*D1345(DD222)) - & eta(3)*D1245(DD222) - eta(5)*D1234(DD333) - & eta(1)*D2345(DD222) + & 6*zeta(1,3)*D1345(DD0022) + & 6*zeta(2,3)*D1245(DD0022) + & 6*zeta(3,4)*D1234(DD0033) - & 6*(zeta(1,3) + zeta(2,3) + zeta(3,3) + zeta(3,4))* & D2345(DD0022) E(EE334) = -(eta(2)*D1345(DD223)) - & eta(3)*D1245(DD223) - eta(1)*D2345(DD223) + & 2*zeta(1,4)*D1345(DD0022) + & 2*zeta(2,4)*D1245(DD0022) + & 4*zeta(1,3)*D1345(DD0023) + & 4*zeta(2,3)*D1245(DD0023) + & 2*zeta(4,4)*D1234(DD0033) - & 2*(zeta(1,4) + zeta(2,4) + zeta(3,4) + zeta(4,4))* & D2345(DD0022) - & 4*(zeta(1,3) + zeta(2,3) + zeta(3,3) + zeta(3,4))* & D2345(DD0023) E(EE344) = -(eta(2)*D1345(DD233)) - & eta(3)*D1245(DD233) - eta(1)*D2345(DD233) + & 4*zeta(1,4)*D1345(DD0023) + & 4*zeta(2,4)*D1245(DD0023) + & 2*zeta(1,3)*D1345(DD0033) + & 2*zeta(2,3)*D1245(DD0033) + & 2*zeta(3,3)*D1235(DD0033) - & 4*(zeta(1,4) + zeta(2,4) + zeta(3,4) + zeta(4,4))* & D2345(DD0023) - & 2*(zeta(1,3) + zeta(2,3) + zeta(3,3) + zeta(3,4))* & D2345(DD0033) E(EE444) = -(eta(2)*D1345(DD333)) - & eta(3)*D1245(DD333) - eta(4)*D1235(DD333) - & eta(1)*D2345(DD333) + & 6*zeta(1,4)*D1345(DD0033) + & 6*zeta(2,4)*D1245(DD0033) + & 6*zeta(3,4)*D1235(DD0033) - & 6*(zeta(1,4) + zeta(2,4) + zeta(3,4) + zeta(4,4))* & D2345(DD0033) E(EE0000) = (-finite*(detZ/detY) - & 48*(eta(2)*(D1345(DD0000) - del) + & eta(3)*(D1245(DD0000) - del) + & eta(4)*(D1235(DD0000) - del) + & eta(5)*(D1234(DD0000) - del) + & eta(1)*(D2345(DD0000) - del)))/48D0 E(EE0011) = -(dabbr11*eta(1)) - & eta(3)*D1245(DD0011) - & eta(4)*D1235(DD0011) - & eta(5)*D1234(DD0011) + & 4*(dabbr33*(zeta(1,1) + zeta(1,2) + zeta(1,3) + & zeta(1,4)) + & zeta(1,2)*(D1245(DD00001) + del4) + & zeta(1,3)*(D1235(DD00001) + del4) + & zeta(1,4)*(D1234(DD00001) + del4)) E(EE0012) = dabbr34*eta(1) - & eta(4)*D1235(DD0012) - & eta(5)*D1234(DD0012) + & 2*(dabbr35*(zeta(1,2) + zeta(2,2) + zeta(2,3) + & zeta(2,4)) + & zeta(1,1)*(D1345(DD00001) + del4) + & zeta(2,2)*(D1245(DD00001) + del4) + & zeta(2,3)*(D1235(DD00001) + del4) + & zeta(2,4)*(D1234(DD00001) + del4) + & zeta(1,3)*(D1235(DD00002) + del4) + & zeta(1,4)*(D1234(DD00002) + del4) - & (zeta(1,1) + zeta(1,3) + zeta(1,4) - zeta(2,2) - & zeta(2,3) - zeta(2,4))* & (D2345(DD00001) + del4)) E(EE0013) = dabbr36*eta(1) - & eta(3)*D1245(DD0012) - & eta(5)*D1234(DD0013) + & 2*(dabbr37*(zeta(1,3) + zeta(2,3) + zeta(3,3) + & zeta(3,4)) + & zeta(2,3)*(D1245(DD00001) + del4) + & zeta(3,3)*(D1235(DD00001) + del4) + & zeta(3,4)*(D1234(DD00001) + del4) + & zeta(1,1)*(D1345(DD00002) + del4) + & zeta(1,2)*(D1245(DD00002) + del4) + & zeta(1,4)*(D1234(DD00003) + del4) - & (zeta(1,1) + zeta(1,2) + zeta(1,4) - zeta(2,3) - & zeta(3,3) - zeta(3,4))* & (D2345(DD00002) + del4)) E(EE0014) = dabbr38*eta(1) - & eta(3)*D1245(DD0013) - & eta(4)*D1235(DD0013) + & 2*(dabbr39*(zeta(1,4) + zeta(2,4) + zeta(3,4) + & zeta(4,4)) + & zeta(2,4)*(D1245(DD00001) + del4) + & zeta(3,4)*(D1235(DD00001) + del4) + & zeta(4,4)*(D1234(DD00001) + del4) + & zeta(1,1)*(D1345(DD00003) + del4) + & zeta(1,2)*(D1245(DD00003) + del4) + & zeta(1,3)*(D1235(DD00003) + del4) - & (zeta(1,1) + zeta(1,2) + zeta(1,3) - zeta(2,4) - & zeta(3,4) - zeta(4,4))* & (D2345(DD00003) + del4)) E(EE0022) = -(eta(2)*D1345(DD0011)) - & eta(4)*D1235(DD0022) - & eta(5)*D1234(DD0022) - & eta(1)*D2345(DD0011) + & 4*zeta(1,2)*(D1345(DD00001) + del4) + & 4*zeta(2,3)*(D1235(DD00002) + del4) + & 4*zeta(2,4)*(D1234(DD00002) + del4) - & 4*(zeta(1,2) + zeta(2,2) + zeta(2,3) + zeta(2,4))* & (D2345(DD00001) + del4) E(EE0023) = -(eta(2)*D1345(DD0012)) - & eta(5)*D1234(DD0023) - & eta(1)*D2345(DD0012) + & 2*(zeta(1,3)*(D1345(DD00001) + del4) + & zeta(1,2)*(D1345(DD00002) + del4) + & zeta(2,2)*(D1245(DD00002) + del4) + & zeta(3,3)*(D1235(DD00002) + del4) + & zeta(3,4)*(D1234(DD00002) + del4) + & zeta(2,4)*(D1234(DD00003) + del4) - & (zeta(1,3) + zeta(2,3) + zeta(3,3) + zeta(3,4))* & (D2345(DD00001) + del4) - & (zeta(1,2) + zeta(2,2) + zeta(2,3) + zeta(2,4))* & (D2345(DD00002) + del4)) E(EE0024) = -(eta(2)*D1345(DD0013)) - & eta(4)*D1235(DD0023) - & eta(1)*D2345(DD0013) + & 2*(zeta(1,4)*(D1345(DD00001) + del4) + & zeta(3,4)*(D1235(DD00002) + del4) + & zeta(4,4)*(D1234(DD00002) + del4) + & zeta(1,2)*(D1345(DD00003) + del4) + & zeta(2,2)*(D1245(DD00003) + del4) + & zeta(2,3)*(D1235(DD00003) + del4) - & (zeta(1,4) + zeta(2,4) + zeta(3,4) + zeta(4,4))* & (D2345(DD00001) + del4) - & (zeta(1,2) + zeta(2,2) + zeta(2,3) + zeta(2,4))* & (D2345(DD00003) + del4)) E(EE0033) = -(eta(2)*D1345(DD0022)) - & eta(3)*D1245(DD0022) - & eta(5)*D1234(DD0033) - & eta(1)*D2345(DD0022) + & 4*zeta(1,3)*(D1345(DD00002) + del4) + & 4*zeta(2,3)*(D1245(DD00002) + del4) + & 4*zeta(3,4)*(D1234(DD00003) + del4) - & 4*(zeta(1,3) + zeta(2,3) + zeta(3,3) + zeta(3,4))* & (D2345(DD00002) + del4) E(EE0034) = -(eta(2)*D1345(DD0023)) - & eta(3)*D1245(DD0023) - & eta(1)*D2345(DD0023) + & 2*(zeta(1,4)*(D1345(DD00002) + del4) + & zeta(2,4)*(D1245(DD00002) + del4) + & zeta(1,3)*(D1345(DD00003) + del4) + & zeta(2,3)*(D1245(DD00003) + del4) + & zeta(3,3)*(D1235(DD00003) + del4) + & zeta(4,4)*(D1234(DD00003) + del4) - & (zeta(1,4) + zeta(2,4) + zeta(3,4) + zeta(4,4))* & (D2345(DD00002) + del4) - & (zeta(1,3) + zeta(2,3) + zeta(3,3) + zeta(3,4))* & (D2345(DD00003) + del4)) E(EE0044) = -(eta(2)*D1345(DD0033)) - & eta(3)*D1245(DD0033) - & eta(4)*D1235(DD0033) - & eta(1)*D2345(DD0033) + & 4*zeta(1,4)*(D1345(DD00003) + del4) + & 4*zeta(2,4)*(D1245(DD00003) + del4) + & 4*zeta(3,4)*(D1235(DD00003) + del4) - & 4*(zeta(1,4) + zeta(2,4) + zeta(3,4) + zeta(4,4))* & (D2345(DD00003) + del4) E(EE1111) = -(dabbr40*eta(1)) - & eta(3)*D1245(DD1111) - & eta(4)*D1235(DD1111) - & eta(5)*D1234(DD1111) + & 8*zeta(1,2)*D1245(DD00111) + & 8*zeta(1,3)*D1235(DD00111) + & 8*zeta(1,4)*D1234(DD00111) + & 8*(zeta(1,1) + zeta(1,2) + zeta(1,3) + zeta(1,4))* & (3*dabbr41 + D2345(DD00) + & 3*D2345(DD001) + 3*D2345(DD002) + & 3*D2345(DD003) + 3*D2345(DD0011) + & 6*D2345(DD0012) + 6*D2345(DD0013) + & 3*D2345(DD0022) + 6*D2345(DD0023) + & 3*D2345(DD0033) + D2345(DD00111) + & 3*D2345(DD00112) + 3*D2345(DD00113) + & 3*D2345(DD00122) + 6*D2345(DD00123) + & 3*D2345(DD00133) + D2345(DD00222) + & D2345(DD00333)) E(EE1112) = -6*dabbr44* & (zeta(1,1) + zeta(1,3) + zeta(1,4) - zeta(2,2) - & zeta(2,3) - zeta(2,4)) - & 6*dabbr43*(2*zeta(1,1) + zeta(1,2) + 2*zeta(1,3) + & 2*zeta(1,4) - zeta(2,2) - zeta(2,3) - zeta(2,4)) - & eta(4)*D1235(DD1112) - & eta(5)*D1234(DD1112) + & eta(1)*(3*dabbr42 + D2345(DD1) + & 3*D2345(DD11) + 3*D2345(DD12) + & 3*D2345(DD13) + 3*D2345(DD111) + & 6*D2345(DD112) + 6*D2345(DD113) + & 3*D2345(DD122) + 6*D2345(DD123) + & 3*D2345(DD133) + D2345(DD1111) + & 3*D2345(DD1112) + 3*D2345(DD1113) + & 3*D2345(DD1122) + 6*D2345(DD1123) + & 3*D2345(DD1133) + D2345(DD1222) + & D2345(DD1333)) + & 2*(zeta(2,2)*D1245(DD00111) + & zeta(2,3)*D1235(DD00111) + & zeta(2,4)*D1234(DD00111) + & 3*zeta(1,3)*D1235(DD00112) + & 3*zeta(1,4)*D1234(DD00112) + & (-3*zeta(1,1) - 2*zeta(1,2) - 3*zeta(1,3) - & 3*zeta(1,4) + zeta(2,2) + zeta(2,3) + zeta(2,4))* & D2345(DD00111)) + & 2*(zeta(1,2) + zeta(2,2) + zeta(2,3) + zeta(2,4))* & (3*dabbr41 + D2345(DD00) + & 3*D2345(DD002) + 3*D2345(DD003) + & 3*D2345(DD0022) + 6*D2345(DD0023) + & 3*D2345(DD0033) + D2345(DD00222) + & D2345(DD00333)) E(EE1113) = -6*dabbr47* & (zeta(1,1) + zeta(1,2) + zeta(1,4) - zeta(2,3) - & zeta(3,3) - zeta(3,4)) - & 6*dabbr46*(2*zeta(1,1) + 2*zeta(1,2) + zeta(1,3) + & 2*zeta(1,4) - zeta(2,3) - zeta(3,3) - zeta(3,4)) - & eta(3)*D1245(DD1112) - & eta(5)*D1234(DD1113) + & eta(1)*(3*dabbr45 + D2345(DD2) + & 3*D2345(DD12) + 3*D2345(DD22) + & 3*D2345(DD23) + 3*D2345(DD112) + & 6*D2345(DD122) + 6*D2345(DD123) + & 3*D2345(DD222) + 6*D2345(DD223) + & 3*D2345(DD233) + D2345(DD1112) + & 3*D2345(DD1122) + 3*D2345(DD1123) + & 3*D2345(DD1222) + 6*D2345(DD1223) + & 3*D2345(DD1233) + D2345(DD2222) + & D2345(DD2333)) + & 2*(zeta(2,3)*D1245(DD00111) + & zeta(3,3)*D1235(DD00111) + & zeta(3,4)*D1234(DD00111) + & 3*zeta(1,2)*D1245(DD00112) + & 3*zeta(1,4)*D1234(DD00113) + & (-3*zeta(1,1) - 3*zeta(1,2) - 2*zeta(1,3) - & 3*zeta(1,4) + zeta(2,3) + zeta(3,3) + zeta(3,4))* & D2345(DD00222)) + & 2*(zeta(1,3) + zeta(2,3) + zeta(3,3) + zeta(3,4))* & (3*dabbr48 + D2345(DD00) + & 3*D2345(DD001) + 3*D2345(DD003) + & 3*D2345(DD0011) + 6*D2345(DD0013) + & 3*D2345(DD0033) + D2345(DD00111) + & D2345(DD00333)) E(EE1114) = -6*dabbr51* & (zeta(1,1) + zeta(1,2) + zeta(1,3) - zeta(2,4) - & zeta(3,4) - zeta(4,4)) - & 6*dabbr52*(2*zeta(1,1) + 2*zeta(1,2) + 2*zeta(1,3) + & zeta(1,4) - zeta(2,4) - zeta(3,4) - zeta(4,4)) - & eta(3)*D1245(DD1113) - & eta(4)*D1235(DD1113) + & eta(1)*(3*dabbr49 + D2345(DD3) + & 3*D2345(DD13) + 3*D2345(DD23) + & 3*D2345(DD33) + 3*D2345(DD113) + & 6*D2345(DD123) + 6*D2345(DD133) + & 3*D2345(DD223) + 6*D2345(DD233) + & 3*D2345(DD333) + D2345(DD1113) + & 3*D2345(DD1123) + 3*D2345(DD1133) + & 3*D2345(DD1223) + 6*D2345(DD1233) + & 3*D2345(DD1333) + D2345(DD2223) + & D2345(DD3333)) + & 2*(zeta(1,4) + zeta(2,4) + zeta(3,4) + zeta(4,4))* & (3*dabbr50 + D2345(DD00) + & 3*D2345(DD001) + 3*D2345(DD002) + & 3*D2345(DD0011) + 6*D2345(DD0012) + & 3*D2345(DD0022) + D2345(DD00111) + & D2345(DD00222)) + & 2*(zeta(2,4)*D1245(DD00111) + & zeta(3,4)*D1235(DD00111) + & zeta(4,4)*D1234(DD00111) + & 3*zeta(1,2)*D1245(DD00113) + & 3*zeta(1,3)*D1235(DD00113) + & (-3*zeta(1,1) - 3*zeta(1,2) - 3*zeta(1,3) - & 2*zeta(1,4) + zeta(2,4) + zeta(3,4) + zeta(4,4))* & D2345(DD00333)) E(EE1122) = -(dabbr53*eta(1)) - & 4*dabbr44*(zeta(1,2) + zeta(2,2) + zeta(2,3) + & zeta(2,4)) - eta(4)*D1235(DD1122) - & eta(5)*D1234(DD1122) + & 4*(-2*dabbr43*(zeta(2,2) + zeta(2,3) + zeta(2,4)) + & zeta(1,1)*D2345(DD0011) - & zeta(1,2)*D2345(DD0011) + & zeta(1,3)*D2345(DD0011) + & zeta(1,4)*D2345(DD0011) + & zeta(2,3)*D1235(DD00112) + & zeta(2,4)*D1234(DD00112) + & zeta(1,3)*D1235(DD00122) + & zeta(1,4)*D1234(DD00122) + & (zeta(1,1) + zeta(1,3) + zeta(1,4) - zeta(2,2) - & zeta(2,3) - zeta(2,4))*D2345(DD00111) + & zeta(1,1)*D2345(DD00112) - & zeta(1,2)*D2345(DD00112) + & zeta(1,3)*D2345(DD00112) + & zeta(1,4)*D2345(DD00112) + & (zeta(1,1) - zeta(1,2) + zeta(1,3) + zeta(1,4))* & D2345(DD00113)) E(EE1123) = -(dabbr54*eta(1)) - & 2*dabbr57*(zeta(1,2) + zeta(2,2) + zeta(2,3) + & zeta(2,4)) - 2*dabbr56* & (zeta(1,3) + zeta(2,3) + zeta(3,3) + zeta(3,4)) - & eta(5)*D1234(DD1123) + & 2*(2*dabbr55*(zeta(1,1) + zeta(1,4) - zeta(2,2) - & 2*zeta(2,3) - zeta(2,4) - zeta(3,3) - zeta(3,4)) + & zeta(2,2)*D1245(DD00112) + & zeta(3,3)*D1235(DD00112) + & zeta(3,4)*D1234(DD00112) + & zeta(2,4)*D1234(DD00113) + & 2*zeta(1,4)*D1234(DD00123) + & (2*zeta(1,1) + zeta(1,2) + 2*zeta(1,4) - zeta(2,2) - & 3*zeta(2,3) - zeta(2,4) - 2*zeta(3,3) - 2*zeta(3,4)) & *D2345(DD00112) + & (2*zeta(1,1) + zeta(1,3) + 2*zeta(1,4) - 2*zeta(2,2) - & 3*zeta(2,3) - 2*zeta(2,4) - zeta(3,3) - zeta(3,4))* & D2345(DD00122)) E(EE1124) = -(dabbr58*eta(1)) - & 2*dabbr61*(zeta(1,2) + zeta(2,2) + zeta(2,3) + & zeta(2,4)) - 2*dabbr59* & (zeta(1,4) + zeta(2,4) + zeta(3,4) + zeta(4,4)) - & eta(4)*D1235(DD1123) + & 2*(2*dabbr60*(zeta(1,1) + zeta(1,3) - zeta(2,2) - & zeta(2,3) - 2*zeta(2,4) - zeta(3,4) - zeta(4,4)) + & zeta(3,4)*D1235(DD00112) + & zeta(4,4)*D1234(DD00112) + & zeta(2,2)*D1245(DD00113) + & zeta(2,3)*D1235(DD00113) + & 2*zeta(1,3)*D1235(DD00123) + & (2*zeta(1,1) + zeta(1,2) + 2*zeta(1,3) - zeta(2,2) - & zeta(2,3) - 3*zeta(2,4) - 2*zeta(3,4) - 2*zeta(4,4)) & *D2345(DD00113) + & (2*zeta(1,1) + 2*zeta(1,3) + zeta(1,4) - 2*zeta(2,2) - & 2*zeta(2,3) - 3*zeta(2,4) - zeta(3,4) - zeta(4,4))* & D2345(DD00133)) E(EE1133) = -(dabbr62*eta(1)) - & 4*dabbr47*(zeta(1,3) + zeta(2,3) + zeta(3,3) + & zeta(3,4)) - eta(3)*D1245(DD1122) - & eta(5)*D1234(DD1133) + & 4*(-2*dabbr46*(zeta(2,3) + zeta(3,3) + zeta(3,4)) + & zeta(1,1)*D2345(DD0022) + & zeta(1,2)*D2345(DD0022) - & zeta(1,3)*D2345(DD0022) + & zeta(1,4)*D2345(DD0022) + & zeta(2,3)*D1245(DD00112) + & zeta(3,4)*D1234(DD00113) + & zeta(1,2)*D1245(DD00122) + & zeta(1,4)*D1234(DD00133) + & zeta(1,1)*D2345(DD00122) + & zeta(1,2)*D2345(DD00122) - & zeta(1,3)*D2345(DD00122) + & zeta(1,4)*D2345(DD00122) + & (zeta(1,1) + zeta(1,2) + zeta(1,4) - zeta(2,3) - & zeta(3,3) - zeta(3,4))*D2345(DD00222) + & (zeta(1,1) + zeta(1,2) - zeta(1,3) + zeta(1,4))* & D2345(DD00223)) E(EE1134) = -(dabbr63*eta(1)) - & 2*dabbr66*(zeta(1,3) + zeta(2,3) + zeta(3,3) + & zeta(3,4)) - 2*dabbr64* & (zeta(1,4) + zeta(2,4) + zeta(3,4) + zeta(4,4)) - & eta(3)*D1245(DD1123) + & 2*(2*dabbr65*(zeta(1,1) + zeta(1,2) - zeta(2,3) - & zeta(2,4) - zeta(3,3) - 2*zeta(3,4) - zeta(4,4)) + & zeta(2,4)*D1245(DD00112) + & zeta(2,3)*D1245(DD00113) + & zeta(3,3)*D1235(DD00113) + & zeta(4,4)*D1234(DD00113) + & 2*zeta(1,2)*D1245(DD00123) + & (2*zeta(1,1) + 2*zeta(1,2) + zeta(1,3) - zeta(2,3) - & 2*zeta(2,4) - zeta(3,3) - 3*zeta(3,4) - 2*zeta(4,4)) & *D2345(DD00223) + & (2*zeta(1,1) + 2*zeta(1,2) + zeta(1,4) - 2*zeta(2,3) - & zeta(2,4) - 2*zeta(3,3) - 3*zeta(3,4) - zeta(4,4))* & D2345(DD00233)) E(EE1144) = -(dabbr67*eta(1)) - & 4*dabbr51*(zeta(1,4) + zeta(2,4) + zeta(3,4) + & zeta(4,4)) - eta(3)*D1245(DD1133) - & eta(4)*D1235(DD1133) + & 4*(-2*dabbr52*(zeta(2,4) + zeta(3,4) + zeta(4,4)) + & zeta(1,1)*D2345(DD0033) + & zeta(1,2)*D2345(DD0033) + & zeta(1,3)*D2345(DD0033) - & zeta(1,4)*D2345(DD0033) + & zeta(2,4)*D1245(DD00113) + & zeta(3,4)*D1235(DD00113) + & zeta(1,2)*D1245(DD00133) + & zeta(1,3)*D1235(DD00133) + & zeta(1,1)*D2345(DD00133) + & zeta(1,2)*D2345(DD00133) + & zeta(1,3)*D2345(DD00133) - & zeta(1,4)*D2345(DD00133) + & (zeta(1,1) + zeta(1,2) + zeta(1,3) - zeta(1,4))* & D2345(DD00233) + & (zeta(1,1) + zeta(1,2) + zeta(1,3) - zeta(2,4) - & zeta(3,4) - zeta(4,4))*D2345(DD00333)) E(EE1222) = dabbr68*eta(1) - & eta(4)*D1235(DD1222) - & eta(5)*D1234(DD1222) + & 2*(3*dabbr43*(zeta(1,2) + zeta(2,2) + zeta(2,3) + & zeta(2,4)) + zeta(1,1)*D1345(DD00111) + & 3*zeta(2,3)*D1235(DD00122) + & 3*zeta(2,4)*D1234(DD00122) + & zeta(1,3)*D1235(DD00222) + & zeta(1,4)*D1234(DD00222) - & (zeta(1,1) - 2*zeta(1,2) + zeta(1,3) + zeta(1,4) - & 3*(zeta(2,2) + zeta(2,3) + zeta(2,4)))* & D2345(DD00111)) E(EE1223) = dabbr69*eta(1) - & eta(5)*D1234(DD1223) + & 2*(2*dabbr71*(zeta(1,2) + zeta(2,2) + zeta(2,3) + & zeta(2,4)) + & dabbr70*(zeta(1,3) + zeta(2,3) + zeta(3,3) + & zeta(3,4)) + zeta(1,1)*D1345(DD00112) + & zeta(3,3)*D1235(DD00122) + & zeta(3,4)*D1234(DD00122) + & 2*zeta(2,4)*D1234(DD00123) + & zeta(1,4)*D1234(DD00223) + & (-zeta(1,1) + zeta(1,2) - zeta(1,4) + 2*zeta(2,2) + & 3*zeta(2,3) + 2*zeta(2,4) + zeta(3,3) + zeta(3,4))* & D2345(DD00112)) E(EE1224) = dabbr72*eta(1) - & eta(4)*D1235(DD1223) + & 2*(2*dabbr74*(zeta(1,2) + zeta(2,2) + zeta(2,3) + & zeta(2,4)) + & dabbr73*(zeta(1,4) + zeta(2,4) + zeta(3,4) + & zeta(4,4)) + zeta(1,1)*D1345(DD00113) + & zeta(3,4)*D1235(DD00122) + & zeta(4,4)*D1234(DD00122) + & 2*zeta(2,3)*D1235(DD00123) + & zeta(1,3)*D1235(DD00223) + & (-zeta(1,1) + zeta(1,2) - zeta(1,3) + 2*zeta(2,2) + & 2*zeta(2,3) + 3*zeta(2,4) + zeta(3,4) + zeta(4,4))* & D2345(DD00113)) E(EE1233) = dabbr75*eta(1) - & eta(5)*D1234(DD1233) + & 2*(dabbr77*(zeta(1,2) + zeta(2,2) + zeta(2,3) + & zeta(2,4)) + & 2*dabbr76*(zeta(1,3) + zeta(2,3) + zeta(3,3) + & zeta(3,4)) + zeta(1,1)*D1345(DD00122) + & zeta(2,2)*D1245(DD00122) + & 2*zeta(3,4)*D1234(DD00123) + & zeta(2,4)*D1234(DD00133) + & zeta(1,4)*D1234(DD00233) + & (-zeta(1,1) + zeta(1,3) - zeta(1,4) + zeta(2,2) + & 3*zeta(2,3) + zeta(2,4) + 2*(zeta(3,3) + zeta(3,4))) & *D2345(DD00122)) E(EE1234) = dabbr78*eta(1) + & 2*(dabbr81*(zeta(1,2) + zeta(2,2) + zeta(2,3) + & zeta(2,4)) + & dabbr80*(zeta(1,3) + zeta(2,3) + zeta(3,3) + & zeta(3,4)) + & dabbr79*(zeta(1,4) + zeta(2,4) + zeta(3,4) + & zeta(4,4)) + zeta(1,1)*D1345(DD00123) + & zeta(2,2)*D1245(DD00123) + & zeta(3,3)*D1235(DD00123) + & zeta(4,4)*D1234(DD00123) + & (-zeta(1,1) + zeta(2,2) + 2*zeta(2,3) + 2*zeta(2,4) + & zeta(3,3) + 2*zeta(3,4) + zeta(4,4))* & D2345(DD00123)) E(EE1244) = dabbr82*eta(1) - & eta(4)*D1235(DD1233) + & 2*(dabbr84*(zeta(1,2) + zeta(2,2) + zeta(2,3) + & zeta(2,4)) + & 2*dabbr83*(zeta(1,4) + zeta(2,4) + zeta(3,4) + & zeta(4,4)) + 2*zeta(3,4)*D1235(DD00123) + & zeta(1,1)*D1345(DD00133) + & zeta(2,2)*D1245(DD00133) + & zeta(2,3)*D1235(DD00133) + & zeta(1,3)*D1235(DD00233) + & (-zeta(1,1) - zeta(1,3) + zeta(1,4) + zeta(2,2) + & zeta(2,3) + 3*zeta(2,4) + 2*(zeta(3,4) + zeta(4,4))) & *D2345(DD00133)) E(EE1333) = dabbr85*eta(1) - & eta(3)*D1245(DD1222) - & eta(5)*D1234(DD1333) + & 2*(3*dabbr46*(zeta(1,3) + zeta(2,3) + zeta(3,3) + & zeta(3,4)) + 3*zeta(2,3)*D1245(DD00122) + & 3*zeta(3,4)*D1234(DD00133) + & zeta(1,1)*D1345(DD00222) + & zeta(1,2)*D1245(DD00222) + & zeta(1,4)*D1234(DD00333) - & (zeta(1,1) + zeta(1,2) - 2*zeta(1,3) + zeta(1,4) - & 3*(zeta(2,3) + zeta(3,3) + zeta(3,4)))* & D2345(DD00222)) E(EE1334) = dabbr86*eta(1) - & eta(3)*D1245(DD1223) + & 2*(2*dabbr88*(zeta(1,3) + zeta(2,3) + zeta(3,3) + & zeta(3,4)) + & dabbr87*(zeta(1,4) + zeta(2,4) + zeta(3,4) + & zeta(4,4)) + zeta(2,4)*D1245(DD00122) + & 2*zeta(2,3)*D1245(DD00123) + & zeta(4,4)*D1234(DD00133) + & zeta(1,1)*D1345(DD00223) + & zeta(1,2)*D1245(DD00223) + & (-zeta(1,1) - zeta(1,2) + zeta(1,3) + 2*zeta(2,3) + & zeta(2,4) + 2*zeta(3,3) + 3*zeta(3,4) + zeta(4,4))* & D2345(DD00223)) E(EE1344) = dabbr89*eta(1) - & eta(3)*D1245(DD1233) + & 2*(dabbr91*(zeta(1,3) + zeta(2,3) + zeta(3,3) + & zeta(3,4)) + & 2*dabbr90*(zeta(1,4) + zeta(2,4) + zeta(3,4) + & zeta(4,4)) + 2*zeta(2,4)*D1245(DD00123) + & zeta(2,3)*D1245(DD00133) + & zeta(3,3)*D1235(DD00133) + & zeta(1,1)*D1345(DD00233) + & zeta(1,2)*D1245(DD00233) + & (-zeta(1,1) - zeta(1,2) + zeta(1,4) + zeta(2,3) + & 2*zeta(2,4) + zeta(3,3) + 3*zeta(3,4) + 2*zeta(4,4)) & *D2345(DD00233)) E(EE1444) = dabbr92*eta(1) - & eta(3)*D1245(DD1333) - & eta(4)*D1235(DD1333) + & 2*(3*dabbr52*(zeta(1,4) + zeta(2,4) + zeta(3,4) + & zeta(4,4)) + 3*zeta(2,4)*D1245(DD00133) + & 3*zeta(3,4)*D1235(DD00133) + & zeta(1,1)*D1345(DD00333) + & zeta(1,2)*D1245(DD00333) + & zeta(1,3)*D1235(DD00333) - & (zeta(1,1) + zeta(1,2) + zeta(1,3) - 2*zeta(1,4) - & 3*(zeta(2,4) + zeta(3,4) + zeta(4,4)))* & D2345(DD00333)) E(EE2222) = -(eta(2)*D1345(DD1111)) - & eta(4)*D1235(DD2222) - & eta(5)*D1234(DD2222) - & eta(1)*D2345(DD1111) + & 8*zeta(1,2)*D1345(DD00111) + & 8*zeta(2,3)*D1235(DD00222) + & 8*zeta(2,4)*D1234(DD00222) - & 8*(zeta(1,2) + zeta(2,2) + zeta(2,3) + zeta(2,4))* & D2345(DD00111) E(EE2223) = -(eta(2)*D1345(DD1112)) - & eta(5)*D1234(DD2223) - & eta(1)*D2345(DD1112) + & 2*zeta(1,3)*D1345(DD00111) + & 6*zeta(1,2)*D1345(DD00112) + & 2*zeta(3,3)*D1235(DD00222) + & 2*zeta(3,4)*D1234(DD00222) + & 6*zeta(2,4)*D1234(DD00223) - & 2*(zeta(1,3) + zeta(2,3) + zeta(3,3) + zeta(3,4))* & D2345(DD00111) - & 6*(zeta(1,2) + zeta(2,2) + zeta(2,3) + zeta(2,4))* & D2345(DD00112) E(EE2224) = -(eta(2)*D1345(DD1113)) - & eta(4)*D1235(DD2223) - & eta(1)*D2345(DD1113) + & 2*zeta(1,4)*D1345(DD00111) + & 6*zeta(1,2)*D1345(DD00113) + & 2*zeta(3,4)*D1235(DD00222) + & 2*zeta(4,4)*D1234(DD00222) + & 6*zeta(2,3)*D1235(DD00223) - & 2*(zeta(1,4) + zeta(2,4) + zeta(3,4) + zeta(4,4))* & D2345(DD00111) - & 6*(zeta(1,2) + zeta(2,2) + zeta(2,3) + zeta(2,4))* & D2345(DD00113) E(EE2233) = -(eta(2)*D1345(DD1122)) - & eta(5)*D1234(DD2233) - & eta(1)*D2345(DD1122) + & 4*(zeta(1,3)*D1345(DD00112) + & zeta(1,2)*D1345(DD00122) + & zeta(3,4)*D1234(DD00223) + & zeta(2,4)*D1234(DD00233) - & (zeta(1,3) + zeta(2,3) + zeta(3,3) + zeta(3,4))* & D2345(DD00112) - & (zeta(1,2) + zeta(2,2) + zeta(2,3) + zeta(2,4))* & D2345(DD00122)) E(EE2234) = -(eta(2)*D1345(DD1123)) - & eta(1)*D2345(DD1123) + & 2*(zeta(1,4)*D1345(DD00112) + & zeta(1,3)*D1345(DD00113) + & 2*zeta(1,2)*D1345(DD00123) + & zeta(3,3)*D1235(DD00223) + & zeta(4,4)*D1234(DD00223) - & (zeta(1,4) + zeta(2,4) + zeta(3,4) + zeta(4,4))* & D2345(DD00112) - & (zeta(1,3) + zeta(2,3) + zeta(3,3) + zeta(3,4))* & D2345(DD00113) - & 2*(zeta(1,2) + zeta(2,2) + zeta(2,3) + zeta(2,4))* & D2345(DD00123)) E(EE2244) = -(eta(2)*D1345(DD1133)) - & eta(4)*D1235(DD2233) - & eta(1)*D2345(DD1133) + & 4*(zeta(1,4)*D1345(DD00113) + & zeta(1,2)*D1345(DD00133) + & zeta(3,4)*D1235(DD00223) + & zeta(2,3)*D1235(DD00233) - & (zeta(1,4) + zeta(2,4) + zeta(3,4) + zeta(4,4))* & D2345(DD00113) - & (zeta(1,2) + zeta(2,2) + zeta(2,3) + zeta(2,4))* & D2345(DD00133)) E(EE2333) = -(eta(2)*D1345(DD1222)) - & eta(5)*D1234(DD2333) - & eta(1)*D2345(DD1222) + & 6*zeta(1,3)*D1345(DD00122) + & 2*zeta(1,2)*D1345(DD00222) + & 2*zeta(2,2)*D1245(DD00222) + & 6*zeta(3,4)*D1234(DD00233) + & 2*zeta(2,4)*D1234(DD00333) - & 6*(zeta(1,3) + zeta(2,3) + zeta(3,3) + zeta(3,4))* & D2345(DD00122) - & 2*(zeta(1,2) + zeta(2,2) + zeta(2,3) + zeta(2,4))* & D2345(DD00222) E(EE2334) = -(eta(2)*D1345(DD1223)) - & eta(1)*D2345(DD1223) + & 2*(zeta(1,4)*D1345(DD00122) + & 2*zeta(1,3)*D1345(DD00123) + & zeta(1,2)*D1345(DD00223) + & zeta(2,2)*D1245(DD00223) + & zeta(4,4)*D1234(DD00233) - & (zeta(1,4) + zeta(2,4) + zeta(3,4) + zeta(4,4))* & D2345(DD00122) - & 2*(zeta(1,3) + zeta(2,3) + zeta(3,3) + zeta(3,4))* & D2345(DD00123) - & (zeta(1,2) + zeta(2,2) + zeta(2,3) + zeta(2,4))* & D2345(DD00223)) E(EE2344) = -(eta(2)*D1345(DD1233)) - & eta(1)*D2345(DD1233) + & 2*(2*zeta(1,4)*D1345(DD00123) + & zeta(1,3)*D1345(DD00133) + & zeta(1,2)*D1345(DD00233) + & zeta(2,2)*D1245(DD00233) + & zeta(3,3)*D1235(DD00233) - & 2*(zeta(1,4) + zeta(2,4) + zeta(3,4) + zeta(4,4))* & D2345(DD00123) - & (zeta(1,3) + zeta(2,3) + zeta(3,3) + zeta(3,4))* & D2345(DD00133) - & (zeta(1,2) + zeta(2,2) + zeta(2,3) + zeta(2,4))* & D2345(DD00233)) E(EE2444) = -(eta(2)*D1345(DD1333)) - & eta(4)*D1235(DD2333) - & eta(1)*D2345(DD1333) + & 6*zeta(1,4)*D1345(DD00133) + & 6*zeta(3,4)*D1235(DD00233) + & 2*zeta(1,2)*D1345(DD00333) + & 2*zeta(2,2)*D1245(DD00333) + & 2*zeta(2,3)*D1235(DD00333) - & 6*(zeta(1,4) + zeta(2,4) + zeta(3,4) + zeta(4,4))* & D2345(DD00133) - & 2*(zeta(1,2) + zeta(2,2) + zeta(2,3) + zeta(2,4))* & D2345(DD00333) E(EE3333) = -(eta(2)*D1345(DD2222)) - & eta(3)*D1245(DD2222) - & eta(5)*D1234(DD3333) - & eta(1)*D2345(DD2222) + & 8*zeta(1,3)*D1345(DD00222) + & 8*zeta(2,3)*D1245(DD00222) + & 8*zeta(3,4)*D1234(DD00333) - & 8*(zeta(1,3) + zeta(2,3) + zeta(3,3) + zeta(3,4))* & D2345(DD00222) E(EE3334) = -(eta(2)*D1345(DD2223)) - & eta(3)*D1245(DD2223) - & eta(1)*D2345(DD2223) + & 2*zeta(1,4)*D1345(DD00222) + & 2*zeta(2,4)*D1245(DD00222) + & 6*zeta(1,3)*D1345(DD00223) + & 6*zeta(2,3)*D1245(DD00223) + & 2*zeta(4,4)*D1234(DD00333) - & 2*(zeta(1,4) + zeta(2,4) + zeta(3,4) + zeta(4,4))* & D2345(DD00222) - & 6*(zeta(1,3) + zeta(2,3) + zeta(3,3) + zeta(3,4))* & D2345(DD00223) E(EE3344) = -(eta(2)*D1345(DD2233)) - & eta(3)*D1245(DD2233) - & eta(1)*D2345(DD2233) + & 4*(zeta(1,4)*D1345(DD00223) + & zeta(2,4)*D1245(DD00223) + & zeta(1,3)*D1345(DD00233) + & zeta(2,3)*D1245(DD00233) - & (zeta(1,4) + zeta(2,4) + zeta(3,4) + zeta(4,4))* & D2345(DD00223) - & (zeta(1,3) + zeta(2,3) + zeta(3,3) + zeta(3,4))* & D2345(DD00233)) E(EE3444) = -(eta(2)*D1345(DD2333)) - & eta(3)*D1245(DD2333) - & eta(1)*D2345(DD2333) + & 6*zeta(1,4)*D1345(DD00233) + & 6*zeta(2,4)*D1245(DD00233) + & 2*zeta(1,3)*D1345(DD00333) + & 2*zeta(2,3)*D1245(DD00333) + & 2*zeta(3,3)*D1235(DD00333) - & 6*(zeta(1,4) + zeta(2,4) + zeta(3,4) + zeta(4,4))* & D2345(DD00233) - & 2*(zeta(1,3) + zeta(2,3) + zeta(3,3) + zeta(3,4))* & D2345(DD00333) E(EE4444) = -(eta(2)*D1345(DD3333)) - & eta(3)*D1245(DD3333) - & eta(4)*D1235(DD3333) - & eta(1)*D2345(DD3333) + & 8*zeta(1,4)*D1345(DD00333) + & 8*zeta(2,4)*D1245(DD00333) + & 8*zeta(3,4)*D1235(DD00333) - & 8*(zeta(1,4) + zeta(2,4) + zeta(3,4) + zeta(4,4))* & D2345(DD00333) if( dump ) call XDumpCoeff(5, E) end LoopTools-2.16/src/E/PaxHeaders/Ecoeffb.F0000644000000000000000000000007413262607211015072 xustar0030 atime=1648161785.723698464 30 ctime=1648161793.715764879 LoopTools-2.16/src/E/Ecoeffb.F0000644000000000000000000003554013262607211016014 0ustar00rootroot00000000000000* Ecoeffb.F * the five-point tensor coefficients via Passarino-Veltman decomposition * this file is part of LoopTools * written by M. Rauch * last modified 9 Apr 18 th #include "externals.h" #include "types.h" #define npoint 5 #include "defs.h" subroutine XEcoeffb(E, para, D2345, D1345, D1245, D1235, D1234) implicit none ComplexType E(*) ComplexType D2345(*), D1345(*), D1245(*), D1235(*), D1234(*) ArgType para(1,*) #include "lt.h" memindex XDget external XDget ArgType p1, p2, p3, p4, p5 ArgType p1p2, p2p3, p3p4, p4p5, p5p1 ArgType m1, m2, m3, m4, m5 ArgQuad f1, f2, f3, f4 ComplexQuad di, d0sum ComplexQuad d1i, d1sum, d2i, d2sum, dii ComplexQuad d1ii, d2ii, diii ComplexQuad d00sum, d22sum, d33sum ComplexQuad in(4) logical dump ArgQuad G(4,4), Ginv(4,4) common /XInvGramE/ Ginv integer perm(4) #define IN(i) in(perm(i)) #define OUT(i) in(i) #define SOLVE_SETUP XInverse(4, G,4, Ginv,4, perm) #define SOLVER(b) XSolve(4, G,4, b) serial = serial + 1 dump = ibits(debugkey, DebugE, 1) .ne. 0 .and. & serial .ge. debugfrom .and. serial .le. debugto if( dump ) call XDumpPara(5, para) m1 = M(1) m2 = M(2) m3 = M(3) m4 = M(4) m5 = M(5) p1 = P(1) p2 = P(2) p3 = P(3) p4 = P(4) p5 = P(5) p1p2 = P(6) p2p3 = P(7) p3p4 = P(8) p4p5 = P(9) p5p1 = P(10) f1 = m2 f1 = f1 - m1 f1 = f1 - p1 f2 = m3 f2 = f2 - m1 f2 = f2 - p1p2 f3 = m4 f3 = f3 - m1 f3 = f3 - p4p5 f4 = m5 f4 = f4 - m1 f4 = f4 - p5 * build up G and calculate matrix decomposition and inverse Y G(1,1) = 2*p1 G(2,2) = 2*p1p2 G(3,3) = 2*p4p5 G(4,4) = 2*p5 G(1,2) = p1 G(1,2) = G(1,2) + p1p2 G(1,2) = G(1,2) - p2 G(2,1) = G(1,2) G(1,3) = p1 G(1,3) = G(1,3) - p2p3 G(1,3) = G(1,3) + p4p5 G(3,1) = G(1,3) G(1,4) = p1 G(1,4) = G(1,4) - p5p1 G(1,4) = G(1,4) + p5 G(4,1) = G(1,4) G(2,3) = p1p2 G(2,3) = G(2,3) - p3 G(2,3) = G(2,3) + p4p5 G(3,2) = G(2,3) G(2,4) = p1p2 G(2,4) = G(2,4) - p3p4 G(2,4) = G(2,4) + p5 G(4,2) = G(2,4) G(3,4) = p5 G(3,4) = G(3,4) + p4p5 G(3,4) = G(3,4) - p4 G(4,3) = G(3,4) call SOLVE_SETUP di = D2345(dd1) + D2345(dd2) + D2345(dd3) d0sum = di + D2345(dd0) d1i = D2345(dd11) + D2345(dd12) + D2345(dd13) d1sum = d1i + D2345(dd1) d2i = D2345(dd12) + D2345(dd22) + D2345(dd23) d2sum = d2i + D2345(dd2) dii = d1i + d2i + D2345(dd13) + D2345(dd23) + D2345(dd33) d1ii = D2345(dd111) + D2345(dd122) + & D2345(dd133) + 2*(D2345(dd112) + & D2345(dd113) + D2345(dd123)) d2ii = D2345(dd112) + D2345(dd222) + & D2345(dd233) + 2*(D2345(dd122) + & D2345(dd123) + D2345(dd223)) diii = d1ii + d2ii + & D2345(dd113) + D2345(dd223) + & D2345(dd333) + 2*(D2345(dd123) + & D2345(dd133) + D2345(dd233)) d00sum = D2345(dd00) + & D2345(dd001) + D2345(dd002) + D2345(dd003) d22sum = D2345(dd22) + & D2345(dd122) + D2345(dd222) + D2345(dd223) d33sum = D2345(dd33) + & D2345(dd133) + D2345(dd233) + D2345(dd333) call XE0func(E(ee0), para, & D2345, D1345, D1245, D1235, D1234, 1) IN(1) = f1*E(ee0) - D2345(dd0) + D1345(dd0) IN(2) = f2*E(ee0) - D2345(dd0) + D1245(dd0) IN(3) = f3*E(ee0) - D2345(dd0) + D1235(dd0) IN(4) = f4*E(ee0) - D2345(dd0) + D1234(dd0) call SOLVER(in) E(ee1) = OUT(1) E(ee2) = OUT(2) E(ee3) = OUT(3) E(ee4) = OUT(4) E(ee00) = 0 IN(1) = f1*E(ee1) + d0sum IN(2) = f2*E(ee1) + d0sum + D1245(dd1) IN(3) = f3*E(ee1) + d0sum + D1235(dd1) IN(4) = f4*E(ee1) + d0sum + D1234(dd1) call SOLVER(in) E(ee11) = OUT(1) E(ee12) = OUT(2) E(ee13) = OUT(3) E(ee14) = OUT(4) IN(1) = f1*E(ee2) - D2345(dd1) + D1345(dd1) IN(2) = f2*E(ee2) - D2345(dd1) IN(3) = f3*E(ee2) - D2345(dd1) + D1235(dd2) IN(4) = f4*E(ee2) - D2345(dd1) + D1234(dd2) call SOLVER(in) E(ee12) = .5D0*(E(ee12) + OUT(1)) E(ee22) = OUT(2) E(ee23) = OUT(3) E(ee24) = OUT(4) IN(1) = f1*E(ee3) - D2345(dd2) + D1345(dd2) IN(2) = f2*E(ee3) - D2345(dd2) + D1245(dd2) IN(3) = f3*E(ee3) - D2345(dd2) IN(4) = f4*E(ee3) - D2345(dd2) + D1234(dd3) call SOLVER(in) E(ee13) = .5D0*(E(ee13) + OUT(1)) E(ee23) = .5D0*(E(ee23) + OUT(2)) E(ee33) = OUT(3) E(ee34) = OUT(4) IN(1) = f1*E(ee4) - D2345(dd3) + D1345(dd3) IN(2) = f2*E(ee4) - D2345(dd3) + D1245(dd3) IN(3) = f3*E(ee4) - D2345(dd3) + D1235(dd3) IN(4) = f4*E(ee4) - D2345(dd3) call SOLVER(in) E(ee14) = .5D0*(E(ee14) + OUT(1)) E(ee24) = .5D0*(E(ee24) + OUT(2)) E(ee34) = .5D0*(E(ee34) + OUT(3)) E(ee44) = OUT(4) E(ee001) = 0 E(ee002) = 0 E(ee003) = 0 E(ee004) = 0 d0sum = d0sum + di + dii IN(1) = f1*E(ee11) - d0sum - & 2*Ginv(1,1)*(D2345(dd00) - D1345(dd00)) IN(2) = f2*E(ee11) - d0sum + D1245(dd11) - & 2*Ginv(1,1)*(D2345(dd00) - D1245(dd00)) IN(3) = f3*E(ee11) - d0sum + D1235(dd11) - & 2*Ginv(1,1)*(D2345(dd00) - D1235(dd00)) IN(4) = f4*E(ee11) - d0sum + D1234(dd11) - & 2*Ginv(1,1)*(D2345(dd00) - D1234(dd00)) call SOLVER(in) E(ee111) = OUT(1) E(ee112) = OUT(2) E(ee113) = OUT(3) E(ee114) = OUT(4) IN(1) = f1*E(ee22) - D2345(dd11) + D1345(dd11) - & 2*Ginv(2,2)*(D2345(dd00) - D1345(dd00)) IN(2) = f2*E(ee22) - D2345(dd11) - & 2*Ginv(2,2)*(D2345(dd00) - D1245(dd00)) IN(3) = f3*E(ee22) - D2345(dd11) + D1235(dd22) - & 2*Ginv(2,2)*(D2345(dd00) - D1235(dd00)) IN(4) = f4*E(ee22) - D2345(dd11) + D1234(dd22) - & 2*Ginv(2,2)*(D2345(dd00) - D1234(dd00)) call SOLVER(in) E(ee122) = OUT(1) E(ee222) = OUT(2) E(ee223) = OUT(3) E(ee224) = OUT(4) IN(1) = f1*E(ee33) - D2345(dd22) + D1345(dd22) - & 2*Ginv(3,3)*(D2345(dd00) - D1345(dd00)) IN(2) = f2*E(ee33) - D2345(dd22) + D1245(dd22) - & 2*Ginv(3,3)*(D2345(dd00) - D1245(dd00)) IN(3) = f3*E(ee33) - D2345(dd22) - & 2*Ginv(3,3)*(D2345(dd00) - D1235(dd00)) IN(4) = f4*E(ee33) - D2345(dd22) + D1234(dd33) - & 2*Ginv(3,3)*(D2345(dd00) - D1234(dd00)) call SOLVER(in) E(ee133) = OUT(1) E(ee233) = OUT(2) E(ee333) = OUT(3) E(ee334) = OUT(4) IN(1) = f1*E(ee44) - D2345(dd33) + D1345(dd33) - & 2*Ginv(4,4)*(D2345(dd00) - D1345(dd00)) IN(2) = f2*E(ee44) - D2345(dd33) + D1245(dd33) - & 2*Ginv(4,4)*(D2345(dd00) - D1245(dd00)) IN(3) = f3*E(ee44) - D2345(dd33) + D1235(dd33) - & 2*Ginv(4,4)*(D2345(dd00) - D1235(dd00)) IN(4) = f4*E(ee44) - D2345(dd33) - & 2*Ginv(4,4)*(D2345(dd00) - D1234(dd00)) call SOLVER(in) E(ee144) = OUT(1) E(ee244) = OUT(2) E(ee344) = OUT(3) E(ee444) = OUT(4) IN(1) = f1*E(ee12) + d1sum - & 2*Ginv(1,2)*(D2345(dd00) - D1345(dd00)) IN(2) = f2*E(ee12) + d1sum - & 2*Ginv(1,2)*(D2345(dd00) - D1245(dd00)) IN(3) = f3*E(ee12) + d1sum + D1235(dd12) - & 2*Ginv(1,2)*(D2345(dd00) - D1235(dd00)) IN(4) = f4*E(ee12) + d1sum + D1234(dd12) - & 2*Ginv(1,2)*(D2345(dd00) - D1234(dd00)) call SOLVER(in) E(ee112) = .5D0*(E(ee112) + OUT(1)) E(ee122) = .5D0*(E(ee122) + OUT(2)) E(ee123) = OUT(3) E(ee124) = OUT(4) IN(1) = f1*E(ee34) - D2345(dd23) + D1345(dd23) - & 2*Ginv(3,4)*(D2345(dd00) - D1345(dd00)) IN(2) = f2*E(ee34) - D2345(dd23) + D1245(dd23) - & 2*Ginv(3,4)*(D2345(dd00) - D1245(dd00)) IN(3) = f3*E(ee34) - D2345(dd23) - & 2*Ginv(3,4)*(D2345(dd00) - D1235(dd00)) IN(4) = f4*E(ee34) - D2345(dd23) - & 2*Ginv(3,4)*(D2345(dd00) - D1234(dd00)) call SOLVER(in) E(ee134) = OUT(1) E(ee234) = OUT(2) E(ee334) = .5D0*(E(ee334) + OUT(3)) E(ee344) = .5D0*(E(ee344) + OUT(4)) E(ee0000) = 0 E(ee0011) = 0 E(ee0012) = 0 E(ee0013) = 0 E(ee0014) = 0 E(ee0022) = 0 E(ee0023) = 0 E(ee0024) = 0 E(ee0033) = 0 E(ee0034) = 0 E(ee0044) = 0 d0sum = d0sum + di + 2*dii + diii IN(1) = f1*E(ee111) + d0sum + & 6*Ginv(1,1)*d00sum IN(2) = f2*E(ee111) + d0sum + D1245(dd111) + & 6*Ginv(1,1)*(d00sum + D1245(dd001)) IN(3) = f3*E(ee111) + d0sum + D1235(dd111) + & 6*Ginv(1,1)*(d00sum + D1235(dd001)) IN(4) = f4*E(ee111) + d0sum + D1234(dd111) + & 6*Ginv(1,1)*(d00sum + D1234(dd001)) call SOLVER(in) E(ee1111) = OUT(1) E(ee1112) = OUT(2) E(ee1113) = OUT(3) E(ee1114) = OUT(4) IN(1) = f1*E(ee222) - D2345(dd111) + D1345(dd111) - & 6*Ginv(2,2)*(D2345(dd001) - D1345(dd001)) IN(2) = f2*E(ee222) - D2345(dd111) - & 6*Ginv(2,2)*D2345(dd001) IN(3) = f3*E(ee222) - D2345(dd111) + D1235(dd222) - & 6*Ginv(2,2)*(D2345(dd001) - D1235(dd002)) IN(4) = f4*E(ee222) - D2345(dd111) + D1234(dd222) - & 6*Ginv(2,2)*(D2345(dd001) - D1234(dd002)) call SOLVER(in) E(ee1222) = OUT(1) E(ee2222) = OUT(2) E(ee2223) = OUT(3) E(ee2224) = OUT(4) IN(1) = f1*E(ee333) - D2345(dd222) + D1345(dd222) - & 6*Ginv(3,3)*(D2345(dd002) - D1345(dd002)) IN(2) = f2*E(ee333) - D2345(dd222) + D1245(dd222) - & 6*Ginv(3,3)*(D2345(dd002) - D1245(dd002)) IN(3) = f3*E(ee333) - D2345(dd222) - & 6*Ginv(3,3)*D2345(dd002) IN(4) = f4*E(ee333) - D2345(dd222) + D1234(dd333) - & 6*Ginv(3,3)*(D2345(dd002) - D1234(dd003)) call SOLVER(in) E(ee1333) = OUT(1) E(ee2333) = OUT(2) E(ee3333) = OUT(3) E(ee3334) = OUT(4) IN(1) = f1*E(ee444) - D2345(dd333) + D1345(dd333) - & 6*Ginv(4,4)*(D2345(dd003) - D1345(dd003)) IN(2) = f2*E(ee444) - D2345(dd333) + D1245(dd333) - & 6*Ginv(4,4)*(D2345(dd003) - D1245(dd003)) IN(3) = f3*E(ee444) - D2345(dd333) + D1235(dd333) - & 6*Ginv(4,4)*(D2345(dd003) - D1235(dd003)) IN(4) = f4*E(ee444) - D2345(dd333) - & 6*Ginv(4,4)*D2345(dd003) call SOLVER(in) E(ee1444) = OUT(1) E(ee2444) = OUT(2) E(ee3444) = OUT(3) E(ee4444) = OUT(4) d1sum = d1sum + d1i + d1ii IN(1) = f1*E(ee112) - d1sum - & 2*Ginv(1,1)*(D2345(dd001) - D1345(dd001)) + & 4*Ginv(1,2)*d00sum IN(2) = f2*E(ee112) - d1sum - & 2*Ginv(1,1)*D2345(dd001) + & 4*Ginv(1,2)*(d00sum + D1245(dd001)) IN(3) = f3*E(ee112) - d1sum + D1235(dd112) - & 2*Ginv(1,1)*(D2345(dd001) - D1235(dd002)) + & 4*Ginv(1,2)*(d00sum + D1235(dd001)) IN(4) = f4*E(ee112) - d1sum + D1234(dd112) - & 2*Ginv(1,1)*(D2345(dd001) - D1234(dd002)) + & 4*Ginv(1,2)*(d00sum + D1234(dd001)) call SOLVER(in) E(ee1112) = .5D0*(E(ee1112) + OUT(1)) E(ee1122) = OUT(2) E(ee1123) = OUT(3) E(ee1124) = OUT(4) IN(1) = f1*E(ee223) - D2345(dd112) + D1345(dd112) - & 2*Ginv(2,2)*(D2345(dd002) - D1345(dd002)) - & 4*Ginv(2,3)*(D2345(dd001) - D1345(dd001)) IN(2) = f2*E(ee223) - D2345(dd112) - & 2*Ginv(2,2)*(D2345(dd002) - D1245(dd002)) - & 4*Ginv(2,3)*D2345(dd001) IN(3) = f3*E(ee223) - D2345(dd112) - & 2*Ginv(2,2)*D2345(dd002) - & 4*Ginv(2,3)*(D2345(dd001) - D1235(dd002)) IN(4) = f4*E(ee223) - D2345(dd112) + D1234(dd223) - & 2*Ginv(2,2)*(D2345(dd002) - D1234(dd003)) - & 4*Ginv(2,3)*(D2345(dd001) - D1234(dd002)) call SOLVER(in) E(ee1223) = OUT(1) E(ee2223) = .5D0*(E(ee2223) + OUT(2)) E(ee2233) = OUT(3) E(ee2234) = OUT(4) IN(1) = f1*E(ee334) - D2345(dd223) + D1345(dd223) - & 2*Ginv(3,3)*(D2345(dd003) - D1345(dd003)) - & 4*Ginv(3,4)*(D2345(dd002) - D1345(dd002)) IN(2) = f2*E(ee334) - D2345(dd223) + D1245(dd223) - & 2*Ginv(3,3)*(D2345(dd003) - D1245(dd003)) - & 4*Ginv(3,4)*(D2345(dd002) - D1245(dd002)) IN(3) = f3*E(ee334) - D2345(dd223) - & 2*Ginv(3,3)*(D2345(dd003) - D1235(dd003)) - & 4*Ginv(3,4)*D2345(dd002) IN(4) = f4*E(ee334) - D2345(dd223) - & 2*Ginv(3,3)*D2345(dd003) - & 4*Ginv(3,4)*(D2345(dd002) - D1234(dd003)) call SOLVER(in) E(ee1334) = OUT(1) E(ee2334) = OUT(2) E(ee3334) = .5D0*(E(ee3334) + OUT(3)) E(ee3344) = OUT(4) IN(1) = f1*E(ee144) + d33sum - & 4*Ginv(1,4)*(D2345(dd003) - D1345(dd003)) + & 2*Ginv(4,4)*d00sum IN(2) = f2*E(ee144) + d33sum + D1245(dd133) - & 4*Ginv(1,4)*(D2345(dd003) - D1245(dd003)) + & 2*Ginv(4,4)*(d00sum + D1245(dd001)) IN(3) = f3*E(ee144) + d33sum + D1235(dd133) - & 4*Ginv(1,4)*(D2345(dd003) - D1235(dd003)) + & 2*Ginv(4,4)*(d00sum + D1235(dd001)) IN(4) = f4*E(ee144) + d33sum - & 4*Ginv(1,4)*D2345(dd003) + & 2*Ginv(4,4)*(d00sum + D1234(dd001)) call SOLVER(in) E(ee1144) = OUT(1) E(ee1244) = OUT(2) E(ee1344) = OUT(3) E(ee1444) = .5D0*(E(ee1444) + OUT(4)) d2sum = d2sum + d2i + d2ii IN(1) = f1*E(ee113) - d2sum - & 2*Ginv(1,1)*(D2345(dd002) - D1345(dd002)) + & 4*Ginv(1,3)*d00sum IN(2) = f2*E(ee113) - d2sum + D1245(dd112) - & 2*Ginv(1,1)*(D2345(dd002) - D1245(dd002)) + & 4*Ginv(1,3)*(d00sum + D1245(dd001)) IN(3) = f3*E(ee113) - d2sum - & 2*Ginv(1,1)*D2345(dd002) + & 4*Ginv(1,3)*(d00sum + D1235(dd001)) IN(4) = f4*E(ee113) - d2sum + D1234(dd113) - & 2*Ginv(1,1)*(D2345(dd002) - D1234(dd003)) + & 4*Ginv(1,3)*(d00sum + D1234(dd001)) call SOLVER(in) E(ee1113) = .5D0*(E(ee1113) + OUT(1)) E(ee1123) = .5D0*(E(ee1123) + OUT(2)) E(ee1133) = OUT(3) E(ee1134) = OUT(4) IN(1) = f1*E(ee224) - D2345(dd113) + D1345(dd113) - & 2*Ginv(2,2)*(D2345(dd003) - D1345(dd003)) - & 4*Ginv(2,4)*(D2345(dd001) - D1345(dd001)) IN(2) = f2*E(ee224) - D2345(dd113) - & 2*Ginv(2,2)*(D2345(dd003) - D1245(dd003)) - & 4*Ginv(2,4)*D2345(dd001) IN(3) = f3*E(ee224) - D2345(dd113) + D1235(dd223) - & 2*Ginv(2,2)*(D2345(dd003) - D1235(dd003)) - & 4*Ginv(2,4)*(D2345(dd001) - D1235(dd002)) IN(4) = f4*E(ee224) - D2345(dd113) - & 2*Ginv(2,2)*D2345(dd003) - & 4*Ginv(2,4)*(D2345(dd001) - D1234(dd002)) call SOLVER(in) E(ee1224) = OUT(1) E(ee2224) = .5D0*(E(ee2224) + OUT(2)) E(ee2234) = E(ee2234) + OUT(3) E(ee2244) = OUT(4) IN(1) = f1*E(ee234) - D2345(dd123) + D1345(dd123) - & 2*Ginv(2,3)*(D2345(dd003) - D1345(dd003)) - & 2*Ginv(3,4)*(D2345(dd001) - D1345(dd001)) - & 2*Ginv(2,4)*(D2345(dd002) - D1345(dd002)) IN(2) = f2*E(ee234) - D2345(dd123) - & 2*Ginv(2,3)*(D2345(dd003) - D1245(dd003)) - & 2*Ginv(3,4)*D2345(dd001) - & 2*Ginv(2,4)*(D2345(dd002) - D1245(dd002)) IN(3) = f3*E(ee234) - D2345(dd123) - & 2*Ginv(2,3)*(D2345(dd003) - D1235(dd003)) - & 2*Ginv(3,4)*(D2345(dd001) - D1235(dd002)) - & 2*Ginv(2,4)*D2345(dd002) IN(4) = f4*E(ee234) - D2345(dd123) - & 2*Ginv(2,3)*D2345(dd003) - & 2*Ginv(3,4)*(D2345(dd001) - D1234(dd002)) - & 2*Ginv(2,4)*(D2345(dd002) - D1234(dd003)) call SOLVER(in) E(ee1234) = OUT(1) E(ee2234) = 1/3D0*(E(ee2234) + OUT(2)) E(ee2334) = .5D0*(E(ee2334) + OUT(3)) E(ee2344) = OUT(4) IN(1) = f1*E(ee133) + d22sum - & 4*Ginv(1,3)*(D2345(dd002) - D1345(dd002)) + & 2*Ginv(3,3)*d00sum IN(2) = f2*E(ee133) + d22sum + D1245(dd122) - & 4*Ginv(1,3)*(D2345(dd002) - D1245(dd002)) + & 2*Ginv(3,3)*(d00sum + D1245(dd001)) IN(3) = f3*E(ee133) + d22sum - & 4*Ginv(1,3)*D2345(dd002) + & 2*Ginv(3,3)*(d00sum + D1235(dd001)) IN(4) = f4*E(ee133) + d22sum + D1234(dd133) - & 4*Ginv(1,3)*(D2345(dd002) - D1234(dd003)) + & 2*Ginv(3,3)*(d00sum + D1234(dd001)) call SOLVER(in) E(ee1133) = .5D0*(E(ee1133) + OUT(1)) E(ee1233) = OUT(2) E(ee1333) = .5D0*(E(ee1333) + OUT(3)) E(ee1334) = .5D0*(E(ee1334) + OUT(4)) if( dump ) call XDumpCoeff(5, E) end LoopTools-2.16/src/E/PaxHeaders/Eget.F0000644000000000000000000000007413262577177014446 xustar0030 atime=1648161785.723698464 30 ctime=1648161793.715764879 LoopTools-2.16/src/E/Eget.F0000644000000000000000000004017713262577177015372 0ustar00rootroot00000000000000* Eget.F * retrieve the five-point tensor coefficients * this file is part of LoopTools * written by M. Rauch * last modified 9 Apr 18 th #include "externals.h" #include "types.h" #define npoint 5 #include "defs.h" subroutine XEpara(para, p1, p2, p3, p4, p5, & p1p2, p2p3, p3p4, p4p5, p5p1, m1, m2, m3, m4, m5) implicit none ArgType para(1,*) ArgType p1, p2, p3, p4, p5 ArgType p1p2, p2p3, p3p4, p4p5, p5p1 ArgType m1, m2, m3, m4, m5 #include "lt.h" P(1) = p1 P(2) = p2 P(3) = p3 P(4) = p4 P(5) = p5 P(6) = p1p2 P(7) = p2p3 P(8) = p3p4 P(9) = p4p5 P(10) = p5p1 M(1) = m1 if( abs(M(1)) .lt. minmass ) M(1) = 0 M(2) = m2 if( abs(M(2)) .lt. minmass ) M(2) = 0 M(3) = m3 if( abs(M(3)) .lt. minmass ) M(3) = 0 M(4) = m4 if( abs(M(4)) .lt. minmass ) M(4) = 0 M(5) = m5 if( abs(M(5)) .lt. minmass ) M(5) = 0 end ************************************************************************ memindex function XEget(p1, p2, p3, p4, p5, & p1p2, p2p3, p3p4, p4p5, p5p1, m1, m2, m3, m4, m5) implicit none ArgType p1, p2, p3, p4, p5 ArgType p1p2, p2p3, p3p4, p4p5, p5p1 ArgType m1, m2, m3, m4, m5 #include "lt.h" memindex cacheindex external cacheindex, XEcoefx #ifdef COMPLEXPARA memindex Eget external Eget #endif ArgType para(1,Pee) #ifdef COMPLEXPARA if( abs(Im(p1)) + abs(Im(p2)) + & abs(Im(p3)) + abs(Im(p4)) + & abs(Im(p5)) + abs(Im(p1p2)) + & abs(Im(p2p3)) + abs(Im(p3p4)) + & abs(Im(p4p5)) + abs(Im(p5p1)) .gt. 0 ) & print *, "Complex momenta not implemented" if( abs(Im(m1)) + abs(Im(m2)) + & abs(Im(m3)) + abs(Im(m4)) + abs(Im(m5)) .eq. 0 ) then XEget = Eget(p1, p2, p3, p4, p1p2, p2p3, & m1, m2, m3, m4) - offsetC return endif #endif call XEpara(para, p1, p2, p3, p4, p5, & p1p2, p2p3, p3p4, p4p5, p5p1, m1, m2, m3, m4, m5) XEget = cacheindex(para, Eval(1,0), XEcoefx, RC*Pee, Nee, Eno) end ************************************************************************ subroutine XEput(res, p1, p2, p3, p4, p5, & p1p2, p2p3, p3p4, p4p5, p5p1, m1, m2, m3, m4, m5) implicit none ComplexType res(*) ArgType p1, p2, p3, p4, p5 ArgType p1p2, p2p3, p3p4, p4p5, p5p1 ArgType m1, m2, m3, m4, m5 #include "lt.h" external XEcoefx ArgType para(1,Pee) #ifdef COMPLEXPARA if( abs(Im(p1)) + abs(Im(p2)) + & abs(Im(p3)) + abs(Im(p4)) + & abs(Im(p5)) + abs(Im(p1p2)) + & abs(Im(p2p3)) + abs(Im(p3p4)) + & abs(Im(p4p5)) + abs(Im(p5p1)) .gt. 0 ) & print *, "Complex momenta not implemented" if( abs(Im(m1)) + abs(Im(m2)) + & abs(Im(m3)) + abs(Im(m4)) + abs(Im(m5)) .eq. 0 ) then call Eput(res, p1, p2, p3, p4, p1p2, p2p3, & m1, m2, m3, m4) return endif #endif call XEpara(para, p1, p2, p3, p4, p5, & p1p2, p2p3, p3p4, p4p5, p5p1, m1, m2, m3, m4, m5) call cachecopy(res, para, Eval(1,0), XEcoefx, RC*Pee, Nee, Eno) end ************************************************************************ subroutine XE0nocache(res, p1, p2, p3, p4, p5, & p1p2, p2p3, p3p4, p4p5, p5p1, m1, m2, m3, m4, m5) implicit none ComplexType res(*) ArgType p1, p2, p3, p4, p5 ArgType p1p2, p2p3, p3p4, p4p5, p5p1 ArgType m1, m2, m3, m4, m5 #include "lt.h" ArgType para(1,Pee) ComplexType D2345(0:2), D1345(0:2), D1245(0:2) ComplexType D1235(0:2), D1234(0:2) #ifdef COMPLEXPARA if( abs(Im(p1)) + abs(Im(p2)) + & abs(Im(p3)) + abs(Im(p4)) + & abs(Im(p5)) + abs(Im(p1p2)) + & abs(Im(p2p3)) + abs(Im(p3p4)) + & abs(Im(p4p5)) + abs(Im(p5p1)) .gt. 0 ) & print *, "Complex momenta not implemented" if( abs(Im(m1)) + abs(Im(m2)) + & abs(Im(m3)) + abs(Im(m4)) + abs(Im(m5)) .eq. 0 ) then call E0nocache(res, p1, p2, p3, p4, p1p2, p2p3, & m1, m2, m3, m4) return endif #endif call XEpara(para, p1, p2, p3, p4, p5, & p1p2, p2p3, p3p4, p4p5, p5p1, m1, m2, m3, m4, m5) call XE0func(res, para, D2345, D1345, D1245, D1235, D1234, 0) end ************************************************************************ ComplexType function XE0i(i, p1, p2, p3, p4, p5, & p1p2, p2p3, p3p4, p4p5, p5p1, m1, m2, m3, m4, m5) implicit none integer i ArgType p1, p2, p3, p4, p5 ArgType p1p2, p2p3, p3p4, p4p5, p5p1 ArgType m1, m2, m3, m4, m5 #include "lt.h" memindex XEget external XEget memindex b b = XEget(p1, p2, p3, p4, p5, & p1p2, p2p3, p3p4, p4p5, p5p1, m1, m2, m3, m4, m5) XE0i = Eval(i+epsi,b) end ************************************************************************ ComplexType function XE0(p1, p2, p3, p4, p5, & p1p2, p2p3, p3p4, p4p5, p5p1, m1, m2, m3, m4, m5) implicit none ArgType p1, p2, p3, p4, p5 ArgType p1p2, p2p3, p3p4, p4p5, p5p1 ArgType m1, m2, m3, m4, m5 #include "lt.h" ComplexType XE0i external XE0i XE0 = XE0i(ee0, p1, p2, p3, p4, p5, & p1p2, p2p3, p3p4, p4p5, p5p1, m1, m2, m3, m4, m5) end ************************************************************************ subroutine XEcoefx(res, para) implicit none ComplexType res(*) ArgType para(1,*) #include "lt.h" memindex d2345, d1345, d1245, d1235, d1234 memindex XDget external XDget d2345 = XDget(P(2), P(3), P(4), P(10), P(7), P(8), & M(2), M(3), M(4), M(5)) d1345 = XDget(P(6), P(3), P(4), P(5), P(9), P(8), & M(1), M(3), M(4), M(5)) d1245 = XDget(P(1), P(7), P(4), P(5), P(9), P(10), & M(1), M(2), M(4), M(5)) d1235 = XDget(P(1), P(2), P(8), P(5), P(6), P(10), & M(1), M(2), M(3), M(5)) d1234 = XDget(P(1), P(2), P(3), P(9), P(6), P(7), & M(1), M(2), M(3), M(4)) call XEcoeff(res, para, Dval(1,d2345), Dval(1,d1345), & Dval(1,d1245), Dval(1,d1235), Dval(1,d1234)) end ************************************************************************ subroutine XEcoeff(res, para, D2345, D1345, D1245, D1235, D1234) implicit none ComplexType res(*) ComplexType D2345(*), D1345(*), D1245(*), D1235(*), D1234(*) ArgType para(1,*) #include "lt.h" ComplexType cmp(Nee) #ifdef COMPLEXPARA goto (1, 2, 3) ibits(versionkey, KeyEgetC, 2) #else goto (1, 2, 3) ibits(versionkey, KeyEget, 2) #endif call XEcoeffa(res, para, D2345, D1345, D1245, D1235, D1234) return 1 call XEcoeffb(res, para, D2345, D1345, D1245, D1235, D1234) return 2 call XEcoeffa(res, para, D2345, D1345, D1245, D1235, D1234) call XEcoeffb(cmp, para, D2345, D1345, D1245, D1235, D1234) call XEcheck(res, cmp, para) return 3 call XEcoeffa(cmp, para, D2345, D1345, D1245, D1235, D1234) call XEcoeffb(res, para, D2345, D1345, D1245, D1235, D1234) call XEcheck(cmp, res, para) end ************************************************************************ subroutine XEcheck(Ea, Eb, para) implicit none ComplexType Ea(*), Eb(*) ArgType para(1,*) #include "lt.h" #include "ltnames.h" ComplexType Ecmp(Nee) integer i logical ini ArgQuad Ginv(4,4) common /XInvGramE/ Ginv Ecmp(EE0) = Ea(EE0) Ecmp(EE1) = Ea(EE1) Ecmp(EE2) = Ea(EE2) Ecmp(EE3) = Ea(EE3) Ecmp(EE4) = Ea(EE4) Ecmp(EE11) = Ea(EE11) + 2*Ea(EE00)*Ginv(1,1) Ecmp(EE12) = Ea(EE12) + 2*Ea(EE00)*Ginv(1,2) Ecmp(EE13) = Ea(EE13) + 2*Ea(EE00)*Ginv(1,3) Ecmp(EE14) = Ea(EE14) + 2*Ea(EE00)*Ginv(1,4) Ecmp(EE22) = Ea(EE22) + 2*Ea(EE00)*Ginv(2,2) Ecmp(EE23) = Ea(EE23) + 2*Ea(EE00)*Ginv(2,3) Ecmp(EE24) = Ea(EE24) + 2*Ea(EE00)*Ginv(2,4) Ecmp(EE33) = Ea(EE33) + 2*Ea(EE00)*Ginv(3,3) Ecmp(EE34) = Ea(EE34) + 2*Ea(EE00)*Ginv(3,4) Ecmp(EE44) = Ea(EE44) + 2*Ea(EE00)*Ginv(4,4) Ecmp(EE00) = 0 Ecmp(EE111) = Ea(EE111) + 6*Ea(EE001)*Ginv(1,1) Ecmp(EE112) = Ea(EE112) + & 2*(Ea(EE002)*Ginv(1,1) + & Ea(EE001)*(Ginv(1,2) + Ginv(2,1))) Ecmp(EE113) = Ea(EE113) + & 2*(Ea(EE003)*Ginv(1,1) + & Ea(EE001)*(Ginv(1,3) + Ginv(3,1))) Ecmp(EE114) = Ea(EE114) + & 2*(Ea(EE004)*Ginv(1,1) + & Ea(EE001)*(Ginv(1,4) + Ginv(4,1))) Ecmp(EE122) = Ea(EE122) + & 2*(Ea(EE002)*(Ginv(1,2) + Ginv(2,1)) + & Ea(EE001)*Ginv(2,2)) Ecmp(EE123) = Ea(EE123) + & 2*(Ea(EE003)*Ginv(1,2) + Ea(EE001)*Ginv(2,3) + & Ea(EE002)*Ginv(3,1)) Ecmp(EE124) = Ea(EE124) + & 2*(Ea(EE004)*Ginv(1,2) + Ea(EE001)*Ginv(2,4) + & Ea(EE002)*Ginv(4,1)) Ecmp(EE133) = Ea(EE133) + & 2*(Ea(EE003)*(Ginv(1,3) + Ginv(3,1)) + & Ea(EE001)*Ginv(3,3)) Ecmp(EE134) = Ea(EE134) + & 2*(Ea(EE004)*Ginv(1,3) + Ea(EE001)*Ginv(3,4) + & Ea(EE003)*Ginv(4,1)) Ecmp(EE144) = Ea(EE144) + & 2*(Ea(EE004)*(Ginv(1,4) + Ginv(4,1)) + & Ea(EE001)*Ginv(4,4)) Ecmp(EE222) = Ea(EE222) + 6*Ea(EE002)*Ginv(2,2) Ecmp(EE223) = Ea(EE223) + & 2*(Ea(EE003)*Ginv(2,2) + & Ea(EE002)*(Ginv(2,3) + Ginv(3,2))) Ecmp(EE224) = Ea(EE224) + & 2*(Ea(EE004)*Ginv(2,2) + & Ea(EE002)*(Ginv(2,4) + Ginv(4,2))) Ecmp(EE233) = Ea(EE233) + & 2*(Ea(EE003)*(Ginv(2,3) + Ginv(3,2)) + & Ea(EE002)*Ginv(3,3)) Ecmp(EE234) = Ea(EE234) + & 2*(Ea(EE004)*Ginv(2,3) + Ea(EE002)*Ginv(3,4) + & Ea(EE003)*Ginv(4,2)) Ecmp(EE244) = Ea(EE244) + & 2*(Ea(EE004)*(Ginv(2,4) + Ginv(4,2)) + & Ea(EE002)*Ginv(4,4)) Ecmp(EE333) = Ea(EE333) + 6*Ea(EE003)*Ginv(3,3) Ecmp(EE334) = Ea(EE334) + & 2*(Ea(EE004)*Ginv(3,3) + & Ea(EE003)*(Ginv(3,4) + Ginv(4,3))) Ecmp(EE344) = Ea(EE344) + & 2*(Ea(EE004)*(Ginv(3,4) + Ginv(4,3)) + & Ea(EE003)*Ginv(4,4)) Ecmp(EE444) = Ea(EE444) + 6*Ea(EE004)*Ginv(4,4) Ecmp(EE001) = 0 Ecmp(EE002) = 0 Ecmp(EE003) = 0 Ecmp(EE004) = 0 Ecmp(EE1111) = & Ea(EE1111) + 12*Ginv(1,1)* & (Ea(EE0011) + Ea(EE0000)*Ginv(1,1)) Ecmp(EE1112) = & Ea(EE1112) + 6*(Ea(EE0012)*Ginv(1,1) + & (Ea(EE0011) + 2*Ea(EE0000)*Ginv(1,1))*Ginv(1,2)) Ecmp(EE1113) = & Ea(EE1113) + 6*(Ea(EE0013)*Ginv(1,1) + & (Ea(EE0011) + 2*Ea(EE0000)*Ginv(1,1))*Ginv(1,3)) Ecmp(EE1114) = & Ea(EE1114) + 6*(Ea(EE0014)*Ginv(1,1) + & (Ea(EE0011) + 2*Ea(EE0000)*Ginv(1,1))*Ginv(1,4)) Ecmp(EE1122) = & Ea(EE1122) + 2*(Ea(EE0022)*Ginv(1,1) + & 4*Ginv(1,2)*(Ea(EE0012) + Ea(EE0000)*Ginv(1,2)) + & (Ea(EE0011) + 2*Ea(EE0000)*Ginv(1,1))*Ginv(2,2)) Ecmp(EE1123) = & Ea(EE1123) + 2*(Ea(EE0023)*Ginv(1,1) + & 2*(Ea(EE0013)*Ginv(1,2) + & (Ea(EE0012) + 2*Ea(EE0000)*Ginv(1,2))*Ginv(1,3)) + & (Ea(EE0011) + 2*Ea(EE0000)*Ginv(1,1))*Ginv(2,3)) Ecmp(EE1124) = & Ea(EE1124) + 2*(Ea(EE0024)*Ginv(1,1) + & 2*(Ea(EE0014)*Ginv(1,2) + & (Ea(EE0012) + 2*Ea(EE0000)*Ginv(1,2))*Ginv(1,4)) + & (Ea(EE0011) + 2*Ea(EE0000)*Ginv(1,1))*Ginv(2,4)) Ecmp(EE1133) = & Ea(EE1133) + 2*(Ea(EE0033)*Ginv(1,1) + & 4*Ginv(1,3)*(Ea(EE0013) + Ea(EE0000)*Ginv(1,3)) + & (Ea(EE0011) + 2*Ea(EE0000)*Ginv(1,1))*Ginv(3,3)) Ecmp(EE1134) = & Ea(EE1134) + 2*(Ea(EE0034)*Ginv(1,1) + & 2*(Ea(EE0014)*Ginv(1,3) + & (Ea(EE0013) + 2*Ea(EE0000)*Ginv(1,3))*Ginv(1,4)) + & (Ea(EE0011) + 2*Ea(EE0000)*Ginv(1,1))*Ginv(3,4)) Ecmp(EE1144) = & Ea(EE1144) + 2*(Ea(EE0044)*Ginv(1,1) + & 4*Ginv(1,4)*(Ea(EE0014) + Ea(EE0000)*Ginv(1,4)) + & (Ea(EE0011) + 2*Ea(EE0000)*Ginv(1,1))*Ginv(4,4)) Ecmp(EE1222) = & Ea(EE1222) + 6*(Ea(EE0022)*Ginv(1,2) + & (Ea(EE0012) + 2*Ea(EE0000)*Ginv(1,2))*Ginv(2,2)) Ecmp(EE1223) = & Ea(EE1223) + 2*(Ea(EE0022)*Ginv(1,3) + & (Ea(EE0013) + 2*Ea(EE0000)*Ginv(1,3))*Ginv(2,2) + & 2*(Ea(EE0023)*Ginv(1,2) + & (Ea(EE0012) + 2*Ea(EE0000)*Ginv(1,2))*Ginv(2,3))) Ecmp(EE1224) = & Ea(EE1224) + 2*(Ea(EE0022)*Ginv(1,4) + & (Ea(EE0014) + 2*Ea(EE0000)*Ginv(1,4))*Ginv(2,2) + & 2*(Ea(EE0024)*Ginv(1,2) + & (Ea(EE0012) + 2*Ea(EE0000)*Ginv(1,2))*Ginv(2,4))) Ecmp(EE1233) = & Ea(EE1233) + 2*(Ea(EE0033)*Ginv(1,2) + & 2*(Ea(EE0023)*Ginv(1,3) + & (Ea(EE0013) + 2*Ea(EE0000)*Ginv(1,3))*Ginv(2,3)) + & (Ea(EE0012) + 2*Ea(EE0000)*Ginv(1,2))*Ginv(3,3)) Ecmp(EE1234) = & Ea(EE1234) + 2*(Ea(EE0023)*Ginv(1,4) + & (Ea(EE0014) + 2*Ea(EE0000)*Ginv(1,4))*Ginv(2,3) + & Ea(EE0013)*Ginv(2,4) + & Ginv(1,3)*(Ea(EE0024) + 2*Ea(EE0000)*Ginv(2,4)) + & Ea(EE0012)*Ginv(3,4) + & Ginv(1,2)*(Ea(EE0034) + 2*Ea(EE0000)*Ginv(3,4))) Ecmp(EE1244) = & Ea(EE1244) + 2*(Ea(EE0044)*Ginv(1,2) + & 2*(Ea(EE0024)*Ginv(1,4) + & (Ea(EE0014) + 2*Ea(EE0000)*Ginv(1,4))*Ginv(2,4)) + & (Ea(EE0012) + 2*Ea(EE0000)*Ginv(1,2))*Ginv(4,4)) Ecmp(EE1333) = & Ea(EE1333) + 6*(Ea(EE0033)*Ginv(1,3) + & (Ea(EE0013) + 2*Ea(EE0000)*Ginv(1,3))*Ginv(3,3)) Ecmp(EE1334) = & Ea(EE1334) + 2*(Ea(EE0033)*Ginv(1,4) + & (Ea(EE0014) + 2*Ea(EE0000)*Ginv(1,4))*Ginv(3,3) + & 2*(Ea(EE0034)*Ginv(1,3) + & (Ea(EE0013) + 2*Ea(EE0000)*Ginv(1,3))*Ginv(3,4))) Ecmp(EE1344) = & Ea(EE1344) + 2*(Ea(EE0044)*Ginv(1,3) + & 2*(Ea(EE0034)*Ginv(1,4) + & (Ea(EE0014) + 2*Ea(EE0000)*Ginv(1,4))*Ginv(3,4)) + & (Ea(EE0013) + 2*Ea(EE0000)*Ginv(1,3))*Ginv(4,4)) Ecmp(EE1444) = & Ea(EE1444) + 6*(Ea(EE0044)*Ginv(1,4) + & (Ea(EE0014) + 2*Ea(EE0000)*Ginv(1,4))*Ginv(4,4)) Ecmp(EE2222) = & Ea(EE2222) + 12*Ginv(2,2)* & (Ea(EE0022) + Ea(EE0000)*Ginv(2,2)) Ecmp(EE2223) = & Ea(EE2223) + 6*(Ea(EE0023)*Ginv(2,2) + & (Ea(EE0022) + 2*Ea(EE0000)*Ginv(2,2))*Ginv(2,3)) Ecmp(EE2224) = & Ea(EE2224) + 6*(Ea(EE0024)*Ginv(2,2) + & (Ea(EE0022) + 2*Ea(EE0000)*Ginv(2,2))*Ginv(2,4)) Ecmp(EE2233) = & Ea(EE2233) + 2*(Ea(EE0033)*Ginv(2,2) + & 4*Ginv(2,3)*(Ea(EE0023) + Ea(EE0000)*Ginv(2,3)) + & (Ea(EE0022) + 2*Ea(EE0000)*Ginv(2,2))*Ginv(3,3)) Ecmp(EE2234) = & Ea(EE2234) + 2*(Ea(EE0034)*Ginv(2,2) + & 2*(Ea(EE0024)*Ginv(2,3) + & (Ea(EE0023) + 2*Ea(EE0000)*Ginv(2,3))*Ginv(2,4)) + & (Ea(EE0022) + 2*Ea(EE0000)*Ginv(2,2))*Ginv(3,4)) Ecmp(EE2244) = & Ea(EE2244) + 2*(Ea(EE0044)*Ginv(2,2) + & 4*Ginv(2,4)*(Ea(EE0024) + Ea(EE0000)*Ginv(2,4)) + & (Ea(EE0022) + 2*Ea(EE0000)*Ginv(2,2))*Ginv(4,4)) Ecmp(EE2333) = & Ea(EE2333) + 6*(Ea(EE0033)*Ginv(2,3) + & (Ea(EE0023) + 2*Ea(EE0000)*Ginv(2,3))*Ginv(3,3)) Ecmp(EE2334) = & Ea(EE2334) + 2*(Ea(EE0033)*Ginv(2,4) + & (Ea(EE0024) + 2*Ea(EE0000)*Ginv(2,4))*Ginv(3,3) + & 2*(Ea(EE0034)*Ginv(2,3) + & (Ea(EE0023) + 2*Ea(EE0000)*Ginv(2,3))*Ginv(3,4))) Ecmp(EE2344) = & Ea(EE2344) + 2*(Ea(EE0044)*Ginv(2,3) + & 2*(Ea(EE0034)*Ginv(2,4) + & (Ea(EE0024) + 2*Ea(EE0000)*Ginv(2,4))*Ginv(3,4)) + & (Ea(EE0023) + 2*Ea(EE0000)*Ginv(2,3))*Ginv(4,4)) Ecmp(EE2444) = & Ea(EE2444) + 6*(Ea(EE0044)*Ginv(2,4) + & (Ea(EE0024) + 2*Ea(EE0000)*Ginv(2,4))*Ginv(4,4)) Ecmp(EE3333) = & Ea(EE3333) + 12*Ginv(3,3)* & (Ea(EE0033) + Ea(EE0000)*Ginv(3,3)) Ecmp(EE3334) = & Ea(EE3334) + 6*(Ea(EE0034)*Ginv(3,3) + & (Ea(EE0033) + 2*Ea(EE0000)*Ginv(3,3))*Ginv(3,4)) Ecmp(EE3344) = & Ea(EE3344) + 2*(Ea(EE0044)*Ginv(3,3) + & 4*Ginv(3,4)*(Ea(EE0034) + Ea(EE0000)*Ginv(3,4)) + & (Ea(EE0033) + 2*Ea(EE0000)*Ginv(3,3))*Ginv(4,4)) Ecmp(EE3444) = & Ea(EE3444) + 6*(Ea(EE0044)*Ginv(3,4) + & (Ea(EE0034) + 2*Ea(EE0000)*Ginv(3,4))*Ginv(4,4)) Ecmp(EE4444) = & Ea(EE4444) + 12*Ginv(4,4)* & (Ea(EE0044) + Ea(EE0000)*Ginv(4,4)) Ecmp(EE0000) = 0 Ecmp(EE0011) = 0 Ecmp(EE0012) = 0 Ecmp(EE0013) = 0 Ecmp(EE0014) = 0 Ecmp(EE0022) = 0 Ecmp(EE0023) = 0 Ecmp(EE0024) = 0 Ecmp(EE0033) = 0 Ecmp(EE0034) = 0 Ecmp(EE0044) = 0 ini = .TRUE. do i = 1, Nee if( abs(Ecmp(i) - Eb(i)) .gt. & .5D0*maxdev*abs(Ecmp(i) + Eb(i)) ) then if( ini ) then #ifdef COMPLEXPARA print *, "Discrepancy in EgetC:" #else print *, "Discrepancy in Eget:" #endif call XDumpPara(5, para, " ") ini = .FALSE. endif print *, coeffname(i,5), " a =", Ecmp(i) print *, coeffname(i,5), " b =", Eb(i) endif enddo end LoopTools-2.16/src/E/PaxHeaders/E0func.F0000644000000000000000000000007413262607506014670 xustar0030 atime=1648161785.723698464 30 ctime=1648161793.715764879 LoopTools-2.16/src/E/E0func.F0000644000000000000000000000731013262607506015604 0ustar00rootroot00000000000000* E0func.F * the scalar four-point function * this file is part of LoopTools * written by M. Rauch * last modified 9 Apr 18 th #include "externals.h" #include "types.h" #define npoint 5 #include "defs.h" #ifndef COMPLEXPARA subroutine E0func(res, para, & D2345, D1345, D1245, D1235, D1234, dvalid) implicit none ComplexType res(0:2) RealType para(1,*) ComplexType D2345(*), D1345(*), D1245(*), D1235(*), D1234(*) integer dvalid #include "lt.h" ComplexType d0(5), alt integer key, ier key = ibits(versionkey, KeyE0, 2) if( key .ne. 1 ) then call E0funcb(res, para, & D2345, D1345, D1245, D1235, D1234, dvalid) if( key .eq. 0 ) return alt = res(0) endif call ffxe0(res(0), d0, para, ier) res(1) = 0 res(2) = 0 if( key .gt. 1 .and. & abs(res(0) - alt) .gt. maxdev*abs(alt) ) then print *, "Discrepancy in E0:" print *, " p1 =", P(1) print *, " p2 =", P(2) print *, " p3 =", P(3) print *, " p4 =", P(4) print *, " p5 =", P(5) print *, " p1p2 =", P(6) print *, " p2p3 =", P(7) print *, " p3p4 =", P(8) print *, " p4p5 =", P(9) print *, " p5p1 =", P(10) print *, " m1 =", M(1) print *, " m2 =", M(2) print *, " m3 =", M(3) print *, " m4 =", M(4) print *, " m5 =", M(5) print *, "E0 a =", alt print *, "E0 b =", res(0) if( ier .gt. errdigits ) alt = res(0) endif if( .not. btest(key, 0) ) res(0) = alt end #endif ************************************************************************ #ifdef COMPLEXPARA subroutine E0funcC( #else subroutine E0funcb( #endif & res, para, D2345, D1345, D1245, D1235, D1234, dvalid) implicit none ComplexType res(0:2) ArgType para(1,*) ComplexType D2345(*), D1345(*), D1245(*), D1235(*), D1234(*) integer dvalid #include "lt.h" ArgType p1, p2, p3, p4, p5 ArgType p1p2, p2p3, p3p4, p4p5, p5p1 ArgType m1, m2, m3, m4, m5 ArgQuad Y(5,5), Yi(5,5), eta(5), detY integer i m1 = M(1) m2 = M(2) m3 = M(3) m4 = M(4) m5 = M(5) p1 = P(1) p2 = P(2) p3 = P(3) p4 = P(4) p5 = P(5) p1p2 = P(6) p2p3 = P(7) p3p4 = P(8) p4p5 = P(9) p5p1 = P(10) Y(1,1) = 2*m1 Y(2,2) = 2*m2 Y(3,3) = 2*m3 Y(4,4) = 2*m4 Y(5,5) = 2*m5 Y(1,2) = m1 Y(1,2) = Y(1,2) + m2 Y(1,2) = Y(1,2) - p1 Y(2,1) = Y(1,2) Y(1,3) = m1 Y(1,3) = Y(1,3) + m3 Y(1,3) = Y(1,3) - p1p2 Y(3,1) = Y(1,3) Y(1,4) = m1 Y(1,4) = Y(1,4) + m4 Y(1,4) = Y(1,4) - p4p5 Y(4,1) = Y(1,4) Y(1,5) = m1 Y(1,5) = Y(1,5) + m5 Y(1,5) = Y(1,5) - p5 Y(5,1) = Y(1,5) Y(2,3) = m2 Y(2,3) = Y(2,3) + m3 Y(2,3) = Y(2,3) - p2 Y(3,2) = Y(2,3) Y(2,4) = m2 Y(2,4) = Y(2,4) + m4 Y(2,4) = Y(2,4) - p2p3 Y(4,2) = Y(2,4) Y(2,5) = m2 Y(2,5) = Y(2,5) + m5 Y(2,5) = Y(2,5) - p5p1 Y(5,2) = Y(2,5) Y(3,4) = m3 Y(3,4) = Y(3,4) + m4 Y(3,4) = Y(3,4) - p3 Y(4,3) = Y(3,4) Y(3,5) = m3 Y(3,5) = Y(3,5) + m5 Y(3,5) = Y(3,5) - p3p4 Y(5,3) = Y(3,5) Y(4,5) = m4 Y(4,5) = Y(4,5) + m5 Y(4,5) = Y(4,5) - p4 Y(5,4) = Y(4,5) do i = 1, 5 Yi = Y Yi(:,i) = 1 call XDet(5, Yi,5, eta(i)) enddo call XDet(5, Y,5, detY) if( dvalid .eq. 0 ) then call XD0nocache(D2345, p2, p3, p4, p5p1, p2p3, p3p4, & m2, m3, m4, m5) call XD0nocache(D1345, p1p2, p3, p4, p5, p4p5, p3p4, & m1, m3, m4, m5) call XD0nocache(D1245, p1, p2p3, p4, p5, p4p5, p5p1, & m1, m2, m4, m5) call XD0nocache(D1235, p1, p2, p3p4, p5, p1p2, p5p1, & m1, m2, m3, m5) call XD0nocache(D1234, p1, p2, p3, p4p5, p1p2, p2p3, & m1, m2, m3, m4) endif res(0) = -( & eta(1)*D2345(dd0) + & eta(2)*D1345(dd0) + & eta(3)*D1245(dd0) + & eta(4)*D1235(dd0) + & eta(5)*D1234(dd0) & )/detY res(1) = 0 res(2) = 0 end LoopTools-2.16/src/E/PaxHeaders/ffdel5.F0000644000000000000000000000007411776502523014716 xustar0030 atime=1648161785.723698464 30 ctime=1648161793.715764879 LoopTools-2.16/src/E/ffdel5.F0000644000000000000000000004710711776502523015642 0ustar00rootroot00000000000000#include "externals.h" #include "types.h" *###[ ffdel5: subroutine ffdel5(del5,xpi,pDp) ***#[*comment:*********************************************************** * * * Calculate del5(pDp) = det(si.sj) with * * the momenta as follows: * * p(1-5) = s(i) * * p(5-10) = p(i) * * p(11-15) = p(i)+p(i+1) * * * * Input: xpi(15) (real) * * pDp(15,15) (real) * * * * Output: del5 (real) det(si.sj) * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments: * RealType del5,xpi(15),pDp(15,15) * * local variables: * integer mem,nperm,nsi parameter(mem=10,nperm=1296,nsi=73) integer i,j1,j2,j3,j4,j5,iperm(5,nperm), + imem,memarr(mem,3),memind,inow RealType s(nsi),xmax,del5p,xmaxp save iperm,memind,memarr,inow * * common blocks: * #include "ff.h" * #] declarations: * #[ data: data memind /0/ data memarr /mem*0,mem*0,mem*1/ data inow /1/ #include "ffperm5.h" * #] data: * #[ out of memory: * * see if we know were to start, if not: go on as last time * do 5 i=1,mem if ( id .eq. memarr(i,1) .and. idsub .eq. memarr(i,2) ) then inow = memarr(i,3) goto 6 endif 5 continue 6 continue * #] out of memory: * #[ calculations: imem = inow del5 = 0 xmax = 0 10 continue * * we only try the diagonal elements: top==bottom * j1 = iperm(1,inow) j2 = iperm(2,inow) j3 = iperm(3,inow) j4 = iperm(4,inow) j5 = iperm(5,inow) * * The following was generated with the Form program * V p1,p2,p3,p4,p5; * L f = (e_(p1,p2,p3,p4,p5))**2; * Contract; * print +s; * .end * plus the substituion //p#@1\./p#@2/=/pDp(j@1,j@2)/ * * #[ terms: s(1)=+ xpi(j1)*xpi(j2)*xpi(j3)*xpi(j4)*xpi(j5) s(2)=- xpi(j1)*xpi(j2)*xpi(j3)*pDp(j4,j5)**2 s(3)=- xpi(j1)*xpi(j2)*pDp(j3,j4)**2*xpi(j5) s(4)=+2*xpi(j1)*xpi(j2)*pDp(j3,j4)*pDp(j3,j5)*pDp(j4,j5) s(5)=- xpi(j1)*xpi(j2)*pDp(j3,j5)**2*xpi(j4) s(6)=- xpi(j1)*pDp(j2,j3)**2*xpi(j4)*xpi(j5) s(7)=+ xpi(j1)*pDp(j2,j3)**2*pDp(j4,j5)**2 s(8)=+2*xpi(j1)*pDp(j2,j3)*pDp(j2,j4)*pDp(j3,j4)*xpi(j5) s(9)=-2*xpi(j1)*pDp(j2,j3)*pDp(j2,j4)*pDp(j3,j5)*pDp(j4,j5) s(10)=-2*xpi(j1)*pDp(j2,j3)*pDp(j2,j5)*pDp(j3,j4)*pDp(j4,j5) s(11)=+2*xpi(j1)*pDp(j2,j3)*pDp(j2,j5)*pDp(j3,j5)*xpi(j4) s(12)=- xpi(j1)*pDp(j2,j4)**2*xpi(j3)*xpi(j5) s(13)=+ xpi(j1)*pDp(j2,j4)**2*pDp(j3,j5)**2 s(14)=+2*xpi(j1)*pDp(j2,j4)*pDp(j2,j5)*xpi(j3)*pDp(j4,j5) s(15)=-2*xpi(j1)*pDp(j2,j4)*pDp(j2,j5)*pDp(j3,j4)*pDp(j3,j5) s(16)=- xpi(j1)*pDp(j2,j5)**2*xpi(j3)*xpi(j4) s(17)=+ xpi(j1)*pDp(j2,j5)**2*pDp(j3,j4)**2 s(18)=- pDp(j1,j2)**2*xpi(j3)*xpi(j4)*xpi(j5) s(19)=+ pDp(j1,j2)**2*xpi(j3)*pDp(j4,j5)**2 s(20)=+ pDp(j1,j2)**2*pDp(j3,j4)**2*xpi(j5) s(21)=-2*pDp(j1,j2)**2*pDp(j3,j4)*pDp(j3,j5)*pDp(j4,j5) s(22)=+ pDp(j1,j2)**2*pDp(j3,j5)**2*xpi(j4) s(23)=+2*pDp(j1,j2)*pDp(j1,j3)*pDp(j2,j3)*xpi(j4)*xpi(j5) s(24)=-2*pDp(j1,j2)*pDp(j1,j3)*pDp(j2,j3)*pDp(j4,j5)**2 s(25)=-2*pDp(j1,j2)*pDp(j1,j3)*pDp(j2,j4)*pDp(j3,j4)*xpi(j5) s(26)=+2*pDp(j1,j2)*pDp(j1,j3)*pDp(j2,j4)*pDp(j3,j5)*pDp(j4,j5) s(27)=+2*pDp(j1,j2)*pDp(j1,j3)*pDp(j2,j5)*pDp(j3,j4)*pDp(j4,j5) s(28)=-2*pDp(j1,j2)*pDp(j1,j3)*pDp(j2,j5)*pDp(j3,j5)*xpi(j4) s(29)=-2*pDp(j1,j2)*pDp(j1,j4)*pDp(j2,j3)*pDp(j3,j4)*xpi(j5) s(30)=+2*pDp(j1,j2)*pDp(j1,j4)*pDp(j2,j3)*pDp(j3,j5)*pDp(j4,j5) s(31)=+2*pDp(j1,j2)*pDp(j1,j4)*pDp(j2,j4)*xpi(j3)*xpi(j5) s(32)=-2*pDp(j1,j2)*pDp(j1,j4)*pDp(j2,j4)*pDp(j3,j5)**2 s(33)=-2*pDp(j1,j2)*pDp(j1,j4)*pDp(j2,j5)*xpi(j3)*pDp(j4,j5) s(34)=+2*pDp(j1,j2)*pDp(j1,j4)*pDp(j2,j5)*pDp(j3,j4)*pDp(j3,j5) s(35)=+2*pDp(j1,j2)*pDp(j1,j5)*pDp(j2,j3)*pDp(j3,j4)*pDp(j4,j5) s(36)=-2*pDp(j1,j2)*pDp(j1,j5)*pDp(j2,j3)*pDp(j3,j5)*xpi(j4) s(37)=-2*pDp(j1,j2)*pDp(j1,j5)*pDp(j2,j4)*xpi(j3)*pDp(j4,j5) s(38)=+2*pDp(j1,j2)*pDp(j1,j5)*pDp(j2,j4)*pDp(j3,j4)*pDp(j3,j5) s(39)=+2*pDp(j1,j2)*pDp(j1,j5)*pDp(j2,j5)*xpi(j3)*xpi(j4) s(40)=-2*pDp(j1,j2)*pDp(j1,j5)*pDp(j2,j5)*pDp(j3,j4)**2 s(41)=- pDp(j1,j3)**2*xpi(j2)*xpi(j4)*xpi(j5) s(42)=+ pDp(j1,j3)**2*xpi(j2)*pDp(j4,j5)**2 s(43)=+ pDp(j1,j3)**2*pDp(j2,j4)**2*xpi(j5) s(44)=-2*pDp(j1,j3)**2*pDp(j2,j4)*pDp(j2,j5)*pDp(j4,j5) s(45)=+ pDp(j1,j3)**2*pDp(j2,j5)**2*xpi(j4) s(46)=+2*pDp(j1,j3)*pDp(j1,j4)*xpi(j2)*pDp(j3,j4)*xpi(j5) s(47)=-2*pDp(j1,j3)*pDp(j1,j4)*xpi(j2)*pDp(j3,j5)*pDp(j4,j5) s(48)=-2*pDp(j1,j3)*pDp(j1,j4)*pDp(j2,j3)*pDp(j2,j4)*xpi(j5) s(49)=+2*pDp(j1,j3)*pDp(j1,j4)*pDp(j2,j3)*pDp(j2,j5)*pDp(j4,j5) s(50)=+2*pDp(j1,j3)*pDp(j1,j4)*pDp(j2,j4)*pDp(j2,j5)*pDp(j3,j5) s(51)=-2*pDp(j1,j3)*pDp(j1,j4)*pDp(j2,j5)**2*pDp(j3,j4) s(52)=-2*pDp(j1,j3)*pDp(j1,j5)*xpi(j2)*pDp(j3,j4)*pDp(j4,j5) s(53)=+2*pDp(j1,j3)*pDp(j1,j5)*xpi(j2)*pDp(j3,j5)*xpi(j4) s(54)=+2*pDp(j1,j3)*pDp(j1,j5)*pDp(j2,j3)*pDp(j2,j4)*pDp(j4,j5) s(55)=-2*pDp(j1,j3)*pDp(j1,j5)*pDp(j2,j3)*pDp(j2,j5)*xpi(j4) s(56)=-2*pDp(j1,j3)*pDp(j1,j5)*pDp(j2,j4)**2*pDp(j3,j5) s(57)=+2*pDp(j1,j3)*pDp(j1,j5)*pDp(j2,j4)*pDp(j2,j5)*pDp(j3,j4) s(58)=- pDp(j1,j4)**2*xpi(j2)*xpi(j3)*xpi(j5) s(59)=+ pDp(j1,j4)**2*xpi(j2)*pDp(j3,j5)**2 s(60)=+ pDp(j1,j4)**2*pDp(j2,j3)**2*xpi(j5) s(61)=-2*pDp(j1,j4)**2*pDp(j2,j3)*pDp(j2,j5)*pDp(j3,j5) s(62)=+ pDp(j1,j4)**2*pDp(j2,j5)**2*xpi(j3) s(63)=+2*pDp(j1,j4)*pDp(j1,j5)*xpi(j2)*xpi(j3)*pDp(j4,j5) s(64)=-2*pDp(j1,j4)*pDp(j1,j5)*xpi(j2)*pDp(j3,j4)*pDp(j3,j5) s(65)=-2*pDp(j1,j4)*pDp(j1,j5)*pDp(j2,j3)**2*pDp(j4,j5) s(66)=+2*pDp(j1,j4)*pDp(j1,j5)*pDp(j2,j3)*pDp(j2,j4)*pDp(j3,j5) s(67)=+2*pDp(j1,j4)*pDp(j1,j5)*pDp(j2,j3)*pDp(j2,j5)*pDp(j3,j4) s(68)=-2*pDp(j1,j4)*pDp(j1,j5)*pDp(j2,j4)*pDp(j2,j5)*xpi(j3) s(69)=- pDp(j1,j5)**2*xpi(j2)*xpi(j3)*xpi(j4) s(70)=+ pDp(j1,j5)**2*xpi(j2)*pDp(j3,j4)**2 s(71)=+ pDp(j1,j5)**2*pDp(j2,j3)**2*xpi(j4) s(72)=-2*pDp(j1,j5)**2*pDp(j2,j3)*pDp(j2,j4)*pDp(j3,j4) s(73)=+ pDp(j1,j5)**2*pDp(j2,j4)**2*xpi(j3) * #] terms: * del5p = 0 xmaxp = 0 do 20 i=1,nsi del5p = del5p + s(i) xmaxp = max(xmaxp,abs(s(i))) 20 continue if ( abs(del5p) .lt. xloss**2*xmaxp ) then if ( inow .eq. imem .or. xmaxp .lt. xmax ) then del5 = del5p xmax = xmaxp endif inow = inow + 1 if ( inow .gt. nperm ) inow = 1 if ( inow .eq. imem ) goto 800 goto 10 endif del5 = del5p xmax = xmaxp * #] calculations: * #[ into memory: 800 continue memind = memind + 1 if ( memind .gt. mem ) memind = 1 memarr(memind,1) = id memarr(memind,2) = idsub memarr(memind,3) = inow * #] into memory: return *###] ffdel5: end *###[ ffdl4p: subroutine ffdl4p(dl4p,piDpj,ii) ***#[*comment:*********************************************************** * calculate in a numerically stable way * * * * p1 p2 p3 p4 * * delta * * p1 p2 p3 p4 * * * * with pn = xpi(ii(n)), n=1,4 * * p5 = -p1-p2-p3-p4 * * xpi(ii(n+5)) = pn+p(n+1), n=1,5 * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments: * integer ii(10) RealType dl4p,piDpj(15,15) * * local variables * integer i,j,k,jj(8),iperm(4,60) RealType s(24),som,xmax,smax * * common blocks * #include "ff.h" * * data (the permutations with 2 from each (1-5) and (6-10) are * still lacking) * data ((iperm(j,i),j=1,4),i=1,35) + /1,2,3,4, 2,3,4,5, 3,4,5,1, 4,5,1,2, 5,1,2,3, + 6,2,3,4, 4,5,6,2, 5,6,2,3, + 1,6,3,4, 4,5,1,6, 5,1,6,3, + 1,7,3,4, 7,3,4,5, 5,1,7,3, + 1,2,7,4, 2,7,4,5, 5,1,2,7, + 1,2,8,4, 2,8,4,5, 8,4,5,1, + 1,2,3,8, 2,3,8,5, 3,8,5,1, + 2,3,9,5, 3,9,5,1, 9,5,1,2, + 2,3,4,9, 3,4,9,1, 4,9,1,2, + 3,4,10,1, 4,10,1,2, 10,1,2,3, + 3,4,5,10, 4,5,10,2, 5,10,2,3/ data ((iperm(j,i),j=1,4),i=36,60) + / 8,9,1,6, 1,6,7,8, + 8,9,10,1, 10,1,7,8, + 2,7,8,9, 9,10,2,7, + 6,2,8,9, 9,10,6,2, + 3,8,9,10, 10,6,3,8, + 7,3,9,10, 10,6,7,3, + 6,7,4,9, 4,9,10,6, + 6,7,8,4, 8,4,10,6, + 7,8,5,10, 5,10,6,7, + 7,8,9,5, 9,5,6,7, + 6,7,8,9, 7,8,9,10, 8,9,10,6, 9,10,6,7, 10,6,7,8/ * #] declarations: * #[ calculations: * * for the time being we just try the (60) diagonal elemnts. * xmax = 0 do 100 i=1,60 jj(1) = ii(iperm(1,i)) jj(2) = ii(iperm(2,i)) jj(3) = ii(iperm(3,i)) jj(4) = ii(iperm(4,i)) s( 1) = +piDpj(jj(1),jj(1))*piDpj(jj(2),jj(2))* + piDpj(jj(3),jj(3))*piDpj(jj(4),jj(4)) s( 2) = +piDpj(jj(2),jj(1))*piDpj(jj(3),jj(2))* + piDpj(jj(1),jj(3))*piDpj(jj(4),jj(4)) s( 3) = s(2) * s( 3) = +piDpj(jj(3),jj(1))*piDpj(jj(1),jj(2))* * + piDpj(jj(2),jj(3))*piDpj(jj(4),jj(4)) s( 4) = -piDpj(jj(1),jj(1))*piDpj(jj(3),jj(2))* + piDpj(jj(2),jj(3))*piDpj(jj(4),jj(4)) s( 5) = -piDpj(jj(3),jj(1))*piDpj(jj(2),jj(2))* + piDpj(jj(1),jj(3))*piDpj(jj(4),jj(4)) s( 6) = -piDpj(jj(2),jj(1))*piDpj(jj(1),jj(2))* + piDpj(jj(3),jj(3))*piDpj(jj(4),jj(4)) s( 7) = -piDpj(jj(1),jj(1))*piDpj(jj(2),jj(2))* + piDpj(jj(4),jj(3))*piDpj(jj(3),jj(4)) s( 8) = -piDpj(jj(2),jj(1))*piDpj(jj(4),jj(2))* + piDpj(jj(1),jj(3))*piDpj(jj(3),jj(4)) s( 9) = -piDpj(jj(4),jj(1))*piDpj(jj(1),jj(2))* + piDpj(jj(2),jj(3))*piDpj(jj(3),jj(4)) s(10) = +piDpj(jj(1),jj(1))*piDpj(jj(4),jj(2))* + piDpj(jj(2),jj(3))*piDpj(jj(3),jj(4)) s(11) = +piDpj(jj(4),jj(1))*piDpj(jj(2),jj(2))* + piDpj(jj(1),jj(3))*piDpj(jj(3),jj(4)) s(12) = +piDpj(jj(2),jj(1))*piDpj(jj(1),jj(2))* + piDpj(jj(4),jj(3))*piDpj(jj(3),jj(4)) s(13) = -piDpj(jj(1),jj(1))*piDpj(jj(4),jj(2))* + piDpj(jj(3),jj(3))*piDpj(jj(2),jj(4)) s(14) = -piDpj(jj(4),jj(1))*piDpj(jj(3),jj(2))* + piDpj(jj(1),jj(3))*piDpj(jj(2),jj(4)) s(15) = s(8) * s(15) = -piDpj(jj(3),jj(1))*piDpj(jj(1),jj(2))* * + piDpj(jj(4),jj(3))*piDpj(jj(2),jj(4)) s(16) = s(10) * s(16) = +piDpj(jj(1),jj(1))*piDpj(jj(3),jj(2))* * + piDpj(jj(4),jj(3))*piDpj(jj(2),jj(4)) s(17) = +piDpj(jj(3),jj(1))*piDpj(jj(4),jj(2))* + piDpj(jj(1),jj(3))*piDpj(jj(2),jj(4)) s(18) = +piDpj(jj(4),jj(1))*piDpj(jj(1),jj(2))* + piDpj(jj(3),jj(3))*piDpj(jj(2),jj(4)) s(19) = -piDpj(jj(4),jj(1))*piDpj(jj(2),jj(2))* + piDpj(jj(3),jj(3))*piDpj(jj(1),jj(4)) s(20) = s(9) * s(20) = -piDpj(jj(2),jj(1))*piDpj(jj(3),jj(2))* * + piDpj(jj(4),jj(3))*piDpj(jj(1),jj(4)) s(21) = s(14) * s(21) = -piDpj(jj(3),jj(1))*piDpj(jj(4),jj(2))* * + piDpj(jj(2),jj(3))*piDpj(jj(1),jj(4)) s(22) = +piDpj(jj(4),jj(1))*piDpj(jj(3),jj(2))* + piDpj(jj(2),jj(3))*piDpj(jj(1),jj(4)) s(23) = s(11) * s(23) = +piDpj(jj(3),jj(1))*piDpj(jj(2),jj(2))* * + piDpj(jj(4),jj(3))*piDpj(jj(1),jj(4)) s(24) = s(18) * s(24) = +piDpj(jj(2),jj(1))*piDpj(jj(4),jj(2))* * + piDpj(jj(3),jj(3))*piDpj(jj(1),jj(4)) som = 0 smax = 0 do 80 k=1,24 som = som + s(k) smax = max(smax,abs(som)) 80 continue if ( i .eq. 1 .or. smax .lt. xmax ) then dl4p = som xmax = smax endif if ( abs(dl4p) .ge. xloss**2*smax ) goto 110 100 continue 110 continue * #] calculations: *###] ffdl4p: end *###[ ffdl4r: subroutine ffdl4r(dl4r,piDpj,miss) ***#[*comment:*********************************************************** * calculate in a numerically stable way * * * * s1 s2 s3 s4 * * delta * * p1 p2 p3 p4 * * * * with s(miss) NOT included * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments: * integer miss RealType dl4r,piDpj(15,15) * * local variables * integer i,j,k,ii(4),jj(4),ipermp(4,125),iperms(4,125), + iplace(11,5),minus(125),mem,msign parameter(mem=45) integer memarr(mem,4),inow,jnow,imem,jmem,memind RealType s(24),som,xmax,smax save ipermp,iperms,iplace,minus,memarr,inow,jnow,memind * * common blocks * #include "ff.h" * #] declarations: * #[ data: data memind /0/ data memarr /mem*0,mem*0,mem*1,mem*1/ data inow,jnow /1,1/ * * data (see getpermp.for) * data ipermp/ + 1,2,3,4,1,2,5,3,1,2,3,8,1,2,10,3,1,2,4,5,1,2,7,4,1,2,8,4,1,2,4, + 9,1,2,4,10,1,2,5,7,1,2,9,5,1,2,7,8,1,2,10,7,1,2,8,9,1,2,9,10,1, + 3,5,4,1,3,4,6,1,3,4,7,1,3,9,4,1,3,10,4,1,3,6,5,1,3,7,5,1,3,5,8, + 1,3,5,9,1,3,8,6,1,3,6,10,1,3,8,7,1,3,7,10,1,3,9,8,1,3,10,8,1,3, + 10,9,1,4,5,6,1,4,8,5,1,4,6,7,1,4,6,8,1,4,9,6,1,4,10,6,1,4,7,8,1, + 4,8,9,1,4,8,10,1,5,7,6,1,5,6,9,1,5,8,7,1,5,9,8,1,6,7,8,1,6,10,7, + 1,6,8,9,1,6,9,10,1,7,10,8,1,8,10,9,2,3,4,5,2,3,6,4,2,3,4,9,2,3, + 5,6,2,3,8,5,2,3,9,5,2,3,5,10,2,3,6,8,2,3,10,6,2,3,8,9,2,3,9,10, + 2,4,6,5,2,4,5,7,2,4,5,8,2,4,10,5,2,4,7,6,2,4,8,6,2,4,6,9,2,4,6, + 10,2,4,9,7,2,4,9,8,2,4,10,9,2,5,6,7,2,5,9,6,2,5,7,8,2,5,7,9,2,5, + 10,7,2,5,8,9,2,5,9,10,2,6,8,7,2,6,7,10,2,6,9,8,2,6,10,9,2,7,8,9, + 2,7,9,10,3,4,7,5,3,4,5,10,3,4,6,7,3,4,10,6,3,4,7,9,3,4,9,10,3,5, + 7,6,3,5,6,10,3,5,8,7,3,5,9,7,3,5,7,10,3,5,10,8,3,5,10,9,3,6,7,8, + 3,6,10,7,3,6,8,10,3,7,9,8,3,7,10,9,3,8,9,10,4,5,6,7,4,5,10,6,4, + 5,7,8,4,5,8,10,4,6,8,7,4,6,7,9,4,6,10,8,4,6,9,10,4,7,8,9,4,8,10, + 9,5,6,9,7,5,6,7,10,5,6,10,9,5,7,9,8,5,7,8,10,5,8,9,10,6,7,8,9,6, + 7,10,8,6,7,9,10,6,8,10,9,7,8,9,10/ data iperms/ + 1,2,3,4,1,2,3,7,1,2,8,3,1,2,3,10,1,2,6,4,1,2,4,7,1,2,4,9,1,2,6,7 + ,1,2,8,6,1,2,6,10,1,2,7,8,1,2,7,9,1,2,10,7,1,2,9,8,1,2,10,9,1,3, + 4,5,1,3,6,4,1,3,10,4,1,3,7,5,1,3,5,8,1,3,10,5,1,3,6,7,1,3,8,6,1, + 3,6,10,1,3,10,7,1,3,8,10,1,4,5,6,1,4,7,5,1,4,9,5,1,4,6,7,1,4,6,9 + ,1,4,6,10,1,4,10,7,1,4,10,9,1,5,6,7,1,5,8,6,1,5,6,10,1,5,7,8,1,5 + ,7,9,1,5,10,7,1,5,9,8,1,5,10,9,1,6,8,7,1,6,9,7,1,6,8,9,1,6,8,10, + 1,6,9,10,1,7,10,8,1,7,10,9,1,8,9,10,2,3,4,5,2,3,8,4,2,3,9,4,2,3, + 7,5,2,3,5,8,2,3,10,5,2,3,8,7,2,3,9,7,2,3,8,9,2,3,8,10,2,3,9,10,2 + ,4,5,6,2,4,7,5,2,4,9,5,2,4,6,8,2,4,6,9,2,4,8,7,2,4,9,7,2,4,8,9,2 + ,5,6,7,2,5,8,6,2,5,6,10,2,5,7,8,2,5,7,9,2,5,10,7,2,5,9,8,2,5,10, + 9,2,6,8,7,2,6,9,7,2,6,8,9,2,6,8,10,2,6,9,10,2,7,10,8,2,7,10,9,2, + 8,9,10,3,4,5,6,3,4,8,5,3,4,9,5,3,4,5,10,3,4,6,8,3,4,6,9,3,4,10,8 + ,3,4,10,9,3,5,6,7,3,5,8,6,3,5,6,10,3,5,7,8,3,5,7,9,3,5,10,7,3,5, + 9,8,3,5,10,9,3,6,8,7,3,6,9,7,3,6,8,9,3,6,8,10,3,6,9,10,3,7,10,8, + 3,7,10,9,3,8,9,10,4,5,6,7,4,5,8,6,4,5,6,10,4,5,7,8,4,5,7,9,4,5,1 + 0,7,4,5,9,8,4,5,10,9,4,6,8,7,4,6,9,7,4,6,8,9,4,6,8,10,4,6,9,10,4 + ,7,10,8,4,7,10,9,4,8,9,10/ data iplace / + 2,3,4,5, 07,08,09,15, +12,+13, 17, + 1,3,4,5, 11,08,09,10, -14,+13, 18, + 1,2,4,5, 06,12,09,10, -14,-15, 19, + 1,2,3,5, 06,07,13,10, +11,-15, 20, + 1,2,3,4, 06,07,08,14, +11,+12, 16/ data minus / + +1,+1,+1,+1,+1,+1,-1,+1,+1,+1,+1,-1,+1,-1,-1,+1, + +1,+1,+1,+1,+1,+1,+1,+1,+1,+1,+1,+1,-1,+1,-1,+1, + +1,-1,+1,+1,+1,+1,-1,+1,-1,-1,+1,-1,-1,+1,-1,+1, + -1,-1,+1,+1,-1,+1,+1,+1,+1,-1,-1,+1,-1,+1,+1,-1, + +1,-1,+1,-1,-1,+1,+1,+1,+1,-1,+1,-1,-1,+1,-1,-1, + +1,-1,+1,-1,-1,+1,+1,-1,+1,+1,-1,+1,-1,+1,+1,+1, + +1,-1,+1,-1,-1,+1,-1,-1,+1,-1,+1,-1,-1,+1,+1,+1, + +1,-1,+1,-1,-1,+1,-1,-1,+1,-1,+1,-1,-1/ * #] data: * #[ out of memory: * * see if we know were to start, if not: go on as last time * do 5 i=1,mem if ( id .eq. memarr(i,1) .and. idsub .eq. memarr(i,2) ) then inow = memarr(i,3) jnow = memarr(i,4) goto 6 endif 5 continue 6 continue * #] out of memory: * #[ calculations: * * loop over all permutations of the si and the pi - * we have 125*125 = a lot of possibilities before we give up .... * 15-feb-1993: well, let's only consider 25 at a time, otherwise * the time spent here becomes ludicrous * imem = inow jmem = jnow dl4r = 0 xmax = 0 * do 110 i=1,5 ii(1) = abs(iplace((iperms(1,inow)),miss)) ii(2) = abs(iplace((iperms(2,inow)),miss)) ii(3) = abs(iplace((iperms(3,inow)),miss)) ii(4) = abs(iplace((iperms(4,inow)),miss)) msign = sign(1,iplace((iperms(1,inow)),miss))* + sign(1,iplace((iperms(2,inow)),miss))* + sign(1,iplace((iperms(3,inow)),miss))* + sign(1,iplace((iperms(4,inow)),miss)) do 100 j=1,5 jj(1) = ipermp(1,jnow) + 5 jj(2) = ipermp(2,jnow) + 5 jj(3) = ipermp(3,jnow) + 5 jj(4) = ipermp(4,jnow) + 5 * s( 1) = +piDpj(ii(1),jj(1))*piDpj(ii(2),jj(2))* + piDpj(ii(3),jj(3))*piDpj(ii(4),jj(4)) s( 2) = +piDpj(ii(2),jj(1))*piDpj(ii(3),jj(2))* + piDpj(ii(1),jj(3))*piDpj(ii(4),jj(4)) s( 3) = +piDpj(ii(3),jj(1))*piDpj(ii(1),jj(2))* + piDpj(ii(2),jj(3))*piDpj(ii(4),jj(4)) s( 4) = -piDpj(ii(1),jj(1))*piDpj(ii(3),jj(2))* + piDpj(ii(2),jj(3))*piDpj(ii(4),jj(4)) s( 5) = -piDpj(ii(3),jj(1))*piDpj(ii(2),jj(2))* + piDpj(ii(1),jj(3))*piDpj(ii(4),jj(4)) s( 6) = -piDpj(ii(2),jj(1))*piDpj(ii(1),jj(2))* + piDpj(ii(3),jj(3))*piDpj(ii(4),jj(4)) * s( 7) = -piDpj(ii(1),jj(1))*piDpj(ii(2),jj(2))* + piDpj(ii(4),jj(3))*piDpj(ii(3),jj(4)) s( 8) = -piDpj(ii(2),jj(1))*piDpj(ii(4),jj(2))* + piDpj(ii(1),jj(3))*piDpj(ii(3),jj(4)) s( 9) = -piDpj(ii(4),jj(1))*piDpj(ii(1),jj(2))* + piDpj(ii(2),jj(3))*piDpj(ii(3),jj(4)) s(10) = +piDpj(ii(1),jj(1))*piDpj(ii(4),jj(2))* + piDpj(ii(2),jj(3))*piDpj(ii(3),jj(4)) s(11) = +piDpj(ii(4),jj(1))*piDpj(ii(2),jj(2))* + piDpj(ii(1),jj(3))*piDpj(ii(3),jj(4)) s(12) = +piDpj(ii(2),jj(1))*piDpj(ii(1),jj(2))* + piDpj(ii(4),jj(3))*piDpj(ii(3),jj(4)) * s(13) = -piDpj(ii(1),jj(1))*piDpj(ii(4),jj(2))* + piDpj(ii(3),jj(3))*piDpj(ii(2),jj(4)) s(14) = -piDpj(ii(4),jj(1))*piDpj(ii(3),jj(2))* + piDpj(ii(1),jj(3))*piDpj(ii(2),jj(4)) s(15) = -piDpj(ii(3),jj(1))*piDpj(ii(1),jj(2))* + piDpj(ii(4),jj(3))*piDpj(ii(2),jj(4)) s(16) = +piDpj(ii(1),jj(1))*piDpj(ii(3),jj(2))* + piDpj(ii(4),jj(3))*piDpj(ii(2),jj(4)) s(17) = +piDpj(ii(3),jj(1))*piDpj(ii(4),jj(2))* + piDpj(ii(1),jj(3))*piDpj(ii(2),jj(4)) s(18) = +piDpj(ii(4),jj(1))*piDpj(ii(1),jj(2))* + piDpj(ii(3),jj(3))*piDpj(ii(2),jj(4)) * s(19) = -piDpj(ii(4),jj(1))*piDpj(ii(2),jj(2))* + piDpj(ii(3),jj(3))*piDpj(ii(1),jj(4)) s(20) = -piDpj(ii(2),jj(1))*piDpj(ii(3),jj(2))* + piDpj(ii(4),jj(3))*piDpj(ii(1),jj(4)) s(21) = -piDpj(ii(3),jj(1))*piDpj(ii(4),jj(2))* + piDpj(ii(2),jj(3))*piDpj(ii(1),jj(4)) s(22) = +piDpj(ii(4),jj(1))*piDpj(ii(3),jj(2))* + piDpj(ii(2),jj(3))*piDpj(ii(1),jj(4)) s(23) = +piDpj(ii(3),jj(1))*piDpj(ii(2),jj(2))* + piDpj(ii(4),jj(3))*piDpj(ii(1),jj(4)) s(24) = +piDpj(ii(2),jj(1))*piDpj(ii(4),jj(2))* + piDpj(ii(3),jj(3))*piDpj(ii(1),jj(4)) * som = 0 smax = 0 do 80 k=1,24 som = som + s(k) smax = max(smax,abs(som)) 80 continue if ( ( inow .eq. imem .and. jnow .eq. jmem ) .or. + smax .lt. xmax ) then dl4r = msign*minus(inow)*som xmax = smax endif if ( abs(dl4r) .ge. xloss**2*smax ) goto 120 * increase with something that is relative prime to 125 so that * eventually we cover all possibilities, but with a good * scatter. jnow = jnow + 49 if ( jnow .gt. 125 ) jnow = jnow - 125 100 continue * again, a number relative prime to 125 and a few times smaller inow = inow + 49 if ( inow .gt. 125 ) inow = inow - 125 110 continue 120 continue * #] calculations: * #[ into memory: memind = memind + 1 if ( memind .gt. mem ) memind = 1 memarr(memind,1) = id memarr(memind,2) = idsub memarr(memind,3) = inow memarr(memind,4) = jnow * #] into memory: *###] ffdl4r: end LoopTools-2.16/src/E/PaxHeaders/ffxe0.F0000644000000000000000000000007411776502523014561 xustar0030 atime=1648161785.723698464 30 ctime=1648161793.715764879 LoopTools-2.16/src/E/ffxe0.F0000644000000000000000000004732011776502523015502 0ustar00rootroot00000000000000#include "externals.h" #include "types.h" * $Id: ffxe0.f,v 1.4 1996/01/10 15:36:51 gj Exp $ *###[ ffxe0: subroutine ffxe0(ce0,cd0i,xpi,ier) ***#[*comment:*********************************************************** * * * calculate * * * * 1 / / \-1* * e0= -----\dq |(q^2-m_1^2)((q+p_1)^2-m_2^2)...((q-p_5)^2-m_5^2| * * ipi^2/ \ / * * * * following the five four-point-function method in .... * * As an extra the five fourpoint function Di are also returned * * if ( ldot ) the dotproducts are left behind in fpij5(15,15) in * * /ffdot/ and the external determinants fdel4 and fdl3i(5) in * * /ffdel/. * * * * Input: xpi = m_i^2 (real) i=1,5 * * xpi = p_i.p_i (real) i=6,10 (note: B&D metric) * * xpi = (p_i+p_{i+1})^2 (r) i=11,15 * * xpi = (p_i+p_{i+2})^2 (r) i=16,20 OR 0 * * * * Output: ce0 (complex) * * cd0i(5) (complex) D0 with s_i missing * * ier (integr) 0=ok 1=inaccurate 2=error * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments * RealType xpi(20) ComplexType ce0,cd0i(5) integer ier * * local variables * integer i,j,NMIN,NMAX,ier0,i6,i7,i8,i9 parameter(NMIN=15,NMAX=20) RealType dpipj(NMIN,NMAX),xmax logical lp5(NMAX-NMIN) * * common blocks: * #include "ff.h" * #] declarations: * #[ get differences: * * simulate the differences in the masses etc.. * * first p16-p20 * do 5 i=1,5 if ( xpi(i+15) .eq. 0 ) then i6 = i+5 i7 = i6+1 if ( i7 .ge. 11 ) i7 = 6 i8 = i7+1 if ( i8 .ge. 11 ) i8 = 6 i9 = i8+1 if ( i9 .ge. 11 ) i9 = 6 xpi(i+15) = xpi(i6)+xpi(i7)+xpi(i8)-xpi(i6+5)-xpi(i7+5)+ + xpi(i9+5) xmax = max(abs(xpi(i6)),abs(xpi(i7)),abs(xpi(i8)),abs( + xpi(i6+5)),abs(xpi(i7+5)),abs(xpi(i9+5))) if ( abs(xpi(i+15)) .lt. xloss*xmax ) + call ffwarn(168,ier,xpi(i+15),xmax) lp5(i) = .TRUE. else lp5(i) = .FALSE. endif 5 continue * * next the differences * ier0 = 0 do 40 i=1,NMAX do 30 j=1,NMIN dpipj(j,i) = xpi(j) - xpi(i) 30 continue 40 continue * #] get differences: * #[ call ffxe0a: call ffxe0a(ce0,cd0i,xpi,dpipj,ier) * #] call ffxe0a: * #[ clean up: do 90 i=1,5 if ( lp5(i) ) then xpi(i+NMIN) = 0 endif 90 continue * #] clean up: *###] ffxe0: end *###[ ffxe0a: subroutine ffxe0a(ce0,cd0i,xpi,dpipj,ier) ***#[*comment:*********************************************************** * * * calculate * * * * 1 / / \-1* * e0= -----\dq |(q^2-m_1^2)((q+p_1)^2-m_2^2)...((q-p_5)^2-m_5^2| * * ipi^2/ \ / * * * * following the five four-point-function method in .... * * As an extra the five fourpoint function Di are also returned * * if ( ldot ) the dotproducts are left behind in fpij5(15,15) in * * /ffdot/ and the external determinants fdel4 and fdl3i(5) in * * /ffdel/. * * * * Input: xpi = m_i^2 (real) i=1,5 * * xpi = p_i.p_i (real) i=6,10 (note: B&D metric) * * xpi = (p_i+p_{i+1})^2 (r) i=11,15 * * xpi = (p_i+p_{i+2})^2 (r) i=16,20 * * dpipj(15,20) (real) = pi(i) - pi(j) * * * * Output: ce0 (complex) * * cd0i(5) (complex) D0 with s_i missing * * ier (integer) <50:lost # digits 100=error * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments * integer ier ComplexType ce0,cd0i(5) RealType xpi(20),dpipj(15,20) * * local variables * integer i,j,ii(10),ii4(6),ieri(5),ier0,imin,itype,ndiv,idone, + ier1 logical ldel2s ComplexType c,cfac,cs,csum RealType dl5s,dl4p,xpi4(13),dpipj4(10,13),piDpj4(10,10), + absc,xmax,piDpj(15,15),xqi4(13),dqiqj4(10,13), + qiDqj4(10,10),del2s,xmx5(5),dl4ri(5) save ii4 * * common blocks: * #include "ff.h" * * statement function * absc(c) = abs(Re(c)) + abs(Im(c)) * * data * data ii4 /5,6,7,8,9,10/ * * #] declarations: * #[ initialisations: ndiv = 0 idsub = 0 ce0 = 0 do 1 i=1,5 cd0i(i) = 0 1 continue * #] initialisations: * #[ calculations: * idsub = idsub + 1 call ffdot5(piDpj,xpi,dpipj,ier) if ( ldot ) then do 6 i=1,15 do 5 j=1,15 fpij5(j,i) = piDpj(j,i) 5 continue 6 continue do 10 i=1,10 ii(i) = i+5 10 continue idsub = idsub + 1 ier0 = 0 call ffdl4p(dl4p,piDpj,ii) * if ( dl4p .lt. 0 ) then * call fferr(57,ier) * endif fdel4 = dl4p endif idsub = idsub + 1 call ffdel5(dl5s,xpi,piDpj) * do 40 i=1,5 ieri(i) = ier 40 continue * do 100 i=1,5 * * get the coefficient determinant * idsub = idsub + 1 call ffdl4r(dl4ri(i),piDpj,i) * * get four-point momenta * call ffpi54(xpi4,dpipj4,piDpj4,xpi,dpipj,piDpj,i) * * first try IR divergent function to avoid error messages from ffrot4 * ier1 = ieri(i) call ffxdir(cs,cfac,idone,xpi4,dpipj4,6,ndiv,ier1) if ( idone .gt. 0 ) then * done xmax = abs(cs)*10d0**(-mod((ier1-ieri(i)),50)) else * * rotate to calculable posistion * call ffrot4(irota4,del2s,xqi4,dqiqj4,qiDqj4,xpi4,dpipj4, + piDpj4,5,itype,ieri(i)) if ( itype .lt. 0 ) then print *,'ffxe0: error: Cannot handle this ', + ' 4point masscombination yet:' print *,(xpi(j),j=1,20) return endif if ( itype .eq. 1 ) then ldel2s = .TRUE. isgnal = +1 print *,'ffxe0a: Cannot handle del2s = 0 yet' stop else ldel2s = .FALSE. endif if ( itype .eq. 2 ) then print *,'ffxe0a: no doubly IR divergent yet' stop endif * * get fourpoint function * ier0 = ieri(i) call ffxd0e(cs,cfac,xmax, .FALSE.,ndiv,xqi4,dqiqj4, + qiDqj4,del2s,ldel2s,ieri(i)) if ( ieri(i).gt.10 ) then isgnal = -isgnal ieri(i) = ier0 call ffxd0e(cs,cfac,xmax, .TRUE.,ndiv,xqi4,dqiqj4, + qiDqj4,del2s,ldel2s,ieri(i)) isgnal = -isgnal endif endif * * Finally ... * cd0i(i) = cs*cfac xmx5(i) = xmax*absc(cfac) if ( ldot ) then call ffdl3p(fdl3i(i),piDpj4,10,ii4,ii4) * let's hope tha tthese have been set by ffxd0e... fdl4si(i) = fdel4s endif 100 continue * * #] calculations: * #[ add all up: * csum = 0 xmax = 0 imin = 1 do 200 i=1,5 imin = -imin csum = csum + imin*Re(dl4ri(i))*cd0i(i) if ( ieri(i) .gt. 50 ) then ieri(i) = mod(ieri(i),50) endif xmax = max(xmax,dl4ri(i)*xmx5(i)*Re(10)**mod(ieri(i),50)) 200 continue * * If the imaginary part is very small it most likely is zero * (can be removed, just esthetically more pleasing) * if ( abs(Im(csum)) .lt. precc*abs(Re(csum)) ) + csum = ToComplex(Re(csum)) * * Finally ... * ce0 = csum*(1/Re(2*dl5s)) * * #] add all up: *###] ffxe0a: end *###[ ffxe00: subroutine ffxe00(ce0,cd0i,dl4ri,xpi,piDpj) ***#[*comment:*********************************************************** * * * calculate * * * * 1 / / \-1* * e0= -----\dq |(q^2-m_1^2)((q+p_1)^2-m_2^2)...((q-p_5)^2-m_5^2| * * ipi^2/ \ / * * * * following the five four-point-function method in .... * * The four five fourpoint function Di are input in this version. * * * * Input: cd0i(5) (complex) D0 with s_i missing * * dl4ri(5) (real) coeff of D0 * * xpi = m_i^2 (real) i=1,5 * * xpi = p_i.p_i (real) i=6,10 (note: B&D metric) * * xpi = (p_i+p_{i+1})^2 (r) i=11,15 * * xpi = (p_i+p_{i+2})^2 (r) i=16,20 * * piDpj(15,15) (real) pi.pj * * * * Output: ce0 (complex) * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments * ComplexType ce0,cd0i(5) RealType dl4ri(5),xpi(20),piDpj(15,15) * * local variables * integer i,ii(10),imin ComplexType c,csum RealType dl5s,dl4p,absc,xmax * * common blocks: * #include "ff.h" * * statement function * absc(c) = abs(Re(c)) + abs(Im(c)) * #] declarations: * #[ initialisations: * idsub = idsub + 1 ce0 = 0 * * #] initialisations: * #[ calculations: * if ( ldot ) then do 10 i=1,10 ii(i) = i+5 10 continue idsub = idsub + 1 call ffdl4p(dl4p,piDpj,ii) fdel4 = dl4p endif idsub = idsub + 1 call ffdel5(dl5s,xpi,piDpj) * * #] calculations: * #[ add all up: * csum = 0 xmax = 0 imin = 1 do 200 i=1,5 imin = -imin csum = csum + imin*Re(dl4ri(i))*cd0i(i) xmax = max(xmax,abs(dl4ri(i))*absc(cd0i(i))) 200 continue * * If the imaginary part is very small it most likely is zero * (can be removed, just esthetically more pleasing) * if ( abs(Im(csum)) .lt. precc*abs(Re(csum)) ) + csum = ToComplex(Re(csum)) * * Finally ... * ce0 = csum*(1/Re(2*dl5s)) * * #] add all up: *###] ffxe00: end *###[ ffdot5: subroutine ffdot5(piDpj,xpi,dpipj,ier) ***#[*comment:*********************************************************** * * * calculate the dotproducts pi.pj with * * * * xpi(i) = s_i i=1,5 * * xpi(i) = p_i i=6,10 * * xpi(i) = p_i+p_{i+1} i=11,15 * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments * integer ier RealType xpi(20),dpipj(15,20),piDpj(15,15) * * local variables * integer is1,is2,is3,is4,ip6,ip7,ip8,ip11,ip12,ip14, + itel,i1,i2,i3,i4,i5,i6,ierin * * common blocks * #include "ff.h" * * data * * #] declarations: * #[ indices: ierin = ier do 10 is1=1,5 is2 = is1 + 1 if ( is2 .eq. 6 ) is2 = 1 is3 = is2 + 1 if ( is3 .eq. 6 ) is3 = 1 ip6 = is1 + 5 ip7 = is2 + 5 ip11 = ip6 + 5 * * we have now defined a 3point function * * | -p11 * | * / \ * s1/ \s3 * ___/_____\___ * p6 s2 p7 * * #] indices: * #[ all in one vertex: * * pi.pi, si.si * piDpj(is1,is1) = xpi(is1) piDpj(ip6,ip6) = xpi(ip6) piDpj(ip11,ip11) = xpi(ip11) * * si.s(i+1) * if ( xpi(is2) .le. xpi(is1) ) then piDpj(is1,is2) = (dpipj(is1,ip6) + xpi(is2))/2 else piDpj(is1,is2) = (dpipj(is2,ip6) + xpi(is1))/2 endif piDpj(is2,is1) = piDpj(is1,is2) * * si.s(i+2) * if ( xpi(is1) .le. xpi(is3) ) then piDpj(is3,is1) = (dpipj(is3,ip11) + xpi(is1))/2 else piDpj(is3,is1) = (dpipj(is1,ip11) + xpi(is3))/2 endif piDpj(is1,is3) = piDpj(is3,is1) * * pi.si * if ( abs(xpi(ip6)) .le. xpi(is1) ) then piDpj(ip6,is1) = (dpipj(is2,is1) - xpi(ip6))/2 else piDpj(ip6,is1) = (dpipj(is2,ip6) - xpi(is1))/2 endif piDpj(is1,ip6) = piDpj(ip6,is1) * * pi.s(i+1) * if ( abs(xpi(ip6)) .le. xpi(is2) ) then piDpj(ip6,is2) = (dpipj(is2,is1) + xpi(ip6))/2 else piDpj(ip6,is2) = (dpipj(ip6,is1) + xpi(is2))/2 endif piDpj(is2,ip6) = piDpj(ip6,is2) * * p(i+2).s(i) * if ( abs(xpi(ip11)) .le. xpi(is1) ) then piDpj(ip11,is1) = -(dpipj(is1,is3) + xpi(ip11))/2 else piDpj(ip11,is1) = -(dpipj(ip11,is3) + xpi(is1))/2 endif piDpj(is1,ip11) = piDpj(ip11,is1) * * p(i+2).s(i+2) * if ( abs(xpi(ip11)) .le. xpi(is3) ) then piDpj(ip11,is3) = -(dpipj(is1,is3) - xpi(ip11))/2 else piDpj(ip11,is3) = -(dpipj(is1,ip11) - xpi(is3))/2 endif piDpj(is3,ip11) = piDpj(ip11,is3) * #] all in one vertex: * #[ all in one 3point: * * pi.s(i+2) * if ( min(abs(dpipj(is2,is1)),abs(dpipj(ip11,ip7))) .le. + min(abs(dpipj(ip11,is1)),abs(dpipj(is2,ip7))) ) then piDpj(ip6,is3) = (dpipj(ip11,ip7) + dpipj(is2,is1))/2 else piDpj(ip6,is3) = (dpipj(ip11,is1) + dpipj(is2,ip7))/2 endif piDpj(is3,ip6) = piDpj(ip6,is3) * * p(i+1).s(i) * if ( min(abs(dpipj(is3,is2)),abs(dpipj(ip6,ip11))) .le. + min(abs(dpipj(ip6,is2)),abs(dpipj(is3,ip11))) ) then piDpj(ip7,is1) = (dpipj(ip6,ip11) + dpipj(is3,is2))/2 else piDpj(ip7,is1) = (dpipj(ip6,is2) + dpipj(is3,ip11))/2 endif piDpj(is1,ip7) = piDpj(ip7,is1) * * p(i+2).s(i+1) * if ( min(abs(dpipj(is1,is3)),abs(dpipj(ip7,ip6))) .le. + min(abs(dpipj(ip7,is3)),abs(dpipj(is1,ip6))) ) then piDpj(ip11,is2) = -(dpipj(ip7,ip6) + dpipj(is1,is3))/2 else piDpj(ip11,is2) = -(dpipj(ip7,is3) + dpipj(is1,ip6))/2 endif piDpj(is2,ip11) = piDpj(ip11,is2) * #] all in one 3point: * #[ all external 3point: * * pi.p(i+1) * if ( abs(xpi(ip7)) .le. abs(xpi(ip6)) ) then piDpj(ip6,ip7) = (dpipj(ip11,ip6) - xpi(ip7))/2 else piDpj(ip6,ip7) = (dpipj(ip11,ip7) - xpi(ip6))/2 endif piDpj(ip7,ip6) = piDpj(ip6,ip7) * * p(i+1).p(i+2) * if ( abs(xpi(ip11)) .le. abs(xpi(ip7)) ) then piDpj(ip7,ip11) = -(dpipj(ip6,ip7) - xpi(ip11))/2 else piDpj(ip7,ip11) = -(dpipj(ip6,ip11) - xpi(ip7))/2 endif piDpj(ip11,ip7) = piDpj(ip7,ip11) * * p(i+2).p(i) * if ( abs(xpi(ip6)) .le. abs(xpi(ip11)) ) then piDpj(ip11,ip6) = -(dpipj(ip7,ip11) - xpi(ip6))/2 else piDpj(ip11,ip6) = -(dpipj(ip7,ip6) - xpi(ip11))/2 endif piDpj(ip6,ip11) = piDpj(ip11,ip6) * #] all external 3point: * #[ the other 3point: is4 = is3 + 1 if ( is4 .eq. 6 ) is4 = 1 ip8 = is3 + 5 ip14 = is4 + 10 * * we now work with the threepoint configuration * * | p14 * | * / \ * s1/ \s4 * ___/_____\___ * p11 s3 p8 * * s1.p8 * do 11 itel = 1,3 if ( itel .eq. 1 ) then i1 = is1 i2 = is3 i3 = is4 i4 = ip11 i5 = ip8 i6 = ip14 elseif ( itel .eq. 2 ) then i1 = is3 i2 = is4 i3 = is1 i4 = ip8 i5 = ip14 i6 = ip11 else i1 = is4 i2 = is1 i3 = is3 i4 = ip14 i5 = ip11 i6 = ip8 endif * * in one go: the opposite sides * if ( min(abs(dpipj(i3,i2)),abs(dpipj(i4,i6))) .le. + min(abs(dpipj(i4,i2)),abs(dpipj(i3,i6))) ) then piDpj(i5,i1) = (dpipj(i3,i2) + dpipj(i4,i6))/2 else piDpj(i5,i1) = (dpipj(i4,i2) + dpipj(i3,i6))/2 endif piDpj(i1,i5) = piDpj(i5,i1) * * and the remaining external ones * if ( abs(xpi(i5)) .le. abs(xpi(i4)) ) then piDpj(i4,i5) = (dpipj(i6,i4) - xpi(i5))/2 else piDpj(i4,i5) = (dpipj(i6,i5) - xpi(i4))/2 endif piDpj(i5,i4) = piDpj(i4,i5) 11 continue * #] the other 3point: * #[ 4point indices: ip12 = ip7+5 * * we now have the fourpoint configuration * * \p14 /p8 * \____/ * | s4 | * s1| |s3 * |____| * p6/ s2 \p7 * / \ * * * do 12 itel = 1,2 if ( itel .eq. 1 ) then i1 = ip6 i2 = ip8 i3 = ip7 i4 = ip14 else i1 = ip7 i2 = ip14 i3 = ip6 i4 = ip8 endif if ( min(abs(dpipj(i3,ip11)),abs(dpipj(i4,ip12))) .le. + min(abs(dpipj(i4,ip11)),abs(dpipj(i3,ip12))) ) then piDpj(i1,i2) = (dpipj(i3,ip11) + dpipj(i4,ip12))/2 else piDpj(i1,i2) = (dpipj(i4,ip11) + dpipj(i3,ip12))/2 endif piDpj(i2,i1) = piDpj(i1,i2) 12 continue * * we are only left with p11.p12 etc. * if ( min(abs(dpipj(ip14,ip8)),abs(dpipj(ip7,ip6))) .le. + min(abs(dpipj(ip7,ip8)),abs(dpipj(ip14,ip6))) ) then piDpj(ip11,ip12) = (dpipj(ip7,ip6) + dpipj(ip14,ip8))/2 else piDpj(ip11,ip12) = (dpipj(ip7,ip8) + dpipj(ip14,ip6))/2 endif piDpj(ip12,ip11) = piDpj(ip11,ip12) 10 continue * #] 4point indices: *###] ffdot5: end *###[ ffpi54: subroutine ffpi54(xpi4,dpipj4,piDpj4,xpi,dpipj,piDpj,inum) ***#[*comment:*********************************************************** * * * Gets the dotproducts pertaining to the fourpoint function with * * s_i missing out of the five point function dotproduct array. * * * * Input: xpi real(20) si.si,pi.pi * * dpipj real(15,20) xpi(i) - xpi(j) * * piDpj real(15,15) pi(i).pi(j) * * inum integer 1--5 * * * * Output: xpi4 real(13) * * dpipj4 real(10,13) * * piDpj4 real(10,10) * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments * integer inum RealType xpi(20),dpipj(15,20),piDpj(15,15),xpi4(13), + dpipj4(10,13),piDpj4(10,10) * * local variables * integer i,j,iplace(11,5),isigns(11,5) save iplace,isigns * * common blocks * #include "ff.h" * * data * data iplace / + 2,3,4,5, 07,08,09,15, 12,13, 17, + 1,3,4,5, 11,08,09,10, 14,13, 18, + 1,2,4,5, 06,12,09,10, 14,15, 19, + 1,2,3,5, 06,07,13,10, 11,15, 20, + 1,2,3,4, 06,07,08,14, 11,12, 16/ * data isigns / + +1,+1,+1,+1, +1,+1,+1,+1, -1,+1, +1, + +1,+1,+1,+1, +1,+1,+1,+1, +1,+1, +1, + +1,+1,+1,+1, +1,+1,+1,+1, +1,-1, +1, + +1,+1,+1,+1, +1,+1,+1,+1, -1,-1, +1, + +1,+1,+1,+1, +1,+1,+1,+1, -1,+1, +1/ * #] declarations: * #[ distribute: * * copy p5-p11 * do 20 i=1,11 xpi4(i) = xpi(iplace(i,inum)) do 10 j=1,10 dpipj4(j,i) = dpipj(iplace(j,inum),iplace(i,inum)) 10 continue 20 continue * * these cannot be simply copied I think * xpi4(12) = -xpi4(5)+xpi4(6)-xpi4(7)+xpi4(8)+xpi4(9)+xpi4(10) xpi4(13) = xpi4(5)-xpi4(6)+xpi4(7)-xpi4(8)+xpi4(9)+xpi4(10) * * and the differences * do 40 i=12,13 do 30 j=1,10 dpipj4(j,i) = xpi4(j) - xpi4(i) 30 continue 40 continue * * copy the dotproducts (watch the signs of p9,p10!) * do 60 i=1,10 do 50 j=1,10 piDpj4(j,i) = isigns(j,inum)*isigns(i,inum)* + piDpj(iplace(j,inum),iplace(i,inum)) 50 continue 60 continue * #] distribute: *###] ffpi54: end *###[ ffxe0r: subroutine ffxe0r(ce0,cd0i,xpi,ier) ***#[*comment:*********************************************************** * * * Tries all 12 permutations of the 5pointfunction * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none integer ier,nrot parameter(nrot=12) RealType xpi(20),xqi(20) ComplexType ce0,cd0i(5),ce0p,cd0ip(5),cd0ipp(5) integer inew(20,nrot),irota,ier1,i,j,k,icon,ialsav,init logical lcon parameter (icon=3) save inew,init,lcon #include "ff.h" data inew + /1,2,3,4,5, 6,7,8,9,10,11,12,13,14,15, 16,17,18,19,20, + 2,1,3,4,5, 6,11,8,9,15,7,14,13,12,10, 16,18,17,19,-20, + 1,3,2,4,5, 11,7,12,9,10,6,8,15,14,13, -16,17,19,18,20, + 1,2,4,3,5, 6,12,8,13,10,14,7,9,11,15, 16,-17,18,20,19, + 1,2,3,5,4, 6,7,13,9,14,11,15,8,10,12, 20,17,-18,19,16, + 5,2,3,4,1, 15,7,8,14,10,13,12,11,9,6, 17,16,18,-19,20, + 2,1,4,3,5, 6,14,8,13,15,12,11,9,7,10, 16,-18,17,20,-19, + 1,3,2,5,4, 11,7,15,9,14,6,13,12,10,8, -20,17,-19,18,16, + 5,2,4,3,1, 15,12,8,11,10,9,7,14,13,6, 17,-16,18,-20,19, + 2,1,3,5,4, 6,11,13,9,12,7,10,8,15,14, 20,18,-17,19,-16, + 5,3,2,4,1, 13,7,12,14,10,15,8,6,9,11, -17,16,19,-18,20, + 1,3,5,2,4, 11,13,15,12,14,10,7,9,6,8,-20,-17,-19,-16,-18/ data init /0/ * #] declarations: * #[ open console for some activity on screen: if ( init .eq. 0 ) then init = 1 lcon = .FALSE. endif * #] open console for some activity on screen: * #[ calculations: ce0 = 0 ier = 999 ialsav = isgnal do 30 j = -1,1,2 do 20 irota=1,nrot do 10 i=1,20 if ( inew(i,irota) .lt. 0 ) then xqi(-inew(i,irota)) = 0 else xqi(inew(i,irota)) = xpi(i) endif 10 continue print '(a,i2,a,i2)','---#[ rotation ',irota, + ': isgnal ',isgnal if (lcon) write(icon,'(a,i2,a,i2)') 'rotation ',irota, + ', isgnal ',isgnal ier1 = 0 ner = 0 id = id + 1 isgnal = ialsav call ffxe0(ce0p,cd0ip,xqi,ier1) ier1 = ier1 + ner print '(a,i1,a,i2)','---#] rotation ',irota,': isgnal ', + isgnal print '(a,2g28.16,i3)','e0 = ',ce0p,ier1 do 15 k=1,5 cd0ipp(k) = cd0ip(inew(k,irota)) print '(a,2g28.16,i3)','d0 = ',cd0ipp(k),k 15 continue if (lcon) write(icon,'(a,2g28.16,i3)')'e0 = ',ce0p,ier1 if ( ier1 .lt. ier ) then ce0 = ce0p do 19 k=1,5 cd0i(k) = cd0ipp(k) 19 continue ier = ier1 endif 20 continue ialsav = -ialsav 30 continue * #] calculations: *###] ffxe0r: end LoopTools-2.16/src/PaxHeaders/B0000644000000000000000000000013214217172001013340 xustar0030 mtime=1648161793.715764879 30 atime=1648161793.715764879 30 ctime=1648161793.715764879 LoopTools-2.16/src/B/0000755000000000000000000000000014217172001014335 5ustar00rootroot00000000000000LoopTools-2.16/src/B/PaxHeaders/ffcb2p.F0000644000000000000000000000007411776502522014707 xustar0030 atime=1648161785.723698464 30 ctime=1648161793.715764879 LoopTools-2.16/src/B/ffcb2p.F0000644000000000000000000002606511776502522015633 0ustar00rootroot00000000000000#include "externals.h" #include "types.h" *###[ ffcb2p: subroutine ffcb2p(cb2i,cb1,cb0,ca0i,cp,xm1,xm2,piDpj,ier) ***#[*comment:*********************************************************** * * * Compute the PV B2, the coefficients of p(mu)p(nu) and g(mu,nu) * * of 1/(ipi^2)\int d^nQ Q(mu)Q(nu)/(Q^2-m_1^2)/((Q+p)^2-m_2^2) * * originally based on aaxbx by Andre Aeppli. * * * * Input: cb1 complex vector two point function * * cb0 complex scalar two point function * * ca0i(2) complex scalar onepoint function with * * m1,m2 * * cp complex p.p in B&D metric * * xm1,2 complex m_1^2,m_2^2 * * piDpj(3,3) complex dotproducts between s1,s2,p * * ier integer digits lost so far * * * * Output: cb2i(2) complex B21,B22: coeffs of p*p, g in B2 * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments * integer ier ComplexType cp,xm1,xm2,piDpj(3,3) ComplexType cb2i(2),cb1,cb0,ca0i(2) RealType rm1,rm2,rp,rpiDpj(3,3),sprec * * local variables * integer i,j ComplexType dm1p,dm2p,dm1m2 * * common blocks * * #include "ff.h" * * #] declarations: * #[ real case: if ( Im(xm1).eq.0 .and. Im(xm2).eq.0 ) then rm1 = Re(xm1) rm2 = Re(xm2) rp = Re(cp) do 20 j=1,3 do 10 i=1,3 rpiDpj(i,j) = Re(piDpj(i,j)) 10 continue 20 continue sprec = precx precx = precc call ffxb2p(cb2i,cb1,cb0,ca0i,rp,rm1,rm2,rpiDpj,ier) precx = sprec return endif * #] real case: * #[ work: * dm1p = xm1 - cp dm2p = xm2 - cp dm1m2= xm1 - xm2 call ffcb2q(cb2i,cb1,cb0,ca0i,cp,xm1,xm2,dm1p,dm2p,dm1m2, + piDpj,ier) * * #] work: *###] ffcb2p: end *###[ ffcb2q: subroutine ffcb2q(cb2i,cb1,cb0,ca0i,cp,xm1,xm2,dm1p,dm2p,dm1m2, + piDpj,ier) ***#[*comment:*********************************************************** * * * Compute the PV B2, the coefficients of p(mu)p(nu) and g(mu,nu) * * of 1/(ipi^2)\int d^nQ Q(mu)Q(nu)/(Q^2-m_1^2)/((Q+p)^2-m_2^2) * * originally based on aaxbx by Andre Aeppli. * * * * Input: cb1 complex vector two point function * * cb0 complex scalar two point function * * ca0i(2) complex scalar onepoint function with * * m1,m2 * * cp complex p.p in B&D metric * * xm1,2 complex m_1^2,m_2^2 * * piDpj(3,3) complex dotproducts between s1,s2,p * * ier integer digits lost so far * * * * Output: cb2i(2) complex B21,B22: coeffs of p*p, g in B2 * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments * integer ier ComplexType cp,xm1,xm2,dm1p,dm2p,dm1m2,piDpj(3,3) ComplexType cb2i(2),cb1,cb0,ca0i(2) * * local variables * integer i,j,ier0,ier1,ithres,init logical lreal,llogmm RealType xmax,xmxsav,absc,xmxp RealType rm1,rm2,rp,rm1p,rm2p,rm1m2,rpiDpj(3,3),sprec ComplexType cs(14),cc,slam,xlo3,csom,clam,xlogmm,zfflo1,alp, + bet,xnoe,xnoe2,zfflo3 ComplexType cqi(3),cqiqj(3,3) save init * for Absoft only * external csqrt * ComplexType csqrt * * common blocks * #include "ff.h" * * statement function * absc(cc) = abs(Re(cc)) + abs(Im(cc)) * * #] declarations: * #[ real cases: if ( Im(xm1).eq.0 .and. Im(xm2).eq.0 ) then lreal = .TRUE. elseif ( nschem.le.4 ) then lreal = .TRUE. if ( init.eq.0 ) then init = 1 print *,'ffcb2q: nschem <= 4, ignoring complex masses:', + nschem endif elseif ( nschem.le.6 ) then if ( init.eq.0 ) then init = 1 print *,'ffcb2q: nschem = 5,6 complex masses near ', + 'threshold: ',nschem endif cqi(1) = xm1 cqi(2) = xm2 cqi(3) = cp cqiqj(1,2) = dm1m2 cqiqj(2,1) = -cqiqj(1,2) cqiqj(1,3) = dm1p cqiqj(3,1) = -cqiqj(1,3) cqiqj(2,3) = dm2p cqiqj(3,2) = -cqiqj(2,3) cqiqj(1,1) = 0 cqiqj(2,2) = 0 cqiqj(3,3) = 0 call ffthre(ithres,cqi,cqiqj,3,1,2,3) if ( ithres.eq.0 .or. ithres.eq.1 .and. nschem.eq.5 ) then lreal = .TRUE. else lreal = .FALSE. endif else lreal = .FALSE. endif if ( lreal ) then rm1 = Re(xm1) rm2 = Re(xm2) rp = Re(cp) rm1p = Re(dm1p) rm2p = Re(dm2p) rm1m2 = Re(dm1m2) do 20 j=1,3 do 10 i=1,3 rpiDpj(i,j) = Re(piDpj(i,j)) 10 continue 20 continue sprec = precx precx = precc call ffxb2q(cb2i,cb1,cb0,ca0i,rp,rm1,rm2,rm1m2,rpiDpj,ier) precx = sprec return endif * #] real cases: * #[ normal case: ier0 = ier ier1 = ier * * with thanks to Andre Aeppli, off whom I stole the original * if ( Re(cp) .ne. 0) then cs(1) = ca0i(2) cs(2) = xm1*cb0 cs(3) = 2*piDpj(1,3)*cb1 cs(4) = (xm1+xm2)/2 cs(5) = -cp/6 cb2i(1) = cs(1) - cs(2) + 2*cs(3) - cs(4) - cs(5) cb2i(2) = cs(1) + 2*cs(2) - cs(3) + 2*cs(4) + 2*cs(5) xmax = max(absc(cs(2)),absc(cs(3)),absc(cs(4)),absc(cs(5))) xmxsav = xmax if ( absc(cb2i(1)) .ge. xloss*xmax ) goto 100 * #] normal case: * #[ improve: m1=m2: * * a relatively simple case: dm1m2 = 0 (bi0.frm) * if ( dm1m2.eq.0 ) then slam = sqrt(cp**2-4*xm1*cp) xlo3 = zfflo3((cp-slam)/(2*xm1),ier) cs(1) = cp*(-1/Re(3) + slam/(4*xm1)) cs(2) = cp**2*(-slam/(4*xm1**2) - 3/(4*xm1)) cs(3) = cp**3/(4*xm1**2) cs(4) = cp/xm1*ca0i(1) cs(5) = xlo3/cp*(-xm1*slam) cs(6) = xlo3*slam csom = cs(1) + cs(2) + cs(3) + cs(4) + cs(5) + cs(6) xmxp = max(absc(cs(2)),absc(cs(3)),absc(cs(4)), + absc(cs(5)),absc(cs(6))) if ( xmxp.lt.xmax ) then cb2i(1) = csom xmax = xmxp endif if ( absc(cb2i(1)).ge.xloss**2*xmax ) goto 100 endif * #] improve: m1=m2: * #[ improve: |cp| < xm1 < xm2: * * try again (see bi.frm) * clam = 4*(piDpj(1,3)**2 - xm1*cp) if ( xm1.eq.0 .or. xm2.eq.0 ) then xlogmm = 0 elseif ( absc(dm1m2).lt.xloss*absc(xm1) ) then xlogmm = zfflo1(dm1m2/xm1,ier) else xlogmm = log(xm2/xm1) endif if ( abs(Re(cp)).lt.xloss*absc(xm2) .and. + Re(xm1).lt.Re(xm2) ) then slam = sqrt(clam) alp = (2*xm1*xm2/(2*piDpj(1,2)+slam) + xm1)/(slam-dm1m2) * bet = [xm2-xm1-cp-slam] bet = 4*xm1*cp/(2*piDpj(1,3)+slam) cs(1) = cp/xm2*ca0i(2) cs(2) = xlogmm*bet*(-2*xm1**2*xm2 - 2*xm1**3) + /((-dm1m2+slam)*(2*piDpj(1,2)+slam)*(2*piDpj(1,3)+slam)) cs(3) = xlogmm*(-4*cp*xm1**3) + /((-dm1m2+slam)*(2*piDpj(1,2)+slam)*(2*piDpj(1,3)+slam)) xnoe = 1/(2*piDpj(2,3)+slam) xnoe2 = xnoe**2 cs(4) = xnoe2*xm1*bet*(cp-4*xm2) cs(5) = xnoe2*xm1*2*cp*xm2 cs(6) = xnoe2*xm1**2*bet cs(7) = xnoe2*xm1**2*4*cp cs(8) = xnoe2*bet*(cp*xm2+3*xm2**2) cs(9) = xnoe2*(-6*cp*xm2**2) cs(10)= cp*(7/6.d0 - 2*xm1*slam*xnoe2 + + 4*xm2*slam*xnoe2 - 2*slam*xnoe) cs(11)= cp**2*( -2*slam*xnoe2 ) xlo3 = zfflo3(2*cp*xnoe,ier) cs(12) = xlo3*dm1m2**2*slam/cp**2 cs(13) = xlo3*(xm1 - 2*xm2)*slam/cp cs(14) = xlo3*slam csom = 0 xmxp = 0 do 50 i=1,14 csom = csom + cs(i) xmxp = max(xmxp,absc(cs(i))) 50 continue if ( xmxp.lt.xmax ) then cb2i(1) = csom xmax = xmxp endif if ( absc(cb2i(1)).ge.xloss**2*xmax ) goto 100 endif * #] improve: |cp| < xm1 < xm2: * #[ improve: |cp| < xm2 < xm1: if ( abs(Re(cp)).lt.xloss*absc(xm1) .and. + Re(xm2).lt.Re(xm1) ) then slam = sqrt(clam) alp = (2*xm2*xm1/(2*piDpj(1,2)+slam) + xm2)/(slam+dm1m2) * bet = [xm1-xm2-cp-slam] bet = 4*xm2*cp/(-2*piDpj(2,3)+slam) xnoe = 1/(-2*piDpj(1,3)+slam) xnoe2 = xnoe**2 cs(1) = cp/xm1*ca0i(1) cs(2) = -xlogmm*bet*(12*cp*xm1*xm2+6*cp*xm2**2- + 6*cp**2*xm2-2*xm1*xm2**2-2*xm2**3) + /((dm1m2+slam)*(2*piDpj(1,2)+slam)*(-2*piDpj(2,3)+slam)) cs(3) = -xlogmm*(-24*cp*xm1**2*xm2-4*cp*xm2**3+36* + cp**2*xm1*xm2+12*cp**2*xm2**2-12*cp**3*xm2) + /((dm1m2+slam)*(2*piDpj(1,2)+slam)*(-2*piDpj(2,3)+slam)) cs(4) = xnoe2*xm2*bet*(cp-4*xm1) cs(5) = xnoe2*xm2*(-10*cp*xm1) cs(6) = xnoe2*xm2**2*bet cs(7) = xnoe2*xm2**2*4*cp cs(8) = xnoe2*bet*(cp*xm1+3*xm1**2) cs(9) = xnoe2*6*cp*xm1**2 cs(10)= cp*(7/6.d0 - 2*xm1*slam*xnoe2 + + 4*xm2*slam*xnoe2 - 2*slam*xnoe) cs(11)= cp**2*( -2*slam*xnoe2 ) xlo3 = zfflo3(2*cp*xnoe,ier) cs(12) = xlo3*dm1m2**2*slam/cp**2 cs(13) = xlo3*(xm1 - 2*xm2)*slam/cp cs(14) = xlo3*slam csom = 0 xmxp = 0 do 60 i=1,14 csom = csom + cs(i) xmxp = max(xmxp,absc(cs(i))) 60 continue if ( xmxp.lt.xmax ) then cb2i(1) = csom xmax = xmxp endif if ( absc(cb2i(1)).ge.xloss**2*xmax ) goto 100 endif * #] improve: |cp| < xm2 < xm1: * #[ wrap up: 100 continue xmax = xmxsav cb2i(1) = Re(1/(3*cp)) * cb2i(1) cb2i(2) = Re(1/6.d0) * cb2i(2) * #] wrap up: * #[ cp=0, m1!=m2: elseif (dm1m2 .ne. 0) then * #[ B21: llogmm = .FALSE. * * B21 (see thesis, b21.frm) * cs(1) = xm1**2/3/dm1m2**3*ca0i(1) cs(2) = (-xm1**2 + xm1*xm2 - xm2**2/3)/dm1m2**3*ca0i(2) cs(3) = (5*xm1**3/18 - xm1*xm2**2/2 + 2*xm2**3/9) + /dm1m2**3 cb2i(1) = cs(1)+cs(2)+cs(3) xmax = max(absc(cs(2)),absc(cs(3))) if ( absc(cb2i(1)).gt.xloss**2*xmax ) goto 160 * * ma ~ mb * if ( absc(dm1m2).lt.xloss*absc(xm1) ) then xlogmm = zfflo1(dm1m2/xm1,ier) else xlogmm = log(xm2/xm1) endif llogmm = .TRUE. cs(1) = (xm1/dm1m2)/6 cs(2) = (xm1/dm1m2)**2/3 cs(3) = (xm1/dm1m2)**3*xlogmm/3 cs(4) = -2/Re(9) + ca0i(1)/(3*xm1) cs(5) = -xlogmm/3 csom = cs(1)+cs(2)+cs(3)+cs(4)+cs(5) xmxp = max(absc(cs(2)),absc(cs(3)),absc(cs(4)), + absc(cs(5))) if ( xmxp.lt.xmax ) then xmax = xmxp cb2i(1) = csom if ( absc(cb2i(1)).gt.xloss**2*xmax ) goto 160 endif * * and last try * xlo3 = zfflo3(dm1m2/xm1,ier) cs(1) = (dm1m2/xm1)**2/6 cs(2) = (dm1m2/xm1)/3 cs(3) = xlo3/(3*(dm1m2/xm1)**3) *same cs(4) = -2/Re(9) + ca0i(1)/(3*xm1) cs(5) = -xlo3/3 csom = cs(1)+cs(2)+cs(3)+cs(4)+cs(5) xmxp = max(absc(cs(2)),absc(cs(3)),absc(cs(4)), + absc(cs(5))) if ( xmxp.lt.xmax ) then xmax = xmxp cb2i(1) = csom if ( absc(cb2i(1)).gt.xloss**2*xmax ) goto 160 endif * * give up * 160 continue * #] B21: * #[ B22: * * B22 * cs(1) = +xm1/(4*dm1m2)*ca0i(1) cs(2) = -xm2/(4*dm1m2)*ca0i(2) cs(3) = (xm1+xm2)/8 cb2i(2) = cs(1) + cs(2) + cs(3) xmax = max(absc(cs(2)),absc(cs(3))) if ( absc(cb2i(2)).gt.xloss*xmax ) goto 210 * * second try, close together * if ( .not.llogmm ) then if ( abs(dm1m2).lt.xloss*absc(xm1) ) then xlogmm = zfflo1(dm1m2/xm1,ier) else xlogmm = log(xm2/xm1) endif endif cs(1) = dm1m2*( -1/Re(8) - ca0i(1)/(4*xm1) ) cs(2) = dm1m2*xlogmm/4 cs(3) = xm1*(xm1/dm1m2)/4*xlogmm cs(4) = xm1*( 1/Re(4) + ca0i(1)/(2*xm1) ) cs(5) = -xm1*xlogmm/2 csom = cs(1) + cs(2) + cs(3) + cs(4) + cs(5) xmxp = max(absc(cs(2)),absc(cs(3)),absc(cs(4)), + absc(cs(5))) if ( xmxp.lt.xmax ) then xmax = xmxp cb2i(2) = csom endif if ( absc(cb2i(2)).gt.xloss*xmax ) goto 210 * * give up * 210 continue * #] B22: * #] cp=0, m1!=m2: * #[ cp=0, m1==m2: else * * taken over from ffxb2a, which in turns stem from my thesis GJ * cb2i(1) = cb0/3 cb2i(2) = xm1/2*(cb0 + 1) endif * #] cp=0, m1==m2: * #[ finish up: ier = max(ier0,ier1) * #] finish up: *###] ffcb2q: end LoopTools-2.16/src/B/PaxHeaders/ffxb2p.F0000644000000000000000000000007411776502522014734 xustar0030 atime=1648161785.723698464 30 ctime=1648161793.715764879 LoopTools-2.16/src/B/ffxb2p.F0000644000000000000000000002612111776502522015651 0ustar00rootroot00000000000000#include "externals.h" #include "types.h" *###[ ffxb2p: subroutine ffxb2p(cb2i,cb1,cb0,ca0i,xp,xm1,xm2,piDpj,ier) ***#[*comment:*********************************************************** * * * Compute the PV B2, the coefficients of p(mu)p(nu) and g(mu,nu) * * of 1/(ipi^2)\int d^nQ Q(mu)Q(nu)/(Q^2-m_1^2)/((Q+p)^2-m_2^2) * * originally based on aaxbx by Andre Aeppli. * * * * Input: cb1 complex vector two point function * * cb0 complex scalar two point function * * ca0i(2) complex scalar onepoint function with * * m1,m2 * * xp real p.p in B&D metric * * xm1,2 real m_1^2,m_2^2 * * piDpj(3,3) real dotproducts between s1,s2,p * * ier integer digits lost so far * * * * Output: cb2i(2) complex B21,B22: coeffs of p*p, g in B2 * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments * integer ier RealType xp,xm1,xm2,piDpj(3,3) ComplexType cb2i(2),cb1,cb0,ca0i(2) * * local variables * RealType dm1m2 * * #] declarations: * #[ work: * dm1m2= xm1 - xm2 call ffxb2q(cb2i,cb1,cb0,ca0i,xp,xm1,xm2,dm1m2,piDpj,ier) * * #] work: *###] ffxb2p: end *###[ ffxb2q: subroutine ffxb2q(cb2i,cb1,cb0,ca0i,xp,xm1,xm2,dm1m2,piDpj,ier) ***#[*comment:*********************************************************** * * * Compute the PV B2, the coefficients of p(mu)p(nu) and g(mu,nu) * * of 1/(ipi^2)\int d^nQ Q(mu)Q(nu)/(Q^2-m_1^2)/((Q+p)^2-m_2^2) * * originally based on aaxbx by Andre Aeppli. * * * * Input: cb1 complex vector two point function * * cb0 complex scalar two point function * * ca0i(2) complex scalar onepoint function with * * m1,m2 * * xp real p.p in B&D metric * * xm1,2 real m_1^2,m_2^2 * * piDpj(3,3) real dotproducts between s1,s2,p * * ier integer digits lost so far * * * * Output: cb2i(2) complex B21,B22: coeffs of p*p, g in B2 * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments * integer ier RealType xp,xm1,xm2,dm1m2,piDpj(3,3) ComplexType cb2i(2),cb1,cb0,ca0i(2) * * local variables * integer i,ier0,ier1 logical llogmm RealType xmax,absc,xlam,slam,bet,xmxp,dfflo3,xlo3, + xmxsav,xnoe,xnoe2,xlogmm,dfflo1 ComplexType cs(16),cc,csom,clo3,zfflo3 external dfflo1,dfflo3,zfflo3 * * common blocks * #include "ff.h" * * statement function * absc(cc) = abs(Re(cc)) + abs(Im(cc)) * * #] declarations: * #[ normal case: ier0 = ier ier1 = ier * * with thanks to Andre Aeppli, off whom I stole the original * if ( xp .ne. 0) then cs(1) = ca0i(2) cs(2) = Re(xm1)*cb0 cs(3) = Re(2*piDpj(1,3))*cb1 cs(4) = (xm1+xm2)/2 cs(5) = -xp/6 cb2i(1) = cs(1) - cs(2) - cs(4) + 2*cs(3) - cs(5) cb2i(2) = cs(1) + 2*cs(2) - cs(3) + 2*cs(4) + 2*cs(5) xmax = max(absc(cs(2)),absc(cs(3)),absc(cs(4)),absc(cs(5))) xmxsav = xmax if ( absc(cb2i(1)) .ge. xloss*xmax ) goto 100 * #] normal case: * #[ improve: m1=m2: * * a relatively simple case: dm1m2 = 0 (bi0.frm) * if ( dm1m2.eq.0 .and. xm1.ne.0 ) then if ( xp.lt.0 ) then slam = sqrt(xp**2-4*xm1*xp) xlo3 = dfflo3((xp-slam)/(2*xm1),ier) cs(1) = xp*(-1/Re(3) + slam/(4*xm1)) cs(2) = xp**2*(-slam/(4*xm1**2) - 3/(4*xm1)) cs(3) = xp**3/(4*xm1**2) cs(4) = Re(xp/xm1)*ca0i(1) cs(5) = xlo3/xp*(-xm1*slam) cs(6) = xlo3*slam else slam = isgnal*sqrt(-xp**2+4*xm1*xp) clo3 = zfflo3(ToComplex(Re(xp/(2*xm1)), + Re(-slam/(2*xm1))),ier) cs(1) = Re(xp)*ToComplex(-1/Re(3), + Re(slam/(4*xm1))) cs(2) = Re(xp**2)*ToComplex(Re(-3/(4*xm1)), + Re(-slam/(4*xm1**2))) cs(3) = Re(xp**3/(4*xm1**2)) cs(4) = Re(xp/xm1)*ca0i(1) cs(5) = clo3*ToComplex(Re(0),Re(-xm1*slam/xp)) cs(6) = clo3*ToComplex(Re(0),Re(slam)) endif csom = cs(1) + cs(2) + cs(3) + cs(4) + cs(5) + cs(6) xmxp = max(absc(cs(2)),absc(cs(3)),absc(cs(4)), + absc(cs(5)),absc(cs(6))) * * get rid of noise in the imaginary part * if ( xloss*abs(Im(csom)).lt.precc*abs(Re(csom)) ) + csom = ToComplex(Re(csom),Re(0)) if ( xmxp.lt.xmax ) then cb2i(1) = csom xmax = xmxp endif if ( absc(cb2i(1)).ge.xloss**2*xmax ) goto 100 endif * #] improve: m1=m2: * #[ improve: |xp| < xm1 < xm2: * * try again (see bi.frm) * xlam = 4*(piDpj(1,3)**2 - xm1*xp) if ( xm1.eq.0 .or. xm2.eq.0 ) then xlogmm = 0 elseif ( abs(dm1m2).lt.xloss*xm1 ) then xlogmm = dfflo1(dm1m2/xm1,ier) else xlogmm = log(xm2/xm1) endif if ( xlam.gt.0 .and. abs(xp).lt.xloss*xm2 .and. + xm1.lt.xm2 ) then slam = sqrt(xlam) bet = 4*xm1*xp/(2*piDpj(1,3)+slam) cs(1) = Re(xp/xm2)*ca0i(2) cs(2) = -xlogmm*bet*xm1**2*2*(xm2 + xm1) + /((-dm1m2+slam)*(2*piDpj(1,2)+slam)*(2*piDpj(1,3)+slam)) cs(3) = xlogmm*(-4*xp*xm1**3) + /((-dm1m2+slam)*(2*piDpj(1,2)+slam)*(2*piDpj(1,3)+slam)) xnoe = 1/(2*piDpj(2,3)+slam) xnoe2 = xnoe**2 cs(4) = xnoe2*xm1*bet*(xp-4*xm2) cs(5) = xnoe2*xm1*2*xp*xm2 cs(6) = xnoe2*xm1**2*bet cs(7) = xnoe2*xm1**2*4*xp cs(8) = xnoe2*bet*xm2*(xp+3*xm2) cs(9) = xnoe2*(-6*xp*xm2**2) cs(10)= xp*(7/6.d0 - 2*xm1*slam*xnoe2 + + 4*xm2*slam*xnoe2 - 2*slam*xnoe) cs(11)= xp**2*( -2*slam*xnoe2 ) xlo3 = dfflo3(2*xp*xnoe,ier) cs(12) = xlo3*dm1m2**2*slam/xp**2 cs(13) = xlo3*(xm1 - 2*xm2)*slam/xp cs(14) = xlo3*slam csom = 0 xmxp = 0 do 50 i=1,14 csom = csom + cs(i) xmxp = max(xmxp,absc(cs(i))) 50 continue if ( xmxp.lt.xmax ) then cb2i(1) = csom xmax = xmxp endif cs(7) = -2*bet*xnoe2*xm2*dm1m2 cs(6) = -bet*xm1**2*xlogmm* & (2*(xm1 + xm2)/(2*piDpj(1,3)+slam) + 1)/ & ((-dm1m2+slam)*(2*piDpj(1,2)+slam)) cs(5) = xnoe2*xp*((xm1 + xm2)*(bet + 4*dm1m2) + & 2*xm2*(dm1m2 + slam)) cs(4) = xnoe2*(bet*dm1m2**2 - & 2*xp*slam*(dm1m2 + 1/xnoe + xp)) cs(3) = 7/6D0*xp xmxp = dm1m2/xp cs(2) = xlo3*slam*(xmxp*(xmxp + 1) - xm2/xp + 1) csom = 0 xmxp = 0 do i=7,1,-1 c do i=1,7 csom = csom + cs(i) xmxp = max(xmxp,absc(cs(i))) enddo if ( xmxp.lt.xmax ) then cb2i(1) = csom xmax = xmxp endif if ( absc(cb2i(1)).ge.xloss**2*xmax ) goto 100 endif * #] improve: |xp| < xm1 < xm2: * #[ improve: |xp| < xm2 < xm1: if ( xlam.gt.0 .and. abs(xp).lt.xloss*xm1 .and. + xm2.lt.xm1 ) then slam = sqrt(xlam) bet = 4*xm2*xp/(-2*piDpj(2,3)+slam) xnoe = 1/(-2*piDpj(1,3)+slam) xnoe2 = xnoe**2 cs(1) = Re(xp/xm1)*ca0i(1) cs(2) = -2*xlogmm*bet*xm2* + (3*xp*(2*xm1 + xm2 - xp) - xm2*(xm1 + xm2))/ + ((dm1m2+slam)*(2*piDpj(1,2)+slam)*(-2*piDpj(2,3)+slam)) cs(3) = -4*xlogmm*xm2*xp* + (-6*xm1**2-xm2**2+ 3*xp*(3*xm1 + xm2 - xp))/ + ((dm1m2+slam)*(2*piDpj(1,2)+slam)*(-2*piDpj(2,3)+slam)) cs(4) = xnoe2*xm2*bet*(xp-4*xm1) cs(5) = xnoe2*xm2*(-10*xp*xm1) cs(6) = xnoe2*xm2**2*bet cs(7) = xnoe2*xm2**2*4*xp cs(8) = xnoe2*bet*xm1*(xp+3*xm1) cs(9) = xnoe2*6*xp*xm1**2 cs(10)= xp*(7/6.d0 - 2*xm1*slam*xnoe2 + + 4*xm2*slam*xnoe2 - 2*slam*xnoe) cs(11)= xp**2*( -2*slam*xnoe2 ) xlo3 = dfflo3(2*xp*xnoe,ier) cs(12) = xlo3*dm1m2**2*slam/xp**2 cs(13) = xlo3*(xm1 - 2*xm2)*slam/xp cs(14) = xlo3*slam csom = 0 xmxp = 0 do 60 i=1,14 csom = csom + cs(i) xmxp = max(xmxp,absc(cs(i))) 60 continue if ( xmxp.lt.xmax ) then cb2i(1) = csom xmax = xmxp endif xmxp = xlogmm*xm2/((dm1m2+slam)* & (2*piDpj(1,2)+slam)*(-2*piDpj(2,3)+slam)) cs(8) = 2*bet*(xnoe2*dm1m2*xm1 + xmxp*(xm1+xm2)*xm2) cs(7) = 2*xmxp*xp*(13*xm1**2 + xm2**2 + dm1m2**2) cs(6) = 2*xnoe2*xp*dm1m2*(xm1 + 2*dm1m2) cs(5) = bet*xnoe2*(dm1m2**2 + xp*(xm1 + xm2)) cs(4)= xp*(7/6D0 - & 2*slam*xnoe*(xnoe*(dm1m2 - xm2 + xp) + 1)) cs(3) = -2*xmxp*xp*( & 3*(bet + 2*xp)*(2*xm1 + xm2 - xp) + & 2*xm1*(3*xp + dm1m2) ) xmxp = dm1m2/xp cs(2) = xlo3*slam*(xmxp*(xmxp + 1) - xm2/xp + 1) csom = 0 xmxp = 0 do i=8,1,-1 csom = csom + cs(i) xmxp = max(xmxp,absc(cs(i))) enddo if ( xmxp.lt.xmax ) then cb2i(1) = csom xmax = xmxp endif if ( absc(cb2i(1)).ge.xloss**2*xmax ) goto 100 endif * #] improve: |xp| < xm2 < xm1: * #[ wrap up: 100 continue xmax = xmxsav cb2i(1) = Re(1/(3*xp)) * cb2i(1) cb2i(2) = Re(1/6.d0) * cb2i(2) * #] wrap up: * #[ xp=0, m1!=m2: elseif (dm1m2 .ne. 0) then * #[ B21: llogmm = .FALSE. * * B21 (see thesis, b21.frm) * cs(1) = Re(xm1**2/3/dm1m2**3)*ca0i(1) cs(2) = Re((-xm1**2 + xm1*xm2 - xm2**2/3)/dm1m2**3)* + ca0i(2) cs(3) = (5*xm1**3/18 - xm1*xm2**2/2 + 2*xm2**3/9) + /dm1m2**3 cb2i(1) = cs(1)+cs(2)+cs(3) xmax = max(absc(cs(2)),absc(cs(3))) if ( absc(cb2i(1)).gt.xloss**2*xmax ) goto 160 * * ma ~ mb * if ( abs(dm1m2).lt.xloss*xm1 ) then xlogmm = dfflo1(dm1m2/xm1,ier) else xlogmm = log(xm2/xm1) endif llogmm = .TRUE. cs(1) = (xm1/dm1m2)/6 cs(2) = (xm1/dm1m2)**2/3 cs(3) = (xm1/dm1m2)**3*xlogmm/3 cs(4) = -2/Re(9) + ca0i(1)*Re(1/(3*xm1)) cs(5) = -xlogmm/3 csom = cs(1)+cs(2)+cs(3)+cs(4)+cs(5) xmxp = max(absc(cs(2)),absc(cs(3)),absc(cs(4)), + absc(cs(5))) if ( xmxp.lt.xmax ) then xmax = xmxp cb2i(1) = csom if ( absc(cb2i(1)).gt.xloss**2*xmax ) goto 160 endif * * and last try * xlo3 = dfflo3(dm1m2/xm1,ier) cs(1) = (dm1m2/xm1)**2/6 cs(2) = (dm1m2/xm1)/3 cs(3) = xlo3/(3*(dm1m2/xm1)**3) *same cs(4) = -2/Re(9) + ca0i(1)*Re(1/(3*xm1)) cs(5) = -xlo3/3 csom = cs(1)+cs(2)+cs(3)+cs(4)+cs(5) xmxp = max(absc(cs(2)),absc(cs(3)),absc(cs(4)), + absc(cs(5))) if ( xmxp.lt.xmax ) then xmax = xmxp cb2i(1) = csom if ( absc(cb2i(1)).gt.xloss**2*xmax ) goto 160 endif * * give up * 160 continue * #] B21: * #[ B22: * * B22 * cs(1) = +Re(xm1/(4*dm1m2))*ca0i(1) cs(2) = -Re(xm2/(4*dm1m2))*ca0i(2) cs(3) = (xm1+xm2)/8 cb2i(2) = cs(1) + cs(2) + cs(3) xmax = max(absc(cs(2)),absc(cs(3))) if ( absc(cb2i(2)).gt.xloss*xmax ) goto 210 * * second try, close together * if ( .not.llogmm ) then if ( abs(dm1m2).lt.xloss*xm1 ) then xlogmm = dfflo1(dm1m2/xm1,ier) else xlogmm = log(xm2/xm1) endif endif cs(1) = dm1m2*( -1/Re(8) - ca0i(1)*Re(1/(4*xm1)) ) cs(2) = dm1m2*xlogmm/4 cs(3) = xm1*(xm1/dm1m2)/4*xlogmm cs(4) = xm1*( 1/Re(4) + ca0i(1)*Re(1/(2*xm1)) ) cs(5) = -xm1*xlogmm/2 csom = cs(1) + cs(2) + cs(3) + cs(4) + cs(5) xmxp = max(absc(cs(2)),absc(cs(3)),absc(cs(4)), + absc(cs(5))) if ( xmxp.lt.xmax ) then xmax = xmxp cb2i(2) = csom endif if ( absc(cb2i(2)).gt.xloss*xmax ) goto 210 * * give up * 210 continue * #] B22: * #] xp=0, m1!=m2: * #[ xp=0, m1==m2: else * * taken over from ffxb2a, which in turns stem from my thesis GJ * cb2i(1) = cb0/3 cb2i(2) = Re(xm1/2)*(cb0 + 1) endif * #] xp=0, m1==m2: * #[ finish up: ier = max(ier0,ier1) * #] finish up: *###] ffxb2q: end LoopTools-2.16/src/B/PaxHeaders/ffdel2.F0000644000000000000000000000007411776502522014707 xustar0030 atime=1648161785.723698464 30 ctime=1648161793.715764879 LoopTools-2.16/src/B/ffdel2.F0000644000000000000000000003440111776502522015624 0ustar00rootroot00000000000000#include "externals.h" #include "types.h" *###[ ffdel2: subroutine ffdel2(del2,piDpj,ns,i1,i2,i3,lerr,ier) ************************************************************************* * calculate in a numerically stable way * * del2(piDpj(i1,i1),piDpj(i2,i2),piDpj(i3,i3)) = * * = piDpj(i1,i1)*piDpj(i2,i2) - piDpj(i1,i2)^2 * * = piDpj(i1,i1)*piDpj(i3,i3) - piDpj(i1,i3)^2 * * = piDpj(i2,i2)*piDpj(i3,i3) - piDpj(i2,i3)^2 * * ier is the usual error flag. * ************************************************************************* implicit none * * arguments: * integer ns,i1,i2,i3,lerr,ier RealType del2,piDpj(ns,ns) * * local variables * RealType s1,s2 * * common blocks * #include "ff.h" * * calculations * idsub = idsub + 1 if ( abs(piDpj(i1,i2)) .lt. abs(piDpj(i1,i3)) .and. + abs(piDpj(i1,i2)) .lt. abs(piDpj(i2,i3)) ) then s1 = piDpj(i1,i1)*piDpj(i2,i2) s2 = piDpj(i1,i2)**2 elseif ( abs(piDpj(i1,i3)) .lt. abs(piDpj(i2,i3)) ) then s1 = piDpj(i1,i1)*piDpj(i3,i3) s2 = piDpj(i1,i3)**2 else s1 = piDpj(i2,i2)*piDpj(i3,i3) s2 = piDpj(i2,i3)**2 endif del2 = s1 - s2 if ( abs(del2) .lt. xloss*s2 ) then if ( lerr .eq. 0 ) then * we know we have another chance if ( del2.ne.0 ) then ier = ier + int(log10(xloss*abs(s2/del2))) else ier = ier + int(log10(xloss*abs(s2)/xclogm)) endif endif endif *###] ffdel2: end *###[ ffdl2p: subroutine ffdl2p(delps1,xpi,dpipj,piDpj, + ip1,ip2,ip3,is1,is2,is3,ns) ***#[*comment:*********************************************************** * * * calculate in a numerically stable way * * delta_{ip1,is2}^{ip1,ip2} * * ier is the usual error flag. * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments: * integer ns,ip1,ip2,ip3,is1,is2,is3 RealType delps1,xpi(ns),dpipj(ns,ns),piDpj(ns,ns) * * local variables * RealType s1,s2,s3,xmax,som * * common blocks * #include "ff.h" * #] declarations: * #[ stupid tree: * 1 s1 = xpi(ip1)*piDpj(ip2,is2) s2 = piDpj(ip1,ip2)*piDpj(ip1,is2) delps1 = s1 - s2 if ( abs(delps1) .ge. xloss*abs(s1) ) goto 100 som = delps1 xmax = abs(s1) * 2 s1 = piDpj(ip1,ip2)*piDpj(ip3,is2) s2 = piDpj(ip1,ip3)*piDpj(ip2,is2) delps1 = s1 - s2 if ( abs(delps1) .ge. xloss*abs(s1) ) goto 100 if ( abs(s1) .lt. xmax ) then som = delps1 xmax = abs(s1) endif * 3 s1 = piDpj(ip1,ip3)*piDpj(ip1,is2) s2 = xpi(ip1)*piDpj(ip3,is2) delps1 = s1 - s2 if ( abs(delps1) .ge. xloss*abs(s1) ) goto 100 if ( abs(s1) .lt. xmax ) then som = delps1 xmax = abs(s1) endif * 4 s1 = xpi(ip1)*piDpj(ip2,is1) s2 = piDpj(ip1,is1)*piDpj(ip1,ip2) delps1 = s1 - s2 if ( abs(delps1) .ge. xloss*abs(s1) ) goto 100 if ( abs(s1) .lt. xmax ) then som = delps1 xmax = abs(s1) endif * 5 s1 = piDpj(ip1,is2)*piDpj(ip2,is1) s2 = piDpj(ip1,is1)*piDpj(ip2,is2) delps1 = s1 - s2 if ( abs(delps1) .ge. xloss*abs(s1) ) goto 100 if ( abs(s1) .lt. xmax ) then som = delps1 xmax = abs(s1) endif * 6 s1 = piDpj(ip1,ip2)*piDpj(ip3,is1) s2 = piDpj(ip1,ip3)*piDpj(ip2,is1) delps1 = s1 - s2 if ( abs(delps1) .ge. xloss*abs(s1) ) goto 100 if ( abs(s1) .lt. xmax ) then som = delps1 xmax = abs(s1) endif * 7 s1 = piDpj(ip2,is2)*piDpj(ip3,is1) s2 = piDpj(ip2,is1)*piDpj(ip3,is2) delps1 = s1 - s2 if ( abs(delps1) .ge. xloss*abs(s1) ) goto 100 if ( abs(s1) .lt. xmax ) then som = delps1 xmax = abs(s1) endif * 8 s1 = piDpj(ip1,ip3)*piDpj(ip1,is1) s2 = xpi(ip1)*piDpj(ip3,is1) delps1 = s1 - s2 if ( abs(delps1) .ge. xloss*abs(s1) ) goto 100 if ( abs(s1) .lt. xmax ) then som = delps1 xmax = abs(s1) endif * 9 s1 = piDpj(ip1,is1)*piDpj(ip3,is2) s2 = piDpj(ip1,is2)*piDpj(ip3,is1) delps1 = s1 - s2 if ( abs(delps1) .ge. xloss*abs(s1) ) goto 100 if ( abs(s1) .lt. xmax ) then som = delps1 xmax = abs(s1) endif *10 22-nov-1993 yet another one if ( dpipj(1,1).eq.0 ) then s1 = +xpi(ip1)*dpipj(is3,is2)/2 s2 = -piDpj(ip1,ip2)*dpipj(is2,is1)/2 s3 = +xpi(ip1)*piDpj(ip2,ip3)/2 delps1 = s1+s2+s3 if ( abs(delps1) .ge. xloss*max(abs(s1),abs(s2)) ) goto 100 if ( max(abs(s1),abs(s2)) .lt. xmax ) then som = delps1 xmax = abs(s1) endif endif * NO possibility delps1 = som 100 continue * #] stupid tree: *###] ffdl2p: end *###[ ffdl2s: subroutine ffdl2s(delps1,piDpj,in,jn,jin,isji, + kn,ln,lkn,islk,ns) ***#[*comment:*********************************************************** * * * calculate in a numerically stable way * * * * \delta_{si,sj}^{sk,sl} * * * * with p(ji) = isji*(sj-si) * * p(lk) = islk*(sl-sk) * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments: * integer in,jn,jin,isji,kn,ln,lkn,islk,ns RealType delps1,piDpj(ns,ns) * * local variables * integer ii,jj,i,j,ji,k,l,lk,ihlp RealType s1,s2,som,smax * * common blocks * #include "ff.h" * #] declarations: * #[ stupid tree: idsub = idsub + 1 som = 0 smax = 0 i = in j = jn ji = jin k = kn l = ln lk = lkn do 20 ii=1,3 do 10 jj=1,3 s1 = piDpj(i,k)*piDpj(j,l) s2 = piDpj(i,l)*piDpj(j,k) delps1 = s1 - s2 if ( ii .gt. 1 ) delps1 = isji*delps1 if ( jj .gt. 1 ) delps1 = islk*delps1 if ( ii .eq. 3 .neqv. jj .eq. 3 ) delps1 = -delps1 if ( abs(delps1) .ge. xloss*abs(s1) ) goto 30 * * Save the most accurate estimate so far: if ( ii .eq. 1 .and. jj .eq. 1 .or. abs(s1) .lt. smax + ) then som = delps1 smax = abs(s1) endif * * rotate the jj's if ( lk .eq. 0 ) goto 20 ihlp = k k = l l = lk lk = ihlp 10 continue * * and the ii's if ( ji .eq. 0 ) goto 25 ihlp = i i = j j = ji ji = ihlp 20 continue 25 continue delps1 = som 30 continue * #] stupid tree: *###] ffdl2s: end *###[ ffdl2t: subroutine ffdl2t(delps,piDpj,in,jn,kn,ln,lkn,islk,iss,ns) ***#[*comment:*********************************************************** * * * calculate in a numerically stable way * * * * \delta_{si,sj}^{sk,sl} * * * * with p(lk) = islk*(iss*sl - sk) (islk,iss = +/-1) * * and NO relationship between s1,s2 assumed (so 1/2 the * * possibilities of ffdl2s). * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments: * integer in,jn,kn,ln,lkn,islk,iss,ns RealType delps,piDpj(ns,ns) * * local variables * RealType s1,s2,som,smax * * common blocks * #include "ff.h" * #] declarations: * #[ calculations: if ( in .eq. jn ) then delps = 0 return endif s1 = piDpj(kn,in)*piDpj(ln,jn) s2 = piDpj(ln,in)*piDpj(kn,jn) delps = s1 - s2 if ( abs(delps) .ge. xloss*abs(s1) ) goto 20 som = delps smax = abs(s1) s1 = piDpj(kn,in)*piDpj(lkn,jn) s2 = piDpj(lkn,in)*piDpj(kn,jn) delps = iss*islk*(s1 - s2) if ( abs(delps) .ge. xloss*abs(s1) ) goto 20 if ( abs(s1) .lt. smax ) then som = delps smax = abs(s1) endif s1 = piDpj(lkn,in)*piDpj(ln,jn) s2 = piDpj(ln,in)*piDpj(lkn,jn) delps = islk*(- s1 + s2) if ( abs(delps) .ge. xloss*abs(s1) ) goto 20 if ( abs(s1) .lt. smax ) then som = delps smax = abs(s1) endif * * give up * delps = som 20 continue * #] calculations: *###] ffdl2t: end *###[ ffdl3m: subroutine ffdl3m(del3mi,ldel,del3,del2,xpi,dpipj,piDpj,ns,ip1n, + ip2n,ip3n,is,itime) ***#[*comment:*********************************************************** * * * Calculate xpi(i)*del2 - del3(piDpj) * * * * / si mu \2 (This appears to be one of the harder * * = | d | determinants to calculate accurately. * * \ p1 p2 / Note that we allow a loss of xloss^2) * * * * Input: ldel iff .true. del2 and del3 exist * * del3 \delta^{s(1),p1,p2}_{s(1),p1,p2} * * del2 \delta^{p1,p2}_{p1,p2} * * xpi(ns) standard * * dpipj(ns,ns) standard * * piDpj(ns,ns) standard * * ipi pi = xpi(abs(ipi)) [p3=-p1 +/-p2] * * is si = xpi(is,is+1,..,is+itime-1) * * itime number of functions to calculate * * * * Output: del3mi(3) (\delta^{s_i \mu}_{p_1 p_2})^2 * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments: * integer ns,ip1n,ip2n,ip3n,is,itime logical ldel RealType del3mi(itime),del3,del2,xpi(ns),dpipj(ns,ns), + piDpj(ns,ns) * * local variables: * RealType s(7),som,smax,xsom,xmax integer i,j,k,ip1,ip2,ip3,ipn,is1,is2,isi,is3,ihlp,iqn, + jsgn1,jsgn2,jsgn3,jsgnn,iadj(10,10,3:4),init,nm save iadj,init logical lmax,ltwist * * common blocks: * #include "ff.h" * * data * data iadj /200*0/ data init /0/ * #] declarations: * #[ initialisations: if ( init .eq. 0 ) then init = 1 * * Fill the array with adjacent values: if * x = iadj(i,j) * k = abs(mod(k,100)) * jsgnk = sign(x) * jsgnj = 1-2*theta(x-100) (ie -1 iff |x|>100) * then * pi(k) = jsgnk*( p(i) - jsgnj*pi(j) ) * do 5 nm=3,4 do 4 i=1,nm is1 = i is2 = i+1 if ( is2 .gt. nm ) is2 = 1 is3 = i-1 if ( is3 .eq. 0 ) is3 = nm ip1 = is1 + nm iadj(is1,is2,nm) = -ip1 iadj(is2,is1,nm) = ip1 iadj(ip1,is2,nm) = -is1 iadj(is2,ip1,nm) = is1 iadj(is1,ip1,nm) = 100+is2 iadj(ip1,is1,nm) = 100+is2 if ( nm .eq. 3 ) then iadj(ip1,is2+3,3) = -100-is3-3 iadj(is2+3,ip1,3) = -100-is3-3 endif 4 continue 5 continue iadj(3,1,4) = -9 iadj(1,3,4) = 9 iadj(9,1,4) = -3 iadj(1,9,4) = 3 iadj(3,9,4) = 100+1 iadj(9,3,4) = 100+1 iadj(2,4,4) = -10 iadj(4,2,4) = 10 iadj(10,4,4) = -2 iadj(4,10,4) = 2 iadj(2,10,4) = 100+4 iadj(10,2,4) = 100+4 endif if ( ns .eq. 6 ) then nm = 3 else nm = 4 endif * #] initialisations: * #[ easy tries: do 40 i=1,itime isi = i+is-1 lmax = .FALSE. * * get xpi(isi)*del2 - del3 ... if del3 and del2 are defined * if ( ldel ) then s(1) = xpi(isi)*del2 som = s(1) - del3 smax = abs(s(1)) if ( abs(som) .ge. xloss**2*smax ) goto 35 xsom = som xmax = smax lmax = .TRUE. endif ip1 = ip1n ip2 = ip2n ip3 = ip3n do 20 j=1,3 * * otherwise use the simple threeterm formula * s(1) = xpi(ip2)*piDpj(ip1,isi)**2 s(2) = xpi(ip1)*piDpj(ip2,isi)*piDpj(ip2,isi) s(3) = -2*piDpj(ip2,isi)*piDpj(ip2,ip1)*piDpj(ip1,isi) som = s(1) + s(2) + s(3) smax = max(abs(s(1)),abs(s(2)),abs(s(3))) if ( abs(som) .ge. xloss**2*smax ) goto 35 if ( .not. lmax .or. smax .lt. xmax ) then xsom = som xmax = smax lmax = .TRUE. endif * * if there are cancellations between two of the terms: * we try mixing with isi. * * First map cancellation to s(2)+s(3) (do not mess up * rotations...) * if ( abs(s(1)+s(3)) .lt. abs(s(3))/2 ) then ihlp = ip1 ip1 = ip2 ip2 = ihlp som = s(1) s(1) = s(2) s(2) = som ltwist = .TRUE. else ltwist = .FALSE. endif if ( abs(s(2)+s(3)) .lt. abs(s(3))/2 ) then * * switch to the vector pn so that si = jsgn1*p1 + jsgnn*pn * k = iadj(isi,ip1,nm) if ( k .ne. 0 ) then ipn = abs(k) jsgnn = isign(1,k) if ( ipn .gt. 100 ) then ipn = ipn - 100 jsgn1 = -1 else jsgn1 = +1 endif if (abs(dpipj(ipn,isi)).lt.xloss*abs(piDpj(ip1,isi)) + .and. + abs(piDpj(ipn,ip2)).lt.xloss*abs(piDpj(ip2,isi)) + ) then * same: s(1) = xpi(ip2)*piDpj(ip1,isi)**2 s(2) = jsgnn*piDpj(isi,ip2)*piDpj(ipn,ip2)* + xpi(ip1) s(3) = jsgn1*piDpj(isi,ip2)*piDpj(ip1,ip2)* + dpipj(ipn,isi) som = s(1) + s(2) + s(3) smax = max(abs(s(1)),abs(s(2)),abs(s(3))) if ( abs(som) .ge. xloss**2*smax ) goto 35 if ( smax .lt. xmax ) then xsom = som xmax = smax endif * * there may be a cancellation between s(1) and * s(2) left. Introduce a vector q such that * pn = jsgnq*q + jsgn2*p2. We also need the sign * jsgn3 in p3 = -p1 - jsgn3*p2 * k = iadj(ipn,ip2,nm) if ( k .ne. 0 ) then iqn = abs(k) if ( iqn .gt. 100 ) then iqn = iqn - 100 jsgn2 = -1 else jsgn2 = +1 endif k = iadj(ip1,ip2,nm) if ( k .eq. 0 .or. k .lt. 100 ) then * we have p1,p2,p3 all p's jsgn3 = +1 elseif ( k .lt. 0 ) then * ip1,ip2 are 2*s,1*p such that p2-p1=ip3 jsgn3 = -1 else jsgn3 = 0 endif * we need one condition on the signs for this * to work if ( ip3.ne.0 .and. jsgn1*jsgn2.eq.jsgnn* + jsgn3 .and. abs(s(3)).lt.xloss*smax ) then s(1) = piDpj(ip1,isi)**2*dpipj(iqn,ipn) s(2) = -jsgn2*jsgn1*piDpj(ipn,ip2)* + piDpj(ip1,isi)*dpipj(ipn,isi) * s(3) stays the same s(4) = -jsgn2*jsgn1*piDpj(ipn,ip2)* + xpi(ip1)*piDpj(isi,ip3) som = s(1) + s(2) + s(3) + s(4) smax =max(abs(s(1)),abs(s(2)),abs(s(3)), + abs(s(4))) if ( abs(som).ge.xloss**2*smax ) goto 35 if ( smax .lt. xmax ) then xsom = som xmax = smax endif endif endif endif endif k = iadj(isi,ip2,nm) if ( k .ne. 0 ) then ipn = abs(k) jsgnn = isign(1,k) if ( ipn .gt. 100 ) then jsgn1 = -1 ipn = ipn - 100 else jsgn1 = +1 endif if (abs(dpipj(ipn,isi)).lt.xloss*abs(piDpj(ip2,isi)) + .and. + abs(piDpj(ipn,ip1)).lt.xloss*abs(piDpj(ip1,isi)) + ) then s(1) = jsgnn*piDpj(isi,ip1)*piDpj(ipn,ip1)* + xpi(ip2) s(2) = xpi(ip1)*piDpj(ip2,isi)**2 s(3) = jsgn1*piDpj(isi,ip1)*piDpj(ip2,ip1)* + dpipj(ipn,isi) som = s(1) + s(2) + s(3) smax = max(abs(s(1)),abs(s(2)),abs(s(3))) print *,' (isi+ip2) with isi,ip1,ip2,ipn: ', + isi,ip1,ip2,ipn if ( abs(som) .ge. xloss**2*smax ) goto 35 if ( smax .lt. xmax ) then xsom = som xmax = smax endif endif endif endif * * rotate the ipi * if ( ip3 .eq. 0 ) goto 30 if ( j .ne. 3 ) then if ( .not. ltwist ) then ihlp = ip1 ip1 = ip2 ip2 = ip3 ip3 = ihlp else ihlp = ip2 ip2 = ip3 ip3 = ihlp endif endif 20 continue 30 continue * #] easy tries: * #[ choose the best value: * * These values are the best found: * som = xsom smax = xmax 35 continue del3mi(i) = som 40 continue * #] choose the best value: *###] ffdl3m: end LoopTools-2.16/src/B/PaxHeaders/ffxb0.F0000644000000000000000000000013114160633472014543 xustar0029 mtime=1640183610.83547285 30 atime=1648161785.723698464 30 ctime=1648161793.715764879 LoopTools-2.16/src/B/ffxb0.F0000644000000000000000000005522014160633472015470 0ustar00rootroot00000000000000#include "externals.h" #include "types.h" *###[ ffxb0: subroutine ffxb0(cb0,xp,xma,xmb,ier) ***#[*comment:*********************************************************** * * * Calculates the the two-point function (cf 't Hooft and Veltman) * * we include an overall factor 1/(i*pi^2) relative to FormF * * * * Input: xp (real) k2, in B&D metric * * xma (real) mass2 * * xmb (real) mass2 * * * * Output: cb0 (complex) B0, the two-point function, * * ier (integer) # of digits lost, if >=100: error * * * * Calls: ffxb0p * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments * integer ier ComplexType cb0 RealType xp,xma,xmb * * local variables * ComplexType cb0p RealType dmamb,dmap,dmbp,xm * * common blocks * #include "ff.h" * * #] declarations: * #[ get differences: dmamb = xma - xmb dmap = xma - xp dmbp = xmb - xp * #] get differences: * #[ calculations: call ffxb0p(cb0p,xp,xma,xmb,dmap,dmbp,dmamb,ier) if ( xma .eq. 0 ) then if ( xmb .eq. 0 ) then xm = 1D0 else xm = xmb**2 endif elseif ( xmb .eq. 0 ) then xm = xma**2 else xm = xma*xmb endif if ( mudim .ne. 0 ) xm = xm/mudim**2 if ( abs(xm) .gt. xalogm ) then cb0 = Re(delta - log(xm)/2D0) - cb0p else call fferr(4,ier) cb0 = Re(delta) - cb0p endif * #] calculations: *###] ffxb0: end *###[ ffxb0p: subroutine ffxb0p(cb0p,xp,xma,xmb,dmap,dmbp,dmamb,ier) ***#[*comment:*********************************************************** * * * calculates the two-point function (see 't Hooft and * * Veltman) for all possible cases: masses equal, unequal, * * equal to zero. * * * * Input: xp (real) p.p, in B&D metric * * xma (real) mass2, * * xmb (real) mass2, * * dm[ab]p (real) xm[ab] - xp * * dmamb (real) xma - xmb * * * * Output: cb0p (complex) B0, the two-point function, minus * * log(xm1*xm2)/2, delta and ipi^2 * * ier (integer) 0=ok, 1=numerical problems, 2=error * * * * Calls: ffxb0q. * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments * integer ier ComplexType cb0p RealType xp,xma,xmb,dmap,dmbp,dmamb * * local variables * integer i,initeq,initn1,jsign RealType ax,ay,ffbnd, + xprceq,bdeq01,bdeq05,bdeq11,bdeq17, + xprcn1,bdn101,bdn105,bdn110,bdn115, + xprnn2,bdn205,bdn210,bdn215,bdn220, + xprcn3,bdn301,bdn305,bdn310,bdn315, + xprcn5,bdn501,bdn505,bdn510,bdn515, + absc RealType xm,dmp,xm1,xm2,dm1m2,dm1p, + dm2p,s,s1,s1a,s1b,s1p,s2,s2a,s2b,s2p,x,y,som, + xlam,slam,xlogmm,alpha,alph1,xnoe,xpneq(30), + xpnn1(30),xx,xtel,dfflo1 ComplexType cs2a,cs2b,cs2p,c,cx external ffbnd,dfflo1 save initeq,initn1,xpneq,xpnn1, + xprceq,bdeq01,bdeq05,bdeq11,bdeq17, + xprcn1,bdn101,bdn105,bdn110,bdn115, + xprnn2,bdn205,bdn210,bdn215,bdn220, + xprcn3,bdn301,bdn305,bdn310,bdn315, + xprcn5,bdn501,bdn505,bdn510,bdn515 * * common blocks * #include "ff.h" * * data * data xprceq /-1D0/ data xprcn1 /-1D0/ data xprnn2 /-1D0/ data xprcn3 /-1D0/ data xprcn5 /-1D0/ data initeq /0/ data initn1 /0/ * * statement function * absc(c) = abs(Re(c)) + abs(Im(c)) * #] declarations: * #[ fill some dotproducts: if ( ldot ) then call ffdot2(fpij2,xp,xma,xmb,dmap,dmbp,dmamb,ier) endif * #] fill some dotproducts: * #[ which case: * * sort according to the type of masscombination encountered: * 100: both masses zero, 200: one equal to zero, 300: both equal * 400: rest. * if ( xma .eq. 0 ) then if ( xmb .eq. 0 ) then goto 100 endif xm = xmb dmp = dmbp goto 200 endif if ( xmb .eq. 0 ) then xm = xma dmp = dmap goto 200 elseif ( dmamb .eq. 0 ) then xm = xma dmp = dmap goto 300 elseif ( xma .gt. xmb ) then xm2 = xma xm1 = xmb dm1m2 = -dmamb dm1p = dmbp dm2p = dmap else xm1 = xma xm2 = xmb dm1m2 = dmamb dm1p = dmap dm2p = dmbp endif goto 400 * #] which case: * #[ both masses equal to zero: 100 continue if ( xp .lt. -xalogm ) then cb0p = log(-xp) - 2 elseif ( xp .gt. xalogm ) then cb0p = ToComplex( Re(log(xp) - 2), Re(-pi) ) else cb0p = 0 call fferr(7,ier) endif return * #] both masses equal to zero: * #[ one mass equal to zero: 200 continue * * special case xp = 0 * if ( xp .eq. 0 ) then cb0p = -1 goto 990 * * special case xp = xm * elseif ( dmp.eq.0 ) then cb0p = -2 goto 990 endif * * Normal case: * s1 = xp/xm if ( abs(s1) .lt. xloss ) then s = dfflo1(s1,ier) else s = log(abs(dmp/xm)) endif s = -s*dmp/xp cb0p = s - 2 if ( xp .gt. xm ) + cb0p = cb0p - ToComplex(0D0,-(dmp/xp)*pi) goto 990 * #] one mass equal to zero: * #[ both masses equal: 300 continue * * Both masses are equal. Not only this speeds up things, some * cancellations have to be avoided as well. * * first a special case * if ( abs(xp) .lt. 8*xloss*xm ) then * -#[ taylor expansion: * * a Taylor expansion seems appropriate as the result will go * as k^2 but seems to go as 1/k !! * *--#[ data and bounds: if ( initeq .eq. 0 ) then initeq = 1 xpneq(1) = 1D0/6D0 do 1 i=2,30 xpneq(i) = - xpneq(i-1)*Re(i-1)/Re(2*(2*i+1)) 1 continue endif if (xprceq .ne. precx ) then * * calculate the boundaries for the number of terms to be * included in the taylorexpansion * xprceq = precx bdeq01 = ffbnd(1,1,xpneq) bdeq05 = ffbnd(1,5,xpneq) bdeq11 = ffbnd(1,11,xpneq) bdeq17 = ffbnd(1,17,xpneq) endif *--#] data and bounds: x = -xp/xm ax = abs(x) if ( ax .gt. bdeq17 ) then som = x*(xpneq(18) + x*(xpneq(19) + x*(xpneq(20) + + x*(xpneq(21) + x*(xpneq(22) + x*(xpneq(23) + + x*(xpneq(24) + x*xpneq(25) ))))))) else som = 0 endif if ( ax .gt. bdeq11 ) then som = x*(xpneq(12) + x*(xpneq(13) + x*(xpneq(14) + + x*(xpneq(15) + x*(xpneq(16) + x*(xpneq(17) + som )))) + )) endif if ( ax .gt. bdeq05 ) then som = x*(xpneq(6) + x*(xpneq(7) + x*(xpneq(8) + x*( + xpneq(9) + x*(xpneq(10) + x*(xpneq(11) + som )))))) endif if ( ax .gt. bdeq01 ) then som = x*(xpneq(2) + x*(xpneq(3) + x*(xpneq(4) + x*( + xpneq(5) + som )))) endif cb0p = x*(xpneq(1)+som) goto 990 * -#] taylor expansion: endif * -#[ normal case: * * normal case * call ffxlmb(xlam,-xp,-xm,-xm,dmp,dmp,0D0) if ( xlam .ge. 0 ) then * cases 1,2 and 4 slam = sqrt(xlam) s2a = dmp + xm s2 = s2a + slam if ( abs(s2) .gt. xloss*slam ) then * looks fine jsign = 1 else s2 = s2a - slam jsign = -1 endif ax = abs(s2/(2*xm)) if ( ax .lt. xalogm ) then s = 0 elseif( ax-1 .lt. .1 .and. s2 .gt. 0 ) then * In this case a quicker and more accurate way is to * calculate log(1-x). s2 = (xp - slam) * the following line is superfluous. s = -slam/xp*dfflo1(s2/(2*xm),ier) else * finally the normal case s = -slam/xp*log(ax) if ( jsign .eq. -1 ) s = -s endif if ( xp .gt. 2*xm ) then * in this case ( xlam>0, so xp>(2*m)^2) ) there also * is an imaginary part y = -pi*slam/xp else y = 0 endif else * the root is complex (k^2 between 0 and (2*m1)^2) slam = sqrt(-xlam) s = 2*slam/xp*atan2(xp,slam) y = 0 endif xx = s - 2 cb0p = ToComplex(Re(xx),Re(y)) goto 990 * -#] normal case: * * #] both masses equal: * #[ unequal nonzero masses: * -#[ get log(xm2/xm1): 400 continue x = xm2/xm1 if ( 1 .lt. xalogm*x ) then call fferr(8,ier) xlogmm = 0 elseif ( abs(x-1) .lt. xloss ) then xlogmm = dfflo1(dm1m2/xm1,ier) else xlogmm = log(x) endif * -#] get log(xm2/xm1): * -#[ xp = 0: * * first a special case * if ( xp .eq. 0 ) then s2 = ((xm2+xm1) / dm1m2)*xlogmm s = - s2 - 2 * save the factor 1/2 for the end if ( abs(s) .lt. xloss*2 ) then * Taylor expansions: choose which one x = dm1m2/xm1 ax = abs(x) if ( ax .lt. .15 .or. precx .gt. 1.E-8 .and. ax + .lt. .3 ) then * * This is the simple Taylor expansion 'n1' * *--#[ data and bounds: * get the coefficients of the taylor expansion if ( initn1 .eq. 0 ) then initn1 = 1 do i = 1,30 xpnn1(i) = Re(i)/Re((i+1)*(i+2)) enddo endif * determine the boundaries for 1,5,10,15 terms if ( xprcn1 .ne. precx ) then xprcn1 = precx bdn101 = ffbnd(1,1,xpnn1) bdn105 = ffbnd(1,5,xpnn1) bdn110 = ffbnd(1,10,xpnn1) bdn115 = ffbnd(1,15,xpnn1) endif *--#] data and bounds: * calculate: if ( ax .gt. bdn115 ) then s = x*(xpnn1(16) + x*(xpnn1(17) + x*(xpnn1(18) + + x*(xpnn1(19) + x*xpnn1(20) )))) else s = 0 endif if ( ax .gt. bdn110 ) then s = x*(xpnn1(11) + x*(xpnn1(12) + x*(xpnn1(13) + + x*(xpnn1(14) + x*xpnn1(15) + s)))) endif if ( ax .gt. bdn105 ) then s = x*(xpnn1(6) + x*(xpnn1(7) + x*(xpnn1(8) + x* + (xpnn1(9) + x*(xpnn1(10) + s))))) endif if ( ax .gt. bdn101 ) then s = x*(xpnn1(2) + x*(xpnn1(3) + x*(xpnn1(4) + x* + (xpnn1(5) +s)))) endif s = x*x*(xpnn1(1) + s) else * * This is the more complicated Taylor expansion 'fc' * * #[ bounds: * determine the boundaries for 1,5,10,15 terms for * the exponential taylor expansion, assuming it * starts at n=2. * if ( xprnn2 .ne. precx ) then xprnn2 = precx bdn205 = ffbnd(4,5,xinfac) bdn210 = ffbnd(4,10,xinfac) bdn215 = ffbnd(4,15,xinfac) bdn220 = ffbnd(4,20,xinfac) endif * #] bounds: * calculate: y = 2*x/(2-x) ay = abs(y) if ( ay .gt. bdn220 ) then s = y*(xinfac(19) + y*(xinfac(20) + y*(xinfac( + 21) + y*(xinfac(22) + y*xinfac( + 23) )))) else s = 0 endif if ( ay .gt. bdn215 ) then s = y*(xinfac(14) + y*(xinfac(15) + y*(xinfac( + 16) + y*(xinfac(17) + y*(xinfac( + 18) + s))))) endif if ( ay .gt. bdn210 ) then s = y*(xinfac(9) + y*(xinfac(10) + y*(xinfac(11) + + y*(xinfac(12) + y*(xinfac(13) + s))))) endif if ( ay .gt. bdn205 ) then s = y*(xinfac(5) + y*(xinfac(6) + y*(xinfac(7) + + y*(xinfac(8) + s)))) endif s = (1-x)*y**4*(xinfac(4)+s) s = x*y**2*(1+y)/12 - s s = - 2*dfflo1(s,ier)/y endif endif cb0p = s/2 goto 990 endif * -#] xp = 0: * -#[ normal case: * * proceeding with the normal case * call ffxlmb(xlam,-xp,-xm2,-xm1,dm2p,dm1p,dm1m2) if ( xlam .gt. 0 ) then * cases k^2 < -(m2+m1)^2 or k^2 > -(m2-m1)^2: *--#[ first try: * first try the normal way slam = sqrt(xlam) s2a = dm2p + xm1 s2 = s2a + slam if ( abs(s2) .gt. xloss*slam ) then * looks fine jsign = 1 else s2 = s2a - slam jsign = -1 endif s2 = s2**2/(4*xm1*xm2) if ( abs(s2) .lt. xalogm ) then call fferr(9,ier) s2 = 0 elseif ( abs(s2-1) .lt. xloss ) then if ( jsign.eq.1 ) then s2 = -slam*(s2a+slam)/(2*xm1*xm2) s2 = -slam/(2*xp)*dfflo1(s2,ier) else s2 = +slam*(s2a-slam)/(2*xm1*xm2) s2 = +slam/(2*xp)*dfflo1(s2,ier) endif else s2 = -slam/(2*xp)*log(s2) if ( jsign .eq. -1 ) s2 = -s2 endif s1 = -dm1m2*xlogmm/(2*xp) xx = s1+s2-2 *--#] first try: if ( abs(xx) .lt. xloss*max(abs(s1),abs(s2)) ) then *--#[ second try: * this is unacceptable, try a better solution s1a = dm1m2 + slam if ( abs(s1a) .gt. xloss*slam ) then * (strangely) this works s1 = -s1a/(2*xp) else * by division a more accurate form can be found s1 = ( -xp/2 + xm1 + xm2 ) / ( slam - dm1m2 ) endif s1 = s1*xlogmm if ( abs(xp) .lt. xm2 ) then s2a = xp - dm1m2 else s2a = xm2 - dm1p endif s2 = s2a - slam if ( abs(s2) .gt. xloss*slam ) then * at least reasonable s2 = s2 / (2*xm2) else * division again s2 = (2*xp) / (s2a+slam) endif if ( abs(s2) .lt. .1 ) then * choose a quick way to get the logarithm s2 = dfflo1(s2,ier) else s2a = abs(1-s2) s2 = log(s2a) endif s2 = -(slam/xp)*s2 xx = s1 + s2 - 2 *--#] second try: if ( abs(xx) .lt. xloss**2*max(abs(s1),abs(s2)) ) then *--#[ third try: * (we accept two times xloss because that's the same * as in this try) * A Taylor expansion might work. We expand * inside the logs. Only do the necessary work. * alpha = slam/(slam-dm1m2) alph1 = -dm1m2/(slam-dm1m2) * * First s1: * s1p = s1 - 2*alph1 if ( abs(s1p) .lt. xloss*abs(s1) ) then * -#[ bounds: * determine the boundaries for 1,5,10,15 terms if ( xprcn3 .ne. precx ) then xprcn3 = precx bdn301 = ffbnd(3,1,xinfac) bdn305 = ffbnd(3,5,xinfac) bdn310 = ffbnd(3,10,xinfac) bdn315 = ffbnd(3,15,xinfac) endif * -#] bounds: xnoe = -xp + 2*xm1 + 2*xm2 x = 4*dm1m2/xnoe ax = abs(x) if ( ax .gt. bdn310 ) then s1a = x*(xinfac(13) + x*(xinfac(14) + x*( + xinfac(15) + x*(xinfac(16) + x* + xinfac(17) )))) else s1a = 0 endif if ( ax .gt. bdn305 ) then s1a = x*(xinfac(8) + x*(xinfac(9) + x*( + xinfac(10) + x*(xinfac(11) + x*( + xinfac(12) + s1a))))) endif if ( ax .gt. bdn301 ) then s1a = x*(xinfac(4) + x*(xinfac(5) + x*( + xinfac(6) + x*(xinfac(7) + s1a)))) endif s1a = x**3 *(xinfac(3) + s1a) *xm2/xm1 s1b = dm1m2*(4*dm1m2**2 - xp*(4*xm1-xp))/ + (xm1*xnoe**2) s1p = s1b - s1a s1p = xnoe*dfflo1(s1p,ier)/(slam - dm1m2)/2 endif * * next s2: * s2p = s2 - 2*alpha if ( abs(s2p) .lt. xloss*abs(s2) ) then * -#[ bounds: * determine the boundaries for 1,5,10,15 terms if ( xprcn5 .ne. precx ) then xprcn5 = precx bdn501 = ffbnd(4,1,xinfac) bdn505 = ffbnd(4,5,xinfac) bdn510 = ffbnd(4,10,xinfac) bdn515 = ffbnd(4,15,xinfac) endif * -#] bounds: xnoe = slam - dm1m2 x = 2*xp/xnoe ax = abs(x) * do not do the Taylor expansion if ( ax .gt. bdn515 ) goto 495 if ( ax .gt. bdn510 ) then s2a = x*(xinfac(14) + x*(xinfac(15) + x*( + xinfac(16) + x*(xinfac(17) + x* + xinfac(18) )))) else s2a = 0 endif if ( ax .gt. bdn505 ) then s2a = x*(xinfac(9) + x*(xinfac(10) + x*( + xinfac(11) + x*(xinfac(12) + x*( + xinfac(13) + s2a))))) endif if ( ax .gt. bdn501 ) then s2a = x*(xinfac(5) + x*(xinfac(6) + x*( + xinfac(7) + x*(xinfac(8) + s2a)))) endif s2a = x**4*(xinfac(4)+s2a)*(1-2*xp/(xnoe+xp)) s2b = -2*xp**3 *(-2*xp - xnoe)/(3*(xnoe+xp)* + xnoe**3) s2p = s2b - s2a s2p = -slam/xp*dfflo1(s2p,ier) endif * * finally ... * 495 xx = s1p + s2p *--#] third try: endif endif if ( xp .gt. xm1+xm2 ) then *--#[ imaginary part: * in this case ( xlam>0, so xp>(m1+m2)^2) ) there also * is an imaginary part y = -pi*slam/xp else y = 0 *--#] imaginary part: endif else * the root is complex (k^2 between -(m1+m2)^2 and -(m2-m1)^2) *--#[ first try: slam = sqrt(-xlam) xnoe = dm2p + xm1 s1 = -(dm1m2/(2*xp))*xlogmm s2 = (slam/xp)*atan2(slam,xnoe) xx = s1 + s2 - 2 *--#] first try: * 13 Apr 11: added x .ne. 0 check to safeguard against div by zero x = 2*xp*xnoe if ( x .ne. 0 .and. & abs(xx) .lt. xloss**2*max(abs(s1),abs(s2)) ) then *--#[ second try: * Again two times xloss as we'll accept that in the next * step as well. * xtel = dm1m2**2 - xp**2 alpha = -xlam/x alph1 = xtel/x * * try a taylor expansion on the terms. First s1: * s1p = s1 - 2*alph1 if ( abs(s1p) .lt. xloss*abs(s1) ) then * -#[ bounds: * determine the boundaries for 1,5,10,15 terms if ( xprcn3 .ne. precx ) then xprcn3 = precx bdn301 = ffbnd(3,1,xinfac) bdn305 = ffbnd(3,5,xinfac) bdn310 = ffbnd(3,10,xinfac) bdn315 = ffbnd(3,15,xinfac) endif * -#] bounds: x = 2*xtel/(dm1m2*xnoe) ax = abs(x) * do not do the Taylor expansion if ( ax .gt. bdn315 ) goto 590 if ( ax .gt. bdn310 ) then s1a = x*(xinfac(13) + x*(xinfac(14) + x*( + xinfac(15) + x*(xinfac(16) + x* + xinfac(17) )))) else s1a = 0 endif if ( ax .gt. bdn305 ) then s1a = x*(xinfac(8) + x*(xinfac(9) + x*( + xinfac(10) + x*(xinfac(11) + x*( + xinfac(12) + s1a))))) endif if ( ax .gt. bdn301 ) then s1a = x*(xinfac(4) + x*(xinfac(5) + x*( + xinfac(6) + x*(xinfac(7) + s1a)))) endif s1a = x**3 *(xinfac(3) + s1a) *xm2/xm1 s1b = (dm1m2**3*(dm1m2**2-2*xp*xm1) + xp**2*(4* + dm1m2*xm1**2-dm1m2**2*(dm1m2+2*xm1))-2*xm2* + xp**3*(dm1m2+xp))/(xm1*dm1m2**2*xnoe**2) s1p = s1b - s1a s1p = -dm1m2*dfflo1(s1p,ier)/(2*xp) endif * * next s2: * 590 continue s2p = s2 - 2*alpha if ( abs(s2p) .lt. xloss*abs(s2) ) then * -#[ bounds: * determine the boundaries for 1,5,10,15 terms if ( xprcn3 .ne. precx ) then xprcn3 = precx bdn301 = ffbnd(3,1,xinfac) bdn305 = ffbnd(3,5,xinfac) bdn310 = ffbnd(3,10,xinfac) bdn315 = ffbnd(3,15,xinfac) endif * -#] bounds: cx = ToComplex(0D0,-slam/xnoe) ax = absc(cx) if ( ax .gt. bdn315 ) goto 600 if ( ax .gt. bdn310 ) then cs2a = cx*(Re(xinfac(13)) + cx*(Re(xinfac(14 + )) + cx*(Re(xinfac(15)) + cx*(Re(xinfac(16 + )) + cx*(Re(xinfac(17))))))) else cs2a = 0 endif if ( ax .gt. bdn305 ) then cs2a = cx*(Re(xinfac(8)) + cx*(Re(xinfac(9)) + + cx*(Re(xinfac(10)) + cx*(Re(xinfac(11)) + + cx*(Re(xinfac(12)) + cs2a))))) endif if ( ax .gt. bdn301 ) then cs2a = cx*(Re(xinfac(4)) + cx*(Re(xinfac(5)) + + cx*(Re(xinfac(6)) + cx*(Re(xinfac(7)) + + cs2a)))) endif cs2a = cx**3*(Re(xinfac(3))+cs2a)* + ToComplex(Re(xnoe),Re(slam)) cs2b = ToComplex(Re(xnoe-xlam/xnoe/2), + -Re(slam**3/xnoe**2/2)) cs2p = cs2b + cs2a s2p = slam*atan2(Im(cs2p),Re(cs2p))/xp endif 600 continue xx = s1p + s2p *--#] second try: endif y = 0 endif cb0p = ToComplex(Re(xx),Re(y)) goto 990 * -#] normal case: * #] unequal nonzero masses: * #[ debug: 990 continue * #] debug: *###] ffxb0p: end *###[ ffxlmb: subroutine ffxlmb(xlambd,a1,a2,a3,a12,a13,a23) ***#[*comment:*********************************************************** * calculate in a numerically stable way * * lambda(a1,a2,a3) = * * a1**2 + a2**2 + a3**2 - 2*a2*a3 - 2*a3*a1 - 2*a1*a2 * * aij = ai - aj are required for greater accuracy at times * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments * RealType xlambd,a1,a2,a3,a12,a13,a23 * * local variables * RealType aa1,aa2,aa3,a,aff,asq * * common blocks * #include "ff.h" * #] declarations: * #[ calculations: aa1 = abs(a1) aa2 = abs(a2) aa3 = abs(a3) * * first see if there are input parameters with opposite sign: * if ( a1 .lt. 0 .and. a2 .gt. 0 .or. + a1 .gt. 0 .and. a2 .lt. 0 ) then goto 12 elseif ( a1 .lt. 0 .and. a3 .gt. 0 .or. + a1 .gt. 0 .and. a3 .lt. 0 ) then goto 13 * * all have the same sign, choose the smallest 4*ai*aj term * elseif ( aa1 .gt. aa2 .and. aa1 .gt. aa3 ) then goto 23 elseif ( aa2 .gt. aa3 ) then goto 13 else goto 12 endif 12 continue if ( aa1 .gt. aa2 ) then a = a13 + a2 else a = a1 + a23 endif aff = 4*a1*a2 goto 100 13 continue if ( aa1 .gt. aa3 ) then a = a12 + a3 else a = a1 - a23 endif aff = 4*a1*a3 goto 100 23 continue if ( aa2 .gt. aa3 ) then a = a12 - a3 else a = a13 - a2 endif aff = 4*a2*a3 100 continue asq = a**2 xlambd = asq - aff * #] calculations: *###] ffxlmb: end *###[ ffclmb: subroutine ffclmb(clambd,cc1,cc2,cc3,cc12,cc13,cc23) ***#[*comment:*********************************************************** * calculate in cc numerically stable way * * lambda(cc1,cc2,cc3) = * * cc1**2 + cc2**2 + cc3**2 - 2*cc2*cc3 - 2*cc3*cc1 - 2*cc1*cc2 * * cij = ci - cj are required for greater accuracy at times * * ier is the usual error flag. * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments * ComplexType clambd,cc1,cc2,cc3,cc12,cc13,cc23 * * local variables * RealType aa1,aa2,aa3,absc ComplexType cc,cff,csq,c * * common blocks * #include "ff.h" * * statement function * absc(c) = abs(Re(c)) + abs(Im(c)) * #] declarations: * #[ calculations (rather old style ...): aa1 = absc(cc1) aa2 = absc(cc2) aa3 = absc(cc3) * * first see if there are input parameters with opposite sign: * if ( Re(cc1) .lt. 0 .and. Re(cc2) .gt. 0 .or. + Re(cc1) .gt. 0 .and. Re(cc2) .lt. 0 ) then goto 12 elseif ( Re(cc1) .lt. 0 .and. Re(cc3) .gt. 0 .or. + Re(cc1) .gt. 0 .and. Re(cc3) .lt. 0 ) then goto 13 * * all have the same sign, choose the smallest 4*ci*cj term * elseif ( aa1 .gt. aa2 .and. aa1 .gt. aa3 ) then goto 23 elseif ( aa2 .gt. aa3 ) then goto 13 else goto 12 endif 12 continue if ( aa1 .gt. aa2 ) then cc = cc13 + cc2 else cc = cc1 + cc23 endif cff = 4*cc1*cc2 goto 100 13 continue if ( aa1 .gt. aa3 ) then cc = cc12 + cc3 else cc = cc1 - cc23 endif cff = 4*cc1*cc3 goto 100 23 continue if ( aa2 .gt. aa3 ) then cc = cc12 - cc3 else cc = cc13 - cc2 endif cff = 4*cc2*cc3 100 continue csq = cc**2 clambd = csq - cff * #] calculations (rather old style ...): *###] ffclmb: end *###[ ffdot2: subroutine ffdot2(piDpj,xp,xma,xmb,dmap,dmbp,dmamb,ier) ***#[*comment:*********************************************************** * * * Store the 3 dotproducts in the common block ffdot. * * * * Input: see ffxb0p * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments * integer ier RealType piDpj(3,3),xp,xma,xmb,dmap,dmbp,dmamb * * local variables * integer ier1 * * common blocks * #include "ff.h" * * statement function * * absc(c) = abs(Re(c)) + abs(Im(c)) * #] declarations: * #[ work: ier1 = ier piDpj(1,1) = xma piDpj(2,2) = xmb piDpj(3,3) = xp if ( abs(dmap) .lt. abs(dmbp) ) then piDpj(1,2) = (dmap + xmb)/2 else piDpj(1,2) = (dmbp + xma)/2 endif piDpj(2,1) = piDpj(1,2) if ( abs(dmamb) .lt. abs(dmbp) ) then piDpj(1,3) = (-dmamb - xp)/2 else piDpj(1,3) = (dmbp - xma)/2 endif piDpj(3,1) = piDpj(1,3) if ( abs(dmamb) .lt. abs(dmap) ) then piDpj(2,3) = (-dmamb + xp)/2 else piDpj(2,3) = (-dmap + xmb)/2 endif piDpj(3,2) = piDpj(2,3) ier = ier1 * #] work: *###] ffdot2: end LoopTools-2.16/src/B/PaxHeaders/ffcel2.F0000644000000000000000000000007411776502522014706 xustar0030 atime=1648161785.727698497 30 ctime=1648161793.715764879 LoopTools-2.16/src/B/ffcel2.F0000644000000000000000000003231211776502522015622 0ustar00rootroot00000000000000#include "externals.h" #include "types.h" *###[ ffcel2: subroutine ffcel2(del2,piDpj,ns,i1,i2,i3,lerr,ier) ************************************************************************* * calculate in a numerically stable way * * del2(piDpj(i1,i1),piDpj(i2,i2),piDpj(i3,i3)) = * * = piDpj(i1,i1)*piDpj(i2,i2) - piDpj(i1,i2)^2 * * = piDpj(i1,i1)*piDpj(i3,i3) - piDpj(i1,i3)^2 * * = piDpj(i2,i2)*piDpj(i3,i3) - piDpj(i2,i3)^2 * * ier is the usual error flag. * ************************************************************************* implicit none * * arguments: * integer ns,i1,i2,i3,lerr,ier ComplexType del2,piDpj(ns,ns) * * local variables * ComplexType s1,s2,cc RealType absc * * common blocks * #include "ff.h" * absc(cc) = abs(Re(cc)) + abs(Im(cc)) * * calculations * if ( absc(piDpj(i1,i2)) .lt. absc(piDpj(i1,i3)) .and. + absc(piDpj(i1,i2)) .lt. absc(piDpj(i2,i3)) ) then s1 = piDpj(i1,i1)*piDpj(i2,i2) s2 = piDpj(i1,i2)**2 elseif ( absc(piDpj(i1,i3)) .lt. absc(piDpj(i2,i3)) ) then s1 = piDpj(i1,i1)*piDpj(i3,i3) s2 = piDpj(i1,i3)**2 else s1 = piDpj(i2,i2)*piDpj(i3,i3) s2 = piDpj(i2,i3)**2 endif del2 = s1 - s2 if ( absc(del2) .lt. xloss*absc(s2) ) then if ( lerr .eq. 0 ) then * we know we have another chance if ( del2.ne.0 ) then ier = ier + int(log10(xloss*absc(s2)/absc(del2))) else ier = ier + int(log10(xloss*absc(s2)/xclogm)) endif endif endif *###] ffcel2: end *###[ ffcl2p: subroutine ffcl2p(delps1,xpi,dpipj,piDpj, + ip1,ip2,ip3,is1,is2,is3,ns) ***#[*comment:*********************************************************** * * * calculate in a numerically stable way * * delta_{ip1,is2}^{ip1,ip2} * * ier is the usual error flag. * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments: * integer ns,ip1,ip2,ip3,is1,is2,is3 ComplexType delps1,xpi(ns),dpipj(ns,ns),piDpj(ns,ns) * * local variables * ComplexType s1,s2,s3,som,c RealType xmax,absc * * common blocks * #include "ff.h" * * statement function * absc(c) = abs(Re(c)) + abs(Im(c)) * #] declarations: * #[ stupid tree: * 1 s1 = xpi(ip1)*piDpj(ip2,is2) s2 = piDpj(ip1,ip2)*piDpj(ip1,is2) delps1 = s1 - s2 if ( absc(delps1) .ge. xloss*absc(s1) ) goto 100 som = delps1 xmax = absc(s1) * 2 s1 = piDpj(ip1,ip2)*piDpj(ip3,is2) s2 = piDpj(ip1,ip3)*piDpj(ip2,is2) delps1 = s1 - s2 if ( absc(delps1) .ge. xloss*absc(s1) ) goto 100 if ( absc(s1) .lt. xmax ) then som = delps1 xmax = absc(s1) endif * 3 s1 = piDpj(ip1,ip3)*piDpj(ip1,is2) s2 = xpi(ip1)*piDpj(ip3,is2) delps1 = s1 - s2 if ( absc(delps1) .ge. xloss*absc(s1) ) goto 100 if ( absc(s1) .lt. xmax ) then som = delps1 xmax = absc(s1) endif * 4 s1 = xpi(ip1)*piDpj(ip2,is1) s2 = piDpj(ip1,is1)*piDpj(ip1,ip2) delps1 = s1 - s2 if ( absc(delps1) .ge. xloss*absc(s1) ) goto 100 if ( absc(s1) .lt. xmax ) then som = delps1 xmax = absc(s1) endif * 5 s1 = piDpj(ip1,is2)*piDpj(ip2,is1) s2 = piDpj(ip1,is1)*piDpj(ip2,is2) delps1 = s1 - s2 if ( absc(delps1) .ge. xloss*absc(s1) ) goto 100 if ( absc(s1) .lt. xmax ) then som = delps1 xmax = absc(s1) endif * 6 s1 = piDpj(ip1,ip2)*piDpj(ip3,is1) s2 = piDpj(ip1,ip3)*piDpj(ip2,is1) delps1 = s1 - s2 if ( absc(delps1) .ge. xloss*absc(s1) ) goto 100 if ( absc(s1) .lt. xmax ) then som = delps1 xmax = absc(s1) endif * 7 s1 = piDpj(ip2,is2)*piDpj(ip3,is1) s2 = piDpj(ip2,is1)*piDpj(ip3,is2) delps1 = s1 - s2 if ( absc(delps1) .ge. xloss*absc(s1) ) goto 100 if ( absc(s1) .lt. xmax ) then som = delps1 xmax = absc(s1) endif * 8 s1 = piDpj(ip1,ip3)*piDpj(ip1,is1) s2 = xpi(ip1)*piDpj(ip3,is1) delps1 = s1 - s2 if ( absc(delps1) .ge. xloss*absc(s1) ) goto 100 if ( absc(s1) .lt. xmax ) then som = delps1 xmax = absc(s1) endif * 9 s1 = piDpj(ip1,is1)*piDpj(ip3,is2) s2 = piDpj(ip1,is2)*piDpj(ip3,is1) delps1 = s1 - s2 if ( absc(delps1) .ge. xloss*absc(s1) ) goto 100 if ( absc(s1) .lt. xmax ) then som = delps1 xmax = absc(s1) endif *10 22-nov-1993 yet another one if ( dpipj(1,1).eq.0 ) then s1 = +xpi(ip1)*dpipj(is3,is2)/2 s2 = -piDpj(ip1,ip2)*dpipj(is2,is1)/2 s3 = +xpi(ip1)*piDpj(ip2,ip3)/2 delps1 = s1+s2+s3 if ( absc(delps1) .ge. xloss*max(absc(s1),absc(s2)) ) + goto 100 if ( max(absc(s1),absc(s2)) .lt. xmax ) then som = delps1 xmax = absc(s1) endif endif * NO possibility delps1 = som 100 continue * #] stupid tree: *###] ffcl2p: end *###[ ffcl2t: subroutine ffcl2t(delps,piDpj,in,jn,kn,ln,lkn,islk,iss,ns) ***#[*comment:*********************************************************** * * * calculate in a numerically stable way * * * * \delta_{si,sj}^{sk,sl} * * * * with p(lk) = islk*(iss*sl - sk) (islk,iss = +/-1) * * and NO relationship between s1,s2 assumed (so 1/2 the * * possibilities of ffdl2s). * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments: * integer in,jn,kn,ln,lkn,islk,iss,ns ComplexType delps,piDpj(ns,ns) * * local variables * ComplexType s1,s2,c RealType absc * * common blocks * #include "ff.h" * * statement function * absc(c) = abs(Re(c)) + abs(Im(c)) * #] declarations: * #[ calculations: if ( in .eq. jn ) then delps = 0D0 return endif s1 = piDpj(kn,in)*piDpj(ln,jn) s2 = piDpj(ln,in)*piDpj(kn,jn) delps = s1 - s2 if ( absc(delps) .ge. xloss*absc(s1) ) goto 10 s1 = piDpj(kn,in)*piDpj(lkn,jn) s2 = piDpj(lkn,in)*piDpj(kn,jn) delps = iss*islk*(s1 - s2) if ( absc(delps) .ge. xloss*absc(s1) ) goto 10 s1 = piDpj(lkn,in)*piDpj(ln,jn) s2 = piDpj(ln,in)*piDpj(lkn,jn) delps = islk*(- s1 + s2) if ( absc(delps) .ge. xloss*absc(s1) ) goto 10 10 continue * #] calculations: *###] ffcl2t: end *###[ ffcl3m: subroutine ffcl3m(del3mi,ldel,del3,del2,xpi,dpipj,piDpj,ns,ip1n, + ip2n,ip3n,is,itime) ***#[*comment:*********************************************************** * * * Calculate xpi(i)*del2 - del3(piDpj) * * * * / si mu \2 (This appears to be one of the harder * * = | d | determinants to calculate accurately. * * \ p1 p2 / Note that we allow a loss of xloss^2) * * * * Input: ldel iff .true. del2 and del3 exist * * del3 \delta^{s(1),p1,p2}_{s(1),p1,p2} * * del2 \delta^{p1,p2}_{p1,p2} * * xpi(ns) standard * * dpipj(ns,ns) standard * * piDpj(ns,ns) standard * * ipi pi = xpi(abs(ipi)) [p3=-p1 +/-p2] * * is si = xpi(is,is+1,..,is+itime-1) * * itime number of functions to calculate * * * * Output: del3mi(3) (\delta^{s_i \mu}_{p_1 p_2})^2 * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments: * integer ns,ip1n,ip2n,ip3n,is,itime logical ldel ComplexType del3mi(itime),del3,del2,xpi(ns),dpipj(ns,ns), + piDpj(ns,ns) * * local variables: * RealType smax,xmax,absc ComplexType s(7),som,xsom,c integer i,j,k,ip1,ip2,ip3,ipn,is1,is2,isi,is3,ihlp,iqn, + jsgn1,jsgn2,jsgn3,jsgnn,iadj(10,10,3:4),init,nm save iadj,init logical lmax,ltwist * * common blocks: * #include "ff.h" * * statement function * absc(c) = abs(Re(c)) + abs(Im(c)) * * data * data iadj /200*0/ data init /0/ * #] declarations: * #[ initialisations: if ( init .eq. 0 ) then init = 1 * * Fill the array with adjacent values: if * x = iadj(i,j) * k = abs(mod(k,100)) * jsgnk = sign(x) * jsgnj = 1-2*theta(x-100) (ie -1 iff |x|>100) * then * pi(k) = jsgnk*( p(i) - jsgnj*pi(j) ) * do 5 nm=3,4 do 4 i=1,nm is1 = i is2 = i+1 if ( is2 .gt. nm ) is2 = 1 is3 = i-1 if ( is3 .eq. 0 ) is3 = nm ip1 = is1 + nm iadj(is1,is2,nm) = -ip1 iadj(is2,is1,nm) = ip1 iadj(ip1,is2,nm) = -is1 iadj(is2,ip1,nm) = is1 iadj(is1,ip1,nm) = 100+is2 iadj(ip1,is1,nm) = 100+is2 if ( nm .eq. 3 ) then iadj(ip1,is2+3,3) = -100-is3-3 iadj(is2+3,ip1,3) = -100-is3-3 endif 4 continue 5 continue iadj(3,1,4) = -9 iadj(1,3,4) = 9 iadj(9,1,4) = -3 iadj(1,9,4) = 3 iadj(3,9,4) = 100+1 iadj(9,3,4) = 100+1 iadj(2,4,4) = -10 iadj(4,2,4) = 10 iadj(10,4,4) = -2 iadj(4,10,4) = 2 iadj(2,10,4) = 100+4 iadj(10,2,4) = 100+4 endif if ( ns .eq. 6 ) then nm = 3 else nm = 4 endif * #] initialisations: * #[ easy tries: do 40 i=1,itime isi = i+is-1 lmax = .FALSE. * * get xpi(isi)*del2 - del3 ... if del3 and del2 are defined * if ( ldel ) then s(1) = xpi(isi)*del2 som = s(1) - del3 smax = absc(s(1)) if ( absc(som) .ge. xloss**2*smax ) goto 35 xsom = som xmax = smax lmax = .TRUE. endif ip1 = ip1n ip2 = ip2n ip3 = ip3n do 20 j=1,3 * * otherwise use the simple threeterm formula * s(1) = xpi(ip2)*piDpj(ip1,isi)**2 s(2) = xpi(ip1)*piDpj(ip2,isi)*piDpj(ip2,isi) s(3) = -2*piDpj(ip2,isi)*piDpj(ip2,ip1)*piDpj(ip1,isi) som = s(1) + s(2) + s(3) smax = max(absc(s(1)),absc(s(2)),absc(s(3))) if ( absc(som) .ge. xloss**2*smax ) goto 35 if ( .not. lmax .or. smax .lt. xmax ) then xsom = som xmax = smax lmax = .TRUE. endif * * if there are cancellations between two of the terms: * we try mixing with isi. * * First map cancellation to s(2)+s(3) (do not mess up * rotations...) * if ( absc(s(1)+s(3)) .lt. absc(s(3))/2 ) then ihlp = ip1 ip1 = ip2 ip2 = ihlp som = s(1) s(1) = s(2) s(2) = som ltwist = .TRUE. else ltwist = .FALSE. endif if ( absc(s(2)+s(3)) .lt. absc(s(3))/2 ) then * * switch to the vector pn so that si = jsgn1*p1 + jsgnn*pn * k = iadj(isi,ip1,nm) if ( k .ne. 0 ) then ipn = abs(k) jsgnn = isign(1,k) if ( ipn .gt. 100 ) then ipn = ipn - 100 jsgn1 = -1 else jsgn1 = +1 endif if ( absc(dpipj(ipn,isi)) .lt. + xloss*absc(piDpj(ip1,isi)) .and. + absc(piDpj(ipn,ip2)) .lt. + xloss*absc(piDpj(ip2,isi)) ) then * same: s(1) = xpi(ip2)*piDpj(ip1,isi)**2 s(2) = jsgnn*piDpj(isi,ip2)*piDpj(ipn,ip2)* + xpi(ip1) s(3) = jsgn1*piDpj(isi,ip2)*piDpj(ip1,ip2)* + dpipj(ipn,isi) som = s(1) + s(2) + s(3) smax = max(absc(s(1)),absc(s(2)),absc(s(3))) * print *,' (isi+ip1) with isi,ip1,ip2,ipn: ', * + isi,ip1,ip2,ipn * print *,'xpi(ip2),piDpj(ip1,isi)',xpi(ip2), * + piDpj(ip1,isi) * print *,'piDpj(isi,ip2),piDpj(ipn,ip2),xpi(ip1)' * + ,piDpj(isi,ip2),piDpj(ipn,ip2),xpi(ip1) if ( absc(som) .ge. xloss**2*smax ) goto 35 if ( smax .lt. xmax ) then xsom = som xmax = smax endif * * there may be a cancellation between s(1) and * s(2) left. Introduce a vector q such that * pn = jsgnq*q + jsgn2*p2. We also need the sign * jsgn3 in p3 = -p1 - jsgn3*p2 * k = iadj(ipn,ip2,nm) if ( k .ne. 0 ) then iqn = abs(k) *not used jsgnq = isign(1,k) if ( iqn .gt. 100 ) then iqn = iqn - 100 jsgn2 = -1 else jsgn2 = +1 endif k = iadj(ip1,ip2,nm) if ( k .eq. 0 .or. k .lt. 100 ) then * we have p1,p2,p3 all p's jsgn3 = +1 elseif ( k .lt. 0 ) then * ip1,ip2 are 2*s,1*p such that p2-p1=ip3 jsgn3 = -1 else jsgn3 = 0 endif * we need one condition on the signs for this * to work if ( ip3.ne.0 .and. jsgn1*jsgn2.eq.jsgnn* + jsgn3 .and. absc(s(3)).lt.xloss*smax ) then s(1) = piDpj(ip1,isi)**2*dpipj(iqn,ipn) s(2) = -jsgn2*jsgn1*piDpj(ipn,ip2)* + piDpj(ip1,isi)*dpipj(ipn,isi) * s(3) stays the same s(4) = -jsgn2*jsgn1*piDpj(ipn,ip2)* + xpi(ip1)*piDpj(isi,ip3) som = s(1) + s(2) + s(3) + s(4) smax = max(absc(s(1)),absc(s(2)), + absc(s(3)),absc(s(4))) if (absc(som).ge.xloss**2*smax) goto 35 if ( smax .lt. xmax ) then xsom = som xmax = smax endif endif endif endif endif k = iadj(isi,ip2,nm) if ( k .ne. 0 ) then ipn = abs(k) jsgnn = isign(1,k) if ( ipn .gt. 100 ) then jsgn1 = -1 ipn = ipn - 100 else jsgn1 = +1 endif if ( absc(dpipj(ipn,isi)) .lt. + xloss*absc(piDpj(ip2,isi)) .and. + absc(piDpj(ipn,ip1)) .lt. + xloss*absc(piDpj(ip1,isi)) ) then s(1) = jsgnn*piDpj(isi,ip1)*piDpj(ipn,ip1)* + xpi(ip2) s(2) = xpi(ip1)*piDpj(ip2,isi)**2 s(3) = jsgn1*piDpj(isi,ip1)*piDpj(ip2,ip1)* + dpipj(ipn,isi) som = s(1) + s(2) + s(3) smax = max(absc(s(1)),absc(s(2)),absc(s(3))) print *,' (isi+ip2) with isi,ip1,ip2,ipn: ', + isi,ip1,ip2,ipn if ( absc(som) .ge. xloss**2*smax ) goto 35 if ( smax .lt. xmax ) then xsom = som xmax = smax endif endif endif endif * * rotate the ipi * if ( ip3 .eq. 0 ) goto 30 if ( j .ne. 3 ) then if ( .not. ltwist ) then ihlp = ip1 ip1 = ip2 ip2 = ip3 ip3 = ihlp else ihlp = ip2 ip2 = ip3 ip3 = ihlp endif endif 20 continue 30 continue * #] easy tries: * #[ choose the best value: * * These values are the best found: * som = xsom smax = xmax 35 continue del3mi(i) = som 40 continue * #] choose the best value: *###] ffcl3m: end LoopTools-2.16/src/B/PaxHeaders/Bget.F0000644000000000000000000000007413262227414014422 xustar0030 atime=1648161785.727698497 30 ctime=1648161793.715764879 LoopTools-2.16/src/B/Bget.F0000644000000000000000000001143013262227414015334 0ustar00rootroot00000000000000* Bget.F * retrieve the two-point tensor coefficients * this file is part of LoopTools * last modified 7 Apr 18 th #include "externals.h" #include "types.h" #define npoint 2 #include "defs.h" subroutine XBpara(para, p, m1, m2) implicit none ArgType para(1,*) ArgType p, m1, m2 #include "lt.h" P(1) = p M(1) = m1 if( abs(M(1)) .lt. minmass ) M(1) = 0 M(2) = m2 if( abs(M(2)) .lt. minmass ) M(2) = 0 end ************************************************************************ memindex function XBget(p, m1, m2) implicit none ArgType p, m1, m2 #include "lt.h" memindex cacheindex external cacheindex, XBcoeff #ifdef COMPLEXPARA memindex Bget external Bget #endif ArgType para(1,Pbb) #ifdef COMPLEXPARA if( abs(Im(p)) .gt. 0 ) & print *, "Complex momenta not implemented" if( abs(Im(m1)) + abs(Im(m2)) .eq. 0 ) then XBget = Bget(p, m1, m2) - offsetC return endif #endif call XBpara(para, p, m1, m2) XBget = cacheindex(para, Bval(1,0), XBcoeff, RC*Pbb, Nbb, Bno) end ************************************************************************ subroutine XBput(res, p, m1, m2) implicit none ComplexType res(*) ArgType p, m1, m2 #include "lt.h" external XBcoeff ArgType para(1,Pbb) #ifdef COMPLEXPARA if( abs(Im(p)) .gt. 0 ) & print *, "Complex momenta not implemented" if( abs(Im(m1)) + abs(Im(m2)) .eq. 0 ) then call Bput(res, p, m1, m2) return endif #endif call XBpara(para, p, m1, m2) call cachecopy(res, para, Bval(1,0), XBcoeff, RC*Pbb, Nbb, Bno) end ************************************************************************ subroutine XBputnocache(res, p, m1, m2) implicit none ComplexType res(*) ArgType p, m1, m2 #include "lt.h" external XBcoeff ArgType para(1,Pbb) #ifdef COMPLEXPARA if( abs(Im(p)) .gt. 0 ) & print *, "Complex momenta not implemented" if( abs(Im(m1)) + abs(Im(m2)) .eq. 0 ) then call Bputnocache(res, p, m1, m2) return endif #endif call XBpara(para, p, m1, m2) call XBcoeff(res, para) end ************************************************************************ ComplexType function XB0i(i, p, m1, m2) implicit none integer i ArgType p, m1, m2 #include "lt.h" memindex XBget external XBget memindex b b = XBget(p, m1, m2) XB0i = Bval(i+epsi,b) end ************************************************************************ ComplexType function XB0(p, m1, m2) implicit none ArgType p, m1, m2 #include "lt.h" ComplexType XB0i external XB0i XB0 = XB0i(bb0, p, m1, m2) end ************************************************************************ ComplexType function XB1(p, m1, m2) implicit none ArgType p, m1, m2 #include "lt.h" ComplexType XB0i external XB0i XB1 = XB0i(bb1, p, m1, m2) end ************************************************************************ ComplexType function XB00(p, m1, m2) implicit none ArgType p, m1, m2 #include "lt.h" ComplexType XB0i external XB0i XB00 = XB0i(bb00, p, m1, m2) end ************************************************************************ ComplexType function XB11(p, m1, m2) implicit none ArgType p, m1, m2 #include "lt.h" ComplexType XB0i external XB0i XB11 = XB0i(bb11, p, m1, m2) end ************************************************************************ ComplexType function XB001(p, m1, m2) implicit none ArgType p, m1, m2 #include "lt.h" ComplexType XB0i external XB0i XB001 = XB0i(bb001, p, m1, m2) end ************************************************************************ ComplexType function XB111(p, m1, m2) implicit none ArgType p, m1, m2 #include "lt.h" ComplexType XB0i external XB0i XB111 = XB0i(bb111, p, m1, m2) end ************************************************************************ ComplexType function XDB0(p, m1, m2) implicit none ArgType p, m1, m2 #include "lt.h" ComplexType XB0i external XB0i XDB0 = XB0i(dbb0, p, m1, m2) end ************************************************************************ ComplexType function XDB1(p, m1, m2) implicit none ArgType p, m1, m2 #include "lt.h" ComplexType XB0i external XB0i XDB1 = XB0i(dbb1, p, m1, m2) end ************************************************************************ ComplexType function XDB00(p, m1, m2) implicit none ArgType p, m1, m2 #include "lt.h" ComplexType XB0i external XB0i XDB00 = XB0i(dbb00, p, m1, m2) end ************************************************************************ ComplexType function XDB11(p, m1, m2) implicit none ArgType p, m1, m2 #include "lt.h" ComplexType XB0i external XB0i XDB11 = XB0i(dbb11, p, m1, m2) end ************************************************************************ ComplexType function XDB001(p, m1, m2) implicit none ArgType p, m1, m2 #include "lt.h" ComplexType XB0i external XB0i XDB001 = XB0i(dbb001, p, m1, m2) end LoopTools-2.16/src/B/PaxHeaders/Bcoeff.F0000644000000000000000000000013214044050730014712 xustar0030 mtime=1620070872.769254727 30 atime=1648161785.727698497 30 ctime=1648161793.715764879 LoopTools-2.16/src/B/Bcoeff.F0000644000000000000000000000514714044050730015641 0ustar00rootroot00000000000000* Bcoeff.F * invoke the two-point tensor coefficients * this file is part of LoopTools * last modified 3 May 21 th #include "externals.h" #include "types.h" #define npoint 2 #include "defs.h" subroutine Bcoeff(B, para) implicit none ComplexType B(*) RealType para(1,*) #include "lt.h" ComplexType cmp(Nbb) RealType p, m1, m2, div integer ier(Nbb), ierall, i logical dump serial = serial + 1 dump = ibits(debugkey, DebugB, 1) .ne. 0 .and. & serial .ge. debugfrom .and. serial .le. debugto if( dump ) call DumpPara(2, para, "Bcoeff") B(1:Nbb) = 0 m1 = M(1) m2 = M(2) p = P(1) div = uvdiv if( abs(p) + abs(m1) + abs(m2) .lt. zeroeps ) div = div - 1 if( div .ne. 0 ) then B(1+bb0) = div B(1+bb1) = -.5D0*div B(1+bb00) = -(p - 3*(m1 + m2))/12D0*div B(1+dbb00) = -1/12D0*div B(1+bb11) = 1/3D0*div B(1+bb001) = (p - 2*m1 - 4*m2)/24D0*div B(1+dbb001) = 1/24D0*div B(1+bb111) = -.25D0*div endif if( lambda .le. 0 ) then if( m1*m2 .eq. 0 .and. abs(p - m1 - m2) .lt. diffeps ) then B(1+dbb0) = nan if( p .ne. 0 ) B(1+dbb0) = -.5D0/p endif if( m2 .eq. 0 .and. abs(p - m1) .lt. diffeps ) then B(1+dbb1) = nan if( p .ne. 0 ) B(1+dbb1) = .5D0/p endif endif if( abs(p) + abs(m1) + abs(m2) .lt. zeroeps ) then if( delta .ne. 0 ) then B(bb0) = delta B(bb1) = -.5D0*delta B(bb11) = 1/3D0*delta B(bb111) = -.25*delta B(dbb00) = -1/12D0*delta B(dbb001) = 1/24D0*delta B(dbb0) = nan B(dbb1) = nan endif goto 9 endif goto (1, 2, 3) ibits(versionkey, KeyBget, 2) call BcoeffAD(B, para) goto 9 1 call BcoeffFF(B, para, ier) ierall = 0 do i = 1, Nbb, 3 ierall = max(ierall, ier(i)) enddo if( ierall .gt. warndigits ) then call BcoeffAD(cmp, para) call Bcheck(cmp, B, ier, para) endif goto 9 2 call BcoeffAD(B, para) call BcoeffFF(cmp, para, ier) call Bcheck(B, cmp, ier, para) goto 9 3 call BcoeffFF(B, para, ier) call BcoeffAD(cmp, para) call Bcheck(cmp, B, ier, para) 9 if( dump ) call DumpCoeff(2, B) end ************************************************************************ subroutine Bcheck(Ba, Bb, ier, para) implicit none ComplexType Ba(*), Bb(*) integer ier(*) ArgType para(1,*) #include "lt.h" #include "ltnames.h" integer i logical ini ini = .TRUE. do i = 1, Nbb, 3 if( abs(Ba(i) - Bb(i)) .gt. maxdev*abs(Ba(i)) ) then if( ini ) then call DumpPara(2, para, "Discrepancy in Bget") ini = .FALSE. endif print *, coeffname(i,2), " a =", Ba(i) print *, coeffname(i,2), " b =", Bb(i) if( ier(i) .gt. errdigits ) Bb(i) = Ba(i) endif enddo end LoopTools-2.16/src/B/PaxHeaders/ffxdb0.F0000644000000000000000000000007412401100047014674 xustar0030 atime=1648161785.727698497 30 ctime=1648161793.715764879 LoopTools-2.16/src/B/ffxdb0.F0000644000000000000000000003727612401100047015626 0ustar00rootroot00000000000000#include "externals.h" #include "types.h" *###[ ffxdb0: subroutine ffxdb0(cdb0,cdb0p,xp,xma,xmb,ier) ***#[*comment:*********************************************************** * * * Calculates the the derivative of the two-point function with * * respect to p2 and the same times p2 (one is always well-defined)* * * * Input: xp (real) k2, in B&D metric * * xma (real) mass2 * * xmb (real) mass2 * * * * Output: cdb0 (complex) dB0/dxp * * cdb0p (complex) xp*dB0/dxp * * ier (integer) # of digits lost, if >=100: error * * * * Calls: ffxdba * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments * integer ier ComplexType cdb0,cdb0p RealType xp,xma,xmb * * local variables * RealType dmamb,dmap,dmbp * * common blocks * #include "ff.h" * * #] declarations: dmamb = (sqrt(xma) - sqrt(xmb))**2 if( abs(xp - dmamb) .lt. precx .and. & abs(dmamb) .gt. precx .and. & xma .gt. precx .and. xmb .gt. precx ) then cdb0p = .5D0*(xmb - xma)/dmamb*log(xmb/xma) - 2 cdb0 = cdb0p/dmamb return endif * #[ get differences: dmamb = xma - xmb dmap = xma - xp dmbp = xmb - xp * #] get differences: * #[ calculations: call ffxdbp(cdb0,cdb0p,xp,xma,xmb,dmap,dmbp,dmamb,ier) * #] calculations: *###] ffxdb0: end *###[ ffxdbp: subroutine ffxdbp(cdb0,cdb0p,xp,xma,xmb,dmap,dmbp,dmamb,ier) ***#[*comment:*********************************************************** * * * calculates the derivatives of the two-point function * * Veltman) for all possible cases: masses equal, unequal, * * equal to zero. * * * * Input: xp (real) p.p, in B&D metric * * xma (real) mass2, * * xmb (real) mass2, * * dm[ab]p (real) xm[ab] - xp * * dmamb (real) xma - xmb * * * * Output: cdb0 (complex) B0' = dB0/dxp * * cdb0p (complex) xp*dB0/dxp * * ier (integer) 0=ok,>0=numerical problems,>100=error * * * * Calls: ffxdbp. * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments * integer ier ComplexType cdb0,cdb0p RealType xp,xma,xmb,dmap,dmbp,dmamb * * local variables * integer i,initeq,jsign,initir RealType ax,ffbnd, + xprceq,bdeq01,bdeq05,bdeq11,bdeq17, + xprcn3,bdn301,bdn305,bdn310, + xprcn5,bdn501,bdn505,bdn510, + xprec0,bdn001,bdn005,bdn010,bdn015 RealType xm,dmp,xm1,xm2,dm1m2,dm1p, + dm2p,s,s1,s1a,s1b,s1p,s2,s2a,s2b,s2p,x,y,som, + xlam,slam,xlogmm,alpha,alph1,xnoe,xpneq(30), + xx,dfflo1,dfflo3,d1,d2,diff,h,a,b,c,d,beta, + betm2n,xmax,s1c,s1d,s1e,s1f,s3 external ffbnd,dfflo1,dfflo3 save initeq,xpneq,initir, + xprceq,bdeq01,bdeq05,bdeq11,bdeq17, + xprcn3,bdn301,bdn305,bdn310, + xprcn5,bdn501,bdn505,bdn510, + xprec0,bdn001,bdn005,bdn010,bdn015 * * common blocks * #include "ff.h" * * data * data xprceq /-1D0/ data xprec0 /-1D0/ data xprcn3 /-1D0/ data xprcn5 /-1D0/ data initeq /0/ data initir /0/ * * #] declarations: * #[ which case: * * sort according to the type of masscombination encountered: * 100: both masses zero, 200: one equal to zero, 300: both equal * 400: rest. * if ( xma .eq. 0 ) then if ( xmb .eq. 0 ) then goto 100 endif xm = xmb dmp = dmbp goto 200 endif if ( xmb .eq. 0 ) then xm = xma dmp = dmap goto 200 elseif ( dmamb .eq. 0 ) then xm = xma dmp = dmap goto 300 elseif ( xma .gt. xmb ) then xm2 = xma xm1 = xmb dm1m2 = -dmamb dm1p = dmbp dm2p = dmap else xm1 = xma xm2 = xmb dm1m2 = dmamb dm1p = dmap dm2p = dmbp endif goto 400 * #] which case: * #[ both masses equal to zero: 100 continue if ( xp.ne.0 ) cdb0 = -1/xp cdb0p = -1 return * #] both masses equal to zero: * #[ one mass equal to zero: 200 continue * * special case xp = 0 * if ( xp .eq. 0 ) then cdb0p = 0 cdb0 = 1/(2*xm) goto 990 * * special case xp = xm * elseif ( abs(dmp) .lt. diffeps ) then if ( lsmug ) then if ( Re(cmipj(1,3)).lt.Re(cmipj(2,3)) ) then cdb0p = -1 - log(cmipj(1,3)*Re(1/xm)) else cdb0p = -1 - log(cmipj(2,3)*Re(1/xm)) endif else if ( initir.eq.0 ) then initir = 1 print *,'ffxdb0: IR divergent B0'', using cutoff ', + lambda endif if ( lambda .le. 0 ) then cdb0p = -1 + log(xm/mudim)/2 else cdb0p = -1 + log(xm/lambda)/2 endif endif cdb0 = cdb0p*(1/Re(xp)) goto 990 endif * * Normal case: * x = xp/xm ax = abs(x) if ( ax .lt. xloss ) then * #[ Taylor expansion: if ( xprec0 .ne. precx ) then xprec0 = precx bdn001 = ffbnd(2,1,xninv) bdn005 = ffbnd(2,5,xninv) bdn010 = ffbnd(2,10,xninv) bdn015 = ffbnd(2,15,xninv) endif if ( ax .gt. bdn015 ) then som = x*(xninv(17) + x*(xninv(18) + x*(xninv(19) + + x*(xninv(20) + x*xninv(21) )))) else som = 0 endif if ( ax .gt. bdn010 ) then som = x*(xninv(12) + x*(xninv(13) + x*(xninv(14) + + x*(xninv(15) + x*(xninv(16) + som ))))) endif if ( ax .gt. bdn005 ) then som = x*(xninv(7) + x*(xninv(8) + x*(xninv(9) + + x*(xninv(10) + x*(xninv(11) + som ))))) endif if ( ax .gt. bdn001 ) then som = x*(xninv(3) + x*(xninv(4) + x*(xninv(5) + + x*(xninv(6) + som )))) endif cdb0p = x*(xninv(2) + som) * #] Taylor expansion: else * #[ short formula: s = log(abs(dmp/xm)) cdb0p = -(1 + s*xm/xp) if ( xp.gt.xm ) cdb0p = cdb0p+ToComplex(Re(0),Re(xm/xp*pi)) * #] short formula: endif cdb0 = cdb0p*(1/Re(xp)) goto 990 * #] one mass equal to zero: * #[ both masses equal: 300 continue * * Both masses are equal. Not only this speeds up things, some * cancellations have to be avoided as well. * * first a special case * if ( abs(xp) .lt. 8*xloss*xm ) then * -#[ taylor expansion: * * a Taylor expansion seems appropriate as the result will go * as k^2 but seems to go as 1/k !! * *--#[ data and bounds: if ( initeq .eq. 0 ) then initeq = 1 xpneq(1) = 1D0/6D0 do 1 i=2,30 xpneq(i) = - xpneq(i-1)*Re(i)/Re(2*(2*i+1)) 1 continue endif if (xprceq .ne. precx ) then * * calculate the boundaries for the number of terms to be * included in the taylorexpansion * xprceq = precx bdeq01 = ffbnd(1,1,xpneq) bdeq05 = ffbnd(1,5,xpneq) bdeq11 = ffbnd(1,11,xpneq) bdeq17 = ffbnd(1,17,xpneq) endif *--#] data and bounds: x = -xp/xm ax = abs(x) if ( ax .gt. bdeq17 ) then som = x*(xpneq(18) + x*(xpneq(19) + x*(xpneq(20) + + x*(xpneq(21) + x*(xpneq(22) + x*(xpneq(23) + + x*(xpneq(24) + x*xpneq(25) ))))))) else som = 0 endif if ( ax .gt. bdeq11 ) then som = x*(xpneq(12) + x*(xpneq(13) + x*(xpneq(14) + + x*(xpneq(15) + x*(xpneq(16) + x*(xpneq(17) + som )))) + )) endif if ( ax .gt. bdeq05 ) then som = x*(xpneq(6) + x*(xpneq(7) + x*(xpneq(8) + x*( + xpneq(9) + x*(xpneq(10) + x*(xpneq(11) + som )))))) endif if ( ax .gt. bdeq01 ) then som = x*(xpneq(2) + x*(xpneq(3) + x*(xpneq(4) + x*( + xpneq(5) + som )))) endif cdb0p = -x*(xpneq(1)+som) if ( xp.ne.0 ) then cdb0 = cdb0p*(1/Re(xp)) else cdb0 = xpneq(1)/xm endif goto 990 * -#] taylor expansion: endif * -#[ normal case: * * normal case * call ffxlmb(xlam,-xp,-xm,-xm,dmp,dmp,0D0) if ( xlam .eq. 0 ) then call fferr(86,ier) return elseif ( xlam .gt. 0 ) then * cases 1,2 and 4 slam = sqrt(xlam) s2a = dmp + xm s2 = s2a + slam if ( abs(s2) .gt. xloss*slam ) then * looks fine jsign = 1 else s2 = s2a - slam jsign = -1 endif ax = abs(s2/(2*xm)) if ( ax .lt. xalogm ) then s = 0 elseif( ax-1 .lt. .1 .and. s2 .gt. 0 ) then * In this case a quicker and more accurate way is to * calculate log(1-x). s2 = (xp - slam) * the following line is superfluous. s = 2*xm/slam*dfflo1(s2/(2*xm),ier) else * finally the normal case s = 2*xm/slam*log(ax) if ( jsign .eq. -1 ) s = -s endif if ( xp .gt. 2*xm ) then * in this case ( xlam>0, so xp>(2*m)^2) ) there also * is an imaginary part y = pi*2*xm/slam else y = 0 endif else * the root is complex (k^2 between 0 and (2*m1)^2) slam = sqrt(-xlam) s = 4*xm/slam*atan2(xp,slam) y = 0 endif xx = s - 1 cdb0p = ToComplex(Re(xx),Re(y)) cdb0 = cdb0p*(1/Re(xp)) goto 990 * -#] normal case: * * #] both masses equal: * #[ unequal nonzero masses: * -#[ get log(xm2/xm1): 400 continue x = xm2/xm1 if ( 1 .lt. xalogm*x ) then call fferr(8,ier) xlogmm = 0 elseif ( abs(x-1) .lt. xloss ) then xlogmm = dfflo1(dm1m2/xm1,ier) else xlogmm = log(x) endif * -#] get log(xm2/xm1): * -#[ xp = 0: * * first a special case * if ( xp .eq. 0 ) then * * repaired 19-nov-1993, see b2.frm * s1 = xm1*xm2*xlogmm/dm1m2**3 s2 = (xm1+xm2)/(2*dm1m2**2) s = s1 + s2 if ( abs(s) .lt. xloss**2*s2 ) then * * second try * h = dfflo3(dm1m2/xm1,ier) s1 = -xm1*h/dm1m2**2 s2 = 1/(2*xm1) s3 = xm1**2*h/dm1m2**3 s = s1 + s2 + s3 if ( abs(s) .lt. xloss*max(abs(s2),abs(s3)) ) then call ffwarn(228,ier,s,s2) endif endif cdb0 = s cdb0p = 0 goto 990 endif * -#] xp = 0: * -#[ normal case: * * proceeding with the normal case * call ffxlmb(xlam,-xp,-xm2,-xm1,dm2p,dm1p,dm1m2) diff = xlam + xp*(dm2p+xm1) if ( abs(diff) .lt. xloss*xlam ) then h = dm1m2**2 - xp*(xm1+xm2) if ( abs(h) .lt. xloss*dm1m2**2 ) then if ( dm1m2**2 .lt. abs(xlam) ) diff = h endif endif if ( xlam .eq. 0 ) then call fferr(86,ier) return elseif ( xlam .gt. 0 ) then * cases k^2 < -(m2+m1)^2 or k^2 > -(m2-m1)^2: *--#[ first try: * first try the normal way slam = sqrt(xlam) s2a = dm2p + xm1 s2 = s2a + slam if ( abs(s2) .gt. xloss*slam ) then * looks fine jsign = 1 else s2 = s2a - slam jsign = -1 endif s2 = s2**2/(4*xm1*xm2) if ( abs(s2) .lt. xalogm ) then call fferr(9,ier) s2 = 0 elseif ( abs(s2-1) .lt. xloss ) then if ( jsign.eq.1 ) then s2 = -slam*(s2a+slam)/(2*xm1*xm2) s2 = -diff/(2*slam*xp)*dfflo1(s2,ier) else ier = ier + 50 print *,'ffxdb0: untested: s2 better in first try' s2 = +slam*(s2a-slam)/(2*xm1*xm2) s2 = +diff/(2*slam*xp)*dfflo1(s2,ier) endif else s2 = -diff/(2*slam*xp)*log(s2) if ( jsign .eq. -1 ) s2 = -s2 endif s1 = -dm1m2*xlogmm/(2*xp) xx = s1+s2-1 *--#] first try: if ( abs(xx) .lt. xloss**2*max(abs(s1),abs(s2)) ) then *--#[ second try: * this is unacceptable, try a better solution s1a = diff + slam*dm1m2 if ( abs(s1a) .gt. xloss*diff ) then * this works s1 = -s1a/(2*xp*slam) else * by division a more accurate form can be found s1 = -2*xm1*xm2*xp/(slam*(diff - slam*dm1m2)) endif s = s1 s1 = s1*xlogmm if ( abs(xp) .lt. xm2 ) then s2a = xp - dm1m2 else s2a = xm2 - dm1p endif s2 = s2a - slam if ( abs(s2) .gt. xloss*slam ) then * at least reasonable s2 = s2 / (2*xm2) else * division again s2 = (2*xp) / (s2a+slam) endif if ( abs(s2) .lt. .1 ) then * choose a quick way to get the logarithm s2 = dfflo1(s2,ier) elseif ( s2.eq.1 ) then print *,'ffxdbp: error: arg log would be 0!' print *,' xp,xma,xmb = ',xp,xma,xmb goto 600 else s2 = log(abs(1 - s2)) endif s2 = -diff/(slam*xp)*s2 xx = s1 + s2 - 1 *--#] second try: if ( abs(xx) .lt. xloss**2*max(abs(s1),abs(s2)) ) then *--#[ third try: * (we accept two times xloss because that's the same * as in this try) * A Taylor expansion might work. We expand * inside the logs. Only do the necessary work. * * #[ split up 1: xnoe = s2a+slam a = 1 b = 2/xnoe-1/xp c = -4/(xp*xnoe) d = sqrt((2/xnoe)**2 + 1/xp**2) call ffroot(d1,d2,a,b,c,d,ier) if ( xp.gt.0 ) then beta = d2 else beta = d1 endif alpha = beta*diff/slam alph1 = 1-alpha if ( alph1 .lt. xloss ) then s1a = 4*xp**2*xm1*xm2/(slam*dm1m2*(diff-slam* + dm1m2)) s1b = -diff/slam*4*xm1*xp/(dm1m2*xnoe*(2*xp- + xnoe)) b = -1/xp c = -(2/xnoe)**2 call ffroot(d1,d2,a,b,c,d,ier) if ( xp.gt.0 ) then betm2n = d2 else betm2n = d1 endif d1 = s1a + s1b - diff/slam*betm2n xmax = max(abs(s1a),abs(s1b)) if ( xmax .lt. 1 ) then alph1 = d1 else xmax = 1 endif else betm2n = beta - 2/xnoe endif * #] split up 1: * #[ s2: * * first s2: * s2p = s2 - alpha if ( abs(s2p) .lt. xloss*abs(s2) ) then * -#[ bounds: * determine the boundaries for 1,5,10,15 terms if ( xprcn5 .ne. precx ) then xprcn5 = precx bdn501 = ffbnd(3,1,xinfac) bdn505 = ffbnd(3,5,xinfac) bdn510 = ffbnd(3,10,xinfac) endif * -#] bounds: x = beta*xp ax = abs(x) if ( ax .gt. bdn510 ) then s2a = x*(xinfac(13) + x*(xinfac(14) + x*( + xinfac(15) + x*(xinfac(16) + x* + xinfac(17) )))) else s2a = 0 endif if ( ax .gt. bdn505 ) then s2a = x*(xinfac(8) + x*(xinfac(9) + x*( + xinfac(10) + x*(xinfac(11) + x*( + xinfac(12) + s2a))))) endif if ( ax .gt. bdn501 ) then s2a = x*(xinfac(4) + x*(xinfac(5) + x*( + xinfac(6) + x*(xinfac(7) + s2a)))) endif s2a = x**3*(xinfac(3)+s2a) s2b = 2*xp/xnoe*(s2a + x**2/2) s2p = s2b - s2a s2p = -diff/(xp*slam)*dfflo1(s2p,ier) endif * #] s2: * #[ s1: * * next s1: * s1p = s1 - alph1 if ( abs(s1p) .lt. xloss*abs(s1) ) then * -#[ bounds: * determine the boundaries for 1,5,10,15 terms if ( xprcn3 .ne. precx ) then xprcn3 = precx bdn301 = ffbnd(3,1,xinfac) bdn305 = ffbnd(3,5,xinfac) bdn310 = ffbnd(3,10,xinfac) endif * -#] bounds: * x = slam*(diff-slam*dm1m2)*alph1/(2*xp*xm1*xm2) h = (2*xp*(xm1+xm2) - xp**2)/(slam-dm1m2) ax = abs(x) * * see form job gets1.frm * s1b = diff*(diff-slam*dm1m2)*betm2n/(2*xp*xm1* + xm2) s1c = 1/(xm1*xnoe*(2*xp-xnoe))*( + xp*( 4*xp*xm2 + 2*dm1m2**2/xm2*(xp-h) + + 2*dm1m2*(3*xp-h) - 8*dm1m2**2 ) + - 2*dm1m2**3/xm2*(3*xp-h) + + 4*dm1m2**4/xm2 + ) s1d = x*dm1m2/xm1 s1e = -x**2/2 if ( ax .gt. bdn310 ) then s1a = x*(xinfac(13) + x*(xinfac(14) + x*( + xinfac(15) + x*(xinfac(16) + x* + xinfac(17) )))) else s1a = 0 endif if ( ax .gt. bdn305 ) then s1a = x*(xinfac(8) + x*(xinfac(9) + x*( + xinfac(10) + x*(xinfac(11) + x*( + xinfac(12) + s1a))))) endif if ( ax .gt. bdn301 ) then s1a = x*(xinfac(4) + x*(xinfac(5) + x*( + xinfac(6) + x*(xinfac(7) + s1a)))) endif s1a = -x**3 *(xinfac(3) + s1a) s1f = dm1m2/xm1*(x**2/2 - s1a) s1p = s1e + s1d + s1c + s1b + s1a + s1f xmax = max(abs(s1a),abs(s1b),abs(s1c),abs(s1d), + abs(s1e)) s1p = s*dfflo1(s1p,ier) endif * #] s1: * * finally ... * xx = s1p + s2p *--#] third try: endif endif 600 continue if ( xp .gt. xm1+xm2 ) then *--#[ imaginary part: * in this case ( xlam>0, so xp>(m1+m2)^2) ) there also * is an imaginary part y = -pi*diff/(slam*xp) else y = 0 *--#] imaginary part: endif else * the root is complex (k^2 between -(m1+m2)^2 and -(m2-m1)^2) *--#[ first try: slam = sqrt(-xlam) xnoe = dm2p + xm1 s1 = -(dm1m2/(2*xp))*xlogmm s2 = -diff/(slam*xp)*atan2(slam,xnoe) xx = s1 + s2 - 1 *--#] first try: y = 0 endif cdb0p = ToComplex(Re(xx),Re(y)) cdb0 = cdb0p*(1/Re(xp)) goto 990 * -#] normal case: * #] unequal nonzero masses: 990 continue *###] ffxdbp: end LoopTools-2.16/src/B/PaxHeaders/ffcb0.F0000644000000000000000000000013114160633523014513 xustar0029 mtime=1640183635.86765876 30 atime=1648161785.727698497 30 ctime=1648161793.715764879 LoopTools-2.16/src/B/ffcb0.F0000644000000000000000000004704014160633523015441 0ustar00rootroot00000000000000#include "externals.h" #include "types.h" * $Id: ffcb0.f,v 1.11 1996/07/18 10:49:04 gj Exp $ *###[ ffcb0: subroutine ffcb0(cb0,cp,cma,cmb,ier) ***#[*comment:*********************************************************** * * * calculates the the two-point function (cf 't Hooft and Veltman) * * we include an overall factor 1/(i*pi^2) relative to FormF * * * * Input: cp (complex) k2, in B&D metric * * cma (complex) mass2, re>0, im<0. * * cmb (complex) mass2, re>0, im<0. * * * * Output: cb0 (complex) B0, the two-point function, * * ier (integer) number of digits lost in calculation * * * * Calls: ffcb0p,ffxb0p * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments * integer ier ComplexType cb0,cp,cma,cmb * * local variables * integer init,ithres,i,j,nschsa,nab logical lreal ComplexType cmamb,cmap,cmbp,cm,c,cb0p,cqi(3),cqiqj(3,3) RealType absc,xp,xma,xmb,sprec,smax save init integer nffeta external nffeta * * common blocks * #include "ff.h" * * statement function * absc(c) = abs(Re(c)) + abs(Im(c)) * * data * data init /0/ * * #] declarations: * #[ the real cases: * if ( Im(cma) .eq. 0 .and. Im(cmb) .eq. 0 .and. + Im(cp).eq.0 ) then lreal = .TRUE. elseif ( nschem.le.4 ) then lreal = .TRUE. if ( init.eq.0 ) then init = 1 print *,'ffcb0: nschem <= 4, ignoring complex masses: ', + nschem endif elseif ( nschem.le.6 ) then if ( init.eq.0 ) then init = 1 print *,'ffcb0: nschem = 5,6 complex masses near ', + 'threshold: ',nschem endif cqi(1) = cma cqi(2) = cmb cqi(3) = cp cqiqj(1,2) = cma - cmb cqiqj(2,1) = -cqiqj(1,2) cqiqj(1,3) = cma - cp cqiqj(3,1) = -cqiqj(1,3) cqiqj(2,3) = cmb - cp cqiqj(3,2) = -cqiqj(2,3) cqiqj(1,1) = 0 cqiqj(2,2) = 0 cqiqj(3,3) = 0 call ffthre(ithres,cqi,cqiqj,3,1,2,3) if ( ithres.eq.0 .or. ithres.eq.1 .and. nschem.eq.5 ) then lreal = .TRUE. else lreal = .FALSE. endif else lreal = .FALSE. endif if ( lreal ) then xp = Re(cp) xma = Re(cma) xmb = Re(cmb) sprec = precx precx = precc call ffxb0(cb0,xp,xma,xmb,ier) precx = sprec if ( ldot ) then do 120 j=1,3 do 110 i=1,3 cfpij2(i,j) = fpij2(i,j) 110 continue 120 continue endif return endif * * #] the real cases: * #[ get differences: * cmamb = cma - cmb cmap = cma - cp cmbp = cmb - cp * * #] get differences: * #[ calculations: * * no more schem-checking, please... * nschsa = nschem nschem = 7 call ffcb0p(cb0p,cp,cma,cmb,cmap,cmbp,cmamb,ier) nschem = nschsa nab = 0 if ( cma .eq. 0 ) then if ( cmb .eq. 0 ) then cm = 1 else cm = cmb**2 endif elseif ( cmb .eq. 0 ) then cm = cma**2 else cm = cma*cmb nab = nffeta(cma, cmb, ier) endif if ( mudim .ne. 0 ) cm = cm/Re(mudim)**2 if ( absc(cm) .gt. xclogm ) then cb0 = Re(delta) - cb0p - log(cm)/2 + .5D0*c2ipi*nab smax = max(abs(delta),absc(cb0p),absc(log(cm))/2) else call fferr(3,ier) cb0 = -cb0p + Re(delta) endif * #] calculations: *###] ffcb0: end *###[ ffcb0p: subroutine ffcb0p(cb0p,cp,cma,cmb,cmap,cmbp,cmamb,ier) ***#[*comment:*********************************************************** * * * calculates the main part of the two-point function (cf 't * * Hooft and Veltman) for all possible cases: masses equal, * * unequal, equal to zero, real or complex (with a negative * * imaginary part). I think it works. * * Has been checked against FormF for all parameter space. * * Only problems with underflow for extreme cases. VERY OLD CODE. * * * * Input: cp (complex) k2, in B&D metric * * cma (complex) mass2, re>0, im<0. * * cmb (complex) mass2, re>0, im<0. * * cmap/b (complex) cma/b - cp * * cmamb (complex) cma - cmb * * * * Output: cb0p (complex) B0, the two-point function, * * minus log(cm/mu), delta and the * * factor -ipi^2. * * ier (integer) 0=ok, 1=numerical problems, 2=error * * * * Calls: (z/a)log, atan. * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments * integer ier ComplexType cb0p,cp,cma,cmb,cmap,cmbp,cmamb * * local variables * integer i,j,initeq,initn1,n1,n2,nffeta,nffet1,init, + ithres,is1 logical lreal RealType xp,ax,ay,ffbnd, + xprceq,bdeq01,bdeq05,bdeq11,bdeq17,bdeq25, + xprcn1,bdn101,bdn105,bdn110,bdn115, + xprnn2,bdn201,bdn205,bdn210,bdn215, + xpneq(30),xpnn1(30), + absc,sprec,xma,xmb,dmap,dmbp,dmamb,smax ComplexType cm,cmp,cm1,cm2,cm1m2, + cm1p,cm2p,cs,cs1,cs2,cx,cy,csom,clam,cslam,clogmm, + zfflo1,c,zm,zp,zm1,zp1,zfflog,cqi(3), + cqiqj(3,3),cpiDpj(3,3),ck,clamr,cslamr,zmr,zpr,zm1r,zp1r save initeq,initn1,xpneq,xpnn1,init, + xprceq,bdeq01,bdeq05,bdeq11,bdeq17,bdeq25, + xprcn1,bdn101,bdn105,bdn110,bdn115, + xprnn2,bdn201,bdn205,bdn210,bdn215 *FOR ABSOFT ONLY * ComplexType csqrt * external csqrt * * common blocks * #include "ff.h" * * data * data xprceq /-1./ data xprcn1 /-1./ data xprnn2 /-1./ data initeq /0/ data initn1 /0/ data init /0/ * * statement function * absc(c) = abs(Re(c)) + abs(Im(c)) * * #] declarations: * #[ fill some dotproducts: * call ffcot2(cpiDpj,cp,cma,cmb,cmap,cmbp,cmamb,ier) if ( ldot ) then do 20 i=1,3 do 10 j=1,3 cfpij2(j,i) = cpiDpj(j,i) fpij2(j,i) = Re(cpiDpj(j,i)) 10 continue 20 continue endif * * #] fill some dotproducts: * #[ the real cases: * if ( Im(cma) .eq. 0 .and. Im(cmb) .eq. 0 .and. + Im(cp).eq.0 ) then lreal = .TRUE. elseif ( nschem.le.4 ) then lreal = .TRUE. if( init.eq.0 ) then init = 1 print *,'ffcb0p: nschem <= 4, ignoring complex masses:', + nschem endif elseif ( nschem.le.6 ) then if( init.eq.0 ) then init = 1 print *,'ffcb0p: nschem = 4,6 complex masses near ', + 'threshold: ',nschem endif cqi(1) = cma cqi(2) = cmb cqi(3) = cp cqiqj(1,2) = cmamb cqiqj(2,1) = -cqiqj(1,2) cqiqj(1,3) = cmap cqiqj(3,1) = -cqiqj(1,3) cqiqj(2,3) = cmbp cqiqj(3,2) = -cqiqj(2,3) cqiqj(1,1) = 0 cqiqj(2,2) = 0 cqiqj(3,3) = 0 call ffthre(ithres,cqi,cqiqj,3,1,2,3) if ( ithres.eq.0 .or. ithres.eq.1 .and. nschem.eq.5 ) then lreal = .TRUE. else lreal = .FALSE. endif else lreal = .FALSE. endif if ( lreal ) then xp = Re(cp) xma = Re(cma) xmb = Re(cmb) dmap = Re(cmap) dmbp = Re(cmbp) dmamb = Re(cmamb) sprec = precx precx = precc call ffxb0p(cb0p,xp,xma,xmb,dmap,dmbp,dmamb,ier) precx = sprec if ( ldot ) then do 120 j=1,3 do 110 i=1,3 cfpij2(i,j) = fpij2(i,j) 110 continue 120 continue endif return endif * * #] the real cases: * #[ which case: * * sort according to the type of mass combination encountered: * 200: one equal to zero, 300: both equal, 400: rest. * if ( cma .eq. 0 ) then if ( cmb .eq. 0 ) then goto 100 endif cm = cmb cmp = cmbp goto 200 endif if ( cmb .eq. 0 ) then cm = cma cmp = cmap goto 200 endif if ( cma .eq. cmb ) then cm = cma cmp = cmap goto 300 endif if ( Re(cma) .lt. Re(cmb) ) then cm2 = cma cm1 = cmb cm1m2 = -cmamb cm1p = cmbp cm2p = cmap is1 = 2 else cm1 = cma cm2 = cmb cm1m2 = cmamb cm1p = cmap cm2p = cmbp is1 = 1 endif goto 400 * #] which case: * #[ both masses equal to zero: 100 continue if ( absc(cp) .gt. xclogm ) then if ( Re(cp).gt.0 ) then cb0p = log(cp) - c2ipi/2 - 2 else cb0p = log(-cp) - 2 endif else cb0p = 0 call fferr(7,ier) endif return * #] both masses equal to zero: * #[ one mass zero: 200 continue * * special case cp = 0, checked 25-oct-1991 * if ( cp .eq. 0 ) then cb0p = -1 goto 990 endif * * Normal case: * cs1 = cp/cm cs2 = cmp/cm * make sure we get the right Riemann sheet! if ( absc(cs1) .lt. xloss ) then cs = zfflo1(cs1,ier) elseif ( Re(cs2).gt.0 ) then cs = zfflog(cs2,0,czero,ier) else cs = zfflog(-cs2,0,czero,ier) cs = cs - c2ipi/2 endif cs = -cs*cmp/cp cb0p = cs - 2 goto 990 * #] one mass zero: * #[ both masses equal: 300 continue * * Both masses are equal. Not only this speeds up things, some * cancellations have to be avoided as well. Checked 25-oct-1991. * -#[ taylor expansion: * * first this special case * if ( absc(cp) .lt. 8*xloss*absc(cm) ) then * * a Taylor expansion seems appropriate as the result will go * as k^2 but seems to go as 1/k !! * * #[ data and bounds: if ( initeq .eq. 0 ) then initeq = 1 xpneq(1) = 1/6D0 do 1 i=2,30 xpneq(i) = xpneq(i-1)*Re(i-1)/Re(2*(2*i+1)) 1 continue endif if (xprceq .ne. precc ) then * * calculate the boundaries for the number of terms to be * included in the taylorexpansion * xprceq = precc sprec = precx precx = precc bdeq01 = ffbnd(1,1,xpneq) bdeq05 = ffbnd(1,5,xpneq) bdeq11 = ffbnd(1,11,xpneq) bdeq17 = ffbnd(1,17,xpneq) bdeq25 = ffbnd(1,25,xpneq) precx = sprec endif * #] data and bounds: cx = cp/cm ax = absc(cx) if ( ax .gt. bdeq17 ) then csom = cx*(Re(xpneq(18)) + cx*(Re(xpneq(19)) + + cx*(Re(xpneq(20)) + cx*(Re(xpneq(21)) + + cx*(Re(xpneq(22)) + cx*(Re(xpneq(23)) + + cx*(Re(xpneq(24)) + cx*(Re(xpneq(25)) )))))))) else csom = 0 endif if ( ax .gt. bdeq11 ) then csom = cx*(Re(xpneq(12)) + cx*(Re(xpneq(13)) + + cx*(Re(xpneq(14)) + cx*(Re(xpneq(15)) + + cx*(Re(xpneq(16)) + cx*(Re(xpneq(17)) + csom )))) + )) endif if ( ax .gt. bdeq05 ) then csom = cx*(Re(xpneq(6)) + cx*(Re(xpneq(7)) + + cx*(Re(xpneq(8)) + cx*(Re(xpneq(9)) + + cx*(Re(xpneq(10)) + cx*(Re(xpneq(11)) + csom )))))) endif if ( ax .gt. bdeq01 ) then csom = cx*(Re(xpneq(2)) + cx*(Re(xpneq(3)) + + cx*(Re(xpneq(4)) + cx*(Re(xpneq(5)) + csom )))) endif cb0p = -cx*(Re(xpneq(1))+csom) goto 990 endif * -#] taylor expansion: * -#[ normal case: * * normal case. first determine if the arguments of the logarithm * has positive real part: (we assume Re(cm) > Im(cm) ) * call ffclmb(clam,-cp,-cm,-cm,cmp,cmp,czero) cslam = sqrt(clam) call ffcoot(zm,zp,cone,chalf,cm/cp,cslam/(2*cp),ier) cs1 = zp/zm if ( absc(cs1-1) .lt. xloss ) then * In this case a quicker and more accurate way is to * calculate log(1-cx). cs2 = cp - cslam if ( absc(cs2) .lt. xloss*absc(cp) ) then cs2 = -cslam*(cp+cslam)/(4*cp*cm) else cs2 = -2*cslam/cs2 endif cs = zfflo1(cs2/(2*cm),ier) else * finally the normal case cs = zfflog(cs1,0,czero,ier) endif cs = cslam*cs/cp cb0p = cs - 2 * * eta terms * n1 = nffet1(zp,1/zm,cs1,ier) if ( Im(cp).eq.0 ) then n2 = nffet1(-zp,-1/zm,cs1,ier) else * use the onshell expression to get the correct continuation ck = Re(cp) call ffclmb(clamr,-ck,-cm,-cm,cm-ck,cm-ck,czero) cslamr = sqrt(clamr) call ffcoot(zmr,zpr,cone,chalf,cm/ck,cslamr/(2*ck),ier) if ( absc(zm-zmr)+absc(zp-zpr).gt.absc(zm-zpr)+absc(zp-zmr) + ) then cs1 = zmr zmr = zpr zpr = cs1 endif if ( Im(zmr).eq.0 .or. Im(zpr).eq.0 ) then if ( Re(zpr).gt.Re(zmr) ) then n2 = +1 else n2 = -1 endif else n2 = nffeta(-zpr,-1/zmr,ier) endif endif if ( n1+n2 .ne. 0 ) + cb0p = cb0p - cslam*c2ipi*(n1+n2)/(2*cp) * also superfluous - just to make sure goto 990 * -#] normal case: * * #] both masses equal: * #[ unequal nonzero masses: 400 continue * -#[ get log(xm2/xm1): cx = cm2/cm1 c = cx-1 if ( 1/absc(cx) .lt. xclogm ) then call fferr(6,ier) clogmm = 0 elseif ( absc(c) .lt. xloss ) then clogmm = zfflo1(cm1m2/cm1,ier) else clogmm = log(cx) endif * -#] get log(xm2/xm1): * -#[ cp = 0: * * first a special case * if ( cp .eq. 0 ) then cs2 = ((cm2+cm1) / cm1m2)*clogmm * save the factor 1/2 for the end cs = - cs2 - 2 if ( absc(cs) .lt. xloss*2 ) then * Taylor expansions: choose which one cx = cm1m2/cm1 ax = absc(cx) if ( ax .lt. .15 .or. precc .gt. 1.E-8 .and. ax + .lt. .3 ) then * #[ taylor 1: * * This is the simple Taylor expansion 'n1' * *--#[ data and bounds: * get the coefficients of the taylor expansion if ( initn1 .eq. 0 ) then initn1 = 1 do i = 1,30 xpnn1(i)=Re(i)/Re((i+1)*(i+2)) enddo endif * determine the boundaries for 1,5,10,15 terms if ( xprcn1 .ne. precc ) then xprcn1 = precc sprec = precx precx = precc bdn101 = ffbnd(1,1,xpnn1) bdn105 = ffbnd(1,5,xpnn1) bdn110 = ffbnd(1,10,xpnn1) bdn115 = ffbnd(1,15,xpnn1) precx = sprec endif *--#] data and bounds: * calculate: if ( ax .gt. bdn110 ) then cs = cx*(Re(xpnn1(11)) + cx*(Re(xpnn1(12)) + + cx*(Re(xpnn1(13)) + cx*(Re(xpnn1(14)) + + cx*(Re(xpnn1(15))) )))) else cs = 0 endif if ( ax .gt. bdn105 ) then cs = cx*(Re(xpnn1(6)) + cx*(Re(xpnn1(7)) + + cx*(Re(xpnn1(8)) + cx*(Re(xpnn1(9)) + + cx*(Re(xpnn1(10)) + cs))))) endif if ( ax .gt. bdn101 ) then cs = cx*(Re(xpnn1(2)) + cx*(Re(xpnn1(3)) + + cx*(Re(xpnn1(4)) + cx*(Re(xpnn1(5)) + + cs)))) endif cs = cx*cx*(Re(xpnn1(1)) + cs) * #] taylor 1: else * #[ taylor 2: * * This is the more complicated exponential Taylor * expansion 'n2' * * #[ bounds: * determine the boundaries for 1,5,10,15 terms for this * Taylor expansion (starting at i=4) * if ( xprnn2 .ne. precc ) then xprnn2 = precc sprec = precx precx = precc bdn201 = ffbnd(4,1,xinfac) bdn205 = ffbnd(4,5,xinfac) bdn210 = ffbnd(4,10,xinfac) bdn215 = ffbnd(4,15,xinfac) precx = sprec endif * #] bounds: * calculate: cy = 2*cx/(2-cx) ay = absc(cy) if ( ay .gt. bdn210 ) then cs = cy*(Re(xinfac(14)) + cy*(Re(xinfac(15)) + + cy*(Re(xinfac(16)) + cy*(Re(xinfac(17)) + + cy*(Re(xinfac(18))))))) else cs = 0 endif if ( ay .gt. bdn205 ) then cs = cy*(Re(xinfac(9)) + cy*(Re(xinfac(10)) + + cy*(Re(xinfac(11)) + cy*(Re(xinfac(12)) + + cy*(Re(xinfac(13)) + cs))))) endif if ( ay .gt. bdn201 ) then cs = cy*(Re(xinfac(5)) + cy*(Re(xinfac(6)) + + cy*(Re(xinfac(7)) + cy*(Re(xinfac(8)) + + cs)))) endif cs = (1-cx)*cy**4 * (Re(xinfac(4)) + cs) cs = cx*cy**2*(1+cy)/12 - cs cs = - 2*zfflo1(cs,ier)/cy * #] taylor 2: endif endif cb0p = cs/2 goto 990 endif * -#] cp = 0: * -#[ normal case: * * (programmed anew 28-oct-1991) * call ffclmb(clam,cm1,cm2,cp,cm1m2,cm1p,cm2p) cslam = sqrt(clam) if ( is1.eq.1 ) then cs = +cpiDpj(2,3) else cs = -cpiDpj(1,3) endif call ffcoot(zm,zp,cp,cs,cm2,cslam/2,ier) zm1 = 1-zm zp1 = 1-zp if ( absc(zm1) .lt. xloss .or. absc(zp1) .lt. xloss ) then if ( is1.eq.1 ) then cs = -cpiDpj(1,3) else cs = +cpiDpj(2,3) endif call ffcoot(zp1,zm1,cp,cs,cm1,cslam/2,ier) if ( abs(Im(zm)) .lt. abs(Im(zm1)) ) then zm = ToComplex(Re(zm),-Im(zm1)) else zm1 = ToComplex(Re(zm1),-Im(zm)) endif if ( abs(Im(zp)) .lt. abs(Im(zp1)) ) then zp = ToComplex(Re(zp),-Im(zp1)) else zp1 = ToComplex(Re(zp1),-Im(zp)) endif endif if ( Im(cp).ne.0 ) then * compute roots for Im(cp).eq.0 for continuation terms. ck = Re(cp) call ffclmb(clamr,cm1,cm2,ck,cm1m2,cm1-ck,cm2-ck) cslamr = sqrt(clamr) if ( absc(cslamr-cslam).gt.absc(cslamr+cslam) ) + cslamr = -cslamr cs = (cm2-cm1+ck)/2 call ffcoot(zmr,zpr,ck,cs,cm2,cslamr/2,ier) zm1r = 1-zmr zp1r = 1-zpr if ( absc(zm1r) .lt. xloss .or. absc(zp1r) .lt. xloss ) then cs = -(cm2-cm1-ck)/2 call ffcoot(zp1r,zm1r,ck,cs,cm1,cslamr/2,ier) if ( abs(Im(zmr)) .lt. abs(Im(zm1r)) ) then zmr = ToComplex(Re(zmr),-Im(zm1r)) else zm1r = ToComplex(Re(zm1r),-Im(zmr)) endif if ( abs(Im(zpr)) .lt. abs(Im(zp1r)) ) then zpr = ToComplex(Re(zpr),-Im(zp1r)) else zp1r = ToComplex(Re(zp1r),-Im(zpr)) endif endif else zmr = zm zm1r = zm1 zpr = zp zp1r = zp1 endif call ffc1lg(cs1,zm,zm1,zmr,zm1r,-1,ier) call ffc1lg(cs2,zp,zp1,zpr,zp1r,+1,ier) cb0p = -clogmm/2 + cs1 + cs2 smax = max(absc(clogmm)/2,absc(cs1),absc(cs2)) if ( absc(cb0p) .lt. xloss*smax ) then call ffwarn(7,ier,absc(cb0p),smax) endif goto 990 * -#] normal case: * #] unequal nonzero masses: * #[ debug: 990 continue * #] debug: *###] ffcb0p: end *###[ ffc1lg: subroutine ffc1lg(cs,z,z1,zr,z1r,is,ier) ***#[*comment:*********************************************************** * * * Calculate the potentially unstable combination -1-z*log(1-1/z) * * = sum_{n=1} 1/(n+1) z^{-n}. * * * * Input z,z1 complex root, z1=1-z * * zr,z1r complex root for Im(p^2)=0, z1r=1-zr * * is integer -1: roots are z-, +1: z+ * * * * Output cs complex see above * * ier integer usual error flag * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments * integer is,ier ComplexType cs,z,z1,zr,z1r * * local variables * RealType absc ComplexType c,zfflog * * common blocks * #include "ff.h" * * statement function * absc(c) = abs(Re(c)) + abs(Im(c)) * * #] declarations: * #[ work: if ( 1 .lt. xclogm*absc(z) ) then cs = 0 elseif ( 1 .lt. precc*absc(z) ) then cs = 1/(2*z) elseif ( 1 .gt. 2*xloss*absc(z) ) then * * normal case * cs = -1 - z*zfflog(-z1/z,0,czero,ier) * * check analytical continuation for Im(p^2) -> 0 * if ( z.ne.zr .or. z1.ne.z1r ) then c = -z1r/zr if ( Re(c).lt.0 ) then * check whetehr we chose the correct continuation if ( (Im(c).gt.0 .or. Im(c).eq.0 .and. + is.eq.+1) .and. Im(-z1/z).lt.0 ) then cs = cs - c2ipi*z elseif ( (Im(c).lt.0 .or. Im(c).eq.0 .and. + is.eq.-1) .and. Im(-z1/z).gt.0 ) then cs = cs + c2ipi*z endif endif endif if ( absc(cs) .lt. xloss ) call ffwarn(8,ier,absc(cs),1D0) else * * Taylor expansion * call ffcayl(cs,1/z,xninv(2),29,ier) endif * #] work: *###] ffc1lg: end *###[ ffcot2: subroutine ffcot2(cpiDpj,cp,cma,cmb,cmap,cmbp,cmamb,ier) ***#[*comment:*********************************************************** * * * Store the 3 dotproducts in the common block ffdot. * * * * Input: see ffxc0p * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments * integer ier ComplexType cpiDpj(3,3),cp,cma,cmb,cmap,cmbp,cmamb * * local variables * integer ier1 RealType absc,xmax ComplexType c * * common blocks * #include "ff.h" * * statement function * absc(c) = abs(Re(c)) + abs(Im(c)) * #] declarations: * #[ work: ier1 = ier cpiDpj(1,1) = cma cpiDpj(2,2) = cmb cpiDpj(3,3) = cp if ( absc(cmap) .lt. absc(cmbp) ) then cpiDpj(1,2) = (cmap + cmb)/2 else cpiDpj(1,2) = (cmbp + cma)/2 endif cpiDpj(2,1) = cpiDpj(1,2) xmax = min(absc(cma),absc(cmb))/2 if ( absc(cmamb) .lt. absc(cmbp) ) then cpiDpj(1,3) = (-cmamb - cp)/2 else cpiDpj(1,3) = (cmbp - cma)/2 endif cpiDpj(3,1) = cpiDpj(1,3) xmax = min(absc(cma),absc(cp))/2 if ( absc(cmamb) .lt. absc(cmap) ) then cpiDpj(2,3) = (-cmamb + cp)/2 else cpiDpj(2,3) = (-cmap + cmb)/2 endif cpiDpj(3,2) = cpiDpj(2,3) xmax = min(absc(cmb),absc(cp))/2 ier = ier1 * #] work: *###] ffcot2: end LoopTools-2.16/src/B/PaxHeaders/BcoeffC.F0000644000000000000000000000013214044050744015022 xustar0030 mtime=1620070884.989308772 30 atime=1648161785.727698497 30 ctime=1648161793.715764879 LoopTools-2.16/src/B/BcoeffC.F0000644000000000000000000000217214044050744015744 0ustar00rootroot00000000000000* BcoeffC.F * invoke the two-point tensor coefficients * this file is part of LoopTools * last modified 3 May 21 th #include "externals.h" #include "types.h" #define npoint 2 #include "defs.h" subroutine BcoeffC(B, para) implicit none ComplexType B(*), para(1,*) #include "lt.h" #include "ltnames.h" integer ier(Nbb), i logical dump, ini serial = serial + 1 dump = ibits(debugkey, DebugB, 1) .ne. 0 .and. & serial .ge. debugfrom .and. serial .le. debugto if( dump ) call DumpParaC(2, para, "Bcoeff") B(1:Nbb) = 0 if( lambda .le. 0 ) then B(1+bb0) = 1 B(1+bb1) = -.5D0 B(1+bb00) = -(P(1) - 3*(M(1) + M(2)))/12D0 B(1+bb11) = 1/3D0 B(1+bb001) = (P(1) - 2*M(1) - 4*M(2))/24D0 B(1+bb111) = -.25D0 B(1+dbb00) = -1/12D0 B(1+dbb001) = 1/24D0 endif call BcoeffFFC(B, para, ier) ini = .TRUE. do i = 1, Nbb if( ier(i) .gt. warndigits ) then if( ini ) then print *, "Loss of digits in BgetC for:" call DumpParaC(2, para, " ") ini = .FALSE. endif print *, coeffname(i,2), " claims ", ier(i), "lost digits" endif enddo if( dump ) call DumpCoeffC(2, B) end LoopTools-2.16/src/B/PaxHeaders/ffcdb0.F0000644000000000000000000000007413127210271014656 xustar0030 atime=1648161785.727698497 30 ctime=1648161793.715764879 LoopTools-2.16/src/B/ffcdb0.F0000644000000000000000000004123013127210271015571 0ustar00rootroot00000000000000#include "externals.h" #include "types.h" *###[ ffcdb0: subroutine ffcdb0(cdb0,cdb0p,cp,cma,cmb,ier) ***#[*comment:*********************************************************** * * * Calculates the derivative of the two-point function with * * respect to p2, plus the same times p2. * * * * Input: cp (complex) k2, in B&D metric * * cma (complex) mass2 * * cmb (complex) mass2 * * * * Output: cdb0 (complex) dB0/dxp * * cdb0p (complex) cp*dB0/dxp * * ier (integer) # of digits lost, if >=100: error * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments * integer ier ComplexType cdb0,cdb0p ComplexType cp,cma,cmb * * local variables * integer ier0 ComplexType cmamb,cmap,cmbp RealType xp,xma,xmb * * common * #include "ff.h" * * #] declarations: * #[ check input: if ( Im(cma).eq.0 .and. Im(cmb).eq.0 ) then xma = Re(cma) xmb = Re(cmb) xp = Re(cp) call ffxdb0(cdb0,cdb0p,xp,xma,xmb,ier) return endif * #] check input: * #[ get differences: ier0 = 0 cmamb = cma - cmb cmap = cma - cp cmbp = cmb - cp * #] get differences: * #[ calculations: call ffcdbp(cdb0,cdb0p,cp,cma,cmb,cmap,cmbp,cmamb,ier) * #] calculations: *###] ffcdb0: end *###[ ffcdbp: subroutine ffcdbp(cdb0,cdb0p,cp,cma,cmb,cmap,cmbp,cmamb,ier) ***#[*comment:*********************************************************** * * * calculates the derivatives of the two-point function * * * * Input: cp (complex) p.p, in B&D metric * * cma (complex) mass2, * * cmb (complex) mass2, * * dm[ab]p (complex) cm[ab] - cp * * cmamb (complex) cma - cmb * * * * Output: cdb0 (complex) B0' = dB0/dxp * * cdb0p (complex) cp*B0' * * ier (integer) 0=ok,>0=numerical problems,>100=error * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments * integer ier ComplexType cdb0,cdb0p ComplexType cp,cma,cmb,cmap,cmbp,cmamb * * local variables * integer i,initeq,init,ithres,initir,n1,n2,nffet1 logical lreal RealType ax,ffbnd,ffbndc, + xprceq,bdeq01,bdeq05,bdeq11,bdeq17,bdeq25, + xprcn3,bdn301,bdn305,bdn310,bdn315, + xprcn5,bdn501,bdn505,bdn510,bdn515, + xprec0,bdn001,bdn005,bdn010,bdn015,bdn020, + absc,xmax,prcsav ComplexType cm,cdmp,cm1,cm2,cm1m2,cdm1p, + cdm2p,s,s1,s1a,s1b,s1p,s2,s2a,s2b,s2p,s3,cx,som, + clam,slam,xlogmm,alpha,alph1,xnoe,xpneq(30), + zfflo1,zfflo3,d1,d2,diff,h,a,b,c,d,beta, + betm2n,s1c,s1d,s1e,s1f,cqi(3),cqiqj(3,3),zm,zp ComplexType cc RealType xp,xma,xmb,dmamb,dmap,dmbp,sprec save initeq,xpneq,init,initir, + xprceq,bdeq01,bdeq05,bdeq11,bdeq17,bdeq25, + xprcn3,bdn301,bdn305,bdn310,bdn315, + xprcn5,bdn501,bdn505,bdn510,bdn515, + xprec0,bdn001,bdn005,bdn010,bdn015,bdn020 *for ABSOFT only * ComplexType csqrt * external csqrt * * common blocks * #include "ff.h" * * data * data xprceq /-1./ data xprec0 /-1./ data xprcn3 /-1./ data xprcn5 /-1./ data initeq /0/ * * statement function * absc(cc) = abs(Re(cc)) + abs(Im(cc)) * #] declarations: * #[ the real cases: * if ( Im(cma) .eq. 0 .and. Im(cmb) .eq. 0 ) then lreal = .TRUE. elseif ( nschem.le.2 ) then lreal = .TRUE. if ( init.eq.0 ) then init = 1 print *,'ffcb0: nschem <= 2, ignoring complex masses: ', + nschem endif elseif ( nschem.le.4 ) then if ( init.eq.0 ) then init = 1 print *,'ffcdbp: nschem = 3,4 complex masses near ', + 'singularity: ',nschem endif if ( abs(Re(cma)) .lt. -xloss*Im(cmb) + .and. abs(Re(cmbp)) .le. -nwidth*Im(cmb) + .or. abs(Re(cmb)) .lt. -xloss*Im(cma) + .and. abs(Re(cmap)) .le. -nwidth*Im(cma) ) then lreal = .FALSE. else lreal = .TRUE. endif elseif ( nschem.le.6 ) then if ( init.eq.0 ) then init = 1 print *,'ffcdbp: nschem = 5,6 complex masses near ', + 'threshold: ',nschem endif cqi(1) = cma cqi(2) = cmb cqi(3) = cp cqiqj(1,2) = cmamb cqiqj(2,1) = -cqiqj(1,2) cqiqj(1,3) = cmap cqiqj(3,1) = -cqiqj(1,3) cqiqj(2,3) = cmbp cqiqj(3,2) = -cqiqj(2,3) cqiqj(1,1) = 0 cqiqj(2,2) = 0 cqiqj(3,3) = 0 call ffthre(ithres,cqi,cqiqj,3,1,2,3) if ( ithres.eq.0 .or. ithres.eq.1 .and. nschem.eq.5 ) then lreal = .TRUE. else lreal = .FALSE. endif else lreal = .FALSE. endif if ( lreal ) then xp = Re(cp) xma = Re(cma) xmb = Re(cmb) dmap = Re(cmap) dmbp = Re(cmbp) dmamb = Re(cmamb) sprec = precx precx = precc call ffxdbp(cdb0,cdb0p,xp,xma,xmb,dmap,dmbp,dmamb,ier) precx = sprec return endif * * #] the real cases: * #[ which case: * * sort according to the type of masscombination encountered: * 100: both masses zero, 200: one equal to zero, 300: both equal * 400: rest. * if ( cma .eq. 0 ) then if ( cmb .eq. 0 ) then goto 100 endif cm = cmb cdmp = cmbp goto 200 endif if ( cmb .eq. 0 ) then cm = cma cdmp = cmap goto 200 elseif ( cmamb .eq. 0 ) then cm = cma cdmp = cmap goto 300 elseif ( Re(cma) .gt. Re(cmb) ) then cm2 = cma cm1 = cmb cm1m2 = -cmamb cdm1p = cmbp cdm2p = cmap else cm1 = cma cm2 = cmb cm1m2 = cmamb cdm1p = cmap cdm2p = cmbp endif goto 400 * #] which case: * #[ both masses equal to zero: 100 continue if ( cp.ne.0 ) cdb0 = -1/cp cdb0p = -1 return * #] both masses equal to zero: * #[ one mass equal to zero: 200 continue * * special case cp = 0 * if ( cp .eq. 0 ) then cdb0p = 0 cdb0 = 1/(2*cm) goto 990 * * special case cp = cm * elseif ( cdmp.eq.0 ) then if ( initir.eq.0 ) then initir = 1 print *,'ffcdbd: IR divergent B0'', using cutoff ', & lambda endif if ( lambda .le. 0 ) then cdb0p = -1 + log(cm/mudim)/2 else cdb0p = -1 + log(cm/lambda)/2 endif cdb0 = cdb0p/cp goto 990 endif * * Normal case: * cx = cp/cm ax = absc(cx) if ( ax .lt. xloss ) then * #[ Taylor expansion: if ( xprec0 .ne. precx ) then xprec0 = precc prcsav = precx precx = precc bdn001 = ffbnd(2,1,xninv) bdn005 = ffbnd(2,5,xninv) bdn010 = ffbnd(2,10,xninv) bdn015 = ffbnd(2,15,xninv) bdn020 = ffbnd(2,20,xninv) precx = prcsav endif if ( ax .gt. bdn015 ) then som = cx*(Re(xninv(17)) + cx*(Re(xninv(18)) + + cx*(Re(xninv(19)) + cx*(Re(xninv(20)) + + cx*(Re(xninv(21)) ))))) else som = 0 endif if ( ax .gt. bdn010 ) then som = cx*(Re(xninv(12)) + cx*(Re(xninv(13)) + + cx*(Re(xninv(14)) + cx*(Re(xninv(15)) + + cx*(Re(xninv(16)) + som ))))) endif if ( ax .gt. bdn005 ) then som = cx*(Re(xninv(7)) + cx*(Re(xninv(8)) + + cx*(Re(xninv(9)) + cx*(Re(xninv(10)) + + cx*(Re(xninv(11)) + som ))))) endif if ( ax .gt. bdn001 ) then som = cx*(Re(xninv(3)) + cx*(Re(xninv(4)) + + cx*(Re(xninv(5)) + cx*(Re(xninv(6)) + som )))) endif cdb0p = cx*(Re(xninv(2)) + som) * #] Taylor expansion: else * #[ short formula: s = log(cdmp/cm) cdb0p = -(1 + s*cm/cp) * #] short formula: endif cdb0 = cdb0p/cp goto 990 * #] one mass equal to zero: * #[ both masses equal: 300 continue * * Both masses are equal. Not only this speeds up things, some * cancellations have to be avoided as well. * * first a special case * if ( absc(cp) .lt. 8*xloss*absc(cm) ) then * -#[ taylor expansion: * * a Taylor expansion seems appropriate as the result will go * as k^2 but seems to go as 1/k !! * *--#[ data and bounds: if ( initeq .eq. 0 ) then initeq = 1 xpneq(1) = 1/6D0 do 1 i=2,30 xpneq(i) = - xpneq(i-1)*Re(i)/Re(2*(2*i+1)) 1 continue endif if (xprceq .ne. precx ) then * * calculate the boundaries for the number of terms to be * included in the taylorexpansion * xprceq = precx bdeq01 = ffbndc(1,1,xpneq) bdeq05 = ffbndc(1,5,xpneq) bdeq11 = ffbndc(1,11,xpneq) bdeq17 = ffbndc(1,17,xpneq) bdeq25 = ffbndc(1,25,xpneq) endif *--#] data and bounds: cx = -cp/cm ax = absc(cx) if ( ax .gt. bdeq17 ) then som = cx*(xpneq(18) + cx*(xpneq(19) + cx*(xpneq(20) + + cx*(xpneq(21) + cx*(xpneq(22) + cx*(xpneq(23) + + cx*(xpneq(24) + cx*(xpneq(25) )))))))) else som = 0 endif if ( ax .gt. bdeq11 ) then som = cx*(xpneq(12) + cx*(xpneq(13) + cx*(xpneq(14) + + cx*(xpneq(15) + cx*(xpneq(16) + cx*(xpneq(17) + som )))) + )) endif if ( ax .gt. bdeq05 ) then som = cx*(xpneq(6) + cx*(xpneq(7) + cx*(xpneq(8) + cx*( + xpneq(9) + cx*(xpneq(10) + cx*(xpneq(11) + som )))))) endif if ( ax .gt. bdeq01 ) then som = cx*(xpneq(2) + cx*(xpneq(3) + cx*(xpneq(4) + cx*( + xpneq(5) + som )))) endif cdb0p = -cx*(xpneq(1)+som) if ( cp.ne.0 ) then cdb0 = cdb0p*(1/Re(cp)) else cdb0 = xpneq(1)/cm endif goto 990 * -#] taylor expansion: endif * -#[ normal case: * * normal case * call ffclmb(clam,-cp,-cm,-cm,cdmp,cdmp,czero) slam = sqrt(clam) call ffcoot(zm,zp,cone,chalf,cm/cp,slam/(2*cp),ier) s1 = zp/zm if( abs(s1-1) .lt. xloss ) then * In this case a quicker and more accurate way is to * calculate log(1-cx). print *,'Not tested, probably wrong' ier = ier + 50 s2 = (cp - slam) if ( absc(s2) .lt. xloss*absc(cp) ) then s2 = -slam*(cp+slam)/(4*cp*cm) else s2 = -2*slam/s2 endif s = -2*cm/slam*zfflo1(s2/(2*cm),ier) else * finally the normal case s = -2*cm/slam*log(s1) endif * * eta terms * n1 = nffet1(zp,1/zm,s1,ier) n2 = nffet1(-zp,-1/zm,s1,ier) if ( n1+n2 .ne. 0 ) then s1 = cm/slam*c2ipi*(n1+n2) s = s + s1 endif cdb0p = s - 1 cdb0 = cdb0p/cp goto 990 * -#] normal case: * * #] both masses equal: * #[ unequal nonzero masses: 400 continue * -#[ get log(cm2/cm1): cx = cm2/cm1 c = cx-1 if ( 1 .lt. xclogm*absc(cx) ) then call fferr(8,ier) xlogmm = 0 elseif ( absc(c) .lt. xloss ) then xlogmm = zfflo1(cm1m2/cm1,ier) else xlogmm = log(cx) endif * -#] get log(cm2/cm1): * -#[ cp = 0: * * first a special case * if ( cp .eq. 0 ) then * * repaired 19-nov-1993, see b2.frm * s1 = cm1*cm2*xlogmm/cm1m2**3 s2 = (cm1 + cm2)/(2*cm1m2**2) s = s1 + s2 if ( absc(s) .lt. xloss**2*absc(s2) ) then * * second try * h = zfflo3(cm1m2/cm1,ier) s1 = -cm1*h/cm1m2**2 s2 = 1/(2*cm1) s3 = cm1**2*h/cm1m2**3 s = s1 + s2 + s3 if ( absc(s) .lt. xloss*max(absc(s2),absc(s3)) ) then call ffwarn(234,ier,absc(s),absc(s2)) endif endif cdb0 = s cdb0p = 0 goto 990 endif * -#] cp = 0: * -#[ normal case: * * proceeding with the normal case * call ffclmb(clam,-cp,-cm2,-cm1,cdm2p,cdm1p,cm1m2) diff = clam + cp*(cdm2p+cm1) if ( absc(diff) .lt. xloss*absc(clam) ) then h = cm1m2**2 - cp*(cm1+cm2) if ( absc(h) .lt. xloss*absc(cm1m2)**2 ) then if ( absc(cm1m2)**2 .lt. absc(clam) ) diff = h call ffwarn(235,ier,absc(diff),min(absc(cm1m2)**2, + absc(clam))) endif endif *--#[ first try: * first try the normal way slam = sqrt(clam) if ( abs(Re(cm1)) .lt. abs(Re(cm2)) ) then s2a = cm1 + cdm2p else s2a = cm2 + cdm1p endif if ( absc(s2a + slam) .lt. xloss*absc(slam) ) slam = -slam s2a = s2a + slam s2 = s2a**2/(4*cm1*cm2) if ( absc(s2) .lt. xclogm ) then call fferr(9,ier) s2 = 0 else if ( absc(s2-1) .lt. xloss ) then ier = ier + 50 print *,'ffcdb0: untested: s2 better in first try' s2 = 2*zfflo1(-slam*s2a/(2*cm1*cm2),ier) else s2 = log(s2) endif s2 = -diff/(2*slam*cp)*s2 s1 = -cm1m2*xlogmm/(2*cp) cdb0p = s1+s2-1 *--#] first try: if ( absc(cdb0p) .lt. xloss**2*max(absc(s1),absc(s2)) ) then *--#[ second try: * this is unacceptable, try a better solution s1a = diff + slam*cm1m2 if ( absc(s1a) .gt. xloss*absc(diff) ) then * this works s1 = -s1a/(2*cp*slam) else * by division a more accurate form can be found s1 = -2*cm1*cm2*cp/(slam*(diff - slam*cm1m2)) endif s = s1 s1 = s1*xlogmm if ( abs(Re(cp)).lt.abs(Re(cm2)) ) then s2a = cp - cm1m2 else s2a = cm2 - cdm1p endif s2 = s2a - slam if ( absc(s2) .gt. xloss*absc(slam) ) then * at least reasonable s2 = s2 / (2*cm2) else * division again s2 = (2*cp) / (s2a+slam) endif if ( absc(s2) .lt. .1 ) then * choose a quick way to get the logarithm s2 = zfflo1(s2,ier) else s2 = log(1-s2) endif s2 = -diff/(slam*cp)*s2 cdb0p = s1 + s2 - 1 *--#] second try: if ( absc(cdb0p) .lt. xloss**2*max(absc(s1),absc(s2)) ) + then *--#[ third try: * (we accept two times xloss because that's the same * as in this try) * A Taylor expansion might work. We expand * inside the logs. Only do the necessary work. * * #[ split up 1: xnoe = s2a+slam a = 1 b = 2/xnoe-1/cp c = -4/(cp*xnoe) d = sqrt(cp**(-2) + (2/xnoe)**2) call ffcoot(d1,d2,a,b,c,d,ier) if ( Re(cp).gt.0 ) then beta = d2 else beta = d1 endif alpha = beta*diff/slam alph1 = 1-alpha if ( absc(alph1) .lt. xloss ) then s1a = 4*cp**2*cm1*cm2/(slam*cm1m2*(diff-slam* + cm1m2)) s1b = -diff/slam*4*cm1*cp/(cm1m2*xnoe*(2*cp- + xnoe)) b = -1/cp c = -(2/xnoe)**2 call ffcoot(d1,d2,a,b,c,d,ier) if ( Re(cp).gt.0 ) then betm2n = d2 else betm2n = d1 endif d1 = s1a + s1b - diff/slam*betm2n xmax = max(absc(s1a),absc(s1b)) if ( xmax .lt. 1 ) then alph1 = d1 else xmax = 1 endif if ( absc(alph1) .lt. xloss*xmax ) + call ffwarn(236,ier,absc(alph1),xmax) else betm2n = beta - 2/xnoe endif * #] split up 1: * #[ s2: * * first s2: * s2p = s2 - alpha if ( absc(s2p) .lt. xloss*absc(s2) ) then * -#[ bounds: * determine the boundaries for 1,5,10,15 terms if ( xprcn5 .ne. precx ) then xprcn5 = precc prcsav = precx precx = precc bdn501 = ffbnd(3,1,xinfac) bdn505 = ffbnd(3,5,xinfac) bdn510 = ffbnd(3,10,xinfac) bdn515 = ffbnd(3,15,xinfac) precx = prcsav endif * -#] bounds: cx = beta*cp ax = absc(cx) if ( ax .gt. bdn510 ) then s2a = cx*(Re(xinfac(13)) + cx*(Re(xinfac( + 14))+ cx*(Re(xinfac(15)) + cx*(Re(xinfac( + 16))+ cx*(Re(xinfac(17))))))) else s2a = 0 endif if ( ax .gt. bdn505 ) then s2a = cx*(Re(xinfac( 8)) + cx*(Re(xinfac( + 9))+ cx*(Re(xinfac(10)) + cx*(Re(xinfac( + 11))+ cx*(Re(xinfac(12)) + s2a))))) endif if ( ax .gt. bdn501 ) then s2a =cx*(Re(xinfac(4))+cx*(Re(xinfac(5)) + +cx*(Re(xinfac(6))+cx*(Re(xinfac(7)) + + s2a)))) endif s2a = cx**3*(Re(xinfac(3))+s2a) s2b = 2*cp/xnoe*(s2a + cx**2/2) s2p = s2b - s2a s2p = -diff/(cp*slam)*zfflo1(s2p,ier) endif * #] s2: * #[ s1: * * next s1: * s1p = s1 - alph1 if ( absc(s1p) .lt. xloss*absc(s1) ) then * -#[ bounds: * determine the boundaries for 1,5,10,15 terms if ( xprcn3 .ne. precx ) then xprcn3 = precc prcsav = precx precx = precc bdn301 = ffbnd(3,1,xinfac) bdn305 = ffbnd(3,5,xinfac) bdn310 = ffbnd(3,10,xinfac) bdn315 = ffbnd(3,15,xinfac) precx = prcsav endif * -#] bounds: * cx = slam*(diff-slam*cm1m2)*alph1/(2*cp*cm1*cm2) ax = absc(cx) h = (2*cp*(cm1+cm2) - cp**2)/(slam-cm1m2) * * see form job gets1.frm * s1b = diff*(diff-slam*cm1m2)*betm2n/(2*cp*cm1* + cm2) s1c = 1/(cm1*xnoe*(2*cp-xnoe))*( + cp*( 4*cp*cm2 + 2*cm1m2**2/cm2*(cp-h) + + 2*cm1m2*(3*cp-h) - 8*cm1m2**2 ) + - 2*cm1m2**3/cm2*(3*cp-h) + + 4*cm1m2**4/cm2 + ) s1d = cx*cm1m2/cm1 s1e = -cx**2/2 if ( ax .gt. bdn310 ) then s1a = cx*(Re(xinfac(13)) + cx*(Re(xinfac( + 14))+ cx*(Re(xinfac(15)) + cx*(Re(xinfac( + 16))+ cx*(Re(xinfac(17))))))) else s1a = 0 endif if ( ax .gt. bdn305 ) then s1a = cx*(Re(xinfac( 8)) + cx*(Re(xinfac( + 9))+ cx*(Re(xinfac(10)) + cx*(Re(xinfac( + 11))+ cx*(Re(xinfac(12)) + s1a))))) endif if ( ax .gt. bdn301 ) then s1a =cx*(Re(xinfac(4))+cx*(Re(xinfac(5)) + +cx*(Re(xinfac(6))+cx*(Re(xinfac(7)) + +s1a)))) endif s1a = -cx**3 *(Re(xinfac(3)) + s1a) s1f = cm1m2/cm1*(cx**2/2 - s1a) s1p = s1e + s1d + s1c + s1b + s1a + s1f xmax = max(absc(s1a),absc(s1b),absc(s1c), + absc(s1d),absc(s1e)) s1p = s*zfflo1(s1p,ier) endif * #] s1: * * finally ... * cdb0p = s1p + s2p *--#] third try: endif endif cdb0 = cdb0p*(1/Re(cp)) * -#] normal case: * #] unequal nonzero masses: 990 continue *###] ffcdbp: end LoopTools-2.16/src/B/PaxHeaders/BcoeffAD.F0000644000000000000000000000007412401072770015127 xustar0030 atime=1648161785.727698497 30 ctime=1648161793.715764879 LoopTools-2.16/src/B/BcoeffAD.F0000644000000000000000000001726112401072770016051 0ustar00rootroot00000000000000* BcoeffAD.F * the two-point tensor coefficients from Ansgar Denner's bcanew.f, * adapted to the conventions of LoopTools * this file is part of LoopTools * last modified 1 Sep 14 th #include "externals.h" #include "types.h" #define npoint 2 #include "defs.h" subroutine BcoeffAD(B, para) implicit none ComplexType B(*) RealType para(1,*) #include "lt.h" ComplexType fpv, yfpv, fth, xlogx external fpv, yfpv, fth, xlogx RealType p, m1, m2 RealType dm, la ComplexType x1, x2, y1, y2, r ComplexType mu, f1, f2, g1, g2, a0 integer sel m1 = M(1) m2 = M(2) p = P(1) dm = m1 - m2 * general case if( abs(p) .gt. zeroeps*(m1 + m2) ) then r = sqrt(ToComplex(p*(p - m1 - m2) - & m1*(p - dm) - m2*(p + dm))) x1 = .5D0*(p + dm + r)/p x2 = .5D0*(p + dm - r)/p if( abs(x2) .gt. abs(x1) ) then x1 = m1/(p*x2) else if( abs(x1) .gt. abs(x2) ) then x2 = m1/(p*x1) endif x1 = x1 + sign(abs(x1), p)*cIeps x2 = x2 - sign(abs(x2), p)*cIeps y2 = .5D0*(p - dm + r)/p y1 = .5D0*(p - dm - r)/p if( abs(y2) .gt. abs(y1) ) then y1 = m2/(p*y2) else if( abs(y1) .gt. abs(y2) ) then y2 = m2/(p*y1) endif y1 = y1 - sign(abs(y1), p)*cIeps y2 = y2 + sign(abs(y2), p)*cIeps if( abs(y1) .gt. .5D0 .and. abs(y2) .gt. .5D0 ) then mu = log(m2/mudim) - delta B(bb0) = -(mu + fpv(1, x1, y1) + fpv(1, x2, y2)) B(bb1) = 1/2D0*(mu + fpv(2, x1, y1) + fpv(2, x2, y2)) B(bb11) = -1/3D0*(mu + fpv(3, x1, y1) + fpv(3, x2, y2)) B(bb111) = 1/4D0*(mu + fpv(4, x1, y1) + fpv(4, x2, y2)) else if( abs(x1) .lt. 10 .and. abs(x2) .lt. 10 ) then mu = log(p/mudim*(1 - cIeps)) - delta g1 = xlogx(y1) f1 = xlogx(-x1) - g1 + 1 g2 = xlogx(y2) f2 = xlogx(-x2) - g2 + 1 B(bb0) = -(mu - f1 - f2) f1 = x1*f1 - g1 + 1/2D0 f2 = x2*f2 - g2 + 1/2D0 B(bb1) = 1/2D0*(mu - f1 - f2) f1 = x1*f1 - g1 + 1/3D0 f2 = x2*f2 - g2 + 1/3D0 B(bb11) = -1/3D0*(mu - f1 - f2) f1 = x1*f1 - g1 + 1/4D0 f2 = x2*f2 - g2 + 1/4D0 B(bb111) = 1/4D0*(mu - f1 - f2) else if( abs(x1) .gt. .5D0 .and. abs(x2) .gt. .5D0 ) then mu = log(m1/mudim) - delta + & fth(1, x1, y1) + fth(1, x2, y2) B(bb0) = -mu mu = mu + fth(2, x1, y1) + fth(2, x2, y2) B(bb1) = 1/2D0*mu mu = mu + fth(3, x1, y1) + fth(3, x2, y2) B(bb11) = -1/3D0*mu mu = mu + fth(4, x1, y1) + fth(4, x2, y2) B(bb111) = 1/4D0*mu else print *, "BcoeffAD not defined for" print *, " p =", p print *, " m1 =", m1 print *, " m2 =", m2 B(bb0) = nan B(bb1) = nan B(bb11) = nan B(bb111) = nan endif a0 = 0 if( m2 .ne. 0 ) a0 = m2*(1 - log(m2/mudim) + delta) B(bb00) = ((p + dm)*B(bb1) + & 2*m1*B(bb0) + a0 + m1 + m2 - p/3D0)/6D0 B(bb001) = .125D0*( 2*m1*B(bb1) - a0 + & (p + dm)*(B(bb11) + 1/6D0) - .5D0*(m1 + m2) ) if( abs(x1 - x2) .gt. diffeps*abs(x1 + x2) ) then B(dbb11) = (yfpv(3, x2, y2) - yfpv(3, x1, y1))/r sel = 1 else if( abs(x1) .gt. 10 ) then B(dbb11) = -Re((3/4D0 + (3 - 4*x1)*fpv(4, x1, y1))/ & x1**2)/p sel = 2 else if( abs(y1) .gt. diffeps ) then B(dbb11) = -Re(4/3D0 + (3 - 4*x1)*fpv(2, x1, y1))/p sel = 3 else B(dbb11) = nan sel = 4 endif la = lambda if( la .le. 0 ) la = mudim if( abs(m1) + abs(m2) .eq. 0 ) then B(dbb0) = nan if( p .ne. 0 ) B(dbb0) = -1/p else if( m1*m2 .eq. 0 .and. & abs(p - m1 - m2) .lt. diffeps ) then * IR divergent case B(dbb0) = -(1 + .5D0*log(la/p))/p else if( sel .eq. 1 ) then B(dbb0) = (yfpv(1, x2, y2) - yfpv(1, x1, y1))/r else if( sel .eq. 2 ) then B(dbb0) = -Re((.5D0 + (1 - 2*x1)*fpv(2, x1, y1))/ & x1**2)/p else if( sel .eq. 3 ) then B(dbb0) = -Re(2 + (1 - 2*x1)*fpv(0, x1, y1))/p else B(dbb0) = nan endif if( abs(m1) + abs(m2) .eq. 0 ) then B(dbb1) = nan if( p .ne. 0 ) B(dbb1) = .5D0/p else if( m2 .eq. 0 .and. abs(p - m1) .lt. diffeps ) then * IR divergent case B(dbb1) = .5D0*(3 + log(la/p))/p else if( sel .eq. 1 ) then B(dbb1) = (yfpv(2, x1, y1) - yfpv(2, x2, y2))/r else if( sel .eq. 2 ) then B(dbb1) = Re((2/3D0 + (2 - 3*x1)*fpv(3, x1, y1))/ & x1**2)/p else if( sel .eq. 3 ) then B(dbb1) = Re(3/2D0 + (2 - 3*x1)*fpv(1, x1, y1))/p else B(dbb1) = nan endif * zero momentum else if( abs(dm) .gt. diffeps*(m1 + m2) ) then x2 = m1/dm*(1 - cIeps) y2 = -m2/dm*(1 - cIeps) if( abs(y2) .gt. .5D0 ) then mu = log(m2/mudim) - delta B(bb0) = -(mu + fpv(1, x2, y2)) B(bb1) = 1/2D0*(mu + fpv(2, x2, y2)) B(bb11) = -1/3D0*(mu + fpv(3, x2, y2)) B(bb111) = 1/4D0*(mu + fpv(4, x2, y2)) a0 = 0 if( m2 .ne. 0 ) a0 = m2*(1 - log(m2/mudim) + delta) B(bb00) = (2*(m1*B(bb0) + a0) + m1 + m2)/8D0 else mu = log(m1/mudim) - delta f1 = fpv(1, y2, x2) B(bb0) = -(mu + f1) B(bb1) = 1/2D0*(mu + (1 + x2)*f1 + 1/2D0) B(bb11) = -1/3D0*(mu - (1 + x2*(1 + x2))*yfpv(0, x2, y2) - & x2*(x2 + 1/2D0) - 1/3D0) B(bb111) = 1/4D0*(mu - & (1 + x2*(1 + x2*(1 + x2)))*yfpv(0, x2, y2) - & x2*(x2*(x2 + 1/2D0) + 1/3D0) - 1/4D0) a0 = 0 if( m1 .ne. 0 ) a0 = m1*(1 - log(m1/mudim) + delta) B(bb00) = (2*(m2*B(bb0) + a0) + m1 + m2)/8D0 endif B(bb001) = -( ((m1 + m2)/6D0)**2 + & m1*m2/6D0 * (B(bb0) + 1/3D0) + & (dm - m2)/3D0 * B(bb00) )/dm if( abs(x2) .lt. 10 ) then B(dbb0) = (1/2D0 + yfpv(1, x2, y2))/dm B(dbb1) = -(1/3D0 + yfpv(2, x2, y2))/dm B(dbb11) = (1/4D0 + yfpv(3, x2, y2))/dm else B(dbb0) = (1/2D0 + yfpv(2, x2, y2))/m1 B(dbb1) = -(1/3D0 + yfpv(3, x2, y2))/m1 B(dbb11) = (1/4D0 + yfpv(4, x2, y2))/m1 endif else mu = log(m2/mudim) - delta B(bb0) = -mu B(bb1) = 1/2D0*mu B(bb11) = -1/3D0*mu B(bb111) = 1/4D0*mu B(bb00) = .5D0*m1*(1 - mu) B(bb001) = -.5D0*B(bb00) B(dbb0) = 1/6D0/m1 B(dbb1) = -1/12D0/m1 B(dbb11) = 1/20D0/m1 endif B(dbb00) = 1/6D0*( 2*m1*B(dbb0) + B(bb1) + & (p + dm)*B(dbb1) - 1/3D0 ) B(dbb001) = 1/8D0*( 2*m1*B(dbb1) + B(bb11) + & (p + dm)*B(dbb11) + 1/6D0 ) end ************************************************************************ ComplexType function fpv(n, x, y) implicit none integer n ComplexType x, y #include "lt.h" ComplexType xm integer m if( abs(x) .lt. 5 ) then if( n .eq. 0 ) then fpv = -log(-y/x) else if( abs(x) .lt. diffeps ) then fpv = -1D0/n else xm = -log(-y/x) do m = 1, n xm = x*xm - 1D0/m enddo fpv = xm endif else fpv = 0 xm = 1 do m = 1, 50 xm = xm/x fpv = fpv + xm/(m + n) if( abs(xm) .lt. precx*abs(fpv) ) return enddo endif end ************************************************************************ ComplexType function yfpv(n, x, y) implicit none integer n ComplexType x, y ComplexType fpv external fpv if( abs(y) .eq. 0 ) then yfpv = 0 else yfpv = y*fpv(n, x, y) endif end ************************************************************************ ComplexType function fth(n, x, y) implicit none integer n ComplexType x, y #include "lt.h" ComplexType fpv external fpv ComplexType xm integer m if( abs(x) .gt. 1D4 ) then xm = 1 fth = 0 do m = n, 30 + n xm = xm/x fth = fth - xm/(m*(m + 1)) if( abs(xm) .lt. precx*abs(fth) ) return enddo else fth = fpv(1, y, x) do m = 1, n - 1 fth = x*fth + 1D0/(m*(m + 1)) enddo endif end ************************************************************************ ComplexType function xlogx(x) implicit none ComplexType x if( abs(x) .eq. 0 ) then xlogx = 0 else xlogx = x*log(x) endif end LoopTools-2.16/src/B/PaxHeaders/ffxdb1.F0000644000000000000000000000007412401077747014721 xustar0030 atime=1648161785.727698497 30 ctime=1648161793.715764879 LoopTools-2.16/src/B/ffxdb1.F0000644000000000000000000002106612401077747015641 0ustar00rootroot00000000000000#include "externals.h" #include "types.h" *###[ ffxdb1: subroutine ffxdb1(cdb1, p, m1, m2, ier) ***#[*comment:*********************************************************** * * * DB1 function (derivative of B1) * * * * algorithm adapted from Ansgar Denner's bcanew.f * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments * ComplexType cdb1 RealType p, m1, m2 integer ier ComplexType ffpvf, ffypvf external ffpvf, ffypvf ComplexType xp, xm, yp, ym, r #include "ff.h" logical initir save initir data initir /.FALSE./ * * #[ declarations: if( abs(p) .gt. diffeps*(m1 + m2) ) then * IR divergent case if( m2 .eq. 0 .and. p .eq. m1 ) then if( .not. initir ) then initir = .TRUE. print *, "ffxdb1: IR divergent B1', using cutoff ", + lambda endif if( lambda .le. 0 ) then cdb1 = .5D0*(3 + log(mudim/p))/p else cdb1 = .5D0*(3 + log(lambda/p))/p endif return endif call ffroots(p, m1, m2, xp, xm, yp, ym, r, ier) if( abs(xp - xm) .gt. diffeps*abs(xp + xm) ) then cdb1 = (ffypvf(2, xp, yp) - ffypvf(2, xm, ym))/r else if( abs(xp) .gt. 10 ) then cdb1 = Re( (2/3D0 + + (2 - 3*xp)*ffpvf(3, xp, yp))/xp**2 )/p else if( abs(yp) .gt. diffeps ) then cdb1 = Re( (3/2D0 + + (2 - 3*xp)*ffpvf(1, xp, yp)) )/p else call fferr(101, ier) cdb1 = nan endif * zero momentum case else if( abs(m1 - m2) .gt. diffeps*(m1 + m2) ) then xm = (1 - cIeps)*m1/(m1 - m2) ym = (1 - cIeps)*m2/(m2 - m1) if( abs(xm) .lt. 10 ) then cdb1 = -(1/3D0 + ffypvf(2, xm, ym))/(m1 - m2) else cdb1 = -(1/3D0 + ffypvf(3, xm, ym))/m1 endif else cdb1 = -1/12D0/m1 endif end *###[ ffxdb11: subroutine ffxdb11(cdb11, p, m1, m2, ier) ***#[*comment:*********************************************************** * * * DB11 function (derivative of B11) * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments * ComplexType cdb11 RealType p, m1, m2 integer ier ComplexType ffpvf, ffypvf external ffpvf, ffypvf ComplexType xp, xm, yp, ym, r #include "ff.h" * * #] declarations: if( abs(p) .gt. diffeps*(m1 + m2) ) then call ffroots(p, m1, m2, xp, xm, yp, ym, r, ier) if( abs(xp - xm) .gt. diffeps*abs(xp + xm) ) then cdb11 = (ffypvf(3, xm, ym) - ffypvf(3, xp, yp))/r else if( abs(xp) .gt. 10 ) then cdb11 = Re( (-3/4D0 + + (4*xp - 3)*ffpvf(4, xp, yp))/xp**2 )/p else if( abs(yp) .gt. diffeps ) then cdb11 = Re( (-4/3D0 + + (4*xp - 3)*ffpvf(2, xp, yp))/p ) else c call fferr(102, ier) cdb11 = nan endif * zero momentum case else if( abs(m1 - m2) .gt. diffeps*(m1 + m2) ) then xm = (1 - cIeps)*m1/(m1 - m2) ym = (1 - cIeps)*m2/(m2 - m1) if( abs(xm) .lt. 10 ) then cdb11 = (1/4D0 + ffypvf(3, xm, ym))/(m1 - m2) else cdb11 = (1/4D0 + ffypvf(4, xm, ym))/m1 endif else cdb11 = 1/20D0/m1 endif end *###[ ffxdb11: subroutine ffxb111(cb111, p, m1, m2, ier) ***#[*comment:*********************************************************** * * * B111 function (coefficient of p_mu p_nu p_rho) * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments * ComplexType cb111 RealType p, m1, m2 integer ier ComplexType ffpvf, ffypvf, ffthf, ffxlogx external ffpvf, ffypvf, ffthf, ffxlogx ComplexType xp, xm, yp, ym, r #include "ff.h" * * #] declarations: if( abs(p) .gt. diffeps*(m1 + m2) ) then call ffroots(p, m1, m2, xp, xm, yp, ym, r, ier) if( abs(yp) .gt. .5D0 .and. abs(ym) .gt. .5D0 ) then cb111 = 1/4D0*( log(m2/mudim) - delta + & ffpvf(4, xp, yp) + ffpvf(4, xm, ym) ) else if( abs(xp) .lt. 10 .and. abs(xm) .lt. 10 ) then cb111 = 1/4D0*( log(p/mudim*(1 - cIeps)) - & delta - 1/2D0 + & (1 + xp)*(1 + xp**2)*ffxlogx(yp) - & xp*(1/3D0 + xp*(1/2D0 + xp*(1 + ffxlogx(-xp)))) + & (1 + xm)*(1 + xm**2)*ffxlogx(ym) - & xm*(1/3D0 + xm*(1/2D0 + xm*(1 + ffxlogx(-xm)))) ) else if( abs(xp) .gt. .5D0 .and. abs(xm) .gt. .5D0 ) then cb111 = 1/4D0*( log(m1/mudim) - delta + & ffthf(4, xp, yp) + ffthf(4, xm, ym) ) else c call fferr(102, ier) cb111 = nan endif * zero momentum case else if( abs(m1 - m2) .gt. diffeps*(m1 + m2) ) then xm = (1 - cIeps)*m1/(m1 - m2) ym = (1 - cIeps)*m2/(m2 - m1) if( abs(ym) .gt. .5D0 ) then cb111 = 1/4D0*(log(m2/mudim) - delta + ffpvf(4, xm, ym)) else cb111 = 1/4D0*(log(m1/mudim) - delta - & (1 + xm*(1 + xm*(1 + xm)))*ffypvf(0, xm, ym) - & xm*(xm*(xm + 1/2D0) + 1/3D0) - 1/4D0) endif else cb111 = 1/4D0*(log(m2/mudim) - delta) endif end *###[ ffroots subroutine ffroots(p, m1, m2, xp, xm, yp, ym, r, ier) ***#[*comment:*********************************************************** * * * roots of quadratic equation * * p*x^2 + (m2 - m1 - p)*x + m2 - I eps = * * p*(x - xp)*(x - xm) = p*(x - 1 + yp)*(x - 1 + ym) * * i.e. x[pm] = 1 - y[pm] * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments * RealType p, m1, m2 ComplexType xp, xm, yp, ym, r integer ier RealType qx, qy #include "ff.h" * * #] declarations: * #[ check input: if( p .eq. 0 ) then call fferr(39, ier) return endif * #] check input: qx = m1 - m2 + p qy = m2 - m1 + p r = sqrt(ToComplex(p*(p - m1 - m2) - m1*qy - m2*qx)) xp = .5D0*(qx + r)/p xm = .5D0*(qx - r)/p if( abs(xm) .gt. abs(xp) ) then xp = m1/(p*xm) else if( abs(xp) .gt. abs(xm) ) then xm = m1/(p*xp) endif xp = xp + sign(abs(xp), p)*cIeps xm = xm - sign(abs(xm), p)*cIeps ym = .5D0*(qy + r)/p yp = .5D0*(qy - r)/p if( abs(ym) .gt. abs(yp) ) then yp = m2/(p*ym) else if( abs(yp) .gt. abs(ym) ) then ym = m2/(p*yp) endif yp = yp - sign(abs(yp), p)*cIeps ym = ym + sign(abs(ym), p)*cIeps end *###[ ffpvf ComplexType function ffpvf(n, x, y) ***#[*comment:*********************************************************** * * * Passarino-Veltman function f(n, x) * * here third arg y = 1 - x * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments * integer n ComplexType x, y ComplexType xm integer m #include "ff.h" * * #] declarations: if( abs(x) .lt. 5 ) then if( n .eq. 0 ) then ffpvf = -log(-y/x) else if( abs(x) .lt. 1D-14 ) then ffpvf = -1D0/n else xm = -log(-y/x) do m = 1, n xm = x*xm - 1D0/m enddo ffpvf = xm endif else ffpvf = 0 xm = 1 do m = 1, 30 xm = xm/x ffpvf = ffpvf + xm/(m + n) if( abs(xm) .lt. precx*abs(ffpvf) ) return enddo endif end *###[ ffypvf ComplexType function ffypvf(n, x, y) ***#[*comment:*********************************************************** * * * y*ffpvf(n, x, y) * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments * integer n ComplexType x, y ComplexType ffpvf external ffpvf * * #] declarations: if( abs(y) .eq. 0 ) then ffypvf = 0 else ffypvf = y*ffpvf(n, x, y) endif end *###[ ffypvf ComplexType function ffxlogx(x) ***#[*comment:*********************************************************** * * * x*log(x) * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments * ComplexType x * * #] declarations: if( abs(x) .eq. 0 ) then ffxlogx = 0 else ffxlogx = x*log(x) endif end *###[ ffthf ComplexType function ffthf(n, x, y) ***#[*comment:*********************************************************** * * * y*ffpvf(n, x, y) * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments * integer n ComplexType x, y ComplexType ffpvf external ffpvf ComplexType xm integer m #include "ff.h" * * #] declarations: if( abs(x) .gt. 1D4 ) then xm = n ffthf = 0 do m = 1, 30 xm = xm/x ffthf = ffthf - xm/(m*(m + n)) if( abs(xm) .lt. precx*abs(ffthf) ) return enddo else xm = ffpvf(1, y, x) ffthf = xm do m = 1, n - 1 xm = x*xm + 1D0/(m*(m + 1)) ffthf = ffthf + xm enddo endif end LoopTools-2.16/src/B/PaxHeaders/ffcb1.F0000644000000000000000000000007411776502522014526 xustar0030 atime=1648161785.727698497 30 ctime=1648161793.715764879 LoopTools-2.16/src/B/ffcb1.F0000644000000000000000000002142111776502522015441 0ustar00rootroot00000000000000#include "externals.h" #include "types.h" *###[ ffcb1: subroutine ffcb1(cb1,cb0,ca0i,xp,xm1,xm2,piDpj,ier) ***#[*comment:*********************************************************** * * * Calculate 1 / d^n Q Q(mu) * * ------ | ------------------------ = B1*p(mu) * * i pi^2 / (Q^2-m1^2)((Q+p)^2-m2^2) * * * * Input: cb0 complex scalar twopoint function * * ca0i(2) complex scalar onepoint function with * * m1,m2 * * xp complex p.p in B&D metric * * xm1,2 complex m_1^2,m_2^2 * * piDpj(3,3) complex dotproducts between s1,s2,p * * ier integer digits lost so far * * Output: cb1 complex B1 * * ier integer digits lost * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments * integer ier ComplexType xp,xm1,xm2,piDpj(3,3) ComplexType cb1,cb0,ca0i(2) * * local variables * integer ier0,i,j ComplexType dm1p,dm2p,dm1m2 RealType rm1,rm2,rp,rpiDpj(3,3),sprec * * common blocks * #include "ff.h" * * #] declarations: * #[ real case: if ( Im(xm1).eq.0 .and. Im(xm2).eq.0 ) then rm1 = Re(xm1) rm2 = Re(xm2) rp = Re(xp) do 20 j=1,3 do 10 i=1,3 rpiDpj(i,j) = Re(piDpj(i,j)) 10 continue 20 continue sprec = precx precx = precc call ffxb1(cb1,cb0,ca0i,rp,rm1,rm2,rpiDpj,ier) precx = sprec return endif * #] real case: * #[ get differences: ier0 = 0 dm1m2 = xm1 - xm2 dm1p = xm1 - xp dm2p = xm2 - xp * #] get differences: * #[ call ffcb1a: call ffcb1a(cb1,cb0,ca0i,xp,xm1,xm2,dm1p,dm2p,dm1m2,piDpj,ier) * #] call ffcb1a: *###] ffcb1: end *###[ ffcb1a: subroutine ffcb1a(cb1,cb0,ca0i,xp,xm1,xm2,dm1p,dm2p,dm1m2,piDpj, + ier) ***#[*comment:*********************************************************** * * * Calculate 1 / d^n Q Q(mu) * * ------ | ------------------------ = B1*p(mu) * * i pi^2 / (Q^2-m1^2)((Q+p)^2-m2^2) * * * * Input: cb0 complex scalar twopoint function * * ca0i(2) complex scalar onepoint function with * * m1,m2 * * xp complex p.p in B&D metric * * xm1,2 complex m_1^2,m_2^2 * * piDpj(3,3) complex dotproducts between s1,s2,p * * ier integer digits lost so far * * Output: cb1 complex B1 * * ier integer digits lost * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments * integer ier ComplexType xp,xm1,xm2,dm1p,dm2p,dm1m2,piDpj(3,3) ComplexType cb1,cb0,ca0i(2) * * local variables * integer i,j,ithres,init logical lneg,lreal RealType xmax,absc,bnd101,bnd105,bnd110,bnd115,ax,cprec, + xprec,xmxp ComplexType s,s1,h,slam,xma,xmb,x,small,dmbma,clam,clogm, + ts2Dp,xlo3,xlogm,cqiqj(3,3),cqi(3) ComplexType cs(5),cc,csom RealType ffbnd ComplexType zfflo1,zfflo3 RealType rm1,rm2,rp,rm1m2,rm1p,rm2p,rpiDpj(3,3),sprec save cprec,bnd101,bnd105,bnd110,bnd115,init *FOR ABSOFT ONLY * ComplexType csqrt * external csqrt * * common blocks * #include "ff.h" * * statement function * absc(cc) = abs(Re(cc)) + abs(Im(cc)) * * data * data cprec /0./ * * #] declarations: * #[ the real cases: * if ( Im(xm1) .eq. 0 .and. Im(xm2) .eq. 0 ) then lreal = .TRUE. elseif ( nschem.le.4 ) then lreal = .TRUE. if ( init.eq.0 ) then init = 1 print *,'ffcb1a: nschem <= 4, ignoring complex masses:', + nschem endif elseif ( nschem.le.6 ) then if ( init.eq.0 ) then init = 1 print *,'ffcb1a: nschem = 5,6 complex masses near ', + 'threshold: ',nschem endif cqi(1) = xm1 cqi(2) = xm2 cqi(3) = xp cqiqj(1,2) = dm1m2 cqiqj(2,1) = -cqiqj(1,2) cqiqj(1,3) = dm1p cqiqj(3,1) = -cqiqj(1,3) cqiqj(2,3) = dm2p cqiqj(3,2) = -cqiqj(2,3) cqiqj(1,1) = 0 cqiqj(2,2) = 0 cqiqj(3,3) = 0 call ffthre(ithres,cqi,cqiqj,3,1,2,3) if ( ithres.eq.0 .or. ithres.eq.1 .and. nschem.eq.5 ) then lreal = .TRUE. else lreal = .FALSE. endif else lreal = .FALSE. endif if ( lreal ) then rm1 = Re(xm1) rm2 = Re(xm2) rp = Re(xp) rm1p = Re(dm1p) rm2p = Re(dm2p) rm1m2 = Re(dm1m2) do 20 j=1,3 do 10 i=1,3 rpiDpj(i,j) = Re(piDpj(i,j)) 10 continue 20 continue sprec = precx precx = precc call ffxb1a(cb1,cb0,ca0i,rp,rm1,rm2,rm1m2,rpiDpj,ier) precx = sprec return endif * #] the real cases: * #[ p^2 != 0: if ( Re(xp) .ne. 0 ) then * #[ normal case: if ( dm1m2 .ne. 0 ) then cs(1) = -ca0i(2) cs(2) = +ca0i(1) else cs(1) = 0 cs(2) = 0 endif cs(3) = +2*piDpj(1,3)*cb0 cb1 = cs(1) + cs(2) + cs(3) xmax = max(absc(cs(2)),absc(cs(3))) if ( absc(cb1) .ge. xloss*xmax ) goto 110 * #] normal case: * #[ almost equal masses: if ( absc(dm1m2) .le. xloss*absc(xm1) ) then cs(2) = dm1m2/xm1*cs(2) cs(1) = -xm2*zfflo1(-dm1m2/xm2,ier) cb1 = cs(1) + cs(2) + cs(3) xmax = max(absc(cs(2)),absc(cs(3))) if ( absc(cb1) .ge. xloss*xmax ) goto 110 * for the perfectionist (not me (today)): * if d0=0 and mu~m1(~m2), then the terms of order * (m1^2-m2^2) also cancel. To patch this I need d0 and mu endif * #] almost equal masses: * #[ p2 -> 0: if ( xloss**2*max(absc(xm1),absc(xm2)) .gt. absc(xp) ) then if ( Re(xm2).gt.Re(xm1) ) then xma = xm1 xmb = xm2 dmbma = -dm1m2 ts2Dp = +2*piDpj(2,3) lneg = .FALSE. else xma = xm2 xmb = xm1 dmbma = +dm1m2 ts2Dp = -2*piDpj(1,3) lneg = .TRUE. endif else goto 100 endif * * We found a situation in which p2 is much smaller than * the masses. * if ( xma.eq.0 ) then clogm = 1 elseif ( absc(dmbma) .gt. xloss*absc(xmb) ) then clogm = log(xmb/xma) else clogm = zfflo1(-dmbma/xma,ier) endif clam = (dmbma-xp)**2 - 4*xma*xp slam = sqrt(clam) small = xp*(-2*(xma+xmb) + xp)/(slam+dmbma) cs(1) = clogm*xma*(4*xmb*(small-xp) + (small-xp)**2)/(2* + (slam+dmbma)*(slam+2*piDpj(1,2))) if ( cprec.ne.precc ) then cprec = precc xprec = precx precx = precc bnd101 = ffbnd(2,1,xinfac) bnd105 = ffbnd(2,5,xinfac) bnd110 = ffbnd(2,10,xinfac) bnd115 = ffbnd(2,15,xinfac) precx = xprec endif x = xp/slam ax = absc(x) if ( ax.gt.bnd110 ) then s = x*(Re(xinfac(12)) + x*(Re(xinfac(13)) + + x*(Re(xinfac(14)) + x*(Re(xinfac(15)) + + x*(Re(xinfac(16)) ))))) else s = 0 endif if ( ax.gt.bnd105 ) then s = x*(Re(xinfac(7)) + x*(Re(xinfac(8)) + + x*(Re(xinfac(9)) + x*(Re(xinfac(10)) + + x*(Re(xinfac(11) + s) ))))) endif if ( ax.gt.bnd101) then s = x*(Re(xinfac(3)) + x*(Re(xinfac(4)) + + x*(Re(xinfac(5)) + x*(Re(xinfac(6)) + s)))) endif s = x**2*(.5D0 + s) s1 = 2*xp/(ts2Dp + slam)*(s + x) h = -4*xp**2*xmb/(slam*(slam+ts2Dp)**2) - s + s1 if ( absc(h) .lt. .1 ) then cs(2) = dmbma*slam/xp*zfflo1(h,ier) else print *,'ffcb1: warning: I thought this was small: ',h print *,' cp,cma,cmb = ',xp,xma,xmb cs(2) = dmbma*slam/xp*log(1-h) *** goto 100 endif if ( lneg ) then cs(1) = -cs(1) cs(2) = -cs(2) endif cs(3) = -xp*cb0 cb1 = cs(1) + cs(2) + cs(3) xmax = max(absc(cs(2)),absc(cs(3))) if ( absc(cb1) .gt. xloss*xmax) goto 110 * #] p2 -> 0: * #[ give up: * * give up... * 100 continue 110 continue * #] give up: cb1 = cb1/(2*xp) * #] p^2 != 0: * #[ p^2=0, m1 != m2: elseif ( dm1m2 .ne. 0 ) then cs(1) = +xm2/(2*dm1m2**2)*(ca0i(2)+xm2/2) cs(2) = -xm1/(2*dm1m2**2)*(ca0i(1)+xm1/2) cs(3) = +ca0i(2)/dm1m2 cb1 = cs(1) + cs(2) + cs(3) xmax = max(absc(cs(1)),absc(cs(2)),absc(cs(3))) if ( absc(cb1).ge.xloss**2*xmax ) goto 120 * * m1 ~ m2, see b21.frm * if ( absc(dm1m2).lt.xloss*absc(xm1) ) then xlogm = zfflo1(dm1m2/xm1,ier) else xlogm = log(xm2/xm1) endif cs(1) = -(xm1/dm1m2)/2 cs(2) = -xlogm/2*(xm1/dm1m2)**2 cs(3) = +1/Re(4) - ca0i(1)/(2*xm1) cs(4) = xlogm/2 csom = cs(1) + cs(2) + cs(3) + cs(4) xmxp = max(absc(cs(2)),absc(cs(3)),absc(cs(4))) if ( xmxp.lt.xmax ) then xmax = xmxp cb1 = csom if ( absc(cb1).gt.xloss**2*xmax ) goto 120 endif * * better * xlo3 = zfflo3(dm1m2/xm1,ier) cs(1) = -(dm1m2/xm1)**2/4 cs(2) = -(dm1m2/xm1)/2 cs(3) = -xlo3/(dm1m2/xm1)**2/2 cs(4) = xlo3/2 cs(5) = 1/Re(2) - ca0i(1)/(2*xm1) csom = cs(1) + cs(2) + cs(3) + cs(4) + cs(5) xmxp = max(absc(cs(2)),absc(cs(3)),absc(cs(4)),absc(cs(5))) if ( xmxp.lt.xmax ) then xmax = xmxp cb1 = csom if ( absc(cb1).gt.xloss**2*xmax ) goto 120 endif * * give up * 120 continue * #] p^2=0, m1 != m2: * #[ p^2=0, m1 == m2: else cb1 = -cb0/2 endif * #] p^2=0, m1 == m2: *###] ffcb1a: end LoopTools-2.16/src/B/PaxHeaders/BcoeffFF.F0000644000000000000000000000007413262342545015144 xustar0030 atime=1648161785.727698497 30 ctime=1648161793.715764879 LoopTools-2.16/src/B/BcoeffFF.F0000644000000000000000000000454213262342545016064 0ustar00rootroot00000000000000* BcoeffFF.F * the two-point tensor coefficients from FF * this file is part of LoopTools * last modified 8 Apr 18 th #include "externals.h" #include "types.h" #define npoint 2 #include "defs.h" subroutine XBcoeffFF(B, para, ier) implicit none ComplexType B(*) ArgType para(1,*) integer ier(*) #include "lt.h" ArgType p, m1, m2, dm ComplexType a0(2), b2(2), pdb0 integer i #ifdef COMPLEXPARA ArgType m1dm ComplexType dmp, d2mp #endif m1 = M(1) m2 = M(2) p = P(1) do i = 1, Nbb ier(i) = 0 enddo ldot = .TRUE. i = 0 call Xffb0(B(bb0), p, m1, m2, i) ier(bb0) = i call Xffa0(a0(1), m1, i) call Xffa0(a0(2), m2, i) ier(bb1) = i call Xffb1(B(bb1), B(bb0), a0, p, m1, m2, Xfpij2, ier(bb1)) call Xffb2p(b2, B(bb1), B(bb0), a0, p, m1, m2, Xfpij2, i) ier(bb00) = i ier(bb11) = i B(bb11) = b2(1) B(bb00) = b2(2) ldot = .FALSE. dm = m1 - m2 if( abs(p) .lt. diffeps ) then if( abs(dm) .lt. diffeps ) then B(bb001) = -.5D0*B(bb00) else B(bb001) = -( ((m1 + m2)/6D0)**2 + & m1*m2/6D0 * (B(bb0) + 1/3D0) + & (dm - m2)/3D0 * B(bb00) )/dm endif else B(bb001) = .125D0*( 2*m1*B(bb1) - a0(2) + & (p + dm)*(B(bb11) + 1/6D0) - .5D0*(m1 + m2) ) endif call Xffdb0(B(dbb0), pdb0, p, m1, m2, ier(dbb0)) #ifdef COMPLEXPARA if( abs(p) .lt. diffeps ) then if( abs(dm) .lt. diffeps ) then B(bb111) = -.25D0*B(bb0) B(dbb1) = -1/12D0/m1 else m1dm = m1/dm B(bb111)= 3/16D0 + .25D0*a0(2)/dm*(m1dm + 1) + & .5D0*m1dm*(m1dm*(B(bb1) - .5D0) - 1/6D0) B(dbb1) = (2*m2*B(bb1) + a0(2) - (m1 + 2*m2)/3D0)/dm**2 endif else B(bb111) = -.25D0*( a0(2) + 2*m1*B(bb1) + & (p + dm)*(3*B(bb11) + 1/6D0) - .5D0*(m1 + m2) )/p B(dbb1) = .5D0/p*( & (a0(2) - a0(1) + dm*B(bb0))/p - & (p + dm)*B(dbb0) ) endif dmp = (m1 - m2)/p d2mp = (m1 - 2*m2)/p B(dbb11) = 1/3D0*( & ( (.5D0*(m1 + m2) + & (2*dmp + 1)*a0(1) - (2*dmp + 2)*a0(2))/p - & (d2mp + 2*dmp**2)*B(bb0) )/p + & (d2mp + dmp**2 + 1)*B(dbb0) ) #else call ffxb111(B(bb111), p, m1, m2, ier(bb111)) call ffxdb1(B(dbb1), p, m1, m2, ier(dbb1)) call ffxdb11(B(dbb11), p, m1, m2, ier(dbb11)) #endif B(dbb00) = 1/6D0*( 2*m1*B(dbb0) + B(bb1) + & (p + dm)*B(dbb1) - 1/3D0 ) B(dbb001) = 1/8D0*( 2*m1*B(dbb1) + B(bb11) + & (p + dm)*B(dbb11) + 1/6D0 ) end LoopTools-2.16/src/B/PaxHeaders/ffxb1.F0000644000000000000000000000007411776502522014553 xustar0030 atime=1648161785.727698497 30 ctime=1648161793.715764879 LoopTools-2.16/src/B/ffxb1.F0000644000000000000000000001550111776502522015470 0ustar00rootroot00000000000000#include "externals.h" #include "types.h" *###[ ffxb1: subroutine ffxb1(cb1,cb0,ca0i,xp,xm1,xm2,piDpj,ier) ***#[*comment:*********************************************************** * * * Calculate 1 / d^n Q Q(mu) * * ------ | ------------------------ = B1*p(mu) * * i pi^2 / (Q^2-m1^2)((Q+p)^2-m2^2) * * * * Input: cb0 complex scalar twopoint function * * ca0i(2) complex scalar onepoint function with * * m1,m2 * * xp real p.p in B&D metric * * xm1,2 real m_1^2,m_2^2 * * piDpj(3,3) real dotproducts between s1,s2,p * * ier integer digits lost so far * * Output: cb1 complex B1 * * ier integer digits lost * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments * integer ier RealType xp,xm1,xm2,piDpj(3,3) ComplexType cb1,cb0,ca0i(2) * * local variables * RealType dm1m2 * * common blocks * #include "ff.h" * * #] declarations: * #[ get differences: dm1m2 = xm1 - xm2 * #] get differences: * #[ call ffxb1a: call ffxb1a(cb1,cb0,ca0i,xp,xm1,xm2,dm1m2,piDpj,ier) * #] call ffxb1a: *###] ffxb1: end *###[ ffxb1a: subroutine ffxb1a(cb1,cb0,ca0i,xp,xm1,xm2,dm1m2,piDpj,ier) ***#[*comment:*********************************************************** * * * Calculate 1 / d^n Q Q(mu) * * ------ | ------------------------ = B1*p(mu) * * i pi^2 / (Q^2-m1^2)((Q+p)^2-m2^2) * * * * Input: cb0 complex scalar twopoint function * * ca0i(2) complex scalar onepoint function with * * m1,m2 * * xp real p.p in B&D metric * * xm1,2 real m_1^2,m_2^2 * * piDpj(3,3) real dotproducts between s1,s2,p * * ier integer digits lost so far * * Output: cb1 complex B1 * * ier integer digits lost * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments * integer ier RealType xp,xm1,xm2,dm1m2,piDpj(3,3) ComplexType cb1,cb0,ca0i(2) * * local variables * logical lneg RealType xmax,absc,s,s1,h,slam,bnd101,bnd105,bnd110, + xma,xmb,x,ax,xlogm,small,dmbma,xprec,xlam,ts2Dp, + xmxp,xlo3,dfflo3 ComplexType cs(5),cc,csom RealType ffbnd,dfflo1 external ffbnd,dfflo1,dfflo3 save xprec,bnd101,bnd105,bnd110 * * common blocks * #include "ff.h" * * statement function * absc(cc) = abs(Re(cc)) + abs(Im(cc)) * * data * data xprec /0D0/ * * #] declarations: * #[ p^2 != 0: if ( xp .ne. 0 ) then * #[ normal case: if ( dm1m2 .ne. 0 ) then cs(1) = -ca0i(2) cs(2) = +ca0i(1) else cs(1) = 0 cs(2) = 0 endif cs(3) = +Re(2*piDpj(1,3))*cb0 cb1 = cs(1) + cs(2) + cs(3) xmax = max(absc(cs(2)),absc(cs(3))) if ( absc(cb1) .ge. xloss*xmax ) goto 110 * #] normal case: * #[ almost equal masses: if ( abs(dm1m2) .le. xloss*xm1 ) then cs(2) = Re(dm1m2/xm1)*cs(2) cs(1) = -xm2*dfflo1(-dm1m2/xm2,ier) cb1 = cs(1) + cs(2) + cs(3) xmax = max(absc(cs(2)),absc(cs(3))) if ( absc(cb1) .ge. xloss*xmax ) goto 110 * for the perfectionist (not me (today)): * if d0=0 and mu~m1(~m2), then the terms of order * (m1^2-m2^2) also cancel. To patch this I need d0 and mu endif * #] almost equal masses: * #[ p2 -> 0: if ( xloss**2*max(xm1,xm2) .gt. abs(xp) ) then if ( xm2.gt.xm1 ) then xma = xm1 xmb = xm2 ts2Dp = +2*piDpj(2,3) lneg = .FALSE. else xma = xm2 xmb = xm1 ts2Dp = -2*piDpj(1,3) lneg = .TRUE. endif else goto 100 endif * * We found a situation in which p2 is much smaller than * the masses. * dmbma = abs(dm1m2) if ( xma.eq.0 ) then xlogm = 1 elseif ( dmbma .gt. xloss*xmb ) then xlogm = log(xmb/xma) else xlogm = dfflo1(-dmbma/xma,ier) endif xlam = (dmbma-xp)**2 - 4*xma*xp if ( xlam.gt.0 ) then * #[ real roots: slam = sqrt(xlam) small = xp*(-2*(xma+xmb) + xp)/(slam+dmbma) h = slam+2*piDpj(1,2) cs(1) = xlogm*xma*(4*xmb*(small-xp) + (small-xp)**2)/(2* + (slam+dmbma)*h) if ( xprec.ne.precx ) then xprec = precx bnd101 = ffbnd(2,1,xinfac) bnd105 = ffbnd(2,5,xinfac) bnd110 = ffbnd(2,10,xinfac) endif x = xp/slam ax = abs(x) if ( ax.gt.bnd110 ) then s = x*(xinfac(12) + x*(xinfac(13) + x*(xinfac(14) + + x*(xinfac(15) + x*xinfac(16) )))) else s = 0 endif if ( ax.gt.bnd105 ) then s = x*(xinfac(7) + x*(xinfac(8) + x*(xinfac(9) + + x*(xinfac(10) + x*(xinfac(11) + s ))))) endif if ( ax.gt.bnd101) then s = x*(xinfac(3) + x*(xinfac(4) + x*(xinfac(5) + + x*(xinfac(6) + s )))) endif s = x**2*(.5D0 + s) h = ts2Dp + slam s1 = 2*xp/h*(s + x) h = -4*xp**2*xmb/(slam*h**2) - s + s1 if ( abs(h) .lt. .1 ) then cs(2) = dmbma*slam/xp*dfflo1(h,ier) else goto 100 endif if ( lneg ) then cs(1) = -cs(1) cs(2) = -cs(2) endif cs(3) = -Re(xp)*cb0 cb1 = cs(1) + cs(2) + cs(3) xmax = max(absc(cs(2)),absc(cs(3))) if ( absc(cb1) .gt. xloss*xmax) goto 110 * * this still occurs in the case xp << dmamb << xma, * with a cancellation of order dmamb/xma between cs1 and * cs2; as the standard model does not contain these kind * of doublets I leave this as an exercise for the * reader... * * #] real roots: else * #[ imaginary roots: * #] imaginary roots: endif * #] p2 -> 0: * #[ give up: * * give up... * 100 continue 110 continue * #] give up: cb1 = cb1*(1/Re(2*xp)) * #] p^2 != 0: * #[ p^2=0, m1 != m2: elseif ( dm1m2 .ne. 0 ) then cs(1) = +Re(xm2/(2*dm1m2**2))*(ca0i(2)+Re(xm2)/2) cs(2) = -Re(xm1/(2*dm1m2**2))*(ca0i(1)+Re(xm1)/2) cs(3) = +ca0i(2)*(1/Re(dm1m2)) cb1 = cs(1) + cs(2) + cs(3) xmax = max(absc(cs(1)),absc(cs(2)),absc(cs(3))) if ( absc(cb1).ge.xloss**2*xmax ) goto 120 * * m1 ~ m2, see b21.frm * if ( abs(dm1m2).lt.xloss*xm1 ) then xlogm = dfflo1(dm1m2/xm1,ier) else xlogm = log(xm2/xm1) endif cs(1) = -(xm1/dm1m2)/2 cs(2) = -xlogm/2*(xm1/dm1m2)**2 cs(3) = +1/Re(4) - ca0i(1)*Re(1/(2*xm1)) cs(4) = xlogm/2 csom = cs(1) + cs(2) + cs(3) + cs(4) xmxp = max(absc(cs(2)),absc(cs(3)),absc(cs(4))) if ( xmxp.lt.xmax ) then xmax = xmxp cb1 = csom if ( absc(cb1).gt.xloss**2*xmax ) goto 120 endif * * better * xlo3 = dfflo3(dm1m2/xm1,ier) cs(1) = -(dm1m2/xm1)**2/4 cs(2) = -(dm1m2/xm1)/2 cs(3) = -xlo3/(dm1m2/xm1)**2/2 cs(4) = xlo3/2 cs(5) = 1/Re(2) - ca0i(1)*Re(1/(2*xm1)) csom = cs(1) + cs(2) + cs(3) + cs(4) + cs(5) xmxp = max(absc(cs(2)),absc(cs(3)),absc(cs(4)),absc(cs(5))) if ( xmxp.lt.xmax ) then xmax = xmxp cb1 = csom if ( absc(cb1).gt.xloss**2*xmax ) goto 120 endif * * give up * 120 continue * #] p^2=0, m1 != m2: * #[ p^2=0, m1 == m2: else cb1 = -cb0/2 endif * #] p^2=0, m1 == m2: *###] ffxb1a: end LoopTools-2.16/src/PaxHeaders/include0000644000000000000000000000013214217172001014602 xustar0030 mtime=1648161793.715764879 30 atime=1648161793.715764879 30 ctime=1648161793.715764879 LoopTools-2.16/src/include/0000755000000000000000000000000014217172001015577 5ustar00rootroot00000000000000LoopTools-2.16/src/include/PaxHeaders/ff.h0000644000000000000000000000007412401070772015435 xustar0030 atime=1648161785.727698497 30 ctime=1648161793.715764879 LoopTools-2.16/src/include/ff.h0000644000000000000000000001553112401070772016355 0ustar00rootroot00000000000000* $Id: ff.h,v 1.1 1995/12/12 10:03:48 gj Exp $ * ------------------------------------------------------------- * INCLUDE FILE FOR THE FF ROUTINES. * Geert Jan van Oldenborgh. * ------------------------------------------------------------- * please do not change, and recompile _everything_ when you do. * ------------------------------------------------------------- * * this parameter determines how far the scalar npoint functions * will look back to find the same parameters (when lmem is true) * integer memory parameter (memory = 12) * * if .TRUE. then default (ffinit) * l4also: in C0 (and higher), also consider the algorithm with 16 * dilogs .TRUE. * ldc3c4: in D0 (and higher), also consider possible cancellations * between the C0s .TRUE. * lmem: before computing the C0 and higher, first check whether * it has already been done recently .FALSE. * ldot: leave the dotproducts and some determinants in common * .FALSE. * onshel: (in ffz?0 only): use onshell momenta .TRUE. * lsmug: internal use * lnasty: internal use * logical l4also,ldc3c4,lmem,ldot,onshel,lsmug,lnasty * * nwidth: number of widths within which the complex mass is used * nschem: scheme to handle the complex mass (see ffinit.f) * idot: internal flags to signal that some of the dotproducts * are input: 0: none; 1: external pi.pj, 2: external + * kinematical determinant, 3: all dotproducts + kindet. * integer nwidth,nschem,idot * * xloss: factor that the final result of a subtraction can be * smaller than the terms without warning (default 1/8) * precx: precision of real numbers, determined at runtime by * ffinit (IEEE: 4.e-16) * precc: same for complex numbers * xalogm: smallest real number of which a log can be taken, * determined at runtime by ffinit (IEEE: 2.e-308) * xclogm: same for complex. * xalog2: xalogm**2 * xclog2: xclogm**2 * reqprc: not used * pi: pi * pi6: pi**2/6 * pi12: pi**2/12 * xlg2: log(2) * bf: factors in the expansion of dilog (~Bernouilli numbers) * xninv: 1/n * xn2inv: 1/n**2 * xinfac: 1/n! * fpij2: vi.vj for 2point function 1-2: si, 3-3: pi * fpij3: vi.vj for 3point function 1-3: si, 4-6: pi * fpij4: vi.vj for 4point function 1-4: si, 5-10: pi * fpij5: vi.vj for 5point function 1-5: si, 6-15: pi * fpij6: vi.vj for 6point function 1-6: si, 7-21: pi * fdel2: del2 = delta_(p1,p2)^(p1,p2) = p1^2.p2^2 - p1.p2^2 in C0 * fdel3: del3 = delta_(p1,p2,p3)^(p1,p2,p3) in D0 * fdel4s: del4s = delta_(s1,s2,s3,s4)^(s1,s2,s3,s4) in D0 * fdel4: del4 = delta_(p1,p2,p3,p4)^(p1,p2,p3,p4) in E0 * fdl3i: del3i = delta_(pj,pk,pl)^(pj,pk,pl) in E0, D0 without si * fdl4si: dl4si = del4s in E0, D0 without si * fdl3ij: same in F0 without si and sj. * fd4sij: dl4si = del4s in E0, D0 without si * fdl4i: delta4 in F0 without si. * fodel2: same offshell (in case of complex or z-functions) * fodel3: -''- * cfdl4s: -''- * fodel4: -''- * fodl3i: -''- * fod3ij: -''- * fodl4i: -''- * fidel3: ier of del3 (is not included in D0) * fidel4: ier of del4 (is not included in E0) * fidl3i: ier of dl3i (is not included in E0) * fid3ij: ier of dl3ij (is not included in F0) * fidl4i: ier of dl4i (is not included in F0) * RealType xloss,precx,precc,xalogm,xclogm,xalog2,xclog2, & reqprc,pi,pi6,pi12,xlg2,sqrt2,bf(20), & xninv(30),xn2inv(30),xinfac(30), & fpij2(3,3),fpij3(6,6),fpij4(10,10),fpij5(15,15), & fpij6(21,21),fdel2,fdel3,fdel4s,fdel4,fdl3i(5), & fdl4si(5),fdl3ij(6,6),fd4sij(6,6),fdl4i(6),fodel2, & fodel3,fodel4,fodl3i(5),fod3ij(6,6),fodl4i(6) integer fidel3,fidel4,fidl3i(5),fid3ij(6,6),fidl4i(6) * * cI: imaginary unit * c[zero1]:0,1 complex * c2ipi: 2*i*pi * cipi2: i*pi**2 * cfp..: complex version of fp..., only defined in ff[cz]* * cmipj: (internal only) mi^2 - pj^2 in C0 * c2sisj: (internal only) 2*si.sj in D0 * cfdl4s: del4s in complex case (D0) * ca1: (internal only) complex A1 * csdl2p: (internal only) complex transformed sqrt(del2) * ComplexType cI,czero,chalf,cone,c2ipi,cipi2, & cfpij2(3,3),cfpij3(6,6),cfpij4(10,10),cfpij5(15,15), & cfpij6(21,21),cmipj(3,3),c2sisj(4,4),cfdl4s,ca1 * * nevent: number in integration loop (to be updated by user) * ner: can be used to signal numerical problems (see ffrcvr) * id: identifier of scalar function (to be set by user) * idsub: internal identifier to pinpoint errors * inx: in D0: p(inx(i,j)) = isgn(i,j)*(s(i)-s(j)) * inx5: in E0: p(inx5(i,j)) = isgn5(i,j)*(s(i)-s(j)) * inx6: in F0: p(inx6(i,j)) = isgn6(i,j)*(s(i)-s(j)) * isgn: see inx * isgn5: see inx5 * isgn6: see inx6 * iold: rotation matrix for 4point function * isgrot: signs to iold * isgn34: +1 or -1: which root to choose in the transformation (D0) * isgnal: +1 or -1: which root to choose in the alpha-trick (C0) * irota3: save the number of positions the C0 configuration has been * rotated over * irota4: same for the D0 * irota5: same for the E0 * irota6: same for the F0 * integer nevent,ner,id,idsub,inx(4,4),isgn(4,4),inx5(5,5), & isgn5(5,5),inx6(6,6),isgn6(6,6),isgn34,isgnal,iold(13, & 12),isgrot(10,12),irota3,irota4,irota5,irota6 integer idum93(2) * ComplexType cIeps * * parameters * parameter( & cI = (0D0, 1D0), & czero = (0D0,0D0), & chalf = (.5D0,0D0), & cone = (1D0,0D0), & c2ipi = (0D0,6.28318530717958647692528676655896D0), & cipi2 = (0D0,9.869604401089358618834490999876D0), & pi = 3.14159265358979323846264338327948D0, & pi6 = 1.644934066848226436472415166646D0, & pi12 = .822467033424113218236207583323D0, & xlg2 = .6931471805599453094172321214581D0, & sqrt2 = 1.4142135623730950488016887242096981D0, & cIeps = (0D0,1D-50) ) * * common * common /ffsign/isgn34,isgnal common /ffprec/ xloss,precx,precc,xalogm,xclogm,xalog2,xclog2, & reqprc common /ffflag/ l4also,ldc3c4,lmem,ldot, & nevent,ner,id,idsub,nwidth,nschem,onshel,idot common /ffcnst/ bf,xninv,xn2inv,xinfac,inx,isgn,iold,isgrot, & inx5,isgn5,inx6,isgn6 common /ffrota/ irota3,irota4,irota5,irota6 common /ffdot/ fpij2,fpij3,fpij4,fpij5,fpij6 common /ffdel/ fdel2,fdel3,fdel4s,fdel4,fdl3i,fdl4si,fdl3ij, & fd4sij,fdl4i common /ffidel/ fidel3,fidel4,fidl3i,fid3ij,fidl4i common /ffcdot/ cfpij2,cfpij3,cfpij4,cfpij5,cfpij6 common /ffcdel/ fodel2,fodel3,cfdl4s,fodel4,fodl3i,fod3ij,fodl4i common /ffsmug/ lsmug,lnasty,idum93,cmipj,c2sisj,ca1 * * regularization parameters * ComplexType mudimc RealType delta, uvdiv, lambda, minmass RealType diffeps, zeroeps common /ltregul/ mudimc, delta, uvdiv, lambda, minmass, & diffeps, zeroeps RealType mudim equivalence (mudimc, mudim) * * nan is used for undefined values and is supposed to * "poison" a result, much as the IEEE NaN, which is just * too unportable in Fortran * ComplexType nan parameter (nan = (1D123, 1D123)) LoopTools-2.16/src/include/PaxHeaders/types.h0000644000000000000000000000007413262707342016214 xustar0030 atime=1648161785.727698497 30 ctime=1648161793.715764879 LoopTools-2.16/src/include/types.h0000644000000000000000000000112213262707342017123 0ustar00rootroot00000000000000* types.h * real-based type declarations * this file is part of LoopTools * last modified 9 Apr 18 th #ifndef TYPES_H #define TYPES_H #define RealType double precision #define ComplexType double complex #define Re DBLE #define Im DIMAG #define Conjugate DCONJG #define ToComplex DCMPLX #if QUADSIZE == 16 #define RealQuad real*16 #define ComplexQuad complex*32 #elif QUADSIZE == 10 #define RealQuad real*10 #define ComplexQuad complex*20 #else #define RealQuad RealType #define ComplexQuad ComplexType #endif #define Sq(c) Re((c)*Conjugate(c)) #define Sqrtc(c) sqrt(ToComplex(c)) #endif LoopTools-2.16/src/include/PaxHeaders/perm.h0000644000000000000000000000007411776502523016015 xustar0030 atime=1648161785.727698497 30 ctime=1648161793.715764879 LoopTools-2.16/src/include/perm.h0000644000000000000000000000314311776502523016731 0ustar00rootroot00000000000000* perm.h * equivalent permutations for C and D functions * this file is part of LoopTools * last modified 9 Mar 11 th * C-permutations integer p123, p231, p312 parameter (p123 = 83) ! O'123' parameter (p231 = 153) ! O'231' parameter (p312 = 202) ! O'312' * D-permutations integer p1234, p1243, p2134, p2143, p1324, p1342 integer p3124, p3142, p1423, p1432, p4123, p4132 integer p2314, p2341, p3214, p3241, p2413, p2431 integer p4213, p4231, p3412, p3421, p4312, p4321 parameter (p1234 = 175301276) ! O'123456 1234' parameter (p1243 = 242623139) ! O'163542 1243' parameter (p2134 = 226051164) ! O'153624 2134' parameter (p2143 = 208360547) ! O'143265 2143' parameter (p1324 = 718320340) ! O'526413 1324' parameter (p1342 = 734405346) ! O'536142 1342' parameter (p3124 = 701318740) ! O'516324 3124' parameter (p3142 = 751408738) ! O'546231 3142' parameter (p1423 = 643085075) ! O'462513 1423' parameter (p1432 = 591848218) ! O'432156 1432' parameter (p4123 = 558848083) ! O'412365 4123' parameter (p4132 = 626628698) ! O'452631 4132' parameter (p2314 = 362329292) ! O'254613 2314' parameter (p2341 = 327636193) ! O'234165 2341' parameter (p3214 = 294577804) ! O'214356 3214' parameter (p3241 = 378902177) ! O'264531 3241' parameter (p2413 = 883471627) ! O'645213 2413' parameter (p2431 = 866469145) ! O'635124 2431' parameter (p4213 = 833497227) ! O'615342 4213' parameter (p4231 = 850499737) ! O'625431 4231' parameter (p3412 = 472573706) ! O'341256 3412' parameter (p3421 = 506808081) ! O'361524 3421' parameter (p4312 = 490350794) ! O'351642 4312' parameter (p4321 = 439572689) ! O'321465 4321' LoopTools-2.16/src/include/PaxHeaders/ffperm5.h0000644000000000000000000000007411776502523016416 xustar0030 atime=1648161785.727698497 30 ctime=1648161793.715764879 LoopTools-2.16/src/include/ffperm5.h0000644000000000000000000004613211776502523017337 0ustar00rootroot00000000000000 data ((iperm(j1,j2),j1=1,5),j2=1,80) / + 1,2,3,4,5,1,2,3,4,9,1,2,3,10,4,1,2,3,4,13, + 1,2,3,15,4,1,2,3,8,5,1,2,3,5,9,1,2,3,12,5, + 1,2,3,5,14,1,2,3,8,9,1,2,3,10,8,1,2,3,8,13, + 1,2,3,15,8,1,2,3,9,10,1,2,3,12,9,1,2,3,13,9, + 1,2,3,9,14,1,2,3,9,15,1,2,3,10,12,1,2,3,14,10, + 1,2,3,12,13,1,2,3,15,12,1,2,3,13,14,1,2,3,14,15, + 1,2,4,5,7,1,2,4,8,5,1,2,4,5,11,1,2,4,13,5, + 1,2,4,9,7,1,2,4,7,10,1,2,4,13,7,1,2,4,7,15, + 1,2,4,8,9,1,2,4,10,8,1,2,4,8,13,1,2,4,15,8, + 1,2,4,9,11,1,2,4,13,9,1,2,4,11,10,1,2,4,10,13, + 1,2,4,13,11,1,2,4,11,15,1,2,4,15,13,1,2,5,7,8, + 1,2,5,9,7,1,2,5,7,12,1,2,5,14,7,1,2,5,8,9, + 1,2,5,11,8,1,2,5,12,8,1,2,5,8,13,1,2,5,8,14, + 1,2,5,9,11,1,2,5,13,9,1,2,5,11,12,1,2,5,14,11, + 1,2,5,12,13,1,2,5,13,14,1,2,7,8,9,1,2,7,10,8, + 1,2,7,8,13,1,2,7,15,8,1,2,7,9,10,1,2,7,12,9, + 1,2,7,13,9,1,2,7,9,14,1,2,7,9,15,1,2,7,10,12, + 1,2,7,14,10,1,2,7,12,13,1,2,7,15,12,1,2,7,13,14, + 1,2,7,14,15,1,2,8,10,9,1,2,8,9,11,1,2,8,9,12, + 1,2,8,14,9,1,2,8,15,9,1,2,8,11,10,1,2,8,12,10 / data ((iperm(j1,j2),j1=1,5),j2=81,160) / + 1,2,8,10,13,1,2,8,10,14,1,2,8,13,11,1,2,8,11,15, + 1,2,8,13,12,1,2,8,12,15,1,2,8,14,13,1,2,8,15,13, + 1,2,8,15,14,1,2,9,10,11,1,2,9,13,10,1,2,9,11,12, + 1,2,9,11,13,1,2,9,14,11,1,2,9,15,11,1,2,9,12,13, + 1,2,9,13,14,1,2,9,13,15,1,2,10,12,11,1,2,10,11,14, + 1,2,10,13,12,1,2,10,14,13,1,2,11,12,13,1,2,11,15,12, + 1,2,11,13,14,1,2,11,14,15,1,2,12,15,13,1,2,13,15,14, + 1,3,4,6,5,1,3,4,5,7,1,3,4,5,12,1,3,4,15,5, + 1,3,4,6,9,1,3,4,10,6,1,3,4,6,13,1,3,4,15,6, + 1,3,4,9,7,1,3,4,7,10,1,3,4,13,7,1,3,4,7,15, + 1,3,4,9,12,1,3,4,15,9,1,3,4,12,10,1,3,4,10,15, + 1,3,4,13,12,1,3,4,12,15,1,3,4,15,13,1,3,5,8,6, + 1,3,5,6,9,1,3,5,12,6,1,3,5,6,14,1,3,5,7,8, + 1,3,5,9,7,1,3,5,7,12,1,3,5,14,7,1,3,5,12,8, + 1,3,5,8,15,1,3,5,9,12,1,3,5,15,9,1,3,5,14,12, + 1,3,5,12,15,1,3,5,15,14,1,3,6,9,8,1,3,6,8,10, + 1,3,6,13,8,1,3,6,8,15,1,3,6,10,9,1,3,6,9,12, + 1,3,6,9,13,1,3,6,14,9,1,3,6,15,9,1,3,6,12,10, + 1,3,6,10,14,1,3,6,13,12,1,3,6,12,15,1,3,6,14,13, + 1,3,6,15,14,1,3,7,8,9,1,3,7,10,8,1,3,7,8,13 / data ((iperm(j1,j2),j1=1,5),j2=161,240) / + 1,3,7,15,8,1,3,7,9,10,1,3,7,12,9,1,3,7,13,9, + 1,3,7,9,14,1,3,7,9,15,1,3,7,10,12,1,3,7,14,10, + 1,3,7,12,13,1,3,7,15,12,1,3,7,13,14,1,3,7,14,15, + 1,3,8,9,12,1,3,8,15,9,1,3,8,12,10,1,3,8,10,15, + 1,3,8,13,12,1,3,8,12,15,1,3,8,15,13,1,3,9,10,12, + 1,3,9,15,10,1,3,9,12,13,1,3,9,14,12,1,3,9,13,15, + 1,3,9,15,14,1,3,10,12,14,1,3,10,15,12,1,3,10,14,15, + 1,3,12,13,14,1,3,12,15,13,1,3,12,14,15,1,3,13,15,14, + 1,4,5,6,7,1,4,5,8,6,1,4,5,6,11,1,4,5,13,6, + 1,4,5,7,8,1,4,5,11,7,1,4,5,7,12,1,4,5,7,13, + 1,4,5,15,7,1,4,5,12,8,1,4,5,8,15,1,4,5,11,12, + 1,4,5,15,11,1,4,5,12,13,1,4,5,13,15,1,4,6,7,9, + 1,4,6,10,7,1,4,6,7,13,1,4,6,15,7,1,4,6,9,8, + 1,4,6,8,10,1,4,6,13,8,1,4,6,8,15,1,4,6,11,9, + 1,4,6,9,13,1,4,6,10,11,1,4,6,13,10,1,4,6,11,13, + 1,4,6,15,11,1,4,6,13,15,1,4,7,8,9,1,4,7,10,8, + 1,4,7,8,13,1,4,7,15,8,1,4,7,9,11,1,4,7,12,9, + 1,4,7,13,9,1,4,7,9,15,1,4,7,11,10,1,4,7,10,12, + 1,4,7,10,13,1,4,7,15,10,1,4,7,13,11,1,4,7,11,15, + 1,4,7,12,13,1,4,7,15,12,1,4,8,9,12,1,4,8,15,9 / data ((iperm(j1,j2),j1=1,5),j2=241,320) / + 1,4,8,12,10,1,4,8,10,15,1,4,8,13,12,1,4,8,12,15, + 1,4,8,15,13,1,4,9,11,12,1,4,9,15,11,1,4,9,12,13, + 1,4,9,13,15,1,4,10,12,11,1,4,10,11,15,1,4,10,13,12, + 1,4,10,15,13,1,4,11,12,13,1,4,11,15,12,1,4,11,13,15, + 1,4,12,15,13,1,5,6,8,7,1,5,6,7,9,1,5,6,12,7, + 1,5,6,7,14,1,5,6,9,8,1,5,6,8,11,1,5,6,8,12, + 1,5,6,13,8,1,5,6,14,8,1,5,6,11,9,1,5,6,9,13, + 1,5,6,12,11,1,5,6,11,14,1,5,6,13,12,1,5,6,14,13, + 1,5,7,8,9,1,5,7,11,8,1,5,7,8,13,1,5,7,8,14, + 1,5,7,15,8,1,5,7,9,11,1,5,7,12,9,1,5,7,13,9, + 1,5,7,9,15,1,5,7,11,12,1,5,7,14,11,1,5,7,12,13, + 1,5,7,12,14,1,5,7,15,12,1,5,7,13,14,1,5,7,14,15, + 1,5,8,9,12,1,5,8,15,9,1,5,8,12,11,1,5,8,11,15, + 1,5,8,13,12,1,5,8,14,12,1,5,8,12,15,1,5,8,15,13, + 1,5,8,15,14,1,5,9,11,12,1,5,9,15,11,1,5,9,12,13, + 1,5,9,13,15,1,5,11,12,14,1,5,11,15,12,1,5,11,14,15, + 1,5,12,13,14,1,5,12,15,13,1,5,13,15,14,1,6,7,8,9, + 1,6,7,10,8,1,6,7,8,13,1,6,7,15,8,1,6,7,9,10, + 1,6,7,12,9,1,6,7,13,9,1,6,7,9,14,1,6,7,9,15, + 1,6,7,10,12,1,6,7,14,10,1,6,7,12,13,1,6,7,15,12 / data ((iperm(j1,j2),j1=1,5),j2=321,400) / + 1,6,7,13,14,1,6,7,14,15,1,6,8,10,9,1,6,8,9,11, + 1,6,8,9,12,1,6,8,14,9,1,6,8,15,9,1,6,8,11,10, + 1,6,8,12,10,1,6,8,10,13,1,6,8,10,14,1,6,8,13,11, + 1,6,8,11,15,1,6,8,13,12,1,6,8,12,15,1,6,8,14,13, + 1,6,8,15,13,1,6,8,15,14,1,6,9,10,11,1,6,9,13,10, + 1,6,9,11,12,1,6,9,11,13,1,6,9,14,11,1,6,9,15,11, + 1,6,9,12,13,1,6,9,13,14,1,6,9,13,15,1,6,10,12,11, + 1,6,10,11,14,1,6,10,13,12,1,6,10,14,13,1,6,11,12,13, + 1,6,11,15,12,1,6,11,13,14,1,6,11,14,15,1,6,12,15,13, + 1,6,13,15,14,1,7,8,9,10,1,7,8,11,9,1,7,8,9,14, + 1,7,8,10,11,1,7,8,13,10,1,7,8,14,10,1,7,8,10,15, + 1,7,8,11,13,1,7,8,15,11,1,7,8,13,14,1,7,8,14,15, + 1,7,9,11,10,1,7,9,10,12,1,7,9,10,13,1,7,9,15,10, + 1,7,9,12,11,1,7,9,13,11,1,7,9,11,14,1,7,9,11,15, + 1,7,9,14,12,1,7,9,14,13,1,7,9,15,14,1,7,10,11,12, + 1,7,10,14,11,1,7,10,12,13,1,7,10,12,14,1,7,10,15,12, + 1,7,10,13,14,1,7,10,14,15,1,7,11,13,12,1,7,11,12,15, + 1,7,11,14,13,1,7,11,15,14,1,7,12,13,14,1,7,12,14,15, + 1,8,9,12,10,1,8,9,10,15,1,8,9,11,12,1,8,9,15,11, + 1,8,9,12,14,1,8,9,14,15,1,8,10,12,11,1,8,10,11,15 / data ((iperm(j1,j2),j1=1,5),j2=401,480) / + 1,8,10,13,12,1,8,10,14,12,1,8,10,12,15,1,8,10,15,13, + 1,8,10,15,14,1,8,11,12,13,1,8,11,15,12,1,8,11,13,15, + 1,8,12,14,13,1,8,12,15,14,1,8,13,14,15,1,9,10,11,12, + 1,9,10,15,11,1,9,10,12,13,1,9,10,13,15,1,9,11,13,12, + 1,9,11,12,14,1,9,11,15,13,1,9,11,14,15,1,9,12,13,14, + 1,9,13,15,14,1,10,11,14,12,1,10,11,12,15,1,10,11,15,14, + 1,10,12,14,13,1,10,12,13,15,1,10,13,14,15,1,11,12,13,14, + 1,11,12,15,13,1,11,12,14,15,1,11,13,15,14,1,12,13,14,15, + 2,3,4,6,5,2,3,4,5,10,2,3,4,11,5,2,3,4,5,14, + 2,3,4,6,9,2,3,4,10,6,2,3,4,6,13,2,3,4,15,6, + 2,3,4,9,10,2,3,4,11,9,2,3,4,9,14,2,3,4,10,11, + 2,3,4,13,10,2,3,4,14,10,2,3,4,10,15,2,3,4,11,13, + 2,3,4,15,11,2,3,4,13,14,2,3,4,14,15,2,3,5,8,6, + 2,3,5,6,9,2,3,5,12,6,2,3,5,6,14,2,3,5,10,8, + 2,3,5,8,11,2,3,5,14,8,2,3,5,9,10,2,3,5,11,9, + 2,3,5,9,14,2,3,5,10,12,2,3,5,14,10,2,3,5,12,11, + 2,3,5,11,14,2,3,5,14,12,2,3,6,9,8,2,3,6,8,10, + 2,3,6,13,8,2,3,6,8,15,2,3,6,10,9,2,3,6,9,12, + 2,3,6,9,13,2,3,6,14,9,2,3,6,15,9,2,3,6,12,10, + 2,3,6,10,14,2,3,6,13,12,2,3,6,12,15,2,3,6,14,13 / data ((iperm(j1,j2),j1=1,5),j2=481,560) / + 2,3,6,15,14,2,3,8,9,10,2,3,8,11,9,2,3,8,9,14, + 2,3,8,10,11,2,3,8,13,10,2,3,8,14,10,2,3,8,10,15, + 2,3,8,11,13,2,3,8,15,11,2,3,8,13,14,2,3,8,14,15, + 2,3,9,11,10,2,3,9,10,12,2,3,9,10,13,2,3,9,15,10, + 2,3,9,12,11,2,3,9,13,11,2,3,9,11,14,2,3,9,11,15, + 2,3,9,14,12,2,3,9,14,13,2,3,9,15,14,2,3,10,11,12, + 2,3,10,14,11,2,3,10,12,13,2,3,10,12,14,2,3,10,15,12, + 2,3,10,13,14,2,3,10,14,15,2,3,11,13,12,2,3,11,12,15, + 2,3,11,14,13,2,3,11,15,14,2,3,12,13,14,2,3,12,14,15, + 2,4,5,6,7,2,4,5,8,6,2,4,5,6,11,2,4,5,13,6, + 2,4,5,7,10,2,4,5,11,7,2,4,5,7,14,2,4,5,10,8, + 2,4,5,8,11,2,4,5,14,8,2,4,5,11,10,2,4,5,10,13, + 2,4,5,13,11,2,4,5,11,14,2,4,5,14,13,2,4,6,7,9, + 2,4,6,10,7,2,4,6,7,13,2,4,6,15,7,2,4,6,9,8, + 2,4,6,8,10,2,4,6,13,8,2,4,6,8,15,2,4,6,11,9, + 2,4,6,9,13,2,4,6,10,11,2,4,6,13,10,2,4,6,11,13, + 2,4,6,15,11,2,4,6,13,15,2,4,7,10,9,2,4,7,9,11, + 2,4,7,14,9,2,4,7,11,10,2,4,7,10,13,2,4,7,10,14, + 2,4,7,15,10,2,4,7,13,11,2,4,7,11,15,2,4,7,14,13, + 2,4,7,15,14,2,4,8,9,10,2,4,8,11,9,2,4,8,9,14 / data ((iperm(j1,j2),j1=1,5),j2=561,640) / + 2,4,8,10,11,2,4,8,13,10,2,4,8,14,10,2,4,8,10,15, + 2,4,8,11,13,2,4,8,15,11,2,4,8,13,14,2,4,8,14,15, + 2,4,9,11,10,2,4,9,10,13,2,4,9,13,11,2,4,9,11,14, + 2,4,9,14,13,2,4,10,14,11,2,4,10,11,15,2,4,10,13,14, + 2,4,10,15,13,2,4,11,14,13,2,4,11,13,15,2,4,11,15,14, + 2,4,13,14,15,2,5,6,8,7,2,5,6,7,9,2,5,6,12,7, + 2,5,6,7,14,2,5,6,9,8,2,5,6,8,11,2,5,6,8,12, + 2,5,6,13,8,2,5,6,14,8,2,5,6,11,9,2,5,6,9,13, + 2,5,6,12,11,2,5,6,11,14,2,5,6,13,12,2,5,6,14,13, + 2,5,7,8,10,2,5,7,11,8,2,5,7,8,14,2,5,7,10,9, + 2,5,7,9,11,2,5,7,14,9,2,5,7,12,10,2,5,7,10,14, + 2,5,7,11,12,2,5,7,14,11,2,5,7,12,14,2,5,8,9,10, + 2,5,8,11,9,2,5,8,9,14,2,5,8,10,11,2,5,8,10,12, + 2,5,8,13,10,2,5,8,14,10,2,5,8,12,11,2,5,8,11,13, + 2,5,8,14,12,2,5,8,13,14,2,5,9,11,10,2,5,9,10,13, + 2,5,9,13,11,2,5,9,11,14,2,5,9,14,13,2,5,10,11,12, + 2,5,10,14,11,2,5,10,12,13,2,5,10,13,14,2,5,11,13,12, + 2,5,11,12,14,2,5,11,14,13,2,5,12,13,14,2,6,7,8,9, + 2,6,7,10,8,2,6,7,8,13,2,6,7,15,8,2,6,7,9,10, + 2,6,7,12,9,2,6,7,13,9,2,6,7,9,14,2,6,7,9,15 / data ((iperm(j1,j2),j1=1,5),j2=641,720) / + 2,6,7,10,12,2,6,7,14,10,2,6,7,12,13,2,6,7,15,12, + 2,6,7,13,14,2,6,7,14,15,2,6,8,10,9,2,6,8,9,11, + 2,6,8,9,12,2,6,8,14,9,2,6,8,15,9,2,6,8,11,10, + 2,6,8,12,10,2,6,8,10,13,2,6,8,10,14,2,6,8,13,11, + 2,6,8,11,15,2,6,8,13,12,2,6,8,12,15,2,6,8,14,13, + 2,6,8,15,13,2,6,8,15,14,2,6,9,10,11,2,6,9,13,10, + 2,6,9,11,12,2,6,9,11,13,2,6,9,14,11,2,6,9,15,11, + 2,6,9,12,13,2,6,9,13,14,2,6,9,13,15,2,6,10,12,11, + 2,6,10,11,14,2,6,10,13,12,2,6,10,14,13,2,6,11,12,13, + 2,6,11,15,12,2,6,11,13,14,2,6,11,14,15,2,6,12,15,13, + 2,6,13,15,14,2,7,8,9,10,2,7,8,11,9,2,7,8,9,14, + 2,7,8,10,11,2,7,8,13,10,2,7,8,14,10,2,7,8,10,15, + 2,7,8,11,13,2,7,8,15,11,2,7,8,13,14,2,7,8,14,15, + 2,7,9,11,10,2,7,9,10,12,2,7,9,10,13,2,7,9,15,10, + 2,7,9,12,11,2,7,9,13,11,2,7,9,11,14,2,7,9,11,15, + 2,7,9,14,12,2,7,9,14,13,2,7,9,15,14,2,7,10,11,12, + 2,7,10,14,11,2,7,10,12,13,2,7,10,12,14,2,7,10,15,12, + 2,7,10,13,14,2,7,10,14,15,2,7,11,13,12,2,7,11,12,15, + 2,7,11,14,13,2,7,11,15,14,2,7,12,13,14,2,7,12,14,15, + 2,8,9,12,10,2,8,9,10,15,2,8,9,11,12,2,8,9,15,11 / data ((iperm(j1,j2),j1=1,5),j2=721,800) / + 2,8,9,12,14,2,8,9,14,15,2,8,10,12,11,2,8,10,11,15, + 2,8,10,13,12,2,8,10,14,12,2,8,10,12,15,2,8,10,15,13, + 2,8,10,15,14,2,8,11,12,13,2,8,11,15,12,2,8,11,13,15, + 2,8,12,14,13,2,8,12,15,14,2,8,13,14,15,2,9,10,11,12, + 2,9,10,15,11,2,9,10,12,13,2,9,10,13,15,2,9,11,13,12, + 2,9,11,12,14,2,9,11,15,13,2,9,11,14,15,2,9,12,13,14, + 2,9,13,15,14,2,10,11,14,12,2,10,11,12,15,2,10,11,15,14, + 2,10,12,14,13,2,10,12,13,15,2,10,13,14,15,2,11,12,13,14, + 2,11,12,15,13,2,11,12,14,15,2,11,13,15,14,2,12,13,14,15, + 3,4,5,6,7,3,4,5,10,6,3,4,5,6,11,3,4,5,6,12, + 3,4,5,14,6,3,4,5,15,6,3,4,5,7,10,3,4,5,11,7, + 3,4,5,7,14,3,4,5,12,10,3,4,5,10,15,3,4,5,11,12, + 3,4,5,15,11,3,4,5,12,14,3,4,5,14,15,3,4,6,7,9, + 3,4,6,10,7,3,4,6,7,13,3,4,6,15,7,3,4,6,9,10, + 3,4,6,11,9,3,4,6,12,9,3,4,6,9,14,3,4,6,9,15, + 3,4,6,10,11,3,4,6,10,12,3,4,6,13,10,3,4,6,14,10, + 3,4,6,11,13,3,4,6,15,11,3,4,6,12,13,3,4,6,15,12, + 3,4,6,13,14,3,4,6,13,15,3,4,6,14,15,3,4,7,10,9, + 3,4,7,9,11,3,4,7,14,9,3,4,7,11,10,3,4,7,10,13, + 3,4,7,10,14,3,4,7,15,10,3,4,7,13,11,3,4,7,11,15 / data ((iperm(j1,j2),j1=1,5),j2=801,880) / + 3,4,7,14,13,3,4,7,15,14,3,4,9,12,10,3,4,9,10,15, + 3,4,9,11,12,3,4,9,15,11,3,4,9,12,14,3,4,9,14,15, + 3,4,10,12,11,3,4,10,11,15,3,4,10,13,12,3,4,10,14,12, + 3,4,10,12,15,3,4,10,15,13,3,4,10,15,14,3,4,11,12,13, + 3,4,11,15,12,3,4,11,13,15,3,4,12,14,13,3,4,12,15,14, + 3,4,13,14,15,3,5,6,8,7,3,5,6,7,9,3,5,6,12,7, + 3,5,6,7,14,3,5,6,10,8,3,5,6,8,11,3,5,6,8,12, + 3,5,6,14,8,3,5,6,15,8,3,5,6,9,10,3,5,6,11,9, + 3,5,6,12,9,3,5,6,9,14,3,5,6,9,15,3,5,6,10,12, + 3,5,6,14,10,3,5,6,12,11,3,5,6,11,14,3,5,6,15,12, + 3,5,6,14,15,3,5,7,8,10,3,5,7,11,8,3,5,7,8,14, + 3,5,7,10,9,3,5,7,9,11,3,5,7,14,9,3,5,7,12,10, + 3,5,7,10,14,3,5,7,11,12,3,5,7,14,11,3,5,7,12,14, + 3,5,8,10,12,3,5,8,15,10,3,5,8,12,11,3,5,8,11,15, + 3,5,8,14,12,3,5,8,15,14,3,5,9,12,10,3,5,9,10,15, + 3,5,9,11,12,3,5,9,15,11,3,5,9,12,14,3,5,9,14,15, + 3,5,10,14,12,3,5,10,12,15,3,5,10,15,14,3,5,11,12,14, + 3,5,11,15,12,3,5,11,14,15,3,5,12,15,14,3,6,7,8,9, + 3,6,7,10,8,3,6,7,8,13,3,6,7,15,8,3,6,7,9,10, + 3,6,7,12,9,3,6,7,13,9,3,6,7,9,14,3,6,7,9,15 / data ((iperm(j1,j2),j1=1,5),j2=881,960) / + 3,6,7,10,12,3,6,7,14,10,3,6,7,12,13,3,6,7,15,12, + 3,6,7,13,14,3,6,7,14,15,3,6,8,10,9,3,6,8,9,11, + 3,6,8,9,12,3,6,8,14,9,3,6,8,15,9,3,6,8,11,10, + 3,6,8,12,10,3,6,8,10,13,3,6,8,10,14,3,6,8,13,11, + 3,6,8,11,15,3,6,8,13,12,3,6,8,12,15,3,6,8,14,13, + 3,6,8,15,13,3,6,8,15,14,3,6,9,10,11,3,6,9,13,10, + 3,6,9,11,12,3,6,9,11,13,3,6,9,14,11,3,6,9,15,11, + 3,6,9,12,13,3,6,9,13,14,3,6,9,13,15,3,6,10,12,11, + 3,6,10,11,14,3,6,10,13,12,3,6,10,14,13,3,6,11,12,13, + 3,6,11,15,12,3,6,11,13,14,3,6,11,14,15,3,6,12,15,13, + 3,6,13,15,14,3,7,8,9,10,3,7,8,11,9,3,7,8,9,14, + 3,7,8,10,11,3,7,8,13,10,3,7,8,14,10,3,7,8,10,15, + 3,7,8,11,13,3,7,8,15,11,3,7,8,13,14,3,7,8,14,15, + 3,7,9,11,10,3,7,9,10,12,3,7,9,10,13,3,7,9,15,10, + 3,7,9,12,11,3,7,9,13,11,3,7,9,11,14,3,7,9,11,15, + 3,7,9,14,12,3,7,9,14,13,3,7,9,15,14,3,7,10,11,12, + 3,7,10,14,11,3,7,10,12,13,3,7,10,12,14,3,7,10,15,12, + 3,7,10,13,14,3,7,10,14,15,3,7,11,13,12,3,7,11,12,15, + 3,7,11,14,13,3,7,11,15,14,3,7,12,13,14,3,7,12,14,15, + 3,8,9,12,10,3,8,9,10,15,3,8,9,11,12,3,8,9,15,11 / data ((iperm(j1,j2),j1=1,5),j2=961,1040) / + 3,8,9,12,14,3,8,9,14,15,3,8,10,12,11,3,8,10,11,15, + 3,8,10,13,12,3,8,10,14,12,3,8,10,12,15,3,8,10,15,13, + 3,8,10,15,14,3,8,11,12,13,3,8,11,15,12,3,8,11,13,15, + 3,8,12,14,13,3,8,12,15,14,3,8,13,14,15,3,9,10,11,12, + 3,9,10,15,11,3,9,10,12,13,3,9,10,13,15,3,9,11,13,12, + 3,9,11,12,14,3,9,11,15,13,3,9,11,14,15,3,9,12,13,14, + 3,9,13,15,14,3,10,11,14,12,3,10,11,12,15,3,10,11,15,14, + 3,10,12,14,13,3,10,12,13,15,3,10,13,14,15,3,11,12,13,14, + 3,11,12,15,13,3,11,12,14,15,3,11,13,15,14,3,12,13,14,15, + 4,5,6,8,7,4,5,6,7,10,4,5,6,12,7,4,5,6,13,7, + 4,5,6,7,14,4,5,6,7,15,4,5,6,10,8,4,5,6,8,11, + 4,5,6,8,12,4,5,6,14,8,4,5,6,15,8,4,5,6,11,10, + 4,5,6,10,13,4,5,6,12,11,4,5,6,13,11,4,5,6,11,14, + 4,5,6,11,15,4,5,6,13,12,4,5,6,14,13,4,5,6,15,13, + 4,5,7,8,10,4,5,7,11,8,4,5,7,8,14,4,5,7,10,11, + 4,5,7,12,10,4,5,7,13,10,4,5,7,10,15,4,5,7,11,12, + 4,5,7,11,13,4,5,7,14,11,4,5,7,15,11,4,5,7,12,14, + 4,5,7,13,14,4,5,7,14,15,4,5,8,10,12,4,5,8,15,10, + 4,5,8,12,11,4,5,8,11,15,4,5,8,14,12,4,5,8,15,14, + 4,5,10,11,12,4,5,10,15,11,4,5,10,12,13,4,5,10,13,15 / data ((iperm(j1,j2),j1=1,5),j2=1041,1120) / + 4,5,11,13,12,4,5,11,12,14,4,5,11,15,13,4,5,11,14,15, + 4,5,12,13,14,4,5,13,15,14,4,6,7,8,9,4,6,7,10,8, + 4,6,7,8,13,4,6,7,15,8,4,6,7,9,10,4,6,7,12,9, + 4,6,7,13,9,4,6,7,9,14,4,6,7,9,15,4,6,7,10,12, + 4,6,7,14,10,4,6,7,12,13,4,6,7,15,12,4,6,7,13,14, + 4,6,7,14,15,4,6,8,10,9,4,6,8,9,11,4,6,8,9,12, + 4,6,8,14,9,4,6,8,15,9,4,6,8,11,10,4,6,8,12,10, + 4,6,8,10,13,4,6,8,10,14,4,6,8,13,11,4,6,8,11,15, + 4,6,8,13,12,4,6,8,12,15,4,6,8,14,13,4,6,8,15,13, + 4,6,8,15,14,4,6,9,10,11,4,6,9,13,10,4,6,9,11,12, + 4,6,9,11,13,4,6,9,14,11,4,6,9,15,11,4,6,9,12,13, + 4,6,9,13,14,4,6,9,13,15,4,6,10,12,11,4,6,10,11,14, + 4,6,10,13,12,4,6,10,14,13,4,6,11,12,13,4,6,11,15,12, + 4,6,11,13,14,4,6,11,14,15,4,6,12,15,13,4,6,13,15,14, + 4,7,8,9,10,4,7,8,11,9,4,7,8,9,14,4,7,8,10,11, + 4,7,8,13,10,4,7,8,14,10,4,7,8,10,15,4,7,8,11,13, + 4,7,8,15,11,4,7,8,13,14,4,7,8,14,15,4,7,9,11,10, + 4,7,9,10,12,4,7,9,10,13,4,7,9,15,10,4,7,9,12,11, + 4,7,9,13,11,4,7,9,11,14,4,7,9,11,15,4,7,9,14,12, + 4,7,9,14,13,4,7,9,15,14,4,7,10,11,12,4,7,10,14,11 / data ((iperm(j1,j2),j1=1,5),j2=1121,1200) / + 4,7,10,12,13,4,7,10,12,14,4,7,10,15,12,4,7,10,13,14, + 4,7,10,14,15,4,7,11,13,12,4,7,11,12,15,4,7,11,14,13, + 4,7,11,15,14,4,7,12,13,14,4,7,12,14,15,4,8,9,12,10, + 4,8,9,10,15,4,8,9,11,12,4,8,9,15,11,4,8,9,12,14, + 4,8,9,14,15,4,8,10,12,11,4,8,10,11,15,4,8,10,13,12, + 4,8,10,14,12,4,8,10,12,15,4,8,10,15,13,4,8,10,15,14, + 4,8,11,12,13,4,8,11,15,12,4,8,11,13,15,4,8,12,14,13, + 4,8,12,15,14,4,8,13,14,15,4,9,10,11,12,4,9,10,15,11, + 4,9,10,12,13,4,9,10,13,15,4,9,11,13,12,4,9,11,12,14, + 4,9,11,15,13,4,9,11,14,15,4,9,12,13,14,4,9,13,15,14, + 4,10,11,14,12,4,10,11,12,15,4,10,11,15,14,4,10,12,14,13, + 4,10,12,13,15,4,10,13,14,15,4,11,12,13,14,4,11,12,15,13, + 4,11,12,14,15,4,11,13,15,14,4,12,13,14,15,5,6,7,8,9, + 5,6,7,10,8,5,6,7,8,13,5,6,7,15,8,5,6,7,9,10, + 5,6,7,12,9,5,6,7,13,9,5,6,7,9,14,5,6,7,9,15, + 5,6,7,10,12,5,6,7,14,10,5,6,7,12,13,5,6,7,15,12, + 5,6,7,13,14,5,6,7,14,15,5,6,8,10,9,5,6,8,9,11, + 5,6,8,9,12,5,6,8,14,9,5,6,8,15,9,5,6,8,11,10, + 5,6,8,12,10,5,6,8,10,13,5,6,8,10,14,5,6,8,13,11, + 5,6,8,11,15,5,6,8,13,12,5,6,8,12,15,5,6,8,14,13 / data ((iperm(j1,j2),j1=1,5),j2=1201,1280) / + 5,6,8,15,13,5,6,8,15,14,5,6,9,10,11,5,6,9,13,10, + 5,6,9,11,12,5,6,9,11,13,5,6,9,14,11,5,6,9,15,11, + 5,6,9,12,13,5,6,9,13,14,5,6,9,13,15,5,6,10,12,11, + 5,6,10,11,14,5,6,10,13,12,5,6,10,14,13,5,6,11,12,13, + 5,6,11,15,12,5,6,11,13,14,5,6,11,14,15,5,6,12,15,13, + 5,6,13,15,14,5,7,8,9,10,5,7,8,11,9,5,7,8,9,14, + 5,7,8,10,11,5,7,8,13,10,5,7,8,14,10,5,7,8,10,15, + 5,7,8,11,13,5,7,8,15,11,5,7,8,13,14,5,7,8,14,15, + 5,7,9,11,10,5,7,9,10,12,5,7,9,10,13,5,7,9,15,10, + 5,7,9,12,11,5,7,9,13,11,5,7,9,11,14,5,7,9,11,15, + 5,7,9,14,12,5,7,9,14,13,5,7,9,15,14,5,7,10,11,12, + 5,7,10,14,11,5,7,10,12,13,5,7,10,12,14,5,7,10,15,12, + 5,7,10,13,14,5,7,10,14,15,5,7,11,13,12,5,7,11,12,15, + 5,7,11,14,13,5,7,11,15,14,5,7,12,13,14,5,7,12,14,15, + 5,8,9,12,10,5,8,9,10,15,5,8,9,11,12,5,8,9,15,11, + 5,8,9,12,14,5,8,9,14,15,5,8,10,12,11,5,8,10,11,15, + 5,8,10,13,12,5,8,10,14,12,5,8,10,12,15,5,8,10,15,13, + 5,8,10,15,14,5,8,11,12,13,5,8,11,15,12,5,8,11,13,15, + 5,8,12,14,13,5,8,12,15,14,5,8,13,14,15,5,9,10,11,12, + 5,9,10,15,11,5,9,10,12,13,5,9,10,13,15,5,9,11,13,12 / data ((iperm(j1,j2),j1=1,5),j2=1281,nperm) / + 5,9,11,12,14,5,9,11,15,13,5,9,11,14,15,5,9,12,13,14, + 5,9,13,15,14,5,10,11,14,12,5,10,11,12,15,5,10,11,15,14, + 5,10,12,14,13,5,10,12,13,15,5,10,13,14,15,5,11,12,13,14, + 5,11,12,15,13,5,11,12,14,15,5,11,13,15,14,5,12,13,14,15 / LoopTools-2.16/src/include/PaxHeaders/ffwarn.h0000644000000000000000000000007411776502523016335 xustar0030 atime=1648161785.731698531 30 ctime=1648161793.715764879 LoopTools-2.16/src/include/ffwarn.h0000644000000000000000000007222711776502523017262 0ustar00rootroot00000000000000 character*80 w1 parameter (w1="ffcb0p: warning: instability in case one mas"// + "s zero, may be solved later.") character*80 w2 parameter (w2="ffcb0p: warning: not enough terms in Taylor "// + "expansion ma=mb. May be serious!") character*80 w3 parameter (w3="ffcb0p: warning: minimum value complex logar"// + "ithm gives problem in equal masses.") character*80 w4 parameter (w4="ffcb0p: warning: cancellations in equal mass"// + "es (should not occur).") character*80 w5 parameter (w5="ffcb0p: warning: not enough terms in expansi"// + "on1 k2 zero. May be serious!") character*80 w6 parameter (w6="ffcb0p: warning: not enough terms in expansi"// + "on2 k2 zero, May be serious!") character*80 w7 parameter (w7="ffcb0p: warning: cancellations in final addi"// + "ng up, contact author if serious.") character*80 w8 parameter (w8="ffc1lg: warning: the combination 1-z*log(1-1"// + "/z) id unstable.") character*80 w9 parameter (w9="ffcayl: warning: not enough terms in Taylor "// + "expansion, may be serious.") character*80 w10 parameter (w10="ffcb0p: warning: cancellation in dotproduct "// + "s1.s2") character*80 w11 parameter (w11="ffcot2: warning: cancellation in dotproduct "// + "p.si ") character*80 w12 parameter (w12="ffcdbp: warning: not enough terms in Taylor "// + "expansion, may be serious") character*80 w13 parameter (w13="ffcdbp: warning: cancellations in case one m"// + "ass equal to zero") character*80 w14 parameter (w14="ffxb0p: warning: instability in case one mas"// + "s zero, may be solved later.") character*80 w15 parameter (w15="ffxb0p: warning: not enough terms in Taylor "// + "expansion ma=mb. May be serious!") character*80 w16 parameter (w16="ffxb0p: warning: minimum value real logarith"// + "m gives problem in equal masses.") character*80 w17 parameter (w17="ffxb0p: warning: cancellations in equal mass"// + "es (should not occur).") character*80 w18 parameter (w18="ffxb0p: warning: cancellations in equal mass"// + "es, complex roots, can be avoided.") character*80 w19 parameter (w19="ffxb0p: warning: not enough terms in expansi"// + "on1 k2 zero, may be serious!") character*80 w20 parameter (w20="ffxb0p: warning: not enough terms in expansi"// + "on2 k2 zero, may be serious!") character*80 w21 parameter (w21="ffxb0p: warning: cancellations between s2 an"// + "d alpha, should not be serious") character*80 w22 parameter (w22="ffd1lg: warning: the combination 1-z*log(1-1"// + "/z) id unstable.") character*80 w23 parameter (w23="ffxb0p: warning: cancellations in lambda equ"// + "al masses.") character*80 w24 parameter (w24="ffxb0p: warning: cancellation in dotproduct "// + "s1.s2") character*80 w25 parameter (w25="ffdot2: warning: cancellation in dotproduct "// + "p.si") character*80 w26 parameter (w26="ffcc0: warning: cancellation between the tw"// + "o twopoint functions.") character*80 w27 parameter (w27="ffcc0: warning: cancellation in final summi"// + "ng up.") character*80 w28 parameter (w28="ffxc0: warning: cancellation between the tw"// + "o twopoint functions.") character*80 w29 parameter (w29="ffxc0: warning: cancellation in final summi"// + "ng up.") character*80 w30 parameter (w30="ffcc0p: warning: numerical problems in cw(j+"// + "2,1), not used") character*80 w31 parameter (w31="ffcc0p: warning: cancellations in cdwz(j,i,1"// + "), not used") character*80 w32 parameter (w32="ffcc0p: warning: numerical problems in cw(j+"// + "2,3), not used") character*80 w33 parameter (w33="ffcc0p: warning: cancellations in cdwz(j,i,3"// + "), not used") character*80 w34 parameter (w34="ffxc0p: warning: numerical problems in w(j+2"// + ",1), not used") character*80 w35 parameter (w35="ffxc0p: warning: cancellations in dwz(j,i,1)"// + ", not used") character*80 w36 parameter (w36="ffxc0p: warning: numerical problems in cw(j+"// + "2,1), not used") character*80 w37 parameter (w37="ffxc0p: warning: cancellations in cdwz(j,i,1"// + "), not used") character*80 w38 parameter (w38="ffxc0p: warning: numerical problems in w(j+2"// + ",3), not used") character*80 w39 parameter (w39="ffxc0p: warning: cancellations in dwz(j,i,3)"// + ", not used") character*80 w40 parameter (w40="ffxc0p: warning: numerical problems in cw(j+"// + "2,3), not used") character*80 w41 parameter (w41="ffxc0p: warning: cancellations in cdwz(j,i,3"// + "), not used") character*80 w42 parameter (w42="ffcs3: warning: problems with range complex"// + " numbers") character*80 w43 parameter (w43="ffcs3: warning: cancellations in czz1 in sp"// + "ecial case") character*80 w44 parameter (w44="ffcxs3: warning: cancellations in zz1 in spe"// + "cial case") character*80 w45 parameter (w45="ffdcrr: warning: not enough terms in Taylor "// + "series (may be serious)") character*80 w46 parameter (w46="ffdcxr: warning: not enough terms in Taylor "// + "series (may be serious)") character*80 w47 parameter (w47="ffcrr: warning: problems with dynamical ran"// + "ge complex numbers") character*80 w48 parameter (w48="ffcrr: warning: y0 = y1, so R has been take"// + "n zero") character*80 w49 parameter (w49="ffcrr: warning: very large correction terms.") character*80 w50 parameter (w50="ffcrr: warning: minimum value complex log c"// + "auses loss of precision.") character*80 w51 parameter (w51="ffcxr: warning: y0 = y1, so R has been take"// + "n zero") character*80 w52 parameter (w52="ffcxr: warning: very large correction terms.") character*80 w53 parameter (w53="ffcxr: warning: minimum value real log caus"// + "es loss of precision.") character*80 w54 parameter (w54="ffcrr: warning: not enough terms in Taylor "// + "series (may be serious)") character*80 w55 parameter (w55="ffcxr: warning: not enough terms in Taylor "// + "series (may be serious)") character*80 w56 parameter (w56="ffcrr: warning: cancellations in cd2yzz + c"// + "zz") character*80 w57 parameter (w57="ffcrr: warning: cancellations in cd2yzz - c"// + "zz1") character*80 w58 parameter (w58="ffcxr: warning: cancellations in d2yzz + zz") character*80 w59 parameter (w59="ffcxr: warning: cancellations in d2yzz - zz1") character*80 w60 parameter (w60="ffxli2: warning: not enough terms in expansi"// + "on (may be serious)") character*80 w61 parameter (w61="ffzli2: warning: not enough terms in expansi"// + "on (may be serious)") character*80 w62 parameter (w62="dfflo1: warning: not enough terms in expansi"// + "on. calling log.") character*80 w63 parameter (w63="zfflo1: warning: not enough terms in expansi"// + "on. calling log.") character*80 w64 parameter (w64="ffzxdl: warning: minimum value real log give"// + "s problems.") character*80 w65 parameter (w65="ffzzdl: warning: minimum value complex log g"// + "ives problems.") character*80 w66 parameter (w66="ffzxdl: warning: not enough terms in expansi"// + "on (may be serious)") character*80 w67 parameter (w67="ffzzdl: warning: not enough terms in expansi"// + "on (may be serious)") character*80 w68 parameter (w68="ffclmb: warning: cancellation in calculation"// + " lambda.") character*80 w69 parameter (w69="ffxlmb: warning: cancellation in calculation"// + " lambda.") character*80 w70 parameter (w70="ffcel2: warning: cancellation in calculation"// + " delta_{pi pj}^{pi pj}") character*80 w71 parameter (w71="ffdel2: warning: cancellation in calculation"// + " delta_{pi pj}^{pi pj}") character*80 w72 parameter (w72="ffcel3: warning: cancellation in calculation"// + " delta_{s1 s2 s3}^{s1 s2 s3}") character*80 w73 parameter (w73="ffdel3: warning: cancellation in calculation"// + " delta_{s1 s2 s3}^{s1 s2 s3}") character*80 w74 parameter (w74="ffcl3m: warning: cancellation in (delta_{sj"// + " sk}^{si mu})^2") character*80 w75 parameter (w75="ffdl3m: warning: cancellation in (delta_{sj"// + " sk}^{si mu})^2") character*80 w76 parameter (w76="ffeta: warning: still cancellations. (not u"// + "sed)") character*80 w77 parameter (w77="ffceta: warning: still cancellations. (not u"// + "sed)") character*80 w78 parameter (w78="ffcdwz: warning: still cancelations in cw3pm"// + " - cz3mp (not used)") character*80 w79 parameter (w79="ffdwz: warning: still cancelations in w3pm "// + "- z3mp (not used)") character*80 w80 parameter (w80="ffdcxr: warning: minimum value real log caus"// + "es problems.") character*80 w81 parameter (w81="ffdcxr: warning: ieps <> iepsz, imaginary pa"// + "rt will be wrong") character*80 w82 parameter (w82="ffdcrr: warning: minimum value complex log c"// + "auses problems.") character*80 w83 parameter (w83="ffdl2s: warning: cancellations in delta_{s1'"// + "s2'}^{s1 s2}") character*80 w84 parameter (w84="ffxd0: warning: cancellation in final summi"// + "ng up.") character*80 w85 parameter (w85="ffdl3s: warning: cancellation in calculation"// + " delta^(si sj sk)_(sl sm sn)") character*80 w86 parameter (w86="ffcc0: warning: cancellations among input p"// + "arameters") character*80 w87 parameter (w87="ffxc0: warning: cancellations among input p"// + "arameters (import difference)") character*80 w88 parameter (w88="ffabcd: warning: cancellations in (2*s3.s4^2"// + " - s3^2*s4^2), try with del2") character*80 w89 parameter (w89="ffabcd: warning: cancellations in somb") character*80 w90 parameter (w90="ffabcd: warning: cancellations in d") character*80 w91 parameter (w91="ffabcd: warning: xc not yet accurate (can be"// + " improved)") character*80 w92 parameter (w92="ffdl2p: warning: cancellations in delta_{p1"// + " s2}^{p1 p2}") character*80 w93 parameter (w93="ffdl2t: warning: cancellations in delta_{p1"// + " s4}^{s3 s4}") character*80 w94 parameter (w94="ffcb0: warning: cancellations between cma a"// + "nd cmb (add input parameters)") character*80 w95 parameter (w95="ffcb0: warning: cancellations between ck an"// + "d cma (add input parameters)") character*80 w96 parameter (w96="ffcb0: warning: cancellations between ck an"// + "d cmb (add input parameters)") character*80 w97 parameter (w97="ffxb0: warning: cancellations between xma a"// + "nd xmb (add input parameters)") character*80 w98 parameter (w98="ffxb0: warning: cancellations between xk an"// + "d xma (add input parameters)") character*80 w99 parameter (w99="ffxb0: warning: cancellations between xk an"// + "d xmb (add input parameters)") character*80 w100 parameter (w100="ffdot3: warning: cancellations in dotproduct"// + " s_i.s_{i+1}") character*80 w101 parameter (w101="ffdot3: warning: cancellations in dotproduct"// + " p_i.s_i") character*80 w102 parameter (w102="ffdot3: warning: cancellations in dotproduct"// + " p_i.s_{i+1}") character*80 w103 parameter (w103="ffdot3: warning: cancellations in dotproduct"// + " p_i.s_{i+2}") character*80 w104 parameter (w104="ffdot3: warning: cancellations in dotproduct"// + " p_i.p_{i+1}") character*80 w105 parameter (w105="ffdot4: warning: cancellations in dotproduct"// + " s_i.s_{i+1}") character*80 w106 parameter (w106="ffdot4: warning: cancellations in dotproduct"// + " s_i.s_{i-1}") character*80 w107 parameter (w107="ffdot4: warning: cancellations in dotproduct"// + " p_i.s_i") character*80 w108 parameter (w108="ffdot4: warning: cancellations in dotproduct"// + " p_i.s_{i+1}") character*80 w109 parameter (w109="ffdot4: warning: cancellations in dotproduct"// + " p_{i-1}.s_i") character*80 w110 parameter (w110="ffdot4: warning: cancellations in dotproduct"// + " p_i.s_{i+2}") character*80 w111 parameter (w111="ffdot4: warning: cancellations in dotproduct"// + " p_{i+1}.s_i") character*80 w112 parameter (w112="ffdot4: warning: cancellations in dotproduct"// + " p_{i+2}.s_{i+1}") character*80 w113 parameter (w113="ffdot4: warning: cancellations in dotproduct"// + " p_i.p_{i+1}") character*80 w114 parameter (w114="ffdot4: warning: cancellations in dotproduct"// + " p_{i+1}.p_{i+2}") character*80 w115 parameter (w115="ffdot4: warning: cancellations in dotproduct"// + " p_{i+2}.p_i") character*80 w116 parameter (w116="ffdot4: warning: cancellations in dotproduct"// + " p_5.p_7") character*80 w117 parameter (w117="ffdot4: warning: cancellations in dotproduct"// + " p_6.p_8") character*80 w118 parameter (w118="ffdot4: warning: cancellations in dotproduct"// + " p_9.p_10") character*80 w119 parameter (w119="ffxd0: warning: sum is close to the minimum"// + " of the range.") character*80 w120 parameter (w120="ffxc0: warning: sum is close to the minimum"// + " of the range.") character*80 w121 parameter (w121="ffxd0: warning: cancellations among input p"// + "arameters (import difference)") character*80 w122 parameter (w122="ff2d22: warning: cancellations (delta_{sjsk"// + "}_{si mu} delta_{smsn}^{mu nu})^2") character*80 w123 parameter (w123="ff2dl2: warning: cancellations delta^{si mu"// + "}_{sj sk} delta^{mu sl}_{sm sn}") character*80 w124 parameter (w124="ff3dl2: warning: cancellations d^{i mu}_{jl"// + "} d^{mu nu}_{lm} d^{nu n}_{op}") character*80 w125 parameter (w125="fftran: warning: cancellations in s'_i^2 - s"// + "'_j^2") character*80 w126 parameter (w126="fftran: warning: cancellations in p'_i^2 - s"// + "'_j^2") character*80 w127 parameter (w127="fftran: warning: cancellations in p'_i^2 - p"// + "'_j^2") character*80 w128 parameter (w128="zfflog: warning: taking log of number close "// + "to 1, must be cured.") character*80 w129 parameter (w129="zxfflg: warning: taking log of number close "// + "to 1, must be cured.") character*80 w130 parameter (w130="ffcrr: warning: cancellations in calculatin"// + "g 2y-1-z...") character*80 w131 parameter (w131="ffxtra: warning: cancellations in extra term"// + "s, working on it") character*80 w132 parameter (w132="dfflo1: warning: cancellations because of wr"// + "ong call, should not occur") character*80 w133 parameter (w133="zfflo1: warning: cancellations because of wr"// + "ong call, should not occur") character*80 w134 parameter (w134="ffcs4: warning: cancellations in cd2yzz + c"// + "zz") character*80 w135 parameter (w135="ffcd0: warning: cancellations among input p"// + "arameters (import difference)") character*80 w136 parameter (w136="ffcd0: warning: cancellation in final summi"// + "ng up.") character*80 w137 parameter (w137="ffcd0: warning: sum is close to the minimum"// + " of the range.") character*80 w138 parameter (w138="ffdl3p: warning: cancellations in delta_{p1"// + " p2 p3}^{p1 p2 p3}") character*80 w139 parameter (w139="ffxd0p: warning: problems calculating sqrt(d"// + "elta(si,s3)) - sqrt(delta(si,s4))") character*80 w140 parameter (w140="ffdxc0: warning: problems calculating yzzy ="// + " y(4)z(3) - y(3)z(4)") character*80 w141 parameter (w141="ffcd0p: warning: problems calculating sqrt(d"// + "elta(si,s3)) - sqrt(delta(si,s4))") character*80 w142 parameter (w142="ffdcc0: warning: problems calculating yzzy ="// + " y(4)z(3) - y(3)z(4)") character*80 w143 parameter (w143="ffdel4: warning: cancellation in calculation"// + " delta_{s1 s2 s3 s4}^{s1 s2 s3 s4}") character*80 w144 parameter (w144="fftran: warning: cancellation in calculation"// + " s_i'.p_{jk}'") character*80 w145 parameter (w145="fftran: warning: cancellation in calculation"// + " p_{ji}'.p_{lk}'") character*80 w146 parameter (w146="fftran: warning: cancellation in calculation"// + " Ai - Aj") character*80 w147 parameter (w147="ffdxc0: warning: problems calculating yyzz ="// + " y(4) - y(3) - z(3) + z(4)") character*80 w148 parameter (w148="ffdxc0: warning: problems calculating cancel"// + "lations extra terms") character*80 w149 parameter (w149="ffcb0: warning: cancellations between Delta"// + ", B0' and log(m1*m2/mu^2)/2") character*80 w150 parameter (w150="ffxb0: warning: cancellations between Delta"// + ", B0' and log(m1*m2/mu^2)/2") character*80 w151 parameter (w151="ffzli2: warning: real part complex dilog ver"// + "y small and not stable") character*80 w152 parameter (w152="ffxxyz: warning: cancellations in y - 2*z (w"// + "ill be solved)") character*80 w153 parameter (w153="ffxd0: warning: cancellation in u=+p5^2+p6^"// + "2+p7^2+p8^2-p9^2-p10^2, import it!") character*80 w154 parameter (w154="ffxd0: warning: cancellation in v=-p5^2+p6^"// + "2-p7^2+p8^2+p9^2+p10^2, import it!") character*80 w155 parameter (w155="ffxd0: warning: cancellation in w=+p5^2-p6^"// + "2+p7^2-p8^2+p9^2+p10^2, import it!") character*80 w156 parameter (w156="ffxc0i: warning: cancellations in dotproduct"// + " p_i.s_j") character*80 w157 parameter (w157="ffxc0i: warning: cancellations in final summ"// + "ing up") character*80 w158 parameter (w158="ffxe0: warning: cancellations among input p"// + "arameters (import difference)") character*80 w159 parameter (w159="ffdl4p: warning: cancellations in delta_{p1"// + " p2 p3 p4}^{p1 p2 p3 p4}") character*80 w160 parameter (w160="ffdel5: warning: cancellation in calculation"// + " delta_{s1s2s3s4s5}^{s1s2s3s4s5}") character*80 w161 parameter (w161="ffxe0a: warning: cancellation in final summi"// + "ng up.") character*80 w162 parameter (w162="ffxe0a: warning: sum is close to the minimum"// + " of the range.") character*80 w163 parameter (w163="ffxc1: warning: cancellations in cc1.") character*80 w164 parameter (w164="ffxd1: warning: cancellations in cd1.") character*80 w165 parameter (w165="ffdl2i: warning: cancellations in delta_{p1"// + " p2}^{p3 p4}") character*80 w166 parameter (w166="ffdl3q: warning: cancellations in delta_{p5"// + " p6 p7}^{p(i1) p(i2) p(i3)}") character*80 w167 parameter (w167="ffxb1: warning: cancellations in cb1.") character*80 w168 parameter (w168="ffxe0: warning: cancellations in (p_i+p_{i+"// + "2})^2 (may not be serious)") character*80 w169 parameter (w169="ffdl4r: warning: cancellations in delta_{p1"// + " p2 p3 p4}^{s1 s2 s3 s4}") character*80 w170 parameter (w170="ffdl4s: warning: cancellations in delta_{p1"// + "p2p3p4}^{si pj pk pl}, to be improved") character*80 w171 parameter (w171="ffxe1: warning: cancellations in ce1") character*80 w172 parameter (w172="ffceta: warning: cancellations in extra term"// + "s for 4point function") character*80 w173 parameter (w173="ffceta: warning: cancellations between alpha"// + " and w-") character*80 w174 parameter (w174="ffceta: warning: cancellations between alpha"// + " and w+") character*80 w175 parameter (w175="ffceta: warning: cancellations between a and"// + " z") character*80 w176 parameter (w176="ffceta: warning: cancellations between a and"// + " y") character*80 w177 parameter (w177="ffcdbd: warning: cancellations in summing up") character*80 w178 parameter (w178="ffkfun: warning: cancellations between z and"// + " (m-mp)^2") character*80 w179 parameter (w179="ffkfun: warning: 4*m*mp/(z-(m-mp)^2) ~ 1, ca"// + "n be solved") character*80 w180 parameter (w180="ffxc0p: warning: delta^{s1,s2,s3}_{s1,s2,s3"// + "} not stable, can be solved.") character*80 w181 parameter (w181="ffxc0p: warning: cancellations in complex di"// + "scriminant, can be solved") character*80 w182 parameter (w182="ffcd0e: warning: still cancellations in del4"// + " with only complex in poles") character*80 w183 parameter (w183="ffcc0a: warning: cannot deal properly with t"// + "hreshold of this type") character*80 w184 parameter (w184="ffcran: warning: cancellations in s'(i).p'(k"// + "j)") character*80 w185 parameter (w185="ffcran: warning: cancellations in p'(ji).p'("// + "lk)") character*80 w186 parameter (w186="ffcd0p: warning: cancellations in cel2") character*80 w187 parameter (w187="ffdel6: warning: cancellations in coefficien"// + "t F0, can be improved") character*80 w188 parameter (w188="ffdl5r: warning: cancellations in coefficien"// + "t E0, can be improved") character*80 w189 parameter (w189="ffxdi: warning: cancellations in cd2del") character*80 w190 parameter (w190="ffxdi: warning: cancellations in cd2pp") character*80 w191 parameter (w191="ffxf0a: warning: cancellations in F0 as sum "// + "of 6 E0's - near threshold?") character*80 w192 parameter (w192="ffxf0a: warning: sum is close to minimum of "// + "range") character*80 w193 parameter (w193="ffxf0: warning: cancellations among input p"// + "arameters (import difference)") character*80 w194 parameter (w194="ffxdbd: warning: cancellations in summing up") character*80 w195 parameter (w195="ffdot6: warning: cancellations in dotproduct"// + " s_i.s_{i+1}") character*80 w196 parameter (w196="ffdot6: warning: cancellations in dotproduct"// + " s_i.s_{i-1}") character*80 w197 parameter (w197="ffdot6: warning: cancellations in dotproduct"// + " p_i.s_i") character*80 w198 parameter (w198="ffdot6: warning: cancellations in dotproduct"// + " p_i.s_{i+1}") character*80 w199 parameter (w199="ffdot6: warning: cancellations in dotproduct"// + " p_{i-1}.s_i") character*80 w200 parameter (w200="ffdot6: warning: cancellations in dotproduct"// + " p_i.s_{i+2}") character*80 w201 parameter (w201="ffdot6: warning: cancellations in dotproduct"// + " p_{i+1}.s_i") character*80 w202 parameter (w202="ffdot6: warning: cancellations in dotproduct"// + " p_{i+2}.s_{i+1}") character*80 w203 parameter (w203="ffdot6: warning: cancellations in dotproduct"// + " p_i.p_{i+1}") character*80 w204 parameter (w204="ffdot6: warning: cancellations in dotproduct"// + " p_{i+1}.p_{i+2}") character*80 w205 parameter (w205="ffdot6: warning: cancellations in dotproduct"// + " p_{i+2}.p_i") character*80 w206 parameter (w206="ffdot6: warning: cancellations in dotproduct"// + " p_{i+2}.s_{i+2}") character*80 w207 parameter (w207="ffdot6: warning: cancellations in dotproduct"// + " s_i.s{i+3}") character*80 w208 parameter (w208="ffdot6: warning: cancellations in dotproduct"// + " pi.pj") character*80 w209 parameter (w209="ffxdna: warning: cancellations in 1+/-a, une"// + "xpected...") character*80 w210 parameter (w210="ffxdna: warning: cancellations in b-a, unexp"// + "ected...") character*80 w211 parameter (w211="ffcd0c: warning: cancellations in subtractio"// + "n of IR pole (to be expected)") character*80 w212 parameter (w212="ffcd0c: warning: cancellations in computatio"// + "n prop1 for threshold") character*80 w213 parameter (w213="ffcd0c: warning: cancellations in computatio"// + "n prop2 for threshold") character*80 w214 parameter (w214="ffxb2a: warning: cancellations in B2d") character*80 w215 parameter (w215="ffxd0p: warning: cancellations in complex de"// + "l3mi") character*80 w216 parameter (w216="ffzcnp: warning: cancellations in y (can be "// + "fixed, contact author)") character*80 w217 parameter (w217="ffzdnp: warning: cancellations in delta^(pi "// + "si+1)_(pi pi+1)") character*80 w218 parameter (w218="ffzdnp: warning: cancellations in (delta^(m"// + "u si+1)_(pi pi+1))^2") character*80 w219 parameter (w219="ffzcnp: warning: cancellations in z (can be "// + "fixed, contact author)") character*80 w220 parameter (w220="ffxb1: warning: not enough terms in Taylor "// + "expansion, may be serious") character*80 w221 parameter (w221="ffxdb0: warning: cancellations in computatio"// + "n 'diff'") character*80 w222 parameter (w222="ffxdb0: warning: still cancellations is spli"// + "t-up 1") character*80 w223 parameter (w223="ffxdb0: warning: still cancellations is s1") character*80 w224 parameter (w224="ffxdb0: warning: cancellations in B0', compl"// + "ex args (can be improved)") character*80 w225 parameter (w225="ffxb2p: warning: cancellations in B21 (after"// + " a lot of effort)") character*80 w226 parameter (w226="ffxb2p: warning: cancellations in B22") character*80 w227 parameter (w227="ffxb2a: warning: cancellations in B21") character*80 w228 parameter (w228="ffxbdp: warning: cancellations in case p^2=0") character*80 w229 parameter (w229="ffxdpv: warning: cancellations in going from"// + " delta- to PV-scheme") character*80 w230 parameter (w230="ffxl22: warning: not enough terms in Taylor "// + "expansion Li2(2-x)") character*80 w231 parameter (w231="dfflo2: warning: not enough terms in taylor "// + "expansion, using log(1-x)+x") character*80 w232 parameter (w232="dfflo3: warning: not enough terms in taylor "// + "expansion, using log(1-x)+x+x^2/2") character*80 w233 parameter (w233="ffcdbp: warning: cancellations in equal mass"// + "es case") character*80 w234 parameter (w234="ffcbdp: warning: cancellations in case p^2=0") character*80 w235 parameter (w235="ffcbdp: warning: cancellations in small diff.") character*80 w236 parameter (w236="ffcbdp: warning: cancellations in 1-alpha") character*80 w237 parameter (w237="ffcbdp: warning: cancellations in s2-alpha, "// + "may not be serious") character*80 w238 parameter (w238="ffcbdp: warning: not enough terms in Taylor "// + "expansion, may be serious") character*80 w239 parameter (w239="ffcbdp: warning: cancellations in s1-(1-alph"// + "a), may not be serious") character*80 w240 parameter (w240="ffcbdp: warning: cancellations in final resu"// + "lt") character*80 w241 parameter (w241="ffxe2: warning: cancellations in E2 (can ma"// + "ybe be done better)") character*80 w242 parameter (w242="ffxe3: warning: cancellations in E3 (can ma"// + "ybe be done better)") character*80 w243 parameter (w243="ffxe3: warning: cancellations in adding det"// + "erminants (may not be serious)") character*80 w244 parameter (w244="ffcdna: warning: cancellations in del45") character*80 w245 parameter (w245="ffcdna: warning: cancellations in del543m") character*80 w246 parameter (w246="ffcdna: warning: cancellations in B") character*80 w247 parameter (w247="ffcdna: warning: cancellations in C") character*80 w248 parameter (w248="ffcdna: warning: cancellations between z1 an"// + "d alpha") character*80 w249 parameter (w249="ffcdna: warning: cancellations between z2 an"// + "d alpha") character*80 w250 parameter (w250="ffcdna: warning: cancellations in 1 + r*x1 ") character*80 w251 parameter (w251="ffcdna: warning: cancellations in 1 + r*x2") character*80 w252 parameter (w252="ffcdna: warning: cancellations between r*x1 "// + "and r*x2") character*80 w253 parameter (w253="ffd0c: warning: something wrong with the "// + "rotation") character*80 w254 parameter (w254="ffTn: warning: numerical cancellation "// + "in in-triangle check") character*80 w255 parameter (w255="ffRn: warning: 3-point Landau singularity") character*80 w256 parameter (w256="ffRn: warning: Im(a.b) in the 1st theta "// + "function is zero") character*80 w257 parameter (w257="ffRn: warning: Im(a.b) in the 2nd theta "// + "function is zero") character*80 w258 parameter (w258="ffint3: cannot handle complex x yet") character*80 warn(258) data warn / w1,w2,w3,w4,w5,w6,w7,w8,w9, + w10,w11,w12,w13,w14,w15,w16,w17,w18,w19, + w20,w21,w22,w23,w24,w25,w26,w27,w28,w29, + w30,w31,w32,w33,w34,w35,w36,w37,w38,w39, + w40,w41,w42,w43,w44,w45,w46,w47,w48,w49, + w50,w51,w52,w53,w54,w55,w56,w57,w58,w59, + w60,w61,w62,w63,w64,w65,w66,w67,w68,w69, + w70,w71,w72,w73,w74,w75,w76,w77,w78,w79, + w80,w81,w82,w83,w84,w85,w86,w87,w88,w89, + w90,w91,w92,w93,w94,w95,w96,w97,w98,w99, + w100,w101,w102,w103,w104,w105,w106,w107,w108,w109, + w110,w111,w112,w113,w114,w115,w116,w117,w118,w119, + w120,w121,w122,w123,w124,w125,w126,w127,w128,w129, + w130,w131,w132,w133,w134,w135,w136,w137,w138,w139, + w140,w141,w142,w143,w144,w145,w146,w147,w148,w149, + w150,w151,w152,w153,w154,w155,w156,w157,w158,w159, + w160,w161,w162,w163,w164,w165,w166,w167,w168,w169, + w170,w171,w172,w173,w174,w175,w176,w177,w178,w179, + w180,w181,w182,w183,w184,w185,w186,w187,w188,w189, + w190,w191,w192,w193,w194,w195,w196,w197,w198,w199, + w200,w201,w202,w203,w204,w205,w206,w207,w208,w209, + w210,w211,w212,w213,w214,w215,w216,w217,w218,w219, + w220,w221,w222,w223,w224,w225,w226,w227,w228,w229, + w230,w231,w232,w233,w234,w235,w236,w237,w238,w239, + w240,w241,w242,w243,w244,w245,w246,w247,w248,w249, + w250,w251,w252,w253,w254,w255,w256,w257,w258 / LoopTools-2.16/src/include/PaxHeaders/externals.h0000644000000000000000000000013213722121553017043 xustar0030 mtime=1598595947.169981926 30 atime=1648161785.731698531 30 ctime=1648161793.715764879 LoopTools-2.16/src/include/externals.h0000644000000000000000000001567613722121553020002 0ustar00rootroot00000000000000#if 0 This file was generated by mkexternalsh on Fri 28 Aug 2020 08:25:47 AM CEST. Do not edit. #endif #define AcoeffC ljAcoeffC #define Acoeff ljAcoeff #define Bcheck ljBcheck #define BcoeffAD ljBcoeffAD #define BcoeffFFC ljBcoeffFFC #define BcoeffFF ljBcoeffFF #define bdKC ljbdKC #define bdK ljbdK #define BparaC ljBparaC #define Bpara ljBpara #define C0collDR ljC0collDR #define C0coll ljC0coll #define C0funcC ljC0funcC #define C0func ljC0func #define C0p0 ljC0p0 #define C0p1 ljC0p1 #define C0p2 ljC0p2 #define C0p3 ljC0p3 #define C0softDR ljC0softDR #define C0soft ljC0soft #define cachecopy ljcachecopy #define cacheindex ljcacheindex #define CcoefxC ljCcoefxC #define Ccoefx ljCcoefx #define CDispatch ljCDispatch #define CDump ljCDump #define cLi2omrat2 ljcLi2omrat2 #define cLi2omrat ljcLi2omrat #define coeffnames ljcoeffnames #define CparaC ljCparaC #define Cpara ljCpara #define cspence ljcspence #define D0CcollDR ljD0CcollDR #define D0Ccoll ljD0Ccoll #define D0Cm1p2 ljD0Cm1p2 #define D0Cm1p3 ljD0Cm1p3 #define D0Cm2p3 ljD0Cm2p3 #define D0collDR ljD0collDR #define D0coll ljD0coll #define D0CsoftDR ljD0CsoftDR #define D0Csoft ljD0Csoft #define D0funcC ljD0funcC #define D0func ljD0func #define D0m0 ljD0m0 #define D0m0p0 ljD0m0p0 #define D0m0p1 ljD0m0p1 #define D0m0p2 ljD0m0p2 #define D0m0p3 ljD0m0p3 #define D0m1 ljD0m1 #define D0m1p2 ljD0m1p2 #define D0m1p3 ljD0m1p3 #define D0m2 ljD0m2 #define D0m2p3 ljD0m2p3 #define D0m3 ljD0m3 #define D0m4 ljD0m4 #define D0softDR ljD0softDR #define D0soft ljD0soft #define D0z ljD0z #define DCDispatch ljDCDispatch #define DCDump ljDCDump #define DcoefxC ljDcoefxC #define Dcoefx ljDcoefx #define DDispatch ljDDispatch #define DDump ljDDump #define DecompC ljDecompC #define Decomp ljDecomp #define DetmC ljDetmC #define Detm ljDetm #define dfflo1 ljdfflo1 #define dfflo2 ljdfflo2 #define dfflo3 ljdfflo3 #define DparaC ljDparaC #define Dpara ljDpara #define DumpCoeffC ljDumpCoeffC #define DumpCoeff ljDumpCoeff #define DumpParaC ljDumpParaC #define DumpPara ljDumpPara #define E0funcb ljE0funcb #define E0funcC ljE0funcC #define E0func ljE0func #define EcheckC ljEcheckC #define Echeck ljEcheck #define EcoeffaC ljEcoeffaC #define Ecoeffa ljEcoeffa #define EcoeffbC ljEcoeffbC #define Ecoeffb ljEcoeffb #define EcoefxC ljEcoefxC #define Ecoefx ljEcoefx #define EparaC ljEparaC #define Epara ljEpara #define eta ljeta #define etatilde ljetatilde #define ff2d22 ljff2d22 #define ff2dl2 ljff2dl2 #define ff3dl2 ljff3dl2 #define ffabcd ljffabcd #define ffai ljffai #define ffbglg ljffbglg #define ffbndc ljffbndc #define ffbnd ljffbnd #define ffc1lg ljffc1lg #define ffca0 ljffca0 #define ffcayl ljffcayl #define ffcb0 ljffcb0 #define ffcb0p ljffcb0p #define ffcb1a ljffcb1a #define ffcb1 ljffcb1 #define ffcb2p ljffcb2p #define ffcb2q ljffcb2q #define ffcc0a ljffcc0a #define ffcc0b ljffcc0b #define ffcc0 ljffcc0 #define ffcc0p ljffcc0p #define ffcc0r ljffcc0r #define ffccyz ljffccyz #define ffcdb0 ljffcdb0 #define ffcdbp ljffcdbp #define ffcdel ljffcdel #define ffcdot ljffcdot #define ffcdwz ljffcdwz #define ffcel2 ljffcel2 #define ffcel3 ljffcel3 #define ffchck ljffchck #define ffcl2p ljffcl2p #define ffcl2t ljffcl2t #define ffcl3m ljffcl3m #define ffclg2 ljffclg2 #define ffclgy ljffclgy #define ffclmb ljffclmb #define ffcnst ljffcnst #define ffcod3 ljffcod3 #define ffcoot ljffcoot #define ffcot2 ljffcot2 #define ffcot3 ljffcot3 #define ffcrr ljffcrr #define ffcrt3 ljffcrt3 #define ffcs3 ljffcs3 #define ffcs4 ljffcs4 #define ffcxra ljffcxra #define ffcxr ljffcxr #define ffcxs3 ljffcxs3 #define ffcxs4 ljffcxs4 #define ffcxyz ljffcxyz #define ffd0c ljffd0c #define ffd0tra ljffd0tra #define ffdcc0 ljffdcc0 #define ffdcrr ljffdcrr #define ffdcs ljffdcs #define ffdcxr ljffdcxr #define ffdcxs ljffdcxs #define ffdel2 ljffdel2 #define ffdel3 ljffdel3 #define ffdel4 ljffdel4 #define ffdel5 ljffdel5 #define ffdel ljffdel #define ffdif4 ljffdif4 #define ffdl2p ljffdl2p #define ffdl2s ljffdl2s #define ffdl2t ljffdl2t #define ffdl3m ljffdl3m #define ffdl3p ljffdl3p #define ffdl3s ljffdl3s #define ffdl4p ljffdl4p #define ffdl4r ljffdl4r #define ffdot2 ljffdot2 #define ffdot3 ljffdot3 #define ffdot4 ljffdot4 #define ffdot5 ljffdot5 #define ffdot ljffdot #define ffdwz ljffdwz #define ffdxc0 ljffdxc0 #define fferr ljfferr #define ffflag ljffflag #define ffgdt4 ljffgdt4 #define ffgeta ljffgeta #define ffidel ljffidel #define ffieps ljffieps #define ffint3 ljffint3 #define ffpi43 ljffpi43 #define ffpi54 ljffpi54 #define ffprec ljffprec #define ffpvf ljffpvf #define ffRn ljffRn #define ffroot ljffroot #define ffroots ljffroots #define ffrot3 ljffrot3 #define ffrot4 ljffrot4 #define ffrota ljffrota #define ffrt3p ljffrt3p #define ffS2_linr ljffS2_linr #define ffS2 ljffS2 #define ffS3n ljffS3n #define ffset ljffset #define ffsign ljffsign #define ffsm43 ljffsm43 #define ffsmug ljffsmug #define ffT13 ljffT13 #define fftayl ljfftayl #define ffthf ljffthf #define ffthre ljffthre #define ffT_lin ljffT_lin #define ffTn ljffTn #define fftran ljfftran #define fftraroot ljfftraroot #define ffwarn ljffwarn #define ffwbeta ljffwbeta #define ffx2ir ljffx2ir #define ffxa0 ljffxa0 #define ffxb0 ljffxb0 #define ffxb0p ljffxb0p #define ffxb111 ljffxb111 #define ffxb1a ljffxb1a #define ffxb1 ljffxb1 #define ffxb2p ljffxb2p #define ffxb2q ljffxb2q #define ffxc0a ljffxc0a #define ffxc0b ljffxc0b #define ffxc0i ljffxc0i #define ffxc0j ljffxc0j #define ffxc0 ljffxc0 #define ffxc0p0 ljffxc0p0 #define ffxc0p ljffxc0p #define ffxc0r ljffxc0r #define ffxclg ljffxclg #define ffxd0a ljffxd0a #define ffxd0b ljffxd0b #define ffxd0d ljffxd0d #define ffxd0e ljffxd0e #define ffxd0 ljffxd0 #define ffxd0m0 ljffxd0m0 #define ffxd0p ljffxd0p #define ffxd0r ljffxd0r #define ffxdb0 ljffxdb0 #define ffxdb11 ljffxdb11 #define ffxdb1 ljffxdb1 #define ffxdbd ljffxdbd #define ffxdbp ljffxdbp #define ffxdir ljffxdir #define ffxe00 ljffxe00 #define ffxe0a ljffxe0a #define ffxe0 ljffxe0 #define ffxe0r ljffxe0r #define ffxhck ljffxhck #define ffxkfn ljffxkfn #define ffxl22 ljffxl22 #define ffxlam ljffxlam #define ffxli2 ljffxli2 #define ffxlmb ljffxlmb #define ffxlogx ljffxlogx #define ffxtra ljffxtra #define ffxxyz ljffxxyz #define ffypvf ljffypvf #define ffzdbd ljffzdbd #define ffzkfn ljffzkfn #define ffzli2 ljffzli2 #define ffzxdl ljffzxdl #define ffzzdl ljffzzdl #define fpv ljfpv #define fth ljfth #define InverseC ljInverseC #define Inverse ljInverse #define InvGramEC ljInvGramEC #define InvGramE ljInvGramE #define Li2omrat2 ljLi2omrat2 #define Li2omrat ljLi2omrat #define Li2omx2 ljLi2omx2 #define Li2omx3 ljLi2omx3 #define Li2rat ljLi2rat #define Li2series ljLi2series #define lndiv0 ljlndiv0 #define lndiv1 ljlndiv1 #define namedata ljnamedata #define nffet1 ljnffet1 #define nffeta ljnffeta #define paranames ljparanames #define SolveC ljSolveC #define Solve ljSolve #define spence ljspence #define xeta ljxeta #define xetatilde ljxetatilde #define xlogx ljxlogx #define xspence ljxspence #define yfpv ljyfpv #define zfflo1 ljzfflo1 #define zfflo2 ljzfflo2 #define zfflo3 ljzfflo3 #define zfflog ljzfflog #define zxfflg ljzxfflg LoopTools-2.16/src/include/PaxHeaders/ftypes.h0000644000000000000000000000013214122633060016344 xustar0030 mtime=1632319024.332704915 30 atime=1648161785.731698531 30 ctime=1648161793.715764879 LoopTools-2.16/src/include/ftypes.h0000644000000000000000000000555414122633060017275 0ustar00rootroot00000000000000#ifndef FTYPES_H #define FTYPES_H #if NOUNDERSCORE #define FORTRAN(s) s #else #define FORTRAN(s) s##_ #endif #ifndef CQUADSIZE #define CQUADSIZE QUADSIZE #endif #if QUAD && CQUADSIZE == 16 #include #define _prec(f) f##q typedef __float128 RealType; typedef __float128 REAL; #ifndef __cplusplus typedef __complex128 ComplexType; #endif #define ToReal(r) (RealType)(r) #define ToREAL(r) (REAL)(r) #elif QUAD && CQUADSIZE == 10 #define _prec(f) f##l #define RealType long double #if QUADSIZE == CQUADSIZE typedef RealType REAL; #define ToReal(r) (r) #define ToREAL(r) (r) #else #pragma pack(push, 1) typedef struct { unsigned long long frac; unsigned short exp; } REAL10; typedef struct { char zero[6]; unsigned long long frac; unsigned short exp; } REAL16; #pragma pack(pop) typedef union { long double r10; REAL10 i10; REAL16 i16; unsigned long long i8[2]; } REAL; static inline REAL ToREAL(const RealType r) { REAL n; n.i8[0] = 0; n.i16.frac = ((REAL *)&r)->i10.frac << 1; n.i16.exp = ((REAL *)&r)->i10.exp; return n; } static inline RealType ToReal(const REAL r) { REAL n; const long long z = r.i16.frac | (r.i16.exp & 0x7fff); n.i10.frac = (r.i16.frac >> 1) | ((z | -z) & 0x8000000000000000LL); n.i10.exp = r.i16.exp; return n.r10; } static inline void ToRealArray(RealType *out, const REAL *in, const int n) { int i; for( i = 0; i < n; ++i ) out[i] = ToReal(in[i]); } static inline void ToREALArray(REAL *out, const RealType *in, const int n) { int i; for( i = 0; i < n; ++i ) out[i] = ToREAL(in[i]); } #endif #else #define _prec(f) f #define RealType double typedef double REAL; #define ToReal(r) (r) #define ToREAL(r) (r) #endif typedef int INTEGER; typedef const INTEGER CINTEGER; typedef long long int INTEGER8; typedef const REAL CREAL; typedef struct { REAL re, im; } COMPLEX; typedef const COMPLEX CCOMPLEX; typedef char CHARACTER; typedef const CHARACTER CCHARACTER; #ifdef __cplusplus #include typedef std::complex ComplexType; #define ToComplex(c) ComplexType(ToReal((c).re), ToReal((c).im)) #define ToComplex2(r,i) ComplexType(r, i) #define Re(x) std::real(x) #define Im(x) std::imag(x) #define Conjugate(x) std::conj(x) #elif __STDC_VERSION__ >= 199901L #include #ifdef RealType typedef RealType complex ComplexType; #endif #define ToComplex(c) (ToReal((c).re) + I*ToReal((c).im)) #define ToComplex2(r,i) (r + I*(i)) #define Re(c) _prec(creal)(c) #define Im(c) _prec(cimag)(c) #define Conjugate(c) _prec(conj)(c) #else #ifdef RealType typedef struct { RealType re, im; } ComplexType; #endif #define ToComplex(c) (ComplexType){ToReal((c).re), ToReal((c).im)} #define ToComplex2(r,i) (ComplexType){r, i} #define Re(x) (x).re #define Im(x) (x).im #define Conjugate(x) (ComplexType){(x).re, -(x).im} #endif typedef const RealType cRealType; typedef const ComplexType cComplexType; #endif LoopTools-2.16/src/include/PaxHeaders/lt.h0000644000000000000000000000007413264371657015477 xustar0030 atime=1648161785.731698531 30 ctime=1648161793.715764879 LoopTools-2.16/src/include/lt.h0000644000000000000000000000150213264371657016410 0ustar00rootroot00000000000000* lt.h * internal common blocks for the LoopTools routines * this file is part of LoopTools * last modified 14 Apr 18 th #include "ff.h" * the cache-pointer structure is (see cache.c): * 1. int valid * 2. Node *last * 3. Node *first * 4. (not used) integer ncaches parameter (ncaches = 10) integer*8 cacheptr(4,0:QUAD,ncaches) integer*8 savedptr(2,ncaches) RealType maxdev integer epsi, warndigits, errdigits integer serial, versionkey integer debugkey, debugfrom, debugto common /ltvars/ & cacheptr, savedptr, & maxdev, & epsi, warndigits, errdigits, & serial, versionkey, & debugkey, debugfrom, debugto integer cmpbits common /ltcache/ cmpbits ComplexType cache(2,ncaches) equivalence (cacheptr, cache) #ifndef DEBUGLEVEL #define DEBUGLEVEL ibits(debugkey,8,2) #endif LoopTools-2.16/src/include/PaxHeaders/looptools-alt.h0000644000000000000000000000007412303645633017657 xustar0030 atime=1648161785.731698531 30 ctime=1648161793.715764879 LoopTools-2.16/src/include/looptools-alt.h0000644000000000000000000001363712303645633020604 0ustar00rootroot00000000000000#if 0 looptools.h the header file for Fortran with all definitions for LoopTools this file is part of LoopTools last modified 27 Feb 14 th #endif #ifndef LOOPTOOLS_H #define LOOPTOOLS_H #define aa0 1 #define aa00 4 #define Naa 6 #define bb0 1 #define bb1 4 #define bb00 7 #define bb11 10 #define bb001 13 #define bb111 16 #define dbb0 19 #define dbb1 22 #define dbb00 25 #define dbb11 28 #define dbb001 31 #define Nbb 33 #define cc0 1 #define cc1 4 #define cc2 7 #define cc00 10 #define cc11 13 #define cc12 16 #define cc22 19 #define cc001 22 #define cc002 25 #define cc111 28 #define cc112 31 #define cc122 34 #define cc222 37 #define cc0000 40 #define cc0011 43 #define cc0012 46 #define cc0022 49 #define cc1111 52 #define cc1112 55 #define cc1122 58 #define cc1222 61 #define cc2222 64 #define Ncc 66 #define dd0 1 #define dd1 4 #define dd2 7 #define dd3 10 #define dd00 13 #define dd11 16 #define dd12 19 #define dd13 22 #define dd22 25 #define dd23 28 #define dd33 31 #define dd001 34 #define dd002 37 #define dd003 40 #define dd111 43 #define dd112 46 #define dd113 49 #define dd122 52 #define dd123 55 #define dd133 58 #define dd222 61 #define dd223 64 #define dd233 67 #define dd333 70 #define dd0000 73 #define dd0011 76 #define dd0012 79 #define dd0013 82 #define dd0022 85 #define dd0023 88 #define dd0033 91 #define dd1111 94 #define dd1112 97 #define dd1113 100 #define dd1122 103 #define dd1123 106 #define dd1133 109 #define dd1222 112 #define dd1223 115 #define dd1233 118 #define dd1333 121 #define dd2222 124 #define dd2223 127 #define dd2233 130 #define dd2333 133 #define dd3333 136 #define dd00001 139 #define dd00002 142 #define dd00003 145 #define dd00111 148 #define dd00112 151 #define dd00113 154 #define dd00122 157 #define dd00123 160 #define dd00133 163 #define dd00222 166 #define dd00223 169 #define dd00233 172 #define dd00333 175 #define dd11111 178 #define dd11112 181 #define dd11113 184 #define dd11122 187 #define dd11123 190 #define dd11133 193 #define dd11222 196 #define dd11223 199 #define dd11233 202 #define dd11333 205 #define dd12222 208 #define dd12223 211 #define dd12233 214 #define dd12333 217 #define dd13333 220 #define dd22222 223 #define dd22223 226 #define dd22233 229 #define dd22333 232 #define dd23333 235 #define dd33333 238 #define Ndd 240 #define ee0 1 #define ee1 4 #define ee2 7 #define ee3 10 #define ee4 13 #define ee00 16 #define ee11 19 #define ee12 22 #define ee13 25 #define ee14 28 #define ee22 31 #define ee23 34 #define ee24 37 #define ee33 40 #define ee34 43 #define ee44 46 #define ee001 49 #define ee002 52 #define ee003 55 #define ee004 58 #define ee111 61 #define ee112 64 #define ee113 67 #define ee114 70 #define ee122 73 #define ee123 76 #define ee124 79 #define ee133 82 #define ee134 85 #define ee144 88 #define ee222 91 #define ee223 94 #define ee224 97 #define ee233 100 #define ee234 103 #define ee244 106 #define ee333 109 #define ee334 112 #define ee344 115 #define ee444 118 #define ee0000 121 #define ee0011 124 #define ee0012 127 #define ee0013 130 #define ee0014 133 #define ee0022 136 #define ee0023 139 #define ee0024 142 #define ee0033 145 #define ee0034 148 #define ee0044 151 #define ee1111 154 #define ee1112 157 #define ee1113 160 #define ee1114 163 #define ee1122 166 #define ee1123 169 #define ee1124 172 #define ee1133 175 #define ee1134 178 #define ee1144 181 #define ee1222 184 #define ee1223 187 #define ee1224 190 #define ee1233 193 #define ee1234 196 #define ee1244 199 #define ee1333 202 #define ee1334 205 #define ee1344 208 #define ee1444 211 #define ee2222 214 #define ee2223 217 #define ee2224 220 #define ee2233 223 #define ee2234 226 #define ee2244 229 #define ee2333 232 #define ee2334 235 #define ee2344 238 #define ee2444 241 #define ee3333 244 #define ee3334 247 #define ee3344 250 #define ee3444 253 #define ee4444 256 #define Nee 258 #define KeyA0 2**0 #define KeyBget 2**2 #define KeyC0 2**4 #define KeyD0 2**6 #define KeyD0C 2**8 #define KeyE0 2**10 #define KeyEget 2**12 #define KeyEgetC 2**14 #define KeyAll 21845 #define DebugA 2**0 #define DebugB 2**1 #define DebugC 2**2 #define DebugD 2**3 #define DebugE 2**4 #define DebugAll 31 #define memindex integer*8 #define Ccache 0 #define Dcache 0 #endif integer ncaches parameter (ncaches = 10) ComplexType cache(2,ncaches) common /ltvars/ cache ComplexType Aval(1,1), AvalC(1,1) ComplexType Bval(1,1), BvalC(1,1) ComplexType Cval(1,1), CvalC(1,1) ComplexType Dval(1,1), DvalC(1,1) ComplexType Eval(1,1), EvalC(1,1) equivalence (cache(2,1), Aval) equivalence (cache(2,2), AvalC) equivalence (cache(2,3), Bval) equivalence (cache(2,4), BvalC) equivalence (cache(2,5), Cval) equivalence (cache(2,6), CvalC) equivalence (cache(2,7), Dval) equivalence (cache(2,8), DvalC) equivalence (cache(2,9), Eval) equivalence (cache(2,10), EvalC) ComplexType A0, A0C, A00, A00C, B0i, B0iC ComplexType B0, B1, B00, B11, B001, B111 ComplexType B0C, B1C, B00C, B11C, B001C, B111C ComplexType DB0, DB1, DB00, DB11, DB001 ComplexType DB0C, DB1C, DB00C, DB11C, DB001C ComplexType C0, C0C, C0i, C0iC ComplexType D0, D0C, D0i, D0iC ComplexType E0, E0C, E0i, E0iC ComplexType Li2, Li2C, Li2omx, Li2omxC memindex Aget, AgetC, Bget, BgetC, Cget, CgetC memindex Dget, DgetC, Eget, EgetC RealType getmudim, getdelta, getlambda, getminmass RealType getmaxdev integer getepsi, getwarndigits, geterrdigits integer getversionkey, getdebugkey integer getcachelast external A0, A0C, A00, A00C, B0i, B0iC external B0, B1, B00, B11, B001, B111 external B0C, B1C, B00C, B11C, B001C, B111C external DB0, DB1, DB00, DB11, DB001 external DB0C, DB1C, DB00C, DB11C, DB001C external C0, C0C, C0i, C0iC external D0, D0C, D0i, D0iC external E0, E0C, E0i, E0iC external Li2, Li2C, Li2omx, Li2omxC external Aget, AgetC, Bget, BgetC, Cget, CgetC external Dget, DgetC, Eget, EgetC external getmudim, getdelta, getlambda, getminmass external getmaxdev external getepsi, getwarndigits, geterrdigits external getversionkey, getdebugkey external getcachelast LoopTools-2.16/src/include/PaxHeaders/defs.h0000644000000000000000000000007413264372236015773 xustar0030 atime=1648161785.731698531 30 ctime=1648161793.715764879 LoopTools-2.16/src/include/defs.h0000644000000000000000000002766413264372236016725 0ustar00rootroot00000000000000* defs.h * internal definitions for the LoopTools routines * this file is part of LoopTools * last modified 14 Apr 18 th #ifdef COMPLEXPARA #define RC 2 #define ArgType ComplexType #define ArgQuad ComplexQuad #define XAget AgetC #define XAput AputC #define XAputnocache AputnocacheC #define XA0i A0iC #define XA0 A0C #define XA00 A00C #define XAcoeff AcoeffC #define XBpara BparaC #define XBget BgetC #define XBput BputC #define XBputnocache BputnocacheC #define XB0i B0iC #define XB0 B0C #define XB1 B1C #define XB00 B00C #define XB11 B11C #define XB001 B001C #define XB111 B111C #define XDB0 DB0C #define XDB1 DB1C #define XDB00 DB00C #define XDB11 DB11C #define XDB001 DB001C #define XBcoeff BcoeffC #define XBcoeffFF BcoeffFFC #define XC0func C0funcC #define XCpara CparaC #define XCget CgetC #define XCput CputC #define XC0nocache C0nocacheC #define XC0i C0iC #define XC0 C0C #define XCcoefx CcoefxC #define XCcoeff CcoeffC #define XD0func D0funcC #define XDpara DparaC #define XDget DgetC #define XDput DputC #define XD0nocache D0nocacheC #define XD0i D0iC #define XD0 D0C #define XDcoefx DcoefxC #define XDcoeff DcoeffC #define XE0func E0funcC #define XEpara EparaC #define XEget EgetC #define XEput EputC #define XE0nocache E0nocacheC #define XE0i E0iC #define XE0 E0C #define XEcoefx EcoefxC #define XEcoeff EcoeffC #define XEcoeffa EcoeffaC #define XEcoeffb EcoeffbC #define XEcheck EcheckC #define XInvGramE InvGramEC #define XSolve SolveC #define XEigen EigenC #define XDecomp DecompC #define XDet DetmC #define XInverse InverseC #define XDumpPara DumpParaC #define XDumpCoeff DumpCoeffC #define XLi2 Li2C #define XLi2sub li2csub #define XLi2omx Li2omxC #define XLi2omxsub li2omxcsub #define Xfpij2 cfpij2 #define Xffa0 ffca0 #define Xffb0 ffcb0 #define Xffb1 ffcb1 #define Xffb2p ffcb2p #define Xffdb0 ffcdb0 #else #define RC 1 #define ArgType RealType #define ArgQuad RealQuad #define XAget Aget #define XAput Aput #define XAputnocache Aputnocache #define XA0i A0i #define XA0 A0 #define XA00 A00 #define XAcoeff Acoeff #define XBpara Bpara #define XBget Bget #define XBput Bput #define XBputnocache Bputnocache #define XB0i B0i #define XB0 B0 #define XB1 B1 #define XB00 B00 #define XB11 B11 #define XB001 B001 #define XB111 B111 #define XDB0 DB0 #define XDB1 DB1 #define XDB00 DB00 #define XDB11 DB11 #define XDB001 DB001 #define XBcoeff Bcoeff #define XBcoeffFF BcoeffFF #define XC0func C0func #define XCpara Cpara #define XCget Cget #define XCput Cput #define XC0nocache C0nocache #define XC0i C0i #define XC0 C0 #define XCcoefx Ccoefx #define XCcoeff Ccoeff #define XD0func D0func #define XDpara Dpara #define XDget Dget #define XDput Dput #define XD0nocache D0nocache #define XD0i D0i #define XD0 D0 #define XDcoefx Dcoefx #define XDcoeff Dcoeff #define XE0func E0func #define XEpara Epara #define XEget Eget #define XEput Eput #define XE0nocache E0nocache #define XE0i E0i #define XE0 E0 #define XEcoefx Ecoefx #define XEcoeff Ecoeff #define XEcoeffa Ecoeffa #define XEcoeffb Ecoeffb #define XEcheck Echeck #define XInvGramE InvGramE #define XSolve Solve #define XEigen Eigen #define XDecomp Decomp #define XDet Detm #define XInverse Inverse #define XDumpPara DumpPara #define XDumpCoeff DumpCoeff #define XLi2 Li2 #define XLi2sub li2sub #define XLi2omx Li2omx #define XLi2omxsub li2omxsub #define Xfpij2 fpij2 #define Xffa0 ffxa0 #define Xffb0 ffxb0 #define Xffb1 ffxb1 #define Xffb2p ffxb2p #define Xffdb0 ffxdb0 #endif #define Paa 1 #define Pbb 3 #define Pcc 6 #define Pdd 10 #define Pee 15 #define aa0 1 #define AA0 1:3 #define aa00 4 #define AA00 4:6 #define Naa 6 #define bb0 1 #define BB0 1:3 #define bb1 4 #define BB1 4:6 #define bb00 7 #define BB00 7:9 #define bb11 10 #define BB11 10:12 #define bb001 13 #define BB001 13:15 #define bb111 16 #define BB111 16:18 #define dbb0 19 #define DBB0 19:21 #define dbb1 22 #define DBB1 22:24 #define dbb00 25 #define DBB00 25:27 #define dbb11 28 #define DBB11 28:30 #define dbb001 31 #define DBB001 31:33 #define Nbb 33 #define cc0 1 #define CC0 1:3 #define cc1 4 #define CC1 4:6 #define cc2 7 #define CC2 7:9 #define cc00 10 #define CC00 10:12 #define cc11 13 #define CC11 13:15 #define cc12 16 #define CC12 16:18 #define cc22 19 #define CC22 19:21 #define cc001 22 #define CC001 22:24 #define cc002 25 #define CC002 25:27 #define cc111 28 #define CC111 28:30 #define cc112 31 #define CC112 31:33 #define cc122 34 #define CC122 34:36 #define cc222 37 #define CC222 37:39 #define cc0000 40 #define CC0000 40:42 #define cc0011 43 #define CC0011 43:45 #define cc0012 46 #define CC0012 46:48 #define cc0022 49 #define CC0022 49:51 #define cc1111 52 #define CC1111 52:54 #define cc1112 55 #define CC1112 55:57 #define cc1122 58 #define CC1122 58:60 #define cc1222 61 #define CC1222 61:63 #define cc2222 64 #define CC2222 64:66 #define Ncc 66 #define dd0 1 #define DD0 1:3 #define dd1 4 #define DD1 4:6 #define dd2 7 #define DD2 7:9 #define dd3 10 #define DD3 10:12 #define dd00 13 #define DD00 13:15 #define dd11 16 #define DD11 16:18 #define dd12 19 #define DD12 19:21 #define dd13 22 #define DD13 22:24 #define dd22 25 #define DD22 25:27 #define dd23 28 #define DD23 28:30 #define dd33 31 #define DD33 31:33 #define dd001 34 #define DD001 34:36 #define dd002 37 #define DD002 37:39 #define dd003 40 #define DD003 40:42 #define dd111 43 #define DD111 43:45 #define dd112 46 #define DD112 46:48 #define dd113 49 #define DD113 49:51 #define dd122 52 #define DD122 52:54 #define dd123 55 #define DD123 55:57 #define dd133 58 #define DD133 58:60 #define dd222 61 #define DD222 61:63 #define dd223 64 #define DD223 64:66 #define dd233 67 #define DD233 67:69 #define dd333 70 #define DD333 70:72 #define dd0000 73 #define DD0000 73:75 #define dd0011 76 #define DD0011 76:78 #define dd0012 79 #define DD0012 79:81 #define dd0013 82 #define DD0013 82:84 #define dd0022 85 #define DD0022 85:87 #define dd0023 88 #define DD0023 88:90 #define dd0033 91 #define DD0033 91:93 #define dd1111 94 #define DD1111 94:96 #define dd1112 97 #define DD1112 97:99 #define dd1113 100 #define DD1113 100:102 #define dd1122 103 #define DD1122 103:105 #define dd1123 106 #define DD1123 106:108 #define dd1133 109 #define DD1133 109:111 #define dd1222 112 #define DD1222 112:114 #define dd1223 115 #define DD1223 115:117 #define dd1233 118 #define DD1233 118:120 #define dd1333 121 #define DD1333 121:123 #define dd2222 124 #define DD2222 124:126 #define dd2223 127 #define DD2223 127:129 #define dd2233 130 #define DD2233 130:132 #define dd2333 133 #define DD2333 133:135 #define dd3333 136 #define DD3333 136:138 #define dd00001 139 #define DD00001 139:141 #define dd00002 142 #define DD00002 142:144 #define dd00003 145 #define DD00003 145:147 #define dd00111 148 #define DD00111 148:150 #define dd00112 151 #define DD00112 151:153 #define dd00113 154 #define DD00113 154:156 #define dd00122 157 #define DD00122 157:159 #define dd00123 160 #define DD00123 160:162 #define dd00133 163 #define DD00133 163:165 #define dd00222 166 #define DD00222 166:168 #define dd00223 169 #define DD00223 169:171 #define dd00233 172 #define DD00233 172:174 #define dd00333 175 #define DD00333 175:177 #define dd11111 178 #define DD11111 178:180 #define dd11112 181 #define DD11112 181:183 #define dd11113 184 #define DD11113 184:186 #define dd11122 187 #define DD11122 187:189 #define dd11123 190 #define DD11123 190:192 #define dd11133 193 #define DD11133 193:195 #define dd11222 196 #define DD11222 196:198 #define dd11223 199 #define DD11223 199:201 #define dd11233 202 #define DD11233 202:204 #define dd11333 205 #define DD11333 205:207 #define dd12222 208 #define DD12222 208:210 #define dd12223 211 #define DD12223 211:213 #define dd12233 214 #define DD12233 214:216 #define dd12333 217 #define DD12333 217:219 #define dd13333 220 #define DD13333 220:222 #define dd22222 223 #define DD22222 223:225 #define dd22223 226 #define DD22223 226:228 #define dd22233 229 #define DD22233 229:231 #define dd22333 232 #define DD22333 232:234 #define dd23333 235 #define DD23333 235:237 #define dd33333 238 #define DD33333 238:240 #define Ndd 240 #define ee0 1 #define EE0 1:3 #define ee1 4 #define EE1 4:6 #define ee2 7 #define EE2 7:9 #define ee3 10 #define EE3 10:12 #define ee4 13 #define EE4 13:15 #define ee00 16 #define EE00 16:18 #define ee11 19 #define EE11 19:21 #define ee12 22 #define EE12 22:24 #define ee13 25 #define EE13 25:27 #define ee14 28 #define EE14 28:30 #define ee22 31 #define EE22 31:33 #define ee23 34 #define EE23 34:36 #define ee24 37 #define EE24 37:39 #define ee33 40 #define EE33 40:42 #define ee34 43 #define EE34 43:45 #define ee44 46 #define EE44 46:48 #define ee001 49 #define EE001 49:51 #define ee002 52 #define EE002 52:54 #define ee003 55 #define EE003 55:57 #define ee004 58 #define EE004 58:60 #define ee111 61 #define EE111 61:63 #define ee112 64 #define EE112 64:66 #define ee113 67 #define EE113 67:69 #define ee114 70 #define EE114 70:72 #define ee122 73 #define EE122 73:75 #define ee123 76 #define EE123 76:78 #define ee124 79 #define EE124 79:81 #define ee133 82 #define EE133 82:84 #define ee134 85 #define EE134 85:87 #define ee144 88 #define EE144 88:90 #define ee222 91 #define EE222 91:93 #define ee223 94 #define EE223 94:96 #define ee224 97 #define EE224 97:99 #define ee233 100 #define EE233 100:102 #define ee234 103 #define EE234 103:105 #define ee244 106 #define EE244 106:108 #define ee333 109 #define EE333 109:111 #define ee334 112 #define EE334 112:114 #define ee344 115 #define EE344 115:117 #define ee444 118 #define EE444 118:120 #define ee0000 121 #define EE0000 121:123 #define ee0011 124 #define EE0011 124:126 #define ee0012 127 #define EE0012 127:129 #define ee0013 130 #define EE0013 130:132 #define ee0014 133 #define EE0014 133:135 #define ee0022 136 #define EE0022 136:138 #define ee0023 139 #define EE0023 139:141 #define ee0024 142 #define EE0024 142:144 #define ee0033 145 #define EE0033 145:147 #define ee0034 148 #define EE0034 148:150 #define ee0044 151 #define EE0044 151:153 #define ee1111 154 #define EE1111 154:156 #define ee1112 157 #define EE1112 157:159 #define ee1113 160 #define EE1113 160:162 #define ee1114 163 #define EE1114 163:165 #define ee1122 166 #define EE1122 166:168 #define ee1123 169 #define EE1123 169:171 #define ee1124 172 #define EE1124 172:174 #define ee1133 175 #define EE1133 175:177 #define ee1134 178 #define EE1134 178:180 #define ee1144 181 #define EE1144 181:183 #define ee1222 184 #define EE1222 184:186 #define ee1223 187 #define EE1223 187:189 #define ee1224 190 #define EE1224 190:192 #define ee1233 193 #define EE1233 193:195 #define ee1234 196 #define EE1234 196:198 #define ee1244 199 #define EE1244 199:201 #define ee1333 202 #define EE1333 202:204 #define ee1334 205 #define EE1334 205:207 #define ee1344 208 #define EE1344 208:210 #define ee1444 211 #define EE1444 211:213 #define ee2222 214 #define EE2222 214:216 #define ee2223 217 #define EE2223 217:219 #define ee2224 220 #define EE2224 220:222 #define ee2233 223 #define EE2233 223:225 #define ee2234 226 #define EE2234 226:228 #define ee2244 229 #define EE2244 229:231 #define ee2333 232 #define EE2333 232:234 #define ee2334 235 #define EE2334 235:237 #define ee2344 238 #define EE2344 238:240 #define ee2444 241 #define EE2444 241:243 #define ee3333 244 #define EE3333 244:246 #define ee3334 247 #define EE3334 247:249 #define ee3344 250 #define EE3344 250:252 #define ee3444 253 #define EE3444 253:255 #define ee4444 256 #define EE4444 256:258 #define Nee 258 #define KeyA0 0 #define KeyBget 2 #define KeyC0 4 #define KeyD0 6 #define KeyD0C 8 #define KeyE0 10 #define KeyEget 12 #define KeyEgetC 14 #define DebugA 0 #define DebugB 1 #define DebugC 2 #define DebugD 3 #define DebugE 4 #define memindex integer*8 #define Ano RC #define Bno RC+2 #define Cno RC+4 #define Dno RC+6 #define Eno RC+8 #define Aval(id,p) cache(p+id,Ano) #define Bval(id,p) cache(p+id,Bno) #define Cval(id,p) cache(p+id,Cno) #define Dval(id,p) cache(p+id,Dno) #define Eval(id,p) cache(p+id,Eno) #define offsetC 2 #define M(i) para(1,i) #define P(i) para(1,i+npoint) #define Sgn(i) (1-2*iand(i,1)) #define ln(x,s) log(x+(s)*cIeps) #define lnrat(x,y) log((x-cIeps)/(y-cIeps)) #define MAXDIM 8 *#define WARNINGS LoopTools-2.16/src/include/PaxHeaders/looptools.h0000644000000000000000000000013113722121664017072 xustar0029 mtime=1598596020.61349909 30 atime=1648161785.731698531 30 ctime=1648161793.715764879 LoopTools-2.16/src/include/looptools.h0000644000000000000000000001361013722121664020014 0ustar00rootroot00000000000000#if 0 looptools.h the header file for Fortran with all definitions for LoopTools this file is part of LoopTools last modified 28 Aug 20 th #endif #ifndef LOOPTOOLS_H #define LOOPTOOLS_H #define aa0 1 #define aa00 4 #define Naa 6 #define bb0 1 #define bb1 4 #define bb00 7 #define bb11 10 #define bb001 13 #define bb111 16 #define dbb0 19 #define dbb1 22 #define dbb00 25 #define dbb11 28 #define dbb001 31 #define Nbb 33 #define cc0 1 #define cc1 4 #define cc2 7 #define cc00 10 #define cc11 13 #define cc12 16 #define cc22 19 #define cc001 22 #define cc002 25 #define cc111 28 #define cc112 31 #define cc122 34 #define cc222 37 #define cc0000 40 #define cc0011 43 #define cc0012 46 #define cc0022 49 #define cc1111 52 #define cc1112 55 #define cc1122 58 #define cc1222 61 #define cc2222 64 #define Ncc 66 #define dd0 1 #define dd1 4 #define dd2 7 #define dd3 10 #define dd00 13 #define dd11 16 #define dd12 19 #define dd13 22 #define dd22 25 #define dd23 28 #define dd33 31 #define dd001 34 #define dd002 37 #define dd003 40 #define dd111 43 #define dd112 46 #define dd113 49 #define dd122 52 #define dd123 55 #define dd133 58 #define dd222 61 #define dd223 64 #define dd233 67 #define dd333 70 #define dd0000 73 #define dd0011 76 #define dd0012 79 #define dd0013 82 #define dd0022 85 #define dd0023 88 #define dd0033 91 #define dd1111 94 #define dd1112 97 #define dd1113 100 #define dd1122 103 #define dd1123 106 #define dd1133 109 #define dd1222 112 #define dd1223 115 #define dd1233 118 #define dd1333 121 #define dd2222 124 #define dd2223 127 #define dd2233 130 #define dd2333 133 #define dd3333 136 #define dd00001 139 #define dd00002 142 #define dd00003 145 #define dd00111 148 #define dd00112 151 #define dd00113 154 #define dd00122 157 #define dd00123 160 #define dd00133 163 #define dd00222 166 #define dd00223 169 #define dd00233 172 #define dd00333 175 #define dd11111 178 #define dd11112 181 #define dd11113 184 #define dd11122 187 #define dd11123 190 #define dd11133 193 #define dd11222 196 #define dd11223 199 #define dd11233 202 #define dd11333 205 #define dd12222 208 #define dd12223 211 #define dd12233 214 #define dd12333 217 #define dd13333 220 #define dd22222 223 #define dd22223 226 #define dd22233 229 #define dd22333 232 #define dd23333 235 #define dd33333 238 #define Ndd 240 #define ee0 1 #define ee1 4 #define ee2 7 #define ee3 10 #define ee4 13 #define ee00 16 #define ee11 19 #define ee12 22 #define ee13 25 #define ee14 28 #define ee22 31 #define ee23 34 #define ee24 37 #define ee33 40 #define ee34 43 #define ee44 46 #define ee001 49 #define ee002 52 #define ee003 55 #define ee004 58 #define ee111 61 #define ee112 64 #define ee113 67 #define ee114 70 #define ee122 73 #define ee123 76 #define ee124 79 #define ee133 82 #define ee134 85 #define ee144 88 #define ee222 91 #define ee223 94 #define ee224 97 #define ee233 100 #define ee234 103 #define ee244 106 #define ee333 109 #define ee334 112 #define ee344 115 #define ee444 118 #define ee0000 121 #define ee0011 124 #define ee0012 127 #define ee0013 130 #define ee0014 133 #define ee0022 136 #define ee0023 139 #define ee0024 142 #define ee0033 145 #define ee0034 148 #define ee0044 151 #define ee1111 154 #define ee1112 157 #define ee1113 160 #define ee1114 163 #define ee1122 166 #define ee1123 169 #define ee1124 172 #define ee1133 175 #define ee1134 178 #define ee1144 181 #define ee1222 184 #define ee1223 187 #define ee1224 190 #define ee1233 193 #define ee1234 196 #define ee1244 199 #define ee1333 202 #define ee1334 205 #define ee1344 208 #define ee1444 211 #define ee2222 214 #define ee2223 217 #define ee2224 220 #define ee2233 223 #define ee2234 226 #define ee2244 229 #define ee2333 232 #define ee2334 235 #define ee2344 238 #define ee2444 241 #define ee3333 244 #define ee3334 247 #define ee3344 250 #define ee3444 253 #define ee4444 256 #define Nee 258 #define KeyA0 2**0 #define KeyBget 2**2 #define KeyC0 2**4 #define KeyD0 2**6 #define KeyD0C 2**8 #define KeyE0 2**10 #define KeyEget 2**12 #define KeyEgetC 2**14 #define KeyAll 21845 #define DebugA 2**0 #define DebugB 2**1 #define DebugC 2**2 #define DebugD 2**3 #define DebugE 2**4 #define DebugAll 31 #define memindex integer*8 #ifndef ComplexType #define ComplexType double complex #endif #ifndef RealType #define RealType double precision #endif #define Aval(id,p) cache(p+id,1) #define AvalC(id,p) cache(p+id,2) #define Bval(id,p) cache(p+id,3) #define BvalC(id,p) cache(p+id,4) #define Cval(id,p) cache(p+id,5) #define CvalC(id,p) cache(p+id,6) #define Dval(id,p) cache(p+id,7) #define DvalC(id,p) cache(p+id,8) #define Eval(id,p) cache(p+id,9) #define EvalC(id,p) cache(p+id,10) #define Ccache 0 #define Dcache 0 #endif integer ncaches parameter (ncaches = 10) ComplexType cache(2,ncaches) common /ltvars/ cache ComplexType A0i, A0iC, A0, A0C, A00, A00C, B0i, B0iC ComplexType B0, B1, B00, B11, B001, B111 ComplexType B0C, B1C, B00C, B11C, B001C, B111C ComplexType DB0, DB1, DB00, DB11, DB001 ComplexType DB0C, DB1C, DB00C, DB11C, DB001C ComplexType C0, C0C, C0i, C0iC ComplexType D0, D0C, D0i, D0iC ComplexType E0, E0C, E0i, E0iC ComplexType Li2, Li2C, Li2omx, Li2omxC memindex Aget, AgetC, Bget, BgetC, Cget, CgetC memindex Dget, DgetC, Eget, EgetC RealType getmudim, getdelta, getlambda, getminmass RealType getmaxdev integer getepsi, getwarndigits, geterrdigits integer getversionkey, getdebugkey integer getcachelast external A0i, A0iC, A0, A0C, A00, A00C, B0i, B0iC external B0, B1, B00, B11, B001, B111 external B0C, B1C, B00C, B11C, B001C, B111C external DB0, DB1, DB00, DB11, DB001 external DB0C, DB1C, DB00C, DB11C, DB001C external C0, C0C, C0i, C0iC external D0, D0C, D0i, D0iC external E0, E0C, E0i, E0iC external Li2, Li2C, Li2omx, Li2omxC external Aget, AgetC, Bget, BgetC, Cget, CgetC external Dget, DgetC, Eget, EgetC external getmudim, getdelta, getlambda, getminmass external getmaxdev external getepsi, getwarndigits, geterrdigits external getversionkey, getdebugkey external getcachelast LoopTools-2.16/src/include/PaxHeaders/fferr.h0000644000000000000000000000007411776502523016156 xustar0030 atime=1648161785.731698531 30 ctime=1648161793.715764879 LoopTools-2.16/src/include/fferr.h0000644000000000000000000002517711776502523017105 0ustar00rootroot00000000000000 character*80 e1 parameter (e1="ffca0: minimum value complex logarit"// + "hm gives problem, change mu.") character*80 e2 parameter (e2="ffxa0: minimum value real logarithm "// + "gives problem, change mu.") character*80 e3 parameter (e3="ffcb0: minimum value complex logarit"// + "hm gives problem, change mu.") character*80 e4 parameter (e4="ffxb0: minimum value real logarithm "// + "gives problem, change mu.") character*80 e5 parameter (e5="ffcb0p: cannot handle complex k^2 yet") character*80 e6 parameter (e6="ffcb0p: minimum value complex log giv"// + "es problem in unequal masses.") character*80 e7 parameter (e7="ffxb0p: divergence for k->0, m1=m2=0.") character*80 e8 parameter (e8="ffxb0p: minimum value real log gives "// + "problem in equal masses.") character*80 e9 parameter (e9="ffxb0p: minimum value real log gives "// + "problem in unequal masses.") character*80 e10 parameter (e10="ffcc0p: cannot handle two spacelike m"// + "omenta and one zero.") character*80 e11 parameter (e11="ffxc0p: cannot handle two spacelike m"// + "omenta and one zero.") character*80 e12 parameter (e12="ffcs3: illegal code for isoort(1) (s"// + "hould not occur)") character*80 e13 parameter (e13="ffcs3: illegal code for isoort(2) (s"// + "hould not occur)") character*80 e14 parameter (e14="ffcs3: imaginary part wrong, will be"// + " improved later") character*80 e15 parameter (e15="ffcs3: isoort = -1,0 not yet ready") character*80 e16 parameter (e16="ffcs3: illegal combination in isoort"// + " (should not occur)") character*80 e17 parameter (e17="ffcxs3: illegal code for isoort(1) (s"// + "hould not occur)") character*80 e18 parameter (e18="ffcxs3: illegal code for isoort(2) (s"// + "hould not occur)") character*80 e19 parameter (e19="ffcs4: imaginary part is wrong (shou"// + "ld be updated)") character*80 e20 parameter (e20="ffdcrr: Taylor expansion in 1/x not y"// + "et ready") character*80 e21 parameter (e21="ffdcxr: imaginary part is wrong") character*80 e22 parameter (e22="ffdcxr: Taylor expansion in 1/x not y"// + "et ready") character*80 e23 parameter (e23="ffcrr: minimum value complex log cau"// + "ses correction term to be wrong.") character*80 e24 parameter (e24="ffcxr: minimum value real log causes"// + " correction term to be wrong.") character*80 e25 parameter (e25="ffcrr: illegal code for iclas1 (shou"// + "ld not occur)") character*80 e26 parameter (e26="ffcxr: illegal code for iclas1 (shou"// + "ld not occur)") character*80 e27 parameter (e27="ffcrr: illegal code for iclas2 (shou"// + "ld not occur)") character*80 e28 parameter (e28="ffcxr: illegal code for iclas2 (shou"// + "ld not occur)") character*80 e29 parameter (e29="ffxli2: argument too large (should no"// + "t occur)") character*80 e30 parameter (e30="ffzli2: argument too large (should no"// + "t occur)") character*80 e31 parameter (e31="ffzzdl: imaginary part dilog is undef"// + "ined for real x > 1.") character*80 e32 parameter (e32="nffeta: eta is not defined for real n"// + "egative numbers a,b, ab.") character*80 e33 parameter (e33="nffet1: eta is not defined for real n"// + "egative numbers a,b, ab.") character*80 e34 parameter (e34="ffcota: illegal flag (should not occu"// + "r)") character*80 e35 parameter (e35="ffrota: illegal flag (should not occu"// + "r)") character*80 e36 parameter (e36="ffccyz: I took the wrong value for ca"// + "lpha... (should not occur)") character*80 e37 parameter (e37="ffxxyz: I took the wrong value for al"// + "pha... (should not occur)") character*80 e38 parameter (e38="ffcoot: a=0, trying to find two roots"// + " of a linear equation ...") character*80 e39 parameter (e39="ffroot: a=0, trying to find two roots"// + " of a linear equation ...") character*80 e40 parameter (e40="ffrot3: all three external masses zer"// + "o !") character*80 e41 parameter (e41="ffxc0: lambda(p1,p2,p3) < 0, unphysi"// + "cal configuration") character*80 e42 parameter (e42="ffxc0: cannot handle this case (p1,p"// + "2,p3 dependent, on threshold)") character*80 e43 parameter (e43="ffcxs3: illegal code for isoort(1) (s"// + "hould not occur)") character*80 e44 parameter (e44="ffxd0: lambda(p1,p2,p3,p4) < 0, unph"// + "ysical configuration") character*80 e45 parameter (e45="ffxd0: cannot handle this case (p1,p"// + "2,p3 dependent, on threshold)") character*80 e46 parameter (e46="ffxd0p: correction terms for Ai <0 in"// + "finite (mass zero?)") character*80 e47 parameter (e47="ffcxyz: p_i^2 = 0 (should not occur)") character*80 e48 parameter (e48="ffeta: answer not consistent with no"// + "rmal result (old)") character*80 e49 parameter (e49="ffcc0: cannot handle complex externa"// + "l momenta or im > 0") character*80 e50 parameter (e50="ffcd0: cannot handle complex externa"// + "l momenta.") character*80 e51 parameter (e51="zfflog: imaginary part undefined for "// + "real z < 0.") character*80 e52 parameter (e52="zxfflg: imaginary part undefined for "// + "x < 0.") character*80 e53 parameter (e53="ffcs3: eta changes within (0,1), add"// + " sophisticated terms...") character*80 e54 parameter (e54="ffrot4: cannot find any physical vert"// + "ex to apply transformation.") character*80 e55 parameter (e55="fftra0: too many vectors parallel, p_"// + "1.p_7 or p_2.p_7 is zero.") character*80 e56 parameter (e56="zfflog: tiny imaginary part in confli"// + "ct with ieps prescription.") character*80 e57 parameter (e57="ffxe0: lambda(p1,p2,p3,p4,p5) < 0, u"// + "nphysical") character*80 e58 parameter (e58="ffxc0j: IR divergent C0 with lambda(p"// + "1,p2,p3)=0.") character*80 e59 parameter (e59="ffxc0i: IR divergent C0 with lambda2=0.") character*80 e60 parameter (e60="ffxc0j: IR divergent C0 obtained from"// + " D0 is singular. Contact author.") character*80 e61 parameter (e61="ffxd0p: IR divergent D0 with lambda2=0.") character*80 e62 parameter (e62="ffxc0p: I never expected complex root"// + "s in an IR divergent diagram.") character*80 e63 parameter (e63="ffxd0p: can only handle one IR diverg"// + "ence per 3point function") character*80 e64 parameter (e64="ffxd0p: cannot handle a threshold in"// + " (3,4), rotated wrongly.") character*80 e65 parameter (e65="ffcxr: IR divergence but iclass!=3. "// + " should not occur.") character*80 e66 parameter (e66="ffcxs3: different imaginary signs sho"// + "uld not occur for ipole=3.") character*80 e67 parameter (e67="ffxdbd: I cannot use this algorithm f"// + "or a linear IR divergence") character*80 e68 parameter (e68="ffxd0: cannot find a proj. transform"// + "ation; try another permutation.") character*80 e69 parameter (e69="ff5ind: could not find independent mo"// + "menta (should not occur).") character*80 e70 parameter (e70="ffxdna: lambda(pi,pj,pk) < 0, unphysi"// + "cal configuration") character*80 e71 parameter (e71="ffxdna: cannot handle lambda(pi,pj,pk"// + ") = 0, dependent momenta.") character*80 e72 parameter (e72="ffxd0e: could not find a stable root;"// + " please try another permutation") character*80 e73 parameter (e73="ffxdir: cannot handle a linearly dive"// + "rgent four point function (yet)") character*80 e74 parameter (e74="ffxdbd: IR divergent B0' without cuto"// + "ff in /ffregul/") character*80 e75 parameter (e75="ffdcxr: dyz=0, should not occur") character*80 e76 parameter (e76="ffdcrr: cdwz=0, but iepsz!=iepsz and "// + "significant") character*80 e77 parameter (e77="ffdcrr: cdyz=0, should not occur") character*80 e78 parameter (e78="ffdcc0: imaginary part wrong") character*80 e79 parameter (e79="ffdcs: cannot handle isoort=0") character*80 e80 parameter (e80="ffdcs: mixed up iep's, 2*pi^2 wrong "// + "somewhere") character*80 e81 parameter (e81="ffdcs: wrong value for isoort") character*80 e82 parameter (e82="ffdxc0: imaginary part Ai < 0 terms unc"// + "ertain") character*80 e83 parameter (e83="ffxc0j: sorry, complex roots not yet "// + "supported here") character*80 e84 parameter (e84="ffxc0p: imaginary part Ai < 0 terms unc"// + "ertain") character*80 e85 parameter (e85="ffxd0a: t3 = t4, don''t know what to do") character*80 e86 parameter (e86="ffxdbp: cannot compute derivative, la"// + "m=0") character*80 e87 parameter (e87="ffxdi: dependent momenta not yet sup"// + "ported (boundary of phase space)") character*80 e88 parameter (e88="ffxxyz: xk = 0 not yet implemented") character*80 e92 parameter (e92="ffxc1: cannot invert matrix with zer"// + "o determinant.") character*80 e93 parameter (e93="ffze0: Im(m^2) > 0") character*80 e94 parameter (e94="ffze0: Im(p^2) != 0") character*80 e95 parameter (e95="ffzf0: Im(m^2) > 0") character*80 e96 parameter (e96="ffzf0: Im(p^2) != 0") character*80 e97 parameter (e97="ffxc0j: ill-defined IR-divergent C0 "// + "for massless charged particles.") character*80 e98 parameter (e98="ffxdbd: ill-defined IR-divergent D0 "// + "for massless charged particles.") character*80 e100 parameter (e100="ffrcvr: probably underflow, I do"// + " not know where or how severe.") character*80 e101 parameter (e101="ffxdb1: case not defined") character*80 e102 parameter (e102="ffxdb11: case not defined") character*80 e103 parameter (e103="ffd0c: cannot handle this case") character*80 e104 parameter (e104="ffwbeta: prefactor 1/(SV-TU) = 1/0 "// + "for all y") character*80 e105 parameter (e105="ffT_lin: prefactor 1/(SV-TU) = 1/0 "// + "for all y") character*80 e99 parameter (e99="ffT13: prefactor 1/(SV-TU) = 1/0 "// + "for all y") character*80 e89 parameter (e89="ffS2: log(0) singularity") character*80 e90 parameter (e90="ffS3n: end-point singularity") character*80 e91 parameter (e91="ffS3n: log(0) singularity") character*80 error(105) data error / e1,e2,e3,e4,e5,e6,e7,e8,e9, + e10,e11,e12,e13,e14,e15,e16,e17,e18,e19, + e20,e21,e22,e23,e24,e25,e26,e27,e28,e29, + e30,e31,e32,e33,e34,e35,e36,e37,e38,e39, + e40,e41,e42,e43,e44,e45,e46,e47,e48,e49, + e50,e51,e52,e53,e54,e55,e56,e57,e58,e59, + e60,e61,e62,e63,e64,e65,e66,e67,e68,e69, + e70,e71,e72,e73,e74,e75,e76,e77,e78,e79, + e80,e81,e82,e83,e84,e85,e86,e87,e88,e89, + e90,e91,e92,e93,e94,e95,e96,e97,e98,e99, + e100,e101,e102,e103,e104,e105 / LoopTools-2.16/src/include/PaxHeaders/ltnames.h0000644000000000000000000000007413266126736016521 xustar0030 atime=1648161785.731698531 30 ctime=1648161793.715764879 LoopTools-2.16/src/include/ltnames.h0000644000000000000000000000017513266126736017437 0ustar00rootroot00000000000000 character*6 paraname(Pee,1:5) common /paranames/ paraname character*10 coeffname(Nee,1:5) common /coeffnames/ coeffname LoopTools-2.16/src/include/PaxHeaders/cexternals.h0000644000000000000000000000013213722121553017206 xustar0030 mtime=1598595947.173981901 30 atime=1648161785.731698531 30 ctime=1648161793.715764879 LoopTools-2.16/src/include/cexternals.h0000644000000000000000000000041213722121553020123 0ustar00rootroot00000000000000#if 0 This file was generated by mkexternalsh on Fri 28 Aug 2020 08:25:47 AM CEST. Do not edit. #endif #if NOUNDERSCORE #define cachecopy ljcachecopy #define cacheindex ljcacheindex #else #define cachecopy_ ljcachecopy_ #define cacheindex_ ljcacheindex_ #endif LoopTools-2.16/src/include/PaxHeaders/clooptools.h.in0000644000000000000000000000013214217075453017647 xustar0030 mtime=1648130859.401326668 30 atime=1648161785.731698531 30 ctime=1648161793.715764879 LoopTools-2.16/src/include/clooptools.h.in0000644000000000000000000005324314217075453020576 0ustar00rootroot00000000000000/* clooptools.h the C/C++ header file with all definitions for LoopTools this file is part of LoopTools last modified 24 Mar 22 th */ #ifndef CLOOPTOOLS_H #define CLOOPTOOLS_H #define aa0 0 #define aa00 3 #define Naa 6 #define bb0 0 #define bb1 3 #define bb00 6 #define bb11 9 #define bb001 12 #define bb111 15 #define dbb0 18 #define dbb1 21 #define dbb00 24 #define dbb11 27 #define dbb001 30 #define Nbb 33 #define cc0 0 #define cc1 3 #define cc2 6 #define cc00 9 #define cc11 12 #define cc12 15 #define cc22 18 #define cc001 21 #define cc002 24 #define cc111 27 #define cc112 30 #define cc122 33 #define cc222 36 #define cc0000 39 #define cc0011 42 #define cc0012 45 #define cc0022 48 #define cc1111 51 #define cc1112 54 #define cc1122 57 #define cc1222 60 #define cc2222 63 #define Ncc 66 #define dd0 0 #define dd1 3 #define dd2 6 #define dd3 9 #define dd00 12 #define dd11 15 #define dd12 18 #define dd13 21 #define dd22 24 #define dd23 27 #define dd33 30 #define dd001 33 #define dd002 36 #define dd003 39 #define dd111 42 #define dd112 45 #define dd113 48 #define dd122 51 #define dd123 54 #define dd133 57 #define dd222 60 #define dd223 63 #define dd233 66 #define dd333 69 #define dd0000 72 #define dd0011 75 #define dd0012 78 #define dd0013 81 #define dd0022 84 #define dd0023 87 #define dd0033 90 #define dd1111 93 #define dd1112 96 #define dd1113 99 #define dd1122 102 #define dd1123 105 #define dd1133 108 #define dd1222 111 #define dd1223 114 #define dd1233 117 #define dd1333 120 #define dd2222 123 #define dd2223 126 #define dd2233 129 #define dd2333 132 #define dd3333 135 #define dd00001 138 #define dd00002 141 #define dd00003 144 #define dd00111 147 #define dd00112 150 #define dd00113 153 #define dd00122 156 #define dd00123 159 #define dd00133 162 #define dd00222 165 #define dd00223 168 #define dd00233 171 #define dd00333 174 #define dd11111 177 #define dd11112 180 #define dd11113 183 #define dd11122 186 #define dd11123 189 #define dd11133 192 #define dd11222 195 #define dd11223 198 #define dd11233 201 #define dd11333 204 #define dd12222 207 #define dd12223 210 #define dd12233 213 #define dd12333 216 #define dd13333 219 #define dd22222 222 #define dd22223 225 #define dd22233 228 #define dd22333 231 #define dd23333 234 #define dd33333 237 #define Ndd 240 #define ee0 0 #define ee1 3 #define ee2 6 #define ee3 9 #define ee4 12 #define ee00 15 #define ee11 18 #define ee12 21 #define ee13 24 #define ee14 27 #define ee22 30 #define ee23 33 #define ee24 36 #define ee33 39 #define ee34 42 #define ee44 45 #define ee001 48 #define ee002 51 #define ee003 54 #define ee004 57 #define ee111 60 #define ee112 63 #define ee113 66 #define ee114 69 #define ee122 72 #define ee123 75 #define ee124 78 #define ee133 81 #define ee134 84 #define ee144 87 #define ee222 90 #define ee223 93 #define ee224 96 #define ee233 99 #define ee234 102 #define ee244 105 #define ee333 108 #define ee334 111 #define ee344 114 #define ee444 117 #define ee0000 120 #define ee0011 123 #define ee0012 126 #define ee0013 129 #define ee0014 132 #define ee0022 135 #define ee0023 138 #define ee0024 141 #define ee0033 144 #define ee0034 147 #define ee0044 150 #define ee1111 153 #define ee1112 156 #define ee1113 159 #define ee1114 162 #define ee1122 165 #define ee1123 168 #define ee1124 171 #define ee1133 174 #define ee1134 177 #define ee1144 180 #define ee1222 183 #define ee1223 186 #define ee1224 189 #define ee1233 192 #define ee1234 195 #define ee1244 198 #define ee1333 201 #define ee1334 204 #define ee1344 207 #define ee1444 210 #define ee2222 213 #define ee2223 216 #define ee2224 219 #define ee2233 222 #define ee2234 225 #define ee2244 228 #define ee2333 231 #define ee2334 234 #define ee2344 237 #define ee2444 240 #define ee3333 243 #define ee3334 246 #define ee3344 249 #define ee3444 252 #define ee4444 255 #define Nee 258 enum { KeyA0 = 1, KeyBget = 1<<2, KeyC0 = 1<<4, KeyD0 = 1<<6, KeyE0 = 1<<8, KeyEget = 1<<10, KeyEgetC = 1<<12, KeyAll = KeyA0 + KeyBget + KeyC0 + KeyD0 + KeyE0 + KeyEget + KeyEgetC }; enum { DebugA = 1, DebugB = 1<<1, DebugC = 1<<2, DebugD = 1<<3, DebugE = 1<<4, DebugAll = DebugA + DebugB + DebugC + DebugD + DebugE }; typedef long long int memindex; /****************************************************************/ #ifdef __cplusplus extern "C" { #endif #define CACHEPTR(n,i) &FORTRAN(ltvars).cache[n][i] #define EPSINDEX(i) i+FORTRAN(ltvars).epsi enum { ltvars_ncache = 10 }; extern struct { /* MUST match common block ltvars in lt.h! */ COMPLEX cache[ltvars_ncache][2]; INTEGER8 savedptr[ltvars_ncache][2]; REAL maxdev; INTEGER epsi, warndigits, errdigits; INTEGER serial, versionkey; INTEGER debugkey, debugfrom, debugto; } FORTRAN(ltvars); #define _lt_Cr_(v) cRealType v #define _lt_Cc_(v) cComplexType v #define _lt_Fr_(v) CREAL *v #define _lt_Fc_(v) CCOMPLEX *v #define _lt_Id_(v) v #if QUAD && CQUADSIZE != QUADSIZE #define _lt_CFr_(v) v##_ = ToREAL(v) #define _lt_CFc_(v) v##_ = {ToREAL(Re(v)), ToREAL(Im(v))} #define _lt_Frp_(v) &v##_ #define _lt_Fcp_(v) &v##_ #define _lt_Fap_(v) v##_ #define _lt_Frd_(f) CREAL f(_lt_CFr_); #define _lt_Fcd_(f) CCOMPLEX f(_lt_CFc_); #define _lt_Fad_(v,n) COMPLEX v##_[n]; #define _lt_Fax_(v,n) ToRealArray((RealType *)v, (REAL *)v##_, 2*n); #else #define _lt_Frp_(v) &v #define _lt_Fcp_(v) (CCOMPLEX *)&v #define _lt_Fap_(v) (COMPLEX *)v #define _lt_Frd_(f) #define _lt_Fcd_(f) #define _lt_Fad_(v,n) #define _lt_Fax_(v,n) #endif /****************************************************************/ #define AARGS(t) t(m) static inline memindex Aget(AARGS(_lt_Cr_)) { _lt_Frd_(AARGS) extern memindex FORTRAN(aget)(AARGS(_lt_Fr_)); return FORTRAN(aget)(AARGS(_lt_Frp_)); } static inline memindex AgetC(AARGS(_lt_Cc_)) { _lt_Fcd_(AARGS) extern memindex FORTRAN(agetc)(AARGS(_lt_Fc_)); return FORTRAN(agetc)(AARGS(_lt_Fcp_)); } static inline void Aput(ComplexType *res, AARGS(_lt_Cr_)) { _lt_Frd_(AARGS) _lt_Fad_(res, Naa) extern void FORTRAN(aput)(COMPLEX *res, AARGS(_lt_Fr_)); FORTRAN(aput)(_lt_Fap_(res), AARGS(_lt_Frp_)); _lt_Fax_(res, Naa) } static inline void AputC(ComplexType *res, AARGS(_lt_Cc_)) { _lt_Fcd_(AARGS) _lt_Fad_(res, Naa) extern void FORTRAN(aputc)(COMPLEX *res, AARGS(_lt_Fc_)); FORTRAN(aputc)(_lt_Fap_(res), AARGS(_lt_Fcp_)); _lt_Fax_(res, Naa) } static inline void Aputnocache(ComplexType *res, AARGS(_lt_Cr_)) { _lt_Frd_(AARGS) _lt_Fad_(res, Naa) extern void FORTRAN(aputnocache)(COMPLEX *res, AARGS(_lt_Fr_)); FORTRAN(aputnocache)(_lt_Fap_(res), AARGS(_lt_Frp_)); _lt_Fax_(res, Naa) } static inline void AputnocacheC(ComplexType *res, AARGS(_lt_Cc_)) { _lt_Fcd_(AARGS) _lt_Fad_(res, Naa) extern void FORTRAN(aputnocachec)(COMPLEX *res, AARGS(_lt_Fc_)); FORTRAN(aputnocachec)(_lt_Fap_(res), AARGS(_lt_Fcp_)); _lt_Fax_(res, Naa) } static inline COMPLEX *Acache(const memindex integral) { return CACHEPTR(0,integral); } static inline COMPLEX *AcacheC(const memindex integral) { return CACHEPTR(1,integral); } static inline ComplexType Aval(const int i, const memindex integral) { return ToComplex(Acache(integral)[i]); } static inline ComplexType AvalC(const int i, const memindex integral) { return ToComplex(AcacheC(integral)[i]); } static inline ComplexType A0i(const int i, AARGS(_lt_Cr_)) { return Aval(EPSINDEX(i), Aget(AARGS(_lt_Id_))); } static inline ComplexType A0iC(const int i, AARGS(_lt_Cc_)) { return AvalC(EPSINDEX(i), AgetC(AARGS(_lt_Id_))); } static inline ComplexType A0(AARGS(_lt_Cr_)) { return A0i(aa0, AARGS(_lt_Id_)); } static inline ComplexType A00(AARGS(_lt_Cr_)) { return A0i(aa00, AARGS(_lt_Id_)); } static inline ComplexType A0C(AARGS(_lt_Cc_)) { return A0iC(aa0, AARGS(_lt_Id_)); } static inline ComplexType A00C(AARGS(_lt_Cc_)) { return A0iC(aa00, AARGS(_lt_Id_)); } /****************************************************************/ #define BARGS(t) t(p), t(m1), t(m2) static inline memindex Bget(BARGS(_lt_Cr_)) { _lt_Frd_(BARGS) extern memindex FORTRAN(bget)(BARGS(_lt_Fr_)); return FORTRAN(bget)(BARGS(_lt_Frp_)); } static inline memindex BgetC(BARGS(_lt_Cc_)) { _lt_Fcd_(BARGS) extern memindex FORTRAN(bgetc)(BARGS(_lt_Fc_)); return FORTRAN(bgetc)(BARGS(_lt_Fcp_)); } static inline void Bput(ComplexType *res, BARGS(_lt_Cr_)) { _lt_Frd_(BARGS) _lt_Fad_(res, Nbb) extern void FORTRAN(bput)(COMPLEX *res, BARGS(_lt_Fr_)); FORTRAN(bput)(_lt_Fap_(res), BARGS(_lt_Frp_)); _lt_Fax_(res, Nbb) } static inline void BputC(ComplexType *res, BARGS(_lt_Cc_)) { _lt_Fcd_(BARGS) _lt_Fad_(res, Nbb) extern void FORTRAN(bputc)(COMPLEX *res, BARGS(_lt_Fc_)); FORTRAN(bputc)(_lt_Fap_(res), BARGS(_lt_Fcp_)); _lt_Fax_(res, Nbb) } static inline void Bputnocache(ComplexType *res, BARGS(_lt_Cr_)) { _lt_Frd_(BARGS) _lt_Fad_(res, Nbb) extern void FORTRAN(bputnocache)(COMPLEX *res, BARGS(_lt_Fr_)); FORTRAN(bputnocache)(_lt_Fap_(res), BARGS(_lt_Frp_)); _lt_Fax_(res, Nbb) } static inline void BputnocacheC(ComplexType *res, BARGS(_lt_Cc_)) { _lt_Fcd_(BARGS) _lt_Fad_(res, Nbb) extern void FORTRAN(bputnocachec)(COMPLEX *res, BARGS(_lt_Fc_)); FORTRAN(bputnocachec)(_lt_Fap_(res), BARGS(_lt_Fcp_)); _lt_Fax_(res, Nbb) } static inline COMPLEX *Bcache(const memindex integral) { return CACHEPTR(2,integral); } static inline COMPLEX *BcacheC(const memindex integral) { return CACHEPTR(3,integral); } static inline ComplexType Bval(const int i, const memindex integral) { return ToComplex(Bcache(integral)[i]); } static inline ComplexType BvalC(const int i, const memindex integral) { return ToComplex(BcacheC(integral)[i]); } static inline ComplexType B0i(const int i, BARGS(_lt_Cr_)) { return Bval(EPSINDEX(i), Bget(BARGS(_lt_Id_))); } static inline ComplexType B0iC(const int i, BARGS(_lt_Cc_)) { return BvalC(EPSINDEX(i), BgetC(BARGS(_lt_Id_))); } static inline ComplexType B0(BARGS(_lt_Cr_)) { return B0i(bb0, BARGS(_lt_Id_)); } static inline ComplexType B1(BARGS(_lt_Cr_)) { return B0i(bb1, BARGS(_lt_Id_)); } static inline ComplexType B00(BARGS(_lt_Cr_)) { return B0i(bb00, BARGS(_lt_Id_)); } static inline ComplexType B11(BARGS(_lt_Cr_)) { return B0i(bb11, BARGS(_lt_Id_)); } static inline ComplexType B001(BARGS(_lt_Cr_)) { return B0i(bb001, BARGS(_lt_Id_)); } static inline ComplexType B111(BARGS(_lt_Cr_)) { return B0i(bb111, BARGS(_lt_Id_)); } static inline ComplexType DB0(BARGS(_lt_Cr_)) { return B0i(dbb0, BARGS(_lt_Id_)); } static inline ComplexType DB1(BARGS(_lt_Cr_)) { return B0i(dbb1, BARGS(_lt_Id_)); } static inline ComplexType DB00(BARGS(_lt_Cr_)) { return B0i(dbb00, BARGS(_lt_Id_)); } static inline ComplexType DB11(BARGS(_lt_Cr_)) { return B0i(dbb11, BARGS(_lt_Id_)); } static inline ComplexType B0C(BARGS(_lt_Cc_)) { return B0iC(bb0, BARGS(_lt_Id_)); } static inline ComplexType B1C(BARGS(_lt_Cc_)) { return B0iC(bb1, BARGS(_lt_Id_)); } static inline ComplexType B00C(BARGS(_lt_Cc_)) { return B0iC(bb00, BARGS(_lt_Id_)); } static inline ComplexType B11C(BARGS(_lt_Cc_)) { return B0iC(bb11, BARGS(_lt_Id_)); } static inline ComplexType B001C(BARGS(_lt_Cc_)) { return B0iC(bb001, BARGS(_lt_Id_)); } static inline ComplexType B111C(BARGS(_lt_Cc_)) { return B0iC(bb111, BARGS(_lt_Id_)); } static inline ComplexType DB0C(BARGS(_lt_Cc_)) { return B0iC(dbb0, BARGS(_lt_Id_)); } static inline ComplexType DB1C(BARGS(_lt_Cc_)) { return B0iC(dbb1, BARGS(_lt_Id_)); } static inline ComplexType DB00C(BARGS(_lt_Cc_)) { return B0iC(dbb00, BARGS(_lt_Id_)); } static inline ComplexType DB11C(BARGS(_lt_Cc_)) { return B0iC(dbb11, BARGS(_lt_Id_)); } /****************************************************************/ #define CARGS(t) t(p1), t(p2), t(p1p2), t(m1), t(m2), t(m3) static inline memindex Cget(CARGS(_lt_Cr_)) { _lt_Frd_(CARGS) extern memindex FORTRAN(cget)(CARGS(_lt_Fr_)); return FORTRAN(cget)(CARGS(_lt_Frp_)); } static inline memindex CgetC(CARGS(_lt_Cc_)) { _lt_Fcd_(CARGS) extern memindex FORTRAN(cgetc)(CARGS(_lt_Fc_)); return FORTRAN(cgetc)(CARGS(_lt_Fcp_)); } static inline void Cput(ComplexType *res, CARGS(_lt_Cr_)) { _lt_Frd_(CARGS) _lt_Fad_(res, Ncc) extern void FORTRAN(cput)(COMPLEX *res, CARGS(_lt_Fr_)); FORTRAN(cput)(_lt_Fap_(res), CARGS(_lt_Frp_)); _lt_Fax_(res, Ncc) } static inline void CputC(ComplexType *res, CARGS(_lt_Cc_)) { _lt_Fcd_(CARGS) _lt_Fad_(res, Ncc) extern void FORTRAN(cputc)(COMPLEX *res, CARGS(_lt_Fc_)); FORTRAN(cputc)(_lt_Fap_(res), CARGS(_lt_Fcp_)); _lt_Fax_(res, Ncc) } static inline void C0nocache(ComplexType *res, CARGS(_lt_Cr_)) { _lt_Frd_(CARGS) _lt_Fad_(res, 3) extern void FORTRAN(c0nocache)(COMPLEX *res, CARGS(_lt_Fr_)); FORTRAN(c0nocache)(_lt_Fap_(res), CARGS(_lt_Frp_)); _lt_Fax_(res, 3) } static inline void C0nocacheC(ComplexType *res, CARGS(_lt_Cc_)) { _lt_Fcd_(CARGS) _lt_Fad_(res, 3) extern void FORTRAN(c0nocachec)(COMPLEX *res, CARGS(_lt_Fc_)); FORTRAN(c0nocachec)(_lt_Fap_(res), CARGS(_lt_Fcp_)); _lt_Fax_(res, 3) } static inline COMPLEX *Ccache(const memindex integral) { return CACHEPTR(4,integral); } static inline COMPLEX *CcacheC(const memindex integral) { return CACHEPTR(5,integral); } static inline ComplexType Cval(const int i, const memindex integral) { return ToComplex(Ccache(integral)[i]); } static inline ComplexType CvalC(const int i, const memindex integral) { return ToComplex(CcacheC(integral)[i]); } static inline ComplexType C0i(const int i, CARGS(_lt_Cr_)) { return Cval(EPSINDEX(i), Cget(CARGS(_lt_Id_))); } static inline ComplexType C0iC(const int i, CARGS(_lt_Cc_)) { return CvalC(EPSINDEX(i), CgetC(CARGS(_lt_Id_))); } static inline ComplexType C0(CARGS(_lt_Cr_)) { return C0i(cc0, CARGS(_lt_Id_)); } static inline ComplexType C0C(CARGS(_lt_Cc_)) { return C0iC(cc0, CARGS(_lt_Id_)); } /****************************************************************/ #define DARGS(t) t(p1), t(p2), t(p3), t(p4), t(p1p2), t(p2p3), \ t(m1), t(m2), t(m3), t(m4) static inline memindex Dget(DARGS(_lt_Cr_)) { _lt_Frd_(DARGS) extern memindex FORTRAN(dget)(DARGS(_lt_Fr_)); return FORTRAN(dget)(DARGS(_lt_Frp_)); } static inline memindex DgetC(DARGS(_lt_Cc_)) { _lt_Fcd_(DARGS) extern memindex FORTRAN(dgetc)(DARGS(_lt_Fc_)); return FORTRAN(dgetc)(DARGS(_lt_Fcp_)); } static inline void Dput(ComplexType *res, DARGS(_lt_Cr_)) { _lt_Frd_(DARGS) _lt_Fad_(res, Ndd) extern void FORTRAN(dput)(COMPLEX *res, DARGS(_lt_Fr_)); FORTRAN(dput)(_lt_Fap_(res), DARGS(_lt_Frp_)); _lt_Fax_(res, Ndd) } static inline void DputC(ComplexType *res, DARGS(_lt_Cc_)) { _lt_Fcd_(DARGS) _lt_Fad_(res, Ndd) extern void FORTRAN(dputc)(COMPLEX *res, DARGS(_lt_Fc_)); FORTRAN(dputc)(_lt_Fap_(res), DARGS(_lt_Fcp_)); _lt_Fax_(res, Ndd) } static inline void D0nocache(ComplexType *res, DARGS(_lt_Cr_)) { _lt_Frd_(DARGS) _lt_Fad_(res, 3) extern void FORTRAN(d0nocache)(COMPLEX *res, DARGS(_lt_Fr_)); FORTRAN(d0nocache)(_lt_Fap_(res), DARGS(_lt_Frp_)); _lt_Fax_(res, 3) } static inline void D0nocacheC(ComplexType *res, DARGS(_lt_Cc_)) { _lt_Fcd_(DARGS) _lt_Fad_(res, 3) extern void FORTRAN(d0nocachec)(COMPLEX *res, DARGS(_lt_Fc_)); FORTRAN(d0nocachec)(_lt_Fap_(res), DARGS(_lt_Fcp_)); _lt_Fax_(res, 3) } static inline COMPLEX *Dcache(const memindex integral) { return CACHEPTR(6,integral); } static inline COMPLEX *DcacheC(const memindex integral) { return CACHEPTR(7,integral); } static inline ComplexType Dval(const int i, const memindex integral) { return ToComplex(Dcache(integral)[i]); } static inline ComplexType DvalC(const int i, const memindex integral) { return ToComplex(DcacheC(integral)[i]); } static inline ComplexType D0i(const int i, DARGS(_lt_Cr_)) { return Dval(EPSINDEX(i), Dget(DARGS(_lt_Id_))); } static inline ComplexType D0iC(const int i, DARGS(_lt_Cc_)) { return DvalC(EPSINDEX(i), DgetC(DARGS(_lt_Id_))); } static inline ComplexType D0(DARGS(_lt_Cr_)) { return D0i(dd0, DARGS(_lt_Id_)); } static inline ComplexType D0C(DARGS(_lt_Cc_)) { return D0iC(dd0, DARGS(_lt_Id_)); } /****************************************************************/ #define EARGS(t) t(p1), t(p2), t(p3), t(p4), t(p5), \ t(p1p2), t(p2p3), t(p3p4), t(p4p5), t(p5p1), \ t(m1), t(m2), t(m3), t(m4), t(m5) static inline memindex Eget(EARGS(_lt_Cr_)) { _lt_Frd_(EARGS) extern memindex FORTRAN(eget)(EARGS(_lt_Fr_)); return FORTRAN(eget)(EARGS(_lt_Frp_)); } static inline memindex EgetC(EARGS(_lt_Cc_)) { _lt_Fcd_(EARGS) extern memindex FORTRAN(egetc)(EARGS(_lt_Fc_)); return FORTRAN(egetc)(EARGS(_lt_Fcp_)); } static inline void Eput(ComplexType *res, EARGS(_lt_Cr_)) { _lt_Frd_(EARGS) _lt_Fad_(res, Nee) extern void FORTRAN(eput)(COMPLEX *res, EARGS(_lt_Fr_)); FORTRAN(eput)(_lt_Fap_(res), EARGS(_lt_Frp_)); _lt_Fax_(res, Nee) } static inline void EputC(ComplexType *res, EARGS(_lt_Cc_)) { _lt_Fcd_(EARGS) _lt_Fad_(res, Nee) extern void FORTRAN(eputc)(COMPLEX *res, EARGS(_lt_Fc_)); FORTRAN(eputc)(_lt_Fap_(res), EARGS(_lt_Fcp_)); _lt_Fax_(res, Nee) } static inline void E0nocache(ComplexType *res, EARGS(_lt_Cr_)) { _lt_Frd_(EARGS) _lt_Fad_(res, 3) extern void FORTRAN(e0nocache)(COMPLEX *res, EARGS(_lt_Fr_)); FORTRAN(e0nocache)(_lt_Fap_(res), EARGS(_lt_Frp_)); _lt_Fax_(res, 3) } static inline void E0nocacheC(ComplexType *res, EARGS(_lt_Cc_)) { _lt_Fcd_(EARGS) _lt_Fad_(res, 3) extern void FORTRAN(e0nocachec)(COMPLEX *res, EARGS(_lt_Fc_)); FORTRAN(e0nocachec)(_lt_Fap_(res), EARGS(_lt_Fcp_)); _lt_Fax_(res, 3) } static inline COMPLEX *Ecache(const memindex integral) { return CACHEPTR(8,integral); } static inline COMPLEX *EcacheC(const memindex integral) { return CACHEPTR(9,integral); } static inline ComplexType Eval(const int i, const memindex integral) { return ToComplex(Ecache(integral)[i]); } static inline ComplexType EvalC(const int i, const memindex integral) { return ToComplex(EcacheC(integral)[i]); } static inline ComplexType E0i(const int i, EARGS(_lt_Cr_)) { return Eval(EPSINDEX(i), Eget(EARGS(_lt_Id_))); } static inline ComplexType E0iC(const int i, EARGS(_lt_Cc_)) { return EvalC(EPSINDEX(i), EgetC(EARGS(_lt_Id_))); } static inline ComplexType E0(EARGS(_lt_Cr_)) { return E0i(ee0, EARGS(_lt_Id_)); } static inline ComplexType E0C(EARGS(_lt_Cc_)) { return E0iC(ee0, EARGS(_lt_Id_)); } /****************************************************************/ #define XARGS(t) t(x) static inline ComplexType Li2(XARGS(_lt_Cr_)) { _lt_Frd_(XARGS) COMPLEX res; extern void FORTRAN(li2sub)(COMPLEX *res, XARGS(_lt_Fr_)); FORTRAN(li2sub)(&res, XARGS(_lt_Frp_)); return ToComplex(res); } static inline ComplexType Li2C(XARGS(_lt_Cc_)) { _lt_Fcd_(XARGS) COMPLEX res; extern void FORTRAN(li2csub)(COMPLEX *res, XARGS(_lt_Fc_)); FORTRAN(li2csub)(&res, XARGS(_lt_Fcp_)); return ToComplex(res); } static inline ComplexType Li2omx(XARGS(_lt_Cr_)) { _lt_Frd_(XARGS) COMPLEX res; extern void FORTRAN(li2omxsub)(COMPLEX *res, XARGS(_lt_Fr_)); FORTRAN(li2omxsub)(&res, XARGS(_lt_Frp_)); return ToComplex(res); } static inline ComplexType Li2omxC(XARGS(_lt_Cc_)) { _lt_Fcd_(XARGS) COMPLEX res; extern void FORTRAN(li2omxcsub)(COMPLEX *res, XARGS(_lt_Fc_)); FORTRAN(li2omxcsub)(&res, XARGS(_lt_Fcp_)); return ToComplex(res); } /****************************************************************/ #define _lt_setreal_(f) static inline void Set##f(XARGS(_lt_Cr_)) { \ _lt_Frd_(XARGS) \ extern void FORTRAN(set##f)(CREAL *); \ FORTRAN(set##f)(XARGS(_lt_Frp_)); \ } #define _lt_getreal_(f) static inline RealType Get##f() { \ extern REAL FORTRAN(get##f)(void); \ return ToReal(FORTRAN(get##f)()); \ } _lt_setreal_(mudim) #define setmudim Setmudim _lt_getreal_(mudim) #define getmudim Getmudim _lt_setreal_(delta) #define setdelta Setdelta _lt_getreal_(delta) #define getdelta Getdelta _lt_setreal_(uvdiv) #define setuvdiv Setuvdiv _lt_getreal_(uvdiv) #define getuvdiv Getuvdiv _lt_setreal_(lambda) #define setlambda Setlambda _lt_getreal_(lambda) #define getlambda Getlambda _lt_setreal_(minmass) #define setminmass Setminmass _lt_getreal_(minmass) #define getminmass Getminmass _lt_setreal_(maxdev) #define setmaxdev Setmaxdev _lt_getreal_(maxdev) #define getmaxdev Getmaxdev _lt_setreal_(diffeps) #define setdiffeps Setdiffeps _lt_getreal_(diffeps) #define getdiffeps Getdiffeps _lt_setreal_(zeroeps) #define setzeroeps Setzeroeps _lt_getreal_(zeroeps) #define getzeroeps Getzeroeps #define _lt_setint_(f) static inline void Set##f(const int x) { \ extern void FORTRAN(set##f)(CINTEGER *); \ FORTRAN(set##f)(&x); \ } #define _lt_getint_(f) static inline int Get##f() { \ extern INTEGER FORTRAN(get##f)(void); \ return FORTRAN(get##f)(); \ } _lt_setint_(warndigits) #define setwarndigits Setwarndigits _lt_getint_(warndigits) #define getwarndigits Getwarndigits _lt_setint_(errdigits) #define seterrdigits Seterrdigits _lt_getint_(errdigits) #define geterrdigits Geterrdigits _lt_setint_(versionkey) #define setversionkey Setversionkey _lt_getint_(versionkey) #define getversionkey Getversionkey _lt_setint_(debugkey) #define setdebugkey Setdebugkey _lt_getint_(debugkey) #define getdebugkey Getdebugkey _lt_setint_(cmpbits) #define setcmpbits Setcmpbits _lt_getint_(cmpbits) #define getcmpbits Getcmpbits _lt_getint_(epsi) #define getepsi Getepsi static inline void Setdebugrange(const int f, const int t) { extern void FORTRAN(setdebugrange)(CINTEGER *, CINTEGER *); FORTRAN(setdebugrange)(&f, &t); } #define setdebugrange Setdebugrange /****************************************************************/ extern void FORTRAN(clearcache)(void); extern void FORTRAN(markcache)(void); extern void FORTRAN(restorecache)(void); extern void FORTRAN(ltini)(void); extern void FORTRAN(ltexi)(void); #if !NOUNDERSCORE #define clearcache FORTRAN(clearcache) #define markcache FORTRAN(markcache) #define restorecache FORTRAN(restorecache) #define ltini FORTRAN(ltini) #define ltexi FORTRAN(ltexi) #endif /****************************************************************/ #ifdef __cplusplus } #endif #endif LoopTools-2.16/PaxHeaders/makefile.in0000644000000000000000000000007414131177145014570 xustar0030 atime=1648161785.731698531 30 ctime=1648161793.715764879 LoopTools-2.16/makefile.in0000644000000000000000000000304614131177145015506 0ustar00rootroot00000000000000BLD = build$(QUADSUFFIX) LIBDIR = $(PREFIX)/lib$(LIBDIRSUFFIX) INCLUDEDIR = $(PREFIX)/include BINDIR = $(PREFIX)/bin LIB = libooptools$(QUADSUFFIX).a FE = lt$(QUADSUFFIX)$(EXE) MFE = LoopTools$(QUADSUFFIX)$(EXE) FCC = fcc$(QUADSUFFIX) FXX = f++$(QUADSUFFIX) INCLUDE = $(BLD)/looptools.h $(BLD)/clooptools.h ARGS = $(PARALLEL) \ LIB="$(LIB)" \ FE="$(FE)" \ MFE="$(MFE)" \ FCC="$(FCC)" \ FXX="$(FXX)" \ EXE="$(EXE)" \ DEF="$(DEF)" \ NOUNDERSCORE="$(NOUNDERSCORE)" \ XFC="$(FC) $(FFLAGS) -I." \ F90="$(F90)" \ CDEFS="$(CDEFS)" \ MCDEFS="$(MCDEFS)" \ CC="$(CC)" \ CFLAGS="$(CFLAGS)" \ CXX="$(CXX)" \ CXXFLAGS="$(CXXFLAGS)" \ ML="$(ML)" \ MCC="$(MCC)" \ MCFLAGS="$(MCFLAGS)" \ MCLIBS="$(MCLIBS)" \ AR="$(AR)" \ RANLIB="$(RANLIB)" \ NM="$(NM)" \ DLLTOOL="$(DLLTOOL)" \ LDFLAGS="$(LDFLAGS)" \ LIBPATH="$(LIBPATH)" default all lib frontend mma: force cd $(BLD) && $(MAKE) $(ARGS) $@ install: lib frontend -mkdir $(PREFIX) -mkdir $(LIBDIR) $(BINDIR) $(INCLUDEDIR) cp -p $(BLD)/$(LIB) $(LIBDIR) cp -p $(INCLUDE) $(INCLUDEDIR) strip $(BLD)/$(FE) cp -p $(BLD)/$(FCC) $(BLD)/$(FE) $(BINDIR) rm -f $(BINDIR)/$(FXX) ln -s $(FCC) $(BINDIR)/$(FXX) test ! -f $(BLD)/$(MFE) || { \ test -z "$(EXE)" || ldd $(BLD)/$(MFE) | awk '/\/usr\/bin\/cyg/ { system("cp -p " $$3 " $(BINDIR)/"); }' ; \ strip $(BLD)/$(MFE) ; \ cp -p $(BLD)/$(MFE) $(BINDIR); \ } force: $(BLD)/timestamp $(BLD)/timestamp: -mkdir $(BLD) find "`cd $(SRC) ; pwd`" -follow -exec ln -sf {} $(BLD) \; touch $(BLD)/timestamp clean: rm -fr $(BLD) LoopTools-2.16/PaxHeaders/COPYING0000644000000000000000000000007411352247751013521 xustar0030 atime=1648161785.731698531 30 ctime=1648161793.715764879 LoopTools-2.16/COPYING0000644000000000000000000001674311352247751014447 0ustar00rootroot00000000000000 GNU LESSER GENERAL PUBLIC LICENSE Version 3, 29 June 2007 Copyright (C) 2007 Free Software Foundation, Inc. Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. This version of the GNU Lesser General Public License incorporates the terms and conditions of version 3 of the GNU General Public License, supplemented by the additional permissions listed below. 0. Additional Definitions. As used herein, "this License" refers to version 3 of the GNU Lesser General Public License, and the "GNU GPL" refers to version 3 of the GNU General Public License. "The Library" refers to a covered work governed by this License, other than an Application or a Combined Work as defined below. An "Application" is any work that makes use of an interface provided by the Library, but which is not otherwise based on the Library. Defining a subclass of a class defined by the Library is deemed a mode of using an interface provided by the Library. A "Combined Work" is a work produced by combining or linking an Application with the Library. The particular version of the Library with which the Combined Work was made is also called the "Linked Version". The "Minimal Corresponding Source" for a Combined Work means the Corresponding Source for the Combined Work, excluding any source code for portions of the Combined Work that, considered in isolation, are based on the Application, and not on the Linked Version. The "Corresponding Application Code" for a Combined Work means the object code and/or source code for the Application, including any data and utility programs needed for reproducing the Combined Work from the Application, but excluding the System Libraries of the Combined Work. 1. Exception to Section 3 of the GNU GPL. You may convey a covered work under sections 3 and 4 of this License without being bound by section 3 of the GNU GPL. 2. Conveying Modified Versions. If you modify a copy of the Library, and, in your modifications, a facility refers to a function or data to be supplied by an Application that uses the facility (other than as an argument passed when the facility is invoked), then you may convey a copy of the modified version: a) under this License, provided that you make a good faith effort to ensure that, in the event an Application does not supply the function or data, the facility still operates, and performs whatever part of its purpose remains meaningful, or b) under the GNU GPL, with none of the additional permissions of this License applicable to that copy. 3. Object Code Incorporating Material from Library Header Files. The object code form of an Application may incorporate material from a header file that is part of the Library. You may convey such object code under terms of your choice, provided that, if the incorporated material is not limited to numerical parameters, data structure layouts and accessors, or small macros, inline functions and templates (ten or fewer lines in length), you do both of the following: a) Give prominent notice with each copy of the object code that the Library is used in it and that the Library and its use are covered by this License. b) Accompany the object code with a copy of the GNU GPL and this license document. 4. Combined Works. You may convey a Combined Work under terms of your choice that, taken together, effectively do not restrict modification of the portions of the Library contained in the Combined Work and reverse engineering for debugging such modifications, if you also do each of the following: a) Give prominent notice with each copy of the Combined Work that the Library is used in it and that the Library and its use are covered by this License. b) Accompany the Combined Work with a copy of the GNU GPL and this license document. c) For a Combined Work that displays copyright notices during execution, include the copyright notice for the Library among these notices, as well as a reference directing the user to the copies of the GNU GPL and this license document. d) Do one of the following: 0) Convey the Minimal Corresponding Source under the terms of this License, and the Corresponding Application Code in a form suitable for, and under terms that permit, the user to recombine or relink the Application with a modified version of the Linked Version to produce a modified Combined Work, in the manner specified by section 6 of the GNU GPL for conveying Corresponding Source. 1) Use a suitable shared library mechanism for linking with the Library. A suitable mechanism is one that (a) uses at run time a copy of the Library already present on the user's computer system, and (b) will operate properly with a modified version of the Library that is interface-compatible with the Linked Version. e) Provide Installation Information, but only if you would otherwise be required to provide such information under section 6 of the GNU GPL, and only to the extent that such information is necessary to install and execute a modified version of the Combined Work produced by recombining or relinking the Application with a modified version of the Linked Version. (If you use option 4d0, the Installation Information must accompany the Minimal Corresponding Source and Corresponding Application Code. If you use option 4d1, you must provide the Installation Information in the manner specified by section 6 of the GNU GPL for conveying Corresponding Source.) 5. Combined Libraries. You may place library facilities that are a work based on the Library side by side in a single library together with other library facilities that are not Applications and are not covered by this License, and convey such a combined library under terms of your choice, if you do both of the following: a) Accompany the combined library with a copy of the same work based on the Library, uncombined with any other library facilities, conveyed under the terms of this License. b) Give prominent notice with the combined library that part of it is a work based on the Library, and explaining where to find the accompanying uncombined form of the same work. 6. Revised Versions of the GNU Lesser General Public License. The Free Software Foundation may publish revised and/or new versions of the GNU Lesser General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Library as you received it specifies that a certain numbered version of the GNU Lesser General Public License "or any later version" applies to it, you have the option of following the terms and conditions either of that published version or of any later version published by the Free Software Foundation. If the Library as you received it does not specify a version number of the GNU Lesser General Public License, you may choose any version of the GNU Lesser General Public License ever published by the Free Software Foundation. If the Library as you received it specifies that a proxy can decide whether future versions of the GNU Lesser General Public License shall apply, that proxy's public statement of acceptance of any version is permanent authorization for you to choose that version for the Library.