looptools-2.8.orig/0000755000175000017500000000000012036565523015245 5ustar sylvestresylvestrelooptools-2.8.orig/makefile.in0000644000175000017500000000246211612211631017341 0ustar sylvestresylvestreBLD = build$(QUADSUFFIX) LIBDIR = $(PREFIX)/lib$(LIBDIRSUFFIX) INCLUDEDIR = $(PREFIX)/include BINDIR = $(PREFIX)/bin LIB = libooptools$(QUADSUFFIX).a FE = lt$(QUADSUFFIX)$(EXE) MFE = LoopTools$(QUADSUFFIX)$(EXE) INCLUDE = $(BLD)/looptools.h $(BLD)/clooptools.h ARGS = $(PARALLEL) \ LIB="$(LIB)" \ FE="$(FE)" \ MFE="$(MFE)" \ EXE="$(EXE)" \ DEF="$(DEF)" \ NOUNDERSCORE="$(NOUNDERSCORE)" \ XFC="$(FC$(QUADSUFFIX)) $(FFLAGS) $(FFLAGS-quad) -I." \ F90="$(F90)" \ CC="$(CC)" \ CFLAGS="$(CFLAGS) $(CFLAGS-quad)" \ CXX="$(CXX)" \ CXXFLAGS="$(CXXFLAGS)" \ ML="$(ML)" \ MCC="$(MCC)" \ MCFLAGS="$(MCFLAGS)" \ AR="$(AR)" \ RANLIB="$(RANLIB)" \ NM="$(NM)" \ DLLTOOL="$(DLLTOOL)" \ LDFLAGS="$(LDFLAGS)" \ LIBPATH="$(LIBPATH)" \ OBJS-quad="$(OBJS-quad)" 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$(QUADSUFFIX)) $(INCLUDEDIR) strip $(BLD)/$(FE) cp -p $(BLD)/fcc $(BLD)/$(FE) $(BINDIR) test ! -f $(BLD)/$(MFE) || { 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.8.orig/makefile.quad-alpha0000644000175000017500000000030611516312170020746 0ustar sylvestresylvestreQUADSUFFIX = -quad F90 = f90 FC-quad = ./q77 FFLAGS-quad = -DQUAD=1 -DKIND=2 CFLAGS-quad = -DKIND=2 OBJS-quad = qcomplex.o INCLUDE-quad = $(BLD)/looptools.h90 $(BLD)/qcomplex.mod include makefile looptools-2.8.orig/makefile.quad-gfortran0000644000175000017500000000025512031772106021510 0ustar sylvestresylvestreQUADSUFFIX = -quad FC-quad = $(FC) FFLAGS-quad = -DQUAD=1 -DKIND=2 -fdefault-real-8 CFLAGS-quad = -DQUAD=1 -DKIND=2 -O0 INCLUDE-quad = $(BLD)/looptools.h include makefile looptools-2.8.orig/makefile.quad-ifort0000644000175000017500000000033312026327662021015 0ustar sylvestresylvestreQUADSUFFIX = -quad FC-quad = $(FC) FFLAGS-quad = -r16 -DQUAD=1 -DKIND=2 -DDBLE=QEXT -DDIMAG=QIMAG -DDCONJG=QCONJG -DDCMPLX=QCMPLX CFLAGS-quad = -DQUAD=1 -DKIND=2 -O0 INCLUDE-quad = $(BLD)/looptools.h include makefile looptools-2.8.orig/makefile.quad-xlf0000644000175000017500000000022611516312202020447 0ustar sylvestresylvestreQUADSUFFIX = -quad FC-quad = xlf FFLAGS-quad = -qautodbl=dbl -WF,-DKIND=2 CFLAGS-quad = -DKIND=2 INCLUDE-quad = $(BLD)/looptools.h include makefile looptools-2.8.orig/configure0000755000175000017500000002261312031772156017155 0ustar sylvestresylvestre#! /bin/sh # configure script for LoopTools # note: has nothing to do with GNU autoconf # last modified 1 Aug 12 by Thomas Hahn LC_ALL=C export LC_ALL test=test$$ trap "rm -fr $test*" 0 1 2 3 15 if (echo "test\c"; echo 1,2,3) | grep c > /dev/null ; then if (echo -n test; echo 1,2,3) | grep n > /dev/null ; then echo_n= echo_c=' ' else echo_n=-n echo_c= fi else echo_n= echo_c='\c' fi findprog() { echo $echo_n "looking for $1... $echo_c" 1>&2 shift test -n "$CONF_TARGET" && for prog in "$@" ; do full="`which \"$CONF_TARGET-$prog\" 2> /dev/null`" test -x "$full" && { echo $full 1>&2 echo $CONF_TARGET-$prog return 0 } done for prog in "$@" ; do full="`which \"$prog\" 2> /dev/null`" test -x "$full" && { echo $full 1>&2 echo $prog return 0 } done echo "no $@ in your path" 1>&2 return 1 } getldflags() { # Mma 5.1's mcc needs -lpthread for static linking ldflags="$LDFLAGS -lpthread" while read line ; do set -- `echo $line | tr ':,()' ' '` case $1 in */collect2$CONF_EXE | */ld$CONF_EXE | ld$CONF_EXE) ;; *) continue ;; esac while test $# -gt 1 ; do shift case $1 in *.o | -lc | -lgcc*) ;; -l* | -L* | *.a) ldflags="$ldflags $1" ;; -Bstatic | -Bdynamic | *.ld) ldflags="$ldflags -Wl,$1" ;; /*) ldflags="$ldflags -L$1" ;; -rpath*) ldflags="$ldflags -Wl,$1,$2" shift ;; -dynamic-linker) shift ;; esac done done echo $ldflags } CONF_SRC=`dirname $0`/src CONF_OS=`uname -s` CONF_MACH=`uname -m` CONF_DEFPREFIX="$CONF_MACH-$CONF_OS" CONF_PREFIX="$CONF_DEFPREFIX" test "$CONF_PREFIX" = x86_64-Linux && CONF_LIBDIRSUFFIX=64 CONF_TARGET= CONF_STATIC= CONF_STATIC_EXT= CONF_DEBUG= CONF_BITS= CONF_EXE= case "$CONF_OS" in CYG*) CONF_EXE=.exe ;; esac for arg in "$@" ; do case "$arg" in --prefix=*) CONF_PREFIX=`expr "$arg" : ".*--prefix=\(.*\)"` ;; --host=*) CONF_TARGET=`expr "$arg" : ".*--host=\(.*\)"` ;; --static) CONF_STATIC="-static" case "$CONF_OS" in # Apple discourages static linking, see # http://developer.apple.com/qa/qa2001/qa1118.html, # so we make only libgcc static. For a static libg2c do: # sudo chmod 000 /usr/local/lib/libg2c.dylib Darwin | CYG*) CONF_STATIC_EXT=$CONF_STATIC CONF_STATIC= ;; esac ;; --debug) CONF_DEBUG="-O0 -g" ;; --32) CONF_BITS=32 ;; --64) CONF_BITS=64 ;; --help) cat << _EOF_ 1>&2 $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, --debug compile without optimization, --32 force 32-bit compilation, --64 force 64-bit compilation. _EOF_ exit 1 ;; -*) echo "Warning: $arg is not a valid option." 1>&2 ;; *=*) eval `echo $arg\" | sed 's/=/="/'` ;; *) echo "Warning: $arg is not a valid argument." 1>&2 ;; esac done CONF_M=${CONF_BITS:+-m$CONF_BITS} ## look for some programs CONF_MAKE=`findprog make $MAKE gmake Make make` || exit 1 CONF_CC=`findprog gcc $CC gcc` || exit 1 CONF_CXX=`findprog g++ $CXX g++` || exit 1 CONF_FC=`findprog f77 $FC pgf77 ifort xlf gfortran g77 g95 f77 f90 fort77` || exit 1 CONF_AR=`findprog ar $AR ar` CONF_RANLIB=`findprog ranlib $RANLIB ranlib` CONF_NM=`findprog nm $NM nm` CONF_DLLTOOL=`findprog dlltool $DLLTOOL dlltool` CONF_DEF="-D" case "`$CONF_FC --version -c 2>&1`" in *G95*) CONF_FFLAGS="$FFLAGS -O0 -g -ffixed-line-length-132 -freal-loops $CONF_M $CONF_STATIC ${CONF_DEBUG:+-Wall}" ;; *GNU*) CONF_FFLAGS="$FFLAGS -O1 -g -ffixed-line-length-none $CONF_M $CONF_STATIC ${CONF_DEBUG:+-Wall}" case "$CONF_FC" in *gfortran*) CONF_FFLAGS="$CONF_FFLAGS ${CONF_DEBUG:+-Wtabs -ffpe-trap=invalid,overflow,zero} -fno-range-check -ff2c ${CONF_STATIC_EXT:+-static-libgfortran -static-libgcc}" ;; esac ;; *) CONF_FFLAGS="${FFLAGS-default}" test "$CONF_FFLAGS" = default && case "$CONF_FC$CONF_MACH" in *pgf*) CONF_FFLAGS="${CONF_DEBUG:--O3 -g} ${CONF_DEBUG:+-Ktrap=fp} -Mextend -Minform=inform -g77libs ${CONF_STATIC:+-Bstatic} $CONF_M" ;; *ifort*) CONF_FFLAGS="${CONF_DEBUG:--O3 -g} -extend_source -warn truncated_source $CONF_STATIC ${CONF_STATIC_EXT:+-static-intel} $CONF_M" ;; *alpha) CONF_FFLAGS="-old_f77 ${CONF_DEBUG:--O3 -g3} ${CONF_DEBUG:+-fpe0} -extend_source -warn truncated_source ${CONF_STATIC:+-non_shared}" ;; *sun* | *sparc*) CONF_FFLAGS="${CONF_DEBUG:--O3 -g} ${CONF_DEBUG:+-ftrap=common} -e ${CONF_STATIC:+-Bstatic}" ;; *hp*) CONF_FFLAGS="${CONF_DEBUG:--O2 -g} ${CONF_DEBUG:++FPVZO} +es +U77 ${CONF_STATIC:+-Wl,-noshared}" ;; *xlf*) CONF_FFLAGS="${CONF_DEBUG:--O2 -g} ${CONF_DEBUG:+-qflttrap=enable:invalid:overflow:zerodivide} -qfixed=132 -qmaxmem=-1 -qextname" CONF_DEF="-WF,-D" ;; *) CONF_FFLAGS="${CONF_DEBUG:--O -g}" ;; esac ;; esac ## find the Fortran libraries echo $echo_n "extracting the Fortran libraries... $echo_c" 1>&2 rm -fr $test* cat > $test.f << _EOF_ program dontpanic print *, "Hi" end _EOF_ CONF_LDFLAGS=`$CONF_FC $CONF_FFLAGS -v -o $test $test.f 2>&1 | getldflags` echo $CONF_LDFLAGS 1>&2 test -z "$CONF_BITS" && case "$CONF_MACH" in *86*) CONF_BITS=32 case "`file $test`" in *x86?64*) CONF_BITS=64 ;; esac CONF_M="-m$CONF_BITS" ;; esac CONF_CFLAGS="${CFLAGS-${CONF_DEBUG:--O3 -g} -fomit-frame-pointer -ffast-math -Wall} $CONF_M $CONF_STATIC ${CONF_STATIC_EXT:+-static-libgcc}" CONF_CXXFLAGS="${CXXFLAGS-${CONF_DEBUG:--O3 -g} -fomit-frame-pointer -ffast-math -Wall} $CONF_M $CONF_STATIC ${CONF_STATIC_EXT:+-static-libstdc++ -static-libgcc}" ## does f77 support REAL*16? echo $echo_n "does $CONF_FC support REAL*16... $echo_c" 1>&2 rm -fr $test* cat > $test.f << _EOF_ program test real*16 a, b a = 2D0**(52/2+2) b = a + 1/a if( a .eq. b ) call exit(1) end _EOF_ $CONF_FC $CONF_FFLAGS $test.f -o $test$CONF_EXE > /dev/null 2>&1 if ./$test$CONF_EXE > /dev/null 2>&1 ; then echo "yes" 1>&2 CONF_QUAD=1 else echo "no" 1>&2 CONF_QUAD=0 fi ## does Fortran need externals for U77 routines? echo $echo_n "does $CONF_FC need externals for U77 routines... $echo_c" 1>&2 rm -fr $test* cat > $test.f << _EOF_ program test implicit none print *, iargc(), len_trim("Hi") end _EOF_ if $CONF_FC $CONF_FFLAGS -c $test.f > /dev/null 2>&1 ; then echo "no" 1>&2 CONF_U77EXT=0 else echo "yes" 1>&2 CONF_U77EXT=1 fi ## does Fortran append underscores to symbols? echo $echo_n "does $CONF_FC append underscores... $echo_c" 1>&2 rm -fr $test* cat > $test.f << _EOF_ subroutine uscore end _EOF_ cat > $test-c.c << _EOF_ int main() { void uscore_(); uscore_(); return 0; } _EOF_ $CONF_FC $CONF_FFLAGS -c $test.f > /dev/null 2>&1 if $CONF_CC $CONF_CFLAGS -o $test-c $test-c.c $test.o $CONF_LDFLAGS > /dev/null 2>&1 ; then echo "yes" 1>&2 CONF_NOUNDERSCORE=0 else echo "no" 1>&2 CONF_NOUNDERSCORE=1 fi ## are we on a big-endian machine? echo $echo_n "are we big-endian... $echo_c" 1>&2 rm -fr $test* cat > $test.c << _EOF_ #include int main() { union { int i; char c; } u; u.i = 1; u.c = 0; printf("%d\n", u.i != 0); } _EOF_ $CONF_CC $CONF_CFLAGS -o $test$CONF_EXE $test.c > /dev/null 2>&1 if test "`./$test$CONF_EXE`" = 1 ; then echo "yes" 1>&2 CONF_BIGENDIAN=1 else echo "no" 1>&2 CONF_BIGENDIAN=0 fi ## can we do MathLink compilations echo $echo_n "do we have MathLink... $echo_c" 1>&2 rm -fr $test* cat > $test.tm << _EOF_ :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_ : ${MCCDEBUG=0} test "$MCCDEBUG" -ge 1 && set -x CONF_MCC=${MCC:-mcc} CONF_MCFLAGS="${CONF_STATIC:+-st} ${CONF_STATIC_EXT:+-st} ${CONF_BITS:+-b$CONF_BITS}" NM="$CONF_NM" DLLTOOL="$CONF_DLLTOOL" \ CC="$CONF_SRC/tools/fcc.in" REALCC="$CONF_CC $CONF_CFLAGS" \ CXX="$CONF_SRC/tools/f++.in" REALCXX="$CONF_CXX $CONF_CXXFLAGS" \ PATH="$PATH:$CONF_SRC/tools" \ "$CONF_MCC" $CONF_MCFLAGS -o $test$CONF_EXE $test.tm > /dev/null 2>&1 test "$MCCDEBUG" -ge 1 && { cat $test.tm cp $test.tm test.tm file $test$CONF_EXE set +x } if test -x $test$CONF_EXE ; then echo "yes" 1>&2 CONF_ML=1 else echo "no" 1>&2 CONF_ML=0 fi case "$CONF_OS" in Linux*) cpus=`grep -c processor /proc/cpuinfo` ;; Darwin) cpus=`system_profiler SPHardwareDataType | \ awk '/Total Number .f Cores:/ { print $5 }'` ;; esac test "${cpus:-1}" -gt 1 && CONF_PARALLEL="-j $cpus" echo "creating makefile" 1>&2 cat - `dirname $0`/makefile.in > makefile << _EOF_ # --- variables defined by configure --- SRC = $CONF_SRC PREFIX = $CONF_PREFIX LIBDIRSUFFIX = $CONF_LIBDIRSUFFIX EXE = $CONF_EXE DEF = $CONF_DEF NOUNDERSCORE = $CONF_NOUNDERSCORE FC = $CONF_FC FFLAGS = $CONF_FFLAGS \$(DEF)QUAD=$CONF_QUAD \$(DEF)U77EXT=$CONF_U77EXT CC = $CONF_CC CFLAGS = $CONF_CFLAGS -DNOUNDERSCORE=\$(NOUNDERSCORE) -DBIGENDIAN=$CONF_BIGENDIAN CXX = $CONF_CXX CXXFLAGS = $CONF_CXXFLAGS ML = $CONF_ML MCC = $CONF_MCC MCFLAGS = $CONF_MCFLAGS LDFLAGS = $CONF_LDFLAGS $CONF_M AR = $CONF_AR RANLIB = $CONF_RANLIB NM = $CONF_NM DLLTOOL = $CONF_DLLTOOL PARALLEL = $CONF_PARALLEL # --- end defs by configure --- _EOF_ echo "" 1>&2 echo "now you must run $CONF_MAKE" 1>&2 echo "" 1>&2 exit 0 looptools-2.8.orig/src/0000755000175000017500000000000012026101335016016 5ustar sylvestresylvestrelooptools-2.8.orig/src/A/0000755000175000017500000000000011776477712016230 5ustar sylvestresylvestrelooptools-2.8.orig/src/A/ffca0.F0000644000175000017500000000152511776502522017305 0ustar sylvestresylvestre* 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.8.orig/src/A/ffxa0.F0000644000175000017500000000114511776502522017330 0ustar sylvestresylvestre* 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.8.orig/src/A/A00.F0000644000175000017500000000111311776502522016637 0ustar sylvestresylvestre* A00.F * the scalar one-point function * this file is part of LoopTools * written by M. Rauch * last modified 15 Apr 11 th #include "externals.h" #include "types.h" #include "defs.h" ComplexType function XA00(m) implicit none DVAR m #include "lt.h" ComplexType XA0 external XA0 XA00 = .25D0*m*XA0(m) if( lambda .ge. 0 ) XA00 = XA00 + .125D0*m**2 end ************************************************************************ * adapter code for C++ subroutine XA00sub(res, m) implicit none ComplexType res DVAR m ComplexType XA00 external XA00 res = XA00(m) end looptools-2.8.orig/src/A/A0.F0000644000175000017500000000302511776502522016563 0ustar sylvestresylvestre* A0.F * the scalar one-point function * this file is part of LoopTools * last modified 15 Apr 11 th #include "externals.h" #include "types.h" #include "defs.h" ComplexType function XA0(m) implicit none DVAR m #include "lt.h" ComplexType XA0b external XA0b ComplexType res(0:1) integer key, ier if( lambda .lt. 0 ) then XA0 = 0 if( lambda .eq. -1 ) XA0 = m return endif key = ibits(versionkey, KeyA0, 2) 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) = XA0b(m) 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 XA0 = res(iand(key, 1)) end ************************************************************************ * adapter code for C++ subroutine XA0sub(res, m) implicit none ComplexType res DVAR m ComplexType XA0 external XA0 res = XA0(m) end ************************************************************************ * this routine is adapted from Ansgar Denner's bcanew.f * to the conventions of LoopTools ComplexType function XA0b(m) implicit none DVAR m #include "lt.h" if( m .eq. 0 ) then XA0b = 0 else XA0b = m*(1 - log(m/mudim) + delta) endif end looptools-2.8.orig/src/frontend/0000755000175000017500000000000012026604266017650 5ustar sylvestresylvestrelooptools-2.8.orig/src/frontend/lt.F0000644000175000017500000000451012025013371020364 0ustar sylvestresylvestre* lt.F * the LoopTools command-line interface to Bget, Cget, Dget, Eget * this file is part of LoopTools * last modified 15 Sep 12 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 RealType x(Pee) integer i, npoint, fail memindex b ComplexType A0, A00 memindex Bget, Cget, Dget, Eget integer getdebugkey external A0, A00, Bget, Cget, Dget, Eget, getdebugkey integer npara(5), key(5) data npara /1, Pbb, Pcc, Pdd, Pee/ data key /KeyA0, KeyBget, KeyC0, KeyD0, KeyEget/ 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 *, "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) read(argv, *, iostat=fail, err=999) x(i) 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 if( npoint .eq. 1 ) then print *, "m =", x(1) print *, "A0 =", A0(x(1)) print *, "A00 =", A00(x(1)) else call setdebugkey(ior(getdebugkey(), 2**(npoint - 2))) if( npoint .eq. 2 ) then b = Bget(x(1), x(2), x(3)) else if( npoint .eq. 3 ) then b = Cget(x(1), x(2), x(3), x(4), x(5), x(6)) else if( npoint .eq. 4 ) then b = Dget(x(1), x(2), x(3), x(4), x(5), x(6), & x(7), x(8), x(9), x(10)) else b = Eget(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 endif call ltexi end looptools-2.8.orig/src/frontend/LoopTools.tm0000644000175000017500000010101412026577706022151 0ustar sylvestresylvestre:Evaluate: BeginPackage["LoopTools`"] :Evaluate: A0::usage = "A0[m] is the one-point one-loop scalar integral. m is the mass squared." :Evaluate: A00::usage = "A00[m] is the one-point one-loop tensor coefficient of g_{mu nu}. m is the mass squared." :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. For example, 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." :Evaluate: Bget::usage = "Bget[p, m1, m2] returns a list of all two-point coefficients." :Evaluate: C0::usage = "C0[p1, p2, p1p2, m1, m2, m3] is the three-point one-loop scalar integral. p1, p2, and p1p2 are the external momenta squared and m1, m2, m3 are the masses squared." :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. For example, 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." :Evaluate: Cget::usage = "Cget[p1, p2, p1p2, m1, m2, m3] returns a list of all three-point coefficients." :Evaluate: D0::usage = "D0[p1, p2, p3, p4, p1p2, p2p3, m1, m2, m3, m4] is the four-point scalar one-loop integral. 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." :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. For example, 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." :Evaluate: Dget::usage = "Dget[p1, p2, p3, p4, p1p2, p2p3, m1, m2, m3, m4] returns a list of all four-point coefficients." :Evaluate: E0::usage = "E0[p1, p2, p3, p4, p1p2, p2p3, p3p4, p4p5, p5p1, m1, m2, m3, m4, m5] is the five-point scalar one-loop integral. p1...p5 are the external momenta squared, pipj are the squares of (pi + pj), and m1...m5 are the masses squared." :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. For example, 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." :Evaluate: 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 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." :Evaluate: 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 divergence 2/(4 - D) - EulerGamma + Log[4 Pi] in LoopTools." :Evaluate: GetDelta::usage = "GetDelta[] returns the current numerical value of Delta which replaces the divergence 2/(4 - D) - EulerGamma + Log[4 Pi] in LoopTools." :Evaluate: SetLambda::usage = "SetLambda[l^2] sets the infrared regulator mass squared." :Evaluate: GetLambda::usage = "GetLambda[] returns the current value for the infrared regulator mass squared." :Evaluate: SetMinMass::usage = "SetMinMass[m^2] sets the collinear cutoff mass." :Evaluate: GetMinMass::usage = "GetMinMass[] returns the current value for the collinear cutoff mass squared." :Evaluate: ClearCache::usage = "ClearCache[] clears the internal LoopTools caches." :Evaluate: MarkCache::usage = "MarkCache[] marks the current positions of the internal LoopTools caches." :Evaluate: 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." :Evaluate: 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." :Evaluate: 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." :Evaluate: 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." :Evaluate: 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." :Evaluate: GetDebugKey::usage = "GetDebugKey[] returns the LoopTools debug key. It determines how much debug information is printed for a loop integral." :Evaluate: 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." :Evaluate: GetCmpBits::usage = "GetCmpBits[] returns the number of bits compared of each real number in cache lookups." :Evaluate: PaVe::usage = "PaVe[ind, {pi}, {mi}] is the generalized Passarino-Veltman function used by FeynCalc. It is converted to B0i, C0i, D0i, or E0i in LoopTools." :Evaluate: Bids = {bb0, bb1, bb00, bb11, bb001, bb111, dbb0, dbb1, dbb00, dbb11}; Cids = {cc0, cc1, cc2, cc00, cc11, cc12, cc22, cc001, cc002, cc111, cc112, cc122, cc222, cc0000, cc0011, cc0012, cc0022, cc1111, cc1112, cc1122, cc1222, cc2222}; Dids = {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}; Eids = {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@@ ({DebugB, DebugC, DebugD, DebugE} = 2^Range[0, 3]) :Evaluate: 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, ##]& :Evaluate: Begin["`Private`"] :Begin: :Function: mA0 :Pattern: A0[m_?r] :Arguments: {N[m]} :ArgumentTypes: {Real} :ReturnType: Manual :End: :Begin: :Function: mA0c :Pattern: A0[m_?c] :Arguments: {N[Re[m]], N[Im[m]]} :ArgumentTypes: {Real, Real} :ReturnType: Manual :End: :Begin: :Function: mA00 :Pattern: A00[m_?r] :Arguments: {N[m]} :ArgumentTypes: {Real} :ReturnType: Manual :End: :Begin: :Function: mA00c :Pattern: A00[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: {Bid[id], 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: {Bid[id], 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: mC0 :Pattern: C0[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: mC0c :Pattern: C0[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: mC0i :Pattern: C0i[id_, p1_?r, p2_?r, p1p2_?r, m1_?r, m2_?r, m3_?r] :Arguments: {Cid[id], 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: {Cid[id], 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: mD0 :Pattern: D0[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: mD0c :Pattern: D0[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: 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: {Did[id], 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: {Did[id], 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: mE0 :Pattern: E0[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: mE0c :Pattern: E0[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: 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: {Eid[id], 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: {Eid[id], 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: Real :End: :Begin: :Function: msetdelta :Pattern: SetDelta[delta_?r] :Arguments: {N[delta]} :ArgumentTypes: {Real} :ReturnType: Manual :End: :Begin: :Function: mgetdelta :Pattern: GetDelta[] :Arguments: {} :ArgumentTypes: {} :ReturnType: Real :End: :Begin: :Function: msetlambda :Pattern: SetLambda[lambda_?r] :Arguments: {N[lambda]} :ArgumentTypes: {Real} :ReturnType: Manual :End: :Begin: :Function: mgetlambda :Pattern: GetLambda[] :Arguments: {} :ArgumentTypes: {} :ReturnType: Real :End: :Begin: :Function: msetminmass :Pattern: SetMinMass[minmass_?r] :Arguments: {N[minmass]} :ArgumentTypes: {Real} :ReturnType: Manual :End: :Begin: :Function: mgetminmass :Pattern: GetMinMass[] :Arguments: {} :ArgumentTypes: {} :ReturnType: Real :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: Real :End: :Begin: :Function: msetwarndigits :Pattern: SetWarnDigits[warndigits_Integer] :Arguments: {warndigits} :ArgumentTypes: {Integer} :ReturnType: Manual :End: :Begin: :Function: mgetwarndigits :Pattern: GetWarnDigits[] :Arguments: {} :ArgumentTypes: {} :ReturnType: Integer :End: :Begin: :Function: mseterrdigits :Pattern: SetErrDigits[errdigits_Integer] :Arguments: {errdigits} :ArgumentTypes: {Integer} :ReturnType: Manual :End: :Begin: :Function: mgeterrdigits :Pattern: GetErrDigits[] :Arguments: {} :ArgumentTypes: {} :ReturnType: Integer :End: :Begin: :Function: msetversionkey :Pattern: SetVersionKey[versionkey_Integer] :Arguments: {versionkey} :ArgumentTypes: {Integer} :ReturnType: Manual :End: :Begin: :Function: mgetversionkey :Pattern: GetVersionKey[] :Arguments: {} :ArgumentTypes: {} :ReturnType: Integer :End: :Begin: :Function: msetdebugkey :Pattern: SetDebugKey[debugkey_Integer] :Arguments: {debugkey} :ArgumentTypes: {Integer} :ReturnType: Manual :End: :Begin: :Function: mgetdebugkey :Pattern: GetDebugKey[] :Arguments: {} :ArgumentTypes: {} :ReturnType: Integer :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: Integer :End: :Evaluate: r = Head[# + 1.] === Real & :Evaluate: c = Head[# + 1. I] === Complex & :Evaluate: A0[0] = 0 :Evaluate: MapThread[ (Derivative[0,1,0,0][B0i][#1, args__] := B0i[#2, args])&, {{bb0, bb1, bb00, bb11}, {dbb0, dbb1, dbb00, dbb11}} ] :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: MapIndexed[(Bid[#1] = #2[[1]] - 1)&, Bids]; MapIndexed[(Cid[#1] = #2[[1]] - 1)&, Cids]; MapIndexed[(Did[#1] = #2[[1]] - 1)&, Dids]; MapIndexed[(Eid[#1] = #2[[1]] - 1)&, Eids]; Bid[x_] = Cid[x_] = Did[x_] = Eid[x_] = x :Evaluate: idlist[ids_, x_] := MapThread[Rule, {ids, Apply[Complex, Partition[Chop[x, 10^-14], 2], 1]}]; :Evaluate: End[] :Evaluate: EndPackage[] /* LoopTools.tm provides the LoopTools functions in Mathematica this file is part of LoopTools last modified 20 Sep 12 th */ #include #include #include #include #include #include #include #include #include "mathlink.h" #ifndef MLCONST #define MLCONST #endif #include "clooptools.h" #ifdef __MINGW32__ #include #include #define pipe(fds) _pipe(fds, 4096, _O_BINARY) #endif 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 MLPutReal64 #define MLPutREALList MLPutReal64List #endif extern void FORTRAN(fortranflush)(); #define Flush() \ FORTRAN(fortranflush)(); \ fflush(stdout) /******************************************************************/ static int forcestderr = 0; static int stdoutorig; static int stdoutpipe[2]; static pthread_t stdouttid; static int stdoutthr; static void *MLstdout(void *fd) { static byte *buf = NULL; static long size = 0; enum { unit = 10240 }; long len = 0, n = 0; do { len += n; if( size - len < 128 ) buf = realloc(buf, size += unit); n = read(*(int *)fd, buf + len, size - len); } while( n > 0 ); if( len ) { MLPutFunction(stdlink, "EvaluatePacket", 1); MLPutFunction(stdlink, "WriteString", 2); MLPutString(stdlink, "stdout"); MLPutByteString(stdlink, buf, len); MLEndPacket(stdlink); MLNextPacket(stdlink); MLNewPacket(stdlink); } return NULL; } /******************************************************************/ static inline void BeginRedirect() { stdoutthr = forcestderr == 0 && pipe(stdoutpipe) != -1 && pthread_create(&stdouttid, NULL, MLstdout, stdoutpipe) == 0; if( !stdoutthr ) stdoutpipe[1] = 2; dup2(stdoutpipe[1], 1); close(stdoutpipe[1]); } /******************************************************************/ static void EndRedirect() { void *ret; Flush(); dup2(stdoutorig, 1); if( stdoutthr ) pthread_join(stdouttid, &ret); } /******************************************************************/ #define ReturnComplex(expr) \ ComplexType result; \ BeginRedirect(); \ result = expr; \ EndRedirect(); \ MLPutComplex(stdlink, result); \ MLEndPacket(stdlink) #define ReturnList(ids, expr, n) \ COMPLEX *list; \ BeginRedirect(); \ list = expr; \ EndRedirect(); \ MLPutList(stdlink, ids, 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) { 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, cchar *ids, COMPLEX *list, cint n) { MLPutFunction(mlp, "LoopTools`Private`idlist", 2); MLPutSymbol(mlp, ids); MLPutREALList(mlp, (REAL *)list, 2*n); } /******************************************************************/ static void mA0(AARGS(_Mr_)) { ReturnComplex(A0(AARGS(_Id_))); } static void mA0c(AARGS(_Mri_)) { ReturnComplex(A0C(AARGS(_Mc_))); } /******************************************************************/ static void mA00(AARGS(_Mr_)) { ReturnComplex(A00(AARGS(_Id_))); } static void mA00c(AARGS(_Mri_)) { ReturnComplex(A00C(AARGS(_Mc_))); } /******************************************************************/ static void mB0i(cint i, BARGS(_Mr_)) { ReturnComplex(B0i(i, BARGS(_Id_))); } static void mB0ic(cint i, BARGS(_Mri_)) { ReturnComplex(B0iC(i, BARGS(_Mc_))); } /******************************************************************/ static void mBget(BARGS(_Mr_)) { ReturnList("Bids", Bcache(Bget(BARGS(_Id_))), Nbb); } static void mBgetc(BARGS(_Mri_)) { ReturnList("Bids", BcacheC(BgetC(BARGS(_Mc_))), Nbb); } /******************************************************************/ static void mC0(CARGS(_Mr_)) { ReturnComplex(C0(CARGS(_Id_))); } static void mC0c(CARGS(_Mri_)) { ReturnComplex(C0C(CARGS(_Mc_))); } /******************************************************************/ static void mC0i(cint i, CARGS(_Mr_)) { ReturnComplex(C0i(i, CARGS(_Id_))); } static void mC0ic(cint i, CARGS(_Mri_)) { ReturnComplex(C0iC(i, CARGS(_Mc_))); } /******************************************************************/ static void mCget(CARGS(_Mr_)) { ReturnList("Cids", Ccache(Cget(CARGS(_Id_))), Ncc); } static void mCgetc(CARGS(_Mri_)) { ReturnList("Cids", CcacheC(CgetC(CARGS(_Mc_))), Ncc); } /******************************************************************/ static void mD0(DARGS(_Mr_)) { ReturnComplex(D0(DARGS())); } static void mD0c(DARGS(_Mri_)) { ReturnComplex(D0C(DARGS(_Mc_))); } /******************************************************************/ static void mD0i(cint i, DARGS(_Mr_)) { ReturnComplex(D0i(i, DARGS(_Id_))); } static void mD0ic(cint i, DARGS(_Mri_)) { ReturnComplex(D0iC(i, DARGS(_Mc_))); } /******************************************************************/ static void mDget(DARGS(_Mr_)) { ReturnList("Dids", Dcache(Dget(DARGS(_Id_))), Ndd); } static void mDgetc(DARGS(_Mri_)) { ReturnList("Dids", DcacheC(DgetC(DARGS(_Mc_))), Ndd); } /******************************************************************/ static void mE0(EARGS(_Mr_)) { ReturnComplex(E0(EARGS(_Id_))); } static void mE0c(EARGS(_Mri_)) { ReturnComplex(E0C(EARGS(_Mc_))); } /******************************************************************/ static void mE0i(cint i, EARGS(_Mr_)) { ReturnComplex(E0i(i, EARGS(_Id_))); } static void mE0ic(cint i, EARGS(_Mri_)) { ReturnComplex(E0iC(i, EARGS(_Mc_))); } /******************************************************************/ static void mEget(EARGS(_Mr_)) { ReturnList("Eids", Ecache(Eget(EARGS(_Id_))), Nee); } static void mEgetc(EARGS(_Mri_)) { ReturnList("Eids", 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) { setmudim(mudim); ReturnVoid(); } static RealType mgetmudim(void) { return getmudim(); } /******************************************************************/ static void msetdelta(cRealType delta) { setdelta(delta); ReturnVoid(); } static RealType mgetdelta(void) { return getdelta(); } /******************************************************************/ static void msetlambda(cRealType lambda) { setlambda(lambda); ReturnVoid(); } static RealType mgetlambda(void) { return getlambda(); } /******************************************************************/ static void msetminmass(cRealType minmass) { setminmass(minmass); ReturnVoid(); } static RealType mgetminmass(void) { return getminmass(); } /******************************************************************/ static void msetmaxdev(cRealType maxdev) { setmaxdev(maxdev); ReturnVoid(); } static RealType mgetmaxdev(void) { return getmaxdev(); } /******************************************************************/ static void msetwarndigits(cint warndigits) { setwarndigits(warndigits); ReturnVoid(); } static int mgetwarndigits(void) { return getwarndigits(); } /******************************************************************/ static void mseterrdigits(cint errdigits) { seterrdigits(errdigits); ReturnVoid(); } static int mgeterrdigits(void) { return geterrdigits(); } /******************************************************************/ static void msetversionkey(cint versionkey) { setversionkey(versionkey); ReturnVoid(); } static int mgetversionkey(void) { return getversionkey(); } /******************************************************************/ static void msetdebugkey(cint debugkey) { setdebugkey(debugkey); ReturnVoid(); } static int mgetdebugkey(void) { return getdebugkey(); } /******************************************************************/ static void msetdebugrange(cint debugfrom, cint debugto) { setdebugrange(debugfrom, debugto); ReturnVoid(); } /******************************************************************/ static void msetcmpbits(cint cmpbits) { setcmpbits(cmpbits); ReturnVoid(); } static int mgetcmpbits(void) { return getcmpbits(); } /******************************************************************/ int main(int argc, char **argv) { int fd, ret; /* make sure a pipe will not overlap with 0, 1, 2 */ do fd = open("/dev/null", O_WRONLY); while( fd <= 2 ); close(fd); if( getenv("LTFORCESTDERR") ) forcestderr = 1; stdoutorig = dup(1); dup2(2, 1); ltini(); Flush(); dup2(stdoutorig, 1); ret = MLMain(argc, argv); dup2(2, 1); ltexi(); Flush(); return ret; } looptools-2.8.orig/src/frontend/fortranflush.F0000644000175000017500000000031311776502523022475 0ustar sylvestresylvestre* fortranflush.F * C-callable function to flush the Fortran stdout (unit 6) * this file is part of LoopTools * last modified 6 Oct 09 th subroutine fortranflush() implicit none call flush(6) end looptools-2.8.orig/src/C/0000755000175000017500000000000012023554474016215 5ustar sylvestresylvestrelooptools-2.8.orig/src/C/C0.F0000644000175000017500000003702212025015063016556 0ustar sylvestresylvestre* C0.F * the scalar three-point function * this file is part of LoopTools * last modified 15 Sep 12 th #include "externals.h" #include "types.h" #define npoint 3 #include "defs.h" ComplexType function C0(p1, p2, p1p2, m1, m2, m3) implicit none RealType p1, p2, p1p2, m1, m2, m3 #include "lt.h" RealType para(1,Pcc) 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 call C0para(C0, para) end ************************************************************************ * subroutine version for C++ subroutine c0sub(res, p1, p2, p1p2, m1, m2, m3) implicit none ComplexType res RealType p1, p2, p1p2, m1, m2, m3 #include "lt.h" RealType para(1,Pcc) 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 call C0para(res, para) end ************************************************************************ subroutine C0para(res, para) implicit none ComplexType res RealType para(1,*) #include "lt.h" external C0soft, C0coll, C0softDR, C0collDR 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 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)) 555 z = 0 c = 0 s = 0 do i = 1, 3 perm = paraperm(i) if( abs(Mx(1)) .lt. eps ) then if( abs(Px(1) - Mx(2)) + & abs(Px(3) - Mx(3)) .lt. acc ) then if( DEBUGLEVEL .gt. 0 ) & print '("soft C0, perm = ",O3)', perm s = perm goto 556 endif if( abs(Px(1)) + abs(Mx(2)) .lt. eps ) c = perm endif if( abs(P(i)) .lt. eps ) 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( res .eq. c ) goto 555 return endif 556 if( lambda .lt. 0 ) then res = 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, para, ier) if( ier .gt. warndigits ) then ier = 0 call ffxc0r(res, 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 endif if( s .ne. 0 ) then call soft(res, para, s) goto 9 endif goto (1, 2, 3) z res = C0p3(para, p123) + C0p3(para, p231) + C0p3(para, p312) goto 9 1 res = C0p2(para, p123) + C0p2(para, p231) + C0p2(para, p312) goto 9 2 res = C0p1(para, p123) + C0p1(para, p231) + C0p1(para, p312) goto 9 3 res = C0p0(para) 9 if( key .ne. 0 ) then if( key .gt. 1 .and. & abs(res - 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 if( ier .gt. errdigits ) alt = res endif endif if( .not. btest(key, 0) ) res = 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 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. eps ) 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. eps ) 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 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. eps ) 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. acc ) 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 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. acc ) then if( abs(m13) .lt. acc ) then C0p0 = -.5D0/m1 else C0p0 = (m13 - m1*log(m1/m3))/m13**2 endif else if( abs(m12) .lt. acc ) then C0p0 = (-m23 + m3*log(m2/m3))/m23**2 else if( abs(m13) .lt. acc ) 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 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. eps ) then ps = max(minmass, 1D-14) if( abs(m1) .lt. eps ) m1 = ps if( abs(m2) .lt. eps ) m2 = ps if( .not. ini ) then print *, "collinear-divergent C0, using mass cutoff ", ps ini = .TRUE. endif endif if( abs(s) .lt. acc ) then if( abs(m1 - m2) .lt. acc ) 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 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) res = perm if( ini ) return print *, "collinear-divergent C0, using mass cutoff ", Px(1) ini = .TRUE. end ************************************************************************ subroutine C0softDR(res, para, perm) implicit none ComplexType res RealType para(1,*) integer perm #include "lt.h" RealType s, m1, m2 RealType m, dm, r 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. eps ) then if( abs(m1) .lt. eps ) then m1 = m2 if( abs(m1) .lt. eps ) then if( abs(s) .lt. eps ) then print *, "C0softDR: all scales zero" res = nan return endif * qltri1 if( DEBUGLEVEL .gt. 1 ) print *, "C0softDR: qltri1" if( lambda .eq. -2 ) then res = 1/s else if( lambda .eq. -1 ) then res = lnrat(mudim, -s)/s else res = .5D0*lnrat(mudim, -s)**2/s endif return endif endif if( abs(s - m1) .lt. acc ) then * qltri5 if( DEBUGLEVEL .gt. 1 ) print *, "C0softDR: qltri5" if( lambda .eq. -2 ) then res = 0 else if( lambda .eq. -1 ) then res = -.5D0/m1 else res = (-.5D0*lnrat(mudim, m1) + 1)/m1 endif return endif * qltri4 if( DEBUGLEVEL .gt. 1 ) print *, "C0softDR: qltri4" if( lambda .eq. -2 ) then res = .5D0/(s - m1) else if( lambda .eq. -1 ) then res = (.5D0*lnrat(mudim, m1) + lnrat(m1, m1 - s))/(s - m1) else ls = lnrat(m1, m1 - s) lm = lnrat(mudim, m1) res = (lm*(.25D0*lm + ls) + .5D0*ls**2 + pi12 - & spence(0, ToComplex(s/(s - m1)), 0D0))/(s - m1) endif return endif if( lambda .eq. -2 ) then res = 0 return 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. acc ) then if( lambda .eq. -1 ) then res = .5D0/m else res = 0 if( abs(m1 - m2) .gt. acc ) & res = 2 + .5D0*(sqrt(m1) + sqrt(m2))/dm*log(m2/m1) res = .5D0/m*(log(mudim/m) - res) endif return endif lmK = ln(mK, 1) fac = 1/(r*root) if( lambda .eq. -1 ) then res = fac*lmK else res = 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) ) endif end ************************************************************************ subroutine C0collDR(res, para, perm) implicit none ComplexType res 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) if( lambda .eq. -2 ) then res = 0 return endif m = Mx(3) s1 = Px(2) s2 = Px(3) if( abs(m) .lt. eps ) then * qltri2 if( DEBUGLEVEL .gt. 1 ) print *, "C0collDR: qltri2" r = .5D0*(s2 - s1)/s1 if( abs(r) .lt. acc ) then if( lambda .eq. -1 ) then res = (1 - r*mudim/s1)/s1 else res = (lnrat(mudim, -s1)*(1 - r) - r)/s1 endif return endif l1 = lnrat(mudim, -s1) l2 = lnrat(mudim, -s2) res = (l1 - l2)/(s1 - s2) if( lambda .ne. -1 ) res = .5D0*(l1 + l2)*res return endif * qltri3 if( DEBUGLEVEL .gt. 1 ) print *, "C0collDR: qltri3" m1 = m - s1 m2 = m - s2 l1 = lnrat(m1, m) l2 = lnrat(m2, m) lm = lnrat(mudim, m) r = .5D0*(s1 - s2)/m1 if( abs(r) .lt. acc ) then if( lambda .eq. -1 ) then res = (1 - r)/m1 else m = m/s1 res = (lm - (m + 1)*(l2 + r) - & r*((m*(m - 2) - 1)*l2 + lm))/m1 endif return endif res = l2 - l1 if( lambda .ne. -1 ) & res = (lm - l1 - l2)*res + & Li2omrat(m1, m) - Li2omrat(m2, m) res = res/(s1 - s2) end looptools-2.8.orig/src/C/ffxc0p.F0000644000175000017500000003327411776502522017524 0ustar sylvestresylvestre#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.8.orig/src/C/ffcel3.F0000644000175000017500000000536111776502522017474 0ustar sylvestresylvestre#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.8.orig/src/C/Cget.F0000644000175000017500000001274712024312037017205 0ustar sylvestresylvestre* Cget.F * the three-point tensor coefficients * this file is part of LoopTools * improvements by M. Rauch * last modified 13 Sep 12 th #include "externals.h" #include "types.h" #define npoint 3 #include "defs.h" memindex function XCget(p1, p2, p1p2, m1, m2, m3) implicit none DVAR p1, p2, p1p2, m1, m2, m3 #include "lt.h" memindex cacheindex external cacheindex, XCcoeff #ifdef COMPLEXPARA memindex Cget external Cget #endif DVAR para(1,Pcc) P(1) = p1 P(2) = p2 P(3) = p1p2 #ifdef COMPLEXPARA if( abs(Im(P(1))) + abs(Im(P(2))) + abs(Im(P(3))) .gt. 0 ) & print *, "CgetC: Complex momenta not implemented" #endif 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 #ifdef COMPLEXPARA if( abs(Im(M(1))) + abs(Im(M(2))) + abs(Im(M(3))) .eq. 0 ) then XCget = Cget(p1, p2, p1p2, m1, m2, m3) - offsetC return endif #endif XCget = cacheindex(para, Cval(1,0), XCcoeff, RC*Pcc, Ncc) end ************************************************************************ subroutine XCput(res, p1, p2, p1p2, m1, m2, m3) implicit none ComplexType res(*) DVAR p1, p2, p1p2, m1, m2, m3 #include "lt.h" external XCcoeff DVAR para(1,Pcc) P(1) = p1 P(2) = p2 P(3) = p1p2 #ifdef COMPLEXPARA if( abs(Im(P(1))) + abs(Im(P(2))) + abs(Im(P(3))) .gt. 0 ) & print *, "CgetC: Complex momenta not implemented" #endif 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 #ifdef COMPLEXPARA if( abs(Im(M(1))) + abs(Im(M(2))) + abs(Im(M(3))) .eq. 0 ) then call Cput(res, p1, p2, p1p2, m1, m2, m3) return endif #endif call cachecopy(res, para, Cval(1,0), XCcoeff, RC*Pcc, Ncc) end ************************************************************************ ComplexType function XC0i(i, p1, p2, p1p2, m1, m2, m3) implicit none integer i DVAR 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,b) end ************************************************************************ subroutine XCcoeff(C, para) implicit none ComplexType C(*) DVAR para(1,*) #include "lt.h" memindex XBget external XBget DVAR p1, p2, p1p2, m1, m2, m3 DVAR f1, f2 QVAR G(2,2) ComplexType bsum, b1sum, b00sum, b11sum, in(2) integer finite memindex B12, B23, B13 logical dump #ifdef SOLVE_EIGEN QVAR Ginv(2,2) #define SOLVE_SETUP XInverse(2, G,2, Ginv,2) #define SOLVE(b) XSolve(2, G,2, Ginv,2, b) #else integer perm(2) #define IN(i) in(perm(i)) #define SOLVE_SETUP XDecomp(2, G,2, perm) #define SOLVE(b) XSolve(2, G,2, b) #endif m1 = M(1) m2 = M(2) m3 = M(3) p1 = P(1) p2 = P(2) p1p2 = P(3) finite = 1 if( lambda .lt. 0 ) finite = 0 B12 = XBget(p1, m1, m2) B23 = XBget(p2, m2, m3) B13 = XBget(p1p2, m1, m3) 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") 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 = Bval(bb0,B23) + Bval(bb1,B23) b1sum = Bval(bb1,B23) + Bval(bb11,B23) b00sum = Bval(bb00,B23) + Bval(bb001,B23) b11sum = Bval(bb11,B23) + Bval(bb111,B23) call XC0para(C(cc0), para) IN(1) = f1*C(cc0) - Bval(bb0,B23) + Bval(bb0,B13) IN(2) = f2*C(cc0) - Bval(bb0,B23) + Bval(bb0,B12) call SOLVE(in) C(cc1) = in(1) C(cc2) = in(2) C(cc00) = .5D0*(m1*C(cc0) - & .5D0*(f1*C(cc1) + f2*C(cc2) - Bval(bb0,B23) - finite)) IN(1) = f1*C(cc1) + bsum - 2*C(cc00) IN(2) = f2*C(cc1) + bsum + Bval(bb1,B12) call SOLVE(in) C(cc11) = in(1) C(cc12) = in(2) IN(1) = f1*C(cc2) - Bval(bb1,B23) + Bval(bb1,B13) IN(2) = f2*C(cc2) - Bval(bb1,B23) - 2*C(cc00) call SOLVE(in) C(cc12) = .5D0*(C(cc12) + in(1)) C(cc22) = in(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) - Bval(bb1,B23) + finite/3D0)) bsum = bsum + b1sum IN(1) = f1*C(cc11) - bsum - 4*C(cc001) IN(2) = f2*C(cc11) - bsum + Bval(bb11,B12) call SOLVE(in) C(cc111) = in(1) C(cc112) = in(2) IN(1) = f1*C(cc22) - Bval(bb11,B23) + Bval(bb11,B13) IN(2) = f2*C(cc22) - Bval(bb11,B23) - 4*C(cc002) call SOLVE(in) C(cc122) = in(1) C(cc222) = in(2) C(cc0000) = 1/4D0*(m1*C(cc00) - & .5D0*(f1*C(cc001) + f2*C(cc002) - Bval(bb00,B23) - & finite*(m1 + m2 + m3 - .25D0*(p1 + p2 + p1p2))/6D0)) IN(1) = f1*C(cc001) + b00sum - 2*C(cc0000) IN(2) = f2*C(cc001) + b00sum + Bval(bb001,B12) call SOLVE(in) C(cc0011) = in(1) C(cc0012) = in(2) IN(1) = f1*C(cc002) - Bval(bb001,B23) + Bval(bb001,B13) IN(2) = f2*C(cc002) - Bval(bb001,B23) - 2*C(cc0000) call SOLVE(in) C(cc0012) = .5D0*(C(cc0012) + in(1)) C(cc0022) = in(2) bsum = bsum + b1sum + b11sum IN(1) = f1*C(cc111) + bsum - 6*C(cc0011) IN(2) = f2*C(cc111) + bsum + Bval(bb111,B12) call SOLVE(in) C(cc1111) = in(1) C(cc1112) = in(2) IN(1) = f1*C(cc222) - Bval(bb111,B23) + Bval(bb111,B13) IN(2) = f2*C(cc222) - Bval(bb111,B23) - 6*C(cc0022) call SOLVE(in) C(cc1222) = in(1) C(cc2222) = in(2) IN(1) = f1*C(cc122) + b11sum - 2*C(cc0022) IN(2) = f2*C(cc122) + b11sum - 4*C(cc0012) call SOLVE(in) C(cc1122) = in(1) C(cc1222) = .5D0*(C(cc1222) + in(2)) if( dump ) call XDumpCoeff(3, C) end looptools-2.8.orig/src/C/ffdel3.F0000644000175000017500000001371311776502522017475 0ustar sylvestresylvestre#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.8.orig/src/C/ffxc0i.F0000644000175000017500000004254411776502522017515 0ustar sylvestresylvestre#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.8.orig/src/C/ffxc0p0.F0000644000175000017500000000276511776502522017605 0ustar sylvestresylvestre#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.8.orig/src/C/ffxc0.F0000644000175000017500000004162511776502522017343 0ustar sylvestresylvestre#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.8.orig/src/C/ffdxc0.F0000644000175000017500000005462111776502522017507 0ustar sylvestresylvestre#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.8.orig/src/C/ffcc0p.F0000644000175000017500000003010211776502522017462 0ustar sylvestresylvestre#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.8.orig/src/C/ffcc0.F0000644000175000017500000006075211776502522017320 0ustar sylvestresylvestre#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.8.orig/src/C/C0C.F0000644000175000017500000000417412024320551016663 0ustar sylvestresylvestre* C0C.F * the scalar three-point function for complex parameters * this file is part of LoopTools * last modified 13 Sep 12 th #include "externals.h" #include "types.h" #define npoint 3 #include "defs.h" ComplexType function C0C(p1, p2, p1p2, m1, m2, m3) implicit none ComplexType p1, p2, p1p2, m1, m2, m3 #include "lt.h" ComplexType para(1,Pcc) ComplexType C0 external C0 P(1) = p1 P(2) = p2 P(3) = p1p2 if( abs(Im(P(1))) + abs(Im(P(2))) + abs(Im(P(3))) .gt. 0 ) & print *, "C0C: Complex momenta not implemented" 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 if( abs(Im(M(1))) + abs(Im(M(2))) + abs(Im(M(3))) .eq. 0 ) then C0C = C0(p1, p2, p1p2, m1, m2, m3) return endif call C0Cpara(C0C, para) end ************************************************************************ * subroutine version for C++ subroutine c0subc(res, p1, p2, p1p2, m1, m2, m3) implicit none ComplexType res, p1, p2, p1p2, m1, m2, m3 #include "lt.h" ComplexType para(1,Pcc) P(1) = p1 P(2) = p2 P(3) = p1p2 if( abs(Im(P(1))) + abs(Im(P(2))) + abs(Im(P(3))) .gt. 0 ) & print *, "C0C: Complex momenta not implemented" 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 if( abs(Im(M(1))) + abs(Im(M(2))) + abs(Im(M(3))) .eq. 0 ) then call c0sub(res, p1, p2, p1p2, m1, m2, m3) return endif call C0Cpara(res, para) end ************************************************************************ subroutine C0Cpara(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.8.orig/src/makefile0000644000175000017500000001714012026272006017525 0ustar sylvestresylvestredefault: 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) \ A0.o A0C.o A00.o A00C.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 \ C0.o C0C.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 \ D0.o D0C.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 \ E0.o E0C.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 A0.o: A0.F $(LTINC) $(XFC) -c -o A0.o A0.F A0C.o: A0.F $(LTINC) $(CFC) -c -o A0C.o A0.F A00.o: A00.F $(LTINC) $(XFC) -c -o A00.o A00.F A00C.o: A00.F $(LTINC) $(CFC) -c -o A00C.o A00.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 C0.o: C0.F $(LTINC) perm.h $(XFC) -c -o C0.o C0.F C0C.o: C0C.F $(LTINC) $(XFC) -c -o C0C.o C0C.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 D0.o: D0.F $(LTINC) perm.h $(XFC) -c -o D0.o D0.F D0C.o: D0C.F $(LTINC) $(XFC) -c -o D0C.o D0C.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 E0.o: E0.F $(LTINC) $(XFC) -c -o E0.o E0.F E0C.o: E0.F $(LTINC) $(CFC) -c -o E0C.o E0.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 solve-LU.F solve-Eigen.F $(LTINC) $(XFC) -c -o solve.o solve.F solveC.o: solve.F solve-LU.F solve-Eigen.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) -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 f77290: f77290.c $(CC) $(CFLAGS) -o f77290 f77290.c looptools.h90: looptools.h f77290 f77290 looptools.h looptools.h90 $(LIB): $(OBJS) $(AR) cru $(LIB) $? -$(RANLIB) $(LIB) $(FE): lt.F $(LTINC) $(LIB) $(XFC) -o $(FE) lt.F $(LIB) -rm -f lt.o clooptools.h: clooptools.h.in ftypes.h sed "s:NOUNDERSCORE:$(NOUNDERSCORE):" ftypes.h clooptools.h.in > clooptools.h fcc: fcc.in sed -e 's|^fldflags=.*|fldflags="$(LDFLAGS)"|' fcc.in > fcc chmod 755 fcc ln -s fcc f++ LoopTools$(EXE): LoopTools.tm clooptools.h fortranflush.o $(LIB) fcc NM="$(NM)" DLLTOOL="$(DLLTOOL)" \ CC="./fcc" REALCC="$(CC) $(CFLAGS)" \ CXX="./f++" REALCXX="$(CXX) $(CXXFLAGS)" \ PATH="$$PATH:." \ "$(MCC)" LoopTools.tm -o LoopTools$(EXE) $(MCFLAGS) \ fortranflush.o $(LIB) -lpthread 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" REALCC="$(CC) $(CFLAGS)" \ CXX="./f++" REALCXX="$(CXX) $(CXXFLAGS)" \ 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.8.orig/src/D/0000755000175000017500000000000012023554526016214 5ustar sylvestresylvestrelooptools-2.8.orig/src/D/D0.F0000644000175000017500000013511512030312645016564 0ustar sylvestresylvestre* D0.F * the scalar four-point function * this file is part of LoopTools * last modified 25 Sep 12 th #include "externals.h" #include "types.h" #define npoint 4 #include "defs.h" ComplexType function D0(p1, p2, p3, p4, p1p2, p2p3, & m1, m2, m3, m4) implicit none RealType p1, p2, p3, p4, p1p2, p2p3 RealType m1, m2, m3, m4 #include "lt.h" RealType para(1,Pdd+3) 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 call D0para(D0, para) end ************************************************************************ * subroutine version for C++ subroutine d0sub(res, p1, p2, p3, p4, p1p2, p2p3, & m1, m2, m3, m4) implicit none ComplexType res RealType p1, p2, p3, p4, p1p2, p2p3 RealType m1, m2, m3, m4 #include "lt.h" RealType para(1,Pdd+3) 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 call D0para(res, para) end ************************************************************************ subroutine D0para(res, para) implicit none ComplexType res RealType para(1,*) #include "lt.h" external D0softDR, D0collDR, D0soft, D0coll if( lambda .le. 0 ) then call DDispatch(res, para, D0softDR, D0collDR) else call DDispatch(res, para, D0soft, D0coll) endif end ************************************************************************ subroutine DDispatch(res, para, soft, coll) implicit none ComplexType res 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) c PRINT '(I3,O12)', i, perm c PRINT '(6F14.2)', Px(1), Px(2), Px(3), Px(4), Px(5), Px(6) c PRINT '(4F14.2)', Mx(1), Mx(2), Mx(3), Mx(4) if( abs(Mx(1)) .lt. eps ) then if( abs(Px(1)) + abs(Mx(2)) .lt. eps ) then if( DEBUGLEVEL .gt. 0 ) & print '("collinear D0, perm = ",O10)', perm call coll(res, para, perm) if( res .ne. perm ) return endif if( s .eq. 0 .and. & abs(Px(1) - Mx(2)) + & abs(Px(4) - Mx(4)) .lt. acc ) s = perm if( z .eq. 0 ) z = perm endif enddo if( lambda .lt. 0 ) then res = 0 if( s .eq. 0 ) return if( DEBUGLEVEL .gt. 0 ) & print '("soft D0, perm = ",O10)', s call soft(res, para, s) 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, para, ier) if( ier .gt. warndigits ) then ier = 0 call ffxd0r(res, 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 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, para) goto 9 endif perm = z z = 0 if( abs(Mx(2)) .lt. eps ) z = 1 if( abs(Mx(3)) .lt. eps ) z = z + 2 if( abs(Mx(4)) .lt. eps ) 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, para, perm) goto 9 2 call D0m2(res, para, perm) goto 9 3 call D0m1(res, para, perm) goto 9 4 call D0m0(res, para) 9 if( key .gt. 1 .and. & abs(res - 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 endif if( .not. btest(key, 0) ) res = 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. eps ) then if( abs(p1 - p2) + abs(p3 - p4) .lt. acc ) 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 = 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. acc ) 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. acc ) 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 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. acc ) 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) res = perm 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 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) if( lambda .eq. -2 ) then res = 0 return endif 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 if( abs(m3) .lt. eps ) then if( abs(q2) + abs(q3) .lt. acc ) then * qlbox14: D0(m2, m2, m4, m4; p1p2, p2p3; 0, m2, 0, m4) if( DEBUGLEVEL .gt. 1 ) print *, "D0softDR: qlbox14" res = 2*fac*lxs if( lambda .ne. -1 ) res = res*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 *, "D0softDR: qlbox15" if( lambda .eq. -1 ) then res = fac*lxs return endif if( abs(q2*q3) .lt. acc ) then m24 = m2 if( abs(q2) .lt. acc ) m24 = m4 res = 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 = fac*( -log(mudim/(r1*r4)) + & lnrat(q2, t) + lnrat(q3, t) + 2 + & (1 + y)/(1 - y)*ln(y, sy) ) else res = 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" if( lambda .eq. -1 ) then res = fac*lxs return endif 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. acc ) 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. acc ) then c = -2*(x2**2 + 1)/((x2 - 1)*(x2 + 1))*lx2 endif res = fac*(c - lm) else res = 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 D0collDR(res, para, perm) implicit none ComplexType res RealType para(1,*) integer perm #include "lt.h" #include "perm.h" integer 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) z = 0 if( abs(Mx(3)) .lt. eps ) z = 1 if( abs(Mx(4)) .lt. eps ) z = z + 2 if( abs(Px(2)) .lt. eps ) z = z + 4 if( abs(Px(3)) .lt. eps ) z = z + 8 if( abs(Px(4)) .lt. eps ) z = z + 16 if( abs(Px(5)) .lt. eps ) z = z + 32 if( abs(Px(6)) .lt. eps ) 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 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) if( lambda .eq. -2 )then res = 4*fac else if( lambda .eq. -1 ) then res = 2*fac*(-lnrat(t, mudim) - lnrat(s, mudim)) else lsm = lnrat(s, mudim) ltm = lnrat(t, mudim) lts = lnrat(t, s) res = fac*((ltm - pi)*(ltm + pi) + (lts - lsm)*(lts + lsm)) 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 integer ldpara, perm RealType para(ldpara,*) #include "lt.h" RealType s, t, m4, fac ComplexType 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) if( lambda .eq. -2 ) then res = 2*fac else if( lambda .eq. -1 ) then res = 2*fac*(lnrat(m4, mudim) - & lnrat(t, mudim) - lnrat(s, mudim)) else l1 = sqrt(lnrat(t, mudim)**2 + lnrat(m4, t)**2 + & lnrat(s, mudim)**2 + lnrat(m4, s)**2) l2 = sqrt(lnrat(m4, mudim)**2 + lnrat(t, s)**2) res = fac*((l1 - l2)*(l1 + l2) + & 2*(Li2omrat(t, m4) + Li2omrat(s, m4) - pi6)) endif end ************************************************************************ subroutine D0m0p2(res, para,ldpara, perm) implicit none ComplexType res integer ldpara, perm RealType para(ldpara,*) #include "lt.h" RealType s, t, q2, q3, q4, fac, r ComplexType ls, lt, lq2, lq3, lq4 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. eps ) 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" if( lambda .eq. -2 ) then res = 0 return endif 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 if( lambda .eq. -1 ) then res = -(2 + r)*fac else res = 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))) endif else * general case fac = 1/(s*t - q2*q4) if( lambda .eq. -1 ) then res = 2*fac*(lnrat(q2, s) + lnrat(q4, t)) else ls = lnrat(s, mudim) lt = lnrat(t, mudim) lq2 = lnrat(q2, mudim) lq4 = lnrat(q4, mudim) res = 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)) ) endif endif return endif * 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" if( lambda .eq. -2 ) then res = fac else if( lambda .eq. -1 ) then res = -fac*(lnrat(s, q3) + lnrat(t, q4) + lnrat(t, mudim)) else ls = lnrat(s, mudim) lt = lnrat(t, mudim) lq3 = lnrat(q3, mudim) lq4 = lnrat(q4, mudim) res = fac*( & .5D0*((ls - lq3)*(ls + lq3) + & (lt - lq4)*(lt + lq4) + lt**2) + & lnrat(s, q3)*lnrat(s, q4) - lnrat(s, t)**2 - & 2*(Li2omrat(q3, t) + Li2omrat(q4, t)) ) 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 integer ldpara, perm RealType para(ldpara,*) #include "lt.h" RealType s, t, q2, q3, q4, fac, r ComplexType lndiv0, lndiv1, Li2omrat, Li2omrat2 external lndiv0, lndiv1, Li2omrat, Li2omrat2 if( DEBUGLEVEL .gt. 1 ) & call DDump("D0m0p3: qlbox5", para,ldpara, perm) if( lambda .eq. -2 ) then res = 0 return endif 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 if( lambda .eq. -1 ) then res = -.5D0*(2 + r)*fac else res = lndiv0(q4, t) res = fac*( & .5D0*(2 + r)*(2 + (1 + q4/t)*res - & lnrat(mudim, s) - lnrat(q3, t)) + & r*(lndiv1(q4, t) - res - 1) ) endif else * general case fac = 1/(s*t - q2*q4) if( lambda .eq. -1 ) then res = fac*(lnrat(q2, t) + lnrat(q4, s)) else res = fac*( & (lnrat(q3, t) + lnrat(mudim, t))*lnrat(q2, t) + & (lnrat(q3, s) + lnrat(mudim, s))*lnrat(q4, s) - & .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)) ) endif endif end ************************************************************************ subroutine D0m1p2(res, para, perm) implicit none ComplexType res 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. acc ) ir = 1 if( abs(q4) .lt. acc ) then ir = ir + 1 q4 = q3 endif if( lambda .eq. -2 ) then res = .5D0*(2 + ir)*fac return endif 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) if( lambda .eq. -1 ) then res = fac*(lnrat(q3, t) + lnrat(q4, t) - lm) else ls = lnrat(s, m4) res = 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)) endif return 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) if( lambda .eq. -1 ) then res = fac*(1.5D0*lm - 2*lt - ls + lq) else res = fac*(2*ls*lt - lq**2 - 5*pi12 + & lm*(.75D0*lm - 2*lt - ls + lq) - & 2*Li2omrat(q4, t)) endif return 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) if( lambda .eq. -1 ) then res = fac*(2*(lm - lt) - ls) else res = fac*((lm - ls)*(lm - 2*lt) - .5D0*pi**2) endif end ************************************************************************ subroutine D0m1p3(res, para, perm) implicit none ComplexType res RealType para(1,*) integer perm #include "lt.h" RealType s, t, m4, q2, q3, q4, m4mu, fac ComplexType Li2omrat, Li2omrat2 external Li2omrat, Li2omrat2 if( DEBUGLEVEL .gt. 1 ) call DDump("D0m1p3", para,1, perm) if( lambda .eq. -2 ) then res = 0 return endif 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. acc ) 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. acc ) then if( DEBUGLEVEL .gt. 1 ) print *, "D0m1p3: qlbox9" fac = 1/(s*t) if( lambda .eq. -1 ) then res = -fac*(lnrat(t, m4mu) + lnrat(s, q2)) else res = fac*(Li2omrat2(q3, q2, t, m4) + 2*Li2omrat(s, q2) + & lnrat(t, m4mu) + lnrat(s, q2) + pi12) endif return endif * 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) res = fac*(lnrat(q2, mudim) + lnrat(q4, mudim) - & lnrat(s, mudim) - lnrat(t, mudim)) if( lambda .ne. -1 ) then res = 2*res*lnrat(m4mu, t) + & fac*(Li2omrat2(q3, q2, t, m4) - Li2omrat2(q3, s, q4, m4) + & 2*(Li2omrat2(q2, s, q4, t) + & Li2omrat(q2, s) - Li2omrat(t, q4))) endif end ************************************************************************ subroutine D0m2p3(res, para, perm) implicit none ComplexType res 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. acc .or. abs(t) .lt. acc ) 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. acc ) ir = 1 if( abs(q4) .lt. acc ) then ir = ir + 1 q4 = q3 tmp = s s = t t = tmp m4 = m3 m3 = Mx(4) endif if( lambda .eq. -2 ) then res = .5D0*fac*ir return endif if( lambda .eq. -1 ) goto (10, 11, 12) ir + 1 p3 = Px(3) if( abs(p3) .lt. eps ) 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. eps ) 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, x43(4), x43(2)) + & Li2omrat2(q3, t, x43(3), x43(1)) + & Li2omrat2(q4, s, x43(1), x43(3)) + & Li2omrat2(q4, s, x43(2), 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 = -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)) return 10 res = fac*(lnrat(q3, mudim) + lnrat(q4, mudim) - & lnrat(s, mudim) - lnrat(t, mudim)) return 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, x43(1), x43(3)) + & Li2omrat2(q4, s, x43(2), 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 = -fac*(dilogs + .5D0*logs + pi12 + & 2*(Li2omrat(q4, t) - ls*lt) + & lq4**2 + (ls - lq4)*log(m4/m3)) return 11 m3mu = sqrt(m3*mudim) res = fac*(lnrat(q4, m3mu) - lnrat(s, m3mu) - lnrat(t, m3mu)) 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) if( DEBUGLEVEL .gt. 1 ) print *, "D0m2p3: qlbox11" res = fac*(.25D0*log(m3/m4)**2 - .5D0*(logs + pi**2) + & 2*lnrat(s, sqrt(m3*mudim))*lnrat(t, sqrt(m4*mudim))) return 12 res = -fac*(lnrat(s, sqrt(m3*mudim)) + & lnrat(t, sqrt(m4*mudim))) 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) c#define AddEps(k) k*ToComplex(1D0, -sign(eps, k)) #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 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) 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) 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) 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))) 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*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))) 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))) 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))) 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.8.orig/src/D/ffT13.F0000644000175000017500000000655211776502523017222 0ustar sylvestresylvestre* 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.8.orig/src/D/D0C.F0000644000175000017500000006501712026323237016676 0ustar sylvestresylvestre* D0C.F * the scalar four-point function with complex masses * this file is part of LoopTools * last modified 19 Sep 12 th #include "externals.h" #include "types.h" #define npoint 4 #include "defs.h" ComplexType function D0C(p1, p2, p3, p4, p1p2, p2p3, & m1, m2, m3, m4) implicit none ComplexType p1, p2, p3, p4, p1p2, p2p3 ComplexType m1, m2, m3, m4 #include "lt.h" ComplexType D0 external D0 ComplexType para(1,Pdd) P(1) = p1 P(2) = p2 P(3) = p3 P(4) = p4 P(5) = p1p2 P(6) = p2p3 if( abs(Im(P(1))) + abs(Im(P(2))) + & abs(Im(P(3))) + abs(Im(P(4))) + & abs(Im(P(5))) + abs(Im(P(6))) .gt. 0 ) & print *, "D0C: Complex momenta not implemented" 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 if( abs(Im(M(1))) + abs(Im(M(2))) + & abs(Im(M(3))) + abs(Im(M(4))) .eq. 0 ) then D0C = D0(p1, p2, p3, p4, p1p2, p2p3, & m1, m2, m3, m4) return endif call D0Cpara(D0C, para) end ************************************************************************ * subroutine version for C++ subroutine d0subc(res, p1, p2, p3, p4, p1p2, p2p3, & m1, m2, m3, m4) implicit none ComplexType res ComplexType p1, p2, p3, p4, p1p2, p2p3 ComplexType m1, m2, m3, m4 #include "lt.h" ComplexType para(1,Pdd) P(1) = p1 P(2) = p2 P(3) = p3 P(4) = p4 P(5) = p1p2 P(6) = p2p3 if( abs(Im(P(1))) + abs(Im(P(2))) + & abs(Im(P(3))) + abs(Im(P(4))) + & abs(Im(P(5))) + abs(Im(P(6))) .gt. 0 ) & print *, "D0C: Complex momenta not implemented" 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 if( abs(Im(M(1))) + abs(Im(M(2))) + & abs(Im(M(3))) + abs(Im(M(4))) .eq. 0 ) then call d0sub(res, p1, p2, p3, p4, p1p2, p2p3, & m1, m2, m3, m4) return endif call D0Cpara(res, para) end ************************************************************************ subroutine D0Cpara(res, para) implicit none ComplexType res, para(1,*) #include "lt.h" external D0CsoftDR, D0CcollDR, D0Csoft, D0Ccoll 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, para(1,*) external soft, coll #include "lt.h" #include "perm.h" integer i, z, s, perm, ier, key 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 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. eps ) then if( abs(Px(1)) + abs(Mc(2)) .lt. eps ) then call coll(res, para, perm) if( res .ne. perm ) return endif if( s .eq. 0 .and. & abs(Px(1) - Mc(2)) + & abs(Px(4) - Mc(4)) .lt. acc ) s = perm if( z .eq. 0 ) z = perm endif enddo if( s .ne. 0 ) then call soft(res, para, s) return endif if( lambda .lt. 0 ) then res = 0 return endif key = ibits(versionkey, KeyD0C, 2) if( key .ne. 1 ) then call ffd0c(res, para, 0, ier) if( key .eq. 0 ) return alt = res endif ier = 0 call ffd0c(res, para, 1, ier) if( key .gt. 1 .and. & abs(res - 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 if( ier .le. errdigits ) res = alt endif if( .not. btest(key, 1) ) res = 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. eps ) then if( abs(p1 - p2) + abs(p3 - p4) .lt. acc ) then res = -2*ln(-lambda/p1p2, 1)*lxs*fac return endif y = (r1*(p3 - p4 + cI*eps))/(r4*(p2 - p1 + cI*eps)) 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. acc ) 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. acc ) 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. acc ) then bdKC = 1 else t = 4*m1*m2/(d + cI*eps) 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) res = perm 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, 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) if( lambda .eq. -2 ) then res = 0 return endif 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 if( abs(m3) .lt. eps ) then * (should have been re-routed to real D0, keep here for safety) if( abs(q2) + abs(q3) .lt. acc ) then * qlbox14: D0(m2, m2, m4, m4; p1p2, p2p3; 0, m2, 0, m4) if( DEBUGLEVEL .gt. 1 ) print *, "D0CsoftDR: qlbox14" res = 2*fac*lxs if( lambda .ne. -1 ) res = res*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( lambda .eq. -1 ) then res = fac*lxs return endif if( abs(q2*q3) .lt. acc ) then m24 = m2 if( abs(q2) .lt. acc ) m24 = m4 res = 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 = fac*( -log(mudim/(r1*r4)) + & lnrat(q2, t) + lnrat(q3, t) + 2 + & (1 + y)/(1 - y)*ln(y, sy) ) else res = 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" if( lambda .eq. -1 ) then res = fac*lxs return endif 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. acc ) 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. acc ) then c = -2*(x2**2 + 1)/((x2 - 1)*(x2 + 1))*lx2 endif res = fac*(c - lm) else res = 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, para(1,*) integer perm #include "lt.h" #include "perm.h" integer 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) z = 0 if( abs(Mc(3)) .lt. eps ) z = 1 if( abs(Mc(4)) .lt. eps ) z = z + 2 if( abs(Px(2)) .lt. eps ) z = z + 4 if( abs(Px(3)) .lt. eps ) z = z + 8 if( abs(Px(4)) .lt. eps ) z = z + 16 if( abs(Px(5)) .lt. eps ) z = z + 32 if( abs(Px(6)) .lt. eps ) 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, 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. acc ) ir = 1 if( abs(q4) .lt. acc ) then ir = ir + 1 q4 = q3 endif if( lambda .eq. -2 ) then res = .5D0*(2 + ir)*fac return endif 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) if( lambda .eq. -1 ) then res = fac*(lnrat(q3, t) + lnrat(q4, t) - lm) else ls = lnrat(s, m4) res = 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, mudimc)*lnrat(q3, m4) - & lnrat(q4, mudimc)*lnrat(q4, m4)) endif 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) if( lambda .eq. -1 ) then res = fac*(1.5D0*lm - 2*lt - ls + lq) else res = fac*(2*ls*lt - lq**2 - 5*pi12 + & lm*(.75D0*lm - 2*lt - ls + lq) - & 2*Li2omrat(q4, t)) endif 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) if( lambda .eq. -1 ) then res = fac*(2*(lm - lt) - ls) else res = fac*((lm - ls)*(lm - 2*lt) - .5D0*pi**2) endif end ************************************************************************ subroutine D0Cm1p3(res, para, perm) implicit none ComplexType res, para(1,*) integer perm #include "lt.h" ComplexType s, q2 ComplexType m4, m4mu, q3, q4, t, fac ComplexType Li2omrat, cLi2omrat, Li2omrat2, cLi2omrat2 external Li2omrat, cLi2omrat, Li2omrat2, cLi2omrat2 if( DEBUGLEVEL .gt. 1 ) call DCDump("D0Cm1p3", para, perm) if( lambda .eq. -2 ) then res = 0 return endif 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. acc ) 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. acc ) then if( DEBUGLEVEL .gt. 1 ) print *, "D0Cm1p3: qlbox9" fac = 1/(Re(s)*Re(t)) if( lambda .eq. -1 ) then res = -fac*(lnrat(t, m4mu) + lnrat(s, q2)) else res = fac*(Li2omrat2(q3, q2, t, m4) + 2*Li2omrat(s, q2) + & lnrat(t, m4mu) + lnrat(s, q2) + pi12) endif 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) res = fac*(lnrat(q2, mudim) + lnrat(q4, mudimc) - & lnrat(s, mudim) - lnrat(t, mudimc)) if( lambda .ne. -1 ) then res = 2*res*lnrat(m4mu, t) + fac*( & cLi2omrat2(q3, q2, t, m4) - & cLi2omrat2(q3, s, q4, m4) + & 2*(cLi2omrat2(q2, s, q4, t) + & cLi2omrat(q2, s) - cLi2omrat(t, q4)) ) endif end ************************************************************************ subroutine D0Cm2p3(res, para, perm) implicit none ComplexType res, 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. acc .or. abs(t) .lt. acc ) 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. acc ) ir = 1 if( abs(q4) .lt. acc ) then ir = ir + 1 q4 = q3 tmp = s s = t t = tmp m4 = m3 m3 = Mc(4) endif if( lambda .eq. -2 ) then res = .5D0*fac*ir return endif if( lambda .eq. -1 ) goto (10, 11, 12) ir + 1 p3 = Px(3) if( abs(p3) .lt. eps ) 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. eps ) 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, mudimc) lt = lnrat(t, mudimc) lq3 = lnrat(q3, mudimc) lq4 = lnrat(q4, mudimc) 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 = -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)) return 10 res = fac*(lnrat(q3, mudim) + lnrat(q4, mudim) - & lnrat(s, mudim) - lnrat(t, mudim)) 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 = 0 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 = -fac*(dilogs + .5D0*logs + pi12 + & 2*(cLi2omrat(q4, t) - ls*lt) + & lq4**2 + (ls - lq4)*log(m4/m3)) return 11 continue m3mu = sqrt(Re(m3)*mudim) res = fac*(lnrat(q4, m3mu) - & lnrat(s, m3mu) - lnrat(t, m3mu)) 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" res = fac*(.25D0*log(Re(m3)/Re(m4))**2 - & .5D0*(logs + pi**2) + & 2*lnrat(s, sqrt(Re(m3)*mudim))* & lnrat(t, sqrt(Re(m4)*mudim))) return 12 res = -fac*(lnrat(s, sqrt(Re(m3)*mudim)) + & lnrat(t, sqrt(Re(m4)*mudim))) end looptools-2.8.orig/src/D/ffxd0h.F0000644000175000017500000004147411776502523017520 0ustar sylvestresylvestre#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.8.orig/src/D/ffxd0m0.F0000644000175000017500000000334011776502523017573 0ustar sylvestresylvestre#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.8.orig/src/D/ffdel4.F0000644000175000017500000002071511776502523017500 0ustar sylvestresylvestre#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.8.orig/src/D/ffd0c.F0000644000175000017500000001035411776502523017314 0ustar sylvestresylvestre* ffd0c.F * the scalar four-point function with complex masses * this file is part of LoopTools * last modified 3 Mar 11 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.8.orig/src/D/ffxd0.F0000644000175000017500000004437011776502523017346 0ustar sylvestresylvestre#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.8.orig/src/D/ffTn.F0000644000175000017500000002766711776502523017246 0ustar sylvestresylvestre* 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.8.orig/src/D/ffS3n.F0000644000175000017500000000532011776502523017306 0ustar sylvestresylvestre* 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.8.orig/src/D/ffxd0i.F0000644000175000017500000000704511776502523017515 0ustar sylvestresylvestre#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.8.orig/src/D/Dget.F0000644000175000017500000003256712024312060017205 0ustar sylvestresylvestre* Dget.F * retrieve the four-point tensor coefficients * this file is part of LoopTools * improvements by M. Rauch * last modified 13 Sep 12 th #include "externals.h" #include "types.h" #define npoint 4 #include "defs.h" memindex function XDget(p1, p2, p3, p4, p1p2, p2p3, & m1, m2, m3, m4) implicit none DVAR p1, p2, p3, p4, p1p2, p2p3 DVAR m1, m2, m3, m4 #include "lt.h" memindex cacheindex external cacheindex, XDcoeff #ifdef COMPLEXPARA memindex Dget external Dget #endif DVAR para(1,Pdd+3) P(1) = p1 P(2) = p2 P(3) = p3 P(4) = p4 P(5) = p1p2 P(6) = p2p3 #ifdef COMPLEXPARA if( abs(Im(P(1))) + abs(Im(P(2))) + & abs(Im(P(3))) + abs(Im(P(4))) + & abs(Im(P(5))) + abs(Im(P(6))) .gt. 0 ) & print *, "DgetC: Complex momenta not implemented" #endif 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 #ifdef COMPLEXPARA if( abs(Im(M(1))) + abs(Im(M(2))) + & abs(Im(M(3))) + abs(Im(M(4))) .eq. 0 ) then XDget = Dget(p1, p2, p3, p4, p1p2, p2p3, & m1, m2, m3, m4) - offsetC return endif #endif XDget = cacheindex(para, Dval(1,0), XDcoeff, RC*Pdd, Ndd) end ************************************************************************ subroutine XDput(res, p1, p2, p3, p4, p1p2, p2p3, & m1, m2, m3, m4) implicit none ComplexType res(*) DVAR p1, p2, p3, p4, p1p2, p2p3 DVAR m1, m2, m3, m4 #include "lt.h" external XDcoeff DVAR para(1,Pdd+3) P(1) = p1 P(2) = p2 P(3) = p3 P(4) = p4 P(5) = p1p2 P(6) = p2p3 #ifdef COMPLEXPARA if( abs(Im(P(1))) + abs(Im(P(2))) + & abs(Im(P(3))) + abs(Im(P(4))) + & abs(Im(P(5))) + abs(Im(P(6))) .gt. 0 ) & print *, "DputC: Complex momenta not implemented" #endif 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 #ifdef COMPLEXPARA if( abs(Im(M(1))) + abs(Im(M(2))) + & abs(Im(M(3))) + abs(Im(M(4))) .eq. 0 ) then call Dput(res, p1, p2, p3, p4, p1p2, p2p3, & m1, m2, m3, m4) return endif #endif call cachecopy(res, para, Dval(1,0), XDcoeff, RC*Pdd, Ndd) end ************************************************************************ ComplexType function XD0i(i, p1, p2, p3, p4, p1p2, p2p3, & m1, m2, m3, m4) implicit none integer i DVAR p1, p2, p3, p4, p1p2, p2p3 DVAR 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,b) end ************************************************************************ subroutine XDcoeff(D, para) implicit none ComplexType D(*) DVAR para(1,*) #include "lt.h" memindex XCget external XCget DVAR p1, p2, p3, p4, p1p2, p2p3, m1, m2, m3, m4 DVAR f1, f2, f3 QVAR G(3,3) ComplexType c0sum, c1sum, c2sum, csum ComplexType c00sum, c11sum, c12sum, c22sum ComplexType in(3) integer finite memindex C234, C134, C124, C123 logical dump #ifdef SOLVE_EIGEN QVAR Ginv(3,3) #define SOLVE_SETUP XInverse(3, G,3, Ginv,3) #define SOLVE(b) XSolve(3, G,3, Ginv,3, b) #else integer perm(3) #define IN(i) in(perm(i)) #define SOLVE_SETUP XDecomp(3, G,3, perm) #define SOLVE(b) XSolve(3, G,3, b) #endif 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) finite = 1 if( lambda .lt. 0 ) finite = 0 C234 = XCget(p2, p3, p2p3, m2, m3, m4) C134 = XCget(p1p2, p3, p4, m1, m3, m4) C124 = XCget(p1, p2p3, p4, m1, m2, m4) C123 = XCget(p1, p2, p1p2, m1, m2, m3) 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") 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 = Cval(cc0,C234) + Cval(cc1,C234) + Cval(cc2,C234) c1sum = Cval(cc1,C234) + Cval(cc11,C234) + Cval(cc12,C234) c2sum = Cval(cc2,C234) + Cval(cc12,C234) + Cval(cc22,C234) csum = c0sum + c1sum + c2sum c00sum = Cval(cc00,C234) + & Cval(cc001,C234) + Cval(cc002,C234) c11sum = Cval(cc11,C234) + & Cval(cc111,C234) + Cval(cc112,C234) c12sum = Cval(cc12,C234) + & Cval(cc112,C234) + Cval(cc122,C234) c22sum = Cval(cc22,C234) + & Cval(cc122,C234) + Cval(cc222,C234) call XD0para(D(dd0), para) IN(1) = f1*D(dd0) - Cval(cc0,C234) + Cval(cc0,C134) IN(2) = f2*D(dd0) - Cval(cc0,C234) + Cval(cc0,C124) IN(3) = f3*D(dd0) - Cval(cc0,C234) + Cval(cc0,C123) call SOLVE(in) D(dd1) = in(1) D(dd2) = in(2) D(dd3) = in(3) D(dd00) = m1*D(dd0) - .5D0* & (D(dd1)*f1 + D(dd2)*f2 + D(dd3)*f3 - Cval(cc0,C234)) IN(1) = f1*D(dd1) + c0sum - 2*D(dd00) IN(2) = f2*D(dd1) + c0sum + Cval(cc1,C124) IN(3) = f3*D(dd1) + c0sum + Cval(cc1,C123) call SOLVE(in) D(dd11) = in(1) D(dd12) = in(2) D(dd13) = in(3) IN(1) = f1*D(dd2) - Cval(cc1,C234) + Cval(cc1,C134) IN(2) = f2*D(dd2) - Cval(cc1,C234) - 2*D(dd00) IN(3) = f3*D(dd2) - Cval(cc1,C234) + Cval(cc2,C123) call SOLVE(in) D(dd12) = .5D0*(D(dd12) + in(1)) D(dd22) = in(2) D(dd23) = in(3) IN(1) = f1*D(dd3) - Cval(cc2,C234) + Cval(cc2,C134) IN(2) = f2*D(dd3) - Cval(cc2,C234) + Cval(cc2,C124) IN(3) = f3*D(dd3) - Cval(cc2,C234) - 2*D(dd00) call SOLVE(in) D(dd13) = .5D0*(D(dd13) + in(1)) D(dd23) = .5D0*(D(dd23) + in(2)) D(dd33) = in(3) IN(1) = f1*D(dd00) - Cval(cc00,C234) + Cval(cc00,C134) IN(2) = f2*D(dd00) - Cval(cc00,C234) + Cval(cc00,C124) IN(3) = f3*D(dd00) - Cval(cc00,C234) + Cval(cc00,C123) call SOLVE(in) D(dd001) = in(1) D(dd002) = in(2) D(dd003) = in(3) IN(1) = f1*D(dd11) - csum - 4*D(dd001) IN(2) = f2*D(dd11) - csum + Cval(cc11,C124) IN(3) = f3*D(dd11) - csum + Cval(cc11,C123) call SOLVE(in) D(dd111) = in(1) D(dd112) = in(2) D(dd113) = in(3) IN(1) = f1*D(dd22) - Cval(cc11,C234) + Cval(cc11,C134) IN(2) = f2*D(dd22) - Cval(cc11,C234) - 4*D(dd002) IN(3) = f3*D(dd22) - Cval(cc11,C234) + Cval(cc22,C123) call SOLVE(in) D(dd122) = in(1) D(dd222) = in(2) D(dd223) = in(3) IN(1) = f1*D(dd33) - Cval(cc22,C234) + Cval(cc22,C134) IN(2) = f2*D(dd33) - Cval(cc22,C234) + Cval(cc22,C124) IN(3) = f3*D(dd33) - Cval(cc22,C234) - 4*D(dd003) call SOLVE(in) D(dd133) = in(1) D(dd233) = in(2) D(dd333) = in(3) IN(1) = f1*D(dd13) + c2sum - 2*D(dd003) IN(2) = f2*D(dd13) + c2sum + Cval(cc12,C124) IN(3) = f3*D(dd13) + c2sum - 2*D(dd001) call SOLVE(in) D(dd113) = .5D0*(D(dd113) + in(1)) D(dd123) = in(2) D(dd133) = .5D0*(D(dd133) + in(3)) D(dd0000) = 1/3D0*(m1*D(dd00) - & .5D0*(f1*D(dd001) + f2*D(dd002) + f3*D(dd003) - & Cval(cc00,C234) - 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) - & Cval(cc11,C234))) D(dd0023) = 1/3D0*(m1*D(dd23) - & .5D0*(f1*D(dd123) + f2*D(dd223) + f3*D(dd233) - & Cval(cc12,C234))) D(dd0033) = 1/3D0*(m1*D(dd33) - & .5D0*(f1*D(dd133) + f2*D(dd233) + f3*D(dd333) - & Cval(cc22,C234))) 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 + Cval(cc111,C124) IN(3) = f3*D(dd111) + csum + Cval(cc111,C123) call SOLVE(in) D(dd1111) = in(1) D(dd1112) = in(2) D(dd1113) = in(3) IN(1) = f1*D(dd113) - c2sum - 4*D(dd0013) IN(2) = f2*D(dd113) - c2sum + Cval(cc112,C124) IN(3) = f3*D(dd113) - c2sum - 2*D(dd0011) call SOLVE(in) D(dd1113) = .5D0*(D(dd1113) + in(1)) D(dd1123) = in(2) D(dd1133) = in(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 + Cval(cc122,C123) call SOLVE(in) D(dd1122) = in(1) D(dd1222) = in(2) D(dd1223) = in(3) IN(1) = f1*D(dd222) - Cval(cc111,C234) + Cval(cc111,C134) IN(2) = f2*D(dd222) - Cval(cc111,C234) - 6*D(dd0022) IN(3) = f3*D(dd222) - Cval(cc111,C234) + Cval(cc222,C123) call SOLVE(in) D(dd1222) = .5D0*(D(dd1222) + in(1)) D(dd2222) = in(2) D(dd2223) = in(3) IN(1) = f1*D(dd233) - Cval(cc122,C234) + Cval(cc122,C134) IN(2) = f2*D(dd233) - Cval(cc122,C234) - 2*D(dd0033) IN(3) = f3*D(dd233) - Cval(cc122,C234) - 4*D(dd0023) call SOLVE(in) D(dd1233) = in(1) D(dd2233) = in(2) D(dd2333) = in(3) IN(1) = f1*D(dd333) - Cval(cc222,C234) + Cval(cc222,C134) IN(2) = f2*D(dd333) - Cval(cc222,C234) + Cval(cc222,C124) IN(3) = f3*D(dd333) - Cval(cc222,C234) - 6*D(dd0033) call SOLVE(in) D(dd1333) = in(1) D(dd2333) = .5D0*(D(dd2333) + in(2)) D(dd3333) = in(3) c00sum = c00sum + & Cval(cc001,C234) + Cval(cc0011,C234) + Cval(cc0012,C234) + & Cval(cc002,C234) + Cval(cc0012,C234) + Cval(cc0022,C234) c11sum = c11sum + & Cval(cc111,C234) + Cval(cc1111,C234) + Cval(cc1112,C234) + & Cval(cc112,C234) + Cval(cc1112,C234) + Cval(cc1122,C234) c12sum = c12sum + & Cval(cc112,C234) + Cval(cc1112,C234) + Cval(cc1122,C234) + & Cval(cc122,C234) + Cval(cc1122,C234) + Cval(cc1222,C234) c22sum = c22sum + & Cval(cc122,C234) + Cval(cc1122,C234) + Cval(cc1222,C234) + & Cval(cc222,C234) + Cval(cc1222,C234) + Cval(cc2222,C234) c1sum = c1sum + c11sum + c12sum c2sum = c2sum + c12sum + c22sum csum = csum + c1sum + c2sum IN(1) = f1*D(dd0000) - Cval(cc0000,C234) + Cval(cc0000,C134) IN(2) = f2*D(dd0000) - Cval(cc0000,C234) + Cval(cc0000,C124) IN(3) = f3*D(dd0000) - Cval(cc0000,C234) + Cval(cc0000,C123) call SOLVE(in) D(dd00001) = in(1) D(dd00002) = in(2) D(dd00003) = in(3) IN(1) = f1*D(dd0011) - c00sum - 4*D(dd00001) IN(2) = f2*D(dd0011) - c00sum + Cval(cc0011,C124) IN(3) = f3*D(dd0011) - c00sum + Cval(cc0011,C123) call SOLVE(in) D(dd00111) = in(1) D(dd00112) = in(2) D(dd00113) = in(3) IN(1) = f1*D(dd0022) - Cval(cc0011,C234) + Cval(cc0011,C134) IN(2) = f2*D(dd0022) - Cval(cc0011,C234) - 4*D(dd00002) IN(3) = f3*D(dd0022) - Cval(cc0011,C234) + Cval(cc0022,C123) call SOLVE(in) D(dd00122) = in(1) D(dd00222) = in(2) D(dd00223) = in(3) IN(1) = f1*D(dd0033) - Cval(cc0022,C234) + Cval(cc0022,C134) IN(2) = f2*D(dd0033) - Cval(cc0022,C234) + Cval(cc0022,C124) IN(3) = f3*D(dd0033) - Cval(cc0022,C234) - 4*D(dd00003) call SOLVE(in) D(dd00133) = in(1) D(dd00233) = in(2) D(dd00333) = in(3) IN(1) = f1*D(dd0023) - Cval(cc0012,C234) + Cval(cc0012,C134) IN(2) = f2*D(dd0023) - Cval(cc0012,C234) - 2*D(dd00003) IN(3) = f3*D(dd0023) - Cval(cc0012,C234) - 2*D(dd00002) call SOLVE(in) D(dd00123) = in(1) D(dd00223) = .5D0*(D(dd00223) + in(2)) D(dd00233) = .5D0*(D(dd00233) + in(3)) IN(1) = f1*D(dd1111) - csum - 8*D(dd00111) IN(2) = f2*D(dd1111) - csum + Cval(cc1111,C124) IN(3) = f3*D(dd1111) - csum + Cval(cc1111,C123) call SOLVE(in) D(dd11111) = in(1) D(dd11112) = in(2) D(dd11113) = in(3) IN(1) = f1*D(dd2222) - Cval(cc1111,C234) + Cval(cc1111,C134) IN(2) = f2*D(dd2222) - Cval(cc1111,C234) - 8*D(dd00222) IN(3) = f3*D(dd2222) - Cval(cc1111,C234) + Cval(cc2222,C123) call SOLVE(in) D(dd12222) = in(1) D(dd22222) = in(2) D(dd22223) = in(3) IN(1) = f1*D(dd3333) - Cval(cc2222,C234) + Cval(cc2222,C134) IN(2) = f2*D(dd3333) - Cval(cc2222,C234) + Cval(cc2222,C124) IN(3) = f3*D(dd3333) - Cval(cc2222,C234) - 8*D(dd00333) call SOLVE(in) D(dd13333) = in(1) D(dd23333) = in(2) D(dd33333) = in(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 + Cval(cc1122,C123) call SOLVE(in) D(dd11122) = in(1) D(dd11222) = in(2) D(dd11223) = in(3) IN(1) = f1*D(dd1133) - c22sum - 4*D(dd00133) IN(2) = f2*D(dd1133) - c22sum + Cval(cc1122,C124) IN(3) = f3*D(dd1133) - c22sum - 4*D(dd00113) call SOLVE(in) D(dd11133) = in(1) D(dd11233) = in(2) D(dd11333) = in(3) IN(1) = f1*D(dd2233) - Cval(cc1122,C234) + Cval(cc1122,C134) IN(2) = f2*D(dd2233) - Cval(cc1122,C234) - 4*D(dd00233) IN(3) = f3*D(dd2233) - Cval(cc1122,C234) - 4*D(dd00223) call SOLVE(in) D(dd12233) = in(1) D(dd22233) = in(2) D(dd22333) = in(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 SOLVE(in) D(dd11123) = in(1) D(dd11223) = .5D0*(D(dd11223) + in(2)) D(dd11233) = .5D0*(D(dd11233) + in(3)) IN(1) = f1*D(dd2223) - Cval(cc1112,C234) + Cval(cc1112,C134) IN(2) = f2*D(dd2223) - Cval(cc1112,C234) - 6*D(dd00223) IN(3) = f3*D(dd2223) - Cval(cc1112,C234) - 2*D(dd00222) call SOLVE(in) D(dd12223) = in(1) D(dd22223) = .5D0*(D(dd22223) + in(2)) D(dd22233) = .5D0*(D(dd22233) + in(3)) IN(1) = f1*D(dd2333) - Cval(cc1222,C234) + Cval(cc1222,C134) IN(2) = f2*D(dd2333) - Cval(cc1222,C234) - 2*D(dd00333) IN(3) = f3*D(dd2333) - Cval(cc1222,C234) - 6*D(dd00233) call SOLVE(in) D(dd12333) = in(1) D(dd22333) = .5D0*(D(dd22333) + in(2)) D(dd23333) = .5D0*(D(dd23333) + in(3)) if( dump ) call XDumpCoeff(4, D) end looptools-2.8.orig/src/D/ffxdbd.F0000644000175000017500000004341411776502523017572 0ustar sylvestresylvestre#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.8.orig/src/D/ffdcc0.F0000644000175000017500000002111411776502523017453 0ustar sylvestresylvestre#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.8.orig/src/D/ffxd0p.F0000644000175000017500000004230711776502523017524 0ustar sylvestresylvestre#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.8.orig/src/D/ffS2.F0000644000175000017500000000600611776502523017131 0ustar sylvestresylvestre* 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.8.orig/src/D/ffxd0tra.F0000644000175000017500000000716112024320660020035 0ustar sylvestresylvestre* 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.8.orig/src/D/ffRn.F0000644000175000017500000000710511776502523017225 0ustar sylvestresylvestre* 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.8.orig/src/E/0000755000175000017500000000000012023554544016215 5ustar sylvestresylvestrelooptools-2.8.orig/src/E/ffdel5.F0000644000175000017500000004710711776502523017506 0ustar sylvestresylvestre#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.8.orig/src/E/Eget.F0000644000175000017500000003016612024312120017175 0ustar sylvestresylvestre* Eget.F * retrieve the five-point tensor coefficients * this file is part of LoopTools * written by M. Rauch * last modified 13 Sep 12 th #include "externals.h" #include "types.h" #define npoint 5 #include "defs.h" memindex function XEget(p1, p2, p3, p4, p5, & p1p2, p2p3, p3p4, p4p5, p5p1, m1, m2, m3, m4, m5) implicit none DVAR p1, p2, p3, p4, p5 DVAR p1p2, p2p3, p3p4, p4p5, p5p1 DVAR m1, m2, m3, m4, m5 #include "lt.h" memindex cacheindex external cacheindex, XEcoeff #ifdef COMPLEXPARA memindex Eget external Eget #endif DVAR para(1,Pee) 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 #ifdef COMPLEXPARA if( abs(Im(P(1))) + abs(Im(P(2))) + & abs(Im(P(3))) + abs(Im(P(4))) + & abs(Im(P(5))) + abs(Im(P(6))) + & abs(Im(P(7))) + abs(Im(P(8))) + & abs(Im(P(9))) + abs(Im(P(10))) .gt. 0 ) & print *, "EgetC: Complex momenta not implemented" #endif 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 #ifdef COMPLEXPARA if( abs(Im(M(1))) + abs(Im(M(2))) + & abs(Im(M(3))) + abs(Im(M(4))) + abs(Im(M(5))) .eq. 0 ) then XEget = Eget(p1, p2, p3, p4, p1p2, p2p3, & m1, m2, m3, m4) - offsetC return endif #endif XEget = cacheindex(para, Eval(1,0), XEcoeff, RC*Pee, Nee) end ************************************************************************ subroutine XEput(res, p1, p2, p3, p4, p5, & p1p2, p2p3, p3p4, p4p5, p5p1, m1, m2, m3, m4, m5) implicit none ComplexType res(*) DVAR p1, p2, p3, p4, p5 DVAR p1p2, p2p3, p3p4, p4p5, p5p1 DVAR m1, m2, m3, m4, m5 #include "lt.h" external XEcoeff DVAR para(1,Pee) 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 #ifdef COMPLEXPARA if( abs(Im(P(1))) + abs(Im(P(2))) + & abs(Im(P(3))) + abs(Im(P(4))) + & abs(Im(P(5))) + abs(Im(P(6))) + & abs(Im(P(7))) + abs(Im(P(8))) + & abs(Im(P(9))) + abs(Im(P(10))) .gt. 0 ) & print *, "EgetC: Complex momenta not implemented" #endif 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 #ifdef COMPLEXPARA if( abs(Im(M(1))) + abs(Im(M(2))) + & abs(Im(M(3))) + abs(Im(M(4))) + abs(Im(M(5))) .eq. 0 ) then call Eput(res, p1, p2, p3, p4, p1p2, p2p3, & m1, m2, m3, m4) return endif #endif call cachecopy(res, para, Eval(1,0), XEcoeff, RC*Pee, Nee) end ************************************************************************ ComplexType function XE0i(i, p1, p2, p3, p4, p5, & p1p2, p2p3, p3p4, p4p5, p5p1, m1, m2, m3, m4, m5) implicit none integer i DVAR p1, p2, p3, p4, p5 DVAR p1p2, p2p3, p3p4, p4p5, p5p1 DVAR 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,b) end ************************************************************************ subroutine XEcoeff(res, para) implicit none ComplexType res(*) DVAR 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) return 1 call XEcoeffb(res, para) return 2 call XEcheck(res, cmp, para) return 3 call XEcheck(cmp, res, para) end ************************************************************************ subroutine XEcheck(Ea, Eb, para) implicit none ComplexType Ea(*), Eb(*) DVAR para(1,*) #include "lt.h" ComplexType dE(Nee) integer i logical ini QVAR Ginv(4,4) common /XInvGramE/ Ginv character*8 coeffname(Nee,2:5) common /ltcoeffnames/ coeffname call XEcoeffa(Ea, para) call XEcoeffb(Eb, para) dE(ee0) = 0 dE(ee1) = 0 dE(ee2) = 0 dE(ee3) = 0 dE(ee4) = 0 dE(ee11) = -2*Ea(ee00)*Ginv(1,1) dE(ee12) = -2*Ea(ee00)*Ginv(1,2) dE(ee13) = -2*Ea(ee00)*Ginv(1,3) dE(ee14) = -2*Ea(ee00)*Ginv(1,4) dE(ee22) = -2*Ea(ee00)*Ginv(2,2) dE(ee23) = -2*Ea(ee00)*Ginv(2,3) dE(ee24) = -2*Ea(ee00)*Ginv(2,4) dE(ee33) = -2*Ea(ee00)*Ginv(3,3) dE(ee34) = -2*Ea(ee00)*Ginv(3,4) dE(ee44) = -2*Ea(ee00)*Ginv(4,4) dE(ee00) = Ea(ee00) dE(ee111) = -6*Ea(ee001)*Ginv(1,1) dE(ee112) = -2*(Ea(ee002)*Ginv(1,1) + & Ea(ee001)*(Ginv(1,2) + Ginv(2,1))) dE(ee113) = -2*(Ea(ee003)*Ginv(1,1) + & Ea(ee001)*(Ginv(1,3) + Ginv(3,1))) dE(ee114) = -2*(Ea(ee004)*Ginv(1,1) + & Ea(ee001)*(Ginv(1,4) + Ginv(4,1))) dE(ee122) = -2*(Ea(ee002)*(Ginv(1,2) + Ginv(2,1)) + & Ea(ee001)*Ginv(2,2)) dE(ee123) = -2*(Ea(ee003)*Ginv(1,2) + Ea(ee001)*Ginv(2,3) + & Ea(ee002)*Ginv(3,1)) dE(ee124) = -2*(Ea(ee004)*Ginv(1,2) + Ea(ee001)*Ginv(2,4) + & Ea(ee002)*Ginv(4,1)) dE(ee133) = -2*(Ea(ee003)*(Ginv(1,3) + Ginv(3,1)) + & Ea(ee001)*Ginv(3,3)) dE(ee134) = -2*(Ea(ee004)*Ginv(1,3) + Ea(ee001)*Ginv(3,4) + & Ea(ee003)*Ginv(4,1)) dE(ee144) = -2*(Ea(ee004)*(Ginv(1,4) + Ginv(4,1)) + & Ea(ee001)*Ginv(4,4)) dE(ee222) = -6*Ea(ee002)*Ginv(2,2) dE(ee223) = -2*(Ea(ee003)*Ginv(2,2) + & Ea(ee002)*(Ginv(2,3) + Ginv(3,2))) dE(ee224) = -2*(Ea(ee004)*Ginv(2,2) + & Ea(ee002)*(Ginv(2,4) + Ginv(4,2))) dE(ee233) = -2*(Ea(ee003)*(Ginv(2,3) + Ginv(3,2)) + & Ea(ee002)*Ginv(3,3)) dE(ee234) = -2*(Ea(ee004)*Ginv(2,3) + Ea(ee002)*Ginv(3,4) + & Ea(ee003)*Ginv(4,2)) dE(ee244) = -2*(Ea(ee004)*(Ginv(2,4) + Ginv(4,2)) + & Ea(ee002)*Ginv(4,4)) dE(ee333) = -6*Ea(ee003)*Ginv(3,3) dE(ee334) = -2*(Ea(ee004)*Ginv(3,3) + & Ea(ee003)*(Ginv(3,4) + Ginv(4,3))) dE(ee344) = -2*(Ea(ee004)*(Ginv(3,4) + Ginv(4,3)) + & Ea(ee003)*Ginv(4,4)) dE(ee444) = -6*Ea(ee004)*Ginv(4,4) dE(ee001) = Ea(ee001) dE(ee002) = Ea(ee002) dE(ee003) = Ea(ee003) dE(ee004) = Ea(ee004) dE(ee1111) = -12*Ginv(1,1)*(Ea(ee0011) + Ea(ee0000)*Ginv(1,1)) dE(ee1112) = -6*(Ea(ee0012)*Ginv(1,1) + & (Ea(ee0011) + 2*Ea(ee0000)*Ginv(1,1))*Ginv(1,2)) dE(ee1113) = -6*(Ea(ee0013)*Ginv(1,1) + & (Ea(ee0011) + 2*Ea(ee0000)*Ginv(1,1))*Ginv(1,3)) dE(ee1114) = -6*(Ea(ee0014)*Ginv(1,1) + & (Ea(ee0011) + 2*Ea(ee0000)*Ginv(1,1))*Ginv(1,4)) dE(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)) dE(ee1123) = -2*(Ea(ee0023)*Ginv(1,1) + & 2*Ea(ee0013)*Ginv(1,2) + & 2*(Ea(ee0012) + 2*Ea(ee0000)*Ginv(1,2))*Ginv(1,3) + & (Ea(ee0011) + 2*Ea(ee0000)*Ginv(1,1))*Ginv(2,3)) dE(ee1124) = -2*(Ea(ee0024)*Ginv(1,1) + & 2*Ea(ee0014)*Ginv(1,2) + & 2*(Ea(ee0012) + 2*Ea(ee0000)*Ginv(1,2))*Ginv(1,4) + & (Ea(ee0011) + 2*Ea(ee0000)*Ginv(1,1))*Ginv(2,4)) dE(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)) dE(ee1134) = -2*(Ea(ee0034)*Ginv(1,1) + & 2*Ea(ee0014)*Ginv(1,3) + & 2*(Ea(ee0013) + 2*Ea(ee0000)*Ginv(1,3))*Ginv(1,4) + & (Ea(ee0011) + 2*Ea(ee0000)*Ginv(1,1))*Ginv(3,4)) dE(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)) dE(ee1222) = -6*(Ea(ee0022)*Ginv(1,2) + & (Ea(ee0012) + 2*Ea(ee0000)*Ginv(1,2))*Ginv(2,2)) dE(ee1223) = -2*(2*Ea(ee0023)*Ginv(1,2) + & Ea(ee0022)*Ginv(1,3) + & (Ea(ee0013) + 2*Ea(ee0000)*Ginv(1,3))*Ginv(2,2) + & 2*(Ea(ee0012) + 2*Ea(ee0000)*Ginv(1,2))*Ginv(2,3)) dE(ee1224) = -2*(2*Ea(ee0024)*Ginv(1,2) + & Ea(ee0022)*Ginv(1,4) + & (Ea(ee0014) + 2*Ea(ee0000)*Ginv(1,4))*Ginv(2,2) + & 2*(Ea(ee0012) + 2*Ea(ee0000)*Ginv(1,2))*Ginv(2,4)) dE(ee1233) = -2*(Ea(ee0033)*Ginv(1,2) + & 2*Ea(ee0023)*Ginv(1,3) + & 2*(Ea(ee0013) + 2*Ea(ee0000)*Ginv(1,3))*Ginv(2,3) + & (Ea(ee0012) + 2*Ea(ee0000)*Ginv(1,2))*Ginv(3,3)) dE(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))) dE(ee1244) = -2*(Ea(ee0044)*Ginv(1,2) + & 2*Ea(ee0024)*Ginv(1,4) + & 2*(Ea(ee0014) + 2*Ea(ee0000)*Ginv(1,4))*Ginv(2,4) + & (Ea(ee0012) + 2*Ea(ee0000)*Ginv(1,2))*Ginv(4,4)) dE(ee1333) = -6*(Ea(ee0033)*Ginv(1,3) + & (Ea(ee0013) + 2*Ea(ee0000)*Ginv(1,3))*Ginv(3,3)) dE(ee1334) = -2*(2*Ea(ee0034)*Ginv(1,3) + & Ea(ee0033)*Ginv(1,4) + & (Ea(ee0014) + 2*Ea(ee0000)*Ginv(1,4))*Ginv(3,3) + & 2*(Ea(ee0013) + 2*Ea(ee0000)*Ginv(1,3))*Ginv(3,4)) dE(ee1344) = -2*(Ea(ee0044)*Ginv(1,3) + & 2*Ea(ee0034)*Ginv(1,4) + & 2*(Ea(ee0014) + 2*Ea(ee0000)*Ginv(1,4))*Ginv(3,4) + & (Ea(ee0013) + 2*Ea(ee0000)*Ginv(1,3))*Ginv(4,4)) dE(ee1444) = -6*(Ea(ee0044)*Ginv(1,4) + & (Ea(ee0014) + 2*Ea(ee0000)*Ginv(1,4))*Ginv(4,4)) dE(ee2222) = -12*Ginv(2,2)*(Ea(ee0022) + Ea(ee0000)*Ginv(2,2)) dE(ee2223) = -6*(Ea(ee0023)*Ginv(2,2) + & (Ea(ee0022) + 2*Ea(ee0000)*Ginv(2,2))*Ginv(2,3)) dE(ee2224) = -6*(Ea(ee0024)*Ginv(2,2) + & (Ea(ee0022) + 2*Ea(ee0000)*Ginv(2,2))*Ginv(2,4)) dE(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)) dE(ee2234) = -2*(Ea(ee0034)*Ginv(2,2) + & 2*Ea(ee0024)*Ginv(2,3) + & 2*(Ea(ee0023) + 2*Ea(ee0000)*Ginv(2,3))*Ginv(2,4) + & (Ea(ee0022) + 2*Ea(ee0000)*Ginv(2,2))*Ginv(3,4)) dE(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)) dE(ee2333) = -6*(Ea(ee0033)*Ginv(2,3) + & (Ea(ee0023) + 2*Ea(ee0000)*Ginv(2,3))*Ginv(3,3)) dE(ee2334) = -2*(2*Ea(ee0034)*Ginv(2,3) + & Ea(ee0033)*Ginv(2,4) + & (Ea(ee0024) + 2*Ea(ee0000)*Ginv(2,4))*Ginv(3,3) + & 2*(Ea(ee0023) + 2*Ea(ee0000)*Ginv(2,3))*Ginv(3,4)) dE(ee2344) = -2*(Ea(ee0044)*Ginv(2,3) + & 2*Ea(ee0034)*Ginv(2,4) + & 2*(Ea(ee0024) + 2*Ea(ee0000)*Ginv(2,4))*Ginv(3,4) + & (Ea(ee0023) + 2*Ea(ee0000)*Ginv(2,3))*Ginv(4,4)) dE(ee2444) = -6*(Ea(ee0044)*Ginv(2,4) + & (Ea(ee0024) + 2*Ea(ee0000)*Ginv(2,4))*Ginv(4,4)) dE(ee3333) = -12*Ginv(3,3)*(Ea(ee0033) + Ea(ee0000)*Ginv(3,3)) dE(ee3334) = -6*(Ea(ee0034)*Ginv(3,3) + & (Ea(ee0033) + 2*Ea(ee0000)*Ginv(3,3))*Ginv(3,4)) dE(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)) dE(ee3444) = -6*(Ea(ee0044)*Ginv(3,4) + & (Ea(ee0034) + 2*Ea(ee0000)*Ginv(3,4))*Ginv(4,4)) dE(ee4444) = -12*Ginv(4,4)*(Ea(ee0044) + Ea(ee0000)*Ginv(4,4)) dE(ee0000) = Ea(ee0000) dE(ee0011) = Ea(ee0011) dE(ee0012) = Ea(ee0012) dE(ee0013) = Ea(ee0013) dE(ee0014) = Ea(ee0014) dE(ee0022) = Ea(ee0022) dE(ee0023) = Ea(ee0023) dE(ee0024) = Ea(ee0024) dE(ee0033) = Ea(ee0033) dE(ee0034) = Ea(ee0034) dE(ee0044) = Ea(ee0044) ini = .TRUE. do i = 1, Nee if( abs(Ea(i) - Eb(i) - dE(i)) .gt. & .5D0*maxdev*abs(Ea(i) + Eb(i)) ) then if( ini ) then #ifdef COMPLEXPARA print *, "Discrepancy in CEget:" #else print *, "Discrepancy in Eget:" #endif call XDumpPara(5, para, " ") ini = .FALSE. endif print *, coeffname(i,5), " a =", Ea(i) print *, coeffname(i,5), " b =", Eb(i) + dE(i) endif enddo end looptools-2.8.orig/src/E/E0.F0000644000175000017500000001126412026274714016575 0ustar sylvestresylvestre* E0.F * the scalar four-point function * this file is part of LoopTools * written by M. Rauch * last modified 15 Sep 12 th #include "externals.h" #include "types.h" #define npoint 5 #include "defs.h" ComplexType function XE0(p1, p2, p3, p4, p5, & p1p2, p2p3, p3p4, p4p5, p5p1, m1, m2, m3, m4, m5) implicit none DVAR p1, p2, p3, p4, p5 DVAR p1p2, p2p3, p3p4, p4p5, p5p1 DVAR m1, m2, m3, m4, m5 #include "lt.h" DVAR para(1,Pee) 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 call XE0para(XE0, para) end ************************************************************************ * subroutine version for C++ subroutine XE0sub(res, p1, p2, p3, p4, p5, & p1p2, p2p3, p3p4, p4p5, p5p1, m1, m2, m3, m4, m5) implicit none ComplexType res DVAR p1, p2, p3, p4, p5 DVAR p1p2, p2p3, p3p4, p4p5, p5p1 DVAR m1, m2, m3, m4, m5 #include "lt.h" DVAR para(1,Pee) 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 call XE0para(res, para) end ************************************************************************ #ifndef COMPLEXPARA subroutine E0para(res, para) implicit none ComplexType res RealType para(1,*) #include "lt.h" ComplexType d0(5), alt integer key, ier key = ibits(versionkey, KeyE0, 2) if( key .ne. 1 ) then call E0parab(res, para) if( key .eq. 0 ) return alt = res endif call ffxe0(res, d0, para, ier) if( key .gt. 1 .and. & abs(res - 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 if( ier .gt. errdigits ) alt = res endif if( .not. btest(key, 0) ) res = alt end #endif ************************************************************************ #ifdef COMPLEXPARA subroutine E0Cpara(res, para) #else subroutine E0parab(res, para) #endif implicit none ComplexType res DVAR para(1,*) #include "lt.h" DVAR p1, p2, p3, p4, p5 DVAR p1p2, p2p3, p3p4, p4p5, p5p1 DVAR m1, m2, m3, m4, m5 QVAR Y(5,5), Yi(5,5), eta(5), detY integer i, j QVAR Yflat(25), Yiflat(25) equivalence (Y, Yflat) equivalence (Yi, Yiflat) ComplexType XD0 external XD0 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 do j = 1, 25 Yiflat(j) = Yflat(j) enddo do j = 1, 5 Yi(j,i) = 1 enddo call XDet(5, Yi,5, eta(i)) enddo call XDet(5, Y,5, detY) res = -( & eta(1)*XD0(p2, p3, p4, p5p1, p2p3, p3p4, m2, m3, m4, m5) + & eta(2)*XD0(p1p2, p3, p4, p5, p4p5, p3p4, m1, m3, m4, m5) + & eta(3)*XD0(p1, p2p3, p4, p5, p4p5, p5p1, m1, m2, m4, m5) + & eta(4)*XD0(p1, p2, p3p4, p5, p1p2, p5p1, m1, m2, m3, m5) + & eta(5)*XD0(p1, p2, p3, p4p5, p1p2, p2p3, m1, m2, m3, m4) & )/detY end looptools-2.8.orig/src/E/ffxe0.F0000644000175000017500000004732011776502523017346 0ustar sylvestresylvestre#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.8.orig/src/E/Ecoeffb.F0000644000175000017500000003777112023130334017657 0ustar sylvestresylvestre* Ecoeffb.F * the five-point tensor coefficients via Passarino-Veltman decomposition * this file is part of LoopTools * written by M. Rauch * last modified 9 Sep 12 th #include "externals.h" #include "types.h" #define npoint 5 #include "defs.h" subroutine XEcoeffb(E, para) implicit none ComplexType E(*) DVAR para(1,*) #include "lt.h" memindex XDget external XDget DVAR p1, p2, p3, p4, p5 DVAR p1p2, p2p3, p3p4, p4p5, p5p1 DVAR m1, m2, m3, m4, m5 DVAR f1, f2, f3, f4 ComplexType di, d0sum ComplexType d1i, d1sum, d2i, d2sum, dii ComplexType d1ii, d2ii, diii ComplexType d00sum, d22sum, d33sum ComplexType in(4) memindex Di1, Di2, Di3, Di4, Di5 logical dump QVAR G(4,4), Ginv(4,4) common /XInvGramE/ Ginv #ifdef SOLVE_EIGEN #define SOLVE_SETUP XInverse(4, G,4, Ginv,4) #define SOLVE(b) XSolve(4, G,4, Ginv,4, b) #else integer perm(4) #define IN(i) in(perm(i)) #define SOLVE_SETUP XInverse(4, G,4, Ginv,4, perm) #define SOLVE(b) XSolve(4, G,4, b) #endif 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) Di1 = XDget(p2, p3, p4, p5p1, p2p3, p3p4, m2, m3, m4, m5) Di2 = XDget(p1p2, p3, p4, p5, p4p5, p3p4, m1, m3, m4, m5) Di3 = XDget(p1, p2p3, p4, p5, p4p5, p5p1, m1, m2, m4, m5) Di4 = XDget(p1, p2, p3p4, p5, p1p2, p5p1, m1, m2, m3, m5) Di5 = XDget(p1, p2, p3, p4p5, p1p2, p2p3, m1, m2, m3, m4) serial = serial + 1 dump = ibits(debugkey, DebugE, 1) .ne. 0 .and. & serial .ge. debugfrom .and. serial .le. debugto if( dump ) call XDumpPara(5, para) 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 = Dval(dd1,Di1) + Dval(dd2,Di1) + Dval(dd3,Di1) d0sum = Dval(dd0,Di1) + di d1i = Dval(dd11,Di1) + Dval(dd12,Di1) + Dval(dd13,Di1) d1sum = Dval(dd1,Di1) + d1i d2i = Dval(dd12,Di1) + Dval(dd22,Di1) + Dval(dd23,Di1) d2sum = Dval(dd2,Di1) + d2i dii = d1i + d2i + & Dval(dd13,Di1) + Dval(dd23,Di1) + Dval(dd33,Di1) d1ii = Dval(dd111,Di1) + Dval(dd122,Di1) + & Dval(dd133,Di1) + 2*(Dval(dd112,Di1) + & Dval(dd113,Di1) + Dval(dd123,Di1)) d2ii = Dval(dd112,Di1) + Dval(dd222,Di1) + & Dval(dd233,Di1) + 2*(Dval(dd122,Di1) + & Dval(dd123,Di1) + Dval(dd223,Di1)) diii = d1ii + d2ii + & Dval(dd113,Di1) + Dval(dd223,Di1) + & Dval(dd333,Di1) + 2*(Dval(dd123,Di1) + & Dval(dd133,Di1) + Dval(dd233,Di1)) d00sum = Dval(dd00,Di1) + & Dval(dd001,Di1) + Dval(dd002,Di1) + Dval(dd003,Di1) d22sum = Dval(dd22,Di1) + & Dval(dd122,Di1) + Dval(dd222,Di1) + Dval(dd223,Di1) d33sum = Dval(dd33,Di1) + & Dval(dd133,Di1) + Dval(dd233,Di1) + Dval(dd333,Di1) call XE0para(E(ee0), para) IN(1) = f1*E(ee0) - Dval(dd0,Di1) + Dval(dd0,Di2) IN(2) = f2*E(ee0) - Dval(dd0,Di1) + Dval(dd0,Di3) IN(3) = f3*E(ee0) - Dval(dd0,Di1) + Dval(dd0,Di4) IN(4) = f4*E(ee0) - Dval(dd0,Di1) + Dval(dd0,Di5) call SOLVE(in) E(ee1) = in(1) E(ee2) = in(2) E(ee3) = in(3) E(ee4) = in(4) E(ee00) = 0 IN(1) = f1*E(ee1) + d0sum IN(2) = f2*E(ee1) + d0sum + Dval(dd1,Di3) IN(3) = f3*E(ee1) + d0sum + Dval(dd1,Di4) IN(4) = f4*E(ee1) + d0sum + Dval(dd1,Di5) call SOLVE(in) E(ee11) = in(1) E(ee12) = in(2) E(ee13) = in(3) E(ee14) = in(4) IN(1) = f1*E(ee2) - Dval(dd1,Di1) + Dval(dd1,Di2) IN(2) = f2*E(ee2) - Dval(dd1,Di1) IN(3) = f3*E(ee2) - Dval(dd1,Di1) + Dval(dd2,Di4) IN(4) = f4*E(ee2) - Dval(dd1,Di1) + Dval(dd2,Di5) call SOLVE(in) E(ee12) = .5D0*(E(ee12) + in(1)) E(ee22) = in(2) E(ee23) = in(3) E(ee24) = in(4) IN(1) = f1*E(ee3) - Dval(dd2,Di1) + Dval(dd2,Di2) IN(2) = f2*E(ee3) - Dval(dd2,Di1) + Dval(dd2,Di3) IN(3) = f3*E(ee3) - Dval(dd2,Di1) IN(4) = f4*E(ee3) - Dval(dd2,Di1) + Dval(dd3,Di5) call SOLVE(in) E(ee13) = .5D0*(E(ee13) + in(1)) E(ee23) = .5D0*(E(ee23) + in(2)) E(ee33) = in(3) E(ee34) = in(4) IN(1) = f1*E(ee4) - Dval(dd3,Di1) + Dval(dd3,Di2) IN(2) = f2*E(ee4) - Dval(dd3,Di1) + Dval(dd3,Di3) IN(3) = f3*E(ee4) - Dval(dd3,Di1) + Dval(dd3,Di4) IN(4) = f4*E(ee4) - Dval(dd3,Di1) call SOLVE(in) E(ee14) = .5D0*(E(ee14) + in(1)) E(ee24) = .5D0*(E(ee24) + in(2)) E(ee34) = .5D0*(E(ee34) + in(3)) E(ee44) = in(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)*(Dval(dd00,Di1) - Dval(dd00,Di2)) IN(2) = f2*E(ee11) - d0sum + Dval(dd11,Di3) - & 2*Ginv(1,1)*(Dval(dd00,Di1) - Dval(dd00,Di3)) IN(3) = f3*E(ee11) - d0sum + Dval(dd11,Di4) - & 2*Ginv(1,1)*(Dval(dd00,Di1) - Dval(dd00,Di4)) IN(4) = f4*E(ee11) - d0sum + Dval(dd11,Di5) - & 2*Ginv(1,1)*(Dval(dd00,Di1) - Dval(dd00,Di5)) call SOLVE(in) E(ee111) = in(1) E(ee112) = in(2) E(ee113) = in(3) E(ee114) = in(4) IN(1) = f1*E(ee22) - Dval(dd11,Di1) + Dval(dd11,Di2) - & 2*Ginv(2,2)*(Dval(dd00,Di1) - Dval(dd00,Di2)) IN(2) = f2*E(ee22) - Dval(dd11,Di1) - & 2*Ginv(2,2)*(Dval(dd00,Di1) - Dval(dd00,Di3)) IN(3) = f3*E(ee22) - Dval(dd11,Di1) + Dval(dd22,Di4) - & 2*Ginv(2,2)*(Dval(dd00,Di1) - Dval(dd00,Di4)) IN(4) = f4*E(ee22) - Dval(dd11,Di1) + Dval(dd22,Di5) - & 2*Ginv(2,2)*(Dval(dd00,Di1) - Dval(dd00,Di5)) call SOLVE(in) E(ee122) = in(1) E(ee222) = in(2) E(ee223) = in(3) E(ee224) = in(4) IN(1) = f1*E(ee33) - Dval(dd22,Di1) + Dval(dd22,Di2) - & 2*Ginv(3,3)*(Dval(dd00,Di1) - Dval(dd00,Di2)) IN(2) = f2*E(ee33) - Dval(dd22,Di1) + Dval(dd22,Di3) - & 2*Ginv(3,3)*(Dval(dd00,Di1) - Dval(dd00,Di3)) IN(3) = f3*E(ee33) - Dval(dd22,Di1) - & 2*Ginv(3,3)*(Dval(dd00,Di1) - Dval(dd00,Di4)) IN(4) = f4*E(ee33) - Dval(dd22,Di1) + Dval(dd33,Di5) - & 2*Ginv(3,3)*(Dval(dd00,Di1) - Dval(dd00,Di5)) call SOLVE(in) E(ee133) = in(1) E(ee233) = in(2) E(ee333) = in(3) E(ee334) = in(4) IN(1) = f1*E(ee44) - Dval(dd33,Di1) + Dval(dd33,Di2) - & 2*Ginv(4,4)*(Dval(dd00,Di1) - Dval(dd00,Di2)) IN(2) = f2*E(ee44) - Dval(dd33,Di1) + Dval(dd33,Di3) - & 2*Ginv(4,4)*(Dval(dd00,Di1) - Dval(dd00,Di3)) IN(3) = f3*E(ee44) - Dval(dd33,Di1) + Dval(dd33,Di4) - & 2*Ginv(4,4)*(Dval(dd00,Di1) - Dval(dd00,Di4)) IN(4) = f4*E(ee44) - Dval(dd33,Di1) - & 2*Ginv(4,4)*(Dval(dd00,Di1) - Dval(dd00,Di5)) call SOLVE(in) E(ee144) = in(1) E(ee244) = in(2) E(ee344) = in(3) E(ee444) = in(4) IN(1) = f1*E(ee12) + d1sum - & 2*Ginv(1,2)*(Dval(dd00,Di1) - Dval(dd00,Di2)) IN(2) = f2*E(ee12) + d1sum - & 2*Ginv(1,2)*(Dval(dd00,Di1) - Dval(dd00,Di3)) IN(3) = f3*E(ee12) + d1sum + Dval(dd12,Di4) - & 2*Ginv(1,2)*(Dval(dd00,Di1) - Dval(dd00,Di4)) IN(4) = f4*E(ee12) + d1sum + Dval(dd12,Di5) - & 2*Ginv(1,2)*(Dval(dd00,Di1) - Dval(dd00,Di5)) call SOLVE(in) E(ee112) = .5D0*(E(ee112) + in(1)) E(ee122) = .5D0*(E(ee122) + in(2)) E(ee123) = in(3) E(ee124) = in(4) IN(1) = f1*E(ee34) - Dval(dd23,Di1) + Dval(dd23,Di2) - & 2*Ginv(3,4)*(Dval(dd00,Di1) - Dval(dd00,Di2)) IN(2) = f2*E(ee34) - Dval(dd23,Di1) + Dval(dd23,Di3) - & 2*Ginv(3,4)*(Dval(dd00,Di1) - Dval(dd00,Di3)) IN(3) = f3*E(ee34) - Dval(dd23,Di1) - & 2*Ginv(3,4)*(Dval(dd00,Di1) - Dval(dd00,Di4)) IN(4) = f4*E(ee34) - Dval(dd23,Di1) - & 2*Ginv(3,4)*(Dval(dd00,Di1) - Dval(dd00,Di5)) call SOLVE(in) E(ee134) = in(1) E(ee234) = in(2) E(ee334) = .5D0*(E(ee334) + in(3)) E(ee344) = .5D0*(E(ee344) + in(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 + Dval(dd111,Di3) + & 6*Ginv(1,1)*(d00sum + Dval(dd001,Di3)) IN(3) = f3*E(ee111) + d0sum + Dval(dd111,Di4) + & 6*Ginv(1,1)*(d00sum + Dval(dd001,Di4)) IN(4) = f4*E(ee111) + d0sum + Dval(dd111,Di5) + & 6*Ginv(1,1)*(d00sum + Dval(dd001,Di5)) call SOLVE(in) E(ee1111) = in(1) E(ee1112) = in(2) E(ee1113) = in(3) E(ee1114) = in(4) IN(1) = f1*E(ee222) - Dval(dd111,Di1) + Dval(dd111,Di2) - & 6*Ginv(2,2)*(Dval(dd001,Di1) - Dval(dd001,Di2)) IN(2) = f2*E(ee222) - Dval(dd111,Di1) - & 6*Ginv(2,2)*Dval(dd001,Di1) IN(3) = f3*E(ee222) - Dval(dd111,Di1) + Dval(dd222,Di4) - & 6*Ginv(2,2)*(Dval(dd001,Di1) - Dval(dd002,Di4)) IN(4) = f4*E(ee222) - Dval(dd111,Di1) + Dval(dd222,Di5) - & 6*Ginv(2,2)*(Dval(dd001,Di1) - Dval(dd002,Di5)) call SOLVE(in) E(ee1222) = in(1) E(ee2222) = in(2) E(ee2223) = in(3) E(ee2224) = in(4) IN(1) = f1*E(ee333) - Dval(dd222,Di1) + Dval(dd222,Di2) - & 6*Ginv(3,3)*(Dval(dd002,Di1) - Dval(dd002,Di2)) IN(2) = f2*E(ee333) - Dval(dd222,Di1) + Dval(dd222,Di3) - & 6*Ginv(3,3)*(Dval(dd002,Di1) - Dval(dd002,Di3)) IN(3) = f3*E(ee333) - Dval(dd222,Di1) - & 6*Ginv(3,3)*Dval(dd002,Di1) IN(4) = f4*E(ee333) - Dval(dd222,Di1) + Dval(dd333,Di5) - & 6*Ginv(3,3)*(Dval(dd002,Di1) - Dval(dd003,Di5)) call SOLVE(in) E(ee1333) = in(1) E(ee2333) = in(2) E(ee3333) = in(3) E(ee3334) = in(4) IN(1) = f1*E(ee444) - Dval(dd333,Di1) + Dval(dd333,Di2) - & 6*Ginv(4,4)*(Dval(dd003,Di1) - Dval(dd003,Di2)) IN(2) = f2*E(ee444) - Dval(dd333,Di1) + Dval(dd333,Di3) - & 6*Ginv(4,4)*(Dval(dd003,Di1) - Dval(dd003,Di3)) IN(3) = f3*E(ee444) - Dval(dd333,Di1) + Dval(dd333,Di4) - & 6*Ginv(4,4)*(Dval(dd003,Di1) - Dval(dd003,Di4)) IN(4) = f4*E(ee444) - Dval(dd333,Di1) - & 6*Ginv(4,4)*Dval(dd003,Di1) call SOLVE(in) E(ee1444) = in(1) E(ee2444) = in(2) E(ee3444) = in(3) E(ee4444) = in(4) d1sum = d1sum + d1i + d1ii IN(1) = f1*E(ee112) - d1sum - & 2*Ginv(1,1)*(Dval(dd001,Di1) - Dval(dd001,Di2)) + & 4*Ginv(1,2)*d00sum IN(2) = f2*E(ee112) - d1sum - & 2*Ginv(1,1)*Dval(dd001,Di1) + & 4*Ginv(1,2)*(d00sum + Dval(dd001,Di3)) IN(3) = f3*E(ee112) - d1sum + Dval(dd112,Di4) - & 2*Ginv(1,1)*(Dval(dd001,Di1) - Dval(dd002,Di4)) + & 4*Ginv(1,2)*(d00sum + Dval(dd001,Di4)) IN(4) = f4*E(ee112) - d1sum + Dval(dd112,Di5) - & 2*Ginv(1,1)*(Dval(dd001,Di1) - Dval(dd002,Di5)) + & 4*Ginv(1,2)*(d00sum + Dval(dd001,Di5)) call SOLVE(in) E(ee1112) = .5D0*(E(ee1112) + in(1)) E(ee1122) = in(2) E(ee1123) = in(3) E(ee1124) = in(4) IN(1) = f1*E(ee223) - Dval(dd112,Di1) + Dval(dd112,Di2) - & 2*Ginv(2,2)*(Dval(dd002,Di1) - Dval(dd002,Di2)) - & 4*Ginv(2,3)*(Dval(dd001,Di1) - Dval(dd001,Di2)) IN(2) = f2*E(ee223) - Dval(dd112,Di1) - & 2*Ginv(2,2)*(Dval(dd002,Di1) - Dval(dd002,Di3)) - & 4*Ginv(2,3)*Dval(dd001,Di1) IN(3) = f3*E(ee223) - Dval(dd112,Di1) - & 2*Ginv(2,2)*Dval(dd002,Di1) - & 4*Ginv(2,3)*(Dval(dd001,Di1) - Dval(dd002,Di4)) IN(4) = f4*E(ee223) - Dval(dd112,Di1) + Dval(dd223,Di5) - & 2*Ginv(2,2)*(Dval(dd002,Di1) - Dval(dd003,Di5)) - & 4*Ginv(2,3)*(Dval(dd001,Di1) - Dval(dd002,Di5)) call SOLVE(in) E(ee1223) = in(1) E(ee2223) = .5D0*(E(ee2223) + in(2)) E(ee2233) = in(3) E(ee2234) = in(4) IN(1) = f1*E(ee334) - Dval(dd223,Di1) + Dval(dd223,Di2) - & 2*Ginv(3,3)*(Dval(dd003,Di1) - Dval(dd003,Di2)) - & 4*Ginv(3,4)*(Dval(dd002,Di1) - Dval(dd002,Di2)) IN(2) = f2*E(ee334) - Dval(dd223,Di1) + Dval(dd223,Di3) - & 2*Ginv(3,3)*(Dval(dd003,Di1) - Dval(dd003,Di3)) - & 4*Ginv(3,4)*(Dval(dd002,Di1) - Dval(dd002,Di3)) IN(3) = f3*E(ee334) - Dval(dd223,Di1) - & 2*Ginv(3,3)*(Dval(dd003,Di1) - Dval(dd003,Di4)) - & 4*Ginv(3,4)*Dval(dd002,Di1) IN(4) = f4*E(ee334) - Dval(dd223,Di1) - & 2*Ginv(3,3)*Dval(dd003,Di1) - & 4*Ginv(3,4)*(Dval(dd002,Di1) - Dval(dd003,Di5)) call SOLVE(in) E(ee1334) = in(1) E(ee2334) = in(2) E(ee3334) = .5D0*(E(ee3334) + in(3)) E(ee3344) = in(4) IN(1) = f1*E(ee144) + d33sum - & 4*Ginv(1,4)*(Dval(dd003,Di1) - Dval(dd003,Di2)) + & 2*Ginv(4,4)*d00sum IN(2) = f2*E(ee144) + d33sum + Dval(dd133,Di3) - & 4*Ginv(1,4)*(Dval(dd003,Di1) - Dval(dd003,Di3)) + & 2*Ginv(4,4)*(d00sum + Dval(dd001,Di3)) IN(3) = f3*E(ee144) + d33sum + Dval(dd133,Di4) - & 4*Ginv(1,4)*(Dval(dd003,Di1) - Dval(dd003,Di4)) + & 2*Ginv(4,4)*(d00sum + Dval(dd001,Di4)) IN(4) = f4*E(ee144) + d33sum - & 4*Ginv(1,4)*Dval(dd003,Di1) + & 2*Ginv(4,4)*(d00sum + Dval(dd001,Di5)) call SOLVE(in) E(ee1144) = in(1) E(ee1244) = in(2) E(ee1344) = in(3) E(ee1444) = .5D0*(E(ee1444) + in(4)) d2sum = d2sum + d2i + d2ii IN(1) = f1*E(ee113) - d2sum - & 2*Ginv(1,1)*(Dval(dd002,Di1) - Dval(dd002,Di2)) + & 4*Ginv(1,3)*d00sum IN(2) = f2*E(ee113) - d2sum + Dval(dd112,Di3) - & 2*Ginv(1,1)*(Dval(dd002,Di1) - Dval(dd002,Di3)) + & 4*Ginv(1,3)*(d00sum + Dval(dd001,Di3)) IN(3) = f3*E(ee113) - d2sum - & 2*Ginv(1,1)*Dval(dd002,Di1) + & 4*Ginv(1,3)*(d00sum + Dval(dd001,Di4)) IN(4) = f4*E(ee113) - d2sum + Dval(dd113,Di5) - & 2*Ginv(1,1)*(Dval(dd002,Di1) - Dval(dd003,Di5)) + & 4*Ginv(1,3)*(d00sum + Dval(dd001,Di5)) call SOLVE(in) E(ee1113) = .5D0*(E(ee1113) + in(1)) E(ee1123) = .5D0*(E(ee1123) + in(2)) E(ee1133) = in(3) E(ee1134) = in(4) IN(1) = f1*E(ee224) - Dval(dd113,Di1) + Dval(dd113,Di2) - & 2*Ginv(2,2)*(Dval(dd003,Di1) - Dval(dd003,Di2)) - & 4*Ginv(2,4)*(Dval(dd001,Di1) - Dval(dd001,Di2)) IN(2) = f2*E(ee224) - Dval(dd113,Di1) - & 2*Ginv(2,2)*(Dval(dd003,Di1) - Dval(dd003,Di3)) - & 4*Ginv(2,4)*Dval(dd001,Di1) IN(3) = f3*E(ee224) - Dval(dd113,Di1) + Dval(dd223,Di4) - & 2*Ginv(2,2)*(Dval(dd003,Di1) - Dval(dd003,Di4)) - & 4*Ginv(2,4)*(Dval(dd001,Di1) - Dval(dd002,Di4)) IN(4) = f4*E(ee224) - Dval(dd113,Di1) - & 2*Ginv(2,2)*Dval(dd003,Di1) - & 4*Ginv(2,4)*(Dval(dd001,Di1) - Dval(dd002,Di5)) call SOLVE(in) E(ee1224) = in(1) E(ee2224) = .5D0*(E(ee2224) + in(2)) E(ee2234) = E(ee2234) + in(3) E(ee2244) = in(4) IN(1) = f1*E(ee234) - Dval(dd123,Di1) + Dval(dd123,Di2) - & 2*Ginv(2,3)*(Dval(dd003,Di1) - Dval(dd003,Di2)) - & 2*Ginv(3,4)*(Dval(dd001,Di1) - Dval(dd001,Di2)) - & 2*Ginv(2,4)*(Dval(dd002,Di1) - Dval(dd002,Di2)) IN(2) = f2*E(ee234) - Dval(dd123,Di1) - & 2*Ginv(2,3)*(Dval(dd003,Di1) - Dval(dd003,Di3)) - & 2*Ginv(3,4)*Dval(dd001,Di1) - & 2*Ginv(2,4)*(Dval(dd002,Di1) - Dval(dd002,Di3)) IN(3) = f3*E(ee234) - Dval(dd123,Di1) - & 2*Ginv(2,3)*(Dval(dd003,Di1) - Dval(dd003,Di4)) - & 2*Ginv(3,4)*(Dval(dd001,Di1) - Dval(dd002,Di4)) - & 2*Ginv(2,4)*Dval(dd002,Di1) IN(4) = f4*E(ee234) - Dval(dd123,Di1) - & 2*Ginv(2,3)*Dval(dd003,Di1) - & 2*Ginv(3,4)*(Dval(dd001,Di1) - Dval(dd002,Di5)) - & 2*Ginv(2,4)*(Dval(dd002,Di1) - Dval(dd003,Di5)) call SOLVE(in) E(ee1234) = in(1) E(ee2234) = 1/3D0*(E(ee2234) + in(2)) E(ee2334) = .5D0*(E(ee2334) + in(3)) E(ee2344) = in(4) IN(1) = f1*E(ee133) + d22sum - & 4*Ginv(1,3)*(Dval(dd002,Di1) - Dval(dd002,Di2)) + & 2*Ginv(3,3)*d00sum IN(2) = f2*E(ee133) + d22sum + Dval(dd122,Di3) - & 4*Ginv(1,3)*(Dval(dd002,Di1) - Dval(dd002,Di3)) + & 2*Ginv(3,3)*(d00sum + Dval(dd001,Di3)) IN(3) = f3*E(ee133) + d22sum - & 4*Ginv(1,3)*Dval(dd002,Di1) + & 2*Ginv(3,3)*(d00sum + Dval(dd001,Di4)) IN(4) = f4*E(ee133) + d22sum + Dval(dd133,Di5) - & 4*Ginv(1,3)*(Dval(dd002,Di1) - Dval(dd003,Di5)) + & 2*Ginv(3,3)*(d00sum + Dval(dd001,Di5)) call SOLVE(in) E(ee1133) = .5D0*(E(ee1133) + in(1)) E(ee1233) = in(2) E(ee1333) = .5D0*(E(ee1333) + in(3)) E(ee1334) = .5D0*(E(ee1334) + in(4)) if( dump ) call XDumpCoeff(5, E) end looptools-2.8.orig/src/E/Ecoeffa.F0000644000175000017500000017261712023110044017651 0ustar sylvestresylvestre* Ecoeffa.F * the five-point tensor coefficients * this file is part of LoopTools * written by M. Rauch * last modified 9 Sep 12 th #include "externals.h" #include "types.h" #define npoint 5 #include "defs.h" subroutine XEcoeffa(E, para) implicit none ComplexType E(*) DVAR para(1,*) #include "lt.h" memindex XDget external XDget DVAR p1, p2, p3, p4, p5 DVAR p1p2, p2p3, p3p4, p4p5, p5p1 DVAR m1, m2, m3, m4, m5 QVAR Y(5,5), Yi(5,5), Z(4,4), Zij(3,3) QVAR eta(5), zeta(4,4), detY, detZ RealType del, del4 integer i, j, k, l, finite memindex Di1, Di2, Di3, Di4, Di5 logical dump QVAR Yflat(25), Yiflat(25) equivalence (Y, Yflat) equivalence (Yi, Yiflat) ComplexType help1, help2, help3, help4 ComplexType dabbr41, dabbr48, dabbr65, dabbr60, dabbr55 ComplexType dabbr50, dabbr49, dabbr45, dabbr42, dabbr10 ComplexType dabbr84, dabbr91, dabbr81, dabbr52, dabbr88 ComplexType dabbr77, dabbr90, dabbr46, dabbr87, dabbr74 ComplexType dabbr80, dabbr71, dabbr83, dabbr76, dabbr79 ComplexType dabbr43, dabbr70, dabbr73, dabbr35, dabbr37 ComplexType dabbr39, dabbr27, dabbr31, dabbr24, dabbr20 ComplexType dabbr16, dabbr30, dabbr13, dabbr23, dabbr26 ComplexType dabbr5, dabbr7, dabbr9, dabbr33, dabbr92 ComplexType dabbr89, dabbr86, dabbr85, dabbr82, dabbr78 ComplexType dabbr75, dabbr72, dabbr69, dabbr68, dabbr38 ComplexType dabbr36, dabbr34, dabbr32, dabbr29, dabbr28 ComplexType dabbr25, dabbr22, dabbr21, dabbr3, dabbr8 ComplexType dabbr6, dabbr4, dabbr1, dabbr61, dabbr66 ComplexType dabbr57, dabbr47, dabbr51, dabbr64, dabbr44 ComplexType dabbr56, dabbr59, dabbr14, dabbr17, dabbr19 ComplexType dabbr67, dabbr63, dabbr62, dabbr58, dabbr54 ComplexType dabbr53, dabbr11, dabbr18, dabbr15, dabbr12 ComplexType dabbr2, dabbr40 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 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 Di1 = XDget(p2, p3, p4, p5p1, p2p3, p3p4, m2, m3, m4, m5) Di1 = XDget(p2, p3, p4, p5p1, p2p3, p3p4, m2, m3, m4, m5) Di2 = XDget(p1p2, p3, p4, p5, p4p5, p3p4, m1, m3, m4, m5) Di3 = XDget(p1, p2p3, p4, p5, p4p5, p5p1, m1, m2, m4, m5) Di4 = XDget(p1, p2, p3p4, p5, p1p2, p5p1, m1, m2, m3, m5) Di5 = XDget(p1, p2, p3, p4p5, p1p2, p2p3, m1, m2, m3, m4) 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") 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 do j = 1, 25 Yiflat(j) = Yflat(j) enddo do j = 1, 5 Yi(j,i) = 1 enddo 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) do i = 1, 5 eta(i) = eta(i)/detY enddo 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 do l = 1, 3 do k = 1, 3 Zij(k,l) = Z(k + ibits(not(k - i), 3, 1), & l + ibits(not(l - j), 3, 1)) enddo enddo 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 = Dval(dd003,Di1) + 2*Dval(dd0033,Di1) + & Dval(dd00333,Di1) help2 = Dval(dd002,Di1) + 2*Dval(dd0023,Di1) + & Dval(dd00233,Di1) help3 = Dval(dd001,Di1) + 2*Dval(dd0013,Di1) + & Dval(dd00133,Di1) help4 = Dval(dd00,Di1) + 2*Dval(dd003,Di1) + & Dval(dd0033,Di1) dabbr41 = Dval(dd00223,Di1) + Dval(dd00233,Di1) dabbr48 = Dval(dd00113,Di1) + Dval(dd00133,Di1) dabbr65 = Dval(dd0023,Di1) + Dval(dd00123,Di1) dabbr60 = Dval(dd0013,Di1) + Dval(dd00123,Di1) dabbr55 = Dval(dd0012,Di1) + Dval(dd00123,Di1) dabbr50 = Dval(dd00112,Di1) + Dval(dd00122,Di1) dabbr49 = Dval(dd2233,Di1) + Dval(dd2333,Di1) dabbr45 = Dval(dd2223,Di1) + Dval(dd2233,Di1) dabbr42 = Dval(dd1223,Di1) + Dval(dd1233,Di1) dabbr10 = Dval(dd223,Di1) + Dval(dd233,Di1) dabbr84 = Dval(dd0033,Di1) + Dval(dd00233,Di1) + & Dval(dd00333,Di1) dabbr91 = Dval(dd0033,Di1) + Dval(dd00133,Di1) + & Dval(dd00333,Di1) dabbr81 = dabbr41 + Dval(dd0023,Di1) dabbr52 = Dval(dd0033,Di1) + Dval(dd00133,Di1) + & Dval(dd00233,Di1) dabbr88 = dabbr65 + Dval(dd00233,Di1) dabbr77 = Dval(dd0022,Di1) + Dval(dd00222,Di1) + & Dval(dd00223,Di1) dabbr90 = dabbr65 + Dval(dd00223,Di1) dabbr46 = Dval(dd0022,Di1) + Dval(dd00122,Di1) + & Dval(dd00223,Di1) dabbr87 = Dval(dd0022,Di1) + Dval(dd00122,Di1) + & Dval(dd00222,Di1) dabbr74 = dabbr60 + Dval(dd00133,Di1) dabbr80 = dabbr48 + Dval(dd0013,Di1) dabbr71 = dabbr55 + Dval(dd00122,Di1) dabbr83 = dabbr60 + Dval(dd00113,Di1) dabbr76 = dabbr55 + Dval(dd00112,Di1) dabbr79 = dabbr50 + Dval(dd0012,Di1) dabbr43 = Dval(dd0011,Di1) + Dval(dd00112,Di1) + & Dval(dd00113,Di1) dabbr70 = Dval(dd0011,Di1) + Dval(dd00111,Di1) + & Dval(dd00113,Di1) dabbr73 = Dval(dd0011,Di1) + Dval(dd00111,Di1) + & Dval(dd00112,Di1) dabbr35 = (Dval(dd0000,Di1) - del) + & (Dval(dd00002,Di1) + del4) + & (Dval(dd00003,Di1) + del4) dabbr37 = (Dval(dd0000,Di1) - del) + & (Dval(dd00001,Di1) + del4) + & (Dval(dd00003,Di1) + del4) dabbr39 = (Dval(dd0000,Di1) - del) + & (Dval(dd00001,Di1) + del4) + & (Dval(dd00002,Di1) + del4) dabbr27 = Dval(dd003,Di1) + Dval(dd0023,Di1) + & Dval(dd0033,Di1) dabbr31 = Dval(dd003,Di1) + Dval(dd0013,Di1) + & Dval(dd0033,Di1) dabbr24 = Dval(dd002,Di1) + Dval(dd0022,Di1) + & Dval(dd0023,Di1) dabbr20 = Dval(dd003,Di1) + Dval(dd0013,Di1) + & Dval(dd0023,Di1) dabbr16 = Dval(dd002,Di1) + Dval(dd0012,Di1) + & Dval(dd0023,Di1) dabbr30 = Dval(dd002,Di1) + Dval(dd0012,Di1) + & Dval(dd0022,Di1) dabbr13 = Dval(dd001,Di1) + Dval(dd0012,Di1) + & Dval(dd0013,Di1) dabbr23 = Dval(dd001,Di1) + Dval(dd0011,Di1) + & Dval(dd0013,Di1) dabbr26 = Dval(dd001,Di1) + Dval(dd0011,Di1) + & Dval(dd0012,Di1) dabbr5 = Dval(dd00,Di1) + Dval(dd002,Di1) + & Dval(dd003,Di1) dabbr7 = Dval(dd00,Di1) + Dval(dd001,Di1) + & Dval(dd003,Di1) dabbr9 = Dval(dd00,Di1) + Dval(dd001,Di1) + & Dval(dd002,Di1) dabbr33 = dabbr35 + (Dval(dd00001,Di1) + del4) dabbr92 = Dval(dd333,Di1) + Dval(dd1333,Di1) + & Dval(dd2333,Di1) + Dval(dd3333,Di1) dabbr89 = dabbr49 + Dval(dd233,Di1) + Dval(dd1233,Di1) dabbr86 = dabbr45 + Dval(dd223,Di1) + Dval(dd1223,Di1) dabbr85 = Dval(dd222,Di1) + Dval(dd1222,Di1) + & Dval(dd2222,Di1) + Dval(dd2223,Di1) dabbr82 = Dval(dd133,Di1) + Dval(dd1133,Di1) + & Dval(dd1233,Di1) + Dval(dd1333,Di1) dabbr78 = dabbr42 + Dval(dd123,Di1) + Dval(dd1123,Di1) dabbr75 = Dval(dd122,Di1) + Dval(dd1122,Di1) + & Dval(dd1222,Di1) + Dval(dd1223,Di1) dabbr72 = Dval(dd113,Di1) + Dval(dd1113,Di1) + & Dval(dd1123,Di1) + Dval(dd1133,Di1) dabbr69 = Dval(dd112,Di1) + Dval(dd1112,Di1) + & Dval(dd1122,Di1) + Dval(dd1123,Di1) dabbr68 = Dval(dd111,Di1) + Dval(dd1111,Di1) + & Dval(dd1112,Di1) + Dval(dd1113,Di1) dabbr38 = dabbr27 + Dval(dd0013,Di1) dabbr36 = dabbr24 + Dval(dd0012,Di1) dabbr34 = dabbr13 + Dval(dd0011,Di1) dabbr32 = Dval(dd33,Di1) + Dval(dd133,Di1) + & Dval(dd233,Di1) + Dval(dd333,Di1) dabbr29 = dabbr10 + Dval(dd23,Di1) + Dval(dd123,Di1) dabbr28 = Dval(dd22,Di1) + Dval(dd122,Di1) + & Dval(dd222,Di1) + Dval(dd223,Di1) dabbr25 = Dval(dd13,Di1) + Dval(dd113,Di1) + & Dval(dd123,Di1) + Dval(dd133,Di1) dabbr22 = Dval(dd12,Di1) + Dval(dd112,Di1) + & Dval(dd122,Di1) + Dval(dd123,Di1) dabbr21 = Dval(dd11,Di1) + Dval(dd111,Di1) + & Dval(dd112,Di1) + Dval(dd113,Di1) dabbr3 = dabbr5 + Dval(dd001,Di1) dabbr8 = Dval(dd3,Di1) + Dval(dd13,Di1) + & Dval(dd23,Di1) + Dval(dd33,Di1) dabbr6 = Dval(dd2,Di1) + Dval(dd12,Di1) + & Dval(dd22,Di1) + Dval(dd23,Di1) dabbr4 = Dval(dd1,Di1) + Dval(dd11,Di1) + & Dval(dd12,Di1) + Dval(dd13,Di1) dabbr1 = Dval(dd0,Di1) + Dval(dd1,Di1) + & Dval(dd2,Di1) + Dval(dd3,Di1) dabbr61 = help1 + 2*Dval(dd0023,Di1) + & Dval(dd00223,Di1) + 2*Dval(dd00233,Di1) dabbr66 = help1 + 2*Dval(dd0013,Di1) + & Dval(dd00113,Di1) + 2*Dval(dd00133,Di1) dabbr57 = help2 + 2*Dval(dd0022,Di1) + & Dval(dd00222,Di1) + 2*Dval(dd00223,Di1) dabbr47 = help2 + 2*Dval(dd0012,Di1) + & Dval(dd00112,Di1) + 2*Dval(dd00123,Di1) dabbr51 = Dval(dd003,Di1) + 2*Dval(dd0013,Di1) + & 2*Dval(dd0023,Di1) + Dval(dd00113,Di1) + & 2*Dval(dd00123,Di1) + Dval(dd00223,Di1) dabbr64 = Dval(dd002,Di1) + 2*Dval(dd0012,Di1) + & 2*Dval(dd0022,Di1) + Dval(dd00112,Di1) + & 2*Dval(dd00122,Di1) + Dval(dd00222,Di1) dabbr44 = help3 + 2*Dval(dd0012,Di1) + & Dval(dd00122,Di1) + 2*Dval(dd00123,Di1) dabbr56 = help3 + 2*Dval(dd0011,Di1) + & Dval(dd00111,Di1) + 2*Dval(dd00113,Di1) dabbr59 = Dval(dd001,Di1) + 2*Dval(dd0011,Di1) + & 2*Dval(dd0012,Di1) + Dval(dd00111,Di1) + & 2*Dval(dd00112,Di1) + Dval(dd00122,Di1) dabbr14 = help4 + 2*Dval(dd002,Di1) + & Dval(dd0022,Di1) + 2*Dval(dd0023,Di1) dabbr17 = help4 + 2*Dval(dd001,Di1) + & Dval(dd0011,Di1) + 2*Dval(dd0013,Di1) dabbr19 = Dval(dd00,Di1) + 2*Dval(dd001,Di1) + & 2*Dval(dd002,Di1) + Dval(dd0011,Di1) + & 2*Dval(dd0012,Di1) + Dval(dd0022,Di1) dabbr67 = Dval(dd33,Di1) + 2*Dval(dd133,Di1) + & 2*Dval(dd233,Di1) + 2*Dval(dd333,Di1) + & Dval(dd1133,Di1) + 2*Dval(dd1233,Di1) + & 2*Dval(dd1333,Di1) + Dval(dd2233,Di1) + & 2*Dval(dd2333,Di1) + Dval(dd3333,Di1) dabbr63 = Dval(dd23,Di1) + 2*Dval(dd123,Di1) + & 2*Dval(dd223,Di1) + 2*Dval(dd233,Di1) + & Dval(dd1123,Di1) + 2*Dval(dd1223,Di1) + & 2*Dval(dd1233,Di1) + Dval(dd2223,Di1) + & 2*Dval(dd2233,Di1) + Dval(dd2333,Di1) dabbr62 = Dval(dd22,Di1) + 2*Dval(dd122,Di1) + & 2*Dval(dd222,Di1) + 2*Dval(dd223,Di1) + & Dval(dd1122,Di1) + 2*Dval(dd1222,Di1) + & 2*Dval(dd1223,Di1) + Dval(dd2222,Di1) + & 2*Dval(dd2223,Di1) + Dval(dd2233,Di1) dabbr58 = Dval(dd13,Di1) + 2*Dval(dd113,Di1) + & 2*Dval(dd123,Di1) + 2*Dval(dd133,Di1) + & Dval(dd1113,Di1) + 2*Dval(dd1123,Di1) + & 2*Dval(dd1133,Di1) + Dval(dd1223,Di1) + & 2*Dval(dd1233,Di1) + Dval(dd1333,Di1) dabbr54 = Dval(dd12,Di1) + 2*Dval(dd112,Di1) + & 2*Dval(dd122,Di1) + 2*Dval(dd123,Di1) + & Dval(dd1112,Di1) + 2*Dval(dd1122,Di1) + & 2*Dval(dd1123,Di1) + Dval(dd1222,Di1) + & 2*Dval(dd1223,Di1) + Dval(dd1233,Di1) dabbr53 = Dval(dd11,Di1) + 2*Dval(dd111,Di1) + & 2*Dval(dd112,Di1) + 2*Dval(dd113,Di1) + & Dval(dd1111,Di1) + 2*Dval(dd1112,Di1) + & 2*Dval(dd1113,Di1) + Dval(dd1122,Di1) + & 2*Dval(dd1123,Di1) + Dval(dd1133,Di1) dabbr11 = dabbr14 + 2*Dval(dd001,Di1) + & Dval(dd0011,Di1) + 2*Dval(dd0012,Di1) + & 2*Dval(dd0013,Di1) dabbr18 = Dval(dd3,Di1) + 2*Dval(dd13,Di1) + & 2*Dval(dd23,Di1) + 2*Dval(dd33,Di1) + & Dval(dd113,Di1) + 2*Dval(dd123,Di1) + & 2*Dval(dd133,Di1) + Dval(dd223,Di1) + & 2*Dval(dd233,Di1) + Dval(dd333,Di1) dabbr15 = Dval(dd2,Di1) + 2*Dval(dd12,Di1) + & 2*Dval(dd22,Di1) + 2*Dval(dd23,Di1) + & Dval(dd112,Di1) + 2*Dval(dd122,Di1) + & 2*Dval(dd123,Di1) + Dval(dd222,Di1) + & 2*Dval(dd223,Di1) + Dval(dd233,Di1) dabbr12 = Dval(dd1,Di1) + 2*Dval(dd11,Di1) + & 2*Dval(dd12,Di1) + 2*Dval(dd13,Di1) + & Dval(dd111,Di1) + 2*Dval(dd112,Di1) + & 2*Dval(dd113,Di1) + Dval(dd122,Di1) + & 2*Dval(dd123,Di1) + Dval(dd133,Di1) dabbr2 = Dval(dd0,Di1) + 2*Dval(dd1,Di1) + & 2*Dval(dd2,Di1) + 2*Dval(dd3,Di1) + & Dval(dd11,Di1) + 2*Dval(dd12,Di1) + & 2*Dval(dd13,Di1) + Dval(dd22,Di1) + & 2*Dval(dd23,Di1) + Dval(dd33,Di1) dabbr40 = Dval(dd0,Di1) + 4*Dval(dd1,Di1) + & 4*Dval(dd2,Di1) + 4*Dval(dd3,Di1) + & 6*Dval(dd11,Di1) + 12*Dval(dd12,Di1) + & 12*Dval(dd13,Di1) + 6*Dval(dd22,Di1) + & 12*Dval(dd23,Di1) + 6*Dval(dd33,Di1) + & 4*Dval(dd111,Di1) + 12*Dval(dd112,Di1) + & 12*Dval(dd113,Di1) + 12*Dval(dd122,Di1) + & 24*Dval(dd123,Di1) + 12*Dval(dd133,Di1) + & 4*Dval(dd222,Di1) + 12*Dval(dd223,Di1) + & 12*Dval(dd233,Di1) + 4*Dval(dd333,Di1) + & Dval(dd1111,Di1) + 4*Dval(dd1112,Di1) + & 4*Dval(dd1113,Di1) + 6*Dval(dd1122,Di1) + & 12*Dval(dd1123,Di1) + 6*Dval(dd1133,Di1) + & 4*Dval(dd1222,Di1) + 12*Dval(dd1223,Di1) + & 12*Dval(dd1233,Di1) + 4*Dval(dd1333,Di1) + & Dval(dd2222,Di1) + 4*Dval(dd2223,Di1) + & 6*Dval(dd2233,Di1) + 4*Dval(dd2333,Di1) + & Dval(dd3333,Di1) call XE0para(E(ee0), para) E(ee1) = dabbr1*eta(1) - eta(3)*Dval(dd1,Di3) - & eta(4)*Dval(dd1,Di4) - eta(5)*Dval(dd1,Di5) + & 2*(zeta(1,1)*Dval(dd00,Di2) + & zeta(1,2)*Dval(dd00,Di3) + & zeta(1,3)*Dval(dd00,Di4) + & zeta(1,4)*Dval(dd00,Di5) - & (zeta(1,1) + zeta(1,2) + zeta(1,3) + zeta(1,4))* & Dval(dd00,Di1)) E(ee2) = -(eta(2)*Dval(dd1,Di2)) - & eta(4)*Dval(dd2,Di4) - eta(5)*Dval(dd2,Di5) - & eta(1)*Dval(dd1,Di1) + & 2*zeta(1,2)*Dval(dd00,Di2) + & 2*zeta(2,2)*Dval(dd00,Di3) + & 2*zeta(2,3)*Dval(dd00,Di4) + & 2*zeta(2,4)*Dval(dd00,Di5) - & 2*(zeta(1,2) + zeta(2,2) + zeta(2,3) + zeta(2,4))* & Dval(dd00,Di1) E(ee3) = -(eta(2)*Dval(dd2,Di2)) - & eta(3)*Dval(dd2,Di3) - eta(5)*Dval(dd3,Di5) - & eta(1)*Dval(dd2,Di1) + & 2*zeta(1,3)*Dval(dd00,Di2) + & 2*zeta(2,3)*Dval(dd00,Di3) + & 2*zeta(3,3)*Dval(dd00,Di4) + & 2*zeta(3,4)*Dval(dd00,Di5) - & 2*(zeta(1,3) + zeta(2,3) + zeta(3,3) + zeta(3,4))* & Dval(dd00,Di1) E(ee4) = -(eta(2)*Dval(dd3,Di2)) - & eta(3)*Dval(dd3,Di3) - eta(4)*Dval(dd3,Di4) - & eta(1)*Dval(dd3,Di1) + & 2*zeta(1,4)*Dval(dd00,Di2) + & 2*zeta(2,4)*Dval(dd00,Di3) + & 2*zeta(3,4)*Dval(dd00,Di4) + & 2*zeta(4,4)*Dval(dd00,Di5) - & 2*(zeta(1,4) + zeta(2,4) + zeta(3,4) + zeta(4,4))* & Dval(dd00,Di1) E(ee00) = -(eta(2)*Dval(dd00,Di2)) - & eta(3)*Dval(dd00,Di3) - eta(4)*Dval(dd00,Di4) - & eta(5)*Dval(dd00,Di5) - eta(1)*Dval(dd00,Di1) E(ee11) = -(dabbr2*eta(1)) - eta(3)*Dval(dd11,Di3) - & eta(4)*Dval(dd11,Di4) - eta(5)*Dval(dd11,Di5) + & 4*(dabbr3*(zeta(1,1) + zeta(1,2) + zeta(1,3) + & zeta(1,4)) + zeta(1,2)*Dval(dd001,Di3) + & zeta(1,3)*Dval(dd001,Di4) + & zeta(1,4)*Dval(dd001,Di5)) E(ee12) = dabbr4*eta(1) - eta(4)*Dval(dd12,Di4) - & eta(5)*Dval(dd12,Di5) + & 2*(dabbr5*(zeta(1,2) + zeta(2,2) + zeta(2,3) + & zeta(2,4)) + zeta(1,1)*Dval(dd001,Di2) + & zeta(2,2)*Dval(dd001,Di3) + & zeta(2,3)*Dval(dd001,Di4) + & zeta(2,4)*Dval(dd001,Di5) + & zeta(1,3)*Dval(dd002,Di4) + & zeta(1,4)*Dval(dd002,Di5) - & (zeta(1,1) + zeta(1,3) + zeta(1,4) - zeta(2,2) - & zeta(2,3) - zeta(2,4))*Dval(dd001,Di1)) E(ee13) = dabbr6*eta(1) - eta(3)*Dval(dd12,Di3) - & eta(5)*Dval(dd13,Di5) + & 2*(dabbr7*(zeta(1,3) + zeta(2,3) + zeta(3,3) + & zeta(3,4)) + zeta(2,3)*Dval(dd001,Di3) + & zeta(3,3)*Dval(dd001,Di4) + & zeta(3,4)*Dval(dd001,Di5) + & zeta(1,1)*Dval(dd002,Di2) + & zeta(1,2)*Dval(dd002,Di3) + & zeta(1,4)*Dval(dd003,Di5) - & (zeta(1,1) + zeta(1,2) + zeta(1,4) - zeta(2,3) - & zeta(3,3) - zeta(3,4))*Dval(dd002,Di1)) E(ee14) = dabbr8*eta(1) - eta(3)*Dval(dd13,Di3) - & eta(4)*Dval(dd13,Di4) + & 2*(dabbr9*(zeta(1,4) + zeta(2,4) + zeta(3,4) + & zeta(4,4)) + zeta(2,4)*Dval(dd001,Di3) + & zeta(3,4)*Dval(dd001,Di4) + & zeta(4,4)*Dval(dd001,Di5) + & zeta(1,1)*Dval(dd003,Di2) + & zeta(1,2)*Dval(dd003,Di3) + & zeta(1,3)*Dval(dd003,Di4) - & (zeta(1,1) + zeta(1,2) + zeta(1,3) - zeta(2,4) - & zeta(3,4) - zeta(4,4))*Dval(dd003,Di1)) E(ee22) = -(eta(2)*Dval(dd11,Di2)) - & eta(4)*Dval(dd22,Di4) - eta(5)*Dval(dd22,Di5) - & eta(1)*Dval(dd11,Di1) + & 4*zeta(1,2)*Dval(dd001,Di2) + & 4*zeta(2,3)*Dval(dd002,Di4) + & 4*zeta(2,4)*Dval(dd002,Di5) - & 4*(zeta(1,2) + zeta(2,2) + zeta(2,3) + zeta(2,4))* & Dval(dd001,Di1) E(ee23) = -(eta(2)*Dval(dd12,Di2)) - & eta(5)*Dval(dd23,Di5) - eta(1)*Dval(dd12,Di1) + & 2*(zeta(1,3)*Dval(dd001,Di2) + & zeta(1,2)*Dval(dd002,Di2) + & zeta(2,2)*Dval(dd002,Di3) + & zeta(3,3)*Dval(dd002,Di4) + & zeta(3,4)*Dval(dd002,Di5) + & zeta(2,4)*Dval(dd003,Di5) - & (zeta(1,3) + zeta(2,3) + zeta(3,3) + zeta(3,4))* & Dval(dd001,Di1) - & (zeta(1,2) + zeta(2,2) + zeta(2,3) + zeta(2,4))* & Dval(dd002,Di1)) E(ee24) = -(eta(2)*Dval(dd13,Di2)) - & eta(4)*Dval(dd23,Di4) - eta(1)*Dval(dd13,Di1) + & 2*(zeta(1,4)*Dval(dd001,Di2) + & zeta(3,4)*Dval(dd002,Di4) + & zeta(4,4)*Dval(dd002,Di5) + & zeta(1,2)*Dval(dd003,Di2) + & zeta(2,2)*Dval(dd003,Di3) + & zeta(2,3)*Dval(dd003,Di4) - & (zeta(1,4) + zeta(2,4) + zeta(3,4) + zeta(4,4))* & Dval(dd001,Di1) - & (zeta(1,2) + zeta(2,2) + zeta(2,3) + zeta(2,4))* & Dval(dd003,Di1)) E(ee33) = -(eta(2)*Dval(dd22,Di2)) - & eta(3)*Dval(dd22,Di3) - eta(5)*Dval(dd33,Di5) - & eta(1)*Dval(dd22,Di1) + & 4*zeta(1,3)*Dval(dd002,Di2) + & 4*zeta(2,3)*Dval(dd002,Di3) + & 4*zeta(3,4)*Dval(dd003,Di5) - & 4*(zeta(1,3) + zeta(2,3) + zeta(3,3) + zeta(3,4))* & Dval(dd002,Di1) E(ee34) = -(eta(2)*Dval(dd23,Di2)) - & eta(3)*Dval(dd23,Di3) - eta(1)*Dval(dd23,Di1) + & 2*(zeta(1,4)*Dval(dd002,Di2) + & zeta(2,4)*Dval(dd002,Di3) + & zeta(1,3)*Dval(dd003,Di2) + & zeta(2,3)*Dval(dd003,Di3) + & zeta(3,3)*Dval(dd003,Di4) + & zeta(4,4)*Dval(dd003,Di5) - & (zeta(1,4) + zeta(2,4) + zeta(3,4) + zeta(4,4))* & Dval(dd002,Di1) - & (zeta(1,3) + zeta(2,3) + zeta(3,3) + zeta(3,4))* & Dval(dd003,Di1)) E(ee44) = -(eta(2)*Dval(dd33,Di2)) - & eta(3)*Dval(dd33,Di3) - eta(4)*Dval(dd33,Di4) - & eta(1)*Dval(dd33,Di1) + & 4*zeta(1,4)*Dval(dd003,Di2) + & 4*zeta(2,4)*Dval(dd003,Di3) + & 4*zeta(3,4)*Dval(dd003,Di4) - & 4*(zeta(1,4) + zeta(2,4) + zeta(3,4) + zeta(4,4))* & Dval(dd003,Di1) E(ee001) = dabbr3*eta(1) - eta(3)*Dval(dd001,Di3) - & eta(4)*Dval(dd001,Di4) - eta(5)*Dval(dd001,Di5) + & 2*(zeta(1,1)*(Dval(dd0000,Di2) - del) + & zeta(1,2)*(Dval(dd0000,Di3) - del) + & zeta(1,3)*(Dval(dd0000,Di4) - del) + & zeta(1,4)*(Dval(dd0000,Di5) - del) - & (zeta(1,1) + zeta(1,2) + zeta(1,3) + zeta(1,4))* & (Dval(dd0000,Di1) - del)) E(ee002) = -(eta(2)*Dval(dd001,Di2)) - & eta(4)*Dval(dd002,Di4) - eta(5)*Dval(dd002,Di5) - & eta(1)*Dval(dd001,Di1) + & 2*zeta(1,2)*(Dval(dd0000,Di2) - del) + & 2*zeta(2,2)*(Dval(dd0000,Di3) - del) + & 2*zeta(2,3)*(Dval(dd0000,Di4) - del) + & 2*zeta(2,4)*(Dval(dd0000,Di5) - del) - & 2*(zeta(1,2) + zeta(2,2) + zeta(2,3) + zeta(2,4))* & (Dval(dd0000,Di1) - del) E(ee003) = -(eta(2)*Dval(dd002,Di2)) - & eta(3)*Dval(dd002,Di3) - eta(5)*Dval(dd003,Di5) - & eta(1)*Dval(dd002,Di1) + & 2*zeta(1,3)*(Dval(dd0000,Di2) - del) + & 2*zeta(2,3)*(Dval(dd0000,Di3) - del) + & 2*zeta(3,3)*(Dval(dd0000,Di4) - del) + & 2*zeta(3,4)*(Dval(dd0000,Di5) - del) - & 2*(zeta(1,3) + zeta(2,3) + zeta(3,3) + zeta(3,4))* & (Dval(dd0000,Di1) - del) E(ee004) = -(eta(2)*Dval(dd003,Di2)) - & eta(3)*Dval(dd003,Di3) - eta(4)*Dval(dd003,Di4) - & eta(1)*Dval(dd003,Di1) + & 2*zeta(1,4)*(Dval(dd0000,Di2) - del) + & 2*zeta(2,4)*(Dval(dd0000,Di3) - del) + & 2*zeta(3,4)*(Dval(dd0000,Di4) - del) + & 2*zeta(4,4)*(Dval(dd0000,Di5) - del) - & 2*(zeta(1,4) + zeta(2,4) + zeta(3,4) + zeta(4,4))* & (Dval(dd0000,Di1) - del) E(ee111) = -6*dabbr11* & (zeta(1,1) + zeta(1,2) + zeta(1,3) + zeta(1,4)) - & eta(3)*Dval(dd111,Di3) - eta(4)*Dval(dd111,Di4) - & eta(5)*Dval(dd111,Di5) + & eta(1)*(3*dabbr10 + Dval(dd0,Di1) + & 3*Dval(dd1,Di1) + 3*Dval(dd2,Di1) + & 3*Dval(dd3,Di1) + 3*Dval(dd11,Di1) + & 6*Dval(dd12,Di1) + 6*Dval(dd13,Di1) + & 3*Dval(dd22,Di1) + 6*Dval(dd23,Di1) + & 3*Dval(dd33,Di1) + Dval(dd111,Di1) + & 3*Dval(dd112,Di1) + 3*Dval(dd113,Di1) + & 3*Dval(dd122,Di1) + 6*Dval(dd123,Di1) + & 3*Dval(dd133,Di1) + Dval(dd222,Di1) + & Dval(dd333,Di1)) + & 6*zeta(1,2)*Dval(dd0011,Di3) + & 6*zeta(1,3)*Dval(dd0011,Di4) + & 6*zeta(1,4)*Dval(dd0011,Di5) E(ee112) = -(dabbr12*eta(1)) - & 2*dabbr14*(zeta(1,2) + zeta(2,2) + zeta(2,3) + & zeta(2,4)) - eta(4)*Dval(dd112,Di4) - & eta(5)*Dval(dd112,Di5) + & 2*(2*dabbr13*(zeta(1,1) + zeta(1,3) + zeta(1,4) - & zeta(2,2) - zeta(2,3) - zeta(2,4)) + & zeta(2,2)*Dval(dd0011,Di3) + & zeta(2,3)*Dval(dd0011,Di4) + & zeta(2,4)*Dval(dd0011,Di5) + & 2*zeta(1,3)*Dval(dd0012,Di4) + & 2*zeta(1,4)*Dval(dd0012,Di5) + & (2*zeta(1,1) + zeta(1,2) + 2*zeta(1,3) + 2*zeta(1,4) - & zeta(2,2) - zeta(2,3) - zeta(2,4))* & Dval(dd0011,Di1)) E(ee113) = -(dabbr15*eta(1)) - & 2*dabbr17*(zeta(1,3) + zeta(2,3) + zeta(3,3) + & zeta(3,4)) - eta(3)*Dval(dd112,Di3) - & eta(5)*Dval(dd113,Di5) + & 2*(2*dabbr16*(zeta(1,1) + zeta(1,2) + zeta(1,4) - & zeta(2,3) - zeta(3,3) - zeta(3,4)) + & zeta(2,3)*Dval(dd0011,Di3) + & zeta(3,3)*Dval(dd0011,Di4) + & zeta(3,4)*Dval(dd0011,Di5) + & 2*zeta(1,2)*Dval(dd0012,Di3) + & 2*zeta(1,4)*Dval(dd0013,Di5) + & (2*zeta(1,1) + 2*zeta(1,2) + zeta(1,3) + 2*zeta(1,4) - & zeta(2,3) - zeta(3,3) - zeta(3,4))* & Dval(dd0022,Di1)) E(ee114) = -(dabbr18*eta(1)) - & 2*dabbr19*(zeta(1,4) + zeta(2,4) + zeta(3,4) + & zeta(4,4)) - eta(3)*Dval(dd113,Di3) - & eta(4)*Dval(dd113,Di4) + & 2*(2*dabbr20*(zeta(1,1) + zeta(1,2) + zeta(1,3) - & zeta(2,4) - zeta(3,4) - zeta(4,4)) + & zeta(2,4)*Dval(dd0011,Di3) + & zeta(3,4)*Dval(dd0011,Di4) + & zeta(4,4)*Dval(dd0011,Di5) + & 2*zeta(1,2)*Dval(dd0013,Di3) + & 2*zeta(1,3)*Dval(dd0013,Di4) + & (2*zeta(1,1) + 2*zeta(1,2) + 2*zeta(1,3) + zeta(1,4) - & zeta(2,4) - zeta(3,4) - zeta(4,4))* & Dval(dd0033,Di1)) E(ee122) = dabbr21*eta(1) - eta(4)*Dval(dd122,Di4) - & eta(5)*Dval(dd122,Di5) + & 2*(2*dabbr13*(zeta(1,2) + zeta(2,2) + zeta(2,3) + & zeta(2,4)) + zeta(1,1)*Dval(dd0011,Di2) + & 2*zeta(2,3)*Dval(dd0012,Di4) + & 2*zeta(2,4)*Dval(dd0012,Di5) + & zeta(1,3)*Dval(dd0022,Di4) + & zeta(1,4)*Dval(dd0022,Di5) - & (zeta(1,1) - zeta(1,2) + zeta(1,3) + zeta(1,4) - & 2*(zeta(2,2) + zeta(2,3) + zeta(2,4)))* & Dval(dd0011,Di1)) E(ee123) = dabbr22*eta(1) - eta(5)*Dval(dd123,Di5) + & 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)*Dval(dd0012,Di2) + & zeta(2,2)*Dval(dd0012,Di3) + & zeta(3,3)*Dval(dd0012,Di4) + & zeta(3,4)*Dval(dd0012,Di5) + & zeta(2,4)*Dval(dd0013,Di5) + & zeta(1,4)*Dval(dd0023,Di5) + & (-zeta(1,1) - zeta(1,4) + zeta(2,2) + 2*zeta(2,3) + & zeta(2,4) + zeta(3,3) + zeta(3,4))* & Dval(dd0012,Di1)) E(ee124) = dabbr25*eta(1) - eta(4)*Dval(dd123,Di4) + & 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)*Dval(dd0012,Di4) + & zeta(4,4)*Dval(dd0012,Di5) + & zeta(1,1)*Dval(dd0013,Di2) + & zeta(2,2)*Dval(dd0013,Di3) + & zeta(2,3)*Dval(dd0013,Di4) + & zeta(1,3)*Dval(dd0023,Di4) + & (-zeta(1,1) - zeta(1,3) + zeta(2,2) + zeta(2,3) + & 2*zeta(2,4) + zeta(3,4) + zeta(4,4))* & Dval(dd0013,Di1)) E(ee133) = dabbr28*eta(1) - eta(3)*Dval(dd122,Di3) - & eta(5)*Dval(dd133,Di5) + & 2*(2*dabbr16*(zeta(1,3) + zeta(2,3) + zeta(3,3) + & zeta(3,4)) + 2*zeta(2,3)*Dval(dd0012,Di3) + & 2*zeta(3,4)*Dval(dd0013,Di5) + & zeta(1,1)*Dval(dd0022,Di2) + & zeta(1,2)*Dval(dd0022,Di3) + & zeta(1,4)*Dval(dd0033,Di5) - & (zeta(1,1) + zeta(1,2) - zeta(1,3) + zeta(1,4) - & 2*(zeta(2,3) + zeta(3,3) + zeta(3,4)))* & Dval(dd0022,Di1)) E(ee134) = dabbr29*eta(1) - eta(3)*Dval(dd123,Di3) + & 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)*Dval(dd0012,Di3) + & zeta(2,3)*Dval(dd0013,Di3) + & zeta(3,3)*Dval(dd0013,Di4) + & zeta(4,4)*Dval(dd0013,Di5) + & zeta(1,1)*Dval(dd0023,Di2) + & zeta(1,2)*Dval(dd0023,Di3) + & (-zeta(1,1) - zeta(1,2) + zeta(2,3) + zeta(2,4) + & zeta(3,3) + 2*zeta(3,4) + zeta(4,4))* & Dval(dd0023,Di1)) E(ee144) = dabbr32*eta(1) - eta(3)*Dval(dd133,Di3) - & eta(4)*Dval(dd133,Di4) + & 2*(2*dabbr20*(zeta(1,4) + zeta(2,4) + zeta(3,4) + & zeta(4,4)) + 2*zeta(2,4)*Dval(dd0013,Di3) + & 2*zeta(3,4)*Dval(dd0013,Di4) + & zeta(1,1)*Dval(dd0033,Di2) + & zeta(1,2)*Dval(dd0033,Di3) + & zeta(1,3)*Dval(dd0033,Di4) - & (zeta(1,1) + zeta(1,2) + zeta(1,3) - zeta(1,4) - & 2*(zeta(2,4) + zeta(3,4) + zeta(4,4)))* & Dval(dd0033,Di1)) E(ee222) = -(eta(2)*Dval(dd111,Di2)) - & eta(4)*Dval(dd222,Di4) - eta(5)*Dval(dd222,Di5) - & eta(1)*Dval(dd111,Di1) + & 6*zeta(1,2)*Dval(dd0011,Di2) + & 6*zeta(2,3)*Dval(dd0022,Di4) + & 6*zeta(2,4)*Dval(dd0022,Di5) - & 6*(zeta(1,2) + zeta(2,2) + zeta(2,3) + zeta(2,4))* & Dval(dd0011,Di1) E(ee223) = -(eta(2)*Dval(dd112,Di2)) - & eta(5)*Dval(dd223,Di5) - eta(1)*Dval(dd112,Di1) + & 2*zeta(1,3)*Dval(dd0011,Di2) + & 4*zeta(1,2)*Dval(dd0012,Di2) + & 2*zeta(3,3)*Dval(dd0022,Di4) + & 2*zeta(3,4)*Dval(dd0022,Di5) + & 4*zeta(2,4)*Dval(dd0023,Di5) - & 2*(zeta(1,3) + zeta(2,3) + zeta(3,3) + zeta(3,4))* & Dval(dd0011,Di1) - & 4*(zeta(1,2) + zeta(2,2) + zeta(2,3) + zeta(2,4))* & Dval(dd0012,Di1) E(ee224) = -(eta(2)*Dval(dd113,Di2)) - & eta(4)*Dval(dd223,Di4) - eta(1)*Dval(dd113,Di1) + & 2*zeta(1,4)*Dval(dd0011,Di2) + & 4*zeta(1,2)*Dval(dd0013,Di2) + & 2*zeta(3,4)*Dval(dd0022,Di4) + & 2*zeta(4,4)*Dval(dd0022,Di5) + & 4*zeta(2,3)*Dval(dd0023,Di4) - & 2*(zeta(1,4) + zeta(2,4) + zeta(3,4) + zeta(4,4))* & Dval(dd0011,Di1) - & 4*(zeta(1,2) + zeta(2,2) + zeta(2,3) + zeta(2,4))* & Dval(dd0013,Di1) E(ee233) = -(eta(2)*Dval(dd122,Di2)) - & eta(5)*Dval(dd233,Di5) - eta(1)*Dval(dd122,Di1) + & 4*zeta(1,3)*Dval(dd0012,Di2) + & 2*zeta(1,2)*Dval(dd0022,Di2) + & 2*zeta(2,2)*Dval(dd0022,Di3) + & 4*zeta(3,4)*Dval(dd0023,Di5) + & 2*zeta(2,4)*Dval(dd0033,Di5) - & 4*(zeta(1,3) + zeta(2,3) + zeta(3,3) + zeta(3,4))* & Dval(dd0012,Di1) - & 2*(zeta(1,2) + zeta(2,2) + zeta(2,3) + zeta(2,4))* & Dval(dd0022,Di1) E(ee234) = -(eta(2)*Dval(dd123,Di2)) - & eta(1)*Dval(dd123,Di1) + & 2*(zeta(1,4)*Dval(dd0012,Di2) + & zeta(1,3)*Dval(dd0013,Di2) + & zeta(1,2)*Dval(dd0023,Di2) + & zeta(2,2)*Dval(dd0023,Di3) + & zeta(3,3)*Dval(dd0023,Di4) + & zeta(4,4)*Dval(dd0023,Di5) - & (zeta(1,4) + zeta(2,4) + zeta(3,4) + zeta(4,4))* & Dval(dd0012,Di1) - & (zeta(1,3) + zeta(2,3) + zeta(3,3) + zeta(3,4))* & Dval(dd0013,Di1) - & (zeta(1,2) + zeta(2,2) + zeta(2,3) + zeta(2,4))* & Dval(dd0023,Di1)) E(ee244) = -(eta(2)*Dval(dd133,Di2)) - & eta(4)*Dval(dd233,Di4) - eta(1)*Dval(dd133,Di1) + & 4*zeta(1,4)*Dval(dd0013,Di2) + & 4*zeta(3,4)*Dval(dd0023,Di4) + & 2*zeta(1,2)*Dval(dd0033,Di2) + & 2*zeta(2,2)*Dval(dd0033,Di3) + & 2*zeta(2,3)*Dval(dd0033,Di4) - & 4*(zeta(1,4) + zeta(2,4) + zeta(3,4) + zeta(4,4))* & Dval(dd0013,Di1) - & 2*(zeta(1,2) + zeta(2,2) + zeta(2,3) + zeta(2,4))* & Dval(dd0033,Di1) E(ee333) = -(eta(2)*Dval(dd222,Di2)) - & eta(3)*Dval(dd222,Di3) - eta(5)*Dval(dd333,Di5) - & eta(1)*Dval(dd222,Di1) + & 6*zeta(1,3)*Dval(dd0022,Di2) + & 6*zeta(2,3)*Dval(dd0022,Di3) + & 6*zeta(3,4)*Dval(dd0033,Di5) - & 6*(zeta(1,3) + zeta(2,3) + zeta(3,3) + zeta(3,4))* & Dval(dd0022,Di1) E(ee334) = -(eta(2)*Dval(dd223,Di2)) - & eta(3)*Dval(dd223,Di3) - eta(1)*Dval(dd223,Di1) + & 2*zeta(1,4)*Dval(dd0022,Di2) + & 2*zeta(2,4)*Dval(dd0022,Di3) + & 4*zeta(1,3)*Dval(dd0023,Di2) + & 4*zeta(2,3)*Dval(dd0023,Di3) + & 2*zeta(4,4)*Dval(dd0033,Di5) - & 2*(zeta(1,4) + zeta(2,4) + zeta(3,4) + zeta(4,4))* & Dval(dd0022,Di1) - & 4*(zeta(1,3) + zeta(2,3) + zeta(3,3) + zeta(3,4))* & Dval(dd0023,Di1) E(ee344) = -(eta(2)*Dval(dd233,Di2)) - & eta(3)*Dval(dd233,Di3) - eta(1)*Dval(dd233,Di1) + & 4*zeta(1,4)*Dval(dd0023,Di2) + & 4*zeta(2,4)*Dval(dd0023,Di3) + & 2*zeta(1,3)*Dval(dd0033,Di2) + & 2*zeta(2,3)*Dval(dd0033,Di3) + & 2*zeta(3,3)*Dval(dd0033,Di4) - & 4*(zeta(1,4) + zeta(2,4) + zeta(3,4) + zeta(4,4))* & Dval(dd0023,Di1) - & 2*(zeta(1,3) + zeta(2,3) + zeta(3,3) + zeta(3,4))* & Dval(dd0033,Di1) E(ee444) = -(eta(2)*Dval(dd333,Di2)) - & eta(3)*Dval(dd333,Di3) - eta(4)*Dval(dd333,Di4) - & eta(1)*Dval(dd333,Di1) + & 6*zeta(1,4)*Dval(dd0033,Di2) + & 6*zeta(2,4)*Dval(dd0033,Di3) + & 6*zeta(3,4)*Dval(dd0033,Di4) - & 6*(zeta(1,4) + zeta(2,4) + zeta(3,4) + zeta(4,4))* & Dval(dd0033,Di1) E(ee0000) = (-finite*(detZ/detY) - & 48*(eta(2)*(Dval(dd0000,Di2) - del) + & eta(3)*(Dval(dd0000,Di3) - del) + & eta(4)*(Dval(dd0000,Di4) - del) + & eta(5)*(Dval(dd0000,Di5) - del) + & eta(1)*(Dval(dd0000,Di1) - del)))/48D0 E(ee0011) = -(dabbr11*eta(1)) - & eta(3)*Dval(dd0011,Di3) - & eta(4)*Dval(dd0011,Di4) - & eta(5)*Dval(dd0011,Di5) + & 4*(dabbr33*(zeta(1,1) + zeta(1,2) + zeta(1,3) + & zeta(1,4)) + & zeta(1,2)*(Dval(dd00001,Di3) + del4) + & zeta(1,3)*(Dval(dd00001,Di4) + del4) + & zeta(1,4)*(Dval(dd00001,Di5) + del4)) E(ee0012) = dabbr34*eta(1) - & eta(4)*Dval(dd0012,Di4) - & eta(5)*Dval(dd0012,Di5) + & 2*(dabbr35*(zeta(1,2) + zeta(2,2) + zeta(2,3) + & zeta(2,4)) + & zeta(1,1)*(Dval(dd00001,Di2) + del4) + & zeta(2,2)*(Dval(dd00001,Di3) + del4) + & zeta(2,3)*(Dval(dd00001,Di4) + del4) + & zeta(2,4)*(Dval(dd00001,Di5) + del4) + & zeta(1,3)*(Dval(dd00002,Di4) + del4) + & zeta(1,4)*(Dval(dd00002,Di5) + del4) - & (zeta(1,1) + zeta(1,3) + zeta(1,4) - zeta(2,2) - & zeta(2,3) - zeta(2,4))* & (Dval(dd00001,Di1) + del4)) E(ee0013) = dabbr36*eta(1) - & eta(3)*Dval(dd0012,Di3) - & eta(5)*Dval(dd0013,Di5) + & 2*(dabbr37*(zeta(1,3) + zeta(2,3) + zeta(3,3) + & zeta(3,4)) + & zeta(2,3)*(Dval(dd00001,Di3) + del4) + & zeta(3,3)*(Dval(dd00001,Di4) + del4) + & zeta(3,4)*(Dval(dd00001,Di5) + del4) + & zeta(1,1)*(Dval(dd00002,Di2) + del4) + & zeta(1,2)*(Dval(dd00002,Di3) + del4) + & zeta(1,4)*(Dval(dd00003,Di5) + del4) - & (zeta(1,1) + zeta(1,2) + zeta(1,4) - zeta(2,3) - & zeta(3,3) - zeta(3,4))* & (Dval(dd00002,Di1) + del4)) E(ee0014) = dabbr38*eta(1) - & eta(3)*Dval(dd0013,Di3) - & eta(4)*Dval(dd0013,Di4) + & 2*(dabbr39*(zeta(1,4) + zeta(2,4) + zeta(3,4) + & zeta(4,4)) + & zeta(2,4)*(Dval(dd00001,Di3) + del4) + & zeta(3,4)*(Dval(dd00001,Di4) + del4) + & zeta(4,4)*(Dval(dd00001,Di5) + del4) + & zeta(1,1)*(Dval(dd00003,Di2) + del4) + & zeta(1,2)*(Dval(dd00003,Di3) + del4) + & zeta(1,3)*(Dval(dd00003,Di4) + del4) - & (zeta(1,1) + zeta(1,2) + zeta(1,3) - zeta(2,4) - & zeta(3,4) - zeta(4,4))* & (Dval(dd00003,Di1) + del4)) E(ee0022) = -(eta(2)*Dval(dd0011,Di2)) - & eta(4)*Dval(dd0022,Di4) - & eta(5)*Dval(dd0022,Di5) - & eta(1)*Dval(dd0011,Di1) + & 4*zeta(1,2)*(Dval(dd00001,Di2) + del4) + & 4*zeta(2,3)*(Dval(dd00002,Di4) + del4) + & 4*zeta(2,4)*(Dval(dd00002,Di5) + del4) - & 4*(zeta(1,2) + zeta(2,2) + zeta(2,3) + zeta(2,4))* & (Dval(dd00001,Di1) + del4) E(ee0023) = -(eta(2)*Dval(dd0012,Di2)) - & eta(5)*Dval(dd0023,Di5) - & eta(1)*Dval(dd0012,Di1) + & 2*(zeta(1,3)*(Dval(dd00001,Di2) + del4) + & zeta(1,2)*(Dval(dd00002,Di2) + del4) + & zeta(2,2)*(Dval(dd00002,Di3) + del4) + & zeta(3,3)*(Dval(dd00002,Di4) + del4) + & zeta(3,4)*(Dval(dd00002,Di5) + del4) + & zeta(2,4)*(Dval(dd00003,Di5) + del4) - & (zeta(1,3) + zeta(2,3) + zeta(3,3) + zeta(3,4))* & (Dval(dd00001,Di1) + del4) - & (zeta(1,2) + zeta(2,2) + zeta(2,3) + zeta(2,4))* & (Dval(dd00002,Di1) + del4)) E(ee0024) = -(eta(2)*Dval(dd0013,Di2)) - & eta(4)*Dval(dd0023,Di4) - & eta(1)*Dval(dd0013,Di1) + & 2*(zeta(1,4)*(Dval(dd00001,Di2) + del4) + & zeta(3,4)*(Dval(dd00002,Di4) + del4) + & zeta(4,4)*(Dval(dd00002,Di5) + del4) + & zeta(1,2)*(Dval(dd00003,Di2) + del4) + & zeta(2,2)*(Dval(dd00003,Di3) + del4) + & zeta(2,3)*(Dval(dd00003,Di4) + del4) - & (zeta(1,4) + zeta(2,4) + zeta(3,4) + zeta(4,4))* & (Dval(dd00001,Di1) + del4) - & (zeta(1,2) + zeta(2,2) + zeta(2,3) + zeta(2,4))* & (Dval(dd00003,Di1) + del4)) E(ee0033) = -(eta(2)*Dval(dd0022,Di2)) - & eta(3)*Dval(dd0022,Di3) - & eta(5)*Dval(dd0033,Di5) - & eta(1)*Dval(dd0022,Di1) + & 4*zeta(1,3)*(Dval(dd00002,Di2) + del4) + & 4*zeta(2,3)*(Dval(dd00002,Di3) + del4) + & 4*zeta(3,4)*(Dval(dd00003,Di5) + del4) - & 4*(zeta(1,3) + zeta(2,3) + zeta(3,3) + zeta(3,4))* & (Dval(dd00002,Di1) + del4) E(ee0034) = -(eta(2)*Dval(dd0023,Di2)) - & eta(3)*Dval(dd0023,Di3) - & eta(1)*Dval(dd0023,Di1) + & 2*(zeta(1,4)*(Dval(dd00002,Di2) + del4) + & zeta(2,4)*(Dval(dd00002,Di3) + del4) + & zeta(1,3)*(Dval(dd00003,Di2) + del4) + & zeta(2,3)*(Dval(dd00003,Di3) + del4) + & zeta(3,3)*(Dval(dd00003,Di4) + del4) + & zeta(4,4)*(Dval(dd00003,Di5) + del4) - & (zeta(1,4) + zeta(2,4) + zeta(3,4) + zeta(4,4))* & (Dval(dd00002,Di1) + del4) - & (zeta(1,3) + zeta(2,3) + zeta(3,3) + zeta(3,4))* & (Dval(dd00003,Di1) + del4)) E(ee0044) = -(eta(2)*Dval(dd0033,Di2)) - & eta(3)*Dval(dd0033,Di3) - & eta(4)*Dval(dd0033,Di4) - & eta(1)*Dval(dd0033,Di1) + & 4*zeta(1,4)*(Dval(dd00003,Di2) + del4) + & 4*zeta(2,4)*(Dval(dd00003,Di3) + del4) + & 4*zeta(3,4)*(Dval(dd00003,Di4) + del4) - & 4*(zeta(1,4) + zeta(2,4) + zeta(3,4) + zeta(4,4))* & (Dval(dd00003,Di1) + del4) E(ee1111) = -(dabbr40*eta(1)) - & eta(3)*Dval(dd1111,Di3) - & eta(4)*Dval(dd1111,Di4) - & eta(5)*Dval(dd1111,Di5) + & 8*zeta(1,2)*Dval(dd00111,Di3) + & 8*zeta(1,3)*Dval(dd00111,Di4) + & 8*zeta(1,4)*Dval(dd00111,Di5) + & 8*(zeta(1,1) + zeta(1,2) + zeta(1,3) + zeta(1,4))* & (3*dabbr41 + Dval(dd00,Di1) + & 3*Dval(dd001,Di1) + 3*Dval(dd002,Di1) + & 3*Dval(dd003,Di1) + 3*Dval(dd0011,Di1) + & 6*Dval(dd0012,Di1) + 6*Dval(dd0013,Di1) + & 3*Dval(dd0022,Di1) + 6*Dval(dd0023,Di1) + & 3*Dval(dd0033,Di1) + Dval(dd00111,Di1) + & 3*Dval(dd00112,Di1) + 3*Dval(dd00113,Di1) + & 3*Dval(dd00122,Di1) + 6*Dval(dd00123,Di1) + & 3*Dval(dd00133,Di1) + Dval(dd00222,Di1) + & Dval(dd00333,Di1)) 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)*Dval(dd1112,Di4) - & eta(5)*Dval(dd1112,Di5) + & eta(1)*(3*dabbr42 + Dval(dd1,Di1) + & 3*Dval(dd11,Di1) + 3*Dval(dd12,Di1) + & 3*Dval(dd13,Di1) + 3*Dval(dd111,Di1) + & 6*Dval(dd112,Di1) + 6*Dval(dd113,Di1) + & 3*Dval(dd122,Di1) + 6*Dval(dd123,Di1) + & 3*Dval(dd133,Di1) + Dval(dd1111,Di1) + & 3*Dval(dd1112,Di1) + 3*Dval(dd1113,Di1) + & 3*Dval(dd1122,Di1) + 6*Dval(dd1123,Di1) + & 3*Dval(dd1133,Di1) + Dval(dd1222,Di1) + & Dval(dd1333,Di1)) + & 2*(zeta(2,2)*Dval(dd00111,Di3) + & zeta(2,3)*Dval(dd00111,Di4) + & zeta(2,4)*Dval(dd00111,Di5) + & 3*zeta(1,3)*Dval(dd00112,Di4) + & 3*zeta(1,4)*Dval(dd00112,Di5) + & (-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))* & Dval(dd00111,Di1)) + & 2*(zeta(1,2) + zeta(2,2) + zeta(2,3) + zeta(2,4))* & (3*dabbr41 + Dval(dd00,Di1) + & 3*Dval(dd002,Di1) + 3*Dval(dd003,Di1) + & 3*Dval(dd0022,Di1) + 6*Dval(dd0023,Di1) + & 3*Dval(dd0033,Di1) + Dval(dd00222,Di1) + & Dval(dd00333,Di1)) 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)*Dval(dd1112,Di3) - & eta(5)*Dval(dd1113,Di5) + & eta(1)*(3*dabbr45 + Dval(dd2,Di1) + & 3*Dval(dd12,Di1) + 3*Dval(dd22,Di1) + & 3*Dval(dd23,Di1) + 3*Dval(dd112,Di1) + & 6*Dval(dd122,Di1) + 6*Dval(dd123,Di1) + & 3*Dval(dd222,Di1) + 6*Dval(dd223,Di1) + & 3*Dval(dd233,Di1) + Dval(dd1112,Di1) + & 3*Dval(dd1122,Di1) + 3*Dval(dd1123,Di1) + & 3*Dval(dd1222,Di1) + 6*Dval(dd1223,Di1) + & 3*Dval(dd1233,Di1) + Dval(dd2222,Di1) + & Dval(dd2333,Di1)) + & 2*(zeta(2,3)*Dval(dd00111,Di3) + & zeta(3,3)*Dval(dd00111,Di4) + & zeta(3,4)*Dval(dd00111,Di5) + & 3*zeta(1,2)*Dval(dd00112,Di3) + & 3*zeta(1,4)*Dval(dd00113,Di5) + & (-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))* & Dval(dd00222,Di1)) + & 2*(zeta(1,3) + zeta(2,3) + zeta(3,3) + zeta(3,4))* & (3*dabbr48 + Dval(dd00,Di1) + & 3*Dval(dd001,Di1) + 3*Dval(dd003,Di1) + & 3*Dval(dd0011,Di1) + 6*Dval(dd0013,Di1) + & 3*Dval(dd0033,Di1) + Dval(dd00111,Di1) + & Dval(dd00333,Di1)) 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)*Dval(dd1113,Di3) - & eta(4)*Dval(dd1113,Di4) + & eta(1)*(3*dabbr49 + Dval(dd3,Di1) + & 3*Dval(dd13,Di1) + 3*Dval(dd23,Di1) + & 3*Dval(dd33,Di1) + 3*Dval(dd113,Di1) + & 6*Dval(dd123,Di1) + 6*Dval(dd133,Di1) + & 3*Dval(dd223,Di1) + 6*Dval(dd233,Di1) + & 3*Dval(dd333,Di1) + Dval(dd1113,Di1) + & 3*Dval(dd1123,Di1) + 3*Dval(dd1133,Di1) + & 3*Dval(dd1223,Di1) + 6*Dval(dd1233,Di1) + & 3*Dval(dd1333,Di1) + Dval(dd2223,Di1) + & Dval(dd3333,Di1)) + & 2*(zeta(1,4) + zeta(2,4) + zeta(3,4) + zeta(4,4))* & (3*dabbr50 + Dval(dd00,Di1) + & 3*Dval(dd001,Di1) + 3*Dval(dd002,Di1) + & 3*Dval(dd0011,Di1) + 6*Dval(dd0012,Di1) + & 3*Dval(dd0022,Di1) + Dval(dd00111,Di1) + & Dval(dd00222,Di1)) + & 2*(zeta(2,4)*Dval(dd00111,Di3) + & zeta(3,4)*Dval(dd00111,Di4) + & zeta(4,4)*Dval(dd00111,Di5) + & 3*zeta(1,2)*Dval(dd00113,Di3) + & 3*zeta(1,3)*Dval(dd00113,Di4) + & (-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))* & Dval(dd00333,Di1)) E(ee1122) = -(dabbr53*eta(1)) - & 4*dabbr44*(zeta(1,2) + zeta(2,2) + zeta(2,3) + & zeta(2,4)) - eta(4)*Dval(dd1122,Di4) - & eta(5)*Dval(dd1122,Di5) + & 4*(-2*dabbr43*(zeta(2,2) + zeta(2,3) + zeta(2,4)) + & zeta(1,1)*Dval(dd0011,Di1) - & zeta(1,2)*Dval(dd0011,Di1) + & zeta(1,3)*Dval(dd0011,Di1) + & zeta(1,4)*Dval(dd0011,Di1) + & zeta(2,3)*Dval(dd00112,Di4) + & zeta(2,4)*Dval(dd00112,Di5) + & zeta(1,3)*Dval(dd00122,Di4) + & zeta(1,4)*Dval(dd00122,Di5) + & (zeta(1,1) + zeta(1,3) + zeta(1,4) - zeta(2,2) - & zeta(2,3) - zeta(2,4))*Dval(dd00111,Di1) + & zeta(1,1)*Dval(dd00112,Di1) - & zeta(1,2)*Dval(dd00112,Di1) + & zeta(1,3)*Dval(dd00112,Di1) + & zeta(1,4)*Dval(dd00112,Di1) + & (zeta(1,1) - zeta(1,2) + zeta(1,3) + zeta(1,4))* & Dval(dd00113,Di1)) 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)*Dval(dd1123,Di5) + & 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)*Dval(dd00112,Di3) + & zeta(3,3)*Dval(dd00112,Di4) + & zeta(3,4)*Dval(dd00112,Di5) + & zeta(2,4)*Dval(dd00113,Di5) + & 2*zeta(1,4)*Dval(dd00123,Di5) + & (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)) & *Dval(dd00112,Di1) + & (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))* & Dval(dd00122,Di1)) 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)*Dval(dd1123,Di4) + & 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)*Dval(dd00112,Di4) + & zeta(4,4)*Dval(dd00112,Di5) + & zeta(2,2)*Dval(dd00113,Di3) + & zeta(2,3)*Dval(dd00113,Di4) + & 2*zeta(1,3)*Dval(dd00123,Di4) + & (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)) & *Dval(dd00113,Di1) + & (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))* & Dval(dd00133,Di1)) E(ee1133) = -(dabbr62*eta(1)) - & 4*dabbr47*(zeta(1,3) + zeta(2,3) + zeta(3,3) + & zeta(3,4)) - eta(3)*Dval(dd1122,Di3) - & eta(5)*Dval(dd1133,Di5) + & 4*(-2*dabbr46*(zeta(2,3) + zeta(3,3) + zeta(3,4)) + & zeta(1,1)*Dval(dd0022,Di1) + & zeta(1,2)*Dval(dd0022,Di1) - & zeta(1,3)*Dval(dd0022,Di1) + & zeta(1,4)*Dval(dd0022,Di1) + & zeta(2,3)*Dval(dd00112,Di3) + & zeta(3,4)*Dval(dd00113,Di5) + & zeta(1,2)*Dval(dd00122,Di3) + & zeta(1,4)*Dval(dd00133,Di5) + & zeta(1,1)*Dval(dd00122,Di1) + & zeta(1,2)*Dval(dd00122,Di1) - & zeta(1,3)*Dval(dd00122,Di1) + & zeta(1,4)*Dval(dd00122,Di1) + & (zeta(1,1) + zeta(1,2) + zeta(1,4) - zeta(2,3) - & zeta(3,3) - zeta(3,4))*Dval(dd00222,Di1) + & (zeta(1,1) + zeta(1,2) - zeta(1,3) + zeta(1,4))* & Dval(dd00223,Di1)) 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)*Dval(dd1123,Di3) + & 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)*Dval(dd00112,Di3) + & zeta(2,3)*Dval(dd00113,Di3) + & zeta(3,3)*Dval(dd00113,Di4) + & zeta(4,4)*Dval(dd00113,Di5) + & 2*zeta(1,2)*Dval(dd00123,Di3) + & (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)) & *Dval(dd00223,Di1) + & (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))* & Dval(dd00233,Di1)) E(ee1144) = -(dabbr67*eta(1)) - & 4*dabbr51*(zeta(1,4) + zeta(2,4) + zeta(3,4) + & zeta(4,4)) - eta(3)*Dval(dd1133,Di3) - & eta(4)*Dval(dd1133,Di4) + & 4*(-2*dabbr52*(zeta(2,4) + zeta(3,4) + zeta(4,4)) + & zeta(1,1)*Dval(dd0033,Di1) + & zeta(1,2)*Dval(dd0033,Di1) + & zeta(1,3)*Dval(dd0033,Di1) - & zeta(1,4)*Dval(dd0033,Di1) + & zeta(2,4)*Dval(dd00113,Di3) + & zeta(3,4)*Dval(dd00113,Di4) + & zeta(1,2)*Dval(dd00133,Di3) + & zeta(1,3)*Dval(dd00133,Di4) + & zeta(1,1)*Dval(dd00133,Di1) + & zeta(1,2)*Dval(dd00133,Di1) + & zeta(1,3)*Dval(dd00133,Di1) - & zeta(1,4)*Dval(dd00133,Di1) + & (zeta(1,1) + zeta(1,2) + zeta(1,3) - zeta(1,4))* & Dval(dd00233,Di1) + & (zeta(1,1) + zeta(1,2) + zeta(1,3) - zeta(2,4) - & zeta(3,4) - zeta(4,4))*Dval(dd00333,Di1)) E(ee1222) = dabbr68*eta(1) - & eta(4)*Dval(dd1222,Di4) - & eta(5)*Dval(dd1222,Di5) + & 2*(3*dabbr43*(zeta(1,2) + zeta(2,2) + zeta(2,3) + & zeta(2,4)) + zeta(1,1)*Dval(dd00111,Di2) + & 3*zeta(2,3)*Dval(dd00122,Di4) + & 3*zeta(2,4)*Dval(dd00122,Di5) + & zeta(1,3)*Dval(dd00222,Di4) + & zeta(1,4)*Dval(dd00222,Di5) - & (zeta(1,1) - 2*zeta(1,2) + zeta(1,3) + zeta(1,4) - & 3*(zeta(2,2) + zeta(2,3) + zeta(2,4)))* & Dval(dd00111,Di1)) E(ee1223) = dabbr69*eta(1) - & eta(5)*Dval(dd1223,Di5) + & 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)*Dval(dd00112,Di2) + & zeta(3,3)*Dval(dd00122,Di4) + & zeta(3,4)*Dval(dd00122,Di5) + & 2*zeta(2,4)*Dval(dd00123,Di5) + & zeta(1,4)*Dval(dd00223,Di5) + & (-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))* & Dval(dd00112,Di1)) E(ee1224) = dabbr72*eta(1) - & eta(4)*Dval(dd1223,Di4) + & 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)*Dval(dd00113,Di2) + & zeta(3,4)*Dval(dd00122,Di4) + & zeta(4,4)*Dval(dd00122,Di5) + & 2*zeta(2,3)*Dval(dd00123,Di4) + & zeta(1,3)*Dval(dd00223,Di4) + & (-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))* & Dval(dd00113,Di1)) E(ee1233) = dabbr75*eta(1) - & eta(5)*Dval(dd1233,Di5) + & 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)*Dval(dd00122,Di2) + & zeta(2,2)*Dval(dd00122,Di3) + & 2*zeta(3,4)*Dval(dd00123,Di5) + & zeta(2,4)*Dval(dd00133,Di5) + & zeta(1,4)*Dval(dd00233,Di5) + & (-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))) & *Dval(dd00122,Di1)) 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)*Dval(dd00123,Di2) + & zeta(2,2)*Dval(dd00123,Di3) + & zeta(3,3)*Dval(dd00123,Di4) + & zeta(4,4)*Dval(dd00123,Di5) + & (-zeta(1,1) + zeta(2,2) + 2*zeta(2,3) + 2*zeta(2,4) + & zeta(3,3) + 2*zeta(3,4) + zeta(4,4))* & Dval(dd00123,Di1)) E(ee1244) = dabbr82*eta(1) - & eta(4)*Dval(dd1233,Di4) + & 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)*Dval(dd00123,Di4) + & zeta(1,1)*Dval(dd00133,Di2) + & zeta(2,2)*Dval(dd00133,Di3) + & zeta(2,3)*Dval(dd00133,Di4) + & zeta(1,3)*Dval(dd00233,Di4) + & (-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))) & *Dval(dd00133,Di1)) E(ee1333) = dabbr85*eta(1) - & eta(3)*Dval(dd1222,Di3) - & eta(5)*Dval(dd1333,Di5) + & 2*(3*dabbr46*(zeta(1,3) + zeta(2,3) + zeta(3,3) + & zeta(3,4)) + 3*zeta(2,3)*Dval(dd00122,Di3) + & 3*zeta(3,4)*Dval(dd00133,Di5) + & zeta(1,1)*Dval(dd00222,Di2) + & zeta(1,2)*Dval(dd00222,Di3) + & zeta(1,4)*Dval(dd00333,Di5) - & (zeta(1,1) + zeta(1,2) - 2*zeta(1,3) + zeta(1,4) - & 3*(zeta(2,3) + zeta(3,3) + zeta(3,4)))* & Dval(dd00222,Di1)) E(ee1334) = dabbr86*eta(1) - & eta(3)*Dval(dd1223,Di3) + & 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)*Dval(dd00122,Di3) + & 2*zeta(2,3)*Dval(dd00123,Di3) + & zeta(4,4)*Dval(dd00133,Di5) + & zeta(1,1)*Dval(dd00223,Di2) + & zeta(1,2)*Dval(dd00223,Di3) + & (-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))* & Dval(dd00223,Di1)) E(ee1344) = dabbr89*eta(1) - & eta(3)*Dval(dd1233,Di3) + & 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)*Dval(dd00123,Di3) + & zeta(2,3)*Dval(dd00133,Di3) + & zeta(3,3)*Dval(dd00133,Di4) + & zeta(1,1)*Dval(dd00233,Di2) + & zeta(1,2)*Dval(dd00233,Di3) + & (-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)) & *Dval(dd00233,Di1)) E(ee1444) = dabbr92*eta(1) - & eta(3)*Dval(dd1333,Di3) - & eta(4)*Dval(dd1333,Di4) + & 2*(3*dabbr52*(zeta(1,4) + zeta(2,4) + zeta(3,4) + & zeta(4,4)) + 3*zeta(2,4)*Dval(dd00133,Di3) + & 3*zeta(3,4)*Dval(dd00133,Di4) + & zeta(1,1)*Dval(dd00333,Di2) + & zeta(1,2)*Dval(dd00333,Di3) + & zeta(1,3)*Dval(dd00333,Di4) - & (zeta(1,1) + zeta(1,2) + zeta(1,3) - 2*zeta(1,4) - & 3*(zeta(2,4) + zeta(3,4) + zeta(4,4)))* & Dval(dd00333,Di1)) E(ee2222) = -(eta(2)*Dval(dd1111,Di2)) - & eta(4)*Dval(dd2222,Di4) - & eta(5)*Dval(dd2222,Di5) - & eta(1)*Dval(dd1111,Di1) + & 8*zeta(1,2)*Dval(dd00111,Di2) + & 8*zeta(2,3)*Dval(dd00222,Di4) + & 8*zeta(2,4)*Dval(dd00222,Di5) - & 8*(zeta(1,2) + zeta(2,2) + zeta(2,3) + zeta(2,4))* & Dval(dd00111,Di1) E(ee2223) = -(eta(2)*Dval(dd1112,Di2)) - & eta(5)*Dval(dd2223,Di5) - & eta(1)*Dval(dd1112,Di1) + & 2*zeta(1,3)*Dval(dd00111,Di2) + & 6*zeta(1,2)*Dval(dd00112,Di2) + & 2*zeta(3,3)*Dval(dd00222,Di4) + & 2*zeta(3,4)*Dval(dd00222,Di5) + & 6*zeta(2,4)*Dval(dd00223,Di5) - & 2*(zeta(1,3) + zeta(2,3) + zeta(3,3) + zeta(3,4))* & Dval(dd00111,Di1) - & 6*(zeta(1,2) + zeta(2,2) + zeta(2,3) + zeta(2,4))* & Dval(dd00112,Di1) E(ee2224) = -(eta(2)*Dval(dd1113,Di2)) - & eta(4)*Dval(dd2223,Di4) - & eta(1)*Dval(dd1113,Di1) + & 2*zeta(1,4)*Dval(dd00111,Di2) + & 6*zeta(1,2)*Dval(dd00113,Di2) + & 2*zeta(3,4)*Dval(dd00222,Di4) + & 2*zeta(4,4)*Dval(dd00222,Di5) + & 6*zeta(2,3)*Dval(dd00223,Di4) - & 2*(zeta(1,4) + zeta(2,4) + zeta(3,4) + zeta(4,4))* & Dval(dd00111,Di1) - & 6*(zeta(1,2) + zeta(2,2) + zeta(2,3) + zeta(2,4))* & Dval(dd00113,Di1) E(ee2233) = -(eta(2)*Dval(dd1122,Di2)) - & eta(5)*Dval(dd2233,Di5) - & eta(1)*Dval(dd1122,Di1) + & 4*(zeta(1,3)*Dval(dd00112,Di2) + & zeta(1,2)*Dval(dd00122,Di2) + & zeta(3,4)*Dval(dd00223,Di5) + & zeta(2,4)*Dval(dd00233,Di5) - & (zeta(1,3) + zeta(2,3) + zeta(3,3) + zeta(3,4))* & Dval(dd00112,Di1) - & (zeta(1,2) + zeta(2,2) + zeta(2,3) + zeta(2,4))* & Dval(dd00122,Di1)) E(ee2234) = -(eta(2)*Dval(dd1123,Di2)) - & eta(1)*Dval(dd1123,Di1) + & 2*(zeta(1,4)*Dval(dd00112,Di2) + & zeta(1,3)*Dval(dd00113,Di2) + & 2*zeta(1,2)*Dval(dd00123,Di2) + & zeta(3,3)*Dval(dd00223,Di4) + & zeta(4,4)*Dval(dd00223,Di5) - & (zeta(1,4) + zeta(2,4) + zeta(3,4) + zeta(4,4))* & Dval(dd00112,Di1) - & (zeta(1,3) + zeta(2,3) + zeta(3,3) + zeta(3,4))* & Dval(dd00113,Di1) - & 2*(zeta(1,2) + zeta(2,2) + zeta(2,3) + zeta(2,4))* & Dval(dd00123,Di1)) E(ee2244) = -(eta(2)*Dval(dd1133,Di2)) - & eta(4)*Dval(dd2233,Di4) - & eta(1)*Dval(dd1133,Di1) + & 4*(zeta(1,4)*Dval(dd00113,Di2) + & zeta(1,2)*Dval(dd00133,Di2) + & zeta(3,4)*Dval(dd00223,Di4) + & zeta(2,3)*Dval(dd00233,Di4) - & (zeta(1,4) + zeta(2,4) + zeta(3,4) + zeta(4,4))* & Dval(dd00113,Di1) - & (zeta(1,2) + zeta(2,2) + zeta(2,3) + zeta(2,4))* & Dval(dd00133,Di1)) E(ee2333) = -(eta(2)*Dval(dd1222,Di2)) - & eta(5)*Dval(dd2333,Di5) - & eta(1)*Dval(dd1222,Di1) + & 6*zeta(1,3)*Dval(dd00122,Di2) + & 2*zeta(1,2)*Dval(dd00222,Di2) + & 2*zeta(2,2)*Dval(dd00222,Di3) + & 6*zeta(3,4)*Dval(dd00233,Di5) + & 2*zeta(2,4)*Dval(dd00333,Di5) - & 6*(zeta(1,3) + zeta(2,3) + zeta(3,3) + zeta(3,4))* & Dval(dd00122,Di1) - & 2*(zeta(1,2) + zeta(2,2) + zeta(2,3) + zeta(2,4))* & Dval(dd00222,Di1) E(ee2334) = -(eta(2)*Dval(dd1223,Di2)) - & eta(1)*Dval(dd1223,Di1) + & 2*(zeta(1,4)*Dval(dd00122,Di2) + & 2*zeta(1,3)*Dval(dd00123,Di2) + & zeta(1,2)*Dval(dd00223,Di2) + & zeta(2,2)*Dval(dd00223,Di3) + & zeta(4,4)*Dval(dd00233,Di5) - & (zeta(1,4) + zeta(2,4) + zeta(3,4) + zeta(4,4))* & Dval(dd00122,Di1) - & 2*(zeta(1,3) + zeta(2,3) + zeta(3,3) + zeta(3,4))* & Dval(dd00123,Di1) - & (zeta(1,2) + zeta(2,2) + zeta(2,3) + zeta(2,4))* & Dval(dd00223,Di1)) E(ee2344) = -(eta(2)*Dval(dd1233,Di2)) - & eta(1)*Dval(dd1233,Di1) + & 2*(2*zeta(1,4)*Dval(dd00123,Di2) + & zeta(1,3)*Dval(dd00133,Di2) + & zeta(1,2)*Dval(dd00233,Di2) + & zeta(2,2)*Dval(dd00233,Di3) + & zeta(3,3)*Dval(dd00233,Di4) - & 2*(zeta(1,4) + zeta(2,4) + zeta(3,4) + zeta(4,4))* & Dval(dd00123,Di1) - & (zeta(1,3) + zeta(2,3) + zeta(3,3) + zeta(3,4))* & Dval(dd00133,Di1) - & (zeta(1,2) + zeta(2,2) + zeta(2,3) + zeta(2,4))* & Dval(dd00233,Di1)) E(ee2444) = -(eta(2)*Dval(dd1333,Di2)) - & eta(4)*Dval(dd2333,Di4) - & eta(1)*Dval(dd1333,Di1) + & 6*zeta(1,4)*Dval(dd00133,Di2) + & 6*zeta(3,4)*Dval(dd00233,Di4) + & 2*zeta(1,2)*Dval(dd00333,Di2) + & 2*zeta(2,2)*Dval(dd00333,Di3) + & 2*zeta(2,3)*Dval(dd00333,Di4) - & 6*(zeta(1,4) + zeta(2,4) + zeta(3,4) + zeta(4,4))* & Dval(dd00133,Di1) - & 2*(zeta(1,2) + zeta(2,2) + zeta(2,3) + zeta(2,4))* & Dval(dd00333,Di1) E(ee3333) = -(eta(2)*Dval(dd2222,Di2)) - & eta(3)*Dval(dd2222,Di3) - & eta(5)*Dval(dd3333,Di5) - & eta(1)*Dval(dd2222,Di1) + & 8*zeta(1,3)*Dval(dd00222,Di2) + & 8*zeta(2,3)*Dval(dd00222,Di3) + & 8*zeta(3,4)*Dval(dd00333,Di5) - & 8*(zeta(1,3) + zeta(2,3) + zeta(3,3) + zeta(3,4))* & Dval(dd00222,Di1) E(ee3334) = -(eta(2)*Dval(dd2223,Di2)) - & eta(3)*Dval(dd2223,Di3) - & eta(1)*Dval(dd2223,Di1) + & 2*zeta(1,4)*Dval(dd00222,Di2) + & 2*zeta(2,4)*Dval(dd00222,Di3) + & 6*zeta(1,3)*Dval(dd00223,Di2) + & 6*zeta(2,3)*Dval(dd00223,Di3) + & 2*zeta(4,4)*Dval(dd00333,Di5) - & 2*(zeta(1,4) + zeta(2,4) + zeta(3,4) + zeta(4,4))* & Dval(dd00222,Di1) - & 6*(zeta(1,3) + zeta(2,3) + zeta(3,3) + zeta(3,4))* & Dval(dd00223,Di1) E(ee3344) = -(eta(2)*Dval(dd2233,Di2)) - & eta(3)*Dval(dd2233,Di3) - & eta(1)*Dval(dd2233,Di1) + & 4*(zeta(1,4)*Dval(dd00223,Di2) + & zeta(2,4)*Dval(dd00223,Di3) + & zeta(1,3)*Dval(dd00233,Di2) + & zeta(2,3)*Dval(dd00233,Di3) - & (zeta(1,4) + zeta(2,4) + zeta(3,4) + zeta(4,4))* & Dval(dd00223,Di1) - & (zeta(1,3) + zeta(2,3) + zeta(3,3) + zeta(3,4))* & Dval(dd00233,Di1)) E(ee3444) = -(eta(2)*Dval(dd2333,Di2)) - & eta(3)*Dval(dd2333,Di3) - & eta(1)*Dval(dd2333,Di1) + & 6*zeta(1,4)*Dval(dd00233,Di2) + & 6*zeta(2,4)*Dval(dd00233,Di3) + & 2*zeta(1,3)*Dval(dd00333,Di2) + & 2*zeta(2,3)*Dval(dd00333,Di3) + & 2*zeta(3,3)*Dval(dd00333,Di4) - & 6*(zeta(1,4) + zeta(2,4) + zeta(3,4) + zeta(4,4))* & Dval(dd00233,Di1) - & 2*(zeta(1,3) + zeta(2,3) + zeta(3,3) + zeta(3,4))* & Dval(dd00333,Di1) E(ee4444) = -(eta(2)*Dval(dd3333,Di2)) - & eta(3)*Dval(dd3333,Di3) - & eta(4)*Dval(dd3333,Di4) - & eta(1)*Dval(dd3333,Di1) + & 8*zeta(1,4)*Dval(dd00333,Di2) + & 8*zeta(2,4)*Dval(dd00333,Di3) + & 8*zeta(3,4)*Dval(dd00333,Di4) - & 8*(zeta(1,4) + zeta(2,4) + zeta(3,4) + zeta(4,4))* & Dval(dd00333,Di1) if( dump ) call XDumpCoeff(5, E) end looptools-2.8.orig/src/B/0000755000175000017500000000000012026327703016210 5ustar sylvestresylvestrelooptools-2.8.orig/src/B/ffdel2.F0000644000175000017500000003440111776502522017470 0ustar sylvestresylvestre#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.8.orig/src/B/ffxdb0.F0000644000175000017500000003727211776502522017510 0ustar sylvestresylvestre#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. acc ) 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.8.orig/src/B/BcoeffAD.F0000644000175000017500000001630512026271470017714 0ustar sylvestresylvestre* 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 19 Sep 12 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, A0b external fpv, yfpv, fth, xlogx, A0b RealType p, m1, m2 RealType dm, la ComplexType x1, x2, y1, y2, r ComplexType mu, f1, f2, g1, g2 integer sel m1 = M(1) m2 = M(2) p = P(1) dm = m1 - m2 * general case if( abs(p) .gt. eps*(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 *, "Bcoeffb 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 B(bb00) = ((p + dm)*B(bb1) + & 2*m1*B(bb0) + A0b(m2) + m1 + m2 - p/3D0)/6D0 B(bb001) = .125D0*( 2*m1*B(bb1) - A0b(m2) + & (p + dm)*(B(bb11) + 1/6D0) - .5D0*(m1 + m2) ) if( abs(x1 - x2) .gt. acc*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. acc ) then B(dbb11) = -Re(4/3D0 + (3 - 4*x1)*fpv(2, x1, y1))/p sel = 3 else B(dbb11) = nan endif if( m1*m2 .eq. 0 .and. & abs(p - m1 - m2) .lt. acc ) then * IR divergent case la = lambda if( la .le. 0 ) la = mudim 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( m2 .eq. 0 .and. abs(p - m1) .lt. acc ) 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. acc*(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)) B(bb00) = (2*(m1*B(bb0) + A0b(m2)) + 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) B(bb00) = (2*(m2*B(bb0) + A0b(m1)) + 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 ) 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. acc ) 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.8.orig/src/B/ffcdb0.F0000644000175000017500000004162111776502522017454 0ustar sylvestresylvestre#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,jsign,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 s2 = s2a + slam if ( absc(s2) .gt. xloss*absc(slam) ) then * looks fine jsign = 1 else s2 = s2a - slam jsign = -1 endif s2 = s2/sqrt(4*cm1*cm2) if ( absc(s2) .lt. xclogm ) then call fferr(9,ier) s2 = 0 elseif ( absc(s2-1) .lt. xloss ) then ier = ier + 50 print *,'ffcdb0: untested: s2 better in first try' if ( jsign.eq.1 ) then s2 = -slam*(s2a+slam)/(2*cm1*cm2) s2 = -diff/(2*slam*cp)*zfflo1(s2,ier) else s2 = +slam*(s2a-slam)/(2*cm1*cm2) s2 = +diff/(2*slam*cp)*zfflo1(s2,ier) endif else s2 = -diff/(2*slam*cp)*2*log(s2) if ( jsign .eq. -1 ) s2 = -s2 endif 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.8.orig/src/B/Bcoeff.F0000644000175000017500000000442112026271570017504 0ustar sylvestresylvestre* Bcoeff.F * invoke the two-point tensor coefficients * this file is part of LoopTools * last modified 11 Sep 12 th #include "externals.h" #include "types.h" #define npoint 2 #include "defs.h" subroutine Bcoeff(res, para) implicit none ComplexType res(*) RealType para(1,*) #include "lt.h" ComplexType cmp(Nbb) RealType p, m1, m2 integer ier(Nbb), ierall, i logical dump m1 = M(1) m2 = M(2) p = P(1) serial = serial + 1 dump = ibits(debugkey, DebugB, 1) .ne. 0 .and. & serial .ge. debugfrom .and. serial .le. debugto if( dump ) call XDumpPara(2, para, "Bcoeff") do i = 1, Nbb res(i) = 0 enddo if( abs(p) + abs(m1) + abs(m2) .lt. eps ) goto 9 if( lambda .lt. 0 ) then if( lambda .ne. -1 ) goto 9 res(bb0) = 1 res(bb1) = -.5D0 res(bb00) = -(p - 3*(m1 + m2))/12D0 res(bb11) = 1/3D0 res(bb001) = (p - 2*m1 - 4*m2)/24D0 res(bb111) = -.25D0 if( m1*m2 .eq. 0 .and. abs(p - m1 - m2) .lt. acc ) & res(dbb0) = -.5D0/p if( m2 .eq. 0 .and. abs(p - m1) .lt. acc ) & res(dbb1) = .5D0/p res(dbb00) = -1/12D0 goto 9 endif goto (1, 2, 3) ibits(versionkey, KeyBget, 2) call BcoeffAD(res, para) goto 9 1 call BcoeffFF(res, para, ier) ierall = 0 do i = 1, Nbb ierall = max(ierall, ier(i)) enddo if( ierall .gt. warndigits ) then call BcoeffAD(cmp, para) call Bcheck(cmp, res, ier, para) endif goto 9 2 call BcoeffAD(res, para) call BcoeffFF(cmp, para, ier) call Bcheck(res, cmp, ier, para) goto 9 3 call BcoeffFF(res, para, ier) call BcoeffAD(cmp, para) call Bcheck(cmp, res, ier, para) 9 if( dump ) call DumpCoeff(2, res) end ************************************************************************ subroutine Bcheck(Ba, Bb, ier, para) implicit none ComplexType Ba(*), Bb(*) integer ier(*) DVAR para(1,*) #include "lt.h" integer i logical ini character*5 name(Nbb) data name /"bb0", "bb1", "bb00", "bb11", "bb001", "bb111", & "dbb0", "dbb1", "dbb00", "dbb11"/ ini = .TRUE. do i = 1, Nbb 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 *, name(i), " a =", Ba(i) print *, name(i), " b =", Bb(i) if( ier(i) .gt. errdigits ) Bb(i) = Ba(i) endif enddo end looptools-2.8.orig/src/B/Bget.F0000644000175000017500000000777312024311775017216 0ustar sylvestresylvestre* Bget.F * retrieve the two-point tensor coefficients * this file is part of LoopTools * last modified 13 Sep 12 th #include "externals.h" #include "types.h" #define npoint 2 #include "defs.h" memindex function XBget(p, m1, m2) implicit none DVAR p, m1, m2 #include "lt.h" memindex cacheindex external cacheindex, XBcoeff #ifdef COMPLEXPARA memindex Bget external Bget #endif DVAR para(1,Pbb) P(1) = p #ifdef COMPLEXPARA if( abs(Im(P(1))) .gt. 0 ) & print *, "BgetC: Complex momenta not implemented" #endif M(1) = m1 if( abs(M(1)) .lt. minmass ) M(1) = 0 M(2) = m2 if( abs(M(2)) .lt. minmass ) M(2) = 0 #ifdef COMPLEXPARA if( abs(Im(M(1))) + abs(Im(M(2))) .eq. 0 ) then XBget = Bget(p, m1, m2) - offsetC return endif #endif XBget = cacheindex(para, Bval(1,0), XBcoeff, RC*Pbb, Nbb) end ************************************************************************ subroutine XBput(res, p, m1, m2) implicit none ComplexType res(*) DVAR p, m1, m2 #include "lt.h" external XBcoeff DVAR para(1,Pbb) P(1) = p #ifdef COMPLEXPARA if( abs(Im(P(1))) .gt. 0 ) & print *, "BputC: Complex momenta not implemented" #endif M(1) = m1 if( abs(M(1)) .lt. minmass ) M(1) = 0 M(2) = m2 if( abs(M(2)) .lt. minmass ) M(2) = 0 #ifdef COMPLEXPARA if( abs(Im(M(1))) + abs(Im(M(2))) .eq. 0 ) then call Bput(res, p, m1, m2) return endif #endif call cachecopy(res, para, Bval(1,0), XBcoeff, RC*Pbb, Nbb) end ************************************************************************ ComplexType function XB0i(i, p, m1, m2) implicit none integer i DVAR p, m1, m2 #include "lt.h" memindex XBget external XBget memindex b b = XBget(p, m1, m2) XB0i = Bval(i,b) end ************************************************************************ ComplexType function XB0(p, m1, m2) implicit none DVAR p, m1, m2 #include "lt.h" memindex XBget external XBget XB0 = Bval(bb0,XBget(p, m1, m2)) end ************************************************************************ ComplexType function XB1(p, m1, m2) implicit none DVAR p, m1, m2 #include "lt.h" memindex XBget external XBget XB1 = Bval(bb1,XBget(p, m1, m2)) end ************************************************************************ ComplexType function XB00(p, m1, m2) implicit none DVAR p, m1, m2 #include "lt.h" memindex XBget external XBget XB00 = Bval(bb00,XBget(p, m1, m2)) end ************************************************************************ ComplexType function XB11(p, m1, m2) implicit none DVAR p, m1, m2 #include "lt.h" memindex XBget external XBget XB11 = Bval(bb11,XBget(p, m1, m2)) end ************************************************************************ ComplexType function XB001(p, m1, m2) implicit none DVAR p, m1, m2 #include "lt.h" memindex XBget external XBget XB001 = Bval(bb001,XBget(p, m1, m2)) end ************************************************************************ ComplexType function XB111(p, m1, m2) implicit none DVAR p, m1, m2 #include "lt.h" memindex XBget external XBget XB111 = Bval(bb111,XBget(p, m1, m2)) end ************************************************************************ ComplexType function XDB0(p, m1, m2) implicit none DVAR p, m1, m2 #include "lt.h" memindex XBget external XBget XDB0 = Bval(dbb0,XBget(p, m1, m2)) end ************************************************************************ ComplexType function XDB1(p, m1, m2) implicit none DVAR p, m1, m2 #include "lt.h" memindex XBget external XBget XDB1 = Bval(dbb1,XBget(p, m1, m2)) end ************************************************************************ ComplexType function XDB00(p, m1, m2) implicit none DVAR p, m1, m2 #include "lt.h" memindex XBget external XBget XDB00 = Bval(dbb00,XBget(p, m1, m2)) end ************************************************************************ ComplexType function XDB11(p, m1, m2) implicit none DVAR p, m1, m2 #include "lt.h" memindex XBget external XBget XDB11 = Bval(dbb11,XBget(p, m1, m2)) end looptools-2.8.orig/src/B/ffxb2p.F0000644000175000017500000002612111776502522017515 0ustar sylvestresylvestre#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.8.orig/src/B/ffxb0.F0000644000175000017500000005520211776502522017335 0ustar sylvestresylvestre#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 410 i = 1,30 410 xpnn1(i) = Re(i)/Re((i+1)*(i+2)) 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.8.orig/src/B/ffxb1.F0000644000175000017500000001550111776502522017334 0ustar sylvestresylvestre#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.8.orig/src/B/ffcb0.F0000644000175000017500000004666111776502522017321 0ustar sylvestresylvestre#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 logical lreal ComplexType cmamb,cmap,cmbp,cm,c,cb0p,cqi(3),cqiqj(3,3) RealType absc,xp,xma,xmb,sprec,smax save init * * 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 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 endif if ( mudim .ne. 0 ) cm = cm/Re(mudim)**2 if ( absc(cm) .gt. xclogm ) then cb0 = Re(delta) - cb0p - log(cm)/2 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 410 i = 1,30 410 xpnn1(i)=Re(i)/Re((i+1)*(i+2)) 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.8.orig/src/B/ffcb2p.F0000644000175000017500000002606511776502522017477 0ustar sylvestresylvestre#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.8.orig/src/B/ffxdb1.F0000644000175000017500000002101612005163405017463 0ustar sylvestresylvestre#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. acc*(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. acc*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. acc ) 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. acc*(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. acc*(m1 + m2) ) then call ffroots(p, m1, m2, xp, xm, yp, ym, r, ier) if( abs(xp - xm) .gt. acc*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. acc ) 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. acc*(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. acc*(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. acc*(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.8.orig/src/B/BcoeffFF.F0000644000175000017500000000423112026271436017720 0ustar sylvestresylvestre* BcoeffFF.F * the two-point tensor coefficients from FF * this file is part of LoopTools * last modified 19 Sep 12 th #include "externals.h" #include "types.h" #define npoint 2 #include "defs.h" subroutine XBcoeffFF(B, para, ier) implicit none ComplexType B(*) DVAR para(1,*) integer ier(*) #include "lt.h" DVAR p, m1, m2, dm ComplexType a0(2), b2(2), pdb0 integer i #ifdef COMPLEXPARA DVAR 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. acc ) then if( abs(dm) .lt. acc ) 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. acc ) then if( abs(dm) .lt. acc ) then B(bb111) = -.25D0*B(bb0) else m1dm = m1/dm B(bb111)= 3/16D0 + .25D0*a0(2)/dm*(m1dm + 1) + & .5D0*m1dm*(m1dm*(B(bb1) - .5D0) - 1/6D0) endif else B(bb111) = -.25D0*( a0(2) + 2*m1*B(bb1) + & (p + dm)*(3*B(bb11) + 1/6D0) - .5D0*(m1 + m2) )/p endif B(dbb1) = .5D0/p*( & (a0(2) - a0(1) + dm*B(bb0))/p - & (p + dm)*B(dbb0) ) 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 ) end looptools-2.8.orig/src/B/BcoeffC.F0000644000175000017500000000207212026271506017606 0ustar sylvestresylvestre* BcoeffC.F * invoke the two-point tensor coefficients * this file is part of LoopTools * last modified 19 Sep 12 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" integer ier(Nbb), i logical ini character*5 name(Nbb) data name /"bb0", "bb1", "bb11", "bb00", "bb001", "bb111", & "dbb0", "dbb1", "dbb00", "dbb11"/ if( lambda .lt. 0 ) then do i = 1, Nbb B(i) = 0 enddo if( lambda .eq. -1 ) then B(bb0) = 1 B(bb1) = -.5D0 B(bb00) = -(P(1) - 3*(M(1) + M(2)))/12D0 B(bb11) = 1/3D0 B(bb001) = -(P(1) - 2*M(1) - 4*M(2))/24D0 B(bb111) = -.25D0 B(dbb00) = -1/12D0 endif return 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 *, name(i), " claims ", ier(i), "lost digits" endif enddo end looptools-2.8.orig/src/B/ffcb1.F0000644000175000017500000002142111776502522017305 0ustar sylvestresylvestre#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.8.orig/src/B/ffcel2.F0000644000175000017500000003231211776502522017466 0ustar sylvestresylvestre#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.8.orig/src/include/0000755000175000017500000000000012026604266017454 5ustar sylvestresylvestrelooptools-2.8.orig/src/include/fferr.h0000644000175000017500000002517711776502523020751 0ustar sylvestresylvestre 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.8.orig/src/include/ff.h0000644000175000017500000001542712023542670020226 0ustar sylvestresylvestre* $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,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) * RealType acc, eps 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, & acc = 1D-12, & eps = 1D-22, & cIeps = (0D0,1D-100) ) * * 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,lambda,minmass common /ltregul/ mudimc,delta,lambda,minmass 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.8.orig/src/include/perm.h0000644000175000017500000000314311776502523020575 0ustar sylvestresylvestre* 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.8.orig/src/include/ftypes.h0000644000175000017500000000427712026574120021144 0ustar sylvestresylvestre#ifndef FTYPES_H #define FTYPES_H #if NOUNDERSCORE #define FORTRAN(s) s #else #define FORTRAN(s) s##_ #endif #if QUAD #define RealType long double #pragma pack(push, 1) typedef union { long double r10; struct { unsigned long long frac; unsigned short exp; } i10; struct { char zero[6]; unsigned long long frac; unsigned short exp; } i16; unsigned long long i8[2]; unsigned char b[16]; } REAL; #pragma pack(pop) static inline REAL ToREAL(const RealType r) { REAL new; new.i8[0] = 0; new.i16.frac = ((REAL *)&r)->i10.frac << 1; new.i16.exp = ((REAL *)&r)->i10.exp; return new; } static inline RealType ToReal(const REAL r) { REAL new; const long long z = r.i16.frac | (r.i16.exp & 0x7fff); new.i10.frac = (r.i16.frac >> 1) | ((z | -z) & 0x8000000000000000LL); new.i10.exp = r.i16.exp; return new.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]); } #else #define RealType double typedef double REAL; #define ToReal(r) (r) #define ToREAL(r) (r) #endif typedef int INTEGER; typedef const INTEGER CINTEGER; 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) #elif __STDC_VERSION__ >= 199901L #include typedef RealType complex ComplexType; #define ToComplex(c) (ToReal((c).re) + I*ToReal((c).im)) #define ToComplex2(r,i) (r + I*(i)) #define Re(x) creal(x) #define Im(x) cimag(x) #else typedef struct { RealType re, im; } ComplexType; #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 #endif typedef const RealType cRealType; typedef const ComplexType cComplexType; #endif looptools-2.8.orig/src/include/cexternals.h0000644000175000017500000000040712026275141021772 0ustar sylvestresylvestre#if 0 This file was generated by mkexternalsh on Wed Sep 19 09:55:13 CEST 2012. Do not edit. #endif #if NOUNDERSCORE #define cachecopy ljcachecopy #define cacheindex ljcacheindex #else #define cachecopy_ ljcachecopy_ #define cacheindex_ ljcacheindex_ #endif looptools-2.8.orig/src/include/ffwarn.h0000644000175000017500000007222711776502523021126 0ustar sylvestresylvestre 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.8.orig/src/include/lt.h0000644000175000017500000000151611776502523020253 0ustar sylvestresylvestre* lt.h * internal common blocks for the LoopTools routines * this file is part of LoopTools * last modified 3 Mar 11 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 = 8) integer*8 cacheptr(4,KIND,ncaches) integer*8 savedptr(2,ncaches) RealType maxdev integer warndigits, errdigits integer serial, versionkey integer debugkey, debugfrom, debugto common /ltvars/ & cacheptr, savedptr, & maxdev, & warndigits, errdigits, & serial, versionkey, & debugkey, debugfrom, debugto integer cmpbits common /ltcache/ cmpbits ComplexType cache(2,ncaches) equivalence (cacheptr, cache) #ifndef sig #define sig(c) int(sign(1D0,Re(r)) #define DEBUGLEVEL ibits(debugkey,8,2) #endif looptools-2.8.orig/src/include/types.h0000644000175000017500000000056211776502573021005 0ustar sylvestresylvestre* types.h * real-based type declarations * this file is part of LoopTools * last modified 9 Jul 12 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 #define Sq(c) Re((c)*Conjugate(c)) #define Sqrtc(c) sqrt(ToComplex(c)) #endif looptools-2.8.orig/src/include/ffperm5.h0000644000175000017500000004613211776502523021203 0ustar sylvestresylvestre 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.8.orig/src/include/clooptools.h.in0000644000175000017500000003547212026577515022450 0ustar sylvestresylvestre/* clooptools.h the C/C++ header file with all definitions for LoopTools this file is part of LoopTools last modified 20 Sep 12 th */ #ifndef CLOOPTOOLS_H #define CLOOPTOOLS_H #define AARGS(t) t(m) #define BARGS(t) t(p), t(m1), t(m2) #define CARGS(t) t(p1), t(p2), t(p1p2), t(m1), t(m2), t(m3) #define DARGS(t) t(p1), t(p2), t(p3), t(p4), t(p1p2), t(p2p3), \ t(m1), t(m2), t(m3), t(m4) #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) #define XARGS(t) t(x) #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 #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_Frd_(f) CREAL f(_lt_CFr_) #define _lt_Fcd_(f) CCOMPLEX f(_lt_CFc_) #else #define _lt_Frp_(v) &v #define _lt_Fcp_(v) (CCOMPLEX *)&v #define _lt_Frd_(f) #define _lt_Fcd_(f) #endif enum { bb0, bb1, bb00, bb11, bb001, bb111, dbb0, dbb1, dbb00, dbb11, Nbb }; enum { cc0, cc1, cc2, cc00, cc11, cc12, cc22, cc001, cc002, cc111, cc112, cc122, cc222, cc0000, cc0011, cc0012, cc0022, cc1111, cc1112, cc1122, cc1222, cc2222, Ncc }; enum { 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, Ndd }; enum { 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, Nee }; 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 { DebugB = 1, DebugC = 1<<1, DebugD = 1<<2, DebugE = 1<<3, DebugAll = DebugB + DebugC + DebugD + DebugE }; typedef long long int memindex; /****************************************************************/ #ifdef __cplusplus extern "C" { #endif extern void FORTRAN(a0sub)(COMPLEX *result, AARGS(_lt_Fr_)); extern void FORTRAN(a0subc)(COMPLEX *result, AARGS(_lt_Fc_)); extern void FORTRAN(a00sub)(COMPLEX *result, AARGS(_lt_Fr_)); extern void FORTRAN(a00subc)(COMPLEX *result, AARGS(_lt_Fc_)); extern memindex FORTRAN(bget)(BARGS(_lt_Fr_)); extern memindex FORTRAN(bgetc)(BARGS(_lt_Fc_)); extern void FORTRAN(c0sub)(COMPLEX *result, CARGS(_lt_Fr_)); extern void FORTRAN(c0subc)(COMPLEX *result, CARGS(_lt_Fc_)); extern memindex FORTRAN(cget)(CARGS(_lt_Fr_)); extern memindex FORTRAN(cgetc)(CARGS(_lt_Fc_)); extern void FORTRAN(d0sub)(COMPLEX *result, DARGS(_lt_Fr_)); extern void FORTRAN(d0subc)(COMPLEX *result, DARGS(_lt_Fc_)); extern memindex FORTRAN(dget)(DARGS(_lt_Fr_)); extern memindex FORTRAN(dgetc)(DARGS(_lt_Fc_)); extern void FORTRAN(e0sub)(COMPLEX *result, EARGS(_lt_Fr_)); extern void FORTRAN(e0subc)(COMPLEX *result, EARGS(_lt_Fc_)); extern memindex FORTRAN(eget)(EARGS(_lt_Fr_)); extern memindex FORTRAN(egetc)(EARGS(_lt_Fc_)); extern void FORTRAN(li2sub)(COMPLEX *result, XARGS(_lt_Fr_)); extern void FORTRAN(li2csub)(COMPLEX *result, XARGS(_lt_Fc_)); extern void FORTRAN(li2omxsub)(COMPLEX *result, XARGS(_lt_Fr_)); extern void FORTRAN(li2omxcsub)(COMPLEX *result, XARGS(_lt_Fc_)); extern void FORTRAN(ltini)(void); extern void FORTRAN(ltexi)(void); extern void FORTRAN(clearcache)(void); extern void FORTRAN(markcache)(void); extern void FORTRAN(restorecache)(void); #define CACHEPTR(n,i) &FORTRAN(ltvars).cache[n][i] extern struct { /* MUST match common block ltvars in lt.h! */ COMPLEX cache[8][2]; COMPLEX savedptr[8]; REAL maxdev; INTEGER warndigits, errdigits; INTEGER serial, versionkey; INTEGER debugkey, debugfrom, debugto; } FORTRAN(ltvars); extern struct { /* MUST match common block ltcache in lt.h! */ INTEGER cmpbits; } FORTRAN(ltcache); extern struct { /* MUST match common block ltregul in ff.h! */ REAL mudim, im_mudim, delta, lambda, minmass; } FORTRAN(ltregul); #ifdef __cplusplus } #endif /****************************************************************/ static inline ComplexType A0(AARGS(_lt_Cr_)) { _lt_Frd_(AARGS); COMPLEX result; FORTRAN(a0sub)(&result, AARGS(_lt_Frp_)); return ToComplex(result); } static inline ComplexType A0C(AARGS(_lt_Cc_)) { _lt_Fcd_(AARGS); COMPLEX result; FORTRAN(a0subc)(&result, AARGS(_lt_Fcp_)); return ToComplex(result); } static inline ComplexType A00(AARGS(_lt_Cr_)) { _lt_Frd_(AARGS); COMPLEX result; FORTRAN(a00sub)(&result, AARGS(_lt_Frp_)); return ToComplex(result); } static inline ComplexType A00C(AARGS(_lt_Cc_)) { _lt_Fcd_(AARGS); COMPLEX result; FORTRAN(a00subc)(&result, AARGS(_lt_Fcp_)); return ToComplex(result); } /****************************************************************/ static inline memindex Bget(BARGS(_lt_Cr_)) { _lt_Frd_(BARGS); return FORTRAN(bget)(BARGS(_lt_Frp_)); } static inline memindex BgetC(BARGS(_lt_Cc_)) { _lt_Fcd_(BARGS); return FORTRAN(bgetc)(BARGS(_lt_Fcp_)); } static inline COMPLEX *Bcache(const memindex integral) { return CACHEPTR(0,integral); } static inline COMPLEX *BcacheC(const memindex integral) { return CACHEPTR(1,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(i, Bget(BARGS(_lt_Id_))); } static inline ComplexType B0iC(const int i, BARGS(_lt_Cc_)) { return BvalC(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_)); } /****************************************************************/ static inline ComplexType C0(CARGS(_lt_Cr_)) { _lt_Frd_(CARGS); COMPLEX result; FORTRAN(c0sub)(&result, CARGS(_lt_Frp_)); return ToComplex(result); } static inline ComplexType C0C(CARGS(_lt_Cc_)) { _lt_Fcd_(CARGS); COMPLEX result; FORTRAN(c0subc)(&result, CARGS(_lt_Fcp_)); return ToComplex(result); } static inline memindex Cget(CARGS(_lt_Cr_)) { _lt_Frd_(CARGS); return FORTRAN(cget)(CARGS(_lt_Frp_)); } static inline memindex CgetC(CARGS(_lt_Cc_)) { _lt_Fcd_(CARGS); return FORTRAN(cgetc)(CARGS(_lt_Fcp_)); } static inline COMPLEX *Ccache(const memindex integral) { return CACHEPTR(2,integral); } static inline COMPLEX *CcacheC(const memindex integral) { return CACHEPTR(3,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(i, Cget(CARGS(_lt_Id_))); } static inline ComplexType C0iC(const int i, CARGS(_lt_Cc_)) { return CvalC(i, CgetC(CARGS(_lt_Id_))); } /****************************************************************/ static inline ComplexType D0(DARGS(_lt_Cr_)) { _lt_Frd_(DARGS); COMPLEX result; FORTRAN(d0sub)(&result, DARGS(_lt_Frp_)); return ToComplex(result); } static inline ComplexType D0C(DARGS(_lt_Cc_)) { _lt_Fcd_(DARGS); COMPLEX result; FORTRAN(d0subc)(&result, DARGS(_lt_Fcp_)); return ToComplex(result); } static inline memindex Dget(DARGS(_lt_Cr_)) { _lt_Frd_(DARGS); return FORTRAN(dget)(DARGS(_lt_Frp_)); } static inline memindex DgetC(DARGS(_lt_Cc_)) { _lt_Fcd_(DARGS); return FORTRAN(dgetc)(DARGS(_lt_Fcp_)); } static inline COMPLEX *Dcache(const memindex integral) { return CACHEPTR(4,integral); } static inline COMPLEX *DcacheC(const memindex integral) { return CACHEPTR(5,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(i, Dget(DARGS(_lt_Id_))); } static inline ComplexType D0iC(const int i, DARGS(_lt_Cc_)) { return DvalC(i, DgetC(DARGS(_lt_Id_))); } /****************************************************************/ static inline ComplexType E0(EARGS(_lt_Cr_)) { _lt_Frd_(EARGS); COMPLEX result; FORTRAN(e0sub)(&result, EARGS(_lt_Frp_)); return ToComplex(result); } static inline ComplexType E0C(EARGS(_lt_Cc_)) { _lt_Fcd_(EARGS); COMPLEX result; FORTRAN(e0subc)(&result, EARGS(_lt_Fcp_)); return ToComplex(result); } static inline memindex Eget(EARGS(_lt_Cr_)) { _lt_Frd_(EARGS); return FORTRAN(eget)(EARGS(_lt_Frp_)); } static inline memindex EgetC(EARGS(_lt_Cc_)) { _lt_Fcd_(EARGS); return FORTRAN(egetc)(EARGS(_lt_Fcp_)); } static inline COMPLEX *Ecache(const memindex integral) { return CACHEPTR(6,integral); } static inline COMPLEX *EcacheC(const memindex integral) { return CACHEPTR(7,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(i, Eget(EARGS(_lt_Id_))); } static inline ComplexType E0iC(const int i, EARGS(_lt_Cc_)) { return EvalC(i, EgetC(EARGS(_lt_Id_))); } /****************************************************************/ static inline ComplexType Li2(XARGS(_lt_Cr_)) { _lt_Frd_(XARGS); COMPLEX result; FORTRAN(li2sub)(&result, XARGS(_lt_Frp_)); return ToComplex(result); } static inline ComplexType Li2C(XARGS(_lt_Cc_)) { _lt_Fcd_(XARGS); COMPLEX result; FORTRAN(li2csub)(&result, XARGS(_lt_Fcp_)); return ToComplex(result); } static inline ComplexType Li2omx(XARGS(_lt_Cr_)) { _lt_Frd_(XARGS); COMPLEX result; FORTRAN(li2sub)(&result, XARGS(_lt_Frp_)); return ToComplex(result); } static inline ComplexType Li2omxC(XARGS(_lt_Cc_)) { _lt_Fcd_(XARGS); COMPLEX result; FORTRAN(li2csub)(&result, XARGS(_lt_Fcp_)); return ToComplex(result); } /****************************************************************/ #define clearcache FORTRAN(clearcache) #define markcache FORTRAN(markcache) #define restorecache FORTRAN(restorecache) #define ltini FORTRAN(ltini) #define ltexi FORTRAN(ltexi) static inline void setmudim(cRealType mudim) { FORTRAN(ltregul).mudim = ToREAL(mudim); clearcache(); } static inline RealType getmudim() { return ToReal(FORTRAN(ltregul).mudim); } static inline void setdelta(cRealType delta) { FORTRAN(ltregul).delta = ToREAL(delta); clearcache(); } static inline RealType getdelta() { return ToReal(FORTRAN(ltregul).delta); } static inline void setlambda(cRealType lambda) { FORTRAN(ltregul).lambda = ToREAL(lambda); clearcache(); } static inline RealType getlambda() { return ToReal(FORTRAN(ltregul).lambda); } static inline void setminmass(cRealType minmass) { FORTRAN(ltregul).minmass = ToREAL(minmass); clearcache(); } static inline RealType getminmass() { return ToReal(FORTRAN(ltregul).minmass); } static inline void setmaxdev(cRealType maxdev) { FORTRAN(ltvars).maxdev = ToREAL(maxdev); } static inline RealType getmaxdev() { return ToReal(FORTRAN(ltvars).maxdev); } static inline void setwarndigits(const int warndigits) { FORTRAN(ltvars).warndigits = warndigits; } static inline int getwarndigits() { return FORTRAN(ltvars).warndigits; } static inline void seterrdigits(const int errdigits) { FORTRAN(ltvars).errdigits = errdigits; } static inline int geterrdigits() { return FORTRAN(ltvars).errdigits; } static inline void setversionkey(const int versionkey) { FORTRAN(ltvars).versionkey = versionkey; clearcache(); } static inline int getversionkey() { return FORTRAN(ltvars).versionkey; } static inline void setdebugkey(const int debugkey) { FORTRAN(ltvars).debugkey = debugkey; } static inline int getdebugkey() { return FORTRAN(ltvars).debugkey; } static inline void setdebugrange(const int debugfrom, const int debugto) { FORTRAN(ltvars).debugfrom = debugfrom; FORTRAN(ltvars).debugto = debugto; } static inline void setcmpbits(const int cmpbits) { FORTRAN(ltcache).cmpbits = cmpbits; } static inline int getcmpbits() { return FORTRAN(ltcache).cmpbits; } #endif looptools-2.8.orig/src/include/looptools.h0000644000175000017500000001277412025551446021672 0ustar sylvestresylvestre* looptools.h * the header file for Fortran with all definitions for LoopTools * this file is part of LoopTools * last modified 17 Sep 12 th #ifndef LOOPTOOLS_H #define LOOPTOOLS_H #define bb0 1 #define bb1 2 #define bb00 3 #define bb11 4 #define bb001 5 #define bb111 6 #define dbb0 7 #define dbb1 8 #define dbb00 9 #define dbb11 10 #define Nbb 10 #define cc0 1 #define cc1 2 #define cc2 3 #define cc00 4 #define cc11 5 #define cc12 6 #define cc22 7 #define cc001 8 #define cc002 9 #define cc111 10 #define cc112 11 #define cc122 12 #define cc222 13 #define cc0000 14 #define cc0011 15 #define cc0012 16 #define cc0022 17 #define cc1111 18 #define cc1112 19 #define cc1122 20 #define cc1222 21 #define cc2222 22 #define Ncc 22 #define dd0 1 #define dd1 2 #define dd2 3 #define dd3 4 #define dd00 5 #define dd11 6 #define dd12 7 #define dd13 8 #define dd22 9 #define dd23 10 #define dd33 11 #define dd001 12 #define dd002 13 #define dd003 14 #define dd111 15 #define dd112 16 #define dd113 17 #define dd122 18 #define dd123 19 #define dd133 20 #define dd222 21 #define dd223 22 #define dd233 23 #define dd333 24 #define dd0000 25 #define dd0011 26 #define dd0012 27 #define dd0013 28 #define dd0022 29 #define dd0023 30 #define dd0033 31 #define dd1111 32 #define dd1112 33 #define dd1113 34 #define dd1122 35 #define dd1123 36 #define dd1133 37 #define dd1222 38 #define dd1223 39 #define dd1233 40 #define dd1333 41 #define dd2222 42 #define dd2223 43 #define dd2233 44 #define dd2333 45 #define dd3333 46 #define dd00001 47 #define dd00002 48 #define dd00003 49 #define dd00111 50 #define dd00112 51 #define dd00113 52 #define dd00122 53 #define dd00123 54 #define dd00133 55 #define dd00222 56 #define dd00223 57 #define dd00233 58 #define dd00333 59 #define dd11111 60 #define dd11112 61 #define dd11113 62 #define dd11122 63 #define dd11123 64 #define dd11133 65 #define dd11222 66 #define dd11223 67 #define dd11233 68 #define dd11333 69 #define dd12222 70 #define dd12223 71 #define dd12233 72 #define dd12333 73 #define dd13333 74 #define dd22222 75 #define dd22223 76 #define dd22233 77 #define dd22333 78 #define dd23333 79 #define dd33333 80 #define Ndd 80 #define ee0 1 #define ee1 2 #define ee2 3 #define ee3 4 #define ee4 5 #define ee00 6 #define ee11 7 #define ee12 8 #define ee13 9 #define ee14 10 #define ee22 11 #define ee23 12 #define ee24 13 #define ee33 14 #define ee34 15 #define ee44 16 #define ee001 17 #define ee002 18 #define ee003 19 #define ee004 20 #define ee111 21 #define ee112 22 #define ee113 23 #define ee114 24 #define ee122 25 #define ee123 26 #define ee124 27 #define ee133 28 #define ee134 29 #define ee144 30 #define ee222 31 #define ee223 32 #define ee224 33 #define ee233 34 #define ee234 35 #define ee244 36 #define ee333 37 #define ee334 38 #define ee344 39 #define ee444 40 #define ee0000 41 #define ee0011 42 #define ee0012 43 #define ee0013 44 #define ee0014 45 #define ee0022 46 #define ee0023 47 #define ee0024 48 #define ee0033 49 #define ee0034 50 #define ee0044 51 #define ee1111 52 #define ee1112 53 #define ee1113 54 #define ee1114 55 #define ee1122 56 #define ee1123 57 #define ee1124 58 #define ee1133 59 #define ee1134 60 #define ee1144 61 #define ee1222 62 #define ee1223 63 #define ee1224 64 #define ee1233 65 #define ee1234 66 #define ee1244 67 #define ee1333 68 #define ee1334 69 #define ee1344 70 #define ee1444 71 #define ee2222 72 #define ee2223 73 #define ee2224 74 #define ee2233 75 #define ee2234 76 #define ee2244 77 #define ee2333 78 #define ee2334 79 #define ee2344 80 #define ee2444 81 #define ee3333 82 #define ee3334 83 #define ee3344 84 #define ee3444 85 #define ee4444 86 #define Nee 86 #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 DebugB 2**0 #define DebugC 2**1 #define DebugD 2**2 #define DebugE 2**3 #define DebugAll 15 #define memindex integer*8 #ifndef ComplexType #define ComplexType double complex #endif #ifndef RealType #define RealType double precision #endif #define Bval(id,p) cache(p+id,1) #define BvalC(id,p) cache(p+id,2) #define Cval(id,p) cache(p+id,3) #define CvalC(id,p) cache(p+id,4) #define Dval(id,p) cache(p+id,5) #define DvalC(id,p) cache(p+id,6) #define Eval(id,p) cache(p+id,7) #define EvalC(id,p) cache(p+id,8) #define Ccache 0 #define Dcache 0 #endif integer ncaches parameter (ncaches = 8) ComplexType cache(2,ncaches) common /ltvars/ cache 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 ComplexType DB0C, DB1C, DB00C, DB11C ComplexType C0, C0C, C0i, C0iC ComplexType D0, D0C, D0i, D0iC ComplexType E0, E0C, E0i, E0iC ComplexType Li2, Li2C, Li2omx, Li2omxC memindex Bget, BgetC, Cget, CgetC, Dget, DgetC, Eget, EgetC RealType getmudim, getdelta, getlambda, getminmass RealType getmaxdev integer 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 external DB0C, DB1C, DB00C, DB11C external C0, C0C, C0i, C0iC external D0, D0C, D0i, D0iC external E0, E0C, E0i, E0iC external Li2, Li2C, Li2omx, Li2omxC external Bget, BgetC, Cget, CgetC, Dget, DgetC, Eget, EgetC external getmudim, getdelta, getlambda, getminmass external getmaxdev external getwarndigits, geterrdigits external getversionkey, getdebugkey external getcachelast looptools-2.8.orig/src/include/defs.h0000644000175000017500000001610112026271532020541 0ustar sylvestresylvestre* defs.h * internal definitions for the LoopTools routines * this file is part of LoopTools * last modified 19 Sep 12 th #ifdef COMPLEXPARA #define XA0 A0C #define XA0b A0bC #define XA0sub a0subc #define XA00 A00C #define XA00sub a00subc #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 XB0i B0iC #define XBget BgetC #define XBput BputC #define XBcoeff BcoeffC #define XBcoeffFF BcoeffFFC #define XC0 C0C #define XC0para C0Cpara #define XC0i C0iC #define XCget CgetC #define XCput CputC #define XCcoeff CcoeffC #define XD0 D0C #define XD0para D0Cpara #define XD0i D0iC #define XDget DgetC #define XDput DputC #define XDcoeff DcoeffC #define XE0 E0C #define XE0sub e0subc #define XE0para E0Cpara #define XE0i E0iC #define XEget EgetC #define XEput EputC #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 #define RC 2 #define DVAR ComplexType #define QVAR ComplexType #define QREAL RealType #define QPREC(x) x #define QCC(x) Conjugate(x) #define QRE(x) Re(x) #else #define XA0 A0 #define XA0b A0b #define XA0sub a0sub #define XA00 A00 #define XA00sub a00sub #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 XB0i B0i #define XBget Bget #define XBput Bput #define XBcoeff Bcoeff #define XBcoeffFF BcoeffFF #define XC0 C0 #define XC0para C0para #define XC0i C0i #define XCget Cget #define XCput Cput #define XCcoeff Ccoeff #define XD0 D0 #define XD0para D0para #define XD0i D0i #define XDget Dget #define XDput Dput #define XDcoeff Dcoeff #define XE0 E0 #define XE0sub e0sub #define XE0para E0para #define XE0i E0i #define XEget Eget #define XEput Eput #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 #define RC 1 #define DVAR RealType #if QUAD #define QVAR real*16 #define QPREC(x) QEXT(x) #else #define QVAR RealType #define QPREC(x) x #endif #define QREAL QVAR #define QCC(x) x #define QRE(x) x #endif #define bb0 1 #define bb1 2 #define bb00 3 #define bb11 4 #define bb001 5 #define bb111 6 #define dbb0 7 #define dbb1 8 #define dbb00 9 #define dbb11 10 #define Pbb 3 #define Nbb 10 #define cc0 1 #define cc1 2 #define cc2 3 #define cc00 4 #define cc11 5 #define cc12 6 #define cc22 7 #define cc001 8 #define cc002 9 #define cc111 10 #define cc112 11 #define cc122 12 #define cc222 13 #define cc0000 14 #define cc0011 15 #define cc0012 16 #define cc0022 17 #define cc1111 18 #define cc1112 19 #define cc1122 20 #define cc1222 21 #define cc2222 22 #define Pcc 6 #define Ncc 22 #define dd0 1 #define dd1 2 #define dd2 3 #define dd3 4 #define dd00 5 #define dd11 6 #define dd12 7 #define dd13 8 #define dd22 9 #define dd23 10 #define dd33 11 #define dd001 12 #define dd002 13 #define dd003 14 #define dd111 15 #define dd112 16 #define dd113 17 #define dd122 18 #define dd123 19 #define dd133 20 #define dd222 21 #define dd223 22 #define dd233 23 #define dd333 24 #define dd0000 25 #define dd0011 26 #define dd0012 27 #define dd0013 28 #define dd0022 29 #define dd0023 30 #define dd0033 31 #define dd1111 32 #define dd1112 33 #define dd1113 34 #define dd1122 35 #define dd1123 36 #define dd1133 37 #define dd1222 38 #define dd1223 39 #define dd1233 40 #define dd1333 41 #define dd2222 42 #define dd2223 43 #define dd2233 44 #define dd2333 45 #define dd3333 46 #define dd00001 47 #define dd00002 48 #define dd00003 49 #define dd00111 50 #define dd00112 51 #define dd00113 52 #define dd00122 53 #define dd00123 54 #define dd00133 55 #define dd00222 56 #define dd00223 57 #define dd00233 58 #define dd00333 59 #define dd11111 60 #define dd11112 61 #define dd11113 62 #define dd11122 63 #define dd11123 64 #define dd11133 65 #define dd11222 66 #define dd11223 67 #define dd11233 68 #define dd11333 69 #define dd12222 70 #define dd12223 71 #define dd12233 72 #define dd12333 73 #define dd13333 74 #define dd22222 75 #define dd22223 76 #define dd22233 77 #define dd22333 78 #define dd23333 79 #define dd33333 80 #define Pdd 10 #define Ndd 80 #define ee0 1 #define ee1 2 #define ee2 3 #define ee3 4 #define ee4 5 #define ee00 6 #define ee11 7 #define ee12 8 #define ee13 9 #define ee14 10 #define ee22 11 #define ee23 12 #define ee24 13 #define ee33 14 #define ee34 15 #define ee44 16 #define ee001 17 #define ee002 18 #define ee003 19 #define ee004 20 #define ee111 21 #define ee112 22 #define ee113 23 #define ee114 24 #define ee122 25 #define ee123 26 #define ee124 27 #define ee133 28 #define ee134 29 #define ee144 30 #define ee222 31 #define ee223 32 #define ee224 33 #define ee233 34 #define ee234 35 #define ee244 36 #define ee333 37 #define ee334 38 #define ee344 39 #define ee444 40 #define ee0000 41 #define ee0011 42 #define ee0012 43 #define ee0013 44 #define ee0014 45 #define ee0022 46 #define ee0023 47 #define ee0024 48 #define ee0033 49 #define ee0034 50 #define ee0044 51 #define ee1111 52 #define ee1112 53 #define ee1113 54 #define ee1114 55 #define ee1122 56 #define ee1123 57 #define ee1124 58 #define ee1133 59 #define ee1134 60 #define ee1144 61 #define ee1222 62 #define ee1223 63 #define ee1224 64 #define ee1233 65 #define ee1234 66 #define ee1244 67 #define ee1333 68 #define ee1334 69 #define ee1344 70 #define ee1444 71 #define ee2222 72 #define ee2223 73 #define ee2224 74 #define ee2233 75 #define ee2234 76 #define ee2244 77 #define ee2333 78 #define ee2334 79 #define ee2344 80 #define ee2444 81 #define ee3333 82 #define ee3334 83 #define ee3344 84 #define ee3444 85 #define ee4444 86 #define Pee 15 #define Nee 86 #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 DebugB 0 #define DebugC 1 #define DebugD 2 #define DebugE 3 #define memindex integer*8 #define Bval(id,p) cache(p+id,RC) #define Cval(id,p) cache(p+id,RC+2) #define Dval(id,p) cache(p+id,RC+4) #define Eval(id,p) cache(p+id,RC+6) #define Nval(n,id,p) cache(p+id,RC+2*n-4) #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 #ifndef KIND #define KIND 1 #endif *#define WARNINGS looptools-2.8.orig/src/include/externals.h0000644000175000017500000001547312026275141021640 0ustar sylvestresylvestre#if 0 This file was generated by mkexternalsh on Wed Sep 19 09:55:13 CEST 2012. Do not edit. #endif #define A0b ljA0b #define A0bC ljA0bC #define Bcheck ljBcheck #define Bcoeff ljBcoeff #define BcoeffAD ljBcoeffAD #define BcoeffC ljBcoeffC #define BcoeffFF ljBcoeffFF #define BcoeffFFC ljBcoeffFFC #define C0Cpara ljC0Cpara #define C0coll ljC0coll #define C0collDR ljC0collDR #define C0p0 ljC0p0 #define C0p1 ljC0p1 #define C0p2 ljC0p2 #define C0p3 ljC0p3 #define C0para ljC0para #define C0soft ljC0soft #define C0softDR ljC0softDR #define CDispatch ljCDispatch #define CDump ljCDump #define Ccoeff ljCcoeff #define CcoeffC ljCcoeffC #define D0Ccoll ljD0Ccoll #define D0CcollDR ljD0CcollDR #define D0Cm1p2 ljD0Cm1p2 #define D0Cm1p3 ljD0Cm1p3 #define D0Cm2p3 ljD0Cm2p3 #define D0Cpara ljD0Cpara #define D0Csoft ljD0Csoft #define D0CsoftDR ljD0CsoftDR #define D0coll ljD0coll #define D0collDR ljD0collDR #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 D0para ljD0para #define D0soft ljD0soft #define D0softDR ljD0softDR #define DCDispatch ljDCDispatch #define DCDump ljDCDump #define DDispatch ljDDispatch #define DDump ljDDump #define Dcoeff ljDcoeff #define DcoeffC ljDcoeffC #define Decomp ljDecomp #define DecompC ljDecompC #define Detm ljDetm #define DetmC ljDetmC #define DumpCoeff ljDumpCoeff #define DumpCoeffC ljDumpCoeffC #define DumpPara ljDumpPara #define DumpParaC ljDumpParaC #define E0Cpara ljE0Cpara #define E0para ljE0para #define E0parab ljE0parab #define Echeck ljEcheck #define EcheckC ljEcheckC #define Ecoeff ljEcoeff #define EcoeffC ljEcoeffC #define Ecoeffa ljEcoeffa #define EcoeffaC ljEcoeffaC #define Ecoeffb ljEcoeffb #define EcoeffbC ljEcoeffbC #define InvGramE ljInvGramE #define InvGramEC ljInvGramEC #define Inverse ljInverse #define InverseC ljInverseC #define LTNameData ljLTNameData #define Li2omrat ljLi2omrat #define Li2omrat2 ljLi2omrat2 #define Li2omx2 ljLi2omx2 #define Li2omx3 ljLi2omx3 #define Li2rat ljLi2rat #define Li2series ljLi2series #define RSolve ljRSolve #define Solve ljSolve #define SolveC ljSolveC #define bdK ljbdK #define bdKC ljbdKC #define cLi2omrat ljcLi2omrat #define cLi2omrat2 ljcLi2omrat2 #define cachecopy ljcachecopy #define cacheindex ljcacheindex #define cspence ljcspence #define dfflo1 ljdfflo1 #define dfflo2 ljdfflo2 #define dfflo3 ljdfflo3 #define eta ljeta #define etatilde ljetatilde #define ff2d22 ljff2d22 #define ff2dl2 ljff2dl2 #define ff3dl2 ljff3dl2 #define ffRn ljffRn #define ffS2 ljffS2 #define ffS2_linr ljffS2_linr #define ffS3n ljffS3n #define ffT13 ljffT13 #define ffT_lin ljffT_lin #define ffTn ljffTn #define ffabcd ljffabcd #define ffai ljffai #define ffbglg ljffbglg #define ffbnd ljffbnd #define ffbndc ljffbndc #define ffc1lg ljffc1lg #define ffca0 ljffca0 #define ffcayl ljffcayl #define ffcb0 ljffcb0 #define ffcb0p ljffcb0p #define ffcb1 ljffcb1 #define ffcb1a ljffcb1a #define ffcb2p ljffcb2p #define ffcb2q ljffcb2q #define ffcc0 ljffcc0 #define ffcc0a ljffcc0a #define ffcc0b ljffcc0b #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 ffcxr ljffcxr #define ffcxra ljffcxra #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 ffdel ljffdel #define ffdel2 ljffdel2 #define ffdel3 ljffdel3 #define ffdel4 ljffdel4 #define ffdel5 ljffdel5 #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 ffdot ljffdot #define ffdot2 ljffdot2 #define ffdot3 ljffdot3 #define ffdot4 ljffdot4 #define ffdot5 ljffdot5 #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 ffroot ljffroot #define ffroots ljffroots #define ffrot3 ljffrot3 #define ffrot4 ljffrot4 #define ffrota ljffrota #define ffrt3p ljffrt3p #define ffset ljffset #define ffsign ljffsign #define ffsm43 ljffsm43 #define ffsmug ljffsmug #define fftayl ljfftayl #define ffthf ljffthf #define ffthre ljffthre #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 ffxb1 ljffxb1 #define ffxb111 ljffxb111 #define ffxb1a ljffxb1a #define ffxb2p ljffxb2p #define ffxb2q ljffxb2q #define ffxc0 ljffxc0 #define ffxc0a ljffxc0a #define ffxc0b ljffxc0b #define ffxc0i ljffxc0i #define ffxc0j ljffxc0j #define ffxc0p ljffxc0p #define ffxc0p0 ljffxc0p0 #define ffxc0r ljffxc0r #define ffxclg ljffxclg #define ffxd0 ljffxd0 #define ffxd0a ljffxd0a #define ffxd0b ljffxd0b #define ffxd0d ljffxd0d #define ffxd0e ljffxd0e #define ffxd0m0 ljffxd0m0 #define ffxd0p ljffxd0p #define ffxd0r ljffxd0r #define ffxdb0 ljffxdb0 #define ffxdb1 ljffxdb1 #define ffxdb11 ljffxdb11 #define ffxdbd ljffxdbd #define ffxdbp ljffxdbp #define ffxdir ljffxdir #define ffxe0 ljffxe0 #define ffxe00 ljffxe00 #define ffxe0a ljffxe0a #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 lndiv0 ljlndiv0 #define lndiv1 ljlndiv1 #define ltcoeffnames ljltcoeffnames #define ltparanames ljltparanames #define nffet1 ljnffet1 #define nffeta ljnffeta #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.8.orig/src/include/looptools-alt.h0000644000175000017500000001271411776502523022446 0ustar sylvestresylvestre* looptools.h * the header file for Fortran with all definitions for LoopTools * this file is part of LoopTools * last modified 31 Mar 11 th #ifndef LOOPTOOLS_H #define LOOPTOOLS_H #define bb0 1 #define bb1 2 #define bb00 3 #define bb11 4 #define bb001 5 #define bb111 6 #define dbb0 7 #define dbb1 8 #define dbb00 9 #define dbb11 10 #define cc0 1 #define cc1 2 #define cc2 3 #define cc00 4 #define cc11 5 #define cc12 6 #define cc22 7 #define cc001 8 #define cc002 9 #define cc111 10 #define cc112 11 #define cc122 12 #define cc222 13 #define cc0000 14 #define cc0011 15 #define cc0012 16 #define cc0022 17 #define cc1111 18 #define cc1112 19 #define cc1122 20 #define cc1222 21 #define cc2222 22 #define dd0 1 #define dd1 2 #define dd2 3 #define dd3 4 #define dd00 5 #define dd11 6 #define dd12 7 #define dd13 8 #define dd22 9 #define dd23 10 #define dd33 11 #define dd001 12 #define dd002 13 #define dd003 14 #define dd111 15 #define dd112 16 #define dd113 17 #define dd122 18 #define dd123 19 #define dd133 20 #define dd222 21 #define dd223 22 #define dd233 23 #define dd333 24 #define dd0000 25 #define dd0011 26 #define dd0012 27 #define dd0013 28 #define dd0022 29 #define dd0023 30 #define dd0033 31 #define dd1111 32 #define dd1112 33 #define dd1113 34 #define dd1122 35 #define dd1123 36 #define dd1133 37 #define dd1222 38 #define dd1223 39 #define dd1233 40 #define dd1333 41 #define dd2222 42 #define dd2223 43 #define dd2233 44 #define dd2333 45 #define dd3333 46 #define dd00001 47 #define dd00002 48 #define dd00003 49 #define dd00111 50 #define dd00112 51 #define dd00113 52 #define dd00122 53 #define dd00123 54 #define dd00133 55 #define dd00222 56 #define dd00223 57 #define dd00233 58 #define dd00333 59 #define dd11111 60 #define dd11112 61 #define dd11113 62 #define dd11122 63 #define dd11123 64 #define dd11133 65 #define dd11222 66 #define dd11223 67 #define dd11233 68 #define dd11333 69 #define dd12222 70 #define dd12223 71 #define dd12233 72 #define dd12333 73 #define dd13333 74 #define dd22222 75 #define dd22223 76 #define dd22233 77 #define dd22333 78 #define dd23333 79 #define dd33333 80 #define ee0 1 #define ee1 2 #define ee2 3 #define ee3 4 #define ee4 5 #define ee00 6 #define ee11 7 #define ee12 8 #define ee13 9 #define ee14 10 #define ee22 11 #define ee23 12 #define ee24 13 #define ee33 14 #define ee34 15 #define ee44 16 #define ee001 17 #define ee002 18 #define ee003 19 #define ee004 20 #define ee111 21 #define ee112 22 #define ee113 23 #define ee114 24 #define ee122 25 #define ee123 26 #define ee124 27 #define ee133 28 #define ee134 29 #define ee144 30 #define ee222 31 #define ee223 32 #define ee224 33 #define ee233 34 #define ee234 35 #define ee244 36 #define ee333 37 #define ee334 38 #define ee344 39 #define ee444 40 #define ee0000 41 #define ee0011 42 #define ee0012 43 #define ee0013 44 #define ee0014 45 #define ee0022 46 #define ee0023 47 #define ee0024 48 #define ee0033 49 #define ee0034 50 #define ee0044 51 #define ee1111 52 #define ee1112 53 #define ee1113 54 #define ee1114 55 #define ee1122 56 #define ee1123 57 #define ee1124 58 #define ee1133 59 #define ee1134 60 #define ee1144 61 #define ee1222 62 #define ee1223 63 #define ee1224 64 #define ee1233 65 #define ee1234 66 #define ee1244 67 #define ee1333 68 #define ee1334 69 #define ee1344 70 #define ee1444 71 #define ee2222 72 #define ee2223 73 #define ee2224 74 #define ee2233 75 #define ee2234 76 #define ee2244 77 #define ee2333 78 #define ee2334 79 #define ee2344 80 #define ee2444 81 #define ee3333 82 #define ee3334 83 #define ee3344 84 #define ee3444 85 #define ee4444 86 #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 DebugB 2**0 #define DebugC 2**1 #define DebugD 2**2 #define DebugE 2**3 #define DebugAll 15 #define memindex integer*8 #define Ccache 0 #define Dcache 0 #endif integer ncaches parameter (ncaches = 8) ComplexType cache(2,ncaches) common /ltvars/ cache 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), Bval) equivalence (cache(2,2), BvalC) equivalence (cache(2,3), Cval) equivalence (cache(2,4), CvalC) equivalence (cache(2,5), Dval) equivalence (cache(2,6), DvalC) equivalence (cache(2,7), Eval) equivalence (cache(2,8), 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 ComplexType DB0C, DB1C, DB00C, DB11C ComplexType C0, C0C, C0i, C0iC ComplexType D0, D0C, D0i, D0iC ComplexType E0, E0C, E0i, E0iC ComplexType Li2, Li2C, Li2omx, Li2omxC memindex Bget, BgetC, Cget, CgetC, Dget, DgetC, Eget, EgetC RealType getmudim, getdelta, getlambda, getminmass RealType getmaxdev integer 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 external DB0C, DB1C, DB00C, DB11C external C0, C0C, C0i, C0iC external D0, D0C, D0i, D0iC external E0, E0C, E0i, E0iC external Li2, Li2C, Li2omx, Li2omxC external Bget, BgetC, Cget, CgetC, Dget, DgetC, Eget, EgetC external getmudim, getdelta, getlambda, getminmass external getmaxdev external getwarndigits, geterrdigits external getversionkey, getdebugkey external getcachelast looptools-2.8.orig/src/tools/0000755000175000017500000000000011612302326017161 5ustar sylvestresylvestrelooptools-2.8.orig/src/tools/mkexternalsh0000755000175000017500000000563312023560446021631 0ustar sylvestresylvestre#! /bin/sh # 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 11 Sep 12 th base=`dirname $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 !~ /^_*(\ a00c|a00|a00subc|a00sub|a0c|a0|a0subc|a0sub|\ b001c|b001|b00c|b00|b0c|b0ic|b0i|b0|b111c|b111|b11c|b11|b1c|b1|\ bgetc|bget|bputc|bput|\ db00c|db00|db0c|db0|db11c|db11|db1c|db1|\ c0c|c0ic|c0i|c0|c0subc|c0sub|cgetc|cget|cputc|cput|\ d0c|d0ic|d0i|d0|d0subc|d0sub|dgetc|dget|dputc|dput|\ e0c|e0ic|e0i|e0|e0subc|e0sub|egetc|eget|eputc|eput|\ li2c|li2csub|li2|li2sub|li2omxc|li2omxcsub|li2omx|li2omxsub|\ ltini|ltexi|ltcache|ltvars|ltregul|\ clearcache|markcache|restorecache|getcachelast|setcachelast|\ getcmpbits|getdebugkey|getdelta|geterrdigits|getlambda|\ getmaxdev|getminmass|getmudim|getversionkey|getwarndigits|\ setcmpbits|setdebugkey|setdebugrange|setdelta|seterrdigits|setlambda|\ setmaxdev|setminmass|setmudim|setversionkey|setwarndigits)_$/ { sub("^_", "", $3); sub("^" PREFIX, "", $3); sub("_*$", "", $3); print file " " $3; } ' PREFIX="$prefix"` fdefs="" cdefs="" c_defs="" test -f $ext && mv -f $ext $ext.old touch $ext test -f $cext && mv -f $cext $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="$c_defs #define ${sym}_ $prefix${sym}_" cdefs="$cdefs #define $sym $prefix$sym" fdefs="$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="$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 `basename $0` on `date`. Do not edit. #endif `echo "$fdefs" | sort -u` _EOF_ cat > $cext << _EOF_ #if 0 This file was generated by `basename $0` on `date`. Do not edit. #endif #if NOUNDERSCORE `echo "$cdefs" | sort -u` #else `echo "$c_defs" | sort -u` #endif _EOF_ looptools-2.8.orig/src/tools/f77290.c0000644000175000017500000002561110331617045020174 0ustar sylvestresylvestre/* f77290.c a f77 (fixed format) -> f90 (free format) converter; if QPRECISION is defined, also converts double prec to quad prec (using the conventions of qcomplex.f90) Sept 97, last modified 1 Nov 05 th */ #define QPRECISION #define MAXLINELENGTH 82 #include #include #include #include #include #define upper(a) &a[sizeof(a)/sizeof(char *)] const char *ops[] = { ".eq.", "==", ".ne.", "/=", ".le.", "<=", ".ge.", ">=", ".lt.", "<", ".gt.", ">" }; const char *types[] = { #ifdef QPRECISION "type(complex32)", #else "double complex", #endif "double precision", "integer", "real", "character", "complex", "logical" }; const char *units[] = { "function", "subroutine", "block data", "program" }; typedef struct sourceline { struct sourceline *next; int label, indent; char s[132]; } SOURCELINE; void f90name(char *oldname) { char *p = strchr(oldname, '.'); if( p && (*(p + 1) | 0x20) == 'f' ) strcpy(p, ".f90"); else strcat(oldname, "90"); } int isnumber(const int c1, const int c2, const int c3, const int c4) { int i2 = isdigit(c2), i3 = isdigit(c3); if( i3 ) return i2 || ((c2 | 0x21) == 'e' && isdigit(c1)) || ((c2 == '+' || c2 == '-') && (c1 | 0x21) == 'e'); if( i2 ) return (c3 | 0x21) == 'e' && (c4 == '+' || c4 == '-' || isdigit(c4)); return (c2 | 0x21) == 'e' && isdigit(c1) && (c3 == '+' || c3 == '-') && isdigit(c4); } #ifdef QPRECISION void typereplace(const char *s, char *d, const char *from, const char *to) { int i; char *p, s2[200]; if( (p = strstr(s, from)) ) { i = strlen(from); strcpy(s2, p + i); strcpy(p, to); strcat(p, s2); p = d + (int)(p - s); strcpy(s2, p + i); strcpy(p, to); strcat(p, s2); } } #endif int main(int argc, char **argv) { FILE *f; char s[512], s2[512], *p, *d, *d2; char fnstack[500], *funcname[10], **fnp = funcname; char functype[50], ch; const char **pp; int lnr = 0, maxllen = MAXLINELENGTH, cont, space, i, throwout = 0; int indent = 0, defertype = 0, justif = 0, param = 0; SOURCELINE *start = NULL, *current = NULL, *new, *last = NULL; SOURCELINE *xref[300], **xrp = xref, **xxp; int gotos[150], *gp = gotos, donum[150], *dgp = donum, *ip; char *dos[150], **dp = dos, **cp; #ifdef QPRECISION int usemodule = 0; #endif if( argc < 2 ) { fprintf(stderr, "usage: %s file.f [file.f90]\n" " translates fixed-style f77 source code file.f to " "free-style f90 source code.\n" " if the file is -, stdin/stdout is used.\n", argv[0]); exit(1); } if( strcmp(argv[1], "-") == 0 ) f = stdin; else if( (f = fopen(argv[1],"r")) == NULL ) { fprintf(stderr, "%s not found\n", argv[1]); exit(2); } if( (p = getenv("MAXLINELENGTH")) ) maxllen = atoi(p); *funcname = fnstack; while( !feof(f) ) { *s = 0; ++lnr; fgets(s, sizeof(s), f); *(s + strlen(s) - 1) = 0; if( *s == 0 ) continue; p = s; cont = 0; if( strncmp(s, " ", 5) == 0 && s[5] > ' ' ) { if( throwout ) continue; p += 6; if( last ) { d = last->s + (i = strlen(last->s)); d2 = p + strspn(p, " \t"); space = strchr(",()=/", *(d - 1)) || strchr(",()=/", *d2) || (*(d - 1) >= 'A' && *(d - 1) <= 'z' && *d2 >= 'A' && *d2 <= 'z'); if( space ) *d++ = ' '; cont = 1 + (i + strlen(p) < maxllen && last == current); if( cont == 1 ) *d++ = '&'; *d = 0; } } else if( strncasecmp(p + strspn(p, " \t"), "intrinsic", 9) == 0 ) { throwout = 1; continue; } throwout = 0; if( cont < 2 ) { new = malloc(sizeof(SOURCELINE)); if( !start ) start = current = new; else { current->next = new; current = new; } current->indent = indent; d = current->s; if( *s == '\t' || cont == 1 ) current->label = 0; else { current->label = strtol(s, &d2, 10); if( d2 != s ) p = d2, *xrp++ = current; } if( cont == 1 ) { current->indent += 2; if( !space ) *d++ = '&'; } } p = (char *)memccpy(d, p + strspn(p, " \t"), 0, 256) - 2; while( p > s && (*p == ' ' || *p == '\t') ) --p; *++p = 0; if( *s == '*' || (*s | 0x20) == 'c' ) { *d = '!'; /* this is a dirty hack to cure some problems the DEC f90 compiler has with FF */ if( strstr(s, "#] declarations") ) strcpy(p, "\ncontinue"); continue; } for( p = s, d2 = d; *d2; ) *p++ = tolower(*d2++); *p = 0; if( strncmp(s, "include", 7) == 0 || strncmp(s, "#include", 8) == 0 ) { if( (p = strpbrk(d + 7, "'\"<")) && (d2 = strpbrk(++p, "'\">")) ) { ch = *d2; *d2 = 0; f90name(p); *(p += strlen(p)) = ch; *(p + 1) = 0; } } #ifdef QPRECISION if( usemodule && !cont ) { new = malloc(sizeof(SOURCELINE)); memcpy(new, current, sizeof(SOURCELINE)); current->next = new; current->label = 0; strcpy(current->s, "use qcomplex"); current = new; d = current->s; usemodule = 0; } #endif if( defertype && !cont && strncmp(s, "implicit", 8) ) { new = malloc(sizeof(SOURCELINE)); memcpy(new, current, sizeof(SOURCELINE)); current->next = new; current->label = 0; strcpy(current->s, functype); strcat(current->s, *(fnp - 1) + 9); current = new; d = current->s; param = justif = defertype = 0; } #ifdef QPRECISION typereplace(s, d, "double complex", "type(complex32)"); typereplace(s, d, "complex*16", "type(complex32)"); typereplace(s, d, "double precision", "real*16"); typereplace(s, d, "real*8", "real*16"); typereplace(s, d, "real*4", "real*16"); #endif if( *s == '#' ) continue; if( !cont ) param = justif = 0; last = current; for( pp = ops; pp < upper(ops); pp += 2 ) while( (p = strstr(s, *pp)) ) { strcpy((char *)memccpy(d + (int)(p - s), *(pp + 1), 0, 10) - 1, d + (int)(p - s + 4)); strcpy((char *)memccpy(p, *(pp + 1), 0, 10) - 1, p + 4); } for(pp = units; pp < upper(units); ++pp) if( strncmp(s, *pp, strlen(*pp)) == 0 ) { copyfname: #ifdef QPRECISION if( fnp == funcname ) usemodule = 1; #endif for( d2 = *fnp, p = d; *p && *p != '('; ) *d2++ = *p++; *d2++ = 0; *++fnp = d2; gp = gotos; dp = dos; dgp = donum; xrp = xref; goto lineok; } for( pp = types; pp < upper(types); ++pp ) if( strncmp(s, *pp, i = strlen(*pp)) == 0 ) { p = d + (i += strspn(d + i, "*0123456789() \t")); if( strncmp(s + i, "function", 8) == 0 ) { memcpy(functype, d, i); strcpy(functype + i, ":: "); strcpy(d, p); defertype = 1; goto copyfname; } strcpy(s2, p); strcpy(p, ":: "); strcpy(p + 3, s2); break; } if( strcmp(s, "end") == 0 || strncmp(s, "end function", 12) == 0 || strncmp(s, "end subroutine", 14) == 0 ) { if( fnp == funcname ) { *d = 0; fprintf(stderr, "warning: superfluous END statement in line %d\n", lnr); } else { for( xxp = xref; xxp < xrp; ++xxp ) { i = (*xxp)->label; for( ip = gotos; ip < gp; ++ip ) if(*ip == i) goto keep; for( cp = dos, ip = donum; cp < dp; ++cp, ++ip ) if( *ip == i ) { strcpy(*cp, *cp + strspn(*cp, "0123456789 \t")); new = malloc(sizeof(SOURCELINE)); new->next = (*xxp)->next; new->indent = (*xxp)->indent; (*xxp)->label = new->label = 0; strcpy(new->s, "enddo"); (*xxp)->next = new; } keep: ; } *(d + 3) = ' '; strcpy(d + 4, *--fnp); strcat(d + 4, "\n"); } current->indent = indent = 0; gp = gotos; dgp = donum; dp = dos; xrp = xref; } else if( justif || (strncmp(s, "if", 2) == 0 && !isalnum(s[2])) ) { if( strstr(s, "then") ) justif = 0, indent += 2; else justif = 1; } else if( strncmp(s, "else", 4) == 0 ) current->indent -= 2; else if( strcmp(s, "endif") == 0 || strcmp(s, "end if") == 0 ) indent -= 2, current->indent -= 2; else if( strncmp(s, "do ", 3) == 0 ) { i = strtol(d + 3, &p, 10); if( i ) *dgp++ = i, *dp++ = d + 3; } if( (p = strstr(s, "goto")) || (p = strstr(s, "go to")) ) if( (i = strtol(p + 5, &d2, 10)) ) *gp++ = i; #ifdef QPRECISION if( strncmp(s, "parameter", 9) == 0 ) param = 1; if( param ) { p = d; while( (p = strchr(p, '=')) ) if( *(p += 1 + strspn(p + 1, " \t")) == '(' ) { strcpy(s2, p); strcpy(p, "complex32"); strcpy(p += 9, s2); } p = s; i = 0; while( (p = strstr(p, "dcmplx")) ) { strcpy(s2, d2 = d + (int)((p += 6) - s + i)); strcpy(d2 - 6, "complex32"); strcpy(d2 + 3, s2); i += 3; } } /* statement functions _are_ a problem if they contain type(complex32) functions :-(, therefore: */ else if( !cont && (strncmp(s, "absc(", 5) == 0 || strncmp(s, "absr(", 5) == 0 || strncmp(s, "norm(", 5) == 0) ) { while( (p = strstr(s + 5, "dble(")) ) { strcpy(p, p + 3); p = d + (int)(p - s); memcpy(p, p + 5, i = strcspn(p + 5, ")")); strcpy(p += i, "%re"); strcpy(p + 3,p + 6); } while( (p = strstr(s + 5, "dimag(")) ) { strcpy(p, p + 4); p = d + (int)(p - s); memcpy(p, p + 6, i = strcspn(p + 6, ")")); strcpy(p += i, "%im"); strcpy(p + 3, p + 7); } } #endif lineok: ; } fclose(f); current->next = NULL; if( argc > 2 ) { if(strcmp(p = argv[2], "-") == 0) f = stdout; } else { if( f == stdin ) f = stdout; else { strcpy(s, argv[1]); f90name(p = s); } } if( f != stdout && (f = fopen(p,"w")) == NULL ) { fprintf(stderr, "cannot create %s\n", p); exit(2); } indent = 0; for( new = start; new; new = new->next ) { if( *new->s == '#' || *new->s == '!' ) { fprintf(f, "%s\n", new->s); continue; } if( strcasecmp(new->s, "enddo") == 0 || strcasecmp(new->s, "end do") == 0 ) indent -= 2; new->indent += indent; if( new->label ) { for( i = new->label; i; i /= 10 ) --new->indent; if( --new->indent <= 0 ) *s = 0; else { memset(s, ' ', new->indent); *(s + new->indent) = 0; } fprintf(f, "%d %s%s\n", new->label, s, new->s); } else if( strcasecmp(new->s, "continue") ) { if(new->indent <= 0) *s = 0; else { memset(s, ' ', new->indent); *(s + new->indent) = 0; } fprintf(f, "%s%s\n", s, new->s); } if( strncasecmp(new->s, "do ", 3) == 0 && !isdigit(new->s[3]) ) indent += 2; } fclose(f); return 0; } looptools-2.8.orig/src/tools/mcc0000755000175000017500000000477411611274563017677 0ustar sylvestresylvestre#! /bin/sh # 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 19 Jul 11 th sdkpath() { mathcmd="$1" shift mathcmd=`IFS=: PATH="$PATH:$*" which $mathcmd` 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() { sdkpath math \ "`cygpath '$ProgramW6432'`/Wolfram Research/Mathematica"/* \ "`cygpath '$PROGRAMFILES'`/Wolfram Research/Mathematica"/* for sdk in "$sdk"/m* ; do break done cache=MLcyg-cache test -d $cache || mkdir $cache MLversion=3 for OSbits in 32 64 ; do dllname=ml${OSbits}i$MLversion libname="$sdk/lib/${dllname}m.lib" test -f "$libname" && break done 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'$sdk/include'" for arg in "$@" ; do case "$arg" in *.tm) cp "$arg" "$arg.tm" "$sdk"/bin/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 \ /Applications/Mathematica*/Contents/MacOS \ $HOME/Desktop/Mathematica*/Contents/MacOS exec "$sdk/mcc" "$@" } defaultmcc() { sdkpath math \ /usr/local/bin \ /usr/local/Wolfram/bin \ /usr/local/Wolfram/Mathematica/*/Executables \ /opt/Wolfram/bin \ /opt/Wolfram/Mathematica/*/Executables exec "$sdk/mcc" "$@" } shopt -s nullglob 2> /dev/null case `uname -s` in Darwin) macmcc "$@" ;; CYG*) cygmcc "$@" ;; *) defaultmcc "$@" ;; esac looptools-2.8.orig/src/tools/fcc.in0000755000175000017500000000152511612302244020251 0ustar sylvestresylvestre#! /bin/sh # script to compile C programs that are linked # against Fortran libraries # last modified 22 Jul 11 th args= objs= ldflags= fldflags= compileonly= cc="${REALCC:-cc}" cxx="${REALCXX:-c++}" test `basename $0 .in` = f++ && cc="$cxx" while test $# -gt 0 ; do 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 -[Ll]* | -Wl*) ldflags="$ldflags '$1'" ;; *.tm.o) objs="'$1' $objs" ;; *.a | *.o | *.so) objs="$objs '$1'" ;; *.cc) args="$args '$1'" cc="$cxx" ;; -c) compileonly="-c" ;; -o) args="$args -o '$2'" shift ;; *) args="$args '$1'" ;; esac shift done eval "set -x ; exec $cc $args ${compileonly:-$objs $ldflags $fldflags}" looptools-2.8.orig/src/tools/alias.tcsh0000644000175000017500000000076010564632303021146 0ustar sylvestresylvestrealias 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 "debugb=2^0; debugc=2^1; debugd=2^2; debuge=2^3; debugall=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.8.orig/src/tools/f++.in0000777000175000017500000000000012032323214021140 2fcc.inustar sylvestresylvestrelooptools-2.8.orig/src/tools/q770000755000175000017500000000271011305527751017537 0ustar sylvestresylvestre#! /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.8.orig/src/util/0000755000175000017500000000000012026604266017006 5ustar sylvestresylvestrelooptools-2.8.orig/src/util/Li2omx.F0000644000175000017500000000107012006317700020255 0ustar sylvestresylvestre* Li2omx.F * the dilogarithm function of 1 - x * this file is part of LoopTools * last modified 1 Aug 12 th #include "externals.h" #include "types.h" #include "defs.h" ComplexType function XLi2omx(x) implicit none DVAR x ComplexType spence external spence XLi2omx = spence(1, ToComplex(x), 0D0) end ************************************************************************ * adapter code for C++ subroutine XLi2omxsub(res, x) implicit none ComplexType res DVAR x ComplexType spence external spence res = spence(1, ToComplex(x), 0D0) end looptools-2.8.orig/src/util/auxCD.F0000644000175000017500000002336412023447744020134 0ustar sylvestresylvestre* 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 10 Sep 12 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. eps ) then Li2omx2 = 0 else if( abs(z12 - 1) .eq. acc ) 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. eps ) & 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. eps .and. abs(z123 - 1) .gt. acc ) & 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. acc ) & 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. acc ) & 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. eps ) 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. acc ) 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. acc ) & 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.8.orig/src/util/solve-Eigen.F0000644000175000017500000001323711776502523021304 0ustar sylvestresylvestre* solve-Eigen.F * computation of the inverse and solution of a linear system * by diagonalizing the matrix with the Jacobi algorithm * code adapted from the "Handbook" routines for complex A * (Wilkinson, Reinsch: Handbook for Automatic Computation, p. 202) * this file is part of LoopTools * last modified 9 Dec 10 th #include "externals.h" #include "types.h" #include "defs.h" * A matrix is considered diagonal if the sum of the squares * of the off-diagonal elements is less than EPS. #define EPS 2D0**(-102) ************************************************************************ ** XEigen diagonalizes a complex symmetric n-by-n matrix. ** Input: n, A = n-by-n matrix ** (only the upper triangle of A needs to be filled). ** Output: d = vector of eigenvalues, U = transformation matrix ** these fulfill diag(d) = U A U^T = U A U^-1 with U U^T = 1. subroutine XEigen(n, A,ldA, d, U,ldU) implicit none integer n, ldA, ldU QVAR A(ldA,*), U(ldU,*), d(*) integer p, q, j, sweep QREAL red, off, thresh QVAR delta, t, invc, s, x, y QVAR ev(2,MAXDIM) QREAL sq QVAR c sq(c) = QRE(c*QCC(c)) do p = 1, n ev(1,p) = 0 ev(2,p) = A(p,p) d(p) = ev(2,p) enddo do p = 1, n do q = 1, n U(q,p) = 0 enddo U(p,p) = 1 enddo red = .04D0/n**4 do sweep = 1, 50 off = 0 do q = 2, n do p = 1, q - 1 off = off + sq(A(p,q)) enddo enddo if( .not. off .gt. EPS ) return thresh = 0 if( sweep .lt. 4 ) thresh = off*red do q = 2, n do p = 1, q - 1 delta = A(p,q) off = sq(delta) if( sweep .gt. 4 .and. off .lt. & EPS*max(sq(ev(2,p)), sq(ev(2,q))) ) then A(p,q) = 0 else if( off .gt. thresh ) then x = .5D0*(ev(2,p) - ev(2,q)) y = sqrt(x**2 + delta**2) t = x - y s = x + y if( sq(t) .lt. sq(s) ) t = s t = delta/t delta = delta*t ev(1,p) = ev(1,p) + delta ev(2,p) = d(p) + ev(1,p) ev(1,q) = ev(1,q) - delta ev(2,q) = d(q) + ev(1,q) invc = sqrt(t**2 + 1) s = t/invc t = t/(invc + 1) do j = 1, p - 1 x = A(j,p) y = A(j,q) A(j,p) = x + s*(y - t*x) A(j,q) = y - s*(x + t*y) enddo do j = p + 1, q - 1 x = A(p,j) y = A(j,q) A(p,j) = x + s*(y - t*x) A(j,q) = y - s*(x + t*y) enddo do j = q + 1, n x = A(p,j) y = A(q,j) A(p,j) = x + s*(y - t*x) A(q,j) = y - s*(x + t*y) enddo A(p,q) = 0 do j = 1, n x = U(p,j) y = U(q,j) U(p,j) = x + s*(y - t*x) U(q,j) = y - s*(x + t*y) enddo endif enddo enddo do p = 1, n ev(1,p) = 0 d(p) = ev(2,p) enddo enddo print *, "Bad convergence in XEigen" end ************************************************************************ subroutine XDet(n, A,ldA, det) implicit none integer n, ldA QVAR A(ldA,*), det QVAR d(MAXDIM), U(MAXDIM,MAXDIM) integer p call XEigen(n, A,ldA, d, U,MAXDIM) det = 1 do p = 1, n det = det*d(p) enddo end ************************************************************************ ** XInverse forms the (pseudo)inverse of a symmetric n-by-n matrix. ** Input: n, A = n-by-n matrix, symmetric ** (only the upper triangle of A needs to be filled). ** Output: Ainv = (pseudo)inverse of A subroutine XInverse(n, A,ldA, Ainv,ldAinv) implicit none integer n, ldA, ldAinv QVAR A(ldA,*), Ainv(ldAinv,*) integer p, q, j QVAR U(MAXDIM,MAXDIM), d(MAXDIM), t #if 0 PRINT *, "SEigen" PRINT *, "A11=", A(1,1) PRINT *, "A12=", A(1,2) PRINT *, "A21=", A(2,1) PRINT *, "A22=", A(2,2) if( ldA .gt. 2 ) then PRINT *, "A13=", A(1,3), A(3,1) PRINT *, "A23=", A(2,3), A(3,2) PRINT *, "A33=", A(3,3) endif PRINT *, "-----------" #endif call XEigen(n, A,ldA, d, U,MAXDIM) * form (pseudo)inverse U^T d^-1 U do p = 1, n do q = 1, n t = 0 do j = 1, n if( abs(d(j)) .gt. EPS ) & t = t + U(j,q)*U(j,p)/d(j) enddo Ainv(q,p) = t enddo enddo #if 0 PRINT *, "d1=", d(1) PRINT *, "d2=", d(2) if( ldA .gt. 2 ) PRINT *, "d3=", d(3) PRINT *, "-----------" PRINT *, "U11=", U(1,1) PRINT *, "U12=", U(1,2) PRINT *, "U21=", U(2,1) PRINT *, "U22=", U(2,2) if( ldA .gt. 2 ) then PRINT *, "U13=", U(1,3) PRINT *, "U23=", U(2,3) PRINT *, "U31=", U(3,1) PRINT *, "U32=", U(3,2) PRINT *, "U33=", U(3,3) endif PRINT *, "-----------" PRINT *, "Ai11=", Ainv(1,1) PRINT *, "Ai12=", Ainv(1,2) PRINT *, "Ai21=", Ainv(2,1) PRINT *, "Ai22=", Ainv(2,2) if( ldA .gt. 2 ) then PRINT *, "Ai13=", Ainv(1,3) PRINT *, "Ai23=", Ainv(2,3) PRINT *, "Ai31=", Ainv(3,1) PRINT *, "Ai32=", Ainv(3,2) PRINT *, "Ai33=", Ainv(3,3) endif PRINT *, "-----------" #endif end ************************************************************************ subroutine XSolve(n, A,ldA, Ainv,ldAinv, b) implicit none integer n, ldA, ldAinv QVAR A(ldA,*), Ainv(ldAinv,*) ComplexType b(*) integer i, j ComplexType x(MAXDIM) #if defined(QUAD) && !defined(COMPLEXPARA) QVAR tr, ti do i = 1, n tr = 0 ti = 0 do j = 1, n tr = tr + Ainv(i,j)*Re(b(j)) ti = ti + Ainv(i,j)*Im(b(j)) enddo x(i) = ToComplex(tr, ti) enddo #else ComplexType delta(MAXDIM), t do i = 1, n t = 0 do j = 1, n t = t + Ainv(i,j)*b(j) enddo x(i) = t enddo * improve on x do i = 1, n t = 0 do j = 1, n t = t + A(i,j)*x(j) enddo delta(i) = b(i) - t enddo do i = 1, n t = 0 do j = 1, n t = t + Ainv(i,j)*delta(j) enddo x(i) = x(i) + t enddo #endif do i = 1, n b(i) = x(i) enddo end looptools-2.8.orig/src/util/ffinit.F0000644000175000017500000006567312003745222020406 0ustar sylvestresylvestre#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 *, "using minmass =", minmass 90 continue call getenv("LTMAXDEV", env) maxdev = 1D-10 read(env, *, end=91, err=91) maxdev print *, "using maxdev =", maxdev 91 continue call getenv("LTCMPBITS", env) cmpbits = 62 + (KIND-1)*4 read(env, *, end=92, err=92) cmpbits print *, "using cmpbits =", cmpbits 92 continue call getenv("LTVERSION", env) versionkey = 0 read(env, *, end=93, err=93) versionkey print *, "using versionkey =", versionkey 93 continue call getenv("LTDEBUG", env) debugkey = 0 read(env, *, end=94, err=94) debugkey print *, "using debugkey =", debugkey 94 continue call getenv("LTRANGE", env) debugfrom = 0 debugto = 2**30 i = index(env, '-') if( i .eq. 0 ) then read(env, *, end=95, err=95) debugfrom debugto = debugfrom else read(env(1:i-1), *, end=951, err=951) debugfrom 951 read(env(i+1:), *, end=952, err=952) debugto 952 continue endif print *, "using debugrange =", debugfrom, debugto 95 continue call getenv("LTWARN", env) warndigits = 9 read(env, *, end=96, err=96) warndigits print *, "using warndigits =", warndigits 96 continue call getenv("LTERR", env) errdigits = 100 read(env, *, end=97, err=97) errdigits print *, "using errdigits =", errdigits 97 continue * * regularization parameters * call getenv("LTDELTA", env) delta = 0 read(env, *, end=100, err=100) delta print *, "using delta =", delta 100 continue call getenv("LTMUDIM", env) mudimc = 1 read(env, *, end=101, err=101) mudim print *, "using mudim =", mudim 101 continue call getenv("LTLAMBDA", env) lambda = 1 read(env, *, end=102, err=102) lambda print *, "using lambda =", lambda 102 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.8.orig/src/util/ffdcxs.F0000644000175000017500000004124411776502523020403 0ustar sylvestresylvestre#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.8.orig/src/util/ffabcd.F0000644000175000017500000001354711776502523020340 0ustar sylvestresylvestre#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.8.orig/src/util/Dump.F0000644000175000017500000000235612023336144020022 0ustar sylvestresylvestre* Dump.F * dumps the parameters and coefficients on screen * this file is part of LoopTools * last modified 10 Sep 12 th #include "externals.h" #include "types.h" #include "defs.h" subroutine XDumpPara(npoint, para, origin) implicit none integer npoint DVAR para(1,*) character*(*) origin #include "lt.h" integer i character*6 paraname(Pee,2:5) common /ltparanames/ paraname integer npara(2:5) data npara /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" integer i character*8 coeffname(Nee,2:5) common /ltcoeffnames/ coeffname integer ncoeff(2:5) data ncoeff /Nbb, Ncc, Ndd, Nee/ do i = 1, ncoeff(npoint) print *, coeffname(i,npoint), "=", coeff(i) enddo print *, "====================================================" call flush(6) end looptools-2.8.orig/src/util/ffcrr.F0000644000175000017500000004043211776502523020226 0ustar sylvestresylvestre#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.8.orig/src/util/Li2.F0000644000175000017500000000131111776502523017543 0ustar sylvestresylvestre* Li2.F * the dilogarithm function * this file is part of LoopTools * last modified 13 Apr 06 th #include "externals.h" #include "types.h" #include "defs.h" ComplexType function XLi2(x) implicit none DVAR 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 DVAR x ComplexType XLi2 external XLi2 res = XLi2(x) end looptools-2.8.orig/src/util/ffcxs3.F0000644000175000017500000004207212024312610020301 0ustar sylvestresylvestre#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 20 cs3(i) = -cs3(i) 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 100 i=1,7 100 cs3(i) = 2*Re(cs3(i)) 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.8.orig/src/util/ffcxyz.F0000644000175000017500000001745011776502523020441 0ustar sylvestresylvestre#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.8.orig/src/util/ini.F0000644000175000017500000002177512031017611017674 0ustar sylvestresylvestre* ini.F * routines for initializing and setting some parameters * this file is part of LoopTools * last modified 27 Sep 12 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,1,i) = 0 cacheptr(2,1,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,1,i) savedptr(2,i) = cacheptr(2,1,i) enddo end ************************************************************************ subroutine restorecache implicit none #include "lt.h" integer i do i = 1, ncaches cacheptr(1,1,i) = savedptr(1,i) cacheptr(2,1,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. acc ) 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. acc ) call clearcache delta = delta_ end ************************************************************************ RealType function getdelta() implicit none #include "lt.h" getdelta = delta end ************************************************************************ subroutine setlambda(lambda_) implicit none RealType lambda_ #include "lt.h" if( abs(lambda - lambda_) .gt. acc ) call clearcache lambda = lambda_ end ************************************************************************ RealType function getlambda() implicit none #include "lt.h" getlambda = lambda end ************************************************************************ subroutine setminmass(minmass_) implicit none RealType minmass_ #include "lt.h" 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 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 = cmpbits_ 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 LTNameData implicit none integer i character*6 paraname(Pee,2:5) common /ltparanames/ paraname character*8 coeffname(Nee,2:5) common /ltcoeffnames/ coeffname data (paraname(i,2), i = 1, Pbb) / & "m1", "m2", "p" / data (paraname(i,3), i = 1, Pcc) / & "m1", "m2", "m3", "p1", "p2", "p1p2" / data (paraname(i,4), i = 1, Pdd) / & "m1", "m2", "m3", "m4", & "p1", "p2", "p3", "p4", "p1p2", "p2p3" / data (paraname(i,5), i = 1, Pee) / & "m1", "m2", "m3", "m4", "m5", & "p1", "p2", "p3", "p4", "p5", & "p1p2", "p2p3", "p3p4", "p4p5", "p5p1" / data (coeffname(i,2), i = 1, Nbb) / & "bb0", "bb1", "bb00", "bb11", "bb001", "bb111", & "dbb0", "dbb1", "dbb00", "dbb11" / data (coeffname(i,3), i = 1, Ncc) / & "cc0", "cc1", "cc2", "cc00", "cc11", "cc12", "cc22", & "cc001", "cc002", "cc111", "cc112", "cc122", "cc222", & "cc0000", "cc0011", "cc0012", "cc0022", "cc1111", & "cc1112", "cc1122", "cc1222", "cc2222" / data (coeffname(i,4), i = 1, Ndd) / & "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" / data (coeffname(i,5), i = 1, Nee) / & "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" / end looptools-2.8.orig/src/util/ffcxr.F0000644000175000017500000002364711776502523020245 0ustar sylvestresylvestre#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.8.orig/src/util/solve-LU.F0000644000175000017500000001126711776502523020576 0ustar sylvestresylvestre* 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 14 Dec 10 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(*) QVAR A(ldA,*) integer i, j, k, pj, invperm(MAXDIM) QVAR tmp QREAL 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 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 QVAR A(ldA,*) ComplexType b(*) integer i, j ComplexType tmp * 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 ************************************************************************ #ifdef COMPLEXPARA #undef RSolve #define RSolve XSolve #else * same as XSolve but for real vector b subroutine RSolve(n, A,ldA, b) implicit none integer n, ldA QVAR A(ldA,*), b(*) integer i, j QVAR tmp * 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 #endif ************************************************************************ * 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 QVAR 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(*) QVAR A(ldA,*), Ainv(ldAinv,*) integer i, j call XDecomp(n, A,ldA, perm) do i = 1, n do j = 1, n Ainv(j,i) = 0 enddo Ainv(perm(i),i) = 1 call RSolve(n, A,ldA, Ainv(1,i)) enddo end looptools-2.8.orig/src/util/fftran.F0000644000175000017500000004656411776502523020420 0ustar sylvestresylvestre#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.8.orig/src/util/solve.F0000644000175000017500000000012011776502523020242 0ustar sylvestresylvestre#ifdef SOLVE_EIGEN #include "solve-Eigen.F" #else #include "solve-LU.F" #endif looptools-2.8.orig/src/util/ffxxyz.F0000644000175000017500000005054011776502523020463 0ustar sylvestresylvestre#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),sum,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 sum = s(1)+s(2)+s(3)+s(4) - (s(5)+s(6)+s(7)) else sum = 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(sum) .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) = sum/(alpha*xpi(5)) else dwz(i1,j1) = sum/(alpha*xpi(5)) endif else ier = ier + 100 endif endif * #] calculations: *###] ffdwz: end looptools-2.8.orig/src/util/cache.c0000644000175000017500000000751212027110627020214 0ustar sylvestresylvestre/* cache.c caching of tensor coefficients in dynamically allocated memory this file is part of LoopTools last modified 21 Sep 12 th */ #include #include #include #include #include "cexternals.h" #if NOUNDERSCORE #define cacheindex_ cacheindex #define cachecopy_ cachecopy #define ltcache_ ltcache #endif #ifndef KIND #define KIND 1 #endif #if KIND == 2 #define MSB (1-BIGENDIAN) #else #define MSB 0 #endif typedef long long dblint; typedef unsigned long long udblint; typedef struct { dblint part[KIND]; } RealType; typedef const RealType cRealType; typedef struct { RealType re, im; } ComplexType; typedef long long memindex; extern struct { int cmpbits; } ltcache_; /* (a < 0) ? -1 : 0 */ #define NegQ(a) ((a) >> (sizeof(a)*8 - 1)) /* (a < 0) ? 0 : a */ #define IDim(a) ((a) & NegQ(-(a))) 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 KIND == 2 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) { 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; if( last == NULL ) last = next; if( ltcache_.cmpbits > 0 ) { dblint mask = -(1ULL << IDim(64 - ltcache_.cmpbits)); #if KIND == 2 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 ) return &node->para[npara]; next = &node->next[SignBit(i)]; } } 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 */ assert( node = malloc(sizeof(Node) + npara*sizeof(RealType) + nval*sizeof(ComplexType)) ); 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); return &node->para[npara]; } memindex cacheindex_(cRealType *para, double *base, void (*calc)(RealType *, cRealType *), const int *pnpara, const int *pnval) { ComplexType *val = Lookup(para, base, calc, *pnpara, *pnval); 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) { ComplexType *val = Lookup(para, base, calc, *pnpara, *pnval); memcpy(dest, val, *pnval*sizeof *dest); } looptools-2.8.orig/src/util/solve-LU.h0000644000175000017500000000041011776502523020624 0ustar sylvestresylvestre QVAR G(DIM,DIM), Gnorm(DIM) integer perm(DIM) #define XSetup(G) XLUDecompose(n, G,DIM, Gnorm, perm) #define IN(i) in(perm(i)) QVAR G(DIM,DIM), Ginv(DIM,DIM) #define XSetup(G) XLUDecompose(n, G,DIM, Ginv,DIM) #define IN(i) in(i) sign of permutation? looptools-2.8.orig/src/util/ffcli2.F0000644000175000017500000003325511776502523020276 0ustar sylvestresylvestre#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.8.orig/src/util/ffxli2.F0000644000175000017500000003526411776502523020325 0ustar sylvestresylvestre#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.8.orig/src/util/ff2dl2.F0000644000175000017500000003036711776502523020211 0ustar sylvestresylvestre#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.8.orig/src/util/cache.c-deb0000644000175000017500000001047412026103320020734 0ustar sylvestresylvestre/* cache.c caching of tensor coefficients in dynamically allocated memory this file is part of LoopTools last modified 10 Sep 12 th */ #include #include #include #include #include "cexternals.h" #if NOUNDERSCORE #define cacheindex_ cacheindex #define cachecopy_ cachecopy #define ltcache_ ltcache #endif #ifndef KIND #define KIND 1 #endif #if KIND == 2 #define MSB (1-BIGENDIAN) #else #define MSB 0 #endif typedef long long dblint; typedef unsigned long long udblint; typedef struct { dblint part[KIND]; } Real; typedef struct { Real re, im; } Complex; typedef long long memindex; extern struct { int cmpbits; } ltcache_; /* (a < 0) ? -1 : 0 */ #define NegQ(a) ((a) >> (sizeof(a)*8 - 1)) /* (a < 0) ? 0 : a */ #define IDim(a) ((a) & NegQ(-(a))) 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; } #define DEB(...) fprintf(stderr, __VA_ARGS__) static void pr(const char *l, const Real *r, int n) { char s[1024], *p = s; p += sprintf(p, "%s", l); while( n-- ) { const dblint c = (r++)->part[MSB]; p += sprintf(p, " %.15lg", *(double *)&c); } DEB("%s\n", s); } static dblint CmpPara(const Real *para1, const Real *para2, int n, const dblint mask) { const Real *p2 = para2; int n2 = n; while( n-- ) { const dblint c = (mask & para1->part[MSB]) - (mask & para2->part[MSB]); //DEB("cmp: p1=%llx p2=%llx\n", mask & para1->part[MSB], mask & para2->part[MSB]); if( c ) { pr("\e[1m\e[31mno\e[0m ", p2, n2); return c; } ++para1; ++para2; } pr("\e[1m\e[32myes\e[0m ", p2, n2); return 0; } #if KIND == 2 static dblint CmpParaLo(const Real *para1, const Real *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(const Real *para, double *base, void (*calc)(Real *, const Real *), const int npara, const int nval) { typedef struct node { struct node *next[2], *succ; int serial; Real 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; pr("\n\e[1m\e[34mfind\e[0m ", para, npara); if( last == NULL ) last = next; if( ltcache_.cmpbits > 0 ) { dblint mask = -(1ULL << IDim(64 - ltcache_.cmpbits)); #if KIND == 2 dblint (*cmp)(const Real *, const Real *, 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 ) return &node->para[npara]; next = &node->next[SignBit(i)]; } } node = *last; if( node == NULL ) { /* The "Real para[2]" bit in Node is effectively an extra Complex for alignment so that node can be reached with an integer index into base */ assert( node = malloc(sizeof(Node) + npara*sizeof(Real) + nval*sizeof(Complex)) ); node = (Node *)((char *)node + (PtrDiff(base, &node->para[npara]) & (sizeof(Complex) - 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(Real)); calc(&node->para[npara], para); return &node->para[npara]; } memindex cacheindex_(const Real *para, double *base, void (*calc)(Real *, const Real *), const int *pnpara, const int *pnval) { Complex *val = Lookup(para, base, calc, *pnpara, *pnval); return PtrDiff(val, base)/(long)sizeof(Complex); } void cachecopy_(Complex *dest, const Real *para, double *base, void (*calc)(Real *, const Real *), const int *pnpara, const int *pnval) { Complex *val = Lookup(para, base, calc, *pnpara, *pnval); val = Lookup(para, base, calc, *pnpara, *pnval); memcpy(dest, val, *pnval*sizeof *dest); } looptools-2.8.orig/src/util/ffbndc.F0000644000175000017500000000141111776502523020340 0ustar sylvestresylvestre#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.8.orig/src/util/qcomplex.f900000644000175000017500000003547607363552750021205 0ustar sylvestresylvestre! qcomplex.f90 ! a class for 32-byte (quadruple precision) complex numbers ! this file is part of LoopTools ! last modified 18 Oct 01 th module qcomplex implicit none type complex32 sequence real*16 re, im end type complex32 interface assignment (=) module procedure d2q, q2d, q2q, r2q, i2q, q2r end interface interface operator (+) module procedure q_plus, qq_add, & qd_add, dq_add, & qr_add, rq_add, & qi_add, iq_add end interface interface operator (-) module procedure q_minus, qq_sub, & qd_sub, dq_sub, & qr_sub, rq_sub, & qi_sub, iq_sub end interface interface operator (*) module procedure qq_mul, & qd_mul, dq_mul, & qr_mul, rq_mul, & qi_mul, iq_mul end interface interface operator (/) module procedure qq_div, & qd_div, dq_div, & qr_div, rq_div, & qi_div, iq_div end interface interface operator (**) module procedure qq_pow, qr_pow, qi_pow end interface interface operator (.eq.) module procedure qq_eq, & qd_eq, dq_eq, & qr_eq, rq_eq, & qi_eq, iq_eq end interface interface operator (.ne.) module procedure qq_ne, & qd_ne, dq_ne, & qr_ne, rq_ne, & qi_ne, iq_ne end interface interface log module procedure q_log end interface interface exp module procedure q_exp end interface interface sqrt module procedure q_sqrt end interface interface sin module procedure q_sin end interface interface cos module procedure q_cos end interface interface dble module procedure q_real end interface interface dimag module procedure q_imag end interface interface dcmplx module procedure q_cmplx, r_cmplx, rr_cmplx end interface interface dconjg module procedure q_conjg end interface interface abs module procedure q_abs end interface contains subroutine d2q(q, d) type(complex32), intent(out) :: q double complex, intent(in) :: d q%re = qext(dble(d)) q%im = qext(dimag(d)) end subroutine d2q subroutine q2d(d, q) double complex, intent(out) :: d type(complex32), intent(in) :: q d = dcmplx(dble(q%re), dble(q%im)) end subroutine q2d subroutine q2q(q1, q2) type(complex32), intent(out) :: q1 type(complex32), intent(in) :: q2 q1%re = q2%re q1%im = q2%im end subroutine q2q subroutine r2q(q, r) type(complex32), intent(out) :: q real*16, intent(in) :: r q%re = r q%im = 0 end subroutine r2q subroutine i2q(q, i) type(complex32), intent(out) :: q integer, intent(in) :: i q%re = i q%im = 0 end subroutine i2q subroutine q2r(r, q) real*16, intent(out) :: r type(complex32), intent(in) :: q r = q%re end subroutine q2r function q_plus(a) type(complex32), intent(in) :: a type(complex32) :: q_plus q_plus%re = a%re q_plus%im = a%im end function q_plus function qq_add(a, b) type(complex32), intent(in) :: a, b type(complex32) :: qq_add qq_add%re = a%re + b%re qq_add%im = a%im + b%im end function qq_add function qd_add(a, b) type(complex32), intent(in) :: a double complex, intent(in) :: b type(complex32) :: qd_add qd_add%re = a%re + qext(b) qd_add%im = a%im + qext(dimag(b)) end function qd_add function dq_add(a, b) double complex, intent(in) :: a type(complex32), intent(in) :: b type(complex32) :: dq_add dq_add%re = qext(a) + b%re dq_add%im = qext(dimag(a)) + b%im end function dq_add function qr_add(a, b) type(complex32), intent(in) :: a real*16, intent(in) :: b type(complex32) :: qr_add qr_add%re = a%re + b qr_add%im = a%im end function qr_add function rq_add(a, b) real*16, intent(in) :: a type(complex32), intent(in) :: b type(complex32) :: rq_add rq_add%re = a + b%re rq_add%im = b%im end function rq_add function qi_add(a, b) type(complex32), intent(in) :: a integer, intent(in) :: b type(complex32) :: qi_add qi_add%re = a%re + b qi_add%im = a%im end function qi_add function iq_add(a, b) integer, intent(in) :: a type(complex32), intent(in) :: b type(complex32) :: iq_add iq_add%re = a + b%re iq_add%im = b%im end function iq_add function q_minus(a) type(complex32), intent(in) :: a type(complex32) :: q_minus q_minus%re = -a%re q_minus%im = -a%im end function q_minus function qq_sub(a, b) type(complex32), intent(in) :: a, b type(complex32) :: qq_sub qq_sub%re = a%re - b%re qq_sub%im = a%im - b%im end function qq_sub function qd_sub(a, b) type(complex32), intent(in) :: a double complex, intent(in) :: b type(complex32) :: qd_sub qd_sub%re = a%re - qext(b) qd_sub%im = a%im - qext(dimag(b)) end function qd_sub function dq_sub(a, b) double complex, intent(in) :: a type(complex32), intent(in) :: b type(complex32) :: dq_sub dq_sub%re = qext(a) - b%re dq_sub%im = qext(dimag(a)) - b%im end function dq_sub function qr_sub(a, b) type(complex32), intent(in) :: a real*16, intent(in) :: b type(complex32) :: qr_sub qr_sub%re = a%re - b qr_sub%im = a%im end function qr_sub function rq_sub(a, b) real*16, intent(in) :: a type(complex32), intent(in) :: b type(complex32) :: rq_sub rq_sub%re = a - b%re rq_sub%im = -b%im end function rq_sub function qi_sub(a, b) type(complex32), intent(in) :: a integer, intent(in) :: b type(complex32) :: qi_sub qi_sub%re = a%re - b qi_sub%im = a%im end function qi_sub function iq_sub(a, b) integer, intent(in) :: a type(complex32), intent(in) :: b type(complex32) :: iq_sub iq_sub%re = a - b%re iq_sub%im = -b%im end function iq_sub function qq_mul(a, b) type(complex32), intent(in) :: a, b type(complex32) :: qq_mul qq_mul%re = a%re*b%re - a%im*b%im qq_mul%im = a%re*b%im + a%im*b%re end function qq_mul function qd_mul(a, b) type(complex32), intent(in) :: a double complex, intent(in) :: b type(complex32) :: qd_mul qd_mul%re = a%re*qext(b) - a%im*qext(dimag(b)) qd_mul%im = a%re*qext(dimag(b)) + a%im*qext(b) end function qd_mul function dq_mul(a, b) double complex, intent(in) :: a type(complex32), intent(in) :: b type(complex32) :: dq_mul dq_mul%re = qext(a)*b%re - qext(dimag(a))*b%im dq_mul%im = qext(a)*b%im + qext(dimag(a))*b%re end function dq_mul function qr_mul(a, b) type(complex32), intent(in) :: a real*16, intent(in) :: b type(complex32) :: qr_mul qr_mul%re = a%re*b qr_mul%im = a%im*b end function qr_mul function rq_mul(a, b) real*16, intent(in) :: a type(complex32), intent(in) :: b type(complex32) :: rq_mul rq_mul%re = a*b%re rq_mul%im = a*b%im end function rq_mul function qi_mul(a, b) type(complex32), intent(in) :: a integer, intent(in) :: b type(complex32) :: qi_mul qi_mul%re = a%re*b qi_mul%im = a%im*b end function qi_mul function iq_mul(a, b) integer, intent(in) :: a type(complex32), intent(in) :: b type(complex32) :: iq_mul iq_mul%re = a*b%re iq_mul%im = a*b%im end function iq_mul function qq_div(a, b) type(complex32), intent(in) :: a, b type(complex32) :: qq_div real*16 :: ratio, den if(abs(b%re) .le. abs(b%im)) then ratio = b%re/b%im den = b%im*(1 + ratio**2) qq_div%re = (a%re*ratio + a%im)/den qq_div%im = (a%im*ratio - a%re)/den else ratio = b%im/b%re den = b%re*(1 + ratio**2) qq_div%re = (a%re + a%im*ratio)/den qq_div%im = (a%im - a%re*ratio)/den endif end function qq_div function qd_div(a, b) type(complex32), intent(in) :: a double complex, intent(in) :: b type(complex32) :: qd_div real*16 :: ratio, den if(abs(qext(b)) .le. abs(qext(dimag(b)))) then ratio = qext(b)/qext(dimag(b)) den = qext(dimag(b))*(1 + ratio**2) qd_div%re = (a%re*ratio + a%im)/den qd_div%im = (a%im*ratio - a%re)/den else ratio = qext(dimag(b))/qext(b) den = qext(b)*(1 + ratio**2) qd_div%re = (a%re + a%im*ratio)/den qd_div%im = (a%im - a%re*ratio)/den endif end function qd_div function dq_div(a, b) double complex, intent(in) :: a type(complex32), intent(in) :: b type(complex32) :: dq_div real*16 :: ratio, den if(abs(b%re) .le. abs(b%im)) then ratio = b%re/b%im den = b%im*(1 + ratio**2) dq_div%re = (qext(a)*ratio + qext(dimag(a)))/den dq_div%im = (qext(dimag(a))*ratio - qext(a))/den else ratio = b%im/b%re den = b%re*(1 + ratio**2) dq_div%re = (qext(a) + qext(dimag(a))*ratio)/den dq_div%im = (qext(dimag(a)) - qext(a)*ratio)/den endif end function dq_div function qr_div(a, b) type(complex32), intent(in) :: a real*16, intent(in) :: b type(complex32) :: qr_div qr_div%re = a%re/b qr_div%im = a%im/b end function qr_div function rq_div(a, b) real*16, intent(in) :: a type(complex32), intent(in) :: b type(complex32) :: rq_div real*16 :: ratio, den if(abs(b%re) .le. abs(b%im)) then ratio = b%re/b%im den = b%im*(1 + ratio**2) rq_div%re = a*ratio/den rq_div%im = -a/den else ratio = b%im/b%re den = b%re*(1 + ratio**2) rq_div%re = a/den rq_div%im = -a*ratio/den endif end function rq_div function qi_div(a, b) type(complex32), intent(in) :: a integer, intent(in) :: b type(complex32) :: qi_div qi_div%re = a%re/b qi_div%im = a%im/b end function qi_div function iq_div(a, b) integer, intent(in) :: a type(complex32), intent(in) :: b type(complex32) :: iq_div real*16 :: ratio, den if(abs(b%re) .le. abs(b%im)) then ratio = b%re/b%im den = b%im*(1 + ratio**2) iq_div%re = a*ratio/den iq_div%im = -a/den else ratio = b%im/b%re den = b%re*(1 + ratio**2) iq_div%re = a/den iq_div%im = -a*ratio/den endif end function iq_div function qq_pow(a, b) type(complex32), intent(in) :: a, b type(complex32) :: qq_pow real*16 :: logr, logi, x, y logr = .5q0*log(a%re**2 + a%im**2) logi = atan2(a%im, a%re) x = exp(logr*b%re - logi*b%im) y = logr*b%im + logi*b%re qq_pow%re = x*cos(y) qq_pow%im = x*sin(y) end function qq_pow function qr_pow(a, b) type(complex32), intent(in) :: a real*16, intent(in) :: b type(complex32) :: qr_pow real*16 :: x, y x = exp(.5q0*log(a%re**2 + a%im**2)*b) y = atan2(a%im, a%re)*b qr_pow%re = x*cos(y) qr_pow%im = x*sin(y) end function qr_pow function qi_pow(a, b) type(complex32), intent(in) :: a integer, intent(in) :: b type(complex32) :: qi_pow integer :: n type(complex32) :: x qi_pow%re = 1 qi_pow%im = 0 if(b .eq. 0) return n = b if(n .lt. 0) then n = -n x = 1/a else x = a endif do if(btest(n, 0)) qi_pow = qi_pow*x n = n/2 if(n .eq. 0) exit x = x*x enddo end function qi_pow function qq_eq(a, b) type(complex32), intent(in) :: a, b logical :: qq_eq qq_eq = a%re .eq. b%re .and. a%im .eq. b%im end function qq_eq function qd_eq(a, b) type(complex32), intent(in) :: a double complex, intent(in) :: b logical :: qd_eq qd_eq = dbleq(a%re) .eq. dble(b) .and. & dbleq(a%im) .eq. qext(dimag(b)) end function qd_eq function dq_eq(a, b) double complex, intent(in) :: a type(complex32), intent(in) :: b logical :: dq_eq dq_eq = dble(a) .eq. dbleq(b%re) .and. & qext(dimag(a)) .eq. dbleq(b%im) end function dq_eq function qr_eq(a, b) type(complex32), intent(in) :: a real*16, intent(in) :: b logical :: qr_eq qr_eq = a%re .eq. b .and. a%im .eq. 0 end function qr_eq function rq_eq(a, b) real*16, intent(in) :: a type(complex32), intent(in) :: b logical :: rq_eq rq_eq = b%re .eq. a .and. b%im .eq. 0 end function rq_eq function qi_eq(a, b) type(complex32), intent(in) :: a integer, intent(in) :: b logical :: qi_eq qi_eq = a%re .eq. b .and. a%im .eq. 0 end function qi_eq function iq_eq(a, b) integer, intent(in) :: a type(complex32), intent(in) :: b logical :: iq_eq iq_eq = b%re .eq. a .and. b%im .eq. 0 end function iq_eq function qq_ne(a, b) type(complex32), intent(in) :: a, b logical :: qq_ne qq_ne = a%re .ne. b%re .or. a%im .ne. b%im end function qq_ne function qd_ne(a, b) type(complex32), intent(in) :: a double complex, intent(in) :: b logical :: qd_ne qd_ne = dbleq(a%re) .ne. dble(b) .or. & dbleq(a%im) .ne. dble(dimag(b)) end function qd_ne function dq_ne(a, b) double complex, intent(in) :: a type(complex32), intent(in) :: b logical :: dq_ne dq_ne = dble(a) .ne. dbleq(b%re) .or. & dble(dimag(a)) .ne. dbleq(b%im) end function dq_ne function qr_ne(a, b) type(complex32), intent(in) :: a real*16, intent(in) :: b logical :: qr_ne qr_ne = a%re .ne. b .or. a%im .ne. 0 end function qr_ne function rq_ne(a, b) real*16, intent(in) :: a type(complex32), intent(in) :: b logical :: rq_ne rq_ne = b%re .ne. a .or. b%im .ne. 0 end function rq_ne function qi_ne(a, b) type(complex32), intent(in) :: a integer, intent(in) :: b logical :: qi_ne qi_ne = a%re .ne. b .or. a%im .ne. 0 end function qi_ne function iq_ne(a, b) integer, intent(in) :: a type(complex32), intent(in) :: b logical :: iq_ne iq_ne = b%re .ne. a .or. b%im .ne. 0 end function iq_ne function q_log(a) type(complex32), intent(in) :: a type(complex32) :: q_log q_log%re = .5q0*log(a%re**2 + a%im**2) q_log%im = atan2(a%im, a%re) end function q_log function q_exp(a) type(complex32), intent(in) :: a type(complex32) :: q_exp real*16 :: expr expr = exp(a%re) q_exp%re = expr*cos(a%im) q_exp%im = expr*sin(a%im) end function q_exp function q_sqrt(a) type(complex32), intent(in) :: a type(complex32) :: q_sqrt real*16 :: mag mag = abs(a) if(mag .eq. 0) then q_sqrt%re = 0 q_sqrt%im = 0 else if(a%re .gt. 0) then q_sqrt%re = sqrt(.5q0*(mag + a%re)) q_sqrt%im = .5q0*a%im/q_sqrt%re else q_sqrt%im = sign(sqrt(.5q0*(mag - a%re)), a%im) q_sqrt%re = .5q0*a%im/q_sqrt%im endif end function q_sqrt function q_sin(a) type(complex32), intent(in) :: a type(complex32) :: q_sin q_sin%re = sin(a%re)*cosh(a%im) q_sin%im = cos(a%re)*sinh(a%im) end function q_sin function q_cos(a) type(complex32), intent(in) :: a type(complex32) :: q_cos q_cos%re = cos(a%re)*cosh(a%im) q_cos%im = -sin(a%re)*sinh(a%im) end function q_cos function q_real(a) type(complex32), intent(in) :: a real*16 :: q_real q_real = a%re end function q_real function q_imag(a) type(complex32), intent(in) :: a real*16 :: q_imag q_imag = a%im end function q_imag function q_cmplx(a) type(complex32), intent(in) :: a type(complex32) :: q_cmplx q_cmplx%re = a%re q_cmplx%im = a%im end function q_cmplx function r_cmplx(a) real*16, intent(in) :: a type(complex32) :: r_cmplx r_cmplx%re = a r_cmplx%im = 0 end function r_cmplx function rr_cmplx(a,b) real*16, intent(in) :: a, b type(complex32) :: rr_cmplx rr_cmplx%re = a rr_cmplx%im = b end function rr_cmplx function q_conjg(a) type(complex32), intent(in) :: a type(complex32) :: q_conjg q_conjg%re = a%re q_conjg%im = -a%im end function q_conjg function q_abs(a) type(complex32), intent(in) :: a real*16 :: q_abs q_abs = sqrt(a%re**2 + a%im**2) end function q_abs end module qcomplex looptools-2.8.orig/src/util/ffcxs4.F0000644000175000017500000004774211776502523020334 0ustar sylvestresylvestre#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 120 i=1,2 do 110 j=1,2 cdyw(i,j) = cdwy(j,i) 110 continue 120 continue 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 10 i=11,20 10 cs3(i) = -cs3(i) 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 30 cs3(i) = -cs3(i) 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 110 i=11,20 110 cs3(i) = -cs3(i) 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 40 i=11,20 40 cs3(i) = -cs3(i) 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 30 i=8,14 30 cs3(i) = -cs3(i) 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 110 i=8,14 110 cs3(i) = -cs3(i) ipi12(2) = -ipi12(2) else call fferr(20,ier) return endif endif * #] Taylor expansion: *###] ffdcrr: end looptools-2.8.orig/manual/0000755000175000017500000000000012036565523016522 5ustar sylvestresylvestrelooptools-2.8.orig/manual/LT28Guide.pdf0000644000175000017500000105465512026050300020661 0ustar sylvestresylvestre%PDF-1.4 %Çì¢ 5 0 obj <> stream xœuRÁnÕ@ ¼ïWìÄ3¶wíݽ"!p†SÅÚR}”R¿Ïlšw€DJl¯=žÌä.2Iäqoï‹cxò¶Æëû°T£ÄWÑ×pdKxëŽOg ´¨…j«çOA¶vÍB¢Q½Pkq>†óôz:0Õ"î-ÝNB¬5oAÓž¾O„^½§yQÊöϾ›“«d­é~”Žëýü\@í” eЙ/±^w|š˜¸KjÓ¡šP1OïPí `\¬èÊ"éj¬Ð&Žò4rVMVœ‹Zõlé9]ÝÒ/„êµsM_FU­{I—ã;¸àüxp6‡7bÅßÚ A;“Žü,ÏZ³›pö_#b°›é©9w²²ÒËêÄÙ¢{s %•ÞVùµôÚÓÏ…™4㶟—"ô1I‡R¹y?‡6jJCR«6·=|> stream xœíZY]G–x¼¿âò”ssÜû2OˆÈAÄ B(áa˜5É,ÎÌ8‰ÿH~?“ªÞªúœ¾3Nlˆ@ÄŠÜîÛK-_­}¾ÞŠYnþ)Ÿ\ož½ôÛ‹ûØ~ ÿ_l¾ÞÈ´`[þ:¹Þ~x‹àŸRÎÑZµ=:ßäÝrëÕÖ[?G·=ºÞ|6©Ýœƒ7.üý蛎6Ÿn̬¶ßn¼[U˜ãözcµlÿºÚüù±+áh/äâFíÝL¾ñh§g¥DtÓåNÍZk3픕³ÒÓéþRÒØén'Ãl½N?ÎAH=ÃNiT°e™pq:‡‘wy½³7!Z3]Á£g+}Î6zÇι@žEZ²#Ëããtte¬ž`¤Bô–ŸWºÙÇàØå‡0²^E‡R|ö201X,„Qû/òå*˜évwZu@I(c "öÓ«FÔÑNJKä`m_áØᬺCãTP™ŠNZÏAÇPÉø¢Éwéû8?IúNª,5£÷iòB i¤Äl…â{³Ð‚RÓ·È«SÂ&è¬Ø*fgÿÏŒØ0ýVã¤Ì2·Â€¤òïRÆåaºIP2ÒU’´Vm“å›nò&ë#ô²m¯L* jꕉ€F ‘GТÓOp;è×(ËH$¡”®ñJamEž²£ É€£gØŠwÀîï‘ ï¼ñŒÉ*â€É’N>Ej`JE`Ú›Š)Pg2¨3šJw«½ ] p‹5GœïV®s¯#%‘w½¬Fm™£%Sì Ý¢?×Å€‚ml« â×ÈžY’vÖóbsô‹Ï&™öi§¦Ïwx¸Z¸í¯»‘¹ÀÑH©˜‚‘Ðm07üPDê<i¶¨=?€¸ɇ]?’©otˆÿ‚¤k=Ù‰ƒGaç'®íÚ‡«ØB·b똿#›ùŠP‘¯vÂ%?'lžsPª âç¼h HzCç³ðE–³?ƒ[Á‹r7zš·{…n"ùB?¹ê i!: HšÄ¾ðt±dN§ˆgkˆó,¬Ò‘¾Ül³T‡X4dD r#ƒ »Å¦RÕÏn5xaƒ6P4œY‘ÅÚŒ*‹D -æo»àgmHõFÄ&z«Š·rÃ"ˆ¹æ{ø£ÌOê€Q—¥5 UwÈš¨ÉQ¿4L™2â˜#N4D¡:†gZ ^ǧ¡¼¤¾÷|” y¥ UEFŽ4qœ­4ì|À`ÂÀwYŒbAK Hž >Q À=Qw›õ]—jÑþ¥Uòl!srëR¬&V3ºª ÈxöU»0C²KB{ëqcšìzu@eر³§à¼ÀÂ"`Ÿâ5šÚS·}æÜ-I¦B'±p®©.—ûãhv7¥”!rZÙ¦„tŒ-f—†C%‡:/å.rìš`³Bã ݶ¥hȾ„\n,¤ï«n„ͣ臮ÿK`Í)m—ü×rŠT.ì¢NÕ&˜+y7ÄɆiå;¼*—Ô&”›È÷äîEòä –­ “½†i»ØRÕílQ’3ƒt¾9ãQ®›î|ѹQ¥‹éÒ²ÐC?TO²+;…¨[ZbžµÄ@µ 3ÛBÈe’WD<ä¡•ªqöÍÒì³Õ\Ðì ;¦Ù™foiöŽ†´€]qE³_Ðì ÏhÁ ÍÞóàN1 ¹ç„—¹«Õý™qøÙ@ÞÄŸëžNneîzE1 ]I©#½¬*貺¾zÙçì¢yѹÞ®jÇ«– Önªî~çûJ7Ub4ùñÝÔRŒ 3áQ?eäÄÖAIxÖ'_uju~Zâ0@½¹Ò£>êrÈP³‡4|6žÓðŒNx3´…ã!ê™åÝs¬µÙÓÔ–Ç z;´1fƯ!jþûíÀîÛžˆÑã»Ã%.0¬ ó󥦶µAø|Œá»Œ?mCR'@õo!´A$†ù+À €Í•ãÖA‹ =iþÚŸ´çCÐÞ!Eô†ûÓ“ OF ‹  †H…tç­€*ÄF^P3”ž5ÏRbÝœZÌüÑè…ð"r?ä>Œ”ÕµB>‚(GÆA­ö_áZŒö ¥ y7«·‘trç¸Ù HÏfFXs`ÙÙ#Þ c{Áú=à;Uá]ÝÕ:³|?@¸ á—tÂ74{KÙ†—Ã×+•#fšýn'C³ÇÃÈ{•2F¡=?ëfX[æùœæžsJê9o—eî ÐPOE3„,„d‹싘üà ×TUCIS0áC}Þ5:Ô^|-BÑÉÈñƒÎ¨¥ýïtžDNëîvç}OîÝk þßíñä©–㟸¦j÷¬•«žâÑ\gÊ;}ðv#mÎÅ·0ÃP0Ãö4ÕÁ¬EH2¹¢Bšu;º|«ü—’лñi!ù’Ó}Ïp=cøž¼ÿñ-w‹Voh,íù­óÙåá&…n¬Ý–àÆ€)biæ`k64LŽß Ù!š¤§U“5¶~쮟ѸækÖ‡Z5”ó}åE.vOÙ&G(.¢ZÊsÞqûw>lqÂäHp#Sù0ü=(·á?f¢Ã‡„*j:Zõÿ¬Û86ƒÃîa ²9À%@ßÏ“ÒÄäò 6Õû¸%“R+îЇ+°Á‹-:¨)5õRå¬ Z\n§~’¸0ÖòÖ`ióI+§ƒ–±ü G&ŠÈÝ4‘CÈáGáƒ`ºoE*‘‹/äÒ«Ö‹¯æj£;¦TVB!ê\ÿÜ ¬î«ëBãS(ñA¾‘õj‰º½p¡%ˆb+Ÿ \ò·Ñõ á p ÿ-=N@%Ù2ÒBÖÌ|{C’ËÌ/¨—\,5€÷  QíÕ@’6£a ª®ÊS?œ^Pf*Ä0%nF¿ºÑâ…á”Ô°ö ]OxÔxÏn¼÷Kœà}<'ºû„(=ý 9¹ ôjš¾ßù-^££ƒBôû†íÐ,C´ÑhÎ" !þƒ™]1q;ËÇ l.$ l諵5ÀJv(Ì0~¬+né2ÇÑ+ŠÂ<ì ³®> stream xœí›[Ô6Ç¥>Ǚ–1öñýh©ZZд}@} {•åNQ¿}í8>Î83™eU!DH/?ŸËßΛgbÁßîßÓ«“ÛíâòÝ _üˆ/OÞœˆX`Ñýszµ¸»ÁB  ˜uV,6'ém±°°°B3c›«“'Ë{+ÎŒ6Ê._­ÖœY%ŒqË—+Á8WF/߯Öx©”VËóxi¬ðíçïÂM°òÏÍÏé×…`^k¿®%†ã僓ͷO–"¼å¬2®+lhaa™—Þas7gØÄ¡08Ëuh#þ†ãàéåët)¤XnV‚{&`¬è l£5R:l-0©¹ò­æ*©±§¹zÐZgRvÝ^ƒ`2ö1¼Sz¸da`½´Rúx›+³²üi†_¶8œXBXm@Æv)0<-g œænù´T÷"ÜæÎ:!lþ±žZˆ¾ûœ¾ÆBáW•/˜ÐDÍ9áRyX]5O¿y´Š>C3éóãÞ,—$…ËPI›)ÃçBzð€[ç‚0ðÞì$ a¿„^Iî3a ùÄu  ,°Ž«¤ÉkÌà2î‘ZRXp²X…·CÎ*gÉO\–µ÷6\*Ú7pÖÖxƒð¯µE›%aÆë8x¹^¶ÆK:´·:á%÷²5bÔ„7L*´¿>ø´¯Ê^²nšWl! ñ>:–{Hd‹@˜*òny±Â:…®ê|q8§ÑŒr[™¹þ¥¡Ñ("i=…S3? ~Èó ‹Põ>nèǧp…“Æý›:² ]ìjδªbÝX›-Û«¾›¯Ë u‘.zÊò¸\…8×[n¢KEX 8Ñ ^µc&LLq_s^1°žY§'kœN x&»Û?’u\†ðœÐX!8°.  èO‹…KëÓUÙ릲£Á°á›Â˜]åT’büÅ-3%þ0•ŸNÊG¸"þ´Ä]qÊsÅfÝç½ÄÜmc•læ+L…67€Iz×Öi†ïÎ`M«Ï¡Ö”h~„*Y¨úg\ÀĬ¨.‹ãZ×3KÜäb+Âó®i‚rrîú@J¦Z”‡¢‰r¥vC>n;ñÍ›…\Îü? øHƒ-·~æ>eMd®óÚD*jçpR„´ slýg Ü0# }ê^ã×æâ³?/ ãXálñÒódæDÛF*‹'Š+ÕÞ]1]#ia„d %Kø$¯úY Ñ8f¯zcC –2vÀL°Ý.ñÛ5Ž˜t7Œ˜ã˜À;#v(bæȈÙãÉ°[Ò E&NüµÉRœEd‚Lv3ýÅaÔŠ±L„k‡;‰ÛÖ`I¸^f•FWç).·ÂuÊ'z•,k ‘à©\Jj¥Ü<¯·{†~O½ñ'fD¡ÞÎIÖc§ãU ì!ÆY[þâ!´0•³#ØQ¨FÕ€ËTŸwŽlñ*“[®È¬*½K#¾ÚLÀ7yk«ìec›óïiÔRË¥X>Fô±#JùV_Ȩìø`+M~^7 a”¨,6CŒHTÛ¦*L*]ª«è ¿áq¯¼FWÏ¢cFØ#Sße€ÎŠÑM̪ƃѺohâI‰î¨Ž–¶Æê"ë¤í#9šfuµ±™ýý­$Š…LJPK|të[ GíR¯ß”¯Û¾Wb.¡FkAÒÕ^]¯óQ¨‹(¢‹³Äã»o¨À«˜–jÚV¥*ûìØ’¶„…h‹Wlìf¼Þ¶³“–VïR Ó¶³CÁ¸mœ}ÛÙGªü<Ù%¨òŽÁ¨ñ ™³Þ´ùN†ä Æ ,(o6ÂÎAçjêšÐS»o/TÏàn[¬ìíh§Áy/7¿+7ñpŽ¤s~4 U;ŽêNNÍÌéÖºFa̵=ÄÚ0ªÆói¯)½ïÅëg¥3ç}#—Wqp¥—xý”ˆ’]„ó¼ïØi¬Ý{.Jí­.¥ùHÔpÔ Üð{‰5à< ³Àø#/‹;«µ`ùM @y¶ðŸ•@ò<…‰6džùxžÙçýÖG•ˆç›/KMÕqòîyëÃç˜^ç©%*÷ýÁš«»' ³äƒ”‡«`Nq<n·-S‘9© WFr‹áW1ÃïL |ÙBMÏdX”JG hb‚Ë픟rX¿lž“<ãŒv§—õN{ƒ1ñ®‘ˆ@ãnjmÌ:ñ˜xv/hë\pYPȺK%à>›mœÂ_ˆGmŸ› Ï‹[,ˆÕJ´å‰Ç~Sœ4vªh×ï¸íA%’Ž}’ÕÎP_4ÖˆPž^öŸØlŸC‰3ºø^VÍ'ik:¼¿!–“E“ÌT‡nÒ1–‡ 0Úê Ô¹Ä pvb)ä'þlð®…FØ;(lVZ3´,ƒïŒâG཰0% Og½°~wŒó3 ‡ÐPŸ gú¹‹+ï7 ꃋ?lNáŸÿaÝN endstream endobj 23 0 obj 2214 endobj 31 0 obj <> stream xœíšßoä4Ç%÷¯ÈciííG~„@À âz\9éZ¸^átüõŒãìfœM¶Ù\Ž6ªNM{ìœ?ùÎçe¥•©túi_\­>øÖW—¯VºúŒÿ]®^®LÓ¡j]\Um¹ÿiŒŠÎÙjûl•G›ÊÛÊ;¯"UÛ«Õ5®7F~Ú~ѲÊXíÓ ­b @“ç'ô&Vû6$W˜úxm8Cýu2Qk¨¿ZoØœ1Î×ÛµVÞh"[?Il°H#¾k,P Û-ëðYŒñ ùy¬Qº]ćlCGŒ.ÚZ­7¼Xð±¶ûç,ša½‰V+0–gÉ „ú×µUÖêW|…ÖñsܦAÜètjÝЊ<$[½ò¡¼rÚª`ìÜÆ{3t^ëÍ•¼¿ƒ÷CDe}³q»ýtÂËLmª SÕöib þî{ŠÊc¬?Oì!cxzïÈB iWðs7ù‹Ô¬™fq÷ù¨Iv’cŸË¿§>š 3iVtiýK·ðµ¿LÜ q Á³®4ÈLBm7fjx'jÏ%<£Ä´TQ‰^ÑéïnÅ¢ÿ]‚ƒ´ ‡Iýi;#z ošz¼9ß#¯ÝGÚ‡Ïuðe Þºú· òpvyë@¥æÎûݤ91$×|³6A‘¦(aáû½‚ù¾‹@bø“ç§îJFµsC@:^'¯Åeš„TŒ(ÄøMc/XSè¼ E®ÖàáNlÁ£¤/QÜÎ÷rS]l(éÏ{e†tï îrÃq—éâ®6Xë¿r,¼9¤0#î¶ßí×¼zgÙ,üç{ø¿#dNèUr‘iørµ}ÿdlÇÃ÷bdÞñZ(WÒÞrmÊ0«/nXöü\ áÌGy¾¿ r¨p¦8“‘µ}ÂI§16JÇóË:õ ìŒþLÞÎÇ[w™÷Û€Ù]j±Ú»«C?fØ‘fhPO!JyÍz‹öÒÓwF´=Š)óä'žÿ1Ö8±àUta NïJµîù«vÌ|…q]i¢ÅKcÀ$¼w1o‹k‘ŠpêMZuT˜÷qñSgÁƒ™]" .tÁ/$°®ØÑR@¹ïM˜|á¸6¬\žÆåQiºMÒĪÇѳ½EŒH°ë )æÍ Õ¼ú»²¿¤ir–š¨Šðú!t˜B#˜Cè0œÀ¨E_¡ÏÎ)fÜ,;Å·Ti:Ä-3!ºÍ ˜q¦ÅÍ–Žõ­ps¶ è7X'(Z®xE°gЖ`íîNðu#TÙ¡šøk¶B$4s4lU£at¨øUX:)©IéþRÅ1Ë`*ÉúS_¼îälX¼ÎÆ™ã°hákÄWrn$uJøBèóe:Éšë E„þi—ß FD°ÞU+ßJÀ’WD<X6/ï‚G†Al_n¯bÛò$ç §K×8a<ò .Ò§2³«¤ aAp’ ³1E²SrJ/c?:¸n±+€Š£â›\›B_3ð°’™L‹Ê—(«å°œ’sJ[|—@x ˜?sœõNþr-« Æšê11óÃb&ÇÖF3‹2U쪒¢ÞÁßD ‰ºúåeWtŸÆŸ‹QX¨ºï¤±œ nªx…N¼†jïú#6[GGáDŒ‰ZªO™ô-š7·üÁÕ ³×®Ð·&§ŒaT¢Šä€”MÜ.aåU‚wØvv²3Çú&F»ëü^3‹vhÈtº„ÆL—_"þ¿¦ŸæïÉáÑW"¾ µ‰8žÈ¾»Z°|#È7£O= ˆ%¾äUúubF:B°=…`8Á}Ó Á†`qZ©< _8_<¾}Ó ¾ßÒÝ?Ù®¾áŸx%µWendstream endobj 32 0 obj 1444 endobj 40 0 obj <> stream xœÝ[ÉrÇðq¾¢3¶§Qûâ£eIae‡dÈŠ+M€ J¦C!°3kÍê®î(‡BÁŽšZ²²2_¾Ì*¼ØȆÿ¥O®7GßÛáâvƯáÿ‹Í» †ôÏÉõðçcè$Ô ÔhåÃñù&Žæƒƒåzän8¾Þ<ÝòÝžÌX¥žƒƒ $í(`Ôñ)ô|²ƒŽLsµ}³Û³Ñ*nŒk¾ß’ïãçb”z±óUXXi&··8³pÂGÜÀùèµ(Á>ˆ°W|Üû, uLx˜aŠ~½ÅŸUQ æG.Ŭ#×D€uŒ3$Ø‹Qáx4IdÐ,.žñwÁœuœÛ0’¹QÂÄÏñSŒF¨(‚PÞ†Ö,ÍIYùUÝùý¢¶žÁ§w£ÉÏAJk¤ êC•I-·7¸hFCOÒ¹íO¸É4s^Ea54›íû¨`šv¹Ã.‚;Í\»·´‡½½FyôèãéçÖs”BŒ{Ð(P˜ù¤hz.Fœ—´×}Æ×Ø™[m„ÜžF¥2%9Ë®S_©O2(Æ©Œy…ª¿´Ÿ²D™k4­T+-Ñ:™à-N &âyÖYT1øn‡Ö$Á™ÉƳÖäÓ2œ&•uzñä‚™ÉQJ¿}‡è¥—°aһ꿮p·ÎÔtë‚ÁQj›5j”1ÛË™F`Š®Cj? 7칫g"në«jºõ³çK0Šg]d/öã½D‚ó.’Vœ4ÛЫØõ×ÐÈ5çÜmGÜž—5øMñ¨1öE€è»ÏkìÀQžíß±Õ+Ðhk§aÎh5³Ê Ì(YX¸1Kîí½¥vp‰«XMoŸì' ¦¦"ü3@)å[_åe; ;¶à¦ÏÊ°I f+lÿŠ ´´Áëq­«’P0†HJóòоoqR KÈÆ[[Û ]¼êº€¹¨M¾! &[Më"¸¦L5N`î:ÌæXA”$RÉߜоuÞ*Åd;‡j:Ó©‰“mx§¥#KFlaRàŽÀ‡¨ÔG'’ÞÅ¥=·"«T¨RÌ·¸ŽàÆzf(våi ‹áÎ@ZM{ šs@s8óÎá…gq ¶Š„¥¨n@Õ,RãÀÄ çÄs£â‚n’è˜|Ókƒ /7j,–ÆŠ \€ÐK}:à'€9‰Âˆ¾ªžû¦XÎM¡pž0o‚ê/p^åËy^4SÈ ôUŽ{%{¨©üè+ÀI¼“Ø:U3ÑÐB@áÁ±Àz±–©Nðml 'cøDß6À ³}x½[Š M8Ðrœpxë×#:†Àâvíld\Ó“Ò‚“ £‘z6.­^8Û³zôвúâ”)Ÿm2¹YÇ™Xâ=Â/DBeç¤+ˆ‚ÄA#r©U$Ѐô’oEd_‚Îñwþe¶òÀïêÀï+Ì0 ©{3¤Ó´VQ}.ÂNÇ!xš&šè bJ•¡"B™ò|qÅIØâï4„q0wÒˆÚ¥(³åAçeMâï´o?¾\ðŠŽ#d§IP!½Aw\®º}²—™Rtß\ËÂ8¼¥žL;L‚©“£ñ~ÂH{Y ìA”“#ž¸_ .ÚLb"òw žý´¼¿ìp¯6Ń#¢ŒØû3Ê43 ìx²³rW|_Ip‘|‚ˬí&¸` n^¢‰ %‰S$q6hÏÁ&ø"ñ‹QÂqBÏâ(oìª_Α¸óœ´ÍØ$ê¢ÃYQBöÖpš1æmÑÅÉšsD ¢âÌ,„ùb‡Iƒ†… –WÿPã§e"‡l¤åŸÌCÎ-T/3°+§ò!~‹„ÂBNé#ßÑõ®„Ã˺ÀY° îÑ0–ç0ò¨—¾R;öLË@>B,·¨‚K“©ºþ¬qW¸1ñà8 ‘~¯e4èÔ$ƒL‡ )SV¹4‰ÚKI‡jnÂ8d“*¨f‰¢7‚Î ú6£n*)Ô{ú”ošˆæ€HrN<]žÙh¼çH$Ï,?'{C#š˜P²0°ÖÄPmÀÞ'›ãßcY‘Kd€öyHŠŒÁ*2Q˜Y*+>'´&a´˜ä¤Ä🧺Š*fàóßïêï/ëïAs¢¬­+õ,U*H$ÑÜâŽw £±l„n E€…Ø µbz ¢]QËAØ>”ÍVèUì"£–˜ƒTö¾WIáÐ× 1EFÔ°µÕÖ5fzÃ%¨—Íõ™EcàÔjñD,³+@‰=4_ŽGEÅ´Lô·èˆ?àïbkHÞ¤P°Œî“—ëÈ _°fZܪ;Š%&©ô·$ň9Ø[JoŽ¾W¢1S1ê’"îŒ^8…€ŒŸRèô…Ý Àá±@þqÕ ìbF[of¹UDmH-`÷ˆÚ糿CQ˜÷Nä|É{ÕÒ±ŠÐµäAJKë¼ ÎTÔùìHß+ošY9¤NQ=ù’’Þˆó‘HT«`nä ýå‰çî“h–Õ=îS ñã6v)tÝDÂduÇBJŽƒÂ].Ô슔óº=Óæ–7„£A3 <›ù›Úú¶~ê{U?oëç¾öµu¬ŸvÚúÞÕÖçÅënêïci$þùŸu¯2ï˵a“o¿¬~ðïàí G\°¢Ñ¼ÊR0t_¥FfùZfÎ…±,qi&…é°&™ Ÿµ+êÜ„tý :ç "´þ?£Qfô½ˆ1õ%ú½\Æ@õaJwYÐ4¼‰¤ÑƒÁ.T1I¡›`¼J";w:Åc…ÁÂèVb[ì¢WéCÚÀ2}@RPbÅ_o¾Û@cÒóábc WVƒÒàÇLE0f¸9ÛœoØðój¬^eOp"]e{C™b>^f_TÇ|_?_×Ïè„’«`„H”÷!yÝ×V£šCÐ×s$ Ì‘[gH4í{U[?áçM·ïE£eüh úü’vÙ›, »ÁÛ#?åC Ê~ªÎk‡ª=4 18ŸÔѧiXðgÓmhë[íTìH`¢Øä ŽãèˆB,í¼kiµõýì¼°õlMƒ×ÝÓ~U?ÏÊD8ú¾CFÇ •óuW‘wµõyWéWô]ÿ¤;çÙl†VÓ½hºÏ$wÙŽ7¹$ï9 S)©u(ÙÞÙã$BUv7=ò ¸<Ê‘Ï(¦&„¨e„š’Fúò;NRaèär©ÙZß‹•H5ncÞæja.XP¯†)Ux´Ñ}hQiË„£"3­lµ¥÷!ÒQÈÍH×5^ÕÆn¥å:2ìG¥…¼ZëœgĘúÒ«ß<¤IunÌ*±èße[9äk¯3’vÕj6 gd܃²ÑùVï¦%ûÄ ´ð¶çEê‘M/Óî‹g ®ù}I–ë(9ã*w‹Ô‘0¡&Q‹ÄQ¬Õj"Ùrý·ZMígéiQ ÇžÉ~%<œûE$’Œ7žIJ}ÿ {qÔÚûב¤Ú8] É,$é+®^4tÁŸ:©Ï˜ÀM’ªöz”‘e!åîšð×K‘TâF¯_êR9ˆÕò¥Šäô¥8C µq¡^-¥;Gœ­>‹Pg‘oýé€×!Ð5ìe"Ê9AËê#aêE—æÌûbÄz1=¬Îvw¨oŸ³vV¡¡›8+L+(Ð3Z×F ¡½zkßt<°„T^vXfÌá·¥Ž\È7ðÐø&ñs CdÚD×,ðá s0ž³¿ Ï%¶@ˆÌi—©õ8áç0–ËÇ0–’;/„rΤ aIÍë¸xõ­$½çŸÔaMèÂÌ"÷@èWý{gÙµ¨¦ö:ýS™GŸô¿é‰w‡úÎ㶒dî²É•þ-å¡wÐÆqsÈ \Ð7~¹{T­?©ª›¿èBVEhoºÏn¡ëì¹5hY5¸P³[H:×ö(gÿù"ç#›-œ.–‚%¼›R-¼÷#¢‘äýÛ¨{£ÂC¬à|­ÿ4$ ÊtÿØ`éÑ'1…'^¹ÜVH§oqiîÅü*~1Ká÷᳑í蓸õ§/Ý=F|‹¶b5륷t\@k(‹.*þöÑÝ10»îuw¸jI‡L^—Ãú!¼ÖQJ¹\ Ñ$ˆ@*ùkY¤›­ùú§óTO¢_§;”,<`.û¿Å®bêßrK™æíÍìÝKpÎÅ÷ÀM÷5¾‡ù<!Ï·Dýû˜–¿a_|E–^`ˆ_¨,2 l­öð7zN(Í=gþ÷Pç`Ö»r©ž«5¢‡¢–€þj˜¿^>Òð¡C.·MŠU€€8×°‡p%MÖï„Ë®ï6ÿs¥ Êendstream endobj 41 0 obj 3297 endobj 47 0 obj <> stream xœå[Ùn·z©§8—s šû IjwQ7ɹk ÔÖb•äENk?GûÀý¹Ìðã çHA%òñpø/üþ•œ·ÎĆÇÿÊ¿ÇGt›WG|óúÿÅÑÛ#‘&lÊ?Ç›ïö4‰þ‚cäfv”ß'7Î8ìfqô·Ánw‚y§­ÿûþÏå%É„ä.¾ÄYðVi‘é[íDØLcÊ+&ÛÕ¾ß ¦Œ ~øc\Wäðí–3TP^ ¥ ÎHa†=:¡‰òð(ΕÞ=ü¸ÝIc˜¦Q1q6°íŽ¨*#ƒË\úždÚ¦}ÃÏ“¸÷R©á)pñ´á(—Dq¿ž9Gl¬M†õ~š«â*O;å]df§, ›ý ñ’VQö—QátÔÎ)I¬‰¬ðûHß-hP2)¼óÃ=ii¸~‰ï®½ÎãûÜ[¸ÞÇ?h²á~x•p^7\*–ËáEÔ«c\«á¤j»™^¨+ ÔéIadCåu]+£è%zÔ^7|Œ$$ã™.¯Ym-Í¥õµ”ºˆ" 7…ס¡2[Þ™¤)£˜£¹ 㙚å&o„–¸Šd%löOŽö¿M€„$N»ýºûø¦>î„ö8÷¼Ž^ÕчÓhB“d× ¹`ÂX©òиî¡=0*K"_'UJÚ×דRßT#"tóÀ€ðs}:'à ŽÓ6%Q´•^ôø7œyÂHþ¦` ~e§ – ,qc"–À¸í~ WdC …¢Ó×}_ ð}ÖEá&ïðiÁ¹Æmw}›PŠù†ù—ug_OVZ÷Ž”LžÖ*åáéc}€q:ÛðVw„× l'ÁzÐP¾"ûîp‘|ŒÎ’PRÙÙL©ÉïμbkZÅÝ¢ë%.â\Ź:ëHêà&‡cœ vt¿Y¢IŽ“Ì[ôoðbˆ¼¨F Â=«[‚\Ä=ÕŠ5¿_‚DÝ‘¯Ìdá8xCÿ|ãg a™ óÍzu°ymòCÅÇŠoÕ)Ú ù9ÛcŸõbÀý«Jå²Ò>îrôK=©£§7 "γOà‹¥ÁïgŠ!ï&öÕKF”!CÔ)ôA¨iA7ü&*EZOK4PŸÌ(Õ\Ü:J•cÎß[”÷ß~–»o/^ÎS©ÈØ.‘Ðs†Dv¬ï#“TÊ \TûÀ^MÊWØlrØ[E®äTMÝ[ä÷ß}©ÈÅ)ÿ&`ùÀ•Cl~­Ð劉{‹ÜÊü÷_pqJ)Ù…®<ÎÜp$[À윾9˜mÊ=îÌŠ }Û`6Þ0oó\äþ÷_*œ»K,:Q‘׈Á#‹y{ê òÈÆúØÔ¼¯ î}© †é_ñQÖÌ÷ûµ 7ò~oÓ`äZï+íW]Ž÷ë>+h”VAÓëoå_ð•J³Û{» ¡nywØL{|_¡Y™ é´€A[³…àÞp›¯²§4B­#’À£…¿¥ö04Y¥3ŒÚØåã¢LÅS—É ¨2t¤bîîì Ý<­Xð\Œdg§v;é=³VFIïnyr˜´µ¶ÉóNZdÄšVb1åY`ëïJÅG9ⲓ›Éw0J“ÄÞh@r=é‚A\ab¡÷`»SÜ1@¨rH"Ç0Ü;Þ‘œŒÏÃfiÓ£ôZ~>šwõñI»ì‚ÇGZ¦¹=ÄXÝ fUœïžò ]žžUfŠÃ‘¦øÍ4ø²>>›~ßÕÁ§ÓàOuðq}ãï]þ3##¤y-3´ Š&«•RS—NÄGпZ–ªœ¸q•´¶ÓDÒnvÂ1ÚVŸÉ+ÈÚ;â *ŸS’H8¥«€›\©HZ›âÃ/AüÚœ ávà<”I&0CÌXÿ®Ëš¬JÑ2e]ÜïI mD>Ϫç*tn·©È±Lu“á}“½4׆L¼e~–Z 4\¿l{R/ó„Ž,Â{Lì!è?«£uô´®ÄE ë©Áb…š”VÚUæuÝî5>[FävÓ=²¨¦νN $?CêWKðÅø‹a®“ÒÆ ØDc0TJª‰æ"¬¦4Sv»ï‰JJ3©(3¶„)4dŠ«©õÒ·%¼ö.§)ÊfFì?®.ãñD¥{'Î2§jÚø„†)¯ý{3Më!^wS2{4ÈE­_¶³´ÏŽ~òËväp€üí(¦y±É45öà5#O4îëCò1Ò éa4Å%Ói¶$×$àfRçNG\mL’]Örñwpu°p. iä$ÛŒÒþP¥--MÉ)µí|4‚X^Ó«Šä×m­%`וýVX›r–.ƾ®s¡wý,ß&uºûó0•íõwð8‹ÆXñQ@O²bÄœßÓ5`.µÆ¥BÜpŠ+ öŠsAÎÀG ºÊrW¤PYÀùçíxªþ Öi’ò¯‚¥íŽW¸oà8ÈפÈ/£~GcE‚Œ³–còÐ?Í{sŽ¦èöÆ×L©¨/_Ý[1¦“LÞq½ D|0ÛlîJ¾1­–Sç,u[‹þgÖ,ÊeiÉXi¤8,_SÀœ.7R+Ëÿ涜'­-Ëü&(¢nøZÊöv¨íí¦µöñŠ'Àól4¶ng"õGküh;¤)¹a{w>÷|žÏ@7µ¶Wü¬;áW{€Q_%qçJçO¦»i„­õé¥nîDzNÈø5Ŭ¬ÓTpØuKk  -Ün© ~øANÚãÇÝÊ_+–<,z²n/fD•ÄJ³á-ôåXÈaà„/ZÜâC—YÎ.¥b&'£f´5¶h¥ÏÒwhÆC¾|VG¡g÷¢ŽBÏî] 5¹vg0Ÿ†<ýÍÚ[‡é~¨¿ë¹¹Z˜Í=_È>ÓȲE¸šÿ˘ÄIr•õ÷Ü+éûí÷ ˹'Åúòà2€1™ï|LNೋ‹¹,IŸÿœUY—+÷’A‰pŒEÔyﱧ#Ï™ùݬ‰Ð† l!üJ×ó}ž gGŒ³¾‚Ñ!õÒï6+c¹¢KâÀ¥_{¯9I@nõð½æœÏù0‡uCÞ‰âò§OÔÑÌjµšÄtš ½vr–A€+»¡éÏ—¦ßGx{PŽ£`9ϧѮ ØÚH}pø¼Å1Kv,;.ÿ÷G+'püƃœþ)w=¡Ý¯édôyeçUõ§—Ù‰í”>;‹ô‹oõBc›½ 0e–AŠ»V‘Í1ÖN1ÝùKzŸÓô®»‡sßö©† ß×f6ʨBǸøÖf™2Är€,I´__\cG‚P¨gŸjaè”û^ïêãÃé÷óE¢)M#œ—µGkׂM{Œ ¸›ÙÁ–2LÌ« (!0ʦS«É¿¦ØZúgS Ô½éŒdþ]ÖT ¿Â2bìè;ÑŽ¯ÝPš6•øØÐo‚MEøT•,yçMÒ¹,ïšVùãéËÛŽ½QÑ¥.|Ý-ˆTª™¬cº=òÃÑÿ–endstream endobj 48 0 obj 2922 endobj 52 0 obj <> stream xœÍ\Ù²$·q¥å·ûŽð[‡_Ü×f—$V*ô`[²¼($Šš'Sz gxGË ErdÓâø ü‡þŸÄV UÝwæŽä˜˜¸]ÕX‰\N&ýÕI,ò$ø_þûüõÝw?q§—oîÄéGøÿòî«;œòŸç¯Oÿ ð(Õ"•p§gwb Þ’–i(« §úΩ“3n öôìõݧgy‘‹wÚúórA+rDᬺ×ÆÐù§ü&hLqþÉý“IiÜù‡üVygìùr/g‰üùÇé¥5ºô"Ú>ÆZ/Ò«ó?ß‹ÅiM¦«L8?ã·’œ2eìGx+Á?ÁG#¼òüwø(ò²ùçq:ë­úå³É, c³(1XžŒ2;\]wê¥ôIºEI£¹×E:]È-¤ž½ˆü“‹•‚deŸ32²O¬ÆœúZ¯œ=^Û^xã‰,H._ÿŽ_ZòÖµ¿d^Ù…¬¯ð–´Súœæüû4”[ãø"ØóËÔ,9½öù¬|ý*uQÖœßà9-ÃŒI¤üýñݳ¿ùôüÜÐdÊö‹@,AaµheÀ÷_ó[ʃ°çë~|ŽJzIRÍe`â¿ÅVž•‡³B¡1í!þüPŪ™úU;I~p^ÊŽ¾o Þ{R¾'ê‹f¢—‰Z"Ó„*dZ«mÉ@¸ÒÛyª½0<­zòŠ‡ÂÙL„Ô¡ `¬¢u€¤*Zï’Þ ÷ßE]i¸ùë¶cCD³ˆL%«SÓàuäxðÒÈVáyûøìîgwæôÍ]61§½SZÈô¢sz}§¬Ï.>¿ºûymûÛ;ì¾[œ;«Íbcka¢€7¹¹2Dؼ´èßô^Ý=”I-xÞN u(“–^V[·@5_ב­bGN“[íËä}'žŠŒí¦"’ÃT¤•‚*5S‘¶»¼LúiT3÷Ø©™ª²2OÕ°²ôZXF^ùU&¯,;Å©º¡g»¦sk pü,)ZžuH¼ëÚÇMêÆœnR~#\€?ãc~†Y‰d=õÏmûfŽ<ætwµE¦¦¯£Û’íÖUGà9ü°Žü¬ÁV}RÖÙNÀÀªãûºêøô­ ˆ·ë׺﬛±¹u~Vp^ܺt–Ýز´.Sç¯}ßÙwcו¬¼(Ï¡[‰Õ¢™-?­+©_ë¾³nÆ®+±äº•€ÏíØéi]IýÚ÷}76Ë/u{RŸ[‰T»'UÚóž‰vOH…®syÌ|«Ï‰­kgÙ-ËتݓJXéLÞä7SËÖ2\fz‘ï²'…˜òu"µv.¾[Iak휘^uÇö+©_Sß™†=¹†@aå&ð 4E{ï-›A ¬óG÷Ï~ƒªÏª¾²€¨B®¯¡¯Ndá@ƒKxëKöYÈÐéY@-à›ãŽw³ áOìî >»°éô2ºNÐ@\[?vtu8úeí ,¼òÞþpŽŸDaojoEÓþÅ l³H?` -‚Q4¡ß.µÝ1[.Ò0ÅFJž†è~e­£[œ ¹ÏWL»%¡bì °R8i†Jh:iòÝOˆÚQ=À“‘×ø·õÀKÓtëó¸¹ñoͤ0z¶ïØ;€n•ª °ˆdQ¾ÀÃy^Ä™xHüŸB 4!ÊÁpº2ä5ÆL†–@©¼Â[y(x“…¨HÔã&¸¢Ìü™—p&Sfo 8ņõ}ÀuQ ì‡Y¬"õÈ‘0"Ð q¼ÕH%`lÓÅ6mpµF_Ûa?ŽyŽ^d¢à‹Ý)š!ºèä‹.®+d¼HaÍckž]J5 c•Ûg˾IŒ0’ž*<âh[Éa)¾µÂL­%m¼¤€¹l›·Ðh9‘ ¿è¨’o‚ SÑà> ôýâ‡Øê/¢±}Ö]Q ã0A4Äò”V(V­ÉL™Âäv­?B` fóIk?™\·“sŠu›+ųV½šY½°„hm4k þÆ.ßO¶/È9·Eò~‘…'h-œ -ÌP‚$ÆoHÒIÑR'ö¯P²gÿüÜþý Úà'YCi ­ÿæNj‡åy!ûp å™C˜£”ÞPa4ÌÉA ö)cÕŠéŒ]ľú•¿Œëñ"ÌÖã²,P4Òª®Œ`œµ¼1ãzƒ 1i|’ÛvTsÉ+uS}ÍkA]óQüRÊø€³€ý³l#ü•Q8l­“‚‚¥†ÿQÂg:ð–8ÿÃr‹öÕw¼8R—Å©Óà^Æ» §.]ŸHöëdˆa]Éã­ìxKã„ÍíÉ {tRÙÅæ†æVcƒLÿQ0Mb©Öð*ï¼"=YEŸX›¨†ð©²UµGx¦nQAëg*È>š0žóU¿Ãdc´±@s\Ã;»¹ 'zQĢˆq]ÛˆOúÝQQ¬.]ŸbŠOè5ä,ñâv¼„ 2’6!©˜œ2[ÏN!ñ¹EæÈŸ³L!ÖónÃÐÞiª{†þâ=º2zªºÇµÿ_#‰ž0 Õk€ú‹ûq‘¶ó]i›$œ:±aY‰ÜÈJbC++½€ –+¡Š^@n3_ƒÒÃÚ0Øè:–ιº?±tF;ùöÒé´ŸØßÝP‘¤}‘âÈ=ÿiä>•´['¦êi¥}‹$Z›¹a¸ï7^=s=è‘ 9dåÜ :ê*‹Q(HMŽ ®}=Èç©à  FÄ? Œ#…½¶î£>°`ðÖ¬ÿ`ÄnvŠÝhÅa#Zݘá8ø¥ëSTZS`†)Ε{±c„Éù ÑÉ›±~Šyû+Æ®ATÙSfs¯:X†IZ™ÐŸH)VëÌÃAvq|ÌÝ‘¡ìÔ"í‘õ6°!Œ L‘õ¥ç#6¸þ¡»Är–0ƒ°Éz¯ï ‚I½»-sÔ±Æ7<®5S½(ÑwgÞ&üõÉÄ'û|]$‚B²ˆBfs4¬!:¤œƒ†ÃÝ:6üi½Á‹Ô[r'zc’ ™çÅÈ#'D}>#ø´=ßïScñ”=¦x¤_¬Óe0TޙÒnbl9#Ò©öP¾}½&²®§Ã¦:.²²59e[ÇÁ)',S `ŒøÉGÓ$¢…JG`]ÚïåÑ2…ÊjnÍY8ÝÓ$þŒ¥®¶kCÓ’K:¼‚ˆÉm6ÇS÷¨¨|×Ûj‘à»ú‰¦*"îµÝç¿Ø. lgo†i’€œHDHg•é2ì*Bº{™Éì 9zÆò¼ØZÛT•pòÓs黿K¯¥êûM¹Õ÷_Q+•“ÊïLج33#ŒY_ì:‚·,V¤„V}nxviñÀEëèÿ¥ëÓ°6¶åB·+ þ±owuUW(*Wmßp$—4‰©ssŸIBfš·<œÜ±¦Òì ŸíYf¢dǦ܆îfë\¤¼6ÿK ™Åø+kÖ5·¶wÊrÛš÷‚›ÙšwCïÁŽ^ tz?.&~)Çg[`öľš*iø¨àðùŠÆÁAêáÕEEš :vtc04€jцŠ‹á®DÁWèxÿç¥ÃŽcù‚ÐBa¯M=7=J‹ó®Öïv¡?R.ÍEe·›ù–’ü®u(=% P›?*§s•–”¾ñ {Îxo玬 —@™Cryœ¡Ñ{Ó³C(8ùÀµ}5:•Ö‰\ÉM)¢Àèt¤ªHÿ[NÃg(cq0,‰Ózr ¼2¾PÊÎRªs¾_mÃÕ²¤ˆáùÕnÙ“?ÜâD—JLS fåmªµ‘çÞLˆ§Ï·æšk}Þè¢)V@]¸¤sí71jÈP[Ë&âjb‘‰ó×·=*H+¯á\Ãôï)¶¦-$èÿgºÃ€P¤Ÿ éÌ8r|Ÿ€¨)³Va%;72äTp†€¼†çÞT)DÆ Œ²)ÝhÂ.øHœs¡©J_»ü>¯ß>TºúqáÞPáß‘ÒÖ™Oƒ¹ZQ1åöX:ÿYŠI Á¾š½W‰}Fnå ÔREtþ3ScJœ–bÅ>€gœ¯ÔoÈŸ¿][lE%ÆX]ðÙ‹'…Ü0Îñå„qiŒ-ãš{1jë°Ì“Õ ìæ:F/ÊBuÑX’àÂÐm”›«v щ©B{Ý NÕ­îÎÅäÚë"ú¶ðõ¡¬|Ñ#Ý "¾ÃldÈy˜·!áa¸¦1øûok¢Ò}.êẔM$È¢Z&££tFl¡çUPñ"É”ˆF^wë²zMã©v³‰P —\®“eêg¦a7øá3X=ÿ`æ!àDƒ‡.ÕN 6DO‰ô±IHJ¸k:©el<ãWš|/ŸÒŒÝX‰f/~•‚Häd²–®ú臌ÈèÆ8²êh̾|Z }À[ /Hî0gÉõDÊNž//ERc†ÿ<ÉSÍ ñM¾Ïx,,rãSx&IÀ|›« ±¹ª5¤Ø¦>áEJE3ƒ7©C'RŠšIs3«ù^ÜÍÚºuÁÒ@€§)!FÃë EiÝ¡>–(|ݳaXñoˆ…4 †dÌF¹H¶òË™ïÿ¾×ä¾(جúU«i¥Ÿè®°UA IH\tüY¤Ûz©Q³VçÚnÓžª>.´D½TÎî:É©Õ/[ëj«=ÝWÆž¾h4Lµ¾ë­BÖ™)–}“¦pÔïk¯¢e†D±4Š'€µˆ…´“}à·z¡Û<Õ;ƒEvÑþ=+gä¨3-R¿gw\°§©Øs„L\^h§S0d›š Ç·Z¡‹¥X÷Ræ\¹ÔHÍ(Àc¦q¯ÿs¨4IÇúí)hêÉð©ÍÑQõT ü‡O׈Öa&šèöâ8» a œòzÅú:Öu%Û½5Ü—±* »_~þp¯8u¡[ÿØžÌÈhËwŽ¼&›¶ñ |t#c¹ù,:´ÉQ»Û³´=¼Ù‰À¡Qn±ÿLeÀNÉCU@¶\ªÐÆÒ¤—ôvú a½I}H·¦äШGÂâTœKHò†ûãa»³7ir¦gPHÎœD”ÊbM Éä#sĘÎJŒ 'kT½¥¦«{~´{øC5gÉF>öî0˯k¬pt}E~UÉx× Ø,¿bÈw´ÙE˜Ø­9¯Ÿ#N4*»8g:Ç:¿Ò¿N7͹|} ãB‚€À‡2KægгÃïVLέ£ƒY%‘'R˜HÓ°dXÆz‡Â§þqÅ÷nvÉš¥Ö=:nåuÀ«`µMq¤^lXár‚ÖP¤´.E—¢Éƒ¶w…_8 ƒX.óÙ6–dçç>Ï•T}ô•W¨1ÂCM—ÎÀpòŽ– ¢Å=M<>Wï½Û-ٗ٥¯yÞ§Iw6yŸ.ÐÜ$Ó¢7í¤êÐoì&^³€(ÍV¤M”>Ao–W[ÄOµò–ûjy×Ëd—Êñiîüi%ëŸx\)‡ÄÚÇü½'¬/ýúñ—µŽ2±®á÷9`†ÓiE*=HžCa„p`4Î;ÅM»×÷Ž jj5[Ïñ ÿ(‡6Dz‘ħÍÚ§À ¬Éç&õE@¤åµHÜãöócƒÞN@ucÞn.'bXV“ÓŒ1Tïµ[ÓÝZÛ]3ü’«âoðlÀ áC&DŽòçDηûÇÚcÜ;šžy®o;×á>æŽd1ÈÜ>ËöH Ι,WäYä´ƒÔñ¬aek“cjK“¶¦l¤]Ä×=¬kv:ÞÄí s)Ëw~¶4Ã?¹äk9é_ßóïO1lJËÆ˺1罹hxÍðùÅ+Ó)bc„çU‰ó€fWi9é#!ªÆ ´¹áØKψ])®ßÄÓ|þ«ã,–Y¬æw½:uÛ¤%öÐû·©@1 ¿95…kk\Ñ«v¬p”¡q} Z4ïe#šó“‘¦AÉ-HÎgÁi* èÂr ]²¨$˜ ¤¾›ìғhÆ\ …6࣢½€äÃTbÂ0M{€¼}Åè\r>&æ꡶=Ò„iIáÒÕÇë—ÄP$>\£0©äZtðì&·:¿ƒÏÎÁRLX|Æ=]¬pMîíÁèÞ¡²õšÞ%Ãu¸Øc‘MÅL´Öƒ PÓ+ û» ‡¢ñí.4é·ÌµMðWs“Êè™ÁË(ñÄ3þ­žü¹Úˆºµ—Èó?¶DÈCÈÃ?Ø£&¢ Žl$•ë;éš²u®SðN%ws…CJ¤°EÜë›r J,B ž´óƒ¬ü ¾Ë¦S*ç1U³É³}Xãóp0 ·æê¬9b8:bÆ^„xöŽ?¶ÑêFÂouñ=BáÆ­™µÞx*~ =Ý¢žg"¬Úƒ«³ÀŠ5J¹X12Ë–ìÀ„f‚㪜œTLuéñŽ|]KqŽä‚î0¸MRzÑÆ* šyŒ3X¯§ ¿Mìã|×®/ÝK­Ïøi£%\ãà㥪ŸÝý™í6endstream endobj 53 0 obj 4938 endobj 74 0 obj <> stream xœí[Ye7†<ö‰§ûƹÀ=Ø.¯D<$“°)R ´xI"fË6“d&,áÿò?¨òr\öñ¹KwO‡ h4šÛw¼”kùꫲû«˜åNПüïÃgW¿|Ïíž¾¼»ßâߧW_]É8`—ÿyøl÷æ5Â¥œƒ1jwýä*Í–;§vθ9ØÝõ³«÷'¿?ÈÙ;mý‡×È“Ô,•p4IÌÁ[Ð2íoµ“a·|fÕ®ö`/g0&øéw´®”"¨é½˜E€^NÄÎ(i¦küÖI;OoÓXå­ÑÓ{ûƒ2fÖø­\$›æýw£‚KRúÑÉ´ ³ö<ïÐÂ+€é]&Å»Dqs…;^寧C1¶³õþ¼|¬Š«2À;æv»ëG(K:0ÐÙ?¦óH§I;÷jV2¨–1š/£µ./.ñjg¶ œíið¿‚×eðOQÕÁz«¦—¤T? Ó'´³ðÎKé¦çø½E+á¯é{%½~‘7Féṗ½ íh/›>ªvä»|õ§•‘4X¡Ñ4x>8/!Œi¥~‰›he…‰ÂṞ‹¯üM5җѸÚ9Ý®ñ×”?ð ?ç#š¾!-¨YØ0=!¶ ,ʇÞb¼Ôå(—{–Tªp¹:2›¸9RVjH¶¢åÅÀ·O>Hp!ïp]¶/ûv¢§UÇ­@K¼Ø“SÔ3Ægq¢è:0íÐd0ù”TÑŒõa§óJi¬É qÎ(ŠXVãجãl°ÙX òÎ#¹¬ŸÉù¼ìºÕ>81 ¡3@ÃŒ¸;H7ƒÆøŠg­NQl ÔâÈb1¸5f³3Ü̵yÐ<"­áDezàHUÙ|=Œ%l¤I9ýÃÑ{Ê·¾ÔE5m#qø£Š·#×l–ÈVCCl¹Ðhx52.EêÇ>¯ à'Úðq:£CÌ|§ =öpv6à9[-h·FõpÀ¸.YÇDlV˜Úv×ï\]ÿì–”÷hŠÖð,¤ÇhÉ'/”Fµ´¡|ÄÙ=­YÄp[È9J5h†Ù-™æ=-;J4D¼X0"A€ç­Ön†¡Ëò©9…W*¶;Ìá·À±~ÆÄn§g!äXEr³Æ˜fB=cæmÆÿ¢µe/%„«©óM”G!#³qüО]µ`|§g·BÚöìêò³#qšÔä.Ta^+‡ªpÙÁ•zÈú¼ö, ŸN¦mVWA!Q+0Xo ƒáŒHÿ¼uõ(¨Õ¥ˆ©t9ˆ^£!å—,Žd‰Ï˜Pš‹ ~”θÃßöäf‘+i@˜)}DÿcjK¡+ ~d³%ŸÆD…4C-å)tÐ’“cÎAy«æYš*j!+oPn¬U–“þ]õÄsOG6(¶u<˜œ¡ú6 ¤óog‚s;Ú9ɹ­†žž]ŒÓeø©¸n#ÓÒX ï…ð·’ѽ ˜êÖ1F >÷+\ÃUÛT7HáÑ^Á7YÐŽLc\(óÑÒŽ€`ô5Žfá¨È’¸xÐ15ÑX«(5‰<  +‰Ù:«MÄn¡Wx‘ª0ÄúÍ3`lF°å-UM0½V~FŒ©W@ÝØ2 —ãB|]¼\¦ô®ÂìÎÈÀT¯x×ÆÏ°c–ÅÈÁ™ø‚ûcÏ&_ÖŠF,°.&ç± \ÔJ/;öm©º MøZ/ö³ǘŠkþdþà°T ‡1¶?ϧ±2#y3ŸUQƒMAÙ¡P "9üVªK¦ Z;læe½rYã õYµfü¦rl-¬ãÀœw Þ€oÒøÎhÇ3ëqBZ¼È*>â }«1Ò8çmì_ ­U¾Š«r)¨·™JZ9^þd>én]™³dc]ÀÖ<ºÄ¡£„­ç¨ÇçA©€J/ÜZà¾àªk­¢ÃztÓ“ÑÑ8%z‚â9 ,j¬ !QXS;’¯2dcâpÝI»È]#æ™[$æ±ô …T\xØxrõ±Ðܧ”à 2õ,{ª‰5Ïá?¢½}8Ó÷Dö„×C&Me82…eæFᶰ”XûÑG/Õi ÈÚ.1²ò`çMY$u¾I‹ Õ6 :QÖl‘Õþc yŒc–˜Ev‚\Ï6ý­2´o`¨€,Áv¼…-Aˆ1ߌ:{%SÆÒÚ7EéEµ*_›æý¥ Lí^>Sþ_h– Ù’«ß†=WÆhúp™Ž¬¨ØöXAOÁáàcæûì<ƒ¦RÊ<)Áõ ¼­Á¸w³ÞÒžÙ©«Y»š<ű|Ÿ»;ÜO˜„_çö RdÏ·Œ½cÄPòáSvTÑr°¯(ªo;Ûið!õCÕ.;Q§/&—O_V% ¨TP«©áÁ;Ö”¡½6ºa^šÇ£dtÖ¿jô»ŠHòmÜVC o«ƒJ×Z®Ø[ç’´ˆ–öæȬ‘þKm^u‰\»}”’’x¢ê*t 3•³`™ƒµZkv¸ æ’QÅ–$>­bϚÌÂUà|²G7ó_Ëžn‰Ð侀º6qΫHy9šh\>4ˆ½Vina¯p>13‚ ˆ-;ËTÐáð¦;½nIoôŠ Â9T!}Nžs³ÍúÀÊxét¬¯è ÁÉ"ÿÓÓïÉc4ò@Ÿ¶²T»ðblØ›>«1ò’¦AìÊôq—ƒHh |1ªÖBÁªSÂ5Ì|KîÙžÅ7Ëô#—öLç‚ 7¢qz¶ä¨gиx*{,zþÆ|—µ¦ÑtÛ.ÎÔkAÞí‡0_î‚@/5,þ6nvÉ¡‘­;VºüÃôLrªãšå©%UH%GØÐ^Fqÿi3+@Gý$øQ™\Èë7QZarʆ§œÆ––°r£”6µ1'á«£|0-?È´“!&ñgŒÜgøƒá ­ßRD Ë DeõôÁ~Œq ¬ÿBÈTž¾}kOWu¼( uQ¨?\.„é:Á£æПXÄÆ_ò[0› Ðkr Msý§^æéíâ6ïRÇÓ©.&îÉR,…gíÆ7·_tËCïN¤ÚšS$–¯‘1•mÛoM£e³\CKÅ®äX<¯oû~G³Iû÷¬"´Ìr€;m¤-\wüù³p56{åÁC}˜N •y˜ý%„5@¤9ÄÑŽ&I&UçV±~#IoåúõÍBçY5²ñN¥î‘T ƒ‹0ÀŒŸ~SµÑÒ ÂLøGnÊ›->µFÿªØ nÊÚœ,ˆÞ{q¦_k·¥©aUÇ{‡/%Îij o¥W×åä±5D×o8Xß EEßØÌøÝ\zq4±–§£÷+´éÈâà¬4bƒÏn¾÷hÛEæAÿŸy—u9†ì€ ÙøÓF¤ð#J–v?½G•ÜµåüƒR(z£Â™;Œ¯}{¸Í Óx¾Ñ"¡Xûó×QI:ÈñÃ9eKW1*7škº*»ÍFr,dãp±!v+G©–µûç'.Wû·ýS ÇùÐôúþúÓ«Öcš¬p@«Ôì|ÊÝÆ«‚Ƹò’²5 æ7Kš¾™aN6ËϪ/V⣎«],j/TÃÓËø´nôótz/‡î #ßS­[­ÇnÙ]÷¯|áVnÙéW'IW ÷rÈ8öl;u Q);­"PL´‘"°$â@yxü ¾VÒÃ(Ñ—–oUü¬•Fì¦Fz·h‚L¥UÈ+ •þÙ×·¤^ŒÞCÄ0¥U…ð•%="¤Qúr¼Ãr™È¿˜—õ,bcå M¹øO¡ô£4p {#œ€3B|—$7ÊòF2•=],§ úÚ ï:ž½ð$>b§L-±¡Ïi,EÁNÙ1>D'Ù¶ãv¨¯Ïß¹ˆîs0Ñs0T„_¾á%Ù×XÞNüŸÌ¾„Ì%™×0DÀI=!³EnÜåÑcŠ=“¤˜¦ø©¯J¹›¾Ž:Ç!XD~+”X $. Ü$ªbƒYÎî¾Cê²ðü·R!' E·ŒÜ¾»m©X"™:]Èn6·Œâƒ5³¢Êë'tuë´ÒC·v±Ð9Ð[I¡wë… \àÖ.ø…hóÂʯ…w“¼°Hh}~G7æ‹p? œ ʺ1úšt ñèŽwm[¾ˆ²)Žçóƒ+¹bèРĬo^W\vøâš {™ú1íSÞ;–¶KsO§ç¦?qüp´ãÇï\¬u?KúQ/ÞÿÃãÞŸ~ë¡õþ»I¸´žV”¨µ`â=úÌì¬T& ¯8;—_]AeAÔÚyÙ9~ !ø0ý5)Ö«!ÉÐdŒ›¥ìL„ùD¸+x.ÊÚ&2ûÎ7ïr»JÖ¶þTÖmiÙ6UÑ9*•“ãÓ@[De×·ÃÒoDâµt9 LÜÛÊ2hÊ,„ˆ÷aô»’¹8›Þ¢ÿéö)ÞeÛódÐ[¼ï[¥›ÑqÏ„vË„1|nQz™~é'–‡9àÏÜëÿª-»œÙ ‘{( É> stream xœÝÙ²71ðx>ªàeç@fÐÖZ’ÊCbR) ,I.¼ØT¼…Ä7±cCÿËЭm$fι›ã¢R)ÏÌ‘Ô‹zWë¾ØÌFÿÅ^~õ©ž¾<°á#üÿéáÅûCüçáåðÁÂW.f.˜.žØ쬖Š‡¥´2Ü ù›ƒ3;=\\îü8ñÙ¥í8'%”nÕg9þ‘¾8… Æ?'Æ9˜ñCú*¬=NG>-¥?5¨4K2W.ð'\@©™[1þæÈf£”„¼¬7^ÐW.€û¿r`Ì™ñS|f•ããûøÈœtÒòògœ¶Züõâ·‘Eø@‹ƒù*v¸Lw˜ªœ5I+gk‡Iš™YƇ‹G‡ñ×Ç‹/i¤pCŸbïœh1tü 1×:ŽxŽ?=NfÁ”†LsF 5þœ¨7w)@–²„,äÌC^ï=n ¡:> i\CºÒ\ãÖ3"ØO|Š€ãql‰6Ì`œv›h‹42½ …ÍR0¹ x58`Läƒå‰˜š(åzñK¿[ wQ"yDžG¸eÌnž‘ëAqøäŒ9›ðN’©NQŽ€2õÚ‰o±Zm»‘ÎÞõ “kâÝ E-`ƒÌƒâ=´ *×ú¬¡zWCÙq’³r–Ûô\ô¿öPœ¸T´azVÄùr“‡ˆf‰w„¦ Óm¢5¹?Ê 0Ì0h¦Ì,8È`ÐTe‡Yf0ÿõÜ° t‡í8ÇzîMÍ+íçüƒ6Y3ÒŒï"óSÊŽ_ÒWÎW®ƒqZ€-Fm/I~¤B[ÛFLì xñ[$'Nè®Nqˆt³ö7”á“–«R¬¯p4g TŽž™×öNd£Úí ƒ~Ž y]8¸1šl¬s§M$'iz†b[[#Ùèï Ú£ˆ÷x\ìk’ÁKèÿ—¯ï‹®Ïæ]•±3¿s£chÒОâpr1·ÎåPçŠNï `s£`ó®cÅGu72Üpw'ι™9~}¦âMgñv ½²ž”[px¯ÃžÔÑ…‹3ñÁ “´`ĦÞ$LÌ1OEN¢•\SN0½Ž±Ë'‘$ò6Ç…»‘¤0Ñ]!’T>Ÿ!’<'Œô‚ŒSWˆ!ãWá`ü ¥ƒEú(³n¼ô$GïQ¥±Ó¡f£B‘ô)»»”p´i·á w=AŠ»¯©Hõ’‹!ª…=®IͲ™§l¼œyQÍ8³„RnKdœt%m+aª€¢6‰Â±Œï u]h 0­&I‹&ñ)ªXOPéjü|)‘=#̘5’aÆøŒF sP%^i1`r|ˆO8ˆÞ4˹)¿{ hÔ@¾öZe(·ÑÔe9¾¢¯‚[`v|Œ@ðÑÔc$¾¡Å>sÁí¬q‹²]À‘ªRq ×t ÇüÍJ«Ç›…¶–Ç)È°9‰–<)â:`* Úd¡p-‚)¤ÿI…>ä ƒ4VB^—P)é«`DÉÆ”P^gP+qíjø¥_ÿÜW •3®Þ‚Œ¶,ÚG>"ª%¦a;N{t$¹C)!ͨ ‚PÐDÔ6jiš¯d24–´m‰ÉþIY„ GŽ9Üøì« ž3³”Ò^ATaz (ïüÛ8Xã¯Lm1:rŒvzü>cÛÓ<Ô%Kš×~Ÿ<³LuL¾E¹àè{þ¶‹¶Ä‹øêíPÄáº.ÙƈÊ(~BX´4]\l“ˆ½I¸´^ðf¸L Èa”šT¡ ø€ÎÁÀY¼1Jœ`“[!E'ýŠ‰]3h¡&Ž ÒŠÇ׊PŸC„[á¶Á,4 â‡ä×èivkjVÊc¨üÁO<ÄÅÐŒ‹IeØF©dØeyëƒE5ˆøo"Fa8IF¶´÷_Vð1®j0@ë-šDÍמ”ŒgãIi¥ë{ÒŒÌK‚Š¡<:Ð/X)²§ ƹÁ]=ƒ­‘Wá«F×ÜwˆÅØN`ègñš= GáÏ74ÀÌ ‰ïyALDE2éÄ®Búaö`‹N´ 3þgA( iŒA 8¨‚ÚD†H €u0åÙùˆÐÄpOC¢C+­×Ûìf‘*ÇP܋Є!'FÁjæPqDaù(\Þ{™öÞ`²Ì‰,ÐÆašØçšÍÁŽél~àu³ùûÑk³ùB陟¿ù„þ«årÝ%š+Ø^vÎbx¡˜Þ †:bÆ,¬Éèx¢1R°–g“lˆ\ óªà:ýþ˜ð€£¾û¡gAÎ:€[1ïûÂã~ý¹8žþK`5éYŒ}&Ô ÿNÃqé–6k`|º„‡‹üwl„—ä¹õý(µͪÒñT;`1)™Oµsc ÷â|Ë™IÏÎátDíÀøÛpÚDBc´ÛR[aI¤åÏÃzZðrÄ+¿†ÅŒ‰˜’Ór ÒrÒ@l‘«Ìz!qaeóhm dT8Äp•–V’4<|ö‹Š¿Ç¯¨µõ—Qá”H8SŽÐÐ’U žô| š j_||¸ø…Ód Š:\Él±ïL8²C¿Å]?Å "ËІ¦ùhàJ}B°–²Ú2Ý{B_Q4œL“ãFÔ’Yy€¬!º_•H.ZKàŒ´íbø]ÎF¨]‹C×¥•‹ð„V¤lhegÁxi2)ªÀ¸Hý2j+ó0 fM©"¹Ù¶_¸/C!Å9d”ùeq™£n8~o4[òÄÏíÎAí?¿RµàÓõi»•â-–% ˜µÉ+æÏJè”ZŒºÖ©Å»×@f“âÿm¨Ur¦7+1Q-Ч ©RÒ̺l-ú¢p«^›¨¹§*$ `j×\êÍ´í‹Âcc©EWe2HNÌ$:­L §©£jSŽ*¦¾ ÀõýH]*Ýyrÿ* ‹v+åô«ë]©|ƒ~Ô[îz֨›ã5]«¼$óT£ÝÂ: ¼øj^[ºá\×ÈÄÿ;8/.ø–4Æ-¤v´2`­…M8Œ§´¬TwW£ ?í—+a/KwkÀηq$JžûÂ4ʱéga•Þ=§¤ç" fVc<ÖÍ$ZSâÕUI5›&îìŒbΫŒtþ *M*6½V°Sqð>ã0?SÅ¡Z¨i# W9  ŽÛR¶™ÇâQèÜJýˆšºâ^à„‹Ax`Wc$µÖØ=Mˆü®í®‹i…7z©MK^'z±L¡G‹=¬L¢A¦fЧQ»‘P+ÐTÙ͘^â³ÓÛö3 1%>…E*u–¢¶‹6²àŽfî8רìÝz(×óùzÜT‘Nè±)ëEÆì·R;äÅÂÍ ›¢ËöÅrÒÖ$“BùÓm0!—uº™øÁ1N2'(Ú ¯À$Í):¾GG…KFB¶$‹‹¯üóJÊ£OÇ*.z":ôh|rü}™ý*/%®´OÛÇ 1¿ì–rÔSÐn]­× ½ï¥àÒ³^Ÿú|3Ë.[GX¤¸kʽz¼³l2íÛ‡‡O0|wˆ=êÃïÔ”L­V!C‡ËƒÐþszvø,ýê€ÛÈŠA8°˜ùÒhàä^ñ Îb43ÊŸñ –hÿ¥žõìð$AU¬j3Ô4K:4&ÂyXae‰ª7[åWÐ1ƒ48¬4‹`Ip~maI Kò;Á’ CYŒÀ„Ò¿£I¦ù]³ø^Ž÷ôT\ëÒ¿(M^˜FP ßÑNÂ\ƒ©ßËñžŽ ïÞN âƒVƒ3d¿?”óKG_(J¤uz[@ä…ÆàÌïX3«¤Çnò Œ:]©XÈ{fð˲2!x=)€‚†uñ$ïðÕï6†¿ô{&Ú¿=$6Ò‰Ôò3¯'óbmßeÚ´ìç½RÔpU\ZþÕ¸¨öúÛú g¹<òÅËÆΞmíÐTÍ)Dd×Íù¤“2r3½N²à®h£ŸÚ¶ä¾Cº§Ý»‡ÑK˜J£•&´feÙcïG'oëö¾N­,gîÒþ¾ n8oN½ƒÿèBçJf˜Fòk™y¯œdÁ•¦¿3°¾Ÿ}ªУê çzÌøèþÇ5¼L0òWò2Ë”ýÜ%µnŠìÄÂ}Avq^ûŠ ˜îÓPÔ#oRîÆØß,¡”P›zU›×·|lÃTnx\ÙzWœ&ž@¥±S–ÞÞ©•×¡ˆ°eå÷H!wiÙG) A!-?˜ß¹+Îö;w…À)¿¤bÓï´U¨ÌÌÆe éÿn7yù„?X#­ Í’Rrfë¾Ï¶ù’+·Îù¤ÖE×â<È[I‹f±ÛýRܹOb]¥ãᦊt’•®#]úöDå æHa@·mM£îÄ¥öJ×»ÀCw™]7‡ ‰»®D?OÞî¿,îäàƧ†göG‡-Ý9>ŽíȆs:¦Úæ7ó‡êK;hä73Ýبäw÷¬»è » A™õÝ¥Ýã^ÀLy@™ã,H[õª”=ÙS8ò±mOŽT”©¢=þˆÕ=Á1íïLwý•ô5óÊ]e·ÜÀÙIRuËþ=Ïh`¼k6¸?vg'HWº²3)P³Ùr Mç •3bÊôC5!C4]w¼ä›?g9÷7œäVq'ù¸µÇVj»…Ë­¤¶—GV—­æP^D»šº#ÈT®;sÏ,̪yÌzNuÂÐ*#ÙkGÏIغ1¶—œµD{ˆg´ FРá4¥ç^­sÀ`¼ŠæÓÆ®Ó%‹µÿÀ73‹žœÔB‘öíŸþGì»·endstream endobj 80 0 obj 4244 endobj 84 0 obj <> stream xœµ–Mo7 †÷´@OsÔ]•¤D‘<¶A´(î­È¡p>ZÄŽ“8iþúRšÙY=iì6ÆÂXÌ¡^’©}3@Äêgú>9Û|ÿX†îùß‹Í› 6ƒaú:9~Ü»‘?"Fc¦aÿ|3¾ƒÐ ,ÑÊ°?Ûüp»Ã¨’‹˜—Oö?OïSD©ïC4-)ã(¥dA潤)ÒÒñ-ÆÄlîW¿ˆ`~ØBK–ÃC7&ä°÷]Áì'‡»Õ–´p·;bŽÙw;‘q»óS“ɨRׂÌl1ëBÏ/Õ(¥t*,µÃÉOÜoQ£ˆËø”qçï×yyLÜQÓ.©T1»T¢ û§®å§pNš%¼ó(‹§Gß52PI€.êvŠìÿQ÷QrÍßy;)'NáƒûPÕDžm)ªhøË_óTK±nómõU%Ø|†ºM8«d†Báu =«”þŒ·u™¹é„êAÃïÇr¼šÄ  gƒÖçõxŠPÝyRÙR™ÄÙÂÕi¯mÊI žy‘KgL9âBéà’JîMV`!ÈŠóÒjÒÕóÜÕ9a^üqÙÆœ °ˆ‰ºW§Žµ ”Òjs!Å5,'?¯àÊKx_¹`dàCb;j'³ó>æE-§¢¡Û¼êrÑa´–Þñáå9Íusî ß©Çö`W©1c5Ó˜’ 5]£¹woŠÙu-•Md˜Í¯ÒÕBy:7çš8J1%Óÿ­°_Ò¸$(kº±Ä„f«º'нm¼êÌkÉŽFÏk‡ôI^«'7µ&â9‚’sص$ªÂvÉrL>_PbÊ@£š¯j¼íÅ:|#fª5ÍÄ´ ÓVéa§'é•Ö­såÂW™Ø{š&G‚þÚ"å0­T°ózÚ[|¬ Ä‘û±4æ!¥ULý¾Šeîê—î¡ÌÐô”¼+”“¹væÙÓ 8{þºêTC¿ Öððl)€^k¿ð>5UÈÑpÎ7‰fî»E³ÔÁ—£¹=%߸g. «ùà–º¶Žæø¨ƒn ãÛ6ÇYd­º9ŠYÁ£Žï*¨µ¾¼¨n7–ëí˜ýv¤Üïγ-ÚdQ»¡öºÕ( ÉZ´ì¿ ±ú_¡Y¬¬»ÿLó5â½5ž—ñܦ–ÏËëï¦J¾ Ó]_ú™}w¿yäŸ9CŸÞendstream endobj 85 0 obj 906 endobj 89 0 obj <> stream xœµYK·rœ ·>öÀšâëCÛÙŽ­u€$ÎAYí®ìÚzXqôïýUóÑřޑ°Q K²«XÖWU优´2“æõïåÝîïãtój§§?âÿÍîÅÎ,Sýsy7}t"LUÆê8]\ï´Ê)82e«@Ñ䩯E;EUÓÅÝî³ÙŒJ‘BšÕþ*˳–½w󧼢“¶yþf¯•Î”}¶óûããü‡½Q/ð95ÍŸñˆW¿dþLP±ñXŸç'RdIó_À½6fþ\^GêLNçù¯¬]ȘÔ]saþL>„6OX–Y%çÖÕ¿1;e29üóâOpYš ¶ö޲NJ¿Íd½WnðÏãb¶uÊ°Ù.»dêØgøŠ/R̹؛¤b„¼Sâ2~¼ºñIߺhć¸ªdƒS1@«‹gã1­ÃÂfi2QYã‰Ùwê0\TÎj×Ø F;Ó9z³²Ö8 _N7¸âüz¿hÃüC]òÑF8oþ‰ }bß_†„ýqe_™^ñA…ƒœŸ÷Å—Lé(ZjLpËüŸu(v}V¸´Ÿ¯ý œý¬žn0ó¿úç7½º$H—X ‹móäãÎ%ä‹áóuˆÓªÂ½¤·«ª¯šƒ¶ŽòP588R¶hQ0â âüŸˆ‰¤¦«ý Elg Ýï™@§˜ŒaAV‘õÚñIhØ)ő䇺a€».AÜȓש‘‡˜u(i`Ô1'™ ¢õ';–u¶ùNjšƒäš\óUÙúVîW'>†<Èÿ^IY»mƒ|°n¾a98¨XäX×·00ó%wJ;‹!Àè3¾_Á Öä4?]at[l >ÈU)êY€ 7 QwLë´6™JÔ 0cë’ÿË›EEHBܪâÍšg^slxç‘ÿ¤ˆ«=Ç’³Š©³T·žL °@OÖÜeVèÖ¹„nðy.¾3Ù9‘=݈NÅE¿ç|ž¦0ë24”8¤ÚòÖ`à¼S£h?Æ¢@n<¤ØØáò@@ÎÙhY47}õ¼¹–pÈù}™Û¢¾˜Û1ðVsÏG½0÷ž ÛAp¨JF¸ä­ Aï8+£_[ZÑBIa+¼d÷º…#5O°SÜÔ‘ÔÝÔ°€j,‹ÚBÿpdàOKÛÈЧQƒåÿÔ4X4s%h’sæ. æ¾3^rþûK3[‚çá`fo¹•ë½E•ç´ÿ+Ö ·¢$KÇ•ÎttU´˜ÉCÿÞáS¼âièS´"‘]o@kÑÊúJ›¦¨rD³8Ð'MqâV¤Pÿše§Lþ ¡¹Lt‚©æM‰1YˆÆzTæuÖŒ¨ã·°óékó°Á!Ó²×QÄ87v(Aöe¿[š0ÊÆo9Ò Ö Þ-'ˆ›I¥ ‘°7;áÂŽúrdq_U”Cð'læw‡ÒQZ¢Hž¼;rSxôìÕCÓŸwð@œ¼nîLëŒi­•_Ë Ýb²ÆFE}g«ù[_î jåûDzme”2.‹DÊÉŸ*®,}Ï:¾Ü5í£ŒRÏKèÝìû7öwƒ}ËŒA…£J6ñÎk·*YƬ—öü4Ü>Æ,ˤYÀ3Ê9ó#ncüïYǼgØ?:ÉèÄž×oýà(ÔZ^…‹xO4H5¿EÝΠvËÝÑÓɸ­˜¶üT@MH‚ð Ö¸ÓoDuTz‰æ!ª©Du2µh-8ˆa°Þ±ò:{ë6’OPîã’]4ânšç6šÀ Dë\Ò·1Ôf¹û [Àœöê^™·üåø1b-1¿] J:où hÁcµ3Ý4‡„=Ìà¸1à Á碇ԱÒJñ[hŽHÛƒ¤—ËÏ.” Z­\Sý#þíƺ¤ÛA"ˆ¹ãßS®wyB’ åß¹„èh6ý0ÄU+O‡ Ò’[K-îwÊ¡ÝÞø`ZKŸxþ¹çµìä…s¹x-¥bÄ{üÖ—<3†t ¿7C ¢Â,žx^0OpÈÎk¯aSZC•LˆïªÛ‰ v2T«DmãæñÒÖ±wEœ¡¥]®Ø5ð> stream xœí[K$· ^8·þ ’S»“´"Qï9Ä$° ø5§Ä9³ÙIöe¬~H=JTµºf\ÛãC`Ûª¢$ò?’Ri^NR¨IÒåßë›Ý¾öÓ³×;9ý ÿ¶{¹SI`*ÿ\ßL^¡6•ÑZ˜®žîro5y˜¼õ"ºéêf÷Ͻ:•Þ¸°‡ùç¿®>-ýA(žúKƒÓFeUœñ*Nó3´€~àJhkcØÿÆUJFØÿå …Œ:ê ö_¢€· ìþ Ÿzepæý'$ ÁY³ÿúpk…Á§LIq8â¬ÚBôYË02ÒØ(LèôùœÆ´ÞÁ´ø¢Ó(M8ãÕAá=ªqN˜÷Íü3«fRFhã’NG<)sÔNÄéêqÝúXí Jú½?Æu‰Q é ©h„Ôöo 3#Ýþ¿$ ÆJë÷GÂmÕþJè`œÔ³DÄѾoÿiolV¹ýS2e ùC“`Â×øÓyëp´7y4p®lô¬ÊÞïuê経„Ó'W»¯vFÀôýÜä¥èã7;+¥sûùîzO?]/J”6J¸ôþ§1]QDƒ£E!!;Ç_ó JˆÉdo¥ UG3ºâ}}tgi"™ŒÆ©`e ›¬à|Ì뀃m ,„“œžwü./¯F¬žç~>(å©AÂìþÛ=‘ÂiÎí­PA’ɉ¾«7¶6Ù ´ŽÁTÙWäÎ6âÒ<Á^¨¼U"U§Î·‡¤ƒ1ó"8@×á/íðƒ6D1´˜­‘ÂR¹;š AÊPeöemþ¼!cµ”*ä1ÞDd\ÁÀz+J»~ÌÊ08ö¥^ÍæŒßÎð5³Óúœš=&; ðTýœ+-6s¹‚À¹½™Ë ƒs¥ «¤î•îÆ …=×èn±N(twÒ>º7eN(\—‰SšS£¼àù;Ëo'1–§Îü¢±õ‡Û8œ0<%üë;&uÜš f®Jñ S¶“~¦ÄùS˜Îs¾"FOk¹þL|pZ ;…KLJŠX/6GˆØÿÄED]§>`°ac @Ê[ª¶á©M’N}òB&5‚ÊË·ÏOÚS:‹0÷r´"8¤ š¦Çš&ºÈ%Ûû2¾Âµeƒ²§Ì@Ûé%á‹Ñ•îÍèâÎå}uîö¾ÀXÞWPÛû ªš—NI~sÔµ÷f§ñDìèh-\4T «ÓÍ!sÕÆÇÛŸ¹XÇúËïnfs¹‹lwÜÚHNΛN‚ {>‡šð3ì Æ+Bj(§lÊ¢Â<¶ØÅÓèÄ‚%ë¹ Y3Ðœkœ[Ö[^ÓùíìrÔ}éxê=“«Ù“m;½VŒ|ìªöölÛ̯fîð qÎèË4ìBP§i83cXER$j>þÓþPÔšî0“ó˜4Zм)Òaò"zÜÓ%CÆOÄû,ÿË$•Ž§Ô©(öTâäÑŽ§%äå»çY£ÑàµÄ$‡Çy÷ïV•6ÙÜFªmæV­™›XÄ̽3¡.y„QÙ“ÍnܺÍìU.1«<™ž¡,XÕJö<•ö¿B…¬“Áœ*ƒÙ(浞²±«õH~;¥èsìJ:Rï™RÕ\N±í”Z37QJ=JU³9Å6SŠYýà)õŽùi9zb!B>Ëßa|oãŸ'j]"N\FT±–å…c–ßNU©Ä]“ßËÉ{8Оíî¼³+v/³à*{Ö텞Л)Ü@xð ¾%)úèâ]’ârdAúŠ¸™É¿¡S”>ùh=¯UÏlÎeoLc2ÊûԱ&HáN]zœtß+•³ÙØÛÌ.D^5{™|“3×·°ÆcŽÁƒ'ò­;OåûOŧ£#k½¿ð  h¹£·Ø¯Ýi)m<Œ·¼bG Äyó¡wº±X?^t®uÃÉñ‹]Ngy&*; ®Ð}è:ÅÎ Š0#tÂ0uÃQ Ž{ƒ¤Ì±ëó'ÔÉYáÐ]+„UZ;˜OY øse>ŸrNõùîê·éÚä”!ÂÓ¿Ö…èŸtÞT½¡yWõ†âÚc¤áþ’{¤ïÓÛ]q˜é3\4Iy y]N(-o“|•ý÷N逾Âd5FKj;dç6øÒæòÏwhyìgXβŸd?ÇÜ.sôò£9j¬ÒN*€ÄÒb2:½W>¿Í­k´?FäÃüÚö;t®g´¤¦Ð1ÕÎ:ò±K ¥ËÔõuì;Ç~l\K ‹µ)mT6%]82Éçšn®ÌfbÀ0=¿6¡ë\›U·ÚÆîÙ•TXÊvJ! çc7Ó+2ÅÊ“ÃB%ࣃDÂÔX—y˜üÑ<ÃÔ¿løí¥¯>Õƒ«S‰¡¦#&–¢Ûåïî³!ûBÈolÏEq¹õŒá4ùWÌþJE½"öè8 Ýj,m2Z#C•­êº8 óCÀ˜D]Ÿ—ÔÇi£[Õ íš»©ü¼ƒ»ºa‰ãåh³»~@HXkÍpO€ –×8ášJðC·p;tï³KïÃTÛá‘Ë©Þû¥+¸'ÇCúɶ+·ÅA¢‚!¢-ʶ¢R M} Ù‚RÛ[¸„ ÂXùzFOÜ  }ˆ¥ŸZ{@ig‹Ž‡[;5^Ë£àþeåßím·¾UúÐg+ÿ~èºmbÛæ^k×…nk£óçåL—õV¾Ÿ]ü¼èŸ­8û{¥RäÏ%}¿ ˜7‘øm›ÈÒ¦÷_íþ\CfTendstream endobj 95 0 obj 2671 endobj 99 0 obj <> stream xœí[mܶúqÅ~Ô^†CßôC/I‹Fóâm"é‡Ôo= WŸ}—¤?¿3)WZÝYÙœ}@aV¢†äÌ3óÌP"ýv«l5ÿ˿ϯ6Ÿ|¶¯o6zû'ú{½y»^`›ž_m/$D·`¶‡W­RôaÊc€´Û‚ÙTòÛÃÕæÛv{P1 ÚíIÊkSg›fçl÷GnÑQ›Ôým§•N˜\2Ý_w{šÀ…î³(K¿zÀÝŸù‘[¿äþ IÅÒǸÔ=£K ¢ Iä{’ðýó¥´0 ri´¤´¢\›M&bd“É  H#¼Ÿï ¡£1±ÉdD§#ÛL`E Ý[MƒÙ-÷4Ž™);æ°°„ÕC¿ß°°6®û®ã$à­3$ NAÔP(ñ}xŽ=äJ›"ÙwÌK—,²aåC,ê0¥u¾Ûõ: ŽN2Æ"Ó¾_ ¿±¨06ðg³ËM–r‘O³MÔ:ÙŠ}ö Ðåkµ†„ÄN]˜(d \ð© ”b÷ß!3€[€ÉZöÈX^…ŠL¾_‰ ±YµÀ”ô>êsCH ²m†Rí;6#—“KéHaÜL̆¶1ËÑn]„Ñ>¢¢Q®Ú—ïGûzâÒSOUc$n¾—Äõä¿+Ac¦ý>h–ˆëIºàRš(?ùN—€½‰¥•Bk®ùEm}2¶ÎRCô?|­š® > 9päÊ«ux&-áa"iøgShøú² ¿¨­‹ÐðRR:4…J4•XwA³H%Œ¤Ϙ´ 2þ÷9íIÞˆÇ µWúÒɹÞùfŽ‘²R¶ÒW$¤w<µƒ¤ÎÏ y¤<•fC)›Gÿ HKÌèDŸ¬bŠÎFÑ++ÎŽ‰À£÷s~">P¼7MƒÂ¸IjüUEñW!;ê¦f÷òë©Ï‹;3 õוÍ/këmm¡>Wahìs3¼˜-¿žáKf÷þ™š=OvžC ðêçÔÒb5— ’Û«¹,08µt+©_•îèPÏ%º;Z'dº{í>ºWe&.n’”–¦,¯dýäד˜–Ó`¾®lýñ.÷N sÏ¢N¯·xÆÊU(^`jSÀzÒ/ÀÔs~ ÓiÎĸyŠX­õ'ò½‹S8Ås燂X›/Vgˆ ØÿÄYDñS›0DŠp)‘ ŒÖw¬Úf¿>•ü Â¼jë½!\¯ëëóËÚÊß"0»$‡%½©ñÙ;œÖ4É')YŸçñ|+­¿« Ÿ.t¯FçpÎÏKp×çÆü¼€ZŸPC´réÔ˯κ.Ò»ÙøZ9Òþ¢æL=ûÖ4“ hΟ?Gs%¼«³ç¢¹}FÔK9óVŠ%JŠÙ2jÖ¦@iõ‹úñwÌ=ùSv®Í_? _¤ƒO2uÎ|5hÄw=kÐ*ŸP¦°Wí÷œ› ›ÇÙWÖã4¢$¹#¹â‚“k”,¿ž-ž»/>0YŠ½-yÖÓeÁÞž-ð‘°¥Øݲg5_ªÙ.pš.¦–>’0ÖËÒâ‚ÿ%ŸäÙ¤ñžÅE|¨{ð÷òlveÑ:³ k–Ì>.2‹õæAßË3•Rw°H!Á#äžøjú+ãU¹åjàR³Pcùõ\2„ÜâB ŽSÀâR1[rk=—–Ì>.A‹Õèa¹T@ÜZÍ%Á#äL|5Ã¥‚—ä–à&z?— ¹A~=›4!öþ…éÞË»3GU¦ÒˆBKµõäZ@a¡NMhÖË.'Š¦sî˜eZ€´´[M´ŠÇ#äÙ\ÍZX ŽØµ”¤ ˆ•r$o~Éb€S~‘sóìCsn¡2p™q‹ ,”³ˆr•€wá±D8 Ç#dÜ\e[bÜ]埩 FÏOiÎz^"ßK>:ÛA ö®l·ôA‰ïX>Œ7±am{zÆËCC¿ïÇnvØÌašM”kvC´ÁÌÒ~T DÓ>êbÔHQ¤l}}³Û[…ÉûÙñQ…^™}ÓçSÒÉÓ«->ÇC°RÄÌÌŽƒ –æ ½¯iª§›ÃoûC‚÷P†=Ï¿gÖ…8FãˆM^y¤Q@0âføÎídë¿vãVÁÁ©Â¿I—ÚŠ’áù¹–gõòýûg‡`¶h¼‚|ÚôÃÉZÄXÏÈYMów|J$ô¨¤ Ý$}Àp¾qEúNðeñ@œ“ch!R°[9†ªqTD¯ëåìÖõ¬‚¡*89Íiœäéñf¨!‰> Ñk/yÆWƳÞQdÚ0»Ó+΃3í&³8AÜ,uh@Ëÿ`‘š”Ä1è¡ÖH“c¥Hħvsš·ÍÓ°»}BwþtFg“¦Šb%릠¹ð2”-¡pçKìårTµa/7x§tKrM4?ñóò'c ¨\ñ ód˜óv{€¢›ÅƒÝP³Æçuâ‹Q›Éa‘÷VLµÉ¨_#|½ùa-”ýendstream endobj 100 0 obj 2428 endobj 104 0 obj <> stream xœíZK“GV˜Ûü"¸õq3M½²À6àc{O`I+vAZÉ!~>_Ö£«ª§¦ww´ …b»ª3«òùUfõ¼™Ä,'Áÿòßç7»Ÿå¦Wowbúþ¿Ú½ÙÉH0å?Ïo¦ß\‚C)ç@¤¦Ë«]â–“S“#7;]Þìþ²—9{g¬ß›åñ¯—Èüj–J8æsðV™D±ÆÉ0-sÚëYõ r!gMüþ÷¼®”"¨ý¯/Ä,‚ÚËýŸ@àHIÚ_bÖIƒ÷Ÿ1­ò–Ìþ«‹ƒ"š f!ç‹vÕ¤‚KRú‘’†Âl|'Ï缆ðJëý_tÅÍv¼¼~vbœ"nÖûzyL")3I3kc£Lí sÐvÓå‹jtr¡èã¥p{=ž†_Bгpl)5 i„ÝQ´7Vèý-Ke¬ aÿ2­`•lüH^“Ü¿®lÿä-,…-¾¯ÿ¨ïàãg­Íþ*îAÁ@ó"…Õ´ÄÏñhY¬ö.­¦¬- mË~ ñ-ßÛÈç´l¼Ï.w_î̬¦÷;ÖÙ •Ð±³# š2¾Þ} šm“õÊÍ$e46R<,7`íÙY,flÃæ·É·B…¨·#a<ë ]$R((®èÂÖJO³Ⱈ‡WDT‹Mš9q:´Œß&_iì:ñ9/¥ã Eûoöœ.Vk?{G³ô‚µˆáõmY¸æq¥õˆp!|¡½å@§ÿ¼„w¾ˆÃéÖ‰óÍE”Á˜ÅSJièRíŸÇgšŸ™‘;­ù³ÚJÛÚÉ-¤½§ÚZo mµ}öÄã +«…Á Q L@.f³¡X ¨ö¯”¡RI] “¥Œ–ÑÒªeòøLËh¥f Ik™O/8Š¨ ôF!³r àuËZ¯(”€Lžl´mÒ´ZwM^. ";óxQ°¤/,æ—ôÍã.}-œxÓf3#À–•ŒÚJ_ ‰L9… ^<îEz”&êYf`£éuögËì M€¤ãøëe¤>í1íª]2%kÔÔ:Ï%™¶Œ¡¼Q­ÖŸÛ…Ÿ¿¯Ä/êì¦]ppëÓˆô`Ó”lJ¦©¹u—i¶³©1M›ߥh'äs†G/MͳåáP’¾¤“s¦Íš.㚊ç*Ÿd»}—…[ÚšÕ PÝò˜—¶ÉõüžÈå•œ³8· œWÿˆ­ª²»áÉ"OÚ7\YIzÁk¬9O’a[fßGŠ¢#ÄHN¬øQœ¸ä¿ýi9·ãÐlüUÍð—uö]m2`töü;ñ‹Þ-œŸø[jG«=Æ&YÀq]ôè)^ŒÐ¦üù)ÞáTUÃE–±³ö¿€–· @“…Q‚VÐÿ TaŽR»8¯Mõ.µeswÖ'Žó“ÅÄq¿®YüÃ]¹­x oïY Ã4P걡 Ø©‡†óÁ`ÃL ŽÍt ŠÅxúØbµ48uácƒF1W"çÃF5×ÿQãéQ£x¯G‘7(Õ¢†âŽÊox-T@CðµRòoŒZc•—É© Ygù^Ãx´„ì,i½U5nSxL‡–²¾ÏëKÚE‘šG‡žtúYÕ’øUÓÛù}‰ôú>[/¿/¶¬ï[:¯»ò*rœÀäc¸ÑmmRœ#èÌ@%[«ž Ÿ›:FHwNuQíºGý®#;÷<#9Q[¬vÉc´K–¿yjφ18¢ñ~Ù!Žžƒ!À¹]^‹žY4k3u Æ„iaÖ¡];˜:o]^›žÙtkÃ'"¬|’ÇI%|ZÎGQKdM”°I˜òšzfjÖfê;5PO…:!O@øfŒ? €Ú>øóöЛ:@ƒH³ATËæ 8§p#Áú–O¾7QBßo.:N×k+Ãþ>o‹µ‘VeSH÷ÙŠ’.m9ì¥I¥ÐWLüc„Hûc4^8¸YÄ£ÖäÚ,2˜U`XÑ•Bª-Ÿ±¦"*‚ø†ÖÖµO£E¬võK­þïwh%-Xî9 mñ¡ǽÅZQî1ÚŽld*Í%GíeÕñ"ŒÔ±bÁ«c³¡Å4ÚGì“>ŸVžiªÙí܃ݢÝN·¬Š5œŒÃÜS«jüÚKøÅ‹âF 7œüË#î¯BìPÛ‘™’îOIí9õñæùÿ¤‘tâ牢ú(æÖQáíþQ±¥¸ëQ]yž$ªO‰b–² ¢¾#ÀÓÍ 8¯;ðæ·¬ùž$_ŠÔ[”r'R.ŠA@s¨ÅyÌ$_îþ @Ap´endstream endobj 105 0 obj 2577 endobj 109 0 obj <> stream xœí[I$G¶Ì­~·»ØqxAŽ·AÞ{¹0«ÉålJ{l›~3¸ò;è#2LÎo.¸˜JÌ{"§Ô|~UŸÛxQ!þ]!Þ‘»Ü"…›Ÿ‘«`§†G|…ŸÆjjï"5aL&¬‰`\‹÷6àYÄÙì‹ËÝ—;µˆé=Ò‰ÛÉ2ér×;DŸ\L^¿Ü=¦ç?R@¤5 Lx~,!·áÅ9)j~a"ÆW“V¤2@9Ñ¡‡^WiÅ”'•¡wš9Ò´œ±ž­AiFÆÚ M9Ñ"~]-a«—Ï:Î--˜ ==Sú)Ý =¬^¸c<ã7™ð(nR1—aßPFh×<„·.‹CÁ܉óõEA©â$!´Dó§õ™æG¦-ØiÍŸÔrTÀÊ0nNTeÓ© [mŸ|Ãñ󚔕 !¤#T4”Gö%hk|¶’wóbNrÁe6L’2XFrc[-“ÖgZF Ì\ “ k‘ç-~(¡Oº ¹7¤„rTÈ_´Žl”ÄlT´YŠv©/úÑA°èª_ZýBââ©A½.‰›ÖmâøïºIcJûcöQâXâÂÆðq21/™23‹?¹ *æ]„ÖhûIÝýiÙŽ0q òzuŸpˆ•–j—FÑ5©Î3FN£cÆGB£õç[»ÐïøIÝ=j:¡×¢[›&çQ4Mͪ›Ls4Ë<˙ۂXé9Ó¦>î d“> R—aMÊ„”J¾6]¶•Ìmak7”ßìsÓävz®qÞGJÖh#P¹‰ú§dJôxN78IDï´t V€kYêQÆŒ<›P÷’¶ ¡7"z®Ö‹ì¹œóŠuGw€?¿Pw%6Aÿ¼&õÓºû®î6A?:hPéï;׳ÚmëÇÔþÙª=N{YÀRtïYÐfùÙYÝØàPC •2 cæ#J| Ú)ñ ¯ßb_~ÐįÂl’9;¬Mî6™¹÷K{ GøóÓýÂ6¬_Õ¼ýî¦l6ܦþÛOy²>tºïäÏfê‹ÁùéÄL!û·f:œýÙb´½µX=ÿT CÞ=—‰l®¾lœ](ªµþ_'¨Ndõu£©Ú{ÑÔ ÁØ Ýp”ËÓ‹J ]ˆSe„ãÑ ñZý´îÒŒB9Nƒªð˜7Έ©ÑõÛ¾…¬Ï}ß6D^gsëdOšæT¯š¦hNÏsl×çÉvéy¶d}ž-il¨vÅÕN-f[KØ°¸Ž&uH\´ï¹`[›ž].êJàø:4PÅÞãùC"«Û†È¹å®Õ¶VÍðiS›ýrq´ªÄIѲhËa-]m] 2ˆeƒ¹®XÅämÖ•AžB:ÈHë6 ![Ûùâ.MãÍmTRös-Óε~œ¦<×X«Ž‰èº™Wd'­°*A›É.Þ¢ÏáêSvR‹ädŒ€".öÌèÛüèÑîòÇaÝ<\3G¦Ie¤ô Hj`2.n$ø1!ˆ³¸‰³bB>gù?ÓYÎŒ/ÿ¹ MÝ…/C,*tœ†Ò êvØzBì ÔQ0–—$­ãnÅè]‚´ü'1Ž—Ã8UAœ+‹8* ªe€/àT¨É0ZñyØE{;N“ÂaûçV.ª’ÜÉEMÎÉf‹‚Ð䢕,ò#tQ“¿’Þ ;fZ²Ý( KŽðkÊåa †¥ã^Xߨüñ^{ö²VÝNwúçÓ»v«.ç¦ZTs¾knrŸ>½ß¥~ú=ÎXÍ@JIȺrÍÂZ‡5ÁgØí¸ôýȤ”õ‹ ݃ĵÓzì$p.Ç5 Ò.H‘—¤—»g™)¿cªÏL3––Œ^ãV‘²– -5”#s-yfÞ#+¡XÇJp½b…Ý-L6¬š\t•°À ­oÃ{Ô°*¦L¬Sf¬jÀL¹Ú+3/&]#Vé‘×ú¡‰»¡eº‘B\‹—´¶†^Ypð4 kGÏ‹LauµÃõÌã (‘-r^š×ZÑ— Yu´U‚.¬ÓcÑ!wr_QHÆ¢kY‹N-dÃ-­ª&ùqµ ç%ï4‡NÍ}K;®ª&å±è;¹¯BlØÎ'eÍŠ;Gë“âÓä$j|‚e,;»•u4kEVm•¡Më“"XF¶+Ÿ¤&þlkÖL.½D«ì5)e,;»•5ë4IFÏ´³O ëüØöÈvå“›>¸Z5#ùrÅ<ݪ´¢Ï®âåêÌ>ö@×Í…_¬¨}É];Óžú¾"°0Â<‡ÅñówÏ}1p¾Ço%\Å®P›EÓE4 =Ùq kº$½]Ä™"ˆËIÔ pã€CÔc?>íËæL7Ø_ëÐyÞ‰ÅÚ}ólÜ¢C³$#§vnp ™GE´}r`xPf…c:°®S+• ëšsÑ^Z>!M™×" âXS_-„¹0ÒÖORô¿ƲIy&ãFïúóúŒO’ -´ <ÍbÚ¡Õ0B¨­3¾mó#mÂ+UÀ'Ü~²^R,ÒjrI(«j®WÇëÌî?ûŽÓ›ðÁ¦òè·‡™-V™ý }õ)¤cÙ‹8+i&G_bÒʇÆFŽ”°åoˆÁ,~@IïWB2áø¨ùŠ›Ç†íL°ÿµ_i•W$éK'dH;·lߦ4¯C"°u:Î`Ük-}Á>FùJ¥¤iã:Å ±ÃP@û@û+äkÂ1h{ë;)PsEYeµ>%bÍp€(qCN‡" }?%+h4f$¦F+LÖßû0ÉîÅdÂcÄË1\bd<=н1d6FƒóIxkÂÔÁÓ4Ç÷)õïˆ4Ì)k=r«áBH.(m½nÌÙWWŸ¾IìÍy»ÁÍÚøë‰o÷áAÇ0ǧvù²~ú&hy»°‰Uh6(ôÃÄ£ŸÍ+¨;ÆÎh\r«€!”=çdÚã$¥ïP#ÌñH‚LÑ¡ ~õûIÙÏf¸xÓü×öƒÎS‡‹^0ÉoÕçA¢úHhŠbL=å6½ƒXG7®iL…ètJÞ.º¿÷uòcŠî²h6îgïø¦å¦1þ¹çÇá1þ&Ó¢u:œÉ´ÓÏÛôJçðùÑü1iB]æÑu‚m–æ5ž‹öÓû´¦ç_îþ ùŸ?¼endstream endobj 110 0 obj 2775 endobj 114 0 obj <> stream xœíÉ’GÑanïˆàöŽoÀ¯©}1ÁÁxas`lÏ ÌAŒ%Ù0²eŒðwÀ“YkVuu¿e‡B¡˜î~UY¹WfÖòÍ–M|Ëð_ú{õlóËOìöé͆m ÿŸn¾ÙðÐ`›þ\=ÛþæÁ+ç“×Zl/Ÿlbo¾µbkµ¼Ù^>ÛüuÇ/ö|rV·3åño—HýÅij؟MÞ©xDÅ(Ëý¶|“NN¢üÖÞí~‡p9g^ìÞ¹`óÒKÇw†V ®w—ðÕr#ïÞǶ­vŸ\ì…Ö“‚¯Ééb£J-¼Xº‘JûI¹ŸsBÊÝG‹ŒÂàF¼¼àn²ÐXjLà}Z#JBm¹š¤2§½t‘ÙK3ùíåç•éÚúLãÌîäø3ÈÅ{91«wàgÔÁç/±µvRóÝ¿Òg¦íîqbßík‹ç€¹tÊ0¹ûz ã«Úâ%p^©‰ž ÅÐVÅßÖ¤ñ<« @{¡ c2`%MÚ8Úï&ô³’ydÚû—›7jÛWgåÖ2é@ߟm4šü~½ù~Ögbkœ°“ƒ&ù´1¡Åiöàõd¤wÏO%èÊQ Lø@´ÕL9È!´  Z€v3å‘h ;ÍR ìrÆzè Jjd¨2Úíø( J·®c?ë8·ø‚™Ð»Ïvh#FJ7Ðu$Û1$#èÔ£ ¸omë& 4ªÜöj·ö œÇÐ ·.£ƒ6vMÉøì"à ¤)r`Ë ÊEéýLîÁÉ4üOt§1;º%˜4ãæº+ó“p8<>Cj%cÜ+0ôʃ&&hk|fø²G»ä‚Ëg$r²•3éýLÎHÎ&Ý0æ½ Ô"]ñ¹%ã‰6ë¡œÐ>+dT,BÜ@i#¡­Ò¢ºKíx¡ÌQ”}é½Ð‡¶ ?šIVÛMïíß3jÊhúk RbÕv  £"‹` !΋ÕÇ/ë#(WxæÊÑϟׯo•¯õSPë^‹¤†©„1—Û‚¶P¨!EvT³:ÙÖ˜!œ”êwç|©ì ?¯_WùŠ —ÝÑɬɖYSíêkV-‰pæMRçÂì)Ъ ±«}6mj5Äi4†E,%ÎfâR4FVÓ¶Õx äèþñûÜ[é0½# kqjà°x¤Å‚ /0ôNKGz¥ñ¹–Å eÌHJ‘MºøιJ=ó QZÕKdiKW¬´C[> ˜}#Ñõ§õñq}|Y-œèúh†×&ž §&¾‰¯‘D4'{líØxÄ‹áÏsf5î³™ð`»ÌB©'Å ‰­ÅàŽCÜLB¢[™>FyÚÜÒô¹!v|ÿ¶Ÿ1lnÏY`Ô¾{æÞOÍT{Ü¢!X˜köóúøí!ƒlLŸ‰Ü9¿CÌ¢€ª»¶ÿ̨ÖœïVØÀœMË s¬ó—7ýÌ¿à,Œœ–¢ñ³=EfWë9Îö•[¯]Å=¹Š,±ÖuPg¡½ÔUÆsÃÚNñ ‹CQªAU•áÀþç5­~¿ ÇC•B9Hñ$P 03¢*k¾rðÙÓ–õwŸ};&ƒrÌÞÞ­ÙÚ+©I¡ÓïY½ëï‰}é÷ÌÌú{a¦u²‰¤Bóý®vj2sÂfcÁm¢I œ»u›…JÊÖ³æ*ÁŽÓ¡¹ÙÚ;œ%²Vdr©–œëô(µÅlçõ§™'$ß‹—q‘/U¿Kœmj«á;ñZÔ%ê8$éÙ;«Âgjm¹~?µ~‘ÞãSLNŠŸuçù2ÕxY2ÓN—¤l Z†´~d¥<×±1¤ktÑ„2Ï‘!NZaUjm¶vòâü ¥Î1e·jòÙºˆ‹=ê ðÁ¡‡ÊÛ凛˟‡*6ù± $` ª®@›#¼_¾@ªáâ6ˆ¯¡‚ã‹ïy|yhü0îý¯ŒïèØ0ôå?fê¤Ñz}©g¡ÏãlH?©iåõ >Y˜O·¨ eÕ£Á·EÅbù¼diþ‹¨ÛŽË¡n£¯`âÝØ—ÄMÇÝ—¬;¥9úldŒV|>óe$¯2ÂX;÷¤ÏI"ª˜ÜJD'±DDú0"’ß»ˆLÄè{QgEëlä5Xü=‰¨ÃE½ÑélyXé"2­Óý?rt†¶>Õ¹¬³ea.ÒŒÛ{ÿÁŠh¯rŽo÷‚MR±îYȘփñ!õÈ €ÐŒoó0MyÀÄ1cB$Û0J®ã¢!“g| GàÎ="лôG wXŽ@kŽMª–S­šºõ¥霤¹XìŠ)ÛW›”Œmÿ¸Á\ò9%e„(¸ KÊ0?Yzä6LÇ6ml‘áý³ü&€HÚJ‡ïÜâúÑ5¼[Õ¾Óö×›'3 †÷àLø·òL,îxH„VZÈIØÌ°,äoÚJÜn­„3Ci…+h%$œ\bRÚ¾"Õ£Hi Z¤ ÿŸd®Ri-—Pg2yè &QgQÖÀÉ!ê‚Y1ȳ±‚ÈtøÒö Xu8Àxˆà®Ÿ¬<§X pç*,°¬8LÉؾâÀX€âϾWÀªÃa¤0¸ó ¼(ßsaÔ¤$Üà8EX\ž'òì;”¬m´¼¼ƒ/W`×ÖØɨ-nñ˜ð5¡Þ® µ+3õgÙv–6¶NïBLÒlkgÞÀæ¹u:ýlÛζ֡;ë¨_`>BÄA}™Á÷ТÚE|¿‚ŒÍ‘¼ƒÀ›1°Gú¢=˜†ÞÚµc¤wì‘°(-tAwcmŒwFV¿‡*(VÀ» -ªyÅwà'¸ÔÉXÒÂ6ê».=ò”·Û AvcÈÔ£b¿T,#„žŽ«`ªª7Õò%a¦¥æ–1/FZhÓH€ÆÕ¬ƒÀš1°Gþ’h+d7†,=2¹…ê ¨n 4xß|ù5ŠãvOQu°{ÖI.aâD/\Zè‚nƸڔ/I£ „¤qeŒ¢“‹ÒÂw|7ÆÉsÚÝ…ïiF‡‹fª%ü”j±§¦ë%Q#©Ê߶<ÓÑá&ŽåÞ}ØŒÍäÝ”]Ú1öŽÇ]§{åCÞ ë¥Ë2h’îÇ0Öœ”â-Œ 88„lºðê˜ÄæXaË°2â· MŒî¸°áLÜ+ æ{ˆ Ì™#6ØWPؽ’˜†ñs†XÏ-ö6u(íOƒÞ ¹Í9.„¡+Ž«,tÉd¡Ú"pá FÀÝæ¡ùO/ 5D¨~€Î ˜ÈªIÖ\»§×°&;´°ôÒʼGÚšº«â½¸ø&m݉‹åýWa!8/î´ë†\àfŒô~Æ^lÅ ‰‹Mç&èÊÝP 1Á««›? $9æG$ÃBí#÷ÉÄ*K«Q4­ªt+"ŠYÖ]!ð.ðyߌôI1 ³Ø¡]aæ TéX%Ì5A?Lðæ[ð!¾Þ_@Q •ÉjÕòWƒ—Ùî ¸¯’@×=îÍz(Yú¤ÓËBkÜÜm¦ë´t9”l©mÚ3xl˜*q÷f:b3’ù‡|¨tR?c‡ `S%nßôùû Ñ@]äÆìÓTe…XÀ£¬f¸x*ÁµZ §»zAdZç5û¾‹{ŸÔƒbÊ„*… ÅÚÕršÔ£U’}Óç°W„©gŽdûÄ‘¶%”TØZvæ…JŽYx.ñýäÂ6 Ÿg,m=,nÊhÙyZi½g~¿ÚÝ윸×Bù¡*ìݯeœ 6Ʋ¥ÊóªÍ¨z”®P ÙsˆÑ!VoKÆëZD S{kÌštÏëÜ.×¹Û¥¨ƒZ¤sšVÏVèX«»]+}È;Sðhç KcífjŠë!¢ÄG+·­8¾VîûVî‡]Ä;¸[áÇoh£•¤åé£ν‰°W3L2·yma¯-ìÐÆ—{Åe\¿ºó`qit-X¬}Y»8ÑÐWð“<Ϩý^ŠÞæÓþ…å‘þO«¼iI·]ÎtáG_ËÝô¾–@¶72«0¤a57ay)ƒ­—2\^pîã©»|÷Â즣´kî^xï·`F6×:¬Ý²`¼¬w6ë2d¼bñ–…¾,ëÁGAÆ{8$^ÉñEºë/íª°îîÔÿtW„tÅ3ßÕŸ.8ðǤ#CÝÎ|Kr©éü¤6Wn„1h‘Ìþñ*Ÿäkî캆Òó&bµ™ÝÆÐRdL,('ä~3;CÑž7çâf‰â­öxÉlÀzHõÝ~°î˜÷qƒI\^Öä²Ê«ÊÁ©¢›fÀ,Þ¨×KDÕOë})ÃcN]…ËwjO \EXNòÕ“ت¼#¸ñI*ï…s`/ðw,¸›ÁŠxá›`Õ¿-ÌÍW¥ñòÉŒ~ð—åøƒî%â£ØD>0)b|fÂf”=0¡¦÷”Ë뀯“a&+…*’>¯Á‚É©‘¢Gm:Šâl† ÂÖ(õ$H Ûz¦Î.ZÏ´/®e~°}Eƒux°7pp¿êžn©®`Œ³Â$âvïÀ€¸|ÁQªu¾6#¼Yª¼hjB`霯L) zõ çƒfêá÷VðG.IklÛø&*Žâ‚S \ᎹX~Æ[ ¤îˆÁ9#\wzˆÚˆîüpýç‚üãÈ&#‘|Ô%‰G³æÔê{¥ (…øK0lâ$û…–Nj¤©žô&‡½ô u´$QyÅÁ•5[™*Š^ÃMš˜‰×õ«Ý‘76uGtw¬ -O×¹½?/–¯O9´¶Çñ'*µ6b¦Í•F×ÃÂFQ-œÝ¥8”ÓOëÕPõþŸ`†×½l¾; EØ×UvRlá.!¢ TÚóûˆ:örp",QB6í®óãÂ…æ4ýUÿ“€ "®£³˜êש¶%_»³³$ŽÜ­³¾NÛm ¬d4@:IÝ؉»­Oª"¼]wÅ6ÃÅi×ÙBŽØJ2ÖE\W¹[IŽ„jo-T×^ tÿrÍš‹q-Çwµ¸Œˆ¥ÇMPmqùDÌëWò(Ziƒ÷Tæö&ì1¿gQ× Y~Q¨U(8:À€Ô»ÜU†ŸyÅYžA"‚.ÁÄSÆr/¼˜ H{”3ßÄñŒÕ$ƒ’ A+„ð²(zUë½#k¡hÈ'—!Ôô¢ßŠV¿@Í §ôŒ§†A 3c Ž~n²XÒ« ï¬RmäFn‹%»;d÷‰m´¼œÒæx9òÔ±x'ˆÆ¢Á<‰·ª9_ª.5ai5a¹'V]³œfž>Ô—æî¿ŠÎc·Hʦp%åJm%$«ä¾Š>¡Š°k„½‚vÄ'Žç)q`žbÏì{ Æ„;÷(áØâ÷H•’NÙ&ᤌAÄÅ®(Ý+—QqâÁ)t¸=É š^|1†lv ÓV/µ Á,µG¯Ù•.o¸ ÝÖܾJs±àH‡¸Ãõ¼¶¦¢øø*ÁåÞz³Ô,%4Ô0І—aðÕMJAn:}¤ÏA/ùô40Ñ2¬™ð‘ ?.E?zªß•T2ò¦Ý',áþ£Rs¹.ו§¡ðH²Ý‰îˆz“bý¢—yâœuÛ؇®i’«öÒ„KqZWÿ¤ÔEˆC{ÕCÕ ÄTx‘Œ6´,Ð(S*Pb„Òi¶¶5‘Àúo OPÑ|øJ&ÒbGÍ‹m…ŽG‘<˜ ÖB'´!›¨D÷k„0¨Ñ¡9‡‹VËq2O îÄž™EmAlhéÖ¢¥ê_`ŽP˜|@,ƒeÐ0ÕØw£Ä7Q¬ò}&Žß•€)ýÜÆ8Y-«Þ ”saÀÚ•‚ci'Uí6âs¼Ý™SºÊ¼ã.±ÂY!1ÒÚVû³Î1´¦9Î*Æ+ê8™XÇá®PjÓ–ØåµÉ¨Ýèrójf$¨ifk ,«®Zœ8ù*'ÖŒL¥Ä:Žol´7ÛZ„ÑÏ3HlséV¢µµè¯# äyÔÄ°BG̬gLS2¿OË‹Y† ÓUù±÷)Ûç Ì¿‹Dá8‹w~µ9Iâ^1¢âµËÊÖÝ8·u½Aíã1Û›>Þüæx¤eendstream endobj 115 0 obj 4751 endobj 119 0 obj <> stream xœµ\ÙŽÇq’;>ÅÜ>“p~÷¾$wbì ä$ö$@ ER”#n¥HÌk$œª^«z9ç %Á0ô³O¯Õµ|µô|s#y#ðå¿Ï^?úõïýÍË÷ÄÍ?Àÿ_>úæ‘LnÊž½¾ùä:Á?¥:¤þæþËGâˆÁi#óTÎxoZ›W7Þú#º›û×>?ÉÛ;yo\8·wÐK{­ãI³fkõé·Ø"‚Pñôo·âÑDÕéw·w°°”ÖŸžÜÊCÃïág/•æôøi ¶þ3Ž¶XÇ(O€Oãq¥Ó¿Àpo…”§ßÃ(+¼iƒ´ˆ§Çݹÿ(³j­Ýéïa,~ú vTÁYM0e<‚ö§OzëàpŒîO÷ÿ$ 7¦¶V!Å2½å²öÐŒ>Ÿæc+­a3xluåÛF l<­à8÷·2ÞÃzsçüýi'ãÚÔyGx‰}KÊéÃ;ØÕýs~M¾}â°;äîæN»#æ¾Ïn܃0ñô´z…çÁk!ÿÇ è®d„ =ÊEëäéK¼ §u8½M»„+Ô§oá÷àë4ÎŒ]#Ìü¼ùÏeÞ ¥‡),Û#“åµ Ì”²AhÒö‡KØ.õ;\ÀZYrž²e%•×±"œþùJ¹dÎcÔ¸§rÖ¶”uJãRçÂ)€ÙÆ#ÊÆ_‘ÞmŠ÷ða”š`¯úˆóN%|¶?ëFßãšBÓ[ÎT ¸§’`Ña_Ý"Óh!Á o¥µàwƒ‹©— Lð%Ne=Ï‚\d²Ò¾ÅVãƒi+f°®ƒ¡!Ö{\DÛÎi>6Ø°6P·mn¥”›ýyÖPþk£ˆZZê¢ÀtÑã]WëÙÃn4×.H?åÙmh`n¾ ¥\’ª•»82?xk×p­q™9}q‹GKà±\¢f+Dzˆè%W:K (ÿ»² 0è 1e„VIwô>¯m2ßw=ZuKÿ"?`7I™.ÆU"ZåªF+` kz¢SŸN°.@IëÃZwúã©ÁÍIpL ¡R²×>-½²ÇyTTK – jßERÊ ê”YP°Æ¥ßƒ`’!$\V 9b)šÝÈMS±Äm·A¨k¥B§çœ9ÁÄ„õüZ”Ïd„Éž ¯³Þ7†½¢Z®2·7´+µôÇÛtõ .DPƒRÀÐÄ¡|“7,¥ÅyØ‹\×›µÜ“M Ä6J,ÿáú¢ƒOª€uÉäÝî“ÅG4›HÅîewA«…âBMm'ò?L2Á:ÂýÐöѾ }˸âä4Ù°\Ù±’ÞÖ=ó‰´ª\†0à»c»ò-‘„D|Û¬PS˜ãC>x©[öd·ƒL.4ìNÎ1yP…7Î`vÀ.x¯ó¦lMƒ°¡'©×ç۠ʉ³"“k2× EµÓÐdîo³ÿ%4WB]ÛS6eL'‚ëjVBØÈã„rtS§Øw*úç_enA—q0`ÂB ²µS]]Јö\Ú³WœÎ2ú,j™BÜq,"j$A¦ß @ˆneßþ{—¢YÁWNFe ×neR`«ìŠá1`xdXÂOº‘£B<磠½‹D/»²Å¸¢†-r(GLûSzÃÞ= ²Œº %’]aÈÛ§îÿúó³Ñ ›ŽB$Qñ±>ý/ žN4ôñçD¿ìˆñEs¢“¿ÃþnÒ§;êø„pȬG¬Âî‹8=t$j°äEi”VŸ¹â“~ºù øyþ Êîj¤€ªÍ?|2.œúÇ.¬4ܽÔW`ó¦ /€‡a¸s OšÒ#(kšÂˆr›"A+N×d5rÍaœIïšd’’³œCšè׈E,öl„Óƒªœ#œcøá ÷H¢Ô #C8ƒ,<Ý1ô1«Ÿ&^€6|€<ÐYu®?u‘ú(¶ûf²_ ú³<.AD·¨tkZ84îÓ¼ÏáZ\½ëÿWTžÙåÀD±ågÆTJÀÔÚ}`dŠÛ=# ŽÌÁ¬ã‰ÙHtcU>ÈŒ³'’˜®’*xf¸Ûdt=ï ˜÷y†ÅG7–Êœ¾^8H}ªw9¤7†xKñë2ÿCBL`q€o1 __ÿÇŒ±@/û¦sç^À„ÙÓ¼RCŒ”DSLÙ÷ǤՔ—0µZÞš¦á®´RúEÄex±CL2†Á¸QñRF0Höœ!T&÷V œ.`Áˆ#ùiè=^ ]dXgjhÁŸÖÕžÌÊ,éÚð¶qrgj™ø¢b¦no™F{ 0ÊÛ0šK<áCòI˜Ÿ\Ü»¼7 0{pIÒŽ¬”@*ì• —(€jʲi Cˆ“l9Ò¸$›ÐÅ‹&Ef0Z¦q…þ,Þ-E¼yŽÜɃõA?¯,hĪêgäóÝ!òuÕÏØã^ b´¿|5œìáÀ÷]Çbß?ø’)ø‚þ¯I $Ö³»1I9Á­é¹Ã\ÎHÐPGð™9Z9ÈÚN‡ßuTúýCP)!öDÀÍ&±ë'?}m²°Q@ïH„ö:D Ž&h2»‹qð|’&y{gâ‰IU¸*˜ú&ëZ%{‘ë·ÂmÉ.—ÅÆÒI? #©ÃNs<;‰’ì1éÒÕ(â …7J}¥¾.+Ƹ3Fð¹3¾ G5ÌOsDÆ:"à\–•‘ ïW˜<óÊàá2? ããŠéš±Õˆ·ÃŒÓYÂíÛl˜@O\ŽsÄXkHgÌí¬ÄbêRNËb)Îù¸y:‚Ûí×iOBLæ>åÉâF,A ¿õ·M]m(õ8_n\ ªg:¸8Zçs)ér›Ää®ÊQ*WI¹ÈÐX?W$µB£õ¬Z†^}šWË9`\|اÌß:ñxáÄbxµzl.´¸jðË\µ³ƒ ¤žót%:¾â„7=af[Ké,¾-óšÓïc)׫Ï)ߥv€+IT®Ùº/ºžûâ!¡¶ &×ag±Z¤‹Ÿ=pÁ0n6:,û0¬‡Sg#0“3+-8ùŠôfÓ°”D*„²î¬R àtÛº{`1ÛCB=Ém·k±¬Û2fÖuWV‘UæEjƒÌ™¸‹ø°­·¸LåšÆþ%¸ÊN ñß¡RBªÉˆ” =Ÿymå‘IßP¡£ê“DˆŽqGŠlË:“;ÄR—kåqUýZßQ2xîDi‡RÑ(lçš9j:×l,Ê1Š´,e@µº$FçÈ~É”rZë¶ €ˆ^7‡Û»Ü)€€O°‡ÕÎ7ûáò=à/ïŒEa°´·Í¡ÇŸA+ܲMöc? ®VÓyßôÖ?§…ƒÑÈ{8Ì:‘”/fǼ—K°1¬.'G´‰‡\§“¦„f…OÚPAñ—ÌUìp߶Üq8p2x“<Ç\;^øm ÁؤØû-ññëþßõýܧâ1¿·DMÖ¯W°bô¢(¶x0,/ÈâgÏ7mÜ)ô#€BpÛ¤Á¨óxj—h?¤ÉX–<¦„ÑÖ%ßðšD-ÜÄ‚pYëü¨µÓ}†ÆHDrFÉÑgîMð˜àNJëyIJ yö>ð¼{Cy»œ/õ›ê×£Ût¹¿÷ RØ| ²¯q­*àÜ¡ñaˆ\6O¨„Ù¦°ü<ÎÃR”~E}S¢œ¼¦6]×'ílU QæqzZ×L*ú”9‡ŒðÄÒ¯OD\7¯±œ9;à2§êC«348tr`³Çý[8hÂ?(Õƒ§–îkQ98S,M+cè™Íh˜$Ïr±TìqI£…])bÆ© ¯ˆ¸&ê[yWD¹ ¼G*‘;RcrMKèdY…öììåÁÅb‡™‘v’&ŽJ‹FïFNÃS§œþ¯ÌqË¢Ð\¡H•š£¼ç‹çÓ"æ¡9 œãøLBK\n±©p–,ÔJ9Uˆˆ>_$íßfÍ…í¹Ër÷ã#dbðšd˜^Ih„áÍ(öJž“ ñ¬”8Ƀ¼‰É$r~±¼ènJ«X\À«ÆÍ^UHÓk™aÏÚ7œÚ0&EöÉÖ+P¦ÈN:sò[|ô?µž#eôÇKEñDXô®IZçÃEÙA¶ämâà×”²×~Žâ™‘_ùg#gö3¤¢`‡ŽÌN/°HHz$˜ŠÜ¬¼) YG`È߃„œ"†sãË…¾â2Ù¥©Sº‰,lÛY,ÏÂ:“(ïtöæJl ‰“t¯W¤/ßåÞŠƒ¹]ü4Ýý|rŠVT’Èz.@V§)R1UŽÔW*Ä"—‡$:ËzÀôÚL&+•ƒÂ̱݀*![Q{˜îbÜââ÷’-ÌGåøtªÐ†=‡kìQ-‚>&KRü`2å° ‘›k^ÔX`xµLû±ØdÑ®-Ï¿Í—m𪮠œö>²zQøŽ^àX»»Émä,%0„1D£NKTÛY&3¨zÍ Xï¤|ºÂÏð^áŽÝ¬²áO’bôÑ3•¯r>XÂwy£pY¿pém&ºZ<`ÂɈ"]û¨,&ùœC’àbö¦Rª%ë×0ŠÇ.¾zùLPúåø´ZJú~eüCë>N>'ˆy7=MÚ8çn»¯y/ë*—º¤“kž6ô«Ûúz®[ÅssYÚž<'y‚u%ÇÚc@÷jEPæè–î\f/ b7”,+”DMD˜ßDîeMóÀ÷Û²yM+Dˆh•áüU奕×Ë;‘¦ù-{cÐÏ™ù?bÅ |¾àIžæ²’jÜ<½%Ué×=¶Êñ½ý^}Ûl­6bTK²$C˜òÂpè…'Ëiß›Ç{+µ>úI×:>2=/E[Ûç#Æ¥Dßð|¤Ø¾…ÛÔ'úÐUVo,a `)ªš}®ÅßÕ!©˜©Ö·ä?"²,³kúÓKåMò:‡_ë9=G±Òsîiøäˆ^I¢¤½W´›‚º)"R‘,hˆ°¼™ ËNoÅÿ³ièÕ39L.ïWn lÞQÆjFK¡}˜j’qWC‰±=$àðuç»ú É­Þåyñ Ü7OðÙ­¼…Gæu~ˆ8’?…ötõmáÏ:j͈ßAð…Od@³\›zÄ¿á§7hüÙÒ+îr=ÁPÇw© ¦H¦eæê{æE)x}‚†œðÉN¯f˜¥¥UœÊ,Œ'X8Ýy~Ýf$Olx¤ãA¤Lˆi¶3°"= pýôçNRçJù!5o!Ïñˆ|ÉWú¿kP7Ùù‡>F©a/Ñâ^é•·>^ŽIÛ\9>ªÄô”N:?ߺý{õéùèªú¸pé£fZeS¨“¸Ãh³)èmñ/1þµ‚û¿Ìõ†ž@‘é™úú•ÞüÈö¼Ñ&š5Ôó~[À#{¶zåÚ¿Vå¯5P¤#.°}Õý<û"^¯ NÍRdS?¶AE;륧<‘®æn> stream xœÕÉn7˜£¾âaNý&óÚÜ—ä0’L6œ8º9>Ȳe–W)‹þ~ªH6Y\úi‹ †á6»XU¬½ª?mØÌ7 ÿ¤OÞGr¼ãU‘óxx?`||UöŽï…¼öK|:!IN¨ø!ôÐÊRpÜ'K[+v0Jè‡P•aÛb¿'ö+*¦fr¤â`7š¼ô²¸.´°¬}c¢Ñêr0ÇÑ80ø•‰N»¥1+ýsD à]¬b¶ÿþÆÆ(ø9&üUF©\ÀMŒÒçVp‚žwÒ‚«½iù¤¬Wk1å c`í¿˜ÕBuîéÅÇ/Co¶_S"®£-“Â({O¶ìéŸIüáíˆVVŸÇeÍlþºÆî ê§W’ùÊØ^ÒxˆÙÚØ+-ŸµñÓ)ÆäFÊ&žßÁ\Yjíþˆq8ãžS+÷.Øï¹ÔDUfnÁÇ j3?à*¸r0Ƀ¨t #!¶DVï«ß1ÄâN%ûl}¶Y¦_fó5íBšÅØik¼©€Ôòa„¢!£wÒïRCÎpœdFFvÙÓǯ„ ʾW >G>9È|Äô7#aœãu ŒR%!!1ò¥ <é\£@"ÀC(†î@. ¡~uϘuC¼7Ð ÄðÞ<‰öÛ@9¥›·–Û èÀFü9e¼ˆæe—(ÛåÐ l=fVÉÑ:׈åcFÒøÇœÞT×QôhÝ‘C ¸'‹¿á]LãëK¦u_b¼†}8SAìóæ÷ÑÉj0<8ÅELÛ§c1ÑѵL(äñcŠ£ªß;:Õ”+ð›$2nZ -`­Ñ“ð¶^67­6>ç_§8pJ…L{Ћè9…§ÂÞžSMß✴(šÎ‘2$V:hØæøP^üÜá&ô ]uÓÁç`[¸yj«½¨4èIQëèû½¹´`+®J™êcœžÝ_Xj‘ŠA.íF…éA~•4c﬒”ì†~ºJR¯’”‡7”g÷'(Ï÷‚¾³p|w•p^%=ŸÖ…£îÇŽ Êã|áÇ-:áñMþ½ïÆ®¾t³fìX ˆýÑÉ >~(âPO(ïg —Õ£²÷°£W(«Ëê÷CDÔ¿ÞkI8:\qM1 €R\ WôbÄíóѵ6–Ê®oÓIP@Æ-~û’Œ]ã¦n•o7½q³xÈ“›q³C•˜ÿÆ™A½ˆm½•8…»Äid@ıÎ%—·4HÂ^ÕÄÛÈàJgëbFIÞàw‰]Úɔ߮ŠPô\P€¤ä+•’تS;”€˜.î1­·{/sV#cø ¸C>xGÜk@ÿ½á¾”ú™ÎUÍ릎±´_¥ŽB"bѤ´ªY‚PLˆ¨"nU÷§ o’5–kZààÛ˜´”Gñ¨ëÙX!3jk¥k©Å\É D= !¤v÷¾6o¡%°q^ZA¹²/M`Ðt4—lî#xšÅ™pš´üCýŸäs*(ä0"úŸ·À ÕLJï% ý¯Z« ¶QZ­Mœ·¥-(”гÉ>âVDjÚà*ÒZU…;*«ª¥RÜ¥”zŒ«:ˆÚ)¯c(^)ù,%‰Y_;ŠÒ•Úñ§EÄû) âÕýWÚX;~=-Om]ËÛ¹ÚsMà„Q£æÿÕZ®§0@Ëám*Ùž \1 9«`ÏâÈL¢UƒÈ¥ÇäxÙow  3³zú¥d.I:às–#ÐWçÕÏ8—£à6}Ú+­FiÏÎð5íàR~) Zk €e ®&â&Q#Øl€s,4 „’èpÕâ $YýX Xh´~ äQ,•C¨GûûÂA@ †Zo²£ú’,\ýʈæY/Í9£Aò¶>Z)MÝýw„·àãîU9 Ù’¼OûìC´+ÖãÉpðØ@·C|¤OQV‚œN^<Ý à-d:[ÙÞ…üÁÛEê àFN¹Û†˜³áKËRÛÌ÷ø<=íüËø¢4´QÚËB?RQvç~:Ú:Ñ´)'®HÓ¡Bä2Q ͸7TŸºoÊ°¥¹‚rv6©¹XÇ_û‡<)Ê ù°(ÀŒ½jPpßã‹ ”%Žò:‰ÃÖZݬ„½`ª”«u0úöPšo€z*¢¸Á—y&‰¤‡/­œ­8$œÎåêÇoyp¢BôÍ”ñ‡JY¥µÄâ„sPS…즓ґôjäR Cf1Uuû›a°¨x «7IïÈp™HêÚCàCÒ’á<ß"lå÷n{[dÄ_×̆´ç¬7†å2]ëïë“B®-é—ê«\k3EÅ°I*%È&þ’RÍ8v»ÇÔÍñ#@­¸ŽÍÕÆÍ ” |›ë ¤yëŠåÌWOTî}ó­¸%Öÿìp yÇ|;´yg— \è;¹ä€ÿ½¶ÏÓú©l û\*¼i“YÚ01²^)€HžŠ[;T)Ê%ºª$šhÕ˜•øÙØ”^ù—T?e4ÊZ_FųÆ®|hAWÖì±a{Ò"êUt¯Sw©èpºý¬99¤“Ž¯éÈeL›pŒuMÑ"p©•-Il'XÃ<‘Ÿ†¬d€¶|10¸ò…ú~Z>¤~†‘ǘìÚ 2 Aê&¯R b“ƒÂßq#¦5vp÷Q ¯aÍ×GÀ¿9:øþüdæPendstream endobj 125 0 obj 3694 endobj 129 0 obj <> stream xœí[io·úQ¿âýÖ}c¿ÞG¯9œ¶pÛJ€".PÛ²dòdËrbÿûÎðr¹+9º ŒD+.—ÎÌ3'õjÇf¾cø/ý|üâèã¯íîìõÛ}ÿ½:âaÂ.ýxüb÷É1L‚_¹˜¹`vw|zÄfïŒT<.e”å~WƬØYmgovÇ/Ž¾ŸøþÀgg•qÓ¼?À,i¥ô“l†µ–Ó=aŽ ?}»g3óÊk/¦¿ï°1çÚNŸîù,áç1¼¶\X¦¦¿à£R8úüÞ+ 1#´Ÿ¾Geq§éKøÜjÆùô5|¥™Uå#ÉüôRg<ü’V•Ršé3ø6Ÿ>lj­`–ô³“vú¤Žþ?W^qoþuüW`™ÛqXZk‹üæ;¡õ,þÜÇR1xlé¥ãéY{àvqpœã=w³µ°ßrr|¾_ÙøMY:R„B¬$ #gk€ªã“VL¾<âgìcfwföqîW•ioSšצ‡u…“H°ezºÚ»Y+)Lžªœš^†÷Ê[?#Û˜3Ö33=AÎJB3å Ϭ½Ä÷bÜY7=†'©¹Ó³¸€uœÛé5 +¡™ÌÃqÝËÀÐ9]ÀÚ€HÝô`B…0R:zzSåý£}QÜwU^׸У™‹¤ƒh€ˆž^ï(oΑXAh:zKq«È=TYüŽ Dôt)u[²$¢%±Œ)ŸÙÁáñΕŒq?’Š¶Æ“S¼¤; ᇈ0xOOq…Ê1­ÿ¨<’«Ùf# áçT~e« Hɸšì#ܸµÓSÂ%²ÚëxHe1B‹ÙÁyÃÑ„w\ó5N'NeLV˜xä¨Gô·>=Œb±ÎQžVêÈ&„•QXLŠ¦È·³TLD¾äÉ¢¨ŽâEeþo£Ùd–uÚžNè¹tóVþ1 Ð@[„3œŠh˜ŒƒNÉ `´k=æPp­Pzn8nAkÈ?«–ª§ô£hÁNi'¶ÐTÃ^„Àv.ÒÁÍ ˆ¨žÄÍ,øŠAAsR¸V1(mOq:˜K BpQÆ.Ò< °jÓæI ¼$¡Å÷@}@”ÂÔR‰'\K †6môª,ï´t-¾—ªC? £Ì¯ç'.x€ì8Úhó¹fzà„2É=(`3™ºmˆ¬5J‘ˆ%áßÀRâ«ðK¶`cÄ-݆ƒ•a2Qg2¡ÂUÖ‚c†¬{¾²î¸.ÆPne]¢ˆHƒ5°‹ìÕ°ÈãIÜÜÀ ;ë ÂûƯ•­+šq&V %_‘͉ExÚ¯*Õ½° ¿ˆ?J.ä)V…au‰ŸYœÒìBˆ¾N²P “–µiÔýÙm=bˆà:ÀñŽÑawfW…‹æׂÙc|N+¸ïVdLðXһȟÓ0<ª©ÄùS—ИˆìõqiÁ¼Axÿèø£ïSP/ÄÚIöŠ8áüÒ{ &Ç!!! Æ„ŒT$þ ŸIÁä+¦fÙaê‡Å ‹F¹8Ùį•h´é$~hý&FÉàp¯P_ x–7XJ$?ZJ!Ô¶¥ìâ¨*öÌK§OÓ–v‘„Ó(» È+ffú9vdE'¶×J6V1>ð“=ˆ‘aÌ ¶G° XËkžôT—’ØÃbèÔ¢™•6­ÂÚˆ½˜yB6¶fî~ƒ‡‡ŒÔe#føDRQcÕU£Eæ]ê [ÔLŽ¥Õê… Þín ÛaïN*À ÌEœ ÉsÔ8¡ Ý„¼_ üžW#^’"·<*xŘ•*Ñ$Êõ…Cº êªóÑ_ {!VÁjåÇçõvúfÇÐ~•QÎ5ÜNàÊu äÑÓ:ú¬ŽžçÎuôU}3$÷¤>F…SbúC½~vVçþ©Œ"ëJ è¯<ÊÔ9n¨n›ØçHGc¬û0Ø3i[²© &ÁãïÚHì•åÞƒ˜ »-©™Z =Ëx ôhÄ¥µÁ(Ç„„«I ž¤®t'øbðsÑ6+o«A=K SšÀvÍݯÄé§ÙùoFi¡@m2¸ß‘MŠìnV"ei%’mi­D*:wa%ÂÜd%"{òàI$6⬠žÖÁËúxUÞ_÷ƒáñáC1αCÐGnàÿ•ŠĨ@¶Š¥‘z†4üÏ8Ê9VÙ¾Dq*ˆ©±˜ëA,t,\mˆÆ¨ZÖú–Ôz©ú7eŠT2â+~°}X‰A~YŸVºI`‚ÉxèÆŠ,àNÉ ß²©º>¨eQKIDHä¡n ¬“ÓßmP59Øãd‚Á“VF¨á{¡é+Èg?™7Òg›‹£ÜóÖ&Â^Ò 9m¥† @„ø §Ší 0”ž°›ÂÝô˜Í¸~OÑbAÙCŠžZèk—*>aB\Óû<ñƒU‡·#\ŸÞ y ¿ è=ð.×Í×+BºÐDêK€±<—kr$«iÊs«¥. ò³(qß9ë¦2PkʬµKÙ{®%J :*»`£Ð,–Ü Iú©ÕéR|¡›ú=êûµgbÇŹq‘œŒÝ Œ–Tθ7Ï+ 0‚ÂY``FÅaK{W“‘‘RB´g1˜L ߇C]ØD㿳ڠKÃZø1ÁvfhßÒÂ%Õ’>ZÒËòžøÉë2¸˜IQ.tʌ Áë«òþÍÈ9ŸÔÁyð~Ä9ÎYí .˜!ÔòQ©L„¾ÒfwÀ¦p ÜS³VCœ>vÌ©çÙ€B0ØÞË™A²òÝžsxÁ²á{#Ð僪+À®V0H!µaÒL·Ô!5­U ˆh Ø,`P¾ixQ¸™p]?ø£é3ÔeŒ±yg¤ìQû&<Ð:TÜèpÍs¢HIC79«Ä Ûý>yÍX- ·-Úì@r;kÅõ¸PT«­$Ý2—R`…LmeºÌ5ä#ÃŽÿûÙí:ûn› ö÷2¤‚”0ë"¹‹qYÌåeaÄËjàŽ÷œAÚ*µ©˜ŸÎÁI{ËŒ‰Uv|$HL‹aZïm#W¬á« â²ßÛV^/Æ+w×$àÁÛ.¬¥)âµfz— öýöÞݼGo)´73Ol_ŠÀîºv¥“X‚·‚šdiÜ‹zYb-©*“×ôXÕµ®^(¸©ª¾Ü ¯«ú6Ê )Œsu#<#7r†]|2ÐP;`sÖ–ˆ=¨>ø:çmÛ¾Dž{5ãM¬AÕËôªÍxZký„*îÃÂ5Ó`dT/¯ú—z/}^z3ÕPaT›ÿbuÚîŽOèJyU®¥•–8|Z##älS(1uæÕ[Ä p‚ oÄ`L–Èâ P+ͪ-ïã¢6ï ø[;‘Ðö&ÌÒç ¢}#·bª…ǘуãà¾ã2D„³Ühd%­½VeC6:»¦õnën5Ô2ÕoÅa?½„´w¤ªJŽ¿lé— ,È:ôs4ì()öfÿ½Ïi3¡á·ø^Í\(šàR/Ȇ ôÞ•@càÉÑö‹’üÞ«žü^÷U‹JPïówᶙÇð³i÷c‰ÂƒÚNùPFë-yúiœì•¨[iÎã6ÎÁ6Š:¹áj ùmy¢ÔuÄrIç¢d=Ï­pëàK”¬UX»,’uvÛ‰ R’­÷Ñ,œ&Ù5áiäG‘z1I¯ƒ4ˆ¸–ãf3h£2Ù8¼ú!åö…3 ç”ôKíx]ì6àÇsc¹haûÚ¥êëçUµÁv½<狆~bBsëm‰ýa£†èÅð“ғצdÃÄNáÍ°À/µædš 2åúT§·™t&–F5 ]Ö•n‡Âk͆c'YnÑ›9õ’méÒã™Û+h£ü&×¥Rë-A׉óQ…oy‰96á‡Ý¿j(ûVØV»]–v«5êã¸ün³H¢Äx¬˜åÅ LÌ™©Ù zIp:¼h=¸:I,àí=X`$_ó`yp‘F¶|<䃶 ÿ¿f$ ]"#‹#kÅ·½+8ôä^ÎûÜÍ_äKñRQ²#¹Ë¤äèï()Íå$Z,ˆ‚”?+"Š 寂ü9Ddw/óÞ—£ ·ZL6eéo²”*Wät›áQOtã-“þÏ7pT¬Öo¼)fj 9ªäŸ7ùÔë¡Ö‘KA?ÔQÒ»ª£dr 겎^ÔÑ›t#éVß!oªæe”Ôþ9ˆ€3­Ôˆ5XFbÌ5IÍúÂÒÌZÖ~ÃæÊ\4 ûcº- õq?ï”÷w–ëÆÛçÇG_Á¿ÿ΂^endstream endobj 130 0 obj 3458 endobj 134 0 obj <> stream xœÝ\é“7§ø¸Å+¾ðñ›è>Håƒ/B€pŠ*'Uøܸb;d„„¿žniFjsìeÊ•x¬ÕH­V¿>f¿Û±ïþÿ~òêäÃvwöæ„í>ÿÎN¾;áaÂnüëÉ«ÝS˜ÿä|ðZ‹Ýéó“ø6ßY±³ÚÞìN_<܋ÑÎ*ãö,=~uú‡ñ}1pÁ,¾ÏïŒT<’b”å~—Ƥ“ƒ(¾{àƒÔÚ»ýïq]ΙûÛ60/½t|ÿ˜`µàz £–+Øyç g´Ú?8…Öƒ‚Qž‰GØUjám¤Òõ©´”+èù®Áœrÿ9¡âó‚¢°¹€OÜ Ös“Éz_¤ÇH’”¦£4~ÿüîô)³œ€Á.Ïòã÷ùñïñ‘+G'œçÑ7yôEý6¾Î£lvÃÑŸóèÃ4‰×ŠïÌ ¹‡›Ž´s`F™ÞA °œ17Íý*íÑ[ØØA&Ê…µR½…A ™ûñᨹœûOêÓ myY1û<Ïmy‰ /ÃÜ–—øØð2Ì…ÓK8Ï ÕþË}þ,Nzÿ¨¦7<~~NÎójå¥éçOò ™úåaš€Ü=r‹?ØÁß@°50•è§üø¯†%(=ç…Ø*ïb=ÍsÉÜÏ£òèyôÓ<úyýsýxQV9¡›DU0öjœJ/èq×oz4rG[¬©ÀVáKñê+;QÊ×yôÇ·ÉÖ9^j·™—Êôxù}O.·ð²ö]G)ÅGáƒæ(lõo°ÆÎ9)®NÉ*ô1Ï€XÁ½ð §`Ä crs¶+7Á4÷OZ¹P6(éW^ঠåÜⱤ”ƒƒÇ´Ù䬬”~º†C87Áhè’ZîŸã¨äƒášå£DaÁ)L)˜ ÞÓHY,qŽÊqmÑfÀžyïÒP¸ˆ]YD~s{w7Ïe“ÄÚýhŸ=ú뽼ܺ÷Šu 1­o„Š)ðU9À}GD!,Sÿ´2ñOš‘Bš‰\ùýKz£ã?´5ÞP&±óLÚR^“}ÎâK.@ Lˆram8ê48ÉM"‰IAI:KYØáQFAm£´€Ð²Ç( Bû‰4®A É"å{£d¡éÑäÚèb1Ð$í¬Þ'"ƒÍš&Ú<‰š1Ú<1(€nªdÐÄBã×D]ј°8¥-nèe”ø9hÓXWjLù¯WsÍ4ùñO5ð5ѪUÅM£äaBÁÈà0}Ñ‘c=3tÒãCÒúbŸÑ2¹ýo³]è‽^MRÝhKÐ ¢-·ó㲶Hàz¦qá[ËT˜AÀ•n'ãN~<[e=â(.±H×LÜÝ÷ƒG÷Þ2îçѳàLŽ{ûEå€lia“giçŸóàfʈïéé‹ð¢‰K"ÁzÁ‰ÄV"oçÇ—éç/—ŒBG_™ÊlÒˆu]·7N"‡T¹lÐÑÒ½ †g4·å£ !¹ ÐzøÒkÍÀ³»Aˆ° xç@HÞ¥Ý8 1à$;:ai9¥­`|Ý°xÁ.:Á^– WÜ÷¢Ð •Ò…×U™• .jœ/Y™½23g8¨6³Ï¸û®³Ë(UxéÞ3R¥*¶1 àRÅ&`ÍÑqÉ)¸ëáÙ€;§xŸ©»&¨GÒ¥}t;‹VCbCVx5dl±C[z"ȼÌo˜J"‹Ê0´À×½èvêF”¯OvÙˆ‹§c§Mæ+Ö‹«›‡ÐOó(Q×Çyô‡§Ú(ʹ¡±K]VØà Š>-ÒÜvYÅÚmÑ(ÐtYžS)ª)Ð"Ìz[·’à›Æ]­¹ªèê€é3Uô‘›¦ýi̦ó®'›º=Â]»B߈3+Ú£Úä×LgÈÌb¤ ªéÁ%Š<ÖLoφ¦¢¦Â GÔ¼äÂÄK«ÛI<ÉYÛvŸÔ³SX0¯ ^[×W#ݦ¦~-›œ¯Û²¶ôá@aäª$fPp.Ûƒ”ú?¶ô M©¾£˜QÝØ‚4 åt>‰Í`s-øÙÞÇßG Mw§ÂV5oxàçhxz Öº«©OÉÝ6™£¸.¶ŸÁþÞÑËŸQ‹Ù¦¸Ð>¡678L‰ÜGÑubˆCÖ£"V¬òJóÑ”}pÉ•t”Œ|XR¬UÞפdtëÆöU“ 3½ÙÁ,ÄÎÈ ÷3ÏGä*eøhh,¥–:WãqDi£ —Ò±—ªì¼·Yèñé‡C¼äœu=Ù®Ú‹ÆØ9U8RSÉqÚbw+ó²3\ƒ¦H[ÛUb±Bo«Ö¥þƒ_Õg&庌LÝ+HC°ÉF,WbxOòúÓä…BÏ ¼ílUpIWÔ|öƒ «ñã|´îÂaʤ(µ¬`[®¾nõIº¤6q“ iíçÔMrer¾å Lžâ†b°BK²TG³dW®õ¼Y8j–Œ¢å”8×¹EúÔ㇘ø-Eñ9èûPn:oh¨RPgÝuI ¼[„ÂOŠSûX/xÖn dÃÇ9)$¹µ²0âe—£WŽAžë¦€UŽs0ÙÄ¥ó[¿­ö*ˆ³Uƒ˜W’€ïæ·ý"…x‰ b7s‡ tîp"ý#¸NíA÷õõ·@1ß6ºÞT¥åÁånîB¿ã_\YÔLbz¼Ì‡S½åÄkVT¿á¦ÊäöIã ùíŸäQÒxs¡òÇEnÿ¸xû€îiÔµxû‚Y÷ÑK¾J]%]ÍÍ×U.w5ê*ïî>DW鮷ɪþ…3wm'L5›Šmz‹¦°`|­Î…Ähˆf 7ÅÑSN„»nÂÆñ…ìRJœÌæaÊ: bu8öŸpKÞ í‘“£$Ì.fŽzù©*nÏËýå»iœ&§š0y®d9¦U ™û§'…?ÿé|æ>endstream endobj 135 0 obj 3590 endobj 139 0 obj <> stream xœÝ\[sÅ~×KþÂyÜвsŸ ÅCC%eHJ\)ðlY…oX  ü øÁéžËNÏíœ#YvHÊåòzÎ\zzúòuOïþ°Yf¶YðOü÷Ñó£¾2›óË£eó9ü=?úáˆù›øÏ£ç›O ü—ñ™ñÅlNž-³³ZH¦ÒÒ0·YÛ ßef§7'ÏNl{Ìfk¤¶Ó¼=†^Âá&Q4+%¦Ï°e± wÓ߷˼8é”ãÓ—ÛcX˜1e¦O¶lðï ül7‹œþ„Rbë_p¼“@bÕ›¾†Gip¥é¯0ܨ…±é+¥#×AbqÓ?:íà?qV!„ž>…A°øt;r«•„&˜ÒÍV˜éãÜúO.dN{òg`™Ý0˜Z)Ž üf®Ô, þÜÛæB1¸má„eñY9àîW±°“-³³1°^Û9<ßÏlüz:P„‡˜IâZÌFU'g@Ïç‘O, ãrÃä,¤öÃŽ%°sÑ›c¡gÆÆʸtÄ–Á)ˆ~sê Ì…Gçļå·`8—‹ž^Èă­Q³YŸNÃ(ÍÙôw+µqº.³€ƒP|ºÀÊ Åb«Ô‹˜Îñ¬€P§§/ ZA‡Ç™„KhÕFi ,<”…ÓÜáI‡9Œ²å8?ñ¢‹Îd峸 ©An‘4hgÓSßA ]2Ù£LÄ÷¹CÜ‘,ç]w„b¼ÎÛìÈoã_yس<ÙUxäšöíJˆ›AÝïüþáª{/½L‰é¹ç bøôÊ‹¨t&, j&­Ä• ³j±¸86 ÇŽ ˆH7nhѳ•N¤[9 ññ–ã@c‘ð<.Nb,c&ñEö»­/XtŒS[Ük±"¡î!¬é,K ¢R.ø(L'¹œ~ ÆäãG2ââ šu\…©Eå™QjŒ´Ó´FšÉ‘¥L:\™ƒå@0åÝÓ@¼‚îaOäŠÑ/Šqµc¿ðõÝ9A2Á+œ›W{ŽŬ i]ä<Û/·Ó- ”`(hÉÄT\^ `àEÓ’ž±H’Vº`Àe2Yö)â: ˜–›Ü L[ÄzZ‚¢„­«Êå£(½¶; YÉ_/ÞtBÒãX)¹9ù¾0ØÇ‘}ÇÌ?¸DÝX ;žXúGð$@¢ i$–PK0¹naTž@«•¨T“I‡Lcžª8·@–÷@Å9ãzÖÎ$º!Rh]°>t`Š¨b1׳öS¾^ DÊqØ‚¼¿= +Îé|”&4ãÈ⢱N@Þxþ ø0F¹]ÐÐux¢AO¨J½Äf «4œ„°ï³o÷|³Uz—¾z%\$üš”0-Šç£ OaÙåÍÎ¥AjX²£–wpò:®,©Äi ì1FÀ:WÊV)¬ ŠGnTŠ9Cf] º¸âuK8˜Sø»YÙgÔSâP ß–]W´Öxÿ,”óg{Šb†æ®¿kvªÏ‚{p“×ÝåWõóë2»ï¸ÉG;Žð¹;è:°F–2T™÷t‰Ú4‚*4Â3ý’'!ò™C,u´~ATûŒºåQ, sò ‘wõk<£¹±ôÍÉ»½ŠÅ@'½ê‡KœÑÎ.["œç ¶JÄbt·Ô{u}Ã*Aª¯>õIyýñT\IDàZ€_õaÓVszèY)AUü>K/Ç#Ïä„γuJ,݇V€,LRJU ÿ»a¶ÐËë¼ Ù}¡]oXÃBv®Cˆ¸,ºº¼¢ªì"ˆ¢æS gGºXä,GŠ¸q4ÅÜ.§¡8ˆ|À2`œÅ°„^ Â>Œtx1-qRÉI’°½Ùr†°A§8„Ÿ/‰¥§WyÃÊ. Ï‚7<Û&EvÍ|ZÖ‹QŸ5s.©a%%šyçˆy$àÿb(W8p `•ôb«6r((«xt80B<žHý,Ÿ@N}ô¶GÆÈ B;ÌÇŠåZ[ц;AöôŒ²Ö ¾îÄ«çÀJ>EèY;Qð`2QÌãϼ‰zVs¥LŒbÔF&QQÀ$ÍÆÖ®i"¢eQ…1&jÙµ…Ù`ÇZd¤”!qA$JÈÈø!Wm6Bb†Ö<…ð¡  ü’ög¼f`MDe IÚ,[èH8i#œß+Ô=Ÿ[šÂ YZsîýÕE¥ZÀMàÕÊ* ð3\6ãtÔ¦_)ꤚ8¨ÇŠKÑ =Vº>:™Ÿ žq¢€ÙÄLúeg˜¨±ŠÌU,J’Q´g6Ç™Çk ¡ë¼³vå¹Iq£=+™l ¥ø¹ePyvæ"ª]=‰%]:…e¹·pÐØ8Yë:¸.ÌܶEZ ;_A°DÌÚÒG>I)‚Ix–‘DÜuyïo +Êü²Š·ƒ¬W¡uáÐ…°£ ± ¿‚šU‚Hà&'¨ê)Už°+¯RxmBÍ‚$Ôú@ y³(}·Ñ@Ú‘0%ÀŽ­låf¹¤{ëgÑFŠBqoa]Æl€PIub%×=å e|oèV-”5}3­é­¬§ÄŸP\8ã( ¦NX“§øÙOÁ ãvGLŸ\᪲ù÷ìˆcêËób˜ú¤pÉÒkxQœÕëÀ?É:dVÑ71•$T©cX àº'}çż‘…¯ý_aÕ;Î/XªAèõÍu $Š«=±—¨[&¶§äýìx«­Uȱ;ÐÀè‚ÜîÁÌz^v:ŽÅñZ󥊽RID‘ìqÂÊøl˜û2"(ÒnA9"5jS{÷%É/s‰ÁͲ\gµÍÝ|ýó@ïG»ù€„ø,ÆŠ¨úiÏš5#в*áð¾]YL?òCˆ×M¢‘x)Í»×Yãlt¢5°Ãï5æB , X•d ®›3.-FTÑsíã_¼cžia™Å›ïG§‡¾BŽ6#Uà­$ò®îL‚OþñªâŸqpnž%Ÿ:wÛ£{…jCxm¬tíM,x“=—bJiðqÌZ¨Jî¸ó§¸Òêà ‹ÌöUÏS sñ‘œñY¼\æ5n'Âø*Ö0QÈåËÐŒv»)+ ÂWœ~Ó¤ÖÈÉø#ÓŠl2¥Z5NÏûí±Ë Œ(=VÎ4ÓòOãæp{…ZõKcõ‚¨6…((ÌWñÖKišÉN§{öC‰—êÙ›ë'µ~¦”ù↡êaÑ¡œ–ðŒ ã”Þ˜Ù™…y£‰å¦Àj%¢1Q`{fé´V=;+gm,K(ÆPÆýº:MZ$KOµ[Óì‚Oa©ài¿r©ÂŽ;dð©ð¯‰È õósga^T°Û„—……©° Õl•‰‘ÎßðaqÊã—FÆçP-õ`Ýô1¥aqø¸è¾¶*dòŠ40 IDâµ®¹c“㬕Yb¬c\å Ç^Róëàð{WvÀ{ø&L?½›}]ªªîÛаŽ–¸u³èý[¥PÝàDY§«ø€¬M?Bã±µocg³ G|4ˆæÏq|MgTGH|kãU¤3R¥Yå"Ë–wÍBåpu“)4{XZ 4@F¬¯!ã;/ „ÓÞÄuâ¥_ˆJZ»‰Ìq…éDÜJ>ý?ÔVA¨‚‹X¦‹FÎÌuââïŠLUcX±gòZ$ʷŸ’7å…ç§ØÜ8Ô–á}v “Á®Î×ͦ §[¢•½r¨¨nd¯}Ÿá< 8¾ôVfOM›À°VS ha’&1{Ð÷IzyªÿFÍðNWë ]‰©¦p fyÖÛîcèz éœ Nô`Þ‚ð€ÈvJU˜,«´Âz<½%"0ñ¬º3¯MQ·†’p¥,JFé€ÍlU'¡ÔKV¹÷€É#µ%N( •B2W©îšwïI\SU˜]&ñý:Ûg!Í;/·ù„½RmäZng¡x¯hˆ˜zkâP¢=¦:fQg«ùž ÑÑMýŒSuX˜ƒÕ#_ùd ‹Z) ¹ð'8îvëÔi€‘ÒµY2E‘ÃàºeøòGz1ÑõJ­ª’ÍpZ ^ð’eŠyk8TJV›^_ø ×{'B&ŽŒ:.ëÃÞJÕhßsÝU@›$`·’ï[/rÒ øÂpÕÔ:),áU;íý!wýÉÞûW­}#ƒŸ*;†)þøîD×ú§ŽÆ\…Â8Ì#öà֥÷*cs7’U<ç¼ yõz€D׺ ‰©çpiuŒ·?‹ Y^xÄïžåVxT ~Š©Ðú8÷½Ê­?åÖÓÜú:·¾È­g¹õ"·žûGŽ—F¤•,Ah‹—:Ǭº,¡v~|qRÊ ”œÁ×ó¶~âÀ_÷„5zó á- «vÌìó›¹ïGÀK° ¸»óš—~Ï-/ÉÁd^ú¾-/—pô†¼ dQø)‡¢ý³Ð=äÊSãë†xŸéYO×Æå ääÀßoK£ß‘´Õ­W¹µåÐH*¬.òD·”·éÃ" Q©8t‘ÿYÑ£¬PÓäE—OVú nôï­¿¿×ÎËU#okøùõ>y{pyûôåíáÛ·owN|7"öù>{pûôEìaîûm߶}±JÍiM¯|ºþNöó|Ï ‹õ÷GµAÜ'•äaÝÅÏYN^åÖ—¹õuÁ@0³¤t?·žä¾äþ˜[¿Ê­_æÖö‰¢ ·Þ;%†sÔ8R´òâ»//{P;„Ð:¼¡ŸaÍ^çAZ‰¨ýx‡lðŠéðJñ¯²£}t3^µ)$ áHhî&ƒ”ªdšÊöXdzëí‡ø•Š~ÔnÆg?ÍAÙ©Px4¾("w7‰:Á†½Ó·I †%Ÿ÷"‰‰¯V5똅bîÍ¢üˆy‹Y(à)Dÿôs^X®Òyô„¹ ;LMy69õÞò{k äll'¢î©÷?øY!ûå²;ç´^¡ÊE+S¼4M¾²ö’T¦ªýNZw;Ö9heM÷ãj>÷UÉÓLäúwß.IKðÊÑèûý¼Ö >^Íø÷g´ãûª‡šü^·Æ1FáD!:¡7©Å!Ÿ±ØóJ©0;èk„ks_ubNDú;uÿù £é7 k 721á”%º•© õ€ÁÔË«öòµÚ5-1(vò†Ý¨kªCð­«ž·ó”Ö¾Íìi%H‰à÷6–ÁÖóºµÆ²‡‰ ·¤ªúsøVÚ; 7l«Pû®hðÆ ‰e@Ìo:qW‚UÏ{™[÷e–@ï[Í>1«ÿC K½?ìG†ÿ½|ý}bÕÆ7«=I†ÛKÕî$ÃHÒÞ Ã½}’´+­p˜$eîù´BÇRýÒ ÷NŽþþiÎÙÎendstream endobj 140 0 obj 4876 endobj 144 0 obj <> stream xœÍ\I“%7Ž}‡nïÆkð+´/&|`q°oㆋíøgzÀžž1îÁføõ|)©¤”JõæÙ8ˆ©§’R©Tî™Õÿ8ˆEýWþ½½¿úñ#xöp%¿ÄÿŸ]ýãJ¦ ‡òÏíýág7˜„ŸR.ÑZu¸¹»Ê«åÁ«ƒ·~‰îpsõþQ]Ÿä¼q=~xó›²^-R OëŃÓFfTœñ2ê˜zQ=àŸ_ËE[ÃñWWJÕñ§×bQGäñO˜à­’öxƒQ/ v>¾KsUpÖ]Ÿ”µ‹Á¨lH.×'쪭Š>cf‡46.&tøüŽ`ˆ ´>þ‘añÇ£´¹ÂŽ7×2,Þ½É Þ{õ1£dÇé¤u\|8œ´[âáæ pyŠ£áý+?JŽŸ¶Ñ—mô³6úêúd…Y‚p´û:zÓæ¾ÛFµÑGmô:š1µ†cèb…–OpAR¸`f§Âa[§~pL€U0êøQÞCÙãã6øÐÿVßp]Gi‹“–zq ”ô‹6À#~hØ?mgz5}ÑF?ÿº´šÈG0¼ÈÏèóªžÿöËÑçÇ°1 +Œå b —WêòVEV¬«¬)üQχ×ÙÚ‘øǨáíñ/‰Ï•‡ŸÓ ´•„ùúøÍ0ÎÇH·L œ’Dt±( ÿ½M~Ɇ¸§moù-œ£•9þ:mb£¸½À³†²æxdž?cÏ<>̶yÒ€Ð6, þ`ëò.Æ ¹P?b±àŸ'ì0^â¼ ëQ Ö•GåÜznÓCcHthâ¬zü©@…K÷Àçl·§óÓ=›Oa[ßâÑy¯Eäêhc-ƼÐX‡›ß]Ýüðý Ƙ@ç„Îv*xÜXz*‡XŒ“¾²‚‘žP'(µÄhªÖ¨GƒBʼnŸ6åN¢p÷Xô¤‚¶ž-«´«¨LuöEƒu{­`•„éÞ?¤AiU³{̤€]UtÛªÏÈDب³ †»Aµ( ó÷¬ŠÒ-[mM’5ø A¬*MP6#Ðë]tÇ·)2±h€®Ótäbï{Ä “¼•u/hPz‹ëKg7Ê Û¯Ë7e$Åg3D»t?^­ÇÁºf¤m3ÓíÝÂJgf]_¦ÛQ8ÙËzyŸ6<`©E\¤vãDŒMl]pEà –™Ý²ñ¸˜X·‡Š4Z-ÖßD8—3á/­NÜ£ ,CÐ…¥hÛÇËU¢ÝVlÒ (ÌJ° VÖù¢wâ€Ëƒ¯å*%ó‚ùídêÌ¢\¶¡Õ&”ùZ((Ïx`!"ðÁŠ°žÍ“Fg;ávÙês"&\,\…ñÂû˜Ü‹áúº` ¤:1\ßÓ)½aÙëÇMÌɸ+€…ùè:°"zYâØ¢¿5FkLß^Òx«%åÁFÇ/;à^Uèp –RäüúÓ¥W"šnJ‚…NFÇ Örjn5°ƒh²)™ÝK`=V•îÌóZ÷JrcãÊóß¾>Áú[+¦‚H@3ßp‡Õ¿ÌÜ'¥–À`|²‰ã);ÛÏ/Bƨ˜@‚{qV ½Õñ;DNåqq…†OMϽ*|NØÑr•©ª>·+M½wYù(}Ü•ÜAäÓ²î.Nˆš3¸ºçÒ ‘a³Y­n]61{ÊZð |»ÿ¦H¿=MbÐJ("éÿ)8؈¯R˜â=É=y¥àíVãÜs”&¸9äï “ûí,äZˆÀ}rÜ·<š¼Ð¬q‘¶ï݌÷ҩàý:;à ¬›gñ»ùx{p‘¸»br]1™mï‰îâ+mØä,B\d”UÌ{ “$JH2K1ïB(¡:¤›QWb£÷‡:ûG$)j!¡yþ²?1‹‹ÁUšó÷gÇý>MÆaãT tH*Á“kZtDÞltp’ÏÄbvÔ@ŠÈ`›sŠÂPÌ:ØŠ‡¼1„³³áÜ!Nä1ÃØzn¤D^0•—Ï$£ïîàz—¼h¡UQÒ Û鯤–”³äíöîêðÔÌS%ûÄF ÚQzÕHÍW.ˆ~HOÚ©Ÿ˜´ _™”¼’zaÚr‹ÃU_Óm;ºNí‰Tb[¨‘Ó2s šËöiY¯§žS½T„ýÎù]ÏwB‹>F˜“µ3ï?èœZlhœÎ„×z¥j~åLa#d›¿ÙhøHC³ë*©«ÞòRA'ϵ·“W¨¡Æ¼œ+O!㧡2ÍÌø}3Â6ø]½Ò;êpã¿Ú‰1öìíı†ßy+*§æˆWY¨;à’2’™EšÌ†…V¥¬À$Íš\K–"†¥Zcq6#iŽW„Eg|³ZÖ”âÜ„ÀPÜ5ÄõZHÕÉ}yá<É%GwÏ~N@]Šæît'ALU6~Š»!Q‘L‘GiýÜ…ÁVfp¡ë½·irš®LîNò@èë%‚ ¢áüF=1‰>#CE?ÑŽïÞ\ýùÊÀ8q¥ À™ƒ5db÷WÊ©ˆå÷ó«÷¾dÙð€ÇÁBµÊõßzÊ ½GجóÄÏ2ÃìOU2à&œ‘«.u!%ŸÈ¿Ë\Í6:½6aÙšIò/®Zϼ0hÉ\ÍÖo_gŽì@_A¥2Ř?âŽ0ų1‰b--ÁCtOQõKH8á1î;=+¸Su)žïèDöØN‘ã•J3½£qWõÐLu4ŸmÂYY0Ñå …Ž. qt6ãŽFqWèòZq€°ªÜÞ)YÕç÷#¤sGÈ}5:ìšã»kJ³j&ÅÓŠ%4“fn©'¹£©Î”BgyKÝ#óO&.ÇFÓî%1·i®­<÷ ¨"P ZyHΆŠ‰•Dï¬BZ˜4ìeJ·}õ•66ñûzeÒl|-©Ú©ŽïW‘xÒŠ‰¼êÙÊ¢,‘ÑJ¡±.´ÇTc¶ÕÏA­iÄÏá„ÌÃÖqBȼÉÉXAÅÔ^T7‰ˆQ('‰ˆ1QüœK e¢¿\6ÄS0zÖEp&?26c'OE9 ‡9œ[¶¡ jr¥9»Ÿ mbŽl,ɶßó˜7ùa¦©ã´8«„`ל;ó*^`S6ÙÔB åÜ"ä²A.¤CTÚÉ'#çÇi4ÔëM²ÕÄfJŒ'ù:•ÝÆ]tߺ6¶mñ$¬³Õ³uñl<¦èËb‰tJÅ„»([åY¤ÜÞ¶;â¼=ŠãpeRïä:­cI˜5Õiþ]½(ð “´‡Î¦´M©Ð½ äT&×Â}ŒÞ¿ ³ƒ2S÷ˆ:(„DBéš:£d´~ÆQ'9Œ¥ùzLeOJ ›¦p@?‰übs"ª[“©æ|8Oµ¶ PÍ5¥š‡T˜•j/i®µð+R„5“Tj:alS ÈVš±ž„©‘;›\À:/mÔÂd§-LMœöäüUŽÏ‰3’6c„aÚæáºhm{ fûŽ}Êj#Ùoâ‡! Oz@W÷ #Á¦l E{-\ÓF!r=#i3ÏóÍBÎúÖ$\ö>¡¢L`ñâÆôë â96ª«Êlÿ•Š´~O"Xkž ÌMÀ´ÿVöÒ—×Eæfv·è¸†öÄ|ªOËž—™öcu¹ :söœQ΢3½åˆýƺµã'Dwè^³/8óŠ´Þ¦1Óî$Jê:¹»˼ʵ$êüC} cÏ"ƒ¦òvÈœä“tiU6:;÷:g_À¬ŒÀs—ø¶&}M—|R–+Í•È|ýD›”n¤fÂS‘n‡ÄYlCÜt5µø= Åkñ¿GE°/ÕÇG KÕ&€NC$6Ï¿mY5“#«’I”1Nó^cš®A/çó~'¯=c Á%J‡ò–ËqÍŸO=Š(ûUý Ò”Qoô€ˆþ±16ÖýÛ¥Ìò\=äá´ÐôëK6vY7°µÙÔqR=ÃgúWæb:ðiæŒ(#c¯Öë¶&4iHƒOÓ KjóÍÖ–?¯˜gÚ Œ%, <(éý 9ÿºÅlë@öÚô‹ ƒM³Ëol­\ƒ¶ vþE³ËÖëëÐ/ì»Í©áášEùEЪ‡öz]ûv3h÷[F¸2D0è“ }P¸ú.¹ý–T-\a(pÔ‡±5<”ðÛCûÌTxB×(C ‰€_ª††LAnƒA4‰=Œ<ÄРïZ´ix(G¹ CÙﾃQ†Šâ%×ðH¾w½B( ÝÁ(C í¨NÝð€«»Ô[ oØu ÊCòÁohcÓ¿ëþ =Œ<ÄаšW74,È#m…aMæ¯"ܯr¨¼ä®Î(rW~硇±þ¶´)ë˜D”_MÚêkÓ/6Æõ·î¤ N}[õÒV_‡~qè`ß½ñ/O ñuÑ7ZÃÃ&l¥¡ÒãÛÔôŒWŽrC©žÎ‡0± $u^¹`¨5OCΞ5ë§f¡ÿ®%UèOõK•dB`\qÕÓžlˆ’ŽŠ‡lå¾Ê'¥Ï¢Ì±$†bÔ:·z”³ÏsxÓ©£Š&õ]¬´h/[¹Ûm¹9-ýÔ¤@_¯P&5Á½OåÍVwé¢\Ø6Âäl“JG ¿ÎÌíê8Þ›AʱuÖRNŪY°íZ†X›÷1}!¨¹¥koi½½‡R‚®å“Çkï0)L¿œ86Wêpò|ÑØådÔŠV~c·£rK¾xŒ~ÅtjU²ÿW4U­gsŒ¡‰ºØ‰“òT·LkÖo%jÃ9óK0%£M­ù{º[Wšâªyk0¯ãç„KCÞýî@‘*¹Äзþ2Bê B›9Y5yLéõIÔõ¥td7$%7áÃzӘ㤩{kÏVÓúZ!%qÃX_yÈ°Ý^òyÔŠôÞ§Ô9¢“@ue궚ê1Ê-X3¶pŠØÌnå±À\N€!©É °ÓMIœaäD¾´¨ÒçÍ<°ëúªû”Öî‡L™}ô÷]‚#µ3Ó`\ú”Ö°ºšE_¿|¦@™oì»åô7Gyø,pZ1dw’Ùc¡á^©<õ¨T:oƒ¦V7æ Ùûi×Ä¥ õ;Õƒò{TÒ˜ËÚ^«W:||æë_ª°¿PáúŒC™ÁTß°¼Jý³Æ$oÓI\’¼iûB§à±MÉ2úðœÒ _GCép‰xU&jƒ;Ûí|¶;üÍ…”3øóÕ§ýQÍendstream endobj 145 0 obj 4993 endobj 149 0 obj <> stream xœ½\I%Çq|ì‹O¾ùðàÓkƒ]Î}1 ¢(²Æ²I¶ ”ò3Cqr†’Lÿÿ^‘™U¹½~M bØõªr‰ŒŒ="ó›“ØäIÐåïÓW7ÿð‰?=w#NÿŒÏo¾¹‘©Á©üyúêôá=á§T›TŸîŸÝˆ-§ÌC9ãe<ï¼:yë·èN÷¯n>;ËÛ;¹o\8o·wh¥½Öñ¬›×Öêó/éBÅóÜŠMDmTçßÜÞab)­?ÿüVnïñÙKå…9ÿŠ¡·ÿFý£ˆ{eãùS<O3ÿݽRž?A/+¼9:iÏÿIйˆeT­µ;„N˜üü j¨‚³¯0dÜ‚öçëÛÿ¢î&Ýïîÿ( '‰¡­U„±ŒoyRÖnºÁÏ“¼l¥5€¡e먃,Ï6<Í°œû[6ï1ßØ8??©hüô:CD›XARNoÞªûφªûQ·f²;l wºÓn‹¹ëë:ã›[…&ž¿’œÙ”çÿ •·Zž¿ —z†¿Ä»è‚S¼÷·´AN£ËÛ[é7£d#~žÁÒÎÿ˜ûH ùK7AÒ®Ñè›qÒ§¶Ê©-Ø29=WÞaÛ^ÔÅþ>/í ʦúÇJ³3$J­€†‚Ã/©­>HéÏÏ ”ÆyfÀø–öÏFÖ˜XÉÎßØ"FÌûG¢;#lýüF9¼ú–†W2Xêç´R¿©hÛé_ÓéµIL;>¯t÷–MÖ¨;f^ÒÈhÒ ü.ï¡E‹Ì&VûŽÂ[ì6ôóÊMÇ?e¦ô.V 2:‚·œãëj ô{ÒP¨ Pí{ÂØ+“’\éÉcÏ_×õ‚µDÜ$¶fÖðåA°ï™è)WY‚,†}z†O¶¹e1Î8šŒ4þ*½ŽAZÉ;òÖ£Xt ýºvÛj‹æÇw8¸ÓÁõ§;pš6Bex3µY,=ƒ+0 Ç—^è˜TEÑÿrvïÑšjš—ÑÐI¯IÔ;âÎL)û.ã”ë¤ÔB@,Ujžr!ëO¨0Ž!œ{N’P•ý>_dœð}gH¡Ÿ_NÖBÔõg´ !h…ñoÓø@úÖ²’‚‚=Ý?¹¹ÿûÏv%L&Z8¬Èž?® 3«cRPÑwL* M&yýû*Dj ÆM‹q“8•åmo7‰Ä„qBíô)4 ­ pLKª/Xã/l½Eæ@ÍEoË°„~íe¤Ø!e2Èb»ºÐc`‡~nz-íÈ.­HϫЛ·BmŒŒ¤Fª0n!J‹Š .8t "!­ ì¡?¡ïvsv¢ò|E/X·“¸÷î’b Ï¯Oi]¿ï°ž•ËÚa\iõ.êdômG¶ýŠ»ÄQB«,[ ’p%uÐ+ƒ}S´ªýñ]RCZ+¢`>!™K¬ %KV©â<Í ûË‘ßÈÂyQ;NÙ´2O1š,ë ̳ i2¬,LØ/˜în„Ú¶–ѾÎ#`4Ž£$A0Ø™ðeƒ5”Í ¦£ÛÊ"ÊŠ[ëÆlÐô|Э$ª ÚY•[Óhy`]ˆCËÿôh|þ;²7#<¢©µ{0918)U’ÃIË|ßpZw‚Kâ)É"p'³éÔ{w œÀ0a¶2³A,;|Ó§Ó.XŠm| åãæa‚(Ø]n7Aþºs?:â[>s™F¨†À )PrŠ™hC¥†78A±ŸPšPYUƒ çìlx;Ñû„ŠÚçŸÒªL”v¶©R‚ ’Èûäw èLÌvSIL€q‹p6eX™(1ˆƒF}Þv7ažÜU"±YЛÓáGQE—m‚ÁØ!éÝFÐÞ‹€ZÎ}ãWo§¹m ë$#86¹»äíyPŒ”qOƒ38ždnáð(O3b$Ýk{R·f꺀ÖAƒ¦¡+8ùP€?'ÖÊ¡®¡ýB}7ƒÆÀ3cÌ{‰ewžuÆû¡˜“ª5Ä΢å;3s+ÄT|ží,#l§ÈÖñ2t¢j¼®§ú&ñÕ_CÃO÷±yÝX´Sÿ ¯Õ9±^Fî|™AQeUXhœ G$¾&ɲžt+ªNô…fZyîý{`3*›†ÄJ<Ž&M²!&& /Šg"'Nà6“ã®l%8ÙlŽñuµÄ’¶º ÓĸœHù`¶etÃD¢„:ÃßNò‘[®“ fì%áƒYwwo bBÇ8­¥À©ŽzmZ2÷|n¾Í†‘Ó\Y2Ùj„™Uبš”ÕÇ‚ðU¤¸%R0ܧnHœ¥~[¶”ÉÿXØû*û.ãJˆA)´²’(rªþ# ÷{ù¦šiÏ/šwÄ2×m7ÙYÌfx(Áyé]ö(~{yýù«I¯è@ï[W¢„ h;:+ñh²îðw…)”ãoK![郜R7a§ûqøþÔÎÕB8wrUCÊ@ ÍÔI%Ñ1HuÈQ@¶ÁKeŠ{!=ÛÝõÝÚ:j±o³õLör‘ÎÄâ’±ª“ùDuVÉFôc6ÑÃÒP)c%…-±[ìb'¹¯Žºg±œ¢+Îr ^?LUñYéÐ8Dâ[âp1³ðÂÓZÛ{ÓðÄn+ÛÆ=“ŒâNÇ,ÂÔØû`Ru&B~A^6ñ2è=ù1‡Ô…WÉ€âüÇ(qŒNµòya uÙXïÒòÕ¯ÒMÞ)9H€sn€Ô½gâdf3Ë(oŽ³ë6‡KÖíGMÑŸš×ݘɎ“v;L Ø¥O ¶:WF8?ANj“ãyÑB¬v¹’Æ ©9!ÔnsߣXÅqPŒPˆÉ{*ñùûÛj'ÿûM–ŽZÎR}­‚ÚȆ¥Î)HkìF:ú²§2û\jÌdYÁ°(ÿCR}mÑ%¿²÷â’¯á3¶¶Ý.‚œÏBŸžÀJTË€ ;QGÜ8…z 9|þC<ˆ°L?ЄVêÞ5:©=ãdðžP¬†6Úf´;F^eBŒÂ4à*TÎ9Š±eZ˜¤°" ãQŠÁ×>%#oU ì«#æLÑÕµy?y¨”Ñ[ò’u¹'N*+üOFµé&éžk¦€6ýµÇªÕx”€…ª)Z¼úèänDEŠùѺ‚…Üçbkìh¦v£2T«qµá¨ç†cg¿Ò:tp£hN1„Þúù«衈Éxè‚\‹-ÅïcÒ2ë ¢Âù!Rmí2£Ïvznu,µ6ç îëO4,Iä=—®Õ<[ÍW>]ÙE‹5F¿ ¸íHp­¿DLÛ΀\ Áç›å’§Â‰Jc® ¤IŠ¹U§]©¦TZ8É1kñ;k2{¡†§rTøùž\EºlèX+/*««#°~,}ûŒà‘äškšW9*Fœ`ûN1!]»ï?ɉD«æ” È/Ö‡øTGÑÒǽ i!Áþ€ô¦Äj…œ 5"VFU…Xþb-jΘ)^îLÖ‰ëüuïVR8ͺ‘ÎÔ4!ÁÔZ è ê+KÁ¥ý®"eV›ÊšÃB˜íWiÙÔä¤æRªk 5ò‚ÅÒ6ì«®ú: ´‹þZr\Ö -È1$í7ŸàÙ4XHÝQx9;h«<ç|­ó°ÔþqGZ[zÒÙ(b.gU-Ë[©ºÆ:ÝÀ5j¶dTWl¬´vb«F²6§G€z™Ç©‡ØGk!%«2К‹þaáë‚Ú<˜Î\ 0§éœˆ1&ß³ø,Ÿ3Æ™sâ•×ﶘ‚m'åTŽâ=uÜX/ Nw`ˆæ4–¾*˜=/çrìy1˜µ_œWysS°³mèhüG‹w—eÇ¿4F½ ƒ}=vÉÞos´Y˜m곕3GüE¡)e¾|å´zÞ%xÊR5œÍ-¥çùÔ•°—ƒqt’Âñ*r&XêÔÏö]w^k«½ÿ{ õ¨®”Wk_k¨~ùGÓ¾‡™>z‡¿=zË<1¼øÑlÔèa““ÂÝÇôIŒ }W¡¾*½kòê©Ä.„Ç×Ã¥:TëVñ°NùQ®·µo²r&Ždý˜$Hµ±*•ÃtEüôV•ÆûhÍÉ’ö¤EÁßäDTƒå’×ÔÔ¥äxY:òÚ—ïÖB¹äkÏ;ëßÎCA««k(“¸¹KÂï.:øÑGÑ—šjéäÏôô´±js@e>­½²—µ/À™¨Ž½šö½ …÷¼•h‚-ëèmʃ=|4n¹Ê«spʾ¥CòW3¯¨‡y8lÔ±ãE†¢ö`¤T’˜†Ú‹‚LQUi®Q‹¹šÛuU{5ÖIJjÃÖÁ'´ú¨¨Væ>=jÐ{ù³úø¯Ç÷ëËŽ—µåô„‚ªžûüÐÖ˜2Î ¼’_wÎ Övèà«rSt܇Äë<ã¹:I:Èbšæ8*1…"Å­æ÷ µÔXlxÇ8ÉhÖQó b« ÐrQÉ•±!Š¢¸~¨9LÇ¥äX¹ ñ,Óªrè‡@§>t²Ûúk:\Ô餖y2£ÁL£Œ&³]eÞjÉw{˜ð&M§ÊH$+hc;IÚ˜¸ÃaÆ1¿*,ÛÏ!zÕ\©Ü':yåÀ{ZöÏ©W¾ãMl¿ÌîwðìéËÃ%Íc }[çš%‘F‚7‡wÖ`ý›húñöåÑ´]4Ýõ ’%´¯÷GÔw ¦cöùEz›Û_ùcÜèH ´Þ® 0([ÔBÚ,ÝÎy­ðòžòx¤€mC,nxÐ]xª5SÁ{ÐR*\$³€”:lî¤+†jLªv¼Æ"WÑ(/U˜GG8Cp­+Ž¤pнí·A¨¤œT0s¦k£i¹ÈŠªñd[>`LÎ÷Z‹uv6áx¬,ïË É"nÊ#ȳǿÆpÛ?5>y ®w˜JL®·^öÚó¡{™@Ѫ—Ï¡-Ïåò£ƒ2½³dÜÙÔ¶ÛYLéчÂs«u^S±8ÿßÜÞ°Ç}Ò±mtlÖ§’û»f~qóñ=ýù¦ÜÈtúõ ƒ:)ø¯›9½Â/h<£ñÂxˆíSúm=~ËW¿éŠºt(9`§§7øË¡ŽÐÁÂ4ŽLíÂmnïÒH4CÉÆ¡’~£›D§2ÑéÓ›O3ÝÊnù×—øÊã«m¿îÔÿÚ9Þ.ÿ¢ì¼Á„Ø|‘L_ˈ!ϯ…&-R?*ÞQ1HË/,B»Sífؘfo¹OX>:Þѱ1Ÿ=x¹Z—¯=® KµkÒºhëÕ ÄÃý0L•2Wþªq¼z¨£§<>$€;ì¯I0í•7“Û~ýb¾ËÖƒ´EÚJ†! DتàõyrL¤¢*¥<ÓÒ‚‡éÌá‘­}•bsÓ³ò"HBÊv<z“áÈÐ?#H"È`–6Þ/Ð){\FÿÛt'™Pr ºmn'xG¸ñPSù.ƒ;ð$#D¼2îñ^\_Hmaž>°²—Gsº4ÂÓ zc²…üJVŸî¼de؃ì¡$éõuYvEê‡.­“¹L%u/14pmgiÁôKgJJÔšYÌNþû> stream xœå\Is·Nrä%§äü*§y‰8ƾĥƒ÷8%Ù±õr’|%Zb,R²(Çq~}º ±Ì{ó(R®”Ë¥òÄÚË×_7 ý°a#ß0üoúÿ“‹“÷¾¶›gW'lóüyvòà 6Óÿž\l>ÜA'ø‘óÑk-6»ïNâh¾±bcµ½Ùì.Nb{ÊGg•qƒJŸßìþ>#Ìâx6zg¤âq+FYî7©M:9Šrâ¶|”Z{7ü çåœy1|°e#óÒKLJ@«×ÃZ-W°òð öÎh5|½=Z ZyÞä¸=…U¥ÞÆ]ºÞ!•ö£rÅ~îáÌ )‡/É.¾,v°ânËÝh-lc©3™ïAúÌ‚Ë{:•ÎâfN¥ýf÷öxã8Þàywš¹áq>æ%6s«PhO³LH׸C ­ø{éÅh•îoŨ¬a~xö¤¤–tüü³nx 0øâÜw¶§JÚQk3œÓö78³ l¢h¿Âv?2c‡WaråmZ’Ã>®pB1>}¦Ë¾Ý¢­”¾ÜÉì„)Ø­.$ó„ Jº™#¯OèQ>ÐQ9¦õðo°$0@k<Î;IÂÚˆbÒ©YjPñ)Z(ü¾’ íò–“š©ê?¢Ek®áØ èìɪÅÓ¡]I¡FëÀ¼ƒ í9§·’Jœ(Øì´G «šik ª…ÎA|?Agç XËðœ(÷ fg˜tY”bV•Q¦»xU.Ýš±ÕóìPi9<÷étðSnG©˜(Î/üðÝVÀdJ ø úr–ü6+ˆÚœX9¢‰wD­1åÐQN…ஶC@tÝI¯šÉá"tðž[AO6ØXÏ þ 4Oèi—2HpöÆI‰\Ûb¶s*4âÑ—q6øºKƸOè Œê:`2<½†Ós*ž|æ鉞ÅQ6¹w1gú ~55GM‚žäfwïd÷ç‡Ãç(k% þ$öãÃW•‹ñÃ11| `E~_£S~S£ld”¼@Ôɼ˜(ŽzN•t‰õè@”Y.+£Ê+›˜õ2éôÈKO.ú3îÚ…iì š- ht/M)ñŒ¸©Alà´« íKûùoîr†EÅ.*× º(ŠqžŠÕ‹ŠE/ñ®Þ,»àE˜ZFÊ„ÀJ䌃{ð#c†jðm]"Ÿ``*Vw–' :ͧ‰¹NÁŽÑõWT‚Z„ˆÝ§¼Ó€ ?o.Án†fÁ ‘%^Gl2ŸêyÞR„Í ¦€šÒ»(­Ž¶Å ›z!ŽËt+ÊÌH xdÞ 0Ùî)¢´ Eå;\Äãt]3–Æ~C<—Àr1nšP‹ö¾Š½™y˜°gûKA÷(« ÎÓÀ¯\Doj/Å^bìPŠN6=*NƒâœÛsZÔ‡øFî ù‹èhà0óìj=AÌg¸F”žÏøaaì¥;†Ùä"ŠD†-%eب(lfÞ'Ç}:pž)ÑŠv|wŒ¥ÎwSçáO \ *–÷X…D¡ùÞ§6Èr,è ·Éã6a·at 9ž@˜ëL&t=-Æ4y–ÔERnŒè"ìœÓü¾“=ñÁïÈÑ?ÍNJPá5ªr%€ž%g¤ì(ãM‹M¤‹Ø^²§Ô»DcôRÇ`\ãƃp‰¹É_Ï;¸6ÅàÞR †”˜L„ rô‚0!y°Ü£í G t­ˆG…°ÐÜzÈZæGBn„$0W1›Q/e(Öç)óA¹¿mâµMbÐdô$­mùiÞ“CÂÎ-d_! ü –åãy<úဎv‡0pˆïè严žnÊþœ…³ZÐ35Æ™Z³‰H÷µ„E°®càÑJÊwS!×BÞZ†)’Üõÿ+ ¨šªºÑ’žÑ•©YfŽÒC~aühgÿC(žÖt#g£!°z7œ òHÙÃlŽ$‡°ß„g`»º7µÏ[¬TÃûÛÝ¿š•uˆ{¢ZÙXf¬|DˆL+Ë=+³j¾2Hy,žäÎfg¥OXx„{ët¡æÖEzaeÈ»h“WNÔ/V¥˜”Y]ùSL'³3á°;ëÉDž â>/zŠÓ*°RžÕj=¿ÁŠëJ~TEùM2äšß@Ž#dà7y̲4ÑÚ‡eÔ ¥áD”RÞ‰‰—Sr»„(1ÖÓÄp9Z V“8@DŠŽu …¤o0»2h(i/º'Ä«ã*4݉üÂG¯„‘Q“Ì]MWéz!A›"K!¦”¹):5Ì•ÃÌuÕ£Mqô(öºÛzœBƺ¶¤¤G4·ày=â³pPë(¨W/Us´¿Š8*#\×I52¢œwõ[Ã&J]Ö @Þ•^þ éWÏÔt°ÔßC/Î “3ó/jÀ"=ð…ëÉeaçž±è{±s`‘®ƒ¥â¦ëx(L%ãZ5?ž¢}Ñ5Èt\LŠ=ïàH'r%r:ÅàyµK|؇9Zýê^\t‰/—îÄ6R [ró~•¯ç—’+¼S_é—°ü~y]gTèþ²Â2yÆzªhò¤‰=—µ²pÙ—Q‰H ŠKŠâÎ1LOLpŒN‚—TÓ]’”™%OÜ}§Ê˜›+$ÉÃEv}…&3â¥âRŽšmôF® ¢Üd‘ñš/\žjÚHtuv1®ªó¸aÛͺèÁÞ™y Ö‰H®ÒO•×– $VÈJ®òz‹,C˜Þ*Uf‘ÖL®„ˆ+ËDÜxÖ’îyØ\£jŒø&E®êQÛŠu'‰o8&glJ\¡¦^ոിt¯ÔÚléK·áK[wê¢m‰(C€Y)â@ŠXŠïéZ-ø2|1؆¡{vArs9“fá–j1ÿ!sLÍV¥§³§Z^3äEBˆ8ð},é1ã— A €&ÆáƒW7] Fžë¯päŸÂªŽfçdµ—A'ÍjW’¸Ø3’¸p"°1aüBº2g™î$Þÿͯ¼„eª8X¥óX›µEšÃ9ñØN•¯yÊ1Õf2è†Ù­[ºwû¾SYœ·Ôy…uîåño âa—ÙúT6í“ÖTkêäJ‚ R_Ε…q'W2ÝŽ!W2@§\ ªûÒM§4©gܲÿ*ªzëãÝÈÍEn̆åÞdÔÄ·‹g9 ñ¨s'¥ÖfÜñbw!Ó­*‰}×(›ÃÙ&‘èwdIî¸n§öž.¡î¨0¦•±¶¥é¤ªZ§ë˜J|(cRÐN<^﫯…· ´‰Ó¤.[8rGg#iÞ¾°TTéÒ%šNÏ;ÂáÊôsh¢5ç¸U¸Aöjã¤|ô#9¤óŽÍ#¹úiT?™“oS¼¼ö‹88êRq±3„dñÏÉKŸ!\ß»¶2)Š(~*|$7§F&ôÛá(å%’âçQ6l$¸²S*¼¦•á)þ8.y@íX”Ì_/3$þ6¯‰ÏS‡ËimbqÀ¢áŒ%2:ÃÙ(Þ¤ ºSå*ÅÕŒ ]:—RÛ2;/ê4á½8k_ÖÅèÓ¿¸ÃŽ·ç‡ AõŠ¨eÔ/Ï¥Îå‹ßP—R ù±øËToCìÞó -¾-ÈO³$^ˆµ—ÎÕS:ºÍ„æ ²ÞKBÇA&_DaòP˜±¾K?J~¡”ëŠÀºGqs—î­Ì¶pÌŠ®[|¨”™zSø.§5Õ%°U¶7© ׺ŠÞ#iÜx/ÎޔѼ{_¼Rª²Ä"盳D\eî]Œk‹J8EšaéuÄ[+YñJðçŒwW1膘Њ1 ŸŸ¢hZ®ú!˜ãRSßjª]ÖËnæÑ€¼È;l >2sà~‚‹zÉTà¤óç‹âP,kº°ˆ­gñ“G ™[ŸæÖ³f²ªïãÜúhHͽ+QgŠëÊßbÊÈ4H¬wLY¹}´Ý;µ ÷¼šhCoj®£Üòm«æ ËÙ…`¶¶‚!’Ë‚©û5Á„“hqÊû¹=Œü4v%ί›™…¦Sãenœd…ß² ¬ƒ‹TDïFíå"·þص¢ónßÆ^J©ì¥ÂÅ¢&1â¥`’÷oõK+P£7ú¹cc˜;\¹—0go/©>RY$8|pébÌ1†y‘? „¾­z†Ù˜MénÔjž<îÚÇ·][êøï?ïñÿŠŠ_ ‚…Öæ¸÷]HmAªó.ä€a´h÷”^g­ÞÓ²%¹P‹1Á’ä¼.¹Þ¯µzYéÆÿ’5÷~—x™R ÓG‰:½W7†Ï¿¤ßÿ¥…3¡—™ÕA¸¶TÀ»dKÑT(cѯ„;ÍÂȯ¥QMäÖ©‘Átù—âEìÅÈô+¢H­ítØÒ1ørë oOï•$hÏËk[ ð nòã¿šáçA>ä™—(ÑSÄ¿H±\ÊZ}¼_!;jL™¥T´zpÈ”?¾WzxkT雽3ß=úìö>¾=Ê2ÁCô*P÷ãy\O>Ÿ§ßŸ5¦²8è<ýþIn$]÷0ª„xÍäþõUm&7A¨¬7þB•ûצu$ªÙÍ •Çc•÷¯G¢J«ÝòS~¯uÐî½5oz¸š6­4ˆ#XS`2%-ÙoÀ”ÄZšBÅ‘4 ãY‡&­4‰{oM“æ¾¥ ‚uð:ó:'úÌè~³ef´=®GŒ–Ó±ŠM=ßžÉ5vv=´œÁÝ( j Ð1`Õ'@­, ºœGÏÁŒXæòç«üù2›Ø늕G2©_ír_B >É­ý¾äÖ»ÞU„FÄû«¨’†<"¥ÌâÛI "ÌÌ¢¾„¨åöŸîº­ÿ³+ØÏ»}k6—T„×­~,DSÿN!>ù|4æ¶%DZ?èÊâîÜHß»ûYÎônieebŽiËEõJZøWÕð_Ra@{WæD ç‹n8"ù ·>XkdoGŽ}—¿L¯…ÏŸìN¾‚ÿþž±endstream endobj 155 0 obj 4111 endobj 159 0 obj <> stream xœÅ[I·F’Û\rJÎIo½6÷%7;‘—@^bqÈi¤x4ckäEùõùŠd7‹ÝìžgelCÔb³Éb±–ï+ò}½ƒÜ úSþ}üâä­OýîâæDìÞÃß‹“¯Odê°+ÿ<~±{ç ð_©©„ß==C N™‡rÆ˸›Ú¼Úyë‡èvg/Nþ¹—§9o\اôÒ^ë¸7M³µzÿÙ©D4ÑFµHo£ Ní?@³7F[¿ÿèô¤Äã{h•VˆèÿuöWÈvX«H¼¼8¹“: ºæ+‚Pqÿ1›Ž?B]TpÖìÏNe¼7zµ3ïáô˜%úSèZ­ýýBx¡dY¿ÖÚA¬­Ÿu•ùA¯oÖ„5jû-,9?º…… Ñã=ºúAÈÕÎ`B„ü"=›è\WϬBïJÎýØ:a­ow5õNWSµoW=a0£n~CN#µ7¾£7ƒ!å(¡åQÊ‘ÂÊüDêù°kÕÖ{žFrl}¸iHRŠEW/¨¯ÖvT%Å l ¤ªdO\UA–m¾±¼ÒóÁÉÙÓà¥ïþy~´R‘2š Yø¢’3)[klÍî`#RQ,Ö+aîNb¿¦lç­LÙNY›ÒœÂaªôÅæËH“J¬•‚üÕiŠæÞí/¨ÑéàŠu(ǧqÌÍLŸ]OŸñǯê#ÒâØøI€?^fa ²È$aOÁd#+|÷¼~÷ª>R|3ÕÆœ©Ó½¤Gm¼2ü3ÖúˆT*⤚1·i aæÛ×f(0¢)ó|Âh¡h¯a.1J¯’åäxlÆ«Ô,ƒÍŠ}@ÌVƒ¶Ò¦8Ì'’aгuJÓÖ!“B¯ØÓÒ] ¿>ª©ñ’r5fÇRÎ+¸¨sð™Ùge`øŸô4Få&KM&Z',+ÄLx¹ƒš&ŒEá&ÀcÆžÚÂÉ›ùø$?B5lz1ÄcR¨å&›öÛÇq<ë¶î’ÎÉ×ÞÀÆç²ü©BÈ’²m2ü@#€“‘w$;øõ ›Ìð Þ!ŒfÌ '[LÏ"yŸÂ6½Ó°ç×PW œÚ®ŽÛ™À|¶U Ûî%u´•-b4oÀhŠàbÃ8˜³xJ»\F¶@l™É'¯'Û¹ž¤ùªJƒ8"ú´b¯ëÓ%fD´uÙ\±-ª§~x†dê_Ù÷ªÒ]ÐC0aa±ˆ~ƒ*g›´ªýóq¿Í”Â:ÛŽö’ ¿qÕK {ÕùU™Ù[> ¹aã*¬Ë§dì £_ò.É~ Ð@MÚY¡ÕhÎ@çÏ–*z“MÏÁôn ¶Q”Ø”EÖèuY–÷ù#èÜ™ ”G®©¨ÉZÏåH8v‰c™Å>;ÑøëÊ­–Q%›ý E—s!Òã$¥ÁšŸâ²»äEØb•‚¾Ë°¥V(Z7˜´™WãbÄv.A¦g{:Ô"Û_MÀo'1¸®npkìâÏ-êœâÄ9-I VË6»÷"ZâaS´ º¸ Trlªµ74`HÉõ3ÖÜᤙ}ŸÀ«#ø²ÆεFŒHtœAØ1¸>¡÷q /O#ž2 UdCN!’¯óV¹ÓYnO¬ªBW†²køBxÓ`´Ô¸šÇAÐç–Ùc°ºÁçy(eiÁ0¢úöuÞ åþŠ"«–"4:e¹i8—ƒ¹Ì Eô=u½å*v¢WÇ>Hôˆ9tªL‹ÿáuìw»a¢˜’¬e:Oá5ÏRŠ ó D„¢ R_…îm%[ d+ëúé¹%˜-Q–Hñ?Q¶À Œ!p ¢­ñ ÅÒBe:D;.0kÔ¦Ì&h€š£a›×—¶_ZB÷U´Æù—åOêÝó:ö¬ `¸íÝ-î'¡h†µ¢»1íI ¤³ò¢pé«3•|>½MvZ9P)@!r…rA[?ò¥°Ü„ûɺ›ŽïÉù´ØÜd†Ë;uög÷dËg"5,‘îT:½ùIÅFØƤG›ìRÄ‹Zø™ìióÂÿ[õ8ÚFôÇæEu%ˆš„2æ¡íDH5Ö¥å,&PÉÊ,Ép•Æcßì3‘Š,‹«‚]3_9èd‡Œ]WY¹*3¿Ö`5Õ´Øwõ¾ËK# ¾©¥t¡¡QÅn[àMÊ¿¥À+sz…LäC«õ4¶yœªõ*A˜ÿ±#½/ºGW›« C_F&j¨eé…å2æ”ËKøŒ9hSüá)²ª^—£7µ^Jnpð—nR²|m¥\ ØòÑl—«X²¦¤•òß]« vp¦=Vআ°SíïxîWëKÚæoì>w:;X€Ëõ À«&ôÀÓÖúäÑG& ›//¶t*§Ù–%‘ E§¨c¢SéÕ­tŠ“ûz‹Š-•G©¾}ssl,PvNJîzDOTî¶{§ÑSF'îd’ûlRDƒ@» =wÉU­Ö³CÅëÉܯ«°ë ¯zïëG‹SÂô8LïŸmú§‹¡Õ‡¸+w‹•¯JåÙ9^Kª‰ƒÐ³3²íÌêÔ,³V+”²9hXÂ@+Yæº)¦ø¥ÐR€t-Ñ3èëÂZ¦»}oê4ý „.•#gh|ÙÊxkº©i¥O|V=÷jÖ×®ù%ªôuüðÈìÚ’Cd‡?CÕI1ÐXŸVÊÞ&ó´Ù+øtÂdºê§U‡Q%(^ö…×,“i®}¬”¢™sàƒùÇ­ËP×CË ¬F ‹.‚ß7•‘$¯‘•ú»b€SJI;öÚk­?C^uö8ƒINóæyõ^>p£ºÒVB¢=ð?YìXÏnP,°b'»±[.Ë‹Fíšî)…Ûï£êÂ…ç¶U§l­ñ®¼ËÂY ‡ß ™æÞ:•Ë‚L÷Qæüó<»‡ñ¾ÅëMî"Û&wö@ªˆÍO1wßéïe?¬3Ûø¿1ØbÂ=« ô£M±n6ãí²±õûÚz‹Ù´‡[+‡Æ#Ó’a^¢Ló«¿;¹­âÃX×¼$jerØþµc~²2ÞNδÜÌìú?w–ŽÆ06SF)²ãc†¦»qe^¬”Ñ/È™”Hv!ý¢Nç=¢Ÿ²Y‘î%y3‚ Ĩ†[©¡·¿Jb÷h§t³¢ó&,šÙâdï5- ¨JÏnÀ2œÕÊm罦ßaÔ¬3’ÒÈ~ß(,Óð,uõ'ìLã&ëÙ“‰w˜ð»øø²z1»íxQ[Ù½ÐGµõÅx©Óò»žÏ›³k–ÔÚ¿-úïEßÙ…TƵ.ºÕÇ Å:äÕ7hê÷½|dzàòº-»+KË8o–‘.ÈF»ÿÝâ³™V¯këâêéF_&ÃMme‡’Ïjk•Vÿìäoøó?uñ›qendstream endobj 160 0 obj 3821 endobj 164 0 obj <> stream xœíZ[o\·~ׯX$@±kxirxèCÒºu‹¸i“ 4éƒ#É’Ër$¹uþ}gHžÃ!ÏZ®" Ã0=‡—™á|ß Éýi#…ÚHúSþ=½>yòß\ÜÈÍñïÅÉO'*uØ”N¯7_°þW)­…ÍáåI­66ÞzÝæp}òÝv{%‚7.lÝÜüçáÏe<ÒÓx)bpÚ¨¬Š3^ÅÍ,ÓA h'þÝN mm Ûg4¯R2Âö‹2ꨃÚþ;x Ên(õÊàÊÛ§Ô‚³fûÍnÖ ƒRU•»=®ª-DŸµ ##„FŸ¯h@ëí×L‹¯Òâ€+v*ïQµÎl¾oçfVÉ×i¯uÀY7{íDÜÎP—S4 ¸Ð‹ÜT&l_U)6­Œ"hàÒûÚ÷ªJ_¤¤ˆòB‰:|urxôÝöMrû¾‰îi}#‚´ÛGµÃc”*”Úí—U(ë¨ï·U¬ªXö!àÒß/f+«™hpÌÖgX6©>`Ø÷»Þw¤š|÷ñv^¥ïŽm˜ŽaZô|¸5gÍåè2jˆ=K´ý…F(¥¬ßÞ¤H5ÚjÒM P>Ƥœ–g “8X¶—ÔV; döAÞ½­‰$¤ã=îò|^…íKB¹Cðµoé»,õŠæ•Áù(“CµD4‚£Àņ‰>â@„¥Ú¡Ê@:ø0þ\S&âÞ‘ÄVI?†Hn©øˆÛl”3† f߯IQ-¥Š&·!e·åuvu iÇ&N« 'Çùä¸ËÓ¸¤.Ê͈UÀ¡’]ÚâÏÅe fêÌÕKÔkµ5ž¹âž|ï„ö–)̵\7”¶Õhß… í$¦‰igœë,Íñ‡ñòÃŽè=1lÞ.ïÝö¢ríUë]tÍâ¼½Úé"kˆfðý|IRtgtG4,º÷à ¡lÆ+yµD¯G[aR ÿ§(`(–„H‰ "‰øm‚Ñ7C¢œšçJÑæìUÔêÐÊKøEåaBð®ÃšÂ\Hè?¾… æ÷´®oÚ §ù¢¸f»<š¡¢,Ì®H]r„)‹!Ä€pN"VÁüwá¯<ÆçÑŒro*ÑßTé›'¯÷e“ÝÕ¦¨}/‚Í£éD½EµeòÅHl=GþÇí·^q@ö‘c? R«e@ØçɃ÷¬|·v;#ÿ„ÉcÝ^:U^KeÉÑ%;"B^Wáim¾š¿¿­Â³Yx> Ç™’òuqª’hñUÜf/YÙîVEs1\#mœe`ƒ1"Ç@ˆÈ«vÎh#y+æ—l§‹&éÛ*=##Ï'ì´ƒl¾ƒ(¬QÆ-l¨˜TAM>*~ÄìÖÐÏÔ³¥Ýþ¡¦‚6^‰ä¤mi«ˆÁÆ.2!Piñ€ôΠÕXÒPÜì¦Q¶‹¶Í4€Z€Ñ¥.îÀÛ×X·ÊD6F#9 sòÙH:S°(«geb°:•[äKç:wÏr3N«ÚÌ;Œ¯+5Ðn!EŒÿ%ÙXòÆ–˜q<ìÇ\±O:ÍuŒ¹ìΧ¤Ž¶g‡s)EˆœP†b…%‹5fˆ :.]²«‚vmAZ λì M;sEDq–+Δ&p}ëLSÁf˜Vµ jH˜¿†_dòSyÿŠjÿFóCÀCÑÌtdRkkÝåËRòDza¡Ùà/¹½«š*þh]Ñ¡•­×•]8-*eêÉ6ÄÔ®7ªsYˆüX¹kŠ3;ð…C´òé‰*</ç2Rë¹æMT‘ÆaÚ–Züa¡%ŒëJÚBþ>@qZW,.êItZ³7 †~Þ)Lº”›ñøƒÕ«[‡SšÄ#,.@œOÞ’y¥„–ÂßóÜt“§‹Ž( qº|Dù–.¡`5ý.˜ÓàRõÑÒ¸w£$[)y qëÐAŠu¾‡ì@…”!3z ŠY‰%þj=Î/‚ö•;LÏ(©É¤ì–ÆÎe\¬B]›0ÃïçïP…búþ"Š+ˆßU/,óã-*¤ö}º9;bDe($&Çt·—{c0ããIѧÝT„v7Èå+“Öa 3BCS¤v%UŠœ„F0Ïkͱ9òlUFnWÖîg–4¹¨Ž¯x*O­ÆÙ#›ü]v‡ÄY˜r¢`ð×\¤\\cy2*d '¼‰‹³u»z(k¾Zº&“Gí±†¯•Ë´F+Ó™½twk‘©’jÞ\~áLó•ÐŠú Ïl®Å!y<‰4õæiqX°|{U–©§ÝQ†ªûcWBIeàÏ G3âeÍÙ’„¯â’6­Õ²Ö•ÍíM­Ís’ÄȺò ØEYÇJ§‡Œa`QÞ½/1TV¸¬Ô£ãƒW‰{V#ìY3«Þ(`½Zå7 $7Nóõ€Ÿ*º’ŠƒË’8øtóRÖ~NÞÇ´Ü$Ñæf¨èÕ ¦'Åí(ýÌ·Þ0³èø¹ƒ•ºUz;¼Þ¿®/ Ïj‡«Úáb8«›¿­Í§MÝ\®é›°ü|±;áSsy§æÛºr} ø11 ÇÏφÌ7Uº<*¬÷]HÊûe•~ÖX?0þl¸»½øa¸ðù´Ene¿Ïîë½î†Ò›fÒ3”ã;KVÐÍÇ«}:œázqz[Î0Iß•­Fl±x»ª S6ï‹Ú|6÷ì¿VÝ׿m|5IÙô¯j,.ìqt=œ¡UPá>éÛÜSùƒ`»ñåUô®´°ºÿmmª¾¾íEWý–}×›ì¡sø>š´ÆÌÐ!탟I³Ð?“T5\W‡ìJ‚ÃʇsÏô§ýè0mL‡îw_ÍŸoxß÷¨Ê¯Ioú௳ÿ›'ᇾw˜ø…ñÒË>]¥M§6F2,8zB&:1Ÿ8~¬MXÄÔŒ¨öG¿Š¼µ0l2æÿeȯ± y>Œd²sBQ¼ï?> ïß×ûæŒóE¿›©/Ãù‹á0æØ9u4óP‡‰ß,V:ZÇèiµ˜¡€E*m¨áyíÁŽP ›óý ‡?ìçNjßGÍÌÌ {> stream xœÍ[Y·ò¸/ù ó½ÒÅû0’>ä#XÇŽ5ÅyV'´‡¬]ÙÒ¿OÉnÙìžYG0 Á6UãXçWÅöOÎĆãŸüß³‹£{?¸Í‹ë#¾ù þyqôÓ‘ˆ6ù?g›Ïv0 þ*$’»ÍîùgÁ[¥EÚÊj'Âf¢9¹qƱ`7»‹£ÿ âx+˜wÚúoa–rJ…ÁTdcÔð¯cÎxÐÁ9<À_ƒõVßÙi­Œþq¼„€áW@†óàþ»û;ðç7#‘½t9±Ê3U1sŠûrÏe¾#ÇÑñ÷8Ezkô°;ž9§Õâd²ßƒi˜8º…Ä$LôµÔŽK‘ﯔ²À õð5ˆÂHÆú9LUÆ?Ü‹¬[+$!Þ-Ä<ôÂçR3"0n+ndQ–›†i-é[óv³U–…Íî)¬}€J Šk;¼JC¡ýð¢P/ õq¡Â ×Ìs;ü†† ‡OË„ó²ìy¡>.Ô{…úãÇÒk9¨B–ex§ ß”¹¯ºÈ–¹ý;Ý7÷ÇãÞ:”íŒO‹6[á˜Ò\&yþ&qc˜ ñZ£dÔl”Á·•@GêœU¤ÙòBÍ¢k/óuWŠxísV¡±%ÞäÚó¢öîFæÞY™‡Ÿ•¹|¦÷8~Ýn'ŸÃjÎO«ª4ÉÀ¼ûçµ¢.AƒÒs±ÙíîT:¼[TØWKGHž‹ ©wº[À€q.†mÑŠÞ§•‡û´²,^4§ÇÍ ô°ã² Óy]_ɺ'†»‡9¢OíOåö»éL÷qBfYjR„ã¬zÈwþÿU½í*™ÄÃF`ÔÁP/¼ÍÒ3>ÝëZ¹ s“ 3t××׬£Û ¨€e©×JiÊ”‹)êZ_t¥×¿ã£}ÙdnÓãä$Ý[ùۣ߇¿õ/Ý÷·GøÛaêÞëNµtF(BvûMÜ©/œwû\dMùëî4Æó6­Q„ƒ"”geéeèÓj彤Þ`VFGਓüwÀ ã>0¬L`,œ±p൉ƒ Ü ?\#ÞuÀ b6ÁŒG¼|yŒˆ\:‹pöRÞærAZz8ˆÒcvæéÜÓiÙÕ´Œß”!T€Ý-xþ=(O‡ç‰Í]á°w}p káe~yUÖÝ”áK!HȃYW7Fë`çr&µQšRï"Uƒ«(3Ž¡rr=àÚÓ øØ*ÍäÚcý%Dº ׊KDêpRÂɨd ÕÈþ&’…7ÜYâÐùá FÊ#‘m¨y d€-.ÓØX©PSPIA…y:×!üXl Æ7pºÔh>cYVΠ'“eycì;Ü£œr Kµ4\ Ÿ”Z4ÉD™ªr ù™€Ö&‹ücSü4ü†S'3š8®z]jF¢QE=ÝÆX ”ÞÊ‘¬ü²ì7ê ªé·8Ôk弇ÓÞQ2Øe’3Ør_IlhæIöPVB€–~¡fý&³nYE¶úÃL´¡ìu.cdœ)¡ðôZŠKÛæ› àk<Á JÅЀýrWÉìCŽT*¹­ÔPÏÏ„=™$–¥XV7V}•Ž Š"ï¹I‘^uÄsð}gáNPj°? kÍ¢=A˜„:o4¢á, B³ã h0צÎûZmíÈDµ…5Ú—¬%ˆLr%;ë ®4¦¤z5ñGà³d7 ! e»ÏÇ.šÓÆ;ÕPÊÃ_šB˜û%ñŒwHˆš{W²öÆ´e<(`èÆÙr½uäz‹]"Ž[â(‡Mp:Q,…ZÝMfÈXê„·ìµiê›)OŽ§ÖZå8ÓCwŒCÖú’ªoÒÿ[„=¸Ò´è}Š’BB("‡Ñ7è|’n癫! <ô¢\LÜèº×k’~Ê—7qœ4s]¨/ðQ›—„ì;nu’¸òZ ï^€%¯·Ð9ÛmIï!0AÖˆwÏYƒðñ¬à¡›.õ²P.°ó´Pwï™áO-|×…{÷Ëð^Ùöª;$­°Ý¾¹ç]Á“&ÜŒß8—ðûD ÖoGï DÄðïBû~¤Ý_Uki ¡:bûÕ‘º¨ÊA¶©3*qúy6ÌŽ?T0ˆXÿ2êXÀJm>ÏSÈ–9´¨*x¿(ÞKâBëŠstT…†Ôºèby´š†¡Ó¾×qŠY¿?=DQvÒƒ$?—QLŽ[›Óƒ•^ômÙ0ÿ 0ï½WÒ× °AÒqbåà“Ubrj”µÎ;úžeÚÄ 0Þ$ãè$¡“,ŸÍMc䦷Î]Ón(C1®‘ã+I­$„_Ù¸qÓÓVv3—Fê“B%½ýËî\Ò¤?+Ô³\[z‰•ì8á›nÔ¨£`'ž‘výåì´&F½+ÔR™¢ÎS‹BTùuYG"Ùâm7=Ë}8ïèí_• ç³PN›*ý”•ÏiÙâ6òÉÇICyxRukçS¯Ú»ÇᛄX5dN]ga*¥zù{TX5ö¯ûÛ¡´G“àh¿¢¹½;?åVU˜g U Ã>ñªa—ÐN>aá׃%Ç©£%_²ã^"NÍ€êÊ~]÷6ýŽ…;±ô…X>S©šs˜÷Wš[Kþ=^[ø~£þ2ãµØ½šðä^lÕ³Q¥@ ÅÈ>ï!þ Z%t Šg…øž–­ÅA µÌãYèv#¬w2ž¬Èó'€Ò²³®3Z4p¬û攲ªÅ”xÙÍ*¨e I2HÁsš¯k±ÂtAžÿfk,}æ8©o õfm.Ù¬©h &Zo“:ìmå“6ËKß+_+FŠŽb#+»„aˆr°¢0Ÿ‚Ûò*;EOˆžÄÏëV*ñ¦¤Ðÿ¤;<›Ù3R/ZÚLR»¿/ÿ´†ÆOÞµÈwÙOþ¶ù1†·EïÔfRV0L^mĉ—bıàg³(RÅ,3¸lAÝŠ*` V Œ{Ú5`ÒEyR¨ug$uQu ²Ã\?óFêûU ÷‰%0¶„‹Ùñô°qPQ€Xëg}È=­ØÚ“ç @.?Ò?=ù4]Ðþ£ét ›ˆH7Btê‚&+/w:—Q„®~¶¤ÆZ%ýérœû™OŒ­ß¢ËPŽ'ÃDm€åãGÒŽY¢‚B0“4Ð#¾ÉU†I„*Ò‡µwýœF:Mvˆˆ¼ý¾`|÷¯›ç¦ê²ãÄöv±ËŽ²*ù8a'¥üRTb?½le: j¼Nr²a^Ë`Æê=àêþvß¿ã"ˆˆ·v’ŸVCûª_{kP/Í ¼oö×Ú'Æv,÷\ßLÄ_ÓÍØ _®æ €µS˜¡]ŠÝSúÑ"û:`$1zGànù©¤m¢ùY¯ XÝ;à(Imt†êx!²d%øÝùßP*C¤/€Õ·K! -XHÓsCés¨ŽÅZ³¦€yBŽYýέ“î‘ÉÒ´‰]r¸·úÎG‚Ð]U M?O_¶T,•ÆLâÞŠW‹ áYL¦û|:¹W“¢îEdSŸä†%TúìÿGœÑx—JÈó´Ì×Wáâ{\I¦½Î™æôËÃßö»8^©6¤ƒwQ·¥w)ï“~e4­<Ùó™Z/Gú½ýW>B_îâ'ôëmª¦ õëyç©}†4¡?Z¹+_è÷Š›ŽBc._}Ö3´lž½rÝ5°¡¹Ð,‘¯Û·7´t§oOÒI¿ü™+¤ý¦üP…Ì£ú/]”²¾blýy]3/± N€Aiüf‘Ô¸>»”˜C܉&Ç…×üòÆô!ëuÓE„ÛC¢$M ²&F_Ë]Õ²*?'¦Dp-¸½¿;ú'üùûJŒendstream endobj 170 0 obj 3463 endobj 174 0 obj <> stream xœíZYoE–xô¯XÁËl’ú>!ÂJ‘8ŒÏ(>‚Žñß©êî™®>ÆkF< +ʤRS]õÕÝãŸVlä+†?éïƒó½·ŸÚÕÉõ[}Nö~Úãa•þ:8_}°&ø'ç£×Z¬¶Ç{ñm¾²beµ½YmÏ÷¾ÄzÃGg•qƒ›Ø~–Þ#ÌâûlôÎHÅ£*FYîW3M:9ŠRð‡k>J­½ž \ΙÃã5™—^:>| V ®‡-P-Wpòðò g´ž®7BëQ•g%ÇõN•Zxµt=#•ö£r…>Ÿ£ 愔×D‹/ ÂáNÜ®¹­5–˜‰¼oæÇ \Öi#Ee6ÒŒ~µ=]>Eƒ•tÊh%ÂÃbvxÔ0Žúø•ö3óÛb8Z‹QpgÝp†1g¬g†Ï‘,¼ç–2_ •ƒ0&†Wƒ;Í=ä •ã Úkrå‚ ‰z´Þ(ïGëõð^#y/3õ:S_eêU¦eê~¦žgêû3íävÓÝ}Ûõf#y‰„Ë®µ/»ÖöyÏ2õ:SÇL=ÍÔ¨ŽpJ RÆ1>aÐ7Î×ÌÚLqûR¿2ùû5ÊP£ƒxý}&/ˆQ®6³/0ÁÏŠ£—R=Î^gú»×UŽæƒ[âTj¼4BßKTHå2•õç™ÌºÌ¬ë´G1†À=ƒn^#¼øøh‚Wc#*yÑ×”7úMâµID”‰t‘Eð>kÐMÞDHûî#2ûîÛäx ^Äxù£P¡î X¾tNó²{HcF­MQ¼OSQÇ– ZKè†\ºá;®‘r®²R˲[u–0‘ýœòÓîq‚º@§“¶« ² .F.²\ŒJh&«–€- Z Ÿy¡iL¥aÇzÏ_|´¥Â˜ x$o^ã![HG”Mì ÿ_@D©žMسMzø8·¼RÆÔý¨ŒDÚW ]jp(dÁX-!%|©0Âf˜žÏ…ÿN LR’¶àçëX+Åh`@ 1÷ ÆçÞÊ°µ³C¹†Žú¤“´ARRÜ(cúÆÛÔŠÃhDŒÏú&¢Ö¶8$é<ˆâXáÆf±NS…BNEËʤšâï+5jînÌ`aVO+÷ª„6áÉ„§¸’¡šõÂ4–3p3‡ÛÝ°‰˜f+a葯1J Õ¸+Äè&éÃ5˜IΨ%Qcü ­ª°E}¬/Bœ”‡ùuⶨ. Ãl•½qfqÚL(H tr§«(@8êp† _ ôV³"}ó6Ñ7vŒi!eN‹¸Œ02O—âtv¹"(‘?Ì‹DÀÛcN"´5ÞÌ"\•¦„e)Aƒ‹MÉ;{ÞäÅ+&F°­œNR˜‚ίSLå=SaÁ3P}%.„¬ßl°À“–§w¦œ¢‘{Š2 ègÊÈ}…tÐÛ‘²—„Á‚Sì.¤4":k®ÂUÎ!TAQ£$ %`k;^º²<c$ÙvÓÊf`%{Ëõ³ÉƤ’0ªÈþ9"‚þ,»Çe-ú-— «îFäM¸Oñða=A†a‰ Ê/»sÓQæMóнñ·VܾÒi$)‰Gh‡²dnd¢l<¯3*$Ž"@æ/,ª ÝýèvˆžBÄÕ*‡Á‰ì–“Û8Ñ2Á‰?çFãë„"v¼HcA³ÉSœJÆ‹¡ã‘AºŒK²‡¢Ò.ÉUš @–äÜ‹rŠºq-ªùlâü^7@¿©yÅ5ŲO„†¸•–äc|Ë£ ÂJ ¦ÉM,ž.B”/ªÛ‘g’4³TK± Ö:f0­Oí8]0áB/qþ¥ûƒþMÁawí 5Ù‘N3õýr]ýÿÒ ¾4x«¸Ú÷Žw-ñ“áÎÂ$23<É bºÐw[¬‰Gd*¿å>-Ë•ûU÷.ì5ýÛ¦û®9c—ê2Õuñ ¤ ­°üZXÓ}ból'6ÄÞþÍŠê¢Ð\œÔ!D^»o{wó”HØÏ×R A»2Sm&VóW“»(ß`ž©5ï}#ö²à 7Yz2q95T—ª»©!2ÕtyeC]FÆöP¼`¾¹Kê”ñQ4°n§«A¹œˆU¬ácSЂ儷Š‰ª¯®DšÙ~—JP8È7ÍÍh^ ý²Íõ·.ŽäûÄI¦žg*Q’t1 ôa£Zž L?6`œ‚ÁãšSFæ\ˆ'·-\´‹€1NÞWÝàzUë”'¼áÛÔ©‰J"ƒÞõÊÚŽ@}Ðuq3)ÜM„×qF„5ñÛ‰I12’Ék *ÐŒ)1dWµÅq¦ÃK°\øðE&?领ÞWâVâ‡Y7_ŸŒnu#ÒþoûA„ºŸ_t‘Çïtç¾=®Ã;}ïØÉ[píUß5wrBm-¯òĶ¨¬ÍPRÿlð-ÄÅqÆÅã<.Êm¼Þî¸f=ôQ£ÿïPŽú?Զθw;ÿ'•¡§‰FËiy©¸;¹Þìrò³ õ¸Ì=ì¶Ï~=XÀôq¶g!§nSØbmÐ6‡]Á¡ò{7U̺åÜwp"÷Zõ›R«®ÍßþC©!Ý™ZýãþõÔêeò×áÛp·píÎÔ)1™æ‹¿’:ÕwJe3;©Ãk¬oH‡Æå·æ­Bu¾‰O°Çß*G“ò›øò×<žæ÷ÚßÜIå´ã^׶O¿ðÑvïkøùÞ–$ endstream endobj 175 0 obj 2184 endobj 179 0 obj <> stream xœÕZmU·–úqÅj¥saïÁï/i©”D$PA^àVU|€–mw75QÕþöŒísÎŒí¹{Ù…/ŠbæŽÇ3ãÇÏŒ}øe%F¹éÏôÿ£³ƒÛüêøýX} ÿür ³ÂjúßÑÙê«-(Á_¥¥~µ}} Æœ6²˜rÆ˸Zd^­¼õct«íÙÁ“A®7r Þ¸0Œë hi¯u\%¶V_‹QDmTÃãôktÁ©á>ˆ½1Úúá»õ|†ß‚TZ!¢¶ýøV&X«’{%8¹’:ŒºræA²+‚Pqøž,GÇ?$œ5Ãv-Ãè½Ñ;•‰½ÇË°xt…Œ)P uÖþ±'¼PrŠ_kíÀJ›á^ZMJÕ%ñ+Gá*»Á„ñ6H?|¹¶f4¢ÛbÈ÷rp:ê ‡»(n§YávÜõN_§=6QI~™Æ^c%æÝ„@ÀÍíKpK!â2,sŒ¢s6FXiµÑnŒeîiBEÔ¸á‡'8Pütò?/â´¾ô£6–~p°½ùdxz?ãð]mÕŠ8­†÷0”f á;8”¨,ÐQ9ÀXø *Ü™dè©`5ÖÚc¢]5ܪífilea–¦4Íóþ³hä4)8hH– B–mùºKUŠó ¥oQJ¶ðJ]oLŒ£>9ÜllR8žÜ±Ž&øñ.ÝYJ|xŽÃ{˜¿ILVîQ’´Sø o;<4€#0$8}MPH–½â?¡ô˜(?í`¿[™Ho±)¡çâiçrqH%bq8„mqqr¦É9D˜çléà¦j«]7ÀºéØO\þ`™öó2ßâ ,D逑¦ß¡îÐáiqÆr‘3ºùäÁ¿OpÞßdÇ´Á–äN 1†‡)cV(¡,pÄœ›É–r6Ûr"æ݆ŸW ù 1ŠØÏIëŸ$£AF‡£\½ Q¢.W#7àà¨Ô;3ªÙ7µ/™F 5¼,µØC*ó2"x-¤zI…YC.ìX8Ã2ç®e6ýׇä>Tˆ`2?áÊnA#áSPK‘¾Hk(¬ Pv‰*q"} @#1{$ôçé/¬€×GŠ¶Òª´Ó¨R<öÎÎq¥ã(+Ù¶@Z=Ê0ïÞÿðLÝÆ“ÿ€­Ýdøu·ûtOQ÷}»Zþ‘­,ߣ””©m;̺?¡ôÞ¥«©”2ؤ”õ’`uÞpE«”°`æ„–-LÕsÎrÕ¬#`Ʋ­Á/@³ÞE7o«…&Û 8_>ÑØ´à†yTüTvJd¾©Êkß8Žn¶D°ò> •Ø¤á½c[Hm!TáLA€væV²„Á/¦^ Ü#þ9[Êß ôÏö¤ûy^-7KÁšf…ËOÀ«Pà¹Y'ëùiç(™‡†ÈhTäâvBš\ÚÙKôÀHˆ—\„Sn-i…œׯ ÓkOµÆrÞ%í…ºó.ÁD9ÚPÝÏRþÀ›§d9H´¸UÞQä÷NéñZ_l1-ÓN&¸¤®‚¥/ðì°% —Z¨5ßI »r7Ë'8$ÏÏpøEUWç'ÞXR 'ŒÔRRaOQzÚù¤7Pú¥})LRÒ|dÙ$—ÔÌ7¸ˆSJ¡ßÏ’é2Gªç‡.ĽYlRGÚòBB¶ä_l›ñ¥ÿ욥$=b“ÿä#Jº¢} ͩ뺼ä׉êqŒ¼NtÙ¡8{ª®€Ð¯PA°é(íŸìéò b›Ç¹Y÷;ÕÐ*ä|õøRB__}šÀ7¨`Pad¥$D‹ÒˆRßÂG>âÈÓ|—²f<§ÃpTÂVÝù–P2õqUÕšKÊêwé!Â;ÅÞdÅèd\Êžîh¸åé«|½©—(r4 “·0¯¦åþÕñ‘Ú§û í’ 9yràwˆÔ÷¨KÊÌ7lÕ‡ºøñ滤!iwº`²”ï5»`Ú¡oØv‡|"_¢î,Òê{¾ýã7Úg‘¡Àÿ?’í#5soç¡QêXôkV—@ˆ Ia·¸©Õµí´¬kY]mß?Rv_rÀÈñ0U—À¦k.Ú(|—¨¦ûP­…v¨Øˆoâð~~9“ÒdªÅ66Ýê„=f¾zñ‘ÈEŸ2DJ²æP»¼7Ò^¡oß»Í0 .¯ –§ÇoòÍ[×`×ìº]F².‘zvšgÁ§A³vKÀ1]÷æòá~®þZ‡1úa`Lóå©üVó,µY›.yÍa/²È" ]B)G 㥣v'"U˜‘?'²È®ò,Ù ³®gcï.‘­.o—œÀŠØfd‘Ü\Y{8«ÎMiX\ ²ü¯B¨ „¿‡ò¥MÒMåX ü©ä;)¢+» 8~?lx¸ò \dXo[(È].2d¬»Ü4G¦*aËðpÎÿêJã•{gñ"ÃÂ5ÉFv6´B¤±Íç%´Ïï>’þ‚xæ*¯z wݨ{‹¹4]BZNl8„?â>ú4A5!ùðKt“!˜û ýÔýÑUªX}ü/…اwJ¶¼Õõ(íÅKº½œÎóBŒì¤ùŒ»J3Çwä|$°ÙÕøq0÷Äìµ vw{ð#üù£o-…endstream endobj 180 0 obj 2608 endobj 184 0 obj <> stream xœÅX[o\5~ß_±/HgC×xÆ÷J QTAQQ¡,â¡ RIIZ)izñÀg|nÏî’¶€¢$Þñx®ßÌxýj­¬uþÿŸ]­>{ÖoVzý5ý^¬^­ gXÿήÖwvÄDTr×»óÕpÖ×Á•üzwµzÔ™ÍT ÖÇNÏËÓÝ·ãyT€:äóZ¥è…Áo¤õL3Ñ(¬µeœK±û&ËÐ »/7Zéd’‰Ð}O Á!¸nGÔ–4ww3/Fïl÷p³Eç”%*#ÕfKZÃ+£ä¤uIÙXÙs?ËÐé0+TõÊ‘4î6UdÆ>f&ïÇy9˜d‘Û´5>­éJëÝS2äŒü"4iaK¬–N[µï¶…úQ¨.çi"ªa 6rª© RM¡ÆÆšL5¢Œ9o—XxS‘ÂJê2+Á@ùØ»ÞûK¬Ã¸ ÊK(¼®PƒèO,¼¾Pý1'ܱà¤Â‹.×9 xC‰O4b÷éO#…—‚‘2¯ +z,Ob;Í.`˜K–PÕŽ {ó€º5i¦Q³ýÓHFÙÑγmBš©c(;Š=Ç$.›>¼lßQ<ÆÜôǺ”ç¦Ã=ÿ '7JYŒ7ˆ¼ÍhiƒÜ*ÃŒ·j¦¶(³30ùÝh&¾÷•¨ºzþO ”oØrNä{ˆÑ—{aÓfZpÿÛ t"ƒ[.ð¢ÈÛ È=¾×M/ Œ3™ø‚ðH'Äfù߃Ъ<šäy+w7ù˜<ÕÚ8 ǦXãÇ¡\3òõ€¹&_Âü’zàN˜ÅBF Of2¼ýÅñ¶|ãÙGÀóë­…~j‚òóD²F§îE~=`ó[Ìo$!a"L cè.ó>ÅÝhÀîºÖ°Æ¾|IùÀ@I0ÝyŽŒîÞån´³ ROpGeˆœº·™ŠŽÝóA‰‰ÒË$ó“o²–¤ Y&däE/—ý¤¼j\ðÉOüΣ™6BÓ†qº‹¬•û¨lª˜Ç ™ZöpT¿W½Y)™;Æ:v¯³0Kåíj3ÎÑ#wáu~…r‰t\”צA…q6 *ŒÖ9L³ nMR«ÀC÷¸›ŸkúiëшŽTNhdûÒ+WÌß<’™¸ïHx´ìÄ‹}-©Á‚3ʆÔ}Wöž÷ÙW¡Ìê)`ö8ëé¼”ê4’”É—Ç›!rѺ)#.Œ ÁHÐf¸ ”UÀű  Ñ¡Ü(o ƒz_9 * 1ÝïÙ|ÂO\Ü%G“ÁX8 Š¸§åÕ•Òl"œ7ÔuH‚%U:Ùf†lß6#Úî×M†Gäj*7׈YÂ&F£¼©Ð»„®:Š’¢a\yª¸ªræ:û3˦h™º ]gÓ©Áz.ár"Æh06~΋1ϲ¯Œ`žo¬À¾?Ò>uög•‡Äaˆ;/‡š›aw0ÇCWcݦͱ·Þ×M°îd=Ø’«Mß"ÍZ,¡ê…̥κÓíÃqÞ’á*ô׃ÚLÏs¬^”å#ñúÇ.…¿ˆ_ÐB¡žêíBýœfEL£î§FoÞ.RKæú–:RŸˆY¾øDôç´BÄÝÝêúù­©¢©endstream endobj 185 0 obj 1601 endobj 189 0 obj <> stream xœÕ\IdGŽ}áÌÕ±¦žs_,q0#,lÓ„íƒñx¹{lÏŒ1óKø»Däö"r©ê6YV¿©Ê—_ìYßÄ&ÿ+?¿»zë#xúêJ~ ÿ?½úæJ¦‡òçó»Ã¯o`2e6¼<Ü<¹Êo˃W/í_ÞÜ]}||çú$…›´ÇxÜDˆÁŸ]Ó°Ò¿¸>)ã·èüñ«ë“ؼ‘Î…ãËô,£€!ÏÓ{ÆXs|J†”­ÐÇi:ãìñ³ô¡ó.oÛ÷ŸÞüÉuŒÜ(6¡€â›Ç@å»d^ò\^dûÔfsAÈúæû×bSÁ:íèÚ;AßÞ‹4s~SÒ\á¤p¹ÃÉÂÌ2ƼÎ;°Ž"z}ÜÀ¨½·ò(¯O1†ÍY{|'ÕÆ+“—Ê»ãküÐ ä½,ßG‹œ–›Ó˜þ¸ ý¶=}O8éëÏ÷GòzYIؼ)·h­*¬‚¿¸ºùÅÇpøxžö‡ôKoDTxüZè-J ÷«âñ ›”È©Ä´à œË-¾&‚ð  ÓYa‚¡C^ã%ƒI~ëy˜ÝWBóè™7ÚÉvS˜‰ãZç5AX»¤ï.ñ|™ò¹b Qeqë”N¸„QX:â nÒl:Fݳɋ°Êä8òòw鋤•u|ˆ•ß‚sêÅ5Š–V„¯‚.‘¶È´ðH'-«ªÑ¡nKZ‘}Z Ô 5}쎘êAGêq.óKoÎ÷ÜÈBcÈkd®Çi…଩Yi7‘Ø´S0€xÏgï½CFœ 'N 0´Ž!3dàˆb•)û2À["”íÒ½<'õ ]†Åp¼pŽ]QÎœÒUŽÙ¤1ì ŽB³‰^¤+šI#ã)ÁÎ3œÅÁvì-.þð!Pe ë<ˆ'yý .`7šn–.ü&Àè]ZÁ;÷ Ú½\úãñýh”ð t!ˆÕ!D%äIHÃ÷F`v“†©˜:ð¦¡l³MþF¥O§²›ŒÚ·Gˆ¾¥%;X‚ë©|ÔŠOVoKfÈäýrÈT=©ðu"kh€ *øM:uüû5ÚÜÖ/o‘<%£’Äàøå~ðTlÉ ßÁT!­ò{À%eÌñc°¤ÞiÍñ;|M‚0Ç?ãÇ.Fà¨ßw¯õ&köiš@…²qÕ Ù¶Ý1ÉÕRUãAotyq?Ê/²F @X§œúÌ´WL>ÓTÍpÝ™”uÒ2üÉÈÈZÙäº FóŸ;Í$š,ùºœ JRBŒº*`¨ˆNeŸYŸ $”eŒ “ä] ­Æ]ãÌY^Ä URé`‘ˆ™ýa@Êáõ÷;F£»–Ì”kcÏ,LÚlB‹9íy7£Ùñ&ä4ÕŠ œJ7“Œ<+ðQaŒÞL¶E'I-©å©f®w¥V QKty‰5£±ÎÓd>Ç|Ø;mºÆ-ÕVop7à+Îòó.A»ƒëÎõê£i‹4,Ì g.\\b„zœDé2È৻rû"³Î³–ª VÀµxé'è×(`5º2á~;Å@²ÐôˆT:ÎÇ%ŒË Te'±ë´×åphç­:2h°êùàó1(k&RœB†XaÊ=¼8jD ó¼ £ýG,œw±˜‡(ê\¬ä톩y¨hÍq[˜ÈR™¤†QÄÞQ)ÆhÉ ?hfœƒØ6öŸ9Þ•Jr»²kÀ6tŠ&ùoJÀ "Û2­4‹žO€¤  ¦–¯¬‚-)'‹×š‡|_eIkÖú!‡FôIÅW¯'”÷Pðƒ01ÿž€Co‰1gÞS„çcüÂB0·Ø8P•ÁR»ö‰v~uÌïAèTâ¥ÄnΨ#¦ €Å\UO·2n“j†él™nó!üÒŽ<¹Vðª1ž¢xGüÊ›I$Áâa\0!d:Š¿Ç9±¦¤š#‰l…¢†(¾NŠ‰)·`§•¥À~Ft9Ád:c¾äa£Ô…czz7³@8æ,¦&œêDÝ‹r80"ì;yó~mÖ‰%[z ¯2%6q«NºNûáítqçîèBÁªM¨Ñ©‹Ö7.(§Â1k=·[ X%9hUÿLò „Og²—™¸êáQ½ ïC¬­'4æ“ÒŠöD$Pi˜Ι|J&b!rÊk„Þ`¤0 Ä a[ø@ÏöŠ” ì&òºÖöÔ9OÛ [S1F^”tu™éÀ ôBÈ"m^š®-¸íÇ•“’Rmð¸ÁzÒßÏ’îà]W%}ËG)„(TŠˆb¹Çÿl!*‹T¯pc¢•KIÄeøžù¥Ìä,Ë©žªÓ—¥=“ÍÝ*u’õ_Šèóß«4 ÎåçQ¼{>x”>"·ÿ;1Mâ42Ïewb¹ÏòÍé07êa”O Ä.å3f’Cb7å%§ÏdÆ«>aI% 2‚Hù9Ô&ÁVç(N÷Óe‰<¸Ù!?9¶¼aÉ×™t§]gZsÄÛ¯ò/÷Í(fd´ ›²ËD/ÙïóHö|ryâ´YÆ2H0&JV‘Q’8³)¾=å0i›/“ºƒ³03ŒtLȾDÐÀyÀ¸±Ã©s‘2CNo©CHøÂíT©i½¢åR¢Ë]Ôùk/w¸'‰¬Á*b{9•õå”#Ö=lñêV§í{E*»e@"ô¹dú]^ÇÔ¬²"q:¨Ü›¨¨`à§Þãó¬p_ƒ“Ȭ#O;§çM^lgˆ²†ºJeZ#¸¶aQ Û\’¼3BLó-sè<λÖ2Œoiçø!\ þ³â‰½n#Í7€OVHf¤WÙæö˜ÓÍ&ù…%´lµâéú$ÇQh"`s£”ùê4aàÁŽ[Ö&zݱÂ0fCÆŒh w`b§åÒFŽÂ¯/Kê‹Ø¥Ÿ–yQqññ4yþÜp©b‰&è+P(¨2ô£=ÂÜ6+ÄÆw«@¾sî•2d…¤’MÏ$—T4ˆR 0ÝéQ5N¬xÆ®PÀÌêðF£T¼kA`gÈf!ƒöJQŸ²7'cG®.ðg~Ö¢z:X;œ duZ(¤&g¨ÑÕ·Y&‰¥d0;%@b°5Ep¡ê}4B‚– ¦¥€V{R:9fËÚVI®Îš¯)´3<”A¯úBÁhôÆØV¦¢®oÃ<<ÙÁ´[#–ðZ䎹óª ~jE}ÙáŠ(Ä–ú*lá†k† ž@Ó.±hUýP´+¡#2Ú'Zq’ÐJÑèË1Ì°’èIAX æý¾g6«gÊ &¶D®nîîâÌ  %–:gŽ¼ŠûØ—½öŸÐ«SwÏÒ ˆ€9}&rcRa;„2|ÓlBÃ<ýÈÓòiîÎÜ€2Û¢=ÓÞ’í•Ç~š±Ùú^ýF †T8“™^Y™a# –=]ÓwnÆRóî†5M—Øj7åÊ¢ÍC»bÞ2+¢ o¬û|æÀÀbì܆PÜ݇Ú'–yÝ´£;Ã’ú8X+(KwË^à™ñí*u0‡wcïJºÑây 3mïú\lîésØ}—ÍUãR$kå â÷Øfw!ýÈjZHý´ã9bHŒ6*}4¶xX>·ˆs®C©¹óH){Tê³¼C´ž ÷Ó÷xiŽ7,›A˜©Íù"žcŸDd@˜\Ç8Sü*Å(5Ú³…™ mÖ¬75õïÈ3ÉÚÔZÂż6Ó˜®²h{Ú/]C7 ›‘÷º¾Ä4)¯ÃÓî„fÑîPýå:J´ç¹ý.šTŸ­ª\ÍC$–t„¥; ÄëÅÏr<[pÆwílgEõ¨‹¢Ï5V• t¦‚gi&HÍ…Ê_ârº€ÍÕQ^˜!Õ€Œ\‡ˆDóI¦¡#}"¶ÉŠwQ5ì[¤úÏ—¤—-Ti+Z^l¡J×<,Ï¡Ôjvh­~«²Ù"«?ãꬦóíß/2™´#0]f©µ[I6]nŒ)kñ6@GK¶ï Y„ó§m‚±_0훃gÑ2ÈàÓš%Õ"ß4¤ªÙ4འ7:wÜ|í(X5GÍ®h¥nÕn• N_àžï(ª¡â^Ž zElï;}xóF™yq vЗ‹Jà¨_ÛÁœ5$Ù/²szÖõ×ÚR™¿x®R’+»]à›Z_9èéˆ{tK½Í÷­´¥wÏ!f3›+ âV®Ÿ6fÍ.«c’oÛ‹uŽ¿¶ òû_Ïžb˜èêÎùz”=Ó`ø±ó.Û:Å£,DØh·:èÉ݆ö^wÉÐM…€×p*jÏäØ`ÎKnü }<‘Ö¯ˆ‚ Ëž»_›õŸÌÚûèØù­3ƒ“K„½LUÕ¿ Ý'çgfµV¥^-b öËEY>!b-pÒÃIÄ-•ð×ôœ¾+ï¸fDú© ¼3#zB[Qäز¸Ê ´¦KØ¿PðQþ«t¸ E˜‡9„Š&‰›ekSÔon®>¼2ðÞwW ]sPÚƒ[|¸»BO ¾(ÿ¾½úÓòEø†ëŠÀ|›ƒù^›Ë?*ò<1ØÌ~†à’D=aÌ&°a]ù Õ1À9 $&:ï·à„„bþôÊß@¸”ðrz*¢4“'¬æ‚Á­9hXS^ „&‘®a6§jG¬›­a!ÈÁ©Oì•qãQ€kÐø 7ÎìR¸ç¹4ÎcæÛ1ÎrLx/g¤šÍ¦Í‰ƒtªÝ…óáJÝœØ;?J–@€y°3šðQï×Ýï’쀳:“P oƒåØ““„Í‹B„’˳€2›O€ÂöAü›æÃ6ßÂÂÆN;αVjö»3=k»ÄŠé>ø— Çy·ÿÎ8X;%g£šÃí‹a/v‚4@(xÂiþÿá ã±D>èXgs›M  ƒÙøìQ`v4z9óP¢Í‡ÐpV5PúGЕ§}XÄ­§¾*I[ŸÉH»i„—ÙbÓ?´Û4õÃçºk?(^Ój š©Ú¢¡­{¦¨ØâËnO ÎÿŸœ–œLO¼ßIáM‰ïuäÓÂ;/'¶3˜ÆxcÚ¿‹Ìèd,×1éoÇ~êU´Äj:”-$¤ò ‰JW´k™²æ.:Tçî;‘­ùÏ­n'~ŸÛFoV,ß•¤·Ï VRP?&FØÿ?HJ²Àï?xÑk~ãöÂm*|rMbÞãt—Ã%ÐýóÆÅQ)¦œ§²0 ¬5xuáøókX=ýZÊg-¾ï£;¤1ÀˆÞûÈ¿Ëcz”˜Öͧ*õ¾É$9^ýL¿¾±endstream endobj 190 0 obj 4773 endobj 194 0 obj <> stream xœµ\I“žëâ¿07¿q0MíËÂãÀÆÆc‡#€FH",@‹üëYKWf-ýÞ ‚ž~µdeåòeVVÿp%6y%ð_ùÿ7ϼÿ¹¿zòê¸úþ{òà‡25¸*ÿûæùÕ‡·Ðþ”r‹Öª«ÛÇroyåÕ•·~‹îêöùƒ/NúúFnÁNjüêöÏ¥¿Ú¤û‹-§Ì¤8ãe¼Úß© 7iØÀ\‹MDu§¿]ËÍ[!éÓG8› ΚÓ_¯o`)­?ý~‡‡Ó'ÐÛ«}8ý~µr3ʲ1·ëý n±­T^˜ÓŸpP)Ut8¾²jSÊœ>÷ÑÀBNŸC[+œ1±L¡µv§áQŸ„¢o YtâO3áʸ̦0ã²±Ú0†<Ä~"(­Éã½9m¼Ù,çô_®Õf|”œ?„ú’ד•Àd2´-%ÄÍ8R£€æ2åï&¢BzÂo2ÑW· qÞíaŸ^ßÀ’<Žwú4~ §W¸e…>}‡ Dp> wúÿˆZ*©O7(8Nëpú>Q {O/¶]Ç;2Íë,>ÒºÓã}Œ‘$+L0¬í7@‡†×{‰MÉ`EàC“)KOë”FiDR­Š9r£"0VÈ« ´"÷'ÈžqÊ\>Æ@™ByEZÿ ¤‡´ÂÆ iø)ì]$/_^{½ùl/ó xËFgøºÙä˜qìز5!óåµ › /yfXÄ£¦Ú™ÑÒ {Ì\€úºL mîʶ¥ oã¼™>#-íD¢Þ›"UFÈD.(¤7PAV|—W,b<ýç÷Ñks/à ´%+â4’i G|7ðÞ¢¼VÎœžÑE¿iv3I+³ÉP5)¯€ 2GÌÂæ;þÇ›k)â¦Á0ôâY†½•ÖLI•lJ*bÚh­Í&4[ÓˆçØDn`«©˜>ÎMpGB”Æ6†‚(éRïØxUò_áÈŒP'_û{.Ù/ðµFIj\špˉ¢±‘‰€à²@ý…J»„óIPÁ‰š0)`£Q!òÈÚWæÙ•¸eéwÐ YŒˆ[¸Oý2¯ØkUŒ¢âˬ¿/G“¥ÓÈ„J:á,Y0s¥´@j»i Þ»ºì,¯…¹Ö±i3’Ã*ˆÁêÐDS¾<¥Eà#ÙÀ§Œ^$É؉ƘïèpGº•[|yf1&«PZû¹Ñ1P q©b bùYˆFŠæè2AA=VèÛxB¶…óN2±%"^ ³3›_ÈÜî²yÃvMUÃfæw7ìZÁ( E{’ƒz•MªZÄÖY77ì®Áç:w—Œ¹ˆ4•àÌc³Å¦Å¨;Šý¯N¼Œ €w=#Cf+ŠS[feÉkLÚb*ªò¥±;î§@5}°§ÿ6…Æ/28‡›jšd’îk×RýSÙB#œßYôʦ4rèÖŸÁjyÊæ  @ËKæþ…¨IÛ·öDĸð›S– }U´„â+˜§}¹Qz5ñü©Z5]Õ±ƒÀ §¼Õν­ƒ€¹ÀÎel‚¥ ÐË‚Z ç¿) dÓšÆQrÀÙÃÜfÓ„²P !HÐ’Ú¼qº,ïhI`÷ü1=(Xœ»›-ïŠÙ¸_Ie˜C*ÛÕÙ ®B¢ÌØ »G“@dàψ$WÀìPÃp|œ‰;¢Z‹•¥#£°Ä­zP<_k‰\Ÿ¨¸Ýjéˆiò iÎ`2‡Fó!z¯Ci@:s@öéƒÛ?…dʇÄÔ1“¯$ÊVvRê=x†Ut^Ly·)ÛÇlÊ›MuГZ>œBJ›SÈ[š–€^~31NFÓ Ø+Ês(;T[™õ9“5eG‹>á:’™cT,‘²‘ûÓÄ:Ó¥bò¦€z=YŒÆ]8.5dëÜh²’ì±ßrz–¶*¶4Ü—fw äù=ýÖHož¢9*¦Ud¿– ËÑè \Ÿ£A)òòQfnÙ  ×B´<5álZ>5…uÎ$»ªUIi`J$1sOZU±†PLRŸ´·i,½¹V^ô¶ç#±DW©eªy(¦¸‰.hÌÑ0ÅhŠ+µR.“h$±gyGZ¼ÉkÒ,²góÞüí¹<Éþvž, ~®‰;IÎuy´îDÜ'ÙÄ¢qU¡ˆßê2 oI»š’vu Û†[&¦s¸V2ÕZû(®dÃÐD ÑbW„AÒÐìœl­UÌí–ð-­Ÿ;Onýt•C´€I`À`ëì³À9jQcî¤Wbœ¾”ÃI $K#6Ucî̹w}ú=˜è‚S xBoÁ¬yH[Ó63¥nûå¹UB£rÏ%×9À2UÌt·B’ŒøÆö§ØÑmNK6ÞÊÓ_—®žFTû6ǪE΀Ÿ!Ò!uØ¥h[ªTé·w ï0ŽŒ ,PÅÔ6i<+Hm‰úd‰Ï´r×1MM ï`€qfŒP{Fâ2=¬ǺEèð°éÔÃú6t |+dšT)ŸÜØ}4j̵ç Lé´IĤ¼™Ù™iL÷»»dà—œ‡©œYd4ú€·³Äôاe”óÆ”DâÛÄ’ÇðV°D§°…A¬¸K; úÈ‘û†¬G;“­„p`|žSž’݃IªÌ,=Ç*êc½Žƒ°)DN*ßûuLdH{‹ È–˜ÆM#iŒv|84féáPUÖ÷ò–13•c¸ÓàSì”èåê«,ÐFÆq@GÖ=¶þÂsFÔ¨[xSÌ‚žFn­#J’=0DÕµ•%-zz,ÜÏqΧO²–ZPÃ,(¦#ØͱÎdß:Ø]×íò^€oÌÁArSRÿ6þ ,cHs °f/ˆ./姒v¤}i¡~%ðù÷1öÒ&éY9’–”,&è²µ˜IhŒgÄQb40¿iHó±–‡§Ñ/Òš'ŨjMΧ†À]5@‘‡˜yÁüÇrÖ…~òÒŠÌ>Ž'îq#S9ŽÄ¥D•™xí YÒã:äBi™úB¤µsYÒA‹°EëÇ,çÁ9Õ<™>èÉ€³=ÏæH–/ LÌ>ϼ1vZW²GVBƒUvg=]-ÂbÂàS²âƒ<”K×0û<(•ÆÒ›x¨­•JžŸJ¾!´ºŠ1§3‘ßÃz‰Üd?,Ñ¿½³–'a¼éñ~utŒÍ``Z?÷fEbA‹§G–³Tx9Jߨz¼M9a ?µsgÞå)4rd3zv°u_Ÿ4äÁñ¨Ä#ñ¦/¥Ý½k¬KG`.¦¨l‘b{”OË;ŸšœïMò ãYñbj:6²Ëh;ÅÙ•Ý™ÚöÔݯà[iÓ'|CÓ =ßLbóP¶‚dzî úErÝ x°áú¢0n»QV6bŠCŽ-k5.«ÚÝÈRJò­žó°ÌâµÜGÕÚ¾ÊYfk ݯ=ŸlæqÈ š.ìûa}*â±™w«º‘Sü“LLñd»ðÓ´.=è]H;ÉéÒÃÃ÷?Wæ ¶MIk°X,ÚÏ|žˆ¢ Fe«v{eÿ1bøiO^ã 2•¼1Úx•DD?ÀMBä)´LÆêúˆ ›$<ÞåŸEtèìM*/©OuÄhëˆÊa˜˜:gI­/ÉŒ‰_Õ­éîž6¿}œsæA˜:v{ºûm­çT}]I~Ö:ïï¼Z»ùœqžD¿/Ô9KyGü˜HN:}Ì‘A]ô]úº6†TtZ7+²×¦–3„Yíÿ"LÓˆg&³C§ìèžåæÆ©KÀ‚Ê¡Ì ]/+¹*ß¹‡YÕëîmÆAífƪ8ô|Râ7h"Ímjüò¬Áû'g‹à‡ :„+8Ç2íþt5å¦ãÀ‘2 š2ĶV·ÈìlžÀ½#§Gë–Èï æ]Ìâ8™ü±H%|¤I–¸j,™ŠÌÒãª+´h3zºROÅnŸDPâÛ‹Êü2Ö+úÒUs×É${5u1è5òC" Ä”÷ûbÇP䔕ܢúŽåH€<ÅFµ‰‡¦`¾ÚÀÈJ{0wËÊ^ä@ ÉD›çXg8p( [©LÓpK0O2dn`tLÑ×Ê]µÑªDñ×ì<+ylb~‰w(är686dÕW¢ï X`k–ñŽ`ÝÅá—ªá×Ét„̲’°={ñïŒ\©NLF®eºëµ„Ô©e ‡¸ù^O¹r•Ø‘kL5È"iAŠŽB $M/¯,Î-gñÑ´þ8q²‡]X!k—g¼üø&1ÉȴžŒ'b³ŒÈž”År)ã×á’~ x2UAþ‘ìG:^ïQðŽ|÷Ó² *½cVdrj/Eî/‘¥êguT Äô!¯ƒ»Uî "‘«‚®3Ö:y–W¹šÈDÃs„ýí@14 Uøák©|:N7-«53ºMb™iÔbÀÖ¸lSá”4j$ëßî Á•ÛÊ€£Ùk‰Ñ „@ÀóÏP‰D°Ó€N¦{ØÑ)ô¡aLSšX®³LÖÖ?ïãÍ𸊠õ-Ø:¸O‡w)¼YoN"s&b—EgõšÆÛŠI¾I4¹4‡—mq=œÚ "ÛÿÞÔêÉEþ+¤DÈƬJËf&(1fzÑ&øéUži¾puBR¯È0‰O£k^ANªxæ^AÈ+Ì÷ÛXæ³çCK ò/¹îùîŠ©É Â|‡Š»zŒ“ny%dÁG‘pål¤Ù}â—Ðágyúä2"æ£^•¯€ÈÓ¤Hèu& ¡JÚ1¯sɨ¼è9QõâÖïÔÉ9«|ã­Ý—J€9¾/…Ĉ5ºË»õ+scb¤^æƒx€ås,xXD§î­>¡R¾Ò²¸‰ß’˜X駩Ê0'Ž ¼_ÚÃuœvÒ;LEñ=‰ º²ÔÅ—‰8´è…ÌùN¬ý0U‰µe‰O80ž¼Å—ÂÆ‚§osÁ"faÕǨ ððEÑ~Õ"‹V”65ªX1ìäèˆfö16ó8¦`úÍ& BÉWäŽ&èÜb‚ä0€¶›0•tÊ BâÆ_< Æy`Š´ Ácœµêý³÷ú&Ñ¢î|)/¯KAv¤æ‹s¾_xoJK,jšÖQ—,ÐG·þÿþ¦˜endstream endobj 195 0 obj 5018 endobj 199 0 obj <> stream xœÕ=É’Çqû6‡¾½›ß88­ÚÉ>X‹m9¶L}!u "9(6—¯wf-]™µô¼¤ýª«²rߪø§“ØäIàŸò÷“W?ùØŸž¿¹§ÿž_ýéJ¦§òד§Ÿß ø§T›TŸn?¿[ N™§rÆËxÚßyuòÖoÑn_\}rþ§k±‰hŒ î¼]ßÀ0íµŽgu}#·à øÚÚ° -Ï?Ç·*8kÎÇV8câù×ðèÑÖŸ•xëÎÿ|}£ŒÃeÏ¿¼–›”*ºú;Nð;|Œ.8uþüŽ_Ïçü-üê­ò|‹/¥öÊ–ßµÖîüi"c`À¿ÃšV¨¶¾”ìDSfP^˜ó¿â€*eÕ¦Ô*CA’Ž:ÈóoÚèëq »!d‚@ù[k€2ý/218ïÙjÒFxÙPÎQúûÛ+l/¬UÈ™©äÉʸ Ǹ@7j·Gœãƃo4àïtûƾE.Q2XÎÄgéˆêü?&˜ó€NêM‡p~r­‰ö÷YžX;w¾ÃÏDðAJOF䤖ø¬AGÂ#`ã)®çqüù˜#„ U8Açè VR ^¦›qBÁÜiÖ›óëk6Ñ^!ÂH*‚-ù2ÏgÒÖ2]Œbtqa©½Ÿ#e£Æ•GŒ:ÛÞ>mbœÑ[ˆAÈ:ñG0X$ô“](o”€ÍzM¨BvýÇj!$HÒ׉íLô±Ëz²Twš@–nóZ!È•E†•É:ÏÓcPZSÚ¿ÆG툴¸mAr^ànÜ&¼«ã3„„.SrXÄ'G¢A¡ (ŸïÛË»öøÅþ»Ú_N颮òŒcs3}RXuǪš³xÁ®´àœäÉdÜeß°*e[Â2fgC @Èp B”´20›Íèrð¤èÚ?Ê"”w"¤PѦÍQ¡üÛ3 2Ðù舆è¬4¬¡J#ù1Vÿ-Rx3ê©¥š’Á=—*›ŸCãW`%ZžŠs¿&µ_ŒŒd…®¯b·ŸÚê …(ÂÜþ]_Ö¾ñÕŠ¼Œ›¿ËNPtÞFõ}2Âà Š5úÑà‚ý¿†EÀ±¡’ЮèëlF˜Þ<ì‘âte°èÒÕï\,’7dR |1øŽ­ñªø¶â'S|ÕŒéNXŠˆ¬F` ¬ÂìvHñËÄc—Ʋ·¬½M®–dØòî½wljEОˆôÏlö Ø,²5Ó1dÐ_7OéY{ü¬=ÞúOÊo»J»Pf9TJ#¹v1$ŽÛ«ü(MæÜßþ¡½½c ƒt$sóu{ûº%{{ÒÞ~ÑÞ¾™¾}Õ_âA àâ "Þdn²R6ŽžéJ"‰ó¯‰’!Æ!o„\Ùêâ¬`´z7ˆˆ‡¡mRØ2 Û |©M»êó” RIË™‰T,iºï«æ(߉ûÐæ¾k5ƨ‰¿C¾§ÊùŽjÔŠY¦FËt å™4.°Ø^Sµò&Ò*R’ l"N¸šíÛl]×;+÷›*µù2| Ê9ã'kËXÞoˆl{E6»‰Sþš…ƃ˜ÀoDÚI®ba[ékû‚ò7˜qZ‡ »'æ"p{y—)"”=PbÕ [ÊD ‡þUEiG|µ•W¹ å×â›XÏá>õ?ÊÞGĺ3yŸV)x$A|µéàûÔ€ à=EÞâï° f‚ @4ÛODr‰Ä‡Û`›¤á:11ÁnÖVAØ1Àt·Õ %BXý`²ök;lZêu~¸·tí*T†æc?»žé{ ÐÈÂœÞûL¯ëïxœ äÐÀy¤‘ˆn®Kÿ<ß[£ô=››“ªè@‡NÕ=V¬œêѾ #)2<ã+ôMN Šy­ð.ECÍ•—|Èó…Æ⻜ ­žì<Í+ÏŸìLJR–¤ÚüßøÂ8±A)®hz§Âù÷ûPŽï Iá¼C¹±IMÍíEÙUð²{]úê>æ™(+fm[“Û?Íéb¦¤·C?’ªBžþùsÓ œx­C9ìb¨\ñ7Š‚ÔN+àS!HÀ]9•¸–óºÜÃMT…¾UYcñ]ÿÝd€ôŸ%Ñö˜,E[M<ؘw\ºûSŒïÃùÁ!îåÚÄ-ù£¯ÎN³FLñ5kyìcäѼ̴Ãf;jì‡:’V êæó5Y!*¥¿¸±·*l†‡goi±¶‰Tl‰©/K¨V·ñוUpBìÇ¢9ö\º·G~Cj· v¨úhnßÉž¾k án‚îz3Æ éC\/oÔ‡.\¢Ñ/¯¦ÍðšNvDÃ’¥çÕ™‰ CQa¾²ƒ™AÞ¦íD0¦^íÔ65¦‘Š|fZöÝB·±$–À*,„yR.[ÄÐgˆ´5ž­}Twß«E²Ó«dV-+»:Ì{@š1}UÐÖÕa˜‘ñã– ŸÏ¯LhTõô…VL ¥|µ6äÝ*Ü"y!ÆÃyÛ¨ o¡ ¥yœŠ®Ó*éR«ÕK"7¤ðÈ-1妹†#‰œ)EïM5›mÀvŠvŸ¶¾ÍŠæ— Dwdk5Сsiæ®f;Ý¿ n¹1«'õæý\*(ÎSPfÑÕY`ÚÜä¶}N&u åb®*œº·^ú2´ßT‹È󴊸âƒ=~™ÉærPýZ:¬Äо J1š“Ñ`•u8bøŒLÖéAÏÑáË^ÀM•Ô,(e¯< @„`t}ŒsO¾´bið´uŸ>®œaí„h@šBššhmÙì  ŽÁ‘µÁÓDÕo@øÔ)ko>j:v¨½u%…Nuß+’±LGHHùä;¹‹Ì¤ÚûÌóªÞ4ÆÜÆìµ.)fu³ÕA5Ô53M”Ñà‚6­y°Ó…Šm¶¹)á…O£ÚÃh໢,â¤Ö÷Ouæ i©Œ nz&Õ€Ñ -œàž\H˜XòÖA¸Ñ~ì²EßÓ‡ÇP@úœÇ˜DÓó¨|.ñ(ŒqŸ³>ç” ÷Ež¸¹y£e¿Ä4“Ì"+*[ïÅÜl,Á·yÏNêwÏ“d‘B­ŠTgnR o烷fSŒRä«o vC”Ö—GÍ™ã1gùùEÙ_<ªÝqo,m„Kñ¹ Τ–äËÄ#ŽÂn*Žèò&t–†…/7K´]KÅè¶õ×Xn`—. DÅåu™»‚1 r”ÑÀÓ<%²wtö°n™ Bã¡vè¾ë$U;MÉïû K£\MÌÖ¼mF;Ñu«#Ÿˆi¹•QBÍò».ZdBo2&¸Ï¶Îh¦SʧŽÍb׈z}ìÁOåæÜ7K ‰ušt•½G¥*DŠ3XO_Bºï ç¯ò%ÀÄNv4s€ù.lW9´d‰œî~pY-9I–AÃ=ëDg ÄuQ¹î¶‹ÙcÜ´Û C–an¤ë~rhá¢]¸zí©X™ÉK¤ûG½Ôä]r34îa™´ä£uMdùPÇòÖx¢cpf0¸é·õ”•õ):éÎp·‰™”ä³Ô¢Øc÷Wå®eý.‡£Jµ´/+¢Á^<ÐedS¶zQ‰ð=D''ÔШ߷:](8µ=ëÊ^ÛšY]×rŠÑ5‰t†rÀÊw£gÛ°Á%¤ÿ{3Õº9fG¦q?fw¥ÃUËj±±ÆWýé}¼ ®3_’Èñ¦î…>‘ZB3c“ÇÂs˜ðD/ìõÀžÕñð°;ütªZÍCªy²KäEmåË-Ê‚;$%y Ìéô`~‹¸öXÄËiò?Ñ2i´4üäY~5Í¡ŠÆÑY3Ò¸8œ›é}Ij¯'òÐÍ£ó9Øß?>Ö‰ž×å§ÌÞ•’¨ŠÁ#†¯*ôf‡eê©•ÊËr{nÃâtãÜ2­¨¢S¯ò/;vÆÐ^ƒD¦xHXxAsI±n A{£ÇŽÿÃäJ‚RÏR›»d‘º×ЇÜZÔŽÎë\ð^œ¾œwn0¿P)¬ÎñЯá-ËTÚ;÷W÷p<Ë%´ Ìª.Þwf`U1Éd|_bDAÃ}&‹;§Ïšy¼e·<ÁA†rÌʼn“ߢǺòçW+ÛÁœÌ¦eŒEu[# ¶ô¡Û@>@Ÿ4zºýÍÕíß—B赟¶4¦³\ê„M¸Ì~-Æî ATeŽRànžÅmù†i‘ê»R“µ¼ÐÊšBjð¸ê¤<¹•ã½;†É³H€ŒºxÈ Þ—¼ û4rÍ¢™ÜI=ª¹µ@‹%èµ$²°¬ˆˆœ«†ú»±]Ò2{Ù‚œ®¨µ3‹Ñ3¸ÄÌÎÛixÛ Pfsîra×Êl ’»;f-[41‰§OðØ¥Ó¡³"èÂ-\YÜžÐ-@;*'ýż;¹¶D<¦0xp,(ŒãöÑ|ŽÆʘGPx=‡<zž|${¢¬7^spÎßÔµCz,áV†û‚ëpIëˆ> ›ŽÑaÙt U{Þ€Úˆ¦Í‡Ài©}rþw×µû0íd@N²í¨1æ²K*~—6hâj§º ˜Es+åâ\së¤ç§pVõûé5íS¶Úc\X¼,áÜ~‘ÃxiAÝ«úlå}X»Ö;‹j¦?ªZšÖ‹ú ý}õ¾ƒÄô'ØÕ[IŠÛm-* ¥ëæ¾r½ŒCÏ›“ÏðW¸Èëî[¦Õšö˜ßå“.uº‹Ž]V?º`ÖÙœIyY7*¿¹F§úàÔ™½ ÁovqÎä.“§™8ÊĉÂâ±ÝAZ™éÝe»]M¨c¡š¼aâyñ§å¬WtvÀ$€G£®c‡ƒª$Êir'Ö›ýå«Ãó„F°kÖåŽbÂW×m+Š§³ƒ0º=>Ù¿üTl=ß+ÌÃ{hêlïPQ÷=aMŽóìÀS-󓲿”ü<“©e:÷Ð¥jUº’¾E½ú ˜¼åd–JOð{DoòPzvþ…³l4sybÐÏ÷;.z¼«ßðôAå„´¡r”<ÂBýØŽ/‹'‰üö<ÔjRI½ˆ–»úLÓ5µ\îG(v~ˆ–Ià?ˆºý£Üù“YY¯¾ê£ä¼inWžsj#1”í©u#ÏÒ21ô¶ègoÉ)³E~xeveV×Pº2i»vÎ{çhø ó69Ü{&h%œÝE7«†ú•Îàg‚rŦOoÒ• éÒÊi'øûTf:ìÖÇ5ç‡ìîø=¹éƒØLrÓñE‘2Šë;¨î¹ àû÷²»)"Å•r™Üœ\…PùÑ›CíÇÜêv¢åͼ¤­ÛgLã%¯–ðóƒÀ¾}n¾Ó[x`Ì÷é=vÿ&3üÏr/zC€ú2béñµ¶åÓÙu~D¾ºƒêl³ÃoÁÃfã¬~‰&À…Õ,\„¨®LL蘘٬î²ùüæR~¯ þ‡DU?‹O«5“_¬ù4oQ"Aûùí‹P¶3<ÿìúöËA,rn[œœñç±ý…#P|zNº ©œ^¹Y'šY¦§Hƒ¸øhÒÎöX r:ékÎNéÁ°öÉù»Á|æn°ê÷Ç>õD+2ÿ®ØwO²:c2Ð¥3URÀ|2§Å„JùÔF±ô5L!àlTQô'e†TÔ¤a •ntØí~a[fÕ{}™sÖþÏjúx€%ÚšÄBïྯRœHOB/{/UT›]µ"Ï Îî‹L9‚È’Ë©½Ë ÞÇ™QkÒ“9µÙ1iˆ¥=LÄû'Ž÷åÀÛ…ÑV¤Þñ®G:¢EG8¢ïgg· 6Õ»»]ö…   ùÿpïµ­XBѽÛÖ΢]PwxÇp‹žÌE¯ÜX*’ó¶¥æTr%ãñò‹šÁx•• uCìÂ3*,b$ª6•ÆÜnbå˜ðÑ_¤M ç…Ÿ©k˜_‘Ñź@œð0ëÂÙÌã=)ͺLÏ14ê¶8rÑá0)Ÿf5¤CÓý‡ ýêöê?áÏÿS,ÞÎendstream endobj 200 0 obj 5202 endobj 204 0 obj <> stream xœ½\YoeÇq’7þ ¾¸×1z_äÁ‰—Ø°³Œ@ñÃHœMLrâ!mýë]ÕËéª^Î1¤@ttnŸîêêZ¾Zš¿¿›¼øOùï7W_|é¯ß>]‰ëŸÁ¿o¯~%Ó€ëòŸo®ÿùÁÿJ¹EkÕõ훫üµ¼öêÚ[¿Ew}ûpõÕIŸoä¼qádöÇßÞþ¢|¯6©„ÇïŃÓFfRœñ2^ïïTЛ4lâÅ&¢Ž:ÈÓœåæ­ôé'¸š Κӿo`)­?ý~‡‡ÓÏáko¬öáôßð«•›Q–͹oLô ¸Å±RyaNÿŠ“J©¢Ãù•U›Ræôïø6ØÈéKk…3&–%´Öîô3x”À'¡è[B]ø—™pe\fS˜qÙØcC~Šß‰ ´&ŸÍiãÍf9§uV›ñQrþêÿ‹¼žìŽ ‘1ä–Õ¾Ât*øÓóùFlJ+Be¼4úôk|íb„Gß„+žQBtp§ß¦ ´x„NéM9UÈ2ÑFuz:ßh«·([â[|–0œÒkb6 Cþ/mD!ž>œeØl„£{ ,Ï@8¾'m¥U§wø½€wRzXC¡D ]_;ë½Oc`ùÓ#.á6u}+AhÞä…mP3Ú,l§ÑfÊâ¾#S<àX-„Œ†ÿ< TØ:³3®î$ØLë·0l$3K*:Ã#¡çwYØ„Šì5¡èOðaˆBû¼iÐ5ïø*û{szÕÎô®©ð³´E¯é€Ç3 ~ "+®oï@~2O|ƒŒ2õØŠ2!´â_7jÛW/™Në_à+mmìùó°…¯a_EÔ_Òn}#’¦2ÁØú•´:’¯ÚVø›Býôð•PyõÜ”ßE¤ò¾°L 8—Âö}ÚDÀ’¨¥ïŽ”°àž 'µ2Ì—œp)©ÅŽð›ŒñHs” `/÷Éó¢L ˆÈñdQªiåw¿’®çl¿¥uTB³:xÚ%œˆÓ†SEíµŽx`~ôõí/¯nðU±öZÉýüŒˆÙ"ÔYл8aeÞm&D€Sª$`+šj¼0ˆÑ¡5Jkw«”Y`÷§·£ŒðhÚh&“…’ôPÓÒ‘ñz¥3wHp&$¬e ÍÈÅ3{Û|ÕH®°ö»"—ÉQâ!!bïzAH“-À.È8š.á68™#mÀÃWsDlDùÌ‚à8äN§”9àƒ%Oäç—Ìqm¶©ü¤cƉ­Ñvñm!RñO™)^9z8ôŒïéð+nÊF“åÒ1äýÇk ¦ˆ>7Ý@Ë¢`g‚íUîÈÖH0Xà5f©#~8Íå6š’°0˜û±SfP:¶|¬Á‡Ë£xʤê÷ ‚T)ªC‹Ã¨ûí°ÑûÄ¥- :+°b¸úý%}ª,’±8L_&®î9kÀY¼Î{@?¹²‡s%(ú˜PU}ÙÕ¡"% 0[1ìòí„7 D5¦ªõ¸:$úÃÛÂTO]ISòrDSèå‹0í•ÕÛXýÒßpP ü±løˆ»Ü Ò÷!?I8i¤*ª- þšl Ìé€ ¸©êÞÒÓÁߣK( ä`ÃàåÕ'ïšݵڤÏ;ÆnïÞï_·%§¸¼¬ÇÝ›R%Dò±*ÔZS9hÅ&‚õK°ÓS-™{'"­D–p.™…K)®A=´±Ý6ðþmÛ÷Zóñš|5zå´Æ%Û€Cð“í[æœ Ö®ëB»Rù’NfBÀÞ«uY¸ƒp(V3Md¶¾;OeÀï…øஃT}øR]•13Á«G«¸“,KÆ`ÁT§² ¤QÌ!¨6í®o`5e°©Œ*`˜“¥I»¶"nwþ<‚“Dð±=þC{|™¾ýó>/Ò²û  }l‹>´E_µ·¸Øó²KÖh^µÏÈdÿsšÎöu{û4.ëí¯ÏéY£N?$ÓáãSK§{¦ë§F¦ 'Þµ_ßžƒfà\uÓŸ¼î5?MJ‚‰qó€õ·öú¾íã¹½Ý E`„>NǾï9Ñ?þ ϼcëG¤  ?@-¤2ï_†wƒÓl÷Œž,+6ºÆÍ:öOÓå>´ÇÇù)>¶G"ïÚà×ù­²e2*3ÊRáøÃþò¡I™ÃEÏ) \ìD'M=º1àûÁª$uwÿv+§}f~ü×ÌŽ(ˆ+Ð×2ÉH"7JÏÅ÷$T°OhÏ=ç„ž•C¨¢ š}’Í |‘l¿ Ò Ða“ºBˆ û¸³ß¦'pr.W廉òîxàæ‚Ø'F ‹:%™~„{p› SPÐR„ðÞÐðrÑï'Þ#÷UDÅþ祰Õ1?9]†>óܯÂZ»²²r9'j"æO‰w&¨€ù¿»L˜u ¦Ä,„sN3D¸ ‡"û/‹XXºà #ðCºc¶ÅÓŽ¤9™¼é°]²ôÏó/-;Fª_*Ù{á÷n 7õ„ÎN´øHƒûd–ø>!b Sd(œœ‰a ;R‚RªDƒ ‰w’ûÕK5%§óæyúbá¦h4D˜mk2XZk~efsèÄãйY% sZÖøaV´— oöÔ³í%XšFhœŒæô9ÇR‡åè!y˜B>Í¢œæeV³3»;—rµ#¢NýÍYyížþ=ÈY¼¥ýþªŠr MUµ(ŸÙ‰¢z;6em-Œ0‘/r¦Hƒ“Ër -fí4¶—LÆGÅSOÓ#^Tyˆ7;Î.·ÍM*ᙌYÙ†Ú­aÊ!囶. ùÚDšãÙ)²rfz“‘Paç:ƒ7œd¶§ðè³!ŠŸf†…Ä)¶51…£¢;è|ÜrðÎ6»…·ð÷ Zs­ Õ,ÍÕ0¥!JH!JWä¤0;@ˆ ècO ÖÐ@3iŸHoÔU€C]¤:ÿï{) zsÆÌ)9ì¨PöÐã‹ï£`‰{C½RHˆÑcn/M𹽨°ˆòuÉ[i˜tf^2Kd–Õ*7¤l2->í_ei•‡Ã£8M+/P"¡Påu>Ï`iûOPf"K12o‘«Ê †°zw¯jŽIfñ-âdXIJ”d°"¥@†Ì%ê ÑÁ 0ɪE}à¾È,ØÅâ‰ß3 w}¸›‚wÏ}ÙBã/ÚÛ?“ua4Iå “­Âh”-F¯2Ù—²¿$X`S ¹?`5%G‹ +ºy ²21Dj³Î–·¯5;.eHÂø>± Ì.ˆ4xv€91••ú!Δy„1u:Ûetvù7 ~£¥¨h [Yb´M“?,…ÂÉt›sB²„U!hv¦<1ÝU7o4ºjÔDD„{>맭²Á”J~epŸÞèûž´‚ãÉBKNfLKð” &"´Ú,ï½ÁÞ å.öÞ¨¸ ^ Ÿ¦Vf5Š×—1êy¥‚ƒÓs¥ êñp :ĺ˜Ö‚¨ ] ûG/™ƒØç²h³J !=Ϋ,fé´û€°/û¬<¬BÆÕÙ¢•¡PTÙ:Ë]R…_El4£™ùžEz鞎é²Y ›ó›srLqÚu—g¹áÁtÞ5z1…v3mžTyÌÙƒe†%ÁG¾MÒRÁ€©aÆ2}ð‹hÂMÃÕ=yÁ‡Ns/;¹œòhÖuïyšÅÍIÂj$¾‰…[u‰Ìâð–ŠÉ÷¢H·…ÈÐ$]m)OÚ$¶Y¨!DI½^z•Ò'’ƒ¹ðø`ïåq,§DjŸôãRšKœæü䑶wužz€10B úDùcfKô†ï¹æ…ï²ò£¾±45hoW=ñ‡°G¬‰#j lÓLÚq…!c2$íˆÛœ÷EthGÌ*g<‹­³›ôâdEË ú´ÜïDQV•K·™ï¡l©7=ËÑ3'5$X3`Ú¥ó°…§ËJ8²T§¡‡Nm"1gY7—å‹)¾¬-©NÑëMU.æ´s‰SSÚyemãªBĹOýžAroDÖ¶äÆñ²ÇsV³œÏÌÆÖw¬Ow ÉvÌÛ?‡· b²zhÓ®–W®ïRk´€¶¼¼Ò 6%“¡dB>Éj–»m‡ÄÛª±–aC¨Zó™CÀ9‚”pí6Ç4¨™éè~?äRÝM-’ ŸGíK^îÌû¤Ôå'\QùâKñ=à>ãrŽ…D<Ü\qÉ.Xyã÷ÂLŸT^ÞÂñu¯AÈ6` Ä} ®ÏW@p‚¶)Q‰Õ hØÛGXDísúe€g¸oHÎfV‚g_©,—ƒ)½¾`–¸Øn@ú,4r_äÞ>z©°+%Q% Ç^ùC£©ýe'Èu}¡b_&<Õb–EÈyÊsj^#FÌ/Lê7>òDŒ$ÖìH gùÈ5Õ5|æøÔ°»„GÕötªû•;l*1RÛˆû´`(Ù`‰¦!R#,À/›¾ø–ˆ°³{IYûrµ‹ê-µÜ[á i¾ ±®¾³éòeƒ¨øZ× &ÂcŸ^)ÌV¿°†c±¿¾ÔL}*p"ý$µ©SÔ²fXdÕ÷²§ê2rÅ``G³ ºÔJõuRQíýÛ"_p¹OùS£u,FÁTî]@_©¸¸èûé;•ËÎf“]­l9ô•_$¼ØëE1òÀ§Æí©«h¢ pZÜ@ZIØûzšðñjž.<Ê8ŽšJ‰öbóXŸrË›åx‰ÜÀeéçÖVP‹ð¢«'Ñ“ÁâõžV +w>•6xŸýйaŽ71L LM;GYU‘jû–ï¢aáJÛÍÏ þ°DtËÛãó¾«Lÿ ƒä"·®8Üß®Ï|WÇ=vãuŸ1&äAMvN‘\dëÒk@ª±~†öû 5¬¢býœåGx¹):³{F±±„ñ…e_㢻&mF"rðËîä¢ks°m^ºø&šò¥ÓÌ î‰šéJTýw8ðuCk³›«L˜^“iÏ-™özšbk·N)6/p»É+&*ýT`Æü;*ág>«1ˆQâŒyÏBOôÿËæ¸`hqÃ2zœ\4- oO˶7o݇¸u3o§Ÿ_Ö/up]h€Tôí—³¿«ÃZYµŽ¾LGÒ…ßÉŸÛ™ýu*ž§µB)özÍøHœÒ4Q>/$_Â2 2½ÍÛÒ¬Qý‹>kŒ“9Cmn¹Äþ¹)¸ÎHÿäöê?៿ÄCœendstream endobj 205 0 obj 4727 endobj 209 0 obj <> stream xœÕ[Y“GŽ€·}á/Ìc¡i×}ø Ÿ˜°ÁÇd?K²…µ2–d„þ=_ÖÑ•Õ]=³Zä‡C=Ýuä_fÕþt³<ú¯üûíÍÕ[ŸûÃwϯÄáCüÿÝÕOW2 8”¾½9¼sAø)Õ,•ð‡ëGWbŽÁi#óRÎxË;¯Þú9ºÃõÍÕýéwG1‹hŒ nš' Ó^ë8éãIÎÁèµµaZNa´7F[?ýñxÂŽRÙ8}Ac£óx¼>z;LjÊÂÑF5}LTpÖÔGoF`¬Ñ`–•Ú+[vÐZ»éOiY¦êfÒú¯¯ÿPøÅ7kñ›¥%VÆY¸Ž=Ɔ]i÷¯¯>»2³:¼¼’Æø9¼Va¶‡›+cƒÂ‡òûÉÕ4"Îñॠøp³üÖÊÍ&8§˜-¡ÒêYbG,' ¡7${£ôjú¦ýíQÍÚJ«¦ïi€„Ü”žÓ³ÎGᦧùƒqBM1\Éà‹J ?ëFzý}™tkF¤+çfï:ÒßÊ”2NÛ¬‹ÏsôBÒ¼F¢‹âèpýÃÅñ¤gƒ ex·q³4B–áï’ê2Ò W7·_ÙÌ°ÐPWžÞ;^ÿc½^œ½‚ßzM+gï£oÔ¾”³*„!±œéÝųIÚ@î¿è«þnúªæ*%4ÁÌ5ÿfæê`˜sÃÌ×ÌîîæꢛCÈ:o9} –½RNrëaÅÜRš9Þ-ב"ºHµ0u< é ›}K !jžc´ z¶r2ã‰vbÐf6–ñIñeg°Ò.N®‹@j5ÚWwt<‡Óå„]Á"µfUjUÅ.v©Ì¸»Š½[ܺDõàÔô3e+L0]´1ûú®tõú¿»¾];úŽõÆåE}«6Q\Ôw\ ~}W©õúçú6QÀn:ý‡ÿB߸)_ÿ3%i}œ~¤GŒ¯§'<ë”>Héiâ? ÷ 1|T£·û©|r{º ŸJ‡d?Ïóa¯ÃEK’¯9·œ}Û­VŤf^תª,¹•…Ϊ2KeÆÝ­ŠÜ&lÍêE"W+Ç8ÏèÑÊ%³!{~<ÜØI¥¼·›»ÄŸì„QnnãõRk5ƒp³göæÅ;γ¹Þb‰‹VR%Ù[ Jà(¿ï`%ž6°Ñ"ÄdQ_#‚ŒÓYüýHþ´ëÏC2‘{Ŷ4ÉuD¯‹¼ „Ë©È@ˆ5Èc»¸tºOàþ.EÁ à‰ÏóþVꥉÓ#zixgå´/„Û¦…‚ïV`œw±µwe1¬sâNÀœ1ƒ°M¤í2õ‚–“³D)ö(-¡ ëœê¥me¬¶o£“³W–¶xŒoÉwi¼YKõÐhã’yœ–€¼5Ì"`~°DåQÂÖéA¢,áЂSþh,F?+$«ë#%T$wëY?l¢²Ø3¢²åoGÅ¥BMp¸þøêú·÷k RPaѬu¥êŠ*ŽJ…"S£ì™£\,YgݸX B„m…àœÑÀ UËðJ¡3f8°Ymhqϼj©Ù§-0GìõÜdmZ¡ßc˜`¾C¹cdÛïA.«o•3ûvÙ,æÑíàkqú ­Á ­¤aû@ùÍC>€7²ÁÿÊ5 ŒµüŒVs~ןÐì";\´Í_D{ËéY¶ íY¦»1ÖÇ[%7 ·y6V2Ó=LG@ÖnÑ™3έBm彨ւ’¶èÊm'ǬŽQ©3åñÚ>³=/ÃsœZ­”H:ð‹yÿì;Ði¬ÍE¤IA2q¶D0¬Ú ‰Š*[å;7~Ń|5ój¥Z@ÿ{ÑZKZO³ï…|Ä×®búIW9­§Zò˜Ë°Ûbsà=Ú†ü] Õ˜Î"¹‘£Jðh™|U,ld4ÒÓäl4w줬MÅØèýÚT(%­Ld»^<9¦¥ÔÏÆ2©¾È*ÒÑò†`_ ÀÕà‚%Ä+/ÌÀƒâ° „‰¼VÊ- Æý*‡\p®gµ– b_dÝ°Nû¤f`<ßžª|[ šbæ²,ܬ9¶¹¾â‚%Š´y]T|OågzùÕ´¸yûþd» cé{qJh–(TðLß‹øêƒÍ.ljÂÁ)ÍvRJNû”¹ø þª%‹ÈÖLM˜gåã(ľ/ûø6ve­ä·Ê¬|‰¶‹I_“0´Îy ª]Zç+°©Q˽‹Ëº÷Š†cO™RxíÕwô?:B'¥óL–ÂP‘Bf,Õñ½2?ʲÏ’€…—`!„ U`Y-¯èca…û[|®5° âîNf¯Y¹r·m[iI½â¼/i(ò¶îÕtZXn¬pqïDÙòŒ²82K'c20&/ÙjEKÖúnVN›£¨M€3 òEòÐF_ï’mSf\~Êé=jË`ò§Ô¡€è!˜èš!®QhÑRð)+Eýp];@ÚE³êM½»A³ð’¨ '¥"qψ7ðÕ`âgGP`”ê"bç¯ ú’¨ø^…|fòWX5òqÜÏ/ÔꙌ¼3ÑÛ•ª/Š<â&æ$1“‹p³d¤³™Lè |²Ç¦)¶À權¢Ö÷Ù±”FL¨žÅk¥z>¹Ë¾*|ª=Wß6´ÊB8ƒðVI W`§g™S3ÝÏÙ‘ž¥ –"~ORRÌîú±áA@{_×æÞ’¦é8äÑÇv]6FÅÛ‡–;ܲ´5›éæ’À¨®òBš¦ÚÄ{´BÔ¸é“ô¨‚QÓ§íí—Ëã°¹er£Êjsë–²L÷A³Ñ7š#¶ÕUuu+ÜYk§è¨âåÊ•«k3â™@Ô`Ù™¦P‡ž‹qñ\ƒh&kÃI›’ú±n– d?ê\pà›‹·ÑщTê—Ì«Ã.üS¢$¦®´tTp¢c$*‰—&.NDB«]zšÜ¬´téôhã/'³K'admZ¯ºû/¤«HOòK#|}ì¿¿hß·ï‰s§‘ëNbØYEí„ÂÛÕÆo¹•L);¨—0ìœ$TÜ'*t€8’m1¢]ï¹e‹'UbW¢,=C†×ÏâTÉëЙܣL£ çzO…UÒ€l*êq˜é>câžv›°Z09È°!ÞAÑ) Ð1EK‡² ~ .0Øm“8kž”0Ê(*â;Ÿ®„©AASGt'I©§’å`mà™™ÃÖ²¡E6ò?•`ß_é0²õ‹ û\£#‡® Ê'<6ñ˜Q °[R÷…jd—â9 ¦ö„q¹ŒkÄϋÏ{ Œ 1òl£²{"9BàÅï=$Æß³þÒ å”Ęì®?B`'¯r§YçóaÞ/Æ8öÃÒ¶;¸o™¨ùš´“ˆ°œ«øü-Žhú"hÇ}…–š“ˆ³ÅyI”«ÎsƈÉFȈÁD”ŽßO×l‹•™3§&b„ôžð²ÄCè£[^3ý=x-${ÑÊ"é×Á8t$/æ.]\ægrK}³©þËû7àH½äißʆínÛó/ž™žŒ³u~ìkŒŠÝv\?§• ˜¹]ŠÆZèíâÁ(âTºáļ™Ùöº³P<<ò£å¼KÇÓëôTß_ÌÒ«nFÕow0™‹èÿ€ÖÕ³pª6ç©—ÉïOd‡ÀnÞdÜc5$ðÕ‘Ö°© x3žn<]ïÖ“oo}vz Æl¬^¯¸µ0»ihåÂI†6Áàî1 Ž$^’R¡uöƒÄà¤ãL©Zï^Km#œD•*o©6Ÿ»GÔ òG2éAþ(Åa73¹%ÏGÌ·:Ó¢±aÜëáÓYn“úæ;¹#¢¨túvÅ3¨—„DPÏ ºÐML±\µOiΛ'öXKm|C–’(vÌà¨ç Ö»…P’$ò¡};ÎIÏ-‡«÷÷úT=ÚMáõŽ':®Û9_Ñ×ɧ-n{ÉàTxè߇GòáDgý,ÔWÁ¥Ê‰µ·Ò£ È쬭5>2c\`HPÖꈿ@jÜ´N×(8Õ#xÆØñÓI=+T™çoÍ’äneéŒ?}?ÇâØÚD¹ºì`5 JËCù£zŒ“Ìu]È7¦Q¦O(x+X)Ò™ã]œ·H½|[Þ_hÇ‚]@_)XºÝeÏÝJ@Õô—â vv üãùêK¢GÍ–FÛqóùóâÎt‡gœ˜¬/”,Žâ»€j ¢Ù 3º1{se…0í÷ë_ŠÄ|Äš’!ߊü5ù…–¢õ±VÍ4ÎNÑ/±¾êÑÀq-Ý»â»Ô]±ý˜Á!¹ë^v(KX¡SÄ‘@T9µU;0­9, =ܤ§ñ=áWùÊnׇÀçó·1}FvfõKúp¤-à ,|wÏÕt aóÇõ,í†;ìúey/_ߣNù»¥w‘þ”ni6S;ÛÒ1m áý±ïq»äGv³)^¸êÁ×ØØyíãÜ ÓZöWÅA$Þ€.mÁÎ8?=®Ïí¯{ØmÓù')­Ä ‰wVý]BnýrY'cÜù‹†Ìvn‘0ê‡-hÙ¹Á~Ï£z!»Rü†ÑN‰#äÝêÄz.ÒNK3FHˆrP_­oÓìˆr{¨¹œ6Z’ÐŒ+á®þUÖÏJ»½XG¾Ý³ýÖçÚö—éf"ôp¢¾2Œ#›Þo–5‡óŠo4tÿl°v·ªøv¸)g;7ðåÀk§ølÕòæ~÷—§JòIÑŸjüñ8Šèdë‹I½Ç úlÚ¹ix~nÇ–7ùQšTÑÕ·OÚ[6öÛá[*ŠbDQ”Òb}ûc;$eož=$õ@tô í”Ë?¡ÁÏ®þâ|7'endstream endobj 210 0 obj 3938 endobj 214 0 obj <> stream xœµ[Io7æ¨Ëü…Ì!­ ¯Í}9ä;ë Û8  ™ƒcŲ-±¤$öüù½SÅ¥Y\ºŸk`nó±Éb±ê«µ_ïØÌw ÿ¤Ÿ_=zjwg7Gl÷ü=;z}ÄÄ]úçùÅîñ L‚ÿr>{­ÅîäÅQ|›ï¬ØYmgov'G?NòxÏgg•q“Yÿ}òÏô¾˜¹`ßg³wF*I1Êr¿[Æ„“3WÕ³™yé¥ãÓ·Ç|¶šqúô î&œÑjúúxûp®íô1üÓð¶UZZ7ý¿j>+¡«5çã½òv† '8— ËÔô9.ʹð×ZÌB¨éõ 2=…¹š¥|ÚBJi¦Ïà‘Ÿ˜ £„,ºñ—‘p¡Ld“qYis*†|Šï1'¤$÷æ´²jÖ5§¿:³²ž×ü!ÔO†'+ˆdH=:Šó³2 ¤FÍiË¿D…¼ ¿qDïNNaòíñžÍ‚;ÍÜôŸ¹Å§_€B&á4rú¹®™rjºÁÓÍdüÝÍ(½ SRËéŽú™q»±°Àa›ˆS‚gù¬ q¯M^2e¦ËøÈ•›ž—Ñó2ú{=-¿,#^(=ké]Þî´Hý+¤˜•Žr}Ìá¤^šD¼GÄ,'¾:gzK[2þG¼cx¦Ì¢Ó¯pØÀuðz¿ËÈ.‰óËFçtJ¼®™¦TçKÓfÄ~mD¹7+§¿!Â8Ø圾¬2½ ï3.Ì)eá @V2¨ä ùÒJéóäòÖ°¼g­™þ‚sR¸jnűxV)‚ÃâÖ’Á$gZ/âp{ù¤F3=+€™VöNKWÍ¿‰ÇCª ¬¤òôÍk|TÖi:xvñŽkž¤Ou{Œb%êø"EåײPÔÃ4Nß+®`×ÝžÛY*PÞðÙë’¨ ʲ‚å½'¢8È›éòÜŠê™(åeÄh@Þéçc¼1'M¾qc=3trÙä׈ƒLD–)T"xË¡ŠZ µ~Bõ?`T&Ç—ûä°Yõ¬ 1B"™|‹„gµ)ð@;ÜýÊuOL~'-ç$¢?Bç}Ù½0³Š÷ûP¨,} †«¨·5*£ÊJ9„\m*Èý¸`ç7\¿/£Ëè—e :Ð2;¦'í Â)vpý¶<Ö+ä¹?l‚6˜C«-Ñ}^&E€NÚ®L€Ná"PXñŠ¢ZQ‹W+`GöƒÈ .9AI¢d :Œµ´zS;Á²xîê»$p]hºÁÉ€K’S |£j–^Qçÿ¿åQ‡=V]•³aÕ8%ÑÜÃÎÌ® ž”»š²l÷éZ‹ºq±Pª’z²@` ‡_"й"$߉¬P¨r{ˆù[¬z‰Åóˆd®%€²Q?[‘/°`¢E=Щ(ÍDmz ŽIE9ÒedŠpn(fà ¥AÒ9‚^l8é}Æ}ªcDü+µ ·FÌêb;¨.ÐM6=áM›#˜q¸˜%J a$½W5p%'DFGG2ÆýúÂ(Dtô•ø –&ùè% ouñlëçû¸Šü T/¼ªbôê[XÏ{­ºüEÓ ÉÄí+WtÅäUk×â¶0·ña@s"¤î…› zAžbHª”rå$ ±ÿýF¯eˆ‡Ì“P¯öPà& ìâäç7‘¸O>@gk—¸Ãõeé1oâ†D«C;i‚Üs± %ˆ°µ3rq·êVÑ•ðȵÐ: é%ý¨‚Æ‚j`®g$(ªÒæÂ’nÀ›°35ĵ`çÇ° ®cµóÈʬ¨Éu„W8«Éè B&`E’zI¼ƒÌ¡ 3`åéz•ßR.™Yb€Êõ8‹g³K<Ý„“é23vM»èr§K’©xS‘ÃÑk@î¯lÑŸê?¢±JH{âŸDÄY*° 0¡t›Â=½é¨D¢šI¶#PŸÂ5C Ã×µœmu]ÅÑÈô¹.浘¾ ¹¾øIÐ3Ö~:MâSÓMö·àÍ àîO?M ’öææ“@¼ZôœtÝ&¤È[¿‰¶¤®Ö3¯…¦Ät-—† ”׬F˜WSß;ç âºôú[ÁE0O5Ë….€*ÁMiäðÄ:fŒX¢1Ñ;ÑH&b8 Ãõ` à-;¼j¼£ô0òµ€—%÷Óñ‚É@iµ« \÷Šk€«`¯´Éi”‹Q>+×åñ×*¸\TõË£“÷œ•y}îûÜ#>þ^bâ:÷¨¼Ÿ­ÇDÚ2ú¢Ì}QFç2ú²Œ¾WFUd#­Ã,'¥ŠŒÞv£¸æywZ½ÍÍ›^—'œ>ÅD€ŸäôxäÐs}Ù-?æ?¹Ó߆'%Ô?ŽÞâU¨Í*9ÞÕCSr>Ž’-z"Ç,n¤èUI{ ‘Na¦¾vU&œZìY™{ž„Œ/ÀàhƾŒþ§<‚þ-ϖɃû!‰¢Ç ¸ètž>-£d‰†i§ñÂÛÔ~Q¿êÖÇÇÏîA,!«_G­»Më“!­} ×,Y³¼Ž~8í×ÅÑ{¬»Mö7å±Ï6ËRµË† ýÁûÜã;ò`s·u±îv£ªBà‘€Kí<ï˜gT³S’jòÕðí? dùëç"3o«ÅšÉHP%àG þy%P3¢&Õ˜œ‹F•붣ºArJŨ 5ááÄ›¡¡x6„ùÓ’±&T½¬Î,™ÐtYìç+òµöw%½DÛñ`¤2LÂÂä°YïcêTú™±êß×Y©Ðc$¯bvæ<κŠ2úÒW(+Ñ^“³3ãø•ŒÜçc›”¦«VÌD›?T ¸ÁûÈ©ÍxT{¤—Äüæ)®/ÀÁk%Ì*ÒÓ‚ƒð¯ ¡«ºg›üêóCàÀìY:ô«B¬€»Ê¥„“B6YUØ.âhëß5mÜv¶!òÕc\ß‹w"æꜢ–I§#Õ±tNcŠ¥&¯þ ß×bp}§:@ȳ*ßJ³61/,]w+1{kƹ%’v]½ü5µ,Tc3 „eÆKZ‰ÊétÙÇH+ç}Öï".¬_KmíêJR˜ªW¢ÓK†±b®# cÚBR(' ñªÎ»›‡¨Ñî…—xpª˜ 8Y;HucCV•U‚oÈj¤WØCÕ«®êõ¨ãü¸0€"é†ëÖRƒ3­‡óU)KR÷$ykS}Ù&`>——ªìU΢(5`Ç’ôD£ÙÁµheö* æGwA¬WTIºYh°liŠh œ%Gäàt¢³˜œ Ç„›ôm&Eã™F©ß±Z®¢­œ&nÁ¸§®ÊàЮ]D†ŠlßS5¥Ún¥#UÑ8ÿ¬Uµ¾·’·逊%¥h5‘çŽZZ5‹:C“´+U¶|Uºî jÓd!ãÇ{|A5 O†kz¤aGPy§p=éWàLmº*‹´tä sƒA× ¶ä‡v†–W²§DVîªB›ÇFÁ˜B5­ ]6åLÂ+¦¦MÒ7èÒ–Ì6Ð¥êÉ€K·uµˆpÀѲ5Ôæ4=ŽX»PŠâUÞ{ ‹C\û±¥,ô9°ª¨Û4Æ´‡AÙ î5á@‚ž£‡¯á8¹‰·Œ„”OÈ.Û­ö®äšuiØDj†}м ÄÇÉ¡'Ã,ÌwÃQë}lÁÓa࣎tòÚJÀ‡Q^jdv*èŽf6µbDêÞÆÞ‘Æ”œg+Em-m“$È´÷$?umAŸqGì˜â]¿j DÚ‡ˆµÂ©E‡qóWÚbÉnb†dè®USܶizVVÖr$ø-tÑÓo5ŽxïOy3.}¦RªMGàÈžáBö]¯1Öܯ ‰«mÜ]ã¯8œÑ’{¨³0—ð0î‚hÔ0s·æ@¥ä¬A|[ŒÙ¨¼¥f!·jÄH„ežl)z/©ôûöp:ü n;5H£6Uj^çÄ îi@ù¸ð*~´ ™É^Dj÷V`MŒäƒjj–EäŠÚNäÐ*f.°(“e¼K<šÒ+-àÔìe"§+²è.2!‰¾­8­e»;vp‘ë mÞépu˜Õ¢„ª@xŽ¹]4ëÚ³QÑ¡y¥M¼c×=„ DgóN#)ÊÙµ ÈÆWàXΩH1éÅ’§ÅÀ®¸y•Ao¦DOµ4ý~P{Hßc½ 9g›äbxÌp³µÞý&ú)@,D¾9¦w›HäéÃá „€GëÊ›@ãm’J7J†{äs¥ËóOü•‡lOסY'D*mïvªÃà ž0Zg}*uëýRçð+¬Ð*l½]ko?èŒ&—oµ½ý¯©²gK®•ôôý©¶“GIÙy\(Z)ù^·¢C‹¤ú»&QÜ‚«ãˆb¤7U,M¬¨±D+­—wé÷ $Áa®¼(ëƒ|Ÿ°za¸a$] Ð´èµ ^–Á÷Ë#_~7e0]ox~¶L¸.ƒgËà yëÀåbZÄÀ Í7á›%­ Êò1‹Ÿf2ÖžAá«Œa]ûDùcäl´©ìÙ]ÊO˜êÁOÝJ‹r€€‡òTΙq­%Ì¡ _V³r+Ɇçq+ÃÅÿ×ÜÀC¨ºP¢ó¯‡øPÐfX´T¥Åó€-ƼŠ÷‚øxµµm:[†’éPr8Å¿²µîøC†½ÊÒqv°×†—G¶I§”ÅஙΘŸ¤.ß¡Œ1‹Å‚5iŠím||­ï_ *=¡©†Ö½”ÝMÜ·Ýÿí…'Å…œÕ+y‹Ê%Í߈өuU<7MV™‘ÜÛÚY¥Z躕U"4  )ÝvËrrô/øó?]%endstream endobj 215 0 obj 3829 endobj 219 0 obj <> stream xœµ\[Å–ÂÛþŠó–³‘ϸ‘¢D„Y‘ˆÇ7¼v—‹óëSÕת™îÙcœ!ÏÎôtWWW}uóýA,ò ð¿òï“닇üáÅí…8üþqñý…LåŸ'ׇß]Á øSªE*áWÏ/ăÓFæ©œñ2Ú=¯Þú%ºÃÕõÅ—Ç÷/Å"¢1&¸ãry‚aÚkæò$—à xÛÚ°-‚ÑÞmýñãˬ(•ôî^Jí•-wµÖ®.mTÇpbœ5ô½¿ãÒ&jé-ŒövÑNÅÉlŸà ÑÀf+Òú\ý¹ðžY«™‹ò`e\„cÛÖ}{¾]â'c<>i·ÄÃÕSÛ9¾Æ±(ÖÇ;¤XIc8>ƒ^/Aªz;XŽ_㵄™…:>î Þáh·(§éÝW8Xç£pø‡òr‘ÇÛKµe…>þ€ °Âsü×%SVÜ\Ê°8á"¥ŒŒ¤Ô¼¤ |KH{kÀ`µ“ zqpÒ…vë£òÇÌ ëlÝ40 Î¶|VAZY‰y DËP6ç„et’ nðÒ”±ÁN¬wѱµ_àÜ …ãOÀ„‚V«áƒóÁW³øEÅw'HP’‚ç¸ó¨…qåR£†R§]_z€  E¢÷YæE€Ëç—rñpÏ•ã“ØRö¦mÇ'À, §ÚXáŒs|oE¤á'R9®õù§„dëpªñ(½w#¦Iåë8ÓS•Êyf¢X_[0ª‹Œæ<ŠNF…ÅNÒ/ÚÀœiÆ"ŠQzUg÷Z€¾>ÍpäÛO;2eôAJ,‘Q/F-{žï¦:Ÿ^ ‹5†éÛVCY] pU1n°— òg³€`ºí ‘w›WђˆïÒÆLô±«!n6úê3é,t*gòÚ:2NG³3«4iu6°íP™Ó€^DKÄ"åL†Ë&éó€äù|Èâ¢ÆðÅJ£`›*¡L@­ ×ÃmmaŠ=˜¾‘щÊQfƒ-d[ÛX&-Øí÷P`´þl¶ô"˜Ë”¨ÉŽ*v ÿCÀ\ë\Ò´ÂT5ˆ‘YCÌO±^@m9°éÝd2äO5¯kÁ¯ð@•óžŸ3•`-`þ•5»W»ºI=3v>ñ4V¬t`ó„hC’\7Y›øÞâÜα¹Ó1D¡=·ƒÀ3ëc¶€:^Tn[Cu›+sÝ °˜À™#³ÅIÌ2£7{É9\Ã#ˆ/`ƒ¼_I³t‚¸¹ªUŒBÓ*&¤*ºE‹x®`* åâŽ( pÇ߃àik“ãV Gq5|°ŒÞ,¢`ì]šÑ‘ùþ˜$“Œ˜7‰+>d#x*›O–JÇyPOG1 èœý&ͨRy®a§/ú]ܨ'œ ùÑï@B ߶8ZW© Bå K¥üu›#Àéë^(w8•ÇÕº­0À:” ÑS|ˆP†ñŸˆÎlÀ Pæ<D§ù&Ï.$ÓÝïpF´²ãš/?TôG7y ðtÊ )MÀêÍ¥1ÙCd¡À±hô|®>º¸úÍ—‡”ì8$bÂ!í Ärêøa?éñ®_ 7ñ©‘V ¤Ÿs©Ñ6{íÀ™ˆÜâªa×ñ)’%Mg@ÚÌÒD‹GE4æÂ_ºZ¬f*H≊[¿åœÝ¸ó¨ºóIwÊÝ›áåÒÇ>íw÷Ë»v9òs-¶h({x°G±%b?x‘AHþ¶]úÝ=êg‘׈P?Qšr¼Ê ãe–Ýè i%;tyÓž_÷›¶ÝÜKº|Üžß³¯Äè¶/˜ÌY½€3PÔQ þš8YÛxC:¹Âñ­óÞOEªÞ[N&5b{WÅkt|¨½&`ÎtŒ,¸ c w2&8M¼È“ƒ2í¸ä²Áê&ª¿Ð(ë'ï{@õâÀƒv3PEÛ)kÞ”…¥ž9(‰ãZŒ ŽaÀÂÀy™° ? .DxÚu¥’Ãã %Ä®G©8»–9D÷±†\Â*ŠÜñÊ&¾¨K4µ=Røºn©šüh=ñ|Æ&¿ÌiÂ…J£®î»rF'À^+±DÚ8W¢¯Ž5Fa È“ÒMñ1]¾î—ßõËgk|ÔÒ„6tXc˜c^Ҋθ æIãœNX{€ãxwƒãgÒ¹‘i ÎôØi¢úrŸÅíКe¾½„Å/7ÁË~w´' {"¸üÕ%ˆÙÎÙÁ“­7ŽˆÂxD†Ì9¼Á8A xðCçÁ«~÷ÕûØ둬] ½ˆÙÁ£+Pâà¶!6j`9jˆ±!6 oat3€3ùÅ%›¥yŽjÀy‹p?Ø 7c°:å»Qå•Wge%©ÁÅ=‰uÚJÄkt6sj€dêa¦¼. ’»Ñ¸oAÆx" º¿4j*.mŠ´Ó8‚²ŒM\ W;2W÷ÏWÔSŽÒŠ¥‡7eO0UEÅZàžöÏÏ’ïdXfÂêº:ô%î7Õ5šäZ<#©5œØõU†?‡­N³—ÞÛÇûo 3n랟.À0„Gx³ ÷Ö d†jð*â»è¥ž =sfŠ †v1° OFU³<+’¤W±á+7Šåb¡¤Ë kÀÀUL®9é4Yõ=VRJ =R˜Û¦u’~ w¯°y &Y{ x<Â…MÀ¸`ô0»Íêî›Æë«¢FQ`ä"…_Ûx$ëÀÓªW¯¦²c ÒßSõíì¼ËfÝá‘vªìN¦¯æÀHÒ¶ç°@%1ì,ýc:÷m6ÝÀ®­3Á*)„‘›Xyš[.hê´ Õz aªõ$î/±Pœ¥Ú`º.Ñé² E“ XšM=Ķö§“J±†¹¯ÀÌRœˆHÁ§°zÝyñØ9}ÿÛdù$AÀC]C„¡ýÇ^G̵ía3Ë\­´”اÙç9ŸŽŒŠ#‡1OœAÀ`xGú‰`¢eUÅæFîr¯ƒ–´ó ²Ùó†¢m.¨ê:nݪ‰ýe8c\<Ä »µ»—ý&©:¾¬Ï§ñë É9¶ÞûZÙ›«ÊLMòÌOü»–óÄ$OìlÍA™Q'Î@Tœ xÃ]‹±æ6/Ñà$–&A„Sa0Ú?&¿«ê xz>ð½ñ,ÚÄ—Ë»Zåêÿ¸Ù§Ën(òœx¯=ç56{³~½NhªÍ‚Ù)A X³k£RF,fR:á’*nï„2¥[b½}¯d£uôLÂ{ÔÊRzܽEòUXkFNnÛã(#9I¬9eyí>˦Ó/sî¼èñ%7ùÍÌtO|oÃOB-ù(£>ÐâM’kå£G§FÍ@µÆ¼OÌN´w•§î5Eºä%x7ë8,ÙÏ„×ÞX*ïùëýƒ¯ó€`í ¥œvjôšOã“VR¢*}žðZŠõ³n=*Œ`Ê}®mÒB»ëZÂÉêh.§^ŒLσÌûòD[Á_ëÙu> –±„.˜ðêÏ‹¿gÁ»¢Y§%ó×û_Ú;kjïloSÿ#LÇäDÿÔ$oÐ4W{ב ‚y"Ýùû9Ó-±e"™êÿ51¤Í¶³ªÕ]Þ¤˜g~7ñO::}nòŠ–\†8«Ò4aýH·ÔŸ" “„i/‘‘MÎ>¡¶ÝËSJ¥Î¸_¦÷KqÌÁ ñé4lÛIGõЗ¨Ü¾öHÜñ¤ò±¹‘‘ç¦5+•rëÖH”,§Ž÷´ŒlBóu©ï TíÅ’p¹éÁ’©5ïng &™CÜ„=o=è«ŽíT[>Ç 2 $väÆn$çµÂ’èȨ«¤`2Fäªè˜©`¥ÇIÄÝü2SæQŽ.ß)íYuf½g%í!̤©šŸ´&z›|°W°ÌªYgúƒ B8/äCR$Ö;OA„Ój ÙÈW3E˜ƒÈÞ*9 榟€õœÏ=¡,‡¿úöäyÉ{y5Së´!À0ö[fm^…qóÞ ®f¥orø¥Y„ˆ°·Ü6ÒçEº¿^ö®ª>v’jÖvÔuˆjìDí‘¡Æ>±@\™ú·t²Um愨èœ0Ïd+n½ëˆôÅéž(·^ R4é3±×8L)ßÓ´FÚè~îwïéêÒ½xk†™­ëÛjÛöYŽr¬ás1Î?@â5~€3v@’—=D·MéqÛNFßK2ûv9Ó˜"Ø#pØH›¿îpƒÌ’1ÎjóÌP¾n¤VqÒé8æï2€XÕ Ù”ÁÔý†ˆ ³ °õ øMN|G9×r 1L­ÏXE—>}I6òo úã½çì“ Í+_}&"f=½Ì_•ÄH¥{œš6{O\J<:L„I9A¥û¾¹™Îª½-%aGiÎ8­òÝÃ|ý&o]!g(Õ?‘y&³ŽÐ .E¿Šgr]oÖOóM ­H4ѹ)ƒ•ÈÑÑ‚)ÓqF©ÐÇýpÃÄöM–½¨qˆAì ¹Üë’Kºãí6<€óÿñ 0ÔË-"K¥–+')Ç,è»U5®0ôºm¥|Í6nl$ý08›dIJ^áÇx H/sk2dšM&.Ùçg>P Ö4Wb_;X{,r–!o mv\ÀQÐø!dE©'—«îâd¡y'²½Q?~ßïÞmü]¿KÓŸõ»d5ˆNÚíqK8™‚¼÷c¿¼écS%vîSœÚα30ï|ÒÆÂ@ªýà…ŸF‚«g`^Ã&þíDšušJLµ4•zŠH¸GÖ}‹¯rZ2'4v¢ØS¨¸Ë…'ü[AWu17ù Ù½[Ô©.øVüb{”¶û7~ÞOˆT42Í3­•´ûàíÚXšƒß™C4 ¤Í?(k¹as(î´*·ù’RƒeÒr­:]2æiþB‘=6KÊ‹}nQo•«x+ãΕAÝ~ëýoòG¤gŒØüTIo“ ø-òίò4³ÊGáþøA×ãG°¼a¢L¿…1;IVË™qÖ#Ÿ¼µñ©>¸ºøô‹¢?]x gŒYôáúBYëê_¯.>›þ 4ý:8úH¡|y €0†?‚Ðsõl˜r&7Y[½,…(¦È²@‚(oLö^âb¤;~;ñ‰ûïc£rtK¤ãa*ÿy &>Ǻ¶Ç¿¯€%¦ý,Çw!²RŒ.ƒRŠÚѯûÝǘ+×Yá9.…ð›!#3ágI©+´Ž| B DÅãX”‰ò R]&צ˜î˜ü™Bˆ¬Ä\ö{Y}dìfß‘ ûÂí…L¸¦ä!(•]¬ ¦?-­ìJÓ³ÁTlþÒ£Ëd-À›ú ]¥Hˆñ‡vï“võq»ú¨]}Q¯šY¥Â`2 ´@«n¬1×í°UÒQ®±¾c¸„È?…¬¤ ½á!°DEr¸éuÑz¤¥´@«Iî~[òRS®O/þ ‘==endstream endobj 220 0 obj 4769 endobj 228 0 obj <> stream xœÕ[Yo$·’7ý ½y&Øió> äÁØp.GIJ^»ˆŽõj}èßç+Íb7{$%ñC`ÛáEÖýU‘úþTLòTÐåßW7'~íO¯îOÄéçøßÕÉ÷'2M8-ÿ¼º9ýÝ&áÿJ9EkÕéÙåI^-O½:õÖOўݜü}§÷9o\Ø…ùóg_–õj’JxZ/¦œ62Å/ãé<¦‚ž¤é¼“ˆ:ê wÞËÉ[!ùק´› ΚÝ÷ì#¥õ»Oð;>v_`µ7Vû°û~µr2Êv4§ýÁD?aÂÍ•Ê ³û=•REGô•U“Rf÷'Œì¾Æ\+œ1±l¡µv»Ïñ)!'¡ø(;ßø«|pe\SIÙØ€9@>£u"(­Ùç³%m¼™l/é?ìÕd|”½|Øé¿aÃN ‚| eN¥Ÿ”ý…Á(19Óô꣈^“ p.í½•;»?Ä&g-ô!'-C»×ûĦw»‹¬ >åä4ôŽ¶×ÆCCìóŽ>ÎÓ¨2a üçyõÛL[غ,ñ‰ïéÓ¥¿ÉŸÊÙÝí¼êŠˆÛÉÆ°»§{#ãî¡‘jƒŒÒ¼û ¤ œÒ64Ñìì’è0AZ_œý¦úòPcX e³·Y»aIr„¬†ÙBÒ°_áv?Ò WX:CZè”» ml4P&ŸRÖÐ ›ýÓL¯Y]³\'_Ï\F‹¬ô,$%zèCú,sa4ŽyI£Ò$)œA+H÷y¡m¡Jb' 9—- ]Ó:õGð}O õäVûÅIŸ¹ß›LÉ£ÞçÍbÎÛdð‘ïø þ£­@HøW;ûýª9îE>è&iÂƵ u®rfÞL÷‡»£a?#F¬œÒz“†É]ñM¶d ƒð¢´Ÿœƒ[žÃßíá®NÙì^Œvp .8’Býz™8Tµßa Úƒm^Y,¼Ùv p’º'“K1 7ß ¡ü*É% íg>²Wh?²y¿…JaEÆ¢g e¼Ë2ƒ¶ª(q®ê9íÚIpÖ³âzþŒÞJ¸E9†–ÿÎ6lg«jÉë§9¸¤õL[GËÌ{ïÚ2’.è"æ¨Ó4§5Äš„Z$•´’-W ©ø6ßíS¤ ¦¹ ì¼–büúHÉðÀ‰¶f’•Mà|L"®óÆw´©5Æü»š/_K¯,"¢ € sÅ[æ£W´ .$üC³„6ØóSlêË‚±ÑØ™îiƒ0Eì[¤7óÇm¦dµäó˜Ýt,\s“{O[8äc3äÛ§˜¿Láñ³ ßúçúöjGQ…ÌHK;)«S® ëLÑ:[AÀèL·è6§ö;´9AÑ´ÀjNhÅŒù'–˜?ýš$¤¥ÀNã`yŸIÈ8KÈáˆÿ¾šƒ›’|¦rÛ;Í8“”8Ô*ü¹ßf…ÈäH®Ò£g]gÎäê^2Ÿ¸ÎFdì"S‘Xí/XÛ6sPò%nJ}–LûAc-}½fsç㮲ÛÊüxgB%Ãú"ñׄJ²XÑe!”“:o¿äÃ^Š=³ö„²²Ù¢<&ÌÜ‘ïAè\Ã4u–º¬Î¢€•Ç®’Í^÷¹Œíu“Ôa;%8@<Ûwí!µ¡“B'ô-ÀóI`PrvÊNÖúu¼ …Ùi×Éeg3óÕ Sv!_¿ö /s/ ܺpªÆÙã ÇjMo ;Å&Èzëß¡¹Nîy‚´ª÷«UìÍÛm$¼ÎÓŠ P>v~Dr•±MR,¦Ê—´€:xnbÞÎmå"ï 5š-ÖÍþIJ*çg|ÀEdÂf8WðO6ãE.$+&(iwßîRÐWÚÍΣ1Þ“¤¸ÙI¤‹ð\W¢Íé×%Ò°7æLmݯHCÊ9ß³ß&œ( «ZJë&h…á-€6Tçë !jÒ¤èƉGü¶j`¶Ù´™QÝæg›³Í9¤î˜Ñ Íܦ¹Ò}#o"—–ÙT\cûÛ}‰nQ¯m .¹VŒìr¶,&Cf +dEGòvAcïð+€ÏÓ&³,#Cp¤]ë·Qø­¨ ÉXÆ­ªç!e#CwÊštô\©µ€±f8«û:‚2/€`Hém ‡Ì[|OZ¨ã _Ê€n‹+,G¬sg¢ñ¾°çÂÚßb°Ì÷äZ"F@ã5^ç«Ùåæ ôŽ´JîTÆp÷(ÖÜ GEžqX8~JXUÕäÌ®%6ê>£[½ûIrmL1C!+hà“9´’f TÀt7»b.×qÊœüóÑKñ-sØW@F"é¦úÊë~*¶W z¹,Þ©òÿ‰~§HVPG^ÕºW£Á¼“É‹DÝTær=^ ê]Û膉—3÷×™@0†êÇ«4únn9ä’/O`§ndH*ŠäÆZMæ÷èýÑ>†Òv’©©šôÚƒV%aÖ-{6uÆ[šO@€ìQ^Rw‹²ƒ.x³že¦q¢õ†ÎEbÂùå`!ojTmìEv«¢Ï>K‡ ÔX«#OM,„6W:óßö¼ì¢9Z€)¸ ê?Yk‘vÉ¡Z06'ŽÂ¨d¼ãï@£Bé6Šòõ0T¬¡žüv™Ï3Ǻá9h/ÔJ)J†:ó‰HœÜ/#*-„Œ†UýíH혛ÍL­a¿z Ý hè zè0cÖŽî+˜œò"ª ú™‰¢BÅûtw·O¹B™cÝ´Ù&X"Ù6¡Hí'[M>75¿th¢8æÊ}r#^ÉOTr Y7ØrߎnC7ô4-Ã4ÍåÜ°áŒe·;cÇE1‚|‹‘ï0œº>·å¾ÅPÝ”15ÌöH÷ÌÐåÅÀÑÇÝ[`+×sãàV‹&^šìûÆÀÒ:̹Æ]Ùá^)aoó"ßB4=²YÒªO=™Í–dö Ñω%»1¯o\³˜ÆTPè’Šú<ãB6Ò­ËTRÌ¢LMrÔsà¶Î,Ž:“¶Ž†ÓÝ,¯ÍU2“U0ã3oÐT»Aû†­¼Ç·ÒÉݸz=v‹QàFÕ[&‘»ruÂë6¡‚ÓŠ{Hò46 _†=Ý›ÕKÃTäsjº6¤Ojü÷WpŽ²n¾…+7ä>W6%²Ï»BÙè}õìÇnù>Î:¯fåY·;õˆ/&æMXW¢ÿEm«Ýd–Ýóûœâ‚ ]ŠÙ\W^æÌÒÙCwWÁÏ1¸™êR“¡þ­ìüy W8­´íÁŠN7£¥âyNrvóæQ㽪‘¬—Ú… º¯äk*_D«Ç¸ÓZM‚-éÝÐO­¢-1òJ\ôl ¶Þm˜D¤q¦mÒÉþÈìÞ®)ɧjƒ(gùÌr_®£TßBmnðP M\ݯQ—©ô½•ž„“å>•H×U<^åv9¾VS*]7ïé6WR?@e¼÷,#±u;ÙR/\xVeÆ";2ûä œê÷ßîçíÈèqˆ#6T÷틇Ṳ̂öÏô„Â$]6s…Y\6×‘;¢{eÉßgäuÖ| ŽO| ©h :¹6GëšH‹ÎиìLìx½á]sû”8îKÈUYeÜ}X2ZßVÆÔV©êìšÁX¾Gá©]Yƒ_Ÿ<‰kóäŒbšžœåÞ7 /‹F”å:¿¯z길kËÞ·eçK†ÒÆ&£{;œ{Þ$}9Üí]ÝÍsæ CùÕF¼®´ÒûÌ::ÍSÛàðµr£ºšK¾~@Æ´]p~ªs{ßµéÛIÚñ€ºÇËVÑ\ç&%–¯(žô¾çQ‹èGšPˆW«2ž s:(6·ËFƒC¸é+ï9ö±ÈvÛÅs½O˜•}ȧãèÜsH éG{˜æcÖkz#ä»ÇÓUüƒ‹6@>}΋Äd¾ 'ƒìÊõe|¹hk [â$RpÿËõFqÞYªVf,ö¦s¿ì#ñµÝ-k²Ù4ùHÛР®õO¹«æêBÿ° /ŸsÖT¬òížH¬ýב~c¯=?|,‚³ÑëU§Ñ«.¦òä˜GG"GvÑLSS~@¯Ó¾ žmj„Á÷˜¬®u-¶þígê‰ùÝóõƒi¶'ÛçŒDY£qÑ¥† öG½àLXEÒ=ð©o¸[W|ÔËèÃŽû¼ý#üªØm¼¾çs·‹†úè{ë9ñ°ÇÍz¡Ôn>u>úB“¯š€•Ô]~0@µý‘¿×I¯²e‡Ýf{^öU±¹#¶Ýñ‡Õ}Æ]÷A¼T:pWo}€ä6Ò¸E»›¹ …±@Û;~ðÄÿ¬RuŽ1zÖ[âˆ.=ÿ%}úöì`î‰MhåYøE‡µ2t™4ÊDãôS^’' Ê®ÓNãëgœçõZo>¹T“tdW©&PŸF±‚kø¹ûÓ%Øññ÷$IÝ$Í«µ¦¢»µ¸ÿ£+ ¤lÓ—`ÔÏ©Œ@ŽP¹'¨×mY5•KÆ Í" 7ÚíæÛÍõ«‡'iÊ|zvòü÷oƒ§•¤endstream endobj 229 0 obj 4176 endobj 233 0 obj <> stream xœµ\YoÇ~ׯàã2G}~sÃqÓ!qÈE ¦D[dl ùó©êcºªåR²!õöôQ]ÇWGÏgb“gÿ”_¼yòìkv}÷Dœ} ¯ŸüøD¦gåŸoÎ~{ à¿RmR vùê‰ØbpÚÈ<”3^Ƴ½Í«3oýÝÙå›'ÿ:|~.61Á¶ó 覽Öñ`Ï/ä¼q›­ ›Ðòp ½½Ô^ÙÃﱃ”2šÃçÊøMFrSÁYsøúZጉåÑø þØx¡¬ØŒö´+à¯çróVHYß‚íAWm7§e]‹ò¾ÂGcµ‡?è¸,ë_â²ìæƒ<ü= à‚S‡â&M42:ÚLF#KøÓ¹Ú ¬Áýûò…Ìð‚µ ÉœIžY7áUu£^ÜóFÑ1. ^¾Ðn‹g—/áÝW¸ƒ¨…qôñª=¾›>nùQšpxÙZŸ·Öû½u¶k7n)-â)têð3P%„ U8|‡t“°¡¯ñY ¬ô‡@#m¥UØE pÇóF€›ÜÙù(Üá Ç®·ÐÙÃÞCàý%óä¡°Å íò_<+˜QXÜj=«+è¬d 0Œ6'Óž4+ö X§t¢¦×[€Ç·¤™¬úMz3iåÞæ»ÅÂHXŽ›>e’wç2l6jG Û C̨Áƃæ¾òÄov^ÚûOÎ ‰ºŸ—ª pƹù\¡¯÷‰ë$ˆE°y_NøûB®ÒZoºqÑ»|ÆN‚ì;-ÀcËR¡Ålô679pàx=°S( fG™­ª—s¡ äÙ…ô0¥PyY䘑vÆÔ•T,+€ãÞ—àbÝ€¶:mËK.dXdA'.}¯IJ;ƒ¼qä˜LkëÎáè’TƒŠQvÆpiWyVëú)«A 'Ë"30– ]¾=ßM“¹*]3%&‰€¶åÐ_÷JK£ˆ¦šiË’1’!ÚÌ;-åT4ƒ7zI‹mÅ(—F*X”ž{$·ƒgo)M>$Sw`búHLibD%€_ÌÙlTç=~ŽÂ'ÐúÕjÓƒ8)üð<ØòÈÛxkv,@4@ºu´+hF»‚­ÇOK›MêêÀDé°êØ4©=43î  j¬k‡0 ¢JÞ%3¼ÙmBŸœ#!bgF±CÔ‹s"seãkä¶uP~•!ZA&Y³×!îó‘«ÐÛœ`6=c”ôþM±Z#¢ï‰Xî]>§YêèØ0ëV¡U§TdVä67 °JßfÛ @ŒÊ4WÙH£ø!©t=]J¡J VïÂ*­ŽlŽ™YHâf¤šgµœš¦¬Ò¼F´.ÒÙ’µ®³ ;c¾¬ð6.yw¥°fÝ!²€N¶±8·ðmÐŽjøåq›½(»QΥ蛑 ½•xÀ‘¢`ŠÊÊ-˜׶§—Û>.Õ.àšNÀÒT—)‚Yª²dbˆ*{߉9ºßûNµ"ð2A§¾Ÿ}­ Cí(ȨÎuÜìÎ_ÿ8ɳä “ŽÍ8铆B’{Ü‚¤3k×s¸Î€@îêáNeÜÀÍûã“Ëßd+Ð=€•"jx4ùè½6ó U×ÙÀ 'k5ì4!<»` çí"[À±„³ë{Й  <1k63ɯyç“Æá ùz²Thê,(A¦*ÿ1j0€Þ¼7½6 vŠÑ™©áçJ· ìâ÷9øÙçêlBR¿à¥ÚÍÉXT£ÎHj-÷C}Ps(ÐÀ¼ÅE7 ýT[ßP5þ!ãf¡jsV(dš6t¯7PÉ'~.qºÊ h‹Â9AÒs±»‰ “Ý„Bî&Ì”=š3~ Œ4.óùyò6´T³!bH‡%CõØVG¹9eFuû«] ,œŒ;ÿû2˜[¹ì4_á–@Ru§Ñš¤Âï˜ñ•¥_Û<¿Þ"@xÀWЂãq™c ×,4è­ÔKmGÂõÄÔ(å™»ßìÑ5‚dœã{9ãN²Zs·Eu=)ëìD›+9à‚äçºóþ̼[â½oFõ&›O•q`i¼ëá÷©Iµ›é|º¼BùŒ×8¸¯­ä‰- PѾQzÅž‰ ªò¥)¸b8jpÛq’ïw =uƒ…Ýüî?›º[¹ü0s·¨Ëü¢µ¶Áfdc¤HàÎh@ãî#‚A:º$sƒµEŠj XÎÈÐEb¯:BgèA\ågIÂ]î°ƒÞ4púÉP;©0 A{ogpÊ¥ aHè•Ñ cžÙD{椥Iì@=sÛ‚q©è|‡P´=PGa0Fz IíתŽØ=Ú‡I:§"Xh ¯él[QâfÇ'*ŽÂ„žÒJ˜š-ê\¥q©OÚ/Œùª±ùòéø0¤ “5SÀ½@ïÓÐ¥Ö›1±G—i0õk¢KÐÌMPˆ$m!<Âô.oV³ !.M›pÒ²÷à¦!y:ı²h3˜ú<Û3çÄœÍ_š©Z§µ[Ö#°dÊ2Ãzx¦h‡#XUŒÁœ‚ _|\Ð9½`eሕ&¦ô"Ó‡›®Â¥û ”Ú…¥daå!(Ñã&檕€YÁ™²t6ÙbtóàßÏÓDÑ»A‡BëÔîບâ|F{ÝíÜi`Š(0`¸¯òlx~³ŒP†ËÀ— 1F œÛÎo›˜œ ãÅ‚.pÙ{zwÙ´B@`å@+ª%8eúPºO|†‡£^…{zD-kA`sg? æa'ƒÓœ0Ûƒ©™È6µ¢4²WíiMš)×Û5 —Ic?b:ƒ.µˆ¥ ò {ŸƒÉ(w„1‰ÉL™G¼·6e$Ê‚Ü3_˜òâÜ"4¶~™ÅA 2õ3wÜN¿Ì~Ý”f8·>°M':ð7ã` {ˆNr¯+éÝ›ÆÏ·­õd· ud¤ÁL@X¼¦Õ£—>ùÊeKAB±}3bŽ´yù õV ¤X}6ºàó¸ÐZb`»?€áÔ$æÑÒkˆ’Yìæ$s…;†SÅñ±‰Þ=.´¬‚¸®èG>”j«'˜6¦©¶]æyáܾøA Å=µ/ƒGGTF9}ðëeÌ4™Ò¯®‡LéPƒWÙÎ#=dYÜÎe „Ú¶%¦ 1wF“ª­og³ Ÿz«”ßî¿?ŸDk‹æ³¾¼8ÖX¥gnæK«ÎS›Gq9 cÑDÃu¶±T‰)i™i|MEŽTHüˆdù›I3ˆ¬1eÀq\æžÅC…kÑ£Æßk-à?Àô‹¨Y!Á”OŒXz!Sú}šs™RO-í2‡Õ4êSRø¥gžÂí±g_8ídGZ]Æ‚y1èhr¬d«Ù£d¥Ä­‚* 8Z´‚–ÄîyI‘6)ðqjŠYSNNÚYc}ªÙ‰¤ôñ#\‹¶kBâ˜]0.¥ƒ¿ÂG›bDcÜ–á„9’%À!LìÀÛZ‹½îgx lTòÉ4¥ôeUÜÍ܉û¸L†5lÜ,¶\S2"X!`#±;¸™¡ž £j܃åÉhÆ‹àÊt²ÑРãàp!Ê¢Sƒp5t…CkÚZ†# âÊäk¬ÐLÚ}ʘÀkÕ€\×WT½¯;~§¾Taçà]'X$Þ:k  è/Ýg Æ KËŠui¹¤0—üÀ΂TTqõN[ʉ{íÅƧä¨öJø(mmœåýQ뮜–=‹õ“©KHר Í€ Ój’`aŠ$ ³ÙÆÍgÈåPíraé"”ü*CÆÍ… ÉÔr]¶”½ýU}ä…ï› Ed¯çìBÃÂlEA¯™­·"„Ã7x–f F•’5ü–:ؽ¦;\·­;•æ è <#[«¨SÀtçõ™å“ž ¾âuæÑ징´ÑÚ§¡u~:ËÕŒµ‰}ß÷lÏõñië;ï€D9’º0:Ç5ñ<5VPN*&R N‹¿÷8)é¾L•(0‹jH^ÄMšù¸U–qvU{ï“;‡Êße̹‹lš$½O—–mVš«®:hy‚K·¯çiž7è’Vï,££×y´Ž×î'2SüÚÌY‹„Xs%ªàªåú/®@»©ë6O66 ¿óßCãÐa÷è‡@Á ñò'Ì„ IæÅÿ“Eæqdõ3-¸£8ñ­G‘_W°¹¶õˆ³‚òCÊ«VRƒ<-¡Y@„›<‚PWõVe$U½ù_1/¹g-ÌZÐTûcá`®ÝøTv–·SJáà€‘dÈ«7BÎãM×½-•Ó)Y‚È®ÖÕøv³dr¡†`y¢úR£Шní2´‚Ô±r$|†4ŽÂ~`’ׂ&”ëz”˜ÓÏÊûöú˜¼w.<'ÞWŠ:Èó>eÞõñd׫¾óYö¤[‰lÛÞ¦WJ*±ê/+"‰4j–Öèüf¦5Êzž%ÙÆ2sÚáiV, q·¾ä¾¾iAßñTkUm0×Z-Cû¹äÍž“z¸Ó’­Hqð†ÍúžFpÈ{º½Zëg…0Z-R¿äŽàÍ0X+OJûþ¬­fØZw¹çèÖRßk¶È4.¨Š96%ƒ‘WýÒ{Kˆ~ß/§Ï©)@ã¬Ðqº[zf1Àß0..QÜ«~ éñ~ÿìç?{ãÿ²Jó–„­uÜöŽ­±xá¦*‚ݧHû¦ð8ÚA‹L„WW±Îñåpj… '­÷ø§`êZdÅ}¤u°MEa,Š˜™C LBèáu4 ªŸœB…Ź“Š”XÑa¨‘cQ™®st0¸7à‰F'U¡¯â¦œHû£D’ Òxá‹Péñ—R#Þ{ò³ˆ£IEÌùª))KªÄrN“ ’!jÂÓa‹Àˆ‹\ѬÌ|98© w_óÑÚؼÑÓJÓÉý E„«±&9.8* hªÏÀ K·{GŠ ËèJ5´œõJàÙÓr·;ýÔöž´3̾ϻ<§g¬ñªïx×ô»Ï·r²¬Þî¬S®ò¨€%ƽÿt¨ÏiÄ ˆë‡ÚªîÚûÅGÌ@~Uß)WŽ´e[•’T¿¾Çæ nÚãm{¼›=N³G’]ü.®†”eWÅþÅZâBm9Hã,iVø Ó®ÎErþÄ1j=[.}ueùæAû®îp§´K< sL}j¥’Žr0}‡#7Jë#" £Ð‘9¹¨3½¸ôà]T­ð3‰zX|"œ:’qa1Žä¿@@€gwä:jöÜ4V ×…±ôÒÄIšY’°™‚ïò®:¬-ÍE+\M…žÑ.ªJ/Øgò†¹¿vâA¿DPK$K#4WH™á6x* \»&–øi9‰6¡€˘§úH5ÞWÅš ×IKùfÅ,1?\…;íR¾Oà`ù!¼­0Io©„R¯dç7{YeiT,´A%ï³Æ”ª¿KûçIµÍ’D¿–™šöËÉE@­»µ_ÉV^+ü”G»¤Ýupð‚´ *z¶ÀÅuQŠ…|Tj«°YžTð5””äÝžTSBOKË.þekªa]¤®îÁ*¼o­Ü@Ѭ`,ºÇ1ñxäû6ѨÁ·Þ¸GüªS,宂Ë%©[¼©Þ»Êv$ºñÆpµËS˜…â*TÌ.ƒ€ÒR¹N!ªî,ÿÄ)CÑ. «ù}ÓÌõÇsvC0‚{€b°Žbö­«É%IZƒª…:ú Œ«> stream xœµ\[s%·qN%oû+˜·C—Î÷KÞœD¶“’/Q˜ªTYy؈»Ü-sIi)Ç¡ÿFòƒÝË 4†ä®U[*s0¸4úúuc~¸›¼ø¯üÿ»¯¾üÆ_Ü<¼¿„ÿn^ýðJ¦åß}¸øÇ+èJ¹EkÕÅÕÛWùmyáÕ…·~‹îâêëߟÌåYnÁNboþ×Õ¿–÷Õ&•ðø¾ØbpÚȼg¼Œû3ô&M7ðÏ/Å&¢Ž:ÈÓï.åæ­´õΦ‚³æô›Ë3Ì#¥õ§†ß¡qúxÛ«}8ý'üjåf”íÆÜ.Ï&ú :\a_©¼0§_á Rªèp|eÕ¦”9ýŸF9}}­pÆÄ2…ÖÚ~ M tŠ>%Ë¢®ŒËd • Ч#È/ð=”Ö¤ùbJo6ÛSú×—j3>Êž>dõÿA3;#hËàFÁrËl/eØl4òtŸva4PíH5+L0§/ÏbS2XNï±-‚×BªÓþ!½ ÿX2ôÃ{€e gâOïH‡×-ÿ'o$x ¯f›ó–v¸Ã!pÝk·ynç£pÝ¢Úܱ· H¢;~nf3Ö;ல(hÓEå¡c¨ÃY§tÃçêŒÊÆÓ#¾æàãéûtÀͱÒTVâ˜f÷+µ<ý èBÐjX]÷»Bž ÆÇûˆi as°Âë&–ÝÞ^c°" o¹¶ÝÌAžß]"ia¶ «®®öžÈ8@v»‹KŠ TÌÓ«”‚äô2µ}è¸åC-©˲ï]wHíià!²V)­Öñd#Ii…í„{íºÀs¥ÐYúM¡2¡ÈÚ“°À( M¬h‰¨()ÈR( 7lGíµŽ8-œ«¾¸úúÕÕÏ~_T©V KÞ‘1‘ÒXœÊùje…îJáÚáÄÕ¦¡ß~èŠr*afïÈ++~C&—n@Qæü‹9+ÔÁ+Äž¬JÉê'”R>•»ŽŸvŽÄ­9a³Z4ªS‹Öm®±1ò)SWš*r¹?}Ýš[ónïË©^`|#c¬sôºn_ïõ ¾ûu*µ…ãE¾aWÖšìÊ40KõÛÓ® Fš¦s¶“êDÊzuú[œO¹öè–ŽROƒÛ›µ› ôá·÷~¤vj–§Ê²»†!*êÛKä°LØkñ{\=jÃÊè ¸—[æýøVUnEá|%] V‡ÓŸÛI'%KÛ2R±§³’P8Ñ[•ýç¬q4¸ªhÊߒ¸Fíã7 <µ;“¾ìé{j‰)ߤ‰ð6µ0›D”è2°–u3¨¥L3ßd?K¨8*½/¿QæBP³.<¸ >í?ëÁì%)¾W}3HpQlÞ¬õ±{¬/Ï|Q0càÀ€Ó)p7©³SòôßðTXSÖJ¥y“ö`l„!j[ØÄÌ© u×õFò :~zOÞ{€Çà†À‘ÓfMóe”§¨~ÛšäéìÓ²' Í6'J*nþI«’$\Åê?$>>ƒmÞ¢°=c59«pI±Fô‚CqI´¦Îªàh7äïp~˜¾”0ÚÕö-ôÆå<¢_nˆA#²Äxy齶Òùs!GZ–@vy‡¦­âmñó–0ÄØ e&ñHËžöf¸Þ V¼©¨¹Þ{Òí·ºioéºî‰ÜÞeì‹p½#¢R ‡„±~'"P¿)çr¶i&iuìë¼ò¬’iÿÎsCÖÐnö'2yãÖ.ƒ œwÜû|»aU¬0¼î¼X¢ az­Ü†ÁÊ:¨§,ßMÿ’Î7qÖ6¨¬Ë¡|9Z[-M˜mpzz;ùAøô¦=}hOÛ¸œ>“¯‰i²»ûž‰:aÒ „<&.± »—‡'ÚÿXI÷Îë_Œfd X0ÃÝÚ’"HÒ ; 3¸K%²†кU]®|¢WcˆÈÈüD±7[VµJ4³}‡Ìº…F¸½ã½@uí¤ñAH6újÆ ,µô«ø¤ Xr£ÐþD tˆÁ%kàÀÀ"¢ÜñËCž× ùR®M¯I=‹ëaË*´mÑI¦àc!=XÉ!¨CmELÜ•¬0£0U€9ï5MØ„a_¼!’Aá˜ÅF¨ø-a-À²«X|(¡Õ-à6mT³»5t%£6c|®=³­ËûîM‘bë–È!r¦°[¿¦y}$Ò§}›c¢…ÉÒ7·¼YäØ C¿ÏŸê!Çaz˜ˆ¬ju0x† ÃìNA7qæÛ‰VÃŽ¹°Ã‘¤$̪Ï’W@%o™½qikSœâTç‰NØ%óI×i#a‚>×<ƒ¢“JhÆ<ÿÈÂ"œy~I¾È—¡“ÁNDj”ÞkÌÌH}ä€#`[*Ç<À&Îv“ø·;“ŽªB˜M@(º„¿ž‚@iß…Á,R65˜HÖŸ¥’Ðlh'ùÆ ø¼´£r‹"@ÿ·‡ïX¹Ë¿K«¨á}&ž 1gCõRÙÄdÚ‰†™¡ç!zbŒÞlnrb‹(É] !Œ®)Bè¥Ñ®kšÌQP§Åƒ ‰+ÐÍëüv%:ÑBÈh¦¸Í€±nY¬Ù4û+I$´í°Ûîè›$ Eþ\G„ã‚ Z9\ÁæukÞ³ž¹iáÊ?`þ1‚Ø{HŧÁ†§0‚Mˆ?71ö%ÿÔ¸d„?¶æw¬†V1–n)Ný¾ýNæ}‡kŒ[åþ}{úí©u–í± =.ëæºI>¶÷‰å¹aÈ£ÁØŸÊ6‚oOckÚÖÜÚ[÷´Ž°•Ý)_¦HOc…ˆá÷Ä“CœÊ’¶uüjïxžèÕaw.Ã&¾´UQÚ/ÁAv`U×¥&GÕB)â]Hª° p^Ù1‹zzFCò6-Óƒî"„Ÿà®w“G§bÒ+‚@¯?AΠ/_rê\xˆi Îðõ=³ÍÃ\Àyàê¦dYeù!“j@ª§GìÞ–ù¿Ù‘ Ââ±¾’J¡fÆËLËòôÁ3Dö˜^áÒŽM£@cÝÎ@˜¬©ò“ëxÁôqÆQÜ–˜Y+²‹.·I¾DKMEËp»}üÐêZÄ}KEäøˆ;1ª1§®;.GÑ|‡ÁWq9ˆ4R8ï;ï`g²¶ÐºóåÁ-ô»/Ÿt HPP䦳EÉ8qADÇé­}© üóüòß\¦\µU%h°Ž¼á6G&Ñ›‰ÎYÔyØEÄŠ @»iæ‘r&y)@]÷r'ÑÖÀçzRŸæi0(L±ì£2ØDÍç›÷09ƒê•—,³ª1…;zp݇'ýÓ:šwxèvƒ±DíT57­xÇA蜳ªÕ‘¼.qIÞìVõã¡U…xy…ÿg›2]ðƒ0€5YÑTLý×Ù æþÜ5ë}O0‰"¬L+Jða “§¢¶Îâ‹n µ%A§Ðr]pѪ¶ZñMÈ-v:åʧ ù`æ ’ÉalóôOâx|­Äq`À è¸Æ`PEHÙ94a-évˤÛSÁWÛ3J (Mt£Z=d·KNmQ褘¨žÐÉ!:U¶á ËZHŽ~ÈÉÀ†ûXi2C7=:ÐåÌøó¨ºß~J¹ñJ攌߽?Š‹œóè_§Õ_¦ˆ³µ —k§Õg~h„¼=< wóž³svoŸ¨ôù+ |»Ò`vL­$ û.s½ç‘ÓFÑâ>PÖ|¾æÈj»j7‚k¤N±jÙ*a@¬=WÃN`F­“ÐI뙧“ÐÅ÷Œ^¯±¹6Èœ‚Kÿ{N᫸ÜÐ M&ár¡ò 8¯²|+ò™ª<XddìÝÞš™Ã*Î$J$(à¦K뫇 úæGèÒã L¹xj;ŦúUÓ[Ò5ìºTGrRÄÀ¡ãcᯅqB8R×X#$?YI#ð¦‡R¸³]ŸP<šdI.T!õ¡‹Eêµ %î‹ÃJžQÕSû‰´€f‹†É ¸”qÞ¶§$Apè—Ñ•/|ZE'xg¤ƒ¬óº©z‚øi4‡ëÄâ‚YåÿuªŸà\Ÿ*ç.áÕäî’|hdÊ &i„ª±Š+¨)ÞƒØeFêIfAê‹·E•oæYå¥êÕ/ñ÷^gV}dg’nX]LÆàŠú'5O«I×^&…¨ȟë% ½•è³kà58« C¶eöµWâi;^íØ G̺¢Œ¤7j?‘| ø£:5¥ÈÀåxÒëN‰YÌnöaÑ}žÊû8h§á[¡"uÚkÿ–Û¨}õX´Ÿ"šº¹g$¡ÒYÙ2£G“bš^¤š+&Â^y3âX3ë†Þ´z›÷£^û[ C‡°ö·°Ž³° ì“‹gÆ e»}hQ«à)YÙÆ̬ÚoFX3#B(#øBœ0V•Ã¬^•î®Ïc#ƒ—˜KWέê˜âk6—™|ö-"-À0ë£[DsÖ±\X‘+öZŠ`–ö:GÉu „qÃÒêµýO;Ñò._eìîæßsÞù´é&ôáí¹à†çÝ(³/ æ¾È!.¼k–ÊVdx‚ô¼B˜3†uM3I2EÐ~.ŒKMG n»dŒ =¶AˆQVàÑEá1óÙ89áÐF¼ED GC¡Ë¸¶é‡×œGmÜ%õn Ò?·¾Nby4 ~˜29íé €LedSþã3п­ž)kýªD„U‭åZ­ˆ7¥†X‰UñsÉÃîUݨf3O`?­¹sT8\4šäÂÃÿk„”+¯¤{‘2C‰ »1}ÏòËoÉúÝ%—êí.s7–÷{<Ì ð]ÁP½;ÐqG5„]–ɬyësîÚ×Ê}ÅD}¾ŠòÜâ¦øË«cH:>§õŒº<;˾ƒs¡ ;:ÃiŸ~½Wk ‡5ÍÊ^ÁM«]Ã3åÀ4…Z +Ç"ÞCåp –ïœóÆ{‚H»lT­‘9ï=ù¶œ‹¾×Ý£GaÝOYwßD4Õ×zÌ‹ øRœ’…ÑJ¸¼’ý=¹âõ Ï*˜Qò¨˜4,¢^a-™ƒ—Jmp_À_jyÄ!F·väáö&TÈs5#"ö© 6ƒö¿Éø˜ÜAÌÔD^ørðg;úCs5J]€ÎåõÁ²›ÁQ=S|•ý2 r̈áZ«YEW1d>vQÈ•éü5¼[¹'4ê±*û„‰WãÅ)MO©’\ûCM›¶îÂkÚ‡Ë\‘Â$½Qô › 1z­ü 7›0K¶ñ§½Ù”ï-,ËùUŒfxu¸gØó* 5°GàðÛR%TtæÓìc=)x¹eõ$_I8Ü„Ãä5¨¦÷Ø»Kö•Ê•@¼àäš4-Ò­çÒïœó®×í³bSe8ê*°«“}Ì zŽ/Tô©Z×Í÷Qrñ:[³ÝJϱfÛ|ž¢O<À)ú¬Û—(Éc®F1íûòXN_ƒ@ú¨gâ©8ZÙÚˆf"—Ü·€¥æX,×ÒA¹pùÙ°›r¾Ræª1½é𜪱4ÝS_SJe-7…ŠfÐóu \ú…*vÚ^~¡Iò ¼­ÝÁôóLª¢£äZ>U 2ÝçøOü°W‘ ºn€ÉÍ”_´æÏ[óëÖü÷Öüª!Òm¶ò@£vè>œó££š¿µ¨r ‡Î6jUª6zxKK—r/½‡‘Þ;€'œç]XÕi2§ÞÄ•žù,~Ônibpîè<&QO™HûM*^ÕO¹%…_ˆ¼·È]E ×°7ùlµ8¬‰ë: ¢"Ê©é°®£Ñpóž ©Ðõ¬×LâÆui×Úq(}Jl¡"Ÿª’nè. ´eÍÕ åÃlg=e£:{Ö™Sšý=¬¢{³'%à¯\£è,y ´wPjìèMž»4Û…!„÷›XÜcHCˆ•ièü<"Ž öBßÇaîîØ=ò`¬¡y8"»ilè8']iûPÆ$¹–N²OoF]¼Ri=ɾ4Õ»áv™ÔúByütVXæ¿G{Œ³ ±ÀR å¬ÛÉF±P^¥ _/É6áx@û0;3D’¶ä©I\·zÂçï±t zÛg·ÔMµbˆ¹…dyQLk Å¿6!C CM)‘d™§«Fª zþ¶ÜÑgSŸTz¬y(ÿÒ+Ôä29õò¿ºzõoðï/Â=àÀendstream endobj 241 0 obj 5220 endobj 245 0 obj <> stream xœµ[K“$7Ž€Û\ø }ì!Üe½Ü0`¼ÖÃÉp0ž}Åzgí™1føõ|)©J)•ÔÓv˜pÔV«$e*óË/35ßÄ"‚þ+ÿÿÕû«_øÃë‡+qø=þ÷úêÛ+™Êÿ}õþðÉ áŸR-R ¸yu%–œ62O北ñ°½óêà­_¢;ܼ¿úâøëk±ˆhŒ î¸\Ÿ0L{­ãÑ]Ÿä¼q^[¡åñsz]pêø›k¹hë× ¢êøý¬‚³¦yýâú¤Œ]ŒTÇ?ãq‘RâÃ&ðNëpü+=Y!åñ/i~£E<þxch öÑ ­XÆ~JcEPZÿžÓQY‹h×-Úð&“Ê SæµÚ‡u5h/QeüçÍ‹nñÂZEºÍ'#VÆE¸F•¦ªLn4ÇÉOƒOÚ-ñps‹±y:|ÄÒ ’Xw|O b”^¿¬³=a¶¬=þëšN(hw|IŸéÅ)ˇÞÖøw)xÉÜÑBÑʤÊ`EàC^gÅ ±ˆ¢ÐÕ‡ôÒ(+ßÑÞ­0Á°†ÉødhÃn F¿Â ƒãñM^YÛ0ÚuJ·+cŠ°8ᚙ߰ÑÛsü9mIK-¡J½h¼lô›¤9}äSÜÓ£ Â6ZN礅ÑÅvÞí%ûþ!oWG3ÿ–F¨Exï0ÔÆtÎdB¦#,/YOVªÂ!—c±8€bH陥“$ÿXgzÕaþì¿uºú0RE8yˆLjöX·h[[]«aSr]/﬈¤müfhnHO¤œ«o¼f¯l ¯htÎu8õ‚}T¯fö°çežÌÏ\¸}Ø*Œí¹®ü®z÷Þç)*ÏPÛÕqÅ>äµ6™í_Õ)öO†€M¶¢­6›±8 ‰ˆ’‘o€=¾åªî!/bñМ瓎“ˇƅØ.«‹Õåw2ú5¤[gŽfʤS¹ÍNY;'Bf%eV¼aý>HÄH›µl±>°aú 6ü9¾DL$ ÊãûôÊ—G€Ôæ•NIˆ(â&Ÿ’aHîGáWEè%†ÃÍgW7¿ü¢Äu­¤]­(A!› ø%¬'[ ‘|mlÐ÷˜;„ tÿóúšè[F†¾¥,bÔMЬ¿ó©²aK›w¾åíÌo²x$(Û`bllw4‘$Z36pfew,8ßf¡”r»X‰ÙÈüšU‹ªýJ8`âÃø÷Tt¥ÆèÁ¢Ìdm„Ù~»Gî:"ÉÀ7¾$€‘žAÂàDnSþq}}rÖÂÜñOt˜ˆ ´0ÀY‘ v àA]²z:=‚¼tð-¦ËÕÊ0VÆÙÃ<ÿ©M}9 ïi?D6Ù!´qUF‹ ¨ãÏè ” Pfg,Pü¨Æ=…€–W´}ES ¤W­—õíýðq©coëÛ/ëããö8‚0r$êQ2ÄǶԛdHÏ%´ lÇædzђdYÎÌǵäsæð=CM*öóñ/sFm½á•˜Ok©â§… Ø:N{’A»ÃVHâ$‹6 T‹Rcµp Xñ4k¬ÿ öÈäЩTÂ\ò«‰«±Qå‹ý~ŸÇéŸKŽ4ÈD”nÈûšÐ¯q :òî–”qÛÙŸM_â¯{ar$bmáºÔ^žŠH7õ¶qŠôX–Ôòl‡r¨¾ˆSòêµÈ+âpû¬fX§zÈûõÂu*J{1ò2Oc³ì¨[úr–Û®꽡Ñ–Nj…µ±åš‰4ÙEMdRhô•hþÍ>-v¼¡»q‹ÔÓ äS¥Ô3Â{.s¦Ù#Lª±¶²ëÈÀ’é0[¶¦‹ëáxÈ•Ýv¨W¦t¢ÆöŠ([hLJ/°ŠÎìò-`¥“EjìR àW\`¡ºçHvÍ”Öõ†µÝ—y‰ˆŒ²–ÄÇEÎÈ4µ¢°„&šôλ‚•ïgÑWÀ‚-QC?ƪ Ÿ_§ãHè:àMJwä:‘QB´võ™Ì;ª®ßžêÀo¶—É0qDΓ"èwåìú‘(”h¦°OöŠ2õ÷:²ní1OdD3gY)¦„qýè!}¤ü°w€› ¿¹wÀZðtLnÝìšßQõ)$oÂ5e ±äZF¤väÅkã a†×øÖßõÎ/#‡3$í 'ÙÝ(Õb ænƒ¦–œ™WIÀ¨´·ƒ@½oa²0ÜpœtÁííºOÑUÖwh@Ó¿«ô«œfÝž4¶“ ÍD¿È½d‚Ÿ»¢@smËŽÎTÀÚV½°~K²K1oç’jªàøŸ¯ðÄË)«£%\ƒ*˜ŠÃËznÞTMŠãTs_9‹ÂÏ’Êí…™%GåæH_kùPŠWÆ´w\jƒ5_8‘jJÑÎØTO÷DõEX8'"͈FAô¬žQ ·×øÌ º !ÅÍÊ]‰ëÍɯNqá6^ÔÞY÷xª?'oR´öêN<ìà Alší GØus=&!¨·ãêH°SQ\Ééãb˳®²]ƒ²ƒÃ±¾î';PÖ@ËEfT7Y™’µ÷Õœ¿œ½Bnt›ÏÒ\ZôWÑQ 01èR»`çmÇ»v>ëõ¾áå‰Ò^t~unsqÕ4m™I Û±azINcBç®wer¹s˜5Ô3²Ä¬¦qhšâ¾7MŠÕ: ëÆ´Í1c.”ªEÃ^Ö@¤´bk«ìnˆ1j±^–ú ]£˜Qk~Hû+W¸’q ~̳ëbc­PÛ4& º.a)©¥K{o4²¨Lµm«T£k¿Øæf¾ømŸZ÷ë­”Kt|rfmçkñؽϴ"Hcl"á«ÌÁ±«ã'u¢NýQŸw´*:­ò²ºÇRP­sËÎ%i²î¹¤©Þ™iÖ±KÐq¿gaõÝÿ[“ †<úVWÛ§7“˜‡eåýÕ#RÍÔ¨&Dj^ÛrSò£-7-}§ÚÐV)ãÞ òmÂÄmBËóÚ~7¯vS0D\xå‰ãJ× _ÝÝ& &0ŽãeÈ r+ßÔ=•M;Òû«M¼îÐߺe­”Ó–¦¯ Ns¾gjßTª2¼.¸V¶¿©å¢õíþ¦Æ¼Ï¯Xå‘Ä&•Á7k«zŸ9t—²§U5Qòéy;ÍÂVëò–d-’ÏÒ±6ñÊ· æ­­q¤|Ž‘6 n¢È)ÝgúØHAö]‘ˆvuäë]K‡¨5óX4eõàGÖȆ²û‚–µz•:ÊãcDbmøû<ƒ ãzÇ a¶ïŽÿàëÞù]"û* çäW9O·hçwŽkkž¾‰ýAÝ%íúy]<÷S.m÷%© »ÒÈ’ó=Å Ï|Óì+Dí ó(Ë•^áßÅÌÊE¬V®dã)“ÎBÐhÓ¥ŠÙ ڛ؋@Ó¬pv›»iGF³Ð-mBÞ® FnóX²“8¿žÒ“p ÉÔiŠ€äBÈîo…BHV7µÿÊ¥“`ž<$­·95ìÿ°æÜ}ÚŠóŽY‘Q9ƒ8&ҶľRáA7“±“KßG¡Ÿ­²¾U³º)e¥¼ìB9íÔ©gûLlÙfŠÆJ¡#@aÚ÷y)ŽMé-ËS8¯]•dw¡> stream xœí[I·Vr|—ÜøÖÇ~±_›ûÃKV²µx °sFÛDšQ´Eò?Ï1_‘ì&ÙÍ~oF‘…1"†(¾b±XüªXKëyÇÞ1ú/ýy|ºùüŽí½Ü°îüÿhó|ÃA—þ8>í®å|ðZ‹îèá&®æÕvð¦;:ÝüÜ«íŽÎ*ãz1 ÿqô÷´^ \0KëÙà‘ŠGQŒ²ÜwÓœpràªbüÕ– ÌK/ïomù`5ãåè:í&œÑªÿ~»Ã>œkÛß1è¿Åj«´´®ÿ ¿j>(¡+žÃv§¼@pD´\X¦ú¿SÎ…7Ä_h1¡ú›4ëÒß­fF)Ÿ¶Ršþ 9ôÄD9[ˆUn|# .”‰jr--+í@S)䯴Ž9!e1¼°¦•Uƒ®5ýÝV Êz^ë§þÇbºq\AC¨Ž«A*³Œ€¸Õ½ ±è XA³&¢G[_MóíÎãš„–¸¨÷ÁL†¡tÊ0Ù?ˆëŒàýŽ†ÚIÍûe‚gÄM(Íp’“LYH«Eÿ GU ªýC’Ni¯p¼×™G±ß1†ÆjÙ^En˜‘±Âµ§ý@ãŠuù¢òe ?àÂnlŽþòs¡¸…ÇÄ€[-Ñé¤ó8~à -*©IœHaQ¤ÜÇ;² #¥Ãéébo_®:¡UÌëƒ3 œCzN§ÂùGtzXšrª¢=ÆvÓžV1ÚY3W³n  D…vh`dÝÑ} ã˜ç%S¦¿†Â)ѳi6r²R¡œôndñe./éÌËíô ã#ñW8«0‚%ôjÓÁ&,~©ÃÙ½µ±‹ÔCÊ;îZr@Œn"ý¥'1àpo‰4Œ›QŒS: `Z7ÄàаÆñ`UÜ{ˆ’ǘëvÕš_¶Û–nPÒ.•Tî(,ÃŽ¸Lããj^íxýhs;øÍF2¡10^ÉÁt§X­à·Æ¿?Ýü°ú¸hW3¹ °ƒuÆÁàEtYR a|ÿ )„4<ÝüŒZ¼2$¨Ê u…K*ÓY t·†–ؤ"L%ú;°p’ε®Î2\ÝÎ’´YXtŸfܤòhŽVT·qô)¸ií¡X×x;˜Ó^Óý  ÞhѺ€œ ¿ó. hÀ yoø0ê’½ð(J>;Ë•àßaÑF7ÍTB¿•qÀ­ Ù0ŽJGµ›ö¤P6ù˜äë´5ˆ^Fÿ ä%Ï&ä½Æ˜èi$öÆWPDçÊñ&‘]±2¹W-%o­ÔàªEýðpÎàý­E*>Nž]©ù4¹em„̼éè;„ˆtàö`ÐT<ñK „žä½-½ÑÖá%x±ån0Ìä×EAºúR´ß±´ÝøfÖO† »¼T¸ú$Þôn¼ŽCx!È7;ȳϚ´¯òìIž=˳(XxpóìÃL»x»Â0¿]ÁÇ'í ñg™öþ‚0|›iOóìi“ö¸IûYyzAÑ÷tâ¬>AæÁNŠ·xÂHŒ`NòŠ³¦jäÙGÍYÜ38XÅÉA±?múu¦»™é~̳Wóì<{}ÜÉôך¾Ë³·Ö8Œ³?8Ê9{0„Y^Fq[DûþÎu+ÏÞÉ´×óìµ<ûmžý¡9{3¿O¦µÀf8í›s@Ö§•!`á#Š.ƒ1b_bcnÓ~4æfÌÿ_¶z¶:íòsmÆh"Æ-NŠ)°’qQE E Ü òƒ"ë[šT²›"UÖR°Õÿ†žleÌ<×­pV"ø¤äˆUq¬6®™›"Y)‰EÅÕŽø]`~9÷ ©›âßZŽ£’Z×Ä™…Õ<$Sbð‚ŠVÌ ÞL#ô†9Q A¼4TôôY”ù™>„pT9( * …RÍ$ Zd…?!bæ ý––~ʺ9ª[$¸”;%ê¤RÌ»”¡ú AǹãQ©ïÿHb 㯦+ú’ÿ¯Ä’8ŸŠ(HTcdŒejŒŒ9Âe2eÕ˜óYx9fÞòÊ‚ï‹ ,´²f5·²‘˜'œ”©IŒ¹ œõJ R¥Ŧô:H$¹ºäDþS-‹ké‹,&ˆ'¤iŽªå`APl]‘Ì[‰ø;gÃ'¯COš“„´¥çV”ûäÔfoÖAuª²KÿG>xî g•*`¢ÈËçŽff«¥ØïÏ”ƒ©úvzê˾8\•pc¶£­°õ’ê×-gðiÈ%œހɲv>ǯDNw±bG5*…Ô8…h=£j™4OVHöD`ÊÄÛ6²ÆcÄX–r¾òU´o.4­‡IÌ¢äÚ´Ó Ä²i=ë~%Ã- ÜD¦ÊM Ì2&ú!nB3nÏÄCõzŽöÖcæþÚÒº3¯°””]T6h3®^Zê¿]N‰è¶NW´+3HœYH.ê\ÜÌ·”ïrH€”@âs*PS5žÒjø0AN’ŠH\cþ˜1ªŽkîÇí¥iÆcxzE1[’ÁŽñJ¤þƒ¹ÿ@U™ –$š‚}òÆ<\¸–¶¬ýSB…ðŒŠ¦AÛ '5¥X|°›åÁQ/ÎÍ¢ÄbY%Ï¿I_ÏÏ||c¦x­ ‰JWµ·å9×&=)Ù®†³luÈvXöÃëçƦąÚc"·ÇŽ¶õ•ÞÞäFYÙüÚßó¬Ñ ¯¢ö57ö˜Á{÷ÞÚcBÍ cj]£UÆ{•­j:]]9:Ã8:ËnúQ<â¡°x›&S¥RÈMmtîe<2ÎÏT ïZ|“3êõ_D¹«ÐU$I…Iíëð Í›ÁìØá£8×æƒwø4.qÙà+ :|Í°i­ÁW?VWC¿HÙz­\JºÎßá³!µøm»|U窒¦ê*«„­»Á:˜×¶™p)d%Ä—Ô<5­¾€ôa—ûeK=ӋȦG¹î”Š¶TQ¡2ešs©ž`1gZµÚ³`c÷‹´lÏî*úƒ‰¤žõ{O]¶“µ +S¬…Ëd+ÛAÞßN¡Ìm;Ø3çûSHr,ºBÇŒ |Ç‘ú7víynä1kK‘eªª¤¶“Tæ0b‡ä¾x8|I›3êyµfŠºcš­Ôþïh—-£ð­,³´¨4˸¢'—ÚÏáD³"ì.’gåã}iš¡Ü‘øBoÞÍPëáâ®Í`€«¹,óÏ ±ƒÿ“?”ÏõÝ'y2g*ÄÉ“Ð{zOá{;í§Z³¥Ì¨JûžFù´õ¹Fâ2Êž,2Gj ¥º˜ߨzæƒZw’QWqV„Ža‚f  û²BÅÎæ¶q^>ûBô –Q×G»–Q‘m5¶K|‰A¾Rã—e'ùÝŠ$Ë<àS.y̵`x½kW‹—MŠrNÿ]^Ï‹)3¯-ã— U1¥jãåÆÚTV?Gé`Ÿ¯[–+RAyý¾^Ÿ†!ŠfZU4rÙbÖ Ä­:#è›ê‹µQXüzuµ²RÚ]¶QÊ]ø>þö濽«/endstream endobj 251 0 obj 2906 endobj 257 0 obj <> stream xœí[KGŽ`7ÿ‰Å]°¸C|›z?„² N@A! ÉDBJX8c3Æ¿‰óGø½|§ª»ëTuußQˆ@–åvÝêS§ÎûÕÏwb;AÆÏŸœüîK¿{øòDìþ„¿OžŸÈ´a7þsþd÷á6á¿R R ¿;»8C N™A9ãeÜÍk^í¼õCt»³''ßìÿp*1Áí‡Ó¶i¯uܻӃ‚7.вµaZî¿¢Õè‚Sû»§rÐÖO¢jÿ)ý¬‚³¦Zþòô ŒŒTûÏð8H)ñâ¼Ó:ì¿ '+¤Üžà-âþðÆÐì¥3Þ½K¤wWß?Í÷*îŸW” zz^í”s® Á_%r*íö/O®-mÈȧ'g¿ýf¤ŠVÒó¥7"&ø:ÄAY‡S±¬b”8ö^9öM!£Ü_Ò³>Hé«ý¯ º&ZÖ‘xìöùö|U£¬LHãAh<¥ã…1ÓïÚêýE^õÂK›èãþÅ© ƒ¸ô¼¯$X}žn/L¬1Ëð^¿ì` ±ýŠtƒ³û€yA«0m¶ÞEÓíd°"L³ 8’/--Îy•/í|p¤¢rÈãÑ€½él‚¦mhzÅŽyH$ðƒÕË=é ½Š q4šA9F†B'ÆØŠ;lýE>šýê”ÄJ›@’ôæû9"§EVp¡çû½¢-¿èL9bûƒQ–ïÍ×PIÒåq®Ý㱪·d²Èè³Êh]©ëxÙƒôƒ6Bå;»OìSFÇü’Qü%3X'¤›(ô†ì 4Æ$ ˜Ÿ–Ç—½Ç6dBN€¿=mа0JCôØ‘±°Ñû´ŒqÄÆI&:g{" ÒÖCõÎBà¼Ã}OâŒÙ†8€rqÿÝ)ÙŠÑaUÔ}„ì|Üd3Û‘OíëQv0ÙX“`Žè–ð$ã[dÍšÔã¾´nЫ¼WÁ¨kò¾æ¶dãb­vɬ|Ï Èl '>…À)q¿ø ö¸iuœà‰7ÍKb¶Ÿ 2ÜhÆÂûZµµ³ùóÁN^#Hø¥1Ê:âƒÕY±%‡êâp½½àÚGªœ7†HVeS¸FÀ Çlt ™1,š¨½àìó‰ ÷äho£ }û¬LÓä8jÇ$5E­’៓5²wÆ?>!–*poÜØ$ˆŽ ~GœwßKѲD%{˜ø!$Øóþ÷“ð#Ãð=Tè‘T÷š¨@Ç*ß‘„ 8Ó"ðd‰ôóîÉ[¢4Þ:á½É©Ú#˜ÁuÓp ÇLaÓ@¶ Ú˜Ã}á¼B)aº²Üë!(y“hkî’¤ *´RÏå"gP³…€±º¢|NB™UßáÏ¿“–A,Â"³©ìýUƒØj3öCCk ófæ»6ú—ôR&†ºrZ*Œïg'Lñ³õM9vefÓ‘Ü„H®L2«fU7öþ‚ÖÍ ‘­1xì”SÕSv¥ãàæPþó8]÷ÍŽ¾Æ"+÷]ƒã‘Û’Á™÷¿×Úšw­²F½‡‰!#Æ1yØÁ”ÿ2¯¼P]ƒ¦à#XlvKòÔZŽWk¤˜7çê9 ¯š3‡†ÑUô˜8 ?î»×aœÎÎÅ›Ðw. 3˜%´¼Žs1Cv,e"1UpìS]¬\!±ëx¯Š)žÄÆw¬,\Lkw3GT’C“á“­…”à‹—Z9ÆœÃàUµÊ£…~l›ì-l,¼Huör1ÛÊö¾ÌÇZËë{õÞæä0Q¤0Ý·Šïîù¾usŠ´±r[xZ«5‘»NÞðjq)rBߌËUE¡“Ðu EŠc¡3×…•7^NŒËTo¶p›|YŸbÄeSøBÖRð>€\×…xÄ©,ê”äz´A#‹{V^{šÈblɱN;®ÊŽW¤'ð° ÆE:© hô:ípHÐùæs*ÎBiEÊ•šÊI(=šìÿé<ì ì½^m˜ê³$3£buá‰=‰#S­÷ñ¬Ã—ó+ ?$IŽi¬ “2?(áÕó¼• ³¯yàÓ+0Ÿ·æêöÛT˜“í“aµ€4æT•Ý(O¥w°,-’-ªlT &#åíhþÆ»2ӛ݊¦þ̤¯ç¥âs^JBb³ðïÇ $&@&»š„Õe¾þ.Av N¨ã+àc$Eà Ñ:ð&«•fYÍ­R½ºíÆOËÖ§7G»¥›þ=°u6Ioãb)qö[¸‹ Âôhõ¶à  !^Cà‰mй‡R«cçãÀúüÛ1àöç·ôo•¥‘¾E  uì¶ëÔY&¸Õ¹ÉÏkWÆ…mƒÒ©z?{„<‹>Í”¯Å­%²-U0†GNXS¯6yx͸ÞBkKº¹|UÕ/&œ7Kò©­zP…ô:ј•Þ_çGi¨B:¯¾(«O»{_•Õ˲zUVA!†@ð¢¬^”½ g‹3ÃÐì#Žn¾ÓÝûle³÷²B¸¹}BâtÞLä+=Ù ³×¯º´yPVvWq$v¹CÛßÀ¼#úQÙ÷yÙ÷uYý°¬~ZV?žNrÙ/. ü¥¬~±aZýqOðGúHî–wϺLyžžÝ*trprâƒ4¿é^òHó›–dÿ—æŸRšßÚ_”Õ/ËÞËêݲúIYýª»úyyülU–²óvêÖ:kÀTö(I É£¬§Ý/|§î¼òùŽ^_²3 e<Îlµ‘ãà¨~÷ú–õ:ÝyWUšØðN&”²ê ÎÝ?¼S–Y~}N|Bê)âÍ ¥¼>ê(QUQ]dqÅDëVfkãN9nºf|&ñË,µtYýtKnH#Uqsjº^N—±ë%Ï9–ËUÎTL•M™s$ŽŠóšošÁ'KºÚ̬{¯gºT€á)"s#m6 t“}á·kLì Yue;-´ oÔ[}Ú#UŠÅÈÕT¥H¹*Ïþ¦ù´ƒ#£÷[YqR­©ò4¤“Á2°’ 5Ëwj» ´“¯XÚÒÂèüªñcs¶Ù0\§&Î/n#=!'°ÍÄëÒ–wF/¢Ýr(9¨ô½2D}¤(Q¥”€ø4 ª,¿2yIëˆFdhh/£ ÿt\_¶EË̬©[ÉÌVÝY5þ{ NÛ©YâKûÉ¿ÓÈbn­›²ôŸ¯ò…©!¿2~߉ H`¿§¡æ½IÇ™’ù÷ZŠ‰ê&†ãR,£OþvRD¿UG™ægx"åõÒvrzþÑÕŒÝJÁ!;t¢WT¬öü"dç¼gz° ìR³g"?¤³t-†U°rÃÇüàªg¶ý%A~aµJÂúN"ZûÔÌ¢ÆÇ`g‘¥‚2}(U7f¿®™b–Õ©W&×uŒ˜le]8êW$ÙîbÜŠDn«¶F—ÅWÅù5ßJMUÔ0Gk?‹NƽR©àÙëVS#mf} ­´¸Ý{ÿØ^¶ú¨<Þ¡¹)Ü(ÖER-ôD?~¢žÎW¬·õ3l4]¥ÿ•NÉ;Ùå!-àåÑkŽCǼð¯Þ§Ô<Çâ?Þ#Ånõ㸋SEÕãÙk–ský¡2Þ-@ DŸ–/³ÊËÜʲˆ£7‡s|Ðô!ÐVÖç½\ì{ŽÀ¬z¢ }i±é9šÖ[zŽ„%…uG?¤ÚhHyO•Õ&œJ×ÛY©¡ªFŒÑeôsDUÓ9¿½$Øúµ´®±Y õ! s.©FA~7ÜÿqƲ_i͸ՕŽ-kW;:×Tï”ÕGµÎMÞó( …øFõÉËÜdäඌѣ®1êY_ˆ7'Ž6ÁÉÇg'ÅŸ,%_endstream endobj 258 0 obj 3776 endobj 262 0 obj <> stream xœÕ[I¯·r|‡ÜrÈmrë‰=-î ‚b[vx‹ò ±spô¤gÅïIÖâDú÷©"ÙÍ*693ò¦‚ ŠÃ¥X¬õ+öÓ˜åNàŸòïýÛ‹;÷üîúù…Ø}¯/ž^È4`Wþ¹»{çÁ¥œ£µjwùð"Ï–;¯vÞú9ºÝåíÅ—“Ùä¼q4ÿqù—2_ÍR óŃÓFfRœñ2îÖ>ô, [øO{1‹¨£rúl/go…¤­»¸› Κé“ýö‘Òúé=øÓ‡0Û«}˜¾€_­œ²lÍy0ÑÏ0àÇJå…™þŒ‹J©¢Ãõ•U³Rfú{£ƒL÷`¬ΘX¶ÐZ»éhJà“P´—E7þ(®ŒËl =.` cÈû8O¥5i¾6§7³åœþx¯fã£äü!ÔNº;'+¨dôF¹e·Â `üô8ß l2½ØĬd°"Lß`[z#¢šÀàzòH†&\Þs$^Y¡Ùï°-‚óQ8Ü&­çàz®ó­ 9šùu•çëÌe¡"ÛгÕrz’~7Új¶!ù>LÓV€°eÉ©¿G^Xi…-Ô8hå½bQ"£(OMœÕî a¶ÐqüD‚樅q°\jJ¦ÖÞgµ÷Iwì‹Úû¨ö>®½PUÌì½›ÖÞ‡uìýÚKš¢¥A£¦¯¦îàͼ4øíî€ïZ‚Û±í="ök7²YúYëv—]\þþK:ýq—Mjïu·¶‚kŸ\ç––2€ì›¾WÇ}ZÇ}^{ß©½ÕÞ»ËNnz·»Âǵ÷³Ñ KïxÑl¢ß^Mâ¹ÒcW“Æ’ƒÓ;w¤{¿ŽF.h3ƒÂúåþûå/ Ø/[îý´‚­‚oL°Åú?“ñŸN5?«½÷êØ»µ÷ÝÚûaíý[·÷ÓÚü¤° [1úaJØzñÃêrŠ¿!þG 7ì™ }†¾Î€ˆØÅû ¥_[ÒìˆRO ›Š„éªtlÚÃ=DÁlAðç´¦þÿÙ^†ÙðâµzãD£/œØ@ÐÙüD,†9·é 1J¯¨gDpÃzã6,Ђ¥th=»h—â´5 Ú©^dÒI¹€[@ç ]œS‘,Ü¢ÈÈM‘ÞÄ-„Œ¦ÞÙ6úŠlþrQrÑC·ˆ”R GÌÑ:¶rþL“„+Ë ø癕V»1U•”¾ÿ=ßùmÄÌL‡Žc(¿ÿÆ낆‹ÔQ'þ‚s¾®(R6!!„Õ;o¸’ Mˆš˜ RÈDy•›Â,p–¯Ö8ྱ(ŽŽ%¼»É4 ;ò7ÕbãU]…RÈïD úˆƒ! Ý¡0¤c.<9׊cÆ€„¦®©¢ƒs´Ji/Ž02ŒÀ¨ª:UKû»ÝPÈŒY6Ì´‹³k@¸ÖO¦3Ú“‘" /×ÛÈ©‡Ö @ Ò´E2oRŽ´³ Å“ÐÆ`³šî™×°†­dcŒUùMÂwµ58µnÉ‡Ç ìá\©Jï „}B”K…Eƒ×÷Ô#Ñàê0ôÀæ ÃM<¥2 sB®^Ò{ ±¬‘$WËcÀõÞ5øhãèÀ D+ñvÖÁg\nÇ"‹’M+ìæ¹ â="³IÖUŠÎPÜ¥µ°NžÕ$­Ï„Côfë\¬ ñ&£˜%ypw–L»ÊZ眣Ë«“ç‚’Œ¶l-Æ"Ó´r‘é°Š´É®ý„HÿziJ¦·­E§*VZs]ù¨`‚·.ÌÂ-U ¸©œM iÙØ]f=pˆ¶ô†Ï³wÚ£WèǃTãc­!8*ÀÚ`4Åå’ùM*wì²j÷> z­,nN[6) ÓÊàßÁÝAð¯d×üÀ±b5½«‹ðS fÜÆ$@‡&´9‘Qï—$AÏôl±$G8\ ñÇV@²‚‘ '*˜(U‹à…™À€î’ r²²µ š„çÇ= ˆü tƒ)RRM‰h¥WÊ9(eçèdƒ\uÞ›Ú$hí× ©låG[0§Õ¸ÿ1ÁDi»Bl˜°e£C_ÖVÑ*ˆÖ“ aš‡6T«.­ØÐ\J–Í2Ýêrˆ€!{Ô¬»I•p/tB¼1šö5 ³ìC$«¼%AÝæhHj¨Œð¸L+0‹B Œ+d½ºIUΞ)àb\­Ï¶Š‘@`RÛ ÷÷­L¥±w™j<„FJ$ ]ŒGÁßòZƒèKCA»!ÂQõ÷›:± €uà¶ØÜ[PGÍD±/¿Â£å –¨6Cp– è`gg²Ç^«­K"ºˆFûWûõÝÀ &g¾òU5½ ‰·ª ?0¢Ä¶â» ©ÚĶ©^tFd¡SUl¹ö „T}· -dIÆüŒ -xPž,õ?77 –“¬ô€ù9‡:82ôEÁk¬#!ÃÁ€ä|“ˆ-ó ¾-èw˜c×1“—]L-˦Œ~M˜ E\[ë³z¥tc^ÇÆ£fÙ:êQóDù:1xuw,™;äcóx—fÅdÙ"ì¡ a@‚ÈÎÍbF°(®ó>2=iOëEx)jì¿ó¾é+!b~¬£7§ ,”À¼»sOñ."ŽºVMßÅÑ.F³Èi"õ¤Ï ½4…O $FiÑ„«>_€Ìžu;¹Vß‹mPÒnËÑÀ7_æ³#”cîñ6ˤ®ç ÿ¬QÚ{Q¬ ãú0ƒô6ôÆUw«OmL\Sàé üÖ¯›¢ÓUxpšJ2,å/LTÎ,r£ld†¶gÓ.×D7 ŽÖ UPÄ®¹a ¤4/xnHªÍ75x Ï0ž÷šÝ0嬆©ì„A4 fÖ0§ødÛ@4mRëSft`s°£ð‰{èFn¨H+pÔo"út/ƒ†§’ÞEÎ4†VèÉ‚›•öT/kÕ¤jÑüg¹ˆky\ÞÍ÷ÑÐF• èº p¶uQ ÉzÑ´¸SZMƒ˜KCC‡åªúÝ&8‹õ%%ኣ÷‘2¢ ßázÂ3o:ªÙškB VÚ@&øeäúH Ì*{HEÜé¼æo“=åu}ôš8ž€c+r›;xǹîÅFDÌæ@b'F1£Äa Ö^Ç¿•3Þ »@)>˜%vç)xÆ#¤°«¨…¢noåú™i‘GÑd|p€~Ýæ¤1´Ñûã"°1† âæƶYâ|­A'ý¤gSSZÔÌë! ›·Ã×U¹*âšp‚Y®~˜E-j5ÅljüÊë#K“Ó¡ mðv˜‹¸Tؾ_M$µYÑ£?0Xƒëµä=Sƒ„Gô—<¦­…œmÝ» PiÜÊ&“ZŽÄÇ «ˆ}ûOüßÃÍc¾½ÍqK§§î£èÑóg®³½@„ºV+`9LÏ|Ê:¢ÝÇÖkçg­–ëöÛ / –B:Mœ‡§þ®„`LþŒzŠ²CD9ï(TÊÊï¤úB\i"ú<AýH÷eÛçy[QßË,è*î`bÖX×Ï cAXE*:¤…4Ð÷4º±ìV+”=°ö~»ÀúAmSù‹¨¥k>O*{¤†Ì?fÙ €òZ=¿~Ãç7'ögê[' Ô>xSI©yàê"±nÇѼ>‹´ÄŸ¤#¿9]?ïêù¨âRb¿‚íK&}û&®çµØדÐÓó¯È—/¯KK«ZG˜øS^Q‡ûP_¶#UÞYÖt¢_­XTM7¶_wHǵ³å±ÄLu·í× *|æÇNëÌ·óËäú ÓHÁð¥í;Èœ¾tËb,c¼œæ×”çF?â³£Z2#„Ô§D‰w Ò!#‡ßÂö¾C~ݽ¼ø+üù/YÌUendstream endobj 263 0 obj 4050 endobj 267 0 obj <> stream xœí\Í“µ¯Êq¹åþr{ö ’ZŸ‡!)RˆYªREr0`^kÀÎ’¿7Ýúl4³» $”‹b¬§‘Zýùën¿<ˆEýÉÿÿèÉÙ«÷ÜáÑõ™8üÿ{tö噌ù=9¼v‰“ð¯R-R w¸|x&–à-h™–²ÚÉp¨cNœqK°‡Ë'gÿp.´ÖÞ—óNŽöü$ï´õ4lŒ_Èã{4¬·êøú¹\À¸²@0AߢŸ•·FwÃ÷ÎOJ›EKu|)%¾xÂœðÇwéÉ)ïÄõ5ˆp|pZÓì¥K|4bQ8÷O4Wxp|?n¼Ì“E0…D<¾†‹Iå„Îëp¾ì†\ã[´3þóò/™·8`Œ"Þ&Éȃ‘a¶c¥n,3õ1­¡_ãÁ-ÞN`—p¸üß½¦ým_§G©ýñÃ6úU}:û¬>n£WmôÁùI½8gÛèÃ6÷yý¸=Šöøc|V^«ãG7M¾hsÙÂ_ T®æ>î^>q^'o¥[@ dë[g—¿û€¿~5å̓6úh:Š[¡/Ì„–Ëömr֣…µãV‹: ³YŒ%õ"#M^”4ÇOÈUJ§º7Ò ôÎØãýæ¾¢GíÉ£äGa Ÿð"ù/¡ÂÌG½(’ŠH[&D|z¼{%[Þ¿>W‹FÏ •r<y$}, 'Á³iPí?§Â;/¥‹jƒ>Ni@eRèN…å=e$Y-g¬23rÍÞÏú8­gœ É*­\$ønú'l™ÂO+Ë«‰”¼ôòüÝH—’¡²\™ÐÍe¤|NKÛE áOh!ƒ.3”Õ™QZÈüd‘!uòÒãûõËp$˜ÌD0Úõš ýb\€¶qÕâ3òr}D¢OIYÒï®r[âä¶k~-xÓ8iµµ=·Ù«\P׉貑ùïö¨ÏIŸPÅPEƒ.iC(ßn*¸rRŠ5Ï#¨P}{:ÛŒQlÒ éÅVK”a¨Û§êºˆÀ(P‚tM±QÇË°õ…*äuÙ(ZÁJm")[yM&%,Ú\–°Ð^ö‚ï@"Fú–Œ"–ÈgJàÌ÷8A¸Åöî„‹ïã ³’ÙÝ!t豪áã{ɸ4€Oö‹—!ÔٿǽbуJb€–Ó]P(îå¿ m<8å MˆðÑ™áŠÁ†&ÍG½ƒE/ýŒ*ƒ:$¤=Ôé¯DF 7…)-Èæ+o¤Å á-j—´\[7Z(pôŒáËkŠHº^ n3Ý¡÷Óz±‰¢î‹Ægg6‹då3?C¨k½÷zv—izÙBÞg, ù% n0H¸ƒ€Mpî.Æðùß xË+„©W`ŽZt©™ *¦f)‰"lòÃÄ „.`Ìc…æÉ!<`°íFü‘(ê}žÅ»rü.!·¿ãà#yÈó1ò".‘Šùð<ú€°v®4ø¡ S†ˆ°µCÎ!Vƒ€O’­”bó&ÜW. 3 +Û(©sÉÐô Fu¯ ðÕÇ:ªÈËÏVžgmc›)°—»%d·Ó|ow9F]"ƒ-çºå(– i묊Py ÛŒ6 2Fçn)<ñ•òXG9ÑgС²#žêèÈeòR µ/%^ŒæÕIŠQ"Ê$ð”æ¡mæÔõû(šºQѾ™*Úiƒù? E¨û‰(Z·Ò÷S´W^ª¢5oý] nT´o_†GÛӌݣmÕÿ¸¢ µ@ÅÙ>”¾Ï*ÝPùæa¬C+Ô¥1VSõ†Ç}–þq€Áò´<Ûi\¯‰®¤ò‚À!k7ÃqÁ˜Ifr^uá¹.«tÛT\ò¡«Óh<μšÃMFå‹ÖG¨ <ËÌœªúq~Rf&÷è¹Üº¼«_ù÷Zô8wÚL§><§ýbw£ÃÆÒ1]ÑaŠŸ1é°ó¦¨ ª³,M£‚KN:>Š¢8éÍJgd ¥âáL$ÂA<ÇP!Eb¿s!‹;`¾ *õ3œ"ÛÔ|FìݬŠé¾5Žjõ ù|°!h!–•«ˆ'U͘,±RÕ‹LuÐw°¡LÚärGiãݪuyÍ¢¸Q ¿"òñ/¨¬¸ÜëŸCšÀo¥te1¤¹Ya_oRÎ.(ì¬~±+ÈÞê”6Z‹r”û æB…°x°Þ¨ñäô¢Œß©'¶aT7ÐM`¢nÆ5&É­ä÷QdˆC!v éædþZçwÐá›I5.Ö)õÉ 2Nµ5Õ'©ã2Ѷڄfe?ï â6:>Vé£y\§Øbúͪ§º©_¦1ÊN+÷ë°µ˜±0z–b¢Ô5í”U…ñ™óÞî ôfÂÞ³”¼µ€~FMÚûsÀ¸×¯“/î€D/¦‹Íç²ÑOÛãEŬ]“5#ÍívïÒãý™6vÿO»¹»Ú¹^y®}&2³²‹5Aq. z»Õ›=­}Kñ— ¤JÁabŽ“¸§íÜk Ò(š¢MÞ*àDÊfá<ÔÖÈLâÂÍybÒmýð\QC;–±ØÑÔs%ñ*C?§´ÿÎ:û(räFŒ¨M‚aÒ%Luy÷µ=]eå@–$ ìÖÔ9Ûñ=R»ß ÛŽ $æ-§’âä¬%ò o4à4*ô é·uR+Yð"ÝÓØI!X_™p Ι" ²ÀÒ[ÔE¦cP]ÕÈØèè¶Ö“™¯ú´wP jh^.»“/~Ü/—BPê;-·¢Ž…ýáYde× Æa@·vRJ{ãÍ,åìߌfÂl~u³Ë13ØC@n•’õú^ùXÁir¥ì[Í,¹ÓµÊ{˜9^îrÉy~Á­žp–Aÿ+·ÞdVöhRpù˜¼ö~°ü+†U^,ß»F9»þö ®¾Ó…Iå‚ûåÂä&Ó]kð:VºÚÆòw ,$w¾¥+åòS[(®[û[Ã,º]Îë…ã5­Õ=tR¦õFl{˜3óxÚÝ·`Q#ÖHâ¡a±¡»ÌAîÕ¬ÚõêÈ­0¹Ýp‹LÀ³ƒz˜t<·ª©%p‹ø’ã ”8ø½ÛùÄ]!ŽCݧi z¢6¥ÕF9VHŸVæ9 æH¥¾cɱè¶p½˜{  Ã…—Yj—á ˜€'­©Ž–\ÅXAh¶Mu¬S£ú/k]^ùÀê¸ËÄ’É8&ÎTx,ÌÚPDÒh]÷ß¡Ò™kÜÙ¨F¿“Ђ&Û.²®Íõ³†ø¹ èív!Ubÿ<ëpb?Êø¶«óù%DC|ÌO7º«T¥²ó`¥™ª+fž7‡FW­i”ÁMWÇH‰4º¯–»ö҈ʡïgmlÓÝ&ÑyÙõÄêïõÒ¶›Õwn/Ì4ÖðŸÒÅr[nÇ›uE¡Ï¸¢ àŒ–·.¡í•Ø‡„‚Y£”+‡Ô)-Jà…Eè^ô¡×ù’÷‹7fzòù=éYÁiÞÏ#Ëtγð=|£]7ªiæ؆£—º;|ëFu@VümjŒ¤Ê­ M)ÔXµ›)óp{b¿OkYè´°›ú:Ô,Zõ É%f9*#tsì²qâ\ºþQ(ê¼ÿ”ëa¼­*Ã^W‘o¼ L{?ãsWŸ~øÔaÚ/ÍA€‚ H4èÜ¿¯tö?‰U·ØÑK'd&¼Oã(ú».xoU–¦º^ÒsT(½#š½0T‰#‰Në­G³ÀùWFUþ³vfú åô¹‰†ýðŠ`(hw#À䨴Juv÷[!ܯjýy,x°&ö:%>D½éŽ| ëûõŽüoh²£ËEv~wÜâêAº;¿º¸Õçíã€öÎpE}ýEAwáÿâ<6¥é² k't¶ÁôÙAÚ[^êDJŦTÙ’h?slÌ/±/¬fŠ5tèoà X·±ÿòTX§å¤Nœ®D¡,^i¼›5 v¿ ½¶r)Ê#Ýzi2Äô: _ö$i®UÜ ˜©¸žk²Rñ_ÓgÕ-~þU‡‰ú*zE­+ï*j¼£"ÚeŸÇOÑsûY&¹®Üé²›`T²0í,e'üQgb£ HIwÓRº†ÔÔᦿð5»تSy耦²e€`Vh™µþe‡)„’SM1ˆNš±Šêg¢ÃD‡96@<½½K‚ÅÃé †ÆÍw¡ø‹ ÀqæξíÜß4M)m= n2ÖLT0åølë*|½™×¯ËÚ¨›¬§ÇJ¹xªâg1eðY{¼_~Ÿ ]µa_}!ÝFH7U)’tûÂ*™8By¥ÏÀØ|kÔì c¡8z/&›ÝtXEÜ «HŠ:\Zß*ß_Ò²ë&0yÌ€DZ>Ñ´ÞíܲÍ0‚«SƒÊj,çïLž©@Û峕Ë^iCŸE¯®;Qð¬ÁŠÖ_·G¦$m…©¢DntÓ^½çùdÛ¾)ÿ#ûW7¾æ©C²2~•Xë<4¨s–Vè£v?ý\óatPˆ&‘‰åŸ‰6 ­ò$’¶'y‹Š½Ö27 $]-µ¼OÚž…:Øï±-¡ }y¿†ã«V´»n<¬;=­>ƒ½ÎékKµO^$[•M¯ÄA’žÒ¸¿œŸ£-t]wO`AOŒó »ûÞxÍG3¥ ùàÑ;ÇkyŒ9“&ÊÝi¯†>aÿÊËÓZ÷`ìb ´}¯¸ûå (·h·ã‹Ö4m¤§¯i]‹ßæ¡þIÊæ&Š!ÉØ}•+2Û’ßô DãáþÅÜN=q¢ªÍOÓL”̨ñ-Ƨü(œ›þK3½a o\žý ÿü‰Áendstream endobj 268 0 obj 3902 endobj 272 0 obj <> stream xœí[ÛŽG–¸Ügàb¹ûâôùâ‚$Nr„)p‘xmcc¯íì&dyž—¯ú0]=Ó3» ,ËãÞêîêê:~ÕûúTLòTПòïÃ'ï~áOŸ\ˆÓð÷ÉÉë™NË?_œ¾w"üWÊ)Z«NÏŸäÙòÔ«SoýÝéù‹“¯æx&§à 7þùü÷e¾š¤žæ‹)§Ì¬8ãe<ÇTГ4Ý¿=ŠIDu‡ÏròVHþuŸvSÁYsøôx†}¤´þð~ŽÃǘíÕ>¾ÂO­œŒ²ÝšÓñÌD?àœh¥òÂ~G‹J©¢£õ•U“RæðFƒƒ¾­ΘX¶ÐZ»ÃGø”“P|”±Å7~WÆe1…‘”  éò!ÍAiÍ>ßXÒÆ›Éö’þä¨&ã£ìåøÿ’ N‚+Èl(³¥0 ì–ÝÞ?ž‰ÉÅhôáe>†Pñð˺ lÐõSxuxÔ”ë²]÷5é€Sð8×VZÕÄÐöWq‚8œœÿòërÅZጡý¥7"¦õµÔSô»bXÅ(±í7mÛi8j!£<<¥o|ÒwôßÓêV˜`hXƒƒŸsò|Tè LLãCh|8ÐYêϵՇÇqÒàïU:4Ô4¾;‚ÒFúæ+Ãáa:½€*vœåõ°ýpÙA‚²„(&óý ¬‡´ •Úzí¿NÇ“ÁŠP%f!r¾J>µ´ØèšâÀ²á 1*gÀ=> î7mN«i½dÛ<¡qL»q´|ßZw÷í!JhÜù´ìO‡´£²FfZ£8-lÀ é*õ¤ë¸eãèÖð©‚IwRG¯FŸ#&4éYŒ3ÇÖÂð¼… ½?5“Æ•§x}21È0Rjç"”>=ëæÀ—Y¡¦ UÑtá SåÞ¤Õ±(÷®(R€‚>Êê]¬Ú$ô“iÿM¹}øöHf¬~6šzÚNÏؤb 1X3e_#Üâr¡ šà™ô“Ɖó9×Úêašj©­J%ww¸h>£S#vÂ'Í%‡Ç¸ÓÕãä:Œì&/½ÁɆwá® ílÞ´„€Q>…[ ;ß»éÓ9Ù¹’ïˆa2£âß´€#3üŠøÅÏ;ó=ø¾!Ž9RÆïë'„Ô¶xmM'Á¬>ê¶ÁE^H*vÜâi%$Ìgg'§’Ûoœt¾õ†V=Nö÷6ñÑ‘ôHk?©jC%…í(ä¢èIrqÜM‹»÷K—+\U!úySìëÌRŠ"47ÔÇìlÈ¡ÖºÙÝe;YyòLÞ{òzSÙjÒq“Ñèò©³úò›œÓzI¥+P<ȼÌIc©OkG= ƉR•#–‹K*'p>BdmVÇèù’̉iã’ÝbuÎ8—¬ÎR—ÔˆŽKn±‰’Ó³ŽÙçyKV¹-¬Ÿ¢ØÙœ¬…ZÕ?F?ËÔÇ&3—FHÆï”íÂãBéŠ)nßžÕT‘>άÏoñ9¿ŠQ–BDkQgúKv×Oª:Å‹«5p~aíIrTŽè«.‘ùñKawÅŽrY.6ø­‹½.êc;Ù+¾3šª‡…f*Ø{2ò3ͧ±Š¥Hl· vè€Ð´&9 í¹"f‡è@R=⯲rYxÀu •ðˆ“˜ÛŒògmòf¹0ÑFÅï–QÒ»¤8÷ò5£'I7ÙÓPporcI4§ý݇rvUøZDKÎ|C´;™²2øùža¦<¸x¦Ãh×ßñ|[3Ïü†{UÔÛîL^/2à !½Óõ5ks@qL©ŸgE3zUÏS<ÓÁdŽYü½[ùõ™ï’ÃjÃ"n[w£^éRЋ¹¯¶Ù Z‘ ¸ ½^QØ@qª%¥ï«Þ@¢‘saÁ^à–=}ƒ/Ôµ²Ô«Úv3‰"Ô™¿8RBeîbî²ÅÃí³-rtÐGã‹oÞ8ždÇ»"Ùy…„ÀŽ`1BÌûýü–#)ÆÛ‹dÔбAÝ$¡0|ª›pA2OP‹º‰À—V?“¨Ì4R#87×Ù…)o¼¬j ½Šd!ií†íñ qétB`À„±Q¤ÔF’6ÂÊ~(ÃÂú ^8EÂLñ [ê¿•ts´Æe£ `dÌ$ %¤`´¸™dª…‚?$ÜZ/’ÝÐj¨êÂ&çt´h›7‚n8tÂðšê|R†TsžçsŠñtþb` Ë®fG^D£ÁßëL ¾)¥®³ÆÀÏÃåÔسo)zÝ þ˜8I?Š» ž9Ì–Þ±z—…¢Í(G¨™ŽYÊ8m;Ú ,åÌ‹Ù(›9B7¤ PòjIvñ¨bÆ@Ý™1þ&‰ª§‡–k&Ljï㬈EÁ ,—øŽ*”©$ba¶=&¹DìVÉW¸NÏÊ׹͉’ÀGøèâ؉ØÀfø ¹dµJ—ƒ°6f%#5rú7­ÿkpï>!ê¿¢éA{xŸwÈÞ€µ»ñ“DÉø;çÏV2·¤öQm"i»_ŸŠ³iKˆ´~rœHuºÚ® æÐMÈÖÖJ*jœ›dߥàK§D…i+ш"§Ì¸ò%†XÑŽMôÿ*¯g1µäÝ0¢Tk8˜Ó£f¯u¬~Ù¼˜”¢ ÖTvZk×´ pØ«â–}Eç°ç¢_4¯ð¤ž:n!!©ØRÆ[ȯZR滨†Äs.¡u¥œ ¬\â:dÃÞ¬D«,ôE«=Ë$]¤ÆW+Û#¬qNŠœ6nælŽ¿ÈrèÐQ¥ŸúܲftØ/Š«"­Šä™jéSÓªïó§„z|ÛF¿k£/‡´×môi½ìÒ5á }Æ£ËèãFûãq‘ڥϖڥà]3¾U¸$¾7¤½Ò>m´÷Ú(ãçÕm´O9;M‘\U™%Öó4º‘ÙMÎÉW%¼JôQ}2¥ªY˜)dt}LÀ2dÚôƒF÷Y£û²¾×F´Ñûu'GÅÔ`…OÚèç[+ÔѯH'PßkbÏ¥½ºÐ%-“AQšômq¹·+ÏÛèö~}¿~ÜFÿ8ý¬}~ZLÇ…µR¦ÓlœW-µ}tôeÆr6p;Øãác¬òfÆWGÞÉš:Y[¡ÌkçJ6°®u%yvÀ‚ê:dä u‘©2z´õq‹$ˆR‡Q»©‹Ìn\‡ÿ«‘qL€ñ7h×tí[Ê·‚z ÍRdjùÎcŽ³‰èª{˜#?Éwh+Îɘ¥’ ²ùöisB…ĬA÷2kQ˜Ý ]ïšfT\y©¶’Žõµ¥ç ëF^:lÎ ¢€n÷o5UņŽ×a*WõÓéÚáU§äü×¹4Œs"¥ð«‚ïp‘Wz}Ñ’½­ã²g7o%£§œpïµ5º¥Üµ&5rœ—ž"¨}Ö•Iiaò}ýó‡Ö‚¢ôG Mëyc-Ãgi4ô®€£}ãÞEŽ7‡·ÝUÁ²›ÛÄä ±n®~r¥ä\ueå ¸ª$¯U¥ksTUY¶¡f]Ñ\+†&[ºrý¾Fr³N^‡Ztˆµ*uýkXs}ÔšL†³Õjgá5wjØ싺÷r[¢B"NÁm¶+ú ÈÞmœ¢éìÑÓŒºÒ#E‡"ÛŒ6‚Ì9œ´2úTnï›i*Ÿ*^ Ý>lŸï¡ØrZxô„CF‚Ønl N»‹NŒš«ó‘JSÍj¸hJ"Pð¶Ç¾«°FAw³ ;Ú©R2Ϋ¬±Ä5Óú±›U›¥'s{Ãq«²f…s+ÃË{ïçÖ5q*†° ‘EùUͺm8cí 0ЭŸf½S¿ <Æq…¯àâP^ÁÉQÚ¡ãH°ÂÝáä1®Ýظ#œ\À^ç†bÜ„“›,7àäöVt¹ÃÒ358¹Í)@ñþÝ×æã–8o=:ÚŒé¡CŒ}ÖQœÑèöBy¿Rü}ÞO:$…£S;j4«~í–¯¯èý' ½ôk·Êë_ԕ׶Êëd6›OšÊÏWYTÆj)òdÔË„¥a¿ë¤‡ÒKV^n„äMï¹x딢NØLÈfWÅÒô›Â5J§»GžU‰Ø½‡Óž|šç¿¸± PEäp¥µ8§~m1Üv _ZÌÇ5ªZ÷x„kÜ:êÙ,®f¬ÖÈ«íê¼t°>°ÜçQàÛ°SK-w§Œ±¨“¨[~…$· ÅlŒ—Ø ¤£)òu¾4 PëØý/CٌՒútKȃH³²åãÍfoðÞkù¬,%›T u'UŽ‹,•ðFCogwezù´ƒZ0céÓ‚|¡45­¡¤~ÄŒYán«6ß n ãüÍà:þ Cø¸”/Qì= |‰3îå;´3:ÞaꊌPò±guìÞ€îÑRô[˜îY‡ù«›>ø?Ⱦ¼E×ãoï-á–•;cXî—ˆåRêË=ÔðâîØàpÙh¤> stream xœÕ[I\·rœs_'jšûrÈ!RÃbÉòÄ û h¤ñÀ3²5£$v~}ª¸ùºG„$ =³‹d±ê«•Ô»gbÇñOþûÕÍÙgÏÝîòîŒï>‡ÿ.ÏÞ‰H°Ë½ºÙ=<"ø_!™ÜíÎßœq¼UZ¤¥¬v"ìꘓ;g vw~söbùÞ3´ÖÞ.l2å” ‹ÛóN[ÃÆxÆ•XÎÚ å¤Y#ôÎØåËý6¸åk Ö[¹<ŸxZžæL/_à|­PæI҄ɪÖèås†ó€ó93Üi—ÙUAy±¿Ì6dýiHÒóÊ)ÖWG_ÇÃÄO¤¦<Ä"D¥´Œ›ÞIÝ¢gÒ‡;OGÜÌóL«©c­_*f•_Dóyxé¢K¿h±¯ÛäÍ^5Ä.ø &¥<‰E·{á™ñ\‘1hðDï"… tp¡›_vƒÓç"è_ Vozë‰û7Î;‰xÊ@h¿Kç×¢ÆD!]¥Ô0÷xDÙZe¦a&.NŽÖs.AvÜtä äðd”Ê¡j¸†-Å ó²"²T9©´tU/’Ö…Òe]«!è§Np¡$ÿ„Óyȉ|”3bÕ{3NRE†Ž,ÐáJæaÄÊÐQšŒQ.+t Ãyýà*ÛyÈòèÄJ³®,§C (®@(BÀk¦¦–S²1ï™7…å :”åOÈl"ËÞ‚(Æ”$ŽÃÇì3ï21}L„GeƉM6IȲq‡,å0)ŽÀ’',)qMì$t <‚)"6›ûCʯ¸ ½ãò̦ö£s*‹‰yB(ƒ`jÅ7Y(OT0ÉL­>¤ãºÛ³Cñ]27ðB…boƒ3KˆFY;o:Q¾,šÒ¨8<óeU¡¡1c— ^ b~¹¦KllÓ1Š3›$ßX Õß“ åÃ÷FÔ*j.Ä2ÖÅKé¬úHÄiV6«y(N®é´_Z®?¯:äQãÊ!bD„SŠ¢¾ šFz˜ÑâSú©mµ$‹vp·`›^•Oî"7D«eã÷ÕºïŠ,f†„Œ¯lzº¼ü5f+Ò:€ñ?Rõìhg<Ô= Þ‰\f±†}”¹±$k E#¥mŸx"ë_Çô¢MªAó»t<U&5bKÈ J Š¾ÊüÜãÔeÙâ +ïP¶<@J½Á†®³tÏ€ )ŒiI^¸ZB´2­\ÚÆŒŠW}[®ûÏiYH[V¸ ô7¸"ºKÓ”À+û˜±G,R,@èV<0ü|®ÝG FÝq6¤³¸§P@p¾”úxp…½ÞŠ[d•>(aeMÌb”VÓxM3Ìc%à˜fãhÉG(Õù¢,‘ kbÖbÚØ`Æra 5)‘®[ÕCÚw³Ï qj@Å©cÃؼq‘¹0Á¹äi0'NŽÎ4Y?s„PÒÿU»C7;\2î#![[=‰0*Œ ª3 ýž»™Dý’Õ ú šfOÓáŒLº¦nc&﫹uëòt™\]ŠÊ­Lsˆ€RÆ.îf(Ûc¶æI)µsT=œ\ù™Ý¤¥78Ùð.Ô ýÆ{U<å|ŸÅOkEçJ0 ŠfÔסDETñ4Ðz…¦½RJt¤„ßPI& Œv}=ˆÐpAu~’7{Z¦³[Zx4EÂ’ Nö¯61דÊ1ÙÊÉ H&ØŽ¡Í= ¥R·»à 9L;ï• a|è°"°K•¬‹ÐìÉÙæ$ÅØU%8xòYþ\4•¬&·Ohs´÷@N’ÉNR%í*AÌk-x9½Ê¤ij—¡iQ;„X3l‡ äÁÂðШY%‰Í¹+ÀÄ:¥–Vu Ènd Jû*ù B,þÿž Òr;€ÝÁÚ1ža) ì3âÍÉhçØ·zc”HZ\‰z×з{s2…€xâ>¿9³‘˜Cu}¥Dl*ƒ.'×z„^Ú‡`ïPk寷•´˜!}d½=«€:-+QÂNCz÷Só$½i´u òwFJëyõ¼Î\”¾…œ—1+#2ëæVF†Î:œ]oæpµ³1 ÒÝ·SeÀÞŠµõS€ÁU,´V½¸i›jã6‰7íÌrr†ÕÒ$÷jmÊ1ª—–gRhßÀ¥æÜuÓÁ{Cj½¿±M˜ì¢¤Rcb¥™Â&è‡N ΛÞ2œ5‘ŸÓ¿Ð‰@¹È­>šÆyÓ„Í2þ÷ÄñR ‘^2£WÊy´§TæHsÿ&Ýw,’ï{A(iç¥t—µšöÒÞç«,yO±œ•ç-·€å›Zg²ý}AÒÇ3äÇ`+k¨$Ñ®Ú×p'‡ÆÑÅ¡äöPïµ¾Ù À0‰qô6EùÝh" 5J’K_Ùÿ§†™©ÇÌôE5¬$.:¾ÁI©QMl…½Âà nï;Løn¶u!u‘JÂ}JŸšilz´ÞÀ Öð¶){:,.¸4S»š†€kêÍôk#$mñ¾AÛgŽZTÌmÌX§k–;+¹º!ÆÆb'èd–FŠÜò‚KºA+¥d|Q¡OÒ¸üBO¦2 t Ÿ*NTÈõòÐ 7 ˜·éÑD:ÇA+ƒKÇIEŽtÚ‰2ß °¾ ZãB7,°¬ƒA’–* „K[.Z¬D Ì:«¯Uš‰=È^›ÀSm•®“µ¶3xÁXð€iE§‘u/»€e G¨pÄK·RáÅ‹dÂXîf7Jx³cÛÒùÞt»&ÂjÕšŸÇ~ÁºvˆX!¿_UGÐÝ2UóŽÏÈ@/-*¡¥Q¥ëòEvjs>æÆ ´Ul¹¦’˪ü[G·±£¹ýÄ9x¼UÒúæà¹7ÞCX0ìbæaC |(3i£CJç9ÇTå4M¬zèýÊ\ Xð®’ÿ„œxåÀî2½'Ë›¼|×qÿMœk³kelÑ·éíC{‘çX»(H|d F7ÇÕ®ÌSžG!iHÛ¦G xËåÜîÐMºE nýì4Ò>¼ùè{åa|¶‡ÁFÎp–¯â5¤qf² °uB\ë-LÒàZ\ÔbË•p/⢖­ ŸµÎ» Ÿ{Ûq/C°¢?\AJº¼CŸ0àWÑUƒs´fŠp‘\_æé&ÞZC0ž°0‘xy„%W~J>gm½ðÊ5’®©ª „ãB…€c=[Bí·±!Xõõ»•- ¢1dåÁ@CáÃ/ÝNiWL.ݲv­+íSjU:0¹Vi4ÓQ¥³ðq#RgîVOƒòS3”ÓÝå5 R¥}Ø[œZËÖ’åÙnlRIߢÜþ'ߧ“Åðâ6Þ2¿:EüàíðâyMûrJ{Õh·°—÷éÝïù}ú e6 “tGüVïŸç9·DTû:©<ƒ'þOŸÁÿ×^}ÏÝ©òþ´r­‰.»= ûø—þE3#î‘`°‘8zOYÿ«€—íà§ÿUòêiüãó³¯àÏ¿Wlendstream endobj 278 0 obj 3377 endobj 282 0 obj <> stream xœÝ\I“· Nå8? çwìIôÚÜ—¤|°-yIÉ–¬Œ«\åä`k4Ò8£Ñîåß ÙMMv?fd;¥R©ÅÇÀ‡î;6òÃ?é߇O>x`w_±Ýgð÷ñÑ‹#:ìÒ?Ÿî>>Nð_ÎG¯µØœÅÑ|gÅÎj;z³;yzôÝ Ž÷|tV7¸ùñ?'ÿLãÅȳ8žÞ©x$Å(ËýnnNŽ\tÌF楗Ž÷ùh5ãôé®&œÑjøêxëp®íp~‡‡á m•–Ö ß¯šJèbÎñx¯¼¡Ã öåÂ25|Ž“r.¼Áù…£j¸‡­^ÁF†ÐW3£”OKH)ÍðMña (KbçJ—ƒSåÞO?Ž0©Sg³°0ôu£sŒ¹Î»!rTÞq×:[;ÊÐîN9—ŽU!ó±à$ œÓCx’š©â˜.Ò©;Îmu|BÀz t‘Ÿa;Î3i‡gA”ÔrØ£u夒@~>§K$Á’9ˆôÒ|8 S —ˆ훉§äS§%9ô¹$¼¸…Ï^jámS<@%(Å#ÈÄ÷Q&À~±Üxžÿ=ÌhëñÔÚ’$eF%½+% ìª=@’> #˜j ’5Œ›AªècÉ„Ì‚„› ÆZñ)`¼Âü‰”§¸GÁtK¦9Ž†-ªQZo| *j´##Pʼ‡uîüõ»x¦RyÁšÊ¨Ft˜¶É?®È¯õFPò“©Ô4#Ö†u÷Jÿ°胕âШMn¿Um 6´Ò&Çé¨bP#›í^Ô&)ݺ:ë™)¦@uã ˆgóQ˜rªè»ªNqê¡h‹µᎧ¤ wš¯ð5û¤@há6ª­8ÜÙdá–´ÁQt1$A ]ËÒÒs!ñ$gù8ËÊûK}9„Çúr(eK²âr£µ±Rú†ŸaFCñ$;SOòöÎáð¼qfæu<ÏØô&»#—ñ‘ ÇÉЗð j2Æyšgóa_Æ£c|J 2'®8‚dešˆI1|8Ë ÷.x6Þ÷@V¸ Odo‘…°9«€¼tÜÒPª(Ï‹[ ²µ‰lÐéá§üó£@ 0è´áøëiõèLu,ù…}e½÷„­×t<ÀV/QüžÄ£²Le¸ #„MNN­Á„>©S8­óù÷Ë,A{ø³I"ãßä¤/ÕÞiª<)Y)i±HøÑNV·ïJ­àœ<1}ĦüpŒlu ½A 3…­"=»v¦´‚°œbÂÈ|/ñwÑCòäJ+1©?E§Úš–±ÖÐ\¸¤Ë¾†Ä{ÝÚzéÐN¬A¸æ€TM œ­àÃYüé53ìèx‰h\'Îöü°Ÿ]®tÏX«tÛP˜@TFŸÍiß} „,6.ßszm÷­éÀžˆõ 2Ï3;¥g¤ˆWÄg?„<¶–pÉ»˜G>G’œ´`Ð.ŒNŽ¼—lcò—0ăi1MÂt’ô¯&§tz@J‚‹T8=Ûò-ñ¯Æ¤…ßV3)ìö昄œ©i(9ô¾äLíW³ã(–zcï”Ý·ú?ò1ºkîÓÃͼkG9Åœ3®µUŒ‹½µè &yp6Â}S¦)aê}1äëàz0­Z‹Y剗\ö–ÐÁ#/—ø—€3›®ˆ’½Ó™±2LP“w³&LÔûVœ° >³1S䤫Ð7h@IüŸÂµÎ48MàAB [PŽVH²ÓO…Æfzë+y ã(·â..1Úá=†.TÁ‘ÎÑ<(Ïu‡5÷ËzškJÍ’Ó°‡…—u|VLb³Ô–…Ú×â3'-qPó™Üˆ8$’¶mÓĆe:Ÿ»„0êæe —ªºI°)þŸ»_/-UÞló Ê‹jSƒûãÉ£<ˆ ‡&MôDYá ÎÑy+ÊaG!§8êUŽ¥ßÄG®°_æÖg;¯sëyn½Ì­V€ýY³ íC_Ú“0Ï)ò·:“„ß­f_òȶú.R $ÓZÉ°_€ù4s’©F¸÷iÇçS™çöÔFÆþH©ÃŸaöÁ™›Æ\ä6ÑX/Ò`CØ5ÏørnLiQlE±ÁœZ9å7ÍsÙ<ôG¹õq³$ÂÌÑ1M'+;$.z;÷»—û}“[?έwsëi%3ÜÏ­rß;¹õ“ÜúEnýW³õ^~ü* ³)ÄöyS6¦,4>Òœù]JE­GQ.æ¾ Éè,RO¼\šHnè\ÈÔüx1˳XÐ'Íú2·ÞïÐÔúm–Š¥nb‡…J‡Vº]±¶±¶ÖWˆÒªÖ×};'+sgBEËjƒäŒ"Úß9i½’ÛQjdJÇ$'M^à:ÌKh§¸ ž3¦h µ™AXG¥BÈÏÞ¤èçñpÃâ•$¥‘kˆ¢oŠ/ã Ø<þ& ( /mPwdÈ+ÞÆcÒ (BTu dÅÊw¥BàŸ_O¶Š "˜2*RI4óô:¦ç4Ps6g´¯;Kµ 2Z˜A5@Æt÷¿#ÈX›®G •ç[¶s²s€‘À¾z“Â-‘Þ66%4ïk<Þå0{ÓØìEOé/ί#{MÅÓzâ-½óˆd€yŠò˜§´P#;ºÐY¤|[¢'Ã'%b” ò~7ÌL˜B=Wá ´«ó÷Ö*å|~šø¹ê5ÇW®¹ny›%öúJ2®I?,æ^‘«V¢^1RXHÏ?€H£‡r]°5Šö·%oÊ ‹{ 6¢ßêœF¼EBu-#×Hô-¬ÓÛÕ¹oK•t¬ «þ²pÌ‹{ ‰éñq&zéÙ€ç4Ùû LmÕA€·ÂLu›§KxÏ­(‘ù #LOLÖÏÐé5˜/0f¦{{´Ødáé‚ùˆ[7À|=2’‘Y8„kæ´BU«BE6kx#k@‚ÏfÈu@¥Á­u“lK^„_Œ"¨_[[ ¯œÓsknb@_aõ™è@âBDñ´3¾d¢hmï I‘ór¥*ÑR¤ý7kp×mœ¥6I:D¼ /ÄìC–N±ÄbØBxˆE ³5ìÄD„bÆN«y§e¹Ãåƹ–MRƒ¬ÍRSSo…ÿukȸ„T»©bÉ O ~r=À¯sBÇÊQE»F –…’7°¬˜ÂÕ 3ƒECd:¢/§™"’³|½®E6çÃsªð¨Ë £iµ“¬Ér+Ia‘\ÔX]U :»à¡–0ŸæJRTò†–Â`±Ç3ÅgsìN¼2¾^óë%Þ[Í ²í²ãGnø2ÈÅœCäÿé–¶<Æ)í¨”\ÜýlKSNI\G:­Íë—ËÀšNÉU‹vj¯^„’–ÈE Ĉ.Ò”]90˜oV û1GpƒÃM;À¾°ŒoN³ .“‰=3à ãmˆ~é…un•'xä`láÓµ.’¦wJ/ŒÊê”^;ˆ•žo|ðWN~\"ø6`Q•×” °à"sR‘‘|÷+’QG&uú«*`Ù f¯´).ÉA±T¡&È‚Ô‘Ê‚ 2šÄܱF«£› œTñkiy’“É6äìX„²7ü9„\ÆZOƦ«my*—Kh ‰=˜íP3gœ¤Á­²½ê–2nOEEí⌒Í:Õ^áŸ.i_ Ù]#d?ìVô\‹DƒÖ¾[\}å Ž$ r­ìoáìã-€e®00þ]Ë$ÆÚ–Û7e2lXnƒÐ¿c`Y6Ö;mËs£ ›o¥ Ueö·›õ”U©ê}\f=Þ;N=_5wÿO!k"úmŒs½>(•R( Y¯Ð’4éP4iJ/§2I»¬¡dTZaY±CØÀÔª–LŠ ÐMæ$ÔÝÌek}kv`Þ×;rÕàÓ6`.󋽨Pip‹Y~óèð—e•Á5oÚ^¾-«´÷Îõ°í° ¸©«<,¶â ŸÍ@®ò(zùõÐx™+Æ—oDUéRnF¹Xm€éfT$5¹Yz软Cèö7w¯|šÀUŒíV"ð UüuedÀ&2½‚ƒìçžo§GQÖ¿!žê çäÂõ,07Ö.Ũí|ÇXPK¶;ÚÂ…þp½ÄZÐêÐÂ¥ÄuKËMùø¢*ÊZ"ãQ¢zñ% %Û¯s51?5®•¶ºx¾/5ˆ¢áåþ­ïWóÖ…¬ž¾Ã°öNªs«wPDáñ-Ó÷þB¬ËGy“oÑg–làNÜ Rµå v L_V¢L‡ezM&8?å<FŽ^Žfùb1Ìj´îÚ¿Ö–1Bf„žÍñr—7[¯ŽG8,@)Q™&‰¾É霔ï`’¬¬®o˜Ä¥#ñz1IîÖ&,âÁ©µƒIJ²öUÁZʘMŠD‹sMƨ¢@e-ý/ß÷˜Âe×Þâ— x°ýk„K—æ¦g`%¸…´ó7KÁ))ê*à¸uÔK[¢ÞÒ:‰…Ú%\4ký:³³“çrËâ½eê)ælê­ôwzø(‘Ë«)ŒN×€·„¸oññ Þ¢+ NWàËGʆuð{QÖ3”Ç)þs€ß ó>^p·³`8“Á@*eˆ ¡‘ù¤LRY¡B¥¡02)öT  Å« ¦‰R[ x§Ž¯ QZÅ›¾)˜É9»õÖdü¢×drœ;_ru¤e£pÇfC4]ˆà!<γ¡½…5Y‰“žÅVåB‰†sA?¢’%îg¬çÔÙæø¦=z\X5*@¨W§™€®رä¯#_•$ ÐŽ»fºiëC½üNéKd£ÐÖI‰ïÍšdÑ3ȇ@—nyiÍó"&w±¤…7ýÄgiQÎ×ÜÇxj‹„—±ðÏš:Yvã z›Gù‘ zU"ÙOû(í}úôdé“-øu¼fÝü\­Át‚v¿.4c„Ô’ö­ÿÊ|*ü+v¶¸f»T‚Ð_Š@ ¹¿ú¢ ƒŲ*`š¶ã--+}ñ!¦ÕDê\ vâg'xápáu‡™6¶ª÷a£Â¯Æ’åg%SzÑf©«A'$ÖÒL*ÑϬDD™z*D*'k‰îÞ˜ûÖž_ø,“\«!'še kžê?rçäèkøó?—‡qendstream endobj 283 0 obj 4182 endobj 287 0 obj <> stream xœíËnÇ1É‘‡ÜrßãlÂôû‘ ‡Øò#2ƒ°s`(Q&-Ri'ÖߧªÓÕ==³KRŽ)À0 {kª««ë]5~³a#ß0ü'ý÷ìêè÷ÏìæåíÛüþ}yô戀MúÏÙÕ惂?¹¹`vsr~ÄFïŒT<¢2Êr¿™Ö¬ØXmGo6'WG_Þ²‘y¥”3øݘ´RúÁmw|tV‡ËZ»‘I>|´å#ç›á þ.œÑj8–K+t^µÚ Ï`U3«ìðÉVŒÊjf†R)©íðévs‰¯½ Ë­°L _ Zoœÿ:ùk:.,h-ð¸‘Y|£¹™©N§Ê)üôˆ8vJYÞI3úÍÉs€ýO/¸ÓÌ ¯·ðƒÓÃ-R/4œó ž¤fʧí+|‹9ë8·tý0Xèá‚‚\ã@˜¨v|ÈáѺá%"aŽ Hø¨ÓzqËD“Ã1ìèfî†oñ4Ã÷ÈD Ù)ÜMZ>j/«¿Ži#d$ÖÕð6’¯œÜ³³%nIïjp‡»@ ¿û‘kµ²s1vø6ÈòÖ/27Þ„|á=5‚ô ÿ…£:礘0Kíxb¬Ÿèñ6¼dá%ùè¹&Ë‘\᯶(GRêQiP¯(C…éê„öùþµ5 7…ôš¯x5ʨ˜n]Øh6ÊŠ$^:\;ÏH¼Órº´ˆ±BOU¯DžYk`WàƒCÝ«ØC¶ýOÔXmty-hXfÍŽƒh(&"‡"•Ö¥›ô N F¯Ÿ¨Ûë  å¼RŸP”gI½Òu ]!´'«œ%8ž#¦(Á$\ w‹þm‹1#Šéš‚¥›+šB¨$jµèkÿ¸–¾ö;á†ÀÒ,yÌ‚¢@Ô¦±ÈÏ\< ‹1˜Ëu1r1x2ˆr"3³› ¢Ó1ñ%ŒCmI2ë¹ywc=«%¼€‹ ’¿m °u.[ –î–`­,aæ.r\tWÓ]Óšh^Æ5ò®,;ÆŸ;eË‹üÎ ½®¥ý,«B…›iU-­¢ÐL2öôèä·_Rz®»—þ¢¬¾ì®u ¥#DGÆ!Àq{!a•w/Ó¿]r¥² ðª%2±£•øe¼/z°È:ä‘£ÏÊaþ^V?(«OËê“Ì$3|ØÅðIYý| C^ý'j$±ªwhœ8בK8¾¦#3í\R’=Z”¤1³TB|b½ÍÒøÌÕšÙùÙ\ýæ*´Ž~6Ww5WSãàé;²\Ÿ—ÕgöIYý°¬~\V¿è®~V?M*i:Ê÷žÙ³YgŠÉ$&!&‹}DéT(H…·èVV°“‹ ’qQ‡mø'!$L’¾#Çsžà*1,™'¸|1cv ¼–{a¿1B”êLJ²<×ÝDj9ûp«ÙG`’ÔÌJÛË߀Œ:ýø%ö -cýTÈ€k]M;׉¹ ·r‚~J…ܦ&žt¥ÄfÎZ¯@<&ëIKxq–´`géÀ¤%5À‚„:[·´ ¼Ëû©¡Ü• -G³’$B˜îEØQÕR±Ü@‰¬á5‰Bò`›~¤æp¢ þ¸-ß×À#3¥ðÄG$ï%45häw±ü;.×ß­êÈègÒ¶eèQ‚µ^ÉËé$‰âLf“ gÑ“hJ–M$ŽCU–³×È ?Ô£%Øãâeµi©­õ¯•-_nq—Öx©5çÖU§¥Vºðmz¹§¨P!k5¤ë¥Ù¨…öø×™|Í â…ŸÒû}ÐwYGÔi³4’Dš£5ïBÎ!°ò”Å5#ÉÐ|ŽGšF~”–s=G¢±ï?úŠÜ_l©àÉåÏFq°ÿWžÈÏo·œyÐ&3o ÖVe—øUOqÍâÖ6X­cÑÖf;šz&5–* ‘ó¥vá_™w$ºÈ« VZhÞ…ýwp09‹ÉPi »–¦¯Ì“á^‚>õʆHñªnæcf8”üú#8·qccõâœe lÕuŸ—¨;Þ„•oŠ¡¦JGì1×ñ=aõŠEèÍ°$‚:ƒrÞÆµÉ †å «#$óiœëÆ0…-ýÒàL6B=i¯NÆá‡6Q Žñ´¬^•GR¥xÞø˦ŽS7¥›£b͸íF@² Äý!¹ÔJvƒík«ûµNsþÝ)ö›8V¾Üwh1Û@ÇþG ÄèÑ„yåmEðíË=…Ù>uøvï}ÖûDû> o!™ÅቤJô|ÙŽ—ò5¾ˆVÁµ–M%†z§·vMTg˜&Í£[‹~è4™ñLÞ³Ÿ•æˆ'LÝtF ûmôfÌècP8ƒÓ?•ˆêž'>j½æ 8AĽSIé΀<Ý·‘~X M¥ ½/ñ4°©y]JakÙMV<'ªcÀ߸Á™«ç$Ð<îÒ«ë;«êôß;-Àk¼­uñÎ*ƒ+°b*ÊÓßS‘”ÊNá´Çi—‹²{ßIkUE2×_Ïèò")yËiñ8Eӌ̲-ws"ÙwwéåÚ‚½ÓïÅ@](¥-±GÖ♉ð]cZ–Eø0XqX¹6ë§;ôd¿‘J”sNw:L_Ä$ŸuMC†9þ˜úP³Øó@“×ïž&ˆY¿BðöKó§ÓÏÌç5þ•>ÔŒb‹“wÚÁÓÇÓ‡:ÄF½7œ§LséZq³`Iüˆ´,Ìéº,W¦‡Pžå±¢kæn×;E‚ ú†ïj×MùaeHÀ¤;‹tÃã%Š„ßEAH‹ŸÍºXR °€ãGI Âç%§†$ÝÇŒˆ~­"jÈï¤zœV…™WÃ`¼ã‹5oÆéÊ’@ó¨ã¤ZI³‹îGo;a wb¡ººV$ gÔ´ Ôÿ^Ž¬ÒâèÁÕµAöà浑ýµÜòÕMù*§ù»ÿ²gás„gzôU]Ž~œNÒç )åV)åþÏ@ëÏQ¹äÝ"ËÁS욶böO±û;L±;ŠúAé·›åÐ÷coº§®*oí'wLYXa¡3öáÞ7N²åŸh\z>N®±R¥C~¢îÉŸÐeô`©­éQ%G–ñ£ ”?”šõ‘rœâΛðîw0Ätôû=Ä°€õïÅz¥çd–§Øq@Åï݈©ï–­ÀóNÉõ,OA ÜçÃfBÏ \5ÿÂÿý"áÿþFCUn¦YCª4cA’V÷ÂÈ^¾o>ƒï÷ÈÞÝ;½sÝÁsÙÒk>ÆË^u¨Ô‘.;Õ!ÙÁƒPONŽþÿü¾ÊPendstream endobj 288 0 obj 3640 endobj 292 0 obj <> stream xœå]“7‘âñø û¸‡½ƒ¤ÖçC1*$.U $þºóymç’ðëé–F£–F3»kŸ¿ \©è´-©»ÕêOi^lÄ 7‚þÿÿîéÙo¾t›G7gbóüïÑÙ‹36ãÿ¾{ºùøðO)‡`ŒÚ\<WƒvAÖüaØź;”à$4´ê‘"…B.£Ü ÊãŠwÎwÆš€o¯h™BÛíMjJí·ûÒ{·ô^–Þ±©¼VÛïKï7çS›0’~Ð2„ÍNº´@¬îãâl–}™ûe;wì}ÔíÅЃ†#Êп[z/K¯œŨ©V"©ph†›;g!5»e­î/"\cƒ>H>r_;˜ún8çp—¹ïAéû~B'nCÁrsñÙÙů¿Æc=Á}QúUéý¸ô~Vzï岨8¦Þ/ ì½Òû»Òûiéý[·÷‹ÒüœÔˆê¿û¥÷ºðVu7Š1ãyeŸ´lû"ì7Û™3),k´ÂÀšãÒj|$lP› ÆƒàÓá¤Ô€{‡ÚQpëð¤/í§ ØFñÁ%ðwo„ß>¦¶DË€ 2ƒh½ýwR1Άq2Úø;lîZ¨fx5ž$(¨Íñð™„4j3†´W¨Ÿ…FÍñ}NsxpÊ:Ê &‚#ÑzxfÐ\K bð“r´¼—à­Ú„w8¨Á{!ü&ª_jÄAÐèAŽ-G‹ä±qÈGÑVjTºiˆR8•´1ÔæQs‰Œþ‚ÇÍû±Ñ[ÏŽDNçÁ$(ÑüiÙcš+¤=ša™þšaJÙ°À°ÌaÆ0„…þmV »“æ%ôˆ‘]êÍÑÙuu€;'‚\µõ³Ã´ãÿ*nÕ>cŠ‘è´ÿ³1v+«I ¡­Æ3…GŒ GÉ{xrYïä¸0Ú%)SZÈzŠŸiqt¿Ðò?$7 —³y©Ãƒ)â=Ë+‚52€é1ÂÐOe;ÑUS-jæ¼rrPD0Š#Á•FT5€s©ž6âì".¾$hÜudÀmµµ4Ó]‰G]€ËÄ£à ø‘·Î«ä<Ò2ˆAM0aJÖýOã¢ÁK#I€Q¶Ð? s;o*‹wÊã!ÑÉšÔyVÌ"¨}žûPt#ã½£í@²Àá443úuíôèýzäáC$ NÞ5ý#‹•”ÄÌœ${dµ4‚ àï™1y–|{d³#Çð‡ v_¡us3®mo~Höi=Œ¶ßžg&d:|5Åø»\ùyjÐ4§¿(˜ÁNš…Yé3;2]¨i›ÑÂ\àÒ¶ïaã˜àstÙ¸¤H¤AˆJ}Ü/Õç$8 ž¶|È˼‰çl/ª@9&‹n‰Žb<95?íÛÖ»Œ½Ïº°Ìÿg.;󛌎ž³Q´ÇÞ‡væþµ>ý˾óÖǼ™K×z…,BXs[§°ïŽ¦dàO:NüõZß“…égœÓÔ3öU± õ9QE9w§Î=gXî¼; ÊŠåÎTúuD¢ÚâˆìÆÁµÞ¼Õ²?Ù‘×Méè D×îÀ˜0šà裂֨àz¸˜á•Ï{Ô¸2ÆF}‰H9¥ žm_‰‰J‹™6ž1(\½_ cCK”B¢4²ÅŽÆW„pÕ0“}ÛTáAêœÌx”þ­Ox¡­ºU궊)±²„FòÈkS¦wÝ­Ë™-Ðx§ãñËt\0½y©¹6oM(ÎkÙÙ¾‚GÍž2: û˜ÿAû ‘™Sï÷Ä mª]â7v«¼(Öñ”N³[g¦^‹~Ož˜`o°×âÎ6±q†<ê™ÐÂadìl.X]œ*ÁÛó†v `°f%‡_ùKµBô@JÁ°­Qt\Œîii7¦Ýtc½]2‰õ®WS×Üôƒ`ÚôéX”ìÏÜ žgFâ !dеäJs=Gs÷ÖUö¦ïØCÏCïšm*ç+Ôº b­=…äÑZÛs8£Gë-öHôE òÓ8Á£5 ²ëiŸŠÆlËçè"&Gã’]Ó#q‰“\Ú,ƒK’Þ·„ ¬á2ÅP;ÃÚ÷c¯Rä=Ù«·‰K»W­n‚ÈGgT.wT~Z/µK6 ´êfÖ§|­"h¸Þ[(“°b؇‡ –ÍÀ,É,Á=¾ÉOéÞ‘a¨*MNB™1%Á’±y•ïºrˆɽ˜9âjéµd61Çð,y_‰Ç  –@•«:˜8!´Ï¥ 3– BúN¦ãýM[Ï Ï‘ikè&¥n5m½”ˆÊiëK¾Â±wOƾ&[EiÁwv]ˆ-Ìùn»¹µ… C³Ü'§ìNxvý¢6á™. ‚’¦)ŽJœ+§Ñ9¥kyÌOe?OÕýž2Kë%_Ó“<ÎV{8@† šéavË òœ»—~n©zýÞPâ†[¨Ž—ÜEeA;)Ùˆ}Š«žP6!)I Ĥ„cììma‰jŽƒŽÙ–Ól}·&}‹!%m¢$OÄ/^ªˆTQ²¥¾T1²P'‘bµ]0“ˆvMô5¿sQ æn’y ±èåL’Å&¢0+ú•èÙÃzègéüVðÈä$j}âi–" žr.3è×ü&Ä«ˆ…¤±ó´‘0KEeLéÔ4^–qv£hÒ6q¥5tÓ÷ä¼WIµÙuÏd$W„D×wóƒ<¾Ð¤;Ó.š*Ñ9²ÐD½ÌýçNyuû¸s¹¬=©Ò䫪Ùñ76â *ÁR£ú G‰.°|?ô~fLÃN_(XÿæFEQ~ɲ«>÷D½›G1c˜[ âv¿ÕÑý¸ Ë€Ö\柹XᲩ œ2‚VŒ+jÖåkîó—Jžq:=BYM­}n­1{",1eS÷¸fÆÀyí·$Ë|k6Ÿñ­æu]r»s>~ ãÀ§Qâ‰S>)Òä&«ptŠ~ûw5›ÓÀMsÃ1; ,Áa›R#ð$ÆrÙ oÓ• CvcùfVýõw%¢‰L®ƒ­ÝœJoŸ¢ñŸÌ·Y‰2ëÓ¤¸›/»y²Vå(%Kü¸¬p‰[‚‹Ú)B‡¤±êVC‹•H|º]õrú"J½/?ÔÐÉuÓVyÉW|Æ.ÏL¹‡ëi"rBÐpzáøø´¤ÖlÅkÖŠ O¡9Òè,@ÁâA™å'ž5'd?ï >÷ùDáëíÖbÒ‡îÊ'døÞÜ»8û+þû/j¿ïÆendstream endobj 293 0 obj 3939 endobj 297 0 obj <> stream xœíYÝo5G<ÞÃ>îÑœñØ<ð@i„ŠJ é!Z MC*ri›ÄÏŒ½»¶wK¢RJ%EqæÆã™ßŒçÃ÷º“:É?Ãßgg«/Ž\wr±’Ý7ô{²z½‚ÈÐ žuw·ÄDÿ‚ ¤ë¶/VRoµ$Ê¡›hNu¶Ûž­žô_­¥Áãm/ÖbÓNëÐûõ„wÆz&#z!5ô÷Ö T°ý!®¼EÓoI„íŽT‡¶?"*Jg\ÿÝZ ãPÚþ>s£Ñõ×R€–ƒ ƒ*ÉI¬rÒôYl°ÞªŸ·ßæQ±¹ ,肶²³0-“ e:0BelŒq¼y£­Ýöù„Œ" `Dƃt#2èBEÖ‰l$ùZ—òYºžôŒ² oÔÊî7–Ü …Y?gH'±%——ûäÖV’\ !ŒÜÏÉB핺?ž´ï/y‰^#”Ô7Œ†Á`<ôg‘¬‚Qýib6Úö»,í—¢‰j5yñ2ó^ÕR”H×rèÆS òáFá’®Ûuröý9…ˆcgAÿŒ"K£4a<‘ý;c ½u".s¼åpB@‰#‡ó®ÜyÉt¥gÓ•óÂëšü¯¸¥"Ådç³c² ÉÀà Ç(æ°ðwÁ,œ•`g.G ø–hºéªöy%ºÆ2ðRúìòéÚNêÏìfjðäpâ4^"²¿É‰RB0ìðŒÝ.¡¡‘‚¢Àq £Uº”Ô3ªTÏzUD’-‚Ų“hI¡¬’…‰újZ¶Q$<3Jû2ªD«3š F-dqôg”Ú(Píp}Ñw”FœfE [Ñ àMÚðŠ-3”Ä[Ó!mq´•o¼PѧŒwÚpºÖ‹ÂÀ®Jv%lÍ'ö˜°±nhd(J¥;}S]þ¹….QxÖEí×ÅFtþ%]ô5º¸`ÃÍuy7™}ºl —2Š° Šÿcæƒú麘¹]üþ³1Sçk/BÄq<&n9á-Ò+­Çü‹ÎRöGê–hóöŽ —¥µn®˜“ÇÚFË¢œÇC P­6ZccÆ%¨Ýy³ÏAÅ[H(Jlª» M%ë‚;A² [¥€ºWJÖc:~•ÓÿiÊùÔ^ÞËÄâó—ãç-<5©ä%Œbˆ×S‹\iî‡t.˜Ñä[OÞsÔDÉÁáͶƒqGîŽaÀAo‹Qêy·PÛnÓFß¹!L.rÑ{›–`|ÿk¦¾ÉÔó&ïe¦žfê.S)L ¬àlÿ"S_dÞE9ŽËE9Ž^xÚgò¾}…÷"õ UÜ…#ï½&Ã˹„È[wQ2(êäé‚Ž8¤ˆè” L´ãæöt]õSDÐpe+Ò~JÎFB]UKy•"ÃVªõÑ“Ê I—µÈ©“FV¸¦öF¥°Y½u3 (.\8B –:Ò¹ Ì\‡Å<ÞÛ8¨cg¡4{¹Ö¨àŽVQ`¼²u8O€{§©ò£ ?»zWšÚSˆf —¯Á£.Q^¾ ¤X¾ D-¦æ .õ £ u£0¢£%¤Ë¤¹ÃfÄòý­øšQu0·¼Í ƒÐ:¾Û)ïúŸøåÝ‚ã$k‰¹E™Ú³²ƒ‰ÞV!€S“¯®Œ­A°²f9úÏæoTÂížäG åLsþöqZ`Ñq(Éè’• åzØo«ýÕû g+¾.Î*~!¤` R¶ÈÍg[ù®ÒaþÄP¿ëáYäÎOÒ»¶!¯ÝŽ8°¼8`sÛÔŽk,äwÍâ}æƒ9]ÝÆJýQš¨ÿSŽ|_ájöX9û’ÒCy¥ÃAþ£e%³û;[i‚’v´µV·²²q˜Î©b! ,kšB¡z‡;òô-òžã(u­¼‡\3<ê¼÷ñw D4xP™Æ¢;û!âBŸ{ߢ"¶Š"²¯žÌ.¨nfÃE\j³ÐÆK1gäø“:ï½V¾îžfýÉø4sÕ÷D<)îç¯7ò“ÏÍúò455Ûã8›$yÔ•2ÊVëÊüxÀß&’…1Å aѵ„Ä.MÔ‰ïp»ú~þ_Ða¼endstream endobj 298 0 obj 1763 endobj 302 0 obj <> stream xœÍYÛŽ7}Ÿ¯è·tGŒñ¥|Ë[ ˆ„  Šû솋’°K—äCò©r_\îvÏÌÂ"¡Âëõ¥\uΩ²ûu#…j$ý ÿŸžon>ôͳËlîâ¿g›×•4ççÍ­ÒÐh>xÕìžnúÙªñºñÊ üãî|ó¸}ØIá¬ßþÞm•Î´O»­^E+s·ŠíÅÐ-LÝ.¶¯:lI‹§ÔÒ>ðI—}Ÿ9ÙÝC›ÐD¥D´V“M „öÑ7»û›ÝçÛÇ8Ô;|{Fó±!mû%(#×ÞÆÆúvבÚKhÐ+•j#Í \hCß4ε'Ý"®àm{§ Qh‹“D·ÕàD3îä,I ­šÿÿnÉìiûh£nŸ¥S©cû7Y€Kh_Wdp>JG3é”òí¯Ù¢ÃŽè®~EMPÉKcìp6ð¶²xøa9‹nv|¹7Ô¶ZY¶_ðíÙže+@ä[~‡<…Ã-·Š°¢Mûo6HqÅÅ”·{ÿLG… ¼£´Jc"…YnÛ_É£},Í™{±¼“owÖï¡50#™å:‚“1 ¬#`ïÎÊÿu Ær¤÷«‚°ÑzÖ÷.o¹M€“F·:‹ki9ÙÜ»üg ²½ì1ÅœqAMðx’a^ ÖLî6ÒY¥ˆÆêè3´PZz¢þ-8ªg8òPÅfêÃ…EÔóFD×óõ{t‚PJá‘N’V#ˆ_r3D¹÷Öx/š­ò ½Û2ƒž÷'uûOÆú%EycÆõ¼1±? ª£ó(1ÊXäVƒ²"œî;E3!Œok3;MŽ…Ÿš5¥Ðèãê'mŠœÁ3ª¼D<Ô|ÒðýG+¨Û妢ESjdÜèc±·ÇQ,`¾F²N>éfêvA¹ŠJQSV¾©pkÙO¦g‘ÙF<jIƒ§¦÷YVׯ°¥”F|§Á v!Q ß WO§ !dLœ¯EòùŠáˆ·óˆ‹!í#κ1‡Ô衼&8;ƒàpv'Ãv`©±f`i Òpµìí&þH(ÃÖ[‰{•Ò3£K¬]hÕ#颭¶8Ô¢]£…\Ã\Ò‚±¤Áˆ¡ÏThQÄ^ÜÔàÑŒL¹÷JkÛŸ{žƒÂÐJú¶×-ª¾Èn™mRÙšYÌÜÉW_ÂÎYB*?×C´2éa$ßÐ(´X#°£Ñwz…ÈD˜`…´“£wXI~\4_ôyÉJÚ˜4+¹1XäF'c Ð-ÂÖDè˜u–­!#—» ‘»Hˆ}ÏDáDZ$Ä„…=Ùÿ½)‘Á¾Æá±ä@–\813Γu)¯¸(³”Éí½âé=Î:hCjDC4½àA«1®Êš8çšZ`&Æ’¤ð#ƒª¡²šPeM9ˆ$ï•P=ŸÆ¸g #¶s«í C»3ÎQ.^M‹LKC—™6ͺJ¦­«…«öžLÏ3­Á?˜µL›å‚áÿ­àbÀDê«^E§ÝE¬ ~” õÄ–ÍeZ†èR¤)7–Y•O[Ä°O{0jTëòG’¯Y\Š çgÇÊ-àƒ„ÂGt`c&\©tîM•5ÿ3¾ƒS ãn±Ä©ªh”ûù\-×+:òò™õ..RÖIÀ£Î²ê@ƒˆÍý4€5|†[D&oúN…i—¥XVMÔ><ó¦Ïµxó=:×~ºxwQÝXXùéáÝL,¬[üjî¨>`ˆ®ð¦Ê:»x7#_‡üPíÍ_²öcÖ¼x¬Vv¬†.”P\ʺèVxÁ²BŽ*‡íC7ævdVóÕøÄd#öð3`©\”ŒÙ d„±ý‰½qæ¬]5XÙ;•¥+»ñžiÚ|Ä(2{#!cùÈÇ™Ù?\!xu~¸âª½]±À²Ý†eA:Ÿ£d—orÑ£]0ý­€ºèdµÌ~L/j™é*w—VéÁò Ò™…ˆUÀõü·nÚ¶¸³$O#€‡^mLñÀHp¯öä2Óú{{¥ö' †Î|Q€eqG\(orŽž§®ëJ&T¦«Ð@4hU/׿0¹ž.>êcäŠ@,ö¾=€ 0ÞPSéj~À;ð² :ê‚ÃàËòÛY•ð Â¯\ ¾¥i^yŒòýœ!XÆžŠŸX}HæÓËt¡Qì¬æÉw~Yªé_¡kº¬«€j `i¢†P–dO ,Ù­|âà\œ ýQžâ<]®¹Åû«nÑpt⪠b(«—r5 [å*Wj™IŒªÙù~M2s‹)߬$q‰ÿ ±,vìëØB‡S™Ï_¦Jþ ’ØXwÜèÃçΫ>ï¸Pöùl2÷-ªxFÆ£±5]Ñ sHL­yüËÍQƒ*äêÕ7,«¡O+t"*ÁèAꬼyL9Ý­`åìû•KØJQ¸ªd&Yا /‹sÄä§SV@³oÂésA@‚q~±OÕ‹âWÅÙÓ)ÿÜ0|ŸþLJ°ùˆÕ„xŸœÂ WóïñF/T¡‹¾`²©º°ÿëÝæGüùbÇwendstream endobj 303 0 obj 1972 endobj 307 0 obj <> stream xœÍYKo7>ô¦_±ÇUÓeù~k7.Zô’B· ‡ØJd#VšØNþû÷ÅáŠZj¥µ\i‰~œùæ›!ó¥ „Ôÿ´¿o¶‹Ÿÿ2ÅæqA‹ßàßfñeÁê Eûëf[\¬`——ÄXÊՇE³š††)Âl±Ú.Þ–¿/+J s”ÉòÓ’J¥V庽_V0Ô0£üÞÿ^ýö%/#N)îí N¸¥°ÕŸ‹ÕoË_–'N€’öÃfÀDë'BSØVkÀóL–šX)Jæ÷³Fj‹†©­«ÎFÅ ÂÙÆTB%ÊÀh`g)§ imÔh$À:My9 ÌG’9w°ÎÆ!nG3«›8 iì\ÌJ~ i’æ M "M“G‡ ñœJš °ˆ4=›'ËPIPGÆ'¬ L â¹6Åm`3äÚvå‚xw^4ßܽXÐRnO·³¨;Í9"•DóP¥°—U¥c ÛmçU¥dÍÛ„áû0|zyñÎ{Yv}ï/涻rÀfv[ë¦Ð_zóÒe=F`ÌMù°ôe¸½§½¬[¦XÚòSS‘Àt·‰ÑÑ}ñÁ¥¥j°5šr½„c¸°îº¯Àˆn74FïyÏ_÷PhžMŸO%ó³ëó>Î÷‘EÁª© KÔÆ<43’G-O½ºÙ¶9’2Ôð @oš«!"l&¶/,¢ ÿŸqSVš&ç*¸ÌŸš#uô`žíQõG É=¥ {Mœ»Oiu~öOi2ù”ÖüÑ.Ê¢,O¿¤ }a÷?¤õ®¸ a¿ê’ÑD ó­©øÙæ2¦IÕYŠyþŒS¿ú¡JDÚ[䇔ƒjnRf£öýMñÚ/-ä½{Cãp¯ˆWaÏžÐâ²A{'k—Ìhû1W.Á™úè]vxàDÜy «© =3o“Bx>½Kjâãhç¨(&×âˆÝ9~{ªj1w²‡Z'ÔÃ뤺#c“vÿÕ mˆó÷ˆ?®U8U<å}rî»ÑCHGä@zfb‚ôv6&â>…±¥âëCÏ£ÑñÚ Jæ<¸¥Ëžg›<Ï÷07µo§Ÿ'&Y¥5ÑEal“Évüâòzµx?ÿ]Dendstream endobj 308 0 obj 1433 endobj 312 0 obj <> stream xœÍZ[oT7–ú¸¿bÏV¬ëûå±DS%i EB}U7 $J}Ç>½çì%AUUaÌxÎ|ž‹ç²Ÿ¦”°)õÿ5ž]N~:1Ó·:}ÿ˜|š°@0mþ8»œ>^ü•1â”âÓÅù¤>ͦ†O2Äééârò¦R³9#ÖHm+Ù-ÿZüÖœç„qjüyJœÕB²Z- sÓnO:N¤MÌ(1R¡«ãÙøP#mõdÆcÔñê©ÿ·\êêõlN‰t’9]Yòu’sFh󞫼˻¸¼ŒËe\^ÕK ‚Ó¸{wo»Ýx#Q. ·‚-Þ0€’kb,«x¼QÕ»Ñ×<0˜3C„¤¼æ³ ¨Ïqù.Š¿Ìh׈/‘Â%ÄÄZ·”mâK‘নƒeܽ.jñßýÖí–°[JD;X–‘c§ öy{fz¦~Žþê‰cRxI)¡Öʸ¿0UK¹ë–5,i‰‚¿ÇpEÍ gÖØjU3ÐÆQ]ƒ§-„­æaÅ…nHõðÁ ‚ݸy3cÀÛq?þmÞ‚óRiây#:ém1@;œ,~|S]ÔŸ‘Þ_¯O)”heWÒë”zá€ÃëoµL°êcðsiFHƒ,þ»ª'@߸‚ãíªè ³ä¦=#;ËU´‹Õ ]HA¸_ô —ÚE{fÞ]ž?šÃºÇ¨x|a§‘ý ŸLLá³í§,c¦UÜ.6’«M¢ª#Ž9׋?‡Ñr®AP¡¨lWLñZ™µ‹`XLð"á lÖi«y­©¹eÅ 7ĨÔM#Ï\—`6½e|?ƒ¤ÏSZFuK,DìôòáE"”w¶ªE†‹HÃvÆasf‘Àd®®¹µäð¬óA:oM<¯äWÈ3±!!Þwç N]d ù‡fûõö—x"é}šKxû¹.˜³˜8F}$r˜Ôà}¬ì môÂÉaÑ„‰Ë£¸ü#.G=düî‹m…Áa©ck(ày—O3~ù2Jþlÿ‡žK^~ø·‘<§õ’ÿ¼¿äci;–¿ýÉ‘¸'¥eIF…a" px ‘€|XÀÀ ½WõPPCåÃ?¥ro7éF®¯“.–þÅ%.{Ó"eÝ]¿-¶ÓíÍÌoIËö®øe¤Wùt1y>‘ÄN¿N ½8a‰œ^N¬ÓÄãm6V“Ûwç™ÄÔ-î#_ ÕÏ ÿyÐcXÔµ U¯mÖt%+TQ½Þ*‚°a ‚~…k£‘΂§kUußÚw¨R:ëºI…îXàÐk(ÖöŸ·]PG³t±÷îj~ .ù¾AY·¢m'×¢*¼Ü⾿P‘†dYm¶8ÃX›ãàA­ŠÊRú‹d– $þARž±†Ö£:²\m>^è¥F£zšÚÚ|jï—ÙÔ>ÐæS{¿¼÷©ýàóµEàøZô#„ýªo©åG o¿?aOëÙ+ò¿Ö”ë!"ST%Sº&ï·L•Æ#\¹ &Ù%ð „8÷;.äË¥y^H»á“ŸA {㬺I}”œÖj‹“D<Ü­YKÊzŸö®(y^”úîÏà’ï¼v¸¶À±>¡^XæÅHïÇX¼¤Œ®?åé¹ä¾àλ_Ž Uãóg¨1\¥yÆXa`…*„ìW%U£û¢ŠŸÆœnfPØIÎ%ÆZƇšù"6ÛF9¾”´kÍîehè(óYõjÙ•r ýP§aËÐÈ»Þs!šï .””³egk´¡Œvzxx?¦¼0¼§|p|o¬Â›8ÔPŒéJz-µF»‘A>¾JVý}~…+±Ö ÞáâZâ[Àö1øÂÂ¥f?9€«‘Ȫ¢x)ÒO§³ÌÈ-p\oCSèùä?tÆ¥6endstream endobj 313 0 obj 2054 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 39 0 obj <> /Contents 40 0 R >> endobj 46 0 obj <> /Contents 47 0 R >> endobj 51 0 obj <> /Contents 52 0 R >> endobj 73 0 obj <> /Contents 74 0 R >> endobj 78 0 obj <> /Contents 79 0 R >> endobj 83 0 obj <> /Contents 84 0 R >> endobj 88 0 obj <> /Contents 89 0 R >> endobj 93 0 obj <> /Contents 94 0 R >> endobj 98 0 obj <> /Contents 99 0 R >> endobj 103 0 obj <> /Contents 104 0 R >> endobj 108 0 obj <> /Contents 109 0 R >> endobj 113 0 obj <> /Contents 114 0 R >> endobj 118 0 obj <> /Contents 119 0 R >> endobj 123 0 obj <> /Contents 124 0 R >> endobj 128 0 obj <> /Contents 129 0 R >> endobj 133 0 obj <> /Contents 134 0 R >> endobj 138 0 obj <> /Contents 139 0 R >> endobj 143 0 obj <> /Contents 144 0 R >> endobj 148 0 obj <> /Contents 149 0 R >> endobj 153 0 obj <> /Contents 154 0 R >> endobj 158 0 obj <> /Contents 159 0 R >> endobj 163 0 obj <> /Contents 164 0 R >> endobj 168 0 obj <> /Contents 169 0 R >> endobj 173 0 obj <> /Contents 174 0 R >> endobj 178 0 obj <> /Contents 179 0 R >> endobj 183 0 obj <> /Contents 184 0 R >> endobj 188 0 obj <> /Contents 189 0 R >> endobj 193 0 obj <> /Contents 194 0 R >> endobj 198 0 obj <> /Contents 199 0 R >> endobj 203 0 obj <> /Contents 204 0 R >> endobj 208 0 obj <> /Contents 209 0 R >> endobj 213 0 obj <> /Contents 214 0 R >> endobj 218 0 obj <> /Contents 219 0 R >> endobj 227 0 obj <> /Contents 228 0 R >> endobj 232 0 obj <> /Contents 233 0 R >> endobj 239 0 obj <> /Contents 240 0 R >> endobj 244 0 obj <> /Contents 245 0 R >> endobj 249 0 obj <> /Contents 250 0 R >> endobj 256 0 obj <> /Contents 257 0 R >> endobj 261 0 obj <> /Contents 262 0 R >> endobj 266 0 obj <> /Contents 267 0 R >> endobj 271 0 obj <> /Contents 272 0 R >> endobj 276 0 obj <> /Contents 277 0 R >> endobj 281 0 obj <> /Contents 282 0 R >> endobj 286 0 obj <> /Contents 287 0 R >> endobj 291 0 obj <> /Contents 292 0 R >> endobj 296 0 obj <> /Contents 297 0 R >> endobj 301 0 obj <> /Contents 302 0 R >> endobj 306 0 obj <> /Contents 307 0 R >> endobj 311 0 obj <> /Contents 312 0 R >> endobj 3 0 obj << /Type /Pages /Kids [ 4 0 R 14 0 R 21 0 R 30 0 R 39 0 R 46 0 R 51 0 R 73 0 R 78 0 R 83 0 R 88 0 R 93 0 R 98 0 R 103 0 R 108 0 R 113 0 R 118 0 R 123 0 R 128 0 R 133 0 R 138 0 R 143 0 R 148 0 R 153 0 R 158 0 R 163 0 R 168 0 R 173 0 R 178 0 R 183 0 R 188 0 R 193 0 R 198 0 R 203 0 R 208 0 R 213 0 R 218 0 R 227 0 R 232 0 R 239 0 R 244 0 R 249 0 R 256 0 R 261 0 R 266 0 R 271 0 R 276 0 R 281 0 R 286 0 R 291 0 R 296 0 R 301 0 R 306 0 R 311 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 37 0 obj <> endobj 38 0 obj <> endobj 44 0 obj <> endobj 45 0 obj <> endobj 49 0 obj <> endobj 50 0 obj <> endobj 71 0 obj <> endobj 72 0 obj <> endobj 76 0 obj <> endobj 77 0 obj <> endobj 81 0 obj <> endobj 82 0 obj <> endobj 86 0 obj <> endobj 87 0 obj <> endobj 91 0 obj <> endobj 92 0 obj <> endobj 96 0 obj <> endobj 97 0 obj <> endobj 101 0 obj <> endobj 102 0 obj <> endobj 106 0 obj <> endobj 107 0 obj <> endobj 111 0 obj <> endobj 112 0 obj <> endobj 116 0 obj <> endobj 117 0 obj <> endobj 121 0 obj <> endobj 122 0 obj <> endobj 126 0 obj <> endobj 127 0 obj <> endobj 131 0 obj <> endobj 132 0 obj <> endobj 136 0 obj <> endobj 137 0 obj <> endobj 141 0 obj <> endobj 142 0 obj <> endobj 146 0 obj <> endobj 147 0 obj <> endobj 151 0 obj <> endobj 152 0 obj <> endobj 156 0 obj <> endobj 157 0 obj <> endobj 161 0 obj <> endobj 162 0 obj <> endobj 166 0 obj <> endobj 167 0 obj <> endobj 171 0 obj <> endobj 172 0 obj <> endobj 176 0 obj <> endobj 177 0 obj <> endobj 181 0 obj <> endobj 182 0 obj <> endobj 186 0 obj <> endobj 187 0 obj <> endobj 191 0 obj <> endobj 192 0 obj <> endobj 196 0 obj <> endobj 197 0 obj <> endobj 201 0 obj <> endobj 202 0 obj <> endobj 206 0 obj <> endobj 207 0 obj <> endobj 211 0 obj <> endobj 212 0 obj <> endobj 216 0 obj <> endobj 217 0 obj <> endobj 225 0 obj <> endobj 226 0 obj <> endobj 230 0 obj <> endobj 231 0 obj <> endobj 237 0 obj <> endobj 238 0 obj <> endobj 242 0 obj <> endobj 243 0 obj <> endobj 247 0 obj <> endobj 248 0 obj <> endobj 254 0 obj <> endobj 255 0 obj <> endobj 259 0 obj <> endobj 260 0 obj <> endobj 264 0 obj <> endobj 265 0 obj <> endobj 269 0 obj <> endobj 270 0 obj <> endobj 274 0 obj <> endobj 275 0 obj <> endobj 279 0 obj <> endobj 280 0 obj <> endobj 284 0 obj <> endobj 285 0 obj <> endobj 289 0 obj <> endobj 290 0 obj <> endobj 294 0 obj <> endobj 295 0 obj <> endobj 299 0 obj <> endobj 300 0 obj <> endobj 304 0 obj <> endobj 305 0 obj <> endobj 309 0 obj <> endobj 310 0 obj <> endobj 314 0 obj <> endobj 315 0 obj <> endobj 336 0 obj <>stream xœ]‘Ánà Dï|`0 V%‹KzÉ¡UÕö0¬#‚qýûή“z˜ÏËXãqw:¿žË²éé‹6=/%7º­÷–HOtYŠ²½ÎKÚ$3]cUÝé-ÖïŸJhÞù=^©ûtÎË#»›ÒšéVc¢Ë…ÔhLç9(*ùßÊwÇ4?®ZDÆLÇ‚ȸ)3¾#c2ŒSÐaÃ2¦'FlXÀĘƒˆ(ãáDÆ`)ˆ€ìõHÌê­å7{ ìy‹½„Ä"•/Njàc3pÈÁÐIÏoå6¸×g:Ý[£²IùR.wºúû?u­ìÒú˜<‚. endstream endobj 58 0 obj <> endobj 337 0 obj <> endobj 56 0 obj <> endobj 338 0 obj <> endobj 339 0 obj <>stream xœ]’1n„0E{ŸÂ7À`lïJÈͦÙ"Q”ä`Æ+Š5ˆe‹Ü>†"Å·x|Ïø›¡º\_®eÚtõ¾Îé“6§2®ô˜Ÿk"=Ðm*ªnô8¥í—dM÷~QÕåµ_¾¾ÒØ@yç·þNÕ‡µgyUïEié±ô‰Ö¾ÜHuÆÄ.稨Œÿ¬¦Ý+†|lcg²ƒÀwÕ4ë:ŠàFE@q}38Æs› °i¢›Ùµ}ÓãEÀĘ¢È ˜©Xp3#²àrm‹D-Ç0xÂiÅmÙu¸¼ãÌÆq g­ _ТxbD"'©°ªÎ£ÎFÏ=nã%$ž€Hä%VÕ$Fàƒºé¸s@× ±ò$ŽOÎCáñÓÔé¹®T6ùdÆ<Ú©Ðßo²Ì WiHýfè¡ endstream endobj 54 0 obj <> endobj 340 0 obj <> endobj 10 0 obj <> endobj 341 0 obj <> endobj 42 0 obj <> endobj 342 0 obj <> endobj 8 0 obj <> endobj 221 0 obj <> endobj 343 0 obj <> endobj 344 0 obj <>stream xœ]An! E÷œ‚ ¸(éH‘7é&‹FUÛ 0`"a™,zûbÓTUéÁ7²=O/§’7=½µ5|ЦS.±Ñm½·@z¡K.Ê‚Ž9l?&g¸úª¦ã«¯Ÿ_•tP~öWšÞŸœ“+;ŠÂéV} æË…ÔÁ<¤„ŠJü÷4‚%ýI2°«ÅYö¬€E `€ÃvFÀ=³v¾+ôo3‡ÁáÀήkÆìƒôùèˆ[æá³êpoÊ&’ ðà¹ÐïëZ¹JwÔ7†ms endstream endobj 35 0 obj <> endobj 345 0 obj <> endobj 33 0 obj <> endobj 346 0 obj <> endobj 70 0 obj <> endobj 66 0 obj <> endobj 347 0 obj <> endobj 26 0 obj <> endobj 68 0 obj <> endobj 348 0 obj <> endobj 252 0 obj <> endobj 64 0 obj <> endobj 24 0 obj <> endobj 349 0 obj <> endobj 62 0 obj <> endobj 17 0 obj <> endobj 235 0 obj <> endobj 350 0 obj <>stream xœ]1à EwNá@@U—ˆ%]:´ªÚ^€€‰ˆ¡·/¦ª:|KÏö·¾ép>½Ë@o)èf°Î›„KX“FqržtŒÓùC­êYEB‡‹ŠÏWD( h7¾ªé]Xku›IƒKT“ò’ž1Ù[+ zó7›a´?›Uœw\²©à± (“*Îo×v_=\#î‰@¯)¡Ïí–³Æs¿¯Æ« ŠÈëÉY. endstream endobj 60 0 obj <> endobj 351 0 obj <> endobj 223 0 obj <> endobj 59 0 obj <> endobj 316 0 obj <>stream xœ¥V pSeMH (õµ‘VôÞ¨ˆÔeß®Š¸€` ”G¡-Ðiú Iš¤mÒ¼šæuÓ/ïô&ihÒ6}¤OÚ*-åQ”ŠŠ"(TWA]guÁU÷áŸzëÎþ<œUGgœÙI&s“Ì?s¾sÎwÎÏå$Máp¹\þòŒŒç_yš—˜ÃMÜ>%qOÁº¾›?Q;’yœÔuû,õÍèÅ›õ$¹‘Cp¹E­Ùjw1Ë¥2µ¼X\¤Îß•.|àñÇ[ |pѢDžËÊDòâ]aF²HTV Ä_ö7Hw‹”jáü'Š”JÙ’… «ªªî/(SÜ/•‹ŸL_ ¬*V ³D ‘¼R´[¸B*Q 3 ÊD«ï¿ú¹\Z&«PŠä én‘\"©Ë‹¤ŠbqYÁÅ.y±LÉápn•ÈžUìÌ,,.)ÝS¶tÉovÛœ|g-g=çÎFÎ3œåœ…œ•œÕœ5œç9œLÎ,Î œ9!n¸®“ëâÌÆìp’8¯pµ\4EË›ÃëMÊŸÊŸZÏŸÍÿzZ>QNô'§'Mž1oÆÐÌy3MÉótÊDª1ž âÜÄ-ïxÆy(-¸ÂÌ +Üp ±ÞÞ#‡œ¢¿¹2ocËWåPú°€žÈ:$þr?†“Ël°›4©x¼`·‰‰Åü-L<€¦Á+ÄŸ³û—/ÉÎIHóØŽž- ¹R³G‘gÜ v¢Ögó‡îv<ymˆv¯¼BmU™J(»I»Î¦+dïKµi-r°ʨ) ƒ>Òåõ÷yš‰”D7»¹ýþÚ™çx/±³¦R»i:¨jë­Š·ë=‡fÚ£Éw»ÃmÐ!¼õ¾ÈÙ.4 )»ÅÇ€@7 ß¡»Ð=_óÖÒµ¹;Ë$TåÙU`¼ŽW¹½f Ð?Â:9¾ˆ6ŸRa´)ì&j\#ð4‚3Žõ1ÍÙ^X!,[G•oÊÝ‘ÄJÍ9ŸÓp¸¨” zß÷r'è <´ô¼ Vd7-B…AëBÐH¡Ë|$F…h;R ?Üó/6bÿÁWëñ¿Ahìí­®ŽÖSŸÒ‚ú>‡ Ã@³øhúùUlJ‰Ž}ìa6‰Ú±á‘5ì Øt~­“ðßéwz1gcüÀçhîƒq.ºýzè ^âÞD²@i«TƒœPõ-áîÀÈ«Û2ØÛ lÁ Hɘº‘~ɸÏ|ÜÙP®*‘ª 9uPÀJ·üÅ£Nß~]2ŸA³Ó°qÝ¢‹è™tÃÐ…ôh¡Ì­ßíƒ!"Òxêòà 5åa2%qâšï†Ïñ·'nÔ6J†31Ø™ìl–bçß}zí'ÇŽ6E¨ÈŠ·íA8±AcSëà&¼6ŸÁ`·È-¤n£*{7ÊÚh¼±¾ÏÛFyÛ¯»#Mï§zZCà!b*¿^+7î±’+ÙvÁÖÙ•¥@lS½t¨ãÛ–Tç‰#Cx+úŒÁ&O·”Sú<°ó1G9Wá!Ñ÷ÈÛÈ~Ž‡è‰‡Óá±Õl{h»’Ü`«°ë@¦k€àa°ÔZŒ»,JòaökS1h¡:mî›ë>ø±­6ä‹UdÃd’@,Ž¿Ûán ¦|¾¸¿Óg0Ü74Ò=ô ÎI™øäº_zgÁ#-­ã.‚ñ{C^«ßH™AE/ƒ¥ wÕ^q¸†®1éCuõÔ ;È@V°Ú4ì”ÉÕ©¬%5EìX´4öÖìÔìïKŒbo›ì3l-¯XeO³êÔ‰¡ÜsÃyÓõ?¬N°Æi¦ÄŽ2/ì«hv"šêà£îÉK>À4ü£Û݈Iô±ùñðg‰Ò^t×gá8wìúð/qKâ.ÁE~S¯¡ª©ù{/0Ç™w£+†~g°—™¬v m¥«k j¨"”]KgGÛ¾C¹­¹ÅÏk–’µJ°ËX!ñ4¿ê‡­9Ë_>™ªš§}t3¤ÑP ªàÁ aÉbê† ™D)*–Žž:Ù"ûOÅÐMN†HAß_“Zð9÷³wzÏðÐщ$A‹f¯²\¢(«Ø«‰µw¶v‘ì¼Iž`KZµVÖ5gPüòåŸÆŸréÎ8v OG«/ꦘ¦#ÐÑýQj},Ø Äè®}[î+`…úkâe\dü‹ƒ]@40V©±Ng,£RË0g‰¿^…£ý)Çy‰0ž¨6ª(+—–«ÂªÖ®öx;ÉŠ¾T ÍÌY кíŽî°»ê‰Vu¨R"“—ˆäÇO )ƒ(¹‹¼€¾s~§íxaý×!à ûÈ®wŽ¢9¨+ÑÑø…!ŒãhøBøªûÑñ÷_¹ÄC#¿Éý4Ø­j’½kò”M‹[¢.­ºAíó÷4¸If¨ýß¡1Ëid]1¤ÝHëíؚĺù¯µwGCdëÀÞ×ÁK\cÔ¢¶‘ú¼òUØûå––Ž#è‰QØV{!Ïlñ ´ôõCcÇFC‚´ß¸É yPGT4j[:ºZö÷)ú·®ÏÞ‘•E®Ï’×hÌXé3ÆøDòw]ø§‘óL…´éf¹qÒlÃãY2Ž–ŽÇúZd¤7üÎ/íÓ×ÒÖ:ÒN[Õtv½ª@ „Âkº®•òÝS×2nbÉϺÕÅx[ŒÓÓûÖÞ¾ö^ˆ¦Šm ‹²f;e.¯^e‘iצZ«Íe˜ Ÿ—^ìo©¿ÞÐÓT¹”±œÆð‹ ½¸@ô« ½"Kœ±4}¸&’ Û S³q¹ùõÜx¼²º·uÎÿÝÖè0»¹-C<.Z硵a¬ÖeedØh»Ojò[|Á¿œGÓO*ì(ª’ʤQé@k¸ÁAâ“€O}Žx<´cLÐ'm‘•*Ê%ÅñŠŽžÖöN\'qÖÕü݆&îk‰E¼„hb‹ÀÛNp!#£×Ø Fɲÿy¢;ÐizÆÚë2n2eⶴ=OÜÛÄEVôo'êïÅâ6k˜êbS‰Ÿ£&_°‚=MÞdÁ6t´‡H—¿Ílú°Qߧ9 ñÓ.÷o.ªÀ°¯“jÿÆÛîÁÉ›æia^À®o«òŠ,òí5dåâ=ìMÆ]v‹L¤T¥Uë%ªB òJÛÞh÷wy[ñzF¡9‘|€‹ª‹·Ã‹Ñ: ¤Ñ¤×Ú«I£Ýf‚Z⊋[ÚAg©Ùn–“6UõJ›NÌÎMµiÌ|‰Ñ…ÁM†ùÃhêá/?Ew ”4³uejUuÌD>ǪÙ'çÞ³§ø·Æfôí).šã¡W€¦ñ+©—Á20C~@*`L ZbÑV_ÓVOUÔÆœÄ`(üî•kÉ••eüA¼xθªIö{~%ˆ 'W,–n3vígœ.¿—<2þ>H¼Ê—ܹ™UøŒYk¬ÂãT6÷2ƒ7c¥÷_ìÊ/ûo€}DpMâòxMŸ÷£;‚•=;Oà«Q šƒnC÷¡©O{r!;c1;WL!!»E°¢b¼ÁÝþÓG ?}Å{x¸#£¸êÞ²LJ’•Ÿƒ›7ñO‡_âî?ƒö½ËKÄ Dðe*èÔ»Àw}¢:>{?;ƒ}•~fÍEt3ætJ?¦ê©‰R¬–ýJ°uGï»Cm(=r–UÎ}–Mgg`1WâóãÜKï¡¢.ZŒrL=ƒßgÎ:Ù60z>þ1œ ©û·±)l*;ή«»£–ÔêviµÕÕuuxÑ,>£ßå„P˜eÖÆúÒa0Ú F @x­£•¦Í&rga®h›ŒgÞôAÄÙDù_0ÇûÐÜž‚Ý#ˆ8D+£*1Àâ'Ødj󒧞¶Xˆ”ÊæÄr&@²f>›ÏLë™qn&9#鱦äéqwr2‡ó_õO¨þ endstream endobj 57 0 obj <> endobj 317 0 obj <>stream xœE”PSWÇß3ä剑v_µï¥Õº8R»]ªËª-]¤vpÖjý5‹˜b Á„`xB‚PHrH¤üHH¢Ô( [¢Öµì¶e¨;þÀÚÖõ×,µãÚÑEï‹—ÎìƒýcçÌܹ瞙{ÏùÜï9$3ƒ IRš‘ýÞS›ÅÂ|RX0CxQؽÝ/¹ä1Ý ¨@jŒGúçPîó„”$u{-Ú3ôÅMšW$å-Q¤®\™–¬X‘’²Rñ¦NeÐä)‹ÙJ^­Ò)yÑÑ*6éó4*¾B‘”®æùâUË—ÆeJ]É2½¡`õ’d…Qëï©JT†2ÕnE¦¾ˆWlPêTŠ©ì–M-z]q)¯2(²õ»U†¢·UZ^¹N©Ó) ‚ˆ[²4%uÅk¿}ýwiH"ŃXBNÄ įˆ_ ñ1‡˜K°ÄLÒNñœX6Cä]äbr/ywFÁŒ!‰R2³-ÆóPúš´A°Æ ©ØÙñl“ŸDÖ ú9ø©QÙ(vÇxÊ÷@×XëêÀæ6sHOàw/| Ï ¶åTWÛíPO×;ëÚ|Cg[[X4)B( œŽ‹Ž.ì@_EÐ×~R˜‘YÈȠʀ`°L@ƒ”<¥&âA™©x>‰e‚Ò`6N•…¢±!²ï Þ“&t™§–‘¯sï® lœ9¯šôoÙ’`+¼ã\<øûÈ›WËÏà Üö=ì¹ì¼#4æñ£L_Ù„å"܇sp þáºÐñèÛ¶ÃÐ —öùSÜ›a-¬ƒ?AªySÙË™¦B Å·!,œ&"2ß Ñh©ótty{Ïm3{ìÊèá3@ÿ8˜ž¶ð­58Ïæp~ÁlŽ:†ÖIµ”ÕX»Ý\þaí¨gRSàŽ_AÔûø‹#äÕGèƒÿHÐGèschãË8þíü-›×úÏ«¹Ã'øàžbý¾¼äGÙˆB‰?Žÿ|ó±WÜÐð7ðý]êÅ…ŠU×ä®<ÒåëÙã)mdO_¸î<ô‘±ÚE,Rš*9–·mh(·×Ú¡š6µÂAv švŠ/_“lt>㇖2Q;¦_žÌ“¢“oˆô,«Y¾ºåtÀEÑpkš/[muõp7Ÿ„_’­¤Ì¤7˦+›xˆ2Cˆ¹åö“OÃÈ6.A a˜io8Ush?v×ëªsÖÛlP¿ŸÛ]•c~_üÙ^­»¦Év «ÁRÁሬ̾ç–&Öíí={ þ GsZË8r`7äÛß×ç–ëò´[`=¼ÛÇ8íA#СÀ¡®ž¢vcÅžš]©ß¦ Šò=è´Ç8vûŸ+5*n:G!1ôýø©#ägÐûÄ¢2p³ùÊÇ?>t¶ï+ðCÄTï´5hÀBë‚û:sõþmç™TÌá—ð\¬Å(!ëÁà¹öOûÙSŸtŸ†;4š“4Ž%»rvð,bð5f öT…ø~Û7ÐK?üüêõ¡ã{Õa;òa'l-×X°7G]‘;­æ²aø‘Úx_"8…'L«KD q3em£Á±õ€½Õꣵ”H»(‡×uÉÓâjº^ªšZ„YLáä¼Òk g`úÝì  Ð¢N{fdªñÑìZ!‡£[%Q=ºÍxýbÏ—@÷ËLªªDìq?x¹èl¬f¼bÄ8‰§ªŒb¤SŒü*=‡ÒmìdZÜà>`o¬nçð‹ˆÑ  €–êC³Ðü³O{c#4ÑM Í5•Û·í¯eñ<¬Ðã,ÀrÀü}œ…,¥ãžÍ„g‘6ºž±øÍP'š,Füô—Ô¹uSd£kZÀÇF ÔÁfhs€£ÎÅM¾.ÜePïd·tr”Š‹.‡Á³0‰^—w¢éÌ䧅êºÃ’ÏMzeù6QÁ¥ÿSð( ÀèŸVðÙ«à9É ²nGs„E2JÌÞ·þ fè.*Nü /Ò·µtPXé’…cÇf±±1i~ùÌP“\>æ“Ï&ˆÿ6G” endstream endobj 55 0 obj <> endobj 318 0 obj <>stream xœ­Xyxç™—V&&ÁQ°B2ã@ á i–œ…@ÂîÀ…,²eI¶lÝÇÌ«û¶dK²åC¶ñÆ7°K ¤MCR’†mIš´Ûý¤ŽwŸýlÒ´ÛÍîvŸgÍ6óÌÌ÷}ïûþ®árÆãp¹Ü{–¯]»zÁÂÑ?g'¦sK<Â+dmÉo’ژăIãÛžþû©‰‰÷£#Sþ>Î.·Xª§Þ@8_^\¢äçæ•g<±ÿÉŒ‹??'cáüù‹3–ŠE’üýYEk³ÊóDâ¬rüŸÂŒMÅûóE劌'^Ê+//yaÞ<™L67K\6·X’ûÊ“s2dùåyoŠÊD’ QNÆÊâ¢òŒuYbQÆÝMνûky±¸DZ.’d¬-ÎIŠrD…åY¢’²üÂâ¢Ü,±8KTžU˜%ÎÎÉ*Éÿþò‡3géöeËKvþ´t…¤¬\š%ÏÞ_™³Nt`CîÆüM›Š_|áå_z%uÆäûÂ)Î ÎbÎLÎcœœ9³8orfs6q6s¶p¶r–qvp–s~ÊÙÅYÁ™ÇYÉy³€³Š³ó:gç Îsœ5œuœÉœ)œû8Î#ŠËpkáZ¹6®ëà<ƒ«ÎÏiçöŽÛ3îÏ?^8¾6åŸø³øîÙxÏeÂpïS÷ÞžP5᳉±I»'?4Y“úHj×”7ï{à¾ÆûE÷=5˜&} äþ~!˜,zPð`öƒŸLS§ON?&\$<ñÐC sjRq´?žXáv&ñÐ+ˆ'ÈÛ/ÛeV3:ap˜\d= Zë!t+œš4Ó釰Gg1PåV¹bPëô>DSÓ‘›oт΢µ•úg‚œo§«ÔjP¨=ଋX¡Ž¼Àÿ Ð \>{µ ÜÌxÚÌÔºäx:b²ªA¨­UlåÈO(Ýîdo§¤&ÏB<™ç6%Ïñʼn§Ï â@¬Íî·>KO †J •ÔFþ:Øke€Ði@®ñ@à¢]Sæ¥ÐD¶³ÊÜœ}¢¥&¡êîÑ̽¯6h…Zò8¿ºèv¼+?Ô{õød2kBPç÷ÇÛnßIoh<{±¡á_X&ÝBÛ5À€Vª8H5£ÐxÁ1v6 ã×C˜®ûþpÐRë-´£²‡MGo§£4ô°×ÛØäñ û{Þtx-^€:oÞT­¤¡šÌä„zM@Ä·/?õ‚›bg°7ìt~5à§,j c7¸¬N«çêJGøh°ãtO/šÅÞG¥&7TÄ“óâÜSó’ªähÚ¹òù¼áÍK@Ȳål1«b_D÷ÎD³o\ëÏàC‘úŸÿ¶ïhU®—ÜK‹˜Š°ÁSÛêëëõ¿ÌNË{,›Jû3¼úAU£‘HEÒDÇѲwx˜‡2³_òÃ^Ì*QÏò{Ðl{-XÁ% Õxjtåæƒ:2‡}6å¾l<.S·ù«Ù:]Fvp÷¡}ç¿=‡f»œá˜:12øG_U±#sÅF ÄtSƒÂ6?•š8‡WžÑD¦þËZ>4-í:úÍEA`Ó U :  uÖu†À†ÔŽ§É¨4‘Š•Š­ûñKàP ÑæõöQ®W‹³õ(z>ÝÕ„7i#‚*¯²H/‘HMÎö >Hdr/›¾M3Øs¡õF󻔿ÀÑ_سkÞv–n´× nûôÈaÌtÞs°T]¤Q{Ù‰Fˆ‰Y׫Ž’i×/C×@$†è­Y„‰Lí½‚6á¢shâ?ŽÆà°@Ý\Ò»í?³Á[ÇûµRi×7xW¶MoƒX}}w¨³ögcýK”äk°ÑÍ‘F›Ïs„r59Üñô”§œD­Ú§<¨ËSÑXNÎj"¡PÙÍ@„Ûz ½QP”˜#8hP•a—3Š‚¶hsKß®pÖºüõr-Yþ˵v³¶°Ó¤cãouÚ­T'â½1èÉ*“ÊU»¨|öåú¢Í[Ah Tº]î6ð¥_^VZq0븼ÿDçá£Q2´á”¬ˆïΡi ß@g¦JžÝ˜½ˆÒíŒS£cL3%Ý°¡,/*sUxö‡ÔPPƒÖ„÷ïø¡}cðà%àïÚ·ÓÄ¿oŸäûö¹¡ö¤E«1Ð"ä:ÖtÂÿŠïŒøßÑa‡¨«•Zçý¿hdÓ] q,y–—”'~)ðõ‡Ú>´6ÿ˜]7ɶӘwaQTX«0¨0ÿaU¤†i{9(@‹%´šMÙ–Î$âúc‘â¤þÀ“Ž!ÐÒ£ç£XáH‹jgYÅj³Ð¨sã¶Èi+Ö°üZ,÷µw͸Gc1Q–ƒNè·Õcu£é‰Žt'. ]‹´#Ÿ§;TVƒ7Ób³×á²ïÀã)‰ —#ÜÁwP¨‡^ÃßïYOÔw]„zb@Ô»zûôvåŒáe_üøT¾)ü š‚—)GDÐæþ6ˆ{?ÐV*š-Afí v_$r#QGÏÜ G¸§o¡˜ZÞĺqyõ?ü‡Ú÷ÝÎX´±OQTëÕæ˜TEP9‘H[Ýᾬƽû²æÈHEž&·œF¬âÿ å—ùŠ¹ÙlEyFå"å²`ÆžU>m‡°ŒñŒL\)Ú7 =ò]z㔬¿~…m8iLÄ&§/†®`øØ-:‰Þ —øˆDäwˆÿÑê÷Ù©{é¿Éë'pô ãx¦Ð½| : „ûûì·žqy6½èáÄÉ¿˜Åoø¿¼T¶¤´æ'™™T¥b—h>¦öGù©‰<\,´&’˜:*õ·$W¦¥ý}Ò¦*ÚT£ÌÞš%ÇÙ© °ùêÙ64¾aŠŸìí›Je®N žÔÄ‹{và×qÙûØGØ'g¾½ýòÙã}‘z*í+é‚êÍInž0;[RƒÄ*qwxÜ­à#Bª´¬TV}´ê$x÷Wç$â%6ÛüX&­ÂQ(«–•˜ÉÔdˆÝúÙ'MhJ$ÑÑÀ=qG/ôh *¹ÁK¼â %WÑèu@« ´˜å|Ëf°8U²Uì‚?f Y‡ÞÒ€=•"XrM@ëN¬ Ú¨6“Ò5Ûr÷Âv¨é2^'ØUÁK-¢_Á—p­ ßùöÄÿæôG@üñÚóìƒKóX »[mãéêáÕ@lÉܲSmWÚõšãäVŠÐäÁ@w×±ÁS¾üÐ1*ýú.áL¿9õÃóÇÏïà 3ºÑLÁ]b0WÉÒùÙ…8DUÛÚZüm¾6êZgs»pôö‰ïü{pëp/nª§û€š”ZÁ®3Tª@!ÜÓž{âËnìoÈ´Ûº„TTÕKËK¥¥’¨ÎßÒØÜ€u÷œ!´pÑÊ!dâ%§|Ÿ#M £T‘}ö6†)¸²Ú—…{šÆÞÃb°dpïÉJÊgªjÓŸ®˜¢R»1R»‰¹Ï=ýøâù]˜¯ì1›—›ÅVÂN;tZ†®4‘ÛÙ,`L5Àµn°Ú-– Ÿ<6Ë=³ÿ+ì³8ßîïÓôˆz¨Š¨Â1/¶ª^kS„*ëjbÐIÜúäÓß~}lýœRc ˜Hü›Çb &Ñ'ñØ&¾«hÍ-T>”9VÒ? k{j1å^Ü×±göv¶Þh79±ÈxdïSíØ×áðÉÐf50„ÑntÞ Ÿ}hrô<ñ.?æµh£‚béÔäКGA(Ñcªð£©Ù MšÏo‚º Ÿ³J€'h—=„‰Ñ‰ù÷ÚÇþ1áCG.]ÅÔùûÓèÊ$;säªI9š¹„Ò:“·ÕÙÐî&£õ?×õ‹a— `2+ñ *;6Î9},ÖWë&£=ó?È ©ÊDVo«X±Y÷pØÞ`Röz°€†¶šçïnè>R¼pùHÇ1h§Áe8`ª.Ù˜%l‰5vÄËÛölÞ“óâOIê€è@5æÕ;š»_%žBYC(ˆ‡²Ñ1ÕÙtª§£9ÖÂ`é­ïÇõVí¦$éÄò¥´ZhRJÁ4–ÚÝré¬î3x&ÇpôþM9,WºžÒ–kp)F¡õUzÜùWØ–¿x û}M•¥£Ùßa÷Qõ'ѸH ç ¾ºj‹hÃ~Ò|®  ,„Ýkó…ìö½ÿÀŽÿ!ÈùkA7iuxº‘†ÏÓSQŒÝEKîpÑòm3 .Êû³V•J¥Á’΀ÏîñV«W—°Bµ±ÀðúÆ×)µjì‡Ñat¸¯€î!ñ[à÷×wxhÍ A¼,RV$+++ŠÉbñH,†Ç¼šµEÿ¼)Â=—¸Ÿ—XšÌ€ÅÄ@÷k\:£¤:’ýìß—cÀ£!Tyõnµ£.üà§ìÁ証Œ¥(ÄB™8ŒÜA5šÊ{´púÛ½[û*ºþËÔèévµQ­ˆcûõBgÌ×ïTÚ “XG®`Û2 kª„ªÊœ-k€Ø¤8zœJ» qO—½n­Jw„Ý8†ŒFE­t4*²³F>dŒ´O´Ò¯ Æ­xãIkq4á‹p?Nü†—|I_}.;•vô{Ü”Uì‚R­ X*zéòÉ«@ *ÂÎ{b¾Â £äk Øû ˜ÐÙ´î çP¯Œ}æpôâ¸n‹]@‹ÿ-p…j[p¢·0.-mý@Óy¯‰_#Ò®+óe{ žÅ›‘Í41÷î—ž¬a^¢µ lsZÆHbáî5ùÿO ‡Pú]úþ ÿ™ªŒrŠ%FöýÍÈ{¢ö67nì{šhòé÷l¢‚‡.%yÉû/áÐDÔ Ñ9Ci?*òÊÿÀžÁüÁ0ŒNÇØPºJ¥Óá[íW…ì>«ÓI†‚h&Zþâ4¿Ü1¯ýy‡ÒQ][ãÕŽÆg"Ì·»Àmg,&;¥õéëM~\¦3šhbÜ9.ºyŒ‡ü‰É”Â/aÇW.ƒ‰j`9G£õá:l,ôA²ä*|: x?ú9Æó‡ £AŽ-=û1–Ñ|ÈÜYZtp+Æ¢¢Ëbs:È3Ÿ¬ˆøÒ%’E‹Ù庪Qý"*Ꞹ»¹ÏO†NƒÕÛ‹·AaÇÑlœ°Þã¡$ë ÐŒ¾þ'ü¦/†Þº Dœ_ÄÕøb>ŸÂN’]Àò~¹ä›Ëo÷zf§ÁL3&#%’P‰Øº©ëNØÚìé¥R+¢‰å^Ÿ•Dùì>ï= ®L$'Œ>2éÞפIÎA‹ñà endstream endobj 11 0 obj <> endobj 319 0 obj <>stream xœ­zxÇÖö !í&€´ÉôšPB ôn°éÅ›jãŠ{•›d[n’F’-ÛrïMî6Ø€˜f½ $„¸!³Êøûî?k'ÜÜ'¹ßÏýÿû¬=öjfvÎ9ïyÏ{fÍ#ú÷#x<Þ›œ¼‚=}ý>ÚâçãäËÝšÀŽà±#û±£øûQïQfoÈû眢°d†À@Ù`‚Ïã…isVøù‡zº{[M²Û²}òÔ©Óþqgæ¼yó¬œÃÿÆj¥k§»¯ÕüK¨«·Ÿ¿«oð«x´··ç~+wïp +'Wnš½“·«—•µ§·§¿¿_¨Õ¤“­f͘1ó#ü1 ¯h…wîíäâégµÎªwïÿ| ‡e¾;–û9¬ðw\°*Ð:huðš›P[™ÓÚ0çuáû×G¸lpÝè¶É}³ÇÏ­¶yÙyÛûlŸ¼sje¿iüÝe|<}ߌ™™³>™ýiúœ¹£?›7_²€߬š˜•6‰ ƉyÄXb1ŸGl&ã‰-Äb+1‘ØFL"ìˆÉ„=1…ØNL%vˉi„±‚øˆp$V;‰UÄtš˜A¬&fkˆY„ ñ aKÌ&ÖŸëˆ9Äzb.±øŒxŸXH $âbáK,&,?âb0±ŒBXjBD %hâCBF #ÄD?‚!†#ˆ(b$‘F 9¡ ("šð$Þ#q¼‰þD o¯¦ŸO¿&þ ¾®ÿôþ5‚U‚›ÂSä|ò*ð½!ï¹¾¿èý‹Æ ¨ð÷eƒ& úÒÂÞââ>x6xÉbHˆå`Ë"ÑQ´èoCÃè5ô÷ú ›>,Eä=¹ Õ±c«H7½‡^‘ r•}¤è˜éŠ6 [™ç”¬JÄDƪw©Ä>$ü wrÁ&{ê’cò<¾bz>†£h(‚Ç¡%:.°`ï±ãL²Ï-uCe÷0‘?û±Šþ\¯y ϾÖ7ÙYï©SÀEÚ‘ð½mgP·ÐøðPÉÁ·¤2Y jܺ]nŸ@ù5’MÉñ6RB‚uªxOõn;WuÚJP *4WÕ½ëíáÖKèAŠü[.w|~å¨Ãb‰…yºybÏ<²‚öч飳dƒª-)9,dz|Ià"Oˆ“×tEÚ¯LÍ}5Fp \Îo©¥Dή¿z}88.kv­p5y¦/6tKÒM”è«öÚ²#íkG”MGèCºtP< Ž¸àh5Úzà¬3JÙû‹žÊKt5#Þ´¹6{ã.$ŒP·Ô‚="«cç×ðjžÀŽ'|XÃzÒh„qh2ýx*¤±_û½SàˆÉÏÑ(iøú‡«ÑHDîX1²Í38l¿ôHÊEeN!v>姛Ò¾d¥ª.±sûáå Œ¼ ±z9ˆdÐ,LŒÛ­ÚÉ9ú¬®^Û :Aƒæl_ÀwêwëÓÀ=Ò$8•]×õè6ä׶|õœÊY@º.ó¶sY?Í£±0۫˹5\à* eav4:Ì+~ÆWóͳºi¥qý~kÙÀ íèCø!t€ë ZÀ¥/^íw‘®¨&µÇ’²/Ï1-ÏZfƒÏB׸ ášcA!o8 M€Ñîä7\“X°/¢Ãÿ6]²ü¾¶|;Lt×ÈŽ£…½î¿ax7gÒK Ž2|ð²/'v¿Åðf²*¼&¾¼Ük„ÂÛâ¦ò¶ŸÁEJÔùÓ¿E”›{lT¤dÞRÁ³Þd¹û[²ÀyÈ‚Ù)YyxhcesÁ±?ž³‹ú¯ùlæ6çüfÎ÷²BUûªÙR´Ï<Ä<•NªD3T!²Õ¡yZÎM@€&\톷U'4ÜЪHƒ€a¨ÀØ(Y "\!G§zÄbyXXÈÚ%”)*‚—ô“P´V©ÀCm}Ê)ÆS˜°%ÞFž€>¾-Z˜sTGYØÈÃÐg×¼áŸ)¤ƒIHa?”€|Ì.ùš{ÍÙÏj¯_»yã($À n@8¹Ç+€&\â Ù§ÙÜÀ6-ê(²IÕªJQ‚E½9â« ‰Œ£à@öº<¥^ 'Æ}Åá°be`fShؽ9ppQ^rZ–ä5HyP€T"8>PŸlø‚ýN_|ÖQí[³ jš\àgpþaXÝl =…‡ë‡‰:ŠÍSèvÎÜ8Žìp~$ÅïJrçö'ŠÒ]®ÔšFˆ:R€ Ô@)öd1Nî¨jŽ²GêA—ᤱ“òª#ÕrMRÂ>…·<‘uć.Oœ9b;×ù(XKštUÚpT¨ò•iâ”M‚*¡ê ^ƒ пäxI˜¸]£T)“â˜ð8?• pžZO ÉêÔ<í5pœN¬Q–&èA0e[O‚s)íGuÞÚ½ Κu8ˆþÀìÑNÒaçKÙ¡ßX›,_ãr±¯äùò–ó{ó妮\[ 9s>èK˜íú=zµ\fàR ¿sMÇ:ªŠä^¹’"a:“žÑ>à¸ÕFü3Äe˾߲ł=pæq.®çCoxŸþÿs@Uj¾ö,h§ªãþìí>`¥;ª=°|9¢Ÿ¨Çþ瘾çY° eìÜËÆë6UPs{• M3Kk•OÜþΈCñ­€‚Þ\Q­, +””ÈüsÂãy¹þ…­ÃÕ›>¿rÜc—$ØDj»´¥újû|÷Tg@!j嶙;‹=[C¥Ñ'"¯FQ¢»-±¡®Ãí\W.ß^LÒLZ˜“e‡ÍÌaKÌ î?ìª&zb¦Ù,ºZŽÚ²O"~ÍŽôx± ´M@êf^Ø ½f ‰ýÂ|u\Ë‚#Rp! ªµ:cr¥QœT&˜¥Voì–0[×[þÄ—©Ó• ˆ™@‚ utR|LØF¹ ^ØYB1tv€ýáÆΣ Ñ¥¢']aeÁ®Ã-à½è ¼Ýü¬%šÉeµ^wKJSR ’öŠ¼@yTb`\" ;¤0%ÓO¢Q ‚ƒ$8¬oH»!ŠòQxÇê}´aÀ‡ZE.ò„b“oÁG9œ°ãžòÙ.ƒß%P,è½”´V}»^\E.W…€íÀiWôø6ðÈš Õ„j¸(„Î D+ÓRÐúÝæ¾+h`Y¡ËM as…§ÀËèÏákï§nó Ÿ¬+­LîËæ­ôšK‚¹_p°ŸŸ—Üx¿ŒÈyn|58JÁvòÏãqXW¼ó‹}F- )»¢ìÊy1ðÕDªvQW°ÌùK-h¿ÃÆiÈ^¦ÿ£¦[°çã‹xl»‚6‘ÕášH µ¹åüÈfu®&M‰%ˆŒ÷öq-Žöösý €Íâ„lU'µÒSsµ:±‰œŒUZ¾vjû¦×©sÔ) ˜…z& Ž yÆr Ë¨ÊªÓø>Ì·eçbšƒá{Où±h§NÕÔ%^h<ÔÁtœË:à ŠÝñŽÑ~@Εûî’²ƒ%1  óδ™œû¤‡7VªÒ5X’2 '+­LÛÄmyÞ² _LÒ÷nÙ¤6©³de‹˜¿¡Ç‚6á ‘’™Qš[dž#ÑSA«°äráÙâóÉæ*œQu%3¯XÏ”ë&r^Šsóô¿Y_¦ÉŽá¸YPG'*•8.$Næ5‘ðˆX^_Wa¦Š>ëyïóáݯéÄ9‚K¸žfai\¦9Ú,]6) t0p- '8@Ô¾ý1Á®{/-YŸU]ÔfLmÌà›~Ƥp1¸e.­‹ÚöÜËÏÓ§¤Jà`8”öu^çê¨ýG ë« ¤e9§²¿ÈÀºïGóçà"Žç¿¤©ðz$¸®çôsÐc}h ÕEi#3¼+ô^‚0¾¢´,«\ËÖ ªÈuØü ÚÍ\\üI ˆˆŒDÕ¨T ügóÕ‚ÍEìÇ&l†©4ÖÎó ©Éy€É6Í¢ÁhÅHEÇdyÖ1ˆ’¥©ó5År£œÑr,ÈWÆ+ ±€‰ð(,ªÍ5å–¥¦1·_¼As´êtyZlZ<Ó‰OÇæÐÙg| >Z“ƒ~,ú8Ë»Ä»Ü K¿åÃ)fgZ™¶7â@ÜÂhÆï4™Ÿã#íq'ÁzüªÜqSCS@Cì Àå©E9/oŠÖÔ?·(H-}0z—cx@€dÛVÁ†þ Û˜Ÿ›oª<”× ¨î«­Pÿ‹æl_VSÌé—òþMø]öyGâÖè²>”c›rA±¦Cy¨é@©G’kŒÏ)/a´ƒF¥‰×h˜ßxYB¢"fv<ÜApŸ<®ðేtÈÁ˜’ðŽµp¡8!/){);#­D{K¨)¿qSú² _]¦ÊŒÉñ` å˜Vƒò˜à ^s]v¹SMZD¥--ˆÍM,Ìp¤áà·p/ë!nú¾ ¢LoâV]ø6·ö­ZŽÓ4[ ä ˆW+“bñæ6É:Yº“WþˆÏŽ…iКҜް¿Ô#Ãì[Ã6º®Úë¶ |B¡O§Ááw rŒ’¢šØ7™—Òkpþò‡PüæعË󥩿Z+ŠxßÊÞ|Ê7û÷6NUzràlÅZ¨œþ…íË”ôVýa.:KzÓ" ï|·s”Óså±' z;Ú·÷q¿üV¬ãù‹•»U{¹çü„q˜‡‹¿ôáp/÷œtð%Ãî!aMÏ#A¡05ÇkÈÉ=”iJ͆֬…8»2³$¿ŽãÕAz–©Ç »“]IW‘«Ô>WN^iñÂxAõMt‚5U%̼š\”Ÿr·2c…¡"‚ý=±DñÏ#d‚×z8ÂÁ¥RÕ;”èJSÛ mbaø¤p§ø©œ D#„©oû…#¸_˜ÁÚÐ[KýÒ<€?JT|²[¼ÅÇm9˜TØtì¯ómS\ÂÒµ$9%òŸˆ§wèrµ™€IÃu°H“ª)ÄŸÔ{ŠòÏÙ6¶?°UÇ*‚ýv9zïÂ]úoàÈ;yñ»ƒMŠ zi‘e^EoÕ*Á6®Oú÷]¿Ÿd}zº¿‹É@«Ie4¸®(¶ã·Èå"?¦7¿—–?>Æ‹ì a¿X°A²С.­å±6×i…q­k°·H¶À®Ò¯#¬6Þ¤î¢àá5pD-C›­M™$—ÝAýÝö)‚œ%óvXÆ‚u9v®MöW¼ï€FИ֜_‘Q”•l 6ÃHz»:H㎛¹­] hK.Î*/:z¤¢Ô‚rE¾ñT_ý왊^ÝÊuþeoøì³ÂÐ44 ù#78M…{`0\ @膬 J#œh¸ä²@.Èq:zMG ‘“ñ¸þ‡×ð3)®êæ)—yÿÕ͇?šèдh½xˆÀÍ6bߊ=À†r"­½!äµdjxÇ#€8˜L=†% ¾!!™e:S‘Z*É4`‡¾‚wkàñ†Þ¶%ï%æJó‡t}Zer–vD—ô™ÖÍÒ¥HÙ] õË8ðÙ¢³H” 4 ©›f‰Æ„pI2›ëAZT-ª4Xöo”'Ì”ÕPyýÇ:Ëš/컡W·öÞ0Ñ6—µ Ëš“2ј$·*÷LGÀì;äÎA”觭^¾Ž†ƒe­;nÇ-Ü ŽJT`ôøåG¶Ëgï‹ÞÈãänÞÃg<^Ep*ðZÜÜyl•ÍnʬÈJË(/–Rtºäd£Æ€Ñxœ(h®l©-n'@¡*+®ˆBÏÐW[·Î±uÚ³A*úi͞λw[.JÛzìh(8lûéµc¤¢7³7¿ÝRÞÜ”'ÍM3é®aGÌÃ0: Á–bxˆÃèÈ„°Ïà­ûµ×ÙšLƒAgL0%VÇÂI»Åõ1ÕñMqݧÅE¤KbŒF‰)x[΂ºõ)N)÷R3:+á ë·! à8 îGcà0Œ/p¾ÈZ¡±ÐK’f^NÃ¥/1ÂÜЮOP4sÎêšóR‡ >ÏÀOÜôýk8OªNûœ×{¦ÊO5O¦O ûH!çEߊ¢Fòß9…OþÁEææ1Üá%†^ÖËa"ÿ^ð‰ÓꪒëF¼îÚ9gúò͈ŠW­Bš¡Ð'e*˜ìH}Rz4\‡€Ø‡¯øoq›Þˆuu:ÞÂ…¾-xé# Š<$ƒâÓÙåµ%¦c ‹ù?[u –D ч˜m<Á´V}tÓüGV{'Ø£ì8œù¼×8g7ýeÃònIº›ýšö ðñ-¨¬¬(¯4ù›ü°ˆ)–åpTÚ /âÒ°•-¡Á‰ä:ãÉ5{ŒÛp‡7¡aŽYî•þÒ:ïÖÈ犻1õ1åÁå¡™¾À•š¹Ôvì‚E‡š%qW^Bm8– `·:$aÏ™À.ENòåÐò8¾MQëW.õ¨uÊBýsEî¾Zp—ê¾pîѡƸ¨ ImDF”Þ×°ElœÉ“±Éw°ÉŸü¥Éß’`RìÊ°ÑÁÁQ¡øy‘º8m¦«¸+ù`ÑÁcõ­ùÁ=j—y;íëïïç[áoª*/¯ª (÷ÅöšÍÃÚy0‹¶4ó0Zï© û¨žïkÑëk)8]hJmPòBqµ\ÒJ9³Bsøi\0SEaÇÍÆ;íJíj­8e‹ÎØRÕÂä{ÚÒŒtàøˆ]Vŵä/Òãm$Ë w¯u¿§‡„„ù(åY¥ „ ¾y^ÕÈ»×ÇdEBú•¸­¡"³—è‰äÚµ»öºx/ß$fwÿ1/ d籊zÊÎh囧qÚõ]j$ºE¢Ñ«mÐx$Ýx •Àçïx\q ÏßvÐ¥ÉùFèKð3¸VÔÒÚÖV|@>î3þßœð×pþ£è°0»)±,¬0OÁr õÃã ç]¿ßßL©Ê,nêq®^’é‘cǜϬ­½—³óÄ%'3r õUœˆP…ƒ`­¯–IÄ^ˆÔâjÓ©*ÖdÅ‚(Īä Qhm9°Éšd$3 33µPKYüJö½Jú©úp?ÃD-ùÿêxð™^CkåšK}súã+¡0Ì~çN6îX"A«ß±÷2æos~gLîåÙ}w½èLþ´ùüt_ed¸dÉj¯ËÎÖ€q~ÊðHëµâozOè[~?sü5JYdžQÈ3*éä}¶6EoL«J«€±õbC¾1½XWÃ9 6±øyÓú<Þ¤ªWe$j# * ‰{äbôërN•WÇx C×GìÙŽ†ãÎðªx"k§ÊÔd#ŠéºÃ}K"K¼fþ~>>~•5¦Šê*?÷šög6[³QØCý÷CÁ9 âj¸Ü¼ŒÞ²Üuç§Y qC¦Q<Çp¯ôjûQF1^ZVoÕñ*»aŽa.îÑô…蔈Þ+šPï(­w<íwK©_Àa:ô³}ͽàõ ŸšŒâ‘§ë'Ó§8¿‚*èÞøà©”Û©O7ÿ ÛI…îÒjµ8qƒN$í 'Áö˜;ÕÖÞ÷jãÀqÖƒ:M¦¦4s}ðvý6}lèdØïHyŠ­çJŸ^ ¦NÎ|î“îúŸ(l>«wÙš/xðÇïø¹%t 7âÕð…[x;cê"îÜ/oÔ#2q·­O‚¶ÐNüüçªSàn3Ý@¢Ž2GI)¨fµæv5”]ÌÃSvs–:-C4³GÖ /×ÁÔ+–ðñ׎O†‰^aéjaþ錺 u€¹tÂ~ÝÒMëVÆÅh±òÒFÛ§&Ì+H©ŒèɃvûã7¬ùx·sŽÉGT¬( ;é+.Úænp8~4®Ü?´œºRלw´vÙa÷²Àüà4‡tJôêþùªÖ³Ã/;‹ø«÷„íÜ)áÜks‘kq¤j¡ ½”cäŽêõ½e°8fÅ>`T¿‰-G}L8ÇÜ!ÏbB5©¨䮤0¥¥T (h­{˜Ò"^æzög `áEy ¡ü…ž¬þr ÎøšÇ¾ÿ ŠØ¿ÑN:­Á€””¾C–|Ö ã4]>þwiÒØöj—&swµ´{樦ªö&ˆÛÚ*²;õìÜjD þZ[ijsÈ/—Kw$/ْ镽—1E5)€+àFå©öÏOÖ\·)(˜ wº+ÜÖ÷º¢{€>sëà•º‡Š,±{t¬jGT‚ ›‹sbÅ0µô_~Ç™U ŸãÕ~3òÙÙæÙ´[ÞT/gÙŽ½Ì¸Ù[‘@£(4ïþxHßÿ GBÒúÎhÅ®M’¥FWmº_À5')ô)ºJqÜfÒØkÏÙ} ¯O.Èȓ׵•¶îŠ}ùï´‘NWá¥â €C\|C^ÇëËp \ ¿îUKIšù`9pÔNá¼›(ÐOœˆ@5ƒ ¨0õtÚùÔ´VÜÖ ÷ÏóÞ캳Fu"¤Øs…<(ù+J(fïÓK]õöº /SŽºtÁ‚x2–4&šJed)¬Öæb)RÁ¤4ëj@1UÆe—¬ÎL×YVÝØyÆ_Ý›û»p!|A;‡EÄ„„R¢Ç®®²=Û‡{° 0)ƒƒï»AÂN‰èî÷çkŸþpe×h4`ö’1«+\m‘@Ê=¾àwÐÑnøÜu6óçl;÷äVeëíIÁ´èîºj¯¦cÃ/··Ü¸Õ¾sù–@[§Þø¦¨å>„yßòŸÉhÈoh/9ÙúüÁq¬‚áp .šÿ3£¡S'bñCÞ™ûºîPFN¾äzWZˆx˜Âlö2q$´6O¤[@mXñþ|¯LG°‡šn¿~ñ»¯_u^øZ‚©»†CŠ?ø+ÿÁýÿp¯ªº—f9¦fõt“I $´H–)L„<*,<5®6´·l>á܇üËÚ¹;ôÏ ã^fM ¯±÷Ÿlr?4Ÿ?×îÔu|*ìypr—¼Ùõ¸ôÂçþeë7:49ål š8v š´)Ë©v‡Þ†¹tÎÎT܉!¾ýòv.eg<%‘õ´¼%¡´PPØqùáñCAµ óW²"x¬¤­šJ,Ý„KoÂaÜç0Ñßá^\¦Y¯š2ë’íã'×n<{d{y¶TL¯Ù1ïS­vö>Ö<%eíÑ‹Þ‘RÑßÿ8XòWƒ{F£4ÛÏì#Ø/ìé÷ß>\%þ²×‘pÜwµE©i Ÿ)çDD…Ç„„H874ϣѴ@P/„ƒ~†ƒÆá_иϬ~ý¿ä?7÷´y(å©ðÑ &9(þ<:9Ó’›‡Ü–ÂŒ_›]Ši«0¾1¬Jž›X ΀ö¶ä..iášÿ¥hÂùAÿº Â‡ç°¤8‰ìéÚ¾ ½ûø<0Þ(¸Tþ ¢íÖ7aåâ±;os°F±,VeÚgÖ¯©qùz1e!+4¯)Ö¿ß= >màÀnãÀAñ‹­ã endstream endobj 43 0 obj <> endobj 320 0 obj <>stream xœ¥yt×ÖîÙ£¡'¹Ø„Ì8@pB'4ƒ ˜¶± ÆY¶%w[’‹ŽÜ‹Ü-÷ ˜fB `!¡%„p!„„ä…=ÜãÜû¹I¹!ëo½5°`fÎœsö·÷þö·D”UJ$I;­_ÿþdÓÇoŠ„}„·Ä¬ô/­Ñ1`Õ8bÌWCŸ×áÐ`Øò%‰‚ÃU‹ƒCR?_™Ý¸övïÏš5c‚ÝäI“fÙ-Üí-õÛádçä)óõÞí)#7vë‚wøyËvãæøÊd!³ß{/22ÒÁsw˜C°Ôgžý»H?™¯‹w˜·4Â{§ÝÒà ™³çno»®Ý9tý³8xwH¸Ì[jç¼Ó[DQÔ–…A›oY²õÃÐ%Ò¥aËdËÃWDDz®”{­RìpŠÚéì½z×_¿uþë6nܽÉþÝmã]'¸MtwØþžÇ¤è÷c&ÇN‰›:múŒ™#gš=úƒw挙;vÞ8ŠI­¦fQ£¨5Ôlj4µ–ú€z‡r¡ÆP먱Ôzjµ²§6RïR›¨ÍÔ"jµ…ZLM¤¶RRÔ6j õµ”šD-£Þ§–S+¨)”#5•ZIM£VQÓ)'jåLͤúQý©9Ôj.5šG ¢æSƒ©ÔkÔBêuÊ•B¹QC)wê j;ÅRÿ †Q6”-%¦†SVÔ›”55‚¢©·( ÅQ ÅS}©­Ä£äUõHä+ºÙgXŸ´>‚ØGl°²µR[ýÛÚÓú*íA?”,’|ÂL`B™+}=û>îçÛïiÿ•ýKŒ4ð­Ñ¿´cЉÁü`Õ௕¼þúëG† ²wè[CCÿý†ÇU,ÍVÿãà ›1,lØ©a/lÞ· ´É¶¹aóÂÖÖv­mŽíýá[†7¿òæ¼7?±hDí[ߊKàVrñCx­Ý<;ùÛÞŽ9tä®QGÚ7š½V($ X„¢:ÁC ŸXå¾H$C(>E€_먷ñ—¡  :TÄÿHÕ¡††0Èׂ•5L§k±•u`ØŸ_Ë?“a›Óx²Ž3Z:CVäŒ4§°Â¦kÅÑFXo Óá(û“ÛÑY˶{Ë£¸VT´ƒ[Adž’kÉŒ‡ðe/󌥋jÉ¡(–÷‚ôÓËmg :G{I^=Šî\OPDÐ ·Y€Üº¬k›!äýD:6¤ó³r~v˜ Ö¥5ÝŸN0¯[AÃ@,Ƕ¸ÂZn~ú¤k)ŠäŸ€ësìjÒ Äó"»vÑð2ˆ!Ú(¾$Û9ilu‡2¬ku¨‡DÄ翽sm«qN)²äÜqôs}Í=܇ÃCq) ^ðšäëj'×Î3xLáÃ,DÃ0É/Óü¶z;MæÉjj|mŒ 'øºB ¯OzF†R“Æá×ñïÇ¿xñý0„ÃÛðLv±Ó—OvéêÕÏV8ŒwZ°˜7N>_!œdËèÂzbM0Š³ÄË”®—oW…ÙÆžZ}¿`ÊkÿŒªÉº2Æá‹ÖØ9¼ËA5¨˜]܃r88›Š7%ÑA#œ¹,‚„{l ª V$'¨R¸T¥R‘ªòÚçVì‰ÌÚa/Ã+¡~†@߯Ûâc£“£Òx%~}Œ* 1ÓAãaü 9ïñ^Ÿž§®@L *«0ˆ¥˜Ü…™F1¸c)kZþtuHkP;b~ü†Âà?Zä¶=1‰oAÅŽÏŽ=ñù»Þko7~aXôþøeË>\°ë›“\/žÄ!­Qwá›Wˆ2QÓŽä¾Kû+•þü ‰Éš[Pe9w %ønGBRJA ¶þ•¨œƒ§tKN^3_R†ªüQ¸œ[Ž$½³ß3B©Q|±'²:öCi‘<Ûh`ÀH˜ SgÂxlËc뎓¬ |"æ4A•Æ×àAXdÐ]ƒè*È®;¶wa¹D^±ëàRâ‘ýDüôí8]?ÔV©çq˜»¤×ùðž9ÓÜiGvÝÖ™Ìwºþð‡«WoÙ6Û© ˆ2ÀŽN_دoLƒC,ØоHÞÒŒªÊ¸›å¾¶¶•îÅê’¤IïÇá›c®®Cb¾Þèî+3p+qEpp™„ùx#¬º-†@XËBÿû×¾ÉÊFš,.ç>51U%¥•mž%[–»ì^çÆèZlŒÕ/ñåùk̉?²;ñƒ d=7Âã1bÛÐȈWÛ6‚@ûWÛ:¬ÌÖ4v(w›ï`”y½mtoê_3@±A,ÌÆtæQ˜Z¦ávT»¡Hâ±á3ý¼ªƒ÷ÈùfECò½¸ª»qh=³ËÏ×a¥gÍ\rQj1dG‘ühI4 ¯×å¡CÅÜQïS›Näÿ†_ÓoË᧯ÎG‡™º¦æždº‡¦sé‘e©:sžÅ`¶ŽD­F¨%Q´ |ÙŠ–Àf¢“CFÎBÌìy$u߇»¿ß9~Ú{l!Ÿ!-GùÝ3Â;“=Qê„äT..À¿qGÙvd‹ûÁobGìôÛB߶Ãe­{øÐNxõå\&7 ¿Vt:z ñ@ Ð—%•«8<ýÝ噂›5]ÒÍpEüœE;|æ÷Å™guÏ+P¥ à4«]eˆ™‹NVó–ÌþÀ¾Ä„/+{ C Ef+±ö¯JsN·1ÒîÅ*;”á´%EöŽ 'ï‹£Ã-ÜnI t‰½UÎvÆÍŸêènzÖ²p÷9h_Õ’¿¾×Ñï]¾õÉþšÒ Χ•r—^]EIQ€6bäs +Í=ïP¾c‘•æQï˜&IÖÃKƒ¨Jð sˆj-°èc¶¯†&Õê&¦à¦uÍ«GÔÒ ÁO ü3"ÛrT‰ ö0½Ó r±°‘L_]óŠP;FoÁk Rݞج0¦êüQJ‰W¬Œ\¦ JU0z¬Y,Üýu ªæ/àÇÙ¾%©UÈöJÏ­¸’··älFQ8Ú¸¬`ý¼ŠåéIûQ)ª@9­L—cf~7ˆÚ '®™ ­ì—.wñ›žï¢¥!å1•Ù-釵ÊÒjõé:m!Ò¡*´µH÷£`´&mmŠSä–¨•>hó᧫7_ÌÚ÷1Wá2m?bª«» LÏŽå/±D´ExÉ}£\Q*bÖx4:ÿb 4ôíb¨†±06Y7Tuûe†Ù]xÖ[ƒ¾BÒë´ñôßT“-¡³GÀ³¬ãzÞÑõ> Iy3Óî©I·Þk<â®I« ¸ FÏûÕºªú¿Þ˜¦ÛKC<ž¨—™Ö~yЧk áÀ‡xˆµ4¬'ôÄæ5|»s䮘ޒ?Møü¯iÒ‘gb_u4p#p_«¿¯ñ@AM&_H2äc #ß5oº¥CéoQ¨®êtORÚUœ#V›ª–C?!Ò :|çÉ•àY.øƒX·É•)‰u ±©zõà:ìpGf"JC[”:5&X(uÝ–¥ÍÈÈ&‚¤*ºD&‰’y7ï8ù´ ØÜ ®·¨Ü !|Û¤'El­)e)ÊØd.|ýVub¦/¾öøTqí°:}š&ÏIÓjPr†W“&1•åÅuWÆ íxþzl7z<Àð½ÏJÌ‘y¹ÊIp~$plœWô6µ?1Fyr*§e&TE""é6ö¤`-ß¡”„J» ú²ËN) å…H­$;0#Açs ‡Ù¤+ó‚H:•ææ–e?‚TÄt„¿úC¥¤¶‡(6Ò;‘:^Êôíq#"™»N±º‚ÌLTÖ­Út©¶fÕVÙ| _ˆOHIAŠnÕö{—{O™Å‡®‘X†ckg8Ö~E8âÙtt‰×gļýÞx<~`ÿ«±í@e9ï‰âþ™¢Á†]ç6kÁâµ×þxùò5ã±5›Ìù¨B«…lüžHÇ¿«=?[”ANz·„¼Ð²Í`ß1ÓFçGê buûy!¯RÒ[çÆZ”¹¹†N-HªUœêf@»³ð&¡ÀËP~I,L…õ¬¾µBß?|fÆÍ9ä{ ì±ïj³Ó*åjUŒš—®uL–£™hŧ ·íY¶ðãÉOÑÏH?=s ÓÛ2œ5BAo;X8Q‡Wà!¸ чÀ X¡¯ƒ6»c; …W';…¢sè3t­àxÑÙÆÂ{èjŽ/Ú¨sEs‘3rBó6$ls@½o´v4>¿+dR-ÒzàIúöUÔÌ¥åîj)©ÒÕŸ›bæà1™Û0Î,#~Æ—-zIÈ5?¡["ºuòRZ§øÕ²ð ÌÕï¿{¼ø;Ló8ðï´-ô7û*„”V¿Ó?¶-Ùèâ¾|"ÿ¶ir¬h‡¥í†vðj]6Â:ãsbpù„wCgÊ323sùŠØ–¸}ˆytõúƒuSD _[TQ¬ÍlÐh£«Ém,iY§pOñ÷äý«ürƒ3iÉ¢iáYÞõ>¼<8u7ŠG¾¥Á¹IëwGn@;™™¿¬"t9ô—‹÷a4^‚ü9W Ù-îGΟ?zäÄé67·|þ…µ_tähqÖÞÖ*¾ª8]AÌ·ÐMq[´Ýžï9$è¦ë¿ž€Ë_%L‡òÿÿ¨ Þà֭؇A·ÒxÜ8lh<†sìÙæÆ3è óõ¢û¸‡çýß ·`zè©;D\6¡æàªRŸ=ÐTîWZC´ô¥Š+û*’ Ãv§…%©Rw(BБs—Qvb ?4.®!¬">ÁL»‚®ÓßY½uëöÕïõ–ÓGEHâå¬ð[Y!•FFJ¥‘555^€G˜Áø2¦-¢¦Élõ8ø†îD²7£N]„CMW‘¦ôŒç¶¶¹äøš?Êš½;³ÕüaÏÒ”ÿ#½UšR\ž/EÁÌÕs¦-ný6™ÓkJww·˜ëì!ô鹇uÜY+ªC¤‡°¾öÏï®zIÍäw’gŽ©–eïÌS¦{ûïE1§Ož¸róÔŽé…\†<=®Þ¢k—„ƒ&»Ý…9ÄòŽWZ¾ºÇòjTÂàŽI4ŠFÁ»B|ƒQi´Q™LjÝ©Å-þ Üw:Éåçï?Šn1ÂRI]ÄYk„áF°íV½`ûŠöìõW4ðÃ;”Û,âlÚõi]Ì2È zAHy/ä’Œ‡~ÖÔ2Æ쯽4žŽ¬á·®õœÍo>êPº[øuŒE»}Ÿ¾}ƒh¦ÉÖ=§s`ež>¤ûÐ%Ó ºi„8’_+‰uuª¡¿çà§49nØ´qåY 8xZ'ù›q¿Òxàן=ûúÈýwÏÐ]ßðX‹,ԡă,î/Z 0È´Ç$½°ß *¤bÁ™ì°©Gµv1U£F~6þ2nsÔµ—­†VH8œxhüǦ±Ú|eš¾ŠŒÔÒ`ÛQ•ç£'E̶’ˆô¼=Lïyäév`LÄÂhg+XMñõ‹Þ©‹Ã÷oCî(0H™¤iŽ@ Äì‰Ç—%áÝÛ¿ß#GyX%¹¿ïô‘ú\_W+%½'ƒ×ÿŸ†ôP $ˆ@NC·Y ͸WÑø–Ê%ÉIãM H¾æ ›QºŠˆ´$rE ¤ˆ”$w¼5y9Ušº´¢äƒ›…Ñ6mh÷T (› ôEGEFdº|²ÍGz”W•žý1Dfž N¦ÛÇ8*3)?ÒÔïAée&ôfê_ÊHsÝL|ü”Tat[þËâ§~G~N@¦ŽJŠÏI.‹'žžvGؽ„ÇâQãâ’”É(ŽIÊŽªª¹a0å ÷j@ß™f|¨†“#/ˆ…y‚«ËÎËCÅLy”.V¥LNUsX¼Õg|‡*mKc ££cãAH©ÕpÚHíZ$Ãâ+6ê e– 1±Qñò˜¼$šÆ 3«âÕII(ÆV^_”“›•‘ÍøŠfeZډ䶊âøâ’¢ÂÒªÔoQ=÷̹::å Û¢R]¹N•—”ÍK‹×7xé;M6¼´'aBÒféË×̇xí¯J àÿX) ÌNÜÃÁ"‹p¶io èoôðæTtgÔ²0’.lFÍ-¦Q#a]ˆš‰T Œåð(No@L~Q®¾!É]ñÕ8Òؾ/An(!<6Xî›ì§avË5ÁA•š"þ3Í¥ètÏ–ìDa}¹5”( ~;íEÍ L“ ºä\ê.6££ä¾‹øYÃs„’,|N¸Ã£Ú (uRœš“{øoܘ£‰HC¡LT~|e{Ûáô ®cዃcµ™¦Ðf’é4ãå[lo†ü±Xb™¨³¢ú ÊÉÀ_ „-Òýò˜zâ]S·1oê Ͻ©Ùe•EuåªìäL®èôѽÄ|ssëÔ¹kVopåq^—”šŠâmM[áà9]™MJE1£ïîá"Â8¬¦ÿ /,gÑq¤k,©+jÊjÔ2åÚú†p-áWíúŠ´ Ì–@?à R.¢sãÊ8™Šü?ƒ ~ ´ùân§â€K$D*ú¦$EírH#,š£ ªDe§aXÞÓ¼îsÕÜ‹àn]û rÈÚyp†ýíè¢ +Ö:Më~¦(]›®Õò™9¹(ÑG—‡EDÆN}²Áo>9|mÊ~î“ýuÐÇÌÍF^â¹Ûú×$–˜)Qæ!-׸ÿJz)b.Ÿôq ’Ï©âw¥E§¥ È´ä8ËéQigÀ'A_Ñxb:ù$^Ž-ŠIP%')9ÆÃ+ )‘:K•Ò$×…˜, MTJå²(¤`bŠb‹ r²òr9­¶íP5ÊEÙÉ9ʺÀòø:ÓùWm~nMyU)*ë.Ï} Â`âþÏÛÅûAÅ&Å¡42‡oaJi¸Ïj ¾ùÐ̸«¡ÏMóÝøÝ¢ÊõãdtJÖÄË<·c0 Að«5þUÒêÌ0ˆ¾ílÄRnÍô]H(•<®Ä"icIfV~.׸÷HÉLj¹}üÃg/Y5cÓÆšc >33'‡l¼NV•¼sÆ׋¡ üé!Xý²àfü·«ež¬ï^ñèyø€hPIÜØ°ù`óÏŸ"W•Z’œ’LøN^Q[[\^uÚëØd<Œ\ƒHK«ñ’'/ž| ïÔoGmv‘»yp`‡²vá0B«Õf¡ e§"c8c¸wûìò9SW/îd½pÈ j3^ fö#fâM80+‘#C²©¥IK²)6ßg 3ägf¢BƇïÐZu‘¬ó ç[ï꫹îì<?g„*bË7ð5{·ú£Ó¨¹7ó6î‹ûÎœ;kíñM·dܘï¥hcÿýTƒ¾ðì쮫ï4s Ø9ëNœ9k8~ë–aÛú .[çòø’Õ´UŸ\ºöù¹{÷«—/q\;£³–ÜÑCv…è?Tü—Ôý‡Äÿ¡®þ‡Œ¬¶JÕà‡RÑMÆÖ¼ÃF›  ­CõH[«-d`x°Ç}3”È)w¥§`?m¬6´Õ™Ft*Àçá(q‰*oˆÒ,±‰Øv艤yÎP”feg䑤*Õ‡†ÆÈe[ömùl¡/°°2±ä“i„©§ã¸ß?§þv¶]ä ‡G«Ù¹ë?¿óí•ó׿®Ÿ”ÇkSQZF˜V.GjÆÙeÝœNîÒÃh£é7ŠwH¤ÿ f±·Ì²`]ã­OšxÑ%0 ³E¡S Û`”š‡2ñÊÇóÌ¥í2­Àã­·˜¢£ñµû^”lëQFmza !æ/üxÂ’¦ ÈB]…<ÍÅVè÷×j‹¯Y½ªÏÔŸ»awÀõÂ9Re/€Øâ b8 œaO«÷KuÛã“41(™ ©Œ-ËÚ—Þ¶'Dxr ×*1Õ‘ ËyK0·jZˆ¢´ØæÚL”8æïIlËÏÍ(D¹L]x‘"Õ¹-;<Ø8nI܆T[Ìí—Uüét|á7k™µ:ÖQçv@Çþ4Ÿ1àföb w´mñÚ²$ž1«¦ÿÍâõýØ$×Yhœ2%A¢;Uù£_\ ®óó  ’øKëá<Œ;©çÁþ¼hOû…öçä¯X˜IäFfAz&Êî”2•<1…Ãå8¦$öU™SV™SVÉÁßØ›» [·îZ»`AëÚ'Z 7¹i Ùyݱcåuå!®®ò¯¾boyŸÛ¶ÅgÍÂyû]ŽŸÜwþF×ȆŽwŽ rßfIvuN/¸Vté#G!ŽÍÏ)È&l¦Wèb¸4R“†”¶øÞ¯R%‰ªÜdø {Ûä¤äªóS\¦ÓëÔù 9<>ÎÖ]9u×à ¢zcnû½vBÌœ,ô5µ›=ô:•Ž &^ yûÅaÛ7}—¤oæžøÁ(ô=i†Ñ`÷´(?ÇDÿùÉ%aÒ…kݸusƒÐ„ů9ºòºs=bª³J‰0‰× ‹ó`¾ŽÆŠ‰¡Ÿ±?×ÏJ< ¯aÀã€õ?…•J» endstream endobj 9 0 obj <> endobj 321 0 obj <>stream xœX xSeÖN, ÁŠÔüÞ«’0.¸ #‹¨02*Ke§lm)Ké¾¥Mº$iš´Y›¤97ûÒ6M“tÝWZh Q@@Q\—qæw—ßmüR/3óAgFþ'Ï“'Ï—{¿ïœ÷œóž÷|lÖŒ›Xl6{nBš0­,¯H´xcYš0/#ºö@ä.väî›"óc˜Ç™ðwÏLs`N Ì™á¿ûŽöyè«ÛPË­¨b.+†Í.·4¬‰å%y9¹e ܳ3é¡E‹ù×ÊÒ•+W.H—ÿãŸë²JórŠ,Ä?¤YB‘¸0«¨ì7 Ö⧅øì9B¹8·tAZffVfôµÄ4aVÁ‚øÁmžYO,#B³âo^xóäìâÙÓsT·Ì¿EûTì•[å·~1÷ÀÜéÛ<óôqqqÆÛÙ·ëo‹×Ë;ÁûYc§³Ñá¾dGÒ§÷ð®ÏºþÇœ]rEžŽ’8…3?²!øÀ49çÞŽ™IV­tƒ›—³>Ðý%ZK"3·•Ià˜f‚™6ÑZGkÀ ¥VT“j"E3¿¼±G¾ü~bë~§tcÔcÓN½¼~f˜Ã¹±‘©–ÉsʺBýÍV‹(¯S£LNgö¤3÷ œêVg³£ÉFмЅ£—N¾wåÜ^‡V)7Iu‚$&W›m,UâUÚúB¯Æ×4W•KÔ ôÕn¯öÒ6ÁEv†m৚Õu²´ø¬Ý ü¬\Q^Òš´‚´5ZjÁK„tµJi¦$i ?6’I`û¯"ÃÕÔ‘òÁþŠƒ«v\L,ñ«±ïž:Ó62Æ?÷â(âÂÄÇ{O?ÉÏÎâí>øÄ"á¯Rri±JÄŽ¼±·gÝ:1$¨ó6;Z€ˆ~T>ùÛ{ìØÈÇ‘^;×~Úu¤þèÓáµ[a%¬,Y¿Ÿ™õÔvæf`Lâ· íúäµæsä{ú4ÎÅ;“ä«b–®øÅ£˜žÏÏž?ßò6¼'*ŸÏ!b#&õ1vdþå4ÓÊs›Út>“¨çÍ|ýÈKÃg{ÐMp…x¹l4'-±x?=WVœ“Ђf“V¿ÅµD@ç­”fIŸå‹dÑØt4zín Ñl/_"[Jé²Õ!gÐÞe§^<ÅkB·‹îxˆ¶ZÉUÌìħ²¢e:¡ÄY܀Ȃ5G"ßõÌ›žÿÑqâîfž¡˜×ÿ'+§™ÛÅ Ë|Ä4ûÀ —aÂ{¢ -yç´Ð*ø¬ðÕmGt?Þøˆ™9d"5\-˜`¡Õ$"§jZÌ^È)¨4 »N“&…Z'¬&lšÃón§;-Aº´éݧ™'™YY÷</س{è1H…ûs¨¥ÖFŒ_Fdý»årL„9È;ä/rJu¢ŠIjŽ¤$c&³î#j [š®¦.¾Ëqáè…Ëý©§¯/3”jdª*Ê]Ùéêt´X)ÛIÇ)÷ä‘ý¤÷¬£ÍÓYé —3«yêdIjö¤ÍÛöQ© ur=<2)¨õ…Ý]Сêq)6™FÐøZMšw £ßóÐ,n;tšÇkÚÌd`Ìè\eÜ^ƒ3"›;‚´Ö‹Ë梎Yºè.º ¨s0¬¥•DÜû®eœ®õ¼sÒ; µÒrŒœJÍDÜ%fŽYkN\1ÙØÍdËAŒèäÏ5ÊUúT½¡˜¦;ést(T`âx¸õÐJwãië³í‡Ý”½#æ*¶kr´*‰’×ö@:Hèxa› õ´‹vcרÍbGfDØ<뀽Ë5¬¶iÎaiN²8“ÌÜ¥’*r]ä­Ù5ähr´‘6¿¥çg0Z©¿˜ŸU;1éÌíÞgo°6Û©:KšÓønóÔèiªg´=Ô>ð¼•øü)tr%b`çÅ…Ðàô¼¿ØÎÁ†‹Š›ºW\Èú’ó¸w@bÑn&™•5œ"n dÐYtJ¦ç£0i¡â˜ž¹OV< ætcŽ‰4ŠzhÎC!l4c*=< 7ðw7Ï´õÚÚ½Ç3"W>$Á¶Â}ûŠÅêÈ]«^R‘£º9d›¤®Ëz[Dü÷fÆ¢"wŽ²Ñm‘;y»˜>³Þ\cRQÕ¢%¨ˆ(÷öö_z‹ï«m¨Ó4Éd5PZƒ«¶­þZÝ/¨;Çù–ëÌ2æÕdÕð±w¢ñ¤ÚGÊTb•PUÂü–L•«å†š*„)„®Œ¥ ¡à„ðx#¨Ü9ètô[©«µƒSÊ]jR€ÑÔf‹ItìG©*4Ÿ½³9ØÁ=N7Ó >5qÚ¸ÖŽ«Ø¢uBˆ7®öÀò,Í9Gàg0l~)¦³æ ¦@›¢ª)£Nm”Ôìîõ<Í¥Ó^hÀÁ:}pÇs‡µ˜Ö¸¾ßÑmõñ“ÎA‡}ÀÖg%±µ JS[°µã?-,"®¿YÉfãŸòô¥F1(‰Ÿ¶³RE±é38=.‹×êÐŽfÄîDÔa4“Ò»Ÿ«Ð$+W—<'ÜO%,Y½.Áí¯·ÔÙ[§£éc©‡:* ­­”ý¼fÜ.­ÚhÖ˜‚-Ìd¶¦*©2Ÿ<øºÍ@ü÷ø8ô¦Ðô=AöWÓð~@g»¾:ÑT±#­\f2d˜p¶›Dœ..ÀǸõãoF§ ãd-¶hœÿÌö?Dº0:vû ­÷:ZîæŠÄ’m]“‘Û&SžŸwõ2j<GÜ›èýÈoxÞr·ÃmÅö¶7”e0>Ì<±VPÿ°òòëhϤĆ^‹ÿ™¡÷?̬z¼H:tê˜ûbíÁ ´EïzVRÄ<¤ÚZ™Q´‡Êx&+½ˆÜ²ÁÐìáO?G3~É—‰|¹öŸ|qÝð¥ŽnµšŒdµÎh¨(_zOÞZxœXÙ»{êü‰SèÞ7øÚTS ”[‡Ʈ}óšŽÿsÿ°þÁ Іàˆ§qçËÓ}6qÔ(™A\µU˜_X’’ºLÈÌÕDª//Ð4ÐÔ3À;yµˆ‰#5rPw•¯y¸í•ßñõ¡jƒ©Æh¤ ÄJ­mµ»ÞVÚ*p£7x†]ž”—´ó‰m; €PU×µŸï@³zß´œjn‡fh4Ž*oèš è›«/b¾}ÈYMUuAÊl2ë}ºc-tÃ`¸óØU4‹ôÆ×=ÞœÙTtù»Â£¤6SX¢T¥„*&¨ ¨û aùdï'nê±öæλ VgWÖÛHßû*§Öª*2r¶>š½›¬çÄ…>W‰ûî*‰7š'I¿æpO°3K74¥ûòn%3¶ÚW Šž¡¶ÕØÕ$ÖX‹¡¿¾ƒTÓÙ<•7©8G»VO¥XÄ·xôz³Ú\-Xx}ÜlÂÚDeŽçŸê?è<Âÿä•‹h> ´ƒ*ŸÞ]eWB)êD•Éâü­OèÙÿáµÕ•¥l–®(Ü$ÈÏ(ØÄ’æ‘V[‡»_x§e|h¤»çD8 Ñng™¾%ÈF_â:þºâÿÓîÍ­Þ·êÎBnÅVm¶Bk ª ›  ÄôÆuú"aÒ9àtö[£dÂ#lýé=³gÖC5ˆCý¹cA7¡¹hë‹|ô«Èµ»H]V-©¡rRµ?wM~ •›œ’*œÿÍt+]GúP¢¥Ó2Ô˜¾±¢ªRŸ¿¿r—W>yØfõ8œVPõ®ò|3T›u‚ ÆhÎà¤5µö¿÷>â\á§0O'3ë÷®YT®¸½×5R ±aòY¤>™?ÁnŪÿÏè]^3×uÁÙïn+õ庳á <›³+ywJÖ=p±h$ù“ãÁ±SüÉa]P©Y»/«"¨]ECo#VïׂPC‹«ˆ±¾òRAìwëä!öw«o@/2GûfP¥Ü«BÏÜƘ¯¯bŽ\ùÉ?&Q[Í c£Š)솾FÏÜÝA*’”U» ¦bræô`,ê¡Ú̽ÑVÔ‹[Q–µÀRáÌÿhn$“D]¿‚µõ鯑.²ìÄﳯû"•>ÙH M8î4gw4îh‡ÍÃÑmŽâm²­9V¹w4º8Òa øý|Ç•øL)ÚÄó_  ·56tÖâÑ2¤æîO*ˆ*sÔ5ÑqK>2}û0{êÃH73§yŒ†YÃlflÌŽ¢u￾ @óÞz =hâïýŠÙÀ¦ñÆaBÕ-»Õõ 073/ƒá<·>eï¦âÕ@0÷=óú ú¯!4ëÒ%<}ži¾Š9Êq'Ùh0dzðè^ot’úšÒjµ9(7„f4|Ð1p¨ÃЮô•zl¤½ÁÓé Ú}¤Â)t”áDaÒKÕ+·••J$ªBõNåSdºL¦+Ñ$ä5®vW!“”Íl“ÄSò„BaàWœò¦J#i,«Ügк ÑIwNv;{¹éÕ×Ñ×ÖZ×€k :H¡á^ôA7;bý0æ\ˆ§~A5.1›2L?¨FN”öÁ•ûP´.¦p]lú‘ÒÃÚñw ´-hÐv«ÇZ×çh°€ør"õ× kíò噽>[`ö˃†0¦Of¹Yèî/¶L1³M†ob8–Dšsƒ;"¼.”u´¥g^öùŽ×êÞøæâþËwÄýMy(2—ç¯qáïÝlu‘&‡H/«Ùƒ1mÓ¸K:<¾€ÕFÓ+-ù¬åµwÿp'¸ÍîÁ,¾¾ž‡ß<šçß™ŸöäÊ#g{»Úùm¡&ÏqñFd¿öB8gÝ}ûÖ¯ßV0üöŸ_x]€ÝEêÿ£LÓ˜*³(“yFº…rª/54 ™þ³á)jôÚןŽQçÖVÉõYº|A2“¬Í1J œ*ýw×?ÚåhœGnG›½üT“º^ž·-?q ?·¨B~ AVBF³ö Äb÷üô"ÊãÒTéeÆJÁFF¯Ä¿pL™Z=ÆãñXÜöàMt¨^pQ~­[!É–&>ÃG«Ði^QQ~^‰OÑÒÙhQú¥‚)ùø41ÎF¬ËHúvL$)ÒÃ;̵tÔ9Ø’áÙkàiaâžCéÒdØìOöç2òdU{.ì$Y·ñ¾=Yµ©üÏ gVïÖT'M”LUMEN±»Þ>4²°I°©~c}a?\¤~ÿòKMtWÆÒMß9Ǝ܉§Ý×¹oAŸÁª²ê,åfq3ÙÁmGO.1s–›Ÿ3çB6l¦WÐ8ó¡åÌ“œ0×wÆÞälp8)‡sÀÑ›Á]q½Q±¤ •l2ŠNGÇÝ0Ý€ç¨ÎïÇÝQ\4 ?-š(M Û/Å_iƒI.0IªwocÎ+÷R•IU{« Aúï®÷<ÞÑ'°¸9˜è¦‹¾âý4ø7¢rMÚüÖ†hT4^EQ–üÐ6þ–ƒ¹¹)ñ‡Ñ|Ò´úÀI4µŠÂ’´ÝüÔ<™tÓònD‘¶†ï/Ãðàôãˆ_¸¨´ª_ñ5}Ù‚bÚ_> endobj 322 0 obj <>stream xœcd`ab`dddsö Ž4±T~H3þaú!ËÜÝý£ùG*k7s7ËÂbBßÓ¿§ð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–U?:ø~Ü]»à‡Ô|Æï3O2¿þ½Wôîú 3—LŸ7yJ÷<Ž9u³*[:»›êå~ËÌú®Ñ;·sIn·d}EsiSnO£|oÕ$çÞ’ßÒÏ$'vô5usTÖÕT•Oo›Ò.ÿ]ÛÇ2=­¶¨^²¢¹©½»‚£jFÍÜI½ÝS¦Ë}—yVýÛ”µt^ót M §´¯ìš*×9§årç¢ï<ÖK˪º9æΘ5g~ý„¦~y¾âÅ?í—°ý–ŸÎ¾‡k÷žù<<@ÌËÀ!é¢? endstream endobj 36 0 obj <> endobj 323 0 obj <>stream xœ­’ÿoeÇŸëuÛ1ÊPc•l‚%¸¯$:ƒ2XäË 2ˆ. ¤+Ç:]¿Ð^=¯®´'×öéõúý¦´¶®féfjÁ` lôbˆÑàoH&ã Ï]o¨7æ_ æÉ;Ïç“OòzÞy?  ð¶Áá‘ÑÞž¥òQe-¦¬3(àPK6w¨áh¡É8×¼ûªÜÄÕ(|hÃ0O€—¦gæ=^Ö79á¤ÉÍŽN²w`àñ-d_OϹÝEù&v79l§”ËNëÍ9âqLR4KnÞæ¤iï“ÝÝ ÃtÙ]þ.oâéÎ-$3I;Éý”Ÿò½J#‡Ÿ‡÷ÐÎ{Å=_S”ßï 8œ€{yµÁ²qý:f4¨aq b LízÀ:Á.p°± û ñJ´C-¡`û^A¸º ÍÅ,—Y´-~Ød!Ô`ÑÖæÐèmì‡Û8:€’æš¿êvûýnwÕ_«U«5«>×’•æHC+ë8êW˜K°Ä0e­nmc![.ÃRÉÚ¡Dô[k(ãÊ>u§oaƒ¶ömX¿ÐÀ?.ܱêŽreXgmR\± y³6†qrLŒ@Ë©Sá/Æ !ÓkºB¡X ò–P>œÏŠ¢,[Ñ!ý84‡ÏœNC‹œÍD(ES¶¸¨õ£ÞÑÏдgM*ýöt*% fˆB$ÇE!Zz½Ñ¸ÑøHÖPÃÕãÊ‹æ Ÿã…°@Ç­ÂÐÎñÝðy8:ÿÂÙƒçžÛ ‰®í;ºÙH:/½#ÙR7oÌ]†_ÀKS—W&®L|‰Ÿ¯ó“M;i¬qbLŸü+È/ß^¿eëh¾±ôWh͘?¿0{>;}ñëìU˜ dF‚ñ+XéÎ}Oh-c!AÐ3|*–~?zí©÷4c’KD‹ÈÊPÃWí×lÌœûìÑ÷ µ·õ€Ý;9yd(²Æ N†ÙbB,IÖ™_¿¼‰Z>‘¥¤30óf2–x©¨­ºD¡mQ9ž B"ÂA.–Û{áY[ÙUs~ü ñÃF³W¿Ó·éÿ#ß}½•]^ÇÒR»*Ê­2¦ü¥TÌr&+ÁñV(æy!&X«ÚyŽç£³@.•yeF«¯‘ù$” 1Éç ‰ËØãh¶EýÍþ7B‡¿ª>ón«¶¶ÐVo¯¯´¶:ΙVÔϘLºVð7¿Ï6 endstream endobj 34 0 obj <> endobj 324 0 obj <>stream xœm”{TwÇgÉL!¢µÎnÏ®;·[*âD­e}­Ä-JÚ`[‹ F% $$…„G.á!F „yù\(µ®®g— ]­Ø®r|­»îÊ>Îþ&ºgzNûÏž{~sæþæüîÜû¹÷ûñà Çq‘4I¶6fþ-œý)Î.b&®6à X„ €8øÃå„t):þ<Ò-F‡–`BWë,Öj©&ϨÍQfë%+3"$kcc7®–ÄDGÇJ¶«Úœ ¹Z’$×g+Tr=ïäJR49 ½Q²rs¶^Ÿ÷˨¨ÂÂÂ5r•nF«Ü±ZR˜£Ï–È:…¶@‘)y]£ÖK’å*…d!½5 O©F•wT¯ÐJ’4™ ­z‡"W/—«Tr Ãk”¹‘ÑkcÖ­ß°e%ÎïìÆvbIX&ƞǖb/`Ë0 ûFcÏáU8`Køâ±`L‰'àVüAPdPWп‚ï žF +„7E+X[k2·²1¼kuM Øtt˜BTÄ?9’¯^Á-å–}‰D(ä«i´”æsiT¤5«‡ó.V]‡sÐ7º/vž¿ÐÜ pÎèËì>‰Ù”¿_³ï€A$ÿ NîEoòЋ^üÆ’N P(ÚE]΄“@þùæø]_Yÿ‘f`ð2ÔAíü²›­•f(%MÎ’æw]«ÛÔ™ýnæ‘b­jË>Í^»3~«¬7ËiaJŠjÈ„·zµ •Þ? „wÉןÉÐb:óñʯ¿ÙMïíx6@2”ƒ±Åì´´€\õ.g#9c¦ÖÁl›†\>¦ÅßåôùÂõF8T”ÇÔ*s>Q‘qÿmp ôw0­'à3 §ÖïÞ¶?Š Cíàq„ÿ^€~H 8¦T¨&ÆÊS™9/‘V ´šèt Co#Ði¿ä'Þ(‹L»„«õ~³Çƒ#ÃêE &ÍhI "w#qìX)ÖJ{… ì®"æëð«\,p{g?·‰ïRˆÙv°‘uöÚÓ÷oMÓý£ a€ÄdXÀ±Õ‹ûÐú¿}ö%tŒB~Q£Ü-EPÌpþyÜFÓœŸó&# .hbï‰L`t·€«‰æ{Xà üăM¢~Lö ÛLUÞSNš’¶¦Â[°Cõš&Ñœ«ŽÇÝ1°mB7 `dÔíìÇ4\#¹ƒÜçÔHp^ú;˜ä!އϛ¯»n~Ô}žŸ¥kú– §e°âa'l+M6pA‰†ì… ?;è¿Àס™ ¡EµAu!­Ë{/ë@ª‰6žé'䜛PÚJÖѹj‘Ïñœáíïà[`K¬³:Ë̇ú#úæúñágèð”€MD›©£"[QÙó±r‹ T@rI"_Û?t´£ÕHrufHDDßåi“ñ+7ì½5ÞŽ¦žNC‹Æb‡*Ý2~åÒFwD½šº]öÃ¥qB‹óÜ|O¦ÑËíhÑÓ›íøøS´÷¯”ˆ8ª¨ÊZÒ\nú’èAÿ¯#¹Çg§î‹mûTÍôTúÝp–ôx4º|“"æIâóøéì_¶ßŠtÑ>¸z¾ ¿Œ½¶ê•íÉqÝeMÞö¦®]ãÑŠ…ŒúÇŸñ"ÏŒGl)ꃌ*=Ç–WõIDûÙtåo> o Õu¦2””ÑÜ•9¥Pš£‰,»9Ž.T‹Ú_B'o‚¶Œ…„ÔæìcžÎúÉ]ì"jngý®JDtìž-c?£Î›z«x…#á­©ÆZ{]…ÝV “¢Ûgˇ]°ßch(¯áS² *Ž1Üa„ŠSuÕÕ§œtçÐåöø:RŠ\™Õ© àM¦I;ªÌÔ¦ó‡.o×Ùë«øB]>燆f­1ß’ùêø*–pæoèºiæç²t­&ŸáÅ€è>ч_ ¬6¢»Ô÷:˜{(ú~îÙ‡\òÿÿòƒN§y™~ÁY)¨G‘ë•Ù è  w.£MˆD!Îà€²¾Òa}?V‘Jï ×K€[ 1\è¨ä:'¾ŸÀ3©­sÔóy]…‰€Ðƒ_ (¬4H•7ÚkMP vk¹‰{ôík/Úmö °’ÕU:°Eä©®®¯µ×Ûk˜¹Ù uÌçΉÂXÄßA?Ž–ß°C-Ô¨=¢[5æ,f®ƒÈ²™¥ó mw<áo ^x þ…†ªˆõv^lqÆqüý¢¡ãíFNB¶ŠÂ ¼¬´ iœ ^'?IøCÆBéàñsžbñX³x†ý m‰© endstream endobj 67 0 obj <> endobj 325 0 obj <>stream xœcd`ab`dddsöu°±TH3þaú!ËÜ-ó=èW\7k7s7˼³…¾W ~/ãÿ^$ÀÀÊȘWÜÔ7×9¿ ²(3=£DA#YSÁÐÒÒ\GÁÈÀÀRÁ17µ(391OÁ7±$#57±ÈÉQÎOÎL-©TаÉ())°Ò×///×KÌ-ÖË/J·ÓÔQ(Ï,ÉPJ-N-*KMQpËÏ+QðKÌMU»NL:çç”–¤)ø槤åe敤¦%攤V”ÀØ)™Å9‰• LAQ Œ]ŒÝ Ì@_2°0t2ŠýèàûQùïõ’…~Þ´p ã‘G?1ÿ¸#ZÕQ^Û]È‘½´~ÎÜ¥ÓÖî‰Úìõ[©ðw°S£\ƒEîï‚úß™míñ ¿9kLº[ºs» Îé›?³{)ÇêÂéU•… ™Q{’Ï|gØþóâ,¹©»¶~?7ã{tïÚ Gû·OýÎ2óÙõîIÝ+»—–rðý8 Þ%KßÊ°·¼] tÆ»Ÿñï˜éDŠÆµ·gt7rd.«^¸xéìu‡B·¨ü–ü­'Whò[ôO‡âŸ§UÚQ¿W$ÿÖªLü­ÔÝÜÛ[¼hGÿºî©k f—Vg„L8öñØwÉï:;ä–>þ.ú£óëÇs^ïù¾bów­ÙG·~×9Ò=¹{eçâ¾m\W¹å¸X*óy8·­âá¹:ƒ‡—5êš endstream endobj 27 0 obj <> endobj 326 0 obj <>stream xœUQmLSg¾¥ôz§„9X—^?ÊKPãÌÔL fN7£‹,L‹‚Z ÐK/½j¡€ÒVhË=íí'ýà«EÊdžÈ4èfæܳþZ²-Yb–L“mÙ{Iù±Û¸eYNròæœ÷œç9Ï#Á230‰Dòj±šQi=»óËÔ3ªº:]Ï6J„MÂf©)5¼²o¥^YRÈÊÜ”ù0õ½‚àed[I%’Vü0k07ÑuZ#µ­ôÄ©í;v¼ù_ewAAUeþ·C½¯i¦ëôT¾ø0iÖРÑß¡‹¿šªcÌm3¥®©ÑÔ¤ÇÊÔŒFG¡Ú``MÔ¶ÃÛ©=»víÞ)¦=âFJ¤Ï¨kh–:N¥ ^\ðÿ†akXÑæã% †cc[±l'¶+ÂQ,c$¤ä~Æ¥*é â³…»Âë’E„#Â¥èw–—ÁɶSõE5ôyÓ‡í§/W@‘¿¤úíæ\pp^yoôþíáùÑÅ¡à!ñëÉåJõ9ùâduÑîÆ-Úò¼fšmÓQÎÌ?üåÚÓKy#Sc Ò8ù"€%5"¸=®>ÏBpˆt{f“hKÜí‰CÆ|WC£‘»3³“î}†d€Öß´&j+*LgK•çjéŠBߘÌŽ>ð%!NÄl!ss}}V¹¿(b˜îE}! ýžnk@s*'¯0õôRI—¡³šD*A.ºsëû»7f€ìmÑiHeÖËk¥õ-:Ð>P?”&‹n/¢…›ôxe­|Ž»ü®(ï!û¹žn¶çªÃg÷v»­Àe“kËÞDøk«O‘:ÄËR '@“© üRÖvÝ’3ÙÓÛFìÜe®«`µJÑqÀbÖqç »V†H CâÊwŠÞéã¼Áe @œ„ +Ä÷%‘J±ŒOB‚ûÓ½¥°KzhNä^<[(n[²–%ß=Eäséôº¼wT9ØKEßš&»gá|5úå½ÄDäÌÀÚ¹¢ÅʼnHkLןܞŸ¸ÄÌ)}gdã8Œ¸CÁE_BQ5¬ VÂд=SYߦ‡³P<«yÒqݦ¸i¾uÄ9š--¯Œ%ie¶€¸ÏËÑ¡œ\‹ðöʹgZ–Ú,*pA Q×Ò 8´wœ×¸°ÚHhw6vë VK¶Ê˽“u*:YîAþ¹6æZ~æžõð2÷àxZ-|`É?1ô”¨ÃïÚØ‹ÚIÖ9ßrV®&¯¸ý™0ïOú| 7)r¼è=ÕRNîAá¨èz ÿ:¹F"×âØ/›ÅÇQa—W– Ši1D‚Á4Án{SªPlG¿ðƽa¯_DFFzcÑz|ߪ½½ÐÚ¦ãÈ2gÚ¬M¢Y±fmaV1ßè²þcV/ßOd£ŸÐ8Âå FóŦN+]v_àŠg*0•÷—`rù<ï éòñ!>d *N·œ¶líèb7ð+a[»³:;ó¶­–uã¬@“Ú9¾úÊì–˜ Š!M _X‹ðu Þ¬, û?25 endstream endobj 69 0 obj <> endobj 327 0 obj <>stream xœcd`ab`dddwöu041UH3þaú!ËÜ-ó»ò‡áfÖnæn–e?}_(ø}ÿ÷I 쌌ù¥-æ®Þåœ_PY”™žQ¢ ‘¬©`hii®£`d``©à˜›Z”™œ˜§à›X’‘š›Xää(ç'g¦–T*hØd””Xéë———ë%æëå¥Ûiê(”g–d(¥§•¥¦(¸åç•(ø%æ¦*@¨¡œós JKR‹|óSR‹ò ‹RórRÓJ’2ÓÁl°{€œ¤¢ÄäìÔ¨”“d```a`dbf`ìbìfìaìe`†P,á Ã;FÁ|?â€A°@†¥m>ãw Ì? e~7‹v÷wövöÅîq¿“øݼäYÓ§îÝßgŸúîóç»Ø”)ݽݽS›»ÛkBýkêäTózýöèþ]Üý[iÉïØïâ¿m§ÖŸ±ŸÛÍÑ?¹{ª<Š ˜¿ýsD´û»RÑ÷Øßâßm§{]¯ìæhkélnïíèïß~ÆjËoãESTºõºÕšT 5S+XG75uwvwr4Oêœ0ëЉ™Óå>~ç=óÝ£û{1ß %›}ÞÌø=n3ów•¢ßC6ÿÖùõù»Îæß!lÈ*œ€*²@*dXÖÿIþ®óïóodv¾òùl@Ñù컸vqËq±TæópnžÄÃļ ¢¥ñ endstream endobj 253 0 obj <> endobj 328 0 obj <>stream xœE=la‡ßã€R< Ð˜¨ð.&[ ƒ?b1š˜àG«‰q09éYˆÂáqõ k 4ÿô[$©\µí`]Œ‹‰]G]ÿ‡ï"²¸üò<ÛóãˆÕB8Ž³'S±è?:là̃óLïJÝ<ÖmóE/Þòà!Âs\¾¸” e%;Qi(¦±D">BF£ z.')Ù´˜§)QÍH9QíÉ}:)§³’Z¦¡SU-œÓ4-"æŠY™>¡ZVÍÐ ©()¥)zAΫô²˜“h¿-Òߤœ+̨’BSò”¤ä !|øHˆ'È`ÿ ±’Ûä%g5ëns?Ó7þL>úÄãÔýðý º®£í zŽGµV«Öa±]þ }dÇ€IÀÎÞeçÙó=žƒE¨;ªËµÆêÏo8ü9ð-MäaÏáî¾8±owðÁ™¶ÞÅY?nÚ[m0ŒT‚l·ì-hk”*¶Å¶*%д6´‚Ø3{J†íVàäï^ã{ê–f×™}÷ðà(àøkGzŸ7a tÇJM¯ÎÇ.²á«›Ì2ÇxˆÃé5æúÀl_˜çÇ¥Up4–õ• {¦c&×1¿ÖèØÙæÀ+çî¾€Ó7„ÁÎ3AØ5! ”ÖE endstream endobj 65 0 obj <> endobj 329 0 obj <>stream xœ•‘[lRwÇñÌ1v‰LŒîœ“&Æ˲ÌiŒué\âjmÕ¤¶.Ö^ÄÂZ.=œ(- ø§¥Pn¥\­â™èììô¡^ŠÙƒ[\–=¨3&&‹K–èâ–?xºlØìu{ùå÷Ëïåóý|˜¨⺆†ƒ¾Ú6•× ÊëkÊï o)¬Ô¯‰$¢ÂzѵwPÏÛ¨íMÔü&4z{Vg¢UÝJ†Úܵ…Ú¹{÷®­Ôû;vì¦>V+hUW‡†jè`” uS=z©cÚ.•‚1Q›÷*F·gûvƒÁ°­C­ß¦¥»÷mÙJTŒ’:ªÐ+èÅiêS­†¡w¨Ô2ܶåY§UëúM5hO+h †abM“ê‹ž^ kÄvbŸaõØ!¬[YM…‰°;MMM_xJøCÙ-­„m\y '(Ï>¢ëèw™ëþ( 1õÐÖfÃGBc¡„/˜'Rrø%è´™m]-éÐÙ:]ýÚÙç Zk+8ñþé‘dr:Ÿ$ü¡âx*óT<Ë&'²¡‹Å[—/§fæ ·ÿZŒM픩t:Ì0ˆ·\ï^|±€ä¿7böºŒNÂÜÜy¤pãh< N‡ÒdüÊ5´Jøㆋµ­õæ½õ„´’‚+(]D‹W•ØŸBô7úV†NŠÑ´ç9zã—í?ò¹$‡ŠÂL2Ž4 #à3ók–’r{·Ç±pÆôè„c* @†ÌBÆ—,d½YXlÈ@Þ<˜€|Ü øM¤Áï˜ÖÇÂ8z·ü¥l’óù¯Ždâ_ïékÕ–Žµ“mªC#GçkÅÒò‘eÓhuúvJ€äfï Ñ‹ŠH–3%¦OC'‡2\¾'ù?dl8”cC†i¼Ôz¡uã ^Þïbí±X`" Î=»•=x*ha Î!ƒ<ί¶jÀcQ­µ¨]–ÿðÙÒÙXõi²Gr©‰xô)-Oòí\ùá¿P‘gÈþHX>]…*èÃæºW?0æÏò‚WýµSfÜßÔrp·ÖÇú~ð‘ñHUJçú‚Ã:uÿ™æ»Ö¯ï!ÉWHR ž¢—þp ±µ¥Ö¹z~Å~ÑÉŽÆb>6$Î_º¹x!HÓÏ°×MJ+›mâ~‹qèÔ âß}.DO*[e>Ö?ã0x­^^d—z-^ÐãÕ2çƒî±(VðTˤ–Jò13¸ÀƒÓ){<œdg¢D0:‡ö¹{®ŸÌÐTý¹Ü#î!pÂ(~°¤¸ó¬ˆ6M.ëñ8]„­[[[Õ£€ù©øÆSä«xðAn_0O'æŠ ßÜœ_„(DÜ!›Ò1¤…¼ç¬#–¹”X˜ïáNjú¼ë$q¼­·ïÌ0.-o´q•š‚? Ñ­ÿ‘Dº4(wxì0Œ.)KWs³Ù1;½,þŠ¶Z·yŒ0}Ât*?sá„20EJÒåºðÔÒ¥Å|{xeqՓ׉U¢])ÉkEV"Á°Ù€F endstream endobj 25 0 obj <> endobj 330 0 obj <>stream xœ¥yXT×ÖöqæL Ãä\Ï3`‰=‰bBÄh¬XA‘Þ{gé0sö™a` ½IGª€¢‚½%¦hLQ“˜˜˜\o¼_ÚM²†l¿ÿû÷S¯÷ÿ’çÎCy†sö^û]ïz×»jâJ"‘Ølö‹ôK ‹ŽyreLd øÉl‹½Ä2m‚åq«\\ûSìh Y[!ë‰ Ó.ÛZæ= ¤)”•D’Š*ÜbbÓâÃBBçîØê9oÁ‚…¿~òÌòåËýÓ~þ‹ãª „°hÇÙä—ä È˜Ø¨ èDG7rwddX€cHdZlh‚£_``P ø˜‡_dP„ãê°È°Øؘdǹnó-zæIò͉¬èHô ‹qÜà(†þû(Šry)zeŒ[쪸—ãW'$&­MNñKõß°Qä¼9dKèÖ°mÛ#vDzDy.˜°ðɧž^ôŒ“óâ%Ï.]¶œ¢fPîÔLj35‹ÚB=Am¥fSÛ¨9ÔvjåAͧ<©ÔJjåF=Ií¦VQOQ^ÔËÔjjµ†z†z…r¢ÖRÎÔ:j1µ„Ú@=Km¤–R›¨e”5EM¦l¨G¨)Ô£”-¥ £êoÔTŠ¥8ÊŽzžä„šHí—8Kþ>á© EVÓ­Mt‘*¤…2Y›ì¿étúºÜ]Ž*Ÿ$´oÒOþÊzp²ròa›6†Gf>rnJÍ£Û½c‹l-ŠX~ 1öL;=5}j=˳ìöKNÂÅs7í\í.Úo°ÿpÚ†iwüèlFkÁÿŒenÄþÌ–çhsP‡2r³³y5Lƒ£¡2dFÁõˆõÌ^:ASœiÞ×Æá2Ë·ÒU²×ÌÀœ¸Âl¯½·N¨JMÒpQji0Ý,ìGAÞ*Ô"#¹jQ+O0òõ¨…—÷Ò»t*!«Us¨TkÒa" Sà5æ_¸TŠ}e6°0·$_‚ ¬«FË4fH½_£ËE›9C£…y‘šP ‰‘„Æ(ëÐ1þMÍXˆ¡ÚHm¡â Šîè<üFk¨‹7ÓgµÕBª ‡ùtü,á¿Ü¸‰F×rûâZãZü+w£(”P¾Ïe#û]P23,¦`»š³}Zs †O@ú°- t:¸Á\¬€ùS¸<ú<“À¯æÓQ&ŠF{„çµ$®^õP‘®9s÷¶Ó(¬0##/"M¤¯j›…VT‰êQ#‚oáuH®øƒÕçÀœL9ÚäÒftÑÜÞVÑÑ&WX*zúì¾Øx+”ØßbÚeäùÈÞ'fz‘-èT–·&6ê* Òäþ{Â_Z¼7x¶Cñ¤ê˜eÚ1I?L?˜fý–;;;cgüÔG‹á Xüùð,,\~ÏuÈòb®v­Âs°MŒç·àw`Ln?uÙÁf4Xõºå³3’Ã0ßjô•O™¬²uaëTë‡Ý°œ€±\ÿëpzo8u×)ýéA™ù®®ÖØW`fõl3/Fr\‚Hðá8žÂŽ€þ~¾bà]’dÕ[pósÉ×$Í1`k¡$¾—“ÂrTêù\6/ ¡Éú½èd½iüm<›>ÚH¡Ð(fóiz8³J݈ºPwÍ[§JŠKôúâ7Fz®£Ïå?¼pcf`tvL¨rÓnéG4¶›ØÐÙY=€ä׎¸Ï™é³v¥_Du_,9ò»êÓ–÷IÀ¦[&ç~«ŽI¤aÙ³Õ S|žgáa’Á÷Þ½üf÷mô#ú2öú®á-ç\±½ Ç‹4.¼í#tÃót$Â?P"¼0=#OK,·˜F])x}0ì5´·~ š‹fÇ¿èåµk÷ª$,Eñ(Mˆ/–‹p} ]’œ[ˆ&Uaq|Áª?Y –õw–O®`=ý’̾õ¾åQˆ E.>‹wGíDsåxúUg·ÔëMeÊ»ð,ãã¼}•Ïe ¾é>þö¡žßN% "¥®è<4f¬¦*R¡f”bÎ躄Óè:”+d\ÙYÌ(( Ö¥ ˆKDQüv~¥&†H(òð­ü?ÖˆbH÷Bûí»dߨûùãèêΉê fp’ÊŸD<ÏkxN‘š]´ÍÞ ;µr¨£[I‘7 ù²>T•­‹+ÙÅöËREò`F‚îK²L€¬`«&}_¡âÖÊÂIѦh ¸üH¾!¸BØ #rÒÔò¸ßpðÊSŽtìÇ9¨õÕ– 3ì¦;:6Õd%T(Mz`rŠ÷i3ƒR³‚ü÷z±_Ò¤<áúg% …éVPJ@Öv ]èMt(_ÈúÄ ]Ú8ˆA¼‹fRŒc¼úˆ iäÄk¼‹‚Õl “Il]耨Ývbtý´·nNSŒ>ãÀýgœŽ?§ Ýõqœ<îã´óWœ6kÊÁoáI°²" Ý` `XYâAÁ~åŽ9k{ü®¨n%É®V¡PÎ;$j›wxeo„²ð2I^>ž~6e(ï$âÀö“Ëß] î}¦ÎayM 1½ upý]M§ú§¦è”¦-R¸¥º)¹%¦äÚ&¯6%'GŽ8aÈý6¼ŽeÒs4:©ë4ŽdšØ€ÔȬ©:O!%ËÝéµ¾Ò$úR±—ÑN½AŸv4•š"ƒUŸKîÉY)Öд˜Âe7uâ©9ªF­šRRâõbú¥?X$tNÉËIá„OˆEôn_­ÉÝw•Pqÿ&ÕY³†ž}jÛݶfCe¥RäÙ1Û5–~Ý´G‹{ul?mÔ…‘‹GØZäzIìÑ"AƒœœØ.$ ˜<žØ`w1¯E·9B)u½RÔÌ-YÕ©©¬ƒÖØ`2VëÚõl½@½SÈEÁZ.ˆîÓTðÆ|”Ë¡,ufAÆ&¼€ÍMÊMV;C›ÓTTI 1J*…-yÐ!!îCéh¶_ݤ©Ö”«j|9Q-ë-OôJÀCÍÜgn|æ‹/°ÊŒmÅB±©³tqÙß¡œ-ë4•W]âšKÉ‚*r!´t|ÉAM5_–‡²8T¤Éæ‹B°”Í Ì‰UíÁJ¸Âî’-ƞъòÔyE¹\AVÁ¾Â¬ÍÂòż éåå£YyT+‹Õž,Ib>¾p§f¿Æ”kˆ%©-_'‘pêÄ› B…ÉöHŸ‡¹ñUReÄñTñÆå3J—T\hârõ4€oE¨E8 ô‘¿ åÄÕ”Êo»Ÿœí矬ôˆ®¦ÛóFt¥­¥-ˆ{Ñ-wNc±mœO zVþÜ€ïû ÕÅ“òX3©qÁ©QH‘Úxp¸¾îíZ‡¡2) uYX¤73xvLIHˉÔpa_ÐmC檲êKŸ±_ã×uý¼µi¸^:R—RzÖ ²ÿYG©¤WàzÒ˜Âó=?IèKÛŸRÅ…æ¾”œoaõB)«NT“Ù¼WþK÷½ýs÷ õaòJÜ’¢sà ¶ ŸT7ðÅ9bóO#µ{GC{ðÀ‘øÁ¬Cˆë@-†¶êþÆ#­ûG:¯¡kr°r½1ý—þêùšëx ¹ß<|ÿR%ü¾OÔÿ?úÄsbŸxBªðÍÕlÏÛhOQ¾NâÚhµ,gÆxÂÞçôÌqžtk*ù²ôÊ œîÍMÜ–¸54, qq(ٜ؜]Ħ-lÉÚ_¸qWÐéSÇaxYز–Êê ]³~¬Hž"ë©Q¤°Y{ŸwU¼9es¨@“­)œõìRˆF‚ºT]ÊåժȄÊÍÆJaLX߆¯Þ–ôÂ+‹Œ0%—ôÆÃùå잪äâ„bò2=#Y'ˆ]h±;ßX 3GzMG•õGrMa™I…ш›·é(¾è¾4ÔŸ’¨s(u—Úü”‘CDá¡ó–׈ðŒª,ǘ{‹ÿ¬¢Xˆö|¦+sÓKÏ §Ë&Ç+zunrv"^φÅNpÓ–`k"ЉB”Àeü… ìOÎêqÓ`úªCGøc㥬ó)VëÅ-—Рº—PšaN¨ÙËuÉj›zß'©ÕçàÛËnËóL7½²(”÷AÈ]À³ŠÉ ù…jl'í“éšJŽU˜Ïö2I†_À¹ÉÑi ë–qá4L"[ö‹ý°Y=Víz=:¬¿XzŒ FænÝ—åEØÒ±ÙcÁ%ÉàÏ.KÿËÛÐ)†slI<â"Ptn¬Ê͛ݻ-‘ã™ï.‚‡öW‰õþ¯O¤Dh\#4´µ‚P ßÊÿ{¿Á6ì½Ô„"+F`Æi | +‹c~t½Œe¡qùé±JÑîh!‡?X óÎöš:/)ŽeUzÇEå Îín?”ÞZ°_sTSegÑPÉ™ 9igŠd(VÈ"V÷Ucÿ9t5hçʉ¶«ÎXþyFræ[6#lY9ºžÁ…x:ñói8¦’)( òÈDd©‹§ƒ“r·1'Ñ ª;ìôŽŽKåxó óðìíþU=!Ê'#ï" Ñ·M ì;Qûý—Eþ*xß"Dµ9ÏrA}ºšÒrCea?™—ª ÚÓªJÙÒ*2¨fÄ'æE¼´‘õ ÈOCÏË}鸴”ìðty}C/ÅM4Ú^˜¬ñØŒ‘Mýà‰Ÿ§…XAUª6s#_†åÐShó¹"Ã:u<ïHŸ¸zj‡SëÆç½0kªâ\"vǬŽoTëù $æî0ÙA1ôõ†l«Ì’a‰fŸ’Eƒ¶ðÆÿß;y7êxE³¤ÓŠk%•5ºû›ƒ>N.žòx¤sà‰¼ 99옔Àž;oÕˆmó?VÂ#°  «©Š-Í–‰Œþ’Q*Ÿ„8ÒRQºàßî]¾ž c9½4#¸<¼1Ρ6¥2·;kÕ6'??™¸Êš´‘}Ïy±ŠÑŒÜì¸X»Åo–Œº“¾îcïþÙÊÙ\u9\ñcdº©®ÒXVWæPÛ†—Ñ¥ýåÝh„4в¢Z9öfN¶ù>¿*6ØÃ3b轫­}§êî½Â(FÁ¦=}ýêW<œ6¾Ú[ßÕ^éPUÚS<ŒDÆeœú-ãF°5ÓKg…g¦¦‰j¼×\Ž­ÙS|‰·ÉL†@ƒÐç†>½4ôñårˆ'LT†æ¦Ú“ŸìÑ9ŸmQG îû,Û#%4iås${¬³©¬5¡JõùtðÚÁ6çש› B¦ÑK™¿¿{aA£Œ[R\^xÁŽüßšÁ{¡ùåÅsJÂæ¿þò®Ñdr}˜ ±"½`†•e òÌþÆÊæö¶ŽŠ^4(ÿçzBÚìć)ãøå„*1"mçÿïsŃ›E:]QR«#Þ>îýœG¼‚C|F|á^!?…Düõçºã¼õj¸~:¤4§$လX|2Í—|/‚uîJ(ò+äÔ¨ÏçåÿÛøõÀYWB¯‡Æ7<Âϯ3lp «k` ¼Ëì…Ã)É%‚‡†ø«àà ×"ÿì­ï„_Ø÷)å5@ßY·=/ÎmvÀ²ö—j#:Ðqîòéc7N¥÷)K–Kdèuý1c[aûJ£§i-!Ëss]°Ý’þãŽ~gT-‘È‹{iýö%kÖµTæ&µ}ÚRË6^´…ª1Ïc™kù’ "³Æ˜oL`õúÕÒ~™ö}]·áXžÅmc&(TÌF›("…/m¨îE®_¦¿ŒJôe:=§ð-ÕWéíá¡{©²?=!±˜SûÄw.V>ÆÒø½?ÍR[ý¶®T}¹2•×.Y²6Ý”V‡wB,k0´··µ˜K¹W‡ˆu-©$–±ÿM戥‰ ±ñÛ¼8K¡h­ê# XÁt uÞjt©èõäô²1Ë‘Žœÿ ¥¸€FÓ÷y„…ÆD{g®E«‘OUlgÜÜ£è[9¿5-ÿf(Ëí 4~(Wp…mw>…µJÂÇïƨøÿ‹Œå'ñlâ4vg”%òåÇ¢l>ŒO$v3SLë,±ÈÔMêÊ´†äÝ»,}_fj.6ëËô•Åf­N(ÖŠh)dË”—×kˆ§™N“C®4#ä ñ(NôXGH‰Tä¢ eäD&{àø?c™šrœ×¡ËŒÄbþ4ùgrÿú/V÷£CüÅñ³Åj#´E÷µ©s »ÿ\kÐ %^A*Ê‹ÐDŠý‹<ÑD¦$„~Tÿ›žýúL}G7BŒÏ€8ÂüVÉ@rÔ1<©`ŸJé²1ñl@ãjÑY%¨þø:ö§ uýè´: ¼Ìr‹‚´q#2p¨¬¢¬Jü%íY"Ò‹tcž+˜> ®Õ˜³Jc8p¸÷•ôŠ¬ý¦¡ÎØOiróî=\šZ’iHàŒñHcH–¿#«û¢¤¹´l,«Øò#åõÕÚNqÝ9÷ "Ðç I(á~ÄÁ5“C9|®:{¾èˆ‡»é³º’/p>²$œ„Ü„œDRß¡zØFlNù-+(‡ã ZA8ô„BÐ-KƨüUßC$IóÝnÙÞ!?ÝÁfªbƒ¥ž(džÌ-Iª¨Î *ô¶ÇV@Éþ¢QRløÅ*)„›¥zÔ ºúç$†h‹JÑiŽ¸$+òxi­´CÖbNÝ〓ÿd9(î´|÷EÝxsí<×s]UÅzg„çîÈÌ[µ`¯Så>–”#xÂÉœc Ó4Y¡ù©êÜ C 2}«¹§ª'×DnÓ·>‹ñ öóë ìíî ë«H FjƉÿ$ý\‰£Iâ ­±¼;,ék²¾µÔŽÎeœÑ戠WÂ6g®@ØFŽ^[³aÑ‚þǬ7£+#Înk_‰äÉ»˜6Ô˜VVç[„íäxFø îQ 5]éÊ”CYÄŠ€‚ ¥Çëz+[Ê[E{ _`­`‹å"£´Dš ¼6EÉï¹Ó(:5=Hã&NE…‹B ’· õH|ш:Åÿš”“)iXœ6ê‚´©•¨ƒ÷htCûš&f™Xlã…éÀ™(¾8Õ'î•Rg9ñ½^%;6©pÕIË@¥Ö4¢rTÅ¡¡\ÛRDºÌélV‹o¼ÞûºÄ}ãtOÙì£òݪLÃË{Õ5oÚ‡š#îÁ½k\_\±Â»àçÆà;¦·Áó¿láX-…)Sw`côÑ%”» ¦u'ÎðP`w2y  Å!¾*¹ÄG/W|s­¿{è¢ÝG/žŸ±= +|‹2?%í–Õ^î=pÉ_;º}½ÿ‡PYêK¥…u%µÚÄ)î¼?²ÛuÅÎí+CÃÊâë3듆ÇP]NºGv ⌶Þa·ŸÚ±ÊnöG«`p_ÿlfŒîT&5¥•ùWË×.mê;c÷éê3˜Â¶ËVb«U­¾Wý”ßúgß oÝj·Ö{÷F7s×OV8qDy&0Šk/·Çµ³;Õ×}öÕAßõ~éѾÁâ\ÙŸBß IÙË æß«˜7t­úÃuðø…›0Á*9¸¹~‰±Ý2'< Ûœ_ý}g]iuòµÓîE±Ù¡\êúÝ{â£Ó÷dÅ¢”-djs‰g^i¹Ã\ìÚ> endobj 331 0 obj <>stream xœ%‘}HyÇã¸3cM–ÕþÑ]73–QYzѪue/HX¡Eo.îä ξŒ“bµéÆIºO%½hYÉšìhkkÑ A½P´QvqRPtÕ=ãý‚»]â Ï÷ŸçåóeHj aÆVTRº"ÙdY?2ÖÜë'¨<ùqÒa‘1up²f&º2pÇt,AX†Ñ|ÍEo£^]Ye(Ù •Ü‚Çb%oÙ²eµ¦êÕN·Râ4ªTÍi$L­R橨VF%{U•ax —.mhhÈqju9½ò×…‹•†j£J)UëT½^u)ë=nCÙäÔT%yZN²y4ï~CÕ•KÕÝ„ܼۢŸ—"’™d™Mì„K¼CRÉrIgº™¬ÖôWR¹'Fðcˆ±JFX+€†G¹®0˜¦~™Žâ×aŸt¿DÇè(ï×Áç C—Œ£tŒóƒnšî’Ò-„˜Š …4ß°H'§Û#GA“Š7fA%.Þ„'ð°_øvœ¯Ã™R¹‹»Ûþî%ôî½-΋•ó™p.*'G½Ã÷HÞƘçH°ãoÖºŠ›íû¸6 øPóo-…ànæpöçÁ¾·ñÈœHäÆ0<0ƒÚ^Ш=wÅ’í7[:×»¯]:|e¯Ô;üèúS¾Üû¥pí®5ë6Ê4@µ@ „Ú9Ö.±²þÚcäQŽ"óåN”™øŠMȲx _Û_ß/Í¢)Å;×x3O>Ø#ÇÚ/˜Ð' ÖõÖxµÎlL)ÃY˜ýiâÓ‹²1:5"ýnÆãð‡ðjÉC*Ò´¼måѦÙ×}u`··]º5ò'œa8^—¿µvÑ‚¹1èm;`s ;áâw˜˜³¶'r!ã¬õóí1šfmâ{á”ÞØÖÚtD¢}Ûmsa|e‚g“Cr»¸Ð±'†`>´†‚IžnÞg£ò+>ßšo§ÿÑ~>½¾Ç*:žŽÓ=uvò±)ãS¥)©Ž˜vå”(Ž_§ò?ûjWV endstream endobj 18 0 obj <> endobj 332 0 obj <>stream xœ¥U{TçŸaav¢±tRSÍÌ *>0–4˜XH´(‰Æ(‰UX–…}°»<–‡²(rwQ”‡"/YVPBˆ1ŠÆÔD¤ÑhÖ˜W«Ñ4Åc›ž»9Ÿ=íâbÌ?==gÏœýæ›ïÞßïÞßï~4åíEÑ4Í„G¯_2ü/À=vO÷r?&+&Yî–Wù€Ÿ ü¼ÓýŒ¿ÀCSÐ47Ñ>mŒ?“Ê\ÛX/öVœ0yBÇÄù£'Z'ÞðU¸['¹[AÄwEúï.ŒqÉÜQØÇÝÚôæ’°W”V+ï,©QòaLŽ4šØ/%ýñž.fö·@G‡r„x\Î ]îÁEú—yVXå©É f4¼RÄx‘þÞ…¸:%FxÃG˜$ÈìêG=ÿ¼*d&ñäŒÇâL˜F÷.æ»3ÅCÄyǤGk!SÓ&åÓBžðŠ§E¬eî·‚«V¹x{Q _§3°$4ýiõÂr®å § .o‡X6I¥ ŽV6¾—ÁïÿcµX-Âby.è;*ëÊœ•üIÍhŠzàÛ×…ª6AéL(¨ŽªZS lƒ£ãÖõ²‹·§4C°Ãà…Q4ïŠÿh q¾Kª° ³Ü4‡ÁLM«Y¹ þŒeo´ðφÈsuwµõÉbåJ>]øø° Òò­ÆR~G|’Al¼Ót/ü=»§r#ÕºOÖ‰ÌÒ¹ªPhkãñ€üÁ};4 ûêTWM}3¿Kç€`/ýTÖx[¤›Ýæá4×2>ë ÕÄÌ$ïÏÄ÷}š<Ç¥ý{niaЛüe¯Êðh#8`o;ªy|#Ò§\˜!‘Ç#Ü—«.‘Ç^¡†útg}Ku§‡=6Û^{•­ªý¢7q½  /Éä°VÿÙ gÅ^¡1µ§ä8°-G å© ÊvZ…eç9ÈsB–Ú’Pº ؘø#¯ŸB/'²6Á#ýchäP†3}^gö9ïji y 4Ï=uݧvç{jï’üLf’‡È"ŸDf¤w#jRéÂd¾ ŒO†alf°žªáâ’LÑÝ$Ò½÷H©¸µÐåöª•PÇvè ›'2&[Š\b˪-v—4C-lטWælÎÝœþ|‘‘-eJöÕÅ#õΞZM°»¬¢¬²jï;^lϬ/Êw´JÇQA~˜ZVh+P’öl%;9ÍœXRQ?µ´=½Æ¬!Ó¢U¶oé¿ÒùÃ1I¦úØ…š›2·)î@vEF^˜ xËe~°!¾z²ý_èßV»£t—PVj+…»®1»Xgý–Ë3a3‰Œ!üo‰ßPþoª½úœˆ´H™w’ÂFÅÌæθ]ɼ²9 ˆ?™tc.zêq´¶ zÈêåï“ì2ü÷âæ¥ËŸ[#^ûZ/ž=¹q=?šÊý$­]Á½ŸÊÜË0†«w@úEýpdràliJûÞš…Óñ±¾kÍó­¥éV!ó±ÖX+Žç\amƒ\Íù³'D¸Må›Ø1¡¯$¥Õ’Ç«‡=î;Î$¾Ç˜ã•=|YÊÁ¼:`îoÿàiÈ ‰[ ÄÎóxþ&é7I›?~«Ã?Ì!‘DâE%$'‘_㬯¯ži?” ÖŒ’ùù‚F«¶j€øOT`Àíïnõ¶§©÷ 1ä<·uë™ËŸõîéí]úì–—âFô‰ÓhŒÅi2üë‡\wJ«Z©OQ+ÛõGº[Û ×?¤ñGsíVþèËíÞoØÃ:2k,ÆÂìübž|þï¯å”>jjÈ­kÞS[µk´g·E7+]ýŸœ“½6®`›4n3ØÔ]Ûºx´?±vœ¾Wy”»ööEÏäX·™ÃÉ|*c„¢Òm, ¾Ãp˜Š7|È ù(r|ʃÿó |ò¶÷ƒ”¬•îð=¸¼’!Yårq¢Ë—ŸèmÑûMýü\~QÔH&ž endstream endobj 236 0 obj <> endobj 333 0 obj <>stream xœEKLQ†ïЊ#V|vá«% 7c||D1 "JB)c;ÔvêtdZ E¬S­µ¨åU -È€ !!F+‰˜èÊÄ…‰ºqáÂÜ1£‰‰®Î9›ÿÿÎG u"‚,.=i4þì;å­„¼-CÞ®Qž‘ñ Ш@£Ný¨Ý€™õ¸z-®\‡TáŬÓÃ1+OåšwS…EEûò¨½CuÄNsŒÙä JM¼•¶›ø¥ã*UΚš÷P¹¬<ïÜ_P B¾ÉîÊg9ËÁÝy”ÀðVªŒvÑ\=]KcQˆÁ$È<ï¿à©Ï*Ü…³µ¾óÕh_¤%6ëH@ˆðp.öFeÕxÅÂðtTÓIW&Äa 1ñ«§BmC̵_c@ï>wÉfÒæ~0ÞÓù(<¤Ob vÇâ›ãñÁÎøRojðÝò{ÁKºú½‰®ÇÁù—U“F3-ðœÎ)ÕEë€Üq\!jü!a4ꎅôƒó3) H©³‰mÍwÄ¿eÿ’Fû¢JΕçµíw;Â&S,øtʦLŸêØôè?eR?´xÁâæ’7ÎÙo“xKü/hjlщõBI5bepü.´‡búì›]rqíÊTÜá•é¬ÅÕº,µ‡Õ¬JG4„~ÕQ› endstream endobj 61 0 obj <> endobj 334 0 obj <>stream xœÏkÓ`ÆßwÙºLký1«Óö=ìÐÂØ:A´"ŠÄËz+]XŠMR“Ô¬tݺΙl_š­¿\kÛu݆Âta—‚A¼ôêUðOxS²ƒµ‡çáóœžçÁ¨¿aŒ¡™Ùç·ÿÓ¸5†­k}Öu “°¾€“gË*\¡Êe»Hç/¡ŒE%kCR<)Gçy•ø"~2 Þš 7 y pr4ÉLXå9!¬vCŒÌJ‘(§&‰ï.¯ªñ;SSš¦M†eR’çïù'ˆUyò”S8ù57GJ¢J‡ŽôÆMö<$ ñ„ÊÉdFšãd1¬t9ª¼ì6ðq9*p!1„>à ½w¨ùÑ/­{ìá³¾ l¸!›_/ÕäÀ„<ê¬KÙïÜßuØžíÁö¹öùvÃéìêBÿ ÷Ý´ endstream endobj 224 0 obj <> endobj 335 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 352 0 obj <>stream 2012-09-18T12:45:20+02:00 2012-09-18T12:45:20+02:00 dvips(k) 5.991 Copyright 2011 Radical Eye Software LT28Guide.dvi endstream endobj 2 0 obj <>endobj xref 0 353 0000000000 65535 f 0000201282 00000 n 0000277676 00000 n 0000200810 00000 n 0000191898 00000 n 0000000015 00000 n 0000000494 00000 n 0000201348 00000 n 0000212271 00000 n 0000246482 00000 n 0000210709 00000 n 0000229483 00000 n 0000201389 00000 n 0000201419 00000 n 0000192058 00000 n 0000000513 00000 n 0000003390 00000 n 0000216324 00000 n 0000269660 00000 n 0000201460 00000 n 0000201490 00000 n 0000192220 00000 n 0000003411 00000 n 0000005697 00000 n 0000215549 00000 n 0000261797 00000 n 0000214591 00000 n 0000257089 00000 n 0000201542 00000 n 0000201572 00000 n 0000192382 00000 n 0000005718 00000 n 0000007234 00000 n 0000213762 00000 n 0000254090 00000 n 0000213183 00000 n 0000252759 00000 n 0000201635 00000 n 0000201665 00000 n 0000192544 00000 n 0000007255 00000 n 0000010624 00000 n 0000211657 00000 n 0000238476 00000 n 0000201719 00000 n 0000201749 00000 n 0000192706 00000 n 0000010645 00000 n 0000013639 00000 n 0000201823 00000 n 0000201853 00000 n 0000192868 00000 n 0000013660 00000 n 0000018670 00000 n 0000210074 00000 n 0000223101 00000 n 0000209302 00000 n 0000221082 00000 n 0000208769 00000 n 0000217774 00000 n 0000217116 00000 n 0000273554 00000 n 0000216145 00000 n 0000268574 00000 n 0000215324 00000 n 0000260330 00000 n 0000214313 00000 n 0000256221 00000 n 0000214862 00000 n 0000258606 00000 n 0000214251 00000 n 0000201905 00000 n 0000201935 00000 n 0000193030 00000 n 0000018691 00000 n 0000022473 00000 n 0000202099 00000 n 0000202129 00000 n 0000193192 00000 n 0000022494 00000 n 0000026810 00000 n 0000202247 00000 n 0000202277 00000 n 0000193354 00000 n 0000026831 00000 n 0000027809 00000 n 0000202417 00000 n 0000202447 00000 n 0000193516 00000 n 0000027829 00000 n 0000030097 00000 n 0000202521 00000 n 0000202551 00000 n 0000193678 00000 n 0000030118 00000 n 0000032861 00000 n 0000202702 00000 n 0000202732 00000 n 0000193840 00000 n 0000032882 00000 n 0000035383 00000 n 0000202883 00000 n 0000202914 00000 n 0000194004 00000 n 0000035405 00000 n 0000038056 00000 n 0000203011 00000 n 0000203042 00000 n 0000194170 00000 n 0000038078 00000 n 0000040927 00000 n 0000203194 00000 n 0000203225 00000 n 0000194336 00000 n 0000040949 00000 n 0000045774 00000 n 0000203377 00000 n 0000203408 00000 n 0000194502 00000 n 0000045796 00000 n 0000050908 00000 n 0000203560 00000 n 0000203591 00000 n 0000194668 00000 n 0000050930 00000 n 0000054698 00000 n 0000203666 00000 n 0000203697 00000 n 0000194834 00000 n 0000054720 00000 n 0000058252 00000 n 0000203772 00000 n 0000203803 00000 n 0000195000 00000 n 0000058274 00000 n 0000061938 00000 n 0000203878 00000 n 0000203909 00000 n 0000195166 00000 n 0000061960 00000 n 0000066910 00000 n 0000204017 00000 n 0000204048 00000 n 0000195332 00000 n 0000066932 00000 n 0000071999 00000 n 0000204156 00000 n 0000204187 00000 n 0000195498 00000 n 0000072021 00000 n 0000077647 00000 n 0000204317 00000 n 0000204348 00000 n 0000195664 00000 n 0000077669 00000 n 0000081854 00000 n 0000204478 00000 n 0000204509 00000 n 0000195830 00000 n 0000081876 00000 n 0000085771 00000 n 0000204639 00000 n 0000204670 00000 n 0000195996 00000 n 0000085793 00000 n 0000088407 00000 n 0000204800 00000 n 0000204831 00000 n 0000196162 00000 n 0000088429 00000 n 0000091966 00000 n 0000204884 00000 n 0000204915 00000 n 0000196328 00000 n 0000091988 00000 n 0000094246 00000 n 0000205001 00000 n 0000205032 00000 n 0000196494 00000 n 0000094268 00000 n 0000096950 00000 n 0000205085 00000 n 0000205116 00000 n 0000196660 00000 n 0000096972 00000 n 0000098647 00000 n 0000205202 00000 n 0000205233 00000 n 0000196826 00000 n 0000098669 00000 n 0000103516 00000 n 0000205286 00000 n 0000205317 00000 n 0000196992 00000 n 0000103538 00000 n 0000108630 00000 n 0000205438 00000 n 0000205469 00000 n 0000197158 00000 n 0000108652 00000 n 0000113928 00000 n 0000205544 00000 n 0000205575 00000 n 0000197324 00000 n 0000113950 00000 n 0000118751 00000 n 0000205685 00000 n 0000205716 00000 n 0000197490 00000 n 0000118773 00000 n 0000122785 00000 n 0000205824 00000 n 0000205855 00000 n 0000197656 00000 n 0000122807 00000 n 0000126710 00000 n 0000205943 00000 n 0000205974 00000 n 0000197822 00000 n 0000126732 00000 n 0000131575 00000 n 0000212660 00000 n 0000252044 00000 n 0000217490 00000 n 0000274404 00000 n 0000206038 00000 n 0000206069 00000 n 0000197988 00000 n 0000131597 00000 n 0000135847 00000 n 0000206161 00000 n 0000206192 00000 n 0000198154 00000 n 0000135869 00000 n 0000140680 00000 n 0000216681 00000 n 0000272472 00000 n 0000206256 00000 n 0000206287 00000 n 0000198320 00000 n 0000140702 00000 n 0000145996 00000 n 0000206364 00000 n 0000206395 00000 n 0000198486 00000 n 0000146018 00000 n 0000149757 00000 n 0000206492 00000 n 0000206523 00000 n 0000198652 00000 n 0000149779 00000 n 0000152759 00000 n 0000215158 00000 n 0000259498 00000 n 0000206598 00000 n 0000206629 00000 n 0000198818 00000 n 0000152781 00000 n 0000156631 00000 n 0000206783 00000 n 0000206814 00000 n 0000198984 00000 n 0000156653 00000 n 0000160777 00000 n 0000206937 00000 n 0000206968 00000 n 0000199150 00000 n 0000160799 00000 n 0000164775 00000 n 0000207087 00000 n 0000207118 00000 n 0000199316 00000 n 0000164797 00000 n 0000168748 00000 n 0000207215 00000 n 0000207246 00000 n 0000199482 00000 n 0000168770 00000 n 0000172221 00000 n 0000207365 00000 n 0000207396 00000 n 0000199648 00000 n 0000172243 00000 n 0000176499 00000 n 0000207517 00000 n 0000207548 00000 n 0000199814 00000 n 0000176521 00000 n 0000180235 00000 n 0000207678 00000 n 0000207709 00000 n 0000199980 00000 n 0000180257 00000 n 0000184270 00000 n 0000207841 00000 n 0000207872 00000 n 0000200146 00000 n 0000184292 00000 n 0000186129 00000 n 0000208026 00000 n 0000208057 00000 n 0000200312 00000 n 0000186151 00000 n 0000188197 00000 n 0000208189 00000 n 0000208220 00000 n 0000200478 00000 n 0000188219 00000 n 0000189726 00000 n 0000208264 00000 n 0000208295 00000 n 0000200644 00000 n 0000189748 00000 n 0000191876 00000 n 0000208359 00000 n 0000208390 00000 n 0000218058 00000 n 0000221374 00000 n 0000223454 00000 n 0000230093 00000 n 0000239135 00000 n 0000246804 00000 n 0000252261 00000 n 0000253053 00000 n 0000254379 00000 n 0000256456 00000 n 0000257343 00000 n 0000258873 00000 n 0000259739 00000 n 0000260566 00000 n 0000262199 00000 n 0000268811 00000 n 0000269983 00000 n 0000272734 00000 n 0000273783 00000 n 0000274685 00000 n 0000208443 00000 n 0000209162 00000 n 0000209594 00000 n 0000209687 00000 n 0000210544 00000 n 0000211534 00000 n 0000212165 00000 n 0000212806 00000 n 0000212900 00000 n 0000213579 00000 n 0000214158 00000 n 0000214477 00000 n 0000215019 00000 n 0000216061 00000 n 0000216871 00000 n 0000217379 00000 n 0000276242 00000 n trailer << /Size 353 /Root 1 0 R /Info 2 0 R /ID [<20491E46027D68FB77FFB71E57D76E60><20491E46027D68FB77FFB71E57D76E60>] >> startxref 277884 %%EOF looptools-2.8.orig/manual/LT28Guide.tex0000644000175000017500000027167612026050237020724 0ustar sylvestresylvestre\documentclass[twoside,12pt]{report} \usepackage{a4wide,array,epsfig,amsmath,axodraw,makeidx,calc,alltt} \makeindex \def\indextt#1{\index{#1@{\tt#1}}} \makeatletter \renewcommand{\rmdefault}{ppl} \DeclareSymbolFont{operators}{OT1}{pplcm}{m}{n} \DeclareSymbolFont{letters}{OML}{pplcm}{m}{it} %\DeclareSymbolFont{symbols}{OMS}{pzccm}{m}{n} \DeclareSymbolFont{largesymbols}{OMX}{psycm}{m}{n} \DeclareSymbolFont{bold}{OT1}{ppl}{bx}{n} \DeclareSymbolFont{italic}{OT1}{ppl}{m}{it} \DeclareMathAlphabet{\mathrm}{OT1}{ppl}{m}{n} \DeclareMathAlphabet{\mathbf}{OT1}{ppl}{bx}{n} \DeclareMathAlphabet{\mathit}{OT1}{ppl}{m}{it} \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 % 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_{\text{min}}^2}} \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.8~~~User's Guide}} \vspace*{1ex} \hfill\hbox{September 18, 2012~~~~~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 77 compiler and the GNU C compiler (\Code{gcc}) are required. \LT\ comes in a compressed tar archive \Code{LoopTools-2.7.tar.gz}. Execute the following commands to unpack and compile the package. \bbox \begin{verbatim} gunzip -c LoopTools-2.7.tar.gz | tar xvf - cd LoopTools-2.7 ./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/}\Var{hosttype}/} \> directory for the compiled programs and libraries \\ \Code{\greyed{LoopTools/}include/} \> directory of the include files \\ \Code{\greyed{LoopTools/}A/} \> directory for the one-point functions \\ \Code{\greyed{LoopTools/}B/} \> directory for the two-point functions \\ \Code{\greyed{LoopTools/}C/} \> directory for the three-point functions \\ \Code{\greyed{LoopTools/}D/} \> directory for the four-point functions \\ \Code{\greyed{LoopTools/}E/} \> directory for the five-point functions \\ \Code{\greyed{LoopTools/}util/} \> directory for utility routines \\ \Code{\greyed{LoopTools/}tools/} \> scripts for compilation \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 right version. \subsection{One-point function} \indextt{A0}% \indextt{A0C}% \indextt{A00}% \indextt{A00C}% \begin{center} \begin{tabular}{|l|l|l|} \hline Function call (\Va\ real) & (\Va\ complex) & Description \\ \hline \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{BgetC}% \indextt{Bput}% \indextt{BputC}% \indextt{B0i}% \indextt{B0iC}% \indextt{B0}% \indextt{B0C}% \indextt{B1}% \indextt{B1C}% \indextt{B00}% \indextt{B00C}% \indextt{B11}% \indextt{B11C}% \indextt{B001}% \indextt{B001C}% \indextt{B111}% \indextt{B111C}% \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 \\ \textit{special cases:} && \\ \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 \\ \textit{special cases:} && \\ \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}% \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 \\ \textit{special case:} && \\ \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{D0C}% \indextt{D0i}% \indextt{D0iC}% \indextt{Dget}% \indextt{DgetC}% \indextt{Dput}% \indextt{DputC}% \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 \\ \textit{special case:} && \\ \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{E0C}% \indextt{E0i}% \indextt{E0iC}% \indextt{Eget}% \indextt{EgetC}% \indextt{Eput}% \indextt{EputC}% \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 four-point tensor coefficients \\ \Code{Eput(res,\,\Va)} & \Code{EputC(res,\,\Va)} & all four-point tensor coefficients \\ \textit{special case:} && \\ \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_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}'' subroutines (\Code{Bput}, \Code{Cput}, 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 is 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{Quadruple 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 with even severe cancellations. Quadruple precision does slow down the calculation, though, and is also not available on all platforms. The procedure to build the quadruple-precision version is as follows. Configure as usual, then run make as \begin{verbatim} make -f makefile.quad- make -f makefile.quad- install \end{verbatim} where the makefile is one of the following: \begin{center} \begin{tabular}{lll} gfortran & 4.6+, all platforms & \Code{makefile.quad-gfortran} \\ f77 & HP Tru64 Unix & \Code{makefile.quad-alpha} \\ ifort & Linux, Mac OS & \Code{makefile.quad-ifort} \\ xlf & IBM RS6000, Mac OS (PPC) & \Code{makefile.quad-xlf} \end{tabular} \end{center} The resulting libraries and executables carry the suffix \Code{-quad}, \eg \Code{libooptools-quad.a}. \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. The cancellation of the divergences can be checked with the two variables $\Delta$ and $\mu$. The first one replaces the actual divergence: $\Delta = 2/(4 - D) - \gamma_{\rm E} + \log 4\pi$. The second one is the dimensionful parameter introduced to keep the integral's mass dimension the same in all dimensions $D$ (see Sect.\ \ref{sect:loopint}). \index{UV-regularization parameters}% The initial 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 actually 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$. It is hence straightforward to check UV finiteness 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 photons. 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$ (indeed, all other non-positive values) 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. \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, -1, 0$ returns the coefficients of $1/\varepsilon^2$, $1/\varepsilon$, 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}% \section{Using \LT\ with Fortran} \label{sect:fortran} \index{Fortran}% \index{f77 command line@\Code{f77} 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 \Code{f77} 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}% \indextt{F77}% \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. If you are using an older Fortran compiler which does not recognize the \Code{.F} extension, use the script \Code{F77} in the \Code{\$LT/bin} subdirectory instead of the normal \Code{f77}. \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 #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 #include "looptools.h" double precision s double complex SigmaH external SigmaH call ltini do s = 100, 1000, 50 print *, s, " ", SigmaH(s) enddo call ltexi end double complex function SigmaH(k2) double precision k2 #include "looptools.h" double precision MH2, MZ2, MW2, Alfa, pi, SW2 parameter (MH2 = 100D0**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}. \item To produce code valid for both C and C++ one can use the \Code{Complex} data type defined by \Code{clooptools.h} which maps to \Code{std::complex} in C++ and to \Code{double complex} in C. Note that the latter type is available only in C99. \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{Complex} data type (a true C++ aficionado would eschew the use of stdio, however). \begin{verbatim} #include #include "clooptools.h" #define MH2 (100.*100.) #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 Complex 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() { Real s; ltini(); for( s = 100; s <= 1000; s += 50 ) { Complex 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.8.orig/COPYING0000644000175000017500000001674311352247751016313 0ustar sylvestresylvestre 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.