Index: branches/ohl/omega-development/completed/whizard2/README =================================================================== --- branches/ohl/omega-development/completed/whizard2/README (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/README (revision 8703) @@ -1,33 +0,0 @@ -This is O'Mega, an optimizing compiler for scattering -amplitudes in quantum field theories at tree level. - -Subdirectories: -*************** - - src/ Objective Caml sources for O'Mega - Sources for the runtime libraries - (currently only Fortran95 is complete) - - bin/ compiled instances of O'Mega - (this directory will grow to tens of megabytes, - if --endable-all-programs is selected) - compiled auxiliary programs - compiled self-checks of the runtime libraries - - lib/ compiled runtime libraries - (currently only Fortran95 is complete) - - web/ typeset versions of the sources in bin/ - (requires ocamlweb, ocamlweb.sty and noweb.sty) - - doc/ additional documentation - - tests/ regression tests - (the installed tests need MADGRAPH, some of - the tests an extended version of MADGRAPH) - - -$Id: README,v 1.5 2001/03/05 11:34:10 ohl Exp $ -Local Variables: -mode:indented-text -End: Index: branches/ohl/omega-development/completed/whizard2/config.sub =================================================================== --- branches/ohl/omega-development/completed/whizard2/config.sub (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/config.sub (revision 8703) @@ -1,1353 +0,0 @@ -#! /bin/sh -# Configuration validation subroutine script. -# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001 -# Free Software Foundation, Inc. - -timestamp='2001-02-13' - -# This file is (in principle) common to ALL GNU software. -# The presence of a machine in this file suggests that SOME GNU software -# can handle that machine. It does not imply ALL GNU software can. -# -# This file is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2 of the License, or -# (at your option) any later version. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 59 Temple Place - Suite 330, -# Boston, MA 02111-1307, USA. - -# As a special exception to the GNU General Public License, if you -# distribute this file as part of a program that contains a -# configuration script generated by Autoconf, you may include it under -# the same distribution terms that you use for the rest of that program. - -# Please send patches to . -# -# Configuration subroutine to validate and canonicalize a configuration type. -# Supply the specified configuration type as an argument. -# If it is invalid, we print an error message on stderr and exit with code 1. -# Otherwise, we print the canonical config type on stdout and succeed. - -# This file is supposed to be the same for all GNU packages -# and recognize all the CPU types, system types and aliases -# that are meaningful with *any* GNU software. -# Each package is responsible for reporting which valid configurations -# it does not support. The user should be able to distinguish -# a failure to support a valid configuration from a meaningless -# configuration. - -# The goal of this file is to map all the various variations of a given -# machine specification into a single specification in the form: -# CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM -# or in some cases, the newer four-part form: -# CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM -# It is wrong to echo any other type of specification. - -me=`echo "$0" | sed -e 's,.*/,,'` - -usage="\ -Usage: $0 [OPTION] CPU-MFR-OPSYS - $0 [OPTION] ALIAS - -Canonicalize a configuration name. - -Operation modes: - -h, --help print this help, then exit - -t, --time-stamp print date of last modification, then exit - -v, --version print version number, then exit - -Report bugs and patches to ." - -version="\ -GNU config.sub ($timestamp) - -Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001 -Free Software Foundation, Inc. - -This is free software; see the source for copying conditions. There is NO -warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." - -help=" -Try \`$me --help' for more information." - -# Parse command line -while test $# -gt 0 ; do - case $1 in - --time-stamp | --time* | -t ) - echo "$timestamp" ; exit 0 ;; - --version | -v ) - echo "$version" ; exit 0 ;; - --help | --h* | -h ) - echo "$usage"; exit 0 ;; - -- ) # Stop option processing - shift; break ;; - - ) # Use stdin as input. - break ;; - -* ) - echo "$me: invalid option $1$help" - exit 1 ;; - - *local*) - # First pass through any local machine types. - echo $1 - exit 0;; - - * ) - break ;; - esac -done - -case $# in - 0) echo "$me: missing argument$help" >&2 - exit 1;; - 1) ;; - *) echo "$me: too many arguments$help" >&2 - exit 1;; -esac - -# Separate what the user gave into CPU-COMPANY and OS or KERNEL-OS (if any). -# Here we must recognize all the valid KERNEL-OS combinations. -maybe_os=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\2/'` -case $maybe_os in - nto-qnx* | linux-gnu* | storm-chaos* | os2-emx*) - os=-$maybe_os - basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'` - ;; - *) - basic_machine=`echo $1 | sed 's/-[^-]*$//'` - if [ $basic_machine != $1 ] - then os=`echo $1 | sed 's/.*-/-/'` - else os=; fi - ;; -esac - -### Let's recognize common machines as not being operating systems so -### that things like config.sub decstation-3100 work. We also -### recognize some manufacturers as not being operating systems, so we -### can provide default operating systems below. -case $os in - -sun*os*) - # Prevent following clause from handling this invalid input. - ;; - -dec* | -mips* | -sequent* | -encore* | -pc532* | -sgi* | -sony* | \ - -att* | -7300* | -3300* | -delta* | -motorola* | -sun[234]* | \ - -unicom* | -ibm* | -next | -hp | -isi* | -apollo | -altos* | \ - -convergent* | -ncr* | -news | -32* | -3600* | -3100* | -hitachi* |\ - -c[123]* | -convex* | -sun | -crds | -omron* | -dg | -ultra | -tti* | \ - -harris | -dolphin | -highlevel | -gould | -cbm | -ns | -masscomp | \ - -apple | -axis) - os= - basic_machine=$1 - ;; - -sim | -cisco | -oki | -wec | -winbond) - os= - basic_machine=$1 - ;; - -scout) - ;; - -wrs) - os=-vxworks - basic_machine=$1 - ;; - -hiux*) - os=-hiuxwe2 - ;; - -sco5) - os=-sco3.2v5 - basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` - ;; - -sco4) - os=-sco3.2v4 - basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` - ;; - -sco3.2.[4-9]*) - os=`echo $os | sed -e 's/sco3.2./sco3.2v/'` - basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` - ;; - -sco3.2v[4-9]*) - # Don't forget version if it is 3.2v4 or newer. - basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` - ;; - -sco*) - os=-sco3.2v2 - basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` - ;; - -udk*) - basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` - ;; - -isc) - os=-isc2.2 - basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` - ;; - -clix*) - basic_machine=clipper-intergraph - ;; - -isc*) - basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` - ;; - -lynx*) - os=-lynxos - ;; - -ptx*) - basic_machine=`echo $1 | sed -e 's/86-.*/86-sequent/'` - ;; - -windowsnt*) - os=`echo $os | sed -e 's/windowsnt/winnt/'` - ;; - -psos*) - os=-psos - ;; - -mint | -mint[0-9]*) - basic_machine=m68k-atari - os=-mint - ;; -esac - -# Decode aliases for certain CPU-COMPANY combinations. -case $basic_machine in - # Recognize the basic CPU types without company name. - # Some are omitted here because they have special meanings below. - tahoe | i860 | ia64 | m32r | m68k | m68000 | m88k | ns32k | arc \ - | arm | arme[lb] | arm[bl]e | armv[2345] | armv[345][lb] | strongarm | xscale \ - | pyramid | mn10200 | mn10300 | tron | a29k \ - | 580 | i960 | h8300 \ - | x86 | ppcbe | mipsbe | mipsle | shbe | shle \ - | hppa | hppa1.0 | hppa1.1 | hppa2.0 | hppa2.0w | hppa2.0n \ - | hppa64 \ - | alpha | alphaev[4-8] | alphaev56 | alphapca5[67] \ - | alphaev6[78] \ - | we32k | ns16k | clipper | i370 | sh | sh[34] \ - | powerpc | powerpcle \ - | 1750a | dsp16xx | pdp10 | pdp11 \ - | mips16 | mips64 | mipsel | mips64el \ - | mips64orion | mips64orionel | mipstx39 | mipstx39el \ - | mips64vr4300 | mips64vr4300el | mips64vr4100 | mips64vr4100el \ - | mips64vr5000 | miprs64vr5000el | mcore \ - | sparc | sparclet | sparclite | sparc64 | sparcv9 | v850 | c4x \ - | thumb | d10v | d30v | fr30 | avr | openrisc) - basic_machine=$basic_machine-unknown - ;; - m6811 | m68hc11 | m6812 | m68hc12) - # Motorola 68HC11/12. - basic_machine=$basic_machine-unknown - os=-none - ;; - m88110 | m680[12346]0 | m683?2 | m68360 | m5200 | z8k | v70 | h8500 | w65 | pj | pjl) - ;; - - # We use `pc' rather than `unknown' - # because (1) that's what they normally are, and - # (2) the word "unknown" tends to confuse beginning users. - i[234567]86 | x86_64) - basic_machine=$basic_machine-pc - ;; - # Object if more than one company name word. - *-*-*) - echo Invalid configuration \`$1\': machine \`$basic_machine\' not recognized 1>&2 - exit 1 - ;; - # Recognize the basic CPU types with company name. - # FIXME: clean up the formatting here. - vax-* | tahoe-* | i[234567]86-* | i860-* | ia64-* | m32r-* | m68k-* | m68000-* \ - | m88k-* | sparc-* | ns32k-* | fx80-* | arc-* | c[123]* \ - | arm-* | armbe-* | armle-* | armv*-* | strongarm-* | xscale-* \ - | mips-* | pyramid-* | tron-* | a29k-* | romp-* | rs6000-* \ - | power-* | none-* | 580-* | cray2-* | h8300-* | h8500-* | i960-* \ - | xmp-* | ymp-* \ - | x86-* | ppcbe-* | mipsbe-* | mipsle-* | shbe-* | shle-* \ - | hppa-* | hppa1.0-* | hppa1.1-* | hppa2.0-* | hppa2.0w-* \ - | hppa2.0n-* | hppa64-* \ - | alpha-* | alphaev[4-8]-* | alphaev56-* | alphapca5[67]-* \ - | alphaev6[78]-* \ - | we32k-* | cydra-* | ns16k-* | pn-* | np1-* | xps100-* \ - | clipper-* | orion-* \ - | sparclite-* | pdp10-* | pdp11-* | sh-* | powerpc-* | powerpcle-* \ - | sparc64-* | sparcv9-* | sparc86x-* | mips16-* | mips64-* | mipsel-* \ - | mips64el-* | mips64orion-* | mips64orionel-* \ - | mips64vr4100-* | mips64vr4100el-* | mips64vr4300-* | mips64vr4300el-* \ - | mipstx39-* | mipstx39el-* | mcore-* \ - | f30[01]-* | f700-* | s390-* | s390x-* | sv1-* | t3e-* \ - | m88110-* | m680[01234]0-* | m683?2-* | m68360-* | z8k-* | d10v-* \ - | thumb-* | v850-* | d30v-* | tic30-* | c30-* | fr30-* \ - | bs2000-* | tic54x-* | c54x-* | x86_64-*) - ;; - # Recognize the various machine names and aliases which stand - # for a CPU type and a company and sometimes even an OS. - 386bsd) - basic_machine=i386-unknown - os=-bsd - ;; - 3b1 | 7300 | 7300-att | att-7300 | pc7300 | safari | unixpc) - basic_machine=m68000-att - ;; - 3b*) - basic_machine=we32k-att - ;; - a29khif) - basic_machine=a29k-amd - os=-udi - ;; - adobe68k) - basic_machine=m68010-adobe - os=-scout - ;; - alliant | fx80) - basic_machine=fx80-alliant - ;; - altos | altos3068) - basic_machine=m68k-altos - ;; - am29k) - basic_machine=a29k-none - os=-bsd - ;; - amdahl) - basic_machine=580-amdahl - os=-sysv - ;; - amiga | amiga-*) - basic_machine=m68k-unknown - ;; - amigaos | amigados) - basic_machine=m68k-unknown - os=-amigaos - ;; - amigaunix | amix) - basic_machine=m68k-unknown - os=-sysv4 - ;; - apollo68) - basic_machine=m68k-apollo - os=-sysv - ;; - apollo68bsd) - basic_machine=m68k-apollo - os=-bsd - ;; - aux) - basic_machine=m68k-apple - os=-aux - ;; - balance) - basic_machine=ns32k-sequent - os=-dynix - ;; - convex-c1) - basic_machine=c1-convex - os=-bsd - ;; - convex-c2) - basic_machine=c2-convex - os=-bsd - ;; - convex-c32) - basic_machine=c32-convex - os=-bsd - ;; - convex-c34) - basic_machine=c34-convex - os=-bsd - ;; - convex-c38) - basic_machine=c38-convex - os=-bsd - ;; - cray | ymp) - basic_machine=ymp-cray - os=-unicos - ;; - cray2) - basic_machine=cray2-cray - os=-unicos - ;; - [cjt]90) - basic_machine=${basic_machine}-cray - os=-unicos - ;; - crds | unos) - basic_machine=m68k-crds - ;; - cris | cris-* | etrax*) - basic_machine=cris-axis - ;; - da30 | da30-*) - basic_machine=m68k-da30 - ;; - decstation | decstation-3100 | pmax | pmax-* | pmin | dec3100 | decstatn) - basic_machine=mips-dec - ;; - delta | 3300 | motorola-3300 | motorola-delta \ - | 3300-motorola | delta-motorola) - basic_machine=m68k-motorola - ;; - delta88) - basic_machine=m88k-motorola - os=-sysv3 - ;; - dpx20 | dpx20-*) - basic_machine=rs6000-bull - os=-bosx - ;; - dpx2* | dpx2*-bull) - basic_machine=m68k-bull - os=-sysv3 - ;; - ebmon29k) - basic_machine=a29k-amd - os=-ebmon - ;; - elxsi) - basic_machine=elxsi-elxsi - os=-bsd - ;; - encore | umax | mmax) - basic_machine=ns32k-encore - ;; - es1800 | OSE68k | ose68k | ose | OSE) - basic_machine=m68k-ericsson - os=-ose - ;; - fx2800) - basic_machine=i860-alliant - ;; - genix) - basic_machine=ns32k-ns - ;; - gmicro) - basic_machine=tron-gmicro - os=-sysv - ;; - go32) - basic_machine=i386-pc - os=-go32 - ;; - h3050r* | hiux*) - basic_machine=hppa1.1-hitachi - os=-hiuxwe2 - ;; - h8300hms) - basic_machine=h8300-hitachi - os=-hms - ;; - h8300xray) - basic_machine=h8300-hitachi - os=-xray - ;; - h8500hms) - basic_machine=h8500-hitachi - os=-hms - ;; - harris) - basic_machine=m88k-harris - os=-sysv3 - ;; - hp300-*) - basic_machine=m68k-hp - ;; - hp300bsd) - basic_machine=m68k-hp - os=-bsd - ;; - hp300hpux) - basic_machine=m68k-hp - os=-hpux - ;; - hp3k9[0-9][0-9] | hp9[0-9][0-9]) - basic_machine=hppa1.0-hp - ;; - hp9k2[0-9][0-9] | hp9k31[0-9]) - basic_machine=m68000-hp - ;; - hp9k3[2-9][0-9]) - basic_machine=m68k-hp - ;; - hp9k6[0-9][0-9] | hp6[0-9][0-9]) - basic_machine=hppa1.0-hp - ;; - hp9k7[0-79][0-9] | hp7[0-79][0-9]) - basic_machine=hppa1.1-hp - ;; - hp9k78[0-9] | hp78[0-9]) - # FIXME: really hppa2.0-hp - basic_machine=hppa1.1-hp - ;; - hp9k8[67]1 | hp8[67]1 | hp9k80[24] | hp80[24] | hp9k8[78]9 | hp8[78]9 | hp9k893 | hp893) - # FIXME: really hppa2.0-hp - basic_machine=hppa1.1-hp - ;; - hp9k8[0-9][13679] | hp8[0-9][13679]) - basic_machine=hppa1.1-hp - ;; - hp9k8[0-9][0-9] | hp8[0-9][0-9]) - basic_machine=hppa1.0-hp - ;; - hppa-next) - os=-nextstep3 - ;; - hppaosf) - basic_machine=hppa1.1-hp - os=-osf - ;; - hppro) - basic_machine=hppa1.1-hp - os=-proelf - ;; - i370-ibm* | ibm*) - basic_machine=i370-ibm - ;; -# I'm not sure what "Sysv32" means. Should this be sysv3.2? - i[34567]86v32) - basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` - os=-sysv32 - ;; - i[34567]86v4*) - basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` - os=-sysv4 - ;; - i[34567]86v) - basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` - os=-sysv - ;; - i[34567]86sol2) - basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` - os=-solaris2 - ;; - i386mach) - basic_machine=i386-mach - os=-mach - ;; - i386-vsta | vsta) - basic_machine=i386-unknown - os=-vsta - ;; - iris | iris4d) - basic_machine=mips-sgi - case $os in - -irix*) - ;; - *) - os=-irix4 - ;; - esac - ;; - isi68 | isi) - basic_machine=m68k-isi - os=-sysv - ;; - m88k-omron*) - basic_machine=m88k-omron - ;; - magnum | m3230) - basic_machine=mips-mips - os=-sysv - ;; - merlin) - basic_machine=ns32k-utek - os=-sysv - ;; - mingw32) - basic_machine=i386-pc - os=-mingw32 - ;; - miniframe) - basic_machine=m68000-convergent - ;; - *mint | -mint[0-9]* | *MiNT | *MiNT[0-9]*) - basic_machine=m68k-atari - os=-mint - ;; - mipsel*-linux*) - basic_machine=mipsel-unknown - ;; - mips*-linux*) - basic_machine=mips-unknown - ;; - mips3*-*) - basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'` - ;; - mips3*) - basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'`-unknown - ;; - mmix*) - basic_machine=mmix-knuth - os=-mmixware - ;; - monitor) - basic_machine=m68k-rom68k - os=-coff - ;; - msdos) - basic_machine=i386-pc - os=-msdos - ;; - mvs) - basic_machine=i370-ibm - os=-mvs - ;; - ncr3000) - basic_machine=i486-ncr - os=-sysv4 - ;; - netbsd386) - basic_machine=i386-unknown - os=-netbsd - ;; - netwinder) - basic_machine=armv4l-rebel - os=-linux - ;; - news | news700 | news800 | news900) - basic_machine=m68k-sony - os=-newsos - ;; - news1000) - basic_machine=m68030-sony - os=-newsos - ;; - news-3600 | risc-news) - basic_machine=mips-sony - os=-newsos - ;; - necv70) - basic_machine=v70-nec - os=-sysv - ;; - next | m*-next ) - basic_machine=m68k-next - case $os in - -nextstep* ) - ;; - -ns2*) - os=-nextstep2 - ;; - *) - os=-nextstep3 - ;; - esac - ;; - nh3000) - basic_machine=m68k-harris - os=-cxux - ;; - nh[45]000) - basic_machine=m88k-harris - os=-cxux - ;; - nindy960) - basic_machine=i960-intel - os=-nindy - ;; - mon960) - basic_machine=i960-intel - os=-mon960 - ;; - nonstopux) - basic_machine=mips-compaq - os=-nonstopux - ;; - np1) - basic_machine=np1-gould - ;; - nsr-tandem) - basic_machine=nsr-tandem - ;; - op50n-* | op60c-*) - basic_machine=hppa1.1-oki - os=-proelf - ;; - OSE68000 | ose68000) - basic_machine=m68000-ericsson - os=-ose - ;; - os68k) - basic_machine=m68k-none - os=-os68k - ;; - pa-hitachi) - basic_machine=hppa1.1-hitachi - os=-hiuxwe2 - ;; - paragon) - basic_machine=i860-intel - os=-osf - ;; - pbd) - basic_machine=sparc-tti - ;; - pbb) - basic_machine=m68k-tti - ;; - pc532 | pc532-*) - basic_machine=ns32k-pc532 - ;; - pentium | p5 | k5 | k6 | nexgen) - basic_machine=i586-pc - ;; - pentiumpro | p6 | 6x86 | athlon) - basic_machine=i686-pc - ;; - pentiumii | pentium2) - basic_machine=i686-pc - ;; - pentium-* | p5-* | k5-* | k6-* | nexgen-*) - basic_machine=i586-`echo $basic_machine | sed 's/^[^-]*-//'` - ;; - pentiumpro-* | p6-* | 6x86-* | athlon-*) - basic_machine=i686-`echo $basic_machine | sed 's/^[^-]*-//'` - ;; - pentiumii-* | pentium2-*) - basic_machine=i686-`echo $basic_machine | sed 's/^[^-]*-//'` - ;; - pn) - basic_machine=pn-gould - ;; - power) basic_machine=power-ibm - ;; - ppc) basic_machine=powerpc-unknown - ;; - ppc-*) basic_machine=powerpc-`echo $basic_machine | sed 's/^[^-]*-//'` - ;; - ppcle | powerpclittle | ppc-le | powerpc-little) - basic_machine=powerpcle-unknown - ;; - ppcle-* | powerpclittle-*) - basic_machine=powerpcle-`echo $basic_machine | sed 's/^[^-]*-//'` - ;; - ps2) - basic_machine=i386-ibm - ;; - pw32) - basic_machine=i586-unknown - os=-pw32 - ;; - rom68k) - basic_machine=m68k-rom68k - os=-coff - ;; - rm[46]00) - basic_machine=mips-siemens - ;; - rtpc | rtpc-*) - basic_machine=romp-ibm - ;; - sa29200) - basic_machine=a29k-amd - os=-udi - ;; - sequent) - basic_machine=i386-sequent - ;; - sh) - basic_machine=sh-hitachi - os=-hms - ;; - sparclite-wrs) - basic_machine=sparclite-wrs - os=-vxworks - ;; - sps7) - basic_machine=m68k-bull - os=-sysv2 - ;; - spur) - basic_machine=spur-unknown - ;; - st2000) - basic_machine=m68k-tandem - ;; - stratus) - basic_machine=i860-stratus - os=-sysv4 - ;; - sun2) - basic_machine=m68000-sun - ;; - sun2os3) - basic_machine=m68000-sun - os=-sunos3 - ;; - sun2os4) - basic_machine=m68000-sun - os=-sunos4 - ;; - sun3os3) - basic_machine=m68k-sun - os=-sunos3 - ;; - sun3os4) - basic_machine=m68k-sun - os=-sunos4 - ;; - sun4os3) - basic_machine=sparc-sun - os=-sunos3 - ;; - sun4os4) - basic_machine=sparc-sun - os=-sunos4 - ;; - sun4sol2) - basic_machine=sparc-sun - os=-solaris2 - ;; - sun3 | sun3-*) - basic_machine=m68k-sun - ;; - sun4) - basic_machine=sparc-sun - ;; - sun386 | sun386i | roadrunner) - basic_machine=i386-sun - ;; - sv1) - basic_machine=sv1-cray - os=-unicos - ;; - symmetry) - basic_machine=i386-sequent - os=-dynix - ;; - t3e) - basic_machine=t3e-cray - os=-unicos - ;; - tic54x | c54x*) - basic_machine=tic54x-unknown - os=-coff - ;; - tx39) - basic_machine=mipstx39-unknown - ;; - tx39el) - basic_machine=mipstx39el-unknown - ;; - tower | tower-32) - basic_machine=m68k-ncr - ;; - udi29k) - basic_machine=a29k-amd - os=-udi - ;; - ultra3) - basic_machine=a29k-nyu - os=-sym1 - ;; - v810 | necv810) - basic_machine=v810-nec - os=-none - ;; - vaxv) - basic_machine=vax-dec - os=-sysv - ;; - vms) - basic_machine=vax-dec - os=-vms - ;; - vpp*|vx|vx-*) - basic_machine=f301-fujitsu - ;; - vxworks960) - basic_machine=i960-wrs - os=-vxworks - ;; - vxworks68) - basic_machine=m68k-wrs - os=-vxworks - ;; - vxworks29k) - basic_machine=a29k-wrs - os=-vxworks - ;; - w65*) - basic_machine=w65-wdc - os=-none - ;; - w89k-*) - basic_machine=hppa1.1-winbond - os=-proelf - ;; - xmp) - basic_machine=xmp-cray - os=-unicos - ;; - xps | xps100) - basic_machine=xps100-honeywell - ;; - z8k-*-coff) - basic_machine=z8k-unknown - os=-sim - ;; - none) - basic_machine=none-none - os=-none - ;; - -# Here we handle the default manufacturer of certain CPU types. It is in -# some cases the only manufacturer, in others, it is the most popular. - w89k) - basic_machine=hppa1.1-winbond - ;; - op50n) - basic_machine=hppa1.1-oki - ;; - op60c) - basic_machine=hppa1.1-oki - ;; - mips) - case $os in - linux*) - basic_machine=mips-unknown - ;; - *) - basic_machine=mips-mips - ;; - esac - ;; - romp) - basic_machine=romp-ibm - ;; - rs6000) - basic_machine=rs6000-ibm - ;; - vax) - basic_machine=vax-dec - ;; - pdp10) - # there are many clones, so DEC is not a safe bet - basic_machine=pdp10-unknown - ;; - pdp11) - basic_machine=pdp11-dec - ;; - we32k) - basic_machine=we32k-att - ;; - sh3 | sh4) - basic_machine=sh-unknown - ;; - sparc | sparcv9) - basic_machine=sparc-sun - ;; - cydra) - basic_machine=cydra-cydrome - ;; - orion) - basic_machine=orion-highlevel - ;; - orion105) - basic_machine=clipper-highlevel - ;; - mac | mpw | mac-mpw) - basic_machine=m68k-apple - ;; - pmac | pmac-mpw) - basic_machine=powerpc-apple - ;; - c4x*) - basic_machine=c4x-none - os=-coff - ;; - *) - echo Invalid configuration \`$1\': machine \`$basic_machine\' not recognized 1>&2 - exit 1 - ;; -esac - -# Here we canonicalize certain aliases for manufacturers. -case $basic_machine in - *-digital*) - basic_machine=`echo $basic_machine | sed 's/digital.*/dec/'` - ;; - *-commodore*) - basic_machine=`echo $basic_machine | sed 's/commodore.*/cbm/'` - ;; - *) - ;; -esac - -# Decode manufacturer-specific aliases for certain operating systems. - -if [ x"$os" != x"" ] -then -case $os in - # First match some system type aliases - # that might get confused with valid system types. - # -solaris* is a basic system type, with this one exception. - -solaris1 | -solaris1.*) - os=`echo $os | sed -e 's|solaris1|sunos4|'` - ;; - -solaris) - os=-solaris2 - ;; - -svr4*) - os=-sysv4 - ;; - -unixware*) - os=-sysv4.2uw - ;; - -gnu/linux*) - os=`echo $os | sed -e 's|gnu/linux|linux-gnu|'` - ;; - # First accept the basic system types. - # The portable systems comes first. - # Each alternative MUST END IN A *, to match a version number. - # -sysv* is not here because it comes later, after sysvr4. - -gnu* | -bsd* | -mach* | -minix* | -genix* | -ultrix* | -irix* \ - | -*vms* | -sco* | -esix* | -isc* | -aix* | -sunos | -sunos[34]*\ - | -hpux* | -unos* | -osf* | -luna* | -dgux* | -solaris* | -sym* \ - | -amigaos* | -amigados* | -msdos* | -newsos* | -unicos* | -aof* \ - | -aos* \ - | -nindy* | -vxsim* | -vxworks* | -ebmon* | -hms* | -mvs* \ - | -clix* | -riscos* | -uniplus* | -iris* | -rtu* | -xenix* \ - | -hiux* | -386bsd* | -netbsd* | -openbsd* | -freebsd* | -riscix* \ - | -lynxos* | -bosx* | -nextstep* | -cxux* | -aout* | -elf* | -oabi* \ - | -ptx* | -coff* | -ecoff* | -winnt* | -domain* | -vsta* \ - | -udi* | -eabi* | -lites* | -ieee* | -go32* | -aux* \ - | -cygwin* | -pe* | -psos* | -moss* | -proelf* | -rtems* \ - | -mingw32* | -linux* | -uxpv* | -beos* | -mpeix* | -udk* \ - | -interix* | -uwin* | -rhapsody* | -darwin* | -opened* \ - | -openstep* | -oskit* | -conix* | -pw32* | -nonstopux* \ - | -storm-chaos* | -tops10* | -tenex* | -tops20* | -its* | -os2*) - # Remember, each alternative MUST END IN *, to match a version number. - ;; - -qnx*) - case $basic_machine in - x86-* | i[34567]86-*) - ;; - *) - os=-nto$os - ;; - esac - ;; - -nto*) - os=-nto-qnx - ;; - -sim | -es1800* | -hms* | -xray | -os68k* | -none* | -v88r* \ - | -windows* | -osx | -abug | -netware* | -os9* | -beos* \ - | -macos* | -mpw* | -magic* | -mmixware* | -mon960* | -lnews*) - ;; - -mac*) - os=`echo $os | sed -e 's|mac|macos|'` - ;; - -sunos5*) - os=`echo $os | sed -e 's|sunos5|solaris2|'` - ;; - -sunos6*) - os=`echo $os | sed -e 's|sunos6|solaris3|'` - ;; - -opened*) - os=-openedition - ;; - -wince*) - os=-wince - ;; - -osfrose*) - os=-osfrose - ;; - -osf*) - os=-osf - ;; - -utek*) - os=-bsd - ;; - -dynix*) - os=-bsd - ;; - -acis*) - os=-aos - ;; - -386bsd) - os=-bsd - ;; - -ctix* | -uts*) - os=-sysv - ;; - -ns2 ) - os=-nextstep2 - ;; - -nsk*) - os=-nsk - ;; - # Preserve the version number of sinix5. - -sinix5.*) - os=`echo $os | sed -e 's|sinix|sysv|'` - ;; - -sinix*) - os=-sysv4 - ;; - -triton*) - os=-sysv3 - ;; - -oss*) - os=-sysv3 - ;; - -svr4) - os=-sysv4 - ;; - -svr3) - os=-sysv3 - ;; - -sysvr4) - os=-sysv4 - ;; - # This must come after -sysvr4. - -sysv*) - ;; - -ose*) - os=-ose - ;; - -es1800*) - os=-ose - ;; - -xenix) - os=-xenix - ;; - -*mint | -mint[0-9]* | -*MiNT | -MiNT[0-9]*) - os=-mint - ;; - -none) - ;; - *) - # Get rid of the `-' at the beginning of $os. - os=`echo $os | sed 's/[^-]*-//'` - echo Invalid configuration \`$1\': system \`$os\' not recognized 1>&2 - exit 1 - ;; -esac -else - -# Here we handle the default operating systems that come with various machines. -# The value should be what the vendor currently ships out the door with their -# machine or put another way, the most popular os provided with the machine. - -# Note that if you're going to try to match "-MANUFACTURER" here (say, -# "-sun"), then you have to tell the case statement up towards the top -# that MANUFACTURER isn't an operating system. Otherwise, code above -# will signal an error saying that MANUFACTURER isn't an operating -# system, and we'll never get to this point. - -case $basic_machine in - *-acorn) - os=-riscix1.2 - ;; - arm*-rebel) - os=-linux - ;; - arm*-semi) - os=-aout - ;; - pdp10-*) - os=-tops20 - ;; - pdp11-*) - os=-none - ;; - *-dec | vax-*) - os=-ultrix4.2 - ;; - m68*-apollo) - os=-domain - ;; - i386-sun) - os=-sunos4.0.2 - ;; - m68000-sun) - os=-sunos3 - # This also exists in the configure program, but was not the - # default. - # os=-sunos4 - ;; - m68*-cisco) - os=-aout - ;; - mips*-cisco) - os=-elf - ;; - mips*-*) - os=-elf - ;; - *-tti) # must be before sparc entry or we get the wrong os. - os=-sysv3 - ;; - sparc-* | *-sun) - os=-sunos4.1.1 - ;; - *-be) - os=-beos - ;; - *-ibm) - os=-aix - ;; - *-wec) - os=-proelf - ;; - *-winbond) - os=-proelf - ;; - *-oki) - os=-proelf - ;; - *-hp) - os=-hpux - ;; - *-hitachi) - os=-hiux - ;; - i860-* | *-att | *-ncr | *-altos | *-motorola | *-convergent) - os=-sysv - ;; - *-cbm) - os=-amigaos - ;; - *-dg) - os=-dgux - ;; - *-dolphin) - os=-sysv3 - ;; - m68k-ccur) - os=-rtu - ;; - m88k-omron*) - os=-luna - ;; - *-next ) - os=-nextstep - ;; - *-sequent) - os=-ptx - ;; - *-crds) - os=-unos - ;; - *-ns) - os=-genix - ;; - i370-*) - os=-mvs - ;; - *-next) - os=-nextstep3 - ;; - *-gould) - os=-sysv - ;; - *-highlevel) - os=-bsd - ;; - *-encore) - os=-bsd - ;; - *-sgi) - os=-irix - ;; - *-siemens) - os=-sysv4 - ;; - *-masscomp) - os=-rtu - ;; - f30[01]-fujitsu | f700-fujitsu) - os=-uxpv - ;; - *-rom68k) - os=-coff - ;; - *-*bug) - os=-coff - ;; - *-apple) - os=-macos - ;; - *-atari*) - os=-mint - ;; - *) - os=-none - ;; -esac -fi - -# Here we handle the case where we know the os, and the CPU type, but not the -# manufacturer. We pick the logical manufacturer. -vendor=unknown -case $basic_machine in - *-unknown) - case $os in - -riscix*) - vendor=acorn - ;; - -sunos*) - vendor=sun - ;; - -aix*) - vendor=ibm - ;; - -beos*) - vendor=be - ;; - -hpux*) - vendor=hp - ;; - -mpeix*) - vendor=hp - ;; - -hiux*) - vendor=hitachi - ;; - -unos*) - vendor=crds - ;; - -dgux*) - vendor=dg - ;; - -luna*) - vendor=omron - ;; - -genix*) - vendor=ns - ;; - -mvs* | -opened*) - vendor=ibm - ;; - -ptx*) - vendor=sequent - ;; - -vxsim* | -vxworks*) - vendor=wrs - ;; - -aux*) - vendor=apple - ;; - -hms*) - vendor=hitachi - ;; - -mpw* | -macos*) - vendor=apple - ;; - -*mint | -mint[0-9]* | -*MiNT | -MiNT[0-9]*) - vendor=atari - ;; - esac - basic_machine=`echo $basic_machine | sed "s/unknown/$vendor/"` - ;; -esac - -echo $basic_machine$os -exit 0 - -# Local variables: -# eval: (add-hook 'write-file-hooks 'time-stamp) -# time-stamp-start: "timestamp='" -# time-stamp-format: "%:y-%02m-%02d" -# time-stamp-end: "'" -# End: Index: branches/ohl/omega-development/completed/whizard2/extensions/people/tho/Makefile.in =================================================================== Index: branches/ohl/omega-development/completed/whizard2/extensions/people/tho/f90_O2.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/extensions/people/tho/f90_O2.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/extensions/people/tho/f90_O2.ml (revision 8703) @@ -1,584 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -let rcs_file = RCS.parse "f90_O2" ["O(2) SSB"] - { RCS.revision = "$Revision$"; - RCS.date = "$Date$"; - RCS.author = "$Author$"; - RCS.source - = "$Source: /home/sources/ohl/ml/omega/extensions/people/tho/f90_O2.ml,v $" } - -(* \subsection*{Lagrangian} *) - -(* Simplest model available: $\mathrm{SO}(2)$ - \begin{equation} - \mathcal{L} = \frac{1}{2} \partial_\mu\Phi\partial^\mu\Phi - - \frac{g}{4} (\Phi^2-v^2)^2 - \end{equation} - equation of motion - \begin{equation} - \Box\Phi = g(v^2-\Phi^2)\Phi - \end{equation} *) - -module O2 = - struct - let rcs = rcs_file - open Coupling - let options = Options.empty - -(* Expand fields around a new minimum - \begin{equation} - \Phi = \begin{pmatrix} v + \phi_1 \\ \phi_2 \end{pmatrix} - \end{equation} - with $\Phi^2-v^2=\phi_1^2+\phi_2^2+2v\phi_1$. *) - type flavor = Phi1 | Phi2 | J - - let conjugate f = f - - let external_flavors () = - [ "fields", [Phi1; Phi2]; - "currents", [J] ] - - let flavors () = ThoList.flatmap snd (external_flavors ()) - - let flavor_of_string = function - | "1" -> Phi1 | "2" -> Phi2 | "j" -> J - | _ -> invalid_arg "O2.flavor_of_string" - - let flavor_to_string = function - | Phi1 -> "phi1" | Phi2 -> "phi2" | J -> "j" - - let flavor_symbol = function - | Phi1 -> "p1" | Phi2 -> "p2" | J -> "j" - - let lorentz = function - | Phi1 | Phi2 -> Scalar | J -> Vector - - let propagator = function - | Phi1 | Phi2 -> Prop_Scalar | J -> Only_Insertion - - let width _ = Timelike - let goldstone _ = None - let fermion _ = 0 - let color _ = Color.Singlet - type gauge = unit - let gauge_symbol () = failwith "O2.gauge_symbol: internal error" - - let colsymm _ = (0,false), (0,false) - -(* \begin{multline} - \mathcal{L} = - \frac{1}{2} \partial_\mu\phi_1\partial^\mu\phi_1 - - \frac{1}{2} 2gv^2\phi_1^2 - gv \phi_1^3 - \frac{g}{4} \phi_1^4 \\ - + \frac{1}{2} \partial_\mu\phi_2\partial^\mu\phi_2 - \frac{g}{4} \phi_2^4 - - gv \phi_1\phi_2^2 - - \frac{g}{2} \phi_1^2\phi_2^2 - \end{multline} - Propagators - \begin{subequations} - \begin{align} - \parbox{21mm}{% - \begin{fmfgraph*}(20,5) - \fmfleft{i}\fmfright{o} - \fmflabel{$\phi_1(p)$}{i} - \fmflabel{$\phi_1(p)$}{o} - \fmf{plain}{i,o} - \fmfdot{i,o} - \end{fmfgraph*}}\qquad\quad - &= \frac{\mathrm{i}}{p^2-2gv^2+\mathrm{i}\epsilon} \\ - \parbox{21mm}{% - \begin{fmfgraph*}(20,5) - \fmfleft{i}\fmfright{o} - \fmflabel{$\phi_2(p)$}{i} - \fmflabel{$\phi_2(p)$}{o} - \fmf{dashes}{i,o} - \fmfdot{i,o} - \end{fmfgraph*}}\qquad\quad - &= \frac{\mathrm{i}}{p^2+\mathrm{i}\epsilon} - \end{align} - \end{subequations} - Three point vertices - \begin{subequations} - \begin{align} - \parbox{21mm}{% - \hfil\\\hfil\\ - \begin{fmfgraph*}(20,15) - \fmfleft{p1}\fmfright{p2,p3} - \fmflabel{$\phi_1(p_1)$}{p1} - \fmflabel{$\phi_1(p_2)$}{p2} - \fmflabel{$\phi_1(p_3)$}{p3} - \fmf{plain}{p1,v} - \fmf{plain}{p2,v,p3} - \fmfdot{v} - \end{fmfgraph*}\\ - \hfil}\qquad\quad - &= -6\mathrm{i}gv\\ - \parbox{21mm}{% - \hfil\\\hfil\\ - \begin{fmfgraph*}(20,15) - \fmfleft{p1}\fmfright{p2,p3} - \fmflabel{$\phi_1(p_1)$}{p1} - \fmflabel{$\phi_2(p_2)$}{p2} - \fmflabel{$\phi_2(p_3)$}{p3} - \fmf{plain}{p1,v} - \fmf{dashes}{p2,v,p3} - \fmfdot{v} - \end{fmfgraph*}\\ - \hfil}\qquad\quad - &= -2\mathrm{i}gv - \end{align} - \end{subequations} - Four point vertices - \begin{subequations} - \begin{align} - \parbox{21mm}{% - \hfil\\\hfil\\ - \begin{fmfgraph*}(20,15) - \fmfleft{p1,p2}\fmfright{p3,p4} - \fmflabel{$\phi_1(p_1)$}{p1} - \fmflabel{$\phi_1(p_2)$}{p2} - \fmflabel{$\phi_1(p_3)$}{p3} - \fmflabel{$\phi_1(p_4)$}{p4} - \fmf{plain}{p1,v,p2} - \fmf{plain}{p3,v,p4} - \fmfdot{v} - \end{fmfgraph*}\\ - \hfil}\qquad\quad - &= -6\mathrm{i}g\\ - \parbox{21mm}{% - \hfil\\\hfil\\ - \begin{fmfgraph*}(20,15) - \fmfleft{p1,p2}\fmfright{p3,p4} - \fmflabel{$\phi_2(p_1)$}{p1} - \fmflabel{$\phi_2(p_2)$}{p2} - \fmflabel{$\phi_2(p_3)$}{p3} - \fmflabel{$\phi_2(p_4)$}{p4} - \fmf{dashes}{p1,v,p2} - \fmf{dashes}{p3,v,p4} - \fmfdot{v} - \end{fmfgraph*}\\ - \hfil}\qquad\quad - &= -6\mathrm{i}g\\ - \parbox{21mm}{% - \hfil\\\hfil\\ - \begin{fmfgraph*}(20,15) - \fmfleft{p1,p2}\fmfright{p3,p4} - \fmflabel{$\phi_1(p_1)$}{p1} - \fmflabel{$\phi_1(p_2)$}{p2} - \fmflabel{$\phi_2(p_3)$}{p3} - \fmflabel{$\phi_2(p_4)$}{p4} - \fmf{plain}{p1,v,p2} - \fmf{dashes}{p3,v,p4} - \fmfdot{v} - \end{fmfgraph*}\\ - \hfil}\qquad\quad - &= -2\mathrm{i}g - \end{align} - \end{subequations} *) - -(* \subsection*{Conserved Current} *) - -(* \begin{equation} - \mathcal{L}\lbrack j_V, j_S \rbrack = - j_V^\mu\phi_1\mathrm{i}\overleftrightarrow{\partial_\mu}\phi_2 - + j_S v\mathrm{i}\partial_\mu\phi_2 - \end{equation} *) - - type constant = - | Unity | G | Vev - | M1 | M2 | MJ | W1 | W2 | WJ - | G3_111 | G3_122 - | G4_1111 | G4_1122 | G4_2222 - let constant_symbol = function - | Unity -> "unity" | G -> "g" | Vev -> "vev" - | M1 -> "m1" | M2 -> "m2" | MJ -> "mj" - | W1 -> "w1" | W2 -> "w2" | WJ -> "wj" - | G3_111 -> "g111" | G3_122 -> "g122" - | G4_1111 -> "g1111" | G4_2222 -> "g2222" - | G4_1122 -> "g1122" - - let vertices () = - ([(Phi1, Phi1, Phi1), Scalar_Scalar_Scalar 1, G3_111; - (Phi1, Phi2, Phi2), Scalar_Scalar_Scalar 1, G3_122; - (J, Phi1, Phi2), Vector_Scalar_Scalar 1, Unity], - [(Phi1, Phi1, Phi1, Phi1), Scalar4 1, G4_1111; - (Phi2, Phi2, Phi2, Phi2), Scalar4 1, G4_2222; - (Phi1, Phi1, Phi2, Phi2), Scalar4 1, G4_1122], - []) - - let parameters () = - { input = [G, 1.0; Vev, 1.0; MJ, 0.0; WJ, 0.0]; - derived = - [ Complex Unity, Const 1; - Real M1, Sqrt (Prod [Const 2; Atom G; Atom Vev; Atom Vev]); - Real M2, Const 0; - Real W1, Const 0; - Real W2, Const 0; - Real G3_111, Prod [Const (-6); Atom G; Atom Vev]; - Real G4_1111, Prod [Const (-6); Atom G]; - Real G4_2222, Prod [Const (-6); Atom G]; - Real G3_122, Prod [Const (-2); Atom G; Atom Vev]; - Real G4_1122, Prod [Const (-2); Atom G] ]; - derived_arrays = [] } - - module F = Models.Fusions (struct - type f = flavor - type c = constant - let compare = compare - let conjugate = conjugate - end) - let table = F.of_vertices (vertices ()) - let fuse2 = F.fuse2 table - let fuse3 = F.fuse3 table - let fuse = F.fuse table - let max_degree () = 3 - - - let pdg = function - | Phi1 -> 1 | Phi2 -> 2 | J -> 0 - let mass_symbol = function - | Phi1 -> "m1" | Phi2 -> "m2" | J -> "mj" - let width_symbol = function - | Phi1 -> "w1" | Phi2 -> "w2" | J -> "wj" - end - -(* \subsection*{Equations of Motion} *) - -(* Equations of motion in the broken phase - \begin{subequations} - \begin{align} - \Box\phi_1 &= - 2gv^2\phi_1 - 3gv\phi_1^2 - gv\phi_2^2 - - g \phi_1^3 - g \phi_1\phi_2^2 \\ - \Box\phi_2 &= - 2gv \phi_1\phi_2 - g \phi_1^2\phi_2 - g\phi_2^3 - \end{align} - \end{subequations} - factoring invariants simplifies things below - \begin{subequations} - \begin{align} - \Box\phi_1 &= - g (\phi_1 + v) (\phi_1^2 + \phi_2^2 + 2v\phi_1)\\ - \Box\phi_2 &= - g \phi_2(\phi_1^2 + \phi_2^2 + 2v\phi_1) - \end{align} - \end{subequations} - Noether current - \begin{equation} - j_\mu = \phi_1\partial_\mu\phi_2 - \phi_2\partial_\mu\phi_1 + v\partial_\mu\phi_2 - \end{equation} - is conserved explicitely - \begin{multline} - \partial^\mu j_\mu = (\phi_1+v)\Box\phi_2 - \phi_2\Box\phi_1 \\ - = - g(\phi_1+v)\phi_2(\phi_1^2 + \phi_2^2 + 2v\phi_1) - + g\phi_2(\phi_1 + v) (\phi_1^2 + \phi_2^2 + 2v\phi_1) = 0 - \end{multline} - conserved charge - \begin{subequations} - \begin{align} - \lbrack Q,\phi_1 \rbrack &= - \phi_2 \\ - \lbrack Q,\phi_2 \rbrack &= \phi_1 + v - \end{align} - \end{subequations} - with - \begin{equation} - \lbrack Q , \phi_1^2 + \phi_2^2 + 2v\phi_1 \rbrack = 0 - \end{equation} - covariance of the equations of motion - \begin{subequations} - \begin{align} - \Box\lbrack Q,\phi_1 \rbrack &= \lbrack Q,\Box\phi_1 \rbrack \\ - -\Box\phi_2 &= -g \lbrack Q, (\phi_1+v)(\phi_1^2 + \phi_2^2 + 2v\phi_1) \rbrack - = g \phi_2 (\phi_1^2 + \phi_2^2 + 2v\phi_1) - \end{align} - \end{subequations} - and - \begin{subequations} - \begin{align} - \Box\lbrack Q,\phi_2 \rbrack &= \lbrack Q,\Box\phi_2 \rbrack \\ - \Box\phi_1 &= -g \lbrack Q, \phi_2(\phi_1^2 + \phi_2^2 + 2v\phi_1) \rbrack - = -g (\phi_1+v) (\phi_1^2 + \phi_2^2 + 2v\phi_1) - \end{align} - \end{subequations} *) - -(* \subsection*{Ward Identities} *) - -(* On shell current matrix elements - \begin{multline} - J_\mu(k_1,k_2) = \Braket{0|j_\mu(x)|\phi_1(k_1)\phi_2(k_2)} = - \Braket{0|j_\mu(x)|\phi_1(k_1)\phi_2(k_2)}_{(0)} \\ - + \mathrm{i}\int\!\mathrm{d}^4y\; - \Braket{0|j_\mu(x)\mathcal{L}(y)|\phi_1(k_1)\phi_2(k_2)}_{(0)} - + O(g^2) \\ - \sim k_{2,\mu} - k_{1,\mu} - + v (k_1+k_2)_\mu \frac{\mathrm{i}}{(k_1+k_2)^2} (-\mathrm{i} 2gv) - + O(g^2) - \end{multline} - \begin{equation} - (k_1+k_2)^\mu J_\mu(k_1,k_2) = k_2^2 - k_1^2 + 2gv^2 + O(g^2) = O(g^2) - \end{equation} - Also for off-shell Greensfunctions - \begin{multline} - \frac{\partial}{\partial x_\mu} - \Braket{0|\mathrm{T}j_\mu(x)\phi(y)\phi(z)|0} = - \delta(x_0-y_0) \Braket{0|\mathrm{T}\lbrack j_0(x),\phi(y) \rbrack \phi(z)|0} \\ - + \delta(x_0-z_0) \Braket{0|\mathrm{T}\phi(y)\lbrack j_0(x),\phi(z) \rbrack |0} - + \Braket{0|\mathrm{T}\partial^\mu j_\mu(x)\phi(y)\phi(z)|0} - \end{multline} - where the last term vanishes for purely spontaneous symmetry - breaking. Assuming - \begin{equation} - \lbrack j_0(x),\phi(y) \rbrack \Bigr\vert_{x_0=y_0} - = \delta^3(\vec x - \vec y) \lbrack Q,\phi(y) \rbrack - \end{equation} - this reads - \begin{multline} - \delta^4(x-y) \Braket{0|\mathrm{T}\lbrack Q,\phi(y) \rbrack \phi(z)|0} - + \delta^4(x-z) \Braket{0|\mathrm{T}\phi(y)\lbrack Q,\phi(z) \rbrack |0} = \\ - \frac{\partial}{\partial x_\mu} - \Braket{0|\mathrm{T}j_\mu(x)\phi(y)\phi(z)|0} - - \Braket{0|\mathrm{T}\partial^\mu j_\mu(x)\phi(y)\phi(z)|0} - \end{multline} - Integrated (zero-momentum insertion) - \begin{multline} - \Braket{0|\mathrm{T}\lbrack Q,\phi(y) \rbrack \phi(z)|0} - + \Braket{0|\mathrm{T}\phi(y)\lbrack Q,\phi(z) \rbrack |0} = - \Braket{0|\mathrm{T}\lbrack Q,\phi(y)\phi(z) \rbrack |0} = \\ - \int\!\mathrm{d}^4x\, \frac{\partial}{\partial x_\mu} - \Braket{0|\mathrm{T}j_\mu(x)\phi(y)\phi(z)|0} - - \int\!\mathrm{d}^4x - \Braket{0|\mathrm{T}\partial^\mu j_\mu(x)\phi(y)\phi(z)|0} - \end{multline} - where the first term does \emph{not} vanish for spontaneous symmetry - breaking, because massless Goldstone boson states give a contribution - at infinity. - E.\,g.: - \begin{multline} - \delta^4(y-x_1) \Braket{0|\mathrm{T}\lbrack Q,\phi_1(x_1) \rbrack \phi_2(x_2)|0} - + \delta^4(y-x_2) \Braket{0|\mathrm{T}\phi_1(x_1)\lbrack Q,\phi_2(x_2) \rbrack |0} \\ - = - - \delta^4(y-x_1) \Braket{0|\mathrm{T}\phi_2(x_1)\phi_2(x_2)|0} - + \delta^4(y-x_2) \Braket{0|\mathrm{T}\phi_1(x_1)\phi_1(x_2)|0} \\ - + v \delta^4(y-x_2) \Braket{0|\mathrm{T}\phi_1(x_1)|0} - = \frac{\partial}{\partial y_\mu} - \Braket{0|\mathrm{T}j_\mu(y)\phi_1(x_1)\phi_2(x_2)|0} - \end{multline} - in tree approximation in momentum space - \begin{multline} - \mbox{} - \frac{\mathrm{i}}{k_2^2} + \frac{\mathrm{i}}{k_1^2-2gv^2} = - -\mathrm{i}(k_1+k_2)^\mu(k_{2,\mu}-k_{1,\mu}) - \frac{\mathrm{i}}{k_2^2}\frac{\mathrm{i}}{k_1^2-2gv^2} \\ - + v(-\mathrm{i}(k_1+k_2)^\mu) (k_1+k_2)_\mu - \frac{\mathrm{i}}{(k_1+k_2)^2} (-\mathrm{i} 2gv) - \frac{\mathrm{i}}{k_2^2}\frac{\mathrm{i}}{k_1^2-2gv^2} \\ - = -\mathrm{i} (k_2^2-k_1^2 + 2gv^2) - \frac{\mathrm{i}}{k_2^2}\frac{\mathrm{i}}{k_1^2-2gv^2} - \end{multline} - similarly, the transformed $n$-point function can be related to the - divergence of a $(n-1)$-point function with the insertion of one - current. - - Graphically denoting the influx of momentum by a dotted line, we have - the \emph{exact} relation (for $k+p_1+p_2=0$ and all momenta incoming) - \begin{equation} - \parbox{21mm}{% - \begin{fmfgraph*}(20,15) - \fmfleft{i,di}\fmfright{o,do} - \fmftop{k} - \fmf{plain,label=$p_1$,l.side=left}{i,o} - \fmf{dots,label=$k$,l.side=left}{k,o} - \end{fmfgraph*}} = - \parbox{21mm}{% - \begin{fmfgraph*}(20,15) - \fmfleft{i,di}\fmfright{o,do} - \fmftop{k} - \fmf{dashes,label=$p_2$,l.side=left}{i,o} - \fmf{dots,label=$k$,l.side=left}{i,k} - \end{fmfgraph*}} + - \parbox{21mm}{% - \begin{fmfgraph*}(20,15) - \fmfleft{i,di}\fmfright{o,do} - \fmftop{k} - \fmf{plain}{i,v} - \fmf{dashes}{v,o} - \fmf{dashes,label=$\phi_2$,l.side=left}{v,k} - \fmfdot{v,k} - \end{fmfgraph*}} + - \parbox{21mm}{% - \begin{fmfgraph*}(20,15) - \fmfleft{i,di}\fmfright{o,do} - \fmftop{k} - \fmf{plain}{i,v} - \fmf{dashes}{v,o} - \fmf{dots,label=$\partial_\mu$,l.side=left,tension=2}{v,k} - \fmfdot{v} - \end{fmfgraph*}} - \end{equation} - that can eventually be used to derive more complicated relations, if we - manage to find the corresponding rules for vertices. - - Caveat: in - \begin{multline} - \frac{\partial}{\partial y_\mu} - \Braket{0|\mathrm{T}j_\mu(y)\phi_2(x_1)\phi_1(x_2)\cdots|0} = \\ - \delta^4(y-x_1) \Braket{0|\mathrm{T}\lbrack Q,\phi_2(x_1) \rbrack \phi_1(x_2)\cdots|0} \\ - \mbox{} + \delta^4(y-x_2) - \Braket{0|\mathrm{T}\phi_2(x_1)\lbrack Q,\phi_1(x_2) \rbrack \cdots|0} + \ldots = \\ - \delta^4(y-x_1) - \Braket{0|\mathrm{T}\phi_1(x_1)\phi_1(x_2)\cdots|0} - + v \delta^4(y-x_1)\Braket{0|\mathrm{T}\phi_1(x_2)\cdots|0} \\ - \mbox{} - \delta^4(y-x_2) - \Braket{0|\mathrm{T}\phi_2(x_1)\phi_2(x_2)\cdots|0} - \ldots - \end{multline} - the $v$-term in the transformation of~$\phi_2$ does \emph{not} - vanish. However, a closer inspection of the fourier transform - \begin{multline} - k^{\mu}G_{\mu}^{j|\phi_2\phi_1\cdots} (k|p_1,p_2,\ldots) - \Bigr|_{k+p_1+p_2+\ldots=0} = \\ - G^{\phi_1\phi_1\cdots} (p_1+k,p_2,\ldots) - + (2\pi)^4 \delta^4(k+p_1) v G^{\phi_1\cdots} (p_2,\ldots)\Bigr|_{p_2+\ldots=0}\\ - - G^{\phi_2\phi_2\cdots} (p_1,p_2+k,\ldots) - \ldots - \end{multline} - reveals that the $v$-term corresponds to disconnected diagrams and - can be dropped. - \begin{multline} - k^{\mu}G_{\mu}^{j|\phi_2\phi_1\cdots,\text{amp.}} (k|p_1,p_2,\ldots) - \Bigr|_{k+p_1+p_2+\ldots=0} = \\ - \frac{G^{\phi_1\phi_1}(p_1+k)}{G^{\phi_2\phi_2}(p_1)} - G^{\phi_1\phi_1\cdots,\text{amp.}} (p_1+k,p_2,\ldots) - \Bigr|_{k+p_1+p_2+\ldots=0} \\ - - \frac{G^{\phi_2\phi_2}(p_2+k)}{G^{\phi_1\phi_1}(p_2)} - G^{\phi_2\phi_2\cdots,\text{amp.}} (p_1,p_2+k,\ldots) - \Bigr|_{k+p_1+p_2+\ldots=0} - \ldots - \end{multline} - For $k_\mu\to0$: - \begin{multline} - \lim_{k_\mu\to0} - k^{\mu}G_{\mu}^{j|\phi_2\phi_1\cdots,\text{amp.}} (k|p_1,p_2,\ldots) - \Bigr|_{k+p_1+p_2+\ldots=0} = \\ - \frac{G^{\phi_1\phi_1}(p_1)}{G^{\phi_2\phi_2}(p_1)} - G^{\phi_1\phi_1\cdots,\text{amp.}} (p_1,p_2,\ldots) - \Bigr|_{p_1+p_2+\ldots=0} \\ - - \frac{G^{\phi_2\phi_2}(p_2)}{G^{\phi_1\phi_1}(p_2)} - G^{\phi_2\phi_2\cdots,\text{amp.}} (p_1,p_2,\ldots) - \Bigr|_{p_1+p_2+\ldots=0} - \ldots - \end{multline} - Now we bring the second, third and all following terms of r.h.s. - to the left and then exchange l.h.s. and r.h.s. We multiply everything - with the prefactor of the one remaining term on the l.h.s. - There's one subtlety: the right hand side of - \begin{multline} - G^{\phi_1\phi_1\cdots,\text{amp.}} (p_1,p_2,\ldots) - \Bigr|_{p_1+p_2+\ldots=0} = \\ - \frac{G^{\phi_2\phi_2}(p_1)}{G^{\phi_1\phi_1}(p_1)} - \lim_{k_\mu\to0} - k^{\mu}G_{\mu}^{j|\phi_2\phi_1\cdots,\text{amp.}} (k|p_1,p_2,\ldots) - \Bigr|_{k+p_1+p_2+\ldots=0} \\ - + \frac{G^{\phi_2\phi_2}(p_1)}{G^{\phi_1\phi_1}(p_1)} - \frac{G^{\phi_2\phi_2}(p_2)}{G^{\phi_1\phi_1}(p_2)} - G^{\phi_2\phi_2\cdots,\text{amp.}} (p_1,p_2,\ldots) - \Bigr|_{p_1+p_2+\ldots=0} + \ldots - \end{multline} - appears to vanish on the mass shell of the left hand side, but this - need not mean that the corresponding scattering amplitude vanishes. - What is going on, is that the insertion of a soft current or the - emission or absorption of a soft Goldstone boson contributes another - pole for $k_\mu\to0$, if momentum conservation is taken into account. - \begin{subequations} - \begin{multline} - \mathrm{F.T.} \Braket{0|\mathrm{T}\phi_1(x_1)\phi_1(x_2)\phi_1(x_3)|0} = \\ - (-6\mathrm{i}gv) \frac{\mathrm{i}}{(p_1+k)^2-2gv^2} - \frac{\mathrm{i}}{p_2^2-2gv^2} \frac{\mathrm{i}}{p_3^2-2gv^2} - \end{multline} - \begin{align} - \mathrm{F.T.} \Braket{0|\mathrm{T}\phi_2(x_1)\phi_2(x_2)\phi_1(x_3)|0} - &= (-2\mathrm{i}gv) \frac{\mathrm{i}}{p_1^2} - \frac{\mathrm{i}}{(p_2+k)^2} \frac{\mathrm{i}}{p_3^2-2gv^2} \\ - \mathrm{F.T.} \Braket{0|\mathrm{T}\phi_2(x_1)\phi_1(x_2)\phi_2(x_3)|0} - &= (-2\mathrm{i}gv) \frac{\mathrm{i}}{p_1^2} - \frac{\mathrm{i}}{p_2^2-2gv^2} \frac{\mathrm{i}}{(p_3+k)^2} - \end{align} - \end{subequations} - \begin{multline} - \mathrm{F.T.} \Braket{0|\mathrm{T}j_\mu(y)\phi_2(x_1)\phi_1(x_2)\phi_1(x_3)|0} = \\ - \frac{\mathrm{i}}{p_1^2}\frac{\mathrm{i}}{p_2^2-2gv^2}\frac{\mathrm{i}}{p_3^2-2gv^2} - \left( \mathrm{F.T.} \Braket{0|\mathrm{T}j_\mu(y)\phi_2(x_1) - \phi_1(x_2)\phi_1(x_3)|0}_{\text{amp.}} \right) - \end{multline} - \begin{multline} - \mathrm{F.T.} \Braket{0|\mathrm{T}j_\mu(y)\phi_2(x_1) - \phi_1(x_2)\phi_1(x_3)|0}_{\text{amp.}} = - v k_\mu \frac{\mathrm{i}}{k^2} (-2\mathrm{i}g) \\ - + (p_{1,\mu}-p_{2,\mu}-p_{3,\mu}) - \frac{\mathrm{i}}{(p_2+p_3)^2-2gv^2} (-6\mathrm{i}gv) \\ - + v k_\mu \frac{\mathrm{i}}{k^2} - (-2\mathrm{i}gv) \frac{\mathrm{i}}{(p_2+p_3)^2-2gv^2} (-6\mathrm{i}gv) \\ - + (p_{1,\mu}+p_{2,\mu}-p_{3,\mu}) \frac{\mathrm{i}}{(p_1+p_2)^2} (-2\mathrm{i}gv) - + v k_\mu \frac{\mathrm{i}}{k^2} (-2\mathrm{i}gv) - \frac{\mathrm{i}}{(p_1+p_2)^2} (-2\mathrm{i}gv) \\ - + (p_{1,\mu}+p_{3,\mu}-p_{2,\mu}) \frac{\mathrm{i}}{(p_1+p_3)^2} (-2\mathrm{i}gv) - + v k_\mu \frac{\mathrm{i}}{k^2} (-2\mathrm{i}gv) - \frac{\mathrm{i}}{(p_1+p_3)^2} (-2\mathrm{i}gv) - \end{multline} - with $\partial_\mu\to-\mathrm{i}k_\mu=\mathrm{i}(p_1+p_2+p_3)_\mu$: - \begin{multline} - \mathrm{F.T.} \partial_y^\mu\Braket{0|\mathrm{T}j_\mu(y)\phi_2(x_1) - \phi_1(x_2)\phi_1(x_3)|0}_{\text{amp.}} = \\ - -2\mathrm{i}gv - - \frac{p_1^2-(p_2+p_3)^2}{(p_2+p_3)^2-2gv^2} 6\mathrm{i}gv - - \frac{2gv^2}{(p_2+p_3)^2-2gv^2} 6\mathrm{i}gv \\ - - \frac{(p_1+p_2)^2-p_3^2}{(p_1+p_2)^2} 2\mathrm{i}gv - - \frac{2gv^2}{(p_1+p_2)^2} 2\mathrm{i}gv - - \frac{(p_1+p_3)^2-p_2^2}{(p_1+p_3)^2} 2\mathrm{i}gv - - \frac{2gv^2}{(p_1+p_3)^2} 2\mathrm{i}gv \\ - = \mbox{} -2\mathrm{i}gv - - \frac{p_1^2-(p_2+p_3)^2+2gv^2}{(p_2+p_3)^2-2gv^2} 6\mathrm{i}gv \\ - - \frac{(p_1+p_2)^2-p_3^2+2gv^2}{(p_1+p_2)^2} 2\mathrm{i}gv - - \frac{(p_1+p_3)^2-p_2^2+2gv^2}{(p_1+p_3)^2} 2\mathrm{i}gv \\ - = \mbox{} - - \frac{p_1^2}{(p_2+p_3)^2-2gv^2} 6\mathrm{i}gv - + \frac{p_3^2-2gv^2}{(p_1+p_2)^2} 2\mathrm{i}gv - + \frac{p_2^2-2gv^2}{(p_1+p_3)^2} 2\mathrm{i}gv - \end{multline} - If the symmetry is unbroken, the - propagators cancel $G^{\phi_1\phi_1}(p_1)=G^{\phi_2\phi_2}(p_1)$: - \begin{multline} - \lim_{k_\mu\to0} - k^{\mu}G_{\mu}^{j|\phi_2\phi_1\cdots,\text{amp.}} (k|p_1,p_2,\ldots) - \Bigr|_{k+p_1+p_2+\ldots=0} = \\ - G^{\phi_1\phi_1\cdots,\text{amp.}} (p_1,p_2,\ldots) - \Bigr|_{p_1+p_2+\ldots=0} - - G^{\phi_2\phi_2\cdots,\text{amp.}} (p_1,p_2,\ldots) - \Bigr|_{p_1+p_2+\ldots=0} - \ldots - \end{multline} *) - -(* Caveat: the Ward identities for on-shell amplitudes do \emph{not} test - the theory comprehensively, since only the coupling of Goldstone bosons - and and currents to external lines. *) - -module Main = Omega.Make(Fusion.Mixed23)(Targets.Fortran)(O2) -let _ = Main.main () - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) - Index: branches/ohl/omega-development/completed/whizard2/extensions/people/tho/main2.tex =================================================================== --- branches/ohl/omega-development/completed/whizard2/extensions/people/tho/main2.tex (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/extensions/people/tho/main2.tex (revision 8703) @@ -1,42 +0,0 @@ -% $Id: main2.tex,v 1.1 2004/04/09 20:11:17 ohl Exp $ -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\documentclass[12pt]{article} -\usepackage{ocamlweb} -\usepackage{amsmath,amssymb,thophys} -\setlength{\parindent}{0pt} -\usepackage{feynmp} -\setlength{\unitlength}{1mm} -\newcommand{\ii}{\mathrm{i}} -\begin{document} -\begin{fmffile}{main2pics} -\input{f90_O2.implementation} -%%%\begin{figure} -%%%\def\F#1#2{\fmfi{dots}{.8[vloc(__v),vloc(__#1)] -- .8[vloc(__v),vloc(__#2)]}} -%%%\def\D#1{\parbox{35mm}{% -%%% \begin{fmfgraph}(35,35) -%%% \fmfleft{s}\fmfrightn{f}{4} -%%% \fmfbottomn{b}{4}\fmfforce{c}{v} -%%% \fmfv{dec.shape=circle,dec.fill=0,dec.size=.35w}{v} -%%% \fmfv{dec.shape=tetragram,dec.fill=1,dec.size=3thick}{f3,f4,b2,b3} -%%% \fmf{fermion}{f4,v,f3} -%%% \fmf{fermion}{f2,v,f1} -%%% \fmf{photon}{b2,v,b3} -%%% \fmffreeze #1 -%%% \F{f1}{f2}\F{f3}{f4}\F{b2}{b3} -%%% \end{fmfgraph}}} -%%%\begin{multline} -%%% \D{\fmf{dashes}{s,v}}\\ -%%% =\D{\fmfi{dashes}{% -%%% vloc(__s){vloc(__v)-vloc(__s)} -%%% .. .5[vloc(__s),vloc(__f4)] .. -%%% {vloc(__f4)-vloc(__v)} vloc(__f4)}} -%%% +\cdots+\D{\fmfi{dashes}{% -%%% vloc(__s){vloc(__v)-vloc(__s)} -%%% .. .5[vloc(__s),vloc(__f4)] .. -%%% {vloc(__f3)-vloc(__v)} vloc(__f3)}} -%%%\end{multline} -%%% \caption{\label{fig:WI}% -%%% Ward identities} -%%%\end{figure} -\end{fmffile} -\end{document} Index: branches/ohl/omega-development/completed/whizard2/extensions/people/tho/f90_O2_test.f95 =================================================================== --- branches/ohl/omega-development/completed/whizard2/extensions/people/tho/f90_O2_test.f95 (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/extensions/people/tho/f90_O2_test.f95 (revision 8703) @@ -1,137 +0,0 @@ -program f90_O2_test - use omega95 - use omega_parameters - use kinds - use kinematics - use rambo - use tao_random_numbers - implicit none - integer, parameter :: N = 5 - real(kind=default), save :: roots = 100 - real(kind=default), dimension(N+1) :: m - real(kind=default), dimension(0:3,N+1) :: p - real(kind=default), dimension(N,0:3,N) :: pk - complex(kind=default) :: a(N), j(2) - integer :: seed, i - read *, seed, roots - call tao_random_seed (seed) - g = 0.1_default - vev = 10_default - call setup_parameters () - ! call print_parameters () - call tao_random_number (m) - m = 0.2 * roots * m - mj = m(N+1) - call beams (roots, m(1), m(2), p(:,1), p(:,2)) - call massive_decay (roots, m(3:), p(:,3:)) - forall (i = 1:N) - pk(i,:,:) = p(:,1:N) - end forall - pk(1,:,1) = p(:,1) - p(:,N+1) - pk(2,:,2) = p(:,2) - p(:,N+1) - forall (i = 3:N) - pk(i,:,i) = p(:,i) + p(:,N+1) - end forall - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - j(1) = - mj * with_insertion (p, (/ 0, 0, 0, 0, 0, 4 /), (/ 2, 1, 1, 1, 1, 0 /)) - j(2) = vev * with_insertion (p, (/ 0, 0, 0, 0, 0, 0 /), (/ 2, 1, 1, 1, 1, 2 /)) - a(1) = without_insertion (pk(1,:,:), (/ 0, 0, 0, 0, 0 /), (/ 1, 1, 1, 1, 1 /)) - a(2) = - without_insertion (pk(2,:,:), (/ 0, 0, 0, 0, 0 /), (/ 2, 2, 1, 1, 1 /)) - a(3) = - without_insertion (pk(3,:,:), (/ 0, 0, 0, 0, 0 /), (/ 2, 1, 2, 1, 1 /)) - a(4) = - without_insertion (pk(4,:,:), (/ 0, 0, 0, 0, 0 /), (/ 2, 1, 1, 2, 1 /)) - a(5) = - without_insertion (pk(5,:,:), (/ 0, 0, 0, 0, 0 /), (/ 2, 1, 1, 1, 2 /)) - a(1) = g2 (pk(1,:,1), m1) / g2 (p(:,1), m2) * a(1) - forall (i = 2:N) - a(i) = g2 (pk(i,:,i), m2) / g2 (p(:,i), m1) * a(i) - end forall -! print *, ' A=', cmplx (sum (a)), 'J=', cmplx (sum (j)) - print *, 'A/J=', sum (a) / (sum (j)) - 1 - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - j(1) = - mj * with_insertion (p, (/ 0, 0, 0, 0, 0, 4 /), (/ 1, 2, 1, 1, 1, 0 /)) - j(2) = vev * with_insertion (p, (/ 0, 0, 0, 0, 0, 0 /), (/ 1, 2, 1, 1, 1, 2 /)) - a(1) = - without_insertion (pk(1,:,:), (/ 0, 0, 0, 0, 0 /), (/ 2, 2, 1, 1, 1 /)) - a(2) = without_insertion (pk(2,:,:), (/ 0, 0, 0, 0, 0 /), (/ 1, 1, 1, 1, 1 /)) - a(3) = - without_insertion (pk(3,:,:), (/ 0, 0, 0, 0, 0 /), (/ 1, 2, 2, 1, 1 /)) - a(4) = - without_insertion (pk(4,:,:), (/ 0, 0, 0, 0, 0 /), (/ 1, 2, 1, 2, 1 /)) - a(5) = - without_insertion (pk(5,:,:), (/ 0, 0, 0, 0, 0 /), (/ 1, 2, 1, 1, 2 /)) - forall (i = 1:1) - a(i) = g2 (pk(i,:,i), m2) / g2 (p(:,i), m1) * a(i) - end forall - a(2) = g2 (pk(2,:,2), m1) / g2 (p(:,2), m2) * a(2) - forall (i = 3:N) - a(i) = g2 (pk(i,:,i), m2) / g2 (p(:,i), m1) * a(i) - end forall -! print *, ' A=', cmplx (sum (a)), 'J=', cmplx (sum (j)) - print *, 'A/J=', sum (a) / (sum (j)) - 1 - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - j(1) = - mj * with_insertion (p, (/ 0, 0, 0, 0, 0, 4 /), (/ 1, 1, 2, 1, 1, 0 /)) - j(2) = vev * with_insertion (p, (/ 0, 0, 0, 0, 0, 0 /), (/ 1, 1, 2, 1, 1, 2 /)) - a(1) = - without_insertion (pk(1,:,:), (/ 0, 0, 0, 0, 0 /), (/ 2, 1, 2, 1, 1 /)) - a(2) = - without_insertion (pk(2,:,:), (/ 0, 0, 0, 0, 0 /), (/ 1, 2, 2, 1, 1 /)) - a(3) = without_insertion (pk(3,:,:), (/ 0, 0, 0, 0, 0 /), (/ 1, 1, 1, 1, 1 /)) - a(4) = - without_insertion (pk(4,:,:), (/ 0, 0, 0, 0, 0 /), (/ 1, 1, 2, 2, 1 /)) - a(5) = - without_insertion (pk(5,:,:), (/ 0, 0, 0, 0, 0 /), (/ 1, 1, 2, 1, 2 /)) - forall (i = 1:2) - a(i) = g2 (pk(i,:,i), m2) / g2 (p(:,i), m1) * a(i) - end forall - a(3) = g2 (pk(3,:,3), m1) / g2 (p(:,3), m2) * a(3) - forall (i = 4:N) - a(i) = g2 (pk(i,:,i), m2) / g2 (p(:,i), m1) * a(i) - end forall -! print *, ' A=', cmplx (sum (a)), 'J=', cmplx (sum (j)) - print *, 'A/J=', sum (a) / (sum (j)) - 1 - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - j(1) = - mj * with_insertion (p, (/ 0, 0, 0, 0, 0, 4 /), (/ 2, 2, 2, 2, 2, 0 /)) - j(2) = vev * with_insertion (p, (/ 0, 0, 0, 0, 0, 0 /), (/ 2, 2, 2, 2, 2, 2 /)) - a(1) = without_insertion (pk(1,:,:), (/ 0, 0, 0, 0, 0 /), (/ 1, 2, 2, 2, 2 /)) - a(2) = without_insertion (pk(2,:,:), (/ 0, 0, 0, 0, 0 /), (/ 2, 1, 2, 2, 2 /)) - a(3) = without_insertion (pk(3,:,:), (/ 0, 0, 0, 0, 0 /), (/ 2, 2, 1, 2, 2 /)) - a(4) = without_insertion (pk(4,:,:), (/ 0, 0, 0, 0, 0 /), (/ 2, 2, 2, 1, 2 /)) - a(5) = without_insertion (pk(5,:,:), (/ 0, 0, 0, 0, 0 /), (/ 2, 2, 2, 2, 1 /)) - forall (i = 1:N) - a(i) = g2 (pk(i,:,i), m1) / g2 (p(:,i), m2) * a(i) - end forall -! print *, ' A=', cmplx (sum (a)), 'J=', cmplx (sum (j)) - print *, 'A/J=', sum (a) / (sum (j)) - 1 - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! m(1) = m1 -! m(2:N) = m2 - call beams (roots, m(1), m(2), p(:,1), p(:,2)) - call massive_decay (roots, m(3:N), p(:,3:N)) - p(:,N+1) = 0 - j(1) = - mj * with_insertion (p, (/ 0, 0, 0, 0, 0, 4 /), (/ 2, 2, 2, 2, 2, 0 /)) - j(2) = vev * with_insertion (p, (/ 0, 0, 0, 0, 0, 0 /), (/ 2, 2, 2, 2, 2, 2 /)) - a(1) = without_insertion (p(:,:), (/ 0, 0, 0, 0, 0 /), (/ 1, 2, 2, 2, 2 /)) - a(2) = without_insertion (p(:,:), (/ 0, 0, 0, 0, 0 /), (/ 2, 1, 2, 2, 2 /)) - a(3) = without_insertion (p(:,:), (/ 0, 0, 0, 0, 0 /), (/ 2, 2, 1, 2, 2 /)) - a(4) = without_insertion (p(:,:), (/ 0, 0, 0, 0, 0 /), (/ 2, 2, 2, 1, 2 /)) - a(5) = without_insertion (p(:,:), (/ 0, 0, 0, 0, 0 /), (/ 2, 2, 2, 2, 1 /)) - forall (i = 1:N) - a(i) = g2 (p(:,i), m1) / g2 (p(:,i), m2) * a(i) - end forall -! print *, ' A=', cmplx (sum (a)), 'J=', cmplx (sum (j)) - print *, 'A/J=', sum (a) / (sum (j)) - 1 -contains - pure function without_insertion (k, s, f) result (amp) - use j20, only: amplitude, symmetry - real(kind=default), dimension(0:,:), intent(in) :: k - integer, dimension(:), intent(in) :: s, f - complex(kind=default) :: amp - amp = symmetry (f) * amplitude (k, s, f) - end function without_insertion - pure function with_insertion (k, s, f) result (amp) - use j21, only: amplitude, symmetry - real(kind=default), dimension(0:,:), intent(in) :: k - integer, dimension(:), intent(in) :: s, f - complex(kind=default) :: amp - amp = symmetry (f) * amplitude (k, s, f) - end function with_insertion - pure function g2 (p, m) result (g) - real(kind=default) :: g - real(kind=default), dimension(0:), intent(in) :: p - real(kind=default), intent(in) :: m - real(kind=default) :: p2 - p2 = dot (p, p) - g = 1 / (p2 - m*m) - end function g2 -end program f90_O2_test Index: branches/ohl/omega-development/completed/whizard2/extensions/people/jr/f90_SAGT_test.f95 =================================================================== --- branches/ohl/omega-development/completed/whizard2/extensions/people/jr/f90_SAGT_test.f95 (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/extensions/people/jr/f90_SAGT_test.f95 (revision 8703) @@ -1,142 +0,0 @@ -program f90_SAGT_test - use omega95_bispinors - use omega_parameters - use kinematics - use rambo - use tao_random_numbers - implicit none - integer, parameter :: N = 4 - real(kind=default), save :: roots = 100, nada = 0 - real(kind=default), dimension(N+1) :: m - real(kind=default), dimension(0:3,N+1) :: p - real(kind=default) :: rel - complex(kind=default) :: j1, j2, j3, j4, j5, j6, res - ! complex(kind=default) :: j1, j2, j3 - integer :: seed, pol - read *, seed, roots !, pol - call tao_random_seed (seed) - call setup_parameters () - ! call print_parameters () - call tao_random_number (m) - m = 0.2 * roots * m - !m(1:) = nada - ! p(:,1) = (/ roots, sqrt(roots**2 - m**2) , nada, nada /) - ! p(:,2) = - p (:,1) - call beams (roots, m(1), m(2), p(:,1), p(:,2)) - call massive_decay (roots, m(3:), p(:,3:)) - !p(:,3) = (/ roots, nada, nada, nada /) - !p(:,4) = (/ nada, nada, nada, nada /) -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - j1 = contact1 (p, (/ 1, 1, 0, 0, 0 /), (/ 1003, 3, 1, 1, (-6) /)) - j2 = contact2 (p, (/ 1, 1, 0, 0, 0 /), (/ 3, 1003, 1, 1, (-6) /)) - j3 = contact3 (p, (/ 1, 1, 0, 0, 0 /), (/ 3, 3, 1001, 1, (-6) /)) - j4 = contact4 (p, (/ 1, 1, 0, 0, 0 /), (/ 3, 3, 1, 1001, (-6) /)) - j5 = currenta (p, (/ 1, 1, 0, 0, 3 /), (/ 3, 3, 1, 1, 4 /)) - rel = (abs(j1)+abs(j2)+abs(j3)+abs(j4)+abs(j5))/5.0_default - res = (j1 + j2 + j3 + j4 + j5)/rel - print *, j1, abs(j1) - print *, j2, abs(j2) - print *, j3, abs(j3) - print *, j4, abs(j4) - print *, j5, abs(j5) - print *, res - !print *, (-j1 + j2 + j3 + j4 + j5)/rel - !print *, ( j1 - j2 + j3 + j4 + j5)/rel - !print *, ( j1 + j2 - j3 + j4 + j5)/rel - !print *, ( j1 + j2 + j3 - j4 + j5)/rel - !print *, ( j1 + j2 + j3 + j4 - j5)/rel - !print *, (j1 - j2 - j3 + j4 + j5)/rel - !print *, (j1 - j2 + j3 - j4 + j5)/rel - !print *, (j1 - j2 + j3 + j4 - j5)/rel - !print *, (j1 + j2 - j3 - j4 + j5)/rel - !print *, (j1 + j2 - j3 + j4 - j5)/rel - !print *, (j1 + j2 + j3 - j4 - j5)/rel -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! j1 = contact1 (p, (/ 0, 0, 1, pol /), (/ 1005, 1, 2, 7 /)) -! j2 = contact2 (p, (/ 0, 0, 1, pol /), (/ 5, 1001, 2, 7 /)) -! j3 = contact3 (p, (/ 0, 0, 1, pol /), (/ 5, 1, 1002, 7 /)) -!! j4 = contact4 (p, (/ 1, 1, 1, 1, 0, 1, 0 /), (/ 3, 5, 3, 3, 1001, 4, (-6) /)) -!! j5 = contact5 (p, (/ 1, 1, 1, 1, 0, 1, 3 /), (/ 3, 5, 3, 3, 1, 4, 4 /)) -! print *, "brs(p)f->axi", j1, abs(j1) -! print *, "pbrs(f)->axi", j2, abs(j2) -! print *, "pf->brs(a)xi", j3, abs(j3) -!! print *, "aa->abrs(a)cbar", j4, abs(j4) -!! print *, "aa->aap", j5, abs(j5) -!! print *, "ff->fbrs(f)ppcbar", j4, abs(j4) -!! print *, "ff->ffppp", j5, abs(j5) -!! rel = (abs(j1)+abs(j2)+abs(j3)+abs(j4)+abs(j5))/5.0_default -! rel = (abs(j1)+abs(j2)+abs(j3))/3.0_default -! res = abs(-j1 + j2 + j3) -!! res = abs(j1 + j2 + j3 + j4 + j5)/rel -! print *, res -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !j1 = contact1 (p, (/ 1, 0, 1 /), (/ 1003, 6, 3 /)) - !j2 = contact2 (p, (/ 1, 0, 1 /), (/ 3, 6, 1003 /)) - !j3 = currenta (p, (/ 1, 3, 1 /), (/ 3, 4, 3 /)) - !rel = (abs(j1)+abs(j2)+abs(j3))/3.0_default - !res = abs(j1 + j2 + j3)/rel - !print *, j1 - !print *, j2 - !print *, j3 - !print *, res - !print *, abs(-j1 + j2 + j3)/rel - !print *, abs( j1 - j2 + j3)/rel - !print *, abs( j1 + j2 - j3)/rel -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -contains - pure function contact1 (k, s, f) result (amp) - use amp1, only: amplitude, symmetry - real(kind=default), dimension(0:,:), intent(in) :: k - integer, dimension(:), intent(in) :: s, f - complex(kind=default) :: amp - amp = symmetry (f) * amplitude (k, s, f) - end function contact1 - pure function contact2 (k, s, f) result (amp) - use amp2, only: amplitude, symmetry - real(kind=default), dimension(0:,:), intent(in) :: k - integer, dimension(:), intent(in) :: s, f - complex(kind=default) :: amp - amp = symmetry (f) * amplitude (k, s, f) - end function contact2 - pure function contact3 (k, s, f) result (amp) - use amp3, only: amplitude, symmetry - real(kind=default), dimension(0:,:), intent(in) :: k - integer, dimension(:), intent(in) :: s, f - complex(kind=default) :: amp - amp = symmetry (f) * amplitude (k, s, f) - end function contact3 - pure function contact4 (k, s, f) result (amp) - use amp4, only: amplitude, symmetry - real(kind=default), dimension(0:,:), intent(in) :: k - integer, dimension(:), intent(in) :: s, f - complex(kind=default) :: amp - amp = symmetry (f) * amplitude (k, s, f) - end function contact4 -! pure function contact5 (k, s, f) result (amp) -! use amp5, only: amplitude, symmetry -! real(kind=default), dimension(0:,:), intent(in) :: k -! integer, dimension(:), intent(in) :: s, f -! complex(kind=default) :: amp -! amp = symmetry (f) * amplitude (k, s, f) -! end function contact5 - !pure function contact6 (k, s, f) result (amp) - ! use amp6, only: amplitude, symmetry - ! real(kind=default), dimension(0:,:), intent(in) :: k - ! integer, dimension(:), intent(in) :: s, f - ! complex(kind=default) :: amp - ! amp = symmetry (f) * amplitude (k, s, f) - !end function contact6 - pure function currenta (k, s, f) result (amp) - use amp5, only: amplitude, symmetry - real(kind=default), dimension(0:,:), intent(in) :: k - integer, dimension(:), intent(in) :: s, f - complex(kind=default) :: amp - amp = symmetry (f) * amplitude (k, s, f) - end function currenta -end program f90_SAGT_test - - Index: branches/ohl/omega-development/completed/whizard2/extensions/people/jr/f90_SQED.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/extensions/people/jr/f90_SQED.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/extensions/people/jr/f90_SQED.ml (revision 8703) @@ -1,382 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -let rcs_file = RCS.parse "f90_SQED" ["SQED-1 gen"] - { RCS.revision = "$Revision$"; - RCS.date = "$Date$"; - RCS.author = "$Author$"; - RCS.source - = "$Source: /home/sources/ohl/ml/omega/extensions/people/jr/f90_SQED.ml,v $" } - -module SQED = - struct - let rcs = rcs_file - open Coupling - let options = Options.empty - -(* Originally [LOp] has been a local operator to generate the insertion - of the derivative of the Faddeev-Popov ghost. This unaesthetic construction - can be avoided either by using physical polarization vectors for the - gauge bosons in which case this term cancels out (as was the case for - the gauge identities) or by absorbing the contribution of this term - coupled to the ghost-ghost-gaugino vertex into the external wavefunction - of [BRST Photon]. -*) - - type flavor = - | Elec | Pos | Ph | Phino - | SelecL | SelecR | SposL | SposR - | C | Cbar | Xi (*i | LOp i*) - | BRST of flavor - - let rec conjugate = function - | Elec -> Pos | Pos -> Elec | Ph -> Ph | Phino -> Phino - | SelecL -> SposL | SposL -> SelecL - | SelecR -> SposR | SposR -> SelecR - | Cbar -> C | C -> Cbar | Xi -> Xi (*i | LOp -> LOp i*) - | BRST f -> BRST (conjugate f) - - - let external_flavors () = - [ "fields", [Elec; Pos; SelecL; SposL; SelecR; SposR; Ph; Phino]; - "ghosts", [C; Cbar; Xi]; - "BRST transformations (ghost sources)", [BRST Elec; BRST Pos; - BRST SelecL; BRST SposL; BRST SelecR; BRST SposR; BRST Ph; - BRST Phino]] -(*i "Local Operator", [LOp]] i*) - - let flavors () = ThoList.flatmap snd (external_flavors ()) - - let flavor_of_string = function - | "e-" -> Elec | "e+" -> Pos - | "sel-" -> SelecL | "sel+" -> SposL - | "ser-" -> SelecR | "ser+" -> SposR - | "ph" -> Ph | "phino" -> Phino - | "c" -> C | "cbar" -> Cbar | "xi" -> Xi - | "brs_e-" -> BRST Elec | "brs_e+" -> BRST Pos - | "brs_sel-" -> BRST SelecL | "brs_sel+" -> BRST SposL - | "brs_ser-" -> BRST SelecR | "brs_ser+" -> BRST SposR - | "brs_ph" -> BRST Ph | "brs_phino" -> BRST Phino -(*i | "lop" -> LOp i*) - | _ -> invalid_arg "SQED.flavor_of_string" - - let rec flavor_to_string = function - | Elec -> "e-" | Pos -> "e+" - | SelecL -> "sel-" | SposL -> "sel+" - | SelecR -> "ser-" | SposR -> "ser+" - | Ph -> "ph" | Phino -> "phino" - | C -> "c" | Cbar -> "cbar" | Xi -> "xi" -(*i | LOp -> "lop" i*) - | BRST f -> "brs_" ^ flavor_to_string f - - let rec flavor_symbol = function - | Elec -> "ele" | Pos -> "pos" - | SelecL -> "sel" | SposL -> "spl" - | SelecR -> "ser" | SposR -> "spr" - | Ph -> "ph" | Phino -> "phino" - | C -> "c" | Cbar -> "cbar" | Xi -> "xi" -(*i | LOp -> "lop" i*) - | BRST f -> "brs_" ^ flavor_symbol f - - let rec lorentz = function - | SelecL | SposL | SelecR | SposR | C | Cbar -> Scalar -(*i | LOp -> Scalar i*) - | Elec -> Spinor | Pos -> ConjSpinor - | Phino -> Majorana - | Xi -> Maj_Ghost - | Ph -> Vector - | BRST f -> BRS (lorentz f) - - let propagator = function - | SelecL | SposL | SelecR | SposR -> Prop_Scalar - | Elec -> Prop_Spinor | Pos -> Prop_ConjSpinor - | C | Cbar -> Prop_Ghost - | Ph -> Prop_Feynman - | Phino -> Prop_Majorana -(*i | LOp -> Only_Insertion i*) - | Xi | BRST _ -> Only_Insertion - - let width _ = Timelike - let goldstone _ = None - - let fermion = function - | SelecL | SposL | SelecR | SposR | Ph | C | Cbar - | BRST SelecL | BRST SposL | BRST SelecR - | BRST SposR | BRST Ph -> 0 -(*i | LOp -> 0 i*) - | Elec | BRST Elec -> 1 - | Pos | BRST Pos -> -1 - | Phino | Xi | BRST Phino -> 2 - | BRST _ -> 42 - - let color _ = Color.Singlet - type gauge = unit - let gauge_symbol () = failwith "SQED.gauge_symbol: internal error" - - let colsymm _ = (0,false),(0,false) - -(* Symbols [MM], [WM] for the matter fields, [MG], [WG] for the gauge - fields. *) - - type constant = - | Unity | Im | Null | E | EC | I_E | E2 | ESQ | ISQ | ISQE - | M | MM | MG | MXI | MC - | WM | WG | WC - | G_MOMA | G_MOMB | G_L | G_S2 - let constant_symbol = function - | Unity -> "unity" | Im -> "im" | Null -> "null" | M -> "mass" - | E -> "e" | EC -> "ec" | I_E -> "ie" | E2 -> "e2" - | ESQ -> "esq" | ISQ -> "isq" | ISQE -> "isqe" - | MM -> "me" | MG -> "mp" | MXI -> "mxi" | MC -> "mc" - | WM -> "we" | WG -> "wp" | WC -> "wc" - | G_MOMA -> "gmoma" | G_MOMB -> "gmomb" - | G_L -> "gl" | G_S2 -> "gs2" - -(* Compare the definitions in the [Coupling.mli]-module: The momenta there - are defined as outgoing. From this the sign must be (-1) for the - selectron-spositron-photon vertices. *) - - let vertices () = - ([(Ph, SelecL, SposL), Vector_Scalar_Scalar (-1), EC; - (Ph, SelecR, SposR), Vector_Scalar_Scalar (-1), EC; - (Pos, Ph, Elec), FBF (1, Psibar, V, Psi), EC; -(* Is the sign of [SelecL] compared to [SelecR] fixed (just by gauge - invariance, without the use of supersymmetry? *) - (Pos, SelecL, Phino), FBF ((-1), Psibar, SR, Chi), ESQ; - (Phino, SposL, Elec), FBF ((-1), Chibar, SL, Psi), ESQ; - (Phino, SposR, Elec), FBF (1, Chibar, SR, Psi), ESQ; - (Pos, SelecR, Phino), FBF (1, Psibar, SL, Chi), ESQ; -(* Alternative signs. *) -(* (Pos, SelecL, Phino), FBF (1, Psibar, SR, Chi), ESQ; - (Phino, SposL, Elec), FBF (1, Chibar, SL, Psi), ESQ; - (Phino, SposR, Elec), FBF ((-1), Chibar, SR, Psi), ESQ; - (Pos, SelecR, Phino), FBF ((-1), Psibar, SL, Chi), ESQ; *) -(* *) - (BRST SposL, C, SelecL), Scalar_Scalar_Scalar 1, EC; - (BRST SposR, C, SelecR), Scalar_Scalar_Scalar 1, EC; - (BRST SelecL, C, SposL), Scalar_Scalar_Scalar (-1), EC; - (BRST SelecR, C, SposR), Scalar_Scalar_Scalar (-1), EC; -(* These are the signs suitable for the gauge STIs. - (BRST Pos, C, Elec), FBF (1, Psibar, S, Psi), EC; - (Pos, C, BRST Elec), FBF ((-1), Psibar, S, Psi), EC; *) - (BRST Pos, C, Elec), FBF ((-1), Psibar, S, Psi), EC; - (Pos, C, BRST Elec), FBF (1, Psibar, S, Psi), EC; -(*i (BRST Ph, C, LOp), Vector_Scalar_Scalar 1, Unity; i*) - (Xi, BRST SposL, Elec), FBF (1, Chibar, SL, Psi), ISQ; - (Pos, BRST SelecL, Xi), FBF ((-1), Psibar, SR, Chi), ISQ; - (Xi, BRST SposR, Elec), FBF (1, Chibar, SR, Psi), ISQ; - (Pos, BRST SelecR, Xi), FBF ((-1), Psibar, SL, Chi), ISQ; -(* Checked until here. *) -(* This is a first guess. Note that we have to switch the direction of the - spinor structure for the terms containing [BRST Elec]. *) - (BRST Pos, SelecL, Xi), GBG (1, Psibar, MOMR, Chi), G_MOMA; - (BRST Pos, SelecR, Xi), GBG ((-1), Psibar, MOML, Chi), G_MOMA; - (Xi, SposL, BRST Elec), GBG (1, Chibar, LMOM, Chi), G_MOMA; - (Xi, SposR, BRST Elec), GBG ((-1), Chibar, RMOM, Chi), G_MOMA; - (BRST Phino, Ph, Xi), GBG (1, Chibar, VMOM, Chi), G_L; - (Phino, BRST Ph, Xi), FBF (1, Chibar, V, Chi), Im; - (Phino, Cbar, Xi), GBG ((-1), Chibar, MOM, Chi), G_MOMB], - (* (Phino, Cbar, Xi), GBG (1, Chibar, MOM, Chi), G_MOMB], *) - [(SelecL, SposL, SelecL, SelecR), Scalar4 (-2), E2; - (SelecL, SposL, SelecL, SelecR), Scalar4 (-2), E2; - (SelecL, SposL, SelecL, SelecR), Scalar4 1, E2; - (SelecL, SposL, Ph, Ph), Scalar2_Vector2 2, E2; - (SelecR, SposR, Ph, Ph), Scalar2_Vector2 2, E2; - (BRST Pos, SelecL, Ph, Xi), GBBG ((-1), Psibar, SRV, Chi), ISQE; - (BRST Pos, SelecR, Ph, Xi), GBBG (1, Psibar, SLV, Chi), ISQE; - (Xi, SposL, Ph, BRST Elec), GBBG (1, Chibar, SRV, Psi), ISQE; - (Xi, SposR, Ph, BRST Elec), GBBG ((-1), Chibar, SLV, Psi), ISQE; - (BRST Phino, SelecL, SposL, Xi), GBBG (1, Chibar, S2, Chi), G_S2; - (BRST Phino, SelecR, SposR, Xi), GBBG (1, Chibar, S2, Chi), G_S2], - []) - - let parameters () = - { input = [E, 0.1; M, 10.00]; - derived = - [ Complex Unity, Const 1; - Complex Null, Const 0; - Real MM, Atom M; Real MG, Const 0; Real MXI, Const 0; - Real MC, Const 0; - Real WM, Const 0; Real WG, Const 0; Real WC, Const 0; - Complex EC, Atom E; - Complex E2, Prod [Atom E; Atom E]; - Complex ESQ, Quot (Atom E, Sqrt(Const 2)); - Complex ISQ, Quot (I, Sqrt(Const 2)); - Complex ISQE, Quot (Prod [I; Atom E], Sqrt(Const 2)); - Complex I_E, Prod [I; Atom E]; - Complex Im, I; - Complex G_L, Quot (I, Const 2); - Complex G_S2, Neg (Prod [I; Atom E])]; - derived_arrays = [Complex_Array G_MOMA, [Atom ISQ; - Prod[Neg (Atom ISQ); Atom M]]; - Complex_Array G_MOMB, [Const 1; Const 0]]} - - -(* Since the functions for the chiral couplings in omega_(bi)spinor_couplings - are defined as $1 \pm \gamma^5$ instead of $(1 \pm \gamma^5)/2$ we have - to divide by two. *) - - module F = Models.Fusions (struct - type f = flavor - type c = constant - let compare = compare - let conjugate = conjugate - end) - let table = F.of_vertices (vertices ()) - let fuse2 = F.fuse2 table - let fuse3 = F.fuse3 table - let fuse = F.fuse table - let max_degree () = 3 - - let pdg = function - | Elec -> 1 | Pos -> -1 | SelecL -> 2 | SposL -> -2 - | SelecR -> 3 | SposR -> -3 | Ph -> 4 | Phino -> 5 - | C -> 6 | Cbar -> -6 | Xi -> 7 - | BRST Elec -> 1001 | BRST Pos -> -1001 - | BRST SelecL -> 1002 | BRST SposL -> -1002 - | BRST SelecR -> 1003 | BRST SposR -> -10033 - | BRST Ph -> 1004 | BRST Phino -> 1005 - | BRST C -> 1006 | BRST Cbar -> -1006 -(*i | LOp -> 42 i*) - | BRST _ -> 1234567 - let mass_symbol = function - | Elec | Pos | BRST Elec | BRST Pos -> "me" - | SelecL | SposL | BRST SelecL | BRST SposL -> "me" - | SelecR | SposR | BRST SelecR | BRST SposR -> "me" - | Ph | BRST Ph -> "mp" - | C | Cbar -> "mc" | Xi -> "mxi" (*i | LOp -> "mlop" i*) - | Phino | BRST Phino -> "mp" | BRST _ -> "" - let width_symbol = function - | Elec | Pos | BRST Elec | BRST Pos -> "we" - | SelecL | SposL | BRST SelecL | BRST SposL -> "we" - | SelecR | SposR | BRST SelecR | BRST SposR -> "we" - | Ph | BRST Ph -> "wp" - | C | Cbar -> "wc" | Xi -> "wxi" (*i | LOp -> "wlop" i*) - | Phino | BRST Phino -> "wp" | BRST _ -> "" - end - -module Main = Omega.Make(Fusion.Mixed23_Majorana) - (Targets.Fortran_Majorana)(SQED) -let _ = Main.main () - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Index: branches/ohl/omega-development/completed/whizard2/extensions/people/jr/Makefile.in =================================================================== Index: branches/ohl/omega-development/completed/whizard2/extensions/people/jr/f90_SAGT.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/extensions/people/jr/f90_SAGT.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/extensions/people/jr/f90_SAGT.ml (revision 8703) @@ -1,1270 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -let rcs_file = RCS.parse "f90_SAGT" ["U(1) SUSY"] - { RCS.revision = "$Revision$"; - RCS.date = "$Date$"; - RCS.author = "$Author$"; - RCS.source - = "$Source: /home/sources/ohl/ml/omega/extensions/people/jr/f90_SAGT.ml,v $" } - -(* \subsection*{Lagrangian} *) - -(* Simplest model available: - \begin{equation} - \dfrac{1}{2} \begin{bmatrix} \hat{\Phi}^\dagger \exp(\mathcal{-V}) - \hat{\Phi} \end{bmatrix}_D + \dfrac{1}{2} \Re \begin{bmatrix} - \overline{W_R} W_L \end{bmatrix}_F - \end{equation} - We discuss a SUSY-model with $U(1)$ gauge group - and only one superfield. Here the fermion is a Majorana-fermion and gets - a chiral charge, so this model is not SQED, the supersymmetric extension of - QED. All particles are forced by gauge invariance to be massless. *) - -module SAGT = - struct - let rcs = rcs_file - open Coupling - let options = Options.empty - - type flavor = - | A | B | F | Ph | Phino | J - | C | Cbar | Xi | LOp - | BRST of flavor - -(* All particles are self-charge-conjugate. *) - - let rec conjugate = function - | C -> Cbar - | Cbar -> C - | f -> f - - - let external_flavors () = - [ "fields", [A; B; F; Ph; Phino]; - "ghosts", [C; Cbar; Xi]; - "BRST transformations (ghost sources)", [BRST A; BRST B; - BRST F; BRST Ph; BRST Phino]; - "Local Operator", [LOp]; - "currents", [J] ] - - let flavors () = ThoList.flatmap snd (external_flavors ()) - - let flavor_of_string = function - | "a" -> A | "b" -> B - | "ph" -> Ph | "phino" -> Phino | "f" -> F - | "c" -> C | "cbar" -> Cbar | "xi" -> Xi - | "brs_a" -> BRST A | "brs_b" -> BRST B | "brs_f" -> BRST F - | "brs_ph" -> BRST Ph | "brs_phino" -> BRST Phino - | "j" -> J | "lop" -> LOp - | _ -> invalid_arg "SAGT.flavor_of_string" - - let rec flavor_to_string = function - | A -> "a" | B -> "b" | F -> "f" - | Ph -> "ph" | Phino -> "phino" - | C -> "c" | Cbar -> "cbar" | Xi -> "xi" - | J -> "j" | LOp -> "lop" - | BRST f -> "brs_" ^ flavor_to_string f - - let rec flavor_symbol = function - | A -> "a" | B -> "b" | F -> "f" - | Ph -> "ph" | Phino -> "phino" - | C -> "c" | Cbar -> "cbar" | Xi -> "xi" - | J -> "j" | LOp -> "lop" - | BRST f -> "brs_" ^ flavor_symbol f - - let rec lorentz = function - | A | B | C | Cbar | LOp -> Scalar - | F | Phino -> Majorana - | Xi -> Maj_Ghost - | Ph -> Vector - | J -> Vectorspinor - | BRST f -> BRS (lorentz f) - - let propagator = function - | A | B -> Prop_Scalar - | C | Cbar -> Prop_Ghost - | Ph -> Prop_Feynman - | F | Phino -> Prop_Majorana - | J | Xi | LOp | BRST _ -> Only_Insertion - - let width _ = Timelike - let goldstone _ = None - - let fermion = function - | A | B | Ph | C | Cbar | BRST A | BRST B | BRST Ph | LOp -> 0 - | F | Phino | J | Xi | BRST F | BRST Phino -> 2 - | BRST _ -> 42 - - let color _ = Color.Singlet - type gauge = unit - let gauge_symbol () = failwith "SAGT.gauge_symbol: internal error" - - let colsymm _ = (0,false),(0,false) - -(* \begin{multline} - \mathcal{L} = \dfrac{1}{2} (\partial_\mu A) (\partial^\mu A) + - \dfrac{1}{2} (\partial_\mu B) (\partial^\mu B) + \dfrac{\ii}{2} - \overline{\Psi} \fmslash{\partial} \Psi - \dfrac{1}{4} F_{\mu\nu} - F^{\mu\nu} + \dfrac{\ii}{2} \overline{\lambda} \fmslash{\partial} - \lambda \\ - + e G_\mu \left( B \partial^\mu A - A \partial^\mu B - \right) + \dfrac{e^2}{2} G_\mu G^\mu \left( A^2 + B^2 \right) - e - \left( \overline{\Psi} \lambda \right) A \\ - - \ii e \left( \overline{\Psi} \gamma^5 \lambda \right) B - - \dfrac{e}{2} \overline{\Psi} \fmslash{G} \gamma^5 \Psi - \dfrac{e^2}{8} - \left( A^4 + B^4 + 2 A^2 B^2 \right) - \end{multline} - Propagators - \begin{subequations} - \begin{align} - \parbox{21mm}{% - \begin{fmfgraph*}(20,5) - \fmfleft{i}\fmfright{o} - \fmflabel{$A(p)$}{i} - \fmflabel{$A(p)$}{o} - \fmf{dashes}{i,o} - \fmfdot{i,o} - \end{fmfgraph*}}\qquad\quad - &= \frac{\mathrm{i}}{p^2+\mathrm{i}\epsilon} \\ - \parbox{21mm}{% - \begin{fmfgraph*}(20,5) - \fmfleft{i}\fmfright{o} - \fmflabel{$B(p)$}{i} - \fmflabel{$B(p)$}{o} - \fmf{dbl_dashes}{i,o} - \fmfdot{i,o} - \end{fmfgraph*}}\qquad\quad - &= \frac{\mathrm{i}}{p^2+\mathrm{i}\epsilon} \\ - \parbox{21mm}{% - \begin{fmfgraph*}(20,5) - \fmfleft{i}\fmfright{o} - \fmflabel{$G_\mu(p)$}{i} - \fmflabel{$G_\nu(p)$}{o} - \fmf{photon}{i,o} - \fmfdot{i,o} - \end{fmfgraph*}}\qquad\quad - &= \frac{- \mathrm{i} \eta_{\mu\nu}}{p^2+\mathrm{i}\epsilon} \\ - \parbox{21mm}{% - \begin{fmfgraph*}(20,5) - \fmfleft{i}\fmfright{o} - \fmflabel{$\Psi(p)$}{i} - \fmflabel{$\overline{\Psi}(p)$}{o} - \fmf{plain}{i,o} - \fmfdot{i,o} - \end{fmfgraph*}}\qquad\quad - &= \frac{\mathrm{i} \fmslash{p}}{p^2+\mathrm{i}\epsilon} \\ - \parbox{21mm}{% - \begin{fmfgraph*}(20,5) - \fmfleft{i}\fmfright{o} - \fmflabel{$\lambda(p)$}{i} - \fmflabel{$\overline{\lambda}(p)$}{o} - \fmf{plain}{i,o} \fmf{photon,wiggly_len=1mm}{i,o} - \fmfdot{i,o} - \end{fmfgraph*}}\qquad\quad - &= \frac{\mathrm{i} \fmslash{p}}{p^2+\mathrm{i}\epsilon} - \end{align} - \end{subequations} - Three point vertices (all momenta incoming) - \begin{subequations} - \begin{align} - \parbox{21mm}{% - \hfil\\\hfil\\ - \begin{fmfgraph*}(20,15) - \fmfleft{p1}\fmfright{p2,p3} - \fmflabel{$G_\mu(p_1)$}{p1} - \fmflabel{$B(p_3)$}{p2} - \fmflabel{$A(p_2)$}{p3} - \fmf{photon}{p1,v} - \fmf{dashes}{p3,v} \fmf{dbl_dashes}{p2,v} - \fmfdot{v} - \end{fmfgraph*}\\ - \hfil}\qquad\quad - &= e (p_2 - p_3)_\mu \\ - \parbox{21mm}{% - \hfil\\\hfil\\ - \begin{fmfgraph*}(20,15) - \fmfleft{p1}\fmfright{p2,p3} - \fmflabel{$G_\mu(p_1)$}{p1} - \fmflabel{$\Psi(p_3)$}{p2} - \fmflabel{$\Psi(p_2)$}{p3} - \fmf{photon}{p1,v} - \fmf{plain}{p2,v,p3} - \fmfdot{v} - \end{fmfgraph*}\\ - \hfil}\qquad\quad - &= \ii e \gamma^5 \gamma_\mu \\ - \parbox{21mm}{% - \hfil\\\hfil\\ - \begin{fmfgraph*}(20,15) - \fmfleft{p1}\fmfright{p2,p3} - \fmflabel{$A(p_1)$}{p1} - \fmflabel{$\lambda(p_3)$}{p2} - \fmflabel{$\Psi(p_2)$}{p3} - \fmf{dashes}{p1,v} - \fmf{plain}{p2,v,p3} \fmffreeze - \fmf{photon}{v,p2} - \fmfdot{v} - \end{fmfgraph*}\\ - \hfil}\qquad\quad - &= - \ii e \\ - \parbox{21mm}{% - \hfil\\\hfil\\ - \begin{fmfgraph*}(20,15) - \fmfleft{p1}\fmfright{p2,p3} - \fmflabel{$B(p_1)$}{p1} - \fmflabel{$\lambda(p_3)$}{p2} - \fmflabel{$\Psi(p_2)$}{p3} - \fmf{dbl_dashes}{p1,v} - \fmf{plain}{p2,v,p3} \fmffreeze - \fmf{photon}{v,p2} - \fmfdot{v} - \end{fmfgraph*}\\ - \hfil}\qquad\quad - &= e \gamma^5 - \end{align} - \end{subequations} - Four point vertices - \begin{subequations} - \begin{align} - \parbox{21mm}{% - \hfil\\\hfil\\ - \begin{fmfgraph*}(20,15) - \fmfleft{p1,p2}\fmfright{p3,p4} - \fmflabel{$A(p_1)$}{p1} - \fmflabel{$A(p_2)$}{p2} - \fmflabel{$A(p_3)$}{p3} - \fmflabel{$A(p_4)$}{p4} - \fmf{dashes}{p1,v,p2} - \fmf{dashes}{p3,v,p4} - \fmfdot{v} - \end{fmfgraph*}\\ - \hfil}\qquad\quad - &= - 3 \ii e^2 \\ - \parbox{21mm}{% - \hfil\\\hfil\\ - \begin{fmfgraph*}(20,15) - \fmfleft{p1,p2}\fmfright{p3,p4} - \fmflabel{$B(p_1)$}{p1} - \fmflabel{$B(p_2)$}{p2} - \fmflabel{$B(p_3)$}{p3} - \fmflabel{$B(p_4)$}{p4} - \fmf{dbl_dashes}{p1,v,p2} - \fmf{dbl_dashes}{p3,v,p4} - \fmfdot{v} - \end{fmfgraph*}\\ - \hfil}\qquad\quad - &= - 3 \ii e^2 \\ - \parbox{21mm}{% - \hfil\\\hfil\\ - \begin{fmfgraph*}(20,15) - \fmfleft{p1,p2}\fmfright{p3,p4} - \fmflabel{$A(p_1)$}{p1} - \fmflabel{$A(p_2)$}{p2} - \fmflabel{$B(p_3)$}{p3} - \fmflabel{$B(p_4)$}{p4} - \fmf{dashes}{p1,v,p2} - \fmf{dbl_dashes}{p3,v,p4} - \fmfdot{v} - \end{fmfgraph*}\\ - \hfil}\qquad\quad - &= - \ii e^2 \\ - \parbox{21mm}{% - \hfil\\\hfil\\ - \begin{fmfgraph*}(20,15) - \fmfleft{p1,p2}\fmfright{p3,p4} - \fmflabel{$A(p_1)$}{p1} - \fmflabel{$A(p_2)$}{p2} - \fmflabel{$G_\mu(p_3)$}{p3} - \fmflabel{$G_\nu(p_4)$}{p4} - \fmf{dashes}{p1,v,p2} - \fmf{photon}{p3,v,p4} - \fmfdot{v} - \end{fmfgraph*}\\ - \hfil}\qquad\quad - &= 2 \ii e^2 \eta_{\mu\nu} \\ - \parbox{21mm}{% - \hfil\\\hfil\\ - \begin{fmfgraph*}(20,15) - \fmfleft{p1,p2}\fmfright{p3,p4} - \fmflabel{$B(p_1)$}{p1} - \fmflabel{$B(p_2)$}{p2} - \fmflabel{$G_\mu(p_3)$}{p3} - \fmflabel{$G_\nu(p_4)$}{p4} - \fmf{dbl_dashes}{p1,v,p2} - \fmf{photon}{p3,v,p4} - \fmfdot{v} - \end{fmfgraph*}\\ - \hfil}\qquad\quad - &= 2 \ii e^2 \eta_{\mu\nu} - \end{align} - \end{subequations} *) - -(* \subsection*{Conserved Current} *) - -(* \begin{multline} - \mathcal{L}\lbrack J_{3/2} \rbrack = - J_{3/2}^\mu \biggl\{ - (\fmslash{\partial} A) \gamma_\mu \Psi - - (\ii\fmslash{\partial} B) \gamma_\mu \gamma^5 \Psi + \ii e A \fmslash{G} - \gamma_\mu \gamma^5 \Psi - e B \fmslash{G} \gamma_\mu \Psi \\ + - \dfrac{1}{2} \lbrack \gamma^\alpha , \gamma^\beta \rbrack \gamma_\mu - \gamma^5 (\partial_\alpha G_\beta) \lambda - \dfrac{\ii e}{2} - \left( A^2 + B^2 \right) \gamma_\mu \lambda \biggr\} - \end{multline} *) - - type constant = - | Unity | Im | Null | E | EC | I_E | E2 - | MA | MB | MP | MPINO | MF | MJ | MXI | MC - | WA | WB | WP | WPINO | WF | WJ | WC - | G_MOMA | G_MOMB | G_L | G_S2 - let constant_symbol = function - | Unity -> "unity" | Im -> "im" | Null -> "null" - | E -> "e" | EC -> "ec" | I_E -> "ie" | E2 -> "e2" - | MA -> "ma" | MB -> "mb" | MP -> "mp" | MXI -> "mxi" | MC -> "mc" - | MPINO -> "mpino" | MF -> "mf" | MJ -> "mj" - | WA -> "wa" | WB -> "wb" | WP -> "wp" | WC -> "wc" - | WPINO -> "wpino" | WF -> "wf" | WJ -> "wj" - | G_MOMA -> "gmoma" | G_MOMB -> "gmomb" - | G_L -> "gl" | G_S2 -> "gs2" - - let vertices () = - ([(Ph, A, B), Vector_Scalar_Scalar 1, I_E; - (F, A, Phino), FBF ((-1), Chibar, S, Chi), EC; - (F, B, Phino), FBF ((-1), Chibar, P, Chi), I_E; - (F, Ph, F), FBF (1, Chibar, Coupling.A, Chi), EC; - (BRST A, C, B), Scalar_Scalar_Scalar 1, I_E; - (BRST B, C, A), Scalar_Scalar_Scalar (-1), I_E; - (BRST F, C, F), FBF ((-1), Chibar, P, Chi), EC; - (Xi, BRST A, F), FBF (1, Chibar, P, Chi), Im; - (F, BRST B, Xi), FBF ((-1), Chibar, S, Chi), Unity; - (BRST F, A, Xi), GBG (1, Chibar, MOM5, Chi), G_MOMA; - (BRST F, B, Xi), GBG (1, Chibar, MOM, Chi), G_MOMB; - (BRST Phino, Ph, Xi), GBG (1, Chibar, VMOM, Chi), G_L; - (BRST Ph, C, LOp), Vector_Scalar_Scalar 1, Unity; - (Phino, BRST Ph, Xi), FBF (1, Chibar, V, Chi), Im; - (Phino, Cbar, Xi), GBG ((-1), Chibar, MOM, Chi), G_MOMB; - (J, A, F), GBG (1, Gravbar, S, Chi), Unity; - (J, B, F), GBG (1, Gravbar, P, Chi), Unity; - (J, Ph, Phino), GBG (1, Gravbar, V, Chi), Unity], - [(A, A, A, A), Scalar4 (-3), E2; - (B, B, B, B), Scalar4 (-3), E2; - (A, A, B, B), Scalar4 (-1), E2; - (A, A, Ph, Ph), Scalar2_Vector2 2, E2; - (B, B, Ph, Ph), Scalar2_Vector2 2, E2; - (BRST F, A, Ph, Xi), GBBG ((-1), Chibar, SV, Chi), I_E; - (BRST F, B, Ph, Xi), GBBG (1, Chibar, PV, Chi), EC; - (BRST Phino, A, A, Xi), GBBG (1, Chibar, S2, Chi), G_S2; - (BRST Phino, B, B, Xi), GBBG (1, Chibar, S2, Chi), G_S2; - (J, A, Ph, F), GBBG (1, Gravbar, SV, Chi), Unity; - (J, B, Ph, F), GBBG (1, Gravbar, PV, Chi), Unity; - (J, A, A, Phino), GBBG (1, Gravbar, S2, Chi), Unity; - (J, B, B, Phino), GBBG (1, Gravbar, S2, Chi), Unity], - []) - - let parameters () = - { input = [E, 0.1; MJ, 0.0; WJ, 0.0]; - derived = - [ Complex Unity, Const 1; - Complex Null, Const 0; - Real MA, Const 0; Real MB, Const 0; Real MPINO, Const 0; - Real MP, Const 0; Real MF, Const 0; Real MXI, Const 0; - Real MC, Const 0; - Real WA, Const 0; Real WB, Const 0; Real WPINO, Const 0; - Real WP, Const 0; Real WF, Const 0; Real WC, Const 0; - Complex EC, Atom E; - Complex E2, Prod [Atom E; Atom E]; - Complex I_E, Prod [I; Atom E]; - Complex Im, I; - Complex G_L, Quot (Neg I, Const 2); - Complex G_S2, Neg (Quot (Prod [I; Atom E], Const 2))]; - derived_arrays = [Complex_Array G_MOMA, [Neg I; Const 0]; - Complex_Array G_MOMB, [Const 1; Const 0]]} - - module F = Models.Fusions (struct - type f = flavor - type c = constant - let compare = compare - let conjugate = conjugate - end) - let table = F.of_vertices (vertices ()) - let fuse2 = F.fuse2 table - let fuse3 = F.fuse3 table - let fuse = F.fuse table - let max_degree () = 3 - - let pdg = function - | A -> 1 | B -> 2 | J -> 0 - | F -> 3 | Ph -> 4 | Phino -> 5 | C -> 6 | Cbar -> -6 | Xi -> 7 - | BRST A -> 1001 | BRST B -> 1002 | BRST F -> 1003 - | BRST Ph -> 1004 | BRST Phino -> 1005 | LOp -> 42 | BRST _ -> 1234567 - let mass_symbol = function - | A | BRST A -> "ma" | B | BRST B -> "mb" | J -> "mj" - | F | BRST F -> "mf" | Ph | BRST Ph -> "mp" - | C | Cbar -> "mc" | Xi -> "mxi" | LOp -> "mlop" - | Phino | BRST Phino -> "mpino" | BRST _ -> "" - let width_symbol = function - | A | BRST A -> "wa" | B | BRST B -> "wb" | J -> "wj" - | F | BRST F -> "wf" | Ph | BRST Ph -> "wp" - | C | Cbar -> "wc" | Xi -> "wxi" | LOp -> "wlop" - | Phino | BRST Phino -> "wpino" | BRST _ -> "" - end - -(* \subsection*{Equations of Motion} *) - -(* Equations of motion - \begin{subequations} - \begin{align} - \Box A &= - 2 e G_\mu \partial^\mu B - e B \partial_\mu G^\mu + - e^2 G_\mu G^\mu A - e \overline{\Psi} \lambda - \dfrac{e^2}{2} \left( - A^3 + A B^2 \right) \\ - \Box B &= 2 e G_\mu \partial^\mu A + e A \partial_\mu G^\mu - + e^2 G_\mu G^\mu B - \ii e \overline{\Psi} \gamma^5 \lambda - - \dfrac{e^2}{2} \left( B^3 + B A^2 \right) \\ - \ii \fmslash{\partial} \Psi &= e A \lambda + \ii e B \gamma^5 \lambda - + e \fmslash{G} \gamma^5 \Psi \\ - \ii \fmslash{\partial} \lambda &= e A \Psi + \ii e B \gamma^5 \Psi \\ - \partial^\nu F_{\nu\mu} &= e \left( A \partial_\mu B - B - \partial_\mu A \right) - e^2 G_\mu \left( A^2 + B^2 \right) + - \dfrac{e}{2} \overline{\Psi} \gamma_\mu \gamma^5 \Psi - \end{align} - \end{subequations} - Noether current - \begin{multline} - \mathcal{J}^\mu = - (\fmslash{\partial} A) \gamma^\mu \Psi - \ii - (\fmslash{\partial} B) \gamma^\mu \gamma^5 \Psi + \ii e A \fmslash{G} - \gamma^\mu \gamma^5 \Psi \\ - e B \fmslash{G} \gamma^\mu \Psi + - \dfrac{1}{2} \lbrack \gamma^\alpha , \gamma^\beta \rbrack \gamma^\mu - \gamma^5 (\partial_\alpha G_\beta) \lambda - \dfrac{\ii e}{2} \left( A^2 - + B^2 \right) \gamma^\mu \lambda - \end{multline} - is conserved explicitely - \begin{equation} - \label{conservedcurrent} - \begin{aligned} - \partial_\mu \mathcal{J}^\mu = & \; - (\Box A) \Psi - (\fmslash{\partial} - A) (\fmslash{\partial} \Psi) - \ii (\Box B) \gamma^5 \Psi + \ii - (\fmslash{\partial} B) \gamma^5 (\fmslash{\partial} \Psi) \\ & \; + \ii e - \gamma^\alpha \gamma^\beta \gamma^5 A (\partial_\beta G_\alpha) \Psi + - \ii e \fmslash{G} (\fmslash{\partial} A) \gamma^5 \Psi - \ii e A - \fmslash{G} \gamma^5 (\fmslash{\partial} \Psi) \\ & \; - e \gamma^\alpha - \gamma^\beta B (\partial_\beta G_\alpha) \Psi - e \fmslash{G} - (\fmslash{\partial} B) \Psi - e B \fmslash{G} (\fmslash{\partial} \Psi) - \\ & \; + \dfrac{1}{2} \gamma^\alpha \gamma^\beta \gamma^\mu \gamma^5 - (\partial_\mu F_{\alpha\beta}) \lambda - \dfrac{1}{2} \gamma^\alpha - \gamma^\beta \gamma^5 F_{\alpha\beta} (\fmslash{\partial} \lambda) - - \ii e A (\fmslash{\partial} A) \lambda \\ & \; - \ii e B - (\fmslash{\partial} B) \lambda - \dfrac{e}{2} \left( A^2 + B^2 \right) - (\ii \fmslash{\partial} \lambda) \; \; = \; \; 0 - \end{aligned} - \end{equation} - We list all the terms separately after inserting several equations of - motion. First term of (\ref{conservedcurrent}): - \begin{multline} - \label{conserv1} - - (\Box A) \Psi = 2 e G_\mu (\partial^\mu B) \Psi + e B (\partial_\mu - G^\mu) \Psi \\ - e^2 G_\mu G^\mu A \Psi + e (\overline{\Psi} \lambda) - \Psi - \dfrac{e^2}{2} \left( A^3 + A B^2 \right) \Psi - \end{multline} - Third term of (\ref{conservedcurrent}): - \begin{multline} - \label{conserv2} - - \ii (\Box B) \gamma^5 \Psi = - 2 \ii e G_\mu (\partial^\mu A) \gamma^5 - \Psi - \ii e A (\partial_\mu G^\mu) \gamma^5 \Psi - \ii e^2 G_\mu - G^\mu B \gamma^5 \Psi \\ - e (\overline{\Psi} \gamma^5 \lambda) \gamma^5 - \Psi + \dfrac{\ii e^2}{2} \left( B^3 + B A^2 \right) \gamma^5 \Psi - \end{multline} - Terms number 2, 6 and 13 of (\ref{conservedcurrent}): - \begin{multline} - \label{conserv3} - - (\fmslash{\partial} A) (\fmslash{\partial} \Psi) + \ii e \fmslash{G} - (\fmslash{\partial} A) \gamma^5 \Psi - \ii e A (\fmslash{\partial} A) - \lambda = - e (\fmslash{\partial} A) B \gamma^5 \lambda + 2 \ii e G_\mu - (\partial^\mu A) \gamma^5 \Psi - \end{multline} - The second term on the rhs cancels the first of rhs (\ref{conserv2}). - Terms number 4, 9 and 14 of (\ref{conservedcurrent}): - \begin{multline} - \label{conserv4} - \ii (\fmslash{\partial} B) \gamma^5 (\fmslash{\partial} \Psi) - e - \fmslash{G} (\fmslash{\partial} B) \Psi - \ii e B (\fmslash{\partial} B) - \lambda = e (\fmslash{\partial} B) A \gamma^5 \lambda - 2 e G_\mu - (\partial^\mu B) \Psi - \end{multline} - On the rhs the second term cancels the first of (\ref{conserv1}). The - seventh term of (\ref{conservedcurrent}) reads - \begin{equation} - \label{conserv5} - - e A \fmslash{G} \gamma^5 (\ii \fmslash{\partial} \Psi) = - e^2 A^2 - \fmslash{G} \gamma^5 \lambda - \ii e^2 A B \fmslash{G} \lambda + e^2 - A G_\mu G^\mu \Psi , - \end{equation} - while the tenth term of (\ref{conservedcurrent}) gives: - \begin{equation} - \label{conserv6} - \ii e B \fmslash{G} (\ii \fmslash{\partial} \Psi) = \ii e^2 A B - \fmslash{G} \lambda - e^2 B^2 \fmslash{G} \gamma^5 \lambda + \ii e^2 - B G_\mu G^\mu \gamma^5 \Psi - \end{equation} - Second term rhs (\ref{conserv5}) cancels first of rhs (\ref{conserv6}), - third term rhs (\ref{conserv5}) cancels third term rhs (\ref{conserv1}), - and third term rhs (\ref{conserv6}) eliminates third term rhs - (\ref{conserv2}). With the use of the identity - \begin{equation} - \lbrack \gamma^\alpha , \gamma^\beta \rbrack \gamma^\mu = - 2 - \eta^{\alpha\mu} \gamma^\beta + 2 \eta^{\beta\mu} \gamma^\alpha - 2 \ii - \epsilon^{\alpha\beta\mu\sigma} \gamma_\sigma \gamma^5 - \end{equation} - and the homogeneous Maxwell equations $\epsilon^{\alpha\beta\mu\sigma} - (\partial_\mu F_{\alpha\beta}) = 0$ term 11 of (\ref{conservedcurrent}) - yields - \begin{multline} - \label{conserv7} - \dfrac{1}{2} \gamma^\alpha \gamma^\beta \gamma^\mu \gamma^5 - (\partial_\mu F_{\alpha\beta}) \lambda = - e \gamma^\beta \gamma^5 \left( - A \partial_\beta B - B \partial_\alpha A \right) \lambda \\ + e^2 - \fmslash{G} \gamma^5 \left( A^2 + B^2 \right) \lambda - \dfrac{e}{2} - (\overline{\Psi} \gamma_\beta \gamma^5 \Psi) \gamma^\beta \gamma^5 - \lambda . - \end{multline} - The first term on rhs cancels the first terms rhs of (\ref{conserv3}) and - (\ref{conserv4}), while the second one eliminates the first term rhs of - (\ref{conserv5}) and the second one rhs of (\ref{conserv6}). Term number - 12 of (\ref{conservedcurrent}) is - \begin{multline} - \label{conserv8} - \dfrac{\ii}{2} \lbrack \gamma^\alpha , \gamma^\beta \rbrack \gamma^5 - (\partial_\alpha G_\beta) (\ii \fmslash{\partial} \lambda) = - \dfrac{\ii e}{2} \lbrack \gamma^\alpha , \gamma^\beta \rbrack \gamma^5 - (\partial_\alpha G_\beta) A \Psi - \dfrac{e}{2} \lbrack \gamma^\alpha , - \gamma^\beta \rbrack (\partial_\alpha G_\beta) B \Psi - \end{multline} - With the help of the Dirac algebra this cancels the fifth and eighth term - of (\ref{conservedcurrent}) together with the second terms of the rhs of - (\ref{conserv1}) and (\ref{conserv2}). - The last term of (\ref{conservedcurrent}) gives - \begin{equation} - \label{conserv9} - - \dfrac{e}{2} \left( A^2 + B^2 \right) (\ii \fmslash{\partial} \lambda) - = - \dfrac{e^2}{2} \left( A^3 + B^2 A \right) \Psi - \dfrac{\ii e^2}{2} - \left( B A^2 + B^3 \right) \gamma^5 \Psi , - \end{equation} - which cancels the last terms on the rhs of (\ref{conserv1}) and - (\ref{conserv2}). The remaining terms, the fourth terms rhs of - (\ref{conserv1}) and (\ref{conserv2}) as well as the last term rhs of - (\ref{conserv7}) add up to zero, - \begin{equation} - e (\overline{\Psi} \lambda) \Psi - e (\overline{\Psi} \gamma^5 \lambda) - \gamma^5 \Psi - \dfrac{e}{2} (\overline{\Psi} \gamma_\beta \gamma^5 \Psi) - \gamma^\beta \gamma^5 \lambda = 0 , - \end{equation} - which can be seen by Fierzing the first two terms. So the conservation of - the current is finally proven. - Conserved charge generates the SUSY transformations of the fields - \begin{subequations} - \begin{align} - \lbrack \overline{\xi} Q, A \rbrack &= \ii \left( \overline{\xi} \Psi - \right) \\ \lbrack \overline{\xi} Q,B \rbrack &= \ii \left( \ii - \overline{\xi} \gamma^5 \Psi \right) - \end{align} - \end{subequations} - For the transformation of the fermions it is more comfortable to write - the charge in the following form - \begin{multline} - \overline{Q} \xi = \int d^3 \vec{x} \biggl\{ - \overline{\Psi} \gamma^0 - (\fmslash{\partial} - \ii \overline{\Psi} \gamma^5 \gamma^0 - (\fmslash{\partial} B) + \ii e \overline{\Psi} \gamma^5 \gamma^0 - \fmslash{G} A - e \overline{\Psi} \gamma^0 \fmslash{G} B \\ + \dfrac{1}{2} - \overline{\lambda} (\partial_\alpha G_\beta) \gamma^5 \gamma^0 \lbrack - \gamma^\alpha , \gamma^\beta \rbrack + \dfrac{\ii e}{2} \overline{\lambda} - \gamma^0 \left( A^2 + B^2 \right) \biggr\} \xi - \end{multline} - and to use the identity $\overline{\xi} Q = \overline{Q} \xi$ to show - \begin{subequations} - \begin{align} - \lbrack \overline{\xi} Q , \Psi \rbrack &= \ii \left( - \ii - (\fmslash{\partial} - \ii e \fmslash{G} \gamma^5) (A + \ii \gamma^5 B) - \xi \right) \\ - \lbrack \overline{\xi} Q , \lambda \rbrack &= \ii \left( - \dfrac{\ii}{2} - F_{\alpha\beta} \gamma^\alpha \gamma^\beta \gamma^5 \xi - \dfrac{e}{2} - \left( A^2 + B^2 \right) \xi \right) - \\ - \lbrack \overline{\xi} Q , G_\mu \rbrack &= \ii \left( - \overline{\xi} - \gamma_\mu \gamma^5 \lambda \right) - \end{align} - \end{subequations} - To show the covariance of the equations of motion is more complicated - than in a simple gauge theory so we just show one example. - \begin{align} - \lbrack \overline{\xi} Q , \Box A \rbrack = & \; 2 \ii e \left( - \overline{\xi} (\fmslash{\partial} B) \gamma^5 \lambda \right) + 2 e - \left( \overline{\xi} \gamma^5 G_\mu \partial^\mu \Psi \right) - \ii e - \left( \overline{\xi} B \gamma^5 \fmslash{\partial} \lambda \right) - \notag\\ & \; - + e (\partial_\mu G^\mu) \left( \overline{\xi} \gamma^5 \Psi \right) - - 2 \ii e^2 A \left( \overline{\xi} \fmslash{G} \gamma^5 \lambda \right) + - \ii e^2 G_\mu G^\mu \left( \overline{\xi} \Psi \right) \notag\\ & \; - + e \overline{\xi} \Bigl( \left( \fmslash{\partial} - \ii e \fmslash{G} - \gamma^5 \right) \left( A - \ii \gamma^5 B \right) \Bigr) \lambda + - \dfrac{e^2}{2} \left( \overline{\xi} \lbrack \gamma^\alpha , \gamma^\beta - \rbrack \gamma^5 (\partial_\alpha G_\beta) \Psi \right) \notag \\ & \; + - \dfrac{\ii e^2}{2} \left( A^2 + B^2 \right) \left( \overline{\xi} \Psi - \right) - \dfrac{3 \ii e^2}{2} A^2 \left( \overline{\xi} \Psi \right) - - \dfrac{\ii e^2}{2} B^2 \left( \overline{\xi} \Psi \right) \notag \\ & \; - + e^2 A B \left( \overline{\xi} \gamma^5 \Psi \right) \notag - \\ = & \; - \ii e \left( - \overline{\xi} (\fmslash{\partial} B) \gamma^5 \lambda \right) + 2 e - \left( \overline{\xi} \gamma^5 G_\mu \partial^\mu \Psi \right) - \ii e - \left( \overline{\xi} B \gamma^5 \fmslash{\partial} \lambda \right) - \notag\\ & \; - + e (\partial_\mu G^\mu) \left( \overline{\xi} \gamma^5 \Psi \right) - - \ii e^2 A \left( \overline{\xi} \fmslash{G} \gamma^5 \lambda \right) + - \ii e^2 G_\mu G^\mu \left( \overline{\xi} \Psi \right) \notag\\ & \; - + e \left( \overline{\xi} (\fmslash{\partial} A) \lambda \right) - + e^2 B \left( \overline{\xi} \fmslash{G} \lambda \right) + - \dfrac{e^2}{2} \left( \overline{\xi} \lbrack \gamma^\alpha , \gamma^\beta - \rbrack \gamma^5 (\partial_\alpha G_\beta) \Psi \right) \notag \\ & \; - - \ii e^2 A^2 \left( \overline{\xi} \Psi \right) + e^2 A B - \left( \overline{\xi} \gamma^5 \Psi \right) - \end{align} - \begin{align} - \Box \: \lbrack \overline{\xi} Q , A \rbrack = & \; \ii \left( - \overline{\xi} \fmslash{\partial} \fmslash{\partial} \Psi \right) \notag - \\ = & \; e A \left( \overline{\xi} \fmslash{\partial} \lambda \right) - + e \left( \overline{\xi} (\fmslash{\partial} A) \lambda \right) - \ii e - B \left( \overline{\xi} \gamma^5 \fmslash{\partial} \lambda \right) + - \ii e \left( \overline{\xi} (\fmslash{\partial} B) \gamma^5 \lambda - \right) \notag \\ & \; + e \left( \overline{\xi} (\fmslash{\partial} - \fmslash{G}) \gamma^5 \Psi \right) + e \left( \overline{\xi} \gamma^\mu - \fmslash{G} \gamma^5 \partial_\mu \Psi \right) \notag \\ = & \; - - \ii e^2 A^2 \left( \overline{\xi} \Psi \right) + e^2 A B \left( - \overline{\xi} \gamma^5 \Psi \right) + e \left( \overline{\xi} - (\fmslash{\partial} A) \lambda \right) - \ii e \left( \overline{\xi} - B \gamma^5 \fmslash{\partial} \lambda \right) \notag \\ & \; + \ii e - \left( \overline{\xi} (\fmslash{\partial} B) \gamma^5 \lambda \right) + - \dfrac{e}{2} \left( \overline{\xi} \lbrack \gamma^\alpha , \gamma^\beta - \rbrack \gamma^5 (\partial_\alpha G_\beta) \Psi \right) + e (\partial_\mu - G^\mu) \left( \overline{\xi} \gamma^5 \Psi \right) \notag \\ & \; + 2 e - \left( \overline{\xi} \gamma^5 G_\mu \partial^\mu \Psi \right) - - \ii e^2 A \left( \overline{\xi} \fmslash{G} \gamma^5 \lambda \right) + - e^2 B \left( \overline{\xi} \fmslash{G} \lambda \right) \notag \\ & \; + - \ii e^2 (G_\mu G^\mu) \left( \overline{\xi} \Psi \right) - \end{align} - \begin{equation} - \Longrightarrow \lbrack \overline{\xi} Q , \Box A \rbrack \, = \, - \Box \: \lbrack \overline{\xi} Q , A \rbrack - \end{equation} *) - -(* \subsection*{Ward Identities} *) - -(* On shell current matrix elements - \begin{multline} - J_\mu(p_1,p_2) = \Braket{0|\mathcal{J}_\mu(x)|A (p_1) \Psi(p_2)} \\ = - \Braket{0|\mathcal{J}_\mu(x)|A(p_1)\Psi(p_2)}_{(0)} + \mathcal{O} - (g) - \sim - \fmslash{p}_1 \gamma_\mu u(p_2) + \mathcal{O} (g) - \end{multline} - \begin{equation} - (p_1+p_2)^\mu J_\mu(p_1,p_2) = - \fmslash{p}_1 \left( \fmslash{p}_1 + - \fmslash{p}_2 \right) u(p_2) + \mathcal{O} (g) = \mathcal{O} (g) - \end{equation} - Also for off-shell Green functions (from now on we take $\overline{\xi} - \mathcal{J}_\mu$ instead of $\mathcal{J}_\mu$ to deal with a bosonic - operator) - \begin{multline} - \frac{\partial}{\partial x_\mu} - \Braket{0|\mathrm{T}\overline{\xi}\mathcal{J}_\mu(x)A(y)\Psi(z)|0} = - \delta(x_0-y_0) \Braket{0|\mathrm{T}\lbrack \overline{\xi} - \mathcal{J}_0(x),A(y) \rbrack \Psi(z)|0} \\ - + \delta(x_0-z_0) \Braket{0|\mathrm{T}A(y)\lbrack \overline{\xi} - \mathcal{J}_0(x), \Psi(z) \rbrack |0} - + \Braket{0|\mathrm{T}\partial^\mu \overline{\xi} \mathcal{J}_\mu(x) - A(y)\Psi(z)|0} - \end{multline} - where the last term vanishes for conserved supersymmetry or purely - spontaneous symmetry breaking (no explicit breaking). Assuming for all - fields~$\phi$ - \begin{equation} - \lbrack \overline{\xi} \mathcal{J}_0(x),\phi(y) \rbrack - \Bigr\vert_{x_0=y_0} - = \delta^3(\vec x - \vec y) \lbrack \overline{\xi}Q,\phi(y) \rbrack - \end{equation} - this reads - \begin{multline} - \delta^4(x-y) \Braket{0|\mathrm{T}\lbrack \overline{\xi} Q, A(y) - \rbrack \Psi(z)|0} - + \delta^4(x-z) \Braket{0|\mathrm{T}A(y)\lbrack \overline{\xi} Q,\Psi(z) - \rbrack |0} = \\ - \frac{\partial}{\partial x_\mu} - \Braket{0|\mathrm{T}\overline{\xi} \mathcal{J}_\mu(x)A(y)\Psi(z)|0} - - \Braket{0|\mathrm{T}\partial^\mu \overline{\xi} \mathcal{J}_\mu(x) - A(y)\Psi(z)|0} - \end{multline} - Integrated (zero-momentum insertion, i.e. Fourier-transformation with zero - momentum) - \begin{multline} - \Braket{0|\mathrm{T}\lbrack \overline{\xi}Q,A(y) \rbrack\Psi(z)|0} - + \Braket{0|\mathrm{T}A(y)\lbrack \overline{\xi}Q,\Psi(z) \rbrack |0} = - \Braket{0|\mathrm{T}\lbrack \overline{\xi}Q,A(y)\Psi(z) \rbrack |0} = \\ - \int\!\mathrm{d}^4x\, \frac{\partial}{\partial x_\mu} - \Braket{0|\mathrm{T}\overline{\xi}\mathcal{J}_\mu(x)A(y)\Psi(z)|0} - - \int\!\mathrm{d}^4x - \Braket{0|\mathrm{T}\partial^\mu \overline{\xi}\mathcal{J}_\mu(x)A(y)\Psi(z)|0} - \end{multline} - where the first term does \emph{not} vanish in the case of zero momentum - for spontaneous symmetry breaking, because massless Goldstone boson states - give a contribution at infinity. We are here dealing with exact - supersymmetry, so the second term on the r.h.s. of the former equation is - zero, but we won't set the momentum of the current to zero at the moment. - E.\,g.: - \begin{multline} - \delta^4(y-x_1) \Braket{0|\mathrm{T}\lbrack \overline{\xi}Q,A(x_1) \rbrack \Psi(x_2)|0} - + \delta^4(y-x_2) \Braket{0|\mathrm{T}A(x_1)\lbrack \overline{\xi}Q,\Psi(x_2) \rbrack |0} \\ - = \ii - \delta^4(y-x_1) \Braket{0|\mathrm{T}\Psi(x_2)\overline{\Psi}(x_1)\xi|0} - + \ii \delta^4(y-x_2) \Braket{0|\mathrm{T}A(x_1) (-\ii \fmslash{\partial}A(x_2))\xi|0} \\ - = \frac{\partial}{\partial y_\mu} - \Braket{0|\mathrm{T}\mathcal{J}_\mu(y)A(x_1)\Psi(x_2)|0} = - - \dfrac{\partial}{\partial y_\mu} \Braket{0|\mathrm{T} \Psi(x_2) - \overline{\Psi}(y) \gamma_\mu A(x_1) \fmslash{\partial}_y A(y) \xi |0} - \end{multline} - in tree approximation in configuration space - \begin{multline} - \ii \delta^4(y-x_1) S_F(x_2-x_1)\xi + \delta^4(y-x_2) - \fmslash{\partial}_{x_2} D_F (x_1-x_2)\xi \\ = - \partial^\mu_y \biggl\{ - S_F(x_2-y) \gamma_\mu \: \fmslash{\partial}_y D_F(x_1-y)\xi\biggr\} - \end{multline} - Inserting the expressions for the fermion and boson propagators (remember - that all particles here are massless) - \begin{align} - D_F (x-y) &= \; \int \dfrac{d^4 k_1}{(2\pi)^4} \dfrac{\ii e^{-\ii k_1 - (x-y)}}{k_1^2 + \ii \epsilon} \\ - S_F (x-y) &= \; \int \dfrac{d^4 k_2}{(2\pi)^4} \dfrac{\ii e^{-\ii k_2 - (x-y)}}{\fmslash{k}_2 + \ii \epsilon} - \end{align} - in tree approximation in momentum space - \begin{multline} - \mbox{} \left( \dfrac{\ii(-\ii)}{\fmslash{p}_2} + \dfrac{\ii(-\ii) - \fmslash{p}_1}{p_1^2} \right) \xi \\ = + \ii \left( p_1 + p_2 - \right)^\mu \biggl\{ S_F(x_2-y) \gamma_\mu \: \fmslash{\partial}_y - D_F(x_1-y)\xi\biggr\} \\ = - \ii^2 (-\ii)^2 \dfrac{1}{p_1^2} \dfrac{1}{\fmslash{p}_2} (\fmslash{p}_1 - + \fmslash{p}_2) - \fmslash{p}_1 \xi = + \left( \dfrac{1}{\fmslash{p}_2} + - \dfrac{\fmslash{p}_1}{p_1^2} \right) \xi - \end{multline} - Some words about the signs: The momentum flux always goes from the right - spacetime event argument of the propagator to the left. In our case the two - propagators $S_F$ and $D_F$ have the exponentials $\exp(\ii p_2(x_2-y)$ and - $\exp(\ii p_1 (x_1-y)$ respectively. The sign of the derivative of the - current can be understood as the derivative acts on a field operator - inserted in the amplitude and not on a field in an interaction vertex. - - \vspace{.5cm} - - Similarly, the transformed $n$-point function can be related to the - divergence of an $(n-1)$-point function with the insertion of one - current. At this level we don't treat spontaneous symmetry breaking so - we haven't any "mixing" of orders in perturbation theory. By this we mean - the masking of a diagram with one current insertion, taking the part with - the vacuum expectation value of the lower doublet component, combining with - the coupling constant of what would normally be a higher order vertex in - perturbation theory to a mass term of the Higgs, as a diagram of lowest - order in perturbation theory. - - \vspace{5mm} - - Graphically denoting the influx of momentum by a dotted line, we have - the \emph{exact} relation (for $k+k_1+k_2=0$ and all momenta incoming) - \begin{equation} - \parbox{21mm}{% - \begin{fmfgraph*}(20,15) - \fmfleft{i,di}\fmfright{o,do} - \fmftop{k} - \fmf{dashes,label=$k_1$,l.side=left}{i,o} - \fmf{dots,label=$k$,l.side=left}{k,o} - \end{fmfgraph*}} + - \parbox{21mm}{% - \begin{fmfgraph*}(20,15) - \fmfleft{i,di}\fmfright{o,do} - \fmftop{k} - \fmf{fermion,label=$k_2$,l.side=right}{o,i} - \fmf{dots,label=$k$,l.side=left}{i,k} - \end{fmfgraph*}} = - \parbox{21mm}{% - \begin{fmfgraph*}(20,15) - \fmftop{t} - \fmfbottom{b1,b2} - \fmf{dashes}{b1,v} - \fmf{fermion}{b2,v} - \fmf{dbl_plain,label=\begin{math}k_\mu {\cal J}^\mu - \end{math}}{v,t} - \fmfdot{v} - \fmfblob{.25w}{t} - \end{fmfgraph*}} - \end{equation} - that can eventually be used to derive more complicated relations, if we - manage to find the corresponding rules for vertices. - - \vspace{.5cm} - - We give another example of a 2-point-function with current insertion, but - with a gauge boson and a gaugino. - \begin{align} - & \delta^4(y-x_1) \Braket{0|\mathrm{T}\lbrack \overline{\xi}Q,G_\nu - (x_1) \rbrack \lambda(x_2)|0} - + \delta^4(y-x_2) \Braket{0|\mathrm{T}G_\nu(x_1)\lbrack \overline{\xi} - Q,\lambda(x_2) \rbrack |0} \notag \\ - = \; & - \ii \delta^4(y-x_1) \Braket{0|\mathrm{T}\lambda(x_2)\overline{\lambda}(x_1)\gamma_\nu\gamma^5\xi|0} \notag \\ & \qquad \qquad - + \dfrac{1}{2} \delta^4(y-x_2) \Braket{0|\mathrm{T}G_\nu(x_1) - (\partial_\alpha^{x_2} G_\beta(x_2))\lbrack \gamma^\alpha , - \gamma^\beta \rbrack \gamma^5 \xi|0} \notag \\ - \stackrel{!}{=} \; & \frac{\partial}{\partial y_\mu} - \Braket{0|\mathrm{T}\mathcal{J}_\mu(y)G_\nu(x_1)\lambda(x_2)|0} \notag - \\ = \; & - \dfrac{1}{2} \dfrac{\partial}{\partial y_\mu} \Braket{0|\mathrm{T} - \lambda(x_2) \overline{\lambda}(y) \gamma^5 \gamma_\mu \lbrack - \gamma^\alpha , \gamma^\beta \rbrack (\partial_\alpha^y G_\beta (y)) - G_\nu(x_1) \xi |0} - \end{align} - In configuration space: - \begin{multline} - - \ii \delta^4(y-x_1) S_F (x_2 - x_1) \gamma_\nu \gamma^5 \xi + - \dfrac{1}{2} \delta^4 (y-x_2) (-\eta_{\nu\beta}) \partial_\alpha^{x_2} - D_F (x_1-x_2) \lbrack \gamma^\alpha , \gamma^\beta \rbrack \gamma^5 \xi \\ - \stackrel{!}{=} \dfrac{1}{2} \partial_\mu^y \biggl\{ S_F (x_2-y) \gamma^5 - \gamma^\mu \lbrack \gamma^\alpha , \gamma^\beta \rbrack \partial_\alpha^y - (-\eta_{\beta\nu}) D_F (y-x_1) \xi \biggr\} - \end{multline} - In momentum space: - \begin{multline} - \dfrac{(-\ii)^2}{\fmslash{p}_2} \gamma_\nu \gamma^5 \xi - \dfrac{1}{2} - \dfrac{\ii}{p_1^2} \lbrack -\ii \fmslash{p}_1 , \gamma_\nu \rbrack - \gamma^5 \xi \\ \stackrel{!}{=} - \dfrac{1}{2} (-\ii) (p_1^\mu + p_2^\mu) \dfrac{-\ii}{\fmslash{p}_2} - \gamma^5 \gamma_\mu \lbrack \gamma^\alpha , \gamma^\beta \rbrack (- - \ii p_{1,\alpha}) \dfrac{-\ii \eta_{\beta\nu}}{p_1^2} \xi - \end{multline} - We better simplify this: - \begin{multline} - \dfrac{-1}{\fmslash{p}_2} \gamma_\nu \gamma^5 \xi - \dfrac{1}{2} - \dfrac{1}{p_1^2} \lbrack \fmslash{p}_1 , \gamma_\nu \rbrack - \gamma^5 \xi \\ \stackrel{!}{=} - \dfrac{1}{2} \dfrac{1}{\fmslash{p}_2} \gamma^5 (\fmslash{p}_1 + - \fmslash{p}_2) \lbrack \fmslash{p}_1 , \gamma_\nu \rbrack - \dfrac{1}{p_1^2} \xi = - \dfrac{1}{2} \dfrac{1}{p_1^2} \lbrack - \fmslash{p}_1 , \gamma_\nu \rbrack \gamma^5 \xi - \dfrac{1}{2} \gamma^5 - \dfrac{1}{\fmslash{p}_2} \fmslash{p}_1 \lbrack \fmslash{p}_1 , \gamma_\nu - \rbrack \dfrac{1}{p_1^2} \xi \\ - = - \dfrac{1}{2} \dfrac{1}{p_1^2} \lbrack \fmslash{p}_1 , \gamma_\nu - \rbrack \gamma^5 \xi - \dfrac{1}{\fmslash{p}_2} \gamma_\nu \gamma^5 \xi - + \dfrac{1}{\fmslash{p}_2} \dfrac{\fmslash{p}_1}{p_1^2} p_{1,\nu} - \gamma^5 \xi - \end{multline} - The third term is proportional to the momentum of the gauge boson. Setting - the gauge boson on-shell (multiplying with the inverse propagator and the - polarization vector) or inserting this 3-point-function with current - insertion with the outer vector index into a gauge-invariant amplitude - result in a zero from that term. So we can eliminate it and the Ward - identity holds. - - \vspace{.5cm} - - As long as the symmetry is exact (no spontaneous breaking) there is no - problem with disconnected diagrams which can be produced by {\em vev}s - in the transformation rules (see [f90_O2.ml]). For better legibility we - write $p_i$ instead of $k_i$ for the momenta of the particles now to - distinguish from the momentum coming from the current. - \begin{multline} - k^{\mu}G_{\mu}^{j|\phi_2\phi_1\cdots,\text{amp.}} (k|p_1,p_2,\ldots) - \Bigr|_{k+p_1+p_2+\ldots=0} = \\ - \frac{G^{\phi_1\phi_1}(p_1+k)}{G^{\phi_2\phi_2}(p_1)} - G^{\phi_1\phi_1\cdots,\text{amp.}} (p_1+k,p_2,\ldots) - \Bigr|_{k+p_1+p_2+\ldots=0} \\ - - \frac{G^{\phi_2\phi_2}(p_2+k)}{G^{\phi_1\phi_1}(p_2)} - G^{\phi_2\phi_2\cdots,\text{amp.}} (p_1,p_2+k,\ldots) - \Bigr|_{k+p_1+p_2+\ldots=0} - \ldots - \end{multline} - For $k_\mu\to0$: - \begin{multline} - \lim_{k_\mu\to0} - k^{\mu}G_{\mu}^{j|\phi_2\phi_1\cdots,\text{amp.}} (k|p_1,p_2,\ldots) - \Bigr|_{k+p_1+p_2+\ldots=0} = \\ - \frac{G^{\phi_1\phi_1}(p_1)}{G^{\phi_2\phi_2}(p_1)} - G^{\phi_1\phi_1\cdots,\text{amp.}} (p_1,p_2,\ldots) - \Bigr|_{p_1+p_2+\ldots=0} \\ - - \frac{G^{\phi_2\phi_2}(p_2)}{G^{\phi_1\phi_1}(p_2)} - G^{\phi_2\phi_2\cdots,\text{amp.}} (p_1,p_2,\ldots) - \Bigr|_{p_1+p_2+\ldots=0} - \ldots - \end{multline} - In case of spontaneous symmetry breaking there's one subtlety: the right - hand side of - \begin{multline} - G^{\phi_1\phi_1\cdots,\text{amp.}} (p_1,p_2,\ldots) - \Bigr|_{p_1+p_2+\ldots=0} = \\ - \frac{G^{\phi_2\phi_2}(p_1)}{G^{\phi_1\phi_1}(p_1)} - \lim_{k_\mu\to0} - k^{\mu}G_{\mu}^{j|\phi_2\phi_1\cdots,\text{amp.}} (k|p_1,p_2,\ldots) - \Bigr|_{k+p_1+p_2+\ldots=0} \\ - + \frac{G^{\phi_2\phi_2}(p_1)}{G^{\phi_1\phi_1}(p_1)} - \frac{G^{\phi_2\phi_2}(p_2)}{G^{\phi_1\phi_1}(p_2)} - G^{\phi_2\phi_2\cdots,\text{amp.}} (p_1,p_2,\ldots) - \Bigr|_{p_1+p_2+\ldots=0} + \ldots - \end{multline} - appears to vanish on the mass shell of the left hand side, but this - must not mean that the corresponding scattering amplitude vanishes. - What is going on, is that the insertion of a soft current or the - emission or absorption of a soft Goldstone boson contributes another - pole for $k_\mu\to0$, if momentum conservation is taken into account. - Here we deal with exact supersymmetry so everything vanishes if we take - the limit $k_\mu \rightarrow 0$. - - Example: - \begin{subequations} - \begin{align} - \mathrm{F.T.} \Braket{0|\mathrm{T}\ii \overline{\xi} \Psi(x_1) - G_\nu(x_2)\Psi(x_3)|0} &= - - e \frac{(-\mathrm{i})}{p_2^2} \frac{\mathrm{i}}{\fmslash{p}_3} - \gamma_\nu \gamma^5 \frac{\mathrm{i}}{\fmslash{p}_1 + \fmslash{k}} - \xi \\ - \mathrm{F.T.} \Braket{0|\mathrm{T}A(x_1)\ii(-\overline{\xi} \gamma_\nu - \gamma^5 \lambda (x_2))\Psi(x_3)|0} - &= e \frac{\mathrm{i}}{p_1^2} - \frac{\mathrm{i}}{\fmslash{p}_3} \frac{\mathrm{i}}{\fmslash{p}_2 + - \fmslash{k}} \gamma_\nu \gamma^5 \xi - \end{align} - \begin{multline} - \mathrm{F.T.} \Braket{0|\mathrm{T}A(x_1)G_\nu(x_2) \ii(-\gamma^5 - \fmslash{\partial} B(x_3)\xi)|0} = \\ - - e \frac{\mathrm{i}}{p_1^2} \frac{-\mathrm{i}}{p_2^2} - (k_\nu+p_{3,\nu}-p_{1,_\nu}) \frac{\mathrm{i}}{(p_3+k)^2} \gamma^5 - (\fmslash{p}_3 + \fmslash{k}) \xi - \end{multline} - \begin{equation} - \mathrm{F.T.} \Braket{0|\mathrm{T}A(x_1)G_\nu(x_2) (-\ii\gamma^\mu - (G_\mu A)(x_3) \gamma^5 \xi)|0} = \dfrac{\ii}{p_1^2} \dfrac{-\ii - \eta_{\mu\nu}}{p_2^2} (-\ii e) \gamma^\mu \gamma^5 \xi - \end{equation} - \end{subequations} - For the last process there is a nonvanishing contribution from the - SUSY-transformation into an [A] scalar and a vectorboson; this seems to be - of higher order in perturbation theory but nonetheless must be considered - here. On-shell you have to take the one-particle-pole on the r.h.s. of the - transformation of the fields. The same is true for the appearing of - quadratic terms after inserting the equation of motion for the auxiliary - fields on the r.h.s. of the transformation rules. But off-shell this - becomes a local operator insertion. In the first two processes one has to - take account of the sign of the last fermion propagator which appears with - calculational direction opposite to the momentum flow. - - \vspace{0.5cm} - - Now we must evaluate the 4-point-function with the current insertion. - We rewrite the current $\overline{\xi} \mathcal{J}_\mu$ as - $\overline{\mathcal{J}_\mu} \xi$, which is identical due to the - Majorana properties of the current and the transformation parameter: - \begin{align} - \overline{\xi} \mathcal{J}_\mu = & \; \overline{\xi} - \biggl\{ - (\fmslash{\partial} A) \gamma_\mu \Psi - \ii - (\fmslash{\partial} B) \gamma_\mu \gamma^5 \Psi + \ii e A \fmslash{G} - \gamma_\mu \gamma^5 \Psi - e B \fmslash{G} \gamma_\mu \Psi \notag \\ - & \qquad\qquad\qquad + - \dfrac{1}{2} \lbrack \gamma^\alpha , \gamma^\beta \rbrack \gamma_\mu - \gamma^5 (\partial_\alpha G_\beta) \lambda - \dfrac{\ii e}{2} \left( A^2 - + B^2 \right) \gamma_\mu \lambda - \biggr\} \notag - \\ = & \; \biggl\{ - \overline{\Psi} \gamma_\mu (\fmslash{\partial} A) - + \ii \overline{\Psi} \gamma_\mu \gamma^5 (\fmslash{\partial} B) - \ii - e \overline{\Psi} \gamma_\mu \gamma^5 \fmslash{G} A - e - \overline{\Psi} \gamma_\mu \fmslash{G} B \notag \\ & \qquad\qquad\qquad - - \dfrac{1}{2} \overline{\lambda} (\partial_\alpha G_\beta) - \gamma_\mu \gamma^5 \lbrack \gamma^\alpha , \gamma^\beta \rbrack - + \dfrac{\ii e}{2} \overline{\lambda} \gamma_\mu \left( A^2 + B^2 \right) - \biggr\} \xi - \end{align} - This brings the propagator of the (matter) fermion to the farthest left. - There are four diagrams contributing to the process which we will list now: - \begin{equation} - \parbox{21mm}{% - \begin{fmfgraph*}(20,20) - \fmfleft{i1,i2}\fmfright{o1,o2} - \fmf{dashes}{o2,v2} - \fmf{photon}{i2,v2} - \fmf{dbl_dashes}{v1,v2} - \fmf{dbl_plain}{i1,v1} - \fmf{plain}{o1,v1} - \fmfdot{v1,v2} - \fmfblob{.25w}{i1} - \end{fmfgraph*}}\qquad + \quad - \parbox{21mm}{% - \begin{fmfgraph*}(20,20) - \fmfleft{i1,i2}\fmfright{o1,o2} - \fmf{plain}{o2,v2} - \fmf{photon}{i2,v2} - \fmf{plain}{v1,v2} - \fmf{dbl_plain}{i1,v1} - \fmf{dashes}{o1,v1} - \fmfdot{v1,v2} - \fmfblob{.25w}{i1} - \end{fmfgraph*}}\qquad + \quad - \parbox{21mm}{% - \begin{fmfgraph*}(20,20) - \fmfleft{i1,i2}\fmfright{o1,o2} - \fmf{plain}{o2,v2} - \fmf{dashes}{i2,v2} - \fmf{plain}{v1,v2} - \fmf{dbl_plain}{i1,v1} - \fmf{photon}{o1,v1} - \fmffreeze - \fmf{photon}{v1,v2} - \fmfdot{v1,v2} - \fmfblob{.25w}{i1} - \end{fmfgraph*}}\qquad + \quad - \parbox{21mm}{% - \begin{fmfgraph*}(20,20) - \fmfleft{i1,i2}\fmfright{o1,o2} - \fmf{plain}{o2,v} - \fmf{photon}{i2,v} - \fmf{dbl_plain}{i1,v} - \fmf{dashes}{o1,v} - \fmfdot{v} - \fmfblob{.25w}{i1} - \end{fmfgraph*}}\qquad\quad - \end{equation} - - For the sign of the fermion propagator one has to take care of the flow of - momentum. - \begin{multline} - \mathrm{F.T.} \Braket{0|\mathrm{T}\overline{\mathcal{J}_\mu}(y) \xi A(x_1) - G_\nu(x_2)\Psi(x_3)|0} = \\ - \frac{\mathrm{i}}{p_1^2}\frac{-\mathrm{i}}{p_2^2} - \dfrac{-\ii}{\fmslash{p}_3} \left( \mathrm{F.T.} \Braket{0|\mathrm{T} - \overline{\mathcal{J}_\mu} (y)A(x_1)G_\nu(x_2)\Psi(x_3)|0}_{\text{amp.}} - \right) \xi - \end{multline} - \begin{multline} - \mathrm{F.T.} \Braket{0|\mathrm{T}\overline{\mathcal{J}_\mu}(y) - A(x_1)G_\nu(x_2)\Psi(x_3)|0}_{\text{amp.}} \xi = - - \ii e \gamma_\mu \gamma^5 \gamma_\nu \xi \\ - - \ii e \dfrac{\ii}{\fmslash{p}_2 + \fmslash{k}} \left(-\dfrac{1}{2} - \right) (-\ii p_{2,\alpha}) \gamma_\mu \gamma^5 \lbrack \gamma^\alpha , - \gamma_\nu \rbrack - \xi + \ii e \gamma_\nu \gamma^5 \dfrac{\ii}{\fmslash{p}_1 + - \fmslash{k}} \gamma_\mu (-\ii \fmslash{p}_1) \xi \\ - + \dfrac{\ii}{(p_3 + k)^2} e \left( p_{1,\nu} - p_{3,\nu} - k_\nu \right) - \ii \gamma_\mu \gamma^5 \ii \left( \fmslash{p}_3 + \fmslash{k} \right) - \xi - \end{multline} - with $\partial_\mu\to\mathrm{i}k_\mu=-\mathrm{i}(p_1+p_2+p_3)_\mu$ - \begin{align} - & \; \dfrac{-\ii}{\fmslash{p}_3} \dfrac{1}{p_1^2 p_2^2} \; - \mathrm{F.T.} \partial_y^\mu \Braket{0|\mathrm{T} - \overline{\mathcal{J}_\mu}(y) A(x_1)G_\nu(x_2) - \Psi(x_3)|0}_{\text{amp.}} \xi \notag \\ = - & \; - \dfrac{\ii}{\fmslash{p}_3} \dfrac{1}{p_1^2 p_2^2} \biggl\{ - - e \left( \fmslash{p}_1 + \fmslash{p}_2 + \fmslash{p}_3 \right) - \gamma^5 \gamma_\nu - \dfrac{e}{2} \, \dfrac{1}{\fmslash{p}_1 + - \fmslash{p}_3} \left( \fmslash{p}_1 + \fmslash{p}_2 + \fmslash{p}_3 - \right) \gamma^5 \lbrack \fmslash{p}_2 , \gamma_\nu \rbrack \notag - \\ & \; \qquad + e \left( p_{1,\nu} - p_{3,\nu} - k_\nu \right) - \dfrac{1}{(p_3 + k)^2} \left( \fmslash{p}_1 + \fmslash{p}_2 + - \fmslash{p}_3 \right) \gamma^5 \left( \fmslash{p}_1 + \fmslash{p}_2 - \right) \notag \\ & \; \qquad - e \gamma_\nu \gamma^5 - \dfrac{1}{\fmslash{p}_2 + \fmslash{p}_3} \left( \fmslash{p}_1 + - \fmslash{p}_2 + \fmslash{p}_3 \right) \fmslash{p}_1 \biggr\} \xi - \notag \\ = & \; - - \dfrac{\ii e}{p_1^2 p_2^2} \gamma_\nu \gamma^5 \xi - \dfrac{\ii e} - {p_1^2 p_2^2} \dfrac{1}{\fmslash{p}_3} \left( \fmslash{p}_1 + - \fmslash{p}_2 \right) \gamma_\nu \gamma^5 \xi - \notag \\ & \; - + \dfrac{\ii e}{2} \dfrac{1}{p_1^2 p_2^2} \dfrac{1}{\fmslash{p}_3} - \gamma^5 \lbrack \fmslash{p}_2 , \gamma_\nu \rbrack \xi + \dfrac{\ii - e}{p_1^2} \dfrac{1}{\fmslash{p}_3} \dfrac{1}{\fmslash{p}_1 + - \fmslash{p}_3} \gamma_\nu \gamma^5 \xi - \dfrac{\ii e}{p_1^2 p_2^2} - \dfrac{1}{\fmslash{p}_3} \dfrac{1}{\fmslash{p}_1 + \fmslash{p}_3} - \fmslash{p}_2 p_{2,\nu} \gamma^5 \xi - \notag \\ & \; - + \dfrac{\ii e}{p_1^2 p_2^2} \dfrac{1}{\fmslash{p}_3} \left( 2 p_{1,\nu} - + p_{2,\nu} \right) \gamma^5 \xi - \dfrac{\ii e}{p_1^2 p_2^2} \left( - 2 p_{1,\nu} + p_{2,\nu} \right) \dfrac{1}{(p_1 + p_2)^2} \gamma^5 - \left( \fmslash{p}_1 + \fmslash{p}_2 \right) \xi \notag - \\ & \; - + \ii e \dfrac{1}{p_1^2 p_2^2} \dfrac{1}{\fmslash{p}_3} \gamma_\nu - \gamma^5 \fmslash{p}_1 \xi + \ii e \dfrac{1}{p_2^2} - \dfrac{1}{\fmslash{p}_3} \gamma_\nu \gamma^5 \dfrac{1}{\fmslash{p}_2 + - \fmslash{p}_3} \xi - \end{align} - For the sign of the momentum it is important to know that the derivative - acting on the current really acts on a field operator insertion and - {\em not} on an operator belonging to an interaction vertex. - The first term in the first row, the second term in the second row, the - second term in the third row and the second term in the last row yield the - sum of the four amplitudes with one field SUSY-transformed which are given - by: - \begin{multline} - \ii e \dfrac{1}{p_2^2} \dfrac{1}{\fmslash{p}_3} \gamma_\nu \gamma^5 - \dfrac{1}{\fmslash{p}_2 + \fmslash{p}_3} \xi + \ii e \dfrac{1}{p_1^2} - \dfrac{1}{\fmslash{p}_3} \dfrac{1}{\fmslash{p}_1 + \fmslash{p}_3} - \gamma_\nu \gamma^5 \xi - \dfrac{\ii e}{p_1^2 p_2^2} \gamma_\nu \gamma^5 - \xi \\ - \ii e \dfrac{1}{p_1^2} \dfrac{1}{p_2^2} - \left( 2 p_{1,\nu} + p_{2,\nu} \right) \dfrac{1}{(p_1 + p_2)^2} \gamma^5 - (\fmslash{p}_1 + \fmslash{p}_2) \xi - \end{multline} - So the remaining terms must cancel. But they don't. There still remains one - term: - \begin{equation} - - \dfrac{\ii e}{p_1^2 p_2^2} \dfrac{1}{\fmslash{p}_3} \dfrac{1}{ - \fmslash{p}_1 + \fmslash{p}_3} \fmslash{p}_2 p_{2,\nu} \gamma^5 \xi - \end{equation} - This again is a term proportional to the momentum of the gauge boson, so the - same is true what we have said in the case of the testing of the 2-point - function $\Greensfunc{\lbrack Q(\xi) , G_\mu(x_1)\lambda(x_2)\rbrack}$. *) - -(* The message from these examples is that the Ward-Takahashi identities are - only fulfilled between physical on-shell states, but not off-shell. - - Caveat (T. Ohl): the Ward identities for on-shell amplitudes do \emph{not} - test the theory comprehensively, since only the coupling of Goldstone bosons - and and currents to external lines. - - The cause for this complication is that the SUSY charge is not conserved in - the case of supersymmetric gauge theories, cf. Sibold, Scharf, Rupp: .... - There is a difference between the SUSY charge acting on the {\em in}-space - and the SUSY charge acting on the {\em out}-space given by the the - BRST-transformation of the derivative of the effective action with - respect to the SUSY ghost. This term of course vanishes between physical - states, so there the SUSY charge is a conserved operator. - - For correctly derive off-shell relations between Green functions we have to - turn to the BRST-formalism; we have to take into account the - BRST-transformations with ghosts instead of the simple "classical" - transformations. To achieve a closed algebra, we must include SUSY - transformations, gauge transformations and translations. - -*) - -module Main = Omega.Make(Fusion.Mixed23_Majorana) - (Targets.Fortran_Majorana)(SAGT) -let _ = Main.main () - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Index: branches/ohl/omega-development/completed/whizard2/extensions/people/jr/main.tex =================================================================== --- branches/ohl/omega-development/completed/whizard2/extensions/people/jr/main.tex (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/extensions/people/jr/main.tex (revision 8703) @@ -1,42 +0,0 @@ -% $Id: main.tex,v 1.1 2004/04/09 20:11:16 ohl Exp $ -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\documentclass[12pt]{article} -\usepackage{ocamlweb} -\usepackage{amsmath,amssymb,thophys} -\setlength{\parindent}{0pt} -\usepackage{feynmp} -\setlength{\unitlength}{1mm} -\newcommand{\ii}{\mathrm{i}} -\begin{document} -\begin{fmffile}{mainpics} -\input{f90_SAGT.implementation} -%%%\begin{figure} -%%%\def\F#1#2{\fmfi{dots}{.8[vloc(__v),vloc(__#1)] -- .8[vloc(__v),vloc(__#2)]}} -%%%\def\D#1{\parbox{35mm}{% -%%% \begin{fmfgraph}(35,35) -%%% \fmfleft{s}\fmfrightn{f}{4} -%%% \fmfbottomn{b}{4}\fmfforce{c}{v} -%%% \fmfv{dec.shape=circle,dec.fill=0,dec.size=.35w}{v} -%%% \fmfv{dec.shape=tetragram,dec.fill=1,dec.size=3thick}{f3,f4,b2,b3} -%%% \fmf{fermion}{f4,v,f3} -%%% \fmf{fermion}{f2,v,f1} -%%% \fmf{photon}{b2,v,b3} -%%% \fmffreeze #1 -%%% \F{f1}{f2}\F{f3}{f4}\F{b2}{b3} -%%% \end{fmfgraph}}} -%%%\begin{multline} -%%% \D{\fmf{dashes}{s,v}}\\ -%%% =\D{\fmfi{dashes}{% -%%% vloc(__s){vloc(__v)-vloc(__s)} -%%% .. .5[vloc(__s),vloc(__f4)] .. -%%% {vloc(__f4)-vloc(__v)} vloc(__f4)}} -%%% +\cdots+\D{\fmfi{dashes}{% -%%% vloc(__s){vloc(__v)-vloc(__s)} -%%% .. .5[vloc(__s),vloc(__f4)] .. -%%% {vloc(__f3)-vloc(__v)} vloc(__f3)}} -%%%\end{multline} -%%% \caption{\label{fig:WI}% -%%% Ward identities} -%%%\end{figure} -\end{fmffile} -\end{document} Index: branches/ohl/omega-development/completed/whizard2/extensions/people/jr/f90_WZ.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/extensions/people/jr/f90_WZ.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/extensions/people/jr/f90_WZ.ml (revision 8703) @@ -1,875 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -let rcs_file = RCS.parse "f90_WZ" ["Wess-Zumino model"] - { RCS.revision = "$Revision$"; - RCS.date = "$Date$"; - RCS.author = "$Author$"; - RCS.source - = "$Source: /home/sources/ohl/ml/omega/extensions/people/jr/f90_WZ.ml,v $" } - -(* \subsection*{Lagrangian} *) - -(* Simplest model available: - \begin{equation} - \dfrac{1}{2} \begin{bmatrix} \hat{\Phi}^\dagger - \hat{\Phi} \end{bmatrix}_D + 2 \Re \, \begin{bmatrix} - \mu \hat{\Phi} + \dfrac{m}{2} \hat{\Phi}^2 + \dfrac{\lambda}{3!} - \hat{\Phi}^3 \end{bmatrix}_F - \end{equation} - The Wess-Zumino model is the simplest supersymmetric toy model (besides the - possibility of a vanishing superpotential). The parameter $\mu$ can be - eliminated by a redefinition of the superfields. *) - -module WZ = - struct - let rcs = rcs_file - open Coupling - let options = Options.empty - - type flavor = - | A | B | Psi | J - -(* All particles are self-charge-conjugate. *) - - let conjugate f = f - - let external_flavors () = - [ "fields", [A; B; Psi]; - "currents", [J] ] - - let flavors () = ThoList.flatmap snd (external_flavors ()) - - let flavor_of_string = function - | "a" -> A | "b" -> B - | "psi" -> Psi - | "j" -> J - | _ -> invalid_arg "WZ.flavor_of_string" - - let flavor_to_string = function - | A -> "a" | B -> "b" | Psi -> "psi" - | J -> "j" - - let flavor_symbol = function - | A -> "a" | B -> "b" | Psi -> "psi" - | J -> "j" - - let lorentz = function - | A | B -> Scalar - | Psi -> Majorana - | J -> Vectorspinor - - let propagator = function - | A | B -> Prop_Scalar - | Psi -> Prop_Majorana - | J -> Only_Insertion - - let width _ = Timelike - let goldstone _ = None - - let fermion = function - | A | B -> 0 - | Psi | J -> 2 - - let color _ = Color.Singlet - type gauge = unit - let gauge_symbol () = failwith "WZ.gauge_symbol: internal error" - - let colsymm _ = (0,false),(0,false) - -(* \begin{equation} - \begin{aligned} - {\cal L}_{WZ} = & \; \frac{1}{2} \left( \partial_\mu A \partial^\mu A - m^2 - A^2 \right) + \frac{1}{2} \left( \partial_\mu B \partial^\mu B - m^2 B^2 - \right) + \frac{1}{2} \overline{\Psi} \left( \ii \fmslash{\partial} - m - \right) \Psi \\ & \; - \dfrac{\lambda}{2 \sqrt{2}} \overline{\Psi} \Psi A + - \dfrac{\ii\lambda}{2 \sqrt{2}} \overline{\Psi} \gamma^5 \Psi B - - \frac{\lambda^2}{16} A^4 - \frac{\lambda^2}{16} B^4 - \frac{\lambda^2}{8} - A^2 B^2 \\ & \; - \frac{1}{2 \sqrt{2}} m \lambda A^3 - \frac{1}{2 \sqrt{2}} - m \lambda A B^2 - \end{aligned} - \end{equation} - Propagators - \begin{subequations} - \begin{align} - \parbox{21mm}{% - \begin{fmfgraph*}(20,5) - \fmfleft{i}\fmfright{o} - \fmflabel{$A(p)$}{i} - \fmflabel{$A(p)$}{o} - \fmf{dashes}{i,o} - \fmfdot{i,o} - \end{fmfgraph*}}\qquad\quad - &= \frac{\mathrm{i}}{p^2-m^2+\mathrm{i}\epsilon} \\ - \parbox{21mm}{% - \begin{fmfgraph*}(20,5) - \fmfleft{i}\fmfright{o} - \fmflabel{$B(p)$}{i} - \fmflabel{$B(p)$}{o} - \fmf{dbl_dashes}{i,o} - \fmfdot{i,o} - \end{fmfgraph*}}\qquad\quad - &= \frac{\mathrm{i}}{p^2-m^2+\mathrm{i}\epsilon} \\ - \parbox{21mm}{% - \begin{fmfgraph*}(20,5) - \fmfleft{i}\fmfright{o} - \fmflabel{$\Psi(p)$}{i} - \fmflabel{$\overline{\Psi}(p)$}{o} - \fmf{plain}{i,o} - \fmfdot{i,o} - \end{fmfgraph*}}\qquad\quad - &= \frac{\mathrm{i} \fmslash{p} + m}{p^2-m^2+\mathrm{i}\epsilon} - \end{align} - \end{subequations} - Three point vertices (no momenta necessary here) - \begin{subequations} - \begin{align} - \parbox{21mm}{% - \hfil\\\hfil\\ - \begin{fmfgraph*}(20,15) - \fmfleft{p1}\fmfright{p2,p3} - \fmflabel{$A$}{p1} - \fmflabel{$A$}{p2} - \fmflabel{$A$}{p3} - \fmf{dashes}{p1,v} - \fmf{dashes}{p2,v,p3} - \fmfdot{v} - \end{fmfgraph*}\\ - \hfil}\qquad\quad - &= -\dfrac{3\ii}{\sqrt{2}} m \lambda \\ - \parbox{21mm}{% - \hfil\\\hfil\\ - \begin{fmfgraph*}(20,15) - \fmfleft{p1}\fmfright{p2,p3} - \fmflabel{$A$}{p1} - \fmflabel{$B$}{p2} - \fmflabel{$B$}{p3} - \fmf{dashes}{p1,v} - \fmf{dbl_dashes}{p2,v,p3} - \fmfdot{v} - \end{fmfgraph*}\\ - \hfil}\qquad\quad - &= -\dfrac{\ii}{\sqrt{2}} m \lambda \\ - \parbox{21mm}{% - \hfil\\\hfil\\ - \begin{fmfgraph*}(20,15) - \fmfleft{p1}\fmfright{p2,p3} - \fmflabel{$A$}{p1} - \fmflabel{$\Psi$}{p2} - \fmflabel{$\Psi$}{p3} - \fmf{dashes}{p1,v} - \fmf{plain}{p2,v,p3} - \fmfdot{v} - \end{fmfgraph*}\\ - \hfil}\qquad\quad - &= -\dfrac{\ii}{\sqrt{2}} \lambda \\ - \parbox{21mm}{% - \hfil\\\hfil\\ - \begin{fmfgraph*}(20,15) - \fmfleft{p1}\fmfright{p2,p3} - \fmflabel{$B$}{p1} - \fmflabel{$\Psi$}{p2} - \fmflabel{$\Psi$}{p3} - \fmf{dbl_dashes}{p1,v} - \fmf{plain}{p2,v,p3} - \fmfdot{v} - \end{fmfgraph*}\\ - \hfil}\qquad\quad - &= -\dfrac{1}{\sqrt{2}} \lambda \gamma^5 - \end{align} - \end{subequations} - Four point vertices - \begin{subequations} - \begin{align} - \parbox{21mm}{% - \hfil\\\hfil\\ - \begin{fmfgraph*}(20,15) - \fmfleft{p1,p2}\fmfright{p3,p4} - \fmflabel{$A$}{p1} - \fmflabel{$A$}{p2} - \fmflabel{$A$}{p3} - \fmflabel{$A$}{p4} - \fmf{dashes}{p1,v,p2} - \fmf{dashes}{p3,v,p4} - \fmfdot{v} - \end{fmfgraph*}\\ - \hfil}\qquad\quad - &= - \dfrac{3\ii}{2} \lambda^2\\ - \parbox{21mm}{% - \hfil\\\hfil\\ - \begin{fmfgraph*}(20,15) - \fmfleft{p1,p2}\fmfright{p3,p4} - \fmflabel{$B$}{p1} - \fmflabel{$B$}{p2} - \fmflabel{$B$}{p3} - \fmflabel{$B$}{p4} - \fmf{dbl_dashes}{p1,v,p2} - \fmf{dbl_dashes}{p3,v,p4} - \fmfdot{v} - \end{fmfgraph*}\\ - \hfil}\qquad\quad - &= - \dfrac{3\ii}{2} \lambda^2\\ - \parbox{21mm}{% - \hfil\\\hfil\\ - \begin{fmfgraph*}(20,15) - \fmfleft{p1,p2}\fmfright{p3,p4} - \fmflabel{$A$}{p1} - \fmflabel{$A$}{p2} - \fmflabel{$B$}{p3} - \fmflabel{$B$}{p4} - \fmf{dashes}{p1,v,p2} - \fmf{dbl_dashes}{p3,v,p4} - \fmfdot{v} - \end{fmfgraph*}\\ - \hfil}\qquad\quad - &= - \dfrac{\ii}{2} \lambda^2 - \end{align} - \end{subequations} *) - -(* \subsection*{Conserved Current} *) - -(* \begin{multline} - \mathcal{L}\lbrack J_{3/2} \rbrack = - J_{3/2}^\mu \biggl\{ \ii \left( (\ii \fmslash{\partial} - m) A \right) - \gamma^\mu \Psi + \left( (\ii \fmslash{\partial} + m) B \right) - \gamma^5 \gamma^\mu \Psi \\ - \dfrac{\ii \lambda}{2 \sqrt{2}} - \gamma^\mu \left( A^2 - B^2 \right) \Psi - \dfrac{\lambda}{\sqrt{2}} - \gamma^\mu \gamma^5 A B \Psi \biggr\} - \end{multline} *) - - type constant = - | Unity | Lambda | M | MJ - | WA | WB | WP | WJ - | G3_SSS | G3_APP | G3_BPP - | G4_SSSS - let constant_symbol = function - | Unity -> "unity" | Lambda -> "l" - | M -> "m" | MJ -> "mj" - | WA -> "wa" | WB -> "wb" | WP -> "wp" | WJ -> "wj" - | G3_SSS -> "gsss" | G3_APP -> "gapp" | G3_BPP -> "g3_bpp" - | G4_SSSS -> "gssss" - - let vertices () = - ([(A, A, A), Scalar_Scalar_Scalar 3, G3_SSS; - (A, B, B), Scalar_Scalar_Scalar 1, G3_SSS; - (Psi, A, Psi), FBF (1, Chibar, S, Chi), G3_APP; - (Psi, B, Psi), FBF (1, Chibar, P, Chi), G3_BPP; - (J, A, Psi), GBG (1, Gravbar, S, Chi), Unity; - (J, B, Psi), GBG (1, Gravbar, P, Chi), Unity], - [(A, A, A, A), Scalar4 3, G4_SSSS; - (B, B, B, B), Scalar4 3, G4_SSSS; - (A, A, B, B), Scalar4 1, G4_SSSS; - (J, A, A, Psi), GBBG (1, Gravbar, S2, Chi), Unity; - (J, B, B, Psi), GBBG (1, Gravbar, S2, Chi), Unity; - (J, A, B, Psi), GBBG (1, Gravbar, S2, Chi), Unity], - []) - - let parameters () = - { input = [Lambda, 1.0; M, 1.0; MJ, 0.0; WJ, 0.0]; - derived = - [ Complex Unity, Const 1; - Real WA, Const 0; Real WB, Const 0; - Real G3_SSS, Neg (Quot (Prod [Atom M; Atom Lambda], - Sqrt (Const 2))); - Real G3_APP, Neg (Atom Lambda); - Complex G3_BPP, Prod [I; Atom Lambda]; - Real G4_SSSS, Neg (Quot (Prod [Atom Lambda; Atom Lambda], Const 2))]; - derived_arrays = [] } - - module F = Models.Fusions (struct - type f = flavor - type c = constant - let compare = compare - let conjugate = conjugate - end) - let table = F.of_vertices (vertices ()) - let fuse2 = F.fuse2 table - let fuse3 = F.fuse3 table - let fuse = F.fuse table - let max_degree () = 3 - - let pdg = function - | A -> 1 | B -> 2 | J -> 0 | Psi -> 3 - let mass_symbol = function - | A -> "ma" | B -> "mb" | J -> "mj" | Psi -> "mp" - let width_symbol = function - | A -> "wa" | B -> "wb" | J -> "wj" | Psi -> "wp" - end - -(* \subsection*{Equations of Motion} *) - -(* The equations of motion and the conservation of the Noether current have - been shown in J. Reuter: Supersymmetric Ward identities, unpublished. - Conserved charge generates the SUSY transformations of the fields - \begin{subequations} - \begin{align} - \lbrack \overline{\xi} Q, A \rbrack &= \ii \left( \overline{\xi} \Psi - \right) \\ \lbrack \overline{\xi} Q,B \rbrack &= \ii \left( \ii - \overline{\xi} \gamma^5 \Psi \right) - \end{align} - \end{subequations} - For the transformation of the fermions it is more comfortable to write - the charge in the following form - \begin{multline} - \overline{Q} \xi = \int d^3 \vec{x} \biggl\{ \ii \overline{\Psi} \gamma^0 - (\ii \fmslash{\partial} + m) A(x) - \overline{\Psi} \gamma^0 - (\ii \fmslash{\partial} + m) B(x) \gamma^5 \\ + - \dfrac{\ii \lambda}{2\sqrt{2}} \overline{\Psi} \gamma^0 \left( A^2 (x) - - B^2 (x) \right) - \dfrac{\lambda}{\sqrt{2}} A(x) B(x) \gamma^0 \gamma^5 - \biggr\} \xi - \end{multline} - and to use the identity $\overline{\xi} Q = \overline{Q} \xi$ to show - \begin{equation} - \lbrack \overline{\xi} Q , \Psi \rbrack = - \ii \left( \ii - \fmslash{\partial} + m\right) (A + \ii \gamma^5 B) \xi - - \dfrac{\ii \lambda}{2\sqrt{2}} \left( A^2 - B^2 \right) \xi + - \dfrac{\lambda}{\sqrt{2}} A B \gamma^5 \xi - \end{equation} - Some remarks about that (nonlinear) transformation. On-shell only the - one-particle-pole contributes. But for off-shell Ward identities the - nonlinear terms give nonvanishing contributions in contact terms arising - from the derivatives acting on the time ordering. The right method to - handle that difficulty is to define local operator insertions for every - nonlinear term appearing in the transformations. -*) - -(* \subsection*{Ward Identities} *) - -(* On shell current matrix elements - \begin{multline} - J_\mu(p_1,p_2) = \Braket{0|\mathcal{J}_\mu(x)|A (p_1) \Psi(p_2)} \\ = - \Braket{0|\mathcal{J}_\mu(x)|A(p_1)\Psi(p_2)}_{(0)} + \mathcal{O} - (g) \sim - \left(\fmslash{p}_1 - m\right) \gamma_\mu u(p_2) + - \mathcal{O} (g) - \end{multline} - \begin{equation} - (p_1+p_2)^\mu J_\mu(p_1,p_2) = - \left(\fmslash{p}_1 - m\right) - \left(\fmslash{p}_1 + \fmslash{p}_2 \right) u(p_2) + \mathcal{O} (g) = - \mathcal{O} (g) - \end{equation} - Also for off-shell Green functions (from now on we take $\overline{\xi} - \mathcal{J}_\mu$ instead of $\mathcal{J}_\mu$ to deal with a bosonic - operator) - \begin{multline} - \frac{\partial}{\partial x_\mu} - \Braket{0|\mathrm{T}\overline{\xi}\mathcal{J}_\mu(x)A(y)\Psi(z)|0} = - \delta(x_0-y_0) \Braket{0|\mathrm{T}\lbrack \overline{\xi} - \mathcal{J}_0(x),A(y) \rbrack \Psi(z)|0} \\ - + \delta(x_0-z_0) \Braket{0|\mathrm{T}A(y)\lbrack \overline{\xi} - \mathcal{J}_0(x), \Psi(z) \rbrack |0} - + \Braket{0|\mathrm{T}\partial^\mu \overline{\xi} \mathcal{J}_\mu(x) - A(y)\Psi(z)|0} - \end{multline} - where the last term vanishes for conserved supersymmetry or purely - spontaneous symmetry breaking (no explicit breaking). Assuming for all - fields~$\phi$ - \begin{equation} - \lbrack \overline{\xi} \mathcal{J}_0(x),\phi(y) \rbrack - \Bigr\vert_{x_0=y_0} - = \delta^3(\vec x - \vec y) \lbrack \overline{\xi}Q,\phi(y) \rbrack - \end{equation} - this reads - \begin{multline} - \delta^4(x-y) \Braket{0|\mathrm{T}\lbrack \overline{\xi} Q, A(y) - \rbrack \Psi(z)|0} - + \delta^4(x-z) \Braket{0|\mathrm{T}A(y)\lbrack \overline{\xi} Q,\Psi(z) - \rbrack |0} = \\ - \frac{\partial}{\partial x_\mu} - \Braket{0|\mathrm{T}\overline{\xi} \mathcal{J}_\mu(x)A(y)\Psi(z)|0} - - \Braket{0|\mathrm{T}\partial^\mu \overline{\xi} \mathcal{J}_\mu(x) - A(y)\Psi(z)|0} - \end{multline} - Integrated (zero-momentum insertion, i.e. Fourier-transformation with zero - momentum) - \begin{multline} - \Braket{0|\mathrm{T}\lbrack \overline{\xi}Q,A(y) \rbrack\Psi(z)|0} - + \Braket{0|\mathrm{T}A(y)\lbrack \overline{\xi}Q,\Psi(z) \rbrack |0} = - \Braket{0|\mathrm{T}\lbrack \overline{\xi}Q,A(y)\Psi(z) \rbrack |0} = \\ - \int\!\mathrm{d}^4x\, \frac{\partial}{\partial x_\mu} - \Braket{0|\mathrm{T}\overline{\xi}\mathcal{J}_\mu(x)A(y)\Psi(z)|0} - - \int\!\mathrm{d}^4x - \Braket{0|\mathrm{T}\partial^\mu \overline{\xi}\mathcal{J}_\mu(x)A(y)\Psi(z)|0} - \end{multline} - where the first term does \emph{not} vanish in the case of zero momentum - for spontaneous symmetry breaking, because massless Goldstone boson states - give a contribution at infinity. We are here dealing with exact - supersymmetry, so the second term on the r.h.s. of the former equation is - zero, but we won't set the momentum of the current to zero at the moment. - E.\,g.: - \begin{multline} - \delta^4(y-x_1) \Braket{0|\mathrm{T}\lbrack \overline{\xi}Q,A(x_1) \rbrack \Psi(x_2)|0} - + \delta^4(y-x_2) \Braket{0|\mathrm{T}A(x_1)\lbrack \overline{\xi}Q,\Psi(x_2) \rbrack |0} \\ - = \ii - \delta^4(y-x_1) \Braket{0|\mathrm{T}\Psi(x_2)\overline{\Psi}(x_1)\xi|0} - -\ii \delta^4(y-x_2) \Braket{0|\mathrm{T}A(x_1) (\ii \fmslash{\partial} + - m) A(x_2)\xi|0} \\ - = \partial^\mu_y - \Braket{0|\mathrm{T}\mathcal{J}_\mu(y)A(x_1)\Psi(x_2)|0} = \ii - \partial^\mu_y \Braket{0|\mathrm{T} \Psi(x_2) - \overline{\Psi}(y) \gamma_\mu A(x_1) (\ii\fmslash{\partial}_y + m)A(y) - \xi |0} - \end{multline} - in tree approximation in configuration space - \begin{multline} - \ii \delta^4(y-x_1) S_F(x_2-x_1)\xi -\ii \delta^4(y-x_2) - \left(\ii \fmslash{\partial}_{x_2} + m\right )D_F (x_1-x_2)\xi \\ - = \ii \partial^\mu_y \biggl\{ - S_F(x_2-y) \gamma_\mu \: (\ii \fmslash{\partial}_y + m) D_F(x_1-y)\xi - \biggr\} - \end{multline} - Inserting the expressions for the fermion and boson propagators (remember - that all particles here are massless) - \begin{align} - D_F (x-y) &= \; \int \dfrac{d^4 k_1}{(2\pi)^4} \dfrac{\ii e^{-\ii k_1 - (x-y)}}{k_1^2 + \ii \epsilon} \\ - S_F (x-y) &= \; \int \dfrac{d^4 k_2}{(2\pi)^4} \dfrac{\ii e^{-\ii k_2 - (x-y)}}{\fmslash{k}_2 + \ii \epsilon} - \end{align} - in tree approximation in momentum space - \begin{multline} - \mbox{} \left( \dfrac{\ii(-\ii)}{\fmslash{p}_2+m} + \dfrac{\ii(-\ii) - (\fmslash{p}_1+m)}{p_1^2-m^2} \right) \xi \\ = \left( p_1 + p_2 - \right)^\mu \biggl\{ S_F(x_2-y) \gamma_\mu \: (\ii \fmslash{\partial}_y - + m) D_F(x_1-y)\xi\biggr\} \\ = - \ii (-\ii) \dfrac{1}{p_1^2-m^2} \dfrac{1}{\fmslash{p}_2+m} - (\fmslash{p}_1 + \fmslash{p}_2) (\fmslash{p}_1 + m) \xi = + \left( - \dfrac{1}{\fmslash{p}_2+m} + - \dfrac{\fmslash{p}_1+m}{p_1^2-m^2} \right) \xi - \end{multline} - Some words about the signs: The momentum flux always goes from the right - spacetime event argument of the propagator to the left. In our case the two - propagators $S_F$ and $D_F$ have the exponentials $\exp(\ii p_2(x_2-y)$ and - $\exp(\ii p_1 (x_1-y)$ respectively. The sign of the derivative of the - current can be understood as the derivative acts on a field operator - inserted in the amplitude and not on a field in an interaction vertex. *) - -(* We now go to a more complex example: - \begin{subequations} - \begin{align} - \mathrm{F.T.} \Braket{0|\mathrm{T}\ii \overline{\xi} \Psi(x_1) - B(x_2)\Psi(x_3)|0} &= \dfrac{-\ii\lambda}{\sqrt{2}} - \dfrac{\ii}{p_2^2 - m^2} \dfrac{-\ii}{\fmslash{p}_3+m} \gamma^5 - \dfrac{\ii}{\fmslash{p}_1 +\fmslash{k}-m} \xi - \end{align} - \begin{align} - \mathrm{F.T.} \Braket{0|\mathrm{T}A(x_1)(-\overline{\xi} \gamma^5 - \Psi (x_2))\Psi(x_3)|0} - &= \dfrac{\ii\lambda}{\sqrt{2}} \dfrac{\ii}{p_1^2-m^2} \dfrac{ - -\ii}{\fmslash{p}_3+m} \dfrac{\ii}{\fmslash{p}_2 + \fmslash{k} - m} - \gamma^5 \xi - \end{align} - \begin{multline} - \mathrm{F.T.} \Braket{0|\mathrm{T}A(x_1)B(x_2) \left( \ii - \fmslash{\partial}_{x_3} + m \right) B(x_3) \gamma^5 \xi|0} = \\ - \dfrac{-\ii m \lambda}{\sqrt{2}} \dfrac{\ii}{p_1^2-m^2} \dfrac{\ii}{ - p_2^2-m^2} \dfrac{\ii}{(p_3+k)^2-m^2} \left( -\fmslash{p}_3 - - \fmslash{k} + m \right) \gamma^5 \xi - \end{multline} - \begin{multline} - \mathrm{F.T.} \Braket{0|\mathrm{T}A(x_1)B(x_2) - \dfrac{\lambda}{\sqrt{2}} (A B) (x_3) \gamma^5 \xi|0} = \\ - \dfrac{\lambda}{\sqrt{2}} \dfrac{\ii}{p_1^2-m^2} \dfrac{\ii}{p^2-m^2} - \gamma^5 \xi - \end{multline} - \end{subequations} - - \vspace{0.5cm} - - Now we must evaluate the 4-point-function with the current insertion. - We rewrite the current $\overline{\xi} \mathcal{J}_\mu$ as - $\overline{\mathcal{J}_\mu} \xi$, which is identical due to the - Majorana properties of the current and the transformation parameter: - \begin{align} - \overline{\xi} \mathcal{J}_\mu = & \; \overline{\xi} - \biggl\{ \ii \left( (\ii \fmslash{\partial} - m) A \right) - \gamma_\mu \Psi + \left( (\ii \fmslash{\partial} + m) B \right) - \gamma^5 \gamma_\mu \Psi \\ &\qquad\qquad\qquad - - \dfrac{\ii \lambda}{2 \sqrt{2}} \gamma_\mu \left( A^2 - B^2 \right) - \Psi - \dfrac{\lambda}{\sqrt{2}} \gamma_\mu \gamma^5 A B \Psi - \biggr\} \notag - \\ = & \; \biggl\{ \overline{\Psi} \gamma_\mu \ii \left( \ii - \fmslash{\partial} + m\right) A - \overline{\Psi} \gamma_\mu - \left( \ii \fmslash{\partial} + m\right) B \gamma^5 \\ & - \qquad\qquad\qquad + \dfrac{\ii\lambda}{2\sqrt{2}} \overline{\Psi} - \gamma_\mu \left( - A^2 - B^2 \right) - \dfrac{\lambda}{\sqrt{2}} \overline{\Psi} - \gamma_\mu \gamma^5 A B \biggr\} \xi - \end{align} - This brings the propagator of the (matter) fermion to the farthest left. - There are four diagrams contributing to the process which we will list now: \begin{equation} - \parbox{21mm}{% - \begin{fmfgraph*}(20,20) - \fmfleft{i1,i2}\fmfright{o1,o2} - \fmf{plain}{o2,v2} - \fmf{dbl_dashes}{i2,v2} - \fmf{plain}{v1,v2} - \fmf{dbl_plain}{i1,v1} - \fmf{dashes}{o1,v1} - \fmfdot{v1,v2} - \fmfblob{.25w}{i1} - \end{fmfgraph*}}\qquad + \quad - \parbox{21mm}{% - \begin{fmfgraph*}(20,20) - \fmfleft{i1,i2}\fmfright{o1,o2} - \fmf{plain}{o2,v2} - \fmf{dashes}{i2,v2} - \fmf{plain}{v1,v2} - \fmf{dbl_plain}{i1,v1} - \fmf{dbl_dashes}{o1,v1} - \fmfdot{v1,v2} - \fmfblob{.25w}{i1} - \end{fmfgraph*}}\qquad + \quad - \parbox{21mm}{% - \begin{fmfgraph*}(20,20) - \fmfleft{i1,i2}\fmfright{o1,o2} - \fmf{dashes}{o2,v2} - \fmf{dbl_dashes}{i2,v2} - \fmf{dbl_dashes}{v1,v2} - \fmf{dbl_plain}{i1,v1} - \fmf{plain}{o1,v1} - \fmfdot{v1,v2} - \fmfblob{.25w}{i1} - \end{fmfgraph*}}\qquad + \quad - \parbox{21mm}{% - \begin{fmfgraph*}(20,20) - \fmfleft{i1,i2}\fmfright{o1,o2} - \fmf{plain}{o2,v} - \fmf{dashes}{i2,v} - \fmf{dbl_plain}{i1,v} - \fmf{dbl_dashes}{o1,v} - \fmfdot{v} - \fmfblob{.25w}{i1} - \end{fmfgraph*}}\qquad\quad - \end{equation} - - For the sign of the fermion propagator one has to take care of the flow of - momentum. - \begin{multline} - \mathrm{F.T.} \Braket{0|\mathrm{T}\overline{\mathcal{J}_\mu}(y) \xi A(x_1) - B(x_2)\Psi(x_3)|0} = \\ - \frac{\mathrm{i}}{p_1^2-m^2}\frac{\mathrm{i}}{p_2^2-m^2} - \dfrac{-\ii}{\fmslash{p}_3+m} \left( \mathrm{F.T.} \Braket{0|\mathrm{T} - \overline{\mathcal{J}_\mu} (y)A(x_1)B(x_2)\Psi(x_3)|0}_{\text{amp.}} - \right) \xi - \end{multline} - \begin{multline} - \mathrm{F.T.} \Braket{0|\mathrm{T}\overline{\mathcal{J}_\mu}(y) - A(x_1)B(x_2)\Psi(x_3)|0}_{\text{amp.}} \xi = - - \dfrac{\ii \lambda}{\sqrt{2}} \gamma^5 \dfrac{\ii}{\fmslash{p}_1 + - \fmslash{k}-m} \gamma_\mu \left( \fmslash{p}_1 + m \right) \xi \\ - + \dfrac{\ii\lambda}{\sqrt{2}} \dfrac{\ii}{\fmslash{p}_2 + \fmslash{k} - -m} \gamma_\mu \left( \fmslash{p}_2 + m\right) \gamma^5 \xi - - \dfrac{\lambda}{\sqrt{2}} \gamma_\mu \gamma^5 \xi - \\ - - \dfrac{\ii m \lambda}{\sqrt{2}} \dfrac{\ii}{(p_3 + k)^2 - m^2} - \gamma_\mu \left( \fmslash{p}_3 + \fmslash{k} - m \right) \gamma^5 \xi - \end{multline} - with $\partial_\mu\to\mathrm{i}k_\mu=-\mathrm{i}(p_1+p_2+p_3)_\mu$ - \begin{align} - & \; \dfrac{\ii}{\fmslash{p}_3+m} \dfrac{1}{(p_1^2-m^2)(p_2^2-m^2)} \; - \mathrm{F.T.} \partial_y^\mu \Braket{0|\mathrm{T} - \overline{\mathcal{J}_\mu}(y) A(x_1)B(x_2) - \Psi(x_3)|0}_{\text{amp.}} \xi \notag \\ = - & \; \dfrac{\ii}{\fmslash{p}_3+m} \dfrac{1}{(p_1^2-m^2)(p_2^2-m^2)} - \cdot \biggl\{ - \dfrac{\ii\lambda}{\sqrt{2}} \left( \fmslash{p}_1 + \fmslash{p}_2 + - \fmslash{p}_3 \right) \gamma^5 \xi \notag \\ & \; - - \dfrac{\ii\lambda}{\sqrt{2}} \gamma^5 \dfrac{1}{\fmslash{p}_1 + - \fmslash{k} - m} \left( \fmslash{p}_1 + \fmslash{p}_2 + \fmslash{p}_3 - \right) \left( \fmslash{p}_1 + m \right) \xi \notag \\ & \; - + \dfrac{\ii\lambda}{\sqrt{2}} \dfrac{1}{\fmslash{p}_2 + \fmslash{k} - -m} \left( \fmslash{p}_1 + \fmslash{p}_2 + \fmslash{p}_3 \right) \left( - \fmslash{p}_2 + m\right) \gamma^5 \xi \notag \\ & \; - - \dfrac{\ii m \lambda}{\sqrt{2}} \dfrac{1}{(p_3 + k)^2 - m^2} - \left( \fmslash{p}_1 + \fmslash{p}_2 + \fmslash{p}_3 \right) \left( - \fmslash{p}_3 + \fmslash{k} - m \right) \gamma^5 \xi \biggr\} - \notag - \end{align} - \begin{align} - = & \; \dfrac{\lambda}{\sqrt{2}} - \dfrac{1}{\fmslash{p}_3+m} \dfrac{1}{(p_1^2-m^2)(p_2^2-m^2)} - \cdot \biggl\{ - - \left( \fmslash{p}_1 + \fmslash{p}_2 + - \fmslash{p}_3 \right) \notag \\ & \; - + \dfrac{1}{\fmslash{p}_2 + - \fmslash{p}_3 - m} \left( \fmslash{p}_1 + \fmslash{p}_2 + \fmslash{p}_3 - \right) \left( \fmslash{p}_1 - m \right) \notag \\ & \; - + \dfrac{1}{\fmslash{p}_1 + \fmslash{p}_3 - +m} \left( \fmslash{p}_1 + \fmslash{p}_2 + \fmslash{p}_3 \right) \left( - \fmslash{p}_2 + m\right) \notag \\ & \; - - m \dfrac{1}{(p_1 + p_2)^2 - m^2} - \left( \fmslash{p}_1 + \fmslash{p}_2 + \fmslash{p}_3 \right) \left( - \fmslash{p}_1 + \fmslash{p}_2 + m \right) \biggr\} \gamma^5 \xi - \notag \\ - = & \; - - \dfrac{\lambda}{\sqrt{2}} \dfrac{1}{\fmslash{p}_3+m} \dfrac{1}{ - (p_1^2-m^2)(p_2^2-m^2)} \left( \fmslash{p}_1 + \fmslash{p}_2 + - \fmslash{p}_3 \right) \gamma^5 \xi \notag \\ & \; - + \dfrac{\lambda}{\sqrt{2}} \dfrac{1}{\fmslash{p}_3+m} \dfrac{1}{(p_1^2 - -m^2)(p_2^2-m^2)} \left( \fmslash{p}_1 - m \right) \gamma^5 \xi \notag - \\ & \; + \dfrac{\lambda}{\sqrt{2}} \dfrac{1}{\fmslash{p}_3+m} - \dfrac{1}{p_2^2-m^2} \dfrac{1}{\fmslash{p}_2 + \fmslash{p}_3-m} - \gamma^5 \xi \notag \\ & \; - + \dfrac{\lambda}{\sqrt{2}} \dfrac{1}{\fmslash{p}_3+m} \dfrac{1}{(p_1^2 - -m^2)(p_2^2-m^2)} \left(\fmslash{p}_2+m\right) \gamma^5 \xi \notag \\ - & \; + \dfrac{\lambda}{\sqrt{2}} \dfrac{1}{\fmslash{p}_3+m} \dfrac{1}{ - p_1^2-m^2} \dfrac{1}{\fmslash{p}_1+\fmslash{p}_3+m} \gamma^5 \xi \notag - \\ & \; - - \dfrac{m\lambda}{\sqrt{2}} \dfrac{1}{(p_1^2-m^2)(p_2^2-m^2)} - \dfrac{1}{(p_1 + p_2)^2 - m^2} \left( \fmslash{p}_1 + \fmslash{p}_2 - + m \right)\gamma^5 \xi \notag \\ & \; - \dfrac{m \lambda}{\sqrt{2}} - \dfrac{1}{\fmslash{p}_3+m} \dfrac{1}{(p_1^2-m^2)(p_2^2-m^2)} \gamma^5 - \xi - \end{align} - - The third, fifth and sixth term equal the ones from the linearly transformed - fields of the r.h.s.: - \begin{multline} - \dfrac{\lambda}{\sqrt{2}} \biggl\{ \dfrac{1}{p_2^2-m^2} \dfrac{1}{\fmslash{ - p}_3+m} \dfrac{1}{\fmslash{p}_2 + \fmslash{p}_3 - m} + \dfrac{1}{p_1^2- - m^2} \dfrac{1}{\fmslash{p}_3+m} \dfrac{1}{\fmslash{p}_1+\fmslash{p}_3 - +m} \\ - m \dfrac{1}{p_1^2-m^2} \dfrac{1}{p_2^2-m^2} \dfrac{1}{(p_1+p_2)^2 - -m^2} \left( \fmslash{p}_1 + \fmslash{p}_2 + m \right) \biggr\} \gamma^5 - \xi - \end{multline} - The remaining terms add up to: - \begin{multline} - \dfrac{\lambda}{\sqrt{2}} \dfrac{1}{(p_1^2-m^2)(p_2^2-m^2)} \dfrac{1}{ - \fmslash{p}_3 +m} \biggl\{ - \fmslash{p}_1 - \fmslash{p}_2 - \fmslash{p}_3 - + \fmslash{p}_1 - m + \fmslash{p}_2 + m - m - \biggr\} \gamma^5 \xi \\ = - \dfrac{\lambda}{\sqrt{2}} \dfrac{1}{(p_1^2- - m^2)(p_2^2-m^2)} \gamma^5 \xi - \end{multline} - This is the one from the local operator insertion, and so the Ward identity - is fulfilled. - *) - -(* Caveat: the Ward identities for on-shell amplitudes do \emph{not} test - the theory comprehensively, since only the coupling of Goldstone bosons - and and currents to external lines. *) - -(* In the case with auxiliary fields: - \begin{equation} - \label{eq:kinvoll} - \begin{aligned} - {\cal L}_{WZ} = & \; \frac{1}{2} \partial_\mu A \partial^\mu A + \frac{1}{2} - \partial_\mu B \partial^\mu B + \frac{1}{2} \overline{\Psi} \left( \ii - \fmslash{\partial} - m \right) \Psi + \dfrac{1}{2} F^2 + \dfrac{1}{2} G^2 - \\ & \; - \dfrac{\lambda}{2 \sqrt{2}} - \overline{\Psi} \Psi A + \dfrac{\ii\lambda}{2 \sqrt{2}} \overline{\Psi} - \gamma^5 \Psi B + m A F + m B G \\ & \; + \dfrac{\lambda}{2\sqrt{2}} A^2 F - - \dfrac{\lambda}{2\sqrt{2}} B^2 F + \dfrac{\lambda}{\sqrt{2}} A B G - \end{aligned} -\end{equation} -The current is the same - with or without auxiliary fields - because the -auxiliary fields cancel each other in the construction of the current. -As one can easily see the current generates the SUSY transformations -automatically with the equations of motion for the auxiliary fields inserted. -The real problem seems to be that the algebra implemented on the fields does -not close off-shell but needs insertion of the equations of motion of all -fields. So using the formalism without the auxiliary fields integrated out in -the path integral seems just to split the scalar component fields from their -mass terms. The additional diagrams with the auxiliary fields only add the -masses for the scalar fields and make them equal the masses of the fermionic -component fields. - -The equations of motion of the scalar and pseudoscalar auxiliary fields are: -\begin{equation} -F = - m A - \dfrac{\lambda}{2\sqrt{2}} \left( A^2 - B^2 \right) , \qquad -G = - m B - \dfrac{\lambda}{\sqrt{2}} A B -\end{equation} *) - -module Main = Omega.Make(Fusion.Mixed23_Majorana) - (Targets.Fortran_Majorana)(WZ) -let _ = Main.main () - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Index: branches/ohl/omega-development/completed/whizard2/extensions/people/jr/main3.tex =================================================================== --- branches/ohl/omega-development/completed/whizard2/extensions/people/jr/main3.tex (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/extensions/people/jr/main3.tex (revision 8703) @@ -1,42 +0,0 @@ -% $Id: main3.tex,v 1.1 2004/04/09 20:11:16 ohl Exp $ -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\documentclass[12pt]{article} -\usepackage{ocamlweb} -\usepackage{amsmath,amssymb,thophys} -\setlength{\parindent}{0pt} -\usepackage{feynmp} -\setlength{\unitlength}{1mm} -\newcommand{\ii}{\mathrm{i}} -\begin{document} -\begin{fmffile}{main3pics} -\input{f90_WZ.implementation} -%%%\begin{figure} -%%%\def\F#1#2{\fmfi{dots}{.8[vloc(__v),vloc(__#1)] -- .8[vloc(__v),vloc(__#2)]}} -%%%\def\D#1{\parbox{35mm}{% -%%% \begin{fmfgraph}(35,35) -%%% \fmfleft{s}\fmfrightn{f}{4} -%%% \fmfbottomn{b}{4}\fmfforce{c}{v} -%%% \fmfv{dec.shape=circle,dec.fill=0,dec.size=.35w}{v} -%%% \fmfv{dec.shape=tetragram,dec.fill=1,dec.size=3thick}{f3,f4,b2,b3} -%%% \fmf{fermion}{f4,v,f3} -%%% \fmf{fermion}{f2,v,f1} -%%% \fmf{photon}{b2,v,b3} -%%% \fmffreeze #1 -%%% \F{f1}{f2}\F{f3}{f4}\F{b2}{b3} -%%% \end{fmfgraph}}} -%%%\begin{multline} -%%% \D{\fmf{dashes}{s,v}}\\ -%%% =\D{\fmfi{dashes}{% -%%% vloc(__s){vloc(__v)-vloc(__s)} -%%% .. .5[vloc(__s),vloc(__f4)] .. -%%% {vloc(__f4)-vloc(__v)} vloc(__f4)}} -%%% +\cdots+\D{\fmfi{dashes}{% -%%% vloc(__s){vloc(__v)-vloc(__s)} -%%% .. .5[vloc(__s),vloc(__f4)] .. -%%% {vloc(__f3)-vloc(__v)} vloc(__f3)}} -%%%\end{multline} -%%% \caption{\label{fig:WI}% -%%% Ward identities} -%%%\end{figure} -\end{fmffile} -\end{document} Index: branches/ohl/omega-development/completed/whizard2/extensions/people/jr/main4.tex =================================================================== --- branches/ohl/omega-development/completed/whizard2/extensions/people/jr/main4.tex (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/extensions/people/jr/main4.tex (revision 8703) @@ -1,42 +0,0 @@ -% $Id: main4.tex,v 1.1 2004/04/09 20:11:16 ohl Exp $ -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\documentclass[12pt]{article} -\usepackage{ocamlweb} -\usepackage{amsmath,amssymb,thophys} -\setlength{\parindent}{0pt} -\usepackage{feynmp} -\setlength{\unitlength}{1mm} -\newcommand{\ii}{\mathrm{i}} -\begin{document} -\begin{fmffile}{main4pics} -\input{f90_SQCD.implementation} -%%%\begin{figure} -%%%\def\F#1#2{\fmfi{dots}{.8[vloc(__v),vloc(__#1)] -- .8[vloc(__v),vloc(__#2)]}} -%%%\def\D#1{\parbox{35mm}{% -%%% \begin{fmfgraph}(35,35) -%%% \fmfleft{s}\fmfrightn{f}{4} -%%% \fmfbottomn{b}{4}\fmfforce{c}{v} -%%% \fmfv{dec.shape=circle,dec.fill=0,dec.size=.35w}{v} -%%% \fmfv{dec.shape=tetragram,dec.fill=1,dec.size=3thick}{f3,f4,b2,b3} -%%% \fmf{fermion}{f4,v,f3} -%%% \fmf{fermion}{f2,v,f1} -%%% \fmf{photon}{b2,v,b3} -%%% \fmffreeze #1 -%%% \F{f1}{f2}\F{f3}{f4}\F{b2}{b3} -%%% \end{fmfgraph}}} -%%%\begin{multline} -%%% \D{\fmf{dashes}{s,v}}\\ -%%% =\D{\fmfi{dashes}{% -%%% vloc(__s){vloc(__v)-vloc(__s)} -%%% .. .5[vloc(__s),vloc(__f4)] .. -%%% {vloc(__f4)-vloc(__v)} vloc(__f4)}} -%%% +\cdots+\D{\fmfi{dashes}{% -%%% vloc(__s){vloc(__v)-vloc(__s)} -%%% .. .5[vloc(__s),vloc(__f4)] .. -%%% {vloc(__f3)-vloc(__v)} vloc(__f3)}} -%%%\end{multline} -%%% \caption{\label{fig:WI}% -%%% Ward identities} -%%%\end{figure} -\end{fmffile} -\end{document} Index: branches/ohl/omega-development/completed/whizard2/dist_tool =================================================================== --- branches/ohl/omega-development/completed/whizard2/dist_tool (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/dist_tool (revision 8703) @@ -1,262 +0,0 @@ -#! /bin/sh -# $Id: dist_tool,v 1.9 2004/06/22 16:00:10 ohl Exp $ -######################################################################## - -######################################################################## -# INSTALLATION DEPENDENT SETUP SCRIPTS -######################################################################## - -set_first_match () { - var="$1" - shift - eval unset "$var" - while test $# -gt 0; do - if test -f "$1"; then - eval "$var"="$1" - break - fi - shift - done -} - -set_first_match setup_ifc \ - /usr/local/intel/compiler70/ia32/bin/ifcvars.sh \ - /opt/intel/compiler70/ia32/bin/ifcvars.sh - -set_first_match setup_ifort \ - /usr/local/OHL/intel8/bin/ifortvars.sh \ - /opt/intel_fc_80/bin/ifortvars.sh - -set_first_match setup_lf95 \ - /usr/local/OHL/lf9561/bash_setup \ - /opt/lahey/lf9561/bash_setup - -######################################################################## - -cmdline="$*" - -test -n "$1" || { echo "usage: $0 action [options]" 1>&2; exit 1; } -action="$1" -shift - -arch=`./config.guess` -version=000.000alpha - -make=make -configure_options= -while test -n "$1"; do - case "$1" in - -V) version="$2"; shift;; - -a) arch="$2"; shift;; - -m) make="$2"; shift;; - -c) configure_options="$configure_options $2"; shift;; - *) files="$files $1";; - esac - shift -done - -sandbox=`pwd`/dists - -dist_dir=omega-$version -dist_tmp=$dist_dir.tmp -dist_tar=$dist_dir.tar.gz - -######################################################################## - -######################################################################## -# Make(1) all files given as argument, -# visiting directories in undefined order. -######################################################################## - -make_all () { - file_list="$*" - dir_list=`echo $file_list | tr ' ' '\n' | sed -n 's|/[^/]*$||p' | sort -u` - $make `echo $file_list | tr ' ' '\n' | grep -v /` - for d in $dir_list; do - $make -C $d `echo $file_list | tr ' ' '\n' | sed -n "s|^$d/||p"` - done -} - -fresh_dir () { - for d in "$@"; do - rm -fr "$d" - mkdir "$d" - done -} - -copy_to () { - dest_dir="$1" - shift - fresh_dir $dest_dir - tar cf - "$@" | tar xf - -C "$dest_dir" -} - -######################################################################## -# Pack the current contents of the directiory tree -######################################################################## - -do_pack () { - $make depend depend_f95 - make_all $files - copy_to $sandbox/$dist_dir $files - ( cd $sandbox || exit 1 - echo "O'Mega $version `date -u +%Y/%m/%d`" > $dist_dir/VERSION - tar czf $dist_tar $dist_dir - rm -rf $dist_dir - ) -} - -######################################################################## -# Pack the contents of the current CVS head revision -######################################################################## - -do_pack_cvs () { - ( cd $sandbox || exit 1 - rm -fr $dist_tmp - cvs export -D today -kkv -d $dist_tmp omega - ( cd $dist_tmp - autoconf - ./configure - do_pack - ) - rm -rf $dist_tmp - ) -} - -######################################################################## -# Perform some tests -######################################################################## - -do_test () { - ( cd $sandbox || exit 1 - rm -fr $dist_dir - tar xzf $dist_tar - ( cd $dist_dir - ./configure $configure_options "$@" - $make bin - $make opt - $make f95 - ./arch/$arch/bin/test_omega95 - ./arch/$arch/bin/test_omega95_bispinors - if test -d tests/SM; then - ( cd tests/SM - ulimit -s unlimited - $make main4 - $make main5 - $make main6 - $make main7 - $make main8 - $make run4 - $make run5 - $make run6 - $make run7 - $make run8 - ) - fi - if test -f web/Makefile; then - $make ps - fi - ) - rm -fr $dist_dir - ) -} - -######################################################################## -# Perform some tests for Intel Fortran 8.0+ -######################################################################## - -do_test_ifort () { - if test -n "$setup_ifort"; then - ( F95=ifort - export F95 - source $setup_ifort - do_test "$@" - ) - fi -} - -######################################################################## -# Perform some tests for Intel Fortran 7.0 -######################################################################## - -do_test_ifc () { - if test -n "$setup_ifc"; then - ( F95=ifc - export F95 - source $setup_ifc - do_test "$@" - ) - fi -} - -######################################################################## -# Perform some tests for Lahey Fortran 95 -######################################################################## - -do_test_lf95 () { - if test -n "$setup_lf95"; then - ( F95=lf95 - export F95 - source $setup_lf95 - do_test "$@" - ) - fi -} - -######################################################################## - -banner_begin () { - echo "<<< BEGIN $cmdline >>>" -} - -banner_end () { - echo "<<< END $cmdline >>>" -} - -######################################################################## - -case $action in - - pack) - do_pack - ;; - - pack_cvs) - do_pack_cvs - ;; - - test_*ifort) - banner_begin - do_test_ifort - banner_end - ;; - - test_*ifc) - banner_begin - do_test_ifc - banner_end - ;; - - test_*lf95) - banner_begin - do_test_lf95 - banner_end - ;; - - test_*all) - banner_begin - do_test_ifort - do_test_ifc - do_test_lf95 - banner_end - ;; - - test*) - banner_begin - do_test - banner_end - ;; - -esac - -######################################################################## Index: branches/ohl/omega-development/completed/whizard2/tools/testbed_old.f95 =================================================================== --- branches/ohl/omega-development/completed/whizard2/tools/testbed_old.f95 (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/tools/testbed_old.f95 (revision 8703) @@ -1,1585 +0,0 @@ -! $Id: testbed_old.f95,v 1.1 2004/04/09 20:11:17 ohl Exp $ - -module testbed_old - use kinds - use omega95 - use kinematics - use rambo - use omega_parameters - use omega_parameters_madgraph - implicit none - real(kind=default), parameter, private :: THRESHOLD_SIGMA = 1.0e-21_default - public :: read_parameters - public :: compare_sigma - public :: compare_squared - public :: compare - public :: compare_omega - public :: compare_omega_sum - public :: symmetry_omega - public :: check_omega - public :: ward_omega - public :: ward4 - public :: compare4_madgraph - public :: compare5_madgraph - public :: compare6_madgraph - public :: compare7_madgraph - public :: compare8_madgraph - public :: compare_sum4_madgraph - public :: compare_sum5_madgraph - public :: compare_sum6_madgraph - public :: compare_sum7_madgraph - public :: compare_sum8_madgraph - public :: check4_madgraph - public :: check5_madgraph - public :: check6_madgraph - public :: check7_madgraph - public :: check8_madgraph -contains - - subroutine read_parameters (roots, n, tolerance, mode) - real(kind=single), intent(out) :: roots - integer, intent(out) :: n, tolerance - character(len=8), intent(out) :: mode - real(kind=single) :: me, mw, gw, mz, gz, mt, gt, mh, gh - complex(kind=single) :: o1, o2, o3, o4, m1, m2, m3, m4 - namelist /options/ mode, n, tolerance, roots, me, mw, gw, mz, gz, & - mt, gt, mh, gh, o1, o2, o3, o4, m1, m2, m3, m4 - integer :: ios - character (len=128) :: cmd - call setup_parameters () - mode = "compare" - n = 10 - tolerance = 10000 - roots = 800 - me = mass(11) - mz = mass(23) - gz = width(23) - mw = mass(24) - gw = width(24) - mt = mass(6) - gt = width(6) - mh = mass(25) - gh = width(25) - o1 = fudge_o1 - o2 = fudge_o2 - o3 = fudge_o3 - o4 = fudge_o4 - m1 = fudge_m1 - m2 = fudge_m2 - m3 = fudge_m3 - m4 = fudge_m4 - write (unit = *, nml = options) - open (unit = 42, status = "scratch") - cmds: do - read (unit = *, fmt = "(A)", iostat = ios) cmd - if (ios /= 0 .or. trim(cmd) == "") exit cmds - rewind (unit = 42) - write (unit = 42, fmt = "('&options ',A,'/')") cmd - rewind (unit = 42) - read (unit = 42, nml = options) - end do cmds - close (unit = 42) - write (unit = *, nml = options) - mass(11) = me - mass(23) = mz - width(23) = gz - mass(24) = mw - width(24) = gw - mass(6) = mt - width(6) = gt - mass(25) = mh - width(25) = gh - fudge_o1 = o1 - fudge_o2 = o2 - fudge_o3 = o3 - fudge_o4 = o4 - fudge_m1 = m1 - fudge_m2 = m2 - fudge_m3 = m3 - fudge_m4 = m4 - end subroutine read_parameters - - subroutine compare_sigma (n1, s1, n2, s2, threshold, tolerance) - real(kind=default), intent(in) :: s1, s2 - character(len=*), intent(in) :: n1, n2 - real(kind=default), intent(in) :: threshold - integer, intent(in), optional :: tolerance - real(kind=default) :: ds, tolerance_local - if (present (tolerance)) then - tolerance_local = tolerance * epsilon (tolerance_local) - else - tolerance_local = 1000 * epsilon (tolerance_local) - end if - if (max (s1, s2) >= threshold) then - ds = abs (s1 - s2) / (s2 + s2) - if (ds > tolerance_local) then - write (unit = *, fmt = & - "(2(2X,A1,': ',E17.10), 2X,A2,1X,E8.2, 1X,A1,1X,E8.2, A4)") & - n1, s1, n2, s2, "d=", ds, "=", ds / epsilon (ds), "*eps" - end if - end if - end subroutine compare_sigma - - subroutine compare_squared (n1, s1, n2, s2, s, threshold, tolerance) - real(kind=default), intent(in) :: s1, s2 - character(len=*), intent(in) :: n1, n2 - integer, dimension(:), intent(in) :: s - real(kind=default), intent(in) :: threshold - integer, intent(in), optional :: tolerance - real(kind=default) :: ds, tolerance_local - character(len=2) :: num - if (present (tolerance)) then - tolerance_local = tolerance * epsilon (tolerance_local) - else - tolerance_local = 1000 * epsilon (tolerance_local) - end if - if (max (s1, s2) >= threshold) then - ds = abs (s1 - s2) / (s1 + s2) - if (ds > tolerance_local) then - write (unit = num, fmt = "(I2)") size (s) - write (unit = *, fmt = "(" // num // & - "I3, 2(2X,A1,': ',E17.10), 2X,A2,1X,E8.2, 1X,A1,1X,E8.2, A4)") & - s, n1, s1, n2, s2, "d=", ds, "=", ds / epsilon (ds), "*eps" - end if - end if - end subroutine compare_squared - - subroutine compare (n1, a1, n2, a2, s, threshold, tolerance) - complex(kind=default), intent(in) :: a1, a2 - character(len=*), intent(in) :: n1, n2 - integer, dimension(:), intent(in) :: s - real(kind=default), intent(in) :: threshold - integer, intent(in), optional :: tolerance - real(kind=default) :: ds, tolerance_local - character(len=2) :: num - if (present (tolerance)) then - tolerance_local = tolerance * epsilon (tolerance_local) - else - tolerance_local = 1000 * epsilon (tolerance_local) - end if - if (max (abs (a1), abs (a2)) >= threshold) then - ds = abs (a1 - a2) / (abs (a1) + abs (a2)) - if (ds > tolerance_local) then - write (unit = num, fmt = "(I2)") size (s) - write (unit = *, fmt = "(" // num // & - "I3, 2(2X,A1,': (',E10.3,',',E10.3,')'), 2X,A2,1X,E8.2, 1X,A1,1X,E8.2, A3)") & - s, n1, a1, n2, a2, "d=", ds, "=", ds / epsilon (ds), "eps" - end if - end if - end subroutine compare - - subroutine compare_omega (n, omega1, omega2, roots, masses, states, tolerance) - integer, intent(in) :: n - real(kind=default), intent(in) :: roots - real(kind=default), dimension(:), intent(in) :: masses - integer, dimension(:), intent(in), optional :: states - integer, intent(in), optional :: tolerance - interface - pure function omega1 (p, s) result (m) - use kinds - implicit none - complex(kind=default) :: m - real(kind=default), dimension(0:,:), intent(in) :: p - integer, dimension(:), intent(in) :: s - end function omega1 - pure function omega2 (p, s) result (m) - use kinds - implicit none - complex(kind=default) :: m - real(kind=default), dimension(0:,:), intent(in) :: p - integer, dimension(:), intent(in) :: s - end function omega2 - end interface - integer :: k, j - real(kind=default) :: threshold, threshold1, threshold2 - complex(kind=default) :: a1, a2 - real(kind=default), dimension(0:3,size(masses)) :: p - integer, dimension(size(masses)) :: s, nstates - if (present (states)) then - nstates = states - else - nstates = 2 - end if - call beams (roots, masses(1), masses(2), p(:,1), p(:,2)) - do k = 1, n - if (any (masses(3:) > 0)) then - call massive_decay (roots, masses(3:), p(:,3:)) - else - call massless_isotropic_decay (roots, p(:,3:)) - end if - threshold1 = omega_sum (omega1, p, states) & - / num_states (size(s) - 2, nstates(3:)) / 1000 - threshold2 = omega_sum (omega2, p, states) & - / num_states (size(s) - 2, nstates(3:)) / 1000 - threshold = max (threshold1, threshold2) - s = -1 - loop_spins: do - a1 = omega1 (p, s) - a2 = omega2 (p, s) - call compare ("1", a1, "2", a2, s, threshold, tolerance) - do j = size (masses), 1, -1 - select case (nstates (j)) - case (3) - s(j) = modulo (s(j) + 2, 3) - 1 - case (2) - s(j) = - s(j) - case (1) - s(j) = -1 - case default - s(j) = -1 - end select - if (s(j) /= -1) then - cycle loop_spins - end if - end do - exit loop_spins - end do loop_spins - end do - end subroutine compare_omega - - subroutine compare_omega_sum (n, omega1, omega2, roots, masses, states, tolerance) - integer, intent(in) :: n - real(kind=default), intent(in) :: roots - real(kind=default), dimension(:), intent(in) :: masses - integer, dimension(:), intent(in), optional :: states - integer, intent(in), optional :: tolerance - interface - pure function omega1 (p, s) result (m) - use kinds - implicit none - complex(kind=default) :: m - real(kind=default), dimension(0:,:), intent(in) :: p - integer, dimension(:), intent(in) :: s - end function omega1 - pure function omega2 (p, s) result (m) - use kinds - implicit none - complex(kind=default) :: m - real(kind=default), dimension(0:,:), intent(in) :: p - integer, dimension(:), intent(in) :: s - end function omega2 - end interface - integer :: k - real(kind=default) :: s1, s2 - real(kind=default), dimension(0:3,size(masses)) :: p - integer, dimension(:), allocatable :: zero - allocate (zero(num_states(size(masses),states))) - call beams (roots, masses(1), masses(2), p(:,1), p(:,2)) - zero = 0 - do k = 1, n - if (any (masses(3:) > 0)) then - call massive_decay (roots, masses(3:), p(:,3:)) - else - call massless_isotropic_decay (roots, p(:,3:)) - end if - call omega_sum_nonzero (s1, omega1, p, zero, k, states) - call omega_sum_nonzero (s2, omega2, p, zero, k, states) - call compare_sigma ("1", s1, "2", s2, THRESHOLD_SIGMA, tolerance) - end do - deallocate (zero) - end subroutine compare_omega_sum - - subroutine symmetry_omega (n, omega, roots, masses, sign, n1, n2, states, tolerance) - integer, intent(in) :: n - real(kind=default), intent(in) :: roots - real(kind=default), dimension(:), intent(in) :: masses - integer, intent(in) :: sign, n1, n2 - integer, dimension(:), intent(in), optional :: states - integer, intent(in), optional :: tolerance - interface - pure function omega (p, s) result (m) - use kinds - implicit none - complex(kind=default) :: m - real(kind=default), dimension(0:,:), intent(in) :: p - integer, dimension(:), intent(in) :: s - end function omega - end interface - integer, dimension(size(masses)) :: s, sx, nstates - real(kind=default), dimension(0:3,size(masses)) :: p, px - integer :: k, j - complex(kind=default) :: a, ax - real(kind=default) :: threshold - if (present (states)) then - nstates = states - else - nstates = 2 - end if - call beams (roots, masses(1), masses(2), p(:,1), p(:,2)) - do k = 1, n - if (any (masses(3:) > 0)) then - call massive_decay (roots, masses(3:), p(:,3:)) - else - call massless_isotropic_decay (roots, p(:,3:)) - end if - threshold = omega_sum (omega, p, states) & - / num_states (size(s) - 2, nstates(3:)) / 1000 - s = -1 - loop_spins: do - px = p - px(:,n1) = p(:,n2) - px(:,n2) = p(:,n1) - sx = s - sx(n1) = s(n2) - sx(n2) = s(n1) - a = omega (p, s) - ax = sign * omega (px, sx) - call compare ("r", a, "i", ax, s, threshold, tolerance) - do j = size (masses), 1, -1 - select case (nstates (j)) - case (3) - s(j) = modulo (s(j) + 2, 3) - 1 - case (2) - s(j) = - s(j) - case (1) - s(j) = -1 - case default - s(j) = -1 - end select - if (s(j) /= -1) then - cycle loop_spins - end if - end do - exit loop_spins - end do loop_spins - end do - end subroutine symmetry_omega - - subroutine check_omega (tag, n, omega1, omega2, & - roots, masses, symmetry, states, tolerance, mode) - character(len=*), intent(in) :: tag - integer, intent(in) :: n - real(kind=default), intent(in) :: roots - real(kind=default), dimension(:), intent(in) :: masses - integer, dimension(0:,:), intent(in), optional :: symmetry - integer, dimension(:), intent(in), optional :: states - integer, intent(in), optional :: tolerance - character(len=*), intent(in), optional :: mode - interface - pure function omega1 (p, s) result (m) - use kinds - implicit none - complex(kind=default) :: m - real(kind=default), dimension(0:,:), intent(in) :: p - integer, dimension(:), intent(in) :: s - end function omega1 - pure function omega2 (p, s) result (m) - use kinds - implicit none - complex(kind=default) :: m - real(kind=default), dimension(0:,:), intent(in) :: p - integer, dimension(:), intent(in) :: s - end function omega2 - end interface - integer :: i - character(len=8) :: mode_local - character(len=130) :: tags - print *, trim (tag) // ":" - call compare_omega_sum (n, omega1, omega2, roots, masses, states, tolerance) - return - print *, trim (tag) // " (polarized):" - call compare_omega (n, omega1, omega2, roots, masses, states, tolerance) - if (present (symmetry)) then - do i = 1, size (symmetry, dim=2) - write (unit = tags, fmt = "('(',I1,'<>',I1,')')") symmetry(1,i), symmetry(2,i) - if (symmetry(0,i) > 0) then - print *, trim (tag) // " - " // trim (tags) // ":" - else - print *, trim (tag) // " + " // trim (tags) // ":" - end if - call symmetry_omega (n, omega1, roots, masses, symmetry(0,i), & - symmetry(1,i), symmetry(2,i), states, tolerance) - end do - end if - end subroutine check_omega - - subroutine ward_omega (n, omega, roots, masses, i, states, tolerance) - integer, intent(in) :: n - real(kind=default), intent(in) :: roots - real(kind=default), dimension(:), intent(in) :: masses - integer, intent(in) :: i - integer, dimension(:), intent(in), optional :: states - integer, intent(in), optional :: tolerance - interface - pure function omega (p, s) result (m) - use kinds - implicit none - complex(kind=default) :: m - real(kind=default), dimension(0:,:), intent(in) :: p - integer, dimension(:), intent(in) :: s - end function omega - end interface - integer, dimension(size(masses)) :: s, nstates - real(kind=default), dimension(0:3,size(masses)) :: p - integer :: k, j - complex(kind=default) :: a - real(kind=default) :: a2, threshold - if (present (states)) then - nstates = states - else - nstates = 2 - end if - call beams (roots, masses(1), masses(2), p(:,1), p(:,2)) - do k = 1, n - if (any (masses(3:) > 0)) then - call massive_decay (roots, masses(3:), p(:,3:)) - else - call massless_isotropic_decay (roots, p(:,3:)) - end if - threshold = omega_sum (omega, p, states) & - / num_states (size(s) - 2, nstates(3:)) / 1000 - s = -1 - loop_spins: do - s(i) = -1 - a = omega (p, s) - a2 = a * conjg (a) - print *, s, a2 - if (nstates(i) == 3) then - s(i) = 0 - a = omega (p, s) - a2 = a * conjg (a) - print *, s, a2 - end if - s(i) = 1 - a = omega (p, s) - a2 = a * conjg (a) - print *, s, a2 - s(i) = 4 - a = omega (p, s) - a2 = a * conjg (a) - print *, s, a2 - ! call compare ("r", a, "i", ax, s, threshold, tolerance) - do j = size (masses), 1, -1 - if (j /= i) then - select case (nstates (j)) - case (3) - s(j) = modulo (s(j) + 2, 3) - 1 - case (2) - s(j) = - s(j) - case (1) - s(j) = -1 - case default - s(j) = -1 - end select - if (s(j) /= -1) then - cycle loop_spins - end if - end if - end do - exit loop_spins - end do loop_spins - end do - end subroutine ward_omega - - subroutine ward4 (n, omega, madgraph, roots, masses, i, states, tolerance) - integer, intent(in) :: n - real(kind=default), intent(in) :: roots - real(kind=default), dimension(:), intent(in) :: masses - integer, intent(in) :: i - integer, dimension(:), intent(in), optional :: states - integer, intent(in), optional :: tolerance - interface - pure function omega (p, s) result (m) - use kinds - implicit none - complex(kind=default) :: m - real(kind=default), dimension(0:,:), intent(in) :: p - integer, dimension(:), intent(in) :: s - end function omega - function madgraph (p1, p2, p3, p4, hel) result (m) - use kinds - implicit none - real(kind=default) :: m - real(kind=default), dimension(0:3) :: p1, p2, p3, p4 - integer, dimension(4) :: hel - end function madgraph - end interface - integer, dimension(size(masses)) :: s, nstates - real(kind=default), dimension(0:3,size(masses)) :: p - integer :: k, j - complex(kind=default) :: a - real(kind=default) :: a2, m2, threshold - if (present (states)) then - nstates = states - else - nstates = 2 - end if - call beams (roots, masses(1), masses(2), p(:,1), p(:,2)) - do k = 1, n - if (any (masses(3:) > 0)) then - call massive_decay (roots, masses(3:), p(:,3:)) - else - call massless_isotropic_decay (roots, p(:,3:)) - end if - threshold = omega_sum (omega, p, states) & - / num_states (size(s) - 2, nstates(3:)) / 1000 - s = -1 - loop_spins: do - s(i) = -1 - a = omega (p, s) - a2 = a * conjg (a) - m2 = madgraph (p(:,1), p(:,2), p(:,3), p(:,4), s) - print *, s, a2, m2 - if (nstates(i) == 3) then - s(i) = 0 - a = omega (p, s) - a2 = a * conjg (a) - m2 = madgraph (p(:,1), p(:,2), p(:,3), p(:,4), s) - print *, s, a2, m2 - end if - s(i) = 1 - a = omega (p, s) - a2 = a * conjg (a) - m2 = madgraph (p(:,1), p(:,2), p(:,3), p(:,4), s) - print *, s, a2, m2 - s(i) = 4 - a = omega (p, s) - a2 = a * conjg (a) - m2 = madgraph (p(:,1), p(:,2), p(:,3), p(:,4), s) - print *, s, a2, m2 - ! call compare ("r", a, "i", ax, s, threshold, tolerance) - do j = size (masses), 1, -1 - if (j /= i) then - select case (nstates (j)) - case (3) - s(j) = modulo (s(j) + 2, 3) - 1 - case (2) - s(j) = - s(j) - case (1) - s(j) = -1 - case default - s(j) = -1 - end select - if (s(j) /= -1) then - cycle loop_spins - end if - end if - end do - exit loop_spins - end do loop_spins - end do - end subroutine ward4 - - subroutine compare4_madgraph (n, omega, madgraph, roots, masses, states, tolerance) - integer, intent(in) :: n - real(kind=default), intent(in) :: roots - real(kind=default), dimension(:), intent(in) :: masses - integer, dimension(:), intent(in), optional :: states - integer, intent(in), optional :: tolerance - interface - pure function omega (p, s) result (m) - use kinds - implicit none - complex(kind=default) :: m - real(kind=default), dimension(0:,:), intent(in) :: p - integer, dimension(:), intent(in) :: s - end function omega - function madgraph (p1, p2, p3, p4, hel) result (m) - use kinds - implicit none - real(kind=default) :: m - real(kind=default), dimension(0:3) :: p1, p2, p3, p4 - integer, dimension(4) :: hel - end function madgraph - end interface - integer :: k, j - real(kind=default) :: threshold, sm, so - complex(kind=default) :: ao - real(kind=default), dimension(0:3,4) :: p - integer, dimension(4) :: s, nstates - if (present (states)) then - nstates = states - else - nstates = 2 - end if - call beams (roots, masses(1), masses(2), p(:,1), p(:,2)) - do k = 1, n - if (any (masses(3:) > 0)) then - call massive_decay (roots, masses(3:), p(:,3:)) - else - call massless_isotropic_decay (roots, p(:,3:)) - end if - s = -1 - threshold = omega_sum (omega, p, states) & - / num_states (size(s) - 2, nstates(3:)) / 1000 - loop_spins: do - sm = madgraph (p(:,1), p(:,2), p(:,3), p(:,4), s) - ao = omega (p, s) - so = ao * conjg (ao) - call compare_squared ("o", so, "m", sm, s, threshold, tolerance) - do j = size (masses), 1, -1 - select case (nstates (j)) - case (3) - s(j) = modulo (s(j) + 2, 3) - 1 - case (2) - s(j) = - s(j) - case (1) - s(j) = -1 - case default - s(j) = -1 - end select - if (s(j) /= -1) then - cycle loop_spins - end if - end do - exit loop_spins - end do loop_spins - end do - end subroutine compare4_madgraph - - subroutine compare5_madgraph (n, omega, madgraph, roots, masses, states, tolerance) - integer, intent(in) :: n - real(kind=default), intent(in) :: roots - real(kind=default), dimension(:), intent(in) :: masses - integer, dimension(:), intent(in), optional :: states - integer, intent(in), optional :: tolerance - interface - pure function omega (p, s) result (m) - use kinds - implicit none - complex(kind=default) :: m - real(kind=default), dimension(0:,:), intent(in) :: p - integer, dimension(:), intent(in) :: s - end function omega - function madgraph (p1, p2, p3, p4, p5, hel) result (m) - use kinds - implicit none - real(kind=default) :: m - real(kind=default), dimension(0:3) :: p1, p2, p3, p4, p5 - integer, dimension(5) :: hel - end function madgraph - end interface - integer :: k, j - real(kind=default) :: threshold, sm, so - complex(kind=default) :: ao - real(kind=default), dimension(0:3,5) :: p - integer, dimension(5) :: s, nstates - if (present (states)) then - nstates = states - else - nstates = 2 - end if - call beams (roots, masses(1), masses(2), p(:,1), p(:,2)) - do k = 1, n - if (any (masses(3:) > 0)) then - call massive_decay (roots, masses(3:), p(:,3:)) - else - call massless_isotropic_decay (roots, p(:,3:)) - end if - threshold = omega_sum (omega, p, states) & - / num_states (size(s) - 2, nstates(3:)) / 1000 - s = -1 - loop_spins: do - sm = madgraph (p(:,1), p(:,2), p(:,3), p(:,4), p(:,5), s) - ao = omega (p, s) - so = ao * conjg (ao) - call compare_squared ("o", so, "m", sm, s, threshold, tolerance) - do j = size (masses), 1, -1 - select case (nstates (j)) - case (3) - s(j) = modulo (s(j) + 2, 3) - 1 - case (2) - s(j) = - s(j) - case (1) - s(j) = -1 - case default - s(j) = -1 - end select - if (s(j) /= -1) then - cycle loop_spins - end if - end do - exit loop_spins - end do loop_spins - end do - end subroutine compare5_madgraph - - subroutine compare6_madgraph (n, omega, madgraph, roots, masses, states, tolerance) - integer, intent(in) :: n - real(kind=default), intent(in) :: roots - real(kind=default), dimension(:), intent(in) :: masses - integer, dimension(:), intent(in), optional :: states - integer, intent(in), optional :: tolerance - interface - pure function omega (p, s) result (m) - use kinds - implicit none - complex(kind=default) :: m - real(kind=default), dimension(0:,:), intent(in) :: p - integer, dimension(:), intent(in) :: s - end function omega - function madgraph (p1, p2, p3, p4, p5, p6, hel) result (m) - use kinds - implicit none - real(kind=default) :: m - real(kind=default), dimension(0:3) :: p1, p2, p3, p4, p5, p6 - integer, dimension(6) :: hel - end function madgraph - end interface - integer :: k, j - real(kind=default) :: threshold, sm, so - complex(kind=default) :: ao - real(kind=default), dimension(0:3,6) :: p - integer, dimension(6) :: s, nstates - if (present (states)) then - nstates = states - else - nstates = 2 - end if - call beams (roots, masses(1), masses(2), p(:,1), p(:,2)) - do k = 1, n - if (any (masses(3:) > 0)) then - call massive_decay (roots, masses(3:), p(:,3:)) - else - call massless_isotropic_decay (roots, p(:,3:)) - end if - threshold = omega_sum (omega, p, states) & - / num_states (size(s) - 2, nstates(3:)) / 1000 - s = -1 - loop_spins: do - sm = madgraph (p(:,1), p(:,2), p(:,3), p(:,4), p(:,5), p(:,6), s) - ao = omega (p, s) - so = ao * conjg (ao) - call compare_squared ("o", so, "m", sm, s, threshold, tolerance) - do j = size (masses), 1, -1 - select case (nstates (j)) - case (3) - s(j) = modulo (s(j) + 2, 3) - 1 - case (2) - s(j) = - s(j) - case (1) - s(j) = -1 - case default - s(j) = -1 - end select - if (s(j) /= -1) then - cycle loop_spins - end if - end do - exit loop_spins - end do loop_spins - end do - end subroutine compare6_madgraph - - subroutine compare7_madgraph (n, omega, madgraph, roots, masses, states, tolerance) - integer, intent(in) :: n - real(kind=default), intent(in) :: roots - real(kind=default), dimension(:), intent(in) :: masses - integer, dimension(:), intent(in), optional :: states - integer, intent(in), optional :: tolerance - interface - pure function omega (p, s) result (m) - use kinds - implicit none - complex(kind=default) :: m - real(kind=default), dimension(0:,:), intent(in) :: p - integer, dimension(:), intent(in) :: s - end function omega - function madgraph (p1, p2, p3, p4, p5, p6, p7, hel) result (m) - use kinds - implicit none - real(kind=default) :: m - real(kind=default), dimension(0:3) :: p1, p2, p3, p4, p5, p6, p7 - integer, dimension(7) :: hel - end function madgraph - end interface - integer :: k, j - real(kind=default) :: threshold, sm, so - complex(kind=default) :: ao - real(kind=default), dimension(0:3,7) :: p - integer, dimension(7) :: s, nstates - if (present (states)) then - nstates = states - else - nstates = 2 - end if - call beams (roots, masses(1), masses(2), p(:,1), p(:,2)) - do k = 1, n - if (any (masses(3:) > 0)) then - call massive_decay (roots, masses(3:), p(:,3:)) - else - call massless_isotropic_decay (roots, p(:,3:)) - end if - threshold = omega_sum (omega, p, states) & - / num_states (size(s) - 2, nstates(3:)) / 1000 - s = -1 - loop_spins: do - sm = madgraph (p(:,1), p(:,2), p(:,3), p(:,4), p(:,5), p(:,6), p(:,7), s) - ao = omega (p, s) - so = ao * conjg (ao) - call compare_squared ("o", so, "m", sm, s, threshold, tolerance) - do j = size (masses), 1, -1 - select case (nstates (j)) - case (3) - s(j) = modulo (s(j) + 2, 3) - 1 - case (2) - s(j) = - s(j) - case (1) - s(j) = -1 - case default - s(j) = -1 - end select - if (s(j) /= -1) then - cycle loop_spins - end if - end do - exit loop_spins - end do loop_spins - end do - end subroutine compare7_madgraph - - subroutine compare8_madgraph (n, omega, madgraph, roots, masses, states, tolerance) - integer, intent(in) :: n - real(kind=default), intent(in) :: roots - real(kind=default), dimension(:), intent(in) :: masses - integer, dimension(:), intent(in), optional :: states - integer, intent(in), optional :: tolerance - interface - pure function omega (p, s) result (m) - use kinds - implicit none - complex(kind=default) :: m - real(kind=default), dimension(0:,:), intent(in) :: p - integer, dimension(:), intent(in) :: s - end function omega - function madgraph (p1, p2, p3, p4, p5, p6, p7, p8, hel) result (m) - use kinds - implicit none - real(kind=default) :: m - real(kind=default), dimension(0:3) :: p1, p2, p3, p4, p5, p6, p7, p8 - integer, dimension(8) :: hel - end function madgraph - end interface - integer :: k, j - real(kind=default) :: threshold, sm, so - complex(kind=default) :: ao - real(kind=default), dimension(0:3,8) :: p - integer, dimension(8) :: s, nstates - if (present (states)) then - nstates = states - else - nstates = 2 - end if - call beams (roots, masses(1), masses(2), p(:,1), p(:,2)) - do k = 1, n - if (any (masses(3:) > 0)) then - call massive_decay (roots, masses(3:), p(:,3:)) - else - call massless_isotropic_decay (roots, p(:,3:)) - end if - threshold = omega_sum (omega, p, states) & - / num_states (size(s) - 2, nstates(3:)) / 1000 - s = -1 - loop_spins: do - sm = madgraph (p(:,1), p(:,2), p(:,3), p(:,4), p(:,5), p(:,6), p(:,7), p(:,8), s) - ao = omega (p, s) - so = ao * conjg (ao) - call compare_squared ("o", so, "m", sm, s, threshold, tolerance) - do j = size (masses), 1, -1 - select case (nstates (j)) - case (3) - s(j) = modulo (s(j) + 2, 3) - 1 - case (2) - s(j) = - s(j) - case (1) - s(j) = -1 - case default - s(j) = -1 - end select - if (s(j) /= -1) then - cycle loop_spins - end if - end do - exit loop_spins - end do loop_spins - end do - end subroutine compare8_madgraph - - subroutine compare_sum4_madgraph (n, omega, madgraph, roots, masses, states, tolerance, mode) - integer, intent(in) :: n - real(kind=default), intent(in) :: roots - real(kind=default), dimension(:), intent(in) :: masses - integer, dimension(:), intent(in), optional :: states - integer, intent(in), optional :: tolerance - character(len=*), intent(in), optional :: mode - interface - pure function omega (p, s) result (m) - use kinds - implicit none - complex(kind=default) :: m - real(kind=default), dimension(0:,:), intent(in) :: p - integer, dimension(:), intent(in) :: s - end function omega - function madgraph (p1, p2, p3, p4) result (s) - use kinds - implicit none - real(kind=default) :: s - real(kind=default), dimension(0:3) :: p1, p2, p3, p4 - end function madgraph - end interface - real(kind=default), save :: s = 0 - integer :: k - character(len=8) :: mode_local - real(kind=default) :: sm, so - real(kind=default), dimension(0:3,4) :: p - integer, dimension(:), allocatable :: zero - if (present (mode)) then - mode_local = mode - else - mode_local = "" - end if - call beams (roots, masses(1), masses(2), p(:,1), p(:,2)) - if (trim(mode_local) == "omega") then - allocate (zero(num_states(4,states))) - zero = 0 - do k = 1, n - if (any (masses(3:) > 0)) then - call massive_decay (roots, masses(3:), p(:,3:)) - else - call massless_isotropic_decay (roots, p(:,3:)) - end if - call omega_sum_nonzero (so, omega, p, zero, k, states) - s = s + so - end do - deallocate (zero) - else if (trim(mode_local) == "madgraph") then - do k = 1, n - if (any (masses(3:) > 0)) then - call massive_decay (roots, masses(3:), p(:,3:)) - else - call massless_isotropic_decay (roots, p(:,3:)) - end if - s = s + madgraph (p(:,1), p(:,2), p(:,3), p(:,4)) - end do - else - allocate (zero(num_states(4,states))) - zero = 0 - do k = 1, n - if (any (masses(3:) > 0)) then - call massive_decay (roots, masses(3:), p(:,3:)) - else - call massless_isotropic_decay (roots, p(:,3:)) - end if - call omega_sum_nonzero (so, omega, p, zero, k, states) - sm = madgraph (p(:,1), p(:,2), p(:,3), p(:,4)) - call compare_sigma ("o", so, "m", sm, THRESHOLD_SIGMA, tolerance) - end do - deallocate (zero) - end if - end subroutine compare_sum4_madgraph - - subroutine compare_sum5_madgraph (n, omega, madgraph, roots, masses, states, tolerance, mode) - integer, intent(in) :: n - real(kind=default), intent(in) :: roots - real(kind=default), dimension(:), intent(in) :: masses - integer, dimension(:), intent(in), optional :: states - integer, intent(in), optional :: tolerance - character(len=*), intent(in), optional :: mode - interface - pure function omega (p, s) result (m) - use kinds - implicit none - complex(kind=default) :: m - real(kind=default), dimension(0:,:), intent(in) :: p - integer, dimension(:), intent(in) :: s - end function omega - function madgraph (p1, p2, p3, p4, p5) result (s) - use kinds - implicit none - real(kind=default) :: s - real(kind=default), dimension(0:3) :: p1, p2, p3, p4, p5 - end function madgraph - end interface - real(kind=default), save :: s = 0 - integer :: k - character(len=8) :: mode_local - real(kind=default) :: sm, so - real(kind=default), dimension(0:3,5) :: p - integer, dimension(:), allocatable :: zero - if (present (mode)) then - mode_local = mode - else - mode_local = "" - end if - call beams (roots, masses(1), masses(2), p(:,1), p(:,2)) - if (trim(mode_local) == "omega") then - allocate (zero(num_states(5,states))) - zero = 0 - do k = 1, n - if (any (masses(3:) > 0)) then - call massive_decay (roots, masses(3:), p(:,3:)) - else - call massless_isotropic_decay (roots, p(:,3:)) - end if - call omega_sum_nonzero (so, omega, p, zero, k, states) - s = s + so - end do - deallocate (zero) - else if (trim(mode_local) == "madgraph") then - do k = 1, n - if (any (masses(3:) > 0)) then - call massive_decay (roots, masses(3:), p(:,3:)) - else - call massless_isotropic_decay (roots, p(:,3:)) - end if - s = s + madgraph (p(:,1), p(:,2), p(:,3), p(:,4), p(:,5)) - end do - else - allocate (zero(num_states(5,states))) - zero = 0 - do k = 1, n - if (any (masses(3:) > 0)) then - call massive_decay (roots, masses(3:), p(:,3:)) - else - call massless_isotropic_decay (roots, p(:,3:)) - end if - call omega_sum_nonzero (so, omega, p, zero, k, states) - sm = madgraph (p(:,1), p(:,2), p(:,3), p(:,4), p(:,5)) - call compare_sigma ("o", so, "m", sm, THRESHOLD_SIGMA, tolerance) - end do - deallocate (zero) - end if - end subroutine compare_sum5_madgraph - - subroutine compare_sum6_madgraph (n, omega, madgraph, roots, masses, states, tolerance, mode) - integer, intent(in) :: n - real(kind=default), intent(in) :: roots - real(kind=default), dimension(:), intent(in) :: masses - integer, dimension(:), intent(in), optional :: states - integer, intent(in), optional :: tolerance - character(len=*), intent(in), optional :: mode - interface - pure function omega (p, s) result (m) - use kinds - implicit none - complex(kind=default) :: m - real(kind=default), dimension(0:,:), intent(in) :: p - integer, dimension(:), intent(in) :: s - end function omega - function madgraph (p1, p2, p3, p4, p5, p6) result (s) - use kinds - implicit none - real(kind=default) :: s - real(kind=default), dimension(0:3) :: p1, p2, p3, p4, p5, p6 - end function madgraph - end interface - real(kind=default), save :: s = 0 - integer :: k - character(len=8) :: mode_local - real(kind=default) :: sm, so - real(kind=default), dimension(0:3,6) :: p - integer, dimension(:), allocatable :: zero - if (present (mode)) then - mode_local = mode - else - mode_local = "" - end if - call beams (roots, masses(1), masses(2), p(:,1), p(:,2)) - if (trim(mode_local) == "omega") then - allocate (zero(num_states(6,states))) - zero = 0 - do k = 1, n - if (any (masses(3:) > 0)) then - call massive_decay (roots, masses(3:), p(:,3:)) - else - call massless_isotropic_decay (roots, p(:,3:)) - end if - call omega_sum_nonzero (so, omega, p, zero, k, states) - s = s + so - end do - deallocate (zero) - else if (trim(mode_local) == "madgraph") then - do k = 1, n - if (any (masses(3:) > 0)) then - call massive_decay (roots, masses(3:), p(:,3:)) - else - call massless_isotropic_decay (roots, p(:,3:)) - end if - s = s + madgraph (p(:,1), p(:,2), p(:,3), p(:,4), p(:,5), p(:,6)) - end do - else - allocate (zero(num_states(6,states))) - zero = 0 - do k = 1, n - if (any (masses(3:) > 0)) then - call massive_decay (roots, masses(3:), p(:,3:)) - else - call massless_isotropic_decay (roots, p(:,3:)) - end if - call omega_sum_nonzero (so, omega, p, zero, k, states) - sm = madgraph (p(:,1), p(:,2), p(:,3), p(:,4), p(:,5), p(:,6)) - call compare_sigma ("o", so, "m", sm, THRESHOLD_SIGMA, tolerance) - end do - deallocate (zero) - end if - end subroutine compare_sum6_madgraph - - subroutine compare_sum7_madgraph (n, omega, madgraph, roots, masses, states, tolerance, mode) - integer, intent(in) :: n - real(kind=default), intent(in) :: roots - real(kind=default), dimension(:), intent(in) :: masses - integer, dimension(:), intent(in), optional :: states - integer, intent(in), optional :: tolerance - character(len=*), intent(in), optional :: mode - interface - pure function omega (p, s) result (m) - use kinds - implicit none - complex(kind=default) :: m - real(kind=default), dimension(0:,:), intent(in) :: p - integer, dimension(:), intent(in) :: s - end function omega - function madgraph (p1, p2, p3, p4, p5, p6, p7) result (s) - use kinds - implicit none - real(kind=default) :: s - real(kind=default), dimension(0:3) :: p1, p2, p3, p4, p5, p6, p7 - end function madgraph - end interface - real(kind=default), save :: s = 0 - integer :: k - character(len=8) :: mode_local - real(kind=default) :: sm, so - real(kind=default), dimension(0:3,7) :: p - integer, dimension(:), allocatable :: zero - if (present (mode)) then - mode_local = mode - else - mode_local = "" - end if - call beams (roots, masses(1), masses(2), p(:,1), p(:,2)) - if (trim(mode_local) == "omega") then - allocate (zero(num_states(7,states))) - zero = 0 - do k = 1, n - if (any (masses(3:) > 0)) then - call massive_decay (roots, masses(3:), p(:,3:)) - else - call massless_isotropic_decay (roots, p(:,3:)) - end if - call omega_sum_nonzero (so, omega, p, zero, k, states) - s = s + so - end do - deallocate (zero) - else if (trim(mode_local) == "madgraph") then - do k = 1, n - if (any (masses(3:) > 0)) then - call massive_decay (roots, masses(3:), p(:,3:)) - else - call massless_isotropic_decay (roots, p(:,3:)) - end if - s = s + madgraph (p(:,1), p(:,2), p(:,3), p(:,4), p(:,5), p(:,6), p(:,7)) - end do - else - allocate (zero(num_states(7,states))) - zero = 0 - do k = 1, n - if (any (masses(3:) > 0)) then - call massive_decay (roots, masses(3:), p(:,3:)) - else - call massless_isotropic_decay (roots, p(:,3:)) - end if - call omega_sum_nonzero (so, omega, p, zero, k, states) - sm = madgraph (p(:,1), p(:,2), p(:,3), p(:,4), p(:,5), p(:,6), p(:,7)) - call compare_sigma ("o", so, "m", sm, THRESHOLD_SIGMA, tolerance) - end do - deallocate (zero) - end if - end subroutine compare_sum7_madgraph - - subroutine compare_sum8_madgraph (n, omega, madgraph, roots, masses, states, tolerance, mode) - integer, intent(in) :: n - real(kind=default), intent(in) :: roots - real(kind=default), dimension(:), intent(in) :: masses - integer, dimension(:), intent(in), optional :: states - integer, intent(in), optional :: tolerance - character(len=*), intent(in), optional :: mode - interface - pure function omega (p, s) result (m) - use kinds - implicit none - complex(kind=default) :: m - real(kind=default), dimension(0:,:), intent(in) :: p - integer, dimension(:), intent(in) :: s - end function omega - function madgraph (p1, p2, p3, p4, p5, p6, p7, p8) result (s) - use kinds - implicit none - real(kind=default) :: s - real(kind=default), dimension(0:3) :: & - p1, p2, p3, p4, p5, p6, p7, p8 - end function madgraph - end interface - real(kind=default), save :: s = 0 - integer :: k - character(len=8) :: mode_local - real(kind=default) :: sm, so - real(kind=default), dimension(0:3,8) :: p - integer, dimension(:), allocatable :: zero - if (present (mode)) then - mode_local = mode - else - mode_local = "" - end if - call beams (roots, masses(1), masses(2), p(:,1), p(:,2)) - if (trim(mode_local) == "omega") then - allocate (zero(num_states(8,states))) - zero = 0 - do k = 1, n - if (any (masses(3:) > 0)) then - call massive_decay (roots, masses(3:), p(:,3:)) - else - call massless_isotropic_decay (roots, p(:,3:)) - end if - call omega_sum_nonzero (so, omega, p, zero, k, states) - s = s + so - end do - deallocate (zero) - else if (trim(mode_local) == "madgraph") then - do k = 1, n - if (any (masses(3:) > 0)) then - call massive_decay (roots, masses(3:), p(:,3:)) - else - call massless_isotropic_decay (roots, p(:,3:)) - end if - s = s + madgraph (p(:,1), p(:,2), p(:,3), p(:,4), p(:,5), p(:,6), p(:,7), p(:,8)) - end do - else - allocate (zero(num_states(8,states))) - zero = 0 - do k = 1, n - if (any (masses(3:) > 0)) then - call massive_decay (roots, masses(3:), p(:,3:)) - else - call massless_isotropic_decay (roots, p(:,3:)) - end if - call omega_sum_nonzero (so, omega, p, zero, k, states) - sm = madgraph (p(:,1), p(:,2), p(:,3), p(:,4), p(:,5), p(:,6), p(:,7), p(:,8)) - call compare_sigma ("o", so, "m", sm, THRESHOLD_SIGMA, tolerance) - end do - deallocate (zero) - end if - end subroutine compare_sum8_madgraph - - subroutine check4_madgraph (tag, n, omega, smadgraph, madgraph, & - roots, masses, symmetry, states, tolerance, mode) - character(len=*), intent(in) :: tag - integer, intent(in) :: n - real(kind=default), intent(in) :: roots - real(kind=default), dimension(:), intent(in) :: masses - integer, dimension(0:,:), intent(in), optional :: symmetry - integer, dimension(:), intent(in), optional :: states - integer, intent(in), optional :: tolerance - character(len=*), intent(in), optional :: mode - interface - pure function omega (p, s) result (m) - use kinds - implicit none - complex(kind=default) :: m - real(kind=default), dimension(0:,:), intent(in) :: p - integer, dimension(:), intent(in) :: s - end function omega - function smadgraph (p1, p2, p3, p4) result (s) - use kinds - implicit none - real(kind=default) :: s - real(kind=default), dimension(0:3) :: p1, p2, p3, p4 - end function smadgraph - function madgraph (p1, p2, p3, p4, hel) result (m) - use kinds - implicit none - real(kind=default) :: m - real(kind=default), dimension(0:3) :: p1, p2, p3, p4 - integer, dimension(4) :: hel - end function madgraph - end interface - integer :: i - character(len=8) :: mode_local - character(len=130) :: tags - if (present (mode)) then - mode_local = mode - else - mode_local = "compare" - end if - if (trim (mode_local) == "compare") then - print *, trim (tag) // ":" - call compare_sum4_madgraph (n, omega, smadgraph, roots, masses, states, tolerance) - print *, trim (tag) // " (polarized):" - call compare4_madgraph (n, omega, madgraph, roots, masses, states, tolerance) - if (present (symmetry)) then - do i = 1, size (symmetry, dim=2) - write (unit = tags, fmt = "('(',I1,'<>',I1,')')") symmetry(1,i), symmetry(2,i) - if (symmetry(0,i) > 0) then - print *, trim (tag) // " - " // trim (tags) // ":" - else - print *, trim (tag) // " + " // trim (tags) // ":" - end if - call symmetry_omega (n, omega, roots, masses, symmetry(0,i), & - symmetry(1,i), symmetry(2,i), states, tolerance) - end do - end if - else - print *, trim (tag) // " (" // trim (mode_local) // "):" - call compare_sum4_madgraph (n, omega, smadgraph, roots, masses, states, & - tolerance, mode = mode_local) - end if - end subroutine check4_madgraph - - subroutine check5_madgraph (tag, n, omega, smadgraph, madgraph, & - roots, masses, symmetry, states, tolerance, mode) - character(len=*), intent(in) :: tag - integer, intent(in) :: n - real(kind=default), intent(in) :: roots - real(kind=default), dimension(:), intent(in) :: masses - integer, dimension(0:,:), intent(in), optional :: symmetry - integer, dimension(:), intent(in), optional :: states - integer, intent(in), optional :: tolerance - character(len=*), intent(in), optional :: mode - interface - pure function omega (p, s) result (m) - use kinds - implicit none - complex(kind=default) :: m - real(kind=default), dimension(0:,:), intent(in) :: p - integer, dimension(:), intent(in) :: s - end function omega - function smadgraph (p1, p2, p3, p4, p5) result (s) - use kinds - implicit none - real(kind=default) :: s - real(kind=default), dimension(0:3) :: p1, p2, p3, p4, p5 - end function smadgraph - function madgraph (p1, p2, p3, p4, p5, hel) result (m) - use kinds - implicit none - real(kind=default) :: m - real(kind=default), dimension(0:3) :: p1, p2, p3, p4, p5 - integer, dimension(5) :: hel - end function madgraph - end interface - integer :: i - character(len=8) :: mode_local - character(len=130) :: tags - if (present (mode)) then - mode_local = mode - else - mode_local = "compare" - end if - if (trim (mode_local) == "compare") then - print *, trim (tag) // ":" - call compare_sum5_madgraph (n, omega, smadgraph, roots, masses, states, tolerance) - print *, trim (tag) // " (polarized):" - call compare5_madgraph (n, omega, madgraph, roots, masses, states, tolerance) - if (present (symmetry)) then - do i = 1, size (symmetry, dim=2) - write (unit = tags, fmt = "('(',I1,'<>',I1,')')") symmetry(1,i), symmetry(2,i) - if (symmetry(0,i) > 0) then - print *, trim (tag) // " - " // trim (tags) // ":" - else - print *, trim (tag) // " + " // trim (tags) // ":" - end if - call symmetry_omega (n, omega, roots, masses, symmetry(0,i), & - symmetry(1,i), symmetry(2,i), states, tolerance) - end do - end if - else - print *, trim (tag) // " (" // trim (mode_local) // "):" - call compare_sum5_madgraph (n, omega, smadgraph, roots, masses, states, & - tolerance, mode = mode_local) - end if - end subroutine check5_madgraph - - subroutine check6_madgraph (tag, n, omega, smadgraph, madgraph, & - roots, masses, symmetry, states, tolerance, mode) - character(len=*), intent(in) :: tag - integer, intent(in) :: n - real(kind=default), intent(in) :: roots - real(kind=default), dimension(:), intent(in) :: masses - integer, dimension(0:,:), intent(in), optional :: symmetry - integer, dimension(:), intent(in), optional :: states - integer, intent(in), optional :: tolerance - character(len=*), intent(in), optional :: mode - interface - pure function omega (p, s) result (m) - use kinds - implicit none - complex(kind=default) :: m - real(kind=default), dimension(0:,:), intent(in) :: p - integer, dimension(:), intent(in) :: s - end function omega - function smadgraph (p1, p2, p3, p4, p5, p6) result (s) - use kinds - implicit none - real(kind=default) :: s - real(kind=default), dimension(0:3) :: p1, p2, p3, p4, p5, p6 - end function smadgraph - function madgraph (p1, p2, p3, p4, p5, p6, hel) result (m) - use kinds - implicit none - real(kind=default) :: m - real(kind=default), dimension(0:3) :: p1, p2, p3, p4, p5, p6 - integer, dimension(6) :: hel - end function madgraph - end interface - integer :: i - character(len=8) :: mode_local - character(len=130) :: tags - if (present (mode)) then - mode_local = mode - else - mode_local = "compare" - end if - if (trim (mode_local) == "compare") then - print *, trim (tag) // ":" - call compare_sum6_madgraph (n, omega, smadgraph, roots, masses, states, tolerance) - print *, trim (tag) // " (polarized):" - call compare6_madgraph (n, omega, madgraph, roots, masses, states, tolerance) - if (present (symmetry)) then - do i = 1, size (symmetry, dim=2) - write (unit = tags, fmt = "('(',I1,'<>',I1,')')") symmetry(1,i), symmetry(2,i) - if (symmetry(0,i) > 0) then - print *, trim (tag) // " - " // trim (tags) // ":" - else - print *, trim (tag) // " + " // trim (tags) // ":" - end if - call symmetry_omega (n, omega, roots, masses, symmetry(0,i), & - symmetry(1,i), symmetry(2,i), states, tolerance) - end do - end if - else - print *, trim (tag) // " (" // trim (mode_local) // "):" - call compare_sum6_madgraph (n, omega, smadgraph, roots, masses, states, & - tolerance, mode = mode_local) - end if - end subroutine check6_madgraph - - subroutine check7_madgraph (tag, n, omega, smadgraph, madgraph, & - roots, masses, symmetry, states, tolerance, mode) - character(len=*), intent(in) :: tag - integer, intent(in) :: n - real(kind=default), intent(in) :: roots - real(kind=default), dimension(:), intent(in) :: masses - integer, dimension(0:,:), intent(in), optional :: symmetry - integer, dimension(:), intent(in), optional :: states - integer, intent(in), optional :: tolerance - character(len=*), intent(in), optional :: mode - interface - pure function omega (p, s) result (m) - use kinds - implicit none - complex(kind=default) :: m - real(kind=default), dimension(0:,:), intent(in) :: p - integer, dimension(:), intent(in) :: s - end function omega - function smadgraph (p1, p2, p3, p4, p5, p6, p7) result (s) - use kinds - implicit none - real(kind=default) :: s - real(kind=default), dimension(0:3) :: p1, p2, p3, p4, p5, p6, p7 - end function smadgraph - function madgraph (p1, p2, p3, p4, p5, p6, p7, hel) result (m) - use kinds - implicit none - real(kind=default) :: m - real(kind=default), dimension(0:3) :: p1, p2, p3, p4, p5, p6, p7 - integer, dimension(7) :: hel - end function madgraph - end interface - integer :: i - character(len=8) :: mode_local - character(len=130) :: tags - if (present (mode)) then - mode_local = mode - else - mode_local = "compare" - end if - if (trim (mode_local) == "compare") then - print *, trim (tag) // ":" - call compare_sum7_madgraph (n, omega, smadgraph, roots, masses, states, tolerance) - print *, trim (tag) // " (polarized):" - call compare7_madgraph (n, omega, madgraph, roots, masses, states, tolerance) - if (present (symmetry)) then - do i = 1, size (symmetry, dim=2) - write (unit = tags, fmt = "('(',I1,'<>',I1,')')") symmetry(1,i), symmetry(2,i) - if (symmetry(0,i) > 0) then - print *, trim (tag) // " - " // trim (tags) // ":" - else - print *, trim (tag) // " + " // trim (tags) // ":" - end if - call symmetry_omega (n, omega, roots, masses, symmetry(0,i), & - symmetry(1,i), symmetry(2,i), states, tolerance) - end do - end if - else - print *, trim (tag) // " (" // trim (mode_local) // "):" - call compare_sum7_madgraph (n, omega, smadgraph, roots, masses, states, & - tolerance, mode = mode_local) - end if - end subroutine check7_madgraph - - subroutine check8_madgraph (tag, n, omega, smadgraph, madgraph, & - roots, masses, symmetry, states, tolerance, mode) - character(len=*), intent(in) :: tag - integer, intent(in) :: n - real(kind=default), intent(in) :: roots - real(kind=default), dimension(:), intent(in) :: masses - integer, dimension(0:,:), intent(in), optional :: symmetry - integer, dimension(:), intent(in), optional :: states - integer, intent(in), optional :: tolerance - character(len=*), intent(in), optional :: mode - interface - pure function omega (p, s) result (m) - use kinds - implicit none - complex(kind=default) :: m - real(kind=default), dimension(0:,:), intent(in) :: p - integer, dimension(:), intent(in) :: s - end function omega - function smadgraph (p1, p2, p3, p4, p5, p6, p7, p8) result (s) - use kinds - implicit none - real(kind=default) :: s - real(kind=default), dimension(0:3) :: & - p1, p2, p3, p4, p5, p6, p7, p8 - end function smadgraph - function madgraph (p1, p2, p3, p4, p5, p6, p7, p8, hel) result (m) - use kinds - implicit none - real(kind=default) :: m - real(kind=default), dimension(0:3) :: p1, p2, p3, p4, p5, p6, p7, p8 - integer, dimension(8) :: hel - end function madgraph - end interface - integer :: i - character(len=8) :: mode_local - character(len=130) :: tags - if (present (mode)) then - mode_local = mode - else - mode_local = "compare" - end if - if (trim (mode_local) == "compare") then - print *, trim (tag) // ":" - call compare_sum8_madgraph (n, omega, smadgraph, roots, masses, states, tolerance) - print *, trim (tag) // " (polarized):" - call compare8_madgraph (n, omega, madgraph, roots, masses, states, tolerance) - if (present (symmetry)) then - do i = 1, size (symmetry, dim=2) - write (unit = tags, fmt = "('(',I1,'<>',I1,')')") symmetry(1,i), symmetry(2,i) - if (symmetry(0,i) > 0) then - print *, trim (tag) // " - " // trim (tags) // ":" - else - print *, trim (tag) // " + " // trim (tags) // ":" - end if - call symmetry_omega (n, omega, roots, masses, symmetry(0,i), & - symmetry(1,i), symmetry(2,i), states, tolerance) - end do - end if - else - print *, trim (tag) // " (" // trim (mode_local) // "):" - call compare_sum8_madgraph (n, omega, smadgraph, roots, masses, states, & - tolerance, mode = mode_local) - end if - end subroutine check8_madgraph - -end module testbed_old Index: branches/ohl/omega-development/completed/whizard2/tools/testbed.f95 =================================================================== --- branches/ohl/omega-development/completed/whizard2/tools/testbed.f95 (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/tools/testbed.f95 (revision 8703) @@ -1,1569 +0,0 @@ -! $Id: testbed.f95,v 1.1 2004/04/09 20:11:17 ohl Exp $ - -module testbed - use kinds - use omega95 - use kinematics - use rambo - use omega_parameters - use omega_parameters_madgraph - implicit none - real(kind=default), parameter, private :: THRESHOLD_SIGMA = 1.0e-21_default - public :: read_parameters - public :: compare_sigma - public :: compare_squared - public :: compare - public :: compare_omega - public :: compare_omega_sum - public :: symmetry_omega - public :: check_omega - public :: ward_omega - public :: ward4 - public :: compare4_madgraph - public :: compare5_madgraph - public :: compare6_madgraph - public :: compare7_madgraph - public :: compare8_madgraph - public :: compare_sum4_madgraph - public :: compare_sum5_madgraph - public :: compare_sum6_madgraph - public :: compare_sum7_madgraph - public :: compare_sum8_madgraph - public :: check4_madgraph - public :: check5_madgraph - public :: check6_madgraph - public :: check7_madgraph - public :: check8_madgraph -contains - - subroutine read_parameters (roots, n, tolerance, mode) - real(kind=single), intent(out) :: roots - integer, intent(out) :: n, tolerance - character(len=8), intent(out) :: mode - real(kind=single) :: me, mw, gw, mz, gz, mt, gt, mh, gh - complex(kind=single) :: o1, o2, o3, o4, m1, m2, m3, m4 - namelist /options/ mode, n, tolerance, roots, me, mw, gw, mz, gz, & - mt, gt, mh, gh, o1, o2, o3, o4, m1, m2, m3, m4 - integer :: ios - character (len=128) :: cmd - call setup_parameters () - mode = "compare" - n = 10 - tolerance = 10000 - roots = 800 - me = mass(11) - mz = mass(23) - gz = width(23) - mw = mass(24) - gw = width(24) - mt = mass(6) - gt = width(6) - mh = mass(25) - gh = width(25) - o1 = fudge_o1 - o2 = fudge_o2 - o3 = fudge_o3 - o4 = fudge_o4 - m1 = fudge_m1 - m2 = fudge_m2 - m3 = fudge_m3 - m4 = fudge_m4 - write (unit = *, nml = options) - open (unit = 42, status = "scratch") - cmds: do - read (unit = *, fmt = "(A)", iostat = ios) cmd - if (ios /= 0 .or. trim(cmd) == "") exit cmds - rewind (unit = 42) - write (unit = 42, fmt = "('&options ',A,'/')") cmd - rewind (unit = 42) - read (unit = 42, nml = options) - end do cmds - close (unit = 42) - write (unit = *, nml = options) - mass(11) = me - mass(23) = mz - width(23) = gz - mass(24) = mw - width(24) = gw - mass(6) = mt - width(6) = gt - mass(25) = mh - width(25) = gh - fudge_o1 = o1 - fudge_o2 = o2 - fudge_o3 = o3 - fudge_o4 = o4 - fudge_m1 = m1 - fudge_m2 = m2 - fudge_m3 = m3 - fudge_m4 = m4 - end subroutine read_parameters - - subroutine compare_sigma (n1, s1, n2, s2, threshold, tolerance) - real(kind=default), intent(in) :: s1, s2 - character(len=*), intent(in) :: n1, n2 - real(kind=default), intent(in) :: threshold - integer, intent(in), optional :: tolerance - real(kind=default) :: ds, tolerance_local - if (present (tolerance)) then - tolerance_local = tolerance * epsilon (tolerance_local) - else - tolerance_local = 1000 * epsilon (tolerance_local) - end if - if (max (s1, s2) >= threshold) then - ds = abs (s1 - s2) / (s2 + s2) - if (ds > tolerance_local) then - write (unit = *, fmt = & - "(2(2X,A1,': ',E17.10), 2X,A2,1X,E8.2, 1X,A1,1X,E8.2, A4)") & - n1, s1, n2, s2, "d=", ds, "=", ds / epsilon (ds), "*eps" - end if - end if - end subroutine compare_sigma - - subroutine compare_squared (n1, s1, n2, s2, s, threshold, tolerance) - real(kind=default), intent(in) :: s1, s2 - character(len=*), intent(in) :: n1, n2 - integer, dimension(:), intent(in) :: s - real(kind=default), intent(in) :: threshold - integer, intent(in), optional :: tolerance - real(kind=default) :: ds, tolerance_local - character(len=2) :: num - if (present (tolerance)) then - tolerance_local = tolerance * epsilon (tolerance_local) - else - tolerance_local = 1000 * epsilon (tolerance_local) - end if - if (max (s1, s2) >= threshold) then - ds = abs (s1 - s2) / (s1 + s2) - if (ds > tolerance_local) then - write (unit = num, fmt = "(I2)") size (s) - write (unit = *, fmt = "(" // num // & - "I3, 2(2X,A1,': ',E17.10), 2X,A2,1X,E8.2, 1X,A1,1X,E8.2, A4)") & - s, n1, s1, n2, s2, "d=", ds, "=", ds / epsilon (ds), "*eps" - end if - end if - end subroutine compare_squared - - subroutine compare (n1, a1, n2, a2, s, threshold, tolerance) - complex(kind=default), intent(in) :: a1, a2 - character(len=*), intent(in) :: n1, n2 - integer, dimension(:), intent(in) :: s - real(kind=default), intent(in) :: threshold - integer, intent(in), optional :: tolerance - real(kind=default) :: ds, tolerance_local - character(len=2) :: num - if (present (tolerance)) then - tolerance_local = tolerance * epsilon (tolerance_local) - else - tolerance_local = 1000 * epsilon (tolerance_local) - end if - if (max (abs (a1), abs (a2)) >= threshold) then - ds = abs (a1 - a2) / (abs (a1) + abs (a2)) - if (ds > tolerance_local) then - write (unit = num, fmt = "(I2)") size (s) - write (unit = *, fmt = "(" // num // & - "I3, 2(2X,A1,': (',E10.3,',',E10.3,')'), 2X,A2,1X,E8.2, 1X,A1,1X,E8.2, A3)") & - s, n1, a1, n2, a2, "d=", ds, "=", ds / epsilon (ds), "eps" - end if - end if - end subroutine compare - - subroutine compare_omega (n, omega1, omega2, spin_states, & - n_spin_states_in, roots, masses, tolerance) - integer, intent(in) :: n - integer, dimension(:,:), intent(in) :: spin_states - integer, intent(in) :: n_spin_states_in - real(kind=default), intent(in) :: roots - real(kind=default), dimension(:), intent(in) :: masses - integer, intent(in), optional :: tolerance - interface - pure function omega1 (p, s, f) result (m) - use kinds - implicit none - complex(kind=default) :: m - real(kind=default), dimension(0:,:), intent(in) :: p - integer, intent(in) :: s - integer, intent(in) :: f - end function omega1 - pure function omega2 (p, s, f) result (m) - use kinds - implicit none - complex(kind=default) :: m - real(kind=default), dimension(0:,:), intent(in) :: p - integer, intent(in) :: s - integer, intent(in) :: f - end function omega2 - end interface - integer :: k - real(kind=default) :: threshold, threshold1, threshold2 - complex(kind=default) :: a1, a2 - real(kind=default), dimension(0:3,size(masses)) :: p - integer :: s - call beams (roots, masses(1), masses(2), p(:,1), p(:,2)) - do k = 1, n - if (any (masses(3:) > 0)) then - call massive_decay (roots, masses(3:), p(:,3:)) - else - call massless_isotropic_decay (roots, p(:,3:)) - end if - threshold1 = & - omega_spin_sum_sqme_1 (omega1, p, 1, size (spin_states, dim=2)) & - / n_spin_states_in / 1000 - threshold2 = & - omega_spin_sum_sqme_1 (omega2, p, 1, size (spin_states, dim=2)) & - / n_spin_states_in / 1000 - threshold = max (threshold1, threshold2) - do s = 1, size (spin_states, dim=2) - a1 = omega1 (p, s, 1) - a2 = omega2 (p, s, 1) - call compare ("1", a1, "2", a2, spin_states(:,s), threshold, tolerance) - end do - end do - end subroutine compare_omega - - subroutine compare_omega_sum (n, omega1, omega2, roots, masses, states, tolerance) - integer, intent(in) :: n - real(kind=default), intent(in) :: roots - real(kind=default), dimension(:), intent(in) :: masses - integer, dimension(:), intent(in), optional :: states - integer, intent(in), optional :: tolerance - interface - pure function omega1 (p, s) result (m) - use kinds - implicit none - complex(kind=default) :: m - real(kind=default), dimension(0:,:), intent(in) :: p - integer, dimension(:), intent(in) :: s - end function omega1 - pure function omega2 (p, s) result (m) - use kinds - implicit none - complex(kind=default) :: m - real(kind=default), dimension(0:,:), intent(in) :: p - integer, dimension(:), intent(in) :: s - end function omega2 - end interface - integer :: k - real(kind=default) :: s1, s2 - real(kind=default), dimension(0:3,size(masses)) :: p - integer, dimension(:), allocatable :: zero - allocate (zero(num_states(size(masses),states))) - call beams (roots, masses(1), masses(2), p(:,1), p(:,2)) - zero = 0 - do k = 1, n - if (any (masses(3:) > 0)) then - call massive_decay (roots, masses(3:), p(:,3:)) - else - call massless_isotropic_decay (roots, p(:,3:)) - end if - call omega_sum_nonzero (s1, omega1, p, zero, k, states) - call omega_sum_nonzero (s2, omega2, p, zero, k, states) - call compare_sigma ("1", s1, "2", s2, THRESHOLD_SIGMA, tolerance) - end do - deallocate (zero) - end subroutine compare_omega_sum - - subroutine symmetry_omega (n, omega, roots, masses, sign, n1, n2, states, tolerance) - integer, intent(in) :: n - real(kind=default), intent(in) :: roots - real(kind=default), dimension(:), intent(in) :: masses - integer, intent(in) :: sign, n1, n2 - integer, dimension(:), intent(in), optional :: states - integer, intent(in), optional :: tolerance - interface - pure function omega (p, s) result (m) - use kinds - implicit none - complex(kind=default) :: m - real(kind=default), dimension(0:,:), intent(in) :: p - integer, dimension(:), intent(in) :: s - end function omega - end interface - integer, dimension(size(masses)) :: s, sx, nstates - real(kind=default), dimension(0:3,size(masses)) :: p, px - integer :: k, j - complex(kind=default) :: a, ax - real(kind=default) :: threshold - if (present (states)) then - nstates = states - else - nstates = 2 - end if - call beams (roots, masses(1), masses(2), p(:,1), p(:,2)) - do k = 1, n - if (any (masses(3:) > 0)) then - call massive_decay (roots, masses(3:), p(:,3:)) - else - call massless_isotropic_decay (roots, p(:,3:)) - end if - threshold = omega_sum (omega, p, states) & - / num_states (size(s) - 2, nstates(3:)) / 1000 - s = -1 - loop_spins: do - px = p - px(:,n1) = p(:,n2) - px(:,n2) = p(:,n1) - sx = s - sx(n1) = s(n2) - sx(n2) = s(n1) - a = omega (p, s) - ax = sign * omega (px, sx) - call compare ("r", a, "i", ax, s, threshold, tolerance) - do j = size (masses), 1, -1 - select case (nstates (j)) - case (3) - s(j) = modulo (s(j) + 2, 3) - 1 - case (2) - s(j) = - s(j) - case (1) - s(j) = -1 - case default - s(j) = -1 - end select - if (s(j) /= -1) then - cycle loop_spins - end if - end do - exit loop_spins - end do loop_spins - end do - end subroutine symmetry_omega - - subroutine check_omega (tag, n, omega1, omega2, & - roots, masses, symmetry, states, tolerance, mode) - character(len=*), intent(in) :: tag - integer, intent(in) :: n - real(kind=default), intent(in) :: roots - real(kind=default), dimension(:), intent(in) :: masses - integer, dimension(0:,:), intent(in), optional :: symmetry - integer, dimension(:), intent(in), optional :: states - integer, intent(in), optional :: tolerance - character(len=*), intent(in), optional :: mode - interface - pure function omega1 (p, s) result (m) - use kinds - implicit none - complex(kind=default) :: m - real(kind=default), dimension(0:,:), intent(in) :: p - integer, dimension(:), intent(in) :: s - end function omega1 - pure function omega2 (p, s) result (m) - use kinds - implicit none - complex(kind=default) :: m - real(kind=default), dimension(0:,:), intent(in) :: p - integer, dimension(:), intent(in) :: s - end function omega2 - end interface - integer :: i - character(len=8) :: mode_local - character(len=130) :: tags - print *, trim (tag) // ":" - call compare_omega_sum (n, omega1, omega2, roots, masses, states, tolerance) - return - print *, trim (tag) // " (polarized):" - ! call compare_omega (n, omega1, omega2, roots, masses, states, tolerance) - if (present (symmetry)) then - do i = 1, size (symmetry, dim=2) - write (unit = tags, fmt = "('(',I1,'<>',I1,')')") symmetry(1,i), symmetry(2,i) - if (symmetry(0,i) > 0) then - print *, trim (tag) // " - " // trim (tags) // ":" - else - print *, trim (tag) // " + " // trim (tags) // ":" - end if - call symmetry_omega (n, omega1, roots, masses, symmetry(0,i), & - symmetry(1,i), symmetry(2,i), states, tolerance) - end do - end if - end subroutine check_omega - - subroutine ward_omega (n, omega, roots, masses, i, states, tolerance) - integer, intent(in) :: n - real(kind=default), intent(in) :: roots - real(kind=default), dimension(:), intent(in) :: masses - integer, intent(in) :: i - integer, dimension(:), intent(in), optional :: states - integer, intent(in), optional :: tolerance - interface - pure function omega (p, s) result (m) - use kinds - implicit none - complex(kind=default) :: m - real(kind=default), dimension(0:,:), intent(in) :: p - integer, dimension(:), intent(in) :: s - end function omega - end interface - integer, dimension(size(masses)) :: s, nstates - real(kind=default), dimension(0:3,size(masses)) :: p - integer :: k, j - complex(kind=default) :: a - real(kind=default) :: a2, threshold - if (present (states)) then - nstates = states - else - nstates = 2 - end if - call beams (roots, masses(1), masses(2), p(:,1), p(:,2)) - do k = 1, n - if (any (masses(3:) > 0)) then - call massive_decay (roots, masses(3:), p(:,3:)) - else - call massless_isotropic_decay (roots, p(:,3:)) - end if - threshold = omega_sum (omega, p, states) & - / num_states (size(s) - 2, nstates(3:)) / 1000 - s = -1 - loop_spins: do - s(i) = -1 - a = omega (p, s) - a2 = a * conjg (a) - print *, s, a2 - if (nstates(i) == 3) then - s(i) = 0 - a = omega (p, s) - a2 = a * conjg (a) - print *, s, a2 - end if - s(i) = 1 - a = omega (p, s) - a2 = a * conjg (a) - print *, s, a2 - s(i) = 4 - a = omega (p, s) - a2 = a * conjg (a) - print *, s, a2 - ! call compare ("r", a, "i", ax, s, threshold, tolerance) - do j = size (masses), 1, -1 - if (j /= i) then - select case (nstates (j)) - case (3) - s(j) = modulo (s(j) + 2, 3) - 1 - case (2) - s(j) = - s(j) - case (1) - s(j) = -1 - case default - s(j) = -1 - end select - if (s(j) /= -1) then - cycle loop_spins - end if - end if - end do - exit loop_spins - end do loop_spins - end do - end subroutine ward_omega - - subroutine ward4 (n, omega, madgraph, roots, masses, i, states, tolerance) - integer, intent(in) :: n - real(kind=default), intent(in) :: roots - real(kind=default), dimension(:), intent(in) :: masses - integer, intent(in) :: i - integer, dimension(:), intent(in), optional :: states - integer, intent(in), optional :: tolerance - interface - pure function omega (p, s) result (m) - use kinds - implicit none - complex(kind=default) :: m - real(kind=default), dimension(0:,:), intent(in) :: p - integer, dimension(:), intent(in) :: s - end function omega - function madgraph (p1, p2, p3, p4, hel) result (m) - use kinds - implicit none - real(kind=default) :: m - real(kind=default), dimension(0:3), intent(in) :: p1, p2, p3, p4 - integer, dimension(4), intent(in) :: hel - end function madgraph - end interface - integer, dimension(size(masses)) :: s, nstates - real(kind=default), dimension(0:3,size(masses)) :: p - integer :: k, j - complex(kind=default) :: a - real(kind=default) :: a2, m2, threshold - if (present (states)) then - nstates = states - else - nstates = 2 - end if - call beams (roots, masses(1), masses(2), p(:,1), p(:,2)) - do k = 1, n - if (any (masses(3:) > 0)) then - call massive_decay (roots, masses(3:), p(:,3:)) - else - call massless_isotropic_decay (roots, p(:,3:)) - end if - threshold = omega_sum (omega, p, states) & - / num_states (size(s) - 2, nstates(3:)) / 1000 - s = -1 - loop_spins: do - s(i) = -1 - a = omega (p, s) - a2 = a * conjg (a) - m2 = madgraph (p(:,1), p(:,2), p(:,3), p(:,4), s) - print *, s, a2, m2 - if (nstates(i) == 3) then - s(i) = 0 - a = omega (p, s) - a2 = a * conjg (a) - m2 = madgraph (p(:,1), p(:,2), p(:,3), p(:,4), s) - print *, s, a2, m2 - end if - s(i) = 1 - a = omega (p, s) - a2 = a * conjg (a) - m2 = madgraph (p(:,1), p(:,2), p(:,3), p(:,4), s) - print *, s, a2, m2 - s(i) = 4 - a = omega (p, s) - a2 = a * conjg (a) - m2 = madgraph (p(:,1), p(:,2), p(:,3), p(:,4), s) - print *, s, a2, m2 - ! call compare ("r", a, "i", ax, s, threshold, tolerance) - do j = size (masses), 1, -1 - if (j /= i) then - select case (nstates (j)) - case (3) - s(j) = modulo (s(j) + 2, 3) - 1 - case (2) - s(j) = - s(j) - case (1) - s(j) = -1 - case default - s(j) = -1 - end select - if (s(j) /= -1) then - cycle loop_spins - end if - end if - end do - exit loop_spins - end do loop_spins - end do - end subroutine ward4 - - subroutine compare4_madgraph (n, omega, madgraph, roots, masses, states, tolerance) - integer, intent(in) :: n - real(kind=default), intent(in) :: roots - real(kind=default), dimension(:), intent(in) :: masses - integer, dimension(:), intent(in), optional :: states - integer, intent(in), optional :: tolerance - interface - pure function omega (p, s) result (m) - use kinds - implicit none - complex(kind=default) :: m - real(kind=default), dimension(0:,:), intent(in) :: p - integer, dimension(:), intent(in) :: s - end function omega - function madgraph (p1, p2, p3, p4, hel) result (m) - use kinds - implicit none - real(kind=default) :: m - real(kind=default), dimension(0:3) :: p1, p2, p3, p4 - integer, dimension(4) :: hel - end function madgraph - end interface - integer :: k, j - real(kind=default) :: threshold, sm, so - complex(kind=default) :: ao - real(kind=default), dimension(0:3,4) :: p - integer, dimension(4) :: s, nstates - if (present (states)) then - nstates = states - else - nstates = 2 - end if - call beams (roots, masses(1), masses(2), p(:,1), p(:,2)) - do k = 1, n - if (any (masses(3:) > 0)) then - call massive_decay (roots, masses(3:), p(:,3:)) - else - call massless_isotropic_decay (roots, p(:,3:)) - end if - s = -1 - threshold = omega_sum (omega, p, states) & - / num_states (size(s) - 2, nstates(3:)) / 1000 - loop_spins: do - sm = madgraph (p(:,1), p(:,2), p(:,3), p(:,4), s) - ao = omega (p, s) - so = ao * conjg (ao) - call compare_squared ("o", so, "m", sm, s, threshold, tolerance) - do j = size (masses), 1, -1 - select case (nstates (j)) - case (3) - s(j) = modulo (s(j) + 2, 3) - 1 - case (2) - s(j) = - s(j) - case (1) - s(j) = -1 - case default - s(j) = -1 - end select - if (s(j) /= -1) then - cycle loop_spins - end if - end do - exit loop_spins - end do loop_spins - end do - end subroutine compare4_madgraph - - subroutine compare5_madgraph (n, omega, madgraph, roots, masses, states, tolerance) - integer, intent(in) :: n - real(kind=default), intent(in) :: roots - real(kind=default), dimension(:), intent(in) :: masses - integer, dimension(:), intent(in), optional :: states - integer, intent(in), optional :: tolerance - interface - pure function omega (p, s) result (m) - use kinds - implicit none - complex(kind=default) :: m - real(kind=default), dimension(0:,:), intent(in) :: p - integer, dimension(:), intent(in) :: s - end function omega - function madgraph (p1, p2, p3, p4, p5, hel) result (m) - use kinds - implicit none - real(kind=default) :: m - real(kind=default), dimension(0:3) :: p1, p2, p3, p4, p5 - integer, dimension(5) :: hel - end function madgraph - end interface - integer :: k, j - real(kind=default) :: threshold, sm, so - complex(kind=default) :: ao - real(kind=default), dimension(0:3,5) :: p - integer, dimension(5) :: s, nstates - if (present (states)) then - nstates = states - else - nstates = 2 - end if - call beams (roots, masses(1), masses(2), p(:,1), p(:,2)) - do k = 1, n - if (any (masses(3:) > 0)) then - call massive_decay (roots, masses(3:), p(:,3:)) - else - call massless_isotropic_decay (roots, p(:,3:)) - end if - threshold = omega_sum (omega, p, states) & - / num_states (size(s) - 2, nstates(3:)) / 1000 - s = -1 - loop_spins: do - sm = madgraph (p(:,1), p(:,2), p(:,3), p(:,4), p(:,5), s) - ao = omega (p, s) - so = ao * conjg (ao) - call compare_squared ("o", so, "m", sm, s, threshold, tolerance) - do j = size (masses), 1, -1 - select case (nstates (j)) - case (3) - s(j) = modulo (s(j) + 2, 3) - 1 - case (2) - s(j) = - s(j) - case (1) - s(j) = -1 - case default - s(j) = -1 - end select - if (s(j) /= -1) then - cycle loop_spins - end if - end do - exit loop_spins - end do loop_spins - end do - end subroutine compare5_madgraph - - subroutine compare6_madgraph (n, omega, madgraph, roots, masses, states, tolerance) - integer, intent(in) :: n - real(kind=default), intent(in) :: roots - real(kind=default), dimension(:), intent(in) :: masses - integer, dimension(:), intent(in), optional :: states - integer, intent(in), optional :: tolerance - interface - pure function omega (p, s) result (m) - use kinds - implicit none - complex(kind=default) :: m - real(kind=default), dimension(0:,:), intent(in) :: p - integer, dimension(:), intent(in) :: s - end function omega - function madgraph (p1, p2, p3, p4, p5, p6, hel) result (m) - use kinds - implicit none - real(kind=default) :: m - real(kind=default), dimension(0:3) :: p1, p2, p3, p4, p5, p6 - integer, dimension(6) :: hel - end function madgraph - end interface - integer :: k, j - real(kind=default) :: threshold, sm, so - complex(kind=default) :: ao - real(kind=default), dimension(0:3,6) :: p - integer, dimension(6) :: s, nstates - if (present (states)) then - nstates = states - else - nstates = 2 - end if - call beams (roots, masses(1), masses(2), p(:,1), p(:,2)) - do k = 1, n - if (any (masses(3:) > 0)) then - call massive_decay (roots, masses(3:), p(:,3:)) - else - call massless_isotropic_decay (roots, p(:,3:)) - end if - threshold = omega_sum (omega, p, states) & - / num_states (size(s) - 2, nstates(3:)) / 1000 - s = -1 - loop_spins: do - sm = madgraph (p(:,1), p(:,2), p(:,3), p(:,4), p(:,5), p(:,6), s) - ao = omega (p, s) - so = ao * conjg (ao) - call compare_squared ("o", so, "m", sm, s, threshold, tolerance) - do j = size (masses), 1, -1 - select case (nstates (j)) - case (3) - s(j) = modulo (s(j) + 2, 3) - 1 - case (2) - s(j) = - s(j) - case (1) - s(j) = -1 - case default - s(j) = -1 - end select - if (s(j) /= -1) then - cycle loop_spins - end if - end do - exit loop_spins - end do loop_spins - end do - end subroutine compare6_madgraph - - subroutine compare7_madgraph (n, omega, madgraph, roots, masses, states, tolerance) - integer, intent(in) :: n - real(kind=default), intent(in) :: roots - real(kind=default), dimension(:), intent(in) :: masses - integer, dimension(:), intent(in), optional :: states - integer, intent(in), optional :: tolerance - interface - pure function omega (p, s) result (m) - use kinds - implicit none - complex(kind=default) :: m - real(kind=default), dimension(0:,:), intent(in) :: p - integer, dimension(:), intent(in) :: s - end function omega - function madgraph (p1, p2, p3, p4, p5, p6, p7, hel) result (m) - use kinds - implicit none - real(kind=default) :: m - real(kind=default), dimension(0:3) :: p1, p2, p3, p4, p5, p6, p7 - integer, dimension(7) :: hel - end function madgraph - end interface - integer :: k, j - real(kind=default) :: threshold, sm, so - complex(kind=default) :: ao - real(kind=default), dimension(0:3,7) :: p - integer, dimension(7) :: s, nstates - if (present (states)) then - nstates = states - else - nstates = 2 - end if - call beams (roots, masses(1), masses(2), p(:,1), p(:,2)) - do k = 1, n - if (any (masses(3:) > 0)) then - call massive_decay (roots, masses(3:), p(:,3:)) - else - call massless_isotropic_decay (roots, p(:,3:)) - end if - threshold = omega_sum (omega, p, states) & - / num_states (size(s) - 2, nstates(3:)) / 1000 - s = -1 - loop_spins: do - sm = madgraph (p(:,1), p(:,2), p(:,3), p(:,4), p(:,5), p(:,6), p(:,7), s) - ao = omega (p, s) - so = ao * conjg (ao) - call compare_squared ("o", so, "m", sm, s, threshold, tolerance) - do j = size (masses), 1, -1 - select case (nstates (j)) - case (3) - s(j) = modulo (s(j) + 2, 3) - 1 - case (2) - s(j) = - s(j) - case (1) - s(j) = -1 - case default - s(j) = -1 - end select - if (s(j) /= -1) then - cycle loop_spins - end if - end do - exit loop_spins - end do loop_spins - end do - end subroutine compare7_madgraph - - subroutine compare8_madgraph (n, omega, madgraph, roots, masses, states, tolerance) - integer, intent(in) :: n - real(kind=default), intent(in) :: roots - real(kind=default), dimension(:), intent(in) :: masses - integer, dimension(:), intent(in), optional :: states - integer, intent(in), optional :: tolerance - interface - pure function omega (p, s) result (m) - use kinds - implicit none - complex(kind=default) :: m - real(kind=default), dimension(0:,:), intent(in) :: p - integer, dimension(:), intent(in) :: s - end function omega - function madgraph (p1, p2, p3, p4, p5, p6, p7, p8, hel) result (m) - use kinds - implicit none - real(kind=default) :: m - real(kind=default), dimension(0:3) :: p1, p2, p3, p4, p5, p6, p7, p8 - integer, dimension(8) :: hel - end function madgraph - end interface - integer :: k, j - real(kind=default) :: threshold, sm, so - complex(kind=default) :: ao - real(kind=default), dimension(0:3,8) :: p - integer, dimension(8) :: s, nstates - if (present (states)) then - nstates = states - else - nstates = 2 - end if - call beams (roots, masses(1), masses(2), p(:,1), p(:,2)) - do k = 1, n - if (any (masses(3:) > 0)) then - call massive_decay (roots, masses(3:), p(:,3:)) - else - call massless_isotropic_decay (roots, p(:,3:)) - end if - threshold = omega_sum (omega, p, states) & - / num_states (size(s) - 2, nstates(3:)) / 1000 - s = -1 - loop_spins: do - sm = madgraph (p(:,1), p(:,2), p(:,3), p(:,4), p(:,5), p(:,6), p(:,7), p(:,8), s) - ao = omega (p, s) - so = ao * conjg (ao) - call compare_squared ("o", so, "m", sm, s, threshold, tolerance) - do j = size (masses), 1, -1 - select case (nstates (j)) - case (3) - s(j) = modulo (s(j) + 2, 3) - 1 - case (2) - s(j) = - s(j) - case (1) - s(j) = -1 - case default - s(j) = -1 - end select - if (s(j) /= -1) then - cycle loop_spins - end if - end do - exit loop_spins - end do loop_spins - end do - end subroutine compare8_madgraph - - subroutine compare_sum4_madgraph (n, omega, madgraph, roots, masses, states, tolerance, mode) - integer, intent(in) :: n - real(kind=default), intent(in) :: roots - real(kind=default), dimension(:), intent(in) :: masses - integer, dimension(:), intent(in), optional :: states - integer, intent(in), optional :: tolerance - character(len=*), intent(in), optional :: mode - interface - pure function omega (p, s) result (m) - use kinds - implicit none - complex(kind=default) :: m - real(kind=default), dimension(0:,:), intent(in) :: p - integer, dimension(:), intent(in) :: s - end function omega - function madgraph (p1, p2, p3, p4) result (s) - use kinds - implicit none - real(kind=default) :: s - real(kind=default), dimension(0:3) :: p1, p2, p3, p4 - end function madgraph - end interface - real(kind=default), save :: s = 0 - integer :: k - character(len=8) :: mode_local - real(kind=default) :: sm, so - real(kind=default), dimension(0:3,4) :: p - integer, dimension(:), allocatable :: zero - if (present (mode)) then - mode_local = mode - else - mode_local = "" - end if - call beams (roots, masses(1), masses(2), p(:,1), p(:,2)) - if (trim(mode_local) == "omega") then - allocate (zero(num_states(4,states))) - zero = 0 - do k = 1, n - if (any (masses(3:) > 0)) then - call massive_decay (roots, masses(3:), p(:,3:)) - else - call massless_isotropic_decay (roots, p(:,3:)) - end if - call omega_sum_nonzero (so, omega, p, zero, k, states) - s = s + so - end do - deallocate (zero) - else if (trim(mode_local) == "madgraph") then - do k = 1, n - if (any (masses(3:) > 0)) then - call massive_decay (roots, masses(3:), p(:,3:)) - else - call massless_isotropic_decay (roots, p(:,3:)) - end if - s = s + madgraph (p(:,1), p(:,2), p(:,3), p(:,4)) - end do - else - allocate (zero(num_states(4,states))) - zero = 0 - do k = 1, n - if (any (masses(3:) > 0)) then - call massive_decay (roots, masses(3:), p(:,3:)) - else - call massless_isotropic_decay (roots, p(:,3:)) - end if - call omega_sum_nonzero (so, omega, p, zero, k, states) - sm = madgraph (p(:,1), p(:,2), p(:,3), p(:,4)) - call compare_sigma ("o", so, "m", sm, THRESHOLD_SIGMA, tolerance) - end do - deallocate (zero) - end if - end subroutine compare_sum4_madgraph - - subroutine compare_sum5_madgraph (n, omega, madgraph, roots, masses, states, tolerance, mode) - integer, intent(in) :: n - real(kind=default), intent(in) :: roots - real(kind=default), dimension(:), intent(in) :: masses - integer, dimension(:), intent(in), optional :: states - integer, intent(in), optional :: tolerance - character(len=*), intent(in), optional :: mode - interface - pure function omega (p, s) result (m) - use kinds - implicit none - complex(kind=default) :: m - real(kind=default), dimension(0:,:), intent(in) :: p - integer, dimension(:), intent(in) :: s - end function omega - function madgraph (p1, p2, p3, p4, p5) result (s) - use kinds - implicit none - real(kind=default) :: s - real(kind=default), dimension(0:3) :: p1, p2, p3, p4, p5 - end function madgraph - end interface - real(kind=default), save :: s = 0 - integer :: k - character(len=8) :: mode_local - real(kind=default) :: sm, so - real(kind=default), dimension(0:3,5) :: p - integer, dimension(:), allocatable :: zero - if (present (mode)) then - mode_local = mode - else - mode_local = "" - end if - call beams (roots, masses(1), masses(2), p(:,1), p(:,2)) - if (trim(mode_local) == "omega") then - allocate (zero(num_states(5,states))) - zero = 0 - do k = 1, n - if (any (masses(3:) > 0)) then - call massive_decay (roots, masses(3:), p(:,3:)) - else - call massless_isotropic_decay (roots, p(:,3:)) - end if - call omega_sum_nonzero (so, omega, p, zero, k, states) - s = s + so - end do - deallocate (zero) - else if (trim(mode_local) == "madgraph") then - do k = 1, n - if (any (masses(3:) > 0)) then - call massive_decay (roots, masses(3:), p(:,3:)) - else - call massless_isotropic_decay (roots, p(:,3:)) - end if - s = s + madgraph (p(:,1), p(:,2), p(:,3), p(:,4), p(:,5)) - end do - else - allocate (zero(num_states(5,states))) - zero = 0 - do k = 1, n - if (any (masses(3:) > 0)) then - call massive_decay (roots, masses(3:), p(:,3:)) - else - call massless_isotropic_decay (roots, p(:,3:)) - end if - call omega_sum_nonzero (so, omega, p, zero, k, states) - sm = madgraph (p(:,1), p(:,2), p(:,3), p(:,4), p(:,5)) - call compare_sigma ("o", so, "m", sm, THRESHOLD_SIGMA, tolerance) - end do - deallocate (zero) - end if - end subroutine compare_sum5_madgraph - - subroutine compare_sum6_madgraph (n, omega, madgraph, roots, masses, states, tolerance, mode) - integer, intent(in) :: n - real(kind=default), intent(in) :: roots - real(kind=default), dimension(:), intent(in) :: masses - integer, dimension(:), intent(in), optional :: states - integer, intent(in), optional :: tolerance - character(len=*), intent(in), optional :: mode - interface - pure function omega (p, s) result (m) - use kinds - implicit none - complex(kind=default) :: m - real(kind=default), dimension(0:,:), intent(in) :: p - integer, dimension(:), intent(in) :: s - end function omega - function madgraph (p1, p2, p3, p4, p5, p6) result (s) - use kinds - implicit none - real(kind=default) :: s - real(kind=default), dimension(0:3) :: p1, p2, p3, p4, p5, p6 - end function madgraph - end interface - real(kind=default), save :: s = 0 - integer :: k - character(len=8) :: mode_local - real(kind=default) :: sm, so - real(kind=default), dimension(0:3,6) :: p - integer, dimension(:), allocatable :: zero - if (present (mode)) then - mode_local = mode - else - mode_local = "" - end if - call beams (roots, masses(1), masses(2), p(:,1), p(:,2)) - if (trim(mode_local) == "omega") then - allocate (zero(num_states(6,states))) - zero = 0 - do k = 1, n - if (any (masses(3:) > 0)) then - call massive_decay (roots, masses(3:), p(:,3:)) - else - call massless_isotropic_decay (roots, p(:,3:)) - end if - call omega_sum_nonzero (so, omega, p, zero, k, states) - s = s + so - end do - deallocate (zero) - else if (trim(mode_local) == "madgraph") then - do k = 1, n - if (any (masses(3:) > 0)) then - call massive_decay (roots, masses(3:), p(:,3:)) - else - call massless_isotropic_decay (roots, p(:,3:)) - end if - s = s + madgraph (p(:,1), p(:,2), p(:,3), p(:,4), p(:,5), p(:,6)) - end do - else - allocate (zero(num_states(6,states))) - zero = 0 - do k = 1, n - if (any (masses(3:) > 0)) then - call massive_decay (roots, masses(3:), p(:,3:)) - else - call massless_isotropic_decay (roots, p(:,3:)) - end if - call omega_sum_nonzero (so, omega, p, zero, k, states) - sm = madgraph (p(:,1), p(:,2), p(:,3), p(:,4), p(:,5), p(:,6)) - call compare_sigma ("o", so, "m", sm, THRESHOLD_SIGMA, tolerance) - end do - deallocate (zero) - end if - end subroutine compare_sum6_madgraph - - subroutine compare_sum7_madgraph (n, omega, madgraph, roots, masses, states, tolerance, mode) - integer, intent(in) :: n - real(kind=default), intent(in) :: roots - real(kind=default), dimension(:), intent(in) :: masses - integer, dimension(:), intent(in), optional :: states - integer, intent(in), optional :: tolerance - character(len=*), intent(in), optional :: mode - interface - pure function omega (p, s) result (m) - use kinds - implicit none - complex(kind=default) :: m - real(kind=default), dimension(0:,:), intent(in) :: p - integer, dimension(:), intent(in) :: s - end function omega - function madgraph (p1, p2, p3, p4, p5, p6, p7) result (s) - use kinds - implicit none - real(kind=default) :: s - real(kind=default), dimension(0:3) :: p1, p2, p3, p4, p5, p6, p7 - end function madgraph - end interface - real(kind=default), save :: s = 0 - integer :: k - character(len=8) :: mode_local - real(kind=default) :: sm, so - real(kind=default), dimension(0:3,7) :: p - integer, dimension(:), allocatable :: zero - if (present (mode)) then - mode_local = mode - else - mode_local = "" - end if - call beams (roots, masses(1), masses(2), p(:,1), p(:,2)) - if (trim(mode_local) == "omega") then - allocate (zero(num_states(7,states))) - zero = 0 - do k = 1, n - if (any (masses(3:) > 0)) then - call massive_decay (roots, masses(3:), p(:,3:)) - else - call massless_isotropic_decay (roots, p(:,3:)) - end if - call omega_sum_nonzero (so, omega, p, zero, k, states) - s = s + so - end do - deallocate (zero) - else if (trim(mode_local) == "madgraph") then - do k = 1, n - if (any (masses(3:) > 0)) then - call massive_decay (roots, masses(3:), p(:,3:)) - else - call massless_isotropic_decay (roots, p(:,3:)) - end if - s = s + madgraph (p(:,1), p(:,2), p(:,3), p(:,4), p(:,5), p(:,6), p(:,7)) - end do - else - allocate (zero(num_states(7,states))) - zero = 0 - do k = 1, n - if (any (masses(3:) > 0)) then - call massive_decay (roots, masses(3:), p(:,3:)) - else - call massless_isotropic_decay (roots, p(:,3:)) - end if - call omega_sum_nonzero (so, omega, p, zero, k, states) - sm = madgraph (p(:,1), p(:,2), p(:,3), p(:,4), p(:,5), p(:,6), p(:,7)) - call compare_sigma ("o", so, "m", sm, THRESHOLD_SIGMA, tolerance) - end do - deallocate (zero) - end if - end subroutine compare_sum7_madgraph - - subroutine compare_sum8_madgraph (n, omega, madgraph, roots, masses, states, tolerance, mode) - integer, intent(in) :: n - real(kind=default), intent(in) :: roots - real(kind=default), dimension(:), intent(in) :: masses - integer, dimension(:), intent(in), optional :: states - integer, intent(in), optional :: tolerance - character(len=*), intent(in), optional :: mode - interface - pure function omega (p, s) result (m) - use kinds - implicit none - complex(kind=default) :: m - real(kind=default), dimension(0:,:), intent(in) :: p - integer, dimension(:), intent(in) :: s - end function omega - function madgraph (p1, p2, p3, p4, p5, p6, p7, p8) result (s) - use kinds - implicit none - real(kind=default) :: s - real(kind=default), dimension(0:3) :: p1, p2, p3, p4, p5, p6, p7, p8 - end function madgraph - end interface - real(kind=default), save :: s = 0 - integer :: k - character(len=8) :: mode_local - real(kind=default) :: sm, so - real(kind=default), dimension(0:3,8) :: p - integer, dimension(:), allocatable :: zero - if (present (mode)) then - mode_local = mode - else - mode_local = "" - end if - call beams (roots, masses(1), masses(2), p(:,1), p(:,2)) - if (trim(mode_local) == "omega") then - allocate (zero(num_states(8,states))) - zero = 0 - do k = 1, n - if (any (masses(3:) > 0)) then - call massive_decay (roots, masses(3:), p(:,3:)) - else - call massless_isotropic_decay (roots, p(:,3:)) - end if - call omega_sum_nonzero (so, omega, p, zero, k, states) - s = s + so - end do - deallocate (zero) - else if (trim(mode_local) == "madgraph") then - do k = 1, n - if (any (masses(3:) > 0)) then - call massive_decay (roots, masses(3:), p(:,3:)) - else - call massless_isotropic_decay (roots, p(:,3:)) - end if - s = s + madgraph (p(:,1), p(:,2), p(:,3), p(:,4), p(:,5), p(:,6), p(:,7), p(:,8)) - end do - else - allocate (zero(num_states(8,states))) - zero = 0 - do k = 1, n - if (any (masses(3:) > 0)) then - call massive_decay (roots, masses(3:), p(:,3:)) - else - call massless_isotropic_decay (roots, p(:,3:)) - end if - call omega_sum_nonzero (so, omega, p, zero, k, states) - sm = madgraph (p(:,1), p(:,2), p(:,3), p(:,4), p(:,5), p(:,6), p(:,7), p(:,8)) - call compare_sigma ("o", so, "m", sm, THRESHOLD_SIGMA, tolerance) - end do - deallocate (zero) - end if - end subroutine compare_sum8_madgraph - - subroutine check4_madgraph (tag, n, omega, smadgraph, madgraph, & - roots, masses, symmetry, states, tolerance, mode) - character(len=*), intent(in) :: tag - integer, intent(in) :: n - real(kind=default), intent(in) :: roots - real(kind=default), dimension(:), intent(in) :: masses - integer, dimension(0:,:), intent(in), optional :: symmetry - integer, dimension(:), intent(in), optional :: states - integer, intent(in), optional :: tolerance - character(len=*), intent(in), optional :: mode - interface - pure function omega (p, s) result (m) - use kinds - implicit none - complex(kind=default) :: m - real(kind=default), dimension(0:,:), intent(in) :: p - integer, dimension(:), intent(in) :: s - end function omega - function smadgraph (p1, p2, p3, p4) result (s) - use kinds - implicit none - real(kind=default) :: s - real(kind=default), dimension(0:3) :: p1, p2, p3, p4 - end function smadgraph - function madgraph (p1, p2, p3, p4, hel) result (m) - use kinds - implicit none - real(kind=default) :: m - real(kind=default), dimension(0:3) :: p1, p2, p3, p4 - integer, dimension(4) :: hel - end function madgraph - end interface - integer :: i - character(len=8) :: mode_local - character(len=130) :: tags - if (present (mode)) then - mode_local = mode - else - mode_local = "compare" - end if - if (trim (mode_local) == "compare") then - print *, trim (tag) // ":" - call compare_sum4_madgraph (n, omega, smadgraph, roots, masses, states, tolerance) - print *, trim (tag) // " (polarized):" - call compare4_madgraph (n, omega, madgraph, roots, masses, states, tolerance) - if (present (symmetry)) then - do i = 1, size (symmetry, dim=2) - write (unit = tags, fmt = "('(',I1,'<>',I1,')')") symmetry(1,i), symmetry(2,i) - if (symmetry(0,i) > 0) then - print *, trim (tag) // " - " // trim (tags) // ":" - else - print *, trim (tag) // " + " // trim (tags) // ":" - end if - call symmetry_omega (n, omega, roots, masses, symmetry(0,i), & - symmetry(1,i), symmetry(2,i), states, tolerance) - end do - end if - else - print *, trim (tag) // " (" // trim (mode_local) // "):" - call compare_sum4_madgraph (n, omega, smadgraph, roots, masses, states, & - tolerance, mode = mode_local) - end if - end subroutine check4_madgraph - - subroutine check5_madgraph (tag, n, omega, smadgraph, madgraph, & - roots, masses, symmetry, states, tolerance, mode) - character(len=*), intent(in) :: tag - integer, intent(in) :: n - real(kind=default), intent(in) :: roots - real(kind=default), dimension(:), intent(in) :: masses - integer, dimension(0:,:), intent(in), optional :: symmetry - integer, dimension(:), intent(in), optional :: states - integer, intent(in), optional :: tolerance - character(len=*), intent(in), optional :: mode - interface - pure function omega (p, s) result (m) - use kinds - implicit none - complex(kind=default) :: m - real(kind=default), dimension(0:,:), intent(in) :: p - integer, dimension(:), intent(in) :: s - end function omega - function smadgraph (p1, p2, p3, p4, p5) result (s) - use kinds - implicit none - real(kind=default) :: s - real(kind=default), dimension(0:3) :: p1, p2, p3, p4, p5 - end function smadgraph - function madgraph (p1, p2, p3, p4, p5, hel) result (m) - use kinds - implicit none - real(kind=default) :: m - real(kind=default), dimension(0:3) :: p1, p2, p3, p4, p5 - integer, dimension(5) :: hel - end function madgraph - end interface - integer :: i - character(len=8) :: mode_local - character(len=130) :: tags - if (present (mode)) then - mode_local = mode - else - mode_local = "compare" - end if - if (trim (mode_local) == "compare") then - print *, trim (tag) // ":" - call compare_sum5_madgraph (n, omega, smadgraph, roots, masses, states, tolerance) - print *, trim (tag) // " (polarized):" - call compare5_madgraph (n, omega, madgraph, roots, masses, states, tolerance) - if (present (symmetry)) then - do i = 1, size (symmetry, dim=2) - write (unit = tags, fmt = "('(',I1,'<>',I1,')')") symmetry(1,i), symmetry(2,i) - if (symmetry(0,i) > 0) then - print *, trim (tag) // " - " // trim (tags) // ":" - else - print *, trim (tag) // " + " // trim (tags) // ":" - end if - call symmetry_omega (n, omega, roots, masses, symmetry(0,i), & - symmetry(1,i), symmetry(2,i), states, tolerance) - end do - end if - else - print *, trim (tag) // " (" // trim (mode_local) // "):" - call compare_sum5_madgraph (n, omega, smadgraph, roots, masses, states, & - tolerance, mode = mode_local) - end if - end subroutine check5_madgraph - - subroutine check6_madgraph (tag, n, omega, smadgraph, madgraph, & - roots, masses, symmetry, states, tolerance, mode) - character(len=*), intent(in) :: tag - integer, intent(in) :: n - real(kind=default), intent(in) :: roots - real(kind=default), dimension(:), intent(in) :: masses - integer, dimension(0:,:), intent(in), optional :: symmetry - integer, dimension(:), intent(in), optional :: states - integer, intent(in), optional :: tolerance - character(len=*), intent(in), optional :: mode - interface - pure function omega (p, s) result (m) - use kinds - implicit none - complex(kind=default) :: m - real(kind=default), dimension(0:,:), intent(in) :: p - integer, dimension(:), intent(in) :: s - end function omega - function smadgraph (p1, p2, p3, p4, p5, p6) result (s) - use kinds - implicit none - real(kind=default) :: s -! real(kind=default), dimension(0:3), intent(in) :: & - real(kind=default), dimension(0:3) :: & - p1, p2, p3, p4, p5, p6 - end function smadgraph - function madgraph (p1, p2, p3, p4, p5, p6, hel) result (m) - use kinds - implicit none - real(kind=default) :: m - real(kind=default), dimension(0:3) :: p1, p2, p3, p4, p5, p6 - integer, dimension(6) :: hel - end function madgraph - end interface - integer :: i - character(len=8) :: mode_local - character(len=130) :: tags - if (present (mode)) then - mode_local = mode - else - mode_local = "compare" - end if - if (trim (mode_local) == "compare") then - print *, trim (tag) // ":" - call compare_sum6_madgraph (n, omega, smadgraph, roots, masses, states, tolerance) - print *, trim (tag) // " (polarized):" - call compare6_madgraph (n, omega, madgraph, roots, masses, states, tolerance) - if (present (symmetry)) then - do i = 1, size (symmetry, dim=2) - write (unit = tags, fmt = "('(',I1,'<>',I1,')')") symmetry(1,i), symmetry(2,i) - if (symmetry(0,i) > 0) then - print *, trim (tag) // " - " // trim (tags) // ":" - else - print *, trim (tag) // " + " // trim (tags) // ":" - end if - call symmetry_omega (n, omega, roots, masses, symmetry(0,i), & - symmetry(1,i), symmetry(2,i), states, tolerance) - end do - end if - else - print *, trim (tag) // " (" // trim (mode_local) // "):" - call compare_sum6_madgraph (n, omega, smadgraph, roots, masses, states, & - tolerance, mode = mode_local) - end if - end subroutine check6_madgraph - - subroutine check7_madgraph (tag, n, omega, smadgraph, madgraph, & - roots, masses, symmetry, states, tolerance, mode) - character(len=*), intent(in) :: tag - integer, intent(in) :: n - real(kind=default), intent(in) :: roots - real(kind=default), dimension(:), intent(in) :: masses - integer, dimension(0:,:), intent(in), optional :: symmetry - integer, dimension(:), intent(in), optional :: states - integer, intent(in), optional :: tolerance - character(len=*), intent(in), optional :: mode - interface - pure function omega (p, s) result (m) - use kinds - implicit none - complex(kind=default) :: m - real(kind=default), dimension(0:,:), intent(in) :: p - integer, dimension(:), intent(in) :: s - end function omega - function smadgraph (p1, p2, p3, p4, p5, p6, p7) result (s) - use kinds - implicit none - real(kind=default) :: s - real(kind=default), dimension(0:3) :: p1, p2, p3, p4, p5, p6, p7 - end function smadgraph - function madgraph (p1, p2, p3, p4, p5, p6, p7, hel) result (m) - use kinds - implicit none - real(kind=default) :: m - real(kind=default), dimension(0:3) :: p1, p2, p3, p4, p5, p6, p7 - integer, dimension(7) :: hel - end function madgraph - end interface - integer :: i - character(len=8) :: mode_local - character(len=130) :: tags - if (present (mode)) then - mode_local = mode - else - mode_local = "compare" - end if - if (trim (mode_local) == "compare") then - print *, trim (tag) // ":" - call compare_sum7_madgraph (n, omega, smadgraph, roots, masses, states, tolerance) - print *, trim (tag) // " (polarized):" - call compare7_madgraph (n, omega, madgraph, roots, masses, states, tolerance) - if (present (symmetry)) then - do i = 1, size (symmetry, dim=2) - write (unit = tags, fmt = "('(',I1,'<>',I1,')')") symmetry(1,i), symmetry(2,i) - if (symmetry(0,i) > 0) then - print *, trim (tag) // " - " // trim (tags) // ":" - else - print *, trim (tag) // " + " // trim (tags) // ":" - end if - call symmetry_omega (n, omega, roots, masses, symmetry(0,i), & - symmetry(1,i), symmetry(2,i), states, tolerance) - end do - end if - else - print *, trim (tag) // " (" // trim (mode_local) // "):" - call compare_sum7_madgraph (n, omega, smadgraph, roots, masses, states, & - tolerance, mode = mode_local) - end if - end subroutine check7_madgraph - - subroutine check8_madgraph (tag, n, omega, smadgraph, madgraph, & - roots, masses, symmetry, states, tolerance, mode) - character(len=*), intent(in) :: tag - integer, intent(in) :: n - real(kind=default), intent(in) :: roots - real(kind=default), dimension(:), intent(in) :: masses - integer, dimension(0:,:), intent(in), optional :: symmetry - integer, dimension(:), intent(in), optional :: states - integer, intent(in), optional :: tolerance - character(len=*), intent(in), optional :: mode - interface - pure function omega (p, s) result (m) - use kinds - implicit none - complex(kind=default) :: m - real(kind=default), dimension(0:,:), intent(in) :: p - integer, dimension(:), intent(in) :: s - end function omega - function smadgraph (p1, p2, p3, p4, p5, p6, p7, p8) result (s) - use kinds - implicit none - real(kind=default) :: s - real(kind=default), dimension(0:3) :: p1, p2, p3, p4, p5, p6, p7, p8 - end function smadgraph - function madgraph (p1, p2, p3, p4, p5, p6, p7, p8, hel) result (m) - use kinds - implicit none - real(kind=default) :: m - real(kind=default), dimension(0:3) :: p1, p2, p3, p4, p5, p6, p7, p8 - integer, dimension(8) :: hel - end function madgraph - end interface - integer :: i - character(len=8) :: mode_local - character(len=130) :: tags - if (present (mode)) then - mode_local = mode - else - mode_local = "compare" - end if - if (trim (mode_local) == "compare") then - print *, trim (tag) // ":" - call compare_sum8_madgraph (n, omega, smadgraph, roots, masses, states, tolerance) - print *, trim (tag) // " (polarized):" - call compare8_madgraph (n, omega, madgraph, roots, masses, states, tolerance) - if (present (symmetry)) then - do i = 1, size (symmetry, dim=2) - write (unit = tags, fmt = "('(',I1,'<>',I1,')')") symmetry(1,i), symmetry(2,i) - if (symmetry(0,i) > 0) then - print *, trim (tag) // " - " // trim (tags) // ":" - else - print *, trim (tag) // " + " // trim (tags) // ":" - end if - call symmetry_omega (n, omega, roots, masses, symmetry(0,i), & - symmetry(1,i), symmetry(2,i), states, tolerance) - end do - end if - else - print *, trim (tag) // " (" // trim (mode_local) // "):" - call compare_sum8_madgraph (n, omega, smadgraph, roots, masses, states, & - tolerance, mode = mode_local) - end if - end subroutine check8_madgraph - -end module testbed Index: branches/ohl/omega-development/completed/whizard2/tools/tao_random_numbers.f95 =================================================================== --- branches/ohl/omega-development/completed/whizard2/tools/tao_random_numbers.f95 (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/tools/tao_random_numbers.f95 (revision 8703) @@ -1,897 +0,0 @@ -! $Id$ -! -! Copyright (C) 1999-2009 by -! -! Wolfgang Kilian -! Thorsten Ohl -! Juergen Reuter -! -! WHIZARD is free software; you can redistribute it and/or modify it -! under the terms of the GNU General Public License as published by -! the Free Software Foundation; either version 2, or (at your option) -! any later version. -! -! WHIZARD is distributed in the hope that it will be useful, but -! WITHOUT ANY WARRANTY; without even the implied warranty of -! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -! GNU General Public License for more details. -! -! You should have received a copy of the GNU General Public License -! along with this program; if not, write to the Free Software -! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -! -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! This version of the source code of vamp has no comments and -! can be hard to understand, modify, and improve. You should have -! received a copy of the literate noweb sources of vamp that -! contain the documentation in full detail. -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -module tao_random_numbers - implicit none - private :: generate - private :: seed_static, seed_state, seed_raw_state - private :: seed_stateless - private :: create_state_from_seed, create_raw_state_from_seed, & - create_state_from_state, create_raw_state_from_state, & - create_state_from_raw_state, create_raw_state_from_raw_st - private :: destroy_state, destroy_raw_state - public :: assignment(=) - private :: copy_state, copy_raw_state, & - copy_raw_state_to_state, copy_state_to_raw_state - private :: write_state_unit, write_state_name - private :: write_raw_state_unit, write_raw_state_name - private :: read_state_unit, read_state_name - private :: read_raw_state_unit, read_raw_state_name - private :: find_free_unit - public :: tao_random_marshal - private :: marshal_state, marshal_raw_state - public :: tao_random_marshal_size - private :: marshal_state_size, marshal_raw_state_size - public :: tao_random_unmarshal - private :: unmarshal_state, unmarshal_raw_state - public :: tao_random_number - public :: tao_random_seed - public :: tao_random_create - public :: tao_random_destroy - public :: tao_random_copy - public :: tao_random_read - public :: tao_random_write - public :: tao_random_flush - public :: tao_random_luxury - public :: tao_random_test - private :: luxury_stateless - private :: luxury_static, luxury_state, & - luxury_static_integer, luxury_state_integer, & - luxury_static_real, luxury_state_real, & - luxury_static_double, luxury_state_double - private :: write_state_array - private :: read_state_array - private :: & - integer_stateless, integer_array_stateless, & - real_stateless, real_array_stateless, & - double_stateless, double_array_stateless - private :: integer_static, integer_state, & - integer_array_static, integer_array_state, & - real_static, real_state, real_array_static, real_array_state, & - double_static, double_state, double_array_static, double_array_state - interface tao_random_seed - module procedure seed_static, seed_state, seed_raw_state - end interface - interface tao_random_create - module procedure create_state_from_seed, create_raw_state_from_seed, & - create_state_from_state, create_raw_state_from_state, & - create_state_from_raw_state, create_raw_state_from_raw_st - end interface - interface tao_random_destroy - module procedure destroy_state, destroy_raw_state - end interface - interface tao_random_copy - module procedure copy_state, copy_raw_state, & - copy_raw_state_to_state, copy_state_to_raw_state - end interface - interface assignment(=) - module procedure copy_state, copy_raw_state, & - copy_raw_state_to_state, copy_state_to_raw_state - end interface - interface tao_random_write - module procedure & - write_state_unit, write_state_name, & - write_raw_state_unit, write_raw_state_name - end interface - interface tao_random_read - module procedure & - read_state_unit, read_state_name, & - read_raw_state_unit, read_raw_state_name - end interface - interface tao_random_marshal_size - module procedure marshal_state_size, marshal_raw_state_size - end interface - interface tao_random_marshal - module procedure marshal_state, marshal_raw_state - end interface - interface tao_random_unmarshal - module procedure unmarshal_state, unmarshal_raw_state - end interface - interface tao_random_luxury - module procedure luxury_static, luxury_state, & - luxury_static_integer, luxury_state_integer, & - luxury_static_real, luxury_state_real, & - luxury_static_double, luxury_state_double - end interface - interface tao_random_number - module procedure integer_static, integer_state, & - integer_array_static, integer_array_state, & - real_static, real_state, real_array_static, real_array_state, & - double_static, double_state, double_array_static, double_array_state - end interface - integer, parameter, private:: & - int32 = selected_int_kind (9), & - double = selected_real_kind (precision (1.0) + 1, range (1.0) + 1) - integer, parameter, private :: K = 100, L = 37 - integer, parameter, private :: DEFAULT_BUFFER_SIZE = 1009 - integer, parameter, private :: MIN_UNIT = 11, MAX_UNIT = 99 - integer(kind=int32), parameter, private :: M = 2**30 - integer(kind=int32), dimension(K), save, private :: s_state - logical, save, private :: s_virginal = .true. - integer(kind=int32), dimension(DEFAULT_BUFFER_SIZE), save, private :: s_buffer - integer, save, private :: s_buffer_end = size (s_buffer) - integer, save, private :: s_last = size (s_buffer) - type, public :: tao_random_raw_state - integer(kind=int32), dimension(K) :: x - end type tao_random_raw_state - type, public :: tao_random_state - type(tao_random_raw_state) :: state - integer(kind=int32), dimension(:), pointer :: buffer =>null() - integer :: buffer_end, last - end type tao_random_state - character(len=*), public, parameter :: TAO_RANDOM_NUMBERS_RCS_ID = & - "$Id$" -contains - subroutine seed_static (seed) - integer, optional, intent(in) :: seed - call seed_stateless (s_state, seed) - s_virginal = .false. - s_last = size (s_buffer) - end subroutine seed_static - elemental subroutine seed_raw_state (s, seed) - type(tao_random_raw_state), intent(inout) :: s - integer, optional, intent(in) :: seed - call seed_stateless (s%x, seed) - end subroutine seed_raw_state - elemental subroutine seed_state (s, seed) - type(tao_random_state), intent(inout) :: s - integer, optional, intent(in) :: seed - call seed_raw_state (s%state, seed) - s%last = size (s%buffer) - end subroutine seed_state - elemental subroutine create_state_from_seed (s, seed, buffer_size) - type(tao_random_state), intent(out) :: s - integer, intent(in) :: seed - integer, intent(in), optional :: buffer_size - call create_raw_state_from_seed (s%state, seed) - if (present (buffer_size)) then - s%buffer_end = max (buffer_size, K) - else - s%buffer_end = DEFAULT_BUFFER_SIZE - end if - allocate (s%buffer(s%buffer_end)) - call tao_random_flush (s) - end subroutine create_state_from_seed - elemental subroutine create_state_from_state (s, state) - type(tao_random_state), intent(out) :: s - type(tao_random_state), intent(in) :: state - call create_raw_state_from_raw_st (s%state, state%state) - allocate (s%buffer(size(state%buffer))) - call tao_random_copy (s, state) - end subroutine create_state_from_state - elemental subroutine create_state_from_raw_state & - (s, raw_state, buffer_size) - type(tao_random_state), intent(out) :: s - type(tao_random_raw_state), intent(in) :: raw_state - integer, intent(in), optional :: buffer_size - call create_raw_state_from_raw_st (s%state, raw_state) - if (present (buffer_size)) then - s%buffer_end = max (buffer_size, K) - else - s%buffer_end = DEFAULT_BUFFER_SIZE - end if - allocate (s%buffer(s%buffer_end)) - call tao_random_flush (s) - end subroutine create_state_from_raw_state - elemental subroutine create_raw_state_from_seed (s, seed) - type(tao_random_raw_state), intent(out) :: s - integer, intent(in) :: seed - call seed_raw_state (s, seed) - end subroutine create_raw_state_from_seed - elemental subroutine create_raw_state_from_state (s, state) - type(tao_random_raw_state), intent(out) :: s - type(tao_random_state), intent(in) :: state - call copy_state_to_raw_state (s, state) - end subroutine create_raw_state_from_state - elemental subroutine create_raw_state_from_raw_st (s, raw_state) - type(tao_random_raw_state), intent(out) :: s - type(tao_random_raw_state), intent(in) :: raw_state - call copy_raw_state (s, raw_state) - end subroutine create_raw_state_from_raw_st - elemental subroutine destroy_state (s) - type(tao_random_state), intent(inout) :: s - deallocate (s%buffer) - end subroutine destroy_state - elemental subroutine destroy_raw_state (s) - type(tao_random_raw_state), intent(inout) :: s - end subroutine destroy_raw_state - elemental subroutine copy_state (lhs, rhs) - type(tao_random_state), intent(inout) :: lhs - type(tao_random_state), intent(in) :: rhs - call copy_raw_state (lhs%state, rhs%state) - if (size (lhs%buffer) /= size (rhs%buffer)) then - deallocate (lhs%buffer) - allocate (lhs%buffer(size(rhs%buffer))) - end if - lhs%buffer = rhs%buffer - lhs%buffer_end = rhs%buffer_end - lhs%last = rhs%last - end subroutine copy_state - elemental subroutine copy_raw_state (lhs, rhs) - type(tao_random_raw_state), intent(out) :: lhs - type(tao_random_raw_state), intent(in) :: rhs - lhs%x = rhs%x - end subroutine copy_raw_state - elemental subroutine copy_raw_state_to_state (lhs, rhs) - type(tao_random_state), intent(inout) :: lhs - type(tao_random_raw_state), intent(in) :: rhs - call copy_raw_state (lhs%state, rhs) - call tao_random_flush (lhs) - end subroutine copy_raw_state_to_state - elemental subroutine copy_state_to_raw_state (lhs, rhs) - type(tao_random_raw_state), intent(out) :: lhs - type(tao_random_state), intent(in) :: rhs - call copy_raw_state (lhs, rhs%state) - end subroutine copy_state_to_raw_state - elemental subroutine tao_random_flush (s) - type(tao_random_state), intent(inout) :: s - s%last = size (s%buffer) - end subroutine tao_random_flush - subroutine write_state_unit (s, unit) - type(tao_random_state), intent(in) :: s - integer, intent(in) :: unit - write (unit = unit, fmt = *) "BEGIN TAO_RANDOM_STATE" - call write_raw_state_unit (s%state, unit) - write (unit = unit, fmt = "(2(1x,a16,1x,i10/),1x,a16,1x,i10)") & - "BUFFER_SIZE", size (s%buffer), & - "BUFFER_END", s%buffer_end, & - "LAST", s%last - write (unit = unit, fmt = *) "BEGIN BUFFER" - call write_state_array (s%buffer, unit) - write (unit = unit, fmt = *) "END BUFFER" - write (unit = unit, fmt = *) "END TAO_RANDOM_STATE" - end subroutine write_state_unit - subroutine read_state_unit (s, unit) - type(tao_random_state), intent(inout) :: s - integer, intent(in) :: unit - integer :: buffer_size - read (unit = unit, fmt = *) - call read_raw_state_unit (s%state, unit) - read (unit = unit, fmt = "(2(1x,16x,1x,i10/),1x,16x,1x,i10)") & - buffer_size, s%buffer_end, s%last - read (unit = unit, fmt = *) - if (buffer_size /= size (s%buffer)) then - deallocate (s%buffer) - allocate (s%buffer(buffer_size)) - end if - call read_state_array (s%buffer, unit) - read (unit = unit, fmt = *) - read (unit = unit, fmt = *) - end subroutine read_state_unit - subroutine write_raw_state_unit (s, unit) - type(tao_random_raw_state), intent(in) :: s - integer, intent(in) :: unit - write (unit = unit, fmt = *) "BEGIN TAO_RANDOM_RAW_STATE" - call write_state_array (s%x, unit) - write (unit = unit, fmt = *) "END TAO_RANDOM_RAW_STATE" - end subroutine write_raw_state_unit - subroutine read_raw_state_unit (s, unit) - type(tao_random_raw_state), intent(inout) :: s - integer, intent(in) :: unit - read (unit = unit, fmt = *) - call read_state_array (s%x, unit) - read (unit = unit, fmt = *) - end subroutine read_raw_state_unit - subroutine find_free_unit (u, iostat) - integer, intent(out) :: u - integer, intent(out), optional :: iostat - logical :: exists, is_open - integer :: i, status - do i = MIN_UNIT, MAX_UNIT - inquire (unit = i, exist = exists, opened = is_open, & - iostat = status) - if (status == 0) then - if (exists .and. .not. is_open) then - u = i - if (present (iostat)) then - iostat = 0 - end if - return - end if - end if - end do - if (present (iostat)) then - iostat = -1 - end if - u = -1 - end subroutine find_free_unit - subroutine write_state_name (s, name) - type(tao_random_state), intent(in) :: s - character(len=*), intent(in) :: name - integer :: unit - call find_free_unit (unit) - open (unit = unit, action = "write", status = "replace", file = name) - call write_state_unit (s, unit) - close (unit = unit) - end subroutine write_state_name - subroutine write_raw_state_name (s, name) - type(tao_random_raw_state), intent(in) :: s - character(len=*), intent(in) :: name - integer :: unit - call find_free_unit (unit) - open (unit = unit, action = "write", status = "replace", file = name) - call write_raw_state_unit (s, unit) - close (unit = unit) - end subroutine write_raw_state_name - subroutine read_state_name (s, name) - type(tao_random_state), intent(inout) :: s - character(len=*), intent(in) :: name - integer :: unit - call find_free_unit (unit) - open (unit = unit, action = "read", status = "old", file = name) - call read_state_unit (s, unit) - close (unit = unit) - end subroutine read_state_name - subroutine read_raw_state_name (s, name) - type(tao_random_raw_state), intent(inout) :: s - character(len=*), intent(in) :: name - integer :: unit - call find_free_unit (unit) - open (unit = unit, action = "read", status = "old", file = name) - call read_raw_state_unit (s, unit) - close (unit = unit) - end subroutine read_raw_state_name - elemental subroutine double_state (s, r) - type(tao_random_state), intent(inout) :: s - real(kind=double), intent(out) :: r - call double_stateless (s%state%x, s%buffer, s%buffer_end, s%last, r) - end subroutine double_state - pure subroutine double_array_state (s, v, num) - type(tao_random_state), intent(inout) :: s - real(kind=double), dimension(:), intent(out) :: v - integer, optional, intent(in) :: num - call double_array_stateless & - (s%state%x, s%buffer, s%buffer_end, s%last, v, num) - end subroutine double_array_state - subroutine double_static (r) - real(kind=double), intent(out) :: r - if (s_virginal) then - call tao_random_seed () - end if - call double_stateless (s_state, s_buffer, s_buffer_end, s_last, r) - end subroutine double_static - subroutine double_array_static (v, num) - real(kind=double), dimension(:), intent(out) :: v - integer, optional, intent(in) :: num - if (s_virginal) then - call tao_random_seed () - end if - call double_array_stateless & - (s_state, s_buffer, s_buffer_end, s_last, v, num) - end subroutine double_array_static - pure subroutine luxury_stateless & - (buffer_size, buffer_end, last, consumption) - integer, intent(in) :: buffer_size - integer, intent(inout) :: buffer_end - integer, intent(inout) :: last - integer, intent(in) :: consumption - if (consumption >= 1 .and. consumption <= buffer_size) then - buffer_end = consumption - last = min (last, buffer_end) - else -!!! print *, "tao_random_luxury: ", "invalid consumption ", & - !!! consumption, ", not in [ 1,", buffer_size, "]." - buffer_end = buffer_size - end if - end subroutine luxury_stateless - elemental subroutine luxury_state (s) - type(tao_random_state), intent(inout) :: s - call luxury_state_integer (s, size (s%buffer)) - end subroutine luxury_state - elemental subroutine luxury_state_integer (s, consumption) - type(tao_random_state), intent(inout) :: s - integer, intent(in) :: consumption - call luxury_stateless (size (s%buffer), s%buffer_end, s%last, consumption) - end subroutine luxury_state_integer - elemental subroutine luxury_state_real (s, consumption) - type(tao_random_state), intent(inout) :: s - real, intent(in) :: consumption - call luxury_state_integer (s, int (consumption * size (s%buffer))) - end subroutine luxury_state_real - elemental subroutine luxury_state_double (s, consumption) - type(tao_random_state), intent(inout) :: s - real(kind=double), intent(in) :: consumption - call luxury_state_integer (s, int (consumption * size (s%buffer))) - end subroutine luxury_state_double - subroutine luxury_static () - if (s_virginal) then - call tao_random_seed () - end if - call luxury_static_integer (size (s_buffer)) - end subroutine luxury_static - subroutine luxury_static_integer (consumption) - integer, intent(in) :: consumption - if (s_virginal) then - call tao_random_seed () - end if - call luxury_stateless (size (s_buffer), s_buffer_end, s_last, consumption) - end subroutine luxury_static_integer - subroutine luxury_static_real (consumption) - real, intent(in) :: consumption - if (s_virginal) then - call tao_random_seed () - end if - call luxury_static_integer (int (consumption * size (s_buffer))) - end subroutine luxury_static_real - subroutine luxury_static_double (consumption) - real(kind=double), intent(in) :: consumption - if (s_virginal) then - call tao_random_seed () - end if - call luxury_static_integer (int (consumption * size (s_buffer))) - end subroutine luxury_static_double - pure subroutine generate (a, state) - integer(kind=int32), dimension(:), intent(inout) :: a, state - integer :: j, n - n = size (a) - a(1:K) = state(1:K) - do j = K+1, n - a(j) = modulo (a(j-K) - a(j-L), M) - end do - state(1:L) = modulo (a(n+1-K:n+L-K) - a(n+1-L:n), M) - do j = L+1, K - state(j) = modulo (a(n+j-K) - state(j-L), M) - end do - end subroutine generate - pure subroutine seed_stateless (state, seed) - integer(kind=int32), dimension(:), intent(out) :: state - integer, optional, intent(in) :: seed - integer, parameter :: DEFAULT_SEED = 0 - integer, parameter :: MAX_SEED = 2**30 - 3 - integer, parameter :: TT = 70 - integer :: seed_value, j, s, t - integer(kind=int32), dimension(2*K-1) :: x - if (present (seed)) then - seed_value = seed - else - seed_value = DEFAULT_SEED - end if - if (seed_value < 0 .or. seed_value > MAX_SEED) then -!!! print *, "tao_random_seed: seed (", seed_value, & - !!! ") not in [ 0,", MAX_SEED, "]!" - seed_value = modulo (abs (seed_value), MAX_SEED + 1) -!!! print *, "tao_random_seed: seed set to ", seed_value, "!" - end if - s = seed_value - modulo (seed_value, 2) + 2 - do j = 1, K - x(j) = s - s = 2*s - if (s >= M) then - s = s - M + 2 - end if - end do - x(K+1:2*K-1) = 0 - x(2) = x(2) + 1 - s = seed_value - t = TT - 1 - do - x(3:2*K-1:2) = x(2:K) - x(2:K+L-1:2) = x(2*K-1:K-L+2:-2) - modulo (x(2*K-1:K-L+2:-2), 2) - do j= 2*K-1, K+1, -1 - if (modulo (x(j), 2) == 1) then - x(j-(K-L)) = modulo (x(j-(K-L)) - x(j), M) - x(j-K) = modulo (x(j-K) - x(j), M) - end if - end do - if (modulo (s, 2) == 1) then - x(2:K+1) = x(1:K) - x(1) = x(K+1) - if (modulo (x(K+1), 2) == 1) then - x(L+1) = modulo (x(L+1) - x(K+1), M) - end if - end if - if (s /= 0) then - s = s / 2 - else - t = t - 1 - end if - if (t <= 0) then - exit - end if - end do - state(K-L+1:K) = x(1:L) - state(1:K-L) = x(L+1:K) - end subroutine seed_stateless - subroutine write_state_array (a, unit) - integer(kind=int32), dimension(:), intent(in) :: a - integer, intent(in) :: unit - integer :: i - do i = 1, size (a) - write (unit = unit, fmt = "(1x,i10,1x,i10)") i, a(i) - end do - end subroutine write_state_array - subroutine read_state_array (a, unit) - integer(kind=int32), dimension(:), intent(inout) :: a - integer, intent(in) :: unit - integer :: i, idum - do i = 1, size (a) - read (unit = unit, fmt = *) idum, a(i) - end do - end subroutine read_state_array - pure subroutine marshal_state (s, ibuf, dbuf) - type(tao_random_state), intent(in) :: s - integer, dimension(:), intent(inout) :: ibuf - real(kind=double), dimension(:), intent(inout) :: dbuf - integer :: buf_size - buf_size = size (s%buffer) - ibuf(1) = s%buffer_end - ibuf(2) = s%last - ibuf(3) = buf_size - ibuf(4:3+buf_size) = s%buffer - call marshal_raw_state (s%state, ibuf(4+buf_size:), dbuf) - end subroutine marshal_state - pure subroutine marshal_state_size (s, iwords, dwords) - type(tao_random_state), intent(in) :: s - integer, intent(out) :: iwords, dwords - call marshal_raw_state_size (s%state, iwords, dwords) - iwords = iwords + 3 + size (s%buffer) - end subroutine marshal_state_size - pure subroutine unmarshal_state (s, ibuf, dbuf) - type(tao_random_state), intent(inout) :: s - integer, dimension(:), intent(in) :: ibuf - real(kind=double), dimension(:), intent(in) :: dbuf - integer :: buf_size - s%buffer_end = ibuf(1) - s%last = ibuf(2) - buf_size = ibuf(3) - s%buffer = ibuf(4:3+buf_size) - call unmarshal_raw_state (s%state, ibuf(4+buf_size:), dbuf) - end subroutine unmarshal_state - pure subroutine marshal_raw_state (s, ibuf, dbuf) - type(tao_random_raw_state), intent(in) :: s - integer, dimension(:), intent(inout) :: ibuf - real(kind=double), dimension(:), intent(inout) :: dbuf - ibuf(1) = size (s%x) - ibuf(2:1+size(s%x)) = s%x - end subroutine marshal_raw_state - pure subroutine marshal_raw_state_size (s, iwords, dwords) - type(tao_random_raw_state), intent(in) :: s - integer, intent(out) :: iwords, dwords - iwords = 1 + size (s%x) - dwords = 0 - end subroutine marshal_raw_state_size - pure subroutine unmarshal_raw_state (s, ibuf, dbuf) - type(tao_random_raw_state), intent(inout) :: s - integer, dimension(:), intent(in) :: ibuf - real(kind=double), dimension(:), intent(in) :: dbuf - integer :: buf_size - buf_size = ibuf(1) - s%x = ibuf(2:1+buf_size) - end subroutine unmarshal_raw_state - pure subroutine integer_stateless & - (state, buffer, buffer_end, last, r) - integer(kind=int32), dimension(:), intent(inout) :: state, buffer - integer, intent(in) :: buffer_end - integer, intent(inout) :: last - integer, intent(out) :: r - integer, parameter :: NORM = 1 - last = last + 1 - if (last > buffer_end) then - call generate (buffer, state) - last = 1 - end if - r = NORM * buffer(last) - end subroutine integer_stateless - pure subroutine real_stateless (state, buffer, buffer_end, last, r) - integer(kind=int32), dimension(:), intent(inout) :: state, buffer - integer, intent(in) :: buffer_end - integer, intent(inout) :: last - real, intent(out) :: r - real, parameter :: NORM = 1.0 / M - last = last + 1 - if (last > buffer_end) then - call generate (buffer, state) - last = 1 - end if - r = NORM * buffer(last) - end subroutine real_stateless - pure subroutine double_stateless (state, buffer, buffer_end, last, r) - integer(kind=int32), dimension(:), intent(inout) :: state, buffer - integer, intent(in) :: buffer_end - integer, intent(inout) :: last - real(kind=double), intent(out) :: r - real(kind=double), parameter :: NORM = 1.0_double / M - last = last + 1 - if (last > buffer_end) then - call generate (buffer, state) - last = 1 - end if - r = NORM * buffer(last) - end subroutine double_stateless - pure subroutine integer_array_stateless & - (state, buffer, buffer_end, last, v, num) - integer(kind=int32), dimension(:), intent(inout) :: state, buffer - integer, intent(in) :: buffer_end - integer, intent(inout) :: last - integer, dimension(:), intent(out) :: v - integer, optional, intent(in) :: num - integer, parameter :: NORM = 1 - integer :: nu, done, todo, chunk - if (present (num)) then - nu = num - else - nu = size (v) - end if - if (last >= buffer_end) then - call generate (buffer, state) - last = 0 - end if - done = 0 - todo = nu - chunk = min (todo, buffer_end - last) - v(1:chunk) = NORM * buffer(last+1:last+chunk) - do - last = last + chunk - done = done + chunk - todo = todo - chunk - chunk = min (todo, buffer_end) - if (chunk <= 0) then - exit - end if - call generate (buffer, state) - last = 0 - v(done+1:done+chunk) = NORM * buffer(1:chunk) - end do - end subroutine integer_array_stateless - pure subroutine real_array_stateless & - (state, buffer, buffer_end, last, v, num) - integer(kind=int32), dimension(:), intent(inout) :: state, buffer - integer, intent(in) :: buffer_end - integer, intent(inout) :: last - real, dimension(:), intent(out) :: v - integer, optional, intent(in) :: num - real, parameter :: NORM = 1.0 / M - integer :: nu, done, todo, chunk - if (present (num)) then - nu = num - else - nu = size (v) - end if - if (last >= buffer_end) then - call generate (buffer, state) - last = 0 - end if - done = 0 - todo = nu - chunk = min (todo, buffer_end - last) - v(1:chunk) = NORM * buffer(last+1:last+chunk) - do - last = last + chunk - done = done + chunk - todo = todo - chunk - chunk = min (todo, buffer_end) - if (chunk <= 0) then - exit - end if - call generate (buffer, state) - last = 0 - v(done+1:done+chunk) = NORM * buffer(1:chunk) - end do - end subroutine real_array_stateless - pure subroutine double_array_stateless & - (state, buffer, buffer_end, last, v, num) - integer(kind=int32), dimension(:), intent(inout) :: state, buffer - integer, intent(in) :: buffer_end - integer, intent(inout) :: last - real(kind=double), dimension(:), intent(out) :: v - integer, optional, intent(in) :: num - real(kind=double), parameter :: NORM = 1.0_double / M - integer :: nu, done, todo, chunk - if (present (num)) then - nu = num - else - nu = size (v) - end if - if (last >= buffer_end) then - call generate (buffer, state) - last = 0 - end if - done = 0 - todo = nu - chunk = min (todo, buffer_end - last) - v(1:chunk) = NORM * buffer(last+1:last+chunk) - do - last = last + chunk - done = done + chunk - todo = todo - chunk - chunk = min (todo, buffer_end) - if (chunk <= 0) then - exit - end if - call generate (buffer, state) - last = 0 - v(done+1:done+chunk) = NORM * buffer(1:chunk) - end do - end subroutine double_array_stateless - elemental subroutine integer_state (s, r) - type(tao_random_state), intent(inout) :: s - integer, intent(out) :: r - call integer_stateless (s%state%x, s%buffer, s%buffer_end, s%last, r) - end subroutine integer_state - elemental subroutine real_state (s, r) - type(tao_random_state), intent(inout) :: s - real, intent(out) :: r - call real_stateless (s%state%x, s%buffer, s%buffer_end, s%last, r) - end subroutine real_state - pure subroutine integer_array_state (s, v, num) - type(tao_random_state), intent(inout) :: s - integer, dimension(:), intent(out) :: v - integer, optional, intent(in) :: num - call integer_array_stateless & - (s%state%x, s%buffer, s%buffer_end, s%last, v, num) - end subroutine integer_array_state - pure subroutine real_array_state (s, v, num) - type(tao_random_state), intent(inout) :: s - real, dimension(:), intent(out) :: v - integer, optional, intent(in) :: num - call real_array_stateless & - (s%state%x, s%buffer, s%buffer_end, s%last, v, num) - end subroutine real_array_state - subroutine integer_static (r) - integer, intent(out) :: r - if (s_virginal) then - call tao_random_seed () - end if - call integer_stateless (s_state, s_buffer, s_buffer_end, s_last, r) - end subroutine integer_static - subroutine real_static (r) - real, intent(out) :: r - if (s_virginal) then - call tao_random_seed () - end if - call real_stateless (s_state, s_buffer, s_buffer_end, s_last, r) - end subroutine real_static - subroutine integer_array_static (v, num) - integer, dimension(:), intent(out) :: v - integer, optional, intent(in) :: num - if (s_virginal) then - call tao_random_seed () - end if - call integer_array_stateless & - (s_state, s_buffer, s_buffer_end, s_last, v, num) - end subroutine integer_array_static - subroutine real_array_static (v, num) - real, dimension(:), intent(out) :: v - integer, optional, intent(in) :: num - if (s_virginal) then - call tao_random_seed () - end if - call real_array_stateless & - (s_state, s_buffer, s_buffer_end, s_last, v, num) - end subroutine real_array_static - subroutine tao_random_test (name) - character(len=*), optional, intent(in) :: name - character (len = *), parameter :: & - OK = "(1x,i10,' is ok.')", & - NOT_OK = "(1x,i10,' is not ok, (expected ',i10,')!')" - integer, parameter :: & - SEED = 310952, & - N = 2009, M = 1009, & - N_SHORT = 1984 - integer, parameter :: & - A_2027082 = 461390032 - integer, dimension(N) :: a - type(tao_random_state) :: s, t - integer, dimension(:), allocatable :: ibuf - real(kind=double), dimension(:), allocatable :: dbuf - integer :: i, ibuf_size, dbuf_size - print *, TAO_RANDOM_NUMBERS_RCS_ID - print *, "testing the 30-bit tao_random_numbers ..." - call tao_random_luxury () - call tao_random_seed (SEED) - do i = 1, N+1 - call tao_random_number (a, M) - end do - if (a(1) == A_2027082) then - print OK, a(1) - else - print NOT_OK, a(1), A_2027082 - end if - call tao_random_seed (SEED) - do i = 1, M+1 - call tao_random_number (a) - end do - if (a(1) == A_2027082) then - print OK, a(1) - else - print NOT_OK, a(1), A_2027082 - end if - print *, "testing the stateless stuff ..." - call tao_random_create (s, SEED) - do i = 1, N_SHORT - call tao_random_number (s, a, M) - end do - call tao_random_create (t, s) - do i = 1, N+1 - N_SHORT - call tao_random_number (s, a, M) - end do - if (a(1) == A_2027082) then - print OK, a(1) - else - print NOT_OK, a(1), A_2027082 - end if - do i = 1, N+1 - N_SHORT - call tao_random_number (t, a, M) - end do - if (a(1) == A_2027082) then - print OK, a(1) - else - print NOT_OK, a(1), A_2027082 - end if - if (present (name)) then - print *, "testing I/O ..." - call tao_random_seed (s, SEED) - do i = 1, N_SHORT - call tao_random_number (s, a, M) - end do - call tao_random_write (s, name) - do i = 1, N+1 - N_SHORT - call tao_random_number (s, a, M) - end do - if (a(1) == A_2027082) then - print OK, a(1) - else - print NOT_OK, a(1), A_2027082 - end if - call tao_random_read (s, name) - do i = 1, N+1 - N_SHORT - call tao_random_number (s, a, M) - end do - if (a(1) == A_2027082) then - print OK, a(1) - else - print NOT_OK, a(1), A_2027082 - end if - end if - print *, "testing marshaling/unmarshaling ..." - call tao_random_seed (s, SEED) - do i = 1, N_SHORT - call tao_random_number (s, a, M) - end do - call tao_random_marshal_size (s, ibuf_size, dbuf_size) - allocate (ibuf(ibuf_size), dbuf(dbuf_size)) - call tao_random_marshal (s, ibuf, dbuf) - do i = 1, N+1 - N_SHORT - call tao_random_number (s, a, M) - end do - if (a(1) == A_2027082) then - print OK, a(1) - else - print NOT_OK, a(1), A_2027082 - end if - call tao_random_unmarshal (s, ibuf, dbuf) - do i = 1, N+1 - N_SHORT - call tao_random_number (s, a, M) - end do - if (a(1) == A_2027082) then - print OK, a(1) - else - print NOT_OK, a(1), A_2027082 - end if - end subroutine tao_random_test -end module tao_random_numbers Index: branches/ohl/omega-development/completed/whizard2/tools/Makefile.in =================================================================== --- branches/ohl/omega-development/completed/whizard2/tools/Makefile.in (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/tools/Makefile.in (revision 8703) @@ -1,130 +0,0 @@ -# $Id$ -# -# Copyright (C) 1999-2009 by -# -# Wolfgang Kilian -# Thorsten Ohl -# Juergen Reuter -# -# WHIZARD is free software; you can redistribute it and/or modify it -# under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2, or (at your option) -# any later version. -# -# WHIZARD is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -# -######################################################################## - -prefix = @prefix@ -srcdir = @srcdir@ -top_srcdir = @top_srcdir@ - -### host = @host@ - -# Architecture dependent source and binary directories -builddir_bin = $(top_srcdir)/bin -builddir_lib = $(top_srcdir)/lib -builddir_src = $(top_srcdir)/src - -FC = @FC@ -FC_OPT = @FC_OPT@ -FC_PROF = @FC_PROF@ -FC_MDIR = @FC_MDIR@ -FC_MDIR_NOSPACE = @FC_MDIR_NOSPACE@ -FC_MAKE_MODULE_NAME = @FC_MAKE_MODULE_NAME@ -FCFLAGS = $(FC_OPT) -I$(builddir_lib) -FC_EXT = @FC_EXT@ -FC_PURE = @FC_PURE@ - -ifeq ($(FC_PURE), yes) -FC_FILTER = $(CPIF) -else -FC_FILTER = \ - sed -e '/^[ ]*elemental[ ]/s/elemental[ ]//' \ - -e '/^[ ]*pure[ ]/s/pure[ ]//' | $(CPIF) -endif - -# Don't delete: these are used by FC_MAKE_MODULE_NAME for -# some target systems! -FC_MODULE_EXT = @FC_MODULE_EXT@ -LOWERCASE = @LOWERCASE@ -UPPERCASE = @UPPERCASE@ - -RANLIB = @RANLIB@ -CPIF = @CPIF@ - -######################################################################## - -FCSRC = \ - tao_random_numbers.f95 kinematics.f95 rambo.f95 \ - testbed.f95 testbed_old.f95 - -FCOBJ = $(FCSRC:.f95=.o) -FCOBJP = $(FCSRC:.f95=_p.o) - -######################################################################## - -all: f95 - -f95: $(builddir_lib)/libomega95_tools.a - -ifneq ($(FC_PROF),) -f95: $(builddir_lib)/libomega95_tools_p.a -endif - -######################################################################## -# There are no Modula(n) sources here ... -%.o: %.mod -######################################################################## - -ifeq ($(FC_MDIR_NOSPACE),yes) - set_mdir=$(FC_MDIR)$(builddir_lib) -else - set_mdir=$(FC_MDIR) $(builddir_lib) -endif - -$(builddir_src)/%.$(FC_EXT): %.f95 - cat $< | $(FC_FILTER) $(builddir_src)/$*.$(FC_EXT) - -%.o: $(builddir_src)/%.$(FC_EXT) -ifneq ($(FC_MDIR),) - $(FC) $(FCFLAGS) $(set_mdir) -c -o $@ $< -else - $(FC) $(FCFLAGS) -c -o $@ $< - test -f $(FC_MAKE_MODULE_NAME) && mv $(FC_MAKE_MODULE_NAME) $(builddir_lib) || true -endif - -%_p.o: $(builddir_src)/%.$(FC_EXT) -ifneq ($(FC_MDIR),) - $(FC) $(FCFLAGS) $(FC_PROF) $(set_mdir) -c -o $@ $< -else - $(FC) $(FCFLAGS) $(FC_PROF) -c -o $@ $< - test -f $(FC_MAKE_MODULE_NAME) && mv $(FC_MAKE_MODULE_NAME) $(builddir_lib) || true -endif - -$(builddir_lib)/libomega95_tools.a: $(FCOBJ) - ar rc $@ $^ - $(RANLIB) $@ - -$(builddir_lib)/libomega95_tools_p.a: $(FC_OBJP) - ar rc $@ $^ - $(RANLIB) $@ - -$(FC_OBJ): $(builddir_lib)/libomega95.a -rambo.o: kinematics.o tao_random_numbers.o -testbed.o: rambo.o - -$(builddir_lib)/libomega95.a: - $(MAKE) -C $(builddir_src) libomega95.a - -clean: - rm -f *.o *~ - -######################################################################## Index: branches/ohl/omega-development/completed/whizard2/tools/rambo.f95 =================================================================== --- branches/ohl/omega-development/completed/whizard2/tools/rambo.f95 (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/tools/rambo.f95 (revision 8703) @@ -1,126 +0,0 @@ -module rambo - - use kinds - use kinematics - use tao_random_numbers - implicit none - !!! Should be there, bt chokes the Intel compiler - ! private - - public :: massless_isotropic_decay, massive_decay - real (kind = default), private, parameter :: & - PI = 3.1415926535897932384626433832795028841972 - -contains - - !!! The massless RAMBO algorithm - subroutine massless_isotropic_decay (roots, p) - real (kind = default), intent(in) :: roots - ! It's a bit stupid that F disallows an explicit `dimension(0:3,:)' here. - real (kind = default), dimension(0:,:), intent(out) :: p - real (kind = default), dimension(0:3,size(p,dim=2)) :: q - real (kind = default), dimension(0:3) :: qsum - real (kind = double), dimension(4) :: ran - real (kind = default) :: c, s, f, qabs, x, r, z - integer :: k - ! Generate isotropic null vectors - do k = 1, size (p, dim = 2) - call tao_random_number (ran) - ! generate a x*exp(-x) distribution for q(0,k) - q(0,k)= -log(ran(1)*ran(2)) - c = 2*ran(3)-1 - f = 2*PI*ran(4) - s = sqrt(1-c*c) - q(2,k) = q(0,k)*s*sin(f) - q(3,k) = q(0,k)*s*cos(f) - q(1,k) = q(0,k)*c - enddo - ! Boost and rescale the vectors - qsum = sum (q, dim = 2) - qabs = sqrt (dot (qsum, qsum)) - x = roots/qabs - do k = 1, size (p, dim = 2) - r = dot (q(0:,k), qsum) / qabs - z = (q(0,k)+r)/(qsum(0)+qabs) - p(1:3,k) = x*(q(1:3,k)-qsum(1:3)*z) - p(0,k) = x*r - enddo - end subroutine massless_isotropic_decay - - !!! The massive RAMBO algorithm (not reweighted, therefore not isotropic) - subroutine massive_decay (roots, m, p) - real (kind = default), intent(in) :: roots - real (kind = default), dimension(:), intent(in) :: m - real (kind = default), dimension(0:,:), intent(out) :: p - real (kind = default), dimension(0:3,size(p,dim=2)) :: q - real (kind = default), dimension(size(p,dim=2)) :: p2, m2, p0 - real (kind = default), dimension(0:3) :: qsum - real (kind = double), dimension(2) :: ran - real (kind = default) :: c, s, f, qq - real (kind = default) :: w, a, xu, u, umax, xv, v, vmax, x - real (kind = default) :: xi, delta - integer :: k, i - if (sum(m) > roots) then - print *, "no solution: sum(m) > roots" - p = 0 - return - end if - m2 = m*m - ! Generate isotropic massive vectors - w = 1 - do k = 1, size (p, dim = 2) - ! Kinderman/Monahan (a la Kleiss/Sterling) - a = 2 * m(k) / w - xu = 0.5 * (1 - a + sqrt (1 + a*a)) - xv = 0.5 * (3 - a + sqrt (9 + 4*a + a*a)) - umax = exp (-0.5*xu) * sqrt (sqrt (xu*xu + a*xu)) - vmax = xv * exp (-0.5*xv) * sqrt (sqrt (xv*xv + a*xv)) - rejection: do - call tao_random_number (ran) - u = ran(1) * umax - v = ran(2) * vmax - x = v / u - if (u*u < exp(-x) * sqrt (x*x + a*x)) then - qq = m(k) + w*x - exit rejection - end if - end do rejection - call tao_random_number (ran) - c = 2*ran(1) - 1 - !!! select case (k) - !!! case (1,3) - !!! c = 1 - 0.0000002*ran(1) - !!! case (2,4) - !!! c = 0.0000002*ran(1) - 1 - !!! end select - f = 2*PI*ran(2) - s = sqrt (1 - c*c) - q(0,k) = sqrt (qq*qq + m2(k)) - q(1,k) = qq * s * sin(f) - q(2,k) = qq * s * cos(f) - q(3,k) = qq * c - enddo - ! Boost the vectors to the common rest frame - qsum = sum (q, dim = 2) - call boost ((/ qsum(0), - qsum(1:3) /) / sqrt (mass2 (qsum)), q, p) - ! rescale momenta - do k = 1, size (p, dim = 2) - p2(k) = dot_product (p(1:3,k), p(1:3,k)) - end do - i = 1 - xi = 1 - find_xi: do - p0 = sqrt (xi*xi*p2 + m2) - delta = sum (p0) - roots - if ((i > 100) .or. (abs (delta) <= 10 * epsilon (roots))) then - exit find_xi - end if - ! Newton / Ralphson iteration - xi = xi - delta / (xi * sum (p2 / p0)) - i = i + 1 - end do find_xi - p(0,:) = p0 - p(1:3,:) = xi * p(1:3,:) - end subroutine massive_decay - -end module rambo Index: branches/ohl/omega-development/completed/whizard2/tools/kinematics.f95 =================================================================== --- branches/ohl/omega-development/completed/whizard2/tools/kinematics.f95 (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/tools/kinematics.f95 (revision 8703) @@ -1,93 +0,0 @@ -! $Id: kinematics.f95,v 1.1 2004/04/09 20:11:17 ohl Exp $ - -module kinematics - - use kinds - implicit none - - private - public :: dot, mass2 - public :: beams, decay2 - public :: boost, split_massive - - private :: boost_one, boost_many - interface boost - module procedure boost_one, boost_many - end interface - -contains - - pure function dot (p, q) result (pq) - real(kind = default), dimension(0:), intent(in) :: p, q - real(kind = default) :: pq - pq = p(0)*q(0) - dot_product (p(1:), q(1:)) - end function dot - - pure function mass2 (p) result (m2) - real (kind = default), dimension(0:), intent(in) :: p - real (kind = default) :: m2 - m2 = p(0)*p(0) - p(1)*p(1) - p(2)*p(2) - p(3)*p(3) - end function mass2 - - pure subroutine beams (roots, m1, m2, p1, p2) - real (kind = default), intent(in) :: roots, m1, m2 - real (kind = default), dimension(0:), intent(out) :: p1, p2 - real (kind = default) :: m12, m22 - m12 = m1**2 - m22 = m2**2 - p1(0) = (roots**2 + m12 - m22) / (2*roots) - p1(1:2) = 0 - p1(3) = sqrt (p1(0)**2 - m12) - p2(0) = roots - p1(0) - p2(1:3) = - p1(1:3) - end subroutine beams - - pure subroutine decay2 (mass, m1, m2, costh, phi, p1, p2) - real (kind = default), intent(in) :: mass, m1, m2, costh, phi - real (kind = default), dimension(0:), intent(out) :: p1, p2 - real (kind = default) :: m12, m22, pabs, sinth, sinphi, cosphi - m12 = m1**2 - m22 = m2**2 - p1(0) = (mass**2 + m12 - m22) / (2*mass) - pabs = sqrt (p1(0)**2 - m12) - cosphi = cos (phi) - sinphi = sqrt (1 - cosphi**2) - sinth = sqrt (1 - costh**2) - p1(1:3) = pabs * (/ sinth*cosphi, sinth*sinphi, costh /) - p2(0) = mass - p1(0) - p2(1:3) = - p1(1:3) - end subroutine decay2 - - pure subroutine boost_one (v, p, q) - real (kind = default), dimension(0:), intent(in) :: v, p - real (kind = default), dimension(0:), intent(out) :: q - q(0) = dot_product (p, v) - q(1:3) = p(1:3) & - + v(1:3) * (p(0) + dot_product (p(1:3), v(1:3)) / (1 + v(0))) - end subroutine boost_one - - pure subroutine boost_many (v, p, q) - real (kind = default), dimension(0:), intent(in) :: v - real (kind = default), dimension(0:,:), intent(in) :: p - real (kind = default), dimension(0:,:), intent(out) :: q - integer :: k - do k = 1, size (p, dim = 2) - call boost_one (v, p(:,k), q(:,k)) - enddo - end subroutine boost_many - - pure subroutine split_massive (p, p_plus, p_minus) - real (kind = default), dimension(0:), intent(in) :: p - real (kind = default), dimension(0:), intent(out) :: p_plus, p_minus - real (kind = default), dimension(3) :: q - real (kind = default), dimension(0:3) :: b - real (kind = default) :: m, E - m = sqrt (mass2 (p)) - E = 0.5 * m - q = 0.5 * m * p(1:3) / sqrt (dot_product (p(1:3), p(1:3))) - b = p / m - call boost (b, (/ E, + q /), p_plus) - call boost (b, (/ E, - q /), p_minus) - end subroutine split_massive - -end module kinematics Index: branches/ohl/omega-development/completed/whizard2/tests/MSSM/main4.f95 =================================================================== --- branches/ohl/omega-development/completed/whizard2/tests/MSSM/main4.f95 (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/tests/MSSM/main4.f95 (revision 8703) @@ -1,190 +0,0 @@ -! $Id: main4.f95,v 1.1.4.1 2005/11/07 01:50:16 ohl Exp $ - -program main4 - use kinds - use tao_random_numbers - use testbed_old - use rambo - use omega_amplitudes4 - use omega_parameters_mssm_4, only: & - setup_parameters_mssm => setup_parameters, & - gh1ww, gh2ww, & - g_yuk13_3, g_yuk14_3 !!, & - !!! sinckm12, sinckm13, sinckm23 - - ! use omega_helas_amplitudes - use madgraph4 - - real(kind=single) :: roots - integer :: n, tolerance - character (len=8) :: mode - - call setup_parameters_mssm () - call setup_parameters () - call read_parameters (roots, n, tolerance, mode) - ghww = 0 - ghbb = 0 - sinckm12 = 0 - sinckm13 = 0 - sinckm23 = 0 - call export_parameters_to_madgraph () - gh2ww = 0 - gh1ww = ghww - g_yuk13_3 = 0 - g_yuk14_3 = ghbb - - !!! This fails unless the interferences are switched off - !!! because the color factors are missing - ! call check4_madgraph ("u dbar -> u dbar", n, oudb_udb, sudb_udb, udb_udb, & - ! real (roots, kind=default), (/ mass(2), mass(1), mass(2), mass(1) /), & - ! tolerance = tolerance, mode = mode) - - !!! This fails becasue MADGRAPH is incomplete - ! call check4_madgraph ("Z Z -> H H", n, ozz_hh, szz_hh, zz_hh, & - ! real (roots, kind=default), (/ mass(23), mass(23), mass(25), mass(25) /), & - ! states = (/ 3, 3, 1, 1 /), tolerance = tolerance, mode = mode) - - call check4_madgraph ("d dbar -> W+ W-", n, odbd_wpwm, sdbd_wpwm, dbd_wpwm, & - real (roots, kind=default), (/ mass(1), mass(1), mass(24), mass(24) /), & - states = (/ 2, 2, 3, 3 /), tolerance = tolerance, mode = mode) - - call check4_madgraph ("dbar d -> W+ W-", n, odbd_wpwm, sdbd_wpwm, dbd_wpwm, & - real (roots, kind=default), (/ mass(1), mass(1), mass(24), mass(24) /), & - states = (/ 2, 2, 3, 3 /), tolerance = tolerance, mode = mode) - - call check4_madgraph ("b bbar -> W+ W-", n, obbb_wpwm, sbbb_wpwm, bbb_wpwm, & - real (roots, kind=default), (/ mass(5), mass(5), mass(24), mass(24) /), & - states = (/ 2, 2, 3, 3 /), tolerance = tolerance, mode = mode) - - ! call ward4 (n, obbb_wpwm, bbb_wpwm, real (roots, kind=default), & - ! (/ mass(5), mass(5), mass(24), mass(24) /), & - ! 3, states = (/ 2, 2, 3, 3 /), tolerance = tolerance, mode = mode) - ! - ! call ward4 (n, obbb_wpwm, bbb_wpwm, real (roots, kind=default), & - ! (/ mass(5), mass(5), mass(24), mass(24) /), & - ! 4, states = (/ 2, 2, 3, 3 /), tolerance = tolerance, mode = mode) - ! - ! call ward_omega (n, obbb_wpwm, real (roots, kind=default), & - ! (/ mass(5), mass(5), mass(24), mass(24) /), & - ! 3, states = (/ 2, 2, 3, 3 /), tolerance = tolerance, mode = mode) - ! - ! call ward_omega (n, obbb_wpwm, real (roots, kind=default), & - ! (/ mass(5), mass(5), mass(24), mass(24) /), & - ! 4, states = (/ 2, 2, 3, 3 /), tolerance = tolerance, mode = mode) - - call check4_madgraph ("W+ W- -> W+ W-", n, owpwm_wpwm, swpwm_wpwm, wpwm_wpwm, & - real (roots, kind=default), (/ mass(24), mass(24), mass(24), mass(24) /), & - states = (/ 3, 3, 3, 3 /), tolerance = tolerance, mode = mode) - - call check4_madgraph ("W+ W- -> Z Z", n, owpwm_zz, swpwm_zz, wpwm_zz, & - real (roots, kind=default), (/ mass(24), mass(24), mass(23), mass(23) /), & - states = (/ 3, 3, 3, 3 /), tolerance = tolerance, mode = mode) - - call check4_madgraph ("W+ W- -> Z A", n, owpwm_za, swpwm_za, wpwm_za, & - real (roots, kind=default), (/ mass(24), mass(24), mass(23), 0.0_default /), & - states = (/ 3, 3, 3, 2 /), tolerance = tolerance, mode = mode) - - call check4_madgraph ("W+ W- -> A A", n, owpwm_aa, swpwm_aa, wpwm_aa, & - real (roots, kind=default), (/ mass(24), mass(24), 0.0_default, 0.0_default /), & - states = (/ 3, 3, 2, 2 /), tolerance = tolerance, mode = mode) - - call check4_madgraph ("e+ e- -> W+ W-", n, oepem_wpwm, sepem_wpwm, epem_wpwm, & - real (roots, kind=default), (/ mass(11), mass(11), mass(24), mass(24) /), & - states = (/ 2, 2, 3, 3 /), tolerance = tolerance, mode = mode) - - call check4_madgraph ("e+ e- -> e+ e-", n, oepem_epem, sepem_epem, epem_epem, & - real (roots, kind=default), & - (/ mass(11), mass(11), mass(11), mass(11) /), & - tolerance = tolerance, mode = mode) - - call check4_madgraph ("e+ e- -> nue nuebar", n, oepem_veve, sepem_veve, epem_veve, & - real (roots, kind=default), & - (/ mass(11), mass(11), 0.0_default, 0.0_default /), & - tolerance = tolerance, mode = mode) - - call check4_madgraph ("e+ e- -> mu+ mu-", n, oepem_mumu, sepem_mumu, epem_mumu, & - real (roots, kind=default), & - (/ mass(11), mass(11), mass(13), mass(13) /), & - tolerance = tolerance, mode = mode) - - call check4_madgraph ("e- e- -> e- e-", n, oemem_emem, semem_emem, emem_emem, & - real (roots, kind=default), (/ mass(11), mass(11), mass(11), mass(11) /), & - symmetry = reshape ((/ -1, 1, 2, -1, 3, 4 /), (/ 3, 2/)), & - tolerance = tolerance, mode = mode) - - call check4_madgraph ("e- A -> e- A", n, oema_ema, sema_ema, ema_ema, & - real (roots, kind=default), & - (/ mass(11), 0.0_default, mass(11), 0.0_default /), & - tolerance = tolerance, mode = mode) - - ! call ward_omega (n, oema_ema, real (roots, kind=default), & - ! (/ mass(11), 0.0_default, mass(11), 0.0_default /), & - ! 4, tolerance = tolerance, mode = mode) - - call check4_madgraph ("e+ e- -> A A", n, oepem_aa, sepem_aa, epem_aa, & - real (roots, kind=default), (/ mass(11), mass(11), 0.0_default, 0.0_default /), & - symmetry = reshape ((/ 1, 3, 4 /), (/ 3, 1/)), & - tolerance = tolerance, mode = mode) - - ! call ward4 (n, oepem_aa, epem_aa, real (roots, kind=default), & - ! (/ mass(11), mass(11), 0.0_default, 0.0_default /), & - ! 3, tolerance = tolerance, mode = mode) - ! - ! call ward4 (n, oepem_aa, epem_aa, real (roots, kind=default), & - ! (/ mass(11), mass(11), 0.0_default, 0.0_default /), & - ! 4, tolerance = tolerance, mode = mode) - ! - ! call ward_omega (n, oepem_aa, real (roots, kind=default), & - ! (/ mass(11), mass(11), 0.0_default, 0.0_default /), & - ! 3, tolerance = tolerance, mode = mode) - ! - ! call ward_omega (n, oepem_aa, real (roots, kind=default), & - ! (/ mass(11), mass(11), 0.0_default, 0.0_default /), & - ! 4, tolerance = tolerance, mode = mode) - - call check4_madgraph ("e+ e- -> Z A", n, oepem_za, sepem_za, epem_za, & - real (roots, kind=default), (/ mass(11), mass(11), mass(23), 0.0_default /), & - states = (/ 2, 2, 3, 2 /), & - tolerance = tolerance, mode = mode) - - call check4_madgraph ("e+ e- -> Z Z", n, oepem_zz, sepem_zz, epem_zz, & - real (roots, kind=default), & - (/ mass(11), mass(11), mass(23), mass(23) /), states = (/ 2, 2, 3, 3 /), & - symmetry = reshape ((/ 1, 3, 4 /), (/ 3, 1/)), & - tolerance = tolerance, mode = mode) - - call check4_madgraph ("A A -> e+ e-", n, oaa_epem, saa_epem, aa_epem, & - real (roots, kind=default), & - (/ 0.0_default, 0.0_default, mass(11), mass(11) /), & - symmetry = reshape ((/ 1, 1, 2 /), (/ 3, 1/)), & - tolerance = tolerance, mode = mode) - - call check4_madgraph ("Z A -> e+ e-", n, oza_epem, sza_epem, za_epem, & - real (roots, kind=default), & - (/ mass(23), 0.0_default, mass(11), mass(11) /), states = (/ 3, 2, 2, 2 /), & - tolerance = tolerance, mode = mode) - - call check4_madgraph ("Z Z -> e+ e-", n, ozz_epem, szz_epem, zz_epem, & - real (roots, kind=default), & - (/ mass(23), mass(23), mass(11), mass(11) /), states = (/ 3, 3, 2, 2 /), & - symmetry = reshape ((/ 1, 1, 2 /), (/ 3, 1/)), & - tolerance = tolerance, mode = mode) - - call check4_madgraph ("Z Z -> nue nuebar", n, ozz_veve, szz_veve, zz_veve, & - real (roots, kind=default), & - (/ mass(23), mass(23), 0.0_default, 0.0_default /), states = (/ 3, 3, 2, 2 /), & - symmetry = reshape ((/ 1, 1, 2 /), (/ 3, 1/)), & - tolerance = tolerance, mode = mode) - - call check4_madgraph ("Z A -> u ubar", n, oza_uub, sza_uub, za_uub, & - real (roots, kind=default), & - (/ mass(23), 0.0_default, mass(2), mass(2) /), states = (/ 3, 2, 2, 2 /), & - tolerance = tolerance, mode = mode) - - call check4_madgraph ("Z A -> d dbar", n, oza_ddb, sza_ddb, za_ddb, & - real (roots, kind=default), & - (/ mass(23), 0.0_default, mass(1), mass(1) /), states = (/ 3, 2, 2, 2 /), & - tolerance = tolerance, mode = mode) - -end program main4 - Index: branches/ohl/omega-development/completed/whizard2/tests/MSSM/dhelas95.f95 =================================================================== --- branches/ohl/omega-development/completed/whizard2/tests/MSSM/dhelas95.f95 (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/tests/MSSM/dhelas95.f95 (revision 8703) @@ -1,3552 +0,0 @@ - module dhelas95 - contains -c -c ====================================================================== -c - subroutine boostx(p,q , pboost) -c -c this subroutine performs the lorentz boost of a four-momentum. the -c momentum p is assumed to be given in the rest frame of q. pboost is -c the momentum p boosted to the frame in which q is given. q must be a -c timelike momentum. -c -c input: -c real p(0:3) : four-momentum p in the q rest frame -c real q(0:3) : four-momentum q in the boosted frame -c -c output: -c real pboost(0:3) : four-momentum p in the boosted frame -c - real*8 p(0:3),q(0:3),pboost(0:3),pq,qq,m,lf -c - real*8 r_zero - parameter( r_zero=0.0d0 ) -c - qq=q(1)**2+q(2)**2+q(3)**2 -c - if ( qq .ne. r_zero ) then - pq=p(1)*q(1)+p(2)*q(2)+p(3)*q(3) - m=sqrt(q(0)**2-qq) - lf=((q(0)-m)*pq/qq+p(0))/m - pboost(0) = (p(0)*q(0)+pq)/m - pboost(1) = p(1)+q(1)*lf - pboost(2) = p(2)+q(2)*lf - pboost(3) = p(3)+q(3)*lf - else - pboost(0)=p(0) - pboost(1)=p(1) - pboost(2)=p(2) - pboost(3)=p(3) - endif -c - return - end subroutine -c -c ********************************************************************** -c - subroutine coup1x(sw2 , gw,gwwa,gwwz) -c -c this subroutine sets up the coupling constants of the gauge bosons in -c the standard model. -c -c input: -c real sw2 : square of sine of the weak angle -c -c output: -c real gw : weak coupling constant -c real gwwa : dimensionless coupling of w-,w+,a -c real gwwz : dimensionless coupling of w-,w+,z -c - real*8 sw2,gw,gwwa,gwwz,alpha,fourpi,ee,sw,cw -c - real*8 r_one, r_four, r_ote, r_pi, r_ialph - parameter( r_one=1.0d0, r_four=4.0d0, r_ote=128.0d0 ) - parameter( r_pi=3.14159265358979323846d0, r_ialph=137.0359895d0 ) -c - alpha = r_one / r_ote -c alpha = r_one / r_ialph - fourpi = r_four * r_pi - ee=sqrt( alpha * fourpi ) - sw=sqrt( sw2 ) - cw=sqrt( r_one - sw2 ) -c - gw = ee/sw - gwwa = ee - gwwz = ee*cw/sw -c - return - end subroutine -c -c ---------------------------------------------------------------------- -c - subroutine coup2x(sw2 , gal,gau,gad,gwf,gzn,gzl,gzu,gzd,g1) -c -c this subroutine sets up the coupling constants for the fermion- -c fermion-vector vertices in the standard model. the array of the -c couplings specifies the chirality of the flowing-in fermion. g??(1) -c denotes a left-handed coupling, and g??(2) a right-handed coupling. -c -c input: -c real sw2 : square of sine of the weak angle -c -c output: -c real gal(2) : coupling with a of charged leptons -c real gau(2) : coupling with a of up-type quarks -c real gad(2) : coupling with a of down-type quarks -c real gwf(2) : coupling with w-,w+ of fermions -c real gzn(2) : coupling with z of neutrinos -c real gzl(2) : coupling with z of charged leptons -c real gzu(2) : coupling with z of up-type quarks -c real gzd(2) : coupling with z of down-type quarks -c real g1(2) : unit coupling of fermions -c - real*8 gal(2),gau(2),gad(2),gwf(2),gzn(2),gzl(2),gzu(2),gzd(2), - & g1(2),sw2,alpha,fourpi,ee,sw,cw,ez,ey -c - real*8 r_zero, r_half, r_one, r_two, r_three, r_four, r_ote - real*8 r_pi, r_ialph - parameter( r_zero=0.0d0, r_half=0.5d0, r_one=1.0d0, r_two=2.0d0, - $ r_three=3.0d0 ) - parameter( r_four=4.0d0, r_ote=128.0d0 ) - parameter( r_pi=3.14159265358979323846d0, r_ialph=137.0359895d0 ) -c - alpha = r_one / r_ote -c alpha = r_one / r_ialph - fourpi = r_four * r_pi - ee=sqrt( alpha * fourpi ) - sw=sqrt( sw2 ) - cw=sqrt( r_one - sw2 ) - ez=ee/(sw*cw) - ey=ee*(sw/cw) -c - gal(1) = ee - gal(2) = ee - gau(1) = -ee*r_two/r_three - gau(2) = -ee*r_two/r_three - gad(1) = ee /r_three - gad(2) = ee /r_three - gwf(1) = -ee/sqrt(r_two*sw2) - gwf(2) = r_zero - gzn(1) = -ez* r_half - gzn(2) = r_zero - gzl(1) = -ez*(-r_half+sw2) - gzl(2) = -ey - gzu(1) = -ez*( r_half-sw2*r_two/r_three) - gzu(2) = ey* r_two/r_three - gzd(1) = -ez*(-r_half+sw2 /r_three) - gzd(2) = -ey /r_three - g1(1) = r_one - g1(2) = r_one -c - return - end subroutine -c -c ---------------------------------------------------------------------- -c - subroutine coup3x(sw2,zmass,hmass , - & gwwh,gzzh,ghhh,gwwhh,gzzhh,ghhhh) -c -c this subroutine sets up the coupling constants of the gauge bosons and -c higgs boson in the standard model. -c -c input: -c real sw2 : square of sine of the weak angle -c real zmass : mass of z -c real hmass : mass of higgs -c -c output: -c real gwwh : dimensionful coupling of w-,w+,h -c real gzzh : dimensionful coupling of z, z, h -c real ghhh : dimensionful coupling of h, h, h -c real gwwhh : dimensionful coupling of w-,w+,h, h -c real gzzhh : dimensionful coupling of z, z, h, h -c real ghhhh : dimensionless coupling of h, h, h, h -c - real*8 sw2,zmass,hmass,gwwh,gzzh,ghhh,gwwhh,gzzhh,ghhhh, - & alpha,fourpi,ee2,sc2,v -c - real*8 r_half, r_one, r_two, r_three, r_four, r_ote - real*8 r_pi, r_ialph - parameter( r_half=0.5d0, r_one=1.0d0, r_two=2.0d0, r_three=3.0d0 ) - parameter( r_four=4.0d0, r_ote=128.0d0 ) - parameter( r_pi=3.14159265358979323846d0, r_ialph=137.0359895d0 ) -c - alpha = r_one / r_ote -c alpha = r_one / r_ialph - fourpi = r_four * r_pi - ee2=alpha*fourpi - sc2=sw2*( r_one - sw2 ) - v = r_two * zmass*sqrt(sc2)/sqrt(ee2) -c - gwwh = ee2/sw2*r_half*v - gzzh = ee2/sc2*r_half*v - ghhh = -hmass**2/v*r_three - gwwhh = ee2/sw2*r_half - gzzhh = ee2/sc2*r_half - ghhhh = -(hmass/v)**2*r_three -c - return - end subroutine -C -C ---------------------------------------------------------------------- -C - SUBROUTINE COUP4X(SW2,ZMASS,FMASS , GCHF) -C -C This subroutine sets up the coupling constant for the fermion-fermion- -C Higgs vertex in the STANDARD MODEL. The coupling is COMPLEX and the -C array of the coupling specifies the chirality of the flowing-IN -C fermion. GCHF(1) denotes a left-handed coupling, and GCHF(2) a right- -C handed coupling. -C -C INPUT: -C real SW2 : square of sine of the weak angle -C real ZMASS : Z mass -C real FMASS : fermion mass -C -C OUTPUT: -C complex GCHF(2) : coupling of fermion and Higgs -C - implicit none - COMPLEX*16 GCHF(2) - REAL*8 SW2,ZMASS,FMASS,ALPHA,FOURPI,EZ,G -C - ALPHA=1.d0/128.d0 -C ALPHA=1./REAL(137.0359895) - FOURPI=4.D0*3.14159265358979323846D0 - EZ=SQRT(ALPHA*FOURPI)/SQRT(SW2*(1.d0-SW2)) - G=EZ*FMASS*0.5d0/ZMASS -C - GCHF(1) = DCMPLX( -G ) - GCHF(2) = DCMPLX( -G ) -C - RETURN - end subroutine -C -C ====================================================================== -C - SUBROUTINE EAIXXX(EB,EA,SHLF,CHLF,PHI,NHE,NHA , EAI) -C -C This subroutine computes an off-shell electron wavefunction after -C emitting a photon from the electron beam, with a special care for the -C small angle region. The momenta are measured in the laboratory frame, -C where the e- beam is along the positive z axis. -C -C INPUT: -C real EB : energy (GeV) of beam e- -C real EA : energy (GeV) of final photon -C real SHLF : sin(theta/2) of final photon -C real CHLF : cos(theta/2) of final photon -C real PHI : azimuthal angle of final photon -C integer NHE = -1 or 1 : helicity of beam e- -C integer NHA = -1 or 1 : helicity of final photon -C -C OUTPUT: -C complex EAI(6) : off-shell electron |e',A,e> -C - implicit none - COMPLEX*16 EAI(6),PHS - REAL*8 EB,EA,SHLF,CHLF,PHI,ME,ALPHA,GAL,RNHE,X,C,S,D,COEFF, - & XNNP,XNNM,SNP,CSP - INTEGER NHE,NHA,NN -C - ME = 0.51099906D-3 - ALPHA=1./128. - GAL =SQRT(ALPHA*4.*3.14159265D0) -C - NN=NHA*NHE - RNHE=NHE - X=EA/EB - C=(CHLF+SHLF)*(CHLF-SHLF) - S=2.*CHLF*SHLF - D=-1./(EA*EB*(4.*SHLF**2+(ME/EB)**2*C)) - COEFF=-NN*GAL*SQRT(EB)*D - XNNP=X*(1+NN) - XNNM=X*(1-NN) - SNP=SIN(PHI) - CSP=COS(PHI) - PHS=dCMPLX( CSP , RNHE*SNP ) -C - EAI((5-3*NHE)/2) = -RNHE*COEFF*ME*S*(1.+XNNP*.5) - EAI((5-NHE)/2) = XNNP*COEFF*ME*CHLF**2*PHS - EAI((5+NHE)/2) = RNHE*COEFF*EB*S*(-2.+XNNM) - EAI((5+3*NHE)/2) = XNNM*COEFF*EB*SHLF**2*PHS*2. -C - EAI(5) = EB*dCMPLX( 1.-X , 1.-X*C ) - EAI(6) = -EB*X*S*dCMPLX( CSP , SNP ) -C - RETURN - end subroutine -C -C ---------------------------------------------------------------------- -C - SUBROUTINE EAOXXX(EB,EA,SHLF,CHLF,PHI,NHE,NHA , EAO) -C -C This subroutine computes an off-shell positron wavefunction after -C emitting a photon from the positron beam, with a special care for the -C small angle region. The momenta are measured in the laboratory frame, -C where the e+ beam is along the negative z axis. -C -C INPUT: -C real EB : energy (GeV) of beam e+ -C real EA : energy (GeV) of final photon -C real SHLF : sin(theta/2) of final photon -C real CHLF : cos(theta/2) of final photon -C real PHI : azimuthal angle of final photon -C integer NHE = -1 or 1 : helicity of beam e+ -C integer NHA = -1 or 1 : helicity of final photon -C -C OUTPUT: -C complex EAO(6) : off-shell positron -c complex*16 sc(3) : input scalar s -c complex*16 gc(2) : coupling constants gchf -c real*8 fmass : mass of output fermion f' -c real*8 fwidth : width of output fermion f' -c -c output: -c complex fsi(6) : off-shell fermion |f',s,fi> -c - complex*16 fi(6),sc(3),fsi(6),gc(2),sl1,sl2,sr1,sr2,ds - real*8 pf(0:3),fmass,fwidth,pf2,p0p3,p0m3 -c - fsi(5) = fi(5)-sc(2) - fsi(6) = fi(6)-sc(3) -c - pf(0)=dble( fsi(5)) - pf(1)=dble( fsi(6)) - pf(2)=dimag(fsi(6)) - pf(3)=dimag(fsi(5)) - pf2=pf(0)**2-(pf(1)**2+pf(2)**2+pf(3)**2) -c - ds=-sc(1)/dcmplx(pf2-fmass**2,max(dsign(fmass*fwidth ,pf2),0d0)) - p0p3=pf(0)+pf(3) - p0m3=pf(0)-pf(3) - sl1=gc(1)*(p0p3*fi(1)+dconjg(fsi(6))*fi(2)) - sl2=gc(1)*(p0m3*fi(2) +fsi(6) *fi(1)) - sr1=gc(2)*(p0m3*fi(3)-dconjg(fsi(6))*fi(4)) - sr2=gc(2)*(p0p3*fi(4) -fsi(6) *fi(3)) -c - fsi(1) = ( gc(1)*fmass*fi(1) + sr1 )*ds - fsi(2) = ( gc(1)*fmass*fi(2) + sr2 )*ds - fsi(3) = ( gc(2)*fmass*fi(3) + sl1 )*ds - fsi(4) = ( gc(2)*fmass*fi(4) + sl2 )*ds -c - return - end subroutine -c -c ---------------------------------------------------------------------- -c - subroutine fsoxxx(fo,sc,gc,fmass,fwidth , fso) -c -c this subroutine computes an off-shell fermion wavefunction from a -c flowing-out external fermion and a vector boson. -c -c input: -c complex*16 fo(6) : flow-out fermion -c complex vc(6) : input vector v -c real g(2) : coupling constants gvf -c real fmass : mass of output fermion f' -c real fwidth : width of output fermion f' -c -c output: -c complex fvi(6) : off-shell fermion |f',v,fi> -c - complex*16 fi(6),vc(6),fvi(6),sl1,sl2,sr1,sr2,d - real*8 g(2),pf(0:3),fmass,fwidth,pf2 -c - real*8 r_zero, r_one - parameter( r_zero=0.0d0, r_one=1.0d0 ) - complex*16 c_imag - c_imag=dcmplx( r_zero, r_one ) -c - fvi(5) = fi(5)-vc(5) - fvi(6) = fi(6)-vc(6) -c - pf(0)=dble( fvi(5)) - pf(1)=dble( fvi(6)) - pf(2)=dimag(fvi(6)) - pf(3)=dimag(fvi(5)) - pf2=pf(0)**2-(pf(1)**2+pf(2)**2+pf(3)**2) -c - d=-r_one/dcmplx( pf2-fmass**2,max(sign(fmass*fwidth,pf2),r_zero)) - sl1= (vc(1)+ vc(4))*fi(1) - & +(vc(2)-c_imag*vc(3))*fi(2) - sl2= (vc(2)+c_imag*vc(3))*fi(1) - & +(vc(1)- vc(4))*fi(2) -c - if ( g(2) .ne. r_zero ) then - sr1= (vc(1)- vc(4))*fi(3) - & -(vc(2)-c_imag*vc(3))*fi(4) - sr2=-(vc(2)+c_imag*vc(3))*fi(3) - & +(vc(1)+ vc(4))*fi(4) -c - fvi(1) = ( g(1)*((pf(0)-pf(3))*sl1 -dconjg(fvi(6))*sl2) - & +g(2)*fmass*sr1)*d - fvi(2) = ( g(1)*( -fvi(6)*sl1 +(pf(0)+pf(3))*sl2) - & +g(2)*fmass*sr2)*d - fvi(3) = ( g(2)*((pf(0)+pf(3))*sr1 +dconjg(fvi(6))*sr2) - & +g(1)*fmass*sl1)*d - fvi(4) = ( g(2)*( fvi(6)*sr1 +(pf(0)-pf(3))*sr2) - & +g(1)*fmass*sl2)*d -c - else - fvi(1) = g(1)*((pf(0)-pf(3))*sl1 -dconjg(fvi(6))*sl2)*d - fvi(2) = g(1)*( -fvi(6)*sl1 +(pf(0)+pf(3))*sl2)*d - fvi(3) = g(1)*fmass*sl1*d - fvi(4) = g(1)*fmass*sl2*d - end if -c - return - end subroutine -c -c ---------------------------------------------------------------------- -c - subroutine fvoxxx(fo,vc,g,fmass,fwidth , fvo) -c -c this subroutine computes an off-shell fermion wavefunction from a -c flowing-out external fermion and a vector boson. -c -c input: -c complex fo(6) : flow-out fermion -c complex fo(6) : flow-out fermion ) -c - complex*16 fi(6),fo(6),hio(3),gc(2),dn - real*8 q(0:3),smass,swidth,q2 -c - hio(2) = fo(5)-fi(5) - hio(3) = fo(6)-fi(6) -c - q(0)=dble( hio(2)) - q(1)=dble( hio(3)) - q(2)=dimag(hio(3)) - q(3)=dimag(hio(2)) - q2=q(0)**2-(q(1)**2+q(2)**2+q(3)**2) -c - dn=-dcmplx(q2-smass**2,dmax1(dsign(smass*swidth,q2),0.d0)) -c - hio(1) = ( gc(1)*(fo(1)*fi(1)+fo(2)*fi(2)) - & +gc(2)*(fo(3)*fi(3)+fo(4)*fi(4)) )/dn -c - return - end subroutine - -C ---------------------------------------------------------------------- -C - SUBROUTINE HSSSXX(S1,S2,S3,G,SMASS,SWIDTH , HSSS) -C -C This subroutine computes an off-shell scalar current from the four- -C scalar coupling. -C -C INPUT: -C complex S1(3) : first scalar S1 -C complex S2(3) : second scalar S2 -C complex S3(3) : third scalar S3 -C real G : coupling constant GHHHH -C real SMASS : mass of OUTPUT scalar S' -C real SWIDTH : width of OUTPUT scalar S' -C -C OUTPUT: -C complex HSSS(3) : scalar current J(S':S1,S2,S3) -C - implicit none - COMPLEX*16 S1(3),S2(3),S3(3),HSSS(3),DG - REAL*8 Q(0:3),G,SMASS,SWIDTH,Q2 -C - HSSS(2) = S1(2)+S2(2)+S3(2) - HSSS(3) = S1(3)+S2(3)+S3(3) -C - Q(0)=dble( HSSS(2)) - Q(1)=dble( HSSS(3)) - Q(2)=dIMAG(HSSS(3)) - Q(3)=dIMAG(HSSS(2)) - Q2=Q(0)**2-(Q(1)**2+Q(2)**2+Q(3)**2) -C - DG=-G/dCMPLX( Q2-SMASS**2,MAX(SIGN(SMASS*SWIDTH ,Q2),0.d0)) -C - HSSS(1) = DG * S1(1)*S2(1)*S3(1) -C - RETURN - end subroutine -C ---------------------------------------------------------------------- -C - SUBROUTINE HSSXXX(S1,S2,G,SMASS,SWIDTH , HSS) -C -C This subroutine computes an off-shell scalar current from the three- -C scalar coupling. -C -C INPUT: -C complex S1(3) : first scalar S1 -C complex S2(3) : second scalar S2 -C real G : coupling constant GHHH -C real SMASS : mass of OUTPUT scalar S' -C real SWIDTH : width of OUTPUT scalar S' -C -C OUTPUT: -C complex HSS(3) : scalar current J(S':S1,S2) -C - implicit none - COMPLEX*16 S1(3),S2(3),HSS(3),DG - REAL*8 Q(0:3),G,SMASS,SWIDTH,Q2 -C - HSS(2) = S1(2)+S2(2) - HSS(3) = S1(3)+S2(3) -C - Q(0)=dble( HSS(2)) - Q(1)=dble( HSS(3)) - Q(2)=dIMAG(HSS(3)) - Q(3)=dIMAG(HSS(2)) - Q2=Q(0)**2-(Q(1)**2+Q(2)**2+Q(3)**2) -C - DG=-G/dCMPLX( Q2-SMASS**2, MAX(SIGN(SMASS*SWIDTH ,Q2),0.d0)) -C - HSS(1) = DG*S1(1)*S2(1) -C - RETURN - end subroutine -C -C ====================================================================== -c ---------------------------------------------------------------------- -c - subroutine hvsxxx(vc,sc,g,smass,swidth , hvs) -c -c this subroutine computes an off-shell scalar current from the vector- -c scalar-scalar coupling. the coupling is absent in the minimal sm in -c unitary gauge. -c -c input: -c complex vc(6) : input vector v -c complex sc(3) : input scalar s -c complex g : coupling constant (s charge) -c real smass : mass of output scalar s' -c real swidth : width of output scalar s' -c -c examples of the coupling constant g for susy particles are as follows: -c ----------------------------------------------------------- -c | s1 | (q,i3) of s1 || v=a | v=z | v=w | -c ----------------------------------------------------------- -c | nu~_l | ( 0 , +1/2) || --- | gzn(1) | gwf(1) | -c | e~_l | ( -1 , -1/2) || gal(1) | gzl(1) | gwf(1) | -c | u~_l | (+2/3 , +1/2) || gau(1) | gzu(1) | gwf(1) | -c | d~_l | (-1/3 , -1/2) || gad(1) | gzd(1) | gwf(1) | -c ----------------------------------------------------------- -c | e~_r-bar | ( +1 , 0 ) || -gal(2) | -gzl(2) | -gwf(2) | -c | u~_r-bar | (-2/3 , 0 ) || -gau(2) | -gzu(2) | -gwf(2) | -c | d~_r-bar | (+1/3 , 0 ) || -gad(2) | -gzd(2) | -gwf(2) | -c ----------------------------------------------------------- -c where the sc charge is defined by the flowing-out quantum number. -c -c output: -c complex hvs(3) : scalar current j(s':v,s) -c - implicit none - complex*16 vc(6),sc(3),hvs(3),dg,qvv,qpv,g - real*8 qv(0:3),qp(0:3),qa(0:3),smass,swidth,q2 -c - hvs(2) = vc(5)+sc(2) - hvs(3) = vc(6)+sc(3) -c - qv(0)=dble( vc(5)) - qv(1)=dble( vc(6)) - qv(2)=dimag( vc(6)) - qv(3)=dimag( vc(5)) - qp(0)=dble( sc(2)) - qp(1)=dble( sc(3)) - qp(2)=dimag( sc(3)) - qp(3)=dimag( sc(2)) - qa(0)=dble( hvs(2)) - qa(1)=dble( hvs(3)) - qa(2)=dimag(hvs(3)) - qa(3)=dimag(hvs(2)) - q2=qa(0)**2-(qa(1)**2+qa(2)**2+qa(3)**2) -c - dg=-g/dcmplx( q2-smass**2 , max(dsign( smass*swidth ,q2),0d0) ) - qvv=qv(0)*vc(1)-qv(1)*vc(2)-qv(2)*vc(3)-qv(3)*vc(4) - qpv=qp(0)*vc(1)-qp(1)*vc(2)-qp(2)*vc(3)-qp(3)*vc(4) -c - hvs(1) = dg*(2d0*qpv+qvv)*sc(1) -c - return - end subroutine -c -c ---------------------------------------------------------------------- -c - subroutine hvvxxx(v1,v2,g,smass,swidth , hvv) -c -c this subroutine computes an off-shell scalar current from the vector- -c vector-scalar coupling. -c -c input: -c complex v1(6) : first vector v1 -c complex v2(6) : second vector v2 -c real g : coupling constant gvvh -c real smass : mass of output scalar s -c real swidth : width of output scalar s -c -c output: -c complex hvv(3) : off-shell scalar current j(s:v1,v2) -c - complex*16 v1(6),v2(6),hvv(3),dg - real*8 q(0:3),g,smass,swidth,q2 -c - real*8 r_zero - parameter( r_zero=0.0d0 ) -c - hvv(2) = v1(5)+v2(5) - hvv(3) = v1(6)+v2(6) -c - q(0)=dble( hvv(2)) - q(1)=dble( hvv(3)) - q(2)=dimag(hvv(3)) - q(3)=dimag(hvv(2)) - q2=q(0)**2-(q(1)**2+q(2)**2+q(3)**2) -c - dg=-g/dcmplx( q2-smass**2 , max(sign( smass*swidth ,q2),r_zero) ) -c - hvv(1) = dg*(v1(1)*v2(1)-v1(2)*v2(2)-v1(3)*v2(3)-v1(4)*v2(4)) -c - return - end subroutine -C -C ====================================================================== -C - SUBROUTINE IOSXXX(FI,FO,SC,GC , VERTEX) -C -C This subroutine computes an amplitude of the fermion-fermion-scalar -C coupling. -C -C INPUT: -C complex FI(6) : flow-in fermion |FI> -C complex FO(6) : flow-out fermion -C - COMPLEX*16 FI(6),FO(6),SC(3),GC(2),VERTEX -C - VERTEX = SC(1)*( GC(1)*(FI(1)*FO(1)+FI(2)*FO(2)) - & +GC(2)*(FI(3)*FO(3)+FI(4)*FO(4)) ) -C - RETURN - end subroutine -c -c ====================================================================== -c - subroutine iovxxx(fi,fo,vc,g , vertex) -c -c this subroutine computes an amplitude of the fermion-fermion-vector -c coupling. -c -c input: -c complex fi(6) : flow-in fermion |fi> -c complex fo(6) : flow-out fermion -c - complex*16 fi(6),fo(6),vc(6),vertex - real*8 g(2) -c - real*8 r_zero, r_one - parameter( r_zero=0.0d0, r_one=1.0d0 ) - complex*16 c_imag - c_imag=dcmplx( r_zero, r_one ) -c - - vertex = g(1)*( (fo(3)*fi(1)+fo(4)*fi(2))*vc(1) - & +(fo(3)*fi(2)+fo(4)*fi(1))*vc(2) - & -(fo(3)*fi(2)-fo(4)*fi(1))*vc(3)*c_imag - & +(fo(3)*fi(1)-fo(4)*fi(2))*vc(4) ) -c - if ( g(2) .ne. r_zero ) then - vertex = vertex - & + g(2)*( (fo(1)*fi(3)+fo(2)*fi(4))*vc(1) - & -(fo(1)*fi(4)+fo(2)*fi(3))*vc(2) - & +(fo(1)*fi(4)-fo(2)*fi(3))*vc(3)*c_imag - & -(fo(1)*fi(3)-fo(2)*fi(4))*vc(4) ) - end if -c - return - end subroutine -c -c Subroutine returns the desired fermion or -c anti-fermion spinor. ie., |f> -c A replacement for the HELAS routine IXXXXX -c -c Adam Duff, 1992 August 31 -c -c - subroutine ixxxxx( - & p, !in: four vector momentum - & fmass, !in: fermion mass - & nhel, !in: spinor helicity, -1 or 1 - & nsf, !in: -1=antifermion, 1=fermion - & fi !out: fermion wavefunction - & ) - implicit none -c -c declare input/output variables -c - complex*16 fi(6) - integer*4 nhel, nsf - real*8 p(0:3), fmass -c -c declare local variables -c - real*8 r_zero, r_one, r_two - parameter( r_zero=0.0d0, r_one=1.0d0, r_two=2.0d0 ) - complex*16 c_zero -c - real*8 plat, pabs, omegap, omegam, rs2pa, spaz - c_zero=dcmplx( r_zero, r_zero ) -c -c define kinematic parameters -c - fi(5) = dcmplx( p(0), p(3) ) * nsf - fi(6) = dcmplx( p(1), p(2) ) * nsf - plat = sqrt( p(1)**2 + p(2)**2 ) - pabs = sqrt( p(1)**2 + p(2)**2 + p(3)**2 ) - omegap = sqrt( p(0) + pabs ) -c -c do massive fermion case -c - if ( fmass .ne. r_zero ) then - omegam = fmass / omegap - if ( nsf .eq. 1 ) then - if ( nhel .eq. 1 ) then - if ( p(3) .ge. r_zero ) then - if ( plat .eq. r_zero ) then - fi(1) = dcmplx( omegam, r_zero ) - fi(2) = c_zero - fi(3) = dcmplx( omegap, r_zero ) - fi(4) = c_zero - else - rs2pa = r_one / sqrt( r_two * pabs ) - spaz = sqrt( pabs + p(3) ) - fi(1) = omegam * rs2pa - & * dcmplx( spaz, r_zero ) - fi(2) = omegam * rs2pa / spaz - & * dcmplx( p(1), p(2) ) - fi(3) = omegap * rs2pa - & * dcmplx( spaz, r_zero ) - fi(4) = omegap * rs2pa / spaz - & * dcmplx( p(1), p(2) ) - end if - else - if ( plat .eq. r_zero ) then - fi(1) = c_zero - fi(2) = dcmplx( omegam, r_zero ) - fi(3) = c_zero - fi(4) = dcmplx( omegap, r_zero ) - else - rs2pa = r_one / sqrt( r_two * pabs ) - spaz = sqrt( pabs - p(3) ) - fi(1) = omegam * rs2pa / spaz - & * dcmplx( plat, r_zero ) - fi(2) = omegam * rs2pa * spaz / plat - & * dcmplx( p(1), p(2) ) - fi(3) = omegap * rs2pa / spaz - & * dcmplx( plat, r_zero ) - fi(4) = omegap * rs2pa * spaz / plat - & * dcmplx( p(1), p(2) ) - end if - end if - else if ( nhel .eq. -1 ) then - if ( p(3) .ge. r_zero ) then - if ( plat .eq. r_zero ) then - fi(1) = c_zero - fi(2) = dcmplx( omegap, r_zero ) - fi(3) = c_zero - fi(4) = dcmplx( omegam, r_zero ) - else - rs2pa = r_one / sqrt( r_two * pabs ) - spaz = sqrt( pabs + p(3) ) - fi(1) = omegap * rs2pa / spaz - & * dcmplx( -p(1), p(2) ) - fi(2) = omegap * rs2pa - & * dcmplx( spaz, r_zero ) - fi(3) = omegam * rs2pa / spaz - & * dcmplx( -p(1), p(2) ) - fi(4) = omegam * rs2pa - & * dcmplx( spaz, r_zero ) - end if - else - if ( plat .eq. r_zero ) then - fi(1) = dcmplx( -omegap, r_zero ) - fi(2) = c_zero - fi(3) = dcmplx( -omegam, r_zero ) - fi(4) = c_zero - else - rs2pa = r_one / sqrt( r_two * pabs ) - spaz = sqrt( pabs - p(3) ) - fi(1) = omegap * rs2pa * spaz / plat - & * dcmplx( -p(1), p(2) ) - fi(2) = omegap * rs2pa / spaz - & * dcmplx( plat, r_zero ) - fi(3) = omegam * rs2pa * spaz / plat - & * dcmplx( -p(1), p(2) ) - fi(4) = omegam * rs2pa / spaz - & * dcmplx( plat, r_zero ) - end if - end if - else - stop 'ixxxxx: fermion helicity must be +1,-1' - end if - else if ( nsf .eq. -1 ) then - if ( nhel .eq. 1 ) then - if ( p(3) .ge. r_zero ) then - if ( plat .eq. r_zero ) then - fi(1) = c_zero - fi(2) = dcmplx( -omegap, r_zero ) - fi(3) = c_zero - fi(4) = dcmplx( omegam, r_zero ) - else - rs2pa = r_one / sqrt( r_two * pabs ) - spaz = sqrt( pabs + p(3) ) - fi(1) = -omegap * rs2pa / spaz - & * dcmplx( -p(1), p(2) ) - fi(2) = -omegap * rs2pa - & * dcmplx( spaz, r_zero ) - fi(3) = omegam * rs2pa / spaz - & * dcmplx( -p(1), p(2) ) - fi(4) = omegam * rs2pa - & * dcmplx( spaz, r_zero ) - end if - else - if ( plat .eq. r_zero ) then - fi(1) = dcmplx( omegap, r_zero ) - fi(2) = c_zero - fi(3) = dcmplx( -omegam, r_zero ) - fi(4) = c_zero - else - rs2pa = r_one / sqrt( r_two * pabs ) - spaz = sqrt( pabs - p(3) ) - fi(1) = -omegap * rs2pa * spaz / plat - & * dcmplx( -p(1), p(2) ) - fi(2) = -omegap * rs2pa / spaz - & * dcmplx( plat, r_zero ) - fi(3) = omegam * rs2pa * spaz / plat - & * dcmplx( -p(1), p(2) ) - fi(4) = omegam * rs2pa / spaz - & * dcmplx( plat, r_zero ) - end if - end if - else if ( nhel .eq. -1 ) then - if ( p(3) .ge. r_zero ) then - if ( plat .eq. r_zero ) then - fi(1) = dcmplx( omegam, r_zero ) - fi(2) = c_zero - fi(3) = dcmplx( -omegap, r_zero ) - fi(4) = c_zero - else - rs2pa = r_one / sqrt( r_two * pabs ) - spaz = sqrt( pabs + p(3) ) - fi(1) = omegam * rs2pa - & * dcmplx( spaz, r_zero ) - fi(2) = omegam * rs2pa / spaz - & * dcmplx( p(1), p(2) ) - fi(3) = -omegap * rs2pa - & * dcmplx( spaz, r_zero ) - fi(4) = -omegap * rs2pa / spaz - & * dcmplx( p(1), p(2) ) - end if - else - if ( plat .eq. r_zero ) then - fi(1) = c_zero - fi(2) = dcmplx( omegam, r_zero ) - fi(3) = c_zero - fi(4) = dcmplx( -omegap, r_zero ) - else - rs2pa = r_one / sqrt( r_two * pabs ) - spaz = sqrt( pabs - p(3) ) - fi(1) = omegam * rs2pa / spaz - & * dcmplx( plat, r_zero ) - fi(2) = omegam * rs2pa * spaz / plat - & * dcmplx( p(1), p(2) ) - fi(3) = -omegap * rs2pa / spaz - & * dcmplx( plat, r_zero ) - fi(4) = -omegap * rs2pa * spaz / plat - & * dcmplx( p(1), p(2) ) - end if - end if - else - stop 'ixxxxx: fermion helicity must be +1,-1' - end if - else - stop 'ixxxxx: fermion type must be +1,-1' - end if -c -c do massless fermion case -c - else - if ( nsf .eq. 1 ) then - if ( nhel .eq. 1 ) then - if ( p(3) .ge. r_zero ) then - if ( plat .eq. r_zero ) then - fi(1) = c_zero - fi(2) = c_zero - fi(3) = dcmplx( omegap, r_zero ) - fi(4) = c_zero - else - spaz = sqrt( pabs + p(3) ) - fi(1) = c_zero - fi(2) = c_zero - fi(3) = dcmplx( spaz, r_zero ) - fi(4) = r_one / spaz - & * dcmplx( p(1), p(2) ) - end if - else - if ( plat .eq. r_zero ) then - fi(1) = c_zero - fi(2) = c_zero - fi(3) = c_zero - fi(4) = dcmplx( omegap, r_zero ) - else - spaz = sqrt( pabs - p(3) ) - fi(1) = c_zero - fi(2) = c_zero - fi(3) = r_one / spaz - & * dcmplx( plat, r_zero ) - fi(4) = spaz / plat - & * dcmplx( p(1), p(2) ) - end if - end if - else if ( nhel .eq. -1 ) then - if ( p(3) .ge. r_zero ) then - if ( plat .eq. r_zero ) then - fi(1) = c_zero - fi(2) = dcmplx( omegap, r_zero ) - fi(3) = c_zero - fi(4) = c_zero - else - spaz = sqrt( pabs + p(3) ) - fi(1) = r_one / spaz - & * dcmplx( -p(1), p(2) ) - fi(2) = dcmplx( spaz, r_zero ) - fi(3) = c_zero - fi(4) = c_zero - end if - else - if ( plat .eq. r_zero ) then - fi(1) = dcmplx( -omegap, r_zero ) - fi(2) = c_zero - fi(3) = c_zero - fi(4) = c_zero - else - spaz = sqrt( pabs - p(3) ) - fi(1) = spaz / plat - & * dcmplx( -p(1), p(2) ) - fi(2) = r_one / spaz - & * dcmplx( plat, r_zero ) - fi(3) = c_zero - fi(4) = c_zero - end if - end if - else - stop 'ixxxxx: fermion helicity must be +1,-1' - end if - else if ( nsf .eq. -1 ) then - if ( nhel .eq. 1 ) then - if ( p(3) .ge. r_zero ) then - if ( plat .eq. r_zero ) then - fi(1) = c_zero - fi(2) = dcmplx( -omegap, r_zero ) - fi(3) = c_zero - fi(4) = c_zero - else - spaz = sqrt( pabs + p(3) ) - fi(1) = -r_one / spaz - & * dcmplx( -p(1), p(2) ) - fi(2) = dcmplx( -spaz, r_zero ) - fi(3) = c_zero - fi(4) = c_zero - end if - else - if ( plat .eq. r_zero ) then - fi(1) = dcmplx( omegap, r_zero ) - fi(2) = c_zero - fi(3) = c_zero - fi(4) = c_zero - else - spaz = sqrt( pabs - p(3) ) - fi(1) = -spaz / plat - & * dcmplx( -p(1), p(2) ) - fi(2) = -r_one / spaz - & * dcmplx( plat, r_zero ) - fi(3) = c_zero - fi(4) = c_zero - end if - end if - else if ( nhel .eq. -1 ) then - if ( p(3) .ge. r_zero ) then - if ( plat .eq. r_zero ) then - fi(1) = c_zero - fi(2) = c_zero - fi(3) = dcmplx( -omegap, r_zero ) - fi(4) = c_zero - else - spaz = sqrt( pabs + p(3) ) - fi(1) = c_zero - fi(2) = c_zero - fi(3) = dcmplx( -spaz, r_zero ) - fi(4) = -r_one / spaz - & * dcmplx( p(1), p(2) ) - end if - else - if ( plat .eq. r_zero ) then - fi(1) = c_zero - fi(2) = c_zero - fi(3) = c_zero - fi(4) = dcmplx( -omegap, r_zero ) - else - spaz = sqrt( pabs - p(3) ) - fi(1) = c_zero - fi(2) = c_zero - fi(3) = -r_one / spaz - & * dcmplx( plat, r_zero ) - fi(4) = -spaz / plat - & * dcmplx( p(1), p(2) ) - end if - end if - else - stop 'ixxxxx: fermion helicity must be +1,-1' - end if - else - stop 'ixxxxx: fermion type must be +1,-1' - end if - end if -c -c done -c - return - end subroutine -c -c ---------------------------------------------------------------------- -c - subroutine j3xxxx(fi,fo,gaf,gzf,zmass,zwidth , j3) -c -c this subroutine computes the sum of photon and z currents with the -c suitable weights ( j(w3) = cos(theta_w) j(z) + sin(theta_w) j(a) ). -c the output j3 is useful as an input of vvvxxx, jvvxxx or w3w3xx. -c the photon propagator is given in feynman gauge, and the z propagator -c is given in unitary gauge. -c -c input: -c complex fi(6) : flow-in fermion |fi> -c complex fo(6) : flow-out fermion ) -c - complex*16 fi(6),fo(6),j3(6), - & c0l,c1l,c2l,c3l,csl,c0r,c1r,c2r,c3r,csr,dz,ddif - real*8 gaf(2),gzf(2),q(0:3),zmass,zwidth,zm2,zmw,q2,da,ww, - & cw,sw,gn,gz3l,ga3l -c - real*8 r_zero, r_one - parameter( r_zero=0.0d0, r_one=1.0d0 ) - complex*16 c_imag - c_imag=dcmplx( r_zero, r_one ) -c - j3(5) = fo(5)-fi(5) - j3(6) = fo(6)-fi(6) -c - q(0)=-dble( j3(5)) - q(1)=-dble( j3(6)) - q(2)=-dimag(j3(6)) - q(3)=-dimag(j3(5)) - q2=q(0)**2-(q(1)**2+q(2)**2+q(3)**2) - zm2=zmass**2 - zmw=zmass*zwidth -c - da=r_one/q2 - ww=max(dsign( zmw ,q2),r_zero) - dz=r_one/dcmplx( q2-zm2 , ww ) - ddif=dcmplx( -zm2 , ww )*da*dz -c -c ddif is the difference : ddif=da-dz -c for the running width, use below instead of the above ww,dz and ddif. -c ww=max( zwidth*q2/zmass ,r_zero) -c dz=r_one/dcmplx( q2-zm2 , ww ) -c ddif=dcmplx( -zm2 , ww )*da*dz -c - cw=r_one/sqrt(r_one+(gzf(2)/gaf(2))**2) - sw=sqrt((r_one-cw)*(r_one+cw)) - gn=gaf(2)*sw - gz3l=gzf(1)*cw - ga3l=gaf(1)*sw - c0l= fo(3)*fi(1)+fo(4)*fi(2) - c0r= fo(1)*fi(3)+fo(2)*fi(4) - c1l=-(fo(3)*fi(2)+fo(4)*fi(1)) - c1r= fo(1)*fi(4)+fo(2)*fi(3) - c2l= (fo(3)*fi(2)-fo(4)*fi(1))*c_imag - c2r=(-fo(1)*fi(4)+fo(2)*fi(3))*c_imag - c3l= -fo(3)*fi(1)+fo(4)*fi(2) - c3r= fo(1)*fi(3)-fo(2)*fi(4) - csl=(q(0)*c0l-q(1)*c1l-q(2)*c2l-q(3)*c3l)/zm2 - csr=(q(0)*c0r-q(1)*c1r-q(2)*c2r-q(3)*c3r)/zm2 -c - j3(1) = gz3l*dz*(c0l-csl*q(0))+ga3l*c0l*da - & + gn*(c0r*ddif-csr*q(0)*dz) - j3(2) = gz3l*dz*(c1l-csl*q(1))+ga3l*c1l*da - & + gn*(c1r*ddif-csr*q(1)*dz) - j3(3) = gz3l*dz*(c2l-csl*q(2))+ga3l*c2l*da - & + gn*(c2r*ddif-csr*q(2)*dz) - j3(4) = gz3l*dz*(c3l-csl*q(3))+ga3l*c3l*da - & + gn*(c3r*ddif-csr*q(3)*dz) -c - return - end subroutine -C -C ---------------------------------------------------------------------- -C - SUBROUTINE JEEXXX(EB,EF,SHLF,CHLF,PHI,NHB,NHF,NSF , JEE) -C -C This subroutine computes an off-shell photon wavefunction emitted from -C the electron or positron beam, with a special care for the small angle -C region. The momenta are measured in the laboratory frame, where the -C e- (e+) beam is along the positive (negative) z axis. -C -C INPUT: -C real EB : energy (GeV) of beam e-/e+ -C real EF : energy (GeV) of final e-/e+ -C real SHLF : sin(theta/2) of final e-/e+ -C real CHLF : cos(theta/2) of final e-/e+ -C real PHI : azimuthal angle of final e-/e+ -C integer NHB = -1 or 1 : helicity of beam e-/e+ -C integer NHF = -1 or 1 : helicity of final e-/e+ -C integer NSF = -1 or 1 : +1 for electron, -1 for positron -C -C OUTPUT: -C complex JEE(6) : off-shell photon J^mu() -C - implicit none - COMPLEX*16 JEE(6),COEFF - REAL*8 CS(2),EB,EF,SHLF,CHLF,PHI,ME,ALPHA,GAL,HI,SF,SFH,X,ME2,Q2, - & RFP,RFM,SNP,CSP,RXC,C,S - INTEGER NHB,NHF,NSF -C - ME =0.51099906D-3 - ALPHA=1./128. - GAL =SQRT(ALPHA*4.*3.14159265D0) -C - HI =NHB - SF =NSF - SFH=NHB*NSF - CS((3+NSF)/2)=SHLF - CS((3-NSF)/2)=CHLF -C CS(1)=CHLF and CS(2)=SHLF for electron -C CS(1)=SHLF and CS(2)=CHLF for positron - X=EF/EB - ME2=ME**2 - Q2=-4.*CS(2)**2*(EF*EB-ME2) - & +SF*(1.-X)**2/X*(SHLF+CHLF)*(SHLF-CHLF)*ME2 - RFP=(1+NSF) - RFM=(1-NSF) - SNP=SIN(PHI) - CSP=COS(PHI) -C - IF (NHB.EQ.NHF) THEN - RXC=2.*X/(1.-X)*CS(1)**2 - COEFF= GAL*2.*EB*SQRT(X)*CS(2)/Q2 - & *(dCMPLX( RFP )-RFM*dCMPLX( CSP ,-SNP*HI ))*.5 - JEE(1) = dCMPLX( 0.d0 ) - JEE(2) = COEFF*dCMPLX( (1.+RXC)*CSP ,-SFH*SNP ) - JEE(3) = COEFF*dCMPLX( (1.+RXC)*SNP , SFH*CSP ) - JEE(4) = COEFF*(-SF*RXC/CS(1)*CS(2)) - ELSE - COEFF= GAL*ME/Q2/SQRT(X) - & *(dCMPLX( RFP )+RFM*dCMPLX( CSP , SNP*HI ))*.5*HI - JEE(1) = -COEFF*(1.+X)*CS(2)*dCMPLX( CSP , SFH*SNP ) - JEE(2) = COEFF*(1.-X)*CS(1) - JEE(3) = JEE(2)*dCMPLX( 0.d0 , SFH ) - JEE(4) = JEE(1)*SF*(1.-X)/(1.+X) - ENDIF -C - C=(CHLF+SHLF)*(CHLF-SHLF) - S=2.*CHLF*SHLF -C - JEE(5) = -EB*dCMPLX( 1.-X , SF-X*C ) - JEE(6) = EB*X*S*dCMPLX( CSP , SNP ) -C - RETURN - end subroutine -C -c -c ---------------------------------------------------------------------- -c - subroutine jgggxx(w1,w2,w3,g, jw3w) -c -c this subroutine computes an off-shell w+, w-, w3, z or photon current -c from the four-point gauge boson coupling, including the contributions -c of w exchange diagrams. the vector propagator is given in feynman -c gauge for a photon and in unitary gauge for w and z bosons. if one -c sets wmass=0.0, then the ggg-->g current is given (see sect 2.9.1 of -c the manual). -c -c input: -c complex w1(6) : first vector w1 -c complex w2(6) : second vector w2 -c complex w3(6) : third vector w3 -c real g : first coupling constant -c (see the table below) -c -c output: -c complex jw3w(6) : w current j^mu(w':w1,w2,w3) -c - implicit none - complex*16 w1(6),w2(6),w3(6),jw3w(6) - complex*16 dw1(0:3),dw2(0:3),dw3(0:3), - & jj(0:3),dv,w32,w13 - real*8 p1(0:3),p2(0:3),p3(0:3),q(0:3),g,dg2,q2 -c - real*8 r_zero - parameter( r_zero=0.0d0 ) -c - jw3w(5) = w1(5)+w2(5)+w3(5) - jw3w(6) = w1(6)+w2(6)+w3(6) -c - dw1(0)=dcmplx(w1(1)) - dw1(1)=dcmplx(w1(2)) - dw1(2)=dcmplx(w1(3)) - dw1(3)=dcmplx(w1(4)) - dw2(0)=dcmplx(w2(1)) - dw2(1)=dcmplx(w2(2)) - dw2(2)=dcmplx(w2(3)) - dw2(3)=dcmplx(w2(4)) - dw3(0)=dcmplx(w3(1)) - dw3(1)=dcmplx(w3(2)) - dw3(2)=dcmplx(w3(3)) - dw3(3)=dcmplx(w3(4)) - p1(0)=dble( w1(5)) - p1(1)=dble( w1(6)) - p1(2)=dble(dimag(w1(6))) - p1(3)=dble(dimag(w1(5))) - p2(0)=dble( w2(5)) - p2(1)=dble( w2(6)) - p2(2)=dble(dimag(w2(6))) - p2(3)=dble(dimag(w2(5))) - p3(0)=dble( w3(5)) - p3(1)=dble( w3(6)) - p3(2)=dble(dimag(w3(6))) - p3(3)=dble(dimag(w3(5))) - q(0)=-(p1(0)+p2(0)+p3(0)) - q(1)=-(p1(1)+p2(1)+p3(1)) - q(2)=-(p1(2)+p2(2)+p3(2)) - q(3)=-(p1(3)+p2(3)+p3(3)) - - q2 =q(0)**2 -(q(1)**2 +q(2)**2 +q(3)**2) - - dg2=dble(g)*dble(g) -c - dv = 1.0d0/dcmplx( q2 ) - -c for the running width, use below instead of the above dv. -c dv = 1.0d0/dcmplx( q2 -mv2 , dmax1(dwv*q2/dmv,0.d0) ) -c - w32=dw3(0)*dw2(0)-dw3(1)*dw2(1)-dw3(2)*dw2(2)-dw3(3)*dw2(3) -c -c - w13=dw1(0)*dw3(0)-dw1(1)*dw3(1)-dw1(2)*dw3(2)-dw1(3)*dw3(3) -c - jj(0)=dg2*( dw1(0)*w32 - dw2(0)*w13 ) - jj(1)=dg2*( dw1(1)*w32 - dw2(1)*w13 ) - jj(2)=dg2*( dw1(2)*w32 - dw2(2)*w13 ) - jj(3)=dg2*( dw1(3)*w32 - dw2(3)*w13 ) -c - jw3w(1) = dcmplx( jj(0)*dv ) - jw3w(2) = dcmplx( jj(1)*dv ) - jw3w(3) = dcmplx( jj(2)*dv ) - jw3w(4) = dcmplx( jj(3)*dv ) -c - return - end subroutine -c -c ---------------------------------------------------------------------- -c - subroutine jggxxx(v1,v2,g, jvv) -c -c this subroutine computes an off-shell vector current from the three- -c point gauge boson coupling. the vector propagator is given in feynman -c gauge for a massless vector and in unitary gauge for a massive vector. -c -c input: -c complex v1(6) : first vector v1 -c complex v2(6) : second vector v2 -c real g : coupling constant (see the table below) -c -c output: -c complex jvv(6) : vector current j^mu(v:v1,v2) -c - complex*16 v1(6),v2(6),jvv(6),j12(0:3), - & sv1,sv2,v12 - real*8 p1(0:3),p2(0:3),q(0:3),g,gs,s -c - real*8 r_zero - parameter( r_zero=0.0d0 ) -c - jvv(5) = v1(5)+v2(5) - jvv(6) = v1(6)+v2(6) -c - p1(0)=dble( v1(5)) - p1(1)=dble( v1(6)) - p1(2)=dimag(v1(6)) - p1(3)=dimag(v1(5)) - p2(0)=dble( v2(5)) - p2(1)=dble( v2(6)) - p2(2)=dimag(v2(6)) - p2(3)=dimag(v2(5)) - q(0)=-dble( jvv(5)) - q(1)=-dble( jvv(6)) - q(2)=-dimag(jvv(6)) - q(3)=-dimag(jvv(5)) - s=q(0)**2-(q(1)**2+q(2)**2+q(3)**2) -c - v12=v1(1)*v2(1)-v1(2)*v2(2)-v1(3)*v2(3)-v1(4)*v2(4) - sv1= (p2(0)-q(0))*v1(1) -(p2(1)-q(1))*v1(2) - & -(p2(2)-q(2))*v1(3) -(p2(3)-q(3))*v1(4) - sv2=-(p1(0)-q(0))*v2(1) +(p1(1)-q(1))*v2(2) - & +(p1(2)-q(2))*v2(3) +(p1(3)-q(3))*v2(4) - j12(0)=(p1(0)-p2(0))*v12 +sv1*v2(1) +sv2*v1(1) - j12(1)=(p1(1)-p2(1))*v12 +sv1*v2(2) +sv2*v1(2) - j12(2)=(p1(2)-p2(2))*v12 +sv1*v2(3) +sv2*v1(3) - j12(3)=(p1(3)-p2(3))*v12 +sv1*v2(4) +sv2*v1(4) -c - gs=-g/s -c - jvv(1) = gs*j12(0) - jvv(2) = gs*j12(1) - jvv(3) = gs*j12(2) - jvv(4) = gs*j12(3) -c - return - end subroutine -c -c ---------------------------------------------------------------------- -c - subroutine jioxxx(fi,fo,g,vmass,vwidth , jio) -c -c this subroutine computes an off-shell vector current from an external -c fermion pair. the vector boson propagator is given in feynman gauge -c for a massless vector and in unitary gauge for a massive vector. -c -c input: -c complex fi(6) : flow-in fermion |fi> -c complex fo(6) : flow-out fermion ) -c - complex*16 fi(6),fo(6),jio(6),c0,c1,c2,c3,cs,d - real*8 g(2),q(0:3),vmass,vwidth,q2,vm2,dd -c - real*8 r_zero, r_one - parameter( r_zero=0.0d0, r_one=1.0d0 ) - complex*16 c_imag - c_imag=dcmplx( r_zero, r_one ) -c - jio(5) = fo(5)-fi(5) - jio(6) = fo(6)-fi(6) -c - q(0)=dble( jio(5)) - q(1)=dble( jio(6)) - q(2)=dimag(jio(6)) - q(3)=dimag(jio(5)) - q2=q(0)**2-(q(1)**2+q(2)**2+q(3)**2) - vm2=vmass**2 -c - if (vmass.ne.r_zero) then -c - d=r_one/dcmplx( q2-vm2 , max(sign( vmass*vwidth ,q2),r_zero) ) -c for the running width, use below instead of the above d. -c d=r_one/dcmplx( q2-vm2 , max( vwidth*q2/vmass ,r_zero) ) -c - if (g(2).ne.r_zero) then -c - c0= g(1)*( fo(3)*fi(1)+fo(4)*fi(2)) - & +g(2)*( fo(1)*fi(3)+fo(2)*fi(4)) - c1= -g(1)*( fo(3)*fi(2)+fo(4)*fi(1)) - & +g(2)*( fo(1)*fi(4)+fo(2)*fi(3)) - c2=( g(1)*( fo(3)*fi(2)-fo(4)*fi(1)) - & +g(2)*(-fo(1)*fi(4)+fo(2)*fi(3)))*c_imag - c3= g(1)*(-fo(3)*fi(1)+fo(4)*fi(2)) - & +g(2)*( fo(1)*fi(3)-fo(2)*fi(4)) - else -c - d=d*g(1) - c0= fo(3)*fi(1)+fo(4)*fi(2) - c1= -fo(3)*fi(2)-fo(4)*fi(1) - c2=( fo(3)*fi(2)-fo(4)*fi(1))*c_imag - c3= -fo(3)*fi(1)+fo(4)*fi(2) - end if -c - cs=(q(0)*c0-q(1)*c1-q(2)*c2-q(3)*c3)/vm2 -c - jio(1) = (c0-cs*q(0))*d - jio(2) = (c1-cs*q(1))*d - jio(3) = (c2-cs*q(2))*d - jio(4) = (c3-cs*q(3))*d -c - else - dd=r_one/q2 -c - if (g(2).ne.r_zero) then - jio(1) = ( g(1)*( fo(3)*fi(1)+fo(4)*fi(2)) - & +g(2)*( fo(1)*fi(3)+fo(2)*fi(4)) )*dd - jio(2) = (-g(1)*( fo(3)*fi(2)+fo(4)*fi(1)) - & +g(2)*( fo(1)*fi(4)+fo(2)*fi(3)) )*dd - jio(3) = ( g(1)*( fo(3)*fi(2)-fo(4)*fi(1)) - & +g(2)*(-fo(1)*fi(4)+fo(2)*fi(3))) - $ *dcmplx(r_zero,dd) - jio(4) = ( g(1)*(-fo(3)*fi(1)+fo(4)*fi(2)) - & +g(2)*( fo(1)*fi(3)-fo(2)*fi(4)) )*dd -c - else - dd=dd*g(1) -c - jio(1) = ( fo(3)*fi(1)+fo(4)*fi(2))*dd - jio(2) = -( fo(3)*fi(2)+fo(4)*fi(1))*dd - jio(3) = ( fo(3)*fi(2)-fo(4)*fi(1))*dcmplx(r_zero,dd) - jio(4) = (-fo(3)*fi(1)+fo(4)*fi(2))*dd - end if - end if -c - return - end subroutine -C ---------------------------------------------------------------------- -C - SUBROUTINE JSSXXX(S1,S2,G,VMASS,VWIDTH , JSS) -C -C This subroutine computes an off-shell vector current from the vector- -C scalar-scalar coupling. The coupling is absent in the minimal SM in -C unitary gauge. The propagator is given in Feynman gauge for a -C massless vector and in unitary gauge for a massive vector. -C -C INPUT: -C complex S1(3) : first scalar S1 -C complex S2(3) : second scalar S2 -C real G : coupling constant (S1 charge) -C real VMASS : mass of OUTPUT vector V -C real VWIDTH : width of OUTPUT vector V -C -C Examples of the coupling constant G for SUSY particles are as follows: -C ----------------------------------------------------------- -C | S1 | (Q,I3) of S1 || V=A | V=Z | V=W | -C ----------------------------------------------------------- -C | nu~_L | ( 0 , +1/2) || --- | GZN(1) | GWF(1) | -C | e~_L | ( -1 , -1/2) || GAL(1) | GZL(1) | GWF(1) | -C | u~_L | (+2/3 , +1/2) || GAU(1) | GZU(1) | GWF(1) | -C | d~_L | (-1/3 , -1/2) || GAD(1) | GZD(1) | GWF(1) | -C ----------------------------------------------------------- -C | e~_R-bar | ( +1 , 0 ) || -GAL(2) | -GZL(2) | -GWF(2) | -C | u~_R-bar | (-2/3 , 0 ) || -GAU(2) | -GZU(2) | -GWF(2) | -C | d~_R-bar | (+1/3 , 0 ) || -GAD(2) | -GZD(2) | -GWF(2) | -C ----------------------------------------------------------- -C where the S1 charge is defined by the flowing-OUT quantum number. -C -C OUTPUT: -C complex JSS(6) : vector current J^mu(V:S1,S2) -C - implicit none - COMPLEX*16 S1(3),S2(3),JSS(6),DG,ADG - REAL*8 PP(0:3),PA(0:3),Q(0:3),G,VMASS,VWIDTH,Q2,VM2,MP2,MA2,M2D -C - JSS(5) = S1(2)+S2(2) - JSS(6) = S1(3)+S2(3) -C - Q(0)=dble( JSS(5)) - Q(1)=dble( JSS(6)) - Q(2)=dIMAG(JSS(6)) - Q(3)=dIMAG(JSS(5)) - Q2=Q(0)**2-(Q(1)**2+Q(2)**2+Q(3)**2) - VM2=VMASS**2 -C - IF (VMASS.EQ.0.) GOTO 10 -C - DG=G/dCMPLX( Q2-VM2, MAX(SIGN( VMASS*VWIDTH ,Q2),0.d0)) -C For the running width, use below instead of the above DG. -C DG=G/dCMPLX( Q2-VM2 , MAX( VWIDTH*Q2/VMASS ,0.) ) -C - ADG=DG*S1(1)*S2(1) -C - PP(0)=dble( S1(2)) - PP(1)=dble( S1(3)) - PP(2)=dIMAG(S1(3)) - PP(3)=dIMAG(S1(2)) - PA(0)=dble( S2(2)) - PA(1)=dble( S2(3)) - PA(2)=dIMAG(S2(3)) - PA(3)=dIMAG(S2(2)) - MP2=PP(0)**2-(PP(1)**2+PP(2)**2+PP(3)**2) - MA2=PA(0)**2-(PA(1)**2+PA(2)**2+PA(3)**2) - M2D=MP2-MA2 -C - JSS(1) = ADG*( (PP(0)-PA(0)) - Q(0)*M2D/VM2) - JSS(2) = ADG*( (PP(1)-PA(1)) - Q(1)*M2D/VM2) - JSS(3) = ADG*( (PP(2)-PA(2)) - Q(2)*M2D/VM2) - JSS(4) = ADG*( (PP(3)-PA(3)) - Q(3)*M2D/VM2) -C - RETURN -C - 10 ADG=G*S1(1)*S2(1)/Q2 -C - JSS(1) = ADG*dble( S1(2)-S2(2)) - JSS(2) = ADG*dble( S1(3)-S2(3)) - JSS(3) = ADG*dIMAG(S1(3)-S2(3)) - JSS(4) = ADG*dIMAG(S1(2)-S2(2)) -C - RETURN - end subroutine -C -c -c ---------------------------------------------------------------------- -c - subroutine jtioxx(fi,fo,g , jio) -c -c this subroutine computes an off-shell vector current from an external -c fermion pair. the vector boson propagator is not included in this -c routine. -c -c input: -c complex fi(6) : flow-in fermion |fi> -c complex fo(6) : flow-out fermion ) -c - complex*16 fi(6),fo(6),jio(6) - real*8 g(2) -c - real*8 r_zero, r_one - parameter( r_zero=0.0d0, r_one=1.0d0 ) - complex*16 c_imag - c_imag=dcmplx( r_zero, r_one ) -c - jio(5) = fo(5)-fi(5) - jio(6) = fo(6)-fi(6) -c - if ( g(2) .ne. r_zero ) then - jio(1) = ( g(1)*( fo(3)*fi(1)+fo(4)*fi(2)) - & +g(2)*( fo(1)*fi(3)+fo(2)*fi(4)) ) - jio(2) = (-g(1)*( fo(3)*fi(2)+fo(4)*fi(1)) - & +g(2)*( fo(1)*fi(4)+fo(2)*fi(3)) ) - jio(3) = ( g(1)*( fo(3)*fi(2)-fo(4)*fi(1)) - & +g(2)*(-fo(1)*fi(4)+fo(2)*fi(3)) )*c_imag - jio(4) = ( g(1)*(-fo(3)*fi(1)+fo(4)*fi(2)) - & +g(2)*( fo(1)*fi(3)-fo(2)*fi(4)) ) -c - else - jio(1) = ( fo(3)*fi(1)+fo(4)*fi(2))*g(1) - jio(2) = -( fo(3)*fi(2)+fo(4)*fi(1))*g(1) - jio(3) = ( fo(3)*fi(2)-fo(4)*fi(1))*dcmplx(r_zero,g(1)) - jio(4) = (-fo(3)*fi(1)+fo(4)*fi(2))*g(1) - end if -c - return - end subroutine -C ---------------------------------------------------------------------- -C - SUBROUTINE JVSSXX(VC,S1,S2,G,VMASS,VWIDTH , JVSS) -C -C This subroutine computes an off-shell vector current from the vector- -C vector-scalar-scalar coupling. The vector propagator is given in -C Feynman gauge for a massless vector and in unitary gauge for a massive -C vector. -C -C INPUT: -C complex VC(6) : input vector V -C complex S1(3) : first scalar S1 -C complex S2(3) : second scalar S2 -C real G : coupling constant GVVHH -C real VMASS : mass of OUTPUT vector V' -C real VWIDTH : width of OUTPUT vector V' -C -C OUTPUT: -C complex JVSS(6) : vector current J^mu(V':V,S1,S2) -C - implicit none - COMPLEX*16 VC(6),S1(3),S2(3),JVSS(6),DG - REAL*8 Q(0:3),G,VMASS,VWIDTH,Q2,VK,VM2 -C - JVSS(5) = VC(5)+S1(2)+S2(2) - JVSS(6) = VC(6)+S1(3)+S2(3) -C - Q(0)=dble( JVSS(5)) - Q(1)=dble( JVSS(6)) - Q(2)=dIMAG(JVSS(6)) - Q(3)=dIMAG(JVSS(5)) - Q2=Q(0)**2-(Q(1)**2+Q(2)**2+Q(3)**2) - VM2=VMASS**2 -C - IF (VMASS.EQ.0.) GOTO 10 -C - DG=G*S1(1)*S2(1)/dCMPLX( Q2-VM2,MAX(SIGN( VMASS*VWIDTH,Q2),0.d0)) -C For the running width, use below instead of the above DG. -C DG=G*S1(1)*S2(1)/CMPLX( Q2-VM2 , MAX( VWIDTH*Q2/VMASS ,0.)) -C - VK=(Q(0)*VC(1)-Q(1)*VC(2)-Q(2)*VC(3)-Q(3)*VC(4))/VM2 -C - JVSS(1) = DG*(VC(1)-VK*Q(0)) - JVSS(2) = DG*(VC(2)-VK*Q(1)) - JVSS(3) = DG*(VC(3)-VK*Q(2)) - JVSS(4) = DG*(VC(4)-VK*Q(3)) -C - RETURN -C - 10 DG= G*S1(1)*S2(1)/Q2 -C - JVSS(1) = DG*VC(1) - JVSS(2) = DG*VC(2) - JVSS(3) = DG*VC(3) - JVSS(4) = DG*VC(4) -C - RETURN - end subroutine -C -c -c ---------------------------------------------------------------------- -c - subroutine jvsxxx(vc,sc,g,vmass,vwidth , jvs) - implicit real*8(a-h,o-z) -c -c this subroutine computes an off-shell vector current from the vector- -c vector-scalar coupling. the vector propagator is given in feynman -c gauge for a massless vector and in unitary gauge for a massive vector. -c -c input: -c complex vc(6) : input vector v -c complex sc(3) : input scalar s -c real g : coupling constant gvvh -c real vmass : mass of output vector v' -c real vwidth : width of output vector v' -c -c output: -c complex jvs(6) : vector current j^mu(v':v,s) -c - complex*16 vc(6),sc(3),jvs(6),dg,vk - real*8 q(0:3),vmass,vwidth,q2,vm2,g -c - jvs(5) = vc(5)+sc(2) - jvs(6) = vc(6)+sc(3) -c - q(0)=dble( jvs(5)) - q(1)=dble( jvs(6)) - q(2)=dimag(jvs(6)) - q(3)=dimag(jvs(5)) - q2=q(0)**2-(q(1)**2+q(2)**2+q(3)**2) - vm2=vmass**2 -c - if (vmass.eq.0.) goto 10 -c - dg=g*sc(1)/dcmplx( q2-vm2 , max(dsign( vmass*vwidth ,q2),0.d0) ) -c for the running width, use below instead of the above dg. -c dg=g*sc(1)/dcmplx( q2-vm2 , max( vwidth*q2/vmass ,0.) ) -c - vk=(-q(0)*vc(1)+q(1)*vc(2)+q(2)*vc(3)+q(3)*vc(4))/vm2 -c - jvs(1) = dg*(q(0)*vk+vc(1)) - jvs(2) = dg*(q(1)*vk+vc(2)) - jvs(3) = dg*(q(2)*vk+vc(3)) - jvs(4) = dg*(q(3)*vk+vc(4)) -c - return -c - 10 dg=g*sc(1)/q2 -c - jvs(1) = dg*vc(1) - jvs(2) = dg*vc(2) - jvs(3) = dg*vc(3) - jvs(4) = dg*vc(4) -c - return - end subroutine - - -c -c ---------------------------------------------------------------------- -c - subroutine jvvxxx(v1,v2,g,vmass,vwidth , jvv) -c -c this subroutine computes an off-shell vector current from the three- -c point gauge boson coupling. the vector propagator is given in feynman -c gauge for a massless vector and in unitary gauge for a massive vector. -c -c input: -c complex v1(6) : first vector v1 -c complex v2(6) : second vector v2 -c real g : coupling constant (see the table below) -c real vmass : mass of output vector v -c real vwidth : width of output vector v -c -c the possible sets of the inputs are as follows: -c ------------------------------------------------------------------ -c | v1 | v2 | jvv | g | vmass | vwidth | -c ------------------------------------------------------------------ -c | w- | w+ | a/z | gwwa/gwwz | 0./zmass | 0./zwidth | -c | w3/a/z | w- | w+ | gw/gwwa/gwwz | wmass | wwidth | -c | w+ | w3/a/z | w- | gw/gwwa/gwwz | wmass | wwidth | -c ------------------------------------------------------------------ -c where all the bosons are defined by the flowing-out quantum number. -c -c output: -c complex jvv(6) : vector current j^mu(v:v1,v2) -c - complex*16 v1(6),v2(6),jvv(6),j12(0:3),js,dg, - & sv1,sv2,s11,s12,s21,s22,v12 - real*8 p1(0:3),p2(0:3),q(0:3),g,vmass,vwidth,gs,s,vm2,m1,m2 -c - real*8 r_zero - parameter( r_zero=0.0d0 ) -c - jvv(5) = v1(5)+v2(5) - jvv(6) = v1(6)+v2(6) -c - p1(0)=dble( v1(5)) - p1(1)=dble( v1(6)) - p1(2)=dimag(v1(6)) - p1(3)=dimag(v1(5)) - p2(0)=dble( v2(5)) - p2(1)=dble( v2(6)) - p2(2)=dimag(v2(6)) - p2(3)=dimag(v2(5)) - q(0)=-dble( jvv(5)) - q(1)=-dble( jvv(6)) - q(2)=-dimag(jvv(6)) - q(3)=-dimag(jvv(5)) - s=q(0)**2-(q(1)**2+q(2)**2+q(3)**2) -c - v12=v1(1)*v2(1)-v1(2)*v2(2)-v1(3)*v2(3)-v1(4)*v2(4) - sv1= (p2(0)-q(0))*v1(1) -(p2(1)-q(1))*v1(2) - & -(p2(2)-q(2))*v1(3) -(p2(3)-q(3))*v1(4) - sv2=-(p1(0)-q(0))*v2(1) +(p1(1)-q(1))*v2(2) - & +(p1(2)-q(2))*v2(3) +(p1(3)-q(3))*v2(4) - j12(0)=(p1(0)-p2(0))*v12 +sv1*v2(1) +sv2*v1(1) - j12(1)=(p1(1)-p2(1))*v12 +sv1*v2(2) +sv2*v1(2) - j12(2)=(p1(2)-p2(2))*v12 +sv1*v2(3) +sv2*v1(3) - j12(3)=(p1(3)-p2(3))*v12 +sv1*v2(4) +sv2*v1(4) -c - if ( vmass .ne. r_zero ) then - vm2=vmass**2 - m1=p1(0)**2-(p1(1)**2+p1(2)**2+p1(3)**2) - m2=p2(0)**2-(p2(1)**2+p2(2)**2+p2(3)**2) - s11=p1(0)*v1(1)-p1(1)*v1(2)-p1(2)*v1(3)-p1(3)*v1(4) - s12=p1(0)*v2(1)-p1(1)*v2(2)-p1(2)*v2(3)-p1(3)*v2(4) - s21=p2(0)*v1(1)-p2(1)*v1(2)-p2(2)*v1(3)-p2(3)*v1(4) - s22=p2(0)*v2(1)-p2(1)*v2(2)-p2(2)*v2(3)-p2(3)*v2(4) - js=(v12*(-m1+m2) +s11*s12 -s21*s22)/vm2 -c - dg=-g/dcmplx( s-vm2 , max(sign( vmass*vwidth ,s),r_zero) ) -c -c for the running width, use below instead of the above dg. -c dg=-g/dcmplx( s-vm2 , max( vwidth*s/vmass ,r_zero) ) -c - jvv(1) = dg*(j12(0)-q(0)*js) - jvv(2) = dg*(j12(1)-q(1)*js) - jvv(3) = dg*(j12(2)-q(2)*js) - jvv(4) = dg*(j12(3)-q(3)*js) -c - else - gs=-g/s -c - jvv(1) = gs*j12(0) - jvv(2) = gs*j12(1) - jvv(3) = gs*j12(2) - jvv(4) = gs*j12(3) - end if -c - return - end subroutine -c -c ---------------------------------------------------------------------- -c - subroutine jw3wxx(w1,w2,w3,g1,g2,wmass,wwidth,vmass,vwidth , jw3w) -c -c this subroutine computes an off-shell w+, w-, w3, z or photon current -c from the four-point gauge boson coupling, including the contributions -c of w exchange diagrams. the vector propagator is given in feynman -c gauge for a photon and in unitary gauge for w and z bosons. if one -c sets wmass=0.0, then the ggg-->g current is given (see sect 2.9.1 of -c the manual). -c -c input: -c complex w1(6) : first vector w1 -c complex w2(6) : second vector w2 -c complex w3(6) : third vector w3 -c real g1 : first coupling constant -c real g2 : second coupling constant -c (see the table below) -c real wmass : mass of internal w -c real wwidth : width of internal w -c real vmass : mass of output w' -c real vwidth : width of output w' -c -c the possible sets of the inputs are as follows: -c ------------------------------------------------------------------- -c | w1 | w2 | w3 | g1 | g2 |wmass|wwidth|vmass|vwidth || jw3w | -c ------------------------------------------------------------------- -c | w- | w3 | w+ | gw |gwwz|wmass|wwidth|zmass|zwidth || z | -c | w- | w3 | w+ | gw |gwwa|wmass|wwidth| 0. | 0. || a | -c | w- | z | w+ |gwwz|gwwz|wmass|wwidth|zmass|zwidth || z | -c | w- | z | w+ |gwwz|gwwa|wmass|wwidth| 0. | 0. || a | -c | w- | a | w+ |gwwa|gwwz|wmass|wwidth|zmass|zwidth || z | -c | w- | a | w+ |gwwa|gwwa|wmass|wwidth| 0. | 0. || a | -c ------------------------------------------------------------------- -c | w3 | w- | w3 | gw | gw |wmass|wwidth|wmass|wwidth || w+ | -c | w3 | w+ | w3 | gw | gw |wmass|wwidth|wmass|wwidth || w- | -c | w3 | w- | z | gw |gwwz|wmass|wwidth|wmass|wwidth || w+ | -c | w3 | w+ | z | gw |gwwz|wmass|wwidth|wmass|wwidth || w- | -c | w3 | w- | a | gw |gwwa|wmass|wwidth|wmass|wwidth || w+ | -c | w3 | w+ | a | gw |gwwa|wmass|wwidth|wmass|wwidth || w- | -c | z | w- | z |gwwz|gwwz|wmass|wwidth|wmass|wwidth || w+ | -c | z | w+ | z |gwwz|gwwz|wmass|wwidth|wmass|wwidth || w- | -c | z | w- | a |gwwz|gwwa|wmass|wwidth|wmass|wwidth || w+ | -c | z | w+ | a |gwwz|gwwa|wmass|wwidth|wmass|wwidth || w- | -c | a | w- | a |gwwa|gwwa|wmass|wwidth|wmass|wwidth || w+ | -c | a | w+ | a |gwwa|gwwa|wmass|wwidth|wmass|wwidth || w- | -c ------------------------------------------------------------------- -c where all the bosons are defined by the flowing-out quantum number. -c -c output: -c complex jw3w(6) : w current j^mu(w':w1,w2,w3) -c - complex*16 w1(6),w2(6),w3(6),jw3w(6) - complex*16 dw1(0:3),dw2(0:3),dw3(0:3), - & jj(0:3),j4(0:3), - & dv,w12,w32,w13, - & jq - real*8 g1,g2,wmass,wwidth,vmass,vwidth - real*8 p1(0:3),p2(0:3),p3(0:3),q(0:3), - & dg2,dmv,dwv,mv2,q2 -c - real*8 r_zero - parameter( r_zero=0.0d0 ) -c - jw3w(5) = w1(5)+w2(5)+w3(5) - jw3w(6) = w1(6)+w2(6)+w3(6) -c - dw1(0)=dcmplx(w1(1)) - dw1(1)=dcmplx(w1(2)) - dw1(2)=dcmplx(w1(3)) - dw1(3)=dcmplx(w1(4)) - dw2(0)=dcmplx(w2(1)) - dw2(1)=dcmplx(w2(2)) - dw2(2)=dcmplx(w2(3)) - dw2(3)=dcmplx(w2(4)) - dw3(0)=dcmplx(w3(1)) - dw3(1)=dcmplx(w3(2)) - dw3(2)=dcmplx(w3(3)) - dw3(3)=dcmplx(w3(4)) - p1(0)=dble( w1(5)) - p1(1)=dble( w1(6)) - p1(2)=dble(dimag(w1(6))) - p1(3)=dble(dimag(w1(5))) - p2(0)=dble( w2(5)) - p2(1)=dble( w2(6)) - p2(2)=dble(dimag(w2(6))) - p2(3)=dble(dimag(w2(5))) - p3(0)=dble( w3(5)) - p3(1)=dble( w3(6)) - p3(2)=dble(dimag(w3(6))) - p3(3)=dble(dimag(w3(5))) - q(0)=-(p1(0)+p2(0)+p3(0)) - q(1)=-(p1(1)+p2(1)+p3(1)) - q(2)=-(p1(2)+p2(2)+p3(2)) - q(3)=-(p1(3)+p2(3)+p3(3)) - - - q2 =q(0)**2 -(q(1)**2 +q(2)**2 +q(3)**2) - dg2=dble(g1)*dble(g2) - dmv=dble(vmass) - dwv=dble(vwidth) - mv2=dmv**2 - if (vmass.eq. r_zero) then - dv = 1.0d0/dcmplx( q2 ) - else - dv = 1.0d0/dcmplx( q2 -mv2 , dmax1(dsign(dmv*dwv,q2 ),0.d0) ) - endif -c for the running width, use below instead of the above dv. -c dv = 1.0d0/dcmplx( q2 -mv2 , dmax1(dwv*q2/dmv,0.d0) ) -c - w12=dw1(0)*dw2(0)-dw1(1)*dw2(1)-dw1(2)*dw2(2)-dw1(3)*dw2(3) - w32=dw3(0)*dw2(0)-dw3(1)*dw2(1)-dw3(2)*dw2(2)-dw3(3)*dw2(3) -c - if ( wmass .ne. r_zero ) then - w13=dw1(0)*dw3(0)-dw1(1)*dw3(1)-dw1(2)*dw3(2)-dw1(3)*dw3(3) -c - j4(0)=dg2*( dw1(0)*w32 + dw3(0)*w12 - 2.d0*dw2(0)*w13 ) - j4(1)=dg2*( dw1(1)*w32 + dw3(1)*w12 - 2.d0*dw2(1)*w13 ) - j4(2)=dg2*( dw1(2)*w32 + dw3(2)*w12 - 2.d0*dw2(2)*w13 ) - j4(3)=dg2*( dw1(3)*w32 + dw3(3)*w12 - 2.d0*dw2(3)*w13 ) -c - jj(0)=j4(0) - jj(1)=j4(1) - jj(2)=j4(2) - jj(3)=j4(3) - - else -c - w12=dw1(0)*dw2(0)-dw1(1)*dw2(1)-dw1(2)*dw2(2)-dw1(3)*dw2(3) - w32=dw3(0)*dw2(0)-dw3(1)*dw2(1)-dw3(2)*dw2(2)-dw3(3)*dw2(3) - w13=dw1(0)*dw3(0)-dw1(1)*dw3(1)-dw1(2)*dw3(2)-dw1(3)*dw3(3) -c - j4(0)=dg2*( dw1(0)*w32 - dw2(0)*w13 ) - j4(1)=dg2*( dw1(1)*w32 - dw2(1)*w13 ) - j4(2)=dg2*( dw1(2)*w32 - dw2(2)*w13 ) - j4(3)=dg2*( dw1(3)*w32 - dw2(3)*w13 ) -c - jj(0)=j4(0) - jj(1)=j4(1) - jj(2)=j4(2) - jj(3)=j4(3) - - end if -c - if ( vmass .ne. r_zero ) then -c - jq=(jj(0)*q(0)-jj(1)*q(1)-jj(2)*q(2)-jj(3)*q(3))/mv2 -c - jw3w(1) = dcmplx( (jj(0)-jq*q(0))*dv ) - jw3w(2) = dcmplx( (jj(1)-jq*q(1))*dv ) - jw3w(3) = dcmplx( (jj(2)-jq*q(2))*dv ) - jw3w(4) = dcmplx( (jj(3)-jq*q(3))*dv ) -c - else -c - jw3w(1) = dcmplx( jj(0)*dv ) - jw3w(2) = dcmplx( jj(1)*dv ) - jw3w(3) = dcmplx( jj(2)*dv ) - jw3w(4) = dcmplx( jj(3)*dv ) - end if -c - return - end subroutine -c -c ---------------------------------------------------------------------- -c - subroutine jwwwxx(w1,w2,w3,gwwa,gwwz,zmass,zwidth,wmass,wwidth , - & jwww) -c -c this subroutine computes an off-shell w+/w- current from the four- -c point gauge boson coupling, including the contributions of photon and -c z exchanges. the vector propagators for the output w and the internal -c z bosons are given in unitary gauge, and that of the internal photon -c is given in feynman gauge. -c -c input: -c complex w1(6) : first vector w1 -c complex w2(6) : second vector w2 -c complex w3(6) : third vector w3 -c real gwwa : coupling constant of w and a gwwa -c real gwwz : coupling constant of w and z gwwz -c real zmass : mass of internal z -c real zwidth : width of internal z -c real wmass : mass of output w -c real wwidth : width of output w -c -c the possible sets of the inputs are as follows: -c ------------------------------------------------------------------- -c | w1 | w2 | w3 |gwwa|gwwz|zmass|zwidth|wmass|wwidth || jwww | -c ------------------------------------------------------------------- -c | w- | w+ | w- |gwwa|gwwz|zmass|zwidth|wmass|wwidth || w+ | -c | w+ | w- | w+ |gwwa|gwwz|zmass|zwidth|wmass|wwidth || w- | -c ------------------------------------------------------------------- -c where all the bosons are defined by the flowing-out quantum number. -c -c output: -c complex jwww(6) : w current j^mu(w':w1,w2,w3) -c - complex*16 w1(6),w2(6),w3(6),jwww(6) - complex*16 dw1(0:3),dw2(0:3),dw3(0:3), - & jj(0:3),js(0:3),jt(0:3),j4(0:3), - & jt12(0:3),jt32(0:3),j12(0:3),j32(0:3), - & dzs,dzt,dw,w12,w32,w13,p1w2,p2w1,p3w2,p2w3, - & jk12,jk32,jsw3,jtw1,p3js,ksw3,p1jt,ktw1,jq - real*8 gwwa,gwwz,zmass,zwidth,wmass,wwidth - real*8 p1(0:3),p2(0:3),p3(0:3),q(0:3),ks(0:3),kt(0:3), - & dgwwa2,dgwwz2,dgw2,dmz,dwz,dmw,dww,mz2,mw2,q2,ks2,kt2, - & das,dat -c - jwww(5) = w1(5)+w2(5)+w3(5) - jwww(6) = w1(6)+w2(6)+w3(6) -c - dw1(0)=dcmplx(w1(1)) - dw1(1)=dcmplx(w1(2)) - dw1(2)=dcmplx(w1(3)) - dw1(3)=dcmplx(w1(4)) - dw2(0)=dcmplx(w2(1)) - dw2(1)=dcmplx(w2(2)) - dw2(2)=dcmplx(w2(3)) - dw2(3)=dcmplx(w2(4)) - dw3(0)=dcmplx(w3(1)) - dw3(1)=dcmplx(w3(2)) - dw3(2)=dcmplx(w3(3)) - dw3(3)=dcmplx(w3(4)) - p1(0)=dble( w1(5)) - p1(1)=dble( w1(6)) - p1(2)=dble(dimag(w1(6))) - p1(3)=dble(dimag(w1(5))) - p2(0)=dble( w2(5)) - p2(1)=dble( w2(6)) - p2(2)=dble(dimag(w2(6))) - p2(3)=dble(dimag(w2(5))) - p3(0)=dble( w3(5)) - p3(1)=dble( w3(6)) - p3(2)=dble(dimag(w3(6))) - p3(3)=dble(dimag(w3(5))) - q(0)=-(p1(0)+p2(0)+p3(0)) - q(1)=-(p1(1)+p2(1)+p3(1)) - q(2)=-(p1(2)+p2(2)+p3(2)) - q(3)=-(p1(3)+p2(3)+p3(3)) - ks(0)=p1(0)+p2(0) - ks(1)=p1(1)+p2(1) - ks(2)=p1(2)+p2(2) - ks(3)=p1(3)+p2(3) - kt(0)=p2(0)+p3(0) - kt(1)=p2(1)+p3(1) - kt(2)=p2(2)+p3(2) - kt(3)=p2(3)+p3(3) - q2 =q(0)**2 -(q(1)**2 +q(2)**2 +q(3)**2) - ks2=ks(0)**2-(ks(1)**2+ks(2)**2+ks(3)**2) - kt2=kt(0)**2-(kt(1)**2+kt(2)**2+kt(3)**2) - dgwwa2=dble(gwwa)**2 - dgwwz2=dble(gwwz)**2 - dgw2 =dgwwa2+dgwwz2 - dmz=dble(zmass) - dwz=dble(zwidth) - dmw=dble(wmass) - dww=dble(wwidth) - mz2=dmz**2 - mw2=dmw**2 -c - das=-dgwwa2/ks2 - dat=-dgwwa2/kt2 - dzs=-dgwwz2/dcmplx( ks2-mz2 , dmax1(dsign(dmz*dwz,ks2),0.d0) ) - dzt=-dgwwz2/dcmplx( kt2-mz2 , dmax1(dsign(dmz*dwz,kt2),0.d0) ) - dw =-1.0d0/dcmplx( q2 -mw2 , dmax1(dsign(dmw*dww,q2 ),0.d0) ) -c for the running width, use below instead of the above dw. -c dw =-1.0d0/dcmplx( q2 -mw2 , dmax1(dww*q2/dmw,0.d0) ) -c - w12=dw1(0)*dw2(0)-dw1(1)*dw2(1)-dw1(2)*dw2(2)-dw1(3)*dw2(3) - w32=dw3(0)*dw2(0)-dw3(1)*dw2(1)-dw3(2)*dw2(2)-dw3(3)*dw2(3) -c - p1w2= (p1(0)+ks(0))*dw2(0)-(p1(1)+ks(1))*dw2(1) - & -(p1(2)+ks(2))*dw2(2)-(p1(3)+ks(3))*dw2(3) - p2w1= (p2(0)+ks(0))*dw1(0)-(p2(1)+ks(1))*dw1(1) - & -(p2(2)+ks(2))*dw1(2)-(p2(3)+ks(3))*dw1(3) - p3w2= (p3(0)+kt(0))*dw2(0)-(p3(1)+kt(1))*dw2(1) - & -(p3(2)+kt(2))*dw2(2)-(p3(3)+kt(3))*dw2(3) - p2w3= (p2(0)+kt(0))*dw3(0)-(p2(1)+kt(1))*dw3(1) - & -(p2(2)+kt(2))*dw3(2)-(p2(3)+kt(3))*dw3(3) -c - jt12(0)= (p1(0)-p2(0))*w12 + p2w1*dw2(0) - p1w2*dw1(0) - jt12(1)= (p1(1)-p2(1))*w12 + p2w1*dw2(1) - p1w2*dw1(1) - jt12(2)= (p1(2)-p2(2))*w12 + p2w1*dw2(2) - p1w2*dw1(2) - jt12(3)= (p1(3)-p2(3))*w12 + p2w1*dw2(3) - p1w2*dw1(3) - jt32(0)= (p3(0)-p2(0))*w32 + p2w3*dw2(0) - p3w2*dw3(0) - jt32(1)= (p3(1)-p2(1))*w32 + p2w3*dw2(1) - p3w2*dw3(1) - jt32(2)= (p3(2)-p2(2))*w32 + p2w3*dw2(2) - p3w2*dw3(2) - jt32(3)= (p3(3)-p2(3))*w32 + p2w3*dw2(3) - p3w2*dw3(3) -c - jk12=(jt12(0)*ks(0)-jt12(1)*ks(1)-jt12(2)*ks(2)-jt12(3)*ks(3))/mz2 - jk32=(jt32(0)*kt(0)-jt32(1)*kt(1)-jt32(2)*kt(2)-jt32(3)*kt(3))/mz2 -c - j12(0)=jt12(0)*(das+dzs)-ks(0)*jk12*dzs - j12(1)=jt12(1)*(das+dzs)-ks(1)*jk12*dzs - j12(2)=jt12(2)*(das+dzs)-ks(2)*jk12*dzs - j12(3)=jt12(3)*(das+dzs)-ks(3)*jk12*dzs - j32(0)=jt32(0)*(dat+dzt)-kt(0)*jk32*dzt - j32(1)=jt32(1)*(dat+dzt)-kt(1)*jk32*dzt - j32(2)=jt32(2)*(dat+dzt)-kt(2)*jk32*dzt - j32(3)=jt32(3)*(dat+dzt)-kt(3)*jk32*dzt -c - jsw3=j12(0)*dw3(0)-j12(1)*dw3(1)-j12(2)*dw3(2)-j12(3)*dw3(3) - jtw1=j32(0)*dw1(0)-j32(1)*dw1(1)-j32(2)*dw1(2)-j32(3)*dw1(3) -c - p3js= (p3(0)-q(0))*j12(0)-(p3(1)-q(1))*j12(1) - & -(p3(2)-q(2))*j12(2)-(p3(3)-q(3))*j12(3) - ksw3= (ks(0)-q(0))*dw3(0)-(ks(1)-q(1))*dw3(1) - & -(ks(2)-q(2))*dw3(2)-(ks(3)-q(3))*dw3(3) - p1jt= (p1(0)-q(0))*j32(0)-(p1(1)-q(1))*j32(1) - & -(p1(2)-q(2))*j32(2)-(p1(3)-q(3))*j32(3) - ktw1= (kt(0)-q(0))*dw1(0)-(kt(1)-q(1))*dw1(1) - & -(kt(2)-q(2))*dw1(2)-(kt(3)-q(3))*dw1(3) -c - js(0)= (ks(0)-p3(0))*jsw3 + p3js*dw3(0) - ksw3*j12(0) - js(1)= (ks(1)-p3(1))*jsw3 + p3js*dw3(1) - ksw3*j12(1) - js(2)= (ks(2)-p3(2))*jsw3 + p3js*dw3(2) - ksw3*j12(2) - js(3)= (ks(3)-p3(3))*jsw3 + p3js*dw3(3) - ksw3*j12(3) - jt(0)= (kt(0)-p1(0))*jtw1 + p1jt*dw1(0) - ktw1*j32(0) - jt(1)= (kt(1)-p1(1))*jtw1 + p1jt*dw1(1) - ktw1*j32(1) - jt(2)= (kt(2)-p1(2))*jtw1 + p1jt*dw1(2) - ktw1*j32(2) - jt(3)= (kt(3)-p1(3))*jtw1 + p1jt*dw1(3) - ktw1*j32(3) -c - w13=dw1(0)*dw3(0)-dw1(1)*dw3(1)-dw1(2)*dw3(2)-dw1(3)*dw3(3) -c - j4(0)=dgw2*( dw1(0)*w32 + dw3(0)*w12 - 2.d0*dw2(0)*w13 ) - j4(1)=dgw2*( dw1(1)*w32 + dw3(1)*w12 - 2.d0*dw2(1)*w13 ) - j4(2)=dgw2*( dw1(2)*w32 + dw3(2)*w12 - 2.d0*dw2(2)*w13 ) - j4(3)=dgw2*( dw1(3)*w32 + dw3(3)*w12 - 2.d0*dw2(3)*w13 ) -c -c jj(0)=js(0)+jt(0)+j4(0) -c jj(1)=js(1)+jt(1)+j4(1) -c jj(2)=js(2)+jt(2)+j4(2) -c jj(3)=js(3)+jt(3)+j4(3) - - jj(0)=j4(0) - jj(1)=j4(1) - jj(2)=j4(2) - jj(3)=j4(3) -c - jq=(jj(0)*q(0)-jj(1)*q(1)-jj(2)*q(2)-jj(3)*q(3))/mw2 -c - - jwww(1) = dcmplx( (jj(0)-jq*q(0))*dw ) - jwww(2) = dcmplx( (jj(1)-jq*q(1))*dw ) - jwww(3) = dcmplx( (jj(2)-jq*q(2))*dw ) - jwww(4) = dcmplx( (jj(3)-jq*q(3))*dw ) -c - return - end subroutine - -C -C ---------------------------------------------------------------------- -C - SUBROUTINE MOM2CX(ESUM,MASS1,MASS2,COSTH1,PHI1 , P1,P2) -C -C This subroutine sets up two four-momenta in the two particle rest -C frame. -C -C INPUT: -C real ESUM : energy sum of particle 1 and 2 -C real MASS1 : mass of particle 1 -C real MASS2 : mass of particle 2 -C real COSTH1 : cos(theta) of particle 1 -C real PHI1 : azimuthal angle of particle 1 -C -C OUTPUT: -C real P1(0:3) : four-momentum of particle 1 -C real P2(0:3) : four-momentum of particle 2 -C - REAL*8 P1(0:3),P2(0:3), - & ESUM,MASS1,MASS2,COSTH1,PHI1,MD2,ED,PP,SINTH1 -C - MD2=(MASS1-MASS2)*(MASS1+MASS2) - ED=MD2/ESUM - IF (MASS1*MASS2.EQ.0.) THEN - PP=(ESUM-ABS(ED))*0.5d0 -C - ELSE - PP=SQRT((MD2/ESUM)**2-2.0d0*(MASS1**2+MASS2**2)+ESUM**2)*0.5d0 - ENDIF - SINTH1=SQRT((1.0d0-COSTH1)*(1.0d0+COSTH1)) -C - P1(0) = MAX((ESUM+ED)*0.5d0,0.d0) - P1(1) = PP*SINTH1*COS(PHI1) - P1(2) = PP*SINTH1*SIN(PHI1) - P1(3) = PP*COSTH1 -C - P2(0) = MAX((ESUM-ED)*0.5d0,0.d0) - P2(1) = -P1(1) - P2(2) = -P1(2) - P2(3) = -P1(3) -C - RETURN - end subroutine -C ********************************************************************** -C - SUBROUTINE MOMNTX(ENERGY,MASS,COSTH,PHI , P) -C -C This subroutine sets up a four-momentum from the four inputs. -C -C INPUT: -C real ENERGY : energy -C real MASS : mass -C real COSTH : cos(theta) -C real PHI : azimuthal angle -C -C OUTPUT: -C real P(0:3) : four-momentum -C - implicit none - REAL*8 P(0:3),ENERGY,MASS,COSTH,PHI,PP,SINTH -C - P(0) = ENERGY - IF (ENERGY.EQ.MASS) THEN - P(1) = 0. - P(2) = 0. - P(3) = 0. - ELSE - PP=SQRT((ENERGY-MASS)*(ENERGY+MASS)) - SINTH=SQRT((1.-COSTH)*(1.+COSTH)) - P(3) = PP*COSTH - IF (PHI.EQ.0.) THEN - P(1) = PP*SINTH - P(2) = 0. - ELSE - P(1) = PP*SINTH*COS(PHI) - P(2) = PP*SINTH*SIN(PHI) - ENDIF - ENDIF - RETURN - end subroutine -C -c -c -c Subroutine returns the desired fermion or -c anti-fermion anti-spinor. ie., -c - subroutine oxxxxx( - & p, !in: four vector momentum - & fmass, !in: fermion mass - & nhel, !in: anti-spinor helicity, -1 or 1 - & nsf, !in: -1=antifermion, 1=fermion - & fo !out: fermion wavefunction - & ) - implicit none -c -c declare input/output variables -c - complex*16 fo(6) - integer*4 nhel, nsf - real*8 p(0:3), fmass -c -c declare local variables -c - real*8 r_zero, r_one, r_two - parameter( r_zero=0.0d0, r_one=1.0d0, r_two=2.0d0 ) - complex*16 c_zero -c - real*8 plat, pabs, omegap, omegam, rs2pa, spaz - c_zero=dcmplx( r_zero, r_zero ) -c -c define kinematic parameters -c - fo(5) = dcmplx( p(0), p(3) ) * nsf - fo(6) = dcmplx( p(1), p(2) ) * nsf - plat = sqrt( p(1)**2 + p(2)**2 ) - pabs = sqrt( p(1)**2 + p(2)**2 + p(3)**2 ) - omegap = sqrt( p(0) + pabs ) -c -c do massive fermion case -c - if ( fmass .ne. r_zero ) then - omegam = fmass / omegap - if ( nsf .eq. 1 ) then - if ( nhel .eq. 1 ) then - if ( p(3) .ge. r_zero ) then - if ( plat .eq. r_zero ) then - fo(1) = dcmplx( omegap, r_zero ) - fo(2) = c_zero - fo(3) = dcmplx( omegam, r_zero ) - fo(4) = c_zero - else - rs2pa = r_one / sqrt( r_two * pabs ) - spaz = sqrt( pabs + p(3) ) - fo(1) = omegap * rs2pa - & * dcmplx( spaz, r_zero ) - fo(2) = omegap * rs2pa / spaz - & * dcmplx( p(1), -p(2) ) - fo(3) = omegam * rs2pa - & * dcmplx( spaz, r_zero ) - fo(4) = omegam * rs2pa / spaz - & * dcmplx( p(1), -p(2) ) - end if - else - if ( plat .eq. r_zero ) then - fo(1) = c_zero - fo(2) = dcmplx( omegap, r_zero ) - fo(3) = c_zero - fo(4) = dcmplx( omegam, r_zero ) - else - rs2pa = r_one / sqrt( r_two * pabs ) - spaz = sqrt( pabs - p(3) ) - fo(1) = omegap * rs2pa / spaz - & * dcmplx( plat, r_zero ) - fo(2) = omegap * rs2pa * spaz / plat - & * dcmplx( p(1), -p(2) ) - fo(3) = omegam * rs2pa / spaz - & * dcmplx( plat, r_zero ) - fo(4) = omegam * rs2pa * spaz / plat - & * dcmplx( p(1), -p(2) ) - end if - end if - else if ( nhel .eq. -1 ) then - if ( p(3) .ge. r_zero ) then - if ( plat .eq. r_zero ) then - fo(1) = c_zero - fo(2) = dcmplx( omegam, r_zero ) - fo(3) = c_zero - fo(4) = dcmplx( omegap, r_zero ) - else - rs2pa = r_one / sqrt( r_two * pabs ) - spaz = sqrt( pabs + p(3) ) - fo(1) = omegam * rs2pa / spaz - & * dcmplx( -p(1), -p(2) ) - fo(2) = omegam * rs2pa - & * dcmplx( spaz, r_zero ) - fo(3) = omegap * rs2pa / spaz - & * dcmplx( -p(1), -p(2) ) - fo(4) = omegap * rs2pa - & * dcmplx( spaz, r_zero ) - end if - else - if ( plat .eq. r_zero ) then - fo(1) = dcmplx( -omegam, r_zero ) - fo(2) = c_zero - fo(3) = dcmplx( -omegap, r_zero ) - fo(4) = c_zero - else - rs2pa = r_one / sqrt( r_two * pabs ) - spaz = sqrt( pabs - p(3) ) - fo(1) = omegam * rs2pa * spaz / plat - & * dcmplx( -p(1), -p(2) ) - fo(2) = omegam * rs2pa / spaz - & * dcmplx( plat, r_zero ) - fo(3) = omegap * rs2pa * spaz / plat - & * dcmplx( -p(1), -p(2) ) - fo(4) = omegap * rs2pa / spaz - & * dcmplx( plat, r_zero ) - end if - end if - else - stop 'oxxxxx: fermion helicity must be +1,-1' - end if - else if ( nsf .eq. -1 ) then - if ( nhel .eq. 1 ) then - if ( p(3) .ge. r_zero ) then - if ( plat .eq. r_zero ) then - fo(1) = c_zero - fo(2) = dcmplx( omegam, r_zero ) - fo(3) = c_zero - fo(4) = dcmplx( -omegap, r_zero ) - else - rs2pa = r_one / sqrt( r_two * pabs ) - spaz = sqrt( pabs + p(3) ) - fo(1) = omegam * rs2pa / spaz - & * dcmplx( -p(1), -p(2) ) - fo(2) = omegam * rs2pa - & * dcmplx( spaz, r_zero ) - fo(3) = -omegap * rs2pa / spaz - & * dcmplx( -p(1), -p(2) ) - fo(4) = -omegap * rs2pa - & * dcmplx( spaz, r_zero ) - end if - else - if ( plat .eq. r_zero ) then - fo(1) = dcmplx( -omegam, r_zero ) - fo(2) = c_zero - fo(3) = dcmplx( omegap, r_zero ) - fo(4) = c_zero - else - rs2pa = r_one / sqrt( r_two * pabs ) - spaz = sqrt( pabs - p(3) ) - fo(1) = omegam * rs2pa * spaz / plat - & * dcmplx( -p(1), -p(2) ) - fo(2) = omegam * rs2pa / spaz - & * dcmplx( plat, r_zero ) - fo(3) = -omegap * rs2pa * spaz / plat - & * dcmplx( -p(1), -p(2) ) - fo(4) = -omegap * rs2pa / spaz - & * dcmplx( plat, r_zero ) - end if - end if - else if ( nhel .eq. -1 ) then - if ( p(3) .ge. r_zero ) then - if ( plat .eq. r_zero ) then - fo(1) = dcmplx( -omegap, r_zero ) - fo(2) = c_zero - fo(3) = dcmplx( omegam, r_zero ) - fo(4) = c_zero - else - rs2pa = r_one / sqrt( r_two * pabs ) - spaz = sqrt( pabs + p(3) ) - fo(1) = -omegap * rs2pa - & * dcmplx( spaz, r_zero ) - fo(2) = -omegap * rs2pa / spaz - & * dcmplx( p(1), -p(2) ) - fo(3) = omegam * rs2pa - & * dcmplx( spaz, r_zero ) - fo(4) = omegam * rs2pa / spaz - & * dcmplx( p(1), -p(2) ) - end if - else - if ( plat .eq. r_zero ) then - fo(1) = c_zero - fo(2) = dcmplx( -omegap, r_zero ) - fo(3) = c_zero - fo(4) = dcmplx( omegam, r_zero ) - else - rs2pa = r_one / sqrt( r_two * pabs ) - spaz = sqrt( pabs - p(3) ) - fo(1) = -omegap * rs2pa / spaz - & * dcmplx( plat, r_zero ) - fo(2) = -omegap * rs2pa * spaz / plat - & * dcmplx( p(1), -p(2) ) - fo(3) = omegam * rs2pa / spaz - & * dcmplx( plat, r_zero ) - fo(4) = omegam * rs2pa * spaz / plat - & * dcmplx( p(1), -p(2) ) - end if - end if - else - stop 'oxxxxx: fermion helicity must be +1,-1' - end if - else - stop 'oxxxxx: fermion type must be +1,-1' - end if -c -c do massless case -c - else - if ( nsf .eq. 1 ) then - if ( nhel .eq. 1 ) then - if ( p(3) .ge. r_zero ) then - if ( plat .eq. r_zero ) then - fo(1) = dcmplx( omegap, r_zero ) - fo(2) = c_zero - fo(3) = c_zero - fo(4) = c_zero - else - spaz = sqrt( pabs + p(3) ) - fo(1) = dcmplx( spaz, r_zero ) - fo(2) = r_one / spaz - & * dcmplx( p(1), -p(2) ) - fo(3) = c_zero - fo(4) = c_zero - end if - else - if ( plat .eq. r_zero ) then - fo(1) = c_zero - fo(2) = dcmplx( omegap, r_zero ) - fo(3) = c_zero - fo(4) = c_zero - else - spaz = sqrt( pabs - p(3) ) - fo(1) = r_one / spaz - & * dcmplx( plat, r_zero ) - fo(2) = spaz / plat - & * dcmplx( p(1), -p(2) ) - fo(3) = c_zero - fo(4) = c_zero - end if - end if - else if ( nhel .eq. -1 ) then - if ( p(3) .ge. r_zero ) then - if ( plat .eq. r_zero ) then - fo(1) = c_zero - fo(2) = c_zero - fo(3) = c_zero - fo(4) = dcmplx( omegap, r_zero ) - else - spaz = sqrt( pabs + p(3) ) - fo(1) = c_zero - fo(2) = c_zero - fo(3) = r_one / spaz - & * dcmplx( -p(1), -p(2) ) - fo(4) = dcmplx( spaz, r_zero ) - end if - else - if ( plat .eq. r_zero ) then - fo(1) = c_zero - fo(2) = c_zero - fo(3) = dcmplx( -omegap, r_zero ) - fo(4) = c_zero - else - spaz = sqrt( pabs - p(3) ) - fo(1) = c_zero - fo(2) = c_zero - fo(3) = spaz / plat - & * dcmplx( -p(1), -p(2) ) - fo(4) = r_one / spaz - & * dcmplx( plat, r_zero ) - end if - end if - else - stop 'oxxxxx: fermion helicity must be +1,-1' - end if - else if ( nsf .eq. -1 ) then - if ( nhel .eq. 1 ) then - if ( p(3) .ge. r_zero ) then - if ( plat .eq. r_zero ) then - fo(1) = c_zero - fo(2) = c_zero - fo(3) = c_zero - fo(4) = dcmplx( -omegap, r_zero ) - else - spaz = sqrt( pabs + p(3) ) - fo(1) = c_zero - fo(2) = c_zero - fo(3) = -r_one / spaz - & * dcmplx( -p(1), -p(2) ) - fo(4) = dcmplx( -spaz, r_zero ) - end if - else - if ( plat .eq. r_zero ) then - fo(1) = c_zero - fo(2) = c_zero - fo(3) = dcmplx( omegap, r_zero ) - fo(4) = c_zero - else - spaz = sqrt( pabs - p(3) ) - fo(1) = c_zero - fo(2) = c_zero - fo(3) = -spaz / plat - & * dcmplx( -p(1), -p(2) ) - fo(4) = -r_one / spaz - & * dcmplx( plat, r_zero ) - end if - end if - else if ( nhel .eq. -1 ) then - if ( p(3) .ge. r_zero ) then - if ( plat .eq. r_zero ) then - fo(1) = dcmplx( -omegap, r_zero ) - fo(2) = c_zero - fo(3) = c_zero - fo(4) = c_zero - else - spaz = sqrt( pabs + p(3) ) - fo(1) = dcmplx( -spaz, r_zero ) - fo(2) = -r_one / spaz - & * dcmplx( p(1), -p(2) ) - fo(3) = c_zero - fo(4) = c_zero - end if - else - if ( plat .eq. r_zero ) then - fo(1) = c_zero - fo(2) = dcmplx( -omegap, r_zero ) - fo(3) = c_zero - fo(4) = c_zero - else - spaz = sqrt( pabs - p(3) ) - fo(1) = -r_one / spaz - & * dcmplx( plat, r_zero ) - fo(2) = -spaz / plat - & * dcmplx( p(1), -p(2) ) - fo(3) = c_zero - fo(4) = c_zero - end if - end if - else - stop 'oxxxxx: fermion helicity must be +1,-1' - end if - else - stop 'oxxxxx: fermion type must be +1,-1' - end if - end if -c -c done -c - return - end subroutine -c -c ---------------------------------------------------------------------- -c - subroutine rotxxx(p,q , prot) -c -c this subroutine performs the spacial rotation of a four-momentum. -c the momentum p is assumed to be given in the frame where the spacial -c component of q points the positive z-axis. prot is the momentum p -c rotated to the frame where q is given. -c -c input: -c real p(0:3) : four-momentum p in q(1)=q(2)=0 frame -c real q(0:3) : four-momentum q in the rotated frame -c -c output: -c real prot(0:3) : four-momentum p in the rotated frame -c - real*8 p(0:3),q(0:3),prot(0:3),qt2,qt,psgn,qq,p1 -c - real*8 r_zero, r_one - parameter( r_zero=0.0d0, r_one=1.0d0 ) -c - prot(0) = p(0) -c - qt2=q(1)**2+q(2)**2 -c - if ( qt2 .eq. r_zero ) then - if ( q(3) .eq. r_zero ) then - prot(1) = p(1) - prot(2) = p(2) - prot(3) = p(3) - else - psgn=dsign(r_one,q(3)) - prot(1) = p(1)*psgn - prot(2) = p(2)*psgn - prot(3) = p(3)*psgn - endif - else - qq=sqrt(qt2+q(3)**2) - qt=sqrt(qt2) - p1=p(1) - prot(1) = q(1)*q(3)/qq/qt*p1 -q(2)/qt*p(2) +q(1)/qq*p(3) - prot(2) = q(2)*q(3)/qq/qt*p1 +q(1)/qt*p(2) +q(2)/qq*p(3) - prot(3) = -qt/qq*p1 +q(3)/qq*p(3) - endif -c - return - end subroutine -C ====================================================================== -C - SUBROUTINE SSSSXX(S1,S2,S3,S4,G , VERTEX) -C -C This subroutine computes an amplitude of the four-scalar coupling. -C -C INPUT: -C complex S1(3) : first scalar S1 -C complex S2(3) : second scalar S2 -C complex S3(3) : third scalar S3 -C complex S4(3) : fourth scalar S4 -C real G : coupling constant GHHHH -C -C OUTPUT: -C complex VERTEX : amplitude Gamma(S1,S2,S3,S4) -C - implicit none - COMPLEX*16 S1(3),S2(3),S3(3),S4(3),VERTEX - REAL*8 G -C - VERTEX = G*S1(1)*S2(1)*S3(1)*S4(1) -C - RETURN - end subroutine -C -C ====================================================================== -C - SUBROUTINE SSSXXX(S1,S2,S3,G , VERTEX) -C -C This subroutine computes an amplitude of the three-scalar coupling. -C -C INPUT: -C complex S1(3) : first scalar S1 -C complex S2(3) : second scalar S2 -C complex S3(3) : third scalar S3 -C real G : coupling constant GHHH -C -C OUTPUT: -C complex VERTEX : amplitude Gamma(S1,S2,S3) -C - implicit none - COMPLEX*16 S1(3),S2(3),S3(3),VERTEX - REAL*8 G -C - VERTEX = G*S1(1)*S2(1)*S3(1) -C - RETURN - end subroutine -C -C -C ---------------------------------------------------------------------- -C - SUBROUTINE SXXXXX(P,NSS , SC) -C -C This subroutine computes a complex SCALAR wavefunction. -C -C INPUT: -C real P(0:3) : four-momentum of scalar boson -C integer NSS = -1 or 1 : +1 for final, -1 for initial -C -C OUTPUT: -C complex SC(3) : scalar wavefunction S -C - COMPLEX*16 SC(3) - REAL*8 P(0:3) - INTEGER NSS -C - SC(1) = DCMPLX( 1.0 ) - SC(2) = DCMPLX(P(0),P(3))*NSS - SC(3) = DCMPLX(P(1),P(2))*NSS -C - RETURN - end subroutine -c -c ====================================================================== -c - subroutine vssxxx(vc,s1,s2,g , vertex) -c -c this subroutine computes an amplitude from the vector-scalar-scalar -c coupling. the coupling is absent in the minimal sm in unitary gauge. -c -c complex vc(6) : input vector v -c complex s1(3) : first scalar s1 -c complex s2(3) : second scalar s2 -c complex g : coupling constant (s1 charge) -c -c examples of the coupling constant g for susy particles are as follows: -c ----------------------------------------------------------- -c | s1 | (q,i3) of s1 || v=a | v=z | v=w | -c ----------------------------------------------------------- -c | nu~_l | ( 0 , +1/2) || --- | gzn(1) | gwf(1) | -c | e~_l | ( -1 , -1/2) || gal(1) | gzl(1) | gwf(1) | -c | u~_l | (+2/3 , +1/2) || gau(1) | gzu(1) | gwf(1) | -c | d~_l | (-1/3 , -1/2) || gad(1) | gzd(1) | gwf(1) | -c ----------------------------------------------------------- -c | e~_r-bar | ( +1 , 0 ) || -gal(2) | -gzl(2) | -gwf(2) | -c | u~_r-bar | (-2/3 , 0 ) || -gau(2) | -gzu(2) | -gwf(2) | -c | d~_r-bar | (+1/3 , 0 ) || -gad(2) | -gzd(2) | -gwf(2) | -c ----------------------------------------------------------- -c where the s1 charge is defined by the flowing-out quantum number. -c -c output: -c complex vertex : amplitude gamma(v,s1,s2) -c - complex*16 vc(6),s1(3),s2(3),vertex,g - real*8 p(0:3) -c - p(0)=dble( s1(2)-s2(2)) - p(1)=dble( s1(3)-s2(3)) - p(2)=dimag(s1(3)-s2(3)) - p(3)=dimag(s1(2)-s2(2)) -c - vertex = g*s1(1)*s2(1) - & *(vc(1)*p(0)-vc(2)*p(1)-vc(3)*p(2)-vc(4)*p(3)) -c - return - end subroutine -C - SUBROUTINE VVSSXX(V1,V2,S1,S2,G , VERTEX) -C -C This subroutine computes an amplitude of the vector-vector-scalar- -C scalar coupling. -C -C INPUT: -C complex V1(6) : first vector V1 -C complex V2(6) : second vector V2 -C complex S1(3) : first scalar S1 -C complex S2(3) : second scalar S2 -C real G : coupling constant GVVHH -C -C OUTPUT: -C complex VERTEX : amplitude Gamma(V1,V2,S1,S2) -C - implicit none - COMPLEX*16 V1(6),V2(6),S1(3),S2(3),VERTEX - REAL*8 G -C - VERTEX = G*S1(1)*S2(1) - & *(V1(1)*V2(1)-V1(2)*V2(2)-V1(3)*V2(3)-V1(4)*V2(4)) -C - RETURN - end subroutine -C -c -c ====================================================================== -c - subroutine vvsxxx(v1,v2,sc,g , vertex) -c -c this subroutine computes an amplitude of the vector-vector-scalar -c coupling. -c -c input: -c complex v1(6) : first vector v1 -c complex v2(6) : second vector v2 -c complex sc(3) : input scalar s -c real g : coupling constant gvvh -c -c output: -c complex vertex : amplitude gamma(v1,v2,s) -c - complex*16 v1(6),v2(6),sc(3),vertex - real*8 g -c - vertex = g*sc(1)*(v1(1)*v2(1)-v1(2)*v2(2)-v1(3)*v2(3)-v1(4)*v2(4)) -c - return - end subroutine -c -c ====================================================================== -c - subroutine vvvxxx(wm,wp,w3,g , vertex) -c -c this subroutine computes an amplitude of the three-point coupling of -c the gauge bosons. -c -c input: -c complex wm(6) : vector flow-out w- -c complex wp(6) : vector flow-out w+ -c complex w3(6) : vector j3 or a or z -c real g : coupling constant gw or gwwa or gwwz -c -c output: -c complex vertex : amplitude gamma(wm,wp,w3) -c - complex*16 wm(6),wp(6),w3(6),vertex, - & xv1,xv2,xv3,v12,v23,v31,p12,p13,p21,p23,p31,p32 - real*8 pwm(0:3),pwp(0:3),pw3(0:3),g -c - real*8 r_zero, r_tenth - parameter( r_zero=0.0d0, r_tenth=0.1d0 ) -c - pwm(0)=dble( wm(5)) - pwm(1)=dble( wm(6)) - pwm(2)=dimag(wm(6)) - pwm(3)=dimag(wm(5)) - pwp(0)=dble( wp(5)) - pwp(1)=dble( wp(6)) - pwp(2)=dimag(wp(6)) - pwp(3)=dimag(wp(5)) - pw3(0)=dble( w3(5)) - pw3(1)=dble( w3(6)) - pw3(2)=dimag(w3(6)) - pw3(3)=dimag(w3(5)) -c - v12=wm(1)*wp(1)-wm(2)*wp(2)-wm(3)*wp(3)-wm(4)*wp(4) - v23=wp(1)*w3(1)-wp(2)*w3(2)-wp(3)*w3(3)-wp(4)*w3(4) - v31=w3(1)*wm(1)-w3(2)*wm(2)-w3(3)*wm(3)-w3(4)*wm(4) - xv1=r_zero - xv2=r_zero - xv3=r_zero - if ( abs(wm(1)) .ne. r_zero ) then - if (abs(wm(1)).ge.max(abs(wm(2)),abs(wm(3)),abs(wm(4))) - $ *r_tenth) - & xv1=pwm(0)/wm(1) - endif - if ( abs(wp(1)) .ne. r_zero) then - if (abs(wp(1)).ge.max(abs(wp(2)),abs(wp(3)),abs(wp(4))) - $ *r_tenth) - & xv2=pwp(0)/wp(1) - endif - if ( abs(w3(1)) .ne. r_zero) then - if ( abs(w3(1)).ge.max(abs(w3(2)),abs(w3(3)),abs(w3(4))) - $ *r_tenth) - & xv3=pw3(0)/w3(1) - endif - p12= (pwm(0)-xv1*wm(1))*wp(1)-(pwm(1)-xv1*wm(2))*wp(2) - & -(pwm(2)-xv1*wm(3))*wp(3)-(pwm(3)-xv1*wm(4))*wp(4) - p13= (pwm(0)-xv1*wm(1))*w3(1)-(pwm(1)-xv1*wm(2))*w3(2) - & -(pwm(2)-xv1*wm(3))*w3(3)-(pwm(3)-xv1*wm(4))*w3(4) - p21= (pwp(0)-xv2*wp(1))*wm(1)-(pwp(1)-xv2*wp(2))*wm(2) - & -(pwp(2)-xv2*wp(3))*wm(3)-(pwp(3)-xv2*wp(4))*wm(4) - p23= (pwp(0)-xv2*wp(1))*w3(1)-(pwp(1)-xv2*wp(2))*w3(2) - & -(pwp(2)-xv2*wp(3))*w3(3)-(pwp(3)-xv2*wp(4))*w3(4) - p31= (pw3(0)-xv3*w3(1))*wm(1)-(pw3(1)-xv3*w3(2))*wm(2) - & -(pw3(2)-xv3*w3(3))*wm(3)-(pw3(3)-xv3*w3(4))*wm(4) - p32= (pw3(0)-xv3*w3(1))*wp(1)-(pw3(1)-xv3*w3(2))*wp(2) - & -(pw3(2)-xv3*w3(3))*wp(3)-(pw3(3)-xv3*w3(4))*wp(4) -c - vertex = -(v12*(p13-p23)+v23*(p21-p31)+v31*(p32-p12))*g -c - return - end subroutine -c -c -c Subroutine returns the value of evaluated -c helicity basis boson polarisation wavefunction. -c Replaces the HELAS routine VXXXXX -c -c Adam Duff, 1992 September 3 -c -c - subroutine vxxxxx( - & p, !in: boson four momentum - & vmass, !in: boson mass - & nhel, !in: boson helicity - & nsv, !in: incoming (-1) or outgoing (+1) - & vc !out: boson wavefunction - & ) - implicit none -c -c declare input/output variables -c - complex*16 vc(6) - integer*4 nhel, nsv - real*8 p(0:3), vmass -c -c declare local variables -c - real*8 r_zero, r_one, r_two - parameter( r_zero=0.0d0, r_one=1.0d0, r_two=2.0d0 ) - complex*16 c_zero -c - real*8 plat, pabs, rs2, rplat, rpabs, rden - c_zero=dcmplx( r_zero, r_zero ) -c -c define internal/external momenta -c - if ( nsv**2 .ne. 1 ) then - stop 'vxxxxx: nsv is not one of -1, +1' - end if -c - rs2 = sqrt( r_one / r_two ) - vc(5) = dcmplx( p(0), p(3) ) * nsv - vc(6) = dcmplx( p(1), p(2) ) * nsv - plat = sqrt( p(1)**2 + p(2)**2 ) - pabs = sqrt( p(1)**2 + p(2)**2 + p(3)**2 ) -c -c calculate polarisation four vectors -c - if ( nhel**2 .eq. 1 ) then - if ( (pabs .eq. r_zero) .or. (plat .eq. r_zero) ) then - vc(1) = c_zero - vc(2) = dcmplx( -nhel * rs2 * dsign( r_one, p(3) ), r_zero ) - vc(3) = dcmplx( r_zero, nsv * rs2 ) - vc(4) = c_zero - else - rplat = r_one / plat - rpabs = r_one / pabs - vc(1) = c_zero - vc(2) = dcmplx( -nhel * rs2 * rpabs * rplat * p(1) * p(3), - & -nsv * rs2 * rplat * p(2) ) - vc(3) = dcmplx( -nhel * rs2 * rpabs * rplat * p(2) * p(3), - & nsv * rs2 * rplat * p(1) ) - vc(4) = dcmplx( nhel * rs2 * rpabs * plat, - & r_zero ) - end if - else if ( nhel .eq. 0 ) then - if ( vmass .gt. r_zero ) then - if ( pabs .eq. r_zero ) then - vc(1) = c_zero - vc(2) = c_zero - vc(3) = c_zero - vc(4) = dcmplx( r_one, r_zero ) - else - rden = p(0) / ( vmass * pabs ) - vc(1) = dcmplx( pabs / vmass, r_zero ) - vc(2) = dcmplx( rden * p(1), r_zero ) - vc(3) = dcmplx( rden * p(2), r_zero ) - vc(4) = dcmplx( rden * p(3), r_zero ) - end if - else - stop 'vxxxxx: nhel = 0 is only for massive bosons' - end if - else if ( nhel .eq. 4 ) then - if ( vmass .gt. r_zero ) then - rden = r_one / vmass - vc(1) = dcmplx( rden * p(0), r_zero ) - vc(2) = dcmplx( rden * p(1), r_zero ) - vc(3) = dcmplx( rden * p(2), r_zero ) - vc(4) = dcmplx( rden * p(3), r_zero ) - elseif (vmass .eq. r_zero) then - rden = r_one / p(0) - vc(1) = dcmplx( rden * p(0), r_zero ) - vc(2) = dcmplx( rden * p(1), r_zero ) - vc(3) = dcmplx( rden * p(2), r_zero ) - vc(4) = dcmplx( rden * p(3), r_zero ) - else - stop 'vxxxxx: nhel = 4 is only for m>=0' - end if - else - stop 'vxxxxx: nhel is not one of -1, 0, 1 or 4' - end if -c -c done -c - return - end subroutine -c -c ---------------------------------------------------------------------- -c - subroutine w3w3xx(wm,w31,wp,w32,g31,g32,wmass,wwidth , vertex) -c -c this subroutine computes an amplitude of the four-point coupling of -c the w-, w+ and two w3/z/a. the amplitude includes the contributions -c of w exchange diagrams. the internal w propagator is given in unitary -c gauge. if one sets wmass=0.0, then the gggg vertex is given (see sect -c 2.9.1 of the manual). -c -c input: -c complex wm(0:3) : flow-out w- wm -c complex w31(0:3) : first w3/z/a w31 -c complex wp(0:3) : flow-out w+ wp -c complex w32(0:3) : second w3/z/a w32 -c real g31 : coupling of w31 with w-/w+ -c real g32 : coupling of w32 with w-/w+ -c (see the table below) -c real wmass : mass of w -c real wwidth : width of w -c -c the possible sets of the inputs are as follows: -c ------------------------------------------- -c | wm | w31 | wp | w32 | g31 | g32 | -c ------------------------------------------- -c | w- | w3 | w+ | w3 | gw | gw | -c | w- | w3 | w+ | z | gw | gwwz | -c | w- | w3 | w+ | a | gw | gwwa | -c | w- | z | w+ | z | gwwz | gwwz | -c | w- | z | w+ | a | gwwz | gwwa | -c | w- | a | w+ | a | gwwa | gwwa | -c ------------------------------------------- -c where all the bosons are defined by the flowing-out quantum number. -c -c output: -c complex vertex : amplitude gamma(wm,w31,wp,w32) -c - complex*16 wm(6),w31(6),wp(6),w32(6),vertex - complex*16 dv1(0:3),dv2(0:3),dv3(0:3),dv4(0:3),dvertx, - & v12,v13,v14,v23,v24,v34 - real*8 g31,g32,wmass,wwidth -c - real*8 r_zero, r_one - parameter( r_zero=0.0d0, r_one=1.0d0 ) - - dv1(0)=dcmplx(wm(1)) - dv1(1)=dcmplx(wm(2)) - dv1(2)=dcmplx(wm(3)) - dv1(3)=dcmplx(wm(4)) - dv2(0)=dcmplx(w31(1)) - dv2(1)=dcmplx(w31(2)) - dv2(2)=dcmplx(w31(3)) - dv2(3)=dcmplx(w31(4)) - dv3(0)=dcmplx(wp(1)) - dv3(1)=dcmplx(wp(2)) - dv3(2)=dcmplx(wp(3)) - dv3(3)=dcmplx(wp(4)) - dv4(0)=dcmplx(w32(1)) - dv4(1)=dcmplx(w32(2)) - dv4(2)=dcmplx(w32(3)) - dv4(3)=dcmplx(w32(4)) -c - if ( dble(wmass) .ne. r_zero ) then -c dm2inv = r_one / dmw2 -c - v12= dv1(0)*dv2(0)-dv1(1)*dv2(1)-dv1(2)*dv2(2)-dv1(3)*dv2(3) - v13= dv1(0)*dv3(0)-dv1(1)*dv3(1)-dv1(2)*dv3(2)-dv1(3)*dv3(3) - v14= dv1(0)*dv4(0)-dv1(1)*dv4(1)-dv1(2)*dv4(2)-dv1(3)*dv4(3) - v23= dv2(0)*dv3(0)-dv2(1)*dv3(1)-dv2(2)*dv3(2)-dv2(3)*dv3(3) - v24= dv2(0)*dv4(0)-dv2(1)*dv4(1)-dv2(2)*dv4(2)-dv2(3)*dv4(3) - v34= dv3(0)*dv4(0)-dv3(1)*dv4(1)-dv3(2)*dv4(2)-dv3(3)*dv4(3) -c - dvertx = v12*v34 +v14*v23 -2.d0*v13*v24 -c - vertex = dcmplx( dvertx ) * (g31*g32) -c - else - v12= dv1(0)*dv2(0)-dv1(1)*dv2(1)-dv1(2)*dv2(2)-dv1(3)*dv2(3) - v13= dv1(0)*dv3(0)-dv1(1)*dv3(1)-dv1(2)*dv3(2)-dv1(3)*dv3(3) - v14= dv1(0)*dv4(0)-dv1(1)*dv4(1)-dv1(2)*dv4(2)-dv1(3)*dv4(3) - v23= dv2(0)*dv3(0)-dv2(1)*dv3(1)-dv2(2)*dv3(2)-dv2(3)*dv3(3) - v24= dv2(0)*dv4(0)-dv2(1)*dv4(1)-dv2(2)*dv4(2)-dv2(3)*dv4(3) - v34= dv3(0)*dv4(0)-dv3(1)*dv4(1)-dv3(2)*dv4(2)-dv3(3)*dv4(3) -c - - dvertx = v14*v23 -v13*v24 -c - vertex = dcmplx( dvertx ) * (g31*g32) - end if -c - return - end subroutine -c -c ====================================================================== -c - subroutine wwwwxx(wm1,wp1,wm2,wp2,gwwa,gwwz,zmass,zwidth , vertex) -c -c this subroutine computes an amplitude of the four-point w-/w+ -c coupling, including the contributions of photon and z exchanges. the -c photon propagator is given in feynman gauge and the z propagator is -c given in unitary gauge. -c -c input: -c complex wm1(0:3) : first flow-out w- wm1 -c complex wp1(0:3) : first flow-out w+ wp1 -c complex wm2(0:3) : second flow-out w- wm2 -c complex wp2(0:3) : second flow-out w+ wp2 -c real gwwa : coupling constant of w and a gwwa -c real gwwz : coupling constant of w and z gwwz -c real zmass : mass of z -c real zwidth : width of z -c -c output: -c complex vertex : amplitude gamma(wm1,wp1,wm2,wp2) -c - complex*16 wm1(6),wp1(6),wm2(6),wp2(6),vertex - complex*16 dv1(0:3),dv2(0:3),dv3(0:3),dv4(0:3), - & j12(0:3),j34(0:3),j14(0:3),j32(0:3),dvertx, - & sv1,sv2,sv3,sv4,tv1,tv2,tv3,tv4,dzs,dzt, - & v12,v13,v14,v23,v24,v34,js12,js34,js14,js32,js,jt - real*8 pwm1(0:3),pwp1(0:3),pwm2(0:3),pwp2(0:3), - & gwwa,gwwz,zmass,zwidth - real*8 q(0:3),k(0:3),dp1(0:3),dp2(0:3),dp3(0:3),dp4(0:3), - & dgwwa2,dgwwz2,dgw2,dmz,dwidth,s,t,das,dat -c - real*8 r_zero, r_one, r_two - parameter( r_zero=0.0d0, r_one=1.0d0, r_two=2.0d0 ) -c - pwm1(0)=dble( wm1(5)) - pwm1(1)=dble( wm1(6)) - pwm1(2)=dimag(wm1(6)) - pwm1(3)=dimag(wm1(5)) - pwp1(0)=dble( wp1(5)) - pwp1(1)=dble( wp1(6)) - pwp1(2)=dimag(wp1(6)) - pwp1(3)=dimag(wp1(5)) - pwm2(0)=dble( wm2(5)) - pwm2(1)=dble( wm2(6)) - pwm2(2)=dimag(wm2(6)) - pwm2(3)=dimag(wm2(5)) - pwp2(0)=dble( wp2(5)) - pwp2(1)=dble( wp2(6)) - pwp2(2)=dimag(wp2(6)) - pwp2(3)=dimag(wp2(5)) -c - dv1(0)=dcmplx(wm1(1)) - dv1(1)=dcmplx(wm1(2)) - dv1(2)=dcmplx(wm1(3)) - dv1(3)=dcmplx(wm1(4)) - dp1(0)=dble(pwm1(0)) - dp1(1)=dble(pwm1(1)) - dp1(2)=dble(pwm1(2)) - dp1(3)=dble(pwm1(3)) - dv2(0)=dcmplx(wp1(1)) - dv2(1)=dcmplx(wp1(2)) - dv2(2)=dcmplx(wp1(3)) - dv2(3)=dcmplx(wp1(4)) - dp2(0)=dble(pwp1(0)) - dp2(1)=dble(pwp1(1)) - dp2(2)=dble(pwp1(2)) - dp2(3)=dble(pwp1(3)) - dv3(0)=dcmplx(wm2(1)) - dv3(1)=dcmplx(wm2(2)) - dv3(2)=dcmplx(wm2(3)) - dv3(3)=dcmplx(wm2(4)) - dp3(0)=dble(pwm2(0)) - dp3(1)=dble(pwm2(1)) - dp3(2)=dble(pwm2(2)) - dp3(3)=dble(pwm2(3)) - dv4(0)=dcmplx(wp2(1)) - dv4(1)=dcmplx(wp2(2)) - dv4(2)=dcmplx(wp2(3)) - dv4(3)=dcmplx(wp2(4)) - dp4(0)=dble(pwp2(0)) - dp4(1)=dble(pwp2(1)) - dp4(2)=dble(pwp2(2)) - dp4(3)=dble(pwp2(3)) - dgwwa2=dble(gwwa)**2 - dgwwz2=dble(gwwz)**2 - dgw2 =dgwwa2+dgwwz2 - dmz =dble(zmass) - dwidth=dble(zwidth) -c - v12= dv1(0)*dv2(0)-dv1(1)*dv2(1)-dv1(2)*dv2(2)-dv1(3)*dv2(3) - v13= dv1(0)*dv3(0)-dv1(1)*dv3(1)-dv1(2)*dv3(2)-dv1(3)*dv3(3) - v14= dv1(0)*dv4(0)-dv1(1)*dv4(1)-dv1(2)*dv4(2)-dv1(3)*dv4(3) - v23= dv2(0)*dv3(0)-dv2(1)*dv3(1)-dv2(2)*dv3(2)-dv2(3)*dv3(3) - v24= dv2(0)*dv4(0)-dv2(1)*dv4(1)-dv2(2)*dv4(2)-dv2(3)*dv4(3) - v34= dv3(0)*dv4(0)-dv3(1)*dv4(1)-dv3(2)*dv4(2)-dv3(3)*dv4(3) -c - q(0)=dp1(0)+dp2(0) - q(1)=dp1(1)+dp2(1) - q(2)=dp1(2)+dp2(2) - q(3)=dp1(3)+dp2(3) - k(0)=dp1(0)+dp4(0) - k(1)=dp1(1)+dp4(1) - k(2)=dp1(2)+dp4(2) - k(3)=dp1(3)+dp4(3) -c - s=q(0)**2-q(1)**2-q(2)**2-q(3)**2 - t=k(0)**2-k(1)**2-k(2)**2-k(3)**2 -c - das=-r_one/s - dat=-r_one/t - dzs=-r_one/dcmplx( s-dmz**2 , dmax1(dsign(dmz*dwidth,s),r_zero) ) - dzt=-r_one/dcmplx( t-dmz**2 , dmax1(dsign(dmz*dwidth,t),r_zero) ) -c - sv1= (dp2(0)+q(0))*dv1(0) -(dp2(1)+q(1))*dv1(1) - & -(dp2(2)+q(2))*dv1(2) -(dp2(3)+q(3))*dv1(3) - sv2=-(dp1(0)+q(0))*dv2(0) +(dp1(1)+q(1))*dv2(1) - & +(dp1(2)+q(2))*dv2(2) +(dp1(3)+q(3))*dv2(3) - sv3= (dp4(0)-q(0))*dv3(0) -(dp4(1)-q(1))*dv3(1) - & -(dp4(2)-q(2))*dv3(2) -(dp4(3)-q(3))*dv3(3) - sv4=-(dp3(0)-q(0))*dv4(0) +(dp3(1)-q(1))*dv4(1) - & +(dp3(2)-q(2))*dv4(2) +(dp3(3)-q(3))*dv4(3) -c - tv1= (dp4(0)+k(0))*dv1(0) -(dp4(1)+k(1))*dv1(1) - & -(dp4(2)+k(2))*dv1(2) -(dp4(3)+k(3))*dv1(3) - tv2=-(dp3(0)-k(0))*dv2(0) +(dp3(1)-k(1))*dv2(1) - & +(dp3(2)-k(2))*dv2(2) +(dp3(3)-k(3))*dv2(3) - tv3= (dp2(0)-k(0))*dv3(0) -(dp2(1)-k(1))*dv3(1) - & -(dp2(2)-k(2))*dv3(2) -(dp2(3)-k(3))*dv3(3) - tv4=-(dp1(0)+k(0))*dv4(0) +(dp1(1)+k(1))*dv4(1) - & +(dp1(2)+k(2))*dv4(2) +(dp1(3)+k(3))*dv4(3) -c - j12(0)=(dp1(0)-dp2(0))*v12 +sv1*dv2(0) +sv2*dv1(0) - j12(1)=(dp1(1)-dp2(1))*v12 +sv1*dv2(1) +sv2*dv1(1) - j12(2)=(dp1(2)-dp2(2))*v12 +sv1*dv2(2) +sv2*dv1(2) - j12(3)=(dp1(3)-dp2(3))*v12 +sv1*dv2(3) +sv2*dv1(3) - j34(0)=(dp3(0)-dp4(0))*v34 +sv3*dv4(0) +sv4*dv3(0) - j34(1)=(dp3(1)-dp4(1))*v34 +sv3*dv4(1) +sv4*dv3(1) - j34(2)=(dp3(2)-dp4(2))*v34 +sv3*dv4(2) +sv4*dv3(2) - j34(3)=(dp3(3)-dp4(3))*v34 +sv3*dv4(3) +sv4*dv3(3) -c - j14(0)=(dp1(0)-dp4(0))*v14 +tv1*dv4(0) +tv4*dv1(0) - j14(1)=(dp1(1)-dp4(1))*v14 +tv1*dv4(1) +tv4*dv1(1) - j14(2)=(dp1(2)-dp4(2))*v14 +tv1*dv4(2) +tv4*dv1(2) - j14(3)=(dp1(3)-dp4(3))*v14 +tv1*dv4(3) +tv4*dv1(3) - j32(0)=(dp3(0)-dp2(0))*v23 +tv3*dv2(0) +tv2*dv3(0) - j32(1)=(dp3(1)-dp2(1))*v23 +tv3*dv2(1) +tv2*dv3(1) - j32(2)=(dp3(2)-dp2(2))*v23 +tv3*dv2(2) +tv2*dv3(2) - j32(3)=(dp3(3)-dp2(3))*v23 +tv3*dv2(3) +tv2*dv3(3) -c - js12=q(0)*j12(0)-q(1)*j12(1)-q(2)*j12(2)-q(3)*j12(3) - js34=q(0)*j34(0)-q(1)*j34(1)-q(2)*j34(2)-q(3)*j34(3) - js14=k(0)*j14(0)-k(1)*j14(1)-k(2)*j14(2)-k(3)*j14(3) - js32=k(0)*j32(0)-k(1)*j32(1)-k(2)*j32(2)-k(3)*j32(3) -c - js=j12(0)*j34(0)-j12(1)*j34(1)-j12(2)*j34(2)-j12(3)*j34(3) - jt=j14(0)*j32(0)-j14(1)*j32(1)-j14(2)*j32(2)-j14(3)*j32(3) -c - dvertx = (v12*v34 +v14*v23 -r_two*v13*v24)*dgw2 - -c & +(dzs*dgwwz2+das*dgwwa2)*js -dzs*dgwwz2*js12*js34/dmz**2 -c & +(dzt*dgwwz2+dat*dgwwa2)*jt -dzt*dgwwz2*js14*js32/dmz**2 -c - vertex = -dcmplx( dvertx ) -c - return - end subroutine - end module dhelas95 Index: branches/ohl/omega-development/completed/whizard2/tests/MSSM/Makefile.in =================================================================== --- branches/ohl/omega-development/completed/whizard2/tests/MSSM/Makefile.in (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/tests/MSSM/Makefile.in (revision 8703) @@ -1,799 +0,0 @@ -# $Id$ -# -# Copyright (C) 1999-2009 by -# -# Wolfgang Kilian -# Thorsten Ohl -# Juergen Reuter -# -# WHIZARD is free software; you can redistribute it and/or modify it -# under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2, or (at your option) -# any later version. -# -# WHIZARD is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -# -######################################################################## - -N = 100 -TOLERANCE = 1000000 - -prefix = @prefix@ -srcdir = @srcdir@ -top_srcdir = @top_srcdir@ - -### host = @host@ -build_bindir = $(top_srcdir)/bin -build_libdir = $(top_srcdir)/lib -build_srcdir = $(top_srcdir)/tests/MSSM -build_tooldir = $(top_srcdir)/tools - -OMEGA_QED = $(build_bindir)/f90_QED.opt -OMEGA_SM = $(build_bindir)/f90_MSSM.opt - -OFLAGS = -old-interface \ - -target:function $(@:_module.f95=) \ - -target:module $(@:.f95=) \ - -target:parameter_module omega_parameters_mssm_4 - -FC = @FC@ -FC_OPT = @FC_OPT@ -FC_PROF = @FC_PROF@ -FC_EXT = @FC_EXT@ -FC_PURE = @FC_PURE@ -FC_VENDOR = @FC_VENDOR@ -FC_DUSTY = -FI -# FC_DUSTY = @FC_DUSTY@ -FC_WIDE = @FC_WIDE@ -FC_FLAGS = $(FC_OPT) -I$(build_libdir) - -ifeq ($(FC_PURE), yes) -FC_FILTER = $(CPIF) -else -FC_FILTER = \ - sed -e '/^[ ]*elemental[ ]/s/elemental[ ]//' \ - -e '/^[ ]*pure[ ]/s/pure[ ]//' | $(CPIF) -endif - -RANLIB = @RANLIB@ -CPIF = @CPIF@ - -HELAS = dhelas95 - -MADGRAPH = @MADGRAPH@ -MG_QED = echo 0; echo; echo; echo -MG_SM = echo 0; echo yes; echo; echo - -RUN_MADGRAPH = $(top_srcdir)/$(MADGRAPH); rm $(@:.f95=.ps); mv $(@:.f95=.f) $@ - -LIBS = $(build_libdir)/libomega95.a $(build_libdir)/libomega95_tools.a - -FC_LIB_FLAGS = -L$(build_libdir) -lomega95_tools -lomega95 -L. -l$(HELAS) - -OMEGA_SRC4 = \ - odbd_wpwm_module.f95 \ - obbb_wpwm_module.f95 ozz_hh_module.f95 \ - oepem_wpwm_module.f95 owpwm_wpwm_module.f95 \ - owpwm_zz_module.f95 owpwm_za_module.f95 owpwm_aa_module.f95 \ - oepem_epem_module.f95 oepem_veve_module.f95 \ - oudb_udb_module.f95 oepem_mumu_module.f95 \ - oemem_emem_module.f95 oema_ema_module.f95 \ - oaa_epem_module.f95 oza_epem_module.f95 \ - oza_uub_module.f95 oza_ddb_module.f95 \ - ozz_epem_module.f95 ozz_veve_module.f95 \ - oepem_aa_module.f95 oepem_za_module.f95 oepem_zz_module.f95 - -OMEGA_SRC5 = \ - oepem_epema_module.f95 oemem_emema_module.f95 \ - oepem_aaa_module.f95 oepem_zaa_module.f95 \ - oemep_emvewp_module.f95 \ - oepem_wpwmz_module.f95 oepem_wpwma_module.f95 - -OMEGA_SRC6 = \ - oepem_muvmtavt_module.f95 oepem_epveemve_module.f95 \ - oepem_mumuaa_module.f95 oepem_epemaa_module.f95 \ - omuem_muemaa_module.f95 oemem_ememaa_module.f95 \ - oepem_aaaa_module.f95 oepem_epemepem_module.f95 \ - oemep_emvewpa_module.f95 oemep_vevewpwm_module.f95 \ - oemep_emepwpwm_module.f95 owpwm_uubssb_module.f95 \ - oepem_vevebbb_module.f95 - -OMEGA_SRC7 = \ - oepem_muvmtavta_module.f95 oemep_emveudba_module.f95 \ - oepem_aaaaa_module.f95 oepem_epemaaa_module.f95 \ - oepem_epemepema_module.f95 oaa_epemaaa_module.f95 \ - oaa_epemmumua_module.f95 oaa_epemepema_module.f95 \ - oepem_veveuubz_module.f95 - -OMEGA_SRC8 = \ - oepem_muvmtavtaa_module.f95 oepem_epemaaaa_module.f95 \ - oepem_mumutatauub_module.f95 oepem_muvmtavtuub_module.f95 \ - oepem_vevemuvmudb_module.f95 - -OMEGA_SRCX = \ - oepem_wpwmaa_module.f95 \ - oepem_muvmtavtaa_module.f95 \ - owpwm_zaa_module.f95 owpwm_aaa_module.f95 owpwm_wpwma_module.f95 \ - oepem_epvebbbdub_module.f95 - -# OMEGA_SRCT = \ -# single_top_module.f95 \ -# single_top_fudged_module.f95 \ -# single_top_constant_module.f95 - -OMEGA_SRCT = oepem_wpwm_module.f95 - -OMEGA_SRC = \ - $(OMEGA_SRC4) $(OMEGA_SRC5) $(OMEGA_SRC6) \ - $(OMEGA_SRC7) $(OMEGA_SRC8) $(OMEGA_SRCX) - -MADGRAPH_SRC4 = $(patsubst o%_module.f95,%.f95, $(OMEGA_SRC4)) -MADGRAPH_SRC5 = $(patsubst o%_module.f95,%.f95, $(OMEGA_SRC5)) -MADGRAPH_SRC6 = $(patsubst o%_module.f95,%.f95, $(OMEGA_SRC6)) -MADGRAPH_SRC7 = $(patsubst o%_module.f95,%.f95, $(OMEGA_SRC7)) -MADGRAPH_SRC8 = $(patsubst o%_module.f95,%.f95, $(OMEGA_SRC8)) -MADGRAPH_SRCX = $(patsubst o%_module.f95,%.f95, $(OMEGA_SRCX)) -MADGRAPH_SRC = $(patsubst o%_module.f95,%.f95, $(OMEGA_SRC)) - -OMEGA_OBJ4 = $(OMEGA_SRC4:.f95=.o) -OMEGA_OBJ5 = $(OMEGA_SRC5:.f95=.o) -OMEGA_OBJ6 = $(OMEGA_SRC6:.f95=.o) -OMEGA_OBJ7 = $(OMEGA_SRC7:.f95=.o) -OMEGA_OBJ8 = $(OMEGA_SRC8:.f95=.o) -OMEGA_OBJX = $(OMEGA_SRCX:.f95=.o) -OMEGA_OBJ = $(OMEGA_SRC:.f95=.o) - -OMEGA_OBJT = $(OMEGA_SRCT:.f95=.o) - -all: main4 main5 main6 main7 main8 mainx - -runall: run4 run5 run6 run7 run8 runx - -run%: main% - echo N = $(N), TOLERANCE = $(TOLERANCE) | ./$< - -######################################################################## - -OBJS4 = madgraph4.o $(OMEGA_OBJ4) omega_amplitudes4.o -OBJS5 = madgraph5.o $(OMEGA_OBJ5) omega_amplitudes5.o -OBJS6 = madgraph6.o $(OMEGA_OBJ6) omega_amplitudes6.o -OBJS7 = madgraph7.o $(OMEGA_OBJ7) omega_amplitudes7.o -OBJS8 = madgraph8.o $(OMEGA_OBJ8) omega_amplitudes8.o -OBJSX = madgraphx.o $(OMEGA_OBJX) omega_amplitudesx.o -OBJST = $(OMEGA_OBJT) omega_amplitudest.o - -######################################################################## -# There are no Modula(n) sources here ... -%.o: %.mod -######################################################################## - -$(build_srcdir)/%.$(FC_EXT): %.f95 - cat $< | $(FC_FILTER) $(build_srcdir)/$*.$(FC_EXT) - -%.o: $(build_srcdir)/%.$(FC_EXT) parameters.MSSM_4.omega.o - $(FC) $(FC_FLAGS) -c -o $@ $< - -%_p.o: $(build_srcdir)/%.$(FC_EXT) parameters.MSSM_4.omega.o - $(FC) $(FC_FLAGS) $(FC_PROF) -c -o $@ $< - -######################################################################## - -main4: main4.o $(LIBS) - $(FC) $(FC_FLAGS) -o $@ parameters.MSSM_4.omega.o $(OBJS4) \ - main4.o $(FC_LIB_FLAGS) - -main5: main5.o $(LIBS) - $(FC) $(FC_FLAGS) -o $@ $(OBJS5) main5.o $(FC_LIB_FLAGS) - -main6: main6.o $(LIBS) - $(FC) $(FC_FLAGS) -o $@ $(OBJS6) main6.o $(FC_LIB_FLAGS) - -main7: main7.o $(LIBS) - $(FC) $(FC_FLAGS) -o $@ $(OBJS7) main7.o $(FC_LIB_FLAGS) - -main8: main8.o $(LIBS) - $(FC) $(FC_FLAGS) -o $@ $(OBJS8) main8.o $(FC_LIB_FLAGS) - -mainx: mainx.o $(LIBS) - $(FC) $(FC_FLAGS) -o $@ $(OBJSX) mainx.o $(FC_LIB_FLAGS) - -maint: maint.o $(LIBS) - $(FC) $(FC_FLAGS) -o $@ $(OBJST) maint.o $(FC_LIB_FLAGS) - -madgraph4.o: $(build_srcdir)/madgraph4.$(FC_EXT) lib$(HELAS).a - $(FC) $(FC_DUSTY) $(FC_FLAGS) $(FC_WIDE) -c -o $@ $< - -madgraph5.o: $(build_srcdir)/madgraph5.$(FC_EXT) lib$(HELAS).a - $(FC) $(FC_DUSTY) $(FC_FLAGS) $(FC_WIDE) -c -o $@ $< - -madgraph6.o: $(build_srcdir)/madgraph6.$(FC_EXT) lib$(HELAS).a - $(FC) $(FC_DUSTY) $(FC_FLAGS) $(FC_WIDE) -c -o $@ $< - -madgraph7.o: $(build_srcdir)/madgraph7.$(FC_EXT) lib$(HELAS).a - $(FC) $(FC_DUSTY) $(FC_FLAGS) $(FC_WIDE) -c -o $@ $< - -madgraph8.o: $(build_srcdir)/madgraph8.$(FC_EXT) lib$(HELAS).a - $(FC) $(FC_DUSTY) $(FC_FLAGS) $(FC_WIDE) -c -o $@ $< - -madgraphx.o: $(build_srcdir)/madgraphx.$(FC_EXT) lib$(HELAS).a - $(FC) $(FC_DUSTY) $(FC_FLAGS) $(FC_WIDE) -c -o $@ $< - -######################################################################## -# -# 4 external lines: -# -######################################################################## - -ozz_hh_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "Z Z -> H H" >$@ - -odbd_wpwm_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "dbar d -> W+ W-" >$@ - -obbb_wpwm_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "bbar b -> W+ W-" >$@ - -owpwm_aa_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "W+ W- -> A A" >$@ - -owpwm_za_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "W+ W- -> Z A" >$@ - -owpwm_zz_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "W+ W- -> Z Z" >$@ - -owpwm_wpwm_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "W+ W- -> W+ W-" >$@ - -oepem_wpwm_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> W+ W-" >$@ - -oepem_epem_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> e+ e-" >$@ - -oepem_veve_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> nue nuebar" >$@ - -oudb_udb_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "u dbar -> u dbar" >$@ - -oepem_mumu_module.f95: $(OMEGA_QED) - $(OMEGA_QED) $(OFLAGS) -scatter "e+ e- -> m+ m-" >$@ - -oepem_aa_module.f95: $(OMEGA_QED) - $(OMEGA_QED) $(OFLAGS) -scatter "e+ e- -> A A" >$@ - -oepem_za_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> Z A" >$@ - -oepem_zz_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> Z Z" >$@ - -oaa_epem_module.f95: $(OMEGA_QED) - $(OMEGA_QED) $(OFLAGS) -scatter "A A -> e+ e-" >$@ - -oza_epem_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "Z A -> e+ e-" >$@ - -ozz_epem_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "Z Z -> e+ e-" >$@ - -ozz_veve_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "Z Z -> nue nuebar" >$@ - -oza_uub_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "Z A -> u ubar" >$@ - -oza_ddb_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "Z A -> d dbar" >$@ - -oemem_emem_module.f95: $(OMEGA_QED) - $(OMEGA_QED) $(OFLAGS) -scatter "e- e- -> e- e-" >$@ - -oema_ema_module.f95: $(OMEGA_QED) - $(OMEGA_QED) $(OFLAGS) -scatter "e- A -> e- A" >$@ - -ifneq ($(MADGRAPH),false) - -zz_hh.f95: - (echo "z z -> h h"; $(MG_SM)) | $(RUN_MADGRAPH) - -dbd_wpwm.f95: - (echo "d~ d -> w+ w-"; $(MG_SM)) | $(RUN_MADGRAPH) - -bbb_wpwm.f95: - (echo "b~ b -> w+ w-"; $(MG_SM)) | $(RUN_MADGRAPH) - -wpwm_wpwm.f95: - (echo "w+ w- -> w+ w-"; $(MG_SM)) | $(RUN_MADGRAPH) - -wpwm_aa.f95: - (echo "w+ w- -> a a"; $(MG_SM)) | $(RUN_MADGRAPH) - -wpwm_za.f95: - (echo "w+ w- -> z a"; $(MG_SM)) | $(RUN_MADGRAPH) - -wpwm_zz.f95: - (echo "w+ w- -> z z"; $(MG_SM)) | $(RUN_MADGRAPH) - -epem_wpwm.f95: - (echo "e+ e- -> w+ w-"; $(MG_SM)) | $(RUN_MADGRAPH) - -epem_epem.f95: - (echo "e+ e- -> e+ e-"; $(MG_SM)) | $(RUN_MADGRAPH) - -udb_udb.f95: - (echo "u d~ -> u d~"; $(MG_SM)) | $(RUN_MADGRAPH) - -epem_veve.f95: - (echo "e+ e- -> ve ve~"; $(MG_SM)) | $(RUN_MADGRAPH) - -epem_mumu.f95: - (echo "e+ e- -> mu+ mu-"; $(MG_QED)) | $(RUN_MADGRAPH) - -epem_aa.f95: - (echo "e+ e- -> a a"; $(MG_QED)) | $(RUN_MADGRAPH) - -epem_za.f95: - (echo "e+ e- -> z a"; $(MG_SM)) | $(RUN_MADGRAPH) - -epem_zz.f95: - (echo "e+ e- -> z z"; $(MG_SM)) | $(RUN_MADGRAPH) - -aa_epem.f95: - (echo "a a -> e+ e-"; $(MG_QED)) | $(RUN_MADGRAPH) - -za_epem.f95: - (echo "z a -> e+ e-"; $(MG_SM)) | $(RUN_MADGRAPH) - -za_uub.f95: - (echo "z a -> u u~"; $(MG_SM)) | $(RUN_MADGRAPH) - -za_ddb.f95: - (echo "z a -> d d~"; $(MG_SM)) | $(RUN_MADGRAPH) - -zz_epem.f95: - (echo "z z -> e+ e-"; $(MG_SM)) | $(RUN_MADGRAPH) - -zz_veve.f95: - (echo "z z -> ve ve~"; $(MG_SM)) | $(RUN_MADGRAPH) - -emem_emem.f95: - (echo "e- e- -> e- e-"; $(MG_QED)) | $(RUN_MADGRAPH) - -ema_ema.f95: - (echo "e- a -> e- a"; $(MG_QED)) | $(RUN_MADGRAPH) - -endif - -######################################################################## -# -# 5 external lines: -# -######################################################################## - -owpwm_zaa_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "W+ W- -> Z A A" >$@ - -owpwm_wpwma_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "W+ W- -> W+ W- A" >$@ - -owpwm_aaa_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "W+ W- -> A A A" >$@ - -oemep_emvewp_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "e- e+ -> e- nuebar W+" >$@ - -oepem_epema_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> e+ e- A" >$@ - -oemem_emema_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "e- e- -> e- e- A" >$@ - -oepem_aaa_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> A A A" >$@ - -oepem_zaa_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> Z A A" >$@ - -oepem_wpwmz_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> W+ W- Z" >$@ - -oepem_wpwma_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> W+ W- A" >$@ - -ifneq ($(MADGRAPH),false) - -wpwm_zaa.f95: - (echo "w+ w- -> z a a"; $(MG_SM)) | $(RUN_MADGRAPH) - -wpwm_wpwma.f95: - (echo "w+ w- -> w+ w- a"; $(MG_SM)) | $(RUN_MADGRAPH) - -wpwm_aaa.f95: - (echo "w+ w- -> a a a"; $(MG_SM)) | $(RUN_MADGRAPH) - -emep_emvewp.f95: - (echo "e- e+ -> e- ve~ w+"; $(MG_SM)) | $(RUN_MADGRAPH) - -epem_epema.f95: - (echo "e+ e- -> e+ e- a"; $(MG_SM)) | $(RUN_MADGRAPH) - -emem_emema.f95: - (echo "e- e- -> e- e- a"; $(MG_SM)) | $(RUN_MADGRAPH) - -epem_aaa.f95: - (echo "e+ e- -> a a a"; $(MG_SM)) | $(RUN_MADGRAPH) - -epem_zaa.f95: - (echo "e+ e- -> z a a"; $(MG_SM)) | $(RUN_MADGRAPH) - -epem_wpwmz.f95: - (echo "e+ e- -> w+ w- z"; $(MG_SM)) | $(RUN_MADGRAPH) - -epem_wpwma.f95: - (echo "e+ e- -> w+ w- a"; $(MG_SM)) | $(RUN_MADGRAPH) - -endif - -######################################################################## -# -# 6 external lines: -# -######################################################################## - -oemep_emvewpa_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "e- e+ -> e- nuebar W+ A" >$@ - -owpwm_uubssb_module.f95: - $(OMEGA_SM) $(OFLAGS) \ - -target:function $(@:_module.f95=) -target:module $(@:.f95=) \ - -scatter "W+ W- -> u ubar s sbar" | \ - sed '/! CAVEAT: color factor not known!/s||amp = amp * sqrt (9.0_default / 1.0_default) ! CAVEAT: naive color factor|' >$@ - -oemep_vevewpwm_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "e- e+ -> nue nuebar W+ W-" >$@ - -oemep_emepwpwm_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "e- e+ -> e- e+ W+ W-" >$@ - -oepem_muvmtavt_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> mu- numubar tau+ nutau" >$@ - -oepem_epveemve_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> e+ nue e- nuebar" >$@ - -oepem_mumuaa_module.f95: $(OMEGA_QED) - $(OMEGA_QED) $(OFLAGS) -scatter "e+ e- -> m+ m- A A" >$@ - -oepem_epemaa_module.f95: $(OMEGA_QED) - $(OMEGA_QED) $(OFLAGS) -scatter "e+ e- -> e+ e- A A" >$@ - -omuem_muemaa_module.f95: $(OMEGA_QED) - $(OMEGA_QED) $(OFLAGS) -scatter "m- e- -> m- e- A A" >$@ - -oemem_ememaa_module.f95: $(OMEGA_QED) - $(OMEGA_QED) $(OFLAGS) -scatter "e- e- -> e- e- A A" >$@ - -oepem_aaaa_module.f95: $(OMEGA_QED) - $(OMEGA_QED) $(OFLAGS) -scatter "e+ e- -> A A A A" >$@ - -oepem_epemepem_module.f95: $(OMEGA_QED) - $(OMEGA_QED) $(OFLAGS) -scatter "e+ e- -> e+ e- e+ e-" >$@ - -oepem_wpwmaa_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> W+ W- A A" >$@ - -oepem_vevebbb_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> nue nuebar b bbar" >$@ - -ifneq ($(MADGRAPH),false) - -wpwm_uubssb.f95: - (echo "w+ w- -> u u~ s s~"; $(MG_SM)) | $(RUN_MADGRAPH) - -emep_vevewpwm.f95: - (echo "e- e+ -> ve ve~ w+ w-"; $(MG_SM)) | $(RUN_MADGRAPH) - -emep_emepwpwm.f95: - (echo "e- e+ -> e- e+ w+ w-"; $(MG_SM)) | $(RUN_MADGRAPH) - -emep_emvewpa.f95: - (echo "e- e+ -> e- ve~ w+ a"; $(MG_SM)) | $(RUN_MADGRAPH) - -epem_muvmtavt.f95: - (echo "e+ e- -> mu- vm~ ta+ vt"; $(MG_SM)) | $(RUN_MADGRAPH) - -epem_epveemve.f95: - (echo "e+ e- -> e+ ve e- ve~"; $(MG_SM)) | $(RUN_MADGRAPH) - -epem_mumuaa.f95: - (echo "e+ e- -> mu+ mu- a a"; $(MG_QED)) | $(RUN_MADGRAPH) - -epem_epemaa.f95: - (echo "e+ e- -> e+ e- a a"; $(MG_QED)) | $(RUN_MADGRAPH) - -muem_muemaa.f95: - (echo "mu- e- -> mu- e- a a"; $(MG_QED)) | $(RUN_MADGRAPH) - -emem_ememaa.f95: - (echo "e- e- -> e- e- a a"; $(MG_QED)) | $(RUN_MADGRAPH) - -epem_aaaa.f95: - (echo "e+ e- -> a a a a"; $(MG_QED)) | $(RUN_MADGRAPH) - -epem_epemepem.f95: - (echo "e+ e- -> e+ e- e+ e-"; $(MG_QED)) | $(RUN_MADGRAPH) - -epem_wpwmaa.f95: - (echo "e+ e- -> w+ w- a a"; $(MG_SM)) | $(RUN_MADGRAPH) - -epem_vevebbb.f95: - (echo "e+ e- -> ve ve~ b b~"; $(MG_SM)) | $(RUN_MADGRAPH) - -endif - -######################################################################## -# -# 7 external lines: -# -######################################################################## - -oemep_emveudba_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) e- e+ e- nuebar u dbar A >$@ - -oepem_veveuubz_module.f95: - $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> nue nuebar u ubar Z" >$@ - -oepem_muvmtavta_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> mu- numubar tau+ nutau A" >$@ - -oepem_epemepema_module.f95: $(OMEGA_QED) - $(OMEGA_QED) $(OFLAGS) -scatter "e+ e- -> e+ e- e+ e- A" >$@ - -oepem_epemaaa_module.f95: $(OMEGA_QED) - $(OMEGA_QED) $(OFLAGS) -scatter "e+ e- -> e+ e- A A A" >$@ - -oepem_aaaaa_module.f95: $(OMEGA_QED) - $(OMEGA_QED) $(OFLAGS) -scatter "e+ e- -> A A A A A" >$@ - -oaa_epemaaa_module.f95: $(OMEGA_QED) - $(OMEGA_QED) $(OFLAGS) -scatter "A A -> e+ e- A A A" >$@ - -oaa_epemmumua_module.f95: $(OMEGA_QED) - $(OMEGA_QED) $(OFLAGS) -scatter "A A -> e+ e- m+ m- A" >$@ - -oaa_epemepema_module.f95: $(OMEGA_QED) - $(OMEGA_QED) $(OFLAGS) -scatter "A A -> e+ e- e+ e- A" >$@ - -ifneq ($(MADGRAPH),false) - -epem_veveuubz.f95: - (echo "e+ e- -> ve ve~ u u~ Z"; $(MG_SM)) | $(RUN_MADGRAPH) - -emep_emveudba.f95: - (echo "e- e+ -> e- ve~ u d~ a"; $(MG_SM)) | $(RUN_MADGRAPH) - -epem_muvmtavta.f95: - (echo "e+ e- -> mu- vm~ ta+ vt a"; $(MG_SM)) | $(RUN_MADGRAPH) - -epem_epemaaa.f95: - (echo "e+ e- -> e+ e- a a a"; $(MG_QED)) | $(RUN_MADGRAPH) - -epem_epemepema.f95: - (echo "e+ e- -> e+ e- e+ e- a"; $(MG_QED)) | $(RUN_MADGRAPH) - -epem_aaaaa.f95: - (echo "e+ e- -> a a a a a"; $(MG_QED)) | $(RUN_MADGRAPH) - -aa_epemaaa.f95: - (echo "a a -> e+ e- a a a"; $(MG_QED)) | $(RUN_MADGRAPH) - -aa_epemmumua.f95: - (echo "a a -> e+ e- mu+ mu- a"; $(MG_QED)) | $(RUN_MADGRAPH) - -aa_epemepema.f95: - (echo "a a -> e+ e- e+ e- a"; $(MG_QED)) | $(RUN_MADGRAPH) - -endif - -######################################################################## -# -# 8 external lines: -# -######################################################################## - -oepem_muvmtavtaa_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> mu- numubar tau+ nutau A A" >$@ - -oepem_epemaaaa_module.f95: $(OMEGA_QED) - $(OMEGA_QED) $(OFLAGS) -scatter "e+ e- -> e+ e- A A A A" >$@ - -oepem_mumutatauub_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> mu+ mu- tau+ tau- u ubar" >$@ - -oepem_muvmtavtuub_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> mu- numubar tau+ nutau u ubar" >$@ - -oepem_vevemuvmudb_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> nue nuebar mu- numubar u dbar" >$@ - -oepem_epvebbbdub_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> e+ nue b bbar d ubar" | \ - sed '/! CAVEAT: color factor not known!/s||amp = amp * sqrt (9.0_default / 1.0_default) ! CAVEAT: naive color factor|' >$@ - -single_top_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> e+ nue b bbar d ubar" >$@ - -single_top_fudged_module.f95: $(OMEGA_SM) - $(OMEGA_SM) -model:fudged_width $(OFLAGS) \ - -scatter "e+ e- -> e+ nue b bbar d ubar" >$@ - -single_top_constant_module.f95: $(OMEGA_SM) - $(OMEGA_SM) -model:constant_width $(OFLAGS) \ - -scatter "e+ e- -> e+ nue b bbar d ubar" >$@ - -ifneq ($(MADGRAPH),false) - -epem_muvmtavtaa.f95: - (echo "e+ e- -> mu- vm~ ta+ vt a a"; $(MG_SM)) | $(RUN_MADGRAPH) - -epem_epemaaaa.f95: - (echo "e+ e- -> e+ e- a a a a"; $(MG_QED)) | $(RUN_MADGRAPH) - -epem_mumutatauub.f95: - (echo "e+ e- -> mu+ mu- ta+ ta- u u~"; $(MG_SM)) | $(RUN_MADGRAPH) - -epem_muvmtavtuub.f95: - (echo "e+ e- -> mu- vm~ ta+ vt u u~"; $(MG_SM)) | $(RUN_MADGRAPH) - -epem_vevemuvmudb.f95: - (echo "e+ e- -> ve ve~ mu- vm~ u d~"; $(MG_SM)) | $(RUN_MADGRAPH) - -epem_epvebbbdub.f95: - (echo "e+ e- -> e+ ve b b~ d u~"; $(MG_SM)) | $(RUN_MADGRAPH) - -endif - -######################################################################## - -lib$(HELAS).a: $(HELAS).o - ar cr $@ $< - -$(HELAS).o: $(build_srcdir)/$(HELAS).$(FC_EXT) - $(FC) $(FC_DUSTY) $(FC_FLAGS) -c -o $@ $< - -clean: - rm -f *.o main[4-9] *~ *.mod *_module* - -purge: purge_omega purge_madlab - -purge_omega: - rm -f $(OMEGA_SRC) - -purge_madlab: - rm -f $(MADGRAPH_SRC) - -compare: - $(MAKE) -n -W $(OMEGA_QED) -W $(OMEGA_SM) \ - | egrep '$(OMEGA_QED)|$(OMEGA_SM)' \ - | sed -e 's/>/>tmp.compare; diff -I"^!" -u /' -e 's/$$/ tmp.compare/' | sh - -MADGRAPH_HEADER = \ - echo " use $(HELAS)"; \ - echo " use omega_parameters_madgraph"; \ - echo " implicit none"; \ - echo " integer,parameter :: D = selected_real_kind(14,100)"; \ - echo " contains"; \ - sed -e 'y/abcdefghijklmnopqrstuvwxyz/ABCDEFGHIJKLMNOPQRSTUVWXYZ/' \ - -e 's/END *$$/END FUNCTION/' \ - -e '/WRITE/s//! WRITE/' \ - -e '/INTERFACE/,/END INTERFACE/s/^/!!! /' \ - -e '/GLOBAL VARIABLES/,/COLOR DATA/s/^/!!! /' - -madgraph4.f95: $(MADGRAPH_SRC4) Makefile - (echo " module madgraph4"; \ - $(MADGRAPH_HEADER) $(MADGRAPH_SRC4); \ - echo " end module madgraph4" ) >$@ - -madgraph5.f95: $(MADGRAPH_SRC5) Makefile - (echo " module madgraph5"; \ - $(MADGRAPH_HEADER) $(MADGRAPH_SRC5); \ - echo " end module madgraph5" ) >$@ - -madgraph6.f95: $(MADGRAPH_SRC6) Makefile - (echo " module madgraph6"; \ - $(MADGRAPH_HEADER) $(MADGRAPH_SRC6); \ - echo " end module madgraph6" ) >$@ - -madgraph7.f95: $(MADGRAPH_SRC7) Makefile - (echo " module madgraph7"; \ - $(MADGRAPH_HEADER) $(MADGRAPH_SRC7); \ - echo " end module madgraph7" ) >$@ - -madgraph8.f95: $(MADGRAPH_SRC8) Makefile - (echo " module madgraph8"; \ - $(MADGRAPH_HEADER) $(MADGRAPH_SRC8); \ - echo " end module madgraph8" ) >$@ - -madgraphx.f95: $(MADGRAPH_SRCX) Makefile - (echo " module madgraphx"; \ - $(MADGRAPH_HEADER) $(MADGRAPH_SRCX); \ - echo " end module madgraphx" ) >$@ - -omega_amplitudes4.f95: Makefile - (echo "module $(@:.f95=)"; \ - for m in $(OMEGA_SRC4:.f95=); do echo " use $$m"; done; \ - echo " public"; \ - echo "end module $(@:.f95=)") >$@ - -omega_amplitudes5.f95: Makefile - (echo "module $(@:.f95=)"; \ - for m in $(OMEGA_SRC5:.f95=); do echo " use $$m"; done; \ - echo " public"; \ - echo "end module $(@:.f95=)") >$@ - -omega_amplitudes6.f95: Makefile - (echo "module $(@:.f95=)"; \ - for m in $(OMEGA_SRC6:.f95=); do echo " use $$m"; done; \ - echo " public"; \ - echo "end module $(@:.f95=)") >$@ - -omega_amplitudes7.f95: Makefile - (echo "module $(@:.f95=)"; \ - for m in $(OMEGA_SRC7:.f95=); do echo " use $$m"; done; \ - echo " public"; \ - echo "end module $(@:.f95=)") >$@ - -omega_amplitudes8.f95: Makefile - (echo "module $(@:.f95=)"; \ - for m in $(OMEGA_SRC8:.f95=); do echo " use $$m"; done; \ - echo " public"; \ - echo "end module $(@:.f95=)") >$@ - -omega_amplitudesx.f95: Makefile - (echo "module $(@:.f95=)"; \ - for m in $(OMEGA_SRCX:.f95=); do echo " use $$m"; done; \ - echo " public"; \ - echo "end module $(@:.f95=)") >$@ - -omega_amplitudest.f95: Makefile - (echo "module $(@:.f95=)"; \ - for m in $(OMEGA_SRCT:.f95=); do echo " use $$m"; done; \ - echo " public"; \ - echo "end module $(@:.f95=)") >$@ - -omega_amplitudes.o: $(OMEGA_OBJ) - -madgraph.o: $(build_srcdir)/kinds.o $(build_srcdir)/omega_parameters_madgraph.o - -main4.o: $(OBJS4) lib$(HELAS).a $(build_libdir)/libomega95.a -main5.o: $(OBJS5) lib$(HELAS).a $(build_libdir)/libomega95.a -main6.o: $(OBJS6) lib$(HELAS).a $(build_libdir)/libomega95.a -main7.o: $(OBJS7) lib$(HELAS).a $(build_libdir)/libomega95.a -main8.o: $(OBJS8) lib$(HELAS).a $(build_libdir)/libomega95.a -mainx.o: $(OBJSX) lib$(HELAS).a $(build_libdir)/libomega95.a -maint.o: $(OBJST) $(build_libdir)/libomega95.a - -######################################################################## - -$(build_libdir)/libomega95.a: - $(MAKE) -C $(build_srcdir) $(build_libdir)/libomega95.a - -$(build_libdir)/libomega95_tools.a: - $(MAKE) -C $(build_tooldir) $(build_libdir)/libomega95_tools.a - -######################################################################## - -parameters.MSSM_4.omega.o: parameters.MSSM_4.omega.f90 - $(FC) $(FC_FLAGS) -c -o $@ $< - -parameters.MSSM_4.omega.f90: $(top_srcdir)/../../conf/models/parameters.MSSM_4.omega.f90 - cp $(top_srcdir)/../../conf/models/parameters.MSSM_4.omega.f90 $(srcdir) \ No newline at end of file Index: branches/ohl/omega-development/completed/whizard2/tests/SM/xsect.f95 =================================================================== --- branches/ohl/omega-development/completed/whizard2/tests/SM/xsect.f95 (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/tests/SM/xsect.f95 (revision 8703) @@ -1,295 +0,0 @@ -! $Id: xsect.f95 170 2000-05-01 23:22:30Z ohl $ - -module gauss - use kinds - implicit none - private - - public :: gauss1 - - real (kind = double), dimension(4), private, parameter :: X_LOW = (/ & - 9.6028985649753623E-01_double, 7.9666647741362674E-01_double, & - 5.2553240991632899E-01_double, 1.8343464249564980E-01_double /) - real (kind = double), dimension(4), private, parameter :: W_LOW = (/ & - 1.0122853629037626E-01_double, 2.2238103445337447E-01_double, & - 3.1370664587788729E-01_double, 3.6268378337836198E-01_double /) - real (kind = double), dimension(8), private, parameter :: X_HIGH = (/ & - 9.8940093499164993E-01_double, 9.4457502307323258E-01_double, & - 8.6563120238783174E-01_double, 7.5540440835500303E-01_double, & - 6.1787624440264375E-01_double, 4.5801677765722739E-01_double, & - 2.8160355077925891E-01_double, 9.5012509837637440E-02_double /) - real (kind = double), dimension(8), private, parameter :: W_HIGH = (/ & - 2.7152459411754095E-02_double, 6.2253523938647893E-02_double, & - 9.5158511682492785E-02_double, 1.2462897125553387E-01_double, & - 1.4959598881657673E-01_double, 1.6915651939500254E-01_double, & - 1.8260341504492359E-01_double, 1.8945061045506850E-01_double /) - -contains - - pure function weighted_sum (f, midpoint, halfwidth, x, w) result (integral) - real (kind = double) :: integral - real (kind = double), intent(in) :: midpoint, halfwidth - real (kind = double), dimension(:), intent(in) :: x, w - interface - pure function f (x) result (fx) - use kinds - implicit none - real (kind = double) :: fx - real (kind = double), intent(in) :: x - end function f - end interface - real (kind = double) :: delta - integer :: i - integral = 0 - do i = 1, size (x) - delta = halfwidth * x(i) - integral = integral + w(i) * (f (midpoint + delta) + f (midpoint - delta)) - end do - integral = halfwidth * integral - end function weighted_sum - - function gauss1 (f, a, b, eps) result (integral) - real (kind = double) :: integral - real (kind = double), intent(in) :: a, b, eps - interface - pure function f (x) result (fx) - use kinds - implicit none - real (kind = double) :: fx - real (kind = double), intent(in) :: x - end function f - end interface - real (kind = double) :: current_a, current_b, midpoint, halfwidth, & - sum_low, sum_high, smallest_interval - smallest_interval = epsilon (200 * (b - a)) - integral = 0 - if (b == a) then - return - end if - current_b = a - DIVISIONS: do - current_a = current_b - current_b = b - SUBDIVIDE: do - midpoint = 0.5_double * (current_b + current_a) - halfwidth = 0.5_double * (current_b - current_a) - sum_low = weighted_sum (f, midpoint, halfwidth, X_LOW, W_LOW) - sum_high = weighted_sum (f, midpoint, halfwidth, X_HIGH, W_HIGH) - if (abs (sum_high - sum_low) <= eps * (1 + abs (sum_high))) then - integral = integral + sum_high - if (current_b == b) then - return - else - cycle DIVISIONS - end if - else if (abs (halfwidth) >= smallest_interval) then - current_b = midpoint - cycle SUBDIVIDE - else - print *, 'gauss: too high accuracy required' - integral = 0 - return - end if - end do SUBDIVIDE - end do DIVISIONS - end function gauss1 - -end module gauss - -module integrands - use kinds - implicit none - private - public :: square, root, sine -contains - pure function square (x) result (x2) - real (kind = double) :: x2 - real (kind = double), intent(in) :: x - x2 = x * x - end function square - pure function root (x) result (rootx) - real (kind = double) :: rootx - real (kind = double), intent(in) :: x - rootx = sqrt (x) - end function root - pure function sine (x) result (sinex) - real (kind = double) :: sinex - real (kind = double), intent(in) :: x - sinex = sin (x) - end function sine -end module integrands - -module differential - use kinds - use omega_constants - use omega_utils - use kinematics - implicit none - private - - public :: dsigma_dcosth, dsigma_dcosth_pol - - ! picobarn - real (kind = default), public, parameter :: & - HBARC2 = 0.38937966E9_default - -contains - - pure function phase_space (roots, p1, p3) result (ps) - real (kind = double) :: ps - real (kind = double), intent(in) :: roots - real (kind = double), dimension(0:), intent(in) :: p1, p3 - ! sqrt ((roots**2 - m(1)**2 - m(2)**2)**2 - 4*(m(1)*m(2))**2) / (2 * roots) - ! sqrt ((roots**2 - m(3)**2 - m(4)**2)**2 - 4*(m(3)*m(4))**2) / (2 * roots) - ps = HBARC2 * sqrt (dot_product (p3(1:), p3(1:)) / dot_product (p1(1:), p1(1:))) & - / (32*PI) / roots**2 - end function phase_space - - pure function dsigma_dcosth (omega, m, roots, costh, states) result (sigma) - real (kind = double) :: sigma - real (kind = double), dimension(:), intent(in) :: m - real (kind = double), intent(in) :: roots, costh - integer, dimension(:), intent(in), optional :: states - interface - pure function omega (k, s) result (amp) - use kinds - implicit none - real(kind=default), dimension(0:,:), intent(in) :: k - integer, dimension(:), intent(in) :: s - complex(kind=default) :: amp - end function omega - end interface - real (kind = double), dimension(0:3,4) :: p - real (kind = double) :: phi - integer, dimension(size(p,dim=2)) :: nstates - if (max (m(1) + m(2), m(3) + m(4)) > roots) then - sigma = 0 - else - if (present (states)) then - nstates = states - else - nstates = 2 - end if - phi = 0 - call beams (roots, m(1), m(2), p(:,1), p(:,2)) - call decay2 (roots, m(3), m(4), costh, phi, p(:,3), p(:,4)) - sigma = phase_space (roots, p(:,1), p(:,3)) * omega_sum (omega, p, states) - end if - end function dsigma_dcosth - - pure function dsigma_dcosth_pol (omega, m, roots, costh, s) result (sigma) - real (kind = double) :: sigma - real (kind = double), dimension(:), intent(in) :: m - real (kind = double), intent(in) :: roots, costh - integer, dimension(:), intent(in) :: s - interface - pure function omega (k, s) result (amp) - use kinds - implicit none - real(kind=default), dimension(0:,:), intent(in) :: k - integer, dimension(:), intent(in) :: s - complex(kind=default) :: amp - end function omega - end interface - real (kind = double), dimension(0:3,4) :: p - real (kind = double) :: phi - complex (kind = double) :: t - if (max (m(1) + m(2), m(3) + m(4)) > roots) then - sigma = 0 - else - phi = 0 - call beams (roots, m(1), m(2), p(:,1), p(:,2)) - call decay2 (roots, m(3), m(4), costh, phi, p(:,3), p(:,4)) - t = omega (p, s) - sigma = phase_space (roots, p(:,1), p(:,3)) * t * conjg (t) - end if - end function dsigma_dcosth_pol - -end module differential - -module omega_cross_sections - use kinds - use omega_amplitudes - use differential - implicit none - private - public :: wpwm, wpwm_pol, zz, zz_pol - ! Global variables to facilitate integration: - real (kind = default), public, save :: roots = 200 - integer, dimension(4), public, save :: spins4 = 0 -contains - function zz (costh) result (sigma) - real (kind = double) :: sigma - real (kind = double), intent(in) :: costh - sigma = dsigma_dcosth (oepem_zz, & - (/ mass(11), mass(11), mass(23), mass(23) /), roots, costh, (/ 2, 2, 3, 3 /)) - end function zz - function zz_pol (costh) result (sigma) - real (kind = double) :: sigma - real (kind = double), intent(in) :: costh - sigma = dsigma_dcosth_pol (oepem_zz, & - (/ mass(11), mass(11), mass(23), mass(23) /), roots, costh, spins4) - end function zz_pol - function wpwm (costh) result (sigma) - real (kind = double) :: sigma - real (kind = double), intent(in) :: costh - sigma = dsigma_dcosth (oepem_wpwm, & - (/ mass(11), mass(11), mass(24), mass(24) /), roots, costh, (/ 2, 2, 3, 3 /)) - end function wpwm - function wpwm_pol (costh) result (sigma) - real (kind = double) :: sigma - real (kind = double), intent(in) :: costh - sigma = dsigma_dcosth_pol (oepem_wpwm, & - (/ mass(11), mass(11), mass(24), mass(24) /), roots, costh, spins4) - end function wpwm_pol -end module omega_cross_sections - -program xsect - use kinds - use omega_constants - use omega_cross_sections - use omega_parameters - use gauss - implicit none - ! real(kind=double) :: a, b, eps, int - ! eps = 1e-6 - ! read *, a, b - ! int = gauss1 (square, a, b, eps) - ! print *, int, (b**3 - a**3) / 3 - ! int = gauss1 (root, a, b, eps) - ! print *, int, (b**1.5_double - a**1.5_double) / 1.5_double - real(kind=double) :: roots_min, roots_max, sigma, eps, theta, costh - real(kind=double), dimension(-1:1,-1:1,-1:1,-1:1) :: sigma_pol - real(kind=double), dimension(-1:1,-1:1) :: sigma_pol2 - ! real(kind=double) :: sigmaz - integer :: i, steps, i1, i2, i3, i4 - eps = 1e-6 - steps = 20 - call setup_parameters () - read *, roots_min, roots_max, theta - costh = cos (PI * theta / 180) - ! qw = 0 - ! igzww = 0 - ! igzww = - igzww - do i = 0, steps - roots = (roots_min * (steps - i) + roots_max * i) / steps - sigma = gauss1 (wpwm, -costh, costh, eps) - ! sigmaz = gauss1 (zz, -costh, costh, eps) - ! print *, roots, sigma, sigmaz - sigma_pol = 0 - sigma_pol2 = 0 - do i1 = -1, 1, 2 - do i2 = -1, 1, 2 - do i3 = -1, 1 - do i4 = -1, 1 - spins4 = (/ i1, i2, i3, i4 /) - sigma_pol(i1,i2,i3,i4) = gauss1 (wpwm_pol, -costh, costh, eps) - sigma_pol2(i3,i4) = sigma_pol2(i3,i4) & - + sigma_pol(i1,i2,i3,i4) / 4 - end do - end do - end do - end do - print *, roots, sigma, sigma_pol2 - end do -end program xsect Index: branches/ohl/omega-development/completed/whizard2/tests/SM/main4.f95 =================================================================== --- branches/ohl/omega-development/completed/whizard2/tests/SM/main4.f95 (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/tests/SM/main4.f95 (revision 8703) @@ -1,166 +0,0 @@ -! $Id: main4.f95,v 1.1 2004/04/09 20:11:17 ohl Exp $ - -program main4 - use kinds - use tao_random_numbers - use testbed_old - use rambo - use omega_amplitudes4 - ! use omega_helas_amplitudes - use madgraph4 - - real(kind=single) :: roots - integer :: n, tolerance - character (len=8) :: mode - - call setup_parameters () - call read_parameters (roots, n, tolerance, mode) - call export_parameters_to_madgraph () - - !!! This fails unless the interferences are switched off - !!! because the color factors are missing - ! call check4_madgraph ("u dbar -> u dbar", n, oudb_udb, sudb_udb, udb_udb, & - ! real (roots, kind=default), (/ mass(2), mass(1), mass(2), mass(1) /), & - ! tolerance = tolerance, mode = mode) - - !!! This fails becasue MADGRAPH is incomplete - ! call check4_madgraph ("Z Z -> H H", n, ozz_hh, szz_hh, zz_hh, & - ! real (roots, kind=default), (/ mass(23), mass(23), mass(25), mass(25) /), & - ! states = (/ 3, 3, 1, 1 /), tolerance = tolerance, mode = mode) - - call check4_madgraph ("b bbar -> W+ W-", n, obbb_wpwm, sbbb_wpwm, bbb_wpwm, & - real (roots, kind=default), (/ mass(5), mass(5), mass(24), mass(24) /), & - states = (/ 2, 2, 3, 3 /), tolerance = tolerance, mode = mode) - - ! call ward4 (n, obbb_wpwm, bbb_wpwm, real (roots, kind=default), & - ! (/ mass(5), mass(5), mass(24), mass(24) /), & - ! 3, states = (/ 2, 2, 3, 3 /), tolerance = tolerance, mode = mode) - ! - ! call ward4 (n, obbb_wpwm, bbb_wpwm, real (roots, kind=default), & - ! (/ mass(5), mass(5), mass(24), mass(24) /), & - ! 4, states = (/ 2, 2, 3, 3 /), tolerance = tolerance, mode = mode) - ! - ! call ward_omega (n, obbb_wpwm, real (roots, kind=default), & - ! (/ mass(5), mass(5), mass(24), mass(24) /), & - ! 3, states = (/ 2, 2, 3, 3 /), tolerance = tolerance, mode = mode) - ! - ! call ward_omega (n, obbb_wpwm, real (roots, kind=default), & - ! (/ mass(5), mass(5), mass(24), mass(24) /), & - ! 4, states = (/ 2, 2, 3, 3 /), tolerance = tolerance, mode = mode) - - call check4_madgraph ("W+ W- -> W+ W-", n, owpwm_wpwm, swpwm_wpwm, wpwm_wpwm, & - real (roots, kind=default), (/ mass(24), mass(24), mass(24), mass(24) /), & - states = (/ 3, 3, 3, 3 /), tolerance = tolerance, mode = mode) - - call check4_madgraph ("W+ W- -> Z Z", n, owpwm_zz, swpwm_zz, wpwm_zz, & - real (roots, kind=default), (/ mass(24), mass(24), mass(23), mass(23) /), & - states = (/ 3, 3, 3, 3 /), tolerance = tolerance, mode = mode) - - call check4_madgraph ("W+ W- -> Z A", n, owpwm_za, swpwm_za, wpwm_za, & - real (roots, kind=default), (/ mass(24), mass(24), mass(23), 0.0_default /), & - states = (/ 3, 3, 3, 2 /), tolerance = tolerance, mode = mode) - - call check4_madgraph ("W+ W- -> A A", n, owpwm_aa, swpwm_aa, wpwm_aa, & - real (roots, kind=default), (/ mass(24), mass(24), 0.0_default, 0.0_default /), & - states = (/ 3, 3, 2, 2 /), tolerance = tolerance, mode = mode) - - call check4_madgraph ("e+ e- -> W+ W-", n, oepem_wpwm, sepem_wpwm, epem_wpwm, & - real (roots, kind=default), (/ mass(11), mass(11), mass(24), mass(24) /), & - states = (/ 2, 2, 3, 3 /), tolerance = tolerance, mode = mode) - - call check4_madgraph ("e+ e- -> e+ e-", n, oepem_epem, sepem_epem, epem_epem, & - real (roots, kind=default), & - (/ mass(11), mass(11), mass(11), mass(11) /), & - tolerance = tolerance, mode = mode) - - call check4_madgraph ("e+ e- -> nue nuebar", n, oepem_veve, sepem_veve, epem_veve, & - real (roots, kind=default), & - (/ mass(11), mass(11), 0.0_default, 0.0_default /), & - tolerance = tolerance, mode = mode) - - call check4_madgraph ("e+ e- -> mu+ mu-", n, oepem_mumu, sepem_mumu, epem_mumu, & - real (roots, kind=default), & - (/ mass(11), mass(11), mass(13), mass(13) /), & - tolerance = tolerance, mode = mode) - - call check4_madgraph ("e- e- -> e- e-", n, oemem_emem, semem_emem, emem_emem, & - real (roots, kind=default), (/ mass(11), mass(11), mass(11), mass(11) /), & - symmetry = reshape ((/ -1, 1, 2, -1, 3, 4 /), (/ 3, 2/)), & - tolerance = tolerance, mode = mode) - - call check4_madgraph ("e- A -> e- A", n, oema_ema, sema_ema, ema_ema, & - real (roots, kind=default), & - (/ mass(11), 0.0_default, mass(11), 0.0_default /), & - tolerance = tolerance, mode = mode) - - ! call ward_omega (n, oema_ema, real (roots, kind=default), & - ! (/ mass(11), 0.0_default, mass(11), 0.0_default /), & - ! 4, tolerance = tolerance, mode = mode) - - call check4_madgraph ("e+ e- -> A A", n, oepem_aa, sepem_aa, epem_aa, & - real (roots, kind=default), (/ mass(11), mass(11), 0.0_default, 0.0_default /), & - symmetry = reshape ((/ 1, 3, 4 /), (/ 3, 1/)), & - tolerance = tolerance, mode = mode) - - ! call ward4 (n, oepem_aa, epem_aa, real (roots, kind=default), & - ! (/ mass(11), mass(11), 0.0_default, 0.0_default /), & - ! 3, tolerance = tolerance, mode = mode) - ! - ! call ward4 (n, oepem_aa, epem_aa, real (roots, kind=default), & - ! (/ mass(11), mass(11), 0.0_default, 0.0_default /), & - ! 4, tolerance = tolerance, mode = mode) - ! - ! call ward_omega (n, oepem_aa, real (roots, kind=default), & - ! (/ mass(11), mass(11), 0.0_default, 0.0_default /), & - ! 3, tolerance = tolerance, mode = mode) - ! - ! call ward_omega (n, oepem_aa, real (roots, kind=default), & - ! (/ mass(11), mass(11), 0.0_default, 0.0_default /), & - ! 4, tolerance = tolerance, mode = mode) - - call check4_madgraph ("e+ e- -> Z A", n, oepem_za, sepem_za, epem_za, & - real (roots, kind=default), (/ mass(11), mass(11), mass(23), 0.0_default /), & - states = (/ 2, 2, 3, 2 /), & - tolerance = tolerance, mode = mode) - - call check4_madgraph ("e+ e- -> Z Z", n, oepem_zz, sepem_zz, epem_zz, & - real (roots, kind=default), & - (/ mass(11), mass(11), mass(23), mass(23) /), states = (/ 2, 2, 3, 3 /), & - symmetry = reshape ((/ 1, 3, 4 /), (/ 3, 1/)), & - tolerance = tolerance, mode = mode) - - call check4_madgraph ("A A -> e+ e-", n, oaa_epem, saa_epem, aa_epem, & - real (roots, kind=default), & - (/ 0.0_default, 0.0_default, mass(11), mass(11) /), & - symmetry = reshape ((/ 1, 1, 2 /), (/ 3, 1/)), & - tolerance = tolerance, mode = mode) - - call check4_madgraph ("Z A -> e+ e-", n, oza_epem, sza_epem, za_epem, & - real (roots, kind=default), & - (/ mass(23), 0.0_default, mass(11), mass(11) /), states = (/ 3, 2, 2, 2 /), & - tolerance = tolerance, mode = mode) - - call check4_madgraph ("Z Z -> e+ e-", n, ozz_epem, szz_epem, zz_epem, & - real (roots, kind=default), & - (/ mass(23), mass(23), mass(11), mass(11) /), states = (/ 3, 3, 2, 2 /), & - symmetry = reshape ((/ 1, 1, 2 /), (/ 3, 1/)), & - tolerance = tolerance, mode = mode) - - call check4_madgraph ("Z Z -> nue nuebar", n, ozz_veve, szz_veve, zz_veve, & - real (roots, kind=default), & - (/ mass(23), mass(23), 0.0_default, 0.0_default /), states = (/ 3, 3, 2, 2 /), & - symmetry = reshape ((/ 1, 1, 2 /), (/ 3, 1/)), & - tolerance = tolerance, mode = mode) - - call check4_madgraph ("Z A -> u ubar", n, oza_uub, sza_uub, za_uub, & - real (roots, kind=default), & - (/ mass(23), 0.0_default, mass(2), mass(2) /), states = (/ 3, 2, 2, 2 /), & - tolerance = tolerance, mode = mode) - - call check4_madgraph ("Z A -> d dbar", n, oza_ddb, sza_ddb, za_ddb, & - real (roots, kind=default), & - (/ mass(23), 0.0_default, mass(1), mass(1) /), states = (/ 3, 2, 2, 2 /), & - tolerance = tolerance, mode = mode) - -end program main4 - Index: branches/ohl/omega-development/completed/whizard2/tests/SM/maint.f95 =================================================================== --- branches/ohl/omega-development/completed/whizard2/tests/SM/maint.f95 (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/tests/SM/maint.f95 (revision 8703) @@ -1,46 +0,0 @@ -! $Id: maint.f95,v 1.1 2004/04/09 20:11:17 ohl Exp $ - -program maint - use kinds - use tao_random_numbers - use testbed_old - use rambo - use omega_amplitudest - use madgraph4 - implicit none - - real(kind=single) :: roots - integer :: n, tolerance - character (len=8) :: mode - - call setup_parameters () - call read_parameters (roots, n, tolerance, mode) - call export_parameters_to_madgraph () - - call check4_madgraph ("e+ e- -> W+ W-", n, oepem_wpwm, sepem_wpwm, epem_wpwm, & - real (roots, kind=default), (/ mass(11), mass(11), mass(24), mass(24) /), & - states = (/ 2, 2, 3, 3 /), tolerance = tolerance, mode = mode) - - ! call check8_madgraph ("e+ e- -> e+ nue b bbar d ubar", n, & - ! oepem_epvebbbdub, sepem_epvebbbdub, epem_epvebbbdub, real (roots, kind=default), & - ! (/ mass(11), mass(11), mass(11), mass(12), mass(5), mass(5), mass(1), mass(2) /), & - ! tolerance = tolerance) - ! - ! stop - ! - ! call check_omega ("e+ e- -> e+ nue b bbar d ubar: Theta vs. Constant", n, & - ! single_top, single_top_constant, real (roots, kind=default), & - ! (/ mass(11), mass(11), mass(11), mass(12), mass(5), mass(5), mass(1), mass(2) /), & - ! tolerance = tolerance) - ! - ! call check_omega ("e+ e- -> e+ nue b bbar d ubar: Theta vs. Fudged", n, & - ! single_top, single_top_fudged, real (roots, kind=default), & - ! (/ mass(11), mass(11), mass(11), mass(12), mass(5), mass(5), mass(1), mass(2) /), & - ! tolerance = tolerance) - ! - ! call check_omega ("e+ e- -> e+ nue b bbar d ubar: Constant vs. Fudged", n, & - ! single_top_constant, single_top_fudged, real (roots, kind=default), & - ! (/ mass(11), mass(11), mass(11), mass(12), mass(5), mass(5), mass(1), mass(2) /), & - ! tolerance = tolerance) - -end program maint Index: branches/ohl/omega-development/completed/whizard2/tests/SM/main5.f95 =================================================================== --- branches/ohl/omega-development/completed/whizard2/tests/SM/main5.f95 (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/tests/SM/main5.f95 (revision 8703) @@ -1,60 +0,0 @@ -! $Id: main5.f95,v 1.1 2004/04/09 20:11:17 ohl Exp $ - -program main5 - use kinds - use tao_random_numbers - use testbed_old - use rambo - use omega_amplitudes5 - ! use omega_helas_amplitudes - use madgraph5 - - real(kind=single) :: roots - integer :: n, tolerance - character (len=8) :: mode - - call setup_parameters () - call read_parameters (roots, n, tolerance, mode) - call export_parameters_to_madgraph () - - call check5_madgraph ("e+ e- -> W+ W- Z", n, & - oepem_wpwmz, sepem_wpwmz, epem_wpwmz, real (roots, kind=default), & - (/ mass(11), mass(11), mass(24), mass(24), mass(23) /), & - states = (/ 2, 2, 3, 3, 3 /), tolerance = tolerance, mode = mode) - - call check5_madgraph ("e+ e- -> W+ W- A", n, & - oepem_wpwma, sepem_wpwma, epem_wpwma, real (roots, kind=default), & - (/ mass(11), mass(11), mass(24), mass(24), 0.0_default /), & - states = (/ 2, 2, 3, 3, 2 /), tolerance = tolerance, mode = mode) - - call check5_madgraph ("e- e+ -> e- nuebar W+", n, & - oemep_emvewp, semep_emvewp, emep_emvewp, real (roots, kind=default), & - (/ mass(11), mass(11), mass(11), 0.0_default, mass(24) /), & - states = (/ 2, 2, 2, 2, 3 /), tolerance = tolerance, mode = mode) - - call check5_madgraph ("e+ e- -> e+ e- A", n, oepem_epema, sepem_epema, epem_epema, & - real (roots, kind=default), & - (/ mass(11), mass(11), mass(11), mass(11), 0.0_default /), & - tolerance = tolerance, mode = mode) - - call check5_madgraph ("e- e- -> e- e- A", n, oemem_emema, semem_emema, emem_emema, & - real (roots, kind=default), & - (/ mass(11), mass(11), mass(11), mass(11), 0.0_default /), & - symmetry = reshape ((/ -1, 1, 2, -1, 3, 4 /), (/ 3, 2/)), & - tolerance = tolerance, mode = mode) - - call check5_madgraph ("e+ e- -> A A A", n, oepem_aaa, sepem_aaa, epem_aaa, & - real (roots, kind=default), & - (/ mass(11), mass(11), 0.0_default, 0.0_default, 0.0_default /), & - symmetry = reshape ((/ 1, 3, 4, 1, 3, 5, 1, 4, 5 /), (/ 3, 3/)), & - tolerance = tolerance, mode = mode) - - call check5_madgraph ("e+ e- -> Z A A", n, oepem_zaa, sepem_zaa, epem_zaa, & - real (roots, kind=default), & - (/ mass(11), mass(11), mass(23), 0.0_default, 0.0_default /), & - states = (/ 2, 2, 3, 2, 2 /), & - symmetry = reshape ((/ 1, 4, 5 /), (/ 3, 1/)), tolerance = tolerance, mode = mode) - -end program main5 - - Index: branches/ohl/omega-development/completed/whizard2/tests/SM/main6.f95 =================================================================== --- branches/ohl/omega-development/completed/whizard2/tests/SM/main6.f95 (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/tests/SM/main6.f95 (revision 8703) @@ -1,100 +0,0 @@ -! $Id: main6.f95,v 1.1 2004/04/09 20:11:17 ohl Exp $ - -program main6 - use kinds - use tao_random_numbers - use testbed_old - use rambo - use omega_amplitudes6 - ! use omega_helas_amplitudes - use madgraph6 - implicit none - - real(kind=single) :: roots - integer :: n, tolerance - character (len=8) :: mode - - call setup_parameters () - call read_parameters (roots, n, tolerance, mode) - call export_parameters_to_madgraph () - - call check6_madgraph ("e+ e- -> nue nuebar b bbar", n, & - oepem_vevebbb, sepem_vevebbb, epem_vevebbb, real (roots, kind=default), & - (/ mass(11), mass(11), 0.0_default, 0.0_default, mass(5), mass(5) /), & - tolerance = tolerance, mode = mode) - - call check6_madgraph ("W+ W- -> u ubar s sbar", n, & - owpwm_uubssb, swpwm_uubssb, wpwm_uubssb, real (roots, kind=default), & - (/ mass(24), mass(24), mass(2), mass(2) , mass(3), mass(3) /), & - states = (/ 3, 3, 2, 2, 2, 2 /), tolerance = tolerance, mode = mode) - - call check6_madgraph ("e- e+ -> nue nuebar W+ W-", n, & - oemep_vevewpwm, semep_vevewpwm, emep_vevewpwm, real (roots, kind=default), & - (/ mass(11), mass(11), 0.0_default, 0.0_default, mass(24), mass(24) /), & - states = (/ 2, 2, 2, 2, 3, 3 /), tolerance = tolerance, mode = mode) - - call check6_madgraph ("e- e+ -> e- e+ W+ W-", n, & - oemep_emepwpwm, semep_emepwpwm, emep_emepwpwm, real (roots, kind=default), & - (/ mass(11), mass(11), mass(11), mass(11), mass(24), mass(24) /), & - states = (/ 2, 2, 2, 2, 3, 3 /), tolerance = tolerance, mode = mode) - - call check6_madgraph ("e- e+ -> e- nuebar W+ A (2 groves)", n, & - oemep_emvewpa_groves, semep_emvewpa, emep_emvewpa, real (roots, kind=default), & - (/ mass(11), mass(11), mass(11), 0.0_default, mass(24), 0.0_default /), & - states = (/ 2, 2, 2, 2, 3, 2 /), tolerance = tolerance, mode = mode) - - call check6_madgraph ("e- e+ -> e- nuebar W+ A", n, & - oemep_emvewpa, semep_emvewpa, emep_emvewpa, real (roots, kind=default), & - (/ mass(11), mass(11), mass(11), 0.0_default, mass(24), 0.0_default /), & - states = (/ 2, 2, 2, 2, 3, 2 /), tolerance = tolerance, mode = mode) - - call check6_madgraph ("e+ e- -> mu- numubar tau+ nutau", n, & - oepem_muvmtavt, sepem_muvmtavt, epem_muvmtavt, real (roots, kind=default), & - (/ mass(11), mass(11), mass(13), 0.0_default, mass(15), 0.0_default /), & - tolerance = tolerance, mode = mode) - - call check6_madgraph ("e+ e- -> e+ nue e- nuebar", n, & - oepem_epveemve, sepem_epveemve, epem_epveemve, real (roots, kind=default), & - (/ mass(11), mass(11), mass(11), 0.0_default, mass(11), 0.0_default /), & - tolerance = tolerance, mode = mode) - - call check6_madgraph ("e+ e- -> mu+ mu- A A", n, & - oepem_mumuaa, sepem_mumuaa, epem_mumuaa, real (roots, kind=default), & - (/ mass(11), mass(11), mass(13), mass(13), 0.0_default, 0.0_default /), & - symmetry = reshape ((/ 1, 5, 6 /), (/ 3, 1/)), tolerance = tolerance, mode = mode) - - call check6_madgraph ("e+ e- -> e+ e- A A", n, & - oepem_epemaa, sepem_epemaa, epem_epemaa, real (roots, kind=default), & - (/ mass(11), mass(11), mass(11), mass(11), 0.0_default, 0.0_default /), & - symmetry = reshape ((/ 1, 5, 6 /), (/ 3, 1/)), tolerance = tolerance, mode = mode) - - call check6_madgraph ("mu- e- -> mu- e- A A", n, & - omuem_muemaa, smuem_muemaa, muem_muemaa, real (roots, kind=default), & - (/ mass(13), mass(11), mass(13), mass(11), 0.0_default, 0.0_default /), & - symmetry = reshape ((/ 1, 5, 6 /), (/ 3, 1/)), tolerance = tolerance, mode = mode) - - call check6_madgraph ("e- e- -> e- e- A A", n, & - oemem_ememaa, semem_ememaa, emem_ememaa, real (roots, kind=default), & - (/ mass(11), mass(11), mass(11), mass(11), 0.0_default, 0.0_default /), & - symmetry = reshape ((/ -1, 3, 4, 1, 5, 6 /), (/ 3, 2/)), & - tolerance = tolerance, mode = mode) - - call check6_madgraph ("e+ e- -> A A A A", n, & - oepem_aaaa, sepem_aaaa, epem_aaaa, real (roots, kind=default), & - (/ mass(11), mass(11), 0.0_default, 0.0_default, 0.0_default, 0.0_default /), & - symmetry = reshape & - ((/ 1, 3, 4, 1, 3, 5, 1, 3, 6, 1, 4, 5, 1, 4, 6, 1, 5, 6 /), (/ 3, 6/)), & - tolerance = tolerance, mode = mode) - - call check6_madgraph ("e+ e- -> e+ e- e+ e-", n, & - oepem_epemepem, sepem_epemepem, epem_epemepem, real (roots, kind=default), & - (/ mass(11), mass(11), mass(11), mass(11), mass(11), mass(11) /), & - symmetry = reshape ((/ -1, 3, 5, -1, 4, 6 /), (/ 3, 2/)), & - tolerance = tolerance, mode = mode) - -end program main6 - - - - - Index: branches/ohl/omega-development/completed/whizard2/tests/SM/main7.f95 =================================================================== --- branches/ohl/omega-development/completed/whizard2/tests/SM/main7.f95 (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/tests/SM/main7.f95 (revision 8703) @@ -1,90 +0,0 @@ -! $Id: main7.f95,v 1.1 2004/04/09 20:11:17 ohl Exp $ - -program main7 - - use kinds - use tao_random_numbers - use kinematics - use testbed_old - use rambo - use omega_amplitudes7 - ! use omega_helas_amplitudes - use madgraph7 - - real(kind=single) :: roots - integer :: n, tolerance - character (len=8) :: mode - - call setup_parameters () - call read_parameters (roots, n, tolerance, mode) - call export_parameters_to_madgraph () - - call check7_madgraph ("e+ e- -> nue nuebar u ubar Z", n, & - oepem_veveuubz, sepem_veveuubz, epem_veveuubz, real (roots, kind=default), & - (/ mass(11), mass(11), 0.0_default, 0.0_default, mass(2), mass(2), mass(23) /), & - states = (/ 2, 2, 2, 2, 2, 2, 3 /), tolerance = tolerance, mode = mode) - - call check7_madgraph ("e- e+ -> e- nuebar u dbar A (2 groves)", n, & - oemep_emveudba_groves, semep_emveudba, emep_emveudba, real (roots, kind=default), & - (/ mass(11), mass(11), mass(11), 0.0_default, mass(2), mass(1), 0.0_default /), & - tolerance = tolerance, mode = mode) - - call check7_madgraph ("e- e+ -> e- nuebar u dbar A", n, & - oemep_emveudba, semep_emveudba, emep_emveudba, real (roots, kind=default), & - (/ mass(11), mass(11), mass(11), 0.0_default, mass(2), mass(1), 0.0_default /), & - tolerance = tolerance, mode = mode) - - call check7_madgraph ("e+ e- -> mu- numubar tau+ nutau A", n, & - oepem_muvmtavta, sepem_muvmtavta, epem_muvmtavta, real (roots, kind=default), & - (/ mass(11), mass(11), mass(13), 0.0_default, & - mass(15), 0.0_default, 0.0_default /), & - tolerance = tolerance, mode = mode) - - call check7_madgraph ("e+ e- -> e+ e- e+ e- A", n, & - oepem_epemepema, sepem_epemepema, epem_epemepema, real (roots, kind=default), & - (/ mass(11), mass(11), mass(11), mass(11), mass(11), mass(11), 0.0_default /), & - symmetry = reshape ((/ -1, 3, 5, -1, 4, 6 /), (/ 3, 2/)), & - tolerance = tolerance, mode = mode) - - call check7_madgraph ("e+ e- -> e+ e- A A A", n, & - oepem_epemaaa, sepem_epemaaa, epem_epemaaa, real (roots, kind=default), & - (/ mass(11), mass(11), mass(11), mass(11), & - 0.0_default, 0.0_default, 0.0_default /), & - symmetry = reshape ((/ 1, 5, 6, 1, 5, 7, 1, 6, 7 /), (/ 3, 3/)), & - tolerance = tolerance, mode = mode) - - call check7_madgraph ("e+ e- -> A A A A A", n, & - oepem_aaaaa, sepem_aaaaa, epem_aaaaa, real (roots, kind=default), & - (/ mass(11), mass(11), 0.0_default, 0.0_default, & - 0.0_default, 0.0_default, 0.0_default /), & - symmetry = reshape ((/ 1, 3, 4, 1, 3, 5, 1, 3, 6, 1, 3, 7, & - 1, 4, 5, 1, 4, 6, 1, 4, 7, 1, 5, 6, & - 1, 5, 7, 1, 6, 7 /), (/ 3, 10/)), & - tolerance = tolerance, mode = mode) - - call check7_madgraph ("A A -> e+ e- A A A", n, & - oaa_epemaaa, saa_epemaaa, aa_epemaaa, real (roots, kind=default), & - (/ 0.0_default, 0.0_default, mass(11), mass(11), & - 0.0_default, 0.0_default, 0.0_default /), & - symmetry = reshape ((/ 1, 1, 2, 1, 5, 6, 1, 5, 7, 1, 6, 7 /), (/ 3, 4/)), & - tolerance = tolerance, mode = mode) - - call check7_madgraph ("A A -> e+ e- mu+ mu- A", n, & - oaa_epemmumua, saa_epemmumua, aa_epemmumua, real (roots, kind=default), & - (/ 0.0_default, 0.0_default, mass(11), mass(11), & - mass(13), mass(13), 0.0_default /), & - symmetry = reshape ((/ 1, 1, 2 /), (/ 3, 1/)), & - tolerance = tolerance, mode = mode) - - call check7_madgraph ("A A -> e+ e- e+ e- A", n, & - oaa_epemepema, saa_epemepema, aa_epemepema, real (roots, kind=default), & - (/ 0.0_default, 0.0_default, mass(11), mass(11), & - mass(11), mass(11), 0.0_default /), & - symmetry = reshape ((/ 1, 1, 2, -1, 3, 5, -1, 4, 6 /), (/ 3, 3/)), & - tolerance = tolerance, mode = mode) - -end program main7 - - - - Index: branches/ohl/omega-development/completed/whizard2/tests/SM/main8.f95 =================================================================== --- branches/ohl/omega-development/completed/whizard2/tests/SM/main8.f95 (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/tests/SM/main8.f95 (revision 8703) @@ -1,50 +0,0 @@ -! $Id: main8.f95,v 1.1 2004/04/09 20:11:17 ohl Exp $ - -program main8 - - use kinds - use tao_random_numbers - use kinematics - use testbed_old - use rambo - use omega_amplitudes8 - ! use omega_helas_amplitudes - use madgraph8 - implicit none - - real(kind=single) :: roots - integer :: n, tolerance - character (len=8) :: mode - - call setup_parameters () - call read_parameters (roots, n, tolerance, mode) - call export_parameters_to_madgraph () - - call check8_madgraph ("e+ e- -> mu- numubar tau+ nutau u ubar", n, & - oepem_muvmtavtuub, sepem_muvmtavtuub, epem_muvmtavtuub, real (roots, kind=default), & - (/ mass(11), mass(11), mass(13), 0.0_default, & - mass(15), 0.0_default, mass(2), mass(2) /), & - tolerance = tolerance, mode = mode) - - call check8_madgraph ("e+ e- -> nue nuebar mu- numubar u dbar", n, & - oepem_vevemuvmudb, sepem_vevemuvmudb, epem_vevemuvmudb, real (roots, kind=default), & - (/ mass(11), mass(11), 0.0_default, 0.0_default, & - mass(13), 0.0_default, mass(2), mass(1) /), & - tolerance = tolerance, mode = mode) - - call check8_madgraph ("e+ e- -> mu+ mu- tau+ tau- u ubar", n, & - oepem_mumutatauub, sepem_mumutatauub, epem_mumutatauub, real (roots, kind=default), & - (/ mass(11), mass(11), mass(13), mass(13), mass(15), mass(15), mass(2), mass(2) /), & - tolerance = tolerance, mode = mode) - - call check8_madgraph ("e+ e- -> e+ e- A A A A", n, & - oepem_epemaaaa, sepem_epemaaaa, epem_epemaaaa, real (roots, kind=default), & - (/ mass(11), mass(11), mass(11), mass(11), & - 0.0_default, 0.0_default, 0.0_default , 0.0_default /), & - tolerance = tolerance, mode = mode) - -end program main8 - - - - Index: branches/ohl/omega-development/completed/whizard2/tests/SM/mainx.f95 =================================================================== --- branches/ohl/omega-development/completed/whizard2/tests/SM/mainx.f95 (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/tests/SM/mainx.f95 (revision 8703) @@ -1,69 +0,0 @@ -! $Id: mainx.f95,v 1.1 2004/04/09 20:11:17 ohl Exp $ - -program mainx - use kinds - use tao_random_numbers - use testbed_old - use rambo - use omega_amplitudesx - ! use omega_helas_amplitudes - use madgraphx - implicit none - - real(kind=single) :: roots - integer :: n, tolerance - character (len=8) :: mode - - call setup_parameters () - call read_parameters (roots, n, tolerance, mode) - !!! mass(1:19) = 0 - call export_parameters_to_madgraph () - - !!! call compare_sum8_madgraph (n, oepem_epvebbbdub, sepem_epvebbbdub, & - !!! real (roots, kind=default), & - !!! (/ mass(11), mass(11), mass(11), mass(12), mass(5), mass(5), mass(1), mass(2) /), & - !!! tolerance = tolerance, mode = mode) - !!! - !!! stop - - call check8_madgraph ("e+ e- -> e+ nue b bbar d ubar", n, & - oepem_epvebbbdub, sepem_epvebbbdub, epem_epvebbbdub, real (roots, kind=default), & - (/ mass(11), mass(11), mass(11), mass(12), mass(5), mass(5), mass(1), mass(2) /), & - tolerance = tolerance, mode = mode) - - call check5_madgraph ("W+ W- -> W+ W- A", n, & - owpwm_wpwma, swpwm_wpwma, wpwm_wpwma, real (roots, kind=default), & - (/ mass(24), mass(24), mass(24), mass(24), 0.0_default /), & - states = (/ 3, 3, 3, 3, 2 /), tolerance = tolerance, mode = mode) - - call check5_madgraph ("W+ W- -> A A A", n, & - owpwm_aaa, swpwm_aaa, wpwm_aaa, real (roots, kind=default), & - (/ mass(24), mass(24), 0.0_default, 0.0_default, 0.0_default /), & - symmetry = reshape ((/ 1, 3, 4, 1, 3, 5, 1, 4, 5 /), (/ 3, 3/)), & - states = (/ 3, 3, 2, 2, 2 /), tolerance = tolerance, mode = mode) - - call check5_madgraph ("W+ W- -> Z A A", n, & - owpwm_zaa, swpwm_zaa, wpwm_zaa, real (roots, kind=default), & - (/ mass(24), mass(24), mass(23), 0.0_default, 0.0_default /), & - symmetry = reshape ((/ 1, 4, 5 /), (/ 3, 1/)), & - states = (/ 3, 3, 3, 2, 2 /), tolerance = tolerance, mode = mode) - - call check6_madgraph ("e+ e- -> W+ W- A A", n, & - oepem_wpwmaa, sepem_wpwmaa, epem_wpwmaa, real (roots, kind=default), & - (/ mass(11), mass(11), mass(24), mass(24), 0.0_default, 0.0_default /), & - symmetry = reshape ((/ 1, 5, 6 /), (/ 3, 1/)), & - states = (/ 2, 2, 3, 3, 2, 2 /), tolerance = tolerance, mode = mode) - - call check8_madgraph ("e+ e- -> mu- numubar tau+ nutau A A", n, & - oepem_muvmtavtaa, sepem_muvmtavtaa, epem_muvmtavtaa, real (roots, kind=default), & - (/ mass(11), mass(11), mass(13), 0.0_default, & - mass(15), 0.0_default, 0.0_default , 0.0_default /), & - symmetry = reshape ((/ 1, 7, 8 /), (/ 3, 1/)), & - tolerance = tolerance, mode = mode) - -end program mainx - - - - - Index: branches/ohl/omega-development/completed/whizard2/tests/SM/dhelas95.f95 =================================================================== --- branches/ohl/omega-development/completed/whizard2/tests/SM/dhelas95.f95 (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/tests/SM/dhelas95.f95 (revision 8703) @@ -1,3552 +0,0 @@ - module dhelas95 - contains -c -c ====================================================================== -c - subroutine boostx(p,q , pboost) -c -c this subroutine performs the lorentz boost of a four-momentum. the -c momentum p is assumed to be given in the rest frame of q. pboost is -c the momentum p boosted to the frame in which q is given. q must be a -c timelike momentum. -c -c input: -c real p(0:3) : four-momentum p in the q rest frame -c real q(0:3) : four-momentum q in the boosted frame -c -c output: -c real pboost(0:3) : four-momentum p in the boosted frame -c - real*8 p(0:3),q(0:3),pboost(0:3),pq,qq,m,lf -c - real*8 r_zero - parameter( r_zero=0.0d0 ) -c - qq=q(1)**2+q(2)**2+q(3)**2 -c - if ( qq .ne. r_zero ) then - pq=p(1)*q(1)+p(2)*q(2)+p(3)*q(3) - m=sqrt(q(0)**2-qq) - lf=((q(0)-m)*pq/qq+p(0))/m - pboost(0) = (p(0)*q(0)+pq)/m - pboost(1) = p(1)+q(1)*lf - pboost(2) = p(2)+q(2)*lf - pboost(3) = p(3)+q(3)*lf - else - pboost(0)=p(0) - pboost(1)=p(1) - pboost(2)=p(2) - pboost(3)=p(3) - endif -c - return - end subroutine -c -c ********************************************************************** -c - subroutine coup1x(sw2 , gw,gwwa,gwwz) -c -c this subroutine sets up the coupling constants of the gauge bosons in -c the standard model. -c -c input: -c real sw2 : square of sine of the weak angle -c -c output: -c real gw : weak coupling constant -c real gwwa : dimensionless coupling of w-,w+,a -c real gwwz : dimensionless coupling of w-,w+,z -c - real*8 sw2,gw,gwwa,gwwz,alpha,fourpi,ee,sw,cw -c - real*8 r_one, r_four, r_ote, r_pi, r_ialph - parameter( r_one=1.0d0, r_four=4.0d0, r_ote=128.0d0 ) - parameter( r_pi=3.14159265358979323846d0, r_ialph=137.0359895d0 ) -c - alpha = r_one / r_ote -c alpha = r_one / r_ialph - fourpi = r_four * r_pi - ee=sqrt( alpha * fourpi ) - sw=sqrt( sw2 ) - cw=sqrt( r_one - sw2 ) -c - gw = ee/sw - gwwa = ee - gwwz = ee*cw/sw -c - return - end subroutine -c -c ---------------------------------------------------------------------- -c - subroutine coup2x(sw2 , gal,gau,gad,gwf,gzn,gzl,gzu,gzd,g1) -c -c this subroutine sets up the coupling constants for the fermion- -c fermion-vector vertices in the standard model. the array of the -c couplings specifies the chirality of the flowing-in fermion. g??(1) -c denotes a left-handed coupling, and g??(2) a right-handed coupling. -c -c input: -c real sw2 : square of sine of the weak angle -c -c output: -c real gal(2) : coupling with a of charged leptons -c real gau(2) : coupling with a of up-type quarks -c real gad(2) : coupling with a of down-type quarks -c real gwf(2) : coupling with w-,w+ of fermions -c real gzn(2) : coupling with z of neutrinos -c real gzl(2) : coupling with z of charged leptons -c real gzu(2) : coupling with z of up-type quarks -c real gzd(2) : coupling with z of down-type quarks -c real g1(2) : unit coupling of fermions -c - real*8 gal(2),gau(2),gad(2),gwf(2),gzn(2),gzl(2),gzu(2),gzd(2), - & g1(2),sw2,alpha,fourpi,ee,sw,cw,ez,ey -c - real*8 r_zero, r_half, r_one, r_two, r_three, r_four, r_ote - real*8 r_pi, r_ialph - parameter( r_zero=0.0d0, r_half=0.5d0, r_one=1.0d0, r_two=2.0d0, - $ r_three=3.0d0 ) - parameter( r_four=4.0d0, r_ote=128.0d0 ) - parameter( r_pi=3.14159265358979323846d0, r_ialph=137.0359895d0 ) -c - alpha = r_one / r_ote -c alpha = r_one / r_ialph - fourpi = r_four * r_pi - ee=sqrt( alpha * fourpi ) - sw=sqrt( sw2 ) - cw=sqrt( r_one - sw2 ) - ez=ee/(sw*cw) - ey=ee*(sw/cw) -c - gal(1) = ee - gal(2) = ee - gau(1) = -ee*r_two/r_three - gau(2) = -ee*r_two/r_three - gad(1) = ee /r_three - gad(2) = ee /r_three - gwf(1) = -ee/sqrt(r_two*sw2) - gwf(2) = r_zero - gzn(1) = -ez* r_half - gzn(2) = r_zero - gzl(1) = -ez*(-r_half+sw2) - gzl(2) = -ey - gzu(1) = -ez*( r_half-sw2*r_two/r_three) - gzu(2) = ey* r_two/r_three - gzd(1) = -ez*(-r_half+sw2 /r_three) - gzd(2) = -ey /r_three - g1(1) = r_one - g1(2) = r_one -c - return - end subroutine -c -c ---------------------------------------------------------------------- -c - subroutine coup3x(sw2,zmass,hmass , - & gwwh,gzzh,ghhh,gwwhh,gzzhh,ghhhh) -c -c this subroutine sets up the coupling constants of the gauge bosons and -c higgs boson in the standard model. -c -c input: -c real sw2 : square of sine of the weak angle -c real zmass : mass of z -c real hmass : mass of higgs -c -c output: -c real gwwh : dimensionful coupling of w-,w+,h -c real gzzh : dimensionful coupling of z, z, h -c real ghhh : dimensionful coupling of h, h, h -c real gwwhh : dimensionful coupling of w-,w+,h, h -c real gzzhh : dimensionful coupling of z, z, h, h -c real ghhhh : dimensionless coupling of h, h, h, h -c - real*8 sw2,zmass,hmass,gwwh,gzzh,ghhh,gwwhh,gzzhh,ghhhh, - & alpha,fourpi,ee2,sc2,v -c - real*8 r_half, r_one, r_two, r_three, r_four, r_ote - real*8 r_pi, r_ialph - parameter( r_half=0.5d0, r_one=1.0d0, r_two=2.0d0, r_three=3.0d0 ) - parameter( r_four=4.0d0, r_ote=128.0d0 ) - parameter( r_pi=3.14159265358979323846d0, r_ialph=137.0359895d0 ) -c - alpha = r_one / r_ote -c alpha = r_one / r_ialph - fourpi = r_four * r_pi - ee2=alpha*fourpi - sc2=sw2*( r_one - sw2 ) - v = r_two * zmass*sqrt(sc2)/sqrt(ee2) -c - gwwh = ee2/sw2*r_half*v - gzzh = ee2/sc2*r_half*v - ghhh = -hmass**2/v*r_three - gwwhh = ee2/sw2*r_half - gzzhh = ee2/sc2*r_half - ghhhh = -(hmass/v)**2*r_three -c - return - end subroutine -C -C ---------------------------------------------------------------------- -C - SUBROUTINE COUP4X(SW2,ZMASS,FMASS , GCHF) -C -C This subroutine sets up the coupling constant for the fermion-fermion- -C Higgs vertex in the STANDARD MODEL. The coupling is COMPLEX and the -C array of the coupling specifies the chirality of the flowing-IN -C fermion. GCHF(1) denotes a left-handed coupling, and GCHF(2) a right- -C handed coupling. -C -C INPUT: -C real SW2 : square of sine of the weak angle -C real ZMASS : Z mass -C real FMASS : fermion mass -C -C OUTPUT: -C complex GCHF(2) : coupling of fermion and Higgs -C - implicit none - COMPLEX*16 GCHF(2) - REAL*8 SW2,ZMASS,FMASS,ALPHA,FOURPI,EZ,G -C - ALPHA=1.d0/128.d0 -C ALPHA=1./REAL(137.0359895) - FOURPI=4.D0*3.14159265358979323846D0 - EZ=SQRT(ALPHA*FOURPI)/SQRT(SW2*(1.d0-SW2)) - G=EZ*FMASS*0.5d0/ZMASS -C - GCHF(1) = DCMPLX( -G ) - GCHF(2) = DCMPLX( -G ) -C - RETURN - end subroutine -C -C ====================================================================== -C - SUBROUTINE EAIXXX(EB,EA,SHLF,CHLF,PHI,NHE,NHA , EAI) -C -C This subroutine computes an off-shell electron wavefunction after -C emitting a photon from the electron beam, with a special care for the -C small angle region. The momenta are measured in the laboratory frame, -C where the e- beam is along the positive z axis. -C -C INPUT: -C real EB : energy (GeV) of beam e- -C real EA : energy (GeV) of final photon -C real SHLF : sin(theta/2) of final photon -C real CHLF : cos(theta/2) of final photon -C real PHI : azimuthal angle of final photon -C integer NHE = -1 or 1 : helicity of beam e- -C integer NHA = -1 or 1 : helicity of final photon -C -C OUTPUT: -C complex EAI(6) : off-shell electron |e',A,e> -C - implicit none - COMPLEX*16 EAI(6),PHS - REAL*8 EB,EA,SHLF,CHLF,PHI,ME,ALPHA,GAL,RNHE,X,C,S,D,COEFF, - & XNNP,XNNM,SNP,CSP - INTEGER NHE,NHA,NN -C - ME = 0.51099906D-3 - ALPHA=1./128. - GAL =SQRT(ALPHA*4.*3.14159265D0) -C - NN=NHA*NHE - RNHE=NHE - X=EA/EB - C=(CHLF+SHLF)*(CHLF-SHLF) - S=2.*CHLF*SHLF - D=-1./(EA*EB*(4.*SHLF**2+(ME/EB)**2*C)) - COEFF=-NN*GAL*SQRT(EB)*D - XNNP=X*(1+NN) - XNNM=X*(1-NN) - SNP=SIN(PHI) - CSP=COS(PHI) - PHS=dCMPLX( CSP , RNHE*SNP ) -C - EAI((5-3*NHE)/2) = -RNHE*COEFF*ME*S*(1.+XNNP*.5) - EAI((5-NHE)/2) = XNNP*COEFF*ME*CHLF**2*PHS - EAI((5+NHE)/2) = RNHE*COEFF*EB*S*(-2.+XNNM) - EAI((5+3*NHE)/2) = XNNM*COEFF*EB*SHLF**2*PHS*2. -C - EAI(5) = EB*dCMPLX( 1.-X , 1.-X*C ) - EAI(6) = -EB*X*S*dCMPLX( CSP , SNP ) -C - RETURN - end subroutine -C -C ---------------------------------------------------------------------- -C - SUBROUTINE EAOXXX(EB,EA,SHLF,CHLF,PHI,NHE,NHA , EAO) -C -C This subroutine computes an off-shell positron wavefunction after -C emitting a photon from the positron beam, with a special care for the -C small angle region. The momenta are measured in the laboratory frame, -C where the e+ beam is along the negative z axis. -C -C INPUT: -C real EB : energy (GeV) of beam e+ -C real EA : energy (GeV) of final photon -C real SHLF : sin(theta/2) of final photon -C real CHLF : cos(theta/2) of final photon -C real PHI : azimuthal angle of final photon -C integer NHE = -1 or 1 : helicity of beam e+ -C integer NHA = -1 or 1 : helicity of final photon -C -C OUTPUT: -C complex EAO(6) : off-shell positron -c complex*16 sc(3) : input scalar s -c complex*16 gc(2) : coupling constants gchf -c real*8 fmass : mass of output fermion f' -c real*8 fwidth : width of output fermion f' -c -c output: -c complex fsi(6) : off-shell fermion |f',s,fi> -c - complex*16 fi(6),sc(3),fsi(6),gc(2),sl1,sl2,sr1,sr2,ds - real*8 pf(0:3),fmass,fwidth,pf2,p0p3,p0m3 -c - fsi(5) = fi(5)-sc(2) - fsi(6) = fi(6)-sc(3) -c - pf(0)=dble( fsi(5)) - pf(1)=dble( fsi(6)) - pf(2)=dimag(fsi(6)) - pf(3)=dimag(fsi(5)) - pf2=pf(0)**2-(pf(1)**2+pf(2)**2+pf(3)**2) -c - ds=-sc(1)/dcmplx(pf2-fmass**2,max(dsign(fmass*fwidth ,pf2),0d0)) - p0p3=pf(0)+pf(3) - p0m3=pf(0)-pf(3) - sl1=gc(1)*(p0p3*fi(1)+dconjg(fsi(6))*fi(2)) - sl2=gc(1)*(p0m3*fi(2) +fsi(6) *fi(1)) - sr1=gc(2)*(p0m3*fi(3)-dconjg(fsi(6))*fi(4)) - sr2=gc(2)*(p0p3*fi(4) -fsi(6) *fi(3)) -c - fsi(1) = ( gc(1)*fmass*fi(1) + sr1 )*ds - fsi(2) = ( gc(1)*fmass*fi(2) + sr2 )*ds - fsi(3) = ( gc(2)*fmass*fi(3) + sl1 )*ds - fsi(4) = ( gc(2)*fmass*fi(4) + sl2 )*ds -c - return - end subroutine -c -c ---------------------------------------------------------------------- -c - subroutine fsoxxx(fo,sc,gc,fmass,fwidth , fso) -c -c this subroutine computes an off-shell fermion wavefunction from a -c flowing-out external fermion and a vector boson. -c -c input: -c complex*16 fo(6) : flow-out fermion -c complex vc(6) : input vector v -c real g(2) : coupling constants gvf -c real fmass : mass of output fermion f' -c real fwidth : width of output fermion f' -c -c output: -c complex fvi(6) : off-shell fermion |f',v,fi> -c - complex*16 fi(6),vc(6),fvi(6),sl1,sl2,sr1,sr2,d - real*8 g(2),pf(0:3),fmass,fwidth,pf2 -c - real*8 r_zero, r_one - parameter( r_zero=0.0d0, r_one=1.0d0 ) - complex*16 c_imag - c_imag=dcmplx( r_zero, r_one ) -c - fvi(5) = fi(5)-vc(5) - fvi(6) = fi(6)-vc(6) -c - pf(0)=dble( fvi(5)) - pf(1)=dble( fvi(6)) - pf(2)=dimag(fvi(6)) - pf(3)=dimag(fvi(5)) - pf2=pf(0)**2-(pf(1)**2+pf(2)**2+pf(3)**2) -c - d=-r_one/dcmplx( pf2-fmass**2,max(sign(fmass*fwidth,pf2),r_zero)) - sl1= (vc(1)+ vc(4))*fi(1) - & +(vc(2)-c_imag*vc(3))*fi(2) - sl2= (vc(2)+c_imag*vc(3))*fi(1) - & +(vc(1)- vc(4))*fi(2) -c - if ( g(2) .ne. r_zero ) then - sr1= (vc(1)- vc(4))*fi(3) - & -(vc(2)-c_imag*vc(3))*fi(4) - sr2=-(vc(2)+c_imag*vc(3))*fi(3) - & +(vc(1)+ vc(4))*fi(4) -c - fvi(1) = ( g(1)*((pf(0)-pf(3))*sl1 -dconjg(fvi(6))*sl2) - & +g(2)*fmass*sr1)*d - fvi(2) = ( g(1)*( -fvi(6)*sl1 +(pf(0)+pf(3))*sl2) - & +g(2)*fmass*sr2)*d - fvi(3) = ( g(2)*((pf(0)+pf(3))*sr1 +dconjg(fvi(6))*sr2) - & +g(1)*fmass*sl1)*d - fvi(4) = ( g(2)*( fvi(6)*sr1 +(pf(0)-pf(3))*sr2) - & +g(1)*fmass*sl2)*d -c - else - fvi(1) = g(1)*((pf(0)-pf(3))*sl1 -dconjg(fvi(6))*sl2)*d - fvi(2) = g(1)*( -fvi(6)*sl1 +(pf(0)+pf(3))*sl2)*d - fvi(3) = g(1)*fmass*sl1*d - fvi(4) = g(1)*fmass*sl2*d - end if -c - return - end subroutine -c -c ---------------------------------------------------------------------- -c - subroutine fvoxxx(fo,vc,g,fmass,fwidth , fvo) -c -c this subroutine computes an off-shell fermion wavefunction from a -c flowing-out external fermion and a vector boson. -c -c input: -c complex fo(6) : flow-out fermion -c complex fo(6) : flow-out fermion ) -c - complex*16 fi(6),fo(6),hio(3),gc(2),dn - real*8 q(0:3),smass,swidth,q2 -c - hio(2) = fo(5)-fi(5) - hio(3) = fo(6)-fi(6) -c - q(0)=dble( hio(2)) - q(1)=dble( hio(3)) - q(2)=dimag(hio(3)) - q(3)=dimag(hio(2)) - q2=q(0)**2-(q(1)**2+q(2)**2+q(3)**2) -c - dn=-dcmplx(q2-smass**2,dmax1(dsign(smass*swidth,q2),0.d0)) -c - hio(1) = ( gc(1)*(fo(1)*fi(1)+fo(2)*fi(2)) - & +gc(2)*(fo(3)*fi(3)+fo(4)*fi(4)) )/dn -c - return - end subroutine - -C ---------------------------------------------------------------------- -C - SUBROUTINE HSSSXX(S1,S2,S3,G,SMASS,SWIDTH , HSSS) -C -C This subroutine computes an off-shell scalar current from the four- -C scalar coupling. -C -C INPUT: -C complex S1(3) : first scalar S1 -C complex S2(3) : second scalar S2 -C complex S3(3) : third scalar S3 -C real G : coupling constant GHHHH -C real SMASS : mass of OUTPUT scalar S' -C real SWIDTH : width of OUTPUT scalar S' -C -C OUTPUT: -C complex HSSS(3) : scalar current J(S':S1,S2,S3) -C - implicit none - COMPLEX*16 S1(3),S2(3),S3(3),HSSS(3),DG - REAL*8 Q(0:3),G,SMASS,SWIDTH,Q2 -C - HSSS(2) = S1(2)+S2(2)+S3(2) - HSSS(3) = S1(3)+S2(3)+S3(3) -C - Q(0)=dble( HSSS(2)) - Q(1)=dble( HSSS(3)) - Q(2)=dIMAG(HSSS(3)) - Q(3)=dIMAG(HSSS(2)) - Q2=Q(0)**2-(Q(1)**2+Q(2)**2+Q(3)**2) -C - DG=-G/dCMPLX( Q2-SMASS**2,MAX(SIGN(SMASS*SWIDTH ,Q2),0.d0)) -C - HSSS(1) = DG * S1(1)*S2(1)*S3(1) -C - RETURN - end subroutine -C ---------------------------------------------------------------------- -C - SUBROUTINE HSSXXX(S1,S2,G,SMASS,SWIDTH , HSS) -C -C This subroutine computes an off-shell scalar current from the three- -C scalar coupling. -C -C INPUT: -C complex S1(3) : first scalar S1 -C complex S2(3) : second scalar S2 -C real G : coupling constant GHHH -C real SMASS : mass of OUTPUT scalar S' -C real SWIDTH : width of OUTPUT scalar S' -C -C OUTPUT: -C complex HSS(3) : scalar current J(S':S1,S2) -C - implicit none - COMPLEX*16 S1(3),S2(3),HSS(3),DG - REAL*8 Q(0:3),G,SMASS,SWIDTH,Q2 -C - HSS(2) = S1(2)+S2(2) - HSS(3) = S1(3)+S2(3) -C - Q(0)=dble( HSS(2)) - Q(1)=dble( HSS(3)) - Q(2)=dIMAG(HSS(3)) - Q(3)=dIMAG(HSS(2)) - Q2=Q(0)**2-(Q(1)**2+Q(2)**2+Q(3)**2) -C - DG=-G/dCMPLX( Q2-SMASS**2, MAX(SIGN(SMASS*SWIDTH ,Q2),0.d0)) -C - HSS(1) = DG*S1(1)*S2(1) -C - RETURN - end subroutine -C -C ====================================================================== -c ---------------------------------------------------------------------- -c - subroutine hvsxxx(vc,sc,g,smass,swidth , hvs) -c -c this subroutine computes an off-shell scalar current from the vector- -c scalar-scalar coupling. the coupling is absent in the minimal sm in -c unitary gauge. -c -c input: -c complex vc(6) : input vector v -c complex sc(3) : input scalar s -c complex g : coupling constant (s charge) -c real smass : mass of output scalar s' -c real swidth : width of output scalar s' -c -c examples of the coupling constant g for susy particles are as follows: -c ----------------------------------------------------------- -c | s1 | (q,i3) of s1 || v=a | v=z | v=w | -c ----------------------------------------------------------- -c | nu~_l | ( 0 , +1/2) || --- | gzn(1) | gwf(1) | -c | e~_l | ( -1 , -1/2) || gal(1) | gzl(1) | gwf(1) | -c | u~_l | (+2/3 , +1/2) || gau(1) | gzu(1) | gwf(1) | -c | d~_l | (-1/3 , -1/2) || gad(1) | gzd(1) | gwf(1) | -c ----------------------------------------------------------- -c | e~_r-bar | ( +1 , 0 ) || -gal(2) | -gzl(2) | -gwf(2) | -c | u~_r-bar | (-2/3 , 0 ) || -gau(2) | -gzu(2) | -gwf(2) | -c | d~_r-bar | (+1/3 , 0 ) || -gad(2) | -gzd(2) | -gwf(2) | -c ----------------------------------------------------------- -c where the sc charge is defined by the flowing-out quantum number. -c -c output: -c complex hvs(3) : scalar current j(s':v,s) -c - implicit none - complex*16 vc(6),sc(3),hvs(3),dg,qvv,qpv,g - real*8 qv(0:3),qp(0:3),qa(0:3),smass,swidth,q2 -c - hvs(2) = vc(5)+sc(2) - hvs(3) = vc(6)+sc(3) -c - qv(0)=dble( vc(5)) - qv(1)=dble( vc(6)) - qv(2)=dimag( vc(6)) - qv(3)=dimag( vc(5)) - qp(0)=dble( sc(2)) - qp(1)=dble( sc(3)) - qp(2)=dimag( sc(3)) - qp(3)=dimag( sc(2)) - qa(0)=dble( hvs(2)) - qa(1)=dble( hvs(3)) - qa(2)=dimag(hvs(3)) - qa(3)=dimag(hvs(2)) - q2=qa(0)**2-(qa(1)**2+qa(2)**2+qa(3)**2) -c - dg=-g/dcmplx( q2-smass**2 , max(dsign( smass*swidth ,q2),0d0) ) - qvv=qv(0)*vc(1)-qv(1)*vc(2)-qv(2)*vc(3)-qv(3)*vc(4) - qpv=qp(0)*vc(1)-qp(1)*vc(2)-qp(2)*vc(3)-qp(3)*vc(4) -c - hvs(1) = dg*(2d0*qpv+qvv)*sc(1) -c - return - end subroutine -c -c ---------------------------------------------------------------------- -c - subroutine hvvxxx(v1,v2,g,smass,swidth , hvv) -c -c this subroutine computes an off-shell scalar current from the vector- -c vector-scalar coupling. -c -c input: -c complex v1(6) : first vector v1 -c complex v2(6) : second vector v2 -c real g : coupling constant gvvh -c real smass : mass of output scalar s -c real swidth : width of output scalar s -c -c output: -c complex hvv(3) : off-shell scalar current j(s:v1,v2) -c - complex*16 v1(6),v2(6),hvv(3),dg - real*8 q(0:3),g,smass,swidth,q2 -c - real*8 r_zero - parameter( r_zero=0.0d0 ) -c - hvv(2) = v1(5)+v2(5) - hvv(3) = v1(6)+v2(6) -c - q(0)=dble( hvv(2)) - q(1)=dble( hvv(3)) - q(2)=dimag(hvv(3)) - q(3)=dimag(hvv(2)) - q2=q(0)**2-(q(1)**2+q(2)**2+q(3)**2) -c - dg=-g/dcmplx( q2-smass**2 , max(sign( smass*swidth ,q2),r_zero) ) -c - hvv(1) = dg*(v1(1)*v2(1)-v1(2)*v2(2)-v1(3)*v2(3)-v1(4)*v2(4)) -c - return - end subroutine -C -C ====================================================================== -C - SUBROUTINE IOSXXX(FI,FO,SC,GC , VERTEX) -C -C This subroutine computes an amplitude of the fermion-fermion-scalar -C coupling. -C -C INPUT: -C complex FI(6) : flow-in fermion |FI> -C complex FO(6) : flow-out fermion -C - COMPLEX*16 FI(6),FO(6),SC(3),GC(2),VERTEX -C - VERTEX = SC(1)*( GC(1)*(FI(1)*FO(1)+FI(2)*FO(2)) - & +GC(2)*(FI(3)*FO(3)+FI(4)*FO(4)) ) -C - RETURN - end subroutine -c -c ====================================================================== -c - subroutine iovxxx(fi,fo,vc,g , vertex) -c -c this subroutine computes an amplitude of the fermion-fermion-vector -c coupling. -c -c input: -c complex fi(6) : flow-in fermion |fi> -c complex fo(6) : flow-out fermion -c - complex*16 fi(6),fo(6),vc(6),vertex - real*8 g(2) -c - real*8 r_zero, r_one - parameter( r_zero=0.0d0, r_one=1.0d0 ) - complex*16 c_imag - c_imag=dcmplx( r_zero, r_one ) -c - - vertex = g(1)*( (fo(3)*fi(1)+fo(4)*fi(2))*vc(1) - & +(fo(3)*fi(2)+fo(4)*fi(1))*vc(2) - & -(fo(3)*fi(2)-fo(4)*fi(1))*vc(3)*c_imag - & +(fo(3)*fi(1)-fo(4)*fi(2))*vc(4) ) -c - if ( g(2) .ne. r_zero ) then - vertex = vertex - & + g(2)*( (fo(1)*fi(3)+fo(2)*fi(4))*vc(1) - & -(fo(1)*fi(4)+fo(2)*fi(3))*vc(2) - & +(fo(1)*fi(4)-fo(2)*fi(3))*vc(3)*c_imag - & -(fo(1)*fi(3)-fo(2)*fi(4))*vc(4) ) - end if -c - return - end subroutine -c -c Subroutine returns the desired fermion or -c anti-fermion spinor. ie., |f> -c A replacement for the HELAS routine IXXXXX -c -c Adam Duff, 1992 August 31 -c -c - subroutine ixxxxx( - & p, !in: four vector momentum - & fmass, !in: fermion mass - & nhel, !in: spinor helicity, -1 or 1 - & nsf, !in: -1=antifermion, 1=fermion - & fi !out: fermion wavefunction - & ) - implicit none -c -c declare input/output variables -c - complex*16 fi(6) - integer*4 nhel, nsf - real*8 p(0:3), fmass -c -c declare local variables -c - real*8 r_zero, r_one, r_two - parameter( r_zero=0.0d0, r_one=1.0d0, r_two=2.0d0 ) - complex*16 c_zero -c - real*8 plat, pabs, omegap, omegam, rs2pa, spaz - c_zero=dcmplx( r_zero, r_zero ) -c -c define kinematic parameters -c - fi(5) = dcmplx( p(0), p(3) ) * nsf - fi(6) = dcmplx( p(1), p(2) ) * nsf - plat = sqrt( p(1)**2 + p(2)**2 ) - pabs = sqrt( p(1)**2 + p(2)**2 + p(3)**2 ) - omegap = sqrt( p(0) + pabs ) -c -c do massive fermion case -c - if ( fmass .ne. r_zero ) then - omegam = fmass / omegap - if ( nsf .eq. 1 ) then - if ( nhel .eq. 1 ) then - if ( p(3) .ge. r_zero ) then - if ( plat .eq. r_zero ) then - fi(1) = dcmplx( omegam, r_zero ) - fi(2) = c_zero - fi(3) = dcmplx( omegap, r_zero ) - fi(4) = c_zero - else - rs2pa = r_one / sqrt( r_two * pabs ) - spaz = sqrt( pabs + p(3) ) - fi(1) = omegam * rs2pa - & * dcmplx( spaz, r_zero ) - fi(2) = omegam * rs2pa / spaz - & * dcmplx( p(1), p(2) ) - fi(3) = omegap * rs2pa - & * dcmplx( spaz, r_zero ) - fi(4) = omegap * rs2pa / spaz - & * dcmplx( p(1), p(2) ) - end if - else - if ( plat .eq. r_zero ) then - fi(1) = c_zero - fi(2) = dcmplx( omegam, r_zero ) - fi(3) = c_zero - fi(4) = dcmplx( omegap, r_zero ) - else - rs2pa = r_one / sqrt( r_two * pabs ) - spaz = sqrt( pabs - p(3) ) - fi(1) = omegam * rs2pa / spaz - & * dcmplx( plat, r_zero ) - fi(2) = omegam * rs2pa * spaz / plat - & * dcmplx( p(1), p(2) ) - fi(3) = omegap * rs2pa / spaz - & * dcmplx( plat, r_zero ) - fi(4) = omegap * rs2pa * spaz / plat - & * dcmplx( p(1), p(2) ) - end if - end if - else if ( nhel .eq. -1 ) then - if ( p(3) .ge. r_zero ) then - if ( plat .eq. r_zero ) then - fi(1) = c_zero - fi(2) = dcmplx( omegap, r_zero ) - fi(3) = c_zero - fi(4) = dcmplx( omegam, r_zero ) - else - rs2pa = r_one / sqrt( r_two * pabs ) - spaz = sqrt( pabs + p(3) ) - fi(1) = omegap * rs2pa / spaz - & * dcmplx( -p(1), p(2) ) - fi(2) = omegap * rs2pa - & * dcmplx( spaz, r_zero ) - fi(3) = omegam * rs2pa / spaz - & * dcmplx( -p(1), p(2) ) - fi(4) = omegam * rs2pa - & * dcmplx( spaz, r_zero ) - end if - else - if ( plat .eq. r_zero ) then - fi(1) = dcmplx( -omegap, r_zero ) - fi(2) = c_zero - fi(3) = dcmplx( -omegam, r_zero ) - fi(4) = c_zero - else - rs2pa = r_one / sqrt( r_two * pabs ) - spaz = sqrt( pabs - p(3) ) - fi(1) = omegap * rs2pa * spaz / plat - & * dcmplx( -p(1), p(2) ) - fi(2) = omegap * rs2pa / spaz - & * dcmplx( plat, r_zero ) - fi(3) = omegam * rs2pa * spaz / plat - & * dcmplx( -p(1), p(2) ) - fi(4) = omegam * rs2pa / spaz - & * dcmplx( plat, r_zero ) - end if - end if - else - stop 'ixxxxx: fermion helicity must be +1,-1' - end if - else if ( nsf .eq. -1 ) then - if ( nhel .eq. 1 ) then - if ( p(3) .ge. r_zero ) then - if ( plat .eq. r_zero ) then - fi(1) = c_zero - fi(2) = dcmplx( -omegap, r_zero ) - fi(3) = c_zero - fi(4) = dcmplx( omegam, r_zero ) - else - rs2pa = r_one / sqrt( r_two * pabs ) - spaz = sqrt( pabs + p(3) ) - fi(1) = -omegap * rs2pa / spaz - & * dcmplx( -p(1), p(2) ) - fi(2) = -omegap * rs2pa - & * dcmplx( spaz, r_zero ) - fi(3) = omegam * rs2pa / spaz - & * dcmplx( -p(1), p(2) ) - fi(4) = omegam * rs2pa - & * dcmplx( spaz, r_zero ) - end if - else - if ( plat .eq. r_zero ) then - fi(1) = dcmplx( omegap, r_zero ) - fi(2) = c_zero - fi(3) = dcmplx( -omegam, r_zero ) - fi(4) = c_zero - else - rs2pa = r_one / sqrt( r_two * pabs ) - spaz = sqrt( pabs - p(3) ) - fi(1) = -omegap * rs2pa * spaz / plat - & * dcmplx( -p(1), p(2) ) - fi(2) = -omegap * rs2pa / spaz - & * dcmplx( plat, r_zero ) - fi(3) = omegam * rs2pa * spaz / plat - & * dcmplx( -p(1), p(2) ) - fi(4) = omegam * rs2pa / spaz - & * dcmplx( plat, r_zero ) - end if - end if - else if ( nhel .eq. -1 ) then - if ( p(3) .ge. r_zero ) then - if ( plat .eq. r_zero ) then - fi(1) = dcmplx( omegam, r_zero ) - fi(2) = c_zero - fi(3) = dcmplx( -omegap, r_zero ) - fi(4) = c_zero - else - rs2pa = r_one / sqrt( r_two * pabs ) - spaz = sqrt( pabs + p(3) ) - fi(1) = omegam * rs2pa - & * dcmplx( spaz, r_zero ) - fi(2) = omegam * rs2pa / spaz - & * dcmplx( p(1), p(2) ) - fi(3) = -omegap * rs2pa - & * dcmplx( spaz, r_zero ) - fi(4) = -omegap * rs2pa / spaz - & * dcmplx( p(1), p(2) ) - end if - else - if ( plat .eq. r_zero ) then - fi(1) = c_zero - fi(2) = dcmplx( omegam, r_zero ) - fi(3) = c_zero - fi(4) = dcmplx( -omegap, r_zero ) - else - rs2pa = r_one / sqrt( r_two * pabs ) - spaz = sqrt( pabs - p(3) ) - fi(1) = omegam * rs2pa / spaz - & * dcmplx( plat, r_zero ) - fi(2) = omegam * rs2pa * spaz / plat - & * dcmplx( p(1), p(2) ) - fi(3) = -omegap * rs2pa / spaz - & * dcmplx( plat, r_zero ) - fi(4) = -omegap * rs2pa * spaz / plat - & * dcmplx( p(1), p(2) ) - end if - end if - else - stop 'ixxxxx: fermion helicity must be +1,-1' - end if - else - stop 'ixxxxx: fermion type must be +1,-1' - end if -c -c do massless fermion case -c - else - if ( nsf .eq. 1 ) then - if ( nhel .eq. 1 ) then - if ( p(3) .ge. r_zero ) then - if ( plat .eq. r_zero ) then - fi(1) = c_zero - fi(2) = c_zero - fi(3) = dcmplx( omegap, r_zero ) - fi(4) = c_zero - else - spaz = sqrt( pabs + p(3) ) - fi(1) = c_zero - fi(2) = c_zero - fi(3) = dcmplx( spaz, r_zero ) - fi(4) = r_one / spaz - & * dcmplx( p(1), p(2) ) - end if - else - if ( plat .eq. r_zero ) then - fi(1) = c_zero - fi(2) = c_zero - fi(3) = c_zero - fi(4) = dcmplx( omegap, r_zero ) - else - spaz = sqrt( pabs - p(3) ) - fi(1) = c_zero - fi(2) = c_zero - fi(3) = r_one / spaz - & * dcmplx( plat, r_zero ) - fi(4) = spaz / plat - & * dcmplx( p(1), p(2) ) - end if - end if - else if ( nhel .eq. -1 ) then - if ( p(3) .ge. r_zero ) then - if ( plat .eq. r_zero ) then - fi(1) = c_zero - fi(2) = dcmplx( omegap, r_zero ) - fi(3) = c_zero - fi(4) = c_zero - else - spaz = sqrt( pabs + p(3) ) - fi(1) = r_one / spaz - & * dcmplx( -p(1), p(2) ) - fi(2) = dcmplx( spaz, r_zero ) - fi(3) = c_zero - fi(4) = c_zero - end if - else - if ( plat .eq. r_zero ) then - fi(1) = dcmplx( -omegap, r_zero ) - fi(2) = c_zero - fi(3) = c_zero - fi(4) = c_zero - else - spaz = sqrt( pabs - p(3) ) - fi(1) = spaz / plat - & * dcmplx( -p(1), p(2) ) - fi(2) = r_one / spaz - & * dcmplx( plat, r_zero ) - fi(3) = c_zero - fi(4) = c_zero - end if - end if - else - stop 'ixxxxx: fermion helicity must be +1,-1' - end if - else if ( nsf .eq. -1 ) then - if ( nhel .eq. 1 ) then - if ( p(3) .ge. r_zero ) then - if ( plat .eq. r_zero ) then - fi(1) = c_zero - fi(2) = dcmplx( -omegap, r_zero ) - fi(3) = c_zero - fi(4) = c_zero - else - spaz = sqrt( pabs + p(3) ) - fi(1) = -r_one / spaz - & * dcmplx( -p(1), p(2) ) - fi(2) = dcmplx( -spaz, r_zero ) - fi(3) = c_zero - fi(4) = c_zero - end if - else - if ( plat .eq. r_zero ) then - fi(1) = dcmplx( omegap, r_zero ) - fi(2) = c_zero - fi(3) = c_zero - fi(4) = c_zero - else - spaz = sqrt( pabs - p(3) ) - fi(1) = -spaz / plat - & * dcmplx( -p(1), p(2) ) - fi(2) = -r_one / spaz - & * dcmplx( plat, r_zero ) - fi(3) = c_zero - fi(4) = c_zero - end if - end if - else if ( nhel .eq. -1 ) then - if ( p(3) .ge. r_zero ) then - if ( plat .eq. r_zero ) then - fi(1) = c_zero - fi(2) = c_zero - fi(3) = dcmplx( -omegap, r_zero ) - fi(4) = c_zero - else - spaz = sqrt( pabs + p(3) ) - fi(1) = c_zero - fi(2) = c_zero - fi(3) = dcmplx( -spaz, r_zero ) - fi(4) = -r_one / spaz - & * dcmplx( p(1), p(2) ) - end if - else - if ( plat .eq. r_zero ) then - fi(1) = c_zero - fi(2) = c_zero - fi(3) = c_zero - fi(4) = dcmplx( -omegap, r_zero ) - else - spaz = sqrt( pabs - p(3) ) - fi(1) = c_zero - fi(2) = c_zero - fi(3) = -r_one / spaz - & * dcmplx( plat, r_zero ) - fi(4) = -spaz / plat - & * dcmplx( p(1), p(2) ) - end if - end if - else - stop 'ixxxxx: fermion helicity must be +1,-1' - end if - else - stop 'ixxxxx: fermion type must be +1,-1' - end if - end if -c -c done -c - return - end subroutine -c -c ---------------------------------------------------------------------- -c - subroutine j3xxxx(fi,fo,gaf,gzf,zmass,zwidth , j3) -c -c this subroutine computes the sum of photon and z currents with the -c suitable weights ( j(w3) = cos(theta_w) j(z) + sin(theta_w) j(a) ). -c the output j3 is useful as an input of vvvxxx, jvvxxx or w3w3xx. -c the photon propagator is given in feynman gauge, and the z propagator -c is given in unitary gauge. -c -c input: -c complex fi(6) : flow-in fermion |fi> -c complex fo(6) : flow-out fermion ) -c - complex*16 fi(6),fo(6),j3(6), - & c0l,c1l,c2l,c3l,csl,c0r,c1r,c2r,c3r,csr,dz,ddif - real*8 gaf(2),gzf(2),q(0:3),zmass,zwidth,zm2,zmw,q2,da,ww, - & cw,sw,gn,gz3l,ga3l -c - real*8 r_zero, r_one - parameter( r_zero=0.0d0, r_one=1.0d0 ) - complex*16 c_imag - c_imag=dcmplx( r_zero, r_one ) -c - j3(5) = fo(5)-fi(5) - j3(6) = fo(6)-fi(6) -c - q(0)=-dble( j3(5)) - q(1)=-dble( j3(6)) - q(2)=-dimag(j3(6)) - q(3)=-dimag(j3(5)) - q2=q(0)**2-(q(1)**2+q(2)**2+q(3)**2) - zm2=zmass**2 - zmw=zmass*zwidth -c - da=r_one/q2 - ww=max(dsign( zmw ,q2),r_zero) - dz=r_one/dcmplx( q2-zm2 , ww ) - ddif=dcmplx( -zm2 , ww )*da*dz -c -c ddif is the difference : ddif=da-dz -c for the running width, use below instead of the above ww,dz and ddif. -c ww=max( zwidth*q2/zmass ,r_zero) -c dz=r_one/dcmplx( q2-zm2 , ww ) -c ddif=dcmplx( -zm2 , ww )*da*dz -c - cw=r_one/sqrt(r_one+(gzf(2)/gaf(2))**2) - sw=sqrt((r_one-cw)*(r_one+cw)) - gn=gaf(2)*sw - gz3l=gzf(1)*cw - ga3l=gaf(1)*sw - c0l= fo(3)*fi(1)+fo(4)*fi(2) - c0r= fo(1)*fi(3)+fo(2)*fi(4) - c1l=-(fo(3)*fi(2)+fo(4)*fi(1)) - c1r= fo(1)*fi(4)+fo(2)*fi(3) - c2l= (fo(3)*fi(2)-fo(4)*fi(1))*c_imag - c2r=(-fo(1)*fi(4)+fo(2)*fi(3))*c_imag - c3l= -fo(3)*fi(1)+fo(4)*fi(2) - c3r= fo(1)*fi(3)-fo(2)*fi(4) - csl=(q(0)*c0l-q(1)*c1l-q(2)*c2l-q(3)*c3l)/zm2 - csr=(q(0)*c0r-q(1)*c1r-q(2)*c2r-q(3)*c3r)/zm2 -c - j3(1) = gz3l*dz*(c0l-csl*q(0))+ga3l*c0l*da - & + gn*(c0r*ddif-csr*q(0)*dz) - j3(2) = gz3l*dz*(c1l-csl*q(1))+ga3l*c1l*da - & + gn*(c1r*ddif-csr*q(1)*dz) - j3(3) = gz3l*dz*(c2l-csl*q(2))+ga3l*c2l*da - & + gn*(c2r*ddif-csr*q(2)*dz) - j3(4) = gz3l*dz*(c3l-csl*q(3))+ga3l*c3l*da - & + gn*(c3r*ddif-csr*q(3)*dz) -c - return - end subroutine -C -C ---------------------------------------------------------------------- -C - SUBROUTINE JEEXXX(EB,EF,SHLF,CHLF,PHI,NHB,NHF,NSF , JEE) -C -C This subroutine computes an off-shell photon wavefunction emitted from -C the electron or positron beam, with a special care for the small angle -C region. The momenta are measured in the laboratory frame, where the -C e- (e+) beam is along the positive (negative) z axis. -C -C INPUT: -C real EB : energy (GeV) of beam e-/e+ -C real EF : energy (GeV) of final e-/e+ -C real SHLF : sin(theta/2) of final e-/e+ -C real CHLF : cos(theta/2) of final e-/e+ -C real PHI : azimuthal angle of final e-/e+ -C integer NHB = -1 or 1 : helicity of beam e-/e+ -C integer NHF = -1 or 1 : helicity of final e-/e+ -C integer NSF = -1 or 1 : +1 for electron, -1 for positron -C -C OUTPUT: -C complex JEE(6) : off-shell photon J^mu() -C - implicit none - COMPLEX*16 JEE(6),COEFF - REAL*8 CS(2),EB,EF,SHLF,CHLF,PHI,ME,ALPHA,GAL,HI,SF,SFH,X,ME2,Q2, - & RFP,RFM,SNP,CSP,RXC,C,S - INTEGER NHB,NHF,NSF -C - ME =0.51099906D-3 - ALPHA=1./128. - GAL =SQRT(ALPHA*4.*3.14159265D0) -C - HI =NHB - SF =NSF - SFH=NHB*NSF - CS((3+NSF)/2)=SHLF - CS((3-NSF)/2)=CHLF -C CS(1)=CHLF and CS(2)=SHLF for electron -C CS(1)=SHLF and CS(2)=CHLF for positron - X=EF/EB - ME2=ME**2 - Q2=-4.*CS(2)**2*(EF*EB-ME2) - & +SF*(1.-X)**2/X*(SHLF+CHLF)*(SHLF-CHLF)*ME2 - RFP=(1+NSF) - RFM=(1-NSF) - SNP=SIN(PHI) - CSP=COS(PHI) -C - IF (NHB.EQ.NHF) THEN - RXC=2.*X/(1.-X)*CS(1)**2 - COEFF= GAL*2.*EB*SQRT(X)*CS(2)/Q2 - & *(dCMPLX( RFP )-RFM*dCMPLX( CSP ,-SNP*HI ))*.5 - JEE(1) = dCMPLX( 0.d0 ) - JEE(2) = COEFF*dCMPLX( (1.+RXC)*CSP ,-SFH*SNP ) - JEE(3) = COEFF*dCMPLX( (1.+RXC)*SNP , SFH*CSP ) - JEE(4) = COEFF*(-SF*RXC/CS(1)*CS(2)) - ELSE - COEFF= GAL*ME/Q2/SQRT(X) - & *(dCMPLX( RFP )+RFM*dCMPLX( CSP , SNP*HI ))*.5*HI - JEE(1) = -COEFF*(1.+X)*CS(2)*dCMPLX( CSP , SFH*SNP ) - JEE(2) = COEFF*(1.-X)*CS(1) - JEE(3) = JEE(2)*dCMPLX( 0.d0 , SFH ) - JEE(4) = JEE(1)*SF*(1.-X)/(1.+X) - ENDIF -C - C=(CHLF+SHLF)*(CHLF-SHLF) - S=2.*CHLF*SHLF -C - JEE(5) = -EB*dCMPLX( 1.-X , SF-X*C ) - JEE(6) = EB*X*S*dCMPLX( CSP , SNP ) -C - RETURN - end subroutine -C -c -c ---------------------------------------------------------------------- -c - subroutine jgggxx(w1,w2,w3,g, jw3w) -c -c this subroutine computes an off-shell w+, w-, w3, z or photon current -c from the four-point gauge boson coupling, including the contributions -c of w exchange diagrams. the vector propagator is given in feynman -c gauge for a photon and in unitary gauge for w and z bosons. if one -c sets wmass=0.0, then the ggg-->g current is given (see sect 2.9.1 of -c the manual). -c -c input: -c complex w1(6) : first vector w1 -c complex w2(6) : second vector w2 -c complex w3(6) : third vector w3 -c real g : first coupling constant -c (see the table below) -c -c output: -c complex jw3w(6) : w current j^mu(w':w1,w2,w3) -c - implicit none - complex*16 w1(6),w2(6),w3(6),jw3w(6) - complex*16 dw1(0:3),dw2(0:3),dw3(0:3), - & jj(0:3),dv,w32,w13 - real*8 p1(0:3),p2(0:3),p3(0:3),q(0:3),g,dg2,q2 -c - real*8 r_zero - parameter( r_zero=0.0d0 ) -c - jw3w(5) = w1(5)+w2(5)+w3(5) - jw3w(6) = w1(6)+w2(6)+w3(6) -c - dw1(0)=dcmplx(w1(1)) - dw1(1)=dcmplx(w1(2)) - dw1(2)=dcmplx(w1(3)) - dw1(3)=dcmplx(w1(4)) - dw2(0)=dcmplx(w2(1)) - dw2(1)=dcmplx(w2(2)) - dw2(2)=dcmplx(w2(3)) - dw2(3)=dcmplx(w2(4)) - dw3(0)=dcmplx(w3(1)) - dw3(1)=dcmplx(w3(2)) - dw3(2)=dcmplx(w3(3)) - dw3(3)=dcmplx(w3(4)) - p1(0)=dble( w1(5)) - p1(1)=dble( w1(6)) - p1(2)=dble(dimag(w1(6))) - p1(3)=dble(dimag(w1(5))) - p2(0)=dble( w2(5)) - p2(1)=dble( w2(6)) - p2(2)=dble(dimag(w2(6))) - p2(3)=dble(dimag(w2(5))) - p3(0)=dble( w3(5)) - p3(1)=dble( w3(6)) - p3(2)=dble(dimag(w3(6))) - p3(3)=dble(dimag(w3(5))) - q(0)=-(p1(0)+p2(0)+p3(0)) - q(1)=-(p1(1)+p2(1)+p3(1)) - q(2)=-(p1(2)+p2(2)+p3(2)) - q(3)=-(p1(3)+p2(3)+p3(3)) - - q2 =q(0)**2 -(q(1)**2 +q(2)**2 +q(3)**2) - - dg2=dble(g)*dble(g) -c - dv = 1.0d0/dcmplx( q2 ) - -c for the running width, use below instead of the above dv. -c dv = 1.0d0/dcmplx( q2 -mv2 , dmax1(dwv*q2/dmv,0.d0) ) -c - w32=dw3(0)*dw2(0)-dw3(1)*dw2(1)-dw3(2)*dw2(2)-dw3(3)*dw2(3) -c -c - w13=dw1(0)*dw3(0)-dw1(1)*dw3(1)-dw1(2)*dw3(2)-dw1(3)*dw3(3) -c - jj(0)=dg2*( dw1(0)*w32 - dw2(0)*w13 ) - jj(1)=dg2*( dw1(1)*w32 - dw2(1)*w13 ) - jj(2)=dg2*( dw1(2)*w32 - dw2(2)*w13 ) - jj(3)=dg2*( dw1(3)*w32 - dw2(3)*w13 ) -c - jw3w(1) = dcmplx( jj(0)*dv ) - jw3w(2) = dcmplx( jj(1)*dv ) - jw3w(3) = dcmplx( jj(2)*dv ) - jw3w(4) = dcmplx( jj(3)*dv ) -c - return - end subroutine -c -c ---------------------------------------------------------------------- -c - subroutine jggxxx(v1,v2,g, jvv) -c -c this subroutine computes an off-shell vector current from the three- -c point gauge boson coupling. the vector propagator is given in feynman -c gauge for a massless vector and in unitary gauge for a massive vector. -c -c input: -c complex v1(6) : first vector v1 -c complex v2(6) : second vector v2 -c real g : coupling constant (see the table below) -c -c output: -c complex jvv(6) : vector current j^mu(v:v1,v2) -c - complex*16 v1(6),v2(6),jvv(6),j12(0:3), - & sv1,sv2,v12 - real*8 p1(0:3),p2(0:3),q(0:3),g,gs,s -c - real*8 r_zero - parameter( r_zero=0.0d0 ) -c - jvv(5) = v1(5)+v2(5) - jvv(6) = v1(6)+v2(6) -c - p1(0)=dble( v1(5)) - p1(1)=dble( v1(6)) - p1(2)=dimag(v1(6)) - p1(3)=dimag(v1(5)) - p2(0)=dble( v2(5)) - p2(1)=dble( v2(6)) - p2(2)=dimag(v2(6)) - p2(3)=dimag(v2(5)) - q(0)=-dble( jvv(5)) - q(1)=-dble( jvv(6)) - q(2)=-dimag(jvv(6)) - q(3)=-dimag(jvv(5)) - s=q(0)**2-(q(1)**2+q(2)**2+q(3)**2) -c - v12=v1(1)*v2(1)-v1(2)*v2(2)-v1(3)*v2(3)-v1(4)*v2(4) - sv1= (p2(0)-q(0))*v1(1) -(p2(1)-q(1))*v1(2) - & -(p2(2)-q(2))*v1(3) -(p2(3)-q(3))*v1(4) - sv2=-(p1(0)-q(0))*v2(1) +(p1(1)-q(1))*v2(2) - & +(p1(2)-q(2))*v2(3) +(p1(3)-q(3))*v2(4) - j12(0)=(p1(0)-p2(0))*v12 +sv1*v2(1) +sv2*v1(1) - j12(1)=(p1(1)-p2(1))*v12 +sv1*v2(2) +sv2*v1(2) - j12(2)=(p1(2)-p2(2))*v12 +sv1*v2(3) +sv2*v1(3) - j12(3)=(p1(3)-p2(3))*v12 +sv1*v2(4) +sv2*v1(4) -c - gs=-g/s -c - jvv(1) = gs*j12(0) - jvv(2) = gs*j12(1) - jvv(3) = gs*j12(2) - jvv(4) = gs*j12(3) -c - return - end subroutine -c -c ---------------------------------------------------------------------- -c - subroutine jioxxx(fi,fo,g,vmass,vwidth , jio) -c -c this subroutine computes an off-shell vector current from an external -c fermion pair. the vector boson propagator is given in feynman gauge -c for a massless vector and in unitary gauge for a massive vector. -c -c input: -c complex fi(6) : flow-in fermion |fi> -c complex fo(6) : flow-out fermion ) -c - complex*16 fi(6),fo(6),jio(6),c0,c1,c2,c3,cs,d - real*8 g(2),q(0:3),vmass,vwidth,q2,vm2,dd -c - real*8 r_zero, r_one - parameter( r_zero=0.0d0, r_one=1.0d0 ) - complex*16 c_imag - c_imag=dcmplx( r_zero, r_one ) -c - jio(5) = fo(5)-fi(5) - jio(6) = fo(6)-fi(6) -c - q(0)=dble( jio(5)) - q(1)=dble( jio(6)) - q(2)=dimag(jio(6)) - q(3)=dimag(jio(5)) - q2=q(0)**2-(q(1)**2+q(2)**2+q(3)**2) - vm2=vmass**2 -c - if (vmass.ne.r_zero) then -c - d=r_one/dcmplx( q2-vm2 , max(sign( vmass*vwidth ,q2),r_zero) ) -c for the running width, use below instead of the above d. -c d=r_one/dcmplx( q2-vm2 , max( vwidth*q2/vmass ,r_zero) ) -c - if (g(2).ne.r_zero) then -c - c0= g(1)*( fo(3)*fi(1)+fo(4)*fi(2)) - & +g(2)*( fo(1)*fi(3)+fo(2)*fi(4)) - c1= -g(1)*( fo(3)*fi(2)+fo(4)*fi(1)) - & +g(2)*( fo(1)*fi(4)+fo(2)*fi(3)) - c2=( g(1)*( fo(3)*fi(2)-fo(4)*fi(1)) - & +g(2)*(-fo(1)*fi(4)+fo(2)*fi(3)))*c_imag - c3= g(1)*(-fo(3)*fi(1)+fo(4)*fi(2)) - & +g(2)*( fo(1)*fi(3)-fo(2)*fi(4)) - else -c - d=d*g(1) - c0= fo(3)*fi(1)+fo(4)*fi(2) - c1= -fo(3)*fi(2)-fo(4)*fi(1) - c2=( fo(3)*fi(2)-fo(4)*fi(1))*c_imag - c3= -fo(3)*fi(1)+fo(4)*fi(2) - end if -c - cs=(q(0)*c0-q(1)*c1-q(2)*c2-q(3)*c3)/vm2 -c - jio(1) = (c0-cs*q(0))*d - jio(2) = (c1-cs*q(1))*d - jio(3) = (c2-cs*q(2))*d - jio(4) = (c3-cs*q(3))*d -c - else - dd=r_one/q2 -c - if (g(2).ne.r_zero) then - jio(1) = ( g(1)*( fo(3)*fi(1)+fo(4)*fi(2)) - & +g(2)*( fo(1)*fi(3)+fo(2)*fi(4)) )*dd - jio(2) = (-g(1)*( fo(3)*fi(2)+fo(4)*fi(1)) - & +g(2)*( fo(1)*fi(4)+fo(2)*fi(3)) )*dd - jio(3) = ( g(1)*( fo(3)*fi(2)-fo(4)*fi(1)) - & +g(2)*(-fo(1)*fi(4)+fo(2)*fi(3))) - $ *dcmplx(r_zero,dd) - jio(4) = ( g(1)*(-fo(3)*fi(1)+fo(4)*fi(2)) - & +g(2)*( fo(1)*fi(3)-fo(2)*fi(4)) )*dd -c - else - dd=dd*g(1) -c - jio(1) = ( fo(3)*fi(1)+fo(4)*fi(2))*dd - jio(2) = -( fo(3)*fi(2)+fo(4)*fi(1))*dd - jio(3) = ( fo(3)*fi(2)-fo(4)*fi(1))*dcmplx(r_zero,dd) - jio(4) = (-fo(3)*fi(1)+fo(4)*fi(2))*dd - end if - end if -c - return - end subroutine -C ---------------------------------------------------------------------- -C - SUBROUTINE JSSXXX(S1,S2,G,VMASS,VWIDTH , JSS) -C -C This subroutine computes an off-shell vector current from the vector- -C scalar-scalar coupling. The coupling is absent in the minimal SM in -C unitary gauge. The propagator is given in Feynman gauge for a -C massless vector and in unitary gauge for a massive vector. -C -C INPUT: -C complex S1(3) : first scalar S1 -C complex S2(3) : second scalar S2 -C real G : coupling constant (S1 charge) -C real VMASS : mass of OUTPUT vector V -C real VWIDTH : width of OUTPUT vector V -C -C Examples of the coupling constant G for SUSY particles are as follows: -C ----------------------------------------------------------- -C | S1 | (Q,I3) of S1 || V=A | V=Z | V=W | -C ----------------------------------------------------------- -C | nu~_L | ( 0 , +1/2) || --- | GZN(1) | GWF(1) | -C | e~_L | ( -1 , -1/2) || GAL(1) | GZL(1) | GWF(1) | -C | u~_L | (+2/3 , +1/2) || GAU(1) | GZU(1) | GWF(1) | -C | d~_L | (-1/3 , -1/2) || GAD(1) | GZD(1) | GWF(1) | -C ----------------------------------------------------------- -C | e~_R-bar | ( +1 , 0 ) || -GAL(2) | -GZL(2) | -GWF(2) | -C | u~_R-bar | (-2/3 , 0 ) || -GAU(2) | -GZU(2) | -GWF(2) | -C | d~_R-bar | (+1/3 , 0 ) || -GAD(2) | -GZD(2) | -GWF(2) | -C ----------------------------------------------------------- -C where the S1 charge is defined by the flowing-OUT quantum number. -C -C OUTPUT: -C complex JSS(6) : vector current J^mu(V:S1,S2) -C - implicit none - COMPLEX*16 S1(3),S2(3),JSS(6),DG,ADG - REAL*8 PP(0:3),PA(0:3),Q(0:3),G,VMASS,VWIDTH,Q2,VM2,MP2,MA2,M2D -C - JSS(5) = S1(2)+S2(2) - JSS(6) = S1(3)+S2(3) -C - Q(0)=dble( JSS(5)) - Q(1)=dble( JSS(6)) - Q(2)=dIMAG(JSS(6)) - Q(3)=dIMAG(JSS(5)) - Q2=Q(0)**2-(Q(1)**2+Q(2)**2+Q(3)**2) - VM2=VMASS**2 -C - IF (VMASS.EQ.0.) GOTO 10 -C - DG=G/dCMPLX( Q2-VM2, MAX(SIGN( VMASS*VWIDTH ,Q2),0.d0)) -C For the running width, use below instead of the above DG. -C DG=G/dCMPLX( Q2-VM2 , MAX( VWIDTH*Q2/VMASS ,0.) ) -C - ADG=DG*S1(1)*S2(1) -C - PP(0)=dble( S1(2)) - PP(1)=dble( S1(3)) - PP(2)=dIMAG(S1(3)) - PP(3)=dIMAG(S1(2)) - PA(0)=dble( S2(2)) - PA(1)=dble( S2(3)) - PA(2)=dIMAG(S2(3)) - PA(3)=dIMAG(S2(2)) - MP2=PP(0)**2-(PP(1)**2+PP(2)**2+PP(3)**2) - MA2=PA(0)**2-(PA(1)**2+PA(2)**2+PA(3)**2) - M2D=MP2-MA2 -C - JSS(1) = ADG*( (PP(0)-PA(0)) - Q(0)*M2D/VM2) - JSS(2) = ADG*( (PP(1)-PA(1)) - Q(1)*M2D/VM2) - JSS(3) = ADG*( (PP(2)-PA(2)) - Q(2)*M2D/VM2) - JSS(4) = ADG*( (PP(3)-PA(3)) - Q(3)*M2D/VM2) -C - RETURN -C - 10 ADG=G*S1(1)*S2(1)/Q2 -C - JSS(1) = ADG*dble( S1(2)-S2(2)) - JSS(2) = ADG*dble( S1(3)-S2(3)) - JSS(3) = ADG*dIMAG(S1(3)-S2(3)) - JSS(4) = ADG*dIMAG(S1(2)-S2(2)) -C - RETURN - end subroutine -C -c -c ---------------------------------------------------------------------- -c - subroutine jtioxx(fi,fo,g , jio) -c -c this subroutine computes an off-shell vector current from an external -c fermion pair. the vector boson propagator is not included in this -c routine. -c -c input: -c complex fi(6) : flow-in fermion |fi> -c complex fo(6) : flow-out fermion ) -c - complex*16 fi(6),fo(6),jio(6) - real*8 g(2) -c - real*8 r_zero, r_one - parameter( r_zero=0.0d0, r_one=1.0d0 ) - complex*16 c_imag - c_imag=dcmplx( r_zero, r_one ) -c - jio(5) = fo(5)-fi(5) - jio(6) = fo(6)-fi(6) -c - if ( g(2) .ne. r_zero ) then - jio(1) = ( g(1)*( fo(3)*fi(1)+fo(4)*fi(2)) - & +g(2)*( fo(1)*fi(3)+fo(2)*fi(4)) ) - jio(2) = (-g(1)*( fo(3)*fi(2)+fo(4)*fi(1)) - & +g(2)*( fo(1)*fi(4)+fo(2)*fi(3)) ) - jio(3) = ( g(1)*( fo(3)*fi(2)-fo(4)*fi(1)) - & +g(2)*(-fo(1)*fi(4)+fo(2)*fi(3)) )*c_imag - jio(4) = ( g(1)*(-fo(3)*fi(1)+fo(4)*fi(2)) - & +g(2)*( fo(1)*fi(3)-fo(2)*fi(4)) ) -c - else - jio(1) = ( fo(3)*fi(1)+fo(4)*fi(2))*g(1) - jio(2) = -( fo(3)*fi(2)+fo(4)*fi(1))*g(1) - jio(3) = ( fo(3)*fi(2)-fo(4)*fi(1))*dcmplx(r_zero,g(1)) - jio(4) = (-fo(3)*fi(1)+fo(4)*fi(2))*g(1) - end if -c - return - end subroutine -C ---------------------------------------------------------------------- -C - SUBROUTINE JVSSXX(VC,S1,S2,G,VMASS,VWIDTH , JVSS) -C -C This subroutine computes an off-shell vector current from the vector- -C vector-scalar-scalar coupling. The vector propagator is given in -C Feynman gauge for a massless vector and in unitary gauge for a massive -C vector. -C -C INPUT: -C complex VC(6) : input vector V -C complex S1(3) : first scalar S1 -C complex S2(3) : second scalar S2 -C real G : coupling constant GVVHH -C real VMASS : mass of OUTPUT vector V' -C real VWIDTH : width of OUTPUT vector V' -C -C OUTPUT: -C complex JVSS(6) : vector current J^mu(V':V,S1,S2) -C - implicit none - COMPLEX*16 VC(6),S1(3),S2(3),JVSS(6),DG - REAL*8 Q(0:3),G,VMASS,VWIDTH,Q2,VK,VM2 -C - JVSS(5) = VC(5)+S1(2)+S2(2) - JVSS(6) = VC(6)+S1(3)+S2(3) -C - Q(0)=dble( JVSS(5)) - Q(1)=dble( JVSS(6)) - Q(2)=dIMAG(JVSS(6)) - Q(3)=dIMAG(JVSS(5)) - Q2=Q(0)**2-(Q(1)**2+Q(2)**2+Q(3)**2) - VM2=VMASS**2 -C - IF (VMASS.EQ.0.) GOTO 10 -C - DG=G*S1(1)*S2(1)/dCMPLX( Q2-VM2,MAX(SIGN( VMASS*VWIDTH,Q2),0.d0)) -C For the running width, use below instead of the above DG. -C DG=G*S1(1)*S2(1)/CMPLX( Q2-VM2 , MAX( VWIDTH*Q2/VMASS ,0.)) -C - VK=(Q(0)*VC(1)-Q(1)*VC(2)-Q(2)*VC(3)-Q(3)*VC(4))/VM2 -C - JVSS(1) = DG*(VC(1)-VK*Q(0)) - JVSS(2) = DG*(VC(2)-VK*Q(1)) - JVSS(3) = DG*(VC(3)-VK*Q(2)) - JVSS(4) = DG*(VC(4)-VK*Q(3)) -C - RETURN -C - 10 DG= G*S1(1)*S2(1)/Q2 -C - JVSS(1) = DG*VC(1) - JVSS(2) = DG*VC(2) - JVSS(3) = DG*VC(3) - JVSS(4) = DG*VC(4) -C - RETURN - end subroutine -C -c -c ---------------------------------------------------------------------- -c - subroutine jvsxxx(vc,sc,g,vmass,vwidth , jvs) - implicit real*8(a-h,o-z) -c -c this subroutine computes an off-shell vector current from the vector- -c vector-scalar coupling. the vector propagator is given in feynman -c gauge for a massless vector and in unitary gauge for a massive vector. -c -c input: -c complex vc(6) : input vector v -c complex sc(3) : input scalar s -c real g : coupling constant gvvh -c real vmass : mass of output vector v' -c real vwidth : width of output vector v' -c -c output: -c complex jvs(6) : vector current j^mu(v':v,s) -c - complex*16 vc(6),sc(3),jvs(6),dg,vk - real*8 q(0:3),vmass,vwidth,q2,vm2,g -c - jvs(5) = vc(5)+sc(2) - jvs(6) = vc(6)+sc(3) -c - q(0)=dble( jvs(5)) - q(1)=dble( jvs(6)) - q(2)=dimag(jvs(6)) - q(3)=dimag(jvs(5)) - q2=q(0)**2-(q(1)**2+q(2)**2+q(3)**2) - vm2=vmass**2 -c - if (vmass.eq.0.) goto 10 -c - dg=g*sc(1)/dcmplx( q2-vm2 , max(dsign( vmass*vwidth ,q2),0.d0) ) -c for the running width, use below instead of the above dg. -c dg=g*sc(1)/dcmplx( q2-vm2 , max( vwidth*q2/vmass ,0.) ) -c - vk=(-q(0)*vc(1)+q(1)*vc(2)+q(2)*vc(3)+q(3)*vc(4))/vm2 -c - jvs(1) = dg*(q(0)*vk+vc(1)) - jvs(2) = dg*(q(1)*vk+vc(2)) - jvs(3) = dg*(q(2)*vk+vc(3)) - jvs(4) = dg*(q(3)*vk+vc(4)) -c - return -c - 10 dg=g*sc(1)/q2 -c - jvs(1) = dg*vc(1) - jvs(2) = dg*vc(2) - jvs(3) = dg*vc(3) - jvs(4) = dg*vc(4) -c - return - end subroutine - - -c -c ---------------------------------------------------------------------- -c - subroutine jvvxxx(v1,v2,g,vmass,vwidth , jvv) -c -c this subroutine computes an off-shell vector current from the three- -c point gauge boson coupling. the vector propagator is given in feynman -c gauge for a massless vector and in unitary gauge for a massive vector. -c -c input: -c complex v1(6) : first vector v1 -c complex v2(6) : second vector v2 -c real g : coupling constant (see the table below) -c real vmass : mass of output vector v -c real vwidth : width of output vector v -c -c the possible sets of the inputs are as follows: -c ------------------------------------------------------------------ -c | v1 | v2 | jvv | g | vmass | vwidth | -c ------------------------------------------------------------------ -c | w- | w+ | a/z | gwwa/gwwz | 0./zmass | 0./zwidth | -c | w3/a/z | w- | w+ | gw/gwwa/gwwz | wmass | wwidth | -c | w+ | w3/a/z | w- | gw/gwwa/gwwz | wmass | wwidth | -c ------------------------------------------------------------------ -c where all the bosons are defined by the flowing-out quantum number. -c -c output: -c complex jvv(6) : vector current j^mu(v:v1,v2) -c - complex*16 v1(6),v2(6),jvv(6),j12(0:3),js,dg, - & sv1,sv2,s11,s12,s21,s22,v12 - real*8 p1(0:3),p2(0:3),q(0:3),g,vmass,vwidth,gs,s,vm2,m1,m2 -c - real*8 r_zero - parameter( r_zero=0.0d0 ) -c - jvv(5) = v1(5)+v2(5) - jvv(6) = v1(6)+v2(6) -c - p1(0)=dble( v1(5)) - p1(1)=dble( v1(6)) - p1(2)=dimag(v1(6)) - p1(3)=dimag(v1(5)) - p2(0)=dble( v2(5)) - p2(1)=dble( v2(6)) - p2(2)=dimag(v2(6)) - p2(3)=dimag(v2(5)) - q(0)=-dble( jvv(5)) - q(1)=-dble( jvv(6)) - q(2)=-dimag(jvv(6)) - q(3)=-dimag(jvv(5)) - s=q(0)**2-(q(1)**2+q(2)**2+q(3)**2) -c - v12=v1(1)*v2(1)-v1(2)*v2(2)-v1(3)*v2(3)-v1(4)*v2(4) - sv1= (p2(0)-q(0))*v1(1) -(p2(1)-q(1))*v1(2) - & -(p2(2)-q(2))*v1(3) -(p2(3)-q(3))*v1(4) - sv2=-(p1(0)-q(0))*v2(1) +(p1(1)-q(1))*v2(2) - & +(p1(2)-q(2))*v2(3) +(p1(3)-q(3))*v2(4) - j12(0)=(p1(0)-p2(0))*v12 +sv1*v2(1) +sv2*v1(1) - j12(1)=(p1(1)-p2(1))*v12 +sv1*v2(2) +sv2*v1(2) - j12(2)=(p1(2)-p2(2))*v12 +sv1*v2(3) +sv2*v1(3) - j12(3)=(p1(3)-p2(3))*v12 +sv1*v2(4) +sv2*v1(4) -c - if ( vmass .ne. r_zero ) then - vm2=vmass**2 - m1=p1(0)**2-(p1(1)**2+p1(2)**2+p1(3)**2) - m2=p2(0)**2-(p2(1)**2+p2(2)**2+p2(3)**2) - s11=p1(0)*v1(1)-p1(1)*v1(2)-p1(2)*v1(3)-p1(3)*v1(4) - s12=p1(0)*v2(1)-p1(1)*v2(2)-p1(2)*v2(3)-p1(3)*v2(4) - s21=p2(0)*v1(1)-p2(1)*v1(2)-p2(2)*v1(3)-p2(3)*v1(4) - s22=p2(0)*v2(1)-p2(1)*v2(2)-p2(2)*v2(3)-p2(3)*v2(4) - js=(v12*(-m1+m2) +s11*s12 -s21*s22)/vm2 -c - dg=-g/dcmplx( s-vm2 , max(sign( vmass*vwidth ,s),r_zero) ) -c -c for the running width, use below instead of the above dg. -c dg=-g/dcmplx( s-vm2 , max( vwidth*s/vmass ,r_zero) ) -c - jvv(1) = dg*(j12(0)-q(0)*js) - jvv(2) = dg*(j12(1)-q(1)*js) - jvv(3) = dg*(j12(2)-q(2)*js) - jvv(4) = dg*(j12(3)-q(3)*js) -c - else - gs=-g/s -c - jvv(1) = gs*j12(0) - jvv(2) = gs*j12(1) - jvv(3) = gs*j12(2) - jvv(4) = gs*j12(3) - end if -c - return - end subroutine -c -c ---------------------------------------------------------------------- -c - subroutine jw3wxx(w1,w2,w3,g1,g2,wmass,wwidth,vmass,vwidth , jw3w) -c -c this subroutine computes an off-shell w+, w-, w3, z or photon current -c from the four-point gauge boson coupling, including the contributions -c of w exchange diagrams. the vector propagator is given in feynman -c gauge for a photon and in unitary gauge for w and z bosons. if one -c sets wmass=0.0, then the ggg-->g current is given (see sect 2.9.1 of -c the manual). -c -c input: -c complex w1(6) : first vector w1 -c complex w2(6) : second vector w2 -c complex w3(6) : third vector w3 -c real g1 : first coupling constant -c real g2 : second coupling constant -c (see the table below) -c real wmass : mass of internal w -c real wwidth : width of internal w -c real vmass : mass of output w' -c real vwidth : width of output w' -c -c the possible sets of the inputs are as follows: -c ------------------------------------------------------------------- -c | w1 | w2 | w3 | g1 | g2 |wmass|wwidth|vmass|vwidth || jw3w | -c ------------------------------------------------------------------- -c | w- | w3 | w+ | gw |gwwz|wmass|wwidth|zmass|zwidth || z | -c | w- | w3 | w+ | gw |gwwa|wmass|wwidth| 0. | 0. || a | -c | w- | z | w+ |gwwz|gwwz|wmass|wwidth|zmass|zwidth || z | -c | w- | z | w+ |gwwz|gwwa|wmass|wwidth| 0. | 0. || a | -c | w- | a | w+ |gwwa|gwwz|wmass|wwidth|zmass|zwidth || z | -c | w- | a | w+ |gwwa|gwwa|wmass|wwidth| 0. | 0. || a | -c ------------------------------------------------------------------- -c | w3 | w- | w3 | gw | gw |wmass|wwidth|wmass|wwidth || w+ | -c | w3 | w+ | w3 | gw | gw |wmass|wwidth|wmass|wwidth || w- | -c | w3 | w- | z | gw |gwwz|wmass|wwidth|wmass|wwidth || w+ | -c | w3 | w+ | z | gw |gwwz|wmass|wwidth|wmass|wwidth || w- | -c | w3 | w- | a | gw |gwwa|wmass|wwidth|wmass|wwidth || w+ | -c | w3 | w+ | a | gw |gwwa|wmass|wwidth|wmass|wwidth || w- | -c | z | w- | z |gwwz|gwwz|wmass|wwidth|wmass|wwidth || w+ | -c | z | w+ | z |gwwz|gwwz|wmass|wwidth|wmass|wwidth || w- | -c | z | w- | a |gwwz|gwwa|wmass|wwidth|wmass|wwidth || w+ | -c | z | w+ | a |gwwz|gwwa|wmass|wwidth|wmass|wwidth || w- | -c | a | w- | a |gwwa|gwwa|wmass|wwidth|wmass|wwidth || w+ | -c | a | w+ | a |gwwa|gwwa|wmass|wwidth|wmass|wwidth || w- | -c ------------------------------------------------------------------- -c where all the bosons are defined by the flowing-out quantum number. -c -c output: -c complex jw3w(6) : w current j^mu(w':w1,w2,w3) -c - complex*16 w1(6),w2(6),w3(6),jw3w(6) - complex*16 dw1(0:3),dw2(0:3),dw3(0:3), - & jj(0:3),j4(0:3), - & dv,w12,w32,w13, - & jq - real*8 g1,g2,wmass,wwidth,vmass,vwidth - real*8 p1(0:3),p2(0:3),p3(0:3),q(0:3), - & dg2,dmv,dwv,mv2,q2 -c - real*8 r_zero - parameter( r_zero=0.0d0 ) -c - jw3w(5) = w1(5)+w2(5)+w3(5) - jw3w(6) = w1(6)+w2(6)+w3(6) -c - dw1(0)=dcmplx(w1(1)) - dw1(1)=dcmplx(w1(2)) - dw1(2)=dcmplx(w1(3)) - dw1(3)=dcmplx(w1(4)) - dw2(0)=dcmplx(w2(1)) - dw2(1)=dcmplx(w2(2)) - dw2(2)=dcmplx(w2(3)) - dw2(3)=dcmplx(w2(4)) - dw3(0)=dcmplx(w3(1)) - dw3(1)=dcmplx(w3(2)) - dw3(2)=dcmplx(w3(3)) - dw3(3)=dcmplx(w3(4)) - p1(0)=dble( w1(5)) - p1(1)=dble( w1(6)) - p1(2)=dble(dimag(w1(6))) - p1(3)=dble(dimag(w1(5))) - p2(0)=dble( w2(5)) - p2(1)=dble( w2(6)) - p2(2)=dble(dimag(w2(6))) - p2(3)=dble(dimag(w2(5))) - p3(0)=dble( w3(5)) - p3(1)=dble( w3(6)) - p3(2)=dble(dimag(w3(6))) - p3(3)=dble(dimag(w3(5))) - q(0)=-(p1(0)+p2(0)+p3(0)) - q(1)=-(p1(1)+p2(1)+p3(1)) - q(2)=-(p1(2)+p2(2)+p3(2)) - q(3)=-(p1(3)+p2(3)+p3(3)) - - - q2 =q(0)**2 -(q(1)**2 +q(2)**2 +q(3)**2) - dg2=dble(g1)*dble(g2) - dmv=dble(vmass) - dwv=dble(vwidth) - mv2=dmv**2 - if (vmass.eq. r_zero) then - dv = 1.0d0/dcmplx( q2 ) - else - dv = 1.0d0/dcmplx( q2 -mv2 , dmax1(dsign(dmv*dwv,q2 ),0.d0) ) - endif -c for the running width, use below instead of the above dv. -c dv = 1.0d0/dcmplx( q2 -mv2 , dmax1(dwv*q2/dmv,0.d0) ) -c - w12=dw1(0)*dw2(0)-dw1(1)*dw2(1)-dw1(2)*dw2(2)-dw1(3)*dw2(3) - w32=dw3(0)*dw2(0)-dw3(1)*dw2(1)-dw3(2)*dw2(2)-dw3(3)*dw2(3) -c - if ( wmass .ne. r_zero ) then - w13=dw1(0)*dw3(0)-dw1(1)*dw3(1)-dw1(2)*dw3(2)-dw1(3)*dw3(3) -c - j4(0)=dg2*( dw1(0)*w32 + dw3(0)*w12 - 2.d0*dw2(0)*w13 ) - j4(1)=dg2*( dw1(1)*w32 + dw3(1)*w12 - 2.d0*dw2(1)*w13 ) - j4(2)=dg2*( dw1(2)*w32 + dw3(2)*w12 - 2.d0*dw2(2)*w13 ) - j4(3)=dg2*( dw1(3)*w32 + dw3(3)*w12 - 2.d0*dw2(3)*w13 ) -c - jj(0)=j4(0) - jj(1)=j4(1) - jj(2)=j4(2) - jj(3)=j4(3) - - else -c - w12=dw1(0)*dw2(0)-dw1(1)*dw2(1)-dw1(2)*dw2(2)-dw1(3)*dw2(3) - w32=dw3(0)*dw2(0)-dw3(1)*dw2(1)-dw3(2)*dw2(2)-dw3(3)*dw2(3) - w13=dw1(0)*dw3(0)-dw1(1)*dw3(1)-dw1(2)*dw3(2)-dw1(3)*dw3(3) -c - j4(0)=dg2*( dw1(0)*w32 - dw2(0)*w13 ) - j4(1)=dg2*( dw1(1)*w32 - dw2(1)*w13 ) - j4(2)=dg2*( dw1(2)*w32 - dw2(2)*w13 ) - j4(3)=dg2*( dw1(3)*w32 - dw2(3)*w13 ) -c - jj(0)=j4(0) - jj(1)=j4(1) - jj(2)=j4(2) - jj(3)=j4(3) - - end if -c - if ( vmass .ne. r_zero ) then -c - jq=(jj(0)*q(0)-jj(1)*q(1)-jj(2)*q(2)-jj(3)*q(3))/mv2 -c - jw3w(1) = dcmplx( (jj(0)-jq*q(0))*dv ) - jw3w(2) = dcmplx( (jj(1)-jq*q(1))*dv ) - jw3w(3) = dcmplx( (jj(2)-jq*q(2))*dv ) - jw3w(4) = dcmplx( (jj(3)-jq*q(3))*dv ) -c - else -c - jw3w(1) = dcmplx( jj(0)*dv ) - jw3w(2) = dcmplx( jj(1)*dv ) - jw3w(3) = dcmplx( jj(2)*dv ) - jw3w(4) = dcmplx( jj(3)*dv ) - end if -c - return - end subroutine -c -c ---------------------------------------------------------------------- -c - subroutine jwwwxx(w1,w2,w3,gwwa,gwwz,zmass,zwidth,wmass,wwidth , - & jwww) -c -c this subroutine computes an off-shell w+/w- current from the four- -c point gauge boson coupling, including the contributions of photon and -c z exchanges. the vector propagators for the output w and the internal -c z bosons are given in unitary gauge, and that of the internal photon -c is given in feynman gauge. -c -c input: -c complex w1(6) : first vector w1 -c complex w2(6) : second vector w2 -c complex w3(6) : third vector w3 -c real gwwa : coupling constant of w and a gwwa -c real gwwz : coupling constant of w and z gwwz -c real zmass : mass of internal z -c real zwidth : width of internal z -c real wmass : mass of output w -c real wwidth : width of output w -c -c the possible sets of the inputs are as follows: -c ------------------------------------------------------------------- -c | w1 | w2 | w3 |gwwa|gwwz|zmass|zwidth|wmass|wwidth || jwww | -c ------------------------------------------------------------------- -c | w- | w+ | w- |gwwa|gwwz|zmass|zwidth|wmass|wwidth || w+ | -c | w+ | w- | w+ |gwwa|gwwz|zmass|zwidth|wmass|wwidth || w- | -c ------------------------------------------------------------------- -c where all the bosons are defined by the flowing-out quantum number. -c -c output: -c complex jwww(6) : w current j^mu(w':w1,w2,w3) -c - complex*16 w1(6),w2(6),w3(6),jwww(6) - complex*16 dw1(0:3),dw2(0:3),dw3(0:3), - & jj(0:3),js(0:3),jt(0:3),j4(0:3), - & jt12(0:3),jt32(0:3),j12(0:3),j32(0:3), - & dzs,dzt,dw,w12,w32,w13,p1w2,p2w1,p3w2,p2w3, - & jk12,jk32,jsw3,jtw1,p3js,ksw3,p1jt,ktw1,jq - real*8 gwwa,gwwz,zmass,zwidth,wmass,wwidth - real*8 p1(0:3),p2(0:3),p3(0:3),q(0:3),ks(0:3),kt(0:3), - & dgwwa2,dgwwz2,dgw2,dmz,dwz,dmw,dww,mz2,mw2,q2,ks2,kt2, - & das,dat -c - jwww(5) = w1(5)+w2(5)+w3(5) - jwww(6) = w1(6)+w2(6)+w3(6) -c - dw1(0)=dcmplx(w1(1)) - dw1(1)=dcmplx(w1(2)) - dw1(2)=dcmplx(w1(3)) - dw1(3)=dcmplx(w1(4)) - dw2(0)=dcmplx(w2(1)) - dw2(1)=dcmplx(w2(2)) - dw2(2)=dcmplx(w2(3)) - dw2(3)=dcmplx(w2(4)) - dw3(0)=dcmplx(w3(1)) - dw3(1)=dcmplx(w3(2)) - dw3(2)=dcmplx(w3(3)) - dw3(3)=dcmplx(w3(4)) - p1(0)=dble( w1(5)) - p1(1)=dble( w1(6)) - p1(2)=dble(dimag(w1(6))) - p1(3)=dble(dimag(w1(5))) - p2(0)=dble( w2(5)) - p2(1)=dble( w2(6)) - p2(2)=dble(dimag(w2(6))) - p2(3)=dble(dimag(w2(5))) - p3(0)=dble( w3(5)) - p3(1)=dble( w3(6)) - p3(2)=dble(dimag(w3(6))) - p3(3)=dble(dimag(w3(5))) - q(0)=-(p1(0)+p2(0)+p3(0)) - q(1)=-(p1(1)+p2(1)+p3(1)) - q(2)=-(p1(2)+p2(2)+p3(2)) - q(3)=-(p1(3)+p2(3)+p3(3)) - ks(0)=p1(0)+p2(0) - ks(1)=p1(1)+p2(1) - ks(2)=p1(2)+p2(2) - ks(3)=p1(3)+p2(3) - kt(0)=p2(0)+p3(0) - kt(1)=p2(1)+p3(1) - kt(2)=p2(2)+p3(2) - kt(3)=p2(3)+p3(3) - q2 =q(0)**2 -(q(1)**2 +q(2)**2 +q(3)**2) - ks2=ks(0)**2-(ks(1)**2+ks(2)**2+ks(3)**2) - kt2=kt(0)**2-(kt(1)**2+kt(2)**2+kt(3)**2) - dgwwa2=dble(gwwa)**2 - dgwwz2=dble(gwwz)**2 - dgw2 =dgwwa2+dgwwz2 - dmz=dble(zmass) - dwz=dble(zwidth) - dmw=dble(wmass) - dww=dble(wwidth) - mz2=dmz**2 - mw2=dmw**2 -c - das=-dgwwa2/ks2 - dat=-dgwwa2/kt2 - dzs=-dgwwz2/dcmplx( ks2-mz2 , dmax1(dsign(dmz*dwz,ks2),0.d0) ) - dzt=-dgwwz2/dcmplx( kt2-mz2 , dmax1(dsign(dmz*dwz,kt2),0.d0) ) - dw =-1.0d0/dcmplx( q2 -mw2 , dmax1(dsign(dmw*dww,q2 ),0.d0) ) -c for the running width, use below instead of the above dw. -c dw =-1.0d0/dcmplx( q2 -mw2 , dmax1(dww*q2/dmw,0.d0) ) -c - w12=dw1(0)*dw2(0)-dw1(1)*dw2(1)-dw1(2)*dw2(2)-dw1(3)*dw2(3) - w32=dw3(0)*dw2(0)-dw3(1)*dw2(1)-dw3(2)*dw2(2)-dw3(3)*dw2(3) -c - p1w2= (p1(0)+ks(0))*dw2(0)-(p1(1)+ks(1))*dw2(1) - & -(p1(2)+ks(2))*dw2(2)-(p1(3)+ks(3))*dw2(3) - p2w1= (p2(0)+ks(0))*dw1(0)-(p2(1)+ks(1))*dw1(1) - & -(p2(2)+ks(2))*dw1(2)-(p2(3)+ks(3))*dw1(3) - p3w2= (p3(0)+kt(0))*dw2(0)-(p3(1)+kt(1))*dw2(1) - & -(p3(2)+kt(2))*dw2(2)-(p3(3)+kt(3))*dw2(3) - p2w3= (p2(0)+kt(0))*dw3(0)-(p2(1)+kt(1))*dw3(1) - & -(p2(2)+kt(2))*dw3(2)-(p2(3)+kt(3))*dw3(3) -c - jt12(0)= (p1(0)-p2(0))*w12 + p2w1*dw2(0) - p1w2*dw1(0) - jt12(1)= (p1(1)-p2(1))*w12 + p2w1*dw2(1) - p1w2*dw1(1) - jt12(2)= (p1(2)-p2(2))*w12 + p2w1*dw2(2) - p1w2*dw1(2) - jt12(3)= (p1(3)-p2(3))*w12 + p2w1*dw2(3) - p1w2*dw1(3) - jt32(0)= (p3(0)-p2(0))*w32 + p2w3*dw2(0) - p3w2*dw3(0) - jt32(1)= (p3(1)-p2(1))*w32 + p2w3*dw2(1) - p3w2*dw3(1) - jt32(2)= (p3(2)-p2(2))*w32 + p2w3*dw2(2) - p3w2*dw3(2) - jt32(3)= (p3(3)-p2(3))*w32 + p2w3*dw2(3) - p3w2*dw3(3) -c - jk12=(jt12(0)*ks(0)-jt12(1)*ks(1)-jt12(2)*ks(2)-jt12(3)*ks(3))/mz2 - jk32=(jt32(0)*kt(0)-jt32(1)*kt(1)-jt32(2)*kt(2)-jt32(3)*kt(3))/mz2 -c - j12(0)=jt12(0)*(das+dzs)-ks(0)*jk12*dzs - j12(1)=jt12(1)*(das+dzs)-ks(1)*jk12*dzs - j12(2)=jt12(2)*(das+dzs)-ks(2)*jk12*dzs - j12(3)=jt12(3)*(das+dzs)-ks(3)*jk12*dzs - j32(0)=jt32(0)*(dat+dzt)-kt(0)*jk32*dzt - j32(1)=jt32(1)*(dat+dzt)-kt(1)*jk32*dzt - j32(2)=jt32(2)*(dat+dzt)-kt(2)*jk32*dzt - j32(3)=jt32(3)*(dat+dzt)-kt(3)*jk32*dzt -c - jsw3=j12(0)*dw3(0)-j12(1)*dw3(1)-j12(2)*dw3(2)-j12(3)*dw3(3) - jtw1=j32(0)*dw1(0)-j32(1)*dw1(1)-j32(2)*dw1(2)-j32(3)*dw1(3) -c - p3js= (p3(0)-q(0))*j12(0)-(p3(1)-q(1))*j12(1) - & -(p3(2)-q(2))*j12(2)-(p3(3)-q(3))*j12(3) - ksw3= (ks(0)-q(0))*dw3(0)-(ks(1)-q(1))*dw3(1) - & -(ks(2)-q(2))*dw3(2)-(ks(3)-q(3))*dw3(3) - p1jt= (p1(0)-q(0))*j32(0)-(p1(1)-q(1))*j32(1) - & -(p1(2)-q(2))*j32(2)-(p1(3)-q(3))*j32(3) - ktw1= (kt(0)-q(0))*dw1(0)-(kt(1)-q(1))*dw1(1) - & -(kt(2)-q(2))*dw1(2)-(kt(3)-q(3))*dw1(3) -c - js(0)= (ks(0)-p3(0))*jsw3 + p3js*dw3(0) - ksw3*j12(0) - js(1)= (ks(1)-p3(1))*jsw3 + p3js*dw3(1) - ksw3*j12(1) - js(2)= (ks(2)-p3(2))*jsw3 + p3js*dw3(2) - ksw3*j12(2) - js(3)= (ks(3)-p3(3))*jsw3 + p3js*dw3(3) - ksw3*j12(3) - jt(0)= (kt(0)-p1(0))*jtw1 + p1jt*dw1(0) - ktw1*j32(0) - jt(1)= (kt(1)-p1(1))*jtw1 + p1jt*dw1(1) - ktw1*j32(1) - jt(2)= (kt(2)-p1(2))*jtw1 + p1jt*dw1(2) - ktw1*j32(2) - jt(3)= (kt(3)-p1(3))*jtw1 + p1jt*dw1(3) - ktw1*j32(3) -c - w13=dw1(0)*dw3(0)-dw1(1)*dw3(1)-dw1(2)*dw3(2)-dw1(3)*dw3(3) -c - j4(0)=dgw2*( dw1(0)*w32 + dw3(0)*w12 - 2.d0*dw2(0)*w13 ) - j4(1)=dgw2*( dw1(1)*w32 + dw3(1)*w12 - 2.d0*dw2(1)*w13 ) - j4(2)=dgw2*( dw1(2)*w32 + dw3(2)*w12 - 2.d0*dw2(2)*w13 ) - j4(3)=dgw2*( dw1(3)*w32 + dw3(3)*w12 - 2.d0*dw2(3)*w13 ) -c -c jj(0)=js(0)+jt(0)+j4(0) -c jj(1)=js(1)+jt(1)+j4(1) -c jj(2)=js(2)+jt(2)+j4(2) -c jj(3)=js(3)+jt(3)+j4(3) - - jj(0)=j4(0) - jj(1)=j4(1) - jj(2)=j4(2) - jj(3)=j4(3) -c - jq=(jj(0)*q(0)-jj(1)*q(1)-jj(2)*q(2)-jj(3)*q(3))/mw2 -c - - jwww(1) = dcmplx( (jj(0)-jq*q(0))*dw ) - jwww(2) = dcmplx( (jj(1)-jq*q(1))*dw ) - jwww(3) = dcmplx( (jj(2)-jq*q(2))*dw ) - jwww(4) = dcmplx( (jj(3)-jq*q(3))*dw ) -c - return - end subroutine - -C -C ---------------------------------------------------------------------- -C - SUBROUTINE MOM2CX(ESUM,MASS1,MASS2,COSTH1,PHI1 , P1,P2) -C -C This subroutine sets up two four-momenta in the two particle rest -C frame. -C -C INPUT: -C real ESUM : energy sum of particle 1 and 2 -C real MASS1 : mass of particle 1 -C real MASS2 : mass of particle 2 -C real COSTH1 : cos(theta) of particle 1 -C real PHI1 : azimuthal angle of particle 1 -C -C OUTPUT: -C real P1(0:3) : four-momentum of particle 1 -C real P2(0:3) : four-momentum of particle 2 -C - REAL*8 P1(0:3),P2(0:3), - & ESUM,MASS1,MASS2,COSTH1,PHI1,MD2,ED,PP,SINTH1 -C - MD2=(MASS1-MASS2)*(MASS1+MASS2) - ED=MD2/ESUM - IF (MASS1*MASS2.EQ.0.) THEN - PP=(ESUM-ABS(ED))*0.5d0 -C - ELSE - PP=SQRT((MD2/ESUM)**2-2.0d0*(MASS1**2+MASS2**2)+ESUM**2)*0.5d0 - ENDIF - SINTH1=SQRT((1.0d0-COSTH1)*(1.0d0+COSTH1)) -C - P1(0) = MAX((ESUM+ED)*0.5d0,0.d0) - P1(1) = PP*SINTH1*COS(PHI1) - P1(2) = PP*SINTH1*SIN(PHI1) - P1(3) = PP*COSTH1 -C - P2(0) = MAX((ESUM-ED)*0.5d0,0.d0) - P2(1) = -P1(1) - P2(2) = -P1(2) - P2(3) = -P1(3) -C - RETURN - end subroutine -C ********************************************************************** -C - SUBROUTINE MOMNTX(ENERGY,MASS,COSTH,PHI , P) -C -C This subroutine sets up a four-momentum from the four inputs. -C -C INPUT: -C real ENERGY : energy -C real MASS : mass -C real COSTH : cos(theta) -C real PHI : azimuthal angle -C -C OUTPUT: -C real P(0:3) : four-momentum -C - implicit none - REAL*8 P(0:3),ENERGY,MASS,COSTH,PHI,PP,SINTH -C - P(0) = ENERGY - IF (ENERGY.EQ.MASS) THEN - P(1) = 0. - P(2) = 0. - P(3) = 0. - ELSE - PP=SQRT((ENERGY-MASS)*(ENERGY+MASS)) - SINTH=SQRT((1.-COSTH)*(1.+COSTH)) - P(3) = PP*COSTH - IF (PHI.EQ.0.) THEN - P(1) = PP*SINTH - P(2) = 0. - ELSE - P(1) = PP*SINTH*COS(PHI) - P(2) = PP*SINTH*SIN(PHI) - ENDIF - ENDIF - RETURN - end subroutine -C -c -c -c Subroutine returns the desired fermion or -c anti-fermion anti-spinor. ie., -c - subroutine oxxxxx( - & p, !in: four vector momentum - & fmass, !in: fermion mass - & nhel, !in: anti-spinor helicity, -1 or 1 - & nsf, !in: -1=antifermion, 1=fermion - & fo !out: fermion wavefunction - & ) - implicit none -c -c declare input/output variables -c - complex*16 fo(6) - integer*4 nhel, nsf - real*8 p(0:3), fmass -c -c declare local variables -c - real*8 r_zero, r_one, r_two - parameter( r_zero=0.0d0, r_one=1.0d0, r_two=2.0d0 ) - complex*16 c_zero -c - real*8 plat, pabs, omegap, omegam, rs2pa, spaz - c_zero=dcmplx( r_zero, r_zero ) -c -c define kinematic parameters -c - fo(5) = dcmplx( p(0), p(3) ) * nsf - fo(6) = dcmplx( p(1), p(2) ) * nsf - plat = sqrt( p(1)**2 + p(2)**2 ) - pabs = sqrt( p(1)**2 + p(2)**2 + p(3)**2 ) - omegap = sqrt( p(0) + pabs ) -c -c do massive fermion case -c - if ( fmass .ne. r_zero ) then - omegam = fmass / omegap - if ( nsf .eq. 1 ) then - if ( nhel .eq. 1 ) then - if ( p(3) .ge. r_zero ) then - if ( plat .eq. r_zero ) then - fo(1) = dcmplx( omegap, r_zero ) - fo(2) = c_zero - fo(3) = dcmplx( omegam, r_zero ) - fo(4) = c_zero - else - rs2pa = r_one / sqrt( r_two * pabs ) - spaz = sqrt( pabs + p(3) ) - fo(1) = omegap * rs2pa - & * dcmplx( spaz, r_zero ) - fo(2) = omegap * rs2pa / spaz - & * dcmplx( p(1), -p(2) ) - fo(3) = omegam * rs2pa - & * dcmplx( spaz, r_zero ) - fo(4) = omegam * rs2pa / spaz - & * dcmplx( p(1), -p(2) ) - end if - else - if ( plat .eq. r_zero ) then - fo(1) = c_zero - fo(2) = dcmplx( omegap, r_zero ) - fo(3) = c_zero - fo(4) = dcmplx( omegam, r_zero ) - else - rs2pa = r_one / sqrt( r_two * pabs ) - spaz = sqrt( pabs - p(3) ) - fo(1) = omegap * rs2pa / spaz - & * dcmplx( plat, r_zero ) - fo(2) = omegap * rs2pa * spaz / plat - & * dcmplx( p(1), -p(2) ) - fo(3) = omegam * rs2pa / spaz - & * dcmplx( plat, r_zero ) - fo(4) = omegam * rs2pa * spaz / plat - & * dcmplx( p(1), -p(2) ) - end if - end if - else if ( nhel .eq. -1 ) then - if ( p(3) .ge. r_zero ) then - if ( plat .eq. r_zero ) then - fo(1) = c_zero - fo(2) = dcmplx( omegam, r_zero ) - fo(3) = c_zero - fo(4) = dcmplx( omegap, r_zero ) - else - rs2pa = r_one / sqrt( r_two * pabs ) - spaz = sqrt( pabs + p(3) ) - fo(1) = omegam * rs2pa / spaz - & * dcmplx( -p(1), -p(2) ) - fo(2) = omegam * rs2pa - & * dcmplx( spaz, r_zero ) - fo(3) = omegap * rs2pa / spaz - & * dcmplx( -p(1), -p(2) ) - fo(4) = omegap * rs2pa - & * dcmplx( spaz, r_zero ) - end if - else - if ( plat .eq. r_zero ) then - fo(1) = dcmplx( -omegam, r_zero ) - fo(2) = c_zero - fo(3) = dcmplx( -omegap, r_zero ) - fo(4) = c_zero - else - rs2pa = r_one / sqrt( r_two * pabs ) - spaz = sqrt( pabs - p(3) ) - fo(1) = omegam * rs2pa * spaz / plat - & * dcmplx( -p(1), -p(2) ) - fo(2) = omegam * rs2pa / spaz - & * dcmplx( plat, r_zero ) - fo(3) = omegap * rs2pa * spaz / plat - & * dcmplx( -p(1), -p(2) ) - fo(4) = omegap * rs2pa / spaz - & * dcmplx( plat, r_zero ) - end if - end if - else - stop 'oxxxxx: fermion helicity must be +1,-1' - end if - else if ( nsf .eq. -1 ) then - if ( nhel .eq. 1 ) then - if ( p(3) .ge. r_zero ) then - if ( plat .eq. r_zero ) then - fo(1) = c_zero - fo(2) = dcmplx( omegam, r_zero ) - fo(3) = c_zero - fo(4) = dcmplx( -omegap, r_zero ) - else - rs2pa = r_one / sqrt( r_two * pabs ) - spaz = sqrt( pabs + p(3) ) - fo(1) = omegam * rs2pa / spaz - & * dcmplx( -p(1), -p(2) ) - fo(2) = omegam * rs2pa - & * dcmplx( spaz, r_zero ) - fo(3) = -omegap * rs2pa / spaz - & * dcmplx( -p(1), -p(2) ) - fo(4) = -omegap * rs2pa - & * dcmplx( spaz, r_zero ) - end if - else - if ( plat .eq. r_zero ) then - fo(1) = dcmplx( -omegam, r_zero ) - fo(2) = c_zero - fo(3) = dcmplx( omegap, r_zero ) - fo(4) = c_zero - else - rs2pa = r_one / sqrt( r_two * pabs ) - spaz = sqrt( pabs - p(3) ) - fo(1) = omegam * rs2pa * spaz / plat - & * dcmplx( -p(1), -p(2) ) - fo(2) = omegam * rs2pa / spaz - & * dcmplx( plat, r_zero ) - fo(3) = -omegap * rs2pa * spaz / plat - & * dcmplx( -p(1), -p(2) ) - fo(4) = -omegap * rs2pa / spaz - & * dcmplx( plat, r_zero ) - end if - end if - else if ( nhel .eq. -1 ) then - if ( p(3) .ge. r_zero ) then - if ( plat .eq. r_zero ) then - fo(1) = dcmplx( -omegap, r_zero ) - fo(2) = c_zero - fo(3) = dcmplx( omegam, r_zero ) - fo(4) = c_zero - else - rs2pa = r_one / sqrt( r_two * pabs ) - spaz = sqrt( pabs + p(3) ) - fo(1) = -omegap * rs2pa - & * dcmplx( spaz, r_zero ) - fo(2) = -omegap * rs2pa / spaz - & * dcmplx( p(1), -p(2) ) - fo(3) = omegam * rs2pa - & * dcmplx( spaz, r_zero ) - fo(4) = omegam * rs2pa / spaz - & * dcmplx( p(1), -p(2) ) - end if - else - if ( plat .eq. r_zero ) then - fo(1) = c_zero - fo(2) = dcmplx( -omegap, r_zero ) - fo(3) = c_zero - fo(4) = dcmplx( omegam, r_zero ) - else - rs2pa = r_one / sqrt( r_two * pabs ) - spaz = sqrt( pabs - p(3) ) - fo(1) = -omegap * rs2pa / spaz - & * dcmplx( plat, r_zero ) - fo(2) = -omegap * rs2pa * spaz / plat - & * dcmplx( p(1), -p(2) ) - fo(3) = omegam * rs2pa / spaz - & * dcmplx( plat, r_zero ) - fo(4) = omegam * rs2pa * spaz / plat - & * dcmplx( p(1), -p(2) ) - end if - end if - else - stop 'oxxxxx: fermion helicity must be +1,-1' - end if - else - stop 'oxxxxx: fermion type must be +1,-1' - end if -c -c do massless case -c - else - if ( nsf .eq. 1 ) then - if ( nhel .eq. 1 ) then - if ( p(3) .ge. r_zero ) then - if ( plat .eq. r_zero ) then - fo(1) = dcmplx( omegap, r_zero ) - fo(2) = c_zero - fo(3) = c_zero - fo(4) = c_zero - else - spaz = sqrt( pabs + p(3) ) - fo(1) = dcmplx( spaz, r_zero ) - fo(2) = r_one / spaz - & * dcmplx( p(1), -p(2) ) - fo(3) = c_zero - fo(4) = c_zero - end if - else - if ( plat .eq. r_zero ) then - fo(1) = c_zero - fo(2) = dcmplx( omegap, r_zero ) - fo(3) = c_zero - fo(4) = c_zero - else - spaz = sqrt( pabs - p(3) ) - fo(1) = r_one / spaz - & * dcmplx( plat, r_zero ) - fo(2) = spaz / plat - & * dcmplx( p(1), -p(2) ) - fo(3) = c_zero - fo(4) = c_zero - end if - end if - else if ( nhel .eq. -1 ) then - if ( p(3) .ge. r_zero ) then - if ( plat .eq. r_zero ) then - fo(1) = c_zero - fo(2) = c_zero - fo(3) = c_zero - fo(4) = dcmplx( omegap, r_zero ) - else - spaz = sqrt( pabs + p(3) ) - fo(1) = c_zero - fo(2) = c_zero - fo(3) = r_one / spaz - & * dcmplx( -p(1), -p(2) ) - fo(4) = dcmplx( spaz, r_zero ) - end if - else - if ( plat .eq. r_zero ) then - fo(1) = c_zero - fo(2) = c_zero - fo(3) = dcmplx( -omegap, r_zero ) - fo(4) = c_zero - else - spaz = sqrt( pabs - p(3) ) - fo(1) = c_zero - fo(2) = c_zero - fo(3) = spaz / plat - & * dcmplx( -p(1), -p(2) ) - fo(4) = r_one / spaz - & * dcmplx( plat, r_zero ) - end if - end if - else - stop 'oxxxxx: fermion helicity must be +1,-1' - end if - else if ( nsf .eq. -1 ) then - if ( nhel .eq. 1 ) then - if ( p(3) .ge. r_zero ) then - if ( plat .eq. r_zero ) then - fo(1) = c_zero - fo(2) = c_zero - fo(3) = c_zero - fo(4) = dcmplx( -omegap, r_zero ) - else - spaz = sqrt( pabs + p(3) ) - fo(1) = c_zero - fo(2) = c_zero - fo(3) = -r_one / spaz - & * dcmplx( -p(1), -p(2) ) - fo(4) = dcmplx( -spaz, r_zero ) - end if - else - if ( plat .eq. r_zero ) then - fo(1) = c_zero - fo(2) = c_zero - fo(3) = dcmplx( omegap, r_zero ) - fo(4) = c_zero - else - spaz = sqrt( pabs - p(3) ) - fo(1) = c_zero - fo(2) = c_zero - fo(3) = -spaz / plat - & * dcmplx( -p(1), -p(2) ) - fo(4) = -r_one / spaz - & * dcmplx( plat, r_zero ) - end if - end if - else if ( nhel .eq. -1 ) then - if ( p(3) .ge. r_zero ) then - if ( plat .eq. r_zero ) then - fo(1) = dcmplx( -omegap, r_zero ) - fo(2) = c_zero - fo(3) = c_zero - fo(4) = c_zero - else - spaz = sqrt( pabs + p(3) ) - fo(1) = dcmplx( -spaz, r_zero ) - fo(2) = -r_one / spaz - & * dcmplx( p(1), -p(2) ) - fo(3) = c_zero - fo(4) = c_zero - end if - else - if ( plat .eq. r_zero ) then - fo(1) = c_zero - fo(2) = dcmplx( -omegap, r_zero ) - fo(3) = c_zero - fo(4) = c_zero - else - spaz = sqrt( pabs - p(3) ) - fo(1) = -r_one / spaz - & * dcmplx( plat, r_zero ) - fo(2) = -spaz / plat - & * dcmplx( p(1), -p(2) ) - fo(3) = c_zero - fo(4) = c_zero - end if - end if - else - stop 'oxxxxx: fermion helicity must be +1,-1' - end if - else - stop 'oxxxxx: fermion type must be +1,-1' - end if - end if -c -c done -c - return - end subroutine -c -c ---------------------------------------------------------------------- -c - subroutine rotxxx(p,q , prot) -c -c this subroutine performs the spacial rotation of a four-momentum. -c the momentum p is assumed to be given in the frame where the spacial -c component of q points the positive z-axis. prot is the momentum p -c rotated to the frame where q is given. -c -c input: -c real p(0:3) : four-momentum p in q(1)=q(2)=0 frame -c real q(0:3) : four-momentum q in the rotated frame -c -c output: -c real prot(0:3) : four-momentum p in the rotated frame -c - real*8 p(0:3),q(0:3),prot(0:3),qt2,qt,psgn,qq,p1 -c - real*8 r_zero, r_one - parameter( r_zero=0.0d0, r_one=1.0d0 ) -c - prot(0) = p(0) -c - qt2=q(1)**2+q(2)**2 -c - if ( qt2 .eq. r_zero ) then - if ( q(3) .eq. r_zero ) then - prot(1) = p(1) - prot(2) = p(2) - prot(3) = p(3) - else - psgn=dsign(r_one,q(3)) - prot(1) = p(1)*psgn - prot(2) = p(2)*psgn - prot(3) = p(3)*psgn - endif - else - qq=sqrt(qt2+q(3)**2) - qt=sqrt(qt2) - p1=p(1) - prot(1) = q(1)*q(3)/qq/qt*p1 -q(2)/qt*p(2) +q(1)/qq*p(3) - prot(2) = q(2)*q(3)/qq/qt*p1 +q(1)/qt*p(2) +q(2)/qq*p(3) - prot(3) = -qt/qq*p1 +q(3)/qq*p(3) - endif -c - return - end subroutine -C ====================================================================== -C - SUBROUTINE SSSSXX(S1,S2,S3,S4,G , VERTEX) -C -C This subroutine computes an amplitude of the four-scalar coupling. -C -C INPUT: -C complex S1(3) : first scalar S1 -C complex S2(3) : second scalar S2 -C complex S3(3) : third scalar S3 -C complex S4(3) : fourth scalar S4 -C real G : coupling constant GHHHH -C -C OUTPUT: -C complex VERTEX : amplitude Gamma(S1,S2,S3,S4) -C - implicit none - COMPLEX*16 S1(3),S2(3),S3(3),S4(3),VERTEX - REAL*8 G -C - VERTEX = G*S1(1)*S2(1)*S3(1)*S4(1) -C - RETURN - end subroutine -C -C ====================================================================== -C - SUBROUTINE SSSXXX(S1,S2,S3,G , VERTEX) -C -C This subroutine computes an amplitude of the three-scalar coupling. -C -C INPUT: -C complex S1(3) : first scalar S1 -C complex S2(3) : second scalar S2 -C complex S3(3) : third scalar S3 -C real G : coupling constant GHHH -C -C OUTPUT: -C complex VERTEX : amplitude Gamma(S1,S2,S3) -C - implicit none - COMPLEX*16 S1(3),S2(3),S3(3),VERTEX - REAL*8 G -C - VERTEX = G*S1(1)*S2(1)*S3(1) -C - RETURN - end subroutine -C -C -C ---------------------------------------------------------------------- -C - SUBROUTINE SXXXXX(P,NSS , SC) -C -C This subroutine computes a complex SCALAR wavefunction. -C -C INPUT: -C real P(0:3) : four-momentum of scalar boson -C integer NSS = -1 or 1 : +1 for final, -1 for initial -C -C OUTPUT: -C complex SC(3) : scalar wavefunction S -C - COMPLEX*16 SC(3) - REAL*8 P(0:3) - INTEGER NSS -C - SC(1) = DCMPLX( 1.0 ) - SC(2) = DCMPLX(P(0),P(3))*NSS - SC(3) = DCMPLX(P(1),P(2))*NSS -C - RETURN - end subroutine -c -c ====================================================================== -c - subroutine vssxxx(vc,s1,s2,g , vertex) -c -c this subroutine computes an amplitude from the vector-scalar-scalar -c coupling. the coupling is absent in the minimal sm in unitary gauge. -c -c complex vc(6) : input vector v -c complex s1(3) : first scalar s1 -c complex s2(3) : second scalar s2 -c complex g : coupling constant (s1 charge) -c -c examples of the coupling constant g for susy particles are as follows: -c ----------------------------------------------------------- -c | s1 | (q,i3) of s1 || v=a | v=z | v=w | -c ----------------------------------------------------------- -c | nu~_l | ( 0 , +1/2) || --- | gzn(1) | gwf(1) | -c | e~_l | ( -1 , -1/2) || gal(1) | gzl(1) | gwf(1) | -c | u~_l | (+2/3 , +1/2) || gau(1) | gzu(1) | gwf(1) | -c | d~_l | (-1/3 , -1/2) || gad(1) | gzd(1) | gwf(1) | -c ----------------------------------------------------------- -c | e~_r-bar | ( +1 , 0 ) || -gal(2) | -gzl(2) | -gwf(2) | -c | u~_r-bar | (-2/3 , 0 ) || -gau(2) | -gzu(2) | -gwf(2) | -c | d~_r-bar | (+1/3 , 0 ) || -gad(2) | -gzd(2) | -gwf(2) | -c ----------------------------------------------------------- -c where the s1 charge is defined by the flowing-out quantum number. -c -c output: -c complex vertex : amplitude gamma(v,s1,s2) -c - complex*16 vc(6),s1(3),s2(3),vertex,g - real*8 p(0:3) -c - p(0)=dble( s1(2)-s2(2)) - p(1)=dble( s1(3)-s2(3)) - p(2)=dimag(s1(3)-s2(3)) - p(3)=dimag(s1(2)-s2(2)) -c - vertex = g*s1(1)*s2(1) - & *(vc(1)*p(0)-vc(2)*p(1)-vc(3)*p(2)-vc(4)*p(3)) -c - return - end subroutine -C - SUBROUTINE VVSSXX(V1,V2,S1,S2,G , VERTEX) -C -C This subroutine computes an amplitude of the vector-vector-scalar- -C scalar coupling. -C -C INPUT: -C complex V1(6) : first vector V1 -C complex V2(6) : second vector V2 -C complex S1(3) : first scalar S1 -C complex S2(3) : second scalar S2 -C real G : coupling constant GVVHH -C -C OUTPUT: -C complex VERTEX : amplitude Gamma(V1,V2,S1,S2) -C - implicit none - COMPLEX*16 V1(6),V2(6),S1(3),S2(3),VERTEX - REAL*8 G -C - VERTEX = G*S1(1)*S2(1) - & *(V1(1)*V2(1)-V1(2)*V2(2)-V1(3)*V2(3)-V1(4)*V2(4)) -C - RETURN - end subroutine -C -c -c ====================================================================== -c - subroutine vvsxxx(v1,v2,sc,g , vertex) -c -c this subroutine computes an amplitude of the vector-vector-scalar -c coupling. -c -c input: -c complex v1(6) : first vector v1 -c complex v2(6) : second vector v2 -c complex sc(3) : input scalar s -c real g : coupling constant gvvh -c -c output: -c complex vertex : amplitude gamma(v1,v2,s) -c - complex*16 v1(6),v2(6),sc(3),vertex - real*8 g -c - vertex = g*sc(1)*(v1(1)*v2(1)-v1(2)*v2(2)-v1(3)*v2(3)-v1(4)*v2(4)) -c - return - end subroutine -c -c ====================================================================== -c - subroutine vvvxxx(wm,wp,w3,g , vertex) -c -c this subroutine computes an amplitude of the three-point coupling of -c the gauge bosons. -c -c input: -c complex wm(6) : vector flow-out w- -c complex wp(6) : vector flow-out w+ -c complex w3(6) : vector j3 or a or z -c real g : coupling constant gw or gwwa or gwwz -c -c output: -c complex vertex : amplitude gamma(wm,wp,w3) -c - complex*16 wm(6),wp(6),w3(6),vertex, - & xv1,xv2,xv3,v12,v23,v31,p12,p13,p21,p23,p31,p32 - real*8 pwm(0:3),pwp(0:3),pw3(0:3),g -c - real*8 r_zero, r_tenth - parameter( r_zero=0.0d0, r_tenth=0.1d0 ) -c - pwm(0)=dble( wm(5)) - pwm(1)=dble( wm(6)) - pwm(2)=dimag(wm(6)) - pwm(3)=dimag(wm(5)) - pwp(0)=dble( wp(5)) - pwp(1)=dble( wp(6)) - pwp(2)=dimag(wp(6)) - pwp(3)=dimag(wp(5)) - pw3(0)=dble( w3(5)) - pw3(1)=dble( w3(6)) - pw3(2)=dimag(w3(6)) - pw3(3)=dimag(w3(5)) -c - v12=wm(1)*wp(1)-wm(2)*wp(2)-wm(3)*wp(3)-wm(4)*wp(4) - v23=wp(1)*w3(1)-wp(2)*w3(2)-wp(3)*w3(3)-wp(4)*w3(4) - v31=w3(1)*wm(1)-w3(2)*wm(2)-w3(3)*wm(3)-w3(4)*wm(4) - xv1=r_zero - xv2=r_zero - xv3=r_zero - if ( abs(wm(1)) .ne. r_zero ) then - if (abs(wm(1)).ge.max(abs(wm(2)),abs(wm(3)),abs(wm(4))) - $ *r_tenth) - & xv1=pwm(0)/wm(1) - endif - if ( abs(wp(1)) .ne. r_zero) then - if (abs(wp(1)).ge.max(abs(wp(2)),abs(wp(3)),abs(wp(4))) - $ *r_tenth) - & xv2=pwp(0)/wp(1) - endif - if ( abs(w3(1)) .ne. r_zero) then - if ( abs(w3(1)).ge.max(abs(w3(2)),abs(w3(3)),abs(w3(4))) - $ *r_tenth) - & xv3=pw3(0)/w3(1) - endif - p12= (pwm(0)-xv1*wm(1))*wp(1)-(pwm(1)-xv1*wm(2))*wp(2) - & -(pwm(2)-xv1*wm(3))*wp(3)-(pwm(3)-xv1*wm(4))*wp(4) - p13= (pwm(0)-xv1*wm(1))*w3(1)-(pwm(1)-xv1*wm(2))*w3(2) - & -(pwm(2)-xv1*wm(3))*w3(3)-(pwm(3)-xv1*wm(4))*w3(4) - p21= (pwp(0)-xv2*wp(1))*wm(1)-(pwp(1)-xv2*wp(2))*wm(2) - & -(pwp(2)-xv2*wp(3))*wm(3)-(pwp(3)-xv2*wp(4))*wm(4) - p23= (pwp(0)-xv2*wp(1))*w3(1)-(pwp(1)-xv2*wp(2))*w3(2) - & -(pwp(2)-xv2*wp(3))*w3(3)-(pwp(3)-xv2*wp(4))*w3(4) - p31= (pw3(0)-xv3*w3(1))*wm(1)-(pw3(1)-xv3*w3(2))*wm(2) - & -(pw3(2)-xv3*w3(3))*wm(3)-(pw3(3)-xv3*w3(4))*wm(4) - p32= (pw3(0)-xv3*w3(1))*wp(1)-(pw3(1)-xv3*w3(2))*wp(2) - & -(pw3(2)-xv3*w3(3))*wp(3)-(pw3(3)-xv3*w3(4))*wp(4) -c - vertex = -(v12*(p13-p23)+v23*(p21-p31)+v31*(p32-p12))*g -c - return - end subroutine -c -c -c Subroutine returns the value of evaluated -c helicity basis boson polarisation wavefunction. -c Replaces the HELAS routine VXXXXX -c -c Adam Duff, 1992 September 3 -c -c - subroutine vxxxxx( - & p, !in: boson four momentum - & vmass, !in: boson mass - & nhel, !in: boson helicity - & nsv, !in: incoming (-1) or outgoing (+1) - & vc !out: boson wavefunction - & ) - implicit none -c -c declare input/output variables -c - complex*16 vc(6) - integer*4 nhel, nsv - real*8 p(0:3), vmass -c -c declare local variables -c - real*8 r_zero, r_one, r_two - parameter( r_zero=0.0d0, r_one=1.0d0, r_two=2.0d0 ) - complex*16 c_zero -c - real*8 plat, pabs, rs2, rplat, rpabs, rden - c_zero=dcmplx( r_zero, r_zero ) -c -c define internal/external momenta -c - if ( nsv**2 .ne. 1 ) then - stop 'vxxxxx: nsv is not one of -1, +1' - end if -c - rs2 = sqrt( r_one / r_two ) - vc(5) = dcmplx( p(0), p(3) ) * nsv - vc(6) = dcmplx( p(1), p(2) ) * nsv - plat = sqrt( p(1)**2 + p(2)**2 ) - pabs = sqrt( p(1)**2 + p(2)**2 + p(3)**2 ) -c -c calculate polarisation four vectors -c - if ( nhel**2 .eq. 1 ) then - if ( (pabs .eq. r_zero) .or. (plat .eq. r_zero) ) then - vc(1) = c_zero - vc(2) = dcmplx( -nhel * rs2 * dsign( r_one, p(3) ), r_zero ) - vc(3) = dcmplx( r_zero, nsv * rs2 ) - vc(4) = c_zero - else - rplat = r_one / plat - rpabs = r_one / pabs - vc(1) = c_zero - vc(2) = dcmplx( -nhel * rs2 * rpabs * rplat * p(1) * p(3), - & -nsv * rs2 * rplat * p(2) ) - vc(3) = dcmplx( -nhel * rs2 * rpabs * rplat * p(2) * p(3), - & nsv * rs2 * rplat * p(1) ) - vc(4) = dcmplx( nhel * rs2 * rpabs * plat, - & r_zero ) - end if - else if ( nhel .eq. 0 ) then - if ( vmass .gt. r_zero ) then - if ( pabs .eq. r_zero ) then - vc(1) = c_zero - vc(2) = c_zero - vc(3) = c_zero - vc(4) = dcmplx( r_one, r_zero ) - else - rden = p(0) / ( vmass * pabs ) - vc(1) = dcmplx( pabs / vmass, r_zero ) - vc(2) = dcmplx( rden * p(1), r_zero ) - vc(3) = dcmplx( rden * p(2), r_zero ) - vc(4) = dcmplx( rden * p(3), r_zero ) - end if - else - stop 'vxxxxx: nhel = 0 is only for massive bosons' - end if - else if ( nhel .eq. 4 ) then - if ( vmass .gt. r_zero ) then - rden = r_one / vmass - vc(1) = dcmplx( rden * p(0), r_zero ) - vc(2) = dcmplx( rden * p(1), r_zero ) - vc(3) = dcmplx( rden * p(2), r_zero ) - vc(4) = dcmplx( rden * p(3), r_zero ) - elseif (vmass .eq. r_zero) then - rden = r_one / p(0) - vc(1) = dcmplx( rden * p(0), r_zero ) - vc(2) = dcmplx( rden * p(1), r_zero ) - vc(3) = dcmplx( rden * p(2), r_zero ) - vc(4) = dcmplx( rden * p(3), r_zero ) - else - stop 'vxxxxx: nhel = 4 is only for m>=0' - end if - else - stop 'vxxxxx: nhel is not one of -1, 0, 1 or 4' - end if -c -c done -c - return - end subroutine -c -c ---------------------------------------------------------------------- -c - subroutine w3w3xx(wm,w31,wp,w32,g31,g32,wmass,wwidth , vertex) -c -c this subroutine computes an amplitude of the four-point coupling of -c the w-, w+ and two w3/z/a. the amplitude includes the contributions -c of w exchange diagrams. the internal w propagator is given in unitary -c gauge. if one sets wmass=0.0, then the gggg vertex is given (see sect -c 2.9.1 of the manual). -c -c input: -c complex wm(0:3) : flow-out w- wm -c complex w31(0:3) : first w3/z/a w31 -c complex wp(0:3) : flow-out w+ wp -c complex w32(0:3) : second w3/z/a w32 -c real g31 : coupling of w31 with w-/w+ -c real g32 : coupling of w32 with w-/w+ -c (see the table below) -c real wmass : mass of w -c real wwidth : width of w -c -c the possible sets of the inputs are as follows: -c ------------------------------------------- -c | wm | w31 | wp | w32 | g31 | g32 | -c ------------------------------------------- -c | w- | w3 | w+ | w3 | gw | gw | -c | w- | w3 | w+ | z | gw | gwwz | -c | w- | w3 | w+ | a | gw | gwwa | -c | w- | z | w+ | z | gwwz | gwwz | -c | w- | z | w+ | a | gwwz | gwwa | -c | w- | a | w+ | a | gwwa | gwwa | -c ------------------------------------------- -c where all the bosons are defined by the flowing-out quantum number. -c -c output: -c complex vertex : amplitude gamma(wm,w31,wp,w32) -c - complex*16 wm(6),w31(6),wp(6),w32(6),vertex - complex*16 dv1(0:3),dv2(0:3),dv3(0:3),dv4(0:3),dvertx, - & v12,v13,v14,v23,v24,v34 - real*8 g31,g32,wmass,wwidth -c - real*8 r_zero, r_one - parameter( r_zero=0.0d0, r_one=1.0d0 ) - - dv1(0)=dcmplx(wm(1)) - dv1(1)=dcmplx(wm(2)) - dv1(2)=dcmplx(wm(3)) - dv1(3)=dcmplx(wm(4)) - dv2(0)=dcmplx(w31(1)) - dv2(1)=dcmplx(w31(2)) - dv2(2)=dcmplx(w31(3)) - dv2(3)=dcmplx(w31(4)) - dv3(0)=dcmplx(wp(1)) - dv3(1)=dcmplx(wp(2)) - dv3(2)=dcmplx(wp(3)) - dv3(3)=dcmplx(wp(4)) - dv4(0)=dcmplx(w32(1)) - dv4(1)=dcmplx(w32(2)) - dv4(2)=dcmplx(w32(3)) - dv4(3)=dcmplx(w32(4)) -c - if ( dble(wmass) .ne. r_zero ) then -c dm2inv = r_one / dmw2 -c - v12= dv1(0)*dv2(0)-dv1(1)*dv2(1)-dv1(2)*dv2(2)-dv1(3)*dv2(3) - v13= dv1(0)*dv3(0)-dv1(1)*dv3(1)-dv1(2)*dv3(2)-dv1(3)*dv3(3) - v14= dv1(0)*dv4(0)-dv1(1)*dv4(1)-dv1(2)*dv4(2)-dv1(3)*dv4(3) - v23= dv2(0)*dv3(0)-dv2(1)*dv3(1)-dv2(2)*dv3(2)-dv2(3)*dv3(3) - v24= dv2(0)*dv4(0)-dv2(1)*dv4(1)-dv2(2)*dv4(2)-dv2(3)*dv4(3) - v34= dv3(0)*dv4(0)-dv3(1)*dv4(1)-dv3(2)*dv4(2)-dv3(3)*dv4(3) -c - dvertx = v12*v34 +v14*v23 -2.d0*v13*v24 -c - vertex = dcmplx( dvertx ) * (g31*g32) -c - else - v12= dv1(0)*dv2(0)-dv1(1)*dv2(1)-dv1(2)*dv2(2)-dv1(3)*dv2(3) - v13= dv1(0)*dv3(0)-dv1(1)*dv3(1)-dv1(2)*dv3(2)-dv1(3)*dv3(3) - v14= dv1(0)*dv4(0)-dv1(1)*dv4(1)-dv1(2)*dv4(2)-dv1(3)*dv4(3) - v23= dv2(0)*dv3(0)-dv2(1)*dv3(1)-dv2(2)*dv3(2)-dv2(3)*dv3(3) - v24= dv2(0)*dv4(0)-dv2(1)*dv4(1)-dv2(2)*dv4(2)-dv2(3)*dv4(3) - v34= dv3(0)*dv4(0)-dv3(1)*dv4(1)-dv3(2)*dv4(2)-dv3(3)*dv4(3) -c - - dvertx = v14*v23 -v13*v24 -c - vertex = dcmplx( dvertx ) * (g31*g32) - end if -c - return - end subroutine -c -c ====================================================================== -c - subroutine wwwwxx(wm1,wp1,wm2,wp2,gwwa,gwwz,zmass,zwidth , vertex) -c -c this subroutine computes an amplitude of the four-point w-/w+ -c coupling, including the contributions of photon and z exchanges. the -c photon propagator is given in feynman gauge and the z propagator is -c given in unitary gauge. -c -c input: -c complex wm1(0:3) : first flow-out w- wm1 -c complex wp1(0:3) : first flow-out w+ wp1 -c complex wm2(0:3) : second flow-out w- wm2 -c complex wp2(0:3) : second flow-out w+ wp2 -c real gwwa : coupling constant of w and a gwwa -c real gwwz : coupling constant of w and z gwwz -c real zmass : mass of z -c real zwidth : width of z -c -c output: -c complex vertex : amplitude gamma(wm1,wp1,wm2,wp2) -c - complex*16 wm1(6),wp1(6),wm2(6),wp2(6),vertex - complex*16 dv1(0:3),dv2(0:3),dv3(0:3),dv4(0:3), - & j12(0:3),j34(0:3),j14(0:3),j32(0:3),dvertx, - & sv1,sv2,sv3,sv4,tv1,tv2,tv3,tv4,dzs,dzt, - & v12,v13,v14,v23,v24,v34,js12,js34,js14,js32,js,jt - real*8 pwm1(0:3),pwp1(0:3),pwm2(0:3),pwp2(0:3), - & gwwa,gwwz,zmass,zwidth - real*8 q(0:3),k(0:3),dp1(0:3),dp2(0:3),dp3(0:3),dp4(0:3), - & dgwwa2,dgwwz2,dgw2,dmz,dwidth,s,t,das,dat -c - real*8 r_zero, r_one, r_two - parameter( r_zero=0.0d0, r_one=1.0d0, r_two=2.0d0 ) -c - pwm1(0)=dble( wm1(5)) - pwm1(1)=dble( wm1(6)) - pwm1(2)=dimag(wm1(6)) - pwm1(3)=dimag(wm1(5)) - pwp1(0)=dble( wp1(5)) - pwp1(1)=dble( wp1(6)) - pwp1(2)=dimag(wp1(6)) - pwp1(3)=dimag(wp1(5)) - pwm2(0)=dble( wm2(5)) - pwm2(1)=dble( wm2(6)) - pwm2(2)=dimag(wm2(6)) - pwm2(3)=dimag(wm2(5)) - pwp2(0)=dble( wp2(5)) - pwp2(1)=dble( wp2(6)) - pwp2(2)=dimag(wp2(6)) - pwp2(3)=dimag(wp2(5)) -c - dv1(0)=dcmplx(wm1(1)) - dv1(1)=dcmplx(wm1(2)) - dv1(2)=dcmplx(wm1(3)) - dv1(3)=dcmplx(wm1(4)) - dp1(0)=dble(pwm1(0)) - dp1(1)=dble(pwm1(1)) - dp1(2)=dble(pwm1(2)) - dp1(3)=dble(pwm1(3)) - dv2(0)=dcmplx(wp1(1)) - dv2(1)=dcmplx(wp1(2)) - dv2(2)=dcmplx(wp1(3)) - dv2(3)=dcmplx(wp1(4)) - dp2(0)=dble(pwp1(0)) - dp2(1)=dble(pwp1(1)) - dp2(2)=dble(pwp1(2)) - dp2(3)=dble(pwp1(3)) - dv3(0)=dcmplx(wm2(1)) - dv3(1)=dcmplx(wm2(2)) - dv3(2)=dcmplx(wm2(3)) - dv3(3)=dcmplx(wm2(4)) - dp3(0)=dble(pwm2(0)) - dp3(1)=dble(pwm2(1)) - dp3(2)=dble(pwm2(2)) - dp3(3)=dble(pwm2(3)) - dv4(0)=dcmplx(wp2(1)) - dv4(1)=dcmplx(wp2(2)) - dv4(2)=dcmplx(wp2(3)) - dv4(3)=dcmplx(wp2(4)) - dp4(0)=dble(pwp2(0)) - dp4(1)=dble(pwp2(1)) - dp4(2)=dble(pwp2(2)) - dp4(3)=dble(pwp2(3)) - dgwwa2=dble(gwwa)**2 - dgwwz2=dble(gwwz)**2 - dgw2 =dgwwa2+dgwwz2 - dmz =dble(zmass) - dwidth=dble(zwidth) -c - v12= dv1(0)*dv2(0)-dv1(1)*dv2(1)-dv1(2)*dv2(2)-dv1(3)*dv2(3) - v13= dv1(0)*dv3(0)-dv1(1)*dv3(1)-dv1(2)*dv3(2)-dv1(3)*dv3(3) - v14= dv1(0)*dv4(0)-dv1(1)*dv4(1)-dv1(2)*dv4(2)-dv1(3)*dv4(3) - v23= dv2(0)*dv3(0)-dv2(1)*dv3(1)-dv2(2)*dv3(2)-dv2(3)*dv3(3) - v24= dv2(0)*dv4(0)-dv2(1)*dv4(1)-dv2(2)*dv4(2)-dv2(3)*dv4(3) - v34= dv3(0)*dv4(0)-dv3(1)*dv4(1)-dv3(2)*dv4(2)-dv3(3)*dv4(3) -c - q(0)=dp1(0)+dp2(0) - q(1)=dp1(1)+dp2(1) - q(2)=dp1(2)+dp2(2) - q(3)=dp1(3)+dp2(3) - k(0)=dp1(0)+dp4(0) - k(1)=dp1(1)+dp4(1) - k(2)=dp1(2)+dp4(2) - k(3)=dp1(3)+dp4(3) -c - s=q(0)**2-q(1)**2-q(2)**2-q(3)**2 - t=k(0)**2-k(1)**2-k(2)**2-k(3)**2 -c - das=-r_one/s - dat=-r_one/t - dzs=-r_one/dcmplx( s-dmz**2 , dmax1(dsign(dmz*dwidth,s),r_zero) ) - dzt=-r_one/dcmplx( t-dmz**2 , dmax1(dsign(dmz*dwidth,t),r_zero) ) -c - sv1= (dp2(0)+q(0))*dv1(0) -(dp2(1)+q(1))*dv1(1) - & -(dp2(2)+q(2))*dv1(2) -(dp2(3)+q(3))*dv1(3) - sv2=-(dp1(0)+q(0))*dv2(0) +(dp1(1)+q(1))*dv2(1) - & +(dp1(2)+q(2))*dv2(2) +(dp1(3)+q(3))*dv2(3) - sv3= (dp4(0)-q(0))*dv3(0) -(dp4(1)-q(1))*dv3(1) - & -(dp4(2)-q(2))*dv3(2) -(dp4(3)-q(3))*dv3(3) - sv4=-(dp3(0)-q(0))*dv4(0) +(dp3(1)-q(1))*dv4(1) - & +(dp3(2)-q(2))*dv4(2) +(dp3(3)-q(3))*dv4(3) -c - tv1= (dp4(0)+k(0))*dv1(0) -(dp4(1)+k(1))*dv1(1) - & -(dp4(2)+k(2))*dv1(2) -(dp4(3)+k(3))*dv1(3) - tv2=-(dp3(0)-k(0))*dv2(0) +(dp3(1)-k(1))*dv2(1) - & +(dp3(2)-k(2))*dv2(2) +(dp3(3)-k(3))*dv2(3) - tv3= (dp2(0)-k(0))*dv3(0) -(dp2(1)-k(1))*dv3(1) - & -(dp2(2)-k(2))*dv3(2) -(dp2(3)-k(3))*dv3(3) - tv4=-(dp1(0)+k(0))*dv4(0) +(dp1(1)+k(1))*dv4(1) - & +(dp1(2)+k(2))*dv4(2) +(dp1(3)+k(3))*dv4(3) -c - j12(0)=(dp1(0)-dp2(0))*v12 +sv1*dv2(0) +sv2*dv1(0) - j12(1)=(dp1(1)-dp2(1))*v12 +sv1*dv2(1) +sv2*dv1(1) - j12(2)=(dp1(2)-dp2(2))*v12 +sv1*dv2(2) +sv2*dv1(2) - j12(3)=(dp1(3)-dp2(3))*v12 +sv1*dv2(3) +sv2*dv1(3) - j34(0)=(dp3(0)-dp4(0))*v34 +sv3*dv4(0) +sv4*dv3(0) - j34(1)=(dp3(1)-dp4(1))*v34 +sv3*dv4(1) +sv4*dv3(1) - j34(2)=(dp3(2)-dp4(2))*v34 +sv3*dv4(2) +sv4*dv3(2) - j34(3)=(dp3(3)-dp4(3))*v34 +sv3*dv4(3) +sv4*dv3(3) -c - j14(0)=(dp1(0)-dp4(0))*v14 +tv1*dv4(0) +tv4*dv1(0) - j14(1)=(dp1(1)-dp4(1))*v14 +tv1*dv4(1) +tv4*dv1(1) - j14(2)=(dp1(2)-dp4(2))*v14 +tv1*dv4(2) +tv4*dv1(2) - j14(3)=(dp1(3)-dp4(3))*v14 +tv1*dv4(3) +tv4*dv1(3) - j32(0)=(dp3(0)-dp2(0))*v23 +tv3*dv2(0) +tv2*dv3(0) - j32(1)=(dp3(1)-dp2(1))*v23 +tv3*dv2(1) +tv2*dv3(1) - j32(2)=(dp3(2)-dp2(2))*v23 +tv3*dv2(2) +tv2*dv3(2) - j32(3)=(dp3(3)-dp2(3))*v23 +tv3*dv2(3) +tv2*dv3(3) -c - js12=q(0)*j12(0)-q(1)*j12(1)-q(2)*j12(2)-q(3)*j12(3) - js34=q(0)*j34(0)-q(1)*j34(1)-q(2)*j34(2)-q(3)*j34(3) - js14=k(0)*j14(0)-k(1)*j14(1)-k(2)*j14(2)-k(3)*j14(3) - js32=k(0)*j32(0)-k(1)*j32(1)-k(2)*j32(2)-k(3)*j32(3) -c - js=j12(0)*j34(0)-j12(1)*j34(1)-j12(2)*j34(2)-j12(3)*j34(3) - jt=j14(0)*j32(0)-j14(1)*j32(1)-j14(2)*j32(2)-j14(3)*j32(3) -c - dvertx = (v12*v34 +v14*v23 -r_two*v13*v24)*dgw2 - -c & +(dzs*dgwwz2+das*dgwwa2)*js -dzs*dgwwz2*js12*js34/dmz**2 -c & +(dzt*dgwwz2+dat*dgwwa2)*jt -dzt*dgwwz2*js14*js32/dmz**2 -c - vertex = -dcmplx( dvertx ) -c - return - end subroutine - end module dhelas95 Index: branches/ohl/omega-development/completed/whizard2/tests/SM/Makefile.in =================================================================== --- branches/ohl/omega-development/completed/whizard2/tests/SM/Makefile.in (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/tests/SM/Makefile.in (revision 8703) @@ -1,837 +0,0 @@ -# $Id$ -# -# Copyright (C) 1999-2009 by -# -# Wolfgang Kilian -# Thorsten Ohl -# Juergen Reuter -# -# WHIZARD is free software; you can redistribute it and/or modify it -# under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2, or (at your option) -# any later version. -# -# WHIZARD is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -# -######################################################################## - -N = 100 -TOLERANCE = 1000000 - -prefix = @prefix@ -srcdir = @srcdir@ -top_srcdir = @top_srcdir@ - -host = @host@ -build_bindir = $(top_srcdir)/bin -build_libdir = $(top_srcdir)/lib -build_srcdir = $(top_srcdir)/tests/SM -build_tooldir = $(top_srcdir)/tools - -# OMEGA_QED = $(build_bindir)/helas_QED.opt -OMEGA_QED = $(build_bindir)/f90_QED.opt - -OMEGA_SM = $(build_bindir)/f90_SM.opt -# OMEGA_SM = $(build_bindir)/f90_SM_ac.opt -# OMEGA_SM = $(build_bindir)/f90_SM3.opt -# OMEGA_SM = $(build_bindir)/f90Maj_SM.opt -# OMEGA_SM = $(build_bindir)/f90Maj_SM3.opt -# OMEGA_SM = $(build_bindir)/helas_SM.opt - -OMEGA_SMG = $(build_bindir)/f90_SM_clones.opt -# OMEGA_SMG = $(build_bindir)/f90_SM3_clones.opt - -OFLAGS = -target:function $(@:_module.f95=) -target:module $(@:.f95=) -old-interface - -FC = @FC@ -FC_OPT = @FC_OPT@ -FC_PROF = @FC_PROF@ -FC_EXT = @FC_EXT@ -FC_PURE = @FC_PURE@ -FC_VENDOR = @FC_VENDOR@ -FC_DUSTY = -FI -# FC_DUSTY = @FC_DUSTY@ -FC_WIDE = @FC_WIDE@ -# -FI option for compiling in fixed format -FC_FLAGS = $(FC_OPT) -I$(build_libdir) - -ifeq ($(FC_PURE), yes) -FC_FILTER = $(CPIF) -else -FC_FILTER = \ - sed -e '/^[ ]*elemental[ ]/s/elemental[ ]//' \ - -e '/^[ ]*pure[ ]/s/pure[ ]//' | $(CPIF) -endif - -RANLIB = @RANLIB@ -CPIF = @CPIF@ - -HELAS = dhelas95 - -MADGRAPH = @MADGRAPH@ -MG_QED = echo 0; echo; echo; echo -MG_SM = echo 0; echo yes; echo; echo - - -RUN_MADGRAPH = $(top_srcdir)/$(MADGRAPH); rm $(@:.f95=.ps); mv $(@:.f95=.f) $@ - - -LIBS = $(build_libdir)/libomega95.a $(build_libdir)/libomega95_tools.a - -FC_LIB_FLAGS = -L$(build_libdir) -lomega95_tools -lomega95 -L. -l$(HELAS) - -OMEGA_SRC4 = \ - obbb_wpwm_module.f95 ozz_hh_module.f95 \ - oepem_wpwm_module.f95 owpwm_wpwm_module.f95 \ - owpwm_zz_module.f95 owpwm_za_module.f95 owpwm_aa_module.f95 \ - oepem_epem_module.f95 oepem_veve_module.f95 \ - oudb_udb_module.f95 oepem_mumu_module.f95 \ - oemem_emem_module.f95 oema_ema_module.f95 \ - oaa_epem_module.f95 oza_epem_module.f95 \ - oza_uub_module.f95 oza_ddb_module.f95 \ - ozz_epem_module.f95 ozz_veve_module.f95 \ - oepem_aa_module.f95 oepem_za_module.f95 oepem_zz_module.f95 - -OMEGA_SRC5 = \ - oepem_epema_module.f95 oemem_emema_module.f95 \ - oepem_aaa_module.f95 oepem_zaa_module.f95 \ - oemep_emvewp_module.f95 \ - oepem_wpwmz_module.f95 oepem_wpwma_module.f95 - -OMEGA_SRC6 = \ - oepem_muvmtavt_module.f95 oepem_epveemve_module.f95 \ - oepem_mumuaa_module.f95 oepem_epemaa_module.f95 \ - omuem_muemaa_module.f95 oemem_ememaa_module.f95 \ - oepem_aaaa_module.f95 oepem_epemepem_module.f95 \ - oemep_emvewpa_module.f95 oemep_vevewpwm_module.f95 \ - oemep_emepwpwm_module.f95 owpwm_uubssb_module.f95 \ - oepem_vevebbb_module.f95 - -OMEGA_SRC7 = \ - oepem_muvmtavta_module.f95 oemep_emveudba_module.f95 \ - oepem_aaaaa_module.f95 oepem_epemaaa_module.f95 \ - oepem_epemepema_module.f95 oaa_epemaaa_module.f95 \ - oaa_epemmumua_module.f95 oaa_epemepema_module.f95 \ - oepem_veveuubz_module.f95 - -OMEGA_SRC8 = \ - oepem_muvmtavtaa_module.f95 oepem_epemaaaa_module.f95 \ - oepem_mumutatauub_module.f95 oepem_muvmtavtuub_module.f95 \ - oepem_vevemuvmudb_module.f95 - -OMEGA_SRCX = \ - oepem_wpwmaa_module.f95 \ - oepem_muvmtavtaa_module.f95 \ - owpwm_zaa_module.f95 owpwm_aaa_module.f95 owpwm_wpwma_module.f95 \ - oepem_epvebbbdub_module.f95 - -# OMEGA_SRCT = \ -# single_top_module.f95 \ -# single_top_fudged_module.f95 \ -# single_top_constant_module.f95 - -OMEGA_SRCT = oepem_wpwm_module.f95 - -OMEGA_SRC = \ - $(OMEGA_SRC4) $(OMEGA_SRC5) $(OMEGA_SRC6) \ - $(OMEGA_SRC7) $(OMEGA_SRC8) $(OMEGA_SRCX) - -MADGRAPH_SRC4 = $(patsubst o%_module.f95,%.f95, $(OMEGA_SRC4)) -MADGRAPH_SRC5 = $(patsubst o%_module.f95,%.f95, $(OMEGA_SRC5)) -MADGRAPH_SRC6 = $(patsubst o%_module.f95,%.f95, $(OMEGA_SRC6)) -MADGRAPH_SRC7 = $(patsubst o%_module.f95,%.f95, $(OMEGA_SRC7)) -MADGRAPH_SRC8 = $(patsubst o%_module.f95,%.f95, $(OMEGA_SRC8)) -MADGRAPH_SRCX = $(patsubst o%_module.f95,%.f95, $(OMEGA_SRCX)) -MADGRAPH_SRC = $(patsubst o%_module.f95,%.f95, $(OMEGA_SRC)) - -OMEGA_OBJ4 = $(OMEGA_SRC4:.f95=.o) -OMEGA_OBJ5 = $(OMEGA_SRC5:.f95=.o) -OMEGA_OBJ6 = $(OMEGA_SRC6:.f95=.o) -OMEGA_OBJ7 = $(OMEGA_SRC7:.f95=.o) -OMEGA_OBJ8 = $(OMEGA_SRC8:.f95=.o) -OMEGA_OBJX = $(OMEGA_SRCX:.f95=.o) -OMEGA_OBJ = $(OMEGA_SRC:.f95=.o) - -OMEGA_OBJT = $(OMEGA_SRCT:.f95=.o) - -all: main4 main5 main6 main7 main8 mainx - -runall: run4 run5 run6 run7 run8 runx - -run%: main% - echo N = $(N), TOLERANCE = $(TOLERANCE) | ./$< - -######################################################################## - -OBJS4 = madgraph4.o $(OMEGA_OBJ4) omega_amplitudes4.o -OBJS5 = madgraph5.o $(OMEGA_OBJ5) omega_amplitudes5.o -OBJS6 = madgraph6.o $(OMEGA_OBJ6) omega_amplitudes6.o -OBJS7 = madgraph7.o $(OMEGA_OBJ7) omega_amplitudes7.o -OBJS8 = madgraph8.o $(OMEGA_OBJ8) omega_amplitudes8.o -OBJSX = madgraphx.o $(OMEGA_OBJX) omega_amplitudesx.o -OBJST = $(OMEGA_OBJT) omega_amplitudest.o - -######################################################################## -# There are no Modula(n) sources here ... -%.o: %.mod -######################################################################## - -$(build_srcdir)/%.$(FC_EXT): %.f95 - cat $< | $(FC_FILTER) $(build_srcdir)/$*.$(F95_EXT) - -%.o: $(build_srcdir)/%.$(FC_EXT) - $(FC) $(FC_FLAGS) -c -o $@ $< - -%_p.o: $(build_srcdir)/%.$(FC_EXT) - $(FC) $(FC_FLAGS) $(FC_PROF) -c -o $@ $< - -######################################################################## - -main4: main4.o $(LIBS) - $(FC) $(FC_FLAGS) -o $@ $(OBJS4) main4.o $(FC_LIB_FLAGS) - -main5: main5.o $(LIBS) - $(FC) $(FC_FLAGS) -o $@ $(OBJS5) main5.o $(FC_LIB_FLAGS) - -main6: main6.o $(LIBS) - $(FC) $(FC_FLAGS) -o $@ $(OBJS6) main6.o $(FC_LIB_FLAGS) - -main7: main7.o $(LIBS) - $(FC) $(FC_FLAGS) -o $@ $(OBJS7) main7.o $(FC_LIB_FLAGS) - -main8: main8.o $(LIBS) - $(FC) $(FC_FLAGS) -o $@ $(OBJS8) main8.o $(FC_LIB_FLAGS) - -mainx: mainx.o $(LIBS) - $(FC) $(FC_FLAGS) -o $@ $(OBJSX) mainx.o $(FC_LIB_FLAGS) - -maint: maint.o $(LIBS) - $(FC) $(FC_FLAGS) -o $@ $(OBJST) maint.o $(FC_LIB_FLAGS) - -madgraph4.o: $(build_srcdir)/madgraph4.$(FC_EXT) lib$(HELAS).a - $(FC) $(FC_DUSTY) $(FC_FLAGS) $(FC_WIDE) -c -o $@ $< - -madgraph5.o: $(build_srcdir)/madgraph5.$(FC_EXT) lib$(HELAS).a - $(FC) $(FC_DUSTY) $(FC_FLAGS) $(FC_WIDE) -c -o $@ $< - -madgraph6.o: $(build_srcdir)/madgraph6.$(FC_EXT) lib$(HELAS).a - $(FC) $(FC_DUSTY) $(FC_FLAGS) $(FC_WIDE) -c -o $@ $< - -madgraph7.o: $(build_srcdir)/madgraph7.$(FC_EXT) lib$(HELAS).a - $(FC) $(FC_DUSTY) $(FC_FLAGS) $(FC_WIDE) -c -o $@ $< - -madgraph8.o: $(build_srcdir)/madgraph8.$(FC_EXT) lib$(HELAS).a - $(FC) $(FC_DUSTY) $(FC_FLAGS) $(FC_WIDE) -c -o $@ $< - -madgraphx.o: $(build_srcdir)/madgraphx.$(FC_EXT) lib$(HELAS).a - $(FC) $(FC_DUSTY) $(FC_FLAGS) $(FC_WIDE) -c -o $@ $< - -######################################################################## -# -# 4 external lines: -# -######################################################################## - -ozz_hh_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "Z Z -> H H" >$@ - -obbb_wpwm_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "b bbar -> W+ W-" >$@ - -owpwm_aa_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "W+ W- -> A A" >$@ - -owpwm_za_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "W+ W- -> Z A" >$@ - -owpwm_zz_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "W+ W- -> Z Z" >$@ - -owpwm_wpwm_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "W+ W- -> W+ W-" >$@ - -oepem_wpwm_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> W+ W-" >$@ - -oepem_epem_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> e+ e-" >$@ - -oepem_veve_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> nue nuebar" >$@ - -oudb_udb_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "u dbar -> u dbar" >$@ - -oepem_mumu_module.f95: $(OMEGA_QED) - $(OMEGA_QED) $(OFLAGS) -scatter "e+ e- -> m+ m-" >$@ - -oepem_aa_module.f95: $(OMEGA_QED) - $(OMEGA_QED) $(OFLAGS) -scatter "e+ e- -> A A" >$@ - -oepem_za_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> Z A" >$@ - -oepem_zz_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> Z Z" >$@ - -oaa_epem_module.f95: $(OMEGA_QED) - $(OMEGA_QED) $(OFLAGS) -scatter "A A -> e+ e-" >$@ - -oza_epem_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "Z A -> e+ e-" >$@ - -ozz_epem_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "Z Z -> e+ e-" >$@ - -ozz_veve_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "Z Z -> nue nuebar" >$@ - -oza_uub_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "Z A -> u ubar" >$@ - -oza_ddb_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "Z A -> d dbar" >$@ - -oemem_emem_module.f95: $(OMEGA_QED) - $(OMEGA_QED) $(OFLAGS) -scatter "e- e- -> e- e-" >$@ - -oema_ema_module.f95: $(OMEGA_QED) - $(OMEGA_QED) $(OFLAGS) -scatter "e- A -> e- A" >$@ - -ifneq ($(MADGRAPH),false) - -zz_hh.f95: - (echo "z z -> h h"; $(MG_SM)) | $(RUN_MADGRAPH) - -bbb_wpwm.f95: - (echo "b b~ -> w+ w-"; $(MG_SM)) | $(RUN_MADGRAPH) - -wpwm_wpwm.f95: - (echo "w+ w- -> w+ w-"; $(MG_SM)) | $(RUN_MADGRAPH) - -wpwm_aa.f95: - (echo "w+ w- -> a a"; $(MG_SM)) | $(RUN_MADGRAPH) - -wpwm_za.f95: - (echo "w+ w- -> z a"; $(MG_SM)) | $(RUN_MADGRAPH) - -wpwm_zz.f95: - (echo "w+ w- -> z z"; $(MG_SM)) | $(RUN_MADGRAPH) - -epem_wpwm.f95: - (echo "e+ e- -> w+ w-"; $(MG_SM)) | $(RUN_MADGRAPH) - -epem_epem.f95: - (echo "e+ e- -> e+ e-"; $(MG_SM)) | $(RUN_MADGRAPH) - -udb_udb.f95: - (echo "u d~ -> u d~"; $(MG_SM)) | $(RUN_MADGRAPH) - -epem_veve.f95: - (echo "e+ e- -> ve ve~"; $(MG_SM)) | $(RUN_MADGRAPH) - -epem_mumu.f95: - (echo "e+ e- -> mu+ mu-"; $(MG_QED)) | $(RUN_MADGRAPH) - -epem_aa.f95: - (echo "e+ e- -> a a"; $(MG_QED)) | $(RUN_MADGRAPH) - -epem_za.f95: - (echo "e+ e- -> z a"; $(MG_SM)) | $(RUN_MADGRAPH) - -epem_zz.f95: - (echo "e+ e- -> z z"; $(MG_SM)) | $(RUN_MADGRAPH) - -aa_epem.f95: - (echo "a a -> e+ e-"; $(MG_QED)) | $(RUN_MADGRAPH) - -za_epem.f95: - (echo "z a -> e+ e-"; $(MG_SM)) | $(RUN_MADGRAPH) - -za_uub.f95: - (echo "z a -> u u~"; $(MG_SM)) | $(RUN_MADGRAPH) - -za_ddb.f95: - (echo "z a -> d d~"; $(MG_SM)) | $(RUN_MADGRAPH) - -zz_epem.f95: - (echo "z z -> e+ e-"; $(MG_SM)) | $(RUN_MADGRAPH) - -zz_veve.f95: - (echo "z z -> ve ve~"; $(MG_SM)) | $(RUN_MADGRAPH) - -emem_emem.f95: - (echo "e- e- -> e- e-"; $(MG_QED)) | $(RUN_MADGRAPH) - -ema_ema.f95: - (echo "e- a -> e- a"; $(MG_QED)) | $(RUN_MADGRAPH) - -endif - -######################################################################## -# -# 5 external lines: -# -######################################################################## - -owpwm_zaa_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "W+ W- -> Z A A" >$@ - -owpwm_wpwma_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "W+ W- -> W+ W- A" >$@ - -owpwm_aaa_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "W+ W- -> A A A" >$@ - -oemep_emvewp_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "e- e+ -> e- nuebar W+" >$@ - -oepem_epema_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> e+ e- A" >$@ - -oemem_emema_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "e- e- -> e- e- A" >$@ - -oepem_aaa_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> A A A" >$@ - -oepem_zaa_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> Z A A" >$@ - -oepem_wpwmz_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> W+ W- Z" >$@ - -oepem_wpwma_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> W+ W- A" >$@ - -ifneq ($(MADGRAPH),false) - -wpwm_zaa.f95: - (echo "w+ w- -> z a a"; $(MG_SM)) | $(RUN_MADGRAPH) - -wpwm_wpwma.f95: - (echo "w+ w- -> w+ w- a"; $(MG_SM)) | $(RUN_MADGRAPH) - -wpwm_aaa.f95: - (echo "w+ w- -> a a a"; $(MG_SM)) | $(RUN_MADGRAPH) - -emep_emvewp.f95: - (echo "e- e+ -> e- ve~ w+"; $(MG_SM)) | $(RUN_MADGRAPH) - -epem_epema.f95: - (echo "e+ e- -> e+ e- a"; $(MG_SM)) | $(RUN_MADGRAPH) - -emem_emema.f95: - (echo "e- e- -> e- e- a"; $(MG_SM)) | $(RUN_MADGRAPH) - -epem_aaa.f95: - (echo "e+ e- -> a a a"; $(MG_SM)) | $(RUN_MADGRAPH) - -epem_zaa.f95: - (echo "e+ e- -> z a a"; $(MG_SM)) | $(RUN_MADGRAPH) - -epem_wpwmz.f95: - (echo "e+ e- -> w+ w- z"; $(MG_SM)) | $(RUN_MADGRAPH) - -epem_wpwma.f95: - (echo "e+ e- -> w+ w- a"; $(MG_SM)) | $(RUN_MADGRAPH) - -endif - -######################################################################## -# -# 6 external lines: -# -######################################################################## - -# oemep_emvewpa_module.f95: $(OMEGA_SM) -# $(OMEGA_SM) $(OFLAGS) -scatter "e- e+ -> e- nuebar W+ A" >$@ - -oemep_emvewpa_module.f95: $(OMEGA_SM) $(OMEGA_SMG) Makefile - $(OMEGA_SM) $(OFLAGS) \ - -scatter "e- e+ -> e- nuebar W+ A" | \ - sed -e '/^end module/d' \ - -e '/public ::/s/$$/, oemep_emvewpa_groves/' >$@ - echo "pure function oemep_emvewpa_groves (k, s) result (amp)" >>$@ - echo " implicit none" >>$@ - echo " real(kind=default), dimension(0:,:), intent(in) :: k" >>$@ - echo " integer, dimension(:), intent(in) :: s" >>$@ - echo " complex(kind=default) :: amp" >>$@ - echo " amp = oemep_emvewpa_t (k, s) + oemep_emvewpa_s (k, s)" >>$@ - echo "end function oemep_emvewpa_groves" >>$@ - $(OMEGA_SMG) $(OFLAGS) \ - -target:function $(@:_module.f95=_t) -target:module $(@:.f95=) \ - -scatter "e-/2 e+/1 -> e-/2 nuebar/1 W+ A" | \ - sed -e '/^module/,/^contains/d' -e '/^end module/d' >>$@ - $(OMEGA_SMG) $(OFLAGS) \ - -target:function $(@:_module.f95=_s) -target:module $(@:.f95=) \ - -scatter "e-/1 e+/1 -> e-/2 nuebar/2 W+ A" | \ - sed -e '/^module/,/^contains/d' >>$@ - -owpwm_uubssb_module.f95: - $(OMEGA_SM) $(OFLAGS) \ - -target:function $(@:_module.f95=) -target:module $(@:.f95=) \ - -scatter "W+ W- -> u ubar s sbar" | \ - sed '/! CAVEAT: color factor not known!/s||amp = amp * sqrt (9.0_default / 1.0_default) ! CAVEAT: naive color factor|' >$@ - -oemep_vevewpwm_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "e- e+ -> nue nuebar W+ W-" >$@ - -oemep_emepwpwm_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "e- e+ -> e- e+ W+ W-" >$@ - -oepem_muvmtavt_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> mu- numubar tau+ nutau" >$@ - -oepem_epveemve_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> e+ nue e- nuebar" >$@ - -oepem_mumuaa_module.f95: $(OMEGA_QED) - $(OMEGA_QED) $(OFLAGS) -scatter "e+ e- -> m+ m- A A" >$@ - -oepem_epemaa_module.f95: $(OMEGA_QED) - $(OMEGA_QED) $(OFLAGS) -scatter "e+ e- -> e+ e- A A" >$@ - -omuem_muemaa_module.f95: $(OMEGA_QED) - $(OMEGA_QED) $(OFLAGS) -scatter "m- e- -> m- e- A A" >$@ - -oemem_ememaa_module.f95: $(OMEGA_QED) - $(OMEGA_QED) $(OFLAGS) -scatter "e- e- -> e- e- A A" >$@ - -oepem_aaaa_module.f95: $(OMEGA_QED) - $(OMEGA_QED) $(OFLAGS) -scatter "e+ e- -> A A A A" >$@ - -oepem_epemepem_module.f95: $(OMEGA_QED) - $(OMEGA_QED) $(OFLAGS) -scatter "e+ e- -> e+ e- e+ e-" >$@ - -oepem_wpwmaa_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> W+ W- A A" >$@ - -oepem_vevebbb_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> nue nuebar b bbar" >$@ - -ifneq ($(MADGRAPH),false) - -wpwm_uubssb.f95: - (echo "w+ w- -> u u~ s s~"; $(MG_SM)) | $(RUN_MADGRAPH) - -emep_vevewpwm.f95: - (echo "e- e+ -> ve ve~ w+ w-"; $(MG_SM)) | $(RUN_MADGRAPH) - -emep_emepwpwm.f95: - (echo "e- e+ -> e- e+ w+ w-"; $(MG_SM)) | $(RUN_MADGRAPH) - -emep_emvewpa.f95: - (echo "e- e+ -> e- ve~ w+ a"; $(MG_SM)) | $(RUN_MADGRAPH) - -epem_muvmtavt.f95: - (echo "e+ e- -> mu- vm~ ta+ vt"; $(MG_SM)) | $(RUN_MADGRAPH) - -epem_epveemve.f95: - (echo "e+ e- -> e+ ve e- ve~"; $(MG_SM)) | $(RUN_MADGRAPH) - -epem_mumuaa.f95: - (echo "e+ e- -> mu+ mu- a a"; $(MG_QED)) | $(RUN_MADGRAPH) - -epem_epemaa.f95: - (echo "e+ e- -> e+ e- a a"; $(MG_QED)) | $(RUN_MADGRAPH) - -muem_muemaa.f95: - (echo "mu- e- -> mu- e- a a"; $(MG_QED)) | $(RUN_MADGRAPH) - -emem_ememaa.f95: - (echo "e- e- -> e- e- a a"; $(MG_QED)) | $(RUN_MADGRAPH) - -epem_aaaa.f95: - (echo "e+ e- -> a a a a"; $(MG_QED)) | $(RUN_MADGRAPH) - -epem_epemepem.f95: - (echo "e+ e- -> e+ e- e+ e-"; $(MG_QED)) | $(RUN_MADGRAPH) - -epem_wpwmaa.f95: - (echo "e+ e- -> w+ w- a a"; $(MG_SM)) | $(RUN_MADGRAPH) - -epem_vevebbb.f95: - (echo "e+ e- -> ve ve~ b b~"; $(MG_SM)) | $(RUN_MADGRAPH) - -endif - -######################################################################## -# -# 7 external lines: -# -######################################################################## - -# oemep_emveudba_module.f95: $(OMEGA_SM) -# $(OMEGA_SM) $(OFLAGS) e- e+ e- nuebar u dbar A >$@ - -oemep_emveudba_module.f95: $(OMEGA_SM) $(OMEGA_SMG) Makefile - $(OMEGA_SM) $(OFLAGS) \ - -scatter "e- e+ -> e- nuebar u dbar A" | \ - sed -e '/^end module/d' \ - -e '/public ::/s/$$/, oemep_emveudba_groves/' >$@ - echo "pure function oemep_emveudba_groves (k, s) result (amp)" >>$@ - echo " implicit none" >>$@ - echo " real(kind=default), dimension(0:,:), intent(in) :: k" >>$@ - echo " integer, dimension(:), intent(in) :: s" >>$@ - echo " complex(kind=default) :: amp" >>$@ - echo " amp = oemep_emveudba_t (k, s) + oemep_emveudba_s (k, s)" >>$@ - echo "end function oemep_emveudba_groves" >>$@ - $(OMEGA_SMG) $(OFLAGS) \ - -target:function $(@:_module.f95=_t) -target:module $(@:.f95=) \ - -scatter "e-/2 e+/1 -> e-/2 nuebar/1 u dbar A" | \ - sed -e '/^module/,/^contains/d' -e '/^end module/d' >>$@ - $(OMEGA_SMG) $(OFLAGS) \ - -target:function $(@:_module.f95=_s) -target:module $(@:.f95=) \ - -scatter "e-/1 e+/1 -> e-/2 nuebar/2 u dbar A" | \ - sed -e '/^module/,/^contains/d' >>$@ - -oepem_veveuubz_module.f95: - $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> nue nuebar u ubar Z" >$@ - -oepem_muvmtavta_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> mu- numubar tau+ nutau A" >$@ - -oepem_epemepema_module.f95: $(OMEGA_QED) - $(OMEGA_QED) $(OFLAGS) -scatter "e+ e- -> e+ e- e+ e- A" >$@ - -oepem_epemaaa_module.f95: $(OMEGA_QED) - $(OMEGA_QED) $(OFLAGS) -scatter "e+ e- -> e+ e- A A A" >$@ - -oepem_aaaaa_module.f95: $(OMEGA_QED) - $(OMEGA_QED) $(OFLAGS) -scatter "e+ e- -> A A A A A" >$@ - -oaa_epemaaa_module.f95: $(OMEGA_QED) - $(OMEGA_QED) $(OFLAGS) -scatter "A A -> e+ e- A A A" >$@ - -oaa_epemmumua_module.f95: $(OMEGA_QED) - $(OMEGA_QED) $(OFLAGS) -scatter "A A -> e+ e- m+ m- A" >$@ - -oaa_epemepema_module.f95: $(OMEGA_QED) - $(OMEGA_QED) $(OFLAGS) -scatter "A A -> e+ e- e+ e- A" >$@ - -ifneq ($(MADGRAPH),false) - -epem_veveuubz.f95: - (echo "e+ e- -> ve ve~ u u~ Z"; $(MG_SM)) | $(RUN_MADGRAPH) - -emep_emveudba.f95: - (echo "e- e+ -> e- ve~ u d~ a"; $(MG_SM)) | $(RUN_MADGRAPH) - -epem_muvmtavta.f95: - (echo "e+ e- -> mu- vm~ ta+ vt a"; $(MG_SM)) | $(RUN_MADGRAPH) - -epem_epemaaa.f95: - (echo "e+ e- -> e+ e- a a a"; $(MG_QED)) | $(RUN_MADGRAPH) - -epem_epemepema.f95: - (echo "e+ e- -> e+ e- e+ e- a"; $(MG_QED)) | $(RUN_MADGRAPH) - -epem_aaaaa.f95: - (echo "e+ e- -> a a a a a"; $(MG_QED)) | $(RUN_MADGRAPH) - -aa_epemaaa.f95: - (echo "a a -> e+ e- a a a"; $(MG_QED)) | $(RUN_MADGRAPH) - -aa_epemmumua.f95: - (echo "a a -> e+ e- mu+ mu- a"; $(MG_QED)) | $(RUN_MADGRAPH) - -aa_epemepema.f95: - (echo "a a -> e+ e- e+ e- a"; $(MG_QED)) | $(RUN_MADGRAPH) - -endif - -######################################################################## -# -# 8 external lines: -# -######################################################################## - -oepem_muvmtavtaa_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> mu- numubar tau+ nutau A A" >$@ - -oepem_epemaaaa_module.f95: $(OMEGA_QED) - $(OMEGA_QED) $(OFLAGS) -scatter "e+ e- -> e+ e- A A A A" >$@ - -oepem_mumutatauub_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> mu+ mu- tau+ tau- u ubar" >$@ - -oepem_muvmtavtuub_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> mu- numubar tau+ nutau u ubar" >$@ - -oepem_vevemuvmudb_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> nue nuebar mu- numubar u dbar" >$@ - -oepem_epvebbbdub_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> e+ nue b bbar d ubar" | \ - sed '/! CAVEAT: color factor not known!/s||amp = amp * sqrt (9.0_default / 1.0_default) ! CAVEAT: naive color factor|' >$@ - -single_top_module.f95: $(OMEGA_SM) - $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> e+ nue b bbar d ubar" >$@ - -single_top_fudged_module.f95: $(OMEGA_SM) - $(OMEGA_SM) -model:fudged_width $(OFLAGS) \ - -scatter "e+ e- -> e+ nue b bbar d ubar" >$@ - -single_top_constant_module.f95: $(OMEGA_SM) - $(OMEGA_SM) -model:constant_width $(OFLAGS) \ - -scatter "e+ e- -> e+ nue b bbar d ubar" >$@ - -ifneq ($(MADGRAPH),false) - -epem_muvmtavtaa.f95: - (echo "e+ e- -> mu- vm~ ta+ vt a a"; $(MG_SM)) | $(RUN_MADGRAPH) - -epem_epemaaaa.f95: - (echo "e+ e- -> e+ e- a a a a"; $(MG_QED)) | $(RUN_MADGRAPH) - -epem_mumutatauub.f95: - (echo "e+ e- -> mu+ mu- ta+ ta- u u~"; $(MG_SM)) | $(RUN_MADGRAPH) - -epem_muvmtavtuub.f95: - (echo "e+ e- -> mu- vm~ ta+ vt u u~"; $(MG_SM)) | $(RUN_MADGRAPH) - -epem_vevemuvmudb.f95: - (echo "e+ e- -> ve ve~ mu- vm~ u d~"; $(MG_SM)) | $(RUN_MADGRAPH) - -epem_epvebbbdub.f95: - (echo "e+ e- -> e+ ve b b~ d u~"; $(MG_SM)) | $(RUN_MADGRAPH) - -endif - -######################################################################## - -lib$(HELAS).a: $(HELAS).o - ar cr $@ $< - -$(HELAS).o: $(build_srcdir)/$(HELAS).$(FC_EXT) - $(FC) $(FC_DUSTY) $(FC_FLAGS) -c -o $@ $< - -clean: - rm -f *.o main[4-9] *~ *.mod *_*.f* omega_cache_* - -purge: purge_omega purge_madlab - -purge_omega: - rm -f $(OMEGA_SRC) - -purge_madlab: - rm -f $(MADGRAPH_SRC) - -compare: - $(MAKE) -n -W $(OMEGA_QED) -W $(OMEGA_SM) \ - | egrep '$(OMEGA_QED)|$(OMEGA_SM)' \ - | sed -e 's/>/>tmp.compare; diff -I"^!" -u /' -e 's/$$/ tmp.compare/' | sh - -MADGRAPH_HEADER = \ - echo " use $(HELAS)"; \ - echo " use omega_parameters_madgraph"; \ - echo " implicit none"; \ - echo " integer,parameter :: D = selected_real_kind(14,100)"; \ - echo " contains"; \ - sed -e 'y/abcdefghijklmnopqrstuvwxyz/ABCDEFGHIJKLMNOPQRSTUVWXYZ/' \ - -e 's/END *$$/END FUNCTION/' \ - -e '/WRITE/s//! WRITE/' \ - -e '/INTERFACE/,/END INTERFACE/s/^/!!! /' \ - -e '/GLOBAL VARIABLES/,/COLOR DATA/s/^/!!! /' - -madgraph4.f95: $(MADGRAPH_SRC4) Makefile - (echo " module madgraph4"; \ - $(MADGRAPH_HEADER) $(MADGRAPH_SRC4); \ - echo " end module madgraph4" ) >$@ - -madgraph5.f95: $(MADGRAPH_SRC5) Makefile - (echo " module madgraph5"; \ - $(MADGRAPH_HEADER) $(MADGRAPH_SRC5); \ - echo " end module madgraph5" ) >$@ - -madgraph6.f95: $(MADGRAPH_SRC6) Makefile - (echo " module madgraph6"; \ - $(MADGRAPH_HEADER) $(MADGRAPH_SRC6); \ - echo " end module madgraph6" ) >$@ - -madgraph7.f95: $(MADGRAPH_SRC7) Makefile - (echo " module madgraph7"; \ - $(MADGRAPH_HEADER) $(MADGRAPH_SRC7); \ - echo " end module madgraph7" ) >$@ - -madgraph8.f95: $(MADGRAPH_SRC8) Makefile - (echo " module madgraph8"; \ - $(MADGRAPH_HEADER) $(MADGRAPH_SRC8); \ - echo " end module madgraph8" ) >$@ - -madgraphx.f95: $(MADGRAPH_SRCX) Makefile - (echo " module madgraphx"; \ - $(MADGRAPH_HEADER) $(MADGRAPH_SRCX); \ - echo " end module madgraphx" ) >$@ - -omega_amplitudes4.f95: Makefile - (echo "module $(@:.f95=)"; \ - for m in $(OMEGA_SRC4:.f95=); do echo " use $$m"; done; \ - echo " public"; \ - echo "end module $(@:.f95=)") >$@ - -omega_amplitudes5.f95: Makefile - (echo "module $(@:.f95=)"; \ - for m in $(OMEGA_SRC5:.f95=); do echo " use $$m"; done; \ - echo " public"; \ - echo "end module $(@:.f95=)") >$@ - -omega_amplitudes6.f95: Makefile - (echo "module $(@:.f95=)"; \ - for m in $(OMEGA_SRC6:.f95=); do echo " use $$m"; done; \ - echo " public"; \ - echo "end module $(@:.f95=)") >$@ - -omega_amplitudes7.f95: Makefile - (echo "module $(@:.f95=)"; \ - for m in $(OMEGA_SRC7:.f95=); do echo " use $$m"; done; \ - echo " public"; \ - echo "end module $(@:.f95=)") >$@ - -omega_amplitudes8.f95: Makefile - (echo "module $(@:.f95=)"; \ - for m in $(OMEGA_SRC8:.f95=); do echo " use $$m"; done; \ - echo " public"; \ - echo "end module $(@:.f95=)") >$@ - -omega_amplitudesx.f95: Makefile - (echo "module $(@:.f95=)"; \ - for m in $(OMEGA_SRCX:.f95=); do echo " use $$m"; done; \ - echo " public"; \ - echo "end module $(@:.f95=)") >$@ - -omega_amplitudest.f95: Makefile - (echo "module $(@:.f95=)"; \ - for m in $(OMEGA_SRCT:.f95=); do echo " use $$m"; done; \ - echo " public"; \ - echo "end module $(@:.f95=)") >$@ - -omega_amplitudes.o: $(OMEGA_OBJ) - -madgraph.o: $(build_srcdir)/kinds.o $(build_srcdir)/omega_parameters_madgraph.o - -main4.o: $(OBJS4) lib$(HELAS).a $(build_libdir)/libomega95.a -main5.o: $(OBJS5) lib$(HELAS).a $(build_libdir)/libomega95.a -main6.o: $(OBJS6) lib$(HELAS).a $(build_libdir)/libomega95.a -main7.o: $(OBJS7) lib$(HELAS).a $(build_libdir)/libomega95.a -main8.o: $(OBJS8) lib$(HELAS).a $(build_libdir)/libomega95.a -mainx.o: $(OBJSX) lib$(HELAS).a $(build_libdir)/libomega95.a -maint.o: $(OBJST) $(build_libdir)/libomega95.a - -######################################################################## - -$(build_libdir)/libomega95.a: - $(MAKE) -C $(build_srcdir) $(build_libdir)/libomega95.a - -$(build_libdir)/libomega95_tools.a: - $(MAKE) -C $(build_tooldir) $(build_libdir)/libomega95_tools.a - -######################################################################## Index: branches/ohl/omega-development/completed/whizard2/tests/people/tho/main.f95 =================================================================== --- branches/ohl/omega-development/completed/whizard2/tests/people/tho/main.f95 (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/tests/people/tho/main.f95 (revision 8703) @@ -1,76 +0,0 @@ -! $Id: main.f95,v 1.1 2004/04/09 20:11:17 ohl Exp $ - -program main - use kinds - use tao_random_numbers - use testbed - ! use omega_parameters1, only: setup_parameters1 => setup_parameters - ! use omega_parameters2, only: setup_parameters2 => setup_parameters - use omega_parameters - implicit none - real(kind=single) :: roots - real(kind=default), dimension(5) :: fudge - integer :: n, seed, tolerance - character (len=8) :: mode - call read_parameters (roots, n, tolerance, mode) - !!! (Very) old version - !!! call read_parameters (roots, n, seed, tolerance) - call tao_random_seed (seed) - call tao_random_number (alpha4) - call tao_random_number (alpha5) - call tao_random_number (fudge) - call setup_parameters () - ! call setup_parameters1 () - ! call setup_parameters2 () - alww0 = alww0 * fudge(1) - alww2 = alww2 * fudge(2) - alzw1 = alzw1 * fudge(3) - alzw0 = alzw0 * fudge(4) - alzz = alzz * fudge(5) - ialww0 = ialww0 * sqrt (fudge(1)) - ialww2 = ialww2 * sqrt (fudge(2)) - ialzw1 = ialzw1 * sqrt (fudge(3)) - ialzw0 = ialzw0 * sqrt (fudge(4)) - ialzz = ialzz * sqrt (fudge(5)) - call check ("W+ W- -> W+ W-", n, real (roots, kind=default), & - (/ 24, -24, 24, -24 /), (/ mass(24), mass(24), mass(24), mass(24) /), & - tolerance = tolerance) - call check ("W+ W- -> Z Z", n, real (roots, kind=default), & - (/ 24, -24, 23, 23 /), (/ mass(24), mass(24), mass(23), mass(23) /), & - symmetry = reshape ( (/ 1, 3, 4 /), (/ 3, 1 /) ), tolerance = tolerance) - call check ("Z Z -> Z Z", n, real (roots, kind=default), & - (/ 23, 23, 23, 23 /), (/ mass(23), mass(23), mass(23), mass(23) /), & - symmetry = reshape ( (/ 1, 3, 4 /), (/ 3, 1 /) ), tolerance = tolerance) -contains - subroutine check (tag, n, roots, flavors, masses, symmetry, tolerance) - use omega_amplitudes1, only: & - omega1 => omega_amplitudes1_func -!!! omega1 => amplitude, & -!!! omega1_sum => spin_sum_sqme, & -!!! spin_states1 => spin_states, & -!!! n_spin_states1 => number_spin_states, & -!!! n_spin_states_in1 => number_spin_states_in - use omega_amplitudes2, only: & - omega2 => omega_amplitudes2_func -!!! omega2 => amplitude, & -!!! omega2_sum => spin_sum_sqme, & -!!! spin_states2 => spin_states, & -!!! n_spin_states2 => number_spin_states, & -!!! n_spin_states_in2 => number_spin_states_in - character(len=*), intent(in) :: tag - integer, intent(in) :: n - real(kind=default), intent(in) :: roots - integer, dimension(:), intent(in) :: flavors - real(kind=default), dimension(:), intent(in) :: masses - integer, dimension(0:,:), intent(in), optional :: symmetry - integer, intent(in), optional :: tolerance - call check_omega (tag, n, omega1, omega2, & - roots, masses, symmetry, flavors, tolerance, mode) - !!! (Very) old version - !!! call check_omega (tag, n, roots, flavors, masses, & - !!! omega1, omega1_sum, spin_states1, n_spin_states1, n_spin_states_in1, & - !!! omega2, omega2_sum, spin_states2, n_spin_states2, n_spin_states_in2, & - !!! symmetry, tolerance) - end subroutine check -end program main - Index: branches/ohl/omega-development/completed/whizard2/tests/people/tho/Makefile.in =================================================================== --- branches/ohl/omega-development/completed/whizard2/tests/people/tho/Makefile.in (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/tests/people/tho/Makefile.in (revision 8703) @@ -1,163 +0,0 @@ -# $Id$ -# -# Copyright (C) 1999-2009 by -# -# Wolfgang Kilian -# Thorsten Ohl -# Juergen Reuter -# -# WHIZARD is free software; you can redistribute it and/or modify it -# under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2, or (at your option) -# any later version. -# -# WHIZARD is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -# -######################################################################## - -prefix = @prefix@ -srcdir = @srcdir@ -top_srcdir = @top_srcdir@ - -### host = @host@ -build_bindir = $(top_srcdir)/bin -build_libdir = $(top_srcdir)/lib -build_srcdir = $(top_srcdir)/src - -OMEGA_QED = $(build_bindir)/f90_QED.opt -OMEGA_SM3 = $(build_bindir)/f90_SM3.opt -OMEGA_SM = $(build_bindir)/f90_SM.opt -OMEGA_SMG = $(build_bindir)/f90_SM_clones.opt -OMEGA_SM3_AC = $(build_bindir)/f90_SM3_ac.opt -OMEGA_SM_AC = $(build_bindir)/f90_SM_ac.opt - -OMEGA_QED_MAJ = $(build_bindir)/f90Maj_QED.opt -OMEGA_SM_MAJ = $(build_bindir)/f90Maj_SM.opt -OMEGA_SMG_MAJ = $(build_bindir)/f90Maj_SM_clones.opt - -## OFLAGS = -target:function $(@:_module.f95=) -target:module $(@:.f95=) -OFLAGS = -target:function $(@:.f95=_func) -target:module $(@:.f95=) -old-interface - - -######################################################################## -# Fortran 90/95 compiler idiosyncrasies -######################################################################## - - -FC = @FC@ -FC_OPT = @FC_OPT@ -FC_PROF = @FC_PROF@ -FC_MDIR = @FC_MDIR@ -FC_MAKE_MODULE_NAME = @FC_MAKE_MODULE_NAME@ -FCFLAGS = $(FC_OPT) -I$(build_libdir) -FC_EXT = @FC_EXT@ -FC_PURE = @FC_PURE@ - -ifeq ($(FC_PURE), yes) -FC_FILTER = $(CPIF) -else -FC_FILTER = sed '/^[ ]*pure[ ]/s/pure[ ]//' | $(CPIF) -endif - -# Don't delete: these are used by FC_MAKE_MODULE_NAME for -# some target systems! -FC_MODULE_EXT = @FC_MODULE_EXT@ -LOWERCASE = @LOWERCASE@ -UPPERCASE = @UPPERCASE@ - -######################################################################## - -CPIF = @CPIF@ - - -LIBS = $(build_libdir)/libomega95.a $(build_libdir)/libomega95_tools.a - -LIBFLAGS = -L$(build_libdir) -lomega95_tools -lomega95 - -TEST_OBJS = $(addprefix $(top_srcdir)/tools/,kinematics.o tao_random_numbers.o rambo.o testbed.o) - -XXX_OMEGA_SRC = \ - omega_parameters1.f95 omega_amplitudes1.f95 \ - omega_parameters2.f95 omega_amplitudes2.f95 - -OMEGA_SRC = \ - omega_parameters.f95 \ - omega_amplitudes1.f95 omega_amplitudes2.f95 - -OMEGA_OBJ = $(OMEGA_SRC:.f95=.o) - -# all: $(TEST_OBJS) - -all: main - -######################################################################## -# There are no Modula(n) sources here ... -%.o: %.mod -######################################################################## - -%.o: %.$(FC_EXT) - $(FC) $(FCFLAGS) $(LIBFLAGS) -c -o $@ $< - -%_p.o: %.$(FC_EXT) - $(FC) $(FC_FLAGS) $(FC_PROF) -c -o $@ $< - -ifneq ($(FC_EXT),f95) -%.$(FC_EXT): %.f95 - cat $< | $(FC_FILTER) $*.$(FC_EXT) -endif - -main: main.o $(OMEGA_OBJ) $(TEST_OBJS) $(LIBS) - $(FC) $(FCFLAGS) -o $@ $(OMEGA_OBJ) $(TEST_OBJS) main.o $(LIBFLAGS) - -main.o: $(OMEGA_OBJ) $(TEST_OBJS) - -######################################################################## - -omega_parameters.f95: - cp $(build_srcdir)/$@ $@ - -omega_parameters1.f95: - $(OMEGA_SM3_AC) -params > $@ - -omega_parameters2.f95: - $(OMEGA_SM_AC) -params > $@ - -omega_amplitudes1.f95: - $(OMEGA_SM3_AC) $(OFLAGS) -scatter "Z:W+ Z:W- -> Z:W+ Z:W-" > $@ - -omega_amplitudes2.f95: - $(OMEGA_SM_AC) $(OFLAGS) -scatter "Z:W+ Z:W- -> Z:W+ Z:W-" > $@ - -######################################################################## - -clean: - rm -f *.o main *~ *.mod omega_cache_* omega_amplitudes* - -purge: purge_omega - -purge_omega: - rm -f $(OMEGA_SRC) - -compare: - $(MAKE) -n -W $(OMEGA_QED) -W $(OMEGA_SM) \ - | egrep '$(OMEGA_QED)|$(OMEGA_SM)' \ - | sed -e 's/>/|diff -I"^!" -u /' -e 's/$$/ -/' | sh - -kinematics.o: $(build_srcdir)/kinds.o -rambo.o: $(build_srcdir)/kinds.o kinematics.o tao_random_numbers.o -testbed.o: $(build_srcdir)/kinds.o rambo.o - -$(build_srcdir)/kinds.o: - $(MAKE) -C $(build_libdir) kinds.o - -$(build_libdir)/libomega95.a: - $(MAKE) -C $(build_libdir) libomega95.a - -######################################################################## Index: branches/ohl/omega-development/completed/whizard2/tests/people/jr/main4.f95 =================================================================== --- branches/ohl/omega-development/completed/whizard2/tests/people/jr/main4.f95 (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/tests/people/jr/main4.f95 (revision 8703) @@ -1,43 +0,0 @@ -! $Id: main4.f95,v 1.1 2004/04/09 20:11:17 ohl Exp $ - -program main4 - use kinds - use tao_random_numbers - use testbed - use rambo - use omega_amplitudes4 - - real(kind=single) :: roots - integer :: n, tolerance - character (len=8) :: mode - - call setup_parameters () - call read_parameters (roots, n, tolerance, mode) - - call check_omega ("A A -> F F", n, oaa_ff, oaa_ff, & - real (roots, kind=default), & - (/ 0.0_default, 0.0_default, 0.0_default, 0.0_default /), & - symmetry = reshape ((/ -1, 3, 4, 1, 1, 2 /), (/ 3, 2/)), & - states = (/ 1, 1, 2, 2 /), tolerance = tolerance, mode = mode) - - call check_omega ("F F -> A A", n, off_aa, off_aa, & - real (roots, kind=default), & - (/ 0.0_default, 0.0_default, 0.0_default, 0.0_default /), & - symmetry = reshape ((/ 1, 3, 4, -1, 1, 2 /), (/ 3, 2/)), & - states = (/ 2, 2, 1, 1 /), tolerance = tolerance, mode = mode) - - call check_omega ("F A -> F A", n, ofa_fa, ofa_fa, & - real (roots, kind=default), & - (/ 0.0_default, 0.0_default, 0.0_default, 0.0_default/), & - symmetry = reshape ((/ 1, 1, 3 /), (/3, 1/)), & - states = (/ 2, 1, 2, 1 /), tolerance = tolerance, mode = mode) - - call check_omega ("F F -> F F", n, off_ff, off_ff, & - real (roots, kind=default), & - (/ 0.0_default, 0.0_default, 0.0_default, 0.0_default /), & - symmetry = reshape ((/ -1, 1, 2, -1, 3, 4/), (/3, 2/)), & - states = (/ 2, 2, 2, 2 /), tolerance = tolerance, mode = mode) - -end program main4 - - Index: branches/ohl/omega-development/completed/whizard2/tests/people/jr/main6.f95 =================================================================== --- branches/ohl/omega-development/completed/whizard2/tests/people/jr/main6.f95 (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/tests/people/jr/main6.f95 (revision 8703) @@ -1,48 +0,0 @@ -! $Id: main6.f95,v 1.1 2004/04/09 20:11:17 ohl Exp $ - -program main6 - use kinds - use tao_random_numbers - use testbed - use rambo - use omega_amplitudes6 - - real(kind=single) :: roots - integer :: n, tolerance - character (len=8) :: mode - - call setup_parameters () - call read_parameters (roots, n, tolerance, mode) - - call check_omega ("A A -> F F F F", n, oaa_ffff, oaa_ffff, & - real (roots, kind=default), & - (/ 0.0_default, 0.0_default, 0.0_default, 0.0_default, & - 0.0_default, 0.0_default /), & - symmetry = reshape ((/ 1, 1, 2, -1, 3, 4, -1, 3, 5, -1, 3, 6, -1, 4, 5, -1, 4, 6, -1, 5, 6 /), (/ 3, 7/)), & - states = (/ 1, 1, 2, 2, 2, 2 /), tolerance = tolerance, mode = mode) - - call check_omega ("A A -> P P P P", n, oaa_pppp, oaa_pppp, & - real (roots, kind=default), & - (/ 0.0_default, 0.0_default, 0.0_default, 0.0_default, & - 0.0_default, 0.0_default /), & - symmetry = reshape ((/ 1, 1, 2, -1, 3, 4, -1, 3, 5, -1, 3, 6, -1, 4, 5, -1, 4, 6, -1, 5, 6 /), (/ 3, 7/)), & - states = (/ 1, 1, 2, 2, 2, 2 /), tolerance = tolerance, mode = mode) - - call check_omega ("A A -> F F P P", n, oaa_ffpp, oaa_ffpp, & - real (roots, kind=default), & - (/ 0.0_default, 0.0_default, 0.0_default, 0.0_default, & - 0.0_default, 0.0_default /), & - symmetry = reshape ((/ 1, 1, 2, -1, 3, 4, -1, 5, 6 /), (/ 3, 3/)), & - states = (/ 1, 1, 2, 2, 2, 2 /), tolerance = tolerance, mode = mode) - - call check_omega ("F F -> P P A A", n, off_ppaa, off_ppaa, & - real (roots, kind=default), & - (/ 0.0_default, 0.0_default, 0.0_default, 0.0_default, & - 0.0_default, 0.0_default /), & - symmetry = reshape ((/ 1, 5, 6, -1, 1, 2, -1, 3, 4 /), (/ 3, 3/)), & - states = (/ 2, 2, 2, 2, 1, 1 /), tolerance = tolerance, mode = mode) - -end program main6 - - - Index: branches/ohl/omega-development/completed/whizard2/tests/people/jr/main8.f95 =================================================================== --- branches/ohl/omega-development/completed/whizard2/tests/people/jr/main8.f95 (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/tests/people/jr/main8.f95 (revision 8703) @@ -1,27 +0,0 @@ -! $Id: main8.f95,v 1.1 2004/04/09 20:11:17 ohl Exp $ - -program main8 - use kinds - use tao_random_numbers - use testbed - use rambo - use omega_amplitudes8 - - real(kind=single) :: roots - integer :: n, tolerance - character (len=8) :: mode - - call setup_parameters () - call read_parameters (roots, n, tolerance, mode) - - call check_omega ("A A -> F F F F P P", n, oaa_ffffpp, oaa_ffffpp, & - real (roots, kind=default), & - (/ 0.0_default, 0.0_default, 0.0_default, 0.0_default, & - 0.0_default, 0.0_default, 0.0_default, 0.0_default /), & - symmetry = reshape ((/ 1, 1, 2, -1, 7, 8, -1, 3, 4, -1, 3, 5, -1, 3, 6, -1, 4, 5, -1, 4, 6, -1, 5, 6 /), (/ 3, 8/)), & - states = (/ 1, 1, 2, 2, 2, 2, 2, 2 /), tolerance = tolerance, mode = mode) - -end program main8 - - - Index: branches/ohl/omega-development/completed/whizard2/tests/people/jr/Makefile.in =================================================================== --- branches/ohl/omega-development/completed/whizard2/tests/people/jr/Makefile.in (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/tests/people/jr/Makefile.in (revision 8703) @@ -1,237 +0,0 @@ -# $Id$ -# -# Copyright (C) 1999-2009 by -# -# Wolfgang Kilian -# Thorsten Ohl -# Juergen Reuter -# -# WHIZARD is free software; you can redistribute it and/or modify it -# under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2, or (at your option) -# any later version. -# -# WHIZARD is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -# -######################################################################## - -prefix = @prefix@ -srcdir = @srcdir@ -top_srcdir = @top_srcdir@ - -### host = @host@ -build_bindir = $(top_srcdir)/bin -build_libdir = $(top_srcdir)/lib -build_srcdir = $(top_srcdir)/src -build_extdir = $(top_srcdir)/extensions/people/jr - -OMEGA_QED = $(build_bindir)/f90_QED.opt -OMEGA_SM = $(build_bindir)/f90_SM.opt -# OMEGA_SM = $(build_bindir)/f90_SM4.opt -OMEGA_SMG = $(build_bindir)/f90_SM_clones.opt -OMEGA_SAGT = $(build_extdir)/f90_SAGT.opt - -# OMEGA_QED = $(build_bindir)/f90Maj_QED.opt -# OMEGA_SM = $(build_bindir)/f90Maj_SM.opt -# OMEGA_SMG = $(build_bindir)/f90Maj_SM_clones.opt - -# OMEGA_QED = $(build_bindir)/helas_QED.opt -# OMEGA_SM = $(build_bindir)/helas_SM.opt -# OMEGA_SMG = false - -OFLAGS = -target:function $(@:_module.f95=) -target:module $(@:.f95=) \ - -target:parameter_module omega_parameters_jr -old-interface - -FC = @FC@ -FC_EXT = @FC_EXT@ -FC_PURE = @FC_PURE@ - -F132 = -132 -FCOPT = $(F132) -I$(build_libdir) -O3 -# FCOPT = -I $(build_libdir) -pg -O3 -Oassumed=contig -FC_DUSTY = -dcfuns -fixed - -# FCOPT = -M $(build_libdir) -Am -Nmaxserious=1 -# FCOPT = -M $(build_libdir) -Am -O3 -x - -Nmaxserious=1 -# FCOPT = -M $(build_libdir) -Am -g -Nmaxserious=1 -# FCOPT = -M $(build_libdir) -Am -O0 -Nmaxserious=1 - -CPIF = @CPIF@ - -MG_QED = echo 0; echo; echo; echo -MG_SM = echo 0; echo yes; echo; echo - -LIBS = -L$(build_libdir) -lomega95 -L. - - -TEST_OBJS = $(addprefix $(top_srcdir)/tools/,kinematics.o tao_random_numbers.o rambo.o testbed.o) \ - omega_parameters_jr.o - -OMEGA_SRC4 = ofa_fa_module.f95 off_ff_module.f95 oaa_ff_module.f95 \ - off_aa_module.f95 - -OMEGA_SRC5 = - -OMEGA_SRC6 = oaa_ffpp_module.f95 obb_ffff_module.f95 off_ppaa_module.f95 \ - oaa_pppp_module.f95 oaa_ffff_module.f95 - -OMEGA_SRC8 = oaa_ffffpp_module.f95 - -OMEGA_SRC = $(OMEGA_SRC4) $(OMEGA_SRC5) $(OMEGA_SRC6) $(OMEGA_SRC8) - -OMEGA_OBJ4 = $(OMEGA_SRC4:.f95=.o) -OMEGA_OBJ5 = $(OMEGA_SRC5:.f95=.o) -OMEGA_OBJ6 = $(OMEGA_SRC6:.f95=.o) -OMEGA_OBJ8 = $(OMEGA_SRC8:.f95=.o) -OMEGA_OBJ = $(OMEGA_SRC:.f95=.o) - -all: main4 main6 main8 - -OBJS4 = $(OMEGA_OBJ4) omega_amplitudes4.o $(TEST_OBJS) - -OBJS5 = $(OMEGA_OBJ5) omega_amplitudes5.o $(TEST_OBJS) - -OBJS6 = $(OMEGA_OBJ6) omega_amplitudes6.o $(TEST_OBJS) - -OBJS8 = $(OMEGA_OBJ8) omega_amplitudes8.o $(TEST_OBJS) - -%.o: %.$(FC_EXT) - $(FC) $(FCOPT) -c -o $@ $(TEST_OBJS) $< - -omega_parameters_jr.o: omega_parameters_jr.$(FC_EXT) - $(FC) $(FCOPT) -c -o $@ $< - -omega_parameters_jr.$(FC_EXT): $(OMEGA_SAGT) - $(OMEGA_SAGT) -params > $@ - -ifneq ($(FC_EXT), f95) -%.$(FC_EXT): %.f95 -ifeq ($(FC_PURE), yes) - $(CPIF) $@ < $< -else - sed '/^[ ]*pure[ ]/s/pure[ ]//' $< | $(CPIF) $@ -endif -endif - -main4: main4.o - $(FC) $(FCOPT) -o $@ $(OBJS4) main4.o $(LIBS) - -main5: main5.o - $(FC) $(FCOPT) -o $@ $(OBJS5) main5.o $(LIBS) - -main6: main6.o - $(FC) $(FCOPT) -o $@ $(OBJS6) main6.o $(LIBS) - -main8: main8.o - $(FC) $(FCOPT) -o $@ $(OBJS8) main8.o $(LIBS) - - -# 4 external lines - -oaa_ff_module.f95: $(OMEGA_SAGT) $(TEST_OBJS) - $(OMEGA_SAGT) $(OFLAGS) -scatter "a a -> f f" >$@ - -off_aa_module.f95: $(OMEGA_SAGT) $(TEST_OBJS) - $(OMEGA_SAGT) $(OFLAGS) -scatter "f f -> a a" >$@ - -ofa_fa_module.f95: $(OMEGA_SAGT) $(TEST_OBJS) - $(OMEGA_SAGT) $(OFLAGS) -scatter "f a -> f a" >$@ - -off_ff_module.f95: $(OMEGA_SAGT) $(TEST_OBJS) - $(OMEGA_SAGT) $(OFLAGS) -scatter "f f -> f f" >$@ - -oaa_ffff_module.f95: $(OMEGA_SAGT) $(TEST_OBJS) - $(OMEGA_SAGT) $(OFLAGS) -scatter "a a -> f f f f" >$@ - -oaa_pppp_module.f95: $(OMEGA_SAGT) $(TEST_OBJS) - $(OMEGA_SAGT) $(OFLAGS) -scatter "a a -> phino phino phino phino" >$@ - -oaa_ffpp_module.f95: $(OMEGA_SAGT) $(TEST_OBJS) - $(OMEGA_SAGT) $(OFLAGS) -scatter "a a -> f f phino phino" >$@ - -off_ppaa_module.f95: $(OMEGA_SAGT) $(TEST_OBJS) - $(OMEGA_SAGT) $(OFLAGS) -scatter "f f -> phino phino a a" >$@ - -obb_ffff_module.f95: $(OMEGA_SAGT) $(TEST_OBJS) - $(OMEGA_SAGT) $(OFLAGS) -scatter "b b -> f f f f" >$@ - -oaa_ffffpp_module.f95: $(OMEGA_SAGT) $(TEST_OBJS) - $(OMEGA_SAGT) $(OFLAGS) -scatter "a a -> f f f f phino phino" >$@ - -######################################################################## - -lib$(HELAS).a: $(HELAS).o - ar cr $@ $< - -$(HELAS).o: $(HELAS).$(FC_EXT) - $(FC) $(FC_DUSTY) $(FCOPT) -c -o $@ $< - - -clean: - rm -f *.o main[4-9] *~ omega_cache_* *.mod *_module* - -purge: purge_omega purge_madlab - -purge_omega: - rm -f $(OMEGA_SRC) - -purge_madlab: - rm -f $(MADGRAPH_SRC) - -compare: - $(MAKE) -n -W $(OMEGA_QED) -W $(OMEGA_SM) \ - | egrep '$(OMEGA_QED)|$(OMEGA_SM)' \ - | sed -e 's/>/>tmp.compare; diff -I"^!" -u /' -e 's/$$/ tmp.compare/' | sh - -omega_amplitudes4.f95: Makefile - (echo "module $(@:.f95=)"; \ - for m in $(OMEGA_SRC4:.f95=); do echo " use $$m"; done; \ - echo " public"; \ - echo "end module $(@:.f95=)") >$@ - -omega_amplitudes5.f95: Makefile - (echo "module $(@:.f95=)"; \ - for m in $(OMEGA_SRC5:.f95=); do echo " use $$m"; done; \ - echo " public"; \ - echo "end module $(@:.f95=)") >$@ - -omega_amplitudes6.f95: Makefile - (echo "module $(@:.f95=)"; \ - for m in $(OMEGA_SRC6:.f95=); do echo " use $$m"; done; \ - echo " public"; \ - echo "end module $(@:.f95=)") >$@ - -omega_amplitudes8.f95: Makefile - (echo "module $(@:.f95=)"; \ - for m in $(OMEGA_SRC8:.f95=); do echo " use $$m"; done; \ - echo " public"; \ - echo "end module $(@:.f95=)") >$@ - -kinematics.o: $(build_srcdir)/kinds.o -rambo.o: $(build_srcdir)/kinds.o kinematics.o tao_random_numbers.o -testbed.o: $(build_srcdir)/kinds.o rambo.o - -$(build_srcdir)/kinds.o: - $(MAKE) -C $(build_libdir) kinds.o - -$(build_libdir)/libomega95.a: - $(MAKE) -C $(build_libdir) libomega95.a - -omega_amplitudes.o: $(OMEGA_OBJ) - -main4.o: $(OBJS4) $(build_libdir)/libomega95.a - -main5.o: $(OBJS5) $(build_libdir)/libomega95.a - -main6.o: $(OBJS6) $(build_libdir)/libomega95.a - -main8.o: $(OBJS8) $(build_libdir)/libomega95.a - - Index: branches/ohl/omega-development/completed/whizard2/configure.ac =================================================================== --- branches/ohl/omega-development/completed/whizard2/configure.ac (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/configure.ac (revision 8703) @@ -1,509 +0,0 @@ -dnl O'Mega configuration -dnl -dnl Process this file with autoconf to produce a configure script -dnl ******************************************************************* -dnl Environment variables. -dnl Set these to a value only if you need to override configure defaults - -AC_REVISION([$Id: configure.in,v 1.52 2005/02/03 18:30:29 ohl Exp $]) -AC_INIT([OMega], [000.011beta Feb 23 2008]) - -dnl Autoconf version requirement -AC_PREREQ([2.60]) - -######################################################################## -# -# Guess which version of the source tree this is and greet the user -# accordingly (including a warning about dangerous code.) -# -######################################################################## - -if test -f dist_tool; then - - development_source_tree=true - cat <) -AC_PATH_PROG(M4,m4,false) -AC_PATH_PROG(LATEX,latex,false) -AC_PATH_PROG(PDFLATEX,pdflatex,false) -AC_PATH_PROG(METAPOST,mpost,false) -AC_PATH_PROG(GHOSTVIEW,gv ghostview,false) -AC_PATH_PROG(DVIPS,dvips,false) -AC_PATH_PROG(EPSTOPDF,epstopdf,false) -AC_PATH_PROG(ACROREAD,acroread,false) -AC_PATH_PROG(DOT,dot,false) -AC_PATH_PROG(HEVEA,hevea,false) -AC_PATH_PROG(IMAGEN,imagen,false) -AC_PATH_PROG(HACHA,hacha,false) -AC_PATH_PROG(GZIP,gzip,false) - -######################################################################## -# -# Options -# -######################################################################## - -######################################################################## -# Fortran90/95/03 compiler switches -######################################################################## - -AC_ARG_ENABLE([fc-flags], -[ --enable-fc-flags=flag Overwrite Fortran90/95/03 compiler flags - (the defaults are system dependent)], -[FC_OPT="$enableval"]) - -AC_ARG_ENABLE([fc-impure], -[ --enable-fc-impure Disable PURE procedures, even if the compiler - claims to support them], -[case "$enableval" in - yes) AC_MSG_WARN([Disabling PURE procedures by request.]) - FC_PURE="no" - ;; -esac]) - -AC_ARG_ENABLE([fc-profiling], -[ --enable-fc-profiling Build profiling versions of the Fortran95 - runtime library], -[case "$enableval" in - no) AC_MSG_WARN([Profiling disabled, since not requested.]) - FC_PROF= - ;; -esac], -[AC_MSG_WARN([Profiling disabled, since not requested.]) -FC_PROF=]) - -AC_ARG_ENABLE([quadruple], -[ --enable-quadruple Set quadruple precision as default for - Fortran library and code], -[case "$enableval" in - yes) AC_MSG_WARN([Enabling quadruple precision by request.]) - case "$FC_QUADRUPLE" in - no) AC_MSG_ERROR([Quadruple precision is not supported by the compiler.]) - ;; - esac - FC_PRECISION=quadruple - ;; - no) FC_PRECISION=double - ;; -esac -AC_SUBST(FC_PRECISION)]) - - -######################################################################## -# NOWEB -######################################################################## - -AC_ARG_ENABLE([noweb], -[ --disable-noweb Disable the noweb programs, even if available.], -[case "$enableval" in - no) AC_MSG_WARN([Disabling NOWEB by request.]) - NOWEAVE=false - NOTANGLE=false - ;; -esac]) -dnl - -######################################################################## -# MADGRAPH -######################################################################## - -AC_ARG_ENABLE([madgraph], -[ --disable-madgraph Disable MADGRAPH for testing, even if available.], -[case "$enableval" in - yes) AC_PATH_PROG(MADGRAPH,madgraph,../../mad-src/madgraph_omega) - ;; - no) AC_MSG_WARN([Disabling MADGRAPH by request.]) - MADGRAPH=false - ;; - *) AC_PATH_PROG(MADGRAPH,$enableval,false) - ;; -esac], -[AC_PATH_PROG(MADGRAPH,madgraph,false)]) - -######################################################################## -# -# Select TARGET/MODEL pairs to build -# -######################################################################## - -AC_SUBST(SELECT_PROGRAMS_CUSTOM) -AC_SUBST(SELECT_PROGRAMS_RELEASED) -AC_SUBST(SELECT_PROGRAMS_UNRELEASED) -AC_SUBST(SELECT_PROGRAMS_THEORETICAL) -AC_SUBST(SELECT_PROGRAMS_REDUNDANT) -AC_SUBST(SELECT_PROGRAMS_DEVELOPERS) -AC_SUBST(SELECT_PROGRAMS_OBSOLETE) -AC_SUBST(SELECT_PROGRAMS_GUI) -SELECT_PROGRAMS_CUSTOM= -SELECT_PROGRAMS_RELEASED=yes -SELECT_PROGRAMS_UNRELEASED= -SELECT_PROGRAMS_THEORETICAL= -SELECT_PROGRAMS_REDUNDANT= -SELECT_PROGRAMS_DEVELOPERS= -SELECT_PROGRAMS_OBSOLETE= -SELECT_PROGRAMS_GUI= - -######################################################################## -# Unreleased -######################################################################## - -AC_ARG_ENABLE([unreleased], -[ --enable-unreleased Build some unreleased models that have not been - tested extensively.], -[case "$enableval" in - yes) SELECT_PROGRAMS_UNRELEASED=yes;; -esac]) - -######################################################################## -# Theoretical -######################################################################## - -AC_ARG_ENABLE([theoretical], -[ --enable-theoretical Build some theoretical models that are not - realized in nature.], -[case "$enableval" in - yes) SELECT_PROGRAMS_THEORETICAL=yes;; -esac]) - -######################################################################## -# Redundant -######################################################################## - -AC_ARG_ENABLE([redundant], -[ --enable-redundant Build some redundant models that add no new - physics for consistency checking.], -[case "$enableval" in - yes) SELECT_PROGRAMS_REDUNDANT=yes;; -esac]) - -######################################################################## -# Only for developers -######################################################################## - -if $development_source_tree; then - -AC_ARG_ENABLE([developers], -[ --enable-developers Build unreleased components (developers only!).], -[case "$enableval" in - yes) AC_MSG_WARN([The development version needs a more up-to-date compiler:]) - THO_OCAML_REQUIRE_VERSION(307000) - SELECT_PROGRAMS_DEVELOPERS=yes - ;; -esac]) - -AC_ARG_ENABLE([obsoletel], -[ --enable-obsolete Build some obsolete components that are only - of historical value (developers only!).], -[case "$enableval" in - yes) SELECT_PROGRAMS_OBSOLETE=yes;; -esac]) - -AC_ARG_ENABLE([unsupported], -[ --enable-unsupported Build also the unsupported applications that - are still under development and might produce - incorrect results.], -[case "$enableval" in - yes) SELECT_PROGRAMS_UNRELEASED=yes - SELECT_PROGRAMS_THEORETICAL=yes - SELECT_PROGRAMS_REDUNDANT=yes - SELECT_PROGRAMS_DEVELOPERS=yes - SELECT_PROGRAMS_OBSOLETE=yes - ;; -esac]) - -fi - -######################################################################## -# Custom collection -######################################################################## - -AC_ARG_ENABLE([program], -[ --enable-program=name Build only one or more selected applications.], -[case "$enableval" in - no) SELECT_PROGRAMS_CUSTOM="" - ;; - *) SELECT_PROGRAMS_CUSTOM="$SELECT_PROGRAMS_CUSTOM $enableval" - ;; -esac]) - -######################################################################## -# GUI -######################################################################## - -AC_ARG_ENABLE([gui], -[ --enable-gui Build a partial GUI that does nothing useful yet - (requires LablGTK!!!).], -[case "$enableval" in - yes) if test -n "$LABLGTKDIR"; then - SELECT_PROGRAMS_GUI="$enableval" - else - AC_MSG_ERROR([GUI requested, but LablGTK not found!]) - fi - ;; -esac]) - -######################################################################## -# -# We're almost done: -# -######################################################################## - -######################################################################## -# Directories -######################################################################## - -build_bindir=${srcdir}/bin -build_libdir=${srcdir}/lib -build_srcdir=${srcdir}/src -mkdir $build_bindir 2>/dev/null -mkdir $build_libdir 2>/dev/null -mkdir $build_srcdir 2>/dev/null - -######################################################################## -# Makefiles -######################################################################## - -# These Makefiles must be avalaible: -PUBLIC_MAKEFILES=" - Makefile - src/Makefile - $build_bindir/Makefile:bin/Makefile.in - $build_libdir/Makefile:lib/Makefile.in" - -# These Makefiles are only required for developers: -PRIVATE_MAKEFILES=" - doc/Makefile - web/Makefile - tools/Makefile - tests/SM/Makefile - tests/MSSM/Makefile - tests/people/cs/Makefile - tests/people/jr/Makefile - tests/people/tho/Makefile - extensions/people/cs/Makefile - extensions/people/jr/Makefile - extensions/people/tho/Makefile - examples/people/cs/Makefile - examples/people/jr/Makefile - examples/people/tho/Makefile" - -MAKEFILES="$PUBLIC_MAKEFILES" -for f in $PRIVATE_MAKEFILES; do - if test -f $f.in; then - MAKEFILES="$MAKEFILES $f" - fi -done - -######################################################################## -# Done: -######################################################################## -AC_OUTPUT($MAKEFILES) Index: branches/ohl/omega-development/completed/whizard2/doc/el_te_ph.eps =================================================================== --- branches/ohl/omega-development/completed/whizard2/doc/el_te_ph.eps (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/doc/el_te_ph.eps (revision 8703) @@ -1,1743 +0,0 @@ -%!PS-Adobe-2.0 EPSF-1.2 -%%Title: Text_kl.fh8 -%%Creator: FreeHand 8.0 -%%CreationDate: 17.11.2000 3:00 Uhr -%%BoundingBox: 0 0 348 100 -%%FHPathName:S_Archiv3:privat:ZZ Andreas:BMBF Logo:Freehand:Text_kl.fh8 -%ALDOriginalFile:S_Archiv3:privat:ZZ Andreas:BMBF Logo:Freehand:Text_kl.fh8 -%ALDBoundingBox: -40 -21 385 120 -%%FHPageNum:1 -%%DocumentSuppliedResources: procset Altsys_header 4 0 -%%ColorUsage: Color -%%DocumentProcessColors: Cyan Magenta Yellow Black -%%CMYKProcessColor: 1 0.85 0 0.29 (100c 85m 0y 29k) -%%+ 0 1 0.91 0 (PANTONE 485 CVP) -%%DocumentNeededResources: font Univers-Condensed -%%+ font Univers -%%+ font Univers-CondensedBold -%%DocumentFonts: Univers-Condensed -%%+ Univers -%%+ Univers-CondensedBold -%%DocumentNeededFonts: Univers-Condensed -%%+ Univers -%%+ Univers-CondensedBold -%%EndComments -%%BeginResource: procset Altsys_header 4 0 -userdict begin /AltsysDict 300 dict def end -AltsysDict begin -/bdf{bind def}bind def -/xdf{exch def}bdf -/defed{where{pop true}{false}ifelse}bdf -/ndf{1 index where{pop pop pop}{dup xcheck{bind}if def}ifelse}bdf -/d{setdash}bdf -/h{closepath}bdf -/H{}bdf -/J{setlinecap}bdf -/j{setlinejoin}bdf -/M{setmiterlimit}bdf -/n{newpath}bdf -/N{newpath}bdf -/q{gsave}bdf -/Q{grestore}bdf -/w{setlinewidth}bdf -/Xic{matrix invertmatrix concat}bdf -/Xq{matrix currentmatrix mark}bdf -/XQ{cleartomark setmatrix}bdf -/sepdef{ - dup where not - { -AltsysSepDict - } - if - 3 1 roll exch put -}bdf -/st{settransfer}bdf -/colorimage defed /_rci xdf -/cntr 0 def -/readbinarystring{ - /cntr 0 def - -2 copy readstring - { -{ -dup -(\034) search -{ -length exch pop exch -dup length 0 ne -{ -dup dup 0 get 32 sub 0 exch put -/cntr cntr 1 add def -} -{ -pop 1 string dup -0 6 index read pop 32 sub put -}ifelse -3 copy -putinterval pop -1 add -1 index length 1 sub -1 index sub -dup 0 le {pop pop exit}if -getinterval -} -{ -pop exit -} ifelse -} loop - }if - cntr 0 gt - { -pop 2 copy -dup length cntr sub cntr getinterval -readbinarystring - } if - pop exch pop -} bdf -/_NXLevel2 defed { - _NXLevel2 not { -/colorimage where { -userdict eq { -/_rci false def -} if -} if - } if -} if -/md defed{ - md type /dicttype eq { -/colorimage where { -md eq { -/_rci false def -}if -}if -/settransfer where { -md eq { -/st systemdict /settransfer get def -}if -}if - }if -}if -/setstrokeadjust defed -{ - true setstrokeadjust - /C{curveto}bdf - /L{lineto}bdf - /m{moveto}bdf -} -{ - /dr{transform .25 sub round .25 add -exch .25 sub round .25 add exch itransform}bdf - /C{dr curveto}bdf - /L{dr lineto}bdf - /m{dr moveto}bdf - /setstrokeadjust{pop}bdf -}ifelse -/privrectpath { - 4 -2 roll m - dtransform round exch round exch idtransform - 2 copy 0 lt exch 0 lt xor - {dup 0 exch rlineto exch 0 rlineto neg 0 exch rlineto} - {exch dup 0 rlineto exch 0 exch rlineto neg 0 rlineto} - ifelse - closepath -}bdf -/rectclip{newpath privrectpath clip newpath}def -/rectfill{gsave newpath privrectpath fill grestore}def -/rectstroke{gsave newpath privrectpath stroke grestore}def -/_fonthacksave false def -/currentpacking defed -{ - /_bfh {/_fonthacksave currentpacking def false setpacking} bdf - /_efh {_fonthacksave setpacking} bdf -} -{ - /_bfh {} bdf - /_efh {} bdf -}ifelse -/packedarray{array astore readonly}ndf -/` -{ - false setoverprint - - - /-save0- save def - 5 index concat - pop - storerect left bottom width height rectclip - pop - - /MMdict_count countdictstack def - /MMop_count count 1 sub def - userdict begin - - /showpage {} def - - 0 setgray 0 setlinecap 1 setlinewidth - 0 setlinejoin 10 setmiterlimit [] 0 setdash newpath - -} bdf -/currentpacking defed{true setpacking}if -/min{2 copy gt{exch}if pop}bdf -/max{2 copy lt{exch}if pop}bdf -/xformfont { currentfont exch makefont setfont } bdf -/fhnumcolors 1 - statusdict begin -/processcolors defed -{ -pop processcolors -} -{ -/deviceinfo defed { -deviceinfo /Colors known { -pop deviceinfo /Colors get -} if -} if -} ifelse - end -def -/printerRes - gsave - matrix defaultmatrix setmatrix - 72 72 dtransform - abs exch abs - max - grestore - def -/graycalcs -[ - {Angle Frequency} - {GrayAngle GrayFrequency} - {0 Width Height matrix defaultmatrix idtransform -dup mul exch dup mul add sqrt 72 exch div} - {0 GrayWidth GrayHeight matrix defaultmatrix idtransform -dup mul exch dup mul add sqrt 72 exch div} -] def -/calcgraysteps { - forcemaxsteps - { -maxsteps - } - { -/currenthalftone defed -{currenthalftone /dicttype eq}{false}ifelse -{ -currenthalftone begin -HalftoneType 4 le -{graycalcs HalftoneType 1 sub get exec} -{ -HalftoneType 5 eq -{ -Default begin -{graycalcs HalftoneType 1 sub get exec} -end -} -{0 60} -ifelse -} -ifelse -end -} -{ -currentscreen pop exch -} -ifelse - -printerRes 300 max exch div exch -2 copy -sin mul round dup mul -3 1 roll -cos mul round dup mul -add 1 add -dup maxsteps gt {pop maxsteps} if -dup minsteps lt {pop minsteps} if - } - ifelse -} bdf -/nextrelease defed { - /languagelevel defed not { -/framebuffer defed { -0 40 string framebuffer 9 1 roll 8 {pop} repeat -dup 516 eq exch 520 eq or -{ -/fhnumcolors 3 def -/currentscreen {60 0 {pop pop 1}}bdf -/calcgraysteps {maxsteps} bdf -}if -}if - }if -}if -fhnumcolors 1 ne { - /calcgraysteps {maxsteps} bdf -} if -/currentpagedevice defed { - - - currentpagedevice /PreRenderingEnhance known - { -currentpagedevice /PreRenderingEnhance get -{ -/calcgraysteps -{ -forcemaxsteps -{maxsteps} -{256 maxsteps min} -ifelse -} def -} if - } if -} if -/gradfrequency 144 def -printerRes 1000 lt { - /gradfrequency 72 def -} if -/adjnumsteps { - - dup dtransform abs exch abs max - - printerRes div - - gradfrequency mul - round - 5 max - min -}bdf -/goodsep { - spots exch get 4 get dup sepname eq exch (_vc_Registration) eq or -}bdf -/BeginGradation defed -{/bb{BeginGradation}bdf} -{/bb{}bdf} -ifelse -/EndGradation defed -{/eb{EndGradation}bdf} -{/eb{}bdf} -ifelse -/bottom -0 def -/delta -0 def -/frac -0 def -/height -0 def -/left -0 def -/numsteps1 -0 def -/radius -0 def -/right -0 def -/top -0 def -/width -0 def -/xt -0 def -/yt -0 def -/df currentflat def -/tempstr 1 string def -/clipflatness currentflat def -/inverted? - 0 currenttransfer exec .5 ge def -/tc1 [0 0 0 1] def -/tc2 [0 0 0 1] def -/storerect{/top xdf /right xdf /bottom xdf /left xdf -/width right left sub def /height top bottom sub def}bdf -/concatprocs{ - systemdict /packedarray known - {dup type /packedarraytype eq 2 index type /packedarraytype eq or}{false}ifelse - { -/proc2 exch cvlit def /proc1 exch cvlit def -proc1 aload pop proc2 aload pop -proc1 length proc2 length add packedarray cvx - } - { -/proc2 exch cvlit def /proc1 exch cvlit def -/newproc proc1 length proc2 length add array def -newproc 0 proc1 putinterval newproc proc1 length proc2 putinterval -newproc cvx - }ifelse -}bdf -/i{dup 0 eq - {pop df dup} - {dup} ifelse - /clipflatness xdf setflat -}bdf -version cvr 38.0 le -{/setrgbcolor{ -currenttransfer exec 3 1 roll -currenttransfer exec 3 1 roll -currenttransfer exec 3 1 roll -setrgbcolor}bdf}if -/vms {/vmsv save def} bdf -/vmr {vmsv restore} bdf -/vmrs{vmsv restore /vmsv save def}bdf -/eomode{ - {/filler /eofill load def /clipper /eoclip load def} - {/filler /fill load def /clipper /clip load def} - ifelse -}bdf -/normtaper{}bdf -/logtaper{9 mul 1 add log}bdf -/CD{ - /NF exch def - { -exch dup -/FID ne 1 index/UniqueID ne and -{exch NF 3 1 roll put} -{pop pop} -ifelse - }forall - NF -}bdf -/MN{ - 1 index length - /Len exch def - dup length Len add - string dup - Len - 4 -1 roll - putinterval - dup - 0 - 4 -1 roll - putinterval -}bdf -/RC{4 -1 roll /ourvec xdf 256 string cvs(|______)anchorsearch - {1 index MN cvn/NewN exch def cvn - findfont dup maxlength dict CD dup/FontName NewN put dup - /Encoding ourvec put NewN exch definefont pop}{pop}ifelse}bdf -/RF{ - dup - FontDirectory exch - known - {pop 3 -1 roll pop} - {RC} - ifelse -}bdf -/FF{dup 256 string cvs(|______)exch MN cvn dup FontDirectory exch known - {exch pop findfont 3 -1 roll pop} - {pop dup findfont dup maxlength dict CD dup dup - /Encoding exch /Encoding get 256 array copy 7 -1 roll - {3 -1 roll dup 4 -2 roll put}forall put definefont} - ifelse}bdf -/RCJ{4 -1 roll - /ourvec xdf - 256 string cvs - (|______) anchorsearch - {pop -cvn -dup FDFJ -exch -1 index -eq -{ -_bfh findfont _efh -dup -maxlength dict -CD -dup -/FontName -3 index -put -dup -/Encoding ourvec put -1 index -exch -definefont -pop -} -{exch pop} -ifelse - } - {pop} - ifelse -}bdf -/RFJ{ - dup - FontDirectory exch - known - {pop 3 -1 roll pop} - {RCJ} - ifelse -}bdf -/hasfont -{ - /resourcestatus where - { -pop -/Font resourcestatus -{ -pop pop true -} -{ -false -} -ifelse - } - { -dup FontDirectory exch known -{pop true} -{ -256 string -cvs -(fonts/) exch MN -status -{pop pop pop pop true} -{false} -ifelse -} -ifelse - } - ifelse -}bdf -/FDFJ -{ - dup - hasfont - not - { -pop -/Ryumin-Light-83pv-RKSJ-H -hasfont -{ -/Ryumin-Light-83pv-RKSJ-H -} -{ -/Courier -} -ifelse - } - if -}bdf -/FFJ{ - _bfh - dup - 256 string cvs - (|______)exch MN - cvn - dup - FontDirectory - exch known - { -exch -pop -findfont -3 -1 roll -pop - } - { -pop -FDFJ -dup findfont -dup maxlength dict -CD -dup dup -/Encoding exch -/Encoding get -256 array copy -7 -1 roll -{ -3 -1 roll -dup -4 -2 roll -put -}forall -put -definefont - } - ifelse - _efh -}bdf -/GS { - dup - hasfont - { -FFJ -curtextmtx makefont setfont -exch -5 1 roll -ts -pop - } { -pop pop -ts - } ifelse -} bdf -/RCK{4 -1 roll - /ourvec xdf - 256 string cvs - (|______) anchorsearch - {pop -cvn -dup FDFK -exch -1 index -eq -{ -_bfh findfont _efh -dup -maxlength dict -CD -dup -/FontName -3 index -put -dup -/Encoding ourvec put -1 index -exch -definefont -pop -} -{exch pop} -ifelse - } - {pop} - ifelse -}bdf -/RFK{ - dup - FontDirectory exch - known - {pop 3 -1 roll pop} - {RCK} - ifelse -}bdf -/hasfont -{ - /resourcestatus where - { -pop -/Font resourcestatus -{ -pop pop true -} -{ -false -} -ifelse - } - { -dup FontDirectory exch known -{pop true} -{ -256 string -cvs -(fonts/) exch MN -status -{pop pop pop pop true} -{false} -ifelse -} -ifelse - } - ifelse -}bdf -/FDFK -{ - dup - hasfont - not - { -pop -/JCsm -hasfont -{ -/JCsm -} -{ -/Courier -} -ifelse - } - if -}bdf -/FFK{ - _bfh - dup - 256 string cvs - (|______)exch MN - cvn - dup - FontDirectory - exch known - { -exch -pop -findfont -3 -1 roll -pop - } - { -pop -FDFK -dup findfont -dup maxlength dict -CD -dup dup -/Encoding exch -/Encoding get -256 array copy -7 -1 roll -{ -3 -1 roll -dup -4 -2 roll -put -}forall -put -definefont - } - ifelse - _efh -}bdf -/RCTC{4 -1 roll - /ourvec xdf - 256 string cvs - (|______) anchorsearch - {pop -cvn -dup FDFTC -exch -1 index -eq -{ -_bfh findfont _efh -dup -maxlength dict -CD -dup -/FontName -3 index -put -dup -/Encoding ourvec put -1 index -exch -definefont -pop -} -{exch pop} -ifelse - } - {pop} - ifelse -}bdf -/RFTC{ - dup - FontDirectory exch - known - {pop 3 -1 roll pop} - {RCTC} - ifelse -}bdf -/FDFTC -{ - dup - hasfont - not - { -pop -/DFMing-Lt-HK-BF -hasfont -{ -/DFMing-Lt-HK-BF -} -{ -/Courier -} -ifelse - } - if -}bdf -/FFTC{ - _bfh - dup - 256 string cvs - (|______)exch MN - cvn - dup - FontDirectory - exch known - { -exch -pop -findfont -3 -1 roll -pop - } - { -pop -FDFTC -dup findfont -dup maxlength dict -CD -dup dup -/Encoding exch -/Encoding get -256 array copy -7 -1 roll -{ -3 -1 roll -dup -4 -2 roll -put -}forall -put -definefont - } - ifelse - _efh -}bdf -/fps{ - currentflat - exch - dup 0 le{pop 1}if - { -dup setflat 3 index stopped -{1.3 mul dup 3 index gt{pop setflat pop pop stop}if} -{exit} -ifelse - }loop - pop setflat pop pop -}bdf -/fp{100 currentflat fps}bdf -/clipper{clip}bdf -/W{/clipper load 100 clipflatness dup setflat fps}bdf -userdict begin /BDFontDict 29 dict def end -BDFontDict begin -/bu{}def -/bn{}def -/setTxMode{av 70 ge{pop}if pop}def -/gm{m}def -/show{pop}def -/gr{pop}def -/fnt{pop pop pop}def -/fs{pop}def -/fz{pop}def -/lin{pop pop}def -/:M {pop pop} def -/sf {pop} def -/S {pop} def -/@b {pop pop pop pop pop pop pop pop} def -/_bdsave /save load def -/_bdrestore /restore load def -/save { dup /fontsave eq {null} {_bdsave} ifelse } def -/restore { dup null eq { pop } { _bdrestore } ifelse } def -/fontsave null def -end -/MacVec 256 array def -MacVec 0 /Helvetica findfont -/Encoding get 0 128 getinterval putinterval -MacVec 127 /DEL put MacVec 16#27 /quotesingle put MacVec 16#60 /grave put -/NUL/SOH/STX/ETX/EOT/ENQ/ACK/BEL/BS/HT/LF/VT/FF/CR/SO/SI -/DLE/DC1/DC2/DC3/DC4/NAK/SYN/ETB/CAN/EM/SUB/ESC/FS/GS/RS/US -MacVec 0 32 getinterval astore pop -/Adieresis/Aring/Ccedilla/Eacute/Ntilde/Odieresis/Udieresis/aacute -/agrave/acircumflex/adieresis/atilde/aring/ccedilla/eacute/egrave -/ecircumflex/edieresis/iacute/igrave/icircumflex/idieresis/ntilde/oacute -/ograve/ocircumflex/odieresis/otilde/uacute/ugrave/ucircumflex/udieresis -/dagger/degree/cent/sterling/section/bullet/paragraph/germandbls -/registered/copyright/trademark/acute/dieresis/notequal/AE/Oslash -/infinity/plusminus/lessequal/greaterequal/yen/mu/partialdiff/summation -/product/pi/integral/ordfeminine/ordmasculine/Omega/ae/oslash -/questiondown/exclamdown/logicalnot/radical/florin/approxequal/Delta/guillemotleft -/guillemotright/ellipsis/nbspace/Agrave/Atilde/Otilde/OE/oe -/endash/emdash/quotedblleft/quotedblright/quoteleft/quoteright/divide/lozenge -/ydieresis/Ydieresis/fraction/currency/guilsinglleft/guilsinglright/fi/fl -/daggerdbl/periodcentered/quotesinglbase/quotedblbase -/perthousand/Acircumflex/Ecircumflex/Aacute -/Edieresis/Egrave/Iacute/Icircumflex/Idieresis/Igrave/Oacute/Ocircumflex -/apple/Ograve/Uacute/Ucircumflex/Ugrave/dotlessi/circumflex/tilde -/macron/breve/dotaccent/ring/cedilla/hungarumlaut/ogonek/caron -MacVec 128 128 getinterval astore pop -/findheaderfont { - /Helvetica findfont -} def -end %. AltsysDict -%%EndResource -%%EndProlog -%%BeginSetup -AltsysDict begin -_bfh -%%IncludeResource: font Univers-Condensed -MacVec 256 array copy -/f0 /|______Univers-Condensed dup RF findfont def -%%IncludeResource: font Univers -MacVec 256 array copy -/f1 /|______Univers dup RF findfont def -%%IncludeResource: font Univers-CondensedBold -MacVec 256 array copy -/f2 /|______Univers-CondensedBold dup RF findfont def -_efh -end %. AltsysDict -%%EndSetup -AltsysDict begin -/onlyk4{false}ndf -/ccmyk{dup 5 -1 roll sub 0 max exch}ndf -/cmyk2gray{ - 4 -1 roll 0.3 mul 4 -1 roll 0.59 mul 4 -1 roll 0.11 mul - add add add 1 min neg 1 add -}bdf -/setcmykcolor{1 exch sub ccmyk ccmyk ccmyk pop setrgbcolor}ndf -/maxcolor { - max max max -} ndf -/maxspot { - pop -} ndf -/setcmykcoloroverprint{4{dup -1 eq{pop 0}if 4 1 roll}repeat setcmykcolor}ndf -/findcmykcustomcolor{5 packedarray}ndf -/setcustomcolor{exch aload pop pop 4{4 index mul 4 1 roll}repeat setcmykcolor pop}ndf -/setseparationgray{setgray}ndf -/setoverprint{pop}ndf -/currentoverprint false ndf -/cmykbufs2gray{ - 0 1 2 index length 1 sub - { -4 index 1 index get 0.3 mul -4 index 2 index get 0.59 mul -4 index 3 index get 0.11 mul -4 index 4 index get -add add add cvi 255 min -255 exch sub -2 index 3 1 roll put - }for - 4 1 roll pop pop pop -}bdf -/colorimage{ - pop pop - [ -5 -1 roll/exec cvx -6 -1 roll/exec cvx -7 -1 roll/exec cvx -8 -1 roll/exec cvx -/cmykbufs2gray cvx - ]cvx - image -} -%. version 47.1 on Linotronic of Postscript defines colorimage incorrectly (rgb model only) -version cvr 47.1 le -statusdict /product get (Lino) anchorsearch{pop pop true}{pop false}ifelse -and{userdict begin bdf end}{ndf}ifelse -fhnumcolors 1 ne {/yt save def} if -/customcolorimage{ - aload pop - (_vc_Registration) eq - { -pop pop pop pop separationimage - } - { -/ik xdf /iy xdf /im xdf /ic xdf -ic im iy ik cmyk2gray /xt xdf -currenttransfer -{dup 1.0 exch sub xt mul add}concatprocs -st -image - } - ifelse -}ndf -fhnumcolors 1 ne {yt restore} if -fhnumcolors 3 ne {/yt save def} if -/customcolorimage{ - aload pop - (_vc_Registration) eq - { -pop pop pop pop separationimage - } - { -/ik xdf /iy xdf /im xdf /ic xdf -1.0 dup ic ik add min sub -1.0 dup im ik add min sub -1.0 dup iy ik add min sub -/ic xdf /iy xdf /im xdf -currentcolortransfer -4 1 roll -{dup 1.0 exch sub ic mul add}concatprocs 4 1 roll -{dup 1.0 exch sub iy mul add}concatprocs 4 1 roll -{dup 1.0 exch sub im mul add}concatprocs 4 1 roll -setcolortransfer -{/dummy xdf dummy}concatprocs{dummy}{dummy}true 3 colorimage - } - ifelse -}ndf -fhnumcolors 3 ne {yt restore} if -fhnumcolors 4 ne {/yt save def} if -/customcolorimage{ - aload pop - (_vc_Registration) eq - { -pop pop pop pop separationimage - } - { -/ik xdf /iy xdf /im xdf /ic xdf -currentcolortransfer -{1.0 exch sub ik mul ik sub 1 add}concatprocs 4 1 roll -{1.0 exch sub iy mul iy sub 1 add}concatprocs 4 1 roll -{1.0 exch sub im mul im sub 1 add}concatprocs 4 1 roll -{1.0 exch sub ic mul ic sub 1 add}concatprocs 4 1 roll -setcolortransfer -{/dummy xdf dummy}concatprocs{dummy}{dummy}{dummy} -true 4 colorimage - } - ifelse -}ndf -fhnumcolors 4 ne {yt restore} if -/separationimage{image}ndf -/spotascmyk false ndf -/newcmykcustomcolor{6 packedarray}ndf -/inkoverprint false ndf -/setinkoverprint{pop}ndf -/setspotcolor { - spots exch get - dup 4 get (_vc_Registration) eq - {pop 1 exch sub setseparationgray} - {0 5 getinterval exch setcustomcolor} - ifelse -}ndf -/currentcolortransfer{currenttransfer dup dup dup}ndf -/setcolortransfer{st pop pop pop}ndf -/fas{}ndf -/sas{}ndf -/fhsetspreadsize{pop}ndf -/filler{fill}bdf -/F{gsave {filler}fp grestore}bdf -/f{closepath F}bdf -/S{gsave {stroke}fp grestore}bdf -/s{closepath S}bdf - - userdict /islevel2 - systemdict /languagelevel known dup - { -pop systemdict /languagelevel get 2 ge - } if - put - - islevel2 not - { -/currentcmykcolor -{ -0 0 0 1 currentgray sub -} ndf - } if - - /tc - { -gsave -setcmykcolor currentcmykcolor -grestore - } bind def - /testCMYKColorThrough - { -tc add add add 0 ne - } bind def - /fhiscomposite where not { -userdict /fhiscomposite -islevel2 -{ -gsave 1 1 1 1 setcmykcolor currentcmykcolor grestore -add add add 4 eq -} -{ -1 0 0 0 testCMYKColorThrough -0 1 0 0 testCMYKColorThrough -0 0 1 0 testCMYKColorThrough -0 0 0 1 testCMYKColorThrough -and and and -} ifelse -put - } - { pop } - ifelse -/bc4 [0 0 0 0] def -/_lfp4 { - 1 pop - /yt xdf - /xt xdf - /ang xdf - storerect - /taperfcn xdf - /k2 xdf /y2 xdf /m2 xdf /c2 xdf - /k1 xdf /y1 xdf /m1 xdf /c1 xdf - c1 c2 sub abs - m1 m2 sub abs - y1 y2 sub abs - k1 k2 sub abs - maxcolor - calcgraysteps mul abs round - height abs adjnumsteps - dup 1 lt {pop 1} if - 1 sub /numsteps1 xdf - currentflat mark - currentflat clipflatness - /delta top bottom sub numsteps1 1 add div def - /right right left sub def - /botsv top delta sub def - { -{ -W -xt yt translate -ang rotate -xt neg yt neg translate -dup setflat -/bottom botsv def -0 1 numsteps1 -{ -numsteps1 dup 0 eq {pop pop 0.5} {div} ifelse -taperfcn /frac xdf -bc4 0 c2 c1 sub frac mul c1 add put -bc4 1 m2 m1 sub frac mul m1 add put -bc4 2 y2 y1 sub frac mul y1 add put -bc4 3 k2 k1 sub frac mul k1 add put -bc4 vc -1 index setflat -{ -mark {newpath left bottom right delta rectfill}stopped -{cleartomark exch 1.3 mul dup setflat exch 2 copy gt{stop}if} -{cleartomark exit}ifelse -}loop -/bottom bottom delta sub def -}for -} -gsave stopped grestore -{exch pop 2 index exch 1.3 mul dup 100 gt{cleartomark setflat stop}if} -{exit}ifelse - }loop - cleartomark setflat -}bdf -/bcs [0 0] def -/_lfs4 { - /yt xdf - /xt xdf - /ang xdf - storerect - /taperfcn xdf - /tint2 xdf - /tint1 xdf - bcs exch 1 exch put - tint1 tint2 sub abs - bcs 1 get maxspot - calcgraysteps mul abs round - height abs adjnumsteps - dup 2 lt {pop 2} if - 1 sub /numsteps1 xdf - currentflat mark - currentflat clipflatness - /delta top bottom sub numsteps1 1 add div def - /right right left sub def - /botsv top delta sub def - { -{ -W -xt yt translate -ang rotate -xt neg yt neg translate -dup setflat -/bottom botsv def -0 1 numsteps1 -{ -numsteps1 div taperfcn /frac xdf -bcs 0 -1.0 tint2 tint1 sub frac mul tint1 add sub -put bcs vc -1 index setflat -{ -mark {newpath left bottom right delta rectfill}stopped -{cleartomark exch 1.3 mul dup setflat exch 2 copy gt{stop}if} -{cleartomark exit}ifelse -}loop -/bottom bottom delta sub def -}for -} -gsave stopped grestore -{exch pop 2 index exch 1.3 mul dup 100 gt{cleartomark setflat stop}if} -{exit}ifelse - }loop - cleartomark setflat -}bdf -/_rfs6 { - /tint2 xdf - /tint1 xdf - bcs exch 1 exch put - /inrad xdf - /radius xdf - /yt xdf - /xt xdf - tint1 tint2 sub abs - bcs 1 get maxspot - calcgraysteps mul abs round - radius inrad sub abs - adjnumsteps - dup 1 lt {pop 1} if - 1 sub /numsteps1 xdf - radius inrad sub numsteps1 dup 0 eq {pop} {div} ifelse - 2 div /halfstep xdf - currentflat mark - currentflat clipflatness - { -{ -dup setflat -W -0 1 numsteps1 -{ -dup /radindex xdf -numsteps1 dup 0 eq {pop pop 0.5} {div} ifelse -/frac xdf -bcs 0 -tint2 tint1 sub frac mul tint1 add -put bcs vc -1 index setflat -{ -newpath mark -xt yt radius inrad sub 1 frac sub mul halfstep add inrad add 0 360 -{ arc -radindex numsteps1 ne -inrad 0 gt or -{ -xt yt -numsteps1 0 eq -{ inrad } -{ -radindex 1 add numsteps1 div 1 exch sub -radius inrad sub mul halfstep add inrad add -}ifelse -dup xt add yt moveto -360 0 arcn -} if -fill -}stopped -{cleartomark exch 1.3 mul dup setflat exch 2 copy gt{stop}if} -{cleartomark exit}ifelse -}loop -}for -} -gsave stopped grestore -{exch pop 2 index exch 1.3 mul dup 100 gt{cleartomark setflat stop}if} -{exit}ifelse - }loop - cleartomark setflat -}bdf -/_rfp6 { - 1 pop - /k2 xdf /y2 xdf /m2 xdf /c2 xdf - /k1 xdf /y1 xdf /m1 xdf /c1 xdf - /inrad xdf - /radius xdf - /yt xdf - /xt xdf - c1 c2 sub abs - m1 m2 sub abs - y1 y2 sub abs - k1 k2 sub abs - maxcolor - calcgraysteps mul abs round - radius inrad sub abs - adjnumsteps - dup 1 lt {pop 1} if - 1 sub /numsteps1 xdf - radius inrad sub numsteps1 dup 0 eq {pop} {div} ifelse - 2 div /halfstep xdf - currentflat mark - currentflat clipflatness - { -{ -dup setflat -W -0 1 numsteps1 -{ -dup /radindex xdf -numsteps1 dup 0 eq {pop pop 0.5} {div} ifelse -/frac xdf -bc4 0 c2 c1 sub frac mul c1 add put -bc4 1 m2 m1 sub frac mul m1 add put -bc4 2 y2 y1 sub frac mul y1 add put -bc4 3 k2 k1 sub frac mul k1 add put -bc4 vc -1 index setflat -{ -newpath mark -xt yt radius inrad sub 1 frac sub mul halfstep add inrad add 0 360 -{ arc -radindex numsteps1 ne -inrad 0 gt or -{ -xt yt -numsteps1 0 eq -{ inrad } -{ -radindex 1 add numsteps1 div 1 exch sub -radius inrad sub mul halfstep add inrad add -}ifelse -dup xt add yt moveto -360 0 arcn -} if -fill -}stopped -{cleartomark exch 1.3 mul dup setflat exch 2 copy gt{stop}if} -{cleartomark exit}ifelse -}loop -}for -} -gsave stopped grestore -{exch pop 2 index exch 1.3 mul dup 100 gt{cleartomark setflat stop}if} -{exit}ifelse - }loop - cleartomark setflat -}bdf -/lfp4{_lfp4}ndf -/lfs4{_lfs4}ndf -/rfs6{_rfs6}ndf -/rfp6{_rfp6}ndf -/cvc [0 0 0 1] def -/vc{ - AltsysDict /cvc 2 index put - aload length dup 4 eq - {pop dup -1 eq{pop setrgbcolor}{setcmykcolor}ifelse} - {6 eq {sethexcolor} {setspotcolor} ifelse } - ifelse -}bdf -0 setseparationgray -/imgr {1692 1570.11 2117.2 1711.84 } def -/bleed 0 def -/clpr {1692 1570.11 2117.2 1711.84 } def -/xs 1 def -/ys 1 def -/botx 0 def -/overlap 0 def -/wdist 18 def -0 2 mul fhsetspreadsize -0 0 ne {/df 0 def /clipflatness 0 def} if -/maxsteps 256 def -/forcemaxsteps false def -/minsteps 0 def - userdict begin /AGDOrigMtx matrix currentmatrix def end -vms --1732 -1591 translate -/currentpacking defed{false setpacking}if -/spots[ -1 0 0 0 (Process Cyan) false newcmykcustomcolor -0 1 0 0 (Process Magenta) false newcmykcustomcolor -0 0 1 0 (Process Yellow) false newcmykcustomcolor -0 0 0 1 (Process Black) false newcmykcustomcolor -]def -/textopf false def -/curtextmtx{}def -/otw .25 def -/msf{dup/curtextmtx xdf makefont setfont}bdf -/makesetfont/msf load def -/curtextheight{.707104 .707104 curtextmtx dtransform - dup mul exch dup mul add sqrt}bdf -/ta2{ -tempstr 2 index gsave exec grestore -cwidth cheight rmoveto -4 index eq{5 index 5 index rmoveto}if -2 index 2 index rmoveto -}bdf -/ta{exch systemdict/cshow known -{{/cheight xdf/cwidth xdf tempstr 0 2 index put ta2}exch cshow} -{{tempstr 0 2 index put tempstr stringwidth/cheight xdf/cwidth xdf ta2}forall} -ifelse 6{pop}repeat}bdf -/sts{/textopf currentoverprint def vc setoverprint -/ts{awidthshow}def exec textopf setoverprint}bdf -/stol{/xt currentlinewidth def - setlinewidth vc newpath - /ts{{false charpath stroke}ta}def exec - xt setlinewidth}bdf - -/strk{/textopf currentoverprint def vc setoverprint - /ts{{false charpath stroke}ta}def exec - textopf setoverprint - }bdf -n -[] 0 d -3.863708 M -1 w -0 j -0 J -false setoverprint -0 i -false eomode -[0 0 0 1] vc -vms -0.7563 w -S -n -2067.629 1656.0955 m -1864.4489 1656.0955 L -1864.4489 1636.2957 L -2067.629 1636.2957 L -2067.629 1656.0955 L -n -q -%%IncludeResource: font Univers-Condensed -{ -f0 [18.911591 0 0 18.800003 0 0] makesetfont -1864.448853 1641.05571 m -0 0 32 0.40831 0 (Elementarteilchenphysik) ts -} -true -[0 0 0 1]sts -Q -false eomode -2076.8609 1687.6181 m -1926.4197 1687.6181 L -1926.4197 1669.0707 L -2076.8609 1669.0707 L -2076.8609 1687.6181 L -n -q -%%IncludeResource: font Univers -{ -f1 [13.656479 0 0 13.575897 0 0] makesetfont -1926.419724 1676.757507 m -0.181686 0 32 0.821426 0 (-) ts -} -true -[0 0 0 1]sts -%%IncludeResource: font Univers-CondensedBold -{ -f2 [13.656479 0 0 13.575897 0 0] makesetfont -0.145065 0 32 -0.055038 0 ( ) ts -} -true -[0 0 0 1]sts -{ -f2 [13.656479 0 0 13.575897 0 0] makesetfont -0.145065 0 32 0.315689 0 ( ) ts -} -true -[0 0 0 1]sts -%%IncludeResource: font Univers-Condensed -{ -f0 [13.656479 0 0 13.575897 0 0] makesetfont -0.145065 0 32 0.821426 0 (F\232rderschwerpunkt) ts -} -true -[0 0 0 1]sts -Q -false eomode -1848.8979 1689.695 m -1848.8979 1595.0719 L -1.7927 w -[0 0 0 1] vc -false setoverprint -S -n -2063.5123 1620.9051 m -1864.5993 1620.9051 L -1864.5993 1591.7662 L -2063.5123 1591.7662 L -2063.5123 1620.9051 L -n -q -%%IncludeResource: font Univers-Condensed -{ -f0 [13.656479 0 0 13.575897 0 0] makesetfont -1864.599304 1610.04451 m -0 0 32 0.891846 0 (Gro\247ger\212te der) ts -} -true -[0 0 0 1]sts -{ -f0 [13.656479 0 0 13.575897 0 0] makesetfont -0 0 32 2.150482 0 ( ) ts -} -true -[0 0 0 1]sts -{ -f0 [13.656479 0 0 13.575897 0 0] makesetfont -0 0 32 0.891846 0 (physikalischen) ts -} -true -[0 0 0 1]sts -{ -f0 [13.656479 0 0 13.575897 0 0] makesetfont -1864.599304 1595.481415 m -0 0 32 0.891846 0 (Grundlagenforschung) ts -} -true -[0 0 0 1]sts -Q -false eomode -1.3277 w -3.863693 M -[1 0.85 0 0.29] vc -false setoverprint -S -n -0.1018 w -S -n -0.4556 w -3.863708 M -S -n -1780.792 1640.7337 m -1780.7699 1593.8087 L -1754.0726 1593.9048 1732.336 1614.9893 1732.336 1640.7336 C -1780.792 1640.7337 L -f -0 w -3.863693 M -S -n -1780.7705 1687.9825 m -1780.7636 1687.9103 L -1780.7473 1686.913 L -1770.9419 1686.9278 L -1774.1146 1687.5674 1777.4014 1687.9707 1780.7705 1687.9825 C -f -0.0345 w -S -n -1766.3248 1685.7834 m -1780.7359 1685.7835 L -1780.7359 1684.4628 L -1762.5675 1684.4476 L -1763.8006 1684.9353 1765.0432 1685.3932 1766.3248 1685.7834 C -f -0.1018 w -S -n -1756.6316 1681.6299 m -1757.57 1682.1569 1758.4858 1682.6275 1759.4628 1683.0941 C -1780.7473 1683.1095 L -1780.7574 1681.6221 L -1756.6316 1681.6299 L -f -0 w -S -n -1751.2789 1678.1485 m -1752.2339 1678.865 1753.1204 1679.4614 1754.1304 1680.1085 C -1780.7704 1680.1109 L -1780.7698 1678.1485 L -1751.2789 1678.1485 L -f -S -n -1745.3963 1672.757 m -1746.327 1673.7376 1747.3068 1674.6228 1748.2583 1675.4777 C -1780.7696 1675.4777 L -1780.7655 1672.7569 L -1745.3963 1672.757 L -f -S -n -1740.2277 1666.1637 m -1740.9807 1667.3107 1741.7769 1668.3945 1742.6266 1669.4719 C -1780.7641 1669.4718 L -1780.7641 1666.1626 L -1740.2277 1666.1637 L -f -S -n -1735.9014 1657.7108 m -1736.4717 1659.1935 1737.1404 1660.6102 1737.8465 1662.0204 C -1780.7552 1662.0204 L -1780.7556 1657.7033 L -1735.9014 1657.7108 L -f -S -n -1733.5089 1651.6853 m -1780.6631 1651.6853 L -1780.6631 1646.0409 L -1732.4618 1646.0409 L -1732.7026 1647.959 1733.0344 1649.8422 1733.5089 1651.6853 C -f -0.3036 w -3.863708 M -S -n -1780.7741 1656.8158 m -1789.4913 1656.7813 1796.609 1649.6252 1796.6085 1640.9209 C -1796.6078 1632.1948 1789.5166 1625.1204 1780.7893 1625.1197 C -1780.7741 1656.8158 L -f -S -n -1780.8527 1625.2585 m -1772.1055 1625.2577 1765.0152 1632.3309 1765.0157 1641.057 C -1765.0162 1649.771 1772.0878 1656.8377 1780.8182 1656.8581 C -1780.8527 1625.2585 L -[0 1 0.91 0] vc -f -S -n -1788.3909 1680.0295 m -1788.3909 1674.4199 1792.9492 1669.8725 1798.5725 1669.8725 C -1804.1957 1669.8725 1808.7541 1674.4199 1808.7541 1680.0295 C -1808.7541 1685.6391 1804.1957 1690.1865 1798.5725 1690.1865 C -1792.9492 1690.1865 1788.3909 1685.6391 1788.3909 1680.0295 C -[1 0.85 0 0.29] vc -f -0.129 w -3.863693 M -S -n -vmrs -1811.7315 1662.863 m -1811.7315 1658.3752 1815.3782 1654.7374 1819.8768 1654.7374 C -1824.3754 1654.7374 1828.0221 1658.3752 1828.0221 1662.863 C -1828.0221 1667.3508 1824.3754 1670.9887 1819.8768 1670.9887 C -1815.3782 1670.9887 1811.7315 1667.3508 1811.7315 1662.863 C -[1 0.85 0 0.29] vc -f -0.3036 w -S -n -1819.3317 1640.8442 m -1819.3317 1637.4785 1822.0668 1634.75 1825.4406 1634.75 C -1828.8146 1634.75 1831.5497 1637.4785 1831.5497 1640.8442 C -1831.5497 1644.21 1828.8146 1646.9384 1825.4406 1646.9384 C -1822.0668 1646.9384 1819.3317 1644.21 1819.3317 1640.8442 C -[0 1 0.91 0] vc -f -0.129 w -3.863693 M -S -n -1818.4238 1623.4511 m -1818.378 1620.8336 1820.4678 1618.6747 1823.0915 1618.629 C -1825.7153 1618.5833 1827.8794 1620.6681 1827.9251 1623.2855 C -1827.971 1625.903 1825.8811 1628.0618 1823.2573 1628.1075 C -1820.6336 1628.1532 1818.4695 1626.0684 1818.4238 1623.4511 C -[1 0.85 0 0.29] vc -f -S -n -1811.9564 1610.9111 m -1811.8909 1609.0424 1813.3564 1607.4746 1815.2297 1607.4095 C -1817.103 1607.3442 1818.6746 1608.8062 1818.74 1610.6749 C -1818.8054 1612.5436 1817.3398 1614.1114 1815.4666 1614.1767 C -1813.5933 1614.2419 1812.0218 1612.78 1811.9564 1610.9111 C -f -S -n -1802.939 1601.5824 m -1802.939 1600.0865 1804.1546 1598.8739 1805.6541 1598.8739 C -1807.1536 1598.8739 1808.3693 1600.0865 1808.3693 1601.5824 C -1808.3693 1603.0784 1807.1536 1604.291 1805.6541 1604.291 C -1804.1546 1604.291 1802.939 1603.0784 1802.939 1601.5824 C -f -S -n -1791.5822 1597.4295 m -1791.5822 1596.3077 1792.4939 1595.3981 1793.6185 1595.3981 C -1794.7431 1595.3981 1795.6549 1596.3077 1795.6549 1597.4295 C -1795.6549 1598.5515 1794.7431 1599.4609 1793.6185 1599.4609 C -1792.4939 1599.4609 1791.5822 1598.5515 1791.5822 1597.4295 C -f -S -n -true eomode -1869.5987 1680.8163 m -1869.6047 1682.0082 1870.1078 1683.8552 1871.6427 1683.8552 C -1873.4619 1683.8552 1873.6648 1682.15 1873.6648 1680.6992 C -1873.6648 1679.2487 1873.4644 1677.6945 1871.6449 1677.6893 C -1870.0515 1677.6845 1869.5918 1679.5165 1869.5987 1680.8163 C -1869.5987 1680.8163 L -h -1866.7559 1677.972 m -1866.7559 1677.3501 1866.748 1676.7087 1866.7102 1676.0871 C -1869.5329 1676.0871 L -1869.5708 1676.5391 1869.6111 1676.907 1869.6111 1677.359 C -1869.6502 1677.359 L -1870.2755 1676.2475 1871.3047 1675.7763 1872.5365 1675.7763 C -1875.3223 1675.7763 1876.6296 1678.3662 1876.6296 1680.7965 C -1876.6296 1683.3396 1875.1315 1685.7292 1872.1751 1685.7292 C -1871.1897 1685.7292 1870.1809 1685.1802 1869.6502 1684.3893 C -1869.5915 1684.3893 L -1869.5915 1689.1472 L -1866.7559 1689.1483 L -1866.7559 1677.972 L -1866.7559 1677.972 L -[0 0 0 0.65] vc -f -n -false eomode -1880.1411 1685.4767 m -1877.367 1685.4767 L -1877.3692 1676.0879 L -1880.2116 1676.0879 L -1880.2116 1681.7772 L -1880.2495 1683.1521 1880.9424 1683.8455 1881.9188 1683.8357 C -1883.2912 1683.8221 1883.4922 1682.7943 1883.5109 1681.7772 C -1883.5109 1676.0871 L -1886.3534 1676.0871 L -1886.3534 1681.7772 L -1886.4366 1683.1268 1887.1745 1683.8606 1888.1508 1683.8357 C -1889.4461 1683.8029 1889.7143 1682.7943 1889.7331 1681.7772 C -1889.7331 1676.0871 L -1892.5658 1676.0871 L -1892.5658 1681.7772 L -1892.5658 1682.5308 1892.5661 1683.3239 1892.263 1684.0397 C -1891.7363 1685.0949 1890.3393 1685.7127 1889.4011 1685.7195 C -1887.9611 1685.7297 1886.9804 1685.2642 1886.0898 1684.0397 C -1885.6014 1685.0562 1884.2109 1685.7195 1883.1497 1685.7195 C -1881.7094 1685.7195 1880.8165 1685.2179 1880.2288 1684.3893 C -1880.1411 1684.3893 L -1880.1411 1685.4767 L -1880.1411 1685.4767 L -f -n -1908.4971 1685.4667 m -1908.4971 1681.3016 L -1904.3794 1681.3016 L -1904.3794 1680.1869 L -1908.4971 1680.1869 L -1908.4971 1676.0879 L -1909.6171 1676.0879 L -1909.6171 1680.1869 L -1913.807 1680.1869 L -1913.807 1681.3016 L -1909.6171 1681.3016 L -1909.6171 1685.4667 L -1908.4971 1685.4667 L -1908.4971 1685.4667 L -[0 1 1 0] vc -f -n -1919.4461 1689.7634 m -1918.9345 1689.8387 1918.4037 1689.8953 1917.8918 1689.8953 C -1914.8029 1689.8953 1914.5568 1688.2387 1914.6326 1685.5447 C -1914.6326 1676.0879 L -1917.4753 1676.0879 L -1917.4753 1683.558 L -1919.1623 1683.558 L -1919.1623 1685.4636 L -1917.4753 1685.4636 L -1917.3992 1687.3284 1917.4369 1688.2159 1919.4461 1687.9896 C -1919.4461 1689.7634 L -1919.4461 1689.7634 L -f -n -true eomode -1896.6019 1680.8163 m -1896.6082 1682.0082 1897.1114 1683.8552 1898.6462 1683.8552 C -1900.4655 1683.8552 1900.668 1682.15 1900.668 1680.6992 C -1900.668 1679.2487 1900.468 1677.6945 1898.6487 1677.6893 C -1897.0549 1677.6845 1896.5954 1679.5165 1896.6019 1680.8163 C -1896.6019 1680.8163 L -h -1893.7594 1677.972 m -1893.7594 1677.3501 1893.7512 1676.7087 1893.7134 1676.0871 C -1896.5366 1676.0871 L -1896.5743 1676.5391 1896.6147 1676.907 1896.6147 1677.359 C -1896.6534 1677.359 L -1897.279 1676.2475 1898.3086 1675.7763 1899.54 1675.7763 C -1902.3259 1675.7763 1903.6331 1678.3662 1903.6331 1680.7965 C -1903.6331 1683.3396 1902.135 1685.7292 1899.1786 1685.7292 C -1898.1935 1685.7292 1897.1844 1685.1802 1896.6534 1684.3893 C -1896.5948 1684.3893 L -1896.5948 1689.1472 L -1893.7594 1689.1483 L -1893.7594 1677.972 L -1893.7594 1677.972 L -f -n -vmr -vmr -end -%%Trailer -%%DocumentNeededResources: font Univers-Condensed -%%+ font Univers -%%+ font Univers-CondensedBold -%%DocumentFonts: Univers-Condensed -%%+ Univers -%%+ Univers-CondensedBold -%%DocumentNeededFonts: Univers-Condensed -%%+ Univers -%%+ Univers-CondensedBold Index: branches/ohl/omega-development/completed/whizard2/doc/custom.hva =================================================================== --- branches/ohl/omega-development/completed/whizard2/doc/custom.hva (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/doc/custom.hva (revision 8703) @@ -1,39 +0,0 @@ -% custom.hva -- tuning HEVEA for O'Mega documentation -% $Id: custom.hva,v 1.3 2000/10/02 20:04:39 ohl Exp $ -% Standard Math -\newcommand{\to}{\rightarrow} -\newcommand{\text}[1]{#1} -\newcommand{\substack}[1]{#1} -\newenvironment{multline}{\begin{equation}}{\end{equation}} -\newenvironment{subequations}{}{} -% Thophys -\newcommand{\braket}[1]{\langle#1\rangle} -\newcommand{\Braket}[1]{\langle#1\rangle} -\newcommand{\bra}[1]{\langle#1|} -\newcommand{\Bra}[1]{\langle#1|} -\newcommand{\ket}[1]{|#1\rangle} -\newcommand{\Ket}[1]{|#1\rangle} -% Thohacks -\newcommand{\dubious}{\begin{quote}} -\newcommand{\enddubious}{\end{quote}} -\newcommand{\timestamp}{\heveadate} -% TeX -\newcommand{\hfil}{} -\newcommand{\hss}{} -% Misc -\newcommand{\tr}{\mathrm{tr}} -% Color! -\definecolor{code}{gray}{0.8} -\newenvironment{fwbgcolor}[1] - {\@open{TABLE}{CELLPADDING=10 WIDTH="100\%"} - \@open{TR}{} - \@open{TD}{BGCOLOR=\@getcolor{#1}}} - { \@close{TD} - \@close{TR} - \@close{TABLE}} -\newenvironment{code}{\fwbgcolor{code}\verbatim}{\endverbatim\endfwbgcolor} -\endinput -Local Variables: -mode:latex -indent-tabs-mode:nil -End: Index: branches/ohl/omega-development/completed/whizard2/doc/preview.tex =================================================================== --- branches/ohl/omega-development/completed/whizard2/doc/preview.tex (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/doc/preview.tex (revision 8703) @@ -1,1790 +0,0 @@ -% $Id: preview.tex,v 1.44.10.1 2006/05/15 09:35:21 ohl Exp $ -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%BEGIN LATEX -\NeedsTeXFormat{LaTeX2e} -\input ifpdf.sty -%END LATEX -\ifpdf - \documentclass[12pt,a4paper]{article} - \usepackage{type1cm} - \usepackage[pdftex,colorlinks]{hyperref} - \usepackage[pdftex]{graphicx,feynmp,emp} - \DeclareGraphicsRule{*}{mps}{*}{} -\else - \documentclass[a4paper]{article} - % \usepackage[hypertex]{hyperref} - \usepackage{graphicx,feynmp,emp} -\fi -%BEGIN LATEX -\makeindex -\IfFileExists{hevea.sty}% - {\usepackage{hevea}} - {\def\ahref##1##2{{##2}}% - \def\ahrefloc##1##2{{##2}}% - \def\aname##1##2{{##2}}% - \def\ahrefurl##1{\url{##1}}% - \def\footahref##1##2{##2\footnote{\url{##1}}}% - \def\mailto##1{\texttt{##1}}% - \def\imgsrc##1##2[]{}% - \def\home##1{\protect\raisebox{-.75ex}{\char126}##1}% - \def\latexonly{\relax}% - \def\endlatexonly{\relax}} -%END LATEX -%\usepackage[T1]{fontenc} -\usepackage{verbatim,array,amsmath,amssymb,url} -\usepackage{thophys} -\usepackage{thohacks} -%BEGIN IMAGE -\setlength{\unitlength}{1mm} -\empaddtoTeX{\usepackage{amsmath,amssymb}} -\empaddtoTeX{\usepackage{thophys,thohacks}} -\empaddtoprelude{input graph;} -\empaddtoprelude{input boxes;} -%END IMAGE -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%% This should be part of flex.cls and/or thopp.sty -\makeatletter - \@ifundefined{frontmatter}% - {\def\frontmatter{\pagenumbering{roman}}% - \def\mainmatter{\cleardoublepage\pagenumbering{arabic}}} - {} -\makeatother -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%BEGIN LATEX -%%% \makeatletter -%%% %%% Italic figure captions to separate them visually from the text -%%% %%% (this should be supported by flex.cls): -%%% \makeatletter -%%% \@secpenalty=-1000 -%%% \def\fps@figure{t} -%%% \def\fps@table{b} -%%% \long\def\@makecaption#1#2{% -%%% \vskip\abovecaptionskip -%%% \sbox\@tempboxa{#1: \textit{#2}}% -%%% \ifdim\wd\@tempboxa>\hsize -%%% #1: \textit{#2}\par -%%% \else -%%% \global\@minipagefalse -%%% \hb@xt@\hsize{\hfil\box\@tempboxa\hfil}% -%%% \fi -%%% \vskip\belowcaptionskip} -%%% \makeatother -\widowpenalty=4000 -\clubpenalty=4000 -\displaywidowpenalty=4000 -%%% \pagestyle{headings} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\allowdisplaybreaks -\renewcommand{\topfraction}{0.8} -\renewcommand{\bottomfraction}{0.8} -\renewcommand{\textfraction}{0.2} -\setlength{\abovecaptionskip}{.5\baselineskip} -\setlength{\belowcaptionskip}{\baselineskip} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%% \special{% -%%% !userdict begin -%%% /bop-hook { gsave -%%% 150 100 translate 60 rotate -%%% /Times-Roman findfont 200 scalefont setfont -%%% 0 0 moveto 0.9 setgray (draft!) show -%%% grestore } def -%%% end} -%END LATEX -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\newenvironment{algorithm}[1]% - {\begin{list}{}% - {\setlength{\leftmargin}{3em}% - \setlength{\rightmargin}{3em}% - \setlength{\itemindent}{1em}% - \setlength{\listparindent}{0pt}% - \settowidth{\labelwidth}{5em}% - \renewcommand{\makelabel}[1]{\textbf{\hss##1:}}}}% - {\end{list}} -\newenvironment{files}% - {\begin{list}{}% - {\setlength{\leftmargin}{3em}% - \setlength{\rightmargin}{3em}% - \setlength{\itemindent}{1em}% - \setlength{\listparindent}{0pt}% - \settowidth{\labelwidth}{5em}% - \renewcommand{\makelabel}[1]{\texttt{##1}}}}% - {\end{list}} -\newenvironment{options}% - {\begin{list}{}% - {\setlength{\leftmargin}{3em}% - \setlength{\rightmargin}{3em}% - \setlength{\itemindent}{1em}% - \setlength{\listparindent}{0pt}% - \settowidth{\labelwidth}{5em}% - \renewcommand{\makelabel}[1]{\texttt{##1}}}}% - {\end{list}} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%BEGIN LATEX -\newenvironment{code}{\verbatim}{\endverbatim\noindent} -\DeclareMathOperator{\tr}{tr} -%END LATEX -\newcommand{\dd}{\mathrm{d}} -\newcommand{\ii}{\mathrm{i}} -\newcommand{\ee}{\mathrm{e}} -\renewcommand{\Re}{\text{Re}} -\renewcommand{\Im}{\text{Im}} -\newcommand{\ketbra}[2]{\ket{#1}\!\bra{#2}} -\newcommand{\Ketbra}[2]{\Ket{#1}\!\Bra{#2}} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\newcommand{\eprint}[1]{\ahref{http://arXiv.org/abs/#1}{#1}} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\begin{document} -%BEGIN IMAGE -\begin{fmffile}{previewpics} -\fmfset{arrow_ang}{10} -\fmfset{curly_len}{2mm} -\fmfset{wiggly_len}{3mm} -\begin{empfile} -%END IMAGE -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\title{\begin{latexonly} - \hfil\\\vspace*{-6\baselineskip} - \includegraphics[width=.3\textwidth]{el_te_ph}\\ - \hfil\\ - \end{latexonly} - O'Mega: An~Optimizing~Matrix~Element~Generator} -\author{% - \ahref{http://theorie.physik.uni-wuerzburg.de/\home{ohl}/}% - {Thorsten Ohl}\thanks{e-mail: \mailto{ohl@physik.uni-wuerzburg.de}}, - J\"urgen Reuter\thanks{e-mail: \mailto{reuter@particle.uni-karlsruhe.de}}, - Christian Schwinn\thanks{e-mail: \texttt{schwinn@zino.physik.uni-mainz.de}}\\ - \hfil\\ - University of W\"urzburg, University of Karlsruhe, University of Mainz -%HEVEA \\\hfil\\ -%HEVEA \imgsrc{el_te_ph.gif} -} -\date{\today} -\maketitle -\begin{abstract} - We sketch the architecture of \textit{O'Mega}, a new - optimizing compiler for tree amplitudes in quantum field theory, - and briefly describe its usage. - O'Mega generates the most efficient code currently available for - scattering amplitudes for many polarized particles in the Standard - Model and its extensions. -\end{abstract} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%HEVEA O'Mega is Free Software and the -%HEVEA \ahref{http://theorie.physik.uni-wuerzburg.de/\home{ohl}/omega/sources}{sources} -%HEVEA can be found at -%HEVEA \ahref{http://theorie.physik.uni-wuerzburg.de/\home{ohl}/omega/sources}{this link}. -%HEVEA Follow \ahrefloc{installation}{this link} for -%HEVEA \ahrefloc{installation}{installation instructions}. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%%\tableofcontents -\section{Introduction} -\label{sec:intro} -Current and planned experiments in high energy physics can probe -physics in -processes with polarized beams and many tagged particles in the final -state. The combinatorial explosion of the number of Feynman diagrams -contributing to scattering amplitudes for many external particles -calls for the development of more compact representations that -translate well to efficient and reliable numerical code. In gauge -theories, the contributions from individual Feynman diagrams are gauge -dependent. Strong numerical cancellations in a redundant -representation built from individual Feynman diagrams lead to a loss -of numerical precision, stressing further the need for eliminating -redundancies. - -Due to the large number of processes that have to be studied in order -to unleash the potential of modern experiments, the construction of -nearly optimal representations must be possible algorithmically on a -computer and should not require human ingenuity for each new -application. - -\textit{O'Mega}~\cite{O'Mega,Ohl:2000:ACAT,Ohl:2000:LCWS} is a compiler for -tree-level scattering amplitudes that satisfies these requirements. -O'Mega is independent of the target language and can therefore create -code in any programming language for which a simple output module has -been written. To support a physics model, O'Mega requires as input -only the Feynman rules and the relations among coupling constants. - -Similar to the earlier numerical approaches~\cite{ALPHA:1997} -and~\cite{HELAC:2000}, O'Mega reduces the growth in calculational -effort from a factorial of the number of particles to an exponential. -The symbolic nature of O'Mega, however, increases its flexibility. -Indeed, O'Mega can emulate both~\cite{ALPHA:1997} -and~\cite{HELAC:2000} and produces code that is empirically at least -twice as fast. The detailed description of all algorithms is -contained in the extensively commented source code of -O'Mega~\cite{O'Mega}. - -In this note, we sketch the architecture of O'Mega and describe the -usage of the first version. The building blocks of the representation -of scattering amplitudes generated by O'Mega are described in -section~\ref{sec:1POW} and directed acyclical graphs are introduced in -section~\ref{sec:DAG}. The algorithm for constructing the directed -acyclical graph is presented in section~\ref{sec:algorithm} and its -implementation is described in section~\ref{sec:implementation}. -We conclude with a few results and examples in -section~\ref{sec:results}. Practical information is -presented in the appendices: installation of the O'Mega software in -appendix~\ref{sec:installation}, running of the O'Mega compiler in -appendix~\ref{sec:running} and using O'Mega's output in -appendix~\ref{sec:using}. Finally, appendix~\ref{sec:extensions} -briefly discusses mechanisms for extending O'Mega. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\section{One Particle Off Shell Wave Functions} -\label{sec:1POW} - -\textit{One Particle Off-Shell Wave Functions}~(1POWs) are obtained -from connected Greensfunctions by applying the LSZ reduction formula -to all but one external line while the remaining line is kept off the -mass shell -\begin{multline} - W(x; p_1,\ldots,p_n; q_1,\ldots,q_m) = \\ - \Braket{\phi(q_1),\ldots,\phi(q_m);\text{out}|\Phi(x) - |\phi(p_1),\ldots,\phi(p_n);\text{in}}\,. -\end{multline} -Depending on the context, the off shell line will either be understood as -amputated or not. For example, -$\Braket{\phi(q_1),\phi(q_2);\text{out}|\Phi(x)|\phi(p_1);\text{in}}$ -in unflavored scalar $\phi^3$-theory is given at tree level by -%HEVEA\begin{center} -%BEGIN IMAGE -\begin{equation} - \parbox{26\unitlength}{% - \fmfframe(2,4)(6,5){% - \begin{fmfgraph*}(17,15) - \fmflabel{$x$}{x} - \fmflabel{$p_1$}{l} - \fmflabel{$q_1$}{r1} - \fmflabel{$q_2$}{r2} - \fmftop{x} - \fmfleft{l,dl} - \fmfright{r1,r2,dr} - \fmf{plain}{l,v} - \fmf{plain}{r1,v} - \fmf{plain}{r2,v} - \fmf{plain,tension=3}{x,v} - \fmfblob{.4w}{v} - \fmfdot{x} - \end{fmfgraph*}}} = - \parbox{26\unitlength}{% - \fmfframe(2,4)(6,5){% - \begin{fmfgraph*}(17,15) - \fmflabel{$x$}{x} - \fmflabel{$p_1$}{l} - \fmflabel{$q_1$}{r1} - \fmflabel{$q_2$}{r2} - \fmftop{x} - \fmfleft{l,dl} - \fmfright{r1,r2,dr} - \fmf{plain}{l,v} - \fmf{plain}{r1,vr,v} - \fmf{plain}{r2,vr} - \fmf{plain,tension=5}{x,v} - \fmfdot{x} - \end{fmfgraph*}}} + - \parbox{26\unitlength}{% - \fmfframe(2,4)(6,5){% - \begin{fmfgraph*}(17,15) - \fmflabel{$x$}{x} - \fmflabel{$p_1$}{l} - \fmflabel{$q_1$}{r1} - \fmflabel{$q_2$}{r2} - \fmftop{x} - \fmfleft{l,dl} - \fmfright{r1,r2,dr} - \fmf{plain}{l,vr,v} - \fmf{plain}{r1,vr} - \fmf{plain}{r2,v} - \fmf{plain,tension=5}{x,v} - \fmfdot{x} - \end{fmfgraph*}}} + - \parbox{26\unitlength}{% - \fmfframe(2,4)(6,5){% - \begin{fmfgraph*}(17,15) - \fmflabel{$x$}{x} - \fmflabel{$p_1$}{l} - \fmflabel{$q_1$}{r1} - \fmflabel{$q_2$}{r2} - \fmftop{x} - \fmfleft{l,dl} - \fmfright{r1,r2,dr} - \fmf{plain}{l,vr} - \fmf{plain,tension=0.5}{vr,v} - \fmf{plain}{r1,v} - \fmf{plain,rubout,tension=0.5}{r2,vr} - \fmf{plain,tension=5}{x,v} - \fmfdot{x} - \end{fmfgraph*}}}. -\end{equation} -%END IMAGE -%HEVEA\imageflush -%HEVEA\end{center} - -The number of distinct momenta that can be formed from -$n$~external momenta is $P(n)=2^{n-1}-1$. Therefore, the number of -tree 1POWs grows exponentially with the number of external particles -and not with a factorial, as the number of Feynman diagrams, e.\,g.{} -$F(n)=(2n-5)!!=(2n-5)\cdot\ldots5\cdot3\cdot1$ in unflavored -$\phi^3$-theory. - -At tree-level, the set of all 1POWs for a given set of external -momenta can be constructed recursively -%HEVEA\begin{center} -%BEGIN IMAGE -\begin{equation} -\label{eq:recursive-1POW} - \parbox{22\unitlength}{% - \fmfframe(2,3)(2,1){% - \begin{fmfgraph*}(17,15) - \fmflabel{$x$}{x} - \fmftop{x} - \fmfbottomn{n}{6} - \fmf{plain,tension=6}{x,n} - \fmfv{d.sh=circle,d.f=empty,d.si=30pt,l=$n$,l.d=0}{n} - \begin{fmffor}{i}{1}{1}{6} - \fmf{plain}{n,n[i]} - \end{fmffor} - \end{fmfgraph*}}} = - \sum_{k+l=n} - \parbox{32\unitlength}{% - \fmfframe(2,3)(2,1){% - \begin{fmfgraph*}(27,15) - \fmflabel{$x$}{x} - \fmftop{x} - \fmfbottomn{n}{6} - \fmf{plain,tension=8}{x,n} - \fmf{plain,tension=4}{n,k} - \fmf{plain,tension=4}{n,l} - \fmfv{d.sh=circle,d.f=empty,d.si=20pt,l=$k$,l.d=0}{k} - \fmfv{d.sh=circle,d.f=empty,d.si=20pt,l=$l$,l.d=0}{l} - \fmffixed{(30pt,0pt)}{k,l} - \begin{fmffor}{i}{1}{1}{4} - \fmf{plain}{k,n[i]} - \end{fmffor} - \begin{fmffor}{i}{5}{1}{6} - \fmf{plain}{l,n[i]} - \end{fmffor} - \fmfdot{n} - \end{fmfgraph*}}}\,, -\end{equation} -%END IMAGE -%HEVEA\imageflush -%HEVEA\end{center} -where the sum extends over all partitions of the set of $n$~momenta. -This recursion will terminate at the external wave functions. - -For all quantum field theories, there are---well defined, but not -unique---sets of \emph{Keystones}~$K$~\cite{O'Mega} such that the sum -of tree Feynman diagrams for a given process can be expressed as a -sparse sum of products of 1POWs without double counting. In a theory -with only cubic couplings this is expressed as -\begin{equation} -\label{eq:keystones} - T = \sum_{i=1}^{F(n)} D_i = - \sum_{k,l,m=1}^{P(n)} - K^{3}_{f_kf_lf_m}(p_k,p_l,p_m) - W_{f_k}(p_k)W_{f_l}(p_l)W_{f_m}(p_m)\,, -\end{equation} -with obvious generalizations. -The non-trivial problem is to avoide the -double counting of diagrams like -%HEVEA\begin{center} -%BEGIN IMAGE -\begin{center} - \begin{fmfgraph}(25,16) - \fmfleftn{l}{3} - \fmfrightn{r}{3} - \fmf{plain}{l1,v4} - \fmf{plain}{l2,v4} - \fmf{plain}{l3,v4} - \fmf{plain}{r1,v1} - \fmf{plain}{r2,v1} - \fmf{plain}{v1,v2} - \fmf{plain}{r3,v2} - \fmf{plain}{v2,v4} - \fmfv{d.sh=circle,d.fill=empty,d.si=6thin}{v4} - \fmfdot{v1,v2} - \end{fmfgraph} - \qquad\qquad - \begin{fmfgraph}(25,16) - \fmfleftn{l}{3} - \fmfrightn{r}{3} - \fmf{plain}{l1,v4} - \fmf{plain}{l2,v4} - \fmf{plain}{l3,v4} - \fmf{plain}{r1,v1} - \fmf{plain}{r2,v1} - \fmf{plain}{v1,v2} - \fmf{plain}{r3,v2} - \fmf{plain}{v2,v4} - \fmfv{d.sh=circle,d.fill=empty,d.si=6thin}{v2} - \fmfdot{v1,v4} - \end{fmfgraph}\,, -\end{center} -%END IMAGE -%HEVEA\imageflush -%HEVEA\end{center} -where the circle denotes the keystone. The problem has been solved -explicitely for general theories with vertices of arbitrary -degrees~\cite{O'Mega}. The solution is inspired by -arguments~\cite{ALPHA:1997} based on the equations of motion (EOM) of -the theory in the presence of sources. The iterative solution of the -EOM leads to the construcion of the 1POWs and the constraints imposed -on the 1POWs by the EOM suggest the correct set~\cite{ALPHA:1997} of -partitions $\{(p_k,p_l,p_m)\}$ in equation~(\ref{eq:keystones}). - -The maximally symmetric solution selects among equivalent diagrams the -keystone closest to the center of a diagram. This corresponds to -the numerical expressions of~\cite{ALPHA:1997}. The absence of double -counting can be demonstrated by counting the number~$F(d_{\max},n)$ of -unflavored Feynman tree diagrams with~$n$ external legs and vertices of -maximum degree~$d_{\max}$ in to different ways: once directly and then -as a sum over keystones. The number~$\tilde F(d_{\max},N_{d,n})$ of -unflavored Feynman tree diagrams for one keystone -$N_{d,n}=\{n_1,n_2,\ldots,n_d\}$, with $n = n_1 + n_2 + \cdots + n_d$, -is given by the product of the number of subtrees and symmetry factors -\begin{subequations} -\begin{equation} - \tilde F(d_{\max},N_{d,n}) = - \frac{n!}{|\mathcal{S}(N_{d,n})|\sigma(n_d,n)} - \prod_{i=1}^{d} \frac{F(d_{\max},n_i+1)}{n_i!}\, -\end{equation} -where $|\mathcal{S}(N)|$ is the size of the symmetric group -of~$N$, $\sigma(n,2n) = 2$ and $\sigma(n,m) = 1$ otherwise. Indeed, -it can be verified that the sum over all keystones reproduces the -number -\begin{equation} - F(d_{\max},n) = - \sum_{d=3}^{d_{\max}} - \sum_{\substack{N = \{n_1,n_2,\ldots,n_d\}\\ - n_1 + n_2 + \cdots + n_d = n\\ - 1 \le n_1 \le n_2 \le \cdots \le n_d \le \lfloor n/2 \rfloor}} - \tilde F(d_{\max},N) -\end{equation} -\end{subequations} -of \emph{all} unflavored Feynman tree diagrams. - -A second consistent prescription for the construction of keystones is -maximally asymmetric and selects the keystone adjacent to a chosen -external line. This prescription reproduces the approach -in~\cite{HELAC:2000} where the tree-level Schwinger-Dyson equations -are used as a special case of the EOM. - -Recursive algorithms for gauge theory amplitudes have been pioneered -in~\cite{Berends:1988me}. The use of 1POWs as basic building blocks -for the calculation of scattering amplitudes in tree approximation has -been advocated in~\cite{HELAS} and a heuristic procedure, without -reference to keystones, for minimizing the number of arithmetical -operations has been suggested. This approach is used by -MADGRAPH~\cite{MADGRAPH:1994} for fully automated calculations. The -heuristic optimizations are quite efficient for $2\to4$ processes, but -the number of operations remains bounded from below by the number of -Feynman diagrams. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\subsection{Ward Identities} -\label{sec:WI} - -\begin{subequations} -A particularly convenient property of the 1POWs in gauge theories is -that, even for vector particles, the 1POWs are `almost' physical -objects and satisfy simple Ward Identities -\label{eq:ward} -\begin{equation} - \frac{\partial}{\partial x_\mu} - \Braket{\text{out}|A_\mu(x)|\text{in}}_{\text{amp.}} = 0 -\end{equation} -for unbroken gauge theories and -\begin{equation} - \frac{\partial}{\partial x_\mu} - \Braket{\text{out}|W_\mu(x)|\text{in}}_{\text{amp.}} = - - m_W \Braket{\text{out}|\phi_W(x)|\text{in}}_{\text{amp.}} -\end{equation} -for spontaneously broken gauge theories in $R_\xi$-gauge for all -physical external states~$\ket{in}$ and $\ket{out}$. Thus the -identities~(\ref{eq:ward}) can serve as powerful numerical checks -both for the consistency of a set of Feynman rules and for the -numerical stability of the generated code. The code for matrix -elements can optionally be instrumented by O'Mega with numerical -checks of these Ward identities for intermediate lines. -\end{subequations} - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\section{Directed Acyclical Graphs} -\label{sec:DAG} - -The algebraic expression for the tree-level scattering amplitude in -terms of Feynman diagrams is itself a tree. The much slower growth of -the set of 1POWs compared to the set of Feynman diagrams shows that this -representation is extremely redundant. In this case, \emph{Directed -Acyclical Graphs} (DAGs) provide a more efficient representation, as -illustrated by a trivial example -%HEVEA\begin{center} -%BEGIN IMAGE -\begin{empcmds} - vardef dag_coords = - pair node[][]; node[1][1] = (.5w,.h); - node[2][1] = (.3w,2/3h); node[2][2] = (.7w,2/3h); - node[3][1] = (.2w,1/3h); node[3][2] = (.4w,1/3h); - node[3][3] = (.6w,1/3h); node[3][4] = (.8w,1/3h); - node[4][1] = (.5w,0/3h); node[4][2] = (.7w,0/3h); - % setbounds currentpicture to (0,0)--(w,0)--(w,h)--(0,h)--cycle; - enddef; - vardef dag_common = - dag_coords; - pickup pencircle scaled 1pt; - label.rt (btex $\times$ etex, node[1][1]); - draw node[1][1]--node[2][2]; - label.rt (btex $+$ etex, node[2][2]); - draw node[2][2]--node[3][3]; - draw node[2][2]--node[3][4]; - label.rt (btex $\times$ etex, node[3][3]); - draw node[3][3]--node[4][1]; - draw node[3][3]--node[4][2]; - label.rt (btex $\vphantom{b}c$ etex, node[3][4]); - label.rt (btex $\vphantom{b}a$ etex, node[4][1]); - label.rt (btex $\vphantom{b}b$ etex, node[4][2]); - pickup pencircle scaled 3pt; - pickup pencircle scaled 3pt; - drawdot node[1][1]; - drawdot node[2][2]; - drawdot node[3][3]; - enddef; -\end{empcmds} -\begin{empdef}[dag](38,16) - dag_common; - pickup pencircle scaled 1pt; - draw node[1][1]{(-1,-1)}..{(1,-1)}node[3][3]; -\end{empdef} -\begin{empdef}[tree](38,16) - dag_common; - pickup pencircle scaled 1pt; - label.rt (btex $\times$ etex, node[2][1]); - draw node[1][1]--node[2][1]; - draw node[2][1]--node[3][1]; - draw node[2][1]--node[3][2]; - label.rt (btex $\vphantom{b}a$ etex, node[3][1]); - label.rt (btex $\vphantom{b}b$ etex, node[3][2]); - pickup pencircle scaled 3pt; - drawdot node[2][1]; -\end{empdef} -\begin{equation} - ab (ab+c) = - \parbox{28\unitlength}{\hfil\empuse{tree}\hfil} - = \parbox{18\unitlength}{\hfil\empuse{dag}\hfil} -\end{equation} -%END IMAGE -%HEVEA\imageflush -%HEVEA\end{center} -where one multiplication is saved. The replacement of expression -trees by equivalent DAGs is part of the repertoire of optimizing -compilers, known as \emph{common subexpression elimination}. -Unfortunately, this approach fails in practice for all interesting -expressions appearing in quantum field theory, because of the -combinatorial growth of space and time required to find an almost -optimal factorization. - -However, the recursive definition in equation~(\ref{eq:recursive-1POW}) -allows to construct the DAG of the 1POWs in equation~(\ref{eq:keystones}) -\emph{directly}~\cite{O'Mega}, without having to construct and -factorize the Feynman diagrams explicitely. - -As mentioned above, there is more than one consistent prescription for -constructing the set of keystones~\cite{O'Mega}. The symbolic -expressions constructed by O'Mega contain the symbolic equivalents of -the numerical expressions computed by~\cite{ALPHA:1997} (maximally -symmetric keystones) and~\cite{HELAC:2000} (maximally asymmetric -keystones) as special cases. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\section{Algorithm} -\label{sec:algorithm} - -By virtue of their recursive construction in -Eqs.~(\ref{eq:recursive-1POW}), tree-level 1POWs form a DAG and the -problem is to find the smallest DAG that corresponds to a given tree, -(i.\,e.~a given sum of Feynman diagrams). O'Mega's algorithm -proceeds in four steps -\begin{algorithm}{Calculate} - \item[Grow] starting from the external particles, build the tower of - \emph{all} 1POWs up to a given height (the height - is less than the number of external lines for asymmetric - keystones and less than half of that for symmetric keystones) - and translate it to the equivalent DAG~$D$. - \item[Select] from $D$, determine \emph{all} possible - \emph{flavored keystones} for the process under - consideration and the 1POWs appearing in them. - \item[Harvest] construct a sub-DAG $D^*\subseteq D$ consisting - \emph{only} of nodes that contribute to the 1POWs - appearing in the flavored keystones. - \item[Calculate] multiply the 1POWs as specified by the keystones - and sum the keystones. -\end{algorithm} -By construction, the resulting expression contains no more -redundancies and can be translated to a numerical expression. In -general, asymmetric keystones create an expression that is smaller -by a few percent than the result from symmetric keystones, but it -is not yet clear which approach produces the numerically more robust -results. - -The details of this algorithm as implemented in O'Mega are described -in the source code~\cite{O'Mega}. The persistent data -structures~\cite{Okasaki:1998:book} used for the determination -of~$D^*$ are very efficient so that the generation of, e.\,g.~Fortran -code for amplitudes in the Standard Model is always much faster than -the subsequent compilation. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\section{Color} -\label{sec:color} - -\begin{dubious} - We will implement a variation of numeric color - diagonalization~\cite{Barger/etal:1992:color}. -\end{dubious} - -\begin{dubious} - Here's a sketch of the algorithm: - \begin{enumerate} - \item expand the DAG~$D$ to a list~$L$ of trees - \item numerically calculate the matrix~$C$ of color factors - for the squared matrix element - \item diagonalize~$C$ - \item tag the wave functions in~$D$ by the list of their - appearances in~$L$ - \item for each wavefunction in~$D$, calculate the coefficients - of the eigenvectors corresponding to non-zero eigenvalues of~$C$ - \item (like for Fermi statistics) keep only the factors that are - \emph{not} already in the daughter wave functions - \end{enumerate} -\end{dubious} - -\begin{dubious} - This multiplies the complexity of the colorless amplitude - by the number of eigenvectors with non-zero eigenvalues of~$C$. - Asymptotically, this will beat~\cite{MADGRAPH:1994}, but it is - not obvious where the break even point is for many eigenvectors. - Therefore more precise estimates will be useful \ldots -\end{dubious} - -\begin{dubious} - The same approach might be workable for spin and flavor sums. The - gains are not obvious (they depend on the number of - eigenamplitudes), but they could be huge. -\end{dubious} - -For the sums over Feynman diagrams, color eigenamplitudes and wave -functions, we introduce the following conventions: -\begin{subequations} -\begin{align} - i &\in \{ 1, 2, \ldots, N_{\mathrm{FD}}\} \\ - a &\in \{ 1, 2, \ldots, N_{\mathrm{ev}}, \ldots, N_{\mathrm{FD}}\} \\ - n &\in \{ 1, 2, \ldots, N_{\mathrm{WF}}\} -\end{align} -\end{subequations} - -A wavefunction is given by a sum over all Feynman diagrams -\begin{equation} - W_n = \sum_i w_{n,i} = \Braket{0|\phi|n} -\end{equation} -where -\begin{equation} - w_{n,i} = \Braket{0|\phi|n}_{\text{diagram \#$i$}} -\end{equation} -corresponds to the contribution of diagram~$i$ to the -wavefunction~$W_n$. - -\begin{equation} - A_a = \sum_i c_{ai} a_i -\end{equation} - -\begin{equation} - W_{n,a} = \sum_i c_{ai} w_{n,i} -\end{equation} -and -\begin{equation} - w_{n,i} = \sum_a (c^{-1})_{ia} W_{n,a} -\end{equation} - -Fusion coefficients -\begin{subequations} -\begin{align} - F_{a,bc} &= \sum_i c_{ai}(c^{-1})_{ib}(c^{-1})_{ic} \\ - F_{a,bcd} &= \sum_i c_{ai}(c^{-1})_{ib}(c^{-1})_{ic}(c^{-1})_{id} -\end{align} -\end{subequations} -can be calculated numerically, since~$c_{ai}$ can be extended to a -non-singular square matrix, even if we need only small part of it. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\section{Implementation} -\label{sec:implementation} -The O'Mega compiler is implemented in O'Caml~\cite{O'Caml}, a -functional programming language of the ML family with a very -efficient, portable and freely available implementation, that can be -bootstrapped on all modern computers in a few minutes. -The library modules built on experience -from~\cite{Ohl:LOTR,Ohl:bocages}. - -A pretty printed and cross referenced snapshot of the complete -implementation can be read -at~\ahrefurl{http://theorie.physik.uni-wuerzburg.de/\home{ohl}/omega/doc/omega.ps.gz}. -However, this code is still under construction and while fully -functional contains unfinished developments and dead ends. - -The powerful module system of O'Caml allows an efficient and concise -implementation of the DAGs for a specific physics model as a functor -application~\cite{O'Mega}. This functor maps from the category of -trees to the category of DAGs and is applied to the set of trees -defined by the Feynman rules of any model under consideration. - -\begin{figure} -%BEGIN IMAGE - %includegraphics[width=\textwidth]{modules} - \includegraphics[height=.9\textheight]{modules} -%END IMAGE -%HEVEA\imageflush - \caption{\label{fig:modules}% - Module dependencies in O'Mega. The diamond shaped nodes denote - abstract signatures defining functor domains and co-domains. - The rectangular boxes denote modules and functors, while oval - boxes stand for example applications.} -\end{figure} -The module system of O'Caml has been used to make the combinatorial -core of O'Mega demonstrably independent from the specifics of both the -physics model and the target language~\cite{O'Mega}, as shown in -Figure~\ref{fig:modules}. A Fortran90/95 backend has been realized -first, backends for C++ and Java will follow. The complete -electroweak Standard Model has been implemented together with -anomalous gauge boson couplings. Recently, the Minimal Supersymmetric -Standard Model~(MSSM) has been added. The implementation of -interfering color amplitudes is currently being completed. - -Many extensions of the Standard Model, most prominently the MSSM, -contain Majorana fermions. In -this case, fermion lines have no canonical orientation and the -determination of the relative signs of interfering amplitudes is not -trivial. However, the Feynman rules for Majorana fermions and fermion -number violating interactions proposed in~\cite{Denner/etal:Majorana} -have been implemented in O'Mega in analogy to the naive Feynman rules -for Dirac fermions and both methods are available. Numerical -comparisons of amplitudes for Dirac fermions calculated both ways show -agreement at a small multiple of the machine precision. - -As mentioned above, the compilers for the target programming language -are the slowest step in the generation of executable code. On the -other hand, the execution speed of the code is limited by non-trivial -vertex evaluations for vectors and spinors, which need $O(10)$ complex -multiplications. Therefore, an \emph{O'Mega Virtual Machine} can -challenge native code and avoid compilations. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\section{Results} -\label{sec:results} - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\subsection{Examples} -\label{sec:examples} - -\begin{table} - \begin{center} - \begin{tabular}{l|rr|rr} - \multicolumn{1}{c|}{process} - & \multicolumn{2}{c|}{Diagrams} - & \multicolumn{2}{c}{O'Mega} \\ - & \multicolumn{1}{c}{\#} & vertices - & \#prop. & vertices \\%\hline - $e^+e^-\to e^+\bar\nu_e d\bar u$ - & 20 & 80 & 14 & 45 \\ -%%%SM4 & 20 & 80 & 14 & 45 \\ -%%%SM4h & 20 & 80 & 14 & 35 \\ - $e^+e^-\to e^+\bar\nu_e d\bar u \gamma$ - & 146 & 730 & 36 & 157 \\ -%%%SM4 & 142 & 710 & 33 & 151 \\ -%%%SM4h & 142 & 710 & 33 & 115 \\ - $e^+e^-\to e^+\bar\nu_e d\bar u \gamma\gamma$ - & 1256 & 7536 & 80 & 462 \\ -%%%SM4 & 1174 & 7044 & 71 & 441 \\ -%%%SM4h & 1174 & 7044 & 71 & 361 \\ - $e^+e^-\to e^+\bar\nu_e d\bar u \gamma\gamma\gamma$ - & 12420 & 86940 & 168 & 1343 \\ -%%%SM4 & 11058 & 77406 & 147 & 1284 \\ -%%%SM4h & 11058 & 77406 & 147 & 1106 \\ - $e^+e^-\to e^+\bar\nu_e d\bar u \gamma\gamma\gamma\gamma$ - & 138816 & 1110528 & 344 & 3933 - \end{tabular} - \end{center} - \caption{\label{tab:4fgamma}% - Radiative corrections to four fermion production: comparison of - the computational complexity of scattering amplitudes obtained - from Feynman diagrams and from O'Mega. (The counts correspond to - the full Standard Model---sans light fermion Yukawa couplings---in - unitarity gauge with quartic couplings emulated by cubic - couplings of non-propagating auxiliary fields.)} -\end{table} - -\begin{table} - \begin{center} - \begin{tabular}{l|rr|rr} - \multicolumn{1}{c|}{process} - & \multicolumn{2}{c|}{Diagrams} - & \multicolumn{2}{c}{O'Mega} \\ - & \multicolumn{1}{c}{\#} & vertices - & \#prop. & vertices \\%\hline - $e^+e^-\to e^+\bar\nu_e d\bar u b\bar b$ - & 472 & 2832 & 49 & 232 \\ -%%%SM4 & 464 & 2784 & 46 & 227 \\ -%%%SM4h & 464 & 2784 & 46 & 186 \\ - $e^+e^-\to e^+\bar\nu_e d\bar u b\bar b \gamma$ - & 4956 & 34692 & 108 & 722 \\ -%%%SM4 & 4738 & 33166 & 99 & 709 \\ -%%%SM4h & 4738 & 33166 & 99 & 606 \\ - $e^+e^-\to e^+\bar\nu_e d\bar u b\bar b \gamma\gamma$ - & 58340 & 466720 & 226 & 2212 - \end{tabular} - \end{center} - \caption{\label{tab:6fgamma}% - Radiative corrections to six fermion production: comparison of - the computational complexity of scattering amplitudes obtained - from Feynman diagrams and from O'Mega. (The counts correspond to - the full Standard Model---sans light fermion Yukawa couplings---in - unitarity gauge with quartic couplings emulated by cubic - couplings of non-propagating auxiliary fields.)} -\end{table} - -Tables~\ref{tab:4fgamma} and~\ref{tab:6fgamma} show the reduction in -computational complexity for some important processes at a -$e^+e^-$-linear collider including radiative corrections. Using the -asymmetric keystones can reduce the number of vertices by some~10 -to~20 percent relativ to the quoted numbers for symmetric keystones. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\subsection{Comparisons} -\label{sec:comparisons} - -HELAC's~\cite{HELAC:2000} diagnostics report more vertices than O'Mega -for identical amplitudes. This ranges from comparable numbers for -Standard Model processes with many different flavors to an increase by -50 percent for processes with many identical flavors. Empirically, -O'Mega's straight line code is twice as fast as HELAC's DO-loops for -identical optimizing Fortran95 compilers (not counting HELAC's -initialization phase). Together this results in an improved -performance by a factor of two to three. - -The numerical efficiency of O'Mega's Fortran95 runtime library is -empirically identical to HELAS~\cite{HELAS}. Therefore, O'Mega's -performance can directly be compared to -MADGRAPH's~\cite{MADGRAPH:1994} by comparing the number of vertices. -For $2\to5$-processes in the Standard Model, O'Mega's advantage in -performance is about a factor of two and grows from there. - -The results have been compared with MADGRAPH~\cite{MADGRAPH:1994} for -many Standard Model processes and numerical agreement at the level -of~$10^{-11}$ has been found with double precision floating point -arithmetic. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\subsection{Applications} -O'Mega generated amplitudes are used in the omnipurpose -event generator generator WHIZARD~\cite{Kilian:WHIZARD}. The first -complete experimental study of vector boson scattering in six fermion -production for linear collider -physics~\cite{Chierici/Kobel/Rosati:2000:TDR-backup} was -facilitated by O'Mega and WHIZARD. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\section*{Acknowledgements} -We thank Mauro Moretti for fruitful discussions of the ALPHA -algorithm~\cite{ALPHA:1997}, that inspired our solution of the double -counting problem. - -We thank Wolfgang Kilian for providing the WHIZARD environment that -turns our numbers into real events with unit weight. Thanks to the -ECFA/DESY workshops and their participants for providing a showcase. -Part of this research was supported by Bundesministerium f\"ur Bildung und -Forschung, Germany, (05\,HT9RDA) and Deutsche Forschungsgemeinschaft -(MA\,676/6-1). - -Finally, thanks to the Caml and Objective Caml teams at INRIA for the -lean and mean implementation of a programming language that does not -insult the programmer's intelligence. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\begin{thebibliography}{10} - \bibitem{O'Mega} - M. Moretti, T. Ohl, J. Reuter, C. Schwinn, - \textit{O'Mega, Version 1.0: An~Optimizing Matrix~Element~Generator}, - Long Write Up and User's Manual (in progress), -%%% \ahrefurl{http://theorie.physik.uni-wuerzburg.de/\home{ohl}/omega/doc/}. - \url{http://theorie.physik.uni-wuerzburg.de/~ohl/omega/doc/}. - \bibitem{Ohl:2000:ACAT} - T. Ohl, \textit{O'Mega: An~Optimizing Matrix~Element~Generator}, - Proceedings of the \textit{Workshop on Advanced Computing and - Analysis Technics in Physics Research,} Fermilab, October 2000, - IKDA 2000/30, \eprint{hep-ph/0011243}. - \bibitem{Ohl:2000:LCWS} - T. Ohl, \textit{O'Mega \&\ WHIZARD: Monte Carlo Event Generator - Generation For Future Colliders}, Proceedings of the - \textit{Workshop on Physics and Experimentation with Future Linear - $e^+e^-$-Colliders (LCWS2000),} Fermilab, October 2000, - IKDA 2000/31, \eprint{hep-ph/0011287}. - \bibitem{ALPHA:1997} -%\cite{Caravaglios:1995cd} -%\bibitem{Caravaglios:1995cd} -F.~Caravaglios and M.~Moretti, -%``An algorithm to compute Born scattering amplitudes without Feynman graphs,'' -Phys.\ Lett.\ {\bf B358} (1995) 332 -[hep-ph/9507237]. -%%CITATION = HEP-PH 9507237;%% - F. Caravaglios, M. Moretti, Z.{} Phys.{} \textbf{C74} (1997) 291. - \bibitem{HELAC:2000} - A. Kanaki, C. Papadopoulos, DEMO-HEP-2000/01, \eprint{hep-ph/0002082}, - February 2000. -%\cite{Berends:1988me} -\bibitem{Berends:1988me} -F.~A.~Berends and W.~T.~Giele, -%``Recursive Calculations For Processes With N Gluons,'' -Nucl.\ Phys.\ {\bf B306} (1988) 759. -%%CITATION = NUPHA,B306,759;%% - \bibitem{HELAS} - H. Murayama, I. Watanabe, K. Hagiwara, KEK Report 91-11, - January 1992. - \bibitem{MADGRAPH:1994} - T. Stelzer, W.F. Long, - Comput.{} Phys.{} Commun.{} \textbf{81} (1994) 357. - \bibitem{Barger/etal:1992:color} - V.~Barger, A.~L.~Stange, R.~J.~N.~Phillips, - Phys.~Rev.~\textbf{D45}, (1992) 1751. - \bibitem{Okasaki:1998:book} - Chris Okasaki, \textit{Purely Functional Data Structures}, - Cambridge University Press, 1998. - \bibitem{O'Caml} - Xavier Leroy, - \textit{The Objective Caml System, Release 3.01, Documentation and - User's Guide}, Technical Report, INRIA, 2001, - \ahrefurl{http://pauillac.inria.fr/ocaml/}. - \bibitem{Ohl:LOTR} - T. Ohl, \textit{Lord of the Rings}, - (Computer algebra library for O'Caml, unpublished). - \bibitem{Ohl:bocages} - T. Ohl, \textit{Bocages}, - (Feynman diagram library for O'Caml, unpublished). - \bibitem{Denner/etal:Majorana} - A. Denner, H. Eck, O. Hahn and J. K\"ublbeck, - Phys.{} Lett.{} \textbf{B291} (1992) 278; - Nucl.{} Phys.{} \textbf{B387} (1992) 467. - \bibitem{Kilian:WHIZARD} - W. Kilian, - \textit{WHIZARD 1.0: A generic Monte-Carlo integration and event - generation package for multi-particle processes}, - \ahrefurl{http://www-ttp.physik.uni-karlsruhe.de/Progdata/whizard/}, - LC-TOOL-2001-039. - \bibitem{Chierici/Kobel/Rosati:2000:TDR-backup} - R. Chierici, S. Rosati, and M. Kobel, - \textit{Strong Electroweak Symmetry Breaking Signals in - $\mathrm{WW}$ Scattering at TESLA}, - LC-PHSM-2001-038. - \bibitem{CompHEP} - E. E. Boos et al, \textit{CompHEP - a package for evaluation of - Feynman diagrams and integration over multi-particle phase space,} - \eprint{hep-ph/9908288}. -\end{thebibliography} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\appendix -\section{Installing O'Mega} -\label{sec:installation} -\aname{installation}{}% -\subsection{Sources} -O'Mega is Free Software and the sources can be obtained from -\ahrefurl{http://theorie.physik.uni-wuerzburg.de/\home{ohl}/omega/sources/}. - -The command -\begin{code} -ohl@thopad:~mc$ zcat omega-yyyy-mm-dd-hhmm.tar.gz | tar xf - -\end{code} -will unpack the sources to the directory \url{omega}. The -subdirectories of \url{omega} are -\begin{files} - \item[bin] contains executable instances of O'Mega: \url{f90_SM.bin} - (\url{f90_SM.opt} if the sytem is supported by O'Caml's native - code compiler), \url{f90_QED.bin}, etc. - \item[doc] contains \LaTeX{} sources of user documentation. - \item[examples] contains currently no supported examples. - \item[lib] contains library support for targets (Fortran90/95 modules, etc.). - \item[src] contains the unabridged and uncensored sources of O'Mega, - including comments. - \item[tests] contains a battery of regression tests. Most tests - require Madgraph~\cite{MADGRAPH:1994}. - \item[web] contains the `woven' sources, i.\,e.~a pretty printed - version of the source including \LaTeX{} documentation. Weaving - the sources requires programs, \url{ocamlweb} and \url{noweb}. - A complete PostScript file is available from the same place as - the O'Mega sources. (It is not required for the end user to read this.) -\end{files} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\subsection{Prerequisites} -\subsubsection{Objective Caml (a.\,k.\,a.~O'Caml)} -You need version 3.07 or higher. You can get it -from~\ahrefurl{http://pauillac.inria.fr/ocaml/}. There are precompiled -binaries for some popular systems and complete sources. Building from -source is straightforward (just follow the instructions in the -file~\url{INSTALL} in the toplevel directory, the defaults are almost -always sufficient) and takes $\mathcal{O}(10)$ minutes on a modern -desktop system. If available for your system (cf.~the file -\url{README} in the toplevel directory), you should build the native -code compiler. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\subsubsection{GNU \texttt{make}} -This should be available for any system of practical importance and it -makes no sense to waste physicist's time on supporting all -incompatible flavors of \url{make} in existence. GNU \url{make} is -the default on Linux systems and is often available as \url{gmake} on -commercial Unices. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\subsubsection{Fortran90/95 Compiler} -Not required for compiling or running O'Mega, but Fortran90/95 is -currently the only fully supported target. - -O'Mega is known to be compiled correctly with recent versions of the -Intel Fortran compiler (preferably version~8.0 or later, versions -prior to 7.0 do -\emph{not work}), the Lahey/Fujitsu Fortran95 compiler and the NAG -Fortran95 compiler. The Intel compiler is available free of charge -for non-commercial purposes. [NB: Support for the `F' Fortran90/95 -subset compiler by Imagine1 and NAG has been dropped.] - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\subsection{Configuration} -Before the next step, O'Caml must have been installed. Configuration -is performed automatically by testing some system features with the -command -\begin{code} -$ ./configure -\end{code} -See -\begin{code} -$ ./configure --help -\end{code} -for additional options. NB: The use of the options -\url{--enable-gui} and \url{--enable-unsupported} is strongly -discouraged. The resulting programs require additional prerequisites -and even if you can get them to compile, the results are unpredictable -and we will not answer any questions about them. NB: \url{configure} -keeps it's state in \url{config.cache}. If you want to reconfigure -after adding new libraries to your system, you should remove -\url{config.cache} before running \url{configure}. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\subsection{Compilation} -The command -\begin{code} -$ make bin -\end{code} -will build the byte code executables. For each pairing of physics -model and target language, there will be one executable. -\begin{code} -$ make opt -\end{code} -will build the native code executables if the sytem is supported by -O'Caml's native code compiler and it is installed. The command -\begin{code} -$ make f95 -\end{code} -will build the Fortran90/95 library and requires, obviously, a -Fortran90/95 compiler. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\section{Running O'Mega} -\label{sec:running} -O'Mega is a simple application that takes parameters from the -commandline and writes results to the standard output -device\footnote{In the future, other targets than Fortran90/95 might -require more than one output file (e.\,g.~source files and header -files for \texttt{C}/\texttt{C++}). In this case the filenames will be -specified by commandline parameters.} -(diagnostics go to the standard error device). E.\,g., the UNIX -commandline -\begin{code} -$ ./bin/f90_SM.opt e+ e- e+ nue ubar d > cc20_amplitude.f95 -\end{code} -will cause O'Mega to write a Fortran95 module containing the Standard -Model tree level scattering amplitude for~$e^+e^-\to e^+\nu_e\bar{u}d$ -to the file \url{cc20_amplitude.f95}. Particles can be combined with -colons. E.\,g., -\begin{code} -$ ./bin/f90_SM.opt ubar:u:dbar:d ubar:u:dbar:d e+:mu+ e-:mu- > dy.f95 -\end{code} -will cause O'Mega to write a Fortran95 module containing the Standard -Model tree level parton scattering amplitudes for all Drell-Yan -processes to the file \url{dy.f95}.\par -A synopsis of the available options, in particular the particle names, -can be requested by giving an illegal option, e.\,g.: -\begin{code} -$ ./bin/f90_SM.opt -? -./bin/f90_SM.opt: unknown option `-?'. -usage: ./bin/f90_SM.opt [options] [e-|nue|u|d|e+|nuebar|ubar|dbar\ - |mu-|numu|c|s|mu+|numubar|cbar|sbar|tau-|nutau|t|b\ - |tau+|nutaubar|tbar|bbar|A|Z|W+|W-|g|H|phi+|phi-|phi0] - -target:function function name - -target:90 don't use Fortran95 features that are not in Fortran90 - -target:kind real and complex kind (default: default) - -target:width approx. line length - -target:module module name - -target:use use module - -target:whizard include WHIZARD interface - -model:constant_width use constant width (also in t-channel) - -model:fudged_width use fudge factor for charge particle width - -model:custom_width use custom width - -model:cancel_widths use vanishing width - -warning: check arguments and print warning on error - -error: check arguments and terminate on error - -warning:a check # of input arguments and print warning on error - -error:a check # of input arguments and terminate on error - -warning:h check input helicities and print warning on error - -error:h check input helicities and terminate on error - -warning:m check input momenta and print warning on error - -error:m check input momenta and terminate on error - -warning:g check internal Ward identities and print warning on error - -error:g check internal Ward identities and terminate on error - -forest ??? - -revision print revision control information - -quiet don't print a summary - -summary print only a summary - -params print the model parameters - -poles print the Monte Carlo poles - -dag print minimal DAG - -full_dag print complete DAG - -file read commands from file -\end{code} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\subsection{General Options} -\begin{options} - \item[-warning:] include code that checks the supplied arguments and - prints a warning in case of an error. - \item[-warning:a] check the number of input arguments (momenta and - spins) and print a warning in case of an error. - \item[-warning:h] check the values of the input helicities - and print a warning in case of an error. - \item[-warning:m] check the values of the input momenta - and print a warning in case of an error. - \item[-warning:g] check internal Ward identities - and print a warning in case of an error (not supported yet!). - \item[-error:] like \verb+-warning:+ but terminates on error. - \item[-error:a] like \verb+-warning:a+ but terminates on error. - \item[-error:h] like \verb+-warning:h+ but terminates on error. - \item[-error:m] like \verb+-warning:m+ but terminates on error. - \item[-error:g] like \verb+-warning:g+ but terminates on error. - %item[-forest] ??? - \item[-revision] print revision control information - \item[-quiet] don't print a summary - \item[-summary] print only a summary - \item[-params] print the model parameters - \item[-poles] print the Monte Carlo poles in a format understood by - the WHIZARD program~\cite{Kilian:WHIZARD}. - \item[-dag] print the reduced DAG in a format understood by the - \texttt{dot} program. - \item[-full\_dag] print the complete DAG in a format understood by the - \texttt{dot} program. - \item[-file] read commands from file -\end{options} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\subsection{Model Options} -\subsubsection{Standard Model} -\begin{options} - \item[-model:constant\_width] use constant width (also in $t$-channel) - \item[-model:fudged\_width] use fudge factor for charge particle width - \item[-model:custom\_width] use custom width - \item[-model:cancel\_widths] use vanishing width -\end{options} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\subsection{Target Options} -\subsubsection{Fortran90/95} -\begin{options} - \item[-target:function] function name - \item[-target:90] don't use Fortran95 features that are not in Fortran90 - \item[-target:kind] real and complex kind (default: \verb+default+) - \item[-target:width] approx. line length - \item[-target:module] module name - \item[-target:use] use module - \item[-target:whizard] include WHIZARD interface -\end{options} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\section{Using O'Mega's Output} -\label{sec:using} -The structure of the outputfile, the calling convention and the -required libraries depends on the target language, of course. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\subsection{Fortran90/95} -The Fortran95 module written by O'Mega has the following signature -\begin{code} -module omega_amplitude -\end{code} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\subsubsection{Libraries} -The imported Fortran modules are -\begin{files} - \item[omega\_kinds] defines \verb+default+, which can be whatever - the Fortran compiler supports. NB: the support libraries have not - yet been tuned to give reliable answers for amplitudes with gauge - cancellations in single precision. - \item[omega95] defines the vertices for Dirac spinors in the chiral - representation and vectors. - \item[omega95\_bispinors] is an alternative that defines the - vertices for Dirac and Majorana spinors in the chiral - representation and vectors using the Feynman rules - of~\cite{Denner/etal:Majorana}. - \item[omega\_parameters] defines the coupling constants -\end{files} -\begin{code} - use kinds - use omega95 - use omega_parameters - implicit none - private -\end{code} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\subsubsection{Summary of Exported Functions} -The functions and subroutines experted by the Fortran95 module are -\begin{itemize} - \item the scattering amplitude in different flavor bases (arrays of - PDG codes or internal numbering): -\begin{code} - public :: amplitude, amplitude_f, amplitude_1, amplitude_2 -\end{code} - \item square root of the inverse Bose/Fermi symmetry factor for - identical particles in the final state -\begin{code} - public :: symmetry -\end{code} - NB: the amplitude returned in \verb+amplitude+ is always divided - by the square root of the Bose/Fermi symmetry factor for identical - particles in the final state, as required for phase space - integration of the squared matrix element and differential cross - section. - \begin{equation} - \frac{1}{\sqrt{\prod_k n_k!}} A(i_1i_2\to f_1f_2\ldots) - \end{equation} - The \verb+symmetry+ function can be used to recover the ``true'' - scattering amplitude~$A$ for checking Ward identities, etc. -\begin{code} - pure function true_amplitude (k, s, f) result (a) - real(kind=default), dimension(0:,:), intent(in) :: k - integer, dimension(:), intent(in) :: s, f - complex(kind=default) :: a - a = symmetry (f) * amplitude (k, s, f) - end function true_amplitude -\end{code}% - It should never be required for differential cross sections. - \item the scattering amplitude with heuristics supressing vanishing - helicity combinations: -\begin{code} - public :: amplitude_nonzero, amplitude_f_nonzero, & - amplitude_1_nonzero, amplitude_2_nonzero -\end{code} - \item the squared scattering amplitude summed over helicity states -\begin{code} - public :: spin_sum_sqme, spin_sum_sqme_1, sum_sqme - public :: spin_sum_sqme_nonzero, spin_sum_sqme_1_nonzero, & - sum_sqme_nonzero -\end{code} - \item ``scattering'' a general density matrix -\begin{code} - public :: scatter, scatter_nonzero -\end{code} - \item ``scattering'' a diagonal density matrix -\begin{code} - public :: scatter_diagonal, scatter_diagonal_nonzero -\end{code} - \item inquiry and maintenance functions -\begin{code} - public :: allocate_zero - public :: multiplicities, multiplicities_in, multiplicities_out - public :: number_particles, & - number_particles_in, number_particles_out - public :: number_spin_states, & - number_spin_states_in, number_spin_states_out, & - spin_states, spin_states_in, spin_states_out - public :: number_flavor_states, & - number_flavor_states_in, number_flavor_states_out, & - flavor_states, flavor_states_in, flavor_states_out - public :: number_flavor_zeros, & - number_flavor_zeros_in, number_flavor_zeros_out, & - flavor_zeros, flavor_zeros_in, flavor_zeros_out - public :: create, reset, destroy -\end{code} -\end{itemize} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\subsubsection{Maintenance Functions} -They currently do nothing, but are here for -WHIZARD's~\cite{Kilian:WHIZARD} convenience -\begin{files} - \item[\texttt{create}] is called only once at the very beginning. - \item[\texttt{reset}] is called whenever parameters are changed. - \item[\texttt{destroy}] is called at most once at the very end. -\end{files} -\begin{code} - subroutine create () - end subroutine create - subroutine reset () - end subroutine reset - subroutine destroy () - end subroutine destroy -\end{code} -\aname{specific/allocate}{}% -Allocate an array of the size used by the heuristic that suppresses -vanishing helicity combinations -\begin{code} - interface allocate_zero - module procedure allocate_zero_1, allocate_zero_2 - end interface -\end{code} -for join numbering of in and out states -\begin{code} - subroutine allocate_zero_1 (zero) - integer, dimension(:,:), pointer :: zero - end subroutine allocate_zero_index -\end{code} -and for separate numbering of in and out states -\begin{code} - subroutine allocate_zero_2 (zero) - integer, dimension(:,:,:,:), pointer :: zero - end subroutine allocate_zero_index_inout -\end{code} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\subsubsection{Inquiry Functions} -\aname{specific/numbers/states}{}% -The total number of particles, the number of incoming particles and -the number of outgoing particles: -\begin{code} - pure function number_particles () result (n) - integer :: n - end function number_particles - pure function number_particles_in () result (n) - integer :: n - end function number_particles_in - pure function number_particles_out () result (n) - integer :: n - end function number_particles_out -\end{code} -The spin states of all particles that can give non-zero results and -their number. The tables are interpreted as -\begin{files} - \item[\texttt{s(1:,i)}] contains the helicities for each particle - for the \verb+i+th helicity combination. -\end{files} -\begin{code} - pure function number_spin_states () result (n) - integer :: n - end function number_spin_states - pure subroutine spin_states (s) - integer, dimension(:,:), intent(inout) :: s - end subroutine spin_states -\end{code} -The spin states of the incoming particles that can give non-zero -results and their number: -\begin{code} - pure function number_spin_states_in () result (n) - integer :: n - end function number_spin_states_in - pure subroutine spin_states_in (s) - integer, dimension(:,:), intent(inout) :: s - end subroutine spin_states_in -\end{code} -The spin states of the outgoing particles that can give non-zero -results and their number: -\begin{code} - pure function number_spin_states_out () result (n) - integer :: n - end function number_spin_states_out - pure subroutine spin_states_out (s) - integer, dimension(:,:), intent(inout) :: s - end subroutine spin_states_out -\end{code} -The flavor combinations of all particles that can give non-zero -results and their number. The tables are interpreted as -\begin{files} - \item[\texttt{f(1:,i)}] contains the PDG particle code for each - particle for the \verb+i+th helicity combination. -\end{files} -\begin{code} - pure function number_flavor_states () result (n) - integer :: n - end function number_flavor_states - pure subroutine flavor_states (f) - integer, dimension(:,:), intent(inout) :: f - end subroutine flavor_states -\end{code} -The flavor combinations of the incoming particles that can give -non-zero results and their number. -\begin{code} - pure function number_flavor_states_in () result (n) - integer :: n - end function number_flavor_states_in - pure subroutine flavor_states_in (f) - integer, dimension(:,:), intent(inout) :: f - end subroutine flavor_states_in -\end{code} -The flavor combinations of the outgoing particles that can give -non-zero results and their number. -\begin{code} - pure function number_flavor_states_out () result (n) - integer :: n - end function number_flavor_states_out - pure subroutine flavor_states_out (f) - integer, dimension(:,:), intent(inout) :: f - end subroutine flavor_states_out -\end{code} -The flavor combinations of all particles that always can give -a zero result and their number: -\begin{code} - pure function number_flavor_zeros () result (n) - integer :: n - end function number_flavor_zeros - pure subroutine flavor_zeros (f) - integer, dimension(:,:), intent(inout) :: f - end subroutine flavor_zeros -\end{code} -The flavor combinations of the incoming particles that always can give -a zero result and their number: -\begin{code} - pure function number_flavor_zeros_in () result (n) - integer :: n - end function number_flavor_zeros_in - pure subroutine flavor_zeros_in (f) - integer, dimension(:,:), intent(inout) :: f - end subroutine flavor_zeros_in -\end{code} -The flavor combinations of the outgoing particles that always can give -a zero result and their number: -\begin{code} - pure function number_flavor_zeros_out () result (n) - integer :: n - end function number_flavor_zeros_out - pure subroutine flavor_zeros_out (f) - integer, dimension(:,:), intent(inout) :: f - end subroutine flavor_zeros_out -\end{code} -\aname{specific/multiplicities}{}% -The same initial and final state can appear more than once in the -tensor product and we must avoid double counting. -\begin{code} - pure subroutine multiplicities (a) - integer, dimension(:), intent(inout) :: a - end subroutine multiplicities -\end{code} -\begin{code} - pure subroutine multiplicities_in (a) - integer, dimension(:), intent(inout) :: a - end subroutine multiplicities_in -\end{code} -\begin{code} - pure subroutine multiplicities_out (a) - integer, dimension(:), intent(inout) :: a - end subroutine multiplicities_out -\end{code} - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\subsubsection{Amplitude} -\aname{specific/amplitude}{}% -The function arguments of of the amplitude are -\begin{files} - \item[\texttt{k(0:3,1:)}] are the particle momenta: \verb+k(0:3,1)+ and - \verb+k(0:3,2)+ are the incoming momenta, \verb+k(0:3,3:)+ are the - outgoing momenta. \emph{All} momenta are the physical momenta, - i.\,e.~forward time-like or light-like. The signs of the incoming - momenta are flipped \emph{internally}. Unless asked by a commandline - parameter, O'Mega will not check the validity of the momenta. - \item[\texttt{s(1:)}] are the helicities in the same order as the - momenta. $s=\pm1$ signify $s=\pm1/2$ for fermions. $s=0$ makes no - sense for fermions and massless vector bosons - $s=4$ signifies an unphysical polarization for vector boson - that the users are \emph{not} supposed to use. Unless asked by a - commandline parameter, O'Mega will not check the validity of the - helicities. - \item[\texttt{f(1:)}] are the PDG particle codes in the same order as the - momenta. -\end{files} -\begin{code} - pure function amplitude (k, s, f) result (amp) - real(kind=default), dimension(0:,:), intent(in) :: k - integer, dimension(:), intent(in) :: s, f - complex(kind=default) :: amp - end function amplitude -\end{code} -Identical to \verb+amplitude (k, s, flavors(:,f))+, where -\verb+flavors+ has been filled by \verb+flavor_states+: -\begin{code} - pure function amplitude_f (k, s, f) result (amp) - real(kind=default), dimension(0:,:), intent(in) :: k - integer, dimension(:), intent(in) :: s - integer, intent(in) :: f - complex(kind=default) :: amp - end function amplitude_f -\end{code} -Identical to \verb+amplitude (k, spins(:,s), flavors(:,f))+, where -\verb+spins+ has been filled by \verb+spin_states+ and -\verb+flavors+ has been filled by \verb+flavor_states+: -\begin{code} - pure function amplitude_1 (k, s, f) result (amp) - real(kind=default), dimension(0:,:), intent(in) :: k - integer, intent(in) :: s, f - complex(kind=default) :: amp - end function amplitude_1 -\end{code} -Similar to \verb+amplitude_1+, but with separate incoming and -outgoing particles: -\begin{code} - pure function amplitude_2 & - (k, s_in, f_in, s_out, f_out) result (amp) - real(kind=default), dimension(0:,:), intent(in) :: k - integer, intent(in) :: s_in, f_in, s_out, f_out - complex(kind=default) :: amp - end function amplitude_2 -\end{code} -\aname{specific/amplitude/nonzero}{}% -The following are subroutines and not functions, since Fortran95 -restricts arguments of pure functions to \verb+intent(in)+, but we -need to update the counter for vanishing amplitudes. -\begin{files} - \item[\texttt{zero(1:,1:)}] an array containing the number of times - a combination of spin index and flavor index yielded a vanishing - amplitude. After a certain threshold, these combinations will be - skipped. \verb+allocate_zero+ will allocate the correct size. - \item[\texttt{n}] the current event count -\end{files} -\begin{code} - pure subroutine amplitude_nonzero (amp, k, s, f, zero, n) - complex(kind=default), intent(out) :: amp - real(kind=default), dimension(0:,:), intent(in) :: k - integer, dimension(:), intent(in) :: s, f - integer, dimension(:,:), intent(inout) :: zero - integer, intent(in) :: n - end subroutine amplitude_nonzero -\end{code} -\begin{code} - pure subroutine amplitude_1_nonzero (amp, k, s, f, zero, n) - complex(kind=default), intent(out) :: amp - real(kind=default), dimension(0:,:), intent(in) :: k - integer, intent(in) :: s, f - integer, dimension(:,:), intent(inout) :: zero - integer, intent(in) :: n - end subroutine amplitude_1_nonzero -\end{code} -\begin{code} - pure subroutine amplitude_f_nonzero & - (amp, k, s, f, zero, n) - complex(kind=default), intent(out) :: amp - real(kind=default), dimension(0:,:), intent(in) :: k - integer, dimension(:), intent(in) :: s - integer, intent(in) :: f - integer, dimension(:,:), intent(inout) :: zero - integer, intent(in) :: n - end subroutine amplitude_f_nonzero -\end{code} -\begin{files} - \item[\texttt{zero(1:,1:,1:,1:)}] an array containing the number of - times a combination of incoming and outgoing spin indices and - flavor indices yielded a vanishing amplitude. - \verb+allocate_zero+ will allocate the correct size. -\end{files} -\begin{code} - pure subroutine amplitude_2_nonzero & - (amp, k, s_in, f_in, s_out, f_out, zero, n) - complex(kind=default), intent(out) :: amp - real(kind=default), dimension(0:,:), intent(in) :: k - integer, intent(in) :: s_in, f_in, s_out, f_out - integer, dimension(:,:,:,:), intent(inout) :: zero - integer, intent(in) :: n - end subroutine amplitude_2_nonzero -\end{code} -\aname{specific/symmetry}{}% -\begin{code} - pure function symmetry (f) result (s) - real(kind=default) :: s - integer, dimension(:), intent(in) :: f - end function symmetry -\end{code} - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\subsubsection{Summation} -\aname{specific/sum}{}% -The the sums of squared matrix elements, the optional mask \url{smask} -can be used to sum only a subset of helicities or flavors. -\begin{code} - pure function spin_sum_sqme (k, f, smask) result (amp2) - real(kind=default), dimension(0:,:), intent(in) :: k - integer, dimension(:), intent(in) :: f - logical, dimension(:), intent(in), optional :: smask - real(kind=default) :: amp2 - end function spin_sum_sqme -\end{code} -\begin{code} - pure function spin_sum_sqme_1 (k, f, smask) result (amp2) - real(kind=default), dimension(0:,:), intent(in) :: k - integer, intent(in) :: f - logical, dimension(:), intent(in), optional :: smask - real(kind=default) :: amp2 - end function spin_sum_sqme_1 -\end{code} -\begin{code} - pure function sum_sqme (k, smask, fmask) result (amp2) - real(kind=default), dimension(0:,:), intent(in) :: k - logical, dimension(:), intent(in), optional :: smask, fmask - real(kind=default) :: amp2 - end function sum_sqme -\end{code} -\aname{specific/sum/nonzero}{}% -\begin{code} - pure subroutine spin_sum_sqme_nonzero (amp2, k, f, zero, n, smask) - real(kind=default), intent(out) :: amp2 - real(kind=default), dimension(0:,:), intent(in) :: k - integer, dimension(:), intent(in) :: f - integer, dimension(:,:), intent(inout) :: zero - integer, intent(in) :: n - logical, dimension(:), intent(in), optional :: smask - end subroutine spin_sum_sqme_nonzero -\end{code} -\begin{code} - pure subroutine spin_sum_sqme_1_nonzero (amp2, k, f, zero, n, smask) - real(kind=default), intent(out) :: amp2 - real(kind=default), dimension(0:,:), intent(in) :: k - integer, intent(in) :: f - integer, dimension(:,:), intent(inout) :: zero - integer, intent(in) :: n - logical, dimension(:), intent(in), optional :: smask - end subroutine spin_sum_sqme_1_nonzero -\end{code} -\begin{code} - pure subroutine sum_sqme_nonzero (amp2, k, zero, n, smask, fmask) - real(kind=default), intent(out) :: amp2 - real(kind=default), dimension(0:,:), intent(in) :: k - integer, dimension(:,:), intent(inout) :: zero - integer, intent(in) :: n - logical, dimension(:), intent(in), optional :: smask, fmask - end subroutine sum_sqme_masked_nonzero -\end{code} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\subsubsection{Density Matrix Transforms} -\aname{specific/scatter}{}% -There are also utility functions that implement the transformation of -density matrices directly -\begin{equation} - \rho \to \rho' = T \rho T^{\dagger} -\end{equation} -i.\,e. -\begin{equation} - \rho'_{ff'} = \sum_{ii'} T_{fi} \rho_{ii'} T^{*}_{f'i'} -\end{equation} -and avoid double counting -\begin{code} - pure subroutine scatter_correlated (k, rho_in, rho_out) - real(kind=default), dimension(0:,:), intent(in) :: k - complex(kind=default), dimension(:,:,:,:), & - intent(in) :: rho_in - complex(kind=default), dimension(:,:,:,:), & - intent(inout) :: rho_out - end subroutine scatter_correlated -\end{code} -\begin{code} - pure subroutine scatter_correlated_nonzero & - (k, rho_in, rho_out, zero, n) - real(kind=default), dimension(0:,:), intent(in) :: k - complex(kind=default), dimension(:,:,:,:), & - intent(in) :: rho_in - complex(kind=default), dimension(:,:,:,:), & - intent(inout) :: rho_out - integer, dimension(:,:,:,:), intent(inout) :: zero - integer, intent(in) :: n - end subroutine scatter_correlated_nonzero -\end{code} -In no off-diagonal density matrix elements of the initial state are -known, the computation can be performed more efficiently: -\begin{equation} - \rho'_{f} = \sum_i T_{fi} \rho_{i} T^{*}_{fi} - = \sum_i |T_{fi}|^2 \rho_{i} -\end{equation} -\begin{code} - pure subroutine scatter_diagonal (k, rho_in, rho_out) - real(kind=default), dimension(0:,:), intent(in) :: k - real(kind=default), dimension(:,:), intent(in) :: rho_in - real(kind=default), dimension(:,:), intent(inout) :: rho_out - end subroutine scatter_diagonal -\end{code} -\begin{code} - pure subroutine scatter_diagonal_nonzero & - (k, rho_in, rho_out, zero, n) - real(kind=default), dimension(0:,:), intent(in) :: k - real(kind=default), dimension(:,:), intent(in) :: rho_in - real(kind=default), dimension(:,:), intent(inout) :: rho_out - integer, dimension(:,:,:,:), intent(inout) :: zero - integer, intent(in) :: n - end subroutine scatter_diagonal_nonzero -\end{code} -Finis. -\begin{code} -end module omega_amplitude -\end{code} -NB: the name of the module can be changed by a -commandline parameter and Fortran95 features like \verb+pure+ can be -disabled as well. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\subsection{FORTRAN77} -The preparation of a FORTRAN77 target is straightforward, but tedious -and will only be considered if there is sufficient demand and support. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\subsection{HELAS} -This target for the HELAS library~\cite{HELAS} is incomplete and no -longer maintained. It was used as an early benchmark for the -Fortran90/95 library. No vector boson selfcouplings are supported. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\subsection{\texttt{C}, \texttt{C++} \&\ Java} -These targets does not exist yet and we solicit suggestions from -\texttt{C++} and Java experts on useful calling conventions and -suppport libraries that blend well with the HEP environments based on -these languages. At least one of the authors believes that Java would -be a better choice, but the political momentum behind \texttt{C++} -might cause an early support for \texttt{C++} anyway. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\section{Extending O'Mega} -\label{sec:extensions} -\subsection{Adding A New Physics Model} -Currently, this still requires to write O'Caml code. This is not as -hard as it might sound, because an inspection of \url{bin/models.ml} -shows that all that is required are some tables of Feynman rules that -can easily be written by copying and modifyng an existing example, -after consulting with \url{src/couplings.mli} or the corresponding -chapter in the woven source. -In fact, having the full power of O'Caml at one's disposal is -very helpful for avoiding needless repetition. - -Nevertheless, in the near future, there will be some special models -that can read model specifications from external files. The first one -of its kind will read CompHEP~\cite{CompHEP} model files. Later there -will be a native O'Mega model file format, but it will probably go -through some iterations. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\subsection{Adding A New Target Language} -This will always require to write O'Caml code, which is again not too -hard. In addition a library for vertices will be required, unless the -target performs complete inlining. NB: an early experiment with -inlining Fortran proved to be an almost complete failure on Linux/Intel PCs. -The inlined code was huge, absolutely unreadable and only marginally -faster. The bulk of the computational cost is always in the vertex -evaluations and function calls create in comparison negligible costs. -This observation is system dependent, of course, and inlining -might be beneficial for other architectures with better floating point -performance, after all. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%BEGIN IMAGE -\end{empfile} -\end{fmffile} -%END IMAGE -\end{document} -\endinput -Local Variables: -mode:latex -indent-tabs-mode:nil -page-delimiter:"^%%%%%.*\n" -End: - Index: branches/ohl/omega-development/completed/whizard2/doc/Makefile.in =================================================================== --- branches/ohl/omega-development/completed/whizard2/doc/Makefile.in (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/doc/Makefile.in (revision 8703) @@ -1,119 +0,0 @@ -# $Id$ -# -# Copyright (C) 1999-2009 by -# -# Wolfgang Kilian -# Thorsten Ohl -# Juergen Reuter -# -# WHIZARD is free software; you can redistribute it and/or modify it -# under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2, or (at your option) -# any later version. -# -# WHIZARD is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -# -######################################################################## - -prefix = @prefix@ -srcdir = @srcdir@ -top_srcdir = @top_srcdir@ - -srcdir_web = $(top_srcdir)/web - -LATEX = @LATEX@ -PDFLATEX = @PDFLATEX@ -HEVEA = @HEVEA@ -IMAGEN = @IMAGEN@ -HACHA = @HACHA@ -METAPOST = @METAPOST@ -DVIPS = @DVIPS@ -GHOSTVIEW = @GHOSTVIEW@ -ACROREAD = @ACROREAD@ -EPSTOPDF = @EPSTOPDF@ -LN_S = @LN_S@ -GZIP = @GZIP@ - -HEVEAOPTS = -exec xxdate.exe article.hva fancysection.hva mathaccents.hva -CUSTOM_HEVEA = custom.hva -HACHAOPTS = -tocbis - -######################################################################## - -all: - @echo make "[ps|psv]" - -ps: preview.ps -psv: preview.psv -pdf: preview.pdf -pdfv: preview.pdfv - -www: index.html - -######################################################################## - -%.psv: %.ps - nohup sh -c '$(GHOSTVIEW) --media=a4 --orientation=portrait $< &' 2>/dev/null 1>/dev/null - -%.pdfv: %.pdf - nohup sh -c '$(ACROREAD) $< &' 2>/dev/null 1>/dev/null - -%.ps: %.dvi - $(DVIPS) -t a4 -o $@ $< - -%.ps.gz: %.ps - $(GZIP) -9 < $< > $@ - -preview.dvi: preview.tex modules.eps - -$(LATEX) $< - TEX=$(LATEX) $(METAPOST) $*.mp - $(METAPOST) $*pics.mp - TEX=latex $(METAPOST) $*.mp - $(LATEX) $< - if grep -s 'Rerun to get cross-references right.' $*.log; then \ - $(LATEX) $<; \ - fi - - -%.pdf: %.eps - $(EPSTOPDF) $< - -preview.pdf: preview.tex modules.pdf el_te_ph.pdf - -$(PDFLATEX) $< - TEX=$(LATEX) $(METAPOST) $(@:.pdf=.mp) - $(METAPOST) $(@:.pdf=pics.mp) - $(PDFLATEX) $< - if grep -s 'Rerun to get cross-references right.' $(@:.pdf=.mp); then \ - $(PDFLATEX) $<; \ - fi - -index.html: preview.html - $(HACHA) $(HACHAOPTS) -o $@ $< - -%.html: %.tex - $(HEVEA) $(HEVEAOPTS) $(CUSTOM_HEVEA) $< - $(IMAGEN) $* - $(METAPOST) $*pics.mp - TEX=latex $(METAPOST) $*.image.mp - $(HEVEA) -fix $(HEVEAOPTS) $(CUSTOM_HEVEA) $< - -preview.html: $(CUSTOM_HEVEA) - -modules.eps: - $(MAKE) $(MFLAGS) -C $(srcdir_web) $@ - $(LN_S) $(srcdir_web)/modules.eps $@ - -clean: - rm -f *~ *.log *.mpx *.mp previewpics.* - -realclean: clean - rm -f *.dvi *.pdf *.aux *.out *.toc *.idx *.ps *.haux *.image.* *.gif *.html - -######################################################################## Index: branches/ohl/omega-development/completed/whizard2/lib/Makefile.in =================================================================== --- branches/ohl/omega-development/completed/whizard2/lib/Makefile.in (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/lib/Makefile.in (revision 8703) @@ -1,32 +0,0 @@ -# $Id$ -# -# Copyright (C) 1999-2009 by -# -# Wolfgang Kilian -# Thorsten Ohl -# Juergen Reuter -# -# WHIZARD is free software; you can redistribute it and/or modify it -# under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2, or (at your option) -# any later version. -# -# WHIZARD is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -# -######################################################################## - -prefix = @prefix@ -srcdir = @srcdir@ -top_srcdir = @top_srcdir@ - -clean: - rm -f *~ *.mod *.a *.d *.pc *.pcl - -realclean: clean Index: branches/ohl/omega-development/completed/whizard2/INSTALL =================================================================== --- branches/ohl/omega-development/completed/whizard2/INSTALL (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/INSTALL (revision 8703) @@ -1,38 +0,0 @@ -Installation: -************* - - 0) Get Objective Caml 3.04 (or higher) from - - http://caml.inria.fr/ocaml/ - - and install it. Bootstrapping the Objective Caml - compiler is straightforward and takes a few minutes - on a reasonably fast machine. It is not required - for O'Mega to install the native code compiler, the - byte code compiler and interpreter suffice. On supported - machines, however, the installation of the native compiler - is straightforward as well an speeds up O'Mega significantly - for very complicated processes. - - 1) run `./configure' (the options --enable-gui and - --enable-all-programs are currently not really useful - and are wasting disk space, respectively) - - 2) run `make bin' - - 2a) optionally run `make opt' if you have the O'Caml native - code compiler `ocamlopt' installed. - - 3) run `make f95' - - 4) try it: - - ./bin/f90_SM.bin -scatter "e+ e- -> e+ nue d ubar" - ./bin/f90_SM.opt -scatter "e+ e- -> e+ nue d ubar" - - - -$Id: INSTALL,v 1.7 2004/12/02 13:46:54 ohl Exp $ -Local Variables: -mode:indented-text -End: Index: branches/ohl/omega-development/completed/whizard2/bin/Makefile.in =================================================================== --- branches/ohl/omega-development/completed/whizard2/bin/Makefile.in (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/bin/Makefile.in (revision 8703) @@ -1,35 +0,0 @@ -# $Id$ -# -# Copyright (C) 1999-2009 by -# -# Wolfgang Kilian -# Thorsten Ohl -# Juergen Reuter -# -# WHIZARD is free software; you can redistribute it and/or modify it -# under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2, or (at your option) -# any later version. -# -# WHIZARD is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -# -######################################################################## - -prefix = @prefix@ -srcdir = @srcdir@ -top_srcdir = @top_srcdir@ - -SELECT_PROGRAMS_GUI = @SELECT_PROGRAMS_GUI@ -SELECT_PROGRAMS_RELEASED = @SELECT_PROGRAMS_RELEASED@ - -clean: - rm -f *~ *.bin *.opt *.top test_omega95 - -realclean: clean Index: branches/ohl/omega-development/completed/whizard2/COPYING =================================================================== --- branches/ohl/omega-development/completed/whizard2/COPYING (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/COPYING (revision 8703) @@ -1,340 +0,0 @@ - GNU GENERAL PUBLIC LICENSE - Version 2, June 1991 - - Copyright (C) 1989, 1991 Free Software Foundation, Inc. - 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - Everyone is permitted to copy and distribute verbatim copies - of this license document, but changing it is not allowed. - - Preamble - - The licenses for most software are designed to take away your -freedom to share and change it. By contrast, the GNU General Public -License is intended to guarantee your freedom to share and change free -software--to make sure the software is free for all its users. This -General Public License applies to most of the Free Software -Foundation's software and to any other program whose authors commit to -using it. (Some other Free Software Foundation software is covered by -the GNU Library General Public License instead.) You can apply it to -your programs, too. - - When we speak of free software, we are referring to freedom, not -price. Our General Public Licenses are designed to make sure that you -have the freedom to distribute copies of free software (and charge for -this service if you wish), that you receive source code or can get it -if you want it, that you can change the software or use pieces of it -in new free programs; and that you know you can do these things. - - To protect your rights, we need to make restrictions that forbid -anyone to deny you these rights or to ask you to surrender the rights. -These restrictions translate to certain responsibilities for you if you -distribute copies of the software, or if you modify it. - - For example, if you distribute copies of such a program, whether -gratis or for a fee, you must give the recipients all the rights that -you have. You must make sure that they, too, receive or can get the -source code. And you must show them these terms so they know their -rights. - - We protect your rights with two steps: (1) copyright the software, and -(2) offer you this license which gives you legal permission to copy, -distribute and/or modify the software. - - Also, for each author's protection and ours, we want to make certain -that everyone understands that there is no warranty for this free -software. If the software is modified by someone else and passed on, we -want its recipients to know that what they have is not the original, so -that any problems introduced by others will not reflect on the original -authors' reputations. - - Finally, any free program is threatened constantly by software -patents. We wish to avoid the danger that redistributors of a free -program will individually obtain patent licenses, in effect making the -program proprietary. To prevent this, we have made it clear that any -patent must be licensed for everyone's free use or not licensed at all. - - The precise terms and conditions for copying, distribution and -modification follow. - - GNU GENERAL PUBLIC LICENSE - TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION - - 0. This License applies to any program or other work which contains -a notice placed by the copyright holder saying it may be distributed -under the terms of this General Public License. The "Program", below, -refers to any such program or work, and a "work based on the Program" -means either the Program or any derivative work under copyright law: -that is to say, a work containing the Program or a portion of it, -either verbatim or with modifications and/or translated into another -language. (Hereinafter, translation is included without limitation in -the term "modification".) Each licensee is addressed as "you". - -Activities other than copying, distribution and modification are not -covered by this License; they are outside its scope. The act of -running the Program is not restricted, and the output from the Program -is covered only if its contents constitute a work based on the -Program (independent of having been made by running the Program). -Whether that is true depends on what the Program does. - - 1. You may copy and distribute verbatim copies of the Program's -source code as you receive it, in any medium, provided that you -conspicuously and appropriately publish on each copy an appropriate -copyright notice and disclaimer of warranty; keep intact all the -notices that refer to this License and to the absence of any warranty; -and give any other recipients of the Program a copy of this License -along with the Program. - -You may charge a fee for the physical act of transferring a copy, and -you may at your option offer warranty protection in exchange for a fee. - - 2. You may modify your copy or copies of the Program or any portion -of it, thus forming a work based on the Program, and copy and -distribute such modifications or work under the terms of Section 1 -above, provided that you also meet all of these conditions: - - a) You must cause the modified files to carry prominent notices - stating that you changed the files and the date of any change. - - b) You must cause any work that you distribute or publish, that in - whole or in part contains or is derived from the Program or any - part thereof, to be licensed as a whole at no charge to all third - parties under the terms of this License. - - c) If the modified program normally reads commands interactively - when run, you must cause it, when started running for such - interactive use in the most ordinary way, to print or display an - announcement including an appropriate copyright notice and a - notice that there is no warranty (or else, saying that you provide - a warranty) and that users may redistribute the program under - these conditions, and telling the user how to view a copy of this - License. (Exception: if the Program itself is interactive but - does not normally print such an announcement, your work based on - the Program is not required to print an announcement.) - -These requirements apply to the modified work as a whole. If -identifiable sections of that work are not derived from the Program, -and can be reasonably considered independent and separate works in -themselves, then this License, and its terms, do not apply to those -sections when you distribute them as separate works. But when you -distribute the same sections as part of a whole which is a work based -on the Program, the distribution of the whole must be on the terms of -this License, whose permissions for other licensees extend to the -entire whole, and thus to each and every part regardless of who wrote it. - -Thus, it is not the intent of this section to claim rights or contest -your rights to work written entirely by you; rather, the intent is to -exercise the right to control the distribution of derivative or -collective works based on the Program. - -In addition, mere aggregation of another work not based on the Program -with the Program (or with a work based on the Program) on a volume of -a storage or distribution medium does not bring the other work under -the scope of this License. - - 3. You may copy and distribute the Program (or a work based on it, -under Section 2) in object code or executable form under the terms of -Sections 1 and 2 above provided that you also do one of the following: - - a) Accompany it with the complete corresponding machine-readable - source code, which must be distributed under the terms of Sections - 1 and 2 above on a medium customarily used for software interchange; or, - - b) Accompany it with a written offer, valid for at least three - years, to give any third party, for a charge no more than your - cost of physically performing source distribution, a complete - machine-readable copy of the corresponding source code, to be - distributed under the terms of Sections 1 and 2 above on a medium - customarily used for software interchange; or, - - c) Accompany it with the information you received as to the offer - to distribute corresponding source code. (This alternative is - allowed only for noncommercial distribution and only if you - received the program in object code or executable form with such - an offer, in accord with Subsection b above.) - -The source code for a work means the preferred form of the work for -making modifications to it. For an executable work, complete source -code means all the source code for all modules it contains, plus any -associated interface definition files, plus the scripts used to -control compilation and installation of the executable. However, as a -special exception, the source code distributed need not include -anything that is normally distributed (in either source or binary -form) with the major components (compiler, kernel, and so on) of the -operating system on which the executable runs, unless that component -itself accompanies the executable. - -If distribution of executable or object code is made by offering -access to copy from a designated place, then offering equivalent -access to copy the source code from the same place counts as -distribution of the source code, even though third parties are not -compelled to copy the source along with the object code. - - 4. You may not copy, modify, sublicense, or distribute the Program -except as expressly provided under this License. Any attempt -otherwise to copy, modify, sublicense or distribute the Program is -void, and will automatically terminate your rights under this License. -However, parties who have received copies, or rights, from you under -this License will not have their licenses terminated so long as such -parties remain in full compliance. - - 5. You are not required to accept this License, since you have not -signed it. However, nothing else grants you permission to modify or -distribute the Program or its derivative works. These actions are -prohibited by law if you do not accept this License. Therefore, by -modifying or distributing the Program (or any work based on the -Program), you indicate your acceptance of this License to do so, and -all its terms and conditions for copying, distributing or modifying -the Program or works based on it. - - 6. Each time you redistribute the Program (or any work based on the -Program), the recipient automatically receives a license from the -original licensor to copy, distribute or modify the Program subject to -these terms and conditions. You may not impose any further -restrictions on the recipients' exercise of the rights granted herein. -You are not responsible for enforcing compliance by third parties to -this License. - - 7. If, as a consequence of a court judgment or allegation of patent -infringement or for any other reason (not limited to patent issues), -conditions are imposed on you (whether by court order, agreement or -otherwise) that contradict the conditions of this License, they do not -excuse you from the conditions of this License. If you cannot -distribute so as to satisfy simultaneously your obligations under this -License and any other pertinent obligations, then as a consequence you -may not distribute the Program at all. For example, if a patent -license would not permit royalty-free redistribution of the Program by -all those who receive copies directly or indirectly through you, then -the only way you could satisfy both it and this License would be to -refrain entirely from distribution of the Program. - -If any portion of this section is held invalid or unenforceable under -any particular circumstance, the balance of the section is intended to -apply and the section as a whole is intended to apply in other -circumstances. - -It is not the purpose of this section to induce you to infringe any -patents or other property right claims or to contest validity of any -such claims; this section has the sole purpose of protecting the -integrity of the free software distribution system, which is -implemented by public license practices. Many people have made -generous contributions to the wide range of software distributed -through that system in reliance on consistent application of that -system; it is up to the author/donor to decide if he or she is willing -to distribute software through any other system and a licensee cannot -impose that choice. - -This section is intended to make thoroughly clear what is believed to -be a consequence of the rest of this License. - - 8. If the distribution and/or use of the Program is restricted in -certain countries either by patents or by copyrighted interfaces, the -original copyright holder who places the Program under this License -may add an explicit geographical distribution limitation excluding -those countries, so that distribution is permitted only in or among -countries not thus excluded. In such case, this License incorporates -the limitation as if written in the body of this License. - - 9. The Free Software Foundation may publish revised and/or new versions -of the 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 Program -specifies a version number of this License which applies to it and "any -later version", you have the option of following the terms and conditions -either of that version or of any later version published by the Free -Software Foundation. If the Program does not specify a version number of -this License, you may choose any version ever published by the Free Software -Foundation. - - 10. If you wish to incorporate parts of the Program into other free -programs whose distribution conditions are different, write to the author -to ask for permission. For software which is copyrighted by the Free -Software Foundation, write to the Free Software Foundation; we sometimes -make exceptions for this. Our decision will be guided by the two goals -of preserving the free status of all derivatives of our free software and -of promoting the sharing and reuse of software generally. - - NO WARRANTY - - 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY -FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN -OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES -PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED -OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF -MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS -TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE -PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, -REPAIR OR CORRECTION. - - 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING -WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR -REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, -INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING -OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED -TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY -YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER -PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE -POSSIBILITY OF SUCH DAMAGES. - - END OF TERMS AND CONDITIONS - - How to Apply These Terms to Your New Programs - - If you develop a new program, and you want it to be of the greatest -possible use to the public, the best way to achieve this is to make it -free software which everyone can redistribute and change under these terms. - - To do so, attach the following notices to the program. It is safest -to attach them to the start of each source file to most effectively -convey the exclusion of warranty; and each file should have at least -the "copyright" line and a pointer to where the full notice is found. - - - Copyright (C) - - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - - -Also add information on how to contact you by electronic and paper mail. - -If the program is interactive, make it output a short notice like this -when it starts in an interactive mode: - - Gnomovision version 69, Copyright (C) year name of author - Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. - This is free software, and you are welcome to redistribute it - under certain conditions; type `show c' for details. - -The hypothetical commands `show w' and `show c' should show the appropriate -parts of the General Public License. Of course, the commands you use may -be called something other than `show w' and `show c'; they could even be -mouse-clicks or menu items--whatever suits your program. - -You should also get your employer (if you work as a programmer) or your -school, if any, to sign a "copyright disclaimer" for the program, if -necessary. Here is a sample; alter the names: - - Yoyodyne, Inc., hereby disclaims all copyright interest in the program - `Gnomovision' (which makes passes at compilers) written by James Hacker. - - , 1 April 1989 - Ty Coon, President of Vice - -This General Public License does not permit incorporating your program into -proprietary programs. If your program is a subroutine library, you may -consider it more useful to permit linking proprietary applications with the -library. If this is what you want to do, use the GNU Library General -Public License instead of this License. Index: branches/ohl/omega-development/completed/whizard2/NEWS =================================================================== --- branches/ohl/omega-development/completed/whizard2/NEWS (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/NEWS (revision 8703) @@ -1,5 +0,0 @@ - -$Id: NEWS,v 1.1 2001/03/05 11:34:10 ohl Exp $ -Local Variables: -mode:indented-text -End: Index: branches/ohl/omega-development/completed/whizard2/aclocal.m4 =================================================================== --- branches/ohl/omega-development/completed/whizard2/aclocal.m4 (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/aclocal.m4 (revision 8703) @@ -1,465 +0,0 @@ -dnl $Id: aclocal.m4,v 1.29.14.1 2005/11/06 21:14:35 ohl Exp $ -dnl -------------------------------------------------------------------- -dnl -dnl THO_FILENAME_CASE_CONVERSION -dnl -dnl Define two variables LOWERCASE and UPPERCASE for /bin/sh filters -dnl that convert strings to lower and upper case, respectively -dnl -AC_DEFUN([THO_FILENAME_CASE_CONVERSION], -[AC_SUBST([LOWERCASE]) -AC_SUBST([UPPERCASE]) -AC_PATH_PROGS(TR,tr) -AC_PATH_PROGS(SED,sed) -AC_MSG_CHECKING([for case conversion]) -if test -n "$TR"; then - LOWERCASE="$TR A-Z a-z" - UPPERCASE="$TR a-z A-Z" - THO_FILENAME_CASE_CONVERSION_TEST -fi -if test -n "$UPPERCASE" && test -n "$LOWERCASE"; then - AC_MSG_RESULT([$TR works]) -else - LOWERCASE="$SED y/ABCDEFGHIJKLMNOPQRSTUVWXYZ/abcdefghijklmnopqrstuvwxyz/" - UPPERCASE="$SED y/abcdefghijklmnopqrstuvwxyz/ABCDEFGHIJKLMNOPQRSTUVWXYZ/" - THO_FILENAME_CASE_CONVERSION_TEST - if test -n "$UPPERCASE" && test -n "$LOWERCASE"; then - AC_MSG_RESULT([$SED works]) - fi -fi]) -dnl -AC_DEFUN([THO_FILENAME_CASE_CONVERSION_TEST], -[if test "`echo fOo | $LOWERCASE`" != "foo"; then - LOWERCASE="" -fi -if test "`echo fOo | $UPPERCASE`" != "FOO"; then - UPPERCASE="" -fi]) -dnl -dnl -------------------------------------------------------------------- -dnl -dnl THO_LIB_LAPACK -dnl -AC_DEFUN([THO_LIB_LAPACK], -[AC_SUBST([HAVE_LIBLAPACK]) -AC_SUBST([LIBLAPACK]) -AC_CHECK_LIB([lapack], [dsyev_], - [HAVE_LIBLAPACK=yes - LIBLAPACK="-llapack -lblas $FLIBS"], - [], - [-lblas $FLIBS]) -if test X$HAVE_LIBLAPACK != Xyes; then - AC_CHECK_LIB([cxml], [dsyev_], - [HAVE_LIBLAPACK=yes - LIBLAPACK="-lcxml $FLIBS"], - [], - [$FLIBS]) -fi -]) -dnl -dnl -------------------------------------------------------------------- -dnl -dnl THO_PROG_F -dnl THO_PROG_FC -dnl -dnl These allow to set F and F95 to overwrite the defaults -dnl (assuming that the names contain no spaces!) -dnl -AC_DEFUN([THO_PROG_F],[AC_PATH_PROGS(F,$F F)]) -AC_DEFUN([THO_PROG_FC],[AC_PATH_PROGS(FC,$FC $F95 $F90 lf95 f95 f90 ifort ifc fort)]) -dnl -dnl -------------------------------------------------------------------- -dnl -dnl THO_FORTRAN_VENDOR(VARIABLE, COMPILER) -dnl -AC_DEFUN([THO_FORTRAN_VENDOR], -[AC_SUBST([$1]) -if test -n "$2"; then - $1=unknown - AC_MSG_CHECKING([vendor of '$2']) - $2 -V >conftest.out 2>&1 - if grep -q 'NAGWare' conftest.out; then - $1=NAG - elif grep -q 'Intel(R)' conftest.out; then - $1=Intel - if grep -q 'Version 10\.' conftest.out; then - FC_IFC_VERSION=10 - elif grep -q 'Version 9\.' conftest.out; then - FC_IFC_VERSION=9 - elif grep -q 'Version 8\.' conftest.out; then - FC_IFC_VERSION=8 - elif grep -q 'Version 7\.1' conftest.out; then - FC_IFC_VERSION=7 - FC_IFC_MINOR_VERSION=1 - elif grep -q 'Version 7\.0' conftest.out; then - FC_IFC_VERSION=7 - FC_IFC_MINOR_VERSION=0 - elif grep -q 'Version 7\.' conftest.out; then - FC_IFC_VERSION=7 - elif grep -q 'Version 6\.' conftest.out; then - FC_IFC_VERSION=6 - elif grep -q 'Version 5\.' conftest.out; then - FC_IFC_VERSION=5 - else - AC_MSG_WARN([version of Intel Fortran compiler not recognized, dnl -continuing at your own peril ...]) - FC_IFC_VERSION=0 - fi - else - $2 -version >conftest.out 2>&1 - if grep -q 'Compaq' conftest.out; then - $1=Compaq - else - $2 --version >conftest.out 2>&1 - if grep -q 'Lahey' conftest.out; then - $1=Lahey - else - $1=UNKNOWN - fi - fi - fi - AC_MSG_RESULT([[$]$1]) - rm -f conftest.out -fi]) -dnl -dnl -------------------------------------------------------------------- -dnl -dnl THO_FORTRAN_TEST_EXTENSION(VARIABLE, COMPILER, EXTENSION) -dnl -AC_DEFUN([THO_FORTRAN_TEST_EXTENSION], -[AC_SUBST([$1]) -if test -n "$2"; then - THO_COMPILE_FORTRAN90([$1], [$2], [$3], [], [$3], []) -fi]) -dnl -dnl -------------------------------------------------------------------- -dnl -dnl THO_FORTRAN_FIND_EXTENSION(VARIABLE, COMPILER, EXTENSIONS) -dnl -AC_DEFUN([THO_FORTRAN_FIND_EXTENSION], -[AC_SUBST([$1]) -for ext in $3; do - AC_MSG_CHECKING([whether '$2' accepts .$ext]) - THO_FORTRAN_TEST_EXTENSION([$1], [$2], [$ext]) - if test -n "[$]$1"; then - AC_MSG_RESULT([yes]) - break - else - AC_MSG_RESULT([no]) - fi -done]) -dnl -dnl -------------------------------------------------------------------- -dnl -dnl THO_FORTRAN_TEST_OPTION(VARIABLE, COMPILER, EXTENSION, OPTION) -dnl -dnl Test whether the COMPILER accepts the OPTION (using EXTENSION -dnl for the test source). If so, the VARIABLE will be set to OPTION. -dnl -AC_DEFUN([THO_FORTRAN_TEST_OPTION], -[if test -n "$2"; then - THO_COMPILE_FORTRAN90([$1], [$2 $4], [$3], [], [$4], []) -fi]) -dnl -dnl -------------------------------------------------------------------- -dnl -dnl THO_FORTRAN_FIND_OPTION(VARIABLE, COMPILER, EXTENSION, OPTIONS) -dnl -dnl Append the first accepted option from OPTIONS to VARIABLE. -dnl -AC_DEFUN([THO_FORTRAN_FIND_OPTION], -[AC_SUBST([$1]) -for option in $4; do - AC_MSG_CHECKING([whether '$2' accepts $option]) - THO_FORTRAN_TEST_OPTION([tmp_$1], [$2], [$3], [$option]) - if test -n "[$]tmp_$1"; then - $1="[$]$1 [$]tmp_$1" - AC_MSG_RESULT([yes]) - break - else - AC_MSG_RESULT([no]) - fi -done]) -dnl -dnl -------------------------------------------------------------------- -dnl -dnl THO_FORTRAN_FILTER_OPTIONS(VARIABLE, COMPILER, EXTENSION, OPTIONS) -dnl -dnl Append all accepted options from OPTIONS to VARIABLE. -dnl -AC_DEFUN([THO_FORTRAN_FILTER_OPTIONS], -[AC_SUBST([$1]) -for option in $4; do - AC_MSG_CHECKING([whether '$2' accepts $option]) - THO_FORTRAN_TEST_OPTION([tmp_$1], [$2], [$3], [$option]) - if test -n "[$]tmp_$1"; then - $1="[$]$1 [$]tmp_$1" - AC_MSG_RESULT([yes]) - else - AC_MSG_RESULT([no]) - fi -done]) -dnl -dnl -------------------------------------------------------------------- -dnl -dnl THO_FORTRAN_TEST_PURE(VARIABLE, COMPILER, EXTENSION) -dnl -AC_DEFUN([THO_FORTRAN_TEST_PURE], -[AC_SUBST([$1]) -if test -n "$2"; then - AC_MSG_CHECKING([whether '$2' accepts PURE functions]) - THO_COMPILE_FORTRAN90([$1], [$2], [$3], - [module conftest_module - implicit none - private :: f - contains - pure function f (x) result (fx) - real, intent(in) :: x - real :: fx - fx = x - end function f - end module conftest_module - ], [$3], []) - if test "[$]$1" = "$3"; then - $1=yes - else - $1=no - fi - AC_MSG_RESULT([[$]$1]) -fi]) -dnl -dnl -------------------------------------------------------------------- -dnl -dnl THO_FORTRAN_TEST_QUADRUPLE(VARIABLE, COMPILER, EXTENSION) -dnl -AC_DEFUN([THO_FORTRAN_TEST_QUADRUPLE], -[AC_SUBST([$1]) -if test -n "$2"; then - AC_MSG_CHECKING([whether '$2' accepts quadruple precision]) - THO_COMPILE_FORTRAN90([$1], [$2], [$3], - [module conftest_module - integer, parameter :: d=selected_real_kind(precision(1.)+1, range(1.)+1) - integer, parameter :: q=selected_real_kind(precision(1._d)+1, range(1._d)) - real(kind=q) :: x - complex(kind=q) :: z - end module conftest_module - ], [$3], []) - if test "[$]$1" = "$3"; then - $1=yes - else - $1=no - fi - AC_MSG_RESULT([[$]$1]) -fi]) -dnl -dnl -------------------------------------------------------------------- -dnl -dnl THO_COMPILE_FORTRAN90(VARIABLE, COMPILER, EXTENSION, MODULE, -dnl VALUE_SUCCESS, VALUE_FAILURE, KEEP) -dnl -AC_DEFUN([THO_COMPILE_FORTRAN90], -[cat >conftest.$3 <<__END__ -$4 -program conftest - print *, 42 -end program conftest -__END__ -$2 -o conftest conftest.$3 >/dev/null 2>&1 -./conftest >conftest.out 2>/dev/null -if test 42 = "`sed 's/ //g' conftest.out`"; then - $1="$5" -else - $1="$6" -fi -if test -z "$7"; then - rm -f conftest* CONFTEST* -fi]) -dnl -dnl -------------------------------------------------------------------- -dnl -dnl THO_FORTRAN90_MODULE_FILE(NAME, EXTENSION, COMPILER, EXTENSION) -dnl -AC_DEFUN([THO_FORTRAN90_MODULE_FILE], -[AC_SUBST([$1]) -AC_SUBST([$2]) -AC_MSG_CHECKING([for Fortran90 module file naming convention]) -THO_COMPILE_FORTRAN90([tho_result], [$3], [$4], - [module module_NAME - implicit none - integer, parameter, public :: forty_two = 42 - end module module_NAME], [ok], [], [KEEP]) -if test -n "$tho_result"; then - $1=unknown - $2=unknown - for name in module_NAME module_name MODULE_NAME conftest; do - for ext in m mod M MOD d D; do - if test -f "$name.$ext"; then - $1="$name" - $2="$ext" - break 2 - fi - done - done - AC_MSG_RESULT([name: [$]$1, extension: .[$]$2 ]) -else - $1="" - $2="" - AC_MSG_RESULT([compiler failed]) -fi -rm -f conftest* CONFTEST* module_name* module_NAME* MODULE_NAME*]) -dnl -dnl -------------------------------------------------------------------- -dnl -------------------------------------------------------------------- -dnl -dnl THO_PATH_PROGS(NAME, PROGS, ARGS) -dnl -dnl Make sure that a program can be run -dnl (I had a problem with ocamlc.opt being compiled but -dnl dumping core on an Alpha) -dnl -AC_DEFUN([THO_PATH_PROGS], -[for name in $2; do - AC_PATH_PROGS($1,[$]name) - if test -n "[$]$1"; then - [$]$1 $3 >/dev/null 2>&1 && break - unset $1 - unset ac_cv_path_$1 - fi - done]) -dnl -dnl -------------------------------------------------------------------- -dnl -------------------------------------------------------------------- -dnl -AC_DEFUN([THO_OCAML_BASE], -[AC_PATH_PROGS(OCAML,ocaml) -THO_PATH_PROGS(OCAMLC,ocamlc.opt ocamlc,>' safe on PS Level 1 devices -/languagelevel where {pop languagelevel}{1} ifelse -2 lt { - userdict (<<) cvn ([) cvn load put - userdict (>>) cvn ([) cvn load put -} if - -%%EndSetup -%%Page: 1 1 -%%PageBoundingBox: 36 36 883 305 -%%PageOrientation: Portrait -gsave -35 35 848 270 boxprim clip newpath -36 36 translate -0 0 1 beginpage -0 0 translate 0 rotate -0.000 0.000 0.000 graphcolor -14.00 /Times-Roman set_font - -% l1b1 -gsave 10 dict begin -500 26 27 18 ellipse_path -stroke -gsave 10 dict begin -500 21 moveto 22 -0.5 (l1b1) alignedtext -end grestore -end grestore - -% l12 -gsave 10 dict begin -572 26 27 18 ellipse_path -stroke -gsave 10 dict begin -572 21 moveto 17 -0.5 (l12) alignedtext -end grestore -end grestore - -% u1b3 -gsave 10 dict begin -399 26 27 18 ellipse_path -stroke -gsave 10 dict begin -399 21 moveto 30 -0.5 (u1b3) alignedtext -end grestore -end grestore - -% d14 -gsave 10 dict begin -703 26 27 18 ellipse_path -stroke -gsave 10 dict begin -703 21 moveto 22 -0.5 (d14) alignedtext -end grestore -end grestore - -% l2b5 -gsave 10 dict begin -242 26 27 18 ellipse_path -stroke -gsave 10 dict begin -242 21 moveto 28 -0.5 (l2b5) alignedtext -end grestore -end grestore - -% n26 -gsave 10 dict begin -84 26 27 18 ellipse_path -stroke -gsave 10 dict begin -84 21 moveto 25 -0.5 (n26) alignedtext -end grestore -end grestore - -% a12 -gsave 10 dict begin -535 98 27 18 ellipse_path -stroke -gsave 10 dict begin -535 93 moveto 20 -0.5 (a12) alignedtext -end grestore -end grestore - -% a12 -> l1b1 -newpath 527 81 moveto -522 72 517 61 512 52 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 510 53 moveto -508 43 lineto -514 51 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% a12 -> l12 -newpath 544 81 moveto -549 73 554 62 559 52 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 557 51 moveto -563 43 lineto -561 53 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% z12 -gsave 10 dict begin -463 98 27 18 ellipse_path -stroke -gsave 10 dict begin -463 93 moveto 20 -0.5 (z12) alignedtext -end grestore -end grestore - -% z12 -> l1b1 -newpath 472 81 moveto -477 73 482 62 487 52 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 485 51 moveto -491 43 lineto -489 53 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% z12 -> l12 -newpath 482 85 moveto -500 74 526 57 545 44 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 543 42 moveto -553 39 lineto -546 46 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% wm34 -gsave 10 dict begin -733 98 32 18 ellipse_path -stroke -gsave 10 dict begin -733 93 moveto 43 -0.5 (wm34) alignedtext -end grestore -end grestore - -% wm34 -> u1b3 -newpath 702 93 moveto -652 83 549 64 464 44 curveto -453 42 443 39 433 36 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 433 39 moveto -424 33 lineto -434 34 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% wm34 -> d14 -newpath 726 80 moveto -722 72 718 62 714 53 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 712 54 moveto -710 44 lineto -716 52 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% wp56 -gsave 10 dict begin -84 98 29 18 ellipse_path -stroke -gsave 10 dict begin -84 93 moveto 37 -0.5 (wp56) alignedtext -end grestore -end grestore - -% wp56 -> l2b5 -newpath 108 87 moveto -135 74 180 55 210 40 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 210 37 moveto -220 36 lineto -212 42 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% wp56 -> n26 -newpath 84 80 moveto -84 72 84 63 84 54 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 82 54 moveto -84 44 lineto -87 54 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% u1b123 -gsave 10 dict begin -414 170 32 18 ellipse_path -stroke -gsave 10 dict begin -414 165 moveto 43 -0.5 (u1b123) alignedtext -end grestore -end grestore - -% u1b123 -> u1b3 -newpath 408 152 moveto -403 128 398 82 396 53 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 394 54 moveto -396 44 lineto -399 54 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% u1b123 -> u1b3 -newpath 417 152 moveto -417 127 412 81 408 53 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 406 54 moveto -406 44 lineto -411 53 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% u1b123 -> a12 -newpath 436 157 moveto -456 145 486 127 507 115 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 505 113 moveto -515 110 lineto -508 117 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% u1b123 -> z12 -newpath 426 153 moveto -432 144 440 133 447 123 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 445 122 moveto -452 115 lineto -449 125 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% d1124 -gsave 10 dict begin -568 170 28 18 ellipse_path -stroke -gsave 10 dict begin -568 165 moveto 35 -0.5 (d1124) alignedtext -end grestore -end grestore - -% d1124 -> d14 -newpath 579 153 moveto -601 126 650 74 680 46 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 677 45 moveto -686 40 lineto -681 49 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% d1124 -> d14 -newpath 586 156 moveto -612 131 661 79 687 48 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 684 48 moveto -692 42 lineto -688 51 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% d1124 -> a12 -newpath 560 153 moveto -556 144 551 134 547 124 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 545 125 moveto -543 115 lineto -549 123 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% d1124 -> z12 -newpath 549 157 moveto -532 146 508 129 489 116 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 489 119 moveto -482 111 lineto -492 115 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% n1b134 -gsave 10 dict begin -646 170 32 18 ellipse_path -stroke -gsave 10 dict begin -646 165 moveto 43 -0.5 (n1b134) alignedtext -end grestore -end grestore - -% n1b134 -> l1b1 -newpath 633 153 moveto -619 135 594 104 571 80 curveto -563 72 545 54 531 41 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 530 43 moveto -523 35 lineto -532 39 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% n1b134 -> wm34 -newpath 664 155 moveto -677 145 694 130 708 119 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 706 118 moveto -715 113 lineto -709 121 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% l2b125 -gsave 10 dict begin -333 170 31 18 ellipse_path -stroke -gsave 10 dict begin -333 165 moveto 41 -0.5 (l2b125) alignedtext -end grestore -end grestore - -% l2b125 -> l2b5 -newpath 318 154 moveto -299 129 268 79 252 50 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 251 54 moveto -249 44 lineto -256 52 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% l2b125 -> l2b5 -newpath 326 152 moveto -312 126 281 76 260 48 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 259 52 moveto -256 42 lineto -264 49 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% l2b125 -> a12 -newpath 357 158 moveto -362 156 368 154 373 152 curveto -427 131 444 137 499 116 curveto -502 115 505 113 508 112 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 504 111 moveto -514 109 lineto -506 116 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% l2b125 -> z12 -newpath 356 157 moveto -378 145 410 127 434 114 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 432 112 moveto -442 110 lineto -434 117 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% n2126 -gsave 10 dict begin -216 170 30 18 ellipse_path -stroke -gsave 10 dict begin -216 165 moveto 38 -0.5 (n2126) alignedtext -end grestore -end grestore - -% n2126 -> n26 -newpath 201 154 moveto -178 129 131 77 104 48 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 103 51 moveto -98 42 lineto -107 47 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% n2126 -> z12 -newpath 243 162 moveto -290 149 383 122 432 107 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 428 106 moveto -438 105 lineto -429 111 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -gsave 10 dict begin -414 242 27 18 ellipse_path -stroke -gsave 10 dict begin -414 237 moveto 6 -0.5 (*) alignedtext -end grestore -end grestore - -% * -> l12 -newpath 441 240 moveto -467 237 473 237 501 234 curveto -607 221 652 253 737 188 curveto -765 165 765 150 774 116 curveto -777 100 783 92 774 80 curveto -763 66 660 44 605 33 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 607 36 moveto -598 31 lineto -608 31 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> u1b3 -newpath 390 234 moveto -380 229 368 223 362 220 curveto -346 212 302 202 293 188 curveto -260 134 333 72 374 43 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 370 43 moveto -379 39 lineto -373 47 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> d14 -newpath 441 242 moveto -514 240 714 231 761 188 curveto -797 154 810 123 788 80 curveto -774 53 760 46 738 37 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 736 39 moveto -728 33 lineto -738 34 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> l2b5 -newpath 387 240 moveto -336 232 207 225 177 188 curveto -143 144 191 80 221 48 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 219 47 moveto -227 41 lineto -222 50 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> n26 -newpath 387 241 moveto -374 241 360 240 354 240 curveto -246 231 212 241 114 192 curveto -79 174 63 160 46 116 curveto -41 101 42 95 46 80 curveto -50 69 57 58 63 49 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 61 48 moveto -69 42 lineto -64 51 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> a12 -newpath 434 229 moveto -449 215 454 207 471 188 curveto -488 166 506 140 519 121 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 516 121 moveto -524 115 lineto -520 124 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> z12 -newpath 429 227 moveto -438 217 449 203 455 188 curveto -463 167 465 143 464 124 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 462 126 moveto -464 116 lineto -467 126 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> wm34 -newpath 440 237 moveto -532 229 578 250 660 188 curveto -682 170 694 139 707 119 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 704 119 moveto -712 112 lineto -708 122 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> wm34 -newpath 441 242 moveto -452 241 460 241 467 240 curveto -578 224 624 256 714 188 curveto -735 171 747 143 748 122 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 746 124 moveto -748 114 lineto -751 124 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> wm34 -newpath 441 239 moveto -545 226 591 254 678 188 curveto -698 171 711 143 719 123 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 716 123 moveto -722 115 lineto -721 125 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> wm34 -newpath 441 241 moveto -444 240 446 240 449 240 curveto -560 224 606 256 696 188 curveto -716 172 729 144 734 124 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 731 126 moveto -735 116 lineto -736 126 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> wp56 -newpath 387 242 moveto -370 241 361 241 354 240 curveto -244 223 201 250 108 188 curveto -84 171 66 140 65 119 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 62 122 moveto -66 112 lineto -67 122 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> wp56 -newpath 387 240 moveto -279 223 236 249 144 188 curveto -121 172 104 143 94 123 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 93 126 moveto -91 116 lineto -97 124 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> wp56 -newpath 388 237 moveto -292 226 249 246 162 188 curveto -138 171 120 140 106 119 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 105 122 moveto -101 112 lineto -109 119 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> wp56 -newpath 389 236 moveto -305 228 262 242 180 188 curveto -154 170 135 135 115 114 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 114 116 moveto -108 108 lineto -117 113 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> wp56 -newpath 387 241 moveto -381 241 376 240 372 240 curveto -262 223 219 250 126 188 curveto -103 172 86 144 80 123 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 78 126 moveto -78 116 lineto -83 125 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> u1b123 -newpath 414 224 moveto -414 216 414 207 414 198 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 412 198 moveto -414 188 lineto -417 198 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> d1124 -newpath 436 232 moveto -463 219 509 198 539 184 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 535 183 moveto -545 181 lineto -537 188 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> n1b134 -newpath 440 236 moveto -476 227 546 208 605 188 curveto -608 187 612 186 615 184 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 611 183 moveto -621 181 lineto -613 188 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> l2b125 -newpath 398 227 moveto -386 217 370 202 357 191 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 356 193 moveto -350 185 lineto -359 190 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> n2126 -newpath 390 234 moveto -359 223 305 205 260 188 curveto -256 186 251 184 247 183 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 249 187 moveto -241 180 lineto -251 182 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -endpage -grestore -%%PageTrailer -%%EndPage: 1 -%%Trailer -%%Pages: 1 -end -restore -%%EOF Index: branches/ohl/omega-development/completed/whizard2/web/epemudbarmunumubar0.eps =================================================================== --- branches/ohl/omega-development/completed/whizard2/web/epemudbarmunumubar0.eps (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/web/epemudbarmunumubar0.eps (revision 8703) @@ -1,1155 +0,0 @@ -%!PS-Adobe-2.0 -%%Creator: dot version 1.8.5 (Wed Aug 21 14:41:12 CEST 2002) -%%For: (ohl) Thorsten Ohl,,5729,0931-3594666 -%%Title: OMEGA -%%Pages: (atend) -%%BoundingBox: 35 35 1292 335 -%%EndComments -save -%%BeginProlog -/DotDict 200 dict def -DotDict begin - -/setupLatin1 { -mark -/EncodingVector 256 array def - EncodingVector 0 - -ISOLatin1Encoding 0 255 getinterval putinterval - -EncodingVector - dup 306 /AE - dup 301 /Aacute - dup 302 /Acircumflex - dup 304 /Adieresis - dup 300 /Agrave - dup 305 /Aring - dup 303 /Atilde - dup 307 /Ccedilla - dup 311 /Eacute - dup 312 /Ecircumflex - dup 313 /Edieresis - dup 310 /Egrave - dup 315 /Iacute - dup 316 /Icircumflex - dup 317 /Idieresis - dup 314 /Igrave - dup 334 /Udieresis - dup 335 /Yacute - dup 376 /thorn - dup 337 /germandbls - dup 341 /aacute - dup 342 /acircumflex - dup 344 /adieresis - dup 346 /ae - dup 340 /agrave - dup 345 /aring - dup 347 /ccedilla - dup 351 /eacute - dup 352 /ecircumflex - dup 353 /edieresis - dup 350 /egrave - dup 355 /iacute - dup 356 /icircumflex - dup 357 /idieresis - dup 354 /igrave - dup 360 /dcroat - dup 361 /ntilde - dup 363 /oacute - dup 364 /ocircumflex - dup 366 /odieresis - dup 362 /ograve - dup 365 /otilde - dup 370 /oslash - dup 372 /uacute - dup 373 /ucircumflex - dup 374 /udieresis - dup 371 /ugrave - dup 375 /yacute - dup 377 /ydieresis - -% Set up ISO Latin 1 character encoding -/starnetISO { - dup dup findfont dup length dict begin - { 1 index /FID ne { def }{ pop pop } ifelse - } forall - /Encoding EncodingVector def - currentdict end definefont -} def -/Times-Roman starnetISO def -/Times-Italic starnetISO def -/Times-Bold starnetISO def -/Times-BoldItalic starnetISO def -/Helvetica starnetISO def -/Helvetica-Oblique starnetISO def -/Helvetica-Bold starnetISO def -/Helvetica-BoldOblique starnetISO def -/Courier starnetISO def -/Courier-Oblique starnetISO def -/Courier-Bold starnetISO def -/Courier-BoldOblique starnetISO def -cleartomark -} bind def - -%%BeginResource: procset -/coord-font-family /Times-Roman def -/default-font-family /Times-Roman def -/coordfont coord-font-family findfont 8 scalefont def - -/InvScaleFactor 1.0 def -/set_scale { - dup 1 exch div /InvScaleFactor exch def - dup scale -} bind def - -% styles -/solid { } bind def -/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def -/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def -/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def -/bold { 2 setlinewidth } bind def -/filled { } bind def -/unfilled { } bind def -/rounded { } bind def -/diagonals { } bind def - -% hooks for setting color -/nodecolor { sethsbcolor } bind def -/edgecolor { sethsbcolor } bind def -/graphcolor { sethsbcolor } bind def -/nopcolor {pop pop pop} bind def - -/beginpage { % i j npages - /npages exch def - /j exch def - /i exch def - /str 10 string def - npages 1 gt { - gsave - coordfont setfont - 0 0 moveto - (\() show i str cvs show (,) show j str cvs show (\)) show - grestore - } if -} bind def - -/set_font { - findfont exch - scalefont setfont -} def - -% draw aligned label in bounding box aligned to current point -/alignedtext { % width adj text - /text exch def - /adj exch def - /width exch def - gsave - width 0 gt { - text stringwidth pop adj mul 0 rmoveto - } if - [] 0 setdash - text show - grestore -} def - -/boxprim { % xcorner ycorner xsize ysize - 4 2 roll - moveto - 2 copy - exch 0 rlineto - 0 exch rlineto - pop neg 0 rlineto - closepath -} bind def - -/ellipse_path { - /ry exch def - /rx exch def - /y exch def - /x exch def - matrix currentmatrix - newpath - x y translate - rx ry scale - 0 0 1 0 360 arc - setmatrix -} bind def - -/endpage { showpage } bind def - -/layercolorseq - [ % layer color sequence - darkest to lightest - [0 0 0] - [.2 .8 .8] - [.4 .8 .8] - [.6 .8 .8] - [.8 .8 .8] - ] -def - -/setlayer {/maxlayer exch def /curlayer exch def - layercolorseq curlayer get - aload pop sethsbcolor - /nodecolor {nopcolor} def - /edgecolor {nopcolor} def - /graphcolor {nopcolor} def -} bind def - -/onlayer { curlayer ne {invis} if } def - -/onlayers { - /myupper exch def - /mylower exch def - curlayer mylower lt - curlayer myupper gt - or - {invis} if -} def - -/curlayer 0 def - -%%EndResource -%%EndProlog -%%BeginSetup -14 default-font-family set_font -1 setmiterlimit -% /arrowlength 10 def -% /arrowwidth 5 def - -% make sure pdfmark is harmless for PS-interpreters other than Distiller -/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse -% make '<<' and '>>' safe on PS Level 1 devices -/languagelevel where {pop languagelevel}{1} ifelse -2 lt { - userdict (<<) cvn ([) cvn load put - userdict (>>) cvn ([) cvn load put -} if - -%%EndSetup -%%Page: 1 1 -%%PageBoundingBox: 36 36 1292 335 -%%PageOrientation: Portrait -gsave -35 35 1257 300 boxprim clip newpath -36 36 translate -0 0 1 beginpage -0 0 translate 0 rotate -0.000 0.000 0.000 graphcolor -14.00 /Times-Roman set_font - -% l1b1 -gsave 10 dict begin -957 26 27 18 ellipse_path -stroke -gsave 10 dict begin -957 21 moveto 22 -0.5 (l1b1) alignedtext -end grestore -end grestore - -% l12 -gsave 10 dict begin -1029 26 27 18 ellipse_path -stroke -gsave 10 dict begin -1029 21 moveto 17 -0.5 (l12) alignedtext -end grestore -end grestore - -% u1b3 -gsave 10 dict begin -465 26 27 18 ellipse_path -stroke -gsave 10 dict begin -465 21 moveto 30 -0.5 (u1b3) alignedtext -end grestore -end grestore - -% d14 -gsave 10 dict begin -537 26 27 18 ellipse_path -stroke -gsave 10 dict begin -537 21 moveto 22 -0.5 (d14) alignedtext -end grestore -end grestore - -% l2b5 -gsave 10 dict begin -1181 26 27 18 ellipse_path -stroke -gsave 10 dict begin -1181 21 moveto 28 -0.5 (l2b5) alignedtext -end grestore -end grestore - -% n26 -gsave 10 dict begin -228 26 27 18 ellipse_path -stroke -gsave 10 dict begin -228 21 moveto 25 -0.5 (n26) alignedtext -end grestore -end grestore - -% a12 -gsave 10 dict begin -1029 98 27 18 ellipse_path -stroke -gsave 10 dict begin -1029 93 moveto 20 -0.5 (a12) alignedtext -end grestore -end grestore - -% a12 -> l1b1 -newpath 1014 83 moveto -1004 73 991 60 979 48 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 977 50 moveto -972 41 lineto -981 46 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% a12 -> l12 -newpath 1029 80 moveto -1029 72 1029 63 1029 54 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1027 54 moveto -1029 44 lineto -1032 54 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% z12 -gsave 10 dict begin -957 98 27 18 ellipse_path -stroke -gsave 10 dict begin -957 93 moveto 20 -0.5 (z12) alignedtext -end grestore -end grestore - -% z12 -> l1b1 -newpath 957 80 moveto -957 72 957 63 957 54 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 955 54 moveto -957 44 lineto -960 54 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% z12 -> l12 -newpath 972 83 moveto -982 73 995 60 1007 48 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1005 46 moveto -1014 41 lineto -1009 50 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% wm34 -gsave 10 dict begin -193 98 32 18 ellipse_path -stroke -gsave 10 dict begin -193 93 moveto 43 -0.5 (wm34) alignedtext -end grestore -end grestore - -% wm34 -> u1b3 -newpath 222 90 moveto -273 77 379 49 433 35 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 430 33 moveto -440 33 lineto -431 38 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% wm34 -> d14 -newpath 224 94 moveto -292 84 450 60 501 44 curveto -504 43 507 42 510 40 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 506 39 moveto -516 38 lineto -507 44 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% wp56 -gsave 10 dict begin -662 98 29 18 ellipse_path -stroke -gsave 10 dict begin -662 93 moveto 37 -0.5 (wp56) alignedtext -end grestore -end grestore - -% wp56 -> l2b5 -newpath 691 94 moveto -757 86 925 64 1065 44 curveto -1092 40 1123 35 1147 31 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1145 29 moveto -1155 30 lineto -1145 34 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% wp56 -> n26 -newpath 634 93 moveto -557 80 344 45 261 31 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 264 34 moveto -254 30 lineto -264 29 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% u1b123 -gsave 10 dict begin -912 170 32 18 ellipse_path -stroke -gsave 10 dict begin -912 165 moveto 43 -0.5 (u1b123) alignedtext -end grestore -end grestore - -% u1b123 -> u1b3 -newpath 888 158 moveto -853 138 787 99 727 80 curveto -626 47 592 76 492 44 curveto -492 44 491 44 491 44 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 490 46 moveto -482 40 lineto -492 42 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% u1b123 -> u1b3 -newpath 894 155 moveto -865 134 802 98 745 80 curveto -644 47 610 76 510 44 curveto -504 42 501 40 497 38 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 497 41 moveto -490 34 lineto -500 37 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% u1b123 -> a12 -newpath 934 157 moveto -954 145 981 128 1001 115 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 999 113 moveto -1009 110 lineto -1002 117 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% u1b123 -> z12 -newpath 923 153 moveto -928 144 935 134 941 123 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 939 122 moveto -946 115 lineto -943 125 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% d1124 -gsave 10 dict begin -990 170 28 18 ellipse_path -stroke -gsave 10 dict begin -990 165 moveto 35 -0.5 (d1124) alignedtext -end grestore -end grestore - -% d1124 -> d14 -newpath 964 163 moveto -957 160 953 156 944 152 curveto -877 118 863 103 793 80 curveto -716 53 620 38 571 31 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 574 34 moveto -564 30 lineto -574 29 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% d1124 -> d14 -newpath 971 157 moveto -968 155 966 154 962 152 curveto -895 118 881 103 811 80 curveto -727 51 624 35 571 30 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 574 33 moveto -564 29 lineto -574 28 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% d1124 -> a12 -newpath 999 153 moveto -1004 145 1010 134 1015 124 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1013 123 moveto -1020 115 lineto -1017 125 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% d1124 -> z12 -newpath 982 153 moveto -978 144 973 134 969 124 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 967 125 moveto -965 115 lineto -971 123 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% n1b134 -gsave 10 dict begin -280 170 32 18 ellipse_path -stroke -gsave 10 dict begin -280 165 moveto 43 -0.5 (n1b134) alignedtext -end grestore -end grestore - -% n1b134 -> l1b1 -newpath 308 161 moveto -361 142 484 103 591 80 curveto -710 54 855 37 921 30 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 920 28 moveto -930 29 lineto -920 33 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% n1b134 -> wm34 -newpath 262 155 moveto -249 145 232 130 218 119 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 217 121 moveto -211 113 lineto -220 118 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% l2b125 -gsave 10 dict begin -1181 170 31 18 ellipse_path -stroke -gsave 10 dict begin -1181 165 moveto 41 -0.5 (l2b125) alignedtext -end grestore -end grestore - -% l2b125 -> l2b5 -newpath 1176 152 moveto -1173 127 1173 82 1175 53 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1172 54 moveto -1176 44 lineto -1177 54 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% l2b125 -> l2b5 -newpath 1186 152 moveto -1189 127 1189 82 1187 53 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1185 54 moveto -1186 44 lineto -1190 54 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% l2b125 -> a12 -newpath 1157 159 moveto -1131 146 1089 127 1060 113 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1059 115 moveto -1051 109 lineto -1061 111 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% l2b125 -> z12 -newpath 1152 163 moveto -1114 154 1047 137 993 116 curveto -991 115 989 114 987 114 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 986 116 moveto -978 109 lineto -988 112 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% n2b345 -gsave 10 dict begin -403 170 35 18 ellipse_path -stroke -gsave 10 dict begin -403 165 moveto 49 -0.5 (n2b345) alignedtext -end grestore -end grestore - -% n2b345 -> l2b5 -newpath 430 158 moveto -485 135 604 85 624 80 curveto -647 74 1039 47 1064 44 curveto -1071 42 1072 41 1080 40 curveto -1108 33 1116 31 1145 28 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1144 26 moveto -1154 27 lineto -1144 31 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% n2b345 -> wm34 -newpath 374 160 moveto -336 147 270 124 229 110 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 229 113 moveto -221 107 lineto -231 108 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% n2126 -gsave 10 dict begin -832 170 30 18 ellipse_path -stroke -gsave 10 dict begin -832 165 moveto 38 -0.5 (n2126) alignedtext -end grestore -end grestore - -% n2126 -> n26 -newpath 809 159 moveto -783 146 744 126 732 116 curveto -715 102 718 89 700 80 curveto -678 68 301 31 263 28 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 265 31 moveto -255 27 lineto -265 26 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% n2126 -> z12 -newpath 854 157 moveto -875 145 906 127 929 114 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 926 113 moveto -936 110 lineto -929 117 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% l2346 -gsave 10 dict begin -72 170 28 18 ellipse_path -stroke -gsave 10 dict begin -72 165 moveto 35 -0.5 (l2346) alignedtext -end grestore -end grestore - -% l2346 -> n26 -newpath 76 152 moveto -82 132 94 100 114 80 curveto -136 58 170 43 194 35 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 192 33 moveto -202 33 lineto -193 38 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% l2346 -> wm34 -newpath 93 158 moveto -112 146 141 129 163 116 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 161 114 moveto -171 111 lineto -164 118 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% n1256 -gsave 10 dict begin -755 170 29 18 ellipse_path -stroke -gsave 10 dict begin -755 165 moveto 37 -0.5 (n1256) alignedtext -end grestore -end grestore - -% n1256 -> l12 -newpath 777 158 moveto -808 140 868 107 921 80 curveto -952 63 963 64 992 44 curveto -995 42 996 40 997 38 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 995 37 moveto -1003 31 lineto -998 40 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% n1256 -> wp56 -newpath 737 156 moveto -723 145 704 130 687 118 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 686 120 moveto -680 112 lineto -689 117 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% d1b356 -gsave 10 dict begin -489 170 33 18 ellipse_path -stroke -gsave 10 dict begin -489 165 moveto 44 -0.5 (d1b356) alignedtext -end grestore -end grestore - -% d1b356 -> u1b3 -newpath 486 152 moveto -482 127 475 82 470 53 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 468 54 moveto -468 44 lineto -473 53 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% d1b356 -> wp56 -newpath 515 159 moveto -520 156 526 154 531 152 curveto -569 135 579 132 619 116 curveto -623 114 628 112 632 111 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 628 110 moveto -638 108 lineto -630 115 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% u1456 -gsave 10 dict begin -569 170 29 18 ellipse_path -stroke -gsave 10 dict begin -569 165 moveto 37 -0.5 (u1456) alignedtext -end grestore -end grestore - -% u1456 -> d14 -newpath 565 152 moveto -560 127 549 82 543 53 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 541 54 moveto -541 44 lineto -546 53 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% u1456 -> wp56 -newpath 587 156 moveto -601 145 620 130 637 118 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 635 117 moveto -644 112 lineto -638 120 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -gsave 10 dict begin -662 242 27 18 ellipse_path -stroke -gsave 10 dict begin -662 237 moveto 6 -0.5 (*) alignedtext -end grestore -end grestore - -% * -> l12 -newpath 689 241 moveto -703 241 719 240 734 240 curveto -770 237 1035 217 1057 188 curveto -1085 149 1078 126 1065 80 curveto -1061 69 1055 58 1049 49 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1048 51 moveto -1043 42 lineto -1051 48 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> u1b3 -newpath 635 241 moveto -623 241 609 240 597 240 curveto -584 239 581 239 570 238 curveto -377 221 216 298 152 116 curveto -147 100 142 92 152 80 curveto -172 56 388 32 430 28 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 428 26 moveto -438 27 lineto -428 31 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> d14 -newpath 635 238 moveto -585 231 368 199 359 188 curveto -349 175 351 166 359 152 curveto -368 136 463 73 511 43 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 507 42 moveto -517 39 lineto -510 47 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> l2b5 -newpath 689 242 moveto -715 241 751 241 766 240 curveto -867 235 1154 264 1221 188 curveto -1255 149 1221 83 1198 49 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1197 52 moveto -1193 42 lineto -1201 49 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> n26 -newpath 635 242 moveto -519 240 76 232 35 188 curveto -0 148 77 88 86 80 curveto -126 46 142 41 191 29 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 191 27 moveto -201 27 lineto -192 31 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> a12 -newpath 689 241 moveto -703 241 719 240 726 240 curveto -749 238 915 219 939 216 curveto -957 213 961 212 980 208 curveto -1007 201 1024 211 1041 188 curveto -1053 169 1048 143 1041 123 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1039 125 moveto -1038 115 lineto -1044 123 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> z12 -newpath 689 241 moveto -693 240 696 240 699 240 curveto -723 238 729 237 754 234 curveto -784 229 1007 211 1027 188 curveto -1037 175 1033 166 1027 152 curveto -1024 147 1004 128 988 115 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 986 116 moveto -980 108 lineto -989 113 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> wm34 -newpath 635 242 moveto -619 241 604 241 592 240 curveto -583 239 581 238 574 238 curveto -412 218 344 282 212 188 curveto -191 172 178 143 178 122 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 176 124 moveto -178 114 lineto -181 124 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> wm34 -newpath 635 238 moveto -633 238 631 238 628 238 curveto -466 218 398 282 266 188 curveto -244 171 231 140 218 119 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 217 122 moveto -214 112 lineto -221 119 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> wm34 -newpath 635 241 moveto -627 241 618 240 610 240 curveto -601 239 599 238 592 238 curveto -430 218 362 282 230 188 curveto -209 172 197 144 192 124 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 190 126 moveto -191 116 lineto -195 126 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> wm34 -newpath 635 240 moveto -633 240 630 240 628 240 curveto -619 239 617 238 610 238 curveto -448 218 380 282 248 188 curveto -227 172 215 143 206 123 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 204 125 moveto -203 115 lineto -209 123 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> wp56 -newpath 645 228 moveto -632 204 632 153 641 122 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 639 121 moveto -645 113 lineto -643 123 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> wp56 -newpath 662 224 moveto -662 199 662 154 662 125 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 660 126 moveto -662 116 lineto -665 126 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> wp56 -newpath 671 225 moveto -676 201 677 154 673 125 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 671 126 moveto -671 116 lineto -676 125 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> wp56 -newpath 679 228 moveto -692 204 692 153 683 122 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 681 123 moveto -679 113 lineto -685 121 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> wp56 -newpath 653 225 moveto -648 201 647 154 651 125 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 648 125 moveto -653 116 lineto -653 126 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> u1b123 -newpath 688 237 moveto -728 228 806 210 871 188 curveto -874 187 878 186 881 184 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 877 183 moveto -887 181 lineto -879 188 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> d1124 -newpath 689 239 moveto -741 234 859 219 953 188 curveto -956 187 959 186 962 184 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 958 183 moveto -968 182 lineto -959 188 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> n1b134 -newpath 635 240 moveto -577 234 438 218 326 188 curveto -321 187 316 185 312 184 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 314 188 moveto -306 181 lineto -316 183 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> l2b125 -newpath 689 241 moveto -762 239 969 229 1136 188 curveto -1140 187 1145 185 1149 184 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1146 183 moveto -1156 181 lineto -1148 187 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> n2126 -newpath 685 233 moveto -711 222 755 204 793 188 curveto -796 187 799 185 802 184 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 798 183 moveto -808 181 lineto -800 188 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -endpage -grestore -%%PageTrailer -%%EndPage: 1 -%%Trailer -%%Pages: 1 -end -restore -%%EOF Index: branches/ohl/omega-development/completed/whizard2/web/epemudbardubar.eps =================================================================== --- branches/ohl/omega-development/completed/whizard2/web/epemudbardubar.eps (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/web/epemudbardubar.eps (revision 8703) @@ -1,1633 +0,0 @@ -%!PS-Adobe-2.0 -%%Creator: dot version 1.8.5 (Wed Aug 21 14:41:12 CEST 2002) -%%For: (ohl) Thorsten Ohl,,5729,0931-3594666 -%%Title: OMEGA -%%Pages: (atend) -%%BoundingBox: 35 35 1547 310 -%%EndComments -save -%%BeginProlog -/DotDict 200 dict def -DotDict begin - -/setupLatin1 { -mark -/EncodingVector 256 array def - EncodingVector 0 - -ISOLatin1Encoding 0 255 getinterval putinterval - -EncodingVector - dup 306 /AE - dup 301 /Aacute - dup 302 /Acircumflex - dup 304 /Adieresis - dup 300 /Agrave - dup 305 /Aring - dup 303 /Atilde - dup 307 /Ccedilla - dup 311 /Eacute - dup 312 /Ecircumflex - dup 313 /Edieresis - dup 310 /Egrave - dup 315 /Iacute - dup 316 /Icircumflex - dup 317 /Idieresis - dup 314 /Igrave - dup 334 /Udieresis - dup 335 /Yacute - dup 376 /thorn - dup 337 /germandbls - dup 341 /aacute - dup 342 /acircumflex - dup 344 /adieresis - dup 346 /ae - dup 340 /agrave - dup 345 /aring - dup 347 /ccedilla - dup 351 /eacute - dup 352 /ecircumflex - dup 353 /edieresis - dup 350 /egrave - dup 355 /iacute - dup 356 /icircumflex - dup 357 /idieresis - dup 354 /igrave - dup 360 /dcroat - dup 361 /ntilde - dup 363 /oacute - dup 364 /ocircumflex - dup 366 /odieresis - dup 362 /ograve - dup 365 /otilde - dup 370 /oslash - dup 372 /uacute - dup 373 /ucircumflex - dup 374 /udieresis - dup 371 /ugrave - dup 375 /yacute - dup 377 /ydieresis - -% Set up ISO Latin 1 character encoding -/starnetISO { - dup dup findfont dup length dict begin - { 1 index /FID ne { def }{ pop pop } ifelse - } forall - /Encoding EncodingVector def - currentdict end definefont -} def -/Times-Roman starnetISO def -/Times-Italic starnetISO def -/Times-Bold starnetISO def -/Times-BoldItalic starnetISO def -/Helvetica starnetISO def -/Helvetica-Oblique starnetISO def -/Helvetica-Bold starnetISO def -/Helvetica-BoldOblique starnetISO def -/Courier starnetISO def -/Courier-Oblique starnetISO def -/Courier-Bold starnetISO def -/Courier-BoldOblique starnetISO def -cleartomark -} bind def - -%%BeginResource: procset -/coord-font-family /Times-Roman def -/default-font-family /Times-Roman def -/coordfont coord-font-family findfont 8 scalefont def - -/InvScaleFactor 1.0 def -/set_scale { - dup 1 exch div /InvScaleFactor exch def - dup scale -} bind def - -% styles -/solid { } bind def -/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def -/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def -/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def -/bold { 2 setlinewidth } bind def -/filled { } bind def -/unfilled { } bind def -/rounded { } bind def -/diagonals { } bind def - -% hooks for setting color -/nodecolor { sethsbcolor } bind def -/edgecolor { sethsbcolor } bind def -/graphcolor { sethsbcolor } bind def -/nopcolor {pop pop pop} bind def - -/beginpage { % i j npages - /npages exch def - /j exch def - /i exch def - /str 10 string def - npages 1 gt { - gsave - coordfont setfont - 0 0 moveto - (\() show i str cvs show (,) show j str cvs show (\)) show - grestore - } if -} bind def - -/set_font { - findfont exch - scalefont setfont -} def - -% draw aligned label in bounding box aligned to current point -/alignedtext { % width adj text - /text exch def - /adj exch def - /width exch def - gsave - width 0 gt { - text stringwidth pop adj mul 0 rmoveto - } if - [] 0 setdash - text show - grestore -} def - -/boxprim { % xcorner ycorner xsize ysize - 4 2 roll - moveto - 2 copy - exch 0 rlineto - 0 exch rlineto - pop neg 0 rlineto - closepath -} bind def - -/ellipse_path { - /ry exch def - /rx exch def - /y exch def - /x exch def - matrix currentmatrix - newpath - x y translate - rx ry scale - 0 0 1 0 360 arc - setmatrix -} bind def - -/endpage { showpage } bind def - -/layercolorseq - [ % layer color sequence - darkest to lightest - [0 0 0] - [.2 .8 .8] - [.4 .8 .8] - [.6 .8 .8] - [.8 .8 .8] - ] -def - -/setlayer {/maxlayer exch def /curlayer exch def - layercolorseq curlayer get - aload pop sethsbcolor - /nodecolor {nopcolor} def - /edgecolor {nopcolor} def - /graphcolor {nopcolor} def -} bind def - -/onlayer { curlayer ne {invis} if } def - -/onlayers { - /myupper exch def - /mylower exch def - curlayer mylower lt - curlayer myupper gt - or - {invis} if -} def - -/curlayer 0 def - -%%EndResource -%%EndProlog -%%BeginSetup -14 default-font-family set_font -1 setmiterlimit -% /arrowlength 10 def -% /arrowwidth 5 def - -% make sure pdfmark is harmless for PS-interpreters other than Distiller -/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse -% make '<<' and '>>' safe on PS Level 1 devices -/languagelevel where {pop languagelevel}{1} ifelse -2 lt { - userdict (<<) cvn ([) cvn load put - userdict (>>) cvn ([) cvn load put -} if - -%%EndSetup -%%Page: 1 1 -%%PageBoundingBox: 36 36 1547 310 -%%PageOrientation: Portrait -gsave -35 35 1512 275 boxprim clip newpath -36 36 translate -0 0 1 beginpage -0 0 translate 0 rotate -0.000 0.000 0.000 graphcolor -14.00 /Times-Roman set_font - -% l1b1 -gsave 10 dict begin -997 26 27 18 ellipse_path -stroke -gsave 10 dict begin -997 21 moveto 22 -0.5 (l1b1) alignedtext -end grestore -end grestore - -% l12 -gsave 10 dict begin -46 26 27 18 ellipse_path -stroke -gsave 10 dict begin -46 21 moveto 17 -0.5 (l12) alignedtext -end grestore -end grestore - -% u1b3 -gsave 10 dict begin -301 26 27 18 ellipse_path -stroke -gsave 10 dict begin -301 21 moveto 30 -0.5 (u1b3) alignedtext -end grestore -end grestore - -% d14 -gsave 10 dict begin -774 26 27 18 ellipse_path -stroke -gsave 10 dict begin -774 21 moveto 22 -0.5 (d14) alignedtext -end grestore -end grestore - -% d1b5 -gsave 10 dict begin -1189 26 27 18 ellipse_path -stroke -gsave 10 dict begin -1189 21 moveto 29 -0.5 (d1b5) alignedtext -end grestore -end grestore - -% u16 -gsave 10 dict begin -1347 26 27 18 ellipse_path -stroke -gsave 10 dict begin -1347 21 moveto 22 -0.5 (u16) alignedtext -end grestore -end grestore - -% a12 -gsave 10 dict begin -589 98 27 18 ellipse_path -stroke -gsave 10 dict begin -589 93 moveto 20 -0.5 (a12) alignedtext -end grestore -end grestore - -% a12 -> l1b1 -newpath 610 87 moveto -616 84 623 82 630 80 curveto -692 62 885 38 963 30 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 960 28 moveto -970 29 lineto -960 33 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% a12 -> l12 -newpath 569 86 moveto -564 84 558 82 553 80 curveto -507 66 191 39 82 29 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 83 32 moveto -73 28 lineto -83 27 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% z12 -gsave 10 dict begin -517 98 27 18 ellipse_path -stroke -gsave 10 dict begin -517 93 moveto 20 -0.5 (z12) alignedtext -end grestore -end grestore - -% z12 -> l1b1 -newpath 537 86 moveto -542 84 548 81 553 80 curveto -592 67 863 40 961 30 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 960 28 moveto -970 29 lineto -960 33 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% z12 -> l12 -newpath 491 94 moveto -410 82 170 45 80 31 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 82 34 moveto -72 30 lineto -82 29 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% wm34 -gsave 10 dict begin -221 98 32 18 ellipse_path -stroke -gsave 10 dict begin -221 93 moveto 43 -0.5 (wm34) alignedtext -end grestore -end grestore - -% wm34 -> u1b3 -newpath 238 83 moveto -250 73 265 59 278 47 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 276 46 moveto -285 41 lineto -279 49 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% wm34 -> d14 -newpath 250 91 moveto -266 87 286 83 303 80 curveto -465 53 663 35 740 29 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 737 27 moveto -747 28 lineto -737 32 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% a45 -gsave 10 dict begin -1072 98 27 18 ellipse_path -stroke -gsave 10 dict begin -1072 93 moveto 23 -0.5 (a45) alignedtext -end grestore -end grestore - -% a45 -> d14 -newpath 1047 92 moveto -993 79 868 49 808 34 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 809 37 moveto -800 32 lineto -810 32 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% a45 -> d1b5 -newpath 1092 86 moveto -1111 74 1140 56 1161 43 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1159 41 moveto -1169 38 lineto -1162 45 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% z45 -gsave 10 dict begin -1146 98 27 18 ellipse_path -stroke -gsave 10 dict begin -1146 93 moveto 23 -0.5 (z45) alignedtext -end grestore -end grestore - -% z45 -> d14 -newpath 1125 87 moveto -1119 84 1113 82 1108 80 curveto -1002 47 870 33 809 29 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 811 32 moveto -801 28 lineto -811 27 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% z45 -> d1b5 -newpath 1156 81 moveto -1161 72 1168 62 1174 51 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1172 50 moveto -1179 43 lineto -1176 53 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% a36 -gsave 10 dict begin -848 98 27 18 ellipse_path -stroke -gsave 10 dict begin -848 93 moveto 22 -0.5 (a36) alignedtext -end grestore -end grestore - -% a36 -> u1b3 -newpath 821 94 moveto -731 82 438 44 337 31 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 338 34 moveto -328 30 lineto -338 29 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% a36 -> u16 -newpath 869 86 moveto -875 84 880 82 886 80 curveto -1031 38 1074 63 1225 44 curveto -1255 40 1288 35 1312 31 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1310 29 moveto -1320 30 lineto -1310 34 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% z36 -gsave 10 dict begin -922 98 27 18 ellipse_path -stroke -gsave 10 dict begin -922 93 moveto 22 -0.5 (z36) alignedtext -end grestore -end grestore - -% z36 -> u1b3 -newpath 901 86 moveto -896 84 890 81 884 80 curveto -779 51 448 33 338 27 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 338 30 moveto -328 27 lineto -338 25 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% z36 -> u16 -newpath 948 94 moveto -1022 81 1231 45 1314 31 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1311 29 moveto -1321 30 lineto -1311 34 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% wp56 -gsave 10 dict begin -1390 98 29 18 ellipse_path -stroke -gsave 10 dict begin -1390 93 moveto 37 -0.5 (wp56) alignedtext -end grestore -end grestore - -% wp56 -> d1b5 -newpath 1365 89 moveto -1328 76 1261 52 1221 38 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1221 41 moveto -1213 35 lineto -1223 36 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% wp56 -> u16 -newpath 1380 81 moveto -1375 72 1368 62 1362 51 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1360 53 moveto -1357 43 lineto -1364 50 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% u1b123 -gsave 10 dict begin -390 170 32 18 ellipse_path -stroke -gsave 10 dict begin -390 165 moveto 43 -0.5 (u1b123) alignedtext -end grestore -end grestore - -% u1b123 -> u1b3 -newpath 376 154 moveto -357 129 326 79 310 50 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 309 54 moveto -307 44 lineto -314 52 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% u1b123 -> u1b3 -newpath 384 152 moveto -370 126 339 76 319 48 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 318 52 moveto -315 42 lineto -323 49 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% u1b123 -> a12 -newpath 414 158 moveto -420 156 426 154 431 152 curveto -484 132 500 136 553 116 curveto -556 115 559 113 562 112 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 558 111 moveto -568 109 lineto -560 116 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% u1b123 -> z12 -newpath 413 157 moveto -434 144 465 127 488 114 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 486 112 moveto -496 110 lineto -488 117 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% d1124 -gsave 10 dict begin -468 170 28 18 ellipse_path -stroke -gsave 10 dict begin -468 165 moveto 35 -0.5 (d1124) alignedtext -end grestore -end grestore - -% d1124 -> d14 -newpath 459 153 moveto -453 133 453 99 472 80 curveto -489 61 666 37 740 30 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 737 28 moveto -747 29 lineto -737 33 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% d1124 -> d14 -newpath 471 152 moveto -471 131 471 99 490 80 curveto -506 62 670 39 741 31 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 737 29 moveto -747 30 lineto -738 34 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% d1124 -> a12 -newpath 489 158 moveto -509 146 539 127 561 114 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 559 112 moveto -569 110 lineto -561 117 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% d1124 -> z12 -newpath 479 153 moveto -485 144 493 133 500 123 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 498 122 moveto -506 115 lineto -502 124 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% n1b134 -gsave 10 dict begin -308 170 32 18 ellipse_path -stroke -gsave 10 dict begin -308 165 moveto 43 -0.5 (n1b134) alignedtext -end grestore -end grestore - -% n1b134 -> l1b1 -newpath 328 156 moveto -360 136 422 98 481 80 curveto -621 37 663 58 810 44 curveto -874 37 890 33 956 28 curveto -957 28 959 28 960 28 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 960 26 moveto -970 27 lineto -960 30 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% n1b134 -> wm34 -newpath 290 155 moveto -277 145 260 130 246 119 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 245 121 moveto -239 113 lineto -248 118 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% d1b125 -gsave 10 dict begin -622 170 32 18 ellipse_path -stroke -gsave 10 dict begin -622 165 moveto 42 -0.5 (d1b125) alignedtext -end grestore -end grestore - -% d1b125 -> d1b5 -newpath 623 152 moveto -630 130 648 96 677 80 curveto -743 40 946 52 1024 44 curveto -1080 37 1094 33 1152 28 curveto -1152 28 1152 28 1152 28 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1152 26 moveto -1162 27 lineto -1152 30 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% d1b125 -> d1b5 -newpath 635 153 moveto -647 132 666 96 695 80 curveto -761 40 964 52 1042 44 curveto -1091 37 1109 34 1152 30 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1152 28 moveto -1162 29 lineto -1152 32 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% d1b125 -> a12 -newpath 614 152 moveto -610 144 605 134 601 125 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 599 126 moveto -597 116 lineto -603 124 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% d1b125 -> z12 -newpath 602 156 moveto -585 145 562 129 544 116 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 543 118 moveto -536 111 lineto -546 114 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% l1b145 -gsave 10 dict begin -1222 170 30 18 ellipse_path -stroke -gsave 10 dict begin -1222 165 moveto 38 -0.5 (l1b145) alignedtext -end grestore -end grestore - -% l1b145 -> l1b1 -newpath 1212 153 moveto -1205 132 1194 99 1173 80 curveto -1152 60 1077 43 1032 34 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1032 37 moveto -1023 32 lineto -1033 32 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% l1b145 -> l1b1 -newpath 1225 152 moveto -1223 131 1212 98 1191 80 curveto -1167 59 1079 40 1031 31 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1034 34 moveto -1024 30 lineto -1034 29 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% l1b145 -> a45 -newpath 1199 159 moveto -1173 146 1131 127 1103 113 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1102 115 moveto -1094 109 lineto -1104 111 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% l1b145 -> z45 -newpath 1206 155 moveto -1195 145 1181 131 1169 119 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1168 121 moveto -1162 113 lineto -1171 118 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% u1126 -gsave 10 dict begin -700 170 28 18 ellipse_path -stroke -gsave 10 dict begin -700 165 moveto 35 -0.5 (u1126) alignedtext -end grestore -end grestore - -% u1126 -> u16 -newpath 709 153 moveto -726 132 763 97 803 80 curveto -883 44 910 55 998 48 curveto -1021 45 1185 48 1208 44 curveto -1217 42 1218 38 1228 36 curveto -1260 27 1269 30 1303 28 curveto -1306 27 1309 27 1313 27 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1310 25 moveto -1320 27 lineto -1310 30 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% u1126 -> u16 -newpath 718 156 moveto -741 136 779 98 821 80 curveto -901 44 928 55 1016 48 curveto -1039 45 1203 48 1226 44 curveto -1235 42 1236 38 1246 36 curveto -1275 28 1285 30 1312 28 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1310 26 moveto -1320 28 lineto -1310 31 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% u1126 -> a12 -newpath 680 157 moveto -662 146 636 129 617 116 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 616 118 moveto -609 111 lineto -619 114 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% u1126 -> z12 -newpath 678 158 moveto -673 156 668 154 663 152 curveto -615 132 600 135 553 116 curveto -551 115 549 114 547 114 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 546 116 moveto -538 109 lineto -548 112 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% l1b136 -gsave 10 dict begin -997 170 29 18 ellipse_path -stroke -gsave 10 dict begin -997 165 moveto 37 -0.5 (l1b136) alignedtext -end grestore -end grestore - -% l1b136 -> l1b1 -newpath 992 152 moveto -989 127 989 82 991 53 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 988 54 moveto -992 44 lineto -993 54 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% l1b136 -> l1b1 -newpath 1002 152 moveto -1005 127 1005 82 1003 53 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1001 54 moveto -1002 44 lineto -1006 54 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% l1b136 -> a36 -newpath 974 159 moveto -949 146 907 127 879 113 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 878 115 moveto -870 109 lineto -880 111 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% l1b136 -> z36 -newpath 981 155 moveto -970 145 956 131 944 119 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 943 121 moveto -937 113 lineto -946 118 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -gsave 10 dict begin -848 242 27 18 ellipse_path -stroke -gsave 10 dict begin -848 237 moveto 6 -0.5 (*) alignedtext -end grestore -end grestore - -% * -> l12 -newpath 821 242 moveto -786 242 743 241 707 240 curveto -672 239 663 238 629 238 curveto -523 235 248 241 157 188 curveto -98 153 49 86 38 50 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 36 53 moveto -36 43 lineto -41 52 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> l12 -newpath 821 241 moveto -808 241 793 240 779 240 curveto -744 239 735 238 701 238 curveto -595 235 320 241 229 188 curveto -166 150 113 76 77 42 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 76 44 moveto -69 36 lineto -78 40 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> l12 -newpath 821 242 moveto -794 241 757 241 725 240 curveto -690 239 681 238 647 238 curveto -541 235 266 241 175 188 curveto -117 153 68 87 50 51 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 49 54 moveto -47 44 lineto -53 52 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> l12 -newpath 821 242 moveto -799 241 769 241 743 240 curveto -708 239 699 238 665 238 curveto -559 235 284 241 193 188 curveto -134 153 85 86 61 50 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 60 53 moveto -56 43 lineto -64 50 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> l12 -newpath 821 241 moveto -803 241 781 240 761 240 curveto -726 239 717 238 683 238 curveto -577 235 302 241 211 188 curveto -150 152 99 81 70 47 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 69 49 moveto -64 40 lineto -72 46 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> u1b3 -newpath 821 242 moveto -801 241 775 241 753 240 curveto -633 235 314 261 219 188 curveto -177 154 135 126 162 80 curveto -188 37 213 41 260 28 curveto -261 27 263 27 266 27 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 264 25 moveto -274 26 lineto -264 30 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> u1b3 -newpath 821 241 moveto -806 241 787 240 771 240 curveto -651 235 332 261 237 188 curveto -195 154 153 126 180 80 curveto -203 41 227 41 265 31 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 264 29 moveto -274 29 lineto -265 34 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> u1b3 -newpath 821 241 moveto -811 241 799 240 789 240 curveto -669 235 350 261 255 188 curveto -213 154 171 126 198 80 curveto -219 46 238 42 269 35 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 266 33 moveto -276 33 lineto -267 38 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> d14 -newpath 821 239 moveto -821 238 821 238 821 238 curveto -785 176 766 93 767 52 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 765 54 moveto -767 44 lineto -770 54 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> d14 -newpath 833 227 moveto -800 167 784 91 778 52 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 776 54 moveto -777 44 lineto -781 54 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> d14 -newpath 849 224 moveto -816 163 801 88 789 50 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 787 52 moveto -786 42 lineto -792 50 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> d1b5 -newpath 875 239 moveto -906 235 961 227 985 224 curveto -1084 210 1241 189 1243 188 curveto -1278 146 1229 84 1202 50 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1201 53 moveto -1197 43 lineto -1205 50 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> d1b5 -newpath 875 240 moveto -877 240 880 240 882 240 curveto -909 237 976 227 1003 224 curveto -1102 210 1259 189 1261 188 curveto -1297 145 1245 81 1212 48 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1210 50 moveto -1205 41 lineto -1214 46 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> d1b5 -newpath 875 241 moveto -884 241 892 240 900 240 curveto -927 237 994 227 1021 224 curveto -1120 210 1277 189 1279 188 curveto -1317 143 1258 75 1218 43 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1217 45 moveto -1210 37 lineto -1219 41 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> u16 -newpath 875 240 moveto -978 235 1333 217 1375 188 curveto -1416 159 1432 125 1410 80 curveto -1400 59 1390 49 1376 42 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1375 44 moveto -1367 38 lineto -1377 40 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> u16 -newpath 875 241 moveto -979 236 1350 217 1393 188 curveto -1434 159 1450 125 1428 80 curveto -1415 54 1403 45 1383 36 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1381 38 moveto -1373 32 lineto -1383 33 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> u16 -newpath 875 241 moveto -983 237 1367 218 1411 188 curveto -1452 159 1468 125 1446 80 curveto -1430 47 1415 42 1383 29 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1383 32 moveto -1374 27 lineto -1384 27 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> a12 -newpath 821 239 moveto -780 233 597 208 581 188 curveto -566 170 571 143 578 123 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 575 123 moveto -581 115 lineto -580 125 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> z12 -newpath 821 240 moveto -776 235 668 218 627 208 curveto -598 200 586 206 565 188 curveto -545 170 532 143 525 123 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 524 126 moveto -522 116 lineto -528 124 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> wm34 -newpath 821 242 moveto -802 241 783 241 767 240 curveto -753 239 750 239 737 238 curveto -626 229 332 251 240 188 curveto -218 172 206 143 206 122 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 204 124 moveto -206 114 lineto -209 124 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> wm34 -newpath 821 241 moveto -809 241 796 240 785 240 curveto -771 239 768 239 755 238 curveto -644 229 350 251 258 188 curveto -237 173 225 145 220 124 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 218 126 moveto -219 116 lineto -223 126 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> wm34 -newpath 821 241 moveto -815 241 809 240 803 240 curveto -789 239 786 239 773 238 curveto -662 229 368 251 276 188 curveto -255 173 243 144 234 123 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 232 125 moveto -231 115 lineto -237 123 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> wm34 -newpath 821 240 moveto -807 239 804 239 791 238 curveto -680 229 386 251 294 188 curveto -272 172 259 140 246 119 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 245 122 moveto -241 112 lineto -249 119 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> a45 -newpath 874 236 moveto -934 227 966 235 1017 188 curveto -1036 169 1046 141 1054 120 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1051 121 moveto -1057 113 lineto -1055 123 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> a45 -newpath 875 241 moveto -880 241 884 240 888 240 curveto -963 224 996 240 1053 188 curveto -1071 170 1081 143 1082 123 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1080 125 moveto -1082 115 lineto -1085 125 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> a45 -newpath 875 239 moveto -946 225 979 239 1035 188 curveto -1053 170 1062 144 1067 124 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1064 125 moveto -1069 116 lineto -1069 126 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> z45 -newpath 874 237 moveto -887 235 895 233 914 230 curveto -978 216 1002 225 1057 188 curveto -1084 169 1105 138 1122 117 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1119 117 moveto -1127 111 lineto -1123 120 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> z45 -newpath 875 241 moveto -881 241 886 240 891 240 curveto -917 236 923 235 950 230 curveto -1014 216 1038 225 1093 188 curveto -1117 171 1137 144 1146 123 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1143 124 moveto -1149 116 lineto -1147 126 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> z45 -newpath 875 240 moveto -899 236 906 235 932 230 curveto -996 216 1020 225 1075 188 curveto -1100 171 1120 142 1133 122 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1130 122 moveto -1137 115 lineto -1134 125 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> a36 -newpath 839 225 moveto -834 200 833 154 837 124 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 834 124 moveto -839 115 lineto -839 125 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> a36 -newpath 848 224 moveto -848 199 848 154 848 125 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 846 126 moveto -848 116 lineto -851 126 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> a36 -newpath 857 225 moveto -862 200 863 154 859 124 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 857 125 moveto -857 115 lineto -862 124 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> z36 -newpath 843 224 moveto -847 214 855 200 862 188 curveto -874 164 887 136 899 118 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 896 118 moveto -904 111 lineto -900 121 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> z36 -newpath 858 225 moveto -864 214 873 200 880 188 curveto -891 166 903 140 911 122 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 908 123 moveto -914 115 lineto -912 125 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> z36 -newpath 869 230 moveto -879 219 889 203 898 188 curveto -909 166 921 141 926 123 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 923 125 moveto -928 116 lineto -928 126 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> wp56 -newpath 875 239 moveto -895 236 904 235 930 232 curveto -1091 212 1155 273 1294 188 curveto -1321 170 1339 135 1359 114 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1357 113 moveto -1366 108 lineto -1360 116 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> wp56 -newpath 875 240 moveto -877 240 879 240 881 240 curveto -910 237 918 235 948 232 curveto -1109 212 1173 273 1312 188 curveto -1337 172 1354 140 1368 120 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1365 120 moveto -1373 113 lineto -1369 123 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> wp56 -newpath 875 241 moveto -883 241 891 240 899 240 curveto -928 237 936 235 966 232 curveto -1127 212 1191 273 1330 188 curveto -1354 173 1370 144 1380 123 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1377 124 moveto -1383 116 lineto -1381 126 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> wp56 -newpath 875 242 moveto -889 241 904 241 917 240 curveto -946 237 954 235 984 232 curveto -1145 212 1209 273 1348 188 curveto -1372 173 1388 144 1394 123 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1391 125 moveto -1396 116 lineto -1396 126 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> wp56 -newpath 875 242 moveto -899 241 918 241 935 240 curveto -964 237 972 235 1002 232 curveto -1163 212 1227 273 1366 188 curveto -1391 172 1408 141 1409 119 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1407 122 moveto -1408 112 lineto -1412 122 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> u1b123 -newpath 821 241 moveto -753 238 574 228 431 188 curveto -428 187 426 186 423 185 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 423 188 moveto -414 182 lineto -424 183 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> d1124 -newpath 821 240 moveto -763 235 623 220 510 188 curveto -506 187 503 186 500 184 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 500 187 moveto -491 181 lineto -501 182 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> n1b134 -newpath 821 240 moveto -730 234 439 212 349 188 curveto -346 187 342 185 339 184 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 341 187 moveto -332 182 lineto -342 182 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> d1b125 -newpath 822 236 moveto -786 226 719 208 663 188 curveto -661 187 659 186 656 185 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 655 187 moveto -647 181 lineto -657 183 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> l1b145 -newpath 875 240 moveto -932 234 1067 219 1178 188 curveto -1182 187 1187 185 1191 184 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1188 183 moveto -1198 181 lineto -1190 187 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> u1126 -newpath 826 231 moveto -801 218 759 199 731 185 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 730 187 moveto -722 181 lineto -732 183 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> l1b136 -newpath 870 231 moveto -896 219 939 198 968 184 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 964 183 moveto -974 181 lineto -966 188 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -endpage -grestore -%%PageTrailer -%%EndPage: 1 -%%Trailer -%%Pages: 1 -end -restore -%%EOF Index: branches/ohl/omega-development/completed/whizard2/web/epemudbardubar0.eps =================================================================== --- branches/ohl/omega-development/completed/whizard2/web/epemudbardubar0.eps (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/web/epemudbardubar0.eps (revision 8703) @@ -1,2189 +0,0 @@ -%!PS-Adobe-2.0 -%%Creator: dot version 1.8.5 (Wed Aug 21 14:41:12 CEST 2002) -%%For: (ohl) Thorsten Ohl,,5729,0931-3594666 -%%Title: OMEGA -%%Pages: (atend) -%%BoundingBox: 35 35 2087 305 -%%EndComments -save -%%BeginProlog -/DotDict 200 dict def -DotDict begin - -/setupLatin1 { -mark -/EncodingVector 256 array def - EncodingVector 0 - -ISOLatin1Encoding 0 255 getinterval putinterval - -EncodingVector - dup 306 /AE - dup 301 /Aacute - dup 302 /Acircumflex - dup 304 /Adieresis - dup 300 /Agrave - dup 305 /Aring - dup 303 /Atilde - dup 307 /Ccedilla - dup 311 /Eacute - dup 312 /Ecircumflex - dup 313 /Edieresis - dup 310 /Egrave - dup 315 /Iacute - dup 316 /Icircumflex - dup 317 /Idieresis - dup 314 /Igrave - dup 334 /Udieresis - dup 335 /Yacute - dup 376 /thorn - dup 337 /germandbls - dup 341 /aacute - dup 342 /acircumflex - dup 344 /adieresis - dup 346 /ae - dup 340 /agrave - dup 345 /aring - dup 347 /ccedilla - dup 351 /eacute - dup 352 /ecircumflex - dup 353 /edieresis - dup 350 /egrave - dup 355 /iacute - dup 356 /icircumflex - dup 357 /idieresis - dup 354 /igrave - dup 360 /dcroat - dup 361 /ntilde - dup 363 /oacute - dup 364 /ocircumflex - dup 366 /odieresis - dup 362 /ograve - dup 365 /otilde - dup 370 /oslash - dup 372 /uacute - dup 373 /ucircumflex - dup 374 /udieresis - dup 371 /ugrave - dup 375 /yacute - dup 377 /ydieresis - -% Set up ISO Latin 1 character encoding -/starnetISO { - dup dup findfont dup length dict begin - { 1 index /FID ne { def }{ pop pop } ifelse - } forall - /Encoding EncodingVector def - currentdict end definefont -} def -/Times-Roman starnetISO def -/Times-Italic starnetISO def -/Times-Bold starnetISO def -/Times-BoldItalic starnetISO def -/Helvetica starnetISO def -/Helvetica-Oblique starnetISO def -/Helvetica-Bold starnetISO def -/Helvetica-BoldOblique starnetISO def -/Courier starnetISO def -/Courier-Oblique starnetISO def -/Courier-Bold starnetISO def -/Courier-BoldOblique starnetISO def -cleartomark -} bind def - -%%BeginResource: procset -/coord-font-family /Times-Roman def -/default-font-family /Times-Roman def -/coordfont coord-font-family findfont 8 scalefont def - -/InvScaleFactor 1.0 def -/set_scale { - dup 1 exch div /InvScaleFactor exch def - dup scale -} bind def - -% styles -/solid { } bind def -/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def -/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def -/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def -/bold { 2 setlinewidth } bind def -/filled { } bind def -/unfilled { } bind def -/rounded { } bind def -/diagonals { } bind def - -% hooks for setting color -/nodecolor { sethsbcolor } bind def -/edgecolor { sethsbcolor } bind def -/graphcolor { sethsbcolor } bind def -/nopcolor {pop pop pop} bind def - -/beginpage { % i j npages - /npages exch def - /j exch def - /i exch def - /str 10 string def - npages 1 gt { - gsave - coordfont setfont - 0 0 moveto - (\() show i str cvs show (,) show j str cvs show (\)) show - grestore - } if -} bind def - -/set_font { - findfont exch - scalefont setfont -} def - -% draw aligned label in bounding box aligned to current point -/alignedtext { % width adj text - /text exch def - /adj exch def - /width exch def - gsave - width 0 gt { - text stringwidth pop adj mul 0 rmoveto - } if - [] 0 setdash - text show - grestore -} def - -/boxprim { % xcorner ycorner xsize ysize - 4 2 roll - moveto - 2 copy - exch 0 rlineto - 0 exch rlineto - pop neg 0 rlineto - closepath -} bind def - -/ellipse_path { - /ry exch def - /rx exch def - /y exch def - /x exch def - matrix currentmatrix - newpath - x y translate - rx ry scale - 0 0 1 0 360 arc - setmatrix -} bind def - -/endpage { showpage } bind def - -/layercolorseq - [ % layer color sequence - darkest to lightest - [0 0 0] - [.2 .8 .8] - [.4 .8 .8] - [.6 .8 .8] - [.8 .8 .8] - ] -def - -/setlayer {/maxlayer exch def /curlayer exch def - layercolorseq curlayer get - aload pop sethsbcolor - /nodecolor {nopcolor} def - /edgecolor {nopcolor} def - /graphcolor {nopcolor} def -} bind def - -/onlayer { curlayer ne {invis} if } def - -/onlayers { - /myupper exch def - /mylower exch def - curlayer mylower lt - curlayer myupper gt - or - {invis} if -} def - -/curlayer 0 def - -%%EndResource -%%EndProlog -%%BeginSetup -14 default-font-family set_font -1 setmiterlimit -% /arrowlength 10 def -% /arrowwidth 5 def - -% make sure pdfmark is harmless for PS-interpreters other than Distiller -/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse -% make '<<' and '>>' safe on PS Level 1 devices -/languagelevel where {pop languagelevel}{1} ifelse -2 lt { - userdict (<<) cvn ([) cvn load put - userdict (>>) cvn ([) cvn load put -} if - -%%EndSetup -%%Page: 1 1 -%%PageBoundingBox: 36 36 2087 305 -%%PageOrientation: Portrait -gsave -35 35 2052 270 boxprim clip newpath -36 36 translate -0 0 1 beginpage -0 0 translate 0 rotate -0.000 0.000 0.000 graphcolor -14.00 /Times-Roman set_font - -% l1b1 -gsave 10 dict begin -1046 26 27 18 ellipse_path -stroke -gsave 10 dict begin -1046 21 moveto 22 -0.5 (l1b1) alignedtext -end grestore -end grestore - -% l12 -gsave 10 dict begin -1645 26 27 18 ellipse_path -stroke -gsave 10 dict begin -1645 21 moveto 17 -0.5 (l12) alignedtext -end grestore -end grestore - -% u1b3 -gsave 10 dict begin -464 26 27 18 ellipse_path -stroke -gsave 10 dict begin -464 21 moveto 30 -0.5 (u1b3) alignedtext -end grestore -end grestore - -% d14 -gsave 10 dict begin -536 26 27 18 ellipse_path -stroke -gsave 10 dict begin -536 21 moveto 22 -0.5 (d14) alignedtext -end grestore -end grestore - -% d1b5 -gsave 10 dict begin -1356 26 27 18 ellipse_path -stroke -gsave 10 dict begin -1356 21 moveto 29 -0.5 (d1b5) alignedtext -end grestore -end grestore - -% u16 -gsave 10 dict begin -1225 26 27 18 ellipse_path -stroke -gsave 10 dict begin -1225 21 moveto 22 -0.5 (u16) alignedtext -end grestore -end grestore - -% a12 -gsave 10 dict begin -1609 98 27 18 ellipse_path -stroke -gsave 10 dict begin -1609 93 moveto 20 -0.5 (a12) alignedtext -end grestore -end grestore - -% a12 -> l1b1 -newpath 1583 92 moveto -1566 88 1542 83 1521 80 curveto -1374 57 1336 61 1189 44 curveto -1152 40 1110 34 1082 30 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1083 33 moveto -1073 29 lineto -1083 28 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% a12 -> l12 -newpath 1618 81 moveto -1622 72 1627 62 1632 52 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1630 51 moveto -1636 43 lineto -1634 53 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% z12 -gsave 10 dict begin -1681 98 27 18 ellipse_path -stroke -gsave 10 dict begin -1681 93 moveto 20 -0.5 (z12) alignedtext -end grestore -end grestore - -% z12 -> l1b1 -newpath 1661 86 moveto -1656 83 1650 81 1645 80 curveto -1449 25 1391 64 1189 44 curveto -1152 40 1110 34 1082 31 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1083 34 moveto -1073 30 lineto -1083 29 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% z12 -> l12 -newpath 1672 81 moveto -1668 72 1663 62 1658 52 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1656 53 moveto -1654 43 lineto -1660 51 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% wm34 -gsave 10 dict begin -284 98 32 18 ellipse_path -stroke -gsave 10 dict begin -284 93 moveto 43 -0.5 (wm34) alignedtext -end grestore -end grestore - -% wm34 -> u1b3 -newpath 310 88 moveto -343 75 399 52 434 38 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 431 37 moveto -441 35 lineto -433 41 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% wm34 -> d14 -newpath 315 92 moveto -357 84 436 68 500 44 curveto -502 43 504 42 506 42 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 505 40 moveto -515 37 lineto -507 44 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% a45 -gsave 10 dict begin -910 98 27 18 ellipse_path -stroke -gsave 10 dict begin -910 93 moveto 23 -0.5 (a45) alignedtext -end grestore -end grestore - -% a45 -> d14 -newpath 884 92 moveto -869 88 849 84 831 80 curveto -736 61 624 41 569 31 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 572 34 moveto -562 30 lineto -572 29 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% a45 -> d1b5 -newpath 930 86 moveto -935 84 941 81 946 80 curveto -1081 39 1121 65 1261 44 curveto -1281 41 1303 36 1321 33 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1320 31 moveto -1330 31 lineto -1321 36 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% z45 -gsave 10 dict begin -982 98 27 18 ellipse_path -stroke -gsave 10 dict begin -982 93 moveto 23 -0.5 (z45) alignedtext -end grestore -end grestore - -% z45 -> d14 -newpath 962 86 moveto -957 84 951 82 946 80 curveto -812 39 646 29 573 26 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 573 29 moveto -563 26 lineto -573 24 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% z45 -> d1b5 -newpath 1008 93 moveto -1075 80 1250 46 1324 32 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1320 30 moveto -1330 31 lineto -1321 35 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% a36 -gsave 10 dict begin -500 98 27 18 ellipse_path -stroke -gsave 10 dict begin -500 93 moveto 22 -0.5 (a36) alignedtext -end grestore -end grestore - -% a36 -> u1b3 -newpath 491 81 moveto -487 72 482 62 477 52 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 475 53 moveto -473 43 lineto -479 51 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% a36 -> u16 -newpath 527 95 moveto -561 91 621 85 673 80 curveto -854 62 900 63 1082 44 curveto -1119 40 1164 34 1193 31 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1189 29 moveto -1199 30 lineto -1190 34 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% z36 -gsave 10 dict begin -428 98 27 18 ellipse_path -stroke -gsave 10 dict begin -428 93 moveto 22 -0.5 (z36) alignedtext -end grestore -end grestore - -% z36 -> u1b3 -newpath 437 81 moveto -441 72 446 62 451 52 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 449 51 moveto -455 43 lineto -453 53 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% z36 -> u16 -newpath 448 86 moveto -453 83 459 81 464 80 curveto -596 44 945 56 1082 44 curveto -1119 40 1164 35 1193 31 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1189 29 moveto -1199 30 lineto -1190 34 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% wp56 -gsave 10 dict begin -1356 98 29 18 ellipse_path -stroke -gsave 10 dict begin -1356 93 moveto 37 -0.5 (wp56) alignedtext -end grestore -end grestore - -% wp56 -> d1b5 -newpath 1356 80 moveto -1356 72 1356 63 1356 54 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1354 54 moveto -1356 44 lineto -1359 54 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% wp56 -> u16 -newpath 1334 86 moveto -1312 73 1278 55 1254 42 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1254 45 moveto -1246 38 lineto -1256 40 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% u1b123 -gsave 10 dict begin -1528 170 32 18 ellipse_path -stroke -gsave 10 dict begin -1528 165 moveto 43 -0.5 (u1b123) alignedtext -end grestore -end grestore - -% u1b123 -> u1b3 -newpath 1508 156 moveto -1481 135 1434 96 1385 80 curveto -1197 18 682 117 499 44 curveto -497 43 496 42 495 41 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 494 43 moveto -489 34 lineto -497 40 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% u1b123 -> u1b3 -newpath 1516 153 moveto -1495 132 1449 95 1403 80 curveto -1215 18 700 117 517 44 curveto -508 39 508 32 499 29 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 500 32 moveto -491 27 lineto -501 27 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% u1b123 -> a12 -newpath 1545 155 moveto -1557 145 1573 130 1586 119 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1584 118 moveto -1593 113 lineto -1587 121 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% u1b123 -> z12 -newpath 1553 158 moveto -1577 147 1613 131 1645 116 curveto -1647 115 1649 114 1650 114 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1649 112 moveto -1659 109 lineto -1651 116 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% d1124 -gsave 10 dict begin -1606 170 28 18 ellipse_path -stroke -gsave 10 dict begin -1606 165 moveto 35 -0.5 (d1124) alignedtext -end grestore -end grestore - -% d1124 -> d14 -newpath 1585 158 moveto -1555 137 1498 97 1443 80 curveto -1255 20 1196 65 1001 44 curveto -950 38 938 31 888 28 curveto -872 26 656 26 570 26 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 573 29 moveto -563 26 lineto -573 24 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% d1124 -> d14 -newpath 1592 154 moveto -1567 133 1513 96 1461 80 curveto -1273 20 1214 65 1019 44 curveto -968 38 956 31 906 28 curveto -889 26 660 26 571 26 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 573 29 moveto -563 26 lineto -573 24 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% d1124 -> a12 -newpath 1607 152 moveto -1608 144 1608 135 1608 126 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1606 126 moveto -1608 116 lineto -1611 126 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% d1124 -> z12 -newpath 1622 155 moveto -1633 145 1647 131 1659 119 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1657 118 moveto -1666 113 lineto -1660 121 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% n1b134 -gsave 10 dict begin -422 170 32 18 ellipse_path -stroke -gsave 10 dict begin -422 165 moveto 43 -0.5 (n1b134) alignedtext -end grestore -end grestore - -% n1b134 -> l1b1 -newpath 447 158 moveto -496 134 606 82 615 80 curveto -744 38 782 46 918 34 curveto -949 30 957 29 989 28 curveto -996 27 1002 27 1009 27 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1009 25 moveto -1019 26 lineto -1009 29 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% n1b134 -> wm34 -newpath 398 158 moveto -375 146 341 128 316 114 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 316 117 moveto -308 110 lineto -318 112 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% d1b125 -gsave 10 dict begin -1834 170 32 18 ellipse_path -stroke -gsave 10 dict begin -1834 165 moveto 42 -0.5 (d1b125) alignedtext -end grestore -end grestore - -% d1b125 -> d1b5 -newpath 1821 153 moveto -1809 132 1791 97 1763 80 curveto -1731 60 1484 37 1391 30 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1393 33 moveto -1383 29 lineto -1393 28 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% d1b125 -> d1b5 -newpath 1833 152 moveto -1827 131 1808 97 1781 80 curveto -1748 60 1487 36 1391 29 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1393 32 moveto -1383 28 lineto -1393 27 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% d1b125 -> a12 -newpath 1809 158 moveto -1804 156 1798 154 1793 152 curveto -1728 130 1708 139 1645 116 curveto -1643 115 1641 114 1639 114 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1638 116 moveto -1630 109 lineto -1640 112 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% d1b125 -> z12 -newpath 1809 158 moveto -1783 145 1741 126 1712 113 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1711 115 moveto -1703 109 lineto -1713 111 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% l1b145 -gsave 10 dict begin -1040 170 30 18 ellipse_path -stroke -gsave 10 dict begin -1040 165 moveto 38 -0.5 (l1b145) alignedtext -end grestore -end grestore - -% l1b145 -> l1b1 -newpath 1036 152 moveto -1035 127 1037 82 1040 53 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1037 54 moveto -1041 44 lineto -1042 54 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% l1b145 -> l1b1 -newpath 1045 152 moveto -1049 127 1051 82 1050 53 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1048 54 moveto -1050 44 lineto -1053 54 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% l1b145 -> a45 -newpath 1018 158 moveto -996 145 963 127 939 114 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 939 117 moveto -931 110 lineto -941 112 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% l1b145 -> z45 -newpath 1027 154 moveto -1020 144 1010 132 1001 121 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1000 123 moveto -995 114 lineto -1003 120 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% l1245 -gsave 10 dict begin -1191 170 27 18 ellipse_path -stroke -gsave 10 dict begin -1191 165 moveto 32 -0.5 (l1245) alignedtext -end grestore -end grestore - -% l1245 -> l12 -newpath 1203 153 moveto -1223 132 1266 98 1309 80 curveto -1431 28 1470 43 1602 28 curveto -1604 28 1606 27 1608 27 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1608 25 moveto -1618 27 lineto -1608 30 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% l1245 -> l12 -newpath 1210 157 moveto -1236 137 1281 99 1327 80 curveto -1446 29 1486 42 1610 29 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1608 27 moveto -1618 28 lineto -1608 32 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% l1245 -> a45 -newpath 1170 158 moveto -1165 156 1160 154 1155 152 curveto -1065 122 1035 145 946 116 curveto -944 115 942 114 940 114 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 939 116 moveto -931 110 lineto -941 112 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% l1245 -> z45 -newpath 1170 158 moveto -1165 156 1160 154 1155 152 curveto -1107 132 1049 115 1014 106 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1016 109 moveto -1007 104 lineto -1017 104 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% u1b345 -gsave 10 dict begin -811 170 33 18 ellipse_path -stroke -gsave 10 dict begin -811 165 moveto 45 -0.5 (u1b345) alignedtext -end grestore -end grestore - -% u1b345 -> u1b3 -newpath 784 159 moveto -777 155 769 151 762 148 curveto -705 121 553 76 499 44 curveto -498 43 496 42 495 41 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 494 43 moveto -489 34 lineto -497 40 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% u1b345 -> u1b3 -newpath 793 155 moveto -789 152 784 150 780 148 curveto -723 121 571 76 517 44 curveto -508 38 508 31 499 29 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 500 32 moveto -491 27 lineto -501 27 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% u1b345 -> d1b5 -newpath 818 152 moveto -827 131 846 97 874 80 curveto -946 34 978 56 1063 48 curveto -1105 44 1211 50 1253 44 curveto -1262 42 1264 40 1273 38 curveto -1294 32 1299 30 1320 28 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1319 26 moveto -1329 27 lineto -1319 31 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% u1b345 -> wm34 -newpath 786 158 moveto -781 156 775 153 769 152 curveto -605 110 559 137 392 116 curveto -369 113 344 108 323 105 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 324 108 moveto -315 103 lineto -325 103 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% u1b345 -> a45 -newpath 831 155 moveto -847 144 867 129 884 116 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 881 115 moveto -891 111 lineto -884 119 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% u1b345 -> z45 -newpath 838 160 moveto -866 149 909 132 946 116 curveto -948 115 950 114 951 114 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 950 112 moveto -960 109 lineto -952 116 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% u1126 -gsave 10 dict begin -1756 170 28 18 ellipse_path -stroke -gsave 10 dict begin -1756 165 moveto 35 -0.5 (u1126) alignedtext -end grestore -end grestore - -% u1126 -> u16 -newpath 1747 153 moveto -1741 132 1732 97 1708 80 curveto -1636 28 1398 58 1311 44 curveto -1286 40 1277 34 1259 30 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1262 33 moveto -1252 29 lineto -1262 28 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% u1126 -> u16 -newpath 1760 152 moveto -1759 131 1749 97 1726 80 curveto -1654 28 1416 58 1329 44 curveto -1299 39 1292 32 1263 28 curveto -1263 28 1262 28 1262 28 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1262 30 moveto -1252 27 lineto -1262 26 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% u1126 -> a12 -newpath 1733 159 moveto -1711 148 1675 131 1645 116 curveto -1643 115 1641 114 1640 114 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1639 116 moveto -1631 109 lineto -1641 112 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% u1126 -> z12 -newpath 1740 155 moveto -1729 145 1715 131 1703 119 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1702 121 moveto -1696 113 lineto -1705 118 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% l1b136 -gsave 10 dict begin -575 170 29 18 ellipse_path -stroke -gsave 10 dict begin -575 165 moveto 37 -0.5 (l1b136) alignedtext -end grestore -end grestore - -% l1b136 -> l1b1 -newpath 582 152 moveto -596 131 628 97 664 80 curveto -724 51 929 34 1012 28 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1009 26 moveto -1019 28 lineto -1009 31 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% l1b136 -> l1b1 -newpath 592 155 moveto -611 135 644 97 682 80 curveto -740 52 933 35 1012 29 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1009 27 moveto -1019 28 lineto -1009 32 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% l1b136 -> a36 -newpath 559 155 moveto -548 145 534 131 522 119 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 521 121 moveto -515 113 lineto -524 118 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% l1b136 -> z36 -newpath 552 159 moveto -530 148 495 131 464 116 curveto -462 115 460 114 459 114 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 458 116 moveto -450 109 lineto -460 112 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% l1236 -gsave 10 dict begin -733 170 27 18 ellipse_path -stroke -gsave 10 dict begin -733 165 moveto 32 -0.5 (l1236) alignedtext -end grestore -end grestore - -% l1236 -> l12 -newpath 745 154 moveto -768 132 816 96 865 80 curveto -1084 8 1154 72 1383 44 curveto -1395 42 1425 36 1438 34 curveto -1443 33 1444 32 1450 32 curveto -1468 29 1472 28 1491 28 curveto -1512 27 1571 26 1610 26 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1608 24 moveto -1618 26 lineto -1608 29 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% l1236 -> l12 -newpath 753 157 moveto -780 137 831 97 883 80 curveto -1102 8 1172 72 1401 44 curveto -1413 42 1443 36 1456 34 curveto -1461 33 1462 32 1468 32 curveto -1486 29 1490 28 1509 28 curveto -1529 27 1577 26 1611 26 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1608 24 moveto -1618 26 lineto -1608 29 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% l1236 -> a36 -newpath 712 158 moveto -707 156 702 154 697 152 curveto -641 131 574 114 534 105 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 535 108 moveto -526 103 lineto -536 103 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% l1236 -> z36 -newpath 713 158 moveto -708 156 702 154 697 152 curveto -597 120 564 147 464 116 curveto -461 115 458 114 455 112 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 458 116 moveto -449 110 lineto -459 111 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% d1346 -gsave 10 dict begin -177 170 29 18 ellipse_path -stroke -gsave 10 dict begin -177 165 moveto 37 -0.5 (d1346) alignedtext -end grestore -end grestore - -% d1346 -> d14 -newpath 172 152 moveto -172 131 179 97 201 80 curveto -214 69 475 51 489 44 curveto -497 40 495 34 501 30 curveto -501 30 501 30 501 30 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 499 28 moveto -509 27 lineto -501 33 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% d1346 -> d14 -newpath 185 153 moveto -190 132 197 97 219 80 curveto -232 69 486 51 506 44 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 505 42 moveto -514 37 lineto -508 45 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% d1346 -> u16 -newpath 189 153 moveto -207 128 239 81 243 80 curveto -324 35 981 50 1074 44 curveto -1086 43 1090 41 1103 40 curveto -1141 34 1151 31 1189 28 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1188 26 moveto -1198 27 lineto -1188 31 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% d1346 -> wm34 -newpath 197 157 moveto -214 146 237 130 256 117 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 254 115 moveto -264 112 lineto -257 119 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% d1346 -> a36 -newpath 206 167 moveto -258 162 372 147 464 116 curveto -466 115 468 114 470 114 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 469 112 moveto -479 110 lineto -471 116 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% d1346 -> z36 -newpath 203 162 moveto -250 149 347 122 396 107 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 393 105 moveto -403 105 lineto -394 110 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% n1256 -gsave 10 dict begin -1449 170 29 18 ellipse_path -stroke -gsave 10 dict begin -1449 165 moveto 37 -0.5 (n1256) alignedtext -end grestore -end grestore - -% n1256 -> l12 -newpath 1464 154 moveto -1490 127 1548 70 1611 37 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1610 35 moveto -1620 33 lineto -1612 39 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% n1256 -> wp56 -newpath 1431 156 moveto -1417 145 1398 130 1381 118 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1380 120 moveto -1374 112 lineto -1383 117 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% d1b356 -gsave 10 dict begin -655 170 33 18 ellipse_path -stroke -gsave 10 dict begin -655 165 moveto 44 -0.5 (d1b356) alignedtext -end grestore -end grestore - -% d1b356 -> u1b3 -newpath 636 155 moveto -602 126 529 66 495 40 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 495 43 moveto -488 35 lineto -498 39 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% d1b356 -> d1b5 -newpath 658 152 moveto -667 131 690 97 720 80 curveto -798 35 830 55 920 48 curveto -937 46 1226 49 1244 44 curveto -1253 41 1254 34 1264 32 curveto -1279 27 1283 29 1300 28 curveto -1307 27 1314 27 1322 27 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1319 25 moveto -1329 26 lineto -1319 30 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% d1b356 -> d1b5 -newpath 669 154 moveto -684 133 707 97 738 80 curveto -816 35 848 55 938 48 curveto -955 46 1244 49 1262 44 curveto -1271 41 1272 34 1282 32 curveto -1297 27 1301 29 1318 28 curveto -1319 28 1321 28 1322 28 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1319 26 moveto -1329 27 lineto -1319 31 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% d1b356 -> a36 -newpath 630 158 moveto -602 145 557 125 528 111 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 530 115 moveto -522 108 lineto -532 110 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% d1b356 -> z36 -newpath 630 158 moveto -624 156 618 154 613 152 curveto -549 130 528 139 464 116 curveto -461 115 458 113 455 112 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 457 116 moveto -449 109 lineto -459 111 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% d1b356 -> wp56 -newpath 679 158 moveto -685 155 691 153 697 152 curveto -758 136 1190 108 1320 100 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1317 98 moveto -1327 100 lineto -1317 103 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% u1456 -gsave 10 dict begin -1117 170 29 18 ellipse_path -stroke -gsave 10 dict begin -1117 165 moveto 37 -0.5 (u1456) alignedtext -end grestore -end grestore - -% u1456 -> d14 -newpath 1104 153 moveto -1087 132 1054 97 1018 80 curveto -866 7 811 36 643 28 curveto -630 27 598 26 573 26 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 573 29 moveto -563 26 lineto -573 24 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% u1456 -> u16 -newpath 1125 153 moveto -1143 126 1181 75 1205 47 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1202 47 moveto -1210 41 lineto -1206 50 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% u1456 -> u16 -newpath 1133 155 moveto -1154 130 1192 79 1213 49 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1209 50 moveto -1217 43 lineto -1214 53 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% u1456 -> a45 -newpath 1095 158 moveto -1089 156 1084 154 1079 152 curveto -1021 130 1003 137 946 116 curveto -944 115 942 114 940 114 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 939 116 moveto -931 109 lineto -941 112 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% u1456 -> z45 -newpath 1095 158 moveto -1072 146 1036 127 1011 114 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1011 117 moveto -1003 110 lineto -1013 112 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% u1456 -> wp56 -newpath 1139 158 moveto -1144 156 1150 154 1155 152 curveto -1211 131 1279 114 1320 106 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1318 104 moveto -1328 104 lineto -1319 109 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -gsave 10 dict begin -964 242 27 18 ellipse_path -stroke -gsave 10 dict begin -964 237 moveto 6 -0.5 (*) alignedtext -end grestore -end grestore - -% * -> l12 -newpath 991 242 moveto -1042 241 1145 241 1233 240 curveto -1304 239 1828 243 1874 188 curveto -1903 151 1836 83 1832 80 curveto -1807 61 1728 45 1680 35 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1679 37 moveto -1670 33 lineto -1680 33 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> l12 -newpath 991 242 moveto -1054 242 1191 241 1305 240 curveto -1376 239 1900 243 1946 188 curveto -1975 151 1908 83 1904 80 curveto -1871 55 1747 35 1681 29 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1682 32 moveto -1672 28 lineto -1682 27 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> l12 -newpath 991 242 moveto -1043 241 1155 241 1251 240 curveto -1322 239 1846 243 1892 188 curveto -1921 151 1854 83 1850 80 curveto -1822 59 1729 42 1678 32 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1681 35 moveto -1671 31 lineto -1681 30 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> l12 -newpath 991 242 moveto -1045 242 1166 241 1269 240 curveto -1340 239 1864 243 1910 188 curveto -1939 151 1872 83 1868 80 curveto -1838 57 1734 39 1679 31 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1682 34 moveto -1672 30 lineto -1682 29 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> l12 -newpath 991 242 moveto -1048 242 1178 241 1287 240 curveto -1358 239 1882 243 1928 188 curveto -1957 151 1890 83 1886 80 curveto -1854 56 1740 37 1680 30 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1682 33 moveto -1672 29 lineto -1682 28 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> u1b3 -newpath 937 242 moveto -887 242 784 241 698 240 curveto -632 239 141 248 107 192 curveto -93 167 125 83 128 80 curveto -170 41 347 30 427 27 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 427 25 moveto -437 27 lineto -427 30 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> u1b3 -newpath 937 242 moveto -891 241 796 241 716 240 curveto -650 239 159 248 125 192 curveto -111 167 143 83 146 80 curveto -187 43 352 31 427 27 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 427 25 moveto -437 27 lineto -427 30 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> u1b3 -newpath 937 242 moveto -893 241 807 241 734 240 curveto -668 239 177 248 143 192 curveto -129 167 161 83 164 80 curveto -203 44 356 32 428 28 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 427 26 moveto -437 27 lineto -427 31 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> d14 -newpath 937 242 moveto -895 242 817 241 752 240 curveto -681 238 169 240 121 188 curveto -89 151 156 86 165 80 curveto -193 61 206 72 238 68 curveto -289 61 302 61 353 56 curveto -357 55 471 45 474 44 curveto -485 39 484 31 495 28 curveto -496 27 498 27 501 27 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 499 25 moveto -509 26 lineto -499 30 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> d14 -newpath 937 242 moveto -899 241 829 241 770 240 curveto -699 238 187 240 139 188 curveto -107 151 174 86 183 80 curveto -211 61 224 72 256 68 curveto -307 61 320 61 371 56 curveto -375 55 489 45 492 44 curveto -498 42 501 38 503 35 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 500 34 moveto -509 29 lineto -504 38 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> d14 -newpath 937 242 moveto -902 241 841 241 788 240 curveto -717 238 205 240 157 188 curveto -125 151 192 86 201 80 curveto -229 61 242 72 274 68 curveto -325 61 338 61 389 56 curveto -393 55 497 46 509 44 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 507 42 moveto -517 39 lineto -510 46 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> d1b5 -newpath 991 242 moveto -1024 241 1080 241 1129 240 curveto -1210 238 1802 248 1857 188 curveto -1898 141 1809 89 1794 80 curveto -1751 55 1734 68 1686 60 curveto -1555 35 1518 36 1391 28 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1393 31 moveto -1383 28 lineto -1393 26 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> d1b5 -newpath 991 242 moveto -1027 241 1091 241 1147 240 curveto -1228 238 1820 248 1875 188 curveto -1916 141 1827 89 1812 80 curveto -1769 55 1752 68 1704 60 curveto -1570 35 1535 36 1400 28 curveto -1398 28 1396 27 1393 27 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1393 30 moveto -1383 27 lineto -1393 25 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> d1b5 -newpath 991 242 moveto -1031 242 1103 241 1165 240 curveto -1246 238 1838 248 1893 188 curveto -1934 141 1845 89 1830 80 curveto -1787 55 1770 68 1722 60 curveto -1588 35 1553 36 1418 28 curveto -1410 27 1402 27 1393 26 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1393 29 moveto -1383 26 lineto -1393 24 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> u16 -newpath 988 233 moveto -1023 226 1201 196 1209 188 curveto -1241 149 1227 86 1222 51 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1220 54 moveto -1221 44 lineto -1225 54 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> u16 -newpath 990 236 moveto -992 236 995 235 1000 234 curveto -1012 231 1218 197 1227 188 curveto -1259 149 1245 85 1234 51 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1232 54 moveto -1232 44 lineto -1237 53 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> u16 -newpath 991 241 moveto -993 240 994 240 995 240 curveto -1005 237 1007 236 1018 234 curveto -1030 231 1236 197 1245 188 curveto -1278 148 1262 82 1245 48 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1244 51 moveto -1241 41 lineto -1248 48 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> a12 -newpath 991 241 moveto -1005 241 1024 240 1040 240 curveto -1056 239 1061 238 1078 238 curveto -1146 234 1163 234 1232 230 curveto -1299 226 1316 226 1383 220 curveto -1427 215 1438 213 1482 208 curveto -1499 205 1631 201 1643 188 curveto -1660 168 1644 140 1629 121 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1628 124 moveto -1624 114 lineto -1632 121 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> z12 -newpath 991 241 moveto -1009 241 1033 241 1055 240 curveto -1060 239 1253 230 1259 230 curveto -1303 227 1314 227 1358 224 curveto -1408 220 1535 209 1586 204 curveto -1598 202 1601 202 1614 200 curveto -1633 196 1643 202 1657 188 curveto -1673 171 1679 144 1680 124 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1677 126 moveto -1681 116 lineto -1682 126 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> wm34 -newpath 937 242 moveto -904 242 856 241 816 240 curveto -623 236 571 252 384 208 curveto -364 203 355 206 339 192 curveto -315 170 291 142 281 122 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 280 126 moveto -278 116 lineto -285 124 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> wm34 -newpath 937 242 moveto -910 241 869 241 834 240 curveto -641 236 589 252 402 208 curveto -382 203 373 206 357 192 curveto -333 170 309 142 295 122 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 294 126 moveto -291 116 lineto -299 123 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> wm34 -newpath 937 241 moveto -914 241 881 241 852 240 curveto -659 236 607 252 420 208 curveto -400 203 391 206 375 192 curveto -350 170 325 140 308 119 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 307 122 moveto -302 113 lineto -311 118 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> wm34 -newpath 937 241 moveto -917 241 892 240 870 240 curveto -677 236 625 252 438 208 curveto -418 203 409 206 393 192 curveto -366 168 340 135 317 116 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 316 118 moveto -309 110 lineto -318 114 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> a45 -newpath 937 238 moveto -906 207 897 156 899 125 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 897 125 moveto -900 115 lineto -901 125 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> a45 -newpath 962 224 moveto -940 192 931 149 923 123 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 921 125 moveto -921 115 lineto -926 124 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> a45 -newpath 947 228 moveto -923 197 915 153 912 125 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 910 126 moveto -911 116 lineto -915 126 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> z45 -newpath 957 224 moveto -955 199 961 153 968 123 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 965 123 moveto -971 114 lineto -970 124 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> z45 -newpath 975 225 moveto -983 201 990 155 989 125 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 987 126 moveto -989 116 lineto -992 126 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> z45 -newpath 966 224 moveto -970 199 975 154 979 125 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 976 126 moveto -980 116 lineto -981 126 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> a36 -newpath 937 242 moveto -924 241 910 241 899 240 curveto -877 238 872 237 851 236 curveto -813 232 549 211 519 188 curveto -500 172 490 143 490 123 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 488 125 moveto -490 115 lineto -493 125 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> a36 -newpath 937 241 moveto -930 241 923 240 917 240 curveto -895 238 890 237 869 236 curveto -831 232 567 211 537 188 curveto -518 172 508 145 504 124 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 502 126 moveto -502 116 lineto -507 125 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> a36 -newpath 937 240 moveto -936 240 936 240 935 240 curveto -913 238 908 237 887 236 curveto -849 232 585 211 555 188 curveto -535 171 525 142 517 121 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 515 123 moveto -514 113 lineto -520 121 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> z36 -newpath 937 242 moveto -824 240 402 230 363 188 curveto -343 166 371 132 397 114 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 395 112 moveto -405 108 lineto -399 116 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> z36 -newpath 937 242 moveto -827 240 419 229 381 188 curveto -363 167 385 138 405 118 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 402 117 moveto -411 112 lineto -406 121 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> z36 -newpath 937 241 moveto -828 239 436 229 399 188 curveto -382 168 401 141 416 122 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 413 122 moveto -421 115 lineto -417 125 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> wp56 -newpath 990 236 moveto -1060 226 1236 203 1260 188 curveto -1287 170 1305 135 1325 114 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1323 113 moveto -1332 108 lineto -1326 116 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> wp56 -newpath 990 238 moveto -1062 228 1253 204 1278 188 curveto -1303 171 1320 140 1334 120 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1331 120 moveto -1338 113 lineto -1335 123 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> wp56 -newpath 991 239 moveto -1065 230 1270 204 1296 188 curveto -1320 172 1336 143 1346 123 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1343 124 moveto -1349 116 lineto -1347 126 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> wp56 -newpath 991 240 moveto -1069 232 1287 205 1314 188 curveto -1337 172 1354 144 1360 123 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1357 125 moveto -1362 116 lineto -1362 126 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> wp56 -newpath 991 240 moveto -1075 233 1304 205 1332 188 curveto -1357 171 1374 140 1375 119 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1373 122 moveto -1374 112 lineto -1378 122 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> u1b123 -newpath 991 240 moveto -1084 234 1392 212 1487 188 curveto -1490 187 1494 185 1497 184 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1494 182 moveto -1504 182 lineto -1495 187 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> d1124 -newpath 991 241 moveto -1094 236 1457 219 1569 188 curveto -1572 187 1575 186 1579 184 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1575 183 moveto -1585 182 lineto -1576 188 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> n1b134 -newpath 937 241 moveto -861 240 643 230 468 188 curveto -463 187 458 185 454 184 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 456 188 moveto -448 181 lineto -458 183 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> d1b125 -newpath 991 241 moveto -1117 239 1635 226 1793 188 curveto -1796 188 1798 187 1801 186 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1800 184 moveto -1810 182 lineto -1802 188 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> l1b145 -newpath 980 227 moveto -991 217 1005 203 1017 192 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1015 190 moveto -1024 185 lineto -1019 194 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> u1126 -newpath 991 241 moveto -1108 238 1572 222 1714 188 curveto -1718 187 1723 185 1727 184 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1723 183 moveto -1733 181 lineto -1725 188 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> l1b136 -newpath 937 240 moveto -877 237 730 224 613 188 curveto -611 187 609 186 606 186 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 605 188 moveto -597 182 lineto -607 184 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -endpage -grestore -%%PageTrailer -%%EndPage: 1 -%%Trailer -%%Pages: 1 -end -restore -%%EOF Index: branches/ohl/omega-development/completed/whizard2/web/bhabha.eps =================================================================== --- branches/ohl/omega-development/completed/whizard2/web/bhabha.eps (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/web/bhabha.eps (revision 8703) @@ -1,576 +0,0 @@ -%!PS-Adobe-2.0 -%%Creator: dot version 1.8.5 (Wed Aug 21 14:41:12 CEST 2002) -%%For: (ohl) Thorsten Ohl,,5729,0931-3594666 -%%Title: OMEGA -%%Pages: (atend) -%%BoundingBox: 35 35 511 233 -%%EndComments -save -%%BeginProlog -/DotDict 200 dict def -DotDict begin - -/setupLatin1 { -mark -/EncodingVector 256 array def - EncodingVector 0 - -ISOLatin1Encoding 0 255 getinterval putinterval - -EncodingVector - dup 306 /AE - dup 301 /Aacute - dup 302 /Acircumflex - dup 304 /Adieresis - dup 300 /Agrave - dup 305 /Aring - dup 303 /Atilde - dup 307 /Ccedilla - dup 311 /Eacute - dup 312 /Ecircumflex - dup 313 /Edieresis - dup 310 /Egrave - dup 315 /Iacute - dup 316 /Icircumflex - dup 317 /Idieresis - dup 314 /Igrave - dup 334 /Udieresis - dup 335 /Yacute - dup 376 /thorn - dup 337 /germandbls - dup 341 /aacute - dup 342 /acircumflex - dup 344 /adieresis - dup 346 /ae - dup 340 /agrave - dup 345 /aring - dup 347 /ccedilla - dup 351 /eacute - dup 352 /ecircumflex - dup 353 /edieresis - dup 350 /egrave - dup 355 /iacute - dup 356 /icircumflex - dup 357 /idieresis - dup 354 /igrave - dup 360 /dcroat - dup 361 /ntilde - dup 363 /oacute - dup 364 /ocircumflex - dup 366 /odieresis - dup 362 /ograve - dup 365 /otilde - dup 370 /oslash - dup 372 /uacute - dup 373 /ucircumflex - dup 374 /udieresis - dup 371 /ugrave - dup 375 /yacute - dup 377 /ydieresis - -% Set up ISO Latin 1 character encoding -/starnetISO { - dup dup findfont dup length dict begin - { 1 index /FID ne { def }{ pop pop } ifelse - } forall - /Encoding EncodingVector def - currentdict end definefont -} def -/Times-Roman starnetISO def -/Times-Italic starnetISO def -/Times-Bold starnetISO def -/Times-BoldItalic starnetISO def -/Helvetica starnetISO def -/Helvetica-Oblique starnetISO def -/Helvetica-Bold starnetISO def -/Helvetica-BoldOblique starnetISO def -/Courier starnetISO def -/Courier-Oblique starnetISO def -/Courier-Bold starnetISO def -/Courier-BoldOblique starnetISO def -cleartomark -} bind def - -%%BeginResource: procset -/coord-font-family /Times-Roman def -/default-font-family /Times-Roman def -/coordfont coord-font-family findfont 8 scalefont def - -/InvScaleFactor 1.0 def -/set_scale { - dup 1 exch div /InvScaleFactor exch def - dup scale -} bind def - -% styles -/solid { } bind def -/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def -/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def -/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def -/bold { 2 setlinewidth } bind def -/filled { } bind def -/unfilled { } bind def -/rounded { } bind def -/diagonals { } bind def - -% hooks for setting color -/nodecolor { sethsbcolor } bind def -/edgecolor { sethsbcolor } bind def -/graphcolor { sethsbcolor } bind def -/nopcolor {pop pop pop} bind def - -/beginpage { % i j npages - /npages exch def - /j exch def - /i exch def - /str 10 string def - npages 1 gt { - gsave - coordfont setfont - 0 0 moveto - (\() show i str cvs show (,) show j str cvs show (\)) show - grestore - } if -} bind def - -/set_font { - findfont exch - scalefont setfont -} def - -% draw aligned label in bounding box aligned to current point -/alignedtext { % width adj text - /text exch def - /adj exch def - /width exch def - gsave - width 0 gt { - text stringwidth pop adj mul 0 rmoveto - } if - [] 0 setdash - text show - grestore -} def - -/boxprim { % xcorner ycorner xsize ysize - 4 2 roll - moveto - 2 copy - exch 0 rlineto - 0 exch rlineto - pop neg 0 rlineto - closepath -} bind def - -/ellipse_path { - /ry exch def - /rx exch def - /y exch def - /x exch def - matrix currentmatrix - newpath - x y translate - rx ry scale - 0 0 1 0 360 arc - setmatrix -} bind def - -/endpage { showpage } bind def - -/layercolorseq - [ % layer color sequence - darkest to lightest - [0 0 0] - [.2 .8 .8] - [.4 .8 .8] - [.6 .8 .8] - [.8 .8 .8] - ] -def - -/setlayer {/maxlayer exch def /curlayer exch def - layercolorseq curlayer get - aload pop sethsbcolor - /nodecolor {nopcolor} def - /edgecolor {nopcolor} def - /graphcolor {nopcolor} def -} bind def - -/onlayer { curlayer ne {invis} if } def - -/onlayers { - /myupper exch def - /mylower exch def - curlayer mylower lt - curlayer myupper gt - or - {invis} if -} def - -/curlayer 0 def - -%%EndResource -%%EndProlog -%%BeginSetup -14 default-font-family set_font -1 setmiterlimit -% /arrowlength 10 def -% /arrowwidth 5 def - -% make sure pdfmark is harmless for PS-interpreters other than Distiller -/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse -% make '<<' and '>>' safe on PS Level 1 devices -/languagelevel where {pop languagelevel}{1} ifelse -2 lt { - userdict (<<) cvn ([) cvn load put - userdict (>>) cvn ([) cvn load put -} if - -%%EndSetup -%%Page: 1 1 -%%PageBoundingBox: 36 36 511 233 -%%PageOrientation: Portrait -gsave -35 35 476 198 boxprim clip newpath -36 36 translate -0 0 1 beginpage -0 0 translate 0 rotate -0.000 0.000 0.000 graphcolor -14.00 /Times-Roman set_font - -% l1b1 -gsave 10 dict begin -191 26 27 18 ellipse_path -stroke -gsave 10 dict begin -191 21 moveto 22 -0.5 (l1b1) alignedtext -end grestore -end grestore - -% l12 -gsave 10 dict begin -51 26 27 18 ellipse_path -stroke -gsave 10 dict begin -51 21 moveto 17 -0.5 (l12) alignedtext -end grestore -end grestore - -% l13 -gsave 10 dict begin -331 26 27 18 ellipse_path -stroke -gsave 10 dict begin -331 21 moveto 16 -0.5 (l13) alignedtext -end grestore -end grestore - -% l1b4 -gsave 10 dict begin -437 26 27 18 ellipse_path -stroke -gsave 10 dict begin -437 21 moveto 26 -0.5 (l1b4) alignedtext -end grestore -end grestore - -% a12 -gsave 10 dict begin -155 98 27 18 ellipse_path -stroke -gsave 10 dict begin -155 93 moveto 20 -0.5 (a12) alignedtext -end grestore -end grestore - -% a12 -> l1b1 -newpath 164 81 moveto -168 72 173 62 178 52 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 176 51 moveto -182 43 lineto -180 53 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% a12 -> l12 -newpath 136 85 moveto -119 74 96 57 77 44 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 77 47 moveto -70 39 lineto -80 43 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% z12 -gsave 10 dict begin -83 98 27 18 ellipse_path -stroke -gsave 10 dict begin -83 93 moveto 20 -0.5 (z12) alignedtext -end grestore -end grestore - -% z12 -> l1b1 -newpath 102 85 moveto -120 74 145 57 164 44 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 162 42 moveto -172 39 lineto -165 46 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% z12 -> l12 -newpath 75 81 moveto -71 72 67 62 63 52 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 61 53 moveto -59 43 lineto -65 51 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% a13 -gsave 10 dict begin -299 98 27 18 ellipse_path -stroke -gsave 10 dict begin -299 93 moveto 19 -0.5 (a13) alignedtext -end grestore -end grestore - -% a13 -> l1b1 -newpath 280 85 moveto -262 74 237 57 218 44 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 217 46 moveto -210 39 lineto -220 42 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% a13 -> l13 -newpath 307 81 moveto -311 72 315 62 319 52 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 317 51 moveto -323 43 lineto -321 53 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% z13 -gsave 10 dict begin -227 98 27 18 ellipse_path -stroke -gsave 10 dict begin -227 93 moveto 19 -0.5 (z13) alignedtext -end grestore -end grestore - -% z13 -> l1b1 -newpath 218 81 moveto -214 72 209 62 204 52 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 202 53 moveto -200 43 lineto -206 51 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% z13 -> l13 -newpath 246 85 moveto -263 74 286 57 305 44 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 302 43 moveto -312 39 lineto -305 47 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -gsave 10 dict begin -331 170 27 18 ellipse_path -stroke -gsave 10 dict begin -331 165 moveto 6 -0.5 (*) alignedtext -end grestore -end grestore - -% * -> l12 -newpath 304 169 moveto -237 167 71 156 38 116 curveto -23 98 27 70 35 50 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 32 50 moveto -38 42 lineto -37 52 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> l12 -newpath 304 169 moveto -240 165 88 154 56 116 curveto -42 99 45 72 48 52 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 45 53 moveto -50 44 lineto -50 54 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> l13 -newpath 325 152 moveto -325 142 326 128 326 116 curveto -326 100 326 95 326 80 curveto -326 71 325 62 325 53 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 323 54 moveto -325 44 lineto -328 54 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> l13 -newpath 340 153 moveto -342 142 343 128 344 116 curveto -344 100 344 95 344 80 curveto -343 70 343 61 341 52 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 339 53 moveto -340 43 lineto -344 53 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> l1b4 -newpath 330 152 moveto -342 124 381 71 410 43 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 407 42 moveto -416 38 lineto -410 46 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> l1b4 -newpath 339 153 moveto -356 126 393 75 416 47 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 413 47 moveto -421 41 lineto -417 50 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> l1b4 -newpath 346 155 moveto -367 130 405 79 425 49 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 421 50 moveto -429 43 lineto -426 53 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> l1b4 -newpath 351 158 moveto -378 135 418 82 434 50 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 430 52 moveto -437 44 lineto -435 54 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> a12 -newpath 307 161 moveto -279 151 231 133 191 116 curveto -189 115 187 114 186 114 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 185 116 moveto -177 109 lineto -187 112 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> z12 -newpath 305 165 moveto -264 157 185 140 119 116 curveto -116 115 113 113 110 112 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 112 116 moveto -104 109 lineto -114 111 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> a13 -newpath 323 153 moveto -319 144 315 134 311 124 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 309 125 moveto -307 115 lineto -313 123 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> z13 -newpath 312 157 moveto -295 146 272 129 253 116 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 253 119 moveto -246 111 lineto -256 115 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -endpage -grestore -%%PageTrailer -%%EndPage: 1 -%%Trailer -%%Pages: 1 -end -restore -%%EOF Index: branches/ohl/omega-development/completed/whizard2/web/bhabha0.eps =================================================================== --- branches/ohl/omega-development/completed/whizard2/web/bhabha0.eps (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/web/bhabha0.eps (revision 8703) @@ -1,722 +0,0 @@ -%!PS-Adobe-2.0 -%%Creator: dot version 1.8.5 (Wed Aug 21 14:41:12 CEST 2002) -%%For: (ohl) Thorsten Ohl,,5729,0931-3594666 -%%Title: OMEGA -%%Pages: (atend) -%%BoundingBox: 35 35 799 233 -%%EndComments -save -%%BeginProlog -/DotDict 200 dict def -DotDict begin - -/setupLatin1 { -mark -/EncodingVector 256 array def - EncodingVector 0 - -ISOLatin1Encoding 0 255 getinterval putinterval - -EncodingVector - dup 306 /AE - dup 301 /Aacute - dup 302 /Acircumflex - dup 304 /Adieresis - dup 300 /Agrave - dup 305 /Aring - dup 303 /Atilde - dup 307 /Ccedilla - dup 311 /Eacute - dup 312 /Ecircumflex - dup 313 /Edieresis - dup 310 /Egrave - dup 315 /Iacute - dup 316 /Icircumflex - dup 317 /Idieresis - dup 314 /Igrave - dup 334 /Udieresis - dup 335 /Yacute - dup 376 /thorn - dup 337 /germandbls - dup 341 /aacute - dup 342 /acircumflex - dup 344 /adieresis - dup 346 /ae - dup 340 /agrave - dup 345 /aring - dup 347 /ccedilla - dup 351 /eacute - dup 352 /ecircumflex - dup 353 /edieresis - dup 350 /egrave - dup 355 /iacute - dup 356 /icircumflex - dup 357 /idieresis - dup 354 /igrave - dup 360 /dcroat - dup 361 /ntilde - dup 363 /oacute - dup 364 /ocircumflex - dup 366 /odieresis - dup 362 /ograve - dup 365 /otilde - dup 370 /oslash - dup 372 /uacute - dup 373 /ucircumflex - dup 374 /udieresis - dup 371 /ugrave - dup 375 /yacute - dup 377 /ydieresis - -% Set up ISO Latin 1 character encoding -/starnetISO { - dup dup findfont dup length dict begin - { 1 index /FID ne { def }{ pop pop } ifelse - } forall - /Encoding EncodingVector def - currentdict end definefont -} def -/Times-Roman starnetISO def -/Times-Italic starnetISO def -/Times-Bold starnetISO def -/Times-BoldItalic starnetISO def -/Helvetica starnetISO def -/Helvetica-Oblique starnetISO def -/Helvetica-Bold starnetISO def -/Helvetica-BoldOblique starnetISO def -/Courier starnetISO def -/Courier-Oblique starnetISO def -/Courier-Bold starnetISO def -/Courier-BoldOblique starnetISO def -cleartomark -} bind def - -%%BeginResource: procset -/coord-font-family /Times-Roman def -/default-font-family /Times-Roman def -/coordfont coord-font-family findfont 8 scalefont def - -/InvScaleFactor 1.0 def -/set_scale { - dup 1 exch div /InvScaleFactor exch def - dup scale -} bind def - -% styles -/solid { } bind def -/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def -/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def -/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def -/bold { 2 setlinewidth } bind def -/filled { } bind def -/unfilled { } bind def -/rounded { } bind def -/diagonals { } bind def - -% hooks for setting color -/nodecolor { sethsbcolor } bind def -/edgecolor { sethsbcolor } bind def -/graphcolor { sethsbcolor } bind def -/nopcolor {pop pop pop} bind def - -/beginpage { % i j npages - /npages exch def - /j exch def - /i exch def - /str 10 string def - npages 1 gt { - gsave - coordfont setfont - 0 0 moveto - (\() show i str cvs show (,) show j str cvs show (\)) show - grestore - } if -} bind def - -/set_font { - findfont exch - scalefont setfont -} def - -% draw aligned label in bounding box aligned to current point -/alignedtext { % width adj text - /text exch def - /adj exch def - /width exch def - gsave - width 0 gt { - text stringwidth pop adj mul 0 rmoveto - } if - [] 0 setdash - text show - grestore -} def - -/boxprim { % xcorner ycorner xsize ysize - 4 2 roll - moveto - 2 copy - exch 0 rlineto - 0 exch rlineto - pop neg 0 rlineto - closepath -} bind def - -/ellipse_path { - /ry exch def - /rx exch def - /y exch def - /x exch def - matrix currentmatrix - newpath - x y translate - rx ry scale - 0 0 1 0 360 arc - setmatrix -} bind def - -/endpage { showpage } bind def - -/layercolorseq - [ % layer color sequence - darkest to lightest - [0 0 0] - [.2 .8 .8] - [.4 .8 .8] - [.6 .8 .8] - [.8 .8 .8] - ] -def - -/setlayer {/maxlayer exch def /curlayer exch def - layercolorseq curlayer get - aload pop sethsbcolor - /nodecolor {nopcolor} def - /edgecolor {nopcolor} def - /graphcolor {nopcolor} def -} bind def - -/onlayer { curlayer ne {invis} if } def - -/onlayers { - /myupper exch def - /mylower exch def - curlayer mylower lt - curlayer myupper gt - or - {invis} if -} def - -/curlayer 0 def - -%%EndResource -%%EndProlog -%%BeginSetup -14 default-font-family set_font -1 setmiterlimit -% /arrowlength 10 def -% /arrowwidth 5 def - -% make sure pdfmark is harmless for PS-interpreters other than Distiller -/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse -% make '<<' and '>>' safe on PS Level 1 devices -/languagelevel where {pop languagelevel}{1} ifelse -2 lt { - userdict (<<) cvn ([) cvn load put - userdict (>>) cvn ([) cvn load put -} if - -%%EndSetup -%%Page: 1 1 -%%PageBoundingBox: 36 36 799 233 -%%PageOrientation: Portrait -gsave -35 35 764 198 boxprim clip newpath -36 36 translate -0 0 1 beginpage -0 0 translate 0 rotate -0.000 0.000 0.000 graphcolor -14.00 /Times-Roman set_font - -% l1b1 -gsave 10 dict begin -553 26 27 18 ellipse_path -stroke -gsave 10 dict begin -553 21 moveto 22 -0.5 (l1b1) alignedtext -end grestore -end grestore - -% l12 -gsave 10 dict begin -661 26 27 18 ellipse_path -stroke -gsave 10 dict begin -661 21 moveto 17 -0.5 (l12) alignedtext -end grestore -end grestore - -% l13 -gsave 10 dict begin -327 26 27 18 ellipse_path -stroke -gsave 10 dict begin -327 21 moveto 16 -0.5 (l13) alignedtext -end grestore -end grestore - -% l1b4 -gsave 10 dict begin -78 26 27 18 ellipse_path -stroke -gsave 10 dict begin -78 21 moveto 26 -0.5 (l1b4) alignedtext -end grestore -end grestore - -% a12 -gsave 10 dict begin -607 98 27 18 ellipse_path -stroke -gsave 10 dict begin -607 93 moveto 20 -0.5 (a12) alignedtext -end grestore -end grestore - -% a12 -> l1b1 -newpath 595 82 moveto -588 72 579 60 571 50 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 569 52 moveto -565 42 lineto -573 49 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% a12 -> l12 -newpath 619 82 moveto -626 72 635 60 643 50 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 641 49 moveto -649 42 lineto -645 51 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% z12 -gsave 10 dict begin -679 98 27 18 ellipse_path -stroke -gsave 10 dict begin -679 93 moveto 20 -0.5 (z12) alignedtext -end grestore -end grestore - -% z12 -> l1b1 -newpath 658 86 moveto -637 74 605 55 582 42 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 582 45 moveto -574 38 lineto -584 40 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% z12 -> l12 -newpath 675 80 moveto -673 72 670 62 668 53 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 666 54 moveto -665 44 lineto -671 53 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% a13 -gsave 10 dict begin -463 98 27 18 ellipse_path -stroke -gsave 10 dict begin -463 93 moveto 19 -0.5 (a13) alignedtext -end grestore -end grestore - -% a13 -> l1b1 -newpath 480 84 moveto -494 73 513 58 529 46 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 527 45 moveto -536 40 lineto -530 48 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% a13 -> l13 -newpath 442 87 moveto -420 75 382 56 356 41 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 356 44 moveto -348 37 lineto -358 39 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% z13 -gsave 10 dict begin -535 98 27 18 ellipse_path -stroke -gsave 10 dict begin -535 93 moveto 19 -0.5 (z13) alignedtext -end grestore -end grestore - -% z13 -> l1b1 -newpath 539 80 moveto -541 72 544 62 546 53 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 543 53 moveto -549 44 lineto -548 54 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% z13 -> l13 -newpath 514 86 moveto -509 84 504 82 499 80 curveto -451 60 394 43 359 34 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 361 37 moveto -352 32 lineto -362 32 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% a24 -gsave 10 dict begin -391 98 27 18 ellipse_path -stroke -gsave 10 dict begin -391 93 moveto 24 -0.5 (a24) alignedtext -end grestore -end grestore - -% a24 -> l12 -newpath 411 86 moveto -416 84 422 82 427 80 curveto -496 55 517 60 589 44 curveto -603 41 617 37 630 34 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 626 33 moveto -636 32 lineto -627 38 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% a24 -> l1b4 -newpath 365 92 moveto -310 80 175 48 112 34 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 113 37 moveto -104 32 lineto -114 32 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% z24 -gsave 10 dict begin -263 98 27 18 ellipse_path -stroke -gsave 10 dict begin -263 93 moveto 24 -0.5 (z24) alignedtext -end grestore -end grestore - -% z24 -> l12 -newpath 289 93 moveto -307 89 332 84 355 80 curveto -458 61 485 64 589 44 curveto -603 41 617 37 630 34 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 626 32 moveto -636 33 lineto -627 37 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% z24 -> l1b4 -newpath 242 87 moveto -237 85 232 82 227 80 curveto -188 63 142 47 112 37 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 112 40 moveto -103 34 lineto -113 35 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% a34 -gsave 10 dict begin -119 98 27 18 ellipse_path -stroke -gsave 10 dict begin -119 93 moveto 23 -0.5 (a34) alignedtext -end grestore -end grestore - -% a34 -> l13 -newpath 140 86 moveto -145 84 150 82 155 80 curveto -203 60 260 43 295 34 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 292 32 moveto -302 32 lineto -293 37 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% a34 -> l1b4 -newpath 109 81 moveto -104 73 98 62 93 52 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 91 53 moveto -88 43 lineto -95 51 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% z34 -gsave 10 dict begin -191 98 27 18 ellipse_path -stroke -gsave 10 dict begin -191 93 moveto 23 -0.5 (z34) alignedtext -end grestore -end grestore - -% z34 -> l13 -newpath 212 87 moveto -235 75 272 56 298 42 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 296 40 moveto -306 38 lineto -298 45 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% z34 -> l1b4 -newpath 171 85 moveto -153 74 125 57 105 44 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 105 47 moveto -98 39 lineto -108 43 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -gsave 10 dict begin -395 170 27 18 ellipse_path -stroke -gsave 10 dict begin -395 165 moveto 6 -0.5 (*) alignedtext -end grestore -end grestore - -% * -> l12 -newpath 422 167 moveto -440 165 447 163 468 160 curveto -533 148 704 117 706 116 curveto -716 103 711 94 706 80 curveto -699 63 693 53 685 46 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 684 48 moveto -678 40 lineto -687 45 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> l12 -newpath 422 169 moveto -426 169 431 168 435 168 curveto -457 165 463 163 486 160 curveto -551 148 722 117 724 116 curveto -734 103 729 94 724 80 curveto -715 58 708 49 694 39 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 693 41 moveto -686 33 lineto -695 37 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> l13 -newpath 376 157 moveto -365 146 353 131 346 116 curveto -336 95 328 71 325 52 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 323 54 moveto -324 44 lineto -328 54 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> l13 -newpath 387 152 moveto -380 142 370 129 364 116 curveto -354 95 346 69 340 51 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 338 53 moveto -337 43 lineto -343 51 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> l1b4 -newpath 368 170 moveto -293 168 95 160 56 116 curveto -38 96 42 65 53 45 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 50 45 moveto -58 38 lineto -54 48 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> l1b4 -newpath 368 170 moveto -297 168 112 159 74 116 curveto -58 98 59 71 65 51 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 62 52 moveto -67 43 lineto -67 53 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> l1b4 -newpath 368 169 moveto -300 167 128 157 92 116 curveto -76 99 77 72 79 52 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 76 54 moveto -80 44 lineto -81 54 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> l1b4 -newpath 368 169 moveto -302 166 144 155 110 116 curveto -94 98 95 69 93 50 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 91 52 moveto -92 42 lineto -96 52 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> a12 -newpath 421 164 moveto -455 154 519 137 571 116 curveto -574 115 577 113 580 112 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 576 111 moveto -586 109 lineto -578 116 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> z12 -newpath 422 166 moveto -468 160 564 143 643 116 curveto -646 115 649 114 652 112 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 648 111 moveto -658 110 lineto -649 116 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> a13 -newpath 409 155 moveto -419 145 432 132 442 120 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 440 119 moveto -448 113 lineto -443 122 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% * -> z13 -newpath 417 159 moveto -440 147 478 128 505 113 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 504 111 moveto -514 109 lineto -506 115 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -endpage -grestore -%%PageTrailer -%%EndPage: 1 -%%Trailer -%%Pages: 1 -end -restore -%%EOF Index: branches/ohl/omega-development/completed/whizard2/web/modules.eps =================================================================== --- branches/ohl/omega-development/completed/whizard2/web/modules.eps (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/web/modules.eps (revision 8703) @@ -1,1430 +0,0 @@ -%!PS-Adobe-2.0 -%%Creator: dot version 1.7.16 (Wed Feb 6 02:14:52 MST 2002) -%%For: (ohl) Thorsten Ohl,,, -%%Title: G -%%Pages: (atend) -%%BoundingBox: 0 0 577 490 -%%EndComments -save -%%BeginProlog -/DotDict 200 dict def -DotDict begin - -/setupLatin1 { -mark -/EncodingVector 256 array def - EncodingVector 0 - -ISOLatin1Encoding 0 255 getinterval putinterval - -EncodingVector - dup 306 /AE - dup 301 /Aacute - dup 302 /Acircumflex - dup 304 /Adieresis - dup 300 /Agrave - dup 305 /Aring - dup 303 /Atilde - dup 307 /Ccedilla - dup 311 /Eacute - dup 312 /Ecircumflex - dup 313 /Edieresis - dup 310 /Egrave - dup 315 /Iacute - dup 316 /Icircumflex - dup 317 /Idieresis - dup 314 /Igrave - dup 334 /Udieresis - dup 335 /Yacute - dup 376 /thorn - dup 337 /germandbls - dup 341 /aacute - dup 342 /acircumflex - dup 344 /adieresis - dup 346 /ae - dup 340 /agrave - dup 345 /aring - dup 347 /ccedilla - dup 351 /eacute - dup 352 /ecircumflex - dup 353 /edieresis - dup 350 /egrave - dup 355 /iacute - dup 356 /icircumflex - dup 357 /idieresis - dup 354 /igrave - dup 360 /dcroat - dup 361 /ntilde - dup 363 /oacute - dup 364 /ocircumflex - dup 366 /odieresis - dup 362 /ograve - dup 365 /otilde - dup 370 /oslash - dup 372 /uacute - dup 373 /ucircumflex - dup 374 /udieresis - dup 371 /ugrave - dup 375 /yacute - dup 377 /ydieresis - -% Set up ISO Latin 1 character encoding -/starnetISO { - dup dup findfont dup length dict begin - { 1 index /FID ne { def }{ pop pop } ifelse - } forall - /Encoding EncodingVector def - currentdict end definefont -} def -/Times-Roman starnetISO def -/Times-Italic starnetISO def -/Times-Bold starnetISO def -/Times-BoldItalic starnetISO def -/Helvetica starnetISO def -/Helvetica-Oblique starnetISO def -/Helvetica-Bold starnetISO def -/Helvetica-BoldOblique starnetISO def -/Courier starnetISO def -/Courier-Oblique starnetISO def -/Courier-Bold starnetISO def -/Courier-BoldOblique starnetISO def -cleartomark -} bind def - -%%BeginResource: procset -/coord-font-family /Times-Roman def -/default-font-family /Times-Roman def -/coordfont coord-font-family findfont 8 scalefont def - -/InvScaleFactor 1.0 def -/set_scale { - dup 1 exch div /InvScaleFactor exch def - dup scale -} bind def - -% styles -/solid { } bind def -/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def -/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def -/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def -/bold { 2 setlinewidth } bind def -/filled { } bind def -/unfilled { } bind def -/rounded { } bind def -/diagonals { } bind def - -% hooks for setting color -/nodecolor { sethsbcolor } bind def -/edgecolor { sethsbcolor } bind def -/graphcolor { sethsbcolor } bind def -/nopcolor {pop pop pop} bind def - -/beginpage { % i j npages - /npages exch def - /j exch def - /i exch def - /str 10 string def - npages 1 gt { - gsave - coordfont setfont - 0 0 moveto - (\() show i str cvs show (,) show j str cvs show (\)) show - grestore - } if -} bind def - -/set_font { - findfont exch - scalefont setfont -} def - -% draw aligned label in bounding box aligned to current point -/alignedtext { % width adj text - /text exch def - /adj exch def - /width exch def - gsave - width 0 gt { - text stringwidth pop adj mul 0 rmoveto - } if - [] 0 setdash - text show - grestore -} def - -/boxprim { % xcorner ycorner xsize ysize - 4 2 roll - moveto - 2 copy - exch 0 rlineto - 0 exch rlineto - pop neg 0 rlineto - closepath -} bind def - -/ellipse_path { - /ry exch def - /rx exch def - /y exch def - /x exch def - matrix currentmatrix - newpath - x y translate - rx ry scale - 0 0 1 0 360 arc - setmatrix -} bind def - -/endpage { showpage } bind def - -/layercolorseq - [ % layer color sequence - darkest to lightest - [0 0 0] - [.2 .8 .8] - [.4 .8 .8] - [.6 .8 .8] - [.8 .8 .8] - ] -def - -/setlayer {/maxlayer exch def /curlayer exch def - layercolorseq curlayer get - aload pop sethsbcolor - /nodecolor {nopcolor} def - /edgecolor {nopcolor} def - /graphcolor {nopcolor} def -} bind def - -/onlayer { curlayer ne {invis} if } def - -/onlayers { - /myupper exch def - /mylower exch def - curlayer mylower lt - curlayer myupper gt - or - {invis} if -} def - -/curlayer 0 def - -%%EndResource -%%EndProlog -%%BeginSetup -14 default-font-family set_font -1 setmiterlimit -% /arrowlength 10 def -% /arrowwidth 5 def - -% make sure pdfmark is harmless for PS-interpreters other than Distiller -/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse -% make '<<' and '>>' safe on PS Level 1 devices -/languagelevel where {pop languagelevel}{1} ifelse -2 lt { - userdict (<<) cvn ([) cvn load put - userdict (>>) cvn ([) cvn load put -} if - -%%EndSetup -%%Page: 1 1 -%%PageBoundingBox: 36 36 577 490 -%%PageOrientation: Portrait -gsave -35 35 542 455 boxprim clip newpath -36 36 translate -0 0 1 beginpage -0.6626 set_scale -0 0 translate 0 rotate -[ /CropBox [36 36 577 490] /PAGES pdfmark -0.000 0.000 0.000 graphcolor -14.00 /Times-Roman set_font - -% F90_SM -gsave 10 dict begin -292 658 40 18 ellipse_path -stroke -gsave 10 dict begin -292 653 moveto 59 -0.5 (F90_SM) alignedtext -end grestore -end grestore - -% Models -gsave 10 dict begin -newpath 0 534 moveto -136 534 lineto -136 594 lineto -0 594 lineto -closepath -stroke -gsave 10 dict begin -24 579 moveto 35 -0.5 (QED) alignedtext -end grestore -newpath 49 574 moveto -49 594 lineto -stroke -gsave 10 dict begin -73 579 moveto 35 -0.5 (QCD) alignedtext -end grestore -newpath 98 574 moveto -98 594 lineto -stroke -gsave 10 dict begin -117 579 moveto 24 -0.5 (SM) alignedtext -end grestore -newpath 0 574 moveto -136 574 lineto -stroke -gsave 10 dict begin -31 559 moveto 48 -0.5 (MSSM) alignedtext -end grestore -newpath 63 554 moveto -63 574 lineto -stroke -gsave 10 dict begin -99 559 moveto 57 -0.5 (User def.) alignedtext -end grestore -newpath 0 554 moveto -136 554 lineto -stroke -gsave 10 dict begin -68 539 moveto 50 -0.5 (Models) alignedtext -end grestore -end grestore - -% F90_SM -> Models -newpath 261 646 moveto -255 644 249 642 243 640 curveto -195 623 178 630 136 604 curveto -135 603 134 603 133 602 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 131 603 moveto -126 594 lineto -134 600 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% Targets -gsave 10 dict begin -newpath 154 524 moveto -353 524 lineto -353 604 lineto -154 604 lineto -closepath -stroke -gsave 10 dict begin -194 589 moveto 67 -0.5 (Fortran77) alignedtext -end grestore -newpath 235 584 moveto -235 604 lineto -stroke -gsave 10 dict begin -268 589 moveto 52 -0.5 (Fortran) alignedtext -end grestore -newpath 301 584 moveto -301 604 lineto -stroke -gsave 10 dict begin -326 589 moveto 37 -0.5 (Helas) alignedtext -end grestore -newpath 154 584 moveto -353 584 lineto -stroke -gsave 10 dict begin -180 569 moveto 11 -0.5 (C) alignedtext -end grestore -newpath 207 564 moveto -207 584 lineto -stroke -gsave 10 dict begin -243 569 moveto 30 -0.5 (C++) alignedtext -end grestore -newpath 279 564 moveto -279 584 lineto -stroke -gsave 10 dict begin -315 569 moveto 31 -0.5 (Java) alignedtext -end grestore -newpath 154 564 moveto -353 564 lineto -stroke -gsave 10 dict begin -186 549 moveto 51 -0.5 (O'Caml) alignedtext -end grestore -newpath 219 544 moveto -219 564 lineto -stroke -gsave 10 dict begin -245 549 moveto 38 -0.5 (Form) alignedtext -end grestore -newpath 271 544 moveto -271 564 lineto -stroke -gsave 10 dict begin -302 549 moveto 48 -0.5 (LaTeX) alignedtext -end grestore -newpath 333 544 moveto -333 564 lineto -stroke -gsave 10 dict begin -343 549 moveto 6 -0.5 (...) alignedtext -end grestore -newpath 154 544 moveto -353 544 lineto -stroke -gsave 10 dict begin -253 529 moveto 50 -0.5 (Targets) alignedtext -end grestore -end grestore - -% F90_SM -> Targets -newpath 285 640 moveto -282 631 278 621 275 613 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 273 614 moveto -272 604 lineto -278 613 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% Omega -gsave 10 dict begin -newpath 432 582 moveto -370 582 lineto -370 546 lineto -432 546 lineto -closepath -stroke -gsave 10 dict begin -401 559 moveto 49 -0.5 (Omega) alignedtext -end grestore -end grestore - -% F90_SM -> Omega -newpath 312 643 moveto -326 632 345 617 361 604 curveto -364 601 370 595 377 588 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 374 587 moveto -383 582 lineto -378 591 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% Model -gsave 10 dict begin -newpath 184 340 moveto -137 320 lineto -184 300 lineto -231 320 lineto -closepath -stroke -gsave 10 dict begin -184 315 moveto 44 -0.5 (Model) alignedtext -end grestore -end grestore - -% Models -> Model -newpath 82 534 moveto -105 485 150 391 172 346 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 170 345 moveto -176 337 lineto -174 347 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% Target -gsave 10 dict begin -newpath 194 488 moveto -147 468 lineto -194 448 lineto -241 468 lineto -closepath -stroke -gsave 10 dict begin -194 463 moveto 44 -0.5 (Target) alignedtext -end grestore -end grestore - -% Targets -> Target -newpath 228 524 moveto -222 513 214 501 208 492 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 206 494 moveto -204 484 lineto -211 492 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% Omega -> Target -newpath 386 546 moveto -379 538 370 530 361 524 curveto -316 496 299 504 250 488 curveto -245 486 236 483 227 480 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 228 483 moveto -220 477 lineto -230 479 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% Lapack -gsave 10 dict begin -newpath 415 486 moveto -351 486 lineto -351 450 lineto -415 450 lineto -closepath -stroke -gsave 10 dict begin -383 463 moveto 51 -0.5 (Lapack) alignedtext -end grestore -end grestore - -% Omega -> Lapack -newpath 398 546 moveto -395 532 391 511 388 495 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 386 496 moveto -386 486 lineto -391 495 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% ThoArray -gsave 10 dict begin -newpath 525 412 moveto -441 412 lineto -441 376 lineto -525 376 lineto -closepath -stroke -gsave 10 dict begin -483 389 moveto 70 -0.5 (ThoArray) alignedtext -end grestore -end grestore - -% Omega -> ThoArray -newpath 428 546 moveto -454 529 489 503 496 488 curveto -507 466 501 439 494 420 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 492 422 moveto -491 412 lineto -497 420 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% Whizard -gsave 10 dict begin -newpath 333 486 moveto -259 486 lineto -259 450 lineto -333 450 lineto -closepath -stroke -gsave 10 dict begin -296 463 moveto 60 -0.5 (Whizard) alignedtext -end grestore -end grestore - -% Omega -> Whizard -newpath 383 546 moveto -376 539 368 531 361 524 curveto -349 513 337 502 325 492 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 324 494 moveto -318 486 lineto -327 491 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% ... -gsave 10 dict begin -207 658 27 18 ellipse_path -stroke -gsave 10 dict begin -207 653 moveto 6 -0.5 (...) alignedtext -end grestore -end grestore - -% ... -> Models -newpath 188 645 moveto -171 633 145 616 121 600 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 120 602 moveto -113 594 lineto -122 598 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% ... -> Targets -newpath 215 641 moveto -219 633 225 621 230 610 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 226 612 moveto -233 604 lineto -231 614 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% ... -> Omega -newpath 228 647 moveto -234 644 240 641 243 640 curveto -293 619 313 632 361 604 curveto -367 600 374 595 379 589 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 377 587 moveto -386 582 lineto -381 591 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% Coupling -gsave 10 dict begin -newpath 81 264 moveto -21 244 lineto -81 224 lineto -141 244 lineto -closepath -stroke -gsave 10 dict begin -81 239 moveto 63 -0.5 (Coupling) alignedtext -end grestore -end grestore - -% Model -> Coupling -newpath 167 307 moveto -150 295 126 277 107 263 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 107 266 moveto -100 258 lineto -110 262 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% Color -gsave 10 dict begin -newpath 467 262 moveto -413 262 lineto -413 226 lineto -467 226 lineto -closepath -stroke -gsave 10 dict begin -440 239 moveto 37 -0.5 (Color) alignedtext -end grestore -end grestore - -% Model -> Color -newpath 209 311 moveto -218 307 230 303 240 300 curveto -241 299 348 270 405 254 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 403 252 moveto -413 252 lineto -404 257 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% Options -gsave 10 dict begin -newpath 225 262 moveto -159 262 lineto -159 226 lineto -225 226 lineto -closepath -stroke -gsave 10 dict begin -192 239 moveto 53 -0.5 (Options) alignedtext -end grestore -end grestore - -% Model -> Options -newpath 186 301 moveto -187 292 188 281 189 272 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 187 272 moveto -190 262 lineto -191 272 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% Fusion -gsave 10 dict begin -newpath 326 412 moveto -266 412 lineto -266 376 lineto -326 376 lineto -closepath -stroke -gsave 10 dict begin -296 389 moveto 46 -0.5 (Fusion) alignedtext -end grestore -end grestore - -% Target -> Fusion -newpath 212 455 moveto -226 445 246 430 263 418 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 261 416 moveto -271 412 lineto -265 420 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% Ogiga -gsave 10 dict begin -newpath 428 676 moveto -374 676 lineto -374 640 lineto -428 640 lineto -closepath -stroke -gsave 10 dict begin -401 653 moveto 40 -0.5 (Ogiga) alignedtext -end grestore -end grestore - -% Ogiga -> Models -newpath 374 650 moveto -359 645 344 641 341 640 curveto -250 618 222 635 136 604 curveto -132 602 128 601 124 599 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 123 601 moveto -115 594 lineto -125 597 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% Ogiga -> Targets -newpath 374 641 moveto -360 632 342 621 325 610 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 323 612 moveto -316 604 lineto -326 607 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% Ogiga -> Omega -newpath 401 640 moveto -401 627 401 607 401 591 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 399 592 moveto -401 582 lineto -404 592 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% ThoGDraw -gsave 10 dict begin -newpath 600 582 moveto -506 582 lineto -506 546 lineto -600 546 lineto -closepath -stroke -gsave 10 dict begin -553 559 moveto 80 -0.5 (ThoGDraw) alignedtext -end grestore -end grestore - -% Ogiga -> ThoGDraw -newpath 428 641 moveto -453 625 491 602 518 586 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 514 585 moveto -524 582 lineto -517 590 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% ThoGMenu -gsave 10 dict begin -newpath 763 582 moveto -667 582 lineto -667 546 lineto -763 546 lineto -closepath -stroke -gsave 10 dict begin -715 559 moveto 82 -0.5 (ThoGMenu) alignedtext -end grestore -end grestore - -% Ogiga -> ThoGMenu -newpath 428 652 moveto -468 642 544 624 609 604 curveto -627 598 646 591 663 584 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 659 583 moveto -669 582 lineto -660 588 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% ThoGDraw -> Color -newpath 554 546 moveto -556 511 556 435 534 376 curveto -518 335 487 295 465 270 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 463 271 moveto -458 262 lineto -466 268 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% ThoGWindow -gsave 10 dict begin -newpath 695 486 moveto -581 486 lineto -581 450 lineto -695 450 lineto -closepath -stroke -gsave 10 dict begin -638 463 moveto 101 -0.5 (ThoGWindow) alignedtext -end grestore -end grestore - -% ThoGDraw -> ThoGWindow -newpath 569 546 moveto -582 531 601 509 616 493 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 614 492 moveto -622 486 lineto -617 495 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% ThoGButton -gsave 10 dict begin -newpath 815 486 moveto -713 486 lineto -713 450 lineto -815 450 lineto -closepath -stroke -gsave 10 dict begin -764 463 moveto 88 -0.5 (ThoGButton) alignedtext -end grestore -end grestore - -% ThoGMenu -> ThoGButton -newpath 724 546 moveto -732 532 742 511 751 494 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 748 494 moveto -755 486 lineto -753 496 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% Tree -gsave 10 dict begin -newpath 405 188 moveto -351 188 lineto -351 152 lineto -405 152 lineto -closepath -stroke -gsave 10 dict begin -378 165 moveto 30 -0.5 (Tree) alignedtext -end grestore -end grestore - -% Color -> Tree -newpath 425 226 moveto -417 216 408 206 399 195 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 398 197 moveto -393 188 lineto -401 194 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% Trie -gsave 10 dict begin -newpath 477 188 moveto -423 188 lineto -423 152 lineto -477 152 lineto -closepath -stroke -gsave 10 dict begin -450 165 moveto 27 -0.5 (Trie) alignedtext -end grestore -end grestore - -% Color -> Trie -newpath 442 226 moveto -443 217 445 207 446 198 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 444 198 moveto -447 188 lineto -448 198 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% Fusion -> Model -newpath 269 376 moveto -251 364 228 348 210 337 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 210 340 moveto -203 332 lineto -213 336 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% DAG -gsave 10 dict begin -newpath 399 338 moveto -345 338 lineto -345 302 lineto -399 302 lineto -closepath -stroke -gsave 10 dict begin -372 315 moveto 38 -0.5 (DAG) alignedtext -end grestore -end grestore - -% Fusion -> DAG -newpath 315 376 moveto -325 366 337 355 346 345 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 344 343 moveto -353 338 lineto -348 347 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% Momentum -gsave 10 dict begin -newpath 677 338 moveto -581 338 lineto -581 302 lineto -677 302 lineto -closepath -stroke -gsave 10 dict begin -629 315 moveto 83 -0.5 (Momentum) alignedtext -end grestore -end grestore - -% Fusion -> Momentum -newpath 326 380 moveto -330 378 334 377 338 376 curveto -381 362 502 341 575 329 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 571 327 moveto -581 328 lineto -572 332 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% Topology -gsave 10 dict begin -newpath 327 338 moveto -249 338 lineto -249 302 lineto -327 302 lineto -closepath -stroke -gsave 10 dict begin -288 315 moveto 65 -0.5 (Topology) alignedtext -end grestore -end grestore - -% Fusion -> Topology -newpath 294 376 moveto -293 367 292 357 291 348 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 289 348 moveto -290 338 lineto -293 348 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% Pmap -gsave 10 dict begin -newpath 518 116 moveto -464 116 lineto -464 80 lineto -518 80 lineto -closepath -stroke -gsave 10 dict begin -491 93 moveto 40 -0.5 (Pmap) alignedtext -end grestore -end grestore - -% ThoArray -> Pmap -newpath 483 376 moveto -485 325 489 182 490 124 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 488 126 moveto -490 116 lineto -493 126 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% Whizard -> Fusion -newpath 296 450 moveto -296 441 296 431 296 422 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 294 422 moveto -296 412 lineto -299 422 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% Comphep -gsave 10 dict begin -newpath 108 676 moveto -28 676 lineto -28 640 lineto -108 640 lineto -closepath -stroke -gsave 10 dict begin -68 653 moveto 67 -0.5 (Comphep) alignedtext -end grestore -end grestore - -% Comphep -> Models -newpath 68 640 moveto -68 630 68 617 68 604 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 66 604 moveto -68 594 lineto -71 604 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% OVM -gsave 10 dict begin -newpath 487 486 moveto -433 486 lineto -433 450 lineto -487 450 lineto -closepath -stroke -gsave 10 dict begin -460 463 moveto 41 -0.5 (OVM) alignedtext -end grestore -end grestore - -% OVM -> Fusion -newpath 433 452 moveto -429 450 426 449 424 448 curveto -386 429 376 428 338 412 curveto -337 412 337 411 336 411 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 334 413 moveto -326 407 lineto -336 408 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% Complex -gsave 10 dict begin -newpath 423 412 moveto -347 412 lineto -347 376 lineto -423 376 lineto -closepath -stroke -gsave 10 dict begin -385 389 moveto 62 -0.5 (Complex) alignedtext -end grestore -end grestore - -% OVM -> Complex -newpath 441 450 moveto -431 440 420 429 410 419 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 408 421 moveto -403 412 lineto -412 417 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% Vertex -gsave 10 dict begin -newpath 111 338 moveto -51 338 lineto -51 302 lineto -111 302 lineto -closepath -stroke -gsave 10 dict begin -81 315 moveto 47 -0.5 (Vertex) alignedtext -end grestore -end grestore - -% Vertex -> Coupling -newpath 81 302 moveto -81 294 81 284 81 274 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 79 274 moveto -81 264 lineto -84 274 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% DAG -> Tree -newpath 373 302 moveto -374 276 376 228 377 197 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 375 198 moveto -377 188 lineto -380 198 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% Tuple -gsave 10 dict begin -newpath 307 262 moveto -253 262 lineto -253 226 lineto -307 226 lineto -closepath -stroke -gsave 10 dict begin -280 239 moveto 39 -0.5 (Tuple) alignedtext -end grestore -end grestore - -% DAG -> Tuple -newpath 350 302 moveto -337 292 322 279 309 268 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 308 270 moveto -302 262 lineto -311 267 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% ThoList -gsave 10 dict begin -newpath 509 44 moveto -443 44 lineto -443 8 lineto -509 8 lineto -closepath -stroke -gsave 10 dict begin -476 21 moveto 53 -0.5 (ThoList) alignedtext -end grestore -end grestore - -% Momentum -> ThoList -newpath 631 302 moveto -633 270 634 202 610 152 curveto -597 127 541 79 506 50 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 505 52 moveto -499 44 lineto -508 49 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% Topology -> Tuple -newpath 286 302 moveto -285 293 284 282 283 272 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 281 272 moveto -282 262 lineto -285 272 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% Linalg -gsave 10 dict begin -newpath 420 116 moveto -362 116 lineto -362 80 lineto -420 80 lineto -closepath -stroke -gsave 10 dict begin -391 93 moveto 44 -0.5 (Linalg) alignedtext -end grestore -end grestore - -% Tree -> Linalg -newpath 381 152 moveto -382 144 384 134 386 126 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 384 125 moveto -388 116 lineto -388 126 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% Tree -> Pmap -newpath 405 153 moveto -420 143 440 130 456 120 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 454 118 moveto -464 115 lineto -457 122 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% Product -gsave 10 dict begin -newpath 344 116 moveto -278 116 lineto -278 80 lineto -344 80 lineto -closepath -stroke -gsave 10 dict begin -311 93 moveto 53 -0.5 (Product) alignedtext -end grestore -end grestore - -% Tree -> Product -newpath 361 152 moveto -353 143 343 133 334 123 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 333 125 moveto -328 116 lineto -336 122 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% Trie -> Pmap -newpath 460 152 moveto -465 144 470 134 476 124 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 474 123 moveto -481 116 lineto -478 126 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% Phasespace -gsave 10 dict begin -newpath 673 412 moveto -585 412 lineto -585 376 lineto -673 376 lineto -closepath -stroke -gsave 10 dict begin -629 389 moveto 75 -0.5 (Phasespace) alignedtext -end grestore -end grestore - -% Phasespace -> Momentum -newpath 629 376 moveto -629 367 629 357 629 348 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 627 348 moveto -629 338 lineto -632 348 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% Combinatorics -gsave 10 dict begin -newpath 333 188 moveto -221 188 lineto -221 152 lineto -333 152 lineto -closepath -stroke -gsave 10 dict begin -277 165 moveto 99 -0.5 (Combinatorics) alignedtext -end grestore -end grestore - -% Tuple -> Combinatorics -newpath 279 226 moveto -278 217 278 207 278 198 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 276 198 moveto -278 188 lineto -281 198 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% Partition -gsave 10 dict begin -newpath 203 188 moveto -131 188 lineto -131 152 lineto -203 152 lineto -closepath -stroke -gsave 10 dict begin -167 165 moveto 59 -0.5 (Partition) alignedtext -end grestore -end grestore - -% Tuple -> Partition -newpath 253 226 moveto -238 216 220 204 203 193 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 202 195 moveto -195 188 lineto -205 191 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% Combinatorics -> Product -newpath 286 152 moveto -290 144 295 134 299 125 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 297 124 moveto -303 116 lineto -301 126 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% Product -> ThoList -newpath 344 83 moveto -371 72 409 55 437 43 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 433 42 moveto -443 40 lineto -435 47 lineto -closepath -fill -0.000 0.000 0.000 edgecolor - -% Algebra -gsave 10 dict begin -newpath 601 188 moveto -533 188 lineto -533 152 lineto -601 152 lineto -closepath -stroke -gsave 10 dict begin -567 165 moveto 55 -0.5 (Algebra) alignedtext -end grestore -end grestore - -% Algebra -> Pmap -newpath 548 152 moveto -538 143 527 132 517 123 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 515 125 moveto -510 116 lineto -519 121 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -endpage -grestore -%%PageTrailer -%%EndPage: 1 -%%Trailer -%%Pages: 1 -end -restore -%%EOF Index: branches/ohl/omega-development/completed/whizard2/web/omegalib.tex =================================================================== --- branches/ohl/omega-development/completed/whizard2/web/omegalib.tex (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/web/omegalib.tex (revision 8703) @@ -1,10320 +0,0 @@ -% $Id: omegalib.nw 727 2009-06-09 08:39:22Z ohl $% ===> this file was generated automatically by noweave --- better not edit it -% -% Copyright (C) 1999-2009 by -% Wolfgang Kilian -% Thorsten Ohl -% Juergen Reuter -% -% WHIZARD is free software; you can redistribute it and/or modify it -% under the terms of the GNU General Public License as published by -% the Free Software Foundation; either version 2, or (at your option) -% any later version. -% -% WHIZARD is distributed in the hope that it will be useful, but -% WITHOUT ANY WARRANTY; without even the implied warranty of -% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -% GNU General Public License for more details. -% -% You should have received a copy of the GNU General Public License -% along with this program; if not, write to the Free Software -% Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\nwfilename{../src/omegalib.nw}\nwbegindocs{1}\nwdocspar -\section{Trivia} -\nwenddocs{}\nwbegincode{2}\moddef{\code{}kinds.f95\edoc{}}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -\LA{}Copyleft\RA{} -module kinds - implicit none - private - -! Three types of precision. double is the default, usually. - public :: single, double, quadruple - public :: default, quad_or_single - - integer, parameter :: single = & - & selected_real_kind (precision(1.), range(1.)) - integer, parameter :: double = & - & selected_real_kind (precision(1._single) + 1, range(1._single) + 1) - integer, parameter :: quadruple = & - & selected_real_kind (precision (1._double) + 1, range (1._double)) - - integer, parameter :: default = double - integer, parameter :: quad_or_single = single - -! Integer kinds: 8 bit, 16 bit, 32 bit, and 64 bit -! These should all be available - public :: i8, i16, i32, i64 - - integer, parameter :: i8 = selected_int_kind (2) - integer, parameter :: i16 = selected_int_kind (4) - integer, parameter :: i32 = selected_int_kind (9) - integer, parameter :: i64 = selected_int_kind (18) - -! This is the integer size for binary codes: 32 bit (default) -! corresponds to a 2 -> 30 process, more than sufficient. - public :: TC - - integer, parameter :: TC = i32 - -end module kinds -\nwendcode{}\nwbegindocs{3}\nwdocspar -\nwenddocs{}\nwbegincode{4}\moddef{\code{}omega{\_}constants.f95\edoc{}}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -\LA{}Copyleft\RA{} -module omega_constants - use kinds - implicit none - private - real(kind=default), parameter, public :: & - PI = 3.1415926535897932384626433832795028841972_default -end module omega_constants -\nwendcode{}\nwbegindocs{5}\nwdocspar -\nwenddocs{}\nwbegincode{6}\moddef{Constants for \code{}omega77\edoc{}}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup - double precision PI - parameter (PI = 3.1415926535897932384626433832795028841972D0) -\nwendcode{}\nwbegindocs{7}\nwdocspar -\section{Spinors} -\nwenddocs{}\nwbegincode{8}\moddef{Operations for spinors (Fortran77)}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup - subroutine o7zs (psi) - implicit none - double complex psi(4) - psi(1) = 0 - psi(2) = 0 - psi(3) = 0 - psi(4) = 0 - end -\nwendcode{}\nwbegindocs{9}\nwdocspar -\nwenddocs{}\nwbegincode{10}\moddef{Operations for spinors (Fortran77)}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup - subroutine o7zcs (psibar) - implicit none - double complex psibar(4) - psibar(1) = 0 - psibar(2) = 0 - psibar(3) = 0 - psibar(4) = 0 - end -\nwendcode{}\nwbegindocs{11}\nwdocspar -\nwenddocs{}\nwbegincode{12}\moddef{\code{}omega{\_}spinors.f95\edoc{}}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -\LA{}Copyleft\RA{} -module omega_spinors - use kinds - use omega_constants - implicit none - private - public :: operator (*), operator (+), operator (-) - public :: abs - \LA{}\code{}intrinsic\ ::\ abs\edoc{}\RA{} - type, public :: conjspinor - ! private (omegalib needs access, but DON'T TOUCH IT!) - complex(kind=default), dimension(4) :: a - end type conjspinor - type, public :: spinor - ! private (omegalib needs access, but DON'T TOUCH IT!) - complex(kind=default), dimension(4) :: a - end type spinor - \LA{}Declaration of operations for spinors\RA{} - integer, parameter, public :: omega_spinors_2003_03_A = 0 -contains - \LA{}Implementation of operations for spinors\RA{} -end module omega_spinors -\nwendcode{}\nwbegindocs{13}\nwdocspar -\nwenddocs{}\nwbegincode{14}\moddef{\code{}intrinsic\ ::\ abs\edoc{} (if working)}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -intrinsic :: abs -\nwendcode{}\nwbegindocs{15}\nwdocspar -\nwenddocs{}\nwbegincode{16}\moddef{\code{}intrinsic\ ::\ conjg\edoc{} (if working)}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -intrinsic :: conjg -\nwendcode{}\nwbegindocs{17}well, the Intel Fortran Compiler chokes on these with an internal error: -\nwenddocs{}\nwbegincode{18}\moddef{\code{}intrinsic\ ::\ abs\edoc{}}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -\nwendcode{}\nwbegindocs{19}\nwdocspar -\nwenddocs{}\nwbegincode{20}\moddef{\code{}intrinsic\ ::\ conjg\edoc{}}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -\nwendcode{}\nwbegindocs{21}\nwdocspar -\subsection{Inner Product} -\nwenddocs{}\nwbegincode{22}\moddef{Declaration of operations for spinors}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -interface operator (*) - module procedure conjspinor_spinor -end interface -private :: conjspinor_spinor -\nwendcode{}\nwbegindocs{23}\nwdocspar -\begin{equation} - \bar\psi\psi' -\end{equation} -NB: {\Tt{}dot{\_}product\nwendquote} conjugates its first argument, we can either -cancel this or inline {\Tt{}dot{\_}product\nwendquote}: -\nwenddocs{}\nwbegincode{24}\moddef{Implementation of operations for spinors}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function conjspinor_spinor (psibar, psi) result (psibarpsi) - complex(kind=default) :: psibarpsi - type(conjspinor), intent(in) :: psibar - type(spinor), intent(in) :: psi - psibarpsi = psibar%a(1)*psi%a(1) + psibar%a(2)*psi%a(2) & - + psibar%a(3)*psi%a(3) + psibar%a(4)*psi%a(4) -end function conjspinor_spinor -\nwendcode{}\nwbegindocs{25}\nwdocspar -\nwenddocs{}\nwbegincode{26}\moddef{Operations for spinors (Fortran77)}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup - subroutine o7css (acc, pb, p) - implicit none - double complex acc, pb(4), p(4) - acc = acc + pb(1)*p(1) + pb(2)*p(2) + pb(3)*p(3) + pb(4)*p(4) - end -\nwendcode{}\nwbegindocs{27}\nwdocspar -\subsection{Spinor Vector Space} -\subsubsection{Scalar Multiplication} -\nwenddocs{}\nwbegincode{28}\moddef{Declaration of operations for spinors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -interface operator (*) - module procedure integer_spinor, spinor_integer, & - real_spinor, double_spinor, & - complex_spinor, dcomplex_spinor, & - spinor_real, spinor_double, & - spinor_complex, spinor_dcomplex -end interface -private :: integer_spinor, spinor_integer, real_spinor, & - double_spinor, complex_spinor, dcomplex_spinor, & - spinor_real, spinor_double, spinor_complex, spinor_dcomplex -\nwendcode{}\nwbegindocs{29}\nwdocspar -\nwenddocs{}\nwbegincode{30}\moddef{Implementation of operations for spinors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function integer_spinor (x, y) result (xy) - integer, intent(in) :: x - type(spinor), intent(in) :: y - type(spinor) :: xy - xy%a = x * y%a -end function integer_spinor -\nwendcode{}\nwbegindocs{31}\nwdocspar -\nwenddocs{}\nwbegincode{32}\moddef{Implementation of operations for spinors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function real_spinor (x, y) result (xy) - real(kind=single), intent(in) :: x - type(spinor), intent(in) :: y - type(spinor) :: xy - xy%a = x * y%a -end function real_spinor -pure function double_spinor (x, y) result (xy) - real(kind=default), intent(in) :: x - type(spinor), intent(in) :: y - type(spinor) :: xy - xy%a = x * y%a -end function double_spinor -pure function complex_spinor (x, y) result (xy) - complex(kind=single), intent(in) :: x - type(spinor), intent(in) :: y - type(spinor) :: xy - xy%a = x * y%a -end function complex_spinor -pure function dcomplex_spinor (x, y) result (xy) - complex(kind=default), intent(in) :: x - type(spinor), intent(in) :: y - type(spinor) :: xy - xy%a = x * y%a -end function dcomplex_spinor -pure function spinor_integer (y, x) result (xy) - integer, intent(in) :: x - type(spinor), intent(in) :: y - type(spinor) :: xy - xy%a = x * y%a -end function spinor_integer -pure function spinor_real (y, x) result (xy) - real(kind=single), intent(in) :: x - type(spinor), intent(in) :: y - type(spinor) :: xy - xy%a = x * y%a -end function spinor_real -pure function spinor_double (y, x) result (xy) - real(kind=default), intent(in) :: x - type(spinor), intent(in) :: y - type(spinor) :: xy - xy%a = x * y%a -end function spinor_double -pure function spinor_complex (y, x) result (xy) - complex(kind=single), intent(in) :: x - type(spinor), intent(in) :: y - type(spinor) :: xy - xy%a = x * y%a -end function spinor_complex -pure function spinor_dcomplex (y, x) result (xy) - complex(kind=default), intent(in) :: x - type(spinor), intent(in) :: y - type(spinor) :: xy - xy%a = x * y%a -end function spinor_dcomplex -\nwendcode{}\nwbegindocs{33}\nwdocspar -\nwenddocs{}\nwbegincode{34}\moddef{Declaration of operations for spinors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -interface operator (*) - module procedure integer_conjspinor, conjspinor_integer, & - real_conjspinor, double_conjspinor, & - complex_conjspinor, dcomplex_conjspinor, & - conjspinor_real, conjspinor_double, & - conjspinor_complex, conjspinor_dcomplex -end interface -private :: integer_conjspinor, conjspinor_integer, real_conjspinor, & - double_conjspinor, complex_conjspinor, dcomplex_conjspinor, & - conjspinor_real, conjspinor_double, conjspinor_complex, & - conjspinor_dcomplex -\nwendcode{}\nwbegindocs{35}\nwdocspar -\nwenddocs{}\nwbegincode{36}\moddef{Implementation of operations for spinors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function integer_conjspinor (x, y) result (xy) - integer, intent(in) :: x - type(conjspinor), intent(in) :: y - type(conjspinor) :: xy - xy%a = x * y%a -end function integer_conjspinor -pure function real_conjspinor (x, y) result (xy) - real(kind=single), intent(in) :: x - type(conjspinor), intent(in) :: y - type(conjspinor) :: xy - xy%a = x * y%a -end function real_conjspinor -pure function double_conjspinor (x, y) result (xy) - real(kind=default), intent(in) :: x - type(conjspinor), intent(in) :: y - type(conjspinor) :: xy - xy%a = x * y%a -end function double_conjspinor -pure function complex_conjspinor (x, y) result (xy) - complex(kind=single), intent(in) :: x - type(conjspinor), intent(in) :: y - type(conjspinor) :: xy - xy%a = x * y%a -end function complex_conjspinor -pure function dcomplex_conjspinor (x, y) result (xy) - complex(kind=default), intent(in) :: x - type(conjspinor), intent(in) :: y - type(conjspinor) :: xy - xy%a = x * y%a -end function dcomplex_conjspinor -pure function conjspinor_integer (y, x) result (xy) - integer, intent(in) :: x - type(conjspinor), intent(in) :: y - type(conjspinor) :: xy - xy%a = x * y%a -end function conjspinor_integer -pure function conjspinor_real (y, x) result (xy) - real(kind=single), intent(in) :: x - type(conjspinor), intent(in) :: y - type(conjspinor) :: xy - xy%a = x * y%a -end function conjspinor_real -pure function conjspinor_double (y, x) result (xy) - real(kind=default), intent(in) :: x - type(conjspinor), intent(in) :: y - type(conjspinor) :: xy - xy%a = x * y%a -end function conjspinor_double -pure function conjspinor_complex (y, x) result (xy) - complex(kind=single), intent(in) :: x - type(conjspinor), intent(in) :: y - type(conjspinor) :: xy - xy%a = x * y%a -end function conjspinor_complex -pure function conjspinor_dcomplex (y, x) result (xy) - complex(kind=default), intent(in) :: x - type(conjspinor), intent(in) :: y - type(conjspinor) :: xy - xy%a = x * y%a -end function conjspinor_dcomplex -\nwendcode{}\nwbegindocs{37}\nwdocspar -\subsubsection{Unary Plus and Minus} -\nwenddocs{}\nwbegincode{38}\moddef{Declaration of operations for spinors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -interface operator (+) - module procedure plus_spinor, plus_conjspinor -end interface -private :: plus_spinor, plus_conjspinor -interface operator (-) - module procedure neg_spinor, neg_conjspinor -end interface -private :: neg_spinor, neg_conjspinor -\nwendcode{}\nwbegindocs{39}\nwdocspar -\nwenddocs{}\nwbegincode{40}\moddef{Implementation of operations for spinors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function plus_spinor (x) result (plus_x) - type(spinor), intent(in) :: x - type(spinor) :: plus_x - plus_x%a = x%a -end function plus_spinor -pure function neg_spinor (x) result (neg_x) - type(spinor), intent(in) :: x - type(spinor) :: neg_x - neg_x%a = - x%a -end function neg_spinor -\nwendcode{}\nwbegindocs{41}\nwdocspar -\nwenddocs{}\nwbegincode{42}\moddef{Implementation of operations for spinors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function plus_conjspinor (x) result (plus_x) - type(conjspinor), intent(in) :: x - type(conjspinor) :: plus_x - plus_x%a = x%a -end function plus_conjspinor -pure function neg_conjspinor (x) result (neg_x) - type(conjspinor), intent(in) :: x - type(conjspinor) :: neg_x - neg_x%a = - x%a -end function neg_conjspinor -\nwendcode{}\nwbegindocs{43}\nwdocspar -\subsubsection{Addition and Subtraction} -\nwenddocs{}\nwbegincode{44}\moddef{Declaration of operations for spinors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -interface operator (+) - module procedure add_spinor, add_conjspinor -end interface -private :: add_spinor, add_conjspinor -interface operator (-) - module procedure sub_spinor, sub_conjspinor -end interface -private :: sub_spinor, sub_conjspinor -\nwendcode{}\nwbegindocs{45}\nwdocspar -\nwenddocs{}\nwbegincode{46}\moddef{Implementation of operations for spinors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function add_spinor (x, y) result (xy) - type(spinor), intent(in) :: x, y - type(spinor) :: xy - xy%a = x%a + y%a -end function add_spinor -pure function sub_spinor (x, y) result (xy) - type(spinor), intent(in) :: x, y - type(spinor) :: xy - xy%a = x%a - y%a -end function sub_spinor -\nwendcode{}\nwbegindocs{47}\nwdocspar -\nwenddocs{}\nwbegincode{48}\moddef{Implementation of operations for spinors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function add_conjspinor (x, y) result (xy) - type(conjspinor), intent(in) :: x, y - type(conjspinor) :: xy - xy%a = x%a + y%a -end function add_conjspinor -pure function sub_conjspinor (x, y) result (xy) - type(conjspinor), intent(in) :: x, y - type(conjspinor) :: xy - xy%a = x%a - y%a -end function sub_conjspinor -\nwendcode{}\nwbegindocs{49}\nwdocspar -\subsection{Norm} -\nwenddocs{}\nwbegincode{50}\moddef{Declaration of operations for spinors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -interface abs - module procedure abs_spinor, abs_conjspinor -end interface -private :: abs_spinor, abs_conjspinor -\nwendcode{}\nwbegindocs{51}\nwdocspar -\nwenddocs{}\nwbegincode{52}\moddef{Implementation of operations for spinors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function abs_spinor (psi) result (x) - type(spinor), intent(in) :: psi - real(kind=default) :: x - x = sqrt (dot_product (psi%a, psi%a)) -end function abs_spinor -\nwendcode{}\nwbegindocs{53}\nwdocspar -\nwenddocs{}\nwbegincode{54}\moddef{Implementation of operations for spinors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function abs_conjspinor (psibar) result (x) - real(kind=default) :: x - type(conjspinor), intent(in) :: psibar - x = sqrt (dot_product (psibar%a, psibar%a)) -end function abs_conjspinor -\nwendcode{}\nwbegindocs{55}\nwdocspar -\section{Spinors Revisited} -\nwenddocs{}\nwbegincode{56}\moddef{\code{}omega{\_}bispinors.f95\edoc{}}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -\LA{}Copyleft\RA{} -module omega_bispinors - use kinds - use omega_constants - implicit none - private - public :: operator (*), operator (+), operator (-) - public :: abs - type, public :: bispinor - ! private (omegalib needs access, but DON'T TOUCH IT!) - complex(kind=default), dimension(4) :: a - end type bispinor - \LA{}Declaration of operations for bispinors\RA{} - integer, parameter, public :: omega_bispinors_2003_03_A = 0 -contains - \LA{}Implementation of operations for bispinors\RA{} -end module omega_bispinors -\nwendcode{}\nwbegindocs{57}\nwdocspar -\nwenddocs{}\nwbegincode{58}\moddef{Declaration of operations for bispinors}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -interface operator (*) - module procedure spinor_product -end interface -private :: spinor_product -\nwendcode{}\nwbegindocs{59}\nwdocspar -\begin{equation} - \bar\psi\psi' -\end{equation} -NB: {\Tt{}dot{\_}product\nwendquote} conjugates its first argument, we have to cancel this. -\nwenddocs{}\nwbegincode{60}\moddef{Implementation of operations for bispinors}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function spinor_product (psil, psir) result (psilpsir) - complex(kind=default) :: psilpsir - type(bispinor), intent(in) :: psil, psir - type(bispinor) :: psidum - psidum%a(1) = psir%a(2) - psidum%a(2) = - psir%a(1) - psidum%a(3) = - psir%a(4) - psidum%a(4) = psir%a(3) - psilpsir = dot_product (conjg (psil%a), psidum%a) -end function spinor_product -\nwendcode{}\nwbegindocs{61}\nwdocspar -\subsection{Spinor Vector Space} -\subsubsection{Scalar Multiplication} -\nwenddocs{}\nwbegincode{62}\moddef{Declaration of operations for bispinors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -interface operator (*) - module procedure integer_bispinor, bispinor_integer, & - real_bispinor, double_bispinor, & - complex_bispinor, dcomplex_bispinor, & - bispinor_real, bispinor_double, & - bispinor_complex, bispinor_dcomplex -end interface -private :: integer_bispinor, bispinor_integer, real_bispinor, & - double_bispinor, complex_bispinor, dcomplex_bispinor, & - bispinor_real, bispinor_double, bispinor_complex, bispinor_dcomplex -\nwendcode{}\nwbegindocs{63}\nwdocspar -\nwenddocs{}\nwbegincode{64}\moddef{Implementation of operations for bispinors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function integer_bispinor (x, y) result (xy) - type(bispinor) :: xy - integer, intent(in) :: x - type(bispinor), intent(in) :: y - xy%a = x * y%a -end function integer_bispinor -\nwendcode{}\nwbegindocs{65}\nwdocspar -\nwenddocs{}\nwbegincode{66}\moddef{Implementation of operations for bispinors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function real_bispinor (x, y) result (xy) - type(bispinor) :: xy - real(kind=single), intent(in) :: x - type(bispinor), intent(in) :: y - xy%a = x * y%a -end function real_bispinor -\nwendcode{}\nwbegindocs{67}\nwdocspar -\nwenddocs{}\nwbegincode{68}\moddef{Implementation of operations for bispinors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function double_bispinor (x, y) result (xy) - type(bispinor) :: xy - real(kind=default), intent(in) :: x - type(bispinor), intent(in) :: y - xy%a = x * y%a -end function double_bispinor -\nwendcode{}\nwbegindocs{69}\nwdocspar -\nwenddocs{}\nwbegincode{70}\moddef{Implementation of operations for bispinors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function complex_bispinor (x, y) result (xy) - type(bispinor) :: xy - complex(kind=single), intent(in) :: x - type(bispinor), intent(in) :: y - xy%a = x * y%a -end function complex_bispinor -\nwendcode{}\nwbegindocs{71}\nwdocspar -\nwenddocs{}\nwbegincode{72}\moddef{Implementation of operations for bispinors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function dcomplex_bispinor (x, y) result (xy) - type(bispinor) :: xy - complex(kind=default), intent(in) :: x - type(bispinor), intent(in) :: y - xy%a = x * y%a -end function dcomplex_bispinor -\nwendcode{}\nwbegindocs{73}\nwdocspar -\nwenddocs{}\nwbegincode{74}\moddef{Implementation of operations for bispinors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function bispinor_integer (y, x) result (xy) - type(bispinor) :: xy - integer, intent(in) :: x - type(bispinor), intent(in) :: y - xy%a = x * y%a -end function bispinor_integer -\nwendcode{}\nwbegindocs{75}\nwdocspar -\nwenddocs{}\nwbegincode{76}\moddef{Implementation of operations for bispinors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function bispinor_real (y, x) result (xy) - type(bispinor) :: xy - real(kind=single), intent(in) :: x - type(bispinor), intent(in) :: y - xy%a = x * y%a -end function bispinor_real -\nwendcode{}\nwbegindocs{77}\nwdocspar -\nwenddocs{}\nwbegincode{78}\moddef{Implementation of operations for bispinors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function bispinor_double (y, x) result (xy) - type(bispinor) :: xy - real(kind=default), intent(in) :: x - type(bispinor), intent(in) :: y - xy%a = x * y%a -end function bispinor_double -\nwendcode{}\nwbegindocs{79}\nwdocspar -\nwenddocs{}\nwbegincode{80}\moddef{Implementation of operations for bispinors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function bispinor_complex (y, x) result (xy) - type(bispinor) :: xy - complex(kind=single), intent(in) :: x - type(bispinor), intent(in) :: y - xy%a = x * y%a -end function bispinor_complex -\nwendcode{}\nwbegindocs{81}\nwdocspar -\nwenddocs{}\nwbegincode{82}\moddef{Implementation of operations for bispinors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function bispinor_dcomplex (y, x) result (xy) - type(bispinor) :: xy - complex(kind=default), intent(in) :: x - type(bispinor), intent(in) :: y - xy%a = x * y%a -end function bispinor_dcomplex -\nwendcode{}\nwbegindocs{83}\nwdocspar -\subsubsection{Unary Plus and Minus} -\nwenddocs{}\nwbegincode{84}\moddef{Declaration of operations for bispinors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -interface operator (+) - module procedure plus_bispinor -end interface -private :: plus_bispinor -interface operator (-) - module procedure neg_bispinor -end interface -private :: neg_bispinor -\nwendcode{}\nwbegindocs{85}\nwdocspar -\nwenddocs{}\nwbegincode{86}\moddef{Implementation of operations for bispinors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function plus_bispinor (x) result (plus_x) - type(bispinor) :: plus_x - type(bispinor), intent(in) :: x - plus_x%a = x%a -end function plus_bispinor -\nwendcode{}\nwbegindocs{87}\nwdocspar -\nwenddocs{}\nwbegincode{88}\moddef{Implementation of operations for bispinors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function neg_bispinor (x) result (neg_x) - type(bispinor) :: neg_x - type(bispinor), intent(in) :: x - neg_x%a = - x%a -end function neg_bispinor -\nwendcode{}\nwbegindocs{89}\nwdocspar -\subsubsection{Addition and Subtraction} -\nwenddocs{}\nwbegincode{90}\moddef{Declaration of operations for bispinors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -interface operator (+) - module procedure add_bispinor -end interface -private :: add_bispinor -interface operator (-) - module procedure sub_bispinor -end interface -private :: sub_bispinor -\nwendcode{}\nwbegindocs{91}\nwdocspar -\nwenddocs{}\nwbegincode{92}\moddef{Implementation of operations for bispinors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function add_bispinor (x, y) result (xy) - type(bispinor) :: xy - type(bispinor), intent(in) :: x, y - xy%a = x%a + y%a -end function add_bispinor -\nwendcode{}\nwbegindocs{93}\nwdocspar -\nwenddocs{}\nwbegincode{94}\moddef{Implementation of operations for bispinors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function sub_bispinor (x, y) result (xy) - type(bispinor) :: xy - type(bispinor), intent(in) :: x, y - xy%a = x%a - y%a -end function sub_bispinor -\nwendcode{}\nwbegindocs{95}\nwdocspar -\subsection{Norm} -\nwenddocs{}\nwbegincode{96}\moddef{Declaration of operations for bispinors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -interface abs - module procedure abs_bispinor -end interface -private :: abs_bispinor -\nwendcode{}\nwbegindocs{97}\nwdocspar -\nwenddocs{}\nwbegincode{98}\moddef{Implementation of operations for bispinors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function abs_bispinor (psi) result (x) - real(kind=default) :: x - type(bispinor), intent(in) :: psi - x = sqrt (dot_product (psi%a, psi%a)) -end function abs_bispinor -\nwendcode{}\nwbegindocs{99}\nwdocspar -\section{Vectorspinors} -\nwenddocs{}\nwbegincode{100}\moddef{\code{}omega{\_}vectorspinors.f95\edoc{}}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -\LA{}Copyleft\RA{} -module omega_vectorspinors - use kinds - use omega_constants - use omega_bispinors - use omega_vectors - implicit none - private - public :: operator (*), operator (+), operator (-) - public :: abs - type, public :: vectorspinor - ! private (omegalib needs access, but DON'T TOUCH IT!) - type(bispinor), dimension(4) :: psi - end type vectorspinor - \LA{}Declaration of operations for vectorspinors\RA{} - integer, parameter, public :: omega_vectorspinors_2003_03_A = 0 -contains - \LA{}Implementation of operations for vectorspinors\RA{} -end module omega_vectorspinors -\nwendcode{}\nwbegindocs{101}\nwdocspar -\nwenddocs{}\nwbegincode{102}\moddef{Declaration of operations for vectorspinors}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -interface operator (*) - module procedure vspinor_product -end interface -private :: vspinor_product -\nwendcode{}\nwbegindocs{103}\nwdocspar -\begin{equation} - \bar\psi^\mu\psi'_\mu -\end{equation} -\nwenddocs{}\nwbegincode{104}\moddef{Implementation of operations for vectorspinors}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function vspinor_product (psil, psir) result (psilpsir) - complex(kind=default) :: psilpsir - type(vectorspinor), intent(in) :: psil, psir - psilpsir = psil%psi(1) * psir%psi(1) & - - psil%psi(2) * psir%psi(2) & - - psil%psi(3) * psir%psi(3) & - - psil%psi(4) * psir%psi(4) -end function vspinor_product -\nwendcode{}\nwbegindocs{105}\nwdocspar -\subsection{Vectorspinor Vector Space} -\subsubsection{Scalar Multiplication} -\nwenddocs{}\nwbegincode{106}\moddef{Declaration of operations for vectorspinors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -interface operator (*) - module procedure integer_vectorspinor, vectorspinor_integer, & - real_vectorspinor, double_vectorspinor, & - complex_vectorspinor, dcomplex_vectorspinor, & - vectorspinor_real, vectorspinor_double, & - vectorspinor_complex, vectorspinor_dcomplex, & - momentum_vectorspinor, vectorspinor_momentum -end interface -private :: integer_vectorspinor, vectorspinor_integer, real_vectorspinor, & - double_vectorspinor, complex_vectorspinor, dcomplex_vectorspinor, & - vectorspinor_real, vectorspinor_double, vectorspinor_complex, & - vectorspinor_dcomplex -\nwendcode{}\nwbegindocs{107}\nwdocspar -\nwenddocs{}\nwbegincode{108}\moddef{Implementation of operations for vectorspinors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function integer_vectorspinor (x, y) result (xy) - type(vectorspinor) :: xy - integer, intent(in) :: x - type(vectorspinor), intent(in) :: y - integer :: k - do k = 1,4 - xy%psi(k) = x * y%psi(k) - end do -end function integer_vectorspinor -\nwendcode{}\nwbegindocs{109}\nwdocspar -\nwenddocs{}\nwbegincode{110}\moddef{Implementation of operations for vectorspinors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function real_vectorspinor (x, y) result (xy) - type(vectorspinor) :: xy - real(kind=single), intent(in) :: x - type(vectorspinor), intent(in) :: y - integer :: k - do k = 1,4 - xy%psi(k) = x * y%psi(k) - end do -end function real_vectorspinor -\nwendcode{}\nwbegindocs{111}\nwdocspar -\nwenddocs{}\nwbegincode{112}\moddef{Implementation of operations for vectorspinors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function double_vectorspinor (x, y) result (xy) - type(vectorspinor) :: xy - real(kind=default), intent(in) :: x - type(vectorspinor), intent(in) :: y - integer :: k - do k = 1,4 - xy%psi(k) = x * y%psi(k) - end do -end function double_vectorspinor -\nwendcode{}\nwbegindocs{113}\nwdocspar -\nwenddocs{}\nwbegincode{114}\moddef{Implementation of operations for vectorspinors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function complex_vectorspinor (x, y) result (xy) - type(vectorspinor) :: xy - complex(kind=single), intent(in) :: x - type(vectorspinor), intent(in) :: y - integer :: k - do k = 1,4 - xy%psi(k) = x * y%psi(k) - end do -end function complex_vectorspinor -\nwendcode{}\nwbegindocs{115}\nwdocspar -\nwenddocs{}\nwbegincode{116}\moddef{Implementation of operations for vectorspinors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function dcomplex_vectorspinor (x, y) result (xy) - type(vectorspinor) :: xy - complex(kind=default), intent(in) :: x - type(vectorspinor), intent(in) :: y - integer :: k - do k = 1,4 - xy%psi(k) = x * y%psi(k) - end do -end function dcomplex_vectorspinor -\nwendcode{}\nwbegindocs{117}\nwdocspar -\nwenddocs{}\nwbegincode{118}\moddef{Implementation of operations for vectorspinors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function vectorspinor_integer (y, x) result (xy) - type(vectorspinor) :: xy - integer, intent(in) :: x - type(vectorspinor), intent(in) :: y - integer :: k - do k = 1,4 - xy%psi(k) = y%psi(k) * x - end do -end function vectorspinor_integer -\nwendcode{}\nwbegindocs{119}\nwdocspar -\nwenddocs{}\nwbegincode{120}\moddef{Implementation of operations for vectorspinors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function vectorspinor_real (y, x) result (xy) - type(vectorspinor) :: xy - real(kind=single), intent(in) :: x - type(vectorspinor), intent(in) :: y - integer :: k - do k = 1,4 - xy%psi(k) = y%psi(k) * x - end do -end function vectorspinor_real -\nwendcode{}\nwbegindocs{121}\nwdocspar -\nwenddocs{}\nwbegincode{122}\moddef{Implementation of operations for vectorspinors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function vectorspinor_double (y, x) result (xy) - type(vectorspinor) :: xy - real(kind=default), intent(in) :: x - type(vectorspinor), intent(in) :: y - integer :: k - do k = 1,4 - xy%psi(k) = y%psi(k) * x - end do -end function vectorspinor_double -\nwendcode{}\nwbegindocs{123}\nwdocspar -\nwenddocs{}\nwbegincode{124}\moddef{Implementation of operations for vectorspinors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function vectorspinor_complex (y, x) result (xy) - type(vectorspinor) :: xy - complex(kind=single), intent(in) :: x - type(vectorspinor), intent(in) :: y - integer :: k - do k = 1,4 - xy%psi(k) = y%psi(k) * x - end do -end function vectorspinor_complex -\nwendcode{}\nwbegindocs{125}\nwdocspar -\nwenddocs{}\nwbegincode{126}\moddef{Implementation of operations for vectorspinors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function vectorspinor_dcomplex (y, x) result (xy) - type(vectorspinor) :: xy - complex(kind=default), intent(in) :: x - type(vectorspinor), intent(in) :: y - integer :: k - do k = 1,4 - xy%psi(k) = y%psi(k) * x - end do -end function vectorspinor_dcomplex -\nwendcode{}\nwbegindocs{127}\nwdocspar -\nwenddocs{}\nwbegincode{128}\moddef{Implementation of operations for vectorspinors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function momentum_vectorspinor (y, x) result (xy) - type(bispinor) :: xy - type(momentum), intent(in) :: y - type(vectorspinor), intent(in) :: x - integer :: k - do k = 1,4 - xy%a(k) = y%t * x%psi(1)%a(k) - y%x(1) * x%psi(2)%a(k) - & - y%x(2) * x%psi(3)%a(k) - y%x(3) * x%psi(4)%a(k) - end do -end function momentum_vectorspinor -\nwendcode{}\nwbegindocs{129}\nwdocspar -\nwenddocs{}\nwbegincode{130}\moddef{Implementation of operations for vectorspinors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function vectorspinor_momentum (y, x) result (xy) - type(bispinor) :: xy - type(momentum), intent(in) :: x - type(vectorspinor), intent(in) :: y - integer :: k - do k = 1,4 - xy%a(k) = x%t * y%psi(1)%a(k) - x%x(1) * y%psi(2)%a(k) - & - x%x(2) * y%psi(3)%a(k) - x%x(3) * y%psi(4)%a(k) - end do -end function vectorspinor_momentum -\nwendcode{}\nwbegindocs{131} -\subsubsection{Unary Plus and Minus} -\nwenddocs{}\nwbegincode{132}\moddef{Declaration of operations for vectorspinors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -interface operator (+) - module procedure plus_vectorspinor -end interface -private :: plus_vectorspinor -interface operator (-) - module procedure neg_vectorspinor -end interface -private :: neg_vectorspinor -\nwendcode{}\nwbegindocs{133}\nwdocspar -\nwenddocs{}\nwbegincode{134}\moddef{Implementation of operations for vectorspinors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function plus_vectorspinor (x) result (plus_x) - type(vectorspinor) :: plus_x - type(vectorspinor), intent(in) :: x - integer :: k - do k = 1,4 - plus_x%psi(k) = + x%psi(k) - end do -end function plus_vectorspinor -\nwendcode{}\nwbegindocs{135}\nwdocspar -\nwenddocs{}\nwbegincode{136}\moddef{Implementation of operations for vectorspinors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function neg_vectorspinor (x) result (neg_x) - type(vectorspinor) :: neg_x - type(vectorspinor), intent(in) :: x - integer :: k - do k = 1,4 - neg_x%psi(k) = - x%psi(k) - end do -end function neg_vectorspinor -\nwendcode{}\nwbegindocs{137}\nwdocspar -\subsubsection{Addition and Subtraction} -\nwenddocs{}\nwbegincode{138}\moddef{Declaration of operations for vectorspinors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -interface operator (+) - module procedure add_vectorspinor -end interface -private :: add_vectorspinor -interface operator (-) - module procedure sub_vectorspinor -end interface -private :: sub_vectorspinor -\nwendcode{}\nwbegindocs{139}\nwdocspar -\nwenddocs{}\nwbegincode{140}\moddef{Implementation of operations for vectorspinors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function add_vectorspinor (x, y) result (xy) - type(vectorspinor) :: xy - type(vectorspinor), intent(in) :: x, y - integer :: k - do k = 1,4 - xy%psi(k) = x%psi(k) + y%psi(k) - end do -end function add_vectorspinor -\nwendcode{}\nwbegindocs{141}\nwdocspar -\nwenddocs{}\nwbegincode{142}\moddef{Implementation of operations for vectorspinors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function sub_vectorspinor (x, y) result (xy) - type(vectorspinor) :: xy - type(vectorspinor), intent(in) :: x, y - integer :: k - do k = 1,4 - xy%psi(k) = x%psi(k) - y%psi(k) - end do -end function sub_vectorspinor -\nwendcode{}\nwbegindocs{143}\nwdocspar -\subsection{Norm} -\nwenddocs{}\nwbegincode{144}\moddef{Declaration of operations for vectorspinors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -interface abs - module procedure abs_vectorspinor -end interface -private :: abs_vectorspinor -\nwendcode{}\nwbegindocs{145}\nwdocspar -\nwenddocs{}\nwbegincode{146}\moddef{Implementation of operations for vectorspinors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function abs_vectorspinor (psi) result (x) - real(kind=default) :: x - type(vectorspinor), intent(in) :: psi - x = sqrt (dot_product (psi%psi(1)%a, psi%psi(1)%a) & - - dot_product (psi%psi(2)%a, psi%psi(2)%a) & - - dot_product (psi%psi(3)%a, psi%psi(3)%a) & - - dot_product (psi%psi(4)%a, psi%psi(4)%a)) -end function abs_vectorspinor -\nwendcode{}\nwbegindocs{147}\nwdocspar -\section{Vectors and Tensors} -Condensed representation of antisymmetric rank-2 tensors: -\begin{equation} - \begin{pmatrix} - T^{00} & T^{01} & T^{02} & T^{03} \\ - T^{10} & T^{11} & T^{12} & T^{13} \\ - T^{20} & T^{21} & T^{22} & T^{23} \\ - T^{30} & T^{31} & T^{32} & T^{33} - \end{pmatrix} - = - \begin{pmatrix} - 0 & T_e^1 & T_e^2 & T_e^3 \\ - -T_e^1 & 0 & T_b^3 & -T_b^2 \\ - -T_e^2 & -T_b^3 & 0 & T_b^1 \\ - -T_e^3 & T_b^2 & -T_b^1 & 0 - \end{pmatrix} -\end{equation} -\nwenddocs{}\nwbegincode{148}\moddef{\code{}omega{\_}vectors.f95\edoc{}}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -\LA{}Copyleft\RA{} -module omega_vectors - use kinds - use omega_constants - implicit none - private - public :: assignment (=) - public :: operator (*), operator (+), operator (-), operator (.wedge.) - public :: abs, conjg - public :: random_momentum - \LA{}\code{}intrinsic\ ::\ abs\edoc{}\RA{} - \LA{}\code{}intrinsic\ ::\ conjg\edoc{}\RA{} - type, public :: momentum - ! private (omegalib needs access, but DON'T TOUCH IT!) - real(kind=default) :: t - real(kind=default), dimension(3) :: x - end type momentum - type, public :: vector - ! private (omegalib needs access, but DON'T TOUCH IT!) - complex(kind=default) :: t - complex(kind=default), dimension(3) :: x - end type vector - type, public :: tensor2odd - ! private (omegalib needs access, but DON'T TOUCH IT!) - complex(kind=default), dimension(3) :: e - complex(kind=default), dimension(3) :: b - end type tensor2odd - \LA{}Declaration of operations for vectors\RA{} - integer, parameter, public :: omega_vectors_2003_03_A = 0 -contains - \LA{}Implementation of operations for vectors\RA{} -end module omega_vectors -\nwendcode{}\nwbegindocs{149}\nwdocspar -\subsection{Constructors} -\nwenddocs{}\nwbegincode{150}\moddef{Declaration of operations for vectors}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -interface assignment (=) - module procedure momentum_of_array, vector_of_momentum, & - vector_of_array, vector_of_double_array, & - array_of_momentum, array_of_vector -end interface -private :: momentum_of_array, vector_of_momentum, vector_of_array, & - vector_of_double_array, array_of_momentum, array_of_vector -\nwendcode{}\nwbegindocs{151}\nwdocspar -\nwenddocs{}\nwbegincode{152}\moddef{Implementation of operations for vectors}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure subroutine momentum_of_array (m, p) - type(momentum), intent(out) :: m - real(kind=default), dimension(0:), intent(in) :: p - m%t = p(0) - m%x = p(1:3) -end subroutine momentum_of_array -pure subroutine array_of_momentum (p, v) - real(kind=default), dimension(0:), intent(out) :: p - type(momentum), intent(in) :: v - p(0) = v%t - p(1:3) = v%x -end subroutine array_of_momentum -\nwendcode{}\nwbegindocs{153}\nwdocspar -\nwenddocs{}\nwbegincode{154}\moddef{Implementation of operations for vectors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure subroutine vector_of_array (v, p) - type(vector), intent(out) :: v - complex(kind=default), dimension(0:), intent(in) :: p - v%t = p(0) - v%x = p(1:3) -end subroutine vector_of_array -pure subroutine vector_of_double_array (v, p) - type(vector), intent(out) :: v - real(kind=default), dimension(0:), intent(in) :: p - v%t = p(0) - v%x = p(1:3) -end subroutine vector_of_double_array -pure subroutine array_of_vector (p, v) - complex(kind=default), dimension(0:), intent(out) :: p - type(vector), intent(in) :: v - p(0) = v%t - p(1:3) = v%x -end subroutine array_of_vector -\nwendcode{}\nwbegindocs{155}\nwdocspar -\nwenddocs{}\nwbegincode{156}\moddef{Implementation of operations for vectors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure subroutine vector_of_momentum (v, p) - type(vector), intent(out) :: v - type(momentum), intent(in) :: p - v%t = p%t - v%x = p%x -end subroutine vector_of_momentum -\nwendcode{}\nwbegindocs{157}\nwdocspar -\nwenddocs{}\nwbegincode{158}\moddef{Operations for vectors (Fortran77)}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup - subroutine o7zv (v) - implicit none - double complex v(0:3) - v(0) = 0 - v(1) = 0 - v(2) = 0 - v(3) = 0 - end -\nwendcode{}\nwbegindocs{159}\nwdocspar -\nwenddocs{}\nwbegincode{160}\moddef{Operations for vectors (Fortran77)}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup - subroutine o7zt (t) - implicit none - double complex t(6) - integer i - do 10 i = 1, 6 - t(i) = 0 - 10 continue - end -\nwendcode{}\nwbegindocs{161}\nwdocspar -\subsection{Inner Products} -\nwenddocs{}\nwbegincode{162}\moddef{Declaration of operations for vectors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -interface operator (*) - module procedure momentum_momentum, vector_vector, & - vector_momentum, momentum_vector, tensor2odd_tensor2odd -end interface -private :: momentum_momentum, vector_vector, vector_momentum, & - momentum_vector, tensor2odd_tensor2odd -\nwendcode{}\nwbegindocs{163}\nwdocspar -\nwenddocs{}\nwbegincode{164}\moddef{Implementation of operations for vectors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function momentum_momentum (x, y) result (xy) - type(momentum), intent(in) :: x - type(momentum), intent(in) :: y - real(kind=default) :: xy - xy = x%t*y%t - x%x(1)*y%x(1) - x%x(2)*y%x(2) - x%x(3)*y%x(3) -end function momentum_momentum -pure function momentum_vector (x, y) result (xy) - type(momentum), intent(in) :: x - type(vector), intent(in) :: y - complex(kind=default) :: xy - xy = x%t*y%t - x%x(1)*y%x(1) - x%x(2)*y%x(2) - x%x(3)*y%x(3) -end function momentum_vector -pure function vector_momentum (x, y) result (xy) - type(vector), intent(in) :: x - type(momentum), intent(in) :: y - complex(kind=default) :: xy - xy = x%t*y%t - x%x(1)*y%x(1) - x%x(2)*y%x(2) - x%x(3)*y%x(3) -end function vector_momentum -pure function vector_vector (x, y) result (xy) - type(vector), intent(in) :: x - type(vector), intent(in) :: y - complex(kind=default) :: xy - xy = x%t*y%t - x%x(1)*y%x(1) - x%x(2)*y%x(2) - x%x(3)*y%x(3) -end function vector_vector -\nwendcode{}\nwbegindocs{165}\nwdocspar -\nwenddocs{}\nwbegincode{166}\moddef{Operations for vectors (Fortran77)}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup - subroutine o7vv (acc, x, y) - implicit none - double complex acc, x(0:3), y(0:3) - acc = acc + x(0)*y(0) - x(1)*y(1) - x(2)*y(2) - x(3)*y(3) - end -\nwendcode{}\nwbegindocs{167}\nwdocspar -Just like classical electrodynamics: -\begin{equation} - \frac{1}{2} T_{\mu\nu} U^{\mu\nu} - = \frac{1}{2} \left( - T^{0i} U^{0i} - T^{i0} U^{i0} + T^{ij} U^{ij} \right) - = T_b^k U_b^k - T_e^k U_e^k -\end{equation} -\nwenddocs{}\nwbegincode{168}\moddef{Implementation of operations for vectors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function tensor2odd_tensor2odd (x, y) result (xy) - type(tensor2odd), intent(in) :: x - type(tensor2odd), intent(in) :: y - complex(kind=default) :: xy - xy = x%b(1)*y%b(1) + x%b(2)*y%b(2) + x%b(3)*y%b(3) & - - x%e(1)*y%e(1) - x%e(2)*y%e(2) - x%e(3)*y%e(3) -end function tensor2odd_tensor2odd -\nwendcode{}\nwbegindocs{169}\nwdocspar -\nwenddocs{}\nwbegincode{170}\moddef{Operations for vectors (Fortran77)}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup - subroutine o7tt (acc, x, y) - implicit none - double complex acc, x(6), y(6) - acc = acc + x(4)*y(4) + x(5)*y(5) + x(6)*y(6) - $ - x(1)*y(1) - x(2)*y(2) - x(3)*y(3) - end -\nwendcode{}\nwbegindocs{171}\nwdocspar -\subsection{Not Entirely Inner Products} -\nwenddocs{}\nwbegincode{172}\moddef{Declaration of operations for vectors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -interface operator (*) - module procedure momentum_tensor2odd, tensor2odd_momentum, & - vector_tensor2odd, tensor2odd_vector -end interface -private :: momentum_tensor2odd, tensor2odd_momentum, vector_tensor2odd, & - tensor2odd_vector -\nwendcode{}\nwbegindocs{173}\nwdocspar -\begin{subequations} -\begin{align} - y^\nu = x_\mu T^{\mu\nu}: - & y^0 = - x^i T^{i0} = x^i T^{0i} \\ - & y^1 = x^0 T^{01} - x^2 T^{21} - x^3 T^{31} \\ - & y^2 = x^0 T^{02} - x^1 T^{12} - x^3 T^{32} \\ - & y^3 = x^0 T^{03} - x^1 T^{13} - x^2 T^{23} -\end{align} -\end{subequations} -\nwenddocs{}\nwbegincode{174}\moddef{Implementation of operations for vectors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function vector_tensor2odd (x, t2) result (xt2) - type(vector), intent(in) :: x - type(tensor2odd), intent(in) :: t2 - type(vector) :: xt2 - xt2%t = x%x(1)*t2%e(1) + x%x(2)*t2%e(2) + x%x(3)*t2%e(3) - xt2%x(1) = x%t*t2%e(1) + x%x(2)*t2%b(3) - x%x(3)*t2%b(2) - xt2%x(2) = x%t*t2%e(2) + x%x(3)*t2%b(1) - x%x(1)*t2%b(3) - xt2%x(3) = x%t*t2%e(3) + x%x(1)*t2%b(2) - x%x(2)*t2%b(1) -end function vector_tensor2odd -pure function momentum_tensor2odd (x, t2) result (xt2) - type(momentum), intent(in) :: x - type(tensor2odd), intent(in) :: t2 - type(vector) :: xt2 - xt2%t = x%x(1)*t2%e(1) + x%x(2)*t2%e(2) + x%x(3)*t2%e(3) - xt2%x(1) = x%t*t2%e(1) + x%x(2)*t2%b(3) - x%x(3)*t2%b(2) - xt2%x(2) = x%t*t2%e(2) + x%x(3)*t2%b(1) - x%x(1)*t2%b(3) - xt2%x(3) = x%t*t2%e(3) + x%x(1)*t2%b(2) - x%x(2)*t2%b(1) -end function momentum_tensor2odd -\nwendcode{}\nwbegindocs{175}\nwdocspar -\begin{subequations} -\begin{align} - y^\mu = T^{\mu\nu} x_\nu : - & y^0 = - T^{0i} x^i \\ - & y^1 = T^{10} x^0 - T^{12} x^2 - T^{13} x^3 \\ - & y^2 = T^{20} x^0 - T^{21} x^1 - T^{23} x^3 \\ - & y^3 = T^{30} x^0 - T^{31} x^1 - T^{32} x^2 -\end{align} -\end{subequations} -\nwenddocs{}\nwbegincode{176}\moddef{Implementation of operations for vectors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function tensor2odd_vector (t2, x) result (t2x) - type(tensor2odd), intent(in) :: t2 - type(vector), intent(in) :: x - type(vector) :: t2x - t2x%t = - t2%e(1)*x%x(1) - t2%e(2)*x%x(2) - t2%e(3)*x%x(3) - t2x%x(1) = - t2%e(1)*x%t + t2%b(2)*x%x(3) - t2%b(3)*x%x(2) - t2x%x(2) = - t2%e(2)*x%t + t2%b(3)*x%x(1) - t2%b(1)*x%x(3) - t2x%x(3) = - t2%e(3)*x%t + t2%b(1)*x%x(2) - t2%b(2)*x%x(1) -end function tensor2odd_vector -pure function tensor2odd_momentum (t2, x) result (t2x) - type(tensor2odd), intent(in) :: t2 - type(momentum), intent(in) :: x - type(vector) :: t2x - t2x%t = - t2%e(1)*x%x(1) - t2%e(2)*x%x(2) - t2%e(3)*x%x(3) - t2x%x(1) = - t2%e(1)*x%t + t2%b(2)*x%x(3) - t2%b(3)*x%x(2) - t2x%x(2) = - t2%e(2)*x%t + t2%b(3)*x%x(1) - t2%b(1)*x%x(3) - t2x%x(3) = - t2%e(3)*x%t + t2%b(1)*x%x(2) - t2%b(2)*x%x(1) -end function tensor2odd_momentum -\nwendcode{}\nwbegindocs{177}\nwdocspar -\subsection{Outer Products} -\nwenddocs{}\nwbegincode{178}\moddef{Declaration of operations for vectors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -interface operator (.wedge.) - module procedure momentum_wedge_momentum, & - momentum_wedge_vector, vector_wedge_momentum, vector_wedge_vector -end interface -private :: momentum_wedge_momentum, momentum_wedge_vector, & - vector_wedge_momentum, vector_wedge_vector -\nwendcode{}\nwbegindocs{179}\nwdocspar -\nwenddocs{}\nwbegincode{180}\moddef{Implementation of operations for vectors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function momentum_wedge_momentum (x, y) result (t2) - type(momentum), intent(in) :: x - type(momentum), intent(in) :: y - type(tensor2odd) :: t2 - t2%e = x%t * y%x - x%x * y%t - t2%b(1) = x%x(2) * y%x(3) - x%x(3) * y%x(2) - t2%b(2) = x%x(3) * y%x(1) - x%x(1) * y%x(3) - t2%b(3) = x%x(1) * y%x(2) - x%x(2) * y%x(1) -end function momentum_wedge_momentum -pure function momentum_wedge_vector (x, y) result (t2) - type(momentum), intent(in) :: x - type(vector), intent(in) :: y - type(tensor2odd) :: t2 - t2%e = x%t * y%x - x%x * y%t - t2%b(1) = x%x(2) * y%x(3) - x%x(3) * y%x(2) - t2%b(2) = x%x(3) * y%x(1) - x%x(1) * y%x(3) - t2%b(3) = x%x(1) * y%x(2) - x%x(2) * y%x(1) -end function momentum_wedge_vector -pure function vector_wedge_momentum (x, y) result (t2) - type(vector), intent(in) :: x - type(momentum), intent(in) :: y - type(tensor2odd) :: t2 - t2%e = x%t * y%x - x%x * y%t - t2%b(1) = x%x(2) * y%x(3) - x%x(3) * y%x(2) - t2%b(2) = x%x(3) * y%x(1) - x%x(1) * y%x(3) - t2%b(3) = x%x(1) * y%x(2) - x%x(2) * y%x(1) -end function vector_wedge_momentum -pure function vector_wedge_vector (x, y) result (t2) - type(vector), intent(in) :: x - type(vector), intent(in) :: y - type(tensor2odd) :: t2 - t2%e = x%t * y%x - x%x * y%t - t2%b(1) = x%x(2) * y%x(3) - x%x(3) * y%x(2) - t2%b(2) = x%x(3) * y%x(1) - x%x(1) * y%x(3) - t2%b(3) = x%x(1) * y%x(2) - x%x(2) * y%x(1) -end function vector_wedge_vector -\nwendcode{}\nwbegindocs{181}\nwdocspar -\subsection{Vector Space} -\subsubsection{Scalar Multiplication} -\nwenddocs{}\nwbegincode{182}\moddef{Declaration of operations for vectors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -interface operator (*) - module procedure integer_momentum, real_momentum, double_momentum, & - complex_momentum, dcomplex_momentum, & - integer_vector, real_vector, double_vector, & - complex_vector, dcomplex_vector, & - integer_tensor2odd, real_tensor2odd, double_tensor2odd, & - complex_tensor2odd, dcomplex_tensor2odd, & - momentum_integer, momentum_real, momentum_double, & - momentum_complex, momentum_dcomplex, & - vector_integer, vector_real, vector_double, & - vector_complex, vector_dcomplex, & - tensor2odd_integer, tensor2odd_real, tensor2odd_double, & - tensor2odd_complex, tensor2odd_dcomplex -end interface -private :: integer_momentum, real_momentum, double_momentum, & - complex_momentum, dcomplex_momentum, integer_vector, real_vector, & - double_vector, complex_vector, dcomplex_vector, & - integer_tensor2odd, real_tensor2odd, double_tensor2odd, & - complex_tensor2odd, dcomplex_tensor2odd, momentum_integer, & - momentum_real, momentum_double, momentum_complex, & - momentum_dcomplex, vector_integer, vector_real, vector_double, & - vector_complex, vector_dcomplex, tensor2odd_integer, & - tensor2odd_real, tensor2odd_double, tensor2odd_complex, & - tensor2odd_dcomplex -\nwendcode{}\nwbegindocs{183}\nwdocspar -\nwenddocs{}\nwbegincode{184}\moddef{Implementation of operations for vectors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function integer_momentum (x, y) result (xy) - integer, intent(in) :: x - type(momentum), intent(in) :: y - type(momentum) :: xy - xy%t = x * y%t - xy%x = x * y%x -end function integer_momentum -pure function real_momentum (x, y) result (xy) - real(kind=single), intent(in) :: x - type(momentum), intent(in) :: y - type(momentum) :: xy - xy%t = x * y%t - xy%x = x * y%x -end function real_momentum -pure function double_momentum (x, y) result (xy) - real(kind=default), intent(in) :: x - type(momentum), intent(in) :: y - type(momentum) :: xy - xy%t = x * y%t - xy%x = x * y%x -end function double_momentum -pure function complex_momentum (x, y) result (xy) - complex(kind=single), intent(in) :: x - type(momentum), intent(in) :: y - type(vector) :: xy - xy%t = x * y%t - xy%x = x * y%x -end function complex_momentum -pure function dcomplex_momentum (x, y) result (xy) - complex(kind=default), intent(in) :: x - type(momentum), intent(in) :: y - type(vector) :: xy - xy%t = x * y%t - xy%x = x * y%x -end function dcomplex_momentum -\nwendcode{}\nwbegindocs{185}\nwdocspar -\nwenddocs{}\nwbegincode{186}\moddef{Implementation of operations for vectors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function integer_vector (x, y) result (xy) - integer, intent(in) :: x - type(vector), intent(in) :: y - type(vector) :: xy - xy%t = x * y%t - xy%x = x * y%x -end function integer_vector -pure function real_vector (x, y) result (xy) - real(kind=single), intent(in) :: x - type(vector), intent(in) :: y - type(vector) :: xy - xy%t = x * y%t - xy%x = x * y%x -end function real_vector -pure function double_vector (x, y) result (xy) - real(kind=default), intent(in) :: x - type(vector), intent(in) :: y - type(vector) :: xy - xy%t = x * y%t - xy%x = x * y%x -end function double_vector -pure function complex_vector (x, y) result (xy) - complex(kind=single), intent(in) :: x - type(vector), intent(in) :: y - type(vector) :: xy - xy%t = x * y%t - xy%x = x * y%x -end function complex_vector -pure function dcomplex_vector (x, y) result (xy) - complex(kind=default), intent(in) :: x - type(vector), intent(in) :: y - type(vector) :: xy - xy%t = x * y%t - xy%x = x * y%x -end function dcomplex_vector -\nwendcode{}\nwbegindocs{187}\nwdocspar -\nwenddocs{}\nwbegincode{188}\moddef{Implementation of operations for vectors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function integer_tensor2odd (x, t2) result (xt2) - integer, intent(in) :: x - type(tensor2odd), intent(in) :: t2 - type(tensor2odd) :: xt2 - xt2%e = x * t2%e - xt2%b = x * t2%b -end function integer_tensor2odd -pure function real_tensor2odd (x, t2) result (xt2) - real(kind=single), intent(in) :: x - type(tensor2odd), intent(in) :: t2 - type(tensor2odd) :: xt2 - xt2%e = x * t2%e - xt2%b = x * t2%b -end function real_tensor2odd -pure function double_tensor2odd (x, t2) result (xt2) - real(kind=default), intent(in) :: x - type(tensor2odd), intent(in) :: t2 - type(tensor2odd) :: xt2 - xt2%e = x * t2%e - xt2%b = x * t2%b -end function double_tensor2odd -pure function complex_tensor2odd (x, t2) result (xt2) - complex(kind=single), intent(in) :: x - type(tensor2odd), intent(in) :: t2 - type(tensor2odd) :: xt2 - xt2%e = x * t2%e - xt2%b = x * t2%b -end function complex_tensor2odd -pure function dcomplex_tensor2odd (x, t2) result (xt2) - complex(kind=default), intent(in) :: x - type(tensor2odd), intent(in) :: t2 - type(tensor2odd) :: xt2 - xt2%e = x * t2%e - xt2%b = x * t2%b -end function dcomplex_tensor2odd -\nwendcode{}\nwbegindocs{189}\nwdocspar -\nwenddocs{}\nwbegincode{190}\moddef{Implementation of operations for vectors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function momentum_integer (y, x) result (xy) - integer, intent(in) :: x - type(momentum), intent(in) :: y - type(momentum) :: xy - xy%t = x * y%t - xy%x = x * y%x -end function momentum_integer -pure function momentum_real (y, x) result (xy) - real(kind=single), intent(in) :: x - type(momentum), intent(in) :: y - type(momentum) :: xy - xy%t = x * y%t - xy%x = x * y%x -end function momentum_real -pure function momentum_double (y, x) result (xy) - real(kind=default), intent(in) :: x - type(momentum), intent(in) :: y - type(momentum) :: xy - xy%t = x * y%t - xy%x = x * y%x -end function momentum_double -pure function momentum_complex (y, x) result (xy) - complex(kind=single), intent(in) :: x - type(momentum), intent(in) :: y - type(vector) :: xy - xy%t = x * y%t - xy%x = x * y%x -end function momentum_complex -pure function momentum_dcomplex (y, x) result (xy) - complex(kind=default), intent(in) :: x - type(momentum), intent(in) :: y - type(vector) :: xy - xy%t = x * y%t - xy%x = x * y%x -end function momentum_dcomplex -\nwendcode{}\nwbegindocs{191}\nwdocspar -\nwenddocs{}\nwbegincode{192}\moddef{Implementation of operations for vectors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function vector_integer (y, x) result (xy) - integer, intent(in) :: x - type(vector), intent(in) :: y - type(vector) :: xy - xy%t = x * y%t - xy%x = x * y%x -end function vector_integer -pure function vector_real (y, x) result (xy) - real(kind=single), intent(in) :: x - type(vector), intent(in) :: y - type(vector) :: xy - xy%t = x * y%t - xy%x = x * y%x -end function vector_real -pure function vector_double (y, x) result (xy) - real(kind=default), intent(in) :: x - type(vector), intent(in) :: y - type(vector) :: xy - xy%t = x * y%t - xy%x = x * y%x -end function vector_double -pure function vector_complex (y, x) result (xy) - complex(kind=single), intent(in) :: x - type(vector), intent(in) :: y - type(vector) :: xy - xy%t = x * y%t - xy%x = x * y%x -end function vector_complex -pure function vector_dcomplex (y, x) result (xy) - complex(kind=default), intent(in) :: x - type(vector), intent(in) :: y - type(vector) :: xy - xy%t = x * y%t - xy%x = x * y%x -end function vector_dcomplex -\nwendcode{}\nwbegindocs{193}\nwdocspar -\nwenddocs{}\nwbegincode{194}\moddef{Implementation of operations for vectors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function tensor2odd_integer (t2, x) result (t2x) - type(tensor2odd), intent(in) :: t2 - integer, intent(in) :: x - type(tensor2odd) :: t2x - t2x%e = x * t2%e - t2x%b = x * t2%b -end function tensor2odd_integer -pure function tensor2odd_real (t2, x) result (t2x) - type(tensor2odd), intent(in) :: t2 - real(kind=single), intent(in) :: x - type(tensor2odd) :: t2x - t2x%e = x * t2%e - t2x%b = x * t2%b -end function tensor2odd_real -pure function tensor2odd_double (t2, x) result (t2x) - type(tensor2odd), intent(in) :: t2 - real(kind=default), intent(in) :: x - type(tensor2odd) :: t2x - t2x%e = x * t2%e - t2x%b = x * t2%b -end function tensor2odd_double -pure function tensor2odd_complex (t2, x) result (t2x) - type(tensor2odd), intent(in) :: t2 - complex(kind=single), intent(in) :: x - type(tensor2odd) :: t2x - t2x%e = x * t2%e - t2x%b = x * t2%b -end function tensor2odd_complex -pure function tensor2odd_dcomplex (t2, x) result (t2x) - type(tensor2odd), intent(in) :: t2 - complex(kind=default), intent(in) :: x - type(tensor2odd) :: t2x - t2x%e = x * t2%e - t2x%b = x * t2%b -end function tensor2odd_dcomplex -\nwendcode{}\nwbegindocs{195}\nwdocspar -\subsubsection{Unary Plus and Minus} -\nwenddocs{}\nwbegincode{196}\moddef{Declaration of operations for vectors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -interface operator (+) - module procedure plus_momentum, plus_vector, plus_tensor2odd -end interface -private :: plus_momentum, plus_vector, plus_tensor2odd -interface operator (-) - module procedure neg_momentum, neg_vector, neg_tensor2odd -end interface -private :: neg_momentum, neg_vector, neg_tensor2odd -\nwendcode{}\nwbegindocs{197}\nwdocspar -\nwenddocs{}\nwbegincode{198}\moddef{Implementation of operations for vectors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function plus_momentum (x) result (plus_x) - type(momentum), intent(in) :: x - type(momentum) :: plus_x - plus_x = x -end function plus_momentum -pure function neg_momentum (x) result (neg_x) - type(momentum), intent(in) :: x - type(momentum) :: neg_x - neg_x%t = - x%t - neg_x%x = - x%x -end function neg_momentum -\nwendcode{}\nwbegindocs{199}\nwdocspar -\nwenddocs{}\nwbegincode{200}\moddef{Implementation of operations for vectors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function plus_vector (x) result (plus_x) - type(vector), intent(in) :: x - type(vector) :: plus_x - plus_x = x -end function plus_vector -pure function neg_vector (x) result (neg_x) - type(vector), intent(in) :: x - type(vector) :: neg_x - neg_x%t = - x%t - neg_x%x = - x%x -end function neg_vector -\nwendcode{}\nwbegindocs{201}\nwdocspar -\nwenddocs{}\nwbegincode{202}\moddef{Implementation of operations for vectors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function plus_tensor2odd (x) result (plus_x) - type(tensor2odd), intent(in) :: x - type(tensor2odd) :: plus_x - plus_x = x -end function plus_tensor2odd -pure function neg_tensor2odd (x) result (neg_x) - type(tensor2odd), intent(in) :: x - type(tensor2odd) :: neg_x - neg_x%e = - x%e - neg_x%b = - x%b -end function neg_tensor2odd -\nwendcode{}\nwbegindocs{203}\nwdocspar -\subsubsection{Addition and Subtraction} -\nwenddocs{}\nwbegincode{204}\moddef{Declaration of operations for vectors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -interface operator (+) - module procedure add_momentum, add_vector, & - add_vector_momentum, add_momentum_vector, add_tensor2odd -end interface -private :: add_momentum, add_vector, add_vector_momentum, & - add_momentum_vector, add_tensor2odd -interface operator (-) - module procedure sub_momentum, sub_vector, & - sub_vector_momentum, sub_momentum_vector, sub_tensor2odd -end interface -private :: sub_momentum, sub_vector, sub_vector_momentum, & - sub_momentum_vector, sub_tensor2odd -\nwendcode{}\nwbegindocs{205}\nwdocspar -\nwenddocs{}\nwbegincode{206}\moddef{Implementation of operations for vectors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function add_momentum (x, y) result (xy) - type(momentum), intent(in) :: x, y - type(momentum) :: xy - xy%t = x%t + y%t - xy%x = x%x + y%x -end function add_momentum -pure function add_vector (x, y) result (xy) - type(vector), intent(in) :: x, y - type(vector) :: xy - xy%t = x%t + y%t - xy%x = x%x + y%x -end function add_vector -pure function add_momentum_vector (x, y) result (xy) - type(momentum), intent(in) :: x - type(vector), intent(in) :: y - type(vector) :: xy - xy%t = x%t + y%t - xy%x = x%x + y%x -end function add_momentum_vector -pure function add_vector_momentum (x, y) result (xy) - type(vector), intent(in) :: x - type(momentum), intent(in) :: y - type(vector) :: xy - xy%t = x%t + y%t - xy%x = x%x + y%x -end function add_vector_momentum -pure function add_tensor2odd (x, y) result (xy) - type(tensor2odd), intent(in) :: x, y - type(tensor2odd) :: xy - xy%e = x%e + y%e - xy%b = x%b + y%b -end function add_tensor2odd -\nwendcode{}\nwbegindocs{207}\nwdocspar -\nwenddocs{}\nwbegincode{208}\moddef{Implementation of operations for vectors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function sub_momentum (x, y) result (xy) - type(momentum), intent(in) :: x, y - type(momentum) :: xy - xy%t = x%t - y%t - xy%x = x%x - y%x -end function sub_momentum -pure function sub_vector (x, y) result (xy) - type(vector), intent(in) :: x, y - type(vector) :: xy - xy%t = x%t - y%t - xy%x = x%x - y%x -end function sub_vector -pure function sub_momentum_vector (x, y) result (xy) - type(momentum), intent(in) :: x - type(vector), intent(in) :: y - type(vector) :: xy - xy%t = x%t - y%t - xy%x = x%x - y%x -end function sub_momentum_vector -pure function sub_vector_momentum (x, y) result (xy) - type(vector), intent(in) :: x - type(momentum), intent(in) :: y - type(vector) :: xy - xy%t = x%t - y%t - xy%x = x%x - y%x -end function sub_vector_momentum -pure function sub_tensor2odd (x, y) result (xy) - type(tensor2odd), intent(in) :: x, y - type(tensor2odd) :: xy - xy%e = x%e - y%e - xy%b = x%b - y%b -end function sub_tensor2odd -\nwendcode{}\nwbegindocs{209}\nwdocspar -\subsection{Norm} -\emph{Not} the covariant length! -\nwenddocs{}\nwbegincode{210}\moddef{Declaration of operations for vectors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -interface abs - module procedure abs_momentum, abs_vector, abs_tensor2odd -end interface -private :: abs_momentum, abs_vector, abs_tensor2odd -\nwendcode{}\nwbegindocs{211}\nwdocspar -\nwenddocs{}\nwbegincode{212}\moddef{Implementation of operations for vectors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function abs_momentum (x) result (absx) - type(momentum), intent(in) :: x - real(kind=default) :: absx - absx = sqrt (x%t*x%t + dot_product (x%x, x%x)) -end function abs_momentum -pure function abs_vector (x) result (absx) - type(vector), intent(in) :: x - real(kind=default) :: absx - absx = sqrt (conjg(x%t)*x%t + dot_product (x%x, x%x)) -end function abs_vector -pure function abs_tensor2odd (x) result (absx) - type(tensor2odd), intent(in) :: x - real(kind=default) :: absx - absx = sqrt (dot_product (x%e, x%e) + dot_product (x%b, x%b)) -end function abs_tensor2odd -\nwendcode{}\nwbegindocs{213}\nwdocspar -\subsection{Conjugation} -\nwenddocs{}\nwbegincode{214}\moddef{Declaration of operations for vectors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -interface conjg - module procedure conjg_momentum, conjg_vector, conjg_tensor2odd -end interface -private :: conjg_momentum, conjg_vector, conjg_tensor2odd -\nwendcode{}\nwbegindocs{215}\nwdocspar -\nwenddocs{}\nwbegincode{216}\moddef{Implementation of operations for vectors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function conjg_momentum (x) result (conjg_x) - type(momentum), intent(in) :: x - type(momentum) :: conjg_x - conjg_x = x -end function conjg_momentum -pure function conjg_vector (x) result (conjg_x) - type(vector), intent(in) :: x - type(vector) :: conjg_x - conjg_x%t = conjg (x%t) - conjg_x%x = conjg (x%x) -end function conjg_vector -pure function conjg_tensor2odd (t2) result (conjg_t2) - type(tensor2odd), intent(in) :: t2 - type(tensor2odd) :: conjg_t2 - conjg_t2%e = conjg (t2%e) - conjg_t2%b = conjg (t2%b) -end function conjg_tensor2odd -\nwendcode{}\nwbegindocs{217}\nwdocspar -\subsection{$\epsilon$-Tensors} -\begin{equation} - \epsilon_{0123} = 1 = - \epsilon^{0123} -\end{equation} -in particular -\begin{equation} - \epsilon(p_1,p_2,p_3,p_4) - = \epsilon_{\mu_1\mu_2\mu_3\mu_4} - p_1^{\mu_1}p_2^{\mu_2}p_3^{\mu_3}p_4^{\mu_4} - = p_1^0 p_2^1 p_3^2 p_4^3 \pm \ldots -\end{equation} -\nwenddocs{}\nwbegincode{218}\moddef{Declaration of operations for vectors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -interface pseudo_scalar - module procedure pseudo_scalar_momentum, pseudo_scalar_vector, & - pseudo_scalar_vec_mom -end interface -public :: pseudo_scalar -private :: pseudo_scalar_momentum, pseudo_scalar_vector -\nwendcode{}\nwbegindocs{219}\nwdocspar -\nwenddocs{}\nwbegincode{220}\moddef{Implementation of operations for vectors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function pseudo_scalar_momentum (p1, p2, p3, p4) result (eps1234) - type(momentum), intent(in) :: p1, p2, p3, p4 - real(kind=default) :: eps1234 - eps1234 = & - p1%t * p2%x(1) * (p3%x(2) * p4%x(3) - p3%x(3) * p4%x(2)) & - + p1%t * p2%x(2) * (p3%x(3) * p4%x(1) - p3%x(1) * p4%x(3)) & - + p1%t * p2%x(3) * (p3%x(1) * p4%x(2) - p3%x(2) * p4%x(1)) & - - p1%x(1) * p2%x(2) * (p3%x(3) * p4%t - p3%t * p4%x(3)) & - - p1%x(1) * p2%x(3) * (p3%t * p4%x(2) - p3%x(2) * p4%t ) & - - p1%x(1) * p2%t * (p3%x(2) * p4%x(3) - p3%x(3) * p4%x(2)) & - + p1%x(2) * p2%x(3) * (p3%t * p4%x(1) - p3%x(1) * p4%t ) & - + p1%x(2) * p2%t * (p3%x(1) * p4%x(3) - p3%x(3) * p4%x(1)) & - + p1%x(2) * p2%x(1) * (p3%x(3) * p4%t - p3%t * p4%x(3)) & - - p1%x(3) * p2%t * (p3%x(1) * p4%x(2) - p3%x(2) * p4%x(1)) & - - p1%x(3) * p2%x(1) * (p3%x(2) * p4%t - p3%t * p4%x(2)) & - - p1%x(3) * p2%x(2) * (p3%t * p4%x(1) - p3%x(1) * p4%t ) -end function pseudo_scalar_momentum -\nwendcode{}\nwbegindocs{221}\nwdocspar -\nwenddocs{}\nwbegincode{222}\moddef{Implementation of operations for vectors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function pseudo_scalar_vector (p1, p2, p3, p4) result (eps1234) - type(vector), intent(in) :: p1, p2, p3, p4 - complex(kind=default) :: eps1234 - eps1234 = & - p1%t * p2%x(1) * (p3%x(2) * p4%x(3) - p3%x(3) * p4%x(2)) & - + p1%t * p2%x(2) * (p3%x(3) * p4%x(1) - p3%x(1) * p4%x(3)) & - + p1%t * p2%x(3) * (p3%x(1) * p4%x(2) - p3%x(2) * p4%x(1)) & - - p1%x(1) * p2%x(2) * (p3%x(3) * p4%t - p3%t * p4%x(3)) & - - p1%x(1) * p2%x(3) * (p3%t * p4%x(2) - p3%x(2) * p4%t ) & - - p1%x(1) * p2%t * (p3%x(2) * p4%x(3) - p3%x(3) * p4%x(2)) & - + p1%x(2) * p2%x(3) * (p3%t * p4%x(1) - p3%x(1) * p4%t ) & - + p1%x(2) * p2%t * (p3%x(1) * p4%x(3) - p3%x(3) * p4%x(1)) & - + p1%x(2) * p2%x(1) * (p3%x(3) * p4%t - p3%t * p4%x(3)) & - - p1%x(3) * p2%t * (p3%x(1) * p4%x(2) - p3%x(2) * p4%x(1)) & - - p1%x(3) * p2%x(1) * (p3%x(2) * p4%t - p3%t * p4%x(2)) & - - p1%x(3) * p2%x(2) * (p3%t * p4%x(1) - p3%x(1) * p4%t ) -end function pseudo_scalar_vector -\nwendcode{}\nwbegindocs{223}\nwdocspar -\nwenddocs{}\nwbegincode{224}\moddef{Implementation of operations for vectors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function pseudo_scalar_vec_mom (p1, v1, p2, v2) result (eps1234) - type(momentum), intent(in) :: p1, p2 - type(vector), intent(in) :: v1, v2 - complex(kind=default) :: eps1234 - eps1234 = & - p1%t * v1%x(1) * (p2%x(2) * v2%x(3) - p2%x(3) * v2%x(2)) & - + p1%t * v1%x(2) * (p2%x(3) * v2%x(1) - p2%x(1) * v2%x(3)) & - + p1%t * v1%x(3) * (p2%x(1) * v2%x(2) - p2%x(2) * v2%x(1)) & - - p1%x(1) * v1%x(2) * (p2%x(3) * v2%t - p2%t * v2%x(3)) & - - p1%x(1) * v1%x(3) * (p2%t * v2%x(2) - p2%x(2) * v2%t ) & - - p1%x(1) * v1%t * (p2%x(2) * v2%x(3) - p2%x(3) * v2%x(2)) & - + p1%x(2) * v1%x(3) * (p2%t * v2%x(1) - p2%x(1) * v2%t ) & - + p1%x(2) * v1%t * (p2%x(1) * v2%x(3) - p2%x(3) * v2%x(1)) & - + p1%x(2) * v1%x(1) * (p2%x(3) * v2%t - p2%t * v2%x(3)) & - - p1%x(3) * v1%t * (p2%x(1) * v2%x(2) - p2%x(2) * v2%x(1)) & - - p1%x(3) * v1%x(1) * (p2%x(2) * v2%t - p2%t * v2%x(2)) & - - p1%x(3) * v1%x(2) * (p2%t * v2%x(1) - p2%x(1) * v2%t ) -end function pseudo_scalar_vec_mom -\nwendcode{}\nwbegindocs{225}\nwdocspar -\begin{equation} - \epsilon_\mu(p_1,p_2,p_3) - = \epsilon_{\mu\mu_1\mu_2\mu_3} - p_1^{\mu_1}p_2^{\mu_2}p_3^{\mu_3} -\end{equation} -i.\,e. -\begin{subequations} -\begin{align} - \epsilon_0(p_1,p_2,p_3) &= p_1^1 p_2^2 p_3^3 \pm \ldots \\ - \epsilon_1(p_1,p_2,p_3) &= p_1^2 p_2^3 p_3^0 \pm \ldots \\ - \epsilon_2(p_1,p_2,p_3) &= - p_1^3 p_2^0 p_3^1 \pm \ldots \\ - \epsilon_3(p_1,p_2,p_3) &= p_1^0 p_2^1 p_3^2 \pm \ldots -\end{align} -\end{subequations} -\nwenddocs{}\nwbegincode{226}\moddef{Declaration of operations for vectors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -interface pseudo_vector - module procedure pseudo_vector_momentum, pseudo_vector_vector, & - pseudo_vector_vec_mom -end interface -public :: pseudo_vector -private :: pseudo_vector_momentum, pseudo_vector_vector -\nwendcode{}\nwbegindocs{227}\nwdocspar -\nwenddocs{}\nwbegincode{228}\moddef{Implementation of operations for vectors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function pseudo_vector_momentum (p1, p2, p3) result (eps123) - type(momentum), intent(in) :: p1, p2, p3 - type(momentum) :: eps123 - eps123%t = & - + p1%x(1) * (p2%x(2) * p3%x(3) - p2%x(3) * p3%x(2)) & - + p1%x(2) * (p2%x(3) * p3%x(1) - p2%x(1) * p3%x(3)) & - + p1%x(3) * (p2%x(1) * p3%x(2) - p2%x(2) * p3%x(1)) - eps123%x(1) = & - + p1%x(2) * (p2%x(3) * p3%t - p2%t * p3%x(3)) & - + p1%x(3) * (p2%t * p3%x(2) - p2%x(2) * p3%t ) & - + p1%t * (p2%x(2) * p3%x(3) - p2%x(3) * p3%x(2)) - eps123%x(2) = & - - p1%x(3) * (p2%t * p3%x(1) - p2%x(1) * p3%t ) & - - p1%t * (p2%x(1) * p3%x(3) - p2%x(3) * p3%x(1)) & - - p1%x(1) * (p2%x(3) * p3%t - p2%t * p3%x(3)) - eps123%x(3) = & - + p1%t * (p2%x(1) * p3%x(2) - p2%x(2) * p3%x(1)) & - + p1%x(1) * (p2%x(2) * p3%t - p2%t * p3%x(2)) & - + p1%x(2) * (p2%t * p3%x(1) - p2%x(1) * p3%t ) -end function pseudo_vector_momentum -\nwendcode{}\nwbegindocs{229}\nwdocspar -\nwenddocs{}\nwbegincode{230}\moddef{Implementation of operations for vectors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function pseudo_vector_vector (p1, p2, p3) result (eps123) - type(vector), intent(in) :: p1, p2, p3 - type(vector) :: eps123 - eps123%t = & - + p1%x(1) * (p2%x(2) * p3%x(3) - p2%x(3) * p3%x(2)) & - + p1%x(2) * (p2%x(3) * p3%x(1) - p2%x(1) * p3%x(3)) & - + p1%x(3) * (p2%x(1) * p3%x(2) - p2%x(2) * p3%x(1)) - eps123%x(1) = & - + p1%x(2) * (p2%x(3) * p3%t - p2%t * p3%x(3)) & - + p1%x(3) * (p2%t * p3%x(2) - p2%x(2) * p3%t ) & - + p1%t * (p2%x(2) * p3%x(3) - p2%x(3) * p3%x(2)) - eps123%x(2) = & - - p1%x(3) * (p2%t * p3%x(1) - p2%x(1) * p3%t ) & - - p1%t * (p2%x(1) * p3%x(3) - p2%x(3) * p3%x(1)) & - - p1%x(1) * (p2%x(3) * p3%t - p2%t * p3%x(3)) - eps123%x(3) = & - + p1%t * (p2%x(1) * p3%x(2) - p2%x(2) * p3%x(1)) & - + p1%x(1) * (p2%x(2) * p3%t - p2%t * p3%x(2)) & - + p1%x(2) * (p2%t * p3%x(1) - p2%x(1) * p3%t ) -end function pseudo_vector_vector -\nwendcode{}\nwbegindocs{231}\nwdocspar -\nwenddocs{}\nwbegincode{232}\moddef{Implementation of operations for vectors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function pseudo_vector_vec_mom (p1, p2, v) result (eps123) - type(momentum), intent(in) :: p1, p2 - type(vector), intent(in) :: v - type(vector) :: eps123 - eps123%t = & - + p1%x(1) * (p2%x(2) * v%x(3) - p2%x(3) * v%x(2)) & - + p1%x(2) * (p2%x(3) * v%x(1) - p2%x(1) * v%x(3)) & - + p1%x(3) * (p2%x(1) * v%x(2) - p2%x(2) * v%x(1)) - eps123%x(1) = & - + p1%x(2) * (p2%x(3) * v%t - p2%t * v%x(3)) & - + p1%x(3) * (p2%t * v%x(2) - p2%x(2) * v%t ) & - + p1%t * (p2%x(2) * v%x(3) - p2%x(3) * v%x(2)) - eps123%x(2) = & - - p1%x(3) * (p2%t * v%x(1) - p2%x(1) * v%t ) & - - p1%t * (p2%x(1) * v%x(3) - p2%x(3) * v%x(1)) & - - p1%x(1) * (p2%x(3) * v%t - p2%t * v%x(3)) - eps123%x(3) = & - + p1%t * (p2%x(1) * v%x(2) - p2%x(2) * v%x(1)) & - + p1%x(1) * (p2%x(2) * v%t - p2%t * v%x(2)) & - + p1%x(2) * (p2%t * v%x(1) - p2%x(1) * v%t ) -end function pseudo_vector_vec_mom -\nwendcode{}\nwbegindocs{233}\nwdocspar -\subsection{Utilities} -\nwenddocs{}\nwbegincode{234}\moddef{Declaration of operations for vectors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -\nwendcode{}\nwbegindocs{235}\nwdocspar -\nwenddocs{}\nwbegincode{236}\moddef{Implementation of operations for vectors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -subroutine random_momentum (p, pabs, m) - type(momentum), intent(out) :: p - real(kind=default), intent(in) :: pabs, m - real(kind=default), dimension(2) :: r - real(kind=default) :: phi, cos_th - call random_number (r) - phi = 2*PI * r(1) - cos_th = 2 * r(2) - 1 - p%t = sqrt (pabs**2 + m**2) - p%x = pabs * (/ cos_th * cos(phi), cos_th * sin(phi), sqrt (1 - cos_th**2) /) -end subroutine random_momentum -\nwendcode{}\nwbegindocs{237}\nwdocspar -\section{Polarization vectors} -\nwenddocs{}\nwbegincode{238}\moddef{\code{}omega{\_}polarizations.f95\edoc{}}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -\LA{}Copyleft\RA{} -module omega_polarizations - use kinds - use omega_constants - use omega_vectors - implicit none - private - \LA{}Declaration of polarization vectors\RA{} - integer, parameter, public :: omega_polarizations_2003_03_A = 0 -contains - \LA{}Implementation of polarization vectors\RA{} -end module omega_polarizations -\nwendcode{}\nwbegindocs{239}\nwdocspar -Here we use a phase convention for the polarization vectors compatible -with the angular momentum coupling to spin 3/2 and spin 2. -\begin{subequations} -\begin{align} - \epsilon^\mu_1(k) &= - \frac{1}{|\vec k|\sqrt{k_x^2+k_y^2}} - \left(0; k_z k_x, k_y k_z, - k_x^2 - k_y^2\right) \\ - \epsilon^\mu_2(k) &= - \frac{1}{\sqrt{k_x^2+k_y^2}} - \left(0; -k_y, k_x, 0\right) \\ - \epsilon^\mu_3(k) &= - \frac{k_0}{m|\vec k|} \left({\vec k}^2/k_0; k_x, k_y, k_z\right) -\end{align} -\end{subequations} -and -\begin{subequations} -\begin{align} - \epsilon^\mu_\pm(k) &= - \frac{1}{\sqrt{2}} (\epsilon^\mu_1(k) \pm \ii\epsilon^\mu_2(k) ) \\ - \epsilon^\mu_0(k) &= \epsilon^\mu_3(k) -\end{align} -\end{subequations} -i.\,e. -\begin{subequations} -\begin{align} - \epsilon^\mu_+(k) &= - \frac{1}{\sqrt{2}\sqrt{k_x^2+k_y^2}} - \left(0; \frac{k_zk_x}{|\vec k|} - \ii k_y, - \frac{k_yk_z}{|\vec k|} + \ii k_x, - - \frac{k_x^2+k_y^2}{|\vec k|}\right) \\ - \epsilon^\mu_-(k) &= - \frac{1}{\sqrt{2}\sqrt{k_x^2+k_y^2}} - \left(0; \frac{k_zk_x}{|\vec k|} + \ii k_y, - \frac{k_yk_z}{|\vec k|} - \ii k_x, - -\frac{k_x^2+k_y^2}{|\vec k|}\right) \\ - \epsilon^\mu_0(k) &= - \frac{k_0}{m|\vec k|} \left({\vec k}^2/k_0; k_x, k_y, k_z\right) -\end{align} -\end{subequations} -Determining the mass from the momenta is a numerically haphazardous for -light particles. Therefore, we accept some redundancy and pass the -mass explicitely. -\nwenddocs{}\nwbegincode{240}\moddef{Declaration of polarization vectors}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -public :: eps -\nwendcode{}\nwbegindocs{241}\nwdocspar -\nwenddocs{}\nwbegincode{242}\moddef{Implementation of polarization vectors}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function eps (m, k, s) result (e) - type(vector) :: e - real(kind=default), intent(in) :: m - type(momentum), intent(in) :: k - integer, intent(in) :: s - real(kind=default) :: kt, kabs, kabs2, sqrt2 - sqrt2 = sqrt (2.0_default) - kabs2 = dot_product (k%x, k%x) - e%t = 0 - e%x = 0 - if (kabs2 > 0) then - kabs = sqrt (kabs2) - select case (s) - case (1) - kt = sqrt (k%x(1)**2 + k%x(2)**2) - if (abs(kt) <= epsilon(kt) * kabs) then - if (k%x(3) > 0) then - e%x(1) = cmplx ( 1, 0, kind=default) / sqrt2 - e%x(2) = cmplx ( 0, 1, kind=default) / sqrt2 - else - e%x(1) = cmplx ( - 1, 0, kind=default) / sqrt2 - e%x(2) = cmplx ( 0, 1, kind=default) / sqrt2 - end if - else - e%x(1) = cmplx ( k%x(3)*k%x(1)/kabs, & - - k%x(2), kind=default) / kt / sqrt2 - e%x(2) = cmplx ( k%x(2)*k%x(3)/kabs, & - k%x(1), kind=default) / kt / sqrt2 - e%x(3) = - kt / kabs / sqrt2 - end if - case (-1) - kt = sqrt (k%x(1)**2 + k%x(2)**2) - if (abs(kt) <= epsilon(kt) * kabs) then - if (k%x(3) > 0) then - e%x(1) = cmplx ( 1, 0, kind=default) / sqrt2 - e%x(2) = cmplx ( 0, - 1, kind=default) / sqrt2 - else - e%x(1) = cmplx ( -1, 0, kind=default) / sqrt2 - e%x(2) = cmplx ( 0, - 1, kind=default) / sqrt2 - end if - else - e%x(1) = cmplx ( k%x(3)*k%x(1)/kabs, & - k%x(2), kind=default) / kt / sqrt2 - e%x(2) = cmplx ( k%x(2)*k%x(3)/kabs, & - - k%x(1), kind=default) / kt / sqrt2 - e%x(3) = - kt / kabs / sqrt2 - end if - case (0) - if (m > 0) then - e%t = kabs / m - e%x = k%t / (m*kabs) * k%x - end if - case (3) - e = (0,1) * k - case (4) - if (m > 0) then - e = (1 / m) * k - else - e = (1 / k%t) * k - end if - end select - else !!! for particles in their rest frame defined to be - !!! polarized along the 3-direction - select case (s) - case (1) - e%x(1) = cmplx ( 1, 0, kind=default) / sqrt2 - e%x(2) = cmplx ( 0, 1, kind=default) / sqrt2 - case (-1) - e%x(1) = cmplx ( 1, 0, kind=default) / sqrt2 - e%x(2) = cmplx ( 0, - 1, kind=default) / sqrt2 - case (0) - if (m > 0) then - e%x(3) = 1 - end if - case (4) - if (m > 0) then - e = (1 / m) * k - else - e = (1 / k%t) * k - end if - end select - end if -end function eps -!!! OLD VERSION !!!!!! -!!! pure function eps (m, k, s) result (e) -!!! type(vector) :: e -!!! real(kind=default), intent(in) :: m -!!! type(momentum), intent(in) :: k -!!! integer, intent(in) :: s -!!! real(kind=default) :: kt, kabs, kabs2, sqrt2 -!!! integer, parameter :: x = 2, y = 3, z = 1 -!!! sqrt2 = sqrt (2.0_default) -!!! kabs2 = dot_product (k%x, k%x) -!!! e%t = 0 -!!! e%x = 0 -!!! if (kabs2 > 0) then -!!! kabs = sqrt (kabs2) -!!! select case (s) -!!! case (1) -!!! kt = sqrt (k%x(x)**2 + k%x(y)**2) -!!! e%x(x) = cmplx ( k%x(z)*k%x(x)/kabs, & -!!! - k%x(y), kind=default) / kt / sqrt2 -!!! e%x(y) = cmplx ( k%x(y)*k%x(z)/kabs, & -!!! k%x(x), kind=default) / kt / sqrt2 -!!! e%x(z) = - kt / kabs / sqrt2 -!!! case (-1) -!!! kt = sqrt (k%x(x)**2 + k%x(y)**2) -!!! e%x(x) = cmplx ( k%x(z)*k%x(x)/kabs, & -!!! k%x(y), kind=default) / kt / sqrt2 -!!! e%x(y) = cmplx ( k%x(y)*k%x(z)/kabs, & -!!! - k%x(x), kind=default) / kt / sqrt2 -!!! e%x(z) = - kt / kabs / sqrt2 -!!! case (0) -!!! if (m > 0) then -!!! e%t = kabs / m -!!! e%x = k%t / (m*kabs) * k%x -!!! end if -!!! case (3) -!!! e = (0,1) * k -!!! case (4) -!!! if (m > 0) then -!!! e = (1 / m) * k -!!! else -!!! e = (1 / k%t) * k -!!! end if -!!! end select -!!! else -!!! select case (s) -!!! case (1) -!!! e%x(x) = cmplx ( 1, 0, kind=default) / sqrt2 -!!! e%x(y) = cmplx ( 0, 1, kind=default) / sqrt2 -!!! case (-1) -!!! e%x(x) = cmplx ( 1, 0, kind=default) / sqrt2 -!!! e%x(y) = cmplx ( 0, - 1, kind=default) / sqrt2 -!!! case (0) -!!! if (m > 0) then -!!! e%x(z) = 1 -!!! end if -!!! case (4) -!!! if (m > 0) then -!!! e = (1 / m) * k -!!! else -!!! e = (1 / k%t) * k -!!! end if -!!! end select -!!! end if -!!! end function eps -!!!!!!!!!!!!!!!!!!!!!!!! -\nwendcode{}\nwbegindocs{243}\nwdocspar -\section{Polarization vectors revisited} -\nwenddocs{}\nwbegincode{244}\moddef{\code{}omega{\_}polarizations{\_}madgraph.f95\edoc{}}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -\LA{}Copyleft\RA{} -module omega_polarizations_madgraph - use kinds - use omega_constants - use omega_vectors - implicit none - private - \LA{}Declaration of polarization vectors for madgraph\RA{} - integer, parameter, public :: omega_pols_madgraph_2003_03_A = 0 -contains - \LA{}Implementation of polarization vectors for madgraph\RA{} -end module omega_polarizations_madgraph -\nwendcode{}\nwbegindocs{245}\nwdocspar -This set of polarization vectors is compatible with HELAS~\cite{HELAS}: -\begin{subequations} -\begin{align} - \epsilon^\mu_1(k) &= - \frac{1}{|\vec k|\sqrt{k_x^2+k_y^2}} - \left(0; k_z k_x, k_y k_z, - k_x^2 - k_y^2\right) \\ - \epsilon^\mu_2(k) &= - \frac{1}{\sqrt{k_x^2+k_y^2}} - \left(0; -k_y, k_x, 0\right) \\ - \epsilon^\mu_3(k) &= - \frac{k_0}{m|\vec k|} \left({\vec k}^2/k_0; k_x, k_y, k_z\right) -\end{align} -\end{subequations} -and -\begin{subequations} -\begin{align} - \epsilon^\mu_\pm(k) &= - \frac{1}{\sqrt{2}} (\mp \epsilon^\mu_1(k) - \ii\epsilon^\mu_2(k) ) \\ - \epsilon^\mu_0(k) &= \epsilon^\mu_3(k) -\end{align} -\end{subequations} -i.\,e. -\begin{subequations} -\begin{align} - \epsilon^\mu_+(k) &= - \frac{1}{\sqrt{2}\sqrt{k_x^2+k_y^2}} - \left(0; -\frac{k_zk_x}{|\vec k|} + \ii k_y, - -\frac{k_yk_z}{|\vec k|} - \ii k_x, - \frac{k_x^2+k_y^2}{|\vec k|}\right) \\ - \epsilon^\mu_-(k) &= - \frac{1}{\sqrt{2}\sqrt{k_x^2+k_y^2}} - \left(0; \frac{k_zk_x}{|\vec k|} + \ii k_y, - \frac{k_yk_z}{|\vec k|} - \ii k_x, - -\frac{k_x^2+k_y^2}{|\vec k|}\right) \\ - \epsilon^\mu_0(k) &= - \frac{k_0}{m|\vec k|} \left({\vec k}^2/k_0; k_x, k_y, k_z\right) -\end{align} -\end{subequations} -Fortunately, for comparing with squared matrix generated by Madgraph -we can also use the modified version, since the difference is only a -phase and does \emph{not} mix helicity states. -\nwenddocs{}\nwbegindocs{246}Determining the mass from the momenta is a numerically haphazardous for -light particles. Therefore, we accept some redundancy and pass the -mass explicitely. -\nwenddocs{}\nwbegincode{247}\moddef{Declaration of polarization vectors for madgraph}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -public :: eps -\nwendcode{}\nwbegindocs{248}\nwdocspar -\nwenddocs{}\nwbegincode{249}\moddef{Implementation of polarization vectors for madgraph}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function eps (m, k, s) result (e) - type(vector) :: e - real(kind=default), intent(in) :: m - type(momentum), intent(in) :: k - integer, intent(in) :: s - real(kind=default) :: kt, kabs, kabs2, sqrt2 - sqrt2 = sqrt (2.0_default) - kabs2 = dot_product (k%x, k%x) - e%t = 0 - e%x = 0 - if (kabs2 > 0) then - kabs = sqrt (kabs2) - select case (s) - case (1) - kt = sqrt (k%x(1)**2 + k%x(2)**2) - if (abs(kt) <= epsilon(kt) * kabs) then - if (k%x(3) > 0) then - e%x(1) = cmplx ( - 1, 0, kind=default) / sqrt2 - e%x(2) = cmplx ( 0, - 1, kind=default) / sqrt2 - else - e%x(1) = cmplx ( 1, 0, kind=default) / sqrt2 - e%x(2) = cmplx ( 0, - 1, kind=default) / sqrt2 - end if - else - e%x(1) = cmplx ( - k%x(3)*k%x(1)/kabs, & - k%x(2), kind=default) / kt / sqrt2 - e%x(2) = cmplx ( - k%x(2)*k%x(3)/kabs, & - - k%x(1), kind=default) / kt / sqrt2 - e%x(3) = kt / kabs / sqrt2 - end if - case (-1) - kt = sqrt (k%x(1)**2 + k%x(2)**2) - if (abs(kt) <= epsilon(kt) * kabs) then - if (k%x(3) > 0) then - e%x(1) = cmplx ( 1, 0, kind=default) / sqrt2 - e%x(2) = cmplx ( 0, - 1, kind=default) / sqrt2 - else - e%x(1) = cmplx ( -1, 0, kind=default) / sqrt2 - e%x(2) = cmplx ( 0, - 1, kind=default) / sqrt2 - end if - else - e%x(1) = cmplx ( k%x(3)*k%x(1)/kabs, & - k%x(2), kind=default) / kt / sqrt2 - e%x(2) = cmplx ( k%x(2)*k%x(3)/kabs, & - - k%x(1), kind=default) / kt / sqrt2 - e%x(3) = - kt / kabs / sqrt2 - end if - case (0) - if (m > 0) then - e%t = kabs / m - e%x = k%t / (m*kabs) * k%x - end if - case (3) - e = (0,1) * k - case (4) - if (m > 0) then - e = (1 / m) * k - else - e = (1 / k%t) * k - end if - end select - else !!! for particles in their rest frame defined to be - !!! polarized along the 3-direction - select case (s) - case (1) - e%x(1) = cmplx ( - 1, 0, kind=default) / sqrt2 - e%x(2) = cmplx ( 0, - 1, kind=default) / sqrt2 - case (-1) - e%x(1) = cmplx ( 1, 0, kind=default) / sqrt2 - e%x(2) = cmplx ( 0, - 1, kind=default) / sqrt2 - case (0) - if (m > 0) then - e%x(3) = 1 - end if - case (4) - if (m > 0) then - e = (1 / m) * k - else - e = (1 / k%t) * k - end if - end select - end if -end function eps -\nwendcode{}\nwbegindocs{250}\nwdocspar -\section{Symmetric Tensors} -Spin-2 polarization tensors are symmetric, transversal and traceless -\begin{subequations} -\begin{align} - \epsilon^{\mu\nu}_{m}(k) &= \epsilon^{\nu\mu}_{m}(k) \\ - k_\mu \epsilon^{\mu\nu}_{m}(k) &= k_\nu \epsilon^{\mu\nu}_{m}(k) = 0 \\ - \epsilon^{\mu}_{m,\mu}(k) &= 0 -\end{align} -\end{subequations} -with $m=1,2,3,4,5$. Our current representation is redundant and does -\emph{not} enforce symmetry or tracelessness. -\nwenddocs{}\nwbegincode{251}\moddef{\code{}omega{\_}tensors.f95\edoc{}}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -\LA{}Copyleft\RA{} -module omega_tensors - use kinds - use omega_constants - use omega_vectors - implicit none - private - public :: operator (*), operator (+), operator (-), & - operator (.tprod.) - public :: abs, conjg - \LA{}\code{}intrinsic\ ::\ abs\edoc{}\RA{} - \LA{}\code{}intrinsic\ ::\ conjg\edoc{}\RA{} - type, public :: tensor - ! private (omegalib needs access, but DON'T TOUCH IT!) - complex(kind=default), dimension(0:3,0:3) :: t - end type tensor - \LA{}Declaration of operations for tensors\RA{} - integer, parameter, public :: omega_tensors_2003_03_A = 0 -contains - \LA{}Implementation of operations for tensors\RA{} -end module omega_tensors -\nwendcode{}\nwbegindocs{252}\nwdocspar -\subsection{Vector Space} -\subsubsection{Scalar Multliplication} -\nwenddocs{}\nwbegincode{253}\moddef{Declaration of operations for tensors}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -interface operator (*) - module procedure integer_tensor, real_tensor, double_tensor, & - complex_tensor, dcomplex_tensor -end interface -private :: integer_tensor, real_tensor, double_tensor -private :: complex_tensor, dcomplex_tensor -\nwendcode{}\nwbegindocs{254}\nwdocspar -\nwenddocs{}\nwbegincode{255}\moddef{Implementation of operations for tensors}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function integer_tensor (x, y) result (xy) - integer, intent(in) :: x - type(tensor), intent(in) :: y - type(tensor) :: xy - xy%t = x * y%t -end function integer_tensor -pure function real_tensor (x, y) result (xy) - real(kind=single), intent(in) :: x - type(tensor), intent(in) :: y - type(tensor) :: xy - xy%t = x * y%t -end function real_tensor -pure function double_tensor (x, y) result (xy) - real(kind=default), intent(in) :: x - type(tensor), intent(in) :: y - type(tensor) :: xy - xy%t = x * y%t -end function double_tensor -pure function complex_tensor (x, y) result (xy) - complex(kind=single), intent(in) :: x - type(tensor), intent(in) :: y - type(tensor) :: xy - xy%t = x * y%t -end function complex_tensor -pure function dcomplex_tensor (x, y) result (xy) - complex(kind=default), intent(in) :: x - type(tensor), intent(in) :: y - type(tensor) :: xy - xy%t = x * y%t -end function dcomplex_tensor -\nwendcode{}\nwbegindocs{256}\nwdocspar -\subsubsection{Addition and Subtraction} -\nwenddocs{}\nwbegincode{257}\moddef{Declaration of operations for tensors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -interface operator (+) - module procedure plus_tensor -end interface -private :: plus_tensor -interface operator (-) - module procedure neg_tensor -end interface -private :: neg_tensor -\nwendcode{}\nwbegindocs{258}\nwdocspar -\nwenddocs{}\nwbegincode{259}\moddef{Implementation of operations for tensors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function plus_tensor (t1) result (t2) - type(tensor), intent(in) :: t1 - type(tensor) :: t2 - t2 = t1 -end function plus_tensor -pure function neg_tensor (t1) result (t2) - type(tensor), intent(in) :: t1 - type(tensor) :: t2 - t2%t = - t1%t -end function neg_tensor -\nwendcode{}\nwbegindocs{260}\nwdocspar -\nwenddocs{}\nwbegincode{261}\moddef{Declaration of operations for tensors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -interface operator (+) - module procedure add_tensor -end interface -private :: add_tensor -interface operator (-) - module procedure sub_tensor -end interface -private :: sub_tensor -\nwendcode{}\nwbegindocs{262}\nwdocspar -\nwenddocs{}\nwbegincode{263}\moddef{Implementation of operations for tensors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function add_tensor (x, y) result (xy) - type(tensor), intent(in) :: x, y - type(tensor) :: xy - xy%t = x%t + y%t -end function add_tensor -pure function sub_tensor (x, y) result (xy) - type(tensor), intent(in) :: x, y - type(tensor) :: xy - xy%t = x%t - y%t -end function sub_tensor -\nwendcode{}\nwbegindocs{264}\nwdocspar -\nwenddocs{}\nwbegincode{265}\moddef{Declaration of operations for tensors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -interface operator (.tprod.) - module procedure out_prod_vv, out_prod_vm, & - out_prod_mv, out_prod_mm -end interface -private :: out_prod_vv, out_prod_vm, & - out_prod_mv, out_prod_mm -\nwendcode{}\nwbegindocs{266}\nwdocspar -\nwenddocs{}\nwbegincode{267}\moddef{Implementation of operations for tensors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function out_prod_vv (v, w) result (t) - type(tensor) :: t - type(vector), intent(in) :: v, w - integer :: i, j - t%t(0,0) = v%t * w%t - t%t(0,1:3) = v%t * w%x - t%t(1:3,0) = v%x * w%t - do i = 1, 3 - do j = 1, 3 - t%t(i,j) = v%x(i) * w%x(j) - end do - end do -end function out_prod_vv -\nwendcode{}\nwbegindocs{268}\nwdocspar -\nwenddocs{}\nwbegincode{269}\moddef{Implementation of operations for tensors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function out_prod_vm (v, m) result (t) - type(tensor) :: t - type(vector), intent(in) :: v - type(momentum), intent(in) :: m - integer :: i, j - t%t(0,0) = v%t * m%t - t%t(0,1:3) = v%t * m%x - t%t(1:3,0) = v%x * m%t - do i = 1, 3 - do j = 1, 3 - t%t(i,j) = v%x(i) * m%x(j) - end do - end do -end function out_prod_vm -\nwendcode{}\nwbegindocs{270}\nwdocspar -\nwenddocs{}\nwbegincode{271}\moddef{Implementation of operations for tensors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function out_prod_mv (m, v) result (t) - type(tensor) :: t - type(vector), intent(in) :: v - type(momentum), intent(in) :: m - integer :: i, j - t%t(0,0) = m%t * v%t - t%t(0,1:3) = m%t * v%x - t%t(1:3,0) = m%x * v%t - do i = 1, 3 - do j = 1, 3 - t%t(i,j) = m%x(i) * v%x(j) - end do - end do -end function out_prod_mv -\nwendcode{}\nwbegindocs{272}\nwdocspar -\nwenddocs{}\nwbegincode{273}\moddef{Implementation of operations for tensors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function out_prod_mm (m, n) result (t) - type(tensor) :: t - type(momentum), intent(in) :: m, n - integer :: i, j - t%t(0,0) = m%t * n%t - t%t(0,1:3) = m%t * n%x - t%t(1:3,0) = m%x * n%t - do i = 1, 3 - do j = 1, 3 - t%t(i,j) = m%x(i) * n%x(j) - end do - end do -end function out_prod_mm -\nwendcode{}\nwbegindocs{274}\nwdocspar -\nwenddocs{}\nwbegincode{275}\moddef{Declaration of operations for tensors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -interface abs - module procedure abs_tensor -end interface -private :: abs_tensor -\nwendcode{}\nwbegindocs{276}\nwdocspar -\nwenddocs{}\nwbegincode{277}\moddef{Implementation of operations for tensors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function abs_tensor (t) result (abs_t) - type(tensor), intent(in) :: t - real(kind=default) :: abs_t - abs_t = sqrt (sum ((abs (t%t))**2)) -end function abs_tensor -\nwendcode{}\nwbegindocs{278}\nwdocspar -\nwenddocs{}\nwbegincode{279}\moddef{Declaration of operations for tensors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -interface conjg - module procedure conjg_tensor -end interface -private :: conjg_tensor -\nwendcode{}\nwbegindocs{280}\nwdocspar -\nwenddocs{}\nwbegincode{281}\moddef{Implementation of operations for tensors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function conjg_tensor (t) result (conjg_t) - type(tensor), intent(in) :: t - type(tensor) :: conjg_t - conjg_t%t = conjg (t%t) -end function conjg_tensor -\nwendcode{}\nwbegindocs{282}\nwdocspar -\nwenddocs{}\nwbegincode{283}\moddef{Declaration of operations for tensors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -interface operator (*) - module procedure tensor_tensor, vector_tensor, tensor_vector, & - momentum_tensor, tensor_momentum -end interface -private :: tensor_tensor, vector_tensor, tensor_vector, & - momentum_tensor, tensor_momentum -\nwendcode{}\nwbegindocs{284}\nwdocspar -\nwenddocs{}\nwbegincode{285}\moddef{Implementation of operations for tensors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function tensor_tensor (t1, t2) result (t1t2) - type(tensor), intent(in) :: t1 - type(tensor), intent(in) :: t2 - complex(kind=default) :: t1t2 - integer :: i1, i2 - t1t2 = t1%t(0,0)*t2%t(0,0) & - - dot_product (conjg (t1%t(0,1:)), t2%t(0,1:)) & - - dot_product (conjg (t1%t(1:,0)), t2%t(1:,0)) - do i1 = 1, 3 - do i2 = 1, 3 - t1t2 = t1t2 + t1%t(i1,i2)*t2%t(i1,i2) - end do - end do -end function tensor_tensor -\nwendcode{}\nwbegindocs{286}\nwdocspar -\nwenddocs{}\nwbegincode{287}\moddef{Implementation of operations for tensors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function tensor_vector (t, v) result (tv) - type(tensor), intent(in) :: t - type(vector), intent(in) :: v - type(vector) :: tv - tv%t = t%t(0,0) * v%t - dot_product (conjg (t%t(0,1:)), v%x) - tv%x(1) = t%t(0,1) * v%t - dot_product (conjg (t%t(1,1:)), v%x) - tv%x(2) = t%t(0,2) * v%t - dot_product (conjg (t%t(2,1:)), v%x) - tv%x(3) = t%t(0,3) * v%t - dot_product (conjg (t%t(3,1:)), v%x) -end function tensor_vector -\nwendcode{}\nwbegindocs{288}\nwdocspar -\nwenddocs{}\nwbegincode{289}\moddef{Implementation of operations for tensors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function vector_tensor (v, t) result (vt) - type(vector), intent(in) :: v - type(tensor), intent(in) :: t - type(vector) :: vt - vt%t = v%t * t%t(0,0) - dot_product (conjg (v%x), t%t(1:,0)) - vt%x(1) = v%t * t%t(0,1) - dot_product (conjg (v%x), t%t(1:,1)) - vt%x(2) = v%t * t%t(0,2) - dot_product (conjg (v%x), t%t(1:,2)) - vt%x(3) = v%t * t%t(0,3) - dot_product (conjg (v%x), t%t(1:,3)) -end function vector_tensor -\nwendcode{}\nwbegindocs{290}\nwdocspar -\nwenddocs{}\nwbegincode{291}\moddef{Implementation of operations for tensors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function tensor_momentum (t, p) result (tp) - type(tensor), intent(in) :: t - type(momentum), intent(in) :: p - type(vector) :: tp - tp%t = t%t(0,0) * p%t - dot_product (conjg (t%t(0,1:)), p%x) - tp%x(1) = t%t(0,1) * p%t - dot_product (conjg (t%t(1,1:)), p%x) - tp%x(2) = t%t(0,2) * p%t - dot_product (conjg (t%t(2,1:)), p%x) - tp%x(3) = t%t(0,3) * p%t - dot_product (conjg (t%t(3,1:)), p%x) -end function tensor_momentum -\nwendcode{}\nwbegindocs{292}\nwdocspar -\nwenddocs{}\nwbegincode{293}\moddef{Implementation of operations for tensors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function momentum_tensor (p, t) result (pt) - type(momentum), intent(in) :: p - type(tensor), intent(in) :: t - type(vector) :: pt - pt%t = p%t * t%t(0,0) - dot_product (p%x, t%t(1:,0)) - pt%x(1) = p%t * t%t(0,1) - dot_product (p%x, t%t(1:,1)) - pt%x(2) = p%t * t%t(0,2) - dot_product (p%x, t%t(1:,2)) - pt%x(3) = p%t * t%t(0,3) - dot_product (p%x, t%t(1:,3)) -end function momentum_tensor -\nwendcode{}\nwbegindocs{294}\nwdocspar -\section{Symmetric Polarization Tensors} -\begin{subequations} -\begin{align} - \epsilon^{\mu\nu}_{+2}(k) &= \epsilon^{\mu}_{+}(k)\epsilon^{\nu}_{+}(k) \\ - \epsilon^{\mu\nu}_{+1}(k) &= \frac{1}{\sqrt{2}} - \left( \epsilon^{\mu}_{+}(k)\epsilon^{\nu}_{0}(k) - + \epsilon^{\mu}_{0}(k)\epsilon^{\nu}_{+}(k) \right) \\ - \epsilon^{\mu\nu}_{0}(k) &= \frac{1}{\sqrt{6}} - \left( \epsilon^{\mu}_{+}(k)\epsilon^{\nu}_{-}(k) - + \epsilon^{\mu}_{-}(k)\epsilon^{\nu}_{+}(k) - - 2 \epsilon^{\mu}_{0}(k)\epsilon^{\nu}_{0}(k) \right) \\ - \epsilon^{\mu\nu}_{-1}(k) &= \frac{1}{\sqrt{2}} - \left( \epsilon^{\mu}_{-}(k)\epsilon^{\nu}_{0}(k) - + \epsilon^{\mu}_{0}(k)\epsilon^{\nu}_{-}(k) \right) \\ - \epsilon^{\mu\nu}_{-2}(k) &= \epsilon^{\mu}_{-}(k)\epsilon^{\nu}_{-}(k) -\end{align} -\end{subequations} -Note that~$\epsilon^{\mu}_{\pm2,\mu}(k) = -\epsilon^{\mu}_{\pm}(k)\epsilon_{\pm,\mu}(k) \propto -\epsilon^{\mu}_{\pm}(k)\epsilon_{\mp,\mu}^{*}(k) = 0$ and that the sign in -$\epsilon^{\mu\nu}_{0}(k)$ insures its tracelessness\footnote{ -On the other hand, with the shift operator -$L_{-}\ket{+}=\ee^{\ii\phi}\ket{0}$ and -$L_{-}\ket{0}=\ee^{\ii\chi}\ket{-}$, we find -\begin{equation*} - L_{-}^{2}\ket{++} = - 2\ee^{2\ii\phi}\ket{00} + \ee^{\ii(\phi+\chi)}(\ket{+-}+\ket{-+}) -\end{equation*} -i.\,e.~$\chi-\phi=\pi$, if we want to identify -$\epsilon^{\mu}_{-,0,+}$ with $\ket{-,0,+}$.}. -\nwenddocs{}\nwbegincode{295}\moddef{\code{}omega{\_}tensor{\_}polarizations.f95\edoc{}}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -\LA{}Copyleft\RA{} -module omega_tensor_polarizations - use kinds - use omega_constants - use omega_vectors - use omega_tensors - use omega_polarizations - implicit none - private - \LA{}Declaration of polarization tensors\RA{} - integer, parameter, public :: omega_tensor_pols_2003_03_A = 0 -contains - \LA{}Implementation of polarization tensors\RA{} -end module omega_tensor_polarizations -\nwendcode{}\nwbegindocs{296}\nwdocspar -\nwenddocs{}\nwbegincode{297}\moddef{Declaration of polarization tensors}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -public :: eps2 -\nwendcode{}\nwbegindocs{298}\nwdocspar -\nwenddocs{}\nwbegincode{299}\moddef{Implementation of polarization tensors}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function eps2 (m, k, s) result (t) - type(tensor) :: t - real(kind=default), intent(in) :: m - type(momentum), intent(in) :: k - integer, intent(in) :: s - type(vector) :: ep, em, e0 - t%t = 0 - select case (s) - case (2) - ep = eps (m, k, 1) - t = ep.tprod.ep - case (1) - ep = eps (m, k, 1) - e0 = eps (m, k, 0) - t = (1 / sqrt (2.0_default)) & - * ((ep.tprod.e0) + (e0.tprod.ep)) - case (0) - ep = eps (m, k, 1) - e0 = eps (m, k, 0) - em = eps (m, k, -1) - t = (1 / sqrt (6.0_default)) & - * ((ep.tprod.em) + (em.tprod.ep) - 2*(e0.tprod.e0)) - case (-1) - e0 = eps (m, k, 0) - em = eps (m, k, -1) - t = (1 / sqrt (2.0_default)) & - * ((em.tprod.e0) + (e0.tprod.em)) - case (-2) - em = eps (m, k, -1) - t = em.tprod.em - end select -end function eps2 -\nwendcode{}\nwbegindocs{300}\section{Couplings} -\nwenddocs{}\nwbegincode{301}\moddef{\code{}omega{\_}couplings.f95\edoc{}}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -\LA{}Copyleft\RA{} -module omega_couplings - use kinds - use omega_constants - use omega_vectors - use omega_tensors - implicit none - private - \LA{}Declaration of couplings\RA{} - \LA{}Declaration of propagators\RA{} - integer, parameter, public :: omega_couplings_2003_03_A = 0 -contains - \LA{}Implementation of couplings\RA{} - \LA{}Implementation of propagators\RA{} -end module omega_couplings -\nwendcode{}\nwbegindocs{302}\nwdocspar -\nwenddocs{}\nwbegincode{303}\moddef{Declaration of propagators}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -public :: wd_tl -\nwendcode{}\nwbegindocs{304}\nwdocspar -\nwenddocs{}\nwbegincode{305}\moddef{Declaration of propagators}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -public :: gauss -\nwendcode{}\nwbegindocs{306}\nwdocspar -\begin{equation} - \Theta(p^2)\Gamma -\end{equation} -\nwenddocs{}\nwbegincode{307}\moddef{Implementation of propagators}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function wd_tl (p, w) result (width) - real(kind=default) :: width - type(momentum), intent(in) :: p - real(kind=default), intent(in) :: w - if (p*p > 0) then - width = w - else - width = 0 - end if -end function wd_tl -\nwendcode{}\nwbegindocs{308}\nwdocspar -\nwenddocs{}\nwbegincode{309}\moddef{Implementation of propagators}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function gauss (x, mu, w) result (gg) - real(kind=default) :: gg - real(kind=default), intent(in) :: x, mu, w - if (w > 0) then - gg = exp(-(x - mu**2)**2/4.0_default/mu**2/w**2) * & - sqrt(sqrt(PI/2)) / w / mu - else - gg = 1.0_default - end if -end function gauss -\nwendcode{}\nwbegindocs{310}\nwdocspar -\nwenddocs{}\nwbegincode{311}\moddef{Declaration of propagators}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -public :: pr_phi, pr_unitarity, pr_feynman, pr_gauge, pr_rxi -public :: pj_phi, pj_unitarity -public :: pg_phi, pg_unitarity -\nwendcode{}\nwbegindocs{312}\nwdocspar -\begin{equation} - \frac{\ii}{p^2-m^2+\ii m\Gamma}\phi -\end{equation} -\nwenddocs{}\nwbegincode{313}\moddef{Implementation of propagators}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function pr_phi (p, m, w, phi) result (pphi) - complex(kind=default) :: pphi - type(momentum), intent(in) :: p - real(kind=default), intent(in) :: m, w - complex(kind=default), intent(in) :: phi - pphi = (1 / cmplx (p*p - m**2, m*w, kind=default)) * phi -end function pr_phi -\nwendcode{}\nwbegindocs{314}\nwdocspar -\begin{equation} - \sqrt{\frac{\pi}{M\Gamma}} - \phi -\end{equation} -\nwenddocs{}\nwbegincode{315}\moddef{Implementation of propagators}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function pj_phi (m, w, phi) result (pphi) - complex(kind=default) :: pphi - real(kind=default), intent(in) :: m, w - complex(kind=default), intent(in) :: phi - pphi = (0, -1) * sqrt (PI / m / w) * phi -end function pj_phi -\nwendcode{}\nwbegindocs{316}\nwdocspar -\nwenddocs{}\nwbegincode{317}\moddef{Implementation of propagators}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function pg_phi (p, m, w, phi) result (pphi) - complex(kind=default) :: pphi - type(momentum), intent(in) :: p - real(kind=default), intent(in) :: m, w - complex(kind=default), intent(in) :: phi - pphi = ((0, 1) * gauss (p*p, m, w)) * phi -end function pg_phi -\nwendcode{}\nwbegindocs{318}\nwdocspar -\begin{equation} - \frac{\ii}{p^2-m^2+\ii m\Gamma} - \left( -g_{\mu\nu} + \frac{p_\mu p_\nu}{m^2} \right) \epsilon^\nu(p) -\end{equation} -NB: the explicit cast to {\Tt{}vector\nwendquote} is required here, because a specific -{\Tt{}complex{\_}momentum\nwendquote} procedure for {\Tt{}operator\ (*)\nwendquote} would introduce -ambiguities. -NB: we used to use the constructor {\Tt{}vector\ (p{\%}t,\ p{\%}x)\nwendquote} instead of -the temporary variable, but the Intel Fortran Compiler choked on it. -\nwenddocs{}\nwbegincode{319}\moddef{Implementation of propagators}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function pr_unitarity (p, m, w, e) result (pe) - type(vector) :: pe - type(momentum), intent(in) :: p - real(kind=default), intent(in) :: m, w - type(vector), intent(in) :: e - type(vector) :: pv - pv = p - pe = - (1 / cmplx (p*p - m**2, m*w, kind=default)) & - * (e - (p*e / m**2) * pv) -end function pr_unitarity -\nwendcode{}\nwbegindocs{320}\nwdocspar -\begin{equation} - \sqrt{\frac{\pi}{M\Gamma}} - \left( -g_{\mu\nu} + \frac{p_\mu p_\nu}{m^2} \right) \epsilon^\nu(p) -\end{equation} -\nwenddocs{}\nwbegincode{321}\moddef{Implementation of propagators}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function pj_unitarity (p, m, w, e) result (pe) - type(vector) :: pe - type(momentum), intent(in) :: p - real(kind=default), intent(in) :: m, w - type(vector), intent(in) :: e - type(vector) :: pv - pv = p - pe = (0, 1) * sqrt (PI / m / w) * (e - (p*e / m**2) * pv) -end function pj_unitarity -\nwendcode{}\nwbegindocs{322}\nwdocspar -\nwenddocs{}\nwbegincode{323}\moddef{Implementation of propagators}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function pg_unitarity (p, m, w, e) result (pe) - type(vector) :: pe - type(momentum), intent(in) :: p - real(kind=default), intent(in) :: m, w - type(vector), intent(in) :: e - type(vector) :: pv - pv = p - pe = - gauss (p*p, m, w) & - * (e - (p*e / m**2) * pv) -end function pg_unitarity -\nwendcode{}\nwbegindocs{324}\nwdocspar -\begin{equation} - \frac{-i}{p^2} \epsilon^\nu(p) -\end{equation} -\nwenddocs{}\nwbegincode{325}\moddef{Implementation of propagators}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function pr_feynman (p, e) result (pe) - type(vector) :: pe - type(momentum), intent(in) :: p - type(vector), intent(in) :: e - pe = - (1 / (p*p)) * e -end function pr_feynman -\nwendcode{}\nwbegindocs{326}\nwdocspar -\begin{equation} - \frac{\ii}{p^2} - \left( -g_{\mu\nu} + (1-\xi)\frac{p_\mu p_\nu}{p^2} \right) - \epsilon^\nu(p) -\end{equation} -\nwenddocs{}\nwbegincode{327}\moddef{Implementation of propagators}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function pr_gauge (p, xi, e) result (pe) - type(vector) :: pe - type(momentum), intent(in) :: p - real(kind=default), intent(in) :: xi - type(vector), intent(in) :: e - real(kind=default) :: p2 - type(vector) :: pv - p2 = p*p - pv = p - pe = - (1 / p2) * (e - ((1 - xi) * (p*e) / p2) * pv) -end function pr_gauge -\nwendcode{}\nwbegindocs{328}\nwdocspar -\begin{equation} - \frac{\ii}{p^2-m^2+\ii m\Gamma} - \left( -g_{\mu\nu} + (1-\xi)\frac{p_\mu p_\nu}{p^2-\xi m^2} \right) - \epsilon^\nu(p) -\end{equation} -\nwenddocs{}\nwbegincode{329}\moddef{Implementation of propagators}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function pr_rxi (p, m, w, xi, e) result (pe) - type(vector) :: pe - type(momentum), intent(in) :: p - real(kind=default), intent(in) :: m, w, xi - type(vector), intent(in) :: e - real(kind=default) :: p2 - type(vector) :: pv - p2 = p*p - pv = p - pe = - (1 / cmplx (p2 - m**2, m*w, kind=default)) & - * (e - ((1 - xi) * (p*e) / (p2 - xi * m**2)) * pv) -end function pr_rxi -\nwendcode{}\nwbegindocs{330}\nwdocspar -\nwenddocs{}\nwbegincode{331}\moddef{Declaration of propagators}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -public :: pr_tensor -\nwendcode{}\nwbegindocs{332}\nwdocspar -\begin{subequations} -\begin{equation} - \frac{\ii P^{\mu\nu,\rho\sigma}(p,m)}{p^2-m^2+\ii m\Gamma} T_{\rho\sigma} -\end{equation} -with -\begin{multline} - P^{\mu\nu,\rho\sigma}(p,m) - = \frac{1}{2} \left(g^{\mu\rho}-\frac{p^{\mu}p^{\nu}}{m^2}\right) - \left(g^{\nu\sigma}-\frac{p^{\nu}p^{\sigma}}{m^2}\right) - + \frac{1}{2} \left(g^{\mu\sigma}-\frac{p^{\mu}p^{\sigma}}{m^2}\right) - \left(g^{\nu\rho}-\frac{p^{\nu}p^{\rho}}{m^2}\right) \\ - - \frac{1}{3} \left(g^{\mu\nu}-\frac{p^{\mu}p^{\nu}}{m^2}\right) - \left(g^{\rho\sigma}-\frac{p^{\rho}p^{\sigma}}{m^2}\right) -\end{multline} -\end{subequations} -Be careful with raising and lowering of indices: -\begin{subequations} -\begin{align} - g^{\mu\nu}-\frac{k^{\mu}k^{\nu}}{m^2} - &= \begin{pmatrix} - 1 - k^0k^0 / m^2 & - k^0 \vec k / m^2 \\ - - \vec k k^0 / m^2 & - \mathbf{1} - \vec k \otimes \vec k / m^2 - \end{pmatrix} \\ - g^{\mu}_{\hphantom{\mu}\nu}-\frac{k^{\mu}k_{\nu}}{m^2} - &= \begin{pmatrix} - 1 - k^0k^0 / m^2 & k^0 \vec k / m^2 \\ - - \vec k k^0 / m^2 & \mathbf{1} + \vec k \otimes \vec k / m^2 - \end{pmatrix} -\end{align} -\end{subequations} -\nwenddocs{}\nwbegincode{333}\moddef{Implementation of propagators}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function pr_tensor (p, m, w, t) result (pt) - type(tensor) :: pt - type(momentum), intent(in) :: p - real(kind=default), intent(in) :: m, w - type(tensor), intent(in) :: t - complex(kind=default) :: p_dd_t - real(kind=default), dimension(0:3,0:3) :: p_uu, p_ud, p_du, p_dd - integer :: i, j - p_uu(0,0) = 1 - p%t * p%t / m**2 - p_uu(0,1:3) = - p%t * p%x / m**2 - p_uu(1:3,0) = p_uu(0,1:3) - do i = 1, 3 - do j = 1, 3 - p_uu(i,j) = - p%x(i) * p%x(j) / m**2 - end do - end do - do i = 1, 3 - p_uu(i,i) = - 1 + p_uu(i,i) - end do - p_ud(:,0) = p_uu(:,0) - p_ud(:,1:3) = - p_uu(:,1:3) - p_du = transpose (p_ud) - p_dd(:,0) = p_du(:,0) - p_dd(:,1:3) = - p_du(:,1:3) - p_dd_t = 0 - do i = 0, 3 - do j = 0, 3 - p_dd_t = p_dd_t + p_dd(i,j) * t%t(i,j) - end do - end do - pt%t = matmul (p_ud, matmul (0.5_default * (t%t + transpose (t%t)), p_du)) & - - (p_dd_t / 3.0_default) * p_uu - pt%t = pt%t / cmplx (p*p - m**2, m*w, kind=default) -end function pr_tensor -\nwendcode{}\nwbegindocs{334}\subsection{Triple Gauge Couplings} -\nwenddocs{}\nwbegincode{335}\moddef{Declaration of couplings}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -public :: g_gg -\nwendcode{}\nwbegindocs{336}According to~(\ref{eq:fuse-gauge}) -\begin{multline} - A^{a,\mu}(k_1+k_2) = - \ii g - \bigl( (k_1^{\mu}-k_2^{\mu})A^{a_1}(k_1) \cdot A^{a_2}(k_2) \\ - + (2k_2+k_1)\cdot A^{a_1}(k_1)A^{a_2,\mu}(k_2) - - A^{a_1,\mu}(k_1)A^{a_2}(k_2)\cdot(2k_1+k_2) \bigr) -\end{multline} -\nwenddocs{}\nwbegincode{337}\moddef{Implementation of couplings}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function g_gg (g, a1, k1, a2, k2) result (a) - complex(kind=default), intent(in) :: g - type(vector), intent(in) :: a1, a2 - type(momentum), intent(in) :: k1, k2 - type(vector) :: a - a = (0, -1) * g * ((k1 - k2) * (a1 * a2) & - + ((2*k2 + k1) * a1) * a2 - a1 * ((2*k1 + k2) * a2)) -end function g_gg -\nwendcode{}\nwbegindocs{338}\subsection{Quadruple Gauge Couplings} -\nwenddocs{}\nwbegincode{339}\moddef{Declaration of couplings}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -public :: x_gg, g_gx -\nwendcode{}\nwbegindocs{340}\nwdocspar -\begin{equation} - T^{a,\mu\nu}(k_1+k_2) = g - \bigl( A^{a_1,\mu}(k_1) A^{a_2,\nu}(k_2) - A^{a_1,\nu}(k_1) A^{a_2,\mu}(k_2) \bigr) -\end{equation} -\nwenddocs{}\nwbegincode{341}\moddef{Implementation of couplings}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function x_gg (g, a1, a2) result (x) - complex(kind=default), intent(in) :: g - type(vector), intent(in) :: a1, a2 - type(tensor2odd) :: x - x = g * (a1 .wedge. a2) -end function x_gg -\nwendcode{}\nwbegindocs{342}\nwdocspar -\begin{equation} - A^{a,\mu}(k_1+k_2) = g A^{a_1}_\nu(k_1) T^{a_2,\nu\mu}(k_2) -\end{equation} -\nwenddocs{}\nwbegincode{343}\moddef{Implementation of couplings}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function g_gx (g, a1, x) result (a) - complex(kind=default), intent(in) :: g - type(vector), intent(in) :: a1 - type(tensor2odd), intent(in) :: x - type(vector) :: a - a = g * (a1 * x) -end function g_gx -\nwendcode{}\nwbegindocs{344}\subsection{Scalar Current} -\nwenddocs{}\nwbegincode{345}\moddef{Declaration of couplings}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -public :: v_ss, s_vs -\nwendcode{}\nwbegindocs{346}\nwdocspar -\begin{equation} - V^\mu(k_1+k_2) = g(k_1^\mu - k_2^\mu)\phi_1(k_1)\phi_2(k_2) -\end{equation} -\nwenddocs{}\nwbegincode{347}\moddef{Implementation of couplings}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function v_ss (g, phi1, k1, phi2, k2) result (v) - complex(kind=default), intent(in) :: g, phi1, phi2 - type(momentum), intent(in) :: k1, k2 - type(vector) :: v - v = (k1 - k2) * (g * phi1 * phi2) -end function v_ss -\nwendcode{}\nwbegindocs{348}\nwdocspar -\begin{equation} - \phi(k_1+k_2) = g(k_1^\mu + 2k_2^\mu)V_\mu(k_1)\phi(k_2) -\end{equation} -\nwenddocs{}\nwbegincode{349}\moddef{Implementation of couplings}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function s_vs (g, v1, k1, phi2, k2) result (phi) - complex(kind=default), intent(in) :: g, phi2 - type(vector), intent(in) :: v1 - type(momentum), intent(in) :: k1, k2 - complex(kind=default) :: phi - phi = g * ((k1 + 2*k2) * v1) * phi2 -end function s_vs -\nwendcode{}\nwbegindocs{350}\subsection{Triple Vector Couplings} -\nwenddocs{}\nwbegincode{351}\moddef{Declaration of couplings}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -public :: tkv_vv, lkv_vv, tv_kvv, lv_kvv, kg_kgkg -public :: t5kv_vv, l5kv_vv, t5v_kvv, l5v_kvv, kg5_kgkg, kg_kg5kg -\nwendcode{}\nwbegindocs{352}\nwdocspar -\begin{equation} - V^\mu(k_1+k_2) = \ii g(k_1-k_2)^\mu V_1^\nu(k_1)V_{2,\nu}(k_2) -\end{equation} -\nwenddocs{}\nwbegincode{353}\moddef{Implementation of couplings}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function tkv_vv (g, v1, k1, v2, k2) result (v) - complex(kind=default), intent(in) :: g - type(vector), intent(in) :: v1, v2 - type(momentum), intent(in) :: k1, k2 - type(vector) :: v - v = (k1 - k2) * ((0, 1) * g * (v1*v2)) -end function tkv_vv -\nwendcode{}\nwbegindocs{354}\nwdocspar -\begin{equation} - V^\mu(k_1+k_2) = \ii g \epsilon^{\mu\nu\rho\sigma} - (k_1-k_2)_{\nu} V_{1,\rho}(k_1)V_{2,\sigma}(k_2) -\end{equation} -\nwenddocs{}\nwbegincode{355}\moddef{Implementation of couplings}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function t5kv_vv (g, v1, k1, v2, k2) result (v) - complex(kind=default), intent(in) :: g - type(vector), intent(in) :: v1, v2 - type(momentum), intent(in) :: k1, k2 - type(vector) :: v - type(vector) :: k - k = k1 - k2 - v = (0, 1) * g * pseudo_vector (k, v1, v2) -end function t5kv_vv -\nwendcode{}\nwbegindocs{356}\nwdocspar -\begin{equation} - V^\mu(k_1+k_2) = \ii g(k_1+k_2)^\mu V_1^\nu(k_1)V_{2,\nu}(k_2) -\end{equation} -\nwenddocs{}\nwbegincode{357}\moddef{Implementation of couplings}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function lkv_vv (g, v1, k1, v2, k2) result (v) - complex(kind=default), intent(in) :: g - type(vector), intent(in) :: v1, v2 - type(momentum), intent(in) :: k1, k2 - type(vector) :: v - v = (k1 + k2) * ((0, 1) * g * (v1*v2)) -end function lkv_vv -\nwendcode{}\nwbegindocs{358}\nwdocspar -\begin{equation} - V^\mu(k_1+k_2) = \ii g \epsilon^{\mu\nu\rho\sigma} - (k_1+k_2)_{\nu} V_{1,\rho}(k_1)V_{2,\sigma}(k_2) -\end{equation} -\nwenddocs{}\nwbegincode{359}\moddef{Implementation of couplings}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function l5kv_vv (g, v1, k1, v2, k2) result (v) - complex(kind=default), intent(in) :: g - type(vector), intent(in) :: v1, v2 - type(momentum), intent(in) :: k1, k2 - type(vector) :: v - type(vector) :: k - k = k1 + k2 - v = (0, 1) * g * pseudo_vector (k, v1, v2) -end function l5kv_vv -\nwendcode{}\nwbegindocs{360}\nwdocspar -\begin{equation} - V^\mu(k_1+k_2) = \ii g (k_2-k)^\nu V_{1,\nu}(k_1)V_2^\mu(k_2) - = \ii g (2k_2+k_1)^\nu V_{1,\nu}(k_1)V_2^\mu(k_2) -\end{equation} -using $k=-k_1-k_2$ -\nwenddocs{}\nwbegincode{361}\moddef{Implementation of couplings}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function tv_kvv (g, v1, k1, v2, k2) result (v) - complex(kind=default), intent(in) :: g - type(vector), intent(in) :: v1, v2 - type(momentum), intent(in) :: k1, k2 - type(vector) :: v - v = v2 * ((0, 1) * g * ((2*k2 + k1)*v1)) -end function tv_kvv -\nwendcode{}\nwbegindocs{362}\nwdocspar -\begin{equation} - V^\mu(k_1+k_2) = \ii g \epsilon^{\mu\nu\rho\sigma} - (2k_2+k_1)_{\nu} V_{1,\rho}(k_1)V_{2,\sigma}(k_2) -\end{equation} -\nwenddocs{}\nwbegincode{363}\moddef{Implementation of couplings}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function t5v_kvv (g, v1, k1, v2, k2) result (v) - complex(kind=default), intent(in) :: g - type(vector), intent(in) :: v1, v2 - type(momentum), intent(in) :: k1, k2 - type(vector) :: v - type(vector) :: k - k = k1 + 2*k2 - v = (0, 1) * g * pseudo_vector (k, v1, v2) -end function t5v_kvv -\nwendcode{}\nwbegindocs{364}\nwdocspar -\begin{equation} - V^\mu(k_1+k_2) = - \ii g k_1^\nu V_{1,\nu}(k_1)V_2^\mu(k_2) -\end{equation} -using $k=-k_1-k_2$ -\nwenddocs{}\nwbegincode{365}\moddef{Implementation of couplings}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function lv_kvv (g, v1, k1, v2) result (v) - complex(kind=default), intent(in) :: g - type(vector), intent(in) :: v1, v2 - type(momentum), intent(in) :: k1 - type(vector) :: v - v = v2 * ((0, -1) * g * (k1*v1)) -end function lv_kvv -\nwendcode{}\nwbegindocs{366}\nwdocspar -\begin{equation} - V^\mu(k_1+k_2) = - \ii g \epsilon^{\mu\nu\rho\sigma} - k_{1,\nu} V_{1,\rho}(k_1)V_{2,\sigma}(k_2) -\end{equation} -\nwenddocs{}\nwbegincode{367}\moddef{Implementation of couplings}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function l5v_kvv (g, v1, k1, v2) result (v) - complex(kind=default), intent(in) :: g - type(vector), intent(in) :: v1, v2 - type(momentum), intent(in) :: k1 - type(vector) :: v - type(vector) :: k - k = k1 - v = (0, -1) * g * pseudo_vector (k, v1, v2) -end function l5v_kvv -\nwendcode{}\nwbegindocs{368}\nwdocspar -\begin{equation} - A^\mu(k_1+k_2) = \ii g k^\nu - \Bigl( F_{1,\nu}^{\hphantom{1,\nu}\rho}(k_1)F_{2,\rho\mu}(k_2) - - F_{1,\mu}^{\hphantom{1,\mu}\rho}(k_1)F_{2,\rho\nu}(k_2) \Bigr) -\end{equation} -with $k=-k_1-k_2$, i.\,e. -\begin{multline} - A^\mu(k_1+k_2) = -\ii g - \Bigl( [(kk_2)(k_1A_2) - (k_1k_2)(kA_2)] A_1^\mu \\ - + [(k_1k_2)(kA_1) - (kk_1)(k_2A_1)] A_2^\mu \\ - + [(k_2A_1)(kA_2) - (kk_2)(A_1A_2)] k_1^\mu \\ - + [(kk_1)(A_1A_2) - (kA_1)(k_1A_2)] k_2^\mu \Bigr) -\end{multline} -\nwenddocs{}\nwbegincode{369}\moddef{Implementation of couplings}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function kg_kgkg (g, a1, k1, a2, k2) result (a) - complex(kind=default), intent(in) :: g - type(vector), intent(in) :: a1, a2 - type(momentum), intent(in) :: k1, k2 - type(vector) :: a - real(kind=default) :: k1k1, k2k2, k1k2, kk1, kk2 - complex(kind=default) :: a1a2, k2a1, ka1, k1a2, ka2 - k1k1 = k1 * k1 - k1k2 = k1 * k2 - k2k2 = k2 * k2 - kk1 = k1k1 + k1k2 - kk2 = k1k2 + k2k2 - k2a1 = k2 * a1 - ka1 = k2a1 + k1 * a1 - k1a2 = k1 * a2 - ka2 = k1a2 + k2 * a2 - a1a2 = a1 * a2 - a = (0, -1) * g * ( (kk2 * k1a2 - k1k2 * ka2 ) * a1 & - + (k1k2 * ka1 - kk1 * k2a1) * a2 & - + (ka2 * k2a1 - kk2 * a1a2) * k1 & - + (kk1 * a1a2 - ka1 * k1a2) * k2 ) -end function kg_kgkg -\nwendcode{}\nwbegindocs{370}\nwdocspar -\begin{equation} - A^\mu(k_1+k_2) = \ii g \epsilon^{\mu\nu\rho\sigma} k_{\nu} - F_{1,\rho}^{\hphantom{1,\rho}\lambda}(k_1)F_{2,\lambda\sigma}(k_2) -\end{equation} -with $k=-k_1-k_2$, i.\,e. -\begin{multline} - A^\mu(k_1+k_2) = -2\ii g \epsilon^{\mu\nu\rho\sigma} k_{\nu} - \Bigl( (k_2A_1) k_{1,\rho} A_{2,\sigma} - + (k_1A_2) A_{1,\rho} k_{2,\sigma} \\ - - (A_1A_2) k_{1,\rho} k_{2,\sigma} - - (k_1k_2) A_{1,\rho} A_{2,\sigma} \Bigr) -\end{multline} -\nwenddocs{}\nwbegincode{371}\moddef{Implementation of couplings}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function kg5_kgkg (g, a1, k1, a2, k2) result (a) - complex(kind=default), intent(in) :: g - type(vector), intent(in) :: a1, a2 - type(momentum), intent(in) :: k1, k2 - type(vector) :: a - type(vector) :: kv, k1v, k2v - kv = - k1 - k2 - k1v = k1 - k2v = k2 - a = (0, -2) * g * ( (k2*A1) * pseudo_vector (kv, k1v, a2 ) & - + (k1*A2) * pseudo_vector (kv, A1 , k2v) & - - (A1*A2) * pseudo_vector (kv, k1v, k2v) & - - (k1*k2) * pseudo_vector (kv, a1 , a2 ) ) -end function kg5_kgkg -\nwendcode{}\nwbegindocs{372}\nwdocspar -\begin{equation} - A^\mu(k_1+k_2) = \ii g k_{\nu} \Bigl( - \epsilon^{\mu\rho\lambda\sigma} - F_{1,\hphantom{\nu}\rho}^{\hphantom{1,}\nu} - - \epsilon^{\nu\rho\lambda\sigma} - F_{1,\hphantom{\mu}\rho}^{\hphantom{1,}\mu} \Bigr) - \frac{1}{2} F_{1,\lambda\sigma} -\end{equation} -with $k=-k_1-k_2$, i.\,e. -\begin{multline} - A^\mu(k_1+k_2) = -\ii g \Bigl( - \epsilon^{\mu\rho\lambda\sigma} (kk_2) A_{2,\rho} - - \epsilon^{\mu\rho\lambda\sigma} (kA_2) k_{2,\rho} - - k_2^\mu \epsilon^{\nu\rho\lambda\sigma} k_nu A_{2,\rho} - + A_2^\mu \epsilon^{\nu\rho\lambda\sigma} k_nu k_{2,\rho} - \Bigr) k_{1,\lambda} A_{1,\sigma} -\end{multline} -\begin{dubious} - This is not the most efficienct way of doing it: - $\epsilon^{\mu\nu\rho\sigma}F_{1,\rho\sigma}$ should be cached! -\end{dubious} -\nwenddocs{}\nwbegincode{373}\moddef{Implementation of couplings}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function kg_kg5kg (g, a1, k1, a2, k2) result (a) - complex(kind=default), intent(in) :: g - type(vector), intent(in) :: a1, a2 - type(momentum), intent(in) :: k1, k2 - type(vector) :: a - type(vector) :: kv, k1v, k2v - kv = - k1 - k2 - k1v = k1 - k2v = k2 - a = (0, -1) * g * ( (kv*k2v) * pseudo_vector (a2 , k1v, a1) & - - (kv*a2 ) * pseudo_vector (k2v, k1v, a1) & - - k2v * pseudo_scalar (kv, a2, k1v, a1) & - + a2 * pseudo_scalar (kv, k2v, k1v, a1) ) -end function kg_kg5kg -\nwendcode{}\nwbegindocs{374}\section{Graviton Couplings} -\nwenddocs{}\nwbegincode{375}\moddef{Declaration of couplings}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -public :: s_gravs, v_gravv, grav_ss, grav_vv -\nwendcode{}\nwbegindocs{376}\nwdocspar -\nwenddocs{}\nwbegincode{377}\moddef{Implementation of couplings}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function s_gravs (g, m, k1, k2, t, s) result (phi) - complex(kind=default), intent(in) :: g, s - real(kind=default), intent(in) :: m - type(momentum), intent(in) :: k1, k2 - type(tensor), intent(in) :: t - complex(kind=default) :: phi, t_tr - t_tr = t%t(0,0) - t%t(1,1) - t%t(2,2) - t%t(3,3) - phi = g * s * (((t*k1)*k2) + ((t*k2)*k1) & - - g * (m**2 + (k1*k2))*t_tr)/2.0_default -end function s_gravs -\nwendcode{}\nwbegindocs{378}\nwdocspar -\nwenddocs{}\nwbegincode{379}\moddef{Implementation of couplings}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function grav_ss (g, m, k1, k2, s1, s2) result (t) - complex(kind=default), intent(in) :: g, s1, s2 - real(kind=default), intent(in) :: m - type(momentum), intent(in) :: k1, k2 - type(tensor) :: t_metric, t - t_metric%t = 0 - t_metric%t(0,0) = 1.0_default - t_metric%t(1,1) = - 1.0_default - t_metric%t(2,2) = - 1.0_default - t_metric%t(3,3) = - 1.0_default - t = g*s1*s2/2.0_default * (-(m**2 + (k1*k2)) * t_metric & - + (k1.tprod.k2) + (k2.tprod.k1)) -end function grav_ss -\nwendcode{}\nwbegindocs{380}\nwdocspar -\nwenddocs{}\nwbegincode{381}\moddef{Implementation of couplings}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function v_gravv (g, m, k1, k2, t, v) result (vec) - complex(kind=default), intent(in) :: g - real(kind=default), intent(in) :: m - type(momentum), intent(in) :: k1, k2 - type(vector), intent(in) :: v - type(tensor), intent(in) :: t - complex(kind=default) :: t_tr - real(kind=default) :: xi - type(vector) :: vec - xi = 1.0_default - t_tr = t%t(0,0) - t%t(1,1) - t%t(2,2) - t%t(3,3) - vec = (-g)/ 2.0_default * (((k1*k2) + m**2) * & - (t*v + v*t - t_tr * v) + t_tr * (k1*v) * k2 & - - (k1*v) * ((k2*t) + (t*k2)) & - - ((k1*(t*v)) + (v*(t*k1))) * k2 & - + ((k1*(t*k2)) + (k2*(t*k1))) * v) -!!! Unitarity gauge: xi -> Infinity -!!! + (1.0_default/xi) * (t_tr * ((k1*v)*k2) + & -!!! (k2*v)*k2 + (k2*v)*k1 - (k1*(t*v))*k1 + & -!!! (k2*v)*(k2*t) - (v*(t*k1))*k1 - (k2*v)*(t*k2))) -end function v_gravv -\nwendcode{}\nwbegindocs{382}\nwdocspar -\nwenddocs{}\nwbegincode{383}\moddef{Implementation of couplings}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function grav_vv (g, m, k1, k2, v1, v2) result (t) - complex(kind=default), intent(in) :: g - type(momentum), intent(in) :: k1, k2 - real(kind=default), intent(in) :: m - real(kind=default) :: xi - type(vector), intent (in) :: v1, v2 - type(tensor) :: t_metric, t - xi = 0.00001_default - t_metric%t = 0 - t_metric%t(0,0) = 1.0_default - t_metric%t(1,1) = - 1.0_default - t_metric%t(2,2) = - 1.0_default - t_metric%t(3,3) = - 1.0_default - t = (-g)/2.0_default * ( & - ((k1*k2) + m**2) * ( & - (v1.tprod.v2) + (v2.tprod.v1) - (v1*v2) * t_metric) & - + (v1*k2)*(v2*k1)*t_metric & - - (k2*v1)*((v2.tprod.k1) + (k1.tprod.v2)) & - - (k1*v2)*((v1.tprod.k2) + (k2.tprod.v1)) & - + (v1*v2)*((k1.tprod.k2) + (k2.tprod.k1))) -!!! Unitarity gauge: xi -> Infinity -!!! + (1.0_default/xi) * ( & -!!! ((k1*v1)*(k1*v2) + (k2*v1)*(k2*v2) + (k1*v1)*(k2*v2))* & -!!! t_metric) - (k1*v1) * ((k1.tprod.v2) + (v2.tprod.k1)) & -!!! - (k2*v2) * ((k2.tprod.v1) + (v1.tprod.k2))) -end function grav_vv -\nwendcode{}\nwbegindocs{384}\section{Tensor Couplings} -\nwenddocs{}\nwbegincode{385}\moddef{Declaration of couplings}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -public :: t2_vv, v_t2v -\nwendcode{}\nwbegindocs{386}\section{Scalar-Vector Dim-5 Couplings} -\nwenddocs{}\nwbegincode{387}\moddef{Declaration of couplings}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -public :: phi_vv, v_phiv -\nwendcode{}\nwbegindocs{388}\nwdocspar -\nwenddocs{}\nwbegincode{389}\moddef{Implementation of couplings}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function phi_vv (g, k1, k2, v1, v2) result (phi) - complex(kind=default), intent(in) :: g - type(momentum), intent(in) :: k1, k2 - type(vector), intent(in) :: v1, v2 - complex(kind=default) :: phi - phi = g * pseudo_scalar (k1, v1, k2, v2) -end function phi_vv -\nwendcode{}\nwbegindocs{390}\nwdocspar -\nwenddocs{}\nwbegincode{391}\moddef{Implementation of couplings}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function v_phiv (g, phi, k1, k2, v) result (w) - complex(kind=default), intent(in) :: g, phi - type(vector), intent(in) :: v - type(momentum), intent(in) :: k1, k2 - type(vector) :: w - w = g * phi * pseudo_vector (k1, k2, v) -end function v_phiv -\nwendcode{}\nwbegindocs{392}\nwdocspar -\nwenddocs{}\nwbegincode{393}\moddef{Implementation of couplings}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function t2_vv (g, v1, v2) result (t) - complex(kind=default), intent(in) :: g - type(vector), intent(in) :: v1, v2 - type(tensor) :: t - type(tensor) :: tmp - tmp = v1.tprod.v2 - t%t = g * (tmp%t + transpose (tmp%t)) -end function t2_vv -\nwendcode{}\nwbegindocs{394}\nwdocspar -\nwenddocs{}\nwbegincode{395}\moddef{Implementation of couplings}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function v_t2v (g, t, v) result (tv) - complex(kind=default), intent(in) :: g - type(tensor), intent(in) :: t - type(vector), intent(in) :: v - type(vector) :: tv - type(tensor) :: tmp - tmp%t = t%t + transpose (t%t) - tv = g * (tmp * v) -end function v_t2v -\nwendcode{}\nwbegindocs{396}\nwdocspar -\nwenddocs{}\nwbegincode{397}\moddef{Declaration of couplings}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -public :: t2_vv_d5_1, v_t2v_d5_1 -\nwendcode{}\nwbegindocs{398}\nwdocspar -\nwenddocs{}\nwbegincode{399}\moddef{Implementation of couplings}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function t2_vv_d5_1 (g, v1, k1, v2, k2) result (t) - complex(kind=default), intent(in) :: g - type(vector), intent(in) :: v1, v2 - type(momentum), intent(in) :: k1, k2 - type(tensor) :: t - t = (g * (v1 * v2)) * (k1-k2).tprod.(k1-k2) -end function t2_vv_d5_1 -\nwendcode{}\nwbegindocs{400}\nwdocspar -\nwenddocs{}\nwbegincode{401}\moddef{Implementation of couplings}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function v_t2v_d5_1 (g, t1, k1, v2, k2) result (tv) - complex(kind=default), intent(in) :: g - type(tensor), intent(in) :: t1 - type(vector), intent(in) :: v2 - type(momentum), intent(in) :: k1, k2 - type(vector) :: tv - tv = (g * ((k1+2*k2).tprod.(k1+2*k2) * t1)) * v2 -end function v_t2v_d5_1 -\nwendcode{}\nwbegindocs{402}\nwdocspar -\nwenddocs{}\nwbegincode{403}\moddef{Declaration of couplings}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -public :: t2_vv_d5_2, v_t2v_d5_2 -\nwendcode{}\nwbegindocs{404}\nwdocspar -\nwenddocs{}\nwbegincode{405}\moddef{Implementation of couplings}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function t2_vv_d5_2 (g, v1, k1, v2, k2) result (t) - complex(kind=default), intent(in) :: g - type(vector), intent(in) :: v1, v2 - type(momentum), intent(in) :: k1, k2 - type(tensor) :: t - t = (g * (k2 * v1)) * (k2-k1).tprod.v2 - t%t = t%t + transpose (t%t) -end function t2_vv_d5_2 -\nwendcode{}\nwbegindocs{406}\nwdocspar -\nwenddocs{}\nwbegincode{407}\moddef{Implementation of couplings}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function v_t2v_d5_2 (g, t1, k1, v2, k2) result (tv) - complex(kind=default), intent(in) :: g - type(tensor), intent(in) :: t1 - type(vector), intent(in) :: v2 - type(momentum), intent(in) :: k1, k2 - type(vector) :: tv - type(tensor) :: tmp - type(momentum) :: k1_k2, k1_2k2 - k1_k2 = k1 + k2 - k1_2k2 = k1_k2 + k2 - tmp%t = t1%t + transpose (t1%t) - tv = (g * (k1_k2 * v2)) * (k1_2k2 * tmp) -end function v_t2v_d5_2 -\nwendcode{}\nwbegindocs{408}\nwdocspar -\nwenddocs{}\nwbegincode{409}\moddef{Declaration of couplings}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -public :: t2_vv_d7, v_t2v_d7 -\nwendcode{}\nwbegindocs{410}\nwdocspar -\nwenddocs{}\nwbegincode{411}\moddef{Implementation of couplings}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function t2_vv_d7 (g, v1, k1, v2, k2) result (t) - complex(kind=default), intent(in) :: g - type(vector), intent(in) :: v1, v2 - type(momentum), intent(in) :: k1, k2 - type(tensor) :: t - t = (g * (k2 * v1) * (k1 * v2)) * (k1-k2).tprod.(k1-k2) -end function t2_vv_d7 -\nwendcode{}\nwbegindocs{412}\nwdocspar -\nwenddocs{}\nwbegincode{413}\moddef{Implementation of couplings}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function v_t2v_d7 (g, t1, k1, v2, k2) result (tv) - complex(kind=default), intent(in) :: g - type(tensor), intent(in) :: t1 - type(vector), intent(in) :: v2 - type(momentum), intent(in) :: k1, k2 - type(vector) :: tv - type(vector) :: k1_k2, k1_2k2 - k1_k2 = k1 + k2 - k1_2k2 = k1_k2 + k2 - tv = (- g * (k1_k2 * v2) * (k1_2k2.tprod.k1_2k2 * t1)) * k2 -end function v_t2v_d7 -\nwendcode{}\nwbegindocs{414}\section{Spinor Couplings} -\nwenddocs{}\nwbegincode{415}\moddef{\code{}omega{\_}spinor{\_}couplings.f95\edoc{}}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -\LA{}Copyleft\RA{} -module omega_spinor_couplings - use kinds - use omega_constants - use omega_spinors - use omega_vectors - use omega_tensors - use omega_couplings - implicit none - private - \LA{}Declaration of spinor on shell wave functions\RA{} - \LA{}Declaration of spinor off shell wave functions\RA{} - \LA{}Declaration of spinor currents\RA{} - \LA{}Declaration of spinor propagators\RA{} - integer, parameter, public :: omega_spinor_cpls_2003_03_A = 0 -contains - \LA{}Implementation of spinor on shell wave functions\RA{} - \LA{}Implementation of spinor off shell wave functions\RA{} - \LA{}Implementation of spinor currents\RA{} - \LA{}Implementation of spinor propagators\RA{} -end module omega_spinor_couplings -\nwendcode{}\nwbegindocs{416}\nwdocspar -See table~\ref{tab:fermionic-currents} for the names of Fortran -functions. We could have used long names instead, but this would -increase the chance of running past continuation line limits without -adding much to the legibility. -\nwenddocs{}\nwbegindocs{417}\nwdocspar -\subsection{Fermionic Vector and Axial Couplings} -There's more than one chiral representation. This one is compatible -with HELAS~\cite{HELAS}. -\begin{equation} - \gamma^0 = \begin{pmatrix} 0 & \mathbf{1} \\ \mathbf{1} & 0 \end{pmatrix},\; - \gamma^i = \begin{pmatrix} 0 & \sigma^i \\ -\sigma^i & 0 \end{pmatrix},\; - \gamma_5 = i\gamma^0\gamma^1\gamma^2\gamma^3 - = \begin{pmatrix} -\mathbf{1} & 0 \\ 0 & \mathbf{1} \end{pmatrix} -\end{equation} -Therefore -\begin{subequations} -\begin{align} - g_S + g_P\gamma_5 &= - \begin{pmatrix} - g_S - g_P & 0 & 0 & 0 \\ - 0 & g_S - g_P & 0 & 0 \\ - 0 & 0 & g_S + g_P & 0 \\ - 0 & 0 & 0 & g_S + g_P - \end{pmatrix} \\ - g_V\gamma^0 - g_A\gamma^0\gamma_5 &= - \begin{pmatrix} - 0 & 0 & g_V - g_A & 0 \\ - 0 & 0 & 0 & g_V - g_A \\ - g_V + g_A & 0 & 0 & 0 \\ - 0 & g_V + g_A & 0 & 0 - \end{pmatrix} \\ - g_V\gamma^1 - g_A\gamma^1\gamma_5 &= - \begin{pmatrix} - 0 & 0 & 0 & g_V - g_A \\ - 0 & 0 & g_V - g_A & 0 \\ - 0 & - g_V - g_A & 0 & 0 \\ - - g_V - g_A & 0 & 0 & 0 - \end{pmatrix} \\ - g_V\gamma^2 - g_A\gamma^2\gamma_5 &= - \begin{pmatrix} - 0 & 0 & 0 & -\ii(g_V - g_A) \\ - 0 & 0 & \ii(g_V - g_A) & 0 \\ - 0 & \ii(g_V + g_A) & 0 & 0 \\ - -\ii(g_V + g_A) & 0 & 0 & 0 - \end{pmatrix} \\ - g_V\gamma^3 - g_A\gamma^3\gamma_5 &= - \begin{pmatrix} - 0 & 0 & g_V - g_A & 0 \\ - 0 & 0 & 0 & - g_V + g_A \\ - - g_V - g_A & 0 & 0 & 0 \\ - 0 & g_V + g_A & 0 & 0 - \end{pmatrix} -\end{align} -\end{subequations} -\begin{table} - \begin{center} - \begin{tabular}{>{$}l<{$}|>{$}l<{$}} - \bar\psi(g_V\gamma^\mu - g_A\gamma^\mu\gamma_5)\psi - & \text{\texttt{va\_ff}}(g_V,g_A,\bar\psi,\psi) \\ - g_V\bar\psi\gamma^\mu\psi - & \text{\texttt{v\_ff}}(g_V,\bar\psi,\psi) \\ - g_A\bar\psi\gamma_5\gamma^\mu\psi - & \text{\texttt{a\_ff}}(g_A,\bar\psi,\psi) \\ - g_L\bar\psi\gamma^\mu(1-\gamma_5)\psi - & \text{\texttt{vl\_ff}}(g_L,\bar\psi,\psi) \\ - g_R\bar\psi\gamma^\mu(1+\gamma_5)\psi - & \text{\texttt{vr\_ff}}(g_R,\bar\psi,\psi) \\\hline - \fmslash{V}(g_V - g_A\gamma_5)\psi - & \text{\texttt{f\_vaf}}(g_V,g_A,V,\psi) \\ - g_V\fmslash{V}\psi - & \text{\texttt{f\_vf}}(g_V,V,\psi) \\ - g_A\gamma_5\fmslash{V}\psi - & \text{\texttt{f\_af}}(g_A,V,\psi) \\ - g_L\fmslash{V}(1-\gamma_5)\psi - & \text{\texttt{f\_vlf}}(g_L,V,\psi) \\ - g_R\fmslash{V}(1+\gamma_5)\psi - & \text{\texttt{f\_vrf}}(g_R,V,\psi) \\\hline - \bar\psi\fmslash{V}(g_V - g_A\gamma_5) - & \text{\texttt{f\_fva}}(g_V,g_A,\bar\psi,V) \\ - g_V\bar\psi\fmslash{V} - & \text{\texttt{f\_fv}}(g_V,\bar\psi,V) \\ - g_A\bar\psi\gamma_5\fmslash{V} - & \text{\texttt{f\_fa}}(g_A,\bar\psi,V) \\ - g_L\bar\psi\fmslash{V}(1-\gamma_5) - & \text{\texttt{f\_fvl}}(g_L,\bar\psi,V) \\ - g_R\bar\psi\fmslash{V}(1+\gamma_5) - & \text{\texttt{f\_fvr}}(g_R,\bar\psi,V) - \end{tabular} - \end{center} - \caption{\label{tab:fermionic-currents} - Mnemonically abbreviated names of Fortran functions implementing - fermionic vector and axial currents.} -\end{table} -\begin{table} - \begin{center} - \begin{tabular}{>{$}l<{$}|>{$}l<{$}} - \bar\psi(g_S + g_P\gamma_5)\psi - & \text{\texttt{sp\_ff}}(g_S,g_P,\bar\psi,\psi) \\ - g_S\bar\psi\psi - & \text{\texttt{s\_ff}}(g_S,\bar\psi,\psi) \\ - g_P\bar\psi\gamma_5\psi - & \text{\texttt{p\_ff}}(g_P,\bar\psi,\psi) \\ - g_L\bar\psi(1-\gamma_5)\psi - & \text{\texttt{sl\_ff}}(g_L,\bar\psi,\psi) \\ - g_R\bar\psi(1+\gamma_5)\psi - & \text{\texttt{sr\_ff}}(g_R,\bar\psi,\psi) \\\hline - \phi(g_S + g_P\gamma_5)\psi - & \text{\texttt{f\_spf}}(g_S,g_P,\phi,\psi) \\ - g_S\phi\psi - & \text{\texttt{f\_sf}}(g_S,\phi,\psi) \\ - g_P\phi\gamma_5\psi - & \text{\texttt{f\_pf}}(g_P,\phi,\psi) \\ - g_L\phi(1-\gamma_5)\psi - & \text{\texttt{f\_slf}}(g_L,\phi,\psi) \\ - g_R\phi(1+\gamma_5)\psi - & \text{\texttt{f\_srf}}(g_R,\phi,\psi) \\\hline - \bar\psi\phi(g_S + g_P\gamma_5) - & \text{\texttt{f\_fsp}}(g_S,g_P,\bar\psi,\phi) \\ - g_S\bar\psi\phi - & \text{\texttt{f\_fs}}(g_S,\bar\psi,\phi) \\ - g_P\bar\psi\phi\gamma_5 - & \text{\texttt{f\_fp}}(g_P,\bar\psi,\phi) \\ - g_L\bar\psi\phi(1-\gamma_5) - & \text{\texttt{f\_fsl}}(g_L,\bar\psi,\phi) \\ - g_R\bar\psi\phi(1+\gamma_5) - & \text{\texttt{f\_fsr}}(g_R,\bar\psi,\phi) - \end{tabular} - \end{center} - \caption{\label{tab:fermionic-scalar currents} - Mnemonically abbreviated names of Fortran functions implementing - fermionic scalar and pseudo scalar ``currents''.} -\end{table} -\nwenddocs{}\nwbegincode{418}\moddef{Declaration of spinor currents}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -public :: va_ff, v_ff, a_ff, vl_ff, vr_ff, vlr_ff, grav_ff -\nwendcode{}\nwbegindocs{419}\nwdocspar -\nwenddocs{}\nwbegincode{420}\moddef{Implementation of spinor currents}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function va_ff (gv, ga, psibar, psi) result (j) - type(vector) :: j - complex(kind=default), intent(in) :: gv, ga - type(conjspinor), intent(in) :: psibar - type(spinor), intent(in) :: psi - complex(kind=default) :: gl, gr - complex(kind=default) :: g13, g14, g23, g24, g31, g32, g41, g42 - gl = gv + ga - gr = gv - ga - g13 = psibar%a(1)*psi%a(3) - g14 = psibar%a(1)*psi%a(4) - g23 = psibar%a(2)*psi%a(3) - g24 = psibar%a(2)*psi%a(4) - g31 = psibar%a(3)*psi%a(1) - g32 = psibar%a(3)*psi%a(2) - g41 = psibar%a(4)*psi%a(1) - g42 = psibar%a(4)*psi%a(2) - j%t = gr * ( g13 + g24) + gl * ( g31 + g42) - j%x(1) = gr * ( g14 + g23) - gl * ( g32 + g41) - j%x(2) = (gr * ( - g14 + g23) + gl * ( g32 - g41)) * (0, 1) - j%x(3) = gr * ( g13 - g24) + gl * ( - g31 + g42) -end function va_ff -\nwendcode{}\nwbegindocs{421}\nwdocspar -\nwenddocs{}\nwbegincode{422}\moddef{Spinor couplings (Fortran77)}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup - subroutine o7vaff (acc, gv, ga, pb, p) - implicit none - double complex acc(0:3), pb(4), p(4) - double precision gv, ga - double precision gl, gr - double complex g13, g14, g23, g24, g31, g32, g41, g42 - gl = gv + ga - gr = gv - ga - g13 = pb(1)*p(3) - g14 = pb(1)*p(4) - g23 = pb(2)*p(3) - g24 = pb(2)*p(4) - g31 = pb(3)*p(1) - g32 = pb(3)*p(2) - g41 = pb(4)*p(1) - g42 = pb(4)*p(2) - acc(0) = acc(0) + gr*( g13+g24) + gl*( g31+g42) - acc(1) = acc(1) + gr*( g14+g23) - gl*( g32+g41) - acc(2) = acc(2) + (gr*(-g14+g23) + gl*( g32-g41)) * (0,1) - acc(3) = acc(3) + gr*( g13-g24) + gl*(-g31+g42) - end -\nwendcode{}\nwbegindocs{423}Special cases that avoid some multiplications -\nwenddocs{}\nwbegincode{424}\moddef{Implementation of spinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function v_ff (gv, psibar, psi) result (j) - type(vector) :: j - complex(kind=default), intent(in) :: gv - type(conjspinor), intent(in) :: psibar - type(spinor), intent(in) :: psi - complex(kind=default) :: g13, g14, g23, g24, g31, g32, g41, g42 - g13 = psibar%a(1)*psi%a(3) - g14 = psibar%a(1)*psi%a(4) - g23 = psibar%a(2)*psi%a(3) - g24 = psibar%a(2)*psi%a(4) - g31 = psibar%a(3)*psi%a(1) - g32 = psibar%a(3)*psi%a(2) - g41 = psibar%a(4)*psi%a(1) - g42 = psibar%a(4)*psi%a(2) - j%t = gv * ( g13 + g24 + g31 + g42) - j%x(1) = gv * ( g14 + g23 - g32 - g41) - j%x(2) = gv * ( - g14 + g23 + g32 - g41) * (0, 1) - j%x(3) = gv * ( g13 - g24 - g31 + g42) -end function v_ff -\nwendcode{}\nwbegindocs{425}\nwdocspar -\nwenddocs{}\nwbegincode{426}\moddef{Implementation of spinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function a_ff (ga, psibar, psi) result (j) - type(vector) :: j - complex(kind=default), intent(in) :: ga - type(conjspinor), intent(in) :: psibar - type(spinor), intent(in) :: psi - complex(kind=default) :: g13, g14, g23, g24, g31, g32, g41, g42 - g13 = psibar%a(1)*psi%a(3) - g14 = psibar%a(1)*psi%a(4) - g23 = psibar%a(2)*psi%a(3) - g24 = psibar%a(2)*psi%a(4) - g31 = psibar%a(3)*psi%a(1) - g32 = psibar%a(3)*psi%a(2) - g41 = psibar%a(4)*psi%a(1) - g42 = psibar%a(4)*psi%a(2) - j%t = ga * ( - g13 - g24 + g31 + g42) - j%x(1) = - ga * ( g14 + g23 + g32 + g41) - j%x(2) = ga * ( g14 - g23 + g32 - g41) * (0, 1) - j%x(3) = ga * ( - g13 + g24 - g31 + g42) -end function a_ff -\nwendcode{}\nwbegindocs{427}\nwdocspar -\nwenddocs{}\nwbegincode{428}\moddef{Implementation of spinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function vl_ff (gl, psibar, psi) result (j) - type(vector) :: j - complex(kind=default), intent(in) :: gl - type(conjspinor), intent(in) :: psibar - type(spinor), intent(in) :: psi - complex(kind=default) :: gl2 - complex(kind=default) :: g31, g32, g41, g42 - gl2 = 2 * gl - g31 = psibar%a(3)*psi%a(1) - g32 = psibar%a(3)*psi%a(2) - g41 = psibar%a(4)*psi%a(1) - g42 = psibar%a(4)*psi%a(2) - j%t = gl2 * ( g31 + g42) - j%x(1) = - gl2 * ( g32 + g41) - j%x(2) = gl2 * ( g32 - g41) * (0, 1) - j%x(3) = gl2 * ( - g31 + g42) -end function vl_ff -\nwendcode{}\nwbegindocs{429}\nwdocspar -\nwenddocs{}\nwbegincode{430}\moddef{Implementation of spinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function vr_ff (gr, psibar, psi) result (j) - type(vector) :: j - complex(kind=default), intent(in) :: gr - type(conjspinor), intent(in) :: psibar - type(spinor), intent(in) :: psi - complex(kind=default) :: gr2 - complex(kind=default) :: g13, g14, g23, g24 - gr2 = 2 * gr - g13 = psibar%a(1)*psi%a(3) - g14 = psibar%a(1)*psi%a(4) - g23 = psibar%a(2)*psi%a(3) - g24 = psibar%a(2)*psi%a(4) - j%t = gr2 * ( g13 + g24) - j%x(1) = gr2 * ( g14 + g23) - j%x(2) = gr2 * ( - g14 + g23) * (0, 1) - j%x(3) = gr2 * ( g13 - g24) -end function vr_ff -\nwendcode{}\nwbegindocs{431}\nwdocspar -\nwenddocs{}\nwbegincode{432}\moddef{Implementation of spinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function grav_ff (g, m, kb, k, psibar, psi) result (j) - type(tensor) :: j - complex(kind=default), intent(in) :: g - real(kind=default), intent(in) :: m - type(conjspinor), intent(in) :: psibar - type(spinor), intent(in) :: psi - type(momentum), intent(in) :: kb, k - complex(kind=default) :: g2, g8, c_dum - type(vector) :: v_dum - type(tensor) :: t_metric - t_metric%t = 0 - t_metric%t(0,0) = 1.0_default - t_metric%t(1,1) = - 1.0_default - t_metric%t(2,2) = - 1.0_default - t_metric%t(3,3) = - 1.0_default - g2 = g/2.0_default - g8 = g/8.0_default - v_dum = v_ff(g8, psibar, psi) - c_dum = (- m) * s_ff (g2, psibar, psi) - (kb+k)*v_dum - j = c_dum*t_metric - (((kb+k).tprod.v_dum) + & - (v_dum.tprod.(kb+k))) -end function grav_ff -\nwendcode{}\nwbegindocs{433}\nwdocspar -\begin{equation} - g_L\gamma_\mu(1-\gamma_5) + g_R\gamma_\mu(1+\gamma_5) - = (g_L+g_R)\gamma_\mu - (g_L-g_R)\gamma_\mu\gamma_5 - = g_V\gamma_\mu - g_A\gamma_\mu\gamma_5 -\end{equation} -\ldots{} give the compiler the benefit of the doubt that it will -optimize the function all. If not, we could inline it \ldots -\nwenddocs{}\nwbegincode{434}\moddef{Implementation of spinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function vlr_ff (gl, gr, psibar, psi) result (j) - type(vector) :: j - complex(kind=default), intent(in) :: gl, gr - type(conjspinor), intent(in) :: psibar - type(spinor), intent(in) :: psi - j = va_ff (gl+gr, gl-gr, psibar, psi) -end function vlr_ff -\nwendcode{}\nwbegindocs{435}\nwdocspar -and -\begin{equation} - \fmslash{v} - \fmslash{a}\gamma_5 = - \begin{pmatrix} - 0 & 0 & v_- - a_- & - v^* + a^* \\ - 0 & 0 & - v + a & v_+ - a_+ \\ - v_+ + a_+ & v^* + a^* & 0 & 0 \\ - v + a & v_- + a_- & 0 & 0 - \end{pmatrix} -\end{equation} -with $v_\pm=v_0\pm v_3$, $a_\pm=a_0\pm a_3$, $v=v_1+\ii v_2$, -$v^*=v_1-\ii v_2$, $a=a_1+\ii a_2$, and $a^*=a_1-\ii a_2$. But note -that~$\cdot^*$ is \emph{not} complex conjugation for complex~$v_\mu$ -or~$a_\mu$. -\nwenddocs{}\nwbegincode{436}\moddef{Declaration of spinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -public :: f_vaf, f_vf, f_af, f_vlf, f_vrf, f_vlrf -\nwendcode{}\nwbegindocs{437}\nwdocspar -\nwenddocs{}\nwbegincode{438}\moddef{Implementation of spinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function f_vaf (gv, ga, v, psi) result (vpsi) - type(spinor) :: vpsi - complex(kind=default), intent(in) :: gv, ga - type(vector), intent(in) :: v - type(spinor), intent(in) :: psi - complex(kind=default) :: gl, gr - complex(kind=default) :: vp, vm, v12, v12s - gl = gv + ga - gr = gv - ga - vp = v%t + v%x(3) - vm = v%t - v%x(3) - v12 = v%x(1) + (0,1)*v%x(2) - v12s = v%x(1) - (0,1)*v%x(2) - vpsi%a(1) = gr * ( vm * psi%a(3) - v12s * psi%a(4)) - vpsi%a(2) = gr * ( - v12 * psi%a(3) + vp * psi%a(4)) - vpsi%a(3) = gl * ( vp * psi%a(1) + v12s * psi%a(2)) - vpsi%a(4) = gl * ( v12 * psi%a(1) + vm * psi%a(2)) -end function f_vaf -\nwendcode{}\nwbegindocs{439}\nwdocspar -\nwenddocs{}\nwbegincode{440}\moddef{Implementation of spinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function f_vf (gv, v, psi) result (vpsi) - type(spinor) :: vpsi - complex(kind=default), intent(in) :: gv - type(vector), intent(in) :: v - type(spinor), intent(in) :: psi - complex(kind=default) :: vp, vm, v12, v12s - vp = v%t + v%x(3) - vm = v%t - v%x(3) - v12 = v%x(1) + (0,1)*v%x(2) - v12s = v%x(1) - (0,1)*v%x(2) - vpsi%a(1) = gv * ( vm * psi%a(3) - v12s * psi%a(4)) - vpsi%a(2) = gv * ( - v12 * psi%a(3) + vp * psi%a(4)) - vpsi%a(3) = gv * ( vp * psi%a(1) + v12s * psi%a(2)) - vpsi%a(4) = gv * ( v12 * psi%a(1) + vm * psi%a(2)) -end function f_vf -\nwendcode{}\nwbegindocs{441}\nwdocspar -\nwenddocs{}\nwbegincode{442}\moddef{Implementation of spinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function f_af (ga, v, psi) result (vpsi) - type(spinor) :: vpsi - complex(kind=default), intent(in) :: ga - type(vector), intent(in) :: v - type(spinor), intent(in) :: psi - complex(kind=default) :: vp, vm, v12, v12s - vp = v%t + v%x(3) - vm = v%t - v%x(3) - v12 = v%x(1) + (0,1)*v%x(2) - v12s = v%x(1) - (0,1)*v%x(2) - vpsi%a(1) = ga * ( - vm * psi%a(3) + v12s * psi%a(4)) - vpsi%a(2) = ga * ( v12 * psi%a(3) - vp * psi%a(4)) - vpsi%a(3) = ga * ( vp * psi%a(1) + v12s * psi%a(2)) - vpsi%a(4) = ga * ( v12 * psi%a(1) + vm * psi%a(2)) -end function f_af -\nwendcode{}\nwbegindocs{443}\nwdocspar -\nwenddocs{}\nwbegincode{444}\moddef{Implementation of spinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function f_vlf (gl, v, psi) result (vpsi) - type(spinor) :: vpsi - complex(kind=default), intent(in) :: gl - type(vector), intent(in) :: v - type(spinor), intent(in) :: psi - complex(kind=default) :: gl2 - complex(kind=default) :: vp, vm, v12, v12s - gl2 = 2 * gl - vp = v%t + v%x(3) - vm = v%t - v%x(3) - v12 = v%x(1) + (0,1)*v%x(2) - v12s = v%x(1) - (0,1)*v%x(2) - vpsi%a(1) = 0 - vpsi%a(2) = 0 - vpsi%a(3) = gl2 * ( vp * psi%a(1) + v12s * psi%a(2)) - vpsi%a(4) = gl2 * ( v12 * psi%a(1) + vm * psi%a(2)) -end function f_vlf -\nwendcode{}\nwbegindocs{445}\nwdocspar -\nwenddocs{}\nwbegincode{446}\moddef{Implementation of spinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function f_vrf (gr, v, psi) result (vpsi) - type(spinor) :: vpsi - complex(kind=default), intent(in) :: gr - type(vector), intent(in) :: v - type(spinor), intent(in) :: psi - complex(kind=default) :: gr2 - complex(kind=default) :: vp, vm, v12, v12s - gr2 = 2 * gr - vp = v%t + v%x(3) - vm = v%t - v%x(3) - v12 = v%x(1) + (0,1)*v%x(2) - v12s = v%x(1) - (0,1)*v%x(2) - vpsi%a(1) = gr2 * ( vm * psi%a(3) - v12s * psi%a(4)) - vpsi%a(2) = gr2 * ( - v12 * psi%a(3) + vp * psi%a(4)) - vpsi%a(3) = 0 - vpsi%a(4) = 0 -end function f_vrf -\nwendcode{}\nwbegindocs{447}\nwdocspar -\nwenddocs{}\nwbegincode{448}\moddef{Implementation of spinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function f_vlrf (gl, gr, v, psi) result (vpsi) - type(spinor) :: vpsi - complex(kind=default), intent(in) :: gl, gr - type(vector), intent(in) :: v - type(spinor), intent(in) :: psi - vpsi = f_vaf (gl+gr, gl-gr, v, psi) -end function f_vlrf -\nwendcode{}\nwbegindocs{449}\nwdocspar -\nwenddocs{}\nwbegincode{450}\moddef{Declaration of spinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -public :: f_fva, f_fv, f_fa, f_fvl, f_fvr, f_fvlr -\nwendcode{}\nwbegindocs{451}\nwdocspar -\nwenddocs{}\nwbegincode{452}\moddef{Implementation of spinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function f_fva (gv, ga, psibar, v) result (psibarv) - type(conjspinor) :: psibarv - complex(kind=default), intent(in) :: gv, ga - type(conjspinor), intent(in) :: psibar - type(vector), intent(in) :: v - complex(kind=default) :: gl, gr - complex(kind=default) :: vp, vm, v12, v12s - gl = gv + ga - gr = gv - ga - vp = v%t + v%x(3) - vm = v%t - v%x(3) - v12 = v%x(1) + (0,1)*v%x(2) - v12s = v%x(1) - (0,1)*v%x(2) - psibarv%a(1) = gl * ( psibar%a(3) * vp + psibar%a(4) * v12) - psibarv%a(2) = gl * ( psibar%a(3) * v12s + psibar%a(4) * vm ) - psibarv%a(3) = gr * ( psibar%a(1) * vm - psibar%a(2) * v12) - psibarv%a(4) = gr * ( - psibar%a(1) * v12s + psibar%a(2) * vp ) -end function f_fva -\nwendcode{}\nwbegindocs{453}\nwdocspar -\nwenddocs{}\nwbegincode{454}\moddef{Implementation of spinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function f_fv (gv, psibar, v) result (psibarv) - type(conjspinor) :: psibarv - complex(kind=default), intent(in) :: gv - type(conjspinor), intent(in) :: psibar - type(vector), intent(in) :: v - complex(kind=default) :: vp, vm, v12, v12s - vp = v%t + v%x(3) - vm = v%t - v%x(3) - v12 = v%x(1) + (0,1)*v%x(2) - v12s = v%x(1) - (0,1)*v%x(2) - psibarv%a(1) = gv * ( psibar%a(3) * vp + psibar%a(4) * v12) - psibarv%a(2) = gv * ( psibar%a(3) * v12s + psibar%a(4) * vm ) - psibarv%a(3) = gv * ( psibar%a(1) * vm - psibar%a(2) * v12) - psibarv%a(4) = gv * ( - psibar%a(1) * v12s + psibar%a(2) * vp ) -end function f_fv -\nwendcode{}\nwbegindocs{455}\nwdocspar -\nwenddocs{}\nwbegincode{456}\moddef{Implementation of spinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function f_fa (ga, psibar, v) result (psibarv) - type(conjspinor) :: psibarv - complex(kind=default), intent(in) :: ga - type(vector), intent(in) :: v - type(conjspinor), intent(in) :: psibar - complex(kind=default) :: vp, vm, v12, v12s - vp = v%t + v%x(3) - vm = v%t - v%x(3) - v12 = v%x(1) + (0,1)*v%x(2) - v12s = v%x(1) - (0,1)*v%x(2) - psibarv%a(1) = ga * ( psibar%a(3) * vp + psibar%a(4) * v12) - psibarv%a(2) = ga * ( psibar%a(3) * v12s + psibar%a(4) * vm ) - psibarv%a(3) = ga * ( - psibar%a(1) * vm + psibar%a(2) * v12) - psibarv%a(4) = ga * ( psibar%a(1) * v12s - psibar%a(2) * vp ) -end function f_fa -\nwendcode{}\nwbegindocs{457}\nwdocspar -\nwenddocs{}\nwbegincode{458}\moddef{Implementation of spinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function f_fvl (gl, psibar, v) result (psibarv) - type(conjspinor) :: psibarv - complex(kind=default), intent(in) :: gl - type(conjspinor), intent(in) :: psibar - type(vector), intent(in) :: v - complex(kind=default) :: gl2 - complex(kind=default) :: vp, vm, v12, v12s - gl2 = 2 * gl - vp = v%t + v%x(3) - vm = v%t - v%x(3) - v12 = v%x(1) + (0,1)*v%x(2) - v12s = v%x(1) - (0,1)*v%x(2) - psibarv%a(1) = gl2 * ( psibar%a(3) * vp + psibar%a(4) * v12) - psibarv%a(2) = gl2 * ( psibar%a(3) * v12s + psibar%a(4) * vm ) - psibarv%a(3) = 0 - psibarv%a(4) = 0 -end function f_fvl -\nwendcode{}\nwbegindocs{459}\nwdocspar -\nwenddocs{}\nwbegincode{460}\moddef{Implementation of spinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function f_fvr (gr, psibar, v) result (psibarv) - type(conjspinor) :: psibarv - complex(kind=default), intent(in) :: gr - type(conjspinor), intent(in) :: psibar - type(vector), intent(in) :: v - complex(kind=default) :: gr2 - complex(kind=default) :: vp, vm, v12, v12s - gr2 = 2 * gr - vp = v%t + v%x(3) - vm = v%t - v%x(3) - v12 = v%x(1) + (0,1)*v%x(2) - v12s = v%x(1) - (0,1)*v%x(2) - psibarv%a(1) = 0 - psibarv%a(2) = 0 - psibarv%a(3) = gr2 * ( psibar%a(1) * vm - psibar%a(2) * v12) - psibarv%a(4) = gr2 * ( - psibar%a(1) * v12s + psibar%a(2) * vp ) -end function f_fvr -\nwendcode{}\nwbegindocs{461}\nwdocspar -\nwenddocs{}\nwbegincode{462}\moddef{Implementation of spinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function f_fvlr (gl, gr, psibar, v) result (psibarv) - type(conjspinor) :: psibarv - complex(kind=default), intent(in) :: gl, gr - type(conjspinor), intent(in) :: psibar - type(vector), intent(in) :: v - psibarv = f_fva (gl+gr, gl-gr, psibar, v) -end function f_fvlr -\nwendcode{}\nwbegindocs{463}\subsection{Fermionic Scalar and Pseudo Scalar Couplings} -\nwenddocs{}\nwbegincode{464}\moddef{Declaration of spinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -public :: sp_ff, s_ff, p_ff, sl_ff, sr_ff, slr_ff -\nwendcode{}\nwbegindocs{465}\nwdocspar -\nwenddocs{}\nwbegincode{466}\moddef{Implementation of spinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function sp_ff (gs, gp, psibar, psi) result (j) - complex(kind=default) :: j - complex(kind=default), intent(in) :: gs, gp - type(conjspinor), intent(in) :: psibar - type(spinor), intent(in) :: psi - j = (gs - gp) * (psibar%a(1)*psi%a(1) + psibar%a(2)*psi%a(2)) & - + (gs + gp) * (psibar%a(3)*psi%a(3) + psibar%a(4)*psi%a(4)) -end function sp_ff -\nwendcode{}\nwbegindocs{467}\nwdocspar -\nwenddocs{}\nwbegincode{468}\moddef{Implementation of spinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function s_ff (gs, psibar, psi) result (j) - complex(kind=default) :: j - complex(kind=default), intent(in) :: gs - type(conjspinor), intent(in) :: psibar - type(spinor), intent(in) :: psi - j = gs * (psibar * psi) -end function s_ff -\nwendcode{}\nwbegindocs{469}\nwdocspar -\nwenddocs{}\nwbegincode{470}\moddef{Implementation of spinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function p_ff (gp, psibar, psi) result (j) - complex(kind=default) :: j - complex(kind=default), intent(in) :: gp - type(conjspinor), intent(in) :: psibar - type(spinor), intent(in) :: psi - j = gp * ( psibar%a(3)*psi%a(3) + psibar%a(4)*psi%a(4) & - - psibar%a(1)*psi%a(1) - psibar%a(2)*psi%a(2)) -end function p_ff -\nwendcode{}\nwbegindocs{471}\nwdocspar -\nwenddocs{}\nwbegincode{472}\moddef{Implementation of spinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function sl_ff (gl, psibar, psi) result (j) - complex(kind=default) :: j - complex(kind=default), intent(in) :: gl - type(conjspinor), intent(in) :: psibar - type(spinor), intent(in) :: psi - j = 2 * gl * (psibar%a(1)*psi%a(1) + psibar%a(2)*psi%a(2)) -end function sl_ff -\nwendcode{}\nwbegindocs{473}\nwdocspar -\nwenddocs{}\nwbegincode{474}\moddef{Implementation of spinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function sr_ff (gr, psibar, psi) result (j) - complex(kind=default) :: j - complex(kind=default), intent(in) :: gr - type(conjspinor), intent(in) :: psibar - type(spinor), intent(in) :: psi - j = 2 * gr * (psibar%a(3)*psi%a(3) + psibar%a(4)*psi%a(4)) -end function sr_ff -\nwendcode{}\nwbegindocs{475}\nwdocspar -\begin{equation} - g_L(1-\gamma_5) + g_R(1+\gamma_5) - = (g_R+g_L) + (g_R-g_L)\gamma_5 - = g_S + g_P\gamma_5 -\end{equation} -\nwenddocs{}\nwbegincode{476}\moddef{Implementation of spinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function slr_ff (gl, gr, psibar, psi) result (j) - complex(kind=default) :: j - complex(kind=default), intent(in) :: gl, gr - type(conjspinor), intent(in) :: psibar - type(spinor), intent(in) :: psi - j = sp_ff (gr+gl, gr-gl, psibar, psi) -end function slr_ff -\nwendcode{}\nwbegindocs{477}\nwdocspar -\nwenddocs{}\nwbegincode{478}\moddef{Declaration of spinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -public :: f_spf, f_sf, f_pf, f_slf, f_srf, f_slrf -\nwendcode{}\nwbegindocs{479}\nwdocspar -\nwenddocs{}\nwbegincode{480}\moddef{Implementation of spinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function f_spf (gs, gp, phi, psi) result (phipsi) - type(spinor) :: phipsi - complex(kind=default), intent(in) :: gs, gp - complex(kind=default), intent(in) :: phi - type(spinor), intent(in) :: psi - phipsi%a(1:2) = ((gs - gp) * phi) * psi%a(1:2) - phipsi%a(3:4) = ((gs + gp) * phi) * psi%a(3:4) -end function f_spf -\nwendcode{}\nwbegindocs{481}\nwdocspar -\nwenddocs{}\nwbegincode{482}\moddef{Implementation of spinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function f_sf (gs, phi, psi) result (phipsi) - type(spinor) :: phipsi - complex(kind=default), intent(in) :: gs - complex(kind=default), intent(in) :: phi - type(spinor), intent(in) :: psi - phipsi%a = (gs * phi) * psi%a -end function f_sf -\nwendcode{}\nwbegindocs{483}\nwdocspar -\nwenddocs{}\nwbegincode{484}\moddef{Implementation of spinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function f_pf (gp, phi, psi) result (phipsi) - type(spinor) :: phipsi - complex(kind=default), intent(in) :: gp - complex(kind=default), intent(in) :: phi - type(spinor), intent(in) :: psi - phipsi%a(1:2) = (- gp * phi) * psi%a(1:2) - phipsi%a(3:4) = ( gp * phi) * psi%a(3:4) -end function f_pf -\nwendcode{}\nwbegindocs{485}\nwdocspar -\nwenddocs{}\nwbegincode{486}\moddef{Implementation of spinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function f_slf (gl, phi, psi) result (phipsi) - type(spinor) :: phipsi - complex(kind=default), intent(in) :: gl - complex(kind=default), intent(in) :: phi - type(spinor), intent(in) :: psi - phipsi%a(1:2) = (2 * gl * phi) * psi%a(1:2) - phipsi%a(3:4) = 0 -end function f_slf -\nwendcode{}\nwbegindocs{487}\nwdocspar -\nwenddocs{}\nwbegincode{488}\moddef{Implementation of spinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function f_srf (gr, phi, psi) result (phipsi) - type(spinor) :: phipsi - complex(kind=default), intent(in) :: gr - complex(kind=default), intent(in) :: phi - type(spinor), intent(in) :: psi - phipsi%a(1:2) = 0 - phipsi%a(3:4) = (2 * gr * phi) * psi%a(3:4) -end function f_srf -\nwendcode{}\nwbegindocs{489}\nwdocspar -\nwenddocs{}\nwbegincode{490}\moddef{Implementation of spinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function f_slrf (gl, gr, phi, psi) result (phipsi) - type(spinor) :: phipsi - complex(kind=default), intent(in) :: gl, gr - complex(kind=default), intent(in) :: phi - type(spinor), intent(in) :: psi - phipsi = f_spf (gr+gl, gr-gl, phi, psi) -end function f_slrf -\nwendcode{}\nwbegindocs{491}\nwdocspar -\nwenddocs{}\nwbegincode{492}\moddef{Declaration of spinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -public :: f_fsp, f_fs, f_fp, f_fsl, f_fsr, f_fslr -\nwendcode{}\nwbegindocs{493}\nwdocspar -\nwenddocs{}\nwbegincode{494}\moddef{Implementation of spinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function f_fsp (gs, gp, psibar, phi) result (psibarphi) - type(conjspinor) :: psibarphi - complex(kind=default), intent(in) :: gs, gp - type(conjspinor), intent(in) :: psibar - complex(kind=default), intent(in) :: phi - psibarphi%a(1:2) = ((gs - gp) * phi) * psibar%a(1:2) - psibarphi%a(3:4) = ((gs + gp) * phi) * psibar%a(3:4) -end function f_fsp -\nwendcode{}\nwbegindocs{495}\nwdocspar -\nwenddocs{}\nwbegincode{496}\moddef{Implementation of spinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function f_fs (gs, psibar, phi) result (psibarphi) - type(conjspinor) :: psibarphi - complex(kind=default), intent(in) :: gs - type(conjspinor), intent(in) :: psibar - complex(kind=default), intent(in) :: phi - psibarphi%a = (gs * phi) * psibar%a -end function f_fs -\nwendcode{}\nwbegindocs{497}\nwdocspar -\nwenddocs{}\nwbegincode{498}\moddef{Implementation of spinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function f_fp (gp, psibar, phi) result (psibarphi) - type(conjspinor) :: psibarphi - complex(kind=default), intent(in) :: gp - type(conjspinor), intent(in) :: psibar - complex(kind=default), intent(in) :: phi - psibarphi%a(1:2) = (- gp * phi) * psibar%a(1:2) - psibarphi%a(3:4) = ( gp * phi) * psibar%a(3:4) -end function f_fp -\nwendcode{}\nwbegindocs{499}\nwdocspar -\nwenddocs{}\nwbegincode{500}\moddef{Implementation of spinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function f_fsl (gl, psibar, phi) result (psibarphi) - type(conjspinor) :: psibarphi - complex(kind=default), intent(in) :: gl - type(conjspinor), intent(in) :: psibar - complex(kind=default), intent(in) :: phi - psibarphi%a(1:2) = (2 * gl * phi) * psibar%a(1:2) - psibarphi%a(3:4) = 0 -end function f_fsl -\nwendcode{}\nwbegindocs{501}\nwdocspar -\nwenddocs{}\nwbegincode{502}\moddef{Implementation of spinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function f_fsr (gr, psibar, phi) result (psibarphi) - type(conjspinor) :: psibarphi - complex(kind=default), intent(in) :: gr - type(conjspinor), intent(in) :: psibar - complex(kind=default), intent(in) :: phi - psibarphi%a(1:2) = 0 - psibarphi%a(3:4) = (2 * gr * phi) * psibar%a(3:4) -end function f_fsr -\nwendcode{}\nwbegindocs{503}\nwdocspar -\nwenddocs{}\nwbegincode{504}\moddef{Implementation of spinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function f_fslr (gl, gr, psibar, phi) result (psibarphi) - type(conjspinor) :: psibarphi - complex(kind=default), intent(in) :: gl, gr - type(conjspinor), intent(in) :: psibar - complex(kind=default), intent(in) :: phi - psibarphi = f_fsp (gr+gl, gr-gl, psibar, phi) -end function f_fslr -\nwendcode{}\nwbegincode{505}\moddef{Declaration of spinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -public :: f_gravf, f_fgrav -\nwendcode{}\nwbegindocs{506}\nwdocspar -\nwenddocs{}\nwbegincode{507}\moddef{Implementation of spinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function f_gravf (g, m, kb, k, t, psi) result (tpsi) - type(spinor) :: tpsi - complex(kind=default), intent(in) :: g - real(kind=default), intent(in) :: m - type(spinor), intent(in) :: psi - type(tensor), intent(in) :: t - type(momentum), intent(in) :: kb, k - complex(kind=default) :: g2, g8, t_tr - type(vector) :: kkb - kkb = k + kb - g2 = g / 2.0_default - g8 = g / 8.0_default - t_tr = t%t(0,0) - t%t(1,1) - t%t(2,2) - t%t(3,3) - tpsi = (- f_sf (g2, cmplx (m,0.0, kind=default), psi) & - - f_vf ((g8*m), kkb, psi)) * t_tr - & - f_vf (g8,(t*kkb + kkb*t),psi) -end function f_gravf -\nwendcode{}\nwbegindocs{508}\nwdocspar -\nwenddocs{}\nwbegincode{509}\moddef{Implementation of spinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function f_fgrav (g, m, kb, k, psibar, t) result (psibart) - type(conjspinor) :: psibart - complex(kind=default), intent(in) :: g - real(kind=default), intent(in) :: m - type(conjspinor), intent(in) :: psibar - type(tensor), intent(in) :: t - type(momentum), intent(in) :: kb, k - type(vector) :: kkb - complex(kind=default) :: g2, g8, t_tr - kkb = k + kb - g2 = g / 2.0_default - g8 = g / 8.0_default - t_tr = t%t(0,0) - t%t(1,1) - t%t(2,2) - t%t(3,3) - psibart = (- f_fs (g2, psibar, cmplx (m, 0.0, kind=default)) & - - f_fv ((g8 * m), psibar, kkb)) * t_tr - & - f_fv (g8,psibar,(t*kkb + kkb*t)) -end function f_fgrav -\nwendcode{}\nwbegindocs{510}\subsection{On Shell Wave Functions} -\nwenddocs{}\nwbegincode{511}\moddef{Declaration of spinor on shell wave functions}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -public :: u, ubar, v, vbar -private :: chi_plus, chi_minus -\nwendcode{}\nwbegindocs{512}\nwdocspar -\begin{subequations} -\begin{align} - \chi_+(\vec p) &= - \frac{1}{\sqrt{2|\vec p|(|\vec p|+p_3)}} - \begin{pmatrix} |\vec p|+p_3 \\ p_1 + \ii p_2 \end{pmatrix} \\ - \chi_-(\vec p) &= - \frac{1}{\sqrt{2|\vec p|(|\vec p|+p_3)}} - \begin{pmatrix} - p_1 + \ii p_2 \\ |\vec p|+p_3 \end{pmatrix} -\end{align} -\end{subequations} -\nwenddocs{}\nwbegincode{513}\moddef{Implementation of spinor on shell wave functions}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function chi_plus (p) result (chi) - complex(kind=default), dimension(2) :: chi - type(momentum), intent(in) :: p - real(kind=default) :: pabs - pabs = sqrt (dot_product (p%x, p%x)) - if (pabs + p%x(3) <= 1000 * epsilon (pabs) * pabs) then -!!! OLD VERSION !!!!!! -!!! if (1 + p%x(3) / pabs <= epsilon (pabs)) then -!!!!!!!!!!!!!!!!!!!!!! - chi = (/ cmplx ( 0.0, 0.0, kind=default), & - cmplx ( 1.0, 0.0, kind=default) /) - else - chi = 1 / sqrt (2*pabs*(pabs + p%x(3))) & - * (/ cmplx (pabs + p%x(3), kind=default), & - cmplx (p%x(1), p%x(2), kind=default) /) - end if -end function chi_plus -\nwendcode{}\nwbegindocs{514}\nwdocspar -\nwenddocs{}\nwbegincode{515}\moddef{Implementation of spinor on shell wave functions}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function chi_minus (p) result (chi) - complex(kind=default), dimension(2) :: chi - type(momentum), intent(in) :: p - real(kind=default) :: pabs - pabs = sqrt (dot_product (p%x, p%x)) - if (pabs + p%x(3) <= 1000 * epsilon (pabs) * pabs) then -!!! OLD VERSION !!!!!!!!!!! -!!! if (1 + p%x(3) / pabs <= epsilon (pabs)) then -!!!!!!!!!!!!!!!!!!!!!!!!!!! - chi = (/ cmplx (-1.0, 0.0, kind=default), & - cmplx ( 0.0, 0.0, kind=default) /) - else - chi = 1 / sqrt (2*pabs*(pabs + p%x(3))) & - * (/ cmplx (-p%x(1), p%x(2), kind=default), & - cmplx (pabs + p%x(3), kind=default) /) - end if -end function chi_minus -\nwendcode{}\nwbegindocs{516}\nwdocspar -\begin{equation} - u_\pm(p) = - \begin{pmatrix} - \sqrt{p_0\mp|\vec p|} \cdot \chi_\pm(\vec p) \\ - \sqrt{p_0\pm|\vec p|} \cdot \chi_\pm(\vec p) - \end{pmatrix} -\end{equation} -Determining the mass from the momenta is a numerically haphazardous for -light particles. Therefore, we accept some redundancy and pass the -mass explicitely. Even if the mass is not used in the chiral -representation, we do so for symmetry with polarization vectors and to -be prepared for other representations. -\nwenddocs{}\nwbegincode{517}\moddef{Implementation of spinor on shell wave functions}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function u (m, p, s) result (psi) - type(spinor) :: psi - real(kind=default), intent(in) :: m - type(momentum), intent(in) :: p - integer, intent(in) :: s - complex(kind=default), dimension(2) :: chi - real(kind=default) :: pabs - pabs = sqrt (dot_product (p%x, p%x)) - select case (s) - case (1) - chi = chi_plus (p) - psi%a(1:2) = sqrt (max (p%t - pabs, 0.0_default)) * chi - psi%a(3:4) = sqrt (p%t + pabs) * chi - case (-1) - chi = chi_minus (p) - psi%a(1:2) = sqrt (p%t + pabs) * chi - psi%a(3:4) = sqrt (max (p%t - pabs, 0.0_default)) * chi - case default - pabs = m ! make the compiler happy and use m - psi%a = 0 - end select -end function u -\nwendcode{}\nwbegindocs{518}\nwdocspar -\nwenddocs{}\nwbegincode{519}\moddef{Implementation of spinor on shell wave functions}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function ubar (m, p, s) result (psibar) - type(conjspinor) :: psibar - real(kind=default), intent(in) :: m - type(momentum), intent(in) :: p - integer, intent(in) :: s - type(spinor) :: psi - psi = u (m, p, s) - psibar%a(1:2) = conjg (psi%a(3:4)) - psibar%a(3:4) = conjg (psi%a(1:2)) -end function ubar -\nwendcode{}\nwbegindocs{520}\nwdocspar -\begin{equation} - v_\pm(p) = - \begin{pmatrix} - \mp\sqrt{p_0\pm|\vec p|} \cdot \chi_\mp(\vec p) \\ - \pm\sqrt{p_0\mp|\vec p|} \cdot \chi_\mp(\vec p) - \end{pmatrix} -\end{equation} -\nwenddocs{}\nwbegincode{521}\moddef{Implementation of spinor on shell wave functions}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function v (m, p, s) result (psi) - type(spinor) :: psi - real(kind=default), intent(in) :: m - type(momentum), intent(in) :: p - integer, intent(in) :: s - complex(kind=default), dimension(2) :: chi - real(kind=default) :: pabs - pabs = sqrt (dot_product (p%x, p%x)) - select case (s) - case (1) - chi = chi_minus (p) - psi%a(1:2) = - sqrt (p%t + pabs) * chi - psi%a(3:4) = sqrt (max (p%t - pabs, 0.0_default)) * chi - case (-1) - chi = chi_plus (p) - psi%a(1:2) = sqrt (max (p%t - pabs, 0.0_default)) * chi - psi%a(3:4) = - sqrt (p%t + pabs) * chi - case default - pabs = m ! make the compiler happy and use m - psi%a = 0 - end select -end function v -\nwendcode{}\nwbegindocs{522}\nwdocspar -\nwenddocs{}\nwbegincode{523}\moddef{Implementation of spinor on shell wave functions}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function vbar (m, p, s) result (psibar) - type(conjspinor) :: psibar - real(kind=default), intent(in) :: m - type(momentum), intent(in) :: p - integer, intent(in) :: s - type(spinor) :: psi - psi = v (m, p, s) - psibar%a(1:2) = conjg (psi%a(3:4)) - psibar%a(3:4) = conjg (psi%a(1:2)) -end function vbar -\nwendcode{}\nwbegindocs{524}\nwdocspar -\subsection{Off Shell Wave Functions} -I've just taken this over from Christian Schwinn's version. -\nwenddocs{}\nwbegincode{525}\moddef{Declaration of spinor off shell wave functions}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -public :: brs_u, brs_ubar, brs_v, brs_vbar -\nwendcode{}\nwbegindocs{526}\nwdocspar -The off-shell wave functions needed for gauge checking are obtained from the LSZ-formulas: -\begin{subequations} -\begin{align} -\Braket{\text{Out}|d^\dagger|\text{In}}&=i\int d^4x \bar v -e^{-ikx}(i\fmslash\partial-m)\Braket{\text{Out}|\psi|\text{In}}\\ -\Braket{\text{Out}|b|\text{In}}&=-i\int d^4x \bar u -e^{ikx}(i\fmslash\partial-m)\Braket{\text{Out}|\psi|\text{In}}\\ -\Braket{\text{Out}|d|\text{In}}&= - i\int d^4x \Braket{\text{Out}|\bar \psi| - \text{In}}(-i\fmslash{\overleftarrow\partial}-m)v e^{ikx}\\ -\Braket{\text{Out}|b^\dagger|\text{In}}&= - -i\int d^4x \Braket{\text{Out}|\bar \psi| - \text{In}}(-i\fmslash{\overleftarrow\partial}-m)u e^{-ikx} -\end{align} -\end{subequations} -Since the relative sign between fermions and antifermions is ignored for -on-shell amplitudes we must also ignore it here, so all wavefunctions must -have a $(-i)$ factor. -In momentum space we have: -\begin{equation} -brs u(p)=(-i) (\fmslash p-m)u(p) -\end{equation} -\nwenddocs{}\nwbegincode{527}\moddef{Implementation of spinor off shell wave functions}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function brs_u (m, p, s) result (dpsi) - type(spinor) :: dpsi,psi - real(kind=default), intent(in) :: m - type(momentum), intent(in) :: p - integer, intent(in) :: s - type (vector)::vp - complex(kind=default), parameter :: one = (1, 0) - vp=p - psi=u(m,p,s) - dpsi=cmplx(0.0,-1.0)*(f_vf(one,vp,psi)-m*psi) -end function brs_u -\nwendcode{}\nwbegindocs{528}\nwdocspar -\begin{equation} -brs v(p)=i (\fmslash p+m)v(p) -\end{equation} -\nwenddocs{}\nwbegincode{529}\moddef{Implementation of spinor off shell wave functions}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function brs_v (m, p, s) result (dpsi) - type(spinor) :: dpsi, psi - real(kind=default), intent(in) :: m - type(momentum), intent(in) :: p - integer, intent(in) :: s - type (vector)::vp - complex(kind=default), parameter :: one = (1, 0) - vp=p - psi=v(m,p,s) - dpsi=cmplx(0.0,1.0)*(f_vf(one,vp,psi)+m*psi) -end function brs_v -\nwendcode{}\nwbegindocs{530}\nwdocspar -\begin{equation} -brs \bar{u}(p)=(-i)\bar u(p)(\fmslash p-m) -\end{equation} -\nwenddocs{}\nwbegincode{531}\moddef{Implementation of spinor off shell wave functions}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup - pure function brs_ubar (m, p, s)result (dpsibar) - type(conjspinor) :: dpsibar, psibar - real(kind=default), intent(in) :: m - type(momentum), intent(in) :: p - integer, intent(in) :: s - type (vector)::vp - complex(kind=default), parameter :: one = (1, 0) - vp=p - psibar=ubar(m,p,s) - dpsibar=cmplx(0.0,-1.0)*(f_fv(one,psibar,vp)-m*psibar) - end function brs_ubar -\nwendcode{}\nwbegindocs{532}\nwdocspar -\begin{equation} -brs \bar{v}(p)=(i)\bar v(p)(\fmslash p+m) -\end{equation} -\nwenddocs{}\nwbegincode{533}\moddef{Implementation of spinor off shell wave functions}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup - pure function brs_vbar (m, p, s) result (dpsibar) - type(conjspinor) :: dpsibar,psibar - real(kind=default), intent(in) :: m - type(momentum), intent(in) :: p - integer, intent(in) :: s - type(vector)::vp - complex(kind=default), parameter :: one = (1, 0) - vp=p - psibar=vbar(m,p,s) - dpsibar=cmplx(0.0,1.0)*(f_fv(one,psibar,vp)+m*psibar) -end function brs_vbar -\nwendcode{}\nwbegindocs{534}\nwdocspar -NB: The remarks on momentum flow in the propagators don't apply -here since the incoming momenta are flipped for the wave functions. -\nwenddocs{}\nwbegindocs{535}\subsection{Propagators} -NB: the common factor of~$\ii$ is extracted: -\nwenddocs{}\nwbegincode{536}\moddef{Declaration of spinor propagators}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -public :: pr_psi, pr_psibar -public :: pj_psi, pj_psibar -public :: pg_psi, pg_psibar -\nwendcode{}\nwbegindocs{537}\nwdocspar -\begin{equation} - \frac{i(-\fmslash{p}+m)}{p^2-m^2+\ii m\Gamma}\psi -\end{equation} -NB: the sign of the momentum comes about because all momenta are -treated as \emph{outgoing} and the particle charge flow is therefore -opposite to the momentum. -\nwenddocs{}\nwbegincode{538}\moddef{Implementation of spinor propagators}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function pr_psi (p, m, w, psi) result (ppsi) - type(spinor) :: ppsi - type(momentum), intent(in) :: p - real(kind=default), intent(in) :: m, w - type(spinor), intent(in) :: psi - type(vector) :: vp - complex(kind=default), parameter :: one = (1, 0) - vp = p - ppsi = (1 / cmplx (p*p - m**2, m*w, kind=default)) & - * (- f_vf (one, vp, psi) + m * psi) -end function pr_psi -\nwendcode{}\nwbegindocs{539}\nwdocspar -\begin{equation} - \sqrt{\frac{\pi}{M\Gamma}} - (-\fmslash{p}+m)\psi -\end{equation} -\nwenddocs{}\nwbegincode{540}\moddef{Implementation of spinor propagators}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function pj_psi (p, m, w, psi) result (ppsi) - type(spinor) :: ppsi - type(momentum), intent(in) :: p - real(kind=default), intent(in) :: m, w - type(spinor), intent(in) :: psi - type(vector) :: vp - complex(kind=default), parameter :: one = (1, 0) - vp = p - ppsi = (0, -1) * sqrt (PI / m / w) * (- f_vf (one, vp, psi) + m * psi) -end function pj_psi -\nwendcode{}\nwbegindocs{541}\nwdocspar -\nwenddocs{}\nwbegincode{542}\moddef{Implementation of spinor propagators}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function pg_psi (p, m, w, psi) result (ppsi) - type(spinor) :: ppsi - type(momentum), intent(in) :: p - real(kind=default), intent(in) :: m, w - type(spinor), intent(in) :: psi - type(vector) :: vp - complex(kind=default), parameter :: one = (1, 0) - vp = p - ppsi = gauss(p*p, m, w) * (- f_vf (one, vp, psi) + m * psi) -end function pg_psi -\nwendcode{}\nwbegindocs{543}\nwdocspar -\begin{equation} - \bar\psi \frac{i(\fmslash{p}+m)}{p^2-m^2+\ii m\Gamma} -\end{equation} -NB: the sign of the momentum comes about because all momenta are -treated as \emph{outgoing} and the antiparticle charge flow is -therefore parallel to the momentum. -\nwenddocs{}\nwbegincode{544}\moddef{Implementation of spinor propagators}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function pr_psibar (p, m, w, psibar) result (ppsibar) - type(conjspinor) :: ppsibar - type(momentum), intent(in) :: p - real(kind=default), intent(in) :: m, w - type(conjspinor), intent(in) :: psibar - type(vector) :: vp - complex(kind=default), parameter :: one = (1, 0) - vp = p - ppsibar = (1 / cmplx (p*p - m**2, m*w, kind=default)) & - * (f_fv (one, psibar, vp) + m * psibar) -end function pr_psibar -\nwendcode{}\nwbegindocs{545}\nwdocspar -\begin{equation} - \sqrt{\frac{\pi}{M\Gamma}} - \bar\psi (\fmslash{p}+m) -\end{equation} -NB: the sign of the momentum comes about because all momenta are -treated as \emph{outgoing} and the antiparticle charge flow is -therefore parallel to the momentum. -\nwenddocs{}\nwbegincode{546}\moddef{Implementation of spinor propagators}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function pj_psibar (p, m, w, psibar) result (ppsibar) - type(conjspinor) :: ppsibar - type(momentum), intent(in) :: p - real(kind=default), intent(in) :: m, w - type(conjspinor), intent(in) :: psibar - type(vector) :: vp - complex(kind=default), parameter :: one = (1, 0) - vp = p - ppsibar = (0, -1) * sqrt (PI / m / w) * (f_fv (one, psibar, vp) + m * psibar) -end function pj_psibar -\nwendcode{}\nwbegindocs{547}\nwdocspar -\nwenddocs{}\nwbegincode{548}\moddef{Implementation of spinor propagators}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function pg_psibar (p, m, w, psibar) result (ppsibar) - type(conjspinor) :: ppsibar - type(momentum), intent(in) :: p - real(kind=default), intent(in) :: m, w - type(conjspinor), intent(in) :: psibar - type(vector) :: vp - complex(kind=default), parameter :: one = (1, 0) - vp = p - ppsibar = gauss (p*p, m, w) * (f_fv (one, psibar, vp) + m * psibar) -end function pg_psibar -\nwendcode{}\nwbegindocs{549}\nwdocspar -\begin{equation} - \frac{i(-\fmslash{p}+m)}{p^2-m^2+\ii m\Gamma} \sum_n \psi_n\otimes\bar\psi_n -\end{equation} -NB: the temporary variables {\Tt{}psi(1:4)\nwendquote} are not nice, but the compilers -should be able to optimize the unnecessary copies away. In any case, even -if the copies are performed, they are (probably) negligible compared to the -floating point multiplications anyway \ldots -\nwenddocs{}\nwbegincode{550}\moddef{(Not used yet) Declaration of operations for spinors}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -type, public :: spinordyad - ! private (omegalib needs access, but DON'T TOUCH IT!) - complex(kind=default), dimension(4,4) :: a -end type spinordyad -\nwendcode{}\nwbegindocs{551}\nwdocspar -\nwenddocs{}\nwbegincode{552}\moddef{(Not used yet) Implementation of spinor propagators}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function pr_dyadleft (p, m, w, psipsibar) result (psipsibarp) - type(spinordyad) :: psipsibarp - type(momentum), intent(in) :: p - real(kind=default), intent(in) :: m, w - type(spinordyad), intent(in) :: psipsibar - integer :: i - type(vector) :: vp - type(spinor), dimension(4) :: psi - complex(kind=default) :: pole - complex(kind=default), parameter :: one = (1, 0) - vp = p - pole = 1 / cmplx (p*p - m**2, m*w, kind=default) - do i = 1, 4 - psi(i)%a = psipsibar%a(:,i) - psi(i) = pole * (- f_vf (one, vp, psi(i)) + m * psi(i)) - psipsibarp%a(:,i) = psi(i)%a - end do -end function pr_dyadleft -\nwendcode{}\nwbegindocs{553}\nwdocspar -\begin{equation} - \sum_n \psi_n\otimes\bar\psi_n \frac{i(\fmslash{p}+m)}{p^2-m^2+\ii m\Gamma} -\end{equation} -\nwenddocs{}\nwbegincode{554}\moddef{(Not used yet) Implementation of spinor propagators}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function pr_dyadright (p, m, w, psipsibar) result (psipsibarp) - type(spinordyad) :: psipsibarp - type(momentum), intent(in) :: p - real(kind=default), intent(in) :: m, w - type(spinordyad), intent(in) :: psipsibar - integer :: i - type(vector) :: vp - type(conjspinor), dimension(4) :: psibar - complex(kind=default) :: pole - complex(kind=default), parameter :: one = (1, 0) - vp = p - pole = 1 / cmplx (p*p - m**2, m*w, kind=default) - do i = 1, 4 - psibar(i)%a = psipsibar%a(i,:) - psibar(i) = pole * (f_fv (one, psibar(i), vp) + m * psibar(i)) - psipsibarp%a(i,:) = psibar(i)%a - end do -end function pr_dyadright -\nwendcode{}\nwbegindocs{555}\nwdocspar -\section{Spinor Couplings Revisited} -\nwenddocs{}\nwbegincode{556}\moddef{\code{}omega{\_}bispinor{\_}couplings.f95\edoc{}}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -\LA{}Copyleft\RA{} -module omega_bispinor_couplings - use kinds - use omega_constants - use omega_bispinors - use omega_vectorspinors - use omega_vectors - use omega_couplings - implicit none - private - \LA{}Declaration of bispinor on shell wave functions\RA{} - \LA{}Declaration of bispinor off shell wave functions\RA{} - \LA{}Declaration of bispinor currents\RA{} - \LA{}Declaration of bispinor propagators\RA{} - integer, parameter, public :: omega_bispinor_cpls_2003_03_A = 0 -contains - \LA{}Implementation of bispinor on shell wave functions\RA{} - \LA{}Implementation of bispinor off shell wave functions\RA{} - \LA{}Implementation of bispinor currents\RA{} - \LA{}Implementation of bispinor propagators\RA{} -end module omega_bispinor_couplings -\nwendcode{}\nwbegindocs{557}\nwdocspar -See table~\ref{tab:fermionic-currents} for the names of Fortran -functions. We could have used long names instead, but this would -increase the chance of running past continuation line limits without -adding much to the legibility. -\nwenddocs{}\nwbegindocs{558}\nwdocspar -\subsection{Fermionic Vector and Axial Couplings} -There's more than one chiral representation. This one is compatible -with HELAS~\cite{HELAS}. -\begin{subequations} -\begin{align} - & \gamma^0 = \begin{pmatrix} 0 & \mathbf{1} \\ \mathbf{1} & 0 - \end{pmatrix},\; - \gamma^i = \begin{pmatrix} 0 & \sigma^i \\ -\sigma^i & 0 \end{pmatrix},\; - \gamma_5 = i\gamma^0\gamma^1\gamma^2\gamma^3 - = \begin{pmatrix} -\mathbf{1} & 0 \\ 0 & \mathbf{1} - \end{pmatrix}, \\ & - C = \begin{pmatrix} \epsilon & 0 \\ 0 & - \epsilon \end{pmatrix} - \; , \qquad \epsilon = \begin{pmatrix} 0 & 1 \\ -1 & 0 \end{pmatrix} . -\end{align} -\end{subequations} -Therefore -\begin{subequations} -\begin{align} - g_S + g_P\gamma_5 &= - \begin{pmatrix} - g_S - g_P & 0 & 0 & 0 \\ - 0 & g_S - g_P & 0 & 0 \\ - 0 & 0 & g_S + g_P & 0 \\ - 0 & 0 & 0 & g_S + g_P - \end{pmatrix} \\ - g_V\gamma^0 - g_A\gamma^0\gamma_5 &= - \begin{pmatrix} - 0 & 0 & g_V - g_A & 0 \\ - 0 & 0 & 0 & g_V - g_A \\ - g_V + g_A & 0 & 0 & 0 \\ - 0 & g_V + g_A & 0 & 0 - \end{pmatrix} \\ - g_V\gamma^1 - g_A\gamma^1\gamma_5 &= - \begin{pmatrix} - 0 & 0 & 0 & g_V - g_A \\ - 0 & 0 & g_V - g_A & 0 \\ - 0 & - g_V - g_A & 0 & 0 \\ - - g_V - g_A & 0 & 0 & 0 - \end{pmatrix} \\ - g_V\gamma^2 - g_A\gamma^2\gamma_5 &= - \begin{pmatrix} - 0 & 0 & 0 & -\ii(g_V - g_A) \\ - 0 & 0 & \ii(g_V - g_A) & 0 \\ - 0 & \ii(g_V + g_A) & 0 & 0 \\ - -\ii(g_V + g_A) & 0 & 0 & 0 - \end{pmatrix} \\ - g_V\gamma^3 - g_A\gamma^3\gamma_5 &= - \begin{pmatrix} - 0 & 0 & g_V - g_A & 0 \\ - 0 & 0 & 0 & - g_V + g_A \\ - - g_V - g_A & 0 & 0 & 0 \\ - 0 & g_V + g_A & 0 & 0 - \end{pmatrix} -\end{align} -\end{subequations} -and -\begin{subequations} -\begin{align} - C(g_S + g_P\gamma_5) &= - \begin{pmatrix} - 0 & g_S - g_P & 0 & 0 \\ - - g_S + g_P & 0 & 0 & 0 \\ - 0 & 0 & 0 & - g_S - g_P \\ - 0 & 0 & g_S + g_P & 0 - \end{pmatrix} \\ - C(g_V\gamma^0 - g_A\gamma^0\gamma_5) &= - \begin{pmatrix} - 0 & 0 & 0 & g_V - g_A \\ - 0 & 0 & - g_V + g_A & 0 \\ - 0 & - g_V - g_A & 0 & 0 \\ - g_V + g_A & 0 & 0 & 0 - \end{pmatrix} \\ - C(g_V\gamma^1 - g_A\gamma^1\gamma_5) &= - \begin{pmatrix} - 0 & 0 & g_V - g_A & 0 \\ - 0 & 0 & 0 & - g_V + g_A \\ - g_V + g_A & 0 & 0 & 0 \\ - 0 & - g_V - g_A & 0 & 0 - \end{pmatrix} \\ - C(g_V\gamma^2 - g_A\gamma^2\gamma_5) &= - \begin{pmatrix} - 0 & 0 & \ii(g_V - g_A) & 0 \\ - 0 & 0 & 0 & \ii(g_V - g_A) \\ - \ii(g_V + g_A) & 0 & 0 & 0 \\ - 0 & \ii(g_V + g_A) & 0 & 0 - \end{pmatrix} \\ - C(g_V\gamma^3 - g_A\gamma^3\gamma_5) &= - \begin{pmatrix} - 0 & 0 & 0 & - g_V + g_A \\ - 0 & 0 & - g_V + g_A & 0 \\ - 0 & - g_V - g_A & 0 & 0 \\ - - g_V - g_A & 0 & 0 & 0 - \end{pmatrix} -\end{align} -\end{subequations} -\nwenddocs{}\nwbegincode{559}\moddef{Declaration of bispinor currents}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -public :: va_ff, v_ff, a_ff, vl_ff, vr_ff, vlr_ff -\nwendcode{}\nwbegindocs{560}\nwdocspar -\nwenddocs{}\nwbegincode{561}\moddef{Implementation of bispinor currents}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function va_ff (gv, ga, psil, psir) result (j) - type(vector) :: j - complex(kind=default), intent(in) :: gv, ga - type(bispinor), intent(in) :: psil, psir - complex(kind=default) :: gl, gr - complex(kind=default) :: g13, g14, g23, g24, g31, g32, g41, g42 - gl = gv + ga - gr = gv - ga - g13 = psil%a(1)*psir%a(3) - g14 = psil%a(1)*psir%a(4) - g23 = psil%a(2)*psir%a(3) - g24 = psil%a(2)*psir%a(4) - g31 = psil%a(3)*psir%a(1) - g32 = psil%a(3)*psir%a(2) - g41 = psil%a(4)*psir%a(1) - g42 = psil%a(4)*psir%a(2) - j%t = gr * ( g14 - g23) + gl * ( - g32 + g41) - j%x(1) = gr * ( g13 - g24) + gl * ( g31 - g42) - j%x(2) = (gr * ( g13 + g24) + gl * ( g31 + g42)) * (0, 1) - j%x(3) = gr * ( - g14 - g23) + gl * ( - g32 - g41) -end function va_ff -\nwendcode{}\nwbegindocs{562}\nwdocspar -\nwenddocs{}\nwbegincode{563}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function v_ff (gv, psil, psir) result (j) - type(vector) :: j - complex(kind=default), intent(in) :: gv - type(bispinor), intent(in) :: psil, psir - complex(kind=default) :: g13, g14, g23, g24, g31, g32, g41, g42 - g13 = psil%a(1)*psir%a(3) - g14 = psil%a(1)*psir%a(4) - g23 = psil%a(2)*psir%a(3) - g24 = psil%a(2)*psir%a(4) - g31 = psil%a(3)*psir%a(1) - g32 = psil%a(3)*psir%a(2) - g41 = psil%a(4)*psir%a(1) - g42 = psil%a(4)*psir%a(2) - j%t = gv * ( g14 - g23 - g32 + g41) - j%x(1) = gv * ( g13 - g24 + g31 - g42) - j%x(2) = gv * ( g13 + g24 + g31 + g42) * (0, 1) - j%x(3) = gv * ( - g14 - g23 - g32 - g41) -end function v_ff -\nwendcode{}\nwbegindocs{564}\nwdocspar -\nwenddocs{}\nwbegincode{565}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function a_ff (ga, psil, psir) result (j) - type(vector) :: j - complex(kind=default), intent(in) :: ga - type(bispinor), intent(in) :: psil, psir - complex(kind=default) :: g13, g14, g23, g24, g31, g32, g41, g42 - g13 = psil%a(1)*psir%a(3) - g14 = psil%a(1)*psir%a(4) - g23 = psil%a(2)*psir%a(3) - g24 = psil%a(2)*psir%a(4) - g31 = psil%a(3)*psir%a(1) - g32 = psil%a(3)*psir%a(2) - g41 = psil%a(4)*psir%a(1) - g42 = psil%a(4)*psir%a(2) - j%t = -ga * ( g14 - g23 + g32 - g41) - j%x(1) = -ga * ( g13 - g24 - g31 + g42) - j%x(2) = -ga * ( g13 + g24 - g31 - g42) * (0, 1) - j%x(3) = -ga * ( - g14 - g23 + g32 + g41) -end function a_ff -\nwendcode{}\nwbegindocs{566}\nwdocspar -\nwenddocs{}\nwbegincode{567}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function vl_ff (gl, psil, psir) result (j) - type(vector) :: j - complex(kind=default), intent(in) :: gl - type(bispinor), intent(in) :: psil, psir - complex(kind=default) :: gl2 - complex(kind=default) :: g31, g32, g41, g42 - gl2 = 2 * gl - g31 = psil%a(3)*psir%a(1) - g32 = psil%a(3)*psir%a(2) - g41 = psil%a(4)*psir%a(1) - g42 = psil%a(4)*psir%a(2) - j%t = gl2 * ( - g32 + g41) - j%x(1) = gl2 * ( g31 - g42) - j%x(2) = gl2 * ( g31 + g42) * (0, 1) - j%x(3) = gl2 * ( - g32 - g41) -end function vl_ff -\nwendcode{}\nwbegindocs{568}\nwdocspar -\nwenddocs{}\nwbegincode{569}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function vr_ff (gr, psil, psir) result (j) - type(vector) :: j - complex(kind=default), intent(in) :: gr - type(bispinor), intent(in) :: psil, psir - complex(kind=default) :: gr2 - complex(kind=default) :: g13, g14, g23, g24 - gr2 = 2 * gr - g13 = psil%a(1)*psir%a(3) - g14 = psil%a(1)*psir%a(4) - g23 = psil%a(2)*psir%a(3) - g24 = psil%a(2)*psir%a(4) - j%t = gr2 * ( g14 - g23) - j%x(1) = gr2 * ( g13 - g24) - j%x(2) = gr2 * ( g13 + g24) * (0, 1) - j%x(3) = gr2 * ( - g14 - g23) -end function vr_ff -\nwendcode{}\nwbegindocs{570}\nwdocspar -\nwenddocs{}\nwbegincode{571}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function vlr_ff (gl, gr, psibar, psi) result (j) - type(vector) :: j - complex(kind=default), intent(in) :: gl, gr - type(bispinor), intent(in) :: psibar - type(bispinor), intent(in) :: psi - j = va_ff (gl+gr, gl-gr, psibar, psi) -end function vlr_ff -\nwendcode{}\nwbegindocs{572}\nwdocspar -and -\begin{equation} - \fmslash{v} - \fmslash{a}\gamma_5 = - \begin{pmatrix} - 0 & 0 & v_- - a_- & - v^* + a^* \\ - 0 & 0 & - v + a & v_+ - a_+ \\ - v_+ + a_+ & v^* + a^* & 0 & 0 \\ - v + a & v_- + a_- & 0 & 0 - \end{pmatrix} -\end{equation} -with $v_\pm=v_0\pm v_3$, $a_\pm=a_0\pm a_3$, $v=v_1+\ii v_2$, -$v^*=v_1-\ii v_2$, $a=a_1+\ii a_2$, and $a^*=a_1-\ii a_2$. But note -that~$\cdot^*$ is \emph{not} complex conjugation for complex~$v_\mu$ -or~$a_\mu$. -\nwenddocs{}\nwbegincode{573}\moddef{Declaration of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -public :: f_vaf, f_vf, f_af, f_vlf, f_vrf, f_vlrf -\nwendcode{}\nwbegindocs{574}\nwdocspar -\nwenddocs{}\nwbegincode{575}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function f_vaf (gv, ga, v, psi) result (vpsi) - type(bispinor) :: vpsi - complex(kind=default), intent(in) :: gv, ga - type(vector), intent(in) :: v - type(bispinor), intent(in) :: psi - complex(kind=default) :: gl, gr - complex(kind=default) :: vp, vm, v12, v12s - gl = gv + ga - gr = gv - ga - vp = v%t + v%x(3) - vm = v%t - v%x(3) - v12 = v%x(1) + (0,1)*v%x(2) - v12s = v%x(1) - (0,1)*v%x(2) - vpsi%a(1) = gr * ( vm * psi%a(3) - v12s * psi%a(4)) - vpsi%a(2) = gr * ( - v12 * psi%a(3) + vp * psi%a(4)) - vpsi%a(3) = gl * ( vp * psi%a(1) + v12s * psi%a(2)) - vpsi%a(4) = gl * ( v12 * psi%a(1) + vm * psi%a(2)) -end function f_vaf -\nwendcode{}\nwbegindocs{576}\nwdocspar -\nwenddocs{}\nwbegincode{577}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function f_vf (gv, v, psi) result (vpsi) - type(bispinor) :: vpsi - complex(kind=default), intent(in) :: gv - type(vector), intent(in) :: v - type(bispinor), intent(in) :: psi - complex(kind=default) :: vp, vm, v12, v12s - vp = v%t + v%x(3) - vm = v%t - v%x(3) - v12 = v%x(1) + (0,1)*v%x(2) - v12s = v%x(1) - (0,1)*v%x(2) - vpsi%a(1) = gv * ( vm * psi%a(3) - v12s * psi%a(4)) - vpsi%a(2) = gv * ( - v12 * psi%a(3) + vp * psi%a(4)) - vpsi%a(3) = gv * ( vp * psi%a(1) + v12s * psi%a(2)) - vpsi%a(4) = gv * ( v12 * psi%a(1) + vm * psi%a(2)) -end function f_vf -\nwendcode{}\nwbegindocs{578}\nwdocspar -\nwenddocs{}\nwbegincode{579}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function f_af (ga, v, psi) result (vpsi) - type(bispinor) :: vpsi - complex(kind=default), intent(in) :: ga - type(vector), intent(in) :: v - type(bispinor), intent(in) :: psi - complex(kind=default) :: vp, vm, v12, v12s - vp = v%t + v%x(3) - vm = v%t - v%x(3) - v12 = v%x(1) + (0,1)*v%x(2) - v12s = v%x(1) - (0,1)*v%x(2) - vpsi%a(1) = ga * ( - vm * psi%a(3) + v12s * psi%a(4)) - vpsi%a(2) = ga * ( v12 * psi%a(3) - vp * psi%a(4)) - vpsi%a(3) = ga * ( vp * psi%a(1) + v12s * psi%a(2)) - vpsi%a(4) = ga * ( v12 * psi%a(1) + vm * psi%a(2)) -end function f_af -\nwendcode{}\nwbegindocs{580}\nwdocspar -\nwenddocs{}\nwbegincode{581}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function f_vlf (gl, v, psi) result (vpsi) - type(bispinor) :: vpsi - complex(kind=default), intent(in) :: gl - type(vector), intent(in) :: v - type(bispinor), intent(in) :: psi - complex(kind=default) :: gl2 - complex(kind=default) :: vp, vm, v12, v12s - gl2 = 2 * gl - vp = v%t + v%x(3) - vm = v%t - v%x(3) - v12 = v%x(1) + (0,1)*v%x(2) - v12s = v%x(1) - (0,1)*v%x(2) - vpsi%a(1) = 0 - vpsi%a(2) = 0 - vpsi%a(3) = gl2 * ( vp * psi%a(1) + v12s * psi%a(2)) - vpsi%a(4) = gl2 * ( v12 * psi%a(1) + vm * psi%a(2)) -end function f_vlf -\nwendcode{}\nwbegindocs{582}\nwdocspar -\nwenddocs{}\nwbegincode{583}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function f_vrf (gr, v, psi) result (vpsi) - type(bispinor) :: vpsi - complex(kind=default), intent(in) :: gr - type(vector), intent(in) :: v - type(bispinor), intent(in) :: psi - complex(kind=default) :: gr2 - complex(kind=default) :: vp, vm, v12, v12s - gr2 = 2 * gr - vp = v%t + v%x(3) - vm = v%t - v%x(3) - v12 = v%x(1) + (0,1)*v%x(2) - v12s = v%x(1) - (0,1)*v%x(2) - vpsi%a(1) = gr2 * ( vm * psi%a(3) - v12s * psi%a(4)) - vpsi%a(2) = gr2 * ( - v12 * psi%a(3) + vp * psi%a(4)) - vpsi%a(3) = 0 - vpsi%a(4) = 0 -end function f_vrf -\nwendcode{}\nwbegindocs{584}\nwdocspar -\nwenddocs{}\nwbegincode{585}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function f_vlrf (gl, gr, v, psi) result (vpsi) - type(bispinor) :: vpsi - complex(kind=default), intent(in) :: gl, gr - type(vector), intent(in) :: v - type(bispinor), intent(in) :: psi - vpsi = f_vaf (gl+gr, gl-gr, v, psi) -end function f_vlrf -\nwendcode{}\nwbegindocs{586}\subsection{Fermionic Scalar and Pseudo Scalar Couplings} -\nwenddocs{}\nwbegincode{587}\moddef{Declaration of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -public :: sp_ff, s_ff, p_ff, sl_ff, sr_ff, slr_ff -\nwendcode{}\nwbegindocs{588}\nwdocspar -\nwenddocs{}\nwbegincode{589}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function sp_ff (gs, gp, psil, psir) result (j) - complex(kind=default) :: j - complex(kind=default), intent(in) :: gs, gp - type(bispinor), intent(in) :: psil, psir - j = (gs - gp) * (psil%a(1)*psir%a(2) - psil%a(2)*psir%a(1)) & - + (gs + gp) * (- psil%a(3)*psir%a(4) + psil%a(4)*psir%a(3)) -end function sp_ff -\nwendcode{}\nwbegindocs{590}\nwdocspar -\nwenddocs{}\nwbegincode{591}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function s_ff (gs, psil, psir) result (j) - complex(kind=default) :: j - complex(kind=default), intent(in) :: gs - type(bispinor), intent(in) :: psil, psir - j = gs * (psil * psir) -end function s_ff -\nwendcode{}\nwbegindocs{592}\nwdocspar -\nwenddocs{}\nwbegincode{593}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function p_ff (gp, psil, psir) result (j) - complex(kind=default) :: j - complex(kind=default), intent(in) :: gp - type(bispinor), intent(in) :: psil, psir - j = gp * (- psil%a(1)*psir%a(2) + psil%a(2)*psir%a(1) & - - psil%a(3)*psir%a(4) + psil%a(4)*psir%a(3)) -end function p_ff -\nwendcode{}\nwbegindocs{594}\nwdocspar -\nwenddocs{}\nwbegincode{595}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function sl_ff (gl, psil, psir) result (j) - complex(kind=default) :: j - complex(kind=default), intent(in) :: gl - type(bispinor), intent(in) :: psil, psir - j = 2 * gl * (psil%a(1)*psir%a(2) - psil%a(2)*psir%a(1)) -end function sl_ff -\nwendcode{}\nwbegindocs{596}\nwdocspar -\nwenddocs{}\nwbegincode{597}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function sr_ff (gr, psil, psir) result (j) - complex(kind=default) :: j - complex(kind=default), intent(in) :: gr - type(bispinor), intent(in) :: psil, psir - j = 2 * gr * (- psil%a(3)*psir%a(4) + psil%a(4)*psir%a(3)) -end function sr_ff -\nwendcode{}\nwbegindocs{598}\nwdocspar -\nwenddocs{}\nwbegincode{599}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function slr_ff (gl, gr, psibar, psi) result (j) - complex(kind=default) :: j - complex(kind=default), intent(in) :: gl, gr - type(bispinor), intent(in) :: psibar - type(bispinor), intent(in) :: psi - j = sp_ff (gr+gl, gr-gl, psibar, psi) -end function slr_ff -\nwendcode{}\nwbegindocs{600}\nwdocspar -\nwenddocs{}\nwbegincode{601}\moddef{Declaration of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -public :: f_spf, f_sf, f_pf, f_slf, f_srf, f_slrf -\nwendcode{}\nwbegindocs{602}\nwdocspar -\nwenddocs{}\nwbegincode{603}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function f_spf (gs, gp, phi, psi) result (phipsi) - type(bispinor) :: phipsi - complex(kind=default), intent(in) :: gs, gp - complex(kind=default), intent(in) :: phi - type(bispinor), intent(in) :: psi - phipsi%a(1:2) = ((gs - gp) * phi) * psi%a(1:2) - phipsi%a(3:4) = ((gs + gp) * phi) * psi%a(3:4) -end function f_spf -\nwendcode{}\nwbegindocs{604}\nwdocspar -\nwenddocs{}\nwbegincode{605}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function f_sf (gs, phi, psi) result (phipsi) - type(bispinor) :: phipsi - complex(kind=default), intent(in) :: gs - complex(kind=default), intent(in) :: phi - type(bispinor), intent(in) :: psi - phipsi%a = (gs * phi) * psi%a -end function f_sf -\nwendcode{}\nwbegindocs{606}\nwdocspar -\nwenddocs{}\nwbegincode{607}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function f_pf (gp, phi, psi) result (phipsi) - type(bispinor) :: phipsi - complex(kind=default), intent(in) :: gp - complex(kind=default), intent(in) :: phi - type(bispinor), intent(in) :: psi - phipsi%a(1:2) = (- gp * phi) * psi%a(1:2) - phipsi%a(3:4) = ( gp * phi) * psi%a(3:4) -end function f_pf -\nwendcode{}\nwbegindocs{608}\nwdocspar -\nwenddocs{}\nwbegincode{609}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function f_slf (gl, phi, psi) result (phipsi) - type(bispinor) :: phipsi - complex(kind=default), intent(in) :: gl - complex(kind=default), intent(in) :: phi - type(bispinor), intent(in) :: psi - phipsi%a(1:2) = (2 * gl * phi) * psi%a(1:2) - phipsi%a(3:4) = 0 -end function f_slf -\nwendcode{}\nwbegindocs{610}\nwdocspar -\nwenddocs{}\nwbegincode{611}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function f_srf (gr, phi, psi) result (phipsi) - type(bispinor) :: phipsi - complex(kind=default), intent(in) :: gr - complex(kind=default), intent(in) :: phi - type(bispinor), intent(in) :: psi - phipsi%a(1:2) = 0 - phipsi%a(3:4) = (2 * gr * phi) * psi%a(3:4) -end function f_srf -\nwendcode{}\nwbegindocs{612}\nwdocspar -\nwenddocs{}\nwbegincode{613}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function f_slrf (gl, gr, phi, psi) result (phipsi) - type(bispinor) :: phipsi - complex(kind=default), intent(in) :: gl, gr - complex(kind=default), intent(in) :: phi - type(bispinor), intent(in) :: psi - phipsi = f_spf (gr+gl, gr-gl, phi, psi) -end function f_slrf -\nwendcode{}\nwbegindocs{614}\subsection{Couplings for BRST Transformations} -\subsubsection{3-Couplings} -The lists of needed gamma matrices can be found in the next subsection with -the gravitino couplings. -\nwenddocs{}\nwbegincode{615}\moddef{Declaration of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -private :: vv_ff, f_vvf -\nwendcode{}\nwbegindocs{616}\nwdocspar -\nwenddocs{}\nwbegincode{617}\moddef{Declaration of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -public :: vmom_ff, mom_ff, mom5_ff, moml_ff, momr_ff, lmom_ff, rmom_ff -\nwendcode{}\nwbegindocs{618}\nwdocspar -\nwenddocs{}\nwbegincode{619}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function vv_ff (psibar, psi, k) result (psibarpsi) - type(vector) :: psibarpsi - type(bispinor), intent(in) :: psibar, psi - type(vector), intent(in) :: k - complex(kind=default) :: kp, km, k12, k12s - type(bispinor) :: kgpsi1, kgpsi2, kgpsi3, kgpsi4 - kp = k%t + k%x(3) - km = k%t - k%x(3) - k12 = k%x(1) + (0,1)*k%x(2) - k12s = k%x(1) - (0,1)*k%x(2) - kgpsi1%a(1) = -k%x(3) * psi%a(1) - k12s * psi%a(2) - kgpsi1%a(2) = -k12 * psi%a(1) + k%x(3) * psi%a(2) - kgpsi1%a(3) = k%x(3) * psi%a(3) + k12s * psi%a(4) - kgpsi1%a(4) = k12 * psi%a(3) - k%x(3) * psi%a(4) - kgpsi2%a(1) = ((0,-1) * k%x(2)) * psi%a(1) - km * psi%a(2) - kgpsi2%a(2) = - kp * psi%a(1) + ((0,1) * k%x(2)) * psi%a(2) - kgpsi2%a(3) = ((0,-1) * k%x(2)) * psi%a(3) + kp * psi%a(4) - kgpsi2%a(4) = km * psi%a(3) + ((0,1) * k%x(2)) * psi%a(4) - kgpsi3%a(1) = (0,1) * (k%x(1) * psi%a(1) + km * psi%a(2)) - kgpsi3%a(2) = (0,-1) * (kp * psi%a(1) + k%x(1) * psi%a(2)) - kgpsi3%a(3) = (0,1) * (k%x(1) * psi%a(3) - kp * psi%a(4)) - kgpsi3%a(4) = (0,1) * (km * psi%a(3) - k%x(1) * psi%a(4)) - kgpsi4%a(1) = -k%t * psi%a(1) - k12s * psi%a(2) - kgpsi4%a(2) = k12 * psi%a(1) + k%t * psi%a(2) - kgpsi4%a(3) = k%t * psi%a(3) - k12s * psi%a(4) - kgpsi4%a(4) = k12 * psi%a(3) - k%t * psi%a(4) - psibarpsi%t = 2 * (psibar * kgpsi1) - psibarpsi%x(1) = 2 * (psibar * kgpsi2) - psibarpsi%x(2) = 2 * (psibar * kgpsi3) - psibarpsi%x(3) = 2 * (psibar * kgpsi4) -end function vv_ff -\nwendcode{}\nwbegindocs{620}\nwdocspar -\nwenddocs{}\nwbegincode{621}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function f_vvf (v, psi, k) result (kvpsi) - type(bispinor) :: kvpsi - type(bispinor), intent(in) :: psi - type(vector), intent(in) :: k, v - complex(kind=default) :: kv30, kv21, kv01, kv31, kv02, kv32 - complex(kind=default) :: ap, am, bp, bm, bps, bms - kv30 = k%x(3) * v%t - k%t * v%x(3) - kv21 = (0,1) * (k%x(2) * v%x(1) - k%x(1) * v%x(2)) - kv01 = k%t * v%x(1) - k%x(1) * v%t - kv31 = k%x(3) * v%x(1) - k%x(1) * v%x(3) - kv02 = (0,1) * (k%t * v%x(2) - k%x(2) * v%t) - kv32 = (0,1) * (k%x(3) * v%x(2) - k%x(2) * v%x(3)) - ap = 2 * (kv30 + kv21) - am = 2 * (-kv30 + kv21) - bp = 2 * (kv01 + kv31 + kv02 + kv32) - bm = 2 * (kv01 - kv31 + kv02 - kv32) - bps = 2 * (kv01 + kv31 - kv02 - kv32) - bms = 2 * (kv01 - kv31 - kv02 + kv32) - kvpsi%a(1) = am * psi%a(1) + bms * psi%a(2) - kvpsi%a(2) = bp * psi%a(1) - am * psi%a(2) - kvpsi%a(3) = ap * psi%a(3) - bps * psi%a(4) - kvpsi%a(4) = -bm * psi%a(3) - ap * psi%a(4) -end function f_vvf -\nwendcode{}\nwbegindocs{622}\nwdocspar -\nwenddocs{}\nwbegincode{623}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function vmom_ff (g, psibar, psi, k) result (psibarpsi) - type(vector) :: psibarpsi - complex(kind=default), intent(in) :: g - type(bispinor), intent(in) :: psibar, psi - type(momentum), intent(in) :: k - type(vector) :: vk - vk = k - psibarpsi = g * vv_ff (psibar, psi, vk) -end function vmom_ff -\nwendcode{}\nwbegindocs{624}\nwdocspar -\nwenddocs{}\nwbegincode{625}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function mom_ff (g, m, psibar, psi, k) result (psibarpsi) - complex(kind=default) :: psibarpsi - type(bispinor), intent(in) :: psibar, psi - type(momentum), intent(in) :: k - complex(kind=default), intent(in) :: g, m - type(bispinor) :: kmpsi - complex(kind=default) :: kp, km, k12, k12s - kp = k%t + k%x(3) - km = k%t - k%x(3) - k12 = k%x(1) + (0,1)*k%x(2) - k12s = k%x(1) - (0,1)*k%x(2) - kmpsi%a(1) = km * psi%a(3) - k12s * psi%a(4) - kmpsi%a(2) = kp * psi%a(4) - k12 * psi%a(3) - kmpsi%a(3) = kp * psi%a(1) + k12s * psi%a(2) - kmpsi%a(4) = k12 * psi%a(1) + km * psi%a(2) - psibarpsi = g * (psibar * kmpsi) + s_ff (m, psibar, psi) -end function mom_ff -\nwendcode{}\nwbegindocs{626}\nwdocspar -\nwenddocs{}\nwbegincode{627}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function mom5_ff (g, m, psibar, psi, k) result (psibarpsi) - complex(kind=default) :: psibarpsi - type(bispinor), intent(in) :: psibar, psi - type(momentum), intent(in) :: k - complex(kind=default), intent(in) :: g, m - type(bispinor) :: g5psi - g5psi%a(1:2) = - psi%a(1:2) - g5psi%a(3:4) = psi%a(3:4) - psibarpsi = mom_ff (g, m, psibar, g5psi, k) -end function mom5_ff -\nwendcode{}\nwbegindocs{628}\nwdocspar -\nwenddocs{}\nwbegincode{629}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function moml_ff (g, m, psibar, psi, k) result (psibarpsi) - complex(kind=default) :: psibarpsi - type(bispinor), intent(in) :: psibar, psi - type(momentum), intent(in) :: k - complex(kind=default), intent(in) :: g, m - type(bispinor) :: leftpsi - leftpsi%a(1:2) = 2 * psi%a(1:2) - leftpsi%a(3:4) = 0 - psibarpsi = mom_ff (g, m, psibar, leftpsi, k) -end function moml_ff -\nwendcode{}\nwbegindocs{630}\nwdocspar -\nwenddocs{}\nwbegincode{631}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function momr_ff (g, m, psibar, psi, k) result (psibarpsi) - complex(kind=default) :: psibarpsi - type(bispinor), intent(in) :: psibar, psi - type(momentum), intent(in) :: k - complex(kind=default), intent(in) :: g, m - type(bispinor) :: rightpsi - rightpsi%a(1:2) = 0 - rightpsi%a(3:4) = 2 * psi%a(3:4) - psibarpsi = mom_ff (g, m, psibar, rightpsi, k) -end function momr_ff -\nwendcode{}\nwbegindocs{632}\nwdocspar -\nwenddocs{}\nwbegincode{633}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function lmom_ff (g, m, psibar, psi, k) result (psibarpsi) - complex(kind=default) :: psibarpsi - type(bispinor), intent(in) :: psibar, psi - type(momentum), intent(in) :: k - complex(kind=default), intent(in) :: g, m - psibarpsi = mom_ff (g, m, psibar, psi, k) + & - mom5_ff (g,-m, psibar, psi, k) -end function lmom_ff -\nwendcode{}\nwbegindocs{634}\nwdocspar -\nwenddocs{}\nwbegincode{635}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function rmom_ff (g, m, psibar, psi, k) result (psibarpsi) - complex(kind=default) :: psibarpsi - type(bispinor), intent(in) :: psibar, psi - type(momentum), intent(in) :: k - complex(kind=default), intent(in) :: g, m - psibarpsi = mom_ff (g, m, psibar, psi, k) - & - mom5_ff (g,-m, psibar, psi, k) -end function rmom_ff -\nwendcode{}\nwbegindocs{636}\nwdocspar -\nwenddocs{}\nwbegincode{637}\moddef{Declaration of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -public :: f_vmomf, f_momf, f_mom5f, f_momlf, f_momrf, f_lmomf, f_rmomf -\nwendcode{}\nwbegindocs{638}\nwdocspar -\nwenddocs{}\nwbegincode{639}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function f_vmomf (g, v, psi, k) result (kvpsi) - type(bispinor) :: kvpsi - type(bispinor), intent(in) :: psi - complex(kind=default), intent(in) :: g - type(momentum), intent(in) :: k - type(vector), intent(in) :: v - type(vector) :: vk - vk = k - kvpsi = g * f_vvf (v, psi, vk) -end function f_vmomf -\nwendcode{}\nwbegindocs{640}\nwdocspar -\nwenddocs{}\nwbegincode{641}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function f_momf (g, m, phi, psi, k) result (kmpsi) - type(bispinor) :: kmpsi - type(bispinor), intent(in) :: psi - complex(kind=default), intent(in) :: phi, g, m - type(momentum), intent(in) :: k - complex(kind=default) :: kp, km, k12, k12s - kp = k%t + k%x(3) - km = k%t - k%x(3) - k12 = k%x(1) + (0,1)*k%x(2) - k12s = k%x(1) - (0,1)*k%x(2) - kmpsi%a(1) = km * psi%a(3) - k12s * psi%a(4) - kmpsi%a(2) = -k12 * psi%a(3) + kp * psi%a(4) - kmpsi%a(3) = kp * psi%a(1) + k12s * psi%a(2) - kmpsi%a(4) = k12 * psi%a(1) + km * psi%a(2) - kmpsi = g * (phi * kmpsi) + f_sf (m, phi, psi) -end function f_momf -\nwendcode{}\nwbegindocs{642}\nwdocspar -\nwenddocs{}\nwbegincode{643}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function f_mom5f (g, m, phi, psi, k) result (kmpsi) - type(bispinor) :: kmpsi - type(bispinor), intent(in) :: psi - complex(kind=default), intent(in) :: phi, g, m - type(momentum), intent(in) :: k - type(bispinor) :: g5psi - g5psi%a(1:2) = - psi%a(1:2) - g5psi%a(3:4) = psi%a(3:4) - kmpsi = f_momf (g, m, phi, g5psi, k) -end function f_mom5f -\nwendcode{}\nwbegindocs{644}\nwdocspar -\nwenddocs{}\nwbegincode{645}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function f_momlf (g, m, phi, psi, k) result (kmpsi) - type(bispinor) :: kmpsi - type(bispinor), intent(in) :: psi - complex(kind=default), intent(in) :: phi, g, m - type(momentum), intent(in) :: k - type(bispinor) :: leftpsi - leftpsi%a(1:2) = 2 * psi%a(1:2) - leftpsi%a(3:4) = 0 - kmpsi = f_momf (g, m, phi, leftpsi, k) -end function f_momlf -\nwendcode{}\nwbegindocs{646}\nwdocspar -\nwenddocs{}\nwbegincode{647}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function f_momrf (g, m, phi, psi, k) result (kmpsi) - type(bispinor) :: kmpsi - type(bispinor), intent(in) :: psi - complex(kind=default), intent(in) :: phi, g, m - type(momentum), intent(in) :: k - type(bispinor) :: rightpsi - rightpsi%a(1:2) = 0 - rightpsi%a(3:4) = 2 * psi%a(3:4) - kmpsi = f_momf (g, m, phi, rightpsi, k) -end function f_momrf -\nwendcode{}\nwbegindocs{648}\nwdocspar -\nwenddocs{}\nwbegincode{649}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function f_lmomf (g, m, phi, psi, k) result (kmpsi) - type(bispinor) :: kmpsi - type(bispinor), intent(in) :: psi - complex(kind=default), intent(in) :: phi, g, m - type(momentum), intent(in) :: k - kmpsi = f_momf (g, m, phi, psi, k) + & - f_mom5f (g,-m, phi, psi, k) -end function f_lmomf -\nwendcode{}\nwbegindocs{650}\nwdocspar -\nwenddocs{}\nwbegincode{651}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function f_rmomf (g, m, phi, psi, k) result (kmpsi) - type(bispinor) :: kmpsi - type(bispinor), intent(in) :: psi - complex(kind=default), intent(in) :: phi, g, m - type(momentum), intent(in) :: k - kmpsi = f_momf (g, m, phi, psi, k) - & - f_mom5f (g,-m, phi, psi, k) -end function f_rmomf -\nwendcode{}\nwbegindocs{652}\nwdocspar -\subsubsection{4-Couplings} -\nwenddocs{}\nwbegincode{653}\moddef{Declaration of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -public :: v2_ff, sv1_ff, sv2_ff, pv1_ff, pv2_ff, svl1_ff, svl2_ff, & - svr1_ff, svr2_ff, svlr1_ff, svlr2_ff -\nwendcode{}\nwbegindocs{654}\nwdocspar -\nwenddocs{}\nwbegincode{655}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function v2_ff (g, psibar, v, psi) result (v2) - type(vector) :: v2 - complex (kind=default), intent(in) :: g - type(bispinor), intent(in) :: psibar, psi - type(vector), intent(in) :: v - v2 = (-g) * vv_ff (psibar, psi, v) -end function v2_ff -\nwendcode{}\nwbegindocs{656}\nwdocspar -\nwenddocs{}\nwbegincode{657}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function sv1_ff (g, psibar, v, psi) result (phi) - complex(kind=default) :: phi - type(bispinor), intent(in) :: psibar, psi - type(vector), intent(in) :: v - complex(kind=default), intent(in) :: g - phi = psibar * f_vf (g, v, psi) -end function sv1_ff -\nwendcode{}\nwbegindocs{658}\nwdocspar -\nwenddocs{}\nwbegincode{659}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function sv2_ff (g, psibar, phi, psi) result (v) - type(vector) :: v - complex(kind=default), intent(in) :: phi, g - type(bispinor), intent(in) :: psibar, psi - v = phi * v_ff (g, psibar, psi) -end function sv2_ff -\nwendcode{}\nwbegindocs{660}\nwdocspar -\nwenddocs{}\nwbegincode{661}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function pv1_ff (g, psibar, v, psi) result (phi) - complex(kind=default) :: phi - type(bispinor), intent(in) :: psibar, psi - type(vector), intent(in) :: v - complex(kind=default), intent(in) :: g - phi = - (psibar * f_af (g, v, psi)) -end function pv1_ff -\nwendcode{}\nwbegindocs{662}\nwdocspar -\nwenddocs{}\nwbegincode{663}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function pv2_ff (g, psibar, phi, psi) result (v) - type(vector) :: v - complex(kind=default), intent(in) :: phi, g - type(bispinor), intent(in) :: psibar, psi - v = -(phi * a_ff (g, psibar, psi)) -end function pv2_ff -\nwendcode{}\nwbegindocs{664}\nwdocspar -\nwenddocs{}\nwbegincode{665}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function svl1_ff (g, psibar, v, psi) result (phi) - complex(kind=default) :: phi - type(bispinor), intent(in) :: psibar, psi - type(vector), intent(in) :: v - complex(kind=default), intent(in) :: g - phi = psibar * f_vlf (g, v, psi) -end function svl1_ff -\nwendcode{}\nwbegindocs{666}\nwdocspar -\nwenddocs{}\nwbegincode{667}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function svl2_ff (g, psibar, phi, psi) result (v) - type(vector) :: v - complex(kind=default), intent(in) :: phi, g - type(bispinor), intent(in) :: psibar, psi - v = phi * vl_ff (g, psibar, psi) -end function svl2_ff -\nwendcode{}\nwbegindocs{668}\nwdocspar -\nwenddocs{}\nwbegincode{669}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function svr1_ff (g, psibar, v, psi) result (phi) - complex(kind=default) :: phi - type(bispinor), intent(in) :: psibar, psi - type(vector), intent(in) :: v - complex(kind=default), intent(in) :: g - phi = psibar * f_vrf (g, v, psi) -end function svr1_ff -\nwendcode{}\nwbegindocs{670}\nwdocspar -\nwenddocs{}\nwbegincode{671}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function svr2_ff (g, psibar, phi, psi) result (v) - type(vector) :: v - complex(kind=default), intent(in) :: phi, g - type(bispinor), intent(in) :: psibar, psi - v = phi * vr_ff (g, psibar, psi) -end function svr2_ff -\nwendcode{}\nwbegindocs{672}\nwdocspar -\nwenddocs{}\nwbegincode{673}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function svlr1_ff (gl, gr, psibar, v, psi) result (phi) - complex(kind=default) :: phi - type(bispinor), intent(in) :: psibar, psi - type(vector), intent(in) :: v - complex(kind=default), intent(in) :: gl, gr - phi = psibar * f_vlrf (gl, gr, v, psi) -end function svlr1_ff -\nwendcode{}\nwbegindocs{674}\nwdocspar -\nwenddocs{}\nwbegincode{675}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function svlr2_ff (gl, gr, psibar, phi, psi) result (v) - type(vector) :: v - complex(kind=default), intent(in) :: phi, gl, gr - type(bispinor), intent(in) :: psibar, psi - v = phi * vlr_ff (gl, gr, psibar, psi) -end function svlr2_ff -\nwendcode{}\nwbegindocs{676}\nwdocspar -\nwenddocs{}\nwbegincode{677}\moddef{Declaration of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -public :: f_v2f, f_svf, f_pvf, f_svlf, f_svrf, f_svlrf -\nwendcode{}\nwbegindocs{678}\nwdocspar -\nwenddocs{}\nwbegincode{679}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function f_v2f (g, v1, v2, psi) result (vpsi) - type(bispinor) :: vpsi - complex(kind=default), intent(in) :: g - type(bispinor), intent(in) :: psi - type(vector), intent(in) :: v1, v2 - vpsi = g * f_vvf (v2, psi, v1) -end function f_v2f -\nwendcode{}\nwbegindocs{680}\nwdocspar -\nwenddocs{}\nwbegincode{681}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function f_svf (g, phi, v, psi) result (pvpsi) - type(bispinor) :: pvpsi - complex(kind=default), intent(in) :: g, phi - type(bispinor), intent(in) :: psi - type(vector), intent(in) :: v - pvpsi = phi * f_vf (g, v, psi) -end function f_svf -\nwendcode{}\nwbegindocs{682}\nwdocspar -\nwenddocs{}\nwbegincode{683}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function f_pvf (g, phi, v, psi) result (pvpsi) - type(bispinor) :: pvpsi - complex(kind=default), intent(in) :: g, phi - type(bispinor), intent(in) :: psi - type(vector), intent(in) :: v - pvpsi = -(phi * f_af (g, v, psi)) -end function f_pvf -\nwendcode{}\nwbegindocs{684}\nwdocspar -\nwenddocs{}\nwbegincode{685}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function f_svlf (g, phi, v, psi) result (pvpsi) - type(bispinor) :: pvpsi - complex(kind=default), intent(in) :: g, phi - type(bispinor), intent(in) :: psi - type(vector), intent(in) :: v - pvpsi = phi * f_vlf (g, v, psi) -end function f_svlf -\nwendcode{}\nwbegindocs{686}\nwdocspar -\nwenddocs{}\nwbegincode{687}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function f_svrf (g, phi, v, psi) result (pvpsi) - type(bispinor) :: pvpsi - complex(kind=default), intent(in) :: g, phi - type(bispinor), intent(in) :: psi - type(vector), intent(in) :: v - pvpsi = phi * f_vrf (g, v, psi) -end function f_svrf -\nwendcode{}\nwbegindocs{688}\nwdocspar -\nwenddocs{}\nwbegincode{689}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function f_svlrf (gl, gr, phi, v, psi) result (pvpsi) - type(bispinor) :: pvpsi - complex(kind=default), intent(in) :: gl, gr, phi - type(bispinor), intent(in) :: psi - type(vector), intent(in) :: v - pvpsi = phi * f_vlrf (gl, gr, v, psi) -end function f_svlrf -\nwendcode{}\nwbegindocs{690}\subsection{Gravitino Couplings} -\nwenddocs{}\nwbegincode{691}\moddef{Declaration of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -public :: pot_grf, pot_fgr, s_grf, s_fgr, p_grf, p_fgr -\nwendcode{}\nwbegindocs{692}\nwdocspar -\nwenddocs{}\nwbegincode{693}\moddef{Declaration of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -private :: fgvgr, fgvg5gr, fggvvgr, grkgf, grkggf, grkkggf, & - fgkgr, fg5gkgr, grvgf, grg5vgf, grkgggf, fggkggr -\nwendcode{}\nwbegindocs{694}\nwdocspar -\nwenddocs{}\nwbegincode{695}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function pot_grf (g, gravbar, psi) result (j) - complex(kind=default) :: j - complex(kind=default), intent(in) :: g - type(vectorspinor), intent(in) :: gravbar - type(bispinor), intent(in) :: psi - type(vectorspinor) :: gamma_psi - gamma_psi%psi(1)%a(1) = psi%a(3) - gamma_psi%psi(1)%a(2) = psi%a(4) - gamma_psi%psi(1)%a(3) = psi%a(1) - gamma_psi%psi(1)%a(4) = psi%a(2) - gamma_psi%psi(2)%a(1) = psi%a(4) - gamma_psi%psi(2)%a(2) = psi%a(3) - gamma_psi%psi(2)%a(3) = - psi%a(2) - gamma_psi%psi(2)%a(4) = - psi%a(1) - gamma_psi%psi(3)%a(1) = (0,-1) * psi%a(4) - gamma_psi%psi(3)%a(2) = (0,1) * psi%a(3) - gamma_psi%psi(3)%a(3) = (0,1) * psi%a(2) - gamma_psi%psi(3)%a(4) = (0,-1) * psi%a(1) - gamma_psi%psi(4)%a(1) = psi%a(3) - gamma_psi%psi(4)%a(2) = - psi%a(4) - gamma_psi%psi(4)%a(3) = - psi%a(1) - gamma_psi%psi(4)%a(4) = psi%a(2) - j = g * (gravbar * gamma_psi) -end function pot_grf -\nwendcode{}\nwbegindocs{696}\nwdocspar -\nwenddocs{}\nwbegincode{697}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function pot_fgr (g, psibar, grav) result (j) - complex(kind=default) :: j - complex(kind=default), intent(in) :: g - type(bispinor), intent(in) :: psibar - type(vectorspinor), intent(in) :: grav - type(bispinor) :: gamma_grav - gamma_grav%a(1) = grav%psi(1)%a(3) - grav%psi(2)%a(4) + & - ((0,1)*grav%psi(3)%a(4)) - grav%psi(4)%a(3) - gamma_grav%a(2) = grav%psi(1)%a(4) - grav%psi(2)%a(3) - & - ((0,1)*grav%psi(3)%a(3)) + grav%psi(4)%a(4) - gamma_grav%a(3) = grav%psi(1)%a(1) + grav%psi(2)%a(2) - & - ((0,1)*grav%psi(3)%a(2)) + grav%psi(4)%a(1) - gamma_grav%a(4) = grav%psi(1)%a(2) + grav%psi(2)%a(1) + & - ((0,1)*grav%psi(3)%a(1)) - grav%psi(4)%a(2) - j = g * (psibar * gamma_grav) -end function pot_fgr -\nwendcode{}\nwbegindocs{698}\nwdocspar -\nwenddocs{}\nwbegincode{699}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function grvgf (gravbar, psi, k) result (j) - complex(kind=default) :: j - complex(kind=default) :: kp, km, k12, k12s - type(vectorspinor), intent(in) :: gravbar - type(bispinor), intent(in) :: psi - type(vector), intent(in) :: k - type(vectorspinor) :: kg_psi - kp = k%t + k%x(3) - km = k%t - k%x(3) - k12 = k%x(1) + (0,1)*k%x(2) - k12s = k%x(1) - (0,1)*k%x(2) - !!! Since we are taking the spinor product here, NO explicit - !!! charge conjugation matrix is needed! - kg_psi%psi(1)%a(1) = km * psi%a(1) - k12s * psi%a(2) - kg_psi%psi(1)%a(2) = - k12 * psi%a(1) + kp * psi%a(2) - kg_psi%psi(1)%a(3) = kp * psi%a(3) + k12s * psi%a(4) - kg_psi%psi(1)%a(4) = k12 * psi%a(3) + km * psi%a(4) - kg_psi%psi(2)%a(1) = k12s * psi%a(1) - km * psi%a(2) - kg_psi%psi(2)%a(2) = - kp * psi%a(1) + k12 * psi%a(2) - kg_psi%psi(2)%a(3) = k12s * psi%a(3) + kp * psi%a(4) - kg_psi%psi(2)%a(4) = km * psi%a(3) + k12 * psi%a(4) - kg_psi%psi(3)%a(1) = (0,1) * (k12s * psi%a(1) + km * psi%a(2)) - kg_psi%psi(3)%a(2) = (0,1) * (- kp * psi%a(1) - k12 * psi%a(2)) - kg_psi%psi(3)%a(3) = (0,1) * (k12s * psi%a(3) - kp * psi%a(4)) - kg_psi%psi(3)%a(4) = (0,1) * (km * psi%a(3) - k12 * psi%a(4)) - kg_psi%psi(4)%a(1) = - km * psi%a(1) - k12s * psi%a(2) - kg_psi%psi(4)%a(2) = k12 * psi%a(1) + kp * psi%a(2) - kg_psi%psi(4)%a(3) = kp * psi%a(3) - k12s * psi%a(4) - kg_psi%psi(4)%a(4) = k12 * psi%a(3) - km * psi%a(4) - j = gravbar * kg_psi -end function grvgf -\nwendcode{}\nwbegindocs{700}\nwdocspar -\nwenddocs{}\nwbegincode{701}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function grg5vgf (gravbar, psi, k) result (j) - complex(kind=default) :: j - type(vectorspinor), intent(in) :: gravbar - type(bispinor), intent(in) :: psi - type(vector), intent(in) :: k - type(bispinor) :: g5_psi - g5_psi%a(1:2) = - psi%a(1:2) - g5_psi%a(3:4) = psi%a(3:4) - j = grvgf (gravbar, g5_psi, k) -end function grg5vgf -\nwendcode{}\nwbegindocs{702}\nwdocspar -\nwenddocs{}\nwbegincode{703}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function s_grf (g, gravbar, psi, k) result (j) - complex(kind=default) :: j - complex(kind=default), intent(in) :: g - type(vectorspinor), intent(in) :: gravbar - type(bispinor), intent(in) :: psi - type(momentum), intent(in) :: k - type(vector) :: vk - vk = k - j = g * grvgf (gravbar, psi, vk) -end function s_grf -\nwendcode{}\nwbegindocs{704}\nwdocspar -\nwenddocs{}\nwbegincode{705}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function fgkgr (psibar, grav, k) result (j) - complex(kind=default) :: j - complex(kind=default) :: kp, km, k12, k12s - type(bispinor), intent(in) :: psibar - type(vectorspinor), intent(in) :: grav - type(vector), intent(in) :: k - type(bispinor) :: gk_grav - kp = k%t + k%x(3) - km = k%t - k%x(3) - k12 = k%x(1) + (0,1)*k%x(2) - k12s = k%x(1) - (0,1)*k%x(2) - !!! Since we are taking the spinor product here, NO explicit - !!! charge conjugation matrix is needed! - gk_grav%a(1) = kp * grav%psi(1)%a(1) + k12s * grav%psi(1)%a(2) & - - k12 * grav%psi(2)%a(1) - km * grav%psi(2)%a(2) & - + (0,1) * k12 * grav%psi(3)%a(1) & - + (0,1) * km * grav%psi(3)%a(2) & - - kp * grav%psi(4)%a(1) - k12s * grav%psi(4)%a(2) - gk_grav%a(2) = k12 * grav%psi(1)%a(1) + km * grav%psi(1)%a(2) & - - kp * grav%psi(2)%a(1) - k12s * grav%psi(2)%a(2) & - - (0,1) * kp * grav%psi(3)%a(1) & - - (0,1) * k12s * grav%psi(3)%a(2) & - + k12 * grav%psi(4)%a(1) + km * grav%psi(4)%a(2) - gk_grav%a(3) = km * grav%psi(1)%a(3) - k12s * grav%psi(1)%a(4) & - - k12 * grav%psi(2)%a(3) + kp * grav%psi(2)%a(4) & - + (0,1) * k12 * grav%psi(3)%a(3) & - - (0,1) * kp * grav%psi(3)%a(4) & - + km * grav%psi(4)%a(3) - k12s * grav%psi(4)%a(4) - gk_grav%a(4) = - k12 * grav%psi(1)%a(3) + kp * grav%psi(1)%a(4) & - + km * grav%psi(2)%a(3) - k12s * grav%psi(2)%a(4) & - + (0,1) * km * grav%psi(3)%a(3) & - - (0,1) * k12s * grav%psi(3)%a(4) & - + k12 * grav%psi(4)%a(3) - kp * grav%psi(4)%a(4) - j = psibar * gk_grav -end function fgkgr -\nwendcode{}\nwbegindocs{706}\nwdocspar -\nwenddocs{}\nwbegincode{707}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function fg5gkgr (psibar, grav, k) result (j) - complex(kind=default) :: j - type(bispinor), intent(in) :: psibar - type(vectorspinor), intent(in) :: grav - type(vector), intent(in) :: k - type(bispinor) :: psibar_g5 - psibar_g5%a(1:2) = - psibar%a(1:2) - psibar_g5%a(3:4) = psibar%a(3:4) - j = fgkgr (psibar_g5, grav, k) -end function fg5gkgr -\nwendcode{}\nwbegindocs{708}\nwdocspar -\nwenddocs{}\nwbegincode{709}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function s_fgr (g, psibar, grav, k) result (j) - complex(kind=default) :: j - complex(kind=default), intent(in) :: g - type(bispinor), intent(in) :: psibar - type(vectorspinor), intent(in) :: grav - type(momentum), intent(in) :: k - type(vector) :: vk - vk = k - j = g * fgkgr (psibar, grav, vk) -end function s_fgr -\nwendcode{}\nwbegindocs{710}\nwdocspar -\nwenddocs{}\nwbegincode{711}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function p_grf (g, gravbar, psi, k) result (j) - complex(kind=default) :: j - complex(kind=default), intent(in) :: g - type(vectorspinor), intent(in) :: gravbar - type(bispinor), intent(in) :: psi - type(momentum), intent(in) :: k - type(vector) :: vk - vk = k - j = g * grg5vgf (gravbar, psi, vk) -end function p_grf -\nwendcode{}\nwbegindocs{712}\nwdocspar -\nwenddocs{}\nwbegincode{713}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function p_fgr (g, psibar, grav, k) result (j) - complex(kind=default) :: j - complex(kind=default), intent(in) :: g - type(bispinor), intent(in) :: psibar - type(vectorspinor), intent(in) :: grav - type(momentum), intent(in) :: k - type(vector) :: vk - vk = k - j = g * fg5gkgr (psibar, grav, vk) -end function p_fgr -\nwendcode{}\nwbegindocs{714}\nwdocspar -\nwenddocs{}\nwbegincode{715}\moddef{Declaration of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -public :: f_potgr, f_sgr, f_pgr, f_vgr -\nwendcode{}\nwbegindocs{716}\nwdocspar -\nwenddocs{}\nwbegincode{717}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function f_potgr (g, phi, psi) result (phipsi) - type(bispinor) :: phipsi - complex(kind=default), intent(in) :: g - complex(kind=default), intent(in) :: phi - type(vectorspinor), intent(in) :: psi - phipsi%a(1) = (g * phi) * (psi%psi(1)%a(3) - psi%psi(2)%a(4) + & - ((0,1)*psi%psi(3)%a(4)) - psi%psi(4)%a(3)) - phipsi%a(2) = (g * phi) * (psi%psi(1)%a(4) - psi%psi(2)%a(3) - & - ((0,1)*psi%psi(3)%a(3)) + psi%psi(4)%a(4)) - phipsi%a(3) = (g * phi) * (psi%psi(1)%a(1) + psi%psi(2)%a(2) - & - ((0,1)*psi%psi(3)%a(2)) + psi%psi(4)%a(1)) - phipsi%a(4) = (g * phi) * (psi%psi(1)%a(2) + psi%psi(2)%a(1) + & - ((0,1)*psi%psi(3)%a(1)) - psi%psi(4)%a(2)) -end function f_potgr -\nwendcode{}\nwbegindocs{718}\nwdocspar -The slashed notation: -\begin{equation} - \fmslash{k} = - \begin{pmatrix} - 0 & 0 & k_- & - k^* \\ - 0 & 0 & - k & k_+ \\ - k_+ & k^* & 0 & 0 \\ - k & k_- & 0 & 0 - \end{pmatrix} , \qquad - \fmslash{k}\gamma_5 = - \begin{pmatrix} - 0 & 0 & k_- & - k^* \\ - 0 & 0 & - k & k_+ \\ - - k_+ & - k^* & 0 & 0 \\ - - k & - k_- & 0 & 0 \end{pmatrix} -\end{equation} -with $k_\pm=k_0\pm k_3$, $k=k_1+\ii k_2$, -$k^*=k_1-\ii k_2$. But note that~$\cdot^*$ is \emph{not} complex -conjugation for complex~$k_\mu$. -\begin{subequations} -\begin{alignat}{2} - \gamma^0 \fmslash{k} &= - \begin{pmatrix} - k_+ & k^* & 0 & 0 \\ - k & k_- & 0 & 0 \\ - 0 & 0 & k_- & - k^* \\ - 0 & 0 & - k & k_+ - \end{pmatrix} , & \qquad - \gamma^0 \fmslash{k} \gamma^5 & = - \begin{pmatrix} - - k_+ & - k^* & 0 & 0 \\ - - k & - k_- & 0 & 0 \\ - 0 & 0 & k_- & - k^* \\ - 0 & 0 & - k & k_+ - \end{pmatrix} \\ - \gamma^1 \fmslash{k} &= - \begin{pmatrix} - k & k_- & 0 & 0 \\ - k_+ & k^* & 0 & 0 \\ - 0 & 0 & k & - k_+ \\ - 0 & 0 & - k_- & k^* - \end{pmatrix}, & \qquad - \gamma^1 \fmslash{k} \gamma^5 & = - \begin{pmatrix} - - k & - k_- & 0 & 0 \\ - - k_+ & - k^* & 0 & 0 \\ - 0 & 0 & k & - k_+ \\ - 0 & 0 & - k_- & k^* - \end{pmatrix} \\ - \gamma^2 \fmslash{k} &= - \begin{pmatrix} - - \ii k & - \ii k_- & 0 & 0 \\ - \ii k_+ & \ii k^* & 0 & 0 \\ - 0 & 0 & - \ii k & \ii k_+ \\ - 0 & 0 & - \ii k_- & \ii k^* - \end{pmatrix}, & \qquad - \gamma^2 \fmslash{k} \gamma^5 & = - \begin{pmatrix} - \ii k & \ii k_- & 0 & 0 \\ - - \ii k_+ & - \ii k^* & 0 & 0 \\ - 0 & 0 & - \ii k & \ii k_+ \\ - 0 & 0 & - \ii k_- & \ii k^* - \end{pmatrix} \\ - \gamma^3 \fmslash{k} &= - \begin{pmatrix} - k_+ & k^* & 0 & 0 \\ - - k & - k_- & 0 & 0 \\ - 0 & 0 & - k_- & k^* \\ - 0 & 0 & - k & k_+ - \end{pmatrix}, & \qquad - \gamma^3 \fmslash{k} \gamma^5 & = - \begin{pmatrix} - - k_+ & - k^* & 0 & 0 \\ - k & k_- & 0 & 0 \\ - 0 & 0 & - k_- & k^* \\ - 0 & 0 & - k & k_+ - \end{pmatrix} -\end{alignat} -\end{subequations} -and -\begin{subequations} -\begin{alignat}{2} - \fmslash{k} \gamma^0&= - \begin{pmatrix} - k_- & - k^* & 0 & 0 \\ - - k & k_+ & 0 & 0 \\ - 0 & 0 & k_+ & k^* \\ - 0 & 0 & k & k_- - \end{pmatrix} , & \qquad - \fmslash{k} \gamma^0 \gamma^5 & = - \begin{pmatrix} - - k_- & k^* & 0 & 0 \\ - k & - k_+ & 0 & 0 \\ - 0 & 0 & k_+ & k^* \\ - 0 & 0 & k & k_- - \end{pmatrix} \\ - \fmslash{k} \gamma^1 &= - \begin{pmatrix} - k^* & - k_- & 0 & 0 \\ - - k_+ & k & 0 & 0 \\ - 0 & 0 & k^* & k_+ \\ - 0 & 0 & k_- & k - \end{pmatrix}, & \qquad - \fmslash{k} \gamma^1 \gamma^5 & = - \begin{pmatrix} - - k^* & k_- & 0 & 0 \\ - k_+ & - k & 0 & 0 \\ - 0 & 0 & k^* & k_+ \\ - 0 & 0 & k_- & k - \end{pmatrix} \\ - \fmslash{k} \gamma^2 &= - \begin{pmatrix} - \ii k^* & \ii k_- & 0 & 0 \\ - - \ii k_+ & - \ii k & 0 & 0 \\ - 0 & 0 & \ii k^* & - \ii k_+ \\ - 0 & 0 & \ii k_- & - \ii k - \end{pmatrix}, & \qquad - \fmslash{k} \gamma^2 \gamma^5 & = - \begin{pmatrix} - - \ii k^* & - \ii k_- & 0 & 0 \\ - \ii k_+ & \ii k & 0 & 0 \\ - 0 & 0 & \ii k^* & - \ii k_+ \\ - 0 & 0 & \ii k_- & - \ii k - \end{pmatrix} \\ - \fmslash{k} \gamma^3 &= - \begin{pmatrix} - - k_- & - k^* & 0 & 0 \\ - k & k_+ & 0 & 0 \\ - 0 & 0 & k_+ & - k^* \\ - 0 & 0 & k & - k_- - \end{pmatrix}, & \qquad - \fmslash{k} \gamma^3 \gamma^5 & = - \begin{pmatrix} - k_- & k^* & 0 & 0 \\ - - k & - k_+ & 0 & 0 \\ - 0 & 0 & k_+ & - k^* \\ - 0 & 0 & k & - k_- - \end{pmatrix} -\end{alignat} -\end{subequations} -and -\begin{subequations} -\begin{alignat}{2} - C \gamma^0 \fmslash{k} &= - \begin{pmatrix} - k & k_- & 0 & 0 \\ - - k_+ & - k^* & 0 & 0 \\ - 0 & 0 & k & - k_+ \\ - 0 & 0 & k_- & - k^* - \end{pmatrix} , & \qquad - C \gamma^0 \fmslash{k} \gamma^5 & = - \begin{pmatrix} - - k & - k_- & 0 & 0 \\ - k_+ & k^* & 0 & 0 \\ - 0 & 0 & k & - k_+ \\ - 0 & 0 & k_- & - k^* - \end{pmatrix} \\ - C \gamma^1 \fmslash{k} &= - \begin{pmatrix} - k_+ & k^* & 0 & 0 \\ - - k & - k_- & 0 & 0 \\ - 0 & 0 & k_- & - k^* \\ - 0 & 0 & k & - k_+ - \end{pmatrix}, & \qquad - C \gamma^1 \fmslash{k} \gamma^5 & = - \begin{pmatrix} - - k_+ & - k^* & 0 & 0 \\ - k & k_- & 0 & 0 \\ - 0 & 0 & k_- & - k^* \\ - 0 & 0 & k & - k_+ - \end{pmatrix} \\ - C \gamma^2 \fmslash{k} &= - \begin{pmatrix} - \ii k_+ & \ii k^* & 0 & 0 \\ - \ii k & \ii k_- & 0 & 0 \\ - 0 & 0 & \ii k_- & - \ii k^* \\ - 0 & 0 & - \ii k & \ii k_+ - \end{pmatrix}, & \qquad - C \gamma^2 \fmslash{k} \gamma^5 & = - \begin{pmatrix} - - \ii k_+ & - \ii k^* & 0 & 0 \\ - - \ii k & - \ii k_- & 0 & 0 \\ - 0 & 0 & \ii k_- & - \ii k^* \\ - 0 & 0 & - \ii k & \ii k_+ - \end{pmatrix} \\ - C \gamma^3 \fmslash{k} &= - \begin{pmatrix} - - k & - k_- & 0 & 0 \\ - - k_+ & - k^* & 0 & 0 \\ - 0 & 0 & k & - k_+ \\ - 0 & 0 & - k_- & k^* - \end{pmatrix}, & \qquad - C \gamma^3 \fmslash{k} \gamma^5 & = - \begin{pmatrix} - k & k_- & 0 & 0 \\ - k_+ & k^* & 0 & 0 \\ - 0 & 0 & k & - k_+ \\ - 0 & 0 & - k_- & k^* - \end{pmatrix} -\end{alignat} -\end{subequations} -and -\begin{subequations} -\begin{alignat}{2} - C \fmslash{k} \gamma^0&= - \begin{pmatrix} - - k & k^+ & 0 & 0 \\ - - k_- & k^* & 0 & 0 \\ - 0 & 0 & - k & - k_- \\ - 0 & 0 & k_+ & k^* - \end{pmatrix} , & \qquad - C \fmslash{k} \gamma^0 \gamma^5 & = - \begin{pmatrix} - k & - k_+ & 0 & 0 \\ - k_- & - k^* & 0 & 0 \\ - 0 & 0 & - k & - k_- \\ - 0 & 0 & k_+ & k^* - \end{pmatrix} \\ - C \fmslash{k} \gamma^1 &= - \begin{pmatrix} - - k_+ & k & 0 & 0 \\ - - k^* & k_- & 0 & 0 \\ - 0 & 0 & - k_- & - k \\ - 0 & 0 & k^* & k_+ - \end{pmatrix}, & \qquad - C \fmslash{k} \gamma^1 \gamma^5 & = - \begin{pmatrix} - k_+ & - k & 0 & 0 \\ - k^* & - k_- & 0 & 0 \\ - 0 & 0 & - k_- & - k \\ - 0 & 0 & k^* & k_+ - \end{pmatrix} \\ - C \fmslash{k} \gamma^2 &= - \begin{pmatrix} - - \ii k_+ & - \ii k & 0 & 0 \\ - - \ii k^* & - \ii k_- & 0 & 0 \\ - 0 & 0 & - \ii k_- & \ii k \\ - 0 & 0 & \ii k^* & - \ii k_+ - \end{pmatrix}, & \qquad - C \fmslash{k} \gamma^2 \gamma^5 & = - \begin{pmatrix} - \ii k_+ & \ii k & 0 & 0 \\ - \ii k^* & \ii k_- & 0 & 0 \\ - 0 & 0 & - \ii k_- & \ii k \\ - 0 & 0 & \ii k^* & - \ii k_+ - \end{pmatrix} \\ - C \fmslash{k} \gamma^3 &= - \begin{pmatrix} - k & k_+ & 0 & 0 \\ - k_- & k^* & 0 & 0 \\ - 0 & 0 & - k & k_- \\ - 0 & 0 & k_+ & - k^* - \end{pmatrix}, & \qquad - C \fmslash{k} \gamma^3 \gamma^5 & = - \begin{pmatrix} - - k & - k_+ & 0 & 0 \\ - - k_- & - k^* & 0 & 0 \\ - 0 & 0 & - k & k_- \\ - 0 & 0 & k_+ & - k^* - \end{pmatrix} -\end{alignat} -\end{subequations} -\nwenddocs{}\nwbegincode{719}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function fgvgr (psi, k) result (kpsi) - type(bispinor) :: kpsi - complex(kind=default) :: kp, km, k12, k12s - type(vector), intent(in) :: k - type(vectorspinor), intent(in) :: psi - kp = k%t + k%x(3) - km = k%t - k%x(3) - k12 = k%x(1) + (0,1)*k%x(2) - k12s = k%x(1) - (0,1)*k%x(2) - kpsi%a(1) = kp * psi%psi(1)%a(1) + k12s * psi%psi(1)%a(2) & - - k12 * psi%psi(2)%a(1) - km * psi%psi(2)%a(2) & - + (0,1) * k12 * psi%psi(3)%a(1) + (0,1) * km * psi%psi(3)%a(2) & - - kp * psi%psi(4)%a(1) - k12s * psi%psi(4)%a(2) - kpsi%a(2) = k12 * psi%psi(1)%a(1) + km * psi%psi(1)%a(2) & - - kp * psi%psi(2)%a(1) - k12s * psi%psi(2)%a(2) & - - (0,1) * kp * psi%psi(3)%a(1) - (0,1) * k12s * psi%psi(3)%a(2) & - + k12 * psi%psi(4)%a(1) + km * psi%psi(4)%a(2) - kpsi%a(3) = km * psi%psi(1)%a(3) - k12s * psi%psi(1)%a(4) & - - k12 * psi%psi(2)%a(3) + kp * psi%psi(2)%a(4) & - + (0,1) * k12 * psi%psi(3)%a(3) - (0,1) * kp * psi%psi(3)%a(4) & - + km * psi%psi(4)%a(3) - k12s * psi%psi(4)%a(4) - kpsi%a(4) = - k12 * psi%psi(1)%a(3) + kp * psi%psi(1)%a(4) & - + km * psi%psi(2)%a(3) - k12s * psi%psi(2)%a(4) & - + (0,1) * km * psi%psi(3)%a(3) - (0,1) * k12s * psi%psi(3)%a(4) & - + k12 * psi%psi(4)%a(3) - kp * psi%psi(4)%a(4) -end function fgvgr -\nwendcode{}\nwbegindocs{720}\nwdocspar -\nwenddocs{}\nwbegincode{721}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function f_sgr (g, phi, psi, k) result (phipsi) - type(bispinor) :: phipsi - complex(kind=default), intent(in) :: g - complex(kind=default), intent(in) :: phi - type(momentum), intent(in) :: k - type(vectorspinor), intent(in) :: psi - type(vector) :: vk - vk = k - phipsi = (g * phi) * fgvgr (psi, vk) -end function f_sgr -\nwendcode{}\nwbegindocs{722}\nwdocspar -\nwenddocs{}\nwbegincode{723}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function fgvg5gr (psi, k) result (kpsi) - type(bispinor) :: kpsi - type(vector), intent(in) :: k - type(vectorspinor), intent(in) :: psi - type(bispinor) :: kpsi_dum - kpsi_dum = fgvgr (psi, k) - kpsi%a(1:2) = - kpsi_dum%a(1:2) - kpsi%a(3:4) = kpsi_dum%a(3:4) -end function fgvg5gr -\nwendcode{}\nwbegindocs{724}\nwdocspar -\nwenddocs{}\nwbegincode{725}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function f_pgr (g, phi, psi, k) result (phipsi) - type(bispinor) :: phipsi - complex(kind=default), intent(in) :: g - complex(kind=default), intent(in) :: phi - type(momentum), intent(in) :: k - type(vectorspinor), intent(in) :: psi - type(vector) :: vk - vk = k - phipsi = (g * phi) * fgvg5gr (psi, vk) -end function f_pgr -\nwendcode{}\nwbegindocs{726}\nwdocspar -The needed construction of gamma matrices involving the commutator -of two gamma matrices. For the slashed terms we use as usual the -abbreviations $k_\pm=k_0\pm k_3$, $k=k_1+\ii k_2$, $k^*=k_1-\ii k_2$ -and analogous expressions for the vector $v^\mu$. We remind you -that~$\cdot^*$ is \emph{not} complex conjugation for complex~$k_\mu$. -Furthermore we introduce (in what follows the brackets around the vector -indices have the usual meaning of antisymmetrizing with respect to the -indices inside the brackets, here without a factor two in the denominator) -\begin{subequations} -\begin{alignat}{2} - a_+ &= \; k_+ v_- + k v^* - k_- v_+ - k^* v & \; = & - \; 2 (k_{[3} v_{0]} + \ii k_{[2} v_{1]}) \\ - a_- &= \; k_- v_+ + k v^* - k_+ v_- - k^* v & \; = & - \; 2 (-k_{[3} v_{0]} + \ii k_{[2} v_{1]}) \\ - b_+ &= \; 2 (k_+ v - k v_+) & \; = & - \; 2 (k_{[0} v_{1]} + k_{[3} v_{1]} + \ii k_{[0} v_{2]} + \ii - k_{[3} v_{2]}) \\ - b_- &= \; 2 (k_- v - k v_-) & \; = & - \; 2 (k_{[0} v_{1]} - k_{[3} v_{1]} + \ii k_{[0} v_{2]} - \ii - k_{[3} v_{2]}) \\ - b_{+*} &= \; 2 (k_+ v^* - k^* v_+) & \; = & - \; 2 (k_{[0} v_{1]} + k_{[3} v_{1]} - \ii k_{[0} v_{2]} - \ii - k_{[3} v_{2]}) \\ - b_{-*} &= \; 2 (k_- v^* - k^* v_-) & \; = & - \; 2 (k_{[0} v_{1]} - k_{[3} v_{1]} - \ii k_{[0} v_{2]} + \ii - k_{[3} v_{2]}) -\end{alignat} -\end{subequations} -Of course, one could introduce a more advanced notation, but we don't want to -become confused. -\begin{subequations} -\begin{align} -\lbrack \fmslash{k} , \gamma^0 \rbrack &= - \begin{pmatrix} - -2k_3 & -2 k^* & 0 & 0 \\ - -2k & 2k_3 & 0 & 0 \\ - 0 & 0 & 2k_3 & 2k^* \\ - 0 & 0 & 2k & -2k_3 - \end{pmatrix} \\ -\lbrack \fmslash{k} , \gamma^1 \rbrack &= - \begin{pmatrix} - -2\ii k_2 & -2k_- & 0 & 0 \\ - -2k_+ & 2\ii k_2 & 0 & 0 \\ - 0 & 0 & -2\ii k_2 & 2k_+ \\ - 0 & 0 & 2k_- & 2\ii k_2 - \end{pmatrix} \\ -\lbrack \fmslash{k} , \gamma^2 \rbrack &= - \begin{pmatrix} - 2\ii k_1 & 2\ii k_- & 0 & 0 \\ - -2\ii k_+ & -2\ii k_1 & 0 & 0 \\ - 0 & 0 & 2\ii k_1 & -2\ii k_+ \\ - 0 & 0 & 2\ii k_- & -2\ii k_1 - \end{pmatrix} \\ -\lbrack \fmslash{k} , \gamma^3 \rbrack &= - \begin{pmatrix} - -2k_0 & -2k^* & 0 & 0 \\ - 2k & 2k_0 & 0 & 0 \\ - 0 & 0 & 2k_0 & -2k^* \\ - 0 & 0 & 2k & -2k_0 - \end{pmatrix} \\ -\lbrack \fmslash{k} , \fmslash{V} \rbrack &= - \begin{pmatrix} - a_- & b_{-*} & 0 & 0 \\ - b_+ & -a_- & 0 & 0 \\ - 0 & 0 & a_+ & -b_{+*} \\ - 0 & 0 & -b_- & -a_+ - \end{pmatrix} \\ - \gamma^5\gamma^0 \lbrack \fmslash{k} , \fmslash{V} \rbrack &= - \begin{pmatrix} - 0 & 0 & - a_+ & b_{+*} \\ - 0 & 0 & b_- & a_+ \\ - a_- & b_{-*} & 0 & 0 \\ - b_+ & - a_- & 0 & 0 - \end{pmatrix} \\ - \gamma^5\gamma^1 \lbrack \fmslash{k} , \fmslash{V} \rbrack &= - \begin{pmatrix} - 0 & 0 & b_- & a_+ \\ - 0 & 0 & -a_+ & b_{+*} \\ - -b_+ & a_- & 0 & 0 & \\ - -a_- & -b_{-*} & 0 & 0 - \end{pmatrix} \\ - \gamma^5\gamma^2 \lbrack \fmslash{k} , \fmslash{V} \rbrack &= - \begin{pmatrix} - 0 & 0 & -\ii b_- & -\ii a_+ \\ - 0 & 0 & -\ii a_+ & \ii b_{+*} \\ - \ii b_+ & -\ii a_- & 0 & 0 \\ - -\ii a_- & -\ii b_{-*} & 0 & 0 - \end{pmatrix} \\ - \gamma^5\gamma^3 \lbrack \fmslash{k} , \fmslash{V} \rbrack &= - \begin{pmatrix} - 0 & 0 & -a_+ & b_{+*} \\ - 0 & 0 & -b_- & -a_+ \\ - -a_- & -b_{-*} & 0 & 0 \\ - b_+ & -a_- & 0 & 0 - \end{pmatrix} -\end{align} -\end{subequations} -and -\begin{subequations} -\begin{align} - \lbrack \fmslash{k} , \fmslash{V} \rbrack \gamma^0 \gamma^5 &= - \begin{pmatrix} - 0 & 0 & a_- & b_{-*} \\ - 0 & 0 & b_+ & -a_- \\ - -a_+ & b_{+*} & 0 & 0 \\ - b_- & a_+ & 0 & 0 - \end{pmatrix} \\ - \lbrack \fmslash{k} , \fmslash{V} \rbrack \gamma^1 \gamma^5 &= - \begin{pmatrix} - 0 & 0 & b_{-*} & a_- \\ - 0 & 0 & -a_- & b_+ \\ - -b_{+*} & a_+ & 0 & 0 \\ - -a_+ & -b_- & 0 & 0 - \end{pmatrix} \\ - \lbrack \fmslash{k} , \fmslash{V} \rbrack \gamma^2 \gamma^5 &= - \begin{pmatrix} - 0 & 0 & \ii b_{-*} & -\ii a_- \\ - 0 & 0 & -\ii a_- & -\ii b_+ \\ - -\ii b_{+*} & -\ii a_+ & 0 & 0 \\ - -\ii a_+ & \ii b_- & 0 & 0 - \end{pmatrix} \\ - \lbrack \fmslash{k} , \fmslash{V} \rbrack \gamma^3 \gamma^5 &= - \begin{pmatrix} - 0 & 0 & a_- & - b_{-*} \\ - 0 & 0 & b_+ & a_- \\ - a_+ & b_{+*} & 0 & 0 \\ - -b_- & a_+ & 0 & 0 - \end{pmatrix} -\end{align} -\end{subequations} -In what follows $l$ always means twice the value of $k$, e.g. $l_+$ = -$2 k_+$. We use the abbreviation $C^{\mu\nu} \equiv C \lbrack -\fmslash{k}, \gamma^\mu \rbrack \gamma^\nu \gamma^5$. -\begin{subequations} -\begin{alignat}{2} - C^{00} &= \begin{pmatrix} - 0 & 0 & -l & -l_3 \\ 0 & 0 & l_3 & l^* \\ - l & -l_3 & 0 & 0 \\ -l_3 & -l^* & 0 & 0 \end{pmatrix} , & \qquad - C^{20} &= \begin{pmatrix} - 0 & 0 & -\ii l_+ & -\ii l_1 \\ 0 & 0 & -\ii l_1 & -\ii l_- \\ - \ii l_- & -\ii l_1 & 0 & 0 \\ -\ii l_1 & \ii l_+ & 0 & 0 - \end{pmatrix} \\ - C^{01} &= \begin{pmatrix} - 0 & 0 & l_3 & -l \\ 0 & 0 & l^* & l_3 \\ - l_3 & -l & 0 & 0 \\ l^* & l_3 & 0 & 0 \end{pmatrix} , & \qquad - C^{21} &= \begin{pmatrix} - 0 & 0 & -\ii l_1 & -\ii l_+ \\ 0 & 0 & -\ii l_- & -\ii l_1 \\ - \ii l_1 & -\ii l_- & 0 & 0 \\ -\ii l_+ & \ii l_1 & 0 & 0 - \end{pmatrix} \\ - C^{02} &= \begin{pmatrix} - 0 & 0 & \ii l_3 & \ii l \\ 0 & 0 & \ii l^* & -\ii l_3 \\ - \ii l_3 & \ii l & 0 & 0 \\ \ii l^* & -\ii l_3 & 0 & 0 \end{pmatrix} - , & \qquad - C^{22} &= \begin{pmatrix} - 0 & 0 & l_1 & -l_+ \\ 0 & 0 & l_- & -l_1 \\ - -l_1 & -l_- & 0 & 0 \\ l_+ & l_1 & 0 & 0 - \end{pmatrix} \\ - C^{03} &= \begin{pmatrix} - 0 & 0 & -l & -l_3 \\ 0 & 0 & l_3 & -l^* \\ - -l & -l_3 & 0 & 0 \\ l_3 & -l^* & 0 & 0 \end{pmatrix} , & \qquad - C^{23} &= \begin{pmatrix} - 0 & 0 & -\ii l_+ & \ii l_1 \\ 0 & 0 & -\ii l_1 & \ii l_- \\ - -\ii l_- & -\ii l_1 & 0 & 0 \\ \ii l_1 & \ii l_+ & 0 & 0 - \end{pmatrix} \\ - C^{10} &= \begin{pmatrix} - 0 & 0 & -l_+ & \ii l_2 \\ 0 & 0 & \ii l_2 & l_- \\ - l_- & \ii l_2 & 0 & 0 \\ \ii l_2 & -l_+ & 0 & 0 \end{pmatrix} , & - \qquad - C^{30} &= \begin{pmatrix} - 0 & 0 & l & l_0 \\ 0 & 0 & l_0 & l^* \\ - l & -l_0 & 0 & 0 \\ -l_0 & l^* & 0 & 0 - \end{pmatrix} \\ - C^{11} &= \begin{pmatrix} - 0 & 0 & \ii l_2 & -l_+ \\ 0 & 0 & l_- & \ii l_2 \\ - -\ii l_2 & -l_- & 0 & 0 \\ l_+ & -\ii l_2 & 0 & 0 \end{pmatrix} , & - \qquad - C^{31} &= \begin{pmatrix} - 0 & 0 & l_0 & l \\ 0 & 0 & l^* & l_0 \\ - l_0 & -l & 0 & 0 \\ -l^* & l_0 & 0 & 0 - \end{pmatrix} \\ - C^{12} &= \begin{pmatrix} - 0 & 0 & -l_2 & \ii l_+ \\ 0 & 0 & \ii l_- & l_2 \\ - l_2 & \ii l_- & 0 & 0 \\ \ii l_+ & -l_2 & 0 & 0 \end{pmatrix} , & - \qquad - C^{32} &= \begin{pmatrix} - 0 & 0 & \ii l_0 & -\ii l \\ 0 & 0 & \ii l^* & -\ii l_0 \\ - \ii l_0 & \ii l & 0 & 0 \\ -\ii l^* & -\ii l_0 & 0 & 0 - \end{pmatrix} \\ - C^{13} &= \begin{pmatrix} - 0 & 0 & -l_+ & -\ii l_2 \\ 0 & 0 & \ii l_2 & - l_- \\ - -l_- & \ii l_2 & 0 & 0 \\ -\ii l_2 & -l_+ & 0 & 0 \end{pmatrix} , & - \qquad - C^{33} &= \begin{pmatrix} - 0 & 0 & l & -l_0 \\ 0 & 0 & l_0 & -l^* \\ - -l & -l_0 & 0 & 0 \\ l_0 & l^* & 0 & 0 - \end{pmatrix} -\end{alignat} -\end{subequations} -and, with the abbreviation $\tilde{C}^{\mu\nu} \equiv C \gamma^5 -\gamma^\nu \lbrack \fmslash{k} , \gamma^\mu \rbrack$ (note the -reversed order of the indices!) -\begin{subequations} -\begin{alignat}{2} - \tilde{C}^{00} &= \begin{pmatrix} - 0 & 0 & -l & l_3 \\ 0 & 0 & l_3 & l^* \\ - l & -l_3 & 0 & 0 \\ -l_3 & -l^* & 0 & 0 \end{pmatrix} , & \qquad - \tilde{C}^{20} &= \begin{pmatrix} - 0 & 0 & -\ii l_- & \ii l_1 \\ 0 & 0 & \ii l_1 & -\ii l_+ \\ - \ii l_+ & \ii l_1 & 0 & 0 \\ \ii l_1 & \ii l_- & 0 & 0 - \end{pmatrix} \\ - \tilde{C}^{01} &= \begin{pmatrix} - 0 & 0 & -l_3 & -l^* \\ 0 & 0 & l & -l_3 \\ - -l_3 & -l^* & 0 & 0 \\ l & -l_3 & 0 & 0 \end{pmatrix} , & \qquad - \tilde{C}^{21} &= \begin{pmatrix} - 0 & 0 & -\ii l_1 & \ii l_+ \\ 0 & 0 & \ii l_- & -\ii l_1 \\ - \ii l_1 & \ii l_- & 0 & 0 \\ \ii l_+ & \ii l_1 & 0 & 0 - \end{pmatrix} \\ - \tilde{C}^{02} &= \begin{pmatrix} - 0 & 0 & -\ii l_3 & -\ii l^* \\ 0 & 0 & -\ii l & \ii l_3 \\ - -\ii l_3 & -\ii l^* & 0 & 0 \\ -\ii l & \ii l_3 & 0 & 0 - \end{pmatrix} , & \qquad - \tilde{C}^{22} &= \begin{pmatrix} - 0 & 0 & l_1 & -l_+ \\ 0 & 0 & l_- & -l_1 \\ - -l_1 & -l_- & 0 & 0 \\ l_+ & l_1 & 0 & 0 - \end{pmatrix} \\ - \tilde{C}^{03} &= \begin{pmatrix} - 0 & 0 & l & -l_3 \\ 0 & 0 & l_3 & l^* \\ - l & -l_3 & 0 & 0 \\ l_3 & l^* & 0 & 0 \end{pmatrix} , & \qquad - \tilde{C}^{23} &= \begin{pmatrix} - 0 & 0 & \ii l_- & -\ii l_1 \\ 0 & 0 & \ii l_1 & -\ii l_+ \\ - \ii l_+ & \ii l_1 & 0 & 0 \\ -\ii l_1 & -\ii l_- & 0 & 0 - \end{pmatrix} \\ - \tilde{C}^{10} &= \begin{pmatrix} - 0 & 0 & -l_- & -\ii l_2 \\ 0 & 0 & -\ii l_2 & l_+ \\ - l_+ & -\ii l_2 & 0 & 0 \\ -\ii l_2 & -l_- & 0 & 0 \end{pmatrix} , & - \qquad - \tilde{C}^{30} &= \begin{pmatrix} - 0 & 0 & -l & l_0 \\ 0 & 0 & l_0 & -l^* \\ - -l & -l_0 & 0 & 0 \\ -l_0 & -l^* & 0 & 0 - \end{pmatrix} \\ - \tilde{C}^{11} &= \begin{pmatrix} - 0 & 0 & \ii l_2 & -l_+ \\ 0 & 0 & l_- & \ii l_2 \\ - -\ii l_2 & -l_- & 0 & 0 \\ l_+ & -\ii l_2 & 0 & 0 \end{pmatrix} , & - \qquad - \tilde{C}^{31} &= \begin{pmatrix} - 0 & 0 & -l_0 & l^* \\ 0 & 0 & l & -l_0 \\ - -l_0 & -l^* & 0 & 0 \\ -l & -l_0 & 0 & 0 - \end{pmatrix} \\ - \tilde{C}^{12} &= \begin{pmatrix} - 0 & 0 & -l_2 & -\ii l_+ \\ 0 & 0 & -\ii l_- & l_2 \\ - l_2 & -\ii l_- & 0 & 0 \\ -\ii l_+ & -l_2 & 0 & 0 \end{pmatrix} , & - \qquad - \tilde{C}^{32} &= \begin{pmatrix} - 0 & 0 & -\ii l_0 & \ii l^* \\ 0 & 0 & -\ii l & \ii l_0 \\ - -\ii l_0 & -\ii l^* & 0 & 0 \\ \ii l & \ii l_0 & 0 & 0 - \end{pmatrix} \\ - \tilde{C}^{13} &= \begin{pmatrix} - 0 & 0 & l_- & \ii l_2 \\ 0 & 0 & -\ii l_2 & l_+ \\ - l_+ & -\ii l_2 & 0 & 0 \\ \ii l_2 & l_- & 0 & 0 \end{pmatrix} , & - \qquad - \tilde{C}^{33} &= \begin{pmatrix} - 0 & 0 & l & -l_0 \\ 0 & 0 & l_0 & -l^* \\ - -l & -l_0 & 0 & 0 \\ l_0 & l^* & 0 & 0 - \end{pmatrix} -\end{alignat} -\end{subequations} -\nwenddocs{}\nwbegincode{727}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function fggvvgr (v, psi, k) result (psikv) - type(bispinor) :: psikv - type(vectorspinor), intent(in) :: psi - type(vector), intent(in) :: v, k - complex(kind=default) :: kv30, kv21, kv01, kv31, kv02, kv32 - complex(kind=default) :: ap, am, bp, bm, bps, bms - kv30 = k%x(3) * v%t - k%t * v%x(3) - kv21 = (0,1) * (k%x(2) * v%x(1) - k%x(1) * v%x(2)) - kv01 = k%t * v%x(1) - k%x(1) * v%t - kv31 = k%x(3) * v%x(1) - k%x(1) * v%x(3) - kv02 = (0,1) * (k%t * v%x(2) - k%x(2) * v%t) - kv32 = (0,1) * (k%x(3) * v%x(2) - k%x(2) * v%x(3)) - ap = 2 * (kv30 + kv21) - am = 2 * (-kv30 + kv21) - bp = 2 * (kv01 + kv31 + kv02 + kv32) - bm = 2 * (kv01 - kv31 + kv02 - kv32) - bps = 2 * (kv01 + kv31 - kv02 - kv32) - bms = 2 * (kv01 - kv31 - kv02 + kv32) - psikv%a(1) = -ap * psi%psi(1)%a(3) + bps * psi%psi(1)%a(4) & - - bm * psi%psi(2)%a(3) - ap * psi%psi(2)%a(4) & - + (0,1) * (bm * psi%psi(3)%a(3) + ap * psi%psi(3)%a(4)) & - + ap * psi%psi(4)%a(3) - bps * psi%psi(4)%a(4) - psikv%a(2) = bm * psi%psi(1)%a(3) + ap * psi%psi(1)%a(4) & - + ap * psi%psi(2)%a(3) - bps * psi%psi(2)%a(4) & - + (0,1) * (ap * psi%psi(3)%a(3) - bps * psi%psi(3)%a(4)) & - + bm * psi%psi(4)%a(3) + ap * psi%psi(4)%a(4) - psikv%a(3) = am * psi%psi(1)%a(1) + bms * psi%psi(1)%a(2) & - + bp * psi%psi(2)%a(1) - am * psi%psi(2)%a(2) & - - (0,1) * (bp * psi%psi(3)%a(1) - am * psi%psi(3)%a(2)) & - + am * psi%psi(4)%a(1) + bms * psi%psi(4)%a(2) - psikv%a(4) = bp * psi%psi(1)%a(1) - am * psi%psi(1)%a(2) & - + am * psi%psi(2)%a(1) + bms * psi%psi(2)%a(2) & - + (0,1) * (am * psi%psi(3)%a(1) + bms * psi%psi(3)%a(2)) & - - bp * psi%psi(4)%a(1) + am * psi%psi(4)%a(2) -end function fggvvgr -\nwendcode{}\nwbegindocs{728}\nwdocspar -\nwenddocs{}\nwbegincode{729}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function f_vgr (g, v, psi, k) result (psikv) - type(bispinor) :: psikv - type(vectorspinor), intent(in) :: psi - type(vector), intent(in) :: v - type(momentum), intent(in) :: k - complex(kind=default), intent(in) :: g - type(vector) :: vk - vk = k - psikv = g * fggvvgr (v, psi, vk) -end function f_vgr -\nwendcode{}\nwbegindocs{730}\nwdocspar -\nwenddocs{}\nwbegincode{731}\moddef{Declaration of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -public :: gr_potf, gr_sf, gr_pf, gr_vf -\nwendcode{}\nwbegindocs{732}\nwdocspar -\nwenddocs{}\nwbegincode{733}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function gr_potf (g, phi, psi) result (phipsi) - type(vectorspinor) :: phipsi - complex(kind=default), intent(in) :: g - complex(kind=default), intent(in) :: phi - type(bispinor), intent(in) :: psi - phipsi%psi(1)%a(1) = (g * phi) * psi%a(3) - phipsi%psi(1)%a(2) = (g * phi) * psi%a(4) - phipsi%psi(1)%a(3) = (g * phi) * psi%a(1) - phipsi%psi(1)%a(4) = (g * phi) * psi%a(2) - phipsi%psi(2)%a(1) = (g * phi) * psi%a(4) - phipsi%psi(2)%a(2) = (g * phi) * psi%a(3) - phipsi%psi(2)%a(3) = (- g * phi) * psi%a(2) - phipsi%psi(2)%a(4) = (- g * phi) * psi%a(1) - phipsi%psi(3)%a(1) = (- (0, 1) * g * phi) * psi%a(4) - phipsi%psi(3)%a(2) = ((0, 1) * g * phi) * psi%a(3) - phipsi%psi(3)%a(3) = ((0, 1) * g * phi) * psi%a(2) - phipsi%psi(3)%a(4) = (- (0, 1) * g * phi) * psi%a(1) - phipsi%psi(4)%a(1) = (g * phi) * psi%a(3) - phipsi%psi(4)%a(2) = (- g * phi) * psi%a(4) - phipsi%psi(4)%a(3) = (- g * phi) * psi%a(1) - phipsi%psi(4)%a(4) = (g * phi) * psi%a(2) -end function gr_potf -\nwendcode{}\nwbegindocs{734}\nwdocspar -\nwenddocs{}\nwbegincode{735}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function grkgf (psi, k) result (kpsi) - type(vectorspinor) :: kpsi - complex(kind=default) :: kp, km, k12, k12s - type(bispinor), intent(in) :: psi - type(vector), intent(in) :: k - kp = k%t + k%x(3) - km = k%t - k%x(3) - k12 = k%x(1) + (0,1)*k%x(2) - k12s = k%x(1) - (0,1)*k%x(2) - kpsi%psi(1)%a(1) = km * psi%a(1) - k12s * psi%a(2) - kpsi%psi(1)%a(2) = - k12 * psi%a(1) + kp * psi%a(2) - kpsi%psi(1)%a(3) = kp * psi%a(3) + k12s * psi%a(4) - kpsi%psi(1)%a(4) = k12 * psi%a(3) + km * psi%a(4) - kpsi%psi(2)%a(1) = k12s * psi%a(1) - km * psi%a(2) - kpsi%psi(2)%a(2) = - kp * psi%a(1) + k12 * psi%a(2) - kpsi%psi(2)%a(3) = k12s * psi%a(3) + kp * psi%a(4) - kpsi%psi(2)%a(4) = km * psi%a(3) + k12 * psi%a(4) - kpsi%psi(3)%a(1) = (0,1) * (k12s * psi%a(1) + km * psi%a(2)) - kpsi%psi(3)%a(2) = (0,-1) * (kp * psi%a(1) + k12 * psi%a(2)) - kpsi%psi(3)%a(3) = (0,1) * (k12s * psi%a(3) - kp * psi%a(4)) - kpsi%psi(3)%a(4) = (0,1) * (km * psi%a(3) - k12 * psi%a(4)) - kpsi%psi(4)%a(1) = -(km * psi%a(1) + k12s * psi%a(2)) - kpsi%psi(4)%a(2) = k12 * psi%a(1) + kp * psi%a(2) - kpsi%psi(4)%a(3) = kp * psi%a(3) - k12s * psi%a(4) - kpsi%psi(4)%a(4) = k12 * psi%a(3) - km * psi%a(4) -end function grkgf -\nwendcode{}\nwbegindocs{736}\nwdocspar -\nwenddocs{}\nwbegincode{737}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function gr_sf (g, phi, psi, k) result (phipsi) - type(vectorspinor) :: phipsi - complex(kind=default), intent(in) :: g - complex(kind=default), intent(in) :: phi - type(bispinor), intent(in) :: psi - type(momentum), intent(in) :: k - type(vector) :: vk - vk = k - phipsi = (g * phi) * grkgf (psi, vk) -end function gr_sf -\nwendcode{}\nwbegindocs{738}\nwdocspar -\nwenddocs{}\nwbegincode{739}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function grkggf (psi, k) result (kpsi) - type(vectorspinor) :: kpsi - complex(kind=default) :: kp, km, k12, k12s - type(bispinor), intent(in) :: psi - type(vector), intent(in) :: k - kp = k%t + k%x(3) - km = k%t - k%x(3) - k12 = k%x(1) + (0,1)*k%x(2) - k12s = k%x(1) - (0,1)*k%x(2) - kpsi%psi(1)%a(1) = - km * psi%a(1) + k12s * psi%a(2) - kpsi%psi(1)%a(2) = k12 * psi%a(1) - kp * psi%a(2) - kpsi%psi(1)%a(3) = kp * psi%a(3) + k12s * psi%a(4) - kpsi%psi(1)%a(4) = k12 * psi%a(3) + km * psi%a(4) - kpsi%psi(2)%a(1) = - k12s * psi%a(1) + km * psi%a(2) - kpsi%psi(2)%a(2) = kp * psi%a(1) - k12 * psi%a(2) - kpsi%psi(2)%a(3) = k12s * psi%a(3) + kp * psi%a(4) - kpsi%psi(2)%a(4) = km * psi%a(3) + k12 * psi%a(4) - kpsi%psi(3)%a(1) = (0,-1) * (k12s * psi%a(1) + km * psi%a(2)) - kpsi%psi(3)%a(2) = (0,1) * (kp * psi%a(1) + k12 * psi%a(2)) - kpsi%psi(3)%a(3) = (0,1) * (k12s * psi%a(3) - kp * psi%a(4)) - kpsi%psi(3)%a(4) = (0,1) * (km * psi%a(3) - k12 * psi%a(4)) - kpsi%psi(4)%a(1) = km * psi%a(1) + k12s * psi%a(2) - kpsi%psi(4)%a(2) = -(k12 * psi%a(1) + kp * psi%a(2)) - kpsi%psi(4)%a(3) = kp * psi%a(3) - k12s * psi%a(4) - kpsi%psi(4)%a(4) = k12 * psi%a(3) - km * psi%a(4) -end function grkggf -\nwendcode{}\nwbegindocs{740}\nwdocspar -\nwenddocs{}\nwbegincode{741}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function gr_pf (g, phi, psi, k) result (phipsi) - type(vectorspinor) :: phipsi - complex(kind=default), intent(in) :: g - complex(kind=default), intent(in) :: phi - type(bispinor), intent(in) :: psi - type(momentum), intent(in) :: k - type(vector) :: vk - vk = k - phipsi = (g * phi) * grkggf (psi, vk) -end function gr_pf -\nwendcode{}\nwbegindocs{742}\nwdocspar -\nwenddocs{}\nwbegincode{743}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function grkkggf (v, psi, k) result (psikv) - type(vectorspinor) :: psikv - type(bispinor), intent(in) :: psi - type(vector), intent(in) :: v, k - complex(kind=default) :: kv30, kv21, kv01, kv31, kv02, kv32 - complex(kind=default) :: ap, am, bp, bm, bps, bms - kv30 = k%x(3) * v%t - k%t * v%x(3) - kv21 = (0,1) * (k%x(2) * v%x(1) - k%x(1) * v%x(2)) - kv01 = k%t * v%x(1) - k%x(1) * v%t - kv31 = k%x(3) * v%x(1) - k%x(1) * v%x(3) - kv02 = (0,1) * (k%t * v%x(2) - k%x(2) * v%t) - kv32 = (0,1) * (k%x(3) * v%x(2) - k%x(2) * v%x(3)) - ap = 2 * (kv30 + kv21) - am = 2 * (-kv30 + kv21) - bp = 2 * (kv01 + kv31 + kv02 + kv32) - bm = 2 * (kv01 - kv31 + kv02 - kv32) - bps = 2 * (kv01 + kv31 - kv02 - kv32) - bms = 2 * (kv01 - kv31 - kv02 + kv32) - psikv%psi(1)%a(1) = am * psi%a(3) + bms * psi%a(4) - psikv%psi(1)%a(2) = bp * psi%a(3) - am * psi%a(4) - psikv%psi(1)%a(3) = -ap * psi%a(1) + bps * psi%a(2) - psikv%psi(1)%a(4) = bm * psi%a(1) + ap * psi%a(2) - psikv%psi(2)%a(1) = bms * psi%a(3) + am * psi%a(4) - psikv%psi(2)%a(2) = -am * psi%a(3) + bp * psi%a(4) - psikv%psi(2)%a(3) = -bps * psi%a(1) + ap * psi%a(2) - psikv%psi(2)%a(4) = -ap * psi%a(1) - bm * psi%a(2) - psikv%psi(3)%a(1) = (0,1) * (bms * psi%a(3) - am * psi%a(4)) - psikv%psi(3)%a(2) = (0,-1) * (am * psi%a(3) + bp * psi%a(4)) - psikv%psi(3)%a(3) = (0,-1) * (bps * psi%a(1) + ap * psi%a(2)) - psikv%psi(3)%a(4) = (0,1) * (-ap * psi%a(1) + bm * psi%a(2)) - psikv%psi(4)%a(1) = am * psi%a(3) - bms * psi%a(4) - psikv%psi(4)%a(2) = bp * psi%a(3) + am * psi%a(4) - psikv%psi(4)%a(3) = ap * psi%a(1) + bps * psi%a(2) - psikv%psi(4)%a(4) = -bm * psi%a(1) + ap * psi%a(2) -end function grkkggf -\nwendcode{}\nwbegindocs{744}\nwdocspar -\nwenddocs{}\nwbegincode{745}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function gr_vf (g, v, psi, k) result (psikv) - type(vectorspinor) :: psikv - type(bispinor), intent(in) :: psi - type(vector), intent(in) :: v - type(momentum), intent(in) :: k - complex(kind=default), intent(in) :: g - type(vector) :: vk - vk = k - psikv = g * grkkggf (v, psi, vk) -end function gr_vf -\nwendcode{}\nwbegindocs{746}\nwdocspar -\nwenddocs{}\nwbegincode{747}\moddef{Declaration of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -public :: v_grf, v_fgr -\nwendcode{}\nwbegindocs{748}\nwdocspar -$V^\mu = \psi_\rho^T C^{\mu\rho} \psi$ -\nwenddocs{}\nwbegincode{749}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function grkgggf (psil, psir, k) result (j) - type(vector) :: j - type(vectorspinor), intent(in) :: psil - type(bispinor), intent(in) :: psir - type(vector), intent(in) :: k - type(vectorspinor) :: c_psir0, c_psir1, c_psir2, c_psir3 - complex(kind=default) :: kp, km, k12, k12s, ik2 - kp = k%t + k%x(3) - km = k%t - k%x(3) - k12 = k%x(1) + (0,1)*k%x(2) - k12s = k%x(1) - (0,1)*k%x(2) - ik2 = (0,1) * k%x(2) - !!! New version: - c_psir0%psi(1)%a(1) = - k%x(3) * psir%a(3) - k12s * psir%a(4) - c_psir0%psi(1)%a(2) = - k12 * psir%a(3) + k%x(3) * psir%a(4) - c_psir0%psi(1)%a(3) = - k%x(3) * psir%a(1) - k12s * psir%a(2) - c_psir0%psi(1)%a(4) = - k12 * psir%a(1) + k%x(3) * psir%a(2) - c_psir0%psi(2)%a(1) = - k12s * psir%a(3) - k%x(3) * psir%a(4) - c_psir0%psi(2)%a(2) = k%x(3) * psir%a(3) - k12 * psir%a(4) - c_psir0%psi(2)%a(3) = k12s * psir%a(1) + k%x(3) * psir%a(2) - c_psir0%psi(2)%a(4) = - k%x(3) * psir%a(1) + k12 * psir%a(2) - c_psir0%psi(3)%a(1) = (0,1) * (- k12s * psir%a(3) + k%x(3) * psir%a(4)) - c_psir0%psi(3)%a(2) = (0,1) * (k%x(3) * psir%a(3) + k12 * psir%a(4)) - c_psir0%psi(3)%a(3) = (0,1) * (k12s * psir%a(1) - k%x(3) * psir%a(2)) - c_psir0%psi(3)%a(4) = (0,1) * (- k%x(3) * psir%a(1) - k12 * psir%a(2)) - c_psir0%psi(4)%a(1) = - k%x(3) * psir%a(3) + k12s * psir%a(4) - c_psir0%psi(4)%a(2) = - k12 * psir%a(3) - k%x(3) * psir%a(4) - c_psir0%psi(4)%a(3) = k%x(3) * psir%a(1) - k12s * psir%a(2) - c_psir0%psi(4)%a(4) = k12 * psir%a(1) + k%x(3) * psir%a(2) - !!! - c_psir1%psi(1)%a(1) = - ik2 * psir%a(3) - km * psir%a(4) - c_psir1%psi(1)%a(2) = - kp * psir%a(3) + ik2 * psir%a(4) - c_psir1%psi(1)%a(3) = ik2 * psir%a(1) - kp * psir%a(2) - c_psir1%psi(1)%a(4) = - km * psir%a(1) - ik2 * psir%a(2) - c_psir1%psi(2)%a(1) = - km * psir%a(3) - ik2 * psir%a(4) - c_psir1%psi(2)%a(2) = ik2 * psir%a(3) - kp * psir%a(4) - c_psir1%psi(2)%a(3) = kp * psir%a(1) - ik2 * psir%a(2) - c_psir1%psi(2)%a(4) = ik2 * psir%a(1) + km * psir%a(2) - c_psir1%psi(3)%a(1) = ((0,-1) * km) * psir%a(3) - k%x(2) * psir%a(4) - c_psir1%psi(3)%a(2) = - k%x(2) * psir%a(3) + ((0,1) * kp) * psir%a(4) - c_psir1%psi(3)%a(3) = ((0,1) * kp) * psir%a(1) - k%x(2) * psir%a(2) - c_psir1%psi(3)%a(4) = - k%x(2) * psir%a(1) - ((0,1) * km) * psir%a(2) - c_psir1%psi(4)%a(1) = - ik2 * psir%a(3) + km * psir%a(4) - c_psir1%psi(4)%a(2) = - kp * psir%a(3) - ik2 * psir%a(4) - c_psir1%psi(4)%a(3) = - ik2 * psir%a(1) - kp * psir%a(2) - c_psir1%psi(4)%a(4) = km * psir%a(1) - ik2 * psir%a(2) - !!! - c_psir2%psi(1)%a(1) = (0,1) * (k%x(1) * psir%a(3) + km * psir%a(4)) - c_psir2%psi(1)%a(2) = (0,-1) * (kp * psir%a(3) + k%x(1) * psir%a(4)) - c_psir2%psi(1)%a(3) = (0,1) * (-k%x(1) * psir%a(1) + kp * psir%a(2)) - c_psir2%psi(1)%a(4) = (0,1) * (- km * psir%a(1) + k%x(1) * psir%a(2)) - c_psir2%psi(2)%a(1) = (0,1) * (km * psir%a(3) + k%x(1) * psir%a(4)) - c_psir2%psi(2)%a(2) = (0,-1) * (k%x(1) * psir%a(3) + kp * psir%a(4)) - c_psir2%psi(2)%a(3) = (0,-1) * (kp * psir%a(1) - k%x(1) * psir%a(2)) - c_psir2%psi(2)%a(4) = (0,-1) * (k%x(1) * psir%a(1) - km * psir%a(2)) - c_psir2%psi(3)%a(1) = - km * psir%a(3) + k%x(1) * psir%a(4) - c_psir2%psi(3)%a(2) = k%x(1) * psir%a(3) - kp * psir%a(4) - c_psir2%psi(3)%a(3) = kp * psir%a(1) + k%x(1) * psir%a(2) - c_psir2%psi(3)%a(4) = k%x(1) * psir%a(1) + km * psir%a(2) - c_psir2%psi(4)%a(1) = (0,1) * (k%x(1) * psir%a(3) - km * psir%a(4)) - c_psir2%psi(4)%a(2) = (0,1) * (- kp * psir%a(3) + k%x(1) * psir%a(4)) - c_psir2%psi(4)%a(3) = (0,1) * (k%x(1) * psir%a(1) + kp * psir%a(2)) - c_psir2%psi(4)%a(4) = (0,1) * (km * psir%a(1) + k%x(1) * psir%a(2)) - !!! - c_psir3%psi(1)%a(1) = - k%t * psir%a(3) - k12s * psir%a(4) - c_psir3%psi(1)%a(2) = k12 * psir%a(3) + k%t * psir%a(4) - c_psir3%psi(1)%a(3) = - k%t * psir%a(1) + k12s * psir%a(2) - c_psir3%psi(1)%a(4) = - k12 * psir%a(1) + k%t * psir%a(2) - c_psir3%psi(2)%a(1) = - k12s * psir%a(3) - k%t * psir%a(4) - c_psir3%psi(2)%a(2) = k%t * psir%a(3) + k12 * psir%a(4) - c_psir3%psi(2)%a(3) = - k12s * psir%a(1) + k%t * psir%a(2) - c_psir3%psi(2)%a(4) = - k%t * psir%a(1) + k12 * psir%a(2) - c_psir3%psi(3)%a(1) = (0,-1) * (k12s * psir%a(3) - k%t * psir%a(4)) - c_psir3%psi(3)%a(2) = (0,1) * (k%t * psir%a(3) - k12 * psir%a(4)) - c_psir3%psi(3)%a(3) = (0,-1) * (k12s * psir%a(1) + k%t * psir%a(2)) - c_psir3%psi(3)%a(4) = (0,-1) * (k%t * psir%a(1) + k12 * psir%a(2)) - c_psir3%psi(4)%a(1) = - k%t * psir%a(3) + k12s * psir%a(4) - c_psir3%psi(4)%a(2) = k12 * psir%a(3) - k%t * psir%a(4) - c_psir3%psi(4)%a(3) = k%t * psir%a(1) + k12s * psir%a(2) - c_psir3%psi(4)%a(4) = k12 * psir%a(1) + k%t * psir%a(2) - j%t = 2 * (psil * c_psir0) - j%x(1) = 2 * (psil * c_psir1) - j%x(2) = 2 * (psil * c_psir2) - j%x(3) = 2 * (psil * c_psir3) -end function grkgggf -\nwendcode{}\nwbegindocs{750}\nwdocspar -\nwenddocs{}\nwbegincode{751}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function v_grf (g, psil, psir, k) result (j) - type(vector) :: j - complex(kind=default), intent(in) :: g - type(vectorspinor), intent(in) :: psil - type(bispinor), intent(in) :: psir - type(momentum), intent(in) :: k - type(vector) :: vk - vk = k - j = g * grkgggf (psil, psir, vk) -end function v_grf -\nwendcode{}\nwbegindocs{752}\nwdocspar -$V^\mu = \psi^T \tilde{C}^{\mu\rho} \psi_\rho$; remember the reversed -index order in $\tilde{C}$. -\nwenddocs{}\nwbegincode{753}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function fggkggr (psil, psir, k) result (j) - type(vector) :: j - type(vectorspinor), intent(in) :: psir - type(bispinor), intent(in) :: psil - type(vector), intent(in) :: k - type(bispinor) :: c_psir0, c_psir1, c_psir2, c_psir3 - complex(kind=default) :: kp, km, k12, k12s, ik1, ik2 - kp = k%t + k%x(3) - km = k%t - k%x(3) - k12 = k%x(1) + (0,1)*k%x(2) - k12s = k%x(1) - (0,1)*k%x(2) - ik1 = (0,1) * k%x(1) - ik2 = (0,1) * k%x(2) - c_psir0%a(1) = k%x(3) * (psir%psi(1)%a(4) + psir%psi(4)%a(4) & - + psir%psi(2)%a(3) + (0,1) * psir%psi(3)%a(3)) - & - k12 * (psir%psi(1)%a(3) + psir%psi(4)%a(3)) + & - k12s * (psir%psi(2)%a(4) + (0,1) * psir%psi(3)%a(4)) - c_psir0%a(2) = k%x(3) * (psir%psi(1)%a(3) - psir%psi(4)%a(3) + & - psir%psi(2)%a(4) - (0,1) * psir%psi(3)%a(4)) + & - k12s * (psir%psi(1)%a(4) - psir%psi(4)%a(4)) - & - k12 * (psir%psi(2)%a(3) - (0,1) * psir%psi(3)%a(3)) - c_psir0%a(3) = k%x(3) * (-psir%psi(1)%a(2) + psir%psi(4)%a(2) + & - psir%psi(2)%a(1) + (0,1) * psir%psi(3)%a(1)) + & - k12 * (psir%psi(1)%a(1) - psir%psi(4)%a(1)) + & - k12s * (psir%psi(2)%a(2) + (0,1) * psir%psi(3)%a(2)) - c_psir0%a(4) = k%x(3) * (-psir%psi(1)%a(1) - psir%psi(4)%a(1) + & - psir%psi(2)%a(2) - (0,1) * psir%psi(3)%a(2)) - & - k12s * (psir%psi(1)%a(2) + psir%psi(4)%a(2)) - & - k12 * (psir%psi(2)%a(1) - (0,1) * psir%psi(3)%a(1)) - !!! - c_psir1%a(1) = ik2 * (-psir%psi(1)%a(4) - psir%psi(4)%a(4) - & - psir%psi(2)%a(3) - (0,1) * psir%psi(3)%a(3)) - & - km * (psir%psi(1)%a(3) + psir%psi(4)%a(3)) + & - kp * (psir%psi(2)%a(4) + (0,1) * psir%psi(3)%a(4)) - c_psir1%a(2) = ik2 * (-psir%psi(1)%a(3) - psir%psi(2)%a(4) + & - psir%psi(4)%a(3) + (0,1) * psir%psi(3)%a(4)) + & - kp * (psir%psi(1)%a(4) - psir%psi(4)%a(4)) - & - km * (psir%psi(2)%a(3) - (0,1) * psir%psi(3)%a(3)) - c_psir1%a(3) = ik2 * (-psir%psi(1)%a(2) + psir%psi(2)%a(1) + & - psir%psi(4)%a(2) + (0,1) * psir%psi(3)%a(1)) + & - kp * (psir%psi(1)%a(1) - psir%psi(4)%a(1)) + & - km * (psir%psi(2)%a(2) + (0,1) * psir%psi(3)%a(2)) - c_psir1%a(4) = ik2 * (-psir%psi(1)%a(1) + psir%psi(2)%a(2) - & - psir%psi(4)%a(1) - (0,1) * psir%psi(3)%a(2)) - & - km * (psir%psi(1)%a(2) + psir%psi(4)%a(2)) - & - kp * (psir%psi(2)%a(1) - (0,1) * psir%psi(3)%a(1)) - !!! - c_psir2%a(1) = ik1 * (psir%psi(2)%a(3) + psir%psi(1)%a(4) & - + psir%psi(4)%a(4) + (0,1) * psir%psi(3)%a(3)) - & - ((0,1)*km) * (psir%psi(1)%a(3) + psir%psi(4)%a(3)) & - + kp * (psir%psi(3)%a(4) - (0,1) * psir%psi(2)%a(4)) - c_psir2%a(2) = ik1 * (psir%psi(1)%a(3) + psir%psi(2)%a(4) - & - psir%psi(4)%a(3) - (0,1) * psir%psi(3)%a(4)) - & - ((0,1)*kp) * (psir%psi(1)%a(4) - psir%psi(4)%a(4)) & - - km * (psir%psi(3)%a(3) + (0,1) * psir%psi(2)%a(3)) - c_psir2%a(3) = ik1 * (psir%psi(1)%a(2) - psir%psi(2)%a(1) - & - psir%psi(4)%a(2) - (0,1) * psir%psi(3)%a(1)) + & - ((0,1)*kp) * (psir%psi(1)%a(1) - psir%psi(4)%a(1)) & - + km * (psir%psi(3)%a(2) - (0,1) * psir%psi(2)%a(2)) - c_psir2%a(4) = ik1 * (psir%psi(1)%a(1) - psir%psi(2)%a(2) + & - psir%psi(4)%a(1) + (0,1) * psir%psi(3)%a(2)) + & - ((0,1)*km) * (psir%psi(1)%a(2) + psir%psi(4)%a(2)) - & - kp * (psir%psi(3)%a(1) + (0,1) * psir%psi(2)%a(1)) - !!! - c_psir3%a(1) = k%t * (psir%psi(1)%a(4) + psir%psi(4)%a(4) + & - psir%psi(2)%a(3) + (0,1) * psir%psi(3)%a(3)) - & - k12 * (psir%psi(1)%a(3) + psir%psi(4)%a(3)) - & - k12s * (psir%psi(2)%a(4) + (0,1) * psir%psi(3)%a(4)) - c_psir3%a(2) = k%t * (psir%psi(1)%a(3) - psir%psi(4)%a(3) + & - psir%psi(2)%a(4) - (0,1) * psir%psi(3)%a(4)) - & - k12s * (psir%psi(1)%a(4) - psir%psi(4)%a(4)) - & - k12 * (psir%psi(2)%a(3) - (0,1) * psir%psi(3)%a(3)) - c_psir3%a(3) = k%t * (-psir%psi(1)%a(2) + psir%psi(2)%a(1) + & - psir%psi(4)%a(2) + (0,1) * psir%psi(3)%a(1)) - & - k12 * (psir%psi(1)%a(1) - psir%psi(4)%a(1)) + & - k12s * (psir%psi(2)%a(2) + (0,1) * psir%psi(3)%a(2)) - c_psir3%a(4) = k%t * (-psir%psi(1)%a(1) + psir%psi(2)%a(2) - & - psir%psi(4)%a(1) - (0,1) * psir%psi(3)%a(2)) - & - k12s * (psir%psi(1)%a(2) + psir%psi(4)%a(2)) + & - k12 * (psir%psi(2)%a(1) - (0,1) * psir%psi(3)%a(1)) - !!! Because we explicitly multiplied the charge conjugation matrix - !!! we have to omit it from the spinor product and take the - !!! ordinary product! - j%t = 2 * dot_product (conjg (psil%a), c_psir0%a) - j%x(1) = 2 * dot_product (conjg (psil%a), c_psir1%a) - j%x(2) = 2 * dot_product (conjg (psil%a), c_psir2%a) - j%x(3) = 2 * dot_product (conjg (psil%a), c_psir3%a) -end function fggkggr -\nwendcode{}\nwbegindocs{754}\nwdocspar -\nwenddocs{}\nwbegincode{755}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function v_fgr (g, psil, psir, k) result (j) - type(vector) :: j - complex(kind=default), intent(in) :: g - type(vectorspinor), intent(in) :: psir - type(bispinor), intent(in) :: psil - type(momentum), intent(in) :: k - type(vector) :: vk - vk = k - j = g * fggkggr (psil, psir, vk) -end function v_fgr -\nwendcode{}\nwbegindocs{756}\subsection{Gravitino 4-Couplings} -\nwenddocs{}\nwbegincode{757}\moddef{Declaration of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -public :: f_s2gr, f_svgr, f_pvgr, f_v2gr -\nwendcode{}\nwbegindocs{758}\nwdocspar -\nwenddocs{}\nwbegincode{759}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function f_s2gr (g, phi1, phi2, psi) result (phipsi) - type(bispinor) :: phipsi - type(vectorspinor), intent(in) :: psi - complex(kind=default), intent(in) :: g - complex(kind=default), intent(in) :: phi1, phi2 - phipsi = phi2 * f_potgr (g, phi1, psi) -end function f_s2gr -\nwendcode{}\nwbegindocs{760}\nwdocspar -\nwenddocs{}\nwbegincode{761}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function f_svgr (g, phi, v, grav) result (phigrav) - type(bispinor) :: phigrav - type(vectorspinor), intent(in) :: grav - type(vector), intent(in) :: v - complex(kind=default), intent(in) :: g, phi - phigrav = (g * phi) * fgvg5gr (grav, v) -end function f_svgr -\nwendcode{}\nwbegindocs{762}\nwdocspar -\nwenddocs{}\nwbegincode{763}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function f_pvgr (g, phi, v, grav) result (phigrav) - type(bispinor) :: phigrav - type(vectorspinor), intent(in) :: grav - type(vector), intent(in) :: v - complex(kind=default), intent(in) :: g, phi - phigrav = (g * phi) * fgvgr (grav, v) -end function f_pvgr -\nwendcode{}\nwbegindocs{764}\nwdocspar -\nwenddocs{}\nwbegincode{765}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function f_v2gr (g, v1, v2, grav) result (psi) - type(bispinor) :: psi - complex(kind=default), intent(in) :: g - type(vectorspinor), intent(in) :: grav - type(vector), intent(in) :: v1, v2 - psi = g * fggvvgr (v2, grav, v1) -end function f_v2gr -\nwendcode{}\nwbegindocs{766}\nwdocspar -\nwenddocs{}\nwbegincode{767}\moddef{Declaration of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -public :: gr_s2f, gr_svf, gr_pvf, gr_v2f -\nwendcode{}\nwbegindocs{768}\nwdocspar -\nwenddocs{}\nwbegincode{769}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function gr_s2f (g, phi1, phi2, psi) result (phipsi) - type(vectorspinor) :: phipsi - type(bispinor), intent(in) :: psi - complex(kind=default), intent(in) :: g - complex(kind=default), intent(in) :: phi1, phi2 - phipsi = phi2 * gr_potf (g, phi1, psi) -end function gr_s2f -\nwendcode{}\nwbegindocs{770}\nwdocspar -\nwenddocs{}\nwbegincode{771}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function gr_svf (g, phi, v, psi) result (phipsi) - type(vectorspinor) :: phipsi - type(bispinor), intent(in) :: psi - type(vector), intent(in) :: v - complex(kind=default), intent(in) :: g, phi - phipsi = (g * phi) * grkggf (psi, v) -end function gr_svf -\nwendcode{}\nwbegindocs{772}\nwdocspar -\nwenddocs{}\nwbegincode{773}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function gr_pvf (g, phi, v, psi) result (phipsi) - type(vectorspinor) :: phipsi - type(bispinor), intent(in) :: psi - type(vector), intent(in) :: v - complex(kind=default), intent(in) :: g, phi - phipsi = (g * phi) * grkgf (psi, v) -end function gr_pvf -\nwendcode{}\nwbegindocs{774}\nwdocspar -\nwenddocs{}\nwbegincode{775}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function gr_v2f (g, v1, v2, psi) result (vvpsi) - type(vectorspinor) :: vvpsi - complex(kind=default), intent(in) :: g - type(bispinor), intent(in) :: psi - type(vector), intent(in) :: v1, v2 - vvpsi = g * grkkggf (v2, psi, v1) -end function gr_v2f -\nwendcode{}\nwbegindocs{776}\nwdocspar -\nwenddocs{}\nwbegincode{777}\moddef{Declaration of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -public :: s2_grf, s2_fgr, sv1_grf, sv2_grf, sv1_fgr, sv2_fgr, & - pv1_grf, pv2_grf, pv1_fgr, pv2_fgr, v2_grf, v2_fgr -\nwendcode{}\nwbegindocs{778}\nwdocspar -\nwenddocs{}\nwbegincode{779}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function s2_grf (g, gravbar, phi, psi) result (j) - complex(kind=default) :: j - complex(kind=default), intent(in) :: g, phi - type(vectorspinor), intent(in) :: gravbar - type(bispinor), intent(in) :: psi - j = phi * pot_grf (g, gravbar, psi) -end function s2_grf -\nwendcode{}\nwbegindocs{780}\nwdocspar -\nwenddocs{}\nwbegincode{781}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function s2_fgr (g, psibar, phi, grav) result (j) - complex(kind=default) :: j - complex(kind=default), intent(in) :: g, phi - type(bispinor), intent(in) :: psibar - type(vectorspinor), intent(in) :: grav - j = phi * pot_fgr (g, psibar, grav) -end function s2_fgr -\nwendcode{}\nwbegindocs{782}\nwdocspar -\nwenddocs{}\nwbegincode{783}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function sv1_grf (g, gravbar, v, psi) result (j) - complex(kind=default) :: j - complex(kind=default), intent(in) :: g - type(vectorspinor), intent(in) :: gravbar - type(bispinor), intent(in) :: psi - type(vector), intent(in) :: v - j = g * grg5vgf (gravbar, psi, v) -end function sv1_grf -\nwendcode{}\nwbegindocs{784}\nwdocspar -\begin{subequations} -\begin{align} - C \gamma^0 \gamma^0 = - C \gamma^1 \gamma^1 = - C \gamma^2 \gamma^2 - = C \gamma^3 \gamma^3 = C &= \begin{pmatrix} - 0 & 1 & 0 & 0 \\ -1 & 0 & 0 & 0 \\ 0 & 0 & 0 & -1 \\ 0 & 0 & 1 & 0 - \end{pmatrix} \\ - C \gamma^0 \gamma^1 = - C \gamma^1 \gamma^0 &= \begin{pmatrix} - -1 & 0 & 0 & 0 \\ 0 & 1 & 0 & 0 \\ 0 & 0 & -1 & 0 \\ 0 & 0 & 0 & 1 - \end{pmatrix} \\ - C \gamma^0 \gamma^2 = - C \gamma^2 \gamma^0 &= \begin{pmatrix} - -\ii & 0 & 0 & 0 \\ 0 & -\ii & 0 & 0 \\ 0 & 0 & -\ii & 0 \\ 0 & 0 & - 0 & -\ii \end{pmatrix} \\ - C \gamma^0 \gamma^3 = - C \gamma^3 \gamma^0 &= \begin{pmatrix} - 0 & 1 & 0 & 0 \\ 1 & 0 & 0 & 0 \\ 0 & 0 & 0 & 1 \\ 0 & 0 & 1 & 0 - \end{pmatrix} \\ - C \gamma^1 \gamma^2 = - C \gamma^2 \gamma^1 &= \begin{pmatrix} - 0 & \ii & 0 & 0 \\ \ii & 0 & 0 & 0 \\ 0 & 0 & 0 & -\ii \\ 0 & 0 & - -\ii & 0 \end{pmatrix} \\ - C \gamma^1 \gamma^3 = - C \gamma^3 \gamma^1 &= \begin{pmatrix} - -1 & 0 & 0 & 0 \\ 0 & -1 & 0 & 0 \\ 0 & 0 & 1 & 0 \\ 0 & 0 & 0 & 1 - \end{pmatrix} \\ - C \gamma^2 \gamma^3 = - C \gamma^3 \gamma^2 &= \begin{pmatrix} - -\ii & 0 & 0 & 0 \\ 0 & \ii & 0 & 0 \\ 0 & 0 & \ii & 0 \\ 0 & 0 & 0 - & -\ii \end{pmatrix} -\end{align} -\end{subequations} -\nwenddocs{}\nwbegindocs{785}\nwdocspar -\nwenddocs{}\nwbegincode{786}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function sv2_grf (g, gravbar, phi, psi) result (j) - type(vector) :: j - complex(kind=default), intent(in) :: g, phi - type(vectorspinor), intent(in) :: gravbar - type(bispinor), intent(in) :: psi - type(vectorspinor) :: g0_psi, g1_psi, g2_psi, g3_psi - g0_psi%psi(1)%a(1:2) = - psi%a(1:2) - g0_psi%psi(1)%a(3:4) = psi%a(3:4) - g0_psi%psi(2)%a(1) = psi%a(2) - g0_psi%psi(2)%a(2) = psi%a(1) - g0_psi%psi(2)%a(3) = psi%a(4) - g0_psi%psi(2)%a(4) = psi%a(3) - g0_psi%psi(3)%a(1) = (0,-1) * psi%a(2) - g0_psi%psi(3)%a(2) = (0,1) * psi%a(1) - g0_psi%psi(3)%a(3) = (0,-1) * psi%a(4) - g0_psi%psi(3)%a(4) = (0,1) * psi%a(3) - g0_psi%psi(4)%a(1) = psi%a(1) - g0_psi%psi(4)%a(2) = - psi%a(2) - g0_psi%psi(4)%a(3) = psi%a(3) - g0_psi%psi(4)%a(4) = - psi%a(4) - g1_psi%psi(1)%a(1:4) = - g0_psi%psi(2)%a(1:4) - g1_psi%psi(2)%a(1:4) = - g0_psi%psi(1)%a(1:4) - g1_psi%psi(3)%a(1) = (0,1) * psi%a(1) - g1_psi%psi(3)%a(2) = (0,-1) * psi%a(2) - g1_psi%psi(3)%a(3) = (0,-1) * psi%a(3) - g1_psi%psi(3)%a(4) = (0,1) * psi%a(4) - g1_psi%psi(4)%a(1) = - psi%a(2) - g1_psi%psi(4)%a(2) = psi%a(1) - g1_psi%psi(4)%a(3) = psi%a(4) - g1_psi%psi(4)%a(4) = - psi%a(3) - g2_psi%psi(1)%a(1:4) = - g0_psi%psi(3)%a(1:4) - g2_psi%psi(2)%a(1:4) = - g1_psi%psi(3)%a(1:4) - g2_psi%psi(3)%a(1:4) = - g0_psi%psi(1)%a(1:4) - g2_psi%psi(4)%a(1) = (0,1) * psi%a(2) - g2_psi%psi(4)%a(2) = (0,1) * psi%a(1) - g2_psi%psi(4)%a(3) = (0,-1) * psi%a(4) - g2_psi%psi(4)%a(4) = (0,-1) * psi%a(3) - g3_psi%psi(1)%a(1:4) = - g0_psi%psi(4)%a(1:4) - g3_psi%psi(2)%a(1:4) = - g1_psi%psi(4)%a(1:4) - g3_psi%psi(3)%a(1:4) = - g2_psi%psi(4)%a(1:4) - g3_psi%psi(4)%a(1:4) = - g0_psi%psi(1)%a(1:4) - j%t = (g * phi) * (gravbar * g0_psi) - j%x(1) = (g * phi) * (gravbar * g1_psi) - j%x(2) = (g * phi) * (gravbar * g2_psi) - j%x(3) = (g * phi) * (gravbar * g3_psi) -end function sv2_grf -\nwendcode{}\nwbegindocs{787}\nwdocspar -\nwenddocs{}\nwbegincode{788}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function sv1_fgr (g, psibar, v, grav) result (j) - complex(kind=default) :: j - complex(kind=default), intent(in) :: g - type(bispinor), intent(in) :: psibar - type(vectorspinor), intent(in) :: grav - type(vector), intent(in) :: v - j = g * fg5gkgr (psibar, grav, v) -end function sv1_fgr -\nwendcode{}\nwbegindocs{789}\nwdocspar -\nwenddocs{}\nwbegincode{790}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function sv2_fgr (g, psibar, phi, grav) result (j) - type(vector) :: j - complex(kind=default), intent(in) :: g, phi - type(bispinor), intent(in) :: psibar - type(vectorspinor), intent(in) :: grav - type(bispinor) :: g0_grav, g1_grav, g2_grav, g3_grav - g0_grav%a(1) = -grav%psi(1)%a(1) + grav%psi(2)%a(2) - & - (0,1) * grav%psi(3)%a(2) + grav%psi(4)%a(1) - g0_grav%a(2) = -grav%psi(1)%a(2) + grav%psi(2)%a(1) + & - (0,1) * grav%psi(3)%a(1) - grav%psi(4)%a(2) - g0_grav%a(3) = grav%psi(1)%a(3) + grav%psi(2)%a(4) - & - (0,1) * grav%psi(3)%a(4) + grav%psi(4)%a(3) - g0_grav%a(4) = grav%psi(1)%a(4) + grav%psi(2)%a(3) + & - (0,1) * grav%psi(3)%a(3) - grav%psi(4)%a(4) - !!! - g1_grav%a(1) = grav%psi(1)%a(2) - grav%psi(2)%a(1) + & - (0,1) * grav%psi(3)%a(1) - grav%psi(4)%a(2) - g1_grav%a(2) = grav%psi(1)%a(1) - grav%psi(2)%a(2) - & - (0,1) * grav%psi(3)%a(2) + grav%psi(4)%a(1) - g1_grav%a(3) = grav%psi(1)%a(4) + grav%psi(2)%a(3) - & - (0,1) * grav%psi(3)%a(3) + grav%psi(4)%a(4) - g1_grav%a(4) = grav%psi(1)%a(3) + grav%psi(2)%a(4) + & - (0,1) * grav%psi(3)%a(4) - grav%psi(4)%a(3) - !!! - g2_grav%a(1) = (0,1) * (-grav%psi(1)%a(2) - grav%psi(2)%a(1) + & - grav%psi(4)%a(2)) - grav%psi(3)%a(1) - g2_grav%a(2) = (0,1) * (grav%psi(1)%a(1) + grav%psi(2)%a(2) + & - grav%psi(4)%a(1)) - grav%psi(3)%a(2) - g2_grav%a(3) = (0,1) * (-grav%psi(1)%a(4) + grav%psi(2)%a(3) - & - grav%psi(4)%a(4)) + grav%psi(3)%a(3) - g2_grav%a(4) = (0,1) * (grav%psi(1)%a(3) - grav%psi(2)%a(4) - & - grav%psi(4)%a(3)) + grav%psi(3)%a(4) - !!! - g3_grav%a(1) = -grav%psi(1)%a(2) + grav%psi(2)%a(2) - & - (0,1) * grav%psi(3)%a(2) - grav%psi(4)%a(1) - g3_grav%a(2) = grav%psi(1)%a(1) - grav%psi(2)%a(1) - & - (0,1) * grav%psi(3)%a(1) - grav%psi(4)%a(2) - g3_grav%a(3) = -grav%psi(1)%a(2) - grav%psi(2)%a(4) + & - (0,1) * grav%psi(3)%a(4) + grav%psi(4)%a(3) - g3_grav%a(4) = -grav%psi(1)%a(4) + grav%psi(2)%a(3) + & - (0,1) * grav%psi(3)%a(3) + grav%psi(4)%a(4) - j%t = (g * phi) * (psibar * g0_grav) - j%x(1) = (g * phi) * (psibar * g1_grav) - j%x(2) = (g * phi) * (psibar * g2_grav) - j%x(3) = (g * phi) * (psibar * g3_grav) -end function sv2_fgr -\nwendcode{}\nwbegindocs{791}\nwdocspar -\nwenddocs{}\nwbegincode{792}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function pv1_grf (g, gravbar, v, psi) result (j) - complex(kind=default) :: j - complex(kind=default), intent(in) :: g - type(vectorspinor), intent(in) :: gravbar - type(bispinor), intent(in) :: psi - type(vector), intent(in) :: v - j = g * grvgf (gravbar, psi, v) -end function pv1_grf -\nwendcode{}\nwbegindocs{793}\nwdocspar -\nwenddocs{}\nwbegincode{794}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function pv2_grf (g, gravbar, phi, psi) result (j) - type(vector) :: j - complex(kind=default), intent(in) :: g, phi - type(vectorspinor), intent(in) :: gravbar - type(bispinor), intent(in) :: psi - type(bispinor) :: g5_psi - g5_psi%a(1:2) = - psi%a(1:2) - g5_psi%a(3:4) = psi%a(3:4) - j = sv2_grf (g, gravbar, phi, g5_psi) -end function pv2_grf -\nwendcode{}\nwbegindocs{795}\nwdocspar -\nwenddocs{}\nwbegincode{796}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function pv1_fgr (g, psibar, v, grav) result (j) - complex(kind=default) :: j - complex(kind=default), intent(in) :: g - type(bispinor), intent(in) :: psibar - type(vectorspinor), intent(in) :: grav - type(vector), intent(in) :: v - j = g * fgkgr (psibar, grav, v) -end function pv1_fgr -\nwendcode{}\nwbegindocs{797}\nwdocspar -\nwenddocs{}\nwbegincode{798}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function pv2_fgr (g, psibar, phi, grav) result (j) - type(vector) :: j - complex(kind=default), intent(in) :: g, phi - type(vectorspinor), intent(in) :: grav - type(bispinor), intent(in) :: psibar - type(bispinor) :: psibar_g5 - psibar_g5%a(1:2) = - psibar%a(1:2) - psibar_g5%a(3:4) = psibar%a(3:4) - j = sv2_fgr (g, psibar_g5, phi, grav) -end function pv2_fgr -\nwendcode{}\nwbegindocs{799}\nwdocspar -\nwenddocs{}\nwbegincode{800}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function v2_grf (g, gravbar, v, psi) result (j) - type(vector) :: j - complex(kind=default), intent(in) :: g - type(vectorspinor), intent(in) :: gravbar - type(bispinor), intent(in) :: psi - type(vector), intent(in) :: v - j = -g * grkgggf (gravbar, psi, v) -end function v2_grf -\nwendcode{}\nwbegindocs{801}\nwdocspar -\nwenddocs{}\nwbegincode{802}\moddef{Implementation of bispinor currents}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function v2_fgr (g, psibar, v, grav) result (j) - type(vector) :: j - complex(kind=default), intent(in) :: g - type(vectorspinor), intent(in) :: grav - type(bispinor), intent(in) :: psibar - type(vector), intent(in) :: v - j = -g * fggkggr (psibar, grav, v) -end function v2_fgr -\nwendcode{}\nwbegindocs{803}\subsection{On Shell Wave Functions} -\nwenddocs{}\nwbegincode{804}\moddef{Declaration of bispinor on shell wave functions}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -public :: u, v, ghost -\nwendcode{}\nwbegindocs{805}\nwdocspar -\begin{subequations} -\begin{align} - \chi_+(\vec p) &= - \frac{1}{\sqrt{2|\vec p|(|\vec p|+p_3)}} - \begin{pmatrix} |\vec p|+p_3 \\ p_1 + \ii p_2 \end{pmatrix} \\ - \chi_-(\vec p) &= - \frac{1}{\sqrt{2|\vec p|(|\vec p|+p_3)}} - \begin{pmatrix} - p_1 + \ii p_2 \\ |\vec p|+p_3 \end{pmatrix} -\end{align} -\end{subequations} -\nwenddocs{}\nwbegindocs{806}\nwdocspar -\begin{equation} - u_\pm(p) = - \begin{pmatrix} - \sqrt{p_0\mp|\vec p|} \cdot \chi_\pm(\vec p) \\ - \sqrt{p_0\pm|\vec p|} \cdot \chi_\pm(\vec p) - \end{pmatrix} -\end{equation} -\nwenddocs{}\nwbegincode{807}\moddef{Implementation of bispinor on shell wave functions}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function u (m, p, s) result (psi) - type(bispinor) :: psi - real(kind=default), intent(in) :: m - type(momentum), intent(in) :: p - integer, intent(in) :: s - complex(kind=default), dimension(2) :: chip, chim - real(kind=default) :: pabs, norm - pabs = sqrt (dot_product (p%x, p%x)) - if (pabs + p%x(3) <= 1000 * epsilon (pabs) * pabs) then -!!! OLD VERSION !!!!!! -!!! if (1 + p%x(3) / pabs <= epsilon (pabs)) then -!!!!!!!!!!!!!!!!!!!!!! - chip = (/ cmplx ( 0.0, 0.0, kind=default), & - cmplx ( 1.0, 0.0, kind=default) /) - chim = (/ cmplx (-1.0, 0.0, kind=default), & - cmplx ( 0.0, 0.0, kind=default) /) - else - norm = 1 / sqrt (2*pabs*(pabs + p%x(3))) - chip = norm * (/ cmplx (pabs + p%x(3), kind=default), & - cmplx (p%x(1), p%x(2), kind=default) /) - chim = norm * (/ cmplx (-p%x(1), p%x(2), kind=default), & - cmplx (pabs + p%x(3), kind=default) /) - end if - if (s > 0) then - psi%a(1:2) = sqrt (max (p%t - pabs, 0.0_default)) * chip - psi%a(3:4) = sqrt (p%t + pabs) * chip - else - psi%a(1:2) = sqrt (p%t + pabs) * chim - psi%a(3:4) = sqrt (max (p%t - pabs, 0.0_default)) * chim - end if - pabs = m ! make the compiler happy and use m -end function u -!pure function u (m, p, s) result (psi) -! type(bispinor) :: psi -! real(kind=default), intent(in) :: m -! type(momentum), intent(in) :: p -! integer, intent(in) :: s -! complex(kind=default), dimension(2) :: chip, chim -! real(kind=default) :: pabs, norm -! pabs = sqrt (dot_product (p%x, p%x)) -! if (p%x(3) <= epsilon(p%x(3))) then -! chip = (/ cmplx ( 0.0, 0.0, kind=default), & -! cmplx ( 1.0, 0.0, kind=default) /) -! chim = (/ cmplx (-1.0, 0.0, kind=default), & -! cmplx ( 0.0, 0.0, kind=default) /) -! else -! if (1 + p%x(3) / pabs <= epsilon (pabs)) then -! chip = (/ cmplx ( 0.0, 0.0, kind=default), & -! cmplx ( 1.0, 0.0, kind=default) /) -! chim = (/ cmplx (-1.0, 0.0, kind=default), & -! cmplx ( 0.0, 0.0, kind=default) /) -! else -! norm = 1 / sqrt (2*pabs*(pabs + p%x(3))) -! chip = norm * (/ cmplx (pabs + p%x(3), kind=default), & -! cmplx (p%x(1), p%x(2), kind=default) /) -! chim = norm * (/ cmplx (-p%x(1), p%x(2), kind=default), & -! cmplx (pabs + p%x(3), kind=default) /) -! end if -! end if -! if (s > 0) then -! psi%a(1:2) = sqrt (max (p%t - pabs, 0.0_default)) * chip -! psi%a(3:4) = sqrt (p%t + pabs) * chip -! else -! psi%a(1:2) = sqrt (p%t + pabs) * chim -! psi%a(3:4) = sqrt (max (p%t - pabs, 0.0_default)) * chim -! end if -! pabs = m ! make the compiler happy and use m -!end function u -\nwendcode{}\nwbegindocs{808}\nwdocspar -\begin{equation} - v_\pm(p) = - \begin{pmatrix} - \mp\sqrt{p_0\pm|\vec p|} \cdot \chi_\mp(\vec p) \\ - \pm\sqrt{p_0\mp|\vec p|} \cdot \chi_\mp(\vec p) - \end{pmatrix} -\end{equation} -\nwenddocs{}\nwbegincode{809}\moddef{Implementation of bispinor on shell wave functions}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function v (m, p, s) result (psi) - type(bispinor) :: psi - real(kind=default), intent(in) :: m - type(momentum), intent(in) :: p - integer, intent(in) :: s - complex(kind=default), dimension(2) :: chip, chim - real(kind=default) :: pabs, norm - pabs = sqrt (dot_product (p%x, p%x)) - if (pabs + p%x(3) <= 1000 * epsilon (pabs) * pabs) then -!!! OLD VERSION !!!!!! -!!! if (1 + p%x(3) / pabs <= epsilon (pabs)) then -!!!!!!!!!!!!!!!!!!!!!! - chip = (/ cmplx ( 0.0, 0.0, kind=default), & - cmplx ( 1.0, 0.0, kind=default) /) - chim = (/ cmplx (-1.0, 0.0, kind=default), & - cmplx ( 0.0, 0.0, kind=default) /) - else - norm = 1 / sqrt (2*pabs*(pabs + p%x(3))) - chip = norm * (/ cmplx (pabs + p%x(3), kind=default), & - cmplx (p%x(1), p%x(2), kind=default) /) - chim = norm * (/ cmplx (-p%x(1), p%x(2), kind=default), & - cmplx (pabs + p%x(3), kind=default) /) - end if - if (s > 0) then - psi%a(1:2) = - sqrt (p%t + pabs) * chim - psi%a(3:4) = sqrt (max (p%t - pabs, 0.0_default)) * chim - else - psi%a(1:2) = sqrt (max (p%t - pabs, 0.0_default)) * chip - psi%a(3:4) = - sqrt (p%t + pabs) * chip - end if - pabs = m ! make the compiler happy and use m -end function v -!pure function v (m, p, s) result (psi) -! type(bispinor) :: psi -! real(kind=default), intent(in) :: m -! type(momentum), intent(in) :: p -! integer, intent(in) :: s -! complex(kind=default), dimension(2) :: chip, chim -! real(kind=default) :: pabs, norm -! pabs = sqrt (dot_product (p%x, p%x)) -! if (p%x(3) <= epsilon (p%x(3))) then -! chip = (/ cmplx ( 1.0, 0.0, kind=default), & -! cmplx ( 0.0, 0.0, kind=default) /) -! chim = (/ cmplx ( 0.0, 0.0, kind=default), & -! cmplx ( 1.0, 0.0, kind=default) /) -! else -! if (1 + p%x(3) / pabs <= epsilon (pabs)) then -! chip = (/ cmplx ( 0.0, 0.0, kind=default), & -! cmplx ( 1.0, 0.0, kind=default) /) -! chim = (/ cmplx (-1.0, 0.0, kind=default), & -! cmplx ( 0.0, 0.0, kind=default) /) -! else -! norm = 1 / sqrt (2*pabs*(pabs + p%x(3))) -! chip = norm * (/ cmplx (pabs + p%x(3), kind=default), & -! cmplx (p%x(1), p%x(2), kind=default) /) -! chim = norm * (/ cmplx (-p%x(1), p%x(2), kind=default), & -! cmplx (pabs + p%x(3), kind=default) /) -! end if -! end if -! if (s > 0) then -! psi%a(1:2) = - sqrt (p%t + pabs) * chim -! psi%a(3:4) = sqrt (max (p%t - pabs, 0.0_default)) * chim -! else -! psi%a(1:2) = sqrt (max (p%t - pabs, 0.0_default)) * chip -! psi%a(3:4) = - sqrt (p%t + pabs) * chip -! end if -! pabs = m ! make the compiler happy and use m -!end function v -\nwendcode{}\nwbegindocs{810}\nwdocspar -\nwenddocs{}\nwbegincode{811}\moddef{Implementation of bispinor on shell wave functions}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function ghost (m, p, s) result (psi) - type(bispinor) :: psi - real(kind=default), intent(in) :: m - type(momentum), intent(in) :: p - integer, intent(in) :: s - psi%a(:) = 0 - select case (s) - case (1) - psi%a(1) = 1 - psi%a(2:4) = 0 - case (2) - psi%a(1) = 0 - psi%a(2) = 1 - psi%a(3:4) = 0 - case (3) - psi%a(1:2) = 0 - psi%a(3) = 1 - psi%a(4) = 0 - case (4) - psi%a(1:3) = 0 - psi%a(4) = 1 - case (5) - psi%a(1) = 1.4 - psi%a(2) = - 2.3 - psi%a(3) = - 71.5 - psi%a(4) = 0.1 - end select -end function ghost -\nwendcode{}\nwbegindocs{812}\nwdocspar - \subsection{Off Shell Wave Functions} -This is the same as for the Dirac fermions except that the expressions for -[ubar] and [vbar] are missing. -\nwenddocs{}\nwbegincode{813}\moddef{Declaration of bispinor off shell wave functions}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -public :: brs_u, brs_v -\nwendcode{}\nwbegindocs{814}\nwdocspar -In momentum space we have: -\begin{equation} -brs u(p)=(-i) (\fmslash p-m)u(p) -\end{equation} -\nwenddocs{}\nwbegincode{815}\moddef{Implementation of bispinor off shell wave functions}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function brs_u (m, p, s) result (dpsi) - type(bispinor) :: dpsi, psi - real(kind=default), intent(in) :: m - type(momentum), intent(in) :: p - integer, intent(in) :: s - type (vector)::vp - complex(kind=default), parameter :: one = (1, 0) - vp=p - psi=u(m,p,s) - dpsi=cmplx(0.0,-1.0)*(f_vf(one,vp,psi)-m*psi) -end function brs_u -\nwendcode{}\nwbegindocs{816}\nwdocspar -\begin{equation} -brs v(p)=i (\fmslash p+m)v(p) -\end{equation} -\nwenddocs{}\nwbegincode{817}\moddef{Implementation of bispinor off shell wave functions}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function brs_v (m, p, s) result (dpsi) - type(bispinor) :: dpsi, psi - real(kind=default), intent(in) :: m - type(momentum), intent(in) :: p - integer, intent(in) :: s - type (vector)::vp - complex(kind=default), parameter :: one = (1, 0) - vp=p - psi=v(m,p,s) - dpsi=cmplx(0.0,1.0)*(f_vf(one,vp,psi)+m*psi) -end function brs_v -\nwendcode{}\nwbegindocs{818}\subsection{Propagators} -\nwenddocs{}\nwbegincode{819}\moddef{Declaration of bispinor propagators}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -public :: pr_psi, pr_grav -public :: pj_psi, pg_psi -\nwendcode{}\nwbegindocs{820} -\begin{equation} - \frac{\ii(-\fmslash{p}+m)}{p^2-m^2+\ii m\Gamma}\psi -\end{equation} -NB: the sign of the momentum comes about because all momenta are -treated as \emph{outgoing} and the particle charge flow is therefore -opposite to the momentum. -\nwenddocs{}\nwbegincode{821}\moddef{Implementation of bispinor propagators}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function pr_psi (p, m, w, psi) result (ppsi) - type(bispinor) :: ppsi - type(momentum), intent(in) :: p - real(kind=default), intent(in) :: m, w - type(bispinor), intent(in) :: psi - type(vector) :: vp - complex(kind=default), parameter :: one = (1, 0) - vp = p - ppsi = (1 / cmplx (p*p - m**2, m*w, kind=default)) & - * (- f_vf (one, vp, psi) + m * psi) -end function pr_psi -\nwendcode{}\nwbegindocs{822} -\begin{equation} - \sqrt{\frac{\pi}{M\Gamma}} - (-\fmslash{p}+m)\psi -\end{equation} -\nwenddocs{}\nwbegincode{823}\moddef{Implementation of bispinor propagators}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function pj_psi (p, m, w, psi) result (ppsi) - type(bispinor) :: ppsi - type(momentum), intent(in) :: p - real(kind=default), intent(in) :: m, w - type(bispinor), intent(in) :: psi - type(vector) :: vp - complex(kind=default), parameter :: one = (1, 0) - vp = p - ppsi = (0, -1) * sqrt (PI / m / w) * (- f_vf (one, vp, psi) + m * psi) -end function pj_psi -\nwendcode{}\nwbegindocs{824}\nwdocspar -\nwenddocs{}\nwbegincode{825}\moddef{Implementation of bispinor propagators}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function pg_psi (p, m, w, psi) result (ppsi) - type(bispinor) :: ppsi - type(momentum), intent(in) :: p - real(kind=default), intent(in) :: m, w - type(bispinor), intent(in) :: psi - type(vector) :: vp - complex(kind=default), parameter :: one = (1, 0) - vp = p - ppsi = gauss (p*p, m, w) * (- f_vf (one, vp, psi) + m * psi) -end function pg_psi -\nwendcode{}\nwbegindocs{826}\nwdocspar -\begin{equation} - \dfrac{\ii\biggl\{(-\fmslash{p} + m)\left(-\eta_{\mu\nu} + \dfrac{p_\mu - p_\nu}{m^2}\right) + \dfrac{1}{3} \left(\gamma_\mu -\dfrac{p_\mu}{m}\right) - (\fmslash{p} + m)\left(\gamma_\nu - - \dfrac{p_\nu}{m}\right)\biggr\}}{p^2 - m^2 + \ii m - \Gamma} \; \psi^\nu -\end{equation} -\nwenddocs{}\nwbegincode{827}\moddef{Implementation of bispinor propagators}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function pr_grav (p, m, w, grav) result (propgrav) - type(vectorspinor) :: propgrav - type(momentum), intent(in) :: p - real(kind=default), intent(in) :: m, w - type(vectorspinor), intent(in) :: grav - type(vector) :: vp - type(bispinor) :: pgrav, ggrav, ggrav1, ggrav2, ppgrav - type(vectorspinor) :: etagrav_dum, etagrav, pppgrav, & - gg_grav_dum, gg_grav - complex(kind=default), parameter :: one = (1, 0) - real(kind=default) :: minv - integer :: i - vp = p - minv = 1/m - pgrav = p%t * grav%psi(1) - p%x(1) * grav%psi(2) - & - p%x(2) * grav%psi(3) - p%x(3) * grav%psi(4) - ggrav%a(1) = grav%psi(1)%a(3) - grav%psi(2)%a(4) + (0,1) * & - grav%psi(3)%a(4) - grav%psi(4)%a(3) - ggrav%a(2) = grav%psi(1)%a(4) - grav%psi(2)%a(3) - (0,1) * & - grav%psi(3)%a(3) + grav%psi(4)%a(4) - ggrav%a(3) = grav%psi(1)%a(1) + grav%psi(2)%a(2) - (0,1) * & - grav%psi(3)%a(2) + grav%psi(4)%a(1) - ggrav%a(4) = grav%psi(1)%a(2) + grav%psi(2)%a(1) + (0,1) * & - grav%psi(3)%a(1) - grav%psi(4)%a(2) - ggrav1 = ggrav - minv * pgrav - ggrav2 = f_vf (one, vp, ggrav1) + m * ggrav - pgrav - ppgrav = -minv**2 * f_vf (one, vp, pgrav) + minv * pgrav - do i = 1, 4 - etagrav_dum%psi(i) = f_vf (one, vp, grav%psi(i)) - end do - etagrav = etagrav_dum - m * grav - pppgrav%psi(1) = p%t * ppgrav - pppgrav%psi(2) = p%x(1) * ppgrav - pppgrav%psi(3) = p%x(2) * ppgrav - pppgrav%psi(4) = p%x(3) * ppgrav - gg_grav_dum%psi(1) = p%t * ggrav2 - gg_grav_dum%psi(2) = p%x(1) * ggrav2 - gg_grav_dum%psi(3) = p%x(2) * ggrav2 - gg_grav_dum%psi(4) = p%x(3) * ggrav2 - gg_grav = gr_potf (one, one, ggrav2) - minv * gg_grav_dum - propgrav = (1 / cmplx (p*p - m**2, m*w, kind=default)) * & - (etagrav + pppgrav + (1/3.0_default) * gg_grav) -end function pr_grav -\nwendcode{}\nwbegindocs{828}\nwdocspar -\section{Polarization vectorspinors} -Here we construct the wavefunctions for (massive) gravitinos out of -the wavefunctions of (massive) vectorbosons and (massive) Majorana -fermions. -\begin{subequations} -\begin{align} -\psi^\mu_{(u; 3/2)} (k) &= \; \epsilon^\mu_+ (k) \cdot u (k, +) \\ -\psi^\mu_{(u; 1/2)} (k) &= \; \sqrt{\dfrac{1}{3}} \, \epsilon^\mu_+ (k) - \cdot u (k, -) + \sqrt{\dfrac{2}{3}} \, \epsilon^\mu_0 (k) \cdot - u (k, +) \\ -\psi^\mu_{(u; -1/2)} (k) &= \; \sqrt{\dfrac{2}{3}} \, \epsilon^\mu_0 (k) - \cdot u (k, -) + \sqrt{\dfrac{1}{3}} \, \epsilon^\mu_- (k) \cdot - u (k, +) \\ -\psi^\mu_{(u; -3/2)} (k) &= \; \epsilon^\mu_- (k) \cdot u (k, -) -\end{align} -\end{subequations} -and in the same manner for $\psi^\mu_{(v; s)}$ with $u$ replaced by -$v$ and with the conjugated polarization vectors. These gravitino -wavefunctions obey the Dirac equation, they are transverse and they -fulfill the irreducibility condition -\begin{equation} - \gamma_\mu \psi^\mu_{(u/v; s)} = 0 . -\end{equation} -\nwenddocs{}\nwbegincode{829}\moddef{\code{}omega{\_}vspinor{\_}polarizations.f95\edoc{}}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -\LA{}Copyleft\RA{} -module omega_vspinor_polarizations - use kinds - use omega_constants - use omega_vectors - use omega_bispinors - use omega_bispinor_couplings - use omega_vectorspinors - implicit none - \LA{}Declaration of polarization vectorspinors\RA{} - integer, parameter, public :: omega_vspinor_pols_2003_03_A = 0 -contains - \LA{}Implementation of polarization vectorspinors\RA{} -end module omega_vspinor_polarizations -\nwendcode{}\nwbegindocs{830}\nwdocspar -\nwenddocs{}\nwbegincode{831}\moddef{Declaration of polarization vectorspinors}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -public :: ueps, veps -private :: eps -private :: outer_product -\nwendcode{}\nwbegindocs{832}\nwdocspar -Here we implement the polarization vectors for vectorbosons with -trigonometric functions, without the rotating of components done in -HELAS~\cite{HELAS}. These are only used for generating the -polarization vectorspinors. -\begin{subequations} -\begin{align} - \epsilon^\mu_+(k) &= - \frac{- e^{+\ii\phi}}{\sqrt{2}} - \left(0; \cos\theta\cos\phi - \ii\sin\phi, - \cos\theta\sin\phi + \ii\cos\phi, - -\sin\theta \right) \\ - \epsilon^\mu_-(k) &= - \frac{e^{-\ii\phi}}{\sqrt{2}} - \left(0; \cos\theta\cos\phi + \ii \sin\phi, - \cos\theta\sin\phi - \ii \cos\phi, - - \sin\theta \right) \\ - \epsilon^\mu_0(k) &= - \frac{1}{m} \left(|\vec k|; k^0\sin\theta\cos\phi, - k^0\sin\theta\sin\phi, - k^0\cos\theta\right) -\end{align} -\end{subequations} -Determining the mass from the momenta is a numerically haphazardous for -light particles. Therefore, we accept some redundancy and pass the -mass explicitely. For the case that the momentum lies totally in the -$z$-direction we take the convention $\cos\phi=1$ and $\sin\phi=0$. -\nwenddocs{}\nwbegincode{833}\moddef{Implementation of polarization vectorspinors}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function eps (m, k, s) result (e) - type(vector) :: e - real(kind=default), intent(in) :: m - type(momentum), intent(in) :: k - integer, intent(in) :: s - real(kind=default) :: kabs, kabs2, sqrt2 - real(kind=default) :: cos_phi, sin_phi, cos_th, sin_th - complex(kind=default) :: epiphi, emiphi - sqrt2 = sqrt (2.0_default) - kabs2 = dot_product (k%x, k%x) - if (kabs2 > 0) then - kabs = sqrt (kabs2) - if ((k%x(1) == 0) .and. (k%x(2) == 0)) then - cos_phi = 1 - sin_phi = 0 - else - cos_phi = k%x(1) / sqrt(k%x(1)**2 + k%x(2)**2) - sin_phi = k%x(2) / sqrt(k%x(1)**2 + k%x(2)**2) - end if - cos_th = k%x(3) / kabs - sin_th = sqrt(1 - cos_th**2) - epiphi = cos_phi + (0,1) * sin_phi - emiphi = cos_phi - (0,1) * sin_phi - e%t = 0 - e%x = 0 - select case (s) - case (1) - e%x(1) = epiphi * (-cos_th * cos_phi + (0,1) * sin_phi) / sqrt2 - e%x(2) = epiphi * (-cos_th * sin_phi - (0,1) * cos_phi) / sqrt2 - e%x(3) = epiphi * ( sin_th / sqrt2) - case (-1) - e%x(1) = emiphi * ( cos_th * cos_phi + (0,1) * sin_phi) / sqrt2 - e%x(2) = emiphi * ( cos_th * sin_phi - (0,1) * cos_phi) / sqrt2 - e%x(3) = emiphi * (-sin_th / sqrt2) - case (0) - if (m > 0) then - e%t = kabs / m - e%x = k%t / (m*kabs) * k%x - end if - case (4) - if (m > 0) then - e = (1 / m) * k - else - e = (1 / k%t) * k - end if - end select - else !!! for particles in their rest frame defined to be - !!! polarized along the 3-direction - e%t = 0 - e%x = 0 - select case (s) - case (1) - e%x(1) = cmplx ( - 1, 0, kind=default) / sqrt2 - e%x(2) = cmplx ( 0, 1, kind=default) / sqrt2 - case (-1) - e%x(1) = cmplx ( 1, 0, kind=default) / sqrt2 - e%x(2) = cmplx ( 0, 1, kind=default) / sqrt2 - case (0) - if (m > 0) then - e%x(3) = 1 - end if - case (4) - if (m > 0) then - e = (1 / m) * k - else - e = (1 / k%t) * k - end if - end select - end if -end function eps -\nwendcode{}\nwbegindocs{834}\nwdocspar -\nwenddocs{}\nwbegincode{835}\moddef{Implementation of polarization vectorspinors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function ueps (m, k, s) result (t) - type(vectorspinor) :: t - real(kind=default), intent(in) :: m - type(momentum), intent(in) :: k - integer, intent(in) :: s - integer :: i - type(vector) :: ep, e0, em - type(bispinor) :: up, um - do i = 1, 4 - t%psi(i)%a = 0 - end do - select case (s) - case (2) - ep = eps (m, k, 1) - up = u (m, k, 1) - t = outer_product (ep, up) - case (1) - ep = eps (m, k, 1) - e0 = eps (m, k, 0) - up = u (m, k, 1) - um = u (m, k, -1) - t = (1 / sqrt (3.0_default)) * (outer_product (ep, um) & - + sqrt (2.0_default) * outer_product (e0, up)) - case (-1) - e0 = eps (m, k, 0) - em = eps (m, k, -1) - up = u (m, k, 1) - um = u (m, k, -1) - t = (1 / sqrt (3.0_default)) * (sqrt (2.0_default) * & - outer_product (e0, um) + outer_product (em, up)) - case (-2) - em = eps (m, k, -1) - um = u (m, k, -1) - t = outer_product (em, um) - end select -end function ueps -\nwendcode{}\nwbegindocs{836}\nwdocspar -\nwenddocs{}\nwbegincode{837}\moddef{Implementation of polarization vectorspinors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function veps (m, k, s) result (t) - type(vectorspinor) :: t - real(kind=default), intent(in) :: m - type(momentum), intent(in) :: k - integer, intent(in) :: s - integer :: i - type(vector) :: ep, e0, em - type(bispinor) :: vp, vm - do i = 1, 4 - t%psi(i)%a = 0 - end do - select case (s) - case (2) - ep = conjg(eps (m, k, 1)) - vp = v (m, k, 1) - t = outer_product (ep, vp) - case (1) - ep = conjg(eps (m, k, 1)) - e0 = conjg(eps (m, k, 0)) - vp = v (m, k, 1) - vm = v (m, k, -1) - t = (1 / sqrt (3.0_default)) * (outer_product (ep, vm) & - + sqrt (2.0_default) * outer_product (e0, vp)) - case (-1) - e0 = conjg(eps (m, k, 0)) - em = conjg(eps (m, k, -1)) - vp = v (m, k, 1) - vm = v (m, k, -1) - t = (1 / sqrt (3.0_default)) * (sqrt (2.0_default) & - * outer_product (e0, vm) + outer_product (em, vp)) - case (-2) - em = conjg(eps (m, k, -1)) - vm = v (m, k, -1) - t = outer_product (em, vm) - end select -end function veps -\nwendcode{}\nwbegindocs{838}\nwdocspar -\nwenddocs{}\nwbegincode{839}\moddef{Implementation of polarization vectorspinors}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function outer_product (ve, sp) result (vs) - type(vectorspinor) :: vs - type(vector), intent(in) :: ve - type(bispinor), intent(in) :: sp - integer :: i - vs%psi(1)%a(1:4) = ve%t * sp%a(1:4) - do i = 1, 3 - vs%psi((i+1))%a(1:4) = ve%x(i) * sp%a(1:4) - end do -end function outer_product -\nwendcode{}\nwbegindocs{840}\nwdocspar -\section{Colors} -\begin{dubious} - A derived data type is probably \emph{not} the optimal solution, - because we have to initialize it \emph{statically} with variable - sizes. This is not possible with \texttt{allocatable} arrays and - allocating lots of arrays anew for each evaluation of the matrix - element is out of the question! -\end{dubious} -\begin{dubious} - However, this might require us to make most of the arithmetic - \texttt{elemental}, which is not possible for Fortran90 compilers. -\end{dubious} -\nwenddocs{}\nwbegincode{841}\moddef{\code{}omega{\_}spinor{\_}colors.m4\edoc{}}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -\LA{}Copyleft\RA{} -\LA{}M4 macros for color\RA{} -\nwendcode{}\nwbegindocs{842}Use m4 diversions to get everything into the right order: -\nwenddocs{}\nwbegincode{843}\moddef{M4 macros for color}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -define(`DECLARATIONS', `undivert(1)') -define(`IMPLEMENTATIONS', `undivert(2)') -\nwendcode{}\nwbegindocs{844}\nwdocspar -We need two versions: One for {\Tt{}spinor\nwendquote}s and one for {\Tt{}bispinor\nwendquote}s: -\nwenddocs{}\nwbegincode{845}\moddef{\code{}omega{\_}bispinor{\_}colors.m4\edoc{}}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -\LA{}Copyleft\RA{} -\LA{}M4 macros for color\RA{} -\LA{}\code{}omega{\_}spinor{\_}colors.m4\edoc{} and \code{}omega{\_}bispinor{\_}colors.m4\edoc{}\RA{} -\nwendcode{}\nwbegindocs{846}\nwdocspar -\nwenddocs{}\nwbegincode{847}\moddef{\code{}omega{\_}spinor{\_}colors.m4\edoc{}}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -\LA{}\code{}omega{\_}spinor{\_}colors.m4\edoc{} and \code{}omega{\_}bispinor{\_}colors.m4\edoc{}\RA{} -\nwendcode{}\nwbegindocs{848}\nwdocspar -\nwenddocs{}\nwbegincode{849}\moddef{M4 macros for color}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -define(`PROPAGATOR', `dnl -divert(1)dnl - public :: $1_c -divert(2)dnl - pure function $1_c (p, $3, iwf) result (owf) - $2, dimension(:), intent(in) :: iwf - $2, dimension(lbound(iwf,dim=1):ubound(iwf,dim=1)) :: owf - type(momentum), intent(in) :: p - real(kind=default), intent(in) :: $3 - integer :: i - do i = lbound(iwf,dim=1), ubound(iwf,dim=1) - owf(i) = $1 (p, $3, iwf(i)) - end do - end function $1_c -divert') -\nwendcode{}\nwbegindocs{850}\nwdocspar -\nwenddocs{}\nwbegincode{851}\moddef{\code{}omega{\_}spinor{\_}colors.m4\edoc{}}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -PROPAGATOR(`pr_psi', `type(spinor)', `m, w') -PROPAGATOR(`pr_psibar', `type(conjspinor)', `m, w') -\nwendcode{}\nwbegindocs{852}\nwdocspar -\nwenddocs{}\nwbegincode{853}\moddef{\code{}omega{\_}bispinor{\_}colors.m4\edoc{}}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -PROPAGATOR(`pr_psi', `type(bispinor)', `m, w') -\nwendcode{}\nwbegindocs{854}\nwdocspar -\nwenddocs{}\nwbegincode{855}\moddef{\code{}omega{\_}spinor{\_}colors.m4\edoc{} and \code{}omega{\_}bispinor{\_}colors.m4\edoc{}}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -PROPAGATOR(`pr_phi', `complex(kind=default)', `m, w') -PROPAGATOR(`pr_unitarity', `type(vector)', `m, w') -dnl PROPAGATOR(`pr_tensor', `type(tensor)', `m, w') -\nwendcode{}\nwbegindocs{856}\nwdocspar -\nwenddocs{}\nwbegincode{857}\moddef{M4 macros for color}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -define(`PROPAGATOR0', `dnl -divert(1)dnl - public :: $1_c -divert(2)dnl - pure function $1_c (p, iwf) result (owf) - $2, dimension(:), intent(in) :: iwf - $2, dimension(lbound(iwf,dim=1):ubound(iwf,dim=1)) :: owf - type(momentum), intent(in) :: p - integer :: i - do i = lbound(iwf,dim=1), ubound(iwf,dim=1) - owf(i) = $1 (p, iwf(i)) - end do - end function $1_c -divert') -\nwendcode{}\nwbegindocs{858}\nwdocspar -\nwenddocs{}\nwbegincode{859}\moddef{\code{}omega{\_}spinor{\_}colors.m4\edoc{} and \code{}omega{\_}bispinor{\_}colors.m4\edoc{}}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -PROPAGATOR0(`pr_feynman', `type(vector)') -\nwendcode{}\nwbegindocs{860}\nwdocspar -\nwenddocs{}\nwbegincode{861}\moddef{\code{}omega{\_}spinor{\_}colors.m4\edoc{} and \code{}omega{\_}bispinor{\_}colors.m4\edoc{}}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -PROPAGATOR(`pr_gauge', `type(vector)', `xi') -PROPAGATOR(`pr_rxi', `type(vector)', `m, w, xi') -\nwendcode{}\nwbegindocs{862}\nwdocspar -\nwenddocs{}\nwbegincode{863}\moddef{M4 macros for color}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -define(`BINARY', `dnl -divert(1)dnl - \LA{}Declare colorized binary fusions\RA{} -divert(2)dnl - \LA{}Implement colorized binary fusions\RA{} -divert') -\nwendcode{}\nwbegindocs{864}Three singlets are redundant and a single colored particle would -be inconsistent: -\nwenddocs{}\nwbegincode{865}\moddef{Declare colorized binary fusions}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -public :: $1_c_cc -public :: $1_c_sc -public :: $1_c_cs -public :: $1_s_cc -\nwendcode{}\nwbegindocs{866}\nwdocspar -\nwenddocs{}\nwbegincode{867}\moddef{Implement colorized binary fusions}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function $1_c_cc (c, $3, wf1, wf2) result (wf) - complex(kind=default), dimension(:,:,:), intent(in) :: c - $2, dimension(lbound(c,dim=1):ubound(c,dim=1)) :: wf - complex(kind=default), intent(in) :: $3 - $4, dimension(:), intent(in) :: wf1 - $5, dimension(:), intent(in) :: wf2 - integer :: i, i1, i2 - do i = lbound(wf,dim=1), ubound(wf,dim=1) - wf(i) = c(i,lbound(wf1,dim=1),lbound(wf2,dim=1)) & - * $1 ($3, wf1(lbound(wf1,dim=1)), wf2(lbound(wf2,dim=1))) - do i2 = lbound(wf2,dim=1) + 1, ubound(wf2,dim=1) - wf(i) = wf(i) + c(i,lbound(wf1,dim=1),i2) & - * $1 ($3, wf1(lbound(wf1,dim=1)), wf2(i2)) - end do - do i1 = lbound(wf1,dim=1) + 1, ubound(wf1,dim=1) - do i2 = lbound(wf2,dim=1), ubound(wf2,dim=1) - wf(i) = wf(i) + c(i,i1,i2) * $1 ($3, wf1(i1), wf2(i2)) - end do - end do - end do -end function $1_c_cc -\nwendcode{}\nwbegindocs{868}\nwdocspar -\nwenddocs{}\nwbegincode{869}\moddef{Implement colorized binary fusions}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function $1_c_sc (c, $3, wf1, wf2) result (wf) - complex(kind=default), dimension(:,:), intent(in) :: c - $2, dimension(lbound(c,dim=1):ubound(c,dim=1)) :: wf - complex(kind=default), intent(in) :: $3 - $4, intent(in) :: wf1 - $5, dimension(:), intent(in) :: wf2 - integer :: i, i2 - do i = lbound(wf,dim=1), ubound(wf,dim=1) - wf(i) = c(i,lbound(wf2,dim=1)) * $1 ($3, wf1, wf2(lbound(wf2,dim=1))) - do i2 = lbound(wf2,dim=1) + 1, ubound(wf2,dim=1) - wf(i) = wf(i) + c(i,i2) * $1 ($3, wf1, wf2(i2)) - end do - end do -end function $1_c_sc -\nwendcode{}\nwbegindocs{870}\nwdocspar -\nwenddocs{}\nwbegincode{871}\moddef{Implement colorized binary fusions}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function $1_c_cs (c, $3, wf1, wf2) result (wf) - complex(kind=default), dimension(:,:), intent(in) :: c - $2, dimension(lbound(c,dim=1):ubound(c,dim=1)) :: wf - complex(kind=default), intent(in) :: $3 - $4, dimension(:), intent(in) :: wf1 - $5, intent(in) :: wf2 - integer :: i, i1 - do i = lbound(wf,dim=1), ubound(wf,dim=1) - wf(i) = c(i,lbound(wf1,dim=1)) * $1 ($3, wf1(lbound(wf1,dim=1)), wf2) - do i1 = lbound(wf1,dim=1) + 1, ubound(wf1,dim=1) - wf(i) = wf(i) + c(i,i1) * $1 ($3, wf1(i1), wf2) - end do - end do -end function $1_c_cs -\nwendcode{}\nwbegindocs{872}\nwdocspar -\nwenddocs{}\nwbegincode{873}\moddef{Implement colorized binary fusions}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function $1_s_cc (c, $3, wf1, wf2) result (wf) - $2 :: wf - complex(kind=default), dimension(:,:), intent(in) :: c - complex(kind=default), intent(in) :: $3 - $4, dimension(:), intent(in) :: wf1 - $5, dimension(:), intent(in) :: wf2 - integer :: i1, i2 - wf = c(lbound(wf1,dim=1),lbound(wf2,dim=1)) & - * $1 ($3, wf1(lbound(wf1,dim=1)), wf2(lbound(wf2,dim=1))) - do i2 = lbound(wf2,dim=1) + 1, ubound(wf2,dim=1) - wf = wf + c(lbound(wf1,dim=1),i2) * $1 ($3, wf1(lbound(wf1,dim=1)), wf2(i2)) - end do - do i1 = lbound(wf1,dim=1) + 1, ubound(wf1,dim=1) - do i2 = lbound(wf2,dim=1), ubound(wf2,dim=1) - wf = wf + c(i1,i2) * $1 ($3, wf1(i1), wf2(i2)) - end do - end do -end function $1_s_cc -\nwendcode{}\nwbegindocs{874}\nwdocspar -\nwenddocs{}\nwbegincode{875}\moddef{\code{}omega{\_}spinor{\_}colors.m4\edoc{}}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -BINARY(`v_ff', `type(vector)', `g', `type(conjspinor)', `type(spinor)') -BINARY(`a_ff', `type(vector)', `g', `type(conjspinor)', `type(spinor)') -BINARY(`vl_ff', `type(vector)', `g', `type(conjspinor)', `type(spinor)') -BINARY(`vr_ff', `type(vector)', `g', `type(conjspinor)', `type(spinor)') -BINARY(`vlr_ff', `type(vector)', `gl, gr', `type(conjspinor)', `type(spinor)') -BINARY(`va_ff', `type(vector)', `gv, ga', `type(conjspinor)', `type(spinor)') -BINARY(`f_vf', `type(spinor)', `g', `type(vector)', `type(spinor)') -BINARY(`f_af', `type(spinor)', `g', `type(vector)', `type(spinor)') -BINARY(`f_vlf', `type(spinor)', `g', `type(vector)', `type(spinor)') -BINARY(`f_vrf', `type(spinor)', `g', `type(vector)', `type(spinor)') -BINARY(`f_vlrf', `type(spinor)', `gl, gr', `type(vector)', `type(spinor)') -BINARY(`f_vaf', `type(spinor)', `gv, ga', `type(vector)', `type(spinor)') -BINARY(`f_fv', `type(conjspinor)', `g', `type(conjspinor)', `type(vector)') -BINARY(`f_fa', `type(conjspinor)', `g', `type(conjspinor)', `type(vector)') -BINARY(`f_fvl', `type(conjspinor)', `g', `type(conjspinor)', `type(vector)') -BINARY(`f_fvr', `type(conjspinor)', `g', `type(conjspinor)', `type(vector)') -BINARY(`f_fvlr', `type(conjspinor)', `gl, gr', `type(conjspinor)', `type(vector)') -BINARY(`f_fva', `type(conjspinor)', `gv, ga', `type(conjspinor)', `type(vector)') -\nwendcode{}\nwbegindocs{876}\nwdocspar -\nwenddocs{}\nwbegincode{877}\moddef{\code{}omega{\_}spinor{\_}colors.m4\edoc{}}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -BINARY(`s_ff', `complex(kind=default)', `g', `type(conjspinor)', `type(spinor)') -BINARY(`p_ff', `complex(kind=default)', `g', `type(conjspinor)', `type(spinor)') -BINARY(`sl_ff', `complex(kind=default)', `g', `type(conjspinor)', `type(spinor)') -BINARY(`sr_ff', `complex(kind=default)', `g', `type(conjspinor)', `type(spinor)') -BINARY(`slr_ff', `complex(kind=default)', `gl, gr', `type(conjspinor)', `type(spinor)') -BINARY(`sp_ff', `complex(kind=default)', `gv, ga', `type(conjspinor)', `type(spinor)') -BINARY(`f_sf', `type(spinor)', `g', `complex(kind=default)', `type(spinor)') -BINARY(`f_pf', `type(spinor)', `g', `complex(kind=default)', `type(spinor)') -BINARY(`f_slf', `type(spinor)', `g', `complex(kind=default)', `type(spinor)') -BINARY(`f_srf', `type(spinor)', `g', `complex(kind=default)', `type(spinor)') -BINARY(`f_slrf', `type(spinor)', `gl, gr', `complex(kind=default)', `type(spinor)') -BINARY(`f_spf', `type(spinor)', `gv, ga', `complex(kind=default)', `type(spinor)') -BINARY(`f_fs', `type(conjspinor)', `g', `type(conjspinor)', `complex(kind=default)') -BINARY(`f_fp', `type(conjspinor)', `g', `type(conjspinor)', `complex(kind=default)') -BINARY(`f_fsl', `type(conjspinor)', `g', `type(conjspinor)', `complex(kind=default)') -BINARY(`f_fsr', `type(conjspinor)', `g', `type(conjspinor)', `complex(kind=default)') -BINARY(`f_fslr', `type(conjspinor)', `gl, gr', `type(conjspinor)', `complex(kind=default)') -BINARY(`f_fsp', `type(conjspinor)', `gv, ga', `type(conjspinor)', `complex(kind=default)') -\nwendcode{}\nwbegindocs{878}\nwdocspar -\nwenddocs{}\nwbegincode{879}\moddef{\code{}omega{\_}bispinor{\_}colors.m4\edoc{}}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -BINARY(`v_ff', `type(vector)', `g', `type(bispinor)', `type(bispinor)') -BINARY(`a_ff', `type(vector)', `g', `type(bispinor)', `type(bispinor)') -BINARY(`vl_ff', `type(vector)', `g', `type(bispinor)', `type(bispinor)') -BINARY(`vr_ff', `type(vector)', `g', `type(bispinor)', `type(bispinor)') -BINARY(`vlr_ff', `type(vector)', `gl, gr', `type(bispinor)', `type(bispinor)') -BINARY(`va_ff', `type(vector)', `gv, ga', `type(bispinor)', `type(bispinor)') -BINARY(`f_vf', `type(bispinor)', `g', `type(vector)', `type(bispinor)') -BINARY(`f_af', `type(bispinor)', `g', `type(vector)', `type(bispinor)') -BINARY(`f_vlf', `type(bispinor)', `g', `type(vector)', `type(bispinor)') -BINARY(`f_vrf', `type(bispinor)', `g', `type(vector)', `type(bispinor)') -BINARY(`f_vlrf', `type(bispinor)', `gl, gr', `type(vector)', `type(bispinor)') -BINARY(`f_vaf', `type(bispinor)', `gv, ga', `type(vector)', `type(bispinor)') -BINARY(`s_ff', `complex(kind=default)', `g', `type(bispinor)', `type(bispinor)') -BINARY(`p_ff', `complex(kind=default)', `g', `type(bispinor)', `type(bispinor)') -BINARY(`sl_ff', `complex(kind=default)', `g', `type(bispinor)', `type(bispinor)') -BINARY(`sr_ff', `complex(kind=default)', `g', `type(bispinor)', `type(bispinor)') -BINARY(`slr_ff', `complex(kind=default)', `gl, gr', `type(bispinor)', `type(bispinor)') -BINARY(`sp_ff', `complex(kind=default)', `gv, ga', `type(bispinor)', `type(bispinor)') -BINARY(`f_sf', `type(bispinor)', `g', `complex(kind=default)', `type(bispinor)') -BINARY(`f_pf', `type(bispinor)', `g', `complex(kind=default)', `type(bispinor)') -BINARY(`f_slf', `type(bispinor)', `g', `complex(kind=default)', `type(bispinor)') -BINARY(`f_srf', `type(bispinor)', `g', `complex(kind=default)', `type(bispinor)') -BINARY(`f_slrf', `type(bispinor)', `gl, gr', `complex(kind=default)', `type(bispinor)') -BINARY(`f_spf', `type(bispinor)', `gv, ga', `complex(kind=default)', `type(bispinor)') -\nwendcode{}\nwbegindocs{880}\nwdocspar -\nwenddocs{}\nwbegincode{881}\moddef{\code{}omega{\_}spinor{\_}colors.m4\edoc{}}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -module omega_spinor_colors - use kinds - use omega_spinors - use omega_vectors - use omega_spinor_couplings - use omega_couplings - implicit none - private -DECLARATIONS -contains -IMPLEMENTATIONS -end module omega_spinor_colors -\nwendcode{}\nwbegindocs{882}\nwdocspar -\nwenddocs{}\nwbegincode{883}\moddef{\code{}omega{\_}bispinor{\_}colors.m4\edoc{}}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -module omega_bispinor_colors - use kinds - use omega_bispinors - use omega_vectors - use omega_bispinor_couplings - use omega_couplings - implicit none - private -DECLARATIONS -contains -IMPLEMENTATIONS -end module omega_bispinor_colors -\nwendcode{}\nwbegindocs{884}\subsection{Comments} -In the customary normalization -\begin{equation} - \tr\left( T_a T_b \right) = \frac{1}{2}\delta_{ab} -\end{equation} -the structure constants in -\begin{equation} - [ T_a , T_b] = \ii f_{abc} T_c -\end{equation} -are -\begin{equation} - f_{abc} = - 2\ii \tr\left([T_a,T_b]T_c\right) -\end{equation} -and the three gluon vertex can be represented symbolically: -\begin{equation} - \parbox{28mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(24,24) - \threeexternal{3}{1}{2} - \fmf{gluon}{v,e1} - \fmf{gluon}{v,e2} - \fmf{gluon}{v,e3} - \threeoutgoing - \end{fmfgraph*}}} - \quad\to\quad - \parbox{28mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(24,24) - \threeexternal{3}{1}{2} - \fmf{phantom}{v,e1} - \fmf{phantom}{v,e2} - \fmf{phantom}{v,e3} - \fmffreeze - \fmfipair{v,e[],a[],b[]} - \fmfiset{e1}{vloc (__e1)} - \fmfiset{e2}{vloc (__e2)} - \fmfiset{e3}{vloc (__e3)} - \fmfiset{v}{vloc (__v)} - \fmfiset{a1}{e1 shifted (-3thin,0)} - \fmfiset{b1}{e1 shifted (+1thin,-2thin)} - \fmfiset{a2}{e2 shifted (0,-3thin)} - \fmfiset{b2}{e2 shifted (0,+3thin)} - \fmfiset{a3}{e3 shifted (+1thin,+2thin)} - \fmfiset{b3}{e3 shifted (-3thin,0)} - \fmfi{plain}{a1{v-e1}...{e2-v}b2} - \fmfi{plain}{a2{v-e2}...{e3-v}b3} - \fmfi{plain}{a3{v-e3}...{e1-v}b1} - \end{fmfgraph*}}} - \quad-\quad - \parbox{28mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(24,24) - \threeexternal{3}{1}{2} - \fmf{phantom}{v,e1} - \fmf{phantom}{v,e2} - \fmf{phantom}{v,e3} - \fmffreeze - \fmfipair{v,e[],a[],b[]} - \fmfiset{e1}{vloc (__e1)} - \fmfiset{e2}{vloc (__e2)} - \fmfiset{e3}{vloc (__e3)} - \fmfiset{v}{vloc (__v)} - \fmfiset{a1}{e1 shifted (-3thin,0)} - \fmfiset{b1}{e1 shifted (+1thin,-2thin)} - \fmfiset{a2}{e2 shifted (0,-3thin)} - \fmfiset{b2}{e2 shifted (0,+3thin)} - \fmfiset{a3}{e3 shifted (+1thin,+2thin)} - \fmfiset{b3}{e3 shifted (-3thin,0)} - \fmfi{plain,rubout}{a2{v-e2}...{e1-v}b1} - \fmfi{plain,rubout}{a1{v-e1}...{e3-v}b3} - \fmfi{plain,rubout}{a3{v-e3}...{e2-v}b2} - \end{fmfgraph*}}} -\end{equation} -Using the completeness relation -\begin{equation} - [T_a]_{ij} [T_a]_{kl} = - \frac{1}{2} \left( \delta_{il} \delta_{jk} - - \frac{1}{N_C} \delta_{ij} \delta_{kl} \right) -\end{equation} -the contration of two structure constants read -\begin{multline} - \tr\left( T_a T_b T_e \right) \tr\left( T_c T_d T_e \right) - = \frac{1}{2} \tr\left( T_a T_b T_c T_d \right) - - \frac{1}{2N_C} \tr\left( T_a T_b \right) \tr\left( T_c T_d \right) \\ - = \frac{1}{2} \tr\left( T_a T_b T_c T_d \right) - - \frac{1}{8N_C} \delta_{ab} \delta_{cd} -\end{multline} -i.\,e. -\begin{equation} - f_{abe} f_{cde} = - 2 \left( - \tr\left( T_a T_b T_c T_d \right) - \tr\left( T_b T_a T_c T_d \right) - - \tr\left( T_a T_b T_d T_c \right) + \tr\left( T_b T_a T_d T_c \right) - \right) -\end{equation} -\newcommand{\gluonfoursome}{% - \fmfstraight - \fmfleft{a,b} - \fmfright{d,c} - \fmflabel{$a$}{a} - \fmflabel{$b$}{b} - \fmflabel{$c$}{c} - \fmflabel{$d$}{d} - \fmf{phantom}{ab,a} - \fmf{phantom}{ab,b} - \fmf{phantom}{ab,cd} - \fmf{phantom}{c,cd} - \fmf{phantom}{d,cd} - \fmffreeze - \fmfipair{ab,cd,a[],b[],c[],d[]} - \fmfiset{a[0]}{vloc (__a)} - \fmfiset{b[0]}{vloc (__b)} - \fmfiset{c[0]}{vloc (__c)} - \fmfiset{d[0]}{vloc (__d)} - \fmfiset{ab}{vloc (__ab)} - \fmfiset{cd}{vloc (__cd)} - \fmfiset{a[+1]}{a[0] shifted (+thick,-thick)} - \fmfiset{a[-1]}{a[0] shifted (-thick,+thick)} - \fmfiset{b[+1]}{b[0] shifted (-thick,-thick)} - \fmfiset{b[-1]}{b[0] shifted (+thick,+thick)} - \fmfiset{c[+1]}{c[0] shifted (-thick,+thick)} - \fmfiset{c[-1]}{c[0] shifted (+thick,-thick)} - \fmfiset{d[+1]}{d[0] shifted (+thick,+thick)} - \fmfiset{d[-1]}{d[0] shifted (-thick,-thick)}} -\begin{multline} - \parbox{40mm}{\fmfframe(2,4)(2,3){\begin{fmfgraph*}(36,24) - \fmfstraight - \fmfleft{a,b} - \fmfright{d,c} - \fmflabel{$a$}{a} - \fmflabel{$b$}{b} - \fmflabel{$c$}{c} - \fmflabel{$d$}{d} - \fmf{gluon}{ab,a} - \fmf{gluon}{ab,b} - \fmf{gluon}{ab,cd} - \fmf{gluon}{c,cd} - \fmf{gluon}{d,cd} - \fmfdot{ab,cd} - \end{fmfgraph*}}} - \quad\to\quad - \parbox{22mm}{\fmfframe(2,4)(2,3){\begin{fmfgraph*}(18,12) - \gluonfoursome - \fmfi{plain,rubout}{a[-1]{ab-a[0]}...{b[0]-ab}b[+1]} - \fmfi{plain,rubout}{b[-1]{ab-b[0]}...{c[0]-cd}c[+1]} - \fmfi{plain,rubout}{c[-1]{cd-c[0]}...{d[0]-cd}d[+1]} - \fmfi{plain,rubout}{d[-1]{cd-d[0]}...{a[0]-ab}a[+1]} - \end{fmfgraph*}}} \\ - -\quad - \parbox{22mm}{\fmfframe(2,4)(2,3){\begin{fmfgraph*}(18,12) - \gluonfoursome - \fmfi{plain,rubout}{a[-1]{ab-a[0]}...{b[0]-ab}b[+1]} - \fmfi{plain,rubout}{b[-1]{ab-b[0]}...{d[0]-cd}d[+1]} - \fmfi{plain,rubout}{d[-1]{cd-d[0]}...{c[0]-cd}c[+1]} - \fmfi{plain,rubout}{c[-1]{cd-c[0]}...{a[0]-ab}a[+1]} - \end{fmfgraph*}}} - -\quad - \parbox{22mm}{\fmfframe(2,4)(2,3){\begin{fmfgraph*}(18,12) - \gluonfoursome - \fmfi{plain,rubout}{b[-1]{ab-b[0]}...{a[0]-ab}a[+1]} - \fmfi{plain,rubout}{a[-1]{ab-a[0]}...{c[0]-cd}c[+1]} - \fmfi{plain,rubout}{c[-1]{cd-c[0]}...{d[0]-cd}d[+1]} - \fmfi{plain,rubout}{d[-1]{cd-d[0]}...{b[0]-ab}b[+1]} - \end{fmfgraph*}}} - \quad+\quad - \parbox{22mm}{\fmfframe(2,4)(2,3){\begin{fmfgraph*}(18,12) - \gluonfoursome - \fmfi{plain,rubout}{b[-1]{ab-b[0]}...{a[0]-ab}a[+1]} - \fmfi{plain,rubout}{a[-1]{ab-a[0]}...{d[0]-cd}d[+1]} - \fmfi{plain,rubout}{d[-1]{cd-d[0]}...{c[0]-cd}c[+1]} - \fmfi{plain,rubout}{c[-1]{cd-c[0]}...{b[0]-ab}b[+1]} - \end{fmfgraph*}}} -\end{multline} -In a more convenient normalization -\begin{equation} - \tr\left(\hat T_a \hat T_b\right) = \delta_{ab} -\end{equation} -with -\begin{equation} - [ \hat T_a, \hat T_b] = \ii \hat f_{abc} \hat T_c -\end{equation} -i.\,e. -\begin{subequations} -\begin{align} - \hat T_a &= \sqrt{2} \cdot T_a \\ - \hat f_{abc} &= \sqrt{2} \cdot f_{abc} -\end{align} -\end{subequations} -all factors of~$2$ cancel in -\begin{equation} - \hat f_{abc} = - \ii \tr\left([\hat T_a,\hat T_b]\hat T_c\right) -\end{equation} -and -\begin{equation} - [\hat T_a]_{ij} [\hat T_a]_{kl} = - \delta_{il} \delta_{jk} - \frac{1}{N_C} \delta_{ij} \delta_{kl} -\end{equation} -Therefore also in -\begin{multline} - \tr\left( \hat T_a \hat T_b \hat T_e \right) \tr\left( \hat T_c \hat T_d \hat T_e \right) - = \tr\left( \hat T_a \hat T_b \hat T_c \hat T_d \right) - - \frac{1}{N_C} \tr\left( \hat T_a \hat T_b \right) \tr\left( \hat T_c \hat T_d \right) \\ - = \tr\left( \hat T_a \hat T_b \hat T_c \hat T_d \right) - - \frac{1}{N_C} \delta_{ab} \delta_{cd} -\end{multline} -and -\begin{equation} - \hat f_{abe} \hat f_{cde} = - - \tr\left( \hat T_a \hat T_b \hat T_c \hat T_d \right) - + \tr\left( \hat T_b \hat T_a \hat T_c \hat T_d \right) - + \tr\left( \hat T_a \hat T_b \hat T_d \hat T_c \right) - - \tr\left( \hat T_b \hat T_a \hat T_d \hat T_c \right) -\end{equation} -\begin{dubious} - The adjoint representation of $\mathrm{SU}(N_C)$ is not the most convenient - basis: we will use $N_C\otimes\overline{N_C}$ instead and provide a special - version for $N_C\to\infty$. -\end{dubious} -Up to normalization: -\begin{subequations} -\begin{align} - (\alpha,\bar\alpha) \cdot (\beta,\bar\beta) - &= (\alpha,\bar\beta) \delta_{\bar\alpha,\beta} - - (\beta,\bar\alpha) \delta_{\bar\beta,\alpha} \\ - \bar\alpha \cdot (\beta,\bar\beta) - &= \bar\beta \delta_{\bar\alpha,\beta} \\ - (\alpha,\bar\alpha) \cdot \beta - &= \alpha \delta_{\bar\alpha,\beta} -\end{align} -\end{subequations} -\begin{dubious} - Unfortunately -\end{dubious} -\nwenddocs{}\nwbegindocs{885}\section{Utilities} -\nwenddocs{}\nwbegincode{886}\moddef{\code{}omega{\_}utils.f95\edoc{}}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -\LA{}Copyleft\RA{} -module omega_utils - use kinds - use omega_vectors - use omega_polarizations - implicit none - private - \LA{}Declaration of utility functions\RA{} - \LA{}Numerical tolerances\RA{} - integer, parameter, private :: REPEAT = 5, SAMPLE = 10 - integer, parameter, public :: omega_utils_2003_03_A = 0 -contains - \LA{}Implementation of utility functions\RA{} -end module omega_utils -\nwendcode{}\nwbegindocs{887}\subsection{Diagnostics} -\nwenddocs{}\nwbegincode{888}\moddef{Declaration of utility functions}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -public :: omega_ward_warn, omega_ward_panic -\nwendcode{}\nwbegindocs{889}The O'Mega amplitudes have only one particle off shell and are the -sum of \emph{all} possible diagrams with the other particles -on-shell. -\begin{dubious} - The problem with these gauge checks is that are numerically very - small amplitudes that vanish analytically and that violate - transversality. The hard part is to determine the thresholds that - make threse tests usable. -\end{dubious} -\nwenddocs{}\nwbegincode{890}\moddef{Implementation of utility functions}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -subroutine omega_ward_warn (name, m, k, e) - character(len=*), intent(in) :: name - real(kind=default), intent(in) :: m - type(momentum), intent(in) :: k - type(vector), intent(in) :: e - type(vector) :: ek - real(kind=default) :: abs_eke, abs_ek_abs_e - ek = eps (m, k, 4) - abs_eke = abs (ek * e) - abs_ek_abs_e = abs (ek) * abs (e) - print *, name, ":", abs_eke / abs_ek_abs_e, abs (ek), abs (e) - if (abs_eke > 1000 * epsilon (abs_ek_abs_e)) then - print *, "O'Mega: warning: non-transverse vector field: ", & - name, ":", abs_eke / abs_ek_abs_e, abs (e) - end if -end subroutine omega_ward_warn -\nwendcode{}\nwbegindocs{891}\nwdocspar -\nwenddocs{}\nwbegincode{892}\moddef{Implementation of utility functions}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -subroutine omega_ward_panic (name, m, k, e) - character(len=*), intent(in) :: name - real(kind=default), intent(in) :: m - type(momentum), intent(in) :: k - type(vector), intent(in) :: e - type(vector) :: ek - real(kind=default) :: abs_eke, abs_ek_abs_e - ek = eps (m, k, 4) - abs_eke = abs (ek * e) - abs_ek_abs_e = abs (ek) * abs (e) - if (abs_eke > 1000 * epsilon (abs_ek_abs_e)) then - print *, "O'Mega: panic: non-transverse vector field: ", & - name, ":", abs_eke / abs_ek_abs_e, abs (e) - stop - end if -end subroutine omega_ward_panic -\nwendcode{}\nwbegindocs{893}\nwdocspar -\nwenddocs{}\nwbegincode{894}\moddef{Declaration of utility functions}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -public :: omega_slavnov_warn, omega_slavnov_panic -\nwendcode{}\nwbegindocs{895}\nwdocspar -\nwenddocs{}\nwbegincode{896}\moddef{Implementation of utility functions}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -subroutine omega_slavnov_warn (name, m, k, e, phi) - character(len=*), intent(in) :: name - real(kind=default), intent(in) :: m - type(momentum), intent(in) :: k - type(vector), intent(in) :: e - complex(kind=default), intent(in) :: phi - type(vector) :: ek - real(kind=default) :: abs_eke, abs_ek_abs_e - ek = eps (m, k, 4) - abs_eke = abs (ek * e - phi) - abs_ek_abs_e = abs (ek) * abs (e) - print *, name, ":", abs_eke / abs_ek_abs_e, abs (ek), abs (e) - if (abs_eke > 1000 * epsilon (abs_ek_abs_e)) then - print *, "O'Mega: warning: non-transverse vector field: ", & - name, ":", abs_eke / abs_ek_abs_e, abs (e) - end if -end subroutine omega_slavnov_warn -\nwendcode{}\nwbegindocs{897}\nwdocspar -\nwenddocs{}\nwbegincode{898}\moddef{Implementation of utility functions}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -subroutine omega_slavnov_panic (name, m, k, e, phi) - character(len=*), intent(in) :: name - real(kind=default), intent(in) :: m - type(momentum), intent(in) :: k - type(vector), intent(in) :: e - complex(kind=default), intent(in) :: phi - type(vector) :: ek - real(kind=default) :: abs_eke, abs_ek_abs_e - ek = eps (m, k, 4) - abs_eke = abs (ek * e - phi) - abs_ek_abs_e = abs (ek) * abs (e) - if (abs_eke > 1000 * epsilon (abs_ek_abs_e)) then - print *, "O'Mega: panic: non-transverse vector field: ", & - name, ":", abs_eke / abs_ek_abs_e, abs (e) - stop - end if -end subroutine omega_slavnov_panic -\nwendcode{}\nwbegindocs{899}\nwdocspar -\nwenddocs{}\nwbegincode{900}\moddef{Declaration of utility functions}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -public :: omega_check_arguments_warn, omega_check_arguments_panic -\nwendcode{}\nwbegindocs{901}\nwdocspar -\nwenddocs{}\nwbegincode{902}\moddef{Implementation of utility functions}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -subroutine omega_check_arguments_warn (n, k, s) - integer, intent(in) :: n - real(kind=default), dimension(0:,:), intent(in) :: k - integer, dimension(:), intent(in) :: s - integer :: i - i = size(k,dim=1) - if (i /= 4) then - print *, "O'Mega: warning: wrong # of dimensions:", i - end if - i = size(k,dim=2) - if (i /= n) then - print *, "O'Mega: warning: wrong # of momenta:", i, & - ", expected", n - end if - i = size (s) - if (i /= n) then - print *, "O'Mega: warning: wrong # of spins:", i, & - ", expected", n - end if -end subroutine omega_check_arguments_warn -\nwendcode{}\nwbegindocs{903}\nwdocspar -\nwenddocs{}\nwbegincode{904}\moddef{Implementation of utility functions}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -subroutine omega_check_arguments_panic (n, k, s) - integer, intent(in) :: n - real(kind=default), dimension(0:,:), intent(in) :: k - integer, dimension(:), intent(in) :: s - logical :: error - integer :: i - error = .false. - i = size(k,dim=1) - if (i /= n) then - print *, "O'Mega: warning: wrong # of dimensions:", i - error = .true. - end if - i = size(k,dim=2) - if (i /= n) then - print *, "O'Mega: warning: wrong # of momenta:", i, & - ", expected", n - error = .true. - end if - i = size (s) - if (i /= n) then - print *, "O'Mega: warning: wrong # of spins:", i, & - ", expected", n - error = .true. - end if - if (error) then - stop - end if -end subroutine omega_check_arguments_panic -\nwendcode{}\nwbegindocs{905}\nwdocspar -\nwenddocs{}\nwbegincode{906}\moddef{Declaration of utility functions}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -public :: omega_check_helicities_warn, omega_check_helicities_panic -private :: omega_check_helicity -\nwendcode{}\nwbegindocs{907}\nwdocspar -\nwenddocs{}\nwbegincode{908}\moddef{Implementation of utility functions}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -function omega_check_helicity (m, smax, s) result (error) - real(kind=default), intent(in) :: m - integer, intent(in) :: smax, s - logical :: error - select case (smax) - case (0) - error = (s /= 0) - case (1) - error = (abs (s) /= 1) - case (2) - if (m == 0.0_default) then - error = .not. (abs (s) == 1 .or. abs (s) == 4) - else - error = .not. (abs (s) <= 1 .or. abs (s) == 4) - end if - case (4) - error = .true. - case default - error = .true. - end select -end function omega_check_helicity -\nwendcode{}\nwbegindocs{909}\nwdocspar -\nwenddocs{}\nwbegincode{910}\moddef{Implementation of utility functions}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -subroutine omega_check_helicities_warn (m, smax, s) - real(kind=default), dimension(:), intent(in) :: m - integer, dimension(:), intent(in) :: smax, s - integer :: i - do i = 1, size (m) - if (omega_check_helicity (m(i), smax(i), s(i))) then - print *, "O'Mega: warning: invalid helicity", s(i) - end if - end do -end subroutine omega_check_helicities_warn -\nwendcode{}\nwbegindocs{911}\nwdocspar -\nwenddocs{}\nwbegincode{912}\moddef{Implementation of utility functions}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -subroutine omega_check_helicities_panic (m, smax, s) - real(kind=default), dimension(:), intent(in) :: m - integer, dimension(:), intent(in) :: smax, s - logical :: error - logical :: error1 - integer :: i - error = .false. - do i = 1, size (m) - error1 = omega_check_helicity (m(i), smax(i), s(i)) - if (error1) then - print *, "O'Mega: panic: invalid helicity", s(i) - error = .true. - end if - end do - if (error) then - stop - end if -end subroutine omega_check_helicities_panic -\nwendcode{}\nwbegindocs{913}\nwdocspar -\nwenddocs{}\nwbegincode{914}\moddef{Declaration of utility functions}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -public :: omega_check_momenta_warn, omega_check_momenta_panic -private :: check_momentum_conservation, check_mass_shell -\nwendcode{}\nwbegindocs{915}\nwdocspar -\nwenddocs{}\nwbegincode{916}\moddef{Numerical tolerances}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -integer, parameter, private :: MOMENTUM_TOLERANCE = 10000 -\nwendcode{}\nwbegindocs{917}\nwdocspar -\nwenddocs{}\nwbegincode{918}\moddef{Implementation of utility functions}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -function check_momentum_conservation (k) result (error) - real(kind=default), dimension(0:,:), intent(in) :: k - logical :: error - error = any (abs (sum (k(:,3:), dim = 2) - k(:,1) - k(:,2)) > & - MOMENTUM_TOLERANCE * epsilon (maxval (abs (k), dim = 2))) - if (error) then - print *, sum (k(:,3:), dim = 2) - k(:,1) - k(:,2) - print *, MOMENTUM_TOLERANCE * epsilon (maxval (abs (k), dim = 2)), & - maxval (abs (k), dim = 2) - end if -end function check_momentum_conservation -\nwendcode{}\nwbegindocs{919}\nwdocspar -\nwenddocs{}\nwbegincode{920}\moddef{Numerical tolerances}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -integer, parameter, private :: ON_SHELL_TOLERANCE = 1000000 -\nwendcode{}\nwbegindocs{921}\nwdocspar -\nwenddocs{}\nwbegincode{922}\moddef{Implementation of utility functions}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -function check_mass_shell (m, k) result (error) - real(kind=default), intent(in) :: m - real(kind=default), dimension(0:), intent(in) :: k - real(kind=default) :: e2 - logical :: error - e2 = k(1)**2 + k(2)**2 + k(3)**2 + m**2 - error = abs (k(0)**2 - e2) > ON_SHELL_TOLERANCE * epsilon (max (k(0)**2, e2)) - if (error) then - print *, k(0)**2 - e2 - print *, ON_SHELL_TOLERANCE * epsilon (max (k(0)**2, e2)), max (k(0)**2, e2) - end if -end function check_mass_shell -\nwendcode{}\nwbegindocs{923}\nwdocspar -\nwenddocs{}\nwbegincode{924}\moddef{Implementation of utility functions}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -subroutine omega_check_momenta_warn (m, k) - real(kind=default), dimension(:), intent(in) :: m - real(kind=default), dimension(0:,:), intent(in) :: k - integer :: i - if (check_momentum_conservation (k)) then - print *, "O'Mega: warning: momentum not conserved" - end if - do i = 1, size(m) - if (check_mass_shell (m(i), k(:,i))) then - print *, "O'Mega: warning: particle #", i, "not on-shell" - end if - end do -end subroutine omega_check_momenta_warn -\nwendcode{}\nwbegindocs{925}\nwdocspar -\nwenddocs{}\nwbegincode{926}\moddef{Implementation of utility functions}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -subroutine omega_check_momenta_panic (m, k) - real(kind=default), dimension(:), intent(in) :: m - real(kind=default), dimension(0:,:), intent(in) :: k - logical :: error - logical :: error1 - integer :: i - error = check_momentum_conservation (k) - if (error) then - print *, "O'Mega: panic: momentum not conserved" - end if - do i = 1, size(m) - error1 = check_mass_shell (m(i), k(0:,i)) - if (error1) then - print *, "O'Mega: panic: particle #", i, "not on-shell" - error = .true. - end if - end do - if (error) then - stop - end if -end subroutine omega_check_momenta_panic -\nwendcode{}\nwbegindocs{927}\subsection{Summation \&\ Density Matrices} -\nwenddocs{}\nwbegincode{928}\moddef{Declaration of utility functions}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -public :: omega_spin_sum_sqme_1, omega_sum_sqme -\nwendcode{}\nwbegindocs{929}\nwdocspar -\nwenddocs{}\nwbegincode{930}\moddef{Implementation of utility functions}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function omega_spin_sum_sqme_1 & - (amplitude_1, k, f, s_max, smask) result (amp2) - real(kind=default), dimension(0:,:), intent(in) :: k - integer, intent(in) :: f, s_max - logical, dimension(:), intent(in), optional :: smask - real(kind=default) :: amp2 - \LA{}Interface \code{}amplitude{\_}1\edoc{}\RA{} - complex(kind=default) :: amp - integer :: s - amp2 = 0 - if (present (smask)) then - do s = 1, s_max - if (smask(s)) then - amp = amplitude_1 (k, s, f) - amp2 = amp2 + amp * conjg (amp) - end if - end do - else - do s = 1, s_max - amp = amplitude_1 (k, s, f) - amp2 = amp2 + amp * conjg (amp) - end do - end if -end function omega_spin_sum_sqme_1 -\nwendcode{}\nwbegindocs{931}\nwdocspar -\nwenddocs{}\nwbegincode{932}\moddef{Interface \code{}amplitude{\_}1\edoc{}}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -interface - pure function amplitude_1 (k, s, f) result (amp) - use kinds - implicit none - real(kind=default), dimension(0:,:), intent(in) :: k - integer, intent(in) :: s, f - complex(kind=default) :: amp - end function amplitude_1 -end interface -\nwendcode{}\nwbegindocs{933}\nwdocspar -\nwenddocs{}\nwbegincode{934}\moddef{Implementation of utility functions}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function omega_sum_sqme & - (amplitude_1, k, s_max, f_max, mult, smask, fmask) result (amp2) - real(kind=default), dimension(0:,:), intent(in) :: k - integer, intent(in) :: s_max, f_max - integer, dimension(:), intent(in) :: mult - logical, dimension(:), intent(in), optional :: smask, fmask - real(kind=default) :: amp2 - \LA{}Interface \code{}amplitude{\_}1\edoc{}\RA{} - complex(kind=default) :: amp - integer :: s, f - amp2 = 0 - if (present (smask)) then - if (present (fmask)) then - do s = 1, s_max - if (smask(s)) then - do f = 1, f_max - if (fmask(f)) then - amp = amplitude_1 (k, s, f) - amp2 = amp2 + amp * conjg (amp) / mult(f) - end if - end do - end if - end do - else - do s = 1, s_max - if (smask(s)) then - do f = 1, f_max - amp = amplitude_1 (k, s, f) - amp2 = amp2 + amp * conjg (amp) / mult(f) - end do - end if - end do - end if - else - if (present (fmask)) then - do f = 1, f_max - if (fmask(f)) then - do s = 1, s_max - amp = amplitude_1 (k, s, f) - amp2 = amp2 + amp * conjg (amp) / mult(f) - end do - end if - end do - else - do s = 1, s_max - do f = 1, f_max - amp = amplitude_1 (k, s, f) - amp2 = amp2 + amp * conjg (amp) / mult(f) - end do - end do - end if - end if -end function omega_sum_sqme -\nwendcode{}\nwbegindocs{935}\nwdocspar -\nwenddocs{}\nwbegincode{936}\moddef{Declaration of utility functions}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -public :: omega_spin_sum_sqme_1_nonzero, omega_sum_sqme_nonzero -\nwendcode{}\nwbegindocs{937}\nwdocspar -\nwenddocs{}\nwbegincode{938}\moddef{Implementation of utility functions}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure subroutine omega_spin_sum_sqme_1_nonzero & - (amplitude_1, amp2, k, f, zero, n, smask) - real(kind=default), intent(out) :: amp2 - real(kind=default), dimension(0:,:), intent(in) :: k - integer, intent(in) :: f - integer, dimension(:,:), intent(inout) :: zero - integer, intent(in) :: n - logical, dimension(:), intent(in), optional :: smask - \LA{}Interface \code{}amplitude{\_}1\edoc{}\RA{} - complex(kind=default) :: amp - real(kind=default) :: dummy - integer :: s, i - if (n <= SAMPLE) then - call omega_sum_sqme_nonzero & - (amplitude_1, dummy, k, (/ (1, i = 1, size(zero,dim=2)) /), zero, n) - end if - amp2 = 0 - if (present (smask)) then - do s = 1, size(zero,dim=1) - if (smask(s)) then - if (zero(s,f) <= REPEAT) then - amp = amplitude_1 (k, s, f) - amp2 = amp2 + amp * conjg (amp) - end if - end if - end do - else - do s = 1, size(zero,dim=1) - if (zero(s,f) <= REPEAT) then - amp = amplitude_1 (k, s, f) - amp2 = amp2 + amp * conjg (amp) - end if - end do - end if -end subroutine omega_spin_sum_sqme_1_nonzero -\nwendcode{}\nwbegindocs{939}\nwdocspar -\nwenddocs{}\nwbegincode{940}\moddef{Implementation of utility functions}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure subroutine omega_sum_sqme_nonzero & - (amplitude_1, amp2, k, mult, zero, n, smask, fmask) - real(kind=default), intent(out) :: amp2 - real(kind=default), dimension(0:,:), intent(in) :: k - integer, dimension(:), intent(in) :: mult - integer, dimension(:,:), intent(inout) :: zero - integer, intent(in) :: n - logical, dimension(:), intent(in), optional :: smask, fmask - \LA{}Interface \code{}amplitude{\_}1\edoc{}\RA{} - complex(kind=default) :: amp - integer :: s, f - if (n <= SAMPLE) then - do s = 1, size(zero,dim=1) - do f = 1, size(zero,dim=2) - if (zero(s,f) <= REPEAT) then - amp = amplitude_1 (k, s, f) - if (real (amp * conjg (amp), kind=default) & - <= tiny (1.0_default)) then - zero(s,f) = zero(s,f) + 1 - end if - end if - end do - end do - end if - amp2 = 0 - if (present (smask)) then - if (present (fmask)) then - do s = 1, size(zero,dim=1) - if (smask(s)) then - do f = 1, size(zero,dim=2) - if (fmask(f)) then - if (zero(s,f) <= REPEAT) then - amp = amplitude_1 (k, s, f) - amp2 = amp2 + amp * conjg (amp) / mult(f) - end if - end if - end do - end if - end do - else - do s = 1, size(zero,dim=1) - if (smask(s)) then - do f = 1, size(zero,dim=2) - if (zero(s,f) <= REPEAT) then - amp = amplitude_1 (k, s, f) - amp2 = amp2 + amp * conjg (amp) / mult(f) - end if - end do - end if - end do - end if - else - if (present (fmask)) then - do f = 1, size(zero,dim=2) - if (fmask(f)) then - do s = 1, size(zero,dim=1) - if (zero(s,f) <= REPEAT) then - amp = amplitude_1 (k, s, f) - amp2 = amp2 + amp * conjg (amp) / mult(f) - end if - end do - end if - end do - else - do s = 1, size(zero,dim=1) - do f = 1, size(zero,dim=2) - if (zero(s,f) <= REPEAT) then - amp = amplitude_1 (k, s, f) - amp2 = amp2 + amp * conjg (amp) / mult(f) - end if - end do - end do - end if - end if -end subroutine omega_sum_sqme_nonzero -\nwendcode{}\nwbegindocs{941}\nwdocspar -\nwenddocs{}\nwbegincode{942}\moddef{Declaration of utility functions}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -public :: omega_amplitude_1_nonzero, omega_amplitude_2_nonzero -\nwendcode{}\nwbegindocs{943}\nwdocspar -\nwenddocs{}\nwbegincode{944}\moddef{Implementation of utility functions}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure subroutine omega_amplitude_1_nonzero & - (amplitude_1, amp, k, s, f, zero, n) - complex(kind=default), intent(out) :: amp - real(kind=default), dimension(0:,:), intent(in) :: k - integer, intent(in) :: s, f - integer, dimension(:,:), intent(inout) :: zero - integer, intent(in) :: n - \LA{}Interface \code{}amplitude{\_}1\edoc{}\RA{} - integer :: i - real(kind=default) :: dummy - if (n <= SAMPLE) then - call omega_sum_sqme_nonzero & - (amplitude_1, dummy, k, (/ (1, i = 1, size(zero,dim=2)) /), zero, n) - end if - if (zero(s,f) < REPEAT) then - amp = amplitude_1 (k, s, f) - else - amp = 0 - end if -end subroutine omega_amplitude_1_nonzero -\nwendcode{}\nwbegindocs{945}\nwdocspar -\nwenddocs{}\nwbegincode{946}\moddef{Implementation of utility functions}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure subroutine omega_amplitude_2_nonzero & - (amplitude_2, amp, k, s_in, f_in, s_out, f_out, zero, n) - complex(kind=default), intent(out) :: amp - real(kind=default), dimension(0:,:), intent(in) :: k - integer, intent(in) :: s_in, f_in, s_out, f_out - integer, dimension(:,:,:,:), intent(inout) :: zero - integer, intent(in) :: n - \LA{}Interface \code{}amplitude{\_}2\edoc{}\RA{} - integer :: si, fi, so, fo - if (n <= SAMPLE) then - do si = 1, size(zero,dim=1) - do fi = 1, size(zero,dim=2) - do so = 1, size(zero,dim=3) - do fo = 1, size(zero,dim=4) - if (zero(si,fi,so,fo) <= REPEAT) then - amp = amplitude_2 (k, si, fi, so, fo) - if (real (amp * conjg (amp), kind=default) & - <= tiny (1.0_default)) then - zero(si,fi,so,fo) = zero(si,fi,so,fo) + 1 - end if - end if - end do - end do - end do - end do - end if - if (zero(s_in,f_in,s_out,f_out) < REPEAT) then - amp = amplitude_2 (k, s_in, f_in, s_out, f_out) - else - amp = 0 - end if -end subroutine omega_amplitude_2_nonzero -\nwendcode{}\nwbegindocs{947}\nwdocspar -\begin{equation} - \rho \to \rho' = T \rho T^{\dagger} -\end{equation} -I.\,e. -\begin{equation} - \rho'_{ff'} = \sum_{ii'} T_{fi} \rho_{ii'} T^{*}_{i'f'} -\end{equation} -\nwenddocs{}\nwbegincode{948}\moddef{Declaration of utility functions}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -public :: omega_scatter, omega_scatter_nonzero -\nwendcode{}\nwbegindocs{949}\nwdocspar -\nwenddocs{}\nwbegincode{950}\moddef{Implementation of utility functions}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure subroutine omega_scatter (amplitude_2, k, rho_in, rho_out, mult) - real(kind=default), dimension(0:,:), intent(in) :: k - complex(kind=default), dimension(:,:,:,:), intent(in) :: rho_in - complex(kind=default), dimension(:,:,:,:), intent(inout) :: rho_out - integer, dimension(:), intent(in) :: mult - \LA{}Interface \code{}amplitude{\_}2\edoc{}\RA{} - integer :: s_in1, s_in2, f_in1, f_in2, s_out1, s_out2, f_out1, f_out2 - complex(kind=default), & - dimension(size(rho_in,dim=1),size(rho_in,dim=2),& - size(rho_out,dim=1),size(rho_out,dim=2)) :: a - do s_in1 = 1, size(rho_in,dim=1) - do f_in1 = 1, size(rho_in,dim=2) - do s_out1 = 1, size(rho_out,dim=1) - do f_out1 = 1, size(rho_out,dim=2) - a(s_in1,f_in1,s_out1,f_out1) = & - amplitude_2 (k, s_in1, f_in1, s_out1, f_out1) & - / sqrt (real (mult(f_out1), kind=default)) - end do - end do - end do - end do - do s_out1 = 1, size(rho_out,dim=1) - do f_out1 = 1, size(rho_out,dim=2) - do s_out2 = 1, size(rho_out,dim=3) - do f_out2 = 1, size(rho_out,dim=4) - rho_out(s_out1,f_out1,s_out2,f_out2) = 0 - do s_in1 = 1, size(rho_in,dim=1) - do f_in1 = 1, size(rho_in,dim=2) - do s_in2 = 1, size(rho_in,dim=3) - do f_in2 = 1, size(rho_in,dim=4) - rho_out(s_out1,f_out1,s_out2,f_out2) = & - rho_out(s_out1,f_out1,s_out2,f_out2) & - + a(s_in1,f_in1,s_out1,f_out1) & - * rho_in(s_in1,f_in1,s_in2,f_in2) & - * conjg (a(s_in2,f_in2,s_out2,f_out2)) - end do - end do - end do - end do - end do - end do - end do - end do -end subroutine omega_scatter -\nwendcode{}\nwbegindocs{951}\nwdocspar -\nwenddocs{}\nwbegincode{952}\moddef{Interface \code{}amplitude{\_}2\edoc{}}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -interface - pure function amplitude_2 (k, s_in, f_in, s_out, f_out) result (amp) - use kinds - implicit none - real(kind=default), dimension(0:,:), intent(in) :: k - integer, intent(in) :: s_in, f_in, s_out, f_out - complex(kind=default) :: amp - end function amplitude_2 -end interface -\nwendcode{}\nwbegindocs{953}\nwdocspar -\nwenddocs{}\nwbegincode{954}\moddef{Implementation of utility functions}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure subroutine omega_scatter_nonzero & - (amplitude_2, k, rho_in, rho_out, mult, zero, n) - real(kind=default), dimension(0:,:), intent(in) :: k - complex(kind=default), dimension(:,:,:,:), intent(in) :: rho_in - complex(kind=default), dimension(:,:,:,:), intent(inout) :: rho_out - integer, dimension(:), intent(in) :: mult - integer, dimension(:,:,:,:), intent(inout) :: zero - integer, intent(in) :: n - \LA{}Interface \code{}amplitude{\_}2\edoc{} (non zero)\RA{} - integer :: s_in1, s_in2, f_in1, f_in2, s_out1, s_out2, f_out1, f_out2 - complex(kind=default), & - dimension(size(rho_in,dim=1),size(rho_in,dim=2),& - size(rho_out,dim=1),size(rho_out,dim=2)) :: a - do s_in1 = 1, size(rho_in,dim=1) - do f_in1 = 1, size(rho_in,dim=2) - do s_out1 = 1, size(rho_out,dim=1) - do f_out1 = 1, size(rho_out,dim=2) - call amplitude_2 (a(s_in1,f_in1,s_out1,f_out1), & - k, s_in1, f_in1, s_out1, f_out1, zero, n) - a(s_in1,f_in1,s_out1,f_out1) = & - a(s_in1,f_in1,s_out1,f_out1) & - / sqrt (real (mult(f_out1), kind=default)) - end do - end do - end do - end do - do s_out1 = 1, size(rho_out,dim=1) - do f_out1 = 1, size(rho_out,dim=2) - do s_out2 = 1, size(rho_out,dim=3) - do f_out2 = 1, size(rho_out,dim=4) - rho_out(s_out1,f_out1,s_out2,f_out2) = 0 - do s_in1 = 1, size(rho_in,dim=1) - do f_in1 = 1, size(rho_in,dim=2) - do s_in2 = 1, size(rho_in,dim=3) - do f_in2 = 1, size(rho_in,dim=4) - rho_out(s_out1,f_out1,s_out2,f_out2) = & - rho_out(s_out1,f_out1,s_out2,f_out2) & - + a(s_in1,f_in1,s_out1,f_out1) & - * rho_in(s_in1,f_in1,s_in2,f_in2) & - * conjg (a(s_in2,f_in2,s_out2,f_out2)) - end do - end do - end do - end do - end do - end do - end do - end do -end subroutine omega_scatter_nonzero -\nwendcode{}\nwbegindocs{955}\nwdocspar -\nwenddocs{}\nwbegincode{956}\moddef{Interface \code{}amplitude{\_}2\edoc{} (non zero)}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -interface - pure subroutine amplitude_2 (amp, k, s_in, f_in, s_out, f_out, zero, n) - use kinds - implicit none - complex(kind=default), intent(out) :: amp - real(kind=default), dimension(0:,:), intent(in) :: k - integer, intent(in) :: s_in, f_in, s_out, f_out - integer, dimension(:,:,:,:), intent(inout) :: zero - integer, intent(in) :: n - end subroutine amplitude_2 -end interface -\nwendcode{}\nwbegindocs{957}\nwdocspar -\begin{equation} - \rho'_{f} = \sum_i T_{fi} \rho_{i} T^{*}_{if} - = \sum_i |T_{fi}|^2 \rho_{i} -\end{equation} -\nwenddocs{}\nwbegincode{958}\moddef{Declaration of utility functions}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -public :: omega_scatter_diagonal, omega_scatter_diagonal_nonzero -\nwendcode{}\nwbegindocs{959}\nwdocspar -\nwenddocs{}\nwbegincode{960}\moddef{Implementation of utility functions}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure subroutine omega_scatter_diagonal & - (amplitude_2, k, rho_in, rho_out, mult) - real(kind=default), dimension(0:,:), intent(in) :: k - real(kind=default), dimension(:,:), intent(in) :: rho_in - real(kind=default), dimension(:,:), intent(inout) :: rho_out - integer, dimension(:), intent(in) :: mult - \LA{}Interface \code{}amplitude{\_}2\edoc{}\RA{} - integer :: s_in, f_in, s_out, f_out - complex(kind=default) :: a - do s_out = 1, size(rho_out,dim=1) - do f_out = 1, size(rho_out,dim=2) - rho_out(s_out,f_out) = 0 - do s_in = 1, size(rho_in,dim=1) - do f_in = 1, size(rho_in,dim=2) - a = amplitude_2 (k, s_in, f_in, s_out, f_out) - rho_out(s_out,f_out) = rho_out(s_out,f_out) & - + rho_in(s_in,f_in) * real (a*conjg(a), kind=default) & - / mult(f_out) - end do - end do - end do - end do -end subroutine omega_scatter_diagonal -\nwendcode{}\nwbegindocs{961}\nwdocspar -\nwenddocs{}\nwbegincode{962}\moddef{Implementation of utility functions}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure subroutine omega_scatter_diagonal_nonzero & - (amplitude_2, k, rho_in, rho_out, mult, zero, n) - real(kind=default), dimension(0:,:), intent(in) :: k - real(kind=default), dimension(:,:), intent(in) :: rho_in - real(kind=default), dimension(:,:), intent(inout) :: rho_out - integer, dimension(:), intent(in) :: mult - integer, dimension(:,:,:,:), intent(inout) :: zero - integer, intent(in) :: n - \LA{}Interface \code{}amplitude{\_}2\edoc{} (non zero)\RA{} - integer :: s_in, f_in, s_out, f_out - complex(kind=default) :: a - do s_out = 1, size(rho_out,dim=1) - do f_out = 1, size(rho_out,dim=2) - rho_out(s_out,f_out) = 0 - do s_in = 1, size(rho_in,dim=1) - do f_in = 1, size(rho_in,dim=2) - call amplitude_2 (a, k, s_in, f_in, s_out, f_out, zero, n) - rho_out(s_out,f_out) = rho_out(s_out,f_out) & - + rho_in(s_in,f_in) * real (a*conjg(a), kind=default) & - / mult(f_out) - end do - end do - end do - end do -end subroutine omega_scatter_diagonal_nonzero -\nwendcode{}\nwbegindocs{963}\subsubsection{Flavor Summation} -\begin{dubious} - Interface to WHIZARD here \ldots -\end{dubious} -\nwenddocs{}\nwbegincode{964}\moddef{Declaration of utility functions}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -\nwendcode{}\nwbegindocs{965}\nwdocspar -\nwenddocs{}\nwbegincode{966}\moddef{Implementation of utility functions}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -\nwendcode{}\nwbegindocs{967}\subsection{Obsolescent Summation} -\subsubsection{Spin/Helicity Summation} -\nwenddocs{}\nwbegincode{968}\moddef{Declaration of utility functions}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -public :: omega_sum, omega_sum_nonzero, omega_nonzero -private :: state_index -\nwendcode{}\nwbegindocs{969}\nwdocspar -\nwenddocs{}\nwbegincode{970}\moddef{Implementation of utility functions}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function omega_sum (omega, p, states, fixed) result (sigma) - real(kind=default) :: sigma - real(kind=default), dimension(0:,:), intent(in) :: p - integer, dimension(:), intent(in), optional :: states, fixed - \LA{}\code{}interface\edoc{} for O'Mega Amplitude\RA{} - integer, dimension(size(p,dim=2)) :: s, nstates - integer :: j - complex(kind=default) :: a - if (present (states)) then - nstates = states - else - nstates = 2 - end if - sigma = 0 - s = -1 - sum_spins: do - if (present (fixed)) then - !!! print *, 's = ', s, ', fixed = ', fixed, ', nstates = ', nstates, & - !!! ', fixed|s = ', merge (fixed, s, mask = nstates == 0) - a = omega (p, merge (fixed, s, mask = nstates == 0)) - else - a = omega (p, s) - end if - sigma = sigma + a * conjg(a) - \LA{}Step \code{}s\edoc{} like a $n$-ary number and terminate when \code{}all\ (s\ ==\ -1)\edoc{}\RA{} - end do sum_spins - sigma = sigma / num_states (2, nstates(1:2)) -end function omega_sum -\nwendcode{}\nwbegindocs{971}We're looping over all spins like a $n$-ary numbers $(-1,\ldots,-1,-1)$, -$(-1,\ldots,-1,0)$, $(-1,\ldots,-1,1)$, $(-1,\ldots,0,-1)$, \ldots, -$(1,\ldots,1,0)$, $(1,\ldots,1,1)$: -\nwenddocs{}\nwbegincode{972}\moddef{Step \code{}s\edoc{} like a $n$-ary number and terminate when \code{}all\ (s\ ==\ -1)\edoc{}}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -do j = size (p, dim = 2), 1, -1 - select case (nstates (j)) - case (3) ! massive vectors - s(j) = modulo (s(j) + 2, 3) - 1 - case (2) ! spinors, massless vectors - s(j) = - s(j) - case (1) ! scalars - s(j) = -1 - case (0) ! fized spin - s(j) = -1 - case default ! ??? - s(j) = -1 - end select - if (s(j) /= -1) then - cycle sum_spins - end if -end do -exit sum_spins -\nwendcode{}\nwbegindocs{973}The dual operation evaluates an $n$-number: -\nwenddocs{}\nwbegincode{974}\moddef{Implementation of utility functions}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function state_index (s, states) result (n) - integer, dimension(:), intent(in) :: s - integer, dimension(:), intent(in), optional :: states - integer :: n - integer :: j, p - n = 1 - p = 1 - if (present (states)) then - do j = size (s), 1, -1 - select case (states(j)) - case (3) - n = n + p * (s(j) + 1) - case (2) - n = n + p * (s(j) + 1) / 2 - end select - p = p * states(j) - end do - else - do j = size (s), 1, -1 - n = n + p * (s(j) + 1) / 2 - p = p * 2 - end do - end if -end function state_index -\nwendcode{}\nwbegindocs{975}\nwdocspar -\nwenddocs{}\nwbegincode{976}\moddef{\code{}interface\edoc{} for O'Mega Amplitude}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -interface - pure function omega (p, s) result (me) - use kinds - implicit none - complex(kind=default) :: me - real(kind=default), dimension(0:,:), intent(in) :: p - integer, dimension(:), intent(in) :: s - end function omega -end interface -\nwendcode{}\nwbegindocs{977}\nwdocspar -\nwenddocs{}\nwbegincode{978}\moddef{Implementation of utility functions}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure subroutine omega_sum_nonzero (sigma, omega, p, zero, n, states, fixed) - real(kind=default), intent(out) :: sigma - real(kind=default), dimension(0:,:), intent(in) :: p - integer, dimension(:), intent(inout) :: zero - integer, intent(in) :: n - integer, dimension(:), intent(in), optional :: states, fixed - \LA{}\code{}interface\edoc{} for O'Mega Amplitude\RA{} - integer, dimension(size(p,dim=2)) :: s, nstates - integer :: j, k - complex(kind=default) :: a - real(kind=default) :: a2 - if (present (states)) then - nstates = states - else - nstates = 2 - end if - sigma = 0 - s = -1 - k = 1 - sum_spins: do - if (zero (k) < REPEAT) then - if (present (fixed)) then - a = omega (p, merge (fixed, s, mask = nstates == 0)) - else - a = omega (p, s) - end if - a2 = a * conjg(a) - if (n <= SAMPLE .and. a2 <= tiny (1.0_default)) then - zero (k) = zero (k) + 1 - end if - sigma = sigma + a2 - end if - k = k + 1 - \LA{}Step \code{}s\edoc{} like a $n$-ary number and terminate when \code{}all\ (s\ ==\ -1)\edoc{}\RA{} - end do sum_spins - sigma = sigma / num_states (2, nstates(1:2)) -end subroutine omega_sum_nonzero -\nwendcode{}\nwbegindocs{979}\nwdocspar -\nwenddocs{}\nwbegincode{980}\moddef{Declaration of utility functions}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -public :: num_states -\nwendcode{}\nwbegindocs{981}\nwdocspar -\nwenddocs{}\nwbegincode{982}\moddef{Implementation of utility functions}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure function num_states (n, states) result (ns) - integer, intent(in) :: n - integer, dimension(:), intent(in), optional :: states - integer :: ns - if (present (states)) then - ns = product (states, mask = states == 2 .or. states == 3) - else - ns = 2**n - end if -end function num_states -\nwendcode{}\nwbegindocs{983}\nwdocspar -\nwenddocs{}\nwbegincode{984}\moddef{Implementation of utility functions}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure subroutine omega_nonzero (a, omega, p, s, zero, n, states) - complex(kind=default), intent(out) :: a - real(kind=default), dimension(0:,:), intent(in) :: p - integer, dimension(:), intent(in) :: s - integer, dimension(:), intent(inout) :: zero - integer, intent(in) :: n - integer, dimension(:), intent(in), optional :: states - \LA{}\code{}interface\edoc{} for O'Mega Amplitude\RA{} - real(kind=default) :: dummy - if (n < SAMPLE) then - call omega_sum_nonzero (dummy, omega, p, zero, n, states) - end if - if (zero (state_index (s, states)) < REPEAT) then - a = omega (p, s) - else - a = 0 - end if -end subroutine omega_nonzero -\nwendcode{}\nwbegindocs{985}\nwdocspar -\section{\texttt{omega95}} -\nwenddocs{}\nwbegincode{986}\moddef{\code{}omega95.f95\edoc{}}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -\LA{}Copyleft\RA{} -module omega95 - use omega_constants - use omega_spinors - use omega_vectors - use omega_polarizations - use omega_tensors - use omega_tensor_polarizations - use omega_couplings - use omega_spinor_couplings - use omega_utils - public -end module omega95 -\nwendcode{}\nwbegindocs{987}\nwdocspar -\section{\texttt{omega95} Revisited} -\nwenddocs{}\nwbegincode{988}\moddef{\code{}omega95{\_}bispinors.f95\edoc{}}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -\LA{}Copyleft\RA{} -module omega95_bispinors - use omega_constants - use omega_bispinors - use omega_vectors - use omega_vectorspinors - use omega_polarizations - use omega_vspinor_polarizations - use omega_couplings - use omega_bispinor_couplings - use omega_utils - public -end module omega95_bispinors -\nwendcode{}\nwbegindocs{989}\nwdocspar -\section{Standard Model Parameters} -\nwenddocs{}\nwbegincode{990}\moddef{\code{}omega{\_}parameters.f95\edoc{}}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -\LA{}Copyleft\RA{} -module omega_parameters - use kinds - use omega_constants - implicit none - private - public :: setup_parameters, print_parameters - real(kind=default), dimension(37), save, public :: mass = 0, width = 0 - real(kind=default), parameter, public :: GeV = 1.0_default - real(kind=default), parameter, public :: MeV = GeV / 1000 - real(kind=default), parameter, public :: keV = MeV / 1000 - real(kind=default), parameter, public :: TeV = GeV * 1000 - real(kind=default), save, public :: & - alpha = 1.0_default / 137.0359895_default, & - sin2thw = 0.23124_default - !!! There is no fundamental reason in defining vev private; - !!! moreover it is needed for the K-matrix stuff. We also - !!! need g, sinthw and costhw for this - real(kind=default), save, public :: vev - real(kind=default), save, public :: g, sinthw, costhw - complex(kind=default), save, public :: & - qlep = 0, qup = 0, qdwn = 0, gcc = 0, qw = 0, & - gzww = 0, gwww = 0, ghww = 0, ghhww = 0, ghzz = 0, ghhzz = 0, & - ghbb = 0, ghtt = 0, ghcc = 0, ghtautau = 0, gh3 = 0, gh4 = 0, & - ghgaga = 0, ghgaz = 0, ghgg = 0, ghmm = 0, & - iqw = 0, igzww = 0, igwww = 0, & - gw4 = 0, gzzww = 0, gazww = 0, gaaww = 0, & - ig1a = 0, ig1z = 0, rg5a = 0, rg5z = 0, & - ig1pkpg4a = 0, ig1pkpg4z = 0, ig1pkmg4a = 0, ig1pkmg4z = 0, & - ig1mkpg4a = 0, ig1mkpg4z = 0, ig1mkmg4a = 0, ig1mkmg4z = 0, & - ila = 0, ilz = 0, il5a = 0, il5z = 0, ik5a = 0, ik5z = 0, & - ialww0 = 0, ialww2 = 0, ialzw0 = 0, ialzw1 = 0, ialzz = 0, & - alww0 = 0, alww2 = 0, alzw0 = 0, alzw1 = 0, alzz = 0, & - igdh4 = 0, gdh2w2 = 0, gdh2z2 = 0, gdhw2 = 0, gdhz2 = 0, & - gs = 0, igs = 0 - complex(kind=default), save, public :: & - sinckm12 = 0, sinckm13 = 0, sinckm23 = 0, & - cosckm12 = 0, cosckm13 = 0, cosckm23 = 0 - complex(kind=default), save, public :: & - vckm_11 = 0, vckm_12 = 0, vckm_13 = 0, vckm_21 = 0, & - vckm_22 = 0, vckm_23 = 0, vckm_31 = 0, vckm_32 = 0, vckm_33 = 0 - complex(kind=default), save, public :: & - gccq11 = 0, gccq12 = 0, gccq13 = 0, gccq21 = 0, & - gccq22 = 0, gccq23 = 0, gccq31 = 0, gccq32 = 0, gccq33 = 0 - real(kind=default), save, public :: & - a4 = 0, a5 = 0, a6 = 0, a7 = 0, a10 = 0 - real(kind=default), save, public :: & - g1a = 1, g1z = 1, kappaa = 1, kappaz = 1, lambdaa = 0, lambdaz = 0, & - g4a = 0, g4z = 0, g5a = 0, g5z = 0, & - kappa5a = 0, kappa5z = 0, lambda5a = 0, lambda5z = 0, & - alpha4 = 0, alpha5 = 0, tau4 = 0, tau5 = 0 - real(kind=default), save, public :: xia = 1, xi0 = 1, xipm = 1 - real(kind=default), save, public :: kc0 = 0, kp0 = 0, kc1 = 0, & - kp1 = 0, kc2 = 0, kp2 = 0 - real(kind=default), save, public :: lam_reg = 0 - complex(kind=default), dimension(2), save, public :: & - gnclep = 0, gncneu = 0, gncup = 0, gncdwn = 0 - complex(kind=default), save, public :: & - fudge_o1 = 1, fudge_o2 = 1, fudge_o3 = 1, fudge_o4 = 1 - real(kind=default), save, public :: & - fudge_higgs = 1, fudge_km = 1, w_res = 0 - real(kind=default), dimension(1:5), save, public :: & - gkm, mkm, wkm -contains - subroutine setup_parameters () - real(kind=default) :: e, qelep, qeup, qedwn - \LA{}Standard model masses and widths\RA{} - \LA{}Standard model couplings\RA{} - end subroutine setup_parameters - subroutine print_parameters () - \LA{}Print standard model masses and widths\RA{} - \LA{}Print Standard model couplings\RA{} - end subroutine print_parameters -end module omega_parameters -\nwendcode{}\nwbegindocs{991}\nwdocspar -\nwenddocs{}\nwbegincode{992}\moddef{Standard model masses and widths}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -mass(1) = 5.0 * MeV -mass(2) = 3.0 * MeV -mass(3) = 100.0 * MeV -mass(4) = 1.2 * GeV -mass(5) = 4.2 * GeV -mass(6) = 174.0 * GeV -width(1:5) = 0 -width(6) = 1.3 * GeV -mass(11) = 0.51099907 * MeV -mass(12) = 0 -mass(13) = 105.658389 * MeV -mass(14) = 0 -mass(15) = 1777.05 * MeV -mass(16) = 0 -width(11:16) = 0 -mass(21) = 0 -mass(22) = 0 -width(21:22) = 0 -mass(23) = 91.187 * GeV -width(23) = 2.490 * GeV -mass(24) = 80.41 * GeV -width(24) = 2.06 * GeV -mass(25) = 120.00 * GeV -width(25) = 5.00 * GeV -mass(35) = 10000 * GeV -width(35) = 0 -sinckm12 = 0.0_default -sinckm13 = 0.0_default -sinckm23 = 0.0_default -cosckm12 = sqrt ((1.0_default - (sinckm12**2))) -cosckm13 = sqrt ((1.0_default - (sinckm13**2))) -cosckm23 = sqrt ((1.0_default - (sinckm23**2))) -\nwendcode{}\nwbegindocs{993}\nwdocspar -\nwenddocs{}\nwbegincode{994}\moddef{Print standard model masses and widths}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -print *, "Quark masses:" -print *, mass(2:6:2) -print *, mass(1:5:2) -print *, "Lepton masses:" -print *, mass(12:16:2) -print *, mass(11:15:2) -print *, "Quark widths:" -print *, width(2:6:2) -print *, width(1:5:2) -print *, "Lepton widths:" -print *, width(12:16:2) -print *, width(11:15:2) -print *, "SU(2)xU(1) Gauge boson masses/widths:" -print *, mass(22:24) -print *, width(22:24) -print *, "Higgs boson and gluon masses/widths:" -print *, mass(25), mass(21) -print *, width(25), width(21) -\nwendcode{}\nwbegindocs{995}\nwdocspar -\nwenddocs{}\nwbegincode{996}\moddef{Standard model masses and widths}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -mass(26) = xi0 * mass(23) -width(26) = 0 -mass(27) = xipm * mass(24) -width(27) = 0 -\nwendcode{}\nwbegindocs{997}\nwdocspar -\nwenddocs{}\nwbegincode{998}\moddef{Standard model couplings}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -e = sqrt (4 * PI * alpha) -qelep = - 1 -qeup = 2.0_default / 3.0_default -qedwn = - 1.0_default / 3.0_default -\nwendcode{}\nwbegindocs{999}\nwdocspar -\nwenddocs{}\nwbegincode{1000}\moddef{Standard model couplings}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -sinthw = sqrt (sin2thw) -costhw = sqrt (1 - sin2thw) -g = e / sinthw -gcc = - g / 2 / sqrt (2.0_default) -vckm_11 = cosckm12 * cosckm13 -vckm_12 = sinckm12 * cosckm13 -vckm_13 = sinckm13 -vckm_21 = - (sinckm12 * cosckm23 + & - cosckm12 * sinckm23 * sinckm13) -vckm_22 = cosckm12 * cosckm23 - & - sinckm12 * sinckm23 * sinckm13 -vckm_23 = sinckm23 * cosckm13 -vckm_31 = sinckm12 * sinckm23 - & - cosckm12 * cosckm23 * sinckm13 -vckm_32 = - (cosckm12 * sinckm23 + & - sinckm12 * cosckm23 * sinckm13) -vckm_33 = cosckm23 * cosckm13 -gccq11 = gcc * vckm_11 -gccq12 = gcc * vckm_12 -gccq13 = gcc * vckm_13 -gccq21 = gcc * vckm_21 -gccq22 = gcc * vckm_22 -gccq23 = gcc * vckm_23 -gccq31 = gcc * vckm_31 -gccq32 = gcc * vckm_32 -gccq33 = gcc * vckm_33 -\nwendcode{}\nwbegindocs{1001}\nwdocspar -\nwenddocs{}\nwbegincode{1002}\moddef{Standard model couplings}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -gncneu(1) = - g / 2 / costhw * ( + 0.5_default) -gnclep(1) = - g / 2 / costhw * ( - 0.5_default - 2 * qelep * sin2thw) -gncup(1) = - g / 2 / costhw * ( + 0.5_default - 2 * qeup * sin2thw) -gncdwn(1) = - g / 2 / costhw * ( - 0.5_default - 2 * qedwn * sin2thw) -gncneu(2) = - g / 2 / costhw * ( + 0.5_default) -gnclep(2) = - g / 2 / costhw * ( - 0.5_default) -gncup(2) = - g / 2 / costhw * ( + 0.5_default) -gncdwn(2) = - g / 2 / costhw * ( - 0.5_default) -\nwendcode{}\nwbegindocs{1003}\nwdocspar -\nwenddocs{}\nwbegincode{1004}\moddef{Print Standard model couplings}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -print *, "Neutral current couplings:" -print *, "U:", gncup -print *, "D:", gncdwn -print *, "N:", gncneu -print *, "L:", gnclep -\nwendcode{}\nwbegindocs{1005}\nwdocspar -\nwenddocs{}\nwbegincode{1006}\moddef{Standard model couplings}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -qlep = - e * qelep -qup = - e * qeup -qdwn = - e * qedwn -\nwendcode{}\nwbegindocs{1007}\nwdocspar -\nwenddocs{}\nwbegincode{1008}\moddef{Print Standard model couplings}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -print *, "Fermion charges:" -print *, "U:", qup -print *, "D:", qdwn -print *, "L:", qlep -\nwendcode{}\nwbegindocs{1009}\nwdocspar -\nwenddocs{}\nwbegincode{1010}\moddef{Standard model couplings}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -qw = e -iqw = (0,1)*qw -gzww = g * costhw -igzww = (0,1)*gzww -\nwendcode{}\nwbegindocs{1011}\nwdocspar -\nwenddocs{}\nwbegincode{1012}\moddef{Print Standard model couplings}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -print *, "TGC:" -print *, "WWA:", iqw -print *, "WWZ:", igzww -\nwendcode{}\nwbegindocs{1013}\nwdocspar -\nwenddocs{}\nwbegincode{1014}\moddef{Standard model couplings}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -gwww = g -igwww = (0,1)*gwww -ghww = mass(24) * g -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!!! This is for the old SM3: -!!! ghhww = (0,1) * g / Sqrt(2.0_default) -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -ghhww = g**2 / 2.0_default -ghzz = mass(23) * g / costhw -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!!! This is for the old SM3: -!!! ghhzz = (0,1) * g / costhw / Sqrt(2.0_default) -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -ghhzz = g**2 / 2.0_default / costhw**2 -\nwendcode{}\nwbegindocs{1015}\nwdocspar -\nwenddocs{}\nwbegincode{1016}\moddef{Print Standard model couplings}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -print *, "WWW:", igwww -print *, "WWH:", ghww -!!! print *, "WWHH:", ghhww**2 !!! Old SM3 -print *, "WWHH:", ghhww -!!! print *, "ZZHH:", ghhzz**2 !!! Old SM3 -print *, "ZZHH:", ghhzz -\nwendcode{}\nwbegindocs{1017}\nwdocspar -\nwenddocs{}\nwbegincode{1018}\moddef{Standard model couplings}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -gw4 = g**2 -gzzww = gzww**2 -gazww = gzww*e -gaaww = e**2 -\nwendcode{}\nwbegindocs{1019}\nwdocspar -\nwenddocs{}\nwbegincode{1020}\moddef{Standard model couplings}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -vev = 2.0 * mass(24) / g -ghtt = - mass(6) / vev -ghbb = - mass(5) / vev -ghcc = - mass(4) / vev -ghtautau = - mass(15) / vev -gh3 = - 3 * mass(25)**2 / vev -gh4 = - 3 * mass(25)**2 / vev**2 -!!! gh4 = mass(25) / vev !!! Old SM3 -\nwendcode{}\nwbegindocs{1021}\nwdocspar -\nwenddocs{}\nwbegincode{1022}\moddef{Standard model couplings}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -ig1a = iqw * g1a -ig1z = igzww * g1z -ig1pkpg4a = iqw * (g1a + kappaa + g4a) / 2 -ig1pkpg4z = igzww * (g1z + kappaz + g4z) / 2 -ig1pkmg4a = iqw * (g1a + kappaa - g4a) / 2 -ig1pkmg4z = igzww * (g1z + kappaz - g4z) / 2 -ig1mkpg4a = iqw * (g1a - kappaa + g4a) / 2 -ig1mkpg4z = igzww * (g1z - kappaz + g4z) / 2 -ig1mkmg4a = iqw * (g1a - kappaa - g4a) / 2 -ig1mkmg4z = igzww * (g1z - kappaz - g4z) / 2 -ila = iqw * lambdaa / (mass(24)*mass(24)) -ilz = igzww * lambdaz / (mass(24)*mass(24)) -\nwendcode{}\nwbegindocs{1023}\nwdocspar -\nwenddocs{}\nwbegincode{1024}\moddef{Standard model couplings}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -rg5a = qw * g5a -rg5z = gzww * g5z -ik5a = iqw * kappa5a -ik5z = igzww * kappa5z -il5a = iqw * lambda5a / (mass(24)*mass(24)) -il5z = igzww * lambda5z / (mass(24)*mass(24)) -\nwendcode{}\nwbegindocs{1025}\nwdocspar -\nwenddocs{}\nwbegincode{1026}\moddef{Standard model couplings}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -alww0 = g**4 * (alpha4 + 2 * alpha5) -alww2 = g**4 * 2 * alpha4 -alzw1 = g**4 / costhw**2 * alpha4 -alzw0 = g**4 / costhw**2 * 2 * alpha5 -alzz = g**4 / costhw**4 * 2 * (alpha4 + alpha5) -\nwendcode{}\nwbegindocs{1027}\nwdocspar -\nwenddocs{}\nwbegincode{1028}\moddef{Standard model couplings}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -ialww0 = g**2 * sqrt ( - cmplx (alpha4 + 2 * alpha5, kind=default)) -ialww2 = g**2 * sqrt ( - cmplx (2 * alpha4, kind=default)) -ialzw1 = g**2 / costhw * sqrt ( - cmplx (alpha4, kind=default)) -ialzw0 = g**2 / costhw * sqrt ( - cmplx (2 * alpha5, kind=default)) -ialzz = g**2 / (costhw*costhw) & - * sqrt ( - cmplx (2 * (alpha4 + alpha5), kind=default)) -\nwendcode{}\nwbegindocs{1029}\nwdocspar -\nwenddocs{}\nwbegincode{1030}\moddef{Standard model couplings}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -gdh2w2 = g * vev * sqrt (cmplx (tau4, kind=default)) -gdhw2 = g * vev * sqrt (cmplx (tau5 / 2, kind=default)) -gdh2z2 = g * vev / costhw * sqrt (cmplx (tau4, kind=default)) -gdhz2 = g * vev / costhw * sqrt (cmplx (tau5 / 2, kind=default)) -igdh4 = g**2 * sqrt ( - cmplx (8 * (tau4 + tau5), kind=default)) -\nwendcode{}\nwbegindocs{1031}\nwdocspar -\nwenddocs{}\nwbegincode{1032}\moddef{\code{}omega{\_}parameters{\_}madgraph.f95\edoc{}}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -\LA{}Copyleft\RA{} -module omega_parameters_madgraph - use kinds - use omega_parameters - implicit none - private - public :: export_parameters_to_madgraph - integer, parameter, private :: D = selected_real_kind (14, 100) - real(kind=D), save, public :: gw = 0, gwwa = 0, gwwz = 0 - real(kind=D), dimension(2), save, public :: gal = 0, gau = 0, gad = 0, gwf = 0 - real(kind=D), dimension(2), save, public :: gzn = 0, gzl = 0, gzu = 0, gzd = 0, g1 = 0 - real(kind=D), save, public :: gwwh = 0, gzzh = 0, ghhh = 0, & - gwwhh = 0, gzzhh = 0, ghhhh = 0 - complex(kind=D), dimension(2,12), save, public :: gh = 0 - real(kind=D), save, public :: wmass = 0, wwidth = 0, zmass = 0, zwidth = 0 - real(kind=D), save, public :: amass = 0, awidth = 0, hmass = 0, hwidth = 0 - real(kind=D), dimension(12), save, public :: fmass = 0, fwidth = 0 - complex(kind=D), save, public :: fudge_m1 = 1, fudge_m2 = 1, fudge_m3 = 1, fudge_m4 = 1 -contains - subroutine export_parameters_to_madgraph () - \LA{}Translate couplings to MADGRAPH\RA{} - \LA{}Translate masses and widths to MADGRAPH\RA{} - end subroutine export_parameters_to_madgraph -end module omega_parameters_madgraph -\nwendcode{}\nwbegindocs{1033}Electromagnetic couplings -\nwenddocs{}\nwbegincode{1034}\moddef{Translate couplings to MADGRAPH}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -gal = qlep -gau = qup -gad = qdwn -\nwendcode{}\nwbegindocs{1035}NC couplings -\begin{equation} - \gamma^\mu \left( - g^M_1\frac{1-\gamma_5}{2} + g^M_2\frac{1+\gamma_5}{2} \right) - = \gamma^\mu \left( g^\Omega_1 - g^\Omega_2 \gamma_5 \right) -\end{equation} -therefore -\begin{equation} - \frac{g^M_1 \pm g^M_2}{2} = g^\Omega_{1,2} -\end{equation} -and -\begin{equation} - g^M_{1,2} = g^\Omega_1 \pm g^\Omega_2 -\end{equation} -\nwenddocs{}\nwbegincode{1036}\moddef{Translate couplings to MADGRAPH}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -gzl(1) = gnclep(1) + gnclep(2) -gzl(2) = gnclep(1) - gnclep(2) -gzn(1) = gncneu(1) + gncneu(2) -gzn(2) = gncneu(1) - gncneu(2) -gzu(1) = gncup(1) + gncup(2) -gzu(2) = gncup(1) - gncup(2) -gzd(1) = gncdwn(1) + gncdwn(2) -gzd(2) = gncdwn(1) - gncdwn(2) -\nwendcode{}\nwbegindocs{1037}CC couplings -\begin{equation} - \gamma^\mu \left( - g^M_1\frac{1-\gamma_5}{2} + g^M_2\frac{1+\gamma_5}{2} \right) - = g^\Omega \gamma^\mu \left( 1 - \gamma_5 \right) -\end{equation} -therefore -\begin{equation} - g^M_1 = 2 g^\Omega,\; g^M_2 = 0 -\end{equation} -\nwenddocs{}\nwbegincode{1038}\moddef{Translate couplings to MADGRAPH}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -gwf(1) = 2 * gcc -gwf(2) = 0 -\nwendcode{}\nwbegindocs{1039}\nwdocspar -\nwenddocs{}\nwbegincode{1040}\moddef{Translate couplings to MADGRAPH}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -gwwa = qw -gwwz = gzww -gwwh = ghww -!!! gwwhh = ghhww**2 !!! Old SM3 -gwwhh = ghhww -gzzh = ghzz -!!! gzzhh = ghhzz**2 !!! Old SM3 -gzzhh = ghhzz -ghhh = gh3 -ghhhh = gh4 -\nwendcode{}\nwbegindocs{1041}MADGRAPH has the Yukawa couplings disabled: -\nwenddocs{}\nwbegincode{1042}\moddef{Translate couplings to MADGRAPH}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -ghtt = 0 -ghbb = 0 -ghcc = 0 -ghtautau = 0 -gh3 = 0 -gh4 = 0 -\nwendcode{}\nwbegindocs{1043}\nwdocspar -\nwenddocs{}\nwbegincode{1044}\moddef{Translate couplings to MADGRAPH}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -gh(:,1:6) = 0 -gh(:,7) = ghcc -gh(:,8) = 0 -gh(:,9) = ghtautau -gh(:,10) = 0 -gh(:,11) = ghtt -gh(:,12) = ghbb -\nwendcode{}\nwbegindocs{1045}Leptons -\nwenddocs{}\nwbegincode{1046}\moddef{Translate masses and widths to MADGRAPH}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -fmass(1:2) = mass(11:12) -fwidth(1:2) = width(11:12) -fmass(5:6) = mass(13:14) -fwidth(5:6) = width(13:14) -fmass(9:10) = mass(15:16) -fwidth(9:10) = width(15:16) -\nwendcode{}\nwbegindocs{1047}Quarks -\nwenddocs{}\nwbegincode{1048}\moddef{Translate masses and widths to MADGRAPH}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -fmass(4) = mass(1) -fwidth(4) = width(1) -fmass(3) = mass(2) -fwidth(3) = width(2) -fmass(8) = mass(3) -fwidth(8) = width(3) -fmass(7) = mass(4) -fwidth(7) = width(4) -fmass(12) = mass(5) -fwidth(12) = width(5) -fmass(11) = mass(6) -fwidth(11) = width(6) -\nwendcode{}\nwbegindocs{1049}Gauge bosons -\nwenddocs{}\nwbegincode{1050}\moddef{Translate masses and widths to MADGRAPH}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -amass = mass(22) -awidth = width(22) -zmass = mass(23) -zwidth = width(23) -wmass = mass(24) -wwidth = width(24) -\nwendcode{}\nwbegindocs{1051}EWSB sector masses -\nwenddocs{}\nwbegincode{1052}\moddef{Translate masses and widths to MADGRAPH}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -hmass = mass(25) -hwidth = width(25) -\nwendcode{}\nwbegindocs{1053}\nwdocspar -\nwenddocs{}\nwbegincode{1054}\moddef{\code{}omega{\_}parameters{\_}whizard.f95\edoc{}}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -\LA{}Copyleft\RA{} -module omega_parameters_whizard - use kinds - use omega_parameters - use parameters - implicit none - private - public :: import_from_whizard -contains - subroutine import_from_whizard (par) - type(parameter_set), intent(in) :: par - real(kind=default) :: e, g, sinthw, costhw, qelep, qeup, qedwn, v - \LA{}Translate masses and widths from \code{}WHIZARD\edoc{}\RA{} - \LA{}Translate couplings from \code{}WHIZARD\edoc{}\RA{} - end subroutine import_from_whizard -end module omega_parameters_whizard -\nwendcode{}\nwbegindocs{1055}\nwdocspar -\nwenddocs{}\nwbegincode{1056}\moddef{Translate masses and widths from \code{}WHIZARD\edoc{}}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -mass(1:27) = 0 -width(1:27) = 0 -\nwendcode{}\nwbegindocs{1057}\nwdocspar -\nwenddocs{}\nwbegincode{1058}\moddef{Translate masses and widths from \code{}WHIZARD\edoc{}}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -mass(3) = par%Ms -mass(4) = par%Mc -mass(5) = par%Mb -mass(6) = par%Mtop -width(6) = par%wtop -\nwendcode{}\nwbegindocs{1059}\nwdocspar -\nwenddocs{}\nwbegincode{1060}\moddef{Translate masses and widths from \code{}WHIZARD\edoc{}}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -mass(11) = par%Me -mass(13) = par%Mm -mass(15) = par%Mt -\nwendcode{}\nwbegindocs{1061}\nwdocspar -\nwenddocs{}\nwbegincode{1062}\moddef{Translate masses and widths from \code{}WHIZARD\edoc{}}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -mass(23) = par%mZ -width(23) = par%wZ -mass(24) = par%mW -width(24) = par%wW -\nwendcode{}\nwbegindocs{1063}\nwdocspar -\nwenddocs{}\nwbegincode{1064}\moddef{Translate masses and widths from \code{}WHIZARD\edoc{}}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -mass(25) = par%mH -width(25) = par%wH -\nwendcode{}\nwbegindocs{1065}\nwdocspar -\nwenddocs{}\nwbegincode{1066}\moddef{Translate masses and widths from \code{}WHIZARD\edoc{}}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -mass(26) = xi0 * mass(23) -width(26) = 0 -mass(27) = xipm * mass(24) -width(27) = 0 -\nwendcode{}\nwbegindocs{1067}\nwdocspar -\nwenddocs{}\nwbegincode{1068}\moddef{Translate couplings from \code{}WHIZARD\edoc{}}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -e = par%EE -sinthw = par%SW -sin2thw = sinthw**2 -costhw = par%CW -\nwendcode{}\nwbegindocs{1069}\nwdocspar -\nwenddocs{}\nwbegincode{1070}\moddef{Translate couplings from \code{}WHIZARD\edoc{}}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -qelep = - 1 -qeup = 2.0_default / 3.0_default -qedwn = - 1.0_default / 3.0_default -\nwendcode{}\nwbegindocs{1071}\nwdocspar -\nwenddocs{}\nwbegincode{1072}\moddef{Translate couplings from \code{}WHIZARD\edoc{}}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -g = e / sinthw -gcc = - g / 2 / sqrt (2.0_default) -gncneu(1) = - g / 2 / costhw * ( + 0.5_default) -gnclep(1) = - g / 2 / costhw * ( - 0.5_default - 2 * qelep * sin2thw) -gncup(1) = - g / 2 / costhw * ( + 0.5_default - 2 * qeup * sin2thw) -gncdwn(1) = - g / 2 / costhw * ( - 0.5_default - 2 * qedwn * sin2thw) -gncneu(2) = - g / 2 / costhw * ( + 0.5_default) -gnclep(2) = - g / 2 / costhw * ( - 0.5_default) -gncup(2) = - g / 2 / costhw * ( + 0.5_default) -gncdwn(2) = - g / 2 / costhw * ( - 0.5_default) -qlep = - e * qelep -qup = - e * qeup -qdwn = - e * qedwn -\nwendcode{}\nwbegindocs{1073}\nwdocspar -\nwenddocs{}\nwbegincode{1074}\moddef{Translate couplings from \code{}WHIZARD\edoc{}}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -qw = e -iqw = (0,1)*qw -gzww = g * costhw -igzww = (0,1)*gzww -gwww = g -igwww = (0,1)*gwww -ghww = mass(24) * g -ghhww = (0,1) * g / Sqrt(2.0_default) -ghzz = mass(23) * g / costhw -ghhzz = (0,1) * g / costhw / Sqrt(2.0_default) -vev = 2.0 * mass(24) / g -ghtt = - mass(6) / vev -ghbb = - mass(5) / vev -ghcc = - mass(4) / vev -ghtautau = - mass(15) / vev -gh3 = - 3 * par%MH**2 / vev -gh4 = par%MH / vev -\nwendcode{}\nwbegindocs{1075}\nwdocspar -\nwenddocs{}\nwbegincode{1076}\moddef{Translate couplings from \code{}WHIZARD\edoc{}}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -ig1a = iqw * g1a -ig1z = igzww * g1z -ig1pkpg4a = iqw * (g1a + kappaa + g4a) / 2 -ig1pkpg4z = igzww * (g1z + kappaz + g4z) / 2 -ig1pkmg4a = iqw * (g1a + kappaa - g4a) / 2 -ig1pkmg4z = igzww * (g1z + kappaz - g4z) / 2 -ig1mkpg4a = iqw * (g1a - kappaa + g4a) / 2 -ig1mkpg4z = igzww * (g1z - kappaz + g4z) / 2 -ig1mkmg4a = iqw * (g1a - kappaa - g4a) / 2 -ig1mkmg4z = igzww * (g1z - kappaz - g4z) / 2 -ila = iqw * lambdaa / (mass(24)*mass(24)) -ilz = igzww * lambdaz / (mass(24)*mass(24)) -rg5a = qw * g5a -rg5z = gzww * g5z -ik5a = iqw * kappa5a -ik5z = igzww * kappa5z -il5a = iqw * lambda5a / (mass(24)*mass(24)) -il5z = igzww * lambda5z / (mass(24)*mass(24)) -ialww0 = g**2 * sqrt ( - cmplx (alpha4 + 2 * alpha5, kind=default)) -ialww2 = g**2 * sqrt ( - cmplx (2 * alpha4, kind=default)) -ialzw1 = g**2 / costhw * sqrt ( - cmplx (alpha4, kind=default)) -ialzw0 = g**2 / costhw * sqrt ( - cmplx (2 * alpha5, kind=default)) -ialzz = g**2 / (costhw*costhw) & - * sqrt ( - cmplx (2 * (alpha4 + alpha5), kind=default)) -\nwendcode{}\nwbegindocs{1077}\nwdocspar -\nwenddocs{}\nwbegincode{1078}\moddef{\code{}omega{\_}parameters{\_}whizard2.f95\edoc{}}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -\LA{}Copyleft\RA{} -module omega_parameters_whizard - use kinds - use omega_parameters - use parameters - implicit none - private - public :: import_from_whizard -contains - subroutine import_from_whizard (par) - type(parameter_set), intent(in) :: par - real(kind=default) :: e, g, sinthw, costhw, qelep, qeup, qedwn, v - \LA{}Translate masses and widths from \code{}WHIZARD\edoc{}\RA{} - \LA{}Translate couplings from \code{}WHIZARD\edoc{}\RA{} - end subroutine import_from_whizard -end module omega_parameters_whizard -\nwendcode{}\nwbegindocs{1079}\nwdocspar -\section{Testing} -\nwenddocs{}\nwbegincode{1080}\moddef{\code{}omega{\_}testtools.f95\edoc{}}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -\LA{}Copyleft\RA{} -module omega_testtools - use kinds - implicit none - private - public :: print_matrix - public :: expect - real(kind=default), parameter, private :: TOLERANCE = 1.0e8 - \LA{}Declare \code{}expect\edoc{}\RA{} -contains - subroutine print_matrix (a) - complex(kind=default), dimension(:,:), intent(in) :: a - integer :: row - do row = 1, size (a, dim=1) - write (unit = *, fmt = "(10(tr2, f5.2, '+', f5.2, 'I'))") a(row,:) - end do - end subroutine print_matrix - \LA{}Implement \code{}expect\edoc{}\RA{} -end module omega_testtools -\nwendcode{}\nwbegindocs{1081}\nwdocspar -\nwenddocs{}\nwbegincode{1082}\moddef{Declare \code{}expect\edoc{}}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -interface expect - module procedure expect_integer, expect_real, expect_complex, & - expect_double_integer, expect_complex_integer, expect_complex_real -end interface -private :: expect_integer, expect_real, expect_complex, & - expect_double_integer, expect_complex_integer, expect_complex_real -\nwendcode{}\nwbegindocs{1083}\nwdocspar -\nwenddocs{}\nwbegincode{1084}\moddef{Implement \code{}expect\edoc{}}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -subroutine expect_integer (x, x0, msg) - integer, intent(in) :: x, x0 - character(len=*), intent(in) :: msg - if (x == x0) then - print *, msg, " passed" - else - print *, msg, " FAILED: expected ", x0, " got ", x - end if -end subroutine expect_integer -\nwendcode{}\nwbegindocs{1085}\nwdocspar -\nwenddocs{}\nwbegincode{1086}\moddef{Implement \code{}expect\edoc{}}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -subroutine expect_real (x, x0, msg) - real(kind=default), intent(in) :: x, x0 - character(len=*), intent(in) :: msg - if (x == x0) then - print *, msg, " passed exactly" - else if (abs (x - x0) <= epsilon (x)) then - print *, msg, " passed at machine precision" - else if (abs (x - x0) <= TOLERANCE * epsilon (x)) then - print *, msg, " passed at", & - ceiling (abs (x - x0) / epsilon (x)), "* machine precision" - else - print *, msg, " FAILED: expected ", x0, " got ", x, " (", & - (x - x0) / epsilon (x), " epsilon)" - end if -end subroutine expect_real -\nwendcode{}\nwbegindocs{1087}\nwdocspar -\nwenddocs{}\nwbegincode{1088}\moddef{Implement \code{}expect\edoc{}}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -subroutine expect_complex (x, x0, msg) - complex(kind=default), intent(in) :: x, x0 - character(len=*), intent(in) :: msg - if (x == x0) then - print *, msg, " passed exactly" - else if (abs (x - x0) <= epsilon (real(x))) then - print *, msg, " passed at machine precision" - else if (abs (x - x0) <= TOLERANCE * epsilon (real(x))) then - print *, msg, " passed at", & - ceiling (abs (x - x0) / epsilon (real(x))), "* machine precision" - else - print *, msg, " FAILED: expected ", x0, " got ", x, " (", & - (x - x0) / epsilon (real(x)), " epsilon)" - end if -end subroutine expect_complex -\nwendcode{}\nwbegindocs{1089}\nwdocspar -\nwenddocs{}\nwbegincode{1090}\moddef{Implement \code{}expect\edoc{}}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -subroutine expect_double_integer (x, x0, msg) - real(kind=default), intent(in) :: x - integer, intent(in) :: x0 - character(len=*), intent(in) :: msg - call expect_real (x, real (x0, kind=default), msg) -end subroutine expect_double_integer -\nwendcode{}\nwbegindocs{1091}\nwdocspar -\nwenddocs{}\nwbegincode{1092}\moddef{Implement \code{}expect\edoc{}}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -subroutine expect_complex_integer (x, x0, msg) - complex(kind=default), intent(in) :: x - integer, intent(in) :: x0 - character(len=*), intent(in) :: msg - call expect_complex (x, cmplx (x0, kind=default), msg) -end subroutine expect_complex_integer -\nwendcode{}\nwbegindocs{1093}\nwdocspar -\nwenddocs{}\nwbegincode{1094}\moddef{Implement \code{}expect\edoc{}}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -subroutine expect_complex_real (x, x0, msg) - complex(kind=default), intent(in) :: x - real(kind=default), intent(in) :: x0 - character(len=*), intent(in) :: msg - call expect_complex (x, cmplx (x0, kind=default), msg) -end subroutine expect_complex_real -\nwendcode{}\nwbegindocs{1095}\nwdocspar -\nwenddocs{}\nwbegincode{1096}\moddef{\code{}test{\_}omega95.f95\edoc{}}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -\LA{}Copyleft\RA{} -program test_omega95 - use kinds - use omega95 - use omega_testtools - implicit none - real(kind=default) :: m, pabs, qabs, w - real(kind=default), dimension(0:3) :: r - complex(kind=default) :: one - type(momentum) :: p, q - type(vector) :: vp, vq, vtest - type(tensor) :: ttest - integer, dimension(8) :: date_time - integer :: rsize - call date_and_time (values = date_time) - call random_seed (size = rsize) - call random_seed (put = spread (product (date_time), dim = 1, ncopies = rsize)) - w = 1.4142 - one = 1 - m = 13 - pabs = 42 - qabs = 137 - call random_number (r) - vtest%t = cmplx (10.0_default * r(0)) - vtest%x(1:3) = cmplx (10.0_default * r(1:3)) - ttest = vtest.tprod.vtest - call random_momentum (p, pabs, m) - call random_momentum (q, qabs, m) - vp = p - vq = q - \LA{}Test \code{}omega95\edoc{}\RA{} -end program test_omega95 -\nwendcode{}\nwbegindocs{1097}\nwdocspar -\nwenddocs{}\nwbegincode{1098}\moddef{Test \code{}omega95\edoc{}}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -print *, "*** Checking the equations of motion ***:" -call expect (abs(f_vf(one,vp,u(m,p,+1))-m*u(m,p,+1)), 0, "|[p-m]u(+)|=0") -call expect (abs(f_vf(one,vp,u(m,p,-1))-m*u(m,p,-1)), 0, "|[p-m]u(-)|=0") -call expect (abs(f_vf(one,vp,v(m,p,+1))+m*v(m,p,+1)), 0, "|[p+m]v(+)|=0") -call expect (abs(f_vf(one,vp,v(m,p,-1))+m*v(m,p,-1)), 0, "|[p+m]v(-)|=0") -call expect (abs(f_fv(one,ubar(m,p,+1),vp)-m*ubar(m,p,+1)), 0, "|ubar(+)[p-m]|=0") -call expect (abs(f_fv(one,ubar(m,p,-1),vp)-m*ubar(m,p,-1)), 0, "|ubar(-)[p-m]|=0") -call expect (abs(f_fv(one,vbar(m,p,+1),vp)+m*vbar(m,p,+1)), 0, "|vbar(+)[p+m]|=0") -call expect (abs(f_fv(one,vbar(m,p,-1),vp)+m*vbar(m,p,-1)), 0, "|vbar(-)[p+m]|=0") -\nwendcode{}\nwbegindocs{1099}\nwdocspar -\nwenddocs{}\nwbegincode{1100}\moddef{Test \code{}omega95\edoc{}}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -print *, "*** Checking the normalization ***:" -call expect (ubar(m,p,+1)*u(m,p,+1), +2*m, "ubar(+)*u(+)=+2m") -call expect (ubar(m,p,-1)*u(m,p,-1), +2*m, "ubar(-)*u(-)=+2m") -call expect (vbar(m,p,+1)*v(m,p,+1), -2*m, "vbar(+)*v(+)=-2m") -call expect (vbar(m,p,-1)*v(m,p,-1), -2*m, "vbar(-)*v(-)=-2m") -call expect (ubar(m,p,+1)*v(m,p,+1), 0, "ubar(+)*v(+)=0 ") -call expect (ubar(m,p,-1)*v(m,p,-1), 0, "ubar(-)*v(-)=0 ") -call expect (vbar(m,p,+1)*u(m,p,+1), 0, "vbar(+)*u(+)=0 ") -call expect (vbar(m,p,-1)*u(m,p,-1), 0, "vbar(-)*u(-)=0 ") -\nwendcode{}\nwbegindocs{1101}\nwdocspar -\nwenddocs{}\nwbegincode{1102}\moddef{Test \code{}omega95\edoc{}}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -print *, "*** Checking the currents ***:" -call expect (abs(v_ff(one,ubar(m,p,+1),u(m,p,+1))-2*vp), 0, "ubar(+).V.u(+)=2p") -call expect (abs(v_ff(one,ubar(m,p,-1),u(m,p,-1))-2*vp), 0, "ubar(-).V.u(-)=2p") -call expect (abs(v_ff(one,vbar(m,p,+1),v(m,p,+1))-2*vp), 0, "vbar(+).V.v(+)=2p") -call expect (abs(v_ff(one,vbar(m,p,-1),v(m,p,-1))-2*vp), 0, "vbar(-).V.v(-)=2p") -\nwendcode{}\nwbegindocs{1103}\nwdocspar -\nwenddocs{}\nwbegincode{1104}\moddef{Test \code{}omega95\edoc{}}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -print *, "*** Checking current conservation ***:" -call expect ((vp-vq)*v_ff(one,ubar(m,p,+1),u(m,q,+1)), 0, "d(ubar(+).V.u(+))=0") -call expect ((vp-vq)*v_ff(one,ubar(m,p,-1),u(m,q,-1)), 0, "d(ubar(-).V.u(-))=0") -call expect ((vp-vq)*v_ff(one,vbar(m,p,+1),v(m,q,+1)), 0, "d(vbar(+).V.v(+))=0") -call expect ((vp-vq)*v_ff(one,vbar(m,p,-1),v(m,q,-1)), 0, "d(vbar(-).V.v(-))=0") -\nwendcode{}\nwbegindocs{1105}\nwdocspar -\nwenddocs{}\nwbegincode{1106}\moddef{Test \code{}omega95\edoc{}}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -if (m == 0) then - print *, "*** Checking axial current conservation ***:" - call expect ((vp-vq)*a_ff(one,ubar(m,p,+1),u(m,q,+1)), 0, "d(ubar(+).A.u(+))=0") - call expect ((vp-vq)*a_ff(one,ubar(m,p,-1),u(m,q,-1)), 0, "d(ubar(-).A.u(-))=0") - call expect ((vp-vq)*a_ff(one,vbar(m,p,+1),v(m,q,+1)), 0, "d(vbar(+).A.v(+))=0") - call expect ((vp-vq)*a_ff(one,vbar(m,p,-1),v(m,q,-1)), 0, "d(vbar(-).A.v(-))=0") -end if -\nwendcode{}\nwbegindocs{1107}\nwdocspar -\nwenddocs{}\nwbegincode{1108}\moddef{Test \code{}omega95\edoc{}}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -print *, "*** Checking polarisation vectors: ***" -call expect (conjg(eps(m,p, 1))*eps(m,p, 1), -1, "e( 1).e( 1)=-1") -call expect (conjg(eps(m,p, 1))*eps(m,p,-1), 0, "e( 1).e(-1)= 0") -call expect (conjg(eps(m,p,-1))*eps(m,p, 1), 0, "e(-1).e( 1)= 0") -call expect (conjg(eps(m,p,-1))*eps(m,p,-1), -1, "e(-1).e(-1)=-1") -call expect ( p*eps(m,p, 1), 0, " p.e( 1)= 0") -call expect ( p*eps(m,p,-1), 0, " p.e(-1)= 0") -if (m > 0) then - call expect (conjg(eps(m,p, 1))*eps(m,p, 0), 0, "e( 1).e( 0)= 0") - call expect (conjg(eps(m,p, 0))*eps(m,p, 1), 0, "e( 0).e( 1)= 0") - call expect (conjg(eps(m,p, 0))*eps(m,p, 0), -1, "e( 0).e( 0)=-1") - call expect (conjg(eps(m,p, 0))*eps(m,p,-1), 0, "e( 0).e(-1)= 0") - call expect (conjg(eps(m,p,-1))*eps(m,p, 0), 0, "e(-1).e( 0)= 0") - call expect ( p*eps(m,p, 0), 0, " p.e( 0)= 0") -end if -\nwendcode{}\nwbegindocs{1109}\nwdocspar -\nwenddocs{}\nwbegincode{1110}\moddef{Test \code{}omega95\edoc{}}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -print *, "*** Checking epsilon tensor: ***" -call expect ( pseudo_scalar(eps(m,p,1),eps(m,q,1),eps(m,p,0),eps(m,q,0)), & - - pseudo_scalar(eps(m,q,1),eps(m,p,1),eps(m,p,0),eps(m,q,0)), "eps(1<->2)") -call expect ( pseudo_scalar(eps(m,p,1),eps(m,q,1),eps(m,p,0),eps(m,q,0)), & - - pseudo_scalar(eps(m,p,0),eps(m,q,1),eps(m,p,1),eps(m,q,0)), "eps(1<->3)") -call expect ( pseudo_scalar(eps(m,p,1),eps(m,q,1),eps(m,p,0),eps(m,q,0)), & - - pseudo_scalar(eps(m,q,0),eps(m,q,1),eps(m,p,0),eps(m,p,1)), "eps(1<->4)") -call expect ( pseudo_scalar(eps(m,p,1),eps(m,q,1),eps(m,p,0),eps(m,q,0)), & - - pseudo_scalar(eps(m,p,1),eps(m,p,0),eps(m,q,1),eps(m,q,0)), "eps(2<->3)") -call expect ( pseudo_scalar(eps(m,p,1),eps(m,q,1),eps(m,p,0),eps(m,q,0)), & - - pseudo_scalar(eps(m,p,1),eps(m,q,0),eps(m,p,0),eps(m,q,1)), "eps(2<->4)") -call expect ( pseudo_scalar(eps(m,p,1),eps(m,q,1),eps(m,p,0),eps(m,q,0)), & - - pseudo_scalar(eps(m,p,1),eps(m,q,1),eps(m,q,0),eps(m,p,0)), "eps(3<->4)") -call expect ( pseudo_scalar(eps(m,p,1),eps(m,q,1),eps(m,p,0),eps(m,q,0)), & - eps(m,p,1)*pseudo_vector(eps(m,q,1),eps(m,p,0),eps(m,q,0)), "eps'") -\nwendcode{}\nwbegindocs{1111}\nwdocspar -\begin{equation} - \frac{1}{2} [x\wedge y]^*_{\mu\nu} [x\wedge y]^{\mu\nu} - = \frac{1}{2} (x^*_\mu y^*_\nu-x^*_\nu y^*_\mu) (x^\mu y^\nu-x^\nu y^\mu) - = (x^*x) (y^*y) - (x^*y) (y^*x) -\end{equation} -\nwenddocs{}\nwbegincode{1112}\moddef{Test \code{}omega95\edoc{}}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -print *, "*** Checking tensors: ***" -call expect (conjg(p.wedge.q)*(p.wedge.q), (p*p)*(q*q)-(p*q)**2, & - "[p,q].[q,p]=p.p*q.q-p.q^2") -call expect (conjg(p.wedge.q)*(q.wedge.p), (p*q)**2-(p*p)*(q*q), & - "[p,q].[q,p]=p.q^2-p.p*q.q") -\nwendcode{}\nwbegindocs{1113}i.\,e. -\begin{equation} - \frac{1}{2} [p\wedge\epsilon(p,i)]^*_{\mu\nu} [p\wedge\epsilon(p,j)]^{\mu\nu} - = - p^2 \delta_{ij} -\end{equation} -\nwenddocs{}\nwbegincode{1114}\moddef{Test \code{}omega95\edoc{}}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -call expect (conjg(p.wedge.eps(m,p, 1))*(p.wedge.eps(m,p, 1)), -p*p, & - "[p,e( 1)].[p,e( 1)]=-p.p") -call expect (conjg(p.wedge.eps(m,p, 1))*(p.wedge.eps(m,p,-1)), 0, & - "[p,e( 1)].[p,e(-1)]=0") -call expect (conjg(p.wedge.eps(m,p,-1))*(p.wedge.eps(m,p, 1)), 0, & - "[p,e(-1)].[p,e( 1)]=0") -call expect (conjg(p.wedge.eps(m,p,-1))*(p.wedge.eps(m,p,-1)), -p*p, & - "[p,e(-1)].[p,e(-1)]=-p.p") -if (m > 0) then - call expect (conjg(p.wedge.eps(m,p, 1))*(p.wedge.eps(m,p, 0)), 0, & - "[p,e( 1)].[p,e( 0)]=0") - call expect (conjg(p.wedge.eps(m,p, 0))*(p.wedge.eps(m,p, 1)), 0, & - "[p,e( 0)].[p,e( 1)]=0") - call expect (conjg(p.wedge.eps(m,p, 0))*(p.wedge.eps(m,p, 0)), -p*p, & - "[p,e( 0)].[p,e( 0)]=-p.p") - call expect (conjg(p.wedge.eps(m,p, 0))*(p.wedge.eps(m,p,-1)), 0, & - "[p,e( 1)].[p,e(-1)]=0") - call expect (conjg(p.wedge.eps(m,p,-1))*(p.wedge.eps(m,p, 0)), 0, & - "[p,e(-1)].[p,e( 0)]=0") -end if -\nwendcode{}\nwbegindocs{1115}also -\begin{align} - [x\wedge y]_{\mu\nu} z^\nu &= x_\mu (yz) - y_\mu (xz) \\ - z_\mu [x\wedge y]^{\mu\nu} &= (zx) y^\nu - (zy) x^\nu -\end{align} -\nwenddocs{}\nwbegincode{1116}\moddef{Test \code{}omega95\edoc{}}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -call expect (abs ((p.wedge.eps(m,p, 1))*p + (p*p)*eps(m,p, 1)), 0, & - "[p,e( 1)].p=-p.p*e( 1)]") -call expect (abs ((p.wedge.eps(m,p, 0))*p + (p*p)*eps(m,p, 0)), 0, & - "[p,e( 0)].p=-p.p*e( 0)]") -call expect (abs ((p.wedge.eps(m,p,-1))*p + (p*p)*eps(m,p,-1)), 0, & - "[p,e(-1)].p=-p.p*e(-1)]") -call expect (abs (p*(p.wedge.eps(m,p, 1)) - (p*p)*eps(m,p, 1)), 0, & - "p.[p,e( 1)]=p.p*e( 1)]") -call expect (abs (p*(p.wedge.eps(m,p, 0)) - (p*p)*eps(m,p, 0)), 0, & - "p.[p,e( 0)]=p.p*e( 0)]") -call expect (abs (p*(p.wedge.eps(m,p,-1)) - (p*p)*eps(m,p,-1)), 0, & - "p.[p,e(-1)]=p.p*e(-1)]") -\nwendcode{}\nwbegindocs{1117}\nwdocspar -\nwenddocs{}\nwbegincode{1118}\moddef{Test \code{}omega95\edoc{}}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -print *, "*** Checking polarisation tensors: ***" -call expect (conjg(eps2(m,p, 2))*eps2(m,p, 2), 1, "e2( 2).e2( 2)=1") -call expect (conjg(eps2(m,p, 2))*eps2(m,p,-2), 0, "e2( 2).e2(-2)=0") -call expect (conjg(eps2(m,p,-2))*eps2(m,p, 2), 0, "e2(-2).e2( 2)=0") -call expect (conjg(eps2(m,p,-2))*eps2(m,p,-2), 1, "e2(-2).e2(-2)=1") -if (m > 0) then - call expect (conjg(eps2(m,p, 2))*eps2(m,p, 1), 0, "e2( 2).e2( 1)=0") - call expect (conjg(eps2(m,p, 2))*eps2(m,p, 0), 0, "e2( 2).e2( 0)=0") - call expect (conjg(eps2(m,p, 2))*eps2(m,p,-1), 0, "e2( 2).e2(-1)=0") - call expect (conjg(eps2(m,p, 1))*eps2(m,p, 2), 0, "e2( 1).e2( 2)=0") - call expect (conjg(eps2(m,p, 1))*eps2(m,p, 1), 1, "e2( 1).e2( 1)=1") - call expect (conjg(eps2(m,p, 1))*eps2(m,p, 0), 0, "e2( 1).e2( 0)=0") - call expect (conjg(eps2(m,p, 1))*eps2(m,p,-1), 0, "e2( 1).e2(-1)=0") - call expect (conjg(eps2(m,p, 1))*eps2(m,p,-2), 0, "e2( 1).e2(-2)=0") - call expect (conjg(eps2(m,p, 0))*eps2(m,p, 2), 0, "e2( 0).e2( 2)=0") - call expect (conjg(eps2(m,p, 0))*eps2(m,p, 1), 0, "e2( 0).e2( 1)=0") - call expect (conjg(eps2(m,p, 0))*eps2(m,p, 0), 1, "e2( 0).e2( 0)=1") - call expect (conjg(eps2(m,p, 0))*eps2(m,p,-1), 0, "e2( 0).e2(-1)=0") - call expect (conjg(eps2(m,p, 0))*eps2(m,p,-2), 0, "e2( 0).e2(-2)=0") - call expect (conjg(eps2(m,p,-1))*eps2(m,p, 2), 0, "e2(-1).e2( 2)=0") - call expect (conjg(eps2(m,p,-1))*eps2(m,p, 1), 0, "e2(-1).e2( 1)=0") - call expect (conjg(eps2(m,p,-1))*eps2(m,p, 0), 0, "e2(-1).e2( 0)=0") - call expect (conjg(eps2(m,p,-1))*eps2(m,p,-1), 1, "e2(-1).e2(-1)=1") - call expect (conjg(eps2(m,p,-1))*eps2(m,p,-2), 0, "e2(-1).e2(-2)=0") - call expect (conjg(eps2(m,p,-2))*eps2(m,p, 1), 0, "e2(-2).e2( 1)=0") - call expect (conjg(eps2(m,p,-2))*eps2(m,p, 0), 0, "e2(-2).e2( 0)=0") - call expect (conjg(eps2(m,p,-2))*eps2(m,p,-1), 0, "e2(-2).e2(-1)=0") -end if -\nwendcode{}\nwbegindocs{1119}\nwdocspar -\nwenddocs{}\nwbegincode{1120}\moddef{Test \code{}omega95\edoc{}}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -call expect ( abs(p*eps2(m,p, 2) ), 0, " |p.e2( 2)| =0") -call expect ( abs(eps2(m,p, 2)*p), 0, " |e2( 2).p|=0") -call expect ( abs(p*eps2(m,p,-2) ), 0, " |p.e2(-2)| =0") -call expect ( abs(eps2(m,p,-2)*p), 0, " |e2(-2).p|=0") -if (m > 0) then - call expect ( abs(p*eps2(m,p, 1) ), 0, " |p.e2( 1)| =0") - call expect ( abs(eps2(m,p, 1)*p), 0, " |e2( 1).p|=0") - call expect ( abs(p*eps2(m,p, 0) ), 0, " |p.e2( 0)| =0") - call expect ( abs(eps2(m,p, 0)*p), 0, " |e2( 0).p|=0") - call expect ( abs(p*eps2(m,p,-1) ), 0, " |p.e2(-1)| =0") - call expect ( abs(eps2(m,p,-1)*p), 0, " |e2(-1).p|=0") -end if -\nwendcode{}\nwbegindocs{1121}\nwdocspar -\nwenddocs{}\nwbegincode{1122}\moddef{XXX Test \code{}omega95\edoc{}}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -print *, " *** Checking the polarization tensors for massive gravitons:" -call expect (abs(p * eps2(m,p,2)), 0, "p.e(+2)=0") -call expect (abs(p * eps2(m,p,1)), 0, "p.e(+1)=0") -call expect (abs(p * eps2(m,p,0)), 0, "p.e( 0)=0") -call expect (abs(p * eps2(m,p,-1)), 0, "p.e(-1)=0") -call expect (abs(p * eps2(m,p,-2)), 0, "p.e(-2)=0") -call expect (abs(trace(eps2 (m,p,2))), 0, "Tr[e(+2)]=0") -call expect (abs(trace(eps2 (m,p,1))), 0, "Tr[e(+1)]=0") -call expect (abs(trace(eps2 (m,p,0))), 0, "Tr[e( 0)]=0") -call expect (abs(trace(eps2 (m,p,-1))), 0, "Tr[e(-1)]=0") -call expect (abs(trace(eps2 (m,p,-2))), 0, "Tr[e(-2)]=0") -call expect (abs(eps2(m,p,2) * eps2(m,p,2)), 1, & - "e(2).e(2) = 1") -call expect (abs(eps2(m,p,2) * eps2(m,p,1)), 0, & - "e(2).e(1) = 0") -call expect (abs(eps2(m,p,2) * eps2(m,p,0)), 0, & - "e(2).e(0) = 0") -call expect (abs(eps2(m,p,2) * eps2(m,p,-1)), 0, & - "e(2).e(-1) = 0") -call expect (abs(eps2(m,p,2) * eps2(m,p,-2)), 0, & - "e(2).e(-2) = 0") -call expect (abs(eps2(m,p,1) * eps2(m,p,1)), 1, & - "e(1).e(1) = 1") -call expect (abs(eps2(m,p,1) * eps2(m,p,0)), 0, & - "e(1).e(0) = 0") -call expect (abs(eps2(m,p,1) * eps2(m,p,-1)), 0, & - "e(1).e(-1) = 0") -call expect (abs(eps2(m,p,1) * eps2(m,p,-2)), 0, & - "e(1).e(-2) = 0") -call expect (abs(eps2(m,p,0) * eps2(m,p,0)), 1, & - "e(0).e(0) = 1") -call expect (abs(eps2(m,p,0) * eps2(m,p,-1)), 0, & - "e(0).e(-1) = 0") -call expect (abs(eps2(m,p,0) * eps2(m,p,-2)), 0, & - "e(0).e(-2) = 0") -call expect (abs(eps2(m,p,-1) * eps2(m,p,-1)), 1, & - "e(-1).e(-1) = 1") -call expect (abs(eps2(m,p,-1) * eps2(m,p,-2)), 0, & - "e(-1).e(-2) = 0") -call expect (abs(eps2(m,p,-2) * eps2(m,p,-2)), 1, & - "e(-2).e(-2) = 1") -\nwendcode{}\nwbegindocs{1123}\nwdocspar -\nwenddocs{}\nwbegincode{1124}\moddef{Test \code{}omega95\edoc{}}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -print *, " *** Checking the graviton propagator:" -call expect (abs(p * (cmplx (p*p - m**2, m*w, kind=default) * & - pr_tensor(p,m,w,eps2(m,p,-2)))), 0, "p.pr.e(-2)") -call expect (abs(p * (cmplx (p*p - m**2, m*w, kind=default) * & - pr_tensor(p,m,w,eps2(m,p,-1)))), 0, "p.pr.e(-1)") -call expect (abs(p * (cmplx (p*p - m**2, m*w, kind=default) * & - pr_tensor(p,m,w,eps2(m,p,0)))), 0, "p.pr.e(0)") -call expect (abs(p * (cmplx (p*p - m**2, m*w, kind=default) * & - pr_tensor(p,m,w,eps2(m,p,1)))), 0, "p.pr.e(1)") -call expect (abs(p * (cmplx (p*p - m**2, m*w, kind=default) * & - pr_tensor(p,m,w,eps2(m,p,2)))), 0, "p.pr.e(2)") -call expect (abs(p * (cmplx (p*p - m**2, m*w, kind=default) * & - pr_tensor(p,m,w,ttest))), 0, "p.pr.ttest") -\nwendcode{}\nwbegindocs{1125}\nwdocspar -\nwenddocs{}\nwbegincode{1126}\moddef{\code{}test{\_}omega95{\_}bispinors.f95\edoc{}}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -\LA{}Copyleft\RA{} -program test_omega95_bispinors - use kinds - use omega95_bispinors - use omega_vspinor_polarizations - use omega_testtools - implicit none - integer :: i, j - real(kind=default) :: m, pabs, qabs, tabs, zabs, w - real(kind=default), dimension(4) :: r - complex(kind=default) :: one - type(momentum) :: p, q, t, z, p_0 - type(vector) :: vp, vq, vt, vz - type(vectorspinor) :: testv - call random_seed () - one = 1 - w = 1.4142 - m = 13 - pabs = 42 - qabs = 137 - tabs = 84 - zabs = 3.1415 - p_0%t = m - p_0%x = 0 - call random_momentum (p, pabs, m) - call random_momentum (q, qabs, m) - call random_momentum (t, tabs, m) - call random_momentum (z, zabs, m) - call random_number (r) - do i = 1, 4 - testv%psi(1)%a(i) = (0, 0) - end do - do i = 2, 3 - do j = 1, 4 - testv%psi(i)%a(j) = cmplx (10.0_default * r(j)) - end do - end do - testv%psi(4)%a(1) = 1 - testv%psi(4)%a(1) = (0, 2.0_default) - testv%psi(4)%a(1) = 1 - testv%psi(4)%a(1) = (3.0_default, 0) - vp = p - vq = q - vt = t - vz = z -\LA{}Test \code{}omega95{\_}bispinors\edoc{}\RA{} -end program test_omega95_bispinors -\nwendcode{}\nwbegindocs{1127}\nwdocspar -\nwenddocs{}\nwbegincode{1128}\moddef{Test \code{}omega95{\_}bispinors\edoc{}}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -print *, "*** Checking the equations of motion ***:" -call expect (abs(f_vf(one,vp,u(m,p,+1))-m*u(m,p,+1)), 0, "|[p-m]u(+)|=0") -call expect (abs(f_vf(one,vp,u(m,p,-1))-m*u(m,p,-1)), 0, "|[p-m]u(-)|=0") -call expect (abs(f_vf(one,vp,v(m,p,+1))+m*v(m,p,+1)), 0, "|[p+m]v(+)|=0") -call expect (abs(f_vf(one,vp,v(m,p,-1))+m*v(m,p,-1)), 0, "|[p+m]v(-)|=0") -\nwendcode{}\nwbegindocs{1129}\nwdocspar -\nwenddocs{}\nwbegincode{1130}\moddef{Test \code{}omega95{\_}bispinors\edoc{}}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -print *, "*** Checking the normalization ***:" -call expect (s_ff(one,v(m,p,+1),u(m,p,+1)), +2*m, "ubar(+)*u(+)=+2m") -call expect (s_ff(one,v(m,p,-1),u(m,p,-1)), +2*m, "ubar(-)*u(-)=+2m") -call expect (s_ff(one,u(m,p,+1),v(m,p,+1)), -2*m, "vbar(+)*v(+)=-2m") -call expect (s_ff(one,u(m,p,-1),v(m,p,-1)), -2*m, "vbar(-)*v(-)=-2m") -call expect (s_ff(one,v(m,p,+1),v(m,p,+1)), 0, "ubar(+)*v(+)=0 ") -call expect (s_ff(one,v(m,p,-1),v(m,p,-1)), 0, "ubar(-)*v(-)=0 ") -call expect (s_ff(one,u(m,p,+1),u(m,p,+1)), 0, "vbar(+)*u(+)=0 ") -call expect (s_ff(one,u(m,p,-1),u(m,p,-1)), 0, "vbar(-)*u(-)=0 ") -\nwendcode{}\nwbegindocs{1131}\nwdocspar -\nwenddocs{}\nwbegincode{1132}\moddef{Test \code{}omega95{\_}bispinors\edoc{}}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -print *, "*** Checking the currents ***:" -call expect (abs(v_ff(one,v(m,p,+1),u(m,p,+1))-2*vp), 0, "ubar(+).V.u(+)=2p") -call expect (abs(v_ff(one,v(m,p,-1),u(m,p,-1))-2*vp), 0, "ubar(-).V.u(-)=2p") -call expect (abs(v_ff(one,u(m,p,+1),v(m,p,+1))-2*vp), 0, "vbar(+).V.v(+)=2p") -call expect (abs(v_ff(one,u(m,p,-1),v(m,p,-1))-2*vp), 0, "vbar(-).V.v(-)=2p") -\nwendcode{}\nwbegindocs{1133}\nwdocspar -\nwenddocs{}\nwbegincode{1134}\moddef{Test \code{}omega95{\_}bispinors\edoc{}}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -print *, "*** Checking current conservation ***:" -call expect ((vp-vq)*v_ff(one,v(m,p,+1),u(m,q,+1)), 0, "d(ubar(+).V.u(+))=0") -call expect ((vp-vq)*v_ff(one,v(m,p,-1),u(m,q,-1)), 0, "d(ubar(-).V.u(-))=0") -call expect ((vp-vq)*v_ff(one,u(m,p,+1),v(m,q,+1)), 0, "d(vbar(+).V.v(+))=0") -call expect ((vp-vq)*v_ff(one,u(m,p,-1),v(m,q,-1)), 0, "d(vbar(-).V.v(-))=0") -\nwendcode{}\nwbegindocs{1135}\nwdocspar -\nwenddocs{}\nwbegincode{1136}\moddef{Test \code{}omega95{\_}bispinors\edoc{}}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -if (m == 0) then - print *, "*** Checking axial current conservation ***:" - call expect ((vp-vq)*a_ff(one,v(m,p,+1),u(m,q,+1)), 0, "d(ubar(+).A.u(+))=0") - call expect ((vp-vq)*a_ff(one,v(m,p,-1),u(m,q,-1)), 0, "d(ubar(-).A.u(-))=0") - call expect ((vp-vq)*a_ff(one,u(m,p,+1),v(m,q,+1)), 0, "d(vbar(+).A.v(+))=0") - call expect ((vp-vq)*a_ff(one,u(m,p,-1),v(m,q,-1)), 0, "d(vbar(-).A.v(-))=0") -end if -\nwendcode{}\nwbegindocs{1137}\nwdocspar -\nwenddocs{}\nwbegincode{1138}\moddef{Test \code{}omega95{\_}bispinors\edoc{}}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -print *, "*** Checking polarization vectors: ***" -call expect (conjg(eps(m,p, 1))*eps(m,p, 1), -1, "e( 1).e( 1)=-1") -call expect (conjg(eps(m,p, 1))*eps(m,p,-1), 0, "e( 1).e(-1)= 0") -call expect (conjg(eps(m,p,-1))*eps(m,p, 1), 0, "e(-1).e( 1)= 0") -call expect (conjg(eps(m,p,-1))*eps(m,p,-1), -1, "e(-1).e(-1)=-1") -call expect ( p*eps(m,p, 1), 0, " p.e( 1)= 0") -call expect ( p*eps(m,p,-1), 0, " p.e(-1)= 0") -if (m > 0) then - call expect (conjg(eps(m,p, 1))*eps(m,p, 0), 0, "e( 1).e( 0)= 0") - call expect (conjg(eps(m,p, 0))*eps(m,p, 1), 0, "e( 0).e( 1)= 0") - call expect (conjg(eps(m,p, 0))*eps(m,p, 0), -1, "e( 0).e( 0)=-1") - call expect (conjg(eps(m,p, 0))*eps(m,p,-1), 0, "e( 0).e(-1)= 0") - call expect (conjg(eps(m,p,-1))*eps(m,p, 0), 0, "e(-1).e( 0)= 0") - call expect ( p*eps(m,p, 0), 0, " p.e( 0)= 0") -end if -\nwendcode{}\nwbegindocs{1139}\nwdocspar -\nwenddocs{}\nwbegincode{1140}\moddef{Test \code{}omega95{\_}bispinors\edoc{}}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -print *, "*** Checking polarization vectorspinors: ***" -call expect (abs(p * ueps(m, p, 2)), 0, "p.ueps ( 2)= 0") -call expect (abs(p * ueps(m, p, 1)), 0, "p.ueps ( 1)= 0") -call expect (abs(p * ueps(m, p, -1)), 0, "p.ueps (-1)= 0") -call expect (abs(p * ueps(m, p, -2)), 0, "p.ueps (-2)= 0") -call expect (abs(p * veps(m, p, 2)), 0, "p.veps ( 2)= 0") -call expect (abs(p * veps(m, p, 1)), 0, "p.veps ( 1)= 0") -call expect (abs(p * veps(m, p, -1)), 0, "p.veps (-1)= 0") -call expect (abs(p * veps(m, p, -2)), 0, "p.veps (-2)= 0") -print *, "*** in the rest frame ***" -call expect (abs(p_0 * ueps(m, p_0, 2)), 0, "p0.ueps ( 2)= 0") -call expect (abs(p_0 * ueps(m, p_0, 1)), 0, "p0.ueps ( 1)= 0") -call expect (abs(p_0 * ueps(m, p_0, -1)), 0, "p0.ueps (-1)= 0") -call expect (abs(p_0 * ueps(m, p_0, -2)), 0, "p0.ueps (-2)= 0") -call expect (abs(p_0 * veps(m, p_0, 2)), 0, "p0.veps ( 2)= 0") -call expect (abs(p_0 * veps(m, p_0, 1)), 0, "p0.veps ( 1)= 0") -call expect (abs(p_0 * veps(m, p_0, -1)), 0, "p0.veps (-1)= 0") -call expect (abs(p_0 * veps(m, p_0, -2)), 0, "p0.veps (-2)= 0") -\nwendcode{}\nwbegindocs{1141}\nwdocspar -\nwenddocs{}\nwbegincode{1142}\moddef{Test \code{}omega95{\_}bispinors\edoc{}}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -print *, "*** Checking the irreducibility condition: ***" -call expect (abs(f_potgr (one, one, ueps(m, p, 2))), 0, "g.ueps ( 2)") -call expect (abs(f_potgr (one, one, ueps(m, p, 1))), 0, "g.ueps ( 1)") -call expect (abs(f_potgr (one, one, ueps(m, p, -1))), 0, "g.ueps (-1)") -call expect (abs(f_potgr (one, one, ueps(m, p, -2))), 0, "g.ueps (-2)") -call expect (abs(f_potgr (one, one, veps(m, p, 2))), 0, "g.veps ( 2)") -call expect (abs(f_potgr (one, one, veps(m, p, 1))), 0, "g.veps ( 1)") -call expect (abs(f_potgr (one, one, veps(m, p, -1))), 0, "g.veps (-1)") -call expect (abs(f_potgr (one, one, veps(m, p, -2))), 0, "g.veps (-2)") -print *, "*** in the rest frame ***" -call expect (abs(f_potgr (one, one, ueps(m, p_0, 2))), 0, "g.ueps ( 2)") -call expect (abs(f_potgr (one, one, ueps(m, p_0, 1))), 0, "g.ueps ( 1)") -call expect (abs(f_potgr (one, one, ueps(m, p_0, -1))), 0, "g.ueps (-1)") -call expect (abs(f_potgr (one, one, ueps(m, p_0, -2))), 0, "g.ueps (-2)") -call expect (abs(f_potgr (one, one, veps(m, p_0, 2))), 0, "g.veps ( 2)") -call expect (abs(f_potgr (one, one, veps(m, p_0, 1))), 0, "g.veps ( 1)") -call expect (abs(f_potgr (one, one, veps(m, p_0, -1))), 0, "g.veps (-1)") -call expect (abs(f_potgr (one, one, veps(m, p_0, -2))), 0, "g.veps (-2)") -\nwendcode{}\nwbegindocs{1143}\nwdocspar -\nwenddocs{}\nwbegincode{1144}\moddef{Test \code{}omega95{\_}bispinors\edoc{}}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -print *, "*** Testing vectorspinor normalization ***" -call expect (veps(m,p, 2)*ueps(m,p, 2), -2*m, "ueps( 2).ueps( 2)= -2m") -call expect (veps(m,p, 1)*ueps(m,p, 1), -2*m, "ueps( 1).ueps( 1)= -2m") -call expect (veps(m,p,-1)*ueps(m,p,-1), -2*m, "ueps(-1).ueps(-1)= -2m") -call expect (veps(m,p,-2)*ueps(m,p,-2), -2*m, "ueps(-2).ueps(-2)= -2m") -call expect (ueps(m,p, 2)*veps(m,p, 2), 2*m, "veps( 2).veps( 2)= +2m") -call expect (ueps(m,p, 1)*veps(m,p, 1), 2*m, "veps( 1).veps( 1)= +2m") -call expect (ueps(m,p,-1)*veps(m,p,-1), 2*m, "veps(-1).veps(-1)= +2m") -call expect (ueps(m,p,-2)*veps(m,p,-2), 2*m, "veps(-2).veps(-2)= +2m") -call expect (ueps(m,p, 2)*ueps(m,p, 2), 0, "ueps( 2).veps( 2)= 0") -call expect (ueps(m,p, 1)*ueps(m,p, 1), 0, "ueps( 1).veps( 1)= 0") -call expect (ueps(m,p,-1)*ueps(m,p,-1), 0, "ueps(-1).veps(-1)= 0") -call expect (ueps(m,p,-2)*ueps(m,p,-2), 0, "ueps(-2).veps(-2)= 0") -call expect (veps(m,p, 2)*veps(m,p, 2), 0, "veps( 2).ueps( 2)= 0") -call expect (veps(m,p, 1)*veps(m,p, 1), 0, "veps( 1).ueps( 1)= 0") -call expect (veps(m,p,-1)*veps(m,p,-1), 0, "veps(-1).ueps(-1)= 0") -call expect (veps(m,p,-2)*veps(m,p,-2), 0, "veps(-2).ueps(-2)= 0") -print *, "*** in the rest frame ***" -call expect (veps(m,p_0, 2)*ueps(m,p_0, 2), -2*m, "ueps( 2).ueps( 2)= -2m") -call expect (veps(m,p_0, 1)*ueps(m,p_0, 1), -2*m, "ueps( 1).ueps( 1)= -2m") -call expect (veps(m,p_0,-1)*ueps(m,p_0,-1), -2*m, "ueps(-1).ueps(-1)= -2m") -call expect (veps(m,p_0,-2)*ueps(m,p_0,-2), -2*m, "ueps(-2).ueps(-2)= -2m") -call expect (ueps(m,p_0, 2)*veps(m,p_0, 2), 2*m, "veps( 2).veps( 2)= +2m") -call expect (ueps(m,p_0, 1)*veps(m,p_0, 1), 2*m, "veps( 1).veps( 1)= +2m") -call expect (ueps(m,p_0,-1)*veps(m,p_0,-1), 2*m, "veps(-1).veps(-1)= +2m") -call expect (ueps(m,p_0,-2)*veps(m,p_0,-2), 2*m, "veps(-2).veps(-2)= +2m") -call expect (ueps(m,p_0, 2)*ueps(m,p_0, 2), 0, "ueps( 2).veps( 2)= 0") -call expect (ueps(m,p_0, 1)*ueps(m,p_0, 1), 0, "ueps( 1).veps( 1)= 0") -call expect (ueps(m,p_0,-1)*ueps(m,p_0,-1), 0, "ueps(-1).veps(-1)= 0") -call expect (ueps(m,p_0,-2)*ueps(m,p_0,-2), 0, "ueps(-2).veps(-2)= 0") -call expect (veps(m,p_0, 2)*veps(m,p_0, 2), 0, "veps( 2).ueps( 2)= 0") -call expect (veps(m,p_0, 1)*veps(m,p_0, 1), 0, "veps( 1).ueps( 1)= 0") -call expect (veps(m,p_0,-1)*veps(m,p_0,-1), 0, "veps(-1).ueps(-1)= 0") -call expect (veps(m,p_0,-2)*veps(m,p_0,-2), 0, "veps(-2).ueps(-2)= 0") -\nwendcode{}\nwbegindocs{1145}\nwdocspar -\nwenddocs{}\nwbegincode{1146}\moddef{Test \code{}omega95{\_}bispinors\edoc{}}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -print *, "*** Majorana properties of gravitino vertices: ***" -call expect (abs(u (m,q,1) * f_sgr (one, one, ueps(m,p,2), t) + & - ueps(m,p,2) * gr_sf(one,one,u(m,q,1),t)), 0, "f_sgr + gr_sf = 0") -!!! call expect (abs(u (m,q,-1) * f_sgr (one, one, ueps(m,p,2), t) + & -!!! ueps(m,p,2) * gr_sf(one,one,u(m,q,-1),t)), 0, "f_sgr + gr_sf = 0") -!!! call expect (abs(u (m,q,1) * f_sgr (one, one, ueps(m,p,1), t) + & -!!! ueps(m,p,1) * gr_sf(one,one,u(m,q,1),t)), 0, "f_sgr + gr_sf = 0") -!!! call expect (abs(u (m,q,-1) * f_sgr (one, one, ueps(m,p,1), t) + & -!!! ueps(m,p,1) * gr_sf(one,one,u(m,q,-1),t)), 0, "f_sgr + gr_sf = 0") -!!! call expect (abs(u (m,q,1) * f_sgr (one, one, ueps(m,p,-1), t) + & -!!! ueps(m,p,-1) * gr_sf(one,one,u(m,q,1),t)), 0, "f_sgr + gr_sf = 0") -!!! call expect (abs(u (m,q,-1) * f_sgr (one, one, ueps(m,p,-1), t) + & -!!! ueps(m,p,-1) * gr_sf(one,one,u(m,q,-1),t)), 0, "f_sgr + gr_sf = 0") -!!! call expect (abs(u (m,q,1) * f_sgr (one, one, ueps(m,p,-2), t) + & -!!! ueps(m,p,-2) * gr_sf(one,one,u(m,q,1),t)), 0, "f_sgr + gr_sf = 0") -!!! call expect (abs(u (m,q,-1) * f_sgr (one, one, ueps(m,p,-2), t) + & -!!! ueps(m,p,-2) * gr_sf(one,one,u(m,q,-1),t)), 0, "f_sgr + gr_sf = 0") -call expect (abs(u (m,q,1) * f_pgr (one, one, ueps(m,p,2), t) + & - ueps(m,p,2) * gr_pf(one,one,u(m,q,1),t)), 0, "f_pgr + gr_pf = 0") -call expect (abs(u (m,q,1) * f_vgr (one, vt, ueps(m,p,2), p+q) + & - ueps(m,p,2) * gr_vf(one,vt,u(m,q,1),p+q)), 0, "f_vgr + gr_vf = 0") -!!! call expect (abs(u (m,q,-1) * f_vgr (one, vt, ueps(m,p,2), p+q) + & -!!! ueps(m,p,2) * gr_vf(one,vt,u(m,q,-1),p+q)), 0, "f_vgr + gr_vf = 0") -!!! call expect (abs(u (m,q,1) * f_vgr (one, vt, ueps(m,p,1), p+q) + & -!!! ueps(m,p,1) * gr_vf(one,vt,u(m,q,1),p+q)), 0, "f_vgr + gr_vf = 0") -!!! call expect (abs(u (m,q,-1) * f_vgr (one, vt, ueps(m,p,1), p+q) + & -!!! ueps(m,p,1) * gr_vf(one,vt,u(m,q,-1),p+q)), 0, "f_vgr + gr_vf = 0") -!!! call expect (abs(u (m,q,1) * f_vgr (one, vt, ueps(m,p,-1), p+q) + & -!!! ueps(m,p,-1) * gr_vf(one,vt,u(m,q,1),p+q)), 0, "f_vgr + gr_vf = 0") -!!! call expect (abs(u (m,q,-1) * f_vgr (one, vt, veps(m,p,-1), p+q) + & -!!! veps(m,p,-1) * gr_vf(one,vt,u(m,q,-1),p+q)), 0, "f_vgr + gr_vf = 0") -!!! call expect (abs(v (m,q,1) * f_vgr (one, vt, ueps(m,p,-2), p+q) + & -!!! ueps(m,p,-2) * gr_vf(one,vt,v(m,q,1),p+q)), 0, "f_vgr + gr_vf = 0") -!!! call expect (abs(u (m,q,-1) * f_vgr (one, vt, ueps(m,p,-2), p+q) + & -!!! ueps(m,p,-2) * gr_vf(one,vt,u(m,q,-1),p+q)), 0, "f_vgr + gr_vf = 0") -call expect (abs(s_grf (one, ueps(m,p,2), u(m,q,1),t) + & - s_fgr(one,u(m,q,1),ueps(m,p,2),t)), 0, "s_grf + s_fgr = 0") -call expect (abs(p_grf (one, ueps(m,p,2), u(m,q,1),t) + & - p_fgr(one,u(m,q,1),ueps(m,p,2),t)), 0, "p_grf + p_fgr = 0") -call expect (abs(v_grf (one, ueps(m,p,2), u(m,q,1),t) + & - v_fgr(one,u(m,q,1),ueps(m,p,2),t)), 0, "v_grf + v_fgr = 0") -call expect (abs(u(m,p,1) * f_potgr (one,one,testv) - testv * gr_potf & - (one,one,u (m,p,1))), 0, "f_potgr - gr_potf = 0") -call expect (abs (pot_fgr (one,u(m,p,1),testv) - pot_grf(one, & - testv,u(m,p,1))), 0, "pot_fgr - pot_grf = 0") -call expect (abs(u(m,p,1) * f_s2gr (one,one,one,testv) - testv * gr_s2f & - (one,one,one,u (m,p,1))), 0, "f_s2gr - gr_s2f = 0") -call expect (abs (s2_fgr (one,u(m,p,1),one,testv) - s2_grf(one, & - testv,one,u(m,p,1))), 0, "s2_fgr - s2_grf = 0") -call expect (abs(u (m,q,1) * f_svgr (one, one, vt, ueps(m,p,2)) + & - ueps(m,p,2) * gr_svf(one,one,vt,u(m,q,1))), 0, "f_svgr + gr_svf = 0") -call expect (abs (sv1_fgr (one,u(m,p,1),vt,ueps(m,q,2)) + sv1_grf(one, & - ueps(m,q,2),vt,u(m,p,1))), 0, "sv1_fgr + sv1_grf = 0") -call expect (abs (sv2_fgr (one,u(m,p,1),one,ueps(m,q,2)) + sv2_grf(one, & - ueps(m,q,2),one,u(m,p,1))), 0, "sv2_fgr + sv2_grf = 0") -call expect (abs(u (m,q,1) * f_pvgr (one, one, vt, ueps(m,p,2)) + & - ueps(m,p,2) * gr_pvf(one,one,vt,u(m,q,1))), 0, "f_pvgr + gr_pvf = 0") -call expect (abs (pv1_fgr (one,u(m,p,1),vt,ueps(m,q,2)) + pv1_grf(one, & - ueps(m,q,2),vt,u(m,p,1))), 0, "pv1_fgr + pv1_grf = 0") -call expect (abs (pv2_fgr (one,u(m,p,1),one,ueps(m,q,2)) + pv2_grf(one, & - ueps(m,q,2),one,u(m,p,1))), 0, "pv2_fgr + pv2_grf = 0") -call expect (abs(u (m,q,1) * f_v2gr (one, vt, vz, ueps(m,p,2)) + & - ueps(m,p,2) * gr_v2f(one,vt,vz,u(m,q,1))), 0, "f_v2gr + gr_v2f = 0") -call expect (abs (v2_fgr (one,u(m,p,1),vt,ueps(m,q,2)) + v2_grf(one, & - ueps(m,q,2),vt,u(m,p,1))), 0, "v2_fgr + v2_grf = 0") -\nwendcode{}\nwbegindocs{1147}\nwdocspar -\nwenddocs{}\nwbegincode{1148}\moddef{Test \code{}omega95{\_}bispinors\edoc{}}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -print *, "*** Testing the gravitino propagator: ***" -print *, "Transversality:" -call expect (abs(p * (cmplx (p*p - m**2, m*w, kind=default) * & - pr_grav(p,m,w,testv))), 0, "p.pr.test") -call expect (abs(p * (cmplx (p*p - m**2, m*w, kind=default) * & - pr_grav(p,m,w,ueps(m,p,2)))), 0, "p.pr.ueps ( 2)") -call expect (abs(p * (cmplx (p*p - m**2, m*w, kind=default) * & - pr_grav(p,m,w,ueps(m,p,1)))), 0, "p.pr.ueps ( 1)") -call expect (abs(p * (cmplx (p*p - m**2, m*w, kind=default) * & - pr_grav(p,m,w,ueps(m,p,-1)))), 0, "p.pr.ueps (-1)") -call expect (abs(p * (cmplx (p*p - m**2, m*w, kind=default) * & - pr_grav(p,m,w,ueps(m,p,-2)))), 0, "p.pr.ueps (-2)") -call expect (abs(p * (cmplx (p*p - m**2, m*w, kind=default) * & - pr_grav(p,m,w,veps(m,p,2)))), 0, "p.pr.veps ( 2)") -call expect (abs(p * (cmplx (p*p - m**2, m*w, kind=default) * & - pr_grav(p,m,w,veps(m,p,1)))), 0, "p.pr.veps ( 1)") -call expect (abs(p * (cmplx (p*p - m**2, m*w, kind=default) * & - pr_grav(p,m,w,veps(m,p,-1)))), 0, "p.pr.veps (-1)") -call expect (abs(p * (cmplx (p*p - m**2, m*w, kind=default) * & - pr_grav(p,m,w,veps(m,p,-2)))), 0, "p.pr.veps (-2)") -print *, "Irreducibility:" -call expect (abs(f_potgr (one, one, (cmplx (p*p - m**2, m*w, & - kind=default) * pr_grav(p,m,w,testv)))), 0, "g.pr.test") -call expect (abs(f_potgr (one, one, (cmplx (p*p - m**2, m*w, & - kind=default) * pr_grav(p,m,w,ueps(m,p,2))))), 0, & - "g.pr.ueps ( 2)") -call expect (abs(f_potgr (one, one, (cmplx (p*p - m**2, m*w, & - kind=default) * pr_grav(p,m,w,ueps(m,p,1))))), 0, & - "g.pr.ueps ( 1)") -call expect (abs(f_potgr (one, one, (cmplx (p*p - m**2, m*w, & - kind=default) * pr_grav(p,m,w,ueps(m,p,-1))))), 0, & - "g.pr.ueps (-1)") -call expect (abs(f_potgr (one, one, (cmplx (p*p - m**2, m*w, & - kind=default) * pr_grav(p,m,w,ueps(m,p,-2))))), 0, & - "g.pr.ueps (-2)") -call expect (abs(f_potgr (one, one, (cmplx (p*p - m**2, m*w, & - kind=default) * pr_grav(p,m,w,veps(m,p,2))))), 0, & - "g.pr.veps ( 2)") -call expect (abs(f_potgr (one, one, (cmplx (p*p - m**2, m*w, & - kind=default) * pr_grav(p,m,w,veps(m,p,1))))), 0, & - "g.pr.veps ( 1)") -call expect (abs(f_potgr (one, one, (cmplx (p*p - m**2, m*w, & - kind=default) * pr_grav(p,m,w,veps(m,p,-1))))), 0, & - "g.pr.veps (-1)") -call expect (abs(f_potgr (one, one, (cmplx (p*p - m**2, m*w, & - kind=default) * pr_grav(p,m,w,veps(m,p,-2))))), 0, & - "g.pr.veps (-2)") -\nwendcode{}\nwbegindocs{1149}\nwdocspar -\nwenddocs{}\nwbegincode{1150}\moddef{\code{}omega{\_}bundle.f95\edoc{}}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -\LA{}\code{}kinds.f95\edoc{}\RA{} -\LA{}\code{}omega{\_}constants.f95\edoc{}\RA{} -\LA{}\code{}omega{\_}vectors.f95\edoc{}\RA{} -\LA{}\code{}omega{\_}spinors.f95\edoc{}\RA{} -\LA{}\code{}omega{\_}bispinors.f95\edoc{}\RA{} -\LA{}\code{}omega{\_}vectorspinors.f95\edoc{}\RA{} -\LA{}\code{}omega{\_}polarizations.f95\edoc{}\RA{} -\LA{}\code{}omega{\_}tensors.f95\edoc{}\RA{} -\LA{}\code{}omega{\_}tensor{\_}polarizations.f95\edoc{}\RA{} -\LA{}\code{}omega{\_}couplings.f95\edoc{}\RA{} -\LA{}\code{}omega{\_}spinor{\_}couplings.f95\edoc{}\RA{} -\LA{}\code{}omega{\_}bispinor{\_}couplings.f95\edoc{}\RA{} -\LA{}\code{}omega{\_}vspinor{\_}polarizations.f95\edoc{}\RA{} -\LA{}\code{}omega{\_}utils.f95\edoc{}\RA{} -\LA{}\code{}omega95.f95\edoc{}\RA{} -\LA{}\code{}omega95{\_}bispinors.f95\edoc{}\RA{} -\LA{}\code{}omega{\_}parameters.f95\edoc{}\RA{} -\LA{}\code{}omega{\_}parameters{\_}madgraph.f95\edoc{}\RA{} -\nwendcode{}\nwbegindocs{1151}\nwdocspar -\nwenddocs{}\nwbegincode{1152}\moddef{\code{}omega{\_}bundle{\_}whizard.f95\edoc{}}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -\LA{}\code{}omega{\_}bundle.f95\edoc{}\RA{} -\LA{}\code{}omega{\_}parameters{\_}whizard.f95\edoc{}\RA{} -\nwendcode{}\nwbegindocs{1153}%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\section{O'Mega Virtual Machine} -\nwenddocs{}\nwbegincode{1154}\moddef{\code{}omegavm95.f95\edoc{}}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -\LA{}Copyleft\RA{} -module omegavm95 - use kinds - use omega95 - ! use omega95_bispinors - implicit none - private - \LA{}OVM Procedure Declarations\RA{} - \LA{}OVM Data Declarations\RA{} - \LA{}OVM Instructions\RA{} -contains - \LA{}OVM Procedure Implementations\RA{} -end module omegavm95 -\nwendcode{}\nwbegindocs{1155}\nwdocspar -\subsection{Memory Layout} -On one hand, we need a memory pool for all the intermediate results -\nwenddocs{}\nwbegincode{1156}\moddef{OVM Data Declarations}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -type, public :: ovm - private - complex(kind=default) :: amp - type(momentum), dimension(:), pointer :: p - complex(kind=default), dimension(:), pointer :: phi - type(spinor), dimension(:), pointer :: psi - type(conjspinor), dimension(:), pointer :: psibar - ! type(bispinor), dimension(:), pointer :: chi - type(vector), dimension(:), pointer :: v -end type ovm -\nwendcode{}\nwbegindocs{1157}\nwdocspar -\nwenddocs{}\nwbegincode{1158}\moddef{OVM Procedure Declarations}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -public :: alloc -\nwendcode{}\nwbegindocs{1159}\nwdocspar -\nwenddocs{}\nwbegincode{1160}\moddef{OVM Procedure Implementations}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -subroutine alloc (vm, momenta, scalars, spinors, conjspinors, vectors) - type(ovm), intent(inout) :: vm - integer, intent(in) :: momenta, scalars, spinors, conjspinors, vectors - allocate (vm%p(momenta)) - allocate (vm%phi(scalars)) - allocate (vm%psi(spinors)) - allocate (vm%psibar(conjspinors)) - allocate (vm%v(vectors)) -end subroutine alloc -\nwendcode{}\nwbegindocs{1161}and on the other hand, we need to access coupling parameters that -define the environment -\nwenddocs{}\nwbegincode{1162}\moddef{OVM Data Declarations}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -type, public :: ovm_env - private - real(kind=default), dimension(:), pointer :: gr - real(kind=default), dimension(:,:), pointer :: gr2 - complex(kind=default), dimension(:), pointer :: gc - complex(kind=default), dimension(:,:), pointer :: gc2 -end type ovm_env -\nwendcode{}\nwbegindocs{1163}NB: during, execution, the type of the coupling constant is implicit -in the instruction. -\begin{dubious} - How to load coupling constants? Is brute force linear lookup good - enough? -\end{dubious} -\nwenddocs{}\nwbegindocs{1164}\subsection{Instruction Set} -\nwenddocs{}\nwbegincode{1165}\moddef{OVM Data Declarations}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -integer, parameter, private :: MAX_RHS = 3 -type, public :: instr - private - integer :: code, sign, coupl, lhs - integer, dimension(MAX_RHS) :: rhs -end type instr -\nwendcode{}\nwbegindocs{1166}\nwdocspar -\nwenddocs{}\nwbegincode{1167}\moddef{OVM Procedure Declarations}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -public :: eval -\nwendcode{}\nwbegindocs{1168}\nwdocspar -\nwenddocs{}\nwbegincode{1169}\moddef{OVM Procedure Implementations}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -pure subroutine eval (vm, amp, env, amplitude, p, s) - type(ovm), intent(inout) :: vm - complex(kind=default), intent(out) :: amp - type(ovm_env), intent(in) :: env - type(instr), dimension(:), intent(in) :: amplitude - real(kind=default), dimension(0:,:), intent(in) :: p - integer, dimension(:), intent(in) :: s - integer :: code, sign, coupl, lhs - integer, dimension(MAX_RHS) :: rhs - integer :: i, pc - vm%p(1) = - p(:,1) - vm%p(2) = - p(:,2) - do i = 3, size (p, dim = 2) - vm%p(i) = p(:,i) - end do - do pc = 1, size (amplitude) - code = amplitude(pc)%code - sign = amplitude(pc)%sign - coupl = amplitude(pc)%coupl - lhs = amplitude(pc)%lhs - rhs = amplitude(pc)%rhs - select case (code) - \LA{}\code{}case\edoc{}s of \code{}code\edoc{}\RA{} - end select - end do - amp = vm%amp -end subroutine eval -\nwendcode{}\nwbegindocs{1170}\subsubsection{Loading External states} -\nwenddocs{}\nwbegincode{1171}\moddef{OVM Instructions}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -integer, public, parameter :: OVM_LOAD_SCALAR = 1 -integer, public, parameter :: OVM_LOAD_U = 2 -integer, public, parameter :: OVM_LOAD_UBAR = 3 -integer, public, parameter :: OVM_LOAD_V = 4 -integer, public, parameter :: OVM_LOAD_VBAR = 5 -integer, public, parameter :: OVM_LOAD_VECTOR = 6 -\nwendcode{}\nwbegindocs{1172}\nwdocspar -\nwenddocs{}\nwbegincode{1173}\moddef{\code{}case\edoc{}s of \code{}code\edoc{}}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -case (OVM_LOAD_SCALAR) - vm%phi(lhs) = 1 -case (OVM_LOAD_U) - if (lhs <= 2) then - vm%psi(lhs) = u (env%gr(coupl), - vm%p(rhs(1)), s(rhs(2))) - else - vm%psi(lhs) = u (env%gr(coupl), vm%p(rhs(1)), s(rhs(2))) - end if -case (OVM_LOAD_UBAR) - if (lhs <= 2) then - vm%psibar(lhs) = ubar (env%gr(coupl), - vm%p(rhs(1)), s(rhs(2))) - else - vm%psibar(lhs) = ubar (env%gr(coupl), vm%p(rhs(1)), s(rhs(2))) - end if -case (OVM_LOAD_V) - if (lhs <= 2) then - vm%psi(lhs) = v (env%gr(coupl), - vm%p(rhs(1)), s(rhs(2))) - else - vm%psi(lhs) = v (env%gr(coupl), vm%p(rhs(1)), s(rhs(2))) - end if -case (OVM_LOAD_VBAR) - if (lhs <= 2) then - vm%psibar(lhs) = vbar (env%gr(coupl), - vm%p(rhs(1)), s(rhs(2))) - else - vm%psibar(lhs) = vbar (env%gr(coupl), vm%p(rhs(1)), s(rhs(2))) - end if -case (OVM_LOAD_VECTOR) - if (lhs <= 2) then - vm%v(lhs) = eps (env%gr(coupl), - vm%p(rhs(1)), s(rhs(2))) - else - vm%v(lhs) = eps (env%gr(coupl), vm%p(rhs(1)), s(rhs(2))) - end if -\nwendcode{}\nwbegindocs{1174}\nwdocspar -\nwenddocs{}\nwbegincode{1175}\moddef{OVM Instructions}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -integer, public, parameter :: OVM_ADD_MOMENTA = 10 -\nwendcode{}\nwbegindocs{1176}\nwdocspar -\nwenddocs{}\nwbegincode{1177}\moddef{\code{}case\edoc{}s of \code{}code\edoc{}}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -case (OVM_ADD_MOMENTA) - vm%p(lhs) = vm%p(rhs(1)) + vm%p(rhs(2)) -\nwendcode{}\nwbegindocs{1178}\nwdocspar -\nwenddocs{}\nwbegincode{1179}\moddef{OVM Instructions}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -integer, public, parameter :: OVM_PROPAGATE_SCALAR = 11 -integer, public, parameter :: OVM_PROPAGATE_SPINOR = 12 -\nwendcode{}\nwbegindocs{1180}\nwdocspar -\nwenddocs{}\nwbegincode{1181}\moddef{\code{}case\edoc{}s of \code{}code\edoc{}}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -case (OVM_PROPAGATE_SCALAR) - vm%phi(lhs) = pr_phi (vm%p(lhs),env%gr(rhs(1)),env%gr(rhs(2)),vm%phi(lhs)) -case (OVM_PROPAGATE_SPINOR) - vm%psi(lhs) = pr_psi (vm%p(lhs),env%gr(rhs(1)),env%gr(rhs(2)),vm%psi(lhs)) -\nwendcode{}\nwbegindocs{1182}\nwdocspar -\nwenddocs{}\nwbegincode{1183}\moddef{OVM Instructions}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -integer, public, parameter :: OVM_FUSE_VECTOR_PSIBAR_PSI = 21 -integer, public, parameter :: OVM_FUSE_PSI_VECTOR_PSI = 22 -integer, public, parameter :: OVM_FUSE_PSIBAR_PSIBAR_VECTOR = 23 -\nwendcode{}\nwbegindocs{1184}\nwdocspar -\nwenddocs{}\nwbegincode{1185}\moddef{\code{}case\edoc{}s of \code{}code\edoc{}}\plusendmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -case (OVM_FUSE_VECTOR_PSIBAR_PSI) - vm%v(lhs) = & - v_ff (sign*env%gc(coupl), vm%psibar(rhs(1)), vm%psi(rhs(2))) -case (OVM_FUSE_PSI_VECTOR_PSI) - vm%psi(lhs) = & - f_vf (sign*env%gc(coupl), vm%v(rhs(1)), vm%psi(rhs(2))) -case (OVM_FUSE_PSIBAR_PSIBAR_VECTOR) - vm%psibar(lhs) = & - f_fv (sign*env%gc(coupl), vm%psibar(rhs(1)), vm%v(rhs(2))) -\nwendcode{}\nwbegindocs{1186}%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\nwenddocs{}\nwbegincode{1187}\moddef{Copyleft}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -! $Id: omegalib.nw 727 2009-06-09 08:39:22Z ohl $ -! -! Copyright (C) 1999-2009 by -! Wolfgang Kilian -! Thorsten Ohl -! Juergen Reuter -! -! WHIZARD is free software; you can redistribute it and/or modify it -! under the terms of the GNU General Public License as published by -! the Free Software Foundation; either version 2, or (at your option) -! any later version. -! -! WHIZARD is distributed in the hope that it will be useful, but -! WITHOUT ANY WARRANTY; without even the implied warranty of -! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -! GNU General Public License for more details. -! -! You should have received a copy of the GNU General Public License -! along with this program; if not, write to the Free Software -! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -\nwendcode{}\nwbegindocs{1188}\nwdocspar -\section{Fortran77} -\nwenddocs{}\nwbegincode{1189}\moddef{\code{}omega77.f\edoc{}}\endmoddef\nwstartdeflinemarkup\nwenddeflinemarkup -C $Id: omegalib.nw 727 2009-06-09 08:39:22Z ohl $ -C -C Copyright (C) 1999-2009 by -C Wolfgang Kilian -C Thorsten Ohl -C Juergen Reuter -C -C WHIZARD is free software; you can redistribute it and/or modify it -C under the terms of the GNU General Public License as published by -C the Free Software Foundation; either version 2, or (at your option) -C any later version. -C -C WHIZARD is distributed in the hope that it will be useful, but -C WITHOUT ANY WARRANTY; without even the implied warranty of -C MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -C GNU General Public License for more details. -C -C You should have received a copy of the GNU General Public License -C along with this program; if not, write to the Free Software -C Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -\LA{}Operations for spinors (Fortran77)\RA{} -\LA{}Operations for vectors (Fortran77)\RA{} -\LA{}Spinor couplings (Fortran77)\RA{} -\nwendcode{}\nwbegindocs{1190}%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% Local Variables: -% mode:noweb -% noweb-doc-mode:latex-mode -% noweb-code-mode:f90-mode -% indent-tabs-mode:nil -% page-delimiter:"^@ %%%.*\n" -% End: -\nwenddocs{} Index: branches/ohl/omega-development/completed/whizard2/web/Makefile.in =================================================================== --- branches/ohl/omega-development/completed/whizard2/web/Makefile.in (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/web/Makefile.in (revision 8703) @@ -1,185 +0,0 @@ -# $Id$ -# -# Copyright (C) 1999-2009 by -# -# Wolfgang Kilian -# Thorsten Ohl -# Juergen Reuter -# -# WHIZARD is free software; you can redistribute it and/or modify it -# under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2, or (at your option) -# any later version. -# -# WHIZARD is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -# -######################################################################## - -prefix = @prefix@ -top_srcdir = @top_srcdir@ - -### host = @host@ - -# Architecture dependent source and binary directories -builddir_bin = $(top_srcdir)/bin -builddir_lib = $(top_srcdir)/lib -builddir_src = $(top_srcdir)/src - -# Architecture independent source directories -srcdir_src = $(top_srcdir)/src - -SELECT_PROGRAMS_CUSTOM = @SELECT_PROGRAMS_CUSTOM@ -SELECT_PROGRAMS_RELEASED = @SELECT_PROGRAMS_RELEASED@ -SELECT_PROGRAMS_UNRELEASED = @SELECT_PROGRAMS_UNRELEASED@ -SELECT_PROGRAMS_THEORETICAL = @SELECT_PROGRAMS_THEORETICAL@ -SELECT_PROGRAMS_REDUNDANT = @SELECT_PROGRAMS_REDUNDANT@ -SELECT_PROGRAMS_DEVELOPERS = @SELECT_PROGRAMS_DEVELOPERS@ -SELECT_PROGRAMS_OBSOLETE = @SELECT_PROGRAMS_OBSOLETE@ -SELECT_PROGRAMS_GUI = @SELECT_PROGRAMS_GUI@ - -CPIF = @CPIF@ -OCAMLWEB = @OCAMLWEB@ -OCAMLDOT = @OCAMLDOT@ -NOWEAVE = @NOWEAVE@ -DOT = @DOT@ -LATEX = @LATEX@ -PDFLATEX = @PDFLATEX@ -METAPOST = @METAPOST@ -DVIPS = @DVIPS@ -GHOSTVIEW = @GHOSTVIEW@ -ACROREAD = @ACROREAD@ -EPSTOPDF = @EPSTOPDF@ -GZIP = @GZIP@ - -######################################################################## - -vpath %.ml $(srcdir_src) -vpath %.mli $(srcdir_src) -vpath %.mll $(srcdir_src) -vpath %.mly $(srcdir_src) -vpath %.nw $(srcdir_src) -vpath %.tex $(srcdir_src) - -######################################################################## - -all: - @echo make "[ps|psv]" - -include $(srcdir_src)/Makefile.src - -# ps: omega.ps omega-title.ps -ps: omega.ps -psv: omega.psv -pdf: omega.pdf -pdfv: omega.pdfv - -######################################################################## - -%.psv: %.ps - nohup sh -c '$(GHOSTVIEW) --media=a4 --orientation=portrait $< &' 2>/dev/null 1>/dev/null - -%.pdfv: %.pdf - nohup sh -c '$(ACROREAD) $< &' 2>/dev/null 1>/dev/null - -%.ps: %.dvi - $(DVIPS) -t a4 -o $@ $< - -%.ps.gz: %.ps - $(GZIP) -9 < $< > $@ - -omega.dvi: omega.tex $(DERIVED_TEX) RCS.info - -$(LATEX) $< - TEX=$(LATEX) $(METAPOST) $(@:.dvi=.mp) - $(METAPOST) $(@:.dvi=pics.mp) - $(LATEX) $< - if grep -s 'Rerun to get cross-references right.' $(@:.dvi=.log); then \ - $(LATEX) $<; \ - fi - -epstopdf: - for i in modules.eps el_te_ph.eps $(DAGS); do $(EPSTOPDF) $$i; done - -omega.pdf: omega.tex $(DERIVED_TEX) RCS.info - rm -f omega.aux omega.out omega.toc omega.idx - -$(PDFLATEX) $< - TEX=$(LATEX) $(METAPOST) $(@:.pdf=.mp) - $(METAPOST) $(@:.pdf=pics.mp) - $(PDFLATEX) $< - if grep -s 'Rerun to get cross-references right.' $(@:.pdf=.mp); then \ - $(PDFLATEX) $<; \ - fi - -RCS.info: omega.tex $(SRC_ML) $(SRC_MLI) $(SRC_MLL) $(SRC_MLY) lapack.nw omegalib.nw - ident $^ | grep '\$$'Id: | sort > $@ - -lapack.implementation: lapack_enabled.ml - $(OCAMLWEB) --no-preamble --noweb --no-index $< >$@ - -%.implementation: %.mll - $(OCAMLWEB) --no-preamble --noweb --no-index $< >$@ - -%.implementation: %.mly - $(OCAMLWEB) --no-preamble --noweb --no-index $< >$@ - -%.implementation: %.ml - $(OCAMLWEB) --no-preamble --noweb --no-index $< >$@ - -%.interface: %.mli - $(OCAMLWEB) --no-preamble --noweb --no-index $< >$@ - -%.tex: %.nw - $(NOWEAVE) -delay $< | $(CPIF) $@ - -# index.tex: $(SRC_ML) $(SRC_MLI) -index.tex: $(filter-out models2.ml, $(SRC_ML) $(SRC_MLI)) - $(OCAMLWEB) --no-preamble --noweb $^ | \ - sed -n '/\\ocwbeginindex{}/,/\\ocwendindex{}/p' >$@ - -.PHONY: DAGS -DAGS: $(DAGS) - -bhabha0.eps: - $(builddir_bin)/f90_SM.opt -summary e+ e- e+ e- -full_dag /dev/stdout \ - | $(DOT) -Tps >$@ - -bhabha.eps: - $(builddir_bin)/f90_SM.opt -summary e+ e- e+ e- -dag /dev/stdout \ - | $(DOT) -Tps >$@ - -epemudbardubar0.eps: - $(builddir_bin)/f90_SM.opt -summary e+ e- u dbar d ubar -full_dag /dev/stdout \ - | $(DOT) -Tps >$@ - -epemudbardubar.eps: - $(builddir_bin)/f90_SM.opt -summary e+ e- u dbar d ubar -dag /dev/stdout \ - | $(DOT) -Tps >$@ - -epemudbarmunumubar0.eps: - $(builddir_bin)/f90_SM.opt -summary e+ e- u dbar mu- numubar -full_dag /dev/stdout \ - | $(DOT) -Tps >$@ - -epemudbarmunumubar.eps: - $(builddir_bin)/f90_SM.opt -summary e+ e- u dbar mu- numubar -dag /dev/stdout \ - | $(DOT) -Tps >$@ - -ATTRIBS = $(srcdir_src)/modules.attrib -modules.eps: $(ATTRIBS) - $(MAKE) $(MFLAGS) -C $(srcdir_src) depend -# $(OCAMLDOT) -fullgraph $(srcdir_src)/.depend \ -# | sed -f $(ATTRIBS) | $(DOT) -Tps >$@ - $(OCAMLDOT) $(srcdir_src)/.depend | sed -f $(ATTRIBS) | $(DOT) -Tps >$@ - -clean: - rm -f *~ *.log *.ilg *.rcs *.mpx *.mp omegapics.* RCS.info - -realclean: clean - rm -f *.dvi *.aux *.toc *.idx $(DERIVED_TEX) *.ps *.pdf *.out - -######################################################################## Index: branches/ohl/omega-development/completed/whizard2/examples/people/tho/sample.prc =================================================================== --- branches/ohl/omega-development/completed/whizard2/examples/people/tho/sample.prc (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/examples/people/tho/sample.prc (revision 8703) @@ -1,8 +0,0 @@ -# $Id: sample.prc,v 1.1 2004/04/09 20:11:16 ohl Exp $ -whizard ffff { - output mnud { process e+ e- mu+ numu ubar d } - output enud { process e+ e- e+ nue ubar d } - output csud { process e+ e- c sbar ubar d } - output uuss { process e+ e- u ubar sbar s } - output udud { process e+ e- u dbar ubar d } -} Index: branches/ohl/omega-development/completed/whizard2/examples/people/tho/sample.mdl =================================================================== --- branches/ohl/omega-development/completed/whizard2/examples/people/tho/sample.mdl (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/examples/people/tho/sample.mdl (revision 8703) @@ -1,38 +0,0 @@ -author { Thorsten Ohl } -version { $Id$ } -created { 2003/07/13 tho } -revised { 2003/07/15 tho } -revised { 2004/04/28 tho } -revised { 2004/04/30 tho } -revised { 2004/05/05 tho } - -particle e- e+ : spin=1/2, fermion, pdg=11, tex="e^-", tex.anti="e^+" -particle nue nuebar : spin=1/2, fermion, pdg=12, tex="\nu_{e}", tex.anti="\bar\nu_{e}" -particle A : spin=1, boson, pdg=22, tex="\gamma" -particle Z : spin=1, boson, pdg=23, tex="Z" -particle W+ W- : spin=1, boson, pdg=24, tex="W^{+}", tex.anti="W^{-}" -particle H : spin=1, boson, pdg=25, tex="\phi" - -coupling e -coupling g -coupling gv -coupling ga -coupling y - -% gauge -vertex e+, A, e- : { e * <1|V.e2|3> } -vertex e+, Z, e- : { gv * <1|V.e2|3> - ga * <1|A.e2|3> } -vertex e+, W-, nue : { g * <1|(V-A).e2|3> } - -% triple gauge -vertex W+, Z, W- : { g * ((k1 - k2).e3*e1.e2 + (k2 - k3).e1*e2.e3 + (k3 - k1).e2*e3.e1) } - -% Yukawa -vertex e+, H, e- : { y*<1|S|3> } -vertex W+, H, W- : { y*e1.e3 } - -% NCQED -vertex e+, A, e- : { e * k2.[mu1]*[mu2].k3*<1|V.e2|3> - - e * k2.[mu1]*[mu2].e2*<1|V.k3|3> - - e * e2.[mu1]*[mu2].k3*<1|V.k2|3> } - Index: branches/ohl/omega-development/completed/whizard2/examples/people/tho/Makefile =================================================================== --- branches/ohl/omega-development/completed/whizard2/examples/people/tho/Makefile (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/examples/people/tho/Makefile (revision 8703) @@ -1,31 +0,0 @@ -# $Id$ -# -# Copyright (C) 1999-2009 by -# -# Wolfgang Kilian -# Thorsten Ohl -# Juergen Reuter -# -# WHIZARD is free software; you can redistribute it and/or modify it -# under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2, or (at your option) -# any later version. -# -# WHIZARD is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -# -######################################################################## - -prefix = /usr/local -srcdir = ./.. - -clean: - rm -f *~ - -realclean: clean Index: branches/ohl/omega-development/completed/whizard2/examples/people/tho/sample.omf =================================================================== --- branches/ohl/omega-development/completed/whizard2/examples/people/tho/sample.omf (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/examples/people/tho/sample.omf (revision 8703) @@ -1,6 +0,0 @@ -% where does the anti-particle fit in here? -% particle (e+, e-) : spin=1/2, fermion, pdg=1, tex="e^+" -particle e+ : spin=1/2, fermion, pdg=1, tex="e^+" -particle g : spin=1, boson, pdg=22 -vertex e+, g, e- : { <1|V|2>.e3 } - Index: branches/ohl/omega-development/completed/whizard2/examples/people/tho/Makefile.in =================================================================== --- branches/ohl/omega-development/completed/whizard2/examples/people/tho/Makefile.in (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/examples/people/tho/Makefile.in (revision 8703) @@ -1,31 +0,0 @@ -# $Id$ -# -# Copyright (C) 1999-2009 by -# -# Wolfgang Kilian -# Thorsten Ohl -# Juergen Reuter -# -# WHIZARD is free software; you can redistribute it and/or modify it -# under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2, or (at your option) -# any later version. -# -# WHIZARD is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -# -######################################################################## - -prefix = @prefix@ -srcdir = @srcdir@/.. - -clean: - rm -f *~ - -realclean: clean Index: branches/ohl/omega-development/completed/whizard2/install-sh =================================================================== --- branches/ohl/omega-development/completed/whizard2/install-sh (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/install-sh (revision 8703) @@ -1,251 +0,0 @@ -#!/bin/sh -# -# install - install a program, script, or datafile -# This comes from X11R5 (mit/util/scripts/install.sh). -# -# Copyright 1991 by the Massachusetts Institute of Technology -# -# Permission to use, copy, modify, distribute, and sell this software and its -# documentation for any purpose is hereby granted without fee, provided that -# the above copyright notice appear in all copies and that both that -# copyright notice and this permission notice appear in supporting -# documentation, and that the name of M.I.T. not be used in advertising or -# publicity pertaining to distribution of the software without specific, -# written prior permission. M.I.T. makes no representations about the -# suitability of this software for any purpose. It is provided "as is" -# without express or implied warranty. -# -# Calling this script install-sh is preferred over install.sh, to prevent -# `make' implicit rules from creating a file called install from it -# when there is no Makefile. -# -# This script is compatible with the BSD install script, but was written -# from scratch. It can only install one file at a time, a restriction -# shared with many OS's install programs. - - -# set DOITPROG to echo to test this script - -# Don't use :- since 4.3BSD and earlier shells don't like it. -doit="${DOITPROG-}" - - -# put in absolute paths if you don't have them in your path; or use env. vars. - -mvprog="${MVPROG-mv}" -cpprog="${CPPROG-cp}" -chmodprog="${CHMODPROG-chmod}" -chownprog="${CHOWNPROG-chown}" -chgrpprog="${CHGRPPROG-chgrp}" -stripprog="${STRIPPROG-strip}" -rmprog="${RMPROG-rm}" -mkdirprog="${MKDIRPROG-mkdir}" - -transformbasename="" -transform_arg="" -instcmd="$mvprog" -chmodcmd="$chmodprog 0755" -chowncmd="" -chgrpcmd="" -stripcmd="" -rmcmd="$rmprog -f" -mvcmd="$mvprog" -src="" -dst="" -dir_arg="" - -while [ x"$1" != x ]; do - case $1 in - -c) instcmd="$cpprog" - shift - continue;; - - -d) dir_arg=true - shift - continue;; - - -m) chmodcmd="$chmodprog $2" - shift - shift - continue;; - - -o) chowncmd="$chownprog $2" - shift - shift - continue;; - - -g) chgrpcmd="$chgrpprog $2" - shift - shift - continue;; - - -s) stripcmd="$stripprog" - shift - continue;; - - -t=*) transformarg=`echo $1 | sed 's/-t=//'` - shift - continue;; - - -b=*) transformbasename=`echo $1 | sed 's/-b=//'` - shift - continue;; - - *) if [ x"$src" = x ] - then - src=$1 - else - # this colon is to work around a 386BSD /bin/sh bug - : - dst=$1 - fi - shift - continue;; - esac -done - -if [ x"$src" = x ] -then - echo "install: no input file specified" - exit 1 -else - true -fi - -if [ x"$dir_arg" != x ]; then - dst=$src - src="" - - if [ -d $dst ]; then - instcmd=: - chmodcmd="" - else - instcmd=mkdir - fi -else - -# Waiting for this to be detected by the "$instcmd $src $dsttmp" command -# might cause directories to be created, which would be especially bad -# if $src (and thus $dsttmp) contains '*'. - - if [ -f $src -o -d $src ] - then - true - else - echo "install: $src does not exist" - exit 1 - fi - - if [ x"$dst" = x ] - then - echo "install: no destination specified" - exit 1 - else - true - fi - -# If destination is a directory, append the input filename; if your system -# does not like double slashes in filenames, you may need to add some logic - - if [ -d $dst ] - then - dst="$dst"/`basename $src` - else - true - fi -fi - -## this sed command emulates the dirname command -dstdir=`echo $dst | sed -e 's,[^/]*$,,;s,/$,,;s,^$,.,'` - -# Make sure that the destination directory exists. -# this part is taken from Noah Friedman's mkinstalldirs script - -# Skip lots of stat calls in the usual case. -if [ ! -d "$dstdir" ]; then -defaultIFS=' -' -IFS="${IFS-${defaultIFS}}" - -oIFS="${IFS}" -# Some sh's can't handle IFS=/ for some reason. -IFS='%' -set - `echo ${dstdir} | sed -e 's@/@%@g' -e 's@^%@/@'` -IFS="${oIFS}" - -pathcomp='' - -while [ $# -ne 0 ] ; do - pathcomp="${pathcomp}${1}" - shift - - if [ ! -d "${pathcomp}" ] ; - then - $mkdirprog "${pathcomp}" - else - true - fi - - pathcomp="${pathcomp}/" -done -fi - -if [ x"$dir_arg" != x ] -then - $doit $instcmd $dst && - - if [ x"$chowncmd" != x ]; then $doit $chowncmd $dst; else true ; fi && - if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dst; else true ; fi && - if [ x"$stripcmd" != x ]; then $doit $stripcmd $dst; else true ; fi && - if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dst; else true ; fi -else - -# If we're going to rename the final executable, determine the name now. - - if [ x"$transformarg" = x ] - then - dstfile=`basename $dst` - else - dstfile=`basename $dst $transformbasename | - sed $transformarg`$transformbasename - fi - -# don't allow the sed command to completely eliminate the filename - - if [ x"$dstfile" = x ] - then - dstfile=`basename $dst` - else - true - fi - -# Make a temp file name in the proper directory. - - dsttmp=$dstdir/#inst.$$# - -# Move or copy the file name to the temp name - - $doit $instcmd $src $dsttmp && - - trap "rm -f ${dsttmp}" 0 && - -# and set any options; do chmod last to preserve setuid bits - -# If any of these fail, we abort the whole thing. If we want to -# ignore errors from any of these, just make sure not to ignore -# errors from the above "$doit $instcmd $src $dsttmp" command. - - if [ x"$chowncmd" != x ]; then $doit $chowncmd $dsttmp; else true;fi && - if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dsttmp; else true;fi && - if [ x"$stripcmd" != x ]; then $doit $stripcmd $dsttmp; else true;fi && - if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dsttmp; else true;fi && - -# Now rename the file to the real destination. - - $doit $rmcmd -f $dstdir/$dstfile && - $doit $mvcmd $dsttmp $dstdir/$dstfile - -fi && - - -exit 0 Index: branches/ohl/omega-development/completed/whizard2/Makefile.in =================================================================== --- branches/ohl/omega-development/completed/whizard2/Makefile.in (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/Makefile.in (revision 8703) @@ -1,313 +0,0 @@ -# $Id$ -# -# Copyright (C) 1999-2009 by -# -# Wolfgang Kilian -# Thorsten Ohl -# Juergen Reuter -# -# WHIZARD is free software; you can redistribute it and/or modify it -# under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2, or (at your option) -# any later version. -# -# WHIZARD is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -# -######################################################################## - -MAJOR = 000 -MINOR = 011 -STATUS = beta - -prefix = @prefix@ -### host = @host@ -srcdir = @srcdir@ -top_srcdir = @top_srcdir@ - -# Architecture independent source directories -srcdir_root = $(top_srcdir) -srcdir_src = $(top_srcdir)/src -srcdir_lib = $(top_srcdir)/lib -srcdir_bin = $(top_srcdir)/bin -srcdir_web = $(top_srcdir)/web -srcdir_doc = $(top_srcdir)/doc -srcdir_tools = $(top_srcdir)/tools -srcdir_tests_sm = $(top_srcdir)/tests/SM -srcdir_tests_mssm = $(top_srcdir)/tests/MSSM -srcdir_tests_little = $(top_srcdir)/tests/little -srcdir_tests_cs = $(top_srcdir)/tests/people/cs -srcdir_tests_jr = $(top_srcdir)/tests/people/jr -srcdir_tests_tho = $(top_srcdir)/tests/people/tho -srcdir_ext_cs = $(top_srcdir)/extensions/people/cs -srcdir_ext_jr = $(top_srcdir)/extensions/people/jr -srcdir_ext_tho = $(top_srcdir)/extensions/people/tho -srcdir_examples_cs = $(top_srcdir)/examples/people/cs -srcdir_examples_jr = $(top_srcdir)/examples/people/jr -srcdir_examples_tho = $(top_srcdir)/examples/people/tho - -# Architecture dependent source and binary directories -builddir_bin = $(top_srcdir)/bin -builddir_lib = $(top_srcdir)/lib -builddir_src = $(top_srcdir)/src - -SELECT_PROGRAMS_CUSTOM = @SELECT_PROGRAMS_CUSTOM@ -SELECT_PROGRAMS_RELEASED = @SELECT_PROGRAMS_RELEASED@ -SELECT_PROGRAMS_UNRELEASED = @SELECT_PROGRAMS_UNRELEASED@ -SELECT_PROGRAMS_THEORETICAL = @SELECT_PROGRAMS_THEORETICAL@ -SELECT_PROGRAMS_REDUNDANT = @SELECT_PROGRAMS_REDUNDANT@ -SELECT_PROGRAMS_DEVELOPERS = @SELECT_PROGRAMS_DEVELOPERS@ -SELECT_PROGRAMS_OBSOLETE = @SELECT_PROGRAMS_OBSOLETE@ -SELECT_PROGRAMS_GUI = @SELECT_PROGRAMS_GUI@ - -SUBDIRS = \ - $(builddir_bin) $(builddir_lib) $(builddir_src) \ - $(srcdir_src) $(srcdir_bin) $(srcdir_lib) \ - $(srcdir_web) $(srcdir_doc) $(srcdir_tools) \ - $(srcdir_tests_sm) $(srcdir_tests_mssm) $(srcdir_tests_little) \ - $(srcdir_tests_cs) $(srcdir_tests_jr) $(srcdir_tests_tho) \ - $(srcdir_ext_cs) $(srcdir_ext_jr) $(srcdir_ext_tho) \ - $(srcdir_examples_cs) $(srcdir_examples_jr) $(srcdir_examples_tho) - -######################################################################## - -include $(srcdir_src)/Makefile.src - -DISTFILES_root = \ - VERSION README INSTALL NEWS ChangeLog COPYING \ - Makefile.in configure configure.in aclocal.m4 \ - config.guess config.sub install-sh - -SOURCEFILES_root = $(DISTFILES_root) dist_tool changes - -DISTFILES_src = \ - Makefile.in Makefile.src .depend .depend_f95 .depend_defun \ - omegalib.nw omega_parameters_mssm.nw omega_parameters_littlest.nw \ - omega_parameters_simplest.nw omega_parameters_xdim.nw \ - omega_parameters_template.nw \ - omega.tex modules.attrib omega_logo.mp omega_logo.xpm \ - $(SOURCE_OCAML_public) $(FC_LIBSRC_public) $(FC_TSTSRC) $(FC_TSTLIBSRC) - -SOURCEFILES_src = \ - $(DISTFILES_src) \ - $(VERTEX_MODULES) $(MODEL_MODULES) \ - omega_parameters_mssm_4.nw \ - $(SOURCE_OCAML_private) $(FC_LIBSRC_private) - -DISTFILES_bin = Makefile.in -SOURCEFILES_bin = $(DISTFILES_bin) - -DISTFILES_lib = Makefile.in -SOURCEFILES_lib = $(DISTFILES_lib) - -DISTFILES_web = omega.ps.gz -SOURCEFILES_web = Makefile.in omegalib.tex modules.eps el_te_ph.eps $(DAGS) - -DISTFILES_doc = preview-title.ps.gz preview.ps.gz -SOURCEFILES_doc = \ - Makefile.in preview.tex custom.hva modules.eps el_te_ph.eps el_te_ph.gif - -DISTFILES_tools = \ - Makefile.in tao_random_numbers.f95 kinematics.f95 rambo.f95 \ - testbed.f95 testbed_old.f95 -SOURCEFILES_tools = $(DISTFILES_tools) - -DISTFILES_tests_sm = \ - Makefile.in dhelas95.f95 \ - main4.f95 main5.f95 main6.f95 main7.f95 main8.f95 \ - mainx.f95 maint.f95 -SOURCEFILES_tests_sm = $(DISTFILES_tests_sm) - -DISTFILES_tests_mssm = \ - Makefile.in main4.f95 -SOURCEFILES_tests_mssm = $(DISTFILES_tests_mssm) - -DISTFILES_tests_cs = -SOURCEFILES_tests_cs = - -DISTFILES_tests_tho = -SOURCEFILES_tests_tho = Makefile.in main.f95 - -DISTFILES_tests_jr = -SOURCEFILES_tests_jr = Makefile.in main4.f95 main6.f95 main8.f95 - -DISTFILES_ext_cs = -SOURCEFILES_ext_cs = - -DISTFILES_ext_jr = -SOURCEFILES_ext_jr = \ - Makefile.in \ - f90_SQED.ml f90_SAGT.ml f90_SAGT_test.f95 f90_WZ.ml \ - main.tex main3.tex main4.tex - -DISTFILES_ext_tho = -SOURCEFILES_ext_tho = Makefile.in f90_O2.ml f90_O2_test.f95 main2.tex - -DISTFILES_examples_cs = -SOURCEFILES_examples_cs = - -DISTFILES_examples_jr = -SOURCEFILES_examples_jr = - -DISTFILES_examples_tho = -SOURCEFILES_examples_tho = Makefile.in sample.prc sample.omf - -DISTFILES = \ - $(addprefix $(srcdir_root)/,$(DISTFILES_root)) \ - $(addprefix $(srcdir_src)/,$(DISTFILES_src)) \ - $(addprefix $(srcdir_lib)/,$(DISTFILES_lib)) \ - $(addprefix $(srcdir_bin)/,$(DISTFILES_bin)) \ - $(addprefix $(srcdir_web)/,$(DISTFILES_web)) \ - $(addprefix $(srcdir_doc)/,$(DISTFILES_doc)) \ - $(addprefix $(srcdir_tools)/,$(DISTFILES_tools)) \ - $(addprefix $(srcdir_tests_sm)/,$(DISTFILES_tests_sm)) \ - $(addprefix $(srcdir_tests_mssm)/,$(DISTFILES_tests_mssm)) \ - $(addprefix $(srcdir_tests_little)/,$(DISTFILES_tests_little)) \ - $(addprefix $(srcdir_tests_cs)/,$(DISTFILES_tests_cs)) \ - $(addprefix $(srcdir_tests_jr)/,$(DISTFILES_tests_jr)) \ - $(addprefix $(srcdir_tests_tho)/,$(DISTFILES_tests_tho)) \ - $(addprefix $(srcdir_ext_cs)/,$(DISTFILES_ext_cs)) \ - $(addprefix $(srcdir_ext_jr)/,$(DISTFILES_ext_jr)) \ - $(addprefix $(srcdir_ext_tho)/,$(DISTFILES_ext_tho)) \ - $(addprefix $(srcdir_examples_cs)/,$(DISTFILES_examples_cs)) \ - $(addprefix $(srcdir_examples_jr)/,$(DISTFILES_examples_jr)) \ - $(addprefix $(srcdir_examples_tho)/,$(DISTFILES_examples_tho)) - -SOURCEFILES = \ - $(addprefix $(srcdir_root)/,$(SOURCEFILES_root)) \ - $(addprefix $(srcdir_src)/,$(SOURCEFILES_src)) \ - $(addprefix $(srcdir_lib)/,$(SOURCEFILES_lib)) \ - $(addprefix $(srcdir_bin)/,$(SOURCEFILES_bin)) \ - $(addprefix $(srcdir_web)/,$(SOURCEFILES_web)) \ - $(addprefix $(srcdir_doc)/,$(SOURCEFILES_doc)) \ - $(addprefix $(srcdir_tools)/,$(SOURCEFILES_tools)) \ - $(addprefix $(srcdir_tests_sm)/,$(SOURCEFILES_tests_sm)) \ - $(addprefix $(srcdir_tests_mssm)/,$(SOURCEFILES_tests_mssm)) \ - $(addprefix $(srcdir_tests_little)/,$(SOURCEFILES_tests_little)) \ - $(addprefix $(srcdir_tests_cs)/,$(SOURCEFILES_tests_cs)) \ - $(addprefix $(srcdir_tests_jr)/,$(SOURCEFILES_tests_jr)) \ - $(addprefix $(srcdir_tests_tho)/,$(SOURCEFILES_tests_tho)) \ - $(addprefix $(srcdir_ext_cs)/,$(SOURCEFILES_ext_cs)) \ - $(addprefix $(srcdir_ext_jr)/,$(SOURCEFILES_ext_jr)) \ - $(addprefix $(srcdir_ext_tho)/,$(SOURCEFILES_ext_tho)) \ - $(addprefix $(srcdir_examples_cs)/,$(SOURCEFILES_examples_cs)) \ - $(addprefix $(srcdir_examples_jr)/,$(SOURCEFILES_examples_jr)) \ - $(addprefix $(srcdir_examples_tho)/,$(SOURCEFILES_examples_tho)) - -######################################################################## - -.PHONY: all world universe ps psv bin opt top gui optgui f77 f95 - -all: - @echo make "[ps|psv|bin|opt|gui|optgui|top|f95]" - -world: bin opt f95 -universe: world ps top gui optgui f77 - -ps psv: - $(MAKE) $(MFLAGS) -C $(srcdir_web) $@ - $(MAKE) $(MFLAGS) -C $(srcdir_doc) $@ - -pdf pdfv: - $(MAKE) $(MFLAGS) -C $(srcdir_web) $@ - -www: - $(MAKE) $(MFLAGS) -C $(srcdir_doc) $@ - -bin opt top gui optgui f77: - $(MAKE) $(MFLAGS) -C $(srcdir_src) $@ - -f95: - $(MAKE) $(MFLAGS) -C $(srcdir_src) $@ - $(MAKE) $(MFLAGS) -C $(srcdir_tools) $@ - -depend depend_f95: - $(MAKE) $(MFLAGS) -C $(srcdir_src) $@ - -######################################################################## - -clean_f95 clean_caml clean_tex clean: - for d in $(SUBDIRS); \ - do test -f $$d/Makefile && $(MAKE) $(MFLAGS) -C $$d $@; true; \ - done - -clean_caml clean: clean_cache - -clean_cache: - find -name 'omega_cache_*' -exec rm -f '{}' ';' - -realclean: clean - for d in $(SUBDIRS); \ - do test -f $$d/Makefile && $(MAKE) $(MFLAGS) -C $$d $@; true; \ - done - rm -fr *~ config.cache config.log config.status autom4te.cache gmon.out - -######################################################################## - -VERSION = $(MAJOR).$(MINOR)$(STATUS) -CVSTAG = OMEGA_$(MAJOR)_$(MINOR)_$(STATUS) -M = - -commit: - @if test -n "$(M)"; then \ - echo "cvs commit -m '$(M)'"; cvs commit -m '$(M)'; \ - echo "cvs tag $(CVSTAG)"; cvs tag $(CVSTAG); \ - echo "cvs tag -b $(CVSTAG)_"; cvs tag -b $(CVSTAG)_; \ - else \ - echo "usage: make commit M=''" 1>&2; \ - fi - -current: - ./dist_tool pack -m $(MAKE) -V current $(SOURCEFILES) - -snap: - ./dist_tool pack -m $(MAKE) -V "`date -u +%Y-%m-%d-%H%M`" $(SOURCEFILES) - -dist: - ./dist_tool pack -m $(MAKE) -V $(VERSION) $(DISTFILES) - -dist_cvs: - ./dist_tool pack_cvs -m $(MAKE) -V $(VERSION) $(DISTFILES) - -######################################################################## - -test_current: - ./dist_tool test -m $(MAKE) -V current -a $(host) -c --enable-developers - -test_dist: - ./dist_tool test -m $(MAKE) -V $(VERSION) -a $(host) - -test_dist_no_noweb: - ./dist_tool test -m $(MAKE) -V $(VERSION) -a $(host) -c --disable-noweb - -test_dist_%: - ./dist_tool $@ -m $(MAKE) -V $(VERSION) -a $(host) - -######################################################################## - -test_dist_big: - ./dist_tool pack -m $(MAKE) -V test-snap $(SOURCEFILES) - ./dist_tool pack -m $(MAKE) -V test-dist $(DISTFILES) - ./dist_tool test_all -m $(MAKE) -V test-snap -a $(host) - ./dist_tool test_all -m $(MAKE) -V test-snap -a $(host) \ - -c "--enable-gui --enable-unsupported" - ./dist_tool test_all -m $(MAKE) -V test-snap -a $(host) \ - -c "--enable-profiling" - ./dist_tool test_all -m $(MAKE) -V test-dist -a $(host) - ./dist_tool test_all -m $(MAKE) -V test-dist -a $(host) \ - -c --disable-noweb - ./dist_tool test_all -m $(MAKE) -V test-dist -a $(host) \ - -c "--enable-gui --enable-unsupported" - ./dist_tool test_all -m $(MAKE) -V test-dist -a $(host) \ - -c "--enable-gui --enable-unsupported --disable-noweb" - -######################################################################## - - - Index: branches/ohl/omega-development/completed/whizard2/VERSION =================================================================== --- branches/ohl/omega-development/completed/whizard2/VERSION (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/VERSION (revision 8703) @@ -1 +0,0 @@ -O'Mega 000.011beta 2006/05/15 Index: branches/ohl/omega-development/completed/whizard2/ChangeLog =================================================================== --- branches/ohl/omega-development/completed/whizard2/ChangeLog (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/ChangeLog (revision 8703) @@ -1,60 +0,0 @@ -2006-05-15 Thorsten Ohl - - * merged Juergen's extensions - - * Version 0.11 - -2005-11-07 Thorsten Ohl - - * merged Juergen's and Wolfgang's color hack for WHiZard - - * EXPERIMENTAL: cache fusion tables (required for colors - a la JR/WK) - - * make Juergen's MSSM official - - * Version 0.10 - -2004-08-93 Thorsten Ohl - - * src/trie.mli, src/trie.ml: make interface compatible with - the O'Caml 3.08 library (remains compatible with older - versions). Implementation of unused functions still - incomplete. - - * Version 0.9 - -2004-06-22 Thorsten Ohl - - * MSSM: sign of W+/W-/A and W+/W-/Z couplings - - * Version 0.8 - -2002-2004 Thorsten Ohl - - * loads of changes - -2001-03-13 Thorsten Ohl - - * O'Caml 3.01: incompatible changes - - * src/trie.mli: add covariance annotation to T.t - This breaks O'Caml 3.00, but is required for O'Caml 3.01. - - * many instances: replace `sig include Module.T end' by - `Module.T', since the bug is fixed in O'Caml 3.01 - -2001-02-28 Thorsten Ohl - - * src/model.mli: - - new field Model.vertices required for model functors, will - retire Model.fuse2, Model.fuse3, Model.fusen soon. - - -$Id: ChangeLog,v 1.4.4.2 2006/05/15 10:01:44 ohl Exp $ -Local Variables: -mode:indented-text -End: - - Index: branches/ohl/omega-development/completed/whizard2/src/f90_Phi3h.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/f90_Phi3h.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/f90_Phi3h.ml (revision 8703) @@ -1,34 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -module O = - Omega.Make(Fusion.Helac(struct let max_arity = 2 end)) - (Targets.Fortran)(Models.Phi3) -let _ = O.main () - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/dAG.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/dAG.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/dAG.ml (revision 8703) @@ -1,481 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -let rcs_file = RCS.parse "DAG" ["Directed Acyclical Graph"] - { RCS.revision = "$Revision$"; - RCS.date = "$Date$"; - RCS.author = "$Author$"; - RCS.source - = "$URL$" } - -module type Ord = - sig - type t - val compare : t -> t -> int - end - -module type Forest = - sig - module Nodes : Ord - type node = Nodes.t - type edge - type children - type t = edge * children - val compare : t -> t -> int - val for_all : (node -> bool) -> t -> bool - val fold : (node -> 'a -> 'a) -> t -> 'a -> 'a - end - -module type T = - sig - type node - type edge - type children - type t - val empty : t - val add_node : node -> t -> t - val add_offspring : node -> edge * children -> t -> t - exception Cycle - val add_offspring_unsafe : node -> edge * children -> t -> t - val is_node : node -> t -> bool - val is_sterile : node -> t -> bool - val is_offspring : node -> edge * children -> t -> bool - val iter_nodes : (node -> unit) -> t -> unit - val map_nodes : (node -> node) -> t -> t - val fold_nodes : (node -> 'a -> 'a) -> t -> 'a -> 'a - val iter : (node -> edge * children -> unit) -> t -> unit - val map : (node -> node) -> - (node -> edge * children -> edge * children) -> t -> t - val fold : (node -> edge * children -> 'a -> 'a) -> t -> 'a -> 'a - val lists : t -> (node * (edge * children) list) list - val harvest : t -> node -> t -> t - val size : t -> int - val eval : (node -> 'a) -> (node -> edge -> 'b -> 'c) -> - ('a -> 'b -> 'b) -> ('c -> 'a -> 'a) -> 'a -> 'b -> node -> t -> 'a - val eval_memoized : (node -> 'a) -> (node -> edge -> 'b -> 'c) -> - ('a -> 'b -> 'b) -> ('c -> 'a -> 'a) -> 'a -> 'b -> node -> t -> 'a - val harvest_list : t -> node list -> t - val count_trees : node -> t -> int - val forest : node -> t -> (node * edge option, node) Tree.t list - val forest_memoized : node -> t -> (node * edge option, node) Tree.t list - val rcs : RCS.t - end - -module type Graded_Ord = - sig - include Ord - module G : Ord - val rank : t -> G.t - end - -module type Grader = functor (O : Ord) -> Graded_Ord with type t = O.t - -module type Graded_Forest = - sig - module Nodes : Graded_Ord - type node = Nodes.t - type edge - type children - type t = edge * children - val compare : t -> t -> int - val for_all : (node -> bool) -> t -> bool - val fold : (node -> 'a -> 'a) -> t -> 'a -> 'a - end - -module type Forest_Grader = functor (G : Grader) -> functor (F : Forest) -> - Graded_Forest with type Nodes.t = F.node - and type node = F.node - and type edge = F.edge - and type children = F.children - and type t = F.t - -(* \thocwmodulesection{The [Forest] Functor} *) - -module Forest (PT : Tuple.Poly) (N : Ord) (E : Ord) : - Forest with module Nodes = N and type edge = E.t - and type node = N.t and type children = N.t PT.t = - struct - module Nodes = N - type edge = E.t - type node = N.t - type children = node PT.t - type t = edge * children - - let compare (e1, n1) (e2, n2) = - let c = PT.compare N.compare n1 n2 in - if c <> 0 then - c - else - E.compare e1 e2 - - let for_all f (_, nodes) = PT.for_all f nodes - let fold f (_, nodes) acc = PT.fold_right f nodes acc - - end - -(* \thocwmodulesection{Gradings} *) - -module Chaotic (O : Ord) = - struct - include O - module G = - struct - type t = unit - let compare _ _ = 0 - end - let rank _ = () - end - -module Discrete (O : Ord) = - struct - include O - module G = O - let rank x = x - end - -module Fake_Grading (O : Ord) = - struct - include O - exception Impossible of string - module G = - struct - type t = unit - let compare _ _ = raise (Impossible "G.compare") - end - let rank _ = raise (Impossible "G.compare") - end - -module Grade_Forest (G : Grader) (F : Forest) = - struct - module Nodes = G(F.Nodes) - type node = Nodes.t - type edge = F.edge - type children = F.children - type t = F.t - let compare = F.compare - let for_all = F.for_all - let fold = F.fold - end - -(* \begin{dubious} - The following can easily be extended to [Map.S] in its full glory, - if we ever need it. - \end{dubious} *) - -module type Graded_Map = - sig - type key - type rank - type 'a t - val empty : 'a t - val add : key -> 'a -> 'a t -> 'a t - val find : key -> 'a t -> 'a - val mem : key -> 'a t -> bool - val iter : (key -> 'a -> unit) -> 'a t -> unit - val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b - val ranks : 'a t -> rank list - val min_max_rank : 'a t -> rank * rank - val ranked : rank -> 'a t -> key list - end - -module type Graded_Map_Maker = functor (O : Graded_Ord) -> - Graded_Map with type key = O.t and type rank = O.G.t - -module Graded_Map (O : Graded_Ord) : - Graded_Map with type key = O.t and type rank = O.G.t = - struct - module M1 = Map.Make(O.G) - module M2 = Map.Make(O) - - type key = O.t - type rank = O.G.t - - type (+'a) t = 'a M2.t M1.t - - let empty = M1.empty - let add key data map1 = - let rank = O.rank key in - let map2 = try M1.find rank map1 with Not_found -> M2.empty in - M1.add rank (M2.add key data map2) map1 - let find key map = M2.find key (M1.find (O.rank key) map) - let mem key map = - M2.mem key (try M1.find (O.rank key) map with Not_found -> M2.empty) - let iter f map1 = M1.iter (fun rank -> M2.iter f) map1 - let fold f map1 acc1 = M1.fold (fun rank -> M2.fold f) map1 acc1 - -(* \begin{dubious} - The set of ranks and its minimum and maximum should be maintained - explicitely! - \end{dubious} *) - module S1 = Set.Make(O.G) - let ranks map = M1.fold (fun key data acc -> key :: acc) map [] - let rank_set map = M1.fold (fun key data -> S1.add key) map S1.empty - let min_max_rank map = - let s = rank_set map in - (S1.min_elt s, S1.max_elt s) - - module S2 = Set.Make(O) - let keys map = M2.fold (fun key data acc -> key :: acc) map [] - let sorted_keys map = - S2.elements (M2.fold (fun key data -> S2.add key) map S2.empty) - let ranked rank map = - keys (try M1.find rank map with Not_found -> M2.empty) - end - -(* \thocwmodulesection{The DAG Functor} *) - -module Maybe_Graded (GMM : Graded_Map_Maker) (F : Graded_Forest) = - struct - let rcs = RCS.rename rcs_file "DAG.Graded()" - ["Graded directed Acyclical Graph "; - "representing binary or n-ary trees"] - - module G = F.Nodes.G - - type node = F.node - type rank = G.t - type edge = F.edge - type children = F.children - -(* If we get tired of graded DAGs, we just have to replace [Graded_Map] by - [Map] here and remove [ranked] below and gain a tiny amount of simplicity - and efficiency. *) - - module Parents = GMM(F.Nodes) - module Offspring = Set.Make(F) - - type t = Offspring.t Parents.t - - let rank = F.Nodes.rank - let ranks = Parents.ranks - let min_max_rank = Parents.min_max_rank - let ranked = Parents.ranked - - let empty = Parents.empty - - let add_node node dag = - if Parents.mem node dag then - dag - else - Parents.add node Offspring.empty dag - - let add_offspring_unsafe node offspring dag = - let offsprings = - try Parents.find node dag with Not_found -> Offspring.empty in - Parents.add node (Offspring.add offspring offsprings) - (F.fold add_node offspring dag) - -(*i - let c = ref 0 - let offspring_add offspring offsprings = - if Offspring.mem offspring offsprings then - (Printf.eprintf "<<<%d>>>\n" !c; incr c); - Offspring.add offspring offsprings - - let add_offspring_unsafe node offspring dag = - let offsprings = - try Parents.find node dag with Not_found -> Offspring.empty in - Parents.add node (offspring_add offspring offsprings) - (F.fold add_node offspring dag) -i*) - - exception Cycle - - let add_offspring node offspring dag = - if F.for_all (fun n -> F.Nodes.compare n node < 0) offspring then - add_offspring_unsafe node offspring dag - else - raise Cycle - - let is_node node dag = - Parents.mem node dag - - let is_sterile node dag = - Offspring.is_empty (Parents.find node dag) - - let is_offspring node offspring dag = - try - Offspring.mem offspring (Parents.find node dag) - with - | Not_found -> false - - let iter_nodes f dag = - Parents.iter (fun n _ -> f n) dag - - let iter f dag = - Parents.iter (fun node -> Offspring.iter (f node)) dag - - let map_nodes f dag = - Parents.fold (fun n -> Parents.add (f n)) dag Parents.empty - - let map fn fo dag = - Parents.fold (fun node offspring -> - Parents.add (fn node) - (Offspring.fold (fun o -> Offspring.add (fo node o)) - offspring Offspring.empty)) dag Parents.empty - - let fold_nodes f dag acc = - Parents.fold (fun n _ -> f n) dag acc - - let fold f dag acc = - Parents.fold (fun node -> Offspring.fold (f node)) dag acc - - let lists dag = - Sort.list (fun (n1, _) (n2, _) -> F.Nodes.compare n1 n2 <= 0) - (Parents.fold (fun node offspring l -> - (node, Offspring.elements offspring) :: l) dag []) - - let size dag = - Parents.fold (fun _ _ n -> succ n) dag 0 - - let rec harvest dag node roots = - Offspring.fold - (fun offspring roots' -> - if is_offspring node offspring roots' then - roots' - else - F.fold (harvest dag) - offspring (add_offspring_unsafe node offspring roots')) - (Parents.find node dag) (add_node node roots) - - let harvest_list dag nodes = - List.fold_left (fun roots node -> harvest dag node roots) empty nodes - -(* Build a closure once, so that we can recurse faster: *) - - let eval f mule muln add null unit node dag = - let rec eval' n = - if is_sterile n dag then - f n - else - Offspring.fold - (fun (e, _ as offspring) v0 -> - add (mule n e (F.fold muln' offspring unit)) v0) - (Parents.find n dag) null - and muln' n = muln (eval' n) in - eval' node - - let count_trees node dag = - eval (fun _ -> 1) (fun _ _ p -> p) ( * ) (+) 0 1 node dag - - let build_forest evaluator node dag = - evaluator (fun n -> [Tree.leaf (n, None) n]) - (fun n e p -> List.map (fun p' -> Tree.node (n, Some e) p') p) - (fun p1 p2 -> Product.fold2 (fun n nl pl -> (n :: nl) :: pl) p1 p2 []) - (@) [] [[]] node dag - - let forest = build_forest eval - -(* At least for [count_trees], the memoizing variant [eval_memoized] is - considerably slower than direct recursive evaluation with [eval]. *) - - let eval_offspring f mule muln add null unit dag values (node, offspring) = - let muln' n = muln (Parents.find n values) in - let v = - if is_sterile node dag then - f node - else - Offspring.fold - (fun (e, _ as offspring) v0 -> - add (mule node e (F.fold muln' offspring unit)) v0) - offspring null - in - (v, Parents.add node v values) - - let eval_memoized' f mule muln add null unit dag = - let result, _ = - List.fold_left - (fun (v, values) -> eval_offspring f mule muln add null unit dag values) - (null, Parents.empty) - (Sort.list (fun (n1, _) (n2, _) -> F.Nodes.compare n1 n2 <= 0) - (Parents.fold - (fun node offspring l -> (node, offspring) :: l) dag [])) in - result - - let eval_memoized f mule muln add null unit node dag = - eval_memoized' f mule muln add null unit - (harvest dag node empty) - - let forest_memoized = build_forest eval_memoized - - end - -module type Graded = - sig - include T - type rank - val rank : node -> rank - val ranks : t -> rank list - val min_max_rank : t -> rank * rank - val ranked : rank -> t -> node list - end - -module Graded (F : Graded_Forest) = Maybe_Graded(Graded_Map)(F) - -(* The following is not a graded map, obviously. But it can pass as one by the - typechecker for constructing non-graded DAGs. *) - -module Fake_Graded_Map (O : Graded_Ord) : - Graded_Map with type key = O.t and type rank = O.G.t = - struct - module M = Map.Make(O) - type key = O.t - type (+'a) t = 'a M.t - let empty = M.empty - let add = M.add - let find = M.find - let mem = M.mem - let iter = M.iter - let fold = M.fold - -(* We make sure that the remaining three are never called inside [DAG] and - are not visible outside. *) - type rank = O.G.t - exception Impossible of string - let ranks _ = raise (Impossible "ranks") - let min_max_rank _ = raise (Impossible "min_max_rank") - let ranked _ _ = raise (Impossible "ranked") - end - -(* We could also have used signature projection with a chaotic or discrete - grading, but the [Graded_Map] can cost some efficiency. This is probably - not the case for the current simple implementation, but future embellishment - can change this. Therefore, the ungraded DAG uses [Map] directly, - without overhead. *) - -module Make (F : Forest) = - Maybe_Graded(Fake_Graded_Map)(Grade_Forest(Fake_Grading)(F)) - -(* \begin{dubious} - If O'Caml had \textit{polymorphic recursion}, we could think - of even more elegant implementations unifying nodes and offspring - (cf.~the generalized tries in~\cite{Okasaki:1998:book}). - \end{dubious} *) - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) - Index: branches/ohl/omega-development/completed/whizard2/src/f90_SM_clones.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/f90_SM_clones.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/f90_SM_clones.ml (revision 8703) @@ -1,33 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -module O = Omega.Make(Fusion.Mixed23)(Targets.Fortran)(Models.SM_clones) - -let _ = O.main () - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/fusion.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/fusion.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/fusion.ml (revision 8703) @@ -1,1523 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -let rcs_file = RCS.parse "Fusion" ["General Fusions"] - { RCS.revision = "$Revision$"; - RCS.date = "$Date$"; - RCS.author = "$Author$"; - RCS.source - = "$URL$" } - -module type T = - sig - type wf - type flavor - val flavor : wf -> flavor - type p - val momentum : wf -> p - val momentum_list : wf -> int list - val wf_tag : wf -> string option - type constant - type rhs - type 'a children - val sign : rhs -> int - val coupling : rhs -> constant Coupling.t - val coupling_tag : rhs -> string option - val children : rhs -> wf list - type fusion - val lhs : fusion -> wf - val rhs : fusion -> rhs list - type braket - val bra : braket -> wf - val ket : braket -> rhs list - type amplitude - type selectors - val amplitude : bool -> selectors -> flavor list -> flavor list -> amplitude - val incoming : amplitude -> flavor list - val outgoing : amplitude -> flavor list - val externals : amplitude -> wf list - val variables : amplitude -> wf list - val fusions : amplitude -> fusion list - val brakets : amplitude -> braket list - val on_shell : amplitude -> (wf -> bool) - val is_gauss : amplitude -> (wf -> bool) - val constraints : amplitude -> string option - val symmetry : amplitude -> int - val allowed : amplitude -> bool - val count_fusions : amplitude -> int - val count_propagators : amplitude -> int - val count_diagrams : amplitude -> int - type coupling - val forest : wf -> amplitude -> ((wf * coupling option, wf) Tree.t) list - val poles : amplitude -> wf list list - val s_channel : amplitude -> wf list - val tower_to_dot : out_channel -> amplitude -> unit - val amplitude_to_dot : out_channel -> amplitude -> unit - val rcs_list : RCS.t list - end - -module type Maker = - functor (P : Momentum.T) -> functor (M : Model.T) -> - T with type p = P.t and type flavor = M.flavor - and type constant = M.constant - and type selectors = Cascade.Make(M)(P).selectors - -(* \thocwmodulesection{Fermi Statistics} *) - -module type Stat = - sig - type flavor - type stat - exception Impossible - val stat : flavor -> int -> stat - val stat_fuse : stat -> stat -> flavor -> stat - val stat_sign : stat -> int - val rcs : RCS.t - end - -module type Stat_Maker = functor (M : Model.T) -> - Stat with type flavor = M.flavor - -(* \thocwmodulesection{Dirac Fermions} *) - -module Stat_Dirac (M : Model.T) : (Stat with type flavor = M.flavor) = - struct - let rcs = RCS.rename rcs_file "Fusion.Stat_Dirac()" - [ "Fermi statistics for Dirac fermions"] - - type flavor = M.flavor - -(* \begin{equation} - \gamma_\mu\psi(1)\,G^{\mu\nu}\,\bar\psi(2)\gamma_\nu\psi(3) - - \gamma_\mu\psi(3)\,G^{\mu\nu}\,\bar\psi(2)\gamma_\nu\psi(1) - \end{equation} *) - - type stat = - | Fermion of int * (int option * int option) list - | AntiFermion of int * (int option * int option) list - | Boson of (int option * int option) list - - let stat f p = - let s = M.fermion f in - if s = 0 then - Boson [] - else if s < 0 then - AntiFermion (p, []) - else (* [if s > 0 then] *) - Fermion (p, []) - - exception Impossible - - let stat_fuse s1 s2 f = - match s1, s2 with - | Boson l1, Boson l2 -> Boson (l1 @ l2) - | Boson l1, Fermion (p, l2) -> Fermion (p, l1 @ l2) - | Boson l1, AntiFermion (p, l2) -> AntiFermion (p, l1 @ l2) - | Fermion (p, l1), Boson l2 -> Fermion (p, l1 @ l2) - | AntiFermion (p, l1), Boson l2 -> AntiFermion (p, l1 @ l2) - | AntiFermion (pbar, l1), Fermion (p, l2) -> - Boson ((Some pbar, Some p) :: l1 @ l2) - | Fermion (p, l1), AntiFermion (pbar, l2) -> - Boson ((Some pbar, Some p) :: l1 @ l2) - | Fermion _, Fermion _ | AntiFermion _, AntiFermion _ -> - raise Impossible - -(* \begin{figure} - \begin{displaymath} - \parbox{26\unitlength}{% - \begin{fmfgraph*}(25,15) - \fmfstraight - \fmfleft{f} - \fmfright{f1,f2,f3} - \fmflabel{$\psi(1)$}{f1} - \fmflabel{$\bar\psi(2)$}{f2} - \fmflabel{$\psi(3)$}{f3} - \fmflabel{$0$}{f} - \fmf{fermion}{f1,v1,f} - \fmffreeze - \fmf{fermion,tension=0.5}{f3,v2,f2} - \fmf{photon}{v1,v2} - \fmfdot{v1,v2} - \end{fmfgraph*}} - \qquad\qquad-\qquad - \parbox{26\unitlength}{% - \begin{fmfgraph*}(25,15) - \fmfstraight - \fmfleft{f} - \fmfright{f1,f2,f3} - \fmflabel{$\psi(1)$}{f1} - \fmflabel{$\bar\psi(2)$}{f2} - \fmflabel{$\psi(3)$}{f3} - \fmflabel{$0$}{f} - \fmf{fermion}{f3,v1,f} - \fmffreeze - \fmf{fermion,tension=0.5}{f1,v2,f2} - \fmf{photon}{v1,v2} - \fmfdot{v1,v2} - \end{fmfgraph*}} - \end{displaymath} - \caption{\label{fig:stat_fuse} Relative sign from Fermi statistics.} - \end{figure} *) - -(* \begin{equation} - \epsilon \left(\left\{ (0,1), (2,3) \right\}\right) - = - \epsilon \left(\left\{ (0,3), (2,1) \right\}\right) - \end{equation} *) - - let permutation lines = - let fout, fin = List.split lines in - let eps_in, _ = Combinatorics.sort_signed compare fin - and eps_out, _ = Combinatorics.sort_signed compare fout in - (eps_in * eps_out) - -(* \begin{dubious} - This comparing of permutations of fermion lines is a bit tedious - and takes a macroscopic fraction of time. However, it's less than - 20\,\%, so we don't focus on improving on it yet. - \end{dubious} *) - - let stat_sign = function - | Boson lines -> permutation lines - | Fermion (p, lines) -> permutation ((None, Some p) :: lines) - | AntiFermion (pbar, lines) -> permutation ((Some pbar, None) :: lines) - - end - -(* \thocwmodulesection{Tags} *) - -module type Tags = - sig - type wf - type coupling - type 'a children - val null_wf : wf - val null_coupling : coupling - val fuse : coupling -> wf children -> wf - val wf_to_string : wf -> string option - val coupling_to_string : coupling -> string option - end - -module type Tagger = - functor (PT : Tuple.Poly) -> Tags with type 'a children = 'a PT.t - -module type Tagged_Maker = - functor (Tagger : Tagger) -> - functor (P : Momentum.T) -> functor (M : Model.T) -> - T with type p = P.t and type flavor = M.flavor - and type constant = M.constant - -(* No tags is one option for good tags \ldots *) - -module No_Tags (PT : Tuple.Poly) = - struct - type wf = unit - type coupling = unit - type 'a children = 'a PT.t - let null_wf = () - let null_coupling = () - let fuse () _ = () - let wf_to_string () = None - let coupling_to_string () = None - end - -(* \begin{dubious} - Here's a simple additive tag that can grow into something useful - for loop calculations. - \end{dubious} *) - -module Loop_Tags (PT : Tuple.Poly) = - struct - type wf = int - type coupling = int - type 'a children = 'a PT.t - let null_wf = 0 - let null_coupling = 0 - let fuse c wfs = PT.fold_left (+) c wfs - let wf_to_string n = Some (string_of_int n) - let coupling_to_string n = Some (string_of_int n) - end - -(* \thocwmodulesection{The [Fusion.Make] Functor} *) - -module Tagged (Tagger : Tagger) (PT : Tuple.Poly) - (Stat : Stat_Maker) (T : Topology.T with type 'a children = 'a PT.t) - (P : Momentum.T) (M : Model.T) = - struct - let rcs = RCS.rename rcs_file "Fusion.Make()" - [ "Fusions for arbitrary topologies" ] - - open Coupling - - module S = Stat(M) - - type stat = S.stat - let stat = S.stat - let stat_sign = S.stat_sign - -(* \begin{dubious} - This will do \emph{something} for 4-, 6-, \ldots fermion vertices, - but not necessarily the right thing \ldots - \end{dubious} *) - - let stat_fuse s f = - PT.fold_right_internal (fun s' acc -> S.stat_fuse s' acc f) s - - type flavor = M.flavor - type constant = M.constant - -(* \thocwmodulesubsection{Wave Functions} *) - -(* \begin{dubious} - The code below is not yet functional. Too often, we assign to - [Tags.null_wf] instead of calling [Tags.fuse]. - \end{dubious} *) - - module Tags = Tagger(PT) - - type p = P.t - type wf = - { flavor : flavor; - momentum : p; - wf_tag : Tags.wf } - - let flavor wf = wf.flavor - let flavor_sans_color wf = M.flavor_sans_color wf.flavor - let momentum wf = wf.momentum - let momentum_list wf = P.to_ints wf.momentum - let wf_tag_raw wf = wf.wf_tag - let wf_tag wf = Tags.wf_to_string (wf_tag_raw wf) - -(* Operator insertions can be fused only if they are external. *) - let is_source wf = - match M.propagator wf.flavor with - | Only_Insertion -> P.rank wf.momentum = 1 - | _ -> true - -(* [is_goldstone_of g v] is [true] if and only if [g] is the Goldstone boson - corresponding to the gauge particle [v]. *) - let is_goldstone_of g v = - match M.goldstone v with - | None -> false - | Some (g', _) -> g = g' - -(* In the future, we might want to have [Coupling] among the functor - arguments. However, for the moment, [Coupling] is assumed to be - comprehensive. *) - - type sign = int - type coupling = - { sign : sign; - coupling : constant Coupling.t; - coupling_tag : Tags.coupling } - - type 'a children = 'a PT.t - -(* This \emph{must} be a pair matching the [edge * node children] pairs of - [DAG.Forest]! *) - type rhs = coupling * wf children - - let sign ({ sign = s }, _) = s - let coupling ({ coupling = c }, _) = c - let coupling_tag_raw ({ coupling_tag = t }, _) = t - let coupling_tag rhs = Tags.coupling_to_string (coupling_tag_raw rhs) - let children (_, wfs) = PT.to_list wfs - -(* \begin{dubious} - In the end, [PT.to_list] should become redudant! - \end{dubious} *) - let fuse_rhs rhs = M.fuse (PT.to_list rhs) - -(* \thocwmodulesubsection{Vertices} *) - -(* Compute the set of all vertices in the model from the allowed - fusions and the set of all flavors: - \begin{dubious} - One could think of using [M.vertices] instead of [M.fuse2], - [M.fuse3] and [M.fuse] \ldots - \end{dubious} *) - - module VSet = Map.Make(struct type t = flavor let compare = compare end) - - let add_vertices f rhs m = - VSet.add f (try rhs :: VSet.find f m with Not_found -> [rhs]) m - - let collect_vertices rhs = - List.fold_right (fun (f1, c) -> add_vertices (M.conjugate f1) (c, rhs)) - (fuse_rhs rhs) - -(* The set of all vertices with common left fields factored. *) - -(* I used to think that constant initializers are a good idea to allow - compile time optimizations. The down side turned out to be that the - constant initializers will be evaluated \emph{every time} the functor - is applied. \emph{Relying on the fact that the functor will be - called only once is not a good idea!} *) - - let vertices max_degree flavors : - (flavor * (constant Coupling.t * flavor PT.t) list) list = - VSet.fold (fun f rhs v -> (f, rhs) :: v) - (PT.power_fold collect_vertices flavors VSet.empty) [] - -(* Performance hack: *) - - let vertices_cache = ref None - let hash = Cache.md5_hash (M.vertices ()) - - let vertices max_degree flavors : - (flavor * (constant Coupling.t * flavor PT.t) list) list = - match !vertices_cache with - | None -> - begin match Cache.maybe_read hash with - | None -> - let result = vertices max_degree flavors in - Cache.write hash result; - vertices_cache := Some result; - result - | Some result -> result - end - | Some result -> result - -(* \thocwmodulesubsection{Partitions} *) - -(* Vertices that are not crossing invariant need special treatment so - that they're only generated for the correct combinations of momenta. *) - -(* \begin{dubious} - Using [PT.Mismatched_arity] is not really good style \ldots - - Tho's approach doesn't work since he does not catch charge conjugated processes or - crossed processes. Another very strange thing is that O'Mega seems always to run in the - q2 q3 timelike case, but not in the other two. (Property of how the DAG is built?). - For the $ZZZZ$ vertex I add the same vertex again, but interchange 1 and 3 in the - [crossing] vertex - - \end{dubious} *) - - let crossing c momenta = - match c with - | V4 (Vector4_K_Matrix_tho (disc,_), fusion, _) - | V4 (Vector4_K_Matrix_jr (disc,_), fusion, _) -> - let s12, s23, s13 = - begin match PT.to_list momenta with - | [q1; q2; q3] -> (P.timelike (P.add q1 q2), - P.timelike (P.add q2 q3), - P.timelike (P.add q1 q3)) - | _ -> raise PT.Mismatched_arity - end in - begin match disc, s12, s23, s13, fusion with - | 0, true, false, false, (F341|F431|F342|F432|F123|F213|F124|F214) - | 0, false, true, false, (F134|F143|F234|F243|F312|F321|F412|F421) - | 0, false, false, true, (F314|F413|F324|F423|F132|F231|F142|F241) -> - true - | 1, true, false, false, (F341|F431|F342|F432) - | 1, false, true, false, (F134|F143|F234|F243) - | 1, false, false, true, (F314|F413|F324|F423) -> - true - | 2, true, false, false, (F123|F213|F124|F214) - | 2, false, true, false, (F312|F321|F412|F421) - | 2, false, false, true, (F132|F231|F142|F241) -> - true - | 3, true, false, false, (F143|F413|F142|F412|F321|F231|F324|F234) - | 3, false, true, false, (F314|F341|F214|F241|F132|F123|F432|F423) - | 3, false, false, true, (F134|F431|F124|F421|F312|F213|F342|F243) -> - true - | _ -> false - end - | _ -> true - -(* Match a set of flavors to a set of momenta. Form the direct product for - the lists of momenta two and three with the list of couplings and flavors - two and three. *) - - let flavor_keystone select_p dim (f1, f23) (p1, p23) = - ({ flavor = f1; - momentum = P.of_ints dim p1; - wf_tag = Tags.null_wf }, - Product.fold2 (fun (c, f) p acc -> - try - if select_p - (P.of_ints dim p1) - (PT.to_list (PT.map (P.of_ints dim) p)) then begin - if crossing c (PT.map (P.of_ints dim) p) then - (c, PT.map2 (fun f' p' -> { flavor = f'; - momentum = P.of_ints dim p'; - wf_tag = Tags.null_wf }) f p) :: acc - else - acc - end else - acc - with - | PT.Mismatched_arity -> acc) f23 p23 []) - -(*i - let cnt = ref 0 - - let gc_stat () = - let minor, promoted, major = Gc.counters () in - Printf.sprintf "(%12.0f, %12.0f, %12.0f)" minor promoted major - - let flavor_keystone select_p n (f1, f23) (p1, p23) = - incr cnt; - Gc.set { (Gc.get()) with Gc.space_overhead = 20 }; - Printf.eprintf "%6d@%8.1f: %s\n" !cnt (Sys.time ()) (gc_stat ()); - flush stderr; - flavor_keystone select_p n (f1, f23) (p1, p23) -i*) - -(* Produce all possible combinations of vertices (flavor keystones) - and momenta by forming the direct product. The semantically equivalent - [Product.list2 (flavor_keystone select_wf n) vertices keystones] with - \emph{subsequent} filtering would be a \emph{very bad} idea, because - a potentially huge intermediate list is built for large models. - E.\,g.~for the MSSM this would lead to non-termination by thrashing - for $2\to4$ processes on most PCs. *) - - let flavor_keystones filter select_p dim vertices keystones = - Product.fold2 (fun v k acc -> - filter (flavor_keystone select_p dim v k) acc) vertices keystones [] - -(* Flatten the nested lists of vertices into a list of attached lines. *) - - let flatten_keystones t = - ThoList.flatmap (fun (p1, p23) -> - p1 :: (ThoList.flatmap (fun (_, rhs) -> PT.to_list rhs) p23)) t - -(* Once more, but without duplicates this time. *) - -(* Order wavefunctions so that the external come first, then the pairs, etc. - Also put possible Goldstone bosons \emph{before} their gauge bosons. *) - - let lorentz_ordering f = - match M.lorentz f with - | Coupling.Scalar -> 0 - | Coupling.Spinor -> 1 - | Coupling.ConjSpinor -> 2 - | Coupling.Majorana -> 3 - | Coupling.Vector -> 4 - | Coupling.Massive_Vector -> 5 - | Coupling.Tensor_2 -> 6 - | Coupling.Tensor_1 -> 7 - | Coupling.Vectorspinor -> 8 - | Coupling.BRS Coupling.Scalar -> 9 - | Coupling.BRS Coupling.Spinor -> 10 - | Coupling.BRS Coupling.ConjSpinor -> 11 - | Coupling.BRS Coupling.Majorana -> 12 - | Coupling.BRS Coupling.Vector -> 13 - | Coupling.BRS Coupling.Massive_Vector -> 14 - | Coupling.BRS Coupling.Tensor_2 -> 15 - | Coupling.BRS Coupling.Tensor_1 -> 16 - | Coupling.BRS Coupling.Vectorspinor -> 17 - | Coupling.BRS _ -> invalid_arg "Fusion.lorentz_ordering: not needed" - | Coupling.Maj_Ghost -> 18 - - let order_flavor f1 f2 = - let c = compare (lorentz_ordering f1) (lorentz_ordering f2) in - if c <> 0 then - c - else - compare f1 f2 - - let order_wf wf1 wf2 = - let c = P.compare wf1.momentum wf2.momentum in - if c <> 0 then - c - else - let c = order_flavor wf1.flavor wf2.flavor in - if c <> 0 then - c - else - compare wf1.wf_tag wf2.wf_tag - - let wavefunctions t = - let module WF = - Set.Make (struct type t = wf let compare = order_wf end) in - WF.elements (List.fold_left (fun set (wf1, wf23) -> - WF.add wf1 (List.fold_left (fun set' (_, wfs) -> - PT.fold_right WF.add wfs set') set wf23)) WF.empty t) - -(* \thocwmodulesubsection{Subtrees} *) - -(* Fuse a tuple of wavefunctions, keeping track of Fermi statistics. - Record only the the sign \emph{relative} to the children. - (The type annotation is only for documentation.) *) - - let fuse select_wf wfss : (wf * stat * rhs) list = - if PT.for_all (fun (wf, _) -> is_source wf) wfss then - try - let wfs, ss = PT.split wfss in - let flavors = PT.map flavor wfs - and momenta = PT.map momentum wfs - (*i and wf_tags = PT.map wf_tag_raw wfs i*) in - let p = PT.fold_left_internal P.add momenta in - List.fold_left - (fun acc (f, c) -> - if select_wf (M.flavor_sans_color f) p (PT.to_list momenta) - && crossing c momenta then - let s = stat_fuse ss f in - let flip = - PT.fold_left (fun acc s' -> acc * stat_sign s') (stat_sign s) ss in - ({ flavor = f; - momentum = p; - wf_tag = Tags.null_wf }, s, - ({ sign = flip; - coupling = c; - coupling_tag = Tags.null_coupling }, wfs)) :: acc - else - acc) - [] (fuse_rhs flavors) - with - | P.Duplicate _ | S.Impossible -> [] - else - [] - - module D = DAG.Make - (DAG.Forest(PT) - (struct type t = wf let compare = order_wf end) - (struct type t = coupling let compare = compare end)) - -(* \begin{dubious} - Eventually, the pairs of [tower] and [dag] in [fusion_tower'] - below could and should be replaced by a graded [DAG]. This will - look like, but currently [tower] containts statistics information - that is missing from [dag]: - \begin{quote} - \verb+Type node = flavor * p is not compatible with type wf * stat+ - \end{quote} - This should be easy to fix. However, replacing [type t = wf] - with [type t = wf * stat] is \emph{not} a good idea because the variable - [stat] makes it impossible to test for the existance of a particular - [wf] in a [DAG]. - \end{dubious} - \begin{dubious} - In summary, it seems that [(wf * stat) list array * D.t] should be - replaced by [(wf -> stat) * D.t]. - \end{dubious} *) - module GF = - struct - module Nodes = - struct - type t = wf - module G = struct type t = int let compare = compare end - let compare = order_wf - let rank wf = P.rank (momentum wf) - end - module Edges = struct type t = coupling let compare = compare end - module F = DAG.Forest(PT)(Nodes)(Edges) - type node = Nodes.t - type edge = F.edge - type children = F.children - type t = F.t - let compare = F.compare - let for_all = F.for_all - let fold = F.fold - end - - module D' = DAG.Graded(GF) - - let tower_of_dag dag = - let _, max_rank = D'.min_max_rank dag in - Array.init max_rank (fun n -> D'.ranked n dag) - - module Stat = Map.Make (struct type t = wf let compare = order_wf end) - -(* The function [fusion_tower'] - recursively builds the tower of all fusions from bottom up to a chosen - level. The argument [tower] is an array of lists, where the $i$-th sublist - (counting from 0) represents all off shell wave functions depending on - $i+1$~momenta and their Fermistatistics. - \begin{equation} - \begin{aligned} - \Bigl\lbrack - & \{ \phi_1(p_1), \phi_2(p_2), \phi_3(p_3), \ldots \}, \\ - & \{ \phi_{12}(p_1+p_2), \phi'_{12}(p_1+p_2), \ldots, - \phi_{13}(p_1+p_3), \ldots, \phi_{23}(p_2+p_3), \ldots \}, \\ - & \ldots \\ - & \{ \phi_{1\cdots n}(p_1+\cdots+p_n), - \phi'_{1\cdots n}(p_1+\cdots+p_n), \ldots \} \Bigr\rbrack - \end{aligned} - \end{equation} - The argument [dag] is a DAG representing all the fusions calculated so far. - NB: The outer array in [tower] is always very short, so we could also - have accessed a list with [List.nth]. Appending of new members at the - end brings no loss of performance. NB: the array is supposed to be - immutable. *) - -(* The towers must be sorted so that the combinatorical functions can - make consistent selections. - \begin{dubious} - Intuitively, this seems to be correct. However, one could have - expected that no element appears twice and that this ordering is - not necessary \ldots - \end{dubious} *) - let grow select_wf tower = - let rank = succ (Array.length tower) in - List.sort Pervasives.compare - (PT.graded_sym_power_fold rank - (fun wfs acc -> fuse select_wf wfs @ acc) tower []) - - let add_offspring dag (wf, _, rhs) = - D.add_offspring wf rhs dag - - let filter_offspring fusions = - List.map (fun (wf, s, _) -> (wf, s)) fusions - - let rec fusion_tower' n_max select_wf tower dag : (wf * stat) list array * D.t = - if Array.length tower >= n_max then - (tower, dag) - else - let tower' = grow select_wf tower in - fusion_tower' n_max select_wf - (Array.append tower [|filter_offspring tower'|]) - (List.fold_left add_offspring dag tower') - -(* Discard the tower and return a map from wave functions to Fermistatistics - together with the DAG. *) - - let make_external_dag wfs = - List.fold_left (fun m (wf, _) -> D.add_node wf m) D.empty wfs - - let mixed_fold_left f acc lists = - Array.fold_left (List.fold_left f) acc lists - - let fusion_tower height select_wf wfs : (wf -> stat) * D.t = - let tower, dag = - fusion_tower' height select_wf [|wfs|] (make_external_dag wfs) in - let stats = mixed_fold_left - (fun m (wf, s) -> Stat.add wf s m) Stat.empty tower in - ((fun wf -> Stat.find wf stats), dag) - -(* Calculate the minimal tower of fusions that suffices for calculating - the amplitude. *) - - let minimal_fusion_tower n select_wf wfs : (wf -> stat) * D.t = - fusion_tower (T.max_subtree n) select_wf wfs - -(* Calculate the complete tower of fusions. It is much larger than required, - but it allows a complete set of gauge checks. *) - let complete_fusion_tower select_wf wfs : (wf -> stat) * D.t = - fusion_tower (List.length wfs - 1) select_wf wfs - -(* \begin{dubious} - There is a natural product of two DAGs using [fuse]. Can this be - used in a replacement for [fusion_tower]? The hard part is to avoid - double counting, of course. A straight forward solution - could do a diagonal sum (in order to reject flipped offspring representing - the same fusion) and rely on the uniqueness in [DAG] otherwise. - However, this will (probably) slow down the procedure significanty, - because most fusions (including Fermi signs!) will be calculated before - being rejected by [DAD().add_offspring]. - \end{dubious} *) - -(* Add to [dag] all Goldstone bosons defined in [tower] that correspond - to gauge bosons in [dag]. This is only required for checking - Slavnov-Taylor identities in unitarity gauge. Currently, it is not used, - because we use the complete tower for gauge checking. *) - let harvest_goldstones tower dag = - D.fold_nodes (fun wf dag' -> - match M.goldstone wf.flavor with - | Some (g, _) -> - let wf' = { wf with flavor = g } in - if D.is_node wf' tower then begin - D.harvest tower wf' dag' - end else begin - dag' - end - | None -> dag') dag dag - -(* Calculate the sign from Fermi statistics that is not already included - in the children. - \begin{dubious} - The use of [PT.of2_kludge] is the largest skeleton on the cupboard of - unified fusions. Currently, it is just another name for [PT.of2], - but the existence of the latter requires binary fusions. Of course, this - is just a symptom for not fully supporting four fermion vertices \ldots - \end{dubious} *) - let stat_keystone stats wf1 wfs = - let wf1' = stats wf1 - and wfs' = PT.map stats wfs in - stat_sign - (stat_fuse - (PT.of2_kludge wf1' (stat_fuse wfs' (M.conjugate (flavor wf1)))) - (flavor wf1)) - * PT.fold_left (fun acc wf -> acc * stat_sign wf) (stat_sign wf1') wfs' - -(* Test all members of a list of wave functions are defined by the DAG - simultaneously: *) - let test_rhs dag (_, wfs) = - PT.for_all (fun wf -> is_source wf && D.is_node wf dag) wfs - -(* Add the keystone [(wf1,pairs)] to [acc] only if it is present in [dag] - and calculate the statistical factor depending on [stats] - \emph{en passant}: *) - let filter_keystone stats dag (wf1, pairs) acc = - if is_source wf1 && D.is_node wf1 dag then - match List.filter (test_rhs dag) pairs with - | [] -> acc - | pairs' -> (wf1, List.map (fun (c, wfs) -> - ({ sign = stat_keystone stats wf1 wfs; - coupling = c; - coupling_tag = Tags.null_coupling }, - wfs)) pairs') :: acc - else - acc - -(* \begin{figure} - \begin{center} - \thocwincludegraphics{width=\textwidth}{bhabha0}\\ - \hfil\\ - \thocwincludegraphics{width=\textwidth}{bhabha} - \end{center} - \caption{\label{fig:bhabha} - The DAGs for Bhabha scattering before and after weeding out unused - nodes. The blatant asymmetry of these DAGs is caused by our - prescription for removing doubling counting for an even number - of external lines.} - \end{figure} - \begin{figure} - \begin{center} - \thocwincludegraphics{width=\textwidth}{epemudbarmunumubar0}\\ - \hfil\\ - \thocwincludegraphics{width=\textwidth}{epemudbarmunumubar} - \end{center} - \caption{\label{fig:epemudbarmunumubar} - The DAGs for $e^+e^-\to u\bar d \mu^-\bar\nu_\mu$ before and after - weeding out unused nodes.} - \end{figure} - \begin{figure} - \begin{center} - \thocwincludegraphics{width=\textwidth}{epemudbardubar0}\\ - \hfil\\ - \thocwincludegraphics{width=\textwidth}{epemudbardubar} - \end{center} - \caption{\label{fig:epemudbardubar} - The DAGs for $e^+e^-\to u\bar d d\bar u$ before and after weeding - out unused nodes.} - \end{figure} *) - -(* \thocwmodulesubsection{Amplitudes} *) - - type fusion = wf * rhs list - - let lhs (l, _) = l - let rhs (_, r) = r - - type braket = wf * rhs list - - let bra (b, _) = b - let ket (_, k) = k - - type amplitude = - { fusions : fusion list; - brakets : braket list; - on_shell : wf -> bool; - is_gauss : wf -> bool; - constraints : string option; - incoming : flavor list; - outgoing : flavor list; - externals : wf list; - symmetry : int; - fusion_tower : D.t; - fusion_dag : D.t } - - module C = Cascade.Make(M)(P) - type selectors = C.selectors - - let incoming a = a.incoming - let outgoing a = a.outgoing - let externals a = a.externals - let fusions a = a.fusions - let brakets a = a.brakets - let symmetry a = a.symmetry - let on_shell a = a.on_shell - let is_gauss a = a.is_gauss - let constraints a = a.constraints - let variables a = List.map fst a.fusions - - let allowed amplitude = - match brakets amplitude with - | [] -> false - | _ -> true - - let external_wfs n particles = - List.map (fun (f, p) -> - ({ flavor = f; - momentum = P.singleton n p; - wf_tag = Tags.null_wf }, - stat f p)) particles - -(* \thocwmodulesubsection{Main Function} *) - -(* [map_amplitude_wfs f a] applies the function [f : wf -> wf] to all - wavefunctions appearing in the amplitude [a]. *) - let map_amplitude_wfs f a = - let map_rhs (c, wfs) = (c, PT.map f wfs) in - let map_braket (wf, rhs) = (f wf, List.map map_rhs rhs) - and map_fusion (lhs, rhs) = (f lhs, List.map map_rhs rhs) in - let map_brakets = List.map map_braket - and map_fusions = List.map map_fusion - and map_dag = D.map f (fun node rhs -> map_rhs rhs) in - { fusions = map_fusions a.fusions; - brakets = map_brakets a.brakets; - on_shell = a.on_shell; - is_gauss = a.is_gauss; - constraints = a.constraints; - incoming = a.incoming; - outgoing = a.outgoing; - externals = List.map f a.externals; - symmetry = a.symmetry; - fusion_tower = map_dag a.fusion_tower; - fusion_dag = map_dag a.fusion_dag } - -(*i -(* \begin{dubious} - Just a silly little test: - \end{dubious} *) - - let hack_amplitude = - map_amplitude_wfs (fun wf -> { wf with momentum = P.split 2 16 wf.momentum }) -i*) - -(* This is the main function that constructs the amplitude for sets - of incoming and outgoing particles and returns the results in - conveniently packaged pieces. *) - - let amplitude goldstones selectors fin fout = - - (* Set up external lines and match flavors with numbered momenta. *) - let f = fin @ List.map M.conjugate fout in - let nin, nout = List.length fin, List.length fout in - let n = nin + nout in - let externals = List.combine f (ThoList.range 1 n) in - let wfs = external_wfs n externals in - let select_wf = C.select_wf selectors in - let select_p = C.select_p selectors in - - (* Build the full fusion tower (including nodes that are never - needed in the amplitude). *) - let stats, tower = - - if goldstones then - complete_fusion_tower select_wf wfs - else - minimal_fusion_tower n select_wf wfs in - - (* Find all vertices for which \emph{all} off shell wavefunctions - are defined by the tower. *) - - let brakets = - flavor_keystones (filter_keystone stats tower) select_p n - (vertices (M.max_degree ()) (M.flavors ())) - (T.keystones (ThoList.range 1 n)) in - - (* Remove the part of the DAG that is never needed in the amplitude. *) - let dag = - if goldstones then - tower - else - D.harvest_list tower (wavefunctions brakets) in - - (* Remove the leaf nodes of the DAG, corresponding to external lines. *) - let fusions = - List.filter (function (_, []) -> false | _ -> true) (D.lists dag) in - - (* Calculate the symmetry factor for identical particles in the - final state. *) - let symmetry = - Combinatorics.symmetry (List.map M.flavor_sans_color fout) in - - (* Finally: package the results: *) - { fusions = fusions; - brakets = brakets; - on_shell = (fun wf -> C.on_shell selectors (flavor_sans_color wf) (momentum wf)); - is_gauss = (fun wf -> C.is_gauss selectors (flavor_sans_color wf) (momentum wf)); - constraints = C.description selectors; - incoming = fin; - outgoing = fout; - externals = List.map fst wfs; - symmetry = symmetry; - fusion_tower = tower; - fusion_dag = dag } - -(* \thocwmodulesubsection{Diagnostics} *) - - let count_propagators a = - List.length a.fusions - - let count_fusions a = - List.fold_left (fun n (_, a) -> n + List.length a) 0 a.fusions - + List.fold_left (fun n (_, t) -> n + List.length t) 0 a.brakets - + List.length a.brakets - -(* \begin{dubious} - This brute force approach blows up for more than ten particles. - Find a smarter algorithm. - \end{dubious} *) - - let count_diagrams a = - List.fold_left (fun n (wf1, wf23) -> - n + D.count_trees wf1 a.fusion_dag * - (List.fold_left (fun n' (_, wfs) -> - n' + PT.fold_left (fun n'' wf -> - n'' * D.count_trees wf a.fusion_dag) 1 wfs) 0 wf23)) - 0 a.brakets - - exception Impossible - -(* \begin{dubious} - We still need to perform the appropriate charge conjugations so that we - get the correct flavors for the external tree representation. - \end{dubious} *) - - let forest' a = - let below wf = D.forest_memoized wf a.fusion_dag in - ThoList.flatmap - (fun (bra, ket) -> - (Product.list2 (fun bra' ket' -> bra' :: ket') - (below bra) - (ThoList.flatmap - (fun (_, wfs) -> - Product.list (fun w -> w) (PT.to_list (PT.map below wfs))) - ket))) - a.brakets - - let cross wf = - { flavor = M.conjugate wf.flavor; - momentum = P.neg wf.momentum; - wf_tag = wf.wf_tag } - - let fuse_trees wf ts = - Tree.fuse (fun (wf', e) -> (cross wf', e)) - wf (fun t -> List.mem wf (Tree.leafs t)) ts - - let forest wf a = - List.map (fuse_trees wf) (forest' a) - - let poles_beneath wf dag = - D.eval_memoized (fun wf' -> [[]]) - (fun wf' _ p -> List.map (fun p' -> wf' :: p') p) - (fun wf1 wf2 -> - Product.fold2 (fun wf' wfs' wfs'' -> (wf' @ wfs') :: wfs'') wf1 wf2 []) - (@) [[]] [[]] wf dag - - let poles a = - ThoList.flatmap (fun (wf1, wf23) -> - let poles_wf1 = poles_beneath wf1 a.fusion_dag in - (ThoList.flatmap (fun (_, wfs) -> - Product.list List.flatten - (PT.to_list (PT.map (fun wf -> - poles_wf1 @ poles_beneath wf a.fusion_dag) wfs))) - wf23)) - a.brakets - - let s_channel a = - let module WF = - Set.Make (struct type t = wf let compare = order_wf end) in - WF.elements (ThoList.fold_right2 - (fun wf wfs -> - if P.timelike (momentum wf) then - WF.add wf wfs - else - wfs) (poles a) WF.empty) - -(* \begin{dubious} - This should be much faster! Is it correct? Is it faster indeed? - \end{dubious} *) - - let poles' a = - List.map lhs a.fusions - - let s_channel a = - let module WF = - Set.Make (struct type t = wf let compare = order_wf end) in - WF.elements (List.fold_right - (fun wf wfs -> - if P.timelike (momentum wf) then - WF.add wf wfs - else - wfs) (poles' a) WF.empty) - -(* \thocwmodulesubsection{Pictures} *) - -(* Export the DAG in the \texttt{dot(1)} file format so that we can - draw pretty pictures to impress audiences \ldots *) - - let p2s p = - if p >= 0 && p <= 9 then - string_of_int p - else if p <= 36 then - String.make 1 (Char.chr (Char.code 'A' + p - 10)) - else - "_" - - let variable wf = - M.flavor_symbol (flavor wf) ^ - String.concat "" (List.map p2s (momentum_list wf)) - - module Int = Map.Make (struct type t = int let compare = compare end) - - let add_to_list i n m = - Int.add i (n :: try Int.find i m with Not_found -> []) m - - let classify_nodes dag = - Int.fold (fun i n acc -> (i, n) :: acc) - (D.fold_nodes (fun wf -> add_to_list (P.rank (momentum wf)) wf) - dag Int.empty) [] - - let dag_to_dot ch brakets dag = - Printf.fprintf ch "digraph OMEGA {\n"; - D.iter_nodes (fun wf -> - Printf.fprintf ch " \"%s\" [ label = \"%s\" ];\n" - (variable wf) (variable wf)) dag; - List.iter (fun (_, wfs) -> - Printf.fprintf ch " { rank = same;"; - List.iter (fun n -> - Printf.fprintf ch " \"%s\";" (variable n)) wfs; - Printf.fprintf ch " };\n") (classify_nodes dag); - List.iter (fun n -> - Printf.fprintf ch " \"*\" -> \"%s\";\n" (variable n)) - (flatten_keystones brakets); - D.iter (fun n (_, ns) -> - let p = variable n in - PT.iter (fun n' -> - Printf.fprintf ch " \"%s\" -> \"%s\";\n" p (variable n')) ns) dag; - Printf.fprintf ch "}\n" - - let tower_to_dot ch a = - dag_to_dot ch a.brakets a.fusion_tower - - let amplitude_to_dot ch a = - dag_to_dot ch a.brakets a.fusion_dag - - - let rcs_list = [D.rcs; T.rcs; P.rcs; rcs] - - end - -module Make = Tagged(No_Tags) - -module Binary = Make(Tuple.Binary)(Stat_Dirac)(Topology.Binary) -module Tagged_Binary (T : Tagger) = - Tagged(T)(Tuple.Binary)(Stat_Dirac)(Topology.Binary) - -(* \thocwmodulesection{Fusions with Majorana Fermions} *) - -module Stat_Majorana (M : Model.T) : (Stat with type flavor = M.flavor) = - struct - let rcs = RCS.rename rcs_file "Fusion.Stat_Dirac()" - [ "Fermi statistics for Dirac fermions"] - - type flavor = M.flavor - - type stat = - | Fermion of int * int list - | AntiFermion of int * int list - | Boson of int list - | Majorana of int * int list - - let stat f p = - let s = M.fermion f in - if s = 0 then - Boson [] - else if s < 0 then - AntiFermion (p, []) - else if s = 1 then (* [if s = 1 then] *) - Fermion (p, []) - else (* [if s > 1 then] *) - Majorana (p, []) - -(* \begin{JR} - In the formalism of~\cite{Denner:Majorana}, it does not matter to distinguish - spinors and conjugate spinors, it is only important to know in which direction - a fermion line is calculated. So the sign is made by the calculation together - with an aditional one due to the permuation of the pairs of endpoints of - fermion lines in the direction they are calculated. We propose a - ``canonical'' direction from the right to the left child at a fusion point - so we only have to keep in mind which external particle hangs at each side. - Therefore we need not to have a list of pairs of conjugate spinors and - spinors but just a list in which the pairs are right-left-right-left - and so on. Unfortunately it is unavoidable to have couplings with clashing - arrows in supersymmetric theories so we need transmutations from fermions - in antifermions and vice versa as well. - \end{JR} *) - - exception Impossible - -(*i - let stat_fuse s1 s2 f = - match s1, s2, M.lorentz f with - | Boson l1, Boson l2, _ -> Boson (l1 @ l2) - | Boson l1, Fermion (p, l2), Coupling.Majorana -> - Majorana (p, l1 @ l2) - | Boson l1, Fermion (p, l2), _ -> Fermion (p, l1 @ l2) - | Boson l1, AntiFermion (p, l2), Coupling.Majorana -> - Majorana (p, l1 @ l2) - | Boson l1, AntiFermion (p, l2), _ -> AntiFermion (p, l1 @ l2) - | Fermion (p, l1), Boson l2, Coupling.Majorana -> - Majorana (p, l1 @ l2) - | Fermion (p, l1), Boson l2, _ -> Fermion (p, l1 @ l2) - | AntiFermion (p, l1), Boson l2, Coupling.Majorana -> - Majorana (p, l1 @ l2) - | AntiFermion (p, l1), Boson l2, _ -> - AntiFermion (p, l1 @ l2) - | Majorana (p, l1), Boson l2, Coupling.Spinor -> - Fermion (p, l1 @ l2) - | Majorana (p, l1), Boson l2, Coupling.ConjSpinor -> - AntiFermion (p, l1 @ l2) - | Majorana (p, l1), Boson l2, _ -> - Majorana (p, l1 @ l2) - | Boson l1, Majorana (p, l2), Coupling.Spinor -> - Fermion (p, l1 @ l2) - | Boson l1, Majorana (p, l2), Coupling.ConjSpinor -> - AntiFermion (p, l1 @ l2) - | Boson l1, Majorana (p, l2), _ -> - Majorana (p, l1 @ l2) - | AntiFermion (pbar, l1), Fermion (p, l2), _ -> - Boson ([p; pbar] @ l1 @ l2) - | Fermion (p, l1), AntiFermion (pbar, l2), _ -> - Boson ([pbar; p] @ l1 @ l2) - | Fermion (pf, l1), Majorana (pm, l2), _ -> - Boson ([pm; pf] @ l1 @ l2) - | Majorana (pm, l1), Fermion (pf, l2), _ -> - Boson ([pf; pm] @ l1 @ l2) - | AntiFermion (pa, l1), Majorana (pm, l2), _ -> - Boson ([pm; pa] @ l1 @ l2) - | Majorana (pm, l1), AntiFermion (pa, l2), _ -> - Boson ([pa; pm] @ l1 @ l2) - | Majorana (p1, l1), Majorana (p2, l2), _ -> - Boson ([p2; p1] @ l1 @ l2) - | Fermion _, Fermion _, _ | AntiFermion _, - AntiFermion _, _ -> raise Impossible -i*) - - let stat_fuse s1 s2 f = - match s1, s2, M.lorentz f with - | Boson l1, Fermion (p, l2), Coupling.Majorana - | Boson l1, AntiFermion (p, l2), Coupling.Majorana - | Fermion (p, l1), Boson l2, Coupling.Majorana - | AntiFermion (p, l1), Boson l2, Coupling.Majorana - | Majorana (p, l1), Boson l2, Coupling.Majorana - | Boson l1, Majorana (p, l2), Coupling.Majorana -> - Majorana (p, l1 @ l2) - | Boson l1, Fermion (p, l2), Coupling.Spinor - | Boson l1, AntiFermion (p, l2), Coupling.Spinor - | Fermion (p, l1), Boson l2, Coupling.Spinor - | AntiFermion (p, l1), Boson l2, Coupling.Spinor - | Majorana (p, l1), Boson l2, Coupling.Spinor - | Boson l1, Majorana (p, l2), Coupling.Spinor -> - Fermion (p, l1 @ l2) - | Boson l1, Fermion (p, l2), Coupling.ConjSpinor - | Boson l1, AntiFermion (p, l2), Coupling.ConjSpinor - | Fermion (p, l1), Boson l2, Coupling.ConjSpinor - | AntiFermion (p, l1), Boson l2, Coupling.ConjSpinor - | Majorana (p, l1), Boson l2, Coupling.ConjSpinor - | Boson l1, Majorana (p, l2), Coupling.ConjSpinor -> - AntiFermion (p, l1 @ l2) - | Boson l1, Fermion (p, l2), Coupling.Vectorspinor - | Boson l1, AntiFermion (p, l2), Coupling.Vectorspinor - | Fermion (p, l1), Boson l2, Coupling.Vectorspinor - | AntiFermion (p, l1), Boson l2, Coupling.Vectorspinor - | Majorana (p, l1), Boson l2, Coupling.Vectorspinor - | Boson l1, Majorana (p, l2), Coupling.Vectorspinor -> - Majorana (p, l1 @ l2) - | Boson l1, Boson l2, _ -> Boson (l1 @ l2) - | AntiFermion (p1, l1), Fermion (p2, l2), _ - | Fermion (p1, l1), AntiFermion (p2, l2), _ - | Fermion (p1, l1), Fermion (p2, l2), _ - | AntiFermion (p1, l1), AntiFermion (p2, l2), _ - | Fermion (p1, l1), Majorana (p2, l2), _ - | Majorana (p1, l1), Fermion (p2, l2), _ - | AntiFermion (p1, l1), Majorana (p2, l2), _ - | Majorana (p1, l1), AntiFermion (p2, l2), _ - | Majorana (p1, l1), Majorana (p2, l2), _ -> - Boson ([p2; p1] @ l1 @ l2) - | Boson l1, Majorana (p, l2), _ -> Majorana (p, l1 @ l2) - | Boson l1, Fermion (p, l2), _ -> Fermion (p, l1 @ l2) - | Boson l1, AntiFermion (p, l2), _ -> AntiFermion (p, l1 @ l2) - | Fermion (p, l1), Boson l2, _ -> Fermion (p, l1 @ l2) - | AntiFermion (p, l1), Boson l2, _ -> AntiFermion (p, l1 @ l2) - | Majorana (p, l1), Boson l2, _ -> Majorana (p, l1 @ l2) - -(*i These are the old Impossible raising rules. We keep them to ask Ohl - what the generalized topologies do and if our stat_fuse does the right - for 4-vertices with - - | Boson l1, AntiFermion (p, l2), _ - | Fermion (p, l1), Boson l2, _ - | AntiFermion (p, l1), Boson l2, _ - | Majorana (p, l1), Boson l2, _ - | Boson l1, Majorana (p, l2), _ -> - raise Impossible -i*) - - let permutation lines = fst(Combinatorics.sort_signed compare lines) - - let stat_sign = function - | Boson lines -> permutation lines - | Fermion (p, lines) -> permutation (p :: lines) - | AntiFermion (pbar, lines) -> permutation (pbar :: lines) - | Majorana (pm, lines) -> permutation (pm :: lines) - - end - -module Binary_Majorana = - Make(Tuple.Binary)(Stat_Majorana)(Topology.Binary) - -module Nary (B: Tuple.Bound) = - Make(Tuple.Nary(B))(Stat_Dirac)(Topology.Nary(B)) -module Nary_Majorana (B: Tuple.Bound) = - Make(Tuple.Nary(B))(Stat_Majorana)(Topology.Nary(B)) - -module Mixed23 = - Make(Tuple.Mixed23)(Stat_Dirac)(Topology.Mixed23) -module Mixed23_Majorana = - Make(Tuple.Mixed23)(Stat_Majorana)(Topology.Mixed23) - -module Helac (B: Tuple.Bound) = - Make(Tuple.Nary(B))(Stat_Dirac)(Topology.Helac(B)) -module Helac_Majorana (B: Tuple.Bound) = - Make(Tuple.Nary(B))(Stat_Majorana)(Topology.Helac(B)) - -(* \thocwmodulesection{Multiple Colored Amplitudes} *) - -module type Colored = - sig - exception Mismatch - val options : Options.t - type flavor - type amplitude - type selectors - type amplitudes - val amplitudes : bool -> selectors -> (flavor list * flavor list) list -> amplitudes - val flavors : amplitudes -> (flavor list * flavor list) list - val vanishing_flavors : amplitudes -> (flavor list * flavor list) list - val color_flows : amplitudes -> Color.Flow.t list - val vanishing_color_flows : amplitudes -> Color.Flow.t list - val helicities : amplitudes -> (int list * int list) list - val processes : amplitudes -> amplitude list list - val constraints : amplitudes -> string option - end - -module type Colored_Maker = functor (Fusion_Maker : Maker) -> - functor (P : Momentum.T) -> - functor (Colorized_Model : Model.Colorized) -> - Colored with type flavor = Colorized_Model.M.flavor - and type amplitude = Fusion_Maker(P)(Colorized_Model).amplitude - and type selectors = Fusion_Maker(P)(Colorized_Model).selectors - -module Colored (Fusion_Maker : Maker) (P : Momentum.T) (CM : Model.Colorized) = - struct - - exception Mismatch - - type progress = - | Quiet - | Channel of out_channel - | File of string - - let progress_option = ref Quiet - - let options = Options.create - [ "progress", Arg.Unit (fun () -> progress_option := Channel stderr), - "report progress to the standard error stream"; - "progress_file", Arg.String (fun s -> progress_option := File s), - "report progress to a file" ] - - module F = Fusion_Maker(P)(CM) - module C = Cascade.Make(CM)(P) - - type flavor = CM.flavor_sans_color - type p = F.p - type amplitude = F.amplitude - type selectors = F.selectors - - type flavors = flavor list array - type helicities = int list array - type colors = Color.Flow.t array - - type amplitudes' = amplitude array array array - - type amplitudes = - { flavors : (flavor list * flavor list) list; - vanishing_flavors : (flavor list * flavor list) list; - color_flows : Color.Flow.t list; - vanishing_color_flows : Color.Flow.t list; - helicities : (int list * int list) list; - processes : amplitude list list; - constraints : string option } - - let flavors a = a.flavors - let vanishing_flavors a = a.vanishing_flavors - let color_flows a = a.color_flows - let vanishing_color_flows a = a.vanishing_color_flows - let helicities a = a.helicities - let processes a = a.processes - let constraints a = a.constraints - - let sans_colors f = - List.map CM.flavor_sans_color f - - let colors (fin, fout) = - List.map CM.M.color (fin @ fout) - - let process_to_string fin fout = - String.concat " " (List.map CM.flavor_to_string fin) - ^ " -> " ^ String.concat " " (List.map CM.flavor_to_string fout) - - let count_processes colored_processes = - List.fold_left (+) 0 (List.map List.length colored_processes) - -(* Recently [Product.list] began to guarantee lexicographic order for sorted - arguments. Anyway, we still force a lexicographic order. *) - - let rec order_spin_table1 s1 s2 = - match s1, s2 with - | h1 :: t1, h2 :: t2 -> - let c = compare h1 h2 in - if c <> 0 then - c - else - order_spin_table1 t1 t2 - | [], [] -> 0 - | _ -> invalid_arg "order_spin_table: inconsistent lengths" - - let order_spin_table (s1_in, s1_out) (s2_in, s2_out) = - let c = compare s1_in s2_in in - if c <> 0 then - c - else - order_spin_table1 s1_out s2_out - - let sort_spin_table table = - List.sort order_spin_table table - - let id x = x - - let pair x y = (x, y) - - let rec hs_of_lorentz = function - | Coupling.Scalar -> [0] - | Coupling.Spinor | Coupling.ConjSpinor - | Coupling.Majorana | Coupling.Maj_Ghost -> [-1; 1] - | Coupling.Vector -> [-1; 1] - | Coupling.Massive_Vector -> [-1; 0; 1] - | Coupling.Tensor_1 -> [-1; 0; 1] - | Coupling.Vectorspinor -> [-2; -1; 1; 2] - | Coupling.Tensor_2 -> [-2; -1; 0; 1; 2] - | Coupling.BRS f -> hs_of_lorentz f - - let hs_of_flavor f = - hs_of_lorentz (CM.M.lorentz f) - - let hs_of_flavors (fin, fout) = - (List.map hs_of_flavor fin, List.map hs_of_flavor fout) - - let helicity_table flavors = - let hs = List.map hs_of_flavors flavors in - if not (ThoList.homogeneous hs) then - invalid_arg "Fusion.helicity_table: not all flavors have the same helicity states!" - else - match hs with - | [] -> [] - | (hs_in, hs_out) :: _ -> - sort_spin_table (Product.list2 pair (Product.list id hs_in) (Product.list id hs_out)) - -(* \thocwmodulesubsection{Calculate All The Amplitudes} *) - - let amplitudes goldstones select_wf processes = - - if not (ThoList.homogeneous (List.map hs_of_flavors processes)) then - invalid_arg "Fusion.Colored.amplitudes: incompatible helicities"; - - if not (ThoList.homogeneous (List.map colors processes)) then - invalid_arg "Fusion.Colored.amplitudes: incompatible color representations"; - - let colored_processes = - List.map (fun (fi, fo) -> CM.amplitude fi fo) processes in - - let progress = - match !progress_option with - | Quiet -> Progress.dummy - | Channel oc -> Progress.channel oc (count_processes colored_processes) - | File name -> Progress.file name (count_processes colored_processes) in - - let all = - List.map - (List.map (fun (fi, fo) -> - Progress.begin_step progress (process_to_string fi fo); - let amp = F.amplitude goldstones select_wf fi fo in - Progress.end_step progress "done"; - amp)) colored_processes in - Progress.summary progress "all processes done"; - - let allowed_flows, forbidden_flows = - List.partition (List.exists F.allowed) (ThoList.transpose all) in - - let allowed_flows = - ThoList.transpose allowed_flows - and forbidden_flows = - ThoList.transpose forbidden_flows in - - let color_flows = - match allowed_flows with - | [] -> [] - | flows :: _ -> List.map (fun a -> CM.flow (F.incoming a) (F.outgoing a)) flows - and vanishing_color_flows = - match forbidden_flows with - | [] -> [] - | flows :: _ -> List.map (fun a -> CM.flow (F.incoming a) (F.outgoing a)) flows in - - let allowed, forbidden = - List.partition (List.exists F.allowed) allowed_flows in - - let flavors = - List.map - (fun a -> - let a' = List.hd a in - (sans_colors (F.incoming a'), sans_colors (F.outgoing a'))) - allowed - and vanishing_flavors = - List.map - (fun a -> - let a' = List.hd a in - (sans_colors (F.incoming a'), sans_colors (F.outgoing a'))) - forbidden in - - let helicities = - helicity_table flavors in - - { flavors = flavors; - vanishing_flavors = vanishing_flavors; - color_flows = color_flows; - vanishing_color_flows = vanishing_color_flows; - helicities = helicities; - processes = allowed; - constraints = C.description select_wf } - - end - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/whizard_tool.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/whizard_tool.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/whizard_tool.ml (revision 8703) @@ -1,69 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -(* \thocwmodulesection{Main Program} *) - -let with_file f arg = function - | None -> () - | Some "-" -> f stdout arg - | Some name -> - let ch = open_out name in - f ch arg; - close_out ch - -let _ = - let usage = "usage: " ^ Sys.argv.(0) ^ " [options]" - and names = ref [] - and interface = ref None - and makefile = ref None - and makefile_processes = ref None in - Arg.parse - [ ("-i", Arg.String (fun s -> interface := Some s), - "write the interface file"); - ("-m", Arg.String (fun s -> makefile := Some s), - "write the common Makefile"); - ("-p", Arg.String (fun s -> makefile_processes := Some s), - "write the process Makefile"); - ("-a", Arg.Unit (fun () -> - interface := Some "process_interface.90"; - makefile := None; - makefile_processes := Some "Makefile.processes"), - "write process_interface.f90 and Makefile.processes"); - ("-A", Arg.Unit (fun () -> - interface := Some "process_interface.90"; - makefile := Some "Makefile.in"; - makefile_processes := Some "Makefile.processes"), - "write 'em all") ] - (fun name -> names := name :: !names) - usage; - with_file Whizard.write_interface !names !interface; - with_file Whizard.write_makefile !names !makefile; - with_file Whizard.write_makefile_processes !names !makefile_processes; - exit 0 - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/f90_SMh.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/f90_SMh.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/f90_SMh.ml (revision 8703) @@ -1,34 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -module O = - Omega.Make(Fusion.Helac(struct let max_arity = 3 end)) - (Targets.Fortran)(Models.SM(Models.SM_no_anomalous)) -let _ = O.main () - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/f90Maj_SM3.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/f90Maj_SM3.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/f90Maj_SM3.ml (revision 8703) @@ -1,34 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -module O = Omega.Make - (Fusion.Binary_Majorana)(Targets.Fortran_Majorana) - (Models.SM3(Models.SM_no_anomalous)) -let _ = O.main () - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/tree.mli =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/tree.mli (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/tree.mli (revision 8703) @@ -1,111 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -(* This module provides utilities for generic decorated trees, such as - FeynMF output. *) - -(* \thocwmodulesection{Abstract Data Type} *) -type ('n, 'l) t - -(* [leaf n l] returns a tree consisting of a single leaf of type [n] - connected to [l]. *) -val leaf : 'n -> 'l -> ('n, 'l) t - -(* [node n ch] returns a tree node. *) -val node : 'n -> ('n, 'l) t list -> ('n, 'l) t - -(* [leafs t] returns a list of all leafs \textit{in order}. *) -val leafs : ('n, 'l) t -> 'l list - -(* [nodes t] returns a list of all nodes in post-order. This guarantees - that the root node can be stripped from the result by [List.tl]. *) -val nodes : ('n, 'l) t -> 'n list - -(* [fuse conjg root contains_root trees] joins the [trees], using - the leaf [root] in one of the trees as root of the new tree. - [contains_root] guides the search for the subtree containing [root] - as a leaf. [fun t -> List.mem root (leafs t)] is acceptable, but more - efficient solutions could be available in special circumstances. *) -val fuse : ('n -> 'n) -> 'l -> (('n, 'l) t -> bool) -> ('n, 'l) t list -> ('n, 'l) t - -(* [sort lesseq t] return a sorted copy of the tree~[t]: node - labels are ignored and nodes are according to the supremum of the - leaf labels in the corresponding subtree. *) -val sort : ('l -> 'l -> bool) -> ('n, 'l) t -> ('n, 'l) t - -(* \thocwmodulesection{Homomorphisms} *) -val map : ('n1 -> 'n2) -> ('l1 -> 'l2) -> ('n1, 'l1) t -> ('n2, 'l2) t -val fold : ('n -> 'l -> 'a) -> ('n -> 'a list -> 'a) -> ('n, 'l) t -> 'a -val fan : ('n -> 'l -> 'a list) -> ('n -> 'a list -> 'a list) -> - ('n, 'l) t -> 'a list - -(* \thocwmodulesection{Output} *) -val to_string : (string, string) t -> string - -(* \thocwmodulesubsection{Feynmf} *) -type feynmf = - { style : string option; - rev : bool; - label : string option; - tension : float option } -val vanilla : feynmf -val sty : string * bool * string -> feynmf - -(* [to_feynmf file to_string i2 t] write the trees in the - list~[t] to the file named~[file]. The leaf~[i2] is used as - the second incoming particle and~[to_string] is use to convert - leaf labels to \LaTeX-strings. *) -val to_feynmf : bool ref -> string -> ('l -> string) -> 'l -> (feynmf, 'l) t list -> unit - -(* \thocwmodulesubsection{Least Squares Layout} *) - -(* A general graph with edges of type~['e], internal nodes of type~['n], - and external nodes of type ['ext]. *) -type ('e, 'n, 'ext) graph -val graph_of_tree : ('n -> 'n -> 'e) -> ('n -> 'n) -> - 'n -> ('n, 'n) t -> ('e, 'n, 'n) graph - -(* A general graph with the layout of the external nodes fixed. *) -type ('e, 'n, 'ext) ext_layout -val left_to_right : int -> ('e, 'n, 'ext) graph -> ('e, 'n, 'ext) ext_layout - -(* A general graph with the layout of all nodes fixed. *) -type ('e, 'n, 'ext) layout -val layout : ('e, 'n, 'ext) ext_layout -> ('e, 'n, 'ext) layout - -val dump : ('e, 'n, 'ext) layout -> unit -val iter_edges : ('e -> float * float -> float * float -> unit) -> - ('e, 'n, 'ext) layout -> unit -val iter_internal : (float * float -> unit) -> - ('e, 'n, 'ext) layout -> unit -val iter_incoming : ('ext * float * float -> unit) -> - ('e, 'n, 'ext) layout -> unit -val iter_outgoing : ('ext * float * float -> unit) -> - ('e, 'n, 'ext) layout -> unit - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/model.mli =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/model.mli (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/model.mli (revision 8703) @@ -1,266 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -(* \thocwmodulesection{General Quantum Field Theories} *) - -module type T = - sig - -(* [flavor] encodes all quantum numbers, but sometimes we need to ignore - unbroken internal symmetries, which are encoded by [Color.t]. - Iff the color representation is trivial, the projector [flavor_sans_color] - is the identity. This is typically the case in user defined models before - they have been processed by [Colorize.It]. *) - type flavor - type flavor_sans_color - val color : flavor -> Color.t - val flavor_sans_color : flavor -> flavor_sans_color - -(* The PDG particle code for interfacing with Monte Carlos. *) - val pdg : flavor -> int - -(* The Lorentz representation of the particle. *) - val lorentz : flavor -> Coupling.lorentz - -(* The propagator for the particle, which \emph{can} depend - on a gauge parameter. *) - type gauge - val propagator : flavor -> gauge Coupling.propagator - -(* \emph{Not} the symbol for the numerical value, but the - scheme or strategy. *) - val width : flavor -> Coupling.width - -(* Charge conjugation, with and without color. NB: [conjugate_sans_color] - is only needed because in general [flavor_sans_color] has not inverse. *) - val conjugate : flavor -> flavor - val conjugate_sans_color : flavor_sans_color -> flavor_sans_color - -(* Returns $1$ for fermions, $-1$ for anti-fermions and $0$ - otherwise. *) - val fermion : flavor -> int - -(* The Feynman rules. [vertices] and [(fuse2, fuse3, fusen)] are - redundant, of course. However, [vertices] is required for building - functors for models and [vertices] can be recovered from - [(fuse2, fuse3, fusen)] only at great cost. *) - -(* \begin{dubious} - Nevertheless: [vertices] is a candidate for removal, b/c we can - build a smarter [Colorize] functor acting on [(fuse2, fuse3, fusen)]. - It can support an arbitrary numer of color lines. But we have to test - whether it is efficient enough. - \end{dubious} *) - type constant - val max_degree : unit -> int - val vertices : unit -> - ((((flavor * flavor * flavor) * constant Coupling.vertex3 * constant) list) - * (((flavor * flavor * flavor * flavor) * constant Coupling.vertex4 * constant) list) - * (((flavor list) * constant Coupling.vertexn * constant) list)) - val fuse2 : flavor -> flavor -> (flavor * constant Coupling.t) list - val fuse3 : flavor -> flavor -> flavor -> (flavor * constant Coupling.t) list - val fuse : flavor list -> (flavor * constant Coupling.t) list - -(* The list of all known flavors. *) - val flavors : unit -> flavor list - -(* The flavors that can appear in incoming or outgoing states, grouped - in a way that is useful for user interfaces. *) - val external_flavors : unit -> (string * flavor list) list - -(* The Goldstone bosons corresponding to a gauge field, if any. *) - val goldstone : flavor -> (flavor * constant Coupling.expr) option - -(* The dependent parameters. *) - val parameters : unit -> constant Coupling.parameters - -(* Translate from and to convenient textual representations of flavors, - with and without color. Again the missing inverse of [flavor_sans_color] - forces us to define special functions for [flavor_sans_color]. *) - val flavor_of_string : string -> flavor - val flavor_to_string : flavor -> string - val flavor_sans_color_of_string : string -> flavor_sans_color - val flavor_sans_color_to_string : flavor_sans_color -> string - -(* The following must return unique symbols that are acceptable as - symbols in all programming languages under consideration as targets. - Strings of alphanumeric characters (starting with a letter) should - be safe. Underscores are also usable, but would violate strict - Fortran77. *) - val flavor_symbol : flavor -> string - val flavor_sans_color_symbol : flavor_sans_color -> string - val gauge_symbol : gauge -> string - val mass_symbol : flavor -> string - val width_symbol : flavor -> string - val constant_symbol : constant -> string - -(* Model specific options. *) - val options : Options.t - -(* Revision control information. *) - val rcs : RCS.t - end - -(* In addition to hardcoded models, we can have models that are - initialized at run time. *) - -(* \thocwmodulesection{Mutable Quantum Field Theories} *) - -module type Mutable = - sig - include T - -(* Export only one big initialization function to discourage - partial initializations. Labels make this usable. *) - - val setup : - color:(flavor -> Color.t) -> - pdg:(flavor -> int) -> - lorentz:(flavor -> Coupling.lorentz) -> - propagator:(flavor -> gauge Coupling.propagator) -> - width:(flavor -> Coupling.width) -> - goldstone:(flavor -> (flavor * constant Coupling.expr) option) -> - conjugate:(flavor -> flavor) -> - fermion:(flavor -> int) -> - max_degree:int -> - vertices:(unit -> - ((((flavor * flavor * flavor) * constant Coupling.vertex3 * constant) list) - * (((flavor * flavor * flavor * flavor) * constant Coupling.vertex4 * constant) list) - * (((flavor list) * constant Coupling.vertexn * constant) list))) -> - fuse:((flavor -> flavor -> (flavor * constant Coupling.t) list) - * (flavor -> flavor -> flavor -> - (flavor * constant Coupling.t) list) - * (flavor list -> (flavor * constant Coupling.t) list)) -> - flavors:((string * flavor list) list) -> - parameters:(unit -> constant Coupling.parameters) -> - flavor_of_string:(string -> flavor) -> - flavor_to_string:(flavor -> string) -> - flavor_symbol:(flavor -> string) -> - gauge_symbol:(gauge -> string) -> - mass_symbol:(flavor -> string) -> - width_symbol:(flavor -> string) -> - constant_symbol:(constant -> string) -> - unit - end - -(* \thocwmodulesection{Gauge Field Theories} *) - -(* The following signatures are used only for model building. The diagrammatics - and numerics is supposed to be completely ignorant about the detail of the - models and expected to rely on the interface [T] exclusively. - \begin{dubious} - In the end, we might have functors [(M : T) -> Gauge], but we will - need to add the quantum numbers to [T]. - \end{dubious} *) - -module type Gauge = - sig - include T - -(* Matter field carry conserved quantum numbers and can be replicated - in generations without changing the gauge sector. *) - type matter_field - -(* Gauge bosons proper. *) - type gauge_boson - -(* Higgses, Goldstones and all the rest: *) - type other - -(* We can query the kind of field *) - type field = - | Matter of matter_field - | Gauge of gauge_boson - | Other of other - val field : flavor -> field - -(* and we can build new fields of a given kind: *) - val matter_field : matter_field -> flavor - val gauge_boson : gauge_boson -> flavor - val other : other -> flavor - end - -(* \thocwmodulesection{Gauge Field Theories with Broken Gauge Symmetries} *) - -(* Both are carefully crafted as subtypes of [Gauge] so that - they can be used in place of [Gauge] and [T] everywhere: *) - -module type Broken_Gauge = - sig - include Gauge - - type massless - type massive - type goldstone - - type kind = - | Massless of massless - | Massive of massive - | Goldstone of goldstone - val kind : gauge_boson -> kind - - val massless : massive -> gauge_boson - val massive : massive -> gauge_boson - val goldstone : goldstone -> gauge_boson - - end - -module type Unitarity_Gauge = - sig - include Gauge - - type massless - type massive - - type kind = - | Massless of massless - | Massive of massive - val kind : gauge_boson -> kind - - val massless : massive -> gauge_boson - val massive : massive -> gauge_boson - - end - -module type Colorized = - sig - module M : T (* We need access to the uncolored flavor for printing etc. *) - include T with type flavor_sans_color = M.flavor - val amplitude : M.flavor list -> M.flavor list -> (flavor list * flavor list) list - val flow : flavor list -> flavor list -> Color.Flow.t - end - -module type Colorized_Gauge = - sig - module M : Gauge (* We need access to the uncolored flavor for printing etc. *) - include Gauge with type flavor_sans_color = M.flavor - val amplitude : M.flavor list -> M.flavor list -> (flavor list * flavor list) list - val flow : flavor list -> flavor list -> Color.Flow.t - end - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/partition.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/partition.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/partition.ml (revision 8703) @@ -1,91 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -let rcs = RCS.parse "Partition" ["Partitions"] - { RCS.revision = "$Revision$"; - RCS.date = "$Date$"; - RCS.author = "$Author$"; - RCS.source - = "$URL$" } - -(* All unordered pairs of integers with the same sum~$n$ in a given - range~$\{n_1,\ldots,n_2\}$: - \begin{equation} - \text{\ocwlowerid{pairs}}: (n, n_1, n_2) \to - \bigl\{ (i,j) \,\vert\, i+j=n - \land n_1\le i \le j \le n_2 \bigr\} - \end{equation} *) - -let rec pairs' acc n1 n2 = - if n1 > n2 then - List.rev acc - else - pairs' ((n1, n2) :: acc) (succ n1) (pred n2) - -let pairs sum min_n1 max_n2 = - let n1 = max min_n1 (sum - max_n2) in - let n2 = sum - n1 in - if n2 <= max_n2 then - pairs' [] n1 n2 - else - [] - -let rec tuples d sum n_min n_max = - if d <= 0 then - invalid_arg "tuples" - else if d > 1 then - tuples' d sum n_min n_max n_min - else if sum >= n_min && sum <= n_max then - [[sum]] - else - [] - -and tuples' d sum n_min n_max n = - if n > n_max then - [] - else - List.fold_right (fun l ll -> (n :: l) :: ll) - (tuples (pred d) (sum - n) (max n_min n) n_max) - (tuples' d sum n_min n_max (succ n)) - -(* \begin{dubious} - When I find a little spare time, I can provide a dedicated implementation, - but we \emph{know} that [Impossible] is \emph{never} raised and the present - approach is just as good (except for a possible tiny inefficiency). - \end{dubious} *) -exception Impossible of string -let impossible name = raise (Impossible name) - -let triples sum n_min n_max = - List.map (function [n1; n2; n3] -> (n1, n2, n3) | _ -> impossible "triples") - (tuples 3 sum n_min n_max) - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) - - - Index: branches/ohl/omega-development/completed/whizard2/src/thoGDraw.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/thoGDraw.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/thoGDraw.ml (revision 8703) @@ -1,751 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -(* \thocwmodulesection{Tracking Display Sizes} *) - -class type resizeable = - object - method size_allocate : callback:(Gtk.rectangle -> unit) -> GtkSignal.id - end - -class size signals= - object (self) - - val mutable width = -1 - val mutable height = -1 - - method width = width - method height = height - - method private resize w h = - width <- w; - height <- h - - initializer - let (_ : GtkSignal.id) = signals#size_allocate - ~callback:(fun evt -> self#resize evt.Gtk.width evt.Gtk.height) in - () - end - -class type ['a, 'b] window = - object - method window : 'a Gdk.drawable - method realize : unit -> unit - method connect : 'b - constraint 'b = #resizeable - end - -(* \thocwmodulesection{Coordinate Systems} *) - -(* We could try to jump through hoops and inherit from [size], but it is much - simpler just to repeat the few lines of code. *) - -class coordinates ?(margins = 0) - ?(xrange = (0.0, 1.0)) ?(yrange = (0.0, 1.0)) signals = - object (self) - -(* ``Input'' parameters: *) - val mutable width = -1 - val mutable height = -1 - - val mutable x_min = fst xrange - val mutable x_max = snd xrange - val mutable y_min = fst yrange - val mutable y_max = snd yrange - - val mutable left_margin = margins - val mutable right_margin = margins - val mutable bottom_margin = margins - val mutable top_margin = margins - -(* Derived parameters: *) - val mutable x_min_pxl = 0 - val mutable x_max_pxl = 100 - val mutable x_delta_pxl = 100 - val mutable y_min_pxl = 0 - val mutable y_max_pxl = 100 - val mutable y_delta_pxl = 100 - - val mutable x_delta = 1.0 - val mutable y_delta = 1.0 - - val mutable x_pxl_per_unit = 100.0 - val mutable y_pxl_per_unit = 100.0 - - method private update = - x_min_pxl <- left_margin; - x_max_pxl <- width - right_margin; - x_delta_pxl <- x_max_pxl - x_min_pxl; - x_delta <- x_max -. x_min; - x_pxl_per_unit <- float x_delta_pxl /. x_delta; - y_min_pxl <- top_margin; - y_max_pxl <- height - bottom_margin; - y_delta_pxl <- y_max_pxl - y_min_pxl; - y_delta <- y_max -. y_min; - y_pxl_per_unit <- float y_delta_pxl /. y_delta - -(* The [resize] method is only called from signal handlers that - respond to external size changes. *) - - method private resize w h = - width <- w; height <- h; - self#update - - method left_margin m = - left_margin <- m; - self#update - - method right_margin m = - right_margin <- m; - self#update - - method bottom_margin m = - bottom_margin <- m; - self#update - - method top_margin m = - top_margin <- m; - self#update - - method margins m = - left_margin <- m; - right_margin <- m; - bottom_margin <- m; - top_margin <- m; - self#update - - method xrange x0 x1 = - x_min <- x0; x_max <- x1; - self#update - - method yrange y0 y1 = - y_min <- y0; y_max <- y1; - self#update - - method private x_pxl_per_unit = - x_pxl_per_unit - - method private y_pxl_per_unit = - y_pxl_per_unit - - method private project_x x = - x_min_pxl + truncate (x_pxl_per_unit *. (x -. x_min)) - - method private project_y y = - y_max_pxl - truncate (y_pxl_per_unit *. (y -. y_min)) - - method private project (x, y) = - (self#project_x x, self#project_y y) - - initializer - let (_ : GtkSignal.id) = signals#size_allocate - ~callback:(fun evt -> self#resize evt.Gtk.width evt.Gtk.height) in - self#update - end - -(* \thocwmodulesection{Viewports} *) - -let config_file_name = ".ogiga" - -let default_font_name = - "-*-*-*-r-*-*-*-120-*-*-m-*-*-*" - -let out_comment oc comment = - Printf.fprintf oc "(* %s *)\n" comment - -let out_string_parameter oc name value = - Printf.fprintf oc "%s = \"%s\"\n" name value - -let out_int_parameter oc name value = - Printf.fprintf oc "%s = %d\n" name value - -class decoration_context = - object (self) - - val mutable font_name = default_font_name - val mutable font = Gdk.Font.load default_font_name - val mutable line_width = 2 - val mutable arrowhead_tip = 8 - val mutable arrowhead_base = 5 - val mutable arrowhead_width = 4 - val mutable wiggle_amp = 3 - val mutable wiggle_len = 10 - val mutable wiggle_res = 1 - val mutable curl_amp = 5 - val mutable curl_len = 10 - val mutable curl_res = 1 - - method font = font - method font_name = font_name - method line_width = line_width - method arrowhead_tip = arrowhead_tip - method arrowhead_base = arrowhead_base - method arrowhead_width = arrowhead_width - method wiggle_amp = wiggle_amp - method wiggle_len = wiggle_len - method wiggle_res = wiggle_res - method curl_amp = curl_amp - method curl_len = curl_len - method curl_res = curl_res - - method set_font name = - font_name <- name; - font <- Gdk.Font.load font_name - method set_line_width n = line_width <- n - method set_arrowhead_tip n = arrowhead_tip <- n - method set_arrowhead_base n = arrowhead_base <- n - method set_arrowhead_width n = arrowhead_width <- n - method set_wiggle_amp n = wiggle_amp <- n - method set_wiggle_len n = wiggle_len <- n - method set_wiggle_res n = wiggle_res <- n - method set_curl_amp n = curl_amp <- n - method set_curl_len n = curl_len <- n - method set_curl_res n = curl_res <- n - - method to_channel oc = - out_comment oc "O'Giga decoration options"; - out_string_parameter oc "font" font_name; - out_int_parameter oc "line_width" line_width; - out_int_parameter oc "arrowhead_tip" arrowhead_tip; - out_int_parameter oc "arrowhead_base" arrowhead_base; - out_int_parameter oc "arrowhead_width" arrowhead_width; - out_int_parameter oc "wiggle_amp" wiggle_amp; - out_int_parameter oc "wiggle_len" wiggle_len; - out_int_parameter oc "wiggle_res" wiggle_res; - out_int_parameter oc "curl_amp" curl_amp; - out_int_parameter oc "curl_len" curl_len; - out_int_parameter oc "curl_res" curl_res - - method save () = - let oc = open_out config_file_name in - self#to_channel oc; - close_out oc - - method of_stream stream = - let tokens = Genlex.make_lexer ["="] stream in - let junk3 () = - Stream.junk tokens; - Stream.junk tokens; - Stream.junk tokens in - let rec process () = - match Stream.npeek 3 tokens with - | [] -> () - | [Genlex.Ident name; Genlex.Kwd "="; Genlex.String value] -> - begin match name with - | "font" -> self#set_font value - | _ -> invalid_arg "invalid string variable in configuration file" - end; - junk3 (); - process () - | [Genlex.Ident name; Genlex.Kwd "="; Genlex.Int value] -> - begin match name with - | "line_width" -> self#set_line_width value - | "arrowhead_tip" -> self#set_arrowhead_tip value - | "arrowhead_base" -> self#set_arrowhead_base value - | "arrowhead_width" -> self#set_arrowhead_width value - | "wiggle_amp" -> self#set_wiggle_amp value - | "wiggle_len" -> self#set_wiggle_len value - | "wiggle_res" -> self#set_wiggle_res value - | "curl_amp" -> self#set_curl_amp value - | "curl_len" -> self#set_curl_len value - | "curl_res" -> self#set_curl_res value - | _ -> invalid_arg "invalid integer variable in configuration file" - end; - junk3 (); - process () - | _ -> invalid_arg "parse error in configuration file" in - process () - - method restore () = - if Sys.file_exists config_file_name then - let ic = open_in config_file_name in - self#of_stream (Stream.of_channel ic); - close_in ic - - initializer - self#restore () - - end - -type horiz = HCenter | Left of int | Right of int -type vert = VCenter | Below of int | Above of int - -let align_horiz align w x = - match align with - | Right dx -> x + dx - | Left dx -> x - w - dx - | HCenter -> x - w / 2 - -let align_vert align h y = - match align with - | Above dy -> y - dy - | Below dy -> y + h + dy - | VCenter -> y + h / 2 - -let align_box (horiz, vert) (w, h) (x,y) = - (align_horiz horiz w x, align_vert vert h y) - -let pixels ~pos (x0, y0) (x1, y1) (along, perp) = - let dx = float (x1 - x0) - and dy = float (y1 - y0) in - let d = sqrt (dx *. dx +. dy *. dy) in - let along' = pos +. float along /. d - and perp' = float perp /. d in - (x0 + truncate (along' *. dx -. perp' *. dy), - y0 + truncate (along' *. dy +. perp' *. dx)) - -let pixel_shape ~pos (x0, y0) (x1, y1) shape = - List.map (pixels ~pos:0.5 (x0, y0) (x1, y1)) shape - -let two_pi = 4.0 *. asin 1.0 - -class ['a] decorations ?colormap (dc : decoration_context) obj = - object (self) - - val mutable dc = dc - - inherit ['a] GDraw.drawable ?colormap obj as drawable - - method decoration_context = dc - method set_decoration_context dc' = dc <- dc' - - method aligned_string ?(font = dc#font) - ?(align = (HCenter, VCenter)) s xy = - let x', y' = - align_box align - (Gdk.Font.string_width font s, Gdk.Font.string_height font s) xy in - self#string s ~font ~x:x' ~y:y' - - method arrowhead (x0, y0) (x1, y1) = - self#polygon ~filled:true - (pixel_shape ~pos:0.5 (x0, y0) (x1, y1) - [(dc#arrowhead_tip, 0); - (-dc#arrowhead_base, dc#arrowhead_width); - (-dc#arrowhead_base, -dc#arrowhead_width)]) - - method double (x0, y0) (x1, y1) = - let gc = drawable#gc_values in - let w = gc.Gdk.GC.line_width in - self#polygon ~filled:false - [pixels ~pos:0.0 (x0, y0) (x1, y1) (0, w); - pixels ~pos:1.0 (x0, y0) (x1, y1) (0, w); - pixels ~pos:1.0 (x0, y0) (x1, y1) (0, -w); - pixels ~pos:0.0 (x0, y0) (x1, y1) (0, -w)] - - method wiggles (x0, y0) (x1, y1) = - let amplitude = dc#wiggle_amp - and step = dc#wiggle_len in - let dx = float (x1 - x0) - and dy = float (y1 - y0) in - let d = sqrt (dx *. dx +. dy *. dy) in - let num_steps = ceil (d /. float step) in - let step = d /. num_steps in - let amplitude = float amplitude in - let xy along perp = - let along' = along /. d - and perp' = perp *. amplitude /. d in - (x0 + truncate (along' *. dx -. perp' *. dy), - y0 + truncate (along' *. dy +. perp' *. dx)) in - let rec wiggles' t = - if t <= 0.0 then - [xy 0.0 0.0] - else - xy t (sin (t *. two_pi /. step)) :: wiggles' (t -. step /. 10.0) in - self#lines (wiggles' d) - - method curls (x0, y0) (x1, y1) = - let amplitude = dc#curl_amp - and step = dc#curl_len in - let dx = float (x1 - x0) - and dy = float (y1 - y0) in - let d = sqrt (dx *. dx +. dy *. dy) in - let num_steps = ceil (d /. float step) in - let step = d /. num_steps in - let amplitude = float amplitude in - let xy along perp = - let along' = along /. d - and perp' = perp *. amplitude /. d in - (x0 + truncate (along' *. dx -. perp' *. dy), - y0 + truncate (along' *. dy +. perp' *. dx)) in - let rec curls' t = - if t <= 0.0 then - [xy 0.0 0.0] - else - xy (t +. step /. 2.0 *. cos (t *. two_pi /. step)) (sin (t *. two_pi /. step)) - :: curls' (t -. step /. 10.0) in - self#lines (curls' d) - - end - -class ['a] drawable ?colormap dc misc = - let () = misc#realize () in - object (self) - - inherit ['a] decorations ?colormap dc misc#window as drawable - val size = new size misc#connect - - method clear ?(color = `WHITE) () = - drawable#set_foreground color; - drawable#rectangle ~filled:true - ~x:0 ~y:0 ~width:size#width ~height:size#height () - - end - -type direction = - | Forward - | Backward - -type line_style = - | Plain - | Double - | Wiggles - | Curls - | Dashes - | Dots - | Arrow of direction - | Name of string - -class ['a] viewport ?colormap ?margins ?xrange ?yrange dc misc = - let () = misc#realize () in - object (self) - - inherit coordinates ?margins ?xrange ?yrange misc#connect - - val drawable = new drawable ?colormap dc misc - - method drawable = (drawable : 'a drawable) - - method arc ?filled ?start ?angle (width, height) (x, y) = - drawable#arc - ~x:(self#project_x x - width/2) ~y:(self#project_y y - height/2) - ~width ~height ?filled ?start ?angle () - - method point (x, y) = - drawable#point ~x:(self#project_x x) ~y:(self#project_y y) - - method points xy = - drawable#points (List.map self#project xy) - - method line (x0, y0) (x1, y1) = - drawable#line - ~x:(self#project_x x0) ~y:(self#project_y y0) - ~x:(self#project_x x1) ~y:(self#project_y y1) - - method lines xy = - drawable#lines (List.map self#project xy) - - method segments xyxy = - drawable#segments - (List.map (fun (xy0, xy1) -> (self#project xy0, self#project xy1)) xyxy) - - method polygon ?filled xy = - drawable#polygon ?filled (List.map self#project xy) - - method string ?font ?align s xy = - drawable#aligned_string ?font ?align s (self#project xy) - - method propagator line_style (x0, y0 as xy0) (x1, y1 as xy1) = - match line_style with - | Arrow Forward -> - self#line xy0 xy1; - drawable#arrowhead (self#project xy0) (self#project xy1) - | Arrow Backward -> - self#line xy0 xy1; - drawable#arrowhead (self#project xy1) (self#project xy0) - | Plain -> - self#line xy0 xy1 - | Double -> - drawable#double (self#project xy0) (self#project xy1) - | Wiggles -> - drawable#wiggles (self#project xy0) (self#project xy1) - | Curls -> - drawable#curls (self#project xy0) (self#project xy1) - | Dashes -> - self#line xy0 xy1; - drawable#set_foreground (`NAME "red"); - self#string "dashes" (0.5 *. (x0 +. x1), 0.5 *. (y0 +. y1)) - | Dots -> - self#line xy0 xy1; - drawable#set_foreground (`NAME "red"); - self#string "dots" (0.5 *. (x0 +. x1), 0.5 *. (y0 +. y1)) - | Name name -> - self#line xy0 xy1; - drawable#set_foreground (`NAME "red"); - self#string name (0.5 *. (x0 +. x1), 0.5 *. (y0 +. y1)) - - end - -(* \thocwmodulesection{Diagram Displays} *) - -let to_string format tree = - Tree.to_string (Tree.map format (fun _ -> "") tree) - -let layout2 nodes2edge conjugate wf2 tree = - Tree.layout (Tree.left_to_right 2 - (Tree.graph_of_tree nodes2edge conjugate wf2 tree)) - -class ['a, 'edge, 'node] diagram_display - ~node_to_string ~conjugate ~cross ~nodes2edge ~line_style - ?label ?width ?height ?packing dc = - let event_box = GBin.event_box ~border_width:0 ?packing () in - let frame = GBin.frame ?label ~packing:event_box#add () in - let area = GMisc.drawing_area ?width ?height ~packing:frame#add () in - let vp = new viewport dc area#misc in - let _ = - vp#left_margin 50; - vp#right_margin 50; - vp#bottom_margin 10; - vp#top_margin 10 in - object (self) - - val mutable diagram : - ('node * ('node, 'node) Tree.t * (unit, 'node) Color.amplitude) option = None - - val mutable label = - match label with - | Some s -> s - | None -> "" - - method set_label s = - label <- s; - frame#set_label label - - method viewport = (vp : 'a viewport) - method event = event_box#event - - method redraw () = - vp#drawable#clear (); - begin match diagram with - | Some (wf2, t, c) -> - let d = layout2 nodes2edge cross wf2 t in - vp#drawable#set_line_attributes - ~width:vp#drawable#decoration_context#line_width (); - vp#drawable#set_foreground `BLACK; - Tree.iter_edges - (fun flavor xy0 xy1 -> vp#propagator (line_style flavor) xy0 xy1) d; - vp#drawable#set_foreground `BLACK; - Tree.iter_internal (vp#arc ~filled:true (6, 6)) d; - Tree.iter_incoming (fun (ext, x, y) -> - vp#string ~align:(Left 5, VCenter) - (node_to_string ext) (x, y)) d; - Tree.iter_outgoing (fun (ext, x, y) -> - vp#string ~align:(Right 5, VCenter) - (node_to_string (conjugate ext)) (x, y)) d - | None -> () - end - - method private popup evt = - begin match diagram with - | Some (wf2, t, c) -> - begin match GdkEvent.Button.button evt with - | 2 -> - ThoGWindow.message ~title:"O'Giga Color Diagram" ~justify:`LEFT - ~text:(label ^ ":\n\n" ^ - Color.to_string (fun () -> "") node_to_string c) () - | 3 -> - ThoGWindow.message ~title:"O'Giga Diagram" ~justify:`LEFT - ~text:(label ^ ":\n\n" ^ to_string node_to_string t) () - | _ -> () - end - | None -> () - end - - method clear_diagram () = - diagram <- None; - self#redraw () - - method set_diagram d = - diagram <- (Some d); - self#redraw () - - initializer - area#event#connect#expose ~callback:(fun evt -> self#redraw (); true); - self#event#connect#button_press ~callback:(fun evt -> self#popup evt; true); - self#redraw () - - end - -(* \thocwmodulesection{Preferences} *) - -class ['a] demo_diagram_display ~line_style ?label ?width ?height ?packing dc = - let frame = GBin.frame ?label ?packing () in - let area = GMisc.drawing_area ?width ?height ~packing:frame#add () in - let vp = new viewport ~margins:10 dc area#misc in - object (self) - - val xy0 = (0.0, 0.5) - val xy1 = (1.0, 0.5) - - method redraw () = - vp#drawable#clear (); - vp#drawable#set_line_attributes ~width:dc#line_width (); - vp#drawable#set_foreground `BLACK; - vp#propagator line_style xy0 xy1; - vp#arc ~filled:true (6, 6) xy0; - vp#arc ~filled:true (6, 6) xy1 - - initializer - area#event#connect#expose ~callback:(fun evt -> self#redraw (); true); - self#redraw () - - end - -let int_adjustment value (lower, upper) = - GData.adjustment ~value:(float value) - ~lower:(float lower) ~upper:(float upper) ~step_incr:1.0 - ~page_incr:10.0 ~page_size:5.0 () - -let notebook_page text (notebook : GPack.notebook) = - GPack.table ~rows:4 ~columns:4 ~row_spacings:8 ~col_spacings:8 - ~packing:(notebook#append_page ~tab_label:(GMisc.label ~text ())#coerce) () - -let int_edit ?width ?changed text value range (table : GPack.table) row = - GMisc.label ?width ~justify:`RIGHT ~text:(text ^ ":") - ~packing:(table#attach ~left:1 ~top:row ~expand:`X) (); - let spin_button = - GEdit.spin_button - ~adjustment:(int_adjustment value range) ~numeric:true ~digits:0 - ~packing:(table#attach ~left:2 ~top:row ~expand:`NONE) () in - begin match changed with - | None -> () - | Some f -> - ignore (spin_button#connect#changed - ~callback:(fun () -> f spin_button#value_as_int)) - end; - spin_button - -let edit_preferences dc = - - let window = - GWindow.window ~title:"O'Giga Preferences" ~border_width:5 () in - let hbox = GPack.hbox ~spacing:8 ~packing:window#add () in - let input = GPack.vbox ~spacing:8 ~packing:hbox#add () in - let monitor = GPack.vbox ~spacing:8 ~packing:hbox#add () in - - let width = 150 - and height = 30 in - let fermion = - new demo_diagram_display ~line_style:(Arrow Forward) - ~label:"Dirac fermions" ~width ~height ~packing:monitor#add dc in - let antifermion = - new demo_diagram_display ~line_style:(Arrow Backward) - ~label:"Dirac antifermions" ~width ~height ~packing:monitor#add dc in - let photon = - new demo_diagram_display ~line_style:Wiggles - ~label:"Color singlet gauge bosons" ~width ~height ~packing:monitor#add dc in - let gluon = - new demo_diagram_display ~line_style:Curls - ~label:"Gluons" ~width ~height ~packing:monitor#add dc in - let heavy = - new demo_diagram_display ~line_style:Double - ~label:"Heavy gauge bosons" ~width ~height ~packing:monitor#add dc in - let redraw () = - fermion#redraw (); - antifermion#redraw (); - photon#redraw (); - gluon#redraw (); - heavy#redraw () in - - let notebook = GPack.notebook ~scrollable:true ~homogeneous_tabs:true - ~packing:(input#pack ~expand:true) () in - - let general = notebook_page "General" notebook in - let line_width = - int_edit ~changed:(fun n -> dc#set_line_width n; redraw ()) - "line width" dc#line_width (1, 10) general 1 in - GMisc.label ~justify:`RIGHT ~text:("font:") - ~packing:(general#attach ~left:1 ~top:2 ~expand:`X) (); - let font_selection_button = - GButton.button ~label:"Change" - ~packing:(general#attach ~left:2 ~top:2 ~expand:`NONE) () in - font_selection_button#connect#clicked - ~callback:(fun evt -> - let fsd = GWindow.font_selection_dialog ~title:"O'Giga Font Selection" () in - fsd#selection#set_font_name dc#font_name; - fsd#cancel_button#connect#clicked ~callback:fsd#destroy; - fsd#ok_button#connect#clicked - ~callback:(fun evt -> - begin match fsd#selection#font_name with - | Some name -> dc#set_font name - | None -> () - end; - fsd#destroy evt); - fsd#show ()); - - let arrows = notebook_page "Arrows" notebook in - let ah_tip = - int_edit ~changed:(fun n -> dc#set_arrowhead_tip n; redraw ()) - "arrowhead tip" dc#arrowhead_tip (1, 50) arrows 1 in - let ah_base = - int_edit ~changed:(fun n -> dc#set_arrowhead_base n; redraw ()) - "arrowhead base" dc#arrowhead_base (1, 40) arrows 2 in - let ah_width = - int_edit ~changed:(fun n -> dc#set_arrowhead_width n; redraw ()) - "arrowhead width" dc#arrowhead_width (1, 30) arrows 3 in - - let wiggles = notebook_page "Wiggles" notebook in - let w_amp = - int_edit ~changed:(fun n -> dc#set_wiggle_amp n; redraw ()) - "wiggle amplitude" dc#wiggle_amp (0, 20) wiggles 1 in - let w_len = - int_edit ~changed:(fun n -> dc#set_wiggle_len n; redraw ()) - "wiggle length" dc#wiggle_len (1, 50) wiggles 2 in - let w_res = - int_edit ~changed:(fun n -> dc#set_wiggle_res n; redraw ()) - "wiggle resolution" dc#wiggle_res (1, 50) wiggles 3 in - - let curls = notebook_page "Curls" notebook in - let c_amp = - int_edit ~changed:(fun n -> dc#set_curl_amp n; redraw ()) - "curl amplitude" dc#curl_amp (0, 20) curls 1 in - let c_len = - int_edit ~changed:(fun n -> dc#set_curl_len n; redraw ()) - "curl length" dc#curl_len (1, 50) curls 2 in - let c_res = - int_edit ~changed:(fun n -> dc#set_curl_res n; redraw ()) - "curl resolution" dc#curl_res (1, 50) curls 3 in - - let buttons = - GPack.hbox ~spacing:8 ~packing:(input#pack ~expand:false) () in - let ok_button = - GButton.button ~label:"OK" ~packing:buttons#add () in - let accept_button = - GButton.button ~label:"Accept" ~packing:buttons#add () in - let cancel_button = - GButton.button ~label:"Cancel" ~packing:buttons#add () in - cancel_button#connect#clicked ~callback:window#destroy; - accept_button#connect#clicked - ~callback:(fun evt -> ()); - ok_button#connect#clicked - ~callback:(fun evt -> - dc#save (); - window#destroy evt); - - window#show () - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/vertex_parser.mly =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/vertex_parser.mly (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/vertex_parser.mly (revision 8703) @@ -1,146 +0,0 @@ -/* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */ - -%{ -let parse_error msg = - raise (Vertex_syntax.Syntax_Error (msg, symbol_start (), symbol_end ())) -%} - -%token < int > INT -%token < string > NAME -%token < int > POLARIZATION MOMENTUM -%token EPSILON -%token S P V A T -%token I -%token LPAREN RPAREN BRA VERT KET LEXT REXT COMMA -%token PLUS MINUS TIMES DIV DOT POWER -%token END - -%left PLUS MINUS -%nonassoc NEG UPLUS -%left TIMES -%left DIV -%right POWER -%left DOT - -%start coupling -%type < Vertex_syntax.scalar > coupling - -%% - -coupling: - expr END { $1 } - | END { Vertex_syntax.null () } -; - -expr: - contraction { $1 } - | I { Vertex_syntax.i () } - | INT { Vertex_syntax.integer $1 } - | NAME { Vertex_syntax.constant $1 } - | expr DIV INT { Vertex_syntax.fraction $1 $3 } - | INT TIMES expr { Vertex_syntax.multiple $1 $3 } - | LPAREN expr RPAREN { $2 } - | expr TIMES expr { Vertex_syntax.mul $1 $3 } - | expr PLUS expr { Vertex_syntax.add $1 $3 } - | expr MINUS expr { Vertex_syntax.sub $1 $3 } - | MINUS expr %prec NEG { Vertex_syntax.sub (Vertex_syntax.null ()) $2 } - | PLUS expr %prec UPLUS { $2 } - | bra scalar_current ket { Vertex_syntax.scalar_current $2 $1 $3 } - | bra vector_current_dot ket - { let (c, v) = $2 in - Vertex_syntax.dot (Vertex_syntax.vector_current c $1 $3) v } - | EPSILON LPAREN vector COMMA vector COMMA vector COMMA vector RPAREN - { Vertex_syntax.eps $3 $5 $7 $9 } -; - -vector_current_dot: - vector_current DOT vector - { ($1, $3) } - | vector DOT vector_current - { ($3, $1) } - | vector_current DOT vector_current - { parse_error "contracted gamma matrices" } -; - -contraction: - vector DOT vector { Vertex_syntax.dot $1 $3 } -; - -vector: - POLARIZATION { Vertex_syntax.e $1 } - | MOMENTUM { Vertex_syntax.k $1 } - | LEXT NAME REXT { Vertex_syntax.x $2 } - | LPAREN vector RPAREN { $2 } - | vector PLUS vector { Vertex_syntax.addv $1 $3 } - | vector MINUS vector { Vertex_syntax.subv $1 $3 } - | vector DOT tensor { Vertex_syntax.contract_left $1 $3 } - | tensor DOT vector { Vertex_syntax.contract_right $1 $3 } - | vector TIMES vector { parse_error "vector*vector" } - | vector DIV vector { parse_error "vector/vector" } - | bra vector_current ket { Vertex_syntax.vector_current $2 $1 $3 } - | EPSILON LPAREN vector COMMA vector COMMA vector RPAREN - { Vertex_syntax.pseudo $3 $5 $7 } -; - -tensor: - bra tensor_current ket { Vertex_syntax.tensor_current $2 $1 $3 } -; - -scalar_current: - S { Vertex_syntax.S } - | P { Vertex_syntax.P } - | S MINUS P { Vertex_syntax.SL } - | S PLUS P { Vertex_syntax.SR } - | S plus_minus S { parse_error "S+/-S" } - | S plus_minus V { parse_error "S+/-V" } - | S plus_minus A { parse_error "S+/-A" } - | LPAREN scalar_current RPAREN - { $2 } -; - -vector_current: - V { Vertex_syntax.V } - | A { Vertex_syntax.A } - | V MINUS A { Vertex_syntax.VL } - | V PLUS A { Vertex_syntax.VR } - | LPAREN vector_current RPAREN - { $2 } -; - -tensor_current: - T { Vertex_syntax.T } - | LPAREN tensor_current RPAREN - { $2 } -; - -plus_minus: - PLUS { } - | MINUS { } -; -bra: - BRA INT VERT { $2 } -; - -ket: - VERT INT KET { $2 } -; Index: branches/ohl/omega-development/completed/whizard2/src/f90_SM_km.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/f90_SM_km.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/f90_SM_km.ml (revision 8703) @@ -1,33 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -module O = Omega.Make(Fusion.Mixed23)(Targets.Fortran) - (Models.SM(Models.SM_k_matrix)) -let _ = O.main () - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/f90_QCD.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/f90_QCD.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/f90_QCD.ml (revision 8703) @@ -1,223 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -let rcs_file = RCS.parse "F90_QCD" ["QCD"] - { RCS.revision = "$Revision$"; - RCS.date = "$Date$"; - RCS.author = "$Author$"; - RCS.source - = "$URL$" } - -(* QCD with colors. *) - -module M : Model.T = - struct - let rcs = rcs_file - - open Coupling - - let options = Options.empty - - type flavor = - | U | Ubar | D | Dbar - | C | Cbar | S | Sbar - | T | Tbar | B | Bbar - | Gl - type flavor_sans_color = flavor - let flavor_sans_color f = f - - let external_flavors () = - [ "Quarks", [U; D; C; S; T; B; Ubar; Dbar; Cbar; Sbar; Tbar; Bbar]; - "Gauge Bosons", [Gl]] - let flavors () = ThoList.flatmap snd (external_flavors ()) - - type gauge = unit - type constant = Gs | G2 | I_Gs - - let lorentz = function - | U | D | C | S | T | B -> Spinor - | Ubar | Dbar | Cbar | Sbar | Tbar | Bbar -> ConjSpinor - | Gl -> Vector - - let color = function - | U | D | C | S | T | B -> Color.SUN 3 - | Ubar | Dbar | Cbar | Sbar | Tbar | Bbar -> Color.SUN (-3) - | Gl -> Color.AdjSUN 3 - - let propagator = function - | U | D | C | S | T | B -> Prop_Spinor - | Ubar | Dbar | Cbar | Sbar | Tbar | Bbar -> Prop_ConjSpinor - | Gl -> Prop_Feynman - - let width _ = Timelike - - let goldstone _ = - None - - let conjugate = function - | U -> Ubar - | D -> Dbar - | C -> Cbar - | S -> Sbar - | T -> Tbar - | B -> Bbar - | Ubar -> U - | Dbar -> D - | Cbar -> C - | Sbar -> S - | Tbar -> T - | Bbar -> B - | Gl -> Gl - - let conjugate_sans_color = conjugate - - let fermion = function - | U | D | C | S | T | B -> 1 - | Ubar | Dbar | Cbar | Sbar | Tbar | Bbar -> -1 - | Gl -> 0 - - module F = Models.Fusions (struct - type f = flavor - type c = constant - let compare = compare - let conjugate = conjugate - end) - -(* This is compatible with CD+. *) - - let color_current = - [ ((Dbar, Gl, D), FBF ((-1), Psibar, V, Psi), Gs); - ((Ubar, Gl, U), FBF ((-1), Psibar, V, Psi), Gs); - ((Cbar, Gl, C), FBF ((-1), Psibar, V, Psi), Gs); - ((Sbar, Gl, S), FBF ((-1), Psibar, V, Psi), Gs); - ((Tbar, Gl, T), FBF ((-1), Psibar, V, Psi), Gs); - ((Bbar, Gl, B), FBF ((-1), Psibar, V, Psi), Gs)] - - let three_gluon = - [ ((Gl, Gl, Gl), Gauge_Gauge_Gauge 1, Gs)] - - let gauge4 = Vector4 [(2, C_13_42); (-1, C_12_34); (-1, C_14_23)] - - let four_gluon = - [ ((Gl, Gl, Gl, Gl), gauge4, G2)] - - let vertices3 = - (color_current @ three_gluon) - - let vertices4 = four_gluon - - let vertices () = - (vertices3, vertices4, []) - - let table = F.of_vertices (vertices ()) - let fuse2 = F.fuse2 table - let fuse3 = F.fuse3 table - let fuse = F.fuse table - let max_degree () = 4 - - let parameters () = { input = [Gs, 1.0]; derived = []; derived_arrays = [] } - let flavor_of_string = function - | "u" -> U - | "d" -> D - | "c" -> C - | "s" -> S - | "t" -> T - | "b" -> B - | "ubar" -> Ubar - | "dbar" -> Dbar - | "cbar" -> Cbar - | "sbar" -> Sbar - | "tbar" -> Tbar - | "bbar" -> Bbar - | "gl" -> Gl - | _ -> invalid_arg "Models.QCD.flavor_of_string" - - let flavor_to_string = function - | U -> "u" - | Ubar -> "ubar" - | D -> "d" - | Dbar -> "dbar" - | C -> "c" - | Cbar -> "cbar" - | S -> "s" - | Sbar -> "sbar" - | T -> "t" - | Tbar -> "tbar" - | B -> "b" - | Bbar -> "bbar" - | Gl -> "gl" - - let flavor_symbol = function - | U -> "u" - | Ubar -> "ubar" - | D -> "d" - | Dbar -> "dbar" - | C -> "c" - | Cbar -> "cbar" - | S -> "s" - | Sbar -> "sbar" - | T -> "t" - | Tbar -> "tbar" - | B -> "b" - | Bbar -> "bbar" - | Gl -> "gl" - - let flavor_sans_color_of_string = flavor_of_string - let flavor_sans_color_to_string = flavor_to_string - let flavor_sans_color_symbol = flavor_symbol - - let gauge_symbol () = - failwith "Models.QCD.gauge_symbol: internal error" - - let pdg = function - | D -> 1 | Dbar -> -1 - | U -> 2 | Ubar -> -2 - | S -> 3 | Sbar -> -3 - | C -> 4 | Cbar -> -4 - | B -> 5 | Bbar -> -5 - | T -> 6 | Tbar -> -6 - | Gl -> 21 - - let mass_symbol f = - "mass(" ^ string_of_int (abs (pdg f)) ^ ")" - - let width_symbol f = - "width(" ^ string_of_int (abs (pdg f)) ^ ")" - - let constant_symbol = function - | I_Gs -> "(0,1)*gs" - | Gs -> "gs" - | G2 -> "gs**2" - end - -module O = Omega.Make(Fusion.Mixed23)(Targets.Fortran)(M) - -let _ = O.main () - - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/topology.mli =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/topology.mli (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/topology.mli (revision 8703) @@ -1,160 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -module type T = - sig - -(* [partition] is a collection of integers, with arity one larger than - the arity of ['a children] below. These arities can one fixed number - corresponding to homogeneous tuples or a collection of tupes or - lists. *) - type partition - -(* [partitions n] returns the union of - all~$\lbrack n_1; n_2; \ldots; n_d\rbrack$ - with~$1\le n_1\le n_2\le\ldots\le n_d\le \lfloor n/2\rfloor$ and - \begin{equation} - \sum_{i=1}^d n_i = n - \end{equation} - for~[d] from~$3$ to~$d_{\max}$, where $d_{\max}$ is a fixed number - for each module implementating [T]. In particular, if - [type partition = int * int * int], then [partitions n] returns - all~$(n_1,n_2,n_3)$ with~$n_1\le n_2\le n_3$ and~$n_1+n_2+n_3=n$. *) - val partitions : int -> partition list - -(* A (poly)tuple as implemented by the modules in [Tuple]: *) - type 'a children - -(* [keystones externals] returns all keystones for the amplitude with - external states [externals] in the vanilla scalar theory with a - \begin{equation} - \sum_{3\le k\le d_{\max}} \lambda_k\phi^k - \end{equation} - interaction. One factor of the products is factorized. In particular, if - \begin{quote} - [type 'a children = 'a Tuple.Binary.t = 'a * 'a], - \end{quote} - then [keystones externals] returns all keystones for the amplitude with - external states [externals] in the vanilla scalar - $\lambda\phi^3$-theory. *) - val keystones : 'a list -> ('a list * 'a list children list) list - -(* The maximal depth of subtrees for a given number of external lines. *) - val max_subtree : int -> int - -(* Only for diagnostics: *) - val inspect_partition : partition -> int list - val rcs : RCS.t - end - -module Binary : T with type 'a children = 'a Tuple.Binary.t -module Ternary : T with type 'a children = 'a Tuple.Ternary.t -module Mixed23 : T with type 'a children = 'a Tuple.Mixed23.t -module Nary : functor (B : Tuple.Bound) -> - (T with type 'a children = 'a Tuple.Nary(B).t) - -(* \thocwmodulesection{% - Diagnostics: Counting Diagrams and Factorizations for $\sum_n\lambda_n\phi^n$} - The number of diagrams for many particles can easily exceed the range of native - integers. Even if we can not calculate the corresponding amplitudes, we want - to check combinatorical factors. Therefore we code a functor that can use - arbitray implementations of integers. *) - -module type Integer = - sig - type t - val zero : t - val one : t - val ( + ) : t -> t -> t - val ( - ) : t -> t -> t - val ( * ) : t -> t -> t - val ( / ) : t -> t -> t - val pred : t -> t - val succ : t -> t - val ( = ) : t -> t -> bool - val ( <> ) : t -> t -> bool - val ( < ) : t -> t -> bool - val ( <= ) : t -> t -> bool - val ( > ) : t -> t -> bool - val ( >= ) : t -> t -> bool - val of_int : int -> t - val to_int : t -> int - val to_string : t -> string - val compare : t -> t -> int - val factorial : t -> t - end - -(* Of course, native integers will provide the fastest implementation: *) -module Int : Integer - -module type Count = - sig - type integer - -(* [diagrams f d n] returns the number of tree diagrams contributing - to the $n$-point amplitude in vanilla scalar theory with - \begin{equation} - \sum_{3\le k\le d \land f(k)} \lambda_k\phi^k - \end{equation} - interaction. The default value of~[f] returns [true] for all - arguments. *) - val diagrams : ?f:(integer -> bool) -> integer -> integer -> integer - val diagrams_via_keystones : integer -> integer -> integer - -(* \begin{equation} - \frac{1}{S(n_k,n-n_k)} \frac{1}{S(n_1,n_2,\ldots,n_k)} - \binom{n_1+n_2+\ldots+n_k}{n_1,n_2,\ldots,n_k} - \end{equation} *) - val keystones : integer list -> integer - -(* [diagrams_via_keystones d n] must produce the same - results as [diagrams d n]. This is shown explicitely in - tables~\ref{tab:keystone-check}, \ref{tab:keystone-check4} and - \ref{tab:keystone-check6} for small values of~[d] and~[n]. - The test program in appendix~\ref{sec:count} can be used to - verify this relation for larger values. *) - val diagrams_per_keystone : integer -> integer list -> integer - - end - -module Count : functor (I : Integer) -> Count with type integer = I.t - -(* \thocwmodulesection{Emulating HELAC} *) - -(* We can also proceed \'a la~\cite{HELAC:2000}. *) -module Helac : functor (B : Tuple.Bound) -> - (T with type 'a children = 'a Tuple.Nary(B).t) - -(* \begin{dubious} - The following has never been tested, but it is no rocket science and - should work anyway \ldots - \end{dubious} *) -module Helac_Binary : T with type 'a children = 'a Tuple.Binary.t - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) - Index: branches/ohl/omega-development/completed/whizard2/src/f90_QED.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/f90_QED.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/f90_QED.ml (revision 8703) @@ -1,32 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -module O = Omega.Make(Fusion.Binary)(Targets.Fortran)(Models.QED) -let _ = O.main () - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/cascade_parser.mly =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/cascade_parser.mly (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/cascade_parser.mly (revision 8703) @@ -1,84 +0,0 @@ -/* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */ - -%{ -open Cascade_syntax -let parse_error msg = - raise (Syntax_Error (msg, symbol_start (), symbol_end ())) -%} - -%token < string > FLAVOR -%token < int > INT -%token LPAREN RPAREN -%token AND OR PLUS COLON NOT -%token ONSHELL OFFSHELL GAUSS -%token END -%left OR -%left AND -%left PLUS COLON -%left NOT - -%start main -%type < (string, int list) Cascade_syntax.t > main - -%% - -main: - END { mk_true () } - | cascades END { $1 } -; - -cascades: - cascade { $1 } - | LPAREN cascades RPAREN { $2 } - | cascades AND cascades { mk_and $1 $3 } - | cascades OR cascades { mk_or $1 $3 } -; - -cascade: - momentum_list { mk_any_flavor $1 } - | momentum_list ONSHELL flavor_list - { mk_on_shell $3 $1 } - | momentum_list ONSHELL NOT flavor_list - { mk_on_shell_not $4 $1 } - | momentum_list OFFSHELL flavor_list - { mk_off_shell $3 $1 } - | momentum_list OFFSHELL NOT flavor_list - { mk_off_shell_not $4 $1 } - | momentum_list GAUSS flavor_list { mk_gauss $3 $1 } - | momentum_list GAUSS NOT flavor_list - { mk_gauss_not $4 $1 } -; - -momentum_list: - | momentum { [$1] } - | momentum_list PLUS momentum { $3 :: $1 } -; - -momentum: - INT { $1 } -; - -flavor_list: - FLAVOR { [$1] } - | flavor_list COLON FLAVOR { $3 :: $1 } -; Index: branches/ohl/omega-development/completed/whizard2/src/count.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/count.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/count.ml (revision 8703) @@ -1,250 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -open Num - -(* Factorial and double factorial for big integers. *) - -let rec factorial' fn n = - if sign_num n <= 0 then - fn - else - factorial' (n */ fn) (pred_num n) - -let factorial n = - factorial' (Int 1) n - -let rec dfactorial' fn n = - if sign_num n <= 0 then - fn - else - dfactorial' (n */ fn) (n -/ (Int 2)) - -let dfactorial n = - dfactorial' (Int 1) n - -(* \thocwmodulesection{[Binary]: $\lambda\phi^3$} *) - -module B = - struct - - module T = Topology.Binary - - let partition_to_string p = - "(" ^ String.concat "," - (List.map string_of_int (T.inspect_partition p)) ^ ")" - - let print_partitions n = - for i = 4 to n do - Printf.printf "%d -> %s\n" - i (String.concat ", " - (List.map partition_to_string (T.partitions i))) - done - -(* See equation~(\ref{eq:S(1,2,3)}): *) - - let symmetry n1 n2 n3 = - if n1 = n2 && n2 = n3 then - Int 6 - else if n1 = n2 && n3 = 2 * n1 then - Int 4 - else if n1 = n2 || n2 = n3 then - Int 2 - else if n3 = n1 + n2 then - Int 2 - else - Int 1 - - let trees n = - dfactorial (n +/ n -/ (Int 5)) - - let number p = - match T.inspect_partition p with - | [n1'; n2'; n3'] -> - let n1 = Int n1' and n2 = Int n2' and n3 = Int n3' in - factorial (n1 +/ n2 +/ n3) - */ trees (succ_num n1) */ trees (succ_num n2) */ trees (succ_num n3) - // factorial n1 // factorial n2 // factorial n3 // symmetry n1' n2' n3' - | _ -> invalid_arg "B.number" - - let partition_sum n = - List.fold_left (fun sum n' -> number n' +/ sum) (Int 0) (T.partitions n) - - let partition_count n = - Printf.sprintf "%s*%s" (string_of_num (number n)) (partition_to_string n) - - let print_symmetry n = - for i = 4 to n do - let p = partition_sum i in - Printf.printf "%d -> %s %s = %s\n" i (string_of_num p) - (if compare_num p (trees (Int i)) = 0 then "(OK)" else "???") - (String.concat " + " (List.map partition_count (T.partitions i))) - done - - let print_diagrams n = - for i = 4 to n do - Printf.printf " %d & %s & %s \\\\\n" i - (string_of_num (power_num (Int 2) (pred_num (Int i)) -/ Int (i + 1))) - (string_of_num (trees (Int i))) - done - - end - -(* \thocwmodulesection{[Nary]: $\sum_n\lambda_n\phi^n$} *) - -module N = - struct - - module I = - struct - type t = num - let zero = num_of_int 0 - let one = num_of_int 1 - let ( + ) = add_num - let ( - ) = sub_num - let ( * ) = mult_num - let ( / ) = quo_num - let pred = pred_num - let succ = succ_num - let ( = ) = ( =/ ) - let ( <> ) = ( <>/ ) - let ( < ) = ( ) = ( >/ ) - let ( >= ) = ( >=/ ) - let of_int = num_of_int - let to_int = int_of_num - let to_string = string_of_num - let compare = compare_num - let factorial = factorial - end - - let max_degree = 6 - - module C = Topology.Count(I) - module T = Topology.Nary(struct let max_arity = pred max_degree end) - - let partition_to_string p = - "(" ^ String.concat "," - (List.map string_of_int (T.inspect_partition p)) ^ ")" - - let print_partitions n = - for i = 4 to n do - Printf.printf "%d -> %s\n" - i (String.concat ", " - (List.map partition_to_string (T.partitions i))) - done - - let partition_count p0 = - let p = List.map I.of_int (T.inspect_partition p0) - and d = I.of_int max_degree in - I.to_string ((C.diagrams_per_keystone d p) */ (C.keystones p)) ^ "*" ^ - partition_to_string p0 - - let print_symmetry n = - let d = I.of_int max_degree in - for i = 4 to n do - let i' = I.of_int i in - let count = C.diagrams d i' in - Printf.printf "%d -> %s %s = %s\n" i (I.to_string count) - (if count =/ C.diagrams_via_keystones d i' then - "(OK)" - else - "???") - (String.concat " + " (List.map partition_count (T.partitions i))) - done - - let print_symmetries n = - let l = ThoList.range 1 n in - List.iter (fun p -> - let p = T.inspect_partition p in - let n = List.length (Combinatorics.keystones p l) - and n' = I.to_int (C.keystones (List.map I.of_int p)) - and name = String.concat "," (List.map string_of_int p) in - if n = n' then - Printf.printf "(%s): %d (OK)\n" name n - else - Printf.printf "(%s): %d != %d\n" name n n') - (T.partitions n) - - end - -(* \thocwmodulesection{Main Program} *) - -let _ = - let usage = "usage: " ^ Sys.argv.(0) ^ " [options]" in - Arg.parse - ["-d", Arg.Int B.print_diagrams, "diagrams"; - "-p", Arg.Int B.print_partitions, "partitions"; - "-P", Arg.Int N.print_partitions, "partitions"; - "-s", Arg.Int B.print_symmetry, "symmetry"; - "-S", Arg.Int N.print_symmetry, "symmetry"; - "-X", Arg.Int N.print_symmetries, "symmetry"] - (fun _ -> print_endline usage; exit 1) - usage; - exit 0 - -(*i - -(* \begin{dubious} - [Numerix.Slong] appears to be \emph{slower} here \ldots - \end{dubious} *) - -module BI = - struct - open Numerix.Slong - type t = Numerix.Slong.t - let zero = of_int 0 - let one = of_int 1 - let ( + ) = add - let ( - ) = sub - let ( * ) = mul - let ( / ) = quo - let pred n = sub_1 n 1 - let succ n = add_1 n 1 - let ( = ) = eq - let ( <> ) = neq - let ( < ) = inf - let ( <= ) = infeq - let ( > ) = sup - let ( >= ) = supeq - let of_int = of_int - let to_int = int_of - let to_string = string_of - let compare = cmp - let rec factorial' fn n = - if infeq_1 n 0 then - fn - else - factorial' (n * fn) (pred n) - let factorial n = - factorial' (of_int 1) n - end -i*) - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/coupling.mli =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/coupling.mli (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/coupling.mli (revision 8703) @@ -1,2550 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -(* The enumeration types used for communication from [Models] - to [Targets]. On the physics side, the modules in [Models] - must implement the Feynman rules according to the conventions - set up here. On the numerics side, the modules in [Targets] - must handle all cases according to the same conventions. *) - -(* \thocwmodulesection{Propagators} - The Lorentz representation of the particle. NB: O'Mega - treats all lines as \emph{outgoing} and particles are therefore - transforming as [ConjSpinor] and antiparticles as [Spinor]. *) -type lorentz = - | Scalar - | Spinor (* $\psi$ *) - | ConjSpinor (* $\bar\psi$ *) - | Majorana (* $\chi$ *) - | Maj_Ghost (* SUSY ghosts *) - | Vector - | Massive_Vector - | Vectorspinor (* supersymmetric currents and gravitinos *) - | Tensor_1 - | Tensor_2 (* massive gravitons (large extra dimensions) *) - | BRS of lorentz - -(* \begin{table} - \begin{center} - \renewcommand{\arraystretch}{2.2} - \begin{tabular}{|r|l|l|}\hline - & only Dirac fermions & incl.~Majorana fermions \\\hline - [Prop_Scalar] - & \multicolumn{2}{l|}{% - $\displaystyle\phi(p)\leftarrow - \frac{\ii}{p^2-m^2+\ii m\Gamma}\phi(p)$} \\\hline - [Prop_Spinor] - & $\displaystyle\psi(p)\leftarrow - \frac{\ii(-\fmslash{p}+m)}{p^2-m^2+\ii m\Gamma}\psi(p)$ - & $\displaystyle\psi(p)\leftarrow - \frac{\ii(-\fmslash{p}+m)}{p^2-m^2+\ii m\Gamma}\psi(p)$ \\\hline - [Prop_ConjSpinor] - & $\displaystyle\bar\psi(p)\leftarrow - \bar\psi(p)\frac{\ii(\fmslash{p}+m)}{p^2-m^2+\ii m\Gamma}$ - & $\displaystyle\psi(p)\leftarrow - \frac{\ii(-\fmslash{p}+m)}{p^2-m^2+\ii m\Gamma}\psi(p)$ \\\hline - [Prop_Majorana] - & \multicolumn{1}{c|}{N/A} - & $\displaystyle\chi(p)\leftarrow - \frac{\ii(-\fmslash{p}+m)}{p^2-m^2+\ii m\Gamma}\chi(p)$ \\\hline - [Prop_Unitarity] - & \multicolumn{2}{l|}{% - $\displaystyle\epsilon_\mu(p)\leftarrow - \frac{\ii}{p^2-m^2+\ii m\Gamma} - \left(-g_{\mu\nu}+\frac{p_\mu p_\nu}{m^2}\right)\epsilon^\nu(p)$} \\\hline - [Prop_Feynman] - & \multicolumn{2}{l|}{% - $\displaystyle\epsilon^\nu(p)\leftarrow - \frac{-\ii}{p^2-m^2+\ii m\Gamma}\epsilon^\nu(p)$} \\\hline - [Prop_Gauge] - & \multicolumn{2}{l|}{% - $\displaystyle\epsilon_\mu(p)\leftarrow - \frac{\ii}{p^2} - \left(-g_{\mu\nu}+(1-\xi)\frac{p_\mu p_\nu}{p^2}\right)\epsilon^\nu(p)$} \\\hline - [Prop_Rxi] - & \multicolumn{2}{l|}{% - $\displaystyle\epsilon_\mu(p)\leftarrow - \frac{\ii}{p^2-m^2+\ii m\Gamma} - \left(-g_{\mu\nu}+(1-\xi)\frac{p_\mu p_\nu}{p^2-\xi m^2}\right) - \epsilon^\nu(p)$} \\\hline - \end{tabular} - \end{center} - \caption{\label{tab:propagators} Propagators. NB: The sign of the - momenta in the spinor propagators comes about because O'Mega - treats all momenta as \emph{outgoing} and the charge flow for - [Spinor] is therefore opposite to the momentum, while the charge - flow for [ConjSpinor] is parallel to the momentum.} - \end{table} - \begin{table} - \begin{center} - \renewcommand{\arraystretch}{1.5} - \begin{tabular}{|r|l|}\hline - [Aux_Scalar] - & $\displaystyle\phi(p)\leftarrow\ii\phi(p)$ \\\hline - [Aux_Spinor] - & $\displaystyle\psi(p)\leftarrow\ii\psi(p)$ \\\hline - [Aux_ConjSpinor] - & $\displaystyle\bar\psi(p)\leftarrow\ii\bar\psi(p)$ \\\hline - [Aux_Vector] - & $\displaystyle\epsilon^\mu(p)\leftarrow\ii\epsilon^\mu(p)$ \\\hline - [Aux_Tensor_1] - & $\displaystyle T^{\mu\nu}(p)\leftarrow\ii T^{\mu\nu}(p)$ \\\hline - [Only_Insertion] - & \multicolumn{1}{c|}{N/A} \\\hline - \end{tabular} - \end{center} - \caption{\label{tab:aux-propagators} Auxiliary and non propagating fields} - \end{table} - If there were no vectors or auxiliary fields, we could deduce the propagator from - the Lorentz representation. While we're at it, we can introduce - ``propagators'' for the contact interactions of auxiliary fields - as well. [Prop_Gauge] and [Prop_Feynman] are redundant as special - cases of [Prop_Rxi]. - - The special case [Only_Insertion] corresponds to operator insertions - that do not correspond to a propagating field all. These are used - for checking Slavnov-Taylor identities - \begin{equation} - \partial_\mu\Braket{\text{out}|W^\mu(x)|\text{in}} - = m_W\Braket{\text{out}|\phi(x)|\text{in}} - \end{equation} - of gauge theories in unitarity gauge where the Goldstone bosons are - not propagating. Numerically, it would suffice to use a vanishing - propagator, but then superflous fusions would be calculated in - production code in which the Slavnov-Taylor identities are not tested. *) - -type 'a propagator = - | Prop_Scalar | Prop_Ghost - | Prop_Spinor | Prop_ConjSpinor | Prop_Majorana - | Prop_Unitarity | Prop_Feynman | Prop_Gauge of 'a | Prop_Rxi of 'a - | Prop_Tensor_2 | Prop_Vectorspinor - | Prop_Col_Scalar | Prop_Col_Feynman | Prop_Col_Majorana - | Prop_Col_Unitarity - | Aux_Scalar | Aux_Vector | Aux_Tensor_1 - | Aux_Spinor | Aux_ConjSpinor | Aux_Majorana - | Only_Insertion - -(* \begin{JR} - We don't need different fermionic propagators as supposed by the variable - names [Prop_Spinor], [Prop_ConjSpinor] or [Prop_Majorana]. The - propagator in all cases has to be multiplied on the left hand side of the - spinor out of which a new one should be built. All momenta are treated as - \emph{outgoing}, so for the propagation of the different fermions the - following table arises, in which the momentum direction is always downwards - and the arrows show whether the momentum and the fermion line, - respectively are parallel or antiparallel to the direction of calculation: - \begin{center} - \begin{tabular}{|l|c|c|c|c|}\hline - Fermion type & fermion arrow & mom. & calc. & sign \\\hline\hline - Dirac fermion & $\uparrow$ & $\uparrow~\downarrow$ & - $\uparrow~\uparrow$ & negative \\\hline - Dirac antifermion & $\downarrow$ & $\downarrow~\downarrow$ & - $\uparrow~\downarrow$ & negative \\\hline - Majorana fermion & - & $\uparrow~\downarrow$ & - & negative \\\hline - \end{tabular} - \end{center} - So the sign of the momentum is always negative and no further distinction - is needed. - \end{JR} *) - -type width = - | Vanishing - | Constant - | Timelike - | Running - | Fudged - | Custom of string - -(* \thocwmodulesection{Vertices} - The combined $S-P$ and $V-A$ couplings (see - tables~\ref{tab:dim4-fermions-SP}, \ref{tab:dim4-fermions-VA}, - \ref{tab:dim4-fermions-SPVA-maj} and~\ref{tab:dim4-fermions-SPVA-maj2}) - are redundant, of course, but they allow some targets to create - more efficient numerical code.\footnote{An additional benefit - is that the counting of Feynman diagrams is not upset by a splitting - of the vectorial and axial pieces of gauge bosons.} *) -type fermion = Psi | Chi | Grav -type fermionbar = Psibar | Chibar | Gravbar -type boson = - | SP | S | P | SL | SR | SLR | VA | V | A | VL | VR | VLR - | POT | MOM | MOM5 | MOML | MOMR | LMOM | RMOM | VMOM -type boson2 = S2 | P2 | S2P | S2L | S2R | S2LR - | SV | PV | SLV | SRV | SLRV | V2 - -(* The integer is an additional coefficient that multiplies the respective - coupling constant. This allows to reduce the number of required coupling - constants in manifestly symmetrc cases. Most of times it will be equal - unity, though. *) - -(* The two vertex types [PBP] and [BBB] for the couplings of two fermions or - two antifermions ("clashing arrows") is unavoidable in supersymmetric - theories. - \begin{dubious} - \ldots{} tho doesn't like the names and has promised to find a better - mnemonics! - \end{dubious} *) - -type 'a vertex3 = - | FBF of int * fermionbar * boson * fermion - | PBP of int * fermion * boson * fermion - | BBB of int * fermionbar * boson * fermionbar - | GBG of int * fermionbar * boson * fermion (* gravitino-boson-fermion *) - | Gauge_Gauge_Gauge of int | Aux_Gauge_Gauge of int - | Scalar_Vector_Vector of int - | Aux_Vector_Vector of int | Aux_Scalar_Vector of int - | Scalar_Scalar_Scalar of int | Aux_Scalar_Scalar of int - | Vector_Scalar_Scalar of int - | Graviton_Scalar_Scalar of int - | Graviton_Vector_Vector of int - | Graviton_Spinor_Spinor of int - | Dim4_Vector_Vector_Vector_T of int - | Dim4_Vector_Vector_Vector_L of int - | Dim4_Vector_Vector_Vector_T5 of int - | Dim4_Vector_Vector_Vector_L5 of int - | Dim6_Gauge_Gauge_Gauge of int - | Dim6_Gauge_Gauge_Gauge_5 of int - | Aux_DScalar_DScalar of int | Aux_Vector_DScalar of int - | Dim5_Scalar_Gauge2 of int (* % - $\frac12 \phi F_{1,\mu\nu} F_2^{\mu\nu} = - \frac12 - \phi (\ii \partial_{[\mu,} V_{1,\nu]})(\ii \partial^{[\mu,} V_2^{\nu]})$ *) - | Dim5_Scalar_Gauge2_Skew of int - (* % - $\frac12 \phi F_{1,\mu\nu} \tilde{F}_2^{\mu\nu} = - - \phi (\ii \partial_\mu V_{1,\nu})(\ii \partial_\rho V_{2,\sigma})\epsilon^{\mu\nu\rho\sigma}$ *) - | Dim5_Scalar_Vector_Vector_T of int (* % - $\phi(\ii\partial_\mu V_1^\nu)(\ii\partial_\nu V_2^\mu)$ *) - | Dim6_Vector_Vector_Vector_T of int (* % - $V_1^\mu ((\ii\partial_\nu V_2^\rho)% - \ii\overleftrightarrow{\partial_\mu}(\ii\partial_\rho V_3^\nu))$ *) - | Tensor_2_Vector_Vector of int (* % - $T^{\mu\nu} (V_{1,\mu}V_{2,\nu} + V_{1,\nu}V_{2,\mu})$ *) - | Dim5_Tensor_2_Vector_Vector_1 of int (* % - $T^{\alpha\beta} (V_1^\mu - \ii\overleftrightarrow\partial_\alpha - \ii\overleftrightarrow\partial_\beta V_{2,\mu}$ *) - | Dim5_Tensor_2_Vector_Vector_2 of int - (* % - $T^{\alpha\beta} - ( V_1^\mu \ii\overleftrightarrow\partial_\beta (\ii\partial_\mu V_{2,\alpha}) - + V_1^\mu \ii\overleftrightarrow\partial_\alpha (\ii\partial_\mu V_{2,\beta}))$ *) - | Dim7_Tensor_2_Vector_Vector_T of int (* % - $T^{\alpha\beta} ((\ii\partial^\mu V_1^\nu) - \ii\overleftrightarrow\partial_\alpha - \ii\overleftrightarrow\partial_\beta - (\ii\partial_\nu V_{2,\mu})) $ *) - -(* As long as we stick to renormalizable couplings, there are only - three types of quartic couplings: [Scalar4], [Scalar2_Vector2] - and [Vector4]. However, there are three inequivalent contractions - for the latter and the general vertex will be a linear combination - with integer coefficients: - \begin{subequations} - \begin{align} - \ocwupperid{Scalar4}\,1 :&\;\;\;\;\; - \phi_1 \phi_2 \phi_3 \phi_4 \\ - \ocwupperid{Scalar2\_Vector2}\,1 :&\;\;\;\;\; - \phi_1^{\vphantom{\mu}} \phi_2^{\vphantom{\mu}} - V_3^\mu V_{4,\mu}^{\vphantom{\mu}} \\ - \ocwupperid{Vector4}\,\lbrack 1, \ocwupperid{C\_12\_34} \rbrack :&\;\;\;\;\; - V_1^\mu V_{2,\mu}^{\vphantom{\mu}} - V_3^\nu V_{4,\nu}^{\vphantom{\mu}} \\ - \ocwupperid{Vector4}\,\lbrack 1, \ocwupperid{C\_13\_42} \rbrack :&\;\;\;\;\; - V_1^\mu V_2^\nu - V_{3,\mu}^{\vphantom{\mu}} V_{4,\nu}^{\vphantom{\mu}} \\ - \ocwupperid{Vector4}\,\lbrack 1, \ocwupperid{C\_14\_23} \rbrack :&\;\;\;\;\; - V_1^\mu V_2^\nu - V_{3,\nu}^{\vphantom{\mu}} V_{4,\mu}^{\vphantom{\mu}} - \end{align} - \end{subequations} *) - -type contract4 = C_12_34 | C_13_42 | C_14_23 - -(*i\begin{dubious} - CS objected to the polymorphic [type 'a vertex4], since it broke the - implementation of some of his extensions. Is there another way of - getting coupling constants into [Vector4_K_Matrix], besides the brute - force solution of declaring the possible coupling constants here? - \textit{I'd like to put the blame on CS for two reasons: it's not clear - that the brute force solution will actually work and everytime a new - vertex that depends non-linearly on coupling contanst pops up, the - problem will make another appearance.} - \end{dubious}i*) - -type 'a vertex4 = - | Scalar4 of int - | Scalar2_Vector2 of int - | Vector4 of (int * contract4) list - | DScalar4 of (int * contract4) list - | DScalar2_Vector2 of (int * contract4) list - | GBBG of int * fermionbar * boson2 * fermion - -(* In some applications, we have to allow for contributions outside of - perturbation theory. The most prominent example is heavy gauge boson - scattering at very high energies, where the perturbative expression - violates unitarity. *) - -(* One solution is the `$K$-matrix' ansatz. Such unitarizations typically - introduce effective propagators and/or vertices that violate crossing - symmetry and vanish in the $t$-channel. This can be taken care of in - [Fusion] by filtering out vertices that have the wrong momenta. *) - -(* In this case the ordering of the fields in a vertex of the Feynman - rules becomes significant. In particular, we assume that $(V_1,V_2,V_3,V_4)$ - implies - \begin{equation} - \parbox{25mm}{\fmfframe(2,3)(2,3){\begin{fmfgraph*}(20,20) - \fmfleft{v1,v2} - \fmfright{v4,v3} - \fmflabel{$V_1$}{v1} - \fmflabel{$V_2$}{v2} - \fmflabel{$V_3$}{v3} - \fmflabel{$V_4$}{v4} - \fmf{plain}{v,v1} - \fmf{plain}{v,v2} - \fmf{plain}{v,v3} - \fmf{plain}{v,v4} - \fmfblob{.2w}{v} - \end{fmfgraph*}}} - \qquad\Longrightarrow\qquad - \parbox{45mm}{\fmfframe(2,3)(2,3){\begin{fmfgraph*}(40,20) - \fmfleft{v1,v2} - \fmfright{v4,v3} - \fmflabel{$V_1$}{v1} - \fmflabel{$V_2$}{v2} - \fmflabel{$V_3$}{v3} - \fmflabel{$V_4$}{v4} - \fmf{plain}{v1,v12,v2} - \fmf{plain}{v3,v34,v4} - \fmf{dots,label=$\Theta((p_1+p_2)^2)$,tension=0.7}{v12,v34} - \fmfdot{v12,v34} - \end{fmfgraph*}}} - \end{equation} - The list of pairs of parameters denotes the location and strengths - of the poles in the $K$-matrix ansatz: - \begin{equation} - (c_1,a_1,c_2,a_2,\ldots,c_n,a_n) \Longrightarrow - f(s) = \sum_{i=1}^{n} \frac{c_i}{s-a_i} - \end{equation} *) - | Vector4_K_Matrix_tho of int * ('a * 'a) list - | Vector4_K_Matrix_jr of int * (int * contract4) list - -type 'a vertexn = unit - -(* An obvious candidate for addition to [boson] is [T], of course. *) - -(* \begin{dubious} - This list is sufficient for the minimal standard model, but not comprehensive - enough for most of its extensions, supersymmetric or otherwise. - In particular, we need a \emph{general} parameterization for all trilinear - vertices. One straightforward possibility are polynomials in the momenta for - each combination of fields. - \end{dubious} - \begin{JR} - Here we use the rules which can be found in~\cite{Denner:Majorana} - and are more properly described in [Targets] where the performing of the fusion - rules in analytical expressions is encoded. - \end{JR} - \begin{table} - \begin{center} - \renewcommand{\arraystretch}{1.2} - \begin{tabular}{|r|l|l|}\hline - & only Dirac fermions & incl.~Majorana fermions \\\hline - \multicolumn{3}{|l|}{[FBF (Psibar, S, Psi)]: - $\mathcal{L}_I=g_S\bar\psi_1 S\psi_2$}\\\hline - [F12] & $\bar\psi_2\leftarrow\ii\cdot g_S\bar\psi_1 S$ - & $\psi_2\leftarrow\ii\cdot g_S\psi_1 S$ \\\hline - [F21] & $\bar\psi_2\leftarrow\ii\cdot g_S S \bar\psi_1$ - & $\psi_2\leftarrow\ii\cdot g_SS\psi_1$ \\\hline - [F13] & $S\leftarrow\ii\cdot g_S\bar\psi_1\psi_2$ - & $S\leftarrow\ii\cdot g_S\psi_1^T{\mathrm{C}}\psi_2$ \\\hline - [F31] & $S\leftarrow\ii\cdot g_S\psi_{2,\alpha}\bar\psi_{1,\alpha}$ - & $S\leftarrow\ii\cdot g_S\psi_2^T{\mathrm{C}} \psi_1$\\\hline - [F23] & $\psi_1\leftarrow\ii\cdot g_SS\psi_2$ - & $\psi_1\leftarrow\ii\cdot g_SS\psi_2$ \\\hline - [F32] & $\psi_1\leftarrow\ii\cdot g_S\psi_2 S$ - & $\psi_1\leftarrow\ii\cdot g_S\psi_2 S$ \\\hline - \multicolumn{3}{|l|}{[FBF (Psibar, P, Psi)]: - $\mathcal{L}_I=g_P\bar\psi_1 P\gamma_5\psi_2$} \\\hline - [F12] & $\bar\psi_2\leftarrow\ii\cdot g_P\bar\psi_1\gamma_5 P$ - & $\psi_2\leftarrow\ii\cdot g_P \gamma_5\psi_1 P$ \\\hline - [F21] & $\bar\psi_2\leftarrow\ii\cdot g_P P\bar\psi_1\gamma_5$ - & $\psi_2\leftarrow\ii\cdot g_P P\gamma_5\psi_1$ \\\hline - [F13] & $P\leftarrow\ii\cdot g_P\bar\psi_1\gamma_5\psi_2$ - & $P\leftarrow\ii\cdot g_P\psi_1^T {\mathrm{C}}\gamma_5\psi_2$ \\\hline - [F31] & $P\leftarrow\ii\cdot g_P[\gamma_5\psi_2]_\alpha\bar\psi_{1,\alpha}$ - & $P\leftarrow\ii\cdot g_P\psi_2^T {\mathrm{C}}\gamma_5\psi_1$ \\\hline - [F23] & $\psi_1\leftarrow\ii\cdot g_P P\gamma_5\psi_2$ - & $\psi_1\leftarrow\ii\cdot g_P P\gamma_5\psi_2$ \\\hline - [F32] & $\psi_1\leftarrow\ii\cdot g_P \gamma_5\psi_2 P$ - & $\psi_1\leftarrow\ii\cdot g_P \gamma_5\psi_2 P$ \\\hline - \multicolumn{3}{|l|}{[FBF (Psibar, V, Psi)]: - $\mathcal{L}_I=g_V\bar\psi_1\fmslash{V}\psi_2$} \\\hline - [F12] & $\bar\psi_2\leftarrow\ii\cdot g_V\bar\psi_1\fmslash{V}$ - & $\psi_{2,\alpha}\leftarrow\ii\cdot - (-g_V)\psi_{1,\beta}\fmslash{V}_{\alpha\beta}$ \\\hline - [F21] & $\bar\psi_{2,\beta}\leftarrow\ii\cdot - g_V\fmslash{V}_{\alpha\beta} \bar\psi_{1,\alpha}$ - & $\psi_2\leftarrow\ii\cdot (-g_V)\fmslash{V}\psi_1$ \\\hline - [F13] & $V_\mu\leftarrow\ii\cdot g_V\bar\psi_1\gamma_\mu\psi_2$ - & $V_\mu\leftarrow\ii\cdot - g_V (\psi_1)^T {\mathrm{C}}\gamma_{\mu}\psi_2$ \\\hline - [F31] & $V_\mu\leftarrow\ii\cdot g_V[\gamma_\mu\psi_2]_\alpha\bar\psi_{1,\alpha}$ - & $V_\mu\leftarrow\ii\cdot - (-g_V)(\psi_2)^T {\mathrm{C}}\gamma_{\mu}\psi_1$ \\\hline - [F23] & $\psi_1\leftarrow\ii\cdot g_V\fmslash{V}\psi_2$ - & $\psi_1\leftarrow\ii\cdot g_V\fmslash{V}\psi_2$ \\\hline - [F32] & $\psi_{1,\alpha}\leftarrow\ii\cdot - g_V\psi_{2,\beta}\fmslash{V}_{\alpha\beta}$ - & $\psi_{1,\alpha}\leftarrow\ii\cdot - g_V\psi_{2,\beta}\fmslash{V}_{\alpha\beta}$ \\\hline - \multicolumn{3}{|l|}{[FBF (Psibar, A, Psi)]: - $\mathcal{L}_I=g_A\bar\psi_1\gamma_5\fmslash{A}\psi_2$} \\\hline - [F12] & $\bar\psi_2\leftarrow\ii\cdot g_A\bar\psi_1\gamma_5\fmslash{A}$ - & $\psi_{2,\alpha}\leftarrow\ii\cdot - g_A\psi_{\beta}[\gamma_5\fmslash{A}]_{\alpha\beta}$ \\\hline - [F21] & $\bar\psi_{2,\beta}\leftarrow\ii\cdot g_A - [\gamma_5\fmslash{A}]_{\alpha\beta} \bar\psi_{1,\alpha}$ - & $\psi_2\leftarrow\ii\cdot g_A \gamma_5\fmslash{A}\psi$ \\\hline - [F13] & $A_\mu\leftarrow\ii\cdot g_A\bar\psi_1\gamma_5\gamma_\mu\psi_2$ - & $A_\mu\leftarrow\ii\cdot - g_A \psi_1^T {\textrm{C}}\gamma_5\gamma_{\mu}\psi_2$ \\\hline - [F31] & $A_\mu\leftarrow\ii\cdot - g_A[\gamma_5\gamma_\mu\psi_2]_\alpha\bar\psi_{1,\alpha}$ - & $A_\mu\leftarrow\ii\cdot - g_A \psi_2^T {\textrm{C}}\gamma_5\gamma_{\mu}\psi_1$ \\\hline - [F23] & $\psi_1\leftarrow\ii\cdot g_A\gamma_5\fmslash{A}\psi_2$ - & $\psi_1\leftarrow\ii\cdot g_A\gamma_5\fmslash{A}\psi_2$ \\\hline - [F32] & $\psi_{1,\alpha}\leftarrow\ii\cdot g_A - \psi_{2,\beta}[\gamma_5\fmslash{A}]_{\alpha\beta}$ - & $\psi_{1,\alpha}\leftarrow\ii\cdot - g_A\psi_{2,\beta}[\gamma_5\fmslash{A}]_{\alpha\beta}$ \\\hline - \end{tabular} - \end{center} - \caption{\label{tab:dim4-fermions} Dimension-4 trilinear fermionic couplings. - The momenta are unambiguous, because there are no derivative couplings - and all participating fields are different.} - \end{table} - \begin{table} - \begin{center} - \renewcommand{\arraystretch}{1.3} - \begin{tabular}{|r|l|l|}\hline - & only Dirac fermions & incl.~Majorana fermions \\\hline - \multicolumn{3}{|l|}{[FBF (Psibar, T, Psi)]: - $\mathcal{L}_I=g_TT_{\mu\nu}\bar\psi_1 - [\gamma^\mu,\gamma^\nu]_-\psi_2$}\\\hline - [F12] & $\bar\psi_2\leftarrow\ii\cdot g_T - \bar\psi_1[\gamma^\mu,\gamma^\nu]_-T_{\mu\nu}$ - & $\bar\psi_2\leftarrow\ii\cdot g_T \cdots$ \\\hline - [F21] & $\bar\psi_2\leftarrow\ii\cdot g_T T_{\mu\nu} - \bar\psi_1[\gamma^\mu,\gamma^\nu]_-$ - & $\bar\psi_2\leftarrow\ii\cdot g_T \cdots$ \\\hline - [F13] & $T_{\mu\nu}\leftarrow\ii\cdot g_T\bar\psi_1[\gamma_\mu,\gamma_\nu]_-\psi_2$ - & $T_{\mu\nu}\leftarrow\ii\cdot g_T \cdots $ \\\hline - [F31] & $T_{\mu\nu}\leftarrow\ii\cdot g_T - [[\gamma_\mu,\gamma_\nu]_-\psi_2]_\alpha\bar\psi_{1,\alpha}$ - & $T_{\mu\nu}\leftarrow\ii\cdot g_T \cdots $ \\\hline - [F23] & $\psi_1\leftarrow\ii\cdot g_T T_{\mu\nu}[\gamma^\mu,\gamma^\nu]_-\psi_2$ - & $\psi_1\leftarrow\ii\cdot g_T \cdots$ \\\hline - [F32] & $\psi_1\leftarrow\ii\cdot g_T [\gamma^\mu,\gamma^\nu]_-\psi_2 T_{\mu\nu}$ - & $\psi_1\leftarrow\ii\cdot g_T \cdots$ \\\hline - \end{tabular} - \end{center} - \caption{\label{tab:dim5-fermions} Dimension-5 trilinear fermionic couplings - (NB: the coefficients and signs are not fixed yet). - The momenta are unambiguous, because there are no derivative couplings - and all participating fields are different.} - \end{table} - \begin{table} - \begin{center} - \renewcommand{\arraystretch}{1.3} - \begin{tabular}{|r|l|l|}\hline - & only Dirac fermions & incl.~Majorana fermions \\\hline - \multicolumn{3}{|l|}{[FBF (Psibar, SP, Psi)]: - $\mathcal{L}_I=\bar\psi_1\phi(g_S+g_P\gamma_5)\psi_2$}\\\hline - [F12] & $\bar\psi_2\leftarrow\ii\cdot\bar\psi_1(g_S+g_P\gamma_5)\phi$ - & $\psi_2\leftarrow\ii\cdot \cdots$ \\\hline - [F21] & $\bar\psi_2\leftarrow\ii\cdot\phi\bar\psi_1(g_S+g_P\gamma_5)$ - & $\psi_2\leftarrow\ii\cdot \cdots$ \\\hline - [F13] & $\phi\leftarrow\ii\cdot\bar\psi_1(g_S+g_P\gamma_5)\psi_2$ - & $\phi\leftarrow\ii\cdot\cdots$ \\\hline - [F31] & $\phi\leftarrow\ii\cdot[(g_S+g_P\gamma_5)\psi_2]_\alpha\bar\psi_{1,\alpha}$ - & $\phi\leftarrow\ii\cdot\cdots$ \\\hline - [F23] & $\psi_1\leftarrow\ii\cdot \phi(g_S+g_P\gamma_5)\psi_2$ - & $\psi_1\leftarrow\ii\cdot\cdots$ \\\hline - [F32] & $\psi_1\leftarrow\ii\cdot(g_S+g_P\gamma_5)\psi_2\phi$ - & $\psi_1\leftarrow\ii\cdot\cdots$ \\\hline - \multicolumn{3}{|l|}{[FBF (Psibar, SL, Psi)]: - $\mathcal{L}_I=g_L\bar\psi_1\phi(1-\gamma_5)\psi_2$}\\\hline - [F12] & $\bar\psi_2\leftarrow\ii\cdot g_L\bar\psi_1(1-\gamma_5)\phi$ - & $\psi_2\leftarrow\ii\cdot \cdots$ \\\hline - [F21] & $\bar\psi_2\leftarrow\ii\cdot g_L\phi\bar\psi_1(1-\gamma_5)$ - & $\psi_2\leftarrow\ii\cdot \cdots$ \\\hline - [F13] & $\phi\leftarrow\ii\cdot g_L\bar\psi_1(1-\gamma_5)\psi_2$ - & $\phi\leftarrow\ii\cdot\cdots$ \\\hline - [F31] & $\phi\leftarrow\ii\cdot g_L[(1-\gamma_5)\psi_2]_\alpha\bar\psi_{1,\alpha}$ - & $\phi\leftarrow\ii\cdot\cdots$ \\\hline - [F23] & $\psi_1\leftarrow\ii\cdot g_L\phi(1-\gamma_5)\psi_2$ - & $\psi_1\leftarrow\ii\cdot\cdots$ \\\hline - [F32] & $\psi_1\leftarrow\ii\cdot g_L(1-\gamma_5)\psi_2\phi$ - & $\psi_1\leftarrow\ii\cdot\cdots$ \\\hline - \multicolumn{3}{|l|}{[FBF (Psibar, SR, Psi)]: - $\mathcal{L}_I=g_R\bar\psi_1\phi(1+\gamma_5)\psi_2$}\\\hline - [F12] & $\bar\psi_2\leftarrow\ii\cdot g_R\bar\psi_1(1+\gamma_5)\phi$ - & $\psi_2\leftarrow\ii\cdot \cdots$ \\\hline - [F21] & $\bar\psi_2\leftarrow\ii\cdot g_R\phi\bar\psi_1(1+\gamma_5)$ - & $\psi_2\leftarrow\ii\cdot \cdots$ \\\hline - [F13] & $\phi\leftarrow\ii\cdot g_R\bar\psi_1(1+\gamma_5)\psi_2$ - & $\phi\leftarrow\ii\cdot\cdots$ \\\hline - [F31] & $\phi\leftarrow\ii\cdot g_R[(1+\gamma_5)\psi_2]_\alpha\bar\psi_{1,\alpha}$ - & $\phi\leftarrow\ii\cdot\cdots$ \\\hline - [F23] & $\psi_1\leftarrow\ii\cdot g_R\phi(1+\gamma_5)\psi_2$ - & $\psi_1\leftarrow\ii\cdot\cdots$ \\\hline - [F32] & $\psi_1\leftarrow\ii\cdot g_R(1+\gamma_5)\psi_2\phi$ - & $\psi_1\leftarrow\ii\cdot\cdots$ \\\hline - \multicolumn{3}{|l|}{[FBF (Psibar, SLR, Psi)]: - $\mathcal{L}_I=g_L\bar\psi_1\phi(1-\gamma_5)\psi_2 - +g_R\bar\psi_1\phi(1+\gamma_5)\psi_2$}\\\hline - \end{tabular} - \end{center} - \caption{\label{tab:dim4-fermions-SP} Combined dimension-4 trilinear fermionic couplings.} - \end{table} - \begin{table} - \begin{center} - \renewcommand{\arraystretch}{1.3} - \begin{tabular}{|r|l|l|}\hline - & only Dirac fermions & incl.~Majorana fermions \\\hline - \multicolumn{3}{|l|}{[FBF (Psibar, VA, Psi)]: - $\mathcal{L}_I=\bar\psi_1\fmslash{Z}(g_V-g_A\gamma_5)\psi_2$}\\\hline - [F12] & $\bar\psi_2\leftarrow\ii\cdot\bar\psi_1\fmslash{Z}(g_V-g_A\gamma_5)$ - & $\psi_2\leftarrow\ii\cdot \cdots$ \\\hline - [F21] & $\bar\psi_{2,\beta}\leftarrow\ii\cdot - [\fmslash{Z}(g_V-g_A\gamma_5)]_{\alpha\beta}\bar\psi_{1,\alpha}$ - & $\psi_2\leftarrow\ii\cdot \cdots$ \\\hline - [F13] & $Z_\mu\leftarrow\ii\cdot\bar\psi_1\gamma_\mu(g_V-g_A\gamma_5)\psi_2$ - & $Z_\mu\leftarrow\ii\cdot \cdots$ \\\hline - [F31] & $Z_\mu\leftarrow\ii\cdot - [\gamma_\mu(g_V-g_A\gamma_5)\psi_2]_\alpha\bar\psi_{1,\alpha}$ - & $Z_\mu\leftarrow\ii\cdot \cdots$ \\\hline - [F23] & $\psi_1\leftarrow\ii\cdot\fmslash{Z}(g_V-g_A\gamma_5)\psi_2$ - & $\psi_1\leftarrow\ii\cdot\cdots$ \\\hline - [F32] & $\psi_{1,\alpha}\leftarrow\ii\cdot - \psi_{2,\beta}[\fmslash{Z}(g_V-g_A\gamma_5)]_{\alpha\beta}$ - & $\psi_1\leftarrow\ii\cdot\cdots$ \\\hline - \multicolumn{3}{|l|}{[FBF (Psibar, VL, Psi)]: - $\mathcal{L}_I=g_L\bar\psi_1\fmslash{Z}(1-\gamma_5)\psi_2$}\\\hline - [F12] & $\bar\psi_2\leftarrow\ii\cdot g_L\bar\psi_1\fmslash{Z}(1-\gamma_5)$ - & $\psi_2\leftarrow\ii\cdot \cdots$ \\\hline - [F21] & $\bar\psi_{2,\beta}\leftarrow\ii\cdot - g_L[\fmslash{Z}(1-\gamma_5)]_{\alpha\beta}\bar\psi_{1,\alpha}$ - & $\psi_2\leftarrow\ii\cdot \cdots$ \\\hline - [F13] & $Z_\mu\leftarrow\ii\cdot g_L\bar\psi_1\gamma_\mu(1-\gamma_5)\psi_2$ - & $Z_\mu\leftarrow\ii\cdot \cdots$ \\\hline - [F31] & $Z_\mu\leftarrow\ii\cdot - g_L[\gamma_\mu(1-\gamma_5)\psi_2]_\alpha\bar\psi_{1,\alpha}$ - & $Z_\mu\leftarrow\ii\cdot \cdots$ \\\hline - [F23] & $\psi_1\leftarrow\ii\cdot g_L\fmslash{Z}(1-\gamma_5)\psi_2$ - & $\psi_1\leftarrow\ii\cdot\cdots$ \\\hline - [F32] & $\psi_{1,\alpha}\leftarrow\ii\cdot - g_L\psi_{2,\beta}[\fmslash{Z}(1-\gamma_5)]_{\alpha\beta}$ - & $\psi_1\leftarrow\ii\cdot\cdots$ \\\hline - \multicolumn{3}{|l|}{[FBF (Psibar, VR, Psi)]: - $\mathcal{L}_I=g_R\bar\psi_1\fmslash{Z}(1+\gamma_5)\psi_2$}\\\hline - [F12] & $\bar\psi_2\leftarrow\ii\cdot g_R\bar\psi_1\fmslash{Z}(1+\gamma_5)$ - & $\psi_2\leftarrow\ii\cdot \cdots$ \\\hline - [F21] & $\bar\psi_{2,\beta}\leftarrow\ii\cdot - g_R[\fmslash{Z}(1+\gamma_5)]_{\alpha\beta}\bar\psi_{1,\alpha}$ - & $\psi_2\leftarrow\ii\cdot \cdots$ \\\hline - [F13] & $Z_\mu\leftarrow\ii\cdot g_R\bar\psi_1\gamma_\mu(1+\gamma_5)\psi_2$ - & $Z_\mu\leftarrow\ii\cdot \cdots$ \\\hline - [F31] & $Z_\mu\leftarrow\ii\cdot - g_R[\gamma_\mu(1+\gamma_5)\psi_2]_\alpha\bar\psi_{1,\alpha}$ - & $Z_\mu\leftarrow\ii\cdot \cdots$ \\\hline - [F23] & $\psi_1\leftarrow\ii\cdot g_R\fmslash{Z}(1+\gamma_5)\psi_2$ - & $\psi_1\leftarrow\ii\cdot\cdots$ \\\hline - [F32] & $\psi_{1,\alpha}\leftarrow\ii\cdot - g_R\psi_{2,\beta}[\fmslash{Z}(1+\gamma_5)]_{\alpha\beta}$ - & $\psi_1\leftarrow\ii\cdot\cdots$ \\\hline - \multicolumn{3}{|l|}{[FBF (Psibar, VLR, Psi)]: - $\mathcal{L}_I=g_L\bar\psi_1\fmslash{Z}(1-\gamma_5)\psi_2 - +g_R\bar\psi_1\fmslash{Z}(1+\gamma_5)\psi_2$}\\\hline - \end{tabular} - \end{center} - \caption{\label{tab:dim4-fermions-VA} Combined dimension-4 trilinear - fermionic couplings continued.} - \end{table} - \begin{table} - \begin{center} - \renewcommand{\arraystretch}{1.4} - \begin{tabular}{|>{\qquad}r<{:}l|r<{:}l|}\hline - \multicolumn{4}{|l|}{[FBF (Psibar, S, Chi)]: $\bar\psi S\chi$}\\\hline - [F12] & $\chi\leftarrow\psi S$ - & [F21] & $\chi\leftarrow S \psi$ \\\hline - [F13] & $S\leftarrow \psi^T{\rm C}\chi$ - & [F31] & $S\leftarrow \chi^T {\rm C}\psi$ \\\hline - [F23] & $\psi\leftarrow S\chi$ - & [F32] & $\psi\leftarrow\chi S$ \\\hline - \multicolumn{4}{|l|}{[FBF (Psibar, P, Chi)]: $\bar\psi P\gamma_5\chi$}\\\hline - [F12] & $\chi\leftarrow \gamma_5 \psi P$ - & [F21] & $\chi\leftarrow P \gamma_5 \psi$ \\\hline - [F13] & $P\leftarrow \psi^T {\rm C}\gamma_5\chi$ - & [F31] & $P\leftarrow \chi^T {\rm C}\gamma_5\psi$ \\\hline - [F23] & $\psi\leftarrow P\gamma_5\chi$ - & [F32] & $\psi\leftarrow\gamma_5\chi P$ \\\hline - \multicolumn{4}{|l|}{[FBF (Psibar, V, Chi)]: $\bar\psi\fmslash{V}\chi$}\\\hline - [F12] & $\chi_{\alpha}\leftarrow-\psi_{\beta}\fmslash{V}_{\alpha\beta}$ - & [F21] & $\chi\leftarrow-\fmslash{V}\psi$ \\\hline - [F13] & $V_{\mu}\leftarrow \psi^T {\rm C}\gamma_{\mu}\chi$ - & [F31] & $V_{\mu}\leftarrow \chi^T {\rm C}(-\gamma_{\mu}\psi)$ \\\hline - [F23] & $\psi\leftarrow\fmslash{V}\chi$ - & [F32] & $\psi_\alpha\leftarrow\chi_\beta\fmslash{V}_{\alpha\beta}$ \\\hline - \multicolumn{4}{|l|}{[FBF (Psibar, A, Chi)]: $\bar\psi\gamma^5\fmslash{A}\chi$}\\\hline - [F12] & $\chi_{\alpha}\leftarrow\psi_{\beta}\lbrack \gamma^5 \fmslash{A} \rbrack_{\alpha\beta}$ - & [F21] & $\chi\leftarrow\gamma^5\fmslash{A}\psi$ \\\hline - [F13] & $A_{\mu}\leftarrow \psi^T {\rm C}\gamma^5\gamma_{\mu}\chi$ - & [F31] & $A_{\mu}\leftarrow \chi^T {\rm C}(\gamma^5 \gamma_{\mu}\psi)$ \\\hline - [F23] & $\psi\leftarrow\gamma^5\fmslash{A}\chi$ - & [F32] & $\psi_\alpha\leftarrow\chi_\beta\lbrack \gamma^5 \fmslash{A} \rbrack_{\alpha\beta}$ \\\hline - \end{tabular} - \end{center} - \caption{\label{tab:dim4-fermions-maj} Dimension-4 trilinear couplings - including one Dirac and one Majorana fermion} - \end{table} - \begin{table} - \begin{center} - \renewcommand{\arraystretch}{1.4} - \begin{tabular}{|>{\qquad}r<{:}l|r<{:}l|}\hline - \multicolumn{4}{|l|}{[FBF (Psibar, SP, Chi)]: - $\bar\psi\phi(g_S+g_P\gamma_5)\chi$}\\\hline - [F12] & $\chi \leftarrow (g_S+g_P\gamma_5)\psi \phi$ - & [F21] & $\chi\leftarrow\phi(g_S+g_P\gamma_5)\psi$ \\\hline - [F13] & $\phi\leftarrow \psi^T {\rm C}(g_S+g_P\gamma_5)\chi$ - & [F31] & $\phi\leftarrow \chi^T {\rm C}(g_S+g_P\gamma_5) \chi$ \\\hline - [F23] & $\psi\leftarrow \phi(g_S+g_P\gamma_5)\chi$ - & [F32] & $\psi\leftarrow(g_S+g_P\gamma_5)\chi\phi$ \\\hline - \multicolumn{4}{|l|}{[FBF (Psibar, VA, Chi)]: - $\bar\psi\fmslash{Z}(g_V - g_A\gamma_5)\chi$}\\\hline - [F12] & $\chi_\alpha\leftarrow - \psi_\beta[\fmslash{Z}(-g_V-g_A\gamma_5)]_{\alpha\beta}$ - & [F21] & $\chi\leftarrow\fmslash{Z}(-g_V-g_A\gamma_5)] - \psi$ \\\hline - [F13] & $Z_\mu\leftarrow \psi^T {\rm C}\gamma_\mu(g_V-g_A\gamma_5)\chi$ - & [F31] & $Z_\mu\leftarrow \chi^T {\rm C}\gamma_\mu(-g_V-g_A\gamma_5)\psi$ \\\hline - [F23] & $\psi\leftarrow\fmslash{Z}(g_V-g_A\gamma_5)\chi$ - & [F32] & $\psi_\alpha\leftarrow - \chi_\beta[\fmslash{Z}(g_V-g_A\gamma_5)]_{\alpha\beta}$ \\\hline - \end{tabular} - \end{center} - \caption{\label{tab:dim4-fermions-SPVA-maj} Combined dimension-4 trilinear - fermionic couplings including one Dirac and one Majorana fermion.} - \end{table} - \begin{table} - \begin{center} - \renewcommand{\arraystretch}{1.4} - \begin{tabular}{|>{\qquad}r<{:}l|r<{:}l|}\hline - \multicolumn{4}{|l|}{[FBF (Chibar, S, Psi)]: $\bar\chi S\psi$}\\\hline - [F12] & $\psi\leftarrow\chi S$ - & [F21] & $\psi\leftarrow S\chi$ \\\hline - [F13] & $S\leftarrow \chi^T {\rm C}\psi$ - & [F31] & $S\leftarrow \psi^T {\rm C}\chi$ \\\hline - [F23] & $\chi\leftarrow S \psi$ - & [F32] & $\chi\leftarrow\psi S$ \\\hline - \multicolumn{4}{|l|}{[FBF (Chibar, P, Psi)]: $\bar\chi P\gamma_5\psi$}\\\hline - [F12] & $\psi\leftarrow\gamma_5\chi P$ - & [F21] & $\psi\leftarrow P\gamma_5\chi$ \\\hline - [F13] & $P\leftarrow \chi^T {\rm C}\gamma_5\psi$ - & [F31] & $P\leftarrow \psi^T {\rm C}\gamma_5\chi$ \\\hline - [F23] & $\chi\leftarrow P \gamma_5 \psi$ - & [F32] & $\chi\leftarrow \gamma_5 \psi P$ \\\hline - \multicolumn{4}{|l|}{[FBF (Chibar, V, Psi)]: $\bar\chi\fmslash{V}\psi$}\\\hline - [F12] & $\psi_\alpha\leftarrow-\chi_\beta\fmslash{V}_{\alpha\beta}$ - & [F21] & $\psi\leftarrow-\fmslash{V}\chi$ \\\hline - [F13] & $V_{\mu}\leftarrow \chi^T {\rm C}\gamma_{\mu}\psi$ - & [F31] & $V_{\mu}\leftarrow \psi^T {\rm C}(-\gamma_{\mu}\chi)$ \\\hline - [F23] & $\chi\leftarrow\fmslash{V}\psi$ - & [F32] & $\chi_{\alpha}\leftarrow\psi_{\beta}\fmslash{V}_{\alpha\beta}$ \\\hline - \multicolumn{4}{|l|}{[FBF (Chibar, A, Psi)]: $\bar\chi\gamma^5\fmslash{A}\psi$}\\\hline - [F12] & $\psi_\alpha\leftarrow\chi_\beta\lbrack\gamma^5\fmslash{A} \rbrack_{\alpha\beta}$ - & [F21] & $\psi\leftarrow\gamma^5\fmslash{A}\chi$ \\\hline - [F13] & $A_{\mu}\leftarrow \chi^T {\rm C}(\gamma^5\gamma_{\mu}\psi)$ - & [F31] & $A_{\mu}\leftarrow \psi^T {\rm C}\gamma^5\gamma_{\mu}\chi$ \\\hline - [F23] & $\chi\leftarrow\gamma^5\fmslash{A}\psi$ - & [F32] & $\chi_{\alpha}\leftarrow\psi_{\beta}\lbrack\gamma^5\fmslash{A} \rbrack_{\alpha\beta}$ \\\hline - \end{tabular} - \end{center} - \caption{\label{tab:dim4-fermions-maj'} Dimension-4 trilinear couplings - including one Dirac and one Majorana fermion} - \end{table} - \begin{table} - \begin{center} - \renewcommand{\arraystretch}{1.4} - \begin{tabular}{|>{\qquad}r<{:}l|r<{:}l|}\hline - \multicolumn{4}{|l|}{[FBF (Chibar, SP, Psi)]: $\bar\chi\phi(g_S+g_P\gamma_5)\psi$}\\\hline - [F12] & $\psi\leftarrow(g_S+g_P\gamma_5)\chi\phi$ - & [F21] & $\psi\leftarrow \phi(g_S+g_P\gamma_5)\chi$ \\\hline - [F13] & $\phi\leftarrow \chi^T {\rm C}(g_S+g_P\gamma_5) \psi$ - & [F31] & $\phi\leftarrow \psi^T {\rm C}(g_S+g_P\gamma_5)\chi$ \\\hline - [F23] & $\chi\leftarrow\phi(g_S+g_P\gamma_5)\psi$ - & [F32] & $\chi \leftarrow (g_S+g_P\gamma_5)\psi \phi$ \\\hline - \multicolumn{4}{|l|}{[FBF (Chibar, VA, Psi)]: - $\bar\chi\fmslash{Z}(g_V - g_A\gamma_5)\psi$}\\\hline - [F12] & $\psi_\alpha\leftarrow - \chi_\beta[\fmslash{Z}(-g_V-g_A\gamma_5)]_{\alpha\beta}$ - & [F21] & $\psi\leftarrow\fmslash{Z}(-g_V-g_A\gamma_5)\chi$ \\\hline - [F13] & $Z_\mu\leftarrow \chi^T {\rm C}\gamma_\mu(g_V-g_A\gamma_5)\psi$ - & [F31] & $Z_\mu\leftarrow \psi^T {\rm C}\gamma_\mu(-g_V-g_A\gamma_5)\chi$ \\\hline - [F23] & $\chi\leftarrow\fmslash{Z}(g_V-g_A\gamma_5)] - \psi$ - & [F32] & $\chi_\alpha\leftarrow\psi_\beta[\fmslash{Z}(g_V-g_A\gamma_5)]_{\alpha\beta}$ \\\hline - \end{tabular} - \end{center} - \caption{\label{tab:dim4-fermions-SPVA-maj'} Combined dimension-4 trilinear - fermionic couplings including one Dirac and one Majorana fermion.} - \end{table} - \begin{table} - \begin{center} - \renewcommand{\arraystretch}{1.4} - \begin{tabular}{|>{\qquad}r<{:}l|r<{:}l|}\hline - \multicolumn{4}{|l|}{[FBF (Chibar, S, Chi)]: $\bar\chi_a S\chi_b$}\\\hline - [F12] & $\chi_b\leftarrow\chi_a S$ - & [F21] & $\chi_b\leftarrow S \chi_a$ \\\hline - [F13] & $S\leftarrow \chi^T_a {\rm C}\chi_b$ - & [F31] & $S\leftarrow \chi^T_b {\rm C}\chi_a$ \\\hline - [F23] & $\chi_a\leftarrow S\chi_b$ - & [F32] & $\chi_a\leftarrow\chi S_b$ \\\hline - \multicolumn{4}{|l|}{[FBF (Chibar, P, Chi)]: $\bar\chi_a P\gamma_5\psi_b$}\\\hline - [F12] & $\chi_b\leftarrow \gamma_5 \chi_a P$ - & [F21] & $\chi_b\leftarrow P \gamma_5 \chi_a$ \\\hline - [F13] & $P\leftarrow \chi^T_a {\rm C}\gamma_5\chi_b$ - & [F31] & $P\leftarrow \chi^T_b {\rm C}\gamma_5\chi_a$ \\\hline - [F23] & $\chi_a\leftarrow P\gamma_5\chi_b$ - & [F32] & $\chi_a\leftarrow\gamma_5\chi_b P$ \\\hline - \multicolumn{4}{|l|}{[FBF (Chibar, V, Chi)]: $\bar\chi_a\fmslash{V}\chi_b$}\\\hline - [F12] & $\chi_{b,\alpha}\leftarrow-\chi_{a,\beta}\fmslash{V}_{\alpha\beta}$ - & [F21] & $\chi_b\leftarrow-\fmslash{V}\chi_a$ \\\hline - [F13] & $V_{\mu}\leftarrow \chi^T_a {\rm C}\gamma_{\mu}\chi_b$ - & [F31] & $V_{\mu}\leftarrow - \chi^T_b {\rm C}\gamma_{\mu}\chi_a$ \\\hline - [F23] & $\chi_a\leftarrow\fmslash{V}\chi_b$ - & [F32] & $\chi_{a,\alpha}\leftarrow\chi_{b,\beta}\fmslash{V}_{\alpha\beta}$ \\\hline - \multicolumn{4}{|l|}{[FBF (Chibar, A, Chi)]: $\bar\chi_a\gamma^5\fmslash{A}\chi_b$}\\\hline - [F12] & $\chi_{b,\alpha}\leftarrow\chi_{a,\beta}\lbrack\gamma^5\fmslash{A} \rbrack_{\alpha\beta}$ - & [F21] & $\chi_b\leftarrow\gamma^5\fmslash{A}\chi_a$ \\\hline - [F13] & $A_{\mu}\leftarrow \chi^T_a {\rm C}\gamma^5\gamma_{\mu}\chi_b$ - & [F31] & $A_{\mu}\leftarrow \chi^T_b {\rm C}(\gamma^5\gamma_{\mu}\chi_a)$ \\\hline - [F23] & $\chi_a\leftarrow\gamma^5\fmslash{A}\chi_b$ - & [F32] & $\chi_{a,\alpha}\leftarrow\chi_{b,\beta}\lbrack\gamma^5\fmslash{A} \rbrack_{\alpha\beta}$ \\\hline - \end{tabular} - \end{center} - \caption{\label{tab:dim4-fermions-maj2} Dimension-4 trilinear couplings - of two Majorana fermions} - \end{table} - \begin{table} - \begin{center} - \renewcommand{\arraystretch}{1.4} - \begin{tabular}{|>{\qquad}r<{:}l|r<{:}l|}\hline - \multicolumn{4}{|l|}{[FBF (Chibar, SP, Chi)]: - $\bar\chi\phi_a(g_S+g_P\gamma_5)\chi_b$}\\\hline - [F12] & $\chi_b \leftarrow (g_S+g_P\gamma_5)\chi_a \phi$ - & [F21] & $\chi_b\leftarrow\phi(g_S+g_P\gamma_5)\chi_a$ \\\hline - [F13] & $\phi\leftarrow \chi^T_a {\rm C}(g_S+g_P\gamma_5)\chi_b$ - & [F31] & $\phi\leftarrow \chi^T_b {\rm C}(g_S+g_P\gamma_5) \chi_a$ \\\hline - [F23] & $\chi_a\leftarrow \phi(g_S+g_P\gamma_5)\chi_b$ - & [F32] & $\chi_a\leftarrow(g_S+g_P\gamma_5)\chi_b\phi$ \\\hline - \multicolumn{4}{|l|}{[FBF (Chibar, VA, Chi)]: - $\bar\chi_a\fmslash{Z}(g_V-g_A\gamma_5)\chi_b$}\\\hline - [F12] & $\chi_{b,\alpha}\leftarrow\chi_{a,\beta}[\fmslash{Z}(-g_V-g_A\gamma_5)]_{\alpha\beta}$ - & [F21] & $\chi_b\leftarrow\fmslash{Z}(-g_V-g_A\gamma_5)]\chi_a$ \\\hline - [F13] & $Z_\mu\leftarrow \chi^T_a {\rm C}\gamma_\mu(g_V-g_A\gamma_5)\chi_b$ - & [F31] & $Z_\mu\leftarrow \chi^T_b {\rm C}\gamma_\mu(-g_V-g_A\gamma_5)\chi_a$ \\\hline - [F23] & $\chi_a\leftarrow\fmslash{Z}(g_V-g_A\gamma_5)\chi_b$ - & [F32] & $\chi_{a,\alpha}\leftarrow - \chi_{b,\beta}[\fmslash{Z}(g_V-g_A\gamma_5)]_{\alpha\beta}$ \\\hline - \end{tabular} - \end{center} - \caption{\label{tab:dim4-fermions-SPVA-maj2} Combined dimension-4 trilinear - fermionic couplings of two Majorana fermions.} - \end{table} - \begin{table} - \begin{center} - \renewcommand{\arraystretch}{1.3} - \begin{tabular}{|>{\qquad}r<{:}l|}\hline - \multicolumn{2}{|l|}{[Gauge_Gauge_Gauge]: - $\mathcal{L}_I=gf_{abc} - A_a^\mu A_b^\nu\partial_\mu A_{c,\nu}$}\\\hline - [_] & $A_a^\mu\leftarrow\ii\cdot - (-\ii g/2)\cdot C_{abc}^{\mu\rho\sigma}(-k_2-k_3,k_2,k_3) - A^b_\rho A^c_\sigma$\\\hline - \multicolumn{2}{|l|}{[Aux_Gauge_Gauge]: - $\mathcal{L}_I=gf_{abc}X_{a,\mu\nu}(k_1) - ( A_b^{\mu}(k_2)A_c^{\nu}(k_3) - -A_b^{\nu}(k_2)A_c^{\mu}(k_3))$}\\\hline - [F23]$\lor$[F32] & $X_a^{\mu\nu}(k_2+k_3)\leftarrow\ii\cdot - gf_{abc}( A_b^\mu(k_2)A_c^\nu(k_3) - -A_b^\nu(k_2)A_c^\mu(k_3))$ \\\hline - [F12]$\lor$[F13] & $A_{a,\mu}(k_1+k_{2/3})\leftarrow\ii\cdot - gf_{abc}X_{b,\nu\mu}(k_1)A_c^\nu(k_{2/3})$ \\\hline - [F21]$\lor$[F31] & $A_{a,\mu}(k_{2/3}+k_1)\leftarrow\ii\cdot - gf_{abc}A_b^\nu(k_{2/3}) X_{c,\mu\nu}(k_1)$ \\\hline - \end{tabular} - \end{center} - \caption{\label{tab:dim4-bosons} Dimension-4 Vector Boson couplings with - \emph{outgoing} momenta. - See~(\ref{eq:C123}) and~(\ref{eq:C123'}) for the definition of the - antisymmetric tensor $C^{\mu_1\mu_2\mu_3}(k_1,k_2,k_3)$.} - \end{table} - \begin{table} - \begin{center} - \renewcommand{\arraystretch}{1.3} - \begin{tabular}{|>{\qquad}r<{:}l|r<{:}l|}\hline - \multicolumn{4}{|l|}{[Scalar_Vector_Vector]: - $\mathcal{L}_I=g\phi V_1^\mu V_{2,\mu}$}\\\hline - [F13] & $\leftarrow\ii\cdot g\cdots$ - & [F31] & $\leftarrow\ii\cdot g\cdots$ \\\hline - [F12] & $\leftarrow\ii\cdot g\cdots$ - & [F21] & $\leftarrow\ii\cdot g\cdots$ \\\hline - [F23] & $\phi\leftarrow\ii\cdot g V_1^\mu V_{2,\mu}$ - & [F32] & $\phi\leftarrow\ii\cdot g V_{2,\mu} V_1^\mu$ \\\hline - \multicolumn{4}{|l|}{[Aux_Vector_Vector]: - $\mathcal{L}_I=gX V_1^\mu V_{2,\mu}$}\\\hline - [F13] & $\leftarrow\ii\cdot g\cdots$ - & [F31] & $\leftarrow\ii\cdot g\cdots$ \\\hline - [F12] & $\leftarrow\ii\cdot g\cdots$ - & [F21] & $\leftarrow\ii\cdot g\cdots$ \\\hline - [F23] & $X\leftarrow\ii\cdot g V_1^\mu V_{2,\mu}$ - & [F32] & $X\leftarrow\ii\cdot g V_{2,\mu} V_1^\mu$ \\\hline - \multicolumn{4}{|l|}{[Aux_Scalar_Vector]: - $\mathcal{L}_I=gX^\mu \phi V_\mu$}\\\hline - [F13] & $\leftarrow\ii\cdot g\cdots$ - & [F31] & $\leftarrow\ii\cdot g\cdots$ \\\hline - [F12] & $\leftarrow\ii\cdot g\cdots$ - & [F21] & $\leftarrow\ii\cdot g\cdots$ \\\hline - [F23] & $\leftarrow\ii\cdot g\cdots$ - & [F32] & $\leftarrow\ii\cdot g\cdots$ \\\hline - \end{tabular} - \end{center} - \caption{\label{tab:scalar-vector} - \ldots} - \end{table} - \begin{table} - \begin{center} - \renewcommand{\arraystretch}{1.3} - \begin{tabular}{|>{\qquad}r<{:}l|r<{:}l|}\hline - \multicolumn{4}{|l|}{[Scalar_Scalar_Scalar]: - $\mathcal{L}_I=g\phi_1\phi_2\phi_3$}\\\hline - [F13] & $\phi_2\leftarrow\ii\cdot g \phi_1\phi_3$ - & [F31] & $\phi_2\leftarrow\ii\cdot g \phi_3\phi_1$ \\\hline - [F12] & $\phi_3\leftarrow\ii\cdot g \phi_1\phi_2$ - & [F21] & $\phi_3\leftarrow\ii\cdot g \phi_2\phi_1$ \\\hline - [F23] & $\phi_1\leftarrow\ii\cdot g \phi_2\phi_3$ - & [F32] & $\phi_1\leftarrow\ii\cdot g \phi_3\phi_2$ \\\hline - \multicolumn{4}{|l|}{[Aux_Scalar_Scalar]: - $\mathcal{L}_I=gX\phi_1\phi_2$}\\\hline - [F13] & $\leftarrow\ii\cdot g\cdots$ - & [F31] & $\leftarrow\ii\cdot g\cdots$ \\\hline - [F12] & $\leftarrow\ii\cdot g\cdots$ - & [F21] & $\leftarrow\ii\cdot g\cdots$ \\\hline - [F23] & $X\leftarrow\ii\cdot g \phi_1\phi_2$ - & [F32] & $X\leftarrow\ii\cdot g \phi_2\phi_1$ \\\hline - \end{tabular} - \end{center} - \caption{\label{tab:scalars} - \ldots} - \end{table} - \begin{table} - \begin{center} - \renewcommand{\arraystretch}{1.3} - \begin{tabular}{|>{\qquad}r<{:}l|}\hline - \multicolumn{2}{|l|}{[Vector_Scalar_Scalar]: - $\mathcal{L}_I=gV^\mu\phi_1 - \ii\overleftrightarrow{\partial_\mu}\phi_2$}\\\hline - [F23] & $V^\mu(k_2+k_3)\leftarrow\ii\cdot - g(k_2^\mu-k_3^\mu)\phi_1(k_2)\phi_2(k_3)$ \\\hline - [F32] & $V^\mu(k_2+k_3)\leftarrow\ii\cdot - g(k_2^\mu-k_3^\mu)\phi_2(k_3)\phi_1(k_2)$ \\\hline - [F12] & $\phi_2(k_1+k_2)\leftarrow\ii\cdot - g(k_1^\mu+2k_2^\mu)V_\mu(k_1)\phi_1(k_2)$ \\\hline - [F21] & $\phi_2(k_1+k_2)\leftarrow\ii\cdot - g(k_1^\mu+2k_2^\mu)\phi_1(k_2)V_\mu(k_1)$ \\\hline - [F13] & $\phi_1(k_1+k_3)\leftarrow\ii\cdot - g(-k_1^\mu-2k_3^\mu)V_\mu(k_1)\phi_2(k_3)$ \\\hline - [F31] & $\phi_1(k_1+k_3)\leftarrow\ii\cdot - g(-k_1^\mu-2k_3^\mu)\phi_2(k_3)V_\mu(k_1)$ \\\hline - \end{tabular} - \end{center} - \caption{\label{tab:scalar-current} - \ldots} - \end{table} *) -(* \begin{table} - \begin{center} - \renewcommand{\arraystretch}{1.3} - \begin{tabular}{|>{\qquad}r<{:}l|}\hline - \multicolumn{2}{|l|}{[Aux_DScalar_DScalar]: - $\mathcal{L}_I=g\chi - (\ii\partial_\mu\phi_1)(\ii\partial^\mu\phi_2)$}\\\hline - [F23] & $\chi(k_2+k_3)\leftarrow\ii\cdot - g (k_2\cdot k_3) \phi_1(k_2) \phi_2(k_3) $ \\\hline - [F32] & $\chi(k_2+k_3)\leftarrow\ii\cdot - g (k_3\cdot k_2) \phi_2(k_3) \phi_1(k_2) $ \\\hline - [F12] & $\phi_2(k_1+k_2)\leftarrow\ii\cdot - g ((-k_1-k_2) \cdot k_2) \chi(k_1) \phi_1(k_2) $ \\\hline - [F21] & $\phi_2(k_1+k_2)\leftarrow\ii\cdot - g (k_2 \cdot (-k_1-k_2)) \phi_1(k_2) \chi(k_1) $ \\\hline - [F13] & $\phi_1(k_1+k_3)\leftarrow\ii\cdot - g ((-k_1-k_3) \cdot k_3) \chi(k_1) \phi_2(k_3) $ \\\hline - [F31] & $\phi_1(k_1+k_3)\leftarrow\ii\cdot - g (k_3 \cdot (-k_1-k_3)) \phi_2(k_3) \chi(k_1) $ \\\hline - \end{tabular} - \end{center} - \caption{\label{tab:dscalar-dscalar} - \ldots} - \end{table} - \begin{table} - \begin{center} - \renewcommand{\arraystretch}{1.3} - \begin{tabular}{|>{\qquad}r<{:}l|}\hline - \multicolumn{2}{|l|}{[Aux_Vector_DScalar]: - $\mathcal{L}_I=g\chi V_\mu (\ii\partial^\mu\phi)$}\\\hline - [F23] & $\chi(k_2+k_3)\leftarrow\ii\cdot - g k_3^\mu V_\mu(k_2) \phi(k_3) $ \\\hline - [F32] & $\chi(k_2+k_3)\leftarrow\ii\cdot - g \phi(k_3) k_3^\mu V_\mu(k_2) $ \\\hline - [F12] & $\phi(k_1+k_2)\leftarrow\ii\cdot - g \chi(k_1) (-k_1-k_2)^\mu V_\mu(k_2) $ \\\hline - [F21] & $\phi(k_1+k_2)\leftarrow\ii\cdot - g (-k_1-k_2)^\mu V_\mu(k_2) \chi(k_1) $ \\\hline - [F13] & $V_\mu(k_1+k_3)\leftarrow\ii\cdot - g (-k_1-k_3)_\mu \chi(k_1) \phi(k_3) $ \\\hline - [F31] & $V_\mu(k_1+k_3)\leftarrow\ii\cdot - g (-k_1-k_3)_\mu \phi(k_3) \chi(k_1) $ \\\hline - \end{tabular} - \end{center} - \caption{\label{tab:vector-dscalar} - \ldots} - \end{table} -*) - - - - -(* Signify which two of three fields are fused: *) -type fuse2 = F23 | F32 | F31 | F13 | F12 | F21 - -(* Signify which three of four fields are fused: *) -type fuse3 = - | F123 | F231 | F312 | F132 | F321 | F213 - | F124 | F241 | F412 | F142 | F421 | F214 - | F134 | F341 | F413 | F143 | F431 | F314 - | F234 | F342 | F423 | F243 | F432 | F324 - -(* Explicit enumeration types make no sense for higher degrees. *) -type fusen = int list - -(* The third member of the triplet will contain the coupling constant: *) -type 'a t = - | V3 of 'a vertex3 * fuse2 * 'a - | V4 of 'a vertex4 * fuse3 * 'a - | Vn of 'a vertexn * fusen * 'a - -(* \thocwmodulesection{Gauge Couplings} - Dimension-4 trilinear vector boson couplings - \begin{subequations} - \begin{multline} - f_{abc}\partial^{\mu}A^{a,\nu}A^b_{\mu}A^c_{\nu} \rightarrow - \ii f_{abc}k_1^\mu A^{a,\nu}(k_1)A^b_{\mu}(k_2)A^c_{\nu}(k_3) \\ - = -\frac{\ii}{3!} f_{a_1a_2a_3} C^{\mu_1\mu_2\mu_3}(k_1,k_2,k_3) - A^{a_1}_{\mu_1}(k_1)A^{a_2}_{\mu_2}(k_2)A^{a_3}_{\mu_3}(k_3) - \end{multline} - with the totally antisymmetric tensor (under simultaneous permutations - of all quantum numbers $\mu_i$ and $k_i$) and all momenta \emph{outgoing} - \begin{equation} - \label{eq:C123} - C^{\mu_1\mu_2\mu_3}(k_1,k_2,k_3) = - ( g^{\mu_1\mu_2} (k_1^{\mu_3}-k_2^{\mu_3}) - + g^{\mu_2\mu_3} (k_2^{\mu_1}-k_3^{\mu_1}) - + g^{\mu_3\mu_1} (k_3^{\mu_2}-k_1^{\mu_2}) ) - \end{equation} - \end{subequations} - Since~$f_{a_1a_2a_3}C^{\mu_1\mu_2\mu_3}(k_1,k_2,k_3)$ is totally symmetric - (under simultaneous permutations of all quantum numbers $a_i$, $\mu_i$ and $k_i$), - it is easy to take the partial derivative - \begin{subequations} - \label{eq:AofAA} - \begin{equation} - A^{a,\mu}(k_2+k_3) = - - \frac{\ii}{2!} f_{abc}C^{\mu\rho\sigma}(-k_2-k_3,k_2,k_3) A^b_\rho(k_2)A^c_\sigma(k_3) - \end{equation} - with - \begin{equation} - \label{eq:C123'} - C^{\mu\rho\sigma}(-k_2-k_3,k_2,k_3) = - ( g^{\rho\sigma} ( k_2^{\mu} -k_3^{\mu} ) - + g^{\mu\sigma} (2k_3^{\rho} +k_2^{\rho} ) - - g^{\mu\rho} (2k_2^{\sigma}+k_3^{\sigma}) ) - \end{equation} - i.\,e. - \begin{multline} - \label{eq:fuse-gauge} - A^{a,\mu}(k_2+k_3) = - \frac{\ii}{2!} f_{abc} - \bigl( (k_2^{\mu}-k_3^{\mu})A^b(k_2) \cdot A^c(k_3) \\ - + (2k_3+k_2)\cdot A^b(k_2)A^{c,\mu}(k_3) - - A^{b,\mu}(k_2)A^c(k_3)\cdot(2k_2+k_3) \bigr) - \end{multline} - \end{subequations} - \begin{dubious} - Investigate the rearrangements proposed in~\cite{HELAS} for improved - numerical stability. - \end{dubious} *) - -(* \thocwmodulesubsection{Non-Gauge Vector Couplings} - As a basis for the dimension-4 couplings of three vector bosons, we - choose ``transversal'' and ``longitudinal'' (with respect to the first - vector field) tensors that are odd and even under permutation of the - second and third argument - \begin{subequations} - \begin{align} - \mathcal{L}_T(V_1,V_2,V_3) - &= V_1^\mu (V_{2,\nu}\ii\overleftrightarrow{\partial_\mu}V_3^\nu) - = - \mathcal{L}_T(V_1,V_3,V_2) \\ - \mathcal{L}_L(V_1,V_2,V_3) - &= (\ii\partial_\mu V_1^\mu) V_{2,\nu}V_3^\nu - = \mathcal{L}_L(V_1,V_3,V_2) - \end{align} - \end{subequations} - Using partial integration in~$\mathcal{L}_L$, we find the - convenient combinations - \begin{subequations} - \begin{align} - \mathcal{L}_T(V_1,V_2,V_3) + \mathcal{L}_L(V_1,V_2,V_3) - &= - 2 V_1^\mu \ii\partial_\mu V_{2,\nu} V_3^\nu \\ - \mathcal{L}_T(V_1,V_2,V_3) - \mathcal{L}_L(V_1,V_2,V_3) - &= 2 V_1^\mu V_{2,\nu} \ii\partial_\mu V_3^\nu - \end{align} - \end{subequations} - As an important example, we can rewrite the dimension-4 ``anomalous'' triple - gauge couplings - \begin{multline} - \ii\mathcal{L}_{\textrm{TGC}}(g_1,\kappa,g_4)/g_{VWW} - = g_1 V^\mu (W^-_{\mu\nu} W^{+,\nu} - W^+_{\mu\nu} W^{-,\nu}) \\ - + \kappa W^+_\mu W^-_\nu V^{\mu\nu} - + g_4 W^+_\mu W^-_\nu (\partial^\mu V^\nu + \partial^\nu V^\mu) - \end{multline} - as - \begin{multline} - \mathcal{L}_{\textrm{TGC}}(g_1,\kappa,g_4) - = g_1 \mathcal{L}_T(V,W^-,W^+) \\ - - \frac{\kappa+g_1-g_4}{2} \mathcal{L}_T(W^-,V,W^+) - + \frac{\kappa+g_1+g_4}{2} \mathcal{L}_T(W^+,V,W^-) \\ - - \frac{\kappa-g_1-g_4}{2} \mathcal{L}_L(W^-,V,W^+) - + \frac{\kappa-g_1+g_4}{2} \mathcal{L}_L(W^+,V,W^-) - \end{multline} - \thocwmodulesubsection{$CP$ Violation} - \begin{subequations} - \begin{align} - \mathcal{L}_{\tilde T}(V_1,V_2,V_3) - &= V_{1,\mu}(V_{2,\rho}\ii\overleftrightarrow{\partial_\nu} - V_{3,\sigma})\epsilon^{\mu\nu\rho\sigma} - = + \mathcal{L}_T(V_1,V_3,V_2) \\ - \mathcal{L}_{\tilde L}(V_1,V_2,V_3) - &= (\ii\partial_\mu V_{1,\nu}) - V_{2,\rho}V_{3,\sigma}\epsilon^{\mu\nu\rho\sigma} - = - \mathcal{L}_L(V_1,V_3,V_2) - \end{align} - \end{subequations} - Here the notations~$\tilde T$ and~$\tilde L$ are clearly - \textit{abuse de langage}, because - $\mathcal{L}_{\tilde L}(V_1,V_2,V_3)$ is actually the - transversal combination, due to the antisymmetry of~$\epsilon$. - Using partial integration in~$\mathcal{L}_{\tilde L}$, we could again find - combinations - \begin{subequations} - \begin{align} - \mathcal{L}_{\tilde T}(V_1,V_2,V_3) + \mathcal{L}_{\tilde L}(V_1,V_2,V_3) - &= - 2 V_{1,\mu} V_{2,\nu} \ii\partial_\rho V_{3,\sigma} - \epsilon^{\mu\nu\rho\sigma} \\ - \mathcal{L}_{\tilde T}(V_1,V_2,V_3) - \mathcal{L}_{\tilde L}(V_1,V_2,V_3) - &= - 2 V_{1,\mu} \ii\partial_\nu V_{2,\rho} V_{3,\sigma} - \epsilon^{\mu\nu\rho\sigma} - \end{align} - \end{subequations} - but we don't need them, since - \begin{multline} - \ii\mathcal{L}_{\textrm{TGC}}(g_5,\tilde\kappa)/g_{VWW} - = g_5 \epsilon_{\mu\nu\rho\sigma} - (W^{+,\mu} \ii\overleftrightarrow{\partial^\rho} W^{-,\nu}) V^\sigma \\ - - \frac{\tilde\kappa_V}{2} W^-_\mu W^+_\nu \epsilon^{\mu\nu\rho\sigma} - V_{\rho\sigma} - \end{multline} - is immediately recognizable as - \begin{equation} - \mathcal{L}_{\textrm{TGC}}(g_5,\tilde\kappa) / g_{VWW} - = - \ii g_5 \mathcal{L}_{\tilde L}(V,W^-,W^+) - + \tilde\kappa \mathcal{L}_{\tilde T}(V,W^-,W^+) - \end{equation} -%%% #procedure decl -%%% symbol g1, kappa; -%%% vector V, Wp, Wm, k0, kp, km; -%%% vector v, V1, V2, V3, k1, k2, k3; -%%% index mu, nu; -%%% #endprocedure -%%% -%%% #call decl -%%% -%%% global L_T(k1,V1,k2,V2,k3,V3) -%%% = (V1.k2 - V1.k3) * V2.V3; -%%% -%%% global L_L(k1,V1,k2,V2,k3,V3) -%%% = - V1.k1 * V2.V3; -%%% -%%% global L_g1(k1,V1,k2,V2,k3,V3) -%%% = - V1(mu) * ( (k2(mu)*V2(nu) - k2(nu)*V2(mu)) * V3(nu) -%%% - (k3(mu)*V3(nu) - k3(nu)*V3(mu)) * V2(nu) ); -%%% -%%% global L_kappa(k1,V1,k2,V2,k3,V3) -%%% = (k1(mu)*V1(nu) - k1(nu)*V1(mu)) * V2(mu) * V3(nu); -%%% -%%% print; -%%% .sort -%%% .store -%%% -%%% #call decl -%%% -%%% local lp = L_T(k1,V1,k2,V2,k3,V3) + L_L(k1,V1,k2,V2,k3,V3); -%%% local lm = L_T(k1,V1,k2,V2,k3,V3) - L_L(k1,V1,k2,V2,k3,V3); -%%% print; -%%% .sort -%%% id k1.v? = - k2.v - k3.v; -%%% print; -%%% .sort -%%% .store -%%% -%%% #call decl -%%% -%%% local [sum(TL)-g1] = - L_g1(k0,V,km,Wm,kp,Wp) -%%% + L_T(k0,V,kp,Wp,km,Wm) -%%% + (L_T(km,Wm,k0,V,kp,Wp) - L_T(kp,Wp,k0,V,km,Wm)) / 2 -%%% - (L_L(km,Wm,k0,V,kp,Wp) - L_L(kp,Wp,k0,V,km,Wm)) / 2; -%%% -%%% local [sum(TL)-kappa] = - L_kappa(k0,V,km,Wm,kp,Wp) -%%% + (L_T(km,Wm,k0,V,kp,Wp) - L_T(kp,Wp,k0,V,km,Wm)) / 2 -%%% + (L_L(km,Wm,k0,V,kp,Wp) - L_L(kp,Wp,k0,V,km,Wm)) / 2; -%%% -%%% local delta = -%%% - (g1 * L_g1(k0,V,km,Wm,kp,Wp) + kappa * L_kappa(k0,V,km,Wm,kp,Wp)) -%%% + g1 * L_T(k0,V,kp,Wp,km,Wm) -%%% + ( g1 + kappa) / 2 * (L_T(km,Wm,k0,V,kp,Wp) - L_T(kp,Wp,k0,V,km,Wm)) -%%% + (- g1 + kappa) / 2 * (L_L(km,Wm,k0,V,kp,Wp) - L_L(kp,Wp,k0,V,km,Wm)); -%%% -%%% print; -%%% .sort -%%% -%%% id k0.v? = - kp.v - km.v; -%%% print; -%%% .sort -%%% .store -%%% -%%% .end *) - -(* \begin{table} - \begin{center} - \renewcommand{\arraystretch}{1.3} - \begin{tabular}{|>{\qquad}r<{:}l|}\hline - \multicolumn{2}{|l|}{[Dim4_Vector_Vector_Vector_T]: - $\mathcal{L}_I=gV_1^\mu - V_{2,\nu}\ii\overleftrightarrow{\partial_\mu}V_3^\nu$}\\\hline - [F23] & $V_1^\mu(k_2+k_3)\leftarrow\ii\cdot - g(k_2^\mu-k_3^\mu)V_{2,\nu}(k_2)V_3^\nu(k_3)$ \\\hline - [F32] & $V_1^\mu(k_2+k_3)\leftarrow\ii\cdot - g(k_2^\mu-k_3^\mu)V_3^\nu(k_3)V_{2,\nu}(k_2)$ \\\hline - [F12] & $V_3^\mu(k_1+k_2)\leftarrow\ii\cdot - g(2k_2^\nu+k_1^\nu)V_{1,\nu}(k_1)V_2^\mu(k_2)$ \\\hline - [F21] & $V_3^\mu(k_1+k_2)\leftarrow\ii\cdot - g(2k_2^\nu+k_1^\nu)V_2^\mu(k_2)V_{1,\nu}(k_1)$ \\\hline - [F13] & $V_2^\mu(k_1+k_3)\leftarrow\ii\cdot - g(-k_1^\nu-2k_3^\nu)V_1^\nu(k_1)V_3^\mu(k_3)$ \\\hline - [F31] & $V_2^\mu(k_1+k_3)\leftarrow\ii\cdot - g(-k_1^\nu-2k_3^\nu)V_3^\mu(k_3)V_1^\nu(k_1)$ \\\hline - \multicolumn{2}{|l|}{[Dim4_Vector_Vector_Vector_L]: - $\mathcal{L}_I=g\ii\partial_\mu V_1^\mu - V_{2,\nu}V_3^\nu$}\\\hline - [F23] & $V_1^\mu(k_2+k_3)\leftarrow\ii\cdot - g(k_2^\mu+k_3^\mu)V_{2,\nu}(k_2)V_3^\nu(k_3)$ \\\hline - [F32] & $V_1^\mu(k_2+k_3)\leftarrow\ii\cdot - g(k_2^\mu+k_3^\mu)V_3^\nu(k_3)V_{2,\nu}(k_2)$ \\\hline - [F12] & $V_3^\mu(k_1+k_2)\leftarrow\ii\cdot - g(-k_1^\nu)V_{1,\nu}(k_1)V_2^\mu(k_2)$ \\\hline - [F21] & $V_3^\mu(k_1+k_2)\leftarrow\ii\cdot - g(-k_1^\nu)V_2^\mu(k_2)V_{1,\nu}(k_1)$ \\\hline - [F13] & $V_2^\mu(k_1+k_3)\leftarrow\ii\cdot - g(-k_1^\nu)V_1^\nu(k_1)V_3^\mu(k_3)$ \\\hline - [F31] & $V_2^\mu(k_1+k_3)\leftarrow\ii\cdot - g(-k_1^\nu)V_3^\mu(k_3)V_1^\nu(k_1)$ \\\hline - \end{tabular} - \end{center} - \caption{\label{tab:dim4-TGC} - \ldots} - \end{table} - \begin{table} - \begin{center} - \renewcommand{\arraystretch}{1.3} - \begin{tabular}{|>{\qquad}r<{:}l|}\hline - \multicolumn{2}{|l|}{[Dim4_Vector_Vector_Vector_T5]: - $\mathcal{L}_I=gV_{1,\mu} - V_{2,\rho}\ii\overleftrightarrow{\partial_\nu} - V_{3,\sigma}\epsilon^{\mu\nu\rho\sigma}$}\\\hline - [F23] & $V_1^\mu(k_2+k_3)\leftarrow\ii\cdot - g\epsilon^{\mu\nu\rho\sigma}(k_{2,\nu}-k_{3,\nu}) - V_{2,\rho}(k_2)V_{3,\sigma}(k_3)$ \\\hline - [F32] & $V_1^\mu(k_2+k_3)\leftarrow\ii\cdot - g\epsilon^{\mu\nu\rho\sigma}(k_{2,\nu}-k_{3,\nu}) - V_{3,\sigma}(k_3)V_{2,\rho}(k_2)$ \\\hline - [F12] & $V_3^\mu(k_1+k_2)\leftarrow\ii\cdot - g\epsilon^{\mu\nu\rho\sigma}(2k_{2,\nu}+k_{1,\nu}) - V_{1,\rho}(k_1)V_{2,\sigma}(k_2)$ \\\hline - [F21] & $V_3^\mu(k_1+k_2)\leftarrow\ii\cdot - g\epsilon^{\mu\nu\rho\sigma}(2k_{2,\nu}+k_{1,\nu}) - V_{2,\sigma}(k_2)V_{1,\rho}(k_1)$ \\\hline - [F13] & $V_2^\mu(k_1+k_3)\leftarrow\ii\cdot - g\epsilon^{\mu\nu\rho\sigma}(-k_{1,\nu}-2k_{3,\nu}) - V_{1,\rho}(k_1)V_{3,\sigma}(k_3)$ \\\hline - [F31] & $V_2^\mu(k_1+k_3)\leftarrow\ii\cdot - g\epsilon^{\mu\nu\rho\sigma}(-k_{1,\nu}-2k_{3,\nu}) - V_{3,\sigma}(k_3)V_{1,\rho}(k_1)$ \\\hline - \multicolumn{2}{|l|}{[Dim4_Vector_Vector_Vector_L5]: - $\mathcal{L}_I=g\ii\partial_\mu V_{1,\nu} - V_{2,\nu}V_{3,\sigma}\epsilon^{\mu\nu\rho\sigma}$}\\\hline - [F23] & $V_1^\mu(k_2+k_3)\leftarrow\ii\cdot - g\epsilon^{\mu\nu\rho\sigma}(k_{2,\nu}+k_{3,\nu}) - V_{2,\rho}(k_2)V_{3,\sigma}(k_3)$ \\\hline - [F32] & $V_1^\mu(k_2+k_3)\leftarrow\ii\cdot - g\epsilon^{\mu\nu\rho\sigma}(k_{2,\nu}+k_{3,\nu}) - V_{2,\rho}(k_2)V_{3,\sigma}(k_3)$ \\\hline - [F12] & $V_3^\mu(k_1+k_2)\leftarrow\ii\cdot - g\epsilon^{\mu\nu\rho\sigma}(-k_{1,\nu}) - V_{1,\rho}(k_1)V_{2,\sigma}(k_2)$ \\\hline - [F21] & $V_3^\mu(k_1+k_2)\leftarrow\ii\cdot - g\epsilon^{\mu\nu\rho\sigma}(-k_{1,\nu}) - V_{2,\sigma}(k_2)V_{1,\rho}(k_1)$ \\\hline - [F13] & $V_2^\mu(k_1+k_3)\leftarrow\ii\cdot - g\epsilon^{\mu\nu\rho\sigma}(-k_{1,\nu}) - V_{1,\rho}(k_1)V_{3,\sigma}(k_3)$ \\\hline - [F31] & $V_2^\mu(k_1+k_3)\leftarrow\ii\cdot - g\epsilon^{\mu\nu\rho\sigma}(-k_{1,\nu}) - V_{3,\sigma}(k_3)V_{1,\rho}(k_1)$ \\\hline - \end{tabular} - \end{center} - \caption{\label{tab:dim4-TGC5} - \ldots} - \end{table} - \begin{table} - \begin{center} - \renewcommand{\arraystretch}{1.3} - \begin{tabular}{|>{\qquad}r<{:}l|}\hline - \multicolumn{2}{|l|}{[Dim6_Gauge_Gauge_Gauge]: - $\mathcal{L}_I=gF_1^{\mu\nu}F_{2,\nu\rho} - F_{3,\hphantom{\rho}\mu}^{\hphantom{3,}\rho}$}\\\hline - [_] & $A_1^\mu(k_2+k_3)\leftarrow-\ii\cdot - \Lambda^{\mu\rho\sigma}(-k_2-k_3,k_2,k_3) - A_{2,\rho} A_{c,\sigma}$\\\hline - \end{tabular} - \end{center} - \caption{\label{tab:dim6-TGC} - \ldots} - \end{table} - \begin{table} - \begin{center} - \renewcommand{\arraystretch}{1.3} - \begin{tabular}{|>{\qquad}r<{:}l|}\hline - \multicolumn{2}{|l|}{[Dim6_Gauge_Gauge_Gauge_5]: - $\mathcal{L}_I=g/2\cdot\epsilon^{\mu\nu\lambda\tau} - F_{1,\mu\nu}F_{2,\tau\rho} - F_{3,\hphantom{\rho}\lambda}^{\hphantom{3,}\rho}$}\\\hline - [F23] & $A_1^\mu(k_2+k_3)\leftarrow-\ii\cdot - \Lambda_5^{\mu\rho\sigma}(-k_2-k_3,k_2,k_3) - A_{2,\rho} A_{3,\sigma}$\\\hline - [F32] & $A_1^\mu(k_2+k_3)\leftarrow-\ii\cdot - \Lambda_5^{\mu\rho\sigma}(-k_2-k_3,k_2,k_3) - A_{3,\sigma} A_{2,\rho}$\\\hline - [F12] & $A_3^\mu(k_1+k_2)\leftarrow-\ii\cdot$\\\hline - [F21] & $A_3^\mu(k_1+k_2)\leftarrow-\ii\cdot$\\\hline - [F13] & $A_2^\mu(k_1+k_3)\leftarrow-\ii\cdot$\\\hline - [F31] & $A_2^\mu(k_1+k_3)\leftarrow-\ii\cdot$\\\hline - \end{tabular} - \end{center} - \caption{\label{tab:dim6-TGC5} - \ldots} - \end{table} *) - -(* \thocwmodulesection{$\textrm{SU}(2)$ Gauge Bosons} - An important special case for table~\ref{tab:dim4-bosons} are the two - usual coordinates of~$\textrm{SU}(2)$ - \begin{equation} - W_\pm = \frac{1}{\sqrt2} \left(W_1 \mp \ii W_2\right) - \end{equation} - i.\,e. - \begin{subequations} - \begin{align} - W_1 &= \frac{1}{\sqrt2} \left(W_+ + W_-\right) \\ - W_2 &= \frac{\ii}{\sqrt2} \left(W_+ - W_-\right) - \end{align} - \end{subequations} - and - \begin{equation} - W_1^\mu W_2^\nu - W_2^\mu W_1^\nu - = \ii\left(W_-^\mu W_+^\nu - W_+^\mu W_-^\nu\right) - \end{equation} - Thus the symmtry remains after the change of basis: - \begin{multline} - \epsilon^{abc} W_a^{\mu_1}W_b^{\mu_2}W_c^{\mu_3} - = \ii W_-^{\mu_1} (W_+^{\mu_2}W_3^{\mu_3} - W_3^{\mu_2}W_+^{\mu_3}) \\ - + \ii W_+^{\mu_1} (W_3^{\mu_2}W_-^{\mu_3} - W_-^{\mu_2}W_3^{\mu_3}) - + \ii W_3^{\mu_1} (W_-^{\mu_2}W_+^{\mu_3} - W_+^{\mu_2}W_-^{\mu_3}) - \end{multline} *) - -(* \thocwmodulesection{Quartic Couplings and Auxiliary Fields} - Quartic couplings can be replaced by cubic couplings to a non-propagating - auxiliary field. The quartic term should get a negative sign so that it the - energy is bounded from below for identical fields. In the language of - functional integrals - \begin{subequations} - \label{eq:quartic-aux} - \begin{multline} - \mathcal{L}_{\phi^4} = - g^2\phi_1\phi_2\phi_3\phi_4 - \Longrightarrow \\ - \mathcal{L}_{X\phi^2} - = X^*X \pm gX\phi_1\phi_2 \pm gX^*\phi_3\phi_4 - = (X^* \pm g\phi_1\phi_2)(X \pm g\phi_3\phi_4) - - g^2\phi_1\phi_2\phi_3\phi_4 - \end{multline} - and in the language of Feynman diagrams - \begin{equation} - \parbox{21mm}{\begin{fmfgraph*}(20,20) - \fmfleft{e1,e2} - \fmfright{e3,e4} - \fmf{plain}{v,e1} - \fmf{plain}{v,e2} - \fmf{plain}{v,e3} - \fmf{plain}{v,e4} - \fmfv{d.sh=circle,d.si=dot_size,label=$-\ii g^2$}{v} - \end{fmfgraph*}} - \qquad\Longrightarrow\qquad - \parbox{21mm}{\begin{fmfgraph*}(20,20) - \fmfleft{e1,e2} - \fmfright{e3,e4} - \fmf{plain}{v12,e1} - \fmf{plain}{v12,e2} - \fmf{plain}{v34,e3} - \fmf{plain}{v34,e4} - \fmf{dashes,label=$+\ii$}{v12,v34} - \fmfv{d.sh=circle,d.si=dot_size,label=$\pm\ii g$}{v12} - \fmfv{d.sh=circle,d.si=dot_size,label=$\pm\ii g$}{v34} - \end{fmfgraph*}} - \end{equation} - \end{subequations} - The other choice of signs - \begin{equation} - \mathcal{L}_{X\phi^2}' - = - X^*X \pm gX\phi_1\phi_2 \mp gX^*\phi_3\phi_4 - = - (X^* \pm g\phi_1\phi_2)(X \mp g\phi_3\phi_4) - - g^2\phi_1\phi_2\phi_3\phi_4 - \end{equation} - can not be extended easily to identical particles and is therefore - not used. For identical particles we have - \begin{multline} - \mathcal{L}_{\phi^4} = - \frac{g^2}{4!}\phi^4 - \Longrightarrow \\ - \mathcal{L}_{X\phi^2} - = \frac{1}{2}X^2 \pm \frac{g}{2}X\phi^2 \pm \frac{g}{2}X\phi^2 - = \frac{1}{2}\left(X \pm \frac{g}{2}\phi^2\right) - \left(X \pm \frac{g}{2}\phi^2\right) - - \frac{g^2}{4!}\phi^4 - \end{multline} - \begin{dubious} - Explain the factor~$1/3$ in the functional setting and its - relation to the three diagrams in the graphical setting? - \end{dubious} - - \thocwmodulesubsection{Quartic Gauge Couplings} - \begin{figure} - \begin{subequations} - \label{eq:Feynman-QCD} - \begin{align} - \parbox{28mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(24,24) - \threeexternal{k,,\mu,,a}{p}{p'} - \fmf{gluon}{v,e1} - \fmf{fermion}{e2,v,e3} - \fmfdot{v} \end{fmfgraph*}}} \,&= - \begin{split} - \mbox{} + & \ii g\gamma_\mu T_a - \end{split} \\ - \label{eq:TGV} - \parbox{28mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(24,24) - \threeexternal{1}{2}{3} - \fmf{gluon}{v,e1} - \fmf{gluon}{v,e2} - \fmf{gluon}{v,e3} - \threeoutgoing - \end{fmfgraph*}}} \,&= - \begin{split} - & g f_{a_1a_2a_3} C^{\mu_1\mu_2\mu_3} (k_1,k_2,k_3) - \end{split} \\ - \parbox{28mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(24,24) - \fmfsurround{d1,e1,d2,e2,d3,e3,d4,e4} - \fmf{gluon}{v,e1} - \fmf{gluon}{v,e2} - \fmf{gluon}{v,e3} - \fmf{gluon}{v,e4} - \fmflabel{1}{e1} - \fmflabel{2}{e2} - \fmflabel{3}{e3} - \fmflabel{4}{e4} - \fmfdot{v} - \fmffreeze - \fmf{warrow_right}{v,e1} - \fmf{warrow_right}{v,e2} - \fmf{warrow_right}{v,e3} - \fmf{warrow_right}{v,e4} - \end{fmfgraph*}}} \,&= - \begin{split} - \mbox{} - & \ii g^2 f_{a_1a_2b}f_{a_3a_4b} - (g_{\mu_1\mu_3} g_{\mu_4\mu_2} - g_{\mu_1\mu_4} g_{\mu_2\mu_3}) \\ - \mbox{} - & \ii g^2 f_{a_1a_3b}f_{a_4a_2b} - (g_{\mu_1\mu_4} g_{\mu_2\mu_3} - g_{\mu_1\mu_2} g_{\mu_3\mu_4}) \\ - \mbox{} - & \ii g^2 f_{a_1a_4b}f_{a_2a_3b} - (g_{\mu_1\mu_2} g_{\mu_3\mu_4} - g_{\mu_1\mu_3} g_{\mu_4\mu_2}) - \end{split} - \end{align} - \end{subequations} - \caption{\label{fig:gauge-feynman-rules} Gauge couplings. - See~(\ref{eq:C123}) for the definition of the antisymmetric - tensor $C^{\mu_1\mu_2\mu_3}(k_1,k_2,k_3)$.} - \end{figure} - \begin{figure} - \begin{equation} - \label{eq:Feynman-QCD'} - \parbox{28mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(24,24) - \fmfsurround{d1,e1,d2,e2,d3,e3,d4,e4} - \fmf{gluon}{v12,e1} - \fmf{gluon}{v12,e2} - \fmf{gluon}{v34,e3} - \fmf{gluon}{v34,e4} - \fmf{dashes}{v12,v34} - \fmflabel{1}{e1} - \fmflabel{2}{e2} - \fmflabel{3}{e3} - \fmflabel{4}{e4} - \fmfdot{v12,v34} - \fmffreeze - \fmf{warrow_right}{v12,e1} - \fmf{warrow_right}{v12,e2} - \fmf{warrow_right}{v34,e3} - \fmf{warrow_right}{v34,e4} - \end{fmfgraph*}}} \,= - \mbox{} - \ii g^2 f_{a_1a_2b}f_{a_3a_4b} - (g_{\mu_1\mu_3} g_{\mu_4\mu_2} - g_{\mu_1\mu_4} g_{\mu_2\mu_3}) - \end{equation} - \caption{\label{fig:gauge-feynman-rules'} Gauge couplings.} - \end{figure} - The three crossed versions of - figure~\ref{fig:gauge-feynman-rules'} reproduces the quartic coupling in - figure~\ref{fig:gauge-feynman-rules}, because - \begin{multline} - - \ii g^2 f_{a_1a_2b}f_{a_3a_4b} - (g_{\mu_1\mu_3} g_{\mu_4\mu_2} - g_{\mu_1\mu_4} g_{\mu_2\mu_3}) \\ - = (\ii g f_{a_1a_2b} T_{\mu_1\mu_2,\nu_1\nu_2}) - \left(\frac{\ii g^{\nu_1\nu_3} g^{\nu_2\nu_4}}{2}\right) - (\ii g f_{a_3a_4b} T_{\mu_3\mu_4,\nu_3\nu_4}) - \end{multline} - with $T_{\mu_1\mu_2,\mu_3\mu_4} = - g_{\mu_1\mu_3}g_{\mu_4\mu_2}-g_{\mu_1\mu_4}g_{\mu_2\mu_3}$. *) - -(* \thocwmodulesection{Gravitinos and supersymmetric currents} - In supergravity theories there is a fermionic partner of the graviton, the - gravitino. Therefore we have introduced the Lorentz type [Vectorspinor]. -*) - -(* \begin{table} - \begin{center} - \renewcommand{\arraystretch}{1.4} - \begin{tabular}{|>{\qquad}r<{:}l|r<{:}l|}\hline - \multicolumn{4}{|l|}{[GBG (Fermbar, MOM, Ferm)]: - $\bar\psi_1(\ii\fmslash{\partial}\pm m)\phi\psi_2$}\\\hline - [F12] & $\psi_2\leftarrow-(\fmslash{k}\mp m)\psi_1S$ - & [F21] & $\psi_2\leftarrow-S(\fmslash{k}\mp m)\psi_1$ \\\hline - [F13] & $S\leftarrow \psi^T_1 {\rm C}(\fmslash{k}\pm m)\psi_2$ - & [F31] & $S\leftarrow \psi^T_2 {\rm C}(-(\fmslash{k}\mp m)\psi_1)$ \\\hline - [F23] & $\psi_1\leftarrow S(\fmslash{k}\pm m)\psi_2$ - & [F32] & $\psi_1\leftarrow(\fmslash{k}\pm m)\psi_2 S$ \\\hline - \multicolumn{4}{|l|}{[GBG (Fermbar, MOM5, Ferm)]: - $\bar\psi_1(\ii\fmslash{\partial}\pm m)\phi\gamma^5\psi_2$}\\\hline - [F12] & $\psi_2\leftarrow(\fmslash{k}\pm m)\gamma^5\psi_1P$ - & [F21] & $\psi_2\leftarrow P(\fmslash{k}\pm m)\gamma^5\psi_1$ \\\hline - [F13] & $P\leftarrow \psi^T_1 {\rm C}(\fmslash{k}\pm m)\gamma^5\psi_2$ - & [F31] & $P\leftarrow \psi^T_2 {\rm C}(\fmslash{k}\pm m)\gamma^5\psi_1$ \\\hline - [F23] & $\psi_1\leftarrow P(\fmslash{k}\pm m)\gamma^5\psi_2$ - & [F32] & $\psi_1\leftarrow(\fmslash{k}\pm m)\gamma^5\psi_2 P$ \\\hline - \multicolumn{4}{|l|}{[GBG (Fermbar, MOML, Ferm)]: - $\bar\psi_1 (\ii\fmslash{\partial}\pm m)\phi(1-\gamma^5)\psi_2$}\\\hline - [F12] & $\psi_2\leftarrow-(1-\gamma^5)(\fmslash{k}\mp m)\psi_1\phi$ - & [F21] & $\psi_2\leftarrow-\phi(1-\gamma^5)(\fmslash{k}\mp m)\psi_1$ \\\hline - [F13] & $\phi\leftarrow \psi^T_1 {\rm C}(\fmslash{k}\pm m)(1-\gamma^5)\psi_2$ - & [F31] & $\phi\leftarrow \psi^T_2 {\rm C}(1-\gamma^5)(-(\fmslash{k}\mp m)\psi_1)$ \\\hline - [F23] & $\psi_1\leftarrow\phi(\fmslash{k}\pm m)(1-\gamma^5)\psi_2$ - & [F32] & $\psi_1\leftarrow(\fmslash{k}\pm m)(1-\gamma^5)\psi_2 \phi$ \\\hline - \multicolumn{4}{|l|}{[GBG (Fermbar, LMOM, Ferm)]: - $\bar\psi_1 \phi(1-\gamma^5)(\ii\fmslash{\partial}\pm m)\psi_2$}\\\hline - [F12] & $\psi_2\leftarrow-(\fmslash{k}\mp m)\psi_1(1-\gamma^5)\phi$ - & [F21] & $\psi_2\leftarrow-\phi(\fmslash{k}\mp m)(1-\gamma^5)\psi_1$ \\\hline - [F13] & $\phi\leftarrow \psi^T_1 {\rm C}(1-\gamma^5)(\fmslash{k}\pm m)\psi_2$ - & [F31] & $\phi\leftarrow \psi^T_2 {\rm C}(-(\fmslash{k}\mp m)(1-\gamma^5)\psi_1)$ \\\hline - [F23] & $\psi_1\leftarrow\phi(1-\gamma^5)(\fmslash{k}\pm m)\psi_2$ - & [F32] & $\psi_1\leftarrow(1-\gamma^5)(\fmslash{k}\pm m)\psi_2 \phi$ \\\hline - \multicolumn{4}{|l|}{[GBG (Fermbar, VMOM, Ferm)]: - $\bar\psi_1 \ii\fmslash{\partial}_\alpha V_\beta \lbrack \gamma^\alpha, \gamma^\beta \rbrack \psi_2$}\\\hline - [F12] & $\psi_2\leftarrow-\lbrack\fmslash{k},\gamma^\alpha\rbrack\psi_1 V_\alpha$ - & [F21] & $\psi_2\leftarrow-\lbrack\fmslash{k},\fmslash{V}\rbrack\psi_1$ \\\hline - [F13] & $V_\alpha\leftarrow \psi^T_1 {\rm C}\lbrack\fmslash{k},\gamma_\alpha\rbrack\psi_2$ - & [F31] & $V_\alpha\leftarrow \psi^T_2 {\rm C}(-\lbrack\fmslash{k}, \gamma_\alpha\rbrack\psi_1)$ \\\hline - [F23] & $\psi_1\leftarrow\rbrack\fmslash{k},\fmslash{V}\rbrack\psi_2$ - & [F32] & $\psi_1\leftarrow\lbrack\fmslash{k},\gamma^\alpha\rbrack\psi_2 V_\alpha$ \\\hline - \end{tabular} - \end{center} - \caption{\label{tab:dim4-fermions-MOM} Combined dimension-4 trilinear - fermionic couplings including a momentum. $Ferm$ stands for $Psi$ and - $Chi$. The case of $MOMR$ is identical to $MOML$ if one substitutes - $1+\gamma^5$ for $1-\gamma^5$, as well as for $LMOM$ and $RMOM$. The - mass term forces us to keep the chiral projector always on the left - after "inverting the line" for $MOML$ while on the right for $LMOM$.} - \end{table} - \begin{table} - \begin{center} - \renewcommand{\arraystretch}{1.4} - \begin{tabular}{|>{\qquad}r<{:}l|r<{:}l|}\hline - \multicolumn{2}{|l|}{[GBBG (Fermbar, S2LR, Ferm)]: $\bar\psi_1 S_1 S_2 -(g_L P_L + g_R P_R) \psi_2$}\\\hline - [F123] [F213] [F132] [F231] [F312] [F321] & $\psi_2\leftarrow S_1 S_2 (g_R P_L + g_L P_R) \psi_1$ \\ \hline - [F423] [F243] [F432] [F234] [F342] [F324] & $\psi_1 \leftarrow S_1 S_2 (g_L P_L + g_R P_R) \psi_2$ \\ \hline - [F134] [F143] [F314] & $S_1 \leftarrow \psi^T_1 C S_2 (g_L P_L + g_R P_R) \psi_2$ \\ \hline - [F124] [F142] [F214] & $S_2 \leftarrow \psi^T_1 C S_1 (g_L P_L + g_R P_R) \psi_2$ \\ \hline - [F413] [F431] [F341] & $S_1 \leftarrow \psi^T_2 C S_2 (g_R P_L + g_L P_R) \psi_1$ \\ \hline - [F412] [F421] [F241] & $S_2 \leftarrow \psi^T_2 C S_1 (g_R P_L + g_L P_R) \psi_1$ \\ \hline - \multicolumn{2}{|l|}{[GBBG (Fermbar, S2, Ferm)]: $\bar\psi_1 S_1 S_2 -\gamma^5 \psi_2$}\\\hline - [F123] [F213] [F132] [F231] [F312] [F321] & $\psi_2\leftarrow S_1 S_2 \gamma^5 \psi_1$ \\ \hline - [F423] [F243] [F432] [F234] [F342] [F324] & $\psi_1 \leftarrow S_1 S_2 \gamma^5 \psi_2$ \\ \hline - [F134] [F143] [F314] & $S_1 \leftarrow \psi^T_1 C S_2 \gamma^5 \psi_2$ \\ \hline - [F124] [F142] [F214] & $S_2 \leftarrow \psi^T_1 C S_1 \gamma^5 \psi_2$ \\ \hline - [F413] [F431] [F341] & $S_1 \leftarrow \psi^T_2 C S_2 \gamma^5 \psi_1$ \\ \hline - [F412] [F421] [F241] & $S_2 \leftarrow \psi^T_2 C S_1 \gamma^5 \psi_1$ \\ \hline - \multicolumn{2}{|l|}{[GBBG (Fermbar, V2, Ferm)]: $\bar\psi_1 \lbrack \fmslash{V}_1 , \fmslash{V}_2 \rbrack \psi_2$}\\\hline - [F123] [F213] [F132] [F231] [F312] [F321] & $\psi_2\leftarrow - \lbrack \fmslash{V}_1 , \fmslash{V}_2 \rbrack \psi_1$ \\ \hline - [F423] [F243] [F432] [F234] [F342] [F324] & $\psi_1 \leftarrow \lbrack \fmslash{V}_1 , \fmslash{V}_2 \rbrack \psi_2$ \\ \hline - [F134] [F143] [F314] & $V_{1\:\alpha} \leftarrow \psi^T_1 C \lbrack \gamma_\alpha , \fmslash{V}_2 \rbrack \psi_2$ \\ \hline - [F124] [F142] [F214] & $V_{2\:\alpha} \leftarrow \psi^T_1 C (-\lbrack \gamma_\alpha , \fmslash{V}_1 \rbrack) \psi_2$ \\ \hline - [F413] [F431] [F341] & $V_{1\:\alpha} \leftarrow \psi^T_2 C (-\lbrack \gamma_\alpha , \fmslash{V}_2 \rbrack) \psi_1$ \\ \hline - [F412] [F421] [F241] & $V_{2\:\alpha} \leftarrow \psi^T_2 C \lbrack \gamma_\alpha , \fmslash{V}_1 \rbrack \psi_1$ \\ \hline - \end{tabular} - \end{center} - \caption{\label{tab:dim5-mom2} Vertices with two fermions ($Ferm$ stands - for $Psi$ and $Chi$, but not for $Grav$) and two bosons (two scalars, - scalar/vector, two vectors) for the BRST transformations. Part I} - \end{table} - \begin{table} - \begin{center} - \renewcommand{\arraystretch}{1.4} - \begin{tabular}{|>{\qquad}r<{:}l|r<{:}l|}\hline - \multicolumn{2}{|l|}{[GBBG (Fermbar, SV, Ferm)]: $\bar\psi_1 \fmslash{V} S \psi_2$}\\\hline - [F123] [F213] [F132] [F231] [F312] [F321] & $\psi_2\leftarrow - \fmslash{V} S \psi_1$ \\ \hline - [F423] [F243] [F432] [F234] [F342] [F324] & $\psi_1 \leftarrow \fmslash{V} S \psi_2$ \\ \hline - [F134] [F143] [F314] & $V_\alpha \leftarrow \psi^T_1 C \gamma_\alpha S \psi_2$ \\ \hline - [F124] [F142] [F214] & $S \leftarrow \psi^T_1 C \fmslash{V} \psi_2$ \\ \hline - [F413] [F431] [F341] & $V_\alpha \leftarrow \psi^T_2 C (- \gamma_\alpha S \psi_1)$ \\ \hline - [F412] [F421] [F241] & $S \leftarrow \psi^T_2 C (- \fmslash{V} \psi_1)$ \\ \hline - \multicolumn{2}{|l|}{[GBBG (Fermbar, PV, Ferm)]: $\bar\psi_1 \fmslash{V} \gamma^5 P \psi_2$}\\\hline - [F123] [F213] [F132] [F231] [F312] [F321] & $\psi_2\leftarrow \fmslash{V} \gamma^5 P \psi_1$ \\ \hline - [F423] [F243] [F432] [F234] [F342] [F324] & $\psi_1 \leftarrow \fmslash{V} \gamma^5 P \psi_2$ \\ \hline - [F134] [F143] [F314] & $V_\alpha \leftarrow \psi^T_1 C \gamma_\alpha \gamma^5 P \psi_2$ \\ \hline - [F124] [F142] [F214] & $P \leftarrow \psi^T_1 C \fmslash{V} \gamma^5 \psi_2$ \\ \hline - [F413] [F431] [F341] & $V_\alpha \leftarrow \psi^T_2 C \gamma_\alpha \gamma^5 P \psi_1$ \\ \hline - [F412] [F421] [F241] & $P \leftarrow \psi^T_2 C \fmslash{V} \gamma^5 \psi_1$ \\ \hline - \multicolumn{2}{|l|}{[GBBG (Fermbar, S(L/R)V, Ferm)]: $\bar\psi_1 \fmslash{V} (1 \mp\gamma^5) \phi \psi_2$}\\\hline - [F123] [F213] [F132] [F231] [F312] [F321] & $\psi_2\leftarrow - \fmslash{V} (1\pm\gamma^5) \phi \psi_1$ \\ \hline - [F423] [F243] [F432] [F234] [F342] [F324] & $\psi_1 \leftarrow \fmslash{V} (1\mp\gamma^5) \phi \psi_2$ \\ \hline - [F134] [F143] [F314] & $V_\alpha \leftarrow \psi^T_1 C \gamma_\alpha (1\mp\gamma^5) \phi \psi_2$ \\ \hline - [F124] [F142] [F214] & $\phi \leftarrow \psi^T_1 C \fmslash{V} (1\mp\gamma^5) \psi_2$ \\ \hline - [F413] [F431] [F341] & $V_\alpha \leftarrow \psi^T_2 C \gamma_\alpha (-(1\pm\gamma^5) \phi \psi_1)$ \\ \hline - [F412] [F421] [F241] & $\phi \leftarrow \psi^T_2 C \fmslash{V} (-(1\pm\gamma^5) \psi_1)$ \\ \hline - \end{tabular} - \end{center} - \caption{\label{tab:dim5-mom2} Vertices with two fermions ($Ferm$ stands - for $Psi$ and $Chi$, but not for $Grav$) and two bosons (two scalars, - scalar/vector, two vectors) for the BRST transformations. Part II} - \end{table} - \begin{table} - \begin{center} - \renewcommand{\arraystretch}{1.4} - \begin{tabular}{|>{\qquad}r<{:}l|r<{:}l|}\hline - \multicolumn{4}{|l|}{[GBG (Gravbar, POT, Psi)]: $\bar\psi_\mu S \gamma^\mu \psi$}\\\hline - [F12] & $\psi\leftarrow - \gamma^\mu \psi_\mu S$ - & [F21] & $\psi\leftarrow - S\gamma^\mu \psi_\mu$ \\\hline - [F13] & $S\leftarrow \psi^T_\mu {\rm C} \gamma^\mu \psi$ - & [F31] & $S\leftarrow \psi^T{\rm C} (-\gamma^\mu)\psi_\mu$ \\\hline - [F23] & $\psi_\mu\leftarrow S\gamma_\mu\psi$ - & [F32] & $\psi_\mu\leftarrow \gamma_\mu \psi S$ \\\hline - \multicolumn{4}{|l|}{[GBG (Gravbar, S, Psi)]: $\bar\psi_\mu \fmslash{k}_S S \gamma^\mu \psi$}\\\hline - [F12] & $\psi\leftarrow \gamma^\mu \fmslash{k}_S \psi_\mu S$ - & [F21] & $\psi\leftarrow S\gamma^\mu \fmslash{k}_S \psi_\mu$ \\\hline - [F13] & $S\leftarrow \psi^T_\mu {\rm C} \fmslash{k}_S \gamma^\mu \psi$ - & [F31] & $S\leftarrow \psi^T{\rm C}\gamma^\mu\fmslash{k}_S \psi_\mu$ \\\hline - [F23] & $\psi_\mu\leftarrow S\fmslash{k}_S\gamma_\mu\psi$ - & [F32] & $\psi_\mu\leftarrow \fmslash{k}_S \gamma_\mu \psi S$ \\\hline - \multicolumn{4}{|l|}{[GBG (Gravbar, P, Psi)]: $\bar\psi_\mu \fmslash{k}_P P \gamma^\mu \gamma_5 \psi$}\\\hline - [F12] & $\psi\leftarrow \gamma^\mu\fmslash{k}_P\gamma_5\psi_\mu P$ - & [F21] & $\psi\leftarrow P\gamma^\mu\fmslash{k}_P\gamma_5\psi_\mu$ \\\hline - [F13] & $P\leftarrow \psi^T_\mu {\rm C}\fmslash{k}_P\gamma^\mu\gamma_5\psi$ - & [F31] & $P\leftarrow \psi^T {\rm C}\gamma^\mu\fmslash{k}_P\gamma_5\psi_\mu$ \\\hline - [F23] & $\psi_\mu\leftarrow P\fmslash{k}_P \gamma_\mu \gamma_5 \psi$ - & [F32] & $\psi_\mu\leftarrow \fmslash{k}_P \gamma_\mu \gamma_5 \psi P$ \\\hline - \multicolumn{4}{|l|}{[GBG (Gravbar, V, Psi)]: $\bar\psi_\mu\lbrack\fmslash{k}_V,\fmslash{V}\rbrack\gamma^\mu\gamma^5\psi$}\\\hline - [F12] & $\psi\leftarrow \gamma^5\gamma^\mu \lbrack \fmslash{k}_V , \gamma^\alpha \rbrack \psi_\mu V_\alpha$ - & [F21] & $\psi\leftarrow \gamma^5\gamma^\mu \lbrack \fmslash{k}_V , \fmslash{V} \rbrack\psi_\mu$ \\\hline - [F13] & $V_{\mu}\leftarrow \psi^T_\rho {\rm C} \lbrack \fmslash{k}_V , \gamma_\mu \rbrack \gamma^\rho \gamma^5 \psi$ - & [F31] & $V_{\mu}\leftarrow \psi^T {\rm C} \gamma^5 \gamma^{\rho} \lbrack \fmslash{k}_V , \gamma_\mu \rbrack \psi_\rho$ \\\hline - [F23] & $\psi_\mu\leftarrow\lbrack \fmslash{k}_V , \fmslash{V} \rbrack \gamma_\mu \gamma^5 \psi $ - & [F32] & $\psi_\mu\leftarrow\lbrack \fmslash{k}_V , \gamma^\alpha \rbrack \gamma_\mu \gamma^5 \psi V_\alpha$ \\\hline - \end{tabular} - \end{center} - \caption{\label{tab:dim5-fermions-gravdirac} Dimension-5 trilinear - couplings including one Dirac, one Gravitino fermion and one additional particle.The option [POT] is for the coupling of the supersymmetric current to the derivative of the quadratic terms in the superpotential.} - \end{table} - \begin{table} - \begin{center} - \renewcommand{\arraystretch}{1.4} - \begin{tabular}{|>{\qquad}r<{:}l|r<{:}l|}\hline - \multicolumn{4}{|l|}{[GBG (Psibar, POT, Grav)]: $\bar\psi \gamma^\mu S \psi_\mu$}\\\hline - [F12] & $\psi_\mu\leftarrow - \gamma_\mu \psi S$ - & [F21] & $\psi_\mu\leftarrow - S \gamma_\mu\psi$ \\\hline - [F13] & $S\leftarrow \psi^T{\rm C}\gamma^\mu\psi_\mu$ - & [F31] & $S\leftarrow \psi^T_\mu {\rm C} (-\gamma^\mu) \psi$ \\\hline - [F23] & $\psi\leftarrow S\gamma^\mu\psi_\mu$ - & [F32] & $\psi\leftarrow \gamma^\mu\psi_\mu S$ \\\hline - \multicolumn{4}{|l|}{[GBG (Psibar, S, Grav)]: $\bar\psi \gamma^\mu \fmslash{k}_S S \psi_\mu$}\\\hline - [F12] & $\psi_\mu\leftarrow \fmslash{k}_S \gamma_\mu \psi S$ - & [F21] & $\psi_\mu\leftarrow S \fmslash{k}_S \gamma_\mu\psi$ \\\hline - [F13] & $S\leftarrow \psi^T{\rm C}\gamma^\mu\fmslash{k}_S \psi_\mu$ - & [F31] & $S\leftarrow \psi^T_\mu {\rm C} \fmslash{k}_S \gamma^\mu \psi$ \\\hline - [F23] & $\psi\leftarrow S\gamma^\mu\fmslash{k}_S\psi_\mu$ - & [F32] & $\psi\leftarrow \gamma^\mu\fmslash{k}_S\psi_\mu S$ \\\hline - \multicolumn{4}{|l|}{[GBG (Psibar, P, Grav)]: $\bar\psi \gamma^\mu\gamma^5 P\fmslash{k}_P \psi_\mu$}\\\hline - [F12] & $\psi_\mu\leftarrow -\fmslash{k}_P \gamma_\mu \gamma^5 \psi P$ - & [F21] & $\psi_\mu\leftarrow -P\fmslash{k}_P \gamma_\mu \gamma^5 \psi$ \\\hline - [F13] & $P\leftarrow \psi^T {\rm C}\gamma^\mu\gamma^5\fmslash{k}_P\psi_\mu$ - & [F31] & $P\leftarrow -\psi^T_\mu {\rm C}\fmslash{k}_P\gamma^\mu\gamma_5\psi$ \\\hline - [F23] & $\psi\leftarrow P \gamma^\mu\gamma^5\fmslash{k}_P\psi_\mu$ - & [F32] & $\psi\leftarrow \gamma^\mu\gamma^5\fmslash{k}_P\psi_\mu P$ \\\hline - \multicolumn{4}{|l|}{[GBG (Psibar, V, Grav)]: $\bar\psi\gamma^5\gamma^\mu\lbrack\fmslash{k}_V,\fmslash{V}\rbrack\psi_\mu$}\\\hline - [F12] & $\psi_\mu\leftarrow \lbrack \fmslash{k}_V , \gamma^\alpha \rbrack \gamma_\mu \gamma^5 \psi V_\alpha$ - & [F21] & $\psi_\mu\leftarrow \lbrack \fmslash{k}_V , \fmslash{V} \rbrack \gamma_\mu \gamma^5 \psi$ \\\hline - [F13] & $V_{\mu}\leftarrow \psi^T {\rm C} \gamma^5 \gamma^\rho \lbrack \fmslash{k}_V , \gamma_\mu \rbrack \psi_\rho$ - & [F31] & $V_{\mu}\leftarrow \psi^T_\rho {\rm C} \lbrack \fmslash{k}_V , \gamma_\mu \rbrack \gamma^\rho \gamma^5 \psi$ \\\hline - [F23] & $\psi\leftarrow\gamma^5\gamma^\mu\lbrack \fmslash{k}_V , \fmslash{V} \rbrack\psi_\mu$ - & [F32] & $\psi\leftarrow\gamma^5\gamma^\mu\lbrack \fmslash{k}_V , \gamma^\alpha \rbrack\psi_\mu V_\alpha$ \\\hline - \end{tabular} - \end{center} - \caption{\label{tab:dim5-fermions-diracgrav} Dimension-5 trilinear - couplings including one conjugated Dirac, one Gravitino fermion and one additional particle.} - \end{table} - \begin{table} - \begin{center} - \renewcommand{\arraystretch}{1.4} - \begin{tabular}{|>{\qquad}r<{:}l|r<{:}l|}\hline - \multicolumn{4}{|l|}{[GBG (Gravbar, POT, Chi)]: $\bar\psi_\mu S \gamma^\mu \chi$}\\\hline - [F12] & $\chi\leftarrow - \gamma^\mu \psi_\mu S$ - & [F21] & $\chi\leftarrow - S\gamma^\mu \psi_\mu$ \\\hline - [F13] & $S\leftarrow \psi^T_\mu {\rm C} \gamma^\mu \chi$ - & [F31] & $S\leftarrow \chi^T{\rm C} (-\gamma^\mu)\psi_\mu$ \\\hline - [F23] & $\psi_\mu\leftarrow S\gamma_\mu\chi$ - & [F32] & $\psi_\mu\leftarrow \gamma_\mu \chi S$ \\\hline - \multicolumn{4}{|l|}{[GBG (Gravbar, S, Chi)]: $\bar\psi_\mu \fmslash{k}_S S \gamma^\mu \chi$}\\\hline - [F12] & $\chi\leftarrow \gamma^\mu \fmslash{k}_S \psi_\mu S$ - & [F21] & $\chi\leftarrow S\gamma^\mu \fmslash{k}_S \psi_\mu$ \\\hline - [F13] & $S\leftarrow \psi^T_\mu {\rm C} \fmslash{k}_S \gamma^\mu \chi$ - & [F31] & $S\leftarrow \chi^T{\rm C}\gamma^\mu\fmslash{k}_S \psi_\mu$ \\\hline - [F23] & $\psi_\mu\leftarrow S\fmslash{k}_S\gamma_\mu\chi$ - & [F32] & $\psi_\mu\leftarrow \fmslash{k}_S \gamma_\mu \chi S$ \\\hline - \multicolumn{4}{|l|}{[GBG (Gravbar, P, Chi)]: $\bar\psi_\mu \fmslash{k}_P P \gamma^\mu \gamma_5 \chi$}\\\hline - [F12] & $\chi\leftarrow \gamma^\mu\fmslash{k}_P\gamma_5\psi_\mu P$ - & [F21] & $\chi\leftarrow P\gamma^\mu\fmslash{k}_P\gamma_5\psi_\mu$ \\\hline - [F13] & $P\leftarrow \psi^T_\mu {\rm C}\fmslash{k}_P\gamma^\mu\gamma_5\chi$ - & [F31] & $P\leftarrow \chi^T {\rm C}\gamma^\mu\fmslash{k}_P\gamma_5\psi_\mu$ \\\hline - [F23] & $\psi_\mu\leftarrow P\fmslash{k}_P \gamma_\mu \gamma_5 \chi$ - & [F32] & $\psi_\mu\leftarrow \fmslash{k}_P \gamma_\mu \gamma_5 \chi P$ \\\hline - \multicolumn{4}{|l|}{[GBG (Gravbar, V, Chi)]: $\bar\psi_\mu\lbrack\fmslash{k}_V,\fmslash{V}\rbrack\gamma^\mu\gamma^5\chi$}\\\hline - [F12] & $\chi\leftarrow \gamma^5\gamma^\mu \lbrack \fmslash{k}_V , \gamma^\alpha \rbrack \psi_\mu V_\alpha$ - & [F21] & $\chi\leftarrow \gamma^5\gamma^\mu \lbrack \fmslash{k}_V , \fmslash{V} \rbrack\psi_\mu$ \\\hline - [F13] & $V_{\mu}\leftarrow \psi^T_\rho {\rm C} \lbrack \fmslash{k}_V , \gamma_\mu \rbrack \gamma^\rho \gamma^5 \chi$ - & [F31] & $V_{\mu}\leftarrow \chi^T {\rm C} \gamma^5 \gamma^{\rho} \lbrack \fmslash{k}_V , \gamma_\mu \rbrack \psi_\rho$ \\\hline - [F23] & $\psi_\mu\leftarrow\lbrack \fmslash{k}_V , \fmslash{V} \rbrack \gamma_\mu \gamma^5 \chi $ - & [F32] & $\psi_\mu\leftarrow\lbrack \fmslash{k}_V , \gamma^\alpha \rbrack \gamma_\mu \gamma^5 \chi V_\alpha$ \\\hline - \end{tabular} - \end{center} - \caption{\label{tab:dim5-fermions-gravmajo} Dimension-5 trilinear - couplings including one Majorana, one Gravitino fermion and one - additional particle. The table is essentially the same as the one - with the Dirac fermion and only written for the sake of completeness.} - \end{table} - \begin{table} - \begin{center} - \renewcommand{\arraystretch}{1.4} - \begin{tabular}{|>{\qquad}r<{:}l|r<{:}l|}\hline - \multicolumn{4}{|l|}{[GBG (Chibar, POT, Grav)]: $\bar\chi \gamma^\mu S \psi_\mu$}\\\hline - [F12] & $\psi_\mu\leftarrow - \gamma_\mu \chi S$ - & [F21] & $\psi_\mu\leftarrow - S \gamma_\mu\chi$ \\\hline - [F13] & $S\leftarrow \chi^T{\rm C}\gamma^\mu\psi_\mu$ - & [F31] & $S\leftarrow \psi^T_\mu {\rm C} (-\gamma^\mu) \chi$ \\\hline - [F23] & $\chi\leftarrow S\gamma^\mu\psi_\mu$ - & [F32] & $\chi\leftarrow \gamma^\mu\psi_\mu S$ \\\hline - \multicolumn{4}{|l|}{[GBG (Chibar, S, Grav)]: $\bar\chi \gamma^\mu \fmslash{k}_S S \psi_\mu$}\\\hline - [F12] & $\psi_\mu\leftarrow \fmslash{k}_S \gamma_\mu \chi S$ - & [F21] & $\psi_\mu\leftarrow S \fmslash{k}_S \gamma_\mu\chi$ \\\hline - [F13] & $S\leftarrow \chi^T{\rm C}\gamma^\mu\fmslash{k}_S \psi_\mu$ - & [F31] & $S\leftarrow \psi^T_\mu {\rm C} \fmslash{k}_S \gamma^\mu \chi$ \\\hline - [F23] & $\chi\leftarrow S\gamma^\mu\fmslash{k}_S\psi_\mu$ - & [F32] & $\chi\leftarrow \gamma^\mu\fmslash{k}_S\psi_\mu S$ \\\hline - \multicolumn{4}{|l|}{[GBG (Chibar, P, Grav)]: $\bar\chi \gamma^\mu\gamma^5 P\fmslash{k}_P \psi_\mu$}\\\hline - [F12] & $\psi_\mu\leftarrow -\fmslash{k}_P \gamma_\mu \gamma^5 \chi P$ - & [F21] & $\psi_\mu\leftarrow -P\fmslash{k}_P \gamma_\mu \gamma^5 \chi$ \\\hline - [F13] & $P\leftarrow \chi^T {\rm C}\gamma^\mu\gamma^5\fmslash{k}_P\psi_\mu$ - & [F31] & $P\leftarrow -\psi^T_\mu {\rm C}\fmslash{k}_P\gamma^\mu\gamma_5\chi$ \\\hline - [F23] & $\chi\leftarrow P \gamma^\mu\gamma^5\fmslash{k}_P\psi_\mu$ - & [F32] & $\chi\leftarrow \gamma^\mu\gamma^5\fmslash{k}_P\psi_\mu P$ \\\hline - \multicolumn{4}{|l|}{[GBG (Chibar, V, Grav)]: $\bar\chi\gamma^5\gamma^\mu\lbrack\fmslash{k}_V,\fmslash{V}\rbrack\psi_\mu$}\\\hline - [F12] & $\psi_\mu\leftarrow \lbrack \fmslash{k}_V , \gamma^\alpha \rbrack \gamma_\mu \gamma^5 \chi V_\alpha$ - & [F21] & $\psi_\mu\leftarrow \lbrack \fmslash{k}_V , \fmslash{V} \rbrack \gamma_\mu \gamma^5 \chi$ \\\hline - [F13] & $V_{\mu}\leftarrow \chi^T {\rm C} \gamma^5 \gamma^\rho \lbrack \fmslash{k}_V , \gamma_\mu \rbrack \psi_\rho$ - & [F31] & $V_{\mu}\leftarrow \psi^T_\rho {\rm C} \lbrack \fmslash{k}_V , \gamma_\mu \rbrack \gamma^\rho \gamma^5 \chi$ \\\hline - [F23] & $\chi\leftarrow\gamma^5\gamma^\mu\lbrack \fmslash{k}_V , \fmslash{V} \rbrack\psi_\mu$ - & [F32] & $\chi\leftarrow\gamma^5\gamma^\mu\lbrack \fmslash{k}_V , \gamma^\alpha \rbrack\psi_\mu V_\alpha$ \\\hline - \end{tabular} - \end{center} - \caption{\label{tab:dim5-fermions-majograv} Dimension-5 trilinear - couplings including one conjugated Majorana, one Gravitino fermion and - one additional particle. This table is not only the same as the one - with the conjugated Dirac fermion but also the same part of the - Lagrangian density as the one with the Majorana particle on the right - of the gravitino.} - \end{table} - \begin{table} - \begin{center} - \renewcommand{\arraystretch}{1.4} - \begin{tabular}{|>{\qquad}r<{:}l|r<{:}l|}\hline - \multicolumn{2}{|l|}{[GBBG (Gravbar, S2, Psi)]: $\bar\psi_\mu S_1 S_2 -\gamma^\mu \psi$}\\\hline - [F123] [F213] [F132] [F231] [F312] [F321] & $\psi\leftarrow - \gamma^\mu S_1 S_2 \psi_\mu$ \\ \hline - [F423] [F243] [F432] [F234] [F342] [F324] & $\psi_\mu \leftarrow \gamma_\mu S_1 S_2 \psi$ \\ \hline - [F134] [F143] [F314] & $S_1 \leftarrow \psi^T_\mu C S_2 \gamma^\mu \psi$ \\ \hline - [F124] [F142] [F214] & $S_2 \leftarrow \psi^T_\mu C S_1 \gamma^\mu \psi$ \\ \hline - [F413] [F431] [F341] & $S_1 \leftarrow - \psi^T C S_2 \gamma^\mu \psi_\mu$ \\ \hline - [F412] [F421] [F241] & $S_2 \leftarrow - \psi^T C S_1 \gamma^\mu \psi_\mu$ \\ \hline - \multicolumn{2}{|l|}{[GBBG (Gravbar, SV, Psi)]: $\bar\psi_\mu S \fmslash{V} \gamma^\mu \gamma^5 \psi$}\\\hline - [F123] [F213] [F132] [F231] [F312] [F321] & $\psi\leftarrow \gamma^5 \gamma^\mu S \fmslash{V} \psi_\mu$ \\ \hline - [F423] [F243] [F432] [F234] [F342] [F324] & $\psi_\mu \leftarrow \fmslash{V} S \gamma_\mu \gamma^5 \psi$ \\ \hline - [F134] [F143] [F314] & $S \leftarrow \psi^T_\mu C \fmslash{V} \gamma^\mu \gamma^5 \psi$ \\ \hline - [F124] [F142] [F214] & $V_\mu \leftarrow \psi^T_\rho C S \gamma_\mu \gamma^\rho \gamma^5 \psi$ \\ \hline - [F413] [F431] [F341] & $S \leftarrow \psi^T C \gamma^5 \gamma^\mu \fmslash{V} \psi_\mu$ \\ \hline - [F412] [F421] [F241] & $V_\mu \leftarrow \psi^T C S \gamma^5 \gamma^\rho \gamma_\mu \psi_\rho$ \\ \hline - \multicolumn{2}{|l|}{[GBBG (Gravbar, PV, Psi)]: $\bar\psi_\mu P \fmslash{V} \gamma^\mu \psi$}\\\hline - [F123] [F213] [F132] [F231] [F312] [F321] & $\psi\leftarrow \gamma^\mu P \fmslash{V} \psi_\mu$ \\ \hline - [F423] [F243] [F432] [F234] [F342] [F324] & $\psi_\mu \leftarrow \fmslash{V} P \gamma_\mu \psi$ \\ \hline - [F134] [F143] [F314] & $P \leftarrow \psi^T_\mu C \fmslash{V} \gamma^\mu \psi$ \\ \hline - [F124] [F142] [F214] & $V_\mu \leftarrow \psi^T_\rho C P \gamma_\mu \gamma^\rho \psi$ \\ \hline - [F413] [F431] [F341] & $P \leftarrow \psi^T C \gamma^\mu \fmslash{V} \psi_\mu$ \\ \hline - [F412] [F421] [F241] & $V_\mu \leftarrow \psi^T C P \gamma^\rho \gamma_\mu \psi_\rho$ \\ \hline - \multicolumn{2}{|l|}{[GBBG (Gravbar, V2, Psi)]: $\bar\psi_\mu f_{abc} \lbrack \fmslash{V}^a , \fmslash{V}^b \rbrack\gamma^\mu \gamma^5 \psi$}\\\hline - [F123] [F213] [F132] [F231] [F312] [F321] & $\psi\leftarrow f_{abc} \gamma^5 \gamma^\mu \lbrack \fmslash{V}^a , \fmslash{V}^b \rbrack \psi_\mu$ \\ \hline - [F423] [F243] [F432] [F234] [F342] [F324] & $\psi_\mu \leftarrow f_{abc} \lbrack \fmslash{V}^a , \fmslash{V}^b \rbrack \gamma_\mu \gamma^5 \psi$ \\ \hline - [F134] [F143] [F314] [F124] [F142] [F214] & $V_\mu^a \leftarrow\psi^T_\rho C f_{abc} \lbrack \gamma_\mu , \fmslash{V}^b \rbrack \gamma^\rho \gamma^5 \psi$ \\ \hline - [F413] [F431] [F341] [F412] [F421] [F241] & $V_\mu^a \leftarrow\psi^T C f_{abc} \gamma^5 \gamma^\rho\lbrack \gamma_\mu , \fmslash{V}^b \rbrack \psi_\rho$ \\ \hline - \end{tabular} - \end{center} - \caption{\label{tab:dim5-gravferm2boson} Dimension-5 trilinear - couplings including one Dirac, one Gravitino fermion and two additional bosons. In each lines we list the fusion possibilities with the same order of the fermions, but the order of the bosons is arbitrary (of course, one has to take care of this order in the mapping of the wave functions in [fusion]).} - \end{table} - \begin{table} - \begin{center} - \renewcommand{\arraystretch}{1.4} - \begin{tabular}{|>{\qquad}r<{:}l|r<{:}l|}\hline - \multicolumn{2}{|l|}{[GBBG (Psibar, S2, Grav)]: $\bar\psi S_1 S_2 -\gamma^\mu \psi_\mu$}\\\hline - [F123] [F213] [F132] [F231] [F312] [F321] & $\psi_\mu\leftarrow - \gamma_\mu S_1 S_2 \psi$ \\ \hline - [F423] [F243] [F432] [F234] [F342] [F324] & $\psi \leftarrow \gamma^\mu S_1 S_2 \psi_\mu$ \\ \hline - [F134] [F143] [F314] & $S_1 \leftarrow \psi^T C S_2 \gamma^\mu \psi_\mu$ \\ \hline - [F124] [F142] [F214] & $S_2 \leftarrow \psi^T C S_1 \gamma^\mu \psi_\mu$ \\ \hline - [F413] [F431] [F341] & $S_1 \leftarrow - \psi^T_\mu C S_2 \gamma^\mu \psi$ \\ \hline - [F412] [F421] [F241] & $S_2 \leftarrow - \psi^T_\mu C S_1 \gamma^\mu \psi$ \\ \hline - \multicolumn{2}{|l|}{[GBBG (Psibar, SV, Grav)]: $\bar\psi S \gamma^\mu \gamma^5 \fmslash{V} \psi_\mu$}\\\hline - [F123] [F213] [F132] [F231] [F312] [F321] & $\psi_\mu\leftarrow \fmslash{V} S \gamma^5 \gamma^\mu \psi$ \\ \hline - [F423] [F243] [F432] [F234] [F342] [F324] & $\psi\leftarrow \gamma^\mu\gamma^5 S\fmslash{V}\psi_\mu$ \\ \hline - [F134] [F143] [F314] & $S \leftarrow \psi^T C \gamma^\mu \gamma^5 \fmslash{V}\psi$ \\ \hline - [F124] [F142] [F214] & $V_\mu \leftarrow \psi^T C \gamma^\rho \gamma^5 S \gamma_\mu \psi_\rho$ \\ \hline - [F413] [F431] [F341] & $S \leftarrow \psi^T_\mu C \fmslash{V} \gamma^5 \gamma^\mu \psi$ \\ \hline - [F412] [F421] [F241] & $V_\mu \leftarrow \psi^T_\rho C S \gamma_\mu \gamma^5 \gamma^\rho \psi$ \\ \hline - \multicolumn{2}{|l|}{[GBBG (Psibar, PV, Grav)]: $\bar\psi P \gamma^\mu \fmslash{V} \psi_\mu$}\\\hline - [F123] [F213] [F132] [F231] [F312] [F321] & $\psi_\mu\leftarrow \fmslash{V}\gamma_\mu P \psi$ \\ \hline - [F423] [F243] [F432] [F234] [F342] [F324] & $\psi\leftarrow \gamma^\mu\fmslash{V} P\psi_\mu$ \\ \hline - [F134] [F143] [F314] & $P \leftarrow \psi^T C \gamma^\mu\fmslash{V}\psi_\mu$ \\ \hline - [F124] [F142] [F214] & $V_\mu \leftarrow \psi^T C P \gamma^\rho \gamma_\mu \psi_\rho$ \\ \hline - [F413] [F431] [F341] & $P \leftarrow \psi^T_\mu C \fmslash{V}\gamma^\mu \psi$ \\ \hline - [F412] [F421] [F241] & $V_\mu \leftarrow \psi^T_\rho C P \gamma_\mu \gamma^\rho \psi$ \\ \hline - \multicolumn{2}{|l|}{[GBBG (Psibar, V2, Grav)]: $\bar\psi f_{abc} \gamma^5 \gamma^\mu \lbrack \fmslash{V}^a , \fmslash{V}^b \rbrack\psi_\mu$}\\\hline - [F123] [F213] [F132] [F231] [F312] [F321] & $\psi_\mu\leftarrow f_{abc} \lbrack \fmslash{V}^a , \fmslash{V}^b \rbrack \gamma_\mu \gamma^5 \psi$ \\ \hline - [F423] [F243] [F432] [F234] [F342] [F324] & $\psi\leftarrow f_{abc} \gamma^5\gamma^\mu\lbrack \fmslash{V}^a , \fmslash{V}^b \rbrack\psi_\mu$ \\ \hline - [F134] [F143] [F314] [F124] [F142] [F214] & $V_\mu^a \leftarrow\psi^T C f_{abc} \gamma^5\gamma^\rho\lbrack \gamma_\mu , \fmslash{V}^b \rbrack\psi_\rho$ \\ \hline - [F413] [F431] [F341] [F412] [F421] [F241] & $V_\mu^a \leftarrow\psi^T_\rho C f_{abc}\lbrack \gamma_\mu , \fmslash{V}^b \rbrack\gamma^\rho\gamma^5 \psi$ \\ \hline - \end{tabular} - \end{center} - \caption{\label{tab:dim5-gravferm2boson2} Dimension-5 trilinear - couplings including one conjugated Dirac, one Gravitino fermion and two additional bosons. The couplings of Majorana fermions to the gravitino and two bosons are essentially the same as for Dirac fermions and they are omitted here.} - \end{table} -*) - -(* \thocwmodulesection{Perturbative Quantum Gravity and Kaluza-Klein Interactions} - The gravitational coupling constant and the relative strength of - the dilaton coupling are abbreviated as - \begin{subequations} - \begin{align} - \kappa &= \sqrt{16\pi G_N} \\ - \omega &= \sqrt{\frac{2}{3(n+2)}} = \sqrt{\frac{2}{3(d-2)}}\,, - \end{align} - \end{subequations} - where~$n=d-4$ is the number of extra space dimensions. *) - -(* In~(\ref{eq:graviton-feynman-rules3}-\ref{eq:dilaton-feynman-rules5}), - we use the notation of~\cite{Han/Lykken/Zhang:1999:Kaluza-Klein}: - \begin{subequations} - \begin{equation} - C_{\mu\nu,\rho\sigma} = - g_{\mu\rho} g_{\nu\sigma} + g_{\mu\sigma} g_{\nu\rho} - - g_{\mu\nu} g_{\rho\sigma} - \end{equation} - \begin{multline} - D_{\mu\nu,\rho\sigma}(k_1,k_2) = - g_{\mu\nu} k_{1,\sigma} k_{2,\rho} \\ - \mbox{} - - ( g_{\mu\sigma} k_{1,\nu} k_{2,\rho} - + g_{\mu\rho} k_{1,\sigma} k_{2,\nu} - - g_{\rho\sigma} k_{1,\mu} k_{2,\nu} - + (\mu\leftrightarrow\nu)) - \end{multline} - \begin{multline} - E_{\mu\nu,\rho\sigma}(k_1,k_2) = - g_{\mu\nu} (k_{1,\rho} k_{1,\sigma} - + k_{2,\rho} k_{2,\sigma} + k_{1,\rho} k_{2,\sigma}) \\ - \mbox{} - - ( g_{\nu\sigma} k_{1,\mu} k_{1,\rho} - + g_{\nu\rho} k_{2,\mu} k_{2,\sigma} - + (\mu\leftrightarrow\nu)) - \end{multline} - \begin{multline} - F_{\mu\nu,\rho\sigma\lambda}(k_1,k_2,k_3) = \\ - g_{\mu\rho} g_{\sigma\lambda} (k_2 - k_3)_{\nu} - + g_{\mu\sigma} g_{\lambda\rho} (k_3 - k_1)_{\nu} - + g_{\mu\lambda} g_{\rho\sigma} (k_1 - k_2)_{\nu} - + (\mu\leftrightarrow\nu) - \end{multline} - \begin{multline} - G_{\mu\nu,\rho\sigma\lambda\delta} = - g_{\mu\nu} (g_{\rho\sigma}g_{\lambda\delta} - g_{\rho\delta}g_{\lambda\sigma}) - \\ \mbox{} - + ( g_{\mu\rho}g_{\nu\delta}g_{\lambda\sigma} - + g_{\mu\lambda}g_{\nu\sigma}g_{\rho\delta} - - g_{\mu\rho}g_{\nu\sigma}g_{\lambda\delta} - - g_{\mu\lambda}g_{\nu\delta}g_{\rho\sigma} - + (\mu\leftrightarrow\nu) ) - \end{multline} - \end{subequations} *) - -(* \begin{figure} - \begin{subequations} - \label{eq:graviton-feynman-rules3} - \begin{align} - \label{eq:graviton-scalar-scalar} - \parbox{28mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(24,22) - \Threeexternal{1}{2}{h_{\mu\nu}} - \fmf{plain}{v,e1} - \fmf{plain}{v,e2} - \fmf{dbl_dots}{v,e3} - \threeoutgoing - \end{fmfgraph*}}} \,&= - \begin{split} - \mbox{} & - \ii \frac{\kappa}{2} g_{\mu\nu} m^2 - + \ii \frac{\kappa}{2} C_{\mu\nu,\mu_1\mu_2}k^{\mu_1}_1k^{\mu_2}_2 - \end{split} \\ - \parbox{28mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(24,22) - \Threeexternal{1}{2}{h_{\mu\nu}} - \fmf{photon}{v,e1} - \fmf{photon}{v,e2} - \fmf{dbl_dots}{v,e3} - \threeoutgoing - \end{fmfgraph*}}} \,&= - \begin{split} - \mbox{} - \ii \frac{\kappa}{2} m^2 C_{\mu\nu,\mu_1\mu_2} - - \ii \frac{\kappa}{2} - (& k_1k_2 C_{\mu\nu,\mu_1\mu_2} \\ - &\mbox{} + D_{\mu\nu,\mu_1\mu_2}(k_1,k_2) \\ - &\mbox{} + \xi^{-1} E_{\mu\nu,\mu_1\mu_2}(k_1,k_2)) - \end{split} \\ - \parbox{28mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(24,22) - \Threeexternal{p}{p'}{h_{\mu\nu}} - \fmf{fermion}{e1,v,e2} - \fmf{dbl_dots}{v,e3} - \fmfdot{v} - \end{fmfgraph*}}} \,&= - \begin{split} - \mbox{} - \ii \frac{\kappa}{2} m g_{\mu\nu} - - \ii \frac{\kappa}{8} - (& \gamma_{\mu}(p+p')_{\nu} + \gamma_{\nu}(p+p')_{\mu} \\ - & \mbox{} - 2 g_{\mu\nu} (\fmslash{p}+\fmslash{p}') ) - \end{split} - \end{align} - \end{subequations} - \caption{\label{fig:graviton-feynman-rules3} Three-point graviton couplings.} - \end{figure} - \begin{table} - \begin{center} - \renewcommand{\arraystretch}{1.4} - \begin{tabular}{|>{\qquad}r<{:}l|}\hline - \multicolumn{2}{|l|}{[Graviton_Scalar_Scalar]: - $h_{\mu\nu} C^{\mu\nu}_{0}(k_1,k_2)\phi_1\phi_2$}\\\hline - [F12|F21] - & $\phi_2 \leftarrow \ii\cdot - h_{\mu\nu} C^{\mu\nu}_{0} (k_1, -k-k_1)\phi_1 $ \\\hline - [F13|F31] - & $\phi_1 \leftarrow \ii\cdot - h_{\mu\nu} C^{\mu\nu}_{0} (-k-k_2, k_2)\phi_2 $ \\\hline - [F23|F32] - & $h^{\mu\nu} \leftarrow \ii\cdot - C^{\mu\nu}_0 (k_1,k_2)\phi_1\phi_2 $ \\\hline - \multicolumn{2}{|l|}{[Graviton_Vector_Vector]: - $h_{\mu\nu} C^{\mu\nu,\mu_1\mu_2}_1(k_1,k_2,\xi) - V_{\mu_1}V_{\mu_2} $}\\\hline - [F12|F21] & $ V^\mu_2 \leftarrow \ii\cdot h_{\kappa\lambda} - C^{\kappa\lambda,\mu\nu}_1(-k-k_1,k_1\xi) V_{1,\nu}$ \\\hline - [F13|F31] & $ V^\mu_1 \leftarrow \ii\cdot h_{\kappa\lambda} - C^{\kappa\lambda,\mu\nu}_1(-k-k_2,k_2,\xi) V_{2,\nu}$ \\\hline - [F23|F32] - & $h^{\mu\nu} \leftarrow \ii\cdot - C^{\mu\nu,\mu_1\mu_2}_1(k_1,k_2,\xi) - V_{1,\mu_1}V_{2,\mu_2} $ \\\hline - \multicolumn{2}{|l|}{[Graviton_Spinor_Spinor]: - $h_{\mu\nu} \bar\psi_1 - C^{\mu\nu}_{\frac{1}{2}}(k_1,k_2)\psi_2 $}\\\hline - [F12] & $ \bar\psi_2 \leftarrow \ii\cdot - h_{\mu\nu} \bar\psi_1 C^{\mu\nu}_{\frac{1}{2}}(k_1,-k-k_1) $ \\\hline - [F21] & $ \bar\psi_2 \leftarrow \ii\cdot\ldots $ \\\hline - [F13] & $ \psi_1 \leftarrow \ii\cdot - h_{\mu\nu}C^{\mu\nu}_{\frac{1}{2}}(-k-k_2,k_2)\psi_2$ \\\hline - [F31] & $ \psi_1 \leftarrow \ii\cdot\ldots $ \\\hline - [F23] & $ h^{\mu\nu} \leftarrow \ii\cdot - \bar\psi_1 C^{\mu\nu}_{\frac{1}{2}}(k_1,k_2)\psi_2 $ \\\hline - [F32] & $ h^{\mu\nu} \leftarrow \ii\cdot\ldots $ \\\hline - \end{tabular} - \end{center} - \caption{\label{tab:graviton-three-point} \ldots} - \end{table} - Derivation of~(\ref{eq:graviton-scalar-scalar}) - \begin{subequations} - \begin{align} - L &= \frac{1}{2} (\partial_\mu \phi) (\partial^\mu \phi) - \frac{m^2}{2} \phi^2 \\ - (\partial_\mu\phi) \frac{\partial L}{\partial(\partial^\nu\phi)} - &= (\partial_\mu\phi)(\partial_\nu\phi) \\ - T_{\mu\nu} &= -g_{\mu\nu} L + - (\partial_\mu\phi) \frac{\partial L}{\partial(\partial^\nu\phi)} - + - \end{align} - \end{subequations} - \begin{subequations} - \begin{align} - C^{\mu\nu}_{0}(k_1,k_2) - &= C^{\mu\nu,\mu_1\mu_2} k_{1,\mu_1} k_{2,\mu_2} \\ - C^{\mu\nu,\mu_1\mu_2}_1(k_1,k_2,\xi) - &= k_1k_2 C^{\mu\nu,\mu_1\mu_2} - + D^{\mu\nu,\mu_1\mu_2}(k_1,k_2) - + \xi^{-1} E^{\mu\nu,\mu_1\mu_2}(k_1,k_2) \\ - C^{\mu\nu}_{\frac{1}{2},\alpha\beta}(p,p') - &= \gamma^{\mu}_{\alpha\beta}(p+p')^{\nu} - + \gamma^{\nu}_{\alpha\beta}(p+p')^{\mu} - - 2 g^{\mu\nu} (\fmslash{p}+\fmslash{p}')_{\alpha\beta} - \end{align} - \end{subequations} *) - -(* \begin{figure} - \begin{subequations} - \label{eq:dilaton-feynman-rules3} - \begin{align} - \parbox{28mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(24,22) - \Threeexternal{1}{2}{\phi(k)} - \fmf{plain}{v,e1} - \fmf{plain}{v,e2} - \fmf{dots}{v,e3} - \threeoutgoing - \end{fmfgraph*}}} \,&= - - \ii \omega \kappa 2m^2 - \ii \omega \kappa k_1k_2 \\ - \parbox{28mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(24,22) - \Threeexternal{1}{2}{\phi(k)} - \fmf{photon}{v,e1} - \fmf{photon}{v,e2} - \fmf{dots}{v,e3} - \threeoutgoing - \end{fmfgraph*}}} \,&= - - \ii \omega \kappa g_{\mu_1\mu_2}m^2 - - \ii \omega \kappa - \xi^{-1} (k_{1,\mu_1}k_{\mu_2} + k_{2,\mu_2}k_{\mu_1}) \\ - \parbox{28mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(24,22) - \Threeexternal{p}{p'}{\phi(k)} - \fmf{fermion}{e1,v,e2} - \fmf{dots}{v,e3} - \fmfdot{v} - \end{fmfgraph*}}} \,&= - - \ii \omega \kappa 2m - + \ii \omega \kappa \frac{3}{4}(\fmslash{p}+\fmslash{p}') - \end{align} - \end{subequations} - \caption{\label{fig:dilaton-feynman-rules3} Three-point dilaton couplings.} - \end{figure} - \begin{table} - \begin{center} - \renewcommand{\arraystretch}{1.4} - \begin{tabular}{|>{\qquad}r<{:}l|}\hline - \multicolumn{2}{|l|}{[Dilaton_Scalar_Scalar]: - $\phi \ldots k_1k_2\phi_1\phi_2 $}\\\hline - [F12|F21] & $ \phi_2 \leftarrow \ii\cdot k_1(-k-k_1)\phi\phi_1 $ \\\hline - [F13|F31] & $ \phi_1 \leftarrow \ii\cdot (-k-k_2)k_2\phi\phi_2 $ \\\hline - [F23|F32] & $ \phi \leftarrow \ii\cdot k_1k_2\phi_1\phi_2 $ \\\hline - \multicolumn{2}{|l|}{[Dilaton_Vector_Vector]: - $\phi \ldots $}\\\hline - [F12] & $ V_{2,\mu} \leftarrow \ii\cdot\ldots $ \\\hline - [F21] & $ V_{2,\mu} \leftarrow \ii\cdot\ldots $ \\\hline - [F13] & $ V_{1,\mu} \leftarrow \ii\cdot\ldots $ \\\hline - [F31] & $ V_{1,\mu} \leftarrow \ii\cdot\ldots $ \\\hline - [F23] & $ \phi \leftarrow \ii\cdot\ldots $ \\\hline - [F32] & $ \phi \leftarrow \ii\cdot\ldots $ \\\hline - \multicolumn{2}{|l|}{[Dilaton_Spinor_Spinor]: - $\phi \ldots $}\\\hline - [F12] & $ \bar\psi_2 \leftarrow \ii\cdot\ldots $ \\\hline - [F21] & $ \bar\psi_2 \leftarrow \ii\cdot\ldots $ \\\hline - [F13] & $ \psi_1 \leftarrow \ii\cdot\ldots $ \\\hline - [F31] & $ \psi_1 \leftarrow \ii\cdot\ldots $ \\\hline - [F23] & $ \phi \leftarrow \ii\cdot\ldots $ \\\hline - [F32] & $ \phi \leftarrow \ii\cdot\ldots $ \\\hline - \end{tabular} - \end{center} - \caption{\label{tab:dilaton-three-point} \ldots} - \end{table} *) - -(* \begin{figure} - \begin{subequations} - \label{eq:graviton-feynman-rules4} - \begin{align} - \label{eq:graviton-scalar-scalar-scalar} - \parbox{28mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(24,22) - \Fourexternal{1}{2}{3}{h_{\mu\nu}} - \fmf{plain}{v,e1} - \fmf{plain}{v,e2} - \fmf{plain}{v,e3} - \fmf{dbl_dots}{v,e4} - \fouroutgoing - \end{fmfgraph*}}} \,&= - \begin{split} - \mbox{} & ??? - \end{split} \\ - \parbox{28mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(24,22) - \Fourexternal{1}{2}{3}{h_{\mu\nu}} - \fmf{plain}{v,e1} - \fmf{plain}{v,e2} - \fmf{photon}{v,e3} - \fmf{dbl_dots}{v,e4} - \fouroutgoing - \end{fmfgraph*}}} \,&= - \begin{split} - \mbox{} & - - \ii g\frac{\kappa}{2} C_{\mu\nu,\mu_3\rho}(k_1-k_2)^{\rho} T^{a_3}_{n_2n_1} - \end{split} \\ - \label{eq:graviton-scalar-vector-vector} - \parbox{28mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(24,22) - \Fourexternal{1}{2}{3}{h_{\mu\nu}} - \fmf{plain}{v,e1} - \fmf{photon}{v,e2} - \fmf{photon}{v,e3} - \fmf{dbl_dots}{v,e4} - \fouroutgoing - \end{fmfgraph*}}} \,&= - \begin{split} - \mbox{} & ??? - \end{split} \\ - \parbox{28mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(24,22) - \Fourexternal{1}{2}{3}{h_{\mu\nu}} - \fmf{photon}{v,e1} - \fmf{photon}{v,e2} - \fmf{photon}{v,e3} - \fmf{dbl_dots}{v,e4} - \fouroutgoing - \end{fmfgraph*}}} \,&= - \begin{split} - \mbox{} - g \frac{\kappa}{2} f^{a_1a_2a_3} - (& C_{\mu\nu,\mu_1\mu_2} (k_1-k_2)_{\mu_3} \\ - & \mbox{} + C_{\mu\nu,\mu_2\mu_3} (k_2-k_3)_{\mu_1} \\ - & \mbox{} + C_{\mu\nu,\mu_3\mu_1} (k_3-k_1)_{\mu_2} \\ - & \mbox{} + F_{\mu\nu,\mu_1\mu_2\mu_3}(k_1,k_2,k_3) ) - \end{split} \\ - \label{eq:graviton-yukawa} - \parbox{28mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(24,22) - \Fourexternal{1}{2}{3}{h_{\mu\nu}} - \fmf{fermion}{e1,v,e2} - \fmf{plain}{v,e3} - \fmf{dbl_dots}{v,e4} - \fmfdot{v} - \fmffreeze - \fmf{warrow_right}{v,e3} - \fmf{warrow_right}{v,e4} - \end{fmfgraph*}}} \,&= - \begin{split} - \mbox{} & ??? - \end{split} \\ - \parbox{28mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(24,22) - \Fourexternal{1}{2}{3}{h_{\mu\nu}} - \fmf{fermion}{e1,v,e2} - \fmf{photon}{v,e3} - \fmf{dbl_dots}{v,e4} - \fmfdot{v} - \fmffreeze - \fmf{warrow_right}{v,e3} - \fmf{warrow_right}{v,e4} - \end{fmfgraph*}}} \,&= - \begin{split} - \mbox{} & \ii g\frac{\kappa}{4} - (C_{\mu\nu,\mu_3\rho} - g_{\mu\nu}g_{\mu_3\rho}) - \gamma^{\rho} T^{a_3}_{n_2n_1} - \end{split} - \end{align} - \end{subequations} - \caption{\label{fig:graviton-feynman-rules4} Four-point graviton couplings. - (\ref{eq:graviton-scalar-scalar-scalar}), - (\ref{eq:graviton-scalar-vector-vector}), - and~(\ref{eq:graviton-yukawa)} are missing - in~\cite{Han/Lykken/Zhang:1999:Kaluza-Klein}, but should be generated - by standard model Higgs selfcouplings, Higgs-gaugeboson couplings, and - Yukawa couplings.} - \end{figure} *) - -(* \begin{figure} - \begin{subequations} - \label{eq:dilaton-feynman-rules4} - \begin{align} - \label{eq:dilaton-scalar-scalar-scalar} - \parbox{28mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(24,22) - \Fourexternal{1}{2}{3}{\phi(k)} - \fmf{plain}{v,e1} - \fmf{plain}{v,e2} - \fmf{plain}{v,e3} - \fmf{dots}{v,e4} - \fouroutgoing - \end{fmfgraph*}}} \,&= ??? \\ - \parbox{28mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(24,22) - \Fourexternal{1}{2}{3}{\phi(k)} - \fmf{plain}{v,e1} - \fmf{plain}{v,e2} - \fmf{photon}{v,e3} - \fmf{dots}{v,e4} - \fouroutgoing - \end{fmfgraph*}}} \,&= - - \ii \omega \kappa (k_1 + k_2)_{\mu_3} T^{a_3}_{n_1,n_2} \\ - \label{eq:dilaton-scalar-vector-vector} - \parbox{28mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(24,22) - \Fourexternal{1}{2}{3}{\phi(k)} - \fmf{plain}{v,e1} - \fmf{photon}{v,e2} - \fmf{photon}{v,e3} - \fmf{dots}{v,e4} - \fouroutgoing - \end{fmfgraph*}}} \,&= ??? \\ - \parbox{28mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(24,22) - \Fourexternal{1}{2}{3}{\phi(k)} - \fmf{photon}{v,e1} - \fmf{photon}{v,e2} - \fmf{photon}{v,e3} - \fmf{dots}{v,e4} - \fouroutgoing - \end{fmfgraph*}}} \,&= 0 \\ - \label{eq:dilaton-yukawa} - \parbox{28mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(24,22) - \Fourexternal{1}{2}{3}{h_{\mu\nu}} - \fmf{fermion}{e1,v,e2} - \fmf{plain}{v,e3} - \fmf{dots}{v,e4} - \fmfdot{v} - \fmffreeze - \fmf{warrow_right}{v,e3} - \fmf{warrow_right}{v,e4} - \end{fmfgraph*}}} \,&= ??? \\ - \parbox{28mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(24,22) - \Fourexternal{1}{2}{3}{\phi(k)} - \fmf{fermion}{e1,v,e2} - \fmf{photon}{v,e3} - \fmf{dots}{v,e4} - \fmfdot{v} - \fmffreeze - \fmf{warrow_right}{v,e3} - \fmf{warrow_right}{v,e4} - \end{fmfgraph*}}} \,&= - - \ii \frac{3}{2} \omega g \kappa \gamma_{\mu_3} T^{a_3}_{n_1n_2} - \end{align} - \end{subequations} - \caption{\label{fig:dilaton-feynman-rules4} Four-point dilaton couplings. - (\ref{eq:dilaton-scalar-scalar-scalar}), - (\ref{eq:dilaton-scalar-vector-vector}) - and~(\ref{eq:dilaton-yukawa}) are missing - in~\cite{Han/Lykken/Zhang:1999:Kaluza-Klein}, but could be generated - by standard model Higgs selfcouplings, Higgs-gaugeboson couplings, - and Yukawa couplings.} - \end{figure} *) - -(* \begin{figure} - \begin{subequations} - \label{eq:graviton-feynman-rules5} - \begin{align} - \label{eq:graviton-scalar-scalar-scalar-scalar} - \parbox{28mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(24,22) - \Fiveexternal{1}{2}{3}{4}{h_{\mu\nu}} - \fmf{plain}{v,e1} - \fmf{plain}{v,e2} - \fmf{plain}{v,e3} - \fmf{plain}{v,e4} - \fmf{dots}{v,e5} - \fiveoutgoing - \end{fmfgraph*}}} \,&= - \begin{split} - \mbox{} & ??? - \end{split} \\ - \parbox{28mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(24,22) - \Fiveexternal{1}{2}{3}{4}{h_{\mu\nu}} - \fmf{plain}{v,e1} - \fmf{plain}{v,e2} - \fmf{photon}{v,e3} - \fmf{photon}{v,e4} - \fmf{dots}{v,e5} - \fiveoutgoing - \end{fmfgraph*}}} \,&= - \begin{split} - \mbox{} & - \ii g^2 \frac{\kappa}{2} C_{\mu\nu,\mu_3\mu_4} - (T^{a_3}T^{a_4} + T^{a_4}T^{a_3})_{n_2n_1} - \end{split} \\ - \parbox{28mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(24,22) - \Fiveexternal{1}{2}{3}{4}{h_{\mu\nu}} - \fmf{photon}{v,e1} - \fmf{photon}{v,e2} - \fmf{photon}{v,e3} - \fmf{photon}{v,e4} - \fmf{dots}{v,e5} - \fiveoutgoing - \end{fmfgraph*}}} \,&= - \begin{split} - \mbox{} - \ii g^2 \frac{\kappa}{2} - (& f^{ba_1a_3} f^{ba_2a_4} G_{\mu\nu,\mu_1\mu_2\mu_3\mu_4} \\ - & \mbox + f^{ba_1a_2} f^{ba_3a_4} G_{\mu\nu,\mu_1\mu_3\mu_2\mu_4} \\ - & \mbox + f^{ba_1a_4} f^{ba_2a_3} G_{\mu\nu,\mu_1\mu_2\mu_4\mu_3} ) - \end{split} - \end{align} - \end{subequations} - \caption{\label{fig:graviton-feynman-rules5} Five-point graviton couplings. - (\ref{eq:graviton-scalar-scalar-scalar-scalar}) is missing - in~\cite{Han/Lykken/Zhang:1999:Kaluza-Klein}, but should be generated - by standard model Higgs selfcouplings.} - \end{figure} *) - -(* \begin{figure} - \begin{subequations} - \label{eq:dilaton-feynman-rules5} - \begin{align} - \label{eq:dilaton-scalar-scalar-scalar-scalar} - \parbox{28mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(24,22) - \Fiveexternal{1}{2}{3}{4}{\phi(k)} - \fmf{plain}{v,e1} - \fmf{plain}{v,e2} - \fmf{plain}{v,e3} - \fmf{plain}{v,e4} - \fmf{dots}{v,e5} - \fiveoutgoing - \end{fmfgraph*}}} \,&= ??? \\ - \parbox{28mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(24,22) - \Fiveexternal{1}{2}{3}{4}{\phi(k)} - \fmf{plain}{v,e1} - \fmf{plain}{v,e2} - \fmf{photon}{v,e3} - \fmf{photon}{v,e4} - \fmf{dots}{v,e5} - \fiveoutgoing - \end{fmfgraph*}}} \,&= - \ii \omega g^2 \kappa g_{\mu_3\mu_4} - (T^{a_3}T^{a_4} + T^{a_4}T^{a_3})_{n_2n_1} \\ - \parbox{28mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(24,22) - \Fiveexternal{1}{2}{3}{4}{\phi(k)} - \fmf{photon}{v,e1} - \fmf{photon}{v,e2} - \fmf{photon}{v,e3} - \fmf{photon}{v,e4} - \fmf{dots}{v,e5} - \fiveoutgoing - \end{fmfgraph*}}} \,&= 0 - \end{align} - \end{subequations} - \caption{\label{fig:dilaton-feynman-rules5} Five-point dilaton couplings. - (\ref{eq:dilaton-scalar-scalar-scalar-scalar}) is missing - in~\cite{Han/Lykken/Zhang:1999:Kaluza-Klein}, but could be generated - by standard model Higgs selfcouplings.} - \end{figure} *) - -(* \thocwmodulesection{Dependent Parameters} - This is a simple abstract syntax for parameter dependencies. - Later, there will be a parser for a convenient concrete syntax - as a part of a concrete syntax for models. There is no intention - to do \emph{any} symbolic manipulation with this. The expressions - will be translated directly by [Targets] to the target language. *) - -type 'a expr = - | I | Const of int - | Atom of 'a - | Sum of 'a expr list - | Diff of 'a expr * 'a expr - | Neg of 'a expr - | Prod of 'a expr list - | Quot of 'a expr * 'a expr - | Rec of 'a expr - | Pow of 'a expr * int - | Sqrt of 'a expr - | Sin of 'a expr - | Cos of 'a expr - | Tan of 'a expr - | Cot of 'a expr - | Atan2 of 'a expr * 'a expr - | Conj of 'a expr - -type 'a variable = Real of 'a | Complex of 'a -type 'a variable_array = Real_Array of 'a | Complex_Array of 'a - -type 'a parameters = - { input : ('a * float) list; - derived : ('a variable * 'a expr) list; - derived_arrays : ('a variable_array * 'a expr list) list } - -(* \thocwmodulesection{More Exotic Couplings} - \begin{table} - \begin{center} - \renewcommand{\arraystretch}{1.3} - \begin{tabular}{|>{\qquad}r<{:}l|}\hline - \multicolumn{2}{|l|}{[Dim5_Scalar_Vector_Vector_T]: - $\mathcal{L}_I=g\phi - (\ii\partial_\mu V_1^\nu)(\ii\partial_\nu V_2^\mu)$}\\\hline - [F23] & $\phi(k_2+k_3)\leftarrow\ii\cdot g - k_3^\mu V_{1,\mu}(k_2) k_2^\nu V_{2,\nu}(k_3)$ \\\hline - [F32] & $\phi(k_2+k_3)\leftarrow\ii\cdot g - k_2^\mu V_{2,\mu}(k_3) k_3^\nu V_{1,\nu}(k_2)$ \\\hline - [F12] & $V_2^\mu(k_1+k_2)\leftarrow\ii\cdot g - k_2^\mu \phi(k_1) (-k_1^\nu-k_2^\nu) V_{1,\nu}(k_2)$ \\\hline - [F21] & $V_2^\mu(k_1+k_2)\leftarrow\ii\cdot g - k_2^\mu (-k_1^\nu-k_2^\nu)V_{1,\nu}(k_2) \phi(k_1)$ \\\hline - [F13] & $V_1^\mu(k_1+k_3)\leftarrow\ii\cdot g - k_3^\mu \phi(k_1) (-k_1^\nu-k_3^\nu)V_{2,\nu}(k_3)$ \\\hline - [F31] & $V_1^\mu(k_1+k_3)\leftarrow\ii\cdot g - k_3^\mu (-k_1^\nu-k_3^\nu)V_{2,\nu}(k_3) \phi(k_1)$ \\\hline - \end{tabular} - \end{center} - \caption{\label{tab:dim5-scalar-vector-vector} - \ldots} - \end{table} - \begin{table} - \begin{center} - \renewcommand{\arraystretch}{1.3} - \begin{tabular}{|>{\qquad}r<{:}l|}\hline - \multicolumn{2}{|l|}{[Dim6_Vector_Vector_Vector_T]: - $\mathcal{L}_I=gV_1^\mu - ((\ii\partial_\nu V_2^\rho)% - \ii\overleftrightarrow{\partial_\mu} - (\ii\partial_\rho V_3^\nu))$}\\\hline - [F23] & $V_1^\mu(k_2+k_3)\leftarrow\ii\cdot g - (k_2^\mu - k_3^\mu) k_3^\nu V_{2,\nu} (k_2) - k_2^\rho V_{3,\rho}(k_3)$ \\\hline - [F32] & $V_1^\mu(k_2+k_3)\leftarrow\ii\cdot g - (k_2^\mu - k_3^\mu) k_2^\nu V_{3,\nu} (k_3) - k_3^\rho V_{2,\rho}(k_2)$ \\\hline - [F12] & $V_3^\mu(k_1+k_2)\leftarrow\ii\cdot g - k_2^\mu (k_1^\nu+2k_2^\nu) V_{1,\nu} (k_1) - (-k_1^\rho-k_2^\rho) V_{2,\rho}(k_2)$ \\\hline - [F21] & $V_3^\mu(k_1+k_2)\leftarrow\ii\cdot g - k_2^\mu (-k_1^\rho-k_2^\rho) V_{2,\rho}(k_2) - (k_1^\nu+2k_2^\nu) V_{1,\nu} (k_1)$ \\\hline - [F13] & $V_2^\mu(k_1+k_3)\leftarrow\ii\cdot g - k_3^\mu (k_1^\nu+2k_3^\nu) V_{1,\nu} (k_1) - (-k_1^\rho-k_3^\rho) V_{3,\rho}(k_3)$ \\\hline - [F31] & $V_2^\mu(k_1+k_3)\leftarrow\ii\cdot g - k_3^\mu (-k_1^\rho-k_3^\rho) V_{3,\rho}(k_3) - (k_1^\nu+2k_3^\nu) V_{1,\nu} (k_1)$ \\\hline - \end{tabular} - \end{center} - \caption{\label{tab:dim6-vector-vector-vector} - \ldots} - \end{table} - \begin{table} - \begin{center} - \renewcommand{\arraystretch}{1.3} - \begin{tabular}{|>{\qquad}r<{:}l|}\hline - \multicolumn{2}{|l|}{[Tensor_2_Vector_Vector]: - $\mathcal{L}_I=gT^{\mu\nu} - (V_{1,\mu}V_{2,\nu} + V_{1,\nu}V_{2,\mu})$}\\\hline - [F23] & $T^{\mu\nu}(k_2+k_3)\leftarrow\ii\cdot g - (V_{1,\mu}(k_2) V_{2,\nu}(k_3) + V_{1,\nu}(k_2) V_{2,\mu}(k_3))$ \\\hline - [F32] & $T^{\mu\nu}(k_2+k_3)\leftarrow\ii\cdot g - (V_{2,\nu}(k_3) V_{1,\mu}(k_2) + V_{2,\mu}(k_3) V_{1,\nu}(k_2))$ \\\hline - [F12] & $V_2^\mu(k_1+k_2)\leftarrow\ii\cdot g - (T^{\mu\nu}(k_1) + T^{\nu\mu}(k_1)) V_{1,\nu}(k_2)$ \\\hline - [F21] & $V_2^\mu(k_1+k_2)\leftarrow\ii\cdot g - V_{1,\nu}(k_2)(T^{\mu\nu}(k_1) + T^{\nu\mu}(k_1))$ \\\hline - [F13] & $V_1^\mu(k_1+k_3)\leftarrow\ii\cdot g - (T^{\mu\nu}(k_1) + T^{\nu\mu}(k_1)) V_{2,\nu}(k_3)$ \\\hline - [F31] & $V_1^\mu(k_1+k_3)\leftarrow\ii\cdot g - V_{2,\nu}(k_3) (T^{\mu\nu}(k_1) + T^{\nu\mu}(k_1))$ \\\hline - \end{tabular} - \end{center} - \caption{\label{tab:tensor2-vector-vector} - \ldots} - \end{table} - \begin{table} - \begin{center} - \renewcommand{\arraystretch}{1.3} - \begin{tabular}{|>{\qquad}r<{:}l|}\hline - \multicolumn{2}{|l|}{[Dim5_Tensor_2_Vector_Vector_1]: - $\mathcal{L}_I=gT^{\alpha\beta} - (V_1^\mu - \ii\overleftrightarrow\partial_\alpha - \ii\overleftrightarrow\partial_\beta V_{2,\mu})$}\\\hline - [F23] & $T^{\alpha\beta}(k_2+k_3)\leftarrow\ii\cdot g - (k_2^\alpha-k_3^\alpha)(k_2^\beta-k_3^\beta) - V_1^\mu(k_2)V_{2,\mu}(k_3)$ \\\hline - [F32] & $T^{\alpha\beta}(k_2+k_3)\leftarrow\ii\cdot g - (k_2^\alpha-k_3^\alpha)(k_2^\beta-k_3^\beta) - V_{2,\mu}(k_3)V_1^\mu(k_2)$ \\\hline - [F12] & $V_2^\mu(k_1+k_2)\leftarrow\ii\cdot g - (k_1^\alpha+2k_2^\alpha) (k_1^\beta+2k_2^\beta) - T_{\alpha\beta}(k_1) V_1^\mu(k_2)$ \\\hline - [F21] & $V_2^\mu(k_1+k_2)\leftarrow\ii\cdot g - (k_1^\alpha+2k_2^\alpha) (k_1^\beta+2k_2^\beta) - V_1^\mu(k_2) T_{\alpha\beta}(k_1)$ \\\hline - [F13] & $V_1^\mu(k_1+k_3)\leftarrow\ii\cdot g - (k_1^\alpha+2k_3^\alpha) (k_1^\beta+2k_3^\beta) - T_{\alpha\beta}(k_1) V_2^\mu(k_3)$ \\\hline - [F31] & $V_1^\mu(k_1+k_3)\leftarrow\ii\cdot g - (k_1^\alpha+2k_3^\alpha) (k_1^\beta+2k_3^\beta) - V_2^\mu(k_3) T_{\alpha\beta}(k_1)$ \\\hline - \end{tabular} - \end{center} - \caption{\label{tab:dim5-tensor2-vector-vector-1} - \ldots} - \end{table} - \begin{table} - \begin{center} - \renewcommand{\arraystretch}{1.3} - \begin{tabular}{|>{\qquad}r<{:}l|}\hline - \multicolumn{2}{|l|}{[Dim5_Tensor_2_Vector_Vector_2]: - $\mathcal{L}_I=gT^{\alpha\beta} - ( V_1^\mu \ii\overleftrightarrow\partial_\beta (\ii\partial_\mu V_{2,\alpha}) - + V_1^\mu \ii\overleftrightarrow\partial_\alpha (\ii\partial_\mu V_{2,\beta})) - $}\\\hline - [F23] & $T^{\alpha\beta}(k_2+k_3)\leftarrow\ii\cdot g - (k_3^\beta-k_2^\beta) k_3^\mu V_{1,\mu}(k_2)V_2^\alpha(k_3) - + (\alpha\leftrightarrow\beta)$ \\\hline - [F32] & $T^{\alpha\beta}(k_2+k_3)\leftarrow\ii\cdot g - (k_3^\beta-k_2^\beta) V_2^\alpha(k_3) k_3^\mu V_{1,\mu}(k_2) - + (\alpha\leftrightarrow\beta)$ \\\hline - [F12] & $V_2^\alpha(k_1+k_2)\leftarrow\ii\cdot g - (k_1^\beta+2k_2^\beta) - (T^{\alpha\beta}(k_1)+T^{\beta\alpha}(k_1)) - (k_1^\mu+k_2^\mu) V_{1,\mu}(k_2)$ \\\hline - [F21] & $V_2^\alpha(k_1+k_2)\leftarrow\ii\cdot g - (k_1^\mu+k_2^\mu) V_{1,\mu}(k_2) - (k_1^\beta+2k_2^\beta) - (T^{\alpha\beta}(k_1)+T^{\beta\alpha}(k_1))$ \\\hline - [F13] & $V_1^\alpha(k_1+k_3)\leftarrow\ii\cdot g - (k_1^\beta+2k_3^\beta) - (T^{\alpha\beta}(k_1)+T^{\beta\alpha}(k_1)) - (k_1^\mu+k_3^\mu) V_{2,\mu}(k_3)$ \\\hline - [F31] & $V_1^\alpha(k_1+k_3)\leftarrow\ii\cdot g - (k_1^\mu+k_3^\mu) V_{2,\mu}(k_3) - (k_1^\beta+2k_3^\beta) - (T^{\alpha\beta}(k_1)+T^{\beta\alpha}(k_1))$ \\\hline - \end{tabular} - \end{center} - \caption{\label{tab:dim5-tensor2-vector-vector-1'} - \ldots} - \end{table} - \begin{table} - \begin{center} - \renewcommand{\arraystretch}{1.3} - \begin{tabular}{|>{\qquad}r<{:}l|}\hline - \multicolumn{2}{|l|}{[Dim7_Tensor_2_Vector_Vector_T]: - $\mathcal{L}_I=gT^{\alpha\beta} - ((\ii\partial^\mu V_1^\nu) - \ii\overleftrightarrow\partial_\alpha - \ii\overleftrightarrow\partial_\beta - (\ii\partial_\nu V_{2,\mu}))$}\\\hline - [F23] & $T^{\alpha\beta}(k_2+k_3)\leftarrow\ii\cdot g - (k_2^\alpha-k_3^\alpha)(k_2^\beta-k_3^\beta) - k_3^\mu V_{1,\mu}(k_2) k_2^\nu V_{2,\nu}(k_3)$ \\\hline - [F32] & $T^{\alpha\beta}(k_2+k_3)\leftarrow\ii\cdot g - (k_2^\alpha-k_3^\alpha)(k_2^\beta-k_3^\beta) - k_2^\nu V_{2,\nu}(k_3) k_3^\mu V_{1,\mu}(k_2)$ \\\hline - [F12] & $V_2^\mu(k_1+k_2)\leftarrow\ii\cdot g - k_2^\mu - (k_1^\alpha+2k_2^\alpha) (k_1^\beta+2k_2^\beta) - T_{\alpha\beta}(k_1) (-k_1^\nu-k_2^\nu)V_{1,\nu}(k_2)$ \\\hline - [F21] & $V_2^\mu(k_1+k_2)\leftarrow\ii\cdot g - k_2^\mu (-k_1^\nu-k_2^\nu)V_{1,\nu}(k_2) - (k_1^\alpha+2k_2^\alpha) (k_1^\beta+2k_2^\beta) - T_{\alpha\beta}(k_1)$ \\\hline - [F13] & $V_1^\mu(k_1+k_3)\leftarrow\ii\cdot g - k_3^\mu - (k_1^\alpha+2k_3^\alpha) (k_1^\beta+2k_3^\beta) - T_{\alpha\beta}(k_1) (-k_1^\nu-k_3^\nu) V_{2,\nu}(k_3)$ \\\hline - [F31] & $V_1^\mu(k_1+k_3)\leftarrow\ii\cdot g - k_3^\mu (-k_1^\nu-k_3^\nu) V_{2,\nu}(k_3) - (k_1^\alpha+2k_3^\alpha) (k_1^\beta+2k_3^\beta) - T_{\alpha\beta}(k_1)$ \\\hline - \end{tabular} - \end{center} - \caption{\label{tab:dim7-tensor2-vector-vector-T} - \ldots} - \end{table} *) - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/thoGWindow.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/thoGWindow.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/thoGWindow.ml (revision 8703) @@ -1,39 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -(* \thocwmodulesection{Misc.~Windows} *) - -let message ?justify ?title ~text () = - let w = GWindow.window ?title ~border_width:5 () in - let v = GPack.vbox ~spacing:8 ~packing:w#add () in - GMisc.label ~xpad:5 ~ypad:5 ?justify ~text ~packing:v#add (); - let b = GButton.button ~label:"OK" ~packing:v#add () in - b#connect#clicked ~callback:w#destroy; - w#show () - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/product.mli =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/product.mli (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/product.mli (revision 8703) @@ -1,61 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -(* \thocwmodulesection{Lists} - Since April 2001, we preserve lexicographic ordering. *) - -val fold2 : ('a -> 'b -> 'c -> 'c) -> 'a list -> 'b list -> 'c -> 'c -val fold3 : ('a -> 'b -> 'c -> 'd -> 'd) -> 'a list -> 'b list -> 'c list -> 'd -> 'd -val fold : ('a list -> 'b -> 'b) -> 'a list list -> 'b -> 'b - -val list2 : ('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list -val list3 : ('a -> 'b -> 'c -> 'd) -> 'a list -> 'b list -> 'c list -> 'd list -val list : ('a list -> 'b) -> 'a list list -> 'b list - -val power : int -> 'a list -> 'a list list - -val thread : 'a list list -> 'a list list - -(* \thocwmodulesection{Sets} *) - -(* ['a_set] is actually ['a set] for a suitable [set], but this - relation can not be expressed polymorphically (in [set]) in O'Caml. - The two sets can be of different type, but we provide a symmetric - version as syntactic sugar. *) - -type 'a set - -type ('a, 'a_set, 'b) fold = ('a -> 'b -> 'b) -> 'a_set -> 'b -> 'b -type ('a, 'a_set, 'b, 'b_set, 'c) fold2 = - ('a -> 'b -> 'c -> 'c) -> 'a_set -> 'b_set -> 'c -> 'c - -val outer : ('a, 'a_set, 'c) fold -> ('b, 'b_set, 'c) fold -> - ('a, 'a_set, 'b, 'b_set, 'c) fold2 -val outer_self : ('a, 'a_set, 'b) fold -> ('a, 'a_set, 'a, 'a_set, 'b) fold2 - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/options.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/options.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/options.ml (revision 8703) @@ -1,64 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -module A = Map.Make (struct type t = string let compare = compare end) - -type t = - { actions : Arg.spec A.t; - raw : (string * Arg.spec * string) list } - -let empty = { actions = A.empty; raw = [] } - -let create options = - { actions = List.fold_left - (fun a (s, f, _) -> A.add s f a) A.empty options; - raw = options } - -exception Invalid of string * string - -let parse options (name, value) = - try - match A.find name options.actions with - | Arg.Unit f -> f () - | Arg.Set b -> b := true - | Arg.Clear b -> b := false - | Arg.String f -> f value - | Arg.Int f -> f (int_of_string value) - | Arg.Float f -> f (float_of_string value) - | _ -> invalid_arg "Options.parse" - with - | Not_found -> raise (Invalid (name, value)) - -let list options = - List.map (fun (o, _, d) -> (o, d)) options.raw - -let cmdline prefix options = - List.map (fun (o, f, d) -> (prefix ^ o, f, d)) options.raw - - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/models.mli =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/models.mli (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/models.mli (revision 8703) @@ -1,89 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -(* \thocwmodulesection{Compilation} *) - -module type Flavor = - sig - type f - type c - val compare : f -> f -> int - val conjugate : f -> f - end - -module type Fusions = - sig - type t - type f - type c - val fuse2 : t -> f -> f -> (f * c Coupling.t) list - val fuse3 : t -> f -> f -> f -> (f * c Coupling.t) list - val fuse : t -> f list -> (f * c Coupling.t) list - val of_vertices : - (((f * f * f) * c Coupling.vertex3 * c) list - * ((f * f * f * f) * c Coupling.vertex4 * c) list - * (f list * c Coupling.vertexn * c) list) -> t - end - -module Fusions : functor (F : Flavor) -> - Fusions with type f = F.f and type c = F.c - -(* \thocwmodulesection{Mutable Models} *) - -module Mutable : functor (FGC : sig type f and g and c end) -> - Model.Mutable with type flavor = FGC.f and type gauge = FGC.g - and type constant = FGC.c - -(* \thocwmodulesection{Hardcoded Models} *) - -module Phi3 : Model.T -module Phi4 : Model.T -module QED : Model.T -module YM : Model.T -module type SM_flags = - sig - val triple_anom : bool - val quartic_anom : bool - val higgs_anom : bool - val k_matrix : bool - val ckm_present : bool - end -module SM_no_anomalous : SM_flags -module SM_anomalous : SM_flags -module SM_k_matrix : SM_flags -module SM_no_anomalous_ckm : SM_flags -module SM_anomalous_ckm : SM_flags -module SM3 : functor (F : SM_flags) -> Model.Gauge -module SM : functor (F : SM_flags) -> Model.Gauge -module SM_Rxi : Model.T - -module Groves : functor (M : Model.Gauge) -> Model.Gauge -module SM_clones : Model.Gauge -module SM3_clones : Model.Gauge - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/models3.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/models3.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/models3.ml (revision 8703) @@ -1,1691 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -let rcs_file = RCS.parse "Models3" ["extended SUSY models"] - { RCS.revision = "$Revision$"; - RCS.date = "$Date$"; - RCS.author = "$Author$"; - RCS.source - = "$URL$" } - -(* \thocwmodulesection{Next-to-Minimal Supersymmetric Standard Model} *) - -module type extMSSM_flags = - sig - val ckm_present : bool - val nmssm : bool - val exotics : bool - end - -module NMSSM : extMSSM_flags = - struct - let ckm_present = false - let nmssm = true - let exotics = false - end - -module E6SSM : extMSSM_flags = - struct - let ckm_present = false - let nmssm = true - let exotics = true - end - - -module ExtMSSM (Flags : extMSSM_flags) = - struct - let rcs = RCS.rename rcs_file "Models.NMSSM" - [ "NMSSM" ] - - open Coupling - - let default_width = ref Timelike - let use_fudged_width = ref false - - let options = Options.create - [ "constant_width", Arg.Unit (fun () -> default_width := Constant), - "use constant width (also in t-channel)"; - "fudged_width", Arg.Set use_fudged_width, - "use fudge factor for charge particle width"; - "custom_width", Arg.String (fun f -> default_width := Custom f), - "use custom width"; - "cancel_widths", Arg.Unit (fun () -> default_width := Vanishing), - "use vanishing width"] - - type gen = - | G of int | GG of gen*gen - - let rec string_of_gen = function - | G n when n > 0 -> string_of_int n - | G n -> string_of_int (abs n) ^ "c" - | GG (g1,g2) -> string_of_gen g1 ^ "_" ^ string_of_gen g2 - -(* With this we distinguish the flavour. *) - - type sff = - | SL | SN | SU | SD - - let string_of_sff = function - | SL -> "sl" | SN -> "sn" | SU -> "su" | SD -> "sd" - -(* With this we distinguish the mass eigenstates. At the moment we have to cheat - a little bit for the sneutrinos. Because we are dealing with massless - neutrinos there is only one sort of sneutrino. *) - - type sfm = - | M1 | M2 - - let string_of_sfm = function - | M1 -> "1" | M2 -> "2" - -(* We also introduce special types for the charginos and neutralinos. *) - - type char = - | C1 | C2 | C1c | C2c - - type neu = - | N1 | N2 | N3 | N4 | N5 - - let int_of_char = function - | C1 -> 1 | C2 -> 2 | C1c -> -1 | C2c -> -2 - - let string_of_char = function - | C1 -> "1" | C2 -> "2" | C1c -> "-1" | C2c -> "-2" - - let conj_char = function - | C1 -> C1c | C2 -> C2c | C1c -> C1 | C2c -> C2 - - let string_of_neu = function - | N1 -> "1" | N2 -> "2" | N3 -> "3" | N4 -> "4" | N5 -> "n5" - -(* Also we need types to distinguish the Higgs bosons. We follow the - conventions of Kuroda, which means - \begin{align} - \label{eq:higgs3} - H_1 &= - \begin{pmatrix} - \frac{1}{\sqrt{2}} - \bigl( - v_1 + H^0 \cos\alpha - h^0 - \sin\alpha + \ii A^0 \sin\beta - \ii \phi^0 \cos\beta - \bigr) \\ - H^- \sin\beta - \phi^- \cos\beta - \end{pmatrix}, - \\ & \notag \\ - H_2 & = - \begin{pmatrix} - H^+ \cos\beta + \phi^+ \sin\beta \\ - \frac{1}{\sqrt{2}} - \bigl( - v_2 + H^0 \sin\alpha + h^0 \cos\alpha + \ii A^0 \cos\beta + - \ii \phi^0 \sin\beta - \bigr) - \end{pmatrix} - \label{eq:higgs4} - \end{align} - This is a different sign convention compared to, e.g., - Weinberg's volume iii. We will refer to it as [GS+]. -*) - - type higgs = - | H1 (* the light scalar Higgs *) - | H2 (* the heavy scalar Higgs *) - | H3 (* the pseudoscalar Higgs *) - | H4 (* the charged Higgs *) - | H5 (* the neutral Goldstone boson *) - | H6 (* the charged Goldstone boson *) - | DH of higgs*higgs - - let rec string_of_higgs = function - | H1 -> "h1" | H2 -> "h2" | H3 -> "h3" | H4 -> "h4" - | H5 -> "p1" | H6 -> "p2" - | DH (h1,h2) -> string_of_higgs h1 ^ string_of_higgs h2 - - type flavor = - | L of int | N of int - | U of int | D of int - | Sup of sfm*int | Sdown of sfm*int - | Ga | Wp | Wm | Z | Gl - | Slepton of sfm*int | Sneutrino of int - | Neutralino of neu | Chargino of char - | Gluino - | H_Heavy | H_Light | Hp | Hm | A - | S0 | P0 - type flavor_sans_color = flavor - let flavor_sans_color f = f - - type gauge = unit - - let gauge_symbol () = - failwith "Models.ExtMSSM.gauge_symbol: internal error" - -(* At this point we will forget graviton and -tino. *) - - let family g = [ L g; N g; Slepton (M1,g); - Slepton (M2,g); Sneutrino g; - U g; D g; Sup (M1,g); Sup (M2,g); - Sdown (M1,g); Sdown (M2,g)] - -(* For the non-QCD version we NOW allow gluons and gluinos as external particles. - (In expectation of Thorsten's marvelous functor.) *) - - let external_flavors () = - [ "1st Generation matter", ThoList.flatmap family [1; -1]; - "2nd Generation matter", ThoList.flatmap family [2; -2]; - "3rd Generation matter", ThoList.flatmap family [3; -3]; - "Gauge Bosons", [Ga; Z; Wp; Wm; Gl]; - "Charginos", [Chargino C1; Chargino C2; Chargino C1c; Chargino C2c]; - "Neutralinos", [Neutralino N1; Neutralino N2; Neutralino N3; - Neutralino N4] @ - if Flags.nmssm then [Neutralino N5] else []; - "Higgs Bosons", [H_Heavy; H_Light; Hp; Hm; A] @ - if Flags.nmssm then [S0; P0] else []; - "Gluino", [Gluino]] - - let flavors () = ThoList.flatmap snd (external_flavors ()) - - let spinor n m = - if n >= 0 && m >= 0 then - Spinor - else if - n <= 0 && m <=0 then - ConjSpinor - else - invalid_arg "Models.ExtMSSM.spinor: internal error" - - let lorentz = function - | L g -> spinor g 0 | N g -> spinor g 0 - | U g -> spinor g 0 | D g -> spinor g 0 - | Chargino c -> spinor (int_of_char c) 0 - | Ga | Gl -> Vector - | Wp | Wm | Z -> Massive_Vector - | H_Heavy | H_Light | Hp | Hm | A -> Scalar - | Sup _ | Sdown _ | Slepton _ | Sneutrino _ -> Scalar - | Neutralino _ -> Majorana - | Gluino -> Majorana - | _ -> invalid_arg "Models.ExtMSSM.lorentz: internal error" - - let color = function - | U g -> Color.SUN (if g > 0 then 3 else -3) - | Sup (m,g) -> Color.SUN (if g > 0 then 3 else -3) - | D g -> Color.SUN (if g > 0 then 3 else -3) - | Sdown (m,g) -> Color.SUN (if g > 0 then 3 else -3) - | Gl | Gluino -> Color.AdjSUN 3 - | _ -> Color.Singlet - - - let prop_spinor n m = - if n >= 0 && m >=0 then - Prop_Spinor - else if - n <=0 && m <=0 then - Prop_ConjSpinor - else - invalid_arg "Models.ExtMSSM.prop_spinor: internal error" - - let propagator = function - | L g -> prop_spinor g 0 | N g -> prop_spinor g 0 - | U g -> prop_spinor g 0 | D g -> prop_spinor g 0 - | Chargino c -> prop_spinor (int_of_char c) 0 - | Ga | Gl -> Prop_Feynman - | Wp | Wm | Z -> Prop_Unitarity - | H_Heavy | H_Light | Hp | Hm | A | S0 | P0 -> Prop_Scalar - | Sup _ | Sdown _ | Slepton _ | Sneutrino _ -> Prop_Scalar - | Gluino -> Prop_Majorana -(* | Gluino0 -> Prop_Col_Majorana *) - | Neutralino _ -> Prop_Majorana - -(* Optionally, ask for the fudge factor treatment for the widths of - charged particles. Currently, this only applies to $W^\pm$ and top. *) - - let width f = - if !use_fudged_width then - match f with - | Wp | Wm | U 3 | U (-3) -> Fudged - | _ -> !default_width - else - !default_width - - let goldstone _ = None - - let conjugate = function - | L g -> L (-g) | N g -> N (-g) - | U g -> U (-g) | D g -> D (-g) - | Sup (m,g) -> Sup (m,-g) - | Sdown (m,g) -> Sdown (m,-g) - | Slepton (m,g) -> Slepton (m,-g) - | Sneutrino g -> Sneutrino (-g) - | Gl -> Gl | Ga -> Ga | Z -> Z - | Wp -> Wm | Wm -> Wp - | H_Heavy -> H_Heavy | H_Light -> H_Light | A -> A - | Hp -> Hm | Hm -> Hp | S0 -> S0 | P0 -> P0 - | Gluino -> Gluino - | Neutralino n -> Neutralino n | Chargino c -> Chargino (conj_char c) - | _ -> invalid_arg "Models.ExtMSSM.conjugate: internal error" - - let conjugate_sans_color = conjugate - - let fermion = function - | L g -> if g > 0 then 1 else -1 - | N g -> if g > 0 then 1 else -1 - | U g -> if g > 0 then 1 else -1 - | D g -> if g > 0 then 1 else -1 - | Gl | Ga | Z | Wp | Wm -> 0 - | H_Heavy | H_Light | Hp | Hm | A | S0 | P0 -> 0 - | Neutralino _ -> 2 - | Chargino c -> if (int_of_char c) > 0 then 1 else -1 - | Sup _ -> 0 | Sdown _ -> 0 - | Slepton _ -> 0 | Sneutrino _ -> 0 - | Gluino -> 2 - -(* Because the O'Caml compiler only allows 248 constructors we must divide the - constants into subgroups of constants, e.g. for the Higgs couplings. In the - MSSM there are a lot of angles among the parameters, the Weinberg-angle, the - angle describing the Higgs vacuum structure, the mixing angle of the real - parts of the Higgs dubletts, the mixing angles of the sfermions. Therefore we - are going to define the trigonometric functions of those angles not as - constants but as functors of the angels. Sums and differences of angles are - only used as arguments for the $\alpha$ and $\beta$ angles, so it makes no - sense to define special functions for differences and sums of angles. *) - - type angle = - | Thw | Al | Be | Th_SF of sff*int | Delta | CKM_12 | CKM_13 | CKM_23 - - let string_of_angle = function - | Thw -> "thw" | Al -> "al" | Be -> "be" | Delta -> "d" - | CKM_12 -> "ckm12" | CKM_13 -> "ckm13" | CKM_23 -> "ckm23" - | Th_SF (f,g) -> "th" ^ string_of_sff f ^ string_of_int g - -(* We introduce a Boolean type vc as a pseudonym for Vertex Conjugator to - distinguish between vertices containing complex mixing matrices like the - CKM--matrix or the sfermion or neutralino/chargino--mixing matrices, which - have to become complex conjugated. The true--option stands for the conjugated - vertex, the false--option for the unconjugated vertex. *) - - type vc = bool - - type constant = - | Unit | Pi | Alpha_QED | Sin2thw - | Sin of angle | Cos of angle | E | G | Vev | Tanb | Tana - | Cos2be | Cos2al | Sin2be | Sin2al | Sin4al | Sin4be | Cos4be - | Cosapb | Cosamb | Sinapb | Sinamb | Cos2am2b | Sin2am2b - | Eidelta - | Mu | AU of int | AD of int | AL of int - | V_CKM of int*int | M_SF of sff*int*sfm*sfm - | M_V of char*char (* left chargino mixing matrix *) - | M_U of char*char (* right chargino mixing matrix *) - | M_N of neu*neu (* neutralino mixing matrix *) - | V_0 of neu*neu | A_0 of neu*neu | V_P of char*char | A_P of char*char - | L_CN of char*neu | R_CN of char*neu | L_NC of neu*char | R_NC of neu*char -(*i | L_NF of neu*sff*sfm | R_NF of neu*sff*sfm i*) - | S_NNH1 of neu*neu | P_NNH1 of neu*neu - | S_NNH2 of neu*neu | P_NNH2 of neu*neu - | S_NNA of neu*neu | P_NNA of neu*neu - | S_NNG of neu*neu | P_NNG of neu*neu - | L_CNG of char*neu | R_CNG of char*neu - | L_NCH of neu*char | R_NCH of neu*char - | Q_lepton | Q_up | Q_down | Q_charg - | G_Z | G_CC | G_CCQ of vc*int*int - | G_NC_neutrino | G_NC_lepton | G_NC_up | G_NC_down - | I_Q_W | I_G_ZWW | G_WWWW | G_ZZWW | G_PZWW | G_PPWW - | G_strong | G_SS | I_G_S | G_S_Sqrt - | Gs - | M of flavor | W of flavor - | G_NZN of neu*neu | G_CZC of char*char - | G_YUK of int*int - | DUM of int - | G_YUK_1 of int*int | G_YUK_2 of int*int | G_YUK_3 of int*int - | G_YUK_4 of int*int | G_NHC of neu*char | G_CHN of char*neu - | G_YUK_C of vc*int*char*sff*sfm - | G_YUK_Q of vc*int*int*char*sff*sfm - | G_YUK_N of vc*int*neu*sff*sfm - | G_YUK_G of vc*int*sff*sfm - | G_NGC of neu*char | G_CGN of char*neu - | SUM_1 - | G_NWC of neu*char | G_CWN of char*neu - | G_CH1C of char*char | G_CH2C of char*char | G_CAC of char*char - | G_CGC of char*char - | G_SWS of vc*int*int*sfm*sfm - | G_SLSNW of vc*int*sfm - | G_ZSF of sff*int*sfm*sfm - | G_CICIH1 of neu*neu | G_CICIH2 of neu*neu | G_CICIA of neu*neu - | G_CICIG of neu*neu - | G_GH of int | G_GHGo of int - | G_WWSFSF of sff*int*sfm*sfm - | G_WPSLSN of vc*int*sfm - | G_H3 of int | G_H4 of int - | G_HGo3 of int | G_HGo4 of int | G_GG4 of int - | G_H1SFSF of sff*int*sfm*sfm | G_H2SFSF of sff*int*sfm*sfm - | G_ASFSF of sff*int*sfm*sfm - | G_HSNSL of vc*int*sfm - | G_GoSFSF of sff*int*sfm*sfm - | G_GoSNSL of vc*int*sfm - | G_HSUSD of vc*sfm*sfm*int*int | G_GSUSD of vc*sfm*sfm*int*int - | G_WPSUSD of vc*sfm*sfm*int*int - | G_WZSUSD of vc*sfm*sfm*int*int - | G_WZSLSN of vc*int*sfm | G_GlGlSQSQ - | G_PPSFSF of sff - | G_ZZSFSF of sff*int*sfm*sfm | G_ZPSFSF of sff*int*sfm*sfm - | G_GlZSFSF of sff*int*sfm*sfm | G_GlPSQSQ - | G_GlWSUSD of vc*sfm*sfm*int*int - | G_GH4 of int | G_GHGo4 of int - | G_H1H2SFSF of sff*sfm*sfm*int - | G_H1H1SFSF of sff*sfm*sfm*int - | G_H2H2SFSF of sff*sfm*sfm*int - | G_HHSFSF of sff*sfm*sfm*int - | G_AASFSF of sff*sfm*sfm*int - | G_HH1SLSN of vc*sfm*int | G_HH2SLSN of vc*sfm*int - | G_HASLSN of vc*sfm*int - | G_HH1SUSD of vc*sfm*sfm*int*int - | G_HH2SUSD of vc*sfm*sfm*int*int - | G_HASUSD of vc*sfm*sfm*int*int - | G_AG0SFSF of sff*sfm*sfm*int - | G_HGSFSF of sff*sfm*sfm*int - | G_GGSFSF of sff*sfm*sfm*int - | G_G0G0SFSF of sff*sfm*sfm*int - | G_HGSNSL of vc*sfm*int | G_H1GSNSL of vc*sfm*int - | G_H2GSNSL of vc*sfm*int | G_AGSNSL of vc*sfm*int - | G_GGSNSL of vc*sfm*int - | G_HGSUSD of vc*sfm*sfm*int*int - | G_H1GSUSD of vc*sfm*sfm*int*int - | G_H2GSUSD of vc*sfm*sfm*int*int - | G_AGSUSD of vc*sfm*sfm*int*int - | G_GGSUSD of vc*sfm*sfm*int*int - | G_SN4 of int*int - | G_SN2SL2_1 of sfm*sfm*int*int | G_SN2SL2_2 of sfm*sfm*int*int - | G_SF4 of sff*sff*sfm*sfm*sfm*sfm*int*int - | G_SF4_3 of sff*sff*sfm*sfm*sfm*sfm*int*int*int - | G_SF4_4 of sff*sff*sfm*sfm*sfm*sfm*int*int*int*int - | G_SL4 of sfm*sfm*sfm*sfm*int - | G_SL4_2 of sfm*sfm*sfm*sfm*int*int - | G_SN2SQ2 of sff*sfm*sfm*int*int - | G_SL2SQ2 of sff*sfm*sfm*sfm*sfm*int*int - | G_SUSDSNSL of vc*sfm*sfm*sfm*int*int*int - | G_SU4 of sfm*sfm*sfm*sfm*int - | G_SU4_2 of sfm*sfm*sfm*sfm*int*int - | G_SD4 of sfm*sfm*sfm*sfm*int - | G_SD4_2 of sfm*sfm*sfm*sfm*int*int - | G_SU2SD2 of sfm*sfm*sfm*sfm*int*int*int*int - | G_HSF31 of higgs*int*sfm*sfm*sff*sff - | G_HSF32 of higgs*int*int*sfm*sfm*sff*sff - | G_HSF41 of higgs*int*sfm*sfm*sff*sff - | G_HSF42 of higgs*int*int*sfm*sfm*sff*sff - - let ferm_of_sff = function - | SL, g -> (L g) | SN, g -> (N g) - | SU, g -> (U g) | SD, g -> (D g) - -(* \begin{subequations} - \begin{align} - \alpha_{\text{QED}} &= \frac{1}{137.0359895} \\ - \sin^2\theta_w &= 0.23124 - \end{align} - \end{subequations} - -Here we must perhaps allow for complex input parameters. So split them -into their modulus and their phase. At first, we leave them real; the -generalization to complex parameters is obvious. *) - - - let parameters () = - { input = []; - derived = []; - derived_arrays = [] } - - module F = Models.Fusions (struct - type f = flavor - type c = constant - let compare = compare - let conjugate = conjugate - end) - - -(* For the couplings there are generally two possibilities concerning the - sign of the covariant derivative. - \begin{equation} - {\rm CD}^\pm = \partial_\mu \pm \ii g T^a A^a_\mu - \end{equation} - The particle data group defines the signs consistently to be positive. - Since the convention for that signs also influence the phase definitions - of the gaugino/higgsino fields via the off-diagonal entries in their - mass matrices it would be the best to adopt that convention. *) - -(*** REVISED: Compatible with CD+. ***) - let electromagnetic_currents_3 g = - [ ((L (-g), Ga, L g), FBF (1, Psibar, V, Psi), Q_lepton); - ((U (-g), Ga, U g), FBF (1, Psibar, V, Psi), Q_up); - ((D (-g), Ga, D g), FBF (1, Psibar, V, Psi), Q_down)] - -(*** REVISED: Compatible with CD+. ***) - let electromagnetic_sfermion_currents g m = - [ ((Ga, Slepton (m,-g), Slepton (m,g)), Vector_Scalar_Scalar 1, Q_lepton); - ((Ga, Sup (m,-g), Sup (m,g)), Vector_Scalar_Scalar 1, Q_up); - ((Ga, Sdown (m,-g), Sdown (m,g)), Vector_Scalar_Scalar 1, Q_down)] - -(*** REVISED: Compatible with CD+. ***) - let electromagnetic_currents_2 c = - let cc = conj_char c in - [ ((Chargino cc, Ga, Chargino c), FBF (1, Psibar, V, Psi), Q_charg) ] - -(*** REVISED: Compatible with CD+. ***) - let neutral_currents g = - [ ((L (-g), Z, L g), FBF (1, Psibar, VA, Psi), G_NC_lepton); - ((N (-g), Z, N g), FBF (1, Psibar, VA, Psi), G_NC_neutrino); - ((U (-g), Z, U g), FBF (1, Psibar, VA, Psi), G_NC_up); - ((D (-g), Z, D g), FBF (1, Psibar, VA, Psi), G_NC_down)] - -(* \begin{equation} - \mathcal{L}_{\textrm{CC}} = - \mp \frac{g}{2\sqrt2} \sum_i \bar\psi_i \gamma^\mu - (1-\gamma_5)(T^+W^+_\mu+T^-W^-_\mu)\psi_i , - \end{equation} - where the sign corresponds to $\text{CD}_\pm$, respectively. *) - -(*** REVISED: Compatible with CD+. ***) - (* Remark: The definition with the other sign compared to the SM files - comes from the fact that $g_{cc} = 1/(2\sqrt{2})$ is used - overwhelmingly often in the SUSY Feynman rules, so that JR - decided to use a different definiton for [g_cc] in SM and MSSM. *) - let charged_currents g = - [ ((L (-g), Wm, N g), FBF ((-1), Psibar, VL, Psi), G_CC); - ((N (-g), Wp, L g), FBF ((-1), Psibar, VL, Psi), G_CC) ] - -(* The quark with the inverted generation (the antiparticle) is the outgoing - one, the other the incoming. The vertex attached to the outgoing up-quark - contains the CKM matrix element {\em not} complex conjugated, while the - vertex with the outgoing down-quark has the conjugated CKM matrix - element. *) - -(*** REVISED: Compatible with CD+. ***) - let charged_quark_currents g h = - [ ((D (-g), Wm, U h), FBF ((-1), Psibar, VL, Psi), G_CCQ (true,g,h)); - ((U (-g), Wp, D h), FBF ((-1), Psibar, VL, Psi), G_CCQ (false,h,g))] - -(*** REVISED: Compatible with CD+. ***) - let charged_chargino_currents n c = - let cc = conj_char c in - [ ((Chargino cc, Wp, Neutralino n), - FBF (1, Psibar, VLR, Chi), G_CWN (c,n)); - ((Neutralino n, Wm, Chargino c), - FBF (1, Chibar, VLR, Psi), G_NWC (n,c)) ] - -(*** REVISED: Compatible with CD+. ***) - let charged_slepton_currents g m = - [ ((Wm, Slepton (m,-g), Sneutrino g), Vector_Scalar_Scalar (-1), G_SLSNW - (true,g,m)); - ((Wp, Slepton (m,g), Sneutrino (-g)), Vector_Scalar_Scalar 1, G_SLSNW - (false,g,m)) ] - -(*** REVISED: Compatible with CD+. ***) - let charged_squark_currents' g h m1 m2 = - [ ((Wm, Sup (m1,g), Sdown (m2,-h)), Vector_Scalar_Scalar (-1), G_SWS - (true,g,h,m1,m2)); - ((Wp, Sup (m1,-g), Sdown (m2,h)), Vector_Scalar_Scalar 1, G_SWS - (false,g,h,m1,m2)) ] - let charged_squark_currents g h = List.flatten (Product.list2 - (charged_squark_currents' g h) [M1;M2] [M1;M2]) - -(*** REVISED: Compatible with CD+. ***) - let neutral_sfermion_currents' g m1 m2 = - [ ((Z, Slepton (m1,-g), Slepton (m2,g)), Vector_Scalar_Scalar (-1), G_ZSF - (SL,g,m1,m2)); - ((Z, Sup (m1,-g), Sup (m2,g)), Vector_Scalar_Scalar (-1), G_ZSF - (SU,g,m1,m2)); - ((Z, Sdown (m1,-g), Sdown (m2,g)), Vector_Scalar_Scalar (-1), G_ZSF - (SD,g,m1,m2))] - let neutral_sfermion_currents g = - List.flatten (Product.list2 (neutral_sfermion_currents' - g) [M1;M2] [M1;M2]) @ - [ ((Z, Sneutrino (-g), Sneutrino g), Vector_Scalar_Scalar (-1), G_ZSF - (SN,g,M1,M1)) ] - -(* The reality of the coupling of the Z-boson to two identical neutralinos - makes the vector part of the coupling vanish. So we distinguish them not - by the name but by the structure of the couplings. *) - -(*** REVISED: Compatible with CD+. ***) - let neutral_Z_1 (n,m) = - [ ((Neutralino n, Z, Neutralino m), FBF (1, Chibar, VA, Chi), - (G_NZN (n,m))) ] -(*** REVISED: Compatible with CD+. ***) - let neutral_Z_2 n = - [ ((Neutralino n, Z, Neutralino n), FBF (1, Chibar, Coupling.A, Chi), - (G_NZN (n,n)) )] - -(*** REVISED: Compatible with CD+. ***) - let charged_Z c1 c2 = - let cc1 = conj_char c1 in - ((Chargino cc1, Z, Chargino c2), FBF ((-1), Psibar, VA, Psi), - G_CZC (c1,c2)) - -(*** REVISED: Compatible with CD+. - Remark: This is pure octet. -***) - let yukawa_v = - [ (Gluino, Gl, Gluino), FBF (1, Chibar, V, Chi), Gs] - -(*** REVISED: Independent of the sign of CD. ***) - let yukawa_higgs g = - [ ((N (-g), Hp, L g), FBF (1, Psibar, Coupling.SR, Psi), G_YUK (6,g)); - ((L (-g), Hm, N g), FBF (1, Psibar, Coupling.SL, Psi), G_YUK (6,g)); - ((L (-g), H_Heavy, L g), FBF (1, Psibar, S, Psi), G_YUK (7,g)); - ((L (-g), H_Light, L g), FBF (1, Psibar, S, Psi), G_YUK (8,g)); - ((L (-g), A, L g), FBF (1, Psibar, P, Psi), G_YUK (9,g)); - ((U (-g), H_Heavy, U g), FBF (1, Psibar, S, Psi), G_YUK (10,g)); - ((U (-g), H_Light, U g), FBF (1, Psibar, S, Psi), G_YUK (11,g)); - ((U (-g), A, U g), FBF (1, Psibar, P, Psi), G_YUK (12,g)); - ((D (-g), H_Heavy, D g), FBF (1, Psibar, S, Psi), G_YUK (13,g)); - ((D (-g), H_Light, D g), FBF (1, Psibar, S, Psi), G_YUK (14,g)); - ((D (-g), A, D g), FBF (1, Psibar, P, Psi), G_YUK (15,g)) ] - -(*** REVISED: Independent of the sign of CD. ***) - let yukawa_higgs_quark (g,h) = - [ ((U (-g), Hp, D h), FBF (1, Psibar, SLR, Psi), G_YUK_1 (g, h)); - ((D (-h), Hm, U g), FBF (1, Psibar, SLR, Psi), G_YUK_2 (g, h)) ] - -(*** REVISED: Compatible with CD+. *) - let yukawa_higgs_2' (c1,c2) = - let cc1 = conj_char c1 in - [ ((Chargino cc1, H_Heavy, Chargino c2), FBF (1, Psibar, SLR, Psi), - G_CH2C (c1,c2)); - ((Chargino cc1, H_Light, Chargino c2), FBF (1, Psibar, SLR, Psi), - G_CH1C (c1,c2)); - ((Chargino cc1, A, Chargino c2), FBF (1, Psibar, SLR, Psi), - G_CAC (c1,c2)) ] - let yukawa_higgs_2'' c = - let cc = conj_char c in - [ ((Chargino cc, H_Heavy, Chargino c), FBF (1, Psibar, S, Psi), - G_CH2C (c,c)); - ((Chargino cc, H_Light, Chargino c), FBF (1, Psibar, S, Psi), - G_CH1C (c,c)); - ((Chargino cc, A, Chargino c), FBF (1, Psibar, P, Psi), - G_CAC (c,c)) ] - let yukawa_higgs_2 = - ThoList.flatmap yukawa_higgs_2' [(C1,C2);(C2,C1)] @ - ThoList.flatmap yukawa_higgs_2'' [C1;C2] - -(*** REVISED: Compatible with CD+. ***) - let higgs_charg_neutr n c = - let cc = conj_char c in - [ ((Neutralino n, Hm, Chargino c), FBF (-1, Chibar, SLR, Psi), - G_NHC (n,c)); - ((Chargino cc, Hp, Neutralino n), FBF (-1, Psibar, SLR, Chi), - G_CHN (c,n)) ] - -(*** REVISED: Compatible with CD+. ***) - let higgs_neutr' (n,m) = - [ ((Neutralino n, H_Heavy, Neutralino m), FBF (1, Chibar, SP, Chi), - G_CICIH2 (n,m)); - ((Neutralino n, H_Light, Neutralino m), FBF (1, Chibar, SP, Chi), - G_CICIH1 (n,m)); - ((Neutralino n, A, Neutralino m), FBF (1, Chibar, SP, Chi), - G_CICIA (n,m)) ] - let higgs_neutr'' n = - [ ((Neutralino n, H_Heavy, Neutralino n), FBF (1, Chibar, S, Chi), - G_CICIH2 (n,n)); - ((Neutralino n, H_Light, Neutralino n), FBF (1, Chibar, S, Chi), - G_CICIH1 (n,n)); - ((Neutralino n, A, Neutralino n), FBF (1, Chibar, P, Chi), - G_CICIA (n,n)) ] - let higgs_neutr = - ThoList.flatmap higgs_neutr' [(N1,N2);(N1,N3);(N1,N4); - (N2,N3);(N2,N4);(N3,N4)] @ - ThoList.flatmap higgs_neutr'' [N1;N2;N3;N4] - -(*** REVISED: Compatible with CD+. ***) - let yukawa_n_1 n g = - [ ((Neutralino n, Slepton (M1,-g), L g), FBF (1, Chibar, Coupling.SL, - Psi), G_YUK_N (true,g,n,SL,M1)); - ((Neutralino n, Slepton (M2,-g), L g), FBF (1, Chibar, SR, Psi), - G_YUK_N (true,g,n,SL,M2)); - ((L (-g), Slepton (M1,g), Neutralino n), FBF (1, Psibar, SR, Chi), - G_YUK_N (false,g,n,SL,M1)); - ((L (-g), Slepton (M2,g), Neutralino n), FBF (1, Psibar, Coupling.SL, - Chi), G_YUK_N (false,g,n,SL,M2)); - ((Neutralino n, Sup (M1,-g), U g), FBF (1, Chibar, Coupling.SL, - Psi), G_YUK_N (true,g,n,SU,M1)); - ((Neutralino n, Sup (M2,-g), U g), FBF (1, Chibar, SR, Psi), - G_YUK_N (true,g,n,SU,M2)); - ((U (-g), Sup (M1,g), Neutralino n), FBF (1, Psibar, SR, Chi), - G_YUK_N (false,g,n,SU,M1)); - ((U (-g), Sup (M2,g), Neutralino n), FBF (1, Psibar, Coupling.SL, - Chi), G_YUK_N (false,g,n,SU,M2)); - ((Neutralino n, Sdown (M1,-g), D g), FBF (1, Chibar, Coupling.SL, - Psi), G_YUK_N (true,g,n,SD,M1)); - ((Neutralino n, Sdown (M2,-g), D g), FBF (1, Chibar, SR, Psi), - G_YUK_N (true,g,n,SD,M2)); - ((D (-g), Sdown (M1,g), Neutralino n), FBF (1, Psibar, SR, Chi), - G_YUK_N (false,g,n,SD,M1)); - ((D (-g), Sdown (M2,g), Neutralino n), FBF (1, Psibar, Coupling.SL, - Chi), G_YUK_N (false,g,n,SD,M2)) ] - let yukawa_n_2 n m = - [ ((Neutralino n, Slepton (m,-3), L 3), FBF (1, Chibar, SLR, Psi), - G_YUK_N (true,3,n,SL,m)); - ((L (-3), Slepton (m,3), Neutralino n), FBF (1, Psibar, SLR, Chi), - G_YUK_N (false,3,n,SL,m)); - ((Neutralino n, Sup (m,-3), U 3), FBF (1, Chibar, SLR, Psi), - G_YUK_N (true,3,n,SU,m)); - ((U (-3), Sup (m,3), Neutralino n), FBF (1, Psibar, SLR, Chi), - G_YUK_N (false,3,n,SU,m)); - ((Neutralino n, Sdown (m,-3), D 3), FBF (1, Chibar, SLR, Psi), - G_YUK_N (true,3,n,SD,m)); - ((D (-3), Sdown (m,3), Neutralino n), FBF (1, Psibar, SLR, Chi), - G_YUK_N (false,3,n,SD,m)) ] - let yukawa_n_3 n g = - [ ((Neutralino n, Sneutrino (-g), N g), FBF (1, Chibar, Coupling.SL, - Psi), G_YUK_N (true,g,n,SN,M1)); - ((N (-g), Sneutrino g, Neutralino n), FBF (1, Psibar, SR, Chi), - G_YUK_N (false,g,n,SN,M1)) ] -(* In principle, we need here the Gluino0 vertices, but they should be automagically - generated by Thorsten color script. *) - let yukawa_n_4 g m = - [ ((U (-g), Sup (m,g), Gluino), FBF ((-1), Psibar, SR, Chi), G_S_Sqrt); - ((D (-g), Sdown (m,g), Gluino), FBF ((-1), Psibar, SR, Chi), G_S_Sqrt); - ((Gluino, Sup (m,-g), U g), FBF ((-1), Chibar, Coupling.SL, Psi), G_S_Sqrt); - ((Gluino, Sdown (m,-g), D g), FBF ((-1), Chibar, Coupling.SL, Psi), G_S_Sqrt)] - let yukawa_n_5 m = - [ ((U (-3), Sup (m,3), Gluino), FBF (1, Psibar, SLR, Chi), - G_YUK_G (false,3,SU,m)); - ((D (-3), Sdown (m,3), Gluino), FBF (1, Psibar, SLR, Chi), - G_YUK_G (false,3,SD,m)); - ((Gluino, Sup (m,-3), U 3), FBF (1, Chibar, SLR, Psi), - G_YUK_G (true,3,SU,m)); - ((Gluino, Sdown (m,-3), D 3), FBF (1, Chibar, SLR, Psi), - G_YUK_G (true,3,SD,m))] - let yukawa_n = - List.flatten (Product.list2 yukawa_n_1 [N1;N2;N3;N4] [1;2]) @ - List.flatten (Product.list2 yukawa_n_2 [N1;N2;N3;N4] [M1;M2]) @ - List.flatten (Product.list2 yukawa_n_3 [N1;N2;N3;N4] [1;2;3]) @ - List.flatten (Product.list2 yukawa_n_4 [1;2;3] [M1;M2]) @ - ThoList.flatmap yukawa_n_5 [M1;M2] - -(*** REVISED: Compatible with CD+. ***) - let yukawa_c_1 c g = - let cc = conj_char c in - [ ((L (-g), Sneutrino g, Chargino cc), BBB (1, Psibar, Coupling.SR, - Psibar), G_YUK_C (true,g,c,SN,M1)); - ((Chargino c, Sneutrino (-g), L g), PBP (1, Psi, Coupling.SL, Psi), - G_YUK_C (false,g,c,SN,M1)) ] - let yukawa_c_2 c = - let cc = conj_char c in - [ ((L (-3), Sneutrino 3, Chargino cc), BBB (1, Psibar, SLR, - Psibar), G_YUK_C (true,3,c,SN,M1)); - ((Chargino c, Sneutrino (-3), L 3), PBP (1, Psi, SLR, Psi), - G_YUK_C (false,3,c,SN,M1)) ] - let yukawa_c_3 c m g = - let cc = conj_char c in - [ ((N (-g), Slepton (m,g), Chargino c), FBF (1, Psibar, Coupling.SR, - Psi), G_YUK_C (true,g,c,SL,m)); - ((Chargino cc, Slepton (m,-g), N g), FBF (1, Psibar, Coupling.SL, - Psi), G_YUK_C (false,g,c,SL,m)) ] - let yukawa_c c = - ThoList.flatmap (yukawa_c_1 c) [1;2] @ - yukawa_c_2 c @ - List.flatten (Product.list2 (yukawa_c_3 c) [M1] [1;2]) @ - List.flatten (Product.list2 (yukawa_c_3 c) [M1;M2] [3]) - -(*** REVISED: Compatible with CD+. ***) - let yukawa_cq' c (g,h) m = - let cc = conj_char c in - [ ((Chargino c, Sup (m,-g), D h), PBP (1, Psi, SLR, Psi), - G_YUK_Q (false,g,h,c,SU,m)); - ((D (-h), Sup (m,g), Chargino cc), BBB (1, Psibar, SLR, Psibar), - G_YUK_Q (true,g,h,c,SU,m)); - ((Chargino cc, Sdown (m,-h), U g), FBF (1, Psibar, SLR, Psi), - G_YUK_Q (true,g,h,c,SD,m)); - ((U (-g), Sdown (m,h), Chargino c), FBF (1, Psibar, SLR, Psi), - G_YUK_Q (false,g,h,c,SD,m)) ] - let yukawa_cq'' c (g,h) = - let cc = conj_char c in - [ ((Chargino c, Sup (M1,-g), D h), PBP (1, Psi, Coupling.SL, Psi), - G_YUK_Q (false,g,h,c,SU,M1)); - ((D (-h), Sup (M1,g), Chargino cc), - BBB (1, Psibar, Coupling.SR, Psibar), G_YUK_Q (true,g,h,c,SU,M1)); - ((Chargino cc, Sdown (M1,-h), U g), - FBF (1, Psibar, Coupling.SL, Psi), G_YUK_Q (true,g,h,c,SD,M1)); - ((U (-g), Sdown (M1,h), Chargino c), - FBF (1, Psibar, Coupling.SR, Psi), G_YUK_Q (false,g,h,c,SD,M1)) ] - let yukawa_cq c = - if Flags.ckm_present then - List.flatten (Product.list2 (yukawa_cq' c) [(1,3);(2,3);(3,3); - (3,2);(3,1)] [M1;M2]) @ - ThoList.flatmap (yukawa_cq'' c) [(1,1);(1,2);(2,1);(2,2)] - else - ThoList.flatmap (yukawa_cq' c (3,3)) [M1;M2] @ - ThoList.flatmap (yukawa_cq'' c) [(1,1);(2,2)] - - -(*** REVISED: Compatible with CD+. - Remark: Singlet and octet gluon exchange. The coupling is divided by - sqrt(2) to account for the correct normalization of the Lie algebra - generators. -***) - let col_currents g = - [ ((D (-g), Gl, D g), FBF ((-1), Psibar, V, Psi), Gs); - ((U (-g), Gl, U g), FBF ((-1), Psibar, V, Psi), Gs)] - -(*** REVISED: Compatible with CD+. - Remark: Singlet and octet gluon exchange. The coupling is divided by - sqrt(2) to account for the correct normalization of the Lie algebra - generators. -***) - - let col_sfermion_currents g m = - [ ((Gl, Sup (m,-g), Sup (m,g)), Vector_Scalar_Scalar (-1), Gs); - ((Gl, Sdown (m,-g), Sdown (m,g)), Vector_Scalar_Scalar (-1), Gs)] - -(*** REVISED: Compatible with CD+. ***) - let triple_gauge = - [ ((Ga, Wm, Wp), Gauge_Gauge_Gauge 1, I_Q_W); - ((Z, Wm, Wp), Gauge_Gauge_Gauge 1, I_G_ZWW); - ((Gl, Gl, Gl), Gauge_Gauge_Gauge 1, I_G_S)] - -(*** REVISED: Independent of the sign of CD. ***) - let gauge4 = Vector4 [(2, C_13_42); (-1, C_12_34); (-1, C_14_23)] - let minus_gauge4 = Vector4 [(-2, C_13_42); (1, C_12_34); (1, C_14_23)] - let quartic_gauge = - [ (Wm, Wp, Wm, Wp), gauge4, G_WWWW; - (Wm, Z, Wp, Z), minus_gauge4, G_ZZWW; - (Wm, Z, Wp, Ga), minus_gauge4, G_PZWW; - (Wm, Ga, Wp, Ga), minus_gauge4, G_PPWW; - (Gl, Gl, Gl, Gl), gauge4, G_SS] - -(* The [Scalar_Vector_Vector] couplings do not depend on the choice of the - sign of the covariant derivative since they are quadratic in the - gauge couplings. *) - -(*** REVISED: Compatible with CD+. ***) -(*** Revision: 2005-03-10: first two vertices corrected. ***) - let gauge_higgs = - [ ((Wm, Hp, A), Vector_Scalar_Scalar 1, G_GH 1); - ((Wp, Hm, A), Vector_Scalar_Scalar 1, G_GH 1); - ((Z, H_Heavy, A), Vector_Scalar_Scalar 1, G_GH 3); - ((Z, H_Light, A), Vector_Scalar_Scalar 1, G_GH 2); - ((H_Heavy, Wp, Wm), Scalar_Vector_Vector 1, G_GH 5); - ((H_Light, Wp, Wm), Scalar_Vector_Vector 1, G_GH 4); - ((Wm, Hp, H_Heavy), Vector_Scalar_Scalar 1, G_GH 7); - ((Wp, Hm, H_Heavy), Vector_Scalar_Scalar (-1), G_GH 7); - ((Wm, Hp, H_Light), Vector_Scalar_Scalar 1, G_GH 6); - ((Wp, Hm, H_Light), Vector_Scalar_Scalar (-1), G_GH 6); - ((H_Heavy, Z, Z), Scalar_Vector_Vector 1, G_GH 9); - ((H_Light, Z, Z), Scalar_Vector_Vector 1, G_GH 8); - ((Z, Hp, Hm), Vector_Scalar_Scalar 1, G_GH 10); - ((Ga, Hp, Hm), Vector_Scalar_Scalar 1, G_GH 11) ] - - let gauge_higgs4 = - [ ((A, A, Z, Z), Scalar2_Vector2 1, G_GH4 1); - ((H_Heavy, H_Heavy, Z, Z), Scalar2_Vector2 1, G_GH4 3); - ((H_Light, H_Light, Z, Z), Scalar2_Vector2 1, G_GH4 2); - ((Hp, Hm, Z, Z), Scalar2_Vector2 1, G_GH4 4); - ((Hp, Hm, Ga, Ga), Scalar2_Vector2 1, G_GH4 5); - ((Hp, Hm, Ga, Z), Scalar2_Vector2 1, G_GH4 6); - ((Hp, H_Heavy, Wm, Z), Scalar2_Vector2 1, G_GH4 8); - ((Hm, H_Heavy, Wp, Z), Scalar2_Vector2 1, G_GH4 8); - ((Hp, H_Light, Wm, Z), Scalar2_Vector2 1, G_GH4 7); - ((Hm, H_Light, Wp, Z), Scalar2_Vector2 1, G_GH4 7); - ((Hp, H_Heavy, Wm, Ga), Scalar2_Vector2 1, G_GH4 10); - ((Hm, H_Heavy, Wp, Ga), Scalar2_Vector2 1, G_GH4 10); - ((Hp, H_Light, Wm, Ga), Scalar2_Vector2 1, G_GH4 9); - ((Hm, H_Light, Wp, Ga), Scalar2_Vector2 1, G_GH4 9); - ((A, A, Wp, Wm), Scalar2_Vector2 1, G_GH4 11); - ((H_Heavy, H_Heavy, Wp, Wm), Scalar2_Vector2 1, G_GH4 13); - ((H_Light, H_Light, Wp, Wm), Scalar2_Vector2 1, G_GH4 12); - ((Hp, Hm, Wp, Wm), Scalar2_Vector2 1, G_GH4 14); - ((Hp, A, Wm, Z), Scalar2_Vector2 1, G_GH4 15); - ((Hm, A, Wp, Z), Scalar2_Vector2 (-1), G_GH4 15); - ((Hp, A, Wm, Ga), Scalar2_Vector2 1, G_GH4 16); - ((Hm, A, Wp, Ga), Scalar2_Vector2 (-1), G_GH4 16) ] - - let gauge_sfermion4' g m1 m2 = - [ ((Wp, Wm, Slepton (m1,g), Slepton (m2,-g)), Scalar2_Vector2 1, - G_WWSFSF (SL,g,m1,m2)); - ((Z, Ga, Slepton (m1,g), Slepton (m2,-g)), Scalar2_Vector2 1, - G_ZPSFSF (SL,g,m1,m2)); - ((Z, Z, Slepton (m1,g), Slepton (m2,-g)), Scalar2_Vector2 1, G_ZZSFSF - (SL,g,m1,m2)); - ((Wp, Wm, Sup (m1,g), Sup (m2,-g)), Scalar2_Vector2 1, G_WWSFSF - (SU,g,m1,m2)); - ((Wp, Wm, Sdown (m1,g), Sdown (m2,-g)), Scalar2_Vector2 1, G_WWSFSF - (SD,g,m1,m2)); - ((Z, Z, Sup (m1,g), Sup (m2,-g)), Scalar2_Vector2 1, G_ZZSFSF - (SU,g,m1,m2)); - ((Z, Z, Sdown (m1,g), Sdown (m2,-g)), Scalar2_Vector2 1, G_ZZSFSF - (SD,g,m1,m2)); - ((Z, Ga, Sup (m1,g), Sup (m2,-g)), Scalar2_Vector2 1, G_ZPSFSF - (SU,g,m1,m2)); - ((Z, Ga, Sdown (m1,g), Sdown (m2,-g)), Scalar2_Vector2 1, G_ZPSFSF - (SD,g,m1,m2)) ] - let gauge_sfermion4'' g m = - [ ((Wp, Ga, Slepton (m,g), Sneutrino (-g)), Scalar2_Vector2 1, G_WPSLSN - (false,g,m)); - ((Wm, Ga, Slepton (m,-g), Sneutrino g), Scalar2_Vector2 1, - G_WPSLSN (true,g,m)); - ((Wp, Z, Slepton (m,g), Sneutrino (-g)), Scalar2_Vector2 1, G_WZSLSN - (false,g,m)); - ((Wm, Z, Slepton (m,-g), Sneutrino g), Scalar2_Vector2 1, - G_WZSLSN (true,g,m)); - ((Ga, Ga, Slepton (m,g), Slepton (m,-g)), Scalar2_Vector2 1, G_PPSFSF SL); - ((Ga, Ga, Sup (m,g), Sup (m,-g)), Scalar2_Vector2 1, G_PPSFSF SU); - ((Ga, Ga, Sdown (m,g), Sdown (m,-g)), Scalar2_Vector2 1, G_PPSFSF SD)] - let gauge_sfermion4 g = - List.flatten (Product.list2 (gauge_sfermion4' g) [M1;M2] [M1;M2]) @ - ThoList.flatmap (gauge_sfermion4'' g) [M1;M2] @ - [ ((Wp, Wm, Sneutrino g, Sneutrino (-g)), Scalar2_Vector2 1, G_WWSFSF - (SN,g,M1,M1)); - ((Z, Z, Sneutrino g, Sneutrino (-g)), Scalar2_Vector2 1, G_ZZSFSF - (SN,g,M1,M1)) ] - - let gauge_squark4' g h m1 m2 = - [ ((Wp, Ga, Sup (m1,-g), Sdown (m2,h)), Scalar2_Vector2 1, G_WPSUSD - (false,m1,m2,g,h)); - ((Wm, Ga, Sup (m1,g), Sdown (m2,-h)), Scalar2_Vector2 1, G_WPSUSD - (true,m1,m2,g,h)); - ((Wp, Z, Sup (m1,-g), Sdown (m2,h)), Scalar2_Vector2 1, G_WZSUSD - (false,m1,m2,g,h)); - ((Wm, Z, Sup (m1,g), Sdown (m2,-h)), Scalar2_Vector2 1, G_WZSUSD - (true,m1,m2,g,h)) ] - let gauge_squark4 g h = List.flatten (Product.list2 (gauge_squark4' g h) - [M1;M2] [M1;M2]) - - let gluon_w_squark' g h m1 m2 = - [ ((Gl, Wp, Sup (m1,-g), Sdown (m2,h)), - Scalar2_Vector2 1, G_GlWSUSD (false,m1,m2,g,h)); - ((Gl, Wm, Sup (m1,g), Sdown (m2,-h)), - Scalar2_Vector2 1, G_GlWSUSD (true,m1,m2,g,h)) ] - let gluon_w_squark g h = - List.flatten (Product.list2 (gluon_w_squark' g h) [M1;M2] [M1;M2]) - - let gluon_gauge_squark' g m1 m2 = - [ ((Gl, Z, Sup (m1,g), Sup (m2,-g)), - Scalar2_Vector2 2, G_GlZSFSF (SU,g,m1,m2)); - ((Gl, Z, Sdown (m1,g), Sdown (m2,-g)), - Scalar2_Vector2 2, G_GlZSFSF (SD,g,m1,m2)) ] - let gluon_gauge_squark'' g m = - [ ((Gl, Ga, Sup (m,g), Sup (m,-g)), Scalar2_Vector2 2, G_GlPSQSQ); - ((Gl, Ga, Sdown (m,g), Sdown (m,-g)), Scalar2_Vector2 (-1), G_GlPSQSQ) ] - let gluon_gauge_squark g = - List.flatten (Product.list2 (gluon_gauge_squark' g) [M1;M2] [M1;M2]) @ - ThoList.flatmap (gluon_gauge_squark'' g) [M1;M2] - - let gluon2_squark2' g m = - [ ((Gl, Gl, Sup (m,g), Sup (m,-g)), Scalar2_Vector2 2, G_GlGlSQSQ); - ((Gl, Gl, Sdown (m,g), Sdown (m,-g)), Scalar2_Vector2 2, G_GlGlSQSQ) ] - let gluon2_squark2 g = - ThoList.flatmap (gluon2_squark2' g) [M1;M2] - - -(*** REVISED: Independent of the sign of CD. ***) - let higgs = - [ ((Hp, Hm, H_Heavy), Scalar_Scalar_Scalar 1, G_H3 1); - ((Hp, Hm, H_Light), Scalar_Scalar_Scalar 1, G_H3 2); - ((H_Heavy, H_Heavy, H_Light), Scalar_Scalar_Scalar 1, G_H3 3); - ((H_Heavy, H_Heavy, H_Heavy), Scalar_Scalar_Scalar 1, G_H3 4); - ((H_Light, H_Light, H_Light), Scalar_Scalar_Scalar 1, G_H3 5); - ((H_Heavy, H_Light, H_Light), Scalar_Scalar_Scalar 1, G_H3 6); - ((H_Heavy, A, A), Scalar_Scalar_Scalar 1, G_H3 7); - ((H_Light, A, A), Scalar_Scalar_Scalar 1, G_H3 8) ] - -(* Here follow purely scalar quartic vertices which are only available for the - no-Whizard colored version. *) - -(*** REVISED: Independent of the sign of CD. ***) - let higgs4 = - [ ((Hp, Hm, Hp, Hm), Scalar4 1, G_H4 1); - ((Hp, Hm, H_Heavy, H_Heavy), Scalar4 1, G_H4 2); - ((Hp, Hm, H_Light, H_Light), Scalar4 1, G_H4 3); - ((Hp, Hm, H_Heavy, H_Light), Scalar4 1, G_H4 4); - ((Hp, Hm, A, A), Scalar4 1, G_H4 5); - ((H_Heavy, H_Heavy, H_Heavy, H_Heavy), Scalar4 1, G_H4 6); - ((H_Light, H_Light, H_Light, H_Light), Scalar4 1, G_H4 6); - ((H_Heavy, H_Heavy, H_Light, H_Light), Scalar4 1, G_H4 7); - ((H_Heavy, H_Light, H_Light, H_Light), Scalar4 1, G_H4 8); - ((H_Heavy, H_Heavy, H_Heavy, H_Light), Scalar4 (-1), G_H4 8); - ((H_Heavy, H_Heavy, A, A), Scalar4 1, G_H4 9); - ((H_Light, H_Light, A, A), Scalar4 (-1), G_H4 9); - ((H_Heavy, H_Light, A, A), Scalar4 1, G_H4 10); - ((A, A, A, A), Scalar4 1, G_H4 11) ] - -(* The vertices of the type Higgs - Sfermion - Sfermion are independent of - the choice of the CD sign since they are quadratic in the gauge - coupling. *) - -(*** REVISED: Independent of the sign of CD. ***) - let higgs_sneutrino' g = - [ ((H_Heavy, Sneutrino g, Sneutrino (-g)), Scalar_Scalar_Scalar 1, - G_H2SFSF (SN,g,M1,M1)); - ((H_Light, Sneutrino g, Sneutrino (-g)), Scalar_Scalar_Scalar 1, - G_H1SFSF (SN,g,M1,M1)); - ((Hp, Sneutrino (-g), Slepton (M1,g)), Scalar_Scalar_Scalar 1, - G_HSNSL (false,g,M1)); - ((Hm, Sneutrino g, Slepton (M1,-g)), Scalar_Scalar_Scalar 1, - G_HSNSL (true,g,M1)) ] - let higgs_sneutrino'' = - [ ((Hp, Sneutrino (-3), Slepton (M2,3)), Scalar_Scalar_Scalar 1, - G_HSNSL (false,3,M2)); - ((Hm, Sneutrino 3, Slepton (M2,-3)), Scalar_Scalar_Scalar 1, - G_HSNSL (false,3,M2)) ] - let higgs_sneutrino = - ThoList.flatmap higgs_sneutrino' [1;2;3] @ higgs_sneutrino'' - - -(* Under the assumption that there is no mixing between the left- and - right-handed sfermions for the first two generations there is only a - coupling of the form Higgs - sfermion1 - sfermion2 for the third - generation. All the others are suppressed by $m_f/M_W$. *) - -(*** REVISED: Independent of the sign of CD. ***) - let higgs_sfermion' g m1 m2 = - [ ((H_Heavy, Slepton (m1,g), Slepton (m2,-g)), Scalar_Scalar_Scalar 1, - G_H2SFSF (SL,g,m1,m2)); - ((H_Light, Slepton (m1,g), Slepton (m2,-g)), Scalar_Scalar_Scalar 1, - G_H1SFSF (SL,g,m1,m2)); - ((H_Heavy, Sup (m1,g), Sup (m2,-g)), Scalar_Scalar_Scalar 1, - G_H2SFSF (SU,g,m1,m2)); - ((H_Heavy, Sdown (m1,g), Sdown (m2,-g)), Scalar_Scalar_Scalar 1, - G_H2SFSF (SD,g,m1,m2)); - ((H_Light, Sup (m1,g), Sup (m2,-g)), Scalar_Scalar_Scalar 1, - G_H1SFSF (SU,g,m1,m2)); - ((H_Light, Sdown (m1,g), Sdown (m2,-g)), Scalar_Scalar_Scalar 1, - G_H1SFSF (SD,g,m1,m2)) ] - let higgs_sfermion'' m1 m2 = - [ ((A, Slepton (m1,3), Slepton (m2,-3)), Scalar_Scalar_Scalar 1, - G_ASFSF (SL,3,m1,m2)); - ((A, Sup (m1,3), Sup (m2,-3)), Scalar_Scalar_Scalar 1, - G_ASFSF (SU,3,m1,m2)); - ((A, Sdown (m1,3), Sdown (m2,-3)), Scalar_Scalar_Scalar 1, - G_ASFSF (SD,3,m1,m2)) ] - let higgs_sfermion = List.flatten (Product.list2 (higgs_sfermion' 3) - [M1;M2] [M1;M2]) @ - (higgs_sfermion' 1 M1 M1) @ (higgs_sfermion' 1 M2 M2) @ - (higgs_sfermion' 2 M1 M1) @ (higgs_sfermion' 2 M2 M2) @ - List.flatten (Product.list2 higgs_sfermion'' [M1;M2] [M1;M2]) - -(*i let higgs_sfermion g = List.flatten (Product.list2 (higgs_sfermion' g) - [M1;M2] [M1;M2]) i*) - -(*** REVISED: Independent of the sign of CD. ***) - let higgs_squark' g h m1 m2 = - [ ((Hp, Sup (m1,-g), Sdown (m2,h)), Scalar_Scalar_Scalar 1, - G_HSUSD (false,m1,m2,g,h)); - ((Hm, Sup (m1,g), Sdown (m2,-h)), Scalar_Scalar_Scalar 1, - G_HSUSD (true,m1,m2,g,h)) ] - let higgs_squark_a g h = higgs_squark' g h M1 M1 - let higgs_squark_b (g,h) = List.flatten (Product.list2 (higgs_squark' g h) - [M1;M2] [M1;M2]) - let higgs_squark = - List.flatten (Product.list2 higgs_squark_a [1;2] [1;2]) @ - ThoList.flatmap higgs_squark_b [(1,3);(2,3);(3,3);(3,1);(3,2)] - - let vertices3 = - (ThoList.flatmap electromagnetic_currents_3 [1;2;3] @ - ThoList.flatmap electromagnetic_currents_2 [C1;C2] @ - List.flatten (Product.list2 electromagnetic_sfermion_currents [1;2;3] - [M1;M2]) @ - ThoList.flatmap neutral_currents [1;2;3] @ - ThoList.flatmap neutral_sfermion_currents [1;2;3] @ - ThoList.flatmap charged_currents [1;2;3] @ - List.flatten (Product.list2 charged_slepton_currents [1;2;3] - [M1;M2]) @ - (if Flags.ckm_present then - List.flatten (Product.list2 charged_quark_currents [1;2;3] - [1;2;3]) @ - List.flatten (Product.list2 charged_squark_currents [1;2;3] - [1;2;3]) @ - ThoList.flatmap yukawa_higgs_quark [(1,3);(2,3);(3,3);(3,1);(3,2)] - else - charged_quark_currents 1 1 @ - charged_quark_currents 2 2 @ - charged_quark_currents 3 3 @ - charged_squark_currents 1 1 @ - charged_squark_currents 2 2 @ - charged_squark_currents 3 3 @ - ThoList.flatmap yukawa_higgs_quark [(3,3)]) @ -(*i ThoList.flatmap yukawa_higgs [1;2;3] @ i*) - yukawa_higgs 3 @ yukawa_n @ - ThoList.flatmap yukawa_c [C1;C2] @ - ThoList.flatmap yukawa_cq [C1;C2] @ - List.flatten (Product.list2 charged_chargino_currents [N1;N2;N3;N4] - [C1;C2]) @ triple_gauge @ - ThoList.flatmap neutral_Z_1 [(N1,N2);(N1,N3);(N1,N4);(N2,N3);(N2,N4); - (N3,N4)] @ - ThoList.flatmap neutral_Z_2 [N1;N2;N3;N4] @ - Product.list2 charged_Z [C1;C2] [C1;C2] @ - gauge_higgs @ higgs @ yukawa_higgs_2 @ -(*i List.flatten (Product.list2 yukawa_higgs_quark [1;2;3] [1;2;3]) @ i*) - List.flatten (Product.list2 higgs_charg_neutr [N1;N2;N3;N4] [C1;C2]) @ - higgs_neutr @ higgs_sneutrino @ higgs_sfermion @ -(*i ThoList.flatmap higgs_sfermion [1;2;3] @ i*) - higgs_squark @ yukawa_v @ - ThoList.flatmap col_currents [1;2;3] @ - List.flatten (Product.list2 col_sfermion_currents [1;2;3] [M1;M2])) - -(* let vertices4 = [] *) - - let vertices4 = - (quartic_gauge @ higgs4 @ gauge_higgs4 @ - ThoList.flatmap gauge_sfermion4 [1;2;3] @ - List.flatten (Product.list2 gauge_squark4 [1;2;3] [1;2;3]) @ - ThoList.flatmap gluon2_squark2 [1;2;3] @ - List.flatten (Product.list2 gluon_w_squark [1;2;3] [1;2;3]) @ - ThoList.flatmap gluon_gauge_squark [1;2;3]) - - let vertices () = (vertices3, vertices4, []) - - let table = F.of_vertices (vertices ()) - let fuse2 = F.fuse2 table - let fuse3 = F.fuse3 table - let fuse = F.fuse table - let max_degree () = 4 - - let flavor_of_string s = - match s with - | "e-" -> L 1 | "e+" -> L (-1) - | "mu-" -> L 2 | "mu+" -> L (-2) - | "tau-" -> L 3 | "tau+" -> L (-3) - | "nue" -> N 1 | "nuebar" -> N (-1) - | "numu" -> N 2 | "numubar" -> N (-2) - | "nutau" -> N 3 | "nutaubar" -> N (-3) - | "se1-" -> Slepton (M1,1) | "se1+" -> Slepton (M1,-1) - | "smu1-" -> Slepton (M1,2) | "smu1+" -> Slepton (M1,-2) - | "stau1-" -> Slepton (M1,3) | "stau1+" -> Slepton (M1,-3) - | "se2-" -> Slepton (M2,1) | "se2+" -> Slepton (M2,-1) - | "smu2-" -> Slepton (M2,2) | "smu2+" -> Slepton (M2,-2) - | "stau2-" -> Slepton (M2,3) | "stau2+" -> Slepton (M2,-3) - | "snue" -> Sneutrino 1 | "snue*" -> Sneutrino (-1) - | "snumu" -> Sneutrino 2 | "snumu*" -> Sneutrino (-2) - | "snutau" -> Sneutrino 3 | "snutau*" -> Sneutrino (-3) - | "u" -> U 1 | "ubar" -> U (-1) - | "c" -> U 2 | "cbar" -> U (-2) - | "t" -> U 3 | "tbar" -> U (-3) - | "d" -> D 1 | "dbar" -> D (-1) - | "s" -> D 2 | "sbar" -> D (-2) - | "b" -> D 3 | "bbar" -> D (-3) - | "A" -> Ga | "Z" | "Z0" -> Z - | "W+" -> Wp | "W-" -> Wm - | "H" -> H_Heavy | "h" -> H_Light | "A0" -> A - | "H+" -> Hp | "H-" -> Hm - | "su1" -> Sup (M1,1) | "su1c" -> Sup (M1,-1) - | "sc1" -> Sup (M1,2) | "sc1c" -> Sup (M1,-2) - | "st1" -> Sup (M1,3) | "st1c" -> Sup (M1,-3) - | "su2" -> Sup (M2,1) | "su2c" -> Sup (M2,-1) - | "sc2" -> Sup (M2,2) | "sc2c" -> Sup (M2,-2) - | "st2" -> Sup (M2,3) | "st2c" -> Sup (M2,-3) - | "sd1" -> Sdown (M1,1) | "sd1c" -> Sdown (M1,-1) - | "ss1" -> Sdown (M1,2) | "ss1c" -> Sdown (M1,-2) - | "sb1" -> Sdown (M1,3) | "sb1c" -> Sdown (M1,-3) - | "sd2" -> Sdown (M2,1) | "sd2c" -> Sdown (M2,-1) - | "ss2" -> Sdown (M2,2) | "ss2c" -> Sdown (M2,-2) - | "sb2" -> Sdown (M2,3) | "sb2c" -> Sdown (M2,-3) - | "neu1" -> Neutralino N1 | "neu2" -> Neutralino N2 - | "neu3" -> Neutralino N3 | "neu4" -> Neutralino N4 - | "neu5" -> if Flags.nmssm then Neutralino N5 else - invalid_arg "Models.ExtMSSM.flavor_of_string" - | "ch1+" -> Chargino C1 | "ch2+" -> Chargino C2 - | "ch1-" -> Chargino C1c | "ch2-" -> Chargino C2c - | _ -> invalid_arg "Models.ExtMSSM.flavor_of_string" - - let flavor_to_string = function - | L 1 -> "e-" | L (-1) -> "e+" - | L 2 -> "mu-" | L (-2) -> "mu+" - | L 3 -> "tau-" | L (-3) -> "tau+" - | N 1 -> "nue" | N (-1) -> "nuebar" - | N 2 -> "numu" | N (-2) -> "numubar" - | N 3 -> "nutau" | N (-3) -> "nutaubar" - | U 1 -> "u" | U (-1) -> "ubar" - | U 2 -> "c" | U (-2) -> "cbar" - | U 3 -> "t" | U (-3) -> "tbar" - | U _ -> invalid_arg - "Models.ExtMSSM.flavor_to_string: invalid up type quark" - | D 1 -> "d" | D (-1) -> "dbar" - | D 2 -> "s" | D (-2) -> "sbar" - | D 3 -> "b" | D (-3) -> "bbar" - | D _ -> invalid_arg - "Models.ExtMSSM.flavor_to_string: invalid down type quark" - | Gl -> "gl" | Gluino -> "sgl" - | Ga -> "A" | Z -> "Z" - | Wp -> "W+" | Wm -> "W-" - | H_Heavy -> "H" | H_Light -> "h" | A -> "A0" - | Hp -> "H+" | Hm -> "H-" - | S0 -> "S0" | P0 -> "P0" - | Slepton (M1,1) -> "se1-" | Slepton (M1,-1) -> "se1+" - | Slepton (M1,2) -> "smu1-" | Slepton (M1,-2) -> "smu1+" - | Slepton (M1,3) -> "stau1-" | Slepton (M1,-3) -> "stau1+" - | Slepton (M2,1) -> "se2-" | Slepton (M2,-1) -> "se2+" - | Slepton (M2,2) -> "smu2-" | Slepton (M2,-2) -> "smu2+" - | Slepton (M2,3) -> "stau2-" | Slepton (M2,-3) -> "stau2+" - | Sneutrino 1 -> "snue" | Sneutrino (-1) -> "snue*" - | Sneutrino 2 -> "snumu" | Sneutrino (-2) -> "snumu*" - | Sneutrino 3 -> "snutau" | Sneutrino (-3) -> "snutau*" - | Sup (M1,1) -> "su1+" | Sup (M1,-1) -> "su1-" - | Sup (M1,2) -> "sc1+" | Sup (M1,-2) -> "sc1-" - | Sup (M1,3) -> "st1+" | Sup (M1,-3) -> "st1-" - | Sup (M2,1) -> "su2+" | Sup (M2,-1) -> "su2-" - | Sup (M2,2) -> "sc2+" | Sup (M2,-2) -> "sc2-" - | Sup (M2,3) -> "st2+" | Sup (M2,-3) -> "st2-" - | Sdown (M1,1) -> "sd1-" | Sdown (M1,-1) -> "sd1+" - | Sdown (M1,2) -> "ss1-" | Sdown (M1,-2) -> "ss1+" - | Sdown (M1,3) -> "sb1-" | Sdown (M1,-3) -> "sb1+" - | Sdown (M2,1) -> "sd2-" | Sdown (M2,-1) -> "sd2+" - | Sdown (M2,2) -> "ss2-" | Sdown (M2,-2) -> "ss2+" - | Sdown (M2,3) -> "sb2-" | Sdown (M2,-3) -> "sb2+" - | Neutralino N1 -> "neu1" - | Neutralino N2 -> "neu2" - | Neutralino N3 -> "neu3" - | Neutralino N4 -> "neu4" - | Neutralino N5 -> if Flags.nmssm then "neu5" else - invalid_arg "Models.ExtMSSM.flavor_to_string" - | Chargino C1 -> "ch1+" | Chargino C1c -> "ch1-" - | Chargino C2 -> "ch2+" | Chargino C2c -> "ch2-" - | _ -> invalid_arg "Models.ExtMSSM.flavor_to_string" - - let flavor_symbol = function - | L g when g > 0 -> "l" ^ string_of_int g - | L g -> "l" ^ string_of_int (abs g) ^ "b" - | N g when g > 0 -> "n" ^ string_of_int g - | N g -> "n" ^ string_of_int (abs g) ^ "b" - | U g when g > 0 -> "u" ^ string_of_int g - | U g -> "u" ^ string_of_int (abs g) ^ "b" - | D g when g > 0 -> "d" ^ string_of_int g - | D g -> "d" ^ string_of_int (abs g) ^ "b" - | Gl -> "gl" - | Ga -> "a" | Z -> "z" - | Wp -> "wp" | Wm -> "wm" - | Slepton (M1,g) when g > 0 -> "sl1" ^ string_of_int g - | Slepton (M1,g) -> "sl1c" ^ string_of_int (abs g) - | Slepton (M2,g) when g > 0 -> "sl2" ^ string_of_int g - | Slepton (M2,g) -> "sl2c" ^ string_of_int (abs g) - | Sneutrino g when g > 0 -> "sn" ^ string_of_int g - | Sneutrino g -> "snc" ^ string_of_int (abs g) - | Sup (M1,g) when g > 0 -> "su1" ^ string_of_int g - | Sup (M1,g) -> "su1c" ^ string_of_int (abs g) - | Sup (M2,g) when g > 0 -> "su2" ^ string_of_int g - | Sup (M2,g) -> "su2c" ^ string_of_int (abs g) - | Sdown (M1,g) when g > 0 -> "sd1" ^ string_of_int g - | Sdown (M1,g) -> "sd1c" ^ string_of_int (abs g) - | Sdown (M2,g) when g > 0 -> "sd2" ^ string_of_int g - | Sdown (M2,g) -> "sd2c" ^ string_of_int (abs g) - | Neutralino n -> "neu" ^ (string_of_neu n) - | Chargino c when (int_of_char c) > 0 -> "cp" ^ string_of_char c - | Chargino c -> "cm" ^ string_of_int (abs (int_of_char c)) - | Gluino -> "sgl" - | H_Heavy -> "h0h" | H_Light -> "h0l" | A -> "a0" - | Hp -> "hp" | Hm -> "hm" | S0 -> "s0" | P0 -> "p0" - - let flavor_sans_color_of_string = flavor_of_string - let flavor_sans_color_to_string = flavor_to_string - let flavor_sans_color_symbol = flavor_symbol - - let pdg = function - | L g when g > 0 -> 9 + 2*g - | L g -> - 9 + 2*g - | N g when g > 0 -> 10 + 2*g - | N g -> - 10 + 2*g - | U g when g > 0 -> 2*g - | U g -> 2*g - | D g when g > 0 -> - 1 + 2*g - | D g -> 1 + 2*g - | Gl -> 21 - | Ga -> 22 | Z -> 23 - | Wp -> 24 | Wm -> (-24) - | H_Light -> 25 | H_Heavy -> 35 | A -> 36 - | Hp -> 37 | Hm -> (-37) - | Slepton (M1,g) when g > 0 -> 1000009 + 2*g - | Slepton (M1,g) -> - 1000009 + 2*g - | Slepton (M2,g) when g > 0 -> 2000009 + 2*g - | Slepton (M2,g) -> - 2000009 + 2*g - | Sneutrino g when g > 0 -> 1000010 + 2*g - | Sneutrino g -> - 1000010 + 2*g - | Sup (M1,g) when g > 0 -> 1000000 + 2*g - | Sup (M1,g) -> - 1000000 + 2*g - | Sup (M2,g) when g > 0 -> 2000000 + 2*g - | Sup (M2,g) -> - 2000000 + 2*g - | Sdown (M1,g) when g > 0 -> 999999 + 2*g - | Sdown (M1,g) -> - 999999 + 2*g - | Sdown (M2,g) when g > 0 -> 1999999 + 2*g - | Sdown (M2,g) -> - 1999999 + 2*g - | Gluino -> 1000021 - | Chargino C1 -> 1000024 | Chargino C1c -> (-1000024) - | Chargino C2 -> 1000037 | Chargino C2c -> (-1000037) - | Neutralino N1 -> 1000022 | Neutralino N2 -> 1000023 - | Neutralino N3 -> 1000025 | Neutralino N4 -> 1000035 -(* Bitte hier noch die richtigen Werte einsetzen. *) - | Neutralino N5 -> 1000099 - | P0 -> 1111111 | S0 -> 1111112 - - -(* We must take care of the pdg numbers for the two different kinds of - sfermions in the MSSM. The particle data group in its Monte Carlo particle - numbering scheme takes only into account mixtures of the third generation - squarks and the stau. For the other sfermions we will use the number of the - lefthanded field for the lighter mixed state and the one for the righthanded - for the heavier. Below are the official pdg numbers from the Particle - Data Group. In order not to produce arrays with some million entries in - the Fortran code for the masses and the widths we introduce our private - pdg numbering scheme which only extends not too far beyond 42. - Our private scheme then has the following pdf numbers (for the sparticles - the subscripts $L/R$ and $1/2$ are taken synonymously): - - \begin{center} - \renewcommand{\arraystretch}{1.2} - \begin{tabular}{|r|l|l|}\hline - $d$ & down-quark & 1 \\\hline - $u$ & up-quark & 2 \\\hline - $s$ & strange-quark & 3 \\\hline - $c$ & charm-quark & 4 \\\hline - $b$ & bottom-quark & 5 \\\hline - $t$ & top-quark & 6 \\\hline\hline - $e^-$ & electron & 11 \\\hline - $\nu_e$ & electron-neutrino & 12 \\\hline - $\mu^-$ & muon & 13 \\\hline - $\nu_\mu$ & muon-neutrino & 14 \\\hline - $\tau^-$ & tau & 15 \\\hline - $\nu_\tau$ & tau-neutrino & 16 \\\hline\hline - $g$ & gluon & (9) 21 \\\hline - $\gamma$ & photon & 22 \\\hline - $Z^0$ & Z-boson & 23 \\\hline - $W^+$ & W-boson & 24 \\\hline\hline - $h^0$ & light Higgs boson & 25 \\\hline - $H^0$ & heavy Higgs boson & 35 \\\hline - $A^0$ & pseudoscalar Higgs & 36 \\\hline - $H^+$ & charged Higgs & 37 \\\hline\hline - $\tilde{d}_L$ & down-squark 1 & 41 \\\hline - $\tilde{u}_L$ & up-squark 1 & 42 \\\hline - $\tilde{s}_L$ & strange-squark 1 & 43 \\\hline - $\tilde{c}_L$ & charm-squark 1 & 44 \\\hline - $\tilde{b}_L$ & bottom-squark 1 & 45 \\\hline - $\tilde{t}_L$ & top-squark 1 & 46 \\\hline - $\tilde{d}_R$ & down-squark 2 & 47 \\\hline - $\tilde{u}_R$ & up-squark 2 & 48 \\\hline - $\tilde{s}_R$ & strange-squark 2 & 49 \\\hline - $\tilde{c}_R$ & charm-squark 2 & 50 \\\hline - $\tilde{b}_R$ & bottom-squark 2 & 51 \\\hline - $\tilde{t}_R$ & top-squark 2 & 52 \\\hline\hline - $\tilde{e}_L$ & selectron 1 & 53 \\\hline - $\tilde{\nu}_{e,L}$ & electron-sneutrino & 54 \\\hline - $\tilde{\mu}_L$ & smuon 1 & 55 \\\hline - $\tilde{\nu}_{\mu,L}$ & muon-sneutrino & 56 \\\hline - $\tilde{\tau}_L$ & stau 1 & 57 \\\hline - $\tilde{\nu}_{\tau,L}$ & tau-sneutrino & 58 \\\hline - $\tilde{e}_R$ & selectron 2 & 59 \\\hline - $\tilde{\mu}_R$ & smuon 2 & 61 \\\hline - $\tilde{\tau}_R$ & stau 2 & 63 \\\hline\hline - $\tilde{g}$ & gluino & 64 \\\hline - $\tilde{\chi}^0_1$ & neutralino 1 & 65 \\\hline - $\tilde{\chi}^0_2$ & neutralino 2 & 66 \\\hline - $\tilde{\chi}^0_3$ & neutralino 3 & 67 \\\hline - $\tilde{\chi}^0_4$ & neutralino 4 & 68 \\\hline - $\tilde{\chi}^0_4$ & neutralino 4 & 69 \\\hline - $\tilde{\chi}^+_1$ & chargino 1 & 70 \\\hline - $\tilde{\chi}^+_2$ & chargino 2 & 71 \\\hline\hline - $a$ & pseudoscalar & 72 \\\hline - $s$ & scalar singlet & 73 \\\hline - $\tilde{G}$ & gravitino & -- \\\hline\hline - \end{tabular} - \end{center} *) - - let pdg_mw = function - | L g when g > 0 -> 9 + 2*g - | L g -> - 9 + 2*g - | N g when g > 0 -> 10 + 2*g - | N g -> - 10 + 2*g - | U g when g > 0 -> 2*g - | U g -> 2*g - | D g when g > 0 -> - 1 + 2*g - | D g -> 1 + 2*g - | Gl -> 21 - | Ga -> 22 | Z -> 23 - | Wp -> 24 | Wm -> (-24) - | H_Light -> 25 | H_Heavy -> 35 | A -> 36 - | Hp -> 37 | Hm -> (-37) - | Sup (M1,g) when g > 0 -> 40 + 2*g - | Sup (M1,g) -> - 40 + 2*g - | Sup (M2,g) when g > 0 -> 46 + 2*g - | Sup (M2,g) -> - 46 + 2*g - | Sdown (M1,g) when g > 0 -> 39 + 2*g - | Sdown (M1,g) -> - 39 + 2*g - | Sdown (M2,g) when g > 0 -> 45 + 2*g - | Sdown (M2,g) -> - 45 + 2*g - | Slepton (M1,g) when g > 0 -> 51 + 2*g - | Slepton (M1,g) -> - 51 + 2*g - | Slepton (M2,g) when g > 0 -> 57 + 2*g - | Slepton (M2,g) -> - 57 + 2*g - | Sneutrino g when g > 0 -> 52 + 2*g - | Sneutrino g -> - 52 + 2*g - | Gluino -> 64 - | Chargino C1 -> 70 | Chargino C1c -> (-70) - | Chargino C2 -> 71 | Chargino C2c -> (-71) - | Neutralino N1 -> 65 | Neutralino N2 -> 66 - | Neutralino N3 -> 67 | Neutralino N4 -> 68 - | Neutralino N5 -> 69 - | P0 -> 72 | S0 -> 73 - - let mass_symbol f = - "mass(" ^ string_of_int (abs (pdg_mw f)) ^ ")" - - let width_symbol f = - "width(" ^ string_of_int (abs (pdg_mw f)) ^ ")" - - let conj_symbol = function - | false, str -> str - | true, str -> str ^ "_c" - - let constant_symbol = function - | Unit -> "unit" | Pi -> "PI" - | Alpha_QED -> "alpha" | E -> "e" | G -> "g" | Vev -> "vev" - | Sin2thw -> "sin2thw" | Eidelta -> "eidelta" | Mu -> "mu" | G_Z -> "gz" - | Sin a -> "sin" ^ string_of_angle a | Cos a -> "cos" ^ string_of_angle a - | Sin2am2b -> "sin2am2b" | Cos2am2b -> "cos2am2b" | Sinamb -> "sinamb" - | Sinapb -> "sinapb" | Cosamb -> "cosamb" | Cosapb -> "cosapb" - | Cos4be -> "cos4be" | Sin4be -> "sin4be" | Sin4al -> "sin4al" - | Sin2al -> "sin2al" | Cos2al -> "cos2al" | Sin2be -> "sin2be" - | Cos2be -> "cos2be" | Tana -> "tana" | Tanb -> "tanb" - | Q_lepton -> "qlep" | Q_up -> "qup" | Q_down -> "qdwn" - | Q_charg -> "qchar" - | V_CKM (g1,g2) -> "vckm_" ^ string_of_int g1 ^ string_of_int g2 - | M_SF (f,g,m1,m2) -> "mix_" ^ string_of_sff f ^ string_of_int g - ^ string_of_sfm m1 ^ string_of_sfm m2 - | AL g -> "al_" ^ string_of_int g - | AD g -> "ad_" ^ string_of_int g - | AU g -> "au_" ^ string_of_int g - | A_0 (n1,n2) -> "a0_" ^ string_of_neu n1 ^ string_of_neu n2 - | A_P (c1,c2) -> "ap_" ^ string_of_char c1 ^ string_of_char c2 - | V_0 (n1,n2) -> "v0_" ^ string_of_neu n1 ^ string_of_neu n2 - | V_P (c1,c2) -> "vp_" ^ string_of_char c1 ^ string_of_char c2 - | M_N (n1,n2) -> "mn_" ^ string_of_neu n1 ^ string_of_neu n2 - | M_U (c1,c2) -> "mu_" ^ string_of_char c1 ^ string_of_char c2 - | M_V (c1,c2) -> "mv_" ^ string_of_char c1 ^ string_of_char c2 - | L_NC (n,c) -> "lnc_" ^ string_of_neu n ^ string_of_char c - | R_NC (n,c) -> "rnc_" ^ string_of_neu n ^ string_of_char c - | L_CN (c,n) -> "lcn_" ^ string_of_char c ^ string_of_neu n - | R_CN (c,n) -> "rcn_" ^ string_of_char c ^ string_of_neu n - | L_NCH (n,c) -> "lnch_" ^ string_of_neu n ^ string_of_char c - | R_NCH (n,c) -> "rnch_" ^ string_of_neu n ^ string_of_char c - | L_CNG (c,n) -> "lcng_" ^ string_of_char c ^ string_of_neu n - | R_CNG (c,n) -> "rcng_" ^ string_of_char c ^ string_of_neu n - | S_NNA (n1,n2) -> "snna_" ^ string_of_neu n1 ^ string_of_neu n2 - | P_NNA (n1,n2) -> "pnna_" ^ string_of_neu n1 ^ string_of_neu n2 - | S_NNG (n1,n2) -> "snng_" ^ string_of_neu n1 ^ string_of_neu n2 - | P_NNG (n1,n2) -> "pnng_" ^ string_of_neu n1 ^ string_of_neu n2 - | S_NNH1 (n1,n2) -> "snnh1_" ^ string_of_neu n1 ^ string_of_neu n2 - | P_NNH1 (n1,n2) -> "pnnh1_" ^ string_of_neu n1 ^ string_of_neu n2 - | S_NNH2 (n1,n2) -> "snnh2_" ^ string_of_neu n1 ^ string_of_neu n2 - | P_NNH2 (n1,n2) -> "pnnh2_" ^ string_of_neu n1 ^ string_of_neu n2 - | G_NC_lepton -> "gnclep" | G_NC_neutrino -> "gncneu" - | G_NC_up -> "gncup" | G_NC_down -> "gncdwn" - | G_CC -> "gcc" - | G_CCQ (vc,g1,g2) -> conj_symbol (vc, "gccq_" ^ string_of_int g1 ^ "_" - ^ string_of_int g2) - | I_Q_W -> "iqw" | I_G_ZWW -> "igzww" - | G_WWWW -> "gw4" | G_ZZWW -> "gzzww" - | G_PZWW -> "gpzww" | G_PPWW -> "gppww" - | G_GH 1 -> "ghaw" - | G_GH 2 -> "gh1az" | G_GH 3 -> "gh2az" - | G_GH 4 -> "gh1ww" | G_GH 5 -> "gh2ww" - | G_GH 6 -> "ghh1w" | G_GH 7 -> "ghh2w" - | G_GH 8 -> "gh1zz" | G_GH 9 -> "gh2zz" - | G_GH 10 -> "ghhz" | G_GH 11 -> "ghhp" - | G_GHGo n -> "g_hgh(" ^ string_of_int n ^ ")" - | G_GH4 1 -> "gaazz" | G_GH4 2 -> "gh1h1zz" | G_GH4 3 -> "gh2h2zz" - | G_GH4 4 -> "ghphmzz" | G_GH4 5 -> "ghphmpp" | G_GH4 6 -> "ghphmpz" - | G_GH4 7 -> "ghh1wz" | G_GH4 8 -> "ghh2wz" - | G_GH4 9 -> "ghh1wp" | G_GH4 10 -> "ghh2wp" - | G_GH4 11 -> "gaaww" | G_GH4 12 -> "gh1h1ww" | G_GH4 13 -> "gh2h2ww" - | G_GH4 14 -> "ghhww" | G_GH4 15 -> "ghawz" | G_GH4 16 -> "ghawp" - | G_CICIH1 (n1,n2) -> "gcicih1_" ^ string_of_neu n1 ^ "_" - ^ string_of_neu n2 - | G_CICIH2 (n1,n2) -> "gcicih2_" ^ string_of_neu n1 ^ "_" - ^ string_of_neu n2 - | G_CICIA (n1,n2) -> "gcicia_" ^ string_of_neu n1 ^ "_" - ^ string_of_neu n2 - | G_CICIG (n1,n2) -> "gcicig_" ^ string_of_neu n1 ^ "_" - ^ string_of_neu n2 - | G_H3 n -> "gh3_" ^ string_of_int n - | G_H4 n -> "gh4_" ^ string_of_int n - | G_HGo3 n -> "ghg3_" ^ string_of_int n - | G_HGo4 n -> "ghg4_" ^ string_of_int n - | G_GG4 n -> "ggg4_" ^ string_of_int n - | G_strong -> "gs" | G_SS -> "gs**2" - | Gs -> "gs" - | I_G_S -> "igs" - | G_S_Sqrt -> "gssq" - | G_NWC (n,c) -> "gnwc_" ^ string_of_neu n ^ "_" ^ string_of_char c - | G_CWN (c,n) -> "gcwn_" ^ string_of_char c ^ "_" ^ string_of_neu n - | G_CH1C (c1,c2) -> "gch1c_" ^ string_of_char c1 ^ "_" ^ string_of_char c2 - | G_CH2C (c1,c2) -> "gch2c_" ^ string_of_char c1 ^ "_" ^ string_of_char c2 - | G_CAC (c1,c2) -> "gcac_" ^ string_of_char c1 ^ "_" ^ string_of_char c2 - | G_CGC (c1,c2) -> "gcgc_" ^ string_of_char c1 ^ "_" ^ string_of_char c2 - | G_YUK (i,g) -> "g_yuk" ^ string_of_int i ^ "_" ^ string_of_int g - | G_NZN (n1,n2) -> "gnzn_" ^ string_of_neu n1 ^ "_" ^ string_of_neu n2 - | G_CZC (c1,c2) -> "gczc_" ^ string_of_char c1 ^ "_" ^ string_of_char - c2 - | DUM 1 -> "dummy1" | DUM 5 -> "dummy5" - | G_YUK_1 (n,m) -> "g_yuk1_" ^ string_of_int n ^ "_" ^ string_of_int m - | G_YUK_2 (n,m) -> "g_yuk2_" ^ string_of_int n ^ "_" ^ string_of_int m - | G_YUK_3 (n,m) -> "g_yuk3_" ^ string_of_int n ^ "_" ^ string_of_int m - | G_YUK_4 (n,m) -> "g_yuk4_" ^ string_of_int n ^ "_" ^ string_of_int m - | G_YUK_C (vc,g,c,sf,m) -> conj_symbol (vc, "g_yuk_ch" ^ string_of_char c - ^ "_" ^ string_of_sff sf ^ string_of_sfm m ^ "_" ^ string_of_int g ) - | G_YUK_N (vc,g,n,sf,m) -> conj_symbol (vc, "g_yuk_n" ^ string_of_neu n - ^ "_" ^ string_of_sff sf ^ string_of_sfm m ^ "_" ^ string_of_int g ) - | G_YUK_G (vc,g,sf,m) -> conj_symbol (vc, "g_yuk_g" ^ string_of_sff sf - ^ string_of_sfm m ^ "_" ^ string_of_int g) - | G_YUK_Q (vc,g1,g2,c,sf,m) -> conj_symbol (vc, "g_yuk_ch" ^ string_of_char c - ^ "_" ^ string_of_sff sf ^ string_of_sfm m ^ "_" ^ string_of_int g1 - ^ "_" ^ string_of_int g2) - | G_NHC (n,c) -> "g_nhc_" ^ string_of_neu n ^ "_" ^ string_of_char c - | G_CHN (c,n) -> "g_chn_" ^ string_of_neu n ^ "_" ^ string_of_char c - | G_NGC (n,c) -> "g_ngc_" ^ string_of_neu n ^ string_of_char c - | G_CGN (c,n) -> "g_cgn_" ^ string_of_char c ^ string_of_neu n - | SUM_1 -> "sum1" - | G_SLSNW (vc,g,m) -> conj_symbol (vc, "gsl" ^ string_of_sfm m ^ "_" - ^ string_of_int g ^ "snw") - | G_ZSF (f,g,m1,m2) -> "g" ^ string_of_sff f ^ string_of_sfm m1 ^ "z" - ^ string_of_sff f ^ string_of_sfm m2 ^ "_" ^ string_of_int g - | G_WWSFSF (f,g,m1,m2) -> "gww" ^ string_of_sff f ^ string_of_sfm m1 - ^ string_of_sff f ^ string_of_sfm m2 ^ "_" ^ string_of_int g - | G_WPSLSN (vc,g,m) -> conj_symbol (vc, "gpwsl" ^ string_of_sfm m - ^ "sn_" ^ string_of_int g) - | G_WZSLSN (vc,g,m) -> conj_symbol (vc, "gwzsl" ^ string_of_sfm m - ^ "sn_" ^ string_of_int g) - | G_H1SFSF (f,g,m1,m2) -> "gh1" ^ string_of_sff f ^ string_of_sfm m1 - ^ string_of_sff f ^ string_of_sfm m2 ^ "_" ^ string_of_int g - | G_H2SFSF (f,g,m1,m2) -> "gh2" ^ string_of_sff f ^ string_of_sfm m1 - ^ string_of_sff f ^ string_of_sfm m2 ^ "_" ^ string_of_int g - | G_ASFSF (f,g,m1,m2) -> "ga" ^ string_of_sff f ^ string_of_sfm m1 - ^ string_of_sff f ^ string_of_sfm m2 ^ "_" ^ string_of_int g - | G_HSNSL (vc,g,m) -> conj_symbol (vc, "ghsnsl" ^ string_of_sfm m ^ "_" - ^ string_of_int g) - | G_GoSFSF (f,g,m1,m2) -> "ggo" ^ string_of_sff f ^ string_of_sfm m1 - ^ string_of_sff f ^ string_of_sfm m2 ^ "_" ^ string_of_int g - | G_GoSNSL (vc,g,m) -> conj_symbol (vc, "ggosnsl" ^ string_of_sfm m ^ "_" - ^ string_of_int g) - | G_HSUSD (vc,m1,m2,g1,g2) -> conj_symbol (vc, "ghsu" ^ string_of_sfm m1 - ^ "sd" ^ string_of_sfm m2 ^ "_" ^ string_of_int g1 ^ "_" - ^ string_of_int g2) - | G_GSUSD (vc,m1,m2,g1,g2) -> conj_symbol (vc, "ggsu" ^ string_of_sfm m1 - ^ "sd" ^ string_of_sfm m2 ^ "_" ^ string_of_int g1 ^ "_" - ^ string_of_int g2) - | G_WPSUSD (vc,m1,m2,n,m) -> conj_symbol (vc, "gpwpsu" ^ string_of_sfm m1 - ^ "sd" ^ string_of_sfm m2 ^ "_" ^ string_of_int n ^ "_" - ^ string_of_int m) - | G_WZSUSD (vc,m1,m2,n,m) -> conj_symbol (vc, "gzwpsu" ^ string_of_sfm m1 - ^ "sd" ^ string_of_sfm m2 ^ "_" ^ string_of_int n ^ "_" - ^ string_of_int m) - | G_SWS (vc,g1,g2,m1,m2) -> conj_symbol (vc, "gs" ^ string_of_sfm m1 ^ "ws" - ^ string_of_sfm m2 ^ "_" ^ string_of_int g1 ^ "_" ^ string_of_int g2) - | G_GlGlSQSQ -> "gglglsqsq" - | G_PPSFSF f -> "gpp" ^ string_of_sff f ^ string_of_sff f - | G_ZZSFSF (f,g,m1,m2) -> "gzz" ^ string_of_sff f ^ string_of_sfm m1 - ^ string_of_sff f ^ string_of_sfm m2 ^ "_" ^ string_of_int g - | G_ZPSFSF (f,g,m1,m2) -> "gzp" ^ string_of_sff f ^ string_of_sfm m1 - ^ string_of_sff f ^ string_of_sfm m2 ^ "_" ^ string_of_int g - | G_GlPSQSQ -> "gglpsqsq" - | G_GlZSFSF (f,g,m1,m2) -> "ggl" ^ string_of_sff f ^ string_of_sfm m1 - ^ string_of_sff f ^ string_of_sfm m2 ^ "_" ^ string_of_int g - | G_GlWSUSD (vc,m1,m2,g1,g2) -> conj_symbol (vc, "gglwsu" - ^ string_of_sfm m1 ^ "sd" ^ string_of_sfm m2 ^ "_" ^ string_of_int g1 - ^ "_" ^ string_of_int g2) - | G_GHGo4 1 -> "gzzg0g0" | G_GHGo4 2 -> "gzzgpgm" - | G_GHGo4 3 -> "gppgpgm" | G_GHGo4 4 -> "gzpgpgm" - | G_GHGo4 5 -> "gwwgpgm" | G_GHGo4 6 -> "gwwg0g0" - | G_GHGo4 7 -> "gwzg0g" | G_GHGo4 8 -> "gwzg0g" - | G_GHGo4 9 -> "gwzh1g" | G_GHGo4 10 -> "gwzh2g" - | G_GHGo4 11 -> "gwph1g" | G_GHGo4 12 -> "gwph2g" - | G_HSF31 (h,g,m1,m2,f1,f2) -> "g_" ^ string_of_higgs h ^ - string_of_int g ^ string_of_sfm m1 ^ string_of_sfm m2 ^ - string_of_sff f1 ^ string_of_sff f2 - | G_HSF32 (h,g1,g2,m1,m2,f1,f2) -> "g_" ^ string_of_higgs h ^ - string_of_int g1 ^ "_" ^ string_of_int g2 ^ string_of_sfm m1 ^ - string_of_sfm m2 ^ string_of_sff f1 ^ string_of_sff f2 - | G_HSF41 (h,g,m1,m2,f1,f2) -> "g_" ^ string_of_higgs h ^ - string_of_int g ^ string_of_sfm m1 ^ string_of_sfm m2 ^ - string_of_sff f1 ^ string_of_sff f2 - | G_HSF42 (h,g1,g2,m1,m2,f1,f2) -> "g_" ^ string_of_higgs h ^ - string_of_int g1 ^ "_" ^ string_of_int g2 ^ string_of_sfm m1 ^ - string_of_sfm m2 ^ string_of_sff f1 ^ string_of_sff f2 - | G_H1H1SFSF (f,m1,m2,n) -> "gh1h1" ^ string_of_sff f ^ string_of_sfm - m1 ^ string_of_sff f ^ string_of_sfm m2 ^ "_" ^ string_of_int n - | G_H1H2SFSF (f,m1,m2,n) -> "gh1h2" ^ string_of_sff f ^ string_of_sfm - m1 ^ string_of_sff f ^ string_of_sfm m2 ^ "_" ^ string_of_int n - | G_H2H2SFSF (f,m1,m2,n) -> "gh2h2" ^ string_of_sff f ^ string_of_sfm - m1 ^ string_of_sff f ^ string_of_sfm m2 ^ "_" ^ string_of_int n - | G_HHSFSF (f,m1,m2,n) -> "ghh" ^ string_of_sff f ^ string_of_sfm m1 - ^ string_of_sff f ^ string_of_sfm m2 ^ "_" ^ string_of_int n - | G_AASFSF (f,m1,m2,n) -> "gaa" ^ string_of_sff f ^ string_of_sfm m1 - ^ string_of_sff f ^ string_of_sfm m2 ^ "_" ^ string_of_int n - | G_HH1SUSD (vc,m1,m2,g1,g2) -> conj_symbol (vc, "ghh1su" - ^ string_of_sfm m1 ^ "sd" ^ string_of_sfm m2 ^ "_" ^ string_of_int g1 - ^ "_" ^ string_of_int g2) - | G_HH2SUSD (vc,m1,m2,g1,g2) -> conj_symbol (vc, "ghh2su" - ^ string_of_sfm m1 ^ "sd" ^ string_of_sfm m2 ^ "_" ^ string_of_int g1 - ^ "_" ^ string_of_int g2) - | G_HASUSD (vc,m1,m2,g1,g2) -> conj_symbol (vc, "ghasu" - ^ string_of_sfm m1 ^ "sd" ^ string_of_sfm m2 ^ "_" - ^ string_of_int g1 ^ "_" ^ string_of_int g2 ^ "_c") - | G_HH1SLSN (vc,m,g) -> conj_symbol (vc, "ghh1sl" ^ string_of_sfm m - ^ "sn_" ^ string_of_int g) - | G_HH2SLSN (vc,m,g) -> conj_symbol (vc, "ghh2sl" ^ string_of_sfm m - ^ "sn_" ^ string_of_int g) - | G_HASLSN (vc,m,g) -> conj_symbol (vc, "ghasl" ^ string_of_sfm m - ^ "sn_" ^ string_of_int g) - | G_AG0SFSF (f,m1,m2,n) -> "gag0" ^ string_of_sff f ^ string_of_sfm m1 - ^ string_of_sff f ^ string_of_sfm m2 ^ "_" ^ string_of_int n - | G_HGSFSF (f,m1,m2,n) -> "ghg" ^ string_of_sff f ^ string_of_sfm m1 - ^ string_of_sff f ^ string_of_sfm m1 ^ "_" ^ string_of_int n - | G_GGSFSF (f,m1,m2,n) -> "ggg" ^ string_of_sff f ^ string_of_sfm m1 - ^ string_of_sff f ^ string_of_sfm m2 ^ "_" ^ string_of_int n - | G_G0G0SFSF (f,m1,m2,n) -> "gg0g0" ^ string_of_sff f ^ string_of_sfm m1 - ^ string_of_sff f ^ string_of_sfm m2 ^ "_" ^ string_of_int n - | G_HGSNSL (vc,m,n) -> conj_symbol (vc, "ghgsnsl" ^ string_of_sfm m ^ "_" - ^ string_of_int n) - | G_H1GSNSL (vc,m,n) -> conj_symbol (vc, "gh1gsnsl" ^ string_of_sfm m ^ "_" - ^ string_of_int n) - | G_H2GSNSL (vc,m,n) -> conj_symbol (vc, "gh2gsnsl" ^ string_of_sfm m ^ "_" - ^ string_of_int n) - | G_AGSNSL (vc,m,n) -> conj_symbol (vc, "gagsnsl" ^ string_of_sfm m ^ "_" - ^ string_of_int n) - | G_GGSNSL (vc,m,n) -> conj_symbol (vc, "gggsnsl" ^ string_of_sfm m ^ "_" - ^ string_of_int n) - | G_HGSUSD (vc,m1,m2,g1,g2) -> conj_symbol (vc, "gghpsu" ^ string_of_sfm m1 - ^ "sd" ^ string_of_sfm m2 ^ "_" ^ string_of_int g1 ^ "_" - ^ string_of_int g2) - | G_H1GSUSD (vc,m1,m2,g1,g2) -> conj_symbol (vc, "gh1gpsu" ^ string_of_sfm m1 - ^ "sd" ^ string_of_sfm m2 ^ "_" ^ string_of_int g1 ^ "_" - ^ string_of_int g2) - | G_H2GSUSD (vc,m1,m2,g1,g2) -> conj_symbol (vc, "gh2gpsu" ^ string_of_sfm m1 - ^ "sd" ^ string_of_sfm m2 ^ "_" ^ string_of_int g1 ^ "_" - ^ string_of_int g2) - | G_AGSUSD (vc,m1,m2,g1,g2) -> conj_symbol (vc, "gagpsu" ^ string_of_sfm m1 - ^ "sd" ^ string_of_sfm m2 ^ "_" ^ string_of_int g1 ^ "_" - ^ string_of_int g2) - | G_GGSUSD (vc,m1,m2,g1,g2) -> conj_symbol (vc, "gggpsu" ^ string_of_sfm m1 - ^ "sd" ^ string_of_sfm m2 ^ "_" ^ string_of_int g1 ^ "_" - ^ string_of_int g2) - | G_SN4 (g1,g2) -> "gsn4_" ^ string_of_int g1 ^ "_" ^ string_of_int g2 - | G_SN2SL2_1 (m1,m2,g1,g2) -> "gsl_" ^ string_of_int g1 ^ "_sl_" - ^ string_of_int g1 ^ "_sl" ^ string_of_sfm m1 ^ "_" ^ string_of_int g2 - ^ "_sl" ^ string_of_sfm m2 ^ "_" ^ string_of_int g2 - | G_SN2SL2_2 (m1,m2,g1,g2) -> "gsl_" ^ string_of_int g1 ^ "_sl_" - ^ string_of_int g2 ^ "_sl" ^ string_of_sfm m1 ^ "_" ^ string_of_int g1 - ^ "_sl" ^ string_of_sfm m2 ^ "_" ^ string_of_int g2 ^ "_mix" - | G_SF4 (f1,f2,m1,m2,m3,m4,g1,g2) -> "gsf" ^ string_of_sff f1 ^ - string_of_sff f2 ^ string_of_sfm m1 ^ string_of_sfm m2 ^ - string_of_sfm m3 ^ string_of_sfm m4 ^ string_of_int g1 ^ - string_of_int g2 - | G_SF4_3 (f1,f2,m1,m2,m3,m4,g1,g2,g3) -> "gsf" ^ string_of_sff f1 ^ - string_of_sff f2 ^ string_of_sfm m1 ^ string_of_sfm m2 ^ - string_of_sfm m3 ^ string_of_sfm m4 ^ string_of_int g1 ^ - string_of_int g2 ^ "_" ^ string_of_int g3 - | G_SF4_4 (f1,f2,m1,m2,m3,m4,g1,g2,g3,g4) -> "gsf" ^ string_of_sff f1 ^ - string_of_sff f2 ^ string_of_sfm m1 ^ string_of_sfm m2 ^ - string_of_sfm m3 ^ string_of_sfm m4 ^ string_of_int g1 ^ "_" ^ - string_of_int g2 ^ string_of_int g3 ^ "_" ^ string_of_int g4 - | G_SL4 (m1,m2,m3,m4,g) -> "gsl" ^ string_of_sfm m1 ^ "_" - ^ "sl" ^ string_of_sfm m2 ^ "_" ^ "sl" ^ string_of_sfm m3 ^ "_" - ^ "sl" ^ string_of_sfm m4 ^ "_" ^ string_of_int g - | G_SL4_2 (m1,m2,m3,m4,g1,g2) -> "gsl" ^ string_of_sfm m1 ^ "_" - ^ "sl" ^ string_of_sfm m2 ^ "_" ^ "sl" ^ string_of_sfm m3 ^ "_" - ^ "sl" ^ string_of_sfm m4 ^ "_" ^ string_of_int g1 ^ "_" ^ - string_of_int g2 - | G_SN2SQ2 (f,m1,m2,g1,g2) -> "gsn_" ^ string_of_int g1 ^ "_sn_" - ^ string_of_int g1 ^ "_" ^ string_of_sff f ^ string_of_sfm m1 ^ "_" - ^ string_of_int g2 ^ "_" ^ string_of_sff f ^ string_of_sfm m2 ^ "_" - ^ string_of_int g2 - | G_SL2SQ2 (f,m1,m2,m3,m4,g1,g2) -> "gsl" ^ string_of_sfm m1 ^ "_" - ^ string_of_int g1 ^ "_sl" ^ string_of_sfm m2 ^ "_" ^ string_of_int g1 - ^ "_" ^ string_of_sff f ^ string_of_sfm m3 ^ "_" ^ string_of_int g2 - ^ "_" ^ string_of_sff f ^ string_of_sfm m4 ^ "_" ^ string_of_int g2 - | G_SUSDSNSL (vc,m1,m2,m3,g1,g2,g3) -> conj_symbol (vc, "gsl" - ^ string_of_sfm m3 ^ "_" ^ string_of_int g3 ^ "_sn_" ^ string_of_int g3 - ^ "_su" ^ string_of_sfm m1 ^ "_" ^ string_of_int g1 ^ "_sd" - ^ string_of_sfm m2 ^ "_" ^ string_of_int g2) - | G_SU4 (m1,m2,m3,m4,g) -> "gsu" ^ string_of_sfm m1 ^ "_" - ^ "_su" ^ string_of_sfm m2 ^ "_" ^ "_su" ^ string_of_sfm m3 ^ "_" ^ - "_su" ^ string_of_sfm m4 ^ "_" ^ string_of_int g - | G_SU4_2 (m1,m2,m3,m4,g1,g2) -> "gsu" ^ string_of_sfm m1 ^ "_" - ^ "_su" ^ string_of_sfm m2 ^ "_" ^ "_su" ^ string_of_sfm m3 ^ "_" ^ - "_su" ^ string_of_sfm m4 ^ "_" ^ string_of_int g1 ^ "_" ^ - string_of_int g2 - | G_SD4 (m1,m2,m3,m4,g) -> "gsd" ^ string_of_sfm m1 ^ "_" - ^ "_sd" ^ string_of_sfm m2 ^ "_" ^ "_sd" ^ string_of_sfm m3 ^ "_" - ^ "_sd" ^ string_of_sfm m4 ^ "_" ^ string_of_int g - | G_SD4_2 (m1,m2,m3,m4,g1,g2) -> "gsd" ^ string_of_sfm m1 ^ "_" - ^ "_sd" ^ string_of_sfm m2 ^ "_" ^ "_sd" ^ string_of_sfm m3 ^ "_" - ^ "_sd" ^ string_of_sfm m4 ^ "_" ^ string_of_int g1 ^ "_" ^ - string_of_int g2 - | G_SU2SD2 (m1,m2,m3,m4,g1,g2,g3,g4) -> "gsu" ^ string_of_sfm m1 - ^ "_" ^ string_of_int g1 ^ "_su" ^ string_of_sfm m2 ^ "_" - ^ string_of_int g2 ^ "_sd" ^ string_of_sfm m3 ^ "_" ^ string_of_int g3 - ^ "_sd" ^ string_of_sfm m4 ^ "_" ^ string_of_int g4 - | M f -> "mass" ^ flavor_symbol f - | W f -> "width" ^ flavor_symbol f - | _ -> "Panic: not available" - - end - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/complex.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/complex.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/complex.ml (revision 8703) @@ -1,249 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -module type T = - sig - type t - - val null : t - val one : t - - val real : t -> float - val imag : t -> float - - val conj : t -> t - val neg : t -> t - val inv : t -> t - - val add : t -> t -> t - val sub : t -> t -> t - val mul : t -> t -> t - val div : t -> t -> t - - val abs : t -> float - val arg : t -> float - - val sqrt : t -> t - val exp : t -> t - val log : t -> t - - val of_float2 : float -> float -> t - val of_int2 : int -> int -> t - val to_float2 : t -> float * float - val to_int2 : t -> int * int - - val of_float : float -> t - val of_int : int -> t - val to_float : t -> float - val to_int : t -> int - - val to_string : t -> string - val of_string : 'a -> 'b - end - -(* The hairier formulae are ``inspired'' by \cite{PTVF92}. *) - -module Dense = - struct - - type t = { re : float; im : float } - let null = { re = 0.0; im = 0.0 } - let one = { re = 1.0; im = 0.0 } - - let real z = z.re - let imag z = z.im - let conj z = {re = z.re; im = ~-. (z.im) } - - let neg z = {re = ~-. (z.re); im = ~-. (z.im) } - let add z1 z2 = {re = z1.re +. z2.re; im = z1.im +. z2.im } - let sub z1 z2 = {re = z1.re -. z2.re; im = z1.im -. z2.im } - -(* Save one multiplication with respect to the standard formula - \begin{equation} - (x+iy)(u+iv) = \lbrack xu-yv\rbrack + i\lbrack(x+u)(y+v)-xu-yv\rbrack\, - \end{equation} - at the expense of one addition and two subtractions. *) - - let mul z1 z2 = - let re12 = z1.re *. z2.re - and im12 = z1.im *. z2.im in - { re = re12 -. im12; - im = (z1.re +. z1.im) *. (z2.re +. z2.im) -. re12 -. im12 } - -(* \begin{equation} - \frac{x+iy}{u+iv} = - \begin{cases} - \frac{\lbrack x+y(v/u)\rbrack + i\lbrack y-x(v/u)\rbrack}{u+v(v/u)} - & \text{for}\;\; |u|\ge|v| \\ - \frac{\lbrack x(u/v)+y\rbrack + i\lbrack y(u/v)-x\rbrack}{u(u/v+v)} - & \text{for}\;\; |u|<|v| - \end{cases} - \end{equation} *) - let div z1 z2 = - if abs_float z2.re >= abs_float z2.im then - let r = z2.im /. z2.re in - let den = z2.re +. r *. z2.im in - { re = (z1.re +. r *. z1.im) /. den; - im = (z1.im -. r *. z1.re) /. den } - else - let r = z2.re /. z2.im in - let den = z2.im +. r *. z2.re in - { re = (r *. z1.re +. z1.im) /. den; - im = (r *. z1.im -. z1.re) /. den } - - let inv = div one - -(* \begin{equation} - |x+iy| = - \begin{cases} - |x|\sqrt{1+(y/x)^2} & \text{for}\;\; |x|\ge|y| \\ - |y|\sqrt{1+(x/y)^2} & \text{for}\;\; |x|<|y| - \end{cases} - \end{equation} *) - let abs z = - let absr = abs_float z.re - and absi = abs_float z.im in - if absr = 0.0 then - absi - else if absi = 0.0 then - absr - else if absr > absi then - let q = absi /. absr in - absr *. sqrt (1.0 +. q *. q) - else - let q = absr /. absi in - absi *. sqrt (1.0 +. q *. q) - - let arg z = atan2 z.im z.re - -(* Square roots are trickier: - \begin{equation} - \label{eq:cont} - \sqrt{x+iy} = - \begin{cases} - 0 & \text{for}\;\; w=0 \\ - w + i \left(\frac{y}{2w}\right) & \text{for}\;\; w\not=0, x\ge0 \\ - \left(\frac{|y|}{2w}\right) + iw & \text{for}\;\; w\not=0, x<0, y\ge0 \\ - \left(\frac{|y|}{2w}\right) - iw & \text{for}\;\; w\not=0, x<0, y<0 - \end{cases} - \end{equation} - where - \begin{equation} - w = - \begin{cases} - 0 & \text{for}\;\; x=y=0 \\ - \sqrt{|x|} \sqrt{\frac{1+\sqrt{1+(y/x)^2}}{2}} & \text{for}\;\; |x|\ge|y| \\ - \sqrt{|y|} \sqrt{\frac{|x/y|+\sqrt{1+(x/y)^2}}{2}} & \text{for}\;\; |x|<|y| - \end{cases}\,. - \end{equation} - Equation~(\ref{eq:cont}) is encoded in [cont w]. *) - let sqrt z = - if z.re = 0.0 && z.im = 0.0 then - { re = 0.0; im = 0.0 } - else - let absr = abs_float z.re - and absi = abs_float z.im - and cont w = - if z.re >= 0.0 then - { re = w; im = z.im /. (2. *. w) } - else - let im = if z.im >= 0.0 then w else ~-. w in - { re = z.im /. (2. *. im); im = im } - in - if absr >= absi then - let q = absi /. absr in - cont ((sqrt absr) *. sqrt (0.5 *. (1.0 +. sqrt (1.0 +. q *. q)))) - else - let q = absr /. absi in - cont ((sqrt absi) *. sqrt (0.5 *. (q +. sqrt (1.0 +. q *. q)))) - - let exp z = - let er = exp z.re in - { re = er *. (cos z.im); im = er *. (sin z.im) } - - let log z = { re = log (abs z); im = arg z } - - let of_float2 r i = { re = r; im = i } - let of_int2 r i = { re = float r; im = float i } - let to_float2 z = (z.re, z.im) - let to_int2 z = (truncate z.re, truncate z.im) - let of_float r = { re = r; im = 0.0 } - let of_int r = { re = float r; im = 0.0 } - let to_float z = z.re - let to_int z = truncate z.re - - let to_string z = - if z.re <> 0.0 && z.im <> 0.0 then - Printf.sprintf "%g+%gi" (* starting from 3.04: ["%g%+gi"] *) z.re z.im - else if z.re <> 0.0 then - Printf.sprintf "%g" z.re - else if z.im <> 0.0 then - Printf.sprintf "%gi" z.im - else - "0" - - let of_string z = failwith "Complex.of_string not implemented yet!" - - end - -(* \thocwmodulesection{Sparse Representation} *) - -(* If the numbers are very likely to be either purely real or imaginary, - a different representation can reduce the load from the floating point - unit. *) - -module Sparse = - struct - module C = Dense - - type t = - | Real of float - | Imag of float - | Complex of C.t - - let null = Real 0.0 - let one = Real 1.0 - - let real = function - | Real x -> x - | Imag y -> 0.0 - | Complex z -> C.real z - - let imag = function - | Real x -> 0.0 - | Imag y -> y - | Complex z -> C.imag z - - end - -(* \thocwmodulesection{Suggesting A Default} *) - -(* There's no real choice here (yet) \ldots *) -module Default = Dense - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/lapack.nw =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/lapack.nw (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/lapack.nw (revision 8703) @@ -1,205 +0,0 @@ -% $Id$ -% -% Copyright (C) 1999-2009 by -% -% Wolfgang Kilian -% Thorsten Ohl -% Juergen Reuter -% -% WHIZARD is free software; you can redistribute it and/or modify it -% under the terms of the GNU General Public License as published by -% the Free Software Foundation; either version 2, or (at your option) -% any later version. -% -% WHIZARD is distributed in the hope that it will be useful, but -% WITHOUT ANY WARRANTY; without even the implied warranty of -% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -% GNU General Public License for more details. -% -% You should have received a copy of the GNU General Public License -% along with this program; if not, write to the Free Software -% Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -@ -\section{C Code Glueing O'Caml and FORTRAN} -<<[[lapack_glue.c]]>>= -<> -#include -#include -<> -@ -<>= -extern void eigenv_ (int *n, double *a, double *w, - int *lwork, double *work, int *info); -@ -<>= -value -eigenv_glue (value a, value w, value work) -{ - int n, lwork, info; - assert (Bigarray_val(a)->num_dims == 2); - assert (Bigarray_val(a)->dim[0] == Bigarray_val(a)->dim[1]); - assert ((Bigarray_val(a)->flags & BIGARRAY_KIND_MASK) == BIGARRAY_FLOAT64); - assert (Bigarray_val(w)->num_dims == 1); - assert ((Bigarray_val(w)->flags & BIGARRAY_KIND_MASK) == BIGARRAY_FLOAT64); - assert (Bigarray_val(work)->num_dims == 1); - assert ((Bigarray_val(work)->flags & BIGARRAY_KIND_MASK) == BIGARRAY_FLOAT64); - n = Bigarray_val(a)->dim[0]; - lwork = Bigarray_val(work)->dim[0]; - info = 0; - eigenv_ (&n, Data_bigarray_val (a), Data_bigarray_val (w), - &lwork, Data_bigarray_val(work), &info); - return Val_int (info); -} -@ -<>= -extern void eigenw_ (int *n, double *a, double *w, - int *lwork, double *work, - int *liwork, int *iwork, int *info); -@ -<>= -value -eigenw_glue (value a, value w, value work, value iwork) -{ - int n, lwork, liwork, info; - assert (Bigarray_val(a)->num_dims == 2); - assert (Bigarray_val(a)->dim[0] == Bigarray_val(a)->dim[1]); - assert ((Bigarray_val(a)->flags & BIGARRAY_KIND_MASK) == BIGARRAY_FLOAT64); - assert (Bigarray_val(w)->num_dims == 1); - assert ((Bigarray_val(w)->flags & BIGARRAY_KIND_MASK) == BIGARRAY_FLOAT64); - assert (Bigarray_val(work)->num_dims == 1); - assert ((Bigarray_val(work)->flags & BIGARRAY_KIND_MASK) == BIGARRAY_FLOAT64); - assert (Bigarray_val(iwork)->num_dims == 1); - assert ((Bigarray_val(iwork)->flags & BIGARRAY_KIND_MASK) == BIGARRAY_INT32); - - n = Bigarray_val(a)->dim[0]; - lwork = Bigarray_val(work)->dim[0]; - liwork = Bigarray_val(iwork)->dim[0]; - info = 0; - eigenw_ (&n, Data_bigarray_val (a), Data_bigarray_val (w), - &lwork, Data_bigarray_val(work), - &liwork, Data_bigarray_val(iwork), &info); - return Val_int (info); -} -@ -\section{FORTRAN Drivers Sans CHARACTERs} -<<[[lapack_f77.f]]>>= -<> -<> -@ -\begin{subequations} -\begin{align} - \text{\texttt{LWORK}} &\gg 3N - 1 \\ - \text{\texttt{LWORK}} &> (2 + N_B)N\qquad - \text{(where $N_B$ = 64 is ``generous'')} -\end{align} -\end{subequations} -<>= -cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc - subroutine eigenv (n, a, w, lwork, work, info) - implicit none - integer n, lwork, info - double precision a(n,n), w(n), work(lwork) - character*1 jobz, uplo - integer lda -cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc -c only eigenvalues -c jobz = "N" -c eigenvalues and eigenvectors - jobz = "V" -c upper triangular a - uplo = "U" -c lower triangular a -c uplo = "L" -c we will only call this with physically symmetric arrays - lda = n -cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc - call dsyev (jobz, uplo, n, a, lda, w, work, lwork, info) - end -@ -\begin{subequations} -\begin{align} - \text{\texttt{LWORK}} &> 1 + 5N + 2N + \log N + 3N^2 \\ - \text{\texttt{LIWORK}} &> 2 + 5N -\end{align} -\end{subequations} -<>= -cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc - subroutine eigenw (n, a, w, lwork, work, liwork, iwork, info) - implicit none - integer n, lwork, liwork, info - double precision a(n,n), w(n), work(lwork) - integer iwork(liwork) - character*1 jobz, uplo - integer lda -cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc -c only eigenvalues -c jobz = "N" -c eigenvalues and eigenvectors - jobz = "V" -c upper triangular a - uplo = "U" -c lower triangular a -c uplo = "L" -c we will only call this with physically symmetric arrays - lda = n -cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc - call dsyevd (jobz, uplo, n, a, lda, w, - $ work, lwork, iwork, liwork, info) - end -cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc -@ -<>= -/* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */ -@ -<>= -C $Id$ -C -C Copyright (C) 1999-2009 by -C -C Wolfgang Kilian -C Thorsten Ohl -C Juergen Reuter -C -C WHIZARD is free software; you can redistribute it and/or modify it -C under the terms of the GNU General Public License as published by -C the Free Software Foundation; either version 2, or (at your option) -C any later version. -C -C WHIZARD is distributed in the hope that it will be useful, but -C WITHOUT ANY WARRANTY; without even the implied warranty of -C MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -C GNU General Public License for more details. -C -C You should have received a copy of the GNU General Public License -C along with this program; if not, write to the Free Software -C Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% Local Variables: -% mode:noweb -% noweb-doc-mode:latex-mode -% noweb-code-mode:c-mode -% indent-tabs-mode:nil -% page-delimiter:"^@ %%%.*\n" -% End: Index: branches/ohl/omega-development/completed/whizard2/src/targets_Kmatrix.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/targets_Kmatrix.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/targets_Kmatrix.ml (revision 8703) @@ -1,561 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -let rcs_file = RCS.parse "Targets_Kmatrix" ["K-Matrix Support routines"] - { RCS.revision = "$Revision$"; - RCS.date = "$Date$"; - RCS.author = "$Author$"; - RCS.source - = "$URL$" } - -module Fortran = - struct - - open Printf - let nl = print_newline - -(* Special functions for the K matrix approach. This might be generalized - to other functions that have to have access to the parameters and - coupling constants. At the moment, this is hardcoded. *) - - let print pure_functions = - let pure = - if pure_functions then - "pure " - else - "" in - printf " !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!"; nl (); - printf " !!! Special K matrix functions"; nl (); - printf " !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!"; nl (); - nl (); - printf " %sfunction width_res (z,res,w_wkm,m,g) result (w)" pure; nl (); - printf " real(kind=default), intent(in) :: z, w_wkm, m, g"; nl (); - printf " integer, intent(in) :: res"; nl (); - printf " real(kind=default) :: w"; nl (); - printf " if (z.eq.0) then"; nl (); - printf " w = 0"; nl (); - printf " else"; nl (); - printf " if (w_wkm.eq.0) then"; nl (); - printf " select case (res)"; nl (); - printf " case (1) !!! Scalar isosinglet"; nl (); - printf " w = 3.*g**2/32./PI * m**3/vev**2"; nl (); - printf " case (2) !!! Scalar isoquintet"; nl (); - printf " w = g**2/64./PI * m**3/vev**2"; nl (); - printf " case (3) !!! Vector isotriplet"; nl (); - printf " w = g**2/48./PI * m"; nl (); - printf " case (4) !!! Tensor isosinglet"; nl (); - printf " w = g**2/320./PI * m**3/vev**2"; nl (); - printf " case (5) !!! Tensor isoquintet"; nl (); - printf " w = 3.*g**2/1920./PI * m**3/vev**2"; nl (); - printf " case default"; nl (); - printf " w = 0"; nl (); - printf " end select"; nl (); - printf " else"; nl (); - printf " w = w_wkm"; nl (); - printf " end if"; nl (); - printf " end if"; nl (); - printf " end function width_res"; nl (); - nl (); - printf " %sfunction s0stu (s, m) result (s0)" pure; nl (); - printf " real(kind=default), intent(in) :: s, m"; nl (); - printf " real(kind=default) :: s0"; nl (); - printf " if (m.ge.1.0e08) then"; nl (); - printf " s0 = 0"; nl (); - printf " else"; nl (); - printf " s0 = m**2 - s/2 + m**4/s * log(m**2/(s+m**2))"; nl (); - printf " end if"; nl (); - printf " end function s0stu"; nl (); - nl (); - printf " %sfunction s1stu (s, m) result (s1)" pure; nl (); - printf " real(kind=default), intent(in) :: s, m"; nl (); - printf " real(kind=default) :: s1"; nl (); - printf " if (m.ge.1.0e08) then"; nl (); - printf " s1 = 0"; nl (); - printf " else"; nl (); - printf " s1 = 2*m**4/s + s/6 + m**4/s**2*(2*m**2+s) &"; nl (); - printf " * log(m**2/(s+m**2))"; nl (); - printf " end if"; nl (); - printf " end function s1stu"; nl (); - nl (); - printf " %sfunction s2stu (s, m) result (s2)" pure; nl (); - printf " real(kind=default), intent(in) :: s, m"; nl (); - printf " real(kind=default) :: s2"; nl (); - printf " if (m.ge.1.0e08) then"; nl (); - printf " s2 = 0"; nl (); - printf " else"; nl (); - printf " s2 = m**4/s**2 * (6*m**2 + 3*s) + &"; nl (); - printf " m**4/s**3 * (6*m**4 + 6*m**2*s + s**2) &"; nl (); - printf " * log(m**2/(s+m**2))"; nl (); - printf " end if"; nl (); - printf " end function s2stu"; nl (); - nl (); - printf " %sfunction p0stu (s, m) result (p0)" pure; nl (); - printf " real(kind=default), intent(in) :: s, m"; nl (); - printf " real(kind=default) :: p0"; nl (); - printf " if (m.ge.1.0e08) then"; nl (); - printf " p0 = 0"; nl (); - printf " else"; nl (); - printf " p0 = 1 + (2*s+m**2)*log(m**2/(s+m**2))/s"; nl (); - printf " end if"; nl (); - printf " end function p0stu"; nl (); - nl (); - printf " %sfunction p1stu (s, m) result (p1)" pure; nl (); - printf " real(kind=default), intent(in) :: s, m"; nl (); - printf " real(kind=default) :: p1"; nl (); - printf " if (m.ge.1.0e08) then"; nl (); - printf " p1 = 0"; nl (); - printf " else"; nl (); - printf " p1 = (m**2 + 2*s)/s**2 * (2*s+(2*m**2+s) &"; nl (); - printf " * log(m**2/(s+m**2)))"; nl (); - printf " end if"; nl (); - printf " end function p1stu"; nl (); - nl (); - printf " %sfunction d0stu (s, m) result (d0)" pure; nl (); - printf " real(kind=default), intent(in) :: s, m"; nl (); - printf " real(kind=default) :: d0"; nl (); - printf " if (m.ge.1.0e08) then"; nl (); - printf " d0 = 0"; nl (); - printf " else"; nl (); - printf " d0 = (2*m**2+11*s)/6 + (m**4+6*m**2*s+6*s**2) &"; nl (); - printf " /3/s * log(m**2/(s+m**2))"; nl (); - printf " end if"; nl (); - printf " end function d0stu"; nl (); - nl (); - printf " %sfunction d1stu (s, m) result (d1)" pure; nl (); - printf " real(kind=default), intent(in) :: s, m"; nl (); - printf " real(kind=default) :: d1"; nl (); - printf " if (m.ge.1.0e08) then"; nl (); - printf " d1 = 0"; nl (); - printf " else"; nl (); - printf " d1 = (s*(12*m**4 + 72*m**2*s + 73*s**2) &"; nl (); - printf " + 6*(2*m**2 + s)*(m**4 + 6*m**2*s + 6*s**2) &"; nl (); - printf " * log(m**2/(s+m**2)))/18/s**2"; nl (); - printf " end if"; nl (); - printf " end function d1stu"; nl (); - nl (); - printf " %sfunction da00 (cc, s, m) result (amp_00)" pure; nl (); - printf " real(kind=default), intent(in) :: s"; nl (); - printf " real(kind=default), dimension(1:5), intent(in) :: m, cc"; nl (); - printf " real(kind=default) :: a00_0, a00_1"; nl (); - printf " complex(kind=default), dimension(1:6) :: a00"; nl (); - printf " complex(kind=default) :: ii, jj, amp_00"; nl (); - printf " ii = cmplx(0.0,1.0/32.0/Pi,default)"; nl (); - printf " jj = s**2/vev**4*ii"; nl (); - printf " !!! Scalar isosinglet"; nl (); - printf " if (cc(1).ne.0) then"; nl (); - printf " if (fudge_km.ne.0) then"; nl (); - printf " a00(1) = vev**4/s**2 * fudge_km * &"; nl (); - printf " cmplx(0.0,32.0*Pi,default)*(1.0 + &"; nl (); - printf " (s-m(1)**2)/(ii*cc(1)**2/vev**2*(3.0*s**2 + &"; nl (); - printf " (s-m(1)**2)*2.0*s0stu(s,m(1))) - (s-m(1)**2)))"; nl (); - printf " else"; nl (); - printf " a00(1) = vev**2/s**2 * cc(1)**2 * &"; nl (); - printf " (3.0 * s**2/cmplx(s-m(1)**2,m(1)*width_res(w_res,1,&"; nl (); - printf " wkm(1),m(1),cc(1))) + 2.0 * s0stu(s,m(1)))"; nl (); - printf " end if"; nl (); - printf " else"; nl (); - printf " a00(1) = 0"; nl (); - printf " end if"; nl (); - printf " !!! Scalar isoquintet"; nl (); - printf " a00(2) = 5.0*cc(2)**2/vev**2 * s0stu(s,m(2)) / 3.0"; nl (); - printf " a00(2) = vev**4/s**2*a00(2) /&"; nl (); - printf " (1.0_default - fudge_km*ii*a00(2))"; nl (); - printf " !!! Vector isotriplet"; nl (); - printf " a00(3) = cc(3)**2*(4.0*p0stu(s,m(3)) + 3.0*s/m(3)**2)"; nl (); - printf " a00(3) = vev**4/s**2*a00(3)/&"; nl (); - printf " (1.0_default - fudge_km*ii*a00(3))"; nl (); - printf " !!! Tensor isosinglet"; nl (); - printf " if (cc(4).ne.0) then"; nl (); - printf " if (fudge_km.ne.0) then"; nl (); - printf " a00(4) = vev**4/s**2 * fudge_km * &"; nl (); - printf " cmplx(0.0,32.0*Pi,default)*(1.0 + &"; nl (); - printf " (s-m(4)**2)/(ii*cc(4)**2/vev**2*(s**2/4.0 + &"; nl (); - printf " (s-m(4)**2)*((d0stu(s,m(4)) + s0stu(s,m(4))/2.0)&"; nl (); - printf " /3.0 + 5.0*s**3/m(4)**4/16.0)) - (s-m(4)**2)))"; nl (); - printf " else"; nl (); - printf " a00(4) = vev**2/s**2 * cc(4)**2 * ( s**2/ &"; nl (); - printf " cmplx(s-m(4)**2,m(4)*width_res(w_res,4,wkm(4),&"; nl (); - printf " m(4),cc(4)))/4.0 + &"; nl (); - printf " (d0stu(s,m(4)) + s0stu(s,m(4))/2.0)/3.0 + s**3 &"; nl (); - printf " /m(4)**4 * 5.0/16.0)"; nl (); - printf " end if"; nl (); - printf " else"; nl (); - printf " a00(4) = 0"; nl (); - printf " end if"; nl (); - printf " !!! Tensor isoquintet"; nl (); - printf " a00(5) = 5.0*cc(5)**2/vev**2*((d0stu(s,m(5))+s0stu(s,m(5))&"; nl (); - printf " /2.0)/3.0 - s**3/m(5)**4/16.0)/6.0"; nl (); - printf " a00(5) = vev**4/s**2*a00(5)/&"; nl (); - printf " (1.0_default - fudge_km*ii*a00(5))"; nl (); - printf " !!! Low energy theory alphas"; nl (); - printf " a00_0 = 2*fudge_higgs*vev**2/s + 8*(7*a4 + 11*a5)/3"; nl (); - printf " a00_1 = 25*log(lam_reg**2/s)/9 + 11./54.0_default"; nl (); - printf " a00(6) = a00_0 !!! + a00_1/16/Pi**2"; nl (); - printf " a00(6) = fudge_km*jj*a00(6)**2 / (1.0_default - jj*a00(6))"; nl (); - printf " amp_00 = sum(a00)"; nl (); - printf " end function da00"; nl (); - nl (); - printf " %sfunction da02 (cc, s, m) result (amp_02)" pure; nl (); - printf " real(kind=default), intent(in) :: s"; nl (); - printf " real(kind=default), dimension(5), intent(in) :: m, cc"; nl (); - printf " real(kind=default) :: a02_0, a02_1"; nl (); - printf " complex(kind=default), dimension(1:6) :: a02"; nl (); - printf " complex(kind=default) :: ii, jj, amp_02"; nl (); - printf " ii = cmplx(0.0,1.0/32.0/Pi,default)"; nl (); - printf " jj = s**2/vev**4*ii"; nl (); - printf " !!! Scalar isosinglet"; nl (); - printf " a02(1) = 2.0*cc(1)**2/vev**2 * s2stu(s,m(1))"; nl (); - printf " a02(1) = vev**4/s**2*a02(1)/&"; nl (); - printf " (1.0_default - fudge_km*ii*a02(1))"; nl (); - printf " !!! Scalar isoquintet"; nl (); - printf " a02(2) = 5.0*cc(2)**2/vev**2 * s2stu(s,m(2)) / 3.0"; nl (); - printf " a02(2) = vev**4/s**2*a02(2)/&"; nl (); - printf " (1.0_default - fudge_km*ii*a02(2))"; nl (); - printf " !!! Vector isotriplet"; nl (); - printf " a02(3) = 4.0*cc(3)**2*(2*s+m(3)**2)*s2stu(s,m(3))/m(3)**4"; nl (); - printf " a02(3) = vev**4/s**2*a02(3)/&"; nl (); - printf " (1.0_default - fudge_km*ii*a02(3))"; nl (); - printf " !!! Tensor isosinglet"; nl (); - printf " if (cc(4).ne.0) then"; nl (); - printf " if (fudge_km.ne.0) then"; nl (); - printf " a02(4) = vev**4/s**2 * fudge_km * &"; nl (); - printf " cmplx(0.0,32.0*Pi,default)*(1.0 + &"; nl (); - printf " (s-m(4)**2)/(ii*cc(4)**2/vev**2*(s**2/10.0 + &"; nl (); - printf " (s-m(4)**2)*((5.0/2.0+6.0*s/m(4)**2+6.0* &"; nl (); - printf " s**2/m(4)**4)* s2stu(s,m(4))/3.0 &"; nl (); - printf " - s**3/m(4)**4/80.0)) - (s-m(4)**2)))"; nl (); - printf " else"; nl (); - printf " a02(4) = vev**2/s**2 * cc(4)**2 * ( s**2/ &"; nl (); - printf " cmplx(s-m(4)**2,m(4)*width_res(w_res,4,wkm(4),&"; nl (); - printf " m(4),cc(4)))/10.0 + &"; nl (); - printf " (5./2.+6.*s/m(4)**2+6.*s**2/m(4)**4)*s2stu(s,m(4))/ &"; nl (); - printf " 3. - s**3/m(4)**4/80.)"; nl (); - printf " end if"; nl (); - printf " else"; nl (); - printf " a02(4) = 0"; nl (); - printf " end if"; nl (); - printf " !!! Tensor isoquintet"; nl (); - printf " a02(5) = cc(5)**2/vev**2*(5.0*(5.0/2.0+6.0* &"; nl (); - printf " s/m(5)**2+6.0*s**2/m(5)**4)*s2stu(s,m(5))/3.0 &"; nl (); - printf " - s**3/m(5)**4/16.0)/6.0"; nl (); - printf " a02(5) = vev**4/s**2*a02(5)/&"; nl (); - printf " (1.0_default - fudge_km*ii*a02(5))"; nl (); - printf " !!! Low energy theory alphas"; nl (); - printf " a02_0 = 8*(2*a4 + a5)/15"; nl (); - printf " a02_1 = log(lam_reg**2/s)/9 - 7./135.0_default"; nl (); - printf " a02(6) = a02_0 !!! + a02_1/16/Pi**2"; nl (); - printf " a02(6) = fudge_km*jj*a02(6)**2 / (1.0_default - jj*a02(6))"; nl (); - printf " amp_02 = sum(a02)"; nl (); - printf " end function da02"; nl (); - nl (); - printf " %sfunction da11 (cc, s, m) result (amp_11)" pure; nl (); - printf " real(kind=default), intent(in) :: s"; nl (); - printf " real(kind=default), dimension(5), intent(in) :: m, cc"; nl (); - printf " real(kind=default) :: a11_0, a11_1"; nl (); - printf " complex(kind=default), dimension(1:6) :: a11"; nl (); - printf " complex(kind=default) :: ii, jj, amp_11"; nl (); - printf " ii = cmplx(0.0,1.0/32.0/Pi,default)"; nl (); - printf " jj = s**2/vev**4*ii"; nl (); - printf " !!! Scalar isosinglet"; nl (); - printf " a11(1) = 2.0*cc(1)**2/vev**2 * s1stu(s,m(1))"; nl (); - printf " a11(1) = vev**4/s**2*a11(1)/&"; nl (); - printf " (1.0_default - fudge_km*ii*a11(1))"; nl (); - printf " !!! Scalar isoquintet"; nl (); - printf " a11(2) = - 5.0*cc(2)**2/vev**2 * s1stu(s,m(2)) / 6.0"; nl (); - printf " a11(2) = vev**4/s**2*a11(2)/&"; nl (); - printf " (1.0_default - fudge_km*ii*a11(2))"; nl (); - printf " !!! Vector isotriplet"; nl (); - printf " if (cc(3).ne.0) then"; nl (); - printf " if (fudge_km.ne.0) then"; nl (); - printf " a11(3) = vev**4/s**2 * fudge_km * &"; nl (); - printf " cmplx(0.0,32.0*Pi,default)*(1.0 + (s-m(3)**2) &"; nl (); - printf " /(ii*cc(3)**2*(2.0*s/3.0 + (s-m(3)**2)&"; nl (); - printf " *(s/m(3)**2+2.0*p1stu(s,m(3)))) - (s-m(3)**2)))"; nl (); - printf " else"; nl (); - printf " a11(3) = vev**4/s**2 * cc(3)**2 * ( 2.*s / &"; nl (); - printf " cmplx(s-m(3)**2,m(3)*width_res(w_res,3,wkm(3),m(3),&"; nl (); - printf " cc(3)))/3. + s/m(3)**2 + 2.*p1stu(s,m(3)))"; nl (); - printf " end if"; nl (); - printf " else"; nl (); - printf " a11(3) = 0"; nl (); - printf " end if"; nl (); - printf " !!! Tensor isosinglet"; nl (); - printf " a11(4) = cc(4)**2/vev**2*((d1stu(s,m(4)) + s1stu(s,m(4)) &"; nl (); - printf " /2.0)/3.0 + 3.0*s**3/m(4)**4/80.0)"; nl (); - printf " a11(4) = vev**4/s**2*a11(4)/&"; nl (); - printf " (1.0_default - fudge_km*ii*a11(4))"; nl (); - printf " !!! Tensor isoquintet"; nl (); - printf " a11(5) = -5.0*cc(5)**2/vev**2*((d1stu(s,m(5))+s1stu(s,m(5)) &"; nl (); - printf " /2.0)/36.0 + s**3/m(5)**4/64.0)"; nl (); - printf " a11(5) = vev**4/s**2*a11(5)/&"; nl (); - printf " (1.0_default - fudge_km*ii*a11(5))"; nl (); - printf " !!! Low energy theory alphas"; nl (); - printf " a11_0 = fudge_higgs*vev**2/3/s + 4*(a4 - 2*a5)/3"; nl (); - printf " a11_1 = - 1.0/54.0_default"; nl (); - printf " a11(6) = a11_0 !!! + a11_1/16/Pi**2"; nl (); - printf " a11(6) = fudge_km*jj*a11(6)**2 / (1.0_default - jj*a11(6))"; nl (); - printf " amp_11 = sum(a11)"; nl (); - printf " end function da11"; nl (); - nl (); - printf " %sfunction da20 (cc, s, m) result (amp_20)" pure; nl (); - printf " real(kind=default), intent(in) :: s"; nl (); - printf " real(kind=default), dimension(1:5), intent(in) :: m, cc"; nl (); - printf " real(kind=default) :: a20_0, a20_1"; nl (); - printf " complex(kind=default), dimension(1:6) :: a20"; nl (); - printf " complex(kind=default) :: ii, jj, amp_20"; nl (); - printf " ii = cmplx(0.0,1.0/32.0/Pi,default)"; nl (); - printf " jj = s**2/vev**4*ii"; nl (); - printf " !!! Scalar isosinglet"; nl (); - printf " a20(1) = 2.0*cc(1)**2/vev**2 * s0stu(s,m(1))"; nl (); - printf " a20(1) = vev**4/s**2*a20(1)/&"; nl (); - printf " (1.0_default - fudge_km*ii*a20(1))"; nl (); - printf " !!! Scalar isoquintet"; nl (); - printf " if (cc(2).ne.0) then"; nl (); - printf " if (fudge_km.ne.0) then"; nl (); - printf " a20(2) = vev**4/s**2 * fudge_km * &"; nl (); - printf " cmplx(0.0,32.0*Pi,default)*(1.0 + &"; nl (); - printf " (s-m(2)**2)/(ii*cc(2)**2/vev**2*(s**2/2.0 + &"; nl (); - printf " (s-m(2)**2)*s0stu(s,m(2))/6.0) - (s-m(2)**2)))"; nl (); - printf " else"; nl (); - printf " a20(2) = vev**2/s**2 * cc(2)**2 * ( s**2 / &"; nl (); - printf " cmplx(s-m(2)**2,m(2)*width_res(w_res,2,wkm(2),&"; nl (); - printf " m(2),cc(2)))/2. + s0stu(s,m(2))/6.)"; nl (); - printf " end if"; nl (); - printf " else"; nl (); - printf " a20(2) = 0"; nl (); - printf " end if"; nl (); - printf " !!! Vector isotriplet"; nl (); - printf " a20(3) = - cc(3)**2*(2.0*p0stu(s,m(3)) + 3.0*s/m(3)**2)"; nl (); - printf " a20(3) = vev**4/s**2*a20(3)/&"; nl (); - printf " (1.0_default - fudge_km*ii*a20(3))"; nl (); - printf " !!! Tensor isosinglet"; nl (); - printf " a20(4) = cc(4)**2/vev**2*((d1stu(s,m(4)) + s1stu(s,m(4)) &"; nl (); - printf " /2.0)/3.0 - s**3/m(4)**4/16.0)"; nl (); - printf " a20(4) = vev**4/s**2*a20(4)/&"; nl (); - printf " (1.0_default - fudge_km*ii*a20(4))"; nl (); - printf " !!! Tensor isoquintet"; nl (); - printf " if (cc(5).ne.0) then"; nl (); - printf " if (fudge_km.ne.0) then"; nl (); - printf " a20(5) = vev**4/s**2 * fudge_km * &"; nl (); - printf " cmplx(0.0,32.0*Pi,default)*(1.0 + &"; nl (); - printf " (s-m(5)**2)/(ii*cc(5)**2/vev**2*(s**2/2.0 + &"; nl (); - printf " (s-m(5)**2)*((d0stu(s,m(5)) + s0stu(s,m(5))/2.0)/3.0 &"; nl (); - printf " + 11.0*s**3/m(5)**4/16.0))/12.0 - (s-m(5)**2)))"; nl (); - printf " else"; nl (); - printf " a20(5) = vev**2/s**2 * cc(5)**2 * ( s**2 / &"; nl (); - printf " cmplx(s-m(5)**2,m(5)*width_res(w_res,5,wkm(5),&"; nl (); - printf " m(5),cc(5)))/24. + (d0stu(s,m(5)) &"; nl (); - printf " + s0stu(s,m(5)))/36. + 11.*s**3/m(5)**4/192.)"; nl (); - printf " end if"; nl (); - printf " else"; nl (); - printf " a20(5) = 0"; nl (); - printf " end if"; nl (); - printf " !!! Low energy theory alphas"; nl (); - printf " a20_0 = -fudge_higgs*vev**2/s + 16*(2*a4 + a5)/3"; nl (); - printf " a20_1 = 10*log(lam_reg**2/s)/9 + 25/108.0_default"; nl (); - printf " a20(6) = a20_0 !!! + a20_1/16/Pi**2"; nl (); - printf " a20(6) = fudge_km*jj*a20(6)**2 / (1.0_default - jj*a20(6))"; nl (); - printf " amp_20 = sum(a20)"; nl (); - printf " end function da20"; nl (); - nl (); - printf " %sfunction da22 (cc, s, m) result (amp_22)" pure; nl (); - printf " real(kind=default), intent(in) :: s"; nl (); - printf " real(kind=default), dimension(1:5), intent(in) :: m, cc"; nl (); - printf " real(kind=default) :: a22_0, a22_1"; nl (); - printf " complex(kind=default), dimension(1:6) :: a22"; nl (); - printf " complex(kind=default) :: ii, jj, amp_22"; nl (); - printf " ii = cmplx(0.0,1.0/32.0/Pi,default)"; nl (); - printf " jj = s**2/vev**4*ii"; nl (); - printf " !!! Scalar isosinglet"; nl (); - printf " a22(1) = 2.0*cc(1)**2/vev**2 * s2stu(s,m(1))"; nl (); - printf " a22(1) = vev**4/s**2*a22(1)/&"; nl (); - printf " (1.0_default - fudge_km*ii*a22(1))"; nl (); - printf " !!! Scalar isoquintet"; nl (); - printf " a22(2) = cc(2)**2/vev**2 * s2stu(s,m(2)) / 6.0"; nl (); - printf " a22(2) = vev**4/s**2*a22(2)/&"; nl (); - printf " (1.0_default - fudge_km*ii*a22(2))"; nl (); - printf " !!! Vector triplet"; nl (); - printf " a22(3) = - 2.0*cc(3)**2*(2*s+m(3)**2)*s2stu(s,m(3))/m(3)**4"; nl (); - printf " a22(3) = vev**4/s**2*a22(3)/&"; nl (); - printf " (1.0_default - fudge_km*ii*a22(3))"; nl (); - printf " !!! Tensor isosinglet"; nl (); - printf " a22(4) = cc(4)**2/vev**2*((5.0/2.0 + 6.0*s/m(4)**2+6.0* &"; nl (); - printf " s**2/m(4)**4)*s2stu(s,m(4))/3.0 - s**3/m(4)**4/80.0)"; nl (); - printf " a22(4) = vev**4/s**2*a22(4)/&"; nl (); - printf " (1.0_default - fudge_km*ii*a22(4))"; nl (); - printf " !!! Tensor isoquintet"; nl (); - printf " if (cc(5).ne.0) then"; nl (); - printf " if (fudge_km.ne.0) then"; nl (); - printf " a22(5) = vev**4 / s**2 * & "; nl (); - printf " cmplx(0.0,32.0*Pi,default)*(1.0 + &"; nl (); - printf " (s-m(5)**2)/(ii*cc(5)**2/vev**2*(s**2/80.0 + &"; nl (); - printf " (s-m(5)**2)*((5.0/2.0+6.0*s/m(5)**2+6.0* &"; nl (); - printf " s**2/m(5)**4)*s2stu(s,m(5))/3.0 &"; nl (); - printf " - s**3/m(5)**4/960.0)) - (s-m(5)**2)))"; nl (); - printf " else"; nl (); - printf " a22(5) = vev**2/s**2 * cc(5)**2 * ( s**2 / &"; nl (); - printf " cmplx(s-m(5)**2,m(5)*width_res(w_res,5,wkm(5),&"; nl (); - printf " m(5),cc(5)))/80. + (5.0/2.0+6.0* &"; nl (); - printf " s/m(5)**2+6.0*s**2/m(5)**4)*s2stu(s,m(5))/36.0 - &"; nl (); - printf " s**3/m(5)**4/960.0)"; nl (); - printf " end if"; nl (); - printf " else"; nl (); - printf " a22(5) = 0"; nl (); - printf " end if"; nl (); - printf " !!! Low energy theory alphas"; nl (); - printf " a22_0 = 4*(a4 + 2*a5)/15"; nl (); - printf " a22_1 = 2*log(lam_reg**2/s)/45 - 247/5400.0_default"; nl (); - printf " a22(6) = a22_0 !!! + a22_1/16/Pi**2"; nl (); - printf " a22(6) = fudge_km*jj*a22(6)**2 / (1.0_default - jj*a22(6))"; nl (); - printf " amp_22 = sum(a22)"; nl (); - printf " end function da22"; nl (); - nl (); - printf " %sfunction dalzz0_s (cc,m,k) result (alzz0_s)" pure; nl (); - printf " type(momentum), intent(in) :: k"; nl (); - printf " real(kind=default), dimension(1:5), intent(in) :: cc, m"; nl (); - printf " complex(kind=default) :: alzz0_s"; nl (); - printf " real(kind=default) :: s"; nl (); - printf " s = k*k"; nl (); - printf " alzz0_s = 2*g**4/costhw**2*((da00(cc,s,m) &"; nl (); - printf " - da20(cc,s,m))/24 &"; nl (); - printf " - 5*(da02(cc,s,m) - da22(cc,s,m))/12)"; nl (); - printf " end function dalzz0_s"; nl (); - nl (); - printf " %sfunction dalzz0_t (cc,m,k) result (alzz0_t)" pure; nl (); - printf " type(momentum), intent(in) :: k"; nl (); - printf " real(kind=default), dimension(1:5), intent(in) :: cc, m"; nl (); - printf " complex(kind=default) :: alzz0_t"; nl (); - printf " real(kind=default) :: s"; nl (); - printf " s = k*k"; nl (); - printf " alzz0_t = 5*g**4/costhw**2*(da02(cc,s,m) - &"; nl (); - printf " da22(cc,s,m))/4"; nl (); - printf " end function dalzz0_t"; nl (); - nl (); - printf " %sfunction dalzz1_s (cc,m,k) result (alzz1_s)" pure; nl (); - printf " type(momentum), intent(in) :: k"; nl (); - printf " real(kind=default), dimension(1:5), intent(in) :: cc, m"; nl (); - printf " complex(kind=default) :: alzz1_s"; nl (); - printf " real(kind=default) :: s"; nl (); - printf " s = k*k"; nl (); - printf " alzz1_s = g**4/costhw**2*(da20(cc,s,m)/8 &"; nl (); - printf " - 5*da22(cc,s,m)/4)"; nl (); - printf " end function dalzz1_s"; nl (); - nl (); - printf " %sfunction dalzz1_t (cc,m,k) result (alzz1_t)" pure; nl (); - printf " type(momentum), intent(in) :: k"; nl (); - printf " real(kind=default), dimension(1:5), intent(in) :: cc, m"; nl (); - printf " complex(kind=default) :: alzz1_t"; nl (); - printf " real(kind=default) :: s"; nl (); - printf " s = k*k"; nl (); - printf " alzz1_t = g**4/costhw**2*(- 3*da11(cc,s,m)/8 &"; nl (); - printf " + 15*da22(cc,s,m)/8)"; nl (); - printf " end function dalzz1_t"; nl (); - nl (); - printf " %sfunction dalzz1_u (cc,m,k) result (alzz1_u)" pure; nl (); - printf " type(momentum), intent(in) :: k"; nl (); - printf " real(kind=default), dimension(1:5), intent(in) :: cc, m"; nl (); - printf " complex(kind=default) :: alzz1_u"; nl (); - printf " real(kind=default) :: s"; nl (); - printf " s = k*k"; nl (); - printf " alzz1_u = g**4/costhw**2*(3*da11(cc,s,m)/8 &"; nl (); - printf " + 15*da22(cc,s,m)/8)"; nl (); - printf " end function dalzz1_u"; nl (); - nl (); - printf " %sfunction dalww0_s (cc,m,k) result (alww0_s)" pure; nl (); - printf " type(momentum), intent(in) :: k"; nl (); - printf " real(kind=default), dimension(1:5), intent(in) :: cc, m"; nl (); - printf " complex(kind=default) :: alww0_s"; nl (); - printf " real(kind=default) :: s"; nl (); - printf " s = k*k"; nl (); - printf " alww0_s = g**4*((2*da00(cc,s,m) + da20(cc,s,m))/24 &"; nl (); - printf " - 5*(2*da02(cc,s,m) + da22(cc,s,m))/12)"; nl (); - printf " end function dalww0_s"; nl (); - nl (); - printf " %sfunction dalww0_t (cc,m,k) result (alww0_t)" pure; nl (); - printf " type(momentum), intent(in) :: k"; nl (); - printf " real(kind=default), dimension(1:5), intent(in) :: cc, m"; nl (); - printf " complex(kind=default) :: alww0_t"; nl (); - printf " real(kind=default) :: s"; nl (); - printf " s = k*k"; nl (); - printf " alww0_t = g**4*(10*da02(cc,s,m) - 3*da11(cc,s,m) &"; nl (); - printf " + 5*da22(cc,s,m))/8"; nl (); - printf " end function dalww0_t"; nl (); - nl (); - printf " %sfunction dalww0_u (cc,m,k) result (alww0_u)" pure; nl (); - printf " type(momentum), intent(in) :: k"; nl (); - printf " real(kind=default), dimension(1:5), intent(in) :: cc, m"; nl (); - printf " complex(kind=default) :: alww0_u"; nl (); - printf " real(kind=default) :: s"; nl (); - printf " s = k*k"; nl (); - printf " alww0_u = g**4*(10*da02(cc,s,m) + 3*da11(cc,s,m) &"; nl (); - printf " + 5*da22(cc,s,m))/8"; nl (); - printf " end function dalww0_u"; nl (); - nl (); - printf " %sfunction dalww2_s (cc,m,k) result (alww2_s)" pure; nl (); - printf " type(momentum), intent(in) :: k"; nl (); - printf " real(kind=default), dimension(1:5), intent(in) :: cc, m"; nl (); - printf " complex(kind=default) :: alww2_s"; nl (); - printf " real(kind=default) :: s"; nl (); - printf " s = k*k"; nl (); - printf " alww2_s = g**4*(da20(cc,s,m) - 10*da22(cc,s,m))/4 "; nl (); - printf " end function dalww2_s"; nl (); - nl (); - printf " %sfunction dalww2_t (cc,m,k) result (alww2_t)" pure; nl (); - printf " type(momentum), intent(in) :: k"; nl (); - printf " real(kind=default), dimension(1:5), intent(in) :: cc, m"; nl (); - printf " complex(kind=default) :: alww2_t"; nl (); - printf " real(kind=default) :: s"; nl (); - printf " s = k*k"; nl (); - printf " alww2_t = 15*g**4*da22(cc,s,m)/4"; nl (); - printf " end function dalww2_t"; nl (); - nl (); - printf " %sfunction dalz4_s (cc,m,k) result (alz4_s)" pure; nl (); - printf " type(momentum), intent(in) :: k"; nl (); - printf " real(kind=default), dimension(1:5), intent(in) :: cc, m"; nl (); - printf " complex(kind=default) :: alz4_s"; nl (); - printf " real(kind=default) :: s"; nl (); - printf " s = k*k"; nl (); - printf " alz4_s = g**4/costhw**4*((da00(cc,s,m) &"; nl (); - printf " + 2*da20(cc,s,m))/12 &"; nl (); - printf " - 5*(da02(cc,s,m)+2*da22(cc,s,m))/6)"; nl (); - printf " end function dalz4_s"; nl (); - nl (); - printf " %sfunction dalz4_t (cc,m,k) result (alz4_t)" pure; nl (); - printf " type(momentum), intent(in) :: k"; nl (); - printf " real(kind=default), dimension(1:5), intent(in) :: cc, m"; nl (); - printf " complex(kind=default) :: alz4_t"; nl (); - printf " real(kind=default) :: s"; nl (); - printf " s = k*k"; nl (); - printf " alz4_t = g**4/costhw**4*5*(da02(cc,s,m) &"; nl (); - printf " + 2*da22(cc,s,m))/4"; nl (); - printf " end function dalz4_t"; nl (); - nl () - - end - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/targets.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/targets.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/targets.ml (revision 8703) @@ -1,2906 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -let rcs_file = RCS.parse "Targets" ["Code Generation"] - { RCS.revision = "$Revision$"; - RCS.date = "$Date$"; - RCS.author = "$Author$"; - RCS.source - = "$URL$" } - -module Dummy (F : Fusion.Maker) (P : Momentum.T) (CM : Model.Colorized) = - struct - let rcs_list = [] - type amplitudes = Fusion.Colored(F)(P)(CM).amplitudes - type diagnostic = All | Arguments | Helicities | Momenta | Gauge - let options = Options.empty - let amplitudes_to_channel cmdline oc amplitudes = failwith "Targets.Dummy" - let parameters_to_channel oc = failwith "Targets.Dummy" - end - -(* \thocwmodulesection{\texttt{Fortran\,90/95}} *) - -(* \thocwmodulesubsection{Dirac Fermions} - We factor out the code for fermions so that we can use the simpler - implementation for Dirac fermions if the model contains no Majorana - fermions. *) - -module type Fermions = - sig - open Coupling - val psi_type : string - val psibar_type : string - val chi_type : string - val grav_type : string - val psi_incoming : string - val brs_psi_incoming : string - val psibar_incoming : string - val brs_psibar_incoming : string - val chi_incoming : string - val brs_chi_incoming : string - val grav_incoming : string - val psi_outgoing : string - val brs_psi_outgoing : string - val psibar_outgoing : string - val brs_psibar_outgoing : string - val chi_outgoing : string - val brs_chi_outgoing : string - val grav_outgoing : string - val psi_propagator : string - val psibar_propagator : string - val chi_propagator : string - val grav_propagator : string - val psi_projector : string - val psibar_projector : string - val chi_projector : string - val grav_projector : string - val psi_gauss : string - val psibar_gauss : string - val chi_gauss : string - val grav_gauss : string - val print_current : int * fermionbar * boson * fermion -> - string -> string -> string -> fuse2 -> unit - val print_current_p : int * fermion * boson * fermion -> - string -> string -> string -> fuse2 -> unit - val print_current_b : int * fermionbar * boson * fermionbar -> - string -> string -> string -> fuse2 -> unit - val print_current_g : int * fermionbar * boson * fermion -> - string -> string -> string -> string -> string -> string - -> fuse2 -> unit - val print_current_g4 : int * fermionbar * boson2 * fermion -> - string -> string -> string -> string -> fuse3 -> unit - val reverse_braket : lorentz -> bool - val use_module : string - val require_library : string list - val rcs : RCS.t - end - -module Fortran_Fermions : Fermions = - struct - let rcs = RCS.rename rcs_file "Targets.Fortran_Fermions()" - [ "generates Fortran95 code for Dirac fermions"; - "using revision 2000_10_A of module omega95" ] - - open Coupling - open Format - - let psi_type = "spinor" - let psibar_type = "conjspinor" - let chi_type = "???" - let grav_type = "???" - - let psi_incoming = "u" - let brs_psi_incoming = "brs_u" - let psibar_incoming = "vbar" - let brs_psibar_incoming = "brs_vbar" - let chi_incoming = "???" - let brs_chi_incoming = "???" - let grav_incoming = "???" - let psi_outgoing = "v" - let brs_psi_outgoing = "brs_v" - let psibar_outgoing = "ubar" - let brs_psibar_outgoing = "brs_ubar" - let chi_outgoing = "???" - let brs_chi_outgoing = "???" - let grav_outgoing = "???" - - let psi_propagator = "pr_psi" - let psibar_propagator = "pr_psibar" - let chi_propagator = "???" - let grav_propagator = "???" - - let psi_projector = "pj_psi" - let psibar_projector = "pj_psibar" - let chi_projector = "???" - let grav_projector = "???" - - let psi_gauss = "pg_psi" - let psibar_gauss = "pg_psibar" - let chi_gauss = "???" - let grav_gauss = "???" - - let format_coupling coeff c = - match coeff with - | 1 -> c - | -1 -> "(-" ^ c ^")" - | coeff -> string_of_int coeff ^ "*" ^ c - - let format_coupling_2 coeff c = - match coeff with - | 1 -> c - | -1 -> "-" ^ c - | coeff -> string_of_int coeff ^ "*" ^ c - - let print_fermion_current coeff f c wf1 wf2 fusion = - let c = format_coupling coeff c in - match fusion with - | F13 -> printf "%s_ff(%s,%s,%s)" f c wf1 wf2 - | F31 -> printf "%s_ff(%s,%s,%s)" f c wf2 wf1 - | F23 -> printf "f_%sf(%s,%s,%s)" f c wf1 wf2 - | F32 -> printf "f_%sf(%s,%s,%s)" f c wf2 wf1 - | F12 -> printf "f_f%s(%s,%s,%s)" f c wf1 wf2 - | F21 -> printf "f_f%s(%s,%s,%s)" f c wf2 wf1 - -(* \begin{dubious} - Using a two element array for the combined vector-axial and scalar-pseudo - couplings helps to support HELAS as well. Since we will probably never - support general boson couplings with HELAS, it might be retired in favor - of two separate variables. For this [Model.constant_symbol] has to be - generalized. - \end{dubious} *) - -(* \begin{dubious} - NB: passing the array instead of two separate constants would be a - \emph{bad} idea, because the support for Majorana spinors below will - have to flip signs! - \end{dubious} *) - - let print_fermion_current2 coeff f c wf1 wf2 fusion = - let c = format_coupling_2 coeff c in - match fusion with - | F13 -> printf "%s_ff(%s(1),%s(2),%s,%s)" f c c wf1 wf2 - | F31 -> printf "%s_ff(%s(1),%s(2),%s,%s)" f c c wf2 wf1 - | F23 -> printf "f_%sf(%s(1),%s(2),%s,%s)" f c c wf1 wf2 - | F32 -> printf "f_%sf(%s(1),%s(2),%s,%s)" f c c wf2 wf1 - | F12 -> printf "f_f%s(%s(1),%s(2),%s,%s)" f c c wf1 wf2 - | F21 -> printf "f_f%s(%s(1),%s(2),%s,%s)" f c c wf2 wf1 - - let print_current = function - | coeff, Psibar, VA, Psi -> print_fermion_current2 coeff "va" - | coeff, Psibar, V, Psi -> print_fermion_current coeff "v" - | coeff, Psibar, A, Psi -> print_fermion_current coeff "a" - | coeff, Psibar, VL, Psi -> print_fermion_current coeff "vl" - | coeff, Psibar, VR, Psi -> print_fermion_current coeff "vr" - | coeff, Psibar, VLR, Psi -> print_fermion_current2 coeff "vlr" - | coeff, Psibar, SP, Psi -> print_fermion_current2 coeff "sp" - | coeff, Psibar, S, Psi -> print_fermion_current coeff "s" - | coeff, Psibar, P, Psi -> print_fermion_current coeff "p" - | coeff, Psibar, SL, Psi -> print_fermion_current coeff "sl" - | coeff, Psibar, SR, Psi -> print_fermion_current coeff "sr" - | coeff, Psibar, SLR, Psi -> print_fermion_current2 coeff "slr" - | coeff, Psibar, _, Psi -> invalid_arg - "Targets.Fortran_Fermions: no superpotential here" - | _, Chibar, _, _ | _, _, _, Chi -> invalid_arg - "Targets.Fortran_Fermions: Majorana spinors not handled" - | _, Gravbar, _, _ | _, _, _, Grav -> invalid_arg - "Targets.Fortran_Fermions: Gravitinos not handled" - - let print_current_p = function - | _, _, _, _ -> invalid_arg - "Targets.Fortran_Fermions: No clashing arrows here" - - let print_current_b = function - | _, _, _, _ -> invalid_arg - "Targets.Fortran_Fermions: No clashing arrows here" - - let print_current_g = function - | _, _, _, _ -> invalid_arg - "Targets.Fortran_Fermions: No gravitinos here" - - let print_current_g4 = function - | _, _, _, _ -> invalid_arg - "Targets.Fortran_Fermions: No gravitinos here" - - let reverse_braket= function - | Spinor -> true - | _ -> false - - let use_module = "omega95" - let require_library = - ["omega_spinors_2003_03_A"; "omega_spinor_cpls_2003_03_A"] - end - -(* \thocwmodulesubsection{Main Functor} *) - -module Make_Fortran (Fermions : Fermions) - (Fusion_Maker : Fusion.Maker) (P : Momentum.T) (CM : Model.Colorized) = - struct - let rcs_list = - [ RCS.rename rcs_file "Targets.Make_Fortran()" - [ "Interface for Whizard 2.X"; - "NB: non-gauge vector couplings are not available yet" ]; - Fermions.rcs ] - - let require_library = - Fermions.require_library @ - [ "omega_vectors_2003_03_A"; "omega_polarizations_2003_03_A"; - "omega_couplings_2003_03_A"; "omega_utils_2003_03_A" ] - - module F = Fusion_Maker(P)(CM) - type amplitude = F.amplitude - - module CF = Fusion.Colored(Fusion_Maker)(P)(CM) - type amplitudes = CF.amplitudes - - open Coupling - open Format - - let line_length = ref 80 - let kind = ref "default" - let fortran95 = ref true - let module_name = ref "omega_amplitude" - let use_modules = ref [] - let whizard = ref false - let parameter_module = ref "omega_parameters" - let no_write = ref false - let km_write = ref false - let km_pure = ref false - - let options = Options.create - [ "90", Arg.Clear fortran95, - "don't use Fortran95 features that are not in Fortran90"; - "kind", Arg.String (fun s -> kind := s), - "real and complex kind (default: " ^ !kind ^ ")"; - "width", Arg.Int (fun w -> line_length := w), "approx. line length"; - "module", Arg.String (fun s -> module_name := s), "module name"; - "use", Arg.String (fun s -> use_modules := s :: !use_modules), - "use module"; - "parameter_module", Arg.String (fun s -> parameter_module := s), - "parameter_module"; - "whizard", Arg.Unit (fun () -> - use_modules := - ["parameters"; "omega_parameters_whizard"] @ !use_modules; - whizard := true), - "include WHIZARD interface"; - "no_write", Arg.Set no_write, "no 'write' statements"; - "kmatrix_write", Arg.Set km_write, "write K matrix functions"; - "kmatrix_write_pure", Arg.Set km_pure, "write K matrix pure functions"] - -(* Fortran style line continuation: *) - - let continuing = ref true - - let nl () = - continuing := false; - print_newline (); - continuing := true - - let wrap_newline () = - let out, flush, newline, space = get_all_formatter_output_functions () in - let newline' () = if !continuing then out " &" 0 2; newline () in - set_all_formatter_output_functions out flush newline' space - - let print_list = function - | [] -> () - | a :: rest -> - print_string a; - List.iter (fun s -> printf ",@ %s" s) rest - -(* \thocwmodulesubsection{Variables and Declarations} *) - - let p2s p = - if p >= 0 && p <= 9 then - string_of_int p - else if p <= 36 then - String.make 1 (Char.chr (Char.code 'A' + p - 10)) - else - "_" - - let format_momentum p = - "p" ^ String.concat "" (List.map p2s p) - - let format_p wf = - String.concat "" (List.map p2s (F.momentum_list wf)) - - let ext_momentum wf = - match F.momentum_list wf with - | [n] -> n - | _ -> invalid_arg "Targets.Fortran.ext_momentum" - - module PSet = Set.Make (struct type t = int list let compare = compare end) - - let add_tag wf name = - match F.wf_tag wf with - | None -> name - | Some tag -> name ^ "_" ^ tag - - let variable wf = - add_tag wf (CM.flavor_symbol (F.flavor wf) ^ "_" ^ format_p wf) - - let momentum wf = "p" ^ format_p wf - let spin wf = "s(" ^ string_of_int (ext_momentum wf) ^ ")" - - let declare_list t = function - | [] -> () - | wfs -> - printf " @[<2>%s :: " t; print_list (List.map variable wfs); nl () - - type declarations = - { scalars : F.wf list; - spinors : F.wf list; - conjspinors : F.wf list; - realspinors : F.wf list; - ghostspinors : F.wf list; - vectorspinors : F.wf list; - vectors : F.wf list; - massive_vectors : F.wf list; - tensors_1 : F.wf list; - tensors_2 : F.wf list; - brs_scalars : F.wf list; - brs_spinors : F.wf list; - brs_conjspinors : F.wf list; - brs_realspinors : F.wf list; - brs_vectorspinors : F.wf list; - brs_vectors : F.wf list; - brs_massive_vectors : F.wf list } - - let rec classify_wfs' acc = function - | [] -> acc - | wf :: rest -> - classify_wfs' - (match CM.lorentz (F.flavor wf) with - | Scalar -> {acc with scalars = wf :: acc.scalars} - | Spinor -> {acc with spinors = wf :: acc.spinors} - | ConjSpinor -> {acc with conjspinors = wf :: acc.conjspinors} - | Majorana -> {acc with realspinors = wf :: acc.realspinors} - | Maj_Ghost -> {acc with ghostspinors = wf :: acc.ghostspinors} - | Vectorspinor -> - {acc with vectorspinors = wf :: acc.vectorspinors} - | Vector -> {acc with vectors = wf :: acc.vectors} - | Massive_Vector -> - {acc with massive_vectors = wf :: acc.massive_vectors} - | Tensor_1 -> {acc with tensors_1 = wf :: acc.tensors_1} - | Tensor_2 -> {acc with tensors_2 = wf :: acc.tensors_2} - | BRS Scalar -> {acc with brs_scalars = wf :: acc.brs_scalars} - | BRS Spinor -> {acc with brs_spinors = wf :: acc.brs_spinors} - | BRS ConjSpinor -> {acc with brs_conjspinors = - wf :: acc.brs_conjspinors} - | BRS Majorana -> {acc with brs_realspinors = - wf :: acc.brs_realspinors} - | BRS Vectorspinor -> {acc with brs_vectorspinors = - wf :: acc.brs_vectorspinors} - | BRS Vector -> {acc with brs_vectors = wf :: acc.brs_vectors} - | BRS Massive_Vector -> {acc with brs_massive_vectors = - wf :: acc.brs_massive_vectors} - | BRS _ -> invalid_arg "Targets.wfs_classify': not needed here") - rest - - let classify_wfs wfs = classify_wfs' - { scalars = []; spinors = []; conjspinors = []; realspinors = []; - ghostspinors = []; vectorspinors = []; vectors = []; - massive_vectors = []; tensors_1 = []; tensors_2 = []; - brs_scalars = [] ; brs_spinors = []; brs_conjspinors = []; - brs_realspinors = []; brs_vectorspinors = []; - brs_vectors = []; brs_massive_vectors = []} - wfs - -(* \thocwmodulesubsection{Parameters} *) - - type 'a parameters = - { real_singles : 'a list; - real_arrays : ('a * int) list; - complex_singles : 'a list; - complex_arrays : ('a * int) list } - - let rec classify_singles acc = function - | [] -> acc - | Real p :: rest -> classify_singles - { acc with real_singles = p :: acc.real_singles } rest - | Complex p :: rest -> classify_singles - { acc with complex_singles = p :: acc.complex_singles } rest - - let rec classify_arrays acc = function - | [] -> acc - | (Real_Array p, rhs) :: rest -> classify_arrays - { acc with real_arrays = - (p, List.length rhs) :: acc.real_arrays } rest - | (Complex_Array p, rhs) :: rest -> classify_arrays - { acc with complex_arrays = - (p, List.length rhs) :: acc.complex_arrays } rest - - let classify_parameters params = - classify_arrays - (classify_singles - { real_singles = []; - real_arrays = []; - complex_singles = []; - complex_arrays = [] } - (List.map fst params.derived)) params.derived_arrays - - - let rec schisma n l = - if List.length l <= n then - [l] - else - let a, b = ThoList.splitn n l in - [a] @ (schisma n b) - - let rec schisma_num i n l = - if List.length l <= n then - [(i,l)] - else - let a, b = ThoList.splitn n l in - [(i,a)] @ (schisma_num (i+1) n b) - - let declare_parameters' t = function - | [] -> () - | plist -> - printf " @[<2>%s(kind=%s), public, save :: " t !kind; - print_list (List.map CM.constant_symbol plist); nl () - - let declare_parameters t plist = - List.iter (declare_parameters' t) plist - - let declare_parameter_array t (p, n) = - printf " @[<2>%s(kind=%s), dimension(%d), public, save :: %s" - t !kind n (CM.constant_symbol p); nl () - - let default_parameter (x, v) = - printf "@ %s = %g_%s" (CM.constant_symbol x) v !kind - - let declare_default_parameters t = function - | [] -> () - | p :: plist -> - printf " @[<2>%s(kind=%s), public, save ::" t !kind; - default_parameter p; - List.iter (fun p' -> printf ","; default_parameter p') plist; - nl () - - let rec format_constant = function - | I -> sprintf "cmplx (0.0_%s, 1.0_%s)" !kind !kind - | Const c when c < 0 -> sprintf "(%d.0_%s)" c !kind - | Const c -> sprintf "%d.0_%s" c !kind - | _ -> invalid_arg "format_constant" - - let rec eval_parameter' = function - | I -> printf "cmplx (0.0_%s, 1.0_%s)" !kind !kind - | Const c when c < 0 -> printf "(%d.0_%s)" c !kind - | Const c -> printf "%d.0_%s" c !kind - | Atom x -> printf "%s" (CM.constant_symbol x) - | Sum [] -> printf "0.0_%s" !kind - | Sum [x] -> eval_parameter' x - | Sum (x :: xs) -> - printf "@,("; eval_parameter' x; - List.iter (fun x -> printf "@, + "; eval_parameter' x) xs; - printf ")" - | Diff (x, y) -> - printf "@,("; eval_parameter' x; - printf " - "; eval_parameter' y; printf ")" - | Neg x -> printf "@,( - "; eval_parameter' x; printf ")" - | Prod [] -> printf "1.0_%s" !kind - | Prod [x] -> eval_parameter' x - | Prod (x :: xs) -> - printf "@,("; eval_parameter' x; - List.iter (fun x -> printf " * "; eval_parameter' x) xs; - printf ")" - | Quot (x, y) -> - printf "@,("; eval_parameter' x; - printf " / "; eval_parameter' y; printf ")" - | Rec x -> - printf "@, (1.0_%s / " !kind; eval_parameter' x; printf ")" - | Pow (x, n) -> - printf "@,("; eval_parameter' x; printf "**%d" n; printf ")" - | Sqrt x -> printf "@,sqrt ("; eval_parameter' x; printf ")" - | Sin x -> printf "@,sin ("; eval_parameter' x; printf ")" - | Cos x -> printf "@,cos ("; eval_parameter' x; printf ")" - | Tan x -> printf "@,tan ("; eval_parameter' x; printf ")" - | Cot x -> printf "@,cot ("; eval_parameter' x; printf ")" - | Atan2 (y, x) -> printf "@,atan2 ("; eval_parameter' y; - printf ",@ "; eval_parameter' x; printf ")" - | Conj x -> printf "@,conjg ("; eval_parameter' x; printf ")" - - let strip_single_tag = function - | Real x -> x - | Complex x -> x - - let strip_array_tag = function - | Real_Array x -> x - | Complex_Array x -> x - - let eval_parameter (lhs, rhs) = - let x = CM.constant_symbol (strip_single_tag lhs) in - printf " @[<2>%s = " x; eval_parameter' rhs; nl () - - let eval_para_list n l = - printf " subroutine setup_parameters%s ()" (string_of_int n); nl(); - List.iter eval_parameter l; - printf " end subroutine setup_parameters%s" (string_of_int n); nl() - - let eval_parameter_pair (lhs, rhs) = - let x = CM.constant_symbol (strip_array_tag lhs) in - let _ = List.fold_left (fun i rhs' -> - printf " @[<2>%s(%d) = " x i; eval_parameter' rhs'; nl (); - succ i) 1 rhs in - () - - let eval_para_pair_list n l = - printf " subroutine setup_parameters%s ()" (string_of_int n); nl(); - List.iter eval_parameter_pair l; - printf " end subroutine setup_parameters%s" (string_of_int n); nl() - - let print_echo fmt p = - let s = CM.constant_symbol p in - printf " write (unit = *, fmt = fmt_%s) \"%s\", %s" - fmt s s; nl () - - let print_echo_array fmt (p, n) = - let s = CM.constant_symbol p in - for i = 1 to n do - printf " write (unit = *, fmt = fmt_%s_array) " fmt ; - printf "\"%s\", %d, %s(%d)" s i s i; nl () - done - - let parameters_to_fortran oc params = - set_formatter_out_channel oc; - set_margin !line_length; - wrap_newline (); - let declarations = classify_parameters params in - printf "module %s" !parameter_module; nl (); - printf " use kinds"; nl (); - printf " use omega_constants"; nl (); - printf " implicit none"; nl (); - printf " private"; nl (); - printf " @[<2>public :: setup_parameters"; - if !no_write then begin - printf "! No print_parameters"; nl(); - end else begin - printf "@,, print_parameters"; nl (); - end; - declare_default_parameters "real" params.input; - declare_parameters "real" (schisma 69 declarations.real_singles); - List.iter (declare_parameter_array "real") declarations.real_arrays; - declare_parameters "complex" (schisma 69 declarations.complex_singles); - List.iter (declare_parameter_array "complex") declarations.complex_arrays; - printf "contains"; nl (); - printf " ! derived parameters:"; nl (); - let shredded = schisma_num 1 120 params.derived in - let shredded_arrays = schisma_num 1 120 params.derived_arrays in - let num_sub = List.length shredded in - let num_sub_arrays = List.length shredded_arrays in - printf " !length: %s" (string_of_int (List.length params.derived)); - nl(); - printf " !Num_Sub: %s" (string_of_int num_sub); nl(); - List.iter (fun (i,l) -> eval_para_list i l) shredded; - List.iter (fun (i,l) -> eval_para_pair_list (num_sub + i) l) - shredded_arrays; - printf " subroutine setup_parameters ()"; nl(); - let sum_sub = num_sub + num_sub_arrays in - for i = 1 to sum_sub do - printf " call setup_parameters%s" (string_of_int i); nl(); - done; - printf " end subroutine setup_parameters"; nl(); - if !no_write then begin - printf "! No print_parameters"; nl(); - end else begin - printf " subroutine print_parameters ()"; nl(); - printf " @[<2>character(len=*), parameter ::"; - printf "@ fmt_real = \"(A12,4X,' = ',E25.18)\","; - printf "@ fmt_complex = \"(A12,4X,' = ',E25.18,' + i*',E25.18)\","; - printf "@ fmt_real_array = \"(A12,'(',I2.2,')',' = ',E25.18)\","; - printf "@ fmt_complex_array = "; - printf "\"(A12,'(',I2.2,')',' = ',E25.18,' + i*',E25.18)\""; nl (); - printf " @[<2>write (unit = *, fmt = \"(A)\") @,"; - printf "\"default values for the input parameters:\""; nl (); - List.iter (fun (p, _) -> print_echo "real" p) params.input; - printf " @[<2>write (unit = *, fmt = \"(A)\") @,"; - printf "\"derived parameters:\""; nl (); - List.iter (print_echo "real") declarations.real_singles; - List.iter (print_echo "complex") declarations.complex_singles; - List.iter (print_echo_array "real") declarations.real_arrays; - List.iter (print_echo_array "complex") declarations.complex_arrays; - printf " end subroutine print_parameters"; nl(); - end; - printf "end module %s" !parameter_module; nl (); - printf "! O'Mega revision control information:"; nl (); - List.iter (fun s -> printf "! %s" s; nl ()) - (ThoList.flatmap RCS.summary (CM.rcs :: rcs_list)); - printf "!!! program test_parameters"; nl(); - printf "!!! use %s" !parameter_module; nl(); - printf "!!! call setup_parameters ()"; nl(); - printf "!!! call print_parameters ()"; nl(); - printf "!!! end program test_parameters"; nl() - -(* \thocwmodulesubsection{Run-Time Diagnostics} *) - - type diagnostic = All | Arguments | Helicities | Momenta | Gauge - - type diagnostic_mode = Off | Warn | Panic - - let warn mode = - match !mode with - | Off -> false - | Warn -> true - | Panic -> true - - let panic mode = - match !mode with - | Off -> false - | Warn -> false - | Panic -> true - - let suffix mode = - if panic mode then - "panic" - else - "warn" - - let diagnose_arguments = ref Off - let diagnose_helicities = ref Off - let diagnose_momenta = ref Off - let diagnose_gauge = ref Off - - let rec parse_diagnostic = function - | All, panic -> - parse_diagnostic (Arguments, panic); - parse_diagnostic (Helicities, panic); - parse_diagnostic (Momenta, panic); - parse_diagnostic (Gauge, panic) - | Arguments, panic -> - diagnose_arguments := if panic then Panic else Warn - | Helicities, panic -> - diagnose_helicities := if panic then Panic else Warn - | Momenta, panic -> - diagnose_momenta := if panic then Panic else Warn - | Gauge, panic -> - diagnose_gauge := if panic then Panic else Warn - -(* If diagnostics are required, we have to switch off - Fortran95 features like pure functions. *) - - let parse_diagnostics = function - | [] -> () - | diagnostics -> - fortran95 := false; - List.iter parse_diagnostic diagnostics - -(* \thocwmodulesubsection{Amplitude} *) - - let declare_wavefunctions wfs = - let wfs' = classify_wfs wfs in - declare_list ("complex(kind=" ^ !kind ^ ")") - (wfs'.scalars @ wfs'.brs_scalars); - declare_list ("type(" ^ Fermions.psi_type ^ ")") - (wfs'.spinors @ wfs'.brs_spinors); - declare_list ("type(" ^ Fermions.psibar_type ^ ")") - (wfs'.conjspinors @ wfs'.brs_conjspinors); - declare_list ("type(" ^ Fermions.chi_type ^ ")") - (wfs'.realspinors @ wfs'.brs_realspinors @ wfs'.ghostspinors); - declare_list ("type(" ^ Fermions.grav_type ^ ")") wfs'.vectorspinors; - declare_list "type(vector)" (wfs'.vectors @ wfs'.massive_vectors @ - wfs'.brs_vectors @ wfs'.brs_massive_vectors); - declare_list "type(tensor2odd)" wfs'.tensors_1; - declare_list "type(tensor)" wfs'.tensors_2 - - let print_declarations amplitude = - declare_wavefunctions (F.externals amplitude); - declare_wavefunctions (F.variables amplitude); - match - PSet.elements - (List.fold_left (fun seen wf -> PSet.add (F.momentum_list wf) seen) - PSet.empty (F.variables amplitude)) with - | [] -> () - | momenta -> - printf " @[<2>type(momentum) :: "; - print_list (List.map format_momentum momenta); nl () - -(* [print_current] is the most important function that has to match the functions - in \verb+omega95+ (see appendix~\ref{sec:fortran}). It offers plentiful - opportunities for making mistakes, in particular those related to signs. - We start with a few auxiliary functions: *) - - let children2 rhs = - match F.children rhs with - | [wf1; wf2] -> (wf1, wf2) - | _ -> failwith "Targets.children2: can't happen" - - let children3 rhs = - match F.children rhs with - | [wf1; wf2; wf3] -> (wf1, wf2, wf3) - | _ -> invalid_arg "Targets.children3: can't happen" - -(* Note that it is (marginally) faster to multiply the two scalar products - with the coupling constant than the four vector components. - \begin{dubious} - This could be part of \verb+omegalib+ as well \ldots - \end{dubious} *) - - let format_coeff = function - | 1 -> "" - | -1 -> "-" - | coeff -> "(" ^ string_of_int coeff ^ ")*" - - let format_coupling coeff c = - match coeff with - | 1 -> c - | -1 -> "(-" ^ c ^")" - | coeff -> string_of_int coeff ^ "*" ^ c - -(* \begin{dubious} - The following is error prone and should be generated automagically. - \end{dubious} *) - - let print_vector4 c wf1 wf2 wf3 fusion (coeff, contraction) = - match contraction, fusion with - | C_12_34, (F341|F431|F342|F432|F123|F213|F124|F214) - | C_13_42, (F241|F421|F243|F423|F132|F312|F134|F314) - | C_14_23, (F231|F321|F234|F324|F142|F412|F143|F413) -> - printf "((%s%s)*(%s*%s))*%s" (format_coeff coeff) c wf1 wf2 wf3 - | C_12_34, (F134|F143|F234|F243|F312|F321|F412|F421) - | C_13_42, (F124|F142|F324|F342|F213|F231|F413|F431) - | C_14_23, (F123|F132|F423|F432|F214|F241|F314|F341) -> - printf "((%s%s)*(%s*%s))*%s" (format_coeff coeff) c wf2 wf3 wf1 - | C_12_34, (F314|F413|F324|F423|F132|F231|F142|F241) - | C_13_42, (F214|F412|F234|F432|F123|F321|F143|F341) - | C_14_23, (F213|F312|F243|F342|F124|F421|F134|F431) -> - printf "((%s%s)*(%s*%s))*%s" (format_coeff coeff) c wf1 wf3 wf2 - - let print_add_vector4 c wf1 wf2 wf3 fusion (coeff, contraction) = - printf "@ + "; - print_vector4 c wf1 wf2 wf3 fusion (coeff, contraction) - - let print_vector4_km c pa pb wf1 wf2 wf3 fusion (coeff, contraction) = - match contraction, fusion with - | C_12_34, (F341|F431|F342|F432|F123|F213|F124|F214) - | C_13_42, (F241|F421|F243|F423|F132|F312|F134|F314) - | C_14_23, (F231|F321|F234|F324|F142|F412|F143|F413) -> - printf "((%s%s%s+%s))*(%s*%s))*%s" - (format_coeff coeff) c pa pb wf1 wf2 wf3 - | C_12_34, (F134|F143|F234|F243|F312|F321|F412|F421) - | C_13_42, (F124|F142|F324|F342|F213|F231|F413|F431) - | C_14_23, (F123|F132|F423|F432|F214|F241|F314|F341) -> - printf "((%s%s%s+%s))*(%s*%s))*%s" - (format_coeff coeff) c pa pb wf2 wf3 wf1 - | C_12_34, (F314|F413|F324|F423|F132|F231|F142|F241) - | C_13_42, (F214|F412|F234|F432|F123|F321|F143|F341) - | C_14_23, (F213|F312|F243|F342|F124|F421|F134|F431) -> - printf "((%s%s%s+%s))*(%s*%s))*%s" - (format_coeff coeff) c pa pb wf1 wf3 wf2 - - let print_add_vector4_km c pa pb wf1 wf2 wf3 fusion (coeff, contraction) = - printf "@ + "; - print_vector4_km c pa pb wf1 wf2 wf3 fusion (coeff, contraction) - - let print_dscalar4 c wf1 wf2 wf3 p1 p2 p3 p123 - fusion (coeff, contraction) = - match contraction, fusion with - | C_12_34, (F341|F431|F342|F432|F123|F213|F124|F214) - | C_13_42, (F241|F421|F243|F423|F132|F312|F134|F314) - | C_14_23, (F231|F321|F234|F324|F142|F412|F143|F413) -> - printf "((%s%s)*(%s*%s)*(%s*%s)*%s*%s*%s)" - (format_coeff coeff) c p1 p2 p3 p123 wf1 wf2 wf3 - | C_12_34, (F134|F143|F234|F243|F312|F321|F412|F421) - | C_13_42, (F124|F142|F324|F342|F213|F231|F413|F431) - | C_14_23, (F123|F132|F423|F432|F214|F241|F314|F341) -> - printf "((%s%s)*(%s*%s)*(%s*%s)*%s*%s*%s)" - (format_coeff coeff) c p2 p3 p1 p123 wf1 wf2 wf3 - | C_12_34, (F314|F413|F324|F423|F132|F231|F142|F241) - | C_13_42, (F214|F412|F234|F432|F123|F321|F143|F341) - | C_14_23, (F213|F312|F243|F342|F124|F421|F134|F431) -> - printf "((%s%s)*(%s*%s)*(%s*%s)*%s*%s*%s)" - (format_coeff coeff) c p1 p3 p2 p123 wf1 wf2 wf3 - - let print_add_dscalar4 c wf1 wf2 wf3 p1 p2 p3 p123 - fusion (coeff, contraction) = - printf "@ + "; - print_dscalar4 c wf1 wf2 wf3 p1 p2 p3 p123 fusion (coeff, contraction) - - let print_dscalar2_vector2 c wf1 wf2 wf3 p1 p2 p3 p123 - fusion (coeff, contraction) = - failwith "Targets.Fortran.print_dscalar2_vector2: incomplete!"; - match contraction, fusion with - | C_12_34, (F134|F143|F234|F243) -> - printf "((%s%s)*(%s*%s)*(%s*%s)*%s)" - (format_coeff coeff) c p123 p1 wf2 wf3 wf1 - | C_12_34, (F312|F321|F412|F421) -> - printf "((%s%s)*((%s*%s)*%s*%s)*%s)" - (format_coeff coeff) c p2 p3 wf2 wf3 wf1 - | C_12_34, (F341|F431|F342|F432|F123|F213|F124|F214) - | C_13_42, (F241|F421|F243|F423|F132|F312|F134|F314) - | C_14_23, (F231|F321|F234|F324|F142|F412|F143|F413) -> - printf "((%s%s)*(%s*%s)*(%s*%s)*%s*%s*%s)" - (format_coeff coeff) c p1 p2 p3 p123 wf1 wf2 wf3 - | C_13_42, (F124|F142|F324|F342|F213|F231|F413|F431) - | C_14_23, (F123|F132|F423|F432|F214|F241|F314|F341) -> - printf "((%s%s)*(%s*%s)*(%s*%s)*%s*%s*%s)" - (format_coeff coeff) c p2 p3 p1 p123 wf1 wf2 wf3 - | C_12_34, (F314|F413|F324|F423|F132|F231|F142|F241) - | C_13_42, (F214|F412|F234|F432|F123|F321|F143|F341) - | C_14_23, (F213|F312|F243|F342|F124|F421|F134|F431) -> - printf "((%s%s)*(%s*%s)*(%s*%s)*%s*%s*%s)" - (format_coeff coeff) c p1 p3 p2 p123 wf1 wf2 wf3 - - let print_add_dscalar2_vector2 c wf1 wf2 wf3 p1 p2 p3 p123 - fusion (coeff, contraction) = - printf "@ + "; - print_dscalar2_vector2 c wf1 wf2 wf3 p1 p2 p3 p123 - fusion (coeff, contraction) - - let print_current rhs = - match F.coupling rhs with - | V3 (vertex, fusion, constant) -> - let ch1, ch2 = children2 rhs in - let wf1 = variable ch1 - and wf2 = variable ch2 - and p1 = momentum ch1 - and p2 = momentum ch2 - and m1 = CM.mass_symbol (F.flavor ch1) - and m2 = CM.mass_symbol (F.flavor ch2) in - let c = CM.constant_symbol constant in - printf "@, %s " (if (F.sign rhs) < 0 then "-" else "+"); - begin match vertex with - -(* Fermionic currents $\bar\psi\fmslash{A}\psi$ and $\bar\psi\phi\psi$ - are handled by the [Fermions] module, since they depend on the - choice of Feynman rules: Dirac or Majorana. *) - - | FBF (coeff, fb, b, f) -> - Fermions.print_current (coeff, fb, b, f) c wf1 wf2 fusion - | PBP (coeff, f1, b, f2) -> - Fermions.print_current_p (coeff, f1, b, f2) c wf1 wf2 fusion - | BBB (coeff, fb1, b, fb2) -> - Fermions.print_current_b (coeff, fb1, b, fb2) c wf1 wf2 fusion - | GBG (coeff, fb, b, f) -> let p12 = - Printf.sprintf "(-%s-%s)" p1 p2 in - Fermions.print_current_g (coeff, fb, b, f) c wf1 wf2 p1 p2 - p12 fusion - -(* Table~\ref{tab:dim4-bosons} is a bit misleading, since if includes - totally antisymmetric structure constants. The space-time part alone - is also totally antisymmetric: *) - - | Gauge_Gauge_Gauge coeff -> - let c = format_coupling coeff c in - begin match fusion with - | (F23|F31|F12) -> - printf "g_gg(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 - | (F32|F13|F21) -> - printf "g_gg(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 - end - -(* In [Aux_Gauge_Gauge], we can not rely on antisymmetry alone, because of the - different Lorentz representations of the auxialiary and the gauge field. - Instead we have to provide the sign in - \begin{equation} - (V_2 \wedge V_3) \cdot T_1 = - \begin{cases} - V_2 \cdot (T_1 \cdot V_3) = - V_2 \cdot (V_3 \cdot T_1) & \\ - V_3 \cdot (V_2 \cdot T_1) = - V_3 \cdot (T_1 \cdot V_2) & - \end{cases} - \end{equation} - ourselves. Alternatively, one could provide \verb+g_xg+ mirroring - \verb+g_gx+. *) - - | Aux_Gauge_Gauge coeff -> - let c = format_coupling coeff c in - begin match fusion with - | F23 -> printf "x_gg(%s,%s,%s)" c wf1 wf2 - | F32 -> printf "x_gg(%s,%s,%s)" c wf2 wf1 - | F12 -> printf "g_gx(%s,%s,%s)" c wf2 wf1 - | F21 -> printf "g_gx(%s,%s,%s)" c wf1 wf2 - | F13 -> printf "(-1)*g_gx(%s,%s,%s)" c wf2 wf1 - | F31 -> printf "(-1)*g_gx(%s,%s,%s)" c wf1 wf2 - end - -(* These cases are symmetric and we just have to juxtapose the correct fields - and provide parentheses to minimize the number of multiplications. *) - - | Scalar_Vector_Vector coeff -> - let c = format_coupling coeff c in - begin match fusion with - | (F23|F32) -> printf "%s*(%s*%s)" c wf1 wf2 - | (F12|F13) -> printf "(%s*%s)*%s" c wf1 wf2 - | (F21|F31) -> printf "(%s*%s)*%s" c wf2 wf1 - end - - | Aux_Vector_Vector coeff -> - let c = format_coupling coeff c in - begin match fusion with - | (F23|F32) -> printf "%s*(%s*%s)" c wf1 wf2 - | (F12|F13) -> printf "(%s*%s)*%s" c wf1 wf2 - | (F21|F31) -> printf "(%s*%s)*%s" c wf2 wf1 - end - -(* Even simpler: *) - - | Scalar_Scalar_Scalar coeff -> - printf "(%s*%s*%s)" (format_coupling coeff c) wf1 wf2 - - | Aux_Scalar_Scalar coeff -> - printf "(%s*%s*%s)" (format_coupling coeff c) wf1 wf2 - - | Aux_Scalar_Vector coeff -> - let c = format_coupling coeff c in - begin match fusion with - | (F13|F31) -> printf "%s*(%s*%s)" c wf1 wf2 - | (F23|F21) -> printf "(%s*%s)*%s" c wf1 wf2 - | (F32|F12) -> printf "(%s*%s)*%s" c wf2 wf1 - end - - | Vector_Scalar_Scalar coeff -> - let c = format_coupling coeff c in - begin match fusion with - | F23 -> printf "v_ss(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 - | F32 -> printf "v_ss(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 - | F12 -> printf "s_vs(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 - | F21 -> printf "s_vs(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 - | F13 -> printf "(-1)*s_vs(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 - | F31 -> printf "(-1)*s_vs(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 - end - - | Graviton_Scalar_Scalar coeff -> - let c = format_coupling coeff c in - begin match fusion with - | F12 -> printf "s_gravs(%s,%s,-(%s+%s),%s,%s,%s)" c m2 p1 p2 p2 wf1 wf2 - | F21 -> printf "s_gravs(%s,%s,-(%s+%s),%s,%s,%s)" c m1 p1 p2 p1 wf2 wf1 - | F13 -> printf "s_gravs(%s,%s,%s,-(%s+%s),%s,%s)" c m2 p2 p1 p2 wf1 wf2 - | F31 -> printf "s_gravs(%s,%s,%s,-(%s+%s),%s,%s)" c m1 p1 p1 p2 wf2 wf1 - | F23 -> printf "grav_ss(%s,%s,%s,%s,%s,%s)" c m1 p1 p2 wf1 wf2 - | F32 -> printf "grav_ss(%s,%s,%s,%s,%s,%s)" c m1 p2 p1 wf2 wf1 - end - -(* In producing a vector in the fusion we always contract the rightmost index with the - vector wavefunction from [rhs]. So the first momentum is always the one of the - vector boson produced in the fusion, while the second one is that from the [rhs]. - This makes the cases [F12] and [F13] as well as [F21] and [F31] equal. In principle, - we could have already done this for the [Graviton_Scalar_Scalar] case. *) - - - | Graviton_Vector_Vector coeff -> - let c = format_coupling coeff c in - begin match fusion with - | (F12|F13) -> printf "v_gravv(%s,%s,-(%s+%s),%s,%s,%s)" c m2 p1 p2 p2 wf1 wf2 - | (F21|F31) -> printf "v_gravv(%s,%s,-(%s+%s),%s,%s,%s)" c m1 p1 p2 p1 wf2 wf1 - | F23 -> printf "grav_vv(%s,%s,%s,%s,%s,%s)" c m1 p1 p2 wf1 wf2 - | F32 -> printf "grav_vv(%s,%s,%s,%s,%s,%s)" c m1 p2 p1 wf2 wf1 - end - - | Graviton_Spinor_Spinor coeff -> - let c = format_coupling coeff c in - begin match fusion with - | F23 -> printf "f_gravf(%s,%s,-(%s+%s),(-%s),%s,%s)" c m2 p1 p2 p2 wf1 wf2 - | F32 -> printf "f_gravf(%s,%s,-(%s+%s),(-%s),%s,%s)" c m1 p1 p2 p1 wf2 wf1 - | F12 -> printf "f_fgrav(%s,%s,%s,%s+%s,%s,%s)" c m1 p1 p1 p2 wf1 wf2 - | F21 -> printf "f_fgrav(%s,%s,%s,%s+%s,%s,%s)" c m2 p2 p1 p2 wf2 wf1 - | F13 -> printf "grav_ff(%s,%s,%s,(-%s),%s,%s)" c m1 p1 p2 wf1 wf2 - | F31 -> printf "grav_ff(%s,%s,%s,(-%s),%s,%s)" c m1 p2 p1 wf2 wf1 - end - - | Dim4_Vector_Vector_Vector_T coeff -> - let c = format_coupling coeff c in - begin match fusion with - | F23 -> printf "tkv_vv(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 - | F32 -> printf "tkv_vv(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 - | F12 -> printf "tv_kvv(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 - | F21 -> printf "tv_kvv(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 - | F13 -> printf "(-1)*tv_kvv(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 - | F31 -> printf "(-1)*tv_kvv(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 - end - - | Dim4_Vector_Vector_Vector_L coeff -> - let c = format_coupling coeff c in - begin match fusion with - | F23 -> printf "lkv_vv(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 - | F32 -> printf "lkv_vv(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 - | F12 | F13 -> printf "lv_kvv(%s,%s,%s,%s)" c wf1 p1 wf2 - | F21 | F31 -> printf "lv_kvv(%s,%s,%s,%s)" c wf2 p2 wf1 - end - - | Dim6_Gauge_Gauge_Gauge coeff -> - let c = format_coupling coeff c in - begin match fusion with - | F23 | F31 | F12 -> - printf "kg_kgkg(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 - | F32 | F13 | F21 -> - printf "kg_kgkg(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 - end - - | Dim4_Vector_Vector_Vector_T5 coeff -> - let c = format_coupling coeff c in - begin match fusion with - | F23 -> printf "t5kv_vv(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 - | F32 -> printf "t5kv_vv(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 - | F12 | F13 -> printf "t5v_kvv(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 - | F21 | F31 -> printf "t5v_kvv(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 - end - - | Dim4_Vector_Vector_Vector_L5 coeff -> - let c = format_coupling coeff c in - begin match fusion with - | F23 -> printf "l5kv_vv(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 - | F32 -> printf "l5kv_vv(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 - | F12 -> printf "l5v_kvv(%s,%s,%s,%s)" c wf1 p1 wf2 - | F21 -> printf "l5v_kvv(%s,%s,%s,%s)" c wf2 p2 wf1 - | F13 -> printf "(-1)*l5v_kvv(%s,%s,%s,%s)" c wf1 p1 wf2 - | F31 -> printf "(-1)*l5v_kvv(%s,%s,%s,%s)" c wf2 p2 wf1 - end - - | Dim6_Gauge_Gauge_Gauge_5 coeff -> - let c = format_coupling coeff c in - begin match fusion with - | F23 -> printf "kg5_kgkg(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 - | F32 -> printf "kg5_kgkg(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 - | F12 -> printf "kg_kg5kg(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 - | F21 -> printf "kg_kg5kg(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 - | F13 -> printf "(-1)*kg_kg5kg(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 - | F31 -> printf "(-1)*kg_kg5kg(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 - end - - | Aux_DScalar_DScalar coeff -> - let c = format_coupling coeff c in - begin match fusion with - | (F23|F32) -> - printf "%s*(%s*%s)*(%s*%s)" c p1 p2 wf1 wf2 - | (F12|F13) -> - printf "%s*(-((%s+%s)*%s))*(%s*%s)" c p1 p2 p2 wf1 wf2 - | (F21|F31) -> - printf "%s*(-((%s+%s)*%s))*(%s*%s)" c p1 p2 p1 wf1 wf2 - end - - | Aux_Vector_DScalar coeff -> - let c = format_coupling coeff c in - begin match fusion with - | F23 -> printf "%s*(%s*%s)*%s" c wf1 p2 wf2 - | F32 -> printf "%s*(%s*%s)*%s" c wf2 p1 wf1 - | F12 -> printf "%s*(-((%s+%s)*%s))*%s" c p1 p2 wf2 wf1 - | F21 -> printf "%s*(-((%s+%s)*%s))*%s" c p1 p2 wf1 wf2 - | (F13|F31) -> printf "(-(%s+%s))*(%s*%s*%s)" p1 p2 c wf1 wf2 - end - - | Dim5_Scalar_Gauge2 coeff -> - let c = format_coupling coeff c in - begin match fusion with - | (F23|F32) -> printf "(%s)*((%s*%s)*(%s*%s) - (%s*%s)*(%s*%s))" - c p1 wf2 p2 wf1 p1 p2 wf2 wf1 - | (F12|F13) -> printf "(%s)*%s*((-((%s+%s)*%s))*%s - ((-(%s+%s)*%s))*%s)" - c wf1 p1 p2 wf2 p2 p1 p2 p2 wf2 - | (F21|F31) -> printf "(%s)*%s*((-((%s+%s)*%s))*%s - ((-(%s+%s)*%s))*%s)" - c wf2 p2 p1 wf1 p1 p1 p2 p1 wf1 - end - - | Dim5_Scalar_Gauge2_Skew coeff -> - let c = format_coupling coeff c in - begin match fusion with - | (F23|F32) -> printf "(- phi_vv (%s, %s, %s, %s, %s))" c p1 p2 wf1 wf2 - | (F12|F13) -> printf "(- v_phiv (%s, %s, %s, %s, %s))" c wf1 p1 p2 wf2 - | (F21|F31) -> printf "v_phiv (%s, %s, %s, %s, %s)" c wf2 p1 p2 wf1 - end - - | Dim5_Scalar_Vector_Vector_T coeff -> - let c = format_coupling coeff c in - begin match fusion with - | (F23|F32) -> printf "(%s)*(%s*%s)*(%s*%s)" c p1 wf2 p2 wf1 - | (F12|F13) -> printf "(%s)*%s*(-((%s+%s)*%s))*%s" c wf1 p1 p2 wf2 p2 - | (F21|F31) -> printf "(%s)*%s*(-((%s+%s)*%s))*%s" c wf2 p2 p1 wf1 p1 - end - - | Dim6_Vector_Vector_Vector_T coeff -> - let c = format_coupling coeff c in - begin match fusion with - | F23 -> printf "(%s)*(%s*%s)*(%s*%s)*(%s-%s)" c p2 wf1 p1 wf2 p1 p2 - | F32 -> printf "(%s)*(%s*%s)*(%s*%s)*(%s-%s)" c p1 wf2 p2 wf1 p2 p1 - | (F12|F13) -> printf "(%s)*((%s+2*%s)*%s)*(-((%s+%s)*%s))*%s" - c p1 p2 wf1 p1 p2 wf2 p2 - | (F21|F31) -> printf "(%s)*((-((%s+%s)*%s))*(%s+2*%s)*%s)*%s" - c p2 p1 wf1 p2 p1 wf2 p1 - end - - | Tensor_2_Vector_Vector coeff -> - let c = format_coupling coeff c in - begin match fusion with - | (F23|F32) -> printf "t2_vv(%s,%s,%s)" c wf1 wf2 - | (F12|F13) -> printf "v_t2v(%s,%s,%s)" c wf1 wf2 - | (F21|F31) -> printf "v_t2v(%s,%s,%s)" c wf2 wf1 - end - - | Dim5_Tensor_2_Vector_Vector_1 coeff -> - let c = format_coupling coeff c in - begin match fusion with - | (F23|F32) -> printf "t2_vv_d5_1(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 - | (F12|F13) -> printf "v_t2v_d5_1(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 - | (F21|F31) -> printf "v_t2v_d5_1(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 - end - - | Dim5_Tensor_2_Vector_Vector_2 coeff -> - let c = format_coupling coeff c in - begin match fusion with - | F23 -> printf "t2_vv_d5_2(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 - | F32 -> printf "t2_vv_d5_2(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 - | (F12|F13) -> printf "v_t2v_d5_2(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 - | (F21|F31) -> printf "v_t2v_d5_2(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 - end - - | Dim7_Tensor_2_Vector_Vector_T coeff -> - let c = format_coupling coeff c in - begin match fusion with - | F23 -> printf "t2_vv_d7(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 - | F32 -> printf "t2_vv_d7(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 - | (F12|F13) -> printf "v_t2v_d7(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 - | (F21|F31) -> printf "v_t2v_d7(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 - end - - end - -(* Flip the sign to account for the~$\mathrm{i}^2$ relative to diagrams - with only cubic couplings. *) - - | V4 (vertex, fusion, constant) -> - let c = CM.constant_symbol constant - and ch1, ch2, ch3 = children3 rhs in - let wf1 = variable ch1 - and wf2 = variable ch2 - and wf3 = variable ch3 - and p1 = momentum ch1 - and p2 = momentum ch2 - and p3 = momentum ch3 in - printf "@, %s " (if (F.sign rhs) < 0 then "+" else "-"); - begin match vertex with - | Scalar4 coeff -> - printf "(%s*%s*%s*%s)" (format_coupling coeff c) wf1 wf2 wf3 - | Scalar2_Vector2 coeff -> - let c = format_coupling coeff c in - begin match fusion with - | F134 | F143 | F234 | F243 -> - printf "%s*%s*(%s*%s)" c wf1 wf2 wf3 - | F314 | F413 | F324 | F423 -> - printf "%s*%s*(%s*%s)" c wf2 wf1 wf3 - | F341 | F431 | F342 | F432 -> - printf "%s*%s*(%s*%s)" c wf3 wf1 wf2 - | F312 | F321 | F412 | F421 -> - printf "(%s*%s*%s)*%s" c wf2 wf3 wf1 - | F231 | F132 | F241 | F142 -> - printf "(%s*%s*%s)*%s" c wf1 wf3 wf2 - | F123 | F213 | F124 | F214 -> - printf "(%s*%s*%s)*%s" c wf1 wf2 wf3 - end - | Vector4 contractions -> - begin match contractions with - | [] -> invalid_arg "Targets.print_current: Vector4 []" - | head :: tail -> - printf "("; - print_vector4 c wf1 wf2 wf3 fusion head; - List.iter (print_add_vector4 c wf1 wf2 wf3 fusion) tail; - printf ")" - end - | Vector4_K_Matrix_tho (disc, poles) -> - let pa, pb = - begin match fusion with - | (F341|F431|F342|F432|F123|F213|F124|F214) -> (p1, p2) - | (F134|F143|F234|F243|F312|F321|F412|F421) -> (p2, p3) - | (F314|F413|F324|F423|F132|F231|F142|F241) -> (p1, p3) - end in - printf "(%s*(%s*%s)*(%s*%s)*(%s*%s)@,*(" - c p1 wf1 p2 wf2 p3 wf3; - List.iter (fun (coeff, pole) -> - printf "+%s/((%s+%s)*(%s+%s)-%s)" - (CM.constant_symbol coeff) pa pb pa pb - (CM.constant_symbol pole)) - poles; - printf ")*(-%s-%s-%s))" p1 p2 p3 - | Vector4_K_Matrix_jr (disc, contractions) -> - let pa, pb = - begin match disc, fusion with - | 3, (F143|F413|F142|F412|F321|F231|F324|F234) -> (p1, p2) - | 3, (F314|F341|F214|F241|F132|F123|F432|F423) -> (p2, p3) - | 3, (F134|F431|F124|F421|F312|F213|F342|F243) -> (p1, p3) - | _, (F341|F431|F342|F432|F123|F213|F124|F214) -> (p1, p2) - | _, (F134|F143|F234|F243|F312|F321|F412|F421) -> (p2, p3) - | _, (F314|F413|F324|F423|F132|F231|F142|F241) -> (p1, p3) - end in - begin match contractions with - | [] -> invalid_arg "Targets.print_current: Vector4_K_Matrix_jr []" - | head :: tail -> - printf "("; - print_vector4_km c pa pb wf1 wf2 wf3 fusion head; - List.iter (print_add_vector4_km c pa pb wf1 wf2 wf3 fusion) - tail; - printf ")" - end - | GBBG (coeff, fb, b, f) -> - Fermions.print_current_g4 (coeff, fb, b, f) c wf1 wf2 wf3 - fusion - -(* \begin{dubious} - In principle, [p4] could be obtained from the left hand side \ldots - \end{dubious} *) - | DScalar4 contractions -> - let p123 = Printf.sprintf "(-%s-%s-%s)" p1 p2 p3 in - begin match contractions with - | [] -> invalid_arg "Targets.print_current: DScalar4 []" - | head :: tail -> - printf "("; - print_dscalar4 c wf1 wf2 wf3 p1 p2 p3 p123 fusion head; - List.iter (print_add_dscalar4 - c wf1 wf2 wf3 p1 p2 p3 p123 fusion) tail; - printf ")" - end - - | DScalar2_Vector2 contractions -> - let p123 = Printf.sprintf "(-%s-%s-%s)" p1 p2 p3 in - begin match contractions with - | [] -> invalid_arg "Targets.print_current: DScalar4 []" - | head :: tail -> - printf "("; - print_dscalar2_vector2 - c wf1 wf2 wf3 p1 p2 p3 p123 fusion head; - List.iter (print_add_dscalar2_vector2 - c wf1 wf2 wf3 p1 p2 p3 p123 fusion) tail; - printf ")" - end - end - - | Vn (_, _, _) -> - invalid_arg "Targets.print_current: n-ary fusion" - - let print_propagator f p m gamma = - let minus_third = "(-1.0_" ^ !kind ^ "/3.0_" ^ !kind ^ ")" in - let w = - begin match CM.width f with - | Vanishing | Fudged -> "0.0_" ^ !kind - | Constant -> gamma - | Timelike -> "wd_tl(" ^ p ^ "," ^ gamma ^ ")" - | Running -> - failwith "Targets.Fortran: running width not yet available" - | Custom f -> f ^ "(" ^ p ^ "," ^ gamma ^ ")" - end in - match CM.propagator f with - | Prop_Scalar -> - printf "pr_phi(%s,%s,%s," p m w - | Prop_Col_Scalar -> - printf "%s * pr_phi(%s,%s,%s," minus_third p m w - | Prop_Ghost -> printf "(0,1) * pr_phi(%s, %s, %s," p m w - | Prop_Spinor -> - printf "%s(%s,%s,%s," Fermions.psi_propagator p m w - | Prop_ConjSpinor -> - printf "%s(%s,%s,%s," Fermions.psibar_propagator p m w - | Prop_Majorana -> - printf "%s(%s,%s,%s," Fermions.chi_propagator p m w - | Prop_Col_Majorana -> - printf "%s * %s(%s,%s,%s," minus_third Fermions.chi_propagator p m w - | Prop_Unitarity -> - printf "pr_unitarity(%s,%s,%s," p m w - | Prop_Col_Unitarity -> - printf "%s * pr_unitarity(%s,%s,%s," minus_third p m w - | Prop_Feynman -> - printf "pr_feynman(%s," p - | Prop_Col_Feynman -> - printf "%s * pr_feynman(%s," minus_third p - | Prop_Gauge xi -> - printf "pr_gauge(%s,%s," p (CM.gauge_symbol xi) - | Prop_Rxi xi -> - printf "pr_rxi(%s,%s,%s,%s," p m w (CM.gauge_symbol xi) - | Prop_Tensor_2 -> - printf "pr_tensor(%s,%s,%s," p m w - | Prop_Vectorspinor -> - printf "pr_grav(%s,%s,%s," p m w - | Aux_Scalar | Aux_Spinor | Aux_ConjSpinor | Aux_Majorana - | Aux_Vector | Aux_Tensor_1 -> printf "(" - | Only_Insertion -> printf "(" - - let print_projector f p m gamma = - let minus_third = "(-1.0_" ^ !kind ^ "/3.0_" ^ !kind ^ ")" in - match CM.propagator f with - | Prop_Scalar -> - printf "pj_phi(%s,%s," m gamma - | Prop_Col_Scalar -> - printf "%s * pj_phi(%s,%s," minus_third m gamma - | Prop_Ghost -> - printf "(0,1) * pj_phi(%s,%s," m gamma - | Prop_Spinor -> - printf "%s(%s,%s,%s," Fermions.psi_projector p m gamma - | Prop_ConjSpinor -> - printf "%s(%s,%s,%s," Fermions.psibar_projector p m gamma - | Prop_Majorana -> - printf "%s(%s,%s,%s," Fermions.chi_projector p m gamma - | Prop_Col_Majorana -> - printf "%s * %s(%s,%s,%s," minus_third Fermions.chi_projector p m gamma - | Prop_Unitarity -> - printf "pj_unitarity(%s,%s,%s," p m gamma - | Prop_Col_Unitarity -> - printf "%s * pj_unitarity(%s,%s,%s," minus_third p m gamma - | Prop_Feynman | Prop_Col_Feynman -> - invalid_arg "no on-shell Feynman propagator!" - | Prop_Gauge xi -> - invalid_arg "no on-shell massless gauge propagator!" - | Prop_Rxi xi -> - invalid_arg "no on-shell Rxi propagator!" - | Prop_Vectorspinor -> - printf "pj_grav(%s,%s,%s," p m gamma - | Prop_Tensor_2 -> - printf "pj_tensor(%s,%s,%s," p m gamma - | Aux_Scalar | Aux_Spinor | Aux_ConjSpinor | Aux_Majorana - | Aux_Vector | Aux_Tensor_1 -> printf "(" - | Only_Insertion -> printf "(" - - let print_gauss f p m gamma = - let minus_third = "(-1.0_" ^ !kind ^ "/3.0_" ^ !kind ^ ")" in - match CM.propagator f with - | Prop_Scalar -> - printf "pg_phi(%s,%s,%s," p m gamma - | Prop_Ghost -> - printf "(0,1) * pg_phi(%s,%s,%s," p m gamma - | Prop_Spinor -> - printf "%s(%s,%s,%s," Fermions.psi_projector p m gamma - | Prop_ConjSpinor -> - printf "%s(%s,%s,%s," Fermions.psibar_projector p m gamma - | Prop_Majorana -> - printf "%s(%s,%s,%s," Fermions.chi_projector p m gamma - | Prop_Col_Majorana -> - printf "%s * %s(%s,%s,%s," minus_third Fermions.chi_projector p m gamma - | Prop_Unitarity -> - printf "pg_unitarity(%s,%s,%s," p m gamma - | Prop_Feynman | Prop_Col_Feynman -> - invalid_arg "no on-shell Feynman propagator!" - | Prop_Gauge xi -> - invalid_arg "no on-shell massless gauge propagator!" - | Prop_Rxi xi -> - invalid_arg "no on-shell Rxi propagator!" - | Prop_Tensor_2 -> - printf "pg_tensor(%s,%s,%s," p m gamma - | Aux_Scalar | Aux_Spinor | Aux_ConjSpinor | Aux_Majorana - | Aux_Vector | Aux_Tensor_1 -> printf "(" - | Only_Insertion -> printf "(" - | _ -> invalid_arg "targets:print_gauss: not available" - - let print_fusion_diagnostics fusion = - if warn diagnose_gauge then begin - let lhs = F.lhs fusion in - let f = F.flavor lhs - and v = variable lhs - and p = momentum lhs in - let mass = CM.mass_symbol f in - match CM.propagator f with - | Prop_Gauge _ | Prop_Feynman - | Prop_Rxi _ | Prop_Unitarity -> - printf " @[<2>%s =" v; - List.iter print_current (F.rhs fusion); nl(); - begin match CM.goldstone f with - | None -> - printf " call omega_ward_%s(\"%s\",%s,%s,%s)" - (suffix diagnose_gauge) v mass p v; nl () - | Some (g, phase) -> - let gv = add_tag lhs (CM.flavor_symbol g ^ "_" ^ format_p lhs) in - printf " call omega_slavnov_%s" - (suffix diagnose_gauge); - printf "(@[\"%s\",%s,%s,%s,@,%s*%s)" - v mass p v (format_constant phase) gv; nl () - end - | _ -> () - end - - let print_fusion amplitude fusion = - let lhs = F.lhs fusion in - let f = F.flavor lhs in - printf " @[<2>%s = " (variable lhs); - if F.on_shell amplitude lhs then - print_projector f (momentum lhs) - (CM.mass_symbol f) (CM.width_symbol f) - else - if F.is_gauss amplitude lhs then - print_gauss f (momentum lhs) - (CM.mass_symbol f) (CM.width_symbol f) - else - print_propagator f (momentum lhs) - (CM.mass_symbol f) (CM.width_symbol f); - List.iter print_current (F.rhs fusion); - printf ")"; nl () - - let print_fusions amplitude = - let momenta = - List.fold_left (fun seen f -> - let wf = F.lhs f in - let p = F.momentum_list wf in - if not (PSet.mem p seen) then begin - let rhs1 = List.hd (F.rhs f) in - printf " %s = %s" (momentum wf) - (String.concat " + " - (List.map momentum (F.children rhs1))); nl () - end; - print_fusion_diagnostics f; - print_fusion amplitude f; - PSet.add p seen) PSet.empty (F.fusions amplitude) - in - () - - let print_braket name braket = - let bra = F.bra braket - and ket = F.ket braket in - printf " @[<2>%s = %s + " name name; - begin match Fermions.reverse_braket (CM.lorentz (F.flavor bra)) with - | false -> - printf "%s*(@," (variable bra); - List.iter print_current ket; - printf ")" - | true -> - printf "(@,"; - List.iter print_current ket; - printf ")*%s" (variable bra) - end; nl () - -(* \begin{equation} - \ii T = \ii^{\#\text{vertices}}\ii^{\#\text{propagators}} \cdots - = \ii^{n-2}\ii^{n-3} \cdots - = -\ii(-1)^n \cdots - \end{equation} *) - - let print_brakets name amplitude = - printf " %s = 0" name; nl (); - List.iter (print_braket name) (F.brakets amplitude); - let n = List.length (F.externals amplitude) in - if n mod 2 = 0 then begin - printf " %s = - %s ! %d vertices, %d propagators" - name name (n - 2) (n - 3); nl () - end else begin - printf " ! %s = %s ! %d vertices, %d propagators" - name name (n - 2) (n - 3); nl () - end; - let s = F.symmetry amplitude in - if s > 1 then - printf " %s = %s / sqrt(%d.0_%s) ! symmetry factor" name name s !kind - else - printf " ! unit symmetry factor"; - nl () - - let print_incoming wf = - let p = momentum wf - and s = spin wf - and f = F.flavor wf in - let m = CM.mass_symbol f in - match CM.lorentz f with - | Scalar -> printf "1" - | BRS Scalar -> printf "(0,-1) * (%s * %s - %s**2)" p p m - | Spinor -> - printf "%s (%s, - %s, %s)" Fermions.psi_incoming m p s - | BRS Spinor -> - printf "%s (%s, - %s, %s)" Fermions.brs_psi_incoming m p s - | ConjSpinor -> - printf "%s (%s, - %s, %s)" Fermions.psibar_incoming m p s - | BRS ConjSpinor -> - printf "%s (%s, - %s, %s)" Fermions.brs_psibar_incoming m p s - | Majorana -> - printf "%s (%s, - %s, %s)" Fermions.chi_incoming m p s - | Maj_Ghost -> printf "ghost (%s, - %s, %s)" m p s - | BRS Majorana -> - printf "%s (%s, - %s, %s)" Fermions.brs_chi_incoming m p s - | Vector | Massive_Vector -> - printf "eps (%s, - %s, %s)" m p s - | BRS Vector | BRS Massive_Vector -> printf - "(0,1) * (%s * %s - %s**2) * eps (%s, -%s, %s)" p p m m p s - | Vectorspinor | BRS Vectorspinor -> - printf "%s (%s, - %s, %s)" Fermions.grav_incoming m p s - | Tensor_1 -> invalid_arg "Tensor_1 only internal" - | Tensor_2 -> printf "eps2 (%s, - %s, %s)" m p s - | _ -> invalid_arg "no such BRST transformations" - - let print_outgoing wf = - let p = momentum wf - and s = spin wf - and f = F.flavor wf in - let m = CM.mass_symbol f in - match CM.lorentz f with - | Scalar -> printf "1" - | BRS Scalar -> printf "(0,-1) * (%s * %s - %s**2)" p p m - | Spinor -> - printf "%s (%s, %s, %s)" Fermions.psi_outgoing m p s - | BRS Spinor -> - printf "%s (%s, %s, %s)" Fermions.brs_psi_outgoing m p s - | ConjSpinor -> - printf "%s (%s, %s, %s)" Fermions.psibar_outgoing m p s - | BRS ConjSpinor -> - printf "%s (%s, %s, %s)" Fermions.brs_psibar_outgoing m p s - | Majorana -> - printf "%s (%s, %s, %s)" Fermions.chi_outgoing m p s - | BRS Majorana -> - printf "%s (%s, %s, %s)" Fermions.brs_chi_outgoing m p s - | Maj_Ghost -> printf "ghost (%s, %s, %s)" m p s - | Vector | Massive_Vector -> - printf "conjg (eps (%s, %s, %s))" m p s - | BRS Vector | BRS Massive_Vector -> printf - "(0,1) * (%s*%s-%s**2) * (conjg (eps (%s, %s, %s)))" p p m m p s - | Vectorspinor | BRS Vectorspinor -> - printf "%s (%s, %s, %s)" Fermions.grav_incoming m p s - | Tensor_1 -> invalid_arg "Tensor_1 only internal" - | Tensor_2 -> printf "conjg (eps2 (%s, %s, %s))" m p s - | BRS _ -> invalid_arg "no such BRST transformations" - - let twice_spin wf = - match CM.lorentz (F.flavor wf) with - | Scalar | BRS Scalar -> "0" - | Spinor | ConjSpinor | Majorana | Maj_Ghost | Vectorspinor - | BRS Spinor | BRS ConjSpinor | BRS Majorana | BRS Vectorspinor -> "1" - | Vector | BRS Vector | Massive_Vector | BRS Massive_Vector -> "2" - | Tensor_1 -> "2" - | Tensor_2 -> "4" - | BRS _ -> invalid_arg "Targets.twice_spin: no such BRST transformation" - - let print_argument_diagnostics amplitude = - let externals = (F.externals amplitude) in - let n = List.length externals - and masses = - List.map (fun wf -> CM.mass_symbol (F.flavor wf)) externals - and spins = List.map twice_spin externals in - if warn diagnose_arguments then begin - printf " call omega_check_arguments_%s (%d, k, s)" - (suffix diagnose_arguments) n; nl () - end; - if warn diagnose_helicities then begin - printf " @[<2>call omega_check_helicities_%s ((/ " - (suffix diagnose_helicities); - print_list masses; - printf " /), (/ "; - print_list spins; - printf " /), s)"; nl () - end; - if warn diagnose_momenta then begin - printf " @[<2>call omega_check_momenta_%s ((/ " - (suffix diagnose_momenta); - print_list masses; - printf " /), k)"; nl () - end - - let print_externals amplitude = - let externals = - List.combine - (F.externals amplitude) - (List.map (fun _ -> true) (F.incoming amplitude) @ - List.map (fun _ -> false) (F.outgoing amplitude)) in - List.iter (fun (wf, incoming) -> - if incoming then - printf " %s = - k(:,%d) ! incoming %s" - (momentum wf) (ext_momentum wf) - (CM.flavor_to_string (F.flavor wf)) - else - printf " %s = k(:,%d) ! outgoing %s" - (momentum wf) (ext_momentum wf) - (CM.flavor_to_string (CM.conjugate (F.flavor wf))); nl ()) externals; - List.iter (fun (wf, incoming) -> - printf " %s = " (variable wf); - (if incoming then print_incoming else print_outgoing) wf; nl ()) externals - - let flavors_symbol flavors = - String.concat "" (List.map CM.flavor_symbol flavors) - - let flavors_to_string flavors = - String.concat " " (List.map CM.flavor_to_string flavors) - - let process_to_string amplitude = - flavors_to_string (F.incoming amplitude) ^ " -> " ^ - flavors_to_string (F.outgoing amplitude) - - let flavors_sans_color_to_string flavors = - String.concat " " (List.map CM.M.flavor_to_string flavors) - - let process_sans_color_to_string (fin, fout) = - flavors_sans_color_to_string fin ^ " -> " ^ - flavors_sans_color_to_string fout - - let flavors a = F.incoming a @ F.outgoing a - - let print_function_header amplitude = - let externals = F.externals amplitude in - printf " ! process: %s" (process_to_string amplitude); nl(); - printf " "; if !fortran95 then printf "pure "; - printf "@[<2>function %s (k, s) result (amp)" - (flavors_symbol (flavors amplitude)); nl (); - printf " @[<2>real(kind=%s), dimension(0:,:), intent(in) :: k" - !kind; nl (); - printf " @[<2>integer, dimension(:), intent(in) :: s"; nl (); - printf " complex(kind=%s) :: amp" !kind; nl (); - printf " @[<2>type(momentum) :: "; - print_list (List.map momentum externals); nl () - - let print_function_footer amplitude = - printf " end function %s" (flavors_symbol (flavors amplitude)); nl () - - let print_fudge_factor name amplitude = - List.iter (fun wf -> - let p = momentum wf - and f = F.flavor wf in - match CM.width f with - | Fudged -> - let m = CM.mass_symbol f - and w = CM.width_symbol f in - printf " if (%s > 0.0_%s) then" w !kind; nl (); - printf " @[<2>%s = %s@ * (%s*%s - %s**2)" - name name p p m; - printf "@ / cmplx (%s*%s - %s**2, %s*%s, kind=%s)" - p p m m w !kind; nl(); - printf " end if"; nl () - | _ -> ()) (F.s_channel amplitude) - - let print_one_amplitude amplitude = - print_function_header amplitude; - print_declarations amplitude; - print_argument_diagnostics amplitude; - print_externals amplitude; - print_fusions amplitude; - print_brakets "amp" amplitude; - print_fudge_factor "amp" amplitude; - print_function_footer amplitude; - nl () - - let fill_one_table_entry flavor color amplitude = - printf " amp(%d,h,%d) = %s (k, s)" - color flavor (flavors_symbol (flavors amplitude)); - nl () - - let print_amplitudes amplitudes = - List.iter (List.iter print_one_amplitude) (CF.processes amplitudes); - nl (); - printf " @[<5>"; if !fortran95 then printf "pure "; - printf "subroutine calculate_amplitudes (amp, k)"; nl (); - printf " complex(kind=default), dimension(:,:,:), intent(out) :: amp"; nl (); - printf " real(kind=default), dimension(0:,:), intent(in) :: k"; nl (); - printf " integer, dimension(n_prt) :: s"; nl (); - printf " integer :: h"; nl (); - printf " do h = 1, n_hel"; nl (); - printf " s = table_spin_states(:,h)"; nl (); - ThoList.iteri2 fill_one_table_entry 1 1 (CF.processes amplitudes); - printf " end do"; nl (); - printf " end subroutine calculate_amplitudes"; nl (); - nl () - -(* \thocwmodulesubsection{Spin, Flavor \&\ Color Tables} *) - -(* The following abomination is required to keep the number of continuation - lines as low as possible. FORTRAN77-style \texttt{DATA} statements - are actually a bit nicer here, but they are nor available for - \emph{constant} arrays. *) - -(* \begin{dubious} - We used to have a more elegent design with a sentinel~0 added to each - initializer, but some revisions of the Compaq/Digital Compiler have a - bug that causes it to reject this variant. - \end{dubious} *) - -(* \begin{dubious} - The actual table writing code using \texttt{reshape} should be factored, - since it's thrice the same algorithm. - \end{dubious} *) - - let print_integer_parameter name value = - printf " @[<2>integer, parameter, private :: %s = %d" name value; nl () - - let print_logical_parameter name value = - printf " @[<2>logical, parameter, private :: %s = .%s." - name (if value then "true" else "false"); nl () - - let num_particles_in amplitudes = - match CF.flavors amplitudes with - | [] -> 0 - | (fin, _) :: _ -> List.length fin - - let num_particles_out amplitudes = - match CF.flavors amplitudes with - | [] -> 0 - | (_, fout) :: _ -> List.length fout - - let num_particles amplitudes = - match CF.flavors amplitudes with - | [] -> 0 - | (fin, fout) :: _ -> List.length fin + List.length fout - - module CFlow = Color.Flow - - let num_color_flows cflows = - List.length cflows - - let num_color_indices_default = 2 (* Standard model *) - - let num_color_indices cflows = - try CFlow.rank (List.hd cflows) with _ -> num_color_indices_default - - let color_to_string c = - "(" ^ (String.concat "," (List.map (Printf.sprintf "%3d") c)) ^ ")" - - let cflow_to_string cflow = - String.concat " " (List.map color_to_string (CFlow.in_to_lists cflow)) ^ " -> " ^ - String.concat " " (List.map color_to_string (CFlow.out_to_lists cflow)) - - let print_spin_table abbrev name = function - | [] -> - printf " @[<2>integer, dimension(n_prt,0), private ::"; - printf "@ table_spin_%s" name; nl () - | _ :: tuples' as tuples -> - ignore (List.fold_left (fun i (tuple1, tuple2) -> - printf " @[<2>integer, dimension(n_prt), parameter, private ::"; - printf "@ %s%04d = (/ %s /)" abbrev i - (String.concat ", " (List.map (Printf.sprintf "%2d") (tuple1 @ tuple2))); - nl (); succ i) 1 tuples); - printf - " @[<2>integer, dimension(n_prt,n_hel), parameter, private ::"; - printf "@ table_spin_%s =@ reshape ( (/" name; - printf "@ %s%04d" abbrev 1; - ignore (List.fold_left (fun i tuple -> - printf ",@ %s%04d" abbrev i; succ i) 2 tuples'); - printf "@ /), (/ n_prt, n_hel /) )"; nl () - - let print_spin_tables amplitudes = - print_spin_table "s" "states" (CF.helicities amplitudes); - nl () - - let num_helicities amplitudes = - List.length (CF.helicities amplitudes) - - let print_flavor_table n abbrev name = function - | [] -> - printf " @[<2>integer, dimension(n_prt,0), private ::"; - printf "@ table_flavor_%s" name; nl () - | _ :: tuples' as tuples -> - ignore (List.fold_left (fun i tuple -> - printf - " @[<2>integer, dimension(n_prt), parameter, private ::"; - printf "@ %s%04d = (/ %s /) ! %s" abbrev i - (String.concat ", " - (List.map (fun f -> Printf.sprintf "%3d" (CM.M.pdg f)) tuple)) - (String.concat " " (List.map CM.M.flavor_to_string tuple)); - nl (); succ i) 1 tuples); - printf - " @[<2>integer, dimension(n_prt,n_flv), parameter, private ::"; - printf "@ table_flavor_%s =@ reshape ( (/" name; - printf "@ %s%04d" abbrev 1; - ignore (List.fold_left (fun i tuple -> - printf ",@ %s%04d" abbrev i; succ i) 2 tuples'); - printf "@ /), (/ n_prt, n_flv /) )"; nl () - - let print_flavor_tables amplitudes = - let n = num_particles amplitudes in - print_flavor_table n "f" "states" - (List.map (fun (fin, fout) -> fin @ fout) (CF.flavors amplitudes)); - nl () - - let num_flavors amplitudes = - List.length (CF.flavors amplitudes) - - let print_color_flows_table abbrev = function - | [] -> - printf " @[<2>integer, dimension(n_cindex, n_prt, n_cflow), parameter, private ::"; - printf "@ table_color_flows"; nl () - | _ :: tuples' as tuples -> - ignore (List.fold_left (fun i tuple -> - printf - " @[<2>integer, dimension(n_cindex, n_prt), parameter, private ::"; - printf "@ %s%04d = reshape ( (/ " abbrev i; - begin match CFlow.to_lists tuple with - | [] -> () - | cf1 :: cfn -> - printf "@ %s" (String.concat "," (List.map string_of_int cf1)); - List.iter (function cf -> - printf ",@ %s" (String.concat "," (List.map string_of_int cf))) cfn - end; - printf "@ /),@ (/ n_cindex, n_prt /) )"; - nl (); succ i) 1 tuples); - printf - " @[<2>integer, dimension(n_cindex, n_prt, n_cflow), parameter, private ::"; - printf "@ table_color_flows =@ reshape ( (/"; - printf "@ %s%04d" abbrev 1; - ignore (List.fold_left (fun i tuple -> - printf ",@ %s%04d" abbrev i; succ i) 2 tuples'); - printf "@ /),@ (/ n_cindex, n_prt, n_cflow /) )"; nl () - - let print_ghost_flags_table abbrev = function - | [] -> - printf " @[<2>logical, dimension(n_prt, n_cflow), parameter, private ::"; - printf "@ table_ghost_flags"; nl () - | _ :: tuples' as tuples -> - ignore (List.fold_left (fun i tuple -> - printf - " @[<2>logical, dimension(n_prt), parameter, private ::"; - printf "@ %s%04d = (/ " abbrev i; - begin match CFlow.ghost_flags tuple with - | [] -> () - | gf1 :: gfn -> - printf "@ %s" (if gf1 then "T" else "F"); - List.iter (function gf -> printf ",@ %s" (if gf then "T" else "F")) gfn - end; - printf "@ /)"; - nl (); succ i) 1 tuples); - printf - " @[<2>logical, dimension(n_prt, n_cflow), parameter, private ::"; - printf "@ table_ghost_flags =@ reshape ( (/"; - printf "@ %s%04d" abbrev 1; - ignore (List.fold_left (fun i tuple -> - printf ",@ %s%04d" abbrev i; succ i) 2 tuples'); - printf "@ /),@ (/ n_prt, n_cflow /) )"; nl () - - let print_color_tables cflows = - print_color_flows_table "c" cflows; - print_ghost_flags_table "g" cflows; - nl (); nl () - - let print_amplitude_table () = - printf - " @[<2>complex(kind=default), dimension(n_cflow, n_hel, n_flv), private, save :: amp"; - nl (); - nl () - -(*i -(* \thocwmodulesubsection{Dispatch Flavor Amplitudes} *) - -(* We can customize the generic [Trie] module so that it will dump the trie. *) - - module FT = Trie.Make - (Map.Make (struct type t = M.flavor let compare = compare end)) - - let flavor_trie_amplitude amplitudes = - List.fold_left (fun t a -> - FT.add (flavors a) - ("amp = " ^ flavors_symbol (flavors a) ^ " (k, s)", - process_to_string a) t) - FT.empty (CF.processes amplitudes) - - let flavor_trie_index amplitudes = - let _, trie = - List.fold_left (fun (i, t) a -> - (succ i, - FT.add (flavors a) ("n = " ^ string_of_int i, process_to_string a) t)) - (1, FT.empty) (MF.allowed amplitudes) in - trie - - let print_trie name trie = - let indent n = String.make (2 * n) ' ' in - FT.export - (fun n -> - let n' = succ n in - printf "%s select case (%s(%d))" (indent n') name n'; nl ()) - (fun n -> - let n' = succ n in - printf "%s end select" (indent n'); nl ()) - (fun n rev_key -> - if n > 0 then begin - printf "%s case (%d)" (indent n) (M.pdg (List.hd rev_key)); - nl () - end) - (fun n rev_key (stmt, doc) -> - printf "%s case (%d) ! %s" - (indent n) (M.pdg (List.hd rev_key)) doc; nl (); - printf "%s %s" (indent n) stmt; nl ()) - trie -i*) - -(* \thocwmodulesubsection{Maintenance \&\ Inquiry Functions} *) - - let print_maintenance_functions () = - if !whizard then begin - printf " subroutine init (par)"; nl (); - printf " type(parameter_set), intent(in) :: par"; nl (); - printf " call import_from_whizard (par)"; nl (); - printf " end subroutine init"; nl (); - nl (); - printf " subroutine final ()"; nl (); - printf " end subroutine final"; nl (); - nl () - end - - let print_inquiry_function_declarations name = - printf " @[<2>public :: number_%s,@ %s" name name; - nl () - - let print_numeric_inquiry_functions () = - printf " @[<5>"; if !fortran95 then printf "pure "; - printf "function number_particles_in () result (n)"; nl (); - printf " integer :: n"; nl (); - printf " n = n_in"; nl (); - printf " end function number_particles_in"; nl (); - nl (); - printf " @[<5>"; if !fortran95 then printf "pure "; - printf "function number_particles_out () result (n)"; nl (); - printf " integer :: n"; nl (); - printf " n = n_out"; nl (); - printf " end function number_particles_out"; nl (); - nl () - - let print_inquiry_functions name = - printf " @[<5>"; if !fortran95 then printf "pure "; - printf "function number_%s () result (n)" name; nl (); - printf " integer :: n"; nl (); - printf " n = size (table_%s, dim=2)" name; nl (); - printf " end function number_%s" name; nl (); - nl (); - printf " @[<5>"; if !fortran95 then printf "pure "; - printf "subroutine %s (a)" name; nl (); - printf " integer, dimension(:,:), intent(out) :: a"; nl (); - printf " a = table_%s" name; nl (); - printf " end subroutine %s" name; nl (); - nl () - - let print_color_flows () = - printf " @[<5>"; if !fortran95 then printf "pure "; - printf "function number_color_indices () result (n)"; nl (); - printf " integer :: n"; nl (); - printf " n = size (table_color_flows, dim=1)"; nl (); - printf " end function number_color_indices"; nl (); - nl (); - printf " @[<5>"; if !fortran95 then printf "pure "; - printf "function number_color_flows () result (n)"; nl (); - printf " integer :: n"; nl (); - printf " n = size (table_color_flows, dim=3)"; nl (); - printf " end function number_color_flows"; nl (); - nl (); - printf " @[<5>"; if !fortran95 then printf "pure "; - printf "subroutine color_flows (a, g)"; nl (); - printf " integer, dimension(:,:,:), intent(out) :: a"; nl (); - printf " logical, dimension(:,:), intent(out) :: g"; nl (); - printf " a = table_color_flows"; nl (); - printf " g = table_ghost_flags"; nl (); - printf " end subroutine color_flows"; nl (); - nl () - - let print_dispatch_functions () = - printf " subroutine new_event (p)"; nl (); - printf " real(kind=default), dimension(0:,:), intent(in) :: p"; nl (); - printf " call calculate_amplitudes (amp, p)"; nl (); - printf " end subroutine new_event"; nl (); - nl (); - printf " @[<5>"; if !fortran95 then printf "pure "; - printf "function is_allowed (flv, hel, col)"; nl (); - printf " logical :: is_allowed"; nl (); - printf " integer, intent(in) :: flv, hel, col"; nl (); - printf " ! integer, dimension(n_prt) :: s"; nl (); - printf " ! s = table_spin_states(:,hel)"; nl (); - printf " is_allowed = .true."; nl (); - printf " end function is_allowed"; nl (); - nl (); - printf " @[<5>"; if !fortran95 then printf "pure "; - printf "function get_amplitude (flv, hel, col) result (amp_result)"; nl (); - printf " complex(kind=default) :: amp_result"; nl (); - printf " integer, intent(in) :: flv, hel, col"; nl (); - printf " amp_result = amp(col, hel, flv)"; nl (); - printf " end function get_amplitude"; nl (); - nl () - -(* \thocwmodulesubsection{Main Function} *) - - let print_description cmdline amplitudes = - printf "! File generated automatically by O'Mega"; nl(); - printf "!"; nl(); - printf "! %s" cmdline; nl(); - printf "!"; nl(); - printf "! with all scattering amplitudes for the process(es)"; nl (); - printf "!"; nl (); - printf "! contributing:"; nl (); - printf "!"; nl (); - List.iter - (fun process -> - printf "! %s" (process_sans_color_to_string process); nl ()) - (CF.flavors amplitudes); - printf "!"; nl (); - List.iter - (fun cflow -> printf "! %s" (cflow_to_string cflow); nl ()) - (CF.color_flows amplitudes); - printf "!"; nl (); - printf "! vanishing:"; nl (); - printf "!"; nl (); - List.iter (fun process -> - printf "! %s" (process_sans_color_to_string process); nl ()) - (CF.vanishing_flavors amplitudes); - printf "!"; nl (); - List.iter - (fun cflow -> printf "! %s" (cflow_to_string cflow); nl ()) - (CF.vanishing_color_flows amplitudes); - printf "!"; nl (); - begin - match CF.constraints amplitudes with - | None -> () - | Some s -> - printf - "! diagram selection (MIGHT BREAK GAUGE INVARIANCE!!!):"; nl (); - printf "!"; nl (); - printf "! %s" s; nl (); - printf "!"; nl () - end; - begin match RCS.description CM.rcs with - | line1 :: lines -> - printf "! in %s" line1; nl (); - List.iter (fun s -> printf "! %s" s; nl ()) lines - | [] -> printf "! in %s" (RCS.name CM.rcs); nl () - end; - printf "!"; nl () - - let print_version () = - printf "! O'Mega revision control information:"; nl (); - List.iter (fun s -> printf "! %s" s; nl ()) - (ThoList.flatmap RCS.summary (CM.rcs :: rcs_list @ F.rcs_list)) - - let print_public = function - | name1 :: names -> - printf " @[<2>public :: %s" name1; - List.iter (fun n -> printf ",@ %s" n) names; nl () - | [] -> () - - let print_public_interface generic procedures = - printf " public :: %s" generic; nl (); - begin match procedures with - | name1 :: names -> - printf " interface %s" generic; nl (); - printf " @[<2>module procedure %s" name1; - List.iter (fun n -> printf ",@ %s" n) names; nl (); - printf " end interface"; nl (); - print_public procedures - | [] -> () - end - - let print_module_header amplitudes = - let cflows = CF.color_flows amplitudes in - printf "module %s" !module_name; nl (); nl (); - List.iter (fun s -> printf " use %s" s; nl ()) - (["kinds"; Fermions.use_module; !parameter_module] @ - !use_modules); nl (); - printf " implicit none"; nl (); - printf " private"; nl (); nl (); - print_public ["number_particles_in"; "number_particles_out"]; - List.iter print_inquiry_function_declarations - ["spin_states"; "flavor_states"; "color_flows"]; - print_public ["number_color_indices"]; - if !whizard then - print_public ["init"; "final"]; - print_public ["new_event"; "is_allowed"; "get_amplitude"]; nl (); - printf " ! DON'T EVEN THINK of removing the following!"; nl (); - printf " ! If the compiler complains about undeclared"; nl (); - printf " ! or undefined variables, you are compiling"; nl (); - printf " ! against an incompatible omega95 module!"; nl (); - printf " @[<2>integer, dimension(%d), parameter, private :: " - (List.length require_library); - printf "require =@ (/ @["; - print_list require_library; - printf " /)"; nl(); nl (); - - (* Using these parameters makes sense for documentation, but in - practice, there is no need to ever change them. *) - List.iter - (function name, value -> print_integer_parameter name value) - [ ("n_prt", num_particles amplitudes); - ("n_in", num_particles_in amplitudes); - ("n_out", num_particles_out amplitudes); - ("n_cflow", num_color_flows cflows); (* Number of different color amplitudes. *) - ("n_cindex", num_color_indices cflows); (* Maximum rank of color tensors. *) - ("n_flv", num_flavors amplitudes); (* Number of different flavor amplitudes. *) - ("n_hel", num_helicities amplitudes) (* Number of different helicty amplitudes. *) ]; - nl (); - - (* Abbreviations. *) - List.iter - (function name, value -> print_logical_parameter name value) - [ ("F", false); ("T", true) ]; nl (); - - print_spin_tables amplitudes; - print_flavor_tables amplitudes; - print_color_tables cflows; - print_amplitude_table (); - printf "contains"; nl (); nl (); - print_maintenance_functions (); - print_numeric_inquiry_functions (); - List.iter print_inquiry_functions - ["spin_states"; "flavor_states"]; - print_color_flows (); - print_dispatch_functions () - - let print_module_footer () = - printf "end module %s" !module_name; nl () - - let amplitudes_to_channel cmdline oc diagnostics amplitudes = - set_formatter_out_channel oc; - set_margin !line_length; - wrap_newline (); - parse_diagnostics diagnostics; - print_description cmdline amplitudes; - print_module_header amplitudes; - if !km_write || !km_pure then - Targets_Kmatrix.Fortran.print !km_pure; - print_amplitudes amplitudes; - print_module_footer (); - print_version (); - print_flush () - - let parameters_to_channel oc = - parameters_to_fortran oc (CM.parameters ()) - - end - -module Fortran = Make_Fortran(Fortran_Fermions) - -(* \thocwmodulesubsection{Majorana Fermions} *) - -(* \begin{JR} - For this function we need a different approach due to our aim of - implementing the fermion vertices with the right line as ingoing (in a - calculational sense) and the left line in a fusion as outgoing. In - defining all external lines and the fermionic wavefunctions built out of - them as ingoing we have to invert the left lines to make them outgoing. - This happens by multiplying them with the inverse charge conjugation - matrix in an appropriate representation and then transposing it. We must - distinguish whether the direction of calculation and the physical direction - of the fermion number flow are parallel or antiparallel. In the first case - we can use the "normal" Feynman rules for Dirac particles, while in the - second, according to the paper of Denner et al., we have to reverse the - sign of the vector and antisymmetric bilinears of the Dirac spinors, cf. - the [Coupling] module. - - Note the subtlety for the left- and righthanded couplings: Only the vector - part of these couplings changes in the appropriate cases its sign, - changing the chirality to the negative of the opposite. - \end{JR} *) - -module Fortran_Majorana_Fermions : Fermions = - struct - let rcs = RCS.rename rcs_file "Targets.Fortran_Majorana_Fermions()" - [ "generates Fortran95 code for Dirac and Majorana fermions"; - " using revision 2003_03_A of module omega95_bispinors" ] - - open Coupling - open Format - - let psi_type = "bispinor" - let psibar_type = "bispinor" - let chi_type = "bispinor" - let grav_type = "vectorspinor" - -(* \begin{JR} - Because of our rules for fermions we are going to give all incoming fermions - a [u] spinor and all outgoing fermions a [v] spinor, no matter whether they - are Dirac fermions, antifermions or Majorana fermions. - \end{JR} *) - - let psi_incoming = "u" - let brs_psi_incoming = "brs_u" - let psibar_incoming = "u" - let brs_psibar_incoming = "brs_u" - let chi_incoming = "u" - let brs_chi_incoming = "brs_u" - let grav_incoming = "ueps" - - let psi_outgoing = "v" - let brs_psi_outgoing = "brs_v" - let psibar_outgoing = "v" - let brs_psibar_outgoing = "brs_v" - let chi_outgoing = "v" - let brs_chi_outgoing = "brs_v" - let grav_outgoing = "veps" - - let psi_propagator = "pr_psi" - let psibar_propagator = "pr_psi" - let chi_propagator = "pr_psi" - let grav_propagator = "pr_grav" - - let psi_projector = "pj_psi" - let psibar_projector = "pj_psi" - let chi_projector = "pj_psi" - let grav_projector = "pj_grav" - - let psi_gauss = "pg_psi" - let psibar_gauss = "pg_psi" - let chi_gauss = "pg_psi" - let grav_gauss = "pg_grav" - - let format_coupling coeff c = - match coeff with - | 1 -> c - | -1 -> "(-" ^ c ^")" - | coeff -> string_of_int coeff ^ "*" ^ c - - let format_coupling_2 coeff c = - match coeff with - | 1 -> c - | -1 -> "-" ^ c - | coeff -> string_of_int coeff ^ "*" ^ c - - let print_fermion_current coeff f c wf1 wf2 fusion = - let c = format_coupling coeff c in - match fusion with - | F13 | F31 -> printf "%s_ff(%s,%s,%s)" f c wf1 wf2 - | F23 | F21 -> printf "f_%sf(%s,%s,%s)" f c wf1 wf2 - | F32 | F12 -> printf "f_%sf(%s,%s,%s)" f c wf2 wf1 - - let print_fermion_current2 coeff f c wf1 wf2 fusion = - let c = format_coupling_2 coeff c in - match fusion with - | F13 | F31 -> printf "%s_ff(%s(1),%s(2),%s,%s)" f c c wf1 wf2 - | F23 | F21 -> printf "f_%sf(%s(1),%s(2),%s,%s)" f c c wf1 wf2 - | F32 | F12 -> printf "f_%sf(%s(1),%s(2),%s,%s)" f c c wf2 wf1 - - let print_fermion_current_vector coeff f c wf1 wf2 fusion = - let c = format_coupling coeff c in - match fusion with - | F13 -> printf "%s_ff(%s,%s,%s)" f c wf1 wf2 - | F31 -> printf "%s_ff(-%s,%s,%s)" f c wf1 wf2 - | F23 -> printf "f_%sf(%s,%s,%s)" f c wf1 wf2 - | F32 -> printf "f_%sf(%s,%s,%s)" f c wf2 wf1 - | F12 -> printf "f_%sf(-%s,%s,%s)" f c wf2 wf1 - | F21 -> printf "f_%sf(-%s,%s,%s)" f c wf1 wf2 - - let print_fermion_current2_vector coeff f c wf1 wf2 fusion = - let c = format_coupling_2 coeff c in - match fusion with - | F13 -> printf "%s_ff(%s(1),%s(2),%s,%s)" f c c wf1 wf2 - | F31 -> printf "%s_ff(-(%s(1)),%s(2),%s,%s)" f c c wf1 wf2 - | F23 -> printf "f_%sf(%s(1),%s(2),%s,%s)" f c c wf1 wf2 - | F32 -> printf "f_%sf(%s(1),%s(2),%s,%s)" f c c wf2 wf1 - | F12 -> printf "f_%sf(-(%s(1)),%s(2),%s,%s)" f c c wf2 wf1 - | F21 -> printf "f_%sf(-(%s(1)),%s(2),%s,%s)" f c c wf1 wf2 - - let print_fermion_current_chiral coeff f1 f2 c wf1 wf2 fusion = - let c = format_coupling coeff c in - match fusion with - | F13 -> printf "%s_ff(%s,%s,%s)" f1 c wf1 wf2 - | F31 -> printf "%s_ff(-%s,%s,%s)" f2 c wf1 wf2 - | F23 -> printf "f_%sf(%s,%s,%s)" f1 c wf1 wf2 - | F32 -> printf "f_%sf(%s,%s,%s)" f1 c wf2 wf1 - | F12 -> printf "f_%sf(-%s,%s,%s)" f2 c wf2 wf1 - | F21 -> printf "f_%sf(-%s,%s,%s)" f2 c wf1 wf2 - - let print_fermion_current2_chiral coeff f c wf1 wf2 fusion = - let c = format_coupling_2 coeff c in - match fusion with - | F13 -> printf "%s_ff(%s(1),%s(2),%s,%s)" f c c wf1 wf2 - | F31 -> printf "%s_ff(-(%s(2)),-(%s(1)),%s,%s)" f c c wf1 wf2 - | F23 -> printf "f_%sf(%s(1),%s(2),%s,%s)" f c c wf1 wf2 - | F32 -> printf "f_%sf(%s(1),%s(2),%s,%s)" f c c wf2 wf1 - | F12 -> printf "f_%sf(-(%s(2)),-(%s(1)),%s,%s)" f c c wf2 wf1 - | F21 -> printf "f_%sf(-(%s(2)),-(%s(1)),%s,%s)" f c c wf1 wf2 - - let print_current = function - | coeff, _, VA, _ -> print_fermion_current2_vector coeff "va" - | coeff, _, V, _ -> print_fermion_current_vector coeff "v" - | coeff, _, A, _ -> print_fermion_current coeff "a" - | coeff, _, VL, _ -> print_fermion_current_chiral coeff "vl" "vr" - | coeff, _, VR, _ -> print_fermion_current_chiral coeff "vr" "vl" - | coeff, _, VLR, _ -> print_fermion_current2_chiral coeff "vlr" - | coeff, _, SP, _ -> print_fermion_current2 coeff "sp" - | coeff, _, S, _ -> print_fermion_current coeff "s" - | coeff, _, P, _ -> print_fermion_current coeff "p" - | coeff, _, SL, _ -> print_fermion_current coeff "sl" - | coeff, _, SR, _ -> print_fermion_current coeff "sr" - | coeff, _, SLR, _ -> print_fermion_current2 coeff "slr" - | coeff, _, POT, _ -> print_fermion_current_vector coeff "pot" - | coeff, _, _, _ -> invalid_arg - "Targets.Fortran_Majorana_Fermions: Not needed in the models" - - let print_current_p = function - | coeff, Psi, SL, Psi -> print_fermion_current coeff "sl" - | coeff, Psi, SR, Psi -> print_fermion_current coeff "sr" - | coeff, Psi, SLR, Psi -> print_fermion_current2 coeff "slr" - | coeff, _, _, _ -> invalid_arg - "Targets.Fortran_Majorana_Fermions: Not needed in the used models" - - let print_current_b = function - | coeff, Psibar, SL, Psibar -> print_fermion_current coeff "sl" - | coeff, Psibar, SR, Psibar -> print_fermion_current coeff "sr" - | coeff, Psibar, SLR, Psibar -> print_fermion_current2 coeff "slr" - | coeff, _, _, _ -> invalid_arg - "Targets.Fortran_Majorana_Fermions: Not needed in the used models" - -(* This function is for the vertices with three particles including two - fermions but also a momentum, therefore with a dimensionful coupling - constant, e.g. the gravitino vertices. One has to dinstinguish between - the two kinds of canonical orders in the string of gamma matrices. Of - course, the direction of the string of gamma matrices is reversed if one - goes from the [Gravbar, _, Psi] to the [Psibar, _, Grav] vertices, and - the same is true for the couplings of the gravitino to the Majorana - fermions. For more details see the tables in the [coupling] - implementation. *) - -(* We now have to fix the directions of the momenta. For making the compiler - happy and because we don't want to make constructions of infinite - complexity we list the momentum including vertices without gravitinos - here; the pattern matching says that's better. Perhaps we have to find a - better name now. - - For the cases of $MOM$, $MOM5$, $MOML$ and $MOMR$ which arise only in - BRST transformations we take the mass as a coupling constant. For - $VMOM$ we don't need a mass either. These vertices are like kinetic terms - and so need not have a coupling constant. By this we avoid a strange and - awful construction with a new variable. But be careful with a - generalization if you want to use these vertices for other purposes. -*) - - let format_coupling_mom coeff c = - match coeff with - | 1 -> c - | -1 -> "(-" ^ c ^")" - | coeff -> string_of_int coeff ^ "*" ^ c - - let format_coupling_mom_2 coeff c = - match coeff with - | 1 -> c - | -1 -> "(-" ^ c ^")" - | coeff -> string_of_int coeff ^ "*" ^ c - - let commute_proj f = - match f with - | "moml" -> "lmom" - | "momr" -> "rmom" - | "lmom" -> "moml" - | "rmom" -> "momr" - | "svl" -> "svr" - | "svr" -> "svl" - | "sl" -> "sr" - | "sr" -> "sl" - | "s" -> "s" - | "p" -> "p" - | _ -> invalid_arg "Targets:Fortran_Majorana_Fermions: wrong case" - - let print_fermion_current_mom coeff f c wf1 wf2 p1 p2 p12 fusion = - let c = format_coupling_mom_2 coeff c in - match fusion with - | F13 -> printf "%s_ff(%s(1),%s(2),%s,%s,%s)" f c c wf1 wf2 p12 - | F31 -> printf "%s_ff(%s(1),%s(2),%s,%s,%s)" f c c wf1 wf2 p12 - | F23 -> printf "f_%sf(%s(1),%s(2),%s,%s,%s)" f c c wf1 wf2 p1 - | F32 -> printf "f_%sf(%s(1),%s(2),%s,%s,%s)" f c c wf2 wf1 p2 - | F12 -> printf "f_%sf(%s(1),%s(2),%s,%s,%s)" f c c wf2 wf1 p2 - | F21 -> printf "f_%sf(%s(1),%s(2),%s,%s,%s)" f c c wf1 wf2 p1 - - let print_fermion_current_mom_sign coeff f c wf1 wf2 p1 p2 p12 fusion = - let c = format_coupling_mom_2 coeff c in - match fusion with - | F13 -> printf "%s_ff(%s(1),%s(2),%s,%s,%s)" f c c wf1 wf2 p12 - | F31 -> printf "%s_ff(%s(1),%s(2),%s,%s,-(%s))" f c c wf1 wf2 p12 - | F23 -> printf "f_%sf(%s(1),%s(2),%s,%s,%s)" f c c wf1 wf2 p1 - | F32 -> printf "f_%sf(%s(1),%s(2),%s,%s,%s)" f c c wf2 wf1 p2 - | F12 -> printf "f_%sf(%s(1),%s(2),%s,%s,-(%s))" f c c wf2 wf1 p2 - | F21 -> printf "f_%sf(%s(1),%s(2),%s,%s,-(%s))" f c c wf1 wf2 p1 - - let print_fermion_current_mom_sign_1 coeff f c wf1 wf2 p1 p2 p12 fusion = - let c = format_coupling coeff c in - match fusion with - | F13 -> printf "%s_ff(%s,%s,%s,%s)" f c wf1 wf2 p12 - | F31 -> printf "%s_ff(%s,%s,%s,-(%s))" f c wf1 wf2 p12 - | F23 -> printf "f_%sf(%s,%s,%s,%s)" f c wf1 wf2 p1 - | F32 -> printf "f_%sf(%s,%s,%s,%s)" f c wf2 wf1 p2 - | F12 -> printf "f_%sf(%s,%s,%s,-(%s))" f c wf2 wf1 p2 - | F21 -> printf "f_%sf(%s,%s,%s,-(%s))" f c wf1 wf2 p1 - - let print_fermion_current_mom_chiral coeff f c wf1 wf2 p1 p2 p12 fusion = - let c = format_coupling_mom_2 coeff c and - cf = commute_proj f in - match fusion with - | F13 -> printf "%s_ff(%s(1),%s(2),%s,%s,%s)" f c c wf1 wf2 p12 - | F31 -> printf "%s_ff(%s(1),%s(2),%s, %s,-(%s))" cf c c wf1 wf2 p12 - | F23 -> printf "f_%sf(%s(1),%s(2),%s,%s,%s)" f c c wf1 wf2 p1 - | F32 -> printf "f_%sf(%s(1),%s(2),%s,%s,%s)" f c c wf2 wf1 p2 - | F12 -> printf "f_%sf(%s(1),%s(2),%s,%s,-(%s))" cf c c wf2 wf1 p2 - | F21 -> printf "f_%sf(%s(1),%s(2),%s,%s,-(%s))" cf c c wf1 wf2 p1 - - let print_fermion_g_current coeff f c wf1 wf2 p1 p2 p12 fusion = - let c = format_coupling coeff c in - match fusion with - | F13 -> printf "%s_grf(%s,%s,%s,%s)" f c wf1 wf2 p12 - | F31 -> printf "%s_fgr(%s,%s,%s,%s)" f c wf1 wf2 p12 - | F23 -> printf "gr_%sf(%s,%s,%s,%s)" f c wf1 wf2 p1 - | F32 -> printf "gr_%sf(%s,%s,%s,%s)" f c wf2 wf1 p2 - | F12 -> printf "f_%sgr(%s,%s,%s,%s)" f c wf2 wf1 p2 - | F21 -> printf "f_%sgr(%s,%s,%s,%s)" f c wf1 wf2 p1 - - let print_fermion_g_current_rev coeff f c wf1 wf2 p1 p2 p12 fusion = - let c = format_coupling coeff c in - match fusion with - | F13 -> printf "%s_fgr(%s,%s,%s,%s)" f c wf1 wf2 p12 - | F31 -> printf "%s_grf(%s,%s,%s,%s)" f c wf1 wf2 p12 - | F23 -> printf "f_%sgr(%s,%s,%s,%s)" f c wf1 wf2 p1 - | F32 -> printf "f_%sgr(%s,%s,%s,%s)" f c wf2 wf1 p2 - | F12 -> printf "gr_%sf(%s,%s,%s,%s)" f c wf2 wf1 p2 - | F21 -> printf "gr_%sf(%s,%s,%s,%s)" f c wf1 wf2 p1 - - let print_fermion_g_current_vector coeff f c wf1 wf2 p1 p2 p12 fusion = - let c = format_coupling coeff c in - match fusion with - | F13 -> printf "%s_grf(%s,%s,%s)" f c wf1 wf2 - | F31 -> printf "%s_fgr(-%s,%s,%s)" f c wf1 wf2 - | F23 -> printf "gr_%sf(%s,%s,%s)" f c wf1 wf2 - | F32 -> printf "gr_%sf(%s,%s,%s)" f c wf2 wf1 - | F12 -> printf "f_%sgr(-%s,%s,%s)" f c wf2 wf1 - | F21 -> printf "f_%sgr(-%s,%s,%s)" f c wf1 wf2 - - let print_fermion_g_current_vector_rev coeff f c wf1 wf2 p1 p2 p12 fusion = - let c = format_coupling coeff c in - match fusion with - | F13 -> printf "%s_fgr(%s,%s,%s)" f c wf1 wf2 - | F31 -> printf "%s_grf(-%s,%s,%s)" f c wf1 wf2 - | F23 -> printf "f_%sgr(%s,%s,%s)" f c wf1 wf2 - | F32 -> printf "f_%sgr(%s,%s,%s)" f c wf2 wf1 - | F12 -> printf "gr_%sf(-%s,%s,%s)" f c wf2 wf1 - | F21 -> printf "gr_%sf(-%s,%s,%s)" f c wf1 wf2 - - let print_current_g = function - | coeff, _, MOM, _ -> print_fermion_current_mom_sign coeff "mom" - | coeff, _, MOM5, _ -> print_fermion_current_mom coeff "mom5" - | coeff, _, MOML, _ -> print_fermion_current_mom_chiral coeff "moml" - | coeff, _, MOMR, _ -> print_fermion_current_mom_chiral coeff "momr" - | coeff, _, LMOM, _ -> print_fermion_current_mom_chiral coeff "lmom" - | coeff, _, RMOM, _ -> print_fermion_current_mom_chiral coeff "rmom" - | coeff, _, VMOM, _ -> print_fermion_current_mom_sign_1 coeff "vmom" - | coeff, Gravbar, S, _ -> print_fermion_g_current coeff "s" - | coeff, Gravbar, P, _ -> print_fermion_g_current coeff "p" - | coeff, Gravbar, V, _ -> print_fermion_g_current coeff "v" - | coeff, Gravbar, POT, _ -> print_fermion_g_current_vector coeff "pot" - | coeff, _, S, Grav -> print_fermion_g_current_rev coeff "s" - | coeff, _, P, Grav -> print_fermion_g_current_rev (-coeff) "p" - | coeff, _, V, Grav -> print_fermion_g_current_rev coeff "v" - | coeff, _, POT, Grav -> print_fermion_g_current_vector_rev coeff "pot" - | coeff, _, _, _ -> invalid_arg - "Targets.Fortran_Majorana_Fermions: not used in the models" - -(* We need support for dimension-5 vertices with two fermions and two - bosons, appearing in theories of supergravity and also together with in - insertions of the supersymmetric current. There is a canonical order - [fermionbar], [boson_1], [boson_2], [fermion], so what one has to do is a - mapping from the fusions [F123] etc. to the order of the three wave - functions [wf1], [wf2] and [wf3]. *) - -(* The function [d_p] (for distinct the particle) distinguishes which particle - (scalar or vector) must be fused to in the special functions. *) - - let d_p = function - | 1, ("sv"|"pv"|"svl"|"svr") -> "1" - | 1, _ -> "" - | 2, ("sv"|"pv"|"svl"|"svr") -> "2" - | 2, _ -> "" - | _, _ -> invalid_arg "Targets.Fortran_Majorana_Fermions: not used" - - let wf_of_f wf1 wf2 wf3 f = - match f with - | (F123|F423) -> [wf2; wf3; wf1] - | (F213|F243|F143|F142|F413|F412) -> [wf1; wf3; wf2] - | (F132|F432) -> [wf3; wf2; wf1] - | (F231|F234|F134|F124|F431|F421) -> [wf1; wf2; wf3] - | (F312|F342) -> [wf3; wf1; wf2] - | (F321|F324|F314|F214|F341|F241) -> [wf2; wf1; wf3] - - let print_fermion_g4_brs_vector_current coeff f c wf1 wf2 wf3 fusion = - let cf = commute_proj f and - cp = format_coupling coeff c and - cm = if f = "pv" then - format_coupling coeff c - else - format_coupling (-coeff) c - and - d1 = d_p (1,f) and - d2 = d_p (2,f) and - f1 = (List.nth (wf_of_f wf1 wf2 wf3 fusion) 0) and - f2 = (List.nth (wf_of_f wf1 wf2 wf3 fusion) 1) and - f3 = (List.nth (wf_of_f wf1 wf2 wf3 fusion) 2) in - match fusion with - | (F123|F213|F132|F231|F312|F321) -> - printf "f_%sf(%s,%s,%s,%s)" cf cm f1 f2 f3 - | (F423|F243|F432|F234|F342|F324) -> - printf "f_%sf(%s,%s,%s,%s)" f cp f1 f2 f3 - | (F134|F143|F314) -> printf "%s%s_ff(%s,%s,%s,%s)" f d1 cp f1 f2 f3 - | (F124|F142|F214) -> printf "%s%s_ff(%s,%s,%s,%s)" f d2 cp f1 f2 f3 - | (F413|F431|F341) -> printf "%s%s_ff(%s,%s,%s,%s)" cf d1 cm f1 f2 f3 - | (F241|F412|F421) -> printf "%s%s_ff(%s,%s,%s,%s)" cf d2 cm f1 f2 f3 - - let print_fermion_g4_svlr_current coeff f c wf1 wf2 wf3 fusion = - let c = format_coupling_2 coeff c and - f1 = (List.nth (wf_of_f wf1 wf2 wf3 fusion) 0) and - f2 = (List.nth (wf_of_f wf1 wf2 wf3 fusion) 1) and - f3 = (List.nth (wf_of_f wf1 wf2 wf3 fusion) 2) in - match fusion with - | (F123|F213|F132|F231|F312|F321) -> - printf "f_svlrf(-(%s(2)),-(%s(1)),%s,%s,%s)" c c f1 f2 f3 - | (F423|F243|F432|F234|F342|F324) -> - printf "f_svlrf(%s(1),%s(2),%s,%s,%s)" c c f1 f2 f3 - | (F134|F143|F314) -> - printf "svlr2_ff(%s(1),%s(2),%s,%s,%s)" c c f1 f2 f3 - | (F124|F142|F214) -> - printf "svlr1_ff(%s(1),%s(2),%s,%s,%s)" c c f1 f2 f3 - | (F413|F431|F341) -> - printf "svlr2_ff(-(%s(2)),-(%s(1)),%s,%s,%s)" c c f1 f2 f3 - | (F241|F412|F421) -> - printf "svlr1_ff(-(%s(2)),-(%s(1)),%s,%s,%s)" c c f1 f2 f3 - - let print_fermion_s2_current coeff f c wf1 wf2 wf3 fusion = - let cp = format_coupling coeff c and - cm = if f = "p" then - format_coupling (-coeff) c - else - format_coupling coeff c - and - cf = commute_proj f and - f1 = (List.nth (wf_of_f wf1 wf2 wf3 fusion) 0) and - f2 = (List.nth (wf_of_f wf1 wf2 wf3 fusion) 1) and - f3 = (List.nth (wf_of_f wf1 wf2 wf3 fusion) 2) in - match fusion with - | (F123|F213|F132|F231|F312|F321) -> - printf "%s * f_%sf(%s,%s,%s)" f1 cf cm f2 f3 - | (F423|F243|F432|F234|F342|F324) -> - printf "%s * f_%sf(%s,%s,%s)" f1 f cp f2 f3 - | (F134|F143|F314) -> - printf "%s * %s_ff(%s,%s,%s)" f2 f cp f1 f3 - | (F124|F142|F214) -> - printf "%s * %s_ff(%s,%s,%s)" f2 f cp f1 f3 - | (F413|F431|F341) -> - printf "%s * %s_ff(%s,%s,%s)" f2 cf cm f1 f3 - | (F241|F412|F421) -> - printf "%s * %s_ff(%s,%s,%s)" f2 cf cm f1 f3 - - let print_fermion_s2p_current coeff f c wf1 wf2 wf3 fusion = - let c = format_coupling_2 coeff c and - f1 = (List.nth (wf_of_f wf1 wf2 wf3 fusion) 0) and - f2 = (List.nth (wf_of_f wf1 wf2 wf3 fusion) 1) and - f3 = (List.nth (wf_of_f wf1 wf2 wf3 fusion) 2) in - match fusion with - | (F123|F213|F132|F231|F312|F321) -> - printf "%s * f_%sf(%s(1),-(%s(2)),%s,%s)" f1 f c c f2 f3 - | (F423|F243|F432|F234|F342|F324) -> - printf "%s * f_%sf(%s(1),%s(2),%s,%s)" f1 f c c f2 f3 - | (F134|F143|F314) -> - printf "%s * %s_ff(%s(1),%s(2),%s,%s)" f2 f c c f1 f3 - | (F124|F142|F214) -> - printf "%s * %s_ff(%s(1),%s(2),%s,%s)" f2 f c c f1 f3 - | (F413|F431|F341) -> - printf "%s * %s_ff(%s(1),-(%s(2)),%s,%s)" f2 f c c f1 f3 - | (F241|F412|F421) -> - printf "%s * %s_ff(%s(1),-(%s(2)),%s,%s)" f2 f c c f1 f3 - - let print_fermion_s2lr_current coeff f c wf1 wf2 wf3 fusion = - let c = format_coupling_2 coeff c and - f1 = (List.nth (wf_of_f wf1 wf2 wf3 fusion) 0) and - f2 = (List.nth (wf_of_f wf1 wf2 wf3 fusion) 1) and - f3 = (List.nth (wf_of_f wf1 wf2 wf3 fusion) 2) in - match fusion with - | (F123|F213|F132|F231|F312|F321) -> - printf "%s * f_%sf(%s(2),%s(1),%s,%s)" f1 f c c f2 f3 - | (F423|F243|F432|F234|F342|F324) -> - printf "%s * f_%sf(%s(1),%s(2),%s,%s)" f1 f c c f2 f3 - | (F134|F143|F314) -> - printf "%s * %s_ff(%s(1),%s(2),%s,%s)" f2 f c c f1 f3 - | (F124|F142|F214) -> - printf "%s * %s_ff(%s(1),%s(2),%s,%s)" f2 f c c f1 f3 - | (F413|F431|F341) -> - printf "%s * %s_ff(%s(2),%s(1),%s,%s)" f2 f c c f1 f3 - | (F241|F412|F421) -> - printf "%s * %s_ff(%s(2),%s(1),%s,%s)" f2 f c c f1 f3 - - let print_fermion_g4_current coeff f c wf1 wf2 wf3 fusion = - let c = format_coupling coeff c and - f1 = (List.nth (wf_of_f wf1 wf2 wf3 fusion) 0) and - f2 = (List.nth (wf_of_f wf1 wf2 wf3 fusion) 1) and - f3 = (List.nth (wf_of_f wf1 wf2 wf3 fusion) 2) in - match fusion with - | (F123|F213|F132|F231|F312|F321) -> - printf "f_%sgr(-%s,%s,%s,%s)" f c f1 f2 f3 - | (F423|F243|F432|F234|F342|F324) -> - printf "gr_%sf(%s,%s,%s,%s)" f c f1 f2 f3 - | (F134|F143|F314|F124|F142|F214) -> - printf "%s_grf(%s,%s,%s,%s)" f c f1 f2 f3 - | (F413|F431|F341|F241|F412|F421) -> - printf "%s_fgr(-%s,%s,%s,%s)" f c f1 f2 f3 - - let print_fermion_g4_current_rev coeff f c wf1 wf2 wf3 fusion = - let c = format_coupling coeff c and - f1 = (List.nth (wf_of_f wf1 wf2 wf3 fusion) 0) and - f2 = (List.nth (wf_of_f wf1 wf2 wf3 fusion) 1) and - f3 = (List.nth (wf_of_f wf1 wf2 wf3 fusion) 2) in - match fusion with - | (F123|F213|F132|F231|F312|F321) -> - printf "gr_%sf(-%s,%s,%s,%s)" f c f1 f2 f3 - | (F423|F243|F432|F234|F342|F324) -> - printf "f_%sgr(%s,%s,%s,%s)" f c f1 f2 f3 - | (F134|F143|F314|F124|F142|F214) -> - printf "%s_fgr(%s,%s,%s,%s)" f c f1 f2 f3 - | (F413|F431|F341|F241|F412|F421) -> - printf "%s_grf(-%s,%s,%s,%s)" f c f1 f2 f3 - -(* Here we have to distinguish which of the two bosons is produced in the - fusion of three particles which include both fermions. *) - - let print_fermion_g4_vector_current coeff f c wf1 wf2 wf3 fusion = - let c = format_coupling coeff c and - d1 = d_p (1,f) and - d2 = d_p (2,f) and - f1 = (List.nth (wf_of_f wf1 wf2 wf3 fusion) 0) and - f2 = (List.nth (wf_of_f wf1 wf2 wf3 fusion) 1) and - f3 = (List.nth (wf_of_f wf1 wf2 wf3 fusion) 2) in - match fusion with - | (F123|F213|F132|F231|F312|F321) -> - printf "f_%sgr(%s,%s,%s,%s)" f c f1 f2 f3 - | (F423|F243|F432|F234|F342|F324) -> - printf "gr_%sf(%s,%s,%s,%s)" f c f1 f2 f3 - | (F134|F143|F314) -> printf "%s%s_grf(%s,%s,%s,%s)" f d1 c f1 f2 f3 - | (F124|F142|F214) -> printf "%s%s_grf(%s,%s,%s,%s)" f d2 c f1 f2 f3 - | (F413|F431|F341) -> printf "%s%s_fgr(%s,%s,%s,%s)" f d1 c f1 f2 f3 - | (F241|F412|F421) -> printf "%s%s_fgr(%s,%s,%s,%s)" f d2 c f1 f2 f3 - - let print_fermion_g4_vector_current_rev coeff f c wf1 wf2 wf3 fusion = - let c = format_coupling coeff c and - d1 = d_p (1,f) and - d2 = d_p (2,f) and - f1 = (List.nth (wf_of_f wf1 wf2 wf3 fusion) 0) and - f2 = (List.nth (wf_of_f wf1 wf2 wf3 fusion) 1) and - f3 = (List.nth (wf_of_f wf1 wf2 wf3 fusion) 2) in - match fusion with - | (F123|F213|F132|F231|F312|F321) -> - printf "gr_%sf(%s,%s,%s,%s)" f c f1 f2 f3 - | (F423|F243|F432|F234|F342|F324) -> - printf "f_%sgr(%s,%s,%s,%s)" f c f1 f2 f3 - | (F134|F143|F314) -> printf "%s%s_fgr(%s,%s,%s,%s)" f d1 c f1 f2 f3 - | (F124|F142|F214) -> printf "%s%s_fgr(%s,%s,%s,%s)" f d2 c f1 f2 f3 - | (F413|F431|F341) -> printf "%s%s_grf(%s,%s,%s,%s)" f d1 c f1 f2 f3 - | (F241|F412|F421) -> printf "%s%s_grf(%s,%s,%s,%s)" f d2 c f1 f2 f3 - - let print_current_g4 = function - | coeff, Gravbar, S2, _ -> print_fermion_g4_current coeff "s2" - | coeff, Gravbar, SV, _ -> print_fermion_g4_vector_current coeff "sv" - | coeff, Gravbar, PV, _ -> print_fermion_g4_vector_current coeff "pv" - | coeff, Gravbar, V2, _ -> print_fermion_g4_current coeff "v2" - | coeff, Gravbar, _, _ -> invalid_arg "print_current_g4: not implemented" - | coeff, _, S2, Grav -> print_fermion_g4_current_rev coeff "s2" - | coeff, _, SV, Grav -> print_fermion_g4_vector_current_rev (-coeff) "sv" - | coeff, _, PV, Grav -> print_fermion_g4_vector_current_rev coeff "pv" - | coeff, _, V2, Grav -> print_fermion_g4_vector_current_rev coeff "v2" - | coeff, _, _, Grav -> invalid_arg "print_current_g4: not implemented" - | coeff, _, S2, _ -> print_fermion_s2_current coeff "s" - | coeff, _, P2, _ -> print_fermion_s2_current coeff "p" - | coeff, _, S2P, _ -> print_fermion_s2p_current coeff "sp" - | coeff, _, S2L, _ -> print_fermion_s2_current coeff "sl" - | coeff, _, S2R, _ -> print_fermion_s2_current coeff "sr" - | coeff, _, S2LR, _ -> print_fermion_s2lr_current coeff "slr" - | coeff, _, V2, _ -> print_fermion_g4_brs_vector_current coeff "v2" - | coeff, _, SV, _ -> print_fermion_g4_brs_vector_current coeff "sv" - | coeff, _, PV, _ -> print_fermion_g4_brs_vector_current coeff "pv" - | coeff, _, SLV, _ -> print_fermion_g4_brs_vector_current coeff "svl" - | coeff, _, SRV, _ -> print_fermion_g4_brs_vector_current coeff "svr" - | coeff, _, SLRV, _ -> print_fermion_g4_svlr_current coeff "svlr" - - let reverse_braket _ = false - - let use_module = "omega95_bispinors" - let require_library = - ["omega_bispinors_2003_03_A"; "omega_bispinor_cpls_2003_03_A"] - end - -module Fortran_Majorana = Make_Fortran(Fortran_Majorana_Fermions) - -(* \thocwmodulesubsection{\texttt{FORTRAN\,77}} *) - -module Fortran77 = Dummy - -(* \thocwmodulesection{O'Mega Virtual Machine} *) - -module VM = Dummy - -(* \thocwmodulesection{\texttt{C}} *) - -module C = Dummy - -(* \thocwmodulesubsection{\texttt{C++}} *) - -module Cpp = Dummy - -(* \thocwmodulesubsection{Java} *) - -module Java = Dummy - -(* \thocwmodulesection{O'Caml} *) - -module Ocaml = Dummy - -(* \thocwmodulesection{\LaTeX} *) - -module LaTeX = Dummy - -(*i -module VM_old (F : Fusion.T) (Make_MF : Fusion.MultiMaker) - (M : Model.T with type flavor = F.flavor and type constant = F.constant) = - struct - let rcs_list = - [ RCS.rename rcs_file "Targets.VM()" - [ "Bytecode for the O'Mega Virtual Machine" ] ] - - module MF = Make_MF(F) - type amplitude = F.amplitude - type amplitudes = MF.amplitudes - type diagnostic = All | Arguments | Helicities | Momenta | Gauge - let options = Options.empty - - let flavors_to_string flavors = - String.concat " " (List.map M.flavor_to_string flavors) - - let format_process amplitude = - flavors_to_string (F.incoming amplitude) ^ " -> " ^ - flavors_to_string (F.outgoing amplitude) - - open Format - open Coupling - - let ovm_LOAD_SCALAR = 1 - let ovm_LOAD_U = 2 - let ovm_LOAD_UBAR = 3 - let ovm_LOAD_V = 4 - let ovm_LOAD_VBAR = 5 - let ovm_LOAD_VECTOR = 6 - - let ovm_ADD_MOMENTA = 10 - - let ovm_PROPAGATE_SCALAR = 11 - let ovm_PROPAGATE_SPINOR = 12 - let ovm_PROPAGATE_CONJSPINOR = 13 - let ovm_PROPAGATE_UNITARITY = 14 - let ovm_PROPAGATE_FEYNMAN = 15 - let ovm_PROPAGATE_TENSOR2 = 16 - - let ovm_FUSE_VECTOR_PSIBAR_PSI = 21 - let ovm_FUSE_PSI_VECTOR_PSI = 22 - let ovm_FUSE_PSIBAR_PSIBAR_VECTOR = 23 - - type instruction = - { code : int; sign : int; coupl : int; - lhs : int; rhs1 : int; rhs2 : int } - - let printi i = - printf "@\n%3d %3d %3d %3d %3d %3d" - i.code i.sign i.coupl i.lhs i.rhs1 i.rhs2 - - let load lhs f rhs = - let code = - match M.lorentz f with - | Scalar -> ovm_LOAD_SCALAR - | Spinor -> ovm_LOAD_U - | ConjSpinor -> ovm_LOAD_UBAR - | Majorana -> failwith "load: Majoranas not implemented yet" - | Maj_Ghost -> failwith "load: SUSY ghosts not implemented yet" - | Vector | Massive_Vector -> ovm_LOAD_VECTOR - | Vectorspinor -> invalid_arg "external spin must be <=1" - | Tensor_1 -> invalid_arg "Tensor_1 only internal" - | Tensor_2 -> invalid_arg "external spin must be <= 1" - | BRS _ -> invalid_arg "no BRST" - in - { code = code; sign = 0; coupl = M.pdg f; - lhs = lhs; rhs1 = rhs; rhs2 = rhs } - - let print_external count flavor = - printi (load count (F.flavor flavor) count); - succ count - - let print_externals amplitude = - printf "@\n@[<2>BEGIN EXTERNALS"; - ignore (List.fold_left print_external 1 (F.externals amplitude)); - printf "@]@\nEND EXTERNALS" - - let print_current rhs = - match F.coupling rhs with - | V3 (vertex, fusion, constant) -> printf "@\nV3" - | V4 (vertex, fusion, constant) -> printf "@\nV4" - | Vn (_, _, _) -> printf "@\nVn" - - let p2s p = - if p >= 0 && p <= 9 then - string_of_int p - else if p <= 36 then - String.make 1 (Char.chr (Char.code 'A' + p - 10)) - else - "_" - - let format_p wf = - String.concat "" (List.map p2s (F.momentum_list wf)) - - let print_fusion fusion = - let lhs = F.lhs fusion in - let f = F.flavor lhs in - (*i let momentum = format_p lhs in i*) - List.iter print_current (F.rhs fusion); - let propagate code = - printi { code = code; sign = 0; coupl = 0; - lhs = int_of_string (format_p lhs); - rhs1 = abs (M.pdg f); rhs2 = abs (M.pdg f) } in - match M.propagator f with - | Prop_Scalar -> propagate ovm_PROPAGATE_SCALAR - | Prop_Col_Scalar -> - failwith "print_fusion: Prop_Col_Scalar not implemented yet!" - | Prop_Ghost -> - failwith "print_fusion: Prop_Ghost not implemented yet!" - | Prop_Spinor -> propagate ovm_PROPAGATE_SPINOR - | Prop_ConjSpinor -> propagate ovm_PROPAGATE_CONJSPINOR - | Prop_Majorana | Prop_Col_Majorana -> - failwith "print_fusion: Prop_Majorana not implemented yet!" - | Prop_Unitarity -> propagate ovm_PROPAGATE_UNITARITY - | Prop_Col_Unitarity -> - failwith "print_fusion: Prop_Col_Unitarity not implemented yet!" - | Prop_Feynman -> propagate ovm_PROPAGATE_FEYNMAN - | Prop_Col_Feynman -> - failwith "print_fusion: Prop_Col_Feynman not implemented yet!" - | Prop_Gauge xi -> - failwith "print_fusion: Prop_Gauge not implemented yet!" - | Prop_Rxi xi -> - failwith "print_fusion: Prop_Rxi not implemented yet!" - | Prop_Vectorspinor -> - failwith "print_fusion: Prop_Vectorspinor not implemented yet!" - | Prop_Tensor_2 -> propagate ovm_PROPAGATE_TENSOR2 - | Aux_Scalar | Aux_Spinor | Aux_ConjSpinor | Aux_Majorana - | Aux_Vector | Aux_Tensor_1 -> () - | Only_Insertion -> () - - module P = Set.Make (struct type t = int list let compare = compare end) - - let rec add_momenta lhs = function - | [] | [_] -> invalid_arg "add_momenta" - | [rhs1; rhs2] -> - printi { code = ovm_ADD_MOMENTA; sign = 0; coupl = 0; - lhs = int_of_string (format_p lhs); - rhs1 = int_of_string (format_p rhs1); - rhs2 = int_of_string (format_p rhs2) } - | rhs1 :: rhs -> - add_momenta lhs rhs; - add_momenta lhs [lhs; rhs1] - - let print_fusions amplitude = - printf "@\n@[<2>BEGIN FUSIONS"; - let momenta = - List.fold_left (fun seen f -> - let wf = F.lhs f in - let p = F.momentum_list wf in - let momentum = format_p wf in - if not (P.mem p seen) then - add_momenta wf (F.children (List.hd (F.rhs f))); - print_fusion f; - P.add p seen) P.empty (F.fusions amplitude) - in - printf "@]@\nEND FUSIONS" - - let print_brakets amplitude = - printf "@\n@[<2>BEGIN BRAKETS"; - printf "@\n!!! not implemented yet !!!"; - printf "@]@\nEND BRAKETS" - - let print_fudge_factor amplitude = - printf "@\n@[<2>BEGIN FUDGE"; - printf "@\n!!! not implemented yet !!!"; - printf "@]@\nEND FUDGE" - - let amplitude_to_channel oc diagnostics amplitude = - set_formatter_out_channel oc; - printf "@\n@[<2>BEGIN AMPLITUDE %s" (format_process amplitude); - print_externals amplitude; - print_fusions amplitude; - print_brakets amplitude; - print_fudge_factor amplitude; - printf "@]@\nEND AMPLITUDE" - - let amplitudes_to_channel oc diagnostics amplitudes = - List.iter (amplitude_to_channel oc diagnostics) (MF.allowed amplitudes) - - let parameters_to_channel oc = - set_formatter_out_channel oc; - (*i let params = M.parameters () in i*) - printf "@[<2>BEGIN PARAMETERS@\n"; - printf "!!! not implemented yet !!!@]@\n"; - printf "END PARAMETERS@\n" - - end - -i*) - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/f90_Littlest_Eta.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/f90_Littlest_Eta.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/f90_Littlest_Eta.ml (revision 8703) @@ -1,33 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -module O = Omega.Make(Fusion.Mixed23)(Targets.Fortran_Majorana) - (Models4.Littlest(Models4.BSM_ungauged)) -let _ = O.main () - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/topology.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/topology.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/topology.ml (revision 8703) @@ -1,894 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -let rcs_file = RCS.parse "Topology" ["Topologies"] - { RCS.revision = "$Revision$"; - RCS.date = "$Date$"; - RCS.author = "$Author$"; - RCS.source - = "$URL$" } - -module type T = - sig - type partition - val partitions : int -> partition list - type 'a children - val keystones : 'a list -> ('a list * 'a list children list) list - val max_subtree : int -> int - val inspect_partition : partition -> int list - val rcs : RCS.t - end - -(* \thocwmodulesection{Factorizing Diagrams for $\phi^3$} *) - -module Binary = - struct - let rcs = RCS.rename rcs_file "Topology.Binary" - ["phi**3 topology"] - - type partition = int * int * int - let inspect_partition (n1, n2, n3) = [n1; n2; n3] - -(* One way~\cite{ALPHA:1997} to lift the degeneracy is to select the - vertex that is closest to the center - (see table~\ref{tab:partition}): - \begin{equation} - \label{eq:partition} - \text{\ocwlowerid{partitions}}: n \to - \bigl\{ (n_1,n_2,n_3) \,\vert\, n_1 + n_2 + n_3 = n - \land n_1 \le n_2 \le n_3 \le \lfloor n/2 \rfloor \bigr\} - \end{equation} - Other, less symmetric, approaches are possible. The simplest - of these is: choose the vertex adjacent to a fixed - external line~\cite{HELAC:2000}. They will be made available - for comparison in the future. - \begin{table} - \begin{center} - \begin{tabular}{r|l} - [n]& [partitions n] \\\hline - 4 & (1,1,2) \\ - 5 & (1,2,2) \\ - 6 & (1,2,3), (2,2,2) \\ - 7 & (1,3,3), (2,2,3) \\ - 8 & (1,3,4), (2,2,4), (2,3,3) \\ - 9 & (1,4,4), (2,3,4), (3,3,3) \\ - 10 & (1,4,5), (2,3,5), (2,4,4), (3,3,4) \\ - 11 & (1,5,5), (2,4,5), (3,3,5), (3,4,4) \\ - 12 & (1,5,6), (2,4,6), (2,5,5), (3,3,6), (3,4,5), (4,4,4) \\ - 13 & (1,6,6), (2,5,6), (3,4,6), (3,5,5), (4,4,5) \\ - 14 & (1,6,7), (2,5,7), (2,6,6), (3,4,7), (3,5,6), (4,4,6), (4,5,5) \\ - 15 & (1,7,7), (2,6,7), (3,5,7), (3,6,6), (4,4,7), (4,5,6), (5,5,5) \\ - 16 & (1,7,8), (2,6,8), (2,7,7), (3,5,8), (3,6,7), (4,4,8), (4,5,7), (4,6,6), (5,5,6) - \end{tabular} - \end{center} - \caption{\label{tab:partition} [partitions n] for moderate values - of [n].} - \end{table} *) - -(* An obvious consequence of~$n_1 + n_2 + n_3 = n$ - and~$n_1 \le n_2 \le n_3$ is $n_1\le\lfloor n/3 \rfloor$: *) - let rec partitions' n n1 = - if n1 > n / 3 then - [] - else - List.map (fun (n2, n3) -> (n1, n2, n3)) - (Partition.pairs (n - n1) n1 (n / 2)) @ partitions' n (succ n1) - - let partitions n = partitions' n 1 - -(* \begin{figure} - \begin{center} - \hfil\\ - \begin{fmfgraph*}(25,20) - \fmfstraight - \fmfbottomn{b}{2} - \fmftopn{t}{1} - \fmf{plain}{t1,v} - \fmf{plain}{b1,v} - \fmf{plain}{b2,v} - \fmfv{d.sh=circle,d.f=empty,d.si=18pt,l=$n$,l.d=0}{b1} - \fmfv{d.sh=circle,d.f=empty,d.si=18pt,l=$n$,l.d=0}{b2} - \fmfv{d.sh=circle,d.f=empty,d.si=18pt,l=$n$,l.d=0}{t1} - \fmfv{d.sh=circle,d.f=empty,d.si=5thin}{v} - \end{fmfgraph*} - \qquad\qquad\qquad\qquad - \begin{fmfgraph*}(25,20) - \fmfstraight - \fmfbottomn{b}{3} - \fmftopn{t}{1} - \fmf{plain}{b1,t1} - \fmf{plain}{b2,t1} - \fmf{plain}{b3,t1} - \fmfv{d.sh=triangle,d.f=empty,d.si=25pt,l=$n$,l.d=0}{b1} - \fmfv{d.sh=triangle,d.f=empty,d.si=25pt,l=$n$,l.d=0}{b2} - \fmfv{d.sh=triangle,d.f=empty,d.si=25pt,l=$n$,l.d=0}{b3} - \fmfv{d.sh=circle,d.f=empty,d.si=5thin}{t1} - \end{fmfgraph*} - \end{center} - \caption{\label{fig:nnn} Topologies with a blatant three-fold - permutation symmetry, if the number of external lines is a - multiple of three} - \end{figure} - \begin{figure} - \begin{center} - \begin{fmfgraph*}(15,20) - \fmfstraight - \fmfbottomn{b}{2} - \fmftopn{t}{1} - \fmf{plain}{b1,v} - \fmf{plain}{b2,v} - \fmf{plain,tension=2}{t1,v} - \fmfv{d.sh=circle,d.f=empty,d.si=18pt,l=$n$,l.d=0}{t1} - \fmfv{d.sh=circle,d.f=empty,d.si=18pt,l=$n'$,l.d=0}{b1} - \fmfv{d.sh=circle,d.f=empty,d.si=18pt,l=$n'$,l.d=0}{b2} - \fmfv{d.sh=circle,d.f=empty,d.si=5thin}{v} - \end{fmfgraph*} - \qquad\qquad\qquad\qquad - \begin{fmfgraph*}(25,20) - \fmfstraight - \fmfbottomn{b}{3} - \fmftopn{t}{1} - \fmf{plain}{b1,t1} - \fmf{plain}{b2,t1} - \fmf{plain}{b3,t1} - \fmfv{d.sh=triangle,d.f=empty,d.si=25pt,l=$n$,l.d=0}{b1} - \fmfv{d.sh=triangle,d.f=empty,d.si=30pt,l=$n'$,l.d=0}{b2} - \fmfv{d.sh=triangle,d.f=empty,d.si=30pt,l=$n'$,l.d=0}{b3} - \fmfv{d.sh=circle,d.f=empty,d.si=5thin}{t1} - \fmfshift{(0,.2h)}{b1} - \end{fmfgraph*} - \qquad\qquad - \begin{fmfgraph*}(25,20) - \fmfstraight - \fmfbottomn{b}{3} - \fmftopn{t}{1} - \fmf{plain}{b1,t1} - \fmf{plain}{b2,t1} - \fmf{plain}{b3,t1} - \fmfv{d.sh=triangle,d.f=empty,d.si=25pt,l=$n'$,l.d=0}{b1} - \fmfv{d.sh=triangle,d.f=empty,d.si=25pt,l=$n'$,l.d=0}{b2} - \fmfv{d.sh=triangle,d.f=empty,d.si=30pt,l=$n$,l.d=0}{b3} - \fmfv{d.sh=circle,d.f=empty,d.si=5thin}{t1} - \fmfshift{(0,.2h)}{b1,b2} - \end{fmfgraph*} - \end{center} - \caption{\label{fig:n1n2n2} Topologies with a blatant two-fold symmetry.} - \end{figure} - \begin{figure} - \begin{center} - \hfil\\ - \begin{fmfgraph*}(25,20) - \fmfstraight - \fmfbottomn{b}{3} - \fmftopn{t}{1} - \fmf{plain}{b1,t1} - \fmf{plain}{b2,t1} - \fmf{plain}{b3,t1} - \fmfv{d.sh=triangle,d.f=empty,d.si=25pt,l=$n_1$,l.d=0}{b1} - \fmfv{d.sh=triangle,d.f=empty,d.si=30pt,l=$n_2$,l.d=0}{b2} - \fmfv{d.sh=triangle,d.f=empty,d.si=35pt,l=$n_3$,l.d=0}{b3} - \fmfv{d.sh=circle,d.f=empty,d.si=5thin}{t1} - \fmfshift{(0,.30h)}{b1} - \fmfshift{(0,.15h)}{b2} - \end{fmfgraph*} - \qquad\qquad - \begin{fmfgraph*}(25,20) - \fmfstraight - \fmfbottomn{b}{3} - \fmftopn{t}{1} - \fmf{plain}{b1,t1} - \fmf{plain}{b2,t1} - \fmf{plain}{b3,t1} - \fmfv{d.sh=triangle,d.f=empty,d.si=25pt,l=$n$,l.d=0}{b1} - \fmfv{d.sh=triangle,d.f=empty,d.si=25pt,l=$n$,l.d=0}{b2} - \fmfv{d.sh=triangle,d.f=empty,d.si=35pt,l=$2n$,l.d=0}{b3} - \fmfv{d.sh=circle,d.f=empty,d.si=5thin}{t1} - \fmfshift{(0,.20h)}{b1} - \fmfshift{(0,.20h)}{b2} - \end{fmfgraph*} - \end{center} - \caption{\label{fig:n1n2n3} If~$n_3=n_1+n_2$, the apparently - asymmetric topologies on the left hand side have a non obvious - two-fold symmetry, that exchanges the two halves. Therefore, - the topologies on the right hand side have a four fold symmetry.} - \end{figure} *) - - type 'a children = 'a Tuple.Binary.t - -(* There remains one peculiar case, when the number of external lines is - even and~$n_3=n_1+n_2$ (cf.~figure~\ref{fig:n1n2n3}). - Unfortunately, this reflection symmetry is not respected by the equivalence - classes. E.\,g. - \begin{equation} - \{1\}\{2,3\}\{4,5,6\}\mapsto\bigl\{ - \{4\}\{5,6\}\{1,2,3\}; \{5\}\{4,6\}\{1,2,3\}; \{6\}\{4,5\}\{1,2,3\} \bigr\} - \end{equation} - However, these reflections will always exchange the two halves - and a representative can be chosen by requiring that one fixed - momentum remains in one half. We choose to filter out the half - of the partitions where the element~[p] appears in the second - half, i.\,e.~the list of length~[n3]. - - Finally, a closed expression for the number of Feynman diagrams - in the equivalence class $(n_1,n_2,n_3)$ is - \begin{equation} - N(n_1,n_2,n_3) = - \frac{(n_1+n_2+n_3)!}{S(n_1,n_2,n_3)} - \prod_{i=1}^{3} \frac{(2n_i-3)!!}{n_i!} - \end{equation} - where the symmetry factor from the above arguments is - \begin{equation} - \label{eq:S(1,2,3)} - S(n_1,n_2,n_3) = - \begin{cases} - 3! & \text{for $n_1 = n_2 = n_3$} \\ - 2\cdot2 & \text{for $n_3 = 2n_1 = 2n_2$} \\ - 2 & \text{for $n_1 = n_2 \lor n_2 = n_3$} \\ - 2 & \text{for $n_1 + n_2 = n_3$} - \end{cases} - \end{equation} - Indeed, the sum of all Feynman diagrams - \begin{equation} - \label{eq:keystone-check} - \sum_{\substack{n_1 + n_2 + n_3 = n\\ - 1 \le n_1 \le n_2 \le n_3 \le \lfloor n/2 \rfloor}} - N(n_1,n_2,n_3) = (2n-5)!! - \end{equation} - can be checked numerically for large values of $n=n_1+n_2+n_3$, - verifying the symmetry factor (see table~\ref{tab:keystone-check}). - \begin{dubious} - P.\,M.~claims to have seen similar formulae in the context of - Young tableaux. That's a good occasion to read the new edition - of Howard's book \ldots - \end{dubious} - \begin{table} - \begin{center} - \begin{tabular}{r|r|l} - $n$ & $(2n-5)!!$ & $\sum N(n_1,n_2,n_3)$ \\\hline - 4 & 3 & $3\cdot(1,1,2)$ \\ - 5 & 15 & $15\cdot(1,2,2)$ \\ - 6 & 105 & $90\cdot(1,2,3) + 15\cdot(2,2,2)$ \\ - 7 & 945 & $630\cdot(1,3,3) + 315\cdot(2,2,3)$ \\ - 8 & 10395 & $6300\cdot(1,3,4) + 1575\cdot(2,2,4) + 2520\cdot(2,3,3)$ \\ - 9 & 135135 & $70875\cdot(1,4,4) + 56700\cdot(2,3,4) + 7560\cdot(3,3,3)$ \\ - 10 & 2027025 & $992250\cdot(1,4,5) + 396900\cdot(2,3,5)$ \\ - & & \quad$\mbox{}+ 354375\cdot(2,4,4) + 283500\cdot(3,3,4)$ \\ - 11 & 34459425 & $15280650\cdot(1,5,5) + 10914750\cdot(2,4,5)$ \\ - & & \quad$\mbox{}+ 4365900\cdot(3,3,5) + 3898125\cdot(3,4,4)$ \\ - 12 & 654729075 & $275051700\cdot(1,5,6) + 98232750\cdot(2,4,6)$ \\ - & & \quad$\mbox{}+ 91683900\cdot(2,5,5)+ 39293100\cdot(3,3,6)$ \\ - & & \quad$\mbox{}+ 130977000\cdot(3,4,5) + 19490625\cdot(4,4,4)$ - \end{tabular} - \end{center} - \caption{\label{tab:keystone-check} Equation~(\ref{eq:keystone-check}) for - small values of $n$.} - \end{table} *) - -(* Return a list of all inequivalent partitions of the list~[l] in three - lists of length [n1], [n2] and [n3], respectively. Common first lists - are factored. This is nothing more than a typedafe wrapper around - [Combinatorics.factorized_keystones]. *) - - exception Impossible of string - let tuple_of_list2 = function - | [x1; x2] -> Tuple.Binary.of2 x1 x2 - | _ -> raise (Impossible "Topology.tuple_of_list") - - let keystone (n1, n2, n3) l = - List.map (fun (p1, p23) -> (p1, List.rev_map tuple_of_list2 p23)) - (Combinatorics.factorized_keystones [n1; n2; n3] l) - - let keystones l = - ThoList.flatmap (fun n123 -> keystone n123 l) (partitions (List.length l)) - - let max_subtree n = n / 2 - - end - -(* \thocwmodulesection{Factorizing Diagrams for $\sum_n\lambda_n\phi^n$} *) - -(* \begin{figure} - \begin{center} - \begin{fmfgraph}(25,20) - \fmfleftn{l}{3} - \fmfrightn{r}{3} - \fmf{plain}{l1,v4} - \fmf{plain}{l2,v4} - \fmf{plain}{l3,v4} - \fmf{plain}{r1,v1} - \fmf{plain}{r2,v1} - \fmf{plain}{v1,v2} - \fmf{plain}{r3,v2} - \fmf{plain}{v2,v4} - \fmfv{d.sh=circle,d.f=empty,d.si=5thin}{v4} - \fmfdot{v1,v2} - \end{fmfgraph} - \qquad\qquad - \begin{fmfgraph}(25,20) - \fmfleftn{l}{3} - \fmfrightn{r}{3} - \fmf{plain}{l1,v4} - \fmf{plain}{l2,v4} - \fmf{plain}{l3,v4} - \fmf{plain}{r1,v1} - \fmf{plain}{r2,v1} - \fmf{plain}{v1,v2} - \fmf{plain}{r3,v2} - \fmf{plain}{v2,v4} - \fmfv{d.sh=circle,d.f=empty,d.si=5thin}{v2} - \fmfdot{v1,v4} - \end{fmfgraph} - \end{center} - \caption{\label{fig:n1n2n3n4} Degenerate $(1,1,1,3)$ and $(1,2,3)$.} - \end{figure} *) - -(* Mixed $\phi^n$ adds new degeneracies, as in figure~\ref{fig:n1n2n3n4}. - They appear if and only if one part takes exactly half of the external - lines and can relate central vertices of different arity. *) - -module Nary (B : Tuple.Bound) = - struct - let rcs = RCS.rename rcs_file "Topology.Nary" - ["phi**n topology"] - - type partition = int list - let inspect_partition p = p - - let partition d sum = - Partition.tuples d sum 1 (sum / 2) - - let rec partitions' d sum = - if d < 3 then - [] - else - partition d sum @ partitions' (pred d) sum - - let partitions sum = partitions' (succ B.max_arity) sum - -(* \begin{table} - \begin{center} - \begin{tabular}{r|r|l} - $n$ & $\sum$ & $\sum$ \\\hline - 4 & 4 & $1\cdot(1,1,1,1) + 3\cdot(1,1,2)$ \\ - 5 & 25 & $10\cdot(1,1,1,2) + 15\cdot(1,2,2)$ \\ - 6 & 220 & $40\cdot(1,1,1,3) + 45\cdot(1,1,2,2) - + 120\cdot(1,2,3) + 15\cdot(2,2,2)$ \\ - 7 & 2485 & $840\cdot(1,1,2,3) + 105\cdot(1,2,2,2) - + 1120\cdot(1,3,3) + 420\cdot(2,2,3)$ \\ - 8 & 34300 & $5250\cdot(1,1,2,4) + 4480\cdot(1,1,3,3) + 3360\cdot(1,2,2,3)$\\ - & & \quad$\mbox{}+ 105\cdot(2,2,2,2) + 14000\cdot(1,3,4)$\\ - & & \quad$\mbox{}+ 2625\cdot(2,2,4) + 4480\cdot(2,3,3)$ \\ - 9 & 559405 & $126000\cdot(1,1,3,4) + 47250\cdot(1,2,2,4) + 40320\cdot(1,2,3,3)$\\ - & & \quad$\mbox{}+ 5040\cdot(2,2,2,3) + 196875\cdot(1,4,4)$\\ - & & \quad$\mbox{}+ 126000\cdot(2,3,4) + 17920\cdot(3,3,3)$ \\ - 10 & 10525900 & $1108800\cdot(1,1,3,5) + 984375\cdot(1,1,4,4) + 415800\cdot(1,2,2,5)$\\ - & & \quad$\mbox{}+ 1260000\cdot(1,2,3,4) + 179200\cdot(1,3,3,3) - + 78750\cdot(2,2,2,4)$\\ - & & \quad$\mbox{}+ 100800\cdot(2,2,3,3) + 3465000\cdot(1,4,5) - + 1108800\cdot(2,3,5)$\\ - & & \quad$\mbox{}+ 984375\cdot(2,4,4) + 840000\cdot(3,3,4)$ - \end{tabular} - \end{center} - \caption{\label{tab:keystone-check4}% - $\mathcal{L}=\lambda_3\phi^3+\lambda_4\phi^4$} - \end{table} - \begin{table} - \begin{center} - \begin{tabular}{r|r|l} - $n$ & $\sum$ & $\sum$ \\\hline - 4 & 4 & $1\cdot(1,1,1,1) + 3\cdot(1,1,2)$ \\ - 5 & 26 & $1\cdot(1,1,1,1,1) + 10\cdot(1,1,1,2) + 15\cdot(1,2,2)$ \\ - 6 & 236 & $1\cdot(1,1,1,1,1,1) + 15\cdot(1,1,1,1,2) + 40\cdot(1,1,1,3)$\\ - & & \quad$\mbox{}+ 45\cdot(1,1,2,2) + 120\cdot(1,2,3) + 15\cdot(2,2,2)$ \\ - 7 & 2751 & $21\cdot(1,1,1,1,1,2) + 140\cdot(1,1,1,1,3) + 105\cdot(1,1,1,2,2)$\\ - & & \quad$\mbox{}+ 840\cdot(1,1,2,3) + 105\cdot(1,2,2,2) - + 1120\cdot(1,3,3) + 420\cdot(2,2,3)$ \\ - 8 & 39179 & $224\cdot(1,1,1,1,1,3) + 210\cdot(1,1,1,1,2,2) + 910\cdot(1,1,1,1,4)$\\ - & & \quad$\mbox{}+ 2240\cdot(1,1,1,2,3) + 420\cdot(1,1,2,2,2) - + 5460\cdot(1,1,2,4)$\\ - & & \quad$\mbox{}+ 4480\cdot(1,1,3,3) + 3360\cdot(1,2,2,3) - + 105\cdot(2,2,2,2)$\\ - & & \quad$\mbox{}+ 14560\cdot(1,3,4) + 2730\cdot(2,2,4) + 4480\cdot(2,3,3)$ - \end{tabular} - \end{center} - \caption{\label{tab:keystone-check6}% - $\mathcal{L}=\lambda_3\phi^3+\lambda_4\phi^4+\lambda_5\phi^5+\lambda_6\phi^6$} - \end{table} *) - - module Tuple = Tuple.Nary(B) - type 'a children = 'a Tuple.t - - let keystones' l = - let n = List.length l in - ThoList.flatmap (fun p -> Combinatorics.factorized_keystones p l) - (partitions n) - - let keystones l = - List.map (fun (bra, kets) -> (bra, List.map Tuple.of_list kets)) - (keystones' l) - - let max_subtree n = n / 2 - - end - -module Nary4 = Nary (struct let max_arity = 3 end) - -(* \thocwmodulesection{Factorizing Diagrams for $\phi^4$} *) - -module Ternary = - struct - let rcs = RCS.rename rcs_file "Topology.Ternary" - ["phi**4 topology"] - let rcs = rcs_file - type partition = int * int * int * int - let inspect_partition (n1, n2, n3, n4) = [n1; n2; n3; n4] - type 'a children = 'a Tuple.Ternary.t - let collect4 acc = function - | [x; y; z; u] -> (x, y, z, u) :: acc - | _ -> acc - let partitions n = - List.fold_left collect4 [] (Nary4.partitions n) - let collect3 acc = function - | [x; y; z] -> Tuple.Ternary.of3 x y z :: acc - | _ -> acc - let keystones l = - List.map (fun (bra, kets) -> (bra, List.fold_left collect3 [] kets)) - (Nary4.keystones' l) - let max_subtree = Nary4.max_subtree - end - -(* \thocwmodulesection{Factorizing Diagrams for $\phi^3+\phi^4$} *) - -module Mixed23 = - struct - let rcs = RCS.rename rcs_file "Topology.Mixed23" - ["phi**3 + phi**4 topology"] - type partition = - | P3 of int * int * int - | P4 of int * int * int * int - let inspect_partition = function - | P3 (n1, n2, n3) -> [n1; n2; n3] - | P4 (n1, n2, n3, n4) -> [n1; n2; n3; n4] - type 'a children = 'a Tuple.Mixed23.t - let collect34 acc = function - | [x; y; z] -> P3 (x, y, z) :: acc - | [x; y; z; u] -> P4 (x, y, z, u) :: acc - | _ -> acc - let partitions n = - List.fold_left collect34 [] (Nary4.partitions n) - let collect23 acc = function - | [x; y] -> Tuple.Mixed23.of2 x y :: acc - | [x; y; z] -> Tuple.Mixed23.of3 x y z :: acc - | _ -> acc - let keystones l = - List.map (fun (bra, kets) -> (bra, List.fold_left collect23 [] kets)) - (Nary4.keystones' l) - let max_subtree = Nary4.max_subtree - end - -(* \thocwmodulesection{% - Diagnostics: Counting Diagrams and Factorizations for $\sum_n\lambda_n\phi^n$} *) - -module type Integer = - sig - type t - val zero : t - val one : t - val ( + ) : t -> t -> t - val ( - ) : t -> t -> t - val ( * ) : t -> t -> t - val ( / ) : t -> t -> t - val pred : t -> t - val succ : t -> t - val ( = ) : t -> t -> bool - val ( <> ) : t -> t -> bool - val ( < ) : t -> t -> bool - val ( <= ) : t -> t -> bool - val ( > ) : t -> t -> bool - val ( >= ) : t -> t -> bool - val of_int : int -> t - val to_int : t -> int - val to_string : t -> string - val compare : t -> t -> int - val factorial : t -> t - end - -(* O'Caml's native integers suffice for all applications, but in - appendix~\ref{sec:count}, we want to use big integers for numeric - checks in high orders: *) - -module Int : Integer = - struct - type t = int - let zero = 0 - let one = 1 - let ( + ) = ( + ) - let ( - ) = ( - ) - let ( * ) = ( * ) - let ( / ) = ( / ) - let pred = pred - let succ = succ - let ( = ) = ( = ) - let ( <> ) = ( <> ) - let ( < ) = ( < ) - let ( <= ) = ( <= ) - let ( > ) = ( > ) - let ( >= ) = ( >= ) - let of_int n = n - let to_int n = n - let to_string = string_of_int - let compare = compare - let factorial = Combinatorics.factorial - end - -module type Count = - sig - type integer - val diagrams : ?f:(integer -> bool) -> integer -> integer -> integer - val diagrams_via_keystones : integer -> integer -> integer - val keystones : integer list -> integer - val diagrams_per_keystone : integer -> integer list -> integer - end - -module Count (I : Integer) = - struct - let rcs = rcs_file - let description = ["(still inoperational) phi^n topology"] - - type integer = I.t - open I - let two = of_int 2 - let three = of_int 3 - -(* If [I.t] is an abstract datatype, the polymorphic [Pervasives.min] - can fail. Provide our own version using the specific comparison - ``[(<=)]''. *) - - let min x y = - if x <= y then - x - else - y - -(* \thocwmodulesubsection{Counting Diagrams for $\sum_n\lambda_n\phi^n$} *) - -(* Classes of diagrams are defined by the number of vertices and their - degrees. We could use fixed size arrays, but we will use a map - instead. For efficiency, we also maintain the number of external - lines and the total number of propagators. *) - - module IMap = Map.Make (struct type t = integer let compare = compare end) - - type diagram_class = { ext : integer; prop : integer; v : integer IMap.t } - -(*i - let to_string cl = - IMap.fold - (fun d n s -> - s ^ Printf.sprintf ", #%s=%s" (to_string d) (to_string n)) cl.v - (Printf.sprintf "#ext=%s, #prop=%s" - (to_string cl.ext) (to_string cl.prop)) -i*) - -(* The numbers of external lines, propagators and vertices are determined - by the degrees and multiplicities of vertices: - \begin{subequations} - \begin{align} - E(\{n_3,n_4,\ldots\}) &= 2 + \sum_{d=3}^{\infty} (d-2)n_d \\ - P(\{n_3,n_4,\ldots\}) &= \sum_{d=3}^{\infty} n_d - 1 - = V(\{n_3,n_4,\ldots\}) - 1 \\ - V(\{n_3,n_4,\ldots\}) &= \sum_{d=3}^{\infty} n_d - \end{align} - \end{subequations} *) - - let num_ext v = - List.fold_left (fun sum (d, n) -> sum + (d - two) * n) two v - - let num_prop v = - List.fold_left (fun sum (_, n) -> sum + n) (zero - one) v - -(* The sum of all vertex degrees must be equal to the number of propagator end - points. This can be verified easily: - \begin{equation} - 2 P(\{n_3,n_4,\ldots\}) + E(\{n_3,n_4,\ldots\}) = \sum_{d=3}^{\infty} dn_d - \end{equation} *) - - let add_degree map (d, n) = - if d < three then - invalid_arg "add_degree: d < 3" - else if n < zero then - invalid_arg "add_degree: n <= 0" - else if n = zero then - map - else - IMap.add d n map - - let create_class v = - { ext = num_ext v; - prop = num_prop v; - v = List.fold_left add_degree IMap.empty v } - - let multiplicity cl d = - if d >= three then - try - IMap.find d cl.v - with - | Not_found -> zero - else - invalid_arg "multiplicity: d < 3" - -(* Remove one vertex of degree [d], maintaining the invariants. Raises - [Zero] if all vertices of degree [d] are exhausted. *) - - exception Zero - - let remove cl d = - let n = pred (multiplicity cl d) in - if n < zero then - raise Zero - else - { ext = cl.ext - (d - two); - prop = pred cl.prop; - v = if n = zero then - IMap.remove d cl.v - else - IMap.add d n cl.v } - -(* Add one vertex of degree [d], maintaining the invariants. *) - - let add cl d = - { ext = cl.ext + (d - two); - prop = succ cl.prop; - v = IMap.add d (succ (multiplicity cl d)) cl.v } - -(* Count the number of diagrams. Any diagram can be obtained recursively either - from a diagram with one ternary vertex less by insertion if a ternary vertex - in an internal or external propagator or from a diagram with a higher order - vertex that has its degree reduced by one: - \begin{multline} - D(\{n_3,n_4,\ldots\}) = \\ - \left(P(\{n_3-1,n_4,\ldots\})+E(\{n_3-1,n_4,\ldots\})\right) - D(\{n_3-1,n_4,\ldots\}) \\ - {} + \sum_{d=4}^{\infty} (n_{d-1} + 1) D(\{n_3,n_4,\ldots,n_{d-1}+1,n_d-1,\ldots\}) - \end{multline} *) - - let rec class_size cl = - if cl.ext = two || cl.prop = zero then - one - else - IMap.fold (fun d _ s -> class_size_n cl d + s) cl.v (class_size_3 cl) - -(* Purely ternary vertices recurse among themselves: *) - - and class_size_3 cl = - try - let d' = remove cl three in - (d'.ext + d'.prop) * class_size d' - with - | Zero -> zero - -(* Vertices of higher degree recurse one step towards lower degrees: *) - - and class_size_n cl d = - if d > three then begin - try - let d' = pred d in - let cl' = add (remove cl d) d' in - multiplicity cl' d' * class_size cl' - with - | Zero -> zero - end else - zero - -(* Find all $\{n_3,n_4,\ldots,n_d\}$ with - \begin{equation} - E(\{n_3,n_4,\ldots,n_d\}) - 2 = \sum_{i=3}^cl (i-2)n_i = \ocwlowerid{sum} - \end{equation} - The implementation is a variant of [tuples] above. *) - - let rec distribute_degrees' d sum = - if d < three then - invalid_arg "distribute_degrees" - else if d = three then - [[(d, sum)]] - else - distribute_degrees'' d sum (sum / (d - two)) - - and distribute_degrees'' d sum n = - if n < zero then - [] - else - List.fold_left (fun ll l -> ((d, n) :: l) :: ll) - (distribute_degrees'' d sum (pred n)) - (distribute_degrees' (pred d) (sum - (d - two) * n)) - -(* Actually, we need to find all $\{n_3,n_4,\ldots,n_d\}$ with - \begin{equation} - E(\{n_3,n_4,\ldots,n_d\}) = \ocwlowerid{sum} - \end{equation} *) - - let distribute_degrees d sum = distribute_degrees' d (sum - two) - -(* Finally we can count all diagrams by adding all possible ways of - splitting the degrees of vertices. We can also count diagrams where - \emph{all} degrees satisfy a predicate [f]: *) - - let diagrams ?(f = fun _ -> true) deg n = - List.fold_left (fun s d -> - if List.for_all (fun (d', n') -> f d' || n' = zero) d then - s + class_size (create_class d) - else - s) - zero (distribute_degrees deg n) - -(* The next two are duplicated from [ThoList] and [Combinatorics], - in order to use the specific comparison functions. *) - - let classify l = - let rec add_to_class a = function - | [] -> [of_int 1, a] - | (n, a') :: rest -> - if a = a' then - (succ n, a) :: rest - else - (n, a') :: add_to_class a rest - in - let rec classify' cl = function - | [] -> cl - | a :: rest -> classify' (add_to_class a cl) rest - in - classify' [] l - - let permutation_symmetry l = - List.fold_left (fun s (n, _) -> factorial n * s) one (classify l) - - let symmetry l = - let sum = List.fold_left (+) zero l in - if List.exists (fun x -> two * x = sum) l then - two * permutation_symmetry l - else - permutation_symmetry l - -(* The number of Feynman diagrams built of vertices with maximum - degree~$d_{\max}$ in a partition $N_{d,n}=\{n_1,n_2,\ldots,n_d\}$ - with $n = n_1 + n_2 + \cdots + n_d$ and - \begin{equation} - \tilde F(d_{\max},N_{d,n}) = - \frac{n!}{|\mathcal{S}(N_{d,n})|\sigma(n_d,n)} - \prod_{i=1}^{d} \frac{F(d_{\max},n_i+1)}{n_i!} - \end{equation} - with~$|\mathcal{S}(N)|$ the size of the symmetric group of~$N$, - $\sigma(n,2n) = 2$ and $\sigma(n,m) = 1$ otherwise. *) - - let keystones p = - let sum = List.fold_left (+) zero p in - List.fold_left (fun acc n -> acc / (factorial n)) (factorial sum) p - / symmetry p - - let diagrams_per_keystone deg p = - List.fold_left (fun acc n -> acc * diagrams deg (succ n)) one p - -(* We must find - \begin{equation} - F(d_{\max},n) = - \sum_{d=3}^{d_{\max}} - \sum_{\substack{N = \{n_1,n_2,\ldots,n_d\}\\ - n_1 + n_2 + \cdots + n_d = n\\ - 1 \le n_1 \le n_2 \le \cdots \le n_d \le \lfloor n/2 \rfloor}} - \tilde F(d_{\max},N) - \end{equation} *) - - let diagrams_via_keystones deg n = - let module N = Nary (struct let max_arity = to_int (pred deg) end) in - List.fold_left - (fun acc p -> acc + diagrams_per_keystone deg p * keystones p) - zero (List.map (List.map of_int) (N.partitions (to_int n))) - - end - -(* \thocwmodulesection{Emulating HELAC} *) - -(* In~\cite{HELAC:2000}, one leg is singled out: *) - -module Helac (B : Tuple.Bound) = - struct - let rcs = RCS.rename rcs_file "Topology.Helac" - ["phi**n topology, Helac style"] - module Tuple = Tuple.Nary(B) - - type partition = int list - let inspect_partition p = p - - let partition d sum = - Partition.tuples d sum 1 (sum - d + 1) - - let rec partitions' d sum = - let d' = pred d in - if d' < 2 then - [] - else - List.map (fun p -> 1::p) (partition d' (pred sum)) @ partitions' d' sum - - let partitions sum = partitions' (succ B.max_arity) sum - - type 'a children = 'a Tuple.t - - let keystones' l = - match l with - | [] -> [] - | head :: tail -> - [([head], - ThoList.flatmap (fun p -> Combinatorics.partitions (List.tl p) tail) - (partitions (List.length l)))] - - let keystones l = - List.map (fun (bra, kets) -> (bra, List.map Tuple.of_list kets)) - (keystones' l) - - let max_subtree n = pred n - end - -(* \begin{dubious} - The following is not tested, but it is no rocket science either \ldots - \end{dubious} *) - -module Helac_Binary = - struct - let rcs = RCS.rename rcs_file "Topology.Helac_Binary" - ["phi**3 topology, Helac style"] - - type partition = int * int * int - let inspect_partition (n1, n2, n3) = [n1; n2; n3] - - let partitions sum = - List.map (fun (n2, n3) -> (1, n2, n3)) - (Partition.pairs (sum - 1) 1 (sum - 2)) - - type 'a children = 'a Tuple.Binary.t - - let keystones' l = - match l with - | [] -> [] - | head :: tail -> - [([head], - ThoList.flatmap (fun (_, p2, _) -> Combinatorics.split p2 tail) - (partitions (List.length l)))] - - let keystones l = - List.map (fun (bra, kets) -> - (bra, List.map (fun (x, y) -> Tuple.Binary.of2 x y) kets)) - (keystones' l) - - let max_subtree n = pred n - - end - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) - - - Index: branches/ohl/omega-development/completed/whizard2/src/color.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/color.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/color.ml (revision 8703) @@ -1,1570 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -(* \thocwmodulesection{Quantum Numbers} *) - -type t = - | Singlet - | SUN of int - | AdjSUN of int - -let conjugate = function - | Singlet -> Singlet - | SUN n -> SUN (-n) - | AdjSUN n -> AdjSUN n - -module type NC = - sig - val nc : int - end -module NC3 = struct let nc = 3 end - -(* \thocwmodulesection{Color Flows} *) - -module type Flow = - sig - type color - type t = color list * color list - val rank : t -> int - val of_list : int list -> color - val ghost : unit -> color - val to_lists : t -> int list list - val in_to_lists : t -> int list list - val out_to_lists : t -> int list list - val ghost_flags : t -> bool list - val in_ghost_flags : t -> bool list - val out_ghost_flags : t -> bool list - end - -module Flow : Flow = - struct - - type color = - | Lines of int * int - | Ghost - - type t = color list * color list - - let rank cflow = - 2 - -(* \thocwmodulesubsection{Constructors} *) - - let ghost () = - Ghost - - let of_list = function - | [c1; c2] -> Lines (c1, c2) - | _ -> invalid_arg "Color.Flow.of_list: num_lines != 2" - - let to_list = function - | Lines (c1, c2) -> [c1; c2] - | Ghost -> [0; 0] - - let to_lists (cfin, cfout) = - (List.map to_list cfin) @ (List.map to_list cfout) - - let in_to_lists (cfin, _) = - List.map to_list cfin - - let out_to_lists (_, cfout) = - List.map to_list cfout - - let ghost_flag = function - | Lines _ -> false - | Ghost -> true - - let ghost_flags (cfin, cfout) = - (List.map ghost_flag cfin) @ (List.map ghost_flag cfout) - - let in_ghost_flags (cfin, _) = - List.map ghost_flag cfin - - let out_ghost_flags (_, cfout) = - List.map ghost_flag cfout - - end - -(* later: *) -module General_Flow = - struct - - type color = - | Lines of int list - | Ghost of int - - type t = color list * color list - - let rank_default = 2 (* Standard model *) - - let rank cflow = - try - begin match List.hd cflow with - | Lines lines -> List.length lines - | Ghost n_lines -> n_lines - end - with - | _ -> rank_default - end - -(*i -(* \thocwmodulesection{Realistic Amplitudes} *) - -type ('a, 'e) amplitude = - | S of ('a, 'e) sng - | F of ('a, 'e) fnd - | C of ('a, 'e) cjg - | A of ('a, 'e) adj - -and ('a, 'e) sng = - | S_ext of 'a * 'e - | S_of_S of 'a * ('a, 'e) sng list - | S_of_FC of 'a * ('a, 'e) fnd * ('a, 'e) cjg * ('a, 'e) sng list - -and ('a, 'e) fnd = - | F_ext of 'a * 'e - | F_of_F of 'a * ('a, 'e) fnd * ('a, 'e) sng list - | F_of_FA of 'a * ('a, 'e) fnd * ('a, 'e) adj * ('a, 'e) sng list - -and ('a, 'e) cjg = - | C_ext of 'a * 'e - | C_of_C of 'a * ('a, 'e) cjg * ('a, 'e) sng list - | C_of_CA of 'a * ('a, 'e) cjg * ('a, 'e) adj * ('a, 'e) sng list - -and ('a, 'e) adj = - | A_ext of 'a * 'e - | A_of_FC of 'a * ('a, 'e) fnd * ('a, 'e) cjg * ('a, 'e) sng list - | A_of_A of 'a * ('a, 'e) adj * ('a, 'e) sng list - | A_of_AA of 'a * ('a, 'e) adj * ('a, 'e) adj * ('a, 'e) sng list - -(* \thocwmodulesubsection{Construction} *) - -exception Mismatch -exception Impossible_quartic -exception Incomplete - -let ext c tag ext_tag = - match c with - | Singlet -> S (S_ext (tag, ext_tag)) - | SUN n when n > 0 -> F (F_ext (tag, ext_tag)) - | SUN n -> C (C_ext (tag, ext_tag)) - | AdjSUN n -> A (A_ext (tag, ext_tag)) - -let fuse2 color tag a1 a2 = - match a1, a2 with - | S s1, S s2 -> - begin match color with - | Singlet -> - begin match s1, s2 with - | (S_ext _ as s), S_of_S (_, slist) - | S_of_S (_, slist), (S_ext _ as s) -> - S (S_of_S (tag, List.sort compare (s :: slist))) - | S_of_S (_, slist1), S_of_S (_, slist2) -> - S (S_of_S (tag, List.sort compare (slist1 @ slist2))) - | _, _ -> - if s1 < s2 then - S (S_of_S (tag, [s1; s2])) - else - S (S_of_S (tag, [s2; s1])) - end - | _ -> raise Mismatch - end - | S s, F f | F f, S s -> - begin match color with - | SUN n when n > 0 -> F (F_of_F (tag, f, [s])) - | _ -> raise Mismatch - end - | S s, C c | C c, S s -> - begin match color with - | SUN n when n < 0 -> C (C_of_C (tag, c, [s])) - | _ -> raise Mismatch - end - | S s, A a | A a, S s -> - begin match color with - | AdjSUN n -> A (A_of_A (tag, a, [s])) - | _ -> raise Mismatch - end - | F _, F _ -> raise Mismatch - | F f, C c | C c, F f -> - begin match color with - | AdjSUN n -> A (A_of_FC (tag, f, c, [])) - | Singlet -> S (S_of_FC (tag, f, c, [])) - | _ -> raise Mismatch - end - | F f, A a | A a, F f -> - begin match color with - | SUN n when n > 0 -> F (F_of_FA (tag, f, a, [])) - | _ -> raise Mismatch - end - | C _, C _ -> raise Mismatch - | C c, A a | A a, C c -> - begin match color with - | SUN n when n < 0 -> C (C_of_CA (tag, c, a, [])) - | _ -> raise Mismatch - end - -(* We must not redorder gluonic children, because the Feynman rule - is antisymmetric: *) - | A a1, A a2 -> - begin match color with - | AdjSUN n -> A (A_of_AA (tag, a1, a2, [])) - | _ -> raise Mismatch - end - -(* The color amplitude factorizes \emph{only} for three gluon vertices and - the four gluon vertices have to be implemented using an auxiliary field! *) - -let fuse3 color tag a1 a2 a3 = - match a1, a2, a3 with - | A a1, A a2, A a3 -> raise Impossible_quartic - | S s1, S s2, S s3 -> - begin match color with - | Singlet -> S (S_of_S (tag, List.sort compare [s1; s2; s3])) - | _ -> raise Mismatch - end - | _, _, _ -> raise Incomplete - -let fuse color tag = function - | [a1; a2] -> fuse2 color tag a1 a2 - | [a1; a2; a3] -> fuse3 color tag a1 a2 a3 - | _ -> raise Incomplete - -let of_tree color proj tree = - Tree.fold - (fun node leaf -> ext (color node) (proj node) leaf) - (fun node -> fuse (color node) (proj node)) - tree - -(* \thocwmodulesubsection{Functionals} *) - -type ('tag, 'ext, 'sng, 'fnd, 'cjg, 'adj, 'a) fold_functions = - { s_ext : ('tag -> 'ext -> 'sng); - s_of_s : ('tag -> 'sng list -> 'sng); - s_of_fc : ('tag -> 'fnd -> 'cjg -> 'sng list -> 'sng); - s_final : ('sng -> 'a); - f_ext : ('tag -> 'ext -> 'fnd); - f_of_f : ('tag -> 'fnd -> 'sng list -> 'fnd); - f_of_fa : ('tag -> 'fnd -> 'adj -> 'sng list -> 'fnd); - f_final : ('fnd -> 'a); - c_ext : ('tag -> 'ext -> 'cjg); - c_of_c : ('tag -> 'cjg -> 'sng list -> 'cjg); - c_of_ca : ('tag -> 'cjg -> 'adj -> 'sng list -> 'cjg); - c_final : ('cjg -> 'a); - a_ext : ('tag -> 'ext -> 'adj); - a_of_a : ('tag -> 'adj -> 'sng list -> 'adj); - a_of_aa : ('tag -> 'adj -> 'adj -> 'sng list -> 'adj); - a_of_fc : ('tag -> 'fnd -> 'cjg -> 'sng list -> 'adj); - a_final : ('adj -> 'a) } - -let rec fold_sng fct = function - | S_ext (tag, ext_tag) -> fct.s_ext tag ext_tag - | S_of_S (tag, s) -> fct.s_of_s tag (List.map (fold_sng fct) s) - | S_of_FC (tag, f, c, s) -> - fct.s_of_fc tag (fold_fnd fct f) (fold_cjg fct c) (List.map (fold_sng fct) s) - -and fold_fnd fct = function - | F_ext (tag, ext_tag) -> fct.f_ext tag ext_tag - | F_of_F (tag, f, s) -> - fct.f_of_f tag (fold_fnd fct f) (List.map (fold_sng fct) s) - | F_of_FA (tag, f, a, s) -> - fct.f_of_fa tag (fold_fnd fct f) (fold_adj fct a) (List.map (fold_sng fct) s) - -and fold_cjg fct = function - | C_ext (tag, ext_tag) -> fct.c_ext tag ext_tag - | C_of_C (tag, c, s) -> - fct.c_of_c tag (fold_cjg fct c) (List.map (fold_sng fct) s) - | C_of_CA (tag, c, a, s) -> - fct.c_of_ca tag (fold_cjg fct c) (fold_adj fct a) (List.map (fold_sng fct) s) - -and fold_adj fct = function - | A_ext (tag, ext_tag) -> fct.a_ext tag ext_tag - | A_of_A (tag, a, s) -> - fct.a_of_a tag (fold_adj fct a) (List.map (fold_sng fct) s) - | A_of_FC (tag, f, c, s) -> - fct.a_of_fc tag (fold_fnd fct f) (fold_cjg fct c) (List.map (fold_sng fct) s) - | A_of_AA (tag, a1, a2, s) -> - fct.a_of_aa tag (fold_adj fct a1) (fold_adj fct a2) - (List.map (fold_sng fct) s) - -let fold fct = function - | S s -> fct.s_final (fold_sng fct s) - | F f -> fct.f_final (fold_fnd fct f) - | C c -> fct.c_final (fold_cjg fct c) - | A a -> fct.a_final (fold_adj fct a) - -(*i (* THIS IS FUN, BUT NOT REQUIRED ANYMORE!!! *) - -let rec fold2_sng f2 f1 = function - | S_ext (tag, ext_tag) -> f2.s_ext tag ext_tag - | S_of_S (tag, s) -> f2.s_of_s tag (List.map (fold2_sng f1 f1) s) - | S_of_FC (tag, f, c, s) -> - f2.s_of_fc tag (fold2_fnd f1 f1 f) (fold2_cjg f1 f1 c) - (List.map (fold2_sng f1 f1) s) - -and fold2_fnd f2 f1 = function - | F_ext (tag, ext_tag) -> f2.f_ext tag ext_tag - | F_of_F (tag, f, s) -> - f2.f_of_f tag (fold2_fnd f1 f1 f) (List.map (fold2_sng f1 f1) s) - | F_of_FA (tag, f, a, s) -> - f2.f_of_fa tag (fold2_fnd f1 f1 f) (fold2_adj f1 f1 a) - (List.map (fold2_sng f1 f1) s) - -and fold2_cjg f2 f1 = function - | C_ext (tag, ext_tag) -> f2.c_ext tag ext_tag - | C_of_C (tag, c, s) -> - f2.c_of_c tag (fold2_cjg f1 f1 c) (List.map (fold2_sng f1 f1) s) - | C_of_CA (tag, c, a, s) -> - f2.c_of_ca tag (fold2_cjg f1 f1 c) (fold2_adj f1 f1 a) - (List.map (fold2_sng f1 f1) s) - -and fold2_adj f2 f1 = function - | A_ext (tag, ext_tag) -> f2.a_ext tag ext_tag - | A_of_A (tag, a, s) -> - f2.a_of_a tag (fold2_adj f1 f1 a) (List.map (fold2_sng f1 f1) s) - | A_of_FC (tag, f, c, s) -> - f2.a_of_fc tag (fold2_fnd f1 f1 f) (fold2_cjg f1 f1 c) - (List.map (fold2_sng f1 f1) s) - | A_of_AA (tag, a1, a2, s) -> - f2.a_of_aa tag (fold2_adj f1 f1 a1) (fold2_adj f1 f1 a2) - (List.map (fold2_sng f1 f1) s) - -let fold2 f2 f1 = function - | S s -> f2.s_final (fold2_sng f2 f1 s) - | F f -> f2.f_final (fold2_fnd f2 f1 f) - | C c -> f2.c_final (fold2_cjg f2 f1 c) - | A a -> f2.a_final (fold2_adj f2 f1 a) - -let fold f = fold2 f f -i*) - -(* \thocwmodulesubsection{Printing} *) - -let to_string_fold_functions fmt fmt_ext = - let outer pfx s = - (* [pfx ^ ":" ^] *) s - and ext pfx tag ext_tag = - "<" ^ pfx ^ fmt_ext ext_tag ^ ">" - and fuse pfx tag children = - "<" ^ pfx ^ fmt tag ^ ">(" ^ String.concat "," children ^ ")" in - let fuse1 pfx tag child children = - fuse pfx tag (child :: children) - and fuse2 pfx tag child1 child2 children = - fuse pfx tag (child1 :: child2 :: children) - (*i and fuse3 pfx tag child1 child2 child3 children = - fuse pfx tag (child1 :: child2 :: child3 :: children) i*) in - { s_ext = ext "S"; - s_of_s = fuse "S"; - s_of_fc = fuse2 "S"; - s_final = outer "S"; - f_ext = ext "F"; - f_of_f = fuse1 "F"; - f_of_fa = fuse2 "F"; - f_final = outer "F"; - c_ext = ext "C"; - c_of_c = fuse1 "C"; - c_of_ca = fuse2 "C"; - c_final = outer "C"; - a_ext = ext "A"; - a_of_a = fuse1 "A"; - a_of_aa = fuse2 "A"; - a_of_fc = fuse2 "A"; - a_final = outer "A" } - -let to_string fmt fmt_ext = fold (to_string_fold_functions fmt fmt_ext) - -(* \thocwmodulesection{Evaluation} *) - -module type Ring = - sig - type t - val null : t - val unit : t - val mul : t -> t -> t - val add : t -> t -> t - val sub : t -> t -> t - val neg : t -> t - val to_float : t -> float - val to_string : t -> string - end - -module type Rational = - sig - include Ring - val is_null : t -> bool - val make : int -> int -> t - end - -module type Coeff = - sig - include Ring - val is_null : t -> bool - val atom : int -> t - val coeff : int -> int -> t - end - -module type Sum = - sig - module C : Coeff - type 'a t - val zero : 'a t - val atom : 'a -> 'a t - val scale : C.t -> 'a t -> 'a t - val add : 'a t -> 'a t -> 'a t - val sub : 'a t -> 'a t -> 'a t - val mul : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t - val mulx : ('a -> 'b -> 'c t) -> 'a t -> 'b t -> 'c t -> 'c t - val mulc : ('a -> 'b -> C.t) -> 'a t -> 'b t -> C.t -> C.t - val map : ('a -> 'b) -> 'a t -> 'b t - val eval : ('a -> C.t) -> 'a t -> C.t - val to_string : ('a -> string) -> 'a t -> string - val terms : 'a t -> 'a list - end - -(* \thocwmodulesection{Color Flow Representation} *) - -module type Flows = - sig - module C : Coeff - type 'a t - type 'a wf - val to_string : ('a -> string) -> 'a t -> string - val of_amplitude : 'e -> ('a, 'e) amplitude -> 'e t - val square : ('a -> 'a) -> 'a t -> 'a t -> 'a t - val eval : 'a t -> C.t - val eval_square : ('a -> 'a) -> 'a t -> 'a t -> C.t - type 'a hash - val make_hash : unit -> 'a hash - val eval_memoized : 'a hash -> 'a t -> C.t - val eval_square_memoized : 'a hash -> ('a -> 'a) -> 'a t -> 'a t -> C.t - end - -module Make_Flows (S : Sum) : Flows with module C = S.C = - struct - - module C = S.C - - let one = S.C.unit - let minus_one = S.C.neg one - let two = S.C.coeff 2 1 - let half = S.C.coeff 1 2 - let nc = S.C.atom 1 - let minus_one_over_two_nc = S.C.neg (S.C.mul half (S.C.atom (-1))) - - type 'a lines = ('a * 'a) list - - let canonicalize lines = List.sort compare lines - -(* \begin{dubious} - [expand_sum] (and the functions using it) assumes too much about the - physical representation of singlet terms! - \end{dubious} *) - let expand_sum sum = List.fold_left (S.mul (@)) (S.atom []) sum - -(* The first member of these pairs is always the list of tags of external - gluons contained in the amplitude. This information must be maintained - in order to avoid duplicate application of the completeness relation - for them. *) - type 'a sng = 'a list * ('a lines) S.t - type 'a fnd = 'a list * ('a * 'a lines) S.t - type 'a cjg = 'a list * ('a * 'a lines) S.t - type 'a adj = 'a list * ('a * 'a * 'a lines) S.t - - type 'a t = 'a sng - - type 'a wf = - | S of 'a sng - | F of 'a fnd - | C of 'a cjg - | A of 'a adj - - let ext_s tag' tag = ([], S.atom []) - let ext_f tag' tag = ([], S.atom (tag, [])) - let ext_c tag' tag = ([], S.atom (tag, [])) - let ext_a tag' tag = ([tag], S.atom (tag, tag, [])) - -(* Things are trivial, as long as there are no colors at all or all colors - are coupled to singlets. *) - - let merge_s tag sngs = - let gluons, sum = List.split sngs in - (List.concat gluons, expand_sum sum) - - let mul_s_fc (f, lf) (c, lc) = canonicalize ((f, c) :: lf @ lc) - - let merge_s_fc tag (gluons_f, sum_f) (gluons_c, sum_c) sngs = - let gluons, sum = List.split sngs in - (gluons_f @ gluons_c @ List.concat gluons, - expand_sum (S.mul mul_s_fc sum_f sum_c :: sum)) - -(* Things remain simple, as long as colored particles emit and absorb - only colorless particles: *) - - let merge1 mul (gluons1, sum1) sngs = - let gluons, sum = List.split sngs in - (gluons1 @ List.concat gluons, S.mul mul sum1 (expand_sum sum)) - - let mul_f (f, lf) l = (f, canonicalize (lf @ l)) - let mul_c (c, lc) l = (c, canonicalize (lc @ l)) - let mul_a (f, c, la) l = (f, c, canonicalize (la @ l)) - - let merge_f tag f sngs = merge1 mul_f f sngs - let merge_c tag c sngs = merge1 mul_c c sngs - let merge_a tag a sngs = merge1 mul_a a sngs - -(* We have only one way to emit a gluon from a quark anti-quark current: *) - - let mul_a_fc (f, lf) (c, lc) = (f, c, canonicalize (lf @ lc)) - - let merge_a_fc tag (gluons_f, sum_f) (gluons_c, sum_c) sngs = - let gluons, sum = List.split sngs in - (gluons_f @ gluons_c @ List.concat gluons, - S.mul mul_a (S.mul mul_a_fc sum_f sum_c) (expand_sum sum)) - -(* Using the $\mathrm{SU}(N_C)$ completeness relation - \begin{equation} - T^{a}_{ij} T^{a}_{kl} = - \frac{1}{2} \delta_{il} \delta_{jk} - - \frac{1}{2N_C} \delta_{ij} \delta_{kl} - \end{equation} - for the conventional normalization - \begin{equation} - \textrm{tr}(T_{a}T_{b}) = \frac{1}{2}\delta_{ab} - \end{equation} *) - - let merge2 mul mulx (gluons1, sum1) (gluons2, sum2) sngs = - let gluons, sum = List.split sngs in - (gluons1 @ gluons2 @ List.concat gluons, - S.mul mul (S.mulx mulx sum1 sum2 S.zero) (expand_sum sum)) - - let absorb_glue mul1 mul2 q (af, ac, _ as a) = - let q' = S.atom q - and a' = S.atom a in - if af = ac then - S.mul mul1 q' a' - else - S.add - (S.scale half (S.mul mul1 q' a')) - (S.scale minus_one_over_two_nc (S.mul mul2 q' a')) - - let mul_fa_1 (f, lf) (af, ac, la) = (af, canonicalize ((f, ac) :: lf @ la)) - let mul_fa_2 (f, lf) (af, ac, la) = (f, canonicalize ((af, ac) :: lf @ la)) - - let mul_ca_1 (c, lc) (af, ac, la) = (ac, canonicalize ((af, c) :: lc @ la)) - let mul_ca_2 (c, lc) (af, ac, la) = (c, canonicalize ((af, ac) :: lc @ la)) - - let merge_fa tag f a sngs = - merge2 mul_f (absorb_glue mul_fa_1 mul_fa_2) f a sngs - - let merge_ca tag c a sngs = - merge2 mul_c (absorb_glue mul_ca_1 mul_ca_2) c a sngs - -(* The fun starts here, but the completeness relation turns out to be - surprinsingly simple. The $1/N_{C}$-terms cancel always due to the - antisymmetry \ldots{} *) - - let mul_aa_1 (f1, c1, l1) (f2, c2, l2) = - (f1, c2, canonicalize ((f2, c1) :: l1 @ l2)) - let mul_aa_2 (f1, c1, l1) (f2, c2, l2) = - (f2, c1, canonicalize ((f1, c2) :: l1 @ l2)) - -(* \ldots{} and only the prefactor changes if we do apply the completeness - relation for internal gluons or don't for external gluons: - \begin{subequations} - \begin{align} - f_{abc} &= - 2\ii \tr\left(\lbrack T_a,T_b\rbrack T_c\right) \\ - \parbox{26mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(22,22) - \fmftop{g} - \fmfbottom{g1,g2} - \fmf{gluon}{v,g1} - \fmf{gluon}{v,g2} - \fmf{gluon}{v,g} - \fmfdot{v} - \end{fmfgraph*}}} - \quad - &= 2\left( - \parbox{26mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(22,22) - \fmftop{g} - \fmfbottom{g1,g2} - \fmf{gluon}{v1,g1} - \fmf{gluon}{v2,g2} - \fmf{gluon}{v3,g} - \fmf{plain_arrow,tension=0.5,left=0.4}{v1,v3,v2,v1} - \fmfdot{v1,v2,v3} - \end{fmfgraph*}}} - \right) - - 2\left( - \parbox{26mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(22,22) - \fmftop{g} - \fmfbottom{g1,g2} - \fmf{gluon}{v1,g1} - \fmf{gluon}{v2,g2} - \fmf{gluon}{v3,g} - \fmf{plain_arrow,tension=0.5,right=0.4}{v1,v2,v3,v1} - \fmfdot{v1,v2,v3} - \end{fmfgraph*}}} - \right) - \end{align} - \end{subequations} - Both incoming gluons external, i.\,e.~the completeness relation is - never applied - \begin{equation} - \parbox{26mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(22,22) - \fmftop{g} - \fmfbottom{g1,g2} - \fmf{gluon}{v,g1} - \fmf{gluon}{v,g2} - \fmf{gluon}{v,g} - \fmfdot{v} - \end{fmfgraph*}}} - \quad - = 2\left( - \parbox{26mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(22,22) - \setupthreegluons - \fmfi{plain_arrow,rubout}{a2{v-g2}...{g1-v}b1} - \fmfi{plain_arrow,rubout}{a1{v-g1}...{g3-v}b3} - \fmfi{plain_arrow,rubout}{a3{v-g3}...{g2-v}b2} - \end{fmfgraph*}}} - \right) - - 2\left( - \parbox{26mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(22,22) - \setupthreegluons - \fmfi{plain_arrow}{a1{v-g1}...{g2-v}b2} - \fmfi{plain_arrow}{a2{v-g2}...{g3-v}b3} - \fmfi{plain_arrow}{a3{v-g3}...{g1-v}b1} - \end{fmfgraph*}}} - \right) - \end{equation} - The right incoming gluon is external and the left internal, - i.\,e.~the completeness relation is only applied to the left - \begin{multline} - \parbox{26mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(22,22) - \fmftop{g} - \fmfbottom{g1,g2} - \fmf{gluon}{v,g1} - \fmf{gluon}{v,g2} - \fmf{gluon}{v,g} - \fmfdot{v} - \end{fmfgraph*}}} - \quad - = \left( - \parbox{26mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(22,22) - \setupthreegluons - \fmfi{plain_arrow,rubout}{a2{v-g2}...{g1-v}b1} - \fmfi{plain_arrow,rubout}{a1{v-g1}...{g3-v}b3} - \fmfi{plain_arrow,rubout}{a3{v-g3}...{g2-v}b2} - \end{fmfgraph*}}} - \right) - - \frac{1}{N_C}\left( - \parbox{26mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(22,22) - \setupthreegluons - \fmfi{plain_arrow,rubout}{a1{v-g1}..v..{g1-v}b1} - \fmfi{plain_arrow,rubout}{a2{v-g2}...{g3-v}b3} - \fmfi{plain_arrow,rubout}{a3{v-g3}...{g2-v}b2} - \end{fmfgraph*}}} - \right) \\ - - \left( - \parbox{26mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(22,22) - \setupthreegluons - \fmfi{plain_arrow}{a1{v-g1}...{g2-v}b2} - \fmfi{plain_arrow}{a2{v-g2}...{g3-v}b3} - \fmfi{plain_arrow}{a3{v-g3}...{g1-v}b1} - \end{fmfgraph*}}} - \right) - + \frac{1}{N_C}\left( - \parbox{26mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(22,22) - \setupthreegluons - \fmfi{plain_arrow,rubout}{a1{v-g1}..v..{g1-v}b1} - \fmfi{plain_arrow,rubout}{a2{v-g2}...{g3-v}b3} - \fmfi{plain_arrow,rubout}{a3{v-g3}...{g2-v}b2} - \end{fmfgraph*}}} - \right) \\ - = \left( - \parbox{26mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(22,22) - \setupthreegluons - \fmfi{plain_arrow,rubout}{a2{v-g2}...{g1-v}b1} - \fmfi{plain_arrow,rubout}{a1{v-g1}...{g3-v}b3} - \fmfi{plain_arrow,rubout}{a3{v-g3}...{g2-v}b2} - \end{fmfgraph*}}} - \right) - - \left( - \parbox{26mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(22,22) - \setupthreegluons - \fmfi{plain_arrow}{a1{v-g1}...{g2-v}b2} - \fmfi{plain_arrow}{a2{v-g2}...{g3-v}b3} - \fmfi{plain_arrow}{a3{v-g3}...{g1-v}b1} - \end{fmfgraph*}}} - \right) - \end{multline} - The left incoming gluon is external and the right internal, - i.\,e.~the completeness relation is only applied to the right - \begin{multline} - \parbox{26mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(22,22) - \fmftop{g} - \fmfbottom{g1,g2} - \fmf{gluon}{v,g1} - \fmf{gluon}{v,g2} - \fmf{gluon}{v,g} - \fmfdot{v} - \end{fmfgraph*}}} - \quad - = \left( - \parbox{26mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(22,22) - \setupthreegluons - \fmfi{plain_arrow,rubout}{a2{v-g2}...{g1-v}b1} - \fmfi{plain_arrow,rubout}{a1{v-g1}...{g3-v}b3} - \fmfi{plain_arrow,rubout}{a3{v-g3}...{g2-v}b2} - \end{fmfgraph*}}} - \right) - - \frac{1}{N_C}\left( - \parbox{26mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(22,22) - \setupthreegluons - \fmfi{plain_arrow,rubout}{a2{v-g2}..v..{g2-v}b2} - \fmfi{plain_arrow,rubout}{a1{v-g1}...{g3-v}b3} - \fmfi{plain_arrow,rubout}{a3{v-g3}...{g1-v}b1} - \end{fmfgraph*}}} - \right) \\ - - \left( - \parbox{26mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(22,22) - \setupthreegluons - \fmfi{plain_arrow}{a1{v-g1}...{g2-v}b2} - \fmfi{plain_arrow}{a2{v-g2}...{g3-v}b3} - \fmfi{plain_arrow}{a3{v-g3}...{g1-v}b1} - \end{fmfgraph*}}} - \right) - + \frac{1}{N_C}\left( - \parbox{26mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(22,22) - \setupthreegluons - \fmfi{plain_arrow,rubout}{a2{v-g2}..v..{g2-v}b2} - \fmfi{plain_arrow,rubout}{a1{v-g1}...{g3-v}b3} - \fmfi{plain_arrow,rubout}{a3{v-g3}...{g1-v}b1} - \end{fmfgraph*}}} - \right) \\ - = \left( - \parbox{26mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(22,22) - \setupthreegluons - \fmfi{plain_arrow,rubout}{a2{v-g2}...{g1-v}b1} - \fmfi{plain_arrow,rubout}{a1{v-g1}...{g3-v}b3} - \fmfi{plain_arrow,rubout}{a3{v-g3}...{g2-v}b2} - \end{fmfgraph*}}} - \right) - - \left( - \parbox{26mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(22,22) - \setupthreegluons - \fmfi{plain_arrow}{a1{v-g1}...{g2-v}b2} - \fmfi{plain_arrow}{a2{v-g2}...{g3-v}b3} - \fmfi{plain_arrow}{a3{v-g3}...{g1-v}b1} - \end{fmfgraph*}}} - \right) - \end{multline} - Both incoming gluons internal, i.\,e.~the completeness relation is - applied twice and as we have seen it corresponds to a factor of~$1/2$ - each time. - \begin{multline} - \parbox{26mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(22,22) - \fmftop{g} - \fmfbottom{g1,g2} - \fmf{gluon}{v,g1} - \fmf{gluon}{v,g2} - \fmf{gluon}{v,g} - \fmfdot{v} - \end{fmfgraph*}}} - \quad - = \frac{1}{2}\left( - \parbox{26mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(22,22) - \setupthreegluons - \fmfi{plain_arrow,rubout}{a2{v-g2}...{g1-v}b1} - \fmfi{plain_arrow,rubout}{a1{v-g1}...{g3-v}b3} - \fmfi{plain_arrow,rubout}{a3{v-g3}...{g2-v}b2} - \end{fmfgraph*}}} - \right) - - \frac{1}{2}\left( - \parbox{26mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(22,22) - \setupthreegluons - \fmfi{plain_arrow}{a1{v-g1}...{g2-v}b2} - \fmfi{plain_arrow}{a2{v-g2}...{g3-v}b3} - \fmfi{plain_arrow}{a3{v-g3}...{g1-v}b1} - \end{fmfgraph*}}} - \right) - \end{multline} *) - - let fuse_aa (a1f, a1c, _ as a1) (a2f, a2c, _ as a2) = - let a1 = S.atom a1 - and a2 = S.atom a2 in - let aa = S.sub (S.mul mul_aa_1 a1 a2) (S.mul mul_aa_2 a1 a2) in - match (a1f = a1c), (a2f = a2c) with - | true, true -> S.scale two aa - | false, false -> S.scale half aa - | true, false | false, true -> aa - - let merge_aa tag a1 a2 sngs = merge2 mul_a fuse_aa a1 a2 sngs - - let finalize_s s' t = t - - let finalize_f f' (gluons, sum) = - (gluons, S.map (fun (f, l) -> canonicalize ((f, f') :: l)) sum) - - let finalize_c c' (gluons, sum) = - (gluons, S.map (fun (c, l) -> canonicalize ((c', c) :: l)) sum) - - let finalize_a a' (gluons, sum) = - (a' :: gluons, - S.map (fun (f, c, l) -> canonicalize ((a', c) :: (f, a') :: l)) sum) - - let of_amplitude_fold_functions root = - { s_ext = ext_s; - s_of_s = merge_s; - s_of_fc = merge_s_fc; - s_final = finalize_s root; - f_ext = ext_f; - f_of_f = merge_f; - f_of_fa = merge_fa; - f_final = finalize_f root; - c_ext = ext_c; - c_of_c = merge_c; - c_of_ca = merge_ca; - c_final = finalize_c root; - a_ext = ext_a; - a_of_a = merge_a; - a_of_aa = merge_aa; - a_of_fc = merge_a_fc; - a_final = finalize_a root } - - let of_amplitude root a = - fold (of_amplitude_fold_functions root) a - - exception Open_flow - -(* It is crucial to apply the completeness relation - \begin{equation} - T^{a}_{ij} (T^{a}_{kl})^{*} = T^{a}_{ij} T^{a}_{lk} = - \frac{1}{2} \delta_{ik} \delta_{jl} - - \frac{1}{2N_C} \delta_{ij} \delta_{kl} - \end{equation} - either to the flow or the conjugated flow. It was appealing to apply it to - the product, but this results in a desastrous quadratic behaviour! - \begin{subequations} - \begin{equation} - T: (f,g)(g,c) \to (f,g)(g',c) - \end{equation} *) - - let flip_fc_left flip is_gluon sum = - S.map (List.map (fun (f, c) -> ((if is_gluon f then flip f else f), c))) sum - -(* \begin{equation} - \begin{aligned} - T^*:& (f,c) \to (c,f) \\ - T^*:& (f,g)(g,c) \to - (c,g)(g,f) \to \frac{1}{2} (c,g')(g,f) - \frac{1}{2N_C} (g,g')(c,f) - \end{aligned} - \end{equation} - \end{subequations} *) - - let find_gluon gluon pairs = - let rec find_gluon_cf seen = function - | [] -> raise Not_found - | (c, f as cf) :: cfs -> - if c = gluon then - find_gluon_f f seen cfs - else if f = gluon then - find_gluon_c c seen cfs - else - find_gluon_cf (cf :: seen) cfs - and find_gluon_f f seen = function - | [] -> invalid_arg "incomplete gluon" - | (c', f' as cf) :: cfs -> - if f' = gluon then - ((c', f), List.rev_append seen cfs) - else if c' = gluon then - invalid_arg "duplicate gluon" - else - find_gluon_f f (cf :: seen) cfs - and find_gluon_c c seen = function - | [] -> invalid_arg "incomplete gluon" - | (c', f' as cf) :: cfs -> - if c' = gluon then - ((c, f'), List.rev_append seen cfs) - else if f' = gluon then - invalid_arg "duplicate gluon" - else - find_gluon_c c (cf :: seen) cfs in - find_gluon_cf [] pairs - - let flip1_cf_right flip gluon sum = - let gluon' = flip gluon in - S.add - (S.scale half - (S.map (List.map (fun (c, f) -> - (c, if f = gluon then gluon' else f))) sum)) - (S.scale minus_one_over_two_nc - (S.map (fun pairs -> - let cf', cfs' = find_gluon gluon pairs in - (gluon, gluon') :: cf' :: cfs') sum)) - - let flip_fc_right flip gluons sum = - List.fold_right (flip1_cf_right flip) gluons - (S.map (List.map (fun (f, c) -> (c, f))) sum) - -(* \begin{dubious} - Possible further optimizations: - \begin{itemize} - \item count and consume all \emph{non-gluon} cycles \emph{before} applying - the completeness relation in [flip_fc], then apply the completeness relation - and count and consume the processed cycles - \end{itemize} - \end{dubious} *) - - let square flip (gluons1, sum1) (gluons2, sum2) = - assert (List.sort compare gluons1 = List.sort compare gluons2); - ([], - S.mul (fun l1 l2 -> l1 @ l2) - (flip_fc_left flip (fun g -> List.mem g gluons1) sum1) - (flip_fc_right flip gluons2 sum2)) - -(* \begin{dubious} - The following algorithm for counting the cycles is quadratic since it - performs nested scans of the lists. If this was a serious problem one could - replace the lists of pairs by a [Map] and replace one power by a logarithm. - \end{dubious} - However \ldots - \begin{dubious} - \ldots{} (much to my surprise), the most expensive (i.\,e.~inefficient) - operation turned out to be an inefficient implementation of [square]. - \end{dubious} *) - - let consume_cycle f0 c0 lines = - let rec consume_cycle' c' seen = function - | [] -> raise Open_flow - | (f, c) :: fc -> - if c = f0 then - (f, c') :: List.rev_append seen fc - else if f = c' then - consume_cycle' c [] (List.rev_append seen fc) - else - consume_cycle' c' ((f, c) :: seen) fc in - consume_cycle' c0 [] lines - - let count_cycles lines = - let rec count_cycles' acc = function - | [] -> acc - | (f, c) :: fc -> - if f = c then - count_cycles' (S.C.mul acc nc) fc - else - count_cycles' acc (consume_cycle f c fc) in - count_cycles' one lines - - let eval (gluons, sum) = - assert (List.length gluons = 0); - S.eval count_cycles sum - -(* This deforestation is very helpful and conserves \emph{a lot} of memory! *) - - let eval_square flip (gluons1, sum1) (gluons2, sum2) = - assert (List.sort compare gluons1 = List.sort compare gluons2); - S.mulc (fun l1 l2 -> count_cycles (l1 @ l2)) - (flip_fc_left flip (fun g -> List.mem g gluons1) sum1) - (flip_fc_right flip gluons2 sum2) - S.C.null - -(* Memoization is precisely as useful as the lookup is efficient. Empirically, - more than 99\%{} of all lookups will be successful in complicated applications. - However, the naive use of [Hashtbl] leads to \emph{terrible} results which - are more than an order of magnitude slower than naive evaluation. *) - -(* \begin{dubious} - On the other hand, using a polymorphic [Trie] doesn't slow down - things significantly, but it doesn't appear to speed them up either. - \end{dubious} *) - - module PT = Trie.MakePoly (Pmap.Tree) - - type 'a hash = ('a * 'a, S.C.t) PT.t ref - - let make_hash () = - ref PT.empty - - let count_cycles_memoized hash lines = - try - PT.find compare lines !hash - with - | Not_found -> - let result = count_cycles lines in - hash := PT.add compare lines result !hash; - result - - let eval_memoized hash (gluons, sum) = - assert (List.length gluons = 0); - S.eval (count_cycles_memoized hash) sum - - let eval_square_memoized hash flip (gluons1, sum1) (gluons2, sum2) = - assert (List.sort compare gluons1 = List.sort compare gluons2); - S.mulc (fun l1 l2 -> count_cycles_memoized hash (l1 @ l2)) - (flip_fc_left flip (fun g -> List.mem g gluons1) sum1) - (flip_fc_right flip gluons2 sum2) - S.C.null - -(* \thocwmodulesubsection{Printing Revisited} *) - - let gluons_to_string fmt = function - | [] -> "" - | gluons -> "" - - let sng_to_string fmt lines = - String.concat "/" (List.map (fun (f, c) -> fmt f ^ ":" ^ fmt c) lines) - - let to_string fmt (gluons, sum) = - gluons_to_string fmt gluons ^ S.to_string (sng_to_string fmt) sum - - end - -(* \thocwmodulesection{Evaluation Revisited} *) - -module Make_Sum_Simple (C : Coeff) : Sum = - struct - - module C = C - - let one = C.coeff 1 1 - let minus_one = C.coeff (-1) 1 - - type 'a summand = { coeff : C.t; term : 'a } - -(* \begin{dubious} - This implementation does not combine identical terms. - \end{dubious} *) - - type 'a t = 'a summand list - - let zero : 'a t = [] - - let atom1 t = { coeff = one; term = t } - let atom t = [atom1 t] - - let add x y = x @ y - - let mul1 mul_term x y = - { coeff = C.mul x.coeff y.coeff; term = mul_term x.term y.term } - - let mul mul_term x y = - Product.list2 (mul1 mul_term) x y - - let scale c x = - List.map (fun t -> { t with coeff = C.mul c t.coeff }) x - - let sub x y = x @ (scale minus_one y) - - let mulx mul_term x y acc = - Product.fold2 (fun x' y' -> - add (scale (C.mul x'.coeff y'.coeff) (mul_term x'.term y'.term))) x y acc - - let mulc mul_term x y acc = - Product.fold2 (fun x' y' -> - C.add (C.mul (C.mul x'.coeff y'.coeff) (mul_term x'.term y'.term))) x y acc - - let map f sum = - List.map (fun t -> { t with term = f t.term }) sum - - let eval to_coeff x = - List.fold_right (fun t -> C.add (C.mul t.coeff (to_coeff t.term))) x C.null - - let to_string fmt sum = - "(" ^ String.concat " + " - (List.map (fun s -> - C.to_string s.coeff ^ "*[" ^ fmt s.term ^ "]") sum) ^ ")" - - module M = Pmap.Tree - - let terms sum = - List.map fst - (M.elements (List.fold_left (fun acc s -> M.add compare s.term () acc) M.empty sum)) - - end - -module Make_Sum (C : Coeff) : Sum = - struct - - module C = C - - let one = C.coeff 1 1 - - type 'a summand = { coeff : C.t; term : 'a } - - module M = Pmap.Tree - - type 'a t = ('a, C.t) M.t - - let zero = M.empty - - let atom t = M.singleton t one - - let scale c x = M.map (C.mul c) x - - let insert1 binop t c sum = - let c' = binop (try M.find compare t sum with Not_found -> C.null) c in - if C.is_null c' then - M.remove compare t sum - else - M.add compare t c' sum - - let add x y = M.fold (insert1 C.add) x y - let sub x y = M.fold (insert1 C.sub) y x - - let fold2 f x y = - M.fold (fun tx cx -> M.fold (f tx cx) y) x - - let mul mul_term x y = - fold2 (fun tx cx ty cy -> insert1 C.add (mul_term tx ty) (C.mul cx cy)) - x y zero - - let mulx mul_term x y acc = - fold2 (fun tx cx ty cy -> add (scale (C.mul cx cy) (mul_term tx ty))) x y acc - - let mulc mul_term x y acc = - fold2 (fun tx cx ty cy -> C.add (C.mul (C.mul cx cy) (mul_term tx ty))) x y acc - - let map f sum = M.fold (fun t -> insert1 C.add (f t)) sum M.empty - - let eval to_coeff x = - M.fold (fun t c -> C.add (C.mul c (to_coeff t))) x C.null - - let to_string fmt sum = - "(" ^ String.concat " + " - (M.fold (fun t c acc -> - (C.to_string c ^ "*[" ^ fmt t ^ "]") :: acc) sum []) ^ ")" - - let terms sum = - List.map fst (M.elements (M.fold (fun s _ -> M.add compare s ()) sum M.empty)) - - end - -(* \thocwmodulesubsection{Floating Point Arithmetic} *) - -(* Floatig point arithmetic for a fixed~$N_C$ is of course the fasted - approach and it appears to be reasonable accurate in most cases. *) - -module SUN_Float (NC : NC) : Coeff = - struct - type t = float - let nc = float NC.nc - let is_null x = (x = 0.0) - let null = 0.0 - let unit = 1.0 - let atom p = nc ** (float p) - let coeff n d = float n /. float d - let mul = ( *. ) - let add = ( +. ) - let sub = ( -. ) - let neg c = -. c - let to_float c = c - let to_string = string_of_float - end - -(* \thocwmodulesubsection{Rational Arithmetic} *) - -module SUN_Rational (R : Rational) (NC : NC) : Coeff = - struct - - type t = R.t - let null = R.null - let unit = R.unit - - let is_null = R.is_null - - let nc = R.make NC.nc 1 - let one_over_nc = R.make 1 NC.nc - - let rec pow n p = - if p < 0 then - invalid_arg "pow" - else if p = 0 then - unit - else - R.mul n (pow n (pred p)) - - let atom p = - if p < 0 then - pow one_over_nc (-p) - else if p = 0 then - unit - else - pow nc p - - let coeff = R.make - - let mul = R.mul - let add = R.add - let sub = R.sub - let neg = R.neg - - let to_float = R.to_float - let to_string = R.to_string - - end - -(* \thocwmodulesubsection{Symbolic Arithmetic} *) - -module SUN_Coeff (R : Rational) (NC : NC) : Coeff = - struct - - module IMap = Map.Make (struct type t = int let compare = compare end) - type t = R.t IMap.t - - let null = IMap.empty - let unit = IMap.add 0 R.unit null - - let is_null c = (c = IMap.empty) - - let atom p = IMap.add p R.unit null - let coeff n d = IMap.add 0 (R.make n d) null - - let neg = IMap.map R.neg - - let insert1 binop p r c = - let r' = binop (try IMap.find p c with Not_found -> R.null) r in - if R.is_null r' then - IMap.remove p c - else - IMap.add p r' c - - let add x y = IMap.fold (insert1 R.add) x y - let sub x y = IMap.fold (insert1 R.sub) y x - - let insert2 p1 r1 p2 r2 c = - insert1 R.add (p1 + p2) (R.mul r1 r2) c - - let mul1 c2 p1 r1 c = IMap.fold (insert2 p1 r1) c2 c - let mul c1 c2 = IMap.fold (mul1 c2) c1 IMap.empty - - let to_list c = IMap.fold (fun p r acc -> (p, r) :: acc) c [] - let to_string c = - "(" ^ String.concat " + " - (List.map - (fun (p, r) -> - if p = 0 then - R.to_string r - else - Printf.sprintf "%s*N^{%d}" (R.to_string r) p) - (List.sort - (fun (p1, _) (p2, _) -> compare p2 p1) - (to_list c))) ^ ")" - - let nc = float NC.nc - let to_float c = - IMap.fold (fun p r acc -> (R.to_float r) *. nc ** (float p) +. acc) c 0.0 - - end - -(* \thocwmodulesubsection{Naive Rational Arithmetic} *) - -(* \begin{dubious} - This \emph{is} dangerous and will overflow even for simple - applications. The production code will have to be linked to - a library for large integer arithmetic. - \end{dubious} *) - -(* Anyway, here's Euclid's algorithm: *) -let rec gcd i1 i2 = - if i2 = 0 then - abs i1 - else - gcd i2 (i1 mod i2) - -let lcm i1 i2 = (i1 / gcd i1 i2) * i2 - -module Small_Rational : Rational = - struct - type t = int * int - let is_null (n, _) = (n = 0) - let null = (0, 1) - let unit = (1, 1) - let make n d = - let c = gcd n d in - (n / c, d / c) - let mul (n1, d1) (n2, d2) = make (n1 * n2) (d1 * d2) - let add (n1, d1) (n2, d2) = make (n1 * d2 + n2 * d1) (d1 * d2) - let sub (n1, d1) (n2, d2) = make (n1 * d2 - n2 * d1) (d1 * d2) - let neg (n, d) = (- n, d) - let to_float (n, d) = float n /. float d - let to_string (n, d) = - if d = 1 then - Printf.sprintf "%d" n - else - Printf.sprintf "(%d/%d)" n d - end - -(*i -(* \thocwmodulesubsection{Arbitrary Size Rational Arithmetic} *) - -module Rational : Rational = - struct - type t = Num.num - let null = Num.num_of_int 0 - let unit = Num.num_of_int 1 - let is_null = Num.eq_num null - let make n d = - Num.div_num (Num.num_of_int n) (Num.num_of_int d) - let mul = Num.mult_num - let add = Num.add_num - let sub = Num.sub_num - let neg = Num.minus_num - let to_float = Num.float_of_num - let to_string = Num.string_of_num - end -i*) - -module Flows = Make_Flows(Make_Sum(SUN_Coeff(Small_Rational)(NC3))) - -(* slightly faster, but noticeably less precise: - [module Flows = Make_Flows(Make_Sum(SUN_Float(NC3)))] *) - -i*) - -(*i -(* \thocwmodulesection{Traces} *) - -module type Traces = - sig - type index - type term - type coeff - val make : index list -> term - val make_term : index list list -> term - val mul : term -> term -> term - val eval : term -> coeff - val format : term -> string - val to_string : coeff -> string - val to_float : coeff -> float - end - -module Make_SUN_Traces (C : Coeff) : Traces with type index = int = - struct - - type index = int - type trace = index list - type term = trace list - type sum = (C.t * term) list - type coeff = C.t - - let make tr = [tr] - let make_term traces = traces - let mul = (@) - - let trace_to_string tr = - "tr(" ^ String.concat "," (List.map string_of_int tr) ^ ")" - - let term_to_string term = - String.concat "*" (List.map trace_to_string term) - - let sum_to_string sum = - String.concat " + " - (List.map (fun (c, term) -> C.to_string c ^ "*" ^ term_to_string term) sum) - - let format = term_to_string - -(* Check that each index appears exactly twice: *) - module IM = Map.Make (struct type t = index let compare = compare end) - - let count i map = - IM.add i (try IM.find i map + 1 with Not_found -> 1) map - - let check term = - IM.iter - (fun i n -> - if n <> 2 then - invalid_arg (Printf.sprintf "index %d appears %d times!" i n)) - (List.fold_right (List.fold_right count) term IM.empty) - -(* The required reduction formulae - \begin{subequations} - \begin{align} - \mathrm{tr} (\mathbf{1}) &= N_C \\ - \mathrm{tr} (T^{a}) &= 0 \\ - \mathrm{tr} (T^{a} T^{a} M) &= C_F \mathrm{tr} (M) \\ - \mathrm{tr} (T^{a} M_1 T^{a} M_2) &= - \frac{1}{2} \mathrm{tr} (M_1) \mathrm{tr} (M_2) - - \frac{1}{2N_C} \mathrm{tr} (M_1 M_2) \\ - \mathrm{tr} (T^{a} M) \mathrm{tr} (M_1 T^{a} M_2) &= - \frac{1}{2} \mathrm{tr} (M_1 M M_2) - - \frac{1}{2N_C} \mathrm{tr} (M) \mathrm{tr} (M_1 M_2) - \end{align} - \end{subequations} - are derived using the $\mathrm{SU}(N_C)$ completeness relation - \begin{equation} - T^{a}_{ij} T^{a}_{kl} = - \frac{1}{2} \delta_{il} \delta_{jk} - - \frac{1}{2N_C} \delta_{ij} \delta_{kl} - \end{equation} - for the conventional normalization - \begin{equation} - \textrm{tr}(T_{a}T_{b}) = \frac{1}{2}\delta_{ab} - \end{equation} - I.\,e. - \begin{subequations} - \begin{multline} - \mathrm{tr} (T^{a} M_1 T^{a} M_2) - = T^{a}_{ij} M_{1,jk} T^{a}_{kl} M_{2,li} - = \frac{1}{2} \delta_{jk} M_{1,jk} \delta_{il} M_{2,li} - - \frac{1}{2N_C} \delta_{ij} M_{1,jk} \delta_{kl} M_{2,li} \\ - = \frac{1}{2} M_{1,jj} M_{2,ii} - \frac{1}{2N_C} M_{1,ik} M_{2,ki} - = \frac{1}{2} \mathrm{tr} (M_1) \mathrm{tr} (M_2) - - \frac{1}{2N_C} \mathrm{tr} (M_1 M_2) - \end{multline} - and - \begin{multline} - \mathrm{tr} (T^{a} M_1) \mathrm{tr} (T^{a} M_2) - = T^{a}_{ij} M_{1,ji} T^{a}_{kl} M_{2,lk} - = \frac{1}{2} \delta_{jk} M_{1,ji} \delta_{il} M_{2,lk} - - \frac{1}{2N_C} \delta_{ij} M_{1,ji} \delta_{kl} M_{2,lk} \\ - = \frac{1}{2} M_{1,jl} M_{2,lj} - \frac{1}{2N_C} M_{1,ii} M_{2,kk} - = \frac{1}{2} \mathrm{tr} (M_1 M_2) - - \frac{1}{2N_C} \mathrm{tr} (M_1) \mathrm{tr} (M_2) - \end{multline} - \end{subequations} - The generalization to arbitrary normalizations is straightforward. - Similar formulae are available for~$\mathrm{SO}(N_C)$, but the - completeness relations involve other invariant tensors - besides~$\delta_{ij}$ for~$\mathrm{Sp}{(2N)}$ and the exceptional - Lie algebras. *) - -(* Construct the frequently used constants in the coefficient ring: - \begin{equation*} - \frac{1}{2},\; N_C,\; \frac{N_C}{2},\; -\frac{1}{2N_C},\; - C_F = \frac{N_C^2-1}{2N_C} = \frac{N_C}{2} - \frac{1}{2N_C} - \end{equation*} *) - let half = C.coeff 1 2 - let nc = C.atom 1 - let nc_over_2 = C.mul half (C.atom 1) - let minus_over_2nc = C.neg (C.mul half (C.atom (-1))) - let cf = C.add nc_over_2 minus_over_2nc - -(* \begin{dubious} - The following type could be made redundant by making [eval_term] and - [eval'] mutually recursive, but the resulting code is a bit more obscure. - \end{dubious} *) - type result = - | Number of C.t - | Sum of sum - -(* Try to evaluate one term, replacing Casimirs by their eigenvalue in the - fundamental representation. If successive pairs do not match, first try - to contract within the first trace. *) - let rec eval_term coeff = function - | [] -> Number coeff - | [] :: traces -> (* $\mathrm{tr} (\mathbf{1}) = N_C$ *) - eval_term (C.mul coeff nc) traces - | [a] :: traces -> (* $\mathrm{tr} (T^{a}) = 0$ *) - Number C.null - | (a :: b :: m) :: traces -> - if a = b then - (* $\mathrm{tr} (T^{a} T^{a} M) = C_F \mathrm{tr} (M)$ *) - eval_term (C.mul coeff cf) (m :: traces) - else - contract_inner coeff a [b] traces m - -(* Try to contract a free index [a] with a matching index in the first trace. - If this fails, consult the other traces. *) - and contract_inner coeff a rev_m1 traces = function - | [] -> contract_outer coeff a rev_m1 [] traces - | b :: m2 -> - if a = b then - match m2 with - | [] -> (* $\mathrm{tr} (T^{a} M T^{a}) = C_F \mathrm{tr} (M)$ *) - eval_term (C.mul coeff cf) (List.rev rev_m1 :: traces) - | _ -> (* $\mathrm{tr} (T^{a} M_1 T^{a} M_2) = - \frac{1}{2} \mathrm{tr} (M_1) \mathrm{tr} (M_2) - - \frac{1}{2N_C} \mathrm{tr} (M_1 M_2)$ *) - let m1 = List.rev rev_m1 - and m1m2 = List.rev_append rev_m1 m2 in - Sum [(C.mul half coeff, m1 :: m2 :: traces); - (C.mul minus_over_2nc coeff, m1m2 :: traces)] - else - contract_inner coeff a (b :: rev_m1) traces m2 - -(* Find a matching index in another trace. *) - and contract_outer coeff a rev_m rev_traces traces = - match traces with - | [] -> invalid_arg "contract_outer" - | trace :: traces -> - contract_outer' coeff a rev_m rev_traces traces [] trace - - and contract_outer' coeff a rev_m rev_traces traces rev_m1 = function - | [] -> contract_outer coeff a rev_m (List.rev rev_m1 :: rev_traces) traces - | b :: m2 -> - if a = b then - (* $\mathrm{tr} (T^{a} M) \mathrm{tr} (M_1 T^{a} M_2) = - \frac{1}{2} \mathrm{tr} (M_1 M M_2) - - \frac{1}{2N_C} \mathrm{tr} (M) \mathrm{tr} (M_1 M_2)$ *) - let m = List.rev rev_m - and m1m2 = List.rev_append rev_m1 m2 - and m1mm2 = List.rev_append rev_m1 (List.rev_append rev_m m2) - and traces = List.rev_append rev_traces traces in - Sum [(C.mul half coeff, m1mm2 :: traces); - (C.mul minus_over_2nc coeff, m :: m1m2 :: traces)] - else - contract_outer' coeff a rev_m rev_traces traces (b :: rev_m1) m2 - - let rec eval' sum expr = - match expr with - | [] -> sum - | (coeff, traces) :: expr -> - match eval_term coeff traces with - | Number term -> eval' (C.add sum term) expr - | Sum terms -> eval' sum (List.rev_append terms expr) - - let eval traces = - check traces; - eval' C.null [(C.unit, traces)] - - let to_string = C.to_string - let to_float = C.to_float - - end -i*) - -(*i -module SU3_Traces_Rational = - Make_SUN_Traces(SUN_Rational(Rational)(NC3)) - -module SU3_Traces_Symbolic = - Make_SUN_Traces(SUN_Coeff(Rational)(NC3)) -i*) - -(*i -module SU3_Traces_Small_Rational = - Make_SUN_Traces(SUN_Rational(Small_Rational)(NC3)) - -module SU3_Traces_Small_Symbolic = - Make_SUN_Traces(SUN_Coeff(Small_Rational)(NC3)) - -module SU3_Traces_Float = - Make_SUN_Traces(SUN_Float(NC3)) - -module SU3_Traces = SU3_Traces_Float -i*) - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/whizard.mli =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/whizard.mli (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/whizard.mli (revision 8703) @@ -1,47 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -module type T = - sig - type t - type amplitude - val trees : amplitude -> t - val merge : t -> t - val write : out_channel -> string -> t -> unit - - end - -module Make (FM : Fusion.Maker) (P : Momentum.T) - (PW : Momentum.Whizard with type t = P.t) (M : Model.T) : - T with type amplitude = FM(P)(M).amplitude - -val write_interface : out_channel -> string list -> unit -val write_makefile : out_channel -> 'a -> unit -val write_makefile_processes : out_channel -> string list -> unit - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/thoArray.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/thoArray.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/thoArray.ml (revision 8703) @@ -1,104 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -type 'a compressed = - { uniq : 'a array; - embedding: int array } - -let uniq a = a.uniq -let embedding a = a.embedding - -type 'a compressed2 = - { uniq2 : 'a array array; - embedding1: int array; - embedding2: int array } - -let uniq2 a = a.uniq2 -let embedding1 a = a.embedding1 -let embedding2 a = a.embedding2 - -module PMap = Pmap.Tree - -let compress a = - let last = Array.length a - 1 in - let embedding = Array.make (succ last) (-1) in - let rec scan num_uniq uniq elements n = - if n > last then - { uniq = Array.of_list (List.rev elements); - embedding = embedding } - else - match PMap.find_opt compare a.(n) uniq with - | Some n' -> - embedding.(n) <- n'; - scan num_uniq uniq elements (succ n) - | None -> - embedding.(n) <- num_uniq; - scan - (succ num_uniq) - (PMap.add compare a.(n) num_uniq uniq) - (a.(n) :: elements) - (succ n) in - scan 0 PMap.empty [] 0 - -let uncompress a = - Array.map (Array.get a.uniq) a.embedding - -(* \begin{dubious} - Using [transpose] simplifies the algorithms, but can be inefficient. - If this turns out to be the case, we should add special treatments - for symmetric matrices. - \end{dubious} *) - -let transpose a = - let dim1 = Array.length a - and dim2 = Array.length a.(0) in - let a' = Array.make_matrix dim2 dim1 a.(0).(0) in - for i1 = 0 to pred dim1 do - for i2 = 0 to pred dim2 do - a'.(i2).(i1) <- a.(i1).(i2) - done - done; - a' - -let compress2 a = - let c2 = compress a in - let c12_transposed = compress (transpose c2.uniq) in - { uniq2 = transpose c12_transposed.uniq; - embedding1 = c12_transposed.embedding; - embedding2 = c2.embedding } - -let uncompress2 a = - let a2 = uncompress { uniq = a.uniq2; embedding = a.embedding2 } in - transpose (uncompress { uniq = transpose a2; embedding = a.embedding1 }) - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) - - - - - Index: branches/ohl/omega-development/completed/whizard2/src/vertex_syntax.mli =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/vertex_syntax.mli (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/vertex_syntax.mli (revision 8703) @@ -1,123 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -(* \thocwmodulesection{Abstract Syntax} *) - -type scalar -type vector and vatom -type tensor and tatom -type spinor and satom -type conj_spinor and catom -type vector_spinor and vsatom -type vector_conj_spinor and vcatom - -type scalar_current = S | P | SL | SR -type vector_current = V | A | VL | VR -type tensor_current = T - -(* [index] denotes the ordinal number of field in the vertex (counting from~$1$). - E.\,g. - \begin{verbatim} -vertex e+, e-, A : { e * <1|V|2>.e3 } -vertex nuebar, W+, e- : { g * <1|(V-A)|3>.e2 } - \end{verbatim} - denote~$e\cdot\bar{\mathrm{e}}\fmslash{\mathrm{A}}\mathrm{e}$ - and~$g\cdot\bar\nu_{\mathrm{e}}\fmslash{\mathrm{W}}^+(1-\gamma_5)\mathrm{e}$, - respectively. *) -type index = int - -(* Scalar constructors: *) - -val null : unit -> scalar -val i : unit -> scalar -val integer : int -> scalar -val constant : string -> scalar -val fraction : scalar -> int -> scalar -val multiple : int -> scalar -> scalar - -val scalar_current : scalar_current -> index -> index -> scalar - -val mul : scalar -> scalar -> scalar -val add : scalar -> scalar -> scalar -val sub : scalar -> scalar -> scalar - -val dot : vatom -> vatom -> scalar -val eps : vatom -> vatom -> vatom -> vatom -> scalar - -(* Vector constructors: *) - -val e : index -> vatom -val k : index -> vatom -val x : string -> vatom - -val vector_current : vector_current -> index -> index -> vatom - -val addv : vatom -> vatom -> vatom -val subv : vatom -> vatom -> vatom - -val pseudo : vatom -> vatom -> vatom -> vatom - -val contract_left : vatom -> tatom -> vatom -val contract_right : tatom -> vatom -> vatom - -(* Spinor constructors: *) - -val vatom_vsatom : vatom -> vsatom -> spinor -val vatom_vcatom : vatom -> vcatom -> conj_spinor - -(* Tensor constructors: *) - -val tensor_current : tensor_current -> index -> index -> tatom - -(* Partial derivatives: *) - -val partial_vector : vatom -> scalar -> vector -val partial_spinor : index -> scalar -> conj_spinor -val partial_conj_spinor : index -> scalar -> spinor - -(* \thocwmodulesection{Diagnostics} *) - -val scalar_to_string : scalar -> string -val vector_to_string : vector -> string -val spinor_to_string : spinor -> string -val conj_spinor_to_string : conj_spinor -> string - -type atoms = - private { constants : string list; - momenta : index list; - polarizations : index list; - external_momenta : string list; - spinors : index list; - conj_spinors : index list } - -val scalar_atoms : scalar -> atoms - -exception Syntax_Error of string * int * int - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * compile-command:"ocamlc -o vertex thoList.ml{i,} pmap.ml{i,} vertex.ml" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/f90_SM_ac.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/f90_SM_ac.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/f90_SM_ac.ml (revision 8703) @@ -1,33 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -module O = Omega.Make(Fusion.Mixed23)(Targets.Fortran) - (Models.SM(Models.SM_anomalous)) -let _ = O.main () - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/cascade_syntax.mli =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/cascade_syntax.mli (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/cascade_syntax.mli (revision 8703) @@ -1,59 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -type ('flavor, 'p) t = - | True - | False - | On_shell of 'flavor list * 'p - | On_shell_not of 'flavor list * 'p - | Off_shell of 'flavor list * 'p - | Off_shell_not of 'flavor list * 'p - | Gauss of 'flavor list * 'p - | Gauss_not of 'flavor list * 'p - | Any_flavor of 'p - | Or of ('flavor, 'p) t list - | And of ('flavor, 'p) t list - -val mk_true : unit -> ('flavor, 'p) t -val mk_false : unit -> ('flavor, 'p) t -val mk_on_shell : 'flavor list -> 'p -> ('flavor, 'p) t -val mk_on_shell_not : 'flavor list -> 'p -> ('flavor, 'p) t -val mk_off_shell : 'flavor list -> 'p -> ('flavor, 'p) t -val mk_off_shell_not : 'flavor list -> 'p -> ('flavor, 'p) t -val mk_gauss : 'flavor list -> 'p -> ('flavor, 'p) t -val mk_gauss_not : 'flavor list -> 'p -> ('flavor, 'p) t -val mk_any_flavor : 'p -> ('flavor, 'p) t -val mk_or : ('flavor, 'p) t -> ('flavor, 'p) t -> ('flavor, 'p) t -val mk_and : ('flavor, 'p) t -> ('flavor, 'p) t -> ('flavor, 'p) t - -val to_string : ('flavor -> string) -> ('p -> string) -> ('flavor, 'p) t -> string - -exception Syntax_Error of string * int * int - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) - Index: branches/ohl/omega-development/completed/whizard2/src/tuple.mli =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/tuple.mli (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/tuple.mli (revision 8703) @@ -1,207 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -(* The [Tuple.Poly] interface abstracts the notion of tuples with variable - arity. Simple cases are binary polytuples, which are simply pairs and - indefinite polytuples, which are nothing but lists. Another example is - the union of pairs and triples. The interface is very - similar to [List] from the O'Caml standard library, but the [Tuple.Poly] - signature allows a more fine grained control of arities. The latter - provides typesafe linking of models, targets and topologies. *) - -module type Mono = - sig - type 'a t - - val arity : 'a t -> int - val max_arity : int - - val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int - - val for_all : ('a -> bool) -> 'a t -> bool - - val map : ('a -> 'b) -> 'a t -> 'b t - val iter : ('a -> unit) -> 'a t -> unit - val fold_left : ('a -> 'b -> 'a) -> 'a -> 'b t -> 'a - val fold_right : ('a -> 'b -> 'b) -> 'a t -> 'b -> 'b - -(* We have applications, where no sensible intial value can be defined: *) - val fold_left_internal : ('a -> 'a -> 'a) -> 'a t -> 'a - val fold_right_internal : ('a -> 'a -> 'a) -> 'a t -> 'a - - val map2 : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t - - val split : ('a * 'b) t -> 'a t * 'b t - -(* The distributive tensor product expands a tuple of lists into - list of tuples, e.\,g.~for binary tuples: - \begin{equation} - \ocwlowerid{product}\, (\lbrack x_1;x_2\rbrack,\lbrack y_1;y_2\rbrack) - = \lbrack (x_1,y_1);(x_1,y_2);(x_2,y_1);(x_2,y_2)\rbrack - \end{equation} - NB: [product_fold] is usually much more memory efficient than - the combination of [product] and [List.fold_right] for large sets. *) - val product : 'a list t -> 'a t list - val product_fold : ('a t -> 'b -> 'b) -> 'a list t -> 'b -> 'b - -(* For homogeneous tuples the [power] function could trivially be built from - [product], e.\,g.: - \begin{equation} - \ocwlowerid{power}\,\lbrack x_1;x_2\rbrack - = \ocwlowerid{product}\,(\lbrack x_1;x_2\rbrack,\lbrack x_1;x_2\rbrack) - = \lbrack (x_1,x_1);(x_1,x_2);(x_2,x_1);(x_2,x_2)\rbrack - \end{equation} - but it is also well defined for polytuples, e.\,g.~for pairs and triples - \begin{equation} - \ocwlowerid{power}\,\lbrack x_1;x_2\rbrack - = \ocwlowerid{product}\,(\lbrack x_1;x_2\rbrack,\lbrack x_1;x_2\rbrack) - \cup \ocwlowerid{product}\, - (\lbrack x_1;x_2\rbrack,\lbrack x_1;x_2\rbrack,\lbrack x_1;x_2\rbrack) - \end{equation} - For tuples and polytuples with bounded arity, the [power] - and [power_fold] functions terminate. In polytuples with unbounded arity, the - the [power] function always raises [No_termination]. [power_fold] - also raises [No_termination], but could be changed to run until the - argument function raises an exception. However, if we need this behaviour, - we should implemente [power_iter] instead. *) - val power : 'a list -> 'a t list - val power_fold : ('a t -> 'b -> 'b) -> 'a list -> 'b -> 'b - -(* We can also identify all (poly)tuples with permuted elements and return - only one representative, e.\,g.: - \begin{equation} - \ocwlowerid{sym\_power}\,\lbrack x_1;x_2\rbrack - = \lbrack (x_1,x_1);(x_1,x_2);(x_2,x_2)\rbrack - \end{equation} - NB: this function has not yet been implemented, because O'Mega only needs - the more efficient special case [graded_sym_power]. *) - -(* If a set $X$ is graded (i.\,e.~there is a map $\phi:X\to\mathbf{N}$, - called [rank] below), the results of [power] or [sym_power] can - canonically be filtered by requiring that the sum of the ranks in - each (poly)tuple has one chosen value. Implementing such a function - directly is much more efficient than constructing and subsequently - disregarding many (poly)tuples. The elements of rank $n$ are at offset - $(n-1)$ in the array. The array is assumed to be \emph{immutable}, even - if O'Caml doesn't support immutable arrays. NB: [graded_power] has not - yet been implemented, because O'Mega only needs [graded_sym_power]. *) - type 'a graded = 'a list array - val graded_sym_power : int -> 'a graded -> 'a t list - val graded_sym_power_fold : int -> ('a t -> 'b -> 'b) -> 'a graded -> - 'b -> 'b - -(* \begin{dubious} - We hope to be able to avoid the next one in the long run, because it mildly - breaks typesafety for arities. Unfortunately, we're still working on it \ldots - \end{dubious} *) - val to_list : 'a t -> 'a list - -(* \begin{dubious} - The next one is only used for Fermi statistics below, but can not - be implemented if there are no binary tuples. It must be retired - as soon as possible. - \end{dubious} *) - val of2_kludge : 'a -> 'a -> 'a t - - val rcs : RCS.t - end - -module type Poly = - sig - include Mono - exception Mismatched_arity - exception No_termination - end - -module type Binary = - sig - include Poly (* should become [Mono]! *) - val of2 : 'a -> 'a -> 'a t - end -module Binary : Binary - -module type Ternary = - sig - include Mono - val of3 : 'a -> 'a -> 'a -> 'a t - end -module Ternary : Ternary - -type 'a pair_or_triple = T2 of 'a * 'a | T3 of 'a * 'a *'a - -module type Mixed23 = - sig - include Poly - val of2 : 'a -> 'a -> 'a t - val of3 : 'a -> 'a -> 'a -> 'a t - end -module Mixed23 : Mixed23 - -module type Nary = - sig - include Poly - val of2 : 'a -> 'a -> 'a t - val of3 : 'a -> 'a -> 'a -> 'a t - val of_list : 'a list -> 'a t - end -module Unbounded_Nary : Nary - -module type Bound = sig val max_arity : int end -module Nary (B: Bound) : Nary - -(* \begin{dubious} - For compleneteness sake, we could add most of the [List] signature - \begin{itemize} - \item{} [val length : 'a t -> int] - \item{} [val hd : 'a t -> 'a] - \item{} [val nth : 'a t -> int -> 'a] - \item{} [val rev : 'a t -> 'a t] - \item{} [val rev_map : ('a -> 'b) -> 'a t -> 'b t] - \item{} [val iter2 : ('a -> 'b -> unit) -> 'a t -> 'b t -> unit] - \item{} [val rev_map2 : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t] - \item{} [val fold_left2 : ('a -> 'b -> 'c -> 'a) -> 'a -> 'b t -> 'c t -> 'a] - \item{} [val fold_right2 : ('a -> 'b -> 'c -> 'c) -> 'a t -> 'b t -> 'c -> 'c] - \item{} [val exists : ('a -> bool) -> 'a t -> bool] - \item{} [val for_all2 : ('a -> 'b -> bool) -> 'a t -> 'b t -> bool] - \item{} [val exists2 : ('a -> 'b -> bool) -> 'a t -> 'b t -> bool] - \item{} [val mem : 'a -> 'a t -> bool] - \item{} [val memq : 'a -> 'a t -> bool] - \item{} [val find : ('a -> bool) -> 'a t -> 'a] - \item{} [val find_all : ('a -> bool) -> 'a t -> 'a list] - \item{} [val assoc : 'a -> ('a * 'b) t -> 'b] - \item{} [val assq : 'a -> ('a * 'b) t -> 'b] - \item{} [val mem_assoc : 'a -> ('a * 'b) t -> bool] - \item{} [val mem_assq : 'a -> ('a * 'b) t -> bool] - \item{} [val combine : 'a t -> 'b t -> ('a * 'b) t] - \item{} [val sort : ('a -> 'a -> int) -> 'a t -> 'a t] - \item{} [val stable_sort : ('a -> 'a -> int) -> 'a t -> 'a t] - \end{itemize} - \end{dubious} - but only if we ever have too much time on our hand \ldots *) - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/comphep_lexer.mll =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/comphep_lexer.mll (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/comphep_lexer.mll (revision 8703) @@ -1,54 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -{ -open Comphep_parser -} - -let digit = ['0'-'9'] -let upper = ['A'-'Z'] -let lower = ['a'-'z'] -let alpha = upper | lower -let alphanum = alpha | digit - -let symbol = alpha alphanum* -let integer = digit+ - -rule token = parse - [' ' '\t'] { token lexbuf } (* skip blanks *) - | "(" { LPAREN } - | ")" { RPAREN } - | "i" { I } - | "." { DOT } - | "**" { POWER } - | "*" { MULT } - | "/" { DIV } - | "+" { PLUS } - | "-" { MINUS } - | symbol { SYMBOL (Lexing.lexeme lexbuf) } - | integer { INT (int_of_string (Lexing.lexeme lexbuf)) } - | _ { failwith ("lexer fails @" ^ Lexing.lexeme lexbuf) } - | eof { END } - - - - Index: branches/ohl/omega-development/completed/whizard2/src/momentum.mli =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/momentum.mli (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/momentum.mli (revision 8703) @@ -1,211 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -(* Model the finite combinations - \begin{equation} - p = \sum_{n=1}^k c_k \bar p_n,\qquad \text{(with $c_k\in\{0,1\}$)} - \end{equation} - of~$n_{\text{in}}$ incoming and~$k-n_{\text{in}}$ outgoing momenta~$p_n$ - \begin{equation} - \bar p_n = - \begin{cases} - - p_n & \text{for $1\le n \le n_{\text{in}}$} \\ - p_n & \text{for $n_{\text{in}}+1\le n\le k$} - \end{cases} - \end{equation} - where momentum is conserved - \begin{equation} - \sum_{n=1}^k \bar p_n = 0 - \end{equation} - below, we need the notion of `rank' and `dimension': - \begin{subequations} - \begin{align} - \text{\ocwlowerid{dim}} (p) &= k \\ - \text{\ocwlowerid{rank}} (p) &= \sum_{n=1}^{k} c_k - \end{align} - \end{subequations} - where `dimension' is \emph{not} the dimension of the - underlying space-time, of course. *) - -module type T = - sig - type t - -(* Constructor: $(k,N)\to p = \sum_{n\in N} \bar p_n$ and - $k=\text{\ocwlowerid{dim}}(p)$ is the \emph{overall} number - of independent momenta, while $\text{\ocwlowerid{rank}}(p)=|N|$ - is the number of momenta in~$p$. It would be possible to - fix~[dim] as a functor argument instead. This might - be slightly faster and allow a few more compile time checks, - but would be much more tedious to use, since the number - of particles will be chosen at runtime. *) - val of_ints : int -> int list -> t - -(* No two indices may be the same. Implementions of [of_ints] can - either raise the exception [Duplicate] or ignore the duplicate, - but implementations of [add] are required to raise [Duplicate]. *) - exception Duplicate of int - -(* Raise [Range] iff $n>k$: *) - exception Range of int - -(* Binary oparations require that both momenta have the same dimension. - [Mismatch] is raised if this condition is violated. *) - exception Mismatch of string * t * t - -(* [Negative] is raised if the result of [sub] is undefined. *) - exception Negative - -(* The inverses of the constructor (we have - [rank p = List.length (to_ints p)], but [rank] might be more efficient): *) - val to_ints : t -> int list - val dim : t -> int - val rank : t -> int - -(* Shortcuts: [singleton d p = of_ints d [p]] and [zero d = of_ints d []]: *) - val singleton : int -> int -> t - val zero : int -> t - -(* An arbitrary total order, with the condition - $\text{\ocwlowerid{rank}}(p_1)<\text{\ocwlowerid{rank}}(p_2) - \Rightarrow p_1 t -> int - -(* Use momentum conservation to construct the negative momentum with - positive coefficients: *) - val neg : t -> t - -(* Return the momentum or its negative, whichever has the lower rank. - NB: the present implementation does \emph{not} guarantee that - \begin{equation} - \text{abs} p = \text{abs} q \Longleftrightarrow p = p \lor p = - q - \end{equation} - for momenta with $\text{rank} = \text{dim}/2$. *) - val abs : t -> t - -(* Add and subtract momenta. This can fail, since the coefficients~$c_k$ must - me either~$0$ or~$1$. *) - val add : t -> t -> t - val sub : t -> t -> t - -(* Once more, but not raising exceptions this time: *) - val try_add : t -> t -> t option - val try_sub : t -> t -> t option - -(* \emph{Not} the total order provided by [compare], but set inclusion of - non-zero coefficients instead: *) - val less : t -> t -> bool - val lesseq : t -> t -> bool - -(* $p_1 + (\pm p_2) + (\pm p_3) = 0$ *) - val try_fusion : t -> t -> t -> (bool * bool) option - -(* A textual representation for debugging: *) - val to_string : t -> string - -(* [split i n p] splits~$\bar p_i$ into~$n$ momenta~$\bar p_i \to - \bar p_i + \bar p_{i+1} + \ldots + \bar p_{i+n-1}$ and makes room - via~$\bar p_{j>i} \to \bar p_{j+n-1}$. This is used for implementating - cascade decays, like combining - \begin{subequations} - \begin{align} - \mathrm{e}^+(p_1) \mathrm{e}^-(p_2) \to - &\mathrm{W}^-(p_3) \nu_{\mathrm{e}}(p_4) \mathrm{e}^+(p_5)\\ - &\mathrm{W}^-(p_3)\to \mathrm{d}(p_3') \bar{\mathrm{u}}(p_4') - \end{align} - \end{subequations} - to - \begin{equation} - \mathrm{e}^+(p_1) \mathrm{e}^-(p_2) \to - \mathrm{d}(p_3) \bar{\mathrm{u}}(p_4) - \nu_{\mathrm{e}}(p_5) \mathrm{e}^+(p_6) - \end{equation} - in narrow width approximation for the~$\mathrm{W}^-$. *) - val split : int -> int -> t -> t - -(* \thocwmodulesection{Scattering Kinematics} - From here on, we assume scattering kinematics $\{1,2\}\to\{3,4,\ldots\}$, - i.\,e.~$n_{\text{in}}=2$. - \begin{dubious} - Since functions like [timelike] can be used for decays as well (in which - case they must \emph{always} return [true], the representation---and - consequently the constructors---should be extended by a flag discriminating - between the two cases! - \end{dubious} *) - -(* Test if the momentum is an incoming one: $p=\bar p_1\lor p=\bar p_2$ *) - val incoming : t -> bool - -(* $p=\bar p_3\lor p=\bar p_4\lor \ldots$ *) - val outgoing : t -> bool - -(* $p^2 \ge 0$. NB: \textit{par abus de langange}, we report the incoming - individual momenta as spacelike, instead as timelike. This will be useful - for phasespace constructions below. *) - val timelike : t -> bool - -(* $p^2 \le 0$. NB: the simple algebraic criterion can be violated for heavy - initial state particles. *) - val spacelike : t -> bool - -(* $p = \bar p_1 + \bar p_2$ *) - val s_channel_in : t -> bool - -(* $p = \bar p_3 + \bar p_4 + \ldots + \bar p_n$ *) - val s_channel_out : t -> bool - -(* $p = \bar p_1 + \bar p_2 \lor p = \bar p_3 + \bar p_4 + \ldots + \bar p_n$ *) - val s_channel : t -> bool - -(* $ \bar p_1 + \bar p_2 \to \bar p_3 + \bar p_4 + \ldots + \bar p_n$ *) - val flip_s_channel_in : t -> t - - val rcs : RCS.t - end - -module Lists : T -module Bits : T -module Default : T - -(* Wolfgang's funny tree codes: - \begin{equation} - (2^n, 2^{n-1}) \to (1, 2, 4, \ldots, 2^{n-2}) - \end{equation} *) - -module type Whizard = - sig - type t - val of_momentum : t -> int - val to_momentum : int -> int -> t - end - -module ListsW : Whizard with type t = Lists.t -module BitsW : Whizard with type t = Bits.t -module DefaultW : Whizard with type t = Default.t - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/oVM.mli =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/oVM.mli (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/oVM.mli (revision 8703) @@ -1,44 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -module type T = - sig - - type amplitude - type program - type environment - - val compile : amplitude -> program - val eval : program -> environment -> - (float array * int) list -> float * float - - end - -module Make (F : Fusion.T) : T with type amplitude = F.amplitude - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/cache.mli =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/cache.mli (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/cache.mli (revision 8703) @@ -1,39 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -type hash = string - -val md5_hash : 'a -> hash -val write : ?dir:string -> ?pfx:string -> hash -> 'a -> unit -val read : ?dir:string -> ?pfx:string -> hash -> 'a -val maybe_read : ?dir:string -> ?pfx:string -> hash -> 'a option - -val set_directory : string -> unit -val set_prefix : string -> unit - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/f90_SM_Rxi.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/f90_SM_Rxi.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/f90_SM_Rxi.ml (revision 8703) @@ -1,32 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -module O = Omega.Make(Fusion.Binary)(Targets.Fortran)(Models.SM_Rxi) -let _ = O.main () - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/models3.mli =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/models3.mli (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/models3.mli (revision 8703) @@ -1,46 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -(* \thocwmodulesection{Extended Supersymmetric Models} *) - -(* We do not introduce the possibility here of using four point couplings - or not. We simply add the relevant and leave the rest out. No - possibility for Goldstone bosons is given. But we allow for CKM mixing. -*) - -module type extMSSM_flags = - sig - val ckm_present : bool - val nmssm : bool - val exotics : bool - end -module NMSSM : extMSSM_flags -module E6SSM : extMSSM_flags -module ExtMSSM : functor (F: extMSSM_flags) -> Model.T - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/f90_Phi3.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/f90_Phi3.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/f90_Phi3.ml (revision 8703) @@ -1,32 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -module O = Omega.Make(Fusion.Binary)(Targets.Fortran)(Models.Phi3) -let _ = O.main () - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/models.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/models.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/models.ml (revision 8703) @@ -1,3092 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -let rcs_file = RCS.parse "Models" ["Lagragians"] - { RCS.revision = "$Revision$"; - RCS.date = "$Date$"; - RCS.author = "$Author$"; - RCS.source - = "$URL$" } - -(* \thocwmodulesection{Compilation} *) - -(* Flavors and coupling constants: flavors can be tested for equality - and charge conjugation is defined. *) - -module type Flavor = - sig - type f - type c - val compare : f -> f -> int - val conjugate : f -> f - end - -(* Compiling fusions from a list of vertices: *) - -module type Fusions = - sig - type t - type f - type c - val fuse2 : t -> f -> f -> (f * c Coupling.t) list - val fuse3 : t -> f -> f -> f -> (f * c Coupling.t) list - val fuse : t -> f list -> (f * c Coupling.t) list - val of_vertices : - (((f * f * f) * c Coupling.vertex3 * c) list - * ((f * f * f * f) * c Coupling.vertex4 * c) list - * (f list * c Coupling.vertexn * c) list) -> t - end - -module Fusions (F : Flavor) : Fusions with type f = F.f and type c = F.c = - struct - - type f = F.f - type c = F.c - - module F2 = - struct - type t = f * f - let hash = Hashtbl.hash - let compare (f1, f2) (f1', f2') = - let c1 = F.compare f1 f1' in - if c1 <> 0 then - c1 - else - F.compare f2 f2' - let equal f f' = compare f f' = 0 - end - - module F3 = - struct - type t = f * f * f - let hash = Hashtbl.hash - let compare (f1, f2, f3) (f1', f2', f3') = - let c1 = F.compare f1 f1' in - if c1 <> 0 then - c1 - else - let c2 = F.compare f2 f2' in - if c2 <> 0 then - c2 - else - F.compare f3 f3' - let equal f f' = compare f f' = 0 - end - - module Fn = - struct - type t = f list - let hash = Hashtbl.hash - let compare f f' = ThoList.compare ~cmp:F.compare f f' - let equal f f' = compare f f' = 0 - end - - module H2 = Hashtbl.Make (F2) - module H3 = Hashtbl.Make (F3) - module Hn = Hashtbl.Make (Fn) - - type t = - { v3 : (f * c Coupling.t) list H2.t; - v4 : (f * c Coupling.t) list H3.t; - vn : (f * c Coupling.t) list Hn.t } - - let fuse2 table f1 f2 = - try - H2.find table.v3 (f1, f2) - with - | Not_found -> [] - - let fuse3 table f1 f2 f3 = - try - H3.find table.v4 (f1, f2, f3) - with - | Not_found -> [] - - let fusen table f = - try - Hn.find table.vn f - with - | Not_found -> [] - - let fuse table = function - | [] | [_] -> invalid_arg "Fusions().fuse" - | [f1; f2] -> fuse2 table f1 f2 - | [f1; f2; f3] -> fuse3 table f1 f2 f3 - | f -> fusen table f - -(* Note that a pair or a triplet can appear more than once - (e.\,g.~$e^+e^-\to \gamma$ and~$e^+e^-\to Z$). Therefore don't - replace the entry, but augment it instead. *) - - let add_fusion2 table f1 f2 fusions = - H2.add table.v3 (f1, f2) (fusions :: fuse2 table f1 f2) - - let add_fusion3 table f1 f2 f3 fusions = - H3.add table.v4 (f1, f2, f3) (fusions :: fuse3 table f1 f2 f3) - - let add_fusionn table f fusions = - Hn.add table.vn f (fusions :: fusen table f) - -(* \begin{dubious} - Do we need to take into account the charge conjugation - of the coupling constants here? - \end{dubious} *) - -(* If some flavors are identical, we must not introduce the - same vertex more than once: *) - - open Coupling - - let permute3 (f1, f2, f3) = - [ (f1, f2), F.conjugate f3, F12; - (f2, f1), F.conjugate f3, F21; - (f2, f3), F.conjugate f1, F23; - (f3, f2), F.conjugate f1, F32; - (f3, f1), F.conjugate f2, F31; - (f1, f3), F.conjugate f2, F13 ] - -(* Here we add identical permutations of pairs only once: *) - - module F2' = Set.Make (F2) - - let add_permute3 table v c set ((f1, f2 as f12), f, p) = - if F2'.mem f12 set then - set - else begin - add_fusion2 table f1 f2 (f, V3 (v, p, c)); - F2'.add f12 set - end - - let add_vertex3 table (f123, v, c) = - ignore (List.fold_left (fun set f -> add_permute3 table v c set f) - F2'.empty (permute3 f123)) - -(* \begin{dubious} - Handling all the cases explicitely is OK for cubic vertices, but starts - to become questionable already for quartic couplings. The advantage - remains that we can check completeness in [Targets]. - \end{dubious} *) - - let permute4 (f1, f2, f3, f4) = - [ (f1, f2, f3), F.conjugate f4, F123; - (f2, f3, f1), F.conjugate f4, F231; - (f3, f1, f2), F.conjugate f4, F312; - (f2, f1, f3), F.conjugate f4, F213; - (f3, f2, f1), F.conjugate f4, F321; - (f1, f3, f2), F.conjugate f4, F132; - (f1, f2, f4), F.conjugate f3, F124; - (f2, f4, f1), F.conjugate f3, F241; - (f4, f1, f2), F.conjugate f3, F412; - (f2, f1, f4), F.conjugate f3, F214; - (f4, f2, f1), F.conjugate f3, F421; - (f1, f4, f2), F.conjugate f3, F142; - (f1, f3, f4), F.conjugate f2, F134; - (f3, f4, f1), F.conjugate f2, F341; - (f4, f1, f3), F.conjugate f2, F413; - (f3, f1, f4), F.conjugate f2, F314; - (f4, f3, f1), F.conjugate f2, F431; - (f1, f4, f3), F.conjugate f2, F143; - (f2, f3, f4), F.conjugate f1, F234; - (f3, f4, f2), F.conjugate f1, F342; - (f4, f2, f3), F.conjugate f1, F423; - (f3, f2, f4), F.conjugate f1, F324; - (f4, f3, f2), F.conjugate f1, F432; - (f2, f4, f3), F.conjugate f1, F243 ] - -(* Add identical permutations of triplets only once: *) - - module F3' = Set.Make (F3) - - let add_permute4 table v c set ((f1, f2, f3 as f123), f, p) = - if F3'.mem f123 set then - set - else begin - add_fusion3 table f1 f2 f3 (f, V4 (v, p, c)); - F3'.add f123 set - end - - let add_vertex4 table (f1234, v, c) = - ignore (List.fold_left (fun set f -> add_permute4 table v c set f) - F3'.empty (permute4 f1234)) - - let of_vertices (vlist3, vlist4, vlistn) = - match vlistn with - | [] -> - let table = - { v3 = H2.create 37; v4 = H3.create 37; vn = Hn.create 37 } in - List.iter (add_vertex3 table) vlist3; - List.iter (add_vertex4 table) vlist4; - table - | _ -> failwith "Models.Fusions.of_vertices: incomplete" - - end - -(* \thocwmodulesection{Mutable Models} *) - -module Mutable (FGC : sig type f and g and c end) = - struct - type flavor = FGC.f - type gauge = FGC.g - type constant = FGC.c - - type flavor_sans_color = flavor - let flavor_sans_color f = f - - let options = Options.empty - - exception Uninitialized of string - let unitialized name = - raise (Uninitialized name) - -(* Note that [lookup] works, by the magic of currying, for any arity. But - we need to supply one argument to delay evaluation. *) - -(* Also note that the references are \emph{not} shared among results - of functor applications. Simple module renaming causes sharing. *) - let declare template = - let reference = ref template in - let update fct = reference := fct - and lookup arg = !reference arg in - (update, lookup) - - let set_color, color = - declare (fun f -> unitialized "color") - let set_pdg, pdg = - declare (fun f -> unitialized "pdg") - let set_lorentz, lorentz = - declare (fun f -> unitialized "lorentz") - let set_propagator, propagator = - declare (fun f -> unitialized "propagator") - let set_width, width = - declare (fun f -> unitialized "width") - let set_goldstone, goldstone = - declare (fun f -> unitialized "goldstone") - let set_conjugate, conjugate = - declare (fun f -> unitialized "conjugate") - let set_conjugate_sans_color, conjugate_sans_color = - declare (fun f -> unitialized "conjugate_sans_color") - let set_fermion, fermion = - declare (fun f -> unitialized "fermion") - let set_max_degree, max_degree = - declare (fun () -> unitialized "max_degree") - let set_vertices, vertices = - declare (fun () -> unitialized "vertices") - let set_fuse2, fuse2 = - declare (fun f1 f2 -> unitialized "fuse2") - let set_fuse3, fuse3 = - declare (fun f1 f2 f3 -> unitialized "fuse3") - let set_fuse, fuse = - declare (fun f -> unitialized "fuse") - let set_flavors, flavors = - declare (fun () -> []) - let set_external_flavors, external_flavors = - declare (fun () -> [("unitialized", [])]) - let set_parameters, parameters = - declare (fun f -> unitialized "parameters") - let set_flavor_of_string, flavor_of_string = - declare (fun f -> unitialized "flavor_of_string") - let set_flavor_to_string, flavor_to_string = - declare (fun f -> unitialized "flavor_to_string") - let set_flavor_symbol, flavor_symbol = - declare (fun f -> unitialized "flavor_symbol") - let set_flavor_sans_color_of_string, flavor_sans_color_of_string = - declare (fun f -> unitialized "flavor_sans_color_of_string") - let set_flavor_sans_color_to_string, flavor_sans_color_to_string = - declare (fun f -> unitialized "flavor_sans_color_to_string") - let set_flavor_sans_color_symbol, flavor_sans_color_symbol = - declare (fun f -> unitialized "flavor_sans_color_symbol") - let set_gauge_symbol, gauge_symbol = - declare (fun f -> unitialized "gauge_symbol") - let set_mass_symbol, mass_symbol = - declare (fun f -> unitialized "mass_symbol") - let set_width_symbol, width_symbol = - declare (fun f -> unitialized "width_symbol") - let set_constant_symbol, constant_symbol = - declare (fun f -> unitialized "constant_symbol") - - let setup ~color ~pdg ~lorentz ~propagator ~width ~goldstone - ~conjugate ~fermion ~max_degree ~vertices - ~fuse:(fuse2, fuse3, fusen) - ~flavors ~parameters ~flavor_of_string ~flavor_to_string ~flavor_symbol - ~gauge_symbol ~mass_symbol ~width_symbol ~constant_symbol = - set_color color; - set_pdg pdg; - set_lorentz lorentz; - set_propagator propagator; - set_width width; - set_goldstone goldstone; - set_conjugate conjugate; - set_conjugate_sans_color conjugate; - set_fermion fermion; - set_max_degree (fun () -> max_degree); - set_vertices vertices; - set_fuse2 fuse2; - set_fuse3 fuse3; - set_fuse fusen; - set_external_flavors (fun f -> flavors); - let flavors = ThoList.flatmap snd flavors in - set_flavors (fun f -> flavors); - set_parameters parameters; - set_flavor_of_string flavor_of_string; - set_flavor_to_string flavor_to_string; - set_flavor_symbol flavor_symbol; - set_flavor_sans_color_of_string flavor_of_string; - set_flavor_sans_color_to_string flavor_to_string; - set_flavor_sans_color_symbol flavor_symbol; - set_gauge_symbol gauge_symbol; - set_mass_symbol mass_symbol; - set_width_symbol width_symbol; - set_constant_symbol constant_symbol - - let rcs = RCS.rename rcs_file "Models.Mutable" ["Mutable Model"] - end - -(* \thocwmodulesection{$\phi^3$} *) - -module Phi3 = - struct - let rcs = RCS.rename rcs_file "Models.Phi3" - ["phi**3 with a single flavor"] - - open Coupling - - let options = Options.empty - - type flavor = Phi - type flavor_sans_color = flavor - let flavor_sans_color f = f - let external_flavors () = [ "", [Phi]] - let flavors () = ThoList.flatmap snd (external_flavors ()) - - type gauge = unit - type constant = G - - let lorentz _ = Scalar - let color _ = Color.Singlet - let propagator _ = Prop_Scalar - let width _ = Timelike - let goldstone _ = None - let conjugate f = f - let conjugate_sans_color = conjugate - let fermion _ = 0 - - module F = Fusions (struct - type f = flavor - type c = constant - let compare = compare - let conjugate = conjugate - end) - - let vertices () = - ([(Phi, Phi, Phi), Scalar_Scalar_Scalar 1, G], [], []) - - let table = F.of_vertices (vertices ()) - let fuse2 = F.fuse2 table - let fuse3 = F.fuse3 table - let fuse = F.fuse table - let max_degree () = 3 - let parameters () = { input = [G, 1.0]; derived = []; derived_arrays = [] } - - let flavor_of_string = function - | "p" -> Phi - | _ -> invalid_arg "Models.Phi3.flavor_of_string" - - let flavor_to_string Phi = "phi" - let flavor_symbol Phi = "phi" - - let flavor_sans_color_of_string = flavor_of_string - let flavor_sans_color_to_string = flavor_to_string - let flavor_sans_color_symbol = flavor_symbol - - let gauge_symbol () = - failwith "Models.Phi3.gauge_symbol: internal error" - - let pdg _ = 1 - let mass_symbol _ = "m" - let width_symbol _ = "w" - let constant_symbol G = "g" - - end - -(* \thocwmodulesection{$\lambda_3\phi^3+\lambda_4\phi^4$} *) - -module Phi4 = - struct - let rcs = RCS.rename rcs_file "Models.Phi4" - ["phi**4 with a single flavor"] - - open Coupling - - let options = Options.empty - - type flavor = Phi - type flavor_sans_color = flavor - let flavor_sans_color f = f - let external_flavors () = [ "", [Phi]] - let flavors () = ThoList.flatmap snd (external_flavors ()) - - type gauge = unit - type constant = G3 | G4 - - let lorentz _ = Scalar - let color _ = Color.Singlet - let propagator _ = Prop_Scalar - let width _ = Timelike - let goldstone _ = None - let conjugate f = f - let conjugate_sans_color = conjugate - let fermion _ = 0 - - module F = Fusions (struct - type f = flavor - type c = constant - let compare = compare - let conjugate = conjugate - end) - - let vertices () = - ([(Phi, Phi, Phi), Scalar_Scalar_Scalar 1, G3], - [(Phi, Phi, Phi, Phi), Scalar4 1, G4], []) - - let fuse2 _ = failwith "Models.Phi4.fuse2" - let fuse3 _ = failwith "Models.Phi4.fuse3" - let fuse = function - | [] | [_] -> invalid_arg "Models.Phi4.fuse" - | [_; _] -> [Phi, V3 (Scalar_Scalar_Scalar 1, F23, G3)] - | [_; _; _] -> [Phi, V4 (Scalar4 1, F234, G4)] - | _ -> [] - let max_degree () = 4 - let parameters () = - { input = [G3, 1.0; G4, 1.0]; derived = []; derived_arrays = [] } - - let flavor_of_string = function - | "p" -> Phi - | _ -> invalid_arg "Models.Phi4.flavor_of_string" - - let flavor_to_string Phi = "phi" - let flavor_symbol Phi = "phi" - - let flavor_sans_color_of_string = flavor_of_string - let flavor_sans_color_to_string = flavor_to_string - let flavor_sans_color_symbol = flavor_symbol - - let gauge_symbol () = - failwith "Models.Phi4.gauge_symbol: internal error" - - let pdg _ = 1 - let mass_symbol _ = "m" - let width_symbol _ = "w" - let constant_symbol = function - | G3 -> "g3" - | G4 -> "g4" - - end - -(* \thocwmodulesection{Quantum Electro Dynamics} *) - -module QED = - struct - let rcs = RCS.rename rcs_file "Models.QED" - ["QED with two leptonic flavors"] - - open Coupling - - let options = Options.empty - - type flavor = - | Electron | Positron - | Muon | AntiMuon - | Tau | AntiTau - | Photon - - type flavor_sans_color = flavor - let flavor_sans_color f = f - - let external_flavors () = - [ "Leptons", [Electron; Positron; Muon; AntiMuon; Tau; AntiTau]; - "Gauge Bosons", [Photon] ] - let flavors () = ThoList.flatmap snd (external_flavors ()) - - type gauge = unit - type constant = Q - - let lorentz = function - | Electron | Muon | Tau -> Spinor - | Positron | AntiMuon | AntiTau -> ConjSpinor - | Photon -> Vector - - let color _ = Color.Singlet - - let propagator = function - | Electron | Muon | Tau -> Prop_Spinor - | Positron | AntiMuon | AntiTau -> Prop_ConjSpinor - | Photon -> Prop_Feynman - - let width _ = Timelike - - let goldstone _ = - None - - let conjugate = function - | Electron -> Positron | Positron -> Electron - | Muon -> AntiMuon | AntiMuon -> Muon - | Tau -> AntiTau | AntiTau -> Tau - | Photon -> Photon - - let conjugate_sans_color = conjugate - - let fermion = function - | Electron | Muon | Tau -> 1 - | Positron | AntiMuon | AntiTau -> -1 - | Photon -> 0 - - module F = Fusions (struct - type f = flavor - type c = constant - let compare = compare - let conjugate = conjugate - end) - - let vertices () = - ([(Positron, Photon, Electron), FBF (1, Psibar, V, Psi), Q; - (AntiMuon, Photon, Muon), FBF (1, Psibar, V, Psi), Q; - (AntiTau, Photon, Tau), FBF (1, Psibar, V, Psi), Q], [], []) - - let table = F.of_vertices (vertices ()) - let fuse2 = F.fuse2 table - let fuse3 = F.fuse3 table - let fuse = F.fuse table - let max_degree () = 3 - - let parameters () = { input = [Q, 1.0]; derived = []; derived_arrays = [] } - - let flavor_of_string = function - | "e-" -> Electron | "e+" -> Positron - | "m-" -> Muon | "m+" -> AntiMuon - | "t-" -> Tau | "t+" -> AntiTau - | "A" -> Photon - | _ -> invalid_arg "Models.QED.flavor_of_string" - - let flavor_to_string = function - | Electron -> "e-" | Positron -> "e+" - | Muon -> "m-" | AntiMuon -> "m+" - | Tau -> "t-" | AntiTau -> "t+" - | Photon -> "A" - - let flavor_symbol = function - | Electron -> "ele" | Positron -> "pos" - | Muon -> "muo" | AntiMuon -> "amu" - | Tau -> "tau" | AntiTau -> "ata" - | Photon -> "gam" - - let flavor_sans_color_of_string = flavor_of_string - let flavor_sans_color_to_string = flavor_to_string - let flavor_sans_color_symbol = flavor_symbol - - let gauge_symbol () = - failwith "Models.QED.gauge_symbol: internal error" - - let pdg = function - | Electron -> 11 | Positron -> -11 - | Muon -> 13 | AntiMuon -> -13 - | Tau -> 15 | AntiTau -> -15 - | Photon -> 22 - - let mass_symbol f = - "mass(" ^ string_of_int (abs (pdg f)) ^ ")" - - let width_symbol f = - "width(" ^ string_of_int (abs (pdg f)) ^ ")" - - let constant_symbol = function - | Q -> "qlep" - end - -(* \thocwmodulesection{Quantum Chromo Dynamics} *) - -module YM = - struct - let rcs = RCS.rename rcs_file "Models.YM" - ["incomplete Yang-Mills theory with one quark flavor"] - - open Coupling - - let options = Options.empty - - type flavor = Quark | Antiquark | Gluon | Gluon_aux - type flavor_sans_color = flavor - let flavor_sans_color f = f - - let external_flavors () = - [ "Quarks", [Quark; Antiquark]; - "Gauge Bosons", [Gluon] ] - let flavors () = ThoList.flatmap snd (external_flavors ()) @ [ Gluon_aux ] - - type gauge = unit - type constant = G - - let lorentz = function - | Quark -> Spinor - | Antiquark -> ConjSpinor - | Gluon -> Vector - | Gluon_aux -> Tensor_1 - - let color = function - | Quark -> Color.SUN 3 - | Antiquark -> Color.SUN (-3) - | Gluon | Gluon_aux -> Color.AdjSUN 3 - - let propagator = function - | Quark -> Prop_Spinor - | Antiquark -> Prop_ConjSpinor - | Gluon -> Prop_Feynman - | Gluon_aux -> Aux_Tensor_1 - - let width _ = Timelike - - let goldstone _ = - None - - let conjugate = function - | Quark -> Antiquark - | Antiquark -> Quark - | Gluon -> Gluon - | Gluon_aux -> Gluon_aux - - let conjugate_sans_color = conjugate - - let fermion = function - | Quark -> 1 - | Antiquark -> -1 - | Gluon | Gluon_aux -> 0 - - module F = Fusions (struct - type f = flavor - type c = constant - let compare = compare - let conjugate = conjugate - end) - - let vertices () = - ([(Antiquark, Gluon, Quark), FBF (1, Psibar, V, Psi), G; - (Gluon, Gluon, Gluon), Gauge_Gauge_Gauge 1, G; - (Gluon_aux, Gluon, Gluon), Aux_Gauge_Gauge 1, G], [], []) - -(*i - let vertices () = - ([(Antiquark, Gluon, Quark), FBF (1, Psibar, V, Psi), G; - (Gluon, Gluon, Gluon), Gauge_Gauge_Gauge 1, G], - [(Gluon, Gluon, Gluon, Gluon), Vector4 [1, C_12_34], G], []) -i*) - - let table = F.of_vertices (vertices ()) - let fuse2 = F.fuse2 table - let fuse3 = F.fuse3 table - let fuse = F.fuse table - let max_degree () = 4 - - let parameters () = - { input = [G, 1.0]; - derived = []; - derived_arrays = [] } - - let flavor_of_string = function - | "q" -> Quark - | "Q" -> Antiquark - | "g" -> Gluon - | _ -> invalid_arg "Models.YM.flavor_of_string" - - let flavor_to_string = function - | Quark -> "q" - | Antiquark -> "Q" - | Gluon -> "g" - | Gluon_aux -> "x" - - let flavor_symbol = function - | Quark -> "qu" - | Antiquark -> "aq" - | Gluon -> "gl" - | Gluon_aux -> "gl_aux" - - let flavor_sans_color_of_string = flavor_of_string - let flavor_sans_color_to_string = flavor_to_string - let flavor_sans_color_symbol = flavor_symbol - - let gauge_symbol () = - failwith "Models.YM.gauge_symbol: internal error" - - let pdg = function - | Quark -> 1 - | Antiquark -> -1 - | Gluon -> 21 - | Gluon_aux -> 0 - - let mass_symbol = function - | Quark -> "mass(1)" - | Antiquark -> "mass(1)" - | Gluon | Gluon_aux -> "mass(21)" - - let width_symbol = function - | Quark -> "width(1)" - | Antiquark -> "width(1)" - | Gluon | Gluon_aux -> "width(21)" - - let constant_symbol = function - | G -> "g" - - end - -(* \thocwmodulesection{Complete Minimal Standard Model (Unitarity Gauge)} *) - -module type SM_flags = - sig - val triple_anom : bool - val quartic_anom : bool - val higgs_anom : bool - val k_matrix : bool - val ckm_present : bool - end - -module SM_no_anomalous : SM_flags = - struct - let triple_anom = false - let quartic_anom = false - let higgs_anom = false - let k_matrix = false - let ckm_present = false - end - -module SM_no_anomalous_ckm : SM_flags = - struct - let triple_anom = false - let quartic_anom = false - let higgs_anom = false - let k_matrix = false - let ckm_present = true - end - -module SM_anomalous : SM_flags = - struct - let triple_anom = true - let quartic_anom = true - let higgs_anom = true - let k_matrix = false - let ckm_present = false - end - -module SM_anomalous_ckm : SM_flags = - struct - let triple_anom = true - let quartic_anom = true - let higgs_anom = true - let k_matrix = false - let ckm_present = true - end - -module SM_k_matrix : SM_flags = - struct - let triple_anom = false - let quartic_anom = true - let higgs_anom = false - let k_matrix = true - let ckm_present = false - end - -module SM3 (Flags : SM_flags) = - struct - let rcs = RCS.rename rcs_file "Models.SM3" - [ "minimal electroweak standard model in unitarity gauge"; - "with emulation of 4-point vertices; no CKM matrix" ] - - open Coupling - - let default_width = ref Timelike - let use_fudged_width = ref false - - let options = Options.create - [ "constant_width", Arg.Unit (fun () -> default_width := Constant), - "use constant width (also in t-channel)"; - "fudged_width", Arg.Set use_fudged_width, - "use fudge factor for charge particle width"; - "custom_width", Arg.String (fun f -> default_width := Custom f), - "use custom width"; - "cancel_widths", Arg.Unit (fun () -> default_width := Vanishing), - "use vanishing width"] - - type matter_field = L of int | N of int | U of int | D of int - type gauge_boson = Ga | Wp | Wm | Z | Gl - type other = - | XWp | XWm | XW3 | XGl - | Phip | Phim | Phi0 | H | XH - | XH_W | XH_W' | XH_Z | XH_Z' - | XSWm | XSWp | XSWpp | XSWmm - | XSWZ0 | XSZW0 | XSW3 | XSZZ - | XDH_W | XDH_W' | XDH_Z | XDH_Z' - | XDH_Wm | XDH_Wp | XDH_Z'' - | XDH2 - - type flavor = M of matter_field | G of gauge_boson | O of other - type flavor_sans_color = flavor - let flavor_sans_color f = f - - let matter_field f = M f - let gauge_boson f = G f - let other f = O f - - type field = - | Matter of matter_field - | Gauge of gauge_boson - | Other of other - - let field = function - | M f -> Matter f - | G f -> Gauge f - | O f -> Other f - - type gauge = unit - - let gauge_symbol () = - failwith "Models.SM3.gauge_symbol: internal error" - -(* The auxiliary fields [XH_W] and [XH_W'] are - mutual charge conjugates. This way the vertex $W^+_\mu W^{-,\mu}HH$ - can be split into $W^+_\mu W^{-,\mu}X_{HW}$ and $X_{HW}^*HH$ without - introducing the additional $W^+_\mu W^{-,\mu}W^+_\nu W^{-,\nu}$ and $HHHH$ - couplings that a neutral auxiliary field would produce. *) - - let family n = List.map matter_field [ L n; N n; U n; D n ] - - let external_flavors () = - [ "1st Generation", ThoList.flatmap family [1; -1]; - "2nd Generation", ThoList.flatmap family [2; -2]; - "3rd Generation", ThoList.flatmap family [3; -3]; - "Gauge Bosons", List.map gauge_boson [Ga; Z; Wp; Wm; Gl]; - "Higgs", List.map other [H]; - "Goldstone Bosons", List.map other [Phip; Phim; Phi0] ] - - let flavors () = - ThoList.flatmap snd (external_flavors ()) @ - List.map other - [ XWp; XWm; XW3; XGl; XH; XH_W; XH_W'; XH_Z; XH_Z'; - XSWm; XSWp; XSWpp; XSWmm; XSWZ0; XSZW0; XSW3; XSZZ; - XDH_W; XDH_W'; XDH_Z; XDH_Z'; - XDH_Wm; XDH_Wp; XDH_Z''; XDH2 ] - - let spinor n = - if n >= 0 then - Spinor - else - ConjSpinor - - let lorentz = function - | M f -> - begin match f with - | L n -> spinor n | N n -> spinor n - | U n -> spinor n | D n -> spinor n - end - | G f -> - begin match f with - | Ga | Gl -> Vector - | Wp | Wm | Z -> Massive_Vector - end - | O f -> - begin match f with - | XWp | XWm | XW3 | XGl -> Tensor_1 - | Phip | Phim | Phi0 -> Scalar - | H -> Scalar | XH -> Scalar - | XH_W | XH_W' -> Scalar - | XH_Z | XH_Z' -> Scalar - | XSWm | XSWp | XSWpp | XSWmm - | XSWZ0 | XSZW0 | XSW3 | XSZZ -> Scalar - | XDH_W | XDH_W' | XDH_Z | XDH_Z' - | XDH_Wm | XDH_Wp | XDH_Z'' | XDH2 -> Scalar - end - - let color = function - | M (U n) -> Color.SUN (if n > 0 then 3 else -3) - | M (D n) -> Color.SUN (if n > 0 then 3 else -3) - | G Gl -> Color.AdjSUN 3 - | _ -> Color.Singlet - - let prop_spinor n = - if n >= 0 then - Prop_Spinor - else - Prop_ConjSpinor - - let propagator = function - | M f -> - begin match f with - | L n -> prop_spinor n | N n -> prop_spinor n - | U n -> prop_spinor n | D n -> prop_spinor n - end - | G f -> - begin match f with - | Ga | Gl -> Prop_Feynman - | Wp | Wm | Z -> Prop_Unitarity - end - | O f -> - begin match f with - | XWp | XWm | XW3 | XGl -> Aux_Tensor_1 - | Phip | Phim | Phi0 -> Only_Insertion - | H -> Prop_Scalar | XH -> Aux_Scalar - | XH_W | XH_W' -> Aux_Scalar - | XH_Z | XH_Z' -> Aux_Scalar - | XSWm | XSWp | XSWpp | XSWmm - | XSWZ0 | XSZW0 | XSW3 | XSZZ -> Aux_Scalar - | XDH_W | XDH_W' | XDH_Z | XDH_Z' - | XDH_Wm | XDH_Wp | XDH_Z'' | XDH2 -> Aux_Scalar - end - -(* Optionally, ask for the fudge factor treatment for the widths of - charged particles. Currently, this only applies to $W^\pm$ and top. *) - - let width f = - if !use_fudged_width then - match f with - | G Wp | G Wm | M (U 3) | M (U (-3)) -> Fudged - | _ -> !default_width - else - !default_width - - let goldstone = function - | G f -> - begin match f with - | Wp -> Some (O Phip, Coupling.Const 1) - | Wm -> Some (O Phim, Coupling.Const 1) - | Z -> Some (O Phi0, Coupling.Const 1) - | _ -> None - end - | _ -> None - - let conjugate = function - | M f -> - M (begin match f with - | L n -> L (-n) | N n -> N (-n) - | U n -> U (-n) | D n -> D (-n) - end) - | G f -> - G (begin match f with - | Gl -> Gl | Ga -> Ga | Z -> Z - | Wp -> Wm | Wm -> Wp - end) - | O f -> - O (begin match f with - | XWp -> XWm | XWm -> XWp - | XW3 -> XW3 | XGl -> XGl - | Phip -> Phim | Phim -> Phip | Phi0 -> Phi0 - | H -> H | XH -> XH - | XH_W -> XH_W' | XH_W' -> XH_W - | XH_Z -> XH_Z' | XH_Z' -> XH_Z - | XSWm -> XSWp | XSWp -> XSWm - | XSWpp -> XSWmm | XSWmm -> XSWpp - | XSWZ0 -> XSZW0 | XSZW0 -> XSWZ0 - | XSW3 -> XSW3 | XSZZ -> XSZZ - | XDH_W -> XDH_W' | XDH_W' -> XDH_W - | XDH_Z -> XDH_Z' | XDH_Z' -> XDH_Z - | XDH_Wm -> XDH_Wp | XDH_Wp -> XDH_Wm - | XDH_Z'' -> XDH_Z'' | XDH2 -> XDH2 - end) - - let conjugate_sans_color = conjugate - - let fermion = function - | M f -> - begin match f with - | L n -> if n > 0 then 1 else -1 - | N n -> if n > 0 then 1 else -1 - | U n -> if n > 0 then 1 else -1 - | D n -> if n > 0 then 1 else -1 - end - | G f -> - begin match f with - | Gl | Ga | Z | Wp | Wm -> 0 - end - | O f -> - begin match f with - | XWp | XWm | XW3 | XGl -> 0 - | Phip | Phim | Phi0 -> 0 - | H | XH -> 0 - | XH_W | XH_W' | XH_Z | XH_Z' -> 0 - | XSWm | XSWp | XSWpp | XSWmm - | XSWZ0 | XSZW0 | XSW3 | XSZZ -> 0 - | XDH_W | XDH_W' | XDH_Z | XDH_Z' - | XDH_Wm | XDH_Wp | XDH_Z'' | XDH2 -> 0 - end - - type constant = - | Unit | Pi | Alpha_QED | Sin2thw - | Sinthw | Costhw | E | G_weak | Vev - | Q_lepton | Q_up | Q_down | G_CC - | G_NC_neutrino | G_NC_lepton | G_NC_up | G_NC_down - | I_Q_W | I_G_ZWW | I_G_WWW - | I_G1_AWW | I_G1_ZWW - | I_G1_plus_kappa_plus_G4_AWW - | I_G1_plus_kappa_plus_G4_ZWW - | I_G1_plus_kappa_minus_G4_AWW - | I_G1_plus_kappa_minus_G4_ZWW - | I_G1_minus_kappa_plus_G4_AWW - | I_G1_minus_kappa_plus_G4_ZWW - | I_G1_minus_kappa_minus_G4_AWW - | I_G1_minus_kappa_minus_G4_ZWW - | I_lambda_AWW | I_lambda_ZWW - | G5_AWW | G5_ZWW - | I_kappa5_AWW | I_kappa5_ZWW - | I_lambda5_AWW | I_lambda5_ZWW - | I_Alpha_WWWW0 | I_Alpha_ZZWW1 | I_Alpha_WWWW2 - | I_Alpha_ZZWW0 | I_Alpha_ZZZZ - | G_HWW | G_HHWW | G_HZZ | G_HHZZ | G_Hmm - | G_Htt | G_Hbb | G_Hcc | G_Htautau | G_H3 | G_H4 - | G_HGaZ | G_HGaGa | G_Hgg - | G_strong - | Mass of flavor | Width of flavor - | I_G_DH4 | G_DH2W2 | G_DH2Z2 | G_DHW2 | G_DHZ2 - -(* \begin{dubious} - The current abstract syntax for parameter dependencies is admittedly - tedious. Later, there will be a parser for a convenient concrete syntax - as a part of a concrete syntax for models. But as these examples show, - it should include simple functions. - \end{dubious} *) - -(* \begin{subequations} - \begin{align} - \alpha_{\text{QED}} &= \frac{1}{137.0359895} \\ - \sin^2\theta_w &= 0.23124 - \end{align} - \end{subequations} *) - let input_parameters = - [ Alpha_QED, 1. /. 137.0359895; - Sin2thw, 0.23124; - Mass (G Z), 91.187; - Mass (M (N 1)), 0.0; Mass (M (L 1)), 0.51099907e-3; - Mass (M (N 2)), 0.0; Mass (M (L 2)), 0.105658389; - Mass (M (N 3)), 0.0; Mass (M (L 3)), 1.77705; - Mass (M (U 1)), 5.0e-3; Mass (M (D 1)), 3.0e-3; - Mass (M (U 2)), 1.2; Mass (M (D 2)), 0.1; - Mass (M (U 3)), 174.0; Mass (M (D 3)), 4.2 ] - -(* \begin{subequations} - \begin{align} - e &= \sqrt{4\pi\alpha} \\ - \sin\theta_w &= \sqrt{\sin^2\theta_w} \\ - \cos\theta_w &= \sqrt{1-\sin^2\theta_w} \\ - g &= \frac{e}{\sin\theta_w} \\ - m_W &= \cos\theta_w m_Z \\ - v &= \frac{2m_W}{g} \\ - g_{CC} = - -\frac{g}{2\sqrt2} &= -\frac{e}{2\sqrt2\sin\theta_w} \\ - Q_{\text{lepton}} = - -q_{\text{lepton}}e &= e \\ - Q_{\text{up}} = - -q_{\text{up}}e &= -\frac{2}{3}e \\ - Q_{\text{down}} = - -q_{\text{down}}e &= \frac{1}{3}e \\ - \ii q_We = - \ii g_{\gamma WW} &= \ii e \\ - \ii g_{ZWW} &= \ii g \cos\theta_w \\ - \ii g_{WWW} &= \ii g - \end{align} - \end{subequations} *) - -(* \begin{dubious} - \ldots{} JR leaves this dubious as it is \ldots{} - but JR has corrected the errors.... - \end{dubious} - \begin{subequations} - \begin{align} - g_{HWW} &= g m_W = 2 \frac{m_W^2}{v} \\ - g_{HHWW} &= \frac{g}{\sqrt{2}} = \frac{\sqrt{2} m_W}{v} \\ - g_{HZZ} &= \frac{g}{\cos\theta_w}m_Z \\ - g_{HHZZ} &= \frac{g}{\sqrt{2}\cos\theta_w} = \frac{\sqrt{2} m_Z}{v} \\ - g_{Htt} &= \lambda_t \\ - g_{Hbb} &= \lambda_b=\frac{m_b}{m_t}\lambda_t \\ - g_{H^3} &= - \frac{3g}{2} \frac{m_H^2}{m_W} = - 3 \frac{m_H^2}{v} \\ - g_{H^4} &= \ii \frac{g}{2} \frac{m_H}{m_W} = \ii \frac{m_H}{v} - \end{align} - \end{subequations} *) - - let derived_parameters = - [ Real E, Sqrt (Prod [Const 4; Atom Pi; Atom Alpha_QED]); - Real Sinthw, Sqrt (Atom Sin2thw); - Real Costhw, Sqrt (Diff (Const 1, Atom Sin2thw)); - Real G_weak, Quot (Atom E, Atom Sinthw); - Real (Mass (G Wp)), Prod [Atom Costhw; Atom (Mass (G Z))]; - Real Vev, Quot (Prod [Const 2; Atom (Mass (G Wp))], Atom G_weak); - Real Q_lepton, Atom E; - Real Q_up, Prod [Quot (Const (-2), Const 3); Atom E]; - Real Q_down, Prod [Quot (Const 1, Const 3); Atom E]; - Real G_CC, Neg (Quot (Atom G_weak, Prod [Const 2; Sqrt (Const 2)])); - Complex I_Q_W, Prod [I; Atom E]; - Complex I_G_ZWW, Prod [I; Atom G_weak; Atom Costhw]; - Complex I_G_WWW, Prod [I; Atom G_weak] ] - -(* \begin{equation} - - \frac{g}{2\cos\theta_w} - \end{equation} *) - let g_over_2_costh = - Quot (Neg (Atom G_weak), Prod [Const 2; Atom Costhw]) - -(* \begin{subequations} - \begin{align} - - \frac{g}{2\cos\theta_w} g_V - &= - \frac{g}{2\cos\theta_w} (T_3 - 2 q \sin^2\theta_w) \\ - - \frac{g}{2\cos\theta_w} g_A - &= - \frac{g}{2\cos\theta_w} T_3 - \end{align} - \end{subequations} *) - let nc_coupling c t3 q = - (Real_Array c, - [Prod [g_over_2_costh; Diff (t3, Prod [Const 2; q; Atom Sin2thw])]; - Prod [g_over_2_costh; t3]]) - - let half = Quot (Const 1, Const 2) - - let derived_parameter_arrays = - [ nc_coupling G_NC_neutrino half (Const 0); - nc_coupling G_NC_lepton (Neg half) (Const (-1)); - nc_coupling G_NC_up half (Quot (Const 2, Const 3)); - nc_coupling G_NC_down (Neg half) (Quot (Const (-1), Const 3)) ] - - let parameters () = - { input = input_parameters; - derived = derived_parameters; - derived_arrays = derived_parameter_arrays } - - module F = Fusions (struct - type f = flavor - type c = constant - let compare = compare - let conjugate = conjugate - end) - -(* \begin{equation} - \mathcal{L}_{\textrm{EM}} = - - e \sum_i q_i \bar\psi_i\fmslash{A}\psi_i - \end{equation} *) - - let mgm ((m1, g, m2), fbf, c) = ((M m1, G g, M m2), fbf, c) - - let electromagnetic_currents n = - List.map mgm - [ ((L (-n), Ga, L n), FBF (1, Psibar, V, Psi), Q_lepton); - ((U (-n), Ga, U n), FBF (1, Psibar, V, Psi), Q_up); - ((D (-n), Ga, D n), FBF (1, Psibar, V, Psi), Q_down) ] - -(* \begin{equation} - \mathcal{L}_{\textrm{NC}} = - - \frac{g}{2\cos\theta_W} - \sum_i \bar\psi_i\fmslash{Z}(g_V^i-g_A^i\gamma_5)\psi_i - \end{equation} *) - - let neutral_currents n = - List.map mgm - [ ((L (-n), Z, L n), FBF (1, Psibar, VA, Psi), G_NC_lepton); - ((N (-n), Z, N n), FBF (1, Psibar, VA, Psi), G_NC_neutrino); - ((U (-n), Z, U n), FBF (1, Psibar, VA, Psi), G_NC_up); - ((D (-n), Z, D n), FBF (1, Psibar, VA, Psi), G_NC_down) ] - -(* \begin{equation} - \mathcal{L}_{\textrm{CC}} = - - \frac{g}{2\sqrt2} \sum_i \bar\psi_i - (T^+\fmslash{W}^+ + T^-\fmslash{W}^-)(1-\gamma_5)\psi_i - \end{equation} *) - - - let charged_currents n = - List.map mgm - [ ((L (-n), Wm, N n), FBF (1, Psibar, VL, Psi), G_CC); - ((N (-n), Wp, L n), FBF (1, Psibar, VL, Psi), G_CC); - ((D (-n), Wm, U n), FBF (1, Psibar, VL, Psi), G_CC); - ((U (-n), Wp, D n), FBF (1, Psibar, VL, Psi), G_CC) ] - - let yukawa = - [ ((M (U (-3)), O H, M (U 3)), FBF (1, Psibar, S, Psi), G_Htt); - ((M (D (-3)), O H, M (D 3)), FBF (1, Psibar, S, Psi), G_Hbb); - ((M (U (-2)), O H, M (U 2)), FBF (1, Psibar, S, Psi), G_Hcc); - ((M (L (-2)), O H, M (L 2)), FBF (1, Psibar, S, Psi), G_Hmm); - ((M (L (-3)), O H, M (L 3)), FBF (1, Psibar, S, Psi), G_Htautau) ] - -(* \begin{equation} - \mathcal{L}_{\textrm{TGC}} = - - e \partial_\mu A_\nu W_+^\mu W_-^\nu + \ldots - - e \cot\theta_w \partial_\mu Z_\nu W_+^\mu W_-^\nu + \ldots - \end{equation} *) - - let tgc ((g1, g2, g3), t, c) = ((G g1, G g2, G g3), t, c) - - let standard_triple_gauge = - List.map tgc - [ ((Ga, Wm, Wp), Gauge_Gauge_Gauge 1, I_Q_W); - ((Z, Wm, Wp), Gauge_Gauge_Gauge 1, I_G_ZWW) ] - -(* \begin{multline} - \mathcal{L}_{\textrm{TGC}}(g_1,\kappa) - = g_1 \mathcal{L}_T(V,W^+,W^-) \\ - + \frac{\kappa+g_1}{2} \Bigl(\mathcal{L}_T(W^-,V,W^+) - - \mathcal{L}_T(W^+,V,W^-)\Bigr)\\ - + \frac{\kappa-g_1}{2} \Bigl(\mathcal{L}_L(W^-,V,W^+) - - \mathcal{L}_T(W^+,V,W^-)\Bigr) - \end{multline} *) - -(* \begin{dubious} - The whole thing in the LEP2 workshop notation: - \begin{multline} - \ii\mathcal{L}_{\textrm{TGC},V} / g_{WWV} = \\ - g_1^V V^\mu (W^-_{\mu\nu}W^{+,\nu}-W^+_{\mu\nu}W^{-,\nu}) - + \kappa_V W^+_\mu W^-_\nu V^{\mu\nu} - + \frac{\lambda_V}{m_W^2} V_{\mu\nu} - W^-_{\rho\mu} W^{+,\hphantom{\nu}\rho}_{\hphantom{+,}\nu} \\ - + \ii g_5^V \epsilon_{\mu\nu\rho\sigma} - \left( (\partial^\rho W^{-,\mu}) W^{+,\nu} - - W^{-,\mu}(\partial^\rho W^{+,\nu}) \right) V^\sigma \\ - + \ii g_4^V W^-_\mu W^+_\nu (\partial^\mu V^\nu + \partial^\nu V^\mu) - - \frac{\tilde\kappa_V}{2} W^-_\mu W^+_\nu \epsilon^{\mu\nu\rho\sigma} - V_{\rho\sigma} - - \frac{\tilde\lambda_V}{2m_W^2} - W^-_{\rho\mu} W^{+,\mu}_{\hphantom{+,\mu}\nu} \epsilon^{\nu\rho\alpha\beta} - V_{\alpha\beta} - \end{multline} - using the conventions of Itzykson and Zuber with $\epsilon^{0123} = +1$. - \end{dubious} *) - -(* \begin{dubious} - This is equivalent to the notation of Hagiwara et al.~\cite{HPZH87}, if we - remember that they have opposite signs for~$g_{WWV}$: - \begin{multline} - \mathcal{L}_{WWV} / (-g_{WWV}) = \\ - \ii g_1^V \left( W^\dagger_{\mu\nu} W^\mu - - W^\dagger_\mu W^\mu_{\hphantom{\mu}\nu} \right) V^\nu - + \ii \kappa_V W^\dagger_\mu W_\nu V^{\mu\nu} - + \ii \frac{\lambda_V}{m_W^2} - W^\dagger_{\lambda\mu} W^\mu_{\hphantom{\mu}\nu} V^{\nu\lambda} \\ - - g_4^V W^\dagger_\mu W_\nu - \left(\partial^\mu V^\nu + \partial^\nu V^\mu \right) - + g_5^V \epsilon^{\mu\nu\lambda\sigma} - \left( W^\dagger_\mu \stackrel{\leftrightarrow}{\partial_\lambda} - W_\nu \right) V_\sigma\\ - + \ii \tilde\kappa_V W^\dagger_\mu W_\nu \tilde{V}^{\mu\nu} - + \ii\frac{\tilde\lambda_V}{m_W^2} - W^\dagger_{\lambda\mu} W^\mu_{\hphantom{\mu}\nu} \tilde{V}^{\nu\lambda} - \end{multline} - Here $V^\mu$ stands for either the photon or the~$Z$ field, $W^\mu$ is the - $W^-$ field, $W_{\mu\nu} = \partial_\mu W_\nu - \partial_\nu W_\mu$, - $V_{\mu\nu} = \partial_\mu V_\nu - \partial_\nu V_\mu$, and - $\tilde{V}_{\mu\nu} = \frac{1}{2} \epsilon_{\mu\nu\lambda\sigma} - V^{\lambda\sigma}$. - \end{dubious} *) - - let anomalous_triple_gauge = - List.map tgc - [ ((Ga, Wm, Wp), Dim4_Vector_Vector_Vector_T (-1), - I_G1_AWW); - ((Z, Wm, Wp), Dim4_Vector_Vector_Vector_T (-1), - I_G1_ZWW); - ((Wm, Ga, Wp), Dim4_Vector_Vector_Vector_T 1, - I_G1_plus_kappa_minus_G4_AWW); - ((Wm, Z, Wp), Dim4_Vector_Vector_Vector_T 1, - I_G1_plus_kappa_minus_G4_ZWW); - ((Wp, Ga, Wm), Dim4_Vector_Vector_Vector_T (-1), - I_G1_plus_kappa_plus_G4_AWW); - ((Wp, Z, Wm), Dim4_Vector_Vector_Vector_T (-1), - I_G1_plus_kappa_plus_G4_ZWW); - ((Wm, Ga, Wp), Dim4_Vector_Vector_Vector_L (-1), - I_G1_minus_kappa_plus_G4_AWW); - ((Wm, Z, Wp), Dim4_Vector_Vector_Vector_L (-1), - I_G1_minus_kappa_plus_G4_ZWW); - ((Wp, Ga, Wm), Dim4_Vector_Vector_Vector_L 1, - I_G1_minus_kappa_minus_G4_AWW); - ((Wp, Z, Wm), Dim4_Vector_Vector_Vector_L 1, - I_G1_minus_kappa_minus_G4_ZWW); - ((Ga, Wm, Wp), Dim4_Vector_Vector_Vector_T5 (-1), - I_kappa5_AWW); - ((Z, Wm, Wp), Dim4_Vector_Vector_Vector_T5 (-1), - I_kappa5_ZWW); - ((Ga, Wm, Wp), Dim4_Vector_Vector_Vector_L5 (-1), - G5_AWW); - ((Z, Wm, Wp), Dim4_Vector_Vector_Vector_L5 (-1), - G5_ZWW); - ((Ga, Wp, Wm), Dim6_Gauge_Gauge_Gauge (-1), - I_lambda_AWW); - ((Z, Wp, Wm), Dim6_Gauge_Gauge_Gauge (-1), - I_lambda_ZWW); - ((Ga, Wp, Wm), Dim6_Gauge_Gauge_Gauge_5 (-1), - I_lambda5_AWW); - ((Z, Wp, Wm), Dim6_Gauge_Gauge_Gauge_5 (-1), - I_lambda5_ZWW) ] - - let triple_gauge = - if Flags.triple_anom then - anomalous_triple_gauge - else - standard_triple_gauge - -(* \begin{equation} - \mathcal{L}_{\textrm{QGC}} = - - g^2 W_{+,\mu} W_{-,\nu} W_+^\mu W_-^\nu + \ldots - \end{equation} *) - - let tgc_aux ((aux, g1, g2), t, c) = ((O aux, G g1, G g2), t, c) - - let standard_quartic_gauge = - List.map tgc_aux - [ ((XW3, Wm, Wp), Aux_Gauge_Gauge 1, I_G_WWW); - ((XWm, Wp, Ga), Aux_Gauge_Gauge 1, I_Q_W); - ((XWm, Wp, Z), Aux_Gauge_Gauge 1, I_G_ZWW); - ((XWp, Ga, Wm), Aux_Gauge_Gauge 1, I_Q_W); - ((XWp, Z, Wm), Aux_Gauge_Gauge 1, I_G_ZWW) ] - -(* \begin{subequations} - \begin{align} - \mathcal{L}_4 - &= \alpha_4 \left( \frac{g^4}{2}\left( (W^+_\mu W^{-,\mu})^2 - + W^+_\mu W^{+,\mu} W^-_\mu W^{-,\mu} - \right)\right.\notag \\ - &\qquad\qquad\qquad \left. - + \frac{g^4}{\cos^2\theta_w} W^+_\mu Z^\mu W^-_\nu Z^\nu - + \frac{g^4}{4\cos^4\theta_w} (Z_\mu Z^\mu)^2 \right) \\ - \mathcal{L}_5 - &= \alpha_5 \left( g^4 (W^+_\mu W^{-,\mu})^2 - + \frac{g^4}{\cos^2\theta_w} W^+_\mu W^{-,\mu} Z_\nu Z^\nu - + \frac{g^4}{4\cos^4\theta_w} (Z_\mu Z^\mu)^2 \right) - \end{align} - \end{subequations} - or - \begin{multline} - \mathcal{L}_4 + \mathcal{L}_5 - = (\alpha_4+2\alpha_5) g^4 \frac{1}{2} (W^+_\mu W^{-,\mu})^2 \\ - + 2\alpha_4 g^4 \frac{1}{4} W^+_\mu W^{+,\mu} W^-_\mu W^{-,\mu} - + \alpha_4 \frac{g^4}{\cos^2\theta_w} W^+_\mu Z^\mu W^-_\nu Z^\nu \\ - + 2\alpha_5 \frac{g^4}{\cos^2\theta_w} \frac{1}{2} W^+_\mu W^{-,\mu} Z_\nu Z^\nu - + (2\alpha_4 + 2\alpha_5) \frac{g^4}{\cos^4\theta_w} \frac{1}{8} (Z_\mu Z^\mu)^2 - \end{multline} - and therefore - \begin{subequations} - \begin{align} - (\ii\alpha_{(WW)_0})^2 &= (\alpha_4+2\alpha_5) g^4 \\ - (\ii\alpha_{(WW)_2})^2 &= 2\alpha_4 g^4 \\ - (\ii\alpha_{(WZ)_\pm})^2 &= \alpha_4 \frac{g^4}{\cos^2\theta_w} \\ - (\ii\alpha_{(WZ)_0})^2 &= 2\alpha_5 \frac{g^4}{\cos^2\theta_w} \\ - (\ii\alpha_{ZZ})^2 &= (2\alpha_4 + 2\alpha_5) \frac{g^4}{\cos^4\theta_w} - \end{align} - \end{subequations} - Not that the auxiliary couplings are purely imaginary, because~$\alpha_4$ - and~$\alpha_5$ are defined with a \emph{positive} sign and we expect - quartic couplings to have a \emph{negative} sign for the energy to be - bounded from below. *) - - let anomalous_quartic_gauge = - List.map tgc_aux - [ ((XSW3, Wm, Wp), Aux_Vector_Vector 1, I_Alpha_WWWW0); - ((XSWpp, Wm, Wm), Aux_Vector_Vector 1, I_Alpha_WWWW2); - ((XSWmm, Wp, Wp), Aux_Vector_Vector 1, I_Alpha_WWWW2); - ((XSWm, Wp, Z), Aux_Vector_Vector 1, I_Alpha_ZZWW1); - ((XSWp, Wm, Z), Aux_Vector_Vector 1, I_Alpha_ZZWW1); - ((XSWZ0, Wp, Wm), Aux_Vector_Vector 1, I_Alpha_ZZWW0); - ((XSZW0, Z, Z), Aux_Vector_Vector 1, I_Alpha_ZZWW0); - ((XSZZ, Z, Z), Aux_Vector_Vector 1, I_Alpha_ZZZZ) ] - - let quartic_gauge = - if Flags.quartic_anom then - standard_quartic_gauge @ anomalous_quartic_gauge - else - standard_quartic_gauge - - let standard_gauge_higgs = - [ ((O H, G Wp, G Wm), Scalar_Vector_Vector 1, G_HWW); - ((O H, G Z, G Z), Scalar_Vector_Vector 1, G_HZZ); - ((O XH_W, G Wp, G Wm), Aux_Vector_Vector 1, G_HHWW); - ((O XH_W', O H, O H), Aux_Scalar_Scalar 1, G_HHWW); - ((O XH_Z, G Z, G Z), Aux_Vector_Vector 1, G_HHZZ); - ((O XH_Z', O H, O H), Aux_Scalar_Scalar 1, G_HHZZ) ] - -(* WK's couplings (apparently, he still intends to divide by - $\Lambda^2_{\text{EWSB}}=16\pi^2v_{\mathrm{F}}^2$): - \begin{subequations} - \begin{align} - \mathcal{L}^{\tau}_4 &= - \left\lbrack (\partial_{\mu}H)(\partial^{\mu}H) - + \frac{g^2v_{\mathrm{F}}^2}{4} V_{\mu} V^{\mu} \right\rbrack^2 \\ - \mathcal{L}^{\tau}_5 &= - \left\lbrack (\partial_{\mu}H)(\partial_{\nu}H) - + \frac{g^2v_{\mathrm{F}}^2}{4} V_{\mu} V_{\nu} \right\rbrack^2 - \end{align} - \end{subequations} - with - \begin{equation} - V_{\mu} V_{\nu} = - \frac{1}{2} \left( W^+_{\mu} W^-_{\nu} + W^+_{\nu} W^-_{\mu} \right) - + \frac{1}{2\cos^2\theta_{w}} Z_{\mu} Z_{\nu} - \end{equation} - (note the symmetrization!), i.\,e. - \begin{subequations} - \begin{align} - \mathcal{L}_4 &= \alpha_4 \frac{g^4v_{\mathrm{F}}^4}{16} (V_{\mu} V_{\nu})^2 \\ - \mathcal{L}_5 &= \alpha_5 \frac{g^4v_{\mathrm{F}}^4}{16} (V_{\mu} V^{\mu})^2 - \end{align} - \end{subequations} *) - -(* Breaking thinks up - \begin{subequations} - \begin{align} - \mathcal{L}^{\tau,H^4}_4 &= - \left\lbrack (\partial_{\mu}H)(\partial^{\mu}H) \right\rbrack^2 \\ - \mathcal{L}^{\tau,H^4}_5 &= - \left\lbrack (\partial_{\mu}H)(\partial^{\mu}H) \right\rbrack^2 - \end{align} - \end{subequations} - and - \begin{subequations} - \begin{align} - \mathcal{L}^{\tau,H^2V^2}_4 &= \frac{g^2v_{\mathrm{F}}^2}{2} - (\partial_{\mu}H)(\partial^{\mu}H) V_{\mu}V^{\mu} \\ - \mathcal{L}^{\tau,H^2V^2}_5 &= \frac{g^2v_{\mathrm{F}}^2}{2} - (\partial_{\mu}H)(\partial_{\nu}H) V_{\mu}V_{\nu} - \end{align} - \end{subequations} - i.\,e. - \begin{subequations} - \begin{align} - \mathcal{L}^{\tau,H^2V^2}_4 &= - \frac{g^2v_{\mathrm{F}}^2}{2} - \left\lbrack - (\partial_{\mu}H)(\partial^{\mu}H) W^+_{\nu}W^{-,\nu} - + \frac{1}{2\cos^2\theta_{w}} (\partial_{\mu}H)(\partial^{\mu}H) Z_{\nu} Z^{\nu} - \right\rbrack \\ - \mathcal{L}^{\tau,H^2V^2}_5 &= - \frac{g^2v_{\mathrm{F}}^2}{2} - \left\lbrack - (W^{+,\mu}\partial_{\mu}H) (W^{-,\nu}\partial_{\nu}H) - + \frac{1}{2\cos^2\theta_{w}} (Z^{\mu}\partial_{\mu}H)(Z^{\nu}\partial_{\nu}H) - \right\rbrack - \end{align} - \end{subequations} *) - -(* \begin{multline} - \tau^4_8 \mathcal{L}^{\tau,H^2V^2}_4 + \tau^5_8 \mathcal{L}^{\tau,H^2V^2}_5 = \\ - - \frac{g^2v_{\mathrm{F}}^2}{2} \Biggl\lbrack - 2\tau^4_8 - \frac{1}{2}(\ii\partial_{\mu}H)(\ii\partial^{\mu}H) W^+_{\nu}W^{-,\nu} - + \tau^5_8 - (W^{+,\mu}\ii\partial_{\mu}H) (W^{-,\nu}\ii\partial_{\nu}H) \\ - + \frac{2\tau^4_8}{\cos^2\theta_{w}} - \frac{1}{4} (\ii\partial_{\mu}H)(\ii\partial^{\mu}H) Z_{\nu} Z^{\nu} - + \frac{\tau^5_8}{\cos^2\theta_{w}} - \frac{1}{2} (Z^{\mu}\ii\partial_{\mu}H)(Z^{\nu}\ii\partial_{\nu}H) - \Biggr\rbrack - \end{multline} - where the two powers of $\ii$ make the sign conveniently negative, - i.\,e. - \begin{subequations} - \begin{align} - \alpha_{(\partial H)^2W^2}^2 &= \tau^4_8 g^2v_{\mathrm{F}}^2\\ - \alpha_{(\partial HW)^2}^2 &= \frac{\tau^5_8 g^2v_{\mathrm{F}}^2}{2} \\ - \alpha_{(\partial H)^2Z^2}^2 &= \frac{\tau^4_8 g^2v_{\mathrm{F}}^2}{\cos^2\theta_{w}} \\ - \alpha_{(\partial HZ)^2}^2 &=\frac{\tau^5_8 g^2v_{\mathrm{F}}^2}{2\cos^2\theta_{w}} - \end{align} - \end{subequations} *) - - let anomalous_gauge_higgs = - [ ((O XDH_W, O H, O H), Aux_DScalar_DScalar 1, G_DH2W2); - ((O XDH_W', G Wp, G Wm), Aux_Vector_Vector 1, G_DH2W2); - ((O XDH_Z, O H, O H), Aux_DScalar_DScalar 1, G_DH2Z2); - ((O XDH_Z', G Z, G Z), Aux_Vector_Vector 1, G_DH2Z2); - ((O XDH_Wm, G Wp, O H), Aux_Vector_DScalar 1, G_DHW2); - ((O XDH_Wp, G Wm, O H), Aux_Vector_DScalar 1, G_DHW2); - ((O XDH_Z'', G Z, O H), Aux_Vector_DScalar 1, G_DHZ2) ] - - let gauge_higgs = - if Flags.higgs_anom then - standard_gauge_higgs @ anomalous_gauge_higgs - else - standard_gauge_higgs - -(* \begin{equation} - \mathcal{L}_{\text{Higgs}} = - \frac{1}{3!} g_{H,3} H^3 - \frac{1}{4!} g_{H,4}^2 H^4 - \end{equation} - According to~(\ref{eq:quartic-aux}), the required negative sign - for the quartic piece is reproduced by any real $g_{H,4}$ in the - auxiliary field couplings. - \begin{multline} - \mathcal{L}_{\text{Higgs}} = - - \frac{1}{4!} g_{H,4}^2 \left((\phi^\dagger\phi)^2 - \mu^2\right)^2 \\ - \to - \frac{1}{4!} g_{H,4}^2 \left((\mu+H)^2 - \mu^2\right)^2 - = - \frac{1}{4!} g_{H,4}^2 \left(2\mu H + H^2\right)^2 \\ - = - \frac{1}{4!} g_{H,4}^2 H^4 - - \frac{1}{3!} g_{H,4}^2 \mu H^3 - - \frac{1}{3!} g_{H,4}^2 \mu^2 H^2 - \end{multline} *) - - let standard_higgs = - [ ((O H, O H, O H), Scalar_Scalar_Scalar 1, G_H3); - ((O XH, O H, O H), Aux_Scalar_Scalar 1, G_H4) ] - -(* \begin{equation} - \tau^4_8 \mathcal{L}^{\tau,H^4}_4 + \tau^5_8 \mathcal{L}^{\tau,H^4}_5 - = 8 (\tau^4_8+\tau^5_8) \frac{1}{8} - \left\lbrack (\ii\partial_{\mu}H)(\ii\partial^{\mu}H) \right\rbrack^2 - \end{equation} - since there are four powers of $\ii$, the sign remains positive, - i.\,e. - \begin{equation} - (\ii\alpha_{(\partial H)^4})^2 = 8 (\tau^4_8+\tau^5_8) - \end{equation} *) - - let anomalous_higgs = - [ ((O XDH2, O H, O H), Aux_DScalar_DScalar 1, I_G_DH4) ] - - let anomaly_higgs = - [] -(*i [ (O H, G Ga, G Ga), Dim5_Scalar_Gauge2 1, G_HGaGa; - (O H, G Ga, G Z), Dim5_Scalar_Gauge2 1, G_HGaZ; - (O H, G Gl, G Gl), Dim5_Scalar_Gauge2 1, G_Hgg ] i*) - - let higgs = - if Flags.higgs_anom then - standard_higgs @ anomalous_higgs - else - standard_higgs - - let goldstone_vertices = - [ ((O Phi0, G Wm, G Wp), Scalar_Vector_Vector 1, I_G_ZWW); - ((O Phip, G Ga, G Wm), Scalar_Vector_Vector 1, I_Q_W); - ((O Phip, G Z, G Wm), Scalar_Vector_Vector 1, I_G_ZWW); - ((O Phim, G Wp, G Ga), Scalar_Vector_Vector 1, I_Q_W); - ((O Phim, G Wp, G Z), Scalar_Vector_Vector 1, I_G_ZWW) ] - - let vertices3 = - (ThoList.flatmap electromagnetic_currents [1;2;3] @ - ThoList.flatmap neutral_currents [1;2;3] @ - ThoList.flatmap charged_currents [1;2;3] @ - yukawa @ triple_gauge @ quartic_gauge @ - gauge_higgs @ higgs @ anomaly_higgs @ goldstone_vertices) - - let vertices () = (vertices3, [], []) - -(* For efficiency, make sure that [F.of_vertices vertices] is - evaluated only once. *) - - let table = F.of_vertices (vertices ()) - let fuse2 = F.fuse2 table - let fuse3 = F.fuse3 table - let fuse = F.fuse table - let max_degree () = 3 - - let flavor_of_string = function - | "e-" -> M (L 1) | "e+" -> M (L (-1)) - | "mu-" -> M (L 2) | "mu+" -> M (L (-2)) - | "tau-" -> M (L 3) | "tau+" -> M (L (-3)) - | "nue" -> M (N 1) | "nuebar" -> M (N (-1)) - | "numu" -> M (N 2) | "numubar" -> M (N (-2)) - | "nutau" -> M (N 3) | "nutaubar" -> M (N (-3)) - | "u" -> M (U 1) | "ubar" -> M (U (-1)) - | "c" -> M (U 2) | "cbar" -> M (U (-2)) - | "t" -> M (U 3) | "tbar" -> M (U (-3)) - | "d" -> M (D 1) | "dbar" -> M (D (-1)) - | "s" -> M (D 2) | "sbar" -> M (D (-2)) - | "b" -> M (D 3) | "bbar" -> M (D (-3)) - | "g" -> G Gl - | "A" -> G Ga | "Z" | "Z0" -> G Z - | "W+" -> G Wp | "W-" -> G Wm - | "H" -> O H - | _ -> invalid_arg "Models.SM3.flavor_of_string" - - let flavor_to_string = function - | M f -> - begin match f with - | L 1 -> "e-" | L (-1) -> "e+" - | L 2 -> "mu-" | L (-2) -> "mu+" - | L 3 -> "tau-" | L (-3) -> "tau+" - | L _ -> invalid_arg - "Models.SM3.flavor_to_string: invalid lepton" - | N 1 -> "nue" | N (-1) -> "nuebar" - | N 2 -> "numu" | N (-2) -> "numubar" - | N 3 -> "nutau" | N (-3) -> "nutaubar" - | N _ -> invalid_arg - "Models.SM3.flavor_to_string: invalid neutrino" - | U 1 -> "u" | U (-1) -> "ubar" - | U 2 -> "c" | U (-2) -> "cbar" - | U 3 -> "t" | U (-3) -> "tbar" - | U _ -> invalid_arg - "Models.SM3.flavor_to_string: invalid up type quark" - | D 1 -> "d" | D (-1) -> "dbar" - | D 2 -> "s" | D (-2) -> "sbar" - | D 3 -> "b" | D (-3) -> "bbar" - | D _ -> invalid_arg - "Models.SM3.flavor_to_string: invalid down type quark" - end - | G f -> - begin match f with - | Gl -> "g" - | Ga -> "A" | Z -> "Z" - | Wp -> "W+" | Wm -> "W-" - end - | O f -> - begin match f with - | XWp -> "W+aux" | XWm -> "W-aux" - | XW3 -> "W3aux" | XGl -> "gaux" - | Phip -> "phi+" | Phim -> "phi-" | Phi0 -> "phi0" - | H -> "H" | XH -> "Haux" - | XH_W -> "HW1aux" | XH_W' -> "HW2aux" - | XH_Z -> "HZ1aux" | XH_Z' -> "HZ2aux" - | XSWm -> "W-Zaux" | XSWp -> "W+Zaux" - | XSWpp -> "W+W+aux" | XSWmm -> "W-W-aux" - | XSWZ0 -> "W+W-/ZZaux" | XSZW0 -> "ZZ/W+W-aux" - | XSW3 -> "W+W-aux" | XSZZ -> "ZZaux" - | XDH_W -> "DHDH/W+W-aux" | XDH_W' -> "DHDH/W+W-aux'" - | XDH_Z -> "DHDH/ZZaux" | XDH_Z' -> "DHDH/ZZaux'" - | XDH_Wm -> "DHW-aux" | XDH_Wp -> "DHW+aux" - | XDH_Z'' -> "DHZaux" | XDH2 -> "DHDHaux" - end - - let flavor_symbol = function - | M f -> - begin match f with - | L n when n > 0 -> "l" ^ string_of_int n - | L n -> "l" ^ string_of_int (abs n) ^ "b" - | N n when n > 0 -> "n" ^ string_of_int n - | N n -> "n" ^ string_of_int (abs n) ^ "b" - | U n when n > 0 -> "u" ^ string_of_int n - | U n -> "u" ^ string_of_int (abs n) ^ "b" - | D n when n > 0 -> "d" ^ string_of_int n - | D n -> "d" ^ string_of_int (abs n) ^ "b" - end - | G f -> - begin match f with - | Gl -> "gl" - | Ga -> "a" | Z -> "z" - | Wp -> "wp" | Wm -> "wm" - end - | O f -> - begin match f with - | XWp -> "xwp" | XWm -> "xwm" - | XW3 -> "xw3" | XGl -> "xgl" - | Phip -> "pp" | Phim -> "pm" | Phi0 -> "p0" - | H -> "h" | XH -> "xh" - | XH_W -> "xhw1" | XH_W' -> "xhw2" - | XH_Z -> "xhz1" | XH_Z' -> "xhz2" - | XSWm -> "xswm" | XSWp -> "xswp" - | XSWpp -> "xswpp" | XSWmm -> "xswmm" - | XSWZ0 -> "xswz0" | XSZW0 -> "xszw0" - | XSW3 -> "xsww" | XSZZ -> "xszz" - | XDH_W -> "xdhw1" | XDH_W' -> "xdhw2" - | XDH_Z -> "xdhz1" | XDH_Z' -> "xdhz2" - | XDH_Wm -> "xdhwm" | XDH_Wp -> "xdhwp" - | XDH_Z'' -> "xdhz" | XDH2 -> "xdh" - end - - let flavor_sans_color_of_string = flavor_of_string - let flavor_sans_color_to_string = flavor_to_string - let flavor_sans_color_symbol = flavor_symbol - - let pdg = function - | M f -> - begin match f with - | L n when n > 0 -> 9 + 2*n - | L n -> - 9 + 2*n - | N n when n > 0 -> 10 + 2*n - | N n -> - 10 + 2*n - | U n when n > 0 -> 2*n - | U n -> 2*n - | D n when n > 0 -> - 1 + 2*n - | D n -> 1 + 2*n - end - | G f -> - begin match f with - | Gl -> 21 - | Ga -> 22 | Z -> 23 - | Wp -> 24 | Wm -> (-24) - end - | O f -> - begin match f with - | XWp | XWm | XW3 | XGl -> 0 - | Phip | Phim -> 27 | Phi0 -> 26 - | H -> 25 - | XH -> 0 - | XH_W | XH_W' -> 0 - | XH_Z | XH_Z' -> 0 - | XSWm | XSWp | XSWpp | XSWmm - | XSWZ0 | XSZW0 | XSW3 | XSZZ -> 0 - | XDH_W | XDH_W' | XDH_Z | XDH_Z' - | XDH_Wm | XDH_Wp | XDH_Z'' | XDH2 -> 0 - end - - let mass_symbol f = - "mass(" ^ string_of_int (abs (pdg f)) ^ ")" - - let width_symbol f = - "width(" ^ string_of_int (abs (pdg f)) ^ ")" - - let constant_symbol = function - | Unit -> "unit" | Pi -> "PI" - | Alpha_QED -> "alpha" | E -> "e" | G_weak -> "g" | Vev -> "vev" - | Sin2thw -> "sin2thw" | Sinthw -> "sinthw" | Costhw -> "costhw" - | Q_lepton -> "qlep" | Q_up -> "qup" | Q_down -> "qdwn" - | G_NC_lepton -> "gnclep" | G_NC_neutrino -> "gncneu" - | G_NC_up -> "gncup" | G_NC_down -> "gncdwn" - | G_CC -> "gcc" - | I_Q_W -> "iqw" | I_G_ZWW -> "igzww" | I_G_WWW -> "igwww" - | I_G1_AWW -> "ig1a" | I_G1_ZWW -> "ig1z" - | I_G1_plus_kappa_plus_G4_AWW -> "ig1pkpg4a" - | I_G1_plus_kappa_plus_G4_ZWW -> "ig1pkpg4z" - | I_G1_plus_kappa_minus_G4_AWW -> "ig1pkmg4a" - | I_G1_plus_kappa_minus_G4_ZWW -> "ig1pkmg4z" - | I_G1_minus_kappa_plus_G4_AWW -> "ig1mkpg4a" - | I_G1_minus_kappa_plus_G4_ZWW -> "ig1mkpg4z" - | I_G1_minus_kappa_minus_G4_AWW -> "ig1mkmg4a" - | I_G1_minus_kappa_minus_G4_ZWW -> "ig1mkmg4z" - | I_lambda_AWW -> "ila" - | I_lambda_ZWW -> "ilz" - | G5_AWW -> "rg5a" - | G5_ZWW -> "rg5z" - | I_kappa5_AWW -> "ik5a" - | I_kappa5_ZWW -> "ik5z" - | I_lambda5_AWW -> "il5a" | I_lambda5_ZWW -> "il5z" - | I_Alpha_WWWW0 -> "ialww0" | I_Alpha_WWWW2 -> "ialww2" - | I_Alpha_ZZWW0 -> "ialzw0" | I_Alpha_ZZWW1 -> "ialzw1" - | I_Alpha_ZZZZ -> "ialzz" - | G_HWW -> "ghww" | G_HZZ -> "ghzz" - | G_HHWW -> "ghhww" | G_HHZZ -> "ghhzz" - | G_Htt -> "ghtt" | G_Hbb -> "ghbb" - | G_Htautau -> "ghtautau" | G_Hcc -> "ghcc" | G_Hmm -> "ghmm" - | G_H3 -> "gh3" | G_H4 -> "gh4" - | G_HGaZ -> "ghgaz" | G_HGaGa -> "ghgaga" | G_Hgg -> "ghgg" - | G_strong -> "gs" - | Mass f -> "mass" ^ flavor_symbol f - | Width f -> "width" ^ flavor_symbol f - | I_G_DH4 -> "igdh4" - | G_DH2W2 -> "gdh2w2" | G_DH2Z2 -> "gdh2z2" - | G_DHW2 -> "gdhw2" | G_DHZ2 -> "gdhz2" - - end - -(* \thocwmodulesection{Complete Minimal Standard Model with Genuine Quartic Couplings} *) - -module SM (Flags : SM_flags) = - struct - let rcs = RCS.rename rcs_file "Models.SM" - [ "minimal electroweak standard model in unitarity gauge"] - - open Coupling - - let default_width = ref Timelike - let use_fudged_width = ref false - - let options = Options.create - [ "constant_width", Arg.Unit (fun () -> default_width := Constant), - "use constant width (also in t-channel)"; - "fudged_width", Arg.Set use_fudged_width, - "use fudge factor for charge particle width"; - "custom_width", Arg.String (fun f -> default_width := Custom f), - "use custom width"; - "cancel_widths", Arg.Unit (fun () -> default_width := Vanishing), - "use vanishing width"] - - type matter_field = L of int | N of int | U of int | D of int - type gauge_boson = Ga | Wp | Wm | Z | Gl - type other = Phip | Phim | Phi0 | H - type flavor = M of matter_field | G of gauge_boson | O of other - type flavor_sans_color = flavor - let flavor_sans_color f = f - - let matter_field f = M f - let gauge_boson f = G f - let other f = O f - - type field = - | Matter of matter_field - | Gauge of gauge_boson - | Other of other - - let field = function - | M f -> Matter f - | G f -> Gauge f - | O f -> Other f - - type gauge = unit - - let gauge_symbol () = - failwith "Models.SM.gauge_symbol: internal error" - - let family n = List.map matter_field [ L n; N n; U n; D n ] - - let external_flavors () = - [ "1st Generation", ThoList.flatmap family [1; -1]; - "2nd Generation", ThoList.flatmap family [2; -2]; - "3rd Generation", ThoList.flatmap family [3; -3]; - "Gauge Bosons", List.map gauge_boson [Ga; Z; Wp; Wm; Gl]; - "Higgs", List.map other [H]; - "Goldstone Bosons", List.map other [Phip; Phim; Phi0] ] - - let flavors () = ThoList.flatmap snd (external_flavors ()) - - let spinor n = - if n >= 0 then - Spinor - else - ConjSpinor - - let lorentz = function - | M f -> - begin match f with - | L n -> spinor n | N n -> spinor n - | U n -> spinor n | D n -> spinor n - end - | G f -> - begin match f with - | Ga | Gl -> Vector - | Wp | Wm | Z -> Massive_Vector - end - | O f -> Scalar - - let color = function - | M (U n) -> Color.SUN (if n > 0 then 3 else -3) - | M (D n) -> Color.SUN (if n > 0 then 3 else -3) - | G Gl -> Color.AdjSUN 3 - | _ -> Color.Singlet - - let prop_spinor n = - if n >= 0 then - Prop_Spinor - else - Prop_ConjSpinor - - let propagator = function - | M f -> - begin match f with - | L n -> prop_spinor n | N n -> prop_spinor n - | U n -> prop_spinor n | D n -> prop_spinor n - end - | G f -> - begin match f with - | Ga | Gl -> Prop_Feynman - | Wp | Wm | Z -> Prop_Unitarity - end - | O f -> - begin match f with - | Phip | Phim | Phi0 -> Only_Insertion - | H -> Prop_Scalar - end - -(* Optionally, ask for the fudge factor treatment for the widths of - charged particles. Currently, this only applies to $W^\pm$ and top. *) - - let width f = - if !use_fudged_width then - match f with - | G Wp | G Wm | M (U 3) | M (U (-3)) -> Fudged - | _ -> !default_width - else - !default_width - - let goldstone = function - | G f -> - begin match f with - | Wp -> Some (O Phip, Coupling.Const 1) - | Wm -> Some (O Phim, Coupling.Const 1) - | Z -> Some (O Phi0, Coupling.Const 1) - | _ -> None - end - | _ -> None - - let conjugate = function - | M f -> - M (begin match f with - | L n -> L (-n) | N n -> N (-n) - | U n -> U (-n) | D n -> D (-n) - end) - | G f -> - G (begin match f with - | Gl -> Gl | Ga -> Ga | Z -> Z - | Wp -> Wm | Wm -> Wp - end) - | O f -> - O (begin match f with - | Phip -> Phim | Phim -> Phip | Phi0 -> Phi0 - | H -> H - end) - - let conjugate_sans_color = conjugate - - let fermion = function - | M f -> - begin match f with - | L n -> if n > 0 then 1 else -1 - | N n -> if n > 0 then 1 else -1 - | U n -> if n > 0 then 1 else -1 - | D n -> if n > 0 then 1 else -1 - end - | G f -> - begin match f with - | Gl | Ga | Z | Wp | Wm -> 0 - end - | O _ -> 0 - - type constant = - | Unit | Pi | Alpha_QED | Sin2thw - | Sinthw | Costhw | E | G_weak | Vev - | Q_lepton | Q_up | Q_down | G_CC | G_CCQ of int*int - | G_NC_neutrino | G_NC_lepton | G_NC_up | G_NC_down - | I_Q_W | I_G_ZWW - | G_WWWW | G_ZZWW | G_AZWW | G_AAWW - | I_G1_AWW | I_G1_ZWW - | I_G1_plus_kappa_plus_G4_AWW - | I_G1_plus_kappa_plus_G4_ZWW - | I_G1_plus_kappa_minus_G4_AWW - | I_G1_plus_kappa_minus_G4_ZWW - | I_G1_minus_kappa_plus_G4_AWW - | I_G1_minus_kappa_plus_G4_ZWW - | I_G1_minus_kappa_minus_G4_AWW - | I_G1_minus_kappa_minus_G4_ZWW - | I_lambda_AWW | I_lambda_ZWW - | G5_AWW | G5_ZWW - | I_kappa5_AWW | I_kappa5_ZWW - | I_lambda5_AWW | I_lambda5_ZWW - | Alpha_WWWW0 | Alpha_ZZWW1 | Alpha_WWWW2 - | Alpha_ZZWW0 | Alpha_ZZZZ - | D_Alpha_ZZWW0_S | D_Alpha_ZZWW0_T | D_Alpha_ZZWW1_S - | D_Alpha_ZZWW1_T | D_Alpha_ZZWW1_U | D_Alpha_WWWW0_S - | D_Alpha_WWWW0_T | D_Alpha_WWWW0_U | D_Alpha_WWWW2_S - | D_Alpha_WWWW2_T | D_Alpha_ZZZZ_S | D_Alpha_ZZZZ_T - | G_HWW | G_HHWW | G_HZZ | G_HHZZ - | G_Htt | G_Hbb | G_Hcc | G_Hmm | G_Htautau | G_H3 | G_H4 - | G_HGaZ | G_HGaGa | G_Hgg - | Gs | I_Gs | G2 - | Mass of flavor | Width of flavor - | K_Matrix_Coeff of int | K_Matrix_Pole of int - -(* \begin{dubious} - The current abstract syntax for parameter dependencies is admittedly - tedious. Later, there will be a parser for a convenient concrete syntax - as a part of a concrete syntax for models. But as these examples show, - it should include simple functions. - \end{dubious} *) - -(* \begin{subequations} - \begin{align} - \alpha_{\text{QED}} &= \frac{1}{137.0359895} \\ - \sin^2\theta_w &= 0.23124 - \end{align} - \end{subequations} *) - let input_parameters = - [ Alpha_QED, 1. /. 137.0359895; - Sin2thw, 0.23124; - Mass (G Z), 91.187; - Mass (M (N 1)), 0.0; Mass (M (L 1)), 0.51099907e-3; - Mass (M (N 2)), 0.0; Mass (M (L 2)), 0.105658389; - Mass (M (N 3)), 0.0; Mass (M (L 3)), 1.77705; - Mass (M (U 1)), 5.0e-3; Mass (M (D 1)), 3.0e-3; - Mass (M (U 2)), 1.2; Mass (M (D 2)), 0.1; - Mass (M (U 3)), 174.0; Mass (M (D 3)), 4.2 ] - -(* \begin{subequations} - \begin{align} - e &= \sqrt{4\pi\alpha} \\ - \sin\theta_w &= \sqrt{\sin^2\theta_w} \\ - \cos\theta_w &= \sqrt{1-\sin^2\theta_w} \\ - g &= \frac{e}{\sin\theta_w} \\ - m_W &= \cos\theta_w m_Z \\ - v &= \frac{2m_W}{g} \\ - g_{CC} = - -\frac{g}{2\sqrt2} &= -\frac{e}{2\sqrt2\sin\theta_w} \\ - Q_{\text{lepton}} = - -q_{\text{lepton}}e &= e \\ - Q_{\text{up}} = - -q_{\text{up}}e &= -\frac{2}{3}e \\ - Q_{\text{down}} = - -q_{\text{down}}e &= \frac{1}{3}e \\ - \ii q_We = - \ii g_{\gamma WW} &= \ii e \\ - \ii g_{ZWW} &= \ii g \cos\theta_w \\ - \ii g_{WWW} &= \ii g - \end{align} - \end{subequations} *) - -(* \begin{dubious} - \ldots{} to be continued \ldots{} - The quartic couplings can't be correct, because the dimensions are wrong! - \begin{subequations} - \begin{align} - g_{HWW} &= g m_W = 2 \frac{m_W^2}{v}\\ - g_{HHWW} &= 2 \frac{m_W^2}{v^2} = \frac{g^2}{2} \\ - g_{HZZ} &= \frac{g}{\cos\theta_w}m_Z \\ - g_{HHZZ} &= 2 \frac{m_Z^2}{v^2} = \frac{g^2}{2\cos\theta_w} \\ - g_{Htt} &= \lambda_t \\ - g_{Hbb} &= \lambda_b=\frac{m_b}{m_t}\lambda_t \\ - g_{H^3} &= - \frac{3g}{2}\frac{m_H^2}{m_W} = - 3 \frac{m_H^2}{v} - g_{H^4} &= - \frac{3g^2}{4} \frac{m_W^2}{v^2} = -3 \frac{m_H^2}{v^2} - \end{align} - \end{subequations} - \end{dubious} *) - - let derived_parameters = - [ Real E, Sqrt (Prod [Const 4; Atom Pi; Atom Alpha_QED]); - Real Sinthw, Sqrt (Atom Sin2thw); - Real Costhw, Sqrt (Diff (Const 1, Atom Sin2thw)); - Real G_weak, Quot (Atom E, Atom Sinthw); - Real (Mass (G Wp)), Prod [Atom Costhw; Atom (Mass (G Z))]; - Real Vev, Quot (Prod [Const 2; Atom (Mass (G Wp))], Atom G_weak); - Real Q_lepton, Atom E; - Real Q_up, Prod [Quot (Const (-2), Const 3); Atom E]; - Real Q_down, Prod [Quot (Const 1, Const 3); Atom E]; - Real G_CC, Neg (Quot (Atom G_weak, Prod [Const 2; Sqrt (Const 2)])); - Complex I_Q_W, Prod [I; Atom E]; - Complex I_G_ZWW, Prod [I; Atom G_weak; Atom Costhw]] - -(* \begin{equation} - - \frac{g}{2\cos\theta_w} - \end{equation} *) - let g_over_2_costh = - Quot (Neg (Atom G_weak), Prod [Const 2; Atom Costhw]) - -(* \begin{subequations} - \begin{align} - - \frac{g}{2\cos\theta_w} g_V - &= - \frac{g}{2\cos\theta_w} (T_3 - 2 q \sin^2\theta_w) \\ - - \frac{g}{2\cos\theta_w} g_A - &= - \frac{g}{2\cos\theta_w} T_3 - \end{align} - \end{subequations} *) - let nc_coupling c t3 q = - (Real_Array c, - [Prod [g_over_2_costh; Diff (t3, Prod [Const 2; q; Atom Sin2thw])]; - Prod [g_over_2_costh; t3]]) - - let half = Quot (Const 1, Const 2) - - let derived_parameter_arrays = - [ nc_coupling G_NC_neutrino half (Const 0); - nc_coupling G_NC_lepton (Neg half) (Const (-1)); - nc_coupling G_NC_up half (Quot (Const 2, Const 3)); - nc_coupling G_NC_down (Neg half) (Quot (Const (-1), Const 3)) ] - - let parameters () = - { input = input_parameters; - derived = derived_parameters; - derived_arrays = derived_parameter_arrays } - - module F = Fusions (struct - type f = flavor - type c = constant - let compare = compare - let conjugate = conjugate - end) - -(* \begin{equation} - \mathcal{L}_{\textrm{EM}} = - - e \sum_i q_i \bar\psi_i\fmslash{A}\psi_i - \end{equation} *) - - let mgm ((m1, g, m2), fbf, c) = ((M m1, G g, M m2), fbf, c) - - let electromagnetic_currents n = - List.map mgm - [ ((L (-n), Ga, L n), FBF (1, Psibar, V, Psi), Q_lepton); - ((U (-n), Ga, U n), FBF (1, Psibar, V, Psi), Q_up); - ((D (-n), Ga, D n), FBF (1, Psibar, V, Psi), Q_down) ] - - let color_currents n = - List.map mgm - [ ((U (-n), Gl, U n), FBF ((-1), Psibar, V, Psi), Gs); - ((D (-n), Gl, D n), FBF ((-1), Psibar, V, Psi), Gs) ] - -(* \begin{equation} - \mathcal{L}_{\textrm{NC}} = - - \frac{g}{2\cos\theta_W} - \sum_i \bar\psi_i\fmslash{Z}(g_V^i-g_A^i\gamma_5)\psi_i - \end{equation} *) - - let neutral_currents n = - List.map mgm - [ ((L (-n), Z, L n), FBF (1, Psibar, VA, Psi), G_NC_lepton); - ((N (-n), Z, N n), FBF (1, Psibar, VA, Psi), G_NC_neutrino); - ((U (-n), Z, U n), FBF (1, Psibar, VA, Psi), G_NC_up); - ((D (-n), Z, D n), FBF (1, Psibar, VA, Psi), G_NC_down) ] - -(* \begin{equation} - \mathcal{L}_{\textrm{CC}} = - - \frac{g}{2\sqrt2} \sum_i \bar\psi_i - (T^+\fmslash{W}^+ + T^-\fmslash{W}^-)(1-\gamma_5)\psi_i - \end{equation} *) - - let charged_currents' n = - List.map mgm - [ ((L (-n), Wm, N n), FBF (1, Psibar, VL, Psi), G_CC); - ((N (-n), Wp, L n), FBF (1, Psibar, VL, Psi), G_CC) ] - - let charged_currents'' n = - List.map mgm - [ ((D (-n), Wm, U n), FBF (1, Psibar, VL, Psi), G_CC); - ((U (-n), Wp, D n), FBF (1, Psibar, VL, Psi), G_CC) ] - - let charged_currents_triv = - ThoList.flatmap charged_currents' [1;2;3] @ - ThoList.flatmap charged_currents'' [1;2;3] - - let charged_currents_ckm = - let charged_currents_2 n1 n2 = - List.map mgm - [ ((D (-n1), Wm, U n2), FBF (1, Psibar, VL, Psi), G_CCQ (n2,n1)); - ((U (-n1), Wp, D n2), FBF (1, Psibar, VL, Psi), G_CCQ (n1,n2)) ] in - ThoList.flatmap charged_currents' [1;2;3] @ - List.flatten (Product.list2 charged_currents_2 [1;2;3] [1;2;3]) - - let yukawa = - [ ((M (U (-3)), O H, M (U 3)), FBF (1, Psibar, S, Psi), G_Htt); - ((M (D (-3)), O H, M (D 3)), FBF (1, Psibar, S, Psi), G_Hbb); - ((M (U (-2)), O H, M (U 2)), FBF (1, Psibar, S, Psi), G_Hcc); - ((M (L (-2)), O H, M (L 2)), FBF (1, Psibar, S, Psi), G_Hmm); - ((M (L (-3)), O H, M (L 3)), FBF (1, Psibar, S, Psi), G_Htautau) ] - -(* \begin{equation} - \mathcal{L}_{\textrm{TGC}} = - - e \partial_\mu A_\nu W_+^\mu W_-^\nu + \ldots - - e \cot\theta_w \partial_\mu Z_\nu W_+^\mu W_-^\nu + \ldots - \end{equation} *) - - let tgc ((g1, g2, g3), t, c) = ((G g1, G g2, G g3), t, c) - - let standard_triple_gauge = - List.map tgc - [ ((Ga, Wm, Wp), Gauge_Gauge_Gauge 1, I_Q_W); - ((Z, Wm, Wp), Gauge_Gauge_Gauge 1, I_G_ZWW); - ((Gl, Gl, Gl), Gauge_Gauge_Gauge 1, I_Gs)] - - let anomalous_triple_gauge = - List.map tgc - [ ((Ga, Wm, Wp), Dim4_Vector_Vector_Vector_T (-1), - I_G1_AWW); - ((Z, Wm, Wp), Dim4_Vector_Vector_Vector_T (-1), - I_G1_ZWW); - ((Wm, Ga, Wp), Dim4_Vector_Vector_Vector_T 1, - I_G1_plus_kappa_minus_G4_AWW); - ((Wm, Z, Wp), Dim4_Vector_Vector_Vector_T 1, - I_G1_plus_kappa_minus_G4_ZWW); - ((Wp, Ga, Wm), Dim4_Vector_Vector_Vector_T (-1), - I_G1_plus_kappa_plus_G4_AWW); - ((Wp, Z, Wm), Dim4_Vector_Vector_Vector_T (-1), - I_G1_plus_kappa_plus_G4_ZWW); - ((Wm, Ga, Wp), Dim4_Vector_Vector_Vector_L (-1), - I_G1_minus_kappa_plus_G4_AWW); - ((Wm, Z, Wp), Dim4_Vector_Vector_Vector_L (-1), - I_G1_minus_kappa_plus_G4_ZWW); - ((Wp, Ga, Wm), Dim4_Vector_Vector_Vector_L 1, - I_G1_minus_kappa_minus_G4_AWW); - ((Wp, Z, Wm), Dim4_Vector_Vector_Vector_L 1, - I_G1_minus_kappa_minus_G4_ZWW); - ((Ga, Wm, Wp), Dim4_Vector_Vector_Vector_T5 (-1), - I_kappa5_AWW); - ((Z, Wm, Wp), Dim4_Vector_Vector_Vector_T5 (-1), - I_kappa5_ZWW); - ((Ga, Wm, Wp), Dim4_Vector_Vector_Vector_L5 (-1), - G5_AWW); - ((Z, Wm, Wp), Dim4_Vector_Vector_Vector_L5 (-1), - G5_ZWW); - ((Ga, Wp, Wm), Dim6_Gauge_Gauge_Gauge (-1), - I_lambda_AWW); - ((Z, Wp, Wm), Dim6_Gauge_Gauge_Gauge (-1), - I_lambda_ZWW); - ((Ga, Wp, Wm), Dim6_Gauge_Gauge_Gauge_5 (-1), - I_lambda5_AWW); - ((Z, Wp, Wm), Dim6_Gauge_Gauge_Gauge_5 (-1), - I_lambda5_ZWW) ] - - let triple_gauge = - if Flags.triple_anom then - anomalous_triple_gauge - else - standard_triple_gauge - -(* \begin{equation} - \mathcal{L}_{\textrm{QGC}} = - - g^2 W_{+,\mu} W_{-,\nu} W_+^\mu W_-^\nu + \ldots - \end{equation} *) - -(* Actually, quartic gauge couplings are a little bit more straightforward - using auxiliary fields. Here we have to impose the antisymmetry manually: - \begin{subequations} - \begin{multline} - (W^{+,\mu}_1 W^{-,\nu}_2 - W^{+,\nu}_1 W^{-,\mu}_2) - (W^+_{3,\mu} W^-_{4,\nu} - W^+_{3,\nu} W^-_{4,\mu}) \\ - = 2(W^+_1W^+_3)(W^-_2W^-_4) - 2(W^+_1W^-_4)(W^-_2W^+_3) - \end{multline} - also ($V$ can be $A$ or $Z$) - \begin{multline} - (W^{+,\mu}_1 V^\nu_2 - W^{+,\nu}_1 V^\mu_2) - (W^-_{3,\mu} V_{4,\nu} - W^-_{3,\nu} V_{4,\mu}) \\ - = 2(W^+_1W^-_3)(V_2V_4) - 2(W^+_1V_4)(V_2W^-_3) - \end{multline} - \end{subequations} *) - -(* \begin{subequations} - \begin{multline} - W^{+,\mu} W^{-,\nu} W^+_\mu W^-_\nu - \end{multline} - \end{subequations} *) - - let qgc ((g1, g2, g3, g4), t, c) = ((G g1, G g2, G g3, G g4), t, c) - - let gauge4 = Vector4 [(2, C_13_42); (-1, C_12_34); (-1, C_14_23)] - let minus_gauge4 = Vector4 [(-2, C_13_42); (1, C_12_34); (1, C_14_23)] - let standard_quartic_gauge = - List.map qgc - [ (Wm, Wp, Wm, Wp), gauge4, G_WWWW; - (Wm, Z, Wp, Z), minus_gauge4, G_ZZWW; - (Wm, Z, Wp, Ga), minus_gauge4, G_AZWW; - (Wm, Ga, Wp, Ga), minus_gauge4, G_AAWW; - (Gl, Gl, Gl, Gl), gauge4, G2 ] - -(* \begin{subequations} - \begin{align} - \mathcal{L}_4 - &= \alpha_4 \left( \frac{g^4}{2}\left( (W^+_\mu W^{-,\mu})^2 - + W^+_\mu W^{+,\mu} W^-_\mu W^{-,\mu} - \right)\right.\notag \\ - &\qquad\qquad\qquad \left. - + \frac{g^4}{\cos^2\theta_w} W^+_\mu Z^\mu W^-_\nu Z^\nu - + \frac{g^4}{4\cos^4\theta_w} (Z_\mu Z^\mu)^2 \right) \\ - \mathcal{L}_5 - &= \alpha_5 \left( g^4 (W^+_\mu W^{-,\mu})^2 - + \frac{g^4}{\cos^2\theta_w} W^+_\mu W^{-,\mu} Z_\nu Z^\nu - + \frac{g^4}{4\cos^4\theta_w} (Z_\mu Z^\mu)^2 \right) - \end{align} - \end{subequations} - or - \begin{multline} - \mathcal{L}_4 + \mathcal{L}_5 - = (\alpha_4+2\alpha_5) g^4 \frac{1}{2} (W^+_\mu W^{-,\mu})^2 \\ - + 2\alpha_4 g^4 \frac{1}{4} W^+_\mu W^{+,\mu} W^-_\mu W^{-,\mu} - + \alpha_4 \frac{g^4}{\cos^2\theta_w} W^+_\mu Z^\mu W^-_\nu Z^\nu \\ - + 2\alpha_5 \frac{g^4}{\cos^2\theta_w} \frac{1}{2} W^+_\mu W^{-,\mu} Z_\nu Z^\nu - + (2\alpha_4 + 2\alpha_5) \frac{g^4}{\cos^4\theta_w} \frac{1}{8} (Z_\mu Z^\mu)^2 - \end{multline} - and therefore - \begin{subequations} - \begin{align} - \alpha_{(WW)_0} &= (\alpha_4+2\alpha_5) g^4 \\ - \alpha_{(WW)_2} &= 2\alpha_4 g^4 \\ - \alpha_{(WZ)_0} &= 2\alpha_5 \frac{g^4}{\cos^2\theta_w} \\ - \alpha_{(WZ)_1} &= \alpha_4 \frac{g^4}{\cos^2\theta_w} \\ - \alpha_{ZZ} &= (2\alpha_4 + 2\alpha_5) \frac{g^4}{\cos^4\theta_w} - \end{align} - \end{subequations} *) - - let anomalous_quartic_gauge = - if Flags.quartic_anom then - List.map qgc - [ ((Wm, Wm, Wp, Wp), - Vector4 [(1, C_13_42); (1, C_14_23)], Alpha_WWWW0); - ((Wm, Wm, Wp, Wp), - Vector4 [1, C_12_34], Alpha_WWWW2); - ((Wm, Wp, Z, Z), - Vector4 [1, C_12_34], Alpha_ZZWW0); - ((Wm, Wp, Z, Z), - Vector4 [(1, C_13_42); (1, C_14_23)], Alpha_ZZWW1); - ((Z, Z, Z, Z), - Vector4 [(1, C_12_34); (1, C_13_42); (1, C_14_23)], Alpha_ZZZZ) ] - else - [] - -(* In any diagonal channel~$\chi$, the scattering amplitude~$a_\chi(s)$ is - unitary iff\footnote{% - Trivial proof: - \begin{equation} - -1 = \textrm{Im}\left(\frac{1}{a_\chi(s)}\right) - = \frac{\textrm{Im}(a_\chi^*(s))}{|a_\chi(s)|^2} - = - \frac{\textrm{Im}(a_\chi(s))}{|a_\chi(s)|^2} - \end{equation} - i.\,e.~$\textrm{Im}(a_\chi(s)) = |a_\chi(s)|^2$.} - \begin{equation} - \textrm{Im}\left(\frac{1}{a_\chi(s)}\right) = -1 - \end{equation} - For a real perturbative scattering amplitude~$r_\chi(s)$ this can be - enforced easily--and arbitrarily--by - \begin{equation} - \frac{1}{a_\chi(s)} = \frac{1}{r_\chi(s)} - \mathrm{i} - \end{equation} - -*) - - let k_matrix_quartic_gauge = - if Flags.k_matrix then - List.map qgc - [ ((Wm, Wp, Wm, Wp), Vector4_K_Matrix_jr (0, - [(1, C_12_34)]), D_Alpha_WWWW0_S); - ((Wm, Wp, Wm, Wp), Vector4_K_Matrix_jr (0, - [(1, C_14_23)]), D_Alpha_WWWW0_T); - ((Wm, Wp, Wm, Wp), Vector4_K_Matrix_jr (0, - [(1, C_13_42)]), D_Alpha_WWWW0_U); - ((Wp, Wm, Wp, Wm), Vector4_K_Matrix_jr (0, - [(1, C_12_34)]), D_Alpha_WWWW0_S); - ((Wp, Wm, Wp, Wm), Vector4_K_Matrix_jr (0, - [(1, C_14_23)]), D_Alpha_WWWW0_T); - ((Wp, Wm, Wp, Wm), Vector4_K_Matrix_jr (0, - [(1, C_13_42)]), D_Alpha_WWWW0_U); - ((Wm, Wm, Wp, Wp), Vector4_K_Matrix_jr (0, - [(1, C_12_34)]), D_Alpha_WWWW2_S); - ((Wm, Wm, Wp, Wp), Vector4_K_Matrix_jr (0, - [(1, C_13_42); (1, C_14_23)]), D_Alpha_WWWW2_T); - ((Wm, Wp, Z, Z), Vector4_K_Matrix_jr (0, - [(1, C_12_34)]), D_Alpha_ZZWW0_S); - ((Wm, Wp, Z, Z), Vector4_K_Matrix_jr (0, - [(1, C_13_42); (1, C_14_23)]), D_Alpha_ZZWW0_T); - ((Wm, Z, Wp, Z), Vector4_K_Matrix_jr (0, - [(1, C_12_34)]), D_Alpha_ZZWW1_S); - ((Wm, Z, Wp, Z), Vector4_K_Matrix_jr (0, - [(1, C_13_42)]), D_Alpha_ZZWW1_T); - ((Wm, Z, Wp, Z), Vector4_K_Matrix_jr (0, - [(1, C_14_23)]), D_Alpha_ZZWW1_U); - ((Wp, Z, Z, Wm), Vector4_K_Matrix_jr (1, - [(1, C_12_34)]), D_Alpha_ZZWW1_S); - ((Wp, Z, Z, Wm), Vector4_K_Matrix_jr (1, - [(1, C_13_42)]), D_Alpha_ZZWW1_U); - ((Wp, Z, Z, Wm), Vector4_K_Matrix_jr (1, - [(1, C_14_23)]), D_Alpha_ZZWW1_T); - ((Z, Wp, Wm, Z), Vector4_K_Matrix_jr (2, - [(1, C_12_34)]), D_Alpha_ZZWW1_S); - ((Z, Wp, Wm, Z), Vector4_K_Matrix_jr (2, - [(1, C_13_42)]), D_Alpha_ZZWW1_U); - ((Z, Wp, Wm, Z), Vector4_K_Matrix_jr (2, - [(1, C_14_23)]), D_Alpha_ZZWW1_T); - ((Z, Z, Z, Z), Vector4_K_Matrix_jr (0, - [(1, C_12_34)]), D_Alpha_ZZZZ_S); - ((Z, Z, Z, Z), Vector4_K_Matrix_jr (0, - [(1, C_13_42); (1, C_14_23)]), D_Alpha_ZZZZ_T); - ((Z, Z, Z, Z), Vector4_K_Matrix_jr (3, - [(1, C_14_23)]), D_Alpha_ZZZZ_S); - ((Z, Z, Z, Z), Vector4_K_Matrix_jr (3, - [(1, C_13_42); (1, C_12_34)]), D_Alpha_ZZZZ_T) ] - else - [] - - -(*i Thorsten's original implementation of the K matrix, which we keep since - it still might be usefull for the future. - - let k_matrix_quartic_gauge = - if Flags.k_matrix then - List.map qgc - [ ((Wm, Wp, Wm, Wp), Vector4_K_Matrix_tho (true, [K_Matrix_Coeff 0, - K_Matrix_Pole 0]), Alpha_WWWW0); - ((Wm, Wm, Wp, Wp), Vector4_K_Matrix_tho (true, [K_Matrix_Coeff 2, - K_Matrix_Pole 2]), Alpha_WWWW2); - ((Wm, Wp, Z, Z), Vector4_K_Matrix_tho (true, [(K_Matrix_Coeff 0, - K_Matrix_Pole 0); (K_Matrix_Coeff 2, - K_Matrix_Pole 2)]), Alpha_ZZWW0); - ((Wm, Z, Wp, Z), Vector4_K_Matrix_tho (true, [K_Matrix_Coeff 1, - K_Matrix_Pole 1]), Alpha_ZZWW1); - ((Z, Z, Z, Z), Vector4_K_Matrix_tho (0, [K_Matrix_Coeff 0, - K_Matrix_Pole 0]), Alpha_ZZZZ) ] - else - [] -i*) - - let quartic_gauge = - standard_quartic_gauge @ anomalous_quartic_gauge @ k_matrix_quartic_gauge - - let standard_gauge_higgs = - [ ((O H, G Wp, G Wm), Scalar_Vector_Vector 1, G_HWW); - ((O H, G Z, G Z), Scalar_Vector_Vector 1, G_HZZ) ] - - let standard_gauge_higgs4 = - [ (O H, O H, G Wp, G Wm), Scalar2_Vector2 1, G_HHWW; - (O H, O H, G Z, G Z), Scalar2_Vector2 1, G_HHZZ ] - - let standard_higgs = - [ (O H, O H, O H), Scalar_Scalar_Scalar 1, G_H3 ] - - let standard_higgs4 = - [ (O H, O H, O H, O H), Scalar4 1, G_H4 ] - -(* WK's couplings (apparently, he still intends to divide by - $\Lambda^2_{\text{EWSB}}=16\pi^2v_{\mathrm{F}}^2$): - \begin{subequations} - \begin{align} - \mathcal{L}^{\tau}_4 &= - \left\lbrack (\partial_{\mu}H)(\partial^{\mu}H) - + \frac{g^2v_{\mathrm{F}}^2}{4} V_{\mu} V^{\mu} \right\rbrack^2 \\ - \mathcal{L}^{\tau}_5 &= - \left\lbrack (\partial_{\mu}H)(\partial_{\nu}H) - + \frac{g^2v_{\mathrm{F}}^2}{4} V_{\mu} V_{\nu} \right\rbrack^2 - \end{align} - \end{subequations} - with - \begin{equation} - V_{\mu} V_{\nu} = - \frac{1}{2} \left( W^+_{\mu} W^-_{\nu} + W^+_{\nu} W^-_{\mu} \right) - + \frac{1}{2\cos^2\theta_{w}} Z_{\mu} Z_{\nu} - \end{equation} - (note the symmetrization!), i.\,e. - \begin{subequations} - \begin{align} - \mathcal{L}_4 &= \alpha_4 \frac{g^4v_{\mathrm{F}}^4}{16} (V_{\mu} V_{\nu})^2 \\ - \mathcal{L}_5 &= \alpha_5 \frac{g^4v_{\mathrm{F}}^4}{16} (V_{\mu} V^{\mu})^2 - \end{align} - \end{subequations} *) - -(* Breaking thinks up - \begin{subequations} - \begin{align} - \mathcal{L}^{\tau,H^4}_4 &= - \left\lbrack (\partial_{\mu}H)(\partial^{\mu}H) \right\rbrack^2 \\ - \mathcal{L}^{\tau,H^4}_5 &= - \left\lbrack (\partial_{\mu}H)(\partial^{\mu}H) \right\rbrack^2 - \end{align} - \end{subequations} - and - \begin{subequations} - \begin{align} - \mathcal{L}^{\tau,H^2V^2}_4 &= \frac{g^2v_{\mathrm{F}}^2}{2} - (\partial_{\mu}H)(\partial^{\mu}H) V_{\mu}V^{\mu} \\ - \mathcal{L}^{\tau,H^2V^2}_5 &= \frac{g^2v_{\mathrm{F}}^2}{2} - (\partial_{\mu}H)(\partial_{\nu}H) V_{\mu}V_{\nu} - \end{align} - \end{subequations} - i.\,e. - \begin{subequations} - \begin{align} - \mathcal{L}^{\tau,H^2V^2}_4 &= - \frac{g^2v_{\mathrm{F}}^2}{2} - \left\lbrack - (\partial_{\mu}H)(\partial^{\mu}H) W^+_{\nu}W^{-,\nu} - + \frac{1}{2\cos^2\theta_{w}} (\partial_{\mu}H)(\partial^{\mu}H) Z_{\nu} Z^{\nu} - \right\rbrack \\ - \mathcal{L}^{\tau,H^2V^2}_5 &= - \frac{g^2v_{\mathrm{F}}^2}{2} - \left\lbrack - (W^{+,\mu}\partial_{\mu}H) (W^{-,\nu}\partial_{\nu}H) - + \frac{1}{2\cos^2\theta_{w}} (Z^{\mu}\partial_{\mu}H)(Z^{\nu}\partial_{\nu}H) - \right\rbrack - \end{align} - \end{subequations} *) - -(* \begin{multline} - \tau^4_8 \mathcal{L}^{\tau,H^2V^2}_4 + \tau^5_8 \mathcal{L}^{\tau,H^2V^2}_5 = \\ - - \frac{g^2v_{\mathrm{F}}^2}{2} \Biggl\lbrack - 2\tau^4_8 - \frac{1}{2}(\ii\partial_{\mu}H)(\ii\partial^{\mu}H) W^+_{\nu}W^{-,\nu} - + \tau^5_8 - (W^{+,\mu}\ii\partial_{\mu}H) (W^{-,\nu}\ii\partial_{\nu}H) \\ - + \frac{2\tau^4_8}{\cos^2\theta_{w}} - \frac{1}{4} (\ii\partial_{\mu}H)(\ii\partial^{\mu}H) Z_{\nu} Z^{\nu} - + \frac{\tau^5_8}{\cos^2\theta_{w}} - \frac{1}{2} (Z^{\mu}\ii\partial_{\mu}H)(Z^{\nu}\ii\partial_{\nu}H) - \Biggr\rbrack - \end{multline} - where the two powers of $\ii$ make the sign conveniently negative, - i.\,e. - \begin{subequations} - \begin{align} - \alpha_{(\partial H)^2W^2}^2 &= \tau^4_8 g^2v_{\mathrm{F}}^2\\ - \alpha_{(\partial HW)^2}^2 &= \frac{\tau^5_8 g^2v_{\mathrm{F}}^2}{2} \\ - \alpha_{(\partial H)^2Z^2}^2 &= \frac{\tau^4_8 g^2v_{\mathrm{F}}^2}{\cos^2\theta_{w}} \\ - \alpha_{(\partial HZ)^2}^2 &=\frac{\tau^5_8 g^2v_{\mathrm{F}}^2}{2\cos^2\theta_{w}} - \end{align} - \end{subequations} *) - - let anomalous_gauge_higgs = - [] - - let anomalous_gauge_higgs4 = - [] - - let anomalous_higgs = - [] - - let anomaly_higgs = - [] -(*i [ (O H, G Ga, G Ga), Dim5_Scalar_Gauge2 1, G_HGaGa; - (O H, G Ga, G Z), Dim5_Scalar_Gauge2 1, G_HGaZ; - (O H, G Gl, G Gl), Dim5_Scalar_Gauge2 1, G_Hgg ] i*) - - let anomalous_higgs4 = - [] - - let gauge_higgs = - if Flags.higgs_anom then - standard_gauge_higgs @ anomalous_gauge_higgs - else - standard_gauge_higgs - - let gauge_higgs4 = - if Flags.higgs_anom then - standard_gauge_higgs4 @ anomalous_gauge_higgs4 - else - standard_gauge_higgs4 - - let higgs = - if Flags.higgs_anom then - standard_higgs @ anomalous_higgs - else - standard_higgs - - let higgs4 = - if Flags.higgs_anom then - standard_higgs4 @ anomalous_higgs4 - else - standard_higgs4 - - let goldstone_vertices = - [ ((O Phi0, G Wm, G Wp), Scalar_Vector_Vector 1, I_G_ZWW); - ((O Phip, G Ga, G Wm), Scalar_Vector_Vector 1, I_Q_W); - ((O Phip, G Z, G Wm), Scalar_Vector_Vector 1, I_G_ZWW); - ((O Phim, G Wp, G Ga), Scalar_Vector_Vector 1, I_Q_W); - ((O Phim, G Wp, G Z), Scalar_Vector_Vector 1, I_G_ZWW) ] - - let vertices3 = - (ThoList.flatmap electromagnetic_currents [1;2;3] @ - ThoList.flatmap color_currents [1;2;3] @ - ThoList.flatmap neutral_currents [1;2;3] @ - (if Flags.ckm_present then - charged_currents_ckm - else - charged_currents_triv) @ - yukawa @ triple_gauge @ - gauge_higgs @ higgs @ anomaly_higgs - @ goldstone_vertices) - - let vertices4 = - quartic_gauge @ gauge_higgs4 @ higgs4 - - let vertices () = (vertices3, vertices4, []) - -(* For efficiency, make sure that [F.of_vertices vertices] is - evaluated only once. *) - - let table = F.of_vertices (vertices ()) - let fuse2 = F.fuse2 table - let fuse3 = F.fuse3 table - let fuse = F.fuse table - let max_degree () = 4 - - let flavor_of_string = function - | "e-" -> M (L 1) | "e+" -> M (L (-1)) - | "mu-" -> M (L 2) | "mu+" -> M (L (-2)) - | "tau-" -> M (L 3) | "tau+" -> M (L (-3)) - | "nue" -> M (N 1) | "nuebar" -> M (N (-1)) - | "numu" -> M (N 2) | "numubar" -> M (N (-2)) - | "nutau" -> M (N 3) | "nutaubar" -> M (N (-3)) - | "u" -> M (U 1) | "ubar" -> M (U (-1)) - | "c" -> M (U 2) | "cbar" -> M (U (-2)) - | "t" -> M (U 3) | "tbar" -> M (U (-3)) - | "d" -> M (D 1) | "dbar" -> M (D (-1)) - | "s" -> M (D 2) | "sbar" -> M (D (-2)) - | "b" -> M (D 3) | "bbar" -> M (D (-3)) - | "g" | "gl" -> G Gl - | "A" -> G Ga | "Z" | "Z0" -> G Z - | "W+" -> G Wp | "W-" -> G Wm - | "H" -> O H - | _ -> invalid_arg "Models.SM.flavor_of_string" - - let flavor_to_string = function - | M f -> - begin match f with - | L 1 -> "e-" | L (-1) -> "e+" - | L 2 -> "mu-" | L (-2) -> "mu+" - | L 3 -> "tau-" | L (-3) -> "tau+" - | L _ -> invalid_arg - "Models.SM.flavor_to_string: invalid lepton" - | N 1 -> "nue" | N (-1) -> "nuebar" - | N 2 -> "numu" | N (-2) -> "numubar" - | N 3 -> "nutau" | N (-3) -> "nutaubar" - | N _ -> invalid_arg - "Models.SM.flavor_to_string: invalid neutrino" - | U 1 -> "u" | U (-1) -> "ubar" - | U 2 -> "c" | U (-2) -> "cbar" - | U 3 -> "t" | U (-3) -> "tbar" - | U _ -> invalid_arg - "Models.SM.flavor_to_string: invalid up type quark" - | D 1 -> "d" | D (-1) -> "dbar" - | D 2 -> "s" | D (-2) -> "sbar" - | D 3 -> "b" | D (-3) -> "bbar" - | D _ -> invalid_arg - "Models.SM.flavor_to_string: invalid down type quark" - end - | G f -> - begin match f with - | Gl -> "gl" - | Ga -> "A" | Z -> "Z" - | Wp -> "W+" | Wm -> "W-" - end - | O f -> - begin match f with - | Phip -> "phi+" | Phim -> "phi-" | Phi0 -> "phi0" - | H -> "H" - end - - let flavor_symbol = function - | M f -> - begin match f with - | L n when n > 0 -> "l" ^ string_of_int n - | L n -> "l" ^ string_of_int (abs n) ^ "b" - | N n when n > 0 -> "n" ^ string_of_int n - | N n -> "n" ^ string_of_int (abs n) ^ "b" - | U n when n > 0 -> "u" ^ string_of_int n - | U n -> "u" ^ string_of_int (abs n) ^ "b" - | D n when n > 0 -> "d" ^ string_of_int n - | D n -> "d" ^ string_of_int (abs n) ^ "b" - end - | G f -> - begin match f with - | Gl -> "gl" - | Ga -> "a" | Z -> "z" - | Wp -> "wp" | Wm -> "wm" - end - | O f -> - begin match f with - | Phip -> "pp" | Phim -> "pm" | Phi0 -> "p0" - | H -> "h" - end - - let flavor_sans_color_of_string = flavor_of_string - let flavor_sans_color_to_string = flavor_to_string - let flavor_sans_color_symbol = flavor_symbol - - let pdg = function - | M f -> - begin match f with - | L n when n > 0 -> 9 + 2*n - | L n -> - 9 + 2*n - | N n when n > 0 -> 10 + 2*n - | N n -> - 10 + 2*n - | U n when n > 0 -> 2*n - | U n -> 2*n - | D n when n > 0 -> - 1 + 2*n - | D n -> 1 + 2*n - end - | G f -> - begin match f with - | Gl -> 21 - | Ga -> 22 | Z -> 23 - | Wp -> 24 | Wm -> (-24) - end - | O f -> - begin match f with - | Phip | Phim -> 27 | Phi0 -> 26 - | H -> 25 - end - - let mass_symbol f = - "mass(" ^ string_of_int (abs (pdg f)) ^ ")" - - let width_symbol f = - "width(" ^ string_of_int (abs (pdg f)) ^ ")" - - let constant_symbol = function - | Unit -> "unit" | Pi -> "PI" - | Alpha_QED -> "alpha" | E -> "e" | G_weak -> "g" | Vev -> "vev" - | Sin2thw -> "sin2thw" | Sinthw -> "sinthw" | Costhw -> "costhw" - | Q_lepton -> "qlep" | Q_up -> "qup" | Q_down -> "qdwn" - | G_NC_lepton -> "gnclep" | G_NC_neutrino -> "gncneu" - | G_NC_up -> "gncup" | G_NC_down -> "gncdwn" - | G_CC -> "gcc" - | G_CCQ (n1,n2) -> "gccq" ^ string_of_int n1 ^ string_of_int n2 - | I_Q_W -> "iqw" | I_G_ZWW -> "igzww" - | G_WWWW -> "gw4" | G_ZZWW -> "gzzww" - | G_AZWW -> "gazww" | G_AAWW -> "gaaww" - | I_G1_AWW -> "ig1a" | I_G1_ZWW -> "ig1z" - | I_G1_plus_kappa_plus_G4_AWW -> "ig1pkpg4a" - | I_G1_plus_kappa_plus_G4_ZWW -> "ig1pkpg4z" - | I_G1_plus_kappa_minus_G4_AWW -> "ig1pkmg4a" - | I_G1_plus_kappa_minus_G4_ZWW -> "ig1pkmg4z" - | I_G1_minus_kappa_plus_G4_AWW -> "ig1mkpg4a" - | I_G1_minus_kappa_plus_G4_ZWW -> "ig1mkpg4z" - | I_G1_minus_kappa_minus_G4_AWW -> "ig1mkmg4a" - | I_G1_minus_kappa_minus_G4_ZWW -> "ig1mkmg4z" - | I_lambda_AWW -> "ila" - | I_lambda_ZWW -> "ilz" - | G5_AWW -> "rg5a" - | G5_ZWW -> "rg5z" - | I_kappa5_AWW -> "ik5a" - | I_kappa5_ZWW -> "ik5z" - | I_lambda5_AWW -> "il5a" | I_lambda5_ZWW -> "il5z" - | Alpha_WWWW0 -> "alww0" | Alpha_WWWW2 -> "alww2" - | Alpha_ZZWW0 -> "alzw0" | Alpha_ZZWW1 -> "alzw1" - | Alpha_ZZZZ -> "alzz" - | D_Alpha_ZZWW0_S -> "dalzz0_s(gkm,mkm," - | D_Alpha_ZZWW0_T -> "dalzz0_t(gkm,mkm," - | D_Alpha_ZZWW1_S -> "dalzz1_s(gkm,mkm," - | D_Alpha_ZZWW1_T -> "dalzz1_t(gkm,mkm," - | D_Alpha_ZZWW1_U -> "dalzz1_u(gkm,mkm," - | D_Alpha_WWWW0_S -> "dalww0_s(gkm,mkm," - | D_Alpha_WWWW0_T -> "dalww0_t(gkm,mkm," - | D_Alpha_WWWW0_U -> "dalww0_u(gkm,mkm," - | D_Alpha_WWWW2_S -> "dalww2_s(gkm,mkm," - | D_Alpha_WWWW2_T -> "dalww2_t(gkm,mkm," - | D_Alpha_ZZZZ_S -> "dalz4_s(gkm,mkm," - | D_Alpha_ZZZZ_T -> "dalz4_t(gkm,mkm," - | G_HWW -> "ghww" | G_HZZ -> "ghzz" - | G_HHWW -> "ghhww" | G_HHZZ -> "ghhzz" - | G_Htt -> "ghtt" | G_Hbb -> "ghbb" - | G_Htautau -> "ghtautau" | G_Hcc -> "ghcc" | G_Hmm -> "ghmm" - | G_HGaZ -> "ghgaz" | G_HGaGa -> "ghgaga" | G_Hgg -> "ghgg" - | G_H3 -> "gh3" | G_H4 -> "gh4" - | Gs -> "gs" | I_Gs -> "igs" | G2 -> "gs**2" - | Mass f -> "mass" ^ flavor_symbol f - | Width f -> "width" ^ flavor_symbol f - | K_Matrix_Coeff i -> "kc" ^ string_of_int i - | K_Matrix_Pole i -> "kp" ^ string_of_int i - - end - -(* \thocwmodulesection{Incomplete Standard Model in $R_\xi$ Gauge} *) - -(* \begin{dubious} - At the end of the day, we want a functor mapping from gauge models - in unitarity gauge to $R_\xi$ gauge and vice versa. For this, we - will need a more abstract implementation of (spontaneously broken) - gauge theories. - \end{dubious} *) - -module SM_Rxi = - struct - let rcs = RCS.rename rcs_file "Models.SM_Rxi" - [ "minimal electroweak standard model in R-xi gauge"; - "NB: very incomplete still!, no CKM matrix" ] - - open Coupling - - module SM = SM(SM_no_anomalous) - let options = SM.options - type flavor = SM.flavor - type flavor_sans_color = SM.flavor_sans_color - let flavor_sans_color = SM.flavor_sans_color - let flavors = SM.flavors - let external_flavors = SM.external_flavors - type constant = SM.constant - let lorentz = SM.lorentz - let color = SM.color - let goldstone = SM.goldstone - let conjugate = SM.conjugate - let conjugate_sans_color = SM.conjugate - let fermion = SM.fermion - -(* \begin{dubious} - Check if it makes sense to have separate gauge fixing parameters - for each vector boson. There's probably only one independent - parameter for each group factor. - \end{dubious} *) - - type gauge = - | XiA | XiZ | XiW - - let gauge_symbol = function - | XiA -> "xia" | XiZ -> "xi0" | XiW -> "xipm" - -(* Change the gauge boson propagators and make the Goldstone bosons - propagating. *) - let propagator = function - | SM.G SM.Ga -> Prop_Gauge XiA - | SM.G SM.Z -> Prop_Rxi XiZ - | SM.G SM.Wp | SM.G SM.Wm -> Prop_Rxi XiW - | SM.O SM.Phip | SM.O SM.Phim | SM.O SM.Phi0 -> Prop_Scalar - | f -> SM.propagator f - - let width = SM.width - - module F = Fusions (struct - type f = flavor - type c = constant - let compare = compare - let conjugate = conjugate - end) - - let vertices = SM.vertices - - let table = F.of_vertices (vertices ()) - let fuse2 = F.fuse2 table - let fuse3 = F.fuse3 table - let fuse = F.fuse table - let max_degree () = 3 - - let parameters = SM.parameters - let flavor_of_string = SM.flavor_of_string - let flavor_to_string = SM.flavor_to_string - let flavor_symbol = SM.flavor_symbol - let flavor_sans_color_of_string = SM.flavor_sans_color_of_string - let flavor_sans_color_to_string = SM.flavor_sans_color_to_string - let flavor_sans_color_symbol = SM.flavor_sans_color_symbol - let pdg = SM.pdg - let mass_symbol = SM.mass_symbol - let width_symbol = SM.width_symbol - let constant_symbol = SM.constant_symbol - - end - -(* \thocwmodulesection{Groves} *) - -module Groves (M : Model.Gauge) : Model.Gauge = - struct - let max_generations = 5 - let rcs = RCS.rename M.rcs - ("Models.Groves(" ^ (RCS.name M.rcs) ^ ")") - ([ "experimental Groves functor"; - Printf.sprintf "for maximally %d flavored legs" - (2 * max_generations) ] @ - RCS.description M.rcs) - - let options = M.options - - type matter_field = M.matter_field * int - type gauge_boson = M.gauge_boson - type other = M.other - type field = - | Matter of matter_field - | Gauge of gauge_boson - | Other of other - type flavor = M of matter_field | G of gauge_boson | O of other - type flavor_sans_color = flavor - let flavor_sans_color f = f - let matter_field (f, g) = M (f, g) - let gauge_boson f = G f - let other f = O f - let field = function - | M f -> Matter f - | G f -> Gauge f - | O f -> Other f - let project = function - | M (f, _) -> M.matter_field f - | G f -> M.gauge_boson f - | O f -> M.other f - let inject g f = - match M.field f with - | M.Matter f -> M (f, g) - | M.Gauge f -> G f - | M.Other f -> O f - type gauge = M.gauge - let gauge_symbol = M.gauge_symbol - let color f = M.color (project f) - let pdg f = M.pdg (project f) - let lorentz f = M.lorentz (project f) - let propagator f = M.propagator (project f) - let fermion f = M.fermion (project f) - let width f = M.width (project f) - let mass_symbol f = M.mass_symbol (project f) - let width_symbol f = M.width_symbol (project f) - let flavor_symbol f = M.flavor_symbol (project f) - let flavor_sans_color_symbol = flavor_symbol - - type constant = M.constant - let constant_symbol = M.constant_symbol - let max_degree = M.max_degree - let parameters = M.parameters - - let conjugate = function - | M (_, g) as f -> inject g (M.conjugate (project f)) - | f -> inject 0 (M.conjugate (project f)) - - let conjugate_sans_color = conjugate - - let read_generation s = - try - let offset = String.index s '/' in - (int_of_string - (String.sub s (succ offset) (String.length s - offset - 1)), - String.sub s 0 offset) - with - | Not_found -> (1, s) - - let format_generation c s = - s ^ "/" ^ string_of_int c - - let flavor_of_string s = - let g, s = read_generation s in - inject g (M.flavor_of_string s) - - let flavor_to_string = function - | M (_, g) as f -> format_generation g (M.flavor_to_string (project f)) - | f -> M.flavor_to_string (project f) - - let flavor_sans_color_of_string = flavor_of_string - let flavor_sans_color_to_string = flavor_to_string - - let goldstone = function - | G _ as f -> - begin match M.goldstone (project f) with - | None -> None - | Some (f, c) -> Some (inject 0 f, c) - end - | M _ | O _ -> None - - let clone generations flavor = - match M.field flavor with - | M.Matter f -> List.map (fun g -> M (f, g)) generations - | M.Gauge f -> [G f] - | M.Other f -> [O f] - - let generations = ThoList.range 1 max_generations - - let flavors () = - ThoList.flatmap (clone generations) (M.flavors ()) - - let external_flavors () = - List.map (fun (s, fl) -> (s, ThoList.flatmap (clone generations) fl)) - (M.external_flavors ()) - - module F = Fusions (struct - type f = flavor - type c = constant - let compare = compare - let conjugate = conjugate - end) - -(* In the following functions, we might replace [_] by [(M.Gauge _ | M.Other _)], - in order to allow the compiler to check completeness. However, this - makes the code much less readable. *) - - let clone3 ((f1, f2, f3), v, c) = - match M.field f1, M.field f2, M.field f3 with - | M.Matter _, M.Matter _, M.Matter _ -> - invalid_arg "Models.Groves().vertices: three matter fields!" - | M.Matter f1', M.Matter f2', _ -> - List.map (fun g -> ((M (f1', g), M (f2', g), inject 0 f3), v, c)) - generations - | M.Matter f1', _, M.Matter f3' -> - List.map (fun g -> ((M (f1', g), inject 0 f2, M (f3', g)), v, c)) - generations - | _, M.Matter f2', M.Matter f3' -> - List.map (fun g -> ((inject 0 f1, M (f2', g), M (f3', g)), v, c)) - generations - | M.Matter _, _, _ | _, M.Matter _, _ | _, _, M.Matter _ -> - invalid_arg "Models.Groves().vertices: lone matter field!" - | _, _, _ -> - [(inject 0 f1, inject 0 f2, inject 0 f3), v, c] - - let clone4 ((f1, f2, f3, f4), v, c) = - match M.field f1, M.field f2, M.field f3, M.field f4 with - | M.Matter _, M.Matter _, M.Matter _, M.Matter _ -> - invalid_arg "Models.Groves().vertices: four matter fields!" - | M.Matter _, M.Matter _, M.Matter _, _ - | M.Matter _, M.Matter _, _, M.Matter _ - | M.Matter _, _, M.Matter _, M.Matter _ - | _, M.Matter _, M.Matter _, M.Matter _ -> - invalid_arg "Models.Groves().vertices: three matter fields!" - | M.Matter f1', M.Matter f2', _, _ -> - List.map (fun g -> - ((M (f1', g), M (f2', g), inject 0 f3, inject 0 f4), v, c)) - generations - | M.Matter f1', _, M.Matter f3', _ -> - List.map (fun g -> - ((M (f1', g), inject 0 f2, M (f3', g), inject 0 f4), v, c)) - generations - | M.Matter f1', _, _, M.Matter f4' -> - List.map (fun g -> - ((M (f1', g), inject 0 f2, inject 0 f3, M (f4', g)), v, c)) - generations - | _, M.Matter f2', M.Matter f3', _ -> - List.map (fun g -> - ((inject 0 f1, M (f2', g), M (f3', g), inject 0 f4), v, c)) - generations - | _, M.Matter f2', _, M.Matter f4' -> - List.map (fun g -> - ((inject 0 f1, M (f2', g), inject 0 f3, M (f4', g)), v, c)) - generations - | _, _, M.Matter f3', M.Matter f4' -> - List.map (fun g -> - ((inject 0 f1, inject 0 f2, M (f3', g), M (f4', g)), v, c)) - generations - | M.Matter _, _, _, _ | _, M.Matter _, _, _ - | _, _, M.Matter _, _ | _, _, _, M.Matter _ -> - invalid_arg "Models.Groves().vertices: lone matter field!" - | _, _, _, _ -> - [(inject 0 f1, inject 0 f2, inject 0 f3, inject 0 f4), v, c] - - let clonen (fl, v, c) = - match List.map M.field fl with - | _ -> failwith "Models.Groves().vertices: incomplete" - - let vertices () = - let vertices3, vertices4, verticesn = M.vertices () in - (ThoList.flatmap clone3 vertices3, - ThoList.flatmap clone4 vertices4, - ThoList.flatmap clonen verticesn) - - let table = F.of_vertices (vertices ()) - let fuse2 = F.fuse2 table - let fuse3 = F.fuse3 table - let fuse = F.fuse table - -(* \begin{dubious} - The following (incomplete) alternative implementations are - included for illustrative purposes only: - \end{dubious} *) - - let injectl g fcl = - List.map (fun (f, c) -> (inject g f, c)) fcl - - let alt_fuse2 f1 f2 = - match f1, f2 with - | M (f1', g1'), M (f2', g2') -> - if g1' = g2' then - injectl 0 (M.fuse2 (M.matter_field f1') (M.matter_field f2')) - else - [] - | M (f1', g'), _ -> injectl g' (M.fuse2 (M.matter_field f1') (project f2)) - | _, M (f2', g') -> injectl g' (M.fuse2 (project f1) (M.matter_field f2')) - | _, _ -> injectl 0 (M.fuse2 (project f1) (project f2)) - - let alt_fuse3 f1 f2 f3 = - match f1, f2, f3 with - | M (f1', g1'), M (f2', g2'), M (f3', g3') -> - invalid_arg "Models.Groves().fuse3: three matter fields!" - | M (f1', g1'), M (f2', g2'), _ -> - if g1' = g2' then - injectl 0 - (M.fuse3 (M.matter_field f1') (M.matter_field f2') (project f3)) - else - [] - | M (f1', g1'), _, M (f3', g3') -> - if g1' = g3' then - injectl 0 - (M.fuse3 (M.matter_field f1') (project f2) (M.matter_field f3')) - else - [] - | _, M (f2', g2'), M (f3', g3') -> - if g2' = g3' then - injectl 0 - (M.fuse3 (project f1) (M.matter_field f2') (M.matter_field f3')) - else - [] - | M (f1', g'), _, _ -> - injectl g' (M.fuse3 (M.matter_field f1') (project f2) (project f3)) - | _, M (f2', g'), _ -> - injectl g' (M.fuse3 (project f1) (M.matter_field f2') (project f3)) - | _, _, M (f3', g') -> - injectl g' (M.fuse3 (project f1) (project f2) (M.matter_field f3')) - | _, _, _ -> injectl 0 (M.fuse3 (project f1) (project f2) (project f3)) - - end - -(* \thocwmodulesection{MSM With Cloned Families} *) - -module SM_clones = Groves(SM(SM_no_anomalous)) -module SM3_clones = Groves(SM3(SM_no_anomalous)) - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) - Index: branches/ohl/omega-development/completed/whizard2/src/ogiga.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/ogiga.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/ogiga.ml (revision 8703) @@ -1,351 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -(* NB: this module \emph{must} be compiled with \verb+-labels+, - since \verb+labltk+ doesn't appear to work in classic mode. *) - -(* \begin{dubious} - Keep in mind that \texttt{ocamlweb} doesn't work properly with - O'Caml~3 yet. The colons in label declarations are typeset with - erroneous white space. - \end{dubious} *) - -let rcs = RCS.parse "Ogiga" ["Graphical User Interface"] - { RCS.revision = "$Revision$"; - RCS.date = "$Date$"; - RCS.author = "$Author$"; - RCS.source - = "$URL$" } - -(* \thocwmodulesection{Windows} *) - -let window = - GWindow.window ~width:550 ~height:500 ~title: - "O'Giga: O'Mega Graphical Interface for Generation and Analysis" () -let vbox = GPack.vbox ~packing:window#add () - -let menubar = GMenu.menu_bar ~packing:(vbox#pack ~expand:false) () -let factory = new ThoGMenu.factory menubar -let accel_group = factory#accel_group -let file_menu = factory#add_submenu "File" -let edit_menu = factory#add_submenu "Edit" -let exec_menu = factory#add_submenu "Exec" -let help_menu = factory#add_submenu_right "Help" -let hbox = GPack.hbox ~packing:(vbox#pack ~expand:false) () - -let about () = - ThoGWindow.message ~justify:`LEFT - ~text:(String.concat "\n" - ([ "This is the skeleton for a graphical interface"; - "for O'Mega."; ""; - "There is almost no functionality implemented yet."; - "I'm still trying to learn GTK+ and LablGTK."; "" ] @ - RCS.summary rcs)) () - - -(* \thocwmodulesection{Main Program} *) - -module O = Omega.Make -module F = Fusion -module T = Targets -module M = Models - -module SM = M.SM(M.SM) -module SM_ac = M.SM(M.SM_anomalous) - -module O1a = O(F.Mixed23)(T.Fortran)(SM) -module O1b = O(F.Mixed23_Majorana)(T.Fortran_Majorana)(SM) - -module O2a = O(F.Binary)(T.Fortran)(SM_ac) -module O2b = O(F.Binary_Majorana)(T.Fortran_Majorana)(SM_ac) - -module O3a = O(F.Binary)(T.Fortran)(M.QED) -module O3b = O(F.Binary_Majorana)(T.Fortran_Majorana)(M.QED) -module O3c = O(F.Binary)(T.Helas)(M.QED) - -module O4a = O(F.Binary)(T.Fortran)(M.YM) -module O4b = O(F.Binary_Majorana)(T.Fortran_Majorana)(M.YM) -module O4c = O(F.Binary)(T.Helas)(M.YM) - -module O5a = O(F.Binary)(T.Fortran)(M.SM_Rxi) -module O5b = O(F.Binary_Majorana)(T.Fortran_Majorana)(M.SM_Rxi) - -module O6a = O(F.Binary)(T.Fortran)(M.SM_clones) -module O6b = O(F.Binary_Majorana)(T.Fortran_Majorana)(M.SM_clones) - -(*i -module O6 = O(F.Binary_Majorana)(T.Fortran_Majorana)(M.MSSM(M.MSSM_no_goldstone)) -i*) - -let flavors = SM.external_flavors -let flavor_to_string = SM.flavor_to_string -let flavors_tree = ThoGMenu.tree_of_nested_lists flavor_to_string (flavors ()) - -let particle_menu button = - ThoGMenu.submenu_tree button#set_state flavors_tree - -let process incoming outgoing = - let in1 = incoming.(0) - and in2 = incoming.(1) - and incoming = Array.to_list incoming - and outgoing = Array.to_list outgoing in - let s = - String.concat " " (List.map SM.flavor_to_string incoming) ^ " -> " ^ - String.concat " " (List.map SM.flavor_to_string outgoing) in - O1a.diagrams in1 in2 outgoing - -let font = - Gdk.Font.load "-*-helvetica-medium-r-normal--*-120-*-*-*-*-iso8859-1" - -let conjugate (f, p) = (SM.conjugate f, p) -let cross (f, p) = (SM.conjugate f, Momentum.Default.neg p) - -let node_to_string (f, p) = - Printf.sprintf "%s[%s]" - (SM.flavor_to_string f) - (String.concat "" (List.map string_of_int (Momentum.Default.to_ints p))) - -let create_linear_rectangle n1 n2 f = - Array.init (n1 * n2) (fun n -> f n (n mod n1) (n / n1)) - -let rows = 4 -let columns = 3 - -class ['a] menu_button_custom widgets accept format state menu = - object (self) - inherit ['a] ThoGMenu.menu_button widgets format state menu as super - method set_menu menu = - self#connect#clicked ~callback:(fun () -> - let m = ThoGMenu.submenu_tree (fun s -> self#set_state s; accept s) - menu in - m#popup ~button:3 ~time:0); - () - end - -let menu_button_custom accept format state menu - ?border_width ?width ?height ?packing ?show () = - new menu_button_custom (ThoGButton.mutable_button_raw - ?border_width ?width ?height ?packing ?show ()) - accept format state menu - -let line_style flavor = - match SM.propagator flavor with - | Coupling.Prop_Scalar | Coupling.Aux_Scalar -> - ThoGDraw.Plain - | Coupling.Prop_Spinor | Coupling.Aux_Spinor -> - ThoGDraw.Arrow ThoGDraw.Forward - | Coupling.Prop_ConjSpinor | Coupling.Aux_ConjSpinor -> - ThoGDraw.Arrow ThoGDraw.Backward - | Coupling.Prop_Majorana | Coupling.Aux_Majorana -> - ThoGDraw.Name "majorana" - | Coupling.Prop_Feynman | Coupling.Prop_Gauge _ -> - begin match SM.color flavor with - | Color.Singlet -> ThoGDraw.Wiggles - | Color.AdjSUN _ -> ThoGDraw.Curls - | Color.SUN _ -> ThoGDraw.Name ("???: " ^ SM.flavor_to_string flavor) - end - | Coupling.Prop_Unitarity | Coupling.Prop_Rxi _ - | Coupling.Aux_Vector | Coupling.Aux_Tensor_1 -> - ThoGDraw.Double - | Coupling.Only_Insertion -> - ThoGDraw.Name (SM.flavor_to_string flavor ^ " insertion") - -let main () = - window#connect#destroy ~callback:GMain.Main.quit; - let factory = new GMenu.factory file_menu ~accel_group in - factory#add_item "Open..." ~key:GdkKeysyms._O - ~callback:(fun () -> prerr_endline "open ..."); - factory#add_item "Save" ~key:GdkKeysyms._S - ~callback:(fun () -> prerr_endline "save"); - factory#add_item "Save as..." - ~callback:(fun () -> prerr_endline "save as"); - factory#add_separator (); - factory#add_item "Quit" ~key:GdkKeysyms._Q ~callback:window#destroy; - let factory = new GMenu.factory edit_menu ~accel_group in - let dc' = new ThoGDraw.decoration_context in - factory#add_item "Preferences" ~key:GdkKeysyms._E - ~callback:(fun () -> ThoGDraw.edit_preferences dc'); - let factory = new GMenu.factory help_menu ~accel_group in - factory#add_item "About" ~key:GdkKeysyms._A ~callback:about; - let tooltips = GData.tooltips () in - let default_flavor = List.hd (snd (List.hd (flavors ()))) in - let hbox = GPack.hbox ~packing:(vbox#pack ~expand:false) () in - let tip2 = - " (left mouse button, SPACE or RET will pop up a menu;" ^ - " right button will select)" in - let incoming = - new ThoGMenu.tensor_menu flavor_to_string default_flavor flavors_tree 2 - ~tooltip_maker:(fun i -> - "incoming particle #" ^ string_of_int (succ i) ^ tip2) - ~label:"incoming" ~width:50 ~packing:hbox#pack () in - let smt = ThoGMenu.Leafs (List.map (fun n -> (string_of_int n, n)) - (ThoList.range 2 8)) in - let n_outgoing_frame = GBin.frame ~label:"#" ~packing:hbox#pack () in - let outgoing = - new ThoGMenu.tensor_menu flavor_to_string default_flavor flavors_tree 8 - ~tooltip_maker:(fun i -> - "outgoing particle #" ^ string_of_int (succ i) ^ tip2) - ~label:"outgoing" ~width:50 ~packing:hbox#pack () in - let n_outgoing = - menu_button_custom (fun n -> outgoing#set_active n) string_of_int 4 smt - ~width:30 ~packing:n_outgoing_frame#add () in - outgoing#set_active 4; - let dds = GPack.table ~rows ~columns ~homogeneous:true - ~packing:(vbox#pack ~expand:true) () in - let dc = new ThoGDraw.decoration_context in - let dd = create_linear_rectangle columns rows - (fun n n1 n2 -> new ThoGDraw.diagram_display - ~label:(string_of_int (succ n)) - ~node_to_string ~conjugate ~cross - ~nodes2edge:(fun n _ -> fst n) ~line_style - ~packing:(dds#attach ~left:n1 ~top:n2 ~expand:`BOTH) dc) in - let factory = new GMenu.factory exec_menu ~accel_group in - let diagrams = ref [| |] in - let num_diagrams = ref 0 in - let offset = ref 0 - and min_offset = ref 0 - and max_offset = ref 0 - and num_squares = rows * columns in - let clamp o = max !min_offset (min !max_offset o) in - let redraw () = - let last = pred (min !num_diagrams num_squares) in - for i = 0 to last do - dd.(i)#viewport#drawable#set_decoration_context dc'; - let i' = i + !offset in - dd.(i)#set_diagram !diagrams.(i'); - dd.(i)#set_label - (Printf.sprintf "diagram #%d (of %d)" (succ i') !num_diagrams) - done; - for i = succ last to pred num_squares do - dd.(i)#clear_diagram (); - dd.(i)#set_label "no diagram" - done in - factory#add_item "Execute" ~key:GdkKeysyms._X - ~callback:(fun () -> - diagrams := Array.of_list (process incoming#states outgoing#states); - num_diagrams := Array.length !diagrams; - min_offset := 0; - max_offset := !num_diagrams - num_squares; - offset := !min_offset; - redraw ()); - window#add_accel_group accel_group; - window#event#connect#key_press ~callback:(fun evt -> - let old_offset = !offset in - let k = GdkEvent.Key.keyval evt in - if k = GdkKeysyms._b then - offset := clamp (pred !offset) - else if k = GdkKeysyms._f then - offset := clamp (succ !offset) - else if k = GdkKeysyms._p then - offset := clamp (!offset - columns) - else if k = GdkKeysyms._n then - offset := clamp (!offset + columns); - if old_offset <> !offset then - redraw (); - -(*i - Printf.eprintf "key = %s: %d (%d, %d) => %d\n" - (GdkEvent.Key.string evt) old_offset !min_offset !max_offset !offset; - flush stderr; -i*) - true); - window#show (); - GMain.Main.main () - -let _ = Printexc.print main () - -(*i - begin - let fancy = "omega_logo_fancy.xpm" - and plain = "omega_logo.xpm" in - if Sys.file_exists fancy then - let pixmap = GDraw.pixmap_from_xpm ~file:fancy ~window () in - ignore (GMisc.pixmap pixmap ~packing:vbox#pack ()) - else if Sys.file_exists plain then - let pixmap = GDraw.pixmap_from_xpm ~file:plain ~window () in - ignore (GMisc.pixmap pixmap ~packing:vbox#pack ()) - end; -i*) - -module type Integers = - Model.Mutable with type flavor = int - and type constant = int and type gauge = int - -module Model_Loader (Mutable : Integers) - (Static : Model.T with type constant = int and type gauge = int) = - struct - - let kludge_flavor = List.hd (Static.flavors ()) - let kludge_flavor_int = 0 - let kludge_constant = 0 - let kludge_gauge = 0 - - let kludge_vertices = - fun () -> ([], [], []) - let kludge_fuse = - ((fun _ _ -> []), (fun _ _ _ -> []), (fun _ -> [])) - let int_to_flavor f = kludge_flavor - let int_of_flavor f = kludge_flavor_int - let int_to_constant c = kludge_constant - let int_to_gauge g = kludge_gauge - - let lift_flavor fct f = fct (int_to_flavor f) - let lift_constant fct c = fct (int_to_constant c) - let lift_gauge fct g = fct (int_to_gauge g) - - let load () = - Mutable.setup - ~color:(lift_flavor Static.color) - ~pdg:(lift_flavor Static.pdg) - ~lorentz:(lift_flavor Static.lorentz) - ~propagator:(lift_flavor Static.propagator) - ~width:(lift_flavor Static.width) - ~goldstone:(fun f -> - match Static.goldstone (int_to_flavor f) with - | None -> None - | Some (f', phase') -> Some (int_of_flavor f', phase')) - ~conjugate:(fun f -> - int_of_flavor (Static.conjugate (int_to_flavor f))) - ~fermion:(lift_flavor Static.fermion) - ~max_degree:(Static.max_degree ()) - ~vertices:kludge_vertices - ~fuse:kludge_fuse - ~flavors:(List.map (fun (s, fl) -> - (s, List.map int_of_flavor fl)) (Static.external_flavors ())) - ~parameters:(Static.parameters) - ~flavor_of_string:(fun s -> - int_of_flavor (Static.flavor_of_string s)) - ~flavor_to_string:(lift_flavor Static.flavor_to_string) - ~flavor_symbol:(lift_flavor Static.flavor_symbol) - ~gauge_symbol:(lift_gauge Static.gauge_symbol) - ~mass_symbol:(lift_flavor Static.mass_symbol) - ~width_symbol:(lift_flavor Static.width_symbol) - ~constant_symbol:(lift_constant Static.constant_symbol) - end - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/color.mli =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/color.mli (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/color.mli (revision 8703) @@ -1,521 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -(* \thocwmodulesection{Quantum Numbers} *) - -(* Color is not necessarily the~$\textrm{SU}(3)$ of QCD. Conceptually, - it can be any \emph{unbroken} symmetry (\emph{broken} symmetries correspond - to [Model.flavor]). In order to keep the group theory simple, we confine - ourselves to the fundamental and adjoint representation - of~$\textrm{SU}(N_C)$ for the moment and use the~$\mathrm{SU}(N_C)$ - completeness relation\footnote{The corresponding formulae for the other - Lie algebras (except~$E_8$) can be found in~\cite{Cvi76}.} - \begin{equation} - T^{a}_{ij} T^{a}_{kl} = - \frac{1}{2} \delta_{il} \delta_{jk} - - \frac{1}{2N_C} \delta_{ij} \delta_{kl} - \end{equation} - for the conventional normalization - \begin{equation} - \textrm{tr}(T_{a}T_{b}) = \frac{1}{2}\delta_{ab} - \end{equation} - Therefore, particles are either color singlets or live in the defining - representation of $\textrm{SU}(N)$: [SUN]$(|n|)$, its conjugate [SUN]$(-|n|)$ - or in the adjoint representation of $\textrm{SU}(N)$: [AdjSUN]$(n)$. *) - -type t = Singlet | SUN of int | AdjSUN of int -val conjugate : t -> t - -module type NC = - sig - val nc : int - end - -(* \thocwmodulesection{Color Flows} *) - -module type Flow = - sig - type color - type t = color list * color list - val rank : t -> int - val of_list : int list -> color - val ghost : unit -> color - val to_lists : t -> int list list - val in_to_lists : t -> int list list - val out_to_lists : t -> int list list - val ghost_flags : t -> bool list - val in_ghost_flags : t -> bool list - val out_ghost_flags : t -> bool list - end -module Flow : Flow - -(*i - -(* \thocwmodulesection{Realistic Amplitudes} *) - -(* The applications that we are interested in are typically not in an - asymptotic region where one particular algorithm is always optimal. - In fact, empirically it appears that different amplitudes will prefer - different algorithms: - \begin{enumerate} - \setcounter{enumi}{-1} - \item \textit{trivial case:} constant factor if there is either only - a single color flow or none at all. - \item \textit{brute force:} calculate the amplitude in the fundamental - and adjoint representation. This will multiply the complexity of - the squared amplitude by - \begin{equation} - N_C^{\#\text{quarks}}\cdot - N_C^{\#\text{anti-quarks}}\cdot - (N_C^2-1)^{\#\text{gluons}} - \end{equation} - which is prohibitive in most cases of interest. But there is always - the option of replacing the color summation by a Monte Carlo - integration~\cite{Kleiss/etal:Color-Monte-Carlo}. - \item \textit{\texttt{MADGRAPH}:} give up on O'Mega-style factorization, go - back to Feynman diagrams and sum over colors in the - \texttt{MADGRAPH}~\cite{Barger/etal:1992:color,MADGRAPH:1994} way. - \item \textit{factorized \texttt{MADGRAPH}:} factorize each color - eigenamplitude. This will multiply the O'Mega complexity the a small - power of the number of color eigenamplitudes. - \item \textit{color flow basis:} calculate the amplitudes in a color - flow basis. This should allow complete O'Mega-style factorization, - but each fusion introduces a product of the number of contributing - color flows. The overall complexity is very hard to estimate a priori. - \end{enumerate} *) - -(* \thocwmodulesubsection{General Case} - We will implement a variation of numeric color - diagonalization~\cite{Barger/etal:1992:color}. *) - -(* \begin{dubious} - The old trick for Feynman diagrams as implemented in \texttt{MADGRAPH} is based - on the observation that the QCD Feynman rules factorize \emph{exactly} - into a color part and a combined spin/flavor part, iff - quartic couplings are represented by cubic coupling to auxiliary - non-propagating antisymmetric tensor field - \begin{multline*} - \parbox{26mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(22,22) - \fmfsurround{d1,e1,d2,e2,d3,e3,d4,e4} - \fmf{gluon}{v12,e1} - \fmf{gluon}{v12,e2} - \fmf{gluon}{v34,e3} - \fmf{gluon}{v34,e4} - \fmf{dashes}{v12,v34} - \fmflabel{1}{e1} - \fmflabel{2}{e2} - \fmflabel{3}{e3} - \fmflabel{4}{e4} - \fmfdot{v12,v34} - \end{fmfgraph*}}} \,= - (\ii g f_{a_1a_2b} T_{\mu_1\mu_2,\nu_1\nu_2}) - \left(\frac{\ii g^{\nu_1\nu_3} g^{\nu_2\nu_4}}{2}\right) - (\ii g f_{a_3a_4b} T_{\mu_3\mu_4,\nu_3\nu_4}) \\ - = \mbox{} - \ii g^2 f_{a_1a_2b}f_{a_3a_4b} - (g_{\mu_1\mu_3} g_{\mu_4\mu_2} - g_{\mu_1\mu_4} g_{\mu_2\mu_3}) - \end{multline*} - with $T_{\mu_1\mu_2,\mu_3\mu_4} = - g_{\mu_1\mu_3}g_{\mu_4\mu_2}-g_{\mu_1\mu_4}g_{\mu_2\mu_3}$. - Therefore the Feynman diagrams also factorize \emph{exactly} into a - color part and a combined spin/flavor part, but not amplitudes and - sums of Feynman diagrams. - - Anyway, the scattering amplitude can be written - \begin{equation*} - T = \sum_{i=1}^{\#\text{diagrams}} C_i T_i - \end{equation*} - and the squared amplitude - \begin{equation*} - TT^{\dagger} = - \sum_{i,j=1}^{\#\text{diagrams}} C_iC_j^{\dagger} T_iT_j^{\dagger} - \end{equation*} - can be summed and/or averaged over colors \emph{separately} - \begin{equation*} - \sum_{\text{colors}} TT^{\dagger} = - \sum_{i,j=1}^{\#\text{diagrams}} \mathbf{C}_{ij} T_iT_j^{\dagger} - \end{equation*} - with - \begin{equation*} - \mathbf{C}_{ij} = \sum_{\text{colors}} C_iC_j^{\dagger} - \end{equation*} - - The matrix $\mathbf{C}$ is hermitian (even real symmetric) and - can be diagonalized with an \emph{orthogonal} matrix~$c$ - \begin{equation*} - \mathbf{C} = c^T \mathbf{\hat C} c - \end{equation*} - i.\,e.~$\mathbf{C}_{ij} = \sum_a c_a^{\hphantom{a}i} - \mathbf{\hat C}_a c_a^{\hphantom{a}j}$ with - \begin{equation*} - \sum_{a=1}^{\#\text{diagrams}} - c_a^{\hphantom{a}i} c_a^{\hphantom{a}j} = \delta^{ij}\quad\text{and}\quad - \sum_{i=1}^{\#\text{diagrams}} - c_a^{\hphantom{a}i} c_b^{\hphantom{b}i} = \delta_{ab} - \end{equation*} - Then - \begin{equation*} - \sum_{\text{colors}} TT^{\dagger} = - \sum_{a=1}^{\#\text{eigenvalues}} \mathbf{\hat C}_a - \hat T_a (\hat T_a)^{\dagger} - \end{equation*} - with $\hat T_a = \sum_i c_a^{\hphantom{a}i} T_i$ and only the non-zero - eigenvalues contribute. This formalism ist therefore useful iff are - only a few. However, the formalism \emph{appears} to depend on - Feynman diagrams, i.\,e.~unsuitable for factorized scattering amplitudes - - %%% For the sums over Feynman diagrams, color eigenamplitudes and wave - %%% functions, we introduce the following conventions: - %%% \begin{align*} - %%% i &\in \{ 1, 2, \ldots, N_{\mathrm{FD}}\} \\ - %%% a &\in \{ 1, 2, \ldots, N_{\mathrm{ev}}, \ldots, N_{\mathrm{FD}}\} \\ - %%% n &\in \{ 1, 2, \ldots, N_{\mathrm{WF}}\} - %%% \end{align*} - - A 1POW can be written as a sum over - \emph{all} Feynman diagrams - \begin{equation*} - W_n = \sum_{i=1}^{\#\text{diagrams}} w_{n,i} = \Braket{0|\phi|n} - \end{equation*} - where $w_{n,i} = \Braket{0|\phi|n}_{\text{diagram \#$i$}}$ - corresponds to the contribution of diagram~$i$ to the - 1POW~$W_n$ (most of which vanish, of course). - - In analogy to - \begin{equation*} - \hat T_a = \sum_{i=1}^{\#\text{diagrams}} c_a^{\hphantom{a}i} T_i - \end{equation*} - we define - \begin{equation*} - \widehat W_{n,a} = \sum_{i=1}^{\#\text{diagrams}} c_a^{\hphantom{a}i} w_{n,i} - \end{equation*} - and since~$c$ is \emph{orthogonal} we have the inverse relation - \begin{equation*} - w_{n,i} = \sum_a \widehat W_{n,a} c_a^{\hphantom{a}i} - \end{equation*} - where the sum \emph{must} include the vanishing - eigenvalues this time. - - Decomposing the keystones in - $T = \sum_{p,q,r} K^3_{pqr} W_p W_q W_r + \text{quartic} + \ldots$ - according to Feynman diagrams - \begin{equation*} - T_i = \sum_{p,q,r} k^{3,i}_{pqr} w_{p,i} w_{q,i} w_{r,i} - + \text{quartic} + \ldots - \end{equation*} - we can express the color eigenamplitudes - \begin{multline*} - \hat T_a - = \sum_{\substack{i\\p,q,r}} c_a^{\hphantom{a}i} - k^{3,i}_{pqr} w_{p,i} w_{q,i} w_{r,i} + \text{quartic} + \ldots \\ - = \sum_{\substack{i\\b,c,d\\p,q,r}} - k^{3,i}_{pqr} c_a^{\hphantom{a}i} - c_b^{\hphantom{b}i} c_c^{\hphantom{c}i} c_d^{\hphantom{d}i} - \widehat W_{p,b} \widehat W_{q,c} \widehat W_{r,d} + \ldots - = \sum_{\substack{b,c,d\\p,q,r}} - \hat K^{3,a,bcd}_{pqr} - \widehat W_{p,b} \widehat W_{q,c} \widehat W_{r,d} + \ldots - \end{multline*} - through colored keystones - \begin{equation*} - \hat K^{3,a,bcd}_{pqr} = - \sum_i k^{3,i}_{pqr} - c_a^{\hphantom{a}i} c_b^{\hphantom{b}i} - c_c^{\hphantom{c}i} c_d^{\hphantom{d}i} - \end{equation*} - \emph{with all diagrams summed!}. - - Analogous expressions can be derived for quartic and higher couplings, - of course. The same approach works for colored fusions that build the - 1POWs recursively: - \begin{equation*} - \widehat W_{p,a} = - \sum_{\substack{b,c\\q,r}} - F^{3,a,bc}_{pqr} \widehat W_{p,b} \widehat W_{q,c} + \ldots - \end{equation*} - The resulting algorithm is - \begin{enumerate} - \item \emph{Expand} expand the - DAG into the corresponding list of Feynman diagrams - \item \emph{Diagonalize} calculate the elements - $\mathbf{C}_{ij}$ of the color matrix $\mathbf{C}_{ij}$ and - diagonalize it numerically for the relevant number of colors. - \item \emph{Classify} find which Feynman diagrams - contribute to which 1POW and construct a - dictionary - \item \emph{Recombine} numerically calculate the - colored keystone and fusion - coefficients and generate the code for the amplitude - \end{enumerate} - \end{dubious} - \begin{dubious} - Here's a sketch of the algorithm: - \begin{enumerate} - \item expand the DAG~$D$ to a list~$L$ of trees - \item numerically calculate the matrix~$C$ of color factors - for the squared matrix element - \item diagonalize~$C$ - \item tag the wave functions in~$D$ by the list of their - appearances in~$L$ - \item for each wavefunction in~$D$, calculate the coefficients - of the eigenvectors corresponding to non-zero eigenvalues of~$C$ - \item (like for Fermi statistics) keep only the factors that are - \emph{not} already in the daughter wave functions - \end{enumerate} - \end{dubious} *) - -(* \begin{dubious} - This multiplies the complexity of the colorless amplitude - by the number of eigenvectors with non-zero eigenvalues of~$C$. - Asymptotically, this will beat~\cite{MADGRAPH:1994}, but it is - not obvious where the break-even point is for many eigenvectors. - Therefore more precise estimates will be useful \ldots - \end{dubious} *) - -(* We allow different types for propagators and external lines. This - allows to calculate ``pure'' color diagrams as [(unit, 'e) amplitude] - with manifest equivalence of different particles with identical - color representations. *) -type ('a, 'e) amplitude - -(* [ext color itag et] constructs an external particle wavefunction in - the color representation [color] with external tag [etag] and internal - tag [itag]. *) -val ext : t -> 'a -> 'e -> ('a, 'e) amplitude - -(* [fuse2 color itag wf1 wf2] fuses the wavefunctions [wf1] and [wf2] to - a wavefunction in the color representation [color] with the tag [itag]. *) -val fuse2 : t -> 'a -> ('a, 'e) amplitude -> - ('a, 'e) amplitude -> ('a, 'e) amplitude - -(* [fuse3 color itag wf1 wf2 wf3] ditto, but for quartic vertices. *) -val fuse3 : t -> 'a -> ('a, 'e) amplitude -> - ('a, 'e) amplitude -> ('a, 'e) amplitude -> ('a, 'e) amplitude - -(* [fuse color itag wf_list] is the same in principle for arbitrary - arity, but the implementation is liekely to raise [Incomplete] - for too high arity. *) -val fuse : t -> 'a -> ('a, 'e) amplitude list -> ('a, 'e) amplitude - -(* [Mismatch] is raised when the Feynman rules are inconsistent and - a diagram contains a colored vertex. *) -exception Mismatch - -(* [Impossible_quartic] is raised when the Feynman contain quartic gluon - vertices that destroy factorization of color amplitudes. This problem - can be circumvented using a non-propagating auxiliary field for - representing quartic couplings through cubic couplings. *) -exception Impossible_quartic - -(* As an intermediate representation for color amplitudes corresponding - to a [('a, 'e) Tree.t], objects of type [('a, 'e) amplitude] could be - avoided with some effort using [Tree.fold] directly. However, we - also want to eliminate redundancies and have to check for equivalent - color amplitudes. Also: we are guaranteed that [('a, 'e) amplitude] - is well formed, while [('a, 'e) Tree.t] could have been built from - an inconsistent set of Feynman rules (i.\,e.~colored vertices). *) - -(* [of_tree color proj tree] constructs the color amplitude for the - tree diagram [tree] using [color] for determining the color from - internal tags and [proj] for projecting out the irrelevant information - from internal tags. *) -val of_tree : ('a -> t) -> ('a -> 'b) -> ('a, 'e) Tree.t -> ('b, 'e) amplitude - -(* [to_string ifmt efmt amplitude] constructs a textual representation of the - color amplitude [amplitude], using the formatters [ifmt] and [efmt] for - the internal and external tags respectively. *) -val to_string : ('a -> string) -> ('e -> string) -> ('a, 'e) amplitude -> string - -(*i -type ('tag, 'ext, 'sng, 'fnd, 'cjg, 'adj, 'a) fold_functions -val fold : ('tag, 'ext, 'sng, 'fnd, 'cjg, 'adj, 'a) fold_functions -> - ('tag, 'ext) amplitude -> 'a -i*) - -(* \thocwmodulesubsection{Case of Few Color Flows} - Iff there are only few contributing color flows, it is more efficient to - perform all calculations directly in a color flow basis. *) - -(* \thocwmodulesection{Evaluation} *) - -(* For further processing we can either reduce internal gluons via the - completeness relation or construct a trace of the square in one step. - The first approach reduces part of the complexity from~$N^2$ to~$N$. *) - -(* \thocwmodulesubsection{Algebraic Infrastructure} *) - -(* Allow for different implementations (symbolic and numeric) of the - coefficient ring. *) - -module type Ring = - sig - type t - val null : t - val unit : t - val mul : t -> t -> t - val add : t -> t -> t - val sub : t -> t -> t - val neg : t -> t - val to_float : t -> float - val to_string : t -> string - end - -module type Rational = - sig - include Ring - val is_null : t -> bool - val make : int -> int -> t - end - -(* The coefficient ring required evaluating traces - in~$\mathrm{SU}(N_C)$ and~$\mathrm{SO}(N_C)$ is the ring - generated by the rational numbers~$\mathbf{Q}$ and the - atoms~$N_C$ and~$N_C^{-1}$. It is generated almost freely, - but we take into account that $N_C \cdot N_C^{-1} = 1$. *) - -module type Coeff = - sig - include Ring - val is_null : t -> bool - -(* [atom p] creates the power~$N_C^{p}$ and [coef n d] creates - the rational coefficient~$n/d$. All possible coefficients can - be generated by ring operations from these two.*) - val atom : int -> t - val coeff : int -> int -> t - end - -(* The [Sum] signature describes a variant of rings. The main difference - is that ['a Sum.t] is polymorphic. One could think of using functors - to implement a monomorphic [Sum.t], but this would make dealing with - [Sum.map] much harder. Therefore, we refrain from casting [Sum] into - the [Ring] mold. *) - -module type Sum = - sig - module C : Coeff - type 'a t - val zero : 'a t - val atom : 'a -> 'a t - val scale : C.t -> 'a t -> 'a t - val add : 'a t -> 'a t -> 'a t - val sub : 'a t -> 'a t -> 'a t - val mul : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t - val mulx : ('a -> 'b -> 'c t) -> 'a t -> 'b t -> 'c t -> 'c t - val mulc : ('a -> 'b -> C.t) -> 'a t -> 'b t -> C.t -> C.t - val map : ('a -> 'b) -> 'a t -> 'b t - val eval : ('a -> C.t) -> 'a t -> C.t - val to_string : ('a -> string) -> 'a t -> string - val terms : 'a t -> 'a list - end - -(* \thocwmodulesection{Color Flow Representation} *) - -module type Flows = - sig - module C : Coeff - type 'a t - type 'a wf - val to_string : ('a -> string) -> 'a t -> string - -(* [of_amplitude root a] calculates the sum of color flows - corresponding to amplitude [a] with [root] as label for - the particle at the root. *) - val of_amplitude : 'e -> ('a, 'e) amplitude -> 'e t - -(* [square flip a1 a2] calculates the product of the colorflows - [a1] and [a2], where the duplicate gluon labels are flipped - by [flip]. *) - val square : ('a -> 'a) -> 'a t -> 'a t -> 'a t - val eval : 'a t -> C.t - val eval_square : ('a -> 'a) -> 'a t -> 'a t -> C.t - - type 'a hash - val make_hash : unit -> 'a hash - val eval_memoized : 'a hash -> 'a t -> C.t - val eval_square_memoized : 'a hash -> ('a -> 'a) -> 'a t -> 'a t -> C.t - - end - -module Make_Flows (S : Sum) : Flows with module C = S.C - -module Flows : Flows - -i*) - -(*i -(* \thocwmodulesection{Traces} - \begin{dubious} - Strategy for constructing the trace corresponding to the color sum - for a pair of a diagram and a conjugated diagram: - \begin{enumerate} - \item represent each amplitude by a set of strings - of~$T^{a}$-matrices. Each string is labeled by a pair - consisting of the incoming and outgoing momentum. External - gluons are also labeled by the momenta. It is probably - easiest to use momenta also as summation indices, but there - are two caveats: - \begin{enumerate} - \item make sure that~$p$ and~$-p$ are not confused - \item allow to tag the indices additionally for the - conjugate diagram, because the same momentum can - appear twice (and will certainly for the squares - on the diagonal). - \end{enumerate} - \item combine the open strings of~$T^{a}$-matrices at matching - momenta to color traces and evaluate them. - \end{enumerate} - \end{dubious} *) - - -(* We're following in general the procedure of~\cite{Cvi76}. *) - -module type Traces = - sig - type index - type term - type coeff - val make : index list -> term - val make_term : index list list -> term - val mul : term -> term -> term - val eval : term -> coeff - val format : term -> string - val to_string : coeff -> string - val to_float : coeff -> float - end - -module SU3_Traces : Traces with type index = int - -module SU3_Traces_Float : Traces with type index = int -module SU3_Traces_Small_Rational : Traces with type index = int -module SU3_Traces_Small_Symbolic : Traces with type index = int -module SU3_Traces_Rational : Traces with type index = int -module SU3_Traces_Symbolic : Traces with type index = int - -i*) - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/f90_MSSM_CKM.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/f90_MSSM_CKM.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/f90_MSSM_CKM.ml (revision 8703) @@ -1,33 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -module O = Omega.Make(Fusion.Mixed23_Majorana)(Targets.Fortran_Majorana) - (Models2.MSSM(Models2.MSSM_no_4_ckm)) -let _ = O.main () - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/rCS.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/rCS.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/rCS.ml (revision 8703) @@ -1,111 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -type raw = { revision : string; date : string; author : string; source : string } - -type t = - { name : string; - description : string list; - rcs_revision : string; - rcs_date : string; - rcs_author : string; - rcs_source : string } - -let name r = r.name -let description r = r.description -let revision r = r.rcs_revision -let date r = r.rcs_date -let author r = r.rcs_author -let source r = r.rcs_source - -module TS = ThoString - -let strip_dollars s = - TS.strip_from_last '$' (TS.strip_prefix "$" s) - -let strip_keyword k s = - TS.strip_prefix_star ' ' (TS.strip_prefix ":" (TS.strip_required_prefix k s)) - -let parse1 k s = - strip_keyword k (strip_dollars s) - -let strip_before_keyword k s = - try - let i = TS.index_string k s in - String.sub s i (String.length s - i) - with - | Not_found -> s - -let strip_before_a_keyword k_list s = - let rec strip_before_a_keyword' = function - | k :: k_rest -> - begin try - let i = TS.index_string k s in - String.sub s i (String.length s - i) - with - | Not_found -> strip_before_a_keyword' k_rest - end - | [] -> s in - strip_before_a_keyword' k_list - -(* Required for the transition from CVS to Subversion, because the latter doesn't - support the \texttt{Source} keyword. \texttt{URL} is probably the way to go, - but we leave in \texttt{Id} as a fallback option. *) - -let parse_source s = - let s = strip_dollars s in - try strip_keyword "URL" s with Invalid_argument _ -> - try strip_keyword "Source" s with Invalid_argument _ -> - TS.strip_from_first ' ' (strip_keyword "Id" s) - -(* Assume that the SVN repository follows the recommended layout and - that all files can be found beneath ["/trunk/"], ["/branches/"] or - ["/tags/"]. Strip everything before that. *) - -let strip_svn_repos s = - strip_before_a_keyword ["/trunk/"; "/branches/"; "/tags/"] s - -let parse name description r = - { name = name; - description = description; - rcs_revision = parse1 "Revision" r.revision; - rcs_date = parse1 "Date" r.date; - rcs_author = parse1 "Author" r.author; - rcs_source = strip_svn_repos (parse_source r.source) } - -let rename rcs name description = - { rcs with name = name; description = description } - -let summary rcs = - [ name rcs ^ ":"] @ - List.map (fun s -> " " ^ s) (description rcs) @ - [ " Source: " ^ source rcs; - " revision: " ^ revision rcs ^ " checked in by " ^ - author rcs ^ " at " ^ date rcs ] - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/omega.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/omega.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/omega.ml (revision 8703) @@ -1,406 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -module P = Momentum.Default -module P_Whizard = Momentum.DefaultW - -module type T = - sig - val main : unit -> unit - type flavor - val diagrams : flavor -> flavor -> flavor list -> - ((flavor * Momentum.Default.t) * - (flavor * Momentum.Default.t, - flavor * Momentum.Default.t) Tree.t) list - end - -module Make (Fusion_Maker : Fusion.Maker) (Target_Maker : Target.Maker) (M' : Model.T) = - struct - -(* \begin{dubious} - [max_lines = 8] is plenty, since amplitudes with 8 gluons still take - several \emph{days} to construct. - \end{dubious} *) - module CM = Colorize.It(struct let max_lines = 8 end)(M') - - module M = CM.M - - type flavor = M.flavor - -(* \begin{dubious} - NB: this causes the constant initializers in [Fusion_Maker] more than once. - Such side effects must be avoided if the initializers involve expensive - computations. \emph{Relying on the fact that the functor will be - called only once is not a good idea!} - \end{dubious} *) - module F = Fusion_Maker(P)(CM) - module CF = Fusion.Colored(Fusion_Maker)(P)(CM) - module T = Target_Maker(Fusion_Maker)(P)(CM) - module W = Whizard.Make(Fusion_Maker)(P)(P_Whizard)(CM) - module C = Cascade.Make(CM)(P) - - let version () = - List.iter (fun s -> prerr_endline ("RCS: " ^ s)) - (ThoList.flatmap RCS.summary (CM.rcs :: T.rcs_list @ F.rcs_list)) - - let debug (str, descr, opt, var) = - [ "-warning:" ^ str, Arg.Unit (fun () -> var := (opt, false):: !var), - "check " ^ descr ^ " and print warning on error"; - "-error:" ^ str, Arg.Unit (fun () -> var := (opt, true):: !var), - "check " ^ descr ^ " and terminate on error" ] - - let rec include_goldstones = function - | [] -> false - | (T.Gauge, _) :: _ -> true - | _ :: rest -> include_goldstones rest - - let p2s p = - if p >= 0 && p <= 9 then - string_of_int p - else if p <= 36 then - String.make 1 (Char.chr (Char.code 'A' + p - 10)) - else - "_" - - let format_p wf = - String.concat "" (List.map p2s (F.momentum_list wf)) - - let variable wf = CM.flavor_to_string (F.flavor wf) ^ "[" ^ format_p wf ^ "]" - let variable' wf = CM.flavor_symbol (F.flavor wf) ^ "[" ^ format_p wf ^ "]" - -(* \thocwmodulesection{Parsing Process Descriptions} *) - - type 'a bag = 'a list - type decay = flavor bag * flavor bag list - type scattering = flavor bag * flavor bag * flavor bag list - type process = - | Any of flavor bag list - | Decay of decay - | Scattering of scattering - -(* [parse_process] decodes process descriptions - \begin{subequations} - \begin{align} - \text{\texttt{"a b c d"}} &\Rightarrow \text{[Any [a; b; c; d]]} \\ - \text{\texttt{"a -> b c d"}} &\Rightarrow \text{[Decay (a, [b; c; d])]} \\ - \text{\texttt{"a b -> c d"}} &\Rightarrow \text{[Scattering (a, b, [c; d])]} - \end{align} - \end{subequations} - where each word is split into a bag of flavors separated by `\texttt{:}'s. *) - - let parse_process process = - let last = String.length process - 1 - and flavor off len = M.flavor_of_string (String.sub process off len) in - - let add_flavors flavors = function - | Any l -> Any (List.rev flavors :: l) - | Decay (i, f) -> Decay (i, List.rev flavors :: f) - | Scattering (i1, i2, f) -> Scattering (i1, i2, List.rev flavors :: f) in - - let rec scan_list so_far n = - if n > last then - so_far - else - let n' = succ n in - match process.[n] with - | ' ' | '\n' -> scan_list so_far n' - | '-' -> scan_gtr so_far n' - | c -> scan_flavors so_far [] n n' - - and scan_flavors so_far flavors w n = - if n > last then - add_flavors (flavor w (last - w + 1) :: flavors) so_far - else - let n' = succ n in - match process.[n] with - | ' ' | '\n' -> - scan_list (add_flavors (flavor w (n - w) :: flavors) so_far) n' - | ':' -> scan_flavors so_far (flavor w (n - w) :: flavors) n' n' - | _ -> scan_flavors so_far flavors w n' - - and scan_gtr so_far n = - if n > last then - invalid_arg "expecting `>'" - else - let n' = succ n in - match process.[n] with - | '>' -> - begin match so_far with - | Any [i] -> scan_list (Decay (i, [])) n' - | Any [i2; i1] -> scan_list (Scattering (i1, i2, [])) n' - | Any _ -> invalid_arg "only 1 or 2 particles in |in>" - | _ -> invalid_arg "too many `->'s" - end - | _ -> invalid_arg "expecting `>'" in - - match scan_list (Any []) 0 with - | Any l -> Any (List.rev l) - | Decay (i, f) -> Decay (i, List.rev f) - | Scattering (i1, i2, f) -> Scattering (i1, i2, List.rev f) - -(* Force interpretation as decay and punt on an explicit scattering - \verb+"a b -> c d"+. *) - let parse_decay process = - match parse_process process with - | Any (i :: f) -> - prerr_endline "missing `->' in process description, assuming decay."; - (i, f) - | Decay (i, f) -> (i, f) - | _ -> invalid_arg "expecting decay description: got scattering" - -(* Force interpretation as scattering and punt on an explicit decay - \verb+"a -> b c"+. *) - let parse_scattering process = - match parse_process process with - | Any (i1 :: i2 :: f) -> - prerr_endline "missing `->' in process description, assuming scattering."; - (i1, i2, f) - | Scattering (i1, i2, f) -> (i1, i2, f) - | _ -> invalid_arg "expecting scattering description: got decay" - - let expand_scatterings scatterings = - ThoList.flatmap - (function (fin1, fin2, fout) -> - Product.list - (function - | fin1' :: fin2' :: fout' -> ([fin1'; fin2'], fout') - | [_] | [] -> failwith "Omega.expand_scatterings: can't happen") - (fin1 :: fin2 :: fout)) scatterings - - let expand_decays decays = - ThoList.flatmap - (function (fin, fout) -> - Product.list - (function - | fin' :: fout' -> ([fin'], fout') - | [] -> failwith "Omega.expand_decays: can't happen") - (fin :: fout)) decays - - let read_lines_rev file = - let ic = open_in file in - let rev_lines = ref [] in - let rec slurp () = - rev_lines := input_line ic :: !rev_lines; - slurp () in - try - slurp () - with - | End_of_file -> - close_in ic; - !rev_lines - - let read_lines file = - List.rev (read_lines_rev file) - -(* \thocwmodulesection{Main Program} *) - - let main () = - let usage = - "usage: " ^ Sys.argv.(0) ^ - " [options] [" ^ String.concat "|" (List.map M.flavor_to_string (M.flavors ())) ^ "]" - and rev_scatterings = ref [] - and rev_decays = ref [] - and cascades = ref [] - and checks = ref [] - and output_file = ref None - and print_forest = ref false - and template = ref false - and feynmf = ref None - and feynmf_tex = ref false - and quiet = ref false - and write = ref true - and params = ref false - and poles = ref false - and dag_out = ref None - and dag0_out = ref None in - Arg.parse - (Options.cmdline "-target:" T.options @ - Options.cmdline "-model:" M.options @ - Options.cmdline "-fusion:" CF.options @ - ThoList.flatmap debug - ["", "arguments", T.All, checks; - "a", "# of input arguments", T.Arguments, checks; - "h", "input helicities", T.Helicities, checks; - "m", "input momenta", T.Momenta, checks; - "g", "internal Ward identities", T.Gauge, checks] @ - [("-o", Arg.String (fun s -> output_file := Some s), - "write to given file instead of /dev/stdout"); - ("-scatter", Arg.String (fun s -> rev_scatterings := s :: !rev_scatterings), - "in1 in2 -> out1 out2 ..."); - ("-scatter_file", - Arg.String (fun s -> rev_scatterings := read_lines_rev s @ !rev_scatterings), - "in1 in2 -> out1 out2 ..."); - ("-decay", Arg.String (fun s -> rev_decays := s :: !rev_decays), - "in -> out1 out2 ..."); - ("-decay_file", Arg.String (fun s -> rev_decays := read_lines_rev s @ !rev_decays), - "in -> out1 out2 ..."); - ("-cascade", Arg.String (fun s -> cascades := s :: !cascades), - "select diagrams"); - ("-template", Arg.Set template, - "write a template for using handwritten amplitudes with WHIZARD"); - ("-forest", Arg.Set print_forest, "Diagrammatic expansion"); - ("-feynmf", Arg.String (fun s -> feynmf := Some s), "print feynmf/mp output"); - ("-feynmf_tex", Arg.Set feynmf_tex, "print feynmf/mp/LaTeX output"); - ("-revision", Arg.Unit version, "print revision control information"); - ("-quiet", Arg.Set quiet, "don't print a summary"); - ("-summary", Arg.Clear write, "print only a summary"); - ("-params", Arg.Set params, "print the model parameters"); - ("-poles", Arg.Set poles, "print the Monte Carlo poles"); - ("-dag", Arg.String (fun s -> dag_out := Some s), "print minimal DAG"); - ("-full_dag", Arg.String (fun s -> dag0_out := Some s), "print complete DAG")]) -(*i ("-T", Arg.Int Topology.Binary.debug_triplet, ""); - ("-P", Arg.Int Topology.Binary.debug_partition, "")]) -i*) - (fun _ -> prerr_endline usage; exit 1) - usage; - let output_channel = - match !output_file with - | None -> stdout - | Some name -> open_out name in - let processes = - ThoList.uniq - (List.sort compare - (match List.rev !rev_scatterings, List.rev !rev_decays with - | [], [] -> [] - | scatterings, [] -> expand_scatterings (List.map parse_scattering scatterings) - | [], decays -> expand_decays (List.map parse_decay decays) - | scatterings, decays -> invalid_arg "mixed scattering and decay!")) in - let selectors = - let dim = - let fin, fout = List.hd processes in - List.length fin + List.length fout in - C.to_selectors (C.of_string_list dim !cascades) in - if !params then - T.parameters_to_channel output_channel - else - let amplitudes = - CF.amplitudes (include_goldstones !checks) selectors processes in - if !write then - T.amplitudes_to_channel - (String.concat " " (List.map ThoString.quote (Array.to_list Sys.argv))) - output_channel !checks amplitudes; - if not !quiet then begin - List.iter - (List.iter (fun amplitude -> - Printf.eprintf "SUMMARY: %d fusions, %d propagators" - (F.count_fusions amplitude) (F.count_propagators amplitude); - flush stderr; - Printf.eprintf ", %d diagrams" (F.count_diagrams amplitude); - Printf.eprintf "\n")) - (CF.processes amplitudes); - end; - if !poles then begin - List.iter - (List.iter (fun amplitude -> - W.write output_channel "omega" (W.merge (W.trees amplitude)))) - (CF.processes amplitudes) - end; - begin match !dag0_out with - | Some name -> - let ch = open_out name in - List.iter (List.iter (F.tower_to_dot ch)) (CF.processes amplitudes); - close_out ch - | None -> () - end; - begin match !dag_out with - | Some name -> - let ch = open_out name in - List.iter (List.iter (F.amplitude_to_dot ch)) (CF.processes amplitudes); - close_out ch - | None -> () - end; - if !print_forest then - List.iter - (List.iter (fun amplitude -> - List.iter (fun t -> Printf.eprintf "%s\n" - (Tree.to_string - (Tree.map (fun (wf, _) -> variable wf) (fun _ -> "") t))) - (F.forest (List.hd (F.externals amplitude)) amplitude))) - (CF.processes amplitudes); - -(*i HACK: DIAGNOSTICS TEMPORARYLY DISABLED!!! - begin match !feynmf with - | Some name -> - let fmf wf = - { Tree.style = - begin match M.propagator (F.flavor wf) with - | Coupling.Prop_Feynman - | Coupling.Prop_Gauge _ -> Some "photon" - | Coupling.Prop_Unitarity - | Coupling.Prop_Rxi _ -> Some "double" - | Coupling.Prop_Spinor - | Coupling.Prop_ConjSpinor -> Some "fermion" - | _ -> None - end; - Tree.rev = - begin match M.propagator (F.flavor wf) with - | Coupling.Prop_Spinor -> false - | Coupling.Prop_ConjSpinor -> true - | _ -> false - end; - Tree.label = None; - Tree.tension = None } in - let a = List.hd (CF.processes amplitudes) in - let wf1 = List.hd (F.externals a) - and wf2 = List.hd (List.tl (F.externals a)) - in - Tree.to_feynmf feynmf_tex name variable' wf2 - (List.map (Tree.map (fun (n, _) -> fmf n) (fun l -> l)) - (F.forest wf1 a)) - | None -> () - end; -HACK: DIAGNOSTICS TEMPORARYLY DISABLED!!! i*) - begin match !output_file with - | None -> () - | Some name -> close_out output_channel - end; - exit 0 - -(* \begin{dubious} - This was only intended for debugging O'Giga \ldots - \end{dubious} *) - - let decode wf = - (F.flavor wf, (F.momentum wf : Momentum.Default.t)) - - let diagrams in1 in2 out = - let a = F.amplitude false C.no_cascades [in1; in2] out in - let wf1 = List.hd (F.externals a) - and wf2 = List.hd (List.tl (F.externals a)) in - let wf2 = decode wf2 in - List.map (fun t -> - (wf2, - Tree.map (fun (wf, _) -> decode wf) decode t)) - (F.forest wf1 a) - - let diagrams in1 in2 out = - failwith "Omega().diagrams: disabled" - - end - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/thoGDraw.mli =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/thoGDraw.mli (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/thoGDraw.mli (revision 8703) @@ -1,246 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -(* \thocwmodulesection{Tracking Display Sizes} *) - -(* Tracking [size_allocate] signals is required for drawing methods that need to - know the size of the drawable in question. *) -class type resizeable = - object - method size_allocate : callback:(Gtk.rectangle -> unit) -> GtkSignal.id - end - -class size : #resizeable -> - object - method width : int - method height : int - end - -(* The need for the type parameter ['b] in the following is ever so - slightly nonintuitive. If it were absent - (i.\,e.~[method connect : #resizeable]), the free [..] in - [#resizeable] would be unbound. *) -class type ['a, 'b] window = - object - method window : 'a Gdk.drawable - method realize : unit -> unit - method connect : 'b - constraint 'b = #resizeable - end - -(* \thocwmodulesection{Coordinate Systems} *) - -(* \begin{figure} - \begin{center} - \begin{picture}(120,60) - \put( 0, 0){\framebox(120,60){}} - \put( 20,20){\framebox(80,20){}} - \put( 20,20){\thocwmakebox{0}{0}{bl}{[(x_min,y_min)]}} - \put(100,20){\thocwmakebox{0}{0}{br}{[(x_max,y_min)]}} - \put(100,40){\thocwmakebox{0}{0}{tr}{[(x_max,y_max)]}} - \put( 20,40){\thocwmakebox{0}{0}{tl}{[(x_min,y_max)]}} - \put( 60,40){\thocwmakebox{0}{0}{b}{[x_delta_pxl]}} - \put( 20,40){\thocwmakebox{0}{0}{bl}{[x_min_pxl]}} - \put(100,40){\thocwmakebox{0}{0}{br}{[x_max_pxl]}} - \put(100,30){\thocwmakebox{0}{0}{l}{[y_delta_pxl]}} - \put(100,40){\thocwmakebox{0}{0}{tl}{[y_min_pxl]}} - \put(100,20){\thocwmakebox{0}{0}{bl}{[y_max_pxl]}} - \put( 20,10){\thocwmakebox{0}{0}{r}{[left_margin]}} - \put(100,10){\thocwmakebox{0}{0}{l}{[right_margin]}} - \put( 60,10){\thocwmakebox{0}{0}{c}{[bottom_margin]}} - \put( 60,50){\thocwmakebox{0}{0}{c}{[top_margin]}} - \end{picture} - \end{center} - \caption{\label{fig:coord}% - Coordinate systems.} - \end{figure} - The tracking of [size_allocate] signals is even more important for mapping - world (abstract) coordinates to device (pixel) coordinates. See - figure~\ref{fig:coord} for the semantics of the device (pixel) and - logical (floating point) coordinates. Note that the logical - coordinates follow mathematical conventions instead of the computer - graphics conventions. *) - -class coordinates : ?margins:int -> - ?xrange:(float * float) -> ?yrange:(float * float) -> #resizeable -> - object - method left_margin : int -> unit - method right_margin : int -> unit - method bottom_margin : int -> unit - method top_margin : int -> unit - method margins : int -> unit - method xrange : float -> float -> unit - method yrange : float -> float -> unit - end - -(* There are more private methods, that are in fact more interesting. In - particular [project_x], [project_x], and [project] that map from logical - to device coordinates. *) - -(* \thocwmodulesection{Viewports} *) - -(* Useful string drawing requires flexible facilities for specifying the - alignment. Here, we can either center the string or specify distances - from a reference point in pixels. *) -type horiz = HCenter | Left of int | Right of int -type vert = VCenter | Below of int | Above of int - -class decoration_context : - object - method font : Gdk.font - method font_name : string - method line_width : int - method arrowhead_tip : int - method arrowhead_base : int - method arrowhead_width : int - method wiggle_amp : int - method wiggle_len : int - method wiggle_res : int - method curl_amp : int - method curl_len : int - method curl_res : int - method set_font : string -> unit - method set_line_width : int -> unit - method set_arrowhead_tip : int -> unit - method set_arrowhead_base : int -> unit - method set_arrowhead_width : int -> unit - method set_wiggle_amp : int -> unit - method set_wiggle_len : int -> unit - method set_wiggle_res : int -> unit - method set_curl_amp : int -> unit - method set_curl_len : int -> unit - method set_curl_res : int -> unit - method to_channel : out_channel -> unit - method of_stream : char Stream.t -> unit - method save : unit -> unit - method restore : unit -> unit - end - -class ['a] decorations : ?colormap:Gdk.colormap -> - decoration_context -> 'a Gdk.drawable -> - object - inherit ['a] GDraw.drawable - method decoration_context : decoration_context - method set_decoration_context : decoration_context -> unit - method aligned_string : ?font:Gdk.font -> ?align:(horiz * vert) -> - string -> int * int -> unit - method arrowhead : int * int -> int * int -> unit - method double : int * int -> int * int -> unit - method wiggles : int * int -> int * int -> unit - method curls : int * int -> int * int -> unit - end - -(* When we keep track of the size, we can easily provide an extension - of [GDraw.drawable] that knows how to clear itself to a given background - color. *) - -class ['a] drawable : ?colormap:Gdk.colormap -> - decoration_context -> ('a, 'b) #window -> - object - inherit ['a] decorations - method clear : ?color:GDraw.color -> unit -> unit - end - -(* \begin{dubious} - Conceptually, [['a] decorations] and [['a] decorations] should be - orthogonal and be implemented by aggregation. Unfortunately, - using [GDraw.drawable] with aggregation is complicated by - the fact that each object has its own graphics context [Gdk.GC]. - \end{dubious} *) - -(* The ['a viewport] (where ['a] will mostly be [[`window]], but can - also be [[`pixmap]] or [[`bitmap]]) is an abstraction of ['a drawable], - with both coordinates running in $0\ldots1$ instead of physical - pixel numbers. *) - -type direction = - | Forward - | Backward - -type line_style = - | Plain - | Double - | Wiggles - | Curls - | Dashes - | Dots - | Arrow of direction - | Name of string - -class ['a] viewport : ?colormap:Gdk.colormap -> ?margins:int -> - ?xrange:(float * float) -> ?yrange:(float * float) -> - decoration_context -> ('a, 'b) #window -> - object - inherit coordinates - method drawable : 'a drawable - method point : float * float -> unit - method points : (float * float) list -> unit - method arc : ?filled:bool -> ?start:float -> ?angle:float -> - int * int -> float * float -> unit - method line : float * float -> float * float -> unit - method lines : (float * float) list -> unit - method segments : ((float * float) * (float * float)) list -> unit - method polygon : ?filled:bool -> (float * float) list -> unit - method string : ?font:Gdk.font -> ?align:(horiz * vert) -> - string -> float * float -> unit - method propagator : line_style -> float * float -> float * float -> unit - end - -(* \thocwmodulesection{Diagram Displays} *) - -class ['a, 'edge, 'node] diagram_display : - node_to_string:('node -> string) -> - conjugate:('node -> 'node) -> cross:('node -> 'node) -> - nodes2edge:('node -> 'node -> 'edge) -> - line_style:('edge -> line_style) -> - ?label:string -> ?width:int -> ?height:int -> - ?packing:(GObj.widget -> unit) -> decoration_context -> - object - method viewport : 'a viewport - method event : GObj.event_ops - method set_label : string -> unit - method set_diagram : - 'node * ('node, 'node) Tree.t * - (unit, 'node) Color.amplitude -> unit - method clear_diagram : unit -> unit - method redraw : unit -> unit - end - -(* \thocwmodulesection{Preferences} *) - -class ['a] demo_diagram_display : - line_style:line_style -> ?label:string -> - ?width:int -> ?height:int -> ?packing:(GObj.widget -> unit) -> - decoration_context -> - object - method redraw : unit -> unit - end - -val edit_preferences : decoration_context -> unit - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/vertex_lexer.mll =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/vertex_lexer.mll (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/vertex_lexer.mll (revision 8703) @@ -1,68 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -{ -open Vertex_parser -let string_tail s = - String.sub s 1 (String.length s - 1) -} - -let digit = ['0'-'9'] -let upper = ['A'-'Z'] -let lower = ['a'-'z'] -let char = upper | lower -let white = [' ' '\t' '\n'] - -rule token = parse - white { token lexbuf } (* skip blanks *) - | '%' [^'\n']* '\n' - { token lexbuf } (* skip comments *) - | '.' { DOT } - | '^' { POWER } - | '*' { TIMES } - | '/' { DIV } - | '+' { PLUS } - | '-' { MINUS } - | '(' { LPAREN } - | ',' { COMMA } - | ')' { RPAREN } - | '<' { BRA } - | '|' { VERT } - | '>' { KET } - | '[' { LEXT } - | ']' { REXT } - | digit+ { INT (int_of_string (Lexing.lexeme lexbuf)) } - | 'e' digit+ { POLARIZATION (int_of_string (string_tail (Lexing.lexeme lexbuf))) } - | 'k' digit+ { MOMENTUM (int_of_string (string_tail (Lexing.lexeme lexbuf))) } - | 'i' { I } - | 'S' { S } - | 'P' { P } - | 'V' { V } - | 'A' { A } - | 'T' { T } - | "eps" { EPSILON } - | char (char|digit)* - { NAME (Lexing.lexeme lexbuf) } - | _ { failwith ("invalid character at `" ^ Lexing.lexeme lexbuf ^ "'") } - | eof { END } - - Index: branches/ohl/omega-development/completed/whizard2/src/thoString.mli =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/thoString.mli (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/thoString.mli (revision 8703) @@ -1,58 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -(* This is a very simple library if stroing manipulation functions missing - in O'Caml's standard library. *) - -(* [strip_prefix prefix string] returns [string] with 0 or 1 - occurences of a leading [prefix] removed. *) -val strip_prefix : string -> string -> string - -(* [strip_prefix_star prefix string] returns [string] with any number - of leading occurences of [prefix] removed. *) -val strip_prefix_star : char -> string -> string - -(* [strip_prefix prefix string] returns [string] with a leading - [prefix] removed, raises [Invalid_argument] if there's no match. *) -val strip_required_prefix : string -> string -> string - -(* [strip_from_first c s] returns [s] with everything starting from - the first [c] removed. [strip_from_last c s] returns [s] with - everything starting from the last [c] removed. *) -val strip_from_first : char -> string -> string -val strip_from_last : char -> string -> string - -(* [index_string pattern string] returns the index of the first - occurence of [pattern] in [string], if any. Raises [Not_found], if - [pattern] is not in [string]. *) -val index_string : string -> string -> int - -(* This silently fails if the argument contains both single and double quotes! *) -val quote : string -> string - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/f90_CQED.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/f90_CQED.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/f90_CQED.ml (revision 8703) @@ -1,162 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -let rcs_file = RCS.parse "F90_CQED" ["QED with contact terms"] - { RCS.revision = "$Revision$"; - RCS.date = "$Date$"; - RCS.author = "$Author$"; - RCS.source - = "$URL$" } - -(* QED with contact interactions. *) - -module M : Model.T = - struct - let rcs = rcs_file - - open Coupling - - let options = Options.empty - - type flavor = - | Electron | Positron - | Muon | AntiMuon - | Tau | AntiTau - | Photon | XZ - type flavor_sans_color = flavor - let flavor_sans_color f = f - - let external_flavors () = - [ "Leptons", [Electron; Positron; Muon; AntiMuon; Tau; AntiTau]; - "Gauge Bosons", [Photon] ] - let flavors () = ThoList.flatmap snd (external_flavors ()) - - type gauge = unit - type constant = Q - - let lorentz = function - | Electron | Muon | Tau -> Spinor - | Positron | AntiMuon | AntiTau -> ConjSpinor - | Photon -> Vector - | XZ -> Tensor_1 - - let color _ = Color.Singlet - - let propagator = function - | Electron | Muon | Tau -> Prop_Spinor - | Positron | AntiMuon | AntiTau -> Prop_ConjSpinor - | Photon -> Prop_Feynman - | XZ -> Aux_Vector - - let width _ = Timelike - - let goldstone _ = - None - - let conjugate = function - | Electron -> Positron | Positron -> Electron - | Muon -> AntiMuon | AntiMuon -> Muon - | Tau -> AntiTau | AntiTau -> Tau - | Photon -> Photon - | XZ -> XZ - - let conjugate_sans_color = conjugate - - let fermion = function - | Electron | Muon | Tau -> 1 - | Positron | AntiMuon | AntiTau -> -1 - | Photon -> 0 | XZ -> 0 - - module F = Models.Fusions (struct - type f = flavor - type c = constant - let compare = compare - let conjugate = conjugate - end) - - let vertices () = - ([(Positron, Photon, Electron), FBF (1, Psibar, V, Psi), Q; - (AntiMuon, Photon, Muon), FBF (1, Psibar, V, Psi), Q; - (AntiTau, Photon, Tau), FBF (1, Psibar, V, Psi), Q; - (Positron, XZ, Electron), FBF (1, Psibar, VA, Psi), Q], [], []) - - let table = F.of_vertices (vertices ()) - let fuse2 = F.fuse2 table - let fuse3 = F.fuse3 table - let fuse = F.fuse table - let max_degree () = 3 - - let parameters () = { input = [Q, 1.0]; derived = []; derived_arrays = [] } - - let flavor_of_string = function - | "e-" -> Electron | "e+" -> Positron - | "m-" -> Muon | "m+" -> AntiMuon - | "t-" -> Tau | "t+" -> AntiTau - | "A" -> Photon - | _ -> invalid_arg "Models.QED.flavor_of_string" - - let flavor_to_string = function - | Electron -> "e-" | Positron -> "e+" - | Muon -> "m-" | AntiMuon -> "m+" - | Tau -> "t-" | AntiTau -> "t+" - | Photon -> "A" | XZ -> "xz" - - let flavor_symbol = function - | Electron -> "ele" | Positron -> "pos" - | Muon -> "muo" | AntiMuon -> "amu" - | Tau -> "tau" | AntiTau -> "ata" - | Photon -> "gam" | XZ -> "xz" - - let flavor_sans_color_of_string = flavor_of_string - let flavor_sans_color_to_string = flavor_to_string - let flavor_sans_color_symbol = flavor_symbol - - let gauge_symbol () = - failwith "Models.QED.gauge_symbol: internal error" - - let pdg = function - | Electron -> 11 | Positron -> -11 - | Muon -> 13 | AntiMuon -> -13 - | Tau -> 15 | AntiTau -> -15 - | Photon -> 22 | XZ -> 0 - - let mass_symbol f = - "mass(" ^ string_of_int (abs (pdg f)) ^ ")" - - let width_symbol f = - "width(" ^ string_of_int (abs (pdg f)) ^ ")" - - let constant_symbol = function - | Q -> "qlep" - end - -module O = Omega.Make(Fusion.Binary)(Targets.Fortran)(M) -let _ = O.main () - - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/model_file.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/model_file.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/model_file.ml (revision 8703) @@ -1,364 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -(* In this module, the label [[v]] is ubiquitous for an optional - ``verbose'' flag. *) - -open Printf - -(* \thocwmodulesubsection{Parsing} *) - -let model_of_channel channel = - try - Model_parser.file Model_lexer.token (Lexing.from_channel channel) - with - | Model_syntax.Syntax_Error (msg, i, j) -> - invalid_arg (sprintf "syntax error (%s) at: [%d,%d]" msg i j) - -let model_of_file = function - | "-" -> model_of_channel stdin - | name -> - let channel = open_in name in - let model = model_of_channel channel in - close_in channel; - model - -type error_level = Info | Warning | Error | Panic -let error_level_to_string = function - | Info -> "INFO" - | Warning -> "WARNING" - | Error -> "ERROR" - | Panic -> "PANIC" - -let error ?(v = false) ?pfx ?(lvl = Error) msg = - if v then begin - begin match pfx with - | Some pfx -> eprintf "%s: " pfx - | None -> () - end; - eprintf "%s: %s\n" (error_level_to_string lvl) msg - end - -(* \thocwmodulesubsection{Metadata} *) - -type metadata = - { name : string; - version : string option; - authors : string list; - created : string option; - revised : string list } - -(* Printing metadata and adding defaults, if necessary. *) - -let print_metadata md = - printf "%% %s -- O'Mega model description file\n" md.name; - begin match md.version with - | None -> printf "version { %cId:%c } %% missing in input file\n" '$' '$'; - | Some version -> printf "version {%s}\n" version - end; - begin match md.authors with - | [] -> printf "%% author missing in input file\n"; - | authors -> List.iter (fun a -> printf "author {%s}\n" a) authors; - end; - begin match md.created with - | None -> printf "%% creation date missing in input file\n"; - | Some created -> printf "created {%s}\n" created - end; - List.iter (fun r -> printf "revised {%s}\n" r) md.revised - -(* Extract metadata from the abstract syntax ``tree'', dropping duplicate data. *) - -let extract_authors ?(v = false) ?pfx = function - | [] -> - error ~v ?pfx ~lvl:Warning "no author in model file!"; - [] - | rev_authors -> List.rev rev_authors - -let extract_version ?(v = false) ?pfx = function - | [] -> - error ~v ?pfx ~lvl:Warning "no version in model file!"; - None - | [version] -> Some version - | version :: _ -> - error ~v ?pfx ~lvl:Warning "multiple versions in model file!"; - error ~v ?pfx ~lvl:Info "keeping the last version."; - Some version - -let extract_created ?(v = false) ?pfx rev_created = - match List.rev rev_created with - | [] -> - error ~v ?pfx ~lvl:Warning "no creation date in model file!"; - None - | [created] -> Some created - | created :: _ -> - error ~v ?pfx ~lvl:Warning "multiple creation dates in model file!"; - error ~v ?pfx ~lvl:Info "keeping the first date."; - Some created - -let extract_metadata ?v name file = - { name = name; - authors = extract_authors ?v ~pfx:name file.Model_syntax.authors; - version = extract_version ?v ~pfx:name file.Model_syntax.version; - created = extract_created ?v ~pfx:name file.Model_syntax.created; - revised = List.rev file.Model_syntax.revised } - -(* \thocwmodulesubsection{Particles} *) - -type particle = - { name : string; - is_anti : bool; - lorentz : Coupling.lorentz; - fermion : int; - charge : int option; - color : int option; - pdg : int option; - tex : string option } - -let print_opt_pdg name = function - | None -> () - | Some pdg -> printf "%% %s : pdg = %d\n" name pdg - -let print_neutral p = - printf "particle %s : ... \n" p.name; - print_opt_pdg p.name p.pdg - -let print_charged p a = - printf "particle %s %s : ... \n" p.name a.name; - print_opt_pdg p.name p.pdg; - print_opt_pdg a.name a.pdg - -let print_particle = function - | (p, None) -> print_neutral p - | (p, Some a) -> if not p.is_anti then print_charged p a - -module SMap = - Map.Make (struct type t = string let compare = compare end) - -type particles = (particle * particle option) SMap.t - -let add_neutral name particle map = - SMap.add name (particle, None) map - -let add_charged name1 particle1 name2 particle2 map = - SMap.add name1 (particle1, Some particle2) - (SMap.add name2 (particle2, Some particle1) map) - -(* Boolean values default to [[false]]. *) - -let boolean_attrib ?v ?pfx name attribs = - try - match String.lowercase (List.assoc name attribs) with - | "true" | "t" | "1" -> true - | "false" | "f" | "0" -> false - | value -> - error ?v ?pfx ("invalid boolean value for `" ^ name ^ "': `" ^ value ^ "'!"); - error ?v ?pfx ~lvl:Info "assuming false."; - false - with - | Not_found -> false - -let opt_attrib name attribs = - try Some (List.assoc name attribs) with Not_found -> None - -let opt_int_attrib ?v ?pfx name attribs = - try - Some (int_of_string (List.assoc name attribs)) - with - | Not_found -> None - | Failure "int_of_string" -> - error ?v ?pfx ("invalid optional integer value for `" ^ name ^ - "': `" ^ List.assoc name attribs ^ "'!"); - error ?v ?pfx ~lvl:Info "ignored."; - None - -(* Extract the lorentz representation from the \texttt{spin}, - \texttt{majorana} and \texttt{massive} attributes. *) -let lorentz_of_attribs ?v ?pfx name is_anti attribs = - try - match List.assoc "spin" attribs with - | "0" -> - Coupling.Scalar - | "1/2" -> - if boolean_attrib "majorana" attribs then - Coupling.Majorana - else if is_anti then - Coupling.ConjSpinor - else - Coupling.Spinor - | "1" -> - if boolean_attrib "massive" attribs then - Coupling.Massive_Vector - else - Coupling.Vector - | "2" -> - Coupling.Tensor_2 - | s -> - error ?v ?pfx ("invalid spin for particle `" ^ name ^ "': `" ^ s ^ "'!"); - error ?v ?pfx ~lvl:Info "assuming spin=0."; - Coupling.Scalar - with - | Not_found -> - error ?v ?pfx ("no spin given for particle `" ^ name ^ "'!"); - error ?v ?pfx ~lvl:Info "assuming spin=0."; - Coupling.Scalar - -let charge_of_attribs ?v ?pfx name is_anti attribs = - try - match List.assoc "spin" attribs with - | "0" -> - Coupling.Scalar - | "1/2" -> - if boolean_attrib "majorana" attribs then - Coupling.Majorana - else if is_anti then - Coupling.ConjSpinor - else - Coupling.Spinor - | "1" -> - if boolean_attrib "massive" attribs then - Coupling.Massive_Vector - else - Coupling.Vector - | "2" -> - Coupling.Tensor_2 - | s -> - error ?v ?pfx ("invalid spin for particle `" ^ name ^ "': `" ^ s ^ "'!"); - error ?v ?pfx ~lvl:Info "assuming spin=0."; - Coupling.Scalar - with - | Not_found -> - error ?v ?pfx ("no spin given for particle `" ^ name ^ "'!"); - error ?v ?pfx ~lvl:Info "assuming spin=0."; - Coupling.Scalar - -let rec fermion_of_lorentz = function - | Coupling.Scalar -> 0 - | Coupling.Spinor -> 1 - | Coupling.ConjSpinor -> -1 - | Coupling.Majorana -> 1 - | Coupling.Maj_Ghost -> 0 - | Coupling.Vector -> 0 - | Coupling.Massive_Vector -> 0 - | Coupling.Vectorspinor -> 1 - | Coupling.Tensor_1 -> 0 - | Coupling.Tensor_2 -> 0 - | Coupling.BRS lorentz -> fermion_of_lorentz lorentz - -let fermion_of_attribs ?v ?pfx name is_anti attribs = - match - (boolean_attrib ?v ?pfx "fermion" attribs, - boolean_attrib ?v ?pfx "boson" attribs) with - | false, true -> 0 - | true, false -> if is_anti then 1 else -1 - | true, true -> - error ?v ?pfx ("both `fermion' and `boson' given for `" ^ name ^ "'!"); - error ?v ?pfx ~lvl:Info "ignored."; - fermion_of_lorentz (lorentz_of_attribs ?v ?pfx name is_anti attribs) - | false, false -> - fermion_of_lorentz (lorentz_of_attribs ?v ?pfx name is_anti attribs) - -let particle_of_attribs ?v ?pfx name attribs = - let lorentz = lorentz_of_attribs ?v ?pfx name false attribs in - let fermion = fermion_of_attribs ?v ?pfx name false attribs in - { name = name; - is_anti = false; - lorentz = lorentz; - fermion = fermion; - charge = opt_int_attrib ?v ?pfx "charge" attribs; - color = opt_int_attrib ?v ?pfx "color" attribs; - pdg = opt_int_attrib ?v ?pfx "pdg" attribs; - tex = opt_attrib "tex" attribs } - -let flip_opt_sign = function - | None -> None - | Some n -> Some (- n) - -let color_opt_sign = function - | None -> None - | Some n when n = 3 || n = -3 -> Some (-n) - | Some n -> Some n - -let anti_particle_of_attribs ?v ?pfx name attribs = - let lorentz = lorentz_of_attribs ?v ?pfx name true attribs in - let fermion = fermion_of_attribs ?v ?pfx name true attribs in - { name = name; - is_anti = true; - lorentz = lorentz; - fermion = fermion; - charge = flip_opt_sign (opt_int_attrib ?v ?pfx "charge" attribs); - color = color_opt_sign (opt_int_attrib ?v ?pfx "color" attribs); - pdg = flip_opt_sign (opt_int_attrib ?v ?pfx "pdg" attribs); - tex = opt_attrib "tex.anti" attribs } - -module SSet = - Set.Make (struct type t = string let compare = compare end) - -let known_attribs = - List.fold_right SSet.add - ["spin"; "massive"; "majorana"; "fermion"; "boson"; - "pdg"; "tex"; "tex.anti"; "charge"; "color"] SSet.empty - -let scan_particle_attrib ?v ?pfx (name, value) = - if not (SSet.mem name known_attribs) then begin - error ?v ?pfx ("unknown particle attribute `" ^ name ^ "' = `" ^ value ^ "'!"); - error ?v ?pfx ~lvl:Info "ignored." - end - -let scan_particle_attribs ?v ?pfx attribs = - List.iter (scan_particle_attrib ?v ?pfx) attribs - -let add_particle ?v ?pfx raw_particle map = - scan_particle_attribs ?v ?pfx raw_particle.Model_syntax.attribs; - match raw_particle.Model_syntax.name with - | Model_syntax.Neutral name -> - add_neutral name (particle_of_attribs ?v ?pfx name - raw_particle.Model_syntax.attribs) map - | Model_syntax.Charged (name, anti) -> - add_charged - name (particle_of_attribs ?v ?pfx name - raw_particle.Model_syntax.attribs) - anti (anti_particle_of_attribs ?v ?pfx anti - raw_particle.Model_syntax.attribs) - map - -let extract_particles ?v name file = - List.fold_right (add_particle ?v ~pfx:name) file.Model_syntax.particles SMap.empty - -(* \thocwmodulesection{Test Program} *) - -let _ = - let file = "-" in - let model = model_of_file file in - let metadata = extract_metadata ~v:true file model in - let particles = extract_particles ~v:true file model in - let vertices = model.Model_syntax.vertices in - print_metadata metadata; - SMap.iter (fun name p -> print_particle p) particles; - List.iter (fun v -> Vertex.process_vertex v.Model_syntax.expr) vertices - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/comphep_syntax.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/comphep_syntax.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/comphep_syntax.ml (revision 8703) @@ -1,121 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -type raw = - | I | Integer of int | Symbol of string - | Application of string * raw - | Dotproduct of raw * raw - | Product of (raw * int) list - | Sum of (raw * int) list - -let symbol name = Symbol name -let integer n = Integer n -let imag = I - -let apply f x = Application (f, x) -let dot x y = Dotproduct (x, y) - -let negate = List.map (fun (x, c) -> (x, -c)) -let scale n = List.map (fun (x, c) -> (x, n*c)) - -let add1 (x, c) y = - if c = 0 then - y - else - try - let c' = List.assoc x y + c in - if c' = 0 then - List.remove_assoc x y - else - (x, c') :: (List.remove_assoc x y) - with - | Not_found -> (x, c) :: y - -let addn = List.fold_right add1 - -let multiply x y = - match x, y with - | Product x', Product y' -> Product (addn x' y') - | Integer n, Product y' -> Product (scale n y') - | Product x', Integer n -> Product (scale n x') - | _, Product y' -> Product (add1 (x, 1) y') - | Product x', _ -> Product (add1 (y, 1) x') - | _ when x = y -> Product ([(x, 2)]) - | _ -> Product ([(x, 1); (y, 1)]) - -let divide x y = - match y with - | Product y' -> multiply x (Product (negate y')) - | _ when x = y -> Product ([]) - | _ -> Product ([(x, 1); (y, -1)]) - -let power x n = - match x with - | Product x' -> Product (scale n x') - | x -> Product ([(x, n)]) - -let add x y = - match x, y with - | Sum x', Sum y' -> Sum (addn x' y') - | _, Sum y' -> Sum (add1 (x, 1) y') - | Sum x', _ -> Sum (add1 (y, 1) x') - | _ when x = y -> Sum ([(x, 2)]) - | _ -> Sum ([(x, 1); (y, 1)]) - -let subtract x y = - match y with - | Sum y' -> add x (Sum (negate y')) - | _ when x = y -> Sum ([]) - | _ -> Sum ([(x, 1); (y, -1)]) - -let neg = function - | Sum x -> Sum (negate x) - | x -> Sum ([(x, -1)]) - -type vector = - | Momentum of int - | Index of int - | Index' of int - -let vector_keyword = function - | "p1" -> Some (Momentum 1) - | "p2" -> Some (Momentum 2) - | "p3" -> Some (Momentum 3) - | "p4" -> Some (Momentum 4) - | "m1" -> Some (Index 1) - | "m2" -> Some (Index 2) - | "m3" -> Some (Index 3) - | "m4" -> Some (Index 4) - | "M1" -> Some (Index' 1) - | "M2" -> Some (Index' 2) - | "M3" -> Some (Index' 3) - | "M4" -> Some (Index' 4) - | _ -> None - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) - Index: branches/ohl/omega-development/completed/whizard2/src/comphep.mli =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/comphep.mli (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/comphep.mli (revision 8703) @@ -1,33 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -(* Wolfgang's idea: read Comphep's model files: *) - -module Model : Model.T - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/omega_logo.xpm =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/omega_logo.xpm (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/omega_logo.xpm (revision 8703) @@ -1,460 +0,0 @@ -/* XPM */ -static char *noname[] = { -/* width height ncolors chars_per_pixel */ -"500 450 3 1", -/* colors */ -" c #000000", -". c #FFFFFF", -"X c None", -/* pixels */ -"....................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................", -"....................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................", -"....................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................", -"....................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................", -"....................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................", -"....................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................", -"....................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................", -"....................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................", -"....................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................", -"....................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................", -"....................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................", -"....................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................", -"....................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................", -"....................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................", -"....................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................", -"....................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................", -"....................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................", -"....................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................", -"....................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................", -"....................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................", -"....................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................", -"....................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................", -"....................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................", -"....................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................", -"....................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................", -"....................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................", -"....................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................", -"....................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................", -"...................................................................................................................................................................................................................................... ...............................................................................................................................................................................................................................", -"........................................................................................................................................................................................................................... .....................................................................................................................................................................................................................", -"................................................................................................................................................................................................................. ...........................................................................................................................................................................................................", -".......................................................................................................................................................................................................... ....................................................................................................................................................................................................", -".................................................................................................................................................................................................... ..............................................................................................................................................................................................", -".............................................................................................................................................................................................. .........................................................................................................................................................................................", -"......................................................................................................................................................................................... ...................................................................................................................................................................................", -".................................................................................................................................................................................... ...............................................................................................................................................................................", -"................................................................................................................................................................................ ...........................................................................................................................................................................", -"............................................................................................................................................................................ ........................................................................................................................................................................", -"......................................................................................................................................................................... ....................................................................................................................................................................", -"..................................................................................................................................................................... ................................................................................................................................................................", -"................................................................................................................................................................. .............................................................................................................................................................", -".............................................................................................................................................................. ..........................................................................................................................................................", -"........................................................................................................................................................... .......................................................................................................................................................", -"........................................................................................................................................................ ....................................................................................................................................................", -"..................................................................................................................................................... ..................................................................................................................................................", -"................................................................................................................................................... ...............................................................................................................................................", -"................................................................................................................................................ ............................................................................................................................................", -"............................................................................................................................................. ..........................................................................................................................................", -"........................................................................................................................................... ........................................................................................................................................", -"......................................................................................................................................... ......................................................................................................................................", -"....................................................................................................................................... ....................................................................................................................................", -"..................................................................................................................................... ..................................................................................................................................", -"................................................................................................................................... ..... ................................................................................................................................", -"................................................................................................................................ ..................................... ..............................................................................................................................", -".............................................................................................................................. ................................................... ...........................................................................................................................", -"............................................................................................................................ ............................................................... ..........................................................................................................................", -".......................................................................................................................... ........................................................................ ........................................................................................................................", -"......................................................................................................................... ................................................................................ ......................................................................................................................", -"....................................................................................................................... ....................................................................................... .....................................................................................................................", -"...................................................................................................................... ............................................................................................ ...................................................................................................................", -".................................................................................................................... .................................................................................................. ..................................................................................................................", -".................................................................................................................. ....................................................................................................... ................................................................................................................", -"................................................................................................................. ............................................................................................................. ...............................................................................................................", -"............................................................................................................... ................................................................................................................. .............................................................................................................", -".............................................................................................................. ..................................................................................................................... ............................................................................................................", -"............................................................................................................ ......................................................................................................................... ..........................................................................................................", -"........................................................................................................... ............................................................................................................................. .........................................................................................................", -"......................................................................................................... ................................................................................................................................. ........................................................................................................", -"........................................................................................................ ................................................................................................................................... .......................................................................................................", -"....................................................................................................... ....................................................................................................................................... .....................................................................................................", -"...................................................................................................... ......................................................................................................................................... ....................................................................................................", -"..................................................................................................... ............................................................................................................................................. ...................................................................................................", -"................................................................................................... ............................................................................................................................................... ..................................................................................................", -".................................................................................................. .................................................................................................................................................. .................................................................................................", -"................................................................................................. .................................................................................................................................................... ................................................................................................", -"................................................................................................ ....................................................................................................................................................... ..............................................................................................", -"............................................................................................... ......................................................................................................................................................... .............................................................................................", -".............................................................................................. ........................................................................................................................................................... ............................................................................................", -"............................................................................................ .............................................................................................................................................................. ...........................................................................................", -"........................................................................................... ................................................................................................................................................................ ..........................................................................................", -".......................................................................................... .................................................................................................................................................................. .........................................................................................", -"......................................................................................... .................................................................................................................................................................... .........................................................................................", -"........................................................................................ ...................................................................................................................................................................... ........................................................................................", -"........................................................................................ ........................................................................................................................................................................ .......................................................................................", -"....................................................................................... ......................................................................................................................................................................... ......................................................................................", -"...................................................................................... ........................................................................................................................................................................... .....................................................................................", -"..................................................................................... ............................................................................................................................................................................ ....................................................................................", -".................................................................................... .............................................................................................................................................................................. ...................................................................................", -"................................................................................... ................................................................................................................................................................................ ...................................................................................", -".................................................................................. .................................................................................................................................................................................. ..................................................................................", -"................................................................................. .................................................................................................................................................................................... .................................................................................", -"................................................................................ ..................................................................................................................................................................................... ................................................................................", -"............................................................................... ....................................................................................................................................................................................... ...............................................................................", -"............................................................................... ......................................................................................................................................................................................... ...............................................................................", -".............................................................................. .......................................................................................................................................................................................... ..............................................................................", -"............................................................................. ............................................................................................................................................................................................ .............................................................................", -"............................................................................ .............................................................................................................................................................................................. .............................................................................", -"............................................................................ .............................................................................................................................................................................................. ............................................................................", -"........................................................................... ................................................................................................................................................................................................ ...........................................................................", -".......................................................................... .................................................................................................................................................................................................. ...........................................................................", -"......................................................................... .................................................................................................................................................................................................. ..........................................................................", -"......................................................................... .................................................................................................................................................................................................... .........................................................................", -"........................................................................ ...................................................................................................................................................................................................... .........................................................................", -"....................................................................... ...................................................................................................................................................................................................... ........................................................................", -"....................................................................... ........................................................................................................................................................................................................ ........................................................................", -"...................................................................... ......................................................................................................................................................................................................... .......................................................................", -"..................................................................... .......................................................................................................................................................................................................... ......................................................................", -".................................................................... ............................................................................................................................................................................................................ ......................................................................", -".................................................................... ............................................................................................................................................................................................................. .....................................................................", -"................................................................... .............................................................................................................................................................................................................. .....................................................................", -".................................................................. ................................................................................................................................................................................................................ ....................................................................", -".................................................................. ................................................................................................................................................................................................................. ....................................................................", -"................................................................. .................................................................................................................................................................................................................. ...................................................................", -"................................................................. ................................................................................................................................................................................................................... ...................................................................", -"................................................................ .................................................................................................................................................................................................................... ..................................................................", -"................................................................ ..................................................................................................................................................................................................................... ..................................................................", -"............................................................... ...................................................................................................................................................................................................................... .................................................................", -"............................................................... ....................................................................................................................................................................................................................... .................................................................", -".............................................................. ........................................................................................................................................................................................................................ ................................................................", -"............................................................. ......................................................................................................................................................................................................................... ................................................................", -"............................................................. .......................................................................................................................................................................................................................... ...............................................................", -"............................................................ ........................................................................................................................................................................................................................... ...............................................................", -"............................................................ ............................................................................................................................................................................................................................ ..............................................................", -"........................................................... ............................................................................................................................................................................................................................. ..............................................................", -"........................................................... .............................................................................................................................................................................................................................. ..............................................................", -".......................................................... ............................................................................................................................................................................................................................... .............................................................", -"......................................................... ................................................................................................................................................................................................................................ .............................................................", -"......................................................... ................................................................................................................................................................................................................................. .............................................................", -"......................................................... .................................................................................................................................................................................................................................. ............................................................", -"........................................................ .................................................................................................................................................................................................................................. ............................................................", -"........................................................ ................................................................................................................................................................................................................................... ............................................................", -"....................................................... .................................................................................................................................................................................................................................... ...........................................................", -"....................................................... .................................................................................................................................................................................................................................... ...........................................................", -"...................................................... ...................................................................................................................................................................................................................................... ..........................................................", -"...................................................... ...................................................................................................................................................................................................................................... ..........................................................", -"...................................................... ....................................................................................................................................................................................................................................... ..........................................................", -"..................................................... ........................................................................................................................................................................................................................................ .........................................................", -"..................................................... ........................................................................................................................................................................................................................................ .........................................................", -".................................................... ......................................................................................................................................................................................................................................... .........................................................", -".................................................... .......................................................................................................................................................................................................................................... ........................................................", -"................................................... .......................................................................................................................................................................................................................................... ........................................................", -"................................................... ........................................................................................................................................................................................................................................... ........................................................", -".................................................. ............................................................................................................................................................................................................................................ ........................................................", -".................................................. ............................................................................................................................................................................................................................................. .......................................................", -".................................................. ............................................................................................................................................................................................................................................. .......................................................", -"................................................. .............................................................................................................................................................................................................................................. .......................................................", -"................................................. ............................................................................................................................................................................................................................................... .......................................................", -"................................................. ............................................................................................................................................................................................................................................... ......................................................", -"................................................ ................................................................................................................................................................................................................................................ ......................................................", -"................................................ ................................................................................................................................................................................................................................................ ......................................................", -"................................................ ................................................................................................................................................................................................................................................. ......................................................", -"............................................... ................................................................................................................................................................................................................................................. .....................................................", -"............................................... .................................................................................................................................................................................................................................................. .....................................................", -"............................................... .................................................................................................................................................................................................................................................. .....................................................", -".............................................. ................................................................................................................................................................................................................................................... .....................................................", -".............................................. ................................................................................................................................................................................................................................................... ....................................................", -".............................................. .................................................................................................................................................................................................................................................... ....................................................", -"............................................. ..................................................................................................................................................................................................................................................... ....................................................", -"............................................. ..................................................................................................................................................................................................................................................... ....................................................", -"............................................. ..................................................................................................................................................................................................................................................... ....................................................", -"............................................ ...................................................................................................................................................................................................................................................... ...................................................", -"............................................ ....................................................................................................................................................................................................................................................... ...................................................", -"............................................ ....................................................................................................................................................................................................................................................... ...................................................", -"............................................ ....................................................................................................................................................................................................................................................... ...................................................", -"............................................ ........................................................................................................................................................................................................................................................ ...................................................", -"........................................... ........................................................................................................................................................................................................................................................ ...................................................", -"........................................... ......................................................................................................................................................................................................................................................... ..................................................", -"........................................... ......................................................................................................................................................................................................................................................... ..................................................", -"........................................... ......................................................................................................................................................................................................................................................... ..................................................", -".......................................... .......................................................................................................................................................................................................................................................... ..................................................", -".......................................... .......................................................................................................................................................................................................................................................... ..................................................", -".......................................... ........................................................................................................................................................................................................................................................... ..................................................", -".......................................... ........................................................................................................................................................................................................................................................... .................................................", -"......................................... ........................................................................................................................................................................................................................................................... .................................................", -"......................................... ........................................................................................................................................................................................................................................................... .................................................", -"......................................... ............................................................................................................................................................................................................................................................ .................................................", -"......................................... ............................................................................................................................................................................................................................................................ .................................................", -"......................................... ............................................................................................................................................................................................................................................................. .................................................", -"........................................ ............................................................................................................................................................................................................................................................. .................................................", -"........................................ ............................................................................................................................................................................................................................................................. .................................................", -"........................................ ............................................................................................................................................................................................................................................................. ................................................", -"........................................ .............................................................................................................................................................................................................................................................. ................................................", -"........................................ .............................................................................................................................................................................................................................................................. ................................................", -"........................................ ............................................................................................................................................................................................................................................................... ................................................", -"....................................... ............................................................................................................................................................................................................................................................... ................................................", -"....................................... ............................................................................................................................................................................................................................................................... ................................................", -"....................................... ............................................................................................................................................................................................................................................................... ................................................", -"....................................... ............................................................................................................................................................................................................................................................... ................................................", -"....................................... ............................................................................................................................................................................................................................................................... ................................................", -"....................................... ................................................................................................................................................................................................................................................................ ................................................", -"....................................... ................................................................................................................................................................................................................................................................ ................................................", -"....................................... ................................................................................................................................................................................................................................................................ ...............................................", -"...................................... ................................................................................................................................................................................................................................................................ ...............................................", -"...................................... ................................................................................................................................................................................................................................................................. ...............................................", -"...................................... ................................................................................................................................................................................................................................................................. ...............................................", -"...................................... ................................................................................................................................................................................................................................................................. ...............................................", -"...................................... ................................................................................................................................................................................................................................................................. ...............................................", -"...................................... ................................................................................................................................................................................................................................................................. ...............................................", -"...................................... ................................................................................................................................................................................................................................................................. ...............................................", -"...................................... ................................................................................................................................................................................................................................................................. ...............................................", -"...................................... .................................................................................................................................................................................................................................................................. ...............................................", -"..................................... .................................................................................................................................................................................................................................................................. ...............................................", -"..................................... .................................................................................................................................................................................................................................................................. ...............................................", -"..................................... .................................................................................................................................................................................................................................................................. ...............................................", -"..................................... ................................................................................................................................................................................................................................................................... ...............................................", -"..................................... ................................................................................................................................................................................................................................................................... ...............................................", -"..................................... ................................................................................................................................................................................................................................................................... ...............................................", -"..................................... ................................................................................................................................................................................................................................................................... ...............................................", -"..................................... ................................................................................................................................................................................................................................................................... ...............................................", -"..................................... ................................................................................................................................................................................................................................................................... ...............................................", -"..................................... ................................................................................................................................................................................................................................................................... ...............................................", -"..................................... ................................................................................................................................................................................................................................................................... ...............................................", -"..................................... ................................................................................................................................................................................................................................................................... ...............................................", -"..................................... ................................................................................................................................................................................................................................................................... ...............................................", -"..................................... ................................................................................................................................................................................................................................................................... ...............................................", -"..................................... ................................................................................................................................................................................................................................................................... ...............................................", -"..................................... ................................................................................................................................................................................................................................................................... ...............................................", -"..................................... ................................................................................................................................................................................................................................................................... ...............................................", -"..................................... ................................................................................................................................................................................................................................................................... ...............................................", -"..................................... ................................................................................................................................................................................................................................................................... ...............................................", -"..................................... ................................................................................................................................................................................................................................................................... ...............................................", -"..................................... ................................................................................................................................................................................................................................................................... ...............................................", -"..................................... ................................................................................................................................................................................................................................................................... ...............................................", -"..................................... ................................................................................................................................................................................................................................................................... ...............................................", -"..................................... ................................................................................................................................................................................................................................................................... ...............................................", -"..................................... ................................................................................................................................................................................................................................................................... ...............................................", -"..................................... ................................................................................................................................................................................................................................................................... ...............................................", -"..................................... ................................................................................................................................................................................................................................................................... ...............................................", -"..................................... ................................................................................................................................................................................................................................................................... ...............................................", -"..................................... ................................................................................................................................................................................................................................................................... ...............................................", -"..................................... ................................................................................................................................................................................................................................................................... ...............................................", -"..................................... ................................................................................................................................................................................................................................................................... ................................................", -"..................................... ................................................................................................................................................................................................................................................................... ................................................", -"..................................... ................................................................................................................................................................................................................................................................... ................................................", -"...................................... ................................................................................................................................................................................................................................................................... ................................................", -"...................................... ................................................................................................................................................................................................................................................................... ................................................", -"...................................... ................................................................................................................................................................................................................................................................... ................................................", -"...................................... ................................................................................................................................................................................................................................................................... ................................................", -"...................................... ................................................................................................................................................................................................................................................................... ................................................", -"...................................... ................................................................................................................................................................................................................................................................... ................................................", -"...................................... ................................................................................................................................................................................................................................................................... .................................................", -"...................................... ................................................................................................................................................................................................................................................................... .................................................", -"....................................... ................................................................................................................................................................................................................................................................. .................................................", -"....................................... ................................................................................................................................................................................................................................................................. .................................................", -"....................................... ................................................................................................................................................................................................................................................................. .................................................", -"....................................... ................................................................................................................................................................................................................................................................. .................................................", -"....................................... ................................................................................................................................................................................................................................................................. .................................................", -"....................................... ................................................................................................................................................................................................................................................................. .................................................", -"....................................... ................................................................................................................................................................................................................................................................. .................................................", -"........................................ ................................................................................................................................................................................................................................................................. ..................................................", -"........................................ ................................................................................................................................................................................................................................................................. ..................................................", -"........................................ ................................................................................................................................................................................................................................................................. ..................................................", -"........................................ ................................................................................................................................................................................................................................................................. ..................................................", -"........................................ ................................................................................................................................................................................................................................................................. ..................................................", -"......................................... ............................................................................................................................................................................................................................................................... ...................................................", -"......................................... ............................................................................................................................................................................................................................................................... ...................................................", -"......................................... ............................................................................................................................................................................................................................................................... ...................................................", -"......................................... ............................................................................................................................................................................................................................................................... ...................................................", -"......................................... ............................................................................................................................................................................................................................................................... ...................................................", -".......................................... ............................................................................................................................................................................................................................................................... ....................................................", -".......................................... .............................................................................................................................................................................................................................................................. ....................................................", -".......................................... .............................................................................................................................................................................................................................................................. ....................................................", -".......................................... .............................................................................................................................................................................................................................................................. ....................................................", -"........................................... .............................................................................................................................................................................................................................................................. ....................................................", -"........................................... ............................................................................................................................................................................................................................................................. ....................................................", -"........................................... ............................................................................................................................................................................................................................................................ .....................................................", -"........................................... ............................................................................................................................................................................................................................................................ .....................................................", -"............................................ ............................................................................................................................................................................................................................................................ .....................................................", -"............................................ ............................................................................................................................................................................................................................................................ ......................................................", -"............................................ ............................................................................................................................................................................................................................................................ ......................................................", -"............................................ ............................................................................................................................................................................................................................................................ ......................................................", -"............................................. .......................................................................................................................................................................................................................................................... ......................................................", -"............................................. .......................................................................................................................................................................................................................................................... .......................................................", -"............................................. .......................................................................................................................................................................................................................................................... .......................................................", -".............................................. .......................................................................................................................................................................................................................................................... .......................................................", -".............................................. .......................................................................................................................................................................................................................................................... ........................................................", -".............................................. ......................................................................................................................................................................................................................................................... ........................................................", -"............................................... ........................................................................................................................................................................................................................................................ ........................................................", -"............................................... ........................................................................................................................................................................................................................................................ ........................................................", -"............................................... ........................................................................................................................................................................................................................................................ .........................................................", -"................................................ ........................................................................................................................................................................................................................................................ .........................................................", -"................................................ ....................................................................................................................................................................................................................................................... .........................................................", -"................................................. ....................................................................................................................................................................................................................................................... ..........................................................", -"................................................. ...................................................................................................................................................................................................................................................... ..........................................................", -"................................................. ..................................................................................................................................................................................................................................................... ..........................................................", -".................................................. ..................................................................................................................................................................................................................................................... ...........................................................", -".................................................. ..................................................................................................................................................................................................................................................... ...........................................................", -".................................................. ................................................................................................................................................................................................................................................... ...........................................................", -"................................................... ................................................................................................................................................................................................................................................... ............................................................", -"................................................... ................................................................................................................................................................................................................................................... ............................................................", -".................................................... .................................................................................................................................................................................................................................................. .............................................................", -".................................................... ................................................................................................................................................................................................................................................. .............................................................", -"..................................................... ................................................................................................................................................................................................................................................. .............................................................", -"..................................................... ................................................................................................................................................................................................................................................ ..............................................................", -"..................................................... ................................................................................................................................................................................................................................................ ..............................................................", -"...................................................... ............................................................................................................................................................................................................................................... ...............................................................", -"...................................................... .............................................................................................................................................................................................................................................. ...............................................................", -"....................................................... .............................................................................................................................................................................................................................................. ...............................................................", -"....................................................... .............................................................................................................................................................................................................................................. ................................................................", -"........................................................ ............................................................................................................................................................................................................................................. ................................................................", -"........................................................ ............................................................................................................................................................................................................................................ .................................................................", -"......................................................... ............................................................................................................................................................................................................................................ .................................................................", -"......................................................... ........................................................................................................................................................................................................................................... ..................................................................", -".......................................................... .......................................................................................................................................................................................................................................... ..................................................................", -".......................................................... .......................................................................................................................................................................................................................................... ...................................................................", -"........................................................... .......................................................................................................................................................................................................................................... ...................................................................", -"............................................................ ........................................................................................................................................................................................................................................ ....................................................................", -"............................................................ ........................................................................................................................................................................................................................................ ....................................................................", -"............................................................. ....................................................................................................................................................................................................................................... .....................................................................", -"............................................................. ...................................................................................................................................................................................................................................... ......................................................................", -".............................................................. ..................................................................................................................................................................................................................................... ......................................................................", -".............................................................. ..................................................................................................................................................................................................................................... .......................................................................", -"............................................................... ................................................................................................................................................................................................................................... .......................................................................", -"............................................................... ................................................................................................................................................................................................................................... ........................................................................", -"................................................................ .................................................................................................................................................................................................................................. ........................................................................", -"................................................................. ................................................................................................................................................................................................................................. .........................................................................", -"................................................................. ................................................................................................................................................................................................................................ ..........................................................................", -".................................................................. ................................................................................................................................................................................................................................ ..........................................................................", -"................................................................... .............................................................................................................................................................................................................................. ...........................................................................", -"................................................................... .............................................................................................................................................................................................................................. ............................................................................", -".................................................................... ............................................................................................................................................................................................................................ ............................................................................", -"..................................................................... ............................................................................................................................................................................................................................ .............................................................................", -"..................................................................... .......................................................................................................................................................................................................................... ..............................................................................", -"...................................................................... .......................................................................................................................................................................................................................... ..............................................................................", -"....................................................................... ......................................................................................................................................................................................................................... ...............................................................................", -"....................................................................... ........................................................................................................................................................................................................................ ................................................................................", -"........................................................................ ....................................................................................................................................................................................................................... ................................................................................", -"......................................................................... ...................................................................................................................................................................................................................... .................................................................................", -".......................................................................... ..................................................................................................................................................................................................................... ..................................................................................", -"........................................................................... .................................................................................................................................................................................................................... ...................................................................................", -"........................................................................... ................................................................................................................................................................................................................... ....................................................................................", -"............................................................................ .................................................................................................................................................................................................................. ....................................................................................", -"............................................................................. ................................................................................................................................................................................................................. .....................................................................................", -".............................................................................. ............................................................................................................................................................................................................... ......................................................................................", -".............................................................................. .............................................................................................................................................................................................................. .......................................................................................", -"............................................................................... ............................................................................................................................................................................................................. ........................................................................................", -"................................................................................ ........................................................................................................................................................................................................... .........................................................................................", -"................................................................................. .......................................................................................................................................................................................................... ..........................................................................................", -".................................................................................. ......................................................................................................................................................................................................... ...........................................................................................", -"................................................................................... ....................................................................................................................................................................................................... ...........................................................................................", -".................................................................................... ...................................................................................................................................................................................................... ............................................................................................", -"..................................................................................... ..................................................................................................................................................................................................... .............................................................................................", -"..................................................................................... .................................................................................................................................................................................................... ..............................................................................................", -"...................................................................................... .................................................................................................................................................................................................. ...............................................................................................", -"....................................................................................... ................................................................................................................................................................................................. .................................................................................................", -"........................................................................................ ............................................................................................................................................................................................... ..................................................................................................", -"......................................................................................... .............................................................................................................................................................................................. ...................................................................................................", -".......................................................................................... ............................................................................................................................................................................................ ....................................................................................................", -"........................................................................................... ........................................................................................................................................................................................... .....................................................................................................", -"............................................................................................ ......................................................................................................................................................................................... ......................................................................................................", -".............................................................................................. ....................................................................................................................................................................................... .......................................................................................................", -"............................................................................................... ..................................................................................................................................................................................... ........................................................................................................", -"................................................................................................ .................................................................................................................................................................................... .........................................................................................................", -"................................................................................................. ................................................................................................................................................................................... ..........................................................................................................", -".................................................................................................. ................................................................................................................................................................................. ............................................................................................................", -"................................................................................................... ............................................................................................................................................................................... .............................................................................................................", -".................................................................................................... ............................................................................................................................................................................. ..............................................................................................................", -"..................................................................................................... ........................................................................................................................................................................... ...............................................................................................................", -"....................................................................................................... ......................................................................................................................................................................... ................................................................................................................", -"........................................................................................................ ....................................................................................................................................................................... ..................................................................................................................", -"......................................................................................................... .................................................................................................................................................................... ...................................................................................................................", -".......................................................................................................... .................................................................................................................................................................. ....................................................................................................................", -"............................................................................................................ ................................................................................................................................................................ ......................................................................................................................", -"............................................................................................................. .............................................................................................................................................................. .......................................................................................................................", -".............................................................................................................. ............................................................................................................................................................ .........................................................................................................................", -"................................................................................................................ .......................................................................................................................................................... ..........................................................................................................................", -"................................................................................................................. ........................................................................................................................................................ ...........................................................................................................................", -"................................................................................................................... ...................................................................................................................................................... .............................................................................................................................", -".................................................................................................................... ................................................................................................................................................... ..............................................................................................................................", -"...................................................................................................................... ................................................................................................................................................ ................................................................................................................................", -"....................................................................................................................... ............................................................................................................................................. .................................................................................................................................", -"......................................................................................................................... ........................................................................................................................................... ..................................................................................................................................", -".......................................................................................................................... ....................................................................................................................................... ....................................................................................................................................", -"............................................................................................................................ ..................................................................................................................................... ......................................................................................................................................", -".............................................................................................................................. .................................................................................................................................. ........................................................................................................................................", -"............................................................................................................................... ............................................................................................................................... ..........................................................................................................................................", -"................................................................................................................................. ............................................................................................................................. ............................................................................................................................................", -"................................................................................................................................... ......................................................................................................................... ..............................................................................................................................................", -"..................................................................................................................................... ....................................................................................................................... ................................................................................................................................................", -"....................................................................................................................................... .................................................................................................................... ..................................................................................................................................................", -"......................................................................................................................................... ................................................................................................................ ....................................................................................................................................................", -"........................................................................................................................................... ............................................................................................................. ......................................................................................................................................................", -"............................................................................................................................................. ......................................................................................................... ........................................................................................................................................................", -"............................................................................................................................................... ..................................................................................................... ............................................................................................................................................................", -"............. ........................................................................................................................... ................................................................................................. ................................................................................................................................................................", -"............. ................................................................................................................. ............................................................................................ ....................................................................................................................................................................", -"............ ....................................................................................................... ........................................................................................ ............................................................................................................................................... .......", -"............ .............................................................................................. ................................................................................... ................................................................................................................... ........", -"............ ................................................................................... .............................................................................. ............................................................................................... ........", -"............ ........................................................................ ......................................................................... ........................................................................... ........", -"........... ............................................ .................................................................... ......................................................... .........", -"........... ................ .............................................................. ....................................... .........", -"........... .......................................................... ..................... .........", -"........... ........................................................... .... .........", -".......... .......................................................... ..........", -".......... .......................................................... ..........", -".......... ........................................................... ..........", -"......... ........................................................... ...........", -"......... .......................................................... ...........", -"......... ........................................................... ...........", -"......... ........................................................... ............", -"........ ........................................................... ............", -"........ ........................................................... ............", -"........ ........................................................... ............", -"........ ........................................................... .............", -"....... ............................................................ .............", -"....... ........................................................... .............", -"....... ........................................................... ..............", -"...... ........................................................... ..............", -"...... ............................................................ ..............", -"...... ........................................................... ...............", -"...... ........................................................... ...............", -"..... ............................................................ ...............", -"..... ............................................................ ...............", -"..... ........................................................... ................", -"..... ............................................................ ................", -".... ............................................................ ................", -".... ............................................................ .................", -".... ............................................................ .................", -".... ............................................................ .................", -"... ............................................................ ..................", -"... ............................................................. ..................", -"... ............................................................ ..................", -".. ............................................................ ..................", -".. ............................................................. ...................", -".. ............................................................. ...................", -".. ............................................................ ...................", -". ............................................................. ....................", -". ............................................................. ....................", -". ............................................................. ....................", -". ............................................................. .....................", -" ............................................................. .....................", -" ............................................................. .....................", -" ............................................................. .....................", -" ............................................................. ......................", -" ............................................................. ......................", -" ............................................................. ......................", -" .............................................................. .......................", -" ............................................................. .......................", -" ............................................................. .......................", -" .............................................................. ........................", -" .............................................................. ........................", -" ............................................................. ........................", -" .............................................................. ........................", -" .............................................................. .........................", -" ........................................................ .............................................................. .........................", -" .............................................................................................................................. .............................................................. .........................", -". ........................................................................................................................................................................ .............................................................. ...................................................................... ..........................", -".................................................................................................................................................................................................................................................................... ............................................................................................................. ..........................", -".................................................................................................................................................................................................................................................................... ............................................................................................................................................... .........................." -}; Index: branches/ohl/omega-development/completed/whizard2/src/.depend =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/.depend (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/.depend (revision 8703) @@ -1,153 +0,0 @@ -pmap.cmo: pmap.cmi -pmap.cmx: pmap.cmi -thoList.cmo: thoList.cmi -thoList.cmx: thoList.cmi -thoArray.cmo: pmap.cmi thoArray.cmi -thoArray.cmx: pmap.cmx thoArray.cmi -thoString.cmo: thoString.cmi -thoString.cmx: thoString.cmi -rCS.cmo: thoString.cmi rCS.cmi -rCS.cmx: thoString.cmx rCS.cmi -cache.cmo: cache.cmi -cache.cmx: cache.cmi -progress.cmo: progress.cmi -progress.cmx: progress.cmi -trie.cmo: pmap.cmi trie.cmi -trie.cmx: pmap.cmx trie.cmi -linalg.cmo: linalg.cmi -linalg.cmx: linalg.cmi -algebra.cmo: thoList.cmi pmap.cmi algebra.cmi -algebra.cmx: thoList.cmx pmap.cmx algebra.cmi -options.cmo: options.cmi -options.cmx: options.cmi -product.cmo: thoList.cmi product.cmi -product.cmx: thoList.cmx product.cmi -combinatorics.cmo: thoList.cmi product.cmi combinatorics.cmi -combinatorics.cmx: thoList.cmx product.cmx combinatorics.cmi -partition.cmo: rCS.cmi partition.cmi -partition.cmx: rCS.cmx partition.cmi -tree.cmo: thoList.cmi product.cmi pmap.cmi linalg.cmi tree.cmi -tree.cmx: thoList.cmx product.cmx pmap.cmx linalg.cmx tree.cmi -tuple.cmo: thoList.cmi rCS.cmi product.cmi partition.cmi combinatorics.cmi \ - tuple.cmi -tuple.cmx: thoList.cmx rCS.cmx product.cmx partition.cmx combinatorics.cmx \ - tuple.cmi -topology.cmo: tuple.cmi thoList.cmi rCS.cmi partition.cmi combinatorics.cmi \ - topology.cmi -topology.cmx: tuple.cmx thoList.cmx rCS.cmx partition.cmx combinatorics.cmx \ - topology.cmi -dAG.cmo: tuple.cmi tree.cmi rCS.cmi product.cmi dAG.cmi -dAG.cmx: tuple.cmx tree.cmx rCS.cmx product.cmx dAG.cmi -momentum.cmo: thoList.cmi rCS.cmi momentum.cmi -momentum.cmx: thoList.cmx rCS.cmx momentum.cmi -phasespace.cmo: momentum.cmi phasespace.cmi -phasespace.cmx: momentum.cmx phasespace.cmi -complex.cmo: complex.cmi -complex.cmx: complex.cmi -color.cmo: color.cmi -color.cmx: color.cmi -models.cmo: thoList.cmi rCS.cmi product.cmi options.cmi model.cmi \ - coupling.cmi color.cmi models.cmi -models.cmx: thoList.cmx rCS.cmx product.cmx options.cmx model.cmi \ - coupling.cmi color.cmx models.cmi -models2.cmo: thoList.cmi rCS.cmi product.cmi options.cmi models.cmi \ - coupling.cmi color.cmi models2.cmi -models2.cmx: thoList.cmx rCS.cmx product.cmx options.cmx models.cmx \ - coupling.cmi color.cmx models2.cmi -models3.cmo: thoList.cmi rCS.cmi product.cmi options.cmi models.cmi \ - coupling.cmi color.cmi models3.cmi -models3.cmx: thoList.cmx rCS.cmx product.cmx options.cmx models.cmx \ - coupling.cmi color.cmx models3.cmi -models4.cmo: thoList.cmi rCS.cmi options.cmi models.cmi coupling.cmi \ - color.cmi models4.cmi -models4.cmx: thoList.cmx rCS.cmx options.cmx models.cmx coupling.cmi \ - color.cmx models4.cmi -whizard.cmo: thoList.cmi rCS.cmi product.cmi momentum.cmi model.cmi \ - fusion.cmi whizard.cmi -whizard.cmx: thoList.cmx rCS.cmx product.cmx momentum.cmx model.cmi \ - fusion.cmx whizard.cmi -comphep_syntax.cmo: comphep_syntax.cmi -comphep_syntax.cmx: comphep_syntax.cmi -comphep_lexer.cmo: comphep_parser.cmi -comphep_lexer.cmx: comphep_parser.cmx -comphep_parser.cmo: comphep_syntax.cmi comphep_parser.cmi -comphep_parser.cmx: comphep_syntax.cmx comphep_parser.cmi -comphep.cmo: thoList.cmi rCS.cmi options.cmi models.cmi coupling.cmi \ - comphep_syntax.cmi comphep_parser.cmi comphep_lexer.cmo color.cmi \ - comphep.cmi -comphep.cmx: thoList.cmx rCS.cmx options.cmx models.cmx coupling.cmi \ - comphep_syntax.cmx comphep_parser.cmx comphep_lexer.cmx color.cmx \ - comphep.cmi -cascade_syntax.cmo: cascade_syntax.cmi -cascade_syntax.cmx: cascade_syntax.cmi -cascade_lexer.cmo: cascade_parser.cmi -cascade_lexer.cmx: cascade_parser.cmx -cascade_parser.cmo: cascade_syntax.cmi cascade_parser.cmi -cascade_parser.cmx: cascade_syntax.cmx cascade_parser.cmi -cascade.cmo: thoList.cmi momentum.cmi model.cmi combinatorics.cmi \ - cascade_syntax.cmi cascade_parser.cmi cascade_lexer.cmo cascade.cmi -cascade.cmx: thoList.cmx momentum.cmx model.cmi combinatorics.cmx \ - cascade_syntax.cmx cascade_parser.cmx cascade_lexer.cmx cascade.cmi -colorize.cmo: thoList.cmi rCS.cmi models.cmi model.cmi coupling.cmi \ - combinatorics.cmi color.cmi colorize.cmi -colorize.cmx: thoList.cmx rCS.cmx models.cmx model.cmi coupling.cmi \ - combinatorics.cmx color.cmx colorize.cmi -fusion.cmo: tuple.cmi tree.cmi topology.cmi thoList.cmi rCS.cmi progress.cmi \ - product.cmi options.cmi momentum.cmi model.cmi dAG.cmi coupling.cmi \ - combinatorics.cmi color.cmi cascade.cmi cache.cmi fusion.cmi -fusion.cmx: tuple.cmx tree.cmx topology.cmx thoList.cmx rCS.cmx progress.cmx \ - product.cmx options.cmx momentum.cmx model.cmi dAG.cmx coupling.cmi \ - combinatorics.cmx color.cmx cascade.cmx cache.cmx fusion.cmi -targets_Kmatrix.cmo: rCS.cmi targets_Kmatrix.cmi -targets_Kmatrix.cmx: rCS.cmx targets_Kmatrix.cmi -targets.cmo: thoList.cmi targets_Kmatrix.cmi rCS.cmi options.cmi momentum.cmi \ - model.cmi fusion.cmi coupling.cmi color.cmi targets.cmi -targets.cmx: thoList.cmx targets_Kmatrix.cmx rCS.cmx options.cmx momentum.cmx \ - model.cmi fusion.cmx coupling.cmi color.cmx targets.cmi -omega.cmo: whizard.cmi tree.cmi thoList.cmi target.cmi rCS.cmi product.cmi \ - options.cmi momentum.cmi model.cmi fusion.cmi colorize.cmi cascade.cmi \ - omega.cmi -omega.cmx: whizard.cmx tree.cmx thoList.cmx target.cmi rCS.cmx product.cmx \ - options.cmx momentum.cmx model.cmi fusion.cmx colorize.cmx cascade.cmx \ - omega.cmi -trie.cmi: pmap.cmi -partition.cmi: rCS.cmi -tuple.cmi: rCS.cmi -topology.cmi: tuple.cmi rCS.cmi -dAG.cmi: tuple.cmi tree.cmi rCS.cmi -momentum.cmi: rCS.cmi -phasespace.cmi: momentum.cmi -model.cmi: rCS.cmi options.cmi coupling.cmi color.cmi -models.cmi: model.cmi coupling.cmi -models2.cmi: model.cmi -models3.cmi: model.cmi -models4.cmi: model.cmi -whizard.cmi: momentum.cmi model.cmi fusion.cmi -comphep_parser.cmi: comphep_syntax.cmi -comphep.cmi: model.cmi -cascade_parser.cmi: cascade_syntax.cmi -cascade.cmi: momentum.cmi model.cmi -colorize.cmi: model.cmi -fusion.cmi: tuple.cmi tree.cmi rCS.cmi options.cmi momentum.cmi model.cmi \ - coupling.cmi color.cmi cascade.cmi -target.cmi: rCS.cmi options.cmi momentum.cmi model.cmi fusion.cmi -targets.cmi: target.cmi -omega.cmi: tree.cmi target.cmi momentum.cmi model.cmi fusion.cmi -thoGButton.cmo: thoGButton.cmi -thoGButton.cmx: thoGButton.cmi -thoGWindow.cmo: thoGWindow.cmi -thoGWindow.cmx: thoGWindow.cmi -thoGMenu.cmo: thoGButton.cmi thoGMenu.cmi -thoGMenu.cmx: thoGButton.cmx thoGMenu.cmi -thoGDraw.cmo: tree.cmi thoGWindow.cmi color.cmi thoGDraw.cmi -thoGDraw.cmx: tree.cmx thoGWindow.cmx color.cmx thoGDraw.cmi -thoGMenu.cmi: thoGButton.cmi -thoGDraw.cmi: tree.cmi color.cmi -f90_SM.cmo: targets.cmi omega.cmi models.cmi fusion.cmi -f90_SM.cmx: targets.cmx omega.cmx models.cmx fusion.cmx -f90_QCD.cmo: thoList.cmi targets.cmi rCS.cmi options.cmi omega.cmi models.cmi \ - model.cmi fusion.cmi coupling.cmi color.cmi -f90_QCD.cmx: thoList.cmx targets.cmx rCS.cmx options.cmx omega.cmx models.cmx \ - model.cmi fusion.cmx coupling.cmi color.cmx -f90_MSSM.cmo: targets.cmi omega.cmi models2.cmi fusion.cmi -f90_MSSM.cmx: targets.cmx omega.cmx models2.cmx fusion.cmx Index: branches/ohl/omega-development/completed/whizard2/src/progress.mli =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/progress.mli (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/progress.mli (revision 8703) @@ -1,40 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -type t - -val dummy : t -val channel : out_channel -> int -> t -val file : string -> int -> t -val open_file : string -> int -> t -val reset : t -> int -> string -> unit -val begin_step : t -> string -> unit -val end_step : t -> string -> unit -val summary : t -> string -> unit - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/complex.mli =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/complex.mli (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/complex.mli (revision 8703) @@ -1,72 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -module type T = - sig - type t - - val null : t - val one : t - - val real : t -> float - val imag : t -> float - - val conj : t -> t - val neg : t -> t - val inv : t -> t - - val add : t -> t -> t - val sub : t -> t -> t - val mul : t -> t -> t - val div : t -> t -> t - - val abs : t -> float - val arg : t -> float - - val sqrt : t -> t - val exp : t -> t - val log : t -> t - - val of_float2 : float -> float -> t - val of_int2 : int -> int -> t - val to_float2 : t -> float * float - val to_int2 : t -> int * int - - val of_float : float -> t - val of_int : int -> t - val to_float : t -> float - val to_int : t -> int - - val to_string : t -> string - val of_string : 'a -> 'b - end - -module Dense : T -module Default : T - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/f90_Littlest.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/f90_Littlest.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/f90_Littlest.ml (revision 8703) @@ -1,33 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -module O = Omega.Make(Fusion.Mixed23)(Targets.Fortran_Majorana) - (Models4.Littlest(Models4.BSM_bsm)) -let _ = O.main () - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/f90_SM3_ac.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/f90_SM3_ac.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/f90_SM3_ac.ml (revision 8703) @@ -1,33 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -module O = Omega.Make(Fusion.Binary)(Targets.Fortran) - (Models.SM3(Models.SM_anomalous)) -let _ = O.main () - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/vertex_syntax.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/vertex_syntax.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/vertex_syntax.ml (revision 8703) @@ -1,481 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -(* \thocwmodulesection{Abstract Syntax} *) - -type index = int - -(* \begin{dubious} - \emph{The following is not complete yet.} - We would like to allow scalars as coefficients of vectors. Since - recursive functors are not available in O'Caml yet, we will have to - go back to a polymorphic implementation. - \end{dubious} *) - -module R = Algebra.Make_Ring(Algebra.Small_Rational)(Algebra.Term) -module V = Algebra.Make_Linear(R) - -type scalar_current = S | P | SL | SR -type vector_current = V | A | VL | VR -type tensor_current = T - -let scalar_current_to_string = function - | S -> "S" - | P -> "P" - | SL -> "S-P" - | SR -> "S+P" - -let vector_current_to_string = function - | V -> "V" - | A -> "A" - | VL -> "V-A" - | VR -> "V+A" - -let tensor_current_to_string = function - | T -> "T" - -type atom = - | I - | Constant of string - | Scalar_Current of scalar_current * index * index (* $\bar\psi_n\Gamma\psi_m$ *) - | Dot of vatom * vatom - | Eps of vatom * vatom * vatom * vatom - -and vatom = - | Polarization of index (* $\epsilon_n^{\mu_n}$ *) - | Momentum of index (* $k_n^{\mu_n}$ *) - | Vector_Current of vector_current * index * index (* $\bar\psi_n\fmslash{v}\psi_m$ *) - | External of string - | Pseudo of vatom * vatom * vatom (* $\epsilon^{\mu\nu\rho\sigma}v_\nu v_\rho v_\sigma$ *) - | Vector_Sum of vector - -and tatom = - | Tensor_Current of tensor_current * index * index (* $\bar\psi_n\sigma_{\mu\nu}\psi_m$ *) - | External_Tensor of string - | Tensor_Sum of tensor - -and satom = - | Ket of index (* $\psi_{n}$ *) - | Scalar_Ket of scalar_current * index (* $\Gamma\psi_{n}$ *) - | Slash_Vector_Ket of vatom * vector_current * index (* $\fmslash{v}\psi_{n}$ *) - | Spinor_Sum of spinor - -and catom = - | Bra of index (* $\bar\psi_{n}$ *) - | Bra_Scalar of scalar_current * index (* $\bar\psi_{n}\Gamma$ *) - | Bra_Slash_Vector of vatom * vector_current * index (* $\bar\psi_{n}\fmslash{v}$ *) - | Conj_Spinor_Sum of conj_spinor - -and vsatom = - | Vector_Ket of vector_current * index (* $\gamma_{\mu}\psi_{n}$ *) - | Vector_Spinor of vatom * satom (* $v_{\mu}\psi_{n}$ *) - | Vector_Spinor_Sum of vector_spinor - -and vcatom = - | Bra_Vector of vector_current * index (* $\bar\psi_{n}\gamma_\mu$ *) - | Vector_Conj_Spinor of vatom * catom (* $v_{\mu}\bar\psi_{n}$ *) - | Vector_Conj_Spinor_Sum of vector_conj_spinor - -and scalar = atom R.t -and vector = (vatom, atom) V.t -and tensor = (tatom, atom) V.t -and spinor = (satom, atom) V.t -and conj_spinor = (catom, atom) V.t -and vector_spinor = (vsatom, atom) V.t -and vector_conj_spinor = (vcatom, atom) V.t - -let null = R.null -let integer i = R.scale (R.C.make i 1) (R.unit ()) -let fraction x i = R.scale (R.C.make 1 i) x -let multiple i x = R.scale (R.C.make i 1) x -let mul = R.mul -let add = R.add -let sub = R.sub - -let rec vatom_vsatom v = function - | Vector_Ket (c, n) -> V.atom (Slash_Vector_Ket (v, c, n)) - | Vector_Spinor (v', s) -> V.singleton (R.atom (Dot (v, v'))) s - | Vector_Spinor_Sum vss -> - V.map (fun vs c -> V.scale c (vatom_vsatom v vs)) vss - -let rec vatom_vcatom v = function - | Bra_Vector (c, n) -> V.atom (Bra_Slash_Vector (v, c, n)) - | Vector_Conj_Spinor (v', c) -> V.singleton (R.atom (Dot (v, v'))) c - | Vector_Conj_Spinor_Sum vss -> - V.map (fun vs c -> V.scale c (vatom_vcatom v vs)) vss - -(* The polymorphic map [Pmap] could use a full-fledged sibling - polymorphic set [Pset], but for now we're satiesfied with a - projection from [Pmap]: *) - -module PM = Pmap.List - -module type Pset = - sig - type 'a t - val empty : 'a t - val singleton : 'a -> 'a t - val add : 'a -> 'a t -> 'a t - val of_list : 'a list -> 'a t - val union : 'a t -> 'a t -> 'a t - val elements : 'a t -> 'a list - end - -module PS = - struct - type 'a t = ('a, unit) PM.t - let empty = PM.empty - let singleton e = PM.singleton e () - let add e s = PM.add compare e () s - let of_list list = List.fold_right add list empty - let union s1 s2 = PM.union compare (fun () () -> ()) s1 s2 - let elements s = List.map fst (PM.elements s) - end - -type atoms = - { constants : string list; - momenta : index list; - polarizations : index list; - external_momenta : string list; - spinors : index list; - conj_spinors : index list } - -type atoms_set = - { constants_set : string PS.t; - momenta_set : index PS.t; - polarizations_set : index PS.t; - external_momenta_set : string PS.t; - spinors_set : index PS.t; - conj_spinors_set : index PS.t } - -let empty_atoms = - { constants_set = PS.empty; - momenta_set = PS.empty; - polarizations_set = PS.empty; - external_momenta_set = PS.empty; - spinors_set = PS.empty; - conj_spinors_set = PS.empty } - -let atoms_union a1 a2 = - { constants_set = PS.union a1.constants_set a2.constants_set; - momenta_set = PS.union a1.momenta_set a2.momenta_set; - polarizations_set = PS.union a1.polarizations_set a2.polarizations_set; - external_momenta_set = PS.union a1.external_momenta_set a2.external_momenta_set; - spinors_set = PS.union a1.spinors_set a2.spinors_set; - conj_spinors_set = PS.union a1.conj_spinors_set a2.conj_spinors_set } - -let rec atom_atoms = function - | I -> empty_atoms - | Constant s -> - { empty_atoms with constants_set = PS.singleton s } - | Scalar_Current (c, n, m) -> - { empty_atoms with - conj_spinors_set = PS.singleton n; - spinors_set = PS.singleton m } - | Dot (v1, v2) -> - atoms_union (vatom_atoms v1) (vatom_atoms v2) - | Eps (v1, v2, v3, v4) -> - atoms_union - (atoms_union (vatom_atoms v1) (vatom_atoms v2)) - (atoms_union (vatom_atoms v3) (vatom_atoms v4)) - -and scalar_atoms e = - List.fold_right atoms_union - (List.map atom_atoms (R.atoms e)) empty_atoms - -and vatom_atoms = function - | Vector_Current (c, n, m) -> - { empty_atoms with - conj_spinors_set = PS.singleton n; - spinors_set = PS.singleton m } - | External e -> - { empty_atoms with external_momenta_set = PS.singleton e } - | Polarization e -> - { empty_atoms with polarizations_set = PS.singleton e } - | Momentum p -> - { empty_atoms with momenta_set = PS.singleton p } - | Pseudo (v1, v2, v3) -> - atoms_union (vatom_atoms v1) (atoms_union (vatom_atoms v3) (vatom_atoms v3)) - | Vector_Sum vector -> vector_atoms vector - -and vector_atoms e = - let vectors, scalars = V.atoms e in - List.fold_right atoms_union - (List.map vatom_atoms vectors @ List.map atom_atoms scalars) - empty_atoms - -let scalar_atoms e = - let a = scalar_atoms e in - { constants = PS.elements a.constants_set; - momenta = PS.elements a.momenta_set; - polarizations = PS.elements a.polarizations_set; - external_momenta = PS.elements a.external_momenta_set; - spinors = PS.elements a.spinors_set; - conj_spinors = PS.elements a.conj_spinors_set } - -let rec atom_to_string = function - | I -> "i" - | Constant s -> s - | Scalar_Current (c, n, m) -> - Printf.sprintf "<%d|%s|%d>" n (scalar_current_to_string c) m - | Dot (v1, v2) -> - "(" ^ vatom_to_string v1 ^ "." ^ vatom_to_string v2 ^ ")" - | Eps (v1, v2, v3, v4) -> - "eps(" ^ vatom_to_string v1 ^ "," ^ vatom_to_string v2 ^ "," ^ - vatom_to_string v3 ^ "," ^ vatom_to_string v4 ^ ")" - -and vatom_to_string = function - | Polarization n -> "e" ^ string_of_int n - | Momentum n -> "k" ^ string_of_int n - | Vector_Current (c, n, m) -> - Printf.sprintf "<%d|%s|%d>" n (vector_current_to_string c) m - | External p -> "<<" ^ p ^ ">>" - | Pseudo (v1, v2, v3) -> - "eps(" ^ vatom_to_string v1 ^ "," ^ vatom_to_string v2 ^ "," ^ - vatom_to_string v3 ^ ")" - | Vector_Sum vs -> vector_to_string vs - -and satom_to_string = function - | Ket i -> "|" ^ string_of_int i ^ ">" - | Scalar_Ket (c, i) -> scalar_current_to_string c ^ "|" ^ string_of_int i ^ ">" - | Slash_Vector_Ket (v, c, i) -> - vatom_to_string v ^ "." ^ vector_current_to_string c ^ "|" ^ string_of_int i ^ ">" - | Spinor_Sum s -> spinor_to_string s - -and catom_to_string = function - | Bra i -> "<" ^ string_of_int i ^ "|" - | Bra_Scalar (c, i) -> "<" ^ string_of_int i ^ "|" ^ scalar_current_to_string c - | Bra_Slash_Vector (v, c, i) -> - "<" ^ string_of_int i ^ "|" ^ vector_current_to_string c ^ "." ^ vatom_to_string v - | Conj_Spinor_Sum s -> conj_spinor_to_string s - -and scalar_to_string s = - R.to_string atom_to_string s - -and vector_to_string v = - V.to_string vatom_to_string atom_to_string v - -and spinor_to_string v = - V.to_string satom_to_string atom_to_string v - -and conj_spinor_to_string v = - V.to_string catom_to_string atom_to_string v - -let incomplete f = - failwith (f ^ ": incomplete") - -let derive_atom_vatom v = function - | I | Constant _ | Scalar_Current _ -> V.null () - | Dot (v1, v2) -> - let v1a = V.atom v1 - and v2a = V.atom v2 in - if v1 = v then begin - if v2 = v then - V.add v1a v2a - else - v2a - end else begin - if v2 = v then - v1a - else - V.null () - end - | Eps (v', v1, v2, v3) when v' = v -> V.atom (Pseudo (v1, v2, v3)) - | Eps (v1, v', v3, v2) when v' = v -> V.atom (Pseudo (v1, v2, v3)) - | Eps (v2, v3, v', v1) when v' = v -> V.atom (Pseudo (v1, v2, v3)) - | Eps (v3, v2, v1, v') when v' = v -> V.atom (Pseudo (v1, v2, v3)) - | Eps (_, _, _, _) -> V.null () - -(* \begin{subequations} - \begin{align} - \frac{\partial}{\partial\psi_k} \bar\psi_{n}\Gamma\psi_{m} - &= \delta_{km} \bar\psi_{n}\Gamma \\ - \frac{\partial}{\partial\psi_k} v^{\mu} \bar\psi_{n}\gamma_{\mu}\psi_{m} - &= \delta_{km} \bar\psi_{n}\fmslash{v} - = v^{\mu} \frac{\partial}{\partial\psi_k} \bar\psi_{n}\gamma_{\mu}\psi_{m} \\ - \ldots - \end{align} - \end{subequations} *) -let rec derive_atom_satom s = function - | I | Constant _ -> V.null () - | Scalar_Current (c, n, m) when m = s -> V.atom (Bra_Scalar (c, n)) - | Scalar_Current (_, _, _) -> V.null () - | Dot (v1, v2) -> - let dv1 = derive_vatom_satom s v1 - and dv2 = derive_vatom_satom s v2 in - begin match dv1, dv2 with - | None, None -> V.null () - | Some (Bra_Vector (c, n)), None -> - V.atom (Bra_Slash_Vector (v2, c, n)) - | Some (Vector_Conj_Spinor (v, c)), None -> - V.singleton (R.atom (Dot (v, v2))) c - | Some (Vector_Conj_Spinor_Sum _), None -> - incomplete "derive_atom_satom" - | None, Some (Bra_Vector (c, n)) -> - V.atom (Bra_Slash_Vector (v1, c, n)) - | None, Some (Vector_Conj_Spinor (v, c)) -> - V.singleton (R.atom (Dot (v, v1))) c - | None, Some (Vector_Conj_Spinor_Sum _) -> - incomplete "derive_atom_satom" - | Some vs1, Some vs2 -> - incomplete "derive_atom_satom" - end - | Eps (_, _, _, _) -> - incomplete "derive_atom_satom" - -(* \begin{subequations} - \begin{align} - \frac{\partial}{\partial\psi_k} \bar\psi_{n}\gamma_{\mu}\psi_{m} - &= \delta_{km} \bar\psi_{n}\gamma_{\mu} \\ - \ldots - \end{align} - \end{subequations} *) -and derive_vatom_satom s = function - | Polarization _ | Momentum _ -> None - | Vector_Current (c, n, m) when m = s -> Some (Bra_Vector (c, n)) - | Vector_Current (_, _, _) -> None - | External _ -> None - | Pseudo _ -> incomplete "derive_vatom_satom" - | Vector_Sum vs -> - Some (Vector_Conj_Spinor_Sum (derive_vsatom s vs)) - -and derive_vsatom s vs = - incomplete "derive_vsatom" - -(* \begin{subequations} - \begin{align} - \frac{\partial}{\partial\bar\psi_k} \bar\psi_{n}\Gamma\psi_{m} - &= \delta_{kn} \Gamma\psi_{m} \\ - \frac{\partial}{\partial\bar\psi_k} v^{\mu} \bar\psi_{n}\gamma_{\mu}\psi_{m} - &= \delta_{kn} \fmslash{v}\psi_{m} - = v^{\mu} \frac{\partial}{\partial\bar\psi_k} \bar\psi_{n}\gamma_{\mu}\psi_{m} \\ - \ldots - \end{align} - \end{subequations} *) -let rec derive_atom_catom s = function - | I | Constant _ -> V.null () - | Scalar_Current (c, n, m) when n = s -> V.atom (Scalar_Ket (c, m)) - | Scalar_Current (_, _, _) -> V.null () - | Dot (v1, v2) -> - begin match derive_vatom_catom s v1, derive_vatom_catom s v2 with - | None, None -> V.null () - | Some (Vector_Ket (c, n)), None -> - V.atom (Slash_Vector_Ket (v2, c, n)) - | Some (Vector_Spinor (v, s)), None -> - V.singleton (R.atom (Dot (v, v2))) s - | Some (Vector_Spinor_Sum _), None -> - incomplete "derive_atom_catom" - | None, Some (Vector_Ket (c, n)) -> - V.atom (Slash_Vector_Ket (v1, c, n)) - | None, Some (Vector_Spinor (v, s)) -> - V.singleton (R.atom (Dot (v, v1))) s - | None, Some (Vector_Spinor_Sum _) -> - incomplete "derive_atom_catom" - | Some vs1, Some vs2 -> - incomplete "derive_atom_catom" - end - | Eps (_, _, _, _) -> - incomplete "derive_atom_catom" - -(* \begin{subequations} - \begin{align} - \frac{\partial}{\partial\bar\psi_k} \bar\psi_{n}\gamma_{\mu}\psi_{m} - &= \delta_{kn} \gamma_{\mu}\psi_{m} \\ - \ldots - \end{align} - \end{subequations} *) -and derive_vatom_catom s = function - | Polarization _ -> None - | Momentum _ -> None - | Vector_Current (c, n, m) when n = s -> Some (Vector_Ket (c, m)) - | Vector_Current (_, _, _) -> None - | External _ -> None - | Pseudo _ -> incomplete "derive_vatom_catom" - | Vector_Sum vs -> - Some (Vector_Spinor_Sum (derive_vcatom s vs)) - -and derive_vcatom s vs = - incomplete "derive_vcatom" - -let e i = Polarization i -let k i = Momentum i -let x s = External s - -let dot v1 v2 = - R.atom (if v1 <= v2 then Dot (v1, v2) else Dot (v2, v1)) - -let eps v1 v2 v3 v4 = - R.atom (Eps (v1, v2, v3, v4)) - -let pseudo v1 v2 v3 = - Pseudo (v1, v2, v3) - -let contract_left v t = - invalid_arg "contractions of tensor currents not implemented yet" - -let contract_right t v = - invalid_arg "contractions of tensor currents not implemented yet" - -let addv v1 v2 = - Vector_Sum (V.add (V.atom v1) (V.atom v2)) - -let subv v1 v2 = - Vector_Sum (V.sub (V.atom v1) (V.atom v2)) - -let scalar_current c i j = - R.atom (Scalar_Current (c, i, j)) - -let vector_current c i j = - Vector_Current (c, i, j) - -let tensor_current c i j = - Tensor_Current (c, i, j) - -let i () = R.atom I - -let constant s = - R.atom (Constant s) - -let partial_vector v s = - V.partial (derive_atom_vatom v) s - -let partial_spinor i s = - V.partial (derive_atom_satom i) s - -let partial_conj_spinor i s = - V.partial (derive_atom_catom i) s - -(*i -let scalev c v = - Sum (V.scale (V.C.atom c) (V.atom v)) -i*) - -exception Syntax_Error of string * int * int - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * compile-command:"ocamlc -o vertex thoList.ml{i,} pmap.ml{i,} vertex.ml" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/thoGMenu.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/thoGMenu.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/thoGMenu.ml (revision 8703) @@ -1,146 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -(* Lists of possible particles can be pretty long. Therefore it is - beneficial to present the choices hierarchically. *) - -type 'a menu_tree = - | Leafs of (string * 'a) list - | Branches of (string * 'a menu_tree) list - -let rec submenu_tree accept = function - | Leafs choices -> - let menu = GMenu.menu () in - List.iter (fun (label, choice) -> - let item = GMenu.menu_item ~label ~packing:menu#append () in - ignore (item#connect#activate - ~callback:(fun () -> accept choice))) choices; - menu - | Branches choices -> - let menu = GMenu.menu () in - List.iter (fun (label, choices') -> - let item = GMenu.menu_item ~label ~packing:menu#append () in - item#set_submenu (submenu_tree accept choices')) choices; - menu - -let tree_of_nested_lists format nested = - Branches (List.map (fun (label, sub_menus) -> - (label, Leafs (List.map (fun o -> (format o, o)) sub_menus))) nested) - -(* We can either build the menus at startup (or immediately after - model selection) or build them when the button is clicked. There - appears to be no noticeable performance difference. *) - -class virtual ['a] menu_button widgets format state menu = - object (self) - inherit ['a] ThoGButton.stateful_button widgets format state - method virtual set_menu : 'a menu_tree -> unit - initializer self#set_menu menu - end - -class type ['a] menu_button_type = - object - inherit ['a] menu_button - method set_menu : 'a menu_tree -> unit - end - -(* \begin{dubious} - [class type ['a] menu_button_type = ['a] ThoGMenu.menu_button_type] does - \emph{not} work! - \end{dubious} *) - -class ['a] menu_button_immediate widgets format inistate menu = - object (self) - inherit ['a] menu_button widgets format inistate menu - method set_menu menu = - let m = submenu_tree self#set_state menu in - self#connect#clicked ~callback:(fun () -> m#popup ~button:3 ~time:0); - () - end - -class ['a] menu_button_delayed widgets format state menu = - object (self) - inherit ['a] menu_button widgets format state menu - method set_menu menu = - self#connect#clicked ~callback:(fun () -> - let m = submenu_tree self#set_state menu in - m#popup ~button:3 ~time:0); - () - end - -let menu_button format state menu - ?border_width ?width ?height ?packing ?show () = - new menu_button_delayed (ThoGButton.mutable_button_raw - ?border_width ?width ?height ?packing ?show ()) - format state menu - -(* Select tuples of similar objects. *) - -class ['a] tensor_menu format state menu n ?label ?tooltip_maker - ?border_width ?width ?height ?packing ?show () = - let frame = GBin.frame ?label ?packing ?show () in - let hbox = GPack.hbox ~packing:frame#add ?show () in - let tooltips = - match tooltip_maker with - | None -> None - | Some maker -> Some (GData.tooltips (), maker) in - let buttons = - Array.init n (fun i -> - let mb = menu_button format state menu - ?width ?height ~packing:(hbox#pack ~expand:false) ?show () in - begin match tooltips with - | None -> () - | Some (widget, maker) -> widget#set_tip mb#coerce ~text:(maker i) - end; - mb) in - object (self) - val frame = frame - val mutable buttons : 'a menu_button array = buttons - val mutable active = n - method frame = frame - method set_menu menu = - Array.iter (fun b -> b#set_menu menu) buttons - method set_active n = - active <- n; - Array.iteri (fun i b -> b#misc#set_sensitive (i < active)) buttons - method states = - Array.map (fun b -> b#state) (Array.sub buttons 0 active) - end - -class ['a] factory ?accel_group ?accel_modi ?accel_flags menu_shell = - object (self) - inherit ['a] GMenu.factory - ?accel_group ?accel_modi ?accel_flags menu_shell - method add_submenu_right ?key label = - let item = GMenu.menu_item ~label () in - item#right_justify (); - self#bind item ?key; - GMenu.menu ~packing:item#set_submenu () -end - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/f90_SM3h.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/f90_SM3h.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/f90_SM3h.ml (revision 8703) @@ -1,34 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -module O = - Omega.Make(Fusion.Helac(struct let max_arity = 3 end)) - (Targets.Fortran)(Models.SM3(Models.SM_no_anomalous)) -let _ = O.main () - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/f90_SM_ac_CKM.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/f90_SM_ac_CKM.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/f90_SM_ac_CKM.ml (revision 8703) @@ -1,33 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -module O = Omega.Make(Fusion.Mixed23)(Targets.Fortran) - (Models.SM(Models.SM_anomalous_ckm)) -let _ = O.main () - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/f90_Phi4h.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/f90_Phi4h.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/f90_Phi4h.ml (revision 8703) @@ -1,34 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -module O = - Omega.Make(Fusion.Helac(struct let max_arity = 3 end)) - (Targets.Fortran)(Models.Phi4) -let _ = O.main () - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/ovm_SM.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/ovm_SM.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/ovm_SM.ml (revision 8703) @@ -1,33 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -module O = Omega.Make(Fusion.Mixed23)(Targets.VM) - (Models.SM(Models.SM_no_anomalous)) -let _ = O.main () - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/cache.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/cache.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/cache.ml (revision 8703) @@ -1,68 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -let directory = ref Filename.current_dir_name -let prefix = ref "omega_cache_" - -let set_directory d = - directory := d - -let set_prefix p = - prefix := p - -type hash = string - -let md5_hash value = - Digest.to_hex (Digest.string (Marshal.to_string value [])) - -let file ?(dir = !directory) ?(pfx = !prefix) hash = - Filename.concat dir (pfx ^ hash) - -let write ?dir ?pfx hash value = - let oc = open_out_bin (file ?dir ?pfx hash) in - Marshal.to_channel oc value []; - close_out oc - -let read ?dir ?pfx hash = - try - let ic = open_in_bin (file ?dir ?pfx hash) in - let value = Marshal.from_channel ic in - close_in ic; - value - with - | _ -> raise Not_found - -let maybe_read ?dir ?pfx hash = - try Some (read ?dir ?pfx hash) with Not_found -> None - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) - - - - - Index: branches/ohl/omega-development/completed/whizard2/src/progress.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/progress.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/progress.ml (revision 8703) @@ -1,164 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -type channel = - | Channel of out_channel - | File of string - | Open_File of string * out_channel - -type state = - { channel : channel; - mutable steps : int; - mutable digits : int; - mutable step : int; - created : float; - mutable last_reset : float; - mutable last_begin : float; } - -type t = state option - -let digits n = - if n > 0 then - succ (truncate (log10 (float n))) - else - invalid_arg "Progress.digits: non-positive argument" - -let mod_float2 a b = - let modulus = mod_float a b in - ((a -. modulus) /. b, modulus) - -let time_to_string seconds = - let minutes, seconds = mod_float2 seconds 60. in - if minutes > 0.0 then - let hours, minutes = mod_float2 minutes 60. in - if hours > 0.0 then - let days, hours = mod_float2 hours 24. in - if days > 0.0 then - Printf.sprintf "%.0f:%02.0f days" days hours - else - Printf.sprintf "%.0f:%02.0f hrs" hours minutes - else - Printf.sprintf "%.0f:%02.0f mins" minutes seconds - else - Printf.sprintf "%.2f secs" seconds - -let create channel steps = - let now = Sys.time () in - Some { channel = channel; - steps = steps; - digits = digits steps; - step = 0; - created = now; - last_reset = now; - last_begin = now } - -let dummy = - None - -let channel oc = - create (Channel oc) - -let file name = - let oc = open_out name in - close_out oc; - create (File name) - -let open_file name = - let oc = open_out name in - create (Open_File (name, oc)) - -let close_channel state = - match state.channel with - | Channel oc -> - flush oc - | File _ -> () - | Open_File (_, oc) -> - flush oc; - close_out oc - -let use_channel state f = - match state.channel with - | Channel oc | Open_File (_, oc) -> - f oc; - flush oc - | File name -> - let oc = open_out_gen [Open_append; Open_creat] 0o644 name in - f oc; - flush oc; - close_out oc - -let reset state steps msg = - match state with - | None -> () - | Some state -> - let now = Sys.time () in - state.steps <- steps; - state.digits <- digits steps; - state.step <- 0; - state.last_reset <- now; - state.last_begin <- now - -let begin_step state msg = - match state with - | None -> () - | Some state -> - let now = Sys.time () in - state.step <- succ state.step; - state.last_begin <- now; - use_channel state (fun oc -> - Printf.fprintf oc "[%0*d/%0*d] %s ..." state.digits state.step state.digits state.steps msg) - -let end_step state msg = - match state with - | None -> () - | Some state -> - let now = Sys.time () in - let last = now -. state.last_begin in - let elapsed = now -. state.last_reset in - let estimated = float state.steps *. elapsed /. float state.step in - let remaining = estimated -. elapsed in - use_channel state (fun oc -> - Printf.fprintf oc " %s. [time: %s, total: %s, remaining: %s]\n" msg - (time_to_string last) (time_to_string estimated) (time_to_string remaining)) - -let summary state msg = - match state with - | None -> () - | Some state -> - let now = Sys.time () in - use_channel state (fun oc -> - Printf.fprintf oc "%s. [total time: %s]\n" msg - (time_to_string (now -. state.created))); - close_channel state - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) - - - - - Index: branches/ohl/omega-development/completed/whizard2/src/linalg.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/linalg.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/linalg.ml (revision 8703) @@ -1,307 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -(* This is not a functional implementations, but uses imperative - array in Fotran style for maximimum speed. *) - -exception Singular -exception Not_Square - -let copy_matrix a = - Array.init (Array.length a) - (fun i -> Array.copy a.(i)) - -let matmul a b = - let ni = Array.length a - and nj = Array.length b.(0) - and n = Array.length b in - let ab = Array.make_matrix ni nj 0.0 in - for i = 0 to pred ni do - for j = 0 to pred nj do - for k = 0 to pred n do - ab.(i).(j) <- ab.(i).(j) +. a.(i).(k) *. b.(k).(j) - done - done - done; - ab - -let matmulv a v = - let na = Array.length a in - let nv = Array.length v in - let v' = Array.make na 0.0 in - for i = 0 to pred na do - for j = 0 to pred nv do - v'.(i) <- v'.(i) +. a.(i).(j) *. v.(j) - done - done; - v' - -(*i -let maxval = Array.fold_left max 0.0] - -let maxval a : float = - let x = ref a.(0) in - for i = 1 to Array.length a - 1 do - x := max !x a.(i) - done; - !x -i*) - -let maxabsval a : float = - let x = ref (abs_float a.(0)) in - for i = 1 to Array.length a - 1 do - x := max !x (abs_float a.(i)) - done; - !x - -(*i -let minval = Array.fold_left min 0.0 - -let minval a : float = - let x = ref a.(0) in - for i = 1 to Array.length a - 1 do - x := min !x a.(i) - done; - !x - -let maxloc (a : float array) n = - let n' = ref n - and max_a : float ref = ref a.(n) in - for i = succ n to Array.length a - 1 do - let a_i = a.(i) in - if a_i > !max_a then begin - n' := i; - max_a := a_i - end - done; - !n' - -let minloc (a : float array) n = - let n' = ref n - and min_a : float ref = ref a.(n) in - for i = succ n to Array.length a - 1 do - let a_i = a.(i) in - if a_i < !min_a then begin - n' := i; - min_a := a_i - end - done; - !n' - -let rec any' f (a : float array) i = - if i < 0 then - false - else if f a.(i) then - true - else - any' f a (pred i) - -let any f a = any' f a (Array.length a - 1) -i*) - -(* \thocwmodulesection{$LU$ Decomposition} - \begin{subequations} - \label{eq:LU} - \begin{equation} - A = LU - \end{equation} - In more detail - \begin{multline} - \begin{pmatrix} - a_{00} & a_{01} & \ldots & a_{0(n-1)} \\ - a_{10} & a_{11} & \ldots & a_{1(n-1)} \\ - \vdots & \vdots & \vdots & \vdots \\ - a_{(n-1)0} & a_{(n-1)1} & \ldots & a_{(n-1)(n-1)} - \end{pmatrix} - = \\ - \begin{pmatrix} - 1 & 0 & \ldots & 0 \\ - l_{10} & 1 & \ldots & 0 \\ - \vdots & \vdots & \vdots & \vdots \\ - l_{(n-1)0} & l_{(n-1)1} & \ldots & 1 - \end{pmatrix} - \begin{pmatrix} - u_{00} & u_{01} & \ldots & u_{0(n-1)} \\ - 0 & u_{11} & \ldots & u_{1(n-1)} \\ - \vdots & \vdots & \vdots & \vdots \\ - 0 & 0 & \ldots & u_{(n-1)(n-1)} - \end{pmatrix} - \end{multline} - \end{subequations} - Rewriting~(\ref{eq:LU}) in block matrix notation - \begin{equation} - \begin{pmatrix} - a_{00} & a_{0\cdot} \\ - a_{\cdot0} & A - \end{pmatrix} - = - \begin{pmatrix} - 1 & 0 \\ - l_{\cdot0} & L - \end{pmatrix} - \begin{pmatrix} - u_{00} & u_{0\cdot} \\ - 0 & U - \end{pmatrix} - = - \begin{pmatrix} - u_{00} & u_{0\cdot} \\ - l_{\cdot0} u_{00} & l_{\cdot0} \otimes u_{0\cdot} + LU - \end{pmatrix} - \end{equation} - we can solve it easily - \begin{subequations} - \begin{align} - u_{00} &= a_{00} \\ - u_{0\cdot} &= a_{0\cdot} \\ - \label{eq:LU1} - l_{\cdot0} &= \frac{a_{\cdot0}}{a_{00}} \\ - \label{eq:LU2} - LU &= A - \frac{a_{\cdot0} \otimes a_{0\cdot}}{a_{00}} - \end{align} - \end{subequations} - and~(\ref{eq:LU1}) and~(\ref{eq:LU2}) define a simple iterative - algorithm if we work from the outside in. It just remains to add - pivoting. *) - -let swap a i j = - let a_i = a.(i) in - a.(i) <- a.(j); - a.(j) <- a_i - -let pivot_column v a n = - let n' = ref n - and max_va = ref (v.(n) *. (abs_float a.(n).(n))) in - for i = succ n to Array.length v - 1 do - let va_i = v.(i) *. (abs_float a.(i).(n)) in - if va_i > !max_va then begin - n' := i; - max_va := va_i - end - done; - !n' - -let lu_decompose_in_place a = - let n = Array.length a in - let eps = ref 1 - and pivots = Array.make n 0 - and v = - try - Array.init n (fun i -> - let a_i = a.(i) in - if Array.length a_i <> n then - raise Not_Square; - 1.0 /. (maxabsval a_i)) - with - | Division_by_zero -> raise Singular in - for i = 0 to pred n do - let pivot = pivot_column v a i in - if pivot <> i then begin - swap a pivot i; - eps := - !eps; - v.(pivot) <- v.(i) - end; - pivots.(i) <- pivot; - let inv_a_ii = - try 1.0 /. a.(i).(i) with Division_by_zero -> raise Singular in - for j = succ i to pred n do - a.(j).(i) <- inv_a_ii *. a.(j).(i) - done; - for j = succ i to pred n do - for k = succ i to pred n do - a.(j).(k) <- a.(j).(k) -. a.(j).(i) *. a.(i).(k) - done - done - done; - (pivots, !eps) - -let lu_decompose_split a pivots = - let n = Array.length pivots in - let l = Array.make_matrix n n 0.0 in - let u = Array.make_matrix n n 0.0 in - for i = 0 to pred n do - l.(i).(i) <- 1.0; - for j = succ i to pred n do - l.(j).(i) <- a.(j).(i) - done - done; - for i = pred n downto 0 do - swap l i pivots.(i) - done; - for i = 0 to pred n do - for j = 0 to i do - u.(j).(i) <- a.(j).(i) - done - done; - (l, u) - -let lu_decompose a = - let a = copy_matrix a in - let pivots, _ = lu_decompose_in_place a in - lu_decompose_split a pivots - -let lu_backsubstitute a pivots b = - let n = Array.length a in - let nonzero = ref (-1) in - let b = Array.copy b in - for i = 0 to pred n do - let ll = pivots.(i) in - let b_i = ref (b.(ll)) in - b.(ll) <- b.(i); - if !nonzero >= 0 then - for j = !nonzero to pred i do - b_i := !b_i -. a.(i).(j) *. b.(j) - done - else if !b_i <> 0.0 then - nonzero := i; - b.(i) <- !b_i - done; - for i = pred n downto 0 do - let b_i = ref (b.(i)) in - for j = succ i to pred n do - b_i := !b_i -. a.(i).(j) *. b.(j) - done; - b.(i) <- !b_i /. a.(i).(i) - done; - b - -let solve_destructive a b = - let pivot, _ = lu_decompose_in_place a in - lu_backsubstitute a pivot b - -let solve_many_destructive a bs = - let pivot, _ = lu_decompose_in_place a in - List.map (lu_backsubstitute a pivot) bs - -let solve a b = - solve_destructive (copy_matrix a) b - -let solve_many a bs = - solve_many_destructive (copy_matrix a) bs - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/models4.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/models4.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/models4.ml (revision 8703) @@ -1,5007 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -let rcs_file = RCS.parse "Models4" ["BSM Models"] - { RCS.revision = "$Revision$"; - RCS.date = "$Date$"; - RCS.author = "$Author$"; - RCS.source - = "$URL$" } - -(* \thocwmodulesection{Littlest Higgs Model} *) - -module type BSM_flags = - sig - val u1_gauged : bool - val anom_ferm_ass : bool - end - -module BSM_bsm : BSM_flags = - struct - let u1_gauged = true - let anom_ferm_ass = false - end - -module BSM_ungauged : BSM_flags = - struct - let u1_gauged = false - let anom_ferm_ass = false - end - -module BSM_anom : BSM_flags = - struct - let u1_gauged = false - let anom_ferm_ass = true - end - -module Littlest (Flags : BSM_flags) = - struct - let rcs = rcs_file - - open Coupling - - let default_width = ref Timelike - let use_fudged_width = ref false - - let options = Options.create - [ "constant_width", Arg.Unit (fun () -> default_width := Constant), - "use constant width (also in t-channel)"; - "fudged_width", Arg.Set use_fudged_width, - "use fudge factor for charge particle width"; - "custom_width", Arg.String (fun f -> default_width := Custom f), - "use custom width"; - "cancel_widths", Arg.Unit (fun () -> default_width := Vanishing), - "use vanishing width" ] - - let gauge_symbol () = - failwith "Models.SM3.gauge_symbol: internal error" - - type matter_field = L of int | N of int | U of int | D of int - | TopH | TopHb - type gauge_boson = Ga | Wp | Wm | Z | Gl | WHp | WHm - | ZH | AH - type other = Phip | Phim | Phi0 | H | Eta | Psi0 - | Psi1 | Psip | Psim | Psipp | Psimm - - type flavor = M of matter_field | G of gauge_boson | O of other - type flavor_sans_color = flavor - let flavor_sans_color f = f - - let matter_field f = M f - let gauge_boson f = G f - let other f = O f - - type field = - | Matter of matter_field - | Gauge of gauge_boson - | Other of other - - let field = function - | M f -> Matter f - | G f -> Gauge f - | O f -> Other f - - type gauge = unit - - let gauge_symbol () = - failwith "Models4.Littlest.gauge_symbol: internal error" - - let family n = List.map matter_field [ L n; N n; U n; D n ] - -(* Since [Phi] already belongs to the EW Goldstone bosons we use [Psi] - for the TeV scale complex triplet. *) - - let external_flavors () = - [ "1st Generation", ThoList.flatmap family [1; -1]; - "2nd Generation", ThoList.flatmap family [2; -2]; - "3rd Generation", ThoList.flatmap family [3; -3]; - "Heavy Quarks", List.map matter_field [TopH; TopHb]; - "Heavy Scalars", List.map other - [Psi0; Psi1; Psip; Psim; Psipp; Psimm]; - "Gauge Bosons", List.map gauge_boson - (if Flags.u1_gauged then - [Ga; Z; Wp; Wm; Gl; WHp; WHm; ZH; AH] - else - [Ga; Z; Wp; Wm; Gl; WHp; WHm; ZH]); - "Higgs", List.map other - (if Flags.u1_gauged then [H] - else [H; Eta]); - "Goldstone Bosons", List.map other [Phip; Phim; Phi0] ] - - let flavors () = ThoList.flatmap snd (external_flavors ()) - - let spinor n = - if n >= 0 then - Spinor - else - ConjSpinor - - let lorentz = function - | M f -> - begin match f with - | L n -> spinor n | N n -> spinor n - | U n -> spinor n | D n -> spinor n - | TopH -> Spinor | TopHb -> ConjSpinor - end - | G f -> - begin match f with - | Ga | Gl -> Vector - | Wp | Wm | Z | WHp | WHm | ZH | AH -> Massive_Vector - end - | O f -> - begin match f with - | Phip | Phim | Phi0 | H | Eta | Psi0 - | Psi1 | Psip | Psim | Psipp | Psimm -> Scalar - end - - let color = function - | M (U n) -> Color.SUN (if n > 0 then 3 else -3) - | M (D n) -> Color.SUN (if n > 0 then 3 else -3) - | M TopH -> Color.SUN 3 | M TopHb -> Color.SUN (-3) - | G Gl -> Color.AdjSUN 3 - | _ -> Color.Singlet - - let prop_spinor n = - if n >= 0 then - Prop_Spinor - else - Prop_ConjSpinor - - let propagator = function - | M f -> - begin match f with - | L n -> prop_spinor n | N n -> prop_spinor n - | U n -> prop_spinor n | D n -> prop_spinor n - | TopH -> Prop_Spinor | TopHb -> Prop_ConjSpinor - end - | G f -> - begin match f with - | Ga | Gl -> Prop_Feynman - | Wp | Wm | Z | WHp | WHm | ZH | AH -> Prop_Unitarity - end - | O f -> - begin match f with - | Phip | Phim | Phi0 -> Only_Insertion - | H | Eta | Psi0 | Psi1 | Psip | Psim - | Psipp | Psimm -> Prop_Scalar - end - -(* Optionally, ask for the fudge factor treatment for the widths of - charged particles. Currently, this only applies to $W^\pm$ and top. *) - - let width f = - if !use_fudged_width then - match f with - | G Wp | G Wm | M (U 3) | M (U (-3)) - | G WHp | G WHm | G ZH | G AH - | M TopH | M TopHb -> Fudged - | _ -> !default_width - else - !default_width - - let goldstone = function - | G f -> - begin match f with - | Wp -> Some (O Phip, Coupling.Const 1) - | Wm -> Some (O Phim, Coupling.Const 1) - | Z -> Some (O Phi0, Coupling.Const 1) - | _ -> None - end - | _ -> None - - let conjugate = function - | M f -> - M (begin match f with - | L n -> L (-n) | N n -> N (-n) - | U n -> U (-n) | D n -> D (-n) - | TopH -> TopHb | TopHb -> TopH - end) - | G f -> - G (begin match f with - | Gl -> Gl | Ga -> Ga | Z -> Z - | Wp -> Wm | Wm -> Wp | WHm -> WHp - | WHp -> WHm | ZH -> ZH | AH -> AH - end) - | O f -> - O (begin match f with - | Psi0 -> Psi0 | Psi1 -> Psi1 | Psip -> Psim - | Psim -> Psip | Psipp -> Psimm | Psimm -> Psipp - | Phip -> Phim | Phim -> Phip | Phi0 -> Phi0 - | H -> H | Eta -> Eta - end) - - let conjugate_sans_color = conjugate - - let fermion = function - | M f -> - begin match f with - | L n -> if n > 0 then 1 else -1 - | N n -> if n > 0 then 1 else -1 - | U n -> if n > 0 then 1 else -1 - | D n -> if n > 0 then 1 else -1 - | TopH -> 1 | TopHb -> -1 - end - | G f -> - begin match f with - | Gl | Ga | Z | Wp | Wm | WHp - | WHm | AH | ZH -> 0 - end - | O f -> - begin match f with - | Psi0 | Psi1 | Psip | Psim | Psipp | Psimm - | Phip | Phim | Phi0 | H | Eta -> 0 - end - - type constant = - | Unit | Pi | Alpha_QED | Sin2thw - | Sinthw | Costhw | E | G_weak | Vev | VHeavy - | Supp | Supp2 - | Sinpsi | Cospsi | Atpsi | Sccs (* Mixing angles of SU(2) *) - | Q_lepton | Q_up | Q_down | Q_Z_up | G_CC | G_CCtop - | G_NC_neutrino | G_NC_lepton | G_NC_up | G_NC_down | G_NC_heavy - | G_NC_h_neutrino | G_NC_h_lepton | G_NC_h_up | G_NC_h_down - | G_CC_heavy | G_ZHTHT | G_ZTHT | G_AHTHTH | G_AHTHT | G_AHTT - | G_CC_WH | G_CC_W - | I_Q_W | I_G_ZWW | I_G_WWW - | I_G_AHWW | I_G_ZHWW | I_G_ZWHW | I_G_AHWHWH | I_G_ZHWHWH - | I_G_AHWHW | I_Q_H - | G_WWWW | G_ZZWW | G_AZWW | G_AAWW - | G_WH4 | G_WHWHWW | G_WHWWW | G_WH3W - | G_WWAAH | G_WWAZH | G_WWZZH | G_WWZAH | G_WHWHAAH - | G_WHWHAZH | G_WHWHZZH | G_WHWHZAH | G_WWZHAH - | G_WHWHZHAH | G_WHWZZ | G_WHWAZ | G_WHWAAH | G_WHWZAH - | G_WHWZHZH | G_WHWZHAH | G_WHWAZH | G_WHWZZH - | G_HWW | G_HHWW | G_HZZ | G_HHZZ - | G_PsiWW | G_PsiWHW | G_PsiZZ | G_PsiZHZH - | G_PsiZHZ | G_PsiZAH | G_PsiZHAH | G_PsiAHAH - | G_PsiZW | G_PsiZWH | G_PsiAHW | G_PsiAHWH - | G_PsiZHW | G_PsiZHWH - | G_PsippWW | G_PsippWHW | G_PsippWHWH - | G_PsiHW | G_PsiHWH | G_Psi0W | G_Psi0WH - | G_Psi1W | G_Psi1WH | G_PsiPPW | G_PsiPPWH - | G_Psi1HAH | G_Psi01AH | G_AHPsip | G_Psi1HZ - | G_Psi1HZH | G_Psi01Z | G_Psi01ZH | G_ZPsip | G_ZPsipp | G_ZHPsipp - | G_HHAA | G_HHWHW | G_HHZHZ | G_HHAHZ | G_HHZHAH - | G_HPsi0WW | G_HPsi0WHW | G_HPsi0ZZ - | G_HPsi0ZHZH | G_HPsi0ZHZ | G_HPsi0AHAH | G_HPsi0ZAH | G_HPsi0ZHAH - | G_HPsipWA | G_HPsipWHA | G_HPsipWZ | G_HPsipWHZ | G_HPsipWAH - | G_HPsipWHAH | G_HPsipWZH | G_HPsipWHZH | G_HPsippWW | G_HPsippWHWH - | G_HPsippWHW | G_Psi00ZH | G_Psi00AH | G_Psi00ZHAH - | G_Psi0pWA | G_Psi0pWHA | G_Psi0pWZ | G_Psi0pWHZ | G_Psi0pWAH - | G_Psi0pWHAH | G_Psi0pWZH | G_Psi0pWHZH | G_Psi0ppWW | G_Psi0ppWHWH - | G_Psi0ppWHW | I_G_Psi0pWA | I_G_Psi0pWHA | I_G_Psi0pWZ | I_G_Psi0pWHZ - | I_G_Psi0pWAH | I_G_Psi0pWHAH | I_G_Psi0pWZH | I_G_Psi0pWHZH - | I_G_Psi0ppWW | I_G_Psi0ppWHWH | I_G_Psi0ppWHW - | G_PsippZZ | G_PsippZHZH | G_PsippAZ | G_PsippAAH | G_PsippZAH - | G_PsippWA | G_PsippWHA | G_PsippWZ | G_PsippWHZ | G_PsippWAH - | G_PsippWHAH | G_PsippWZH | G_PsippWHZH - | G_PsiccZZ | G_PsiccAZ | G_PsiccAAH | G_PsiccZZH | G_PsiccAZH - | G_PsiccZAH - | G_Htt | G_Hbb | G_Hcc | G_Htautau | G_H3 | G_H4 - | G_Hthth | G_Htht | G_Ethth | G_Etht | G_Ett - | G_HHtt | G_HHthth | G_HHtht - | G_Psi0tt | G_Psi0bb | G_Psi0cc | G_Psi0tautau - | G_Psi1tt | G_Psi1bb | G_Psi1cc | G_Psi1tautau - | G_Psipq3 | G_Psipq2 | G_Psipl3 | G_Psi0tth | G_Psi1tth - | G_Psipbth | G_Ebb - | G_HGaGa | G_HGaZ | G_EGaGa | G_EGaZ | G_EGlGl - | Gs | I_Gs | G2 - | G_HWHW | G_HWHWH | G_HAHAH | G_HZHZ | G_HZHAH | G_HAHZ - | Mass of flavor | Width of flavor - - let input_parameters = - [] - - let derived_parameters = - [] - - let derived_parameter_arrays = - [] - - let parameters () = - { input = input_parameters; - derived = derived_parameters; - derived_arrays = derived_parameter_arrays } - - module F = Models.Fusions (struct - type f = flavor - type c = constant - let compare = compare - let conjugate = conjugate - end) - - let mgm ((m1, g, m2), fbf, c) = ((M m1, G g, M m2), fbf, c) - let mhm ((m1, h, m2), fbf, c) = ((M m1, O h, M m2), fbf, c) - let tgc ((g1, g2, g3), t, c) = ((G g1, G g2, G g3), t, c) - let qgc ((g1, g2, g3, g4), t, c) = ((G g1, G g2, G g3, G g4), t, c) - let hgg ((h, g1, g2), coup, c) = ((O h, G g1, G g2), coup, c) - let ghh ((g, h1, h2), coup, c) = ((G g, O h1, O h2), coup, c) - let hhgg ((h1, h2, g1, g2), coup, c) = ((O h1, O h2, G g1, G g2), coup, c) - - let electromagnetic_currents n = - List.map mgm - [ ((L (-n), Ga, L n), FBF (1, Psibar, V, Psi), Q_lepton); - ((U (-n), Ga, U n), FBF (1, Psibar, V, Psi), Q_up); - ((D (-n), Ga, D n), FBF (1, Psibar, V, Psi), Q_down) ] - - let neutral_currents n = - List.map mgm - [ ((L (-n), Z, L n), FBF (1, Psibar, VA, Psi), G_NC_lepton); - ((N (-n), Z, N n), FBF (1, Psibar, VA, Psi), G_NC_neutrino); - ((U (-n), Z, U n), FBF (1, Psibar, VA, Psi), G_NC_up); - ((D (-n), Z, D n), FBF (1, Psibar, VA, Psi), G_NC_down) ] - -(* The sign of this coupling is just the one of the T3, being -(1/2) for - leptons and down quarks, and +(1/2) for neutrinos and up quarks. *) - - let neutral_heavy_currents n = - List.map mgm - ([ ((L (-n), ZH, L n), FBF ((-1), Psibar, VL, Psi), G_NC_heavy); - ((N (-n), ZH, N n), FBF (1, Psibar, VL, Psi), G_NC_heavy); - ((U (-n), ZH, U n), FBF (1, Psibar, VL, Psi), G_NC_heavy); - ((D (-n), ZH, D n), FBF ((-1), Psibar, VL, Psi), G_NC_heavy)] - @ - (if Flags.u1_gauged then - [ ((L (-n), AH, L n), FBF (1, Psibar, VA, Psi), G_NC_h_lepton); - ((N (-n), AH, N n), FBF (1, Psibar, VA, Psi), G_NC_h_neutrino); - ((D (-n), AH, D n), FBF (1, Psibar, VA, Psi), G_NC_h_down)] - else - [])) - - let color_currents n = - List.map mgm - [ ((D (-n), Gl, D n), FBF ((-1), Psibar, V, Psi), Gs); - ((U (-n), Gl, U n), FBF ((-1), Psibar, V, Psi), Gs)] - - let heavy_top_currents = - List.map mgm - ([ ((TopHb, Ga, TopH), FBF (1, Psibar, V, Psi), Q_up); - ((TopHb, Z, TopH), FBF (1, Psibar, V, Psi), Q_Z_up); - ((TopHb, Z, U 3), FBF (1, Psibar, VL, Psi), G_ZTHT); - ((U (-3), Z, TopH), FBF (1, Psibar, VL, Psi), G_ZTHT); - ((TopHb, ZH, U 3), FBF (1, Psibar, VL, Psi), G_ZHTHT); - ((U (-3), ZH, TopH), FBF (1, Psibar, VL, Psi), G_ZHTHT); - ((U (-3), Wp, D 3), FBF (1, Psibar, VL, Psi), G_CCtop); - ((D (-3), Wm, U 3), FBF (1, Psibar, VL, Psi), G_CCtop); - ((TopHb, WHp, D 3), FBF (1, Psibar, VL, Psi), G_CC_WH); - ((D (-3), WHm, TopH), FBF (1, Psibar, VL, Psi), G_CC_WH); - ((TopHb, Wp, D 3), FBF (1, Psibar, VL, Psi), G_CC_W); - ((D (-3), Wm, TopH), FBF (1, Psibar, VL, Psi), G_CC_W)] - @ - (if Flags.u1_gauged then - [ ((U (-3), AH, U 3), FBF (1, Psibar, VA, Psi), G_AHTT); - ((TopHb, AH, TopH), FBF (1, Psibar, VA, Psi), G_AHTHTH); - ((TopHb, AH, U 3), FBF (1, Psibar, VR, Psi), G_AHTHT); - ((U (-3), AH, TopH), FBF (1, Psibar, VR, Psi), G_AHTHT)] - else - [])) - - -(* \begin{equation} - \mathcal{L}_{\textrm{CC}} = - - \frac{g}{2\sqrt2} \sum_i \bar\psi_i - (T^+\fmslash{W}^+ + T^-\fmslash{W}^-)(1-\gamma_5)\psi_i - \end{equation} *) - - let charged_currents n = - List.map mgm - [ ((L (-n), Wm, N n), FBF (1, Psibar, VL, Psi), G_CC); - ((N (-n), Wp, L n), FBF (1, Psibar, VL, Psi), G_CC); - ((D (-n), Wm, U n), FBF (1, Psibar, VL, Psi), G_CC); - ((U (-n), Wp, D n), FBF (1, Psibar, VL, Psi), G_CC) ] - - let charged_heavy_currents n = - List.map mgm - ([ ((L (-n), WHm, N n), FBF (1, Psibar, VL, Psi), G_CC_heavy); - ((N (-n), WHp, L n), FBF (1, Psibar, VL, Psi), G_CC_heavy); - ((D (-n), WHm, U n), FBF (1, Psibar, VL, Psi), G_CC_heavy); - ((U (-n), WHp, D n), FBF (1, Psibar, VL, Psi), G_CC_heavy)] - @ - (if Flags.u1_gauged then - [ ((U (-n), AH, U n), FBF (1, Psibar, VA, Psi), G_NC_h_up)] - else - [])) - - -(* We specialize the third generation since there is an additional shift - coming from the admixture of the heavy top quark. The universal shift, - coming from the mixing in the non-Abelian gauge boson sector is - unobservable. (Redefinition of coupling constants by measured ones. *) - - let yukawa = - List.map mhm - [ ((U (-3), H, U 3), FBF (1, Psibar, S, Psi), G_Htt); - ((D (-3), H, D 3), FBF (1, Psibar, S, Psi), G_Hbb); - ((U (-2), H, U 2), FBF (1, Psibar, S, Psi), G_Hcc); - ((L (-3), H, L 3), FBF (1, Psibar, S, Psi), G_Htautau)] - - let yukawa_add' = - List.map mhm - [ ((TopHb, H, TopH), FBF (1, Psibar, S, Psi), G_Hthth); - ((TopHb, H, U 3), FBF (1, Psibar, SLR, Psi), G_Htht); - ((U (-3), H, TopH), FBF (1, Psibar, SLR, Psi), G_Htht); - ((U (-3), Psi0, U 3), FBF (1, Psibar, S, Psi), G_Psi0tt); - ((D (-3), Psi0, D 3), FBF (1, Psibar, S, Psi), G_Psi0bb); - ((U (-2), Psi0, U 2), FBF (1, Psibar, S, Psi), G_Psi0cc); - ((L (-3), Psi0, L 3), FBF (1, Psibar, S, Psi), G_Psi0tautau); - ((U (-3), Psi1, U 3), FBF (1, Psibar, P, Psi), G_Psi1tt); - ((D (-3), Psi1, D 3), FBF (1, Psibar, P, Psi), G_Psi1bb); - ((U (-2), Psi1, U 2), FBF (1, Psibar, P, Psi), G_Psi1cc); - ((L (-3), Psi1, L 3), FBF (1, Psibar, P, Psi), G_Psi1tautau); - ((U (-3), Psip, D 3), FBF (1, Psibar, SLR, Psi), G_Psipq3); - ((U (-2), Psip, D 2), FBF (1, Psibar, SLR, Psi), G_Psipq2); - ((N (-3), Psip, L 3), FBF (1, Psibar, SR, Psi), G_Psipl3); - ((D (-3), Psim, U 3), FBF (1, Psibar, SLR, Psi), G_Psipq3); - ((D (-2), Psim, U 2), FBF (1, Psibar, SLR, Psi), G_Psipq2); - ((L (-3), Psim, N 3), FBF (1, Psibar, SL, Psi), G_Psipl3); - ((TopHb, Psi0, U 3), FBF (1, Psibar, SL, Psi), G_Psi0tth); - ((U (-3), Psi0, TopH), FBF (1, Psibar, SR, Psi), G_Psi0tth); - ((TopHb, Psi1, U 3), FBF (1, Psibar, SL, Psi), G_Psi1tth); - ((U (-3), Psi1, TopH), FBF (1, Psibar, SR, Psi), G_Psi1tth); - ((TopHb, Psip, D 3), FBF (1, Psibar, SL, Psi), G_Psipbth); - ((D (-3), Psim, TopH), FBF (1, Psibar, SR, Psi), G_Psipbth)] - - let yukawa_add = - if Flags.u1_gauged then - yukawa_add' - else - yukawa_add' @ - List.map mhm - [ ((U (-3), Eta, U 3), FBF (1, Psibar, P, Psi), G_Ett); - ((TopHb, Eta, U 3), FBF (1, Psibar, SLR, Psi), G_Etht); - ((D (-3), Eta, D 3), FBF (1, Psibar, P, Psi), G_Ebb); - ((U (-3), Eta, TopH), FBF (1, Psibar, SLR, Psi), G_Etht)] - -(* \begin{equation} - \mathcal{L}_{\textrm{TGC}} = - - e \partial_\mu A_\nu W_+^\mu W_-^\nu + \ldots - - e \cot\theta_w \partial_\mu Z_\nu W_+^\mu W_-^\nu + \ldots - \end{equation} *) - - let standard_triple_gauge = - List.map tgc - [ ((Ga, Wm, Wp), Gauge_Gauge_Gauge 1, I_Q_W); - ((Z, Wm, Wp), Gauge_Gauge_Gauge 1, I_G_ZWW); - ((Gl, Gl, Gl), Gauge_Gauge_Gauge 1, I_Gs) ] - - let heavy_triple_gauge = - List.map tgc - ([ ((Ga, WHm, WHp), Gauge_Gauge_Gauge 1, I_Q_W); - ((Z, WHm, WHp), Gauge_Gauge_Gauge 1, I_G_ZWW); - ((ZH, Wm, Wp), Gauge_Gauge_Gauge 1, I_G_ZHWW); - ((Z, WHm, Wp), Gauge_Gauge_Gauge 1, I_G_ZWHW); - ((Z, Wm, WHp), Gauge_Gauge_Gauge (-1), I_G_ZWHW); - ((ZH, WHm, Wp), Gauge_Gauge_Gauge 1, I_G_WWW); - ((ZH, Wm, WHp), Gauge_Gauge_Gauge (-1), I_G_WWW); - ((ZH, WHm, WHp), Gauge_Gauge_Gauge (-1), I_G_ZHWHWH)] - @ - (if Flags.u1_gauged then - [ ((AH, Wm, Wp), Gauge_Gauge_Gauge 1, I_G_AHWW); - ((AH, WHm, Wp), Gauge_Gauge_Gauge 1, I_G_AHWHW); - ((AH, Wm, WHp), Gauge_Gauge_Gauge (-1), I_G_AHWHW); - ((AH, WHm, WHp), Gauge_Gauge_Gauge 1, I_G_AHWHWH)] - else - [])) - - let triple_gauge = - standard_triple_gauge @ heavy_triple_gauge - - let gauge4 = Vector4 [(2, C_13_42); (-1, C_12_34); (-1, C_14_23)] - let minus_gauge4 = Vector4 [(-2, C_13_42); (1, C_12_34); (1, C_14_23)] - let standard_quartic_gauge = - List.map qgc - [ (Wm, Wp, Wm, Wp), gauge4, G_WWWW; - (Wm, Z, Wp, Z), minus_gauge4, G_ZZWW; - (Wm, Z, Wp, Ga), minus_gauge4, G_AZWW; - (Wm, Ga, Wp, Ga), minus_gauge4, G_AAWW; - (Gl, Gl, Gl, Gl), gauge4, G2 ] - - let heavy_quartic_gauge = - List.map qgc - ([ (WHm, Wp, WHm, Wp), gauge4, G_WWWW; - (Wm, WHp, Wm, WHp), gauge4, G_WWWW; - (WHm, WHp, WHm, WHp), gauge4, G_WH4; - (Wm, Wp, WHm, WHp), gauge4, G_WHWHWW; - (Wm, Wp, Wm, WHp), gauge4, G_WHWWW; - (Wm, Wp, WHm, Wp), gauge4, G_WHWWW; - (WHm, WHp, Wm, WHp), gauge4, G_WH3W; - (WHm, WHp, WHm, Wp), gauge4, G_WH3W; - (WHm, Z, WHp, Z), minus_gauge4, G_ZZWW; - (WHm, Z, WHp, Ga), minus_gauge4, G_AZWW; - (WHm, Ga, WHp, ZH), minus_gauge4, G_AAWW; - (WHm, Z, WHp, ZH), minus_gauge4, G_ZZWW; - (Wm, ZH, Wp, ZH), minus_gauge4, G_WWWW; - (Wm, Ga, Wp, ZH), minus_gauge4, G_WWAZH; - (Wm, Z, Wp, ZH), minus_gauge4, G_WWZZH; - (WHm, Ga, WHp, ZH), minus_gauge4, G_WHWHAZH; - (WHm, Z, WHp, ZH), minus_gauge4, G_WHWHZZH; - (WHm, ZH, WHm, ZH), minus_gauge4, G_WH4; - (WHm, Z, Wp, Z), minus_gauge4, G_WHWZZ; - (Wm, Z, WHp, Z), minus_gauge4, G_WHWZZ; - (WHm, Ga, Wp, Z), minus_gauge4, G_WHWAZ; - (Wm, Ga, WHp, Z), minus_gauge4, G_WHWAZ; - (WHm, ZH, Wp, ZH), minus_gauge4, G_WHWZHZH; - (Wm, ZH, WHp, ZH), minus_gauge4, G_WHWZHZH; - (WHm, Ga, Wp, ZH), minus_gauge4, G_WHWAZH; - (Wm, Ga, WHp, ZH), minus_gauge4, G_WHWAZH; - (WHm, Z, Wp, ZH), minus_gauge4, G_WHWZZH; - (Wm, Z, WHp, ZH), minus_gauge4, G_WHWZZH] - @ - (if Flags.u1_gauged then - [ (Wm, Ga, Wp, AH), minus_gauge4, G_WWAAH; - (Wm, Z, Wp, AH), minus_gauge4, G_WWZAH; - (WHm, Ga, WHp, AH), minus_gauge4, G_WHWHAAH; - (WHm, Z, WHp, AH), minus_gauge4, G_WHWHZAH; - (Wm, ZH, Wp, AH), minus_gauge4, G_WWZHAH; - (WHm, ZH, WHp, AH), minus_gauge4, G_WHWHZHAH; - (WHm, Ga, Wp, AH), minus_gauge4, G_WHWAAH; - (Wm, Ga, WHp, AH), minus_gauge4, G_WHWAAH; - (WHm, Z, Wp, AH), minus_gauge4, G_WHWZAH; - (Wm, Z, WHp, AH), minus_gauge4, G_WHWZAH; - (WHm, ZH, Wp, AH), minus_gauge4, G_WHWZHAH; - (Wm, ZH, WHp, AH), minus_gauge4, G_WHWZHAH] - else - [])) - - let quartic_gauge = - standard_quartic_gauge @ heavy_quartic_gauge - - let standard_gauge_higgs' = - List.map hgg - [ ((H, Wp, Wm), Scalar_Vector_Vector 1, G_HWW); - ((H, Z, Z), Scalar_Vector_Vector 1, G_HZZ) ] - - let heavy_gauge_higgs = - List.map hgg - ([ ((H, Wp, WHm), Scalar_Vector_Vector 1, G_HWHW); - ((H, WHp, Wm), Scalar_Vector_Vector 1, G_HWHW); - ((H, WHp, WHm), Scalar_Vector_Vector 1, G_HWHWH); - ((H, ZH, ZH), Scalar_Vector_Vector 1, G_HWHWH); - ((H, ZH, Z), Scalar_Vector_Vector 1, G_HZHZ); - ((H, Wp, Wm), Scalar_Vector_Vector 1, G_HZHAH)] - @ - (if Flags.u1_gauged then - [((H, AH, AH), Scalar_Vector_Vector 1, G_HAHAH); - ((H, Z, AH), Scalar_Vector_Vector 1, G_HAHZ)] - else - [])) - - let triplet_gauge_higgs = - List.map hgg - ([ ((Psi0, Wp, Wm), Scalar_Vector_Vector 1, G_PsiWW); - ((Psi0, WHp, WHm), Scalar_Vector_Vector (-1), G_PsiWW); - ((Psi0, WHp, Wm), Scalar_Vector_Vector 1, G_PsiWHW); - ((Psi0, WHm, Wp), Scalar_Vector_Vector 1, G_PsiWHW); - ((Psi0, Z, Z), Scalar_Vector_Vector 1, G_PsiZZ); - ((Psi0, ZH, ZH), Scalar_Vector_Vector 1, G_PsiZHZH); - ((Psi0, ZH, Z), Scalar_Vector_Vector 1, G_PsiZHZ); - ((Psim, Wp, Z), Scalar_Vector_Vector 1, G_PsiZW); - ((Psip, Wm, Z), Scalar_Vector_Vector 1, G_PsiZW); - ((Psim, WHp, Z), Scalar_Vector_Vector 1, G_PsiZWH); - ((Psip, WHm, Z), Scalar_Vector_Vector 1, G_PsiZWH); - ((Psim, Wp, ZH), Scalar_Vector_Vector 1, G_PsiZHW); - ((Psip, Wm, ZH), Scalar_Vector_Vector 1, G_PsiZHW); - ((Psim, WHp, ZH), Scalar_Vector_Vector 1, G_PsiZHWH); - ((Psip, WHm, ZH), Scalar_Vector_Vector 1, G_PsiZHWH); - ((Psimm, Wp, Wp), Scalar_Vector_Vector 1, G_PsippWW); - ((Psipp, Wm, Wm), Scalar_Vector_Vector 1, G_PsippWW); - ((Psimm, WHp, Wp), Scalar_Vector_Vector 1, G_PsippWHW); - ((Psipp, WHm, Wm), Scalar_Vector_Vector 1, G_PsippWHW); - ((Psimm, WHp, WHp), Scalar_Vector_Vector 1, G_PsippWHWH); - ((Psipp, WHm, WHm), Scalar_Vector_Vector 1, G_PsippWHWH)] - @ - (if Flags.u1_gauged then - [((Psi0, AH, Z), Scalar_Vector_Vector 1, G_PsiZAH); - ((Psi0, AH, ZH), Scalar_Vector_Vector 1, G_PsiZHAH); - ((Psi0, AH, AH), Scalar_Vector_Vector 1, G_PsiAHAH); - ((Psim, Wp, AH), Scalar_Vector_Vector 1, G_PsiAHW); - ((Psip, Wm, AH), Scalar_Vector_Vector 1, G_PsiAHW); - ((Psim, WHp, AH), Scalar_Vector_Vector 1, G_PsiAHWH); - ((Psip, WHm, AH), Scalar_Vector_Vector 1, G_PsiAHWH)] - else - [])) - - let triplet_gauge2_higgs = - List.map ghh - ([ ((Wp, H, Psim), Vector_Scalar_Scalar 1, G_PsiHW); - ((Wm, H, Psip), Vector_Scalar_Scalar 1, G_PsiHW); - ((WHp, H, Psim), Vector_Scalar_Scalar 1, G_PsiHWH); - ((WHm, H, Psip), Vector_Scalar_Scalar 1, G_PsiHWH); - ((Wp, Psi0, Psim), Vector_Scalar_Scalar 1, G_Psi0W); - ((Wm, Psi0, Psip), Vector_Scalar_Scalar 1, G_Psi0W); - ((WHp, Psi0, Psim), Vector_Scalar_Scalar 1, G_Psi0WH); - ((WHm, Psi0, Psip), Vector_Scalar_Scalar 1, G_Psi0WH); - ((Wp, Psi1, Psim), Vector_Scalar_Scalar 1, G_Psi1W); - ((Wm, Psi1, Psip), Vector_Scalar_Scalar (-1), G_Psi1W); - ((WHp, Psi1, Psim), Vector_Scalar_Scalar 1, G_Psi1WH); - ((WHm, Psi1, Psip), Vector_Scalar_Scalar (-1), G_Psi1WH); - ((Wp, Psip, Psimm), Vector_Scalar_Scalar 1, G_PsiPPW); - ((Wm, Psim, Psipp), Vector_Scalar_Scalar 1, G_PsiPPW); - ((WHp, Psip, Psimm), Vector_Scalar_Scalar 1, G_PsiPPWH); - ((WHm, Psim, Psipp), Vector_Scalar_Scalar 1, G_PsiPPWH); - ((Ga, Psip, Psim), Vector_Scalar_Scalar 1, Q_lepton); - ((Ga, Psipp, Psimm), Vector_Scalar_Scalar 2, Q_lepton); - ((Z, H, Psi1), Vector_Scalar_Scalar 1, G_Psi1HZ); - ((ZH, H, Psi1), Vector_Scalar_Scalar 1, G_Psi1HZH); - ((Z, Psi0, Psi1), Vector_Scalar_Scalar 1, G_Psi01Z); - ((ZH, Psi0, Psi1), Vector_Scalar_Scalar 1, G_Psi01ZH); - ((Z, Psip, Psim), Vector_Scalar_Scalar 1, G_ZPsip); - ((Z, Psipp, Psimm), Vector_Scalar_Scalar 2, G_ZPsipp); - ((ZH, Psipp, Psimm), Vector_Scalar_Scalar 2, G_ZHPsipp)] - @ - (if Flags.u1_gauged then - [((AH, H, Psi1), Vector_Scalar_Scalar 1, G_Psi1HAH); - ((AH, Psi0, Psi1), Vector_Scalar_Scalar 1, G_Psi01AH); - ((AH, Psip, Psim), Vector_Scalar_Scalar 1, G_AHPsip); - ((AH, Psipp, Psimm), Vector_Scalar_Scalar 2, G_AHPsip)] - else [])) - - let standard_gauge_higgs = - standard_gauge_higgs' @ heavy_gauge_higgs @ triplet_gauge_higgs @ - triplet_gauge2_higgs - - let standard_gauge_higgs4 = - List.map hhgg - [ (H, H, Wp, Wm), Scalar2_Vector2 1, G_HHWW; - (H, H, Z, Z), Scalar2_Vector2 1, G_HHZZ ] - - let littlest_gauge_higgs4 = - List.map hhgg - ([ (H, H, WHp, WHm), Scalar2_Vector2 (-1), G_HHWW; - (H, H, ZH, ZH), Scalar2_Vector2 (-1), G_HHWW; - (H, H, Wp, WHm), Scalar2_Vector2 1, G_HHWHW; - (H, H, WHp, Wm), Scalar2_Vector2 1, G_HHWHW; - (H, H, ZH, Z), Scalar2_Vector2 (-1), G_HHZHZ; - (H, Psi0, Wp, Wm), Scalar2_Vector2 1, G_HPsi0WW; - (H, Psi0, WHp, WHm), Scalar2_Vector2 (-1), G_HPsi0WW; - (H, Psi0, WHp, Wm), Scalar2_Vector2 1, G_HPsi0WHW; - (H, Psi0, Wp, WHm), Scalar2_Vector2 1, G_HPsi0WHW; - (H, Psi0, Z, Z), Scalar2_Vector2 1, G_HPsi0ZZ; - (H, Psi0, ZH, ZH), Scalar2_Vector2 1, G_HPsi0ZHZH; - (H, Psi0, ZH, Z), Scalar2_Vector2 1, G_HPsi0ZHZ; - (H, Psim, Wp, Ga), Scalar2_Vector2 1, G_HPsipWA; - (H, Psip, Wm, Ga), Scalar2_Vector2 1, G_HPsipWA; - (H, Psim, WHp, Ga), Scalar2_Vector2 1, G_HPsipWHA; - (H, Psip, WHm, Ga), Scalar2_Vector2 1, G_HPsipWHA; - (H, Psim, Wp, Z), Scalar2_Vector2 1, G_HPsipWZ; - (H, Psip, Wm, Z), Scalar2_Vector2 1, G_HPsipWZ; - (H, Psim, WHp, Z), Scalar2_Vector2 1, G_HPsipWHZ; - (H, Psip, WHm, Z), Scalar2_Vector2 1, G_HPsipWHZ; - (H, Psim, Wp, ZH), Scalar2_Vector2 1, G_HPsipWZH; - (H, Psip, Wm, ZH), Scalar2_Vector2 1, G_HPsipWZH; - (H, Psim, WHp, ZH), Scalar2_Vector2 1, G_HPsipWHZH; - (H, Psip, WHm, ZH), Scalar2_Vector2 1, G_HPsipWHZH; - (H, Psimm, Wp, Wp), Scalar2_Vector2 1, G_HPsippWW; - (H, Psipp, Wm, Wm), Scalar2_Vector2 1, G_HPsippWW; - (H, Psimm, WHp, WHp), Scalar2_Vector2 1, G_HPsippWHWH; - (H, Psipp, WHm, WHm), Scalar2_Vector2 1, G_HPsippWHWH; - (H, Psimm, WHp, Wp), Scalar2_Vector2 1, G_HPsippWHW; - (H, Psipp, WHm, Wm), Scalar2_Vector2 1, G_HPsippWHW; - (Psi0, Psi0, Wp, Wm), Scalar2_Vector2 2, G_HHWW; - (Psi0, Psi0, WHp, WHm), Scalar2_Vector2 (-2), G_HHWW; - (Psi0, Psi0, Z, Z), Scalar2_Vector2 4, G_HHZZ; - (Psi0, Psi0, ZH, ZH), Scalar2_Vector2 1, G_Psi00ZH; - (Psi0, Psi0, WHp, Wm), Scalar2_Vector2 2, G_HHWHW; - (Psi0, Psi0, Wp, WHm), Scalar2_Vector2 2, G_HHWHW; - (Psi0, Psi0, Z, ZH), Scalar2_Vector2 4, G_HHZHZ; - (Psi0, Psim, Wp, Ga), Scalar2_Vector2 1, G_Psi0pWA; - (Psi0, Psip, Wm, Ga), Scalar2_Vector2 1, G_Psi0pWA; - (Psi0, Psim, WHp, Ga), Scalar2_Vector2 1, G_Psi0pWHA; - (Psi0, Psip, WHm, Ga), Scalar2_Vector2 1, G_Psi0pWHA; - (Psi0, Psim, Wp, Z), Scalar2_Vector2 1, G_Psi0pWZ; - (Psi0, Psip, Wm, Z), Scalar2_Vector2 1, G_Psi0pWZ; - (Psi0, Psim, WHp, Z), Scalar2_Vector2 1, G_Psi0pWHZ; - (Psi0, Psip, WHm, Z), Scalar2_Vector2 1, G_Psi0pWHZ; - (Psi0, Psim, Wp, ZH), Scalar2_Vector2 1, G_Psi0pWZH; - (Psi0, Psip, Wm, ZH), Scalar2_Vector2 1, G_Psi0pWZH; - (Psi0, Psim, WHp, ZH), Scalar2_Vector2 1, G_Psi0pWHZH; - (Psi0, Psip, WHm, ZH), Scalar2_Vector2 1, G_Psi0pWHZH; - (Psi0, Psimm, Wp, Wp), Scalar2_Vector2 1, G_Psi0ppWW; - (Psi0, Psipp, Wm, Wm), Scalar2_Vector2 1, G_Psi0ppWW; - (Psi0, Psimm, WHp, WHp), Scalar2_Vector2 1, G_Psi0ppWHWH; - (Psi0, Psipp, WHm, WHm), Scalar2_Vector2 1, G_Psi0ppWHWH; - (Psi0, Psimm, WHp, Wp), Scalar2_Vector2 1, G_Psi0ppWHW; - (Psi0, Psipp, WHm, Wm), Scalar2_Vector2 1, G_Psi0ppWHW; - (Psi1, Psi1, Wp, Wm), Scalar2_Vector2 2, G_HHWW; - (Psi1, Psi1, WHp, WHm), Scalar2_Vector2 (-2), G_HHWW; - (Psi1, Psi1, Z, Z), Scalar2_Vector2 4, G_HHZZ; - (Psi1, Psi1, ZH, ZH), Scalar2_Vector2 1, G_Psi00ZH; - (Psi1, Psi1, WHp, Wm), Scalar2_Vector2 2, G_HHWHW; - (Psi1, Psi1, Wp, WHm), Scalar2_Vector2 2, G_HHWHW; - (Psi1, Psi1, Z, ZH), Scalar2_Vector2 4, G_HHZHZ; - (Psi1, Psim, Wp, Ga), Scalar2_Vector2 1, I_G_Psi0pWA; - (Psi1, Psip, Wm, Ga), Scalar2_Vector2 (-1), I_G_Psi0pWA; - (Psi1, Psim, WHp, Ga), Scalar2_Vector2 1, I_G_Psi0pWHA; - (Psi1, Psip, WHm, Ga), Scalar2_Vector2 (-1), I_G_Psi0pWHA; - (Psi1, Psim, Wp, Z), Scalar2_Vector2 1, I_G_Psi0pWZ; - (Psi1, Psip, Wm, Z), Scalar2_Vector2 (-1), I_G_Psi0pWZ; - (Psi1, Psim, WHp, Z), Scalar2_Vector2 1, I_G_Psi0pWHZ; - (Psi1, Psip, WHm, Z), Scalar2_Vector2 (-1), I_G_Psi0pWHZ; - (Psi1, Psim, Wp, ZH), Scalar2_Vector2 1, I_G_Psi0pWZH; - (Psi1, Psip, Wm, ZH), Scalar2_Vector2 (-1), I_G_Psi0pWZH; - (Psi1, Psim, WHp, ZH), Scalar2_Vector2 1, I_G_Psi0pWHZH; - (Psi1, Psip, WHm, ZH), Scalar2_Vector2 (-1), I_G_Psi0pWHZH; - (Psi1, Psimm, Wp, Wp), Scalar2_Vector2 1, I_G_Psi0ppWW; - (Psi1, Psipp, Wm, Wm), Scalar2_Vector2 (-1), I_G_Psi0ppWW; - (Psi1, Psimm, WHp, WHp), Scalar2_Vector2 1, I_G_Psi0ppWHWH; - (Psi1, Psipp, WHm, WHm), Scalar2_Vector2 (-1), I_G_Psi0ppWHWH; - (Psi1, Psimm, WHp, Wp), Scalar2_Vector2 1, I_G_Psi0ppWHW; - (Psi1, Psipp, WHm, Wm), Scalar2_Vector2 (-1), I_G_Psi0ppWHW; - (Psip, Psim, Wp, Wm), Scalar2_Vector2 4, G_HHWW; - (Psip, Psim, WHp, WHm), Scalar2_Vector2 1, G_Psi00ZH; - (Psip, Psim, WHp, Wm), Scalar2_Vector2 4, G_HHWHW; - (Psip, Psim, Wp, WHm), Scalar2_Vector2 4, G_HHWHW; - (Psip, Psim, Z, Z), Scalar2_Vector2 1, G_PsippZZ; - (Psip, Psim, Ga, Ga), Scalar2_Vector2 2, G_AAWW; - (Psip, Psim, ZH, ZH), Scalar2_Vector2 1, G_PsippZHZH; - (Psip, Psim, Ga, Z), Scalar2_Vector2 4, G_PsippAZ; - (Psip, Psimm, Wp, Ga), Scalar2_Vector2 1, G_PsippWA; - (Psim, Psipp, Wm, Ga), Scalar2_Vector2 1, G_PsippWA; - (Psip, Psimm, WHp, Ga), Scalar2_Vector2 1, G_PsippWHA; - (Psim, Psipp, WHm, Ga), Scalar2_Vector2 1, G_PsippWHA; - (Psip, Psimm, Wp, Z), Scalar2_Vector2 1, G_PsippWZ; - (Psim, Psipp, Wm, Z), Scalar2_Vector2 1, G_PsippWZ; - (Psip, Psimm, WHp, Z), Scalar2_Vector2 1, G_PsippWHZ; - (Psim, Psipp, WHm, Z), Scalar2_Vector2 1, G_PsippWHZ; - (Psip, Psimm, Wp, ZH), Scalar2_Vector2 1, G_PsippWZH; - (Psim, Psipp, Wm, ZH), Scalar2_Vector2 1, G_PsippWZH; - (Psip, Psimm, WHp, ZH), Scalar2_Vector2 1, G_PsippWHZH; - (Psim, Psipp, WHm, ZH), Scalar2_Vector2 1, G_PsippWHZH; - (Psipp, Psimm, Wp, Wm), Scalar2_Vector2 2, G_HHWW; - (Psipp, Psimm, WHp, WHm), Scalar2_Vector2 (-2), G_HHWW; - (Psipp, Psimm, WHp, Wm), Scalar2_Vector2 2, G_HHWHW; - (Psipp, Psimm, Wp, WHm), Scalar2_Vector2 2, G_HHWHW; - (Psipp, Psimm, Z, Z), Scalar2_Vector2 1, G_PsiccZZ; - (Psipp, Psimm, Ga, Ga), Scalar2_Vector2 8, G_AAWW; - (Psipp, Psimm, ZH, ZH), Scalar2_Vector2 1, G_Psi00ZH; - (Psipp, Psimm, Ga, Z), Scalar2_Vector2 1, G_PsiccAZ; - (Psipp, Psimm, Z, ZH), Scalar2_Vector2 4, G_PsiccZZH; - (Psipp, Psimm, Ga, ZH), Scalar2_Vector2 4, G_PsiccAZH] - @ - (if Flags.u1_gauged then - [(H, H, AH, AH), Scalar2_Vector2 1, G_HHAA; - (H, H, AH, Z), Scalar2_Vector2 (-1), G_HHAHZ; - (H, H, ZH, AH), Scalar2_Vector2 (-1), G_HHZHAH; - (H, Psi0, AH, AH), Scalar2_Vector2 1, G_HPsi0AHAH; - (H, Psi0, Z, AH), Scalar2_Vector2 1, G_HPsi0ZAH; - (H, Psi0, ZH, AH), Scalar2_Vector2 1, G_HPsi0ZHAH; - (H, Psim, Wp, AH), Scalar2_Vector2 1, G_HPsipWAH; - (H, Psip, Wm, AH), Scalar2_Vector2 1, G_HPsipWAH; - (H, Psim, WHp, AH), Scalar2_Vector2 1, G_HPsipWHAH; - (H, Psip, WHm, AH), Scalar2_Vector2 1, G_HPsipWHAH; - (Psi0, Psi0, AH, AH), Scalar2_Vector2 1, G_Psi00AH; - (Psi0, Psi0, Z, AH), Scalar2_Vector2 4, G_HHAHZ; - (Psi0, Psi0, AH, ZH), Scalar2_Vector2 1, G_Psi00ZHAH; - (Psi0, Psim, Wp, AH), Scalar2_Vector2 1, G_Psi0pWAH; - (Psi0, Psip, Wm, AH), Scalar2_Vector2 1, G_Psi0pWAH; - (Psi0, Psim, WHp, AH), Scalar2_Vector2 1, G_Psi0pWHAH; - (Psi0, Psip, WHm, AH), Scalar2_Vector2 1, G_Psi0pWHAH; - (Psi1, Psi1, AH, AH), Scalar2_Vector2 1, G_Psi00AH; - (Psi1, Psi1, Z, AH), Scalar2_Vector2 4, G_HHAHZ; - (Psi1, Psi1, AH, ZH), Scalar2_Vector2 1, G_Psi00ZHAH; - (Psi1, Psim, Wp, AH), Scalar2_Vector2 1, I_G_Psi0pWAH; - (Psi1, Psip, Wm, AH), Scalar2_Vector2 (-1), I_G_Psi0pWAH; - (Psi1, Psim, WHp, AH), Scalar2_Vector2 1, I_G_Psi0pWHAH; - (Psi1, Psip, WHm, AH), Scalar2_Vector2 (-1), I_G_Psi0pWHAH; - (Psip, Psim, AH, AH), Scalar2_Vector2 1, G_Psi00AH; - (Psip, Psim, Ga, AH), Scalar2_Vector2 4, G_PsippAAH; - (Psip, Psim, Z, AH), Scalar2_Vector2 4, G_PsippZAH; - (Psip, Psimm, Wp, AH), Scalar2_Vector2 1, G_PsippWAH; - (Psim, Psipp, Wm, AH), Scalar2_Vector2 1, G_PsippWAH; - (Psip, Psimm, WHp, AH), Scalar2_Vector2 1, G_PsippWHAH; - (Psim, Psipp, WHm, AH), Scalar2_Vector2 1, G_PsippWHAH; - (Psipp, Psimm, AH, AH), Scalar2_Vector2 1, G_Psi00AH; - (Psipp, Psimm, AH, ZH), Scalar2_Vector2 (-1), G_Psi00ZHAH; - (Psipp, Psimm, Ga, AH), Scalar2_Vector2 4, G_PsiccAAH; - (Psipp, Psimm, Z, AH), Scalar2_Vector2 4, G_PsiccZAH] - else [])) - - let standard_higgs = - [ (O H, O H, O H), Scalar_Scalar_Scalar 1, G_H3 ] - - let anomaly_higgs = - List.map hgg - [ (Eta, Gl, Gl), Dim5_Scalar_Gauge2_Skew 1, G_EGlGl; - (Eta, Ga, Ga), Dim5_Scalar_Gauge2_Skew 1, G_EGaGa; - (Eta, Ga, Z), Dim5_Scalar_Gauge2_Skew 1, G_EGaZ] -(* @ [ (H, Ga, Ga), Dim5_Scalar_Gauge2 1, G_HGaGa; - (H, Ga, Z), Dim5_Scalar_Gauge2 1, G_HGaZ ] *) - - let standard_higgs4 = - [ (O H, O H, O H, O H), Scalar4 1, G_H4 ] - - let gauge_higgs = - standard_gauge_higgs - - let gauge_higgs4 = - standard_gauge_higgs4 - - let higgs = - standard_higgs - - let higgs4 = - standard_higgs4 - - let top_quartic = - [ ((M (U (-3)), O H, O H, M (U 3)), GBBG (1, Psibar, S2, Psi), G_HHtt); - ((M (TopHb), O H, O H, M TopH), GBBG (1, Psibar, S2, Psi), G_HHthth); - ((M (U (-3)), O H, O H, M TopH), GBBG (1, Psibar, S2LR, Psi), G_HHtht); - ((M (TopHb), O H, O H, M (U 3)), GBBG (1, Psibar, S2LR, Psi), G_HHtht)] - - let goldstone_vertices = - List.map hgg - [ ((Phi0, Wm, Wp), Scalar_Vector_Vector 1, I_G_ZWW); - ((Phip, Ga, Wm), Scalar_Vector_Vector 1, I_Q_W); - ((Phip, Z, Wm), Scalar_Vector_Vector 1, I_G_ZWW); - ((Phim, Wp, Ga), Scalar_Vector_Vector 1, I_Q_W); - ((Phim, Wp, Z), Scalar_Vector_Vector 1, I_G_ZWW) ] - - let vertices3 = - (ThoList.flatmap electromagnetic_currents [1;2;3] @ - ThoList.flatmap color_currents [1;2;3] @ - ThoList.flatmap neutral_currents [1;2;3] @ - ThoList.flatmap neutral_heavy_currents [1;2;3] @ - ThoList.flatmap charged_currents [1;2;3] @ - ThoList.flatmap charged_heavy_currents [1;2;3] @ - heavy_top_currents @ - (if Flags.u1_gauged then [] - else anomaly_higgs) @ - yukawa @ yukawa_add @ triple_gauge @ - gauge_higgs @ higgs @ goldstone_vertices) - - let vertices4 = - quartic_gauge @ gauge_higgs4 @ higgs4 @ top_quartic - - let vertices () = (vertices3, vertices4, []) - -(* For efficiency, make sure that [F.of_vertices vertices] is - evaluated only once. *) - - let table = F.of_vertices (vertices ()) - let fuse2 = F.fuse2 table - let fuse3 = F.fuse3 table - let fuse = F.fuse table - let max_degree () = 4 - - let flavor_of_string = function - | "e-" -> M (L 1) | "e+" -> M (L (-1)) - | "mu-" -> M (L 2) | "mu+" -> M (L (-2)) - | "tau-" -> M (L 3) | "tau+" -> M (L (-3)) - | "nue" -> M (N 1) | "nuebar" -> M (N (-1)) - | "numu" -> M (N 2) | "numubar" -> M (N (-2)) - | "nutau" -> M (N 3) | "nutaubar" -> M (N (-3)) - | "u" -> M (U 1) | "ubar" -> M (U (-1)) - | "c" -> M (U 2) | "cbar" -> M (U (-2)) - | "t" -> M (U 3) | "tbar" -> M (U (-3)) - | "d" -> M (D 1) | "dbar" -> M (D (-1)) - | "s" -> M (D 2) | "sbar" -> M (D (-2)) - | "b" -> M (D 3) | "bbar" -> M (D (-3)) - | "th" -> M TopH | "thbar" -> M TopHb - | "g" -> G Gl - | "A" -> G Ga | "Z" | "Z0" -> G Z - | "AH" | "AH0" | "Ah" | "Ah0" -> G AH - | "ZH" | "ZH0" | "Zh" | "Zh0" -> G ZH - | "W+" -> G Wp | "W-" -> G Wm - | "WH+" -> G WHp | "WH-" -> G WHm - | "H" | "h" -> O H | "eta" | "Eta" -> O Eta - | "Psi" | "Psi0" | "psi" | "psi0" -> O Psi0 - | "Psi1" | "psi1" -> O Psi1 - | "Psi+" | "psi+" | "Psip" | "psip" -> O Psip - | "Psi-" | "psi-" | "Psim" | "psim" -> O Psim - | "Psi++" | "psi++" | "Psipp" | "psipp" -> O Psipp - | "Psi--" | "psi--" | "Psimm" | "psimm" -> O Psimm - | _ -> invalid_arg "Models4.Littlest.flavor_of_string" - - - let flavor_to_string = function - | M f -> - begin match f with - | L 1 -> "e-" | L (-1) -> "e+" - | L 2 -> "mu-" | L (-2) -> "mu+" - | L 3 -> "tau-" | L (-3) -> "tau+" - | L _ -> invalid_arg "Models4.Littlest.flavor_to_string" - | N 1 -> "nue" | N (-1) -> "nuebar" - | N 2 -> "numu" | N (-2) -> "numubar" - | N 3 -> "nutau" | N (-3) -> "nutaubar" - | N _ -> invalid_arg "Models4.Littlest.flavor_to_string" - | U 1 -> "u" | U (-1) -> "ubar" - | U 2 -> "c" | U (-2) -> "cbar" - | U 3 -> "t" | U (-3) -> "tbar" - | U _ -> invalid_arg "Models4.Littlest.flavor_to_string" - | D 1 -> "d" | D (-1) -> "dbar" - | D 2 -> "s" | D (-2) -> "sbar" - | D 3 -> "b" | D (-3) -> "bbar" - | D _ -> invalid_arg "Models4.Littlest.flavor_to_string" - | TopH -> "th" | TopHb -> "thbar" - end - | G f -> - begin match f with - | Gl -> "g" - | Ga -> "A" | Z -> "Z" - | Wp -> "W+" | Wm -> "W-" - | ZH -> "ZH" | AH -> "AH" | WHp -> "WHp" | WHm -> "WHm" - end - | O f -> - begin match f with - | Phip -> "phi+" | Phim -> "phi-" | Phi0 -> "phi0" - | H -> "H" | Eta -> "Eta" - | Psi0 -> "Psi0" | Psi1 -> "Psi1" | Psip -> "Psi+" - | Psim -> "Psi-" | Psipp -> "Psi++" | Psimm -> "Psi--" - end - - let flavor_symbol = function - | M f -> - begin match f with - | L n when n > 0 -> "l" ^ string_of_int n - | L n -> "l" ^ string_of_int (abs n) ^ "b" - | N n when n > 0 -> "n" ^ string_of_int n - | N n -> "n" ^ string_of_int (abs n) ^ "b" - | U n when n > 0 -> "u" ^ string_of_int n - | U n -> "u" ^ string_of_int (abs n) ^ "b" - | D n when n > 0 -> "d" ^ string_of_int n - | D n -> "d" ^ string_of_int (abs n) ^ "b" - | TopH -> "th" | TopHb -> "thb" - end - | G f -> - begin match f with - | Gl -> "gl" - | Ga -> "a" | Z -> "z" - | Wp -> "wp" | Wm -> "wm" - | ZH -> "zh" | AH -> "ah" | WHp -> "whp" | WHm -> "whm" - end - | O f -> - begin match f with - | Phip -> "pp" | Phim -> "pm" | Phi0 -> "p0" - | H -> "h" | Eta -> "eta" - | Psi0 -> "psi0" | Psi1 -> "psi1" | Psip -> "psip" - | Psim -> "psim" | Psipp -> "psipp" | Psimm -> "psimm" - end - - let flavor_sans_color_of_string = flavor_of_string - let flavor_sans_color_to_string = flavor_to_string - let flavor_sans_color_symbol = flavor_symbol - -(* There are PDG numbers for Z', Z'', W', 32-34, respectively. - We just introduce a number 38 for Y0 as a Z'''. - As well, there is the number 8 for a t'. But we cheat a little bit and - take the number 35 which is reserved for a heavy scalar Higgs for the - Eta scalar. - For the heavy Higgs states we take 35 and 36 for the neutral ones, 37 for - the charged and 38 for the doubly-charged. - The pseudoscalar gets the 39. -*) - - let pdg = function - | M f -> - begin match f with - | L n when n > 0 -> 9 + 2*n - | L n -> - 9 + 2*n - | N n when n > 0 -> 10 + 2*n - | N n -> - 10 + 2*n - | U n when n > 0 -> 2*n - | U n -> 2*n - | D n when n > 0 -> - 1 + 2*n - | D n -> 1 + 2*n - | TopH -> 8 | TopHb -> (-8) - end - | G f -> - begin match f with - | Gl -> 21 - | Ga -> 22 | Z -> 23 - | Wp -> 24 | Wm -> (-24) - | AH -> 32 | ZH -> 33 | WHp -> 34 | WHm -> (-34) - end - | O f -> - begin match f with - | Phip | Phim -> 27 | Phi0 -> 26 - | Psi0 -> 35 | Psi1 -> 36 | Psip -> 37 | Psim -> (-37) - | Psipp -> 38 | Psimm -> (-38) - | H -> 25 | Eta -> 39 - end - - let mass_symbol f = - "mass(" ^ string_of_int (abs (pdg f)) ^ ")" - - let width_symbol f = - "width(" ^ string_of_int (abs (pdg f)) ^ ")" - - let constant_symbol = function - | Unit -> "unit" | Pi -> "PI" | VHeavy -> "vheavy" - | Alpha_QED -> "alpha" | E -> "e" | G_weak -> "g" | Vev -> "vev" - | Sin2thw -> "sin2thw" | Sinthw -> "sinthw" | Costhw -> "costhw" - | Sinpsi -> "sinpsi" | Cospsi -> "cospsi" - | Atpsi -> "atpsi" | Sccs -> "sccs" - | Supp -> "vF" | Supp2 -> "v2F2" - | Q_lepton -> "qlep" | Q_up -> "qup" | Q_down -> "qdwn" - | Q_Z_up -> "qzup" - | G_ZHTHT -> "gzhtht" | G_ZTHT -> "gzhtht" - | G_AHTHTH -> "gahthth" | G_AHTHT -> "gahtht" | G_AHTT -> "gahtt" - | G_NC_lepton -> "gnclep" | G_NC_neutrino -> "gncneu" - | G_NC_up -> "gncup" | G_NC_down -> "gncdwn" - | G_CC -> "gcc" | G_CCtop -> "gcctop" | G_CC_heavy -> "gcch" - | G_CC_WH -> "gccwh" | G_CC_W -> "gccw" - | G_NC_h_lepton -> "gnchlep" | G_NC_h_neutrino -> "gnchneu" - | G_NC_h_up -> "gnchup" | G_NC_h_down -> "gnchdwn" - | G_NC_heavy -> "gnch" - | I_Q_W -> "iqw" | I_G_ZWW -> "igzww" | I_G_WWW -> "igwww" - | I_G_AHWW -> "igahww" | I_G_ZHWW -> "igzhww" | I_G_ZWHW -> "igzwhw" - | I_G_AHWHWH -> "igahwhwh" | I_G_ZHWHWH -> "igzhwhwh" - | I_G_AHWHW -> "igahwhw" - | I_Q_H -> "iqh" - | G_WWWW -> "gw4" | G_ZZWW -> "gzzww" - | G_AZWW -> "gazww" | G_AAWW -> "gaaww" - | G_WH4 -> "gwh4" | G_WHWHWW -> "gwhwhww" | G_WHWWW -> "gwhwww" - | G_WH3W -> "gwh3w" - | G_WWAAH -> "gwwaah" | G_WWAZH -> "gwwazh" | G_WWZZH -> "gwwzzh" - | G_WWZAH -> "gwwzah" | G_WHWHAAH -> "gwhwhaah" - | G_WHWHAZH -> "gwhwhazh" | G_WHWHZZH -> "gwhwhzzh" - | G_WHWHZAH -> "gwhwhzah" - | G_WWZHAH -> "gwwzhah" | G_WHWHZHAH -> "gwhwhzhah" - | G_WHWZZ -> "gwhwzz" | G_WHWAZ -> "gwhwaz" - | G_WHWAAH -> "gwhwaah" | G_WHWZAH -> "gwhwzah" - | G_WHWZHZH -> "gwhwzhzh" | G_WHWZHAH -> "gwhwzhah" - | G_WHWAZH -> "gwhwazh" | G_WHWZZH -> "gwhwzzh" - | G_HWW -> "ghww" | G_HZZ -> "ghzz" - | G_HHWW -> "ghhww" | G_HHZZ -> "ghhzz" - | G_HWHW -> "ghwhw" | G_HWHWH -> "ghwhwh" | G_HAHAH -> "ghahah" - | G_HZHZ -> "ghzhz" | G_HZHAH -> "ghzhah" - | G_HAHZ -> "ghahz" - | G_Htt -> "ghtt" | G_Hbb -> "ghbb" - | G_Htautau -> "ghtautau" | G_Hcc -> "ghcc" - | G_Hthth -> "ghthth" | G_Htht -> "ghtht" - | G_HHtt -> "ghhtt" | G_HHthth -> "ghhthth" | G_HHtht -> "ghhtht" - | G_Psi0tt -> "gpsi0tt" | G_Psi0bb -> "gpsi0bb" - | G_Psi0cc -> "gpsi0cc" | G_Psi0tautau -> "gpsi0tautau" - | G_Psi1tt -> "gpsi1tt" | G_Psi1bb -> "gpsi1bb" - | G_Psi1cc -> "gpsi1cc" | G_Psi1tautau -> "gpsi1tautau" - | G_Psipq3 -> "gpsipq3" | G_Psipq2 -> "gpsipq2" | G_Psipl3 -> "gpsil3" - | G_Psi0tth -> "gpsi0tth" | G_Psi1tth -> "gpsi1tth" - | G_Psipbth -> "gpsipbth" - | G_Ethth -> "gethth" | G_Etht -> "getht" - | G_Ett -> "gett" | G_Ebb -> "gebb" - | G_HGaGa -> "ghgaga" | G_HGaZ -> "ghgaz" - | G_EGaGa -> "geaa" | G_EGaZ -> "geaz" | G_EGlGl -> "gegg" - | G_H3 -> "gh3" | G_H4 -> "gh4" - | G_PsiWW -> "gpsiww" | G_PsiWHW -> "gpsiwhw" - | G_PsiZZ -> "gpsizz" | G_PsiZHZH -> "gpsizhzh" - | G_PsiZHZ -> "gpsizhz" | G_PsiZAH -> "gpsizah" - | G_PsiZHAH -> "gpsizhah" | G_PsiAHAH -> "gpsiahah" - | G_PsiZW -> "gpsizw" | G_PsiZWH -> "gpsizwh" | G_PsiAHW -> "gpsiahw" - | G_PsiAHWH -> "gpsiahwh" | G_PsiZHW -> "gpsizhw" - | G_PsiZHWH -> "gpsizhwh" - | G_PsippWW -> "gpsippww" | G_PsippWHW -> "gpsippwhw" - | G_PsippWHWH -> "gpsippwhwh" - | Gs -> "gs" | G2 -> "gs**2" | I_Gs -> "igs" - | G_PsiHW -> "gpsihw" | G_PsiHWH -> "gpsihwh" - | G_Psi0W -> "gpsi0w" | G_Psi0WH -> "gpsi0wh" - | G_Psi1W -> "gpsi1w" | G_Psi1WH -> "gpsi1wh" - | G_PsiPPW -> "gpsippw" | G_PsiPPWH -> "gpsippwh" - | G_Psi1HAH -> "gpsihah" | G_Psi01AH -> "gpsi0ah" - | G_AHPsip -> "gahpsip" | G_Psi1HZ -> "gpsi1hz" - | G_Psi1HZH -> "gpsi1hzh" | G_Psi01Z -> "gpsi01z" - | G_Psi01ZH -> "gpsi01zh" | G_ZPsip -> "gzpsip" - | G_ZPsipp -> "gzpsipp" | G_ZHPsipp -> "gzhpsipp" - | G_HHAA -> "ghhaa" | G_HHWHW -> "ghhwhw" | G_HHZHZ -> "ghhzhz" - | G_HHAHZ -> "ghhahz" | G_HHZHAH -> "ghhzhah" - | G_HPsi0WW -> "ghpsi0ww" | G_HPsi0WHW -> "ghpsi0whw" - | G_HPsi0ZZ -> "ghpsi0zz" | G_HPsi0ZHZH -> "ghpsi0zhzh" - | G_HPsi0ZHZ -> "ghpsi0zhz" | G_HPsi0AHAH -> "ghpsi0ahah" - | G_HPsi0ZAH -> "ghpsi0zah" | G_HPsi0ZHAH -> "ghpsi0zhah" - | G_HPsipWA -> "ghpsipwa" | G_HPsipWHA -> "ghpsipwha" - | G_HPsipWZ -> "ghpsipwz" | G_HPsipWHZ -> "ghpsiwhz" - | G_HPsipWAH -> "ghpsipwah" | G_HPsipWHAH -> "ghpsipwhah" - | G_HPsipWZH -> "ghpsipwzh" | G_HPsipWHZH -> "ghpsipwhzh" - | G_HPsippWW -> "ghpsippww" | G_HPsippWHWH -> "ghpsippwhwh" - | G_HPsippWHW -> "ghpsippwhw" | G_Psi00ZH -> "gpsi00zh" - | G_Psi00AH -> "gpsi00ah" | G_Psi00ZHAH -> "gpsi00zhah" - | G_Psi0pWA -> "gpsi0pwa" | G_Psi0pWHA -> "gpsi0pwha" - | G_Psi0pWZ -> "gpsi0pwz" | G_Psi0pWHZ -> "gpsi0pwhz" - | G_Psi0pWAH -> "gpsi0pwah" | G_Psi0pWHAH -> "gpsi0pwhah" - | G_Psi0pWZH -> "gpsi0pwzh" | G_Psi0pWHZH -> "gpsi0pwhzh" - | G_Psi0ppWW -> "gpsi0ppww" | G_Psi0ppWHWH -> "gpsi0ppwhwh" - | G_Psi0ppWHW -> "gpsi0ppwhw" - | I_G_Psi0pWA -> "i_gpsi0pwa" | I_G_Psi0pWHA -> "i_gpsi0pwha" - | I_G_Psi0pWZ -> "i_gpsi0pwz" | I_G_Psi0pWHZ -> "i_gpsi0pwhz" - | I_G_Psi0pWAH -> "i_gpsi0pwah" | I_G_Psi0pWHAH -> "i_gpsi0pwhah" - | I_G_Psi0pWZH -> "i_gpsi0pwzh" | I_G_Psi0pWHZH -> "i_gpsi0pwhzh" - | I_G_Psi0ppWW -> "i_gpsi0ppww" | I_G_Psi0ppWHWH -> "i_gpsi0ppwhwh" - | I_G_Psi0ppWHW -> "i_gpsi0ppwhw" - | G_PsippZZ -> "gpsippzz" | G_PsippZHZH -> "gpsippzhzh" - | G_PsippAZ -> "gpsippaz" | G_PsippAAH -> "gpsippaah" - | G_PsippZAH -> "gpsippzah" - | G_PsippWA -> "gpsippwa" | G_PsippWHA -> "gpsippwha" - | G_PsippWZ -> "gpsippwz" | G_PsippWHZ -> "gpsippwhz" - | G_PsippWAH -> "gpsippwah" | G_PsippWHAH -> "gpsippwhah" - | G_PsippWZH -> "gpsippwzh" | G_PsippWHZH -> "gpsippwhzh" - | G_PsiccZZ -> "gpsicczz" | G_PsiccAZ -> "gpsiccaz" - | G_PsiccAAH -> "gpsiccaah" | G_PsiccZZH -> "gpsicczzh" - | G_PsiccAZH -> "gpsiccazh" | G_PsiccZAH -> "gpsicczah" - | Mass f -> "mass" ^ flavor_symbol f - | Width f -> "width" ^ flavor_symbol f - end - -module Littlest_Tpar (Flags : BSM_flags) = - struct - let rcs = rcs_file - - open Coupling - - let default_width = ref Timelike - let use_fudged_width = ref false - - let options = Options.create - [ "constant_width", Arg.Unit (fun () -> default_width := Constant), - "use constant width (also in t-channel)"; - "fudged_width", Arg.Set use_fudged_width, - "use fudge factor for charge particle width"; - "custom_width", Arg.String (fun f -> default_width := Custom f), - "use custom width"; - "cancel_widths", Arg.Unit (fun () -> default_width := Vanishing), - "use vanishing width" ] - - type flavor = L of int | N of int | U of int | D of int - | Topp | Toppb - | Ga | Wp | Wm | Z | Gl | Lodd of int | Nodd of int - | Uodd of int | Dodd of int - | WHp | WHm | ZH | AH | Phip | Phim | Phi0 | H | Eta | Psi0 - | Psi1 | Psip | Psim | Psipp | Psimm - type flavor_sans_color = flavor - let flavor_sans_color f = f - - type gauge = unit - - let gauge_symbol () = - failwith "Models4.Littlest_Tpar.gauge_symbol: internal error" - - let family n = [ L n; N n; U n; D n; Dodd n; Nodd n; Lodd n; Uodd n ] - -(* Since [Phi] already belongs to the EW Goldstone bosons we use [Psi] - for the TeV scale complex triplet. - - We use the notation Todd1 = Uodd 3, Todd2 = Uodd 4. -*) - - let external_flavors () = - [ "1st Generation", ThoList.flatmap family [1; -1]; - "2nd Generation", ThoList.flatmap family [2; -2]; - "3rd Generation", ThoList.flatmap family [3; -3]; - "Heavy Quarks", [Topp; Toppb; Uodd 4; Uodd (-4)]; - "Heavy Scalars", [Psi0; Psi1; Psip; Psim; Psipp; Psimm]; - "Gauge Bosons", if Flags.u1_gauged then - [Ga; Z; Wp; Wm; Gl; WHp; WHm; ZH; AH] - else - [Ga; Z; Wp; Wm; Gl; WHp; WHm; ZH]; - "Higgs", if Flags.u1_gauged then [H] - else [H; Eta]; - "Goldstone Bosons", [Phip; Phim; Phi0] ] - - let flavors () = ThoList.flatmap snd (external_flavors ()) - - let spinor n = - if n >= 0 then - Spinor - else - ConjSpinor - - let lorentz = function - | L n -> spinor n | N n -> spinor n - | U n -> spinor n | D n -> spinor n - | Topp -> Spinor | Toppb -> ConjSpinor - | Ga | Gl -> Vector - | Wp | Wm | Z | WHp | WHm | ZH | AH -> Massive_Vector - | _ -> Scalar - - let color = function - | U n -> Color.SUN (if n > 0 then 3 else -3) - | Uodd n -> Color.SUN (if n > 0 then 3 else -3) - | D n -> Color.SUN (if n > 0 then 3 else -3) - | Dodd n -> Color.SUN (if n > 0 then 3 else -3) - | Topp -> Color.SUN 3 | Toppb -> Color.SUN (-3) - | Gl -> Color.AdjSUN 3 - | _ -> Color.Singlet - - let prop_spinor n = - if n >= 0 then - Prop_Spinor - else - Prop_ConjSpinor - - let propagator = function - | L n -> prop_spinor n | N n -> prop_spinor n - | Lodd n -> prop_spinor n | Nodd n -> prop_spinor n - | U n -> prop_spinor n | D n -> prop_spinor n - | Uodd n -> prop_spinor n | Dodd n -> prop_spinor n - | Topp -> Prop_Spinor | Toppb -> Prop_ConjSpinor - | Ga | Gl -> Prop_Feynman - | Wp | Wm | Z | WHp | WHm | ZH | AH -> Prop_Unitarity - | Phip | Phim | Phi0 -> Only_Insertion - | H | Eta | Psi0 | Psi1 | Psip | Psim | Psipp | Psimm -> Prop_Scalar - -(* Optionally, ask for the fudge factor treatment for the widths of - charged particles. Currently, this only applies to $W^\pm$ and top. *) - - let width f = - if !use_fudged_width then - match f with - | Wp | Wm | U 3 | U (-3) - | WHp | WHm | ZH | AH - | Uodd _ | Dodd _ | Nodd _ | Lodd _ - | Topp | Toppb -> Fudged - | _ -> !default_width - else - !default_width - - let goldstone = function - | Wp -> Some (Phip, Coupling.Const 1) - | Wm -> Some (Phim, Coupling.Const 1) - | Z -> Some (Phi0, Coupling.Const 1) - | _ -> None - - let conjugate = function - | L n -> L (-n) | N n -> N (-n) - | Lodd n -> L (-n) | Nodd n -> N (-n) - | U n -> U (-n) | D n -> D (-n) - | Uodd n -> U (-n) | Dodd n -> D (-n) - | Topp -> Toppb | Toppb -> Topp - | Gl -> Gl | Ga -> Ga | Z -> Z - | Wp -> Wm | Wm -> Wp | WHm -> WHp - | WHp -> WHm | ZH -> ZH | AH -> AH - | Psi0 -> Psi0 | Psi1 -> Psi1 | Psip -> Psim - | Psim -> Psip | Psipp -> Psimm | Psimm -> Psipp - | Phip -> Phim | Phim -> Phip | Phi0 -> Phi0 - | H -> H | Eta -> Eta - - let conjugate_sans_color = conjugate - - let fermion = function - | L n -> if n > 0 then 1 else -1 - | N n -> if n > 0 then 1 else -1 - | U n -> if n > 0 then 1 else -1 - | D n -> if n > 0 then 1 else -1 - | Lodd n -> if n > 0 then 1 else -1 - | Nodd n -> if n > 0 then 1 else -1 - | Uodd n -> if n > 0 then 1 else -1 - | Dodd n -> if n > 0 then 1 else -1 - | Topp -> 1 | Toppb -> -1 - | Gl | Ga | Z | Wp | Wm | WHp | WHm | AH | ZH -> 0 - | _ -> 0 - - type constant = - | Unit | Pi | Alpha_QED | Sin2thw - | Sinthw | Costhw | E | G_weak | Vev | VHeavy - | Supp | Supp2 - | Sinpsi | Cospsi | Atpsi | Sccs (* Mixing angles of SU(2) *) - | Q_lepton | Q_up | Q_down | Q_Z_up | G_CC | G_CCtop - | G_NC_neutrino | G_NC_lepton | G_NC_up | G_NC_down | G_NC_heavy - | G_NC_h_neutrino | G_NC_h_lepton | G_NC_h_up | G_NC_h_down - | G_CC_heavy | G_ZHTHT | G_ZTHT | G_AHTHTH | G_AHTHT | G_AHTT - | G_CC_WH | G_CC_W - | Gs | I_Gs | G2 - | I_Q_W | I_G_ZWW | I_G_WWW - | I_G_AHWW | I_G_ZHWW | I_G_ZWHW | I_G_AHWHWH | I_G_ZHWHWH - | I_G_AHWHW | I_Q_H - | G_WWWW | G_ZZWW | G_AZWW | G_AAWW - | G_WH4 | G_WHWHWW | G_WHWWW | G_WH3W - | G_WWAAH | G_WWAZH | G_WWZZH | G_WWZAH | G_WHWHAAH - | G_WHWHAZH | G_WHWHZZH | G_WHWHZAH | G_WWZHAH - | G_WHWHZHAH | G_WHWZZ | G_WHWAZ | G_WHWAAH | G_WHWZAH - | G_WHWZHZH | G_WHWZHAH | G_WHWAZH | G_WHWZZH - | G_HWW | G_HHWW | G_HZZ | G_HHZZ - | G_PsiWW | G_PsiWHW | G_PsiZZ | G_PsiZHZH - | G_PsiZHZ | G_PsiZAH | G_PsiZHAH | G_PsiAHAH - | G_PsiZW | G_PsiZWH | G_PsiAHW | G_PsiAHWH - | G_PsiZHW | G_PsiZHWH - | G_PsippWW | G_PsippWHW | G_PsippWHWH - | G_PsiHW | G_PsiHWH | G_Psi0W | G_Psi0WH - | G_Psi1W | G_Psi1WH | G_PsiPPW | G_PsiPPWH - | G_Psi1HAH | G_Psi01AH | G_AHPsip | G_Psi1HZ - | G_Psi1HZH | G_Psi01Z | G_Psi01ZH | G_ZPsip | G_ZPsipp | G_ZHPsipp - | G_HHAA | G_HHWHW | G_HHZHZ | G_HHAHZ | G_HHZHAH - | G_HPsi0WW | G_HPsi0WHW | G_HPsi0ZZ - | G_HPsi0ZHZH | G_HPsi0ZHZ | G_HPsi0AHAH | G_HPsi0ZAH | G_HPsi0ZHAH - | G_HPsipWA | G_HPsipWHA | G_HPsipWZ | G_HPsipWHZ | G_HPsipWAH - | G_HPsipWHAH | G_HPsipWZH | G_HPsipWHZH | G_HPsippWW | G_HPsippWHWH - | G_HPsippWHW | G_Psi00ZH | G_Psi00AH | G_Psi00ZHAH - | G_Psi0pWA | G_Psi0pWHA | G_Psi0pWZ | G_Psi0pWHZ | G_Psi0pWAH - | G_Psi0pWHAH | G_Psi0pWZH | G_Psi0pWHZH | G_Psi0ppWW | G_Psi0ppWHWH - | G_Psi0ppWHW | I_G_Psi0pWA | I_G_Psi0pWHA | I_G_Psi0pWZ | I_G_Psi0pWHZ - | I_G_Psi0pWAH | I_G_Psi0pWHAH | I_G_Psi0pWZH | I_G_Psi0pWHZH - | I_G_Psi0ppWW | I_G_Psi0ppWHWH | I_G_Psi0ppWHW - | G_PsippZZ | G_PsippZHZH | G_PsippAZ | G_PsippAAH | G_PsippZAH - | G_PsippWA | G_PsippWHA | G_PsippWZ | G_PsippWHZ | G_PsippWAH - | G_PsippWHAH | G_PsippWZH | G_PsippWHZH - | G_PsiccZZ | G_PsiccAZ | G_PsiccAAH | G_PsiccZZH | G_PsiccAZH - | G_PsiccZAH - | G_Htt | G_Hbb | G_Hcc | G_Htautau | G_H3 | G_H4 - | G_Hthth | G_Htht | G_Ethth | G_Etht | G_Ett - | G_HHtt | G_HHthth | G_HHtht - | G_Psi0tt | G_Psi0bb | G_Psi0cc | G_Psi0tautau - | G_Psi1tt | G_Psi1bb | G_Psi1cc | G_Psi1tautau - | G_Psipq3 | G_Psipq2 | G_Psipl3 | G_Psi0tth | G_Psi1tth - | G_Psipbth | G_Ebb - | G_HGaGa | G_HGaZ | G_EGaGa | G_EGaZ | G_EGlGl - | G_HWHW | G_HWHWH | G_HAHAH | G_HZHZ | G_HZHAH | G_HAHZ - | Mass of flavor | Width of flavor - - let input_parameters = - [] - - let derived_parameters = - [] - - let derived_parameter_arrays = - [] - - let parameters () = - { input = input_parameters; - derived = derived_parameters; - derived_arrays = derived_parameter_arrays } - - module F = Models.Fusions (struct - type f = flavor - type c = constant - let compare = compare - let conjugate = conjugate - end) - - let electromagnetic_currents n = - [ ((L (-n), Ga, L n), FBF (1, Psibar, V, Psi), Q_lepton); - ((U (-n), Ga, U n), FBF (1, Psibar, V, Psi), Q_up); - ((D (-n), Ga, D n), FBF (1, Psibar, V, Psi), Q_down) ] - - let color_currents n = - [ ((U (-n), Gl, U n), FBF ((-1), Psibar, V, Psi), Gs); - ((D (-n), Gl, D n), FBF ((-1), Psibar, V, Psi), Gs) ] - - let neutral_currents n = - [ ((L (-n), Z, L n), FBF (1, Psibar, VA, Psi), G_NC_lepton); - ((N (-n), Z, N n), FBF (1, Psibar, VA, Psi), G_NC_neutrino); - ((U (-n), Z, U n), FBF (1, Psibar, VA, Psi), G_NC_up); - ((D (-n), Z, D n), FBF (1, Psibar, VA, Psi), G_NC_down) ] - -(* The sign of this coupling is just the one of the T3, being -(1/2) for - leptons and down quarks, and +(1/2) for neutrinos and up quarks. *) - - let neutral_heavy_currents n = - ([ ((L (-n), ZH, L n), FBF ((-1), Psibar, VL, Psi), G_NC_heavy); - ((N (-n), ZH, N n), FBF (1, Psibar, VL, Psi), G_NC_heavy); - ((U (-n), ZH, U n), FBF (1, Psibar, VL, Psi), G_NC_heavy); - ((D (-n), ZH, D n), FBF ((-1), Psibar, VL, Psi), G_NC_heavy)] - @ - (if Flags.u1_gauged then - [ ((L (-n), AH, L n), FBF (1, Psibar, VA, Psi), G_NC_h_lepton); - ((N (-n), AH, N n), FBF (1, Psibar, VA, Psi), G_NC_h_neutrino); - ((D (-n), AH, D n), FBF (1, Psibar, VA, Psi), G_NC_h_down)] - else - [])) - - let heavy_top_currents = - ([ ((Toppb, Ga, Topp), FBF (1, Psibar, V, Psi), Q_up); - ((Toppb, Z, Topp), FBF (1, Psibar, V, Psi), Q_Z_up); - ((Toppb, Z, U 3), FBF (1, Psibar, VL, Psi), G_ZTHT); - ((U (-3), Z, Topp), FBF (1, Psibar, VL, Psi), G_ZTHT); - ((Toppb, ZH, U 3), FBF (1, Psibar, VL, Psi), G_ZHTHT); - ((U (-3), ZH, Topp), FBF (1, Psibar, VL, Psi), G_ZHTHT); - ((U (-3), Wp, D 3), FBF (1, Psibar, VL, Psi), G_CCtop); - ((D (-3), Wm, U 3), FBF (1, Psibar, VL, Psi), G_CCtop); - ((Toppb, WHp, D 3), FBF (1, Psibar, VL, Psi), G_CC_WH); - ((D (-3), WHm, Topp), FBF (1, Psibar, VL, Psi), G_CC_WH); - ((Toppb, Wp, D 3), FBF (1, Psibar, VL, Psi), G_CC_W); - ((D (-3), Wm, Topp), FBF (1, Psibar, VL, Psi), G_CC_W)] - @ - (if Flags.u1_gauged then - [ ((U (-3), AH, U 3), FBF (1, Psibar, VA, Psi), G_AHTT); - ((Toppb, AH, Topp), FBF (1, Psibar, VA, Psi), G_AHTHTH); - ((Toppb, AH, U 3), FBF (1, Psibar, VR, Psi), G_AHTHT); - ((U (-3), AH, Topp), FBF (1, Psibar, VR, Psi), G_AHTHT)] - else - [])) - - -(* \begin{equation} - \mathcal{L}_{\textrm{CC}} = - - \frac{g}{2\sqrt2} \sum_i \bar\psi_i - (T^+\fmslash{W}^+ + T^-\fmslash{W}^-)(1-\gamma_5)\psi_i - \end{equation} *) - - let charged_currents n = - [ ((L (-n), Wm, N n), FBF (1, Psibar, VL, Psi), G_CC); - ((N (-n), Wp, L n), FBF (1, Psibar, VL, Psi), G_CC); - ((L (-n), WHm, N n), FBF (1, Psibar, VL, Psi), G_CC_heavy); - ((N (-n), WHp, L n), FBF (1, Psibar, VL, Psi), G_CC_heavy); - ((D (-n), WHm, U n), FBF (1, Psibar, VL, Psi), G_CC_heavy); - ((U (-n), WHp, D n), FBF (1, Psibar, VL, Psi), G_CC_heavy)] - - let quark_currents n = - ([ ((D (-n), Wm, U n), FBF (1, Psibar, VL, Psi), G_CC); - ((U (-n), Wp, D n), FBF (1, Psibar, VL, Psi), G_CC)] - @ - (if Flags.u1_gauged then - [ ((U (-n), AH, U n), FBF (1, Psibar, VA, Psi), G_NC_h_up)] - else - [])) - - -(* We specialize the third generation since there is an additional shift - coming from the admixture of the heavy top quark. The universal shift, - coming from the mixing in the non-Abelian gauge boson sector is - unobservable. (Redefinition of coupling constants by measured ones. *) - - let yukawa = - [ ((U (-3), H, U 3), FBF (1, Psibar, S, Psi), G_Htt); - ((D (-3), H, D 3), FBF (1, Psibar, S, Psi), G_Hbb); - ((U (-2), H, U 2), FBF (1, Psibar, S, Psi), G_Hcc); - ((L (-3), H, L 3), FBF (1, Psibar, S, Psi), G_Htautau)] - - let yukawa_add' = - [ ((Toppb, H, Topp), FBF (1, Psibar, S, Psi), G_Hthth); - ((Toppb, H, U 3), FBF (1, Psibar, SLR, Psi), G_Htht); - ((U (-3), H, Topp), FBF (1, Psibar, SLR, Psi), G_Htht); - ((U (-3), Psi0, U 3), FBF (1, Psibar, S, Psi), G_Psi0tt); - ((D (-3), Psi0, D 3), FBF (1, Psibar, S, Psi), G_Psi0bb); - ((U (-2), Psi0, U 2), FBF (1, Psibar, S, Psi), G_Psi0cc); - ((L (-3), Psi0, L 3), FBF (1, Psibar, S, Psi), G_Psi0tautau); - ((U (-3), Psi1, U 3), FBF (1, Psibar, P, Psi), G_Psi1tt); - ((D (-3), Psi1, D 3), FBF (1, Psibar, P, Psi), G_Psi1bb); - ((U (-2), Psi1, U 2), FBF (1, Psibar, P, Psi), G_Psi1cc); - ((L (-3), Psi1, L 3), FBF (1, Psibar, P, Psi), G_Psi1tautau); - ((U (-3), Psip, D 3), FBF (1, Psibar, SLR, Psi), G_Psipq3); - ((U (-2), Psip, D 2), FBF (1, Psibar, SLR, Psi), G_Psipq2); - ((N (-3), Psip, L 3), FBF (1, Psibar, SR, Psi), G_Psipl3); - ((D (-3), Psim, U 3), FBF (1, Psibar, SLR, Psi), G_Psipq3); - ((D (-2), Psim, U 2), FBF (1, Psibar, SLR, Psi), G_Psipq2); - ((L (-3), Psim, N 3), FBF (1, Psibar, SL, Psi), G_Psipl3); - ((Toppb, Psi0, U 3), FBF (1, Psibar, SL, Psi), G_Psi0tth); - ((U (-3), Psi0, Topp), FBF (1, Psibar, SR, Psi), G_Psi0tth); - ((Toppb, Psi1, U 3), FBF (1, Psibar, SL, Psi), G_Psi1tth); - ((U (-3), Psi1, Topp), FBF (1, Psibar, SR, Psi), G_Psi1tth); - ((Toppb, Psip, D 3), FBF (1, Psibar, SL, Psi), G_Psipbth); - ((D (-3), Psim, Topp), FBF (1, Psibar, SR, Psi), G_Psipbth)] - - let yukawa_add = - if Flags.u1_gauged then - yukawa_add' - else - yukawa_add' @ - [ ((U (-3), Eta, U 3), FBF (1, Psibar, P, Psi), G_Ett); - ((Toppb, Eta, U 3), FBF (1, Psibar, SLR, Psi), G_Etht); - ((D (-3), Eta, D 3), FBF (1, Psibar, P, Psi), G_Ebb); - ((U (-3), Eta, Topp), FBF (1, Psibar, SLR, Psi), G_Etht)] - -(* \begin{equation} - \mathcal{L}_{\textrm{TGC}} = - - e \partial_\mu A_\nu W_+^\mu W_-^\nu + \ldots - - e \cot\theta_w \partial_\mu Z_\nu W_+^\mu W_-^\nu + \ldots - \end{equation} *) - -(* Check. *) - - let standard_triple_gauge = - [ ((Ga, Wm, Wp), Gauge_Gauge_Gauge 1, I_Q_W); - ((Z, Wm, Wp), Gauge_Gauge_Gauge 1, I_G_ZWW); - ((Gl, Gl, Gl), Gauge_Gauge_Gauge 1, I_Gs) ] - - let heavy_triple_gauge = - ([ ((Ga, WHm, WHp), Gauge_Gauge_Gauge 1, I_Q_W); - ((Z, WHm, WHp), Gauge_Gauge_Gauge 1, I_G_ZWW); - ((ZH, Wm, Wp), Gauge_Gauge_Gauge 1, I_G_ZHWW); - ((Z, WHm, Wp), Gauge_Gauge_Gauge 1, I_G_ZWHW); - ((Z, Wm, WHp), Gauge_Gauge_Gauge (-1), I_G_ZWHW); - ((ZH, WHm, Wp), Gauge_Gauge_Gauge 1, I_G_WWW); - ((ZH, Wm, WHp), Gauge_Gauge_Gauge (-1), I_G_WWW); - ((ZH, WHm, WHp), Gauge_Gauge_Gauge (-1), I_G_ZHWHWH)] - @ - (if Flags.u1_gauged then - [ ((AH, Wm, Wp), Gauge_Gauge_Gauge 1, I_G_AHWW); - ((AH, WHm, Wp), Gauge_Gauge_Gauge 1, I_G_AHWHW); - ((AH, Wm, WHp), Gauge_Gauge_Gauge (-1), I_G_AHWHW); - ((AH, WHm, WHp), Gauge_Gauge_Gauge 1, I_G_AHWHWH)] - else - [])) - - let triple_gauge = - standard_triple_gauge @ heavy_triple_gauge - - let gauge4 = Vector4 [(2, C_13_42); (-1, C_12_34); (-1, C_14_23)] - let minus_gauge4 = Vector4 [(-2, C_13_42); (1, C_12_34); (1, C_14_23)] - let standard_quartic_gauge = - [ (Wm, Wp, Wm, Wp), gauge4, G_WWWW; - (Wm, Z, Wp, Z), minus_gauge4, G_ZZWW; - (Wm, Z, Wp, Ga), minus_gauge4, G_AZWW; - (Wm, Ga, Wp, Ga), minus_gauge4, G_AAWW; - (Gl, Gl, Gl, Gl), gauge4, G2] - - let heavy_quartic_gauge = - [ (WHm, Wp, WHm, Wp), gauge4, G_WWWW; - (Wm, WHp, Wm, WHp), gauge4, G_WWWW; - (WHm, WHp, WHm, WHp), gauge4, G_WH4; - (Wm, Wp, WHm, WHp), gauge4, G_WHWHWW; - (Wm, Wp, Wm, WHp), gauge4, G_WHWWW; - (Wm, Wp, WHm, Wp), gauge4, G_WHWWW; - (WHm, WHp, Wm, WHp), gauge4, G_WH3W; - (WHm, WHp, WHm, Wp), gauge4, G_WH3W; - (WHm, Z, WHp, Z), minus_gauge4, G_ZZWW; - (WHm, Z, WHp, Ga), minus_gauge4, G_AZWW; - (WHm, Ga, WHp, ZH), minus_gauge4, G_AAWW; - (WHm, Z, WHp, ZH), minus_gauge4, G_ZZWW; - (Wm, ZH, Wp, ZH), minus_gauge4, G_WWWW; - (Wm, Ga, Wp, ZH), minus_gauge4, G_WWAZH; - (Wm, Z, Wp, ZH), minus_gauge4, G_WWZZH; - (WHm, Ga, WHp, ZH), minus_gauge4, G_WHWHAZH; - (WHm, Z, WHp, ZH), minus_gauge4, G_WHWHZZH; - (WHm, ZH, WHm, ZH), minus_gauge4, G_WH4; - (WHm, Z, Wp, Z), minus_gauge4, G_WHWZZ; - (Wm, Z, WHp, Z), minus_gauge4, G_WHWZZ; - (WHm, Ga, Wp, Z), minus_gauge4, G_WHWAZ; - (Wm, Ga, WHp, Z), minus_gauge4, G_WHWAZ; - (WHm, ZH, Wp, ZH), minus_gauge4, G_WHWZHZH; - (Wm, ZH, WHp, ZH), minus_gauge4, G_WHWZHZH; - (WHm, Ga, Wp, ZH), minus_gauge4, G_WHWAZH; - (Wm, Ga, WHp, ZH), minus_gauge4, G_WHWAZH; - (WHm, Z, Wp, ZH), minus_gauge4, G_WHWZZH; - (Wm, Z, WHp, ZH), minus_gauge4, G_WHWZZH] - @ - (if Flags.u1_gauged then - [ (Wm, Ga, Wp, AH), minus_gauge4, G_WWAAH; - (Wm, Z, Wp, AH), minus_gauge4, G_WWZAH; - (WHm, Ga, WHp, AH), minus_gauge4, G_WHWHAAH; - (WHm, Z, WHp, AH), minus_gauge4, G_WHWHZAH; - (Wm, ZH, Wp, AH), minus_gauge4, G_WWZHAH; - (WHm, ZH, WHp, AH), minus_gauge4, G_WHWHZHAH; - (WHm, Ga, Wp, AH), minus_gauge4, G_WHWAAH; - (Wm, Ga, WHp, AH), minus_gauge4, G_WHWAAH; - (WHm, Z, Wp, AH), minus_gauge4, G_WHWZAH; - (Wm, Z, WHp, AH), minus_gauge4, G_WHWZAH; - (WHm, ZH, Wp, AH), minus_gauge4, G_WHWZHAH; - (Wm, ZH, WHp, AH), minus_gauge4, G_WHWZHAH] - else - []) - - let quartic_gauge = - standard_quartic_gauge @ heavy_quartic_gauge - - let standard_gauge_higgs' = - [ ((H, Wp, Wm), Scalar_Vector_Vector 1, G_HWW); - ((H, Z, Z), Scalar_Vector_Vector 1, G_HZZ) ] - - let heavy_gauge_higgs = - [ ((H, Wp, WHm), Scalar_Vector_Vector 1, G_HWHW); - ((H, WHp, Wm), Scalar_Vector_Vector 1, G_HWHW); - ((H, WHp, WHm), Scalar_Vector_Vector 1, G_HWHWH); - ((H, ZH, ZH), Scalar_Vector_Vector 1, G_HWHWH); - ((H, ZH, Z), Scalar_Vector_Vector 1, G_HZHZ); - ((H, Wp, Wm), Scalar_Vector_Vector 1, G_HZHAH)] - @ - (if Flags.u1_gauged then - [((H, AH, AH), Scalar_Vector_Vector 1, G_HAHAH); - ((H, Z, AH), Scalar_Vector_Vector 1, G_HAHZ)] - else - []) - - let triplet_gauge_higgs = - [ ((Psi0, Wp, Wm), Scalar_Vector_Vector 1, G_PsiWW); - ((Psi0, WHp, WHm), Scalar_Vector_Vector (-1), G_PsiWW); - ((Psi0, WHp, Wm), Scalar_Vector_Vector 1, G_PsiWHW); - ((Psi0, WHm, Wp), Scalar_Vector_Vector 1, G_PsiWHW); - ((Psi0, Z, Z), Scalar_Vector_Vector 1, G_PsiZZ); - ((Psi0, ZH, ZH), Scalar_Vector_Vector 1, G_PsiZHZH); - ((Psi0, ZH, Z), Scalar_Vector_Vector 1, G_PsiZHZ); - ((Psim, Wp, Z), Scalar_Vector_Vector 1, G_PsiZW); - ((Psip, Wm, Z), Scalar_Vector_Vector 1, G_PsiZW); - ((Psim, WHp, Z), Scalar_Vector_Vector 1, G_PsiZWH); - ((Psip, WHm, Z), Scalar_Vector_Vector 1, G_PsiZWH); - ((Psim, Wp, ZH), Scalar_Vector_Vector 1, G_PsiZHW); - ((Psip, Wm, ZH), Scalar_Vector_Vector 1, G_PsiZHW); - ((Psim, WHp, ZH), Scalar_Vector_Vector 1, G_PsiZHWH); - ((Psip, WHm, ZH), Scalar_Vector_Vector 1, G_PsiZHWH); - ((Psimm, Wp, Wp), Scalar_Vector_Vector 1, G_PsippWW); - ((Psipp, Wm, Wm), Scalar_Vector_Vector 1, G_PsippWW); - ((Psimm, WHp, Wp), Scalar_Vector_Vector 1, G_PsippWHW); - ((Psipp, WHm, Wm), Scalar_Vector_Vector 1, G_PsippWHW); - ((Psimm, WHp, WHp), Scalar_Vector_Vector 1, G_PsippWHWH); - ((Psipp, WHm, WHm), Scalar_Vector_Vector 1, G_PsippWHWH)] - @ - (if Flags.u1_gauged then - [((Psi0, AH, Z), Scalar_Vector_Vector 1, G_PsiZAH); - ((Psi0, AH, ZH), Scalar_Vector_Vector 1, G_PsiZHAH); - ((Psi0, AH, AH), Scalar_Vector_Vector 1, G_PsiAHAH); - ((Psim, Wp, AH), Scalar_Vector_Vector 1, G_PsiAHW); - ((Psip, Wm, AH), Scalar_Vector_Vector 1, G_PsiAHW); - ((Psim, WHp, AH), Scalar_Vector_Vector 1, G_PsiAHWH); - ((Psip, WHm, AH), Scalar_Vector_Vector 1, G_PsiAHWH)] - else - []) - - let triplet_gauge2_higgs = - [ ((Wp, H, Psim), Vector_Scalar_Scalar 1, G_PsiHW); - ((Wm, H, Psip), Vector_Scalar_Scalar 1, G_PsiHW); - ((WHp, H, Psim), Vector_Scalar_Scalar 1, G_PsiHWH); - ((WHm, H, Psip), Vector_Scalar_Scalar 1, G_PsiHWH); - ((Wp, Psi0, Psim), Vector_Scalar_Scalar 1, G_Psi0W); - ((Wm, Psi0, Psip), Vector_Scalar_Scalar 1, G_Psi0W); - ((WHp, Psi0, Psim), Vector_Scalar_Scalar 1, G_Psi0WH); - ((WHm, Psi0, Psip), Vector_Scalar_Scalar 1, G_Psi0WH); - ((Wp, Psi1, Psim), Vector_Scalar_Scalar 1, G_Psi1W); - ((Wm, Psi1, Psip), Vector_Scalar_Scalar (-1), G_Psi1W); - ((WHp, Psi1, Psim), Vector_Scalar_Scalar 1, G_Psi1WH); - ((WHm, Psi1, Psip), Vector_Scalar_Scalar (-1), G_Psi1WH); - ((Wp, Psip, Psimm), Vector_Scalar_Scalar 1, G_PsiPPW); - ((Wm, Psim, Psipp), Vector_Scalar_Scalar 1, G_PsiPPW); - ((WHp, Psip, Psimm), Vector_Scalar_Scalar 1, G_PsiPPWH); - ((WHm, Psim, Psipp), Vector_Scalar_Scalar 1, G_PsiPPWH); - ((Ga, Psip, Psim), Vector_Scalar_Scalar 1, Q_lepton); - ((Ga, Psipp, Psimm), Vector_Scalar_Scalar 2, Q_lepton); - ((Z, H, Psi1), Vector_Scalar_Scalar 1, G_Psi1HZ); - ((ZH, H, Psi1), Vector_Scalar_Scalar 1, G_Psi1HZH); - ((Z, Psi0, Psi1), Vector_Scalar_Scalar 1, G_Psi01Z); - ((ZH, Psi0, Psi1), Vector_Scalar_Scalar 1, G_Psi01ZH); - ((Z, Psip, Psim), Vector_Scalar_Scalar 1, G_ZPsip); - ((Z, Psipp, Psimm), Vector_Scalar_Scalar 2, G_ZPsipp); - ((ZH, Psipp, Psimm), Vector_Scalar_Scalar 2, G_ZHPsipp)] - @ - (if Flags.u1_gauged then - [((AH, H, Psi1), Vector_Scalar_Scalar 1, G_Psi1HAH); - ((AH, Psi0, Psi1), Vector_Scalar_Scalar 1, G_Psi01AH); - ((AH, Psip, Psim), Vector_Scalar_Scalar 1, G_AHPsip); - ((AH, Psipp, Psimm), Vector_Scalar_Scalar 2, G_AHPsip)] - else []) - - let standard_gauge_higgs = - standard_gauge_higgs' @ heavy_gauge_higgs @ triplet_gauge_higgs @ - triplet_gauge2_higgs - - let standard_gauge_higgs4 = - [ (H, H, Wp, Wm), Scalar2_Vector2 1, G_HHWW; - (H, H, Z, Z), Scalar2_Vector2 1, G_HHZZ ] - - let littlest_gauge_higgs4 = - [ (H, H, WHp, WHm), Scalar2_Vector2 (-1), G_HHWW; - (H, H, ZH, ZH), Scalar2_Vector2 (-1), G_HHWW; - (H, H, Wp, WHm), Scalar2_Vector2 1, G_HHWHW; - (H, H, WHp, Wm), Scalar2_Vector2 1, G_HHWHW; - (H, H, ZH, Z), Scalar2_Vector2 (-1), G_HHZHZ; - (H, Psi0, Wp, Wm), Scalar2_Vector2 1, G_HPsi0WW; - (H, Psi0, WHp, WHm), Scalar2_Vector2 (-1), G_HPsi0WW; - (H, Psi0, WHp, Wm), Scalar2_Vector2 1, G_HPsi0WHW; - (H, Psi0, Wp, WHm), Scalar2_Vector2 1, G_HPsi0WHW; - (H, Psi0, Z, Z), Scalar2_Vector2 1, G_HPsi0ZZ; - (H, Psi0, ZH, ZH), Scalar2_Vector2 1, G_HPsi0ZHZH; - (H, Psi0, ZH, Z), Scalar2_Vector2 1, G_HPsi0ZHZ; - (H, Psim, Wp, Ga), Scalar2_Vector2 1, G_HPsipWA; - (H, Psip, Wm, Ga), Scalar2_Vector2 1, G_HPsipWA; - (H, Psim, WHp, Ga), Scalar2_Vector2 1, G_HPsipWHA; - (H, Psip, WHm, Ga), Scalar2_Vector2 1, G_HPsipWHA; - (H, Psim, Wp, Z), Scalar2_Vector2 1, G_HPsipWZ; - (H, Psip, Wm, Z), Scalar2_Vector2 1, G_HPsipWZ; - (H, Psim, WHp, Z), Scalar2_Vector2 1, G_HPsipWHZ; - (H, Psip, WHm, Z), Scalar2_Vector2 1, G_HPsipWHZ; - (H, Psim, Wp, ZH), Scalar2_Vector2 1, G_HPsipWZH; - (H, Psip, Wm, ZH), Scalar2_Vector2 1, G_HPsipWZH; - (H, Psim, WHp, ZH), Scalar2_Vector2 1, G_HPsipWHZH; - (H, Psip, WHm, ZH), Scalar2_Vector2 1, G_HPsipWHZH; - (H, Psimm, Wp, Wp), Scalar2_Vector2 1, G_HPsippWW; - (H, Psipp, Wm, Wm), Scalar2_Vector2 1, G_HPsippWW; - (H, Psimm, WHp, WHp), Scalar2_Vector2 1, G_HPsippWHWH; - (H, Psipp, WHm, WHm), Scalar2_Vector2 1, G_HPsippWHWH; - (H, Psimm, WHp, Wp), Scalar2_Vector2 1, G_HPsippWHW; - (H, Psipp, WHm, Wm), Scalar2_Vector2 1, G_HPsippWHW; - (Psi0, Psi0, Wp, Wm), Scalar2_Vector2 2, G_HHWW; - (Psi0, Psi0, WHp, WHm), Scalar2_Vector2 (-2), G_HHWW; - (Psi0, Psi0, Z, Z), Scalar2_Vector2 4, G_HHZZ; - (Psi0, Psi0, ZH, ZH), Scalar2_Vector2 1, G_Psi00ZH; - (Psi0, Psi0, WHp, Wm), Scalar2_Vector2 2, G_HHWHW; - (Psi0, Psi0, Wp, WHm), Scalar2_Vector2 2, G_HHWHW; - (Psi0, Psi0, Z, ZH), Scalar2_Vector2 4, G_HHZHZ; - (Psi0, Psim, Wp, Ga), Scalar2_Vector2 1, G_Psi0pWA; - (Psi0, Psip, Wm, Ga), Scalar2_Vector2 1, G_Psi0pWA; - (Psi0, Psim, WHp, Ga), Scalar2_Vector2 1, G_Psi0pWHA; - (Psi0, Psip, WHm, Ga), Scalar2_Vector2 1, G_Psi0pWHA; - (Psi0, Psim, Wp, Z), Scalar2_Vector2 1, G_Psi0pWZ; - (Psi0, Psip, Wm, Z), Scalar2_Vector2 1, G_Psi0pWZ; - (Psi0, Psim, WHp, Z), Scalar2_Vector2 1, G_Psi0pWHZ; - (Psi0, Psip, WHm, Z), Scalar2_Vector2 1, G_Psi0pWHZ; - (Psi0, Psim, Wp, ZH), Scalar2_Vector2 1, G_Psi0pWZH; - (Psi0, Psip, Wm, ZH), Scalar2_Vector2 1, G_Psi0pWZH; - (Psi0, Psim, WHp, ZH), Scalar2_Vector2 1, G_Psi0pWHZH; - (Psi0, Psip, WHm, ZH), Scalar2_Vector2 1, G_Psi0pWHZH; - (Psi0, Psimm, Wp, Wp), Scalar2_Vector2 1, G_Psi0ppWW; - (Psi0, Psipp, Wm, Wm), Scalar2_Vector2 1, G_Psi0ppWW; - (Psi0, Psimm, WHp, WHp), Scalar2_Vector2 1, G_Psi0ppWHWH; - (Psi0, Psipp, WHm, WHm), Scalar2_Vector2 1, G_Psi0ppWHWH; - (Psi0, Psimm, WHp, Wp), Scalar2_Vector2 1, G_Psi0ppWHW; - (Psi0, Psipp, WHm, Wm), Scalar2_Vector2 1, G_Psi0ppWHW; - (Psi1, Psi1, Wp, Wm), Scalar2_Vector2 2, G_HHWW; - (Psi1, Psi1, WHp, WHm), Scalar2_Vector2 (-2), G_HHWW; - (Psi1, Psi1, Z, Z), Scalar2_Vector2 4, G_HHZZ; - (Psi1, Psi1, ZH, ZH), Scalar2_Vector2 1, G_Psi00ZH; - (Psi1, Psi1, WHp, Wm), Scalar2_Vector2 2, G_HHWHW; - (Psi1, Psi1, Wp, WHm), Scalar2_Vector2 2, G_HHWHW; - (Psi1, Psi1, Z, ZH), Scalar2_Vector2 4, G_HHZHZ; - (Psi1, Psim, Wp, Ga), Scalar2_Vector2 1, I_G_Psi0pWA; - (Psi1, Psip, Wm, Ga), Scalar2_Vector2 (-1), I_G_Psi0pWA; - (Psi1, Psim, WHp, Ga), Scalar2_Vector2 1, I_G_Psi0pWHA; - (Psi1, Psip, WHm, Ga), Scalar2_Vector2 (-1), I_G_Psi0pWHA; - (Psi1, Psim, Wp, Z), Scalar2_Vector2 1, I_G_Psi0pWZ; - (Psi1, Psip, Wm, Z), Scalar2_Vector2 (-1), I_G_Psi0pWZ; - (Psi1, Psim, WHp, Z), Scalar2_Vector2 1, I_G_Psi0pWHZ; - (Psi1, Psip, WHm, Z), Scalar2_Vector2 (-1), I_G_Psi0pWHZ; - (Psi1, Psim, Wp, ZH), Scalar2_Vector2 1, I_G_Psi0pWZH; - (Psi1, Psip, Wm, ZH), Scalar2_Vector2 (-1), I_G_Psi0pWZH; - (Psi1, Psim, WHp, ZH), Scalar2_Vector2 1, I_G_Psi0pWHZH; - (Psi1, Psip, WHm, ZH), Scalar2_Vector2 (-1), I_G_Psi0pWHZH; - (Psi1, Psimm, Wp, Wp), Scalar2_Vector2 1, I_G_Psi0ppWW; - (Psi1, Psipp, Wm, Wm), Scalar2_Vector2 (-1), I_G_Psi0ppWW; - (Psi1, Psimm, WHp, WHp), Scalar2_Vector2 1, I_G_Psi0ppWHWH; - (Psi1, Psipp, WHm, WHm), Scalar2_Vector2 (-1), I_G_Psi0ppWHWH; - (Psi1, Psimm, WHp, Wp), Scalar2_Vector2 1, I_G_Psi0ppWHW; - (Psi1, Psipp, WHm, Wm), Scalar2_Vector2 (-1), I_G_Psi0ppWHW; - (Psip, Psim, Wp, Wm), Scalar2_Vector2 4, G_HHWW; - (Psip, Psim, WHp, WHm), Scalar2_Vector2 1, G_Psi00ZH; - (Psip, Psim, WHp, Wm), Scalar2_Vector2 4, G_HHWHW; - (Psip, Psim, Wp, WHm), Scalar2_Vector2 4, G_HHWHW; - (Psip, Psim, Z, Z), Scalar2_Vector2 1, G_PsippZZ; - (Psip, Psim, Ga, Ga), Scalar2_Vector2 2, G_AAWW; - (Psip, Psim, ZH, ZH), Scalar2_Vector2 1, G_PsippZHZH; - (Psip, Psim, Ga, Z), Scalar2_Vector2 4, G_PsippAZ; - (Psip, Psimm, Wp, Ga), Scalar2_Vector2 1, G_PsippWA; - (Psim, Psipp, Wm, Ga), Scalar2_Vector2 1, G_PsippWA; - (Psip, Psimm, WHp, Ga), Scalar2_Vector2 1, G_PsippWHA; - (Psim, Psipp, WHm, Ga), Scalar2_Vector2 1, G_PsippWHA; - (Psip, Psimm, Wp, Z), Scalar2_Vector2 1, G_PsippWZ; - (Psim, Psipp, Wm, Z), Scalar2_Vector2 1, G_PsippWZ; - (Psip, Psimm, WHp, Z), Scalar2_Vector2 1, G_PsippWHZ; - (Psim, Psipp, WHm, Z), Scalar2_Vector2 1, G_PsippWHZ; - (Psip, Psimm, Wp, ZH), Scalar2_Vector2 1, G_PsippWZH; - (Psim, Psipp, Wm, ZH), Scalar2_Vector2 1, G_PsippWZH; - (Psip, Psimm, WHp, ZH), Scalar2_Vector2 1, G_PsippWHZH; - (Psim, Psipp, WHm, ZH), Scalar2_Vector2 1, G_PsippWHZH; - (Psipp, Psimm, Wp, Wm), Scalar2_Vector2 2, G_HHWW; - (Psipp, Psimm, WHp, WHm), Scalar2_Vector2 (-2), G_HHWW; - (Psipp, Psimm, WHp, Wm), Scalar2_Vector2 2, G_HHWHW; - (Psipp, Psimm, Wp, WHm), Scalar2_Vector2 2, G_HHWHW; - (Psipp, Psimm, Z, Z), Scalar2_Vector2 1, G_PsiccZZ; - (Psipp, Psimm, Ga, Ga), Scalar2_Vector2 8, G_AAWW; - (Psipp, Psimm, ZH, ZH), Scalar2_Vector2 1, G_Psi00ZH; - (Psipp, Psimm, Ga, Z), Scalar2_Vector2 1, G_PsiccAZ; - (Psipp, Psimm, Z, ZH), Scalar2_Vector2 4, G_PsiccZZH; - (Psipp, Psimm, Ga, ZH), Scalar2_Vector2 4, G_PsiccAZH] - @ - (if Flags.u1_gauged then - [(H, H, AH, AH), Scalar2_Vector2 1, G_HHAA; - (H, H, AH, Z), Scalar2_Vector2 (-1), G_HHAHZ; - (H, H, ZH, AH), Scalar2_Vector2 (-1), G_HHZHAH; - (H, Psi0, AH, AH), Scalar2_Vector2 1, G_HPsi0AHAH; - (H, Psi0, Z, AH), Scalar2_Vector2 1, G_HPsi0ZAH; - (H, Psi0, ZH, AH), Scalar2_Vector2 1, G_HPsi0ZHAH; - (H, Psim, Wp, AH), Scalar2_Vector2 1, G_HPsipWAH; - (H, Psip, Wm, AH), Scalar2_Vector2 1, G_HPsipWAH; - (H, Psim, WHp, AH), Scalar2_Vector2 1, G_HPsipWHAH; - (H, Psip, WHm, AH), Scalar2_Vector2 1, G_HPsipWHAH; - (Psi0, Psi0, AH, AH), Scalar2_Vector2 1, G_Psi00AH; - (Psi0, Psi0, Z, AH), Scalar2_Vector2 4, G_HHAHZ; - (Psi0, Psi0, AH, ZH), Scalar2_Vector2 1, G_Psi00ZHAH; - (Psi0, Psim, Wp, AH), Scalar2_Vector2 1, G_Psi0pWAH; - (Psi0, Psip, Wm, AH), Scalar2_Vector2 1, G_Psi0pWAH; - (Psi0, Psim, WHp, AH), Scalar2_Vector2 1, G_Psi0pWHAH; - (Psi0, Psip, WHm, AH), Scalar2_Vector2 1, G_Psi0pWHAH; - (Psi1, Psi1, AH, AH), Scalar2_Vector2 1, G_Psi00AH; - (Psi1, Psi1, Z, AH), Scalar2_Vector2 4, G_HHAHZ; - (Psi1, Psi1, AH, ZH), Scalar2_Vector2 1, G_Psi00ZHAH; - (Psi1, Psim, Wp, AH), Scalar2_Vector2 1, I_G_Psi0pWAH; - (Psi1, Psip, Wm, AH), Scalar2_Vector2 (-1), I_G_Psi0pWAH; - (Psi1, Psim, WHp, AH), Scalar2_Vector2 1, I_G_Psi0pWHAH; - (Psi1, Psip, WHm, AH), Scalar2_Vector2 (-1), I_G_Psi0pWHAH; - (Psip, Psim, AH, AH), Scalar2_Vector2 1, G_Psi00AH; - (Psip, Psim, Ga, AH), Scalar2_Vector2 4, G_PsippAAH; - (Psip, Psim, Z, AH), Scalar2_Vector2 4, G_PsippZAH; - (Psip, Psimm, Wp, AH), Scalar2_Vector2 1, G_PsippWAH; - (Psim, Psipp, Wm, AH), Scalar2_Vector2 1, G_PsippWAH; - (Psip, Psimm, WHp, AH), Scalar2_Vector2 1, G_PsippWHAH; - (Psim, Psipp, WHm, AH), Scalar2_Vector2 1, G_PsippWHAH; - (Psipp, Psimm, AH, AH), Scalar2_Vector2 1, G_Psi00AH; - (Psipp, Psimm, AH, ZH), Scalar2_Vector2 (-1), G_Psi00ZHAH; - (Psipp, Psimm, Ga, AH), Scalar2_Vector2 4, G_PsiccAAH; - (Psipp, Psimm, Z, AH), Scalar2_Vector2 4, G_PsiccZAH] - else []) - - let standard_higgs = - [ (H, H, H), Scalar_Scalar_Scalar 1, G_H3 ] - - let anomaly_higgs = - [ (Eta, Gl, Gl), Dim5_Scalar_Gauge2_Skew 1, G_EGlGl; - (Eta, Ga, Ga), Dim5_Scalar_Gauge2_Skew 1, G_EGaGa; - (Eta, Ga, Z), Dim5_Scalar_Gauge2_Skew 1, G_EGaZ] -(* @ [ (H, Ga, Ga), Dim5_Scalar_Gauge2 1, G_HGaGa; - (H, Ga, Z), Dim5_Scalar_Gauge2 1, G_HGaZ ] *) - - let standard_higgs4 = - [ (H, H, H, H), Scalar4 1, G_H4 ] - - let gauge_higgs = - standard_gauge_higgs - - let gauge_higgs4 = - standard_gauge_higgs4 - - let higgs = - standard_higgs - - let higgs4 = - standard_higgs4 - - let top_quartic = - [ ((U (-3), H, H, U 3), GBBG (1, Psibar, S2, Psi), G_HHtt); - ((Toppb, H, H, Topp), GBBG (1, Psibar, S2, Psi), G_HHthth); - ((U (-3), H, H, Topp), GBBG (1, Psibar, S2LR, Psi), G_HHtht); - ((Toppb, H, H, U 3), GBBG (1, Psibar, S2LR, Psi), G_HHtht)] - - let goldstone_vertices = - [ ((Phi0, Wm, Wp), Scalar_Vector_Vector 1, I_G_ZWW); - ((Phip, Ga, Wm), Scalar_Vector_Vector 1, I_Q_W); - ((Phip, Z, Wm), Scalar_Vector_Vector 1, I_G_ZWW); - ((Phim, Wp, Ga), Scalar_Vector_Vector 1, I_Q_W); - ((Phim, Wp, Z), Scalar_Vector_Vector 1, I_G_ZWW) ] - - let vertices3 = - (ThoList.flatmap electromagnetic_currents [1;2;3] @ - ThoList.flatmap neutral_currents [1;2;3] @ - ThoList.flatmap color_currents [1;2;3] @ - ThoList.flatmap neutral_heavy_currents [1;2;3] @ - ThoList.flatmap charged_currents [1;2;3] @ - ThoList.flatmap quark_currents [1;2] @ - heavy_top_currents @ - (if Flags.u1_gauged then [] - else anomaly_higgs) @ - yukawa @ yukawa_add @ triple_gauge @ - gauge_higgs @ higgs @ goldstone_vertices) - - let vertices4 = - quartic_gauge @ gauge_higgs4 @ higgs4 @ top_quartic - - let vertices () = (vertices3, vertices4, []) - -(* For efficiency, make sure that [F.of_vertices vertices] is - evaluated only once. *) - - let table = F.of_vertices (vertices ()) - let fuse2 = F.fuse2 table - let fuse3 = F.fuse3 table - let fuse = F.fuse table - let max_degree () = 4 - - let flavor_of_string = function - | "e-" -> L 1 | "e+" -> L (-1) - | "mu-" -> L 2 | "mu+" -> L (-2) - | "tau-" -> L 3 | "tau+" -> L (-3) - | "nue" -> N 1 | "nuebar" -> N (-1) - | "numu" -> N 2 | "numubar" -> N (-2) - | "nutau" -> N 3 | "nutaubar" -> N (-3) - | "u" -> U 1 | "ubar" -> U (-1) - | "c" -> U 2 | "cbar" -> U (-2) - | "t" -> U 3 | "tbar" -> U (-3) - | "d" -> D 1 | "dbar" -> D (-1) - | "s" -> D 2 | "sbar" -> D (-2) - | "b" -> D 3 | "bbar" -> D (-3) - | "tp" -> Topp | "tpbar" -> Toppb - | "g" -> Gl - | "A" -> Ga | "Z" | "Z0" -> Z - | "AH" | "AH0" | "Ah" | "Ah0" -> AH - | "ZH" | "ZH0" | "Zh" | "Zh0" -> ZH - | "W+" -> Wp | "W-" -> Wm - | "WH+" -> WHp | "WH-" -> WHm - | "H" | "h" -> H | "eta" | "Eta" -> Eta - | "Psi" | "Psi0" | "psi" | "psi0" -> Psi0 - | "Psi1" | "psi1" -> Psi1 - | "Psi+" | "psi+" | "Psip" | "psip" -> Psip - | "Psi-" | "psi-" | "Psim" | "psim" -> Psim - | "Psi++" | "psi++" | "Psipp" | "psipp" -> Psipp - | "Psi--" | "psi--" | "Psimm" | "psimm" -> Psimm - | _ -> invalid_arg "Models4.Littlest_Tpar.flavor_of_string" - - let flavor_to_string = function - | L 1 -> "e-" | L (-1) -> "e+" - | L 2 -> "mu-" | L (-2) -> "mu+" - | L 3 -> "tau-" | L (-3) -> "tau+" - | L _ -> invalid_arg "Models4.Littlest_Tpar.flavor_to_string" - | N 1 -> "nue" | N (-1) -> "nuebar" - | N 2 -> "numu" | N (-2) -> "numubar" - | N 3 -> "nutau" | N (-3) -> "nutaubar" - | N _ -> invalid_arg "Models4.Littlest_Tpar.flavor_to_string" - | Lodd 1 -> "l1odd-" | Lodd (-1) -> "l1odd+" - | Lodd 2 -> "l2odd-" | Lodd (-2) -> "l2odd+" - | Lodd 3 -> "l3odd-" | Lodd (-3) -> "l3odd+" - | Lodd _ -> invalid_arg "Models4.Littlest_Tpar.flavor_to_string" - | Nodd 1 -> "n1odd" | Nodd (-1) -> "n1oddbar" - | Nodd 2 -> "n2odd" | Nodd (-2) -> "n2oddbar" - | Nodd 3 -> "n3odd" | Nodd (-3) -> "n3oddbar" - | Nodd _ -> invalid_arg "Models4.Littlest_Tpar.flavor_to_string" - | U 1 -> "u" | U (-1) -> "ubar" - | U 2 -> "c" | U (-2) -> "cbar" - | U 3 -> "t" | U (-3) -> "tbar" - | U _ -> invalid_arg "Models4.Littlest_Tpar.flavor_to_string" - | D 1 -> "d" | D (-1) -> "dbar" - | D 2 -> "s" | D (-2) -> "sbar" - | D 3 -> "b" | D (-3) -> "bbar" - | D _ -> invalid_arg "Models4.Littlest_Tpar.flavor_to_string" - | Uodd 1 -> "uodd" | Uodd (-1) -> "uoddbar" - | Uodd 2 -> "codd" | Uodd (-2) -> "coddbar" - | Uodd 3 -> "t1odd" | Uodd (-3) -> "t1oddbar" - | Uodd 4 -> "t2odd" | Uodd (-4) -> "t2oddbar" - | Uodd _ -> invalid_arg "Models4.Littlest_Tpar.flavor_to_string" - | Dodd 1 -> "dodd" | Dodd (-1) -> "doddbar" - | Dodd 2 -> "sodd" | Dodd (-2) -> "soddbar" - | Dodd 3 -> "bodd" | Dodd (-3) -> "boddbar" - | Dodd _ -> invalid_arg "Models4.Littlest_Tpar.flavor_to_string" - | Topp -> "tp" | Toppb -> "tpbar" - | Gl -> "g" - | Ga -> "A" | Z -> "Z" - | Wp -> "W+" | Wm -> "W-" - | ZH -> "ZH" | AH -> "AH" | WHp -> "WHp" | WHm -> "WHm" - | Phip -> "phi+" | Phim -> "phi-" | Phi0 -> "phi0" - | H -> "H" | Eta -> "Eta" - | Psi0 -> "Psi0" | Psi1 -> "Psi1" | Psip -> "Psi+" - | Psim -> "Psi-" | Psipp -> "Psi++" | Psimm -> "Psi--" - - let flavor_symbol = function - | L n when n > 0 -> "l" ^ string_of_int n - | L n -> "l" ^ string_of_int (abs n) ^ "b" - | Lodd n when n > 0 -> "lodd" ^ string_of_int n - | Lodd n -> "lodd" ^ string_of_int (abs n) ^ "b" - | N n when n > 0 -> "n" ^ string_of_int n - | N n -> "n" ^ string_of_int (abs n) ^ "b" - | Nodd n when n > 0 -> "nodd" ^ string_of_int n - | Nodd n -> "nodd" ^ string_of_int (abs n) ^ "b" - | U n when n > 0 -> "u" ^ string_of_int n - | U n -> "u" ^ string_of_int (abs n) ^ "b" - | D n when n > 0 -> "d" ^ string_of_int n - | D n -> "d" ^ string_of_int (abs n) ^ "b" - | Uodd n when n > 0 -> "uodd" ^ string_of_int n - | Uodd n -> "uodd" ^ string_of_int (abs n) ^ "b" - | Dodd n when n > 0 -> "dodd" ^ string_of_int n - | Dodd n -> "dodd" ^ string_of_int (abs n) ^ "b" - | Topp -> "tp" | Toppb -> "tpb" - | Gl -> "gl" - | Ga -> "a" | Z -> "z" - | Wp -> "wp" | Wm -> "wm" - | ZH -> "zh" | AH -> "ah" | WHp -> "whp" | WHm -> "whm" - | Phip -> "pp" | Phim -> "pm" | Phi0 -> "p0" - | H -> "h" | Eta -> "eta" - | Psi0 -> "psi0" | Psi1 -> "psi1" | Psip -> "psip" - | Psim -> "psim" | Psipp -> "psipp" | Psimm -> "psimm" - - let flavor_sans_color_of_string = flavor_of_string - let flavor_sans_color_to_string = flavor_to_string - let flavor_sans_color_symbol = flavor_symbol - -(* There are PDG numbers for Z', Z'', W', 32-34, respectively. - We just introduce a number 38 for Y0 as a Z'''. - As well, there is the number 8 for a t'. But we cheat a little bit and - take the number 35 which is reserved for a heavy scalar Higgs for the - Eta scalar. - For the heavy Higgs states we take 35 and 36 for the neutral ones, 37 for - the charged and 38 for the doubly-charged. - The pseudoscalar gets the 39. - For the odd fermions we add 40 to the values for the SM particles. -*) - - let pdg = function - | L n when n > 0 -> 9 + 2*n - | L n -> - 9 + 2*n - | N n when n > 0 -> 10 + 2*n - | N n -> - 10 + 2*n - | U n when n > 0 -> 2*n - | U n -> 2*n - | D n when n > 0 -> - 1 + 2*n - | D n -> 1 + 2*n - | Lodd n when n > 0 -> 49 + 2*n - | Lodd n -> - 49 + 2*n - | Nodd n when n > 0 -> 50 + 2*n - | Nodd n -> - 50 + 2*n - | Uodd n when n > 0 -> 40 + 2*n - | Uodd n -> -40 + 2*n - | Dodd n when n > 0 -> 39 + 2*n - | Dodd n -> -39 + 2*n - | Topp -> 8 | Toppb -> (-8) - | Gl -> 21 - | Ga -> 22 | Z -> 23 - | Wp -> 24 | Wm -> (-24) - | AH -> 32 | ZH -> 33 | WHp -> 34 | WHm -> (-34) - | Phip | Phim -> 27 | Phi0 -> 26 - | Psi0 -> 35 | Psi1 -> 36 | Psip -> 37 | Psim -> (-37) - | Psipp -> 38 | Psimm -> (-38) - | H -> 25 | Eta -> 39 - - let mass_symbol f = - "mass(" ^ string_of_int (abs (pdg f)) ^ ")" - - let width_symbol f = - "width(" ^ string_of_int (abs (pdg f)) ^ ")" - - let constant_symbol = function - | Unit -> "unit" | Pi -> "PI" | VHeavy -> "vheavy" - | Alpha_QED -> "alpha" | E -> "e" | G_weak -> "g" | Vev -> "vev" - | Sin2thw -> "sin2thw" | Sinthw -> "sinthw" | Costhw -> "costhw" - | Sinpsi -> "sinpsi" | Cospsi -> "cospsi" - | Atpsi -> "atpsi" | Sccs -> "sccs" - | Supp -> "vF" | Supp2 -> "v2F2" - | Q_lepton -> "qlep" | Q_up -> "qup" | Q_down -> "qdwn" - | Q_Z_up -> "qzup" - | G_ZHTHT -> "gzhtht" | G_ZTHT -> "gzhtht" - | G_AHTHTH -> "gahthth" | G_AHTHT -> "gahtht" | G_AHTT -> "gahtt" - | G_NC_lepton -> "gnclep" | G_NC_neutrino -> "gncneu" - | G_NC_up -> "gncup" | G_NC_down -> "gncdwn" - | G_CC -> "gcc" | G_CCtop -> "gcctop" | G_CC_heavy -> "gcch" - | G_CC_WH -> "gccwh" | G_CC_W -> "gccw" - | G_NC_h_lepton -> "gnchlep" | G_NC_h_neutrino -> "gnchneu" - | G_NC_h_up -> "gnchup" | G_NC_h_down -> "gnchdwn" - | G_NC_heavy -> "gnch" - | I_Q_W -> "iqw" | I_G_ZWW -> "igzww" | I_G_WWW -> "igwww" - | I_G_AHWW -> "igahww" | I_G_ZHWW -> "igzhww" | I_G_ZWHW -> "igzwhw" - | I_G_AHWHWH -> "igahwhwh" | I_G_ZHWHWH -> "igzhwhwh" - | I_G_AHWHW -> "igahwhw" - | I_Q_H -> "iqh" - | Gs -> "gs" | I_Gs -> "igs" | G2 -> "gs**2" - | G_WWWW -> "gw4" | G_ZZWW -> "gzzww" - | G_AZWW -> "gazww" | G_AAWW -> "gaaww" - | G_WH4 -> "gwh4" | G_WHWHWW -> "gwhwhww" | G_WHWWW -> "gwhwww" - | G_WH3W -> "gwh3w" - | G_WWAAH -> "gwwaah" | G_WWAZH -> "gwwazh" | G_WWZZH -> "gwwzzh" - | G_WWZAH -> "gwwzah" | G_WHWHAAH -> "gwhwhaah" - | G_WHWHAZH -> "gwhwhazh" | G_WHWHZZH -> "gwhwhzzh" - | G_WHWHZAH -> "gwhwhzah" - | G_WWZHAH -> "gwwzhah" | G_WHWHZHAH -> "gwhwhzhah" - | G_WHWZZ -> "gwhwzz" | G_WHWAZ -> "gwhwaz" - | G_WHWAAH -> "gwhwaah" | G_WHWZAH -> "gwhwzah" - | G_WHWZHZH -> "gwhwzhzh" | G_WHWZHAH -> "gwhwzhah" - | G_WHWAZH -> "gwhwazh" | G_WHWZZH -> "gwhwzzh" - | G_HWW -> "ghww" | G_HZZ -> "ghzz" - | G_HHWW -> "ghhww" | G_HHZZ -> "ghhzz" - | G_HWHW -> "ghwhw" | G_HWHWH -> "ghwhwh" | G_HAHAH -> "ghahah" - | G_HZHZ -> "ghzhz" | G_HZHAH -> "ghzhah" - | G_HAHZ -> "ghahz" - | G_Htt -> "ghtt" | G_Hbb -> "ghbb" - | G_Htautau -> "ghtautau" | G_Hcc -> "ghcc" - | G_Hthth -> "ghthth" | G_Htht -> "ghtht" - | G_HHtt -> "ghhtt" | G_HHthth -> "ghhthth" | G_HHtht -> "ghhtht" - | G_Psi0tt -> "gpsi0tt" | G_Psi0bb -> "gpsi0bb" - | G_Psi0cc -> "gpsi0cc" | G_Psi0tautau -> "gpsi0tautau" - | G_Psi1tt -> "gpsi1tt" | G_Psi1bb -> "gpsi1bb" - | G_Psi1cc -> "gpsi1cc" | G_Psi1tautau -> "gpsi1tautau" - | G_Psipq3 -> "gpsipq3" | G_Psipq2 -> "gpsipq2" | G_Psipl3 -> "gpsil3" - | G_Psi0tth -> "gpsi0tth" | G_Psi1tth -> "gpsi1tth" - | G_Psipbth -> "gpsipbth" - | G_Ethth -> "gethth" | G_Etht -> "getht" - | G_Ett -> "gett" | G_Ebb -> "gebb" - | G_HGaGa -> "ghgaga" | G_HGaZ -> "ghgaz" - | G_EGaGa -> "geaa" | G_EGaZ -> "geaz" | G_EGlGl -> "gegg" - | G_H3 -> "gh3" | G_H4 -> "gh4" - | G_PsiWW -> "gpsiww" | G_PsiWHW -> "gpsiwhw" - | G_PsiZZ -> "gpsizz" | G_PsiZHZH -> "gpsizhzh" - | G_PsiZHZ -> "gpsizhz" | G_PsiZAH -> "gpsizah" - | G_PsiZHAH -> "gpsizhah" | G_PsiAHAH -> "gpsiahah" - | G_PsiZW -> "gpsizw" | G_PsiZWH -> "gpsizwh" | G_PsiAHW -> "gpsiahw" - | G_PsiAHWH -> "gpsiahwh" | G_PsiZHW -> "gpsizhw" - | G_PsiZHWH -> "gpsizhwh" - | G_PsippWW -> "gpsippww" | G_PsippWHW -> "gpsippwhw" - | G_PsippWHWH -> "gpsippwhwh" - | G_PsiHW -> "gpsihw" | G_PsiHWH -> "gpsihwh" - | G_Psi0W -> "gpsi0w" | G_Psi0WH -> "gpsi0wh" - | G_Psi1W -> "gpsi1w" | G_Psi1WH -> "gpsi1wh" - | G_PsiPPW -> "gpsippw" | G_PsiPPWH -> "gpsippwh" - | G_Psi1HAH -> "gpsihah" | G_Psi01AH -> "gpsi0ah" - | G_AHPsip -> "gahpsip" | G_Psi1HZ -> "gpsi1hz" - | G_Psi1HZH -> "gpsi1hzh" | G_Psi01Z -> "gpsi01z" - | G_Psi01ZH -> "gpsi01zh" | G_ZPsip -> "gzpsip" - | G_ZPsipp -> "gzpsipp" | G_ZHPsipp -> "gzhpsipp" - | G_HHAA -> "ghhaa" | G_HHWHW -> "ghhwhw" | G_HHZHZ -> "ghhzhz" - | G_HHAHZ -> "ghhahz" | G_HHZHAH -> "ghhzhah" - | G_HPsi0WW -> "ghpsi0ww" | G_HPsi0WHW -> "ghpsi0whw" - | G_HPsi0ZZ -> "ghpsi0zz" | G_HPsi0ZHZH -> "ghpsi0zhzh" - | G_HPsi0ZHZ -> "ghpsi0zhz" | G_HPsi0AHAH -> "ghpsi0ahah" - | G_HPsi0ZAH -> "ghpsi0zah" | G_HPsi0ZHAH -> "ghpsi0zhah" - | G_HPsipWA -> "ghpsipwa" | G_HPsipWHA -> "ghpsipwha" - | G_HPsipWZ -> "ghpsipwz" | G_HPsipWHZ -> "ghpsiwhz" - | G_HPsipWAH -> "ghpsipwah" | G_HPsipWHAH -> "ghpsipwhah" - | G_HPsipWZH -> "ghpsipwzh" | G_HPsipWHZH -> "ghpsipwhzh" - | G_HPsippWW -> "ghpsippww" | G_HPsippWHWH -> "ghpsippwhwh" - | G_HPsippWHW -> "ghpsippwhw" | G_Psi00ZH -> "gpsi00zh" - | G_Psi00AH -> "gpsi00ah" | G_Psi00ZHAH -> "gpsi00zhah" - | G_Psi0pWA -> "gpsi0pwa" | G_Psi0pWHA -> "gpsi0pwha" - | G_Psi0pWZ -> "gpsi0pwz" | G_Psi0pWHZ -> "gpsi0pwhz" - | G_Psi0pWAH -> "gpsi0pwah" | G_Psi0pWHAH -> "gpsi0pwhah" - | G_Psi0pWZH -> "gpsi0pwzh" | G_Psi0pWHZH -> "gpsi0pwhzh" - | G_Psi0ppWW -> "gpsi0ppww" | G_Psi0ppWHWH -> "gpsi0ppwhwh" - | G_Psi0ppWHW -> "gpsi0ppwhw" - | I_G_Psi0pWA -> "i_gpsi0pwa" | I_G_Psi0pWHA -> "i_gpsi0pwha" - | I_G_Psi0pWZ -> "i_gpsi0pwz" | I_G_Psi0pWHZ -> "i_gpsi0pwhz" - | I_G_Psi0pWAH -> "i_gpsi0pwah" | I_G_Psi0pWHAH -> "i_gpsi0pwhah" - | I_G_Psi0pWZH -> "i_gpsi0pwzh" | I_G_Psi0pWHZH -> "i_gpsi0pwhzh" - | I_G_Psi0ppWW -> "i_gpsi0ppww" | I_G_Psi0ppWHWH -> "i_gpsi0ppwhwh" - | I_G_Psi0ppWHW -> "i_gpsi0ppwhw" - | G_PsippZZ -> "gpsippzz" | G_PsippZHZH -> "gpsippzhzh" - | G_PsippAZ -> "gpsippaz" | G_PsippAAH -> "gpsippaah" - | G_PsippZAH -> "gpsippzah" - | G_PsippWA -> "gpsippwa" | G_PsippWHA -> "gpsippwha" - | G_PsippWZ -> "gpsippwz" | G_PsippWHZ -> "gpsippwhz" - | G_PsippWAH -> "gpsippwah" | G_PsippWHAH -> "gpsippwhah" - | G_PsippWZH -> "gpsippwzh" | G_PsippWHZH -> "gpsippwhzh" - | G_PsiccZZ -> "gpsicczz" | G_PsiccAZ -> "gpsiccaz" - | G_PsiccAAH -> "gpsiccaah" | G_PsiccZZH -> "gpsicczzh" - | G_PsiccAZH -> "gpsiccazh" | G_PsiccZAH -> "gpsicczah" - | Mass f -> "mass" ^ flavor_symbol f - | Width f -> "width" ^ flavor_symbol f - end - -module Simplest (Flags : BSM_flags) = - struct - let rcs = rcs_file - - open Coupling - - let default_width = ref Timelike - let use_fudged_width = ref false - - let options = Options.create - [ "constant_width", Arg.Unit (fun () -> default_width := Constant), - "use constant width (also in t-channel)"; - "fudged_width", Arg.Set use_fudged_width, - "use fudge factor for charge particle width"; - "custom_width", Arg.String (fun f -> default_width := Custom f), - "use custom width"; - "cancel_widths", Arg.Unit (fun () -> default_width := Vanishing), - "use vanishing width" ] - -(* We do not introduce the Goldstones for the heavy vectors here. The heavy - quarks are simply numerated by their generation, the assignments whether - they are up- or down-type will be defined by the model. *) - - type flavor = L of int | N of int | U of int | D of int | QH of int - | NH of int | Wp | Wm | Ga | Z | Xp | Xm | X0 | Y0 | ZH - | Phip | Phim | Phi0 | H | Eta | Gl - type flavor_sans_color = flavor - let flavor_sans_color f = f - - type gauge = unit - - let gauge_symbol () = - failwith "Models4.Simplest.gauge_symbol: internal error" - - let family n = [ L n; N n; U n; D n; QH n; NH n ] - -(* Note that we add all heavy quarks, [U], [D], [C], [S], in order to have - both embeddings included. *) - - let external_flavors () = - [ "1st Generation (incl. heavy)", ThoList.flatmap family [1; -1]; - "2nd Generation (incl. heavy)", ThoList.flatmap family [2; -2]; - "3rd Generation (incl. heavy)", ThoList.flatmap family [3; -3]; - "Gauge Bosons", [Ga; Z; Wp; Wm; Gl; Xp; Xm; X0; Y0; ZH]; - "Higgs", [H; Eta]; - "Goldstone Bosons", [Phip; Phim; Phi0] ] - - let flavors () = ThoList.flatmap snd (external_flavors ()) - - let spinor n = - if n >= 0 then - Spinor - else - ConjSpinor - - let lorentz = function - | L n -> spinor n | N n -> spinor n - | U n -> spinor n | D n -> spinor n - | QH n -> spinor n | NH n -> spinor n - | Ga | Gl -> Vector - | Wp | Wm | Z | Xp | Xm | X0 | Y0 | ZH -> Massive_Vector - | _ -> Scalar - - let color = function - | U n -> Color.SUN (if n > 0 then 3 else -3) - | D n -> Color.SUN (if n > 0 then 3 else -3) - | QH n -> Color.SUN (if n > 0 then 3 else -3) - | Gl -> Color.AdjSUN 3 - | _ -> Color.Singlet - - let prop_spinor n = - if n >= 0 then - Prop_Spinor - else - Prop_ConjSpinor - - let propagator = function - | L n -> prop_spinor n | N n -> prop_spinor n - | U n -> prop_spinor n | D n -> prop_spinor n - | QH n -> prop_spinor n | NH n -> prop_spinor n - | Ga | Gl -> Prop_Feynman - | Wp | Wm | Z | Xp | Xm | X0 | Y0 | ZH -> Prop_Unitarity - | Phip | Phim | Phi0 -> Only_Insertion - | H | Eta -> Prop_Scalar - -(* Optionally, ask for the fudge factor treatment for the widths of - charged particles. Currently, this only applies to $W^\pm$ and top. *) - - let width f = - if !use_fudged_width then - match f with - | Wp | Wm | U 3 | U (-3) | QH _ | NH _ -> Fudged - | _ -> !default_width - else - !default_width - - let goldstone = function - | Wp -> Some (Phip, Coupling.Const 1) - | Wm -> Some (Phim, Coupling.Const 1) - | Z -> Some (Phi0, Coupling.Const 1) - | _ -> None - - let conjugate = function - | L n -> L (-n) | N n -> N (-n) - | U n -> U (-n) | D n -> D (-n) - | QH n -> QH (-n) | NH n -> NH (-n) - | Ga -> Ga | Gl -> Gl | Z -> Z - | Wp -> Wm | Wm -> Wp - | Xp -> Xm | Xm -> Xp | X0 -> X0 | Y0 -> Y0 | ZH -> ZH - | Phip -> Phim | Phim -> Phip | Phi0 -> Phi0 - | H -> H | Eta -> Eta - - let conjugate_sans_color = conjugate - - let fermion = function - | L n -> if n > 0 then 1 else -1 - | N n -> if n > 0 then 1 else -1 - | U n -> if n > 0 then 1 else -1 - | D n -> if n > 0 then 1 else -1 - | QH n -> if n > 0 then 1 else -1 - | NH n -> if n > 0 then 1 else -1 - | Ga | Gl | Z | Wp | Wm | Xp | Xm | X0 | Y0 | ZH -> 0 - | _ -> 0 - - type constant = - | Unit | Pi | Alpha_QED | Sin2thw - | Sinthw | Costhw | E | G_weak | Vev | VHeavy - | Supp | Supp2 - | Sinpsi | Cospsi | Atpsi | Sccs (* Mixing angles of SU(2) *) - | Q_lepton | Q_up | Q_down | Q_Z_up | G_CC | I_G_CC - | G_NC_neutrino | G_NC_lepton | G_NC_up | G_NC_down - | G_NC_X | G_NC_X_t | G_NC_Y | G_NC_Y_t | G_NC_H - | G_NC_h_neutrino | G_NC_h_lepton | G_NC_h_up | G_NC_h_down - | G_NC_h_top | G_NC_h_bot | G_NCH_N | G_NCH_U | G_NCH_D | G_NCHt - | G_zhthth - | I_Q_W | I_G_ZWW | I_G_WWW - | I_G_Z1 | I_G_Z2 | I_G_Z3 | I_G_Z4 | I_G_Z5 | I_G_Z6 - | I_Q_H | Gs | I_Gs | G2 - | G_WWWW | G_ZZWW | G_AZWW | G_AAWW - | I_Q_ZH - | G_HWW | G_HHWW | G_HZZ | G_HHZZ | G_HHZZH - | G_heavy_HVV | G_heavy_HWW | G_heavy_HZZ | G_HHthth - | G_Htt | G_Hbb | G_Hcc | G_Htautau | G_H3 | G_H4 - | G_Hthth | G_Htht | G_Ethth | G_Etht | G_Ett | G_Hqhq - | G_Ebb | G_ZEH | G_ZHEH | G_Hgg - | G_HGaGa | G_HGaZ | G_EGaGa | G_EGaZ | G_EGlGl - | Mass of flavor | Width of flavor - -(* \begin{dubious} - The current abstract syntax for parameter dependencies is admittedly - tedious. Later, there will be a parser for a convenient concrete syntax - as a part of a concrete syntax for models. But as these examples show, - it should include simple functions. - \end{dubious} *) - - - let input_parameters = - [] - - let derived_parameters = - [] - - let derived_parameter_arrays = - [] - - let parameters () = - { input = input_parameters; - derived = derived_parameters; - derived_arrays = derived_parameter_arrays } - - module F = Models.Fusions (struct - type f = flavor - type c = constant - let compare = compare - let conjugate = conjugate - end) - - let electromagnetic_currents n = - [ ((L (-n), Ga, L n), FBF (1, Psibar, V, Psi), Q_lepton); - ((U (-n), Ga, U n), FBF (1, Psibar, V, Psi), Q_up); - ((D (-n), Ga, D n), FBF (1, Psibar, V, Psi), Q_down) ] - - let color_currents n = - [ ((D (-n), Gl, D n), FBF ((-1), Psibar, V, Psi), Gs); - ((U (-n), Gl, U n), FBF ((-1), Psibar, V, Psi), Gs); - ((QH (-n), Gl, QH n), FBF ((-1), Psibar, V, Psi), Gs)] - - let neutral_currents n = - [ ((L (-n), Z, L n), FBF (1, Psibar, VA, Psi), G_NC_lepton); - ((N (-n), Z, N n), FBF (1, Psibar, VA, Psi), G_NC_neutrino); - ((U (-n), Z, U n), FBF (1, Psibar, VA, Psi), G_NC_up); - ((D (-n), Z, D n), FBF (1, Psibar, VA, Psi), G_NC_down) ] - - let xy_currents = - ThoList.flatmap - (fun n -> [ ((N (-n), X0, N n), FBF ((-1), Psibar, VL, Psi), G_NC_X); - ((L (-n), Xm, N n), FBF ((-1), Psibar, VL, Psi), G_NC_X); - ((N (-n), Xp, L n), FBF ((-1), Psibar, VL, Psi), G_NC_X); - ((N (-n), Y0, N n), FBF ((-1), Psibar, VL, Psi), G_NC_Y); - ((NH (-n), X0, N n), FBF ((-1), Psibar, VL, Psi), G_CC); - ((N (-n), X0, NH n), FBF ((-1), Psibar, VL, Psi), G_CC); - ((NH (-n), Y0, N n), FBF ((-1), Psibar, VL, Psi), I_G_CC); - ((N (-n), Y0, NH n), FBF ((-1), Psibar, VL, Psi), I_G_CC); - ((L (-n), Xm, NH n), FBF ((-1), Psibar, VL, Psi), G_CC); - ((NH (-n), Xp, L n), FBF ((-1), Psibar, VL, Psi), G_CC)]) - [1;2;3] - @ - [ ((U (-3), X0, U 3), FBF (1, Psibar, VL, Psi), G_NC_X_t); - ((U (-3), Y0, U 3), FBF (1, Psibar, VL, Psi), G_NC_Y_t); - ((U (-3), X0, QH 3), FBF (1, Psibar, VL, Psi), G_CC); - ((QH (-3), X0, U 3), FBF (1, Psibar, VL, Psi), G_CC); - ((U (-3), Y0, QH 3), FBF (1, Psibar, VL, Psi), I_G_CC); - ((QH (-3), Y0, U 3), FBF (1, Psibar, VL, Psi), I_G_CC); - ((D (-3), Xm, U 3), FBF (1, Psibar, VL, Psi), G_NC_X_t); - ((U (-3), Xp, D 3), FBF (1, Psibar, VL, Psi), G_NC_X_t); - ((D (-3), Xm, QH 3), FBF (1, Psibar, VL, Psi), G_CC); - ((QH (-3), Xp, D 3), FBF (1, Psibar, VL, Psi), G_CC); - ((QH (-3), Wp, D 3), FBF (1, Psibar, VL, Psi), G_NC_X_t); - ((D (-3), Wm, QH 3), FBF (1, Psibar, VL, Psi), G_NC_X_t); - ((QH (-3), Z, U 3), FBF (1, Psibar, VL, Psi), G_NCHt); - ((U (-3), Z, QH 3), FBF (1, Psibar, VL, Psi), G_NCHt)] - @ - ThoList.flatmap - (fun n -> - if Flags.anom_ferm_ass then - [ ((U (-n), X0, U n), FBF ((-1), Psibar, VL, Psi), G_NC_X); - ((U (-n), Y0, U n), FBF ((-1), Psibar, VL, Psi), G_NC_Y); - ((D (-n), Xm, U n), FBF ((-1), Psibar, VL, Psi), G_NC_X); - ((U (-n), Xp, D n), FBF ((-1), Psibar, VL, Psi), G_NC_X); - ((QH (-n), X0, U n), FBF ((-1), Psibar, VL, Psi), G_CC); - ((U (-n), X0, QH n), FBF ((-1), Psibar, VL, Psi), G_CC); - ((QH (-n), Y0, U n), FBF ((-1), Psibar, VL, Psi), I_G_CC); - ((U (-n), Y0, QH n), FBF ((-1), Psibar, VL, Psi), I_G_CC); - ((D (-n), Xm, QH n), FBF ((-1), Psibar, VL, Psi), G_CC); - ((QH (-n), Xp, D n), FBF ((-1), Psibar, VL, Psi), G_CC); - ((QH (-n), Wp, D n), FBF ((-1), Psibar, VL, Psi), G_NC_X); - ((D (-n), Wm, QH n), FBF ((-1), Psibar, VL, Psi), G_NC_X); - ((QH (-n), Z, U n), FBF (1, Psibar, VL, Psi), G_NC_H); - ((U (-n), Z, QH n), FBF (1, Psibar, VL, Psi), G_NC_H)] - else - [ ((D (-n), X0, D n), FBF (1, Psibar, VL, Psi), G_NC_X); - ((D (-n), Y0, D n), FBF (1, Psibar, VL, Psi), G_NC_Y); - ((D (-n), Xm, U n), FBF (1, Psibar, VL, Psi), G_NC_X); - ((U (-n), Xp, D n), FBF (1, Psibar, VL, Psi), G_NC_X); - ((QH (-n), X0, D n), FBF ((-1), Psibar, VL, Psi), G_CC); - ((D (-n), X0, QH n), FBF ((-1), Psibar, VL, Psi), G_CC); - ((QH (-n), Y0, D n), FBF ((-1), Psibar, VL, Psi), I_G_CC); - ((D (-n), Y0, QH n), FBF ((-1), Psibar, VL, Psi), I_G_CC); - ((QH (-n), Xm, U n), FBF (1, Psibar, VL, Psi), G_CC); - ((U (-n), Xp, QH n), FBF (1, Psibar, VL, Psi), G_CC); - ((QH (-n), Wm, U n), FBF (1, Psibar, VL, Psi), G_NC_X); - ((U (-n), Wp, QH n), FBF (1, Psibar, VL, Psi), G_NC_X); - ((QH (-n), Z, D n), FBF (1, Psibar, VL, Psi), G_NC_H); - ((D (-n), Z, QH n), FBF (1, Psibar, VL, Psi), G_NC_H)]) - [1; 2] - - -(* The sign of this coupling is just the one of the T3, being -(1/2) for - leptons and down quarks, and +(1/2) for neutrinos and up quarks. *) - - let neutral_heavy_currents n = - [ ((L (-n), ZH, L n), FBF (1, Psibar, VLR, Psi), G_NC_h_lepton); - ((N (-n), ZH, N n), FBF ((-1), Psibar, VLR, Psi), G_NC_h_neutrino); - ((U (-n), ZH, U n), FBF ((-1), Psibar, VLR, Psi), (if n = 3 then - G_NC_h_top else G_NC_h_up)); - ((D (-n), ZH, D n), FBF (1, Psibar, VLR, Psi), (if n = 3 then - G_NC_h_bot else G_NC_h_down)); - ((NH (-n), ZH, NH n), FBF (1, Psibar, VLR, Psi), G_NCH_N); - ((QH (-n), ZH, QH n), FBF (1, Psibar, VLR, Psi), (if n = 3 then - G_NCH_U else if Flags.anom_ferm_ass then G_NCH_U else G_NCH_D))] - - - let heavy_currents n = - [ ((QH (-n), Ga, QH n), FBF (1, Psibar, V, Psi), (if n=3 then Q_up else - if Flags.anom_ferm_ass then Q_up else Q_down))] - - let charged_currents n = - [ ((L (-n), Wm, N n), FBF (1, Psibar, VL, Psi), G_CC); - ((N (-n), Wp, L n), FBF (1, Psibar, VL, Psi), G_CC); - ((D (-n), Wm, U n), FBF (1, Psibar, VL, Psi), G_CC); - ((U (-n), Wp, D n), FBF (1, Psibar, VL, Psi), G_CC) ] - - let yukawa = - [ ((U (-3), H, U 3), FBF (1, Psibar, S, Psi), G_Htt); - ((D (-3), H, D 3), FBF (1, Psibar, S, Psi), G_Hbb); - ((U (-2), H, U 2), FBF (1, Psibar, S, Psi), G_Hcc); - ((L (-3), H, L 3), FBF (1, Psibar, S, Psi), G_Htautau) ] - - let yukawa_add = - [ ((QH (-3), H, U 3), FBF (1, Psibar, SL, Psi), G_Htht); - ((U (-3), H, QH 3), FBF (1, Psibar, SR, Psi), G_Htht); - ((QH (-3), Eta, U 3), FBF (1, Psibar, SR, Psi), G_Etht); - ((U (-3), Eta, QH 3), FBF (1, Psibar, SL, Psi), G_Etht); - ((D (-3), Eta, D 3), FBF (1, Psibar, P, Psi), G_Ebb); - ((U (-3), Eta, U 3), FBF (1, Psibar, P, Psi), G_Ett)] - @ - ThoList.flatmap - (fun n -> - if Flags.anom_ferm_ass then - [ ((QH (-n), H, U n), FBF (1, Psibar, SL, Psi), G_Hqhq); - ((U (-n), H, QH n), FBF (1, Psibar, SR, Psi), G_Hqhq)] - else - [ ((QH (-n), H, D n), FBF (1, Psibar, SL, Psi), G_Hqhq); - ((D (-n), H, QH n), FBF (1, Psibar, SR, Psi), G_Hqhq)]) - [1;2] - - - let standard_triple_gauge = - [ ((Ga, Wm, Wp), Gauge_Gauge_Gauge 1, I_Q_W); - ((Z, Wm, Wp), Gauge_Gauge_Gauge 1, I_G_ZWW); - ((Gl, Gl, Gl), Gauge_Gauge_Gauge 1, I_Gs)] - - let heavy_triple_gauge = - [ ((Ga, Xm, Xp), Gauge_Gauge_Gauge 1, I_Q_W); - ((Z, Xm, Xp), Gauge_Gauge_Gauge 1, I_Q_ZH); - ((Z, X0, Y0), Gauge_Gauge_Gauge 1, I_G_Z1); - ((ZH, X0, Y0), Gauge_Gauge_Gauge 1, I_G_Z2); - ((Y0, Wm, Xp), Gauge_Gauge_Gauge 1, I_G_Z3); - ((Y0, Wp, Xm), Gauge_Gauge_Gauge (-1), I_G_Z3); - ((X0, Wm, Xp), Gauge_Gauge_Gauge 1, I_G_Z4); - ((X0, Wp, Xm), Gauge_Gauge_Gauge 1, I_G_Z4); - ((ZH, Xm, Xp), Gauge_Gauge_Gauge 1, I_G_Z5); - ((ZH, Wm, Wp), Gauge_Gauge_Gauge 1, I_G_Z6)] - - let triple_gauge = - standard_triple_gauge @ heavy_triple_gauge - - let gauge4 = Vector4 [(2, C_13_42); (-1, C_12_34); (-1, C_14_23)] - let minus_gauge4 = Vector4 [(-2, C_13_42); (1, C_12_34); (1, C_14_23)] - let standard_quartic_gauge = - [ (Wm, Wp, Wm, Wp), gauge4, G_WWWW; - (Wm, Z, Wp, Z), minus_gauge4, G_ZZWW; - (Wm, Z, Wp, Ga), minus_gauge4, G_AZWW; - (Wm, Ga, Wp, Ga), minus_gauge4, G_AAWW; - (Gl, Gl, Gl, Gl), gauge4, G2] - - let heavy_quartic_gauge = - [] - - - let quartic_gauge = - standard_quartic_gauge @ heavy_quartic_gauge - - let standard_gauge_higgs' = - [ ((H, Wp, Wm), Scalar_Vector_Vector 1, G_HWW); - ((H, Z, Z), Scalar_Vector_Vector 1, G_HZZ) ] - - let heavy_gauge_higgs = - [ ((H, Wp, Xm), Scalar_Vector_Vector 1, G_heavy_HWW); - ((H, Wm, Xp), Scalar_Vector_Vector 1, G_heavy_HWW); - ((H, Z, X0), Scalar_Vector_Vector 1, G_heavy_HVV); - ((H, ZH, X0), Scalar_Vector_Vector 1, G_heavy_HVV)] - - let standard_gauge_higgs = - standard_gauge_higgs' @ heavy_gauge_higgs - - let standard_gauge_higgs4 = - [ (H, H, Wp, Wm), Scalar2_Vector2 1, G_HHWW; - (H, H, Z, Z), Scalar2_Vector2 1, G_HHZZ ] - - let heavy_gauge_higgs4 = - [ (H, H, Z, ZH), Scalar2_Vector2 1, G_HHZZH; - (H, H, Xp, Xm), Scalar2_Vector2 (-1), G_HHWW; - (H, H, ZH, ZH), Scalar2_Vector2 (-1), G_HHZZ ] - - let standard_higgs = - [ (H, H, H), Scalar_Scalar_Scalar 1, G_H3 ] - - let anomaly_higgs = - [ (Eta, Gl, Gl), Dim5_Scalar_Gauge2_Skew 1, G_EGlGl; - (Eta, Ga, Ga), Dim5_Scalar_Gauge2_Skew 1, G_EGaGa; - (Eta, Ga, Z), Dim5_Scalar_Gauge2_Skew 1, G_EGaZ ] -(* @ [ (H, Ga, Ga), Dim5_Scalar_Gauge2 1, G_HGaGa; - (H, Ga, Z), Dim5_Scalar_Gauge2 1, G_HGaZ ] *) - - let standard_higgs4 = - [ (H, H, H, H), Scalar4 1, G_H4 ] - - let gauge_higgs = - standard_gauge_higgs - - let gauge_higgs4 = - standard_gauge_higgs4 @ heavy_gauge_higgs4 - - let higgs = - standard_higgs - - let eta_higgs_gauge = - [ (Z, Eta, H), Vector_Scalar_Scalar 1, G_ZEH; - (ZH, Eta, H), Vector_Scalar_Scalar 1, G_ZHEH; - (X0, Eta, H), Vector_Scalar_Scalar 1, G_CC ] - - let top_quartic = - [ ((QH (-3), H, H, QH 3), GBBG (1, Psibar, S2, Psi), G_HHthth)] - - let higgs4 = - standard_higgs4 - - let goldstone_vertices = - [ ((Phi0, Wm, Wp), Scalar_Vector_Vector 1, I_G_ZWW); - ((Phip, Ga, Wm), Scalar_Vector_Vector 1, I_Q_W); - ((Phip, Z, Wm), Scalar_Vector_Vector 1, I_G_ZWW); - ((Phim, Wp, Ga), Scalar_Vector_Vector 1, I_Q_W); - ((Phim, Wp, Z), Scalar_Vector_Vector 1, I_G_ZWW) ] - - let vertices3 = - (ThoList.flatmap electromagnetic_currents [1;2;3] @ - ThoList.flatmap color_currents [1;2;3] @ - ThoList.flatmap neutral_currents [1;2;3] @ - ThoList.flatmap neutral_heavy_currents [1;2;3] @ - ThoList.flatmap heavy_currents [1;2;3] @ - ThoList.flatmap charged_currents [1;2;3] @ - xy_currents @ anomaly_higgs @ - eta_higgs_gauge @ - yukawa @ yukawa_add @ - triple_gauge @ - gauge_higgs @ higgs @ goldstone_vertices) - - let vertices4 = - quartic_gauge @ gauge_higgs4 @ higgs4 - - let vertices () = (vertices3, vertices4, []) - -(* For efficiency, make sure that [F.of_vertices vertices] is - evaluated only once. *) - - let table = F.of_vertices (vertices ()) - let fuse2 = F.fuse2 table - let fuse3 = F.fuse3 table - let fuse = F.fuse table - let max_degree () = 4 - - let flavor_of_string = function - | "e-" -> L 1 | "e+" -> L (-1) - | "mu-" -> L 2 | "mu+" -> L (-2) - | "tau-" -> L 3 | "tau+" -> L (-3) - | "nue" -> N 1 | "nuebar" -> N (-1) - | "numu" -> N 2 | "numubar" -> N (-2) - | "nutau" -> N 3 | "nutaubar" -> N (-3) - | "nh1" -> NH 1 | "nh1bar" -> NH (-1) - | "nh2" -> NH 2 | "nh2bar" -> NH (-2) - | "nh3" -> NH 3 | "nh3bar" -> NH (-3) - | "u" -> U 1 | "ubar" -> U (-1) - | "c" -> U 2 | "cbar" -> U (-2) - | "t" -> U 3 | "tbar" -> U (-3) - | "d" -> D 1 | "dbar" -> D (-1) - | "s" -> D 2 | "sbar" -> D (-2) - | "b" -> D 3 | "bbar" -> D (-3) - | "uh" -> if Flags.anom_ferm_ass then QH 1 else invalid_arg - "Models4.Simplest.flavor_of_string" - | "dh" -> if Flags.anom_ferm_ass then invalid_arg - "Models4.Simplest.flavor_of_string" else QH 1 - | "uhbar" -> if Flags.anom_ferm_ass then QH (-1) else invalid_arg - "Models4.Simplest.flavor_of_string" - | "dhbar" -> if Flags.anom_ferm_ass then invalid_arg - "Models4.Simplest.flavor_of_string" else QH (-1) - | "ch" -> if Flags.anom_ferm_ass then QH 2 else invalid_arg - "Models4.Simplest.flavor_of_string" - | "sh" -> if Flags.anom_ferm_ass then invalid_arg - "Models4.Simplest.flavor_of_string" else QH 2 - | "chbar" -> if Flags.anom_ferm_ass then QH (-2) else invalid_arg - "Models4.Simplest.flavor_of_string" - | "shbar" -> if Flags.anom_ferm_ass then invalid_arg - "Models4.Simplest.flavor_of_string" else QH (-2) - | "th" -> QH 3 | "thbar" -> QH (-3) - | "eta" | "Eta" -> Eta - | "A" -> Ga | "Z" | "Z0" -> Z | "g" | "gl" -> Gl - | "ZH" | "ZH0" | "Zh" | "Zh0" -> ZH - | "W+" -> Wp | "W-" -> Wm - | "X+" -> Xp | "X-" -> Xm - | "X0" -> X0 | "Y0" -> Y0 - | "H" -> H - | _ -> invalid_arg "Models4.Simplest.flavor_of_string" - - let flavor_to_string = function - | L 1 -> "e-" | L (-1) -> "e+" - | L 2 -> "mu-" | L (-2) -> "mu+" - | L 3 -> "tau-" | L (-3) -> "tau+" - | L _ -> invalid_arg - "Models4.Simplest.flavor_to_string: invalid lepton" - | N 1 -> "nue" | N (-1) -> "nuebar" - | N 2 -> "numu" | N (-2) -> "numubar" - | N 3 -> "nutau" | N (-3) -> "nutaubar" - | N _ -> invalid_arg - "Models4.Simplest.flavor_to_string: invalid neutrino" - | U 1 -> "u" | U (-1) -> "ubar" - | U 2 -> "c" | U (-2) -> "cbar" - | U 3 -> "t" | U (-3) -> "tbar" - | U _ -> invalid_arg - "Models4.Simplest.flavor_to_string: invalid up type quark" - | D 1 -> "d" | D (-1) -> "dbar" - | D 2 -> "s" | D (-2) -> "sbar" - | D 3 -> "b" | D (-3) -> "bbar" - | D _ -> invalid_arg - "Models4.Simplest.flavor_to_string: invalid down type quark" - | QH 1 -> if Flags.anom_ferm_ass then "uh" else "dh" - | QH 2 -> if Flags.anom_ferm_ass then "ch" else "sh" - | QH 3 -> "th" - | QH (-1) -> if Flags.anom_ferm_ass then "uhbar" else "dhbar" - | QH (-2) -> if Flags.anom_ferm_ass then "chbar" else "shbar" - | QH (-3) -> "thbar" - | QH _ -> invalid_arg - "Models4.Simplest.flavor_to_string: invalid heavy quark" - | NH n when n > 0 -> "nh" ^ string_of_int n - | NH n -> "nh" ^ string_of_int (abs n) ^ "bar" - | Ga -> "A" | Z -> "Z" | Gl -> "gl" - | Wp -> "W+" | Wm -> "W-" - | Xp -> "X+" | Xm -> "X-" | X0 -> "X0" | Y0 -> "Y0" | ZH -> "ZH" - | Phip -> "phi+" | Phim -> "phi-" | Phi0 -> "phi0" - | H -> "H" | Eta -> "Eta" - - let flavor_symbol = function - | L n when n > 0 -> "l" ^ string_of_int n - | L n -> "l" ^ string_of_int (abs n) ^ "b" - | N n when n > 0 -> "n" ^ string_of_int n - | N n -> "n" ^ string_of_int (abs n) ^ "b" - | U n when n > 0 -> "u" ^ string_of_int n - | U n -> "u" ^ string_of_int (abs n) ^ "b" - | D n when n > 0 -> "d" ^ string_of_int n - | D n -> "d" ^ string_of_int (abs n) ^ "b" - | NH n when n > 0 -> "nh" ^ string_of_int n - | NH n -> "nh" ^ string_of_int (abs n) ^ "b" - | QH n when n > 0 -> "qh" ^ string_of_int n - | QH n -> "qh" ^ string_of_int (abs n) ^ "b" - | Ga -> "a" | Z -> "z" | Gl -> "gl" - | Wp -> "wp" | Wm -> "wm" - | Xp -> "xp" | Xm -> "xm" | X0 -> "x0" | Y0 -> "y0" | ZH -> "zh" - | Phip -> "pp" | Phim -> "pm" | Phi0 -> "p0" - | H -> "h" | Eta -> "eta" - - let flavor_sans_color_of_string = flavor_of_string - let flavor_sans_color_to_string = flavor_to_string - let flavor_sans_color_symbol = flavor_symbol - -(* There are PDG numbers for Z', Z'', W', 32-34, respectively. - We just introduce a number 38 for Y0 as a Z'''. - As well, there is the number 8 for a t'. But we cheat a little bit and - take the number 35 which is reserved for a heavy scalar Higgs for the - Eta scalar. - - We abuse notation for the heavy quarks and take the PDG code for their - SUSY partners!!! (What about an update of the PDG numbering scheme?) - Thereby we take only those for up-type (s)quarks. The heavy neutrinos get - the numbers of the sneutrinos. -*) - - let pdg = function - | L n when n > 0 -> 9 + 2*n - | L n -> - 9 + 2*n - | N n when n > 0 -> 10 + 2*n - | N n -> - 10 + 2*n - | U n when n > 0 -> 2*n - | U n -> 2*n - | D n when n > 0 -> - 1 + 2*n - | D n -> 1 + 2*n - | NH n when n > 0 -> 1000010 + 2*n - | NH n -> - 1000010 + 2*n - | QH 3 -> 1000006 - | QH (-3) -> - 1000006 - | QH n when n > 0 -> if Flags.anom_ferm_ass then - 1000000 + 2*n else 999999 + 2*n - | QH n -> if Flags.anom_ferm_ass then - - 1000000 + 2*n else - 999999 + 2*n - | Gl -> 21 - | Ga -> 22 | Z -> 23 - | Wp -> 24 | Wm -> (-24) - | Xp -> 34 | Xm -> (-34) | ZH -> 32 | X0 -> 33 | Y0 -> 38 - | Phip | Phim -> 27 | Phi0 -> 26 - | H -> 25 | Eta -> 36 - -(* As in the case of SUSY we introduce an internal dummy pdf code in order - to have manageable arrays. Heavy neutrinos get numbers 41,43,45, while the - heavy quarks have the numbers 40,42,44. I take them all as up type - here. - *) - - let pdg_mw = function - | L n when n > 0 -> 9 + 2*n - | L n -> - 9 + 2*n - | N n when n > 0 -> 10 + 2*n - | N n -> - 10 + 2*n - | U n when n > 0 -> 2*n - | U n -> 2*n - | D n when n > 0 -> - 1 + 2*n - | D n -> 1 + 2*n - | NH n when n > 0 -> 39 + 2*n - | NH n -> - 39 + 2*n - | QH n when n > 0 -> 38 + 2*n - | QH n -> - 38 + 2*n - | Gl -> 21 - | Ga -> 22 | Z -> 23 - | Wp -> 24 | Wm -> (-24) - | Xp -> 34 | Xm -> (-34) | ZH -> 32 | X0 -> 33 | Y0 -> 38 - | Phip | Phim -> 27 | Phi0 -> 26 - | H -> 25 | Eta -> 36 - - let mass_symbol f = - "mass(" ^ string_of_int (abs (pdg_mw f)) ^ ")" - - let width_symbol f = - "width(" ^ string_of_int (abs (pdg_mw f)) ^ ")" - - let constant_symbol = function - | Unit -> "unit" | Pi -> "PI" | VHeavy -> "vheavy" - | Alpha_QED -> "alpha" | E -> "e" | G_weak -> "g" | Vev -> "vev" - | Sin2thw -> "sin2thw" | Sinthw -> "sinthw" | Costhw -> "costhw" - | Sinpsi -> "sinpsi" | Cospsi -> "cospsi" - | Atpsi -> "atpsi" | Sccs -> "sccs" - | Supp -> "vF" | Supp2 -> "v2F2" - | Q_lepton -> "qlep" | Q_up -> "qup" | Q_down -> "qdwn" - | Q_Z_up -> "qzup" - | G_zhthth -> "gzhthth" - | G_NC_lepton -> "gnclep" | G_NC_neutrino -> "gncneu" - | G_NC_up -> "gncup" | G_NC_down -> "gncdwn" - | G_NC_X -> "gncx" | G_NC_X_t -> "gncxt" - | G_NC_Y -> "gncy" | G_NC_Y_t -> "gncyt" | G_NC_H -> "gnch" - | G_CC -> "gcc" | I_G_CC -> "i_gcc" - | G_NC_h_lepton -> "gnchlep" | G_NC_h_neutrino -> "gnchneu" - | G_NC_h_up -> "gnchup" | G_NC_h_down -> "gnchdwn" - | G_NC_h_top -> "gnchtop" | G_NC_h_bot -> "gnchbot" - | G_NCH_N -> "gnchn" | G_NCH_U -> "gnchu" | G_NCH_D -> "gnchd" - | G_NCHt -> "gncht" - | I_Q_W -> "iqw" | I_G_ZWW -> "igzww" | I_G_WWW -> "igwww" - | I_Q_H -> "iqh" | I_Q_ZH -> "iqzh" - | I_G_Z1 -> "igz1" | I_G_Z2 -> "igz2" | I_G_Z3 -> "igz3" - | I_G_Z4 -> "igz4" | I_G_Z5 -> "igz5" | I_G_Z6 -> "igz6" - | G_HHthth -> "ghhthth" - | G_WWWW -> "gw4" | G_ZZWW -> "gzzww" - | G_AZWW -> "gazww" | G_AAWW -> "gaaww" - | G_HWW -> "ghww" | G_HZZ -> "ghzz" - | G_heavy_HVV -> "ghyhvv" - | G_heavy_HWW -> "ghyhww" - | G_heavy_HZZ -> "ghyhzz" - | G_HHWW -> "ghhww" | G_HHZZ -> "ghhzz" - | G_HHZZH -> "ghhzzh" - | G_Hgg -> "ghgg" - | G_Htt -> "ghtt" | G_Hbb -> "ghbb" - | G_Htautau -> "ghtautau" | G_Hcc -> "ghcc" - | G_Hthth -> "ghthth" | G_Htht -> "ghtht" - | G_Hqhq -> "ghqhq" - | G_Ethth -> "gethth" | G_Etht -> "getht" - | G_Ett -> "gett" | G_Ebb -> "gebb" - | G_HGaGa -> "ghgaga" | G_HGaZ -> "ghgaz" - | G_EGaGa -> "geaa" | G_EGaZ -> "geaz" | G_EGlGl -> "gegg" - | G_ZEH -> "gzeh" | G_ZHEH -> "gzheh" - | G_H3 -> "gh3" | G_H4 -> "gh4" - | Mass f -> "mass" ^ flavor_symbol f - | Width f -> "width" ^ flavor_symbol f - | Gs -> "gs" | I_Gs -> "igs" | G2 -> "gs**2" - end - -module Xdim (Flags : BSM_flags) = - struct - let rcs = RCS.rename rcs_file "Models4.Xdim" - [ "SM with extradimensional resonances"] - - open Coupling - - let default_width = ref Timelike - let use_fudged_width = ref false - - let options = Options.create - [ "constant_width", Arg.Unit (fun () -> default_width := Constant), - "use constant width (also in t-channel)"; - "fudged_width", Arg.Set use_fudged_width, - "use fudge factor for charge particle width"; - "custom_width", Arg.String (fun f -> default_width := Custom f), - "use custom width"; - "cancel_widths", Arg.Unit (fun () -> default_width := Vanishing), - "use vanishing width"] - - type matter_field = L of int | N of int | U of int | D of int - type gauge_boson = Ga | Wp | Wm | Z | Gl - type other = Phip | Phim | Phi0 | H | Grav - type flavor = M of matter_field | G of gauge_boson | O of other - type flavor_sans_color = flavor - let flavor_sans_color f = f - - let matter_field f = M f - let gauge_boson f = G f - let other f = O f - - type field = - | Matter of matter_field - | Gauge of gauge_boson - | Other of other - - let field = function - | M f -> Matter f - | G f -> Gauge f - | O f -> Other f - - type gauge = unit - - let gauge_symbol () = - failwith "Models4.Xdim.gauge_symbol: internal error" - - let family n = List.map matter_field [ L n; N n; U n; D n ] - - let external_flavors () = - [ "1st Generation", ThoList.flatmap family [1; -1]; - "2nd Generation", ThoList.flatmap family [2; -2]; - "3rd Generation", ThoList.flatmap family [3; -3]; - "Gauge Bosons", List.map gauge_boson [Ga; Z; Wp; Wm; Gl]; - "Higgs", List.map other [H]; - "Graviton", List.map other [Grav]; - "Goldstone Bosons", List.map other [Phip; Phim; Phi0] ] - - let flavors () = ThoList.flatmap snd (external_flavors ()) - - let spinor n = - if n >= 0 then - Spinor - else - ConjSpinor - - let lorentz = function - | M f -> - begin match f with - | L n -> spinor n | N n -> spinor n - | U n -> spinor n | D n -> spinor n - end - | G f -> - begin match f with - | Ga | Gl -> Vector - | Wp | Wm | Z -> Massive_Vector - end - | O f -> - begin match f with - | Grav -> Tensor_2 - | _ -> Scalar - end - - let color = function - | M (U n) -> Color.SUN (if n > 0 then 3 else -3) - | M (D n) -> Color.SUN (if n > 0 then 3 else -3) - | G Gl -> Color.AdjSUN 3 - | _ -> Color.Singlet - - let prop_spinor n = - if n >= 0 then - Prop_Spinor - else - Prop_ConjSpinor - - let propagator = function - | M f -> - begin match f with - | L n -> prop_spinor n | N n -> prop_spinor n - | U n -> prop_spinor n | D n -> prop_spinor n - end - | G f -> - begin match f with - | Ga | Gl -> Prop_Feynman - | Wp | Wm | Z -> Prop_Unitarity - end - | O f -> - begin match f with - | Phip | Phim | Phi0 -> Only_Insertion - | H -> Prop_Scalar - | Grav -> Prop_Tensor_2 - end - -(* Optionally, ask for the fudge factor treatment for the widths of - charged particles. Currently, this only applies to $W^\pm$ and top. *) - - let width f = - if !use_fudged_width then - match f with - | G Wp | G Wm | M (U 3) | M (U (-3)) | O Grav -> Fudged - | _ -> !default_width - else - !default_width - - let goldstone = function - | G f -> - begin match f with - | Wp -> Some (O Phip, Coupling.Const 1) - | Wm -> Some (O Phim, Coupling.Const 1) - | Z -> Some (O Phi0, Coupling.Const 1) - | _ -> None - end - | _ -> None - - let conjugate = function - | M f -> - M (begin match f with - | L n -> L (-n) | N n -> N (-n) - | U n -> U (-n) | D n -> D (-n) - end) - | G f -> - G (begin match f with - | Gl -> Gl | Ga -> Ga | Z -> Z - | Wp -> Wm | Wm -> Wp - end) - | O f -> - O (begin match f with - | Phip -> Phim | Phim -> Phip | Phi0 -> Phi0 - | H -> H | Grav -> Grav - end) - - let conjugate_sans_color = conjugate - - let fermion = function - | M f -> - begin match f with - | L n -> if n > 0 then 1 else -1 - | N n -> if n > 0 then 1 else -1 - | U n -> if n > 0 then 1 else -1 - | D n -> if n > 0 then 1 else -1 - end - | G f -> - begin match f with - | Gl | Ga | Z | Wp | Wm -> 0 - end - | O _ -> 0 - - type constant = - | Unit | Pi | Alpha_QED | Sin2thw - | Sinthw | Costhw | E | G_weak | Vev - | Q_lepton | Q_up | Q_down | G_CC | G_CCQ of int*int - | G_NC_neutrino | G_NC_lepton | G_NC_up | G_NC_down - | Gs | I_Gs | G2 - | I_Q_W | I_G_ZWW - | G_WWWW | G_ZZWW | G_AZWW | G_AAWW - | G_HWW | G_HHWW | G_HZZ | G_HHZZ - | G_Htt | G_Hbb | G_Hcc | G_Htautau | G_H3 | G_H4 - | G_HGaZ | G_HGaGa | G_Hgg | G_Grav - | Mass of flavor | Width of flavor - - let input_parameters = - [] - - let derived_parameters = - [] - - let derived_parameter_arrays = - [] - - let parameters () = - { input = input_parameters; - derived = derived_parameters; - derived_arrays = derived_parameter_arrays } - - module F = Models.Fusions (struct - type f = flavor - type c = constant - let compare = compare - let conjugate = conjugate - end) - - let mgm ((m1, g, m2), fbf, c) = ((M m1, G g, M m2), fbf, c) - let mom ((m1, o, m2), fbf, c) = ((M m1, O o, M m2), fbf, c) - - let electromagnetic_currents n = - List.map mgm - [ ((L (-n), Ga, L n), FBF (1, Psibar, V, Psi), Q_lepton); - ((U (-n), Ga, U n), FBF (1, Psibar, V, Psi), Q_up); - ((D (-n), Ga, D n), FBF (1, Psibar, V, Psi), Q_down) ] - - let neutral_currents n = - List.map mgm - [ ((L (-n), Z, L n), FBF (1, Psibar, VA, Psi), G_NC_lepton); - ((N (-n), Z, N n), FBF (1, Psibar, VA, Psi), G_NC_neutrino); - ((U (-n), Z, U n), FBF (1, Psibar, VA, Psi), G_NC_up); - ((D (-n), Z, D n), FBF (1, Psibar, VA, Psi), G_NC_down) ] - - let color_currents n = - List.map mgm - [ ((U (-n), Gl, U n), FBF ((-1), Psibar, V, Psi), Gs); - ((D (-n), Gl, D n), FBF ((-1), Psibar, V, Psi), Gs) ] - - let charged_currents n = - List.map mgm - [ ((L (-n), Wm, N n), FBF (1, Psibar, VL, Psi), G_CC); - ((N (-n), Wp, L n), FBF (1, Psibar, VL, Psi), G_CC); - ((D (-n), Wm, U n), FBF (1, Psibar, VL, Psi), G_CC); - ((U (-n), Wp, D n), FBF (1, Psibar, VL, Psi), G_CC) ] - - let gravity_currents n = - List.map mom - [ ((L (-n), Grav, L n), Graviton_Spinor_Spinor 1, G_Grav); - ((N (-n), Grav, N n), Graviton_Spinor_Spinor 1, G_Grav); - ((U (-n), Grav, U n), Graviton_Spinor_Spinor 1, G_Grav); - ((D (-n), Grav, D n), Graviton_Spinor_Spinor 1, G_Grav) ] - - let yukawa = - List.map mom - [ ((U (-3), H, U 3), FBF (1, Psibar, S, Psi), G_Htt); - ((D (-3), H, D 3), FBF (1, Psibar, S, Psi), G_Hbb); - ((U (-2), H, U 2), FBF (1, Psibar, S, Psi), G_Hcc); - ((L (-3), H, L 3), FBF (1, Psibar, S, Psi), G_Htautau) ] - - let tgc ((g1, g2, g3), t, c) = ((G g1, G g2, G g3), t, c) - - let standard_triple_gauge = - List.map tgc - [ ((Ga, Wm, Wp), Gauge_Gauge_Gauge 1, I_Q_W); - ((Z, Wm, Wp), Gauge_Gauge_Gauge 1, I_G_ZWW); - ((Gl, Gl, Gl), Gauge_Gauge_Gauge 1, I_Gs) ] - - let triple_gauge = - standard_triple_gauge - - let qgc ((g1, g2, g3, g4), t, c) = ((G g1, G g2, G g3, G g4), t, c) - - let gauge4 = Vector4 [(2, C_13_42); (-1, C_12_34); (-1, C_14_23)] - let minus_gauge4 = Vector4 [(-2, C_13_42); (1, C_12_34); (1, C_14_23)] - let standard_quartic_gauge = - List.map qgc - [ (Wm, Wp, Wm, Wp), gauge4, G_WWWW; - (Wm, Z, Wp, Z), minus_gauge4, G_ZZWW; - (Wm, Z, Wp, Ga), minus_gauge4, G_AZWW; - (Wm, Ga, Wp, Ga), minus_gauge4, G_AAWW; - (Gl, Gl, Gl, Gl), gauge4, G2] - - let quartic_gauge = - standard_quartic_gauge - - let gravity_gauge = - [ (O Grav, G Z, G Z), Graviton_Vector_Vector 1, G_Grav; - (O Grav, G Wp, G Wm), Graviton_Vector_Vector 1, G_Grav; - (O Grav, G Ga, G Ga), Graviton_Vector_Vector 1, G_Grav; - (O Grav, G Gl, G Gl), Graviton_Vector_Vector 1, G_Grav ] - - let standard_gauge_higgs = - [ ((O H, G Wp, G Wm), Scalar_Vector_Vector 1, G_HWW); - ((O H, G Z, G Z), Scalar_Vector_Vector 1, G_HZZ) ] - - let standard_gauge_higgs4 = - [ (O H, O H, G Wp, G Wm), Scalar2_Vector2 1, G_HHWW; - (O H, O H, G Z, G Z), Scalar2_Vector2 1, G_HHZZ ] - - let standard_higgs = - [ (O H, O H, O H), Scalar_Scalar_Scalar 1, G_H3 ] - - let standard_higgs4 = - [ (O H, O H, O H, O H), Scalar4 1, G_H4 ] - - let gravity_higgs = - [ (O Grav, O H, O H), Graviton_Scalar_Scalar 1, G_Grav] - - let anomalous_gauge_higgs = - [] - - let anomalous_gauge_higgs4 = - [] - - let anomalous_higgs = - [] - - let anomaly_higgs = - [ (O H, G Ga, G Ga), Dim5_Scalar_Gauge2 1, G_HGaGa; - (O H, G Ga, G Z), Dim5_Scalar_Gauge2 1, G_HGaZ; - (O H, G Gl, G Gl), Dim5_Scalar_Gauge2 1, G_Hgg ] - - let anomalous_higgs4 = - [] - - let gauge_higgs = - standard_gauge_higgs - - let gauge_higgs4 = - standard_gauge_higgs4 - - let higgs = - standard_higgs @ gravity_higgs - - let higgs4 = - standard_higgs4 - - let goldstone_vertices = - [ ((O Phi0, G Wm, G Wp), Scalar_Vector_Vector 1, I_G_ZWW); - ((O Phip, G Ga, G Wm), Scalar_Vector_Vector 1, I_Q_W); - ((O Phip, G Z, G Wm), Scalar_Vector_Vector 1, I_G_ZWW); - ((O Phim, G Wp, G Ga), Scalar_Vector_Vector 1, I_Q_W); - ((O Phim, G Wp, G Z), Scalar_Vector_Vector 1, I_G_ZWW) ] - - let vertices3 = - (ThoList.flatmap electromagnetic_currents [1;2;3] @ - ThoList.flatmap neutral_currents [1;2;3] @ - ThoList.flatmap color_currents [1;2;3] @ - ThoList.flatmap charged_currents [1;2;3] @ - ThoList.flatmap gravity_currents [1;2;3] @ - yukawa @ triple_gauge @ gravity_gauge @ - gauge_higgs @ higgs @ anomaly_higgs - @ goldstone_vertices) - - let vertices4 = - quartic_gauge @ gauge_higgs4 @ higgs4 - - let vertices () = (vertices3, vertices4, []) - -(* For efficiency, make sure that [F.of_vertices vertices] is - evaluated only once. *) - - let table = F.of_vertices (vertices ()) - let fuse2 = F.fuse2 table - let fuse3 = F.fuse3 table - let fuse = F.fuse table - let max_degree () = 4 - - let flavor_of_string = function - | "e-" -> M (L 1) | "e+" -> M (L (-1)) - | "mu-" -> M (L 2) | "mu+" -> M (L (-2)) - | "tau-" -> M (L 3) | "tau+" -> M (L (-3)) - | "nue" -> M (N 1) | "nuebar" -> M (N (-1)) - | "numu" -> M (N 2) | "numubar" -> M (N (-2)) - | "nutau" -> M (N 3) | "nutaubar" -> M (N (-3)) - | "u" -> M (U 1) | "ubar" -> M (U (-1)) - | "c" -> M (U 2) | "cbar" -> M (U (-2)) - | "t" -> M (U 3) | "tbar" -> M (U (-3)) - | "d" -> M (D 1) | "dbar" -> M (D (-1)) - | "s" -> M (D 2) | "sbar" -> M (D (-2)) - | "b" -> M (D 3) | "bbar" -> M (D (-3)) - | "g" | "gl" -> G Gl - | "A" -> G Ga | "Z" | "Z0" -> G Z - | "W+" -> G Wp | "W-" -> G Wm - | "H" -> O H - | "GG" -> O Grav - | _ -> invalid_arg "Models4.Xdim.flavor_of_string" - - let flavor_to_string = function - | M f -> - begin match f with - | L 1 -> "e-" | L (-1) -> "e+" - | L 2 -> "mu-" | L (-2) -> "mu+" - | L 3 -> "tau-" | L (-3) -> "tau+" - | L _ -> invalid_arg - "Models4.Xdim.flavor_to_string: invalid lepton" - | N 1 -> "nue" | N (-1) -> "nuebar" - | N 2 -> "numu" | N (-2) -> "numubar" - | N 3 -> "nutau" | N (-3) -> "nutaubar" - | N _ -> invalid_arg - "Models4.Xdim.flavor_to_string: invalid neutrino" - | U 1 -> "u" | U (-1) -> "ubar" - | U 2 -> "c" | U (-2) -> "cbar" - | U 3 -> "t" | U (-3) -> "tbar" - | U _ -> invalid_arg - "Models4.Xdim.flavor_to_string: invalid up type quark" - | D 1 -> "d" | D (-1) -> "dbar" - | D 2 -> "s" | D (-2) -> "sbar" - | D 3 -> "b" | D (-3) -> "bbar" - | D _ -> invalid_arg - "Models4.Xdim.flavor_to_string: invalid down type quark" - end - | G f -> - begin match f with - | Gl -> "g" - | Ga -> "A" | Z -> "Z" - | Wp -> "W+" | Wm -> "W-" - end - | O f -> - begin match f with - | Phip -> "phi+" | Phim -> "phi-" | Phi0 -> "phi0" - | H -> "H" | Grav -> "GG" - end - - let flavor_symbol = function - | M f -> - begin match f with - | L n when n > 0 -> "l" ^ string_of_int n - | L n -> "l" ^ string_of_int (abs n) ^ "b" - | N n when n > 0 -> "n" ^ string_of_int n - | N n -> "n" ^ string_of_int (abs n) ^ "b" - | U n when n > 0 -> "u" ^ string_of_int n - | U n -> "u" ^ string_of_int (abs n) ^ "b" - | D n when n > 0 -> "d" ^ string_of_int n - | D n -> "d" ^ string_of_int (abs n) ^ "b" - end - | G f -> - begin match f with - | Gl -> "gl" - | Ga -> "a" | Z -> "z" - | Wp -> "wp" | Wm -> "wm" - end - | O f -> - begin match f with - | Phip -> "pp" | Phim -> "pm" | Phi0 -> "p0" - | H -> "h" | Grav -> "gv" - end - - let flavor_sans_color_of_string = flavor_of_string - let flavor_sans_color_to_string = flavor_to_string - let flavor_sans_color_symbol = flavor_symbol - - let pdg = function - | M f -> - begin match f with - | L n when n > 0 -> 9 + 2*n - | L n -> - 9 + 2*n - | N n when n > 0 -> 10 + 2*n - | N n -> - 10 + 2*n - | U n when n > 0 -> 2*n - | U n -> 2*n - | D n when n > 0 -> - 1 + 2*n - | D n -> 1 + 2*n - end - | G f -> - begin match f with - | Gl -> 21 - | Ga -> 22 | Z -> 23 - | Wp -> 24 | Wm -> (-24) - end - | O f -> - begin match f with - | Phip | Phim -> 27 | Phi0 -> 26 - | H -> 25 | Grav -> 39 - end - - let mass_symbol f = - "mass(" ^ string_of_int (abs (pdg f)) ^ ")" - - let width_symbol f = - "width(" ^ string_of_int (abs (pdg f)) ^ ")" - - let constant_symbol = function - | Unit -> "unit" | Pi -> "PI" - | Alpha_QED -> "alpha" | E -> "e" | G_weak -> "g" | Vev -> "vev" - | Sin2thw -> "sin2thw" | Sinthw -> "sinthw" | Costhw -> "costhw" - | Q_lepton -> "qlep" | Q_up -> "qup" | Q_down -> "qdwn" - | G_NC_lepton -> "gnclep" | G_NC_neutrino -> "gncneu" - | G_NC_up -> "gncup" | G_NC_down -> "gncdwn" - | Gs -> "gs" | I_Gs -> "igs" | G2 -> "gs**2" - | G_CC -> "gcc" - | G_CCQ (n1,n2) -> "gccq" ^ string_of_int n1 ^ string_of_int n2 - | I_Q_W -> "iqw" | I_G_ZWW -> "igzww" - | G_WWWW -> "gw4" | G_ZZWW -> "gzzww" - | G_AZWW -> "gazww" | G_AAWW -> "gaaww" - | G_HWW -> "ghww" | G_HZZ -> "ghzz" - | G_HHWW -> "ghhww" | G_HHZZ -> "ghhzz" - | G_Htt -> "ghtt" | G_Hbb -> "ghbb" - | G_Htautau -> "ghtautau" | G_Hcc -> "ghcc" - | G_HGaZ -> "ghgaz" | G_HGaGa -> "ghgaga" | G_Hgg -> "ghgg" - | G_H3 -> "gh3" | G_H4 -> "gh4" | G_Grav -> "ggrav" - | Mass f -> "mass" ^ flavor_symbol f - | Width f -> "width" ^ flavor_symbol f - - end - -module UED (Flags : BSM_flags) = - struct - let rcs = RCS.rename rcs_file "Models4.UED" - [ "Universal Extra Dimensions"] - - open Coupling - - let default_width = ref Timelike - let use_fudged_width = ref false - - let options = Options.create - [ "constant_width", Arg.Unit (fun () -> default_width := Constant), - "use constant width (also in t-channel)"; - "fudged_width", Arg.Set use_fudged_width, - "use fudge factor for charge particle width"; - "custom_width", Arg.String (fun f -> default_width := Custom f), - "use custom width"; - "cancel_widths", Arg.Unit (fun () -> default_width := Vanishing), - "use vanishing width"] - - type matter_field = L of int | N of int | U of int | D of int - | L_K1_L of int | L_K1_R of int | N_K1 of int - | L_K2_L of int | L_K2_R of int | N_K2 of int - | U_K1_L of int | U_K2_L of int | D_K1_L of int | D_K2_L of int - | U_K1_R of int | U_K2_R of int | D_K1_R of int | D_K2_R of int - type gauge_boson = Ga | Wp | Wm | Z | Gl | Gl_K1 | Gl_K2 - | B1 | B2 | Z1 | Z2 | Wp1 | Wm1 | Wp2 | Wm2 - type other = Phip | Phim | Phi0 | H | H1up | H1um - | H1dp | H1dm | H2up |H2um | H2dp |H2dm - | Grav - type flavor = M of matter_field | G of gauge_boson | O of other - type flavor_sans_color = flavor - let flavor_sans_color f = f - - let matter_field f = M f - let gauge_boson f = G f - let other f = O f - - type field = - | Matter of matter_field - | Gauge of gauge_boson - | Other of other - - let field = function - | M f -> Matter f - | G f -> Gauge f - | O f -> Other f - - type gauge = unit - - let gauge_symbol () = - failwith "Models4.UED.gauge_symbol: internal error" - - let family n = List.map matter_field [ L n; N n; U n; D n; L_K1_L n; - L_K1_R n; L_K2_L n; L_K2_R n; N_K1 n; N_K2 n; U_K1_L n; U_K2_L n; - D_K1_L n; D_K2_L n; U_K1_R n; U_K2_R n; D_K1_R n; D_K2_R n] - -(* We don't introduce a special index for the higher excitations but make - them parts of the particles' names. *) - - let external_flavors () = - [ "1st Generation", ThoList.flatmap family [1; -1]; - "2nd Generation", ThoList.flatmap family [2; -2]; - "3rd Generation", ThoList.flatmap family [3; -3]; - "Gauge Bosons", List.map gauge_boson [Ga; Z; Wp; Wm; Gl; - Gl_K1; Gl_K2; B1; B2; Z1; Z2; Wp1 ; Wm1; Wp2; Wm2]; - "Higgs", List.map other [H; H1up; H1um; H1dp; H1dm; - H2up; H2um; H2dp; H2dm]; - "Graviton", List.map other [Grav]; - "Goldstone Bosons", List.map other [Phip; Phim; Phi0] ] - - let flavors () = ThoList.flatmap snd (external_flavors ()) - - let spinor n = - if n >= 0 then - Spinor - else - ConjSpinor - - let lorentz = function - | M f -> - begin match f with - | L n -> spinor n | N n -> spinor n - | U n -> spinor n | D n -> spinor n - | L_K1_L n -> spinor n | L_K1_R n -> spinor n - | L_K2_L n -> spinor n | L_K2_R n -> spinor n - | N_K1 n -> spinor n | N_K2 n -> spinor n - | U_K1_L n -> spinor n | U_K1_R n -> spinor n - | U_K2_L n -> spinor n | U_K2_R n -> spinor n - | D_K1_L n -> spinor n | D_K1_R n -> spinor n - | D_K2_L n -> spinor n | D_K2_R n -> spinor n - end - | G f -> - begin match f with - | Ga | Gl -> Vector - | Wp | Wm | Z | Gl_K1 | Gl_K2 | B1 | B2 - | Z1 | Z2 | Wp1 | Wm1 | Wp2 | Wm2 -> Massive_Vector - end - | O f -> - begin match f with - | Grav -> Tensor_2 - | _ -> Scalar - end - - let color = function - | M (U n) -> Color.SUN (if n > 0 then 3 else -3) - | M (D n) -> Color.SUN (if n > 0 then 3 else -3) - | M (U_K1_L n) -> Color.SUN (if n > 0 then 3 else -3) - | M (D_K1_L n) -> Color.SUN (if n > 0 then 3 else -3) - | M (U_K1_R n) -> Color.SUN (if n > 0 then 3 else -3) - | M (D_K1_R n) -> Color.SUN (if n > 0 then 3 else -3) - | M (U_K2_L n) -> Color.SUN (if n > 0 then 3 else -3) - | M (D_K2_L n) -> Color.SUN (if n > 0 then 3 else -3) - | M (U_K2_R n) -> Color.SUN (if n > 0 then 3 else -3) - | M (D_K2_R n) -> Color.SUN (if n > 0 then 3 else -3) - | G Gl | G Gl_K1 | G Gl_K2 -> Color.AdjSUN 3 - | _ -> Color.Singlet - - let prop_spinor n = - if n >= 0 then - Prop_Spinor - else - Prop_ConjSpinor - - let propagator = function - | M f -> - begin match f with - | L n -> prop_spinor n | N n -> prop_spinor n - | U n -> prop_spinor n | D n -> prop_spinor n - | L_K1_L n -> prop_spinor n | L_K1_R n -> prop_spinor n - | L_K2_L n -> prop_spinor n | L_K2_R n -> prop_spinor n - | N_K1 n -> prop_spinor n | N_K2 n -> prop_spinor n - | U_K1_L n -> prop_spinor n | U_K1_R n -> prop_spinor n - | U_K2_L n -> prop_spinor n | U_K2_R n -> prop_spinor n - | D_K1_L n -> prop_spinor n | D_K1_R n -> prop_spinor n - | D_K2_L n -> prop_spinor n | D_K2_R n -> prop_spinor n - end - | G f -> - begin match f with - | Ga | Gl -> Prop_Feynman - | Wp | Wm | Z | Gl_K1 | Gl_K2 | B1 | B2 - | Z1 | Z2 | Wp1 | Wm1 | Wp2 | Wm2 -> Prop_Unitarity - end - | O f -> - begin match f with - | Phip | Phim | Phi0 -> Only_Insertion - | H | H1up | H1um | H1dp | H1dm | H2up - | H2um | H2dp | H2dm -> Prop_Scalar - | Grav -> Prop_Tensor_2 - end - -(* Optionally, ask for the fudge factor treatment for the widths of - charged particles. Currently, this only applies to $W^\pm$ and top. *) - - let width f = - if !use_fudged_width then - match f with - | G Wp | G Wm | M (U 3) | M (U (-3)) | O Grav -> Fudged - | _ -> !default_width - else - !default_width - - let goldstone = function - | G f -> - begin match f with - | Wp -> Some (O Phip, Coupling.Const 1) - | Wm -> Some (O Phim, Coupling.Const 1) - | Z -> Some (O Phi0, Coupling.Const 1) - | _ -> None - end - | _ -> None - - let conjugate = function - | M f -> - M (begin match f with - | L n -> L (-n) | N n -> N (-n) - | U n -> U (-n) | D n -> D (-n) - | L_K1_L n -> L_K1_L (-n) | L_K1_R n -> L_K1_R (-n) - | L_K2_L n -> L_K2_L (-n) | L_K2_R n -> L_K2_R (-n) - | N_K1 n -> N_K1 (-n) | N_K2 n -> N_K2 (-n) - | U_K1_L n -> U_K1_L (-n) | U_K1_R n -> U_K1_R (-n) - | U_K2_L n -> U_K2_L (-n) | U_K2_R n -> U_K2_R (-n) - | D_K1_L n -> D_K1_L (-n) | D_K1_R n -> D_K1_R (-n) - | D_K2_L n -> D_K2_L (-n) | D_K2_R n -> D_K2_R (-n) - end) - | G f -> - G (begin match f with - | Gl -> Gl | Ga -> Ga | Z -> Z - | Wp -> Wm | Wm -> Wp - | Gl_K1 -> Gl_K1 | Gl_K2 -> Gl_K2 | B1 -> B1 | B2 -> B2 - | Z1 -> Z1 | Z2 -> Z2 | Wp1 -> Wm1 | Wm1 -> Wp1 - | Wp2 -> Wm2 | Wm2 -> Wp2 - end) - | O f -> - O (begin match f with - | Phip -> Phim | Phim -> Phip | Phi0 -> Phi0 - | H -> H | H1up -> H1um | H1um -> H1up - | H1dp -> H1dm | H1dm -> H1dp - | H2up -> H2um | H2um -> H2up - | H2dp -> H2dm | H2dm -> H2dp - | Grav -> Grav - end) - - let conjugate_sans_color = conjugate - - let fermion = function - | M f -> - begin match f with - | L n -> if n > 0 then 1 else -1 - | N n -> if n > 0 then 1 else -1 - | U n -> if n > 0 then 1 else -1 - | D n -> if n > 0 then 1 else -1 - | L_K1_L n -> if n > 0 then 1 else -1 - | L_K2_L n -> if n > 0 then 1 else -1 - | L_K1_R n -> if n > 0 then 1 else -1 - | L_K2_R n -> if n > 0 then 1 else -1 - | U_K1_L n -> if n > 0 then 1 else -1 - | U_K2_L n -> if n > 0 then 1 else -1 - | U_K1_R n -> if n > 0 then 1 else -1 - | U_K2_R n -> if n > 0 then 1 else -1 - | D_K1_L n -> if n > 0 then 1 else -1 - | D_K2_L n -> if n > 0 then 1 else -1 - | D_K1_R n -> if n > 0 then 1 else -1 - | D_K2_R n -> if n > 0 then 1 else -1 - | N_K1 n -> if n > 0 then 1 else -1 - | N_K2 n -> if n > 0 then 1 else -1 - end - | G f -> - begin match f with - | Gl | Ga | Z | Wp | Wm | Gl_K1 | Gl_K2 - | B1 | B2 | Z1 | Z2 | Wp1 | Wm1 | Wp2 - | Wm2 -> 0 - end - | O _ -> 0 - - type constant = - | Unit | Pi | Alpha_QED | Sin2thw - | Sinthw | Costhw | E | G_weak | Vev - | Q_lepton | Q_up | Q_down | G_CC | G_CCQ of int*int - | G_NC_neutrino | G_NC_lepton | G_NC_up | G_NC_down - | I_Q_W | I_G_ZWW | I_Q_W_K | I_G_ZWW_K1 | I_G_ZWW_K2 - | I_G_ZWW_K3 - | G_WWWW | G_ZZWW | G_AZWW | G_AAWW - | G_HWW | G_HHWW | G_HZZ | G_HHZZ - | G_Htt | G_Hbb | G_Hcc | G_Htautau | G_H3 | G_H4 - | G_HGaZ | G_HGaGa | G_Hgg - | Gs | I_Gs | I_GsRt2 | G2 | G22 | G_Grav - | Mass of flavor | Width of flavor - - let input_parameters = - [] - - let derived_parameters = - [] - - let derived_parameter_arrays = - [] - - let parameters () = - { input = input_parameters; - derived = derived_parameters; - derived_arrays = derived_parameter_arrays } - - module F = Models.Fusions (struct - type f = flavor - type c = constant - let compare = compare - let conjugate = conjugate - end) - - let mgm ((m1, g, m2), fbf, c) = ((M m1, G g, M m2), fbf, c) - let mom ((m1, o, m2), fbf, c) = ((M m1, O o, M m2), fbf, c) - - let electromagnetic_currents n = - List.map mgm - [ ((L (-n), Ga, L n), FBF (1, Psibar, V, Psi), Q_lepton); - ((U (-n), Ga, U n), FBF (1, Psibar, V, Psi), Q_up); - ((D (-n), Ga, D n), FBF (1, Psibar, V, Psi), Q_down) ] - - let neutral_currents n = - List.map mgm - [ ((L (-n), Z, L n), FBF (1, Psibar, VA, Psi), G_NC_lepton); - ((N (-n), Z, N n), FBF (1, Psibar, VA, Psi), G_NC_neutrino); - ((U (-n), Z, U n), FBF (1, Psibar, VA, Psi), G_NC_up); - ((D (-n), Z, D n), FBF (1, Psibar, VA, Psi), G_NC_down) ] - - let charged_currents n = - List.map mgm - [ ((L (-n), Wm, N n), FBF (1, Psibar, VL, Psi), G_CC); - ((N (-n), Wp, L n), FBF (1, Psibar, VL, Psi), G_CC); - ((D (-n), Wm, U n), FBF (1, Psibar, VL, Psi), G_CC); - ((U (-n), Wp, D n), FBF (1, Psibar, VL, Psi), G_CC) ] - - let color_currents n = - List.map mgm - [ ((U (-n), Gl, U n), FBF ((-1), Psibar, V, Psi), Gs); - ((D (-n), Gl, D n), FBF ((-1), Psibar, V, Psi), Gs) ] - - let gravity_currents n = - List.map mom - [ ((L (-n), Grav, L n), Graviton_Spinor_Spinor 1, G_Grav); - ((N (-n), Grav, N n), Graviton_Spinor_Spinor 1, G_Grav); - ((U (-n), Grav, U n), Graviton_Spinor_Spinor 1, G_Grav); - ((D (-n), Grav, D n), Graviton_Spinor_Spinor 1, G_Grav) ] - - let yukawa = - List.map mom - [ ((U (-3), H, U 3), FBF (1, Psibar, S, Psi), G_Htt); - ((D (-3), H, D 3), FBF (1, Psibar, S, Psi), G_Hbb); - ((U (-2), H, U 2), FBF (1, Psibar, S, Psi), G_Hcc); - ((L (-3), H, L 3), FBF (1, Psibar, S, Psi), G_Htautau) ] - - let tgc ((g1, g2, g3), t, c) = ((G g1, G g2, G g3), t, c) - -(* Gluons should be included in just that way. *) - - let standard_triple_gauge = - List.map tgc - [ ((Ga, Wm, Wp), Gauge_Gauge_Gauge 1, I_Q_W); - ((Ga, Wm1, Wp1), Gauge_Gauge_Gauge 1, I_Q_W_K); - ((Z, Wm, Wp), Gauge_Gauge_Gauge 1, I_G_ZWW); - ((Z, Wm1, Wp1), Gauge_Gauge_Gauge 1, I_G_ZWW_K1); - ((Z1, Wm, Wp1), Gauge_Gauge_Gauge 1, I_G_ZWW_K2); - ((Z1, Wm1, Wp), Gauge_Gauge_Gauge 1, I_G_ZWW_K2); - ((Z2, Wm1, Wp2), Gauge_Gauge_Gauge 1, I_G_ZWW_K3); - ((Gl, Gl, Gl), Gauge_Gauge_Gauge 1, I_Gs); - ((Gl, Gl_K2, Gl_K2), Gauge_Gauge_Gauge (-1), I_Gs); - ((Gl, Gl_K1, Gl_K1), Gauge_Gauge_Gauge 1, I_Gs); - ((Gl_K2, Gl_K1, Gl_K1), Gauge_Gauge_Gauge 1, I_GsRt2)] - - let triple_gauge = - standard_triple_gauge - - let qgc ((g1, g2, g3, g4), t, c) = ((G g1, G g2, G g3, G g4), t, c) - - let gauge4 = Vector4 [(2, C_13_42); (-1, C_12_34); (-1, C_14_23)] - let minus_gauge4 = Vector4 [(-2, C_13_42); (1, C_12_34); (1, C_14_23)] - let standard_quartic_gauge = - List.map qgc - [ (Wm, Wp, Wm, Wp), gauge4, G_WWWW; - (Wm, Z, Wp, Z), minus_gauge4, G_ZZWW; - (Wm, Z, Wp, Ga), minus_gauge4, G_AZWW; - (Wm, Ga, Wp, Ga), minus_gauge4, G_AAWW; - ((Gl, Gl, Gl, Gl), gauge4, G2); - ((Gl, Gl, Gl_K1, Gl_K1), gauge4, G2); - ((Gl, Gl, Gl_K2, Gl_K2), gauge4, G2); - ((Gl_K1, Gl_K1, Gl_K2, Gl_K2), gauge4, G2); - ((Gl_K2, Gl_K2, Gl_K2, Gl_K2), gauge4, G22)] - - let quartic_gauge = - standard_quartic_gauge - - let gravity_gauge = - [ (O Grav, G Z, G Z), Graviton_Vector_Vector 1, G_Grav; - (O Grav, G Wp, G Wm), Graviton_Vector_Vector 1, G_Grav; - (O Grav, G Ga, G Ga), Graviton_Vector_Vector 1, G_Grav; - (O Grav, G Gl, G Gl), Graviton_Vector_Vector 1, G_Grav ] - - let standard_gauge_higgs = - [ ((O H, G Wp, G Wm), Scalar_Vector_Vector 1, G_HWW); - ((O H, G Z, G Z), Scalar_Vector_Vector 1, G_HZZ) ] - - let standard_gauge_higgs4 = - [ (O H, O H, G Wp, G Wm), Scalar2_Vector2 1, G_HHWW; - (O H, O H, G Z, G Z), Scalar2_Vector2 1, G_HHZZ ] - - let standard_higgs = - [ (O H, O H, O H), Scalar_Scalar_Scalar 1, G_H3 ] - - let standard_higgs4 = - [ (O H, O H, O H, O H), Scalar4 1, G_H4 ] - - let gravity_higgs = - [ (O Grav, O H, O H), Graviton_Scalar_Scalar 1, G_Grav] - - let anomalous_gauge_higgs = - [] - - let anomalous_gauge_higgs4 = - [] - - let anomalous_higgs = - [] - - let anomaly_higgs = - [ (O H, G Ga, G Ga), Dim5_Scalar_Gauge2 1, G_HGaGa; - (O H, G Ga, G Z), Dim5_Scalar_Gauge2 1, G_HGaZ; - (O H, G Gl, G Gl), Dim5_Scalar_Gauge2 1, G_Hgg ] - - let anomalous_higgs4 = - [] - - let gauge_higgs = - standard_gauge_higgs - - let gauge_higgs4 = - standard_gauge_higgs4 - - let higgs = - standard_higgs @ gravity_higgs - - let higgs4 = - standard_higgs4 - - let goldstone_vertices = - [ ((O Phi0, G Wm, G Wp), Scalar_Vector_Vector 1, I_G_ZWW); - ((O Phip, G Ga, G Wm), Scalar_Vector_Vector 1, I_Q_W); - ((O Phip, G Z, G Wm), Scalar_Vector_Vector 1, I_G_ZWW); - ((O Phim, G Wp, G Ga), Scalar_Vector_Vector 1, I_Q_W); - ((O Phim, G Wp, G Z), Scalar_Vector_Vector 1, I_G_ZWW) ] - - let vertices3 = - (ThoList.flatmap electromagnetic_currents [1;2;3] @ - ThoList.flatmap neutral_currents [1;2;3] @ - ThoList.flatmap charged_currents [1;2;3] @ - ThoList.flatmap color_currents [1;2;3] @ - ThoList.flatmap gravity_currents [1;2;3] @ - yukawa @ triple_gauge @ gravity_gauge @ - gauge_higgs @ higgs @ anomaly_higgs - @ goldstone_vertices) - - let vertices4 = - quartic_gauge @ gauge_higgs4 @ higgs4 - - let vertices () = (vertices3, vertices4, []) - -(* For efficiency, make sure that [F.of_vertices vertices] is - evaluated only once. *) - - let table = F.of_vertices (vertices ()) - let fuse2 = F.fuse2 table - let fuse3 = F.fuse3 table - let fuse = F.fuse table - let max_degree () = 4 - - let flavor_of_string = function - | "e-" -> M (L 1) | "e+" -> M (L (-1)) - | "mu-" -> M (L 2) | "mu+" -> M (L (-2)) - | "tau-" -> M (L 3) | "tau+" -> M (L (-3)) - | "nue" -> M (N 1) | "nuebar" -> M (N (-1)) - | "numu" -> M (N 2) | "numubar" -> M (N (-2)) - | "nutau" -> M (N 3) | "nutaubar" -> M (N (-3)) - | "u" -> M (U 1) | "ubar" -> M (U (-1)) - | "c" -> M (U 2) | "cbar" -> M (U (-2)) - | "t" -> M (U 3) | "tbar" -> M (U (-3)) - | "d" -> M (D 1) | "dbar" -> M (D (-1)) - | "s" -> M (D 2) | "sbar" -> M (D (-2)) - | "b" -> M (D 3) | "bbar" -> M (D (-3)) - | "uk1l" -> M (U_K1_L 1) | "uk1lbar" -> M (U_K1_L (-1)) - | "ck1l" -> M (U_K1_L 2) | "ck1lbar" -> M (U_K1_L (-2)) - | "tk1l" -> M (U_K1_L 3) | "tk1lbar" -> M (U_K1_L (-3)) - | "dk1l" -> M (D_K1_L 1) | "dk1lbar" -> M (D_K1_L (-1)) - | "sk1l" -> M (D_K1_L 2) | "sk1lbar" -> M (D_K1_L (-2)) - | "bk1l" -> M (D_K1_L 3) | "bk1lbar" -> M (D_K1_L (-3)) - | "uk1r" -> M (U_K1_R 1) | "uk1rbar" -> M (U_K1_R (-1)) - | "ck1r" -> M (U_K1_R 2) | "ck1rbar" -> M (U_K1_R (-2)) - | "tk1r" -> M (U_K1_R 3) | "tk1rbar" -> M (U_K1_R (-3)) - | "dk1r" -> M (D_K1_R 1) | "dk1rbar" -> M (D_K1_R (-1)) - | "sk1r" -> M (D_K1_R 2) | "sk1rbar" -> M (D_K1_R (-2)) - | "bk1r" -> M (D_K1_R 3) | "bk1rbar" -> M (D_K1_R (-3)) - | "uk2l" -> M (U_K2_L 1) | "uk2lbar" -> M (U_K2_L (-1)) - | "ck2l" -> M (U_K2_L 2) | "ck2lbar" -> M (U_K2_L (-2)) - | "tk2l" -> M (U_K2_L 3) | "tk2lbar" -> M (U_K2_L (-3)) - | "dk2l" -> M (D_K2_L 1) | "dk2lbar" -> M (D_K2_L (-1)) - | "sk2l" -> M (D_K2_L 2) | "sk2lbar" -> M (D_K2_L (-2)) - | "bk2l" -> M (D_K2_L 3) | "bk2lbar" -> M (D_K2_L (-3)) - | "uk2r" -> M (U_K2_R 1) | "uk2rbar" -> M (U_K2_R (-1)) - | "ck2r" -> M (U_K2_R 2) | "ck2rbar" -> M (U_K2_R (-2)) - | "tk2r" -> M (U_K2_R 3) | "tk2rbar" -> M (U_K2_R (-3)) - | "dk2r" -> M (D_K2_R 1) | "dk2rbar" -> M (D_K2_R (-1)) - | "sk2r" -> M (D_K2_R 2) | "sk2rbar" -> M (D_K2_R (-2)) - | "bk2r" -> M (D_K2_R 3) | "bk2rbar" -> M (D_K2_R (-3)) - | "g" | "gl" -> G Gl - | "g_k1" | "gl_k1" -> G Gl_K1 - | "g_k2" | "gl_k2" -> G Gl_K2 - | "b1" -> G B1 | "b2" -> G B2 | "z1" -> G Z1 | "z2" -> G Z2 - | "W1+" -> G Wp1 | "W1-" -> G Wm1 - | "W2+" -> G Wp2 | "W2-" -> G Wm2 - | "A" -> G Ga | "Z" | "Z0" -> G Z - | "W+" -> G Wp | "W-" -> G Wm - | "H" -> O H | "H1u+" -> O H1up | "H1u-" -> O H1um - | "H1d+" -> O H1dp | "H1d-" -> O H1dm - | "H2u+" -> O H2up | "H2u-" -> O H2um - | "H2d+" -> O H2dp | "H2d-" -> O H2dm - | "GG" -> O Grav - | "ek1l-" -> M (L_K1_L 1) | "ek1l+" -> M (L_K1_L (-1)) - | "muk1l-" -> M (L_K1_L 2) | "mu1l+" -> M (L_K1_L (-2)) - | "tauk1l-" -> M (L_K1_L 3) | "tauk1l+" -> M (L_K1_L (-3)) - | "ek1r-" -> M (L_K1_R 1) | "ek1r+" -> M (L_K1_R (-1)) - | "muk1r-" -> M (L_K1_R 2) | "mu1r+" -> M (L_K1_R (-2)) - | "tau1r-" -> M (L_K1_R 3) | "tauk1r+" -> M (L_K1_R (-3)) - | "ek2l-" -> M (L_K2_L 1) | "ek2l+" -> M (L_K2_L (-1)) - | "muk2l-" -> M (L_K2_L 2) | "mu2l+" -> M (L_K2_L (-2)) - | "tauk2l-" -> M (L_K2_L 3) | "tauk2l+" -> M (L_K2_L (-3)) - | "ek2r-" -> M (L_K2_R 1) | "ek2r+" -> M (L_K2_R (-1)) - | "muk2r-" -> M (L_K2_R 2) | "mu2r+" -> M (L_K2_R (-2)) - | "tau2r-" -> M (L_K2_R 3) | "tauk2r+" -> M (L_K2_R (-3)) - | "nuek1" -> M (N_K1 1) | "nuek1bar" -> M (N_K1 (-1)) - | "numuk1" -> M (N_K1 2) | "numuk1bar" -> M (N_K1 (-2)) - | "nutauk1" -> M (N_K1 3) | "nutauk1bar" -> M (N_K1 (-3)) - | "nuek2" -> M (N_K2 1) | "nuek2bar" -> M (N_K2 (-1)) - | "numuk2" -> M (N_K2 2) | "numuk2bar" -> M (N_K2 (-2)) - | "nutauk2" -> M (N_K2 3) | "nutauk2bar" -> M (N_K2 (-3)) - | _ -> invalid_arg "Models4.UED.flavor_of_string" - - let flavor_to_string = function - | M f -> - begin match f with - | L 1 -> "e-" | L (-1) -> "e+" - | L 2 -> "mu-" | L (-2) -> "mu+" - | L 3 -> "tau-" | L (-3) -> "tau+" - | L _ -> invalid_arg - "Models4.UED.flavor_to_string: invalid lepton" - | N 1 -> "nue" | N (-1) -> "nuebar" - | N 2 -> "numu" | N (-2) -> "numubar" - | N 3 -> "nutau" | N (-3) -> "nutaubar" - | N _ -> invalid_arg - "Models4.UED.flavor_to_string: invalid neutrino" - | U 1 -> "u" | U (-1) -> "ubar" - | U 2 -> "c" | U (-2) -> "cbar" - | U 3 -> "t" | U (-3) -> "tbar" - | U _ -> invalid_arg - "Models4.UED.flavor_to_string: invalid up type quark" - | D 1 -> "d" | D (-1) -> "dbar" - | D 2 -> "s" | D (-2) -> "sbar" - | D 3 -> "b" | D (-3) -> "bbar" - | D _ -> invalid_arg - "Models4.UED.flavor_to_string: invalid down type quark" - | U_K1_L 1 -> "uk1l" | U_K1_L (-1) -> "uk1lbar" - | U_K1_L 2 -> "ck1l" | U_K1_L (-2) -> "ck1lbar" - | U_K1_L 3 -> "tk1l" | U_K1_L (-3) -> "tk1lbar" - | U_K1_L _ -> invalid_arg - "Models4.UED.flavor_to_string: invalid up type quark" - | D_K1_L 1 -> "dk1l" | D_K1_L (-1) -> "dk1lbar" - | D_K1_L 2 -> "sk1l" | D_K1_L (-2) -> "sk1lbar" - | D_K1_L 3 -> "bk1l" | D_K1_L (-3) -> "bk1lbar" - | D_K1_L _ -> invalid_arg - "Models4.UED.flavor_to_string: invalid down type quark" - | U_K1_R 1 -> "uk1r" | U_K1_R (-1) -> "uk1rbar" - | U_K1_R 2 -> "ck1r" | U_K1_R (-2) -> "ck1rbar" - | U_K1_R 3 -> "tk1r" | U_K1_R (-3) -> "tk1rbar" - | U_K1_R _ -> invalid_arg - "Models4.UED.flavor_to_string: invalid up type quark" - | D_K1_R 1 -> "dk1r" | D_K1_R (-1) -> "dk1rbar" - | D_K1_R 2 -> "sk1r" | D_K1_R (-2) -> "sk1rbar" - | D_K1_R 3 -> "bk1r" | D_K1_R (-3) -> "bk1rbar" - | D_K1_R _ -> invalid_arg - "Models4.UED.flavor_to_string: invalid down type quark" - | U_K2_L 1 -> "uk2l" | U_K2_L (-1) -> "uk2lbar" - | U_K2_L 2 -> "ck2l" | U_K2_L (-2) -> "ck2lbar" - | U_K2_L 3 -> "tk2l" | U_K2_L (-3) -> "tk2lbar" - | U_K2_L _ -> invalid_arg - "Models4.UED.flavor_to_string: invalid up type quark" - | D_K2_L 1 -> "dk2l" | D_K2_L (-1) -> "dk2lbar" - | D_K2_L 2 -> "sk2l" | D_K2_L (-2) -> "sk2lbar" - | D_K2_L 3 -> "bk2l" | D_K2_L (-3) -> "bk2lbar" - | D_K2_L _ -> invalid_arg - "Models4.UED.flavor_to_string: invalid down type quark" - | U_K2_R 1 -> "uk2r" | U_K2_R (-1) -> "uk2rbar" - | U_K2_R 2 -> "ck2r" | U_K2_R (-2) -> "ck2rbar" - | U_K2_R 3 -> "tk2r" | U_K2_R (-3) -> "tk2rbar" - | U_K2_R _ -> invalid_arg - "Models4.UED.flavor_to_string: invalid up type quark" - | D_K2_R 1 -> "dk2r" | D_K2_R (-1) -> "dk2rbar" - | D_K2_R 2 -> "sk2r" | D_K2_R (-2) -> "sk2rbar" - | D_K2_R 3 -> "bk2r" | D_K2_R (-3) -> "bk2rbar" - | D_K2_R _ -> invalid_arg - "Models4.UED.flavor_to_string: invalid down type quark" - | L_K1_L 1 -> "ek1l-" | L_K1_L (-1) -> "ek1l+" - | L_K1_L 2 -> "muk1l-" | L_K1_L (-2) -> "muk1l+" - | L_K1_L 3 -> "tauk1l-" | L_K1_L (-3) -> "tauk1l+" - | L_K1_L _ -> invalid_arg - "Models4.UED.flavor_to_string: invalid lepton" - | L_K1_R 1 -> "ek1r-" | L_K1_R (-1) -> "ek1r+" - | L_K1_R 2 -> "muk1r-" | L_K1_R (-2) -> "muk1r+" - | L_K1_R 3 -> "tauk1r-" | L_K1_R (-3) -> "tauk1r+" - | L_K1_R _ -> invalid_arg - "Models4.UED.flavor_to_string: invalid lepton" - | L_K2_L 1 -> "ek2l-" | L_K2_L (-1) -> "ek2l+" - | L_K2_L 2 -> "muk2l-" | L_K2_L (-2) -> "muk2l+" - | L_K2_L 3 -> "tauk2l-" | L_K2_L (-3) -> "tauk2l+" - | L_K2_L _ -> invalid_arg - "Models4.UED.flavor_to_string: invalid lepton" - | L_K2_R 1 -> "ek2r-" | L_K2_R (-1) -> "ek2r+" - | L_K2_R 2 -> "muk2r-" | L_K2_R (-2) -> "muk2r+" - | L_K2_R 3 -> "tauk2r-" | L_K2_R (-3) -> "tauk2r+" - | L_K2_R _ -> invalid_arg - "Models4.UED.flavor_to_string: invalid lepton" - | N_K1 1 -> "nuek1" | N_K1 (-1) -> "nuek1bar" - | N_K1 2 -> "numuk1" | N_K1 (-2) -> "numuk1bar" - | N_K1 3 -> "nutauk1" | N_K1 (-3) -> "nutauk1bar" - | N_K1 _ -> invalid_arg - "Models4.UED.flavor_to_string: invalid neutrino" - | N_K2 1 -> "nuek2" | N_K2 (-1) -> "nuek2bar" - | N_K2 2 -> "numuk2" | N_K2 (-2) -> "numuk2bar" - | N_K2 3 -> "nutauk2" | N_K2 (-3) -> "nutauk2bar" - | N_K2 _ -> invalid_arg - "Models4.UED.flavor_to_string: invalid neutrino" - end - | G f -> - begin match f with - | Gl -> "g" - | Ga -> "A" | Z -> "Z" - | Wp -> "W+" | Wm -> "W-" - | Gl_K1 -> "gk1" | Gl_K2 -> "gk2" - | B1 -> "b1" | B2 -> "b2" | Z1 -> "z1" | Z2 -> "z2" - | Wp1 -> "W1+" | Wm1 -> "W1-" - | Wp2 -> "W2+" | Wm2 -> "W2-" - end - | O f -> - begin match f with - | Phip -> "phi+" | Phim -> "phi-" | Phi0 -> "phi0" - | H -> "H" | H1up -> "H1u+" | H1um -> "H1u-" - | H1dp -> "H1d+" | H1dm -> "H1d-" - | H2up -> "H2u+" | H2um -> "H2u-" - | H2dp -> "H2d+" | H2dm -> "H2d-" - | Grav -> "GG" - end - - let flavor_symbol = function - | M f -> - begin match f with - | L n when n > 0 -> "l" ^ string_of_int n - | L n -> "l" ^ string_of_int (abs n) ^ "b" - | N n when n > 0 -> "n" ^ string_of_int n - | N n -> "n" ^ string_of_int (abs n) ^ "b" - | U n when n > 0 -> "u" ^ string_of_int n - | U n -> "u" ^ string_of_int (abs n) ^ "b" - | D n when n > 0 -> "d" ^ string_of_int n - | D n -> "d" ^ string_of_int (abs n) ^ "b" - | L_K1_L n when n > 0 -> "lk1l" ^ string_of_int n - | L_K1_L n -> "lk1l" ^ string_of_int (abs n) ^ "b" - | L_K1_R n when n > 0 -> "lk1r" ^ string_of_int n - | L_K1_R n -> "lk1r" ^ string_of_int (abs n) ^ "b" - | L_K2_L n when n > 0 -> "lk2l" ^ string_of_int n - | L_K2_L n -> "lk2l" ^ string_of_int (abs n) ^ "b" - | L_K2_R n when n > 0 -> "lk2r" ^ string_of_int n - | L_K2_R n -> "lk2r" ^ string_of_int (abs n) ^ "b" - | U_K1_L n when n > 0 -> "uk1l" ^ string_of_int n - | U_K1_L n -> "uk1l" ^ string_of_int (abs n) ^ "b" - | U_K1_R n when n > 0 -> "uk1r" ^ string_of_int n - | U_K1_R n -> "uk1r" ^ string_of_int (abs n) ^ "b" - | U_K2_L n when n > 0 -> "uk2l" ^ string_of_int n - | U_K2_L n -> "uk2l" ^ string_of_int (abs n) ^ "b" - | U_K2_R n when n > 0 -> "uk2r" ^ string_of_int n - | U_K2_R n -> "uk2r" ^ string_of_int (abs n) ^ "b" - | D_K1_L n when n > 0 -> "dk1l" ^ string_of_int n - | D_K1_L n -> "dk1l" ^ string_of_int (abs n) ^ "b" - | D_K1_R n when n > 0 -> "dk1r" ^ string_of_int n - | D_K1_R n -> "dk1r" ^ string_of_int (abs n) ^ "b" - | D_K2_L n when n > 0 -> "dk2l" ^ string_of_int n - | D_K2_L n -> "dk2l" ^ string_of_int (abs n) ^ "b" - | D_K2_R n when n > 0 -> "dk2r" ^ string_of_int n - | D_K2_R n -> "dk2r" ^ string_of_int (abs n) ^ "b" - | N_K1 n when n > 0 -> "nk1" ^ string_of_int n - | N_K1 n -> "nk1" ^ string_of_int (abs n) ^ "b" - | N_K2 n when n > 0 -> "nk2" ^ string_of_int n - | N_K2 n -> "nk2" ^ string_of_int (abs n) ^ "b" - end - | G f -> - begin match f with - | Gl -> "gl" - | Ga -> "a" | Z -> "z" - | Wp -> "wp" | Wm -> "wm" - | Gl_K1 -> "gk1" | Gl_K2 -> "gk2" - | B1 -> "b1" | B2 -> "b2" | Z1 -> "z1" | Z2 -> "z2" - | Wp1 -> "wp1" | Wm1 -> "wm1" - | Wp2 -> "wp2" | Wm2 -> "wm2" - end - | O f -> - begin match f with - | Phip -> "pp" | Phim -> "pm" | Phi0 -> "p0" - | H -> "h" | H1up -> "h1up" | H1um -> "h1um" - | H1dp -> "h1dp" | H1dm -> "h1dm" - | H2up -> "h2up" | H2um -> "h2um" - | H2dp -> "h2dp" | H2dm -> "h2dm" - | Grav -> "gv" - end - - let flavor_sans_color_of_string = flavor_of_string - let flavor_sans_color_to_string = flavor_to_string - let flavor_sans_color_symbol = flavor_symbol - - let pdg = function - | M f -> - begin match f with - | L n when n > 0 -> 9 + 2*n - | L n -> - 9 + 2*n - | N n when n > 0 -> 10 + 2*n - | N n -> - 10 + 2*n - | U n when n > 0 -> 2*n - | U n -> 2*n - | D n when n > 0 -> - 1 + 2*n - | D n -> 1 + 2*n - | U_K1_L n when n > 0 -> 4000000 + 2*n - | U_K1_L n -> - 4000000 + 2*n - | D_K1_L n when n > 0 -> 3999999 + 2*n - | D_K1_L n -> - 3999999 + 2*n - | U_K1_R n when n > 0 -> 5000000 + 2*n - | U_K1_R n -> - 5000000 + 2*n - | D_K1_R n when n > 0 -> 4999999 + 2*n - | D_K1_R n -> - 4999999 + 2*n - | U_K2_L n when n > 0 -> 6000000 + 2*n - | U_K2_L n -> - 6000000 + 2*n - | D_K2_L n when n > 0 -> 5999999 + 2*n - | D_K2_L n -> - 5999999 + 2*n - | U_K2_R n when n > 7000000 -> 2*n - | U_K2_R n -> - 7000000 + 2*n - | D_K2_R n when n > 0 -> 6999999 + 2*n - | D_K2_R n -> - 6999999 + 2*n - | L_K1_L n when n > 0 -> 4000009 + 2*n - | L_K1_L n -> - 4000009 + 2*n - | L_K1_R n when n > 0 -> 5000009 + 2*n - | L_K1_R n -> - 5000009 + 2*n - | L_K2_L n when n > 0 -> 6000009 + 2*n - | L_K2_L n -> - 6000009 + 2*n - | L_K2_R n when n > 0 -> 7000009 + 2*n - | L_K2_R n -> - 7000009 + 2*n - | N_K1 n when n > 0 -> 4000010 + 2*n - | N_K1 n -> - 4000010 + 2*n - | N_K2 n when n > 0 -> 6000010 + 2*n - | N_K2 n -> - 6000010 + 2*n - end - | G f -> - begin match f with - | Gl -> 21 - | Ga -> 22 | Z -> 23 - | Wp -> 24 | Wm -> (-24) - | Gl_K1 -> 4000021 | Gl_K2 -> 6000021 - | B1 -> 4000022 | B2 -> 6000022 - | Z1 -> 4000023 | Z2 -> 6000024 - | Wp1 -> 4000024 | Wm1 -> (-4000024) - | Wp2 -> 6000024 | Wm2 -> (-6000024) - end - | O f -> - begin match f with - | Phip | Phim -> 27 | Phi0 -> 26 - | H -> 25 | H1up -> 4000036 | H1um -> (-4000036) - | H1dp -> 4000037 | H1dm -> (-4000037) - | H2up -> 6000036 | H2um -> (-6000036) - | H2dp -> 6000037 | H2dm -> (-6000037) - | Grav -> 39 - end - - let mass_symbol f = - "mass(" ^ string_of_int (abs (pdg f)) ^ ")" - - let width_symbol f = - "width(" ^ string_of_int (abs (pdg f)) ^ ")" - - let constant_symbol = function - | Unit -> "unit" | Pi -> "PI" - | Alpha_QED -> "alpha" | E -> "e" | G_weak -> "g" | Vev -> "vev" - | Sin2thw -> "sin2thw" | Sinthw -> "sinthw" | Costhw -> "costhw" - | Q_lepton -> "qlep" | Q_up -> "qup" | Q_down -> "qdwn" - | G_NC_lepton -> "gnclep" | G_NC_neutrino -> "gncneu" - | G_NC_up -> "gncup" | G_NC_down -> "gncdwn" - | G_CC -> "gcc" - | G_CCQ (n1,n2) -> "gccq" ^ string_of_int n1 ^ string_of_int n2 - | I_Q_W -> "iqw" | I_G_ZWW -> "igzww" - | I_Q_W_K -> "iqwk" | I_G_ZWW_K1 -> "igzwwk1" - | I_G_ZWW_K2 -> "igzwwk2" | I_G_ZWW_K3 -> "igzwwk3" - | G_WWWW -> "gw4" | G_ZZWW -> "gzzww" - | G_AZWW -> "gazww" | G_AAWW -> "gaaww" - | G_HWW -> "ghww" | G_HZZ -> "ghzz" - | G_HHWW -> "ghhww" | G_HHZZ -> "ghhzz" - | G_Htt -> "ghtt" | G_Hbb -> "ghbb" - | G_Htautau -> "ghtautau" | G_Hcc -> "ghcc" - | G_HGaZ -> "ghgaz" | G_HGaGa -> "ghgaga" | G_Hgg -> "ghgg" - | G_H3 -> "gh3" | G_H4 -> "gh4" - | G2 -> "gs**2" | Gs -> "gs" | I_Gs -> "igs" | I_GsRt2 -> "igs/sqrt(2.0_default)" - | G22 -> "gs**2/2.0_default" - | G_Grav -> "ggrav" - | Mass f -> "mass" ^ flavor_symbol f - | Width f -> "width" ^ flavor_symbol f - - end - -module GravTest (Flags : BSM_flags) = - struct - let rcs = RCS.rename rcs_file "Models4.GravTest" - [ "Testing of Gravitinos"] - - open Coupling - - let default_width = ref Timelike - let use_fudged_width = ref false - - let options = Options.create - [ "constant_width", Arg.Unit (fun () -> default_width := Constant), - "use constant width (also in t-channel)"; - "fudged_width", Arg.Set use_fudged_width, - "use fudge factor for charge particle width"; - "custom_width", Arg.String (fun f -> default_width := Custom f), - "use custom width"; - "cancel_widths", Arg.Unit (fun () -> default_width := Vanishing), - "use vanishing width"] - - type matter_field = L of int | N of int | U of int | D of int | SL of int - type gauge_boson = Ga | Wp | Wm | Z | Gl | Phino - type other = Phip | Phim | Phi0 | H | Grino - type flavor = M of matter_field | G of gauge_boson | O of other - type flavor_sans_color = flavor - let flavor_sans_color f = f - - let matter_field f = M f - let gauge_boson f = G f - let other f = O f - - type field = - | Matter of matter_field - | Gauge of gauge_boson - | Other of other - - let field = function - | M f -> Matter f - | G f -> Gauge f - | O f -> Other f - - type gauge = unit - - let gauge_symbol () = - failwith "Models4.SM.gauge_symbol: internal error" - - let family n = List.map matter_field [ L n; SL n; N n; U n; D n ] - - let external_flavors () = - [ "1st Generation", ThoList.flatmap family [1; -1]; - "2nd Generation", ThoList.flatmap family [2; -2]; - "3rd Generation", ThoList.flatmap family [3; -3]; - "Gauge Bosons", List.map gauge_boson [Ga; Z; Wp; Wm; Gl; Phino]; - "Higgs", List.map other [H]; - "Gravitino", List.map other [Grino]; - "Goldstone Bosons", List.map other [Phip; Phim; Phi0] ] - - let flavors () = ThoList.flatmap snd (external_flavors ()) - - let spinor n = - if n >= 0 then - Spinor - else - ConjSpinor - - let lorentz = function - | M f -> - begin match f with - | L n -> spinor n | N n -> spinor n - | U n -> spinor n | D n -> spinor n - | SL _ -> Scalar - end - | G f -> - begin match f with - | Ga | Gl -> Vector - | Wp | Wm | Z -> Massive_Vector - | Phino -> Majorana - end - | O f -> - begin match f with - | Grino -> Vectorspinor - | _ -> Scalar - end - - let color = function - | M (U n) -> Color.SUN (if n > 0 then 3 else -3) - | M (D n) -> Color.SUN (if n > 0 then 3 else -3) - | G Gl -> Color.AdjSUN 3 - | _ -> Color.Singlet - - let prop_spinor n = - if n >= 0 then - Prop_Spinor - else - Prop_ConjSpinor - - let propagator = function - | M f -> - begin match f with - | L n -> prop_spinor n | N n -> prop_spinor n - | U n -> prop_spinor n | D n -> prop_spinor n - | SL n -> Prop_Scalar - end - | G f -> - begin match f with - | Ga | Gl -> Prop_Feynman - | Wp | Wm | Z -> Prop_Unitarity - | Phino -> Prop_Majorana - end - | O f -> - begin match f with - | Phip | Phim | Phi0 -> Only_Insertion - | H -> Prop_Scalar - | Grino -> Prop_Vectorspinor - end - -(* Optionally, ask for the fudge factor treatment for the widths of - charged particles. Currently, this only applies to $W^\pm$ and top. *) - - let width f = - if !use_fudged_width then - match f with - | G Wp | G Wm | M (U 3) | M (U (-3)) | O Grino -> Fudged - | _ -> !default_width - else - !default_width - - let goldstone = function - | G f -> - begin match f with - | Wp -> Some (O Phip, Coupling.Const 1) - | Wm -> Some (O Phim, Coupling.Const 1) - | Z -> Some (O Phi0, Coupling.Const 1) - | _ -> None - end - | _ -> None - - let conjugate = function - | M f -> - M (begin match f with - | L n -> L (-n) | N n -> N (-n) - | U n -> U (-n) | D n -> D (-n) - | SL n -> SL (-n) - end) - | G f -> - G (begin match f with - | Gl -> Gl | Ga -> Ga | Z -> Z - | Wp -> Wm | Wm -> Wp | Phino -> Phino - end) - | O f -> - O (begin match f with - | Phip -> Phim | Phim -> Phip | Phi0 -> Phi0 - | H -> H | Grino -> Grino - end) - - let conjugate_sans_color = conjugate - - let fermion = function - | M f -> - begin match f with - | L n -> if n > 0 then 1 else -1 - | N n -> if n > 0 then 1 else -1 - | U n -> if n > 0 then 1 else -1 - | D n -> if n > 0 then 1 else -1 - | SL _ -> 0 - end - | G f -> - begin match f with - | Gl | Ga | Z | Wp | Wm -> 0 - | Phino -> 2 - end - | O f -> - begin match f with - | Grino -> 2 - | _ -> 0 - end - - type constant = - | Unit | Pi | Alpha_QED | Sin2thw - | Sinthw | Costhw | E | G_weak | Vev - | Q_lepton | Q_up | Q_down | G_CC | G_CCQ of int*int - | G_NC_neutrino | G_NC_lepton | G_NC_up | G_NC_down - | I_Q_W | I_G_ZWW - | G_WWWW | G_ZZWW | G_AZWW | G_AAWW - | G_HWW | G_HHWW | G_HZZ | G_HHZZ - | G_Htt | G_Hbb | G_Hcc | G_Htautau | G_H3 | G_H4 - | G_HGaZ | G_HGaGa | G_Hgg - | G_strong | G_Grav - | Mass of flavor | Width of flavor - - let input_parameters = - [] - - let derived_parameters = - [] - - let derived_parameter_arrays = - [] - - let parameters () = - { input = input_parameters; - derived = derived_parameters; - derived_arrays = derived_parameter_arrays } - - module F = Models.Fusions (struct - type f = flavor - type c = constant - let compare = compare - let conjugate = conjugate - end) - - let mgm ((m1, g, m2), fbf, c) = ((M m1, G g, M m2), fbf, c) - let mom ((m1, o, m2), fbf, c) = ((M m1, O o, M m2), fbf, c) - - let electromagnetic_currents n = - List.map mgm - [ ((L (-n), Ga, L n), FBF (1, Psibar, V, Psi), Q_lepton); - ((U (-n), Ga, U n), FBF (1, Psibar, V, Psi), Q_up); - ((D (-n), Ga, D n), FBF (1, Psibar, V, Psi), Q_down) ] - - let neutral_currents n = - List.map mgm - [ ((L (-n), Z, L n), FBF (1, Psibar, VA, Psi), G_NC_lepton); - ((N (-n), Z, N n), FBF (1, Psibar, VA, Psi), G_NC_neutrino); - ((U (-n), Z, U n), FBF (1, Psibar, VA, Psi), G_NC_up); - ((D (-n), Z, D n), FBF (1, Psibar, VA, Psi), G_NC_down) ] - - let charged_currents n = - List.map mgm - [ ((L (-n), Wm, N n), FBF (1, Psibar, VL, Psi), G_CC); - ((N (-n), Wp, L n), FBF (1, Psibar, VL, Psi), G_CC); - ((D (-n), Wm, U n), FBF (1, Psibar, VL, Psi), G_CC); - ((U (-n), Wp, D n), FBF (1, Psibar, VL, Psi), G_CC) ] - - let yukawa = - List.map mom - [ ((U (-3), H, U 3), FBF (1, Psibar, S, Psi), G_Htt); - ((D (-3), H, D 3), FBF (1, Psibar, S, Psi), G_Hbb); - ((U (-2), H, U 2), FBF (1, Psibar, S, Psi), G_Hcc); - ((L (-3), H, L 3), FBF (1, Psibar, S, Psi), G_Htautau) ] - - let tgc ((g1, g2, g3), t, c) = ((G g1, G g2, G g3), t, c) - - let standard_triple_gauge = - List.map tgc - [ ((Ga, Wm, Wp), Gauge_Gauge_Gauge 1, I_Q_W); - ((Z, Wm, Wp), Gauge_Gauge_Gauge 1, I_G_ZWW) ] - - let triple_gauge = - standard_triple_gauge - - let qgc ((g1, g2, g3, g4), t, c) = ((G g1, G g2, G g3, G g4), t, c) - - let gauge4 = Vector4 [(2, C_13_42); (-1, C_12_34); (-1, C_14_23)] - let minus_gauge4 = Vector4 [(-2, C_13_42); (1, C_12_34); (1, C_14_23)] - let standard_quartic_gauge = - List.map qgc - [ (Wm, Wp, Wm, Wp), gauge4, G_WWWW; - (Wm, Z, Wp, Z), minus_gauge4, G_ZZWW; - (Wm, Z, Wp, Ga), minus_gauge4, G_AZWW; - (Wm, Ga, Wp, Ga), minus_gauge4, G_AAWW ] - - let quartic_gauge = - standard_quartic_gauge - - let standard_gauge_higgs = - [ ((O H, G Wp, G Wm), Scalar_Vector_Vector 1, G_HWW); - ((O H, G Z, G Z), Scalar_Vector_Vector 1, G_HZZ) ] - - let standard_gauge_higgs4 = - [ (O H, O H, G Wp, G Wm), Scalar2_Vector2 1, G_HHWW; - (O H, O H, G Z, G Z), Scalar2_Vector2 1, G_HHZZ ] - - let standard_higgs = - [ (O H, O H, O H), Scalar_Scalar_Scalar 1, G_H3 ] - - let standard_higgs4 = - [ (O H, O H, O H, O H), Scalar4 1, G_H4 ] - - let anomalous_gauge_higgs = - [] - - let anomalous_gauge_higgs4 = - [] - - let anomalous_higgs = - [] - - let anomaly_higgs = - [ (O H, G Ga, G Ga), Dim5_Scalar_Gauge2 1, G_HGaGa; - (O H, G Ga, G Z), Dim5_Scalar_Gauge2 1, G_HGaZ; - (O H, G Gl, G Gl), Dim5_Scalar_Gauge2 1, G_Hgg ] - - let gravitino_coup n = - [ (O Grino, M (SL (-n)), M (L n)), GBG (1, Gravbar, POT, Psi), G_Grav; - (M (L (-n)), M (SL n), O Grino), GBG (1, Psibar, POT, Grav), G_Grav] - - let gravitino_gauge = - [ (O Grino, G Ga, G Phino), GBG (1, Gravbar, V, Chi), G_Grav ] - - - let anomalous_higgs4 = - [] - - let gauge_higgs = - standard_gauge_higgs - - let gauge_higgs4 = - standard_gauge_higgs4 - - let higgs = - standard_higgs - - let higgs4 = - standard_higgs4 - - let goldstone_vertices = - [ ((O Phi0, G Wm, G Wp), Scalar_Vector_Vector 1, I_G_ZWW); - ((O Phip, G Ga, G Wm), Scalar_Vector_Vector 1, I_Q_W); - ((O Phip, G Z, G Wm), Scalar_Vector_Vector 1, I_G_ZWW); - ((O Phim, G Wp, G Ga), Scalar_Vector_Vector 1, I_Q_W); - ((O Phim, G Wp, G Z), Scalar_Vector_Vector 1, I_G_ZWW) ] - - let vertices3 = - (ThoList.flatmap electromagnetic_currents [1;2;3] @ - ThoList.flatmap neutral_currents [1;2;3] @ - ThoList.flatmap charged_currents [1;2;3] @ - ThoList.flatmap gravitino_coup [1;2;3] @ - gravitino_gauge @ - yukawa @ triple_gauge @ - gauge_higgs @ higgs @ anomaly_higgs - @ goldstone_vertices) - - let vertices4 = - quartic_gauge @ gauge_higgs4 @ higgs4 - - let vertices () = (vertices3, vertices4, []) - -(* For efficiency, make sure that [F.of_vertices vertices] is - evaluated only once. *) - - let table = F.of_vertices (vertices ()) - let fuse2 = F.fuse2 table - let fuse3 = F.fuse3 table - let fuse = F.fuse table - let max_degree () = 4 - - let flavor_of_string = function - | "e-" -> M (L 1) | "e+" -> M (L (-1)) - | "mu-" -> M (L 2) | "mu+" -> M (L (-2)) - | "tau-" -> M (L 3) | "tau+" -> M (L (-3)) - | "se-" -> M (SL 1) | "se+" -> M (SL (-1)) - | "smu-" -> M (SL 2) | "smu+" -> M (SL (-2)) - | "stau-" -> M (SL 3) | "stau+" -> M (SL (-3)) - | "nue" -> M (N 1) | "nuebar" -> M (N (-1)) - | "numu" -> M (N 2) | "numubar" -> M (N (-2)) - | "nutau" -> M (N 3) | "nutaubar" -> M (N (-3)) - | "u" -> M (U 1) | "ubar" -> M (U (-1)) - | "c" -> M (U 2) | "cbar" -> M (U (-2)) - | "t" -> M (U 3) | "tbar" -> M (U (-3)) - | "d" -> M (D 1) | "dbar" -> M (D (-1)) - | "s" -> M (D 2) | "sbar" -> M (D (-2)) - | "b" -> M (D 3) | "bbar" -> M (D (-3)) - | "g" | "gl" -> G Gl - | "A" -> G Ga | "Z" | "Z0" -> G Z - | "W+" -> G Wp | "W-" -> G Wm - | "H" -> O H - | "GG" -> O Grino - | "phino" | "Phino" -> G Phino - | _ -> invalid_arg "Models4.GravTest.flavor_of_string" - - let flavor_to_string = function - | M f -> - begin match f with - | L 1 -> "e-" | L (-1) -> "e+" - | L 2 -> "mu-" | L (-2) -> "mu+" - | L 3 -> "tau-" | L (-3) -> "tau+" - | L _ -> invalid_arg - "Models4.GravTest.flavor_to_string: invalid lepton" - | SL 1 -> "se-" | SL (-1) -> "se+" - | SL 2 -> "smu-" | SL (-2) -> "smu+" - | SL 3 -> "stau-" | SL (-3) -> "stau+" - | SL _ -> invalid_arg - "Models4.GravTest.flavor_to_string: invalid slepton" - | N 1 -> "nue" | N (-1) -> "nuebar" - | N 2 -> "numu" | N (-2) -> "numubar" - | N 3 -> "nutau" | N (-3) -> "nutaubar" - | N _ -> invalid_arg - "Models4.GravTest.flavor_to_string: invalid neutrino" - | U 1 -> "u" | U (-1) -> "ubar" - | U 2 -> "c" | U (-2) -> "cbar" - | U 3 -> "t" | U (-3) -> "tbar" - | U _ -> invalid_arg - "Models4.SM.flavor_to_string: invalid up type quark" - | D 1 -> "d" | D (-1) -> "dbar" - | D 2 -> "s" | D (-2) -> "sbar" - | D 3 -> "b" | D (-3) -> "bbar" - | D _ -> invalid_arg - "Models4.GravTest.flavor_to_string: invalid down type quark" - end - | G f -> - begin match f with - | Gl -> "g" - | Ga -> "A" | Z -> "Z" - | Wp -> "W+" | Wm -> "W-" - | Phino -> "phino" - end - | O f -> - begin match f with - | Phip -> "phi+" | Phim -> "phi-" | Phi0 -> "phi0" - | H -> "H" | Grino -> "GG" - end - - let flavor_symbol = function - | M f -> - begin match f with - | L n when n > 0 -> "l" ^ string_of_int n - | L n -> "l" ^ string_of_int (abs n) ^ "b" - | SL n when n > 0 -> "sl" ^ string_of_int n - | SL n -> "sl" ^ string_of_int (abs n) ^ "b" - | N n when n > 0 -> "n" ^ string_of_int n - | N n -> "n" ^ string_of_int (abs n) ^ "b" - | U n when n > 0 -> "u" ^ string_of_int n - | U n -> "u" ^ string_of_int (abs n) ^ "b" - | D n when n > 0 -> "d" ^ string_of_int n - | D n -> "d" ^ string_of_int (abs n) ^ "b" - end - | G f -> - begin match f with - | Gl -> "gl" - | Ga -> "a" | Z -> "z" - | Wp -> "wp" | Wm -> "wm" - | Phino -> "phino" - end - | O f -> - begin match f with - | Phip -> "pp" | Phim -> "pm" | Phi0 -> "p0" - | H -> "h" | Grino -> "gv" - end - - let flavor_sans_color_of_string = flavor_of_string - let flavor_sans_color_to_string = flavor_to_string - let flavor_sans_color_symbol = flavor_symbol - - let pdg = function - | M f -> - begin match f with - | L n when n > 0 -> 9 + 2*n - | L n -> - 9 + 2*n - | SL n when n > 0 -> 39 + 2*n - | SL n -> - 39 + 2*n - | N n when n > 0 -> 10 + 2*n - | N n -> - 10 + 2*n - | U n when n > 0 -> 2*n - | U n -> 2*n - | D n when n > 0 -> - 1 + 2*n - | D n -> 1 + 2*n - end - | G f -> - begin match f with - | Gl -> 21 - | Ga -> 22 | Z -> 23 - | Wp -> 24 | Wm -> (-24) - | Phino -> 46 - end - | O f -> - begin match f with - | Phip | Phim -> 27 | Phi0 -> 26 - | H -> 25 | Grino -> 39 - end - - let mass_symbol f = - "mass(" ^ string_of_int (abs (pdg f)) ^ ")" - - let width_symbol f = - "width(" ^ string_of_int (abs (pdg f)) ^ ")" - - let constant_symbol = function - | Unit -> "unit" | Pi -> "PI" - | Alpha_QED -> "alpha" | E -> "e" | G_weak -> "g" | Vev -> "vev" - | Sin2thw -> "sin2thw" | Sinthw -> "sinthw" | Costhw -> "costhw" - | Q_lepton -> "qlep" | Q_up -> "qup" | Q_down -> "qdwn" - | G_NC_lepton -> "gnclep" | G_NC_neutrino -> "gncneu" - | G_NC_up -> "gncup" | G_NC_down -> "gncdwn" - | G_CC -> "gcc" - | G_CCQ (n1,n2) -> "gccq" ^ string_of_int n1 ^ string_of_int n2 - | I_Q_W -> "iqw" | I_G_ZWW -> "igzww" - | G_WWWW -> "gw4" | G_ZZWW -> "gzzww" - | G_AZWW -> "gazww" | G_AAWW -> "gaaww" - | G_HWW -> "ghww" | G_HZZ -> "ghzz" - | G_HHWW -> "ghhww" | G_HHZZ -> "ghhzz" - | G_Htt -> "ghtt" | G_Hbb -> "ghbb" - | G_Htautau -> "ghtautau" | G_Hcc -> "ghcc" - | G_HGaZ -> "ghgaz" | G_HGaGa -> "ghgaga" | G_Hgg -> "ghgg" - | G_H3 -> "gh3" | G_H4 -> "gh4" - | G_strong -> "gs" | G_Grav -> "ggrav" - | Mass f -> "mass" ^ flavor_symbol f - | Width f -> "width" ^ flavor_symbol f - - end - -module Template (Flags : BSM_flags) = - struct - let rcs = RCS.rename rcs_file "Models4.Template" - [ "Template for user-defined BSM model"] - - open Coupling - - let default_width = ref Timelike - let use_fudged_width = ref false - - let options = Options.create - [ "constant_width", Arg.Unit (fun () -> default_width := Constant), - "use constant width (also in t-channel)"; - "fudged_width", Arg.Set use_fudged_width, - "use fudge factor for charge particle width"; - "custom_width", Arg.String (fun f -> default_width := Custom f), - "use custom width"; - "cancel_widths", Arg.Unit (fun () -> default_width := Vanishing), - "use vanishing width"] - - type matter_field = L of int | N of int | U of int | D of int - type gauge_boson = Ga | Wp | Wm | Z | Gl - type other = Phip | Phim | Phi0 | H - type flavor = M of matter_field | G of gauge_boson | O of other - type flavor_sans_color = flavor - let flavor_sans_color f = f - - let matter_field f = M f - let gauge_boson f = G f - let other f = O f - - type field = - | Matter of matter_field - | Gauge of gauge_boson - | Other of other - - let field = function - | M f -> Matter f - | G f -> Gauge f - | O f -> Other f - - type gauge = unit - - let gauge_symbol () = - failwith "Models4.Template.gauge_symbol: internal error" - - let family n = List.map matter_field [ L n; N n; U n; D n ] - - let external_flavors () = - [ "1st Generation", ThoList.flatmap family [1; -1]; - "2nd Generation", ThoList.flatmap family [2; -2]; - "3rd Generation", ThoList.flatmap family [3; -3]; - "Gauge Bosons", List.map gauge_boson [Ga; Z; Wp; Wm; Gl]; - "Higgs", List.map other [H]; - "Goldstone Bosons", List.map other [Phip; Phim; Phi0] ] - - let flavors () = ThoList.flatmap snd (external_flavors ()) - - let spinor n = - if n >= 0 then - Spinor - else - ConjSpinor - - let lorentz = function - | M f -> - begin match f with - | L n -> spinor n | N n -> spinor n - | U n -> spinor n | D n -> spinor n - end - | G f -> - begin match f with - | Ga | Gl -> Vector - | Wp | Wm | Z -> Massive_Vector - end - | O f -> Scalar - - let color = function - | M (U n) -> Color.SUN (if n > 0 then 3 else -3) - | M (D n) -> Color.SUN (if n > 0 then 3 else -3) - | G Gl -> Color.AdjSUN 3 - | _ -> Color.Singlet - - let prop_spinor n = - if n >= 0 then - Prop_Spinor - else - Prop_ConjSpinor - - let propagator = function - | M f -> - begin match f with - | L n -> prop_spinor n | N n -> prop_spinor n - | U n -> prop_spinor n | D n -> prop_spinor n - end - | G f -> - begin match f with - | Ga | Gl -> Prop_Feynman - | Wp | Wm | Z -> Prop_Unitarity - end - | O f -> - begin match f with - | Phip | Phim | Phi0 -> Only_Insertion - | H -> Prop_Scalar - end - -(* Optionally, ask for the fudge factor treatment for the widths of - charged particles. Currently, this only applies to $W^\pm$ and top. *) - - let width f = - if !use_fudged_width then - match f with - | G Wp | G Wm | M (U 3) | M (U (-3)) -> Fudged - | _ -> !default_width - else - !default_width - - let goldstone = function - | G f -> - begin match f with - | Wp -> Some (O Phip, Coupling.Const 1) - | Wm -> Some (O Phim, Coupling.Const 1) - | Z -> Some (O Phi0, Coupling.Const 1) - | _ -> None - end - | _ -> None - - let conjugate = function - | M f -> - M (begin match f with - | L n -> L (-n) | N n -> N (-n) - | U n -> U (-n) | D n -> D (-n) - end) - | G f -> - G (begin match f with - | Gl -> Gl | Ga -> Ga | Z -> Z - | Wp -> Wm | Wm -> Wp - end) - | O f -> - O (begin match f with - | Phip -> Phim | Phim -> Phip | Phi0 -> Phi0 - | H -> H - end) - - let conjugate_sans_color = conjugate - - let fermion = function - | M f -> - begin match f with - | L n -> if n > 0 then 1 else -1 - | N n -> if n > 0 then 1 else -1 - | U n -> if n > 0 then 1 else -1 - | D n -> if n > 0 then 1 else -1 - end - | G f -> - begin match f with - | Gl | Ga | Z | Wp | Wm -> 0 - end - | O _ -> 0 - - type constant = - | Unit | Pi | Alpha_QED | Sin2thw - | Sinthw | Costhw | E | G_weak | Vev - | Q_lepton | Q_up | Q_down | G_CC - | G_NC_neutrino | G_NC_lepton | G_NC_up | G_NC_down - | I_Q_W | I_G_ZWW - | G_WWWW | G_ZZWW | G_AZWW | G_AAWW - | G_HWW | G_HHWW | G_HZZ | G_HHZZ - | G_Htt | G_Hbb | G_Hcc | G_Hmm | G_Htautau | G_H3 | G_H4 - | G_HGaZ | G_HGaGa | G_Hgg - | Gs | I_Gs | G2 - | Mass of flavor | Width of flavor - - let input_parameters = [] - - let derived_parameters = [] - - let derived_parameter_arrays = [] - - let parameters () = - { input = input_parameters; - derived = derived_parameters; - derived_arrays = derived_parameter_arrays } - - module F = Models.Fusions (struct - type f = flavor - type c = constant - let compare = compare - let conjugate = conjugate - end) - - let mgm ((m1, g, m2), fbf, c) = ((M m1, G g, M m2), fbf, c) - - let electromagnetic_currents n = - List.map mgm - [ ((L (-n), Ga, L n), FBF (1, Psibar, V, Psi), Q_lepton); - ((U (-n), Ga, U n), FBF (1, Psibar, V, Psi), Q_up); - ((D (-n), Ga, D n), FBF (1, Psibar, V, Psi), Q_down) ] - - let color_currents n = - List.map mgm - [ ((U (-n), Gl, U n), FBF ((-1), Psibar, V, Psi), Gs); - ((D (-n), Gl, D n), FBF ((-1), Psibar, V, Psi), Gs) ] - - let neutral_currents n = - List.map mgm - [ ((L (-n), Z, L n), FBF (1, Psibar, VA, Psi), G_NC_lepton); - ((N (-n), Z, N n), FBF (1, Psibar, VA, Psi), G_NC_neutrino); - ((U (-n), Z, U n), FBF (1, Psibar, VA, Psi), G_NC_up); - ((D (-n), Z, D n), FBF (1, Psibar, VA, Psi), G_NC_down) ] - - let charged_currents n = - List.map mgm - [ ((L (-n), Wm, N n), FBF (1, Psibar, VL, Psi), G_CC); - ((N (-n), Wp, L n), FBF (1, Psibar, VL, Psi), G_CC); - ((D (-n), Wm, U n), FBF (1, Psibar, VL, Psi), G_CC); - ((U (-n), Wp, D n), FBF (1, Psibar, VL, Psi), G_CC) ] - - let yukawa = - [ ((M (U (-3)), O H, M (U 3)), FBF (1, Psibar, S, Psi), G_Htt); - ((M (D (-3)), O H, M (D 3)), FBF (1, Psibar, S, Psi), G_Hbb); - ((M (U (-2)), O H, M (U 2)), FBF (1, Psibar, S, Psi), G_Hcc); - ((M (L (-2)), O H, M (L 2)), FBF (1, Psibar, S, Psi), G_Hmm); - ((M (L (-3)), O H, M (L 3)), FBF (1, Psibar, S, Psi), G_Htautau) ] - - let tgc ((g1, g2, g3), t, c) = ((G g1, G g2, G g3), t, c) - - let triple_gauge = - List.map tgc - [ ((Ga, Wm, Wp), Gauge_Gauge_Gauge 1, I_Q_W); - ((Z, Wm, Wp), Gauge_Gauge_Gauge 1, I_G_ZWW); - ((Gl, Gl, Gl), Gauge_Gauge_Gauge 1, I_Gs) ] - - let qgc ((g1, g2, g3, g4), t, c) = ((G g1, G g2, G g3, G g4), t, c) - - let gauge4 = Vector4 [(2, C_13_42); (-1, C_12_34); (-1, C_14_23)] - let minus_gauge4 = Vector4 [(-2, C_13_42); (1, C_12_34); (1, C_14_23)] - let quartic_gauge = - List.map qgc - [ (Wm, Wp, Wm, Wp), gauge4, G_WWWW; - (Wm, Z, Wp, Z), minus_gauge4, G_ZZWW; - (Wm, Z, Wp, Ga), minus_gauge4, G_AZWW; - (Wm, Ga, Wp, Ga), minus_gauge4, G_AAWW; - (Gl, Gl, Gl, Gl), gauge4, G2] - - let gauge_higgs = - [ ((O H, G Wp, G Wm), Scalar_Vector_Vector 1, G_HWW); - ((O H, G Z, G Z), Scalar_Vector_Vector 1, G_HZZ) ] - - let gauge_higgs4 = - [ (O H, O H, G Wp, G Wm), Scalar2_Vector2 1, G_HHWW; - (O H, O H, G Z, G Z), Scalar2_Vector2 1, G_HHZZ ] - - let higgs = - [ (O H, O H, O H), Scalar_Scalar_Scalar 1, G_H3 ] - - let higgs4 = - [ (O H, O H, O H, O H), Scalar4 1, G_H4 ] - - let anomaly_higgs = - [] -(* [ (O H, G Ga, G Ga), Dim5_Scalar_Gauge2 1, G_HGaGa; - (O H, G Ga, G Z), Dim5_Scalar_Gauge2 1, G_HGaZ; - (O H, G Gl, G Gl), Dim5_Scalar_Gauge2 1, G_Hgg] *) - - let goldstone_vertices = - [ ((O Phi0, G Wm, G Wp), Scalar_Vector_Vector 1, I_G_ZWW); - ((O Phip, G Ga, G Wm), Scalar_Vector_Vector 1, I_Q_W); - ((O Phip, G Z, G Wm), Scalar_Vector_Vector 1, I_G_ZWW); - ((O Phim, G Wp, G Ga), Scalar_Vector_Vector 1, I_Q_W); - ((O Phim, G Wp, G Z), Scalar_Vector_Vector 1, I_G_ZWW) ] - - let vertices3 = - (ThoList.flatmap electromagnetic_currents [1;2;3] @ - ThoList.flatmap color_currents [1;2;3] @ - ThoList.flatmap neutral_currents [1;2;3] @ - ThoList.flatmap charged_currents [1;2;3] @ - yukawa @ triple_gauge @ gauge_higgs @ higgs @ - anomaly_higgs @ goldstone_vertices) - - let vertices4 = - quartic_gauge @ gauge_higgs4 @ higgs4 - - let vertices () = (vertices3, vertices4, []) - - let table = F.of_vertices (vertices ()) - let fuse2 = F.fuse2 table - let fuse3 = F.fuse3 table - let fuse = F.fuse table - let max_degree () = 4 - - let flavor_of_string = function - | "e-" -> M (L 1) | "e+" -> M (L (-1)) - | "mu-" -> M (L 2) | "mu+" -> M (L (-2)) - | "tau-" -> M (L 3) | "tau+" -> M (L (-3)) - | "nue" -> M (N 1) | "nuebar" -> M (N (-1)) - | "numu" -> M (N 2) | "numubar" -> M (N (-2)) - | "nutau" -> M (N 3) | "nutaubar" -> M (N (-3)) - | "u" -> M (U 1) | "ubar" -> M (U (-1)) - | "c" -> M (U 2) | "cbar" -> M (U (-2)) - | "t" -> M (U 3) | "tbar" -> M (U (-3)) - | "d" -> M (D 1) | "dbar" -> M (D (-1)) - | "s" -> M (D 2) | "sbar" -> M (D (-2)) - | "b" -> M (D 3) | "bbar" -> M (D (-3)) - | "g" | "gl" -> G Gl - | "A" -> G Ga | "Z" | "Z0" -> G Z - | "W+" -> G Wp | "W-" -> G Wm - | "H" -> O H - | _ -> invalid_arg "Models4.Template.flavor_of_string" - - let flavor_to_string = function - | M f -> - begin match f with - | L 1 -> "e-" | L (-1) -> "e+" - | L 2 -> "mu-" | L (-2) -> "mu+" - | L 3 -> "tau-" | L (-3) -> "tau+" - | L _ -> invalid_arg - "Models4.Template.flavor_to_string: invalid lepton" - | N 1 -> "nue" | N (-1) -> "nuebar" - | N 2 -> "numu" | N (-2) -> "numubar" - | N 3 -> "nutau" | N (-3) -> "nutaubar" - | N _ -> invalid_arg - "Models4.Template.flavor_to_string: invalid neutrino" - | U 1 -> "u" | U (-1) -> "ubar" - | U 2 -> "c" | U (-2) -> "cbar" - | U 3 -> "t" | U (-3) -> "tbar" - | U _ -> invalid_arg - "Models4.Template.flavor_to_string: invalid up type quark" - | D 1 -> "d" | D (-1) -> "dbar" - | D 2 -> "s" | D (-2) -> "sbar" - | D 3 -> "b" | D (-3) -> "bbar" - | D _ -> invalid_arg - "Models4.Template.flavor_to_string: invalid down type quark" - end - | G f -> - begin match f with - | Gl -> "g" - | Ga -> "A" | Z -> "Z" - | Wp -> "W+" | Wm -> "W-" - end - | O f -> - begin match f with - | Phip -> "phi+" | Phim -> "phi-" | Phi0 -> "phi0" - | H -> "H" - end - - let flavor_symbol = function - | M f -> - begin match f with - | L n when n > 0 -> "l" ^ string_of_int n - | L n -> "l" ^ string_of_int (abs n) ^ "b" - | N n when n > 0 -> "n" ^ string_of_int n - | N n -> "n" ^ string_of_int (abs n) ^ "b" - | U n when n > 0 -> "u" ^ string_of_int n - | U n -> "u" ^ string_of_int (abs n) ^ "b" - | D n when n > 0 -> "d" ^ string_of_int n - | D n -> "d" ^ string_of_int (abs n) ^ "b" - end - | G f -> - begin match f with - | Gl -> "gl" - | Ga -> "a" | Z -> "z" - | Wp -> "wp" | Wm -> "wm" - end - | O f -> - begin match f with - | Phip -> "pp" | Phim -> "pm" | Phi0 -> "p0" - | H -> "h" - end - - let flavor_sans_color_of_string = flavor_of_string - let flavor_sans_color_to_string = flavor_to_string - let flavor_sans_color_symbol = flavor_symbol - - let pdg = function - | M f -> - begin match f with - | L n when n > 0 -> 9 + 2*n - | L n -> - 9 + 2*n - | N n when n > 0 -> 10 + 2*n - | N n -> - 10 + 2*n - | U n when n > 0 -> 2*n - | U n -> 2*n - | D n when n > 0 -> - 1 + 2*n - | D n -> 1 + 2*n - end - | G f -> - begin match f with - | Gl -> 21 - | Ga -> 22 | Z -> 23 - | Wp -> 24 | Wm -> (-24) - end - | O f -> - begin match f with - | Phip | Phim -> 27 | Phi0 -> 26 - | H -> 25 - end - - let mass_symbol f = - "mass(" ^ string_of_int (abs (pdg f)) ^ ")" - - let width_symbol f = - "width(" ^ string_of_int (abs (pdg f)) ^ ")" - - let constant_symbol = function - | Unit -> "unit" | Pi -> "PI" - | Alpha_QED -> "alpha" | E -> "e" | G_weak -> "g" | Vev -> "vev" - | Sin2thw -> "sin2thw" | Sinthw -> "sinthw" | Costhw -> "costhw" - | Q_lepton -> "qlep" | Q_up -> "qup" | Q_down -> "qdwn" - | G_NC_lepton -> "gnclep" | G_NC_neutrino -> "gncneu" - | G_NC_up -> "gncup" | G_NC_down -> "gncdwn" - | G_CC -> "gcc" - | I_Q_W -> "iqw" | I_G_ZWW -> "igzww" - | G_WWWW -> "gw4" | G_ZZWW -> "gzzww" - | G_AZWW -> "gazww" | G_AAWW -> "gaaww" - | G_HWW -> "ghww" | G_HZZ -> "ghzz" - | G_HHWW -> "ghhww" | G_HHZZ -> "ghhzz" - | G_Htt -> "ghtt" | G_Hbb -> "ghbb" - | G_Htautau -> "ghtautau" | G_Hcc -> "ghcc" | G_Hmm -> "ghmm" - | G_HGaZ -> "ghgaz" | G_HGaGa -> "ghgaga" | G_Hgg -> "ghgg" - | G_H3 -> "gh3" | G_H4 -> "gh4" - | Gs -> "gs" | I_Gs -> "igs" | G2 -> "gs**2" - | Mass f -> "mass" ^ flavor_symbol f - | Width f -> "width" ^ flavor_symbol f - - end - - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/trie.mli =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/trie.mli (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/trie.mli (revision 8703) @@ -1,119 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -(* \thocwmodulesection{Monomorphically} *) - -module type T = - sig - - type key - type (+'a) t - val empty : 'a t - val is_empty : 'a t -> bool - -(* Standard trie interface: *) - - val add : key -> 'a -> 'a t -> 'a t - val find : key -> 'a t -> 'a - -(* Functionals: *) - - val remove : key -> 'a t -> 'a t - val mem : key -> 'a t -> bool - val map : ('a -> 'b) -> 'a t -> 'b t - val mapi : (key -> 'a -> 'b) -> 'a t -> 'b t - val iter : (key -> 'a -> unit) -> 'a t -> unit - val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b - -(* Try to match a longest prefix and return the unmatched rest. *) - - val longest : key -> 'a t -> 'a option * key - -(* Try to match a shortest prefix and return the unmatched rest. *) - - val shortest : key -> 'a t -> 'a option * key - -(* \thocwmodulesection{New in O'Caml 3.08} *) - - val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int - val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool - -(* \thocwmodulesection{O'Mega customization} - [export f_open f_close f_descend f_match trie] allows us to export the - trie [trie] as source code to another programming language. *) - - val export : (int -> unit) -> (int -> unit) -> - (int -> key -> unit) -> (int -> key -> 'a -> unit) -> 'a t -> unit - - end - -module Make (M : Map.S) : T with type key = M.key list -module MakeMap (M : Map.S) : Map.S with type key = M.key list - -(* \thocwmodulesection{Polymorphically} *) - -module type Poly = - sig - - type ('a, 'b) t - val empty : ('a, 'b) t - -(* Standard trie interface: *) - - val add : ('a -> 'a -> int) -> 'a list -> 'b -> ('a, 'b) t -> ('a, 'b) t - val find : ('a -> 'a -> int) -> 'a list -> ('a, 'b) t -> 'b - -(* Functionals: *) - - val remove : ('a -> 'a -> int) -> 'a list -> ('a, 'b) t -> ('a, 'b) t - val mem : ('a -> 'a -> int) -> 'a list -> ('a, 'b) t -> bool - val map : ('b -> 'c) -> ('a, 'b) t -> ('a, 'c) t - val mapi : ('a list -> 'b -> 'c) -> ('a, 'b) t -> ('a, 'c) t - val iter : ('a list -> 'b -> unit) -> ('a, 'b) t -> unit - val fold : ('a list -> 'b -> 'c -> 'c) -> ('a, 'b) t -> 'c -> 'c - -(* Try to match a longest prefix and return the unmatched rest. *) - - val longest : ('a -> 'a -> int) -> 'a list -> ('a, 'b) t -> 'b option * 'a list - -(* Try to match a shortest prefix and return the unmatched rest. *) - - val shortest : ('a -> 'a -> int) -> 'a list -> ('a, 'b) t -> 'b option * 'a list - -(* \thocwmodulesection{O'Mega customization} - [export f_open f_close f_descend f_match trie] allows us to export the - trie [trie] as source code to another programming language. *) - - val export : (int -> unit) -> (int -> unit) -> - (int -> 'a list -> unit) -> (int -> 'a list -> 'b -> unit) -> ('a, 'b) t -> unit - - end - -module MakePoly (M : Pmap.T) : Poly - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/f90_Simplest_univ.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/f90_Simplest_univ.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/f90_Simplest_univ.ml (revision 8703) @@ -1,33 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -module O = Omega.Make(Fusion.Mixed23)(Targets.Fortran_Majorana) - (Models4.Simplest(Models4.BSM_anom)) -let _ = O.main () - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/targets_Kmatrix.mli =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/targets_Kmatrix.mli (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/targets_Kmatrix.mli (revision 8703) @@ -1,31 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -module Fortran : sig val print : bool -> unit end - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/partition.mli =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/partition.mli (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/partition.mli (revision 8703) @@ -1,45 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -(* [pairs n n1 n2] returns all (unordered) pairs of integers with the - sum~$n$ in the range from~[n1] to~[n2]. *) -val pairs : int -> int -> int -> (int * int) list -val triples : int -> int -> int -> (int * int * int) list - -(* [tuples d n n_min n_max] returns - all~$\lbrack n_1; n_2; \ldots; n_d\rbrack$ - with~$n_{\min}\le n_1\le n_2\le\ldots\le n_d\le n_{\max}$ and - \begin{equation} - \sum_{i=1}^d n_i = n - \end{equation} *) -val tuples : int -> int -> int -> int -> int list list - -val rcs : RCS.t - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) - Index: branches/ohl/omega-development/completed/whizard2/src/thoList.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/thoList.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/thoList.ml (revision 8703) @@ -1,197 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -let rec hdn n l = - if n <= 0 then - [] - else - match l with - | x :: rest -> x :: hdn (pred n) rest - | [] -> invalid_arg "ThoList.hdn" - -let rec tln n l = - if n <= 0 then - l - else - match l with - | _ :: rest -> tln (pred n) rest - | [] -> invalid_arg "ThoList.tln" - -let rec splitn' n l1_rev l2 = - if n <= 0 then - (List.rev l1_rev, l2) - else - match l2 with - | x :: l2' -> splitn' (pred n) (x :: l1_rev) l2' - | [] -> invalid_arg "ThoList.splitn n > len" - -let splitn n l = - if n < 0 then - invalid_arg "ThoList.splitn n < 0" - else - splitn' n [] l - -let of_subarray n1 n2 a = - let rec of_subarray' n1 n2 = - if n1 > n2 then - [] - else - a.(n1) :: of_subarray' (succ n1) n2 in - of_subarray' (max 0 n1) (min n2 (pred (Array.length a))) - -let range ?(stride=1) n1 n2 = - if stride <= 0 then - invalid_arg "ThoList.range: stride <= 0" - else - let rec range' n = - if n > n2 then - [] - else - n :: range' (n + stride) in - range' n1 - -let rec flatmap f = function - | [] -> [] - | x :: rest -> f x @ flatmap f rest - -let fold_left2 f acc lists = - List.fold_left (List.fold_left f) acc lists - -let fold_right2 f lists acc = - List.fold_right (List.fold_right f) lists acc - -let iteri f start list = - ignore (List.fold_left (fun i a -> f i a; succ i) start list) - -let iteri2 f start_outer star_inner lists = - iteri (fun j -> iteri (f j) star_inner) start_outer lists - -(* Is there a more efficient implementation? *) -let transpose lists = - let rec transpose' rest = - if List.for_all ((=) []) rest then - [] - else - List.map List.hd rest :: transpose' (List.map List.tl rest) in - try - transpose' lists - with - | Failure "tl" -> invalid_arg "ThoList.transpose: not rectangular" - -let compare ?(cmp=Pervasives.compare) l1 l2 = - let rec compare' l1' l2' = - match l1', l2' with - | [], [] -> 0 - | [], _ -> -1 - | _, [] -> 1 - | n1 :: r1, n2 :: r2 -> - let c = cmp n1 n2 in - if c <> 0 then - c - else - compare' r1 r2 - in - compare' l1 l2 - -let rec uniq' x = function - | [] -> [] - | x' :: rest -> - if x' = x then - uniq' x rest - else - x' :: uniq' x' rest - -let uniq = function - | [] -> [] - | x :: rest -> x :: uniq' x rest - -let rec homogeneous = function - | [] | [_] -> true - | a1 :: (a2 :: _ as rest) -> - if a1 <> a2 then - false - else - homogeneous rest - -(* If we needed it, we could use a polymorphic version of [Set] to - speed things up from~$O(n^2)$ to~$O(n\ln n)$. But not before it - matters somewhere \ldots *) -let classify l = - let rec add_to_class a = function - | [] -> [1, a] - | (n, a') :: rest -> - if a = a' then - (succ n, a) :: rest - else - (n, a') :: add_to_class a rest - in - let rec classify' cl = function - | [] -> cl - | a :: rest -> classify' (add_to_class a cl) rest - in - classify' [] l - -let rec factorize l = - let rec add_to_class x y = function - | [] -> [(x, [y])] - | (x', ys) :: rest -> - if x = x' then - (x, y :: ys) :: rest - else - (x', ys) :: add_to_class x y rest - in - let rec factorize' fl = function - | [] -> fl - | (x, y) :: rest -> factorize' (add_to_class x y fl) rest - in - List.map (fun (x, ys) -> (x, List.rev ys)) (factorize' [] l) - -let rec clone n x = - if n < 0 then - invalid_arg "ThoList.clone" - else if n = 0 then - [] - else - x :: clone (pred n) x - -let rec rev_multiply n rl l = - if n < 0 then - invalid_arg "ThoList.multiply" - else if n = 0 then - [] - else - List.rev_append rl (rev_multiply (pred n) rl l) - -let multiply n l = rev_multiply n (List.rev l) l - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) - - - - - Index: branches/ohl/omega-development/completed/whizard2/src/colorize.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/colorize.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/colorize.ml (revision 8703) @@ -1,1763 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -(* \thocwmodulesection{(Statically) Colorizing a Monochrome Model} *) - -module type Flows = - sig - val max_lines :int - end - -module It (F : Flows) (M : Model.T) = - struct - - module M = M - - open Coupling - - module C = Color - - let incomplete s = - failwith ("Colorize.It()." ^ s ^ " not done yet!") - - let incomplete s = - Printf.eprintf "WARNING: Colorize.It().%s not done yet!\n" s; - [] - - let su0 s = - invalid_arg ("Colorize.It()." ^ s ^ ": found SU(0)!") - - let colored_vertex s = - invalid_arg ("Colorize.It()." ^ s ^ ": colored vertex!") - - let color_flow_ambiguous s = - invalid_arg ("Colorize.It()." ^ s ^ ": ambiguous color flow!") - - let color_flow_of_string s = - let c = int_of_string s in - if c < 1 then - invalid_arg ("Colorize.It()." ^ s ^ ": color flow # < 1!") - else if c > F.max_lines then - invalid_arg ("Colorize.It()." ^ s ^ ": color flow # too large") - else - c - - type flavor = - | White of M.flavor - | CF_in of M.flavor * int - | CF_out of M.flavor * int - | CF_io of M.flavor * int * int - | CF_aux of M.flavor - - type flavor_sans_color = M.flavor - - let flavor_sans_color = function - | White f -> f - | CF_in (f, _) -> f - | CF_out (f, _) -> f - | CF_io (f, _, _) -> f - | CF_aux f -> f - - let pullback f arg1 = - f (flavor_sans_color arg1) - - type gauge = M.gauge - type constant = M.constant - let options = M.options - - let color = pullback M.color - let pdg = pullback M.pdg - let lorentz = pullback M.lorentz - -(* For the propagator we cannot use pullback because we have to add the case - of the color singlet propagator by hand. *) - - let colorize_propagator = function - | Prop_Scalar -> Prop_Col_Scalar (* Spin 0 octets. *) - | Prop_Majorana -> Prop_Col_Majorana (* Spin 1/2 octets. *) - | Prop_Feynman -> Prop_Col_Feynman (* Spin 1 states, massless. *) - | Prop_Unitarity -> Prop_Col_Unitarity (* Spin 1 states, massive. *) - | Prop_Col_Scalar | Prop_Col_Feynman | Prop_Col_Majorana | Prop_Col_Unitarity - -> failwith ("Colorize.It().colorize_propagator: already colored particle!") - | _ -> failwith ("Colorize.It().colorize_propagator: impossible!") - - let propagator = function - | CF_aux f -> colorize_propagator (M.propagator f) - | White f -> M.propagator f - | CF_in (f, _) -> M.propagator f - | CF_out (f, _) -> M.propagator f - | CF_io (f, _, _) -> M.propagator f - - let width = pullback M.width - - let goldstone = function - | White f -> - begin match M.goldstone f with - | None -> None - | Some (f', g) -> Some (White f', g) - end - | CF_in (f, c) -> - begin match M.goldstone f with - | None -> None - | Some (f', g) -> Some (CF_in (f', c), g) - end - | CF_out (f, c) -> - begin match M.goldstone f with - | None -> None - | Some (f', g) -> Some (CF_out (f', c), g) - end - | CF_io (f, c1, c2) -> - begin match M.goldstone f with - | None -> None - | Some (f', g) -> Some (CF_io (f', c1, c2), g) - end - | CF_aux f -> - begin match M.goldstone f with - | None -> None - | Some (f', g) -> Some (CF_aux f', g) - end - - let conjugate = function - | White f -> White (M.conjugate f) - | CF_in (f, c) -> CF_out (M.conjugate f, c) - | CF_out (f, c) -> CF_in (M.conjugate f, c) - | CF_io (f, c1, c2) -> CF_io (M.conjugate f, c2, c1) - | CF_aux f -> CF_aux (M.conjugate f) - - let conjugate_sans_color = M.conjugate - - let fermion = pullback M.fermion - - let permute_triple (a, b, c) = - List.map - (function - | [a'; b'; c'] -> (a', b', c') - | _ -> failwith "Colorize.It().permute_triple: internal error") - (Combinatorics.permute [a; b; c]) - - let permute_quadruple (a, b, c, d) = - List.map - (function - | [a'; b'; c'; d'] -> (a', b', c', d') - | _ -> failwith "Colorize.It().permute_quadruple: internal error") - (Combinatorics.permute [a; b; c; d]) - - let max_degree = M.max_degree - - let color_flows = - ThoList.range 1 F.max_lines - - let color_flow_pairs = - ThoList.flatmap - (function - | [c1; c2] -> [(c1, c2); (c2, c1)] - | _ -> failwith "Colorize.It().color_flow_pairs: internal error") - (Combinatorics.choose 2 color_flows) - - let color_flow_triples = - List.map - (function - | [c1; c2; c3] -> (c1, c2, c3) - | _ -> failwith "Colorize.It().color_flow_triples: internal error") - (Combinatorics.choose 3 color_flows) - - let color_flow_quadruples = - List.map - (function - | [c1; c2; c3; c4] -> (c1, c2, c3, c4) - | _ -> failwith "Colorize.It().color_flow_quadruples: internal error") - (Combinatorics.choose 4 color_flows) - - let colorize_flavor f = - match M.color f with - | C.Singlet -> [White f] - | C.SUN nc -> - if nc > 0 then - List.map (fun c -> CF_in (f, c)) color_flows - else if nc < 0 then - List.map (fun c -> CF_out (f, c)) color_flows - else - su0 "colorize_flavor" - | C.AdjSUN _ -> - CF_aux f :: (List.map (fun (c1, c2) -> CF_io (f, c1, c2)) color_flow_pairs) - - let flavors () = - ThoList.flatmap colorize_flavor (M.flavors ()) - - let external_flavors () = - List.map - (fun (name, flist) -> (name, ThoList.flatmap colorize_flavor flist)) - (M.external_flavors ()) - - let parameters = M.parameters - - module Fusion = Models.Fusions (struct - type f = flavor - type c = constant - let compare = compare - let conjugate = conjugate - end) - -(* \thocwmodulesubsection{Auxiliary functions} *) - - let mult_vertex3 fac = function - | FBF (c,fb,coup,f) -> FBF ((fac*c),fb,coup,f) - | PBP (c,fb,coup,f) -> PBP ((fac*c),fb,coup,f) - | BBB (c,fb,coup,f) -> BBB ((fac*c),fb,coup,f) - | GBG (c,fb,coup,f) -> GBG ((fac*c),fb,coup,f) - | Gauge_Gauge_Gauge c -> Gauge_Gauge_Gauge (fac*c) - | Aux_Gauge_Gauge c -> Aux_Gauge_Gauge (fac*c) - | Scalar_Vector_Vector c -> Scalar_Vector_Vector (fac*c) - | Aux_Vector_Vector c -> Aux_Vector_Vector (fac*c) - | Aux_Scalar_Vector c -> Aux_Scalar_Vector (fac*c) - | Scalar_Scalar_Scalar c -> Scalar_Scalar_Scalar (fac*c) - | Aux_Scalar_Scalar c -> Aux_Scalar_Scalar (fac*c) - | Vector_Scalar_Scalar c -> Vector_Scalar_Scalar (fac*c) - | Graviton_Scalar_Scalar c -> Graviton_Scalar_Scalar (fac*c) - | Graviton_Vector_Vector c -> Graviton_Vector_Vector (fac*c) - | Graviton_Spinor_Spinor c -> Graviton_Spinor_Spinor (fac*c) - | Dim4_Vector_Vector_Vector_T c -> Dim4_Vector_Vector_Vector_T (fac*c) - | Dim4_Vector_Vector_Vector_L c -> Dim4_Vector_Vector_Vector_L (fac*c) - | Dim4_Vector_Vector_Vector_T5 c -> Dim4_Vector_Vector_Vector_T5 (fac*c) - | Dim4_Vector_Vector_Vector_L5 c -> Dim4_Vector_Vector_Vector_L5 (fac*c) - | Dim6_Gauge_Gauge_Gauge c -> Dim6_Gauge_Gauge_Gauge (fac*c) - | Dim6_Gauge_Gauge_Gauge_5 c -> Dim6_Gauge_Gauge_Gauge_5 (fac*c) - | Aux_DScalar_DScalar c -> Aux_DScalar_DScalar (fac*c) - | Aux_Vector_DScalar c -> Aux_Vector_DScalar (fac*c) - | Dim5_Scalar_Gauge2 c -> Dim5_Scalar_Gauge2 (fac*c) - | Dim5_Scalar_Gauge2_Skew c -> Dim5_Scalar_Gauge2_Skew (fac*c) - | Dim5_Scalar_Vector_Vector_T c -> Dim5_Scalar_Vector_Vector_T (fac*c) - | Dim6_Vector_Vector_Vector_T c -> Dim6_Vector_Vector_Vector_T (fac*c) - | Tensor_2_Vector_Vector c -> Tensor_2_Vector_Vector (fac*c) - | Dim5_Tensor_2_Vector_Vector_1 c -> Dim5_Tensor_2_Vector_Vector_1 (fac*c) - | Dim5_Tensor_2_Vector_Vector_2 c -> Dim5_Tensor_2_Vector_Vector_2 (fac*c) - | Dim7_Tensor_2_Vector_Vector_T c -> Dim7_Tensor_2_Vector_Vector_T (fac*c) - - let mult_vertex4 fac = function - | Scalar4 c -> Scalar4 (fac*c) - | Scalar2_Vector2 c -> Scalar2_Vector2 (fac*c) - | Vector4 ic4_list -> Vector4 (List.map (fun (c,icl) -> ((fac*c),icl)) ic4_list) - | DScalar4 ic4_list -> DScalar4 (List.map (fun (c,icl) -> ((fac*c),icl)) ic4_list) - | DScalar2_Vector2 ic4_list -> DScalar2_Vector2 (List.map (fun (c,icl) -> ((fac*c),icl)) ic4_list) - | GBBG (c,fb,b2,f) -> GBBG ((fac*c),fb,b2,f) - | Vector4_K_Matrix_tho (c,ch2_list) -> Vector4_K_Matrix_tho ((fac*c), ch2_list) - | Vector4_K_Matrix_jr (c,ch2_list) -> Vector4_K_Matrix_jr ((fac*c), ch2_list) - -(* \thocwmodulesubsection{Cubic Vertices} *) - - let vertices3, vertices4, verticesn = M.vertices () - -(* \textbf{Important}: In the following, we don't test that the - $\mathrm{SU}(N)$ groups match and that $N>0$, since we can assume - that [colorize_flavor] would have thrown an exception. *) - - let colorize_vertex3 ((f1, f2, f3), v, g) = - match M.color f1, M.color f2, M.color f3 with - -(* The trivial case. *) - - | C.Singlet, C.Singlet, C.Singlet -> - [(White f1, White f2, White f3), v, g] - -(* Coupling a quark, an anti-quark and a colorless particle: all - particles are \emph{guaranteed} to be different and no nontrivial - symmetry can arise. *) - - | C.SUN nc1, C.SUN nc2, C.Singlet -> - if nc1 <> - nc2 then - colored_vertex "colored_vertex3" - else if nc1 > 0 then - List.map - (fun c -> ((CF_in (f1, c), CF_out (f2, c), White f3), v, g)) - color_flows - else - List.map - (fun c -> ((CF_out (f1, c), CF_in (f2, c), White f3), v, g)) - color_flows - - | C.SUN nc1, C.Singlet, C.SUN nc3 -> - if nc1 <> - nc3 then - colored_vertex "colored_vertex3" - else if nc1 > 0 then - List.map - (fun c -> ((CF_in (f1, c), White f2, CF_out (f3, c)), v, g)) - color_flows - else - List.map - (fun c -> ((CF_out (f1, c), White f2, CF_in (f3, c)), v, g)) - color_flows - - | C.Singlet, C.SUN nc2, C.SUN nc3 -> - if nc2 <> - nc3 then - colored_vertex "colored_vertex3" - else if nc2 > 0 then - List.map - (fun c -> ((White f1, CF_in (f2, c), CF_out (f3, c)), v, g)) - color_flows - else - List.map - (fun c -> ((White f1, CF_out (f2, c), CF_in (f3, c)), v, g)) - color_flows - -(* Coupling a quark, an anti-quark and a gluon: all particles are - again \emph{guaranteed} to be different and no nontrivial symmetry - can arise. *) - - | C.SUN nc1, C.SUN nc2, C.AdjSUN _ -> - if nc1 <> - nc2 then - colored_vertex "colored_vertex3" - else if nc1 > 0 then - List.map - (fun (c1, c2) -> - ((CF_in (f1, c1), CF_out (f2, c2), CF_io (f3, c2, c1)), v, g)) - color_flow_pairs - @ (List.map - (fun c -> ((CF_in (f1, c), CF_out (f2, c), CF_aux f3), v, g)) - color_flows) - else - List.map - (fun (c1, c2) -> - ((CF_out (f1, c2), CF_in (f2, c1), CF_io (f3, c2, c1)), v, g)) - color_flow_pairs - @ (List.map - (fun c -> ((CF_out (f1, c), CF_in (f2, c), CF_aux f3), v, g)) - color_flows) - - | C.SUN nc1, C.AdjSUN _, C.SUN nc3 -> - if nc1 <> - nc3 then - colored_vertex "colored_vertex3" - else if nc1 > 0 then - List.map - (fun (c1, c3) -> - ((CF_in (f1, c1), CF_io (f2, c3, c1), CF_out (f3, c3)), v, g)) - color_flow_pairs - @ (List.map - (fun c -> ((CF_in (f1, c), CF_aux f2, CF_out (f3, c)), v, g)) - color_flows) - else - List.map - (fun (c1, c3) -> - ((CF_out (f1, c1), CF_io (f2, c1, c3), CF_in (f3, c3)), v, g)) - color_flow_pairs - @ (List.map - (fun c -> ((CF_out (f1, c), CF_aux f2, CF_in (f3, c)), v, g)) - color_flows) - - | C.AdjSUN _, C.SUN nc2, C.SUN nc3 -> - if nc2 <> - nc3 then - colored_vertex "colored_vertex3" - else if nc2 > 0 then - List.map - (fun (c2, c3) -> - ((CF_io (f1, c3, c2), CF_in (f2, c2), CF_out (f3, c3)), v, g)) - color_flow_pairs - @ (List.map - (fun c -> ((CF_aux f1, CF_in (f2, c), CF_out (f3, c)), v, g)) - color_flows) - else - List.map - (fun (c2, c3) -> - ((CF_io (f1, c2, c3), CF_out (f2, c2), CF_in (f3, c3)), v, g)) - color_flow_pairs - @ (List.map - (fun c -> ((CF_aux f1, CF_out (f2, c), CF_in (f3, c)), v, g)) - color_flows) - -(* Coupling two gluons with a colorless particle: - - To make the color algebra correct, we need to introduce the vertex with the two - ghost gluons with a relative factor of -3. *) - - - | C.AdjSUN _, C.AdjSUN _, C.Singlet -> - List.map (fun (c1, c2) -> ((CF_io (f1, c1, c2), CF_io (f2, c2, c1), White f3), v, g)) - color_flow_pairs - @ - [((CF_aux f1, CF_aux f2, White f3), (mult_vertex3 (-3) v), g)] - - | C.AdjSUN _, C.Singlet, C.AdjSUN _ -> - List.map (fun (c1, c3) -> ((CF_io (f1, c1, c3), White f2, CF_io (f3, c3, c1)), v, g)) - color_flow_pairs - @ - [((CF_aux f1, White f2, CF_aux f3), (mult_vertex3 (-3) v), g)] - - | C.Singlet, C.AdjSUN _, C.AdjSUN _ -> - List.map (fun (c2, c3) -> ((White f1, CF_io (f2, c2, c3), CF_io (f3, c3, c2)), v, g)) - color_flow_pairs - @ - [((White f1, CF_aux f2, CF_aux f3), (mult_vertex3 (-3) v), g)] - -(* Coupling three gluons: *) - - | C.AdjSUN _, C.AdjSUN _, C.AdjSUN _ -> - if f1 = f2 && f2 = f3 then - ThoList.flatmap - (fun (c1, c2, c3) -> - [((CF_io (f1, c1, c3), CF_io (f2, c2, c1), CF_io (f3, c3, c2)), v, g); - ((CF_io (f1, c1, c2), CF_io (f2, c3, c1), CF_io (f3, c2, c3)), v, g)]) - color_flow_triples - else - ThoList.flatmap - (fun (c1, c2, c3) -> - (List.map (fun (c1', c2', c3') -> - ((CF_io (f1, c1', c3'), CF_io (f2, c2', c1'), CF_io (f3, c3', c2')), v, g)) - (permute_triple (c1, c2, c3)))) - color_flow_triples - -(* The rest is \emph{verboten}! - - JR mildly protests, because in principle a diquark coupling like in the baryon-number - violating superpotential of three (s)quarks might be allowed. Might be an interesting task - to work out the color flow combinations. - - Tho concedes that he forgot the special case of a $\mathrm{SU}(3)$-baryon-like coupling - \ldots - - *) - - | C.SUN _, (C.Singlet|C.AdjSUN _), (C.Singlet|C.AdjSUN _) - | (C.Singlet|C.AdjSUN _), C.SUN _, (C.Singlet|C.AdjSUN _) - | (C.Singlet|C.AdjSUN _), (C.Singlet|C.AdjSUN _), C.SUN _ -> - colored_vertex "colored_vertex3: single quark/anti-quark" - - | C.SUN _, C.SUN _, C.SUN _ -> - colored_vertex "colored_vertex3: three quarks/anti-quarks" - - | C.Singlet, C.Singlet, C.AdjSUN _ - | C.Singlet, C.AdjSUN _, C.Singlet - | C.AdjSUN _, C.Singlet, C.Singlet -> - colored_vertex "colored_vertex3: single gluon" - -(* \thocwmodulesubsection{Quartic Vertices} *) - - let colorize_vertex4 ((f1, f2, f3, f4), v, g) = - match M.color f1, M.color f2, M.color f3, M.color f4 with - -(* The trivial case. *) - - | C.Singlet, C.Singlet, C.Singlet, C.Singlet -> - [(White f1, White f2, White f3, White f4), v, g] - -(* Coupling a quark, an anti-quark and two colorless particles: *) - - | C.SUN nc1, C.SUN nc2, C.Singlet, C.Singlet -> - if nc1 <> - nc2 then - colored_vertex "colorize_vertex4" - else if nc1 > 0 then - List.map - (fun c -> ((CF_in (f1, c), CF_out (f2, c), White f3, White f4), v, g)) - color_flows - else - List.map - (fun c -> ((CF_out (f1, c), CF_in (f2, c), White f3, White f4), v, g)) - color_flows - - | C.SUN nc1, C.Singlet, C.SUN nc3, C.Singlet -> - if nc1 <> - nc3 then - colored_vertex "colorize_vertex4" - else if nc1 > 0 then - List.map - (fun c -> ((CF_in (f1, c), White f2, CF_out (f3, c), White f4), v, g)) - color_flows - else - List.map - (fun c -> ((CF_out (f1, c), White f2, CF_in (f3, c), White f4), v, g)) - color_flows - - | C.SUN nc1, C.Singlet, C.Singlet, C.SUN nc4 -> - if nc1 <> - nc4 then - colored_vertex "colorize_vertex4" - else if nc1 > 0 then - List.map - (fun c -> ((CF_in (f1, c), White f2, White f3, CF_out (f4, c)), v, g)) - color_flows - else - List.map - (fun c -> ((CF_out (f1, c), White f2, White f3, CF_in (f4, c)), v, g)) - color_flows - - | C.Singlet, C.SUN nc2, C.SUN nc3, C.Singlet -> - if nc2 <> - nc3 then - colored_vertex "colorize_vertex4" - else if nc2 > 0 then - List.map - (fun c -> ((White f1, CF_in (f2, c), CF_out (f3, c), White f4), v, g)) - color_flows - else - List.map - (fun c -> ((White f1, CF_out (f2, c), CF_in (f4, c), White f4), v, g)) - color_flows - - | C.Singlet, C.SUN nc2, C.Singlet, C.SUN nc4 -> - if nc2 <> - nc4 then - colored_vertex "colorize_vertex4" - else if nc2 > 0 then - List.map - (fun c -> ((White f1, CF_in (f2, c), White f3, CF_out (f4, c)), v, g)) - color_flows - else - List.map - (fun c -> ((White f1, CF_out (f2, c), White f3, CF_in (f4, c)), v, g)) - color_flows - - | C.Singlet, C.Singlet, C.SUN nc3, C.SUN nc4 -> - if nc3 <> - nc4 then - colored_vertex "colorize_vertex4" - else if nc3 > 0 then - List.map - (fun c -> ((White f1, White f2, CF_in (f3, c), CF_out (f4, c)), v, g)) - color_flows - else - List.map - (fun c -> ((White f1, White f2, CF_out (f3, c), CF_in (f4, c)), v, g)) - color_flows - -(* Coupling two quarks and two anti-quarks requires additional colorflow - specification: better use an auxiliary field here!: *) - - | C.SUN _, C.SUN _, C.SUN _, C.SUN _ -> - color_flow_ambiguous "colorize_vertex4: four quarks/anti-quarks" - -(* Coupling a quark, an anti-quark, a gluon and a colorless particle: - all particles are again \emph{guaranteed} to be different and no - nontrivial symmetry can arise. *) - - | C.SUN nc1, C.SUN nc2, C.AdjSUN _, C.Singlet -> - if nc1 <> - nc2 then - colored_vertex "colorize_vertex4" - else if nc1 > 0 then - List.map - (fun (c1, c2) -> ((CF_in (f1, c1), CF_out (f2, c2), CF_io (f3, c2, c1), White f4), v, g)) - color_flow_pairs - @ (List.map - (fun c -> ((CF_in (f1, c), CF_out (f2, c), CF_aux f3, White f4), v, g)) - color_flows) - else - List.map - (fun (c1, c2) -> ((CF_out (f1, c2), CF_in (f2, c1), CF_io (f3, c2, c1), White f4), v, g)) - color_flow_pairs - @ (List.map - (fun c -> ((CF_out (f1, c), CF_in (f2, c), CF_aux f3, White f4), v, g)) - color_flows) - - | C.SUN nc1, C.SUN nc2, C.Singlet, C.AdjSUN _ -> - if nc1 <> - nc2 then - colored_vertex "colorize_vertex4" - else if nc1 > 0 then - List.map - (fun (c1, c2) -> ((CF_in (f1, c1), CF_out (f2, c2), White f3, CF_io (f4, c2, c1)), v, g)) - color_flow_pairs - @ (List.map - (fun c -> ((CF_in (f1, c), CF_out (f2, c), White f3, CF_aux f4), v, g)) - color_flows) - else - List.map - (fun (c1, c2) -> ((CF_out (f1, c2), CF_in (f2, c1), White f3, CF_io (f4, c2, c1)), v, g)) - color_flow_pairs - @ (List.map - (fun c -> ((CF_out (f1, c), CF_in (f2, c), White f3, CF_aux f4), v, g)) - color_flows) - - | C.SUN nc1, C.AdjSUN _, C.SUN nc3, C.Singlet -> - if nc1 <> - nc3 then - colored_vertex "colorize_vertex4" - else if nc1 > 0 then - List.map - (fun (c1, c3) -> ((CF_in (f1, c1), CF_io (f2, c3, c1), CF_out (f3, c3), White f4), v, g)) - color_flow_pairs - @ (List.map - (fun c -> ((CF_in (f1, c), CF_aux f2, CF_out (f3, c), White f4), v, g)) - color_flows) - else - List.map - (fun (c1, c3) -> ((CF_out (f1, c3), CF_io (f2, c3, c1), CF_in (f3, c1), White f4), v, g)) - color_flow_pairs - @ (List.map - (fun c -> ((CF_out (f1, c), CF_aux f2, CF_in (f3, c), White f4), v, g)) - color_flows) - - | C.SUN nc1, C.Singlet, C.SUN nc3, C.AdjSUN _ -> - if nc1 <> - nc3 then - colored_vertex "colorize_vertex4" - else if nc1 > 0 then - List.map - (fun (c1, c3) -> ((CF_in (f1, c1), White f2, CF_out (f3, c3), CF_io (f4, c3, c1)), v, g)) - color_flow_pairs - @ (List.map - (fun c -> ((CF_in (f1, c), White f2, CF_out (f3, c), CF_aux f4), v, g)) - color_flows) - else - List.map - (fun (c1, c3) -> ((CF_out (f1, c3), White f2, CF_in (f3, c1), CF_io (f4, c3, c1)), v, g)) - color_flow_pairs - @ (List.map - (fun c -> ((CF_out (f1, c), White f2, CF_in (f3, c), CF_aux f4), v, g)) - color_flows) - - | C.SUN nc1, C.AdjSUN _, C.Singlet, C.SUN nc4 -> - if nc1 <> - nc4 then - colored_vertex "colorize_vertex4" - else if nc1 > 0 then - List.map - (fun (c1, c4) -> ((CF_in (f1, c1), CF_io (f2, c4, c1), White f3, CF_out (f4, c4)), v, g)) - color_flow_pairs - @ (List.map - (fun c -> ((CF_in (f1, c), CF_aux f2, White f3, CF_out (f4, c)), v, g)) - color_flows) - else - List.map - (fun (c1, c4) -> ((CF_out (f1, c4), CF_io (f2, c4, c1), White f3, CF_in (f4, c1)), v, g)) - color_flow_pairs - @ (List.map - (fun c -> ((CF_out (f1, c), CF_aux f2, White f3, CF_in (f4, c)), v, g)) - color_flows) - - | C.SUN nc1, C.Singlet, C.AdjSUN _, C.SUN nc4 -> - if nc1 <> - nc4 then - colored_vertex "colorize_vertex4" - else if nc1 > 0 then - List.map - (fun (c1, c4) -> ((CF_in (f1, c1), White f2, CF_io (f3, c4, c1), CF_out (f4, c4)), v, g)) - color_flow_pairs - @ (List.map - (fun c -> ((CF_in (f1, c), White f2, CF_aux f3, CF_out (f4, c)), v, g)) - color_flows) - else - List.map - (fun (c1, c4) -> ((CF_out (f1, c4), White f2, CF_io (f3, c4, c1), CF_in (f4, c1)), v, g)) - color_flow_pairs - @ (List.map - (fun c -> ((CF_out (f1, c), White f2, CF_aux f3, CF_in (f4, c)), v, g)) - color_flows) - - | C.AdjSUN nc1, C.SUN nc2, C.SUN nc3, C.Singlet -> - if nc2 <> - nc3 then - colored_vertex "colorize_vertex4" - else if nc2 > 0 then - List.map - (fun (c2, c3) -> ((CF_io (f1, c3, c2), CF_in (f2, c2), CF_out (f3, c3), White f4), v, g)) - color_flow_pairs - @ (List.map - (fun c -> ((CF_aux f1, CF_in (f2, c), CF_out (f3, c), White f4), v, g)) - color_flows) - else - List.map - (fun (c2, c3) -> ((CF_io (f1, c3, c2), CF_out (f2, c3), CF_in (f3, c2), White f4), v, g)) - color_flow_pairs - @ (List.map - (fun c -> ((CF_aux f1, CF_out (f2, c), CF_in (f3, c), White f4), v, g)) - color_flows) - - | C.Singlet, C.SUN nc2, C.SUN nc3, C.AdjSUN _ -> - if nc2 <> - nc3 then - colored_vertex "colorize_vertex4" - else if nc2 > 0 then - List.map - (fun (c2, c3) -> ((White f1, CF_in (f2, c2), CF_out (f3, c3), CF_io (f4, c3, c2)), v, g)) - color_flow_pairs - @ (List.map - (fun c -> ((White f1, CF_in (f2, c), CF_out (f3, c), CF_aux f4), v, g)) - color_flows) - else - List.map - (fun (c2, c3) -> ((White f1, CF_out (f2, c3), CF_in (f3, c2), CF_io (f4, c3, c2)), v, g)) - color_flow_pairs - @ (List.map - (fun c -> ((White f1, CF_out (f2, c), CF_in (f3, c), CF_aux f4), v, g)) - color_flows) - - | C.AdjSUN _, C.SUN nc2, C.Singlet, C.SUN nc4 -> - if nc2 <> - nc4 then - colored_vertex "colorize_vertex4" - else if nc2 > 0 then - List.map - (fun (c2, c4) -> ((CF_io (f1, c4, c2), CF_in (f2, c2), White f3, CF_out (f4, c4)), v, g)) - color_flow_pairs - @ (List.map - (fun c -> ((CF_aux f1, CF_in (f2, c), White f3, CF_out (f4, c)), v, g)) - color_flows) - else - List.map - (fun (c2, c4) -> ((CF_io (f1, c4, c2), CF_out (f2, c4), White f3, CF_in (f4, c2)), v, g)) - color_flow_pairs - @ (List.map - (fun c -> ((CF_aux f1, CF_out (f2, c), White f3, CF_in (f4, c)), v, g)) - color_flows) - - | C.Singlet, C.SUN nc2, C.AdjSUN _, C.SUN nc4 -> - if nc2 <> - nc4 then - colored_vertex "colorize_vertex4" - else if nc2 > 0 then - List.map - (fun (c2, c4) -> ((White f1, CF_in (f2, c2), CF_io (f3, c4, c2), CF_out (f4, c4)), v, g)) - color_flow_pairs - @ (List.map - (fun c -> ((White f1, CF_in (f2, c), CF_aux f3, CF_out (f4, c)), v, g)) - color_flows) - else - List.map - (fun (c2, c4) -> ((White f1, CF_out (f2, c4), CF_io (f3, c4, c2), CF_in (f4, c2)), v, g)) - color_flow_pairs - @ (List.map - (fun c -> ((White f1, CF_out (f2, c), CF_aux f3, CF_in (f4, c)), v, g)) - color_flows) - - | C.AdjSUN _, C.Singlet, C.SUN nc3, C.SUN nc4 -> - if nc3 <> - nc4 then - colored_vertex "colorize_vertex4" - else if nc3 > 0 then - List.map - (fun (c3, c4) -> ((CF_io (f1, c4, c3), White f2, CF_in (f3, c3), CF_out (f4, c4)), v, g)) - color_flow_pairs - @ (List.map - (fun c -> ((CF_aux f1, White f2, CF_in (f3, c), CF_out (f4, c)), v, g)) - color_flows) - else - List.map - (fun (c3, c4) -> ((CF_io (f1, c4, c3), White f2, CF_out (f2, c4), CF_in (f4, c3)), v, g)) - color_flow_pairs - @ (List.map - (fun c -> ((CF_aux f1, White f2, CF_out (f2, c), CF_in (f4, c)), v, g)) - color_flows) - - | C.Singlet, C.AdjSUN _, C.SUN nc3, C.SUN nc4 -> - if nc3 <> - nc4 then - colored_vertex "colorize_vertex4" - else if nc3 > 0 then - List.map - (fun (c3, c4) -> ((White f1, CF_io (f2, c4, c3), CF_in (f3, c3), CF_out (f4, c4)), v, g)) - color_flow_pairs - @ (List.map - (fun c -> ((White f1, CF_aux f2, CF_in (f3, c), CF_out (f4, c)), v, g)) - color_flows) - else - List.map - (fun (c3, c4) -> ((White f1, CF_io (f2, c4, c3), CF_out (f2, c4), CF_in (f4, c3)), v, g)) - color_flow_pairs - @ (List.map - (fun c -> ((White f1, CF_aux f2, CF_out (f2, c), CF_in (f4, c)), v, g)) - color_flows) - -(* Coupling a quark, an anti-quark and two gluons. For two different octets (is there a - realistic situation for this we need twelve combinations as well as two combinations - for the rest. *) - - | C.SUN nc1, C.SUN nc2, C.AdjSUN _, C.AdjSUN _ -> - if (compare f3 f4) <> 0 then - incomplete "colorize_vertex4" - else - if nc1 <> - nc2 then - colored_vertex "colorize_vertex4" - else if nc1 > 0 then - ThoList.flatmap - (fun (c1,c2,c3) -> List.map (fun (c1', c2', c3') -> - ((CF_in (f1, c1'), CF_out (f2, c2'), CF_io (f3, c2', c3'), CF_io (f4, c3', c1')), v, g)) - (permute_triple (c1,c2,c3))) color_flow_triples - @ List.map (fun (c1, c2) -> - ((CF_in (f1, c1), CF_out (f2, c2), CF_io (f3, c2, c1), CF_aux f4), - (mult_vertex4 2 v), g)) color_flow_pairs - @ (List.map (fun c -> - ((CF_in (f1, c), CF_out (f2, c), CF_aux f3, CF_aux f4), (mult_vertex4 2 v), g)) - color_flows) - else - ThoList.flatmap - (fun (c1,c2,c3) -> List.map (fun (c1', c2', c3') -> - ((CF_out (f1, c2'), CF_in (f2, c1'), CF_io (f3, c2', c3'), CF_io (f4, c3', c1')), v, g)) - (permute_triple (c1,c2,c3))) color_flow_triples - @ (List.map (fun (c1, c2) -> - ((CF_out (f1, c2), CF_in (f2, c1), CF_io (f3, c2, c1), CF_aux f4), - (mult_vertex4 2 v), g)) color_flow_pairs) - @ (List.map (fun c -> - ((CF_out (f1, c), CF_in (f2, c), CF_aux f3, CF_aux f4), (mult_vertex4 2 v), g)) - color_flows) - - | C.SUN nc1, C.AdjSUN _, C.SUN nc3, C.AdjSUN _ -> - if (compare f2 f4) <> 0 then - incomplete "colorize_vertex4" - else - if nc1 <> - nc3 then - colored_vertex "colorize_vertex4" - else if nc1 > 0 then - ThoList.flatmap - (fun (c1,c2,c3) -> List.map (fun (c1', c2', c3') -> - ((CF_in (f1, c1'), CF_io (f2, c2', c3'), CF_out (f3, c2'), CF_io (f4, c3', c1')), v, g)) - (permute_triple (c1,c2,c3))) color_flow_triples - @ List.map (fun (c1, c2) -> - ((CF_in (f1, c1), CF_io (f2, c2, c1), CF_out (f3, c2), CF_aux f4), - (mult_vertex4 2 v), g)) color_flow_pairs - @ (List.map (fun c -> - ((CF_in (f1, c), CF_aux f2, CF_out (f3, c), CF_aux f4), (mult_vertex4 2 v), g)) - color_flows) - else - ThoList.flatmap - (fun (c1,c2,c3) -> List.map (fun (c1', c2', c3') -> - ((CF_out (f1, c2'), CF_io (f2, c2', c3'), CF_in (f3, c1'), CF_io (f4, c3', c1')), v, g)) - (permute_triple (c1,c2,c3))) color_flow_triples - @ (List.map (fun (c1, c2) -> - ((CF_out (f1, c2), CF_io (f2, c2, c1), CF_in (f3, c1), CF_aux f4), - (mult_vertex4 2 v), g)) color_flow_pairs) - @ (List.map (fun c -> - ((CF_out (f1, c), CF_aux f2, CF_in (f3, c), CF_aux f4), (mult_vertex4 2 v), g)) - color_flows) - - | C.SUN nc1, C.AdjSUN _, C.AdjSUN _, C.SUN nc4 -> - if (compare f2 f3) <> 0 then - incomplete "colorize_vertex4" - else - if nc1 <> - nc4 then - colored_vertex "colorize_vertex4" - else if nc1 > 0 then - ThoList.flatmap - (fun (c1,c2,c3) -> List.map (fun (c1', c2', c3') -> - ((CF_in (f1, c1'), CF_io (f2, c2', c3'), CF_io (f3, c3', c1'), CF_out (f4, c2')), v, g)) - (permute_triple (c1,c2,c3))) color_flow_triples - @ List.map (fun (c1, c2) -> - ((CF_in (f1, c1), CF_io (f2, c2, c1), CF_aux f3, CF_out (f4, c2)), - (mult_vertex4 2 v), g)) color_flow_pairs - @ (List.map (fun c -> - ((CF_in (f1, c), CF_aux f2, CF_aux f3, CF_out (f4, c)), (mult_vertex4 2 v), g)) - color_flows) - else - ThoList.flatmap - (fun (c1,c2,c3) -> List.map (fun (c1', c2', c3') -> - ((CF_out (f1, c2'), CF_io (f2, c2', c3'), CF_io (f3, c3', c1'), CF_in (f4, c1')), v, g)) - (permute_triple (c1,c2,c3))) color_flow_triples - @ (List.map (fun (c1, c2) -> - ((CF_out (f1, c2), CF_io (f2, c2, c1), CF_aux f3, CF_in (f4, c1)), - (mult_vertex4 2 v), g)) color_flow_pairs) - @ (List.map (fun c -> - ((CF_out (f1, c), CF_aux f2, CF_aux f3, CF_in (f4, c)), (mult_vertex4 2 v), g)) - color_flows) - - | C.AdjSUN _, C.SUN nc2, C.SUN nc3, C.AdjSUN _ -> - if (compare f1 f4) <> 0 then - incomplete "colorize_vertex4" - else - if nc2 <> - nc3 then - colored_vertex "colorize_vertex4" - else if nc2 > 0 then - ThoList.flatmap - (fun (c1,c2,c3) -> List.map (fun (c1', c2', c3') -> - ((CF_io (f1, c2', c3'), CF_in (f2, c1'), CF_out (f3, c2'), CF_io (f4, c3', c1')), v, g)) - (permute_triple (c1,c2,c3))) color_flow_triples - @ List.map (fun (c1, c2) -> - ((CF_io (f1, c2, c1), CF_in (f2, c1), CF_out (f3, c2), CF_aux f4), - (mult_vertex4 2 v), g)) color_flow_pairs - @ (List.map (fun c -> - ((CF_aux f1, CF_in (f2, c), CF_out (f3, c), CF_aux f4), (mult_vertex4 2 v), g)) - color_flows) - else - ThoList.flatmap - (fun (c1,c2,c3) -> List.map (fun (c1', c2', c3') -> - ((CF_io (f1, c2', c3'), CF_out (f2, c2'), CF_in (f3, c1'), CF_io (f4, c3', c1')), v, g)) - (permute_triple (c1,c2,c3))) color_flow_triples - @ (List.map (fun (c1, c2) -> - ((CF_io (f1, c2, c1), CF_out (f2, c2), CF_in (f3, c1), CF_aux f4), - (mult_vertex4 2 v), g)) color_flow_pairs) - @ (List.map (fun c -> - ((CF_aux f1, CF_out (f2, c), CF_in (f3, c), CF_aux f4), (mult_vertex4 2 v), g)) - color_flows) - - | C.AdjSUN _, C.SUN nc2, C.AdjSUN _, C.SUN nc4 -> - if (compare f1 f3) <> 0 then - incomplete "colorize_vertex4" - else - if nc2 <> - nc4 then - colored_vertex "colorize_vertex4" - else if nc2 > 0 then - ThoList.flatmap - (fun (c1,c2,c3) -> List.map (fun (c1', c2', c3') -> - ((CF_io (f1, c2', c3'), CF_in (f2, c1'), CF_io (f3, c3', c1'), CF_out (f4, c2')), v, g)) - (permute_triple (c1,c2,c3))) color_flow_triples - @ List.map (fun (c1, c2) -> - ((CF_io (f1, c2, c1), CF_in (f2, c1), CF_aux f3, CF_out (f4, c2)), - (mult_vertex4 2 v), g)) color_flow_pairs - @ (List.map (fun c -> - ((CF_aux f1, CF_in (f2, c), CF_aux f3, CF_out (f4, c)), (mult_vertex4 2 v), g)) - color_flows) - else - ThoList.flatmap - (fun (c1,c2,c3) -> List.map (fun (c1', c2', c3') -> - ((CF_io (f1, c2', c3'), CF_out (f2, c2'), CF_io (f3, c3', c1'), CF_in (f4, c1')), v, g)) - (permute_triple (c1,c2,c3))) color_flow_triples - @ (List.map (fun (c1, c2) -> - ((CF_io (f1, c2, c1), CF_out (f2, c2), CF_aux f3, CF_in (f4, c1)), - (mult_vertex4 2 v), g)) color_flow_pairs) - @ (List.map (fun c -> - ((CF_aux f1, CF_out (f2, c), CF_aux f3, CF_in (f4, c)), (mult_vertex4 2 v), g)) - color_flows) - - | C.AdjSUN _, C.AdjSUN _, C.SUN nc3, C.SUN nc4 -> - if (compare f1 f2) <> 0 then - incomplete "colorize_vertex4" - else - if nc3 <> - nc4 then - colored_vertex "colorize_vertex4" - else if nc3 > 0 then - ThoList.flatmap - (fun (c1,c2,c3) -> List.map (fun (c1', c2', c3') -> - ((CF_io (f1, c2', c3'), CF_io (f2, c3', c1'), CF_in (f3, c1'), CF_out (f4, c2')), v, g)) - (permute_triple (c1,c2,c3))) color_flow_triples - @ List.map (fun (c1, c2) -> - ((CF_io (f1, c2, c1), CF_aux f2, CF_in (f3, c1), CF_out (f4, c2)), - (mult_vertex4 2 v), g)) color_flow_pairs - @ (List.map (fun c -> - ((CF_aux f1, CF_aux f2, CF_in (f3, c), CF_out (f4, c)), (mult_vertex4 2 v), g)) - color_flows) - else - ThoList.flatmap - (fun (c1,c2,c3) -> List.map (fun (c1', c2', c3') -> - ((CF_io (f1, c2', c3'), CF_io (f2, c3', c1'), CF_out (f3, c2'), CF_in (f4, c1')), v, g)) - (permute_triple (c1,c2,c3))) color_flow_triples - @ (List.map (fun (c1, c2) -> - ((CF_io (f1, c2, c1), CF_aux f2, CF_out (f3, c2), CF_in (f4, c1)), - (mult_vertex4 2 v), g)) color_flow_pairs) - @ (List.map (fun c -> - ((CF_aux f1, CF_aux f2, CF_out (f3, c), CF_in (f4, c)), (mult_vertex4 2 v), g)) - color_flows) - -(* Coupling two gluons and two colorless particles. *) - - | C.AdjSUN _, C.AdjSUN _, C.Singlet, C.Singlet -> - List.map (fun (c1, c2) -> ((CF_io (f1, c1, c2), CF_io (f2, c2, c1), White f3, White f4), v, g)) - color_flow_pairs - @ - [((CF_aux f1, CF_aux f2, White f3, White f4), (mult_vertex4 (-3) v), g)] - - | C.AdjSUN _, C.Singlet, C.AdjSUN _, C.Singlet -> - List.map (fun (c1, c3) -> ((CF_io (f1, c1, c3), White f2, CF_io (f3, c3, c1), White f4), v, g)) - color_flow_pairs - @ - [((CF_aux f1, White f2, CF_aux f3, White f4), (mult_vertex4 (-3) v), g)] - - | C.AdjSUN _, C.Singlet, C.Singlet, C.AdjSUN _ -> - List.map (fun (c1, c4) -> ((CF_io (f1, c1, c4), White f2, White f3, CF_io (f4, c4, c1)), v, g)) - color_flow_pairs - @ - [((CF_aux f1, White f2, White f3, CF_aux f4), (mult_vertex4 (-3) v), g)] - - | C.Singlet, C.AdjSUN _, C.AdjSUN _, C.Singlet -> - List.map (fun (c2, c3) -> ((White f1, CF_io (f2, c2, c3), CF_io (f3, c3, c2), White f4), v, g)) - color_flow_pairs - @ - [((White f1, CF_aux f2, CF_aux f3, White f4), (mult_vertex4 (-3) v), g)] - - | C.Singlet, C.AdjSUN _, C.Singlet, C.AdjSUN _ -> - List.map (fun (c2, c4) -> ((White f1, CF_io (f2, c2, c4), White f3, CF_io (f4, c4, c2)), v, g)) - color_flow_pairs - @ - [((White f1, CF_aux f2, White f3, CF_aux f4), (mult_vertex4 (-3) v), g)] - - | C.Singlet, C.Singlet, C.AdjSUN _, C.AdjSUN _ -> - List.map (fun (c3, c4) -> ((White f1, White f2, CF_io (f3, c3, c4), CF_io (f4, c4, c3)), v, g)) - color_flow_pairs - @ - [((White f1, White f2, CF_aux f3, CF_aux f4), (mult_vertex4 (-3) v), g)] - -(* Coupling tree gluons and a colorless particle. *) - - | C.AdjSUN _, C.AdjSUN _, C.AdjSUN _, C.Singlet -> - ThoList.flatmap - (fun (c1, c2, c3) -> - [((CF_io (f1, c1, c3), CF_io (f2, c2, c1), CF_io (f3, c3, c2), White f4), v, g); - ((CF_io (f1, c1, c2), CF_io (f2, c3, c1), CF_io (f3, c2, c3), White f4), v, g)]) - color_flow_triples - - | C.AdjSUN _, C.AdjSUN _, C.Singlet, C.AdjSUN _ -> - ThoList.flatmap - (fun (c1, c2, c4) -> - [((CF_io (f1, c1, c4), CF_io (f2, c2, c1), White f3, CF_io (f4, c4, c2)), v, g); - ((CF_io (f1, c1, c2), CF_io (f2, c4, c1), White f3, CF_io (f4, c2, c4)), v, g)]) - color_flow_triples - - | C.AdjSUN _, C.Singlet, C.AdjSUN _, C.AdjSUN _ -> - ThoList.flatmap - (fun (c1, c3, c4) -> - [((CF_io (f1, c1, c4), White f2, CF_io (f3, c3, c1), CF_io (f4, c4, c3)), v, g); - ((CF_io (f1, c1, c3), White f2, CF_io (f3, c4, c1), CF_io (f4, c3, c4)), v, g)]) - color_flow_triples - - | C.Singlet, C.AdjSUN _, C.AdjSUN _, C.AdjSUN _ -> - ThoList.flatmap - (fun (c2, c3, c4) -> - [((White f1, CF_io (f2, c2, c4), CF_io (f3, c3, c2), CF_io (f4, c4, c3)), v, g); - ((White f1, CF_io (f2, c2, c3), CF_io (f3, c4, c2), CF_io (f4, c3, c4)), v, g)]) - color_flow_triples - -(* Coupling four gluons. Tho still has concerns about symmetry factors for KK gluons. It's the same - problem that already appears for the gluino-gluon-gluino vertex. *) - -(* - \begin{equation} - \parbox{28mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(24,24) - \fmfsurround{d1,e1,d2,e2,d3,e3,d4,e4} - \fmf{gluon}{v,e1} - \fmf{gluon}{v,e2} - \fmf{gluon}{v,e3} - \fmf{gluon}{v,e4} - \fmflabel{1}{e1} - \fmflabel{2}{e2} - \fmflabel{3}{e3} - \fmflabel{4}{e4} - \fmfdot{v} - \fmffreeze - \fmf{warrow_right}{v,e1} - \fmf{warrow_right}{v,e2} - \fmf{warrow_right}{v,e3} - \fmf{warrow_right}{v,e4} - \end{fmfgraph*}}} \,= - \begin{split} - \mbox{} - & \ii g^2 f_{a_1a_2b}f_{a_3a_4b} - (g_{\mu_1\mu_3} g_{\mu_4\mu_2} - g_{\mu_1\mu_4} g_{\mu_2\mu_3}) \\ - \mbox{} - & \ii g^2 f_{a_1a_3b}f_{a_4a_2b} - (g_{\mu_1\mu_4} g_{\mu_2\mu_3} - g_{\mu_1\mu_2} g_{\mu_3\mu_4}) \\ - \mbox{} - & \ii g^2 f_{a_1a_4b}f_{a_2a_3b} - (g_{\mu_1\mu_2} g_{\mu_3\mu_4} - g_{\mu_1\mu_3} g_{\mu_4\mu_2}) - \end{split} - \end{equation} - *) - - - | C.AdjSUN _, C.AdjSUN _, C.AdjSUN _, C.AdjSUN _ -> - if f1 = f2 && f2 = f3 && f3 = f4 then - ThoList.flatmap - (fun (c1, c2, c3, c4) -> - let c1' = c1 in - List.map (fun (c2', c3', c4') -> - ((CF_io (f1, c1', c2'), CF_io (f2, c3', c1'), - CF_io (f3, c4', c3'), CF_io (f4, c2', c4')), v, g)) - (permute_triple (c2, c3, c4))) - color_flow_quadruples - else - ThoList.flatmap - (fun (c1, c2, c3, c4) -> - List.map (fun (c1',c2', c3', c4') -> - ((CF_io (f1, c1', c2'), CF_io (f2, c3', c1'), - CF_io (f3, c4', c3'), CF_io (f4, c2', c4')), v, g)) - (permute_quadruple (c1, c2, c3, c4))) - color_flow_quadruples - -(* The rest is \emph{verboten}! *) - - - - | C.SUN _, (C.Singlet|C.AdjSUN _), (C.Singlet|C.AdjSUN _), (C.Singlet|C.AdjSUN _) - | (C.Singlet|C.AdjSUN _), C.SUN _, (C.Singlet|C.AdjSUN _), (C.Singlet|C.AdjSUN _) - | (C.Singlet|C.AdjSUN _), (C.Singlet|C.AdjSUN _), C.SUN _, (C.Singlet|C.AdjSUN _) - | (C.Singlet|C.AdjSUN _), (C.Singlet|C.AdjSUN _), (C.Singlet|C.AdjSUN _), C.SUN _ -> - colored_vertex "colorize_vertex4: single quark/anti-quark" - - | C.SUN _, C.SUN _, C.SUN _, (C.Singlet|C.AdjSUN _) - | C.SUN _, C.SUN _, (C.Singlet|C.AdjSUN _), C.SUN _ - | C.SUN _, (C.Singlet|C.AdjSUN _), C.SUN _, C.SUN _ - | (C.Singlet|C.AdjSUN _), C.SUN _, C.SUN _, C.SUN _ -> - colored_vertex "colorize_vertex4: three quarks/anti-quarks" - - | C.Singlet, C.Singlet, C.Singlet, C.AdjSUN _ - | C.Singlet, C.Singlet, C.AdjSUN _, C.Singlet - | C.Singlet, C.AdjSUN _, C.Singlet, C.Singlet - | C.AdjSUN _, C.Singlet, C.Singlet, C.Singlet -> - colored_vertex "colorize_vertex4: single gluon" - -(* \thocwmodulesubsection{Higher Vertices} *) - - let colorize_vertexn (flist, v, g) = - if List.for_all - (fun f -> match M.color f with C.Singlet -> true | _ -> false) - flist - then - [(List.map (fun f -> White f) flist, v, g)] - else - incomplete "colorize_vertexn" - -(* Discuss with {\em tho:} Is there possibly a functor that could take a vertex structure and - add a singlet ??? *) - - - let vertices () = - (ThoList.flatmap colorize_vertex3 vertices3, - ThoList.flatmap colorize_vertex4 vertices4, - ThoList.flatmap colorize_vertexn verticesn) - - let table = Fusion.of_vertices (vertices ()) - let fuse2 = Fusion.fuse2 table - let fuse3 = Fusion.fuse3 table - let fuse = Fusion.fuse table - let max_degree = M.max_degree - - let split_color_string s = - try - let i1 = String.index s '/' in - let i2 = String.index_from s (succ i1) '/' in - let sf = String.sub s 0 i1 - and sc1 = String.sub s (succ i1) (i2 - i1 - 1) - and sc2 = String.sub s (succ i2) (String.length s - i2 - 1) in - (sf, sc1, sc2) - with - | Not_found -> (s, "", "") - - let flavor_of_string s = - try - let sf, sc1, sc2 = split_color_string s in - let f = M.flavor_of_string sf in - match M.color f with - | C.Singlet -> White f - | C.SUN nc -> - if nc > 0 then - CF_in (f, color_flow_of_string sc1) - else - CF_out (f, color_flow_of_string sc2) - | C.AdjSUN _ -> - begin match sc1, sc2 with - | "", "" -> CF_aux f - | _, _ -> CF_io (f, color_flow_of_string sc1, color_flow_of_string sc2) - end - with - | Failure "int_of_string" -> - invalid_arg "Colorize().flavor_of_string: expecting integer" - - let flavor_sans_color_of_string = M.flavor_of_string - - let flavor_to_string = function - | White f -> - M.flavor_to_string f - | CF_in (f, c) -> - M.flavor_to_string f ^ "/" ^ string_of_int c ^ "/" - | CF_out (f, c) -> - M.flavor_to_string f ^ "//" ^ string_of_int c - | CF_io (f, c1, c2) -> - M.flavor_to_string f ^ "/" ^ string_of_int c1 ^ "/" ^ string_of_int c2 - | CF_aux f -> - M.flavor_to_string f ^ "//" - - let flavor_sans_color_to_string = M.flavor_to_string - - let flavor_symbol = function - | White f -> - M.flavor_symbol f - | CF_in (f, c) -> - M.flavor_symbol f ^ "_" ^ string_of_int c ^ "_" - | CF_out (f, c) -> - M.flavor_symbol f ^ "__" ^ string_of_int c - | CF_io (f, c1, c2) -> - M.flavor_symbol f ^ "_" ^ string_of_int c1 ^ "_" ^ string_of_int c2 - | CF_aux f -> - M.flavor_symbol f ^ "__" - - let flavor_sans_color_symbol = M.flavor_symbol - - let gauge_symbol = M.gauge_symbol - -(* Masses and widths must not depend on the colors anyway! *) - let mass_symbol = pullback M.mass_symbol - let width_symbol = pullback M.width_symbol - - let constant_symbol = M.constant_symbol - -(* \thocwmodulesubsection{Adding Color to External Particles} *) - - let count_color_strings f_list = - let rec count_color_strings' n_in n_out n_glue = function - | f :: rest -> - begin match M.color f with - | C.Singlet -> count_color_strings' n_in n_out n_glue rest - | C.SUN nc -> - if nc > 0 then - count_color_strings' (succ n_in) n_out n_glue rest - else if nc < 0 then - count_color_strings' n_in (succ n_out) n_glue rest - else - su0 "count_color_strings" - | C.AdjSUN _ -> - count_color_strings' (succ n_in) (succ n_out) (succ n_glue) rest - end - | [] -> (n_in, n_out, n_glue) - in - count_color_strings' 0 0 0 f_list - - let external_color_flows f_list = - let n_in, n_out, n_glue = count_color_strings f_list in - if n_in <> n_out then - invalid_arg - "Colorize.It().external_color_flows: crossed amplitude not a singlet!" - else if n_in > F.max_lines then - invalid_arg - "Colorize.It().external_color_flows: too few color lines!" - else - let color_strings = ThoList.range 1 n_in in - List.map - (fun permutation -> (color_strings, permutation)) - (Combinatorics.permute color_strings) - - let rec colorize_crossed_amplitude1 f_list (ecf_in, ecf_out) = - match f_list with - | f :: rest -> - begin match M.color f with - | C.Singlet -> - White f :: colorize_crossed_amplitude1 rest (ecf_in, ecf_out) - | C.SUN nc -> - if nc > 0 then - CF_in (f, List.hd ecf_in) :: - colorize_crossed_amplitude1 rest (List.tl ecf_in, ecf_out) - else if nc < 0 then - CF_out (f, List.hd ecf_out) :: - colorize_crossed_amplitude1 rest (ecf_in, List.tl ecf_out) - else - su0 "colorize_flavor" - | C.AdjSUN _ -> - let ecf_in' = List.hd ecf_in - and ecf_out' = List.hd ecf_out in - if ecf_in' = ecf_out' then - CF_aux f :: - colorize_crossed_amplitude1 rest (List.tl ecf_in, List.tl ecf_out) - else - CF_io (f, ecf_in', ecf_out') :: - colorize_crossed_amplitude1 rest (List.tl ecf_in, List.tl ecf_out) - end - | [] -> - begin match ecf_in, ecf_out with - | [], [] -> [] - | _ -> invalid_arg "colorize_crossed_amplitude1" - end - - let colorize_crossed_amplitude p_list = - List.map (colorize_crossed_amplitude1 p_list) (external_color_flows p_list) - - let cross_uncolored p_in p_out = - (List.map M.conjugate p_in) @ p_out - - let uncross_colored n_in p_lists_colorized = - let p_in_out_colorized = List.map (ThoList.splitn n_in) p_lists_colorized in - List.map - (fun (p_in_colored, p_out_colored) -> - (List.map conjugate p_in_colored, p_out_colored)) - p_in_out_colorized - - let amplitude p_in p_out = - uncross_colored - (List.length p_in) - (colorize_crossed_amplitude (cross_uncolored p_in p_out)) - - (* The $-$-sign in the second component is redundant, but a Whizard convention. *) - let indices = function - | White _ -> Color.Flow.of_list [0; 0] - | CF_in (_, c) -> Color.Flow.of_list [c; 0] - | CF_out (_, c) -> Color.Flow.of_list [0; -c] - | CF_io (_, c1, c2) -> Color.Flow.of_list [c1; -c2] - | CF_aux f -> Color.Flow.ghost () - - let flow p_in p_out = - (List.map indices p_in, List.map indices p_out) - -(*i -module M = Models.SM(Models.SM_whizcol);; -module CM = Colorize.Gauge (struct let max_lines = 10 end) (M);; - -let test_amplitude p_in p_out = - List.map - (fun (i, o) -> - (List.map CM.flavor_to_string i, List.map CM.flavor_to_string o)) - (CM.amplitude (List.map M.flavor_of_string p_in) (List.map M.flavor_of_string p_out));; -i*) - - let rcs = - RCS.rename M.rcs - ("Colorize.It(" ^ RCS.name M.rcs ^ ")") - [String.concat " " (RCS.description M.rcs @ ["(statically colorized)"])] - - end - -(* \thocwmodulesection{(Statically) Colorizing a Monochrome Gauge Model} *) - -module Gauge (F : Flows) (M : Model.Gauge) = - struct - - module M = M - - module CM = It (F) (M) - - type flavor = CM.flavor - type flavor_sans_color = CM.flavor_sans_color - type gauge = CM.gauge - type constant = CM.constant - - let flavor_sans_color = CM.flavor_sans_color - let color = CM.color - let pdg = CM.pdg - let lorentz = CM.lorentz - let propagator = CM.propagator - let width = CM.width - let conjugate = CM.conjugate - let conjugate_sans_color = CM.conjugate_sans_color - let fermion = CM.fermion - let max_degree = CM.max_degree - let vertices = CM.vertices - let fuse2 = CM.fuse2 - let fuse3 = CM.fuse3 - let fuse = CM.fuse - let flavors = CM.flavors - let external_flavors = CM.external_flavors - let goldstone = CM.goldstone - let parameters = CM.parameters - let flavor_of_string = CM.flavor_of_string - let flavor_to_string = CM.flavor_to_string - let flavor_symbol = CM.flavor_symbol - let flavor_sans_color_of_string = CM.flavor_sans_color_of_string - let flavor_sans_color_to_string = CM.flavor_sans_color_to_string - let flavor_sans_color_symbol = CM.flavor_sans_color_symbol - let gauge_symbol = CM.gauge_symbol - let mass_symbol = CM.mass_symbol - let width_symbol = CM.width_symbol - let constant_symbol = CM.constant_symbol - let options = CM.options - - let incomplete s = - failwith ("Colorize.Gauge()." ^ s ^ " not done yet!") - - type matter_field = M.matter_field - type gauge_boson = M.gauge_boson - type other = M.other - - type field = - | Matter of matter_field - | Gauge of gauge_boson - | Other of other - - let field f = - incomplete "field" - - let matter_field f = - incomplete "matter_field" - - let gauge_boson f = - incomplete "gauge_boson" - - let other f = - incomplete "other" - - let amplitude = CM.amplitude - - let flow = CM.flow - - let rcs = - RCS.rename M.rcs - ("Colorize.Gauge(" ^ RCS.name M.rcs ^ ")") - [String.concat " " (RCS.description M.rcs @ ["(statically colorized)"])] - - end - -(* \thocwmodulesection{(Dynamically) Colorizing a Monochrome Model} *) - -module Dynamical (M : Model.T) = - struct - - module M = M - - open Coupling - - module C = Color - - let incomplete s = - failwith ("Colorize.It()." ^ s ^ " not done yet!") - - let incomplete s = - Printf.eprintf "WARNING: Colorize.It().%s not done yet!\n" s; - [] - - let su0 s = - invalid_arg ("Colorize.It()." ^ s ^ ": found SU(0)!") - - let colored_vertex s = - invalid_arg ("Colorize.It()." ^ s ^ ": colored vertex!") - - let color_flow_ambiguous s = - invalid_arg ("Colorize.It()." ^ s ^ ": ambiguous color flow!") - - let color_flow_of_string s = - let c = int_of_string s in - if c < 1 then - invalid_arg ("Colorize.It()." ^ s ^ ": color flow # < 1!") - else - c - - type flavor = - | White of M.flavor - | CF_in of M.flavor * int - | CF_out of M.flavor * int - | CF_io of M.flavor * int * int - | CF_aux of M.flavor - - type flavor_sans_color = M.flavor - - let flavor_sans_color = function - | White f -> f - | CF_in (f, _) -> f - | CF_out (f, _) -> f - | CF_io (f, _, _) -> f - | CF_aux f -> f - - let pullback f arg1 = - f (flavor_sans_color arg1) - - type gauge = M.gauge - type constant = M.constant - let options = M.options - - let color = pullback M.color - let pdg = pullback M.pdg - let lorentz = pullback M.lorentz - -(* For the propagator we cannot use pullback because we have to add the case - of the color singlet propagator by hand. *) - - let colorize_propagator = function - | Prop_Scalar -> Prop_Col_Scalar (* Spin 0 octets. *) - | Prop_Majorana -> Prop_Col_Majorana (* Spin 1/2 octets. *) - | Prop_Feynman -> Prop_Col_Feynman (* Spin 1 states, massless. *) - | Prop_Unitarity -> Prop_Col_Unitarity (* Spin 1 states, massive. *) - | Prop_Col_Scalar | Prop_Col_Feynman | Prop_Col_Majorana | Prop_Col_Unitarity - -> failwith ("Colorize.It().colorize_propagator: already colored particle!") - | _ -> failwith ("Colorize.It().colorize_propagator: impossible!") - - let propagator = function - | CF_aux f -> colorize_propagator (M.propagator f) - | White f -> M.propagator f - | CF_in (f, _) -> M.propagator f - | CF_out (f, _) -> M.propagator f - | CF_io (f, _, _) -> M.propagator f - - let width = pullback M.width - - let goldstone = function - | White f -> - begin match M.goldstone f with - | None -> None - | Some (f', g) -> Some (White f', g) - end - | CF_in (f, c) -> - begin match M.goldstone f with - | None -> None - | Some (f', g) -> Some (CF_in (f', c), g) - end - | CF_out (f, c) -> - begin match M.goldstone f with - | None -> None - | Some (f', g) -> Some (CF_out (f', c), g) - end - | CF_io (f, c1, c2) -> - begin match M.goldstone f with - | None -> None - | Some (f', g) -> Some (CF_io (f', c1, c2), g) - end - | CF_aux f -> - begin match M.goldstone f with - | None -> None - | Some (f', g) -> Some (CF_aux f', g) - end - - let conjugate = function - | White f -> White (M.conjugate f) - | CF_in (f, c) -> CF_out (M.conjugate f, c) - | CF_out (f, c) -> CF_in (M.conjugate f, c) - | CF_io (f, c1, c2) -> CF_io (M.conjugate f, c2, c1) - | CF_aux f -> CF_aux (M.conjugate f) - - let conjugate_sans_color = M.conjugate - - let fermion = pullback M.fermion - - let max_degree = M.max_degree - -(* \begin{dubious} - That's the tricky part: the current implementation of [Fusion.Tagged] - needs a list of all flavors. For this we need the list of all color - lines \ldots - \end{dubious} *) - - let flavors () = - incomplete "flavors" - - let external_flavors () = - incomplete "external_flavors" - - let parameters = M.parameters - - module Fusion = Models.Fusions (struct - type f = flavor - type c = constant - let compare = compare - let conjugate = conjugate - end) - -(* \thocwmodulesubsection{Vertices} *) - -(* \begin{dubious} - [vertices] are \emph{only} used by functor applications and - for indexing a cache of precomputed fusion rules. - \end{dubious} *) - - let vertices () = - failwith "Colorize.Dynamical().vertices: no longer supported"; - ([], [], []) - -(* \thocwmodulesubsection{Cubic Vertices} *) - -(* \begin{dubious} - The following pattern matches will eventually become quite long. - The O'Caml compiler will hopefully optimize them aggressively - (\url{http://pauillac.inria.fr/~maranget/papers/opat/}). If this - doesn't turn out to be the case, there might be an intermediate way - using hashtables of functions mapping color flow lines. - \end{dubious} *) - - let colorize_fusion2 f1 f2 (f, v) = - match M.color f, f1, f2 with - | C.Singlet, White _, White _ -> [(White f, v)] - | C.Singlet, CF_in (_, _), White _ - | C.Singlet, White _, CF_in (_, _) -> [] - | C.Singlet, CF_in (_, c1), CF_out (_, c2) -> - if c1 = c2 then [(White f, v)] else [] - | C.SUN _ , White f1, White f2 -> [] - | C.SUN _, CF_in (_, c1), White _ - | C.SUN _, White _, CF_in (_, c1) -> [(CF_in (f, c1), v)] - | C.SUN _, CF_out (_, c1), White _ - | C.SUN _, White _, CF_out (_, c1) -> [(CF_out (f, c1), v)] - | _ -> incomplete "colorize_fusion2" - -(* \thocwmodulesubsection{Quartic Vertices} *) - - let colorize_fusion3 f1 f2 f3 (f, v) = - match M.color f, f1, f2, f3 with - | C.Singlet, White f1, White f2, White f3 -> [(White f, v)] - | C.SUN _ , White f1, White f2, White f3 -> [] - | _ -> incomplete "colorize_fusion3" - -(* \thocwmodulesubsection{Quintic and Higher Vertices} *) - - let is_white = function - | White _ -> true - | _ -> false - - let colorize_fusionn flist (f, v) = - match M.color f, List.for_all is_white flist with - | C.Singlet, true -> [(White f, v)] - | C.SUN _, true -> [] - | _ -> incomplete "colorize_fusionn" - - let fuse2 f1 f2 = - ThoList.flatmap - (colorize_fusion2 f1 f2) - (M.fuse2 (flavor_sans_color f1) (flavor_sans_color f2)) - - let fuse3 f1 f2 f3 = - ThoList.flatmap - (colorize_fusion3 f1 f2 f3) - (M.fuse3 (flavor_sans_color f1) (flavor_sans_color f2) (flavor_sans_color f3)) - - let fuse_list flist = - ThoList.flatmap - (colorize_fusionn flist) - (M.fuse (List.map flavor_sans_color flist)) - - let fuse = function - | [] | [_] -> invalid_arg "Colorize.Dynamical().fuse" - | [f1; f2] -> fuse2 f1 f2 - | [f1; f2; f3] -> fuse3 f1 f2 f3 - | flist -> fuse_list flist - - let max_degree = M.max_degree - - let split_color_string s = - try - let i1 = String.index s '/' in - let i2 = String.index_from s (succ i1) '/' in - let sf = String.sub s 0 i1 - and sc1 = String.sub s (succ i1) (i2 - i1 - 1) - and sc2 = String.sub s (succ i2) (String.length s - i2 - 1) in - (sf, sc1, sc2) - with - | Not_found -> (s, "", "") - - let flavor_of_string s = - try - let sf, sc1, sc2 = split_color_string s in - let f = M.flavor_of_string sf in - match M.color f with - | C.Singlet -> White f - | C.SUN nc -> - if nc > 0 then - CF_in (f, color_flow_of_string sc1) - else - CF_out (f, color_flow_of_string sc2) - | C.AdjSUN _ -> - begin match sc1, sc2 with - | "", "" -> CF_aux f - | _, _ -> CF_io (f, color_flow_of_string sc1, color_flow_of_string sc2) - end - with - | Failure "int_of_string" -> - invalid_arg "Colorize().flavor_of_string: expecting integer" - - let flavor_sans_color_of_string = M.flavor_of_string - - let flavor_to_string = function - | White f -> - M.flavor_to_string f - | CF_in (f, c) -> - M.flavor_to_string f ^ "/" ^ string_of_int c ^ "/" - | CF_out (f, c) -> - M.flavor_to_string f ^ "//" ^ string_of_int c - | CF_io (f, c1, c2) -> - M.flavor_to_string f ^ "/" ^ string_of_int c1 ^ "/" ^ string_of_int c2 - | CF_aux f -> - M.flavor_to_string f ^ "//" - - let flavor_sans_color_to_string = M.flavor_to_string - - let flavor_symbol = function - | White f -> - M.flavor_symbol f - | CF_in (f, c) -> - M.flavor_symbol f ^ "_" ^ string_of_int c ^ "_" - | CF_out (f, c) -> - M.flavor_symbol f ^ "__" ^ string_of_int c - | CF_io (f, c1, c2) -> - M.flavor_symbol f ^ "_" ^ string_of_int c1 ^ "_" ^ string_of_int c2 - | CF_aux f -> - M.flavor_symbol f ^ "__" - - let flavor_sans_color_symbol = M.flavor_symbol - - let gauge_symbol = M.gauge_symbol - -(* Masses and widths must not depend on the colors anyway! *) - let mass_symbol = pullback M.mass_symbol - let width_symbol = pullback M.width_symbol - - let constant_symbol = M.constant_symbol - -(* \thocwmodulesubsection{Adding Color to External Particles} *) - - let count_color_strings f_list = - let rec count_color_strings' n_in n_out n_glue = function - | f :: rest -> - begin match M.color f with - | C.Singlet -> count_color_strings' n_in n_out n_glue rest - | C.SUN nc -> - if nc > 0 then - count_color_strings' (succ n_in) n_out n_glue rest - else if nc < 0 then - count_color_strings' n_in (succ n_out) n_glue rest - else - su0 "count_color_strings" - | C.AdjSUN _ -> - count_color_strings' (succ n_in) (succ n_out) (succ n_glue) rest - end - | [] -> (n_in, n_out, n_glue) - in - count_color_strings' 0 0 0 f_list - - let external_color_flows f_list = - let n_in, n_out, n_glue = count_color_strings f_list in - if n_in <> n_out then - invalid_arg - "Colorize.Dynamical().external_color_flows: crossed amplitude not a singlet!" - else - let color_strings = ThoList.range 1 n_in in - List.map - (fun permutation -> (color_strings, permutation)) - (Combinatorics.permute color_strings) - - let rec colorize_crossed_amplitude1 f_list (ecf_in, ecf_out) = - match f_list with - | f :: rest -> - begin match M.color f with - | C.Singlet -> - White f :: colorize_crossed_amplitude1 rest (ecf_in, ecf_out) - | C.SUN nc -> - if nc > 0 then - CF_in (f, List.hd ecf_in) :: - colorize_crossed_amplitude1 rest (List.tl ecf_in, ecf_out) - else if nc < 0 then - CF_out (f, List.hd ecf_out) :: - colorize_crossed_amplitude1 rest (ecf_in, List.tl ecf_out) - else - su0 "colorize_flavor" - | C.AdjSUN _ -> - let ecf_in' = List.hd ecf_in - and ecf_out' = List.hd ecf_out in - if ecf_in' = ecf_out' then - CF_aux f :: - colorize_crossed_amplitude1 rest (List.tl ecf_in, List.tl ecf_out) - else - CF_io (f, ecf_in', ecf_out') :: - colorize_crossed_amplitude1 rest (List.tl ecf_in, List.tl ecf_out) - end - | [] -> - begin match ecf_in, ecf_out with - | [], [] -> [] - | _ -> invalid_arg "colorize_crossed_amplitude1" - end - - let colorize_crossed_amplitude p_list = - List.map (colorize_crossed_amplitude1 p_list) (external_color_flows p_list) - - let cross_uncolored p_in p_out = - (List.map M.conjugate p_in) @ p_out - - let uncross_colored n_in p_lists_colorized = - let p_in_out_colorized = List.map (ThoList.splitn n_in) p_lists_colorized in - List.map - (fun (p_in_colored, p_out_colored) -> - (List.map conjugate p_in_colored, p_out_colored)) - p_in_out_colorized - - let amplitude p_in p_out = - uncross_colored - (List.length p_in) - (colorize_crossed_amplitude (cross_uncolored p_in p_out)) - - (* The $-$-sign in the second component is redundant, but a Whizard convention. *) - let indices = function - | White _ -> Color.Flow.of_list [0; 0] - | CF_in (_, c) -> Color.Flow.of_list [c; 0] - | CF_out (_, c) -> Color.Flow.of_list [0; -c] - | CF_io (_, c1, c2) -> Color.Flow.of_list [c1; -c2] - | CF_aux f -> Color.Flow.ghost () - - let flow p_in p_out = - (List.map indices p_in, List.map indices p_out) - - let rcs = - RCS.rename M.rcs - ("Colorize.Dynamical(" ^ RCS.name M.rcs ^ ")") - [String.concat " " (RCS.description M.rcs @ ["(dynamically colorized)"])] - - end - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/f90_SM_CKM.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/f90_SM_CKM.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/f90_SM_CKM.ml (revision 8703) @@ -1,33 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -module O = Omega.Make(Fusion.Mixed23)(Targets.Fortran) - (Models.SM(Models.SM_no_anomalous_ckm)) -let _ = O.main () - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/f90_UED.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/f90_UED.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/f90_UED.ml (revision 8703) @@ -1,33 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -module O = Omega.Make(Fusion.Mixed23)(Targets.Fortran) - (Models4.UED(Models4.BSM_bsm)) -let _ = O.main () - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/comphep.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/comphep.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/comphep.ml (revision 8703) @@ -1,507 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -let rcs_file = RCS.parse "Comphep" ["Plagiarizing CompHEP models ..."] - { RCS.revision = "$Revision$"; - RCS.date = "$Date$"; - RCS.author = "$Author$"; - RCS.source - = "$URL$" } - -(* A friendlier [String.sub] that returns an empty string instead of - raising an exception. Instead of the length, the second argument - denotes the last position. *) - -let substring buffer i1 i2 = - let imax = String.length buffer - 1 in - let i1 = max i1 0 - and i2 = min i2 imax in - let len = i2 - i1 + 1 in - if len > 0 then - String.sub buffer i1 len - else - "" - -let first_non_white buffer = - let len = String.length buffer in - let rec skip_white i = - if i >= len then - i - else if buffer.[i] <> ' ' && buffer.[i] <> '\t' then - i - else - skip_white (succ i) in - skip_white 0 - -let last_non_white buffer = - let len = String.length buffer in - let rec skip_white i = - if i < 0 then - i - else if buffer.[i] <> ' ' && buffer.[i] <> '\t' then - i - else - skip_white (pred i) in - skip_white (pred len) - -let gobble_white buffer = - substring buffer (first_non_white buffer) (last_non_white buffer) - -let gobble_arrows buffer = - let imax = String.length buffer - 1 in - if imax >= 0 then - gobble_white - (substring buffer - (if buffer.[0] = '>' then 1 else 0) - (if buffer.[imax] = '<' then pred imax else imax)) - else - "" - -let fold_lines ic f init = - let rec fold_lines' acc = - let continue = - try - let acc' = f (input_line ic) acc in - fun () -> fold_lines' acc' - with - | End_of_file -> fun () -> acc in - continue () in - fold_lines' init - -let column_tabs line = - let len = String.length line in - let rec tabs' acc i = - if i >= len then - List.rev acc - else if line.[i] = '|' then - tabs' (i :: acc) (succ i) - else - tabs' acc (succ i) - in - tabs' [] 0 - -let columns tabs line = - let imax = String.length line - 1 in - let rec columns' acc i = function - | [] -> List.rev_map gobble_white (substring line i imax :: acc) - | tab :: rest -> - if tab < i then - invalid_arg "columns: clash" - else if (match rest with [] -> false | _ -> true) - && line.[tab] <> '|' then - invalid_arg "columns: expecting '|'" - else - columns' (substring line i (pred tab) :: acc) (succ tab) rest - in - columns' [] 0 tabs - -let input_table name = - let ic = open_in name in - let model = input_line ic in - let table = input_line ic in - let line = input_line ic in - let tabs = column_tabs line in - let titles = columns tabs line in - let rows = fold_lines ic (fun line acc -> - if String.length line > 0 && line.[0] = '=' then - acc - else - columns tabs line :: acc) [] in - close_in ic; - (gobble_white model, gobble_white table, List.map gobble_arrows titles, rows) - -let substitute_char (cold, cnew) s = - for i = 0 to String.length s - 1 do - if s.[i] = cold then - s.[i] <- cnew - done; - s - -let sanitize_symbol s = - List.fold_right substitute_char [('+', 'p'); ('-', 'm')] (String.copy s) - -(* \begin{dubious} - Fodder for a future [Coupling] module \ldots - \end{dubious} *) - -let rec fermion_of_lorentz = function - | Coupling.Spinor -> 1 - | Coupling.ConjSpinor -> -1 - | Coupling.Majorana -> 1 - | Coupling.Maj_Ghost -> 1 - | Coupling.Vectorspinor -> 1 - | Coupling.Vector | Coupling.Massive_Vector -> 0 - | Coupling.Scalar | Coupling.Tensor_1 | Coupling.Tensor_2 -> 0 - | Coupling.BRS f -> fermion_of_lorentz f - -let rec conjugate_lorentz = function - | Coupling.Spinor -> Coupling.ConjSpinor - | Coupling.ConjSpinor -> Coupling.Spinor - | Coupling.BRS f -> Coupling.BRS (conjugate_lorentz f) - | f -> f - -(* \begin{dubious} - Currently, this operates on the sanitized symbol names. - \end{dubious} *) - -let pdg_heuristic name = - match name with - | "e1" -> 11 | "E1" -> -11 | "n1" -> 12 | "N1" -> -12 - | "e2" -> 13 | "E2" -> -13 | "n2" -> 14 | "N2" -> -14 - | "e3" -> 15 | "E3" -> -15 | "n3" -> 16 | "N3" -> -16 - | "u" -> 2 | "U" -> -2 | "d" -> 1 | "D" -> -1 - | "c" -> 4 | "C" -> -4 | "s" -> 3 | "S" -> -3 - | "t" -> 6 | "T" -> -6 | "b" -> 5 | "B" -> -5 - | "G" -> 21 | "A" -> 22 | "Z" -> 23 - | "Wp" -> 24 | "Wm" -> -24 | "H" -> 25 - | _ -> invalid_arg ("pdg_heuristic failed: " ^ name) - -module Model = - struct - - type flavor = int - type flavor_sans_color = flavor - let flavor_sans_color f = f - type constant = string - type gauge = unit - - module M = Models.Mutable - (struct type f = flavor type g = gauge type c = constant end) - - let flavors = M.flavors - let external_flavors = M.external_flavors - let lorentz = M.lorentz - let color = M.color - let propagator = M.propagator - let width = M.width - let goldstone = M.goldstone - let conjugate = M.conjugate - let conjugate_sans_color = conjugate - let fermion = M.fermion - let vertices = M.vertices - let fuse2 = M.fuse2 - let fuse3 = M.fuse3 - let fuse = M.fuse - let max_degree = M.max_degree - let parameters = M.parameters - let flavor_of_string = M.flavor_of_string - let flavor_to_string = M.flavor_to_string - let flavor_symbol = M.flavor_symbol - let flavor_sans_color_of_string = flavor_of_string - let flavor_sans_color_to_string = flavor_to_string - let flavor_sans_color_symbol = flavor_symbol - let gauge_symbol = M.gauge_symbol - let pdg = M.pdg - let mass_symbol = M.mass_symbol - let width_symbol = M.width_symbol - let constant_symbol = M.constant_symbol - - let rcs = rcs_file - - type symbol = - | Selfconjugate of string - | Conjugates of string * string - - type particle = - { p_name : string; - p_symbol : symbol; - p_spin : Coupling.lorentz; - p_mass : Comphep_syntax.raw; - p_width : Comphep_syntax.raw; - p_color : Color.t; - p_aux : string option } - - let count_flavors particles = - List.fold_left (fun n p -> n + - match p.p_symbol with - | Selfconjugate _ -> 1 - | Conjugates _ -> 2) 0 particles - - type particle_flavor = - { f_name : string; - f_conjugate : int; - f_symbol : string; - f_pdg : int; - f_spin : Coupling.lorentz; - f_propagator : gauge Coupling.propagator; - f_fermion : int; - f_mass : string; - f_width : string; - f_color : Color.t; - f_aux : string option } - - let real_variable = function - | Comphep_syntax.Integer 0 -> "zero" - | Comphep_syntax.Symbol s -> s - | _ -> invalid_arg "real_variable" - - let dummy_flavor = - { f_name = ""; - f_conjugate = -1; - f_symbol = ""; - f_pdg = 0; - f_spin = Coupling.Scalar; - f_propagator = Coupling.Prop_Scalar; - f_fermion = 0; - f_mass = real_variable (Comphep_syntax.integer 0); - f_width = real_variable (Comphep_syntax.integer 0); - f_color = Color.Singlet; - f_aux = None } - - let propagator_of_lorentz = function - | Coupling.Scalar -> Coupling.Prop_Scalar - | Coupling.Spinor -> Coupling.Prop_Spinor - | Coupling.ConjSpinor -> Coupling.Prop_ConjSpinor - | Coupling.Majorana -> Coupling.Prop_Majorana - | Coupling.Maj_Ghost -> invalid_arg - "propagator_of_lorentz: SUSY ghosts do not propagate" - | Coupling.Vector -> Coupling.Prop_Feynman - | Coupling.Massive_Vector -> Coupling.Prop_Unitarity - | Coupling.Vectorspinor -> - invalid_arg "propagator_of_lorentz: Vectorspinor" - | Coupling.Tensor_1 -> invalid_arg "propagator_of_lorentz: Tensor_1" - | Coupling.Tensor_2 -> invalid_arg "propagator_of_lorentz: Tensor_2" - | Coupling.BRS _ -> invalid_arg "propagator_of_lorentz: no BRST" - - let flavor_of_particle symbol conjg particle = - let spin = particle.p_spin in - { f_name = particle.p_name; - f_conjugate = conjg; - f_symbol = symbol; - f_pdg = pdg_heuristic symbol; - f_spin = spin; - f_propagator = propagator_of_lorentz spin; - f_fermion = fermion_of_lorentz spin; - f_mass = real_variable particle.p_mass; - f_width = real_variable particle.p_width; - f_color = particle.p_color; - f_aux = particle.p_aux } - - let flavor_of_antiparticle symbol conjg particle = - let spin = conjugate_lorentz particle.p_spin in - { f_name = "anti-" ^ particle.p_name; - f_conjugate = conjg; - f_symbol = symbol; - f_pdg = pdg_heuristic symbol; - f_spin = spin; - f_propagator = propagator_of_lorentz spin; - f_fermion = fermion_of_lorentz spin; - f_mass = real_variable particle.p_mass; - f_width = real_variable particle.p_width; - f_color = Color.conjugate particle.p_color; - f_aux = particle.p_aux } - - let parse_expr text = - try - Comphep_parser.expr Comphep_lexer.token (Lexing.from_string text) - with - | Parsing.Parse_error -> invalid_arg ("parse error: " ^ text) - - let parse_function_row = function - | name :: fct :: comment :: _ -> (name, parse_expr fct, comment) - | _ -> invalid_arg "parse_function_row" - - let parse_lagragian_row = function - | p1 :: p2 :: p3 :: p4 :: c :: t :: _ -> - ((p1, p2, p3, p4), parse_expr c, parse_expr t) - | _ -> invalid_arg "parse_lagragian_row" - - let parse_symbol s1 s2 = - if s1 = s2 then - Selfconjugate (sanitize_symbol s1) - else - Conjugates (sanitize_symbol s1, sanitize_symbol s2) - - let parse_spin spin = - match int_of_string spin with - | 0 -> Coupling.Scalar - | 1 -> Coupling.Spinor - | 2 -> Coupling.Vector - | _ -> invalid_arg ("parse_spin: spin = " ^ spin) - - let parse_color color = - match int_of_string color with - | 1 -> Color.Singlet - | 3 -> Color.SUN 3 - | 8 -> Color.AdjSUN 3 - | _ -> invalid_arg ("parse_color: color = " ^ color) - - let parse_particle_row = function - | name :: symbol :: symbol_cc :: spin :: mass :: width :: color :: - aux :: _ -> - { p_name = name; - p_symbol = parse_symbol symbol symbol_cc; - p_spin = parse_spin spin; - p_mass = parse_expr mass; - p_width = parse_expr width; - p_color = parse_color color; - p_aux = match aux with "" -> None | _ -> Some aux } - | _ -> invalid_arg "parse_particle_row" - - let parse_variable_row = function - | name :: value :: comment :: _ -> - (name, float_of_string value, comment) - | _ -> invalid_arg "parse_variable_row" - - let parse_table parse_row name = - let model, table, titles, rows = input_table name in - (model, table, titles, List.rev_map parse_row rows) - - let input_functions = parse_table parse_function_row - let input_lagrangian = parse_table parse_lagragian_row - let input_particles = parse_table parse_particle_row - let input_variables = parse_table parse_variable_row - - let input_model dir idx = - let idx = string_of_int idx in - (input_particles (dir ^ "/prtcls" ^ idx ^ ".mdl"), - input_variables (dir ^ "/vars" ^ idx ^ ".mdl"), - input_functions (dir ^ "/func" ^ idx ^ ".mdl"), - input_lagrangian (dir ^ "/lgrng" ^ idx ^ ".mdl")) - - let flavors_of_particles particles = - let flavors = Array.create (count_flavors particles) dummy_flavor in - ignore (List.fold_left (fun n p -> - match p.p_symbol with - | Selfconjugate f -> - flavors.(n) <- flavor_of_particle f n p; - n + 1 - | Conjugates (f1, f2) -> - flavors.(n) <- flavor_of_particle f1 (n + 1) p; - flavors.(n+1) <- flavor_of_antiparticle f2 n p; - n + 2) 0 particles); - flavors - - module F = Models.Fusions (struct - type f = flavor - type c = constant - let compare = compare - let conjugate = conjugate - end) - - let translate_tensor3 _ = Coupling.Scalar_Scalar_Scalar 1 - let translate_tensor4 _ = Coupling.Scalar4 1 - let translate_constant _ = "" - - let init flavors variables functions vertices = - let fmax = Array.length flavors - 1 in - let flist = ThoList.range 0 fmax in - let clamp_flavor msg f = - if f >= 0 || f <= fmax then - f - else - invalid_arg (msg ^ ": invalid flavor: " ^ string_of_int f) in - let flavor_hash = Hashtbl.create 37 in - let flavor_of_string s = - try - Hashtbl.find flavor_hash s - with - | Not_found -> invalid_arg ("flavor_of_string: " ^ s) in - for f = 0 to fmax do - Hashtbl.add flavor_hash flavors.(f).f_symbol f - done; - let vertices3, vertices4 = - List.fold_left (fun (v3, v4) ((p1, p2, p3, p4), c, t) -> - if p4 = "" then - (((flavor_of_string p1, flavor_of_string p2, flavor_of_string p3), - translate_tensor3 t, translate_constant c) :: v3, v4) - else - (v3, ((flavor_of_string p1, flavor_of_string p2, - flavor_of_string p3, flavor_of_string p4), - translate_tensor4 t, translate_constant c) :: v4)) - ([], []) vertices in - let max_degree = match vertices4 with [] -> 3 | _ -> 4 in - let all_vertices () = (vertices3, vertices4, []) in - let table = F.of_vertices (all_vertices ()) in - let input_parameters = - (real_variable (Comphep_syntax.integer 0), 0.0) :: - (List.map (fun (n, v, _) -> (n, v)) variables) in - let derived_parameters = - List.map (fun (n, f, _) -> (Coupling.Real n, Coupling.Const 0)) - functions in - M.setup - ~color:(fun f -> flavors.(clamp_flavor "color" f).f_color) - ~pdg:(fun f -> flavors.(clamp_flavor "pdg" f).f_pdg) - ~lorentz:(fun f -> flavors.(clamp_flavor "spin" f).f_spin) - ~propagator:(fun f -> - flavors.(clamp_flavor "propagator" f).f_propagator) - ~width:(fun f -> Coupling.Constant) - ~goldstone:(fun f -> None) - ~conjugate:(fun f -> flavors.(clamp_flavor "conjugate" f).f_conjugate) - ~fermion:(fun f -> flavors.(clamp_flavor "fermion" f).f_fermion) - ~max_degree - ~vertices:all_vertices - ~fuse:(F.fuse2 table, F.fuse3 table, F.fuse table) - ~flavors:([("All Flavors", flist)]) - ~parameters:(fun () -> - { Coupling.input = input_parameters; - Coupling.derived = derived_parameters; - Coupling.derived_arrays = [] }) - ~flavor_of_string - ~flavor_to_string:(fun f -> - flavors.(clamp_flavor "flavor_to_string" f).f_name) - ~flavor_symbol:(fun f -> - flavors.(clamp_flavor "flavor_symbol" f).f_symbol) - ~gauge_symbol:(fun () -> "") - ~mass_symbol:(fun f -> - flavors.(clamp_flavor "mass_symbol" f).f_mass) - ~width_symbol:(fun f -> - flavors.(clamp_flavor "width_symbol" f).f_width) - ~constant_symbol:(fun c -> failwith "constant_symbol") - - let particles_file = ref "prtcls1.mdl" - let variables_file = ref "vars1.mdl" - let functions_file = ref "func1.mdl" - let lagrangian_file = ref "lgrng1.mdl" - - let load () = - let (_, _, _, p), v, f, l = - (input_particles !particles_file, input_variables !variables_file, - input_functions !functions_file, input_lagrangian !lagrangian_file) in - init (flavors_of_particles p) [] [] [] - - let options = Options.create - [ ("p", Arg.String (fun name -> particles_file := name), - "CompHEP particles file (default: " ^ !particles_file ^ ")"); - ("v", Arg.String (fun name -> variables_file := name), - "CompHEP variables file (default: " ^ !variables_file ^ ")"); - ("f", Arg.String (fun name -> functions_file := name), - "CompHEP functions file (default: " ^ !functions_file ^ ")"); - ("l", Arg.String (fun name -> lagrangian_file := name), - "CompHEP lagrangian file (default: " ^ !lagrangian_file ^ ")"); - ("exec", Arg.Unit load, - "load the model files (required _before_ any particle)"); - ("help", Arg.Unit (fun () -> - print_endline - ("[" ^ String.concat "|" - (List.map M.flavor_to_string (M.flavors ())) ^ "]")), - "print information on the model")] - - end - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/Makefile.src =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/Makefile.src (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/Makefile.src (revision 8703) @@ -1,355 +0,0 @@ -# $Id$ -# -# Copyright (C) 1999-2009 by -# -# Wolfgang Kilian -# Thorsten Ohl -# Juergen Reuter -# -# WHIZARD is free software; you can redistribute it and/or modify it -# under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2, or (at your option) -# any later version. -# -# WHIZARD is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -# -######################################################################## -# -# This Makefile does NOT pretent to be portable and requires GNU make. -# GNU make is the native make for Linux systems and available on most -# other systems as `gmake' -# -######################################################################## -# -# All source files for library modules: -# * must be in the correct sequence for linking -# * foo.mll or foo.mly imply foo.ml and foo.mli -# * foo.ml as a source file implies foo.mli as a source files -# -######################################################################## - -ifneq ($(SELECT_PROGRAMS_DEVELOPERS),) -VERTEX_MODULES = vertex_syntax.ml vertex_lexer.mll vertex_parser.mly vertex.ml -MODEL_MODULES = model_syntax.ml model_lexer.mll model_parser.mly model_file.ml -else -VERTEX_MODULES = -MODEL_MODULES = -endif - -MODULES = \ - pmap.ml thoList.ml thoArray.ml thoString.ml rCS.ml \ - cache.ml progress.ml trie.ml linalg.ml \ - algebra.ml options.ml product.ml combinatorics.ml partition.ml tree.ml \ - tuple.ml topology.ml dAG.ml momentum.ml phasespace.ml \ - complex.ml color.ml \ - model.mli models.ml models2.ml models3.ml models4.ml \ - whizard.ml \ - comphep_syntax.ml comphep_lexer.mll comphep_parser.mly comphep.ml \ - $(VERTEX_MODULES) \ - $(MODEL_MODULES) \ - cascade_syntax.ml cascade_lexer.mll cascade_parser.mly cascade.ml \ - colorize.ml fusion.ml coupling.mli target.mli targets_Kmatrix.ml targets.ml \ - omega.ml - -GUI_MODULES = \ - thoGButton.ml thoGWindow.ml thoGMenu.ml thoGDraw.ml - -######################################################################## -# -# All source files for executable programs: -# * .ml will be appended -# -######################################################################## - -######################################################################## -# Programs for the general public: -######################################################################## - -# Released models: QED, SM (+ some anomalous couplings), MSSM - -PROGRAMS_released = f90_QED \ - f90_SM f90_SM_CKM \ - f90_SM_ac f90_SM_ac_CKM \ - f90_MSSM f90_MSSM_CKM \ - f90_NMSSM f90_E6SSM \ - f90_Littlest f90_Littlest_Eta \ - f90_Littlest_Tpar \ - f90_Simplest f90_Simplest_univ \ - f90_Xdim f90_GravTest \ - f90_SM_km f90_UED f90_Zprime \ - f90_Template - -# Self tests: -PROGRAMS_tests = f90_SM_clones count - -######################################################################## -# Programs for advanced users: -######################################################################## - -# Not tested comprehensively: -PROGRAMS_unreleased = f90_SM_Rxi f90_2HDM f90_CQED - -# Theoretical Models: -PROGRAMS_theoretical = f90_Phi3 f90_Phi3h f90_Phi4 f90_Phi4h - -# Alternative implementations of released models: -PROGRAMS_redundant = f90Maj_SM f90_SMh - -######################################################################## -# Programs for developers: -######################################################################## - -# Delevopment tools: -PROGRAMS_delevopment = test_linalg whizard_tool model_file - -# Known to be incomplete: -PROGRAMS_incomplete = f90_Comphep ovm_SM - -# Known to be unphysical: -# PROGRAMS_unphysical = f90_QCD - -######################################################################## -# Obsolete Programs: -######################################################################## - -# The old Standard Model with auxiliary fields -PROGRAMS_obsolete = f90_SM3 f90_SM3_ac f90_SM3_clones -PROGRAMS_obsolete += f90Maj_SM3 f90_SM3h - -######################################################################## - -PROGRAMS_public = \ - $(PROGRAMS_released) \ - $(PROGRAMS_tests) \ - $(PROGRAMS_unreleased) \ - $(PROGRAMS_theoretical) \ - $(PROGRAMS_redundant) - -PROGRAMS_private = \ - $(PROGRAMS_not_public) \ - $(PROGRAMS_delevopment) \ - $(PROGRAMS_incomplete) \ - $(PROGRAMS_unphysical) \ - $(PROGRAMS_obsolete) - -######################################################################## - -PROGRAMS := -GUI_PROGRAMS := - -######################################################################## - -ifneq ($(SELECT_PROGRAMS_CUSTOM),) - -PROGRAMS := $(SELECT_PROGRAMS_CUSTOM) - -else - -ifneq ($(SELECT_PROGRAMS_RELEASED),) - PROGRAMS += $(PROGRAMS_released) $(PROGRAMS_tests) -endif - -ifneq ($(SELECT_PROGRAMS_UNRELEASED),) - PROGRAMS += $(PROGRAMS_unreleased) -endif - -ifneq ($(SELECT_PROGRAMS_THEORETICAL),) - PROGRAMS += $(PROGRAMS_theoretical) -endif - -ifneq ($(SELECT_PROGRAMS_REDUNDANT),) - PROGRAMS += $(PROGRAMS_redundant) -endif - -ifneq ($(SELECT_PROGRAMS_DEVELOPERS),) - PROGRAMS += \ - $(PROGRAMS_not_public) \ - $(PROGRAMS_delevopment) \ - $(PROGRAMS_incomplete) \ - $(PROGRAMS_unphysical) -endif - -ifneq ($(SELECT_PROGRAMS_OBSOLETE),) - PROGRAMS += $(PROGRAMS_obsolete) -endif - -endif - -######################################################################## - -ifneq ($(SELECT_PROGRAMS_GUI),) - GUI_PROGRAMS := ogiga -endif - -######################################################################## -# -# Primary files (sources): -# -######################################################################## - -LIB_SRC_ML = $(filter %.ml,$(MODULES)) -LIB_SRC_MLI = $(filter %.mli,$(MODULES)) $(LIB_SRC_ML:.ml=.mli) -LIB_SRC_MLL = $(filter %.mll,$(MODULES)) -LIB_SRC_MLY = $(filter %.mly,$(MODULES)) - -GUI_LIB_SRC_ML = $(filter %.ml,$(GUI_MODULES)) -GUI_LIB_SRC_MLI = $(filter %.mli,$(GUI_MODULES)) $(GUI_LIB_SRC_ML:.ml=.mli) -GUI_LIB_SRC_MLL = $(filter %.mll,$(GUI_MODULES)) -GUI_LIB_SRC_MLY = $(filter %.mly,$(GUI_MODULES)) - -APP_ML = $(addsuffix .ml,$(PROGRAMS)) -GUI_APP_ML = $(addsuffix .ml,$(GUI_PROGRAMS)) - -SRC_ML = $(LIB_SRC_ML) $(GUI_LIB_SRC_ML) $(APP_ML) $(GUI_APP_ML) -SRC_MLI = $(LIB_SRC_MLI) $(GUI_LIB_SRC_MLI) -SRC_MLL = $(LIB_SRC_MLL) $(GUI_LIB_SRC_MLL) -SRC_MLY = $(LIB_SRC_MLY) $(GUI_LIB_SRC_MLY) - -SOURCE_OCAML = $(SRC_ML) $(SRC_MLI) $(SRC_MLL) $(SRC_MLY) - -APP_ML_public = $(addsuffix .ml,$(PROGRAMS_public)) -APP_ML_private = $(addsuffix .ml,$(PROGRAMS_private)) -APP_ML_all = $(APP_ML_public) $(APP_ML_private) - -SRC_ML_public = $(LIB_SRC_ML) $(GUI_LIB_SRC_ML) $(APP_ML_public) $(GUI_APP_ML) -SRC_ML_private = $(APP_ML_private) -SRC_ML_all = $(SRC_ML_public) $(SRC_ML_private) - -SOURCE_OCAML_public = $(SRC_ML_public) $(SRC_MLI) $(SRC_MLL) $(SRC_MLY) -SOURCE_OCAML_private = $(SRC_ML_private) -SOURCE_OCAML_all = $(SOURCE_OCAML_public) $(SOURCE_OCAML_private) - -######################################################################## -# -# Derived files: -# -######################################################################## - -LIB_ML = $(filter %.ml,$(patsubst %.mll,%.ml,$(patsubst %.mly,%.ml,$(MODULES)))) -LIB_MLI = $(filter %.mli,$(patsubst %.mly,%.mli,$(patsubst %.ml,%.mli,$(MODULES)))) -DERIVED_ML = $(filter-out $(LIB_SRC_ML),$(LIB_ML)) -DERIVED_MLI = $(filter-out $(LIB_SRC_MLI),$(LIB_MLI)) - -GUI_LIB_ML = $(filter %.ml,$(patsubst %.mll,%.ml,$(patsubst %.mly,%.ml,$(GUI_MODULES)))) -GUI_LIB_MLI = $(filter %.mli,$(patsubst %.mly,%.mli,$(patsubst %.ml,%.mli,$(GUI_MODULES)))) -GUI_DERIVED_ML = $(filter-out $(GUI_LIB_SRC_ML),$(GUI_LIB_ML)) -GUI_DERIVED_MLI = $(filter-out $(GUI_LIB_SRC_MLI),$(GUI_LIB_MLI)) - -DERIVED_OCAML = $(DERIVED_ML) $(DERIVED_MLI) $(GUI_DERIVED_ML) $(GUI_DERIVED_MLI) - -LIB_CMI = $(LIB_MLI:.mli=.cmi) -LIB_CMO = $(LIB_ML:.ml=.cmo) -LIB_CMX = $(LIB_ML:.ml=.cmx) - -APP_BIN = $(addsuffix .bin,$(PROGRAMS)) -APP_OPT = $(addsuffix .opt,$(PROGRAMS)) -APP_CMO = $(addsuffix .cmo,$(PROGRAMS)) -APP_CMX = $(addsuffix .cmx,$(PROGRAMS)) - -ifeq ($(SELECT_PROGRAMS_GUI),yes) - GUI_LIB_CMI = $(GUI_LIB_MLI:.mli=.cmi) - GUI_LIB_CMO = $(GUI_LIB_ML:.ml=.cmo) - GUI_LIB_CMX = $(GUI_LIB_ML:.ml=.cmx) - GUI_APP_BIN = $(addsuffix .bin,$(GUI_PROGRAMS)) - GUI_APP_OPT = $(addsuffix .opt,$(GUI_PROGRAMS)) - GUI_APP_CMO = $(addsuffix .cmo,$(GUI_PROGRAMS)) - GUI_APP_CMX = $(addsuffix .cmx,$(GUI_PROGRAMS)) -endif - -INTERFACES = $(SRC_MLI:.mli=.interface) -IMPLEMENTATIONS = $(SRC_ML_all:.ml=.implementation) \ - $(SRC_MLL:.mll=.implementation) $(SRC_MLY:.mly=.implementation) - -DERIVED_TEX = index.tex $(INTERFACES) $(IMPLEMENTATIONS) omegalib.tex - -DAGS = bhabha0.eps bhabha.eps \ - epemudbardubar0.eps epemudbardubar.eps \ - epemudbarmunumubar0.eps epemudbarmunumubar.eps - -######################################################################## -# -# Fortran90/95/03 -# -######################################################################## - -######################################################################## -# derived straightforwardly from omegalib.nw -######################################################################## - -FC_LIBSRC_FROM_OMEGALIB_NW_public := \ - kinds.f95 \ - omega_constants.f95 omega_spinors.f95 \ - omega_bispinors.f95 omega_vectorspinors.f95 omega_vectors.f95 \ - omega_couplings.f95 omega_polarizations.f95 omega_polarizations_madgraph.f95 \ - omega_tensors.f95 omega_tensor_polarizations.f95 \ - omega_vspinor_polarizations.f95 \ - omega_spinor_couplings.f95 omega_bispinor_couplings.f95 \ - omega_utils.f95 omega95.f95 omega95_bispinors.f95 \ - omega_parameters.f95 omega_parameters_madgraph.f95 - -# The unfinished O'Mega virtual machine -# (don't build it by default, because some compilers trip over it!) -FC_LIBSRC_FROM_OMEGALIB_NW_private := \ - omegavm95.f95 - -FC_LIBSRC_public := $(FC_LIBSRC_FROM_OMEGALIB_NW_public) -FC_LIBSRC_private := $(FC_LIBSRC_FROM_OMEGALIB_NW_private) - -######################################################################## -# derived from other files or using preprocessors -######################################################################## - -# tho's unreleased code -FC_LIBSRC_private += omega_spinor_colors.f95 omega_bispinor_colors.f95 - -######################################################################## - -FC_LIBSRC := $(FC_LIBSRC_public) -FC_LIBSRC_FROM_OMEGALIB_NW := $(FC_LIBSRC_FROM_OMEGALIB_NW_public) - -ifneq ($(SELECT_PROGRAMS_DEVELOPERS),) - FC_LIBSRC += $(FC_LIBSRC_private) - FC_LIBSRC_FROM_OMEGALIB_NW += $(FC_LIBSRC_FROM_OMEGALIB_NW_private) -endif - -######################################################################## - -FC_TSTLIBSRC = omega_testtools.f95 -FC_TSTSRC = test_omega95.f95 test_omega95_bispinors.f95 - -FC_LIBOBJ = $(FC_LIBSRC:.f95=.o) -FC_LIBOBJP = $(FC_LIBSRC:.f95=_p.o) -FC_TSTLIBOBJ = $(FC_TSTLIBSRC:.f95=.o) -FC_TSTLIBOBJP = $(FC_TSTLIBSRC:.f95=_p.o) -FC_TSTOBJ = $(FC_TSTSRC:.f95=.o) -FC_TSTOBJP = $(FC_TSTSRC:.f95=_p.o) - -######################################################################## -# -# Fortran77 -# -######################################################################## - -F77LIBSRC := - -ifneq ($(SELECT_PROGRAMS_DEVELOPERS),) - -F77LIBSRC += omega77.f - -endif - -F77TSTSRC = - -F77LIBOBJ = $(F77LIBSRC:.f=.o) -F77TSTOBJ = $(F77TSTSRC:.f=.o) - -######################################################################## - - Index: branches/ohl/omega-development/completed/whizard2/src/f90_MSSM.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/f90_MSSM.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/f90_MSSM.ml (revision 8703) @@ -1,33 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -module O = Omega.Make(Fusion.Mixed23_Majorana)(Targets.Fortran_Majorana) - (Models2.MSSM(Models2.MSSM_no_4)) -let _ = O.main () - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/cascade_lexer.mll =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/cascade_lexer.mll (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/cascade_lexer.mll (revision 8703) @@ -1,55 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -{ -open Cascade_parser -let unquote s = - String.sub s 1 (String.length s - 2) -} - -let digit = ['0'-'9'] -let upper = ['A'-'Z'] -let lower = ['a'-'z'] -let char = upper | lower -let white = [' ' '\t' '\n'] - -(* We use a very liberal definition of strings for flavor names. *) -rule token = parse - white { token lexbuf } (* skip blanks *) - | '%' [^'\n']* '\n' - { token lexbuf } (* skip comments *) - | digit+ { INT (int_of_string (Lexing.lexeme lexbuf)) } - | '+' { PLUS } - | ':' { COLON } - | '~' { OFFSHELL } - | '=' { ONSHELL } - | '#' { GAUSS } - | '!' { NOT } - | '&' '&'? { AND } - | '|' '|'? { OR } - | '(' { LPAREN } - | ')' { RPAREN } - | char [^ ' ' '\t' '\n' '|' '&' '(' ')' ':']* - { FLAVOR (Lexing.lexeme lexbuf) } - | '"' [^ '"']* '"' - { FLAVOR (unquote (Lexing.lexeme lexbuf)) } - | eof { END } Index: branches/ohl/omega-development/completed/whizard2/src/thoGMenu.mli =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/thoGMenu.mli (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/thoGMenu.mli (revision 8703) @@ -1,90 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -(* Lists of possible particles can be pretty long. Therefore it is - beneficial to present the choices hierarchically. *) - -type 'a menu_tree = - | Leafs of (string * 'a) list - | Branches of (string * 'a menu_tree) list - -val submenu_tree : ('a -> unit) -> 'a menu_tree -> GMenu.menu -val tree_of_nested_lists : ('a -> string) -> (string * 'a list) list -> 'a menu_tree - -class virtual ['a] menu_button : Gtk.button Gtk.obj * GMisc.label -> - ('a -> string) -> 'a -> 'a menu_tree -> - object - inherit ['a] ThoGButton.stateful_button - method virtual set_menu : 'a menu_tree -> unit - end - -class type ['a] menu_button_type = - object - inherit ['a] menu_button - method set_menu : 'a menu_tree -> unit - end - -class ['a] menu_button_immediate : Gtk.button Gtk.obj * GMisc.label -> - ('a -> string) -> 'a -> 'a menu_tree -> ['a] menu_button_type - -class ['a] menu_button_delayed : Gtk.button Gtk.obj * GMisc.label -> - ('a -> string) -> 'a -> 'a menu_tree -> ['a] menu_button_type - -val menu_button : ('a -> string) -> 'a -> 'a menu_tree -> - ?border_width:int -> ?width:int -> ?height:int -> - ?packing:(GObj.widget -> unit) -> ?show:bool -> unit -> - 'a menu_button_delayed - -class ['a] tensor_menu : ('a -> string) -> 'a -> 'a menu_tree -> int -> - ?label:string -> ?tooltip_maker:(int -> string) -> - ?border_width:'b -> ?width:int -> ?height:int -> - ?packing:(GObj.widget -> unit) -> ?show:bool -> unit -> - object - val mutable active : int - val mutable buttons : 'a menu_button array - val frame : GBin.frame - method frame : GBin.frame - method set_active : int -> unit - method set_menu : 'a menu_tree -> unit - method states : 'a array - end - -(* This is the same as [GMenu.factory] but with the ability to - add right justified menus; for Motif-style `Help' menus, for - example. *) - -class ['a] factory : ?accel_group:Gtk.accel_group -> - ?accel_modi:Gdk.Tags.modifier list -> - ?accel_flags:Gtk.Tags.accel_flag list -> 'a -> - object - inherit ['a] GMenu.factory - method add_submenu_right : - ?key:Gdk.keysym -> string -> GMenu.menu - end - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/rCS.mli =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/rCS.mli (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/rCS.mli (revision 8703) @@ -1,69 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -(* This is a very simple library for exporting and accessing - \texttt{RCS} and \texttt{CVS} revision control information. - In addition, module names and short descriptions are supported - as well. - - If multiple applications are constructed by functors, - the functions in this module can be used to identify the concrete - implementations. In the context of O'Mega, this is particularly - important for physics models and target languages. *) - -(* One structure of type [raw] has to be initialized in each file by the raw - RCS keyword strings. It can remain private to the module, because it is - only used as argument to the function [parse]. *) -type raw = { revision : string; date : string; author : string; source : string } - -(* Parsed revision control info: *) -type t - -(* [parse name description keywords] initializes revision control info: *) -val parse : string -> string list -> raw -> t - -(* [rename rcs name description] changes the name and description. - This is useful if more than one module is defined in a file. *) -val rename : t -> string -> string list -> t - -(* Access individual parts of the revision control information: *) -val name : t -> string -val description : t -> string list -val revision : t -> string -val date : t -> string -val author : t -> string - -(* This one tries \texttt{URL} (svn), \texttt{Source} (CVS) and \texttt{Id}, - in that order, for the filename. *) -val source : t -> string - -(* Return the formatted revision control info as a list of strings - suitable for printing to the terminal or embedding in the output: *) -val summary : t -> string list - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/thoGWindow.mli =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/thoGWindow.mli (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/thoGWindow.mli (revision 8703) @@ -1,34 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -(* \thocwmodulesection{Misc.~Windows} *) - -val message : ?justify:Gtk.Tags.justification -> - ?title:string -> text:string -> unit -> unit - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/test_linalg.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/test_linalg.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/test_linalg.ml (revision 8703) @@ -1,73 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -let random_vector n = - Array.init n (fun _ -> Random.float 1.0) - -let random_matrix n = - Array.init n (fun _ -> random_vector n) - -let infty_metric a b : float = - let d = ref (abs_float (a.(0) -. b.(0))) in - for i = 1 to Array.length a - 1 do - d := max !d (abs_float (a.(i) -. b.(i))) - done; - !d - -let infty_metric2 a b : float = - let d = ref (infty_metric a.(0) b.(0)) in - for i = 1 to Array.length a - 1 do - d := max !d (infty_metric a.(i) b.(i)) - done; - !d - -let test_lu_decompostion n = - let a = random_matrix n in - let l, u = Linalg.lu_decompose a in - infty_metric2 (Linalg.matmul l u) a - -let test_solve n = - let a = random_matrix n - and b = random_vector n in - let x = Linalg.solve a b in - infty_metric (Linalg.matmulv a x) b - -let _ = - let usage = "usage: " ^ Sys.argv.(0) ^ " [options]" in - Arg.parse - [ "-lu", Arg.Int (fun n -> - Printf.printf "|L*U-A|_infty = %g\n" (test_lu_decompostion n)), - "test LU decomposition"; - "-s", Arg.Int (fun n -> - Printf.printf "|A*x-b|_infty = %g\n" (test_solve n)), - "test solve" ] - (fun _ -> print_endline usage; exit 1) - usage; - exit 0 - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/combinatorics.mli =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/combinatorics.mli (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/combinatorics.mli (revision 8703) @@ -1,163 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -(* This type is defined just for documentation. Below, most functions will - construct a (possibly nested) [list] of partitions or permutations of - a ['a seq]. *) -type 'a seq = 'a list - -(* \thocwmodulesection{Simple Combinatorial Functions} *) - -(* The functions - \begin{subequations} - \begin{align} - \ocwlowerid{factorial}:\;& n \to n! \\ - \ocwlowerid{binomial}:\; & (n, k) \to - \binom{n}{k} = \frac{n!}{k!(n-k)!} \\ - \ocwlowerid{multinomial}:\; & \lbrack n_1; n_2; \ldots; n_k \rbrack \to - \binom{n_1+n_2+\ldots+n_k}{n_1,n_2,\ldots,n_k} = - \frac{(n_1+n_2+\ldots+n_k)!}{n_1!n_2!\cdots n_k!} - \end{align} - \end{subequations} - have not been optimized. They can quickly run out of the range of - native integers. *) -val factorial : int -> int -val binomial : int -> int -> int -val multinomial : int list -> int - -(* [symmetry l] returns the size of the symmetric group on~[l], - i.\,e.~the product of the factorials of the numbers of identical - elements. *) -val symmetry : 'a list -> int - -(* \thocwmodulesection{Partitions} *) - -(* $\ocwlowerid{partitions}\, - \lbrack n_1;n_2;\ldots;n_k \rbrack\, \lbrack x_1;x_2;\ldots;x_n\rbrack$, - where $n=n_1+n_2+\ldots+n_k$, returns all inequivalent partitions of - $\lbrack x_1;x_2;\ldots;x_n\rbrack$ into parts of size $n_1$, $n_2$, \ldots, - $n_k$. The order of the $n_i$ is not respected. There are - \begin{equation} - \frac{1}{S(n_1,n_2,\ldots,n_k)} - \binom{n_1+n_2+\ldots+n_k}{n_1,n_2,\ldots,n_k} - \end{equation} - such partitions, where the symmetry factor~$S(n_1,n_2,\ldots,n_k)$ is - the size of the permutation group of~$\lbrack n_1;n_2;\ldots;n_k \rbrack$ - as determined by the function [symmetry]. *) -val partitions : int list -> 'a seq -> 'a seq list list - -(* [ordered_partitions] is identical to [partitions], except that the - order of the $n_i$ is respected. There are - \begin{equation} - \binom{n_1+n_2+\ldots+n_k}{n_1,n_2,\ldots,n_k} - \end{equation} - such partitions. *) -val ordered_partitions : int list -> 'a seq -> 'a seq list list - -(* [keystones m l] is equivalent to [partitions m l], except for the - special case when the length of~[l] is even and~[m] contains a part - that has exactly half the length of~[l]. In this case only the half - of the partitions is created that has the head of~[l] in the longest - part. *) -val keystones : int list -> 'a seq -> 'a seq list list - -(* It can be beneficial to factorize a common part in the partitions and - keystones: *) -val factorized_partitions : int list -> 'a seq -> ('a seq * 'a seq list list) list -val factorized_keystones : int list -> 'a seq -> ('a seq * 'a seq list list) list - -(* \thocwmodulesubsection{Special Cases} *) - -(* [partitions] is built from components that can be convenient by themselves, - even thepugh they are just special cases of [partitions]. - - [split k l] returns the list of all inequivalent splits of the list~[l] into - one part of length~[k] and the rest. There are - \begin{equation} - \frac{1}{S(|l|-k,k)} \binom{|l|}{k} - \end{equation} - such splits. After replacing the pairs by two-element lists, - [split k l] is equivalent to [partitions [k; length l - k] l].*) - -val split : int -> 'a seq -> ('a seq * 'a seq) list - -(* Create both equipartitions of lists of even length. There are - \begin{equation} - \binom{|l|}{k} - \end{equation} - such splits. After replacing the pairs by two-element lists, - the result of [ordered_split k l] is equivalent to - [ordered_partitions [k; length l - k] l].*) - -val ordered_split : int -> 'a seq -> ('a seq * 'a seq) list - -(* [multi_split n k l] returns the list of all inequivalent splits of the list~[l] - into~[n] parts of length~[k] and the rest. *) - -val multi_split : int -> int -> 'a seq -> ('a seq list * 'a seq) list -val ordered_multi_split : int -> int -> 'a seq -> ('a seq list * 'a seq) list - -(* \thocwmodulesection{Choices} *) - -(* $\ocwlowerid{choose}\,n\,\lbrack x_1;x_2;\ldots;x_n\rbrack$ - returns the list of all $n$-element subsets - of~$\lbrack x_1;x_2;\ldots;x_n\rbrack$. - [choose n] is equivalent to $(\ocwlowerid{map}\,\ocwlowerid{fst})\circ - (\ocwlowerid{ordered\_split}\,\ocwlowerid{n})$. *) - -val choose : int -> 'a seq -> 'a seq list - -(* [multi_choose n k] is equivalent to $(\ocwlowerid{map}\,\ocwlowerid{fst})\circ - (\ocwlowerid{multi\_split}\,\ocwlowerid{n}\,\ocwlowerid{k})$. *) - -val multi_choose : int -> int -> 'a seq -> 'a seq list list -val ordered_multi_choose : int -> int -> 'a seq -> 'a seq list list - -(* \thocwmodulesection{Permutations} *) - -val permute : 'a seq -> 'a seq list - -(* \thocwmodulesubsection{Graded Permutations} *) - -val permute_signed : 'a seq -> (int * 'a seq) list -val permute_even : 'a seq -> 'a seq list -val permute_odd : 'a seq -> 'a seq list - -(* \thocwmodulesubsection{Tensor Products of Permutations} *) - -(* In other words: permutations which respect compartmentalization. *) -val permute_tensor : 'a seq list -> 'a seq list list -val permute_tensor_signed : 'a seq list -> (int * 'a seq list) list -val permute_tensor_even : 'a seq list -> 'a seq list list -val permute_tensor_odd : 'a seq list -> 'a seq list list - -(* \thocwmodulesubsection{Sorting} *) - -val sort_signed : ('a -> 'a -> int) -> 'a list -> int * 'a list - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/f90_Littlest_Tpar.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/f90_Littlest_Tpar.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/f90_Littlest_Tpar.ml (revision 8703) @@ -1,33 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -module O = Omega.Make(Fusion.Mixed23)(Targets.Fortran) - (Models4.Littlest_Tpar(Models4.BSM_bsm)) -let _ = O.main () - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/model_file.mli =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/model_file.mli (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/model_file.mli (revision 8703) @@ -1,32 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -val model_of_channel : in_channel -> Model_syntax.file -val model_of_file : string -> Model_syntax.file - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/f90_Comphep.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/f90_Comphep.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/f90_Comphep.ml (revision 8703) @@ -1,32 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -module O = Omega.Make(Fusion.Mixed23)(Targets.Fortran)(Comphep.Model) -let _ = O.main () - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/f90_E6SSM.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/f90_E6SSM.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/f90_E6SSM.ml (revision 8703) @@ -1,33 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -module O = Omega.Make(Fusion.Mixed23_Majorana)(Targets.Fortran_Majorana) - (Models3.ExtMSSM(Models3.E6SSM)) -let _ = O.main () - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/model_lexer.mll =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/model_lexer.mll (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/model_lexer.mll (revision 8703) @@ -1,58 +0,0 @@ -/* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */ - -{ -open Model_parser -let unquote s = - String.sub s 1 (String.length s - 2) -} - -let digit = ['0'-'9'] -let upper = ['A'-'Z'] -let lower = ['a'-'z'] -let char = upper | lower -let white = [' ' '\t' '\n'] - -(* We use a very liberal definition of strings in order to avoid - the need for quotes in the declaration section. *) -rule token = parse - white { token lexbuf } (* skip blanks *) - | '%' [^'\n']* '\n' - { token lexbuf } (* skip comments *) - | "particle" { PARTICLE } - | "coupling" { COUPLING } - | "vertex" { VERTEX } - | "author" { AUTHOR } - | "version" { VERSION } - | "created" { CREATED } - | "revised" { REVISED } - | ',' { COMMA } - | '=' { EQUAL } - | ':' { COLON } - | [^ ' ' '\t' '\n' ',' '=' ':' '{' '}']+ - { STRING (Lexing.lexeme lexbuf) } - | '"' [^ '"']* '"' - { STRING (unquote (Lexing.lexeme lexbuf)) } - | '{' [^ '}']* '}' - { EXPR (unquote (Lexing.lexeme lexbuf)) } - | '}' { failwith "unexpected `}' outside of expression" } - | eof { END } Index: branches/ohl/omega-development/completed/whizard2/src/omega_logo.mp =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/omega_logo.mp (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/omega_logo.mp (revision 8703) @@ -1,501 +0,0 @@ -% $Id$ -% -% Copyright (C) 1999-2009 by -% -% Wolfgang Kilian -% Thorsten Ohl -% Juergen Reuter -% -% WHIZARD is free software; you can redistribute it and/or modify it -% under the terms of the GNU General Public License as published by -% the Free Software Foundation; either version 2, or (at your option) -% any later version. -% -% WHIZARD is distributed in the hope that it will be useful, but -% WITHOUT ANY WARRANTY; without even the implied warranty of -% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -% GNU General Public License for more details. -% -% You should have received a copy of the GNU General Public License -% along with this program; if not, write to the Free Software -% Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% These are the capital Omegas in the AMS Euler fonts, -% adapted to Metapost. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -% These all in bitpad numbers (.001"): - programem = 3700; - baseline = 0; - capheight = 2560; - -ptsize = 700; -leftside = rightside = 0h; - -if unknown xscale_factor: xscale_factor := 1; fi -h = ptsize * xscale_factor / programem; -v = ptsize / programem; - -save_leftside:=leftside; save_rightside:=rightside; -def more_side(expr s_sharp) = - leftside:=save_leftside+s_sharp; rightside:=save_rightside+s_sharp; -enddef; - -% ----- Fontbegin, Charbegin ----------------------------------- -% -------------------------------------------------------------- - -transform rot; - -def charbegin(expr c,w_sharp,h_sharp,d_sharp) = - begingroup - beginfig(c); - W := w_sharp*pt; - chardx:=round(W+leftside+rightside); - charwd:=w_sharp+leftside+rightside; charht:=h_sharp; chardp:=d_sharp; - charic:=0; clearxy; clearit; clearpen; - rot := identity; - pair tiept[]; - enddef; - -def endchar = - % setbounds currentpicture to - % (0,-chardp)--(charwd,-chardp)--(charwd,charht)--(0,charht)--cycle; - endfig; - endgroup -enddef; - -def mathcorr(expr subwidth_sharp) = % DEK - charic:=subwidth_sharp; charwd:=charwd-charic; -enddef; - -% Adjusting stems -% revised by DEK to allow highres adjustments, 11 Aug 87 - -vardef set_stem_round(expr slo,s,shi,clo,c,chi) = - stem_lo:=slo*h; stem_hi:=shi*h; stem_norm:=s*h; - curve_lo:=clo*h; curve_hi:=chi*h; curve_norm:=c*h; - save a,b; - a-b = round (stem_norm - curve_norm); - a = round(.5(stem_norm + curve_norm + a - b)); - stem_norm_corr := a-stem_norm; % a is normal stem width in pixels - curve_norm_corr := b-curve_norm; % b is normal curve width in pixels -enddef; - -def no_stem_round = set_stem_round(-1,-1,-1,-1,-1,-1) enddef; -no_stem_round; % default is to do ordinary rounding - -% The |stem_round| macro rounds its argument, forcing numbers that look like -% stem widths to round near to |stem_norm|, and similarly forcing vertical curve -% weights to round near to |curve_norm|. - -def stem_round primary w = if w<0: -stem_rnd(-w) else: stem_rnd(w) fi enddef; - -def stem_rnd(expr w) = - round(w - if (stem_lo<=w) and (w<=stem_hi): +stem_norm_corr - elseif (curve_lo<=w) and (w<=curve_hi): +curve_norm_corr - fi) -enddef; - -% Filling cyclic paths with step width adjustment and rounding - -% Before calling the |adj_fill| macro, the user should set up an -% array |t[]| and a nonnegative integer |n| so that |t[1]| through |t[n]| -% are time values on some cyclic path |p|. It should be true that |t[i]=firsti: - for j=previ+1 upto n: xyset[j]; endfor - for j=1 upto i-1: xyset[j]; endfor - else: - for j=previ+1 upto i-1: xyset[j]; endfor - fi - previ:=i; - fi endfor - else: - for i=1 upto n: xyset[i]; endfor - fi -enddef; - - - -% Return the transformed $i$th segement of |p_path| as defined by the time -% values in |t[]|, updating |curtx| and |curty| if appropriate. - -vardef new_seg(expr i) = - save p; path p; - if known tx[i]: curtx:=tx[i]; fi - if known ty[i]: curty:=ty[i]; fi - p = subpath (t[i],t[i+1]) of p_path transformed (curtx transformed curty); - p -enddef; - - - -% The following macros are used only when |t| entries are readjusted: - - -% Find the first time on the path |p| where the direction is |dir| or |-dir|. - -def extremetime expr dir of p = - begingroup save a,b; - a = directiontime dir of p; if a<0: a:=infinity; fi - b = directiontime -dir of p; if b<0: b:=infinity; fi - if a2tt: b else: a fi; -enddef; - - -% Issue an error message when |t[i]>t[i+1]| after the above adjustment process. - -vardef bad_order(expr i) = - initerim showstopping:=0; - show t[i], t[i+1]; - errmessage "Adjusted t entries "&decimal i&" and "&decimal(i+1) - &" are out of order. (See above)"; -enddef; - - -% The |adj_fill| macro performs the entire adjustment and filling based on -% the following parameters: a list |tfx| of |t| indices for points whose -% $x$-coordinates should not be moved during the adjustment process, a similar -% list |tfy| for $y$-coordinates, a list of pairs $(i,j)$ where $i$ is a |t| -% index and |tiept[j]| is the corresponding tie point, lists |tv| and |th| of -% pairs of |t| indices that correspond to opposite sides of vertical and -% horizontal strokes, and finally a cyclic path |p|. (Note the scaling by |h| -% and |v|.) - -vardef adj_fill@#(text tfx, tfy, tie, tv, th)(expr p) = -% message str@#; % that's for use with the stem-round message above - save p_path, nn, x, y, tx, ty, curtx, curty; - path p_path, p_path'; - transform tx[], ty[], curtx, curty; - p_path = p transformed (identity xscaled h yscaled v transformed rot); - nn = length p_path; - forsuffixes i=tfx: x.fix.i=1; endfor % Prepare for |adj_t| calls. - forsuffixes i=tfy: y.fix.i=1; endfor - for w=1 tv: if pair w: (x.fix[xpart w],x.fix[ypart w]) = (1,1); fi endfor - for w=1 th: if pair w: (y.fix[xpart w],y.fix[ypart w]) = (1,1); fi endfor - for i=1 upto n: - if t[i]>floor t[i]: - if unknown x.fix[i]: adj_t(t[i],right); fi - if unknown y.fix[i]: adj_t(t[i],up); fi - fi - endfor - t[n+1] := t1+nn; - for i=1 upto n: if t[i]>t[i+1]: bad_order(i); fi endfor - for i=1 upto n: z[i] = point t[i] of p_path; endfor - forsuffixes i=tfx: x'i =x.i; endfor - forsuffixes i=tfy: y'i =y.i; endfor - for w=1 tie: if pair w: z'[xpart w] = tiept[ypart w]; fi endfor - for w=1 tv: if pair w: rnd_pr_x([xpart w], [ypart w]); fi endfor - for w=1 th: if pair w: rnd_pr_y([xpart w], [ypart w]); fi endfor - curtx=curty=identity; - set_trans(x, set_tx, xset); - set_trans(y, set_ty, yset); - p_path' = if n=0: p_path else: - for i=1 upto n: new_seg(i)-- endfor cycle - fi; - begingroup save currenttransform; - transform currenttransform; currenttransform:=identity; - if known fillwhite: - draw p_path' withpen pencircle scaled 4; % was scaled 2 - else: - begingroup save pic; % Now fill - picture pic; - pic=currentpicture; - currentpicture:=nullpicture; - fill p_path'; - % cull currentpicture dropping origin; - addto currentpicture also pic; - endgroup; - fi - endgroup; -enddef; - -% UPPERCASE GREEK CHARACTERS -set_stem_round(270,290,320,321,335,367); % DEK -more_side(100h); -%upper case Omega - -charbegin( 1, 3042h, capheight*v, baseline ); -n := 13; -t1 := 2; -t2 := 5; -t3 := 8; -t4 := 10; -t5 := 13; -t6 := 14; -t7 := 16.36; -t8 := 18; -t9 := 20; -t10 := 23; -t11 := 25; -t12 := 29; -t13 := 29.48; - -adj_fill.A(1, 5, 8, 12) % fixed x points - () % fixed y points - () % tied points - ((4,9), (2,11)) % verticals - ((6,7), (3,10), (1,13)) % horizontals - ((3021,188){-30,35}...{-30,35} % 0 - (2991,223){-1,0}...{-738,-41} % 1 - (2018,184){1,33}...{1,33} % 2 - (2019,217){564,169}... % 3 - (2412,479){1,1}... % 4 - (2746,1425){0,1}... % 5 - (2446,2275){-1,1}... % 6 - (2098,2478){-833,274}... % *7 - (1613,2549){-1,0}... % 8 - (617,2203){-1,-1}... % 9 - (263,1251){0,-1}... % 10 - (330,776){256,-808}... % *11 - (519,443){1,-1}...{627,-285} % 12 - (861,216){-12,-23}...{-12,-23} % 13 - (849,193){-248,29}...{-555,24} % 14 - (54,242)-- % 15 - (-6,14){701,52}...{356,-33} % 16 - (1208,-9){80,205}...{80,205} % 17 - (1288,196){-787,148}... % 18 - (880,393){-1,1}... % 19 - (590,1217){0,1}... % 20 - (674,1784){322,975}... % *21 - (912,2192){1,1}... % 22 - (1543,2420){1,0}... % 23 - (2110,2208){1,-1}... % 24 - (2411,1362){0,-1}... % 25 - (2341,830){-268,-893}... % *26 - (2143,469){-1,-1}...{-469,-109} % 27 - (1685,211){-34,-216}...{-34,-216} % 28 - (1651,-5){676,50}...{317,-26} % 29 - (2929,-9)--cycle); % 30 - -endchar; - -charbegin( 2, 3026h, capheight*v, baseline ); -n := 12; -t1 := 1; -t2 := 4; -t3 := 7; -t4 := 10; -t5 := 12; -t6 := 16; -t7 := 18; -t8 := 20; -t9 := 22; -t10 := 24; -t11 := 28; -t12 := 29; - -adj_fill.A(1, 5, 7, 11) % fixed x points - () % fixed y points - () % tied points - ((4,8), (2,10)) % verticals - ((5,6), (3,9), (1,12)) % horizontals - ((3022,390){-1,0}...{-748,-44} % 0 - (1980,344){5,35}...{5,35} % 1 - (1985,379){398,51}... % 2 - (2497,669){1,1}... % 3 - (2781,1461){0,1}... % 4 - (2503,2284){-1,1}... % 5 - (2111,2510){-944,305}... % *6 - (1559,2589){-1,0}... % 7 - (972,2506){-1000,-319}... % *8 - (559,2270){-1,-1}... % 9 - (227,1425){0,-1}...{609,-202} % 10 - (971,375){5,-21}...{5,-21} % 11 - (976,354){-1,0}...{-605,55} % 12 - (82,405)-- % 13 - (-12,53){21,-42}...{21,-42} % 14 - (9,11){680,37}... % 15 - (604,30){1,0}...{315,-24} % 16 - (1213,11){109,342}...{109,342} % 17 - (1322,353){-12,4}... % 18 - (880,728){-611,1027}... % *19 - (711,1380){0,1}... % 20 - (1007,2264){1,1}... % 21 - (1525,2439){1,0}... % 22 - (2007,2269){1,-1}... % 23 - (2309,1401){0,-1}... % 24 - (2247,906){-240,-825}... % *25 - (2069,576){-1,-1}...{-501,-131} % 26 - (1682,349){-88,-352}...{-88,-352} % 27 - (1594,-3){648,52}... % 28 - (2286,20){1,0}...{274,-19} % 29 - (2900,-17)--cycle); % 30 - - endchar; - -% UPPER CASE DUBBAYA -more_side(200h); -charbegin( 3, 3658h, capheight*v, baseline ); - -n := 13; -t1 := 0; -t2 := 3; -t3 := 4; -t4 := 6; -t5 := 9; -t6 := 11; -t7 := 12; -t8 := 13; -t9 := 18; -t10 := 21; -t11 := 24; -t12 := 26; -t13 := 27; - -adj_fill.A(3, 12) % fixed x points - (1, 13) % fixed y points - ((1,1), (13,1)) % tied points - ((6,7)) % verticals - ((7,8), (5,9), (4,10), (2,11)) % horizontals - ((3822,2548){-298,-50}...{-298,-50} % 0 - (3524,2498){-247,-428}... % 1 - (2574,539){-269,-585}...{-30,-28} % 2 - (2544,511){-41,49}... % 3 - (2503,560){-110,499}...{-117,780} % 4 - (2144,2529){-26,24}...{-26,24} % 5 - (2118,2553){-283,-108}...{-283,-108} % 6 - (1835,2445){-185,-535}... % 7 - (1025,597){-144,-306}...{-30,-15} % 8 - (995,582){-23,22}... % 9 - (972,604){-52,237}...{-146,781} % 10 - (555,2549){-606,-11}...{-606,-11} % 11 - (-51,2538)-- % 12 - (-44,2423){414,-111}... % 13 - (122,2375){264,-74}... % 14 - (222,2273){125,-318}... % 15 - (480,1389){548,-2296}...{76,-418} % *16 - (770,-23){39,-17}...{39,-17} % 17 - (809,-40){237,106}...{237,106} % 18 - (1046,66){247,751}... % 19 - (1825,1985){159,324}... % 20 - (1859,2029)... % 21 - (1884,1984){121,-550}...{79,-458} % 22 - (2285,-12){46,-27}...{46,-27} % 23 - (2331,-39){223,98}...{223,98} % 24 - (2554,59){277,679}...{322,523} % 25 - (3822,2471){0,77}...{0,77} % 26 - (3822,2548)--cycle); % 27 - - endchar; - -end. Index: branches/ohl/omega-development/completed/whizard2/src/f90_Simplest.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/f90_Simplest.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/f90_Simplest.ml (revision 8703) @@ -1,33 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -module O = Omega.Make(Fusion.Mixed23)(Targets.Fortran_Majorana) - (Models4.Simplest(Models4.BSM_bsm)) -let _ = O.main () - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/linalg.mli =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/linalg.mli (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/linalg.mli (revision 8703) @@ -1,41 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -exception Singular -exception Not_Square - -val copy_matrix : float array array -> float array array - -val matmul : float array array -> float array array -> float array array -val matmulv : float array array -> float array -> float array - -val lu_decompose : float array array -> float array array * float array array -val solve : float array array -> float array -> float array -val solve_many : float array array -> float array list -> float array list - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/product.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/product.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/product.ml (revision 8703) @@ -1,122 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -(* \thocwmodulesection{Lists} *) - -(* We use the tail recursive [List.fold_left] over [List.fold_right] - for efficiency, but revert the argument lists in order to preserve - lexicographic ordering. The argument lists are much shorter than - the results, so the cost of the [List.rev] is negligible. *) - -let fold2_rev f l1 l2 acc = - List.fold_left (fun acc1 x1 -> - List.fold_left (fun acc2 x2 -> f x1 x2 acc2) acc1 l2) acc l1 - -let fold2 f l1 l2 acc = - fold2_rev f (List.rev l1) (List.rev l2) acc - -let fold3_rev f l1 l2 l3 acc = - List.fold_left (fun acc1 x1 -> fold2 (f x1) l2 l3 acc1) acc l1 - -let fold3 f l1 l2 l3 acc = - fold3_rev f (List.rev l1) (List.rev l2) (List.rev l3) acc - -(* If all lists have the same type, there's also *) - -let rec fold_rev f ll acc = - match ll with - | [] -> acc - | [l] -> List.fold_left (fun acc' x -> f [x] acc') acc l - | l :: rest -> - List.fold_left (fun acc' x -> fold_rev (fun xr -> f (x::xr)) rest acc') acc l - -let fold f ll acc = fold_rev f (List.map List.rev ll) acc - -let list2 op l1 l2 = - fold2 (fun x1 x2 c -> op x1 x2 :: c) l1 l2 [] - -let list3 op l1 l2 l3 = - fold3 (fun x1 x2 x3 c -> op x1 x2 x3 :: c) l1 l2 l3 [] - -let list op ll = - fold (fun l c -> op l :: c) ll [] - -let power n l = - list (fun x -> x) (ThoList.clone n l) - -(* Reshuffling lists: - \begin{equation} - \lbrack - \lbrack a_1;\ldots;a_k \rbrack; - \lbrack b_1;\ldots;b_k \rbrack; - \lbrack c_1;\ldots;c_k \rbrack; - \ldots\rbrack \rightarrow - \lbrack - \lbrack a_1;b_1;c_1;\ldots\rbrack; - \lbrack a_2;b_2;c_2;\ldots\rbrack; - \ldots\rbrack - \end{equation} -*) - -(*i JR/WK -let thread l = - List.map List.rev - (List.fold_left (fun i acc -> List.map2 (fun a b -> b::a) i acc) - (List.map (fun i -> [i]) (List.hd l)) (List.tl l)) -i*) - -(* \begin{dubious} - [tho:] Is this really an optimal implementation? - \end{dubious} *) - -let thread = function - | head :: tail -> - List.map List.rev - (List.fold_left (fun i acc -> List.map2 (fun a b -> b::a) i acc) - (List.map (fun i -> [i]) head) tail) - | [] -> [] - -(* \thocwmodulesection{Sets} *) - -(* The implementation is amazingly simple: *) - -type 'a set - -type ('a, 'a_set, 'b) fold = ('a -> 'b -> 'b) -> 'a_set -> 'b -> 'b -type ('a, 'a_set, 'b, 'b_set, 'c) fold2 = - ('a -> 'b -> 'c -> 'c) -> 'a_set -> 'b_set -> 'c -> 'c - -let outer fold1 fold2 f l1 l2 = fold1 (fun x1 -> fold2 (f x1) l2) l1 -let outer_self fold f l1 l2 = fold (fun x1 -> fold (f x1) l2) l1 - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) - - - - - Index: branches/ohl/omega-development/completed/whizard2/src/omega.tex =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/omega.tex (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/omega.tex (revision 8703) @@ -1,1076 +0,0 @@ -% $Id: omega.tex,v 1.127.10.2 2006/05/15 09:35:21 ohl Exp $ -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\NeedsTeXFormat{LaTeX2e} -\input ifpdf.sty -\ifpdf - \documentclass[a4paper,notitlepage,chapters]{flex} - \usepackage{type1cm} - \usepackage[pdftex,colorlinks]{hyperref} - \usepackage[pdftex]{graphicx,feynmp,emp} - \DeclareGraphicsRule{*}{mps}{*}{} -\else - \documentclass[a4paper,notitlepage,chapters]{flex} - \usepackage[T1]{fontenc} - % \usepackage[hypertex]{hyperref} - \usepackage{graphicx,feynmp,emp} -\fi -\usepackage{verbatim,array,amsmath,amssymb} -\usepackage{url,thophys,thohacks} -\setlength{\unitlength}{1mm} -\empaddtoTeX{\usepackage{amsmath,amssymb}} -\empaddtoTeX{\usepackage{thophys,thohacks}} -\empaddtoprelude{input graph;} -\empaddtoprelude{input boxes;} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%% This should be part of flex.cls and/or thopp.sty -\makeatletter - \@ifundefined{frontmatter}% - {\def\frontmatter{\pagenumbering{roman}}% - \def\mainmatter{\cleardoublepage\pagenumbering{arabic}}} - {} -\makeatother -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%% \makeatletter -%%% %%% Italic figure captions to separate them visually from the text -%%% %%% (this should be supported by flex.cls): -%%% \makeatletter -%%% \@secpenalty=-1000 -%%% \def\fps@figure{t} -%%% \def\fps@table{b} -%%% \long\def\@makecaption#1#2{% -%%% \vskip\abovecaptionskip -%%% \sbox\@tempboxa{#1: \textit{#2}}% -%%% \ifdim\wd\@tempboxa>\hsize -%%% #1: \textit{#2}\par -%%% \else -%%% \global\@minipagefalse -%%% \hb@xt@\hsize{\hfil\box\@tempboxa\hfil}% -%%% \fi -%%% \vskip\belowcaptionskip} -%%% \makeatother -\widowpenalty=4000 -\clubpenalty=4000 -\displaywidowpenalty=4000 -%%% \pagestyle{headings} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\allowdisplaybreaks -\renewcommand{\topfraction}{0.8} -\renewcommand{\bottomfraction}{0.8} -\renewcommand{\textfraction}{0.2} -\setlength{\abovecaptionskip}{.5\baselineskip} -\setlength{\belowcaptionskip}{\baselineskip} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\special{% - !userdict begin - /bop-hook { gsave - 150 100 translate 60 rotate - /Times-Roman findfont 200 scalefont setfont - 0 0 moveto 0.9 setgray (draft!) show - grestore } def - end} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\usepackage{noweb} -%%% \usepackage{nocondmac} -\setlength{\nwmarginglue}{1em} -\noweboptions{smallcode,noidentxref}%%%{webnumbering} -%%% Saving paper: -\def\nwendcode{\endtrivlist\endgroup} -\nwcodepenalty=0 -\let\nwdocspar\relax -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\usepackage[noweb,bypages]{ocamlweb} -\empaddtoTeX{\usepackage[latex-sects,bypages]{ocamlweb}} -\renewcommand{\ocwinterface}[1]{\section{Interface of \ocwupperid{#1}}} -\renewcommand{\ocwmodule}[1]{\section{Implementation of \ocwupperid{#1}}} -\renewcommand{\ocwinterfacepart}{\relax} -\renewcommand{\ocwcodepart}{\relax} -\renewcommand{\ocwbeginindex}{\begin{theindex}} -\newcommand{\thocwmodulesection}[1]{\subsection{#1}} -\newcommand{\thocwmodulesubsection}[1]{\subsubsection{#1}} -\newcommand{\thocwmoduleparagraph}[1]{\paragraph{#1}} -\renewcommand{\ocweol}{\setlength\parskip{0pt}\par} -\makeatletter -\renewcommand{\@oddfoot}{\reset@font\hfil\thepage\hfil} -\let\@evenfoot\@oddfoot -\def\@evenhead{\leftmark{} \hrulefill}% -\def\@oddhead{\hrulefill{} \rightmark}% -\let\@mkboth\markboth -\renewcommand{\chaptermark}[1]{\markboth{\hfil}{\hfil}}% -\renewcommand{\sectionmark}[1]{\markboth{#1}{#1}} -\renewcommand{\chapter}{% - \clearpage\global\@topnum\z@\@afterindentfalse - \secdef\@chapter\@schapter} -\makeatother -\newcommand{\signature}[1]{% - \InputIfFileExists{#1.interface}{}% - {\begin{dubious}\textit{Interface \texttt{#1.mli} unavailable!}\end{dubious}}} -\newcommand{\application}[1]{% - \InputIfFileExists{#1.implementation}{}% - {\begin{dubious}\textit{Application \texttt{#1.ml} unavailable!}\end{dubious}}} -\newcommand{\module}[1]{% - \label{mod:#1}% - \InputIfFileExists{#1.interface}{}% - {\begin{dubious}\textit{Interface \texttt{#1.mli} unavailable!}\end{dubious}}% - \InputIfFileExists{#1.implementation}{}% - {\begin{dubious}\textit{Implementation \texttt{#1.ml} unavailable!}\end{dubious}}} -\newcommand{\lexer}[1]{\application{#1_lexer}} -\renewcommand{\ocwlexmodule}[1]{\relax} -\newcommand{\parser}[1]{\application{#1_parser}} -\renewcommand{\ocwyaccmodule}[1]{\relax} -\newcommand{\thocwincludegraphics}[2]{\includegraphics[#1]{#2}} -\ifpdf - \newcommand{\thocwdefref}[1]{\textbf{\pageref{#1}}}% - \newcommand{\thocwuseref}[1]{\textrm{\pageref{#1}}}% - \renewcommand{\ocwrefindexentry}[5]% - {\item #1,\quad\let\ref\thocwdefref{#4}, used: \let\ref\thocwuseref{#5}} -\fi -\newcommand{\thocwmakebox}[4]{\makebox(#1,#2)[#3]{#4}} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\newenvironment{modules}[1]% - {\begin{list}{}% - {\setlength{\leftmargin}{3em}% - \setlength{\rightmargin}{2em}% - \setlength{\itemindent}{-1em}% - \setlength{\listparindent}{0pt}% - %%%\setlength{\itemsep}{0pt}% - \settowidth{\labelwidth}{\textbf{\ocwupperid{#1}:}}% - \renewcommand{\makelabel}[1]{\ocwupperid{##1:}}}}% - {\end{list}} -\newenvironment{JR}% - {\begin{dubious}\textit{JR sez' (regarding the Majorana Feynman rules):}} - {\textit{(JR's probably right, but I need to check myself \ldots)} - \end{dubious}} - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\DeclareMathOperator{\tr}{tr} -\newcommand{\dd}{\mathrm{d}} -\newcommand{\ii}{\mathrm{i}} -\newcommand{\ee}{\mathrm{e}} -\renewcommand{\Re}{\text{Re}} -\renewcommand{\Im}{\text{Im}} -\newcommand{\ketbra}[2]{\ket{#1}\!\bra{#2}} -\newcommand{\Ketbra}[2]{\Ket{#1}\!\Bra{#2}} - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\makeindex -\begin{document} -\begin{fmffile}{\jobname pics} -\fmfset{arrow_ang}{10} -\fmfset{curly_len}{2mm} -\fmfset{wiggly_len}{3mm} -\fmfcmd{vardef middir (expr p, ang) = - dir (angle direction length(p)/2 of p + ang) - enddef;} -\fmfcmd{style_def arrow_left expr p = - shrink (.7); - cfill (arrow p shifted (4thick * middir (p, 90))); - endshrink - enddef;} -\fmfcmd{style_def arrow_right expr p = - shrink (.7); - cfill (arrow p shifted (4thick * middir (p, -90))); - endshrink - enddef;} -\fmfcmd{style_def warrow_left expr p = - shrink (.7); - cfill (arrow p shifted (8thick * middir (p, 90))); - endshrink - enddef;} -\fmfcmd{style_def warrow_right expr p = - shrink (.7); - cfill (arrow p shifted (8thick * middir (p, -90))); - endshrink - enddef;} -\newcommand{\threeexternal}[3]{% - \fmfsurround{d1,e1,d2,e2,d3,e3}% - \fmfv{label=$#1$,label.ang=0}{e1}% - \fmfv{label=$#2$,label.ang=180}{e2}% - \fmfv{label=$#3$,label.ang=0}{e3}} -\newcommand{\Threeexternal}[3]{% - \fmfsurround{d1,e1,d3,e3,d2,e2}% - \fmfv{label=$#1$,label.ang=0}{e1}% - \fmfv{label=$#2$,label.ang=0}{e2}% - \fmfv{label=$#3$,label.ang=180}{e3}} -\newcommand{\Fourexternal}[4]{% - \fmfsurround{d2,e2,d1,e1,d4,e4,d3,e3}% - \fmfv{label=$#1$,label.ang=180}{e1}% - \fmfv{label=$#2$,label.ang=0}{e2}% - \fmfv{label=$#3$,label.ang=0}{e3}% - \fmfv{label=$#4$,label.ang=180}{e4}} -\newcommand{\Fiveexternal}[5]{% - \fmfsurround{d2,e2,d1,e1,d5,e5,d4,e4,d3,e3}% - \fmfv{label=$#1$,label.ang=180}{e1}% - \fmfv{label=$#2$,label.ang=0}{e2}% - \fmfv{label=$#3$,label.ang=0}{e3}% - \fmfv{label=$#4$,label.ang=0}{e4}% - \fmfv{label=$#5$,label.ang=180}{e5}} -\newcommand{\twoincoming}{% - \fmfdot{v}% - \fmffreeze% - \fmf{warrow_right}{e1,v}% - \fmf{warrow_right}{e2,v}% - \fmf{warrow_right}{v,e3}} -\newcommand{\threeincoming}{% - \fmfdot{v}% - \fmffreeze% - \fmf{warrow_right}{e1,v}% - \fmf{warrow_right}{e2,v}% - \fmf{warrow_right}{e3,v}} -\newcommand{\threeoutgoing}{% - \fmfdot{v}% - \fmffreeze% - \fmf{warrow_right}{v,e1}% - \fmf{warrow_right}{v,e2}% - \fmf{warrow_right}{v,e3}} -\newcommand{\fouroutgoing}{% - \threeoutgoing% - \fmf{warrow_right}{v,e4}} -\newcommand{\fiveoutgoing}{% - \fouroutgoing% - \fmf{warrow_right}{v,e5}} -\newcommand{\setupthreegluons}{% - \fmftop{g3} - \fmfbottom{g1,g2} - \fmf{phantom}{v,g1} - \fmf{phantom}{v,g2} - \fmf{phantom}{v,g3} - \fmffreeze - \fmfipair{v,g[],a[],b[]} - \fmfiset{g1}{vloc (__g1)} - \fmfiset{g2}{vloc (__g2)} - \fmfiset{g3}{vloc (__g3)} - \fmfiset{v}{vloc (__v)} - \fmfiset{a1}{g1 shifted (-3thin,0)} - \fmfiset{b1}{g1 shifted (+1thin,-2thin)} - \fmfiset{a2}{g2 shifted (0,-3thin)} - \fmfiset{b2}{g2 shifted (0,+3thin)} - \fmfiset{a3}{g3 shifted (+1thin,+2thin)} - \fmfiset{b3}{g3 shifted (-3thin,0)}} -\begin{empfile} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\frontmatter -\title{ - O'Mega:\\ - Optimal~Monte-Carlo\\ - Event~Generation~Amplitudes} -\author{% - Thorsten Ohl\thanks{% - \texttt{ohl@physik.uni-wuerzburg.de}, - \texttt{http://physik.uni-wuerzburg.de/ohl}}\\ - \hfil\\ - Institut f\"ur Theoretische~Physik und Astrophysik\\ - Julius-Maximilians-Universit\"at~W\"urzburg\\ - Am~Hubland, 97074~W\"urzburg, Germany\\ - \hfil\\ - J\"urgen Reuter\thanks{\texttt{juergen.reuter@physik.uni-freiburg.de}}\\ - \hfil\\ - Physikalisches Institut\\ - Albert-Ludwigs-Universit\"at Freiburg\\ - Hermann-Herder-Str.~3, 79104 Freiburg, Germany\\ - \hfil\\ - Wolfgang Kilian${}^{c,}$\thanks{\texttt{kilian@hep.physik.uni-siegen.de}}\\ - \hfil\\ - Theoretische Physik 1\\ - Universit\"at Siegen\\ - Walter-Flex-Str.~3, 57068 Siegen, Germany\\ - \hfil\\ - with contributions from Christian Schwinn et al.} -\date{\textbf{unpublished draft, printed \timestamp}} -\maketitle -\begin{abstract} - \ldots -\end{abstract} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\newpage -\begin{quote} - Copyright \textcopyright~2000-2009 - by Thorsten~Ohl~\texttt{} and others -\end{quote} -\begin{quote} - O'Mega is free software; you can redistribute it and/or modify it under - the terms of the GNU General Public License as published by the Free - Software Foundation; either version 2, or (at your option) any later - version. -\end{quote} -\begin{quote} - O'Mega is distributed in the hope that it will be useful, but - \emph{without any warranty}; without even the implied warranty of - \emph{merchantability} or \emph{fitness for a particular purpose}. - See the GNU General Public License for more details. -\end{quote} -\begin{quote} - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -\end{quote} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\section*{Revision Control} -\verbatiminput{RCS.info} -%%% \chapter*{Chapters} -%%% \bgroup -%%% \setcounter{tocdepth}{0}% -%%% \makeatletter\@input{\jobname.toc}\makeatother -%%% \egroup -\setcounter{tocdepth}{2} -\tableofcontents -\mainmatter - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\chapter{Introduction} -\label{sec:intro} - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\section{Complexity} -\label{sec:complexity} - -\begin{table} - \begin{center} - \begin{tabular}{r|r|r} - $n$ & $P(n)$& $F(n)$ \\\hline - 4 & 3 & 3 \\ - 5 & 10 & 15 \\ - 6 & 25 & 105 \\ - 7 & 56 & 945 \\ - 8 & 119 & 10395 \\ - 9 & 246 & 135135 \\ - 10 & 501 & 2027025 \\ - 11 & 1012 & 34459425 \\ - 12 & 2035 & 654729075 \\ - 13 & 4082 & 13749310575 \\ - 14 & 8177 & 316234143225 \\ - 15 & 16368 & 7905853580625 \\ - 16 & 32751 & 213458046676875 - \end{tabular} - \end{center} - \caption{\label{tab:P(n),F(n)} - The number of $\phi^3$ Feynman diagrams~$F(n)$ and independent - poles~$P(n)$.} -\end{table} -There are -\begin{equation} - P(n) = \frac{2^n-2}{2} - n = 2^{n-1} - n - 1 -\end{equation} -independent internal momenta in a $n$-particle scattering -amplitude~\cite{ALPHA:1997}. This grows much slower than the -number -\begin{equation} - F(n) = (2n-5)!! = (2n-5)\cdot(2n-7)\cdot\ldots\cdot3\cdot1 -\end{equation} -of tree Feynman diagrams in vanilla $\phi^3$ (see -table~\ref{tab:P(n),F(n)}). There are no known corresponding -expressions for theories with more than one particle type. However, -empirical evidence from numerical studies~\cite{ALPHA:1997,HELAC:2000} -as well as explicit counting results from O'Mega suggest -\begin{equation} - P^*(n) \propto 10^{n/2} -\end{equation} -while he factorial growth of the number of Feynman diagrams remains -unchecked, of course. - -The number of independent momenta in an amplitude is a better measure -for the complexity of the amplitude than the number of Feynman -diagrams, since there can be substantial cancellations among the -latter. Therefore it should be possible to express the scattering -amplitude more compactly than by a sum over Feynman diagrams. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\section{Ancestors} -\label{sec:ancestors} - -Some of the ideas that O'Mega is based on can be traced back to -HELAS~\cite{HELAS}. HELAS builts Feynman amplitudes by recursively -forming off-shell `wave functions' from joining external lines with -other external lines or off-shell `wave functions'. - -The program Madgraph~\cite{MADGRAPH:1994} automatically generates -Feynman diagrams and writes a Fortran program corresponding to their -sum. The amplitudes are calculated by calls to HELAS~\cite{HELAS}. -Madgraph uses one straightforward optimization: no statement is -written more than once. Since each statement corresponds to a -collection of trees, this optimization is very effective for up to -four particles in the final state. However, since the amplitudes are -given as a sum of Feynman diagrams, this optimization can, by design, -\emph{not} remove the factorial growth and is substantially weaker -than the algorithms of~\cite{ALPHA:1997,HELAC:2000} and the algorithm -of O'Mega for more particles in the final state. - -Then ALPHA~\cite{ALPHA:1997} (see also the slightly modified -variant~\cite{HELAC:2000}) provided a numerical algorithm for -calculating scattering amplitudes and it could be shown empirically, -that the calculational costs are rising with a power instead of -factorially. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\section{Architecture} -\label{sec:architecture} - -\begin{figure} - \begin{center} - \includegraphics[width=\textwidth]{modules} - %includegraphics[height=.8\textheight]{modules} - \end{center} - \caption{\label{fig:modules}% - Module dependencies in O'Mega. The diamond shaped nodes are - abstract signatures defininng functor domains and co-domains. - The rectangular boxes are modules and functors and oval boxes are - examples for applications.} -\end{figure} - -\subsection{General purpose libraries} -Functions that are not specific to O'Mega and could be part of the -O'Caml standard library -\begin{modules}{} - \item[ThoList] (mostly) simple convenience functions for lists that - are missing from the standard library module \ocwupperid{List} - (section~\ref{sec:tholist}, p.~\pageref{sec:tholist}) - \item[Product] effcient tensor products for lists and sets - (section~\ref{sec:product}, p.~\pageref{sec:product}) - \item[Combinatorics] combinatorical formulae, sets of subsets, etc. - (section~\ref{sec:combinatorics}, p.~\pageref{sec:combinatorics}) -\end{modules} - -\subsection{O'Mega} -The non-trivial algorithms that constitute O'Mega: -\begin{modules}{} - \item[DAG] Directed Acyclical Graphs - (section~\ref{sec:DAG}, p.~\pageref{sec:DAG}) - \item[Topology] unusual enumerations of unflavored tree diagrams - (section~\ref{sec:topology}, p.~\pageref{sec:topology}) - \item[Momentum] finite sums of external momenta - (section~\ref{sec:momentum}, p.~\pageref{sec:momentum}) - \item[Fusion] off shell wave functions - (section~\ref{sec:fusion}, p.~\pageref{sec:fusion}) - \item[OVM] O'Mega Virtual Machine (not implemented yet) - (section~\ref{sec:ovm}, p.~\pageref{sec:ovm}) - \item[Omega] functor constructing an application from a model and a - target - (section~\ref{sec:omega}, p.~\pageref{sec:omega}) -\end{modules} - -\subsection{Abstract interfaces} -The domains and co-domains of functors -(section~\ref{sec:coupling}, p.~\pageref{sec:coupling}) -\begin{modules}{} - \item[Coupling] all possible couplings (not comprensive yet) - \item[Model] physical models - \item[Target] target programming languages -\end{modules} - -\subsection{Models} -(section~\ref{sec:models}, p.~\pageref{sec:models}) -\begin{modules}{} - \item[Models.QED] Quantum Electrodynamics - \item[Models.QCD] Quantum Chromodynamics (not complete yet) - \item[Models.SM] Minimal Standard Model (not complete yet) -\end{modules} -Other models will be supported by a convenient concrete syntax for -langrangians in text files. - -\subsection{Targets} -Any programming language that supports arithmetic and a textual -representation of programs can be targeted by O'Caml. The -implementations translate the abstract expressions derived by -\ocwupperid{Fusion} to expressions in the target -(section~\ref{sec:targets}, p.~\pageref{sec:targets}). -\begin{modules}{} - \item[Targets.Fortran] Fortran95 language implementation, calling - subroutines - \item[Targets.Fortran\_Inlined] Fortran language implementation, - self contained - \item[Targets.Helas] Fortran language implementation calling - HELAS~\cite{HELAS} subroutines -\end{modules} -Other targets will come in the future: \texttt{C}, \texttt{C++}, -O'Caml itself, symbolic manipulation languages, etc. - -\subsection{Applications} -(section~\ref{sec:omega}, p.~\pageref{sec:omega}) - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\section{The Big To Do Lists} -\label{sec:TODO} - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\subsection{Required} -All features planned for a first release are in place. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\subsection{Useful} -\begin{enumerate} - \item complete standard model in $R_\xi$-gauge - \item provide \texttt{omega77}, a Fortran77 library equivalent to - \texttt{omega95} (i.\,e.~a more orthogonal HELAS clone) - \item groves (the simple method of cloned generations works) - \item color factors for a ``few'' colored particles, maybe one can - separate color ``eigenamplitudes'' - \item color factors for many colored particles: Mangano, Moretti et al. - \item select allowed helicity combinations for massless fermions - \item Weyl-Van der Waerden spinors - \item speed up helicity sums by using discrete symmetries - \item general triple and quartic vector couplings - \item complete MSSM - \item diagnostics: count corresponding Feynman diagrams - more efficiently for more than ten external lines - \item recognize potential cascade decays ($\tau$, $b$, etc.) - \begin{itemize} - \item warn the user to add additional - \item kill fusions (at runtime), that contribute to a cascade - \end{itemize} -\end{enumerate} - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\subsection{Future Features} -\begin{enumerate} - \item investigate if unpolarized squared matrix elements can be - calculated faster as traces of densitiy matrices. Unfortunately, - the answer apears to be \emph{no} for fermions and \emph{up to a - constant factor} for massive vectors. Since the number of fusions - in the amplitude grows like~$10^{n/2}$, the number of fusions in - the squared matrix element grows like~$10^n$. On the other hand, - there are $2^{\#\text{fermions}+\#\text{massless vectors}} - \cdot3^{\#\text{massive vectors}}$ terms in the helicity sum, which - grows \emph{slower} than~$10^{n/2}$. The constant factor is - probably also not favorable. - However, there will certainly be asymptotic gains for sums over - gauge (and other) multiplets, like color sums. - \item compile Feynman rules from Lagrangians - \item evaluate amplitues in O'Caml by compiling it to three address - code for a virtual machine - \begin{flushleft} - \ocwkw{type}~$\ocwlowerid{mem}~=~\ocwlowerid{scalar}~$\ocwbt{array}~$% - \times{}~\ocwlowerid{spinor}~$\ocwbt{array}~$% - \times{}~\ocwlowerid{spinor}~$\ocwbt{array}~$% - \times{}~\ocwlowerid{vector}~$\ocwbt{array}\\ - \ocwkw{type}~$\ocwlowerid{instr}~=$\\ - \qquad|~$\ocwupperid{VSS}~$\ocwkw{of}~\ocwbt{int}~$% - \times{}~$\ocwbt{int}~$\times{}~$\ocwbt{int}\\ - \qquad|~$\ocwupperid{SVS}~$\ocwkw{of}~\ocwbt{int}~$% - \times{}~$\ocwbt{int}~$\times{}~$\ocwbt{int}\\ - \qquad|~$\ocwupperid{AVA}~$\ocwkw{of}~\ocwbt{int}~$% - \times{}~$\ocwbt{int}~$\times{}~$\ocwbt{int}\\ - \qquad\ldots - \end{flushleft} - this could be as fast as~\cite{ALPHA:1997} or~\cite{HELAC:2000}. - \item a virtual machine will be useful for for other target as - well, because native code appears to become to large for most - compilers for more than ten external particles. Bytecode might - even be faster due to improved cache locality. - \item use the virtual machine in O'Giga -\end{enumerate} - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\subsection{Science Fiction} -\begin{enumerate} - \item numerical and symbolical loop calculations with - \textsc{O'Tera: O'Mega Tool for Evaluating Renormalized Amplitudes} -\end{enumerate} - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\chapter{Tuples and Polytuples} -\label{sec:tuple} -\module{tuple} - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\chapter{Topologies} -\label{sec:topology} -\module{topology} - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\chapter{Directed Acyclical Graphs} -\label{sec:DAG} -\module{dAG} - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\chapter{Momenta} -\label{sec:momentum} -\module{momentum} - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\chapter{Cascades} -\label{sec:cascades} -\module{cascade_syntax} -\section{Lexer} -\lexer{cascade} -\section{Parser} -\parser{cascade} -\module{cascade} - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\chapter{Color} -\label{sec:color} -\module{color} - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\chapter{Fusions} -\label{sec:fusion} -\module{fusion} - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\chapter{Lorentz Representations, Couplings, Models and Targets} -\label{sec:coupling} -\signature{coupling} -\signature{model} -\signature{target} - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\chapter{Colorization} -\module{colorize} - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\chapter{Vertices} -\label{sec:vertex} -\module{vertex_syntax} -\section{Lexer} -The design of the lexer is not perfect yet. Currently, we have -\verb+k+ and \verb+e+ with immediately following digits -as reserved words, denoting momenta and -polarization vectors respectively. Similarly for the -$\gamma$-matrices: \verb+S+($=\mathbf{1}$), \verb+P+($=\gamma_5$), -\verb+V+($=\gamma_\mu$), and \verb+A+($=\gamma_\mu\gamma_5$). -\begin{dubious} - There's no good idea for \verb+T+($=\sigma_{\mu\nu}$) and other - tensors yet. -\end{dubious} -\lexer{vertex} -\section{Parser} -\parser{vertex} -\module{vertex} - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\chapter{Models} -\module{model_syntax} -\section{Lexer} -\lexer{model} -\section{Parser} -\parser{model} -\section{Sample} -{\small\verbatiminput{sample.omf}} -\module{model_file} - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\chapter{Hardcoded Models} -\label{sec:models} -\module{models} -\signature{models2} -\ocwmodule{Models2} -\module{models2} - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\chapter{Comphep Models} -\label{sec:comphep} -\module{comphep_syntax} -\section{Lexer} -\lexer{comphep} -\section{Parser} -\parser{comphep} -\module{comphep} - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\chapter{Hardcoded Targets} -\label{sec:targets} -\module{targets} -\module{targets_Kmatrix} - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\chapter{Phase Space} -\label{sec:phasespace} -\module{phasespace} - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\chapter{Whizard} -\label{sec:whizard} -Talk to~\cite{Kilian:WHIZARD}. -\module{whizard} - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\chapter{Applications} -\label{sec:omega} -\section{Sample} -{\small\verbatiminput{sample.prc}} -\module{omega} -%application{f90_Phi3} -%application{f90_Phi3h} -%application{f90_Phi4} -%application{f90_Phi4h} -\application{f90_QED} -%application{f90_QCD} -\application{f90_SM3} -\application{f90_SM3_ac} -\application{f90_SM} -\application{f90_SM_ac} -%application{f90Maj_SM} -%application{f90Maj_SM4} -\application{f90_MSSM} -%application{f90_MSSM_g} -%application{f90_SM_Rxi} -%application{f90_SM_clones} -%application{f90_2HDM} -%application{f90_SMh} -%application{f90_SM4h} -%application{helas_QED} -%application{helas_QCD} -%application{helas_SM} - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\chapter{O'Giga: O'Mega Graphical Interface for Generation and Analysis} -\label{sec:ogiga} -{\itshape NB: The code in this chapter \emph{must} be compiled with -\verb+-labels+, since \verb+lablgtk+ doesn't appear to work in classic mode.} -\begin{dubious} - Keep in mind that \texttt{ocamlweb} doesn't work properly with - O'Caml~3 yet. The colons in label declarations are typeset with - erroneous white space. -\end{dubious} - -\application{ogiga} - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\chapter*{Acknowledgements} -We thank Mauro Moretti for fruitful discussions of the ALPHA -algorithm~\cite{ALPHA:1997}, that inspired our solution of the double -counting problem. - -We thank Wolfgang Kilian for providing the WHIZARD environment that -turns our numbers into real events with unit weight. Thanks to the -ECFA/DESY workshops and their participants for providing a showcase. -Thanks to Edward Boos for discussions in Kaluza-Klein gravitons. - -This research is supported by Bundesministerium f\"ur Bildung und -Forschung, Germany, (05\,HT9RDA) and Deutsche Forschungsgemeinschaft -(MA\,676/6-1). - -Thanks to the Caml and Objective Caml teams from INRIA for the -development and the lean and mean implementation of a programming -language that does not insult the programmer's intelligence. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\begin{thebibliography}{10} - \bibitem{ALPHA:1997} - F. Caravaglios, M. Moretti, Z.{} Phys.{} \textbf{C74} (1997) 291. - \bibitem{HELAC:2000} - A. Kanaki, C. Papadopoulos, DEMO-HEP-2000/01, hep-ph/0002082, - February 2000. - \bibitem{Ler97} - Xavier Leroy, - \textit{The Objective Caml system, documentation and user's guide}, - Technical Report, INRIA, 1997. - \bibitem{Okasaki:1998:book} - Chris Okasaki, \textit{Purely Functional Data Structures}, - Cambridge University Press, 1998. - \bibitem{HELAS} - H. Murayama, I. Watanabe, K. Hagiwara, KEK Report 91-11, - January 1992. - \bibitem{MADGRAPH:1994} - T. Stelzer, W.F. Long, - Comput.{} Phys.{} Commun.{} \textbf{81} (1994) 357. - \bibitem{Denner:Majorana} - A. Denner, H. Eck, O. Hahn and J. K\"ublbeck, - Phys.{} Lett.{} \textbf{B291} (1992) 278; - Nucl.{} Phys.{} \textbf{B387} (1992) 467. - \bibitem{Barger/etal:1992:color} - V.~Barger, A.~L.~Stange, R.~J.~N.~Phillips, - Phys.~Rev.~\textbf{D45}, (1992) 1751. - \bibitem{Ohl:LOTR} - T. Ohl, \textit{Lord of the Rings}, - (Computer algebra library for O'Caml, unpublished). - \bibitem{Ohl:bocages} - T. Ohl, \textit{Bocages}, - (Feynman diagram library for O'Caml, unpublished). - \bibitem{Kilian:WHIZARD} - W. Kilian, \textit{\texttt{WHIZARD}}, University of Karlsruhe, 2000. - \bibitem{Boos/Ohl:groves} - E.\,E. Boos, T. Ohl, - Phys.\ Rev.\ Lett.\ \textbf{83} (1999) 480. - \bibitem{Han/Lykken/Zhang:1999:Kaluza-Klein} -T.~Han, J.~D.~Lykken and R.~Zhang, -%``On Kaluza-Klein states from large extra dimensions,'' -Phys.{} Rev.{} \textbf{D59} (1999) 105006 -[hep-ph/9811350]. -%%CITATION = HEP-PH 9811350;%% - \bibitem{PTVF92} - William H. Press, Saul A. Teukolsky, William T. Vetterling, - Brian P. Flannery, - \textit{Numerical Recipes: The Art of Scientific Computing}, - Second Edition, Cambridge University Press, 1992. -\bibitem{Cvi76} -P.~Cvitanovi\'c, -% author={Predrag Cvitanovi\'c}, -% title={Group Theory for {Feynman} Diagrams in Non-{Abelian} -% Gauge Theories}, -Phys.{} Rev.{} \textbf{D14} (1976) 1536. -%%%\bibitem{Kleiss/etal:Color-Monte-Carlo} -%%% \begin{dubious} -%%% ``\texttt{Kleiss/etal:Color-Monte-Carlo}'' -%%% \end{dubious} -\end{thebibliography} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\appendix - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\chapter{Revision Control} -\label{sec:RCS} -\module{rCS} - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\chapter{Textual Options} -\label{sec:options} -\module{options} - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\chapter{Progress Reports} -\label{sec:progress} -\module{progress} - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\chapter{More On Lists} -\label{sec:tholist} -\module{thoList} - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\chapter{More On Arrays} -\label{sec:thoarray} -\module{thoArray} - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\chapter{Polymorphic Maps} -\label{sec:pmap} -From~\cite{Ohl:LOTR}. -\module{pmap} - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\chapter{Tries} -\label{sec:trie} -From~\cite{Okasaki:1998:book}, extended for~\cite{Ohl:LOTR}. -\module{trie} - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\chapter{Tensor Products} -\label{sec:product} -From~\cite{Ohl:LOTR}. -\module{product} - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\chapter{Combinatorics} -\label{sec:combinatorics} -\module{combinatorics} - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\chapter{Partitions} -\label{sec:partition} -\module{partition} - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\chapter{Trees} -\label{sec:tree} -From~\cite{Ohl:bocages}: -Trees with one root admit a straightforward recursive definition -\begin{equation} -\label{eq:trees} - T(N,L) = L \cup N\times T(N,L)\times T(N,L) -\end{equation} -that is very well adapted to mathematical reasoning. Such -recursive definitions are useful because they -allow us to prove properties of elements by induction -\begin{multline} -\label{eq:tree-induction} - \forall l\in L: p(l) \land - (\forall n\in N: \forall t_1,t_2\in T(N,L): p(t_1) \land p(t_2) - \Rightarrow p(n\times t_1\times t_2)) \\ - \Longrightarrow \forall t\in T(N,L): p(t) -\end{multline} -i.\,e.~establishing a property for all leaves and showing that a node -automatically satisfies the property if it is true for all children -proves the property for \emph{all} trees. This induction is of course -modelled after standard mathematical induction -\begin{equation} - p(1) \land (\forall n\in \mathbf{N}: p(n) \Rightarrow p(n+1)) - \Longrightarrow \forall n\in \mathbf{N}: p(n) -\end{equation} -The recursive definition~(\ref{eq:trees}) is mirrored by the two tree -construction functions\footnote{To make the introduction more -accessible to non-experts, I avoid the `curried' notation for -functions with multiple arguments and use tuples instead. The actual -implementation takes advantage of curried functions, however. Experts -can read $\alpha\to\beta\to\gamma$ for $\alpha\times\beta\to\gamma$.} -\begin{subequations} -\begin{align} - \ocwlowerid{leaf}:\;& \nu\times\lambda \to(\nu,\lambda) T \\ - \ocwlowerid{node}:\;& \nu\times(\nu,\lambda)T \times(\nu,\lambda)T - \to(\nu,\lambda)T -\end{align} -\end{subequations} -Renaming leaves and nodes leaves the structure of the tree invariant. -Therefore, morphisms~$L\to L'$ and~$N\to N'$ of the sets of leaves -and nodes induce natural homomorphisms~$T(N,L)\to T(N',L')$ of trees -\begin{equation} - \ocwlowerid{map}:\; (\nu\to\nu')\times(\lambda\to\lambda') - \times(\nu,\lambda)T \to(\nu',\lambda') T -\end{equation} -The homomorphisms constructed by \ocwlowerid{map} are trivial, but -ubiquitous. More interesting are the morphisms -\begin{equation} - \begin{aligned} - \ocwlowerid{fold}:\;& (\nu\times\lambda\to\alpha) - \times(\nu\times\alpha\times\alpha\to\alpha) - \times(\nu,\lambda)T \to\alpha \\ - & (f_1,f_2,l\in L) \mapsto f_1(l) \\ - & (f_1,f_2,(n,t_1,t_2)) \mapsto - f_2(n,\ocwlowerid{fold}(f_1,f_2,t_1), - \ocwlowerid{fold}(f_1,f_2,t_2)) - \end{aligned} -\end{equation} -and -\begin{equation} - \begin{aligned} - \ocwlowerid{fan}:\;& (\nu\times\lambda\to\{\alpha\}) - \times(\nu\times\alpha\times\alpha\to\{\alpha\}) - \times(\nu,\lambda)T \to\{\alpha\} \\ - & (f_1,f_2,l\in L) \mapsto f_1(l) \\ - & (f_1,f_2,(n,t_1,t_2)) \mapsto - f_2(n, \ocwlowerid{fold}(f_1,f_2,t_1) - \otimes\ocwlowerid{fold}(f_1,f_2,t_2)) - \end{aligned} -\end{equation} -where the tensor product notation means that~$f_2$ is applied to all -combinations of list members in the argument: -\begin{equation} - \phi(\{x\}\otimes \{y\}) - = \left\{ \phi(x,y) | x\in\{x\} \land y\in\{y\} \right\} -\end{equation} -But note that due to the recursive nature of trees, \ocwlowerid{fan} is -\emph{not} a morphism from $T(N,L)$ to $T(N\otimes N,L)$.\par -If we identify singleton sets with their members, \ocwlowerid{fold} could be -viewed as a special case of \ocwlowerid{fan}, but that is probably more -confusing than helpful. Also, using the special -case~$\alpha=(\nu',\lambda')T$, the homomorphism \ocwlowerid{map} can be -expressed in terms of \ocwlowerid{fold} and the constructors -\begin{equation} - \begin{aligned} - \ocwlowerid{map}:\;& (\nu\to\nu')\times(\lambda\to\lambda') - \times(\nu,\lambda)T \to(\nu',\lambda')T \\ - &(f,g,t) \mapsto - \ocwlowerid{fold} (\ocwlowerid{leaf}\circ (f\times g), - \ocwlowerid{node}\circ (f\times\ocwlowerid{id} - \times\ocwlowerid{id}), t) - \end{aligned} -\end{equation} -\ocwlowerid{fold} is much more versatile than \ocwlowerid{map}, because it can be used -with constructors for other tree representations to translate among -different representations. The target type can also be a mathematical -expression. This is used extensively below for evaluating Feynman -diagrams.\par -Using \ocwlowerid{fan} with~$\alpha=(\nu',\lambda')T$ can be used to construct -a multitude of homomorphic trees. In fact, below it will be used -extensively to construct all Feynman -diagrams~$\{(\nu,\{p_1,\ldots,p_n\})T\}$ of a given -topology~$t\in (\emptyset,\{1,\ldots,n\})T$. -\begin{dubious} - The physicist in me guesses that there is another morphism of trees - that is related to \ocwlowerid{fan} like a Lie-algebra is related to the - it's Lie-group. I have not been able to pin it down, but I guess that it - is a generalization of \ocwlowerid{grow} below. -\end{dubious} -\module{tree} - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\chapter{Consistency Checks} -\label{sec:count} -\application{count} - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\chapter{Complex Numbers} -\label{sec:complex} -\module{complex} - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\chapter{Algebra} -\label{sec:algebra} -\module{algebra} - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\chapter{Simple Linear Algebra} -\label{sec:linalg} -\module{linalg} -%application{test_linalg} - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\chapter{Talk To The WHiZard \ldots} -\label{sec:whizard_tool} -Talk to~\cite{Kilian:WHIZARD}. -\application{whizard_tool} - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\chapter{Widget Library and Class Hierarchy for O'Giga} -\label{sec:thogtk} -{\itshape NB: The code in this chapter \emph{must} be compiled with -\verb+-labels+, since \verb+lablgtk+ doesn't appear to work in classic mode.} -\begin{dubious} - Keep in mind that \texttt{ocamlweb} doesn't work properly with - O'Caml~3 yet. The colons in label declarations are typeset with - erroneous white space. -\end{dubious} - -\section{Architecture} -In \texttt{lablgtk}, O'Caml objects are typically constructed in -parallel to constructors for \texttt{GTK+} widgets. The objects -provide inheritance and all that, while the constructors implement the -semantics. - -\subsection{Inheritance vs.~Aggregation} -We have two mechanisms for creating new widgets: inheritance and -aggregation. Inheritance makes it easy to extend a given widget with -new methods or to combine orthogonal widgets (\emph{multiple -inheritance}). Aggregation is more suitable for combining -non-orthogonal widgets (e.\,g.~multiple instances of the same widget). - -The problem with inheritance in \texttt{lablgtk} is, that it is a -\emph{bad} idea to implement the semantics in the objects. In a -multi-level inheritance hierarchy, O'Caml can evaluate class functions -more than once. Since functions accessing \texttt{GTK+} change the -state of \texttt{GTK+}, we could accidentally violate invariants. -Therefore inheritance forces us to use the two-tiered approach of -\texttt{lablgtk} ourselves. It is not really complicated, but tedious -and it appears to be a good idea to use aggregation whenever in doubt. - -Nevertheless, there are examples (like -\ocwupperid{ThoGButton.mutable\_button} below, where just one new -method is added), that cry out for inheritance for the benefit of the -application developer. - -\module{thoGWindow} -\module{thoGButton} -\module{thoGMenu} -\module{thoGDraw} - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\chapter{O'Mega Virtual Machine} -\label{sec:ovm} -\module{oVM} - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\chapter{\texttt{Fortran} Libraries} -\label{sec:fortran} -\input{omegalib} - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\begin{raggedright} - \ifpdf - \chapter{Index} - \let\origtwocolumn\twocolumn - \def\twocolumn[#1]{\origtwocolumn}% - This index has been generated automatically and might not be - 100\%ly accurate. In particular, hyperlinks have been observed to - by of by one page. - \fi - \input{index.tex} -\end{raggedright} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\end{empfile} -\end{fmffile} -\end{document} -\endinput -Local Variables: -mode:latex -indent-tabs-mode:nil -page-delimiter:"^%%%%%.*\n" -End: Index: branches/ohl/omega-development/completed/whizard2/src/f90_Phi4.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/f90_Phi4.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/f90_Phi4.ml (revision 8703) @@ -1,32 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -module O = Omega.Make(Fusion.Mixed23)(Targets.Fortran)(Models.Phi4) -let _ = O.main () - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/targets.mli =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/targets.mli (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/targets.mli (revision 8703) @@ -1,44 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -module Dummy : Target.Maker - -(* \thocwmodulesection{Supported Targets} *) -module Fortran : Target.Maker -module Fortran_Majorana : Target.Maker - -(* \thocwmodulesection{Potential Targets} *) -module VM : Target.Maker -module Fortran77 : Target.Maker -module C : Target.Maker -module Cpp : Target.Maker -module Java : Target.Maker -module Ocaml : Target.Maker -module LaTeX : Target.Maker - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/f90_SM3_clones.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/f90_SM3_clones.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/f90_SM3_clones.ml (revision 8703) @@ -1,33 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -module O = Omega.Make(Fusion.Binary)(Targets.Fortran)(Models.SM3_clones) - -let _ = O.main () - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/phasespace.mli =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/phasespace.mli (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/phasespace.mli (revision 8703) @@ -1,63 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -module type T = - sig - type momentum - - type 'a t - type 'a decay - -(* Sort individual decays and complete phasespaces in a canonical order - to determine topological equivalence classes. *) - val sort : ('a -> 'a -> int) -> 'a t -> 'a t - val sort_decay : ('a -> 'a -> int) -> 'a decay -> 'a decay - -(* Functionals: *) - val map : ('a -> 'b) -> 'a t -> 'b t - val map_decay : ('a -> 'b) -> 'a decay -> 'b decay - - val eval : ('a -> 'b) -> ('a -> 'b) -> ('a -> 'b -> 'b -> 'b) -> 'a t -> 'b t - val eval_decay : ('a -> 'b) -> ('a -> 'b -> 'b -> 'b) -> 'a decay -> 'b decay - -(* [of_momenta f1 f2 plist] constructs the phasespace parameterization - for a process $f_1 f_2 \to X$ with flavor decoration from pairs - of outgoing momenta and flavors [plist] and initial flavors~$f1$ - and~$f2$ *) - val of_momenta : 'a -> 'a -> (momentum * 'a) list -> (momentum * 'a) t - val decay_of_momenta : (momentum * 'a) list -> (momentum * 'a) decay - - exception Duplicate of momentum - exception Unordered of momentum - exception Incomplete of momentum - - end - -module Make (M : Momentum.T) : T with type momentum = M.t - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/modules.attrib =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/modules.attrib (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/modules.attrib (revision 8703) @@ -1,67 +0,0 @@ -# $Id: modules.attrib,v 1.11 2003/01/10 19:48:21 ohl Exp $ - -### draw bolder -# 1a\ -# edge [style=bold]; \ -# node [style=bold]; - -# Library modules as boxes -1a\ -node [shape=box]; - -# Applications as ellipses -1a\ -"F90_SM" [shape=ellipse]; \ -"F90_SM" -> "Models":sm; \ -"F90_SM" -> "Targets":f90; \ -"F90_SM" -> "Omega"; \ -"..." [shape=ellipse]; \ -"..." -> "Models"; \ -"..." -> "Targets"; \ -"..." -> "Omega"; - -# Signatures as diamonds -1a\ -"Coupling" [shape=diamond]; \ -"Model" [shape=diamond]; \ -"Target" [shape=diamond]; - -1a\ -"Targets" [shape=record,label="{{Fortran77|Fortran|Helas}|{C|C++|Java}|{O'Caml|
Form|LaTeX|...}|Targets}"]; \ -"Models" [shape=record,label="{{QED|QCD|SM}|{MSSM|User def.}|Models}"]; - -/F90/s/"Targets"/"Targets":f90/ -/Helas/s/"Targets"/"Targets":helas/ - -/QCD/s/"Models"/Models:qcd/ -/QED/s/"Models"/Models:qed/ -/SM/s/"Models"/Models:sm/ - -# Hide redundant applications -/_/d - -# Hide regression tests -/Count/d - -# Hide experimental models -/Models2/d - -# Hide trivial dependencies/libraries -/RCS/d -/Models.*ThoList/d -# /ThoList/d -# /Options/d -# /Tree/d -# /Pmap/d - -# ## Abbreviated drawings: -# /Ogiga/d -# /Whizard/d -# /OVM/d -# /ThoList/d -# -# 1a\ -# "F90_MSSM" [shape=ellipse]; \ -# "F90_MSSM" -> "Models":mssm; \ -# "F90_MSSM" -> "Targets":f90; \ -# "F90_MSSM" -> "Omega"; \ Index: branches/ohl/omega-development/completed/whizard2/src/.depend_defun =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/.depend_defun (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/.depend_defun (revision 8703) @@ -1,74 +0,0 @@ -depend/f90_Phi4.cmd:depend/fusion.cmd depend/models.cmd depend/omega.cmd depend/targets.cmd -depend/f90_SMh.cmd:depend/fusion.cmd depend/models.cmd depend/omega.cmd depend/targets.cmd -depend/count.cmd:depend/combinatorics.cmd depend/thoList.cmd depend/topology.cmd -depend/f90_2HDM.cmd:depend/omega.cmd depend/options.cmd depend/rCS.cmd depend/targets.cmd depend/thoList.cmd depend/color.cmd depend/coupling.cmd depend/fusion.cmd depend/model.cmd depend/models.cmd -depend/color.cmd:depend/pmap.cmd depend/product.cmd depend/tree.cmd depend/trie.cmd -depend/linalg.cmd:depend/ -depend/fusion.cmd:depend/tuple.cmd depend/momentum.cmd depend/product.cmd depend/rCS.cmd depend/thoList.cmd depend/topology.cmd depend/tree.cmd depend/color.cmd depend/combinatorics.cmd depend/coupling.cmd depend/dAG.cmd depend/model.cmd -depend/phasespace.cmd:depend/momentum.cmd -depend/f90_SM_clones.cmd:depend/fusion.cmd depend/models.cmd depend/omega.cmd depend/targets.cmd -depend/f90_SM4_ac.cmd:depend/fusion.cmd depend/models.cmd depend/omega.cmd depend/targets.cmd -depend/thoList.cmd:depend/ -depend/f90_Phi4h.cmd:depend/fusion.cmd depend/models.cmd depend/omega.cmd depend/targets.cmd -depend/f90Maj_SM.cmd:depend/fusion.cmd depend/models.cmd depend/omega.cmd depend/targets.cmd -depend/comphep.cmd:depend/model.cmd depend/thoList.cmd depend/comphep_syntax.cmd depend/coupling.cmd depend/models.cmd depend/options.cmd depend/rCS.cmd depend/color.cmd depend/comphep_lexer.cmd depend/comphep_parser.cmd -depend/f90_Comphep.cmd:depend/comphep.cmd depend/fusion.cmd depend/omega.cmd depend/targets.cmd -depend/omega_lexer.cmd:depend/omega_parser.cmd -depend/ogiga.cmd:depend/thoGMenu.cmd depend/thoGWindow.cmd depend/thoList.cmd depend/momentum.cmd depend/omega.cmd depend/rCS.cmd depend/targets.cmd depend/thoGButton.cmd depend/thoGDraw.cmd depend/color.cmd depend/coupling.cmd depend/fusion.cmd depend/model.cmd depend/models.cmd -depend/f90_SM4.cmd:depend/fusion.cmd depend/models.cmd depend/omega.cmd depend/targets.cmd -depend/rCS.cmd:depend/ -depend/models.cmd:depend/color.cmd depend/coupling.cmd depend/model.cmd depend/options.cmd depend/rCS.cmd depend/thoList.cmd -depend/helas_QED.cmd:depend/fusion.cmd depend/models.cmd depend/omega.cmd depend/targets.cmd -depend/product.cmd:depend/thoList.cmd -depend/models2.cmd:depend/model.cmd depend/rCS.cmd depend/thoList.cmd depend/color.cmd depend/coupling.cmd depend/models.cmd depend/options.cmd depend/product.cmd -depend/f90_SM_ac.cmd:depend/fusion.cmd depend/models.cmd depend/omega.cmd depend/targets.cmd -depend/test_linalg.cmd:depend/linalg.cmd -depend/thoArray.cmd:depend/pmap.cmd -depend/thoGWindow.cmd:depend/ -depend/target.cmd:depend/fusion.cmd depend/model.cmd depend/options.cmd depend/rCS.cmd -depend/f90_Phi3h.cmd:depend/fusion.cmd depend/models.cmd depend/omega.cmd depend/targets.cmd -depend/helas_SM.cmd:depend/fusion.cmd depend/models.cmd depend/omega.cmd depend/targets.cmd -depend/f90Maj_SM4.cmd:depend/fusion.cmd depend/models.cmd depend/omega.cmd depend/targets.cmd -depend/model_parser.cmd:depend/model_syntax.cmd -depend/combinatorics.cmd:depend/product.cmd depend/thoList.cmd -depend/thoGMenu.cmd:depend/thoGButton.cmd -depend/model.cmd:depend/color.cmd depend/coupling.cmd depend/options.cmd depend/rCS.cmd -depend/comphep_parser.cmd:depend/comphep_syntax.cmd -depend/f90_MSSM.cmd:depend/fusion.cmd depend/models2.cmd depend/omega.cmd depend/targets.cmd -depend/f90_QCD.cmd:depend/fusion.cmd depend/models.cmd depend/omega.cmd depend/targets.cmd -depend/momentum.cmd:depend/rCS.cmd depend/thoList.cmd -depend/thoGDraw.cmd:depend/color.cmd depend/thoGWindow.cmd depend/tree.cmd -depend/omega_syntax.cmd:depend/ -depend/topology.cmd:depend/combinatorics.cmd depend/partition.cmd depend/rCS.cmd depend/thoList.cmd depend/tuple.cmd -depend/pmap.cmd:depend/ -depend/lapack.cmd:depend/ -depend/ovm_SM4.cmd:depend/fusion.cmd depend/models.cmd depend/omega.cmd depend/targets.cmd -depend/whizard_tool.cmd:depend/whizard.cmd -depend/f90_SM_g.cmd:depend/fusion.cmd depend/models.cmd depend/omega.cmd depend/targets.cmd -depend/f90_Phi3.cmd:depend/fusion.cmd depend/models.cmd depend/omega.cmd depend/targets.cmd -depend/f90_SM.cmd:depend/fusion.cmd depend/models.cmd depend/omega.cmd depend/targets.cmd -depend/omega.cmd:depend/whizard.cmd depend/options.cmd depend/rCS.cmd depend/target.cmd depend/thoArray.cmd depend/thoList.cmd depend/tree.cmd depend/momentum.cmd depend/omega_lexer.cmd depend/omega_parser.cmd depend/omega_syntax.cmd depend/color.cmd depend/coupling.cmd depend/fusion.cmd depend/lapack.cmd depend/model.cmd -depend/complex.cmd:depend/ -depend/tree.cmd:depend/linalg.cmd depend/pmap.cmd depend/product.cmd depend/thoList.cmd -depend/model_lexer.cmd:depend/model_parser.cmd -depend/dAG.cmd:depend/product.cmd depend/rCS.cmd depend/tree.cmd depend/tuple.cmd -depend/tuple.cmd:depend/combinatorics.cmd depend/partition.cmd depend/product.cmd depend/rCS.cmd depend/thoList.cmd -depend/helas_QCD.cmd:depend/fusion.cmd depend/models.cmd depend/omega.cmd depend/targets.cmd -depend/f90_SM4_k_matrix.cmd:depend/fusion.cmd depend/models.cmd depend/omega.cmd depend/targets.cmd -depend/f90_MSSM_g.cmd:depend/fusion.cmd depend/models2.cmd depend/omega.cmd depend/targets.cmd -depend/trie.cmd:depend/pmap.cmd -depend/targets.cmd:depend/target.cmd depend/rCS.cmd depend/thoList.cmd depend/trie.cmd depend/coupling.cmd depend/fusion.cmd depend/model.cmd depend/options.cmd depend/product.cmd -depend/f90_SM_Rxi.cmd:depend/fusion.cmd depend/models.cmd depend/omega.cmd depend/targets.cmd -depend/thoGButton.cmd:depend/ -depend/model_file.cmd:depend/model_syntax.cmd depend/model_lexer.cmd depend/model_parser.cmd -depend/omega_parser.cmd:depend/omega_syntax.cmd -depend/whizard.cmd:depend/thoList.cmd depend/fusion.cmd depend/model.cmd depend/momentum.cmd depend/product.cmd depend/rCS.cmd -depend/f90_SM4h.cmd:depend/fusion.cmd depend/models.cmd depend/omega.cmd depend/targets.cmd -depend/model_syntax.cmd:depend/ -depend/comphep_syntax.cmd:depend/ -depend/comphep_lexer.cmd:depend/comphep_parser.cmd -depend/f90_QED.cmd:depend/fusion.cmd depend/models.cmd depend/omega.cmd depend/targets.cmd -depend/partition.cmd:depend/rCS.cmd -depend/oVM.cmd:depend/complex.cmd depend/fusion.cmd depend/rCS.cmd -depend/options.cmd:depend/ -depend/f90_Gudi_etal.cmd:depend/omega.cmd depend/options.cmd depend/rCS.cmd depend/targets.cmd depend/thoList.cmd depend/color.cmd depend/coupling.cmd depend/fusion.cmd depend/model.cmd depend/models.cmd Index: branches/ohl/omega-development/completed/whizard2/src/tuple.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/tuple.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/tuple.ml (revision 8703) @@ -1,490 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -let rcs_file = RCS.parse "Tuple" ["Tuples of fixed and indefinite arity"] - { RCS.revision = "$Revision$"; - RCS.date = "$Date$"; - RCS.author = "$Author$"; - RCS.source - = "$URL$" } - -module type Mono = - sig - type 'a t - val arity : 'a t -> int - val max_arity : int - val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int - val for_all : ('a -> bool) -> 'a t -> bool - val map : ('a -> 'b) -> 'a t -> 'b t - val iter : ('a -> unit) -> 'a t -> unit - val fold_left : ('a -> 'b -> 'a) -> 'a -> 'b t -> 'a - val fold_right : ('a -> 'b -> 'b) -> 'a t -> 'b -> 'b - val fold_left_internal : ('a -> 'a -> 'a) -> 'a t -> 'a - val fold_right_internal : ('a -> 'a -> 'a) -> 'a t -> 'a - val map2 : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t - val split : ('a * 'b) t -> 'a t * 'b t - val product : 'a list t -> 'a t list - val product_fold : ('a t -> 'b -> 'b) -> 'a list t -> 'b -> 'b - val power : 'a list -> 'a t list - val power_fold : ('a t -> 'b -> 'b) -> 'a list -> 'b -> 'b - type 'a graded = 'a list array - val graded_sym_power : int -> 'a graded -> 'a t list - val graded_sym_power_fold : int -> ('a t -> 'b -> 'b) -> 'a graded -> - 'b -> 'b - val to_list : 'a t -> 'a list - val of2_kludge : 'a -> 'a -> 'a t - val rcs : RCS.t - end - -module type Poly = - sig - include Mono - exception Mismatched_arity - exception No_termination - end - -(* \thocwmodulesection{Typesafe Combinatorics} *) - -(* Wrap the combinatorical functions with varying arities into typesafe functions - with fixed arities. We could provide specialized implementations, but since - we \emph{know} that [Impossible] is \emph{never} raised, the present approach - is just as good (except for a tiny inefficiency). *) - -exception Impossible of string -let impossible name = raise (Impossible name) - -let choose2 set = - List.map (function [x; y] -> (x, y) | _ -> impossible "choose2") - (Combinatorics.choose 2 set) - -let choose3 set = - List.map (function [x; y; z] -> (x, y, z) | _ -> impossible "choose3") - (Combinatorics.choose 3 set) - -(* \thocwmodulesection{Pairs} *) - -module type Binary = - sig - include Poly (* should become [Mono]! *) - val of2 : 'a -> 'a -> 'a t - end - -module Binary = - struct - let rcs = RCS.rename rcs_file "Tuple.Binary" ["Pairs"] - - type 'a t = 'a * 'a - - let arity _ = 2 - let max_arity = 2 - - let of2 x y = (x, y) - - let compare cmp (x1, y1) (x2, y2) = - let cx = cmp x1 x2 in - if cx <> 0 then - cx - else - cmp y1 y2 - - let for_all p (x, y) = p x && p y - - let map f (x, y) = (f x, f y) - let iter f (x, y) = f x; f y - let fold_left f init (x, y) = f (f init x) y - let fold_right f (x, y) init = f x (f y init) - let fold_left_internal f (x, y) = f x y - let fold_right_internal f (x, y) = f x y - - exception Mismatched_arity - let map2 f (x1, y1) (x2, y2) = (f x1 x2, f y1 y2) - - let split ((x1, x2), (y1, y2)) = ((x1, y1), (x2, y2)) - - let product (lx, ly) = - Product.list2 (fun x y -> (x, y)) lx ly - let product_fold f (lx, ly) init = - Product.fold2 (fun x y -> f (x, y)) lx ly init - - let power l = product (l, l) - let power_fold f l = product_fold f (l, l) - -(* In the special case of binary fusions, the implementation is very concise. *) - type 'a graded = 'a list array - - let fuse2 f set (i, j) acc = - if i = j then - List.fold_right (fun (x, y) -> f x y) (choose2 set.(pred i)) acc - else - Product.fold2 f set.(pred i) set.(pred j) acc - - let graded_sym_power_fold rank f set acc = - let max_rank = Array.length set in - List.fold_right (fuse2 (fun x y -> f (of2 x y)) set) - (Partition.pairs rank 1 max_rank) acc - - let graded_sym_power rank set = - graded_sym_power_fold rank (fun pair acc -> pair :: acc) set [] - - let to_list (x, y) = [x; y] - let of2_kludge = of2 - - exception No_termination - end - -(* \thocwmodulesection{Triples} *) - -module type Ternary = - sig - include Mono - val of3 : 'a -> 'a -> 'a -> 'a t - end - -module Ternary = - struct - let rcs = RCS.rename rcs_file "Tuple.Ternary" ["Triples"] - - type 'a t = 'a * 'a * 'a - - let arity _ = 3 - let max_arity = 3 - - let of3 x y z = (x, y, z) - - let compare cmp (x1, y1, z1) (x2, y2, z2) = - let cx = cmp x1 x2 in - if cx <> 0 then - cx - else - let cy = cmp y1 y2 in - if cy <> 0 then - cy - else - cmp z1 z2 - - let for_all p (x, y, z) = p x && p y && p z - - let map f (x, y, z) = (f x, f y, f z) - let iter f (x, y, z) = f x; f y; f z - let fold_left f init (x, y, z) = f (f (f init x) y) z - let fold_right f (x, y, z) init = f x (f y (f z init)) - let fold_left_internal f (x, y, z) = f (f x y) z - let fold_right_internal f (x, y, z) = f x (f y z) - - exception Mismatched_arity - let map2 f (x1, y1, z1) (x2, y2, z2) = (f x1 x2, f y1 y2, f z1 z2) - - let split ((x1, x2), (y1, y2), (z1, z2)) = ((x1, y1, z1), (x2, y2, z2)) - - let product (lx,ly,lz) = - Product.list3 (fun x y z -> (x, y, z)) lx ly lz - let product_fold f (lx, ly, lz) init = - Product.fold3 (fun x y z -> f (x, y, z)) lx ly lz init - - let power l = product (l, l, l) - let power_fold f l = product_fold f (l, l, l) - - type 'a graded = 'a list array - - let fuse3 f set (i, j, k) acc = - if i = j then begin - if j = k then - List.fold_right (fun (x, y, z) -> f x y z) (choose3 set.(pred i)) acc - else - Product.fold2 (fun (x, y) z -> f x y z) - (choose2 set.(pred i)) set.(pred k) acc - end else begin - if j = k then - Product.fold2 (fun x (y, z) -> f x y z) - set.(pred i) (choose2 set.(pred j)) acc - else - Product.fold3 (fun x y z -> f x y z) - set.(pred i) set.(pred j) set.(pred k) acc - end - - let graded_sym_power_fold rank f set acc = - let max_rank = Array.length set in - List.fold_right (fuse3 (fun x y z -> f (of3 x y z)) set) - (Partition.triples rank 1 max_rank) acc - - let graded_sym_power rank set = - graded_sym_power_fold rank (fun pair acc -> pair :: acc) set [] - - let of2_kludge _ = failwith "Tuple.Ternary.of2_kludge" - - let to_list (x, y, z) = [x; y; z] - - end - -(* \thocwmodulesection{Pairs and Triples} *) - -type 'a pair_or_triple = T2 of 'a * 'a | T3 of 'a * 'a *'a - -module type Mixed23 = - sig - include Poly - val of2 : 'a -> 'a -> 'a t - val of3 : 'a -> 'a -> 'a -> 'a t - end - -module Mixed23 = - struct - let rcs = RCS.rename rcs_file "Tuple.Mixed23" - ["Mixed pairs and triples"] - - type 'a t = 'a pair_or_triple - - let arity = function - | T2 _ -> 2 - | T3 _ -> 3 - let max_arity = 3 - - let of2 x y = T2 (x, y) - let of3 x y z = T3 (x, y, z) - - let compare cmp m1 m2 = - match m1, m2 with - | T2 _, T3 _ -> -1 - | T3 _, T2 _ -> 1 - | T2 (x1, y1), T2 (x2, y2) -> - let cx = cmp x1 x2 in - if cx <> 0 then - cx - else - cmp y1 y2 - | T3 (x1, y1, z1), T3 (x2, y2, z2) -> - let cx = cmp x1 x2 in - if cx <> 0 then - cx - else - let cy = cmp y1 y2 in - if cy <> 0 then - cy - else - cmp z1 z2 - - let for_all p = function - | T2 (x, y) -> p x && p y - | T3 (x, y, z) -> p x && p y && p z - - let map f = function - | T2 (x, y) -> T2 (f x, f y) - | T3 (x, y, z) -> T3 (f x, f y, f z) - - let iter f = function - | T2 (x, y) -> f x; f y - | T3 (x, y, z) -> f x; f y; f z - - let fold_left f init = function - | T2 (x, y) -> f (f init x) y - | T3 (x, y, z) -> f (f (f init x) y) z - - let fold_right f m init = - match m with - | T2 (x, y) -> f x (f y init) - | T3 (x, y, z) -> f x (f y (f z init)) - - let fold_left_internal f m = - match m with - | T2 (x, y) -> f x y - | T3 (x, y, z) -> f (f x y) z - - let fold_right_internal f m = - match m with - | T2 (x, y) -> f x y - | T3 (x, y, z) -> f x (f y z) - - exception Mismatched_arity - let map2 f m1 m2 = - match m1, m2 with - | T2 (x1, y1), T2 (x2, y2) -> T2 (f x1 x2, f y1 y2) - | T3 (x1, y1, z1), T3 (x2, y2, z2) -> T3 (f x1 x2, f y1 y2, f z1 z2) - | T2 _, T3 _ | T3 _, T2 _ -> raise Mismatched_arity - - let split = function - | T2 ((x1, x2), (y1, y2)) -> (T2 (x1, y1), T2 (x2, y2)) - | T3 ((x1, x2), (y1, y2), (z1, z2)) -> (T3 (x1, y1, z1), T3 (x2, y2, z2)) - - let product = function - | T2 (lx, ly) -> Product.list2 (fun x y -> T2 (x, y)) lx ly - | T3 (lx, ly, lz) -> Product.list3 (fun x y z -> T3 (x, y, z)) lx ly lz - let product_fold f m init = - match m with - | T2 (lx, ly) -> Product.fold2 (fun x y -> f (T2 (x, y))) lx ly init - | T3 (lx, ly, lz) -> - Product.fold3 (fun x y z -> f (T3 (x, y, z))) lx ly lz init - - exception No_termination - - let power_fold f l init = - product_fold f (T2 (l, l)) (product_fold f (T3 (l, l, l)) init) - let power l = - power_fold (fun m acc -> m :: acc) l [] - - type 'a graded = 'a list array - - let graded_sym_power_fold rank f set acc = - let max_rank = Array.length set in - List.fold_right (Binary.fuse2 (fun x y -> f (of2 x y)) set) - (Partition.pairs rank 1 max_rank) - (List.fold_right (Ternary.fuse3 (fun x y z -> f (of3 x y z)) set) - (Partition.triples rank 1 max_rank) acc) - - let graded_sym_power rank set = - graded_sym_power_fold rank (fun pair acc -> pair :: acc) set [] - - let to_list = function - | T2 (x, y) -> [x; y] - | T3 (x, y, z) -> [x; y; z] - - let of2_kludge = of2 - - end - -(* \thocwmodulesection{\ldots{} and All The Rest} *) - -module type Nary = - sig - include Poly - val of2 : 'a -> 'a -> 'a t - val of3 : 'a -> 'a -> 'a -> 'a t - val of_list : 'a list -> 'a t - end - -module Nary (A : sig val max_arity : int end) = - struct - let rcs = RCS.rename rcs_file "Tuple.Nary" - ["Tupels of indefinite arity"] - - type 'a t = 'a * 'a list - - let arity (_, y) = succ (List.length y) - let max_arity = A.max_arity - - let of2 x y = (x, [y]) - let of3 x y z = (x, [y; z]) - - let of_list = function - | x :: y -> (x, y) - | [] -> invalid_arg "Tuple.Nary.of_list: empty" - - let compare cmp (x1, y1) (x2, y2) = - let c = cmp x1 x2 in - if c <> 0 then - c - else - ThoList.compare ~cmp y1 y2 - - let for_all p (x, y) = p x && List.for_all p y - - let map f (x, y) = (f x, List.map f y) - let iter f (x, y) = f x; List.iter f y - let fold_left f init (x, y) = List.fold_left f (f init x) y - let fold_right f (x, y) init = f x (List.fold_right f y init) - let fold_left_internal f (x, y) = List.fold_left f x y - let fold_right_internal f (x, y) = - match List.rev y with - | [] -> x - | y0 :: y_sans_y0 -> - f x (List.fold_right f (List.rev y_sans_y0) y0) - - exception Mismatched_arity - let map2 f (x1, y1) (x2, y2) = - try (f x1 x2, List.map2 f y1 y2) with - | Invalid_argument _ -> raise Mismatched_arity - - let split ((x1, x2), y12) = - let y1, y2 = List.split y12 in - ((x1, y1), (x2, y2)) - - let product (xl, yl) = - Product.list (function - | x :: y -> (x, y) - | [] -> failwith "Tuple.Nary.product") (xl :: yl) - let product_fold f (xl, yl) init = - Product.fold (function - | x :: y -> f (x, y) - | [] -> failwith "Tuple.Nary.product_fold") (xl :: yl) init - - let bounded_power_fold f l init = - List.fold_right (fun n -> product_fold f (l, ThoList.clone (pred n) l)) - (ThoList.range 2 A.max_arity) init - let bounded_power l = - bounded_power_fold (fun t acc -> t :: acc) l [] - - exception No_termination - let unbounded_power_fold f l init = raise No_termination - let unbounded_power l = raise No_termination - - let power_fold, power = - if A.max_arity > 0 then - (bounded_power_fold, bounded_power) - else - (unbounded_power_fold, unbounded_power) - - type 'a graded = 'a list array - - let fuse_n f set partition acc = - let choose (n, r) = - Printf.printf "chose: n=%d r=%d len=%d\n" - n r (List.length set.(pred r)); - Combinatorics.choose n set.(pred r) in - Product.fold (fun wfs -> f (List.concat wfs)) - (List.map choose (ThoList.classify partition)) acc - - let fuse_n f set partition acc = - let choose (n, r) = Combinatorics.choose n set.(pred r) in - Product.fold (fun wfs -> f (List.concat wfs)) - (List.map choose (ThoList.classify partition)) acc - -(* \begin{dubious} - [graded_sym_power_fold] is well defined for unbounded arities as well: derive - a reasonable replacement from [set]. The length of the flattened [set] is - an upper limit, of course, but too pessimistic in most cases. - \end{dubious} *) - - let graded_sym_power_fold rank f set acc = - let max_rank = Array.length set in - let degrees = ThoList.range 2 max_arity in - let partitions = - ThoList.flatmap - (fun deg -> Partition.tuples deg rank 1 max_rank) degrees in - List.fold_right (fuse_n (fun wfs -> f (of_list wfs)) set) partitions acc - - let graded_sym_power rank set = - graded_sym_power_fold rank (fun pair acc -> pair :: acc) set [] - - let to_list (x, y) = x :: y - let of2_kludge = of2 - - end - -module type Bound = sig val max_arity : int end -module Unbounded_Nary = Nary (struct let max_arity = -1 end) - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/f90_Template.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/f90_Template.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/f90_Template.ml (revision 8703) @@ -1,33 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -module O = Omega.Make(Fusion.Mixed23)(Targets.Fortran_Majorana) - (Models4.Template(Models4.BSM_bsm)) -let _ = O.main () - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/cascade_syntax.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/cascade_syntax.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/cascade_syntax.ml (revision 8703) @@ -1,106 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -(* Concerning the Gaussian propagators, we admit the following: In - principle, they would allow for flavor sums like the off-shell - lines, but for all practical purposes they are used only for - determining the significance of a specified intermediate state. - So we select them in the same manner as on-shell states. *) - -type ('flavor, 'p) t = - | True - | False - | On_shell of 'flavor list * 'p - | On_shell_not of 'flavor list * 'p - | Off_shell of 'flavor list * 'p - | Off_shell_not of 'flavor list * 'p - | Gauss of 'flavor list * 'p - | Gauss_not of 'flavor list * 'p - | Any_flavor of 'p - | Or of ('flavor, 'p) t list - | And of ('flavor, 'p) t list - -let mk_true () = True -let mk_false () = False -let mk_on_shell f p = On_shell (f, p) -let mk_on_shell_not f p = On_shell_not (f, p) -let mk_off_shell f p = Off_shell (f, p) -let mk_off_shell_not f p = Off_shell_not (f, p) -let mk_gauss f p = Gauss (f, p) -let mk_gauss_not f p = Gauss_not (f, p) -let mk_any_flavor p = Any_flavor p - -let mk_or c1 c2 = - match c1, c2 with - | _, True | True, _ -> True - | c, False | False, c -> c - | Or cs, Or cs' -> Or (cs @ cs') - | Or cs, c | c, Or cs -> Or (c::cs) - | c, c' -> Or [c; c'] - -let mk_and c1 c2 = - match c1, c2 with - | c, True | True, c -> c - | c, False | False, c -> False - | And cs, And cs' -> And (cs @ cs') - | And cs, c | c, And cs -> And (c::cs) - | c, c' -> And [c; c'] - -let to_string flavor_to_string momentum_to_string cascades = - let rec to_string' = function - | True -> "true" - | False -> "false" - | On_shell (fs, p) -> - momentum_to_string p ^ " = " ^ (String.concat ":" (List.map flavor_to_string fs)) - | On_shell_not (fs, p) -> - momentum_to_string p ^ " = !" ^ (String.concat ":" (List.map flavor_to_string fs)) - | Off_shell (fs, p) -> - momentum_to_string p ^ " ~ " ^ - (String.concat ":" (List.map flavor_to_string fs)) - | Off_shell_not (fs, p) -> - momentum_to_string p ^ " ~ !" ^ - (String.concat ":" (List.map flavor_to_string fs)) - | Gauss (fs, p) -> - momentum_to_string p ^ " # " ^ (String.concat ":" (List.map flavor_to_string fs)) - | Gauss_not (fs, p) -> - momentum_to_string p ^ " # !" ^ (String.concat ":" (List.map flavor_to_string fs)) - | Any_flavor p -> - momentum_to_string p ^ " ~ ?" - | Or cs -> - String.concat " || " (List.map (fun c -> "(" ^ to_string' c ^ ")") cs) - | And cs -> - String.concat " && " (List.map (fun c -> "(" ^ to_string' c ^ ")") cs) in - to_string' cascades - -let int_list_to_string p = - String.concat "+" (List.map string_of_int (Sort.list (<) p)) - -exception Syntax_Error of string * int * int - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) - Index: branches/ohl/omega-development/completed/whizard2/src/combinatorics.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/combinatorics.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/combinatorics.ml (revision 8703) @@ -1,403 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -type 'a seq = 'a list - -(* \thocwmodulesection{Simple Combinatorial Functions} *) - -let rec factorial' fn n = - if n < 1 then - fn - else - factorial' (n * fn) (pred n) - -let factorial n = - if 0 <= n && n <= 12 then - factorial' 1 n - else - invalid_arg "Combinatorics.factorial" - -(* \begin{multline} - \binom{n}{k} = \frac{n!}{k!(n-k)!} - = \frac{n(n-1)\cdots(n-k+1)}{k(k-1)\cdots1} \\ - = \frac{n(n-1)\cdots(k+1)}{(n-k)(n-k-1)\cdots1} = - \begin{cases} - B_{n-k+1}(n,k) & \text{for $k \le \lfloor n/2 \rfloor$} \\ - B_{k+1}(n,n-k) & \text{for $k > \lfloor n/2 \rfloor$} - \end{cases} - \end{multline} - where - \begin{equation} - B_{n_{\min}}(n,k) = - \begin{cases} - n B_{n_{\min}}(n-1,k) & \text{for $n \ge n_{\min}$} \\ - \frac{1}{k} B_{n_{\min}}(n,k-1) & \text{for $k > 1$} \\ - 1 & \text{otherwise} - \end{cases} - \end{equation} *) - -let rec binomial' n_min n k acc = - if n >= n_min then - binomial' n_min (pred n) k (n * acc) - else if k > 1 then - binomial' n_min n (pred k) (acc / k) - else - acc - -let binomial n k = - if k > n / 2 then - binomial' (k + 1) n (n - k) 1 - else - binomial' (n - k + 1) n k 1 - -(* Overflows later, but takes much more time: - \begin{equation} - \binom{n}{k} = \binom{n-1}{k} + \binom{n-1}{k-1} - \end{equation} *) - -let rec slow_binomial n k = - if n < 0 || k < 0 then - invalid_arg "Combinatorics.binomial" - else if k = 0 || k = n then - 1 - else - slow_binomial (pred n) k + slow_binomial (pred n) (pred k) - -let multinomial n_list = - List.fold_left (fun acc n -> acc / (factorial n)) - (factorial (List.fold_left (+) 0 n_list)) n_list - -let symmetry l = - List.fold_left (fun s (n, _) -> s * factorial n) 1 (ThoList.classify l) - -(* \thocwmodulesection{Partitions} *) - -(* The inner steps of the recursion (i.\,e.~$n=1$) are expanded as follows - \begin{multline} - \ocwlowerid{split'}(1,\lbrack p_k;p_{k-1};\ldots;p_1\rbrack, - \lbrack x_l;x_{l-1};\ldots;x_1\rbrack, - \lbrack x_{l+1};x_{l+2};\ldots;x_m\rbrack ) = \\ - \lbrack (\lbrack p_1;\ldots;p_k;x_{l+1}\rbrack, - \lbrack x_1;\ldots;x_l;x_{l+2};\ldots;x_m\rbrack); \qquad\qquad\qquad\\ - (\lbrack p_1;\ldots;p_k;x_{l+2}\rbrack, - \lbrack x_1;\ldots;x_l;x_{l+1};x_{l+3}\ldots;x_m\rbrack); - \ldots; \\ - (\lbrack p_1;\ldots;p_k;x_m\rbrack, - \lbrack x_1;\ldots;x_l;x_{l+1};\ldots;x_{m-1}\rbrack) \rbrack - \end{multline} - while the outer steps (i.\,e.~$n>1$) perform the same with one element - moved from the last argument to the first argument. At the $n$th level we have - \begin{multline} - \ocwlowerid{split'}(n,\lbrack p_k;p_{k-1};\ldots;p_1\rbrack, - \lbrack x_l;x_{l-1};\ldots;x_1\rbrack, - \lbrack x_{l+1};x_{l+2};\ldots;x_m\rbrack ) = \\ - \lbrack (\lbrack p_1;\ldots;p_k;x_{l+1};x_{l+2};\ldots;x_{l+n}\rbrack, - \lbrack x_1;\ldots;x_l;x_{l+n+1};\ldots;x_m\rbrack); \ldots; \qquad\\ - (\lbrack p_1;\ldots;p_k;x_{m-n+1};x_{m-n+2};\ldots;x_{m}\rbrack, - \lbrack x_1;\ldots;x_l;x_{l+1};\ldots;x_{m-n}\rbrack) \rbrack - \end{multline} - where the order of the~$\lbrack x_1;x_2;\ldots;x_m\rbrack$ is maintained in - the partitions. Variations on this multiple recursion idiom are used many - times below. *) - -let rec split' n rev_part rev_head = function - | [] -> [] - | x :: tail -> - let rev_part' = x :: rev_part - and parts = split' n rev_part (x :: rev_head) tail in - if n < 1 then - failwith "Combinatorics.split': can't happen" - else if n = 1 then - (List.rev rev_part', List.rev_append rev_head tail) :: parts - else - split' (pred n) rev_part' rev_head tail @ parts - -(* Kick off the recursion for $0 (b, a)) (split' (abs_l - n) [] [] l) - -(* Check the arguments and call the workhorse: *) - -let ordered_split n l = - let abs_l = List.length l in - if n < 0 || n > abs_l then - invalid_arg "Combinatorics.ordered_split" - else - ordered_split_unsafe n abs_l l - -(* Handle equipartitions specially: *) - -let split n l = - let abs_l = List.length l in - if n < 0 || n > abs_l then - invalid_arg "Combinatorics.split" - else begin - if 2 * n = abs_l then - match l with - | [] -> failwith "Combinatorics.split: can't happen" - | x :: tail -> - List.map (fun (p1, p2) -> (x :: p1, p2)) (split' (pred n) [] [] tail) - else - ordered_split_unsafe n abs_l l - end - -(* If we chop off parts repeatedly, we can either keep permutations or - suppress them. Generically, [attach_to_fst] has type - \begin{quote} - [('a * 'b) list -> 'a list -> ('a list * 'b) list -> ('a list * 'b) list] - \end{quote} - and semantics - \begin{multline} - \ocwlowerid{attach\_to\_fst} - (\lbrack (a_1,b_1),(a_2,b_2),\ldots,(a_m,b_m)\rbrack, - \lbrack a'_1,a'_2,\ldots\rbrack) = \\ - \lbrack (\lbrack a_1,a'_1,\ldots\rbrack, b_1), - (\lbrack a_2,a'_1,\ldots\rbrack, b_2),\ldots, - (\lbrack a_m,a'_1,\ldots\rbrack, b_m)\rbrack - \end{multline} - (where some of the result can be filtered out), assumed to be - prepended to the final argument. *) - -let rec multi_split' attach_to_fst n size splits = - if n <= 0 then - splits - else - multi_split' attach_to_fst (pred n) size - (List.fold_left (fun acc (parts, tail) -> - attach_to_fst (ordered_split size tail) parts acc) [] splits) - -let attach_to_fst_unsorted splits parts acc = - List.fold_left (fun acc' (p, rest) -> (p :: parts, rest) :: acc') acc splits - -(* Similarly, if the secod argument is a list of lists: *) - -let prepend_to_fst_unsorted splits parts acc = - List.fold_left (fun acc' (p, rest) -> (p @ parts, rest) :: acc') acc splits - -let attach_to_fst_sorted splits parts acc = - match parts with - | [] -> List.fold_left (fun acc' (p, rest) -> ([p], rest) :: acc') acc splits - | p :: _ as parts -> - List.fold_left (fun acc' (p', rest) -> - if p' > p then - (p' :: parts, rest) :: acc' - else - acc') acc splits - -let multi_split n size l = - multi_split' attach_to_fst_sorted n size [([], l)] - -let ordered_multi_split n size l = - multi_split' attach_to_fst_unsorted n size [([], l)] - -let rec partitions' splits = function - | [] -> List.map (fun (h, r) -> (List.rev h, r)) splits - | (1, size) :: more -> - partitions' - (List.fold_left (fun acc (parts, rest) -> - attach_to_fst_unsorted (split size rest) parts acc) - [] splits) more - | (n, size) :: more -> - partitions' - (List.fold_left (fun acc (parts, rest) -> - prepend_to_fst_unsorted (multi_split n size rest) parts acc) - [] splits) more - -let partitions multiplicities l = - if List.fold_left (+) 0 multiplicities <> List.length l then - invalid_arg "Combinatorics.partitions" - else - List.map fst (partitions' [([], l)] - (ThoList.classify (List.sort compare multiplicities))) - -let rec ordered_partitions' splits = function - | [] -> List.map (fun (h, r) -> (List.rev h, r)) splits - | size :: more -> - ordered_partitions' - (List.fold_left (fun acc (parts, rest) -> - attach_to_fst_unsorted (ordered_split size rest) parts acc) - [] splits) more - -let ordered_partitions multiplicities l = - if List.fold_left (+) 0 multiplicities <> List.length l then - invalid_arg "Combinatorics.ordered_partitions" - else - List.map fst (ordered_partitions' [([], l)] multiplicities) - - -let hdtl = function - | [] -> invalid_arg "Combinatorics.hdtl" - | h :: t -> (h, t) - -let factorized_partitions multiplicities l = - ThoList.factorize (List.map hdtl (partitions multiplicities l)) - -(* In order to construct keystones (cf.~chapter~\ref{sec:topology}), we - must eliminate reflectionsc consistently. For this to work, the lengths - of the parts \emph{must not} be reordered arbitrarily. Ordering with - monotonously fallings lengths would be incorrect however, because - then some remainders could fake a reflection symmetry and partitions - would be dropped erroneously. Therefore we put the longest first and - order the remaining with rising lengths: *) - -let longest_first l = - match ThoList.classify (List.sort (fun n1 n2 -> compare n2 n1) l) with - | [] -> [] - | longest :: rest -> longest :: List.rev rest - -let keystones multiplicities l = - if List.fold_left (+) 0 multiplicities <> List.length l then - invalid_arg "Combinatorics.keystones" - else - List.map fst (partitions' [([], l)] (longest_first multiplicities)) - -let factorized_keystones multiplicities l = - ThoList.factorize (List.map hdtl (keystones multiplicities l)) - -(* \thocwmodulesection{Choices} *) - -(* The implementation is very similar to [split'], but here we don't - have to keep track of the complements of the chosen sets. *) - -let rec choose' n rev_choice = function - | [] -> [] - | x :: tail -> - let rev_choice' = x :: rev_choice - and choices = choose' n rev_choice tail in - if n < 1 then - failwith "Combinatorics.choose': can't happen" - else if n = 1 then - List.rev rev_choice' :: choices - else - choose' (pred n) rev_choice' tail @ choices - -(* [choose n] is equivalent to $(\ocwlowerid{List.map}\,\ocwlowerid{fst})\circ - (\ocwlowerid{split\_ordered}\,\ocwlowerid{n})$, but more efficient. *) - -let choose n l = - let abs_l = List.length l in - if n < 0 then - invalid_arg "Combinatorics.choose" - else if n > abs_l then - [] - else if n = 0 then - [[]] - else if n = abs_l then - [l] - else - choose' n [] l - -let multi_choose n size l = - List.map fst (multi_split n size l) - -let ordered_multi_choose n size l = - List.map fst (ordered_multi_split n size l) - -(* \thocwmodulesection{Permutations} *) - -let rec insert x = function - | [] -> [[x]] - | h :: t as l -> (x :: l) :: List.map (fun l' -> h :: l') (insert x t) - -let permute l = - List.fold_left (fun acc x -> ThoList.flatmap (insert x) acc) [[]] l - -(* \thocwmodulesubsection{Graded Permutations} *) - -let rec insert_signed x = function - | (eps, []) -> [(eps, [x])] - | (eps, h :: t) -> (eps, x :: h :: t) :: - (List.map (fun (eps', l') -> (-eps', h :: l')) (insert_signed x (eps, t))) - -let rec permute_signed' = function - | (eps, []) -> [(eps, [])] - | (eps, h :: t) -> ThoList.flatmap (insert_signed h) (permute_signed' (eps, t)) - -let permute_signed l = - permute_signed' (1, l) - -(* The following are wasting at most a factor of two and there's probably - no point in improving on this \ldots *) - -let filter_sign s l = - List.map snd (List.filter (fun (eps, _) -> eps = s) l) - -let permute_even l = - filter_sign 1 (permute_signed l) - -let permute_odd l = - filter_sign (-1) (permute_signed l) - -(* \thocwmodulesubsection{Tensor Products of Permutations} *) - -let permute_tensor ll = - Product.list (fun l -> l) (List.map permute ll) - -let join_signs l = - let el, pl = List.split l in - (List.fold_left (fun acc x -> x * acc) 1 el, pl) - -let permute_tensor_signed ll = - Product.list join_signs (List.map permute_signed ll) - -let permute_tensor_even l = - filter_sign 1 (permute_tensor_signed l) - -let permute_tensor_odd l = - filter_sign (-1) (permute_tensor_signed l) - -let insert_inorder_signed order x (eps, l) = - let rec insert eps' accu = function - | [] -> (eps * eps', List.rev_append accu [x]) - | h :: t -> - if order x h = 0 then - invalid_arg - "Combinatorics.insert_inorder_signed: identical elements" - else if order x h < 0 then - (eps * eps', List.rev_append accu (x :: h :: t)) - else - insert (-eps') (h::accu) t - in - insert 1 [] l - -(* \thocwmodulesubsection{Sorting} *) - -let sort_signed order l = - List.fold_left (fun acc x -> insert_inorder_signed order x acc) (1, []) l - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/cascade.mli =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/cascade.mli (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/cascade.mli (revision 8703) @@ -1,70 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -module type T = - sig - - type flavor - type p - - type t - val of_string_list : int -> string list -> t - val to_string : t -> string - -(* An opaque type that describes the set of all constraints on an amplitude - and how to construct it from a cascade description. *) - type selectors - val to_selectors : t -> selectors - -(* Don't throw anything away: *) - val no_cascades : selectors - -(* [select_wf s f p ps] returns [true] iff either the flavor [f] and - momentum [p] match or \emph{all} combinations of the momenta in [ps] - are compatible, i.\,e.~$\pm\sum p_i\leq q$ *) - val select_wf : selectors -> (flavor -> p -> p list -> bool) - -(* [select_p s p ps] same as [select_wf s f p ps], but ignores the flavor [f] *) - val select_p : selectors -> (p -> p list -> bool) - -(* [on_shell s p] *) - val on_shell : selectors -> (flavor -> p -> bool) - -(* [is_gauss s p] *) - val is_gauss : selectors -> (flavor -> p -> bool) - -(* Diagnostics: *) - val description : selectors -> string option - - end - -module Make (M : Model.T) (P : Momentum.T) : - T with type flavor = M.flavor_sans_color and type p = P.t - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) - Index: branches/ohl/omega-development/completed/whizard2/src/pmap.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/pmap.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/pmap.ml (revision 8703) @@ -1,540 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -module type T = - sig - type ('key, 'a) t - val empty : ('key, 'a) t - val is_empty : ('key, 'a) t -> bool - val singleton : 'key -> 'a -> ('key, 'a) t - val add : ('key -> 'key -> int) -> 'key -> 'a -> ('key, 'a) t -> ('key, 'a) t - val update : ('key -> 'key -> int) -> ('a -> 'a -> 'a) -> - 'key -> 'a -> ('key, 'a) t -> ('key, 'a) t - val cons : ('key -> 'key -> int) -> ('a -> 'a -> 'a option) -> - 'key -> 'a -> ('key, 'a) t -> ('key, 'a) t - val find : ('key -> 'key -> int) -> 'key -> ('key, 'a) t -> 'a - val find_opt : ('key -> 'key -> int) -> 'key -> ('key, 'a) t -> 'a option - val choose : ('key, 'a) t -> 'key * 'a - val choose_opt : ('key, 'a) t -> ('key * 'a) option - val uncons : ('key, 'a) t -> 'key * 'a * ('key, 'a) t - val uncons_opt : ('key, 'a) t -> ('key * 'a * ('key, 'a) t) option - val elements : ('key, 'a) t -> ('key * 'a) list - val mem : ('key -> 'key -> int) -> 'key -> ('key, 'a) t -> bool - val remove : ('key -> 'key -> int) -> 'key -> ('key, 'a) t -> ('key, 'a) t - val union : ('key -> 'key -> int) -> ('a -> 'a -> 'a) -> - ('key, 'a) t -> ('key, 'a) t -> ('key, 'a) t - val compose : ('key -> 'key -> int) -> ('a -> 'a -> 'a option) -> - ('key, 'a) t -> ('key, 'a) t -> ('key, 'a) t - val iter : ('key -> 'a -> unit) -> ('key, 'a) t -> unit - val map : ('a -> 'b) -> ('key, 'a) t -> ('key, 'b) t - val mapi : ('key -> 'a -> 'b) -> ('key, 'a) t -> ('key, 'b) t - val fold : ('key -> 'a -> 'b -> 'b) -> ('key, 'a) t -> 'b -> 'b - val compare : ('key -> 'key -> int) -> ('a -> 'a -> int) -> - ('key, 'a) t -> ('key, 'a) t -> int - val canonicalize : ('key -> 'key -> int) -> ('key, 'a) t -> ('key, 'a) t - end - -module Tree = - struct - type ('key, 'a) t = - | Empty - | Node of ('key, 'a) t * 'key * 'a * ('key, 'a) t * int - - let empty = Empty - - let is_empty = function - | Empty -> true - | _ -> false - - let singleton k d = - Node (Empty, k, d, Empty, 1) - - let height = function - | Empty -> 0 - | Node (_,_,_,_,h) -> h - - let create l x d r = - let hl = height l and hr = height r in - Node (l, x, d, r, (if hl >= hr then hl + 1 else hr + 1)) - - let bal l x d r = - let hl = match l with Empty -> 0 | Node (_,_,_,_,h) -> h in - let hr = match r with Empty -> 0 | Node (_,_,_,_,h) -> h in - if hl > hr + 2 then begin - match l with - | Empty -> invalid_arg "Map.bal" - | Node (ll, lv, ld, lr, _) -> - if height ll >= height lr then - create ll lv ld (create lr x d r) - else begin - match lr with - | Empty -> invalid_arg "Map.bal" - | Node (lrl, lrv, lrd, lrr, _)-> - create (create ll lv ld lrl) lrv lrd (create lrr x d r) - end - end else if hr > hl + 2 then begin - match r with - | Empty -> invalid_arg "Map.bal" - | Node (rl, rv, rd, rr, _) -> - if height rr >= height rl then - create (create l x d rl) rv rd rr - else begin - match rl with - | Empty -> invalid_arg "Map.bal" - | Node (rll, rlv, rld, rlr, _) -> - create (create l x d rll) rlv rld (create rlr rv rd rr) - end - end else - Node (l, x, d, r, (if hl >= hr then hl + 1 else hr + 1)) - - let rec join l x d r = - match bal l x d r with - | Empty -> invalid_arg "Pmap.join" - | Node (l', x', d', r', _) as t' -> - let d = height l' - height r' in - if d < -2 or d > 2 then - join l' x' d' r' - else - t' - -(* Merge two trees [t1] and [t2] into one. All elements of [t1] must - precede the elements of [t2]. Assumes [height t1 - height t2 <= 2]. *) - - let rec merge t1 t2 = - match t1, t2 with - | Empty, t -> t - | t, Empty -> t - | Node (l1, v1, d1, r1, h1), Node (l2, v2, d2, r2, h2) -> - bal l1 v1 d1 (bal (merge r1 l2) v2 d2 r2) - -(* Same as merge, but does not assume anything about [t1] and [t2]. *) - - let rec concat t1 t2 = - match t1, t2 with - | Empty, t -> t - | t, Empty -> t - | Node (l1, v1, d1, r1, h1), Node (l2, v2, d2, r2, h2) -> - join l1 v1 d1 (join (concat r1 l2) v2 d2 r2) - -(* Splitting *) - - let rec split cmp x = function - | Empty -> (Empty, None, Empty) - | Node (l, v, d, r, _) -> - let c = cmp x v in - if c = 0 then - (l, Some d, r) - else if c < 0 then - let ll, vl, rl = split cmp x l in - (ll, vl, join rl v d r) - else (* [if c > 0 then] *) - let lr, vr, rr = split cmp x r in - (join l v d lr, vr, rr) - - let rec find cmp x = function - | Empty -> raise Not_found - | Node (l, v, d, r, _) -> - let c = cmp x v in - if c = 0 then - d - else if c < 0 then - find cmp x l - else (* [if c > 0] *) - find cmp x r - - let rec find_opt cmp x = function - | Empty -> None - | Node (l, v, d, r, _) -> - let c = cmp x v in - if c = 0 then - Some d - else if c < 0 then - find_opt cmp x l - else (* [if c > 0] *) - find_opt cmp x r - - let rec mem cmp x = function - | Empty -> false - | Node (l, v, d, r, _) -> - let c = cmp x v in - if c = 0 then - true - else if c < 0 then - mem cmp x l - else (* [if c > 0] *) - mem cmp x r - - let choose = function - | Empty -> raise Not_found - | Node (l, v, d, r, _) -> (v, d) - - let choose_opt = function - | Empty -> None - | Node (l, v, d, r, _) -> Some (v, d) - - let uncons = function - | Empty -> raise Not_found - | Node (l, v, d, r, h) -> (v, d, merge l r) - - let uncons_opt = function - | Empty -> None - | Node (l, v, d, r, h) -> Some (v, d, merge l r) - - let rec remove cmp x = function - | Empty -> Empty - | Node (l, v, d, r, h) -> - let c = cmp x v in - if c = 0 then - merge l r - else if c < 0 then - bal (remove cmp x l) v d r - else (* [if c > 0] *) - bal l v d (remove cmp x r) - - let rec cons cmp resolve x data' = function - | Empty -> Node (Empty, x, data', Empty, 1) - | Node (l, v, data, r, h) -> - let c = cmp x v in - if c = 0 then - match resolve data' data with - | Some data'' -> Node (l, x, data'', r, h) - | None -> merge l r - else if c < 0 then - bal (cons cmp resolve x data' l) v data r - else (* [if c > 0] *) - bal l v data (cons cmp resolve x data' r) - - let rec update cmp resolve x data' = function - | Empty -> Node (Empty, x, data', Empty, 1) - | Node (l, v, data, r, h) -> - let c = cmp x v in - if c = 0 then - Node (l, x, resolve data' data, r, h) - else if c < 0 then - bal (update cmp resolve x data' l) v data r - else (* [if c > 0] *) - bal l v data (update cmp resolve x data' r) - - let add cmp x data = update cmp (fun n o -> n) x data - - let rec compose cmp resolve s1 s2 = - match s1, s2 with - | Empty, t2 -> t2 - | t1, Empty -> t1 - | Node (l1, v1, d1, r1, h1), Node (l2, v2, d2, r2, h2) -> - if h1 >= h2 then - if h2 = 1 then - cons cmp (fun o n -> resolve n o) v2 d2 s1 - else begin - match split cmp v1 s2 with - | l2', None, r2' -> - join (compose cmp resolve l1 l2') v1 d1 - (compose cmp resolve r1 r2') - | l2', Some d, r2' -> - begin match resolve d1 d with - | None -> - concat (compose cmp resolve l1 l2') - (compose cmp resolve r1 r2') - | Some d -> - join (compose cmp resolve l1 l2') v1 d - (compose cmp resolve r1 r2') - end - end - else - if h1 = 1 then - cons cmp resolve v1 d1 s2 - else begin - match split cmp v2 s1 with - | l1', None, r1' -> - join (compose cmp resolve l1' l2) v2 d2 - (compose cmp resolve r1' r2) - | l1', Some d, r1' -> - begin match resolve d d2 with - | None -> - concat (compose cmp resolve l1' l2) - (compose cmp resolve r1' r2) - | Some d -> - join (compose cmp resolve l1' l2) v2 d - (compose cmp resolve r1' r2) - end - end - - let rec union cmp resolve s1 s2 = - match s1, s2 with - | Empty, t2 -> t2 - | t1, Empty -> t1 - | Node (l1, v1, d1, r1, h1), Node (l2, v2, d2, r2, h2) -> - - if h1 >= h2 then - if h2 = 1 then - update cmp (fun o n -> resolve n o) v2 d2 s1 - else begin - match split cmp v1 s2 with - | l2', None, r2' -> - join (union cmp resolve l1 l2') v1 d1 - (union cmp resolve r1 r2') - | l2', Some d, r2' -> - join (union cmp resolve l1 l2') v1 (resolve d1 d) - (union cmp resolve r1 r2') - end - else - if h1 = 1 then - update cmp resolve v1 d1 s2 - else begin - match split cmp v2 s1 with - | l1', None, r1' -> - join (union cmp resolve l1' l2) v2 d2 - (union cmp resolve r1' r2) - | l1', Some d, r1' -> - join (union cmp resolve l1' l2) v2 (resolve d d2) - (union cmp resolve r1' r2) - end - - let rec iter f = function - | Empty -> () - | Node (l, v, d, r, _) -> iter f l; f v d; iter f r - - let rec map f = function - | Empty -> Empty - | Node (l, v, d, r, h) -> Node (map f l, v, f d, map f r, h) - - let rec mapi f = function - | Empty -> Empty - | Node(l, v, d, r, h) -> Node (mapi f l, v, f v d, mapi f r, h) - - let rec fold f m accu = - match m with - | Empty -> accu - | Node (l, v, d, r, _) -> fold f l (f v d (fold f r accu)) - - let rec compare' cmp_k cmp_d l1 l2 = - match l1, l2 with - | [], [] -> 0 - | [], _ -> -1 - | _, [] -> 1 - | Empty :: t1, Empty :: t2 -> compare' cmp_k cmp_d t1 t2 - | Node (Empty, v1, d1, r1, _) :: t1, - Node (Empty, v2, d2, r2, _) :: t2 -> - let cv = cmp_k v1 v2 in - if cv <> 0 then begin - cv - end else begin - let cd = cmp_d d1 d2 in - if cd <> 0 then - cd - else - compare' cmp_k cmp_d (r1::t1) (r2::t2) - end - | Node (l1, v1, d1, r1, _) :: t1, t2 -> - compare' cmp_k cmp_d (l1 :: Node (Empty, v1, d1, r1, 0) :: t1) t2 - | t1, Node (l2, v2, d2, r2, _) :: t2 -> - compare' cmp_k cmp_d t1 (l2 :: Node (Empty, v2, d2, r2, 0) :: t2) - - let compare cmp_k cmp_d m1 m2 = compare' cmp_k cmp_d [m1] [m2] - - let rec elements' accu = function - | Empty -> accu - | Node (l, v, d, r, _) -> elements' ((v, d) :: elements' accu r) l - - let elements s = - elements' [] s - - let canonicalize cmp m = - fold (add cmp) m empty - - end - -module List = - struct - type ('key, 'a) t = ('key * 'a) list - - let empty = [] - - let is_empty = function - | [] -> true - | _ -> false - - let singleton k d = [(k, d)] - - let rec cons cmp resolve k' d' = function - | [] -> [(k', d')] - | ((k, d) as kd :: rest) as list -> - let c = cmp k' k in - if c = 0 then - match resolve d' d with - | None -> rest - | Some d'' -> (k', d'') :: rest - else if c < 0 then (* [k' < k] *) - (k', d') :: list - else (* [if c > 0], i.\,e.~[k < k'] *) - kd :: cons cmp resolve k' d' rest - - let rec update cmp resolve k' d' = function - | [] -> [(k', d')] - | ((k, d) as kd :: rest) as list -> - let c = cmp k' k in - if c = 0 then - (k', resolve d' d) :: rest - else if c < 0 then (* [k' < k] *) - (k', d') :: list - else (* [if c > 0], i.\,e.~[k < k'] *) - kd :: update cmp resolve k' d' rest - - let add cmp k' d' list = - update cmp (fun n o -> n) k' d' list - - let rec find cmp k' = function - | [] -> raise Not_found - | (k, d) :: rest -> - let c = cmp k' k in - if c = 0 then - d - else if c < 0 then (* [k' < k] *) - raise Not_found - else (* [if c > 0], i.\,e.~[k < k'] *) - find cmp k' rest - - let rec find_opt cmp k' = function - | [] -> None - | (k, d) :: rest -> - let c = cmp k' k in - if c = 0 then - Some d - else if c < 0 then (* [k' < k] *) - None - else (* [if c > 0], i.\,e.~[k < k'] *) - find_opt cmp k' rest - - let choose = function - | [] -> raise Not_found - | kd :: _ -> kd - - let rec choose_opt = function - | [] -> None - | kd :: _ -> Some kd - - let uncons = function - | [] -> raise Not_found - | (k, d) :: rest -> (k, d, rest) - - let uncons_opt = function - | [] -> None - | (k, d) :: rest -> Some (k, d, rest) - - let elements list = list - - let rec mem cmp k' = function - | [] -> false - | (k, d) :: rest -> - let c = cmp k' k in - if c = 0 then - true - else if c < 0 then (* [k' < k] *) - false - else (* [if c > 0], i.\,e.~[k < k'] *) - mem cmp k' rest - - let rec remove cmp k' = function - | [] -> [] - | ((k, d) as kd :: rest) as list -> - let c = cmp k' k in - if c = 0 then - rest - else if c < 0 then (* [k' < k] *) - list - else (* [if c > 0], i.\,e.~[k < k'] *) - kd :: remove cmp k' rest - - let rec compare cmp_k cmp_d m1 m2 = - match m1, m2 with - | [], [] -> 0 - | [], _ -> -1 - | _, [] -> 1 - | (k1, d1) :: rest1, (k2, d2) :: rest2 -> - let c = cmp_k k1 k2 in - if c = 0 then begin - let c' = cmp_d d1 d2 in - if c' = 0 then - compare cmp_k cmp_d rest1 rest2 - else - c' - end else - c - - let rec iter f = function - | [] -> () - | (k, d) :: rest -> f k d; iter f rest - - let rec map f = function - | [] -> [] - | (k, d) :: rest -> (k, f d) :: map f rest - - let rec mapi f = function - | [] -> [] - | (k, d) :: rest -> (k, f k d) :: mapi f rest - - let rec fold f m accu = - match m with - | [] -> accu - | (k, d) :: rest -> fold f rest (f k d accu) - - let rec compose cmp resolve m1 m2 = - match m1, m2 with - | [], [] -> [] - | [], m -> m - | m, [] -> m - | ((k1, d1) as kd1 :: rest1), ((k2, d2) as kd2 :: rest2) -> - let c = cmp k1 k2 in - if c = 0 then - match resolve d1 d2 with - | None -> compose cmp resolve rest1 rest2 - | Some d -> (k1, d) :: compose cmp resolve rest1 rest2 - else if c < 0 then (* [k1 < k2] *) - kd1 :: compose cmp resolve rest1 m2 - else (* [if c > 0], i.\,e.~[k2 < k1] *) - kd2 :: compose cmp resolve m1 rest2 - - let rec union cmp resolve m1 m2 = - match m1, m2 with - | [], [] -> [] - | [], m -> m - | m, [] -> m - | ((k1, d1) as kd1 :: rest1), ((k2, d2) as kd2 :: rest2) -> - let c = cmp k1 k2 in - if c = 0 then - (k1, resolve d1 d2) :: union cmp resolve rest1 rest2 - else if c < 0 then (* [k1 < k2] *) - kd1 :: union cmp resolve rest1 m2 - else (* [if c > 0], i.\,e.~[k2 < k1] *) - kd2 :: union cmp resolve m1 rest2 - - let canonicalize cmp x = x - - end - -(*i - Local Variables: - mode:caml - indent-tabs-mode:nil - page-delimiter:"^(\\* .*\n" - End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/thoGButton.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/thoGButton.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/thoGButton.ml (revision 8703) @@ -1,81 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -(* \begin{dubious} - Multiple inheritance from [GButton.button] and [GMisc.label] won't - typecheck because [GButton.button_signals] and [GObj.widget_signals] - don't match. - \end{dubious} - \begin{dubious} - Instead of [GtkBase.Object.try_cast], we could use - [GtkBase.Object.unsafe_cast] - \end{dubious} *) - -class mutable_button (button, label) = - object (self) - inherit GButton.button button - val label : GMisc.label = label - method set_text = label#set_text - end - -(* It remains to provide the semantics. Ask \texttt{GTK+} to create a - pair consisting of a button and \emph{included} label. *) - -let mutable_button_raw ?text ?border_width ?width ?height ?packing ?show () = - let button = GButton.button ?border_width ?width ?height ?packing ?show () in - let hbox = GPack.hbox ~packing:button#add () in - let label = GMisc.label ?text ~packing:(hbox#pack ~expand:true) () in - (GtkBase.Object.unsafe_cast button#as_widget, label) - -(* Finally, wrap it in the object. *) - -let mutable_button ?text ?border_width ?width ?height ?packing ?show () = - new mutable_button - (mutable_button_raw - ?text ?border_width ?width ?height ?packing ?show ()) - -(* If we need more state then just a changing label, we can do this - polymorphically by inheritance. *) - -class ['a] stateful_button widgets format state = - object (self) - inherit mutable_button widgets - val mutable state : 'a = state - method private update_text = self#set_text (format state) - method state = state - method set_state s = (state <- s; self#update_text) - initializer self#update_text - end - -let stateful_button format state - ?text ?border_width ?width ?height ?packing ?show () = - new stateful_button (mutable_button_raw - ?text ?border_width ?width ?height ?packing ?show ()) - format state - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/colorize.mli =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/colorize.mli (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/colorize.mli (revision 8703) @@ -1,50 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -(* \thocwmodulesection{\ldots} *) - -module type Flows = - sig - val max_lines : int - end - -module It (F : Flows) (M : Model.T) : - Model.Colorized with module M = M - -module Gauge (F : Flows) (M : Model.Gauge) : - Model.Colorized_Gauge with module M = M - -module Dynamical (M : Model.T) : - Model.Colorized with module M = M - -(* \begin{dubious} - Also implement [module Trivial (M : Model.T) : Model.Colorized with module M = M] - for handling completely colorless models more efficiently. - \end{dubious} *) - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/thoList.mli =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/thoList.mli (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/thoList.mli (revision 8703) @@ -1,95 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -(* [splitn n l = (hdn l, tln l)], but more efficient. *) -val hdn : int -> 'a list -> 'a list -val tln : int -> 'a list -> 'a list -val splitn : int -> 'a list -> 'a list * 'a list - -(* [of_subarray n m a] is $[\ocwlowerid{a.}(\ocwlowerid{n}); - \ocwlowerid{a.}(\ocwlowerid{n}+1);\ldots; - \ocwlowerid{a.}(\ocwlowerid{m})]$. Values of~[n] and~[m] - out of bounds are silently shifted towards these bounds. *) -val of_subarray : int -> int -> 'a array -> 'a list - -(* [range s n m] is $[\ocwlowerid{n}; \ocwlowerid{n}+\ocwlowerid{s}; - \ocwlowerid{n}+2\ocwlowerid{s};\ldots; - \ocwlowerid{m} - ((\ocwlowerid{m}-\ocwlowerid{n})\mod s)]$ *) -val range : ?stride:int -> int -> int -> int list - -(* Compress identical elements in a sorted list. Identity - is determined using the polymorphic equality function - [Pervasives.(=)]. *) -val uniq : 'a list -> 'a list - -(* Test if all members of a list are structurally identical - (actually [homogeneous l] and [List.length (uniq l) <= 1] - are equivalent, but the former is more efficient if a mismatch - comes early). *) -val homogeneous : 'a list -> bool - -(* [compare cmp l1 l2] compare two lists [l1] and [l2] according to - [cmp]. [cmp] defaults to the polymorphic [Pervasives.compare]. *) -val compare : ?cmp:('a -> 'a -> int) -> 'a list -> 'a list -> int - -(* Collect and count identical elements in a list. Identity - is determined using the polymorphic equality function - [Pervasives.(=)]. [classify] does not assume that the list - is sorted. However, it is~$O(n)$ for sorted lists and~$O(n^2)$ - in the worst case. *) -val classify : 'a list -> (int * 'a) list - -(* Collect the second factors with a common first factor in lists. *) -val factorize : ('a * 'b) list -> ('a * 'b list) list - -(* [flatmap f] is equivalent to $\ocwlowerid{List.flatten} \circ - (\ocwlowerid{List.map}\;\ocwlowerid{f})$, but more efficient, - because no intermediate lists are built. *) -val flatmap : ('a -> 'b list) -> 'a list -> 'b list - -val clone : int -> 'a -> 'a list -val multiply : int -> 'a list -> 'a list - -(* \begin{dubious} - Invent other names to avoid confusions with [List.fold_left2] - and [List.fold_right2]. - \end{dubious} *) -val fold_right2 : ('a -> 'b -> 'b) -> 'a list list -> 'b -> 'b -val fold_left2 : ('b -> 'a -> 'b) -> 'b -> 'a list list -> 'b - -(* [iteri f n [a;b;c]] evaluates [f n a], [f (n+1) b] and [f (n+2) c]. *) -val iteri : (int -> 'a -> unit) -> int -> 'a list -> unit - -(* [iteri2 f n m [[aa;ab];[ba;bb]]] evaluates [f n m aa], [f n (m+1) ab], - [f (n+1) m ba] and [f (n+1) (m+1) bb]. - NB: the nested lists need not be rectangular. *) -val iteri2 : (int -> int -> 'a -> unit) -> int -> int -> 'a list list -> unit - -val transpose : 'a list list -> 'a list list - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/tree.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/tree.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/tree.ml (revision 8703) @@ -1,643 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -(* \thocwmodulesection{Abstract Data Type} *) - -type ('n, 'l) t = - | Leaf of 'n * 'l - | Node of 'n * ('n, 'l) t list - -let leaf n l = Leaf (n, l) - -let node n children = Node (n, children) - -(* Presenting the leafs \textit{in order} comes naturally, but will be - useful below. *) -let rec leafs = function - | Leaf (_, l) -> [l] - | Node (_, ch) -> ThoList.flatmap leafs ch - -(* This guarantees that the root node can be stripped from the result - by [List.tl]. *) -let rec nodes = function - | Leaf _ -> [] - | Node (n, ch) -> n :: ThoList.flatmap nodes ch - -(* [first_match p list] returns [(x,list')], where [x] is the first element - of [list] for which [p x = true] and [list'] is [list] sans [x]. *) -let first_match p list = - let rec first_match' no_match = function - | [] -> invalid_arg "Tree.fuse: prospective root not found" - | t :: rest when p t -> (t, List.rev_append no_match rest) - | t :: rest -> first_match' (t :: no_match) rest in - first_match' [] list - -(* One recursion step in [fuse'] rotates the topmost tree node, moving - the prospective root up: - \begin{equation} - \label{eq:tree-rotation} - \parbox{46\unitlength}{% - \fmfframe(0,0)(0,4){% - \begin{fmfgraph*}(45,30) - \fmfstraight - \fmftop{r} - \fmfbottom{l11,l12,l1x,l1n,db1,l21,l22,l2x,l2n,db2,db3,db4,db5,db6,% - lx1,lx2,lxx,lxn,db7,ln1,ln2,lnx,lnn} - \fmf{plain,tension=4}{r,vr1} - \fmf{plain,tension=4,lab=$p$,lab.side=left}{r,vr2} - \fmf{dots,tension=4}{r,vrx} - \fmf{plain,tension=4}{r,vrn} - \fmf{plain}{vr1,l11}\fmf{plain}{vr1,l12} - \fmf{dots}{vr1,l1x}\fmf{plain}{vr1,l1n} - \fmf{plain}{vr2,l21}\fmf{plain}{vr2,l22} - \fmf{dots}{vr2,l2x}\fmf{plain}{vr2,l2n} - \fmf{dots}{vrx,lx1}\fmf{dots}{vrx,lx2} - \fmf{dots}{vrx,lxx}\fmf{dots}{vrx,lxn} - \fmf{plain}{vrn,ln1}\fmf{plain}{vrn,ln2} - \fmf{dots}{vrn,lnx}\fmf{plain}{vrn,lnn} - \fmfv{l=$r$,l.ang=-90}{l22} - \fmfv{d.shape=circle,d.filled=empty,d.size=7thick,% - back=.8white}{r,vr1,vrx,vrn} - \fmfv{d.shape=circle,d.filled=empty,d.size=7thick,% - lab=$R$,lab.dist=0}{vr2} - \end{fmfgraph*}}} - \to - \parbox{61\unitlength}{% - \fmfframe(0,0)(0,4){% - \begin{fmfgraph*}(60,30) - \fmfstraight - \fmftop{r} - \fmfbottom{l21,d1,d2,l22,d3,d4,l2x,d5,d6,l2n,d7,d8,db2,% - l11,l12,l1x,l1n,db1,db2,db3,lx1,lx2,lxx,lxn,db4,% - ln1,ln2,lnx,lnn} - \fmf{plain}{r,vr1}\fmf{phantom}{vr1,l21} - \fmf{plain}{r,vr2}\fmf{phantom}{vr2,l22} - \fmf{dots}{r,vrx}\fmf{phantom}{vrx,l2x} - \fmf{plain}{r,vr3}\fmf{phantom}{vr3,l2n} - \fmf{plain,tension=12,lab=$-p$,lab.side=left}{r,vrn} - \fmf{plain,tension=4}{vrn,vvr1} - \fmf{dots,tension=4}{vrn,vvrx} - \fmf{plain,tension=4}{vrn,vvrn} - \fmf{plain}{vvr1,l11}\fmf{plain}{vvr1,l12} - \fmf{dots}{vvr1,l1x}\fmf{plain}{vvr1,l1n} - \fmf{dots}{vvrx,lx1}\fmf{dots}{vvrx,lx2} - \fmf{dots}{vvrx,lxx}\fmf{dots}{vvrx,lxn} - \fmf{plain}{vvrn,ln1}\fmf{plain}{vvrn,ln2} - \fmf{dots}{vvrn,lnx}\fmf{plain}{vvrn,lnn} - \fmfv{l=$r$,l.ang=-90}{vr2} - \fmfv{d.shape=circle,d.filled=empty,d.size=7thick,% - back=.8white}{vrn,vvr1,vvrx,vvrn} - \fmfv{d.shape=circle,d.filled=empty,d.size=7thick,% - lab=$R$,lab.dist=0}{r} - \end{fmfgraph*}}} - \end{equation} *) - -let fuse conjg root contains_root trees = - let rec fuse' subtrees = - match first_match contains_root subtrees with - -(* If the prospective root is contained in a leaf, we have either found - the root---in which case we're done---or have failed catastrophically: *) - | Leaf (n, l), children -> - if l = root then - Node (conjg n, children) - else - invalid_arg "Tree.fuse: root predicate inconsistent" - -(* Otherwise, we perform a rotation as in~(\ref{eq:tree-rotation}) and - connect all nodes that do not contain the root to a new node. - For efficiency, we append the new node at the end and prevent - [first_match] from searching for the root in it in vain again. - Since [root_children] is probably rather short, this should be - a good strategy. *) - | Node (n, root_children), other_children -> - fuse' (root_children @ [Node (conjg n, other_children)]) in - fuse' trees - -(* Sorting is also straightforward, we only have to keep track of the - suprema of the subtrees: *) - -type ('a, 'b) with_supremum = { sup : 'a; data : 'b } - -(* Since the lists are rather short, [Sort.list] could be replaced by - an optimized version, but we're not (yet) dealing with the most - important speed bottleneck here: *) - -let rec sort' lesseq = function - | Leaf (_, l) as e -> { sup = l; data = e } - | Node (n, ch) -> - let ch' = Sort.list - (fun x y -> lesseq x.sup y.sup) (List.map (sort' lesseq) ch) in - { sup = (List.hd (List.rev ch')).sup; - data = Node (n, List.map (fun x -> x.data) ch') } - -(* finally, throw away the overall supremum: *) - -let sort lesseq t = (sort' lesseq t).data - -(* \thocwmodulesection{Homomorphisms} *) - -(* Isomophisms are simple: *) - -let rec map fn fl = function - | Leaf (n, l) -> Leaf (fn n, fl l) - | Node (n, ch) -> Node (fn n, List.map (map fn fl) ch) - -(* homomorphisms are not more complicated: *) - -let rec fold leaf node = function - | Leaf (n, l) -> leaf n l - | Node (n, ch) -> node n (List.map (fold leaf node) ch) - -(* and tensor products are fun: *) - -let rec fan leaf node = function - | Leaf (n, l) -> leaf n l - | Node (n, ch) -> Product.fold - (fun ch' t -> node n ch' @ t) (List.map (fan leaf node) ch) [] - -(* \thocwmodulesection{Output} *) - -let leaf_to_string n l = - if n = "" then - l - else if l = "" then - n - else - n ^ "(" ^ l ^ ")" - -let node_to_string n ch = - "(" ^ (if n = "" then "" else n ^ ":") ^ (String.concat "," ch) ^ ")" - -let to_string t = - fold leaf_to_string node_to_string t - -(* \thocwmodulesubsection{Feynmf} - Add a value that is greater than all suprema *) - -type 'a supremum_or_infinity = Infinity | Sup of 'a - -type ('a, 'b) with_supremum_or_infinity = - { sup : 'a supremum_or_infinity; data : 'b } - -let with_infinity lesseq x y = - match x.sup, y.sup with - | Infinity, _ -> false - | _, Infinity -> true - | Sup x', Sup y' -> lesseq x' y' - -(* Using this, we can sort the tree in another way that guarantees that - a particular leaf ([i2]) is moved as far to the end as possible. We - can then flip this leaf from outgoing to incoming without introducing - a crossing: *) - -let rec sort_2i' lesseq i2 = function - | Leaf (_, l) as e -> - { sup = if l = i2 then Infinity else Sup l; data = e } - | Node (n, ch) -> - let ch' = Sort.list (with_infinity lesseq) - (List.map (sort_2i' lesseq i2) ch) in - { sup = (List.hd (List.rev ch')).sup; - data = Node (n, List.map (fun x -> x.data) ch') } - -(* again, throw away the overall supremum: *) - -let sort_2i lesseq i2 t = (sort_2i' lesseq i2 t).data - -type feynmf = - { style : string option; - rev : bool; - label : string option; - tension : float option } - -open Printf - -let style prop = - match prop.style with - | None -> "plain" - | Some s -> s - -let leaf_label tex io leaf = function - | None -> fprintf tex " \\fmflabel{$%s$}{%s%s}\n" leaf io leaf - | Some s -> - fprintf tex " \\fmflabel{$%s{}^{(%s)}$}{%s%s}\n" s leaf io leaf - -(* We try to draw diagrams more symmetrically by reducing the tension - on the outgoing external lines. - \begin{dubious} - \index{shortcomings!algorithmical} - This is insufficient for asymmetrical cascade decays. - \end{dubious} *) - -let rec leaf_node tex to_string i2 n prop leaf = - let io, tension, rev = - if leaf = i2 then - ("i", "", not prop.rev) - else - ("o", ",tension=0.5", prop.rev) in - leaf_label tex io (to_string leaf) prop.label; - fprintf tex " \\fmfdot{v%d}\n" n; - if rev then - fprintf tex " \\fmf{%s%s}{%s%s,v%d}\n" - (style prop) tension io (to_string leaf) n - else - fprintf tex " \\fmf{%s%s}{v%d,%s%s}\n" - (style prop) tension n io (to_string leaf) - -and int_node tex to_string i2 n n' prop t = - if prop.rev then - fprintf tex " \\fmf{%s}{v%d,v%d}\n" (style prop) n' n - else - fprintf tex " \\fmf{%s}{v%d,v%d}\n" (style prop) n n'; - fprintf tex " \\fmfdot{v%d,v%d}\n" n n'; - edges_feynmf' tex to_string i2 n' t - -and leaf_or_int_node tex to_string i2 n n' = function - | Leaf (prop, l) -> leaf_node tex to_string i2 n prop l - | Node (prop, _) as t -> int_node tex to_string i2 n n' prop t - -and edges_feynmf' tex to_string i2 n = function - | Leaf (prop, l) -> leaf_node tex to_string i2 n prop l - | Node (_, ch) -> - ignore (List.fold_right - (fun t' n' -> - leaf_or_int_node tex to_string i2 n n' t'; - succ n') ch (4*n)) - -let edges_feynmf tex to_string i2 t = - let n = 1 in - begin match t with - | Leaf _ -> () - | Node (prop, _) -> - leaf_label tex "i" "1" prop.label; - if prop.rev then - fprintf tex " \\fmf{%s}{i1,v%d}\n" (style prop) n - else - fprintf tex " \\fmf{%s}{v%d,i1}\n" (style prop) n - end; - fprintf tex " \\fmfdot{v%d}\n" n; - edges_feynmf' tex to_string i2 n t - -let to_feynmf_channel tex to_string i2 t = - let t' = sort_2i (<=) i2 t in - let out = List.map to_string (List.filter (fun a -> i2 <> a) (leafs t')) in - fprintf tex "\\fmfframe(6,7)(6,6){%%\n"; - fprintf tex " \\begin{fmfgraph*}(35,30)\n"; - fprintf tex " \\fmfleft{i1,i%s}\n" (to_string i2); - fprintf tex " \\fmfright{o%s}\n" (String.concat ",o" out); - List.iter (fun s -> fprintf tex " \\fmflabel{$%s$}{i%s}\n" s s) - ["1"; (to_string i2)]; - List.iter (fun s -> fprintf tex " \\fmflabel{$%s$}{o%s}\n" s s) out; - edges_feynmf tex to_string i2 t'; - fprintf tex " \\end{fmfgraph*}}\n" - -(* \begin{figure} - \fmfframe(3,5)(3,5){% - \begin{fmfgraph*}(30,30) - \fmfleft{i1,i2} - \fmfright{o3,o4,o5,o6} - \fmflabel{$1$}{i1} - \fmflabel{$2$}{i2} - \fmflabel{$3$}{o3} - \fmflabel{$4$}{o4} - \fmflabel{$5$}{o5} - \fmflabel{$6$}{o6} - \fmf{plain}{i1,v1} - \fmf{plain}{v1,v3} - \fmf{plain,tension=0.5}{v3,o3} - \fmf{plain}{v3,v9} - \fmf{plain,tension=0.5}{v9,o4} - \fmf{plain}{v9,v27} - \fmf{plain,tension=0.5}{v27,o5} - \fmf{plain,tension=0.5}{v27,o6} - \fmf{plain}{v1,i2} - \end{fmfgraph*}} - \fmfframe(3,5)(3,5){% - \begin{fmfgraph*}(30,30) - \fmfleft{i1,i2} - \fmfright{o3,o4,o6,o5} - \fmflabel{$1$}{i1} - \fmflabel{$2$}{i2} - \fmflabel{$3$}{o3} - \fmflabel{$4$}{o4} - \fmflabel{$6$}{o6} - \fmflabel{$5$}{o5} - \fmf{plain}{i1,v1} - \fmf{plain}{v1,v3} - \fmf{plain,tension=0.5}{v3,o3} - \fmf{plain}{v3,v9} - \fmf{plain}{v9,v27} - \fmf{plain,tension=0.5}{v27,o4} - \fmf{plain,tension=0.5}{v27,o6} - \fmf{plain,tension=0.5}{v9,o5} - \fmf{plain}{v1,i2} - \end{fmfgraph*}} - \fmfframe(3,5)(3,5){% - \begin{fmfgraph*}(30,30) - \fmfleft{i1,i2} - \fmfright{o3,o4,o5,o6} - \fmflabel{$1$}{i1} - \fmflabel{$2$}{i2} - \fmflabel{$3$}{o3} - \fmflabel{$4$}{o4} - \fmflabel{$5$}{o5} - \fmflabel{$6$}{o6} - \fmf{plain}{i1,v1} - \fmf{plain}{v1,v3} - \fmf{plain}{v3,v9} - \fmf{plain,tension=0.5}{v9,o3} - \fmf{plain,tension=0.5}{v9,o4} - \fmf{plain}{v3,v10} - \fmf{plain,tension=0.5}{v10,o5} - \fmf{plain,tension=0.5}{v10,o6} - \fmf{plain}{v1,i2} - \end{fmfgraph*}} - \caption{\label{fig:to_feynmf}% - Note that this is subtly different \ldots} - \end{figure} *) - -let to_feynmf latex file to_string i2 t = - if !latex then - let tex = open_out (file ^ ".tex") in - fprintf tex "\\documentclass[10pt]{article} \n"; - fprintf tex "\\usepackage{feynmp} \n\n"; - fprintf tex "\\textwidth 18.5cm\n"; - fprintf tex "\\evensidemargin -1.5cm \n"; - fprintf tex "\\oddsidemargin -1.5cm \n\n"; - fprintf tex "\\setlength{\\unitlength}{1mm} \n\n"; - fprintf tex "\\begin{document} \n"; - fprintf tex "\\begin{fmffile}{%s.fmf} \n\n" file; - List.iter (to_feynmf_channel tex to_string i2) t; - fprintf tex "\n"; - fprintf tex "\\end{fmffile} \n"; - fprintf tex "\\end{document} \n"; - close_out tex - else - let tex = open_out file in - List.iter (to_feynmf_channel tex to_string i2) t; - close_out tex - -let vanilla = { style = None; rev = false; label = None; tension = None } - -let sty (s, r, l) = { vanilla with style = Some s; rev = r; label = Some l } - -(* \thocwmodulesection{Least Squares Layout} - \begin{equation} - L = \frac{1}{2} \sum_{i\not=i'} T_{ii'} \left(x_i-x_{i'}\right)^2 - + \frac{1}{2} \sum_{i,j} T'_{ij} \left(x_i-e_j\right)^2 - \end{equation} - and thus - \begin{equation} - 0 = \frac{\partial L}{\partial x_i} - = \sum_{i'\not=i} T_{ii'} \left(x_i-x_{i'}\right) - + \sum_{j} T'_{ij} \left(x_i-e_j\right) - \end{equation} - or - \begin{equation} - \label{eq:layout} - \left(\sum_{i'\not=i} T_{ii'} + \sum_{j} T'_{ij}\right) x_i - - \sum_{i'\not=i} T_{ii'} x_{i'} - = \sum_{j} T'_{ij} e_j - \end{equation} - where we can assume that - \begin{subequations} - \begin{align} - T_{ii'} &= T_{i'i} \\ - T_{ii} &= 0 - \end{align} - \end{subequations} *) -type 'a node_with_tension = { node : 'a; tension : float } - -let unit_tension t = - map (fun n -> { node = n; tension = 1.0 }) (fun l -> l) t - -let leafs_and_nodes i2 t = - let t' = sort_2i (<=) i2 t in - match nodes t' with - | [] -> failwith "Tree.nodes_and_leafs: impossible" - | i1 :: _ as n -> (i1, i2, List.filter (fun l -> l <> i2) (leafs t'), n) - -(* Not tail recursive, but they're unlikely to meet any deep trees: *) -let rec internal_edges_from n = function - | Leaf _ -> [] - | Node (n', ch) -> (n', n) :: (ThoList.flatmap (internal_edges_from n') ch) - -(* The root node of the tree represents a vertex (node) and an - external line (leaf) of the Feynman diagram simultaneously. Thus - it requires special treatment: *) -let internal_edges = function - | Leaf _ -> [] - | Node (n, ch) -> ThoList.flatmap (internal_edges_from n) ch - -let rec external_edges_from n = function - | Leaf (n', _) -> [(n', n)] - | Node (n', ch) -> ThoList.flatmap (external_edges_from n') ch - -let external_edges = function - | Leaf (n, _) -> [(n, n)] - | Node (n, ch) -> (n, n) :: ThoList.flatmap (external_edges_from n) ch - -type ('edge, 'node, 'ext) graph = - { int_nodes : 'node array; - ext_nodes : 'ext array; - int_edges : ('edge * int * int) list; - ext_edges : ('edge * int * int) list } - -module M = Pmap.Tree - -(* Invert an array, viewed as a map from non-negative integers - into a set. The result is a map from the set to the integers: - [val invert_array : 'a array -> ('a, int) M.t] *) - -let invert_array_unsafe a = - fst (Array.fold_left (fun (m, i) a_i -> - (M.add compare a_i i m, succ i)) (M.empty, 0) a) - -exception Not_invertible - -let add_unique key data map = - if M.mem compare key map then - raise Not_invertible - else - M.add compare key data map - -let invert_array a = - fst (Array.fold_left (fun (m, i) a_i -> - (add_unique a_i i m, succ i)) (M.empty, 0) a) - -let graph_of_tree nodes2edge conjugate i2 t = - let i1, i2, out, vertices = leafs_and_nodes i2 t in - let int_nodes = Array.of_list vertices - and ext_nodes = Array.of_list (conjugate i1 :: i2 :: out) in - let int_nodes_index_table = invert_array int_nodes - and ext_nodes_index_table = invert_array ext_nodes in - let int_nodes_index n = M.find compare n int_nodes_index_table - and ext_nodes_index n = M.find compare n ext_nodes_index_table in - { int_nodes = int_nodes; - ext_nodes = ext_nodes; - int_edges = List.map - (fun (n1, n2) -> - (nodes2edge n1 n2, int_nodes_index n1, int_nodes_index n2)) - (internal_edges t); - ext_edges = List.map - (fun (e, n) -> - let e' = - if e = i1 then - conjugate e - else - e in - (nodes2edge e' n, ext_nodes_index e', int_nodes_index n)) - (external_edges t) } - -let int_incidence f null g = - let n = Array.length g.int_nodes in - let incidence = Array.make_matrix n n null in - List.iter (fun (edge, n1, n2) -> - if n1 <> n2 then begin - let edge' = f edge g.int_nodes.(n1) g.int_nodes.(n2) in - incidence.(n1).(n2) <- edge'; - incidence.(n2).(n1) <- edge' - end) - g.int_edges; - incidence - -let ext_incidence f null g = - let n_int = Array.length g.int_nodes - and n_ext = Array.length g.ext_nodes in - let incidence = Array.make_matrix n_int n_ext null in - List.iter (fun (edge, e, n) -> - incidence.(n).(e) <- f edge g.ext_nodes.(e) g.int_nodes.(n)) - g.ext_edges; - incidence - -let division n = - if n < 0 then - [] - else if n = 1 then - [0.5] - else - let n' = pred n in - let d = 1.0 /. (float n') in - let rec division' i acc = - if i < 0 then - acc - else - division' (pred i) (float i *. d :: acc) in - division' n' [] - -type ('e, 'n, 'ext) ext_layout = ('e, 'n, 'ext * float * float) graph -type ('e, 'n, 'ext) layout = ('e, 'n * float * float, 'ext) ext_layout - -let left_to_right num_in g = - if num_in < 1 then - invalid_arg "left_to_right" - else - let num_out = Array.length g.ext_nodes - num_in in - if num_out < 1 then - invalid_arg "left_to_right" - else - let incoming = - List.map2 (fun e y -> (e, 0.0, y)) - (Array.to_list (Array.sub g.ext_nodes 0 num_in)) - (division num_in) - and outgoing = - List.map2 (fun e y -> (e, 1.0, y)) - (Array.to_list (Array.sub g.ext_nodes num_in num_out)) - (division num_out) in - { g with ext_nodes = Array.of_list (incoming @ outgoing) } - -(* Reformulating~(\ref{eq:layout}) - \begin{subequations} - \begin{align} - Ax &= b_x \\ - Ay &= b_y - \end{align} - \end{subequations} - with - \begin{subequations} - \begin{align} - A_{ii'} &= - \left( \sum_{i''\not=i} T_{ii''} - + \sum_j T'_{ij} \right) \delta_{ii'} - T_{ii'} \\ - (b_{x/y})_i &= \sum_j T'_{ij} (e_{x/y})_j - \end{align} - \end{subequations} *) -let sum a = Array.fold_left (+.) 0.0 a - -let tension_to_equation t t' e = - let xe, ye = List.split e in - let bx = Linalg.matmulv t' (Array.of_list xe) - and by = Linalg.matmulv t' (Array.of_list ye) - and a = Array.init (Array.length t) - (fun i -> - let a_i = Array.map (~-.) t.(i) in - a_i.(i) <- a_i.(i) +. sum t.(i) +. sum t'.(i); - a_i) in - (a, bx, by) - -let layout g = - let ext_nodes = - List.map (fun (_, x, y) -> (x, y)) (Array.to_list g.ext_nodes) in - let a, bx, by = - tension_to_equation - (int_incidence (fun _ _ _ -> 1.0) 0.0 g) - (ext_incidence (fun _ _ _ -> 1.0) 0.0 g) ext_nodes in - match Linalg.solve_many a [bx; by] with - | [x; y] -> { g with int_nodes = Array.mapi - (fun i n -> (n, x.(i), y.(i))) g.int_nodes } - | _ -> failwith "impossible" - -let iter_edges f g = - List.iter (fun (edge, n1, n2) -> - let _, x1, y1 = g.int_nodes.(n1) - and _, x2, y2 = g.int_nodes.(n2) in - f edge (x1, y1) (x2, y2)) g.int_edges; - List.iter (fun (edge, e, n) -> - let _, x1, y1 = g.ext_nodes.(e) - and _, x2, y2 = g.int_nodes.(n) in - f edge (x1, y1) (x2, y2)) g.ext_edges - -let iter_internal f g = - Array.iter (fun (node, x, y) -> f (x, y)) g.int_nodes - -let iter_incoming f g = - f g.ext_nodes.(0); - f g.ext_nodes.(1) - -let iter_outgoing f g = - for i = 2 to pred (Array.length g.ext_nodes) do - f g.ext_nodes.(i) - done - -let dump g = - Array.iter (fun (_, x, y) -> Printf.eprintf "(%g,%g) " x y) g.ext_nodes; - Printf.eprintf "\n => "; - Array.iter (fun (_, x, y) -> Printf.eprintf "(%g,%g) " x y) g.int_nodes; - Printf.eprintf "\n" - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/comphep_parser.mly =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/comphep_parser.mly (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/comphep_parser.mly (revision 8703) @@ -1,63 +0,0 @@ -/* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */ - -%{ -module S = Comphep_syntax -%} - -%token < string > SYMBOL -%token < int > INT -%token I -%token LPAREN RPAREN -%token DOT MULT DIV POWER PLUS MINUS -%token END - -%left PLUS MINUS -%left MULT DIV -%nonassoc UNARY -%nonassoc POWER -%nonassoc DOT - -%start expr -%type < Comphep_syntax.raw > expr - -%% - -expr: - e END { $1 } -; - -e: - SYMBOL { S.symbol $1 } - | INT { S.integer $1 } - | I { S.imag } - | SYMBOL LPAREN e RPAREN { S.apply $1 $3 } - | LPAREN e RPAREN { $2 } - | e DOT e { S.dot $1 $3 } - | e MULT e { S.multiply $1 $3 } - | e DIV e { S.divide $1 $3 } - | e PLUS e { S.add $1 $3 } - | e MINUS e { S.subtract $1 $3 } - | PLUS e %prec UNARY { $2 } - | MINUS e %prec UNARY { S.neg $2 } - | e POWER INT { S.power $1 $3 } -; Index: branches/ohl/omega-development/completed/whizard2/src/momentum.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/momentum.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/momentum.ml (revision 8703) @@ -1,672 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -let rcs_file = RCS.parse "Momentum" ["Finite disjoint sums of momenta"] - { RCS.revision = "$Revision$"; - RCS.date = "$Date$"; - RCS.author = "$Author$"; - RCS.source - = "$URL$" } - -module type T = - sig - type t - val of_ints : int -> int list -> t - exception Duplicate of int - exception Range of int - exception Mismatch of string * t * t - exception Negative - val to_ints : t -> int list - val dim : t -> int - val rank : t -> int - val singleton : int -> int -> t - val zero : int -> t - val compare : t -> t -> int - val neg : t -> t - val abs : t -> t - val add : t -> t -> t - val sub : t -> t -> t - val try_add : t -> t -> t option - val try_sub : t -> t -> t option - val less : t -> t -> bool - val lesseq : t -> t -> bool - val try_fusion : t -> t -> t -> (bool * bool) option - val to_string : t -> string - val split : int -> int -> t -> t - val incoming : t -> bool - val outgoing : t -> bool - val timelike : t -> bool - val spacelike : t -> bool - val s_channel_in : t -> bool - val s_channel_out : t -> bool - val s_channel : t -> bool - val flip_s_channel_in : t -> t - val rcs : RCS.t - end - -(* \thocwmodulesection{Lists of Integers} *) - -(* The first implementation (as part of [Fusion]) was based on sorted - lists, because I did not want to preclude the use of more general - indices that integers. However, there's probably not much use for - this generality (the indices are typically generated automatically - and integer are the most natural choice) and it is no longer supported. - by the current signature. Thus one can also use the - more efficient implementation based on bitvectors below. *) - -module Lists = - struct - let rcs = RCS.rename rcs_file "Momentum.Lists()" - (RCS.description rcs_file @ - ["using lists as representation."]) - - type t = { d : int; r : int; p : int list } - - exception Range of int - exception Duplicate of int - - let rec check d = function - | p1 :: p2 :: _ when p2 <= p1 -> raise (Duplicate p1) - | p1 :: (p2 :: _ as rest) -> check d rest - | [p] when p < 1 || p > d -> raise (Range p) - | [p] -> () - | [] -> () - - let of_ints d p = - let p' = List.sort compare p in - check d p'; - { d = d; r = List.length p; p = p' } - - let to_ints p = p.p - let dim p = p.d - let rank p = p.r - let zero d = { d = d; r = 0; p = [] } - let singleton d p = { d = d; r = 1; p = [p] } - - let to_string p = - "[" ^ String.concat "," (List.map string_of_int p.p) ^ - "/" ^ string_of_int p.r ^ "/" ^ string_of_int p.d ^ "]" - - exception Mismatch of string * t * t - let mismatch s p1 p2 = raise (Mismatch (s, p1, p2)) - - let matching f s p1 p2 = - if p1.d = p2.d then - f p1 p2 - else - mismatch s p1 p2 - - let compare p1 p2 = - if p1.d = p2.d then begin - let c = compare p1.r p2.r in - if c <> 0 then - c - else - compare p1.p p2.p - end else - mismatch "compare" p1 p2 - - let rec neg' d i = function - | [] -> - if i <= d then - i :: neg' d (succ i) [] - else - [] - | i' :: rest as p -> - if i' > d then - failwith "Integer_List.neg: internal error" - else if i' = i then - neg' d (succ i) rest - else - i :: neg' d (succ i) p - - let neg p = { d = p.d; r = p.d - p.r; p = neg' p.d 1 p.p } - - let abs p = - if 2 * p.r > p.d then - neg p - else - p - - let rec add' p1 p2 = - match p1, p2 with - | [], p -> p - | p, [] -> p - | x1 :: p1', x2 :: p2' -> - if x1 < x2 then - x1 :: add' p1' p2 - else if x2 < x1 then - x2 :: add' p1 p2' - else - raise (Duplicate x1) - - let add p1 p2 = - if p1.d = p2.d then - { d = p1.d; r = p1.r + p2.r; p = add' p1.p p2.p } - else - mismatch "add" p1 p2 - - let rec try_add' d r acc p1 p2 = - match p1, p2 with - | [], p -> Some ({ d = d; r = r; p = List.rev_append acc p }) - | p, [] -> Some ({ d = d; r = r; p = List.rev_append acc p }) - | x1 :: p1', x2 :: p2' -> - if x1 < x2 then - try_add' d r (x1 :: acc) p1' p2 - else if x2 < x1 then - try_add' d r (x2 :: acc) p1 p2' - else - None - - let try_add p1 p2 = - if p1.d = p2.d then - try_add' p1.d (p1.r + p2.r) [] p1.p p2.p - else - mismatch "try_add" p1 p2 - - exception Negative - - let rec sub' p1 p2 = - match p1, p2 with - | p, [] -> p - | [], _ -> raise Negative - | x1 :: p1', x2 :: p2' -> - if x1 < x2 then - x1 :: sub' p1' p2 - else if x1 = x2 then - sub' p1' p2' - else - raise Negative - - let rec sub p1 p2 = - if p1.d = p2.d then begin - if p1.r >= p2.r then - { d = p1.d; r = p1.r - p2.r; p = sub' p1.p p2.p } - else - neg (sub p2 p1) - end else - mismatch "sub" p1 p2 - - let rec try_sub' d r acc p1 p2 = - match p1, p2 with - | p, [] -> Some ({ d = d; r = r; p = List.rev_append acc p }) - | [], _ -> None - | x1 :: p1', x2 :: p2' -> - if x1 < x2 then - try_sub' d r (x1 :: acc) p1' p2 - else if x1 = x2 then - try_sub' d r acc p1' p2' - else - None - - let try_sub p1 p2 = - if p1.d = p2.d then begin - if p1.r >= p2.r then - try_sub' p1.d (p1.r - p2.r) [] p1.p p2.p - else - match try_sub' p1.d (p2.r - p1.r) [] p2.p p1.p with - | None -> None - | Some p -> Some (neg p) - end else - mismatch "try_sub" p1 p2 - - let rec less' equal p1 p2 = - match p1, p2 with - | [], [] -> not equal - | [], _ -> true - | x1 :: _ , [] -> false - | x1 :: p1', x2 :: p2' when x1 = x2 -> less' equal p1' p2' - | x1 :: p1', x2 :: p2' -> less' false p1 p2' - - let less p1 p2 = - if p1.d = p2.d then - less' true p1.p p2.p - else - mismatch "sub" p1 p2 - - let rec lesseq' p1 p2 = - match p1, p2 with - | [], _ -> true - | x1 :: _ , [] -> false - | x1 :: p1', x2 :: p2' when x1 = x2 -> lesseq' p1' p2' - | x1 :: p1', x2 :: p2' -> lesseq' p1 p2' - - let lesseq p1 p2 = - if p1.d = p2.d then - lesseq' p1.p p2.p - else - mismatch "lesseq" p1 p2 - - let incoming p = - if p.r = 1 then - match p.p with - | [1] | [2] -> true - | _ -> false - else - false - - let outgoing p = - if p.r = 1 then - match p.p with - | [1] | [2] -> false - | _ -> true - else - false - - let s_channel_in p = - match p.p with - | [1; 2] -> true - | _ -> false - - let rec s_channel_out' d i = function - | [] -> i = succ d - | i' :: p when i' = i -> s_channel_out' d (succ i) p - | _ -> false - - let s_channel_out p = - match p.p with - | 3 :: p' -> s_channel_out' p.d 4 p' - | _ -> false - - let s_channel p = s_channel_in p || s_channel_out p - - let timelike p = - match p.p with - | p1 :: p2 :: _ -> p1 > 2 || (p1 = 1 && p2 = 2) - | p1 :: _ -> p1 > 2 - | [] -> false - - let spacelike p = not (timelike p) - - let flip_s_channel_in p = - if s_channel_in p then - neg (of_ints p.d [1;2]) - else - p - - let test_sum p inv1 p1 inv2 p2 = - if p.d = p1.d then begin - if p.d = p2.d then begin - match (if inv1 then try_add else try_sub) p p1 with - | None -> false - | Some p' -> - begin match (if inv2 then try_add else try_sub) p' p2 with - | None -> false - | Some p'' -> p''.r = 0 || p''.r = p.d - end - end else - mismatch "test_sum" p p2 - end else - mismatch "test_sum" p p1 - - let try_fusion p p1 p2 = - if test_sum p false p1 false p2 then - Some (false, false) - else if test_sum p true p1 false p2 then - Some (true, false) - else if test_sum p false p1 true p2 then - Some (false, true) - else if test_sum p true p1 true p2 then - Some (true, true) - else - None - - let split i n p = - let n' = n - 1 in - let rec split' head = function - | [] -> (p.r, List.rev head) - | i1 :: ilist -> - if i1 < i then - split' (i1 :: head) ilist - else if i1 > i then - (p.r, List.rev_append head (List.map ((+) n') (i1 :: ilist))) - else - (p.r + n', - List.rev_append head - ((ThoList.range i1 (i1 + n')) @ (List.map ((+) n') ilist))) in - let r', p' = split' [] p.p in - { d = p.d + n'; r = r'; p = p' } - - end - -(* \thocwmodulesection{Bit Fiddlings} *) - -(* Bit vectors are popular in Fortran based - implementations~\cite{ALPHA:1997,HELAC:2000,Kilian:WHIZARD} and - can be more efficient. In particular, when all infomation is - packed into a single integer, much of the memory overhead is - reduced. *) - -module Bits = - struct - let rcs = RCS.rename rcs_file "Momentum.Bits()" - (RCS.description rcs_file @ - [ "using bitfields as representation." ]) - - type t = int - -(* Bits $1\ldots21$ are used as a bitvector, indicating whether a - particular momentum is included. Bits $22\ldots26$ represent the - numbers of bits set in bits $1\ldots21$ and bits $27\ldots31$ - denote the maximum number of momenta. *) - let mask n = (1 lsl n) - 1 - let mask2 = mask 2 - let mask5 = mask 5 - let mask21 = mask 21 - - let maskd = mask5 lsl 26 - let maskr = mask5 lsl 21 - let maskb = mask21 - - let dim0 p = p land maskd - let rank0 p = p land maskr - let bits0 p = p land maskb - - let dim p = (dim0 p) lsr 26 - let rank p = (rank0 p) lsr 21 - let bits p = bits0 p - - let drb0 d r b = d lor r lor b - let drb d r b = d lsl 26 lor r lsl 21 lor b - -(* For a 64-bit architecture, the corresponding sizes could - be increased to $1\ldots51$, $52\ldots57$, and $58\ldots63$. - However, the combinatorical complexity will have killed - us long before we can reach these values. *) - - exception Range of int - exception Duplicate of int - - exception Mismatch of string * t * t - let mismatch s p1 p2 = raise (Mismatch (s, p1, p2)) - - let of_ints d p = - let r = List.length p in - if d <= 21 && r <= 21 then begin - List.fold_left (fun b p' -> - if p' <= d then - b lor (1 lsl (pred p')) - else - raise (Range p')) (drb d r 0) p - end else - raise (Range r) - - let zero d = drb d 0 0 - - let singleton d p = drb d 1 (1 lsl (pred p)) - - let rec to_ints' acc p b = - if b = 0 then - List.rev acc - else if (b land 1) = 1 then - to_ints' (p :: acc) (succ p) (b lsr 1) - else - to_ints' acc (succ p) (b lsr 1) - - let to_ints p = to_ints' [] 1 (bits p) - - let to_string p = - "[" ^ String.concat "," (List.map string_of_int (to_ints p)) ^ - "/" ^ string_of_int (rank p) ^ "/" ^ string_of_int (dim p) ^ "]" - - let compare p1 p2 = - if dim0 p1 = dim0 p2 then begin - let c = compare (rank0 p1) (rank0 p2) in - if c <> 0 then - c - else - compare (bits p1) (bits p2) - end else - mismatch "compare" p1 p2 - - let neg p = - let d = dim p and r = rank p in - drb d (d - r) ((mask d) land (lnot p)) - - let abs p = - if 2 * (rank p) > dim p then - neg p - else - p - - let add p1 p2 = - let d1 = dim0 p1 and d2 = dim0 p2 in - if d1 = d2 then begin - let b1 = bits p1 and b2 = bits p2 in - if b1 land b2 = 0 then - drb0 d1 (rank0 p1 + rank0 p2) (b1 lor b2) - else - raise (Duplicate 0) - end else - mismatch "add" p1 p2 - - exception Negative - - let rec sub p1 p2 = - let d1 = dim0 p1 and d2 = dim0 p2 in - if d1 = d2 then begin - let r1 = rank0 p1 and r2 = rank0 p2 in - if r1 >= r2 then begin - let b1 = bits p1 and b2 = bits p2 in - if b1 lor b2 = b1 then - drb0 d1 (r1 - r2) (b1 lxor b2) - else - raise Negative - end else - neg (sub p2 p1) - end else - mismatch "sub" p1 p2 - - let try_add p1 p2 = - let d1 = dim0 p1 and d2 = dim0 p2 in - if d1 = d2 then begin - let b1 = bits p1 and b2 = bits p2 in - if b1 land b2 = 0 then - Some (drb0 d1 (rank0 p1 + rank0 p2) (b1 lor b2)) - else - None - end else - mismatch "try_add" p1 p2 - - let rec try_sub p1 p2 = - let d1 = dim0 p1 and d2 = dim0 p2 in - if d1 = d2 then begin - let r1 = rank0 p1 and r2 = rank0 p2 in - if r1 >= r2 then begin - let b1 = bits p1 and b2 = bits p2 in - if b1 lor b2 = b1 then - Some (drb0 d1 (r1 - r2) (b1 lxor b2)) - else - None - end else - begin match try_sub p2 p1 with - | Some p -> Some (neg p) - | None -> None - end - end else - mismatch "sub" p1 p2 - - let lesseq p1 p2 = - let d1 = dim0 p1 and d2 = dim0 p2 in - if d1 = d2 then begin - let r1 = rank0 p1 and r2 = rank0 p2 in - if r1 <= r2 then begin - let b1 = bits p1 and b2 = bits p2 in - b1 lor b2 = b2 - end else - false - end else - mismatch "less" p1 p2 - - let less p1 p2 = p1 <> p2 && lesseq p1 p2 - - let mask_in1 = 1 - let mask_in2 = 2 - let mask_in = mask_in1 lor mask_in2 - - let incoming p = - let p' = bits p in - p' = mask_in1 || p' = mask_in2 - - let outgoing p = - rank p = 1 && not (incoming p) - - let timelike p = (mask_in1 land p) = ((mask_in2 land p) lsr 1) - let spacelike p = not (timelike p) - - let s_channel_in p = bits p = 3 - let s_channel_out p = ((mask (dim p)) land (lnot p)) = 3 - - let s_channel p = s_channel_in p || s_channel_out p - - let flip_s_channel_in p = - if s_channel_in p then - neg p - else - p - - let test_sum p inv1 p1 inv2 p2 = - let d = dim p in - if d = dim p1 then begin - if d = dim p2 then begin - match (if inv1 then try_add else try_sub) p p1 with - | None -> false - | Some p' -> - begin match (if inv2 then try_add else try_sub) p' p2 with - | None -> false - | Some p'' -> - let r = rank p'' in - r = 0 || r = d - end - end else - mismatch "test_sum" p p2 - end else - mismatch "test_sum" p p1 - - let try_fusion p p1 p2 = - if test_sum p false p1 false p2 then - Some (false, false) - else if test_sum p true p1 false p2 then - Some (true, false) - else if test_sum p false p1 true p2 then - Some (false, true) - else if test_sum p true p1 true p2 then - Some (true, true) - else - None - -(* First create a gap of size~$n-1$ and subsequently fill it if and only if - the bit~$i$ was set. *) - let split i n p = - let delta_d = n - 1 - and b = bits p in - let mask_low = mask (pred i) - and mask_i = 1 lsl (pred i) - and mask_high = lnot (mask i) in - let b_low = mask_low land b - and b_med, delta_r = - if mask_i land b <> 0 then - ((mask n) lsl (pred i), delta_d) - else - (0, 0) - and b_high = - if delta_d > 0 then - (mask_high land b) lsl delta_d - else if delta_d = 0 then - mask_high land b - else - (mask_high land b) lsr (-delta_d) in - drb (dim p + delta_d) (rank p + delta_r) (b_low lor b_med lor b_high) - - end - -(* \thocwmodulesection{Whizard} *) - -module type Whizard = - sig - type t - val of_momentum : t -> int - val to_momentum : int -> int -> t - end - -module BitsW = - struct - type t = Bits.t - open Bits (* NB: this includes the internal functions not in [T]! *) - - let of_momentum p = - let d = dim p in - let bit_in1 = 1 land p - and bit_in2 = 1 land (p lsr 1) - and bits_out = ((mask d) land p) lsr 2 in - bits_out lor (bit_in1 lsl (d - 1)) lor (bit_in2 lsl (d - 2)) - - let rec count_non_zero' acc i last b = - if i > last then - acc - else if (1 lsl (pred i)) land b = 0 then - count_non_zero' acc (succ i) last b - else - count_non_zero' (succ acc) (succ i) last b - - let count_non_zero first last b = - count_non_zero' 0 first last b - - let to_momentum d w = - let bit_in1 = 1 land (w lsr (d - 1)) - and bit_in2 = 1 land (w lsr (d - 2)) - and bits_out = (mask (d - 2)) land w in - let b = (bits_out lsl 2) lor bit_in1 lor (bit_in2 lsl 1) in - drb d (count_non_zero 1 d b) b - - end - -(* The following would be a tad more efficient, if coded directly, but - there's no point in wasting effort on this. *) - -module ListsW = - struct - type t = Lists.t - let of_momentum p = - BitsW.of_momentum (Bits.of_ints p.Lists.d p.Lists.p) - let to_momentum d w = - Lists.of_ints d (Bits.to_ints (BitsW.to_momentum d w)) - end - -(* \thocwmodulesection{Suggesting a Default Implementation} *) - -(* [Lists] is better tested, but the more recent [Bits] appears to - work as well and is \emph{much} more efficient, resulting in a - relative factor of better than 2. This performance ratio - is larger than I had expected and we are not likely to - reach its limit of 21 independent vectors anyway. *) - -module Default = Bits -module DefaultW = BitsW - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/oVM.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/oVM.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/oVM.ml (revision 8703) @@ -1,90 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -let rcs_file = RCS.parse "OVM" ["O'Mega Virtual Machine"] - { RCS.revision = "$Revision$"; - RCS.date = "$Date$"; - RCS.author = "$Author$"; - RCS.source - = "$URL$" } - -module Complex = Complex.Default - -module Vector = - struct - - type t = { t : Complex.t; x1 : Complex.t; x2 : Complex.t; x3 : Complex.t } - - let add v1 v2 = - { t = Complex.add v1.t v2.t; - x1 = Complex.add v1.x1 v2.x1; - x2 = Complex.add v1.x2 v2.x2; - x3 = Complex.add v1.x3 v2.x3 } - - let sub v1 v2 = - { t = Complex.sub v1.t v2.t; - x1 = Complex.sub v1.x1 v2.x1; - x2 = Complex.sub v1.x2 v2.x2; - x3 = Complex.sub v1.x3 v2.x3 } - - end - -module type T = - sig - - type amplitude - type program - type environment - - val compile : amplitude -> program - val eval : program -> environment -> - (float array * int) list -> float * float - - end - -module Make (F : Fusion.T) = - struct - - type amplitude = F.amplitude - - type instruction = - | NOP - - type environment = (string, float) Hashtbl.t - - type program = (instruction * int * int * int) list - - let compile amplitude = - failwith "OVM.compile: not available yet" - - let eval program environment momenta = - failwith "OVM.eval: not available yet" - - end - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/omega.mli =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/omega.mli (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/omega.mli (revision 8703) @@ -1,47 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -module type T = - sig - val main : unit -> unit - -(* \begin{dubious} - This used to be only intended for debugging O'Giga, - but might live longer \ldots - \end{dubious} *) - type flavor - val diagrams : flavor -> flavor -> flavor list -> - ((flavor * Momentum.Default.t) * - (flavor * Momentum.Default.t, - flavor * Momentum.Default.t) Tree.t) list - end - -module Make (FM : Fusion.Maker) (TM : Target.Maker) (M : Model.T) : - T with type flavor = M.flavor - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/thoArray.mli =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/thoArray.mli (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/thoArray.mli (revision 8703) @@ -1,55 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -(* Compressed arrays, i.\,e.~arrays with only unique elements and - an embedding that allows to recover the original array. - NB: in the current implementation, compressing saves space, - if \emph{and only if} objects of type ['a] require more storage - than integers. The main use of ['a compressed] is \emph{not} for - saving space, anyway, but for avoiding the repetition of hard - calculations. *) -type 'a compressed -val uniq : 'a compressed -> 'a array -val embedding : 'a compressed -> int array - -(* These two are inverses of each other: *) -val compress : 'a array -> 'a compressed -val uncompress : 'a compressed -> 'a array - -(* One can play the same game for matrices. *) -type 'a compressed2 -val uniq2 : 'a compressed2 -> 'a array array -val embedding1 : 'a compressed2 -> int array -val embedding2 : 'a compressed2 -> int array - -(* Again, these two are inverses of each other: *) -val compress2 : 'a array array -> 'a compressed2 -val uncompress2 : 'a compressed2 -> 'a array array - - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/trie.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/trie.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/trie.ml (revision 8703) @@ -1,355 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -(* \thocwmodulesection{Monomorphically} *) - -module type T = - sig - type key - type (+'a) t - val empty : 'a t - val is_empty : 'a t -> bool - val add : key -> 'a -> 'a t -> 'a t - val find : key -> 'a t -> 'a - val remove : key -> 'a t -> 'a t - val mem : key -> 'a t -> bool - val map : ('a -> 'b) -> 'a t -> 'b t - val mapi : (key -> 'a -> 'b) -> 'a t -> 'b t - val iter : (key -> 'a -> unit) -> 'a t -> unit - val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b - val longest : key -> 'a t -> 'a option * key - val shortest : key -> 'a t -> 'a option * key - val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int - val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool - val export : (int -> unit) -> (int -> unit) -> - (int -> key -> unit) -> (int -> key -> 'a -> unit) -> 'a t -> unit - - end - -module Make (M : Map.S) : (T with type key = M.key list) = - struct - -(* Derived from SML code by Chris Okasaki~\cite{Okasaki:1998:book}. *) - - type key = M.key list - - type 'a t = Trie of 'a option * 'a t M.t - - let empty = Trie (None, M.empty) - - let is_empty = function - | Trie (None, m) -> - m = M.empty (* after O'Caml 3.08: [M.is_empty m] *) - | _ -> false - - let rec add key data trie = - match key, trie with - | [], Trie (_, children) -> Trie (Some data, children) - | k :: rest, Trie (node, children) -> - let t = try M.find k children with Not_found -> empty in - Trie (node, M.add k (add rest data t) children) - - let rec find key trie = - match key, trie with - | [], Trie (None, _) -> raise Not_found - | [], Trie (Some data, _) -> data - | k :: rest, Trie (_, children) -> find rest (M.find k children) - -(* The rest is my own fault \ldots{} *) - - let find1 k children = - try Some (M.find k children) with Not_found -> None - - let add_non_empty k t children = - if t = empty then - M.remove k children - else - M.add k t children - - let rec remove key trie = - match key, trie with - | [], Trie (_, children) -> Trie (None, children) - | k :: rest, (Trie (node, children) as orig) -> - match find1 k children with - | None -> orig - | Some t -> Trie (node, add_non_empty k (remove rest t) children) - - let rec mem key trie = - match key, trie with - | [], Trie (None, _) -> false - | [], Trie (Some data, _) -> true - | k :: rest, Trie (_, children) -> - match find1 k children with - | None -> false - | Some t -> mem rest t - - let rec map f = function - | Trie (Some data, children) -> - Trie (Some (f data), M.map (map f) children) - | Trie (None, children) -> Trie (None, M.map (map f) children) - - let rec mapi' key f = function - | Trie (Some data, children) -> - Trie (Some (f key data), descend key f children) - | Trie (None, children) -> Trie (None, descend key f children) - and descend key f = M.mapi (fun k -> mapi' (key @ [k]) f) - let mapi f = mapi' [] f - - let rec iter' key f = function - | Trie (Some data, children) -> f key data; descend key f children - | Trie (None, children) -> descend key f children - and descend key f = M.iter (fun k -> iter' (key @ [k]) f) - let iter f = iter' [] f - - let rec fold' key f t acc = - match t with - | Trie (Some data, children) -> descend key f children (f key data acc) - | Trie (None, children) -> descend key f children acc - and descend key f = M.fold (fun k -> fold' (key @ [k]) f) - let fold f t acc = fold' [] f t acc - - let rec longest' partial partial_rest key trie = - match key, trie with - | [], Trie (data, _) -> (data, []) - | k :: rest, Trie (data, children) -> - match data, find1 k children with - | None, None -> (partial, partial_rest) - | Some _, None -> (data, key) - | _, Some t -> longest' partial partial_rest rest t - let longest key = longest' None key key - - let rec shortest' partial partial_rest key trie = - match key, trie with - | [], Trie (data, _) -> (data, []) - | k :: rest, Trie (Some _ as data, children) -> (data, key) - | k :: rest, Trie (None, children) -> - match find1 k children with - | None -> (partial, partial_rest) - | Some t -> shortest' partial partial_rest rest t - let shortest key = shortest' None key key - -(* \thocwmodulesection{O'Mega customization} *) - - let rec export' n key f_open f_close f_descend f_match = function - | Trie (Some data, children) -> - f_match n key data; - if children <> M.empty then - descend n key f_open f_close f_descend f_match children - | Trie (None, children) -> - if children <> M.empty then begin - f_descend n key; - descend n key f_open f_close f_descend f_match children - end - and descend n key f_open f_close f_descend f_match children = - f_open n; - M.iter (fun k -> - export' (succ n) (k :: key) f_open f_close f_descend f_match) children; - f_close n - - let export f_open f_close f_descend f_match = - export' 0 [] f_open f_close f_descend f_match - - let compare _ _ _ = - failwith "incomplete" - -(*i - let compare cmp m1 m2 = - let rec compare_aux e1 e2 = - match (e1, e2) with - | (End, End) -> 0 - | (End, _) -> -1 - | (_, End) -> 1 - | (More(v1, d1, r1, e1), More(v2, d2, r2, e2)) -> - let c = Ord.compare v1 v2 in - if c <> 0 then c else - let c = cmp d1 d2 in - if c <> 0 then c else - compare_aux (cons_enum r1 e1) (cons_enum r2 e2) in - compare_aux (cons_enum m1 End) (cons_enum m2 End) -i*) - - let equal _ _ _ = - failwith "incomplete" - -(*i - let equal cmp m1 m2 = - let rec equal_aux e1 e2 = - match (e1, e2) with - | (End, End) -> true - | (End, _) -> false - | (_, End) -> false - | (More(v1, d1, r1, e1), More(v2, d2, r2, e2)) -> - Ord.compare v1 v2 = 0 && cmp d1 d2 && - equal_aux (cons_enum r1 e1) (cons_enum r2 e2) in - equal_aux (cons_enum m1 End) (cons_enum m2 End) -i*) - - end - -module MakeMap (M : Map.S) : (Map.S with type key = M.key list) = Make(M) - -(* \thocwmodulesection{Polymorphically} *) - -module type Poly = - sig - type ('a, 'b) t - val empty : ('a, 'b) t - val add : ('a -> 'a -> int) -> 'a list -> 'b -> ('a, 'b) t -> ('a, 'b) t - val find : ('a -> 'a -> int) -> 'a list -> ('a, 'b) t -> 'b - val remove : ('a -> 'a -> int) -> 'a list -> ('a, 'b) t -> ('a, 'b) t - val mem : ('a -> 'a -> int) -> 'a list -> ('a, 'b) t -> bool - val map : ('b -> 'c) -> ('a, 'b) t -> ('a, 'c) t - val mapi : ('a list -> 'b -> 'c) -> ('a, 'b) t -> ('a, 'c) t - val iter : ('a list -> 'b -> unit) -> ('a, 'b) t -> unit - val fold : ('a list -> 'b -> 'c -> 'c) -> ('a, 'b) t -> 'c -> 'c - val longest : ('a -> 'a -> int) -> 'a list -> ('a, 'b) t -> 'b option * 'a list - val shortest : ('a -> 'a -> int) -> 'a list -> ('a, 'b) t -> 'b option * 'a list - val export : (int -> unit) -> (int -> unit) -> - (int -> 'a list -> unit) -> (int -> 'a list -> 'b -> unit) -> ('a, 'b) t -> unit - end - -module MakePoly (M : Pmap.T) : Poly = - struct - -(* Derived from SML code by Chris Okasaki~\cite{Okasaki:1998:book}. *) - - - type ('a, 'b) t = Trie of 'b option * ('a, ('a, 'b) t) M.t - - let empty = Trie (None, M.empty) - - let rec add cmp key data trie = - match key, trie with - | [], Trie (_, children) -> Trie (Some data, children) - | k :: rest, Trie (node, children) -> - let t = try M.find cmp k children with Not_found -> empty in - Trie (node, M.add cmp k (add cmp rest data t) children) - - let rec find cmp key trie = - match key, trie with - | [], Trie (None, _) -> raise Not_found - | [], Trie (Some data, _) -> data - | k :: rest, Trie (_, children) -> find cmp rest (M.find cmp k children) - -(* The rest is my own fault \ldots{} *) - - let find1 cmp k children = - try Some (M.find cmp k children) with Not_found -> None - - let add_non_empty cmp k t children = - if t = empty then - M.remove cmp k children - else - M.add cmp k t children - - let rec remove cmp key trie = - match key, trie with - | [], Trie (_, children) -> Trie (None, children) - | k :: rest, (Trie (node, children) as orig) -> - match find1 cmp k children with - | None -> orig - | Some t -> Trie (node, add_non_empty cmp k (remove cmp rest t) children) - - let rec mem cmp key trie = - match key, trie with - | [], Trie (None, _) -> false - | [], Trie (Some data, _) -> true - | k :: rest, Trie (_, children) -> - match find1 cmp k children with - | None -> false - | Some t -> mem cmp rest t - - let rec map f = function - | Trie (Some data, children) -> - Trie (Some (f data), M.map (map f) children) - | Trie (None, children) -> Trie (None, M.map (map f) children) - - let rec mapi' key f = function - | Trie (Some data, children) -> - Trie (Some (f key data), descend key f children) - | Trie (None, children) -> Trie (None, descend key f children) - and descend key f = M.mapi (fun k -> mapi' (key @ [k]) f) - let mapi f = mapi' [] f - - let rec iter' key f = function - | Trie (Some data, children) -> f key data; descend key f children - | Trie (None, children) -> descend key f children - and descend key f = M.iter (fun k -> iter' (key @ [k]) f) - let iter f = iter' [] f - - let rec fold' key f t acc = - match t with - | Trie (Some data, children) -> descend key f children (f key data acc) - | Trie (None, children) -> descend key f children acc - and descend key f = M.fold (fun k -> fold' (key @ [k]) f) - let fold f t acc = fold' [] f t acc - - let rec longest' cmp partial partial_rest key trie = - match key, trie with - | [], Trie (data, _) -> (data, []) - | k :: rest, Trie (data, children) -> - match data, find1 cmp k children with - | None, None -> (partial, partial_rest) - | Some _, None -> (data, key) - | _, Some t -> longest' cmp partial partial_rest rest t - let longest cmp key = longest' cmp None key key - - let rec shortest' cmp partial partial_rest key trie = - match key, trie with - | [], Trie (data, _) -> (data, []) - | k :: rest, Trie (Some _ as data, children) -> (data, key) - | k :: rest, Trie (None, children) -> - match find1 cmp k children with - | None -> (partial, partial_rest) - | Some t -> shortest' cmp partial partial_rest rest t - let shortest cmp key = shortest' cmp None key key - -(* \thocwmodulesection{O'Mega customization} *) - - let rec export' n key f_open f_close f_descend f_match = function - | Trie (Some data, children) -> - f_match n key data; - if children <> M.empty then - descend n key f_open f_close f_descend f_match children - | Trie (None, children) -> - if children <> M.empty then begin - f_descend n key; - descend n key f_open f_close f_descend f_match children - end - and descend n key f_open f_close f_descend f_match children = - f_open n; - M.iter (fun k -> - export' (succ n) (k :: key) f_open f_close f_descend f_match) children; - f_close n - - let export f_open f_close f_descend f_match = - export' 0 [] f_open f_close f_descend f_match - - end - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/dAG.mli =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/dAG.mli (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/dAG.mli (revision 8703) @@ -1,319 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -(* This datastructure describes large collections of trees with - many shared nodes. The sharing of nodes is semantically irrelevant, - but can turn a factorial complexity to exponential complexity. - Note that [DAG] implements only a very specialized subset of Directed - Acyclical Graphs (DAGs). *) - -(* If~$T(n,D)$ denotes the set of all binary trees with root~$n$ - encoded in~$D$, while - \begin{equation} - O(n,D)=\{(e_1,n_1,n_1'), \ldots, (e_k,n_k,n_k')\} - \end{equation} - denotes the set of all~\emph{offspring} of~$n$ in~$D$, - and~$\text{tree}(e,t,t')$ denotes the binary tree formed by - joining the binary trees~$t$ and~$t'$ with the label~$e$, then - \begin{multline} - T(n,D) = \bigl\{ \text{tree}(e_i,t_i,t_i')\,\bigl|\, - (e_i,t_i,t_i')\in\{e_1\}\times T(n_1,D)\times T(n_1',D) \cup\ldots\\ - \ldots\cup\{e_k\}\times T(n_k,D)\times T(n_k',D) \bigr\} - \end{multline} - is the recursive definition of the binary trees encoded in~$D$. - It is obvious how this definitions translates to $n$-ary trees - (including trees with mixed arity). *) - -(* \thocwmodulesection{Forests} *) - -(* We require edges and nodes to be members of ordered sets. - The sematics of [compare] are compatible with [Pervasives.compare]: - \begin{equation} - \ocwlowerid{compare}(x,y) = - \begin{cases} - -1 & \text{for $xy$} - \end{cases} - \end{equation} - Note that this requirement does \emph{not} exclude any trees. - Even if we consider only topological equivalence classes with - anonymous nodes, we can always construct a canonical labeling - and order from the children of the nodes. However, if practical - applications, we will often have more efficient labelings and - orders at our disposal. *) - -module type Ord = - sig - type t - val compare : t -> t -> int - end - -(* A forest~$F$ over a set of nodes and a set of edges - is a map from the set of nodes~$N$, to the direct product - of the set of edges~$E$ and the power set $2^N$ of~$N$ augmented - by a special element~$\bot$ (``bottom''). - \begin{equation} - \begin{aligned} - F: N &\to (E \times 2^N) \cup \{\bot\} \\ - n &\mapsto \begin{cases} - (e, \{n'_1,n'_2,\ldots\}) \\ - \bot - \end{cases} - \end{aligned} - \end{equation} - The nodes are ordered so that cycles can be detected - \begin{equation} - \forall n\in N: F(n) = (e, x) \Rightarrow \forall n'\in x: n > n' - \end{equation} - A suitable function that exists for \emph{all} forests is the - depth of the tree beneath a node. - - Nodes that are mapped to~$\bot$ are called \emph{leaf} nodes and - nodes that do not appear in any~$F(n)$ are called \emph{root} - nodes. There are as many trees in the forest as there are root - nodes. *) - -module type Forest = - sig - - module Nodes : Ord - type node = Nodes.t - type edge - -(* A subset~$X\subset2^N$ of the powerset of the set of nodes. The - members of~$X$ can be be characterized by a fixed number of members - (e.\,g.~two for binary trees, as in QED). We can also have mixed arities - (e.\,g.~two and three for QCD) or even arbitrary arities. However, - in most cases, the members of~$X$ will have at least two members. *) - type children - -(* This type abbreviation and order allow to apply the [Set.Make] - functor to $E\times X$. *) - type t = edge * children - val compare : t -> t -> int - -(* Test a predicate for \emph{all} children. *) - val for_all : (node -> bool) -> t -> bool - -(* [fold f (_, children) acc] will calculate - \begin{equation} - f (x_1, f(x_2, \cdots f(x_n,\ocwlowerid{acc}))) - \end{equation} - where the [children] are $\{x_1,x_2,\ldots,x_n\}$. - There are slightly more efficient alternatives for fixed arity - (in particular binary), but we want to be general. *) - val fold : (node -> 'a -> 'a) -> t -> 'a -> 'a - - end - -module Forest : functor (PT : Tuple.Poly) -> - functor (N : Ord) -> functor (E : Ord) -> - Forest with module Nodes = N and type edge = E.t - and type node = N.t and type children = N.t PT.t - -(* \thocwmodulesection{DAGs} *) - -module type T = - sig - - type node - type edge - -(* In the description of the function we assume for definiteness DAGs of - binary trees with [type children = node * node]. However, we will - also have implementations with [type children = node list] below. *) - -(* Other possibilities include - [type children = V3 of node * node | V4 of node * node * node]. - There's probable never a need to use sets with logarithmic - access, but it is easy to add. *) - - type children - type t - -(* The empty DAG. *) - val empty : t - -(* [add_node n dag] returns the DAG [dag] with the node [n]. - If the node [n] already exists in [dag], it is returned - unchanged. Otherwise [n] is added without offspring. *) - val add_node : node -> t -> t - -(* [add_offspring n (e, (n1, n2)) dag] returns the DAG [dag] - with the node [n] and its offspring [n1] and [n2] with edge - label [e]. Each node can have an arbitrary number of offspring, - but identical offspring are added only once. In order - to prevent cycles, [add_offspring] requires both [n>n1] and - [n>n2] in the given ordering. The nodes [n1] and [n2] are - added as by [add_node]. NB: Adding all nodes [n1] and [n2], even - if they are sterile, is not strictly necessary for our applications. - It even slows down the code by a few percent. But it is desirable - for consistency and allows much more efficient [iter_nodes] and - [fold_nodes] below. *) - val add_offspring : node -> edge * children -> t -> t - exception Cycle - -(* Just like [add_offspring], but does not check for potential cycles. *) - val add_offspring_unsafe : node -> edge * children -> t -> t - -(* [is_node n dag] returns [true] iff [n] is a node in [dag]. *) - val is_node : node -> t -> bool - -(* [is_sterile n dag] returns [true] iff [n] is a node in [dag] and - boasts no offspring. *) - val is_sterile : node -> t -> bool - -(* [is_offspring n (e, (n1, n2)) dag] returns [true] iff [n1] and [n2] - are offspring of [n] with label [e] in [dag]. *) - val is_offspring : node -> edge * children -> t -> bool - -(* Note that the following functions can run into infinite - recursion if the DAG given as argument contains cycles. *) - -(* The usual functionals for processing all nodes (including sterile) - \ldots{} *) - val iter_nodes : (node -> unit) -> t -> unit - val map_nodes : (node -> node) -> t -> t - val fold_nodes : (node -> 'a -> 'a) -> t -> 'a -> 'a - -(* \ldots{} and all parent/offspring relations. Note that [map] requires - \emph{two} functions: one for the nodes and one for - the edges and children. This is so because a change in the - definition of node is \emph{not} propagated automatically to where - it is used as a child. *) - val iter : (node -> edge * children -> unit) -> t -> unit - val map : (node -> node) -> - (node -> edge * children -> edge * children) -> t -> t - val fold : (node -> edge * children -> 'a -> 'a) -> t -> 'a -> 'a - -(* Return the DAG as a list of lists. *) - val lists : t -> (node * (edge * children) list) list - -(* [harvest dag n roots] returns the DAG [roots] - enlarged by all nodes in [dag] reachable from [n]. *) - val harvest : t -> node -> t -> t - -(* [size dag] returns the number of nodes in the DAG [dag]. *) - val size : t -> int - -(* [eval f mul_edge mul_nodes add null unit root dag] *) - val eval : (node -> 'a) -> (node -> edge -> 'b -> 'c) -> - ('a -> 'b -> 'b) -> ('c -> 'a -> 'a) -> 'a -> 'b -> node -> t -> 'a - val eval_memoized : (node -> 'a) -> (node -> edge -> 'b -> 'c) -> - ('a -> 'b -> 'b) -> ('c -> 'a -> 'a) -> 'a -> 'b -> node -> t -> 'a - -(* [harvest_list dag nlist] returns the part of the DAG [dag] - that is reachable from the nodes in [nlist]. *) - val harvest_list : t -> node list -> t - -(* [count_trees n dag] returns the number of trees with root [n] encoded - in the DAG [dag], i.\,e.~$|T(n,D)|$. NB: the current - implementation is very naive and can take a \emph{very} long - time for moderately sized DAGs that encode a large set of - trees. *) - val count_trees : node -> t -> int - -(* [forest root dag] *) - val forest : node -> t -> (node * edge option, node) Tree.t list - val forest_memoized : node -> t -> (node * edge option, node) Tree.t list - - val rcs : RCS.t - end - -module Make (F : Forest) : - T with type node = F.node and type edge = F.edge - and type children = F.children - -(* \thocwmodulesection{Graded Sets, Forests \&{} DAGs} *) - -(* A graded ordered\footnote{We don't appear to have use for graded unordered - sets.} set is an ordered set with a map into another ordered set (often the - non-negative integers). The grading does not necessarily respect the - ordering. *) - -module type Graded_Ord = - sig - include Ord - module G : Ord - val rank : t -> G.t - end - -(* For all ordered sets, there are two canonical gradings: a [Chaotic] grading - that assigns the same rank (e.\,g.~[unit]) to all elements and the [Discrete] - grading that uses the identity map as grading. *) - -module type Grader = functor (O : Ord) -> Graded_Ord with type t = O.t -module Chaotic : Grader -module Discrete : Grader - -(* A graded forest is just a forest in which the nodes form a graded ordered set. - \begin{dubious} - There doesn't appear to be a nice syntax for avoiding the repetition - here. Fortunately, the signature is short \ldots - \end{dubious} *) - -module type Graded_Forest = - sig - module Nodes : Graded_Ord - type node = Nodes.t - type edge - type children - type t = edge * children - val compare : t -> t -> int - val for_all : (node -> bool) -> t -> bool - val fold : (node -> 'a -> 'a) -> t -> 'a -> 'a - end - -module type Forest_Grader = functor (G : Grader) -> functor (F : Forest) -> - Graded_Forest with type Nodes.t = F.node - and type node = F.node - and type edge = F.edge - and type children = F.children - and type t = F.t - -module Grade_Forest : Forest_Grader - -(* Finally, a graded DAG is a DAG in which the nodes form a graded ordered set - and the subsets with a given rank can be accessed cheaply. *) - -module type Graded = - sig - include T - type rank - val rank : node -> rank - val ranks : t -> rank list - val min_max_rank : t -> rank * rank - val ranked : rank -> t -> node list - end - -module Graded (F : Graded_Forest) : - Graded with type node = F.node and type edge = F.edge - and type children = F.children and type rank = F.Nodes.G.t - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/model_parser.mly =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/model_parser.mly (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/model_parser.mly (revision 8703) @@ -1,101 +0,0 @@ -/* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */ - -%{ -let parse_error msg = - raise (Model_syntax.Syntax_Error (msg, symbol_start (), symbol_end ())) -%} - -%token < string > STRING EXPR -%token PARTICLE COUPLING VERTEX -%token AUTHOR VERSION CREATED REVISED -%token COMMA EQUAL COLON -%token END - -%start file -%type < Model_syntax.file > file - -%% - -file: - declarations END { $1 } -; - -declarations: - { Model_syntax.empty () } - | declarations particle_declaration - { Model_syntax.add_particle $2 $1 } - | declarations vertex_declaration - { Model_syntax.add_vertex $2 $1 } - | declarations coupling_declaration - { Model_syntax.add_coupling $2 $1 } - | declarations AUTHOR EXPR { Model_syntax.add_author $3 $1 } - | declarations VERSION EXPR { Model_syntax.add_version $3 $1 } - | declarations CREATED EXPR { Model_syntax.add_created $3 $1 } - | declarations REVISED EXPR { Model_syntax.add_revised $3 $1 } -; - -particle_declaration: - PARTICLE STRING attrib_list - { Model_syntax.neutral $2 $3 } - | PARTICLE STRING opt_comma STRING attrib_list - { Model_syntax.charged $2 $4 $5 } -; - -attrib_list: - { List.rev [] } - | COLON { List.rev [] } - | COLON rev_attrib_list { List.rev $2 } - -rev_attrib_list: - attrib { [$1] } - | rev_attrib_list opt_comma attrib - { $3 :: $1 } -; - -attrib: - STRING { ($1, "true") } - | STRING EQUAL STRING { ($1, $3) } -; - -coupling_declaration: - COUPLING STRING { Model_syntax.coupling $2 } -; - -vertex_declaration: - VERTEX particle_list COLON EXPR - { Model_syntax.vertex $2 $4 } -; - -particle_list: - rev_particle_list { List.rev $1 } - -rev_particle_list: - STRING { [$1] } - | rev_particle_list opt_comma STRING - { $3 :: $1 } -; - -opt_comma: - { () } - | COMMA { () } -; Index: branches/ohl/omega-development/completed/whizard2/src/models2.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/models2.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/models2.ml (revision 8703) @@ -1,2219 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -let rcs_file = RCS.parse "Models2" ["More Lagragians"] - { RCS.revision = "$Revision$"; - RCS.date = "$Date$"; - RCS.author = "$Author$"; - RCS.source - = "$URL$" } - -(* \thocwmodulesection{Minimal Supersymmetric Standard Model} *) - -module type MSSM_flags = - sig - val include_goldstone : bool - val include_four : bool - val ckm_present : bool - end - -module MSSM_no_goldstone : MSSM_flags = - struct - let include_goldstone = false - let include_four = true - let ckm_present = false - end - -module MSSM_goldstone : MSSM_flags = - struct - let include_goldstone = true - let include_four = true - let ckm_present = false - end - -module MSSM_no_4 : MSSM_flags = - struct - let include_goldstone = false - let include_four = false - let ckm_present = false - end - -module MSSM_no_4_ckm : MSSM_flags = - struct - let include_goldstone = false - let include_four = false - let ckm_present = true - end - -module MSSM_QCD : MSSM_flags = - struct - let include_goldstone = false - let include_four = false - let ckm_present = false - end - -module MSSM_QCD_ckm : MSSM_flags = - struct - let include_goldstone = false - let include_four = false - let ckm_present = true - end - -module MSSM (Flags : MSSM_flags) = - struct - let rcs = RCS.rename rcs_file "Models.MSSM" - [ "MSSM" ] - - open Coupling - - let default_width = ref Timelike - let use_fudged_width = ref false - - let options = Options.create - [ "constant_width", Arg.Unit (fun () -> default_width := Constant), - "use constant width (also in t-channel)"; - "fudged_width", Arg.Set use_fudged_width, - "use fudge factor for charge particle width"; - "custom_width", Arg.String (fun f -> default_width := Custom f), - "use custom width"; - "cancel_widths", Arg.Unit (fun () -> default_width := Vanishing), - "use vanishing width"] - - type gen = - | G of int | GG of gen*gen - - let rec string_of_gen = function - | G n when n > 0 -> string_of_int n - | G n -> string_of_int (abs n) ^ "c" - | GG (g1,g2) -> string_of_gen g1 ^ "_" ^ string_of_gen g2 - -(* With this we distinguish the flavour. *) - - type sff = - | SL | SN | SU | SD - - let string_of_sff = function - | SL -> "sl" | SN -> "sn" | SU -> "su" | SD -> "sd" - -(* With this we distinguish the mass eigenstates. At the moment we have to cheat - a little bit for the sneutrinos. Because we are dealing with massless - neutrinos there is only one sort of sneutrino. *) - - type sfm = - | M1 | M2 - - let string_of_sfm = function - | M1 -> "1" | M2 -> "2" - -(* We also introduce special types for the charginos and neutralinos. *) - - type char = - | C1 | C2 | C1c | C2c - - type neu = - | N1 | N2 | N3 | N4 - - let int_of_char = function - | C1 -> 1 | C2 -> 2 | C1c -> -1 | C2c -> -2 - - let string_of_char = function - | C1 -> "1" | C2 -> "2" | C1c -> "-1" | C2c -> "-2" - - let conj_char = function - | C1 -> C1c | C2 -> C2c | C1c -> C1 | C2c -> C2 - - let string_of_neu = function - | N1 -> "1" | N2 -> "2" | N3 -> "3" | N4 -> "4" - -(* Also we need types to distinguish the Higgs bosons. We follow the - conventions of Kuroda, which means - \begin{align} - \label{eq:higgs3} - H_1 &= - \begin{pmatrix} - \frac{1}{\sqrt{2}} - \bigl( - v_1 + H^0 \cos\alpha - h^0 - \sin\alpha + \ii A^0 \sin\beta - \ii \phi^0 \cos\beta - \bigr) \\ - H^- \sin\beta - \phi^- \cos\beta - \end{pmatrix}, - \\ & \notag \\ - H_2 & = - \begin{pmatrix} - H^+ \cos\beta + \phi^+ \sin\beta \\ - \frac{1}{\sqrt{2}} - \bigl( - v_2 + H^0 \sin\alpha + h^0 \cos\alpha + \ii A^0 \cos\beta + - \ii \phi^0 \sin\beta - \bigr) - \end{pmatrix} - \label{eq:higgs4} - \end{align} - This is a different sign convention compared to, e.g., - Weinberg's volume iii. We will refer to it as [GS+]. -*) - - type higgs = - | H1 (* the light scalar Higgs *) - | H2 (* the heavy scalar Higgs *) - | H3 (* the pseudoscalar Higgs *) - | H4 (* the charged Higgs *) - | H5 (* the neutral Goldstone boson *) - | H6 (* the charged Goldstone boson *) - | DH of higgs*higgs - - let rec string_of_higgs = function - | H1 -> "h1" | H2 -> "h2" | H3 -> "h3" | H4 -> "h4" - | H5 -> "p1" | H6 -> "p2" - | DH (h1,h2) -> string_of_higgs h1 ^ string_of_higgs h2 - - type flavor = - | L of int | N of int - | U of int | D of int - | Sup of sfm*int | Sdown of sfm*int - | Ga | Wp | Wm | Z | Gl - | Slepton of sfm*int | Sneutrino of int - | Neutralino of neu | Chargino of char - | Gluino - | Phip | Phim | Phi0 | H_Heavy | H_Light | Hp | Hm | A - type flavor_sans_color = flavor - let flavor_sans_color f = f - - type gauge = unit - - let gauge_symbol () = - failwith "Models.MSSM.gauge_symbol: internal error" - -(* At this point we will forget graviton and -tino. *) - - let lep_family g = [ L g; N g; Slepton (M1,g); - Slepton (M2,g); Sneutrino g ] - let family g = - [ L g; N g; Slepton (M1,g); Slepton (M2,g); Sneutrino g; - U g; D g; Sup (M1,g); Sup (M2,g); Sdown (M1,g); - Sdown (M2,g)] - - let external_flavors' = - [ "1st Generation", ThoList.flatmap family [1; -1]; - "2nd Generation", ThoList.flatmap family [2; -2]; - "3rd Generation", ThoList.flatmap family [3; -3]; - "Gauge Bosons", [Ga; Z; Wp; Wm; Gl]; - "Charginos", [Chargino C1; Chargino C2; Chargino C1c; Chargino C2c]; - "Neutralinos", [Neutralino N1; Neutralino N2; Neutralino N3; - Neutralino N4]; - "Higgs Bosons", [H_Heavy; H_Light; Hp; Hm; A]; - "Gluinos", [Gluino]] - let external_flavors () = - if Flags.include_goldstone then external_flavors' @ ["Goldstone Bosons", - [Phip; Phim; Phi0]] - else - external_flavors' - - let flavors () = ThoList.flatmap snd (external_flavors ()) - - let spinor n = - if n >= 0 then - Spinor - else if - n <= 0 then - ConjSpinor - else - invalid_arg "Models.MSSM.spinor: internal error" - - let lorentz = function - | L g -> spinor g | N g -> spinor g - | U g -> spinor g | D g -> spinor g - | Chargino c -> spinor (int_of_char c) - | Ga -> Vector | Gl -> Vector - | Wp | Wm | Z -> Massive_Vector - | H_Heavy | H_Light | Hp | Hm | A -> Scalar - | Phip | Phim | Phi0 -> Scalar - | Sup _ | Sdown _ | Slepton _ | Sneutrino _ -> Scalar - | Neutralino _ -> Majorana - | Gluino -> Majorana - | _ -> invalid_arg "Models.MSSM.lorentz: internal error" - - let color = function - | U g -> Color.SUN (if g > 0 then 3 else -3) - | Sup (m,g) -> Color.SUN (if g > 0 then 3 else -3) - | D g -> Color.SUN (if g > 0 then 3 else -3) - | Sdown (m,g) -> Color.SUN (if g > 0 then 3 else -3) - | Gl | Gluino -> Color.AdjSUN 3 - | _ -> Color.Singlet - - let prop_spinor n = - if n >= 0 then - Prop_Spinor - else if - n <=0 then - Prop_ConjSpinor - else - invalid_arg "Models.MSSM.prop_spinor: internal error" - - let propagator = function - | L g -> prop_spinor g | N g -> prop_spinor g - | U g -> prop_spinor g | D g -> prop_spinor g - | Chargino c -> prop_spinor (int_of_char c) - | Ga | Gl -> Prop_Feynman -(*i | Gl0 -> Prop_Col_Feynman i*) - | Wp | Wm | Z -> Prop_Unitarity - | H_Heavy | H_Light | Hp | Hm | A -> Prop_Scalar - | Phip | Phim | Phi0 -> if Flags.include_goldstone then Prop_Scalar - else Only_Insertion - | Slepton _ | Sneutrino _ | Sup _ | Sdown _ -> Prop_Scalar - | Gluino -> Prop_Majorana -(*i | Gluino0 -> Prop_Col_Majorana i*) - | Neutralino _ -> Prop_Majorana - -(* Optionally, ask for the fudge factor treatment for the widths of - charged particles. Currently, this only applies to $W^\pm$ and top. *) - - let width f = - if !use_fudged_width then - match f with - | Wp | Wm | U 3 | U (-3) -> Fudged - | _ -> !default_width - else - !default_width - -(* For the Goldstone bosons we adopt the conventions of the Kuroda paper. - \begin{subequations} - \begin{equation} - H_1 \equiv \begin{pmatrix} \left( v_1 + H^0 \cos\alpha - h^0 \sin - \alpha + \ii A^0 \sin\beta - \ii \cos\beta \phi^0 \right) / \sqrt{2} \\ - H^- \sin\beta - \phi^- \cos\beta \end{pmatrix} - \end{equation} - \begin{equation} - H_2 \equiv \begin{pmatrix} H^+ \cos\beta + \phi^+ \sin\beta \\ \left( - v_2 + H^0 \sin\alpha + h^0 \cos\alpha + \ii A^0 \cos\beta + \ii - \phi^0 \sin\beta \right) / \sqrt{2} \end{pmatrix} - \end{equation} - \end{subequations} -*) - - let goldstone = function - | Wp -> Some (Phip, Coupling.Const 1) - | Wm -> Some (Phim, Coupling.Const 1) - | Z -> Some (Phi0, Coupling.Const 1) - | _ -> None - - let conjugate = function - | L g -> L (-g) | N g -> N (-g) - | U g -> U (-g) | D g -> D (-g) - | Sup (m,g) -> Sup (m,-g) - | Sdown (m,g) -> Sdown (m,-g) - | Slepton (m,g) -> Slepton (m,-g) - | Sneutrino g -> Sneutrino (-g) - | Gl -> Gl (* | Gl0 -> Gl0 *) - | Ga -> Ga | Z -> Z | Wp -> Wm | Wm -> Wp - | H_Heavy -> H_Heavy | H_Light -> H_Light | A -> A - | Hp -> Hm | Hm -> Hp - | Phip -> Phim | Phim -> Phip | Phi0 -> Phi0 - | Gluino -> Gluino (* | Gluino0 -> Gluino0 *) - | Neutralino n -> Neutralino n | Chargino c -> Chargino (conj_char c) - | _ -> invalid_arg "Models.MSSM.conjugate: internal error" - - let conjugate_sans_color = conjugate - - let fermion = function - | L g -> if g > 0 then 1 else -1 - | N g -> if g > 0 then 1 else -1 - | U g -> if g > 0 then 1 else -1 - | D g -> if g > 0 then 1 else -1 - | Gl | Ga | Z | Wp | Wm -> 0 (* | Gl0 -> 0 *) - | H_Heavy | H_Light | Hp | Hm | A -> 0 - | Phip | Phim | Phi0 -> 0 - | Neutralino _ -> 2 - | Chargino c -> if (int_of_char c) > 0 then 1 else -1 - | Sup _ -> 0 | Sdown _ -> 0 - | Slepton _ -> 0 | Sneutrino _ -> 0 - | Gluino -> 2 (* Gluino0 -> 2 *) - -(* Because the O'Caml compiler only allows 248 constructors we must divide the - constants into subgroups of constants, e.g. for the Higgs couplings. In the - MSSM there are a lot of angles among the parameters, the Weinberg-angle, the - angle describing the Higgs vacuum structure, the mixing angle of the real - parts of the Higgs dubletts, the mixing angles of the sfermions. Therefore we - are going to define the trigonometric functions of those angles not as - constants but as functors of the angels. Sums and differences of angles are - only used as arguments for the $\alpha$ and $\beta$ angles, so it makes no - sense to define special functions for differences and sums of angles. *) - - type angle = - | Thw | Al | Be | Th_SF of sff*int | Delta | CKM_12 | CKM_13 | CKM_23 - - let string_of_angle = function - | Thw -> "thw" | Al -> "al" | Be -> "be" | Delta -> "d" - | CKM_12 -> "ckm12" | CKM_13 -> "ckm13" | CKM_23 -> "ckm23" - | Th_SF (f,g) -> "th" ^ string_of_sff f ^ string_of_int g - -(* We introduce a Boolean type vc as a pseudonym for Vertex Conjugator to - distinguish between vertices containing complex mixing matrices like the - CKM--matrix or the sfermion or neutralino/chargino--mixing matrices, which - have to become complex conjugated. The true--option stands for the conjugated - vertex, the false--option for the unconjugated vertex. *) - - type vc = bool - - type constant = - | Unit | Pi | Alpha_QED | Sin2thw - | Sin of angle | Cos of angle | E | G | Vev | Tanb | Tana - | Cos2be | Cos2al | Sin2be | Sin2al | Sin4al | Sin4be | Cos4be - | Cosapb | Cosamb | Sinapb | Sinamb | Cos2am2b | Sin2am2b - | Eidelta - | Mu | AU of int | AD of int | AL of int - | V_CKM of int*int | M_SF of sff*int*sfm*sfm - | M_V of char*char (* left chargino mixing matrix *) - | M_U of char*char (* right chargino mixing matrix *) - | M_N of neu*neu (* neutralino mixing matrix *) - | V_0 of neu*neu | A_0 of neu*neu | V_P of char*char | A_P of char*char - | L_CN of char*neu | R_CN of char*neu | L_NC of neu*char | R_NC of neu*char -(*i | L_NF of neu*sff*sfm | R_NF of neu*sff*sfm i*) - | S_NNH1 of neu*neu | P_NNH1 of neu*neu - | S_NNH2 of neu*neu | P_NNH2 of neu*neu - | S_NNA of neu*neu | P_NNA of neu*neu - | S_NNG of neu*neu | P_NNG of neu*neu - | L_CNG of char*neu | R_CNG of char*neu - | L_NCH of neu*char | R_NCH of neu*char - | Q_lepton | Q_up | Q_down | Q_charg - | G_Z | G_CC | G_CCQ of vc*int*int - | G_NC_neutrino | G_NC_lepton | G_NC_up | G_NC_down - | I_Q_W | I_G_ZWW | G_WWWW | G_ZZWW | G_PZWW | G_PPWW - | G_strong | G_SS | I_G_S | G_S_Sqrt - | Gs - | M of flavor | W of flavor - | G_NZN of neu*neu | G_CZC of char*char - | G_YUK of int*int - | DUM of int - | G_YUK_1 of int*int | G_YUK_2 of int*int | G_YUK_3 of int*int - | G_YUK_4 of int*int | G_NHC of neu*char | G_CHN of char*neu - | G_YUK_C of vc*int*char*sff*sfm - | G_YUK_Q of vc*int*int*char*sff*sfm - | G_YUK_N of vc*int*neu*sff*sfm - | G_YUK_G of vc*int*sff*sfm - | G_NGC of neu*char | G_CGN of char*neu - | SUM_1 - | G_NWC of neu*char | G_CWN of char*neu - | G_CH1C of char*char | G_CH2C of char*char | G_CAC of char*char - | G_CGC of char*char - | G_SWS of vc*int*int*sfm*sfm - | G_SLSNW of vc*int*sfm - | G_ZSF of sff*int*sfm*sfm - | G_CICIH1 of neu*neu | G_CICIH2 of neu*neu | G_CICIA of neu*neu - | G_CICIG of neu*neu - | G_GH of int | G_GHGo of int - | G_WWSFSF of sff*int*sfm*sfm - | G_WPSLSN of vc*int*sfm - | G_H3 of int | G_H4 of int - | G_HGo3 of int | G_HGo4 of int | G_GG4 of int - | G_H1SFSF of sff*int*sfm*sfm | G_H2SFSF of sff*int*sfm*sfm - | G_ASFSF of sff*int*sfm*sfm - | G_HSNSL of vc*int*sfm - | G_GoSFSF of sff*int*sfm*sfm - | G_GoSNSL of vc*int*sfm - | G_HSUSD of vc*sfm*sfm*int*int | G_GSUSD of vc*sfm*sfm*int*int - | G_WPSUSD of vc*sfm*sfm*int*int - | G_WZSUSD of vc*sfm*sfm*int*int - | G_WZSLSN of vc*int*sfm | G_GlGlSQSQ - | G_PPSFSF of sff - | G_ZZSFSF of sff*int*sfm*sfm | G_ZPSFSF of sff*int*sfm*sfm - | G_GlZSFSF of sff*int*sfm*sfm | G_GlPSQSQ - | G_GlWSUSD of vc*sfm*sfm*int*int - | G_GH4 of int | G_GHGo4 of int - | G_H1H2SFSF of sff*sfm*sfm*int - | G_H1H1SFSF of sff*sfm*sfm*int - | G_H2H2SFSF of sff*sfm*sfm*int - | G_HHSFSF of sff*sfm*sfm*int - | G_AASFSF of sff*sfm*sfm*int - | G_HH1SLSN of vc*sfm*int | G_HH2SLSN of vc*sfm*int - | G_HASLSN of vc*sfm*int - | G_HH1SUSD of vc*sfm*sfm*int*int - | G_HH2SUSD of vc*sfm*sfm*int*int - | G_HASUSD of vc*sfm*sfm*int*int - | G_AG0SFSF of sff*sfm*sfm*int - | G_HGSFSF of sff*sfm*sfm*int - | G_GGSFSF of sff*sfm*sfm*int - | G_G0G0SFSF of sff*sfm*sfm*int - | G_HGSNSL of vc*sfm*int | G_H1GSNSL of vc*sfm*int - | G_H2GSNSL of vc*sfm*int | G_AGSNSL of vc*sfm*int - | G_GGSNSL of vc*sfm*int - | G_HGSUSD of vc*sfm*sfm*int*int - | G_H1GSUSD of vc*sfm*sfm*int*int - | G_H2GSUSD of vc*sfm*sfm*int*int - | G_AGSUSD of vc*sfm*sfm*int*int - | G_GGSUSD of vc*sfm*sfm*int*int - | G_SN4 of int*int - | G_SN2SL2_1 of sfm*sfm*int*int | G_SN2SL2_2 of sfm*sfm*int*int - | G_SF4 of sff*sff*sfm*sfm*sfm*sfm*int*int - | G_SF4_3 of sff*sff*sfm*sfm*sfm*sfm*int*int*int - | G_SF4_4 of sff*sff*sfm*sfm*sfm*sfm*int*int*int*int - | G_SL4 of sfm*sfm*sfm*sfm*int - | G_SL4_2 of sfm*sfm*sfm*sfm*int*int - | G_SN2SQ2 of sff*sfm*sfm*int*int - | G_SL2SQ2 of sff*sfm*sfm*sfm*sfm*int*int - | G_SUSDSNSL of vc*sfm*sfm*sfm*int*int*int - | G_SU4 of sfm*sfm*sfm*sfm*int - | G_SU4_2 of sfm*sfm*sfm*sfm*int*int - | G_SD4 of sfm*sfm*sfm*sfm*int - | G_SD4_2 of sfm*sfm*sfm*sfm*int*int - | G_SU2SD2 of sfm*sfm*sfm*sfm*int*int*int*int - | G_HSF31 of higgs*int*sfm*sfm*sff*sff - | G_HSF32 of higgs*int*int*sfm*sfm*sff*sff - | G_HSF41 of higgs*int*sfm*sfm*sff*sff - | G_HSF42 of higgs*int*int*sfm*sfm*sff*sff - - let ferm_of_sff = function - | SL, g -> (L g) | SN, g -> (N g) - | SU, g -> (U g) | SD, g -> (D g) - -(* \begin{subequations} - \begin{align} - \alpha_{\text{QED}} &= \frac{1}{137.0359895} \\ - \sin^2\theta_w &= 0.23124 - \end{align} - \end{subequations} - -Here we must perhaps allow for complex input parameters. So split them -into their modulus and their phase. At first, we leave them real; the -generalization to complex parameters is obvious. *) - - - let parameters () = - { input = []; - derived = []; - derived_arrays = [] } - - module F = Models.Fusions (struct - type f = flavor - type c = constant - let compare = compare - let conjugate = conjugate - end) - - -(* For the couplings there are generally two possibilities concerning the - sign of the covariant derivative. - \begin{equation} - {\rm CD}^\pm = \partial_\mu \pm \ii g T^a A^a_\mu - \end{equation} - The particle data group defines the signs consistently to be positive. - Since the convention for that signs also influence the phase definitions - of the gaugino/higgsino fields via the off-diagonal entries in their - mass matrices it would be the best to adopt that convention. *) - -(*** REVISED: Compatible with CD+. ***) - let electromagnetic_currents_3 g = - [((U (-g), Ga, U g), FBF (1, Psibar, V, Psi), Q_up); - ((D (-g), Ga, D g), FBF (1, Psibar, V, Psi), Q_down); - ((L (-g), Ga, L g), FBF (1, Psibar, V, Psi), Q_lepton) ] - -(*** REVISED: Compatible with CD+. ***) - let electromagnetic_sfermion_currents g m = - [ ((Ga, Slepton (m,-g), Slepton (m,g)), Vector_Scalar_Scalar 1, Q_lepton); - ((Ga, Sup (m,-g), Sup (m,g)), Vector_Scalar_Scalar 1, Q_up); - ((Ga, Sdown (m,-g), Sdown (m,g)), Vector_Scalar_Scalar 1, Q_down) ] - -(*** REVISED: Compatible with CD+. ***) - let electromagnetic_currents_2 c = - let cc = conj_char c in - [ ((Chargino cc, Ga, Chargino c), FBF (1, Psibar, V, Psi), Q_charg) ] - -(*** REVISED: Compatible with CD+. ***) - let neutral_currents g = - [ ((L (-g), Z, L g), FBF (1, Psibar, VA, Psi), G_NC_lepton); - ((N (-g), Z, N g), FBF (1, Psibar, VA, Psi), G_NC_neutrino); - ((U (-g), Z, U g), FBF (1, Psibar, VA, Psi), G_NC_up); - ((D (-g), Z, D g), FBF (1, Psibar, VA, Psi), G_NC_down) ] - -(* \begin{equation} - \mathcal{L}_{\textrm{CC}} = - \mp \frac{g}{2\sqrt2} \sum_i \bar\psi_i \gamma^\mu - (1-\gamma_5)(T^+W^+_\mu+T^-W^-_\mu)\psi_i , - \end{equation} - where the sign corresponds to $\text{CD}_\pm$, respectively. *) - -(*** REVISED: Compatible with CD+. ***) - (* Remark: The definition with the other sign compared to the SM files - comes from the fact that $g_{cc} = 1/(2\sqrt{2})$ is used - overwhelmingly often in the SUSY Feynman rules, so that JR - decided to use a different definiton for [g_cc] in SM and MSSM. *) - let charged_currents g = - [ ((L (-g), Wm, N g), FBF ((-1), Psibar, VL, Psi), G_CC); - ((N (-g), Wp, L g), FBF ((-1), Psibar, VL, Psi), G_CC) ] - -(* The quark with the inverted generation (the antiparticle) is the outgoing - one, the other the incoming. The vertex attached to the outgoing up-quark - contains the CKM matrix element {\em not} complex conjugated, while the - vertex with the outgoing down-quark has the conjugated CKM matrix - element. *) - -(*** REVISED: Compatible with CD+. ***) - let charged_quark_currents g h = - [ ((D (-g), Wm, U h), FBF ((-1), Psibar, VL, Psi), G_CCQ (true,g,h)); - ((U (-g), Wp, D h), FBF ((-1), Psibar, VL, Psi), G_CCQ (false,h,g))] - -(*** REVISED: Compatible with CD+. ***) - let charged_chargino_currents n c = - let cc = conj_char c in - [ ((Chargino cc, Wp, Neutralino n), - FBF (1, Psibar, VLR, Chi), G_CWN (c,n)); - ((Neutralino n, Wm, Chargino c), - FBF (1, Chibar, VLR, Psi), G_NWC (n,c)) ] - -(*** REVISED: Compatible with CD+. ***) - let charged_slepton_currents g m = - [ ((Wm, Slepton (m,-g), Sneutrino g), Vector_Scalar_Scalar (-1), G_SLSNW - (true,g,m)); - ((Wp, Slepton (m,g), Sneutrino (-g)), Vector_Scalar_Scalar 1, G_SLSNW - (false,g,m)) ] - -(*** REVISED: Compatible with CD+. ***) - let charged_squark_currents' g h m1 m2 = - [ ((Wm, Sup (m1,g), Sdown (m2,-h)), Vector_Scalar_Scalar (-1), G_SWS - (true,g,h,m1,m2)); - ((Wp, Sup (m1,-g), Sdown (m2,h)), Vector_Scalar_Scalar 1, G_SWS - (false,g,h,m1,m2)) ] - let charged_squark_currents g h = List.flatten (Product.list2 - (charged_squark_currents' g h) [M1;M2] [M1;M2]) - -(*** REVISED: Compatible with CD+. ***) - let neutral_sfermion_currents' g m1 m2 = - [ ((Z, Slepton (m1,-g), Slepton (m2,g)), Vector_Scalar_Scalar (-1), G_ZSF - (SL,g,m1,m2)); - ((Z, Sup (m1,-g), Sup (m2,g)), Vector_Scalar_Scalar (-1), G_ZSF - (SU,g,m1,m2)); - ((Z, Sdown (m1,-g), Sdown (m2,g)), Vector_Scalar_Scalar (-1), G_ZSF - (SD,g,m1,m2)) ] - let neutral_sfermion_currents g = - List.flatten (Product.list2 (neutral_sfermion_currents' - g) [M1;M2] [M1;M2]) @ - [ ((Z, Sneutrino (-g), Sneutrino g), Vector_Scalar_Scalar (-1), G_ZSF - (SN,g,M1,M1)) ] - -(* The reality of the coupling of the Z-boson to two identical neutralinos - makes the vector part of the coupling vanish. So we distinguish them not - by the name but by the structure of the couplings. *) - -(*** REVISED: Compatible with CD+. ***) - let neutral_Z_1 (n,m) = - [ ((Neutralino n, Z, Neutralino m), FBF (1, Chibar, VA, Chi), - (G_NZN (n,m))) ] -(*** REVISED: Compatible with CD+. ***) - let neutral_Z_2 n = - [ ((Neutralino n, Z, Neutralino n), FBF (1, Chibar, Coupling.A, Chi), - (G_NZN (n,n)) )] - -(*** REVISED: Compatible with CD+. ***) - let charged_Z c1 c2 = - let cc1 = conj_char c1 in - ((Chargino cc1, Z, Chargino c2), FBF ((-1), Psibar, VA, Psi), - G_CZC (c1,c2)) - -(*** REVISED: Compatible with CD+. ***) - let yukawa_v = - [ ((Gluino, Gl, Gluino), FBF (1, Chibar, V, Chi), Gs) ] - -(*** REVISED: Independent of the sign of CD. ***) - let yukawa_higgs g = - [ ((N (-g), Hp, L g), FBF (1, Psibar, Coupling.SR, Psi), G_YUK (6,g)); - ((L (-g), Hm, N g), FBF (1, Psibar, Coupling.SL, Psi), G_YUK (6,g)); - ((L (-g), H_Heavy, L g), FBF (1, Psibar, S, Psi), G_YUK (7,g)); - ((L (-g), H_Light, L g), FBF (1, Psibar, S, Psi), G_YUK (8,g)); - ((L (-g), A, L g), FBF (1, Psibar, P, Psi), G_YUK (9,g)); - ((U (-g), H_Heavy, U g), FBF (1, Psibar, S, Psi), G_YUK (10,g)); - ((U (-g), H_Light, U g), FBF (1, Psibar, S, Psi), G_YUK (11,g)); - ((U (-g), A, U g), FBF (1, Psibar, P, Psi), G_YUK (12,g)); - ((D (-g), H_Heavy, D g), FBF (1, Psibar, S, Psi), G_YUK (13,g)); - ((D (-g), H_Light, D g), FBF (1, Psibar, S, Psi), G_YUK (14,g)); - ((D (-g), A, D g), FBF (1, Psibar, P, Psi), G_YUK (15,g)) ] - -(*** REVISED: Compatible with CD+ and GS+. ***) - let yukawa_goldstone g = - [ ((N (-g), Phip, L g), FBF (1, Psibar, Coupling.SR, Psi), G_YUK (19,g)); - ((L (-g), Phim, N g), FBF (1, Psibar, Coupling.SL, Psi), G_YUK (19,g)); - ((L (-g), Phi0, L g), FBF (1, Psibar, P, Psi), G_YUK (16,g)); - ((U (-g), Phi0, U g), FBF (1, Psibar, P, Psi), G_YUK (17,g)); - ((D (-g), Phi0, D g), FBF (1, Psibar, P, Psi), G_YUK (18,g)) ] - -(*** REVISED: Independent of the sign of CD. ***) - let yukawa_higgs_quark (g,h) = - [ ((U (-g), Hp, D h), FBF (1, Psibar, SLR, Psi), G_YUK_1 (g, h)); - ((D (-h), Hm, U g), FBF (1, Psibar, SLR, Psi), G_YUK_2 (g, h)) ] - -(*** REVISED: Compatible with CD+ and GS+. ***) - let yukawa_goldstone_quark g h = - [ ((U (-g), Phip, D h), FBF (1, Psibar, SLR, Psi), G_YUK_3 (g, h)); - ((D (-h), Phim, U g), FBF (1, Psibar, SLR, Psi), G_YUK_4 (g, h)) ] - -(*** REVISED: Compatible with CD+. *) - let yukawa_higgs_2' (c1,c2) = - let cc1 = conj_char c1 in - [ ((Chargino cc1, H_Heavy, Chargino c2), FBF (1, Psibar, SLR, Psi), - G_CH2C (c1,c2)); - ((Chargino cc1, H_Light, Chargino c2), FBF (1, Psibar, SLR, Psi), - G_CH1C (c1,c2)); - ((Chargino cc1, A, Chargino c2), FBF (1, Psibar, SLR, Psi), - G_CAC (c1,c2)) ] - let yukawa_higgs_2'' c = - let cc = conj_char c in - [ ((Chargino cc, H_Heavy, Chargino c), FBF (1, Psibar, S, Psi), - G_CH2C (c,c)); - ((Chargino cc, H_Light, Chargino c), FBF (1, Psibar, S, Psi), - G_CH1C (c,c)); - ((Chargino cc, A, Chargino c), FBF (1, Psibar, P, Psi), - G_CAC (c,c)) ] - let yukawa_higgs_2 = - ThoList.flatmap yukawa_higgs_2' [(C1,C2);(C2,C1)] @ - ThoList.flatmap yukawa_higgs_2'' [C1;C2] - -(*** REVISED: Compatible with CD+ and GS+. ***) - let yukawa_goldstone_2' (c1,c2) = - let cc1 = conj_char c1 in - [ ((Chargino cc1, Phi0, Chargino c2), FBF (1, Psibar, SLR, Psi), - G_CGC (c1,c2)) ] - let yukawa_goldstone_2'' c = - let cc = conj_char c in - [ ((Chargino cc, Phi0, Chargino c), FBF (1, Psibar, P, Psi), - G_CGC (c,c)) ] - let yukawa_goldstone_2 = - ThoList.flatmap yukawa_goldstone_2' [(C1,C2);(C2,C1)] @ - ThoList.flatmap yukawa_goldstone_2'' [C1;C2] - -(*** REVISED: Compatible with CD+. ***) - let higgs_charg_neutr n c = - let cc = conj_char c in - [ ((Neutralino n, Hm, Chargino c), FBF (-1, Chibar, SLR, Psi), - G_NHC (n,c)); - ((Chargino cc, Hp, Neutralino n), FBF (-1, Psibar, SLR, Chi), - G_CHN (c,n)) ] - -(*** REVISED: Compatible with CD+ and GS+. ***) - let goldstone_charg_neutr n c = - let cc = conj_char c in - [ ((Neutralino n, Phim, Chargino c), FBF (1, Chibar, SLR, Psi), - G_NGC (n,c)); - ((Chargino cc, Phip, Neutralino n), FBF (1, Psibar, SLR, Chi), - G_CGN (c,n)) ] - -(*** REVISED: Compatible with CD+. ***) - let higgs_neutr' (n,m) = - [ ((Neutralino n, H_Heavy, Neutralino m), FBF (1, Chibar, SP, Chi), - G_CICIH2 (n,m)); - ((Neutralino n, H_Light, Neutralino m), FBF (1, Chibar, SP, Chi), - G_CICIH1 (n,m)); - ((Neutralino n, A, Neutralino m), FBF (1, Chibar, SP, Chi), - G_CICIA (n,m)) ] - let higgs_neutr'' n = - [ ((Neutralino n, H_Heavy, Neutralino n), FBF (1, Chibar, S, Chi), - G_CICIH2 (n,n)); - ((Neutralino n, H_Light, Neutralino n), FBF (1, Chibar, S, Chi), - G_CICIH1 (n,n)); - ((Neutralino n, A, Neutralino n), FBF (1, Chibar, P, Chi), - G_CICIA (n,n)) ] - let higgs_neutr = - ThoList.flatmap higgs_neutr' [(N1,N2);(N1,N3);(N1,N4); - (N2,N3);(N2,N4);(N3,N4)] @ - ThoList.flatmap higgs_neutr'' [N1;N2;N3;N4] - -(*** REVISED: Compatible with CD+ and GS+. ***) - let goldstone_neutr' (n,m) = - [ ((Neutralino n, Phi0, Neutralino m), FBF (1, Chibar, SP, Chi), - G_CICIG (n,m)) ] - let goldstone_neutr'' n = - [ ((Neutralino n, Phi0, Neutralino n), FBF (1, Chibar, P, Chi), - G_CICIG (n,n)) ] - let goldstone_neutr = - ThoList.flatmap goldstone_neutr' [(N1,N2);(N1,N3);(N1,N4); - (N2,N3);(N2,N4);(N3,N4)] @ - ThoList.flatmap goldstone_neutr'' [N1;N2;N3;N4] - - -(*** REVISED: Compatible with CD+. ***) - let yukawa_n_1 n g = - [ ((Neutralino n, Slepton (M1,-g), L g), FBF (1, Chibar, Coupling.SL, - Psi), G_YUK_N (true,g,n,SL,M1)); - ((Neutralino n, Slepton (M2,-g), L g), FBF (1, Chibar, SR, Psi), - G_YUK_N (true,g,n,SL,M2)); - ((L (-g), Slepton (M1,g), Neutralino n), FBF (1, Psibar, SR, Chi), - G_YUK_N (false,g,n,SL,M1)); - ((L (-g), Slepton (M2,g), Neutralino n), FBF (1, Psibar, Coupling.SL, - Chi), G_YUK_N (false,g,n,SL,M2)); - ((Neutralino n, Sup (M1,-g), U g), FBF (1, Chibar, Coupling.SL, - Psi), G_YUK_N (true,g,n,SU,M1)); - ((Neutralino n, Sup (M2,-g), U g), FBF (1, Chibar, SR, Psi), - G_YUK_N (true,g,n,SU,M2)); - ((U (-g), Sup (M1,g), Neutralino n), FBF (1, Psibar, SR, Chi), - G_YUK_N (false,g,n,SU,M1)); - ((U (-g), Sup (M2,g), Neutralino n), FBF (1, Psibar, Coupling.SL, - Chi), G_YUK_N (false,g,n,SU,M2)); - ((Neutralino n, Sdown (M1,-g), D g), FBF (1, Chibar, Coupling.SL, - Psi), G_YUK_N (true,g,n,SD,M1)); - ((Neutralino n, Sdown (M2,-g), D g), FBF (1, Chibar, SR, Psi), - G_YUK_N (true,g,n,SD,M2)); - ((D (-g), Sdown (M1,g), Neutralino n), FBF (1, Psibar, SR, Chi), - G_YUK_N (false,g,n,SD,M1)); - ((D (-g), Sdown (M2,g), Neutralino n), FBF (1, Psibar, Coupling.SL, - Chi), G_YUK_N (false,g,n,SD,M2)) ] - let yukawa_n_2 n m = - [ ((Neutralino n, Slepton (m,-3), L 3), FBF (1, Chibar, SLR, Psi), - G_YUK_N (true,3,n,SL,m)); - ((L (-3), Slepton (m,3), Neutralino n), FBF (1, Psibar, SLR, Chi), - G_YUK_N (false,3,n,SL,m)); - ((Neutralino n, Sup (m,-3), U 3), FBF (1, Chibar, SLR, Psi), - G_YUK_N (true,3,n,SU,m)); - ((U (-3), Sup (m,3), Neutralino n), FBF (1, Psibar, SLR, Chi), - G_YUK_N (false,3,n,SU,m)); - ((Neutralino n, Sdown (m,-3), D 3), FBF (1, Chibar, SLR, Psi), - G_YUK_N (true,3,n,SD,m)); - ((D (-3), Sdown (m,3), Neutralino n), FBF (1, Psibar, SLR, Chi), - G_YUK_N (false,3,n,SD,m)) ] - let yukawa_n_3 n g = - [ ((Neutralino n, Sneutrino (-g), N g), FBF (1, Chibar, Coupling.SL, - Psi), G_YUK_N (true,g,n,SN,M1)); - ((N (-g), Sneutrino g, Neutralino n), FBF (1, Psibar, SR, Chi), - G_YUK_N (false,g,n,SN,M1)) ] - let yukawa_n_4 g = - [ ((U (-g), Sup (M1,g), Gluino), FBF ((-1), Psibar, SR, Chi), G_S_Sqrt); - ((D (-g), Sdown (M1,g), Gluino), FBF ((-1), Psibar, SR, Chi), G_S_Sqrt); - ((Gluino, Sup (M1,-g), U g), FBF ((-1), Chibar, Coupling.SL, Psi), G_S_Sqrt); - ((Gluino, Sdown (M1,-g), D g), FBF ((-1), Chibar, Coupling.SL, Psi), G_S_Sqrt); - ((U (-g), Sup (M2,g), Gluino), FBF (1, Psibar, Coupling.SL, Chi), G_S_Sqrt); - ((D (-g), Sdown (M2,g), Gluino), FBF (1, Psibar, Coupling.SL, Chi), G_S_Sqrt); - ((Gluino, Sup (M2,-g), U g), FBF (1, Chibar, SR, Psi), G_S_Sqrt); - ((Gluino, Sdown (M2,-g), D g), FBF (1, Chibar, SR, Psi), G_S_Sqrt)] - let yukawa_n_5 m = - [ ((U (-3), Sup (m,3), Gluino), FBF (1, Psibar, SLR, Chi), - G_YUK_G (false,3,SU,m)); - ((D (-3), Sdown (m,3), Gluino), FBF (1, Psibar, SLR, Chi), - G_YUK_G (false,3,SD,m)); - ((Gluino, Sup (m,-3), U 3), FBF (1, Chibar, SLR, Psi), - G_YUK_G (true,3,SU,m)); - ((Gluino, Sdown (m,-3), D 3), FBF (1, Chibar, SLR, Psi), - G_YUK_G (true,3,SD,m))] - let yukawa_n = - List.flatten (Product.list2 yukawa_n_1 [N1;N2;N3;N4] [1;2]) @ - List.flatten (Product.list2 yukawa_n_2 [N1;N2;N3;N4] [M1;M2]) @ - List.flatten (Product.list2 yukawa_n_3 [N1;N2;N3;N4] [1;2;3]) @ - ThoList.flatmap yukawa_n_4 [1;2] @ - ThoList.flatmap yukawa_n_5 [M1;M2] - -(*** REVISED: Compatible with CD+. ***) - let yukawa_c_1 c g = - let cc = conj_char c in - [ ((L (-g), Sneutrino g, Chargino cc), BBB (1, Psibar, Coupling.SR, - Psibar), G_YUK_C (true,g,c,SN,M1)); - ((Chargino c, Sneutrino (-g), L g), PBP (1, Psi, Coupling.SL, Psi), - G_YUK_C (false,g,c,SN,M1)) ] - let yukawa_c_2 c = - let cc = conj_char c in - [ ((L (-3), Sneutrino 3, Chargino cc), BBB (1, Psibar, SLR, - Psibar), G_YUK_C (true,3,c,SN,M1)); - ((Chargino c, Sneutrino (-3), L 3), PBP (1, Psi, SLR, Psi), - G_YUK_C (false,3,c,SN,M1)) ] - let yukawa_c_3 c m g = - let cc = conj_char c in - [ ((N (-g), Slepton (m,g), Chargino c), FBF (1, Psibar, Coupling.SR, - Psi), G_YUK_C (true,g,c,SL,m)); - ((Chargino cc, Slepton (m,-g), N g), FBF (1, Psibar, Coupling.SL, - Psi), G_YUK_C (false,g,c,SL,m)) ] - let yukawa_c c = - ThoList.flatmap (yukawa_c_1 c) [1;2] @ - yukawa_c_2 c @ - List.flatten (Product.list2 (yukawa_c_3 c) [M1] [1;2]) @ - List.flatten (Product.list2 (yukawa_c_3 c) [M1;M2] [3]) - -(*** REVISED: Compatible with CD+. ***) - let yukawa_cq' c (g,h) m = - let cc = conj_char c in - [ ((Chargino c, Sup (m,-g), D h), PBP (1, Psi, SLR, Psi), - G_YUK_Q (false,g,h,c,SU,m)); - ((D (-h), Sup (m,g), Chargino cc), BBB (1, Psibar, SLR, Psibar), - G_YUK_Q (true,g,h,c,SU,m)); - ((Chargino cc, Sdown (m,-h), U g), FBF (1, Psibar, SLR, Psi), - G_YUK_Q (true,g,h,c,SD,m)); - ((U (-g), Sdown (m,h), Chargino c), FBF (1, Psibar, SLR, Psi), - G_YUK_Q (false,g,h,c,SD,m)) ] - let yukawa_cq'' c (g,h) = - let cc = conj_char c in - [ ((Chargino c, Sup (M1,-g), D h), PBP (1, Psi, Coupling.SL, Psi), - G_YUK_Q (false,g,h,c,SU,M1)); - ((D (-h), Sup (M1,g), Chargino cc), - BBB (1, Psibar, Coupling.SR, Psibar), G_YUK_Q (true,g,h,c,SU,M1)); - ((Chargino cc, Sdown (M1,-h), U g), - FBF (1, Psibar, Coupling.SL, Psi), G_YUK_Q (true,g,h,c,SD,M1)); - ((U (-g), Sdown (M1,h), Chargino c), - FBF (1, Psibar, Coupling.SR, Psi), G_YUK_Q (false,g,h,c,SD,M1)) ] - let yukawa_cq c = - if Flags.ckm_present then - List.flatten (Product.list2 (yukawa_cq' c) [(1,3);(2,3);(3,3); - (3,2);(3,1)] [M1;M2]) @ - ThoList.flatmap (yukawa_cq'' c) [(1,1);(1,2);(2,1);(2,2)] - else - ThoList.flatmap (yukawa_cq' c (3,3)) [M1;M2] @ - ThoList.flatmap (yukawa_cq'' c) [(1,1);(2,2)] - - -(*** REVISED: Compatible with CD+. - Remark: Singlet and octet gluon exchange. The coupling is divided by - sqrt(2) to account for the correct normalization of the Lie algebra - generators. -***) - let col_currents g = - [ ((D (-g), Gl, D g), FBF ((-1), Psibar, V, Psi), Gs); - ((U (-g), Gl, U g), FBF ((-1), Psibar, V, Psi), Gs)] - -(*** REVISED: Compatible with CD+. - Remark: Singlet and octet gluon exchange. The coupling is divided by - sqrt(2) to account for the correct normalization of the Lie algebra - generators. -***) - - let col_sfermion_currents g m = - [ ((Gl, Sup (m,-g), Sup (m,g)), Vector_Scalar_Scalar (-1), Gs); - ((Gl, Sdown (m,-g), Sdown (m,g)), Vector_Scalar_Scalar (-1), Gs)] - -(*** REVISED: Compatible with CD+. ***) - let triple_gauge = - [ ((Ga, Wm, Wp), Gauge_Gauge_Gauge 1, I_Q_W); - ((Z, Wm, Wp), Gauge_Gauge_Gauge 1, I_G_ZWW); - ((Gl, Gl, Gl), Gauge_Gauge_Gauge 1, I_G_S)] - -(*** REVISED: Independent of the sign of CD. ***) - let gauge4 = Vector4 [(2, C_13_42); (-1, C_12_34); (-1, C_14_23)] - let gluon4 = Vector4 [(-1, C_13_42); (-1, C_12_34); (-1, C_14_23)] - let minus_gauge4 = Vector4 [(-2, C_13_42); (1, C_12_34); (1, C_14_23)] - let quartic_gauge = - [ (Wm, Wp, Wm, Wp), gauge4, G_WWWW; - (Wm, Z, Wp, Z), minus_gauge4, G_ZZWW; - (Wm, Z, Wp, Ga), minus_gauge4, G_PZWW; - (Wm, Ga, Wp, Ga), minus_gauge4, G_PPWW; - (Gl, Gl, Gl, Gl), gauge4, G_SS] - -(* The [Scalar_Vector_Vector] couplings do not depend on the choice of the - sign of the covariant derivative since they are quadratic in the - gauge couplings. *) - -(*** REVISED: Compatible with CD+. ***) -(*** Revision: 2005-03-10: first two vertices corrected. ***) - let gauge_higgs = - [ ((Wm, Hp, A), Vector_Scalar_Scalar 1, G_GH 1); - ((Wp, Hm, A), Vector_Scalar_Scalar 1, G_GH 1); - ((Z, H_Heavy, A), Vector_Scalar_Scalar 1, G_GH 3); - ((Z, H_Light, A), Vector_Scalar_Scalar 1, G_GH 2); - ((H_Heavy, Wp, Wm), Scalar_Vector_Vector 1, G_GH 5); - ((H_Light, Wp, Wm), Scalar_Vector_Vector 1, G_GH 4); - ((Wm, Hp, H_Heavy), Vector_Scalar_Scalar 1, G_GH 7); - ((Wp, Hm, H_Heavy), Vector_Scalar_Scalar (-1), G_GH 7); - ((Wm, Hp, H_Light), Vector_Scalar_Scalar 1, G_GH 6); - ((Wp, Hm, H_Light), Vector_Scalar_Scalar (-1), G_GH 6); - ((H_Heavy, Z, Z), Scalar_Vector_Vector 1, G_GH 9); - ((H_Light, Z, Z), Scalar_Vector_Vector 1, G_GH 8); - ((Z, Hp, Hm), Vector_Scalar_Scalar 1, G_GH 10); - ((Ga, Hp, Hm), Vector_Scalar_Scalar 1, G_GH 11) ] - -(*** REVISED: Compatible with CD+ and GS+. ***) - let gauge_higgs_gold = - [ ((Wp, Phi0, Phim), Vector_Scalar_Scalar 1, G_GH 1); - ((Wm, Phi0, Phip), Vector_Scalar_Scalar 1, G_GH 1); - ((Z, H_Heavy, Phi0), Vector_Scalar_Scalar 1, G_GH 2); - ((Z, H_Light, Phi0), Vector_Scalar_Scalar (-1), G_GH 3); - ((Wp, H_Heavy, Phim), Vector_Scalar_Scalar 1, G_GH 6); - ((Wm, H_Heavy, Phip), Vector_Scalar_Scalar (-1), G_GH 6); - ((Wp, H_Light, Phim), Vector_Scalar_Scalar (-1), G_GH 7); - ((Wm, H_Light, Phip), Vector_Scalar_Scalar 1, G_GH 7); - ((Phim, Wp, Ga), Scalar_Vector_Vector 1, G_GHGo 1); - ((Phip, Wm, Ga), Scalar_Vector_Vector 1, G_GHGo 1); - ((Phim, Wp, Z), Scalar_Vector_Vector 1, G_GHGo 2); - ((Phip, Wm, Z), Scalar_Vector_Vector 1, G_GHGo 2); - ((Z, Phip, Phim), Vector_Scalar_Scalar 1, G_GH 10); - ((Ga, Phip, Phim), Vector_Scalar_Scalar 1, G_GH 11) ] - - let gauge_higgs4 = - [ ((A, A, Z, Z), Scalar2_Vector2 1, G_GH4 1); - ((H_Heavy, H_Heavy, Z, Z), Scalar2_Vector2 1, G_GH4 3); - ((H_Light, H_Light, Z, Z), Scalar2_Vector2 1, G_GH4 2); - ((Hp, Hm, Z, Z), Scalar2_Vector2 1, G_GH4 4); - ((Hp, Hm, Ga, Ga), Scalar2_Vector2 1, G_GH4 5); - ((Hp, Hm, Ga, Z), Scalar2_Vector2 1, G_GH4 6); - ((Hp, H_Heavy, Wm, Z), Scalar2_Vector2 1, G_GH4 8); - ((Hm, H_Heavy, Wp, Z), Scalar2_Vector2 1, G_GH4 8); - ((Hp, H_Light, Wm, Z), Scalar2_Vector2 1, G_GH4 7); - ((Hm, H_Light, Wp, Z), Scalar2_Vector2 1, G_GH4 7); - ((Hp, H_Heavy, Wm, Ga), Scalar2_Vector2 1, G_GH4 10); - ((Hm, H_Heavy, Wp, Ga), Scalar2_Vector2 1, G_GH4 10); - ((Hp, H_Light, Wm, Ga), Scalar2_Vector2 1, G_GH4 9); - ((Hm, H_Light, Wp, Ga), Scalar2_Vector2 1, G_GH4 9); - ((A, A, Wp, Wm), Scalar2_Vector2 1, G_GH4 11); - ((H_Heavy, H_Heavy, Wp, Wm), Scalar2_Vector2 1, G_GH4 13); - ((H_Light, H_Light, Wp, Wm), Scalar2_Vector2 1, G_GH4 12); - ((Hp, Hm, Wp, Wm), Scalar2_Vector2 1, G_GH4 14); - ((Hp, A, Wm, Z), Scalar2_Vector2 1, G_GH4 15); - ((Hm, A, Wp, Z), Scalar2_Vector2 (-1), G_GH4 15); - ((Hp, A, Wm, Ga), Scalar2_Vector2 1, G_GH4 16); - ((Hm, A, Wp, Ga), Scalar2_Vector2 (-1), G_GH4 16) ] - - let gauge_higgs_gold4 = - [ ((Z, Z, Phi0, Phi0), Scalar2_Vector2 1, G_GHGo4 1); - ((Z, Z, Phip, Phim), Scalar2_Vector2 1, G_GHGo4 2); - ((Ga, Ga, Phip, Phim), Scalar2_Vector2 1, G_GHGo4 3); - ((Z, Ga, Phip, Phim), Scalar2_Vector2 1, G_GHGo4 4); - ((Wp, Wm, Phip, Phim), Scalar2_Vector2 1, G_GHGo4 5); - ((Wp, Wm, Phi0, Phi0), Scalar2_Vector2 1, G_GHGo4 5); - ((Wp, Z, Phim, Phi0), Scalar2_Vector2 1, G_GHGo4 6); - ((Wm, Z, Phip, Phi0), Scalar2_Vector2 (-1), G_GHGo4 6); - ((Wp, Ga, Phim, Phi0), Scalar2_Vector2 1, G_GHGo4 7); - ((Wm, Ga, Phip, Phi0), Scalar2_Vector2 (-1), G_GHGo4 7); - ((Wp, Z, Phim, H_Heavy), Scalar2_Vector2 1, G_GHGo4 9); - ((Wm, Z, Phip, H_Heavy), Scalar2_Vector2 1, G_GHGo4 9); - ((Wp, Ga, Phim, H_Heavy), Scalar2_Vector2 1, G_GHGo4 11); - ((Wm, Ga, Phip, H_Heavy), Scalar2_Vector2 1, G_GHGo4 11); - ((Wp, Z, Phim, H_Light), Scalar2_Vector2 1, G_GHGo4 8); - ((Wm, Z, Phip, H_Light), Scalar2_Vector2 1, G_GHGo4 8); - ((Wp, Ga, Phim, H_Light), Scalar2_Vector2 1, G_GHGo4 10); - ((Wm, Ga, Phip, H_Light), Scalar2_Vector2 1, G_GHGo4 10) ] - - let gauge_sfermion4' g m1 m2 = - [ ((Wp, Wm, Slepton (m1,g), Slepton (m2,-g)), Scalar2_Vector2 1, - G_WWSFSF (SL,g,m1,m2)); - ((Z, Ga, Slepton (m1,g), Slepton (m2,-g)), Scalar2_Vector2 1, - G_ZPSFSF (SL,g,m1,m2)); - ((Z, Z, Slepton (m1,g), Slepton (m2,-g)), Scalar2_Vector2 1, G_ZZSFSF - (SL,g,m1,m2)); - ((Wp, Wm, Sup (m1,g), Sup (m2,-g)), Scalar2_Vector2 1, G_WWSFSF - (SU,g,m1,m2)); - ((Wp, Wm, Sdown (m1,g), Sdown (m2,-g)), Scalar2_Vector2 1, G_WWSFSF - (SD,g,m1,m2)); - ((Z, Z, Sup (m1,g), Sup (m2,-g)), Scalar2_Vector2 1, G_ZZSFSF - (SU,g,m1,m2)); - ((Z, Z, Sdown (m1,g), Sdown (m2,-g)), Scalar2_Vector2 1, G_ZZSFSF - (SD,g,m1,m2)); - ((Z, Ga, Sup (m1,g), Sup (m2,-g)), Scalar2_Vector2 1, G_ZPSFSF - (SU,g,m1,m2)); - ((Z, Ga, Sdown (m1,g), Sdown (m2,-g)), Scalar2_Vector2 1, G_ZPSFSF - (SD,g,m1,m2)) ] - let gauge_sfermion4'' g m = - [ ((Wp, Ga, Slepton (m,g), Sneutrino (-g)), Scalar2_Vector2 1, G_WPSLSN - (false,g,m)); - ((Wm, Ga, Slepton (m,-g), Sneutrino g), Scalar2_Vector2 1, - G_WPSLSN (true,g,m)); - ((Wp, Z, Slepton (m,g), Sneutrino (-g)), Scalar2_Vector2 1, G_WZSLSN - (false,g,m)); - ((Wm, Z, Slepton (m,-g), Sneutrino g), Scalar2_Vector2 1, - G_WZSLSN (true,g,m)); - ((Ga, Ga, Slepton (m,g), Slepton (m,-g)), Scalar2_Vector2 1, G_PPSFSF SL); - ((Ga, Ga, Sup (m,g), Sup (m,-g)), Scalar2_Vector2 1, G_PPSFSF SU); - ((Ga, Ga, Sdown (m,g), Sdown (m,-g)), Scalar2_Vector2 1, G_PPSFSF SD)] - let gauge_sfermion4 g = - List.flatten (Product.list2 (gauge_sfermion4' g) [M1;M2] [M1;M2]) @ - ThoList.flatmap (gauge_sfermion4'' g) [M1;M2] @ - [ ((Wp, Wm, Sneutrino g, Sneutrino (-g)), Scalar2_Vector2 1, G_WWSFSF - (SN,g,M1,M1)); - ((Z, Z, Sneutrino g, Sneutrino (-g)), Scalar2_Vector2 1, G_ZZSFSF - (SN,g,M1,M1)) ] - - let gauge_squark4' g h m1 m2 = - [ ((Wp, Ga, Sup (m1,-g), Sdown (m2,h)), Scalar2_Vector2 1, G_WPSUSD - (false,m1,m2,g,h)); - ((Wm, Ga, Sup (m1,g), Sdown (m2,-h)), Scalar2_Vector2 1, G_WPSUSD - (true,m1,m2,g,h)); - ((Wp, Z, Sup (m1,-g), Sdown (m2,h)), Scalar2_Vector2 1, G_WZSUSD - (false,m1,m2,g,h)); - ((Wm, Z, Sup (m1,g), Sdown (m2,-h)), Scalar2_Vector2 1, G_WZSUSD - (true,m1,m2,g,h)) ] - let gauge_squark4 g h = List.flatten (Product.list2 (gauge_squark4' g h) - [M1;M2] [M1;M2]) - - let gluon_w_squark' g h m1 m2 = - [ ((Gl, Wp, Sup (m1,-g), Sdown (m2,h)), - Scalar2_Vector2 1, G_GlWSUSD (false,m1,m2,g,h)); - ((Gl, Wm, Sup (m1,g), Sdown (m2,-h)), - Scalar2_Vector2 1, G_GlWSUSD (true,m1,m2,g,h)) ] - let gluon_w_squark g h = - List.flatten (Product.list2 (gluon_w_squark' g h) [M1;M2] [M1;M2]) - - let gluon_gauge_squark' g m1 m2 = - [ ((Gl, Z, Sup (m1,g), Sup (m2,-g)), Scalar2_Vector2 2, G_GlZSFSF (SU,g,m1,m2)); - ((Gl, Z, Sdown (m1,g), Sdown (m2,-g)), Scalar2_Vector2 2, G_GlZSFSF (SD,g,m1,m2)) ] - let gluon_gauge_squark'' g m = - [ ((Gl, Ga, Sup (m,g), Sup (m,-g)), Scalar2_Vector2 2, G_GlPSQSQ); - ((Gl, Ga, Sdown (m,g), Sdown (m,-g)), Scalar2_Vector2 (-1), G_GlPSQSQ) ] - let gluon_gauge_squark g = - List.flatten (Product.list2 (gluon_gauge_squark' g) [M1;M2] [M1;M2]) @ - ThoList.flatmap (gluon_gauge_squark'' g) [M1;M2] - - let gluon2_squark2 g m = - [ ((Gl, Gl, Sup (m,g), Sup (m,-g)), Scalar2_Vector2 1, G_GlGlSQSQ); - ((Gl, Gl, Sdown (m,g), Sdown (m,-g)), Scalar2_Vector2 1, G_GlGlSQSQ)] - -(*** REVISED: Independent of the sign of CD. ***) - let higgs = - [ ((Hp, Hm, H_Heavy), Scalar_Scalar_Scalar 1, G_H3 1); - ((Hp, Hm, H_Light), Scalar_Scalar_Scalar 1, G_H3 2); - ((H_Heavy, H_Heavy, H_Light), Scalar_Scalar_Scalar 1, G_H3 3); - ((H_Heavy, H_Heavy, H_Heavy), Scalar_Scalar_Scalar 1, G_H3 4); - ((H_Light, H_Light, H_Light), Scalar_Scalar_Scalar 1, G_H3 5); - ((H_Heavy, H_Light, H_Light), Scalar_Scalar_Scalar 1, G_H3 6); - ((H_Heavy, A, A), Scalar_Scalar_Scalar 1, G_H3 7); - ((H_Light, A, A), Scalar_Scalar_Scalar 1, G_H3 8) ] - -(*** REVISED: Compatible with GS+, independent of the sign of CD. ***) - let higgs_gold = - [ ((H_Heavy, A, Phi0), Scalar_Scalar_Scalar 1, G_HGo3 1); - ((H_Light, A, Phi0), Scalar_Scalar_Scalar 1, G_HGo3 2); - ((H_Heavy, Hp, Phim), Scalar_Scalar_Scalar 1, G_HGo3 3); - ((H_Heavy, Hm, Phip), Scalar_Scalar_Scalar 1, G_HGo3 3); - ((H_Light, Hp, Phim), Scalar_Scalar_Scalar 1, G_HGo3 4); - ((H_Light, Hm, Phip), Scalar_Scalar_Scalar 1, G_HGo3 4); - ((A, Hp, Phim), Scalar_Scalar_Scalar (-1), G_HGo3 5); - ((A, Hm, Phip), Scalar_Scalar_Scalar 1, G_HGo3 5); - ((H_Heavy, Phi0, Phi0), Scalar_Scalar_Scalar (-1), G_H3 7); - ((H_Heavy, Phip, Phim), Scalar_Scalar_Scalar (-1), G_H3 7); - ((H_Light, Phi0, Phi0), Scalar_Scalar_Scalar (-1), G_H3 8); - ((H_Light, Phip, Phim), Scalar_Scalar_Scalar (-1), G_H3 8) ] - -(* Here follow purely scalar quartic vertices which are only available for the - no-Whizard colored version. *) - -(*** REVISED: Independent of the sign of CD. ***) - let higgs4 = - [ ((Hp, Hm, Hp, Hm), Scalar4 1, G_H4 1); - ((Hp, Hm, H_Heavy, H_Heavy), Scalar4 1, G_H4 2); - ((Hp, Hm, H_Light, H_Light), Scalar4 1, G_H4 3); - ((Hp, Hm, H_Heavy, H_Light), Scalar4 1, G_H4 4); - ((Hp, Hm, A, A), Scalar4 1, G_H4 5); - ((H_Heavy, H_Heavy, H_Heavy, H_Heavy), Scalar4 1, G_H4 6); - ((H_Light, H_Light, H_Light, H_Light), Scalar4 1, G_H4 6); - ((H_Heavy, H_Heavy, H_Light, H_Light), Scalar4 1, G_H4 7); - ((H_Heavy, H_Light, H_Light, H_Light), Scalar4 1, G_H4 8); - ((H_Heavy, H_Heavy, H_Heavy, H_Light), Scalar4 (-1), G_H4 8); - ((H_Heavy, H_Heavy, A, A), Scalar4 1, G_H4 9); - ((H_Light, H_Light, A, A), Scalar4 (-1), G_H4 9); - ((H_Heavy, H_Light, A, A), Scalar4 1, G_H4 10); - ((A, A, A, A), Scalar4 1, G_H4 11) ] - -(*** REVISED: Compatible with GS+, independent of the sign of CD. ***) - let higgs_gold4 = - [ ((H_Heavy, H_Heavy, A, Phi0), Scalar4 1, G_HGo4 1); - ((H_Heavy, H_Light, A, Phi0), Scalar4 1, G_HGo4 2); - ((H_Light, H_Light, A, Phi0), Scalar4 (-1), G_HGo4 1); - ((A, A, A, Phi0), Scalar4 3, G_HGo4 3); - ((Hp, Hm, A, Phi0), Scalar4 1, G_HGo4 3); - ((H_Heavy, H_Heavy, Hp, Phim), Scalar4 1, G_HGo4 4); - ((H_Heavy, H_Heavy, Hm, Phip), Scalar4 1, G_HGo4 4); - ((H_Heavy, H_Light, Hp, Phim), Scalar4 1, G_HGo4 5); - ((H_Heavy, H_Light, Hm, Phip), Scalar4 1, G_HGo4 5); - ((H_Light, H_Light, Hp, Phim), Scalar4 (-1), G_HGo4 4); - ((H_Light, H_Light, Hm, Phip), Scalar4 (-1), G_HGo4 4); - ((A, A, Hp, Phim), Scalar4 1, G_HGo4 6); - ((A, A, Hm, Phip), Scalar4 1, G_HGo4 6); - ((H_Heavy, A, Hp, Phim), Scalar4 1, G_HGo4 7); - ((H_Heavy, A, Hm, Phip), Scalar4 (-1), G_HGo4 7); - ((H_Light, A, Hp, Phim), Scalar4 1, G_HGo4 8); - ((H_Light, A, Hm, Phip), Scalar4 (-1), G_HGo4 8); - ((Hp, Hm, Hp, Phim), Scalar4 2, G_HGo4 6); - ((Hp, Hm, Hm, Phip), Scalar4 2, G_HGo4 6); - ((H_Heavy, H_Heavy, Phi0, Phi0), Scalar4 (-1), G_H4 9); - ((H_Heavy, H_Light, Phi0, Phi0), Scalar4 (-1), G_H4 10); - ((H_Light, H_Light, Phi0, Phi0), Scalar4 1, G_H4 9); - ((A, A, Phi0, Phi0), Scalar4 1, G_HGo4 9); - ((Hp, Hm, Phi0, Phi0), Scalar4 1, G_HGo4 10); - ((H_Heavy, Hp, Phim, Phi0), Scalar4 1, G_HGo4 8); - ((H_Heavy, Hm, Phip, Phi0), Scalar4 (-1), G_HGo4 8); - ((H_Light, Hp, Phim, Phi0), Scalar4 (-1), G_HGo4 7); - ((H_Light, Hm, Phip, Phi0), Scalar4 1, G_HGo4 7); - ((A, Hp, Phim, Phi0), Scalar4 1, G_HGo4 11); - ((A, Hm, Phip, Phi0), Scalar4 1, G_HGo4 11); - ((H_Heavy, H_Heavy, Phip, Phim), Scalar4 1, G_HGo4 12); - ((H_Heavy, H_Light, Phip, Phim), Scalar4 1, G_HGo4 13); - ((H_Light, H_Light, Phip, Phim), Scalar4 1, G_HGo4 14); - ((A, A, Phip, Phim), Scalar4 1, G_HGo4 15); - ((Hp, Hm, Phip, Phim), Scalar4 1, G_HGo4 16); - ((Hp, Hp, Phim, Phim), Scalar4 1, G_HGo4 17); - ((Hm, Hm, Phip, Phip), Scalar4 1, G_HGo4 17); - ((Hp, Phim, Phi0, Phi0), Scalar4 (-1), G_HGo4 6); - ((Hm, Phip, Phi0, Phi0), Scalar4 (-1), G_HGo4 6); - ((A, Phi0, Phi0, Phi0), Scalar4 (-3), G_HGo4 6); - ((A, Phi0, Phip, Phim), Scalar4 (-1), G_HGo4 6); - ((Hp, Phim, Phip, Phim), Scalar4 (-2), G_HGo4 6); - ((Hm, Phip, Phip, Phim), Scalar4 (-2), G_HGo4 6) ] - -(*** REVISED: Independent of the sign of CD and GS. ***) - let goldstone4 = - [ ((Phi0, Phi0, Phi0, Phi0), Scalar4 1, G_GG4 1); - ((Phip, Phim, Phi0, Phi0), Scalar4 1, G_GG4 2); - ((Phip, Phim, Phip, Phim), Scalar4 1, G_GG4 3) ] - -(* The vertices of the type Higgs - Sfermion - Sfermion are independent of - the choice of the CD sign since they are quadratic in the gauge - coupling. *) - -(*** REVISED: Independent of the sign of CD. ***) - let higgs_sneutrino' g = - [ ((H_Heavy, Sneutrino g, Sneutrino (-g)), Scalar_Scalar_Scalar 1, - G_H2SFSF (SN,g,M1,M1)); - ((H_Light, Sneutrino g, Sneutrino (-g)), Scalar_Scalar_Scalar 1, - G_H1SFSF (SN,g,M1,M1)); - ((Hp, Sneutrino (-g), Slepton (M1,g)), Scalar_Scalar_Scalar 1, - G_HSNSL (false,g,M1)); - ((Hm, Sneutrino g, Slepton (M1,-g)), Scalar_Scalar_Scalar 1, - G_HSNSL (true,g,M1)) ] - let higgs_sneutrino'' = - [ ((Hp, Sneutrino (-3), Slepton (M2,3)), Scalar_Scalar_Scalar 1, - G_HSNSL (false,3,M2)); - ((Hm, Sneutrino 3, Slepton (M2,-3)), Scalar_Scalar_Scalar 1, - G_HSNSL (false,3,M2)) ] - let higgs_sneutrino = - ThoList.flatmap higgs_sneutrino' [1;2;3] @ higgs_sneutrino'' - - -(* Under the assumption that there is no mixing between the left- and - right-handed sfermions for the first two generations there is only a - coupling of the form Higgs - sfermion1 - sfermion2 for the third - generation. All the others are suppressed by $m_f/M_W$. *) - -(*** REVISED: Independent of the sign of CD. ***) - let higgs_sfermion' g m1 m2 = - [ ((H_Heavy, Slepton (m1,g), Slepton (m2,-g)), Scalar_Scalar_Scalar 1, - G_H2SFSF (SL,g,m1,m2)); - ((H_Light, Slepton (m1,g), Slepton (m2,-g)), Scalar_Scalar_Scalar 1, - G_H1SFSF (SL,g,m1,m2)); - ((H_Heavy, Sup (m1,g), Sup (m2,-g)), Scalar_Scalar_Scalar 1, - G_H2SFSF (SU,g,m1,m2)); - ((H_Heavy, Sdown (m1,g), Sdown (m2,-g)), Scalar_Scalar_Scalar 1, - G_H2SFSF (SD,g,m1,m2)); - ((H_Light, Sup (m1,g), Sup (m2,-g)), Scalar_Scalar_Scalar 1, - G_H1SFSF (SU,g,m1,m2)); - ((H_Light, Sdown (m1,g), Sdown (m2,-g)), Scalar_Scalar_Scalar 1, - G_H1SFSF (SD,g,m1,m2)) ] - let higgs_sfermion'' m1 m2 = - [ ((A, Slepton (m1,3), Slepton (m2,-3)), Scalar_Scalar_Scalar 1, - G_ASFSF (SL,3,m1,m2)); - ((A, Sup (m1,3), Sup (m2,-3)), Scalar_Scalar_Scalar 1, - G_ASFSF (SU,3,m1,m2)); - ((A, Sdown (m1,3), Sdown (m2,-3)), Scalar_Scalar_Scalar 1, - G_ASFSF (SD,3,m1,m2)) ] - let higgs_sfermion = List.flatten (Product.list2 (higgs_sfermion' 3) - [M1;M2] [M1;M2]) @ - (higgs_sfermion' 1 M1 M1) @ (higgs_sfermion' 1 M2 M2) @ - (higgs_sfermion' 2 M1 M1) @ (higgs_sfermion' 2 M2 M2) @ - List.flatten (Product.list2 higgs_sfermion'' [M1;M2] [M1;M2]) - -(*i let higgs_sfermion g = List.flatten (Product.list2 (higgs_sfermion' g) - [M1;M2] [M1;M2]) i*) - -(*** REVISED: Independent of the sign of CD, compatible with GS+. ***) - let goldstone_sfermion' g m1 m2 = - [ ((Phi0, Slepton (m1,g), Slepton (m2,-g)), Scalar_Scalar_Scalar 1, - G_GoSFSF (SL,g,m1,m2)); - ((Phi0, Sup (m1,g), Sup (m2,-g)), Scalar_Scalar_Scalar 1, - G_GoSFSF (SU,g,m1,m2)); - ((Phi0, Sdown (m1,g), Sdown (m2,-g)), Scalar_Scalar_Scalar 1, - G_GoSFSF (SD,g,m1,m2))] - let goldstone_sfermion'' g = - [ ((Phip, Sneutrino (-g), Slepton (M1,g)), Scalar_Scalar_Scalar 1, - G_GoSNSL (false,g,M1)); - ((Phim, Sneutrino g, Slepton (M1,-g)), Scalar_Scalar_Scalar 1, - G_GoSNSL (true,g,M1)) ] - let goldstone_sfermion''' g = - [ ((Phip, Sneutrino (-g), Slepton (M2,g)), Scalar_Scalar_Scalar 1, - G_GoSNSL (false,g,M2)); - ((Phim, Sneutrino g, Slepton (M2,-g)), Scalar_Scalar_Scalar 1, - G_GoSNSL (true,g,M2))] - let goldstone_sfermion = - List.flatten (Product.list2 (goldstone_sfermion' 3) [M1;M2] [M1;M2]) @ - ThoList.flatmap goldstone_sfermion'' [1;2;3] @ - goldstone_sfermion''' 3 - -(*** REVISED: Independent of the sign of CD. ***) - let higgs_squark' g h m1 m2 = - [ ((Hp, Sup (m1,-g), Sdown (m2,h)), Scalar_Scalar_Scalar 1, - G_HSUSD (false,m1,m2,g,h)); - ((Hm, Sup (m1,g), Sdown (m2,-h)), Scalar_Scalar_Scalar 1, - G_HSUSD (true,m1,m2,g,h)) ] - let higgs_squark_a g h = higgs_squark' g h M1 M1 - let higgs_squark_b (g,h) = List.flatten (Product.list2 (higgs_squark' g h) - [M1;M2] [M1;M2]) - let higgs_squark = - List.flatten (Product.list2 higgs_squark_a [1;2] [1;2]) @ - ThoList.flatmap higgs_squark_b [(1,3);(2,3);(3,3);(3,1);(3,2)] - -(*** REVISED: Independent of the sign of CD, compatible with GS+. ***) - let goldstone_squark' g h m1 m2 = - [ ((Phip, Sup (m1,-g), Sdown (m2,h)), Scalar_Scalar_Scalar 1, - G_GSUSD (false,m1,m2,g,h)); - ((Phim, Sup (m1,g), Sdown (m2,-h)), Scalar_Scalar_Scalar 1, - G_GSUSD (true,m1,m2,g,h)) ] - let goldstone_squark_a g h = goldstone_squark' g h M1 M1 - let goldstone_squark_b (g,h) = List.flatten (Product.list2 - (goldstone_squark' g h) [M1;M2] [M1;M2]) - let goldstone_squark = - List.flatten (Product.list2 goldstone_squark_a [1;2] [1;2]) @ - ThoList.flatmap goldstone_squark_b [(1,3);(2,3);(3,3);(3,1);(3,2)] - -(* BAUSTELLE: For the quartic scalar coupligs we does not allow [whiz_col]. *) - - let higgs_sneutrino4' g m = - [ ((Hp, H_Heavy, Slepton (m,g), Sneutrino (-g)), Scalar4 1, - G_HH2SLSN (false,m,g)); - ((Hm, H_Heavy, Slepton (m,-g), Sneutrino g), Scalar4 1, - G_HH2SLSN (true,m,g)); - ((Hp, H_Light, Slepton (m,g), Sneutrino (-g)), Scalar4 1, - G_HH1SLSN (false,m,g)); - ((Hm, H_Light, Slepton (m,-g), Sneutrino g), Scalar4 1, - G_HH1SLSN (true,m,g)); - ((Hp, A, Slepton (m,g), Sneutrino (-g)), Scalar4 1, - G_HASLSN (false,m,g)); - ((Hm, A, Slepton (m,-g), Sneutrino g), Scalar4 1, - G_HASLSN (true,m,g)) ] - let higgs_sneutrino4 g = - ThoList.flatmap (higgs_sneutrino4' g) [M1;M2] @ - [ ((H_Heavy, H_Heavy, Sneutrino g, Sneutrino (-g)), Scalar4 1, - G_H2H2SFSF (SN,M1,M1,g)); - ((H_Heavy, H_Light, Sneutrino g, Sneutrino (-g)), Scalar4 1, - G_H1H2SFSF (SN,M1,M1,g)); - ((H_Light, H_Light, Sneutrino g, Sneutrino (-g)), Scalar4 1, - G_H1H1SFSF (SN,M1,M1,g)); - ((Hp, Hm, Sneutrino g, Sneutrino (-g)), Scalar4 1, G_HHSFSF (SN,M1,M1,g)) ] - - let higgs_sfermion4' g m1 m2 = - [ ((H_Heavy, H_Heavy, Slepton (m1,g), Slepton (m2,-g)), Scalar4 1, - G_H2H2SFSF (SL,m1,m2,g)); - ((H_Heavy, H_Light, Slepton (m1,g), Slepton (m2,-g)), Scalar4 1, - G_H1H2SFSF (SL,m1,m2,g)); - ((H_Light, H_Light, Slepton (m1,g), Slepton (m2,-g)), Scalar4 1, - G_H1H1SFSF (SL,m1,m2,g)); - ((A, A, Slepton (m1,g), Slepton (m2,-g)), Scalar4 1, - G_AASFSF (SL,m1,m2,g)); - ((Hp, Hm, Slepton (m1,g), Slepton (m2,-g)), Scalar4 1, - G_HHSFSF (SL,m1,m2,g)); - ((H_Heavy, H_Heavy, Sup (m1,g), Sup (m2,-g)), Scalar4 1, - G_H2H2SFSF (SU,m1,m2,g)); - ((H_Heavy, H_Heavy, Sdown (m1,g), Sdown (m2,-g)), Scalar4 1, - G_H2H2SFSF (SD,m1,m2,g)); - ((H_Light, H_Light, Sup (m1,g), Sup (m2,-g)), Scalar4 1, - G_H1H1SFSF (SU,m1,m2,g)); - ((H_Light, H_Light, Sdown (m1,g), Sdown (m2,-g)), Scalar4 1, - G_H1H1SFSF (SD,m1,m2,g)); - ((H_Light, H_Heavy, Sup (m1,g), Sup (m2,-g)), Scalar4 1, - G_H1H2SFSF (SU,m1,m2,g)); - ((H_Light, H_Heavy, Sdown (m1,g), Sdown (m2,-g)), Scalar4 1, - G_H1H2SFSF (SD,m1,m2,g)); - ((Hp, Hm, Sup (m1,g), Sup (m2,-g)), Scalar4 1, G_HHSFSF (SU,m1,m2,g)); - ((Hp, Hm, Sdown (m1,g), Sdown (m2,-g)), Scalar4 1, G_HHSFSF (SD,m1,m2,g)); - ((A, A, Sup (m1,g), Sup (m2,-g)), Scalar4 1, G_AASFSF (SU,m1,m2,g)); - ((A, A, Sdown (m1,g), Sdown (m2,-g)), Scalar4 1, G_AASFSF (SD,m1,m2,g)) ] - let higgs_sfermion4 g = List.flatten (Product.list2 (higgs_sfermion4' g) - [M1;M2] [M1;M2]) - - let higgs_squark4' g h m1 m2 = - [ ((Hp, H_Light, Sup (m1,-g), Sdown (m2,h)), Scalar4 1, - G_HH1SUSD (false,m1,m2,g,h)); - ((Hm, H_Light, Sup (m1,g), Sdown (m2,-h)), Scalar4 1, - G_HH1SUSD (true,m1,m2,g,h)); - ((Hp, H_Heavy, Sup (m1,-g), Sdown (m2,h)), Scalar4 1, - G_HH2SUSD (false,m1,m2,g,h)); - ((Hm, H_Heavy, Sup (m1,g), Sdown (m2,-h)), Scalar4 1, - G_HH2SUSD (true,m1,m2,g,h)); - ((Hp, A, Sup (m1,-g), Sdown (m2,h)), Scalar4 1, - G_HASUSD (false,m1,m2,g,h)); - ((Hm, A, Sup (m1,g), Sdown (m2,-h)), Scalar4 1, - G_HASUSD (true,m1,m2,g,h)) ] - let higgs_squark4 g h = List.flatten (Product.list2 (higgs_squark4' g h) - [M1;M2] [M1;M2]) - - let higgs_gold_sneutrino' g m = - [ ((Hp, Phi0, Sneutrino (-g), Slepton (m,g)), Scalar4 1, G_HGSNSL (false,m,g)); - ((Hm, Phi0, Sneutrino g, Slepton (m,-g)), Scalar4 1, G_HGSNSL (true,m,g)); - ((H_Heavy, Phip, Sneutrino (-g), Slepton (m,g)), Scalar4 1, - G_H2GSNSL (false,m,g)); - ((H_Heavy, Phim, Sneutrino g, Slepton (m,-g)), Scalar4 1, - G_H2GSNSL (true,m,g)); - ((H_Light, Phip, Sneutrino (-g), Slepton (m,g)), Scalar4 1, - G_H1GSNSL (false,m,g)); - ((H_Light, Phim, Sneutrino g, Slepton (m,-g)), Scalar4 1, - G_H1GSNSL (true,m,g)); - ((A, Phip, Sneutrino (-g), Slepton (m,g)), Scalar4 1, G_AGSNSL (false,m,g)); - ((A, Phim, Sneutrino g, Slepton (m,-g)), Scalar4 1, G_AGSNSL (true,m,g)); - ((Phi0, Phip, Sneutrino (-g), Slepton (m,g)), Scalar4 1, G_GGSNSL (false,m,g)); - ((Phi0, Phim, Sneutrino g, Slepton (m,-g)), Scalar4 1, G_GGSNSL (true,m,g))] - let higgs_gold_sneutrino g = - ThoList.flatmap (higgs_gold_sneutrino' g) [M1;M2] @ - [ ((A, Phi0, Sneutrino g, Sneutrino (-g)), Scalar4 1, - G_AG0SFSF (SN,M1,M1,g)); - ((Hp, Phim, Sneutrino g, Sneutrino (-g)), Scalar4 1, - G_HGSFSF (SN,M1,M1,g)); - ((Hm, Phip, Sneutrino g, Sneutrino (-g)), Scalar4 1, - G_HGSFSF (SN,M1,M1,g)); - ((Phip, Phim, Sneutrino g, Sneutrino (-g)), Scalar4 1, - G_GGSFSF (SN,M1,M1,g)); - ((Phi0, Phi0, Sneutrino g, Sneutrino (-g)), Scalar4 1, - G_G0G0SFSF (SN,M1,M1,g)) ] - - let higgs_gold_sfermion' g m1 m2 = - [ ((A, Phi0, Slepton (m1,g), Slepton (m2,-g)), Scalar4 1, - G_AG0SFSF (SL,m1,m2,g)); - ((Hp, Phim, Slepton (m1,g), Slepton (m2,-g)), Scalar4 1, - G_HGSFSF (SL,m1,m2,g)); - ((Hm, Phip, Slepton (m1,g), Slepton (m2,-g)), Scalar4 1, - G_HGSFSF (SL,m1,m2,g)); - ((Phip, Phim, Slepton (m1,g), Slepton (m2,-g)), Scalar4 1, - G_GGSFSF (SL,m1,m2,g)); - ((Phi0, Phi0, Slepton (m1,g), Slepton (m2,-g)), Scalar4 1, - G_G0G0SFSF (SL,m1,m2,g)); - ((A, Phi0, Sup (m1,g), Sup (m2,-g)), Scalar4 1, G_AG0SFSF (SU,m1,m2,g)); - ((A, Phi0, Sdown (m1,g), Sdown (m2,-g)), Scalar4 1, - G_AG0SFSF (SD,m1,m2,g)); - ((Hp, Phim, Sup (m1,g), Sup (m2,-g)), Scalar4 1, G_HGSFSF (SU,m1,m2,g)); - ((Hm, Phip, Sup (m1,g), Sup (m2,-g)), Scalar4 1, G_HGSFSF (SU,m1,m2,g)); - ((Hp, Phim, Sdown (m1,g), Sdown (m2,-g)), Scalar4 1, - G_HGSFSF (SD,m1,m2,g)); - ((Hm, Phip, Sdown (m1,g), Sdown (m2,-g)), Scalar4 1, - G_HGSFSF (SD,m1,m2,g)); - ((Phip, Phim, Sup (m1,g), Sup (m2,-g)), Scalar4 1, - G_GGSFSF (SU,m1,m2,g)); - ((Phip, Phim, Sdown (m1,g), Sdown (m2,-g)), Scalar4 1, - G_GGSFSF (SD,m1,m2,g)); - ((Phi0, Phi0, Sup (m1,g), Sup (m2,-g)), Scalar4 1, - G_G0G0SFSF (SU,m1,m2,g)); - ((Phi0, Phi0, Sdown (m1,g), Sdown (m2,-g)), Scalar4 1, - G_G0G0SFSF (SD,m1,m2,g)) ] - let higgs_gold_sfermion g = List.flatten (Product.list2 - (higgs_gold_sfermion' g) [M1;M2] [M1;M2]) - - let higgs_gold_squark' g h m1 m2 = - [ ((Hp, Phi0, Sup (m1,-g), Sdown (m2,h)), Scalar4 1, - G_HGSUSD (false,m1,m2,g,h)); - ((Hm, Phi0, Sup (m1,g), Sdown (m2,-h)), Scalar4 1, - G_HGSUSD (true,m1,m2,g,h)); - ((H_Heavy, Phip, Sup (m1,-g), Sdown (m2,h)), Scalar4 1, - G_H2GSUSD (false,m1,m2,g,h)); - ((H_Heavy, Phim, Sup (m1,g), Sdown (m2,-h)), Scalar4 1, - G_H2GSUSD (true,m1,m2,g,h)); - ((H_Light, Phip, Sup (m1,-g), Sdown (m2,h)), Scalar4 1, - G_H1GSUSD (false,m1,m2,g,h)); - ((H_Light, Phim, Sup (m1,g), Sdown (m2,-h)), Scalar4 1, - G_H1GSUSD (true,m1,m2,g,h)); - ((A, Phip, Sup (m1,-g), Sdown (m2,h)), Scalar4 1, - G_AGSUSD (false,m1,m2,g,h)); - ((A, Phim, Sup (m1,g), Sdown (m2,-h)), Scalar4 1, - G_AGSUSD (true,m1,m2,g,h)); - ((Phi0, Phip, Sup (m1,-g), Sdown (m2,h)), Scalar4 1, - G_GGSUSD (false,m1,m2,g,h)); - ((Phi0, Phim, Sup (m1,g), Sdown (m2,-h)), Scalar4 1, - G_GGSUSD (true,m1,m2,g,h)) ] - let higgs_gold_squark g h = List.flatten (Product.list2 (higgs_gold_squark' - g h) [M1;M2] [M1;M2]) - - let sneutrino4' (g,h) = - [ ((Sneutrino g, Sneutrino h, Sneutrino (-g), Sneutrino (-h)), Scalar4 1, - G_SN4 (g,h))] - let sneutrino4 = ThoList.flatmap sneutrino4' - [(1,1);(1,2);(1,3);(2,2);(2,3);(3,3)] - - let sneu2_slep2_1' g h m1 m2 = - ((Sneutrino (-g), Sneutrino g, Slepton (m1,-h), Slepton (m2,h)), Scalar4 1, - G_SN2SL2_1 (m1,m2,g,h)) - let sneu2_slep2_2' (g,h) m1 m2 = - ((Sneutrino g, Sneutrino (-h), Slepton (m1,-g), Slepton (m2,h)), Scalar4 1, - G_SN2SL2_2 (m1,m2,g,h)) - let sneu2_slep2_1 g h = Product.list2 (sneu2_slep2_1' g h) [M1;M2] [M1;M2] - let sneu2_slep2_2 (g,h) = Product.list2 (sneu2_slep2_2' (g,h)) [M1;M2] [M1;M2] - -(* The 4-slepton-vertices have the following structure: The sleptons come up in - pairs of a positive and a negative slepton of the same generation; there is - no vertex with e.g. two negative selectrons and two positive smuons, that of - course would be a contradiction to the conservation of the separate slepton - numbers of each generation which is not implemented in the MSSM. Because there - is no CKM-mixing for the sleptons (in case of massless neutrinos) we maximally - have two different generations of sleptons in a 4-slepton-vertex. *) - - let slepton4_1gen' g (m1,m2,m3,m4) = - [ ((Slepton (m1,-g), Slepton (m2,g), Slepton (m3,-g), Slepton (m4,g)), - Scalar4 1, G_SL4 (m1,m2,m3,m4,g)) ] - let slepton4_1gen g = ThoList.flatmap (slepton4_1gen' g) [(M1,M1,M1,M1); - (M1,M1,M1,M2); (M1,M1,M2,M1); (M1,M1,M2,M2); (M1,M2,M1,M2); (M1,M2,M2,M1); - (M1,M2,M2,M2); (M2,M1,M2,M2); (M2,M2,M2,M2) ] - let slepton4_2gen' (g,h) (m1,m2) (m3,m4) = - ((Slepton (m1,-g), Slepton (m2,g), Slepton (m3,-h), Slepton (m4,h)), - Scalar4 1, G_SL4_2 (m1,m2,m3,m4,g,h)) - let slepton4_2gen (g,h) = - Product.list2 (slepton4_2gen' (g,h)) [(M1,M1);(M1,M2);(M2,M1);(M2,M2)] - [(M1,M1);(M1,M2);(M2,M1);(M2,M2)] - - let sneu2_squark2' g h m1 m2 = - [ ((Sneutrino (-g), Sneutrino g, Sup (m1,-h), Sup (m2,h)), Scalar4 1, - G_SN2SQ2 (SU,m1,m2,g,h)); - ((Sneutrino (-g), Sneutrino g, Sdown (m1,-h), Sdown (m2,h)), Scalar4 1, - G_SN2SQ2 (SD,m1,m2,g,h)) ] - let sneu2_squark2 g h = List.flatten (Product.list2 (sneu2_squark2' g h) - [M1;M2] [M1;M2]) - - let slepton2_squark2'' g h m1 m2 m3 m4 = - [ ((Slepton (m1,-g), Slepton (m2,g), Sup (m3,-h), Sup (m4,h)), Scalar4 1, - G_SL2SQ2 (SU,m1,m2,m3,m4,g,h)); - ((Slepton (m1,-g), Slepton (m2,g), Sdown (m3,-h), Sdown (m4,h)), - Scalar4 1, G_SL2SQ2 (SD,m1,m2,m3,m4,g,h)) ] - let slepton2_squark2' g h m1 m2 = - List.flatten (Product.list2 (slepton2_squark2'' g h m1 m2) [M1;M2] [M1;M2]) - let slepton2_squark2 g h = - List.flatten (Product.list2 (slepton2_squark2' g h) [M1;M2] [M1;M2]) - - let slep_sneu_squark2'' g1 g2 g3 m1 m2 m3 = - [ ((Sup (m1,-g1), Sdown (m2,g2), Slepton (m3,-g3), Sneutrino g3), - Scalar4 1, G_SUSDSNSL (false,m1,m2,m3,g1,g2,g3)); - ((Sup (m1,g1), Sdown (m2,-g2), Slepton (m3,g3), Sneutrino (-g3)), - Scalar4 1, G_SUSDSNSL (true,m1,m2,m3,g1,g2,g3)) ] - let slep_sneu_squark2' g1 g2 g3 m1 = - List.flatten (Product.list2 (slep_sneu_squark2'' g1 g2 g3 m1) - [M1;M2] [M1;M2]) - let slep_sneu_squark2 g1 g2 = - List.flatten (Product.list2 (slep_sneu_squark2' g1 g2) [1;2;3] [M1;M2]) - -(* There are three kinds of 4-squark-vertices: Four up-Squarks, four down-squarks - or two up- and two down-squarks. *) - - let sup4_1gen' g (m1,m2,m3,m4) = - [ ((Sup (m1,-g), Sup (m2,g), Sup (m3,-g), Sup (m4,g)), Scalar4 1, - G_SU4 (m1,m2,m3,m4,g)) ] - let sup4_1gen g = ThoList.flatmap (sup4_1gen' g) [(M1,M1,M1,M1); - (M1,M1,M1,M2); (M1,M1,M2,M1); (M1,M1,M2,M2); (M1,M2,M1,M2); (M1,M2,M2,M1); - (M1,M2,M2,M2); (M2,M1,M2,M2); (M2,M2,M2,M2) ] - let sup4_2gen' (g,h) (m1,m2) (m3,m4) = - ((Sup (m1,-g), Sup (m2,g), Sup (m3,-h), Sup (m4,h)), Scalar4 1, - G_SU4_2 (m1,m2,m3,m4,g,h)) - let sup4_2gen (g,h) = - Product.list2 (sup4_2gen' (g,h)) [(M1,M1);(M1,M2);(M2,M1);(M2,M2)] - [(M1,M1);(M1,M2);(M2,M1);(M2,M2)] - - let sdown4_1gen' g (m1,m2,m3,m4) = - [ ((Sdown (m1,-g), Sdown (m2,g), Sdown (m3,-g), Sdown (m4,g)), Scalar4 1, - G_SD4 (m1,m2,m3,m4,g)) ] - let sdown4_1gen g = ThoList.flatmap (sdown4_1gen' g) [(M1,M1,M1,M1); - (M1,M1,M1,M2); (M1,M1,M2,M1); (M1,M1,M2,M2); (M1,M2,M1,M2); (M1,M2,M2,M1); - (M1,M2,M2,M2); (M2,M1,M2,M2); (M2,M2,M2,M2) ] - let sdown4_2gen' (g,h) (m1,m2) (m3,m4) = - ((Sdown (m1,-g), Sdown (m2,g), Sdown (m3,-h), Sdown (m4,h)), Scalar4 1, - G_SD4_2 (m1,m2,m3,m4,g,h)) - let sdown4_2gen (g,h) = - Product.list2 (sdown4_2gen' (g,h)) [(M1,M1);(M1,M2);(M2,M1);(M2,M2)] - [(M1,M1);(M1,M2);(M2,M1);(M2,M2)] - - let sup2_sdown2_3 g1 g2 g3 g4 m1 m2 m3 m4 = - ((Sup (m1,-g1), Sup (m2,g2), Sdown (m3,-g3), Sdown - (m4,g4)), Scalar4 1, G_SU2SD2 (m1,m2,m3,m4,g1,g2,g3,g4)) - let sup2_sdown2_2 g1 g2 g3 g4 m1 m2 = - Product.list2 (sup2_sdown2_3 g1 g2 g3 g4 m1 m2) [M1;M2] [M1;M2] - let sup2_sdown2_1 g1 g2 g3 g4 = - List.flatten (Product.list2 (sup2_sdown2_2 g1 g2 g3 g4) [M1;M2] [M1;M2]) - let sup2_sdown2 g1 g2 = - List.flatten (Product.list2 (sup2_sdown2_1 g1 g2) [1;2;3] [1;2;3]) - - let vertices3' = - (ThoList.flatmap electromagnetic_currents_3 [1;2;3] @ - ThoList.flatmap electromagnetic_currents_2 [C1;C2] @ - List.flatten (Product.list2 - electromagnetic_sfermion_currents [1;2;3] [M1;M2]) @ - ThoList.flatmap neutral_currents [1;2;3] @ - ThoList.flatmap neutral_sfermion_currents [1;2;3] @ - ThoList.flatmap charged_currents [1;2;3] @ - List.flatten (Product.list2 charged_slepton_currents [1;2;3] - [M1;M2]) @ - (if Flags.ckm_present then - List.flatten (Product.list2 charged_quark_currents [1;2;3] - [1;2;3]) @ - List.flatten (Product.list2 charged_squark_currents [1;2;3] - [1;2;3]) @ - ThoList.flatmap yukawa_higgs_quark [(1,3);(2,3);(3,3);(3,1);(3,2)] - else - charged_quark_currents 1 1 @ - charged_quark_currents 2 2 @ - charged_quark_currents 3 3 @ - charged_squark_currents 1 1 @ - charged_squark_currents 2 2 @ - charged_squark_currents 3 3 @ - ThoList.flatmap yukawa_higgs_quark [(3,3)]) @ -(*i ThoList.flatmap yukawa_higgs [1;2;3] @ i*) - yukawa_higgs 3 @ yukawa_n @ - ThoList.flatmap yukawa_c [C1;C2] @ - ThoList.flatmap yukawa_cq [C1;C2] @ - List.flatten (Product.list2 charged_chargino_currents [N1;N2;N3;N4] - [C1;C2]) @ triple_gauge @ - ThoList.flatmap neutral_Z_1 [(N1,N2);(N1,N3);(N1,N4);(N2,N3);(N2,N4); - (N3,N4)] @ - ThoList.flatmap neutral_Z_2 [N1;N2;N3;N4] @ - Product.list2 charged_Z [C1;C2] [C1;C2] @ - gauge_higgs @ higgs @ yukawa_higgs_2 @ -(*i List.flatten (Product.list2 yukawa_higgs_quark [1;2;3] [1;2;3]) @ i*) - List.flatten (Product.list2 higgs_charg_neutr [N1;N2;N3;N4] [C1;C2]) @ - higgs_neutr @ higgs_sneutrino @ higgs_sfermion @ -(*i ThoList.flatmap higgs_sfermion [1;2;3] @ i*) - higgs_squark @ yukawa_v @ - ThoList.flatmap col_currents [1;2;3] @ - List.flatten (Product.list2 col_sfermion_currents [1;2;3] [M1;M2])) - let vertices3 = - if Flags.include_goldstone then - (vertices3' @ yukawa_goldstone 3 @ - gauge_higgs_gold @ higgs_gold @ yukawa_goldstone_2 @ - (if Flags.ckm_present then - List.flatten (Product.list2 yukawa_goldstone_quark [1;2;3] - [1;2;3]) @ - List.flatten (Product.list2 goldstone_charg_neutr [N1;N2;N3;N4] - [C1;C2]) - else - yukawa_goldstone_quark 1 1 @ - yukawa_goldstone_quark 2 2 @ - yukawa_goldstone_quark 3 3) @ - goldstone_neutr @ goldstone_sfermion @ goldstone_squark) - else vertices3' - - -(* let vertices4 = [] *) - - let vertices4'' = - (quartic_gauge @ higgs4 @ gauge_higgs4 @ - ThoList.flatmap gauge_sfermion4 [1;2;3] @ - List.flatten (Product.list2 gauge_squark4 [1;2;3] [1;2;3]) @ - List.flatten (Product.list2 gluon2_squark2 [1;2;3] [M1;M2]) @ - List.flatten (Product.list2 gluon_w_squark [1;2;3] [1;2;3]) @ - ThoList.flatmap gluon_gauge_squark [1;2;3]) - let vertices4' = - if Flags.include_four then - (vertices4'' @ - ThoList.flatmap higgs_sfermion4 [1;2;3] @ - ThoList.flatmap higgs_sneutrino4 [1;2;3] @ - List.flatten (Product.list2 higgs_squark4 [1;2;3] [1;2;3]) @ - sneutrino4 @ - List.flatten (Product.list2 sneu2_slep2_1 [1;2;3] [1;2;3]) @ - ThoList.flatmap sneu2_slep2_2 [(1,2);(1,3);(2,3);(2,1);(3,1);(3,2)] @ - ThoList.flatmap slepton4_1gen [1;2;3] @ - ThoList.flatmap slepton4_2gen [(1,2);(1,3);(2,3)] @ - List.flatten (Product.list2 sneu2_squark2 [1;2;3] [1;2;3]) @ - List.flatten (Product.list2 slepton2_squark2 [1;2;3] [1;2;3]) @ - List.flatten (Product.list2 slep_sneu_squark2 [1;2;3] [1;2;3]) @ - ThoList.flatmap sup4_1gen [1;2;3] @ - ThoList.flatmap sup4_2gen [(1,2);(1,3);(2,3)] @ - ThoList.flatmap sdown4_1gen [1;2;3] @ - ThoList.flatmap sdown4_2gen [(1,2);(1,3);(2,3)] @ - List.flatten (Product.list2 sup2_sdown2 [1;2;3] [1;2;3]) ) - else - vertices4'' - let vertices4 = - if Flags.include_goldstone then - (vertices4' @ higgs_gold4 @ gauge_higgs_gold4 @ goldstone4 @ - ThoList.flatmap higgs_gold_sneutrino [1;2;3] @ - ThoList.flatmap higgs_gold_sfermion [1;2;3] @ - List.flatten (Product.list2 higgs_gold_squark [1;2;3] [1;2;3]) ) - else - vertices4' - - let vertices () = (vertices3, vertices4, []) - - let table = F.of_vertices (vertices ()) - let fuse2 = F.fuse2 table - let fuse3 = F.fuse3 table - let fuse = F.fuse table - let max_degree () = 4 - - let flavor_of_string s = - match s with - | "e-" -> L 1 | "e+" -> L (-1) - | "mu-" -> L 2 | "mu+" -> L (-2) - | "tau-" -> L 3 | "tau+" -> L (-3) - | "nue" -> N 1 | "nuebar" -> N (-1) - | "numu" -> N 2 | "numubar" -> N (-2) - | "nutau" -> N 3 | "nutaubar" -> N (-3) - | "se1-" -> Slepton (M1,1) | "se1+" -> Slepton (M1,-1) - | "smu1-" -> Slepton (M1,2) | "smu1+" -> Slepton (M1,-2) - | "stau1-" -> Slepton (M1,3) | "stau1+" -> Slepton (M1,-3) - | "se2-" -> Slepton (M2,1) | "se2+" -> Slepton (M2,-1) - | "smu2-" -> Slepton (M2,2) | "smu2+" -> Slepton (M2,-2) - | "stau2-" -> Slepton (M2,3) | "stau2+" -> Slepton (M2,-3) - | "snue" -> Sneutrino 1 | "snue*" -> Sneutrino (-1) - | "snumu" -> Sneutrino 2 | "snumu*" -> Sneutrino (-2) - | "snutau" -> Sneutrino 3 | "snutau*" -> Sneutrino (-3) - | "u" -> U 1 | "ubar" -> U (-1) - | "c" -> U 2 | "cbar" -> U (-2) - | "t" -> U 3 | "tbar" -> U (-3) - | "d" -> D 1 | "dbar" -> D (-1) - | "s" -> D 2 | "sbar" -> D (-2) - | "b" -> D 3 | "bbar" -> D (-3) - | "A" -> Ga | "Z" | "Z0" -> Z - | "W+" -> Wp | "W-" -> Wm - | "gl" | "g" -> Gl - | "H" -> H_Heavy | "h" -> H_Light | "A0" -> A - | "H+" -> Hp | "H-" -> Hm - | "phi0" -> Phi0 | "phi+" -> Phip | "phim" -> Phim - | "su1" -> Sup (M1,1) | "su1c" -> Sup (M1,-1) - | "sc1" -> Sup (M1,2) | "sc1c" -> Sup (M1,-2) - | "st1" -> Sup (M1,3) | "st1c" -> Sup (M1,-3) - | "su2" -> Sup (M2,1) | "su2c" -> Sup (M2,-1) - | "sc2" -> Sup (M2,2) | "sc2c" -> Sup (M2,-2) - | "st2" -> Sup (M2,3) | "st2c" -> Sup (M2,-3) - | "sgl" | "sg" -> Gluino - | "sd1" -> Sdown (M1,1) | "sd1c" -> Sdown (M1,-1) - | "ss1" -> Sdown (M1,2) | "ss1c" -> Sdown (M1,-2) - | "sb1" -> Sdown (M1,3) | "sb1c" -> Sdown (M1,-3) - | "sd2" -> Sdown (M2,1) | "sd2c" -> Sdown (M2,-1) - | "ss2" -> Sdown (M2,2) | "ss2c" -> Sdown (M2,-2) - | "sb2" -> Sdown (M2,3) | "sb2c" -> Sdown (M2,-3) - | "neu1" -> Neutralino N1 | "neu2" -> Neutralino N2 - | "neu3" -> Neutralino N3 | "neu4" -> Neutralino N4 - | "ch1+" -> Chargino C1 | "ch2+" -> Chargino C2 - | "ch1-" -> Chargino C1c | "ch2-" -> Chargino C2c - | _ -> invalid_arg "Models.MSSM.flavor_of_string" - - let flavor_to_string = function - | L 1 -> "e-" | L (-1) -> "e+" - | L 2 -> "mu-" | L (-2) -> "mu+" - | L 3 -> "tau-" | L (-3) -> "tau+" - | N 1 -> "nue" | N (-1) -> "nuebar" - | N 2 -> "numu" | N (-2) -> "numubar" - | N 3 -> "nutau" | N (-3) -> "nutaubar" - | U 1 -> "u" | U (-1) -> "ubar" - | U 2 -> "c" | U (-2) -> "cbar" - | U 3 -> "t" | U (-3) -> "tbar" - | D 1 -> "d" | D (-1) -> "dbar" - | D 2 -> "s" | D (-2) -> "sbar" - | D 3 -> "b" | D (-3) -> "bbar" - | U _ -> invalid_arg - "Models.MSSM.flavor_to_string: invalid up type quark" - | D _ -> invalid_arg - "Models.MSSM.flavor_to_string: invalid down type quark" - | Gl -> "gl" | Gluino -> "sgl" - | Ga -> "A" | Z -> "Z" | Wp -> "W+" | Wm -> "W-" - | Phip -> "phi+" | Phim -> "phi-" | Phi0 -> "phi0" - | H_Heavy -> "H" | H_Light -> "h" | A -> "A0" - | Hp -> "H+" | Hm -> "H-" - | Slepton (M1,1) -> "se1-" | Slepton (M1,-1) -> "se1+" - | Slepton (M1,2) -> "smu1-" | Slepton (M1,-2) -> "smu1+" - | Slepton (M1,3) -> "stau1-" | Slepton (M1,-3) -> "stau1+" - | Slepton (M2,1) -> "se2-" | Slepton (M2,-1) -> "se2+" - | Slepton (M2,2) -> "smu2-" | Slepton (M2,-2) -> "smu2+" - | Slepton (M2,3) -> "stau2-" | Slepton (M2,-3) -> "stau2+" - | Sneutrino 1 -> "snue" | Sneutrino (-1) -> "snue*" - | Sneutrino 2 -> "snumu" | Sneutrino (-2) -> "snumu*" - | Sneutrino 3 -> "snutau" | Sneutrino (-3) -> "snutau*" - | Sup (M1,1) -> "su1" | Sup (M1,-1) -> "su1c" - | Sup (M1,2) -> "sc1" | Sup (M1,-2) -> "sc1c" - | Sup (M1,3) -> "st1" | Sup (M1,-3) -> "st1c" - | Sup (M2,1) -> "su2" | Sup (M2,-1) -> "su2c" - | Sup (M2,2) -> "sc2" | Sup (M2,-2) -> "sc2c" - | Sup (M2,3) -> "st2" | Sup (M2,-3) -> "st2c" - | Sdown (M1,1) -> "sd1" | Sdown (M1,-1) -> "sd1c" - | Sdown (M1,2) -> "ss1" | Sdown (M1,-2) -> "ss1c" - | Sdown (M1,3) -> "sb1" | Sdown (M1,-3) -> "sb1c" - | Sdown (M2,1) -> "sd2" | Sdown (M2,-1) -> "sd2c" - | Sdown (M2,2) -> "ss2" | Sdown (M2,-2) -> "ss2c" - | Sdown (M2,3) -> "sb2" | Sdown (M2,-3) -> "sb2c" - | Neutralino N1 -> "neu1" - | Neutralino N2 -> "neu2" - | Neutralino N3 -> "neu3" - | Neutralino N4 -> "neu4" - | Neutralino _ -> invalid_arg "Models.MSSM.flavor_to_string" - | Chargino C1 -> "ch1+" | Chargino C1c -> "ch1-" - | Chargino C2 -> "ch2+" | Chargino C2c -> "ch2-" - | _ -> invalid_arg "Models.MSSM.flavor_to_string" - - let flavor_symbol = function - | L g when g > 0 -> "l" ^ string_of_int g - | L g -> "l" ^ string_of_int (abs g) ^ "b" - | N g when g > 0 -> "n" ^ string_of_int g - | N g -> "n" ^ string_of_int (abs g) ^ "b" - | U g when g > 0 -> "u" ^ string_of_int g - | U g -> "u" ^ string_of_int (abs g) ^ "b" - | D g when g > 0 -> "d" ^ string_of_int g - | D g -> "d" ^ string_of_int (abs g) ^ "b" - | Gl -> "gl" | Ga -> "a" | Z -> "z" - | Wp -> "wp" | Wm -> "wm" - | Slepton (M1,g) when g > 0 -> "sl1" ^ string_of_int g - | Slepton (M1,g) -> "sl1c" ^ string_of_int (abs g) - | Slepton (M2,g) when g > 0 -> "sl2" ^ string_of_int g - | Slepton (M2,g) -> "sl2c" ^ string_of_int (abs g) - | Sneutrino g when g > 0 -> "sn" ^ string_of_int g - | Sneutrino g -> "snc" ^ string_of_int (abs g) - | Sup (M1,g) when g > 0 -> "su1" ^ string_of_int g - | Sup (M1,g) -> "su1c" ^ string_of_int (abs g) - | Sup (M2,g) when g > 0 -> "su2" ^ string_of_int g - | Sup (M2,g) -> "su2c" ^ string_of_int (abs g) - | Sdown (M1,g) when g > 0 -> "sd1" ^ string_of_int g - | Sdown (M1,g) -> "sd1c" ^ string_of_int (abs g) - | Sdown (M2,g) when g > 0 -> "sd2" ^ string_of_int g - | Sdown (M2,g) -> "sd2c" ^ string_of_int (abs g) - | Neutralino n -> "neu" ^ (string_of_neu n) - | Chargino c when (int_of_char c) > 0 -> "cp" ^ string_of_char c - | Chargino c -> "cm" ^ string_of_int (abs (int_of_char c)) - | Gluino -> "sgl" | Phip -> "pp" | Phim -> "pm" | Phi0 -> "p0" - | H_Heavy -> "h0h" | H_Light -> "h0l" | A -> "a0" - | Hp -> "hp" | Hm -> "hm" - - let flavor_sans_color_of_string = flavor_of_string - let flavor_sans_color_to_string = flavor_to_string - let flavor_sans_color_symbol = flavor_symbol - - let pdg = function - | L g when g > 0 -> 9 + 2*g - | L g -> - 9 + 2*g - | N g when g > 0 -> 10 + 2*g - | N g -> - 10 + 2*g - | U g when g > 0 -> 2*g - | U g -> 2*g - | D g when g > 0 -> - 1 + 2*g - | D g -> 1 + 2*g - | Gl -> 21 | Ga -> 22 | Z -> 23 - | Wp -> 24 | Wm -> (-24) - | H_Light -> 25 | H_Heavy -> 35 | A -> 36 - | Hp -> 37 | Hm -> (-37) - | Phip | Phim -> 27 | Phi0 -> 26 - | Slepton (M1,g) when g > 0 -> 1000009 + 2*g - | Slepton (M1,g) -> - 1000009 + 2*g - | Slepton (M2,g) when g > 0 -> 2000009 + 2*g - | Slepton (M2,g) -> - 2000009 + 2*g - | Sneutrino g when g > 0 -> 1000010 + 2*g - | Sneutrino g -> - 1000010 + 2*g - | Sup (M1,g) when g > 0 -> 1000000 + 2*g - | Sup (M1,g) -> - 1000000 + 2*g - | Sup (M2,g) when g > 0 -> 2000000 + 2*g - | Sup (M2,g) -> - 2000000 + 2*g - | Sdown (M1,g) when g > 0 -> 999999 + 2*g - | Sdown (M1,g) -> - 999999 + 2*g - | Sdown (M2,g) when g > 0 -> 1999999 + 2*g - | Sdown (M2,g) -> - 1999999 + 2*g - | Gluino -> 1000021 - | Chargino C1 -> 1000024 | Chargino C1c -> (-1000024) - | Chargino C2 -> 1000037 | Chargino C2c -> (-1000037) - | Neutralino N1 -> 1000022 | Neutralino N2 -> 1000023 - | Neutralino N3 -> 1000025 | Neutralino N4 -> 1000035 - - -(* We must take care of the pdg numbers for the two different kinds of - sfermions in the MSSM. The particle data group in its Monte Carlo particle - numbering scheme takes only into account mixtures of the third generation - squarks and the stau. For the other sfermions we will use the number of the - lefthanded field for the lighter mixed state and the one for the righthanded - for the heavier. Below are the official pdg numbers from the Particle - Data Group. In order not to produce arrays with some million entries in - the Fortran code for the masses and the widths we introduce our private - pdg numbering scheme which only extends not too far beyond 42. - Our private scheme then has the following pdf numbers (for the sparticles - the subscripts $L/R$ and $1/2$ are taken synonymously): - - \begin{center} - \renewcommand{\arraystretch}{1.2} - \begin{tabular}{|r|l|l|}\hline - $d$ & down-quark & 1 \\\hline - $u$ & up-quark & 2 \\\hline - $s$ & strange-quark & 3 \\\hline - $c$ & charm-quark & 4 \\\hline - $b$ & bottom-quark & 5 \\\hline - $t$ & top-quark & 6 \\\hline\hline - $e^-$ & electron & 11 \\\hline - $\nu_e$ & electron-neutrino & 12 \\\hline - $\mu^-$ & muon & 13 \\\hline - $\nu_\mu$ & muon-neutrino & 14 \\\hline - $\tau^-$ & tau & 15 \\\hline - $\nu_\tau$ & tau-neutrino & 16 \\\hline\hline - $g$ & gluon & (9) 21 \\\hline - $\gamma$ & photon & 22 \\\hline - $Z^0$ & Z-boson & 23 \\\hline - $W^+$ & W-boson & 24 \\\hline\hline - $h^0$ & light Higgs boson & 25 \\\hline - $H^0$ & heavy Higgs boson & 35 \\\hline - $A^0$ & pseudoscalar Higgs & 36 \\\hline - $H^+$ & charged Higgs & 37 \\\hline\hline - $\tilde{d}_L$ & down-squark 1 & 41 \\\hline - $\tilde{u}_L$ & up-squark 1 & 42 \\\hline - $\tilde{s}_L$ & strange-squark 1 & 43 \\\hline - $\tilde{c}_L$ & charm-squark 1 & 44 \\\hline - $\tilde{b}_L$ & bottom-squark 1 & 45 \\\hline - $\tilde{t}_L$ & top-squark 1 & 46 \\\hline - $\tilde{d}_R$ & down-squark 2 & 47 \\\hline - $\tilde{u}_R$ & up-squark 2 & 48 \\\hline - $\tilde{s}_R$ & strange-squark 2 & 49 \\\hline - $\tilde{c}_R$ & charm-squark 2 & 50 \\\hline - $\tilde{b}_R$ & bottom-squark 2 & 51 \\\hline - $\tilde{t}_R$ & top-squark 2 & 52 \\\hline\hline - $\tilde{e}_L$ & selectron 1 & 53 \\\hline - $\tilde{\nu}_{e,L}$ & electron-sneutrino & 54 \\\hline - $\tilde{\mu}_L$ & smuon 1 & 55 \\\hline - $\tilde{\nu}_{\mu,L}$ & muon-sneutrino & 56 \\\hline - $\tilde{\tau}_L$ & stau 1 & 57 \\\hline - $\tilde{\nu}_{\tau,L}$ & tau-sneutrino & 58 \\\hline - $\tilde{e}_R$ & selectron 2 & 59 \\\hline - $\tilde{\mu}_R$ & smuon 2 & 61 \\\hline - $\tilde{\tau}_R$ & stau 2 & 63 \\\hline\hline - $\tilde{g}$ & gluino & 64 \\\hline - $\tilde{\chi}^0_1$ & neutralino 1 & 65 \\\hline - $\tilde{\chi}^0_2$ & neutralino 2 & 66 \\\hline - $\tilde{\chi}^0_3$ & neutralino 3 & 67 \\\hline - $\tilde{\chi}^0_4$ & neutralino 4 & 68 \\\hline - $\tilde{\chi}^+_1$ & chargino 1 & 69 \\\hline - $\tilde{\chi}^+_2$ & chargino 2 & 70 \\\hline\hline - $\tilde{G}$ & gravitino & -- \\\hline\hline - \end{tabular} - \end{center} *) - - let pdg_mw = function - | L g when g > 0 -> 9 + 2*g - | L g -> - 9 + 2*g - | N g when g > 0 -> 10 + 2*g - | N g -> - 10 + 2*g - | U g when g > 0 -> 2*g - | U g -> 2*g - | D g when g > 0 -> - 1 + 2*g - | D g -> 1 + 2*g - | Gl -> 21 | Ga -> 22 | Z -> 23 - | Wp -> 24 | Wm -> (-24) - | H_Light -> 25 | H_Heavy -> 35 | A -> 36 - | Hp -> 37 | Hm -> (-37) - | Phip | Phim -> 27 | Phi0 -> 26 - | Sup (M1,g) when g > 0 -> 40 + 2*g - | Sup (M1,g) -> - 40 + 2*g - | Sup (M2,g) when g > 0 -> 46 + 2*g - | Sup (M2,g) -> - 46 + 2*g - | Sdown (M1,g) when g > 0 -> 39 + 2*g - | Sdown (M1,g) -> - 39 + 2*g - | Sdown (M2,g) when g > 0 -> 45 + 2*g - | Sdown (M2,g) -> - 45 + 2*g - | Slepton (M1,g) when g > 0 -> 51 + 2*g - | Slepton (M1,g) -> - 51 + 2*g - | Slepton (M2,g) when g > 0 -> 57 + 2*g - | Slepton (M2,g) -> - 57 + 2*g - | Sneutrino g when g > 0 -> 52 + 2*g - | Sneutrino g -> - 52 + 2*g - | Gluino -> 64 - | Chargino C1 -> 69 | Chargino C1c -> (-69) - | Chargino C2 -> 70 | Chargino C2c -> (-70) - | Neutralino N1 -> 65 | Neutralino N2 -> 66 - | Neutralino N3 -> 67 | Neutralino N4 -> 68 - - let mass_symbol f = - "mass(" ^ string_of_int (abs (pdg_mw f)) ^ ")" - - let width_symbol f = - "width(" ^ string_of_int (abs (pdg_mw f)) ^ ")" - - let conj_symbol = function - | false, str -> str - | true, str -> str ^ "_c" - - let constant_symbol = function - | Unit -> "unit" | Pi -> "PI" - | Alpha_QED -> "alpha" | E -> "e" | G -> "g" | Vev -> "vev" - | Sin2thw -> "sin2thw" | Eidelta -> "eidelta" | Mu -> "mu" | G_Z -> "gz" - | Sin a -> "sin" ^ string_of_angle a | Cos a -> "cos" ^ string_of_angle a - | Sin2am2b -> "sin2am2b" | Cos2am2b -> "cos2am2b" | Sinamb -> "sinamb" - | Sinapb -> "sinapb" | Cosamb -> "cosamb" | Cosapb -> "cosapb" - | Cos4be -> "cos4be" | Sin4be -> "sin4be" | Sin4al -> "sin4al" - | Sin2al -> "sin2al" | Cos2al -> "cos2al" | Sin2be -> "sin2be" - | Cos2be -> "cos2be" | Tana -> "tana" | Tanb -> "tanb" - | Q_lepton -> "qlep" | Q_up -> "qup" | Q_down -> "qdwn" - | Q_charg -> "qchar" - | V_CKM (g1,g2) -> "vckm_" ^ string_of_int g1 ^ string_of_int g2 - | M_SF (f,g,m1,m2) -> "mix_" ^ string_of_sff f ^ string_of_int g - ^ string_of_sfm m1 ^ string_of_sfm m2 - | AL g -> "al_" ^ string_of_int g - | AD g -> "ad_" ^ string_of_int g - | AU g -> "au_" ^ string_of_int g - | A_0 (n1,n2) -> "a0_" ^ string_of_neu n1 ^ string_of_neu n2 - | A_P (c1,c2) -> "ap_" ^ string_of_char c1 ^ string_of_char c2 - | V_0 (n1,n2) -> "v0_" ^ string_of_neu n1 ^ string_of_neu n2 - | V_P (c1,c2) -> "vp_" ^ string_of_char c1 ^ string_of_char c2 - | M_N (n1,n2) -> "mn_" ^ string_of_neu n1 ^ string_of_neu n2 - | M_U (c1,c2) -> "mu_" ^ string_of_char c1 ^ string_of_char c2 - | M_V (c1,c2) -> "mv_" ^ string_of_char c1 ^ string_of_char c2 - | L_NC (n,c) -> "lnc_" ^ string_of_neu n ^ string_of_char c - | R_NC (n,c) -> "rnc_" ^ string_of_neu n ^ string_of_char c - | L_CN (c,n) -> "lcn_" ^ string_of_char c ^ string_of_neu n - | R_CN (c,n) -> "rcn_" ^ string_of_char c ^ string_of_neu n - | L_NCH (n,c) -> "lnch_" ^ string_of_neu n ^ string_of_char c - | R_NCH (n,c) -> "rnch_" ^ string_of_neu n ^ string_of_char c - | L_CNG (c,n) -> "lcng_" ^ string_of_char c ^ string_of_neu n - | R_CNG (c,n) -> "rcng_" ^ string_of_char c ^ string_of_neu n - | S_NNA (n1,n2) -> "snna_" ^ string_of_neu n1 ^ string_of_neu n2 - | P_NNA (n1,n2) -> "pnna_" ^ string_of_neu n1 ^ string_of_neu n2 - | S_NNG (n1,n2) -> "snng_" ^ string_of_neu n1 ^ string_of_neu n2 - | P_NNG (n1,n2) -> "pnng_" ^ string_of_neu n1 ^ string_of_neu n2 - | S_NNH1 (n1,n2) -> "snnh1_" ^ string_of_neu n1 ^ string_of_neu n2 - | P_NNH1 (n1,n2) -> "pnnh1_" ^ string_of_neu n1 ^ string_of_neu n2 - | S_NNH2 (n1,n2) -> "snnh2_" ^ string_of_neu n1 ^ string_of_neu n2 - | P_NNH2 (n1,n2) -> "pnnh2_" ^ string_of_neu n1 ^ string_of_neu n2 - | G_NC_lepton -> "gnclep" | G_NC_neutrino -> "gncneu" - | G_NC_up -> "gncup" | G_NC_down -> "gncdwn" - | G_CC -> "gcc" - | G_CCQ (vc,g1,g2) -> conj_symbol (vc, "gccq_" ^ string_of_int g1 ^ "_" - ^ string_of_int g2) - | I_Q_W -> "iqw" | I_G_ZWW -> "igzww" - | G_WWWW -> "gw4" | G_ZZWW -> "gzzww" - | G_PZWW -> "gpzww" | G_PPWW -> "gppww" - | G_GH 1 -> "ghaw" - | G_GH 2 -> "gh1az" | G_GH 3 -> "gh2az" - | G_GH 4 -> "gh1ww" | G_GH 5 -> "gh2ww" - | G_GH 6 -> "ghh1w" | G_GH 7 -> "ghh2w" - | G_GH 8 -> "gh1zz" | G_GH 9 -> "gh2zz" - | G_GH 10 -> "ghhz" | G_GH 11 -> "ghhp" - | G_GHGo n -> "g_hgh(" ^ string_of_int n ^ ")" - | G_GH4 1 -> "gaazz" | G_GH4 2 -> "gh1h1zz" | G_GH4 3 -> "gh2h2zz" - | G_GH4 4 -> "ghphmzz" | G_GH4 5 -> "ghphmpp" | G_GH4 6 -> "ghphmpz" - | G_GH4 7 -> "ghh1wz" | G_GH4 8 -> "ghh2wz" - | G_GH4 9 -> "ghh1wp" | G_GH4 10 -> "ghh2wp" - | G_GH4 11 -> "gaaww" | G_GH4 12 -> "gh1h1ww" | G_GH4 13 -> "gh2h2ww" - | G_GH4 14 -> "ghhww" | G_GH4 15 -> "ghawz" | G_GH4 16 -> "ghawp" - | G_CICIH1 (n1,n2) -> "gcicih1_" ^ string_of_neu n1 ^ "_" - ^ string_of_neu n2 - | G_CICIH2 (n1,n2) -> "gcicih2_" ^ string_of_neu n1 ^ "_" - ^ string_of_neu n2 - | G_CICIA (n1,n2) -> "gcicia_" ^ string_of_neu n1 ^ "_" - ^ string_of_neu n2 - | G_CICIG (n1,n2) -> "gcicig_" ^ string_of_neu n1 ^ "_" - ^ string_of_neu n2 - | G_H3 n -> "gh3_" ^ string_of_int n - | G_H4 n -> "gh4_" ^ string_of_int n - | G_HGo3 n -> "ghg3_" ^ string_of_int n - | G_HGo4 n -> "ghg4_" ^ string_of_int n - | G_GG4 n -> "ggg4_" ^ string_of_int n - | G_strong -> "gs" | G_SS -> "gs**2" - | Gs -> "gs" - | I_G_S -> "igs" - | G_S_Sqrt -> "gssq" - | G_NWC (n,c) -> "gnwc_" ^ string_of_neu n ^ "_" ^ string_of_char c - | G_CWN (c,n) -> "gcwn_" ^ string_of_char c ^ "_" ^ string_of_neu n - | G_CH1C (c1,c2) -> "gch1c_" ^ string_of_char c1 ^ "_" ^ string_of_char c2 - | G_CH2C (c1,c2) -> "gch2c_" ^ string_of_char c1 ^ "_" ^ string_of_char c2 - | G_CAC (c1,c2) -> "gcac_" ^ string_of_char c1 ^ "_" ^ string_of_char c2 - | G_CGC (c1,c2) -> "gcgc_" ^ string_of_char c1 ^ "_" ^ string_of_char c2 - | G_YUK (i,g) -> "g_yuk" ^ string_of_int i ^ "_" ^ string_of_int g - | G_NZN (n1,n2) -> "gnzn_" ^ string_of_neu n1 ^ "_" ^ string_of_neu n2 - | G_CZC (c1,c2) -> "gczc_" ^ string_of_char c1 ^ "_" ^ string_of_char - c2 - | DUM 1 -> "dummy1" | DUM 5 -> "dummy5" - | G_YUK_1 (n,m) -> "g_yuk1_" ^ string_of_int n ^ "_" ^ string_of_int m - | G_YUK_2 (n,m) -> "g_yuk2_" ^ string_of_int n ^ "_" ^ string_of_int m - | G_YUK_3 (n,m) -> "g_yuk3_" ^ string_of_int n ^ "_" ^ string_of_int m - | G_YUK_4 (n,m) -> "g_yuk4_" ^ string_of_int n ^ "_" ^ string_of_int m - | G_YUK_C (vc,g,c,sf,m) -> conj_symbol (vc, "g_yuk_ch" ^ string_of_char c - ^ "_" ^ string_of_sff sf ^ string_of_sfm m ^ "_" ^ string_of_int g ) - | G_YUK_N (vc,g,n,sf,m) -> conj_symbol (vc, "g_yuk_n" ^ string_of_neu n - ^ "_" ^ string_of_sff sf ^ string_of_sfm m ^ "_" ^ string_of_int g ) - | G_YUK_G (vc,g,sf,m) -> conj_symbol (vc, "g_yuk_g" ^ string_of_sff sf - ^ string_of_sfm m ^ "_" ^ string_of_int g) - | G_YUK_Q (vc,g1,g2,c,sf,m) -> conj_symbol (vc, "g_yuk_ch" ^ string_of_char c - ^ "_" ^ string_of_sff sf ^ string_of_sfm m ^ "_" ^ string_of_int g1 - ^ "_" ^ string_of_int g2) - | G_NHC (n,c) -> "g_nhc_" ^ string_of_neu n ^ "_" ^ string_of_char c - | G_CHN (c,n) -> "g_chn_" ^ string_of_neu n ^ "_" ^ string_of_char c - | G_NGC (n,c) -> "g_ngc_" ^ string_of_neu n ^ string_of_char c - | G_CGN (c,n) -> "g_cgn_" ^ string_of_char c ^ string_of_neu n - | SUM_1 -> "sum1" - | G_SLSNW (vc,g,m) -> conj_symbol (vc, "gsl" ^ string_of_sfm m ^ "_" - ^ string_of_int g ^ "snw") - | G_ZSF (f,g,m1,m2) -> "g" ^ string_of_sff f ^ string_of_sfm m1 ^ "z" - ^ string_of_sff f ^ string_of_sfm m2 ^ "_" ^ string_of_int g - | G_WWSFSF (f,g,m1,m2) -> "gww" ^ string_of_sff f ^ string_of_sfm m1 - ^ string_of_sff f ^ string_of_sfm m2 ^ "_" ^ string_of_int g - | G_WPSLSN (vc,g,m) -> conj_symbol (vc, "gpwsl" ^ string_of_sfm m - ^ "sn_" ^ string_of_int g) - | G_WZSLSN (vc,g,m) -> conj_symbol (vc, "gwzsl" ^ string_of_sfm m - ^ "sn_" ^ string_of_int g) - | G_H1SFSF (f,g,m1,m2) -> "gh1" ^ string_of_sff f ^ string_of_sfm m1 - ^ string_of_sff f ^ string_of_sfm m2 ^ "_" ^ string_of_int g - | G_H2SFSF (f,g,m1,m2) -> "gh2" ^ string_of_sff f ^ string_of_sfm m1 - ^ string_of_sff f ^ string_of_sfm m2 ^ "_" ^ string_of_int g - | G_ASFSF (f,g,m1,m2) -> "ga" ^ string_of_sff f ^ string_of_sfm m1 - ^ string_of_sff f ^ string_of_sfm m2 ^ "_" ^ string_of_int g - | G_HSNSL (vc,g,m) -> conj_symbol (vc, "ghsnsl" ^ string_of_sfm m ^ "_" - ^ string_of_int g) - | G_GoSFSF (f,g,m1,m2) -> "ggo" ^ string_of_sff f ^ string_of_sfm m1 - ^ string_of_sff f ^ string_of_sfm m2 ^ "_" ^ string_of_int g - | G_GoSNSL (vc,g,m) -> conj_symbol (vc, "ggosnsl" ^ string_of_sfm m ^ "_" - ^ string_of_int g) - | G_HSUSD (vc,m1,m2,g1,g2) -> conj_symbol (vc, "ghsu" ^ string_of_sfm m1 - ^ "sd" ^ string_of_sfm m2 ^ "_" ^ string_of_int g1 ^ "_" - ^ string_of_int g2) - | G_GSUSD (vc,m1,m2,g1,g2) -> conj_symbol (vc, "ggsu" ^ string_of_sfm m1 - ^ "sd" ^ string_of_sfm m2 ^ "_" ^ string_of_int g1 ^ "_" - ^ string_of_int g2) - | G_WPSUSD (vc,m1,m2,n,m) -> conj_symbol (vc, "gpwpsu" ^ string_of_sfm m1 - ^ "sd" ^ string_of_sfm m2 ^ "_" ^ string_of_int n ^ "_" - ^ string_of_int m) - | G_WZSUSD (vc,m1,m2,n,m) -> conj_symbol (vc, "gzwpsu" ^ string_of_sfm m1 - ^ "sd" ^ string_of_sfm m2 ^ "_" ^ string_of_int n ^ "_" - ^ string_of_int m) - | G_SWS (vc,g1,g2,m1,m2) -> conj_symbol (vc, "gs" ^ string_of_sfm m1 ^ "ws" - ^ string_of_sfm m2 ^ "_" ^ string_of_int g1 ^ "_" ^ string_of_int g2) - | G_GlGlSQSQ -> "gglglsqsq" - | G_PPSFSF f -> "gpp" ^ string_of_sff f ^ string_of_sff f - | G_ZZSFSF (f,g,m1,m2) -> "gzz" ^ string_of_sff f ^ string_of_sfm m1 - ^ string_of_sff f ^ string_of_sfm m2 ^ "_" ^ string_of_int g - | G_ZPSFSF (f,g,m1,m2) -> "gzp" ^ string_of_sff f ^ string_of_sfm m1 - ^ string_of_sff f ^ string_of_sfm m2 ^ "_" ^ string_of_int g - | G_GlPSQSQ -> "gglpsqsq" - | G_GlZSFSF (f,g,m1,m2) -> "ggl" ^ string_of_sff f ^ string_of_sfm m1 - ^ string_of_sff f ^ string_of_sfm m2 ^ "_" ^ string_of_int g - | G_GlWSUSD (vc,m1,m2,g1,g2) -> conj_symbol (vc, "gglwsu" - ^ string_of_sfm m1 ^ "sd" ^ string_of_sfm m2 ^ "_" ^ string_of_int g1 - ^ "_" ^ string_of_int g2) - | G_GHGo4 1 -> "gzzg0g0" | G_GHGo4 2 -> "gzzgpgm" - | G_GHGo4 3 -> "gppgpgm" | G_GHGo4 4 -> "gzpgpgm" - | G_GHGo4 5 -> "gwwgpgm" | G_GHGo4 6 -> "gwwg0g0" - | G_GHGo4 7 -> "gwzg0g" | G_GHGo4 8 -> "gwzg0g" - | G_GHGo4 9 -> "gwzh1g" | G_GHGo4 10 -> "gwzh2g" - | G_GHGo4 11 -> "gwph1g" | G_GHGo4 12 -> "gwph2g" - | G_HSF31 (h,g,m1,m2,f1,f2) -> "g_" ^ string_of_higgs h ^ - string_of_int g ^ string_of_sfm m1 ^ string_of_sfm m2 ^ - string_of_sff f1 ^ string_of_sff f2 - | G_HSF32 (h,g1,g2,m1,m2,f1,f2) -> "g_" ^ string_of_higgs h ^ - string_of_int g1 ^ "_" ^ string_of_int g2 ^ string_of_sfm m1 ^ - string_of_sfm m2 ^ string_of_sff f1 ^ string_of_sff f2 - | G_HSF41 (h,g,m1,m2,f1,f2) -> "g_" ^ string_of_higgs h ^ - string_of_int g ^ string_of_sfm m1 ^ string_of_sfm m2 ^ - string_of_sff f1 ^ string_of_sff f2 - | G_HSF42 (h,g1,g2,m1,m2,f1,f2) -> "g_" ^ string_of_higgs h ^ - string_of_int g1 ^ "_" ^ string_of_int g2 ^ string_of_sfm m1 ^ - string_of_sfm m2 ^ string_of_sff f1 ^ string_of_sff f2 - | G_H1H1SFSF (f,m1,m2,n) -> "gh1h1" ^ string_of_sff f ^ string_of_sfm - m1 ^ string_of_sff f ^ string_of_sfm m2 ^ "_" ^ string_of_int n - | G_H1H2SFSF (f,m1,m2,n) -> "gh1h2" ^ string_of_sff f ^ string_of_sfm - m1 ^ string_of_sff f ^ string_of_sfm m2 ^ "_" ^ string_of_int n - | G_H2H2SFSF (f,m1,m2,n) -> "gh2h2" ^ string_of_sff f ^ string_of_sfm - m1 ^ string_of_sff f ^ string_of_sfm m2 ^ "_" ^ string_of_int n - | G_HHSFSF (f,m1,m2,n) -> "ghh" ^ string_of_sff f ^ string_of_sfm m1 - ^ string_of_sff f ^ string_of_sfm m2 ^ "_" ^ string_of_int n - | G_AASFSF (f,m1,m2,n) -> "gaa" ^ string_of_sff f ^ string_of_sfm m1 - ^ string_of_sff f ^ string_of_sfm m2 ^ "_" ^ string_of_int n - | G_HH1SUSD (vc,m1,m2,g1,g2) -> conj_symbol (vc, "ghh1su" - ^ string_of_sfm m1 ^ "sd" ^ string_of_sfm m2 ^ "_" ^ string_of_int g1 - ^ "_" ^ string_of_int g2) - | G_HH2SUSD (vc,m1,m2,g1,g2) -> conj_symbol (vc, "ghh2su" - ^ string_of_sfm m1 ^ "sd" ^ string_of_sfm m2 ^ "_" ^ string_of_int g1 - ^ "_" ^ string_of_int g2) - | G_HASUSD (vc,m1,m2,g1,g2) -> conj_symbol (vc, "ghasu" - ^ string_of_sfm m1 ^ "sd" ^ string_of_sfm m2 ^ "_" - ^ string_of_int g1 ^ "_" ^ string_of_int g2 ^ "_c") - | G_HH1SLSN (vc,m,g) -> conj_symbol (vc, "ghh1sl" ^ string_of_sfm m - ^ "sn_" ^ string_of_int g) - | G_HH2SLSN (vc,m,g) -> conj_symbol (vc, "ghh2sl" ^ string_of_sfm m - ^ "sn_" ^ string_of_int g) - | G_HASLSN (vc,m,g) -> conj_symbol (vc, "ghasl" ^ string_of_sfm m - ^ "sn_" ^ string_of_int g) - | G_AG0SFSF (f,m1,m2,n) -> "gag0" ^ string_of_sff f ^ string_of_sfm m1 - ^ string_of_sff f ^ string_of_sfm m2 ^ "_" ^ string_of_int n - | G_HGSFSF (f,m1,m2,n) -> "ghg" ^ string_of_sff f ^ string_of_sfm m1 - ^ string_of_sff f ^ string_of_sfm m1 ^ "_" ^ string_of_int n - | G_GGSFSF (f,m1,m2,n) -> "ggg" ^ string_of_sff f ^ string_of_sfm m1 - ^ string_of_sff f ^ string_of_sfm m2 ^ "_" ^ string_of_int n - | G_G0G0SFSF (f,m1,m2,n) -> "gg0g0" ^ string_of_sff f ^ string_of_sfm m1 - ^ string_of_sff f ^ string_of_sfm m2 ^ "_" ^ string_of_int n - | G_HGSNSL (vc,m,n) -> conj_symbol (vc, "ghgsnsl" ^ string_of_sfm m ^ "_" - ^ string_of_int n) - | G_H1GSNSL (vc,m,n) -> conj_symbol (vc, "gh1gsnsl" ^ string_of_sfm m ^ "_" - ^ string_of_int n) - | G_H2GSNSL (vc,m,n) -> conj_symbol (vc, "gh2gsnsl" ^ string_of_sfm m ^ "_" - ^ string_of_int n) - | G_AGSNSL (vc,m,n) -> conj_symbol (vc, "gagsnsl" ^ string_of_sfm m ^ "_" - ^ string_of_int n) - | G_GGSNSL (vc,m,n) -> conj_symbol (vc, "gggsnsl" ^ string_of_sfm m ^ "_" - ^ string_of_int n) - | G_HGSUSD (vc,m1,m2,g1,g2) -> conj_symbol (vc, "gghpsu" ^ string_of_sfm m1 - ^ "sd" ^ string_of_sfm m2 ^ "_" ^ string_of_int g1 ^ "_" - ^ string_of_int g2) - | G_H1GSUSD (vc,m1,m2,g1,g2) -> conj_symbol (vc, "gh1gpsu" ^ string_of_sfm m1 - ^ "sd" ^ string_of_sfm m2 ^ "_" ^ string_of_int g1 ^ "_" - ^ string_of_int g2) - | G_H2GSUSD (vc,m1,m2,g1,g2) -> conj_symbol (vc, "gh2gpsu" ^ string_of_sfm m1 - ^ "sd" ^ string_of_sfm m2 ^ "_" ^ string_of_int g1 ^ "_" - ^ string_of_int g2) - | G_AGSUSD (vc,m1,m2,g1,g2) -> conj_symbol (vc, "gagpsu" ^ string_of_sfm m1 - ^ "sd" ^ string_of_sfm m2 ^ "_" ^ string_of_int g1 ^ "_" - ^ string_of_int g2) - | G_GGSUSD (vc,m1,m2,g1,g2) -> conj_symbol (vc, "gggpsu" ^ string_of_sfm m1 - ^ "sd" ^ string_of_sfm m2 ^ "_" ^ string_of_int g1 ^ "_" - ^ string_of_int g2) - | G_SN4 (g1,g2) -> "gsn4_" ^ string_of_int g1 ^ "_" ^ string_of_int g2 - | G_SN2SL2_1 (m1,m2,g1,g2) -> "gsl_" ^ string_of_int g1 ^ "_sl_" - ^ string_of_int g1 ^ "_sl" ^ string_of_sfm m1 ^ "_" ^ string_of_int g2 - ^ "_sl" ^ string_of_sfm m2 ^ "_" ^ string_of_int g2 - | G_SN2SL2_2 (m1,m2,g1,g2) -> "gsl_" ^ string_of_int g1 ^ "_sl_" - ^ string_of_int g2 ^ "_sl" ^ string_of_sfm m1 ^ "_" ^ string_of_int g1 - ^ "_sl" ^ string_of_sfm m2 ^ "_" ^ string_of_int g2 ^ "_mix" - | G_SF4 (f1,f2,m1,m2,m3,m4,g1,g2) -> "gsf" ^ string_of_sff f1 ^ - string_of_sff f2 ^ string_of_sfm m1 ^ string_of_sfm m2 ^ - string_of_sfm m3 ^ string_of_sfm m4 ^ string_of_int g1 ^ - string_of_int g2 - | G_SF4_3 (f1,f2,m1,m2,m3,m4,g1,g2,g3) -> "gsf" ^ string_of_sff f1 ^ - string_of_sff f2 ^ string_of_sfm m1 ^ string_of_sfm m2 ^ - string_of_sfm m3 ^ string_of_sfm m4 ^ string_of_int g1 ^ - string_of_int g2 ^ "_" ^ string_of_int g3 - | G_SF4_4 (f1,f2,m1,m2,m3,m4,g1,g2,g3,g4) -> "gsf" ^ string_of_sff f1 ^ - string_of_sff f2 ^ string_of_sfm m1 ^ string_of_sfm m2 ^ - string_of_sfm m3 ^ string_of_sfm m4 ^ string_of_int g1 ^ "_" ^ - string_of_int g2 ^ string_of_int g3 ^ "_" ^ string_of_int g4 - | G_SL4 (m1,m2,m3,m4,g) -> "gsl" ^ string_of_sfm m1 ^ "_" - ^ "sl" ^ string_of_sfm m2 ^ "_" ^ "sl" ^ string_of_sfm m3 ^ "_" - ^ "sl" ^ string_of_sfm m4 ^ "_" ^ string_of_int g - | G_SL4_2 (m1,m2,m3,m4,g1,g2) -> "gsl" ^ string_of_sfm m1 ^ "_" - ^ "sl" ^ string_of_sfm m2 ^ "_" ^ "sl" ^ string_of_sfm m3 ^ "_" - ^ "sl" ^ string_of_sfm m4 ^ "_" ^ string_of_int g1 ^ "_" ^ - string_of_int g2 - | G_SN2SQ2 (f,m1,m2,g1,g2) -> "gsn_" ^ string_of_int g1 ^ "_sn_" - ^ string_of_int g1 ^ "_" ^ string_of_sff f ^ string_of_sfm m1 ^ "_" - ^ string_of_int g2 ^ "_" ^ string_of_sff f ^ string_of_sfm m2 ^ "_" - ^ string_of_int g2 - | G_SL2SQ2 (f,m1,m2,m3,m4,g1,g2) -> "gsl" ^ string_of_sfm m1 ^ "_" - ^ string_of_int g1 ^ "_sl" ^ string_of_sfm m2 ^ "_" ^ string_of_int g1 - ^ "_" ^ string_of_sff f ^ string_of_sfm m3 ^ "_" ^ string_of_int g2 - ^ "_" ^ string_of_sff f ^ string_of_sfm m4 ^ "_" ^ string_of_int g2 - | G_SUSDSNSL (vc,m1,m2,m3,g1,g2,g3) -> conj_symbol (vc, "gsl" - ^ string_of_sfm m3 ^ "_" ^ string_of_int g3 ^ "_sn_" ^ string_of_int g3 - ^ "_su" ^ string_of_sfm m1 ^ "_" ^ string_of_int g1 ^ "_sd" - ^ string_of_sfm m2 ^ "_" ^ string_of_int g2) - | G_SU4 (m1,m2,m3,m4,g) -> "gsu" ^ string_of_sfm m1 ^ "_" - ^ "_su" ^ string_of_sfm m2 ^ "_" ^ "_su" ^ string_of_sfm m3 ^ "_" ^ - "_su" ^ string_of_sfm m4 ^ "_" ^ string_of_int g - | G_SU4_2 (m1,m2,m3,m4,g1,g2) -> "gsu" ^ string_of_sfm m1 ^ "_" - ^ "_su" ^ string_of_sfm m2 ^ "_" ^ "_su" ^ string_of_sfm m3 ^ "_" ^ - "_su" ^ string_of_sfm m4 ^ "_" ^ string_of_int g1 ^ "_" ^ - string_of_int g2 - | G_SD4 (m1,m2,m3,m4,g) -> "gsd" ^ string_of_sfm m1 ^ "_" - ^ "_sd" ^ string_of_sfm m2 ^ "_" ^ "_sd" ^ string_of_sfm m3 ^ "_" - ^ "_sd" ^ string_of_sfm m4 ^ "_" ^ string_of_int g - | G_SD4_2 (m1,m2,m3,m4,g1,g2) -> "gsd" ^ string_of_sfm m1 ^ "_" - ^ "_sd" ^ string_of_sfm m2 ^ "_" ^ "_sd" ^ string_of_sfm m3 ^ "_" - ^ "_sd" ^ string_of_sfm m4 ^ "_" ^ string_of_int g1 ^ "_" ^ - string_of_int g2 - | G_SU2SD2 (m1,m2,m3,m4,g1,g2,g3,g4) -> "gsu" ^ string_of_sfm m1 - ^ "_" ^ string_of_int g1 ^ "_su" ^ string_of_sfm m2 ^ "_" - ^ string_of_int g2 ^ "_sd" ^ string_of_sfm m3 ^ "_" ^ string_of_int g3 - ^ "_sd" ^ string_of_sfm m4 ^ "_" ^ string_of_int g4 - | M f -> "mass" ^ flavor_symbol f - | W f -> "width" ^ flavor_symbol f - | _ -> "Panic: not available" - - end - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/pmap.mli =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/pmap.mli (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/pmap.mli (revision 8703) @@ -1,73 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -(* Module [Pmap]: association tables over a polymorphic - type\footnote{Extension of code \textcopyright~1996 by Xavier Leroy}. *) - -module type T = - sig - type ('key, 'a) t - val empty : ('key, 'a) t - val is_empty : ('key, 'a) t -> bool - val singleton : 'key -> 'a -> ('key, 'a) t - val add : ('key -> 'key -> int) -> 'key -> 'a -> ('key, 'a) t -> ('key, 'a) t - val update : ('key -> 'key -> int) -> ('a -> 'a -> 'a) -> - 'key -> 'a -> ('key, 'a) t -> ('key, 'a) t - val cons : ('key -> 'key -> int) -> ('a -> 'a -> 'a option) -> - 'key -> 'a -> ('key, 'a) t -> ('key, 'a) t - val find : ('key -> 'key -> int) -> 'key -> ('key, 'a) t -> 'a - val find_opt : ('key -> 'key -> int) -> 'key -> ('key, 'a) t -> 'a option - val choose : ('key, 'a) t -> 'key * 'a - val choose_opt : ('key, 'a) t -> ('key * 'a) option - val uncons : ('key, 'a) t -> 'key * 'a * ('key, 'a) t - val uncons_opt : ('key, 'a) t -> ('key * 'a * ('key, 'a) t) option - val elements : ('key, 'a) t -> ('key * 'a) list - val mem : ('key -> 'key -> int) -> 'key -> ('key, 'a) t -> bool - val remove : ('key -> 'key -> int) -> 'key -> ('key, 'a) t -> ('key, 'a) t - val union : ('key -> 'key -> int) -> ('a -> 'a -> 'a) -> - ('key, 'a) t -> ('key, 'a) t -> ('key, 'a) t - val compose : ('key -> 'key -> int) -> ('a -> 'a -> 'a option) -> - ('key, 'a) t -> ('key, 'a) t -> ('key, 'a) t - val iter : ('key -> 'a -> unit) -> ('key, 'a) t -> unit - val map : ('a -> 'b) -> ('key, 'a) t -> ('key, 'b) t - val mapi : ('key -> 'a -> 'b) -> ('key, 'a) t -> ('key, 'b) t - val fold : ('key -> 'a -> 'b -> 'b) -> ('key, 'a) t -> 'b -> 'b - val compare : ('key -> 'key -> int) -> ('a -> 'a -> int) -> - ('key, 'a) t -> ('key, 'a) t -> int - val canonicalize : ('key -> 'key -> int) -> ('key, 'a) t -> ('key, 'a) t - end - -(* Balanced trees: logarithmic access, but representation not unique. *) - -module Tree : T - -(* Sorted lists: representation unique, but linear access. *) - -module List : T - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/model_syntax.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/model_syntax.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/model_syntax.ml (revision 8703) @@ -1,90 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -type name = - | Charged of string * string - | Neutral of string - -type particle = { name : name; attribs : (string * string) list } -type vertex = { fields : string list; expr : Vertex_syntax.scalar } -type coupling = string - -type file = - { particles : particle list; - couplings : coupling list; - vertices : vertex list; - authors : string list; - version : string list; - created : string list; - revised : string list } - -let empty () = - { particles = []; - couplings = []; - vertices = []; - authors = []; - version = []; - created = []; - revised = [] } - -let add_particle particle file = - { file with particles = particle :: file.particles } - -let add_coupling coupling file = - { file with couplings = coupling :: file.couplings } - -let add_vertex vertex file = - { file with vertices = vertex :: file.vertices } - -let add_author author file = - { file with authors = author :: file.authors } - -let add_version version file = - { file with version = version :: file.version } - -let add_created created file = - { file with created = created :: file.created } - -let add_revised revised file = - { file with revised = revised :: file.revised } - -let neutral name attribs = - { name = Neutral name; attribs = attribs } - -let charged name anti attribs = - { name = Charged (name, anti); attribs = attribs } - -let coupling name = name - -let vertex fields expr = - { fields = fields; expr = Vertex.parse expr } - -exception Syntax_Error of string * int * int - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) - Index: branches/ohl/omega-development/completed/whizard2/src/thoGButton.mli =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/thoGButton.mli (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/thoGButton.mli (revision 8703) @@ -1,60 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -(* Plain [GButton.button]s have an immutable label. We can remedy this - situation by adding an explicit label and exporting its [set_text] - method. *) - -class mutable_button : Gtk.button Gtk.obj * GMisc.label -> - object - inherit GButton.button - method set_text : string -> unit - end - -val mutable_button_raw : - ?text:string -> ?border_width:int -> ?width:int -> ?height:int -> - ?packing:(GObj.widget -> unit) -> - ?show:bool -> unit -> Gtk.button Gtk.obj * GMisc.label - -val mutable_button : - ?text:string -> ?border_width:int -> ?width:int -> ?height:int -> - ?packing:(GObj.widget -> unit) -> ?show:bool -> unit -> mutable_button - -class ['a] stateful_button : Gtk.button Gtk.obj * GMisc.label -> - ('a -> string) -> 'a -> - object - inherit mutable_button - method state : 'a - method set_state : 'a -> unit - end - -val stateful_button : ('a -> string) -> 'a -> - ?text:string -> ?border_width:int -> ?width:int -> ?height:int -> - ?packing:(GObj.widget -> unit) -> ?show:bool -> unit -> 'a stateful_button - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/f90_2HDM.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/f90_2HDM.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/f90_2HDM.ml (revision 8703) @@ -1,567 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -let rcs_file = RCS.parse "F90_2HDM" ["2 Higgs Doublet Models"] - { RCS.revision = "$Revision$"; - RCS.date = "$Date$"; - RCS.author = "$Author$"; - RCS.source - = "$URL$" } - -(* \thocwmodulesection{Standard Model with additional Higgses} *) - -module M : Model.T = - struct - let rcs = rcs_file - - open Coupling - - let include_gluons = false - let default_width = ref Timelike - let use_fudged_width = ref false - - let options = Options.create - [ "constant_width", Arg.Unit (fun () -> default_width := Constant), - "use constant width (also in t-channel)"; - "fudged_width", Arg.Set use_fudged_width, - "use fudge factor for charge particle width"; - "custom_width", Arg.String (fun f -> default_width := Custom f), - "use custom width"; - "cancel_widths", Arg.Unit (fun () -> default_width := Vanishing), - "use vanishing width" ] - - type matter_field = L of int | N of int | U of int | D of int - type gauge_boson = Ga | Wp | Wm | Z | Gl | Gl_aux - type other = Phip | Phim | Phi0 | Hh | HA | HH | Hp | Hm - type flavor = M of matter_field | G of gauge_boson | O of other - type flavor_sans_color = flavor - let flavor_sans_color f = f - let matter_field f = M f - let gauge_boson f = G f - let other f = O f - - type field = - | Matter of matter_field - | Gauge of gauge_boson - | Other of other - - let field = function - | M f -> Matter f - | G f -> Gauge f - | O f -> Other f - - type gauge = unit - - let gauge_symbol () = - failwith "F90_2HDM.M.gauge_symbol: internal error" - - let family n = List.map matter_field [ L n; N n; U n; D n ] - - let external_flavors () = - [ "1st Generation", ThoList.flatmap family [1; -1]; - "2nd Generation", ThoList.flatmap family [2; -2]; - "3rd Generation", ThoList.flatmap family [3; -3]; - "Gauge Bosons", List.map gauge_boson [Ga; Z; Wp; Wm; Gl]; - "Higgs", List.map other [Hh; HH; HA; Hp; Hm]; - "Goldstone Bosons", List.map other [Phip; Phim; Phi0] ] - - let flavors () = ThoList.flatmap snd (external_flavors ()) @ [ G Gl_aux ] - - let spinor n = - if n >= 0 then - Spinor - else - ConjSpinor - - let lorentz = function - | M f -> - begin match f with - | L n -> spinor n | N n -> spinor n - | U n -> spinor n | D n -> spinor n - end - | G f -> - begin match f with - | Ga | Gl -> Vector - | Wp | Wm | Z -> Massive_Vector - | Gl_aux -> Tensor_1 - end - | O f -> Scalar - - let color = function - | M (U n) -> Color.SUN (if n > 0 then 3 else -3) - | M (D n) -> Color.SUN (if n > 0 then 3 else -3) - | G Gl | G Gl_aux -> Color.AdjSUN 3 - | _ -> Color.Singlet - - let prop_spinor n = - if n >= 0 then - Prop_Spinor - else - Prop_ConjSpinor - - let propagator = function - | M f -> - begin match f with - | L n -> prop_spinor n | N n -> prop_spinor n - | U n -> prop_spinor n | D n -> prop_spinor n - end - | G f -> - begin match f with - | Ga | Gl -> Prop_Feynman - | Wp | Wm | Z -> Prop_Unitarity - | Gl_aux -> Aux_Tensor_1 - end - | O f -> - begin match f with - | Phip | Phim | Phi0 -> Only_Insertion - | Hh | HH | HA | Hp | Hm -> Prop_Scalar - end - -(* Optionally, ask for the fudge factor treatment for the widths of - charged particles. Currently, this only applies to $W^\pm$ and top. *) - - let width f = - if !use_fudged_width then - match f with - | G Wp | G Wm | M (U 3) | M (U (-3)) -> Fudged - | _ -> !default_width - else - !default_width - - let goldstone = function - | G f -> - begin match f with - | Wp -> Some (O Phip, Coupling.Const 1) - | Wm -> Some (O Phim, Coupling.Const 1) - | Z -> Some (O Phi0, Coupling.Const 1) - | _ -> None - end - | _ -> None - - let conjugate = function - | M f -> - M (begin match f with - | L n -> L (-n) | N n -> N (-n) - | U n -> U (-n) | D n -> D (-n) - end) - | G f -> - G (begin match f with - | Gl -> Gl | Ga -> Ga | Z -> Z - | Wp -> Wm | Wm -> Wp - | Gl_aux -> Gl_aux - end) - | O f -> - O (begin match f with - | Phip -> Phim | Phim -> Phip | Phi0 -> Phi0 - | Hh -> Hh | HH -> HH | HA -> HA - | Hp -> Hm | Hm -> Hp - end) - - let conjugate_sans_color = conjugate - - let fermion = function - | M f -> - begin match f with - | L n -> if n > 0 then 1 else -1 - | N n -> if n > 0 then 1 else -1 - | U n -> if n > 0 then 1 else -1 - | D n -> if n > 0 then 1 else -1 - end - | G f -> - begin match f with - | Gl | Ga | Z | Wp | Wm | Gl_aux -> 0 - end - | O _ -> 0 - - type constant = - | Unit | Pi | Alpha_QED | Sin2thw - | Sinthw | Costhw | E | G_weak | Vev - | Q_lepton | Q_up | Q_down | G_CC - | G_NC_neutrino | G_NC_lepton | G_NC_up | G_NC_down - | I_Q_W | I_G_ZWW | I_G_WWW - | G_WWWW | G_ZZWW | G_AZWW | G_AAWW - | G_hWW | G_HWW | G_hhWW - | G_hZZ | G_HZZ | G_hhZZ - | G_htt | G_hbb | G_hcc | G_htautau | G_hmumu - | G_Htt | G_Hbb | G_Hcc | G_Htautau | G_Hmumu - | I_G_Att | I_G_Abb | I_G_Acc | I_G_Atautau | I_G_Amumu - | G_Htb | G_Hcs | G_Htaunu | G_Hmunu - | I_G_ZhA | I_G_ZHA | G_ZHH | G_AHH - | G_H3 | G_H4 - | G_strong - | Mass of flavor | Width of flavor - - let parameters () = - { input = []; derived = []; derived_arrays = [] } - - module F = Models.Fusions (struct - type f = flavor - type c = constant - let compare = compare - let conjugate = conjugate - end) - -(* \begin{equation} - \mathcal{L}_{\textrm{EM}} = - - e \sum_i q_i \bar\psi_i\fmslash{A}\psi_i - \end{equation} *) - - let mgm ((m1, g, m2), fbf, c) = ((M m1, G g, M m2), fbf, c) - - let electromagnetic_currents n = - List.map mgm - [ ((L (-n), Ga, L n), FBF (1, Psibar, V, Psi), Q_lepton); - ((U (-n), Ga, U n), FBF (1, Psibar, V, Psi), Q_up); - ((D (-n), Ga, D n), FBF (1, Psibar, V, Psi), Q_down) ] - - let color_currents n = - if include_gluons then - List.map mgm - [ ((U (-n), Gl, U n), FBF (1, Psibar, V, Psi), G_strong); - ((D (-n), Gl, D n), FBF (1, Psibar, V, Psi), G_strong) ] - else - [] - -(* \begin{equation} - \mathcal{L}_{\textrm{NC}} = - - \frac{g}{2\cos\theta_W} - \sum_i \bar\psi_i\fmslash{Z}(g_V^i-g_A^i\gamma_5)\psi_i - \end{equation} *) - - let neutral_currents n = - List.map mgm - [ ((L (-n), Z, L n), FBF (1, Psibar, VA, Psi), G_NC_lepton); - ((N (-n), Z, N n), FBF (1, Psibar, VA, Psi), G_NC_neutrino); - ((U (-n), Z, U n), FBF (1, Psibar, VA, Psi), G_NC_up); - ((D (-n), Z, D n), FBF (1, Psibar, VA, Psi), G_NC_down) ] - -(* \begin{equation} - \mathcal{L}_{\textrm{CC}} = - - \frac{g}{2\sqrt2} \sum_i \bar\psi_i - (T^+\fmslash{W}^+ + T^-\fmslash{W}^-)(1-\gamma_5)\psi_i - \end{equation} *) - - let charged_currents n = - List.map mgm - [ ((L (-n), Wm, N n), FBF (1, Psibar, VL, Psi), G_CC); - ((N (-n), Wp, L n), FBF (1, Psibar, VL, Psi), G_CC); - ((D (-n), Wm, U n), FBF (1, Psibar, VL, Psi), G_CC); - ((U (-n), Wp, D n), FBF (1, Psibar, VL, Psi), G_CC) ] - - let yukawa = - [ ((M (U (-3)), O Hh, M (U 3)), FBF (1, Psibar, S, Psi), G_htt); - ((M (D (-3)), O Hh, M (D 3)), FBF (1, Psibar, S, Psi), G_hbb); - ((M (U (-2)), O Hh, M (U 2)), FBF (1, Psibar, S, Psi), G_hcc); - ((M (L (-3)), O Hh, M (L 3)), FBF (1, Psibar, S, Psi), G_htautau); - ((M (L (-2)), O Hh, M (L 2)), FBF (1, Psibar, S, Psi), G_hmumu); - ((M (U (-3)), O HH, M (U 3)), FBF (1, Psibar, S, Psi), G_Htt); - ((M (D (-3)), O HH, M (D 3)), FBF (1, Psibar, S, Psi), G_Hbb); - ((M (U (-2)), O HH, M (U 2)), FBF (1, Psibar, S, Psi), G_Hcc); - ((M (L (-3)), O HH, M (L 3)), FBF (1, Psibar, S, Psi), G_Htautau); - ((M (L (-2)), O HH, M (L 2)), FBF (1, Psibar, S, Psi), G_Hmumu); - ((M (U (-3)), O HA, M (U 3)), FBF (1, Psibar, P, Psi), I_G_Att); - ((M (D (-3)), O HA, M (D 3)), FBF (1, Psibar, P, Psi), I_G_Abb); - ((M (U (-2)), O HA, M (U 2)), FBF (1, Psibar, P, Psi), I_G_Acc); - ((M (L (-3)), O HA, M (L 3)), FBF (1, Psibar, P, Psi), I_G_Atautau); - ((M (L (-2)), O HA, M (L 2)), FBF (1, Psibar, P, Psi), I_G_Amumu); - ((M (D (-3)), O Hm, M (U 3)), FBF (1, Psibar, SP, Psi), G_Htb); - ((M (U (-3)), O Hp, M (D 3)), FBF (1, Psibar, SP, Psi), G_Htb); - ((M (D (-2)), O Hm, M (U 2)), FBF (1, Psibar, SP, Psi), G_Hcs); - ((M (U (-2)), O Hp, M (D 2)), FBF (1, Psibar, SP, Psi), G_Hcs); - ((M (L (-3)), O Hm, M (N 3)), FBF (1, Psibar, SP, Psi), G_Htaunu); - ((M (N (-3)), O Hp, M (L 3)), FBF (1, Psibar, SP, Psi), G_Htaunu); - ((M (L (-2)), O Hm, M (N 2)), FBF (1, Psibar, SP, Psi), G_Hmunu); - ((M (N (-2)), O Hp, M (L 2)), FBF (1, Psibar, SP, Psi), G_Hmunu) ] - -(* \begin{equation} - \mathcal{L}_{\textrm{TGC}} = - - e \partial_\mu A_\nu W_+^\mu W_-^\nu + \ldots - - e \cot\theta_w \partial_\mu Z_\nu W_+^\mu W_-^\nu + \ldots - \end{equation} *) - - let tgc ((g1, g2, g3), t, c) = ((G g1, G g2, G g3), t, c) - - let triple_gauge = - List.map tgc - [ ((Ga, Wm, Wp), Gauge_Gauge_Gauge 1, I_Q_W); - ((Z, Wm, Wp), Gauge_Gauge_Gauge 1, I_G_ZWW) ] - - let triple_gluon = - if include_gluons then - List.map tgc - [ ((Gl, Gl, Gl), Gauge_Gauge_Gauge 1, G_strong); - ((Gl_aux, Gl, Gl), Aux_Gauge_Gauge 1, G_strong) ] - else - [] - -(* \begin{equation} - \mathcal{L}_{\textrm{QGC}} = - - g^2 W_{+,\mu} W_{-,\nu} W_+^\mu W_-^\nu + \ldots - \end{equation} *) - -(* Actually, quartic gauge couplings are a little bit more straightforward - using auxiliary fields. Here we have to impose the antisymmetry manually: - \begin{subequations} - \begin{multline} - (W^{+,\mu}_1 W^{-,\nu}_2 - W^{+,\nu}_1 W^{-,\mu}_2) - (W^+_{3,\mu} W^-_{4,\nu} - W^+_{3,\nu} W^-_{4,\mu}) \\ - = 2(W^+_1W^+_3)(W^-_2W^-_4) - 2(W^+_1W^-_4)(W^-_2W^+_3) - \end{multline} - also ($V$ can be $A$ or $Z$) - \begin{multline} - (W^{+,\mu}_1 V^\nu_2 - W^{+,\nu}_1 V^\mu_2) - (W^-_{3,\mu} V_{4,\nu} - W^-_{3,\nu} V_{4,\mu}) \\ - = 2(W^+_1W^-_3)(V_2V_4) - 2(W^+_1V_4)(V_2W^-_3) - \end{multline} - \end{subequations} *) - -(* \begin{subequations} - \begin{multline} - W^{+,\mu} W^{-,\nu} W^+_\mu W^-_\nu - \end{multline} - \end{subequations} *) - - let qgc ((g1, g2, g3, g4), t, c) = ((G g1, G g2, G g3, G g4), t, c) - - let gauge4 = Vector4 [(2, C_13_42); (-1, C_12_34); (-1, C_14_23)] - let minus_gauge4 = Vector4 [(-2, C_13_42); (1, C_12_34); (1, C_14_23)] - let quartic_gauge = - List.map qgc - [ (Wm, Wp, Wm, Wp), gauge4, G_WWWW; - (Wm, Z, Wp, Z), minus_gauge4, G_ZZWW; - (Wm, Z, Wp, Ga), minus_gauge4, G_AZWW; - (Wm, Ga, Wp, Ga), minus_gauge4, G_AAWW ] - - let gauge_higgs = - [ ((O Hh, G Wp, G Wm), Scalar_Vector_Vector 1, G_hWW); - ((O HH, G Wp, G Wm), Scalar_Vector_Vector 1, G_HWW); - ((O Hh, G Z, G Z), Scalar_Vector_Vector 1, G_hZZ); - ((O HH, G Z, G Z), Scalar_Vector_Vector 1, G_HZZ); - ((G Z, O Hh, O HA), Vector_Scalar_Scalar 1, I_G_ZhA); - ((G Z, O HH, O HA), Vector_Scalar_Scalar 1, I_G_ZHA); - ((G Z, O Hp, O Hm), Vector_Scalar_Scalar 1, G_ZHH); - ((G Ga, O Hp, O Hm), Vector_Scalar_Scalar 1, G_AHH) ] - - let gauge_higgs4 = - [ (O Hh, O Hh, G Wp, G Wm), Scalar2_Vector2 1, G_hhWW; - (O Hh, O Hh, G Z, G Z), Scalar2_Vector2 1, G_hhZZ ] - - let higgs = - [ (O Hh, O Hh, O Hh), Scalar_Scalar_Scalar 1, G_H3 ] - - let higgs4 = - [ (O Hh, O Hh, O Hh, O Hh), Scalar4 1, G_H4 ] - - let goldstone_vertices = - [ ((O Phi0, G Wm, G Wp), Scalar_Vector_Vector 1, I_G_ZWW); - ((O Phip, G Ga, G Wm), Scalar_Vector_Vector 1, I_Q_W); - ((O Phip, G Z, G Wm), Scalar_Vector_Vector 1, I_G_ZWW); - ((O Phim, G Wp, G Ga), Scalar_Vector_Vector 1, I_Q_W); - ((O Phim, G Wp, G Z), Scalar_Vector_Vector 1, I_G_ZWW) ] - - let vertices3 = - (ThoList.flatmap electromagnetic_currents [1;2;3] @ - ThoList.flatmap color_currents [1;2;3] @ - ThoList.flatmap neutral_currents [1;2;3] @ - ThoList.flatmap charged_currents [1;2;3] @ - yukawa @ triple_gauge @ triple_gluon @ - gauge_higgs @ higgs @ goldstone_vertices) - - let vertices4 = - quartic_gauge @ gauge_higgs4 @ higgs4 - - let vertices () = (vertices3, vertices4, []) - -(* For efficiency, make sure that [F.of_vertices vertices] is - evaluated only once. *) - - let table = F.of_vertices (vertices ()) - let fuse2 = F.fuse2 table - let fuse3 = F.fuse3 table - let fuse = F.fuse table - let max_degree () = 4 - - let flavor_of_string = function - | "e-" -> M (L 1) | "e+" -> M (L (-1)) - | "mu-" -> M (L 2) | "mu+" -> M (L (-2)) - | "tau-" -> M (L 3) | "tau+" -> M (L (-3)) - | "nue" -> M (N 1) | "nuebar" -> M (N (-1)) - | "numu" -> M (N 2) | "numubar" -> M (N (-2)) - | "nutau" -> M (N 3) | "nutaubar" -> M (N (-3)) - | "u" -> M (U 1) | "ubar" -> M (U (-1)) - | "c" -> M (U 2) | "cbar" -> M (U (-2)) - | "t" -> M (U 3) | "tbar" -> M (U (-3)) - | "d" -> M (D 1) | "dbar" -> M (D (-1)) - | "s" -> M (D 2) | "sbar" -> M (D (-2)) - | "b" -> M (D 3) | "bbar" -> M (D (-3)) - | "g" -> G Gl - | "A" -> G Ga | "Z" | "Z0" -> G Z - | "W+" -> G Wp | "W-" -> G Wm - | "h0" -> O Hh - | "H0" -> O HH - | "A0" -> O HA - | _ -> invalid_arg "Models.SM_hHA.flavor_of_string" - - let flavor_to_string = function - | M f -> - begin match f with - | L 1 -> "e-" | L (-1) -> "e+" - | L 2 -> "mu-" | L (-2) -> "mu+" - | L 3 -> "tau-" | L (-3) -> "tau+" - | L _ -> invalid_arg - "Models.SM_hHA.flavor_to_string: invalid lepton" - | N 1 -> "nue" | N (-1) -> "nuebar" - | N 2 -> "numu" | N (-2) -> "numubar" - | N 3 -> "nutau" | N (-3) -> "nutaubar" - | N _ -> invalid_arg - "Models.SM_hHA.flavor_to_string: invalid neutrino" - | U 1 -> "u" | U (-1) -> "ubar" - | U 2 -> "c" | U (-2) -> "cbar" - | U 3 -> "t" | U (-3) -> "tbar" - | U _ -> invalid_arg - "Models.SM_hHA.flavor_to_string: invalid up type quark" - | D 1 -> "d" | D (-1) -> "dbar" - | D 2 -> "s" | D (-2) -> "sbar" - | D 3 -> "b" | D (-3) -> "bbar" - | D _ -> invalid_arg - "Models.SM_hHA.flavor_to_string: invalid down type quark" - end - | G f -> - begin match f with - | Gl -> "g" - | Ga -> "A" | Z -> "Z" - | Wp -> "W+" | Wm -> "W-" - | Gl_aux -> "gx" - end - | O f -> - begin match f with - | Phip -> "phi+" | Phim -> "phi-" | Phi0 -> "phi0" - | Hh -> "h0" | HH -> "H0" | HA -> "A0" - | Hp -> "H+" | Hm -> "H-" - end - - let flavor_symbol = function - | M f -> - begin match f with - | L n when n > 0 -> "l" ^ string_of_int n - | L n -> "l" ^ string_of_int (abs n) ^ "b" - | N n when n > 0 -> "n" ^ string_of_int n - | N n -> "n" ^ string_of_int (abs n) ^ "b" - | U n when n > 0 -> "u" ^ string_of_int n - | U n -> "u" ^ string_of_int (abs n) ^ "b" - | D n when n > 0 -> "d" ^ string_of_int n - | D n -> "d" ^ string_of_int (abs n) ^ "b" - end - | G f -> - begin match f with - | Gl -> "gl" - | Ga -> "a" | Z -> "z" - | Wp -> "wp" | Wm -> "wm" - | Gl_aux -> "gx" - end - | O f -> - begin match f with - | Phip -> "pp" | Phim -> "pm" | Phi0 -> "p0" - | Hh -> "h" | HH -> "h0" | HA -> "a0" - | Hp -> "hp" | Hm -> "hm" - end - - let flavor_sans_color_of_string = flavor_of_string - let flavor_sans_color_to_string = flavor_to_string - let flavor_sans_color_symbol = flavor_symbol - - let pdg = function - | M f -> - begin match f with - | L n when n > 0 -> 9 + 2*n - | L n -> - 9 + 2*n - | N n when n > 0 -> 10 + 2*n - | N n -> - 10 + 2*n - | U n when n > 0 -> 2*n - | U n -> 2*n - | D n when n > 0 -> - 1 + 2*n - | D n -> 1 + 2*n - end - | G f -> - begin match f with - | Gl -> 21 - | Ga -> 22 | Z -> 23 - | Wp -> 24 | Wm -> (-24) - | Gl_aux -> 21 - end - | O f -> - begin match f with - | Phip | Phim -> 27 | Phi0 -> 26 - | Hh -> 25 - | HH -> 35 - | HA -> 36 - | Hp -> 37 - | Hm -> -37 - end - - let mass_symbol f = - "mass(" ^ string_of_int (abs (pdg f)) ^ ")" - - let width_symbol f = - "width(" ^ string_of_int (abs (pdg f)) ^ ")" - - let constant_symbol = function - | Unit -> "unit" | Pi -> "PI" - | Alpha_QED -> "alpha" | E -> "e" | G_weak -> "g" | Vev -> "vev" - | Sin2thw -> "sin2thw" | Sinthw -> "sinthw" | Costhw -> "costhw" - | Q_lepton -> "qlep" | Q_up -> "qup" | Q_down -> "qdwn" - | G_NC_lepton -> "gnclep" | G_NC_neutrino -> "gncneu" - | G_NC_up -> "gncup" | G_NC_down -> "gncdwn" - | G_CC -> "gcc" - | I_Q_W -> "iqw" | I_G_ZWW -> "igzww" | I_G_WWW -> "igwww" - | G_WWWW -> "gw4" | G_ZZWW -> "gzzww" - | G_AZWW -> "gazww" | G_AAWW -> "gaaww" - | G_hWW -> "ghww" | G_HWW -> "gh0ww" - | G_hZZ -> "ghzz" | G_HZZ -> "gh0zz" - | G_hhWW -> "ghhww" | G_hhZZ -> "ghhzz" - | G_htt -> "ghtt" | G_hbb -> "ghbb" | G_hcc -> "ghcc" - | G_Htt -> "gh0tt" | G_Hbb -> "gh0bb" | G_Hcc -> "gh0cc" - | I_G_Att -> "iga0tt" | I_G_Abb -> "iga0bb" | I_G_Acc -> "iga0cc" - | G_htautau -> "ghtautau" | G_hmumu -> "ghmumu" - | G_Htautau -> "gh0tautau" | G_Hmumu -> "gh0mumu" - | I_G_Atautau -> "iga0tautau" | I_G_Amumu -> "iga0mumu" - | G_Htb -> "ghptb" | G_Hcs -> "ghpcs" - | G_Htaunu -> "ghptaunu" | G_Hmunu -> "ghpmunu" - | G_AHH -> "gahh" | G_ZHH -> "gzhh" - | I_G_ZHA -> "igzha" | I_G_ZhA -> "igzh0a" - | G_H3 -> "gh3" | G_H4 -> "gh4" - | G_strong -> "gs" - | Mass f -> "mass" ^ flavor_symbol f - | Width f -> "width" ^ flavor_symbol f - - end - -module O = Omega.Make(Fusion.Mixed23)(Targets.Fortran)(M) -let _ = O.main () - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/whizard.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/whizard.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/whizard.ml (revision 8703) @@ -1,419 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -let rcs = RCS.parse "Whizard" ["Whizard Interface"] - { RCS.revision = "$Revision$"; - RCS.date = "$Date$"; - RCS.author = "$Author$"; - RCS.source - = "$URL$" } - -open Printf - -module type T = - sig - type t - type amplitude - val trees : amplitude -> t - val merge : t -> t - val write : out_channel -> string -> t -> unit - - end - -module Make (FM : Fusion.Maker) (P : Momentum.T) - (PW : Momentum.Whizard with type t = P.t) (M : Model.T) = - struct - module F = FM(P)(M) - - type tree = (P.t * M.flavor list) list - - module Poles = Map.Make - (struct - type t = int * int - let compare (s1, t1) (s2, t2) = - let c = compare s2 s1 in - if c <> 0 then - c - else - compare t1 t2 - end) - - let add_tree maps tree trees = - Poles.add maps - (try tree :: (Poles.find maps trees) with Not_found -> [tree]) trees - - type t = - { in1 : M.flavor; - in2 : M.flavor; - out : M.flavor list; - trees : tree list Poles.t } - - type amplitude = F.amplitude - -(* \thocwmodulesection{Building Trees} *) - -(* A singularity is to be mapped if it is timelike and not the - overall $s$-channel. *) - let timelike_map c = P.timelike c && not (P.s_channel c) - - let count_maps n clist = - List.fold_left (fun (s, t as cnt) (c, _) -> - if timelike_map c then - (succ s, t) - else if P.spacelike c then - (s, succ t) - else - cnt) (0, 0) clist - - let poles_to_whizard n trees poles = - let tree = List.map (fun wf -> - (P.flip_s_channel_in (F.momentum wf), [F.flavor wf])) poles in - add_tree (count_maps n tree) tree trees - - let trees a = - match F.externals a with - | in1 :: in2 :: out -> - let n = List.length out + 2 in - { in1 = F.flavor in1; - in2 = F.flavor in2; - out = List.map (fun f -> M.conjugate (F.flavor f)) out; - trees = List.fold_left - (poles_to_whizard n) Poles.empty (F.poles a) } - | _ -> invalid_arg "Whizard().trees" - -(* \thocwmodulesection{Merging Homomorphic Trees} *) - - module Pole_Map = - Map.Make (struct type t = P.t list let compare = compare end) - module Flavor_Set = - Set.Make (struct type t = M.flavor let compare = compare end) - - let add_flavors flist fset = - List.fold_right Flavor_Set.add flist fset - - let set_of_flavors flist = - List.fold_right Flavor_Set.add flist Flavor_Set.empty - - let pack_tree map t = - let c, f = - List.split (List.sort (fun (c1, _) (c2, _) -> - compare (PW.of_momentum c2) (PW.of_momentum c1)) t) in - let f' = - try - List.map2 add_flavors f (Pole_Map.find c map) - with - | Not_found -> List.map set_of_flavors f in - Pole_Map.add c f' map - - let pack_map trees = List.fold_left pack_tree Pole_Map.empty trees - - let merge_sets clist flist = - List.map2 (fun c f -> (c, Flavor_Set.elements f)) clist flist - - let unpack_map map = - Pole_Map.fold (fun c f l -> (merge_sets c f) :: l) map [] - -(* If a singularity is to be mapped (i.\,e.~if it is timelike and not the - overall $s$-channel), expand merged particles again: *) - let unfold1 (c, f) = - if timelike_map c then - List.map (fun f' -> (c, [f'])) f - else - [(c,f)] - - let unfold_tree tree = Product.list (fun x -> x) (List.map unfold1 tree) - - let unfold trees = ThoList.flatmap unfold_tree trees - - let merge t = - { t with trees = Poles.map - (fun t' -> unfold (unpack_map (pack_map t'))) t.trees } - -(* \thocwmodulesection{Printing Trees} *) - - let flavors_to_string f = - String.concat "/" (List.map M.flavor_to_string f) - - let whizard_tree t = - "tree " ^ - (String.concat " " (List.rev_map (fun (c, _) -> - (string_of_int (PW.of_momentum c))) t)) ^ - " ! " ^ - (String.concat ", " (List.rev_map (fun (_, f) -> flavors_to_string f) t)) - - let whizard_tree_debug t = - "tree " ^ - (String.concat " " (List.rev_map (fun (c, _) -> - ("[" ^ (String.concat "+" (List.map string_of_int (P.to_ints c))) ^ "]")) - (List.sort (fun (t1,_) (t2,_) -> - let c = - compare - (List.length (P.to_ints t2)) - (List.length (P.to_ints t1)) in - if c <> 0 then - c - else - compare t1 t2) t))) ^ - " ! " ^ - (String.concat ", " (List.rev_map (fun (_, f) -> flavors_to_string f) t)) - - let format_maps = function - | (0, 0) -> "neither mapped timelike nor spacelike poles" - | (0, 1) -> "no mapped timelike poles, one spacelike pole" - | (0, n) -> "no mapped timelike poles, " ^ - string_of_int n ^ " spacelike poles" - | (1, 0) -> "one mapped timelike pole, no spacelike pole" - | (1, 1) -> "one mapped timelike and spacelike pole each" - | (1, n) -> "one mapped timelike and " ^ - string_of_int n ^ " spacelike poles" - | (n, 0) -> string_of_int n ^ - " mapped timelike poles and no spacelike pole" - | (n, 1) -> string_of_int n ^ - " mapped timelike poles and one spacelike pole" - | (n, n') -> string_of_int n ^ " mapped timelike and " ^ - string_of_int n' ^ " spacelike poles" - - let format_flavor f = - match flavors_to_string f with - | "d" -> "d" | "dbar" -> "D" - | "u" -> "u" | "ubar" -> "U" - | "s" -> "s" | "sbar" -> "S" - | "c" -> "c" | "cbar" -> "C" - | "b" -> "b" | "bbar" -> "B" - | "t" -> "t" | "tbar" -> "T" - | "e-" -> "e1" | "e+" -> "E1" - | "nue" -> "n1" | "nuebar" -> "N1" - | "mu-" -> "e2" | "mu+" -> "E2" - | "numu" -> "n2" | "numubar" -> "N2" - | "tau-" -> "e3" | "tau+" -> "E3" - | "nutau" -> "n3" | "nutaubar" -> "N3" - | "g" -> "G" | "A" -> "A" | "Z" -> "Z" - | "W+" -> "W+" | "W-" -> "W-" - | "H" -> "H" - | s -> s ^ " (not translated)" - - module Mappable = - Set.Make (struct type t = string let compare = compare end) - let mappable = - List.fold_right Mappable.add - [ "T"; "Z"; "W+"; "W-"; "H" ] Mappable.empty - - let analyze_tree ch t = - List.iter (fun (c, f) -> - let f' = format_flavor f - and c' = PW.of_momentum c in - if P.timelike c then begin - if P.s_channel c then - fprintf ch " ! overall s-channel %d %s not mapped\n" c' f' - else if Mappable.mem f' mappable then - fprintf ch " map %d s-channel %s\n" c' f' - else - fprintf ch - " ! %d s-channel %s can't be mapped by whizard\n" - c' f' - end else - fprintf ch " ! t-channel %d %s not mapped\n" c' f') t - - let write ch pid t = - fprintf ch "! whizard trees by O'Mega\n\n"; - fprintf ch "! %s %s -> %s\n" - (M.flavor_to_string t.in1) (M.flavor_to_string t.in2) - (String.concat " " (List.map M.flavor_to_string t.out)); -(*i - fprintf ch "! %d %d -> %s\n\n" - (whizard_code1 t.n 1) (whizard_code1 t.n 2) - (String.concat " " (List.map (fun o -> - string_of_int (whizard_code1 t.n o)) (ThoList.range 3 t.n))); -i*) - fprintf ch "process %s\n" pid; - Poles.iter (fun maps ds -> - fprintf ch "\n ! %d times %s:\n" - (List.length ds) (format_maps maps); - List.iter (fun d -> - fprintf ch "\n grove\n"; - fprintf ch " %s\n" (whizard_tree d); - analyze_tree ch d) ds) t.trees; - fprintf ch "\n! O'Mega revision control information:\n"; - List.iter (fun s -> fprintf ch "! %s\n" s) - (ThoList.flatmap RCS.summary (rcs :: M.rcs :: F.rcs_list)); - fprintf ch "\n" - - end - -(* \thocwmodulesection{Process Dispatcher} *) - -let arguments = function - | [] -> ("", "") - | args -> - let arg_list = String.concat ", " (List.map snd args) in - (arg_list, ", " ^ arg_list) - -let import_prefixed ch pid name = - fprintf ch " use %s, only: %s_%s => %s !NODEP!\n" - pid pid name name - -let declare_argument ch (arg_type, arg) = - fprintf ch " %s, intent(in) :: %s\n" arg_type arg - -let call_function ch pid result name args = - fprintf ch " case (pr_%s)\n" pid; - fprintf ch " %s = %s_%s (%s)\n" result pid name args - -let default_function ch result default = - fprintf ch " case default\n"; - fprintf ch " call invalid_process (pid)\n"; - fprintf ch " %s = %s\n" result default - -let call_subroutine ch pid name args = - fprintf ch " case (pr_%s)\n" pid; - fprintf ch " call %s_%s (%s)\n" pid name args - -let default_subroutine ch = - fprintf ch " case default\n"; - fprintf ch " call invalid_process (pid)\n" - -let write_interface_subroutine ch wrapper name args processes = - let arg_list, arg_list' = arguments args in - fprintf ch " subroutine %s (pid%s)\n" wrapper arg_list'; - List.iter (fun p -> import_prefixed ch p name) processes; - List.iter (declare_argument ch) (("character(len=*)", "pid") :: args); - fprintf ch " select case (pid)\n"; - List.iter (fun p -> call_subroutine ch p name arg_list) processes; - default_subroutine ch; - fprintf ch " end select\n"; - fprintf ch " end subroutine %s\n" wrapper - -let write_interface_function ch wrapper name - (result_type, result, default) args processes = - let arg_list, arg_list' = arguments args in - fprintf ch " function %s (pid%s) result (%s)\n" wrapper arg_list' result; - List.iter (fun p -> import_prefixed ch p name) processes; - List.iter (declare_argument ch) (("character(len=*)", "pid") :: args); - fprintf ch " %s :: %s\n" result_type result; - fprintf ch " select case (pid)\n"; - List.iter (fun p -> call_function ch p result name arg_list) processes; - default_function ch result default; - fprintf ch " end select\n"; - fprintf ch " end function %s\n" wrapper - -let write_other_interface_functions ch = - fprintf ch " subroutine invalid_process (pid)\n"; - fprintf ch " character(len=*), intent(in) :: pid\n"; - fprintf ch " print *, \"PANIC:"; - fprintf ch " process `\"//trim(pid)//\"' not available!\"\n"; - fprintf ch " end subroutine invalid_process\n"; - fprintf ch " function n_tot (pid) result (n)\n"; - fprintf ch " character(len=*), intent(in) :: pid\n"; - fprintf ch " integer :: n\n"; - fprintf ch " n = n_in(pid) + n_out(pid)\n"; - fprintf ch " end function n_tot\n" - -let write_other_declarations ch = - fprintf ch " public :: n_in, n_out, n_tot, pdg_code\n"; - fprintf ch " public :: allow_helicities\n"; - fprintf ch " public :: create, destroy\n"; - fprintf ch " public :: set_const, sqme\n"; - fprintf ch " interface create\n"; - fprintf ch " module procedure process_create\n"; - fprintf ch " end interface\n"; - fprintf ch " interface destroy\n"; - fprintf ch " module procedure process_destroy\n"; - fprintf ch " end interface\n"; - fprintf ch " interface set_const\n"; - fprintf ch " module procedure process_set_const\n"; - fprintf ch " end interface\n"; - fprintf ch " interface sqme\n"; - fprintf ch " module procedure process_sqme\n"; - fprintf ch " end interface\n" - -let write_interface ch names = - fprintf ch "module process_interface\n"; - fprintf ch " use kinds, only: default !NODEP!\n"; - fprintf ch " use parameters, only: parameter_set\n"; - fprintf ch " implicit none\n"; - fprintf ch " private\n"; - List.iter (fun p -> - fprintf ch - " character(len=*), parameter, public :: pr_%s = \"%s\"\n" p p) - names; - write_other_declarations ch; - fprintf ch "contains\n"; - write_interface_function ch "n_in" "n_in" ("integer", "n", "0") [] names; - write_interface_function ch "n_out" "n_out" ("integer", "n", "0") [] names; - write_interface_function ch "pdg_code" "pdg_code" - ("integer", "n", "0") [ "integer", "i" ] names; - write_interface_function ch "allow_helicities" "allow_helicities" - ("logical", "yorn", ".false.") [] names; - write_interface_subroutine ch "process_create" "create" [] names; - write_interface_subroutine ch "process_destroy" "destroy" [] names; - write_interface_subroutine ch "process_set_const" "set_const" - [ "type(parameter_set)", "par"] names; - write_interface_function ch "process_sqme" "sqme" - ("real(kind=default)", "sqme", "0") - [ "real(kind=default), dimension(0:,:)", "p"; - "integer, dimension(:), optional", "h" ] names; - write_other_interface_functions ch; - fprintf ch "end module process_interface\n" - -(* \thocwmodulesection{Makefile} *) - -let write_makefile ch names = - fprintf ch "KINDS = ../@KINDS@\n"; - fprintf ch "HELAS = ../@HELAS@\n"; - fprintf ch "F90 = @F90@\n"; - fprintf ch "F90FLAGS = @F90FLAGS@\n"; - fprintf ch "F90INCL = -I$(KINDS) -I$(HELAS)\n"; - fprintf ch "F90COMMON = omega_bundle_whizard.f90"; - fprintf ch " file_utils.f90 process_interface.f90\n"; - fprintf ch "include Makefile.processes\n"; - fprintf ch "F90SRC = $(F90COMMON) $(F90PROCESSES)\n"; - fprintf ch "OBJ = $(F90SRC:.f90=.o)\n"; - fprintf ch "MOD = $(F90SRC:.f90=.mod)\n"; - fprintf ch "archive: processes.a\n"; - fprintf ch "processes.a: $(OBJ)\n"; - fprintf ch "\t$(AR) r $@ $(OBJ)\n"; - fprintf ch "\t@RANLIB@ $@\n"; - fprintf ch "clean:\n"; - fprintf ch "\trm -f $(OBJ)\n"; - fprintf ch "realclean:\n"; - fprintf ch "\trm -f processes.a\n"; - fprintf ch "parameters.o: file_utils.o\n"; - fprintf ch "omega_bundle_whizard.o: parameters.o\n"; - fprintf ch "process_interface.o: parameters.o\n"; - fprintf ch "%%.o: %%.f90 $(KINDS)/kinds.f90\n"; - fprintf ch "\t$(F90) $(F90FLAGS) $(F90INCL) -c $<\n" - -let write_makefile_processes ch names = - fprintf ch "F90PROCESSES ="; - List.iter (fun f -> fprintf ch " \\\n %s.f90" f) names; - fprintf ch "\n"; - List.iter (fun f -> - fprintf ch "%s.o: omega_bundle_whizard.o parameters.o\n" f; - fprintf ch "process_interface.o: %s.o\n" f) names - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/Makefile.in =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/Makefile.in (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/Makefile.in (revision 8703) @@ -1,477 +0,0 @@ -# $Id$ -# -# Copyright (C) 1999-2009 by -# -# Wolfgang Kilian -# Thorsten Ohl -# Juergen Reuter -# -# WHIZARD is free software; you can redistribute it and/or modify it -# under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2, or (at your option) -# any later version. -# -# WHIZARD is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -# -######################################################################## - -prefix = @prefix@ -srcdir = @srcdir@ -top_srcdir = @top_srcdir@ - -### host = @host@ - -# Architecture dependent source and binary directories -builddir_bin = $(top_srcdir)/bin -builddir_lib = $(top_srcdir)/lib -builddir_src = $(top_srcdir)/src - -SELECT_PROGRAMS_CUSTOM = @SELECT_PROGRAMS_CUSTOM@ -SELECT_PROGRAMS_RELEASED = @SELECT_PROGRAMS_RELEASED@ -SELECT_PROGRAMS_UNRELEASED = @SELECT_PROGRAMS_UNRELEASED@ -SELECT_PROGRAMS_THEORETICAL = @SELECT_PROGRAMS_THEORETICAL@ -SELECT_PROGRAMS_REDUNDANT = @SELECT_PROGRAMS_REDUNDANT@ -SELECT_PROGRAMS_DEVELOPERS = @SELECT_PROGRAMS_DEVELOPERS@ -SELECT_PROGRAMS_OBSOLETE = @SELECT_PROGRAMS_OBSOLETE@ -SELECT_PROGRAMS_GUI = @SELECT_PROGRAMS_GUI@ - -DBG = -g -GPROF = # -p - -OCAML = @OCAML@ -OCAMLC = @OCAMLC@ $(DBG) -OCAMLCI = $(OCAMLC) -OCAMLOPT = @OCAMLOPT@ -OCAMLLEX = @OCAMLLEX@ -OCAMLYACC = @OCAMLYACC@ -OCAMLMKTOP = @OCAMLMKTOP@ -OCAMLCP = @OCAMLCP@ -OCAMLDEP = @OCAMLDEP@ -OCAMLDOT = @OCAMLDOT@ -OCAMLDEFUN = @OCAMLDEFUN@ -OCAMLFLAGS = -OCAMLOPTFLAGS = -inline 64 $(GPROF) - -OCAML_VERSION = @OCAML_VERSION@ -OCAML_LIBDIR = @OCAML_LIBDIR@ -LABLGTKDIR = @LABLGTKDIR@ - -ifeq ($(OCAML_VERSION),304000) -OCAML304_LINK_BUG = -custom -else -OCAML304_LINK_BUG = -endif - -CPIF = @CPIF@ -NOTANGLE = @NOTANGLE@ -M4 = @M4@ - -F77 = @F77@ -F77FLAGS = -O3 -F77RUNTIME = @FLIBS@ - -RANLIB = @RANLIB@ - -######################################################################## -# Fortran 90/95/03 compiler idiosyncrasies -######################################################################## - -FC = @FC@ -FC_OPT = @FC_OPT@ -FC_PROF = @FC_PROF@ -FC_MDIR = @FC_MDIR@ -FC_MDIR_NOSPACE = @FC_MDIR_NOSPACE@ -FC_MAKE_MODULE_NAME = @FC_MAKE_MODULE_NAME@ -FCFLAGS = $(FC_OPT) -I$(builddir_lib) -FC_EXT = @FC_EXT@ -FC_PURE = @FC_PURE@ -FC_PRECISION = @FC_PRECISION@ - -ifeq ($(FC_PRECISION), quadruple) -FC_FILTER = sed -e 's/default = double/default = quadruple/' | -else -FC_FILTER = -endif - -ifeq ($(FC_PURE), yes) -FC_FILTER += $(CPIF) -else -FC_FILTER += sed '/^[ ]*pure[ ]/s/pure[ ]//' | $(CPIF) -endif - -# Don't delete: these are used by FC_MAKE_MODULE_NAME for -# some target systems! -FC_MODULE_EXT = @FC_MODULE_EXT@ -LOWERCASE = @LOWERCASE@ -UPPERCASE = @UPPERCASE@ - -######################################################################## - -include Makefile.src - -EXTRA_CMA = -EXTRA_CMXA = -EXTRA_A = - -# EXTRA_CMA = unix.cma nums.cma -# EXTRA_CMXA = unix.cmxa nums.cmxa -# EXTRA_A = -cclib -lnums -cclib -lunix - -######################################################################## - -.PHONY: all world universe cma cmxa bin opt top gui optgui f77 f95 - -all: - @echo make "[cma|cmxa|bin|opt|gui|optgui|top|f77|f95]" - -world: bin opt -universe: world top gui optgui f77 f95 - -cma: omega.cma -cmxa: omega.cmxa - -bin: $(addprefix $(builddir_bin)/,$(APP_BIN)) -opt: $(addprefix $(builddir_bin)/,$(APP_OPT)) -gui: $(addprefix $(builddir_bin)/,$(GUI_APP_BIN)) -optgui: $(addprefix $(builddir_bin)/,$(GUI_APP_OPT)) -top: $(builddir_bin)/omega.top -f95: $(builddir_lib)/libomega95.a $(builddir_bin)/test_omega95 \ - $(builddir_bin)/test_omega95_bispinors -ifneq ($(FC_PROF),) -f95: $(builddir_lib)/libomega95_p.a $(builddir_bin)/test_omega95_p \ - $(builddir_bin)/test_omega95_bispinors_p -endif - -f77: $(builddir_lib)/libomega77.a - -######################################################################## - -$(addprefix $(builddir_bin)/,$(APP_BIN)) \ - $(addprefix $(builddir_bin)/,$(GUI_APP_BIN)): omega.cma - -$(addprefix $(builddir_bin)/,$(APP_OPT)) \ - $(addprefix $(builddir_bin)/,$(GUI_APP_OPT)): omega.cmxa - -omega.cma: $(LIB_CMO) - $(OCAMLC) $(OCAMLFLAGS) -a -o $@ $^ - -omega.cmxa: $(LIB_CMX) - $(OCAMLOPT) $(OCAMLFLAGS) $(OCAMLOPTFLAGS) -a -o $@ $^ - -ogiga.cma: $(GUI_LIB_CMO) - $(OCAMLC) $(OCAMLFLAGS) -a -o $@ $^ - -ogiga.cmxa: $(GUI_LIB_CMX) - $(OCAMLOPT) $(OCAMLFLAGS) $(OCAMLOPTFLAGS) -a -o $@ $^ - -$(builddir_bin)/%.bin: %.cmo - $(OCAMLC) $(OCAMLFLAGS) -o $@ omega.cma $< - -$(builddir_bin)/%.opt: %.cmx - $(OCAMLOPT) $(OCAMLFLAGS) $(OCAMLOPTFLAGS) -o $@ omega.cmxa $< - -######################################################################## - -$(builddir_bin)/ogiga.bin: ogiga.cmo omega.cma ogiga.cma - $(OCAMLC) $(OCAML304_LINK_BUG) -thread -o $@ -I $(LABLGTKDIR) \ - unix.cma threads.cma lablgtk.cma gtkThread.cmo gtkInit.cmo \ - omega.cma ogiga.cma $< - -$(builddir_bin)/ogiga.opt: ogiga.cmx omega.cmxa ogiga.cmxa - $(OCAMLOPT) -thread -o $@ -I $(LABLGTKDIR) \ - unix.cmxa threads.cmxa lablgtk.cmxa gtkThread.cmx gtkInit.cmx \ - omega.cmxa ogiga.cmxa $< - -ogiga.cmo: ogiga.ml - $(OCAMLC) $(OCAMLFLAGS) -I $(LABLGTKDIR) \ - -thread -labels -w s -o $@ -c $< - -ogiga.cmx: ogiga.ml - $(OCAMLOPT) $(OCAMLFLAGS) $(OCAMLOPTFLAGS) -I $(LABLGTKDIR) \ - -thread -labels -w s -o $@ -c $< - -thoG%.cmi: thoG%.mli - @rm -f $*.cmi - $(OCAMLCI) $(OCAMLFLAGS) -I $(LABLGTKDIR) -labels -o $@ -c $< - -thoG%.cmo: thoG%.ml - $(OCAMLC) $(OCAMLFLAGS) -I $(LABLGTKDIR) \ - -thread -labels -w s -o $@ -c $< - -thoG%.cmx: thoG%.ml - $(OCAMLOPT) $(OCAMLFLAGS) $(OCAMLOPTFLAGS) -I $(LABLGTKDIR) \ - -thread -labels -w s -o $@ -c $< - -$(builddir_bin)/omega.top: omega.cma - $(OCAMLMKTOP) $(OCAMLFLAGS) -o $@ nums.cma omega.cma - -$(builddir_bin)/count.bin: count.cmo - $(OCAMLC) $(OCAMLFLAGS) -o $@ nums.cma omega.cma count.cmo - -$(builddir_bin)/count.opt: count.cmx - $(OCAMLOPT) $(OCAMLFLAGS) -o $@ nums.cmxa omega.cmxa count.cmx - -######################################################################## -# -# count.bin: count.cmo -# $(OCAMLC) $(OCAMLFLAGS) -o $@ nums.cma omega.cma numerix.cmo count.cmo \ -# -cclib -lmlnumx -cclib -lgmp -# -# count.opt: count.cmx -# $(OCAMLOPT) $(OCAMLFLAGS) -o $@ nums.cmxa omega.cmxa numerix.cmx count.cmx \ -# -cclib -lmlnumx -cclib -lgmp -# -######################################################################## - -%.cmo: %.ml - @rm -f $@ - $(OCAMLC) $(OCAMLFLAGS) -c $< - -%.cmx: %.ml - @rm -f $@ - $(OCAMLOPT) $(OCAMLFLAGS) $(OCAMLOPTFLAGS) -c $< - -%.cmi: %.mli - @rm -f $*.cmi - $(OCAMLCI) $(OCAMLFLAGS) -c $< - -%.ml: %.mll - $(OCAMLLEX) $< - -######################################################################## -# Why did I need the following??? -######################################################################## -# -# %.ml %.mli: %.mly -# rm -f $<.tmp -# mv $< $<.tmp -# perl -pe 'while (s/\\$$//) { chomp; $$_.=<>; }' $<.tmp >$< -# $(OCAMLYACC) $< -# rm -f $< -# mv $<.tmp $< -# - -%.ml %.mli: %.mly - $(OCAMLYACC) $< - -######################################################################## -# The O'Caml Defunctorizer is not ready for prime time yet. -######################################################################## - -DEFUNDIR = defun - -LIB_CMDML = $(addprefix $(DEFUNDIR)/, $(LIB_ML)) -LIB_CMDMLI = $(addprefix $(DEFUNDIR)/, $(LIB_MLI)) -LIB_CMD = $(addprefix $(DEFUNDIR)/, $(LIB_CMO:.cmo=.cmd) \ - $(filter-out $(LIB_ML:.ml=.cmd), $(LIB_MLI:.mli=.cmd))) - -defun: $(LIB_CMD) - -SKIP_CMD= $(filter-out %.cmd, $^) - -$(DEFUNDIR)/%.cmd: %.mli %.ml - $(OCAMLDEFUN) -d $(DEFUNDIR) $(OCAMLFLAGS) $(SKIP_CMD) - -$(DEFUNDIR)/%.cmd: %.mli - $(OCAMLDEFUN) -d $(DEFUNDIR) $(OCAMLFLAGS) $(SKIP_CMD) - -$(DEFUNDIR)/%.cmd: %.ml - $(OCAMLDEFUN) -d $(DEFUNDIR) $(OCAMLFLAGS) $(SKIP_CMD) - - -######################################################################## - - -######################################################################## - -$(builddir_bin)/test_omega95: $(FC_TSTLIBOBJ) \ - test_omega95.o $(builddir_lib)/libomega95.a - $(FC) $(FCFLAGS) -o $@ $(FC_TSTLIBOBJ) \ - test_omega95.o -L$(builddir_lib) -lomega95 - -$(builddir_bin)/test_omega95_p: $(FC_TSTLIBOBJP) \ - test_omega95_p.o $(builddir_lib)/libomega95_p.a - $(FC) $(FCFLAGS) $(FC_PROF) -o $@ $(FC_TSTLIBOBJP) \ - test_omega95_p.o -L$(builddir_lib) -lomega95_p - -$(builddir_bin)/test_omega95_bispinors: $(FC_TSTLIBOBJ) \ - test_omega95_bispinors.o $(builddir_lib)/libomega95.a - $(FC) $(FCFLAGS) -o $@ $(FC_TSTLIBOBJ) \ - test_omega95_bispinors.o -L$(builddir_lib) -lomega95 - -$(builddir_bin)/test_omega95_bispinors_p: $(FC_TSTLIBOBJP) \ - test_omega95_bispinors_p.o $(builddir_lib)/libomega95_p.a - $(FC) $(FCFLAGS) $(FC_PROF) -o $@ $(FC_TSTLIBOBJP) \ - test_omega95_bispinors_p.o -L$(builddir_lib) -lomega95_p - -$(builddir_lib)/libomega77.a: $(F77LIBOBJ) - ar rc $@ $^ - $(RANLIB) $@ - -$(builddir_lib)/libomega95.a: $(FC_LIBOBJ) - ar rc $@ $^ - $(RANLIB) $@ - -$(builddir_lib)/libomega95_p.a: $(FC_LIBOBJP) - ar rc $@ $^ - $(RANLIB) $@ - -######################################################################## -# There are no Modula(n) sources hidden around here ... -%.o: %.mod -######################################################################## - -ifeq ($(FC_MDIR_NOSPACE),yes) - set_mdir=$(FC_MDIR)$(builddir_lib) -else - set_mdir=$(FC_MDIR) $(builddir_lib) -endif - -%.o: %.f - $(F77) $(F77FLAGS) -c -o $@ $< - -$(builddir_src)/%.$(FC_EXT): %.f95 - cat $< | $(FC_FILTER) $(builddir_src)/$*.$(FC_EXT) - -%.o: $(builddir_src)/%.$(FC_EXT) -ifneq ($(FC_MDIR),) - $(FC) $(FCFLAGS) $(set_mdir) -c -o $@ $< -else - $(FC) $(FCFLAGS) -c -o $@ $< - test -f $(FC_MAKE_MODULE_NAME) && mv $(FC_MAKE_MODULE_NAME) $(builddir_lib) || true -endif - -%_p.o: $(builddir_src)/%.$(FC_EXT) -ifneq ($(FC_MDIR),) - $(FC) $(FC5FLAGS) $(FC_PROF) $(set_mdir) -c -o $@ $< -else - $(FC) $(FCFLAGS) $(FC_PROF) -c -o $@ $< - test -f $(FC_MAKE_MODULE_NAME) && mv $(FC_MAKE_MODULE_NAME) $(builddir_lib) || true -endif - -######################################################################## -# The omega_*_colors.f95 files require special treatment: -######################################################################## - -ifneq ($(NOTANGLE), false) - -$(F77LIBSRC) $(F77TSTSRC) $(FC_TSTSRC) $(FC_TSTLIBSRC) \ - $(FC_LIBSRC_FROM_OMEGALIB_NW): omegalib.nw - $(NOTANGLE) -R'[[$@]]' $< | $(CPIF) $@ - -omega_%_colors.f95: omegalib.nw -ifneq ($(M4), false) - $(NOTANGLE) -R'[[$(@:.f95=.m4)]]' $< | $(M4) | $(CPIF) $@ -endif - -omega_parameters_mssm.f95: omega_parameters_mssm.nw - $(NOTANGLE) $< | $(CPIF) $@ - -omega_parameters_mssm_4.f95: omega_parameters_mssm_4.nw - $(NOTANGLE) $< | $(CPIF) $@ - -omega_parameters_littlest.f95: omega_parameters_littlest.nw - $(NOTANGLE) $< | $(CPIF) $@ - -omega_parameters_simplest.f95: omega_parameters_simplest.nw - $(NOTANGLE) $< | $(CPIF) $@ - -omega_parameters_xdim.f95: omega_parameters_xdim.nw - $(NOTANGLE) $< | $(CPIF) $@ - -omega_parameters_ued.f95: omega_parameters_ued.nw - $(NOTANGLE) $< | $(CPIF) $@ - -omega_parameters_template.f95: omega_parameters_template.nw - $(NOTANGLE) $< | $(CPIF) $@ - -endif - -######################################################################## -# Single file bundles -######################################################################## - -omega_bundle_whizard.f95: omegalib.nw - $(NOTANGLE) -R'[[$@]]' $< | $(CPIF) $@ - -omega_bundle.f90: omegalib.nw - $(NOTANGLE) -R'[[omega_bundle.f95]]' $< | \ - sed '/^[ ]*pure[ ]/s/pure[ ]//' | $(CPIF) $@ - -omega_bundle.f95: omegalib.nw - $(NOTANGLE) -R'[[omega_bundle.f95]]' $< | $(CPIF) $@ - -F90_MODE = -l $(HOME)/emacs/f90.elc -INDENT = $(F90_MODE) -eval '(progn (f90-mode) (mark-whole-buffer) \ - (indent-region (point-min) (point-max) nil) \ - (save-buffer))' -.PHONY: indent_f95 -indent_f95: $(FC_LIBSRC) $(FC_TSTSRC) - for f in $(FC_LIBSRC) $(FC_TSTSRC); do \ - emacs -q -batch $$f $(INDENT); \ - done - -ATTRIBS = modules.attrib -modules.eps: depend $(ATTRIBS) -# $(OCAMLDOT) -fullgraph .depend | sed -f $(ATTRIBS) | dot -Tps >$@ - $(OCAMLDOT) .depend | sed -f $(ATTRIBS) | dot -Tps >$@ - -omega_logo.eps: omega_logo.mp - mpost omega_logo.mp - rm -f omega_logo.1 - mv omega_logo.2 $@ - -omega_logo.xpm: omega_logo.eps - gs -g500x450 -r62 -q -dNOPAUSE -dBATCH -sOutputFile=- -sDEVICE=ppmraw \ - omega_logo.eps | ppmtoxpm > $@ - -omega_logo.ascii: omega_logo.eps - gs -g120x100 -r15 -q -dNOPAUSE -dBATCH -sOutputFile=- -sDEVICE=pbm \ - omega_logo.eps | pbmtoascii -2x4 > omega_logo.ascii - -######################################################################## - -clean_ocaml: - rm -f $(DERIVED_OCAML) *.cm[ioxa] *.cmxa - -clean_f95: - rm -f *.f90 - -clean_tex: - rm -f *.log - -clean: clean_ocaml clean_f95 clean_tex - rm -f *~ *.o *.a omega_logo.eps - -realclean: clean - mv omega_utils.f95 omega_utils.f95.keep - rm -f *.f *.f95 *.F - mv omega_utils.f95.keep omega_utils.f95 - -.PHONY: depend -depend: $(LIB_ML) $(LIB_MLI) $(GUI_LIB_ML) $(GUI_LIB_MLI) $(APP_ML) $(GUI_APP_ML) - $(OCAMLDEP) $^ >.depend - -.PHONY: depend_f95 -depend_f95: $(FC_LIBSRC) $(FC_TSTSRC) $(FC_TSTLIBSRC) - grep '^ *use ' $(FC_LIBSRC) $(FC_TSTSRC) $(FC_TSTLIBSRC) \ - | grep -v '!NODEP!' \ - | sed -e 's/\..*: *use */.o: /' \ - -e 's/, *only:.*//' \ - -e 's/, *&//' \ - -e 's/, *.*=>.*//' \ - -e 's/$$/.o/' >.depend_f95 - -include .depend -include .depend_defun -include .depend_f95 - -######################################################################## - Index: branches/ohl/omega-development/completed/whizard2/src/fusion.mli =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/fusion.mli (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/fusion.mli (revision 8703) @@ -1,294 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -module type T = - sig - -(* Wavefunctions are an abstract data type, containing a momentum~[p] - and additional quantum numbers, collected in~[flavor]. *) - type wf - -(* Obviously, [flavor] is not restricted to the physical notion of - flavor, but can carry spin, color, etc. *) - type flavor - val flavor : wf -> flavor - -(* Momenta are represented by an abstract datatype (defined - in~[Momentum]) that is optimized for performance. They can be - accessed either abstractly or as lists of indices of the external - momenta. These indices are assigned sequentially by [amplitude] below. *) - type p - val momentum : wf -> p - val momentum_list : wf -> int list - -(* At tree level, the wave functions are uniquely specified by [flavor] - and momentum. If loops are included, we need to distinguish among - orders. Also, if we build a result from an incomplete sum of diagrams, - we need to add a distinguishing mark. At the moment, we assume that a - [string] that can be attached to the symbol suffices. *) - val wf_tag : wf -> string option - -(* Coupling constants *) - type constant - -(* and right hand sides of assignments. The latter are formed from a sign from - Fermi statistics, a coupling (constand and Lorentz structure) and wave - functions. *) - type rhs - type 'a children - val sign : rhs -> int - val coupling : rhs -> constant Coupling.t - - val coupling_tag : rhs -> string option - -(* In renormalized perturbation theory, couplings come in different orders - of the loop expansion. Be prepared: [val order : rhs -> int] *) - -(* \begin{dubious} - This is here only for the benefit of [Target] and shall become - [val children : rhs -> wf children] later \ldots - \end{dubious} *) - val children : rhs -> wf list - -(* Fusions come in two types: fusions of wave functions to off-shell wave - functions: - \begin{equation*} - \phi(p+q) = \phi(p)\phi(q) - \end{equation*} *) - type fusion - val lhs : fusion -> wf - val rhs : fusion -> rhs list - -(* and products at the keystones: - \begin{equation*} - \phi(-p-q)\cdot\phi(p)\phi(q) - \end{equation*} *) - type braket - val bra : braket -> wf - val ket : braket -> rhs list - -(* [amplitude goldstones incoming outgoing] calculates the - amplitude for scattering of [incoming] to [outgoing]. If - [goldstones] is true, also non-propagating off-shell Goldstone - amplitudes are included to allow the checking of Slavnov-Taylor - identities. *) - type amplitude - type selectors - val amplitude : bool -> selectors -> flavor list -> flavor list -> amplitude - -(* We should be precise regarding the semantics of the following functions, since - modules implementating [Target] must not make any mistakes interpreting the - return values. Instead of calculating the amplitude - \begin{subequations} - \begin{equation} - \label{eq:physical-amplitude} - \Braket{f_3,p_3,f_4,p_4,\ldots|T|f_1,p_1,f_2,p_2} - \end{equation} - directly, O'Mega calculates the---equivalent, but more symmetrical---crossed - amplitude - \begin{equation} - \Braket{\bar f_1,-p_1,\bar f_2,-p_2,f_3,p_3,f_4,p_4,\ldots|T|0} - \end{equation} - Internally, all flavors are represented by their charge conjugates - \begin{equation} - \label{eq:internal-amplitude} - A(f_1,-p_1,f_2,-p_2,\bar f_3,p_3,\bar f_4,p_4,\ldots) - \end{equation} - \end{subequations} - The correspondence of vertex and term in the lagrangian - \begin{equation} - \parbox{26\unitlength}{% - \fmfframe(5,3)(5,3){% - \begin{fmfgraph*}(15,20) - \fmfleft{v} - \fmfright{p,A,e} - \fmflabel{$\mathrm{e}^-$}{e} - \fmflabel{$\mathrm{e}^+$}{p} - \fmflabel{$\mathrm{A}$}{A} - \fmf{fermion}{p,v,e} - \fmf{photon}{A,v} - \fmfdot{v} - \end{fmfgraph*}}}: \bar\psi\fmslash{A}\psi - \end{equation} - suggests to denote the \emph{outgoing} particle by the flavor of the - \emph{anti}particle and the \emph{outgoing} \emph{anti}particle by the - flavor of the particle, since this choice allows to represent the vertex - by a triple - \begin{equation} - \bar\psi\fmslash{A}\psi: (\mathrm{e}^+,A,\mathrm{e}^-) - \end{equation} - which is more intuitive than the alternative $(\mathrm{e}^-,A,\mathrm{e}^+)$. - Also, when thinking in terms of building wavefunctions from the outside in, - the outgoing \emph{antiparticle} is represented by a \emph{particle} - propagator and vice versa\footnote{Even if this choice will appear slightly - counter-intuitive on the [Target] side, one must keep in mind that much more - people are expected to prepare [Model]s.}. - [incoming] and [outgoing] are the physical flavors as - in~(\ref{eq:physical-amplitude}) *) - val incoming : amplitude -> flavor list - val outgoing : amplitude -> flavor list - -(* [externals] are flavors and momenta as in~(\ref{eq:internal-amplitude}) *) - val externals : amplitude -> wf list - - val variables : amplitude -> wf list - val fusions : amplitude -> fusion list - val brakets : amplitude -> braket list - val on_shell : amplitude -> (wf -> bool) - val is_gauss : amplitude -> (wf -> bool) - val constraints : amplitude -> string option - val symmetry : amplitude -> int - - val allowed : amplitude -> bool - -(* \thocwmodulesubsection{Diagnostics} *) - - val count_fusions : amplitude -> int - val count_propagators : amplitude -> int - val count_diagrams : amplitude -> int - - type coupling - val forest : wf -> amplitude -> ((wf * coupling option, wf) Tree.t) list - val poles : amplitude -> wf list list - val s_channel : amplitude -> wf list - - val tower_to_dot : out_channel -> amplitude -> unit - val amplitude_to_dot : out_channel -> amplitude -> unit - - val rcs_list : RCS.t list - end - -(* There is more than one way to make fusions. *) - -module type Maker = - functor (P : Momentum.T) -> functor (M : Model.T) -> - T with type p = P.t and type flavor = M.flavor - and type constant = M.constant - and type selectors = Cascade.Make(M)(P).selectors - -(* Straightforward Dirac fermions vs. slightly more complicated - Majorana fermions: *) - -module Binary : Maker -module Binary_Majorana : Maker - -module Mixed23 : Maker -module Mixed23_Majorana : Maker - -module Nary : functor (B : Tuple.Bound) -> Maker -module Nary_Majorana : functor (B : Tuple.Bound) -> Maker - -(* We can also proceed \'a la~\cite{HELAC:2000}. Empirically, - this will use slightly~($O(10\%)$) fewer fusions than the - symmetric factorization. Our implementation uses - significantly~($O(50\%)$) fewer fusions than reported - by~\cite{HELAC:2000}. Our pruning of the DAG might - be responsible for this. *) - -module Helac : functor (B : Tuple.Bound) -> Maker -module Helac_Majorana : functor (B : Tuple.Bound) -> Maker - -(* \thocwmodulesection{Multiple Colored Amplitudes} *) - -module type Colored = - sig - exception Mismatch - val options : Options.t - - type flavor - type amplitude - type selectors - type amplitudes - - (* Construct all possible color flow amplitudes for a given process. *) - val amplitudes : bool -> selectors -> (flavor list * flavor list) list -> amplitudes - - (* The list of all combinations of incoming and outgoing particles - with a nonvanishing scattering amplitude. *) - val flavors : amplitudes -> (flavor list * flavor list) list - - (* The list of all combinations of incoming and outgoing particles that - lead to a vanishing scattering amplitude. *) - val vanishing_flavors : amplitudes -> (flavor list * flavor list) list - - (* The list of all color flows with a nonvanishing scattering amplitude. *) - val color_flows : amplitudes -> Color.Flow.t list - - (* The list of all color flows that lead to a vanishing scattering amplitude. *) - val vanishing_color_flows : amplitudes -> Color.Flow.t list - - (* The list of all valid helicity combinations. *) - val helicities : amplitudes -> (int list * int list) list - - (* The rectangular nested list of all scattering amplitudes. *) - val processes : amplitudes -> amplitude list list - - (* A description of optional diagram selectors. *) - val constraints : amplitudes -> string option - - end - -module type Colored_Maker = functor (Fusion_Maker : Maker) -> - functor (P : Momentum.T) -> - functor (Colorized_Model : Model.Colorized) -> - Colored with type flavor = Colorized_Model.M.flavor - and type amplitude = Fusion_Maker(P)(Colorized_Model).amplitude - and type selectors = Fusion_Maker(P)(Colorized_Model).selectors - -module Colored : Colored_Maker - -(* \thocwmodulesection{Tags} *) - -(* It appears that there are useful applications for tagging couplings - and wave functions, e.\,g.~skeleton expansion and diagram selections. - We can abstract this in a [Tags] signature: *) - -module type Tags = - sig - type wf - type coupling - type 'a children - val null_wf : wf - val null_coupling : coupling - val fuse : coupling -> wf children -> wf - val wf_to_string : wf -> string option - val coupling_to_string : coupling -> string option - end - -module type Tagger = - functor (PT : Tuple.Poly) -> Tags with type 'a children = 'a PT.t - -module type Tagged_Maker = - functor (Tagger : Tagger) -> - functor (P : Momentum.T) -> functor (M : Model.T) -> - T with type p = P.t and type flavor = M.flavor - and type constant = M.constant - -module Tagged_Binary : Tagged_Maker - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/phasespace.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/phasespace.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/phasespace.ml (revision 8703) @@ -1,378 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -(* \thocwmodulesection{Tools} *) - -(* These are candidates for [ThoList] and not specific to phase space. *) - -let rec first_match' mismatch f = function - | [] -> None - | x :: rest -> - if f x then - Some (x, List.rev_append mismatch rest) - else - first_match' (x :: mismatch) f rest - -(* Returns $(x,X\setminus\{x\})$ if $\exists x\in X: f(x)$. *) - -let first_match f l = first_match' [] f l - -let rec first_pair' mismatch1 f l1 l2 = - match l1 with - | [] -> None - | x1 :: rest1 -> - begin match first_match (f x1) l2 with - | None -> first_pair' (x1 :: mismatch1) f rest1 l2 - | Some (x2, rest2) -> - Some ((x1, x2), (List.rev_append mismatch1 rest1, rest2)) - end - -(* Returns $((x,y),(X\setminus\{x\},Y\setminus\{y\}))$ if - $\exists x\in X: \exists y\in Y: f(x,y)$. *) - -let first_pair f l1 l2 = first_pair' [] f l1 l2 - -(* \thocwmodulesection{Phase Space Parameterization Trees} *) - -module type T = - sig - type momentum - type 'a t - type 'a decay - val sort : ('a -> 'a -> int) -> 'a t -> 'a t - val sort_decay : ('a -> 'a -> int) -> 'a decay -> 'a decay - val map : ('a -> 'b) -> 'a t -> 'b t - val map_decay : ('a -> 'b) -> 'a decay -> 'b decay - val eval : ('a -> 'b) -> ('a -> 'b) -> ('a -> 'b -> 'b -> 'b) -> 'a t -> 'b t - val eval_decay : ('a -> 'b) -> ('a -> 'b -> 'b -> 'b) -> 'a decay -> 'b decay - val of_momenta : 'a -> 'a -> (momentum * 'a) list -> (momentum * 'a) t - val decay_of_momenta : (momentum * 'a) list -> (momentum * 'a) decay - exception Duplicate of momentum - exception Unordered of momentum - exception Incomplete of momentum - end - -module Make (M : Momentum.T) = - struct - - type momentum = M.t - -(* \begin{dubious} - Finally, we came back to binary trees \ldots - \end{dubious} *) - -(* \thocwmodulesubsection{Cascade Decays} *) - - type 'a decay = - | Leaf of 'a - | Branch of 'a * 'a decay * 'a decay - -(* \begin{dubious} - Trees of type [(momentum * 'a option) decay] can be build easily and - mapped to [(momentum * 'a) decay] later, once all the ['a] slots are - filled. A more elegant functor operating on ['b decay] directly (with - [Momentum] style functions defined for ['b]) would not allow holes in - the ['b decay] during the construction. - \end{dubious} *) - - let label = function - | Leaf p -> p - | Branch (p, _, _) -> p - - let rec sort_decay cmp = function - | Leaf _ as l -> l - | Branch (p, d1, d2) -> - let d1' = sort_decay cmp d1 - and d2' = sort_decay cmp d2 in - if cmp (label d1') (label d2') <= 0 then - Branch (p, d1', d2') - else - Branch (p, d2', d1') - - let rec map_decay f = function - | Leaf p -> Leaf (f p) - | Branch (p, d1, d2) -> Branch (f p, map_decay f d1, map_decay f d2) - - let rec eval_decay fl fb = function - | Leaf p -> Leaf (fl p) - | Branch (p, d1, d2) -> - let d1' = eval_decay fl fb d1 - and d2' = eval_decay fl fb d2 in - Branch (fb p (label d1') (label d2'), d1', d2') - -(* Assuming that $p>p_D \lor p=p_D \lor p - if M.less p' p then - Branch ((p, Some f), d', Leaf (M.sub p p', None)) - else if M.less p p' then - Branch (pf', Leaf (p, Some f), Leaf (M.sub p' p, None)) - else if p = p' then - begin match f' with - | None -> Leaf (p, Some f) - | Some _ -> raise (Duplicate p) - end - else - raise (Unordered p) - | Branch ((p', f' as pf'), d1, d2) as d' -> - let p1, _ = label d1 - and p2, _ = label d2 in - if M.less p' p then - Branch ((p, Some f), d', Leaf (M.sub p p', None)) - else if M.lesseq p p1 then - Branch (pf', embed_in_decay pf d1, d2) - else if M.lesseq p p2 then - Branch (pf', d1, embed_in_decay pf d2) - else if p = p' then - begin match f' with - | None -> Branch ((p, Some f), d1, d2) - | Some _ -> raise (Duplicate p) - end - else - raise (Unordered p) - -(* \begin{dubious} - Note that both [embed_in_decay] and [embed_in_decays] below do - \emph{not} commute, and should process `bigger' momenta first, - because disjoint sub-momenta will create disjoint subtrees in - the latter and raise exceptions in the former. - \end{dubious} *) - - exception Incomplete of momentum - - let finalize1 = function - | p, Some f -> (p, f) - | p, None -> raise (Incomplete p) - - let finalize_decay t = map_decay finalize1 t - -(* Process the momenta starting in with the highest [M.rank]: *) - - let sort_momenta plist = - List.sort (fun (p1, _) (p2, _) -> M.compare p1 p2) plist - - let decay_of_momenta plist = - match sort_momenta plist with - | (p, f) :: rest -> - finalize_decay (List.fold_right embed_in_decay rest (Leaf (p, Some f))) - | [] -> invalid_arg "Phasespace.decay_of_momenta: empty" - -(* \thocwmodulesubsection{$2\to n$ Scattering } *) - -(* \begin{figure} - \begin{center} - \begin{fmfgraph*}(80,50) - %%%\fmfstraight - \fmftopn{i}{2} - \fmfbottomn{o}{20} - \fmf{plain,label=$p_1$}{i1,v1} - \fmf{plain,label=$p_2$}{i2,v2} - \fmf{phantom}{o1,v1,w1,w2,w3,w4,w5,v2,o20} - \fmfdot{v1,v2} - \fmfdot{w2,w4} - \fmffreeze - \fmfshift{(0,.2h)}{w1,w3,w5} - \fmflabel{$t_1$}{w1} - \fmflabel{$t_2$}{w3} - \fmfi{plain}{vloc(__v1)...{right}vloc(__w1){right}...vloc(__w2)} - \fmfi{plain}{vloc(__w2)...{right}vloc(__w3){right}...vloc(__w4)} - \fmfi{dashes}{vloc(__w4)...{right}vloc(__w5){right}...vloc(__v2)} - \fmf{plain,tension=2,label=$s_1$}{v1,p1} - \fmf{plain}{o1,p1,q1,o4} - \fmf{plain,tension=0}{q1,o3} - \fmf{plain,tension=2,label=$s_2$}{w2,p2} - \fmf{plain}{o6,p2,q2,o9} - \fmf{plain,tension=0}{q2,o8} - \fmf{plain,tension=2,label=$s_3$}{w4,p3} - \fmf{plain}{o12,q3,p3,o15} - \fmf{plain,tension=0}{q3,o13} - \fmf{plain,tension=2,label=$s_4$}{v2,p4} - \fmf{plain}{o17,q4,p4,o20} - \fmf{plain,tension=0}{q4,o18} - \fmfdotn{p}{4} - \fmfdotn{q}{4} - \end{fmfgraph*} - \end{center} - \caption{\label{fig:phasespace}% - Phasespace parameterization for~$2\to n$ scattering by a sequence - of cascade decays.} - \end{figure} - A general $2\to n$ scattering process can be parameterized by a sequence - of cascade decays. The most symmetric representation is a little bit - redundant and enters each $t$-channel momentum twice. *) - - type 'a t = ('a * 'a decay * 'a) list - -(* \begin{dubious} - [let topology = map snd] has type [(momentum * 'a) t -> 'a t] - and can be used to define topological equivalence classes ``up to - permutations of momenta,'' which are useful for calculating Whizard - ``groves''\footnote{Not to be confused with gauge invariant classes - of Feynman diagrams~\cite{Boos/Ohl:groves}.}~\cite{Kilian:WHIZARD}. - \end{dubious} *) - - let sort cmp = List.map (fun (l, d, r) -> (l, sort_decay cmp d, r)) - let map f = List.map (fun (l, d, r) -> (f l, map_decay f d, f r)) - let eval ft fl fb = List.map (fun (l, d, r) -> (ft l, eval_decay fl fb d, ft r)) - -(* Find a tree with a defined ordering relation with respect to~$p$ or create - a new one at the end of the list. *) - - let rec embed_in_decays (p, f as pf) = function - | [] -> [Leaf (p, Some f)] - | d' :: rest -> - let p', _ = label d' in - if M.lesseq p' p || M.less p p' then - embed_in_decay pf d' :: rest - else - d' :: embed_in_decays pf rest - -(* \thocwmodulesubsection{Collecting Ingredients} *) - - type 'a unfinished_decays = - { n : int; - t_channel : (momentum * 'a option) list; - decays : (momentum * 'a option) decay list } - - let empty n = { n = n; t_channel = []; decays = [] } - - let insert_in_unfinished_decays (p, f as pf) d = - if M.spacelike p then - { d with t_channel = (p, Some f) :: d.t_channel } - else - { d with decays = embed_in_decays pf d.decays } - - let flip_incoming plist = - List.map (fun (p', f') -> (M.flip_s_channel_in p', f')) plist - - let unfinished_decays_of_momenta n f2 p = - List.fold_right insert_in_unfinished_decays - (sort_momenta (flip_incoming ((M.of_ints n [2], f2) :: p))) (empty n) - -(* \thocwmodulesubsection{Assembling Ingredients} *) - - let sort3 compare x y z = - let a = [| x; y; z |] in - Array.sort compare a; - (a.(0), a.(1), a.(2)) - -(* Take advantage of the fact that sorting with [M.compare] - sorts with \emph{rising} values of [M.rank]: *) - - let allows_momentum_fusion (p, _) (p1, _) (p2, _) = - let p2', p1', p' = sort3 M.compare p p1 p2 in - match M.try_fusion p' p1' p2' with - | Some _ -> true - | None -> false - - let allows_fusion p1 p2 d = allows_momentum_fusion (label d) p1 p2 - - let rec thread_unfinished_decays' p acc tlist dlist = - match first_pair (allows_fusion p) tlist dlist with - | None -> (p, acc, tlist, dlist) - | Some ((t, _ as td), (tlist', dlist')) -> - thread_unfinished_decays' t (td :: acc) tlist' dlist' - - let thread_unfinished_decays p c = - match thread_unfinished_decays' p [] c.t_channel c.decays with - | _, pairs, [], [] -> pairs - | _ -> failwith "thread_unfinished_decays" - - let rec combine_decays = function - | [] -> [] - | ((t, f as tf), d) :: rest -> - let p, _ = label d in - begin match M.try_sub t p with - | Some p' -> (tf, d, (p', f)) :: combine_decays rest - | None -> (tf, d, (M.sub (M.neg t) p, f)) :: combine_decays rest - end - - let finalize t = map finalize1 t - - let of_momenta f1 f2 = function - | (p, _) :: _ as l -> - let n = M.dim p in - finalize (combine_decays - (thread_unfinished_decays (M.of_ints n [1], Some f1) - (unfinished_decays_of_momenta n f2 l))) - | [] -> [] - -(* \thocwmodulesubsection{Diagnostics} *) - - let p_to_string p = - String.concat "" (List.map string_of_int (M.to_ints (M.abs p))) - - let rec to_string1 = function - | Leaf p -> "(" ^ p_to_string p ^ ")" - | Branch (_, d1, d2) -> "(" ^ to_string1 d1 ^ to_string1 d2 ^ ")" - - let to_string ps = - String.concat "/" - (List.map (fun (p1, d, p2) -> - p_to_string p1 ^ to_string1 d ^ p_to_string p2) ps) - -(* \thocwmodulesubsection{Examples} *) - - let try_thread_unfinished_decays p c = - thread_unfinished_decays' p [] c.t_channel c.decays - - let try_of_momenta f = function - | (p, _) :: _ as l -> - let n = M.dim p in - try_thread_unfinished_decays - (M.of_ints n [1], None) (unfinished_decays_of_momenta n f l) - | [] -> invalid_arg "try_of_momenta" - - end - -(*i - module M = Momentum.Lists - module PS = Phasespace.Make (M) - open PS - let u n = List.map (fun p -> (M.of_ints n p, ())) - let four_t = u 6 [[3;4]; [1;3;4]; [5;6]] - let four_s = u 6 [[3;4;5;6]; [3;4]; [5;6]] - let six_mp_1 = u 8 [[3;4]; [1;3;4]; [5;6]; [1;3;4;5;6]; [7;8]] - let six_mp_2 = u 8 [[3;4]; [1;3;4]; [5;6]; [2;7;8]; [7;8]] - let f = map (fun (p, ()) -> M.to_ints p) - let four_t' = f (of_momenta () () four_t) - let four_s' = f (of_momenta () () four_s) - let six_mp_1' = f (of_momenta () () six_mp_1) - let six_mp_2' = f (of_momenta () () six_mp_2) -i*) - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/models2.mli =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/models2.mli (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/models2.mli (revision 8703) @@ -1,45 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -(* \thocwmodulesection{More Hardcoded Models} *) - -module type MSSM_flags = - sig - val include_goldstone : bool - val include_four : bool - val ckm_present : bool - end -module MSSM_no_goldstone : MSSM_flags -module MSSM_goldstone : MSSM_flags -module MSSM_no_4 : MSSM_flags -module MSSM_no_4_ckm : MSSM_flags -module MSSM_QCD : MSSM_flags -module MSSM_QCD_ckm : MSSM_flags -module MSSM : functor (F: MSSM_flags) -> Model.T - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/f90_Xdim.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/f90_Xdim.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/f90_Xdim.ml (revision 8703) @@ -1,33 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -module O = Omega.Make(Fusion.Mixed23)(Targets.Fortran) - (Models4.Xdim(Models4.BSM_bsm)) -let _ = O.main () - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/models4.mli =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/models4.mli (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/models4.mli (revision 8703) @@ -1,50 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -(* \thocwmodulesection{More Hardcoded BSM Models} *) - -module type BSM_flags = - sig - val u1_gauged : bool - val anom_ferm_ass : bool - end - -module BSM_bsm : BSM_flags -module BSM_ungauged : BSM_flags -module BSM_anom : BSM_flags -module Littlest : functor (F: BSM_flags) -> Model.Gauge -module Littlest_Tpar : functor (F: BSM_flags) -> Model.T -module Simplest : functor (F: BSM_flags) -> Model.T -module Xdim : functor (F: BSM_flags) -> Model.Gauge -module UED : functor (F: BSM_flags) -> Model.Gauge -module GravTest : functor (F: BSM_flags) -> Model.Gauge -module Template : functor (F : BSM_flags) -> Model.Gauge - - - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/thoString.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/thoString.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/thoString.ml (revision 8703) @@ -1,116 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -let strip_prefix p s = - let lp = String.length p - and ls = String.length s in - if lp > ls then - s - else - let rec strip_prefix' i = - if i >= lp then - String.sub s i (ls - i) - else if p.[i] <> s.[i] then - s - else - strip_prefix' (succ i) - in - strip_prefix' 0 - -let strip_prefix_star p s = - let ls = String.length s in - if ls < 1 then - s - else - let rec strip_prefix_star' i = - if i < ls then begin - if p <> s.[i] then - String.sub s i (ls - i) - else - strip_prefix_star' (succ i) - end else - "" - in - strip_prefix_star' 0 - -let strip_required_prefix p s = - let lp = String.length p - and ls = String.length s in - if lp > ls then - invalid_arg ("strip_required_prefix: expected `" ^ p ^ "' got `" ^ s ^ "'") - else - let rec strip_prefix' i = - if i >= lp then - String.sub s i (ls - i) - else if p.[i] <> s.[i] then - invalid_arg ("strip_required_prefix: expected `" ^ p ^ "' got `" ^ s ^ "'") - else - strip_prefix' (succ i) - in - strip_prefix' 0 - -let strip_from_first c s = - try - String.sub s 0 (String.index s c) - with - | Not_found -> s - -let strip_from_last c s = - try - String.sub s 0 (String.rindex s c) - with - | Not_found -> s - -let index_string pat s = - let lpat = String.length pat - and ls = String.length s in - if lpat = 0 then - 0 - else - let rec index_string' n = - let i = String.index_from s n pat.[0] in - if i + lpat > ls then - raise Not_found - else - if String.compare pat (String.sub s i lpat) = 0 then - i - else - index_string' (succ i) - in - index_string' 0 - -let quote s = - if String.contains s ' ' || String.contains s '\n' then begin - if String.contains s '"' then - "'" ^ s ^ "'" - else - "\"" ^ s ^ "\"" - end else - s - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/f90_Zprime.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/f90_Zprime.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/f90_Zprime.ml (revision 8703) @@ -1,984 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -let rcs_file = RCS.parse "F90_Zprime" ["Standard Model with Additional Vectors"] - { RCS.revision = "$Revision$"; - RCS.date = "$Date$"; - RCS.author = "$Author$"; - RCS.source - = "$URL$" } - -(* \thocwmodulesection{SM with Littlest Higgs Z'} *) - -module type SM_flags = - sig - val include_gluons : bool - val include_anomalous : bool - val include_supp : bool - val k_matrix : bool - end - -module SM_no_anomalous : SM_flags = - struct - let include_gluons = false - let include_anomalous = false - let include_supp = false - let k_matrix = false - end - -module SM_anomalous : SM_flags = - struct - let include_gluons = false - let include_anomalous = true - let include_supp = false - let k_matrix = false - end - -module SM_k_matrix : SM_flags = - struct - let include_gluons = false - let include_anomalous = false - let include_supp = false - let k_matrix = true - end - -module SM_gluons : SM_flags = - struct - let include_gluons = true - let include_anomalous = false - let include_supp = false - let k_matrix = false - end - -module SM_supp : SM_flags = - struct - let include_gluons = false - let include_anomalous = false - let include_supp = true - let k_matrix = false - end - -module Zprime (Flags : SM_flags) = - struct - let rcs = rcs_file - - open Coupling - - let default_width = ref Timelike - let use_fudged_width = ref false - - let options = Options.create - [ "constant_width", Arg.Unit (fun () -> default_width := Constant), - "use constant width (also in t-channel)"; - "fudged_width", Arg.Set use_fudged_width, - "use fudge factor for charge particle width"; - "custom_width", Arg.String (fun f -> default_width := Custom f), - "use custom width"; - "cancel_widths", Arg.Unit (fun () -> default_width := Vanishing), - "use vanishing width" ] - -(* We do not introduce the Goldstones for the heavy vectors here. *) - - type matter_field = L of int | N of int | U of int | D of int - | TopH | TopHq | DH | DHq - type gauge_boson = Ga | Wp | Wm | Z | Gl | Gl_aux - | Xp | Xm | X0 | Y0 | ZH - type other = Phip | Phim | Phi0 | H | Eta - type flavor = M of matter_field | G of gauge_boson | O of other - type flavor_sans_color = flavor - let flavor_sans_color f = f - let matter_field f = M f - let gauge_boson f = G f - let other f = O f - - type field = - | Matter of matter_field - | Gauge of gauge_boson - | Other of other - - let field = function - | M f -> Matter f - | G f -> Gauge f - | O f -> Other f - - type gauge = unit - - let gauge_symbol () = - failwith "Models.Zprime.gauge_symbol: internal error" - - let family n = List.map matter_field [ L n; N n; U n; D n ] - - let external_flavors () = - [ "1st Generation", ThoList.flatmap family [1; -1]; - "2nd Generation", ThoList.flatmap family [2; -2]; - "3rd Generation", ThoList.flatmap family [3; -3]; - "Heavy Quarks", List.map matter_field [TopH; TopHq; DH; DHq]; - "Gauge Bosons", List.map gauge_boson [Ga; Z; Wp; Wm; Gl; Xp; - Xm; X0; Y0; ZH]; - "Higgs", List.map other [H; Eta]; - "Goldstone Bosons", List.map other [Phip; Phim; Phi0] ] - - let flavors () = ThoList.flatmap snd (external_flavors ()) @ - [ G Gl_aux] - - let squ = function - | x -> Pow (Atom x, 2) - - let spinor n = - if n >= 0 then - Spinor - else - ConjSpinor - - let lorentz = function - | M f -> - begin match f with - | L n -> spinor n | N n -> spinor n - | U n -> spinor n | D n -> spinor n - | TopH -> Spinor | TopHq -> ConjSpinor - | DH -> Spinor | DHq -> ConjSpinor - end - | G f -> - begin match f with - | Ga | Gl -> Vector - | Wp | Wm | Z | Xp | Xm | X0 | Y0 | ZH -> Massive_Vector - | Gl_aux -> Tensor_1 - end - | O f -> - Scalar - - let color = function - | M (U n) -> Color.SUN (if n > 0 then 3 else -3) - | M (D n) -> Color.SUN (if n > 0 then 3 else -3) - | M TopH -> Color.SUN 3 | M TopHq -> Color.SUN (-3) - | M DH -> Color.SUN 3 | M DHq -> Color.SUN (-3) - | G Gl | G Gl_aux -> Color.AdjSUN 3 - | _ -> Color.Singlet - - let prop_spinor n = - if n >= 0 then - Prop_Spinor - else - Prop_ConjSpinor - - let propagator = function - | M f -> - begin match f with - | L n -> prop_spinor n | N n -> prop_spinor n - | U n -> prop_spinor n | D n -> prop_spinor n - | TopH -> Prop_Spinor | TopHq -> Prop_ConjSpinor - | DH -> Prop_Spinor | DHq -> Prop_ConjSpinor - end - | G f -> - begin match f with - | Ga | Gl -> Prop_Feynman - | Wp | Wm | Z | Xp | Xm | X0 | Y0 | ZH -> Prop_Unitarity - | Gl_aux -> Aux_Tensor_1 - end - | O f -> - begin match f with - | Phip | Phim | Phi0 -> Only_Insertion - | H | Eta -> Prop_Scalar - end - -(* Optionally, ask for the fudge factor treatment for the widths of - charged particles. Currently, this only applies to $W^\pm$ and top. *) - - let width f = - if !use_fudged_width then - match f with - | G Wp | G Wm | M (U 3) | M (U (-3)) - | M TopH | M TopHq | M DH | M DHq -> Fudged - | _ -> !default_width - else - !default_width - - let goldstone = function - | G f -> - begin match f with - | Wp -> Some (O Phip, Coupling.Const 1) - | Wm -> Some (O Phim, Coupling.Const 1) - | Z -> Some (O Phi0, Coupling.Const 1) - | _ -> None - end - | _ -> None - - let conjugate = function - | M f -> - M (begin match f with - | L n -> L (-n) | N n -> N (-n) - | U n -> U (-n) | D n -> D (-n) - | TopH -> TopHq | TopHq -> TopH - | DH -> DHq | DHq -> DH - end) - | G f -> - G (begin match f with - | Gl -> Gl | Ga -> Ga | Z -> Z - | Wp -> Wm | Wm -> Wp - | Xp -> Xm | Xm -> Xp | X0 -> X0 | Y0 -> Y0 | ZH -> ZH - | Gl_aux -> Gl_aux - end) - | O f -> - O (begin match f with - | Phip -> Phim | Phim -> Phip | Phi0 -> Phi0 - | H -> H | Eta -> Eta - end) - - let conjugate_sans_color = conjugate - - let fermion = function - | M f -> - begin match f with - | L n -> if n > 0 then 1 else -1 - | N n -> if n > 0 then 1 else -1 - | U n -> if n > 0 then 1 else -1 - | D n -> if n > 0 then 1 else -1 - | TopH -> 1 | TopHq -> -1 - | DH -> 1 | DHq -> -1 - end - | G f -> - begin match f with - | Gl | Ga | Z | Wp | Wm | Gl_aux | Xp | Xm | X0 | Y0 | ZH -> 0 - end - | O _ -> 0 - - type constant = - | Unit | Pi | Alpha_QED | Sin2thw - | Sinthw | Costhw | E | G_weak | Vev | VHeavy - | Supp | Supp2 - | Sinpsi | Cospsi | Atpsi | Sccs (* Mixing angles of SU(2) *) - | Q_lepton | Q_up | Q_down | Q_Z_up | G_CC - | G_NC_neutrino | G_NC_lepton | G_NC_up | G_NC_down - | G_NC_h_neutrino | G_NC_h_lepton | G_NC_h_up | G_NC_h_down - | G_CC_heavy | G_zhthth - | G_CC_supp1 | G_CC_supp2 - | I_Q_W | I_G_ZWW | I_G_WWW - | I_G_Z1 | I_G_Z2 | I_G_Z3 | I_G_Z4 - | I_Q_H | I_Q_ZH | G_over4 | G_over4_sup | G_CC_sup - | G_WWWW | G_ZZWW | G_AZWW | G_AAWW - | I_G1_AWW | I_G1_ZWW - | I_G1_plus_kappa_AWW | I_G1_plus_kappa_ZWW - | I_G1_minus_kappa_AWW | I_G1_minus_kappa_ZWW - | I_kappa_minus_G1_AWW | I_kappa_minus_G1_ZWW - | I_lambda_AWW | I_lambda_ZWW - | Alpha_WWWW0 | Alpha_ZZWW1 | Alpha_WWWW2 - | Alpha_ZZWW0 | Alpha_ZZZZ - | G_HWW | G_HHWW | G_HZZ | G_HHZZ - | G_heavy_HVV | G_heavy_HWW | G_heavy_HZZ | G_heavy_HHVV - | G_Htt | G_Hbb | G_Hcc | G_Htautau | G_H3 | G_H4 - | G_Hthth | G_Htht | G_Ethth | G_Etht | G_Ett - | G_Ebb | G_ZEH | G_ZHEH | G_XEH - | G_HGaGa | G_HGaZ | G_EGaGa | G_EGaZ | G_EGlGl - | G_strong - | Mass of flavor | Width of flavor - | K_Matrix_Coeff of int | K_Matrix_Pole of int - -(* \begin{dubious} - The current abstract syntax for parameter dependencies is admittedly - tedious. Later, there will be a parser for a convenient concrete syntax - as a part of a concrete syntax for models. But as these examples show, - it should include simple functions. - \end{dubious} *) - - - let input_parameters = - [ Alpha_QED, 1. /. 137.0359895; - Sin2thw, 0.23124; - VHeavy, 2000.0; - Mass (G Z), 91.187; - Mass (M (N 1)), 0.0; Mass (M (L 1)), 0.51099907e-3; - Mass (M (N 2)), 0.0; Mass (M (L 2)), 0.105658389; - Mass (M (N 3)), 0.0; Mass (M (L 3)), 1.77705; - Mass (M (U 1)), 5.0e-3; Mass (M (D 1)), 3.0e-3; - Mass (M (U 2)), 1.2; Mass (M (D 2)), 0.1; - Mass (M (U 3)), 174.0; Mass (M (D 3)), 4.2 ] - - -(* hier, Hier, hallo, hier Higgs couplings still missing. *) - - let derived_parameters = - [ Real E, Sqrt (Prod [Const 4; Atom Pi; Atom Alpha_QED]); - Real Sinthw, Sqrt (Atom Sin2thw); - Real Costhw, Sqrt (Diff (Const 1, Atom Sin2thw)); - Real G_weak, Quot (Atom E, Atom Sinthw); - Real (Mass (G Wp)), Prod [Atom Costhw; Atom (Mass (G Z))]; - Real Vev, Quot (Prod [Const 2; Atom (Mass (G Wp))], Atom G_weak); - Real Supp, Quot (Atom Vev, Atom VHeavy); - Real Supp2, squ Supp; - Real Atpsi, Quot (Atom Cospsi, Atom Sinpsi); - Real Sccs, Prod [Atom Sinpsi; Atom Cospsi; - Diff (squ Cospsi, squ Sinpsi)]; - Real Q_lepton, Atom E; - Real Q_up, Prod [Quot (Const (-2), Const 3); Atom E]; - Real Q_down, Prod [Quot (Const 1, Const 3); Atom E]; - Real G_CC, Neg (Quot (Atom G_weak, Prod [Const 2; Sqrt (Const 2)])); - Real G_CC_heavy, Prod [Atom G_CC; Atom Atpsi]; -(* Real G_NC_heavy, Quot (Prod [Atom G_weak; Atom Atpsi], Const 4); *) - Complex I_Q_W, Prod [I; Atom E]; - Complex I_G_ZWW, Prod [I; Atom G_weak; Atom Costhw]; - Complex I_G_WWW, Prod [I; Atom G_weak]; - Complex I_Q_ZH, Neg (Prod [I; Atom G_weak; Atom Supp2; Atom Sccs - ]); - Complex I_Q_H, Quot (Atom I_Q_ZH, Atom Costhw) ] - -(* \begin{equation} - - \frac{g}{2\cos\theta_w} - \end{equation} *) - let g_over_2_costh = - Quot (Neg (Atom G_weak), Prod [Const 2; Atom Costhw]) - -(* \begin{subequations} - \begin{align} - - \frac{g}{2\cos\theta_w} g_V - &= - \frac{g}{2\cos\theta_w} (T_3 - 2 q \sin^2\theta_w) \\ - - \frac{g}{2\cos\theta_w} g_A - &= - \frac{g}{2\cos\theta_w} T_3 - \end{align} - \end{subequations} *) - let nc_coupling c t3 q = - (Real_Array c, - [Prod [g_over_2_costh; Diff (t3, Prod [Const 2; q; Atom Sin2thw])]; - Prod [g_over_2_costh; t3]]) - - let half = Quot (Const 1, Const 2) - - let derived_parameter_arrays = - [ nc_coupling G_NC_neutrino half (Const 0); - nc_coupling G_NC_lepton (Neg half) (Const (-1)); - nc_coupling G_NC_up half (Quot (Const 2, Const 3)); - nc_coupling G_NC_down (Neg half) (Quot (Const (-1), Const 3)) ] - - let parameters () = - { input = input_parameters; - derived = derived_parameters; - derived_arrays = derived_parameter_arrays } - - module F = Models.Fusions (struct - type f = flavor - type c = constant - let compare = compare - let conjugate = conjugate - end) - -(* \begin{equation} - \mathcal{L}_{\textrm{EM}} = - - e \sum_i q_i \bar\psi_i\fmslash{A}\psi_i - \end{equation} *) - - let mgm ((m1, g, m2), fbf, c) = ((M m1, G g, M m2), fbf, c) - let mom ((m1, o, m2), fbf, c) = ((M m1, O o, M m2), fbf, c) - - let electromagnetic_currents n = - List.map mgm - [ ((L (-n), Ga, L n), FBF (1, Psibar, V, Psi), Q_lepton); - ((U (-n), Ga, U n), FBF (1, Psibar, V, Psi), Q_up); - ((D (-n), Ga, D n), FBF (1, Psibar, V, Psi), Q_down) ] - - let color_currents n = - if Flags.include_gluons then - List.map mgm - [ ((U (-n), Gl, U n), FBF (1, Psibar, V, Psi), G_strong); - ((D (-n), Gl, D n), FBF (1, Psibar, V, Psi), G_strong) ] - else - [] - -(* \begin{equation} - \mathcal{L}_{\textrm{NC}} = - - \frac{g}{2\cos\theta_W} - \sum_i \bar\psi_i\fmslash{Z}(g_V^i-g_A^i\gamma_5)\psi_i - \end{equation} *) - - let neutral_currents n = - List.map mgm - [ ((L (-n), Z, L n), FBF (1, Psibar, VA, Psi), G_NC_lepton); - ((N (-n), Z, N n), FBF (1, Psibar, VA, Psi), G_NC_neutrino); - ((U (-n), Z, U n), FBF (1, Psibar, VA, Psi), G_NC_up); - ((D (-n), Z, D n), FBF (1, Psibar, VA, Psi), G_NC_down) ] - -(* The sign of this coupling is just the one of the T3, being -(1/2) for - leptons and down quarks, and +(1/2) for neutrinos and up quarks. *) - -(* This version is the canonical Little Higgs which is universal couplings - of the heavy Z to the SM fermions. - - let neutral_heavy_currents n = - List.map mgm - [ ((L (-n), ZH, L n), FBF (1, Psibar, VL, Psi), G_NC_heavy); - ((N (-n), ZH, N n), FBF ((-1), Psibar, VL, Psi), G_NC_heavy); - ((U (-n), ZH, U n), FBF ((-1), Psibar, VL, Psi), G_NC_heavy); - ((D (-n), ZH, D n), FBF (1, Psibar, VL, Psi), G_NC_heavy) ] - - We want to allow for (almost) completely general couplings but maintain - universality (generation independence). Maybe we should also separate the - coupling to the top quark since the third generation is somewhat special. - *) - - let neutral_heavy_currents n = - List.map mgm - [ ((L (-n), ZH, L n), FBF (1, Psibar, VLR, Psi), G_NC_h_lepton); - ((N (-n), ZH, N n), FBF ((-1), Psibar, VLR, Psi), G_NC_h_neutrino); - ((U (-n), ZH, U n), FBF ((-1), Psibar, VLR, Psi), G_NC_h_up); - ((D (-n), ZH, D n), FBF (1, Psibar, VLR, Psi), G_NC_h_down); - ] - - let heavy_top_currents = - List.map mgm - [ ((TopHq, Ga, TopH), FBF (1, Psibar, V, Psi), Q_up); - ((DHq, Ga, DH), FBF (1, Psibar, V, Psi), Q_down); - ((TopHq, Z, TopH), FBF (4, Psibar, V, Psi), Q_Z_up); - ((DHq, Z, DH), FBF (1, Psibar, V, Psi), Q_Z_up); - ((DHq, X0, D 1), FBF (1, Psibar, VL, Psi), G_over4); - ((D (-1), X0, DH), FBF (1, Psibar, VL, Psi), G_over4); - ((DHq, Y0, D 1), FBF (1, Psibar, VL, Psi), G_over4); - ((D (-1), Y0, DH), FBF ((-1), Psibar, VL, Psi), G_over4); - ((DHq, Xm, U 1), FBF (1, Psibar, VL, Psi), G_CC); - ((U (-1), Xp, DH), FBF (1, Psibar, VL, Psi), G_CC); - ((U (-3), X0, U 3), FBF (2, Psibar, VL, Psi), G_over4_sup); - ((U (-3), Y0, U 3), FBF (2, Psibar, VL, Psi), G_over4_sup); - ((U (-3), Xp, D 3), FBF (1, Psibar, VL, Psi), G_CC_sup); - ((D (-3), Xm, U 3), FBF (1, Psibar, VL, Psi), G_CC_sup)] - - - let neutral_supp_currents = - List.map mgm - [ ((TopHq, ZH, TopH), FBF (1, Psibar, VL, Psi), G_zhthth); - ((DHq, ZH, DH), FBF (1, Psibar, VL, Psi), G_zhthth)] - -(* \begin{equation} - \mathcal{L}_{\textrm{CC}} = - - \frac{g}{2\sqrt2} \sum_i \bar\psi_i - (T^+\fmslash{W}^+ + T^-\fmslash{W}^-)(1-\gamma_5)\psi_i - \end{equation} *) - - let charged_currents n = - List.map mgm - [ ((L (-n), Wm, N n), FBF (1, Psibar, VL, Psi), G_CC); - ((N (-n), Wp, L n), FBF (1, Psibar, VL, Psi), G_CC); - ((D (-n), Wm, U n), FBF (1, Psibar, VL, Psi), G_CC); - ((U (-n), Wp, D n), FBF (1, Psibar, VL, Psi), G_CC) ] - - let charged_heavy_currents n = - List.map mgm - [ ((L (-n), Xm, N n), FBF (1, Psibar, VL, Psi), G_CC_heavy); - ((N (-n), Xp, L n), FBF (1, Psibar, VL, Psi), G_CC_heavy); - ((D (-n), Xm, U n), FBF (1, Psibar, VL, Psi), G_CC_heavy); - ((U (-n), Xp, D n), FBF (1, Psibar, VL, Psi), G_CC_heavy) ] - -(* - let charged_supp_currents = - List.map mgm - [ ((TopHq, WHp, D 3), FBF (1, Psibar, VL, Psi), G_CC_supp1); - ((D (-3), WHm, TopH), FBF (1, Psibar, VL, Psi), G_CC_supp1); - ((TopHq, Wp, D 3), FBF (1, Psibar, VL, Psi), G_CC_supp2); - ((D (-3), Wm, TopH), FBF (1, Psibar, VL, Psi), G_CC_supp2)] -*) - - let yukawa = - [ ((M (U (-3)), O H, M (U 3)), FBF (1, Psibar, S, Psi), G_Htt); - ((M (D (-3)), O H, M (D 3)), FBF (1, Psibar, S, Psi), G_Hbb); - ((M (U (-2)), O H, M (U 2)), FBF (1, Psibar, S, Psi), G_Hcc); - ((M (L (-3)), O H, M (L 3)), FBF (1, Psibar, S, Psi), G_Htautau) ] - - let yukawa_add = - [ ((M TopHq, O H, M TopH), FBF (1, Psibar, S, Psi), G_Hthth); - ((M TopHq, O H, M (U 3)), FBF (1, Psibar, SLR, Psi), G_Htht); - ((M (U (-3)), O H, M TopH), FBF (1, Psibar, SLR, Psi), G_Htht); - ((M (U (-3)), O Eta, M (U 3)), FBF (1, Psibar, P, Psi), G_Ett); - ((M TopHq, O Eta, M (U 3)), FBF (1, Psibar, SLR, Psi), G_Etht); - ((M DHq, O Eta, M (D 1)), FBF (1, Psibar, SL, Psi), G_Ett); - ((M (D (-3)), O Eta, M (D 3)), FBF (1, Psibar, P, Psi), G_Ebb); - ((M (D (-1)), O Eta, M DH), FBF (1, Psibar, SR, Psi), G_Ett); - ((M (U (-3)), O Eta, M TopH), FBF (1, Psibar, SLR, Psi), G_Etht)] - -(* \begin{equation} - \mathcal{L}_{\textrm{TGC}} = - - e \partial_\mu A_\nu W_+^\mu W_-^\nu + \ldots - - e \cot\theta_w \partial_\mu Z_\nu W_+^\mu W_-^\nu + \ldots - \end{equation} *) - - let tgc ((g1, g2, g3), t, c) = ((G g1, G g2, G g3), t, c) - - let standard_triple_gauge = - List.map tgc - [ ((Ga, Wm, Wp), Gauge_Gauge_Gauge 1, I_Q_W); - ((Z, Wm, Wp), Gauge_Gauge_Gauge 1, I_G_ZWW) ] - - - let heavy_triple_gauge = - List.map tgc - [ ((Ga, Xm, Xp), Gauge_Gauge_Gauge 1, I_Q_W); - ((Z, Xm, Xp), Gauge_Gauge_Gauge 1, I_Q_ZH); - ((Z, X0, Y0), Gauge_Gauge_Gauge 1, I_G_Z1); - ((ZH, X0, Y0), Gauge_Gauge_Gauge 1, I_G_Z2); - ((Y0, Wm, Xp), Gauge_Gauge_Gauge 1, I_G_Z3); - ((Y0, Wp, Xm), Gauge_Gauge_Gauge (-1), I_G_Z3); - ((X0, Wm, Xp), Gauge_Gauge_Gauge 1, I_G_Z4); - ((X0, Wp, Xm), Gauge_Gauge_Gauge 1, I_G_Z4); - ] - - - let triple_gluon = - if Flags.include_gluons then - List.map tgc - [ ((Gl, Gl, Gl), Gauge_Gauge_Gauge 1, G_strong); - ((Gl_aux, Gl, Gl), Aux_Gauge_Gauge 1, G_strong) ] - else - [] - -(* \begin{multline} - \mathcal{L}_{\textrm{TGC}}(g_1,\kappa) - = g_1 \mathcal{L}_T(V,W^+,W^-) \\ - + \frac{\kappa+g_1}{2} \Bigl(\mathcal{L}_T(W^-,V,W^+) - - \mathcal{L}_T(W^+,V,W^-)\Bigr)\\ - + \frac{\kappa-g_1}{2} \Bigl(\mathcal{L}_L(W^-,V,W^+) - - \mathcal{L}_T(W^+,V,W^-)\Bigr) - \end{multline} *) - - let anomalous_triple_gauge = - List.map tgc - [ ((Ga, Wp, Wm), Dim4_Vector_Vector_Vector_T 1, - I_G1_AWW); - ((Z, Wp, Wm), Dim4_Vector_Vector_Vector_T 1, - I_G1_ZWW); - ((Wp, Wm, Ga), Dim4_Vector_Vector_Vector_T 1, - I_G1_plus_kappa_AWW); - ((Wp, Wm, Z), Dim4_Vector_Vector_Vector_T 1, - I_G1_plus_kappa_ZWW); - ((Wp, Wm, Ga), Dim4_Vector_Vector_Vector_L 1, - I_G1_minus_kappa_AWW); - ((Wp, Wm, Z), Dim4_Vector_Vector_Vector_L 1, - I_G1_minus_kappa_ZWW); - ((Wm, Ga, Wp), Dim4_Vector_Vector_Vector_T 1, - I_G1_plus_kappa_AWW); - ((Wm, Z, Wp), Dim4_Vector_Vector_Vector_T 1, - I_G1_plus_kappa_ZWW); - ((Wm, Ga, Wp), Dim4_Vector_Vector_Vector_L 1, - I_kappa_minus_G1_AWW); - ((Wm, Z, Wp), Dim4_Vector_Vector_Vector_L 1, - I_kappa_minus_G1_ZWW); - ((Ga, Wp, Wm), Dim6_Gauge_Gauge_Gauge 1, - I_lambda_AWW); - ((Z, Wp, Wm), Dim6_Gauge_Gauge_Gauge 1, - I_lambda_ZWW) ] - - let triple_gauge = - if Flags.include_anomalous then - anomalous_triple_gauge - else - standard_triple_gauge @ heavy_triple_gauge - - let qgc ((g1, g2, g3, g4), t, c) = ((G g1, G g2, G g3, G g4), t, c) - - let gauge4 = Vector4 [(2, C_13_42); (-1, C_12_34); (-1, C_14_23)] - let minus_gauge4 = Vector4 [(-2, C_13_42); (1, C_12_34); (1, C_14_23)] - let standard_quartic_gauge = - List.map qgc - [ (Wm, Wp, Wm, Wp), gauge4, G_WWWW; - (Wm, Z, Wp, Z), minus_gauge4, G_ZZWW; - (Wm, Z, Wp, Ga), minus_gauge4, G_AZWW; - (Wm, Ga, Wp, Ga), minus_gauge4, G_AAWW ] - - - let anomalous_quartic_gauge = - if Flags.include_anomalous then - List.map qgc - [ ((Wm, Wm, Wp, Wp), - Vector4 [(1, C_13_42); (1, C_14_23)], Alpha_WWWW0); - ((Wm, Wm, Wp, Wp), - Vector4 [1, C_12_34], Alpha_WWWW2); - ((Wm, Wp, Z, Z), - Vector4 [1, C_12_34], Alpha_ZZWW0); - ((Wm, Wp, Z, Z), - Vector4 [(1, C_13_42); (1, C_14_23)], Alpha_ZZWW1); - ((Z, Z, Z, Z), - Vector4 [(1, C_12_34); (1, C_13_42); (1, C_14_23)], Alpha_ZZZZ) ] - else - [] - -(* In any diagonal channel~$\chi$, the scattering amplitude~$a_\chi(s)$ is - unitary iff\footnote{% - Trivial proof: - \begin{equation} - -1 = \textrm{Im}\left(\frac{1}{a_\chi(s)}\right) - = \frac{\textrm{Im}(a_\chi^*(s))}{|a_\chi(s)|^2} - = - \frac{\textrm{Im}(a_\chi(s))}{|a_\chi(s)|^2} - \end{equation} - i.\,e.~$\textrm{Im}(a_\chi(s)) = |a_\chi(s)|^2$.} - \begin{equation} - \textrm{Im}\left(\frac{1}{a_\chi(s)}\right) = -1 - \end{equation} - For a real perturbative scattering amplitude~$r_\chi(s)$ this can be - enforced easily--and arbitrarily--by - \begin{equation} - \frac{1}{a_\chi(s)} = \frac{1}{r_\chi(s)} - \mathrm{i} - \end{equation} *) - - let k_matrix_quartic_gauge = - if Flags.k_matrix then - List.map qgc - [ ((Wm, Wp, Wm, Wp), - Vector4_K_Matrix_tho (0, [K_Matrix_Coeff 0, K_Matrix_Pole 0]), Alpha_WWWW0); - ((Wm, Wm, Wp, Wp), - Vector4_K_Matrix_tho (0, [K_Matrix_Coeff 2, K_Matrix_Pole 2]), Alpha_WWWW0); - ((Wm, Wp, Z, Z), - Vector4_K_Matrix_tho (0, [(K_Matrix_Coeff 0, K_Matrix_Pole 0); - (K_Matrix_Coeff 2, K_Matrix_Pole 2)]), Alpha_WWWW0); - ((Wm, Z, Wp, Z), - Vector4_K_Matrix_tho (0, [K_Matrix_Coeff 1, K_Matrix_Pole 1]), Alpha_WWWW0); - ((Z, Z, Z, Z), - Vector4_K_Matrix_tho (0, [K_Matrix_Coeff 0, K_Matrix_Pole 0]), Alpha_WWWW0) ] - else - [] - - let heavy_quartic_gauge = - [] - - - let quartic_gauge = - standard_quartic_gauge @ anomalous_quartic_gauge @ k_matrix_quartic_gauge - @ heavy_quartic_gauge - - let standard_gauge_higgs' = - [ ((O H, G Wp, G Wm), Scalar_Vector_Vector 1, G_HWW); - ((O H, G Z, G Z), Scalar_Vector_Vector 1, G_HZZ) ] - - let heavy_gauge_higgs = - [ ((O H, G Wp, G Xm), Scalar_Vector_Vector 1, G_heavy_HWW); - ((O H, G Wm, G Xp), Scalar_Vector_Vector 1, G_heavy_HWW); - ((O H, G Z, G X0), Scalar_Vector_Vector 1, G_heavy_HVV); - ((O H, G ZH, G X0), Scalar_Vector_Vector 1, G_heavy_HVV)] - - let standard_gauge_higgs = - standard_gauge_higgs' @ heavy_gauge_higgs - - let standard_gauge_higgs4 = - [ (O H, O H, G Wp, G Wm), Scalar2_Vector2 1, G_HHWW; - (O H, O H, G Z, G Z), Scalar2_Vector2 1, G_HHZZ ] - -(* - let standard_heavy_gauge_higgs4 = - [ (O H, O H, G WHp, G Wm), Scalar2_Vector2 1, G_heavy_HHVV; - (O H, O H, G Wp, G WHm), Scalar2_Vector2 1, G_heavy_HHVV; - (O H, O H, G Z, G ZH), Scalar2_Vector2 1, G_heavy_HHVV ] -*) - - let standard_higgs = - [ (O H, O H, O H), Scalar_Scalar_Scalar 1, G_H3 ] - - let anomaly_higgs = - [ (* - (O H, G Ga, G Ga), Dim5_Scalar_Gauge2 1, G_HGaGa; - (O H, G Ga, G Z), Dim5_Scalar_Gauge2 1, G_HGaZ;*) - (O Eta, G Gl, G Gl), Dim5_Scalar_Gauge2_Skew 1, G_EGlGl; - (O Eta, G Ga, G Ga), Dim5_Scalar_Gauge2_Skew 1, G_EGaGa; - (O Eta, G Ga, G Z), Dim5_Scalar_Gauge2_Skew 1, G_EGaZ] - - let standard_higgs4 = - [ (O H, O H, O H, O H), Scalar4 1, G_H4 ] - - let anomalous_gauge_higgs = - [] - - let anomalous_gauge_higgs4 = - [] - - let anomalous_higgs = - [] - - let anomalous_higgs4 = - [] - - let gauge_higgs = - if Flags.include_anomalous then - standard_gauge_higgs @ anomalous_gauge_higgs - else - standard_gauge_higgs - - let gauge_higgs4 = - if Flags.include_anomalous then - standard_gauge_higgs4 @ anomalous_gauge_higgs4 - else - standard_gauge_higgs4 - - let higgs = - if Flags.include_anomalous then - standard_higgs @ anomalous_higgs - else - standard_higgs - - let eta_higgs_gauge = - [ (G Z, O Eta, O H), Vector_Scalar_Scalar 1, G_ZEH; - (G ZH, O Eta, O H), Vector_Scalar_Scalar 1, G_ZHEH; - (G X0, O Eta, O H), Vector_Scalar_Scalar 1, G_XEH ] - - - let higgs4 = - if Flags.include_anomalous then - standard_higgs4 @ anomalous_higgs4 - else - standard_higgs4 - - let goldstone_vertices = - [ ((O Phi0, G Wm, G Wp), Scalar_Vector_Vector 1, I_G_ZWW); - ((O Phip, G Ga, G Wm), Scalar_Vector_Vector 1, I_Q_W); - ((O Phip, G Z, G Wm), Scalar_Vector_Vector 1, I_G_ZWW); - ((O Phim, G Wp, G Ga), Scalar_Vector_Vector 1, I_Q_W); - ((O Phim, G Wp, G Z), Scalar_Vector_Vector 1, I_G_ZWW) ] - - let vertices3' = - (ThoList.flatmap electromagnetic_currents [1;2;3] @ - ThoList.flatmap color_currents [1;2;3] @ - ThoList.flatmap neutral_currents [1;2;3] @ - ThoList.flatmap neutral_heavy_currents [1;2;3] @ - ThoList.flatmap charged_currents [1;2;3] @ - anomaly_higgs @ -(* ThoList.flatmap charged_heavy_currents [1;2;3] @ *) - heavy_top_currents @ eta_higgs_gauge @ - yukawa @ yukawa_add @ triple_gauge @ triple_gluon @ - gauge_higgs @ higgs @ goldstone_vertices) - - let vertices3 = - if Flags.include_supp then - vertices3' @ neutral_supp_currents (* @ charged_supp_currents *) - else - vertices3' - - let vertices4 = - quartic_gauge @ gauge_higgs4 @ higgs4 - - let vertices () = (vertices3, vertices4, []) - -(* For efficiency, make sure that [F.of_vertices vertices] is - evaluated only once. *) - - let table = F.of_vertices (vertices ()) - let fuse2 = F.fuse2 table - let fuse3 = F.fuse3 table - let fuse = F.fuse table - let max_degree () = 4 - - let flavor_of_string = function - | "e-" -> M (L 1) | "e+" -> M (L (-1)) - | "mu-" -> M (L 2) | "mu+" -> M (L (-2)) - | "tau-" -> M (L 3) | "tau+" -> M (L (-3)) - | "nue" -> M (N 1) | "nuebar" -> M (N (-1)) - | "numu" -> M (N 2) | "numubar" -> M (N (-2)) - | "nutau" -> M (N 3) | "nutaubar" -> M (N (-3)) - | "u" -> M (U 1) | "ubar" -> M (U (-1)) - | "c" -> M (U 2) | "cbar" -> M (U (-2)) - | "t" -> M (U 3) | "tbar" -> M (U (-3)) - | "d" -> M (D 1) | "dbar" -> M (D (-1)) - | "s" -> M (D 2) | "sbar" -> M (D (-2)) - | "b" -> M (D 3) | "bbar" -> M (D (-3)) - | "th" -> M TopH | "thbar" -> M TopHq - | "dh" -> M DH | "dhbar" -> M DHq - | "eta" | "Eta" -> O Eta - | "g" -> G Gl - | "A" -> G Ga | "Z" | "Z0" -> G Z - | "ZH" | "ZH0" | "Zh" | "Zh0" -> G ZH - | "W+" -> G Wp | "W-" -> G Wm - | "X+" -> G Xp | "X-" -> G Xm - | "X0" -> G X0 | "Y0" -> G Y0 - | "H" -> O H - | _ -> invalid_arg "Models.Zprime.flavor_of_string" - - let flavor_to_string = function - | M f -> - begin match f with - | L 1 -> "e-" | L (-1) -> "e+" - | L 2 -> "mu-" | L (-2) -> "mu+" - | L 3 -> "tau-" | L (-3) -> "tau+" - | L _ -> invalid_arg - "Models.Zprime.flavor_to_string: invalid lepton" - | N 1 -> "nue" | N (-1) -> "nuebar" - | N 2 -> "numu" | N (-2) -> "numubar" - | N 3 -> "nutau" | N (-3) -> "nutaubar" - | N _ -> invalid_arg - "Models.Zprime.flavor_to_string: invalid neutrino" - | U 1 -> "u" | U (-1) -> "ubar" - | U 2 -> "c" | U (-2) -> "cbar" - | U 3 -> "t" | U (-3) -> "tbar" - | U _ -> invalid_arg - "Models.Zprime.flavor_to_string: invalid up type quark" - | D 1 -> "d" | D (-1) -> "dbar" - | D 2 -> "s" | D (-2) -> "sbar" - | D 3 -> "b" | D (-3) -> "bbar" - | D _ -> invalid_arg - "Models.Zprime.flavor_to_string: invalid down type quark" - | TopH -> "th" | TopHq -> "thbar" - | DH -> "dh" | DHq -> "dhbar" - end - | G f -> - begin match f with - | Gl -> "g" - | Ga -> "A" | Z -> "Z" - | Wp -> "W+" | Wm -> "W-" - | Xp -> "X+" | Xm -> "X-" | X0 -> "X0" | Y0 -> "Y0" | ZH -> "ZH" - | Gl_aux -> "gx" - end - | O f -> - begin match f with - | Phip -> "phi+" | Phim -> "phi-" | Phi0 -> "phi0" - | H -> "H" | Eta -> "Eta" - end - - let flavor_symbol = function - | M f -> - begin match f with - | L n when n > 0 -> "l" ^ string_of_int n - | L n -> "l" ^ string_of_int (abs n) ^ "b" - | N n when n > 0 -> "n" ^ string_of_int n - | N n -> "n" ^ string_of_int (abs n) ^ "b" - | U n when n > 0 -> "u" ^ string_of_int n - | U n -> "u" ^ string_of_int (abs n) ^ "b" - | D n when n > 0 -> "d" ^ string_of_int n - | D n -> "d" ^ string_of_int (abs n) ^ "b" - | TopH -> "th" | TopHq -> "thb" - | DH -> "dh" | DHq -> "dhb" - end - | G f -> - begin match f with - | Gl -> "gl" - | Ga -> "a" | Z -> "z" - | Wp -> "wp" | Wm -> "wm" - | Xp -> "xp" | Xm -> "xm" | X0 -> "x0" | Y0 -> "y0" | ZH -> "zh" - | Gl_aux -> "gx" - end - | O f -> - begin match f with - | Phip -> "pp" | Phim -> "pm" | Phi0 -> "p0" - | H -> "h" | Eta -> "eta" - end - - let flavor_sans_color_of_string = flavor_of_string - let flavor_sans_color_to_string = flavor_to_string - let flavor_sans_color_symbol = flavor_symbol - -(* There are PDG numbers for Z', Z'', W', 32-34, respectively. - We just introduce a number 38 for Y0 as a Z'''. - As well, there is the number 8 for a t'. But we cheat a little bit and - take the number 35 which is reserved for a heavy scalar Higgs for the - Eta scalar. -*) - - let pdg = function - | M f -> - begin match f with - | L n when n > 0 -> 9 + 2*n - | L n -> - 9 + 2*n - | N n when n > 0 -> 10 + 2*n - | N n -> - 10 + 2*n - | U n when n > 0 -> 2*n - | U n -> 2*n - | D n when n > 0 -> - 1 + 2*n - | D n -> 1 + 2*n - | DH -> 7 | DHq -> (-7) - | TopH -> 8 | TopHq -> (-8) - end - | G f -> - begin match f with - | Gl -> 21 - | Ga -> 22 | Z -> 23 - | Wp -> 24 | Wm -> (-24) - | Xp -> 34 | Xm -> (-34) | ZH -> 32 | X0 -> 33 | Y0 -> 38 - | Gl_aux -> 21 - end - | O f -> - begin match f with - | Phip | Phim -> 27 | Phi0 -> 26 - | H -> 25 | Eta -> 36 - end - - let mass_symbol f = - "mass(" ^ string_of_int (abs (pdg f)) ^ ")" - - let width_symbol f = - "width(" ^ string_of_int (abs (pdg f)) ^ ")" - - let constant_symbol = function - | Unit -> "unit" | Pi -> "PI" | VHeavy -> "vheavy" - | Alpha_QED -> "alpha" | E -> "e" | G_weak -> "g" | Vev -> "vev" - | Sin2thw -> "sin2thw" | Sinthw -> "sinthw" | Costhw -> "costhw" - | Sinpsi -> "sinpsi" | Cospsi -> "cospsi" - | Atpsi -> "atpsi" | Sccs -> "sccs" - | Supp -> "vF" | Supp2 -> "v2F2" - | Q_lepton -> "qlep" | Q_up -> "qup" | Q_down -> "qdwn" - | Q_Z_up -> "qzup" - | G_over4 -> "gov4" | G_over4_sup -> "gov4sup" | G_CC_sup -> "gccsup" - | G_zhthth -> "gzhthth" - | G_NC_lepton -> "gnclep" | G_NC_neutrino -> "gncneu" - | G_NC_up -> "gncup" | G_NC_down -> "gncdwn" - | G_CC -> "gcc" | G_CC_heavy -> "gcch" - | G_CC_supp1 -> "gsupp1" | G_CC_supp2 -> "gsupp2" - | G_NC_h_lepton -> "gnchlep" | G_NC_h_neutrino -> "gnchneu" - | G_NC_h_up -> "gnchup" | G_NC_h_down -> "gnchdwn" -(* | G_NC_heavy -> "gnch" *) - | I_Q_W -> "iqw" | I_G_ZWW -> "igzww" | I_G_WWW -> "igwww" - | I_Q_H -> "iqh" | I_Q_ZH -> "iqzh" - | I_G_Z1 -> "igz1" | I_G_Z2 -> "igz2" - | I_G_Z3 -> "igz3" | I_G_Z4 -> "igz4" - | G_WWWW -> "gw4" | G_ZZWW -> "gzzww" - | G_AZWW -> "gazww" | G_AAWW -> "gaaww" - | I_G1_AWW -> "ig1a" | I_G1_ZWW -> "ig1z" - | I_G1_plus_kappa_AWW -> "ig1pka" - | I_G1_plus_kappa_ZWW -> "ig1pkz" - | I_G1_minus_kappa_AWW -> "ig1mka" - | I_G1_minus_kappa_ZWW -> "ig1mkz" - | I_kappa_minus_G1_AWW -> "ikmg1a" - | I_kappa_minus_G1_ZWW -> "ikmg1z" - | I_lambda_AWW -> "ila" | I_lambda_ZWW -> "ilz" - | Alpha_WWWW0 -> "alww0" | Alpha_WWWW2 -> "alww2" - | Alpha_ZZWW0 -> "alzw0" | Alpha_ZZWW1 -> "alzw1" - | Alpha_ZZZZ -> "alzz" - | G_HWW -> "ghww" | G_HZZ -> "ghzz" - | G_heavy_HVV -> "ghyhvv" - | G_heavy_HWW -> "ghyhww" - | G_heavy_HZZ -> "ghyhzz" - | G_HHWW -> "ghhww" | G_HHZZ -> "ghhzz" - | G_heavy_HHVV -> "ghyhhvv" - | G_Htt -> "ghtt" | G_Hbb -> "ghbb" - | G_Htautau -> "ghtautau" | G_Hcc -> "ghcc" - | G_Hthth -> "ghthth" | G_Htht -> "ghtht" - | G_Ethth -> "gethth" | G_Etht -> "getht" - | G_Ett -> "gett" | G_Ebb -> "gebb" - | G_HGaGa -> "ghaa" | G_HGaZ -> "ghaz" - | G_EGaGa -> "geaa" | G_EGaZ -> "geaz" | G_EGlGl -> "gegg" - | G_ZEH -> "gzeh" | G_ZHEH -> "gzheh" | G_XEH -> "gxeh" - | G_H3 -> "gh3" | G_H4 -> "gh4" - | G_strong -> "gs" - | Mass f -> "mass" ^ flavor_symbol f - | Width f -> "width" ^ flavor_symbol f - | K_Matrix_Coeff i -> "kc" ^ string_of_int i - | K_Matrix_Pole i -> "kp" ^ string_of_int i - end - -module O = Omega.Make(Fusion.Mixed23)(Targets.Fortran) - (Zprime(SM_no_anomalous)) -let _ = O.main () - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/.depend_f95 =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/.depend_f95 (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/.depend_f95 (revision 8703) @@ -1,93 +0,0 @@ -omega_constants.o: kinds.o -omega_spinors.o: kinds.o -omega_spinors.o: omega_constants.o -omega_bispinors.o: kinds.o -omega_bispinors.o: omega_constants.o -omega_vectorspinors.o: kinds.o -omega_vectorspinors.o: omega_constants.o -omega_vectorspinors.o: omega_bispinors.o -omega_vectorspinors.o: omega_vectors.o -omega_vectors.o: kinds.o -omega_vectors.o: omega_constants.o -omega_couplings.o: kinds.o -omega_couplings.o: omega_constants.o -omega_couplings.o: omega_vectors.o -omega_couplings.o: omega_tensors.o -omega_polarizations.o: kinds.o -omega_polarizations.o: omega_constants.o -omega_polarizations.o: omega_vectors.o -omega_polarizations_madgraph.o: kinds.o -omega_polarizations_madgraph.o: omega_constants.o -omega_polarizations_madgraph.o: omega_vectors.o -omega_tensors.o: kinds.o -omega_tensors.o: omega_constants.o -omega_tensors.o: omega_vectors.o -omega_tensor_polarizations.o: kinds.o -omega_tensor_polarizations.o: omega_constants.o -omega_tensor_polarizations.o: omega_vectors.o -omega_tensor_polarizations.o: omega_tensors.o -omega_tensor_polarizations.o: omega_polarizations.o -omega_vspinor_polarizations.o: kinds.o -omega_vspinor_polarizations.o: omega_constants.o -omega_vspinor_polarizations.o: omega_vectors.o -omega_vspinor_polarizations.o: omega_bispinors.o -omega_vspinor_polarizations.o: omega_bispinor_couplings.o -omega_vspinor_polarizations.o: omega_vectorspinors.o -omega_spinor_couplings.o: kinds.o -omega_spinor_couplings.o: omega_constants.o -omega_spinor_couplings.o: omega_spinors.o -omega_spinor_couplings.o: omega_vectors.o -omega_spinor_couplings.o: omega_tensors.o -omega_spinor_couplings.o: omega_couplings.o -omega_bispinor_couplings.o: kinds.o -omega_bispinor_couplings.o: omega_constants.o -omega_bispinor_couplings.o: omega_bispinors.o -omega_bispinor_couplings.o: omega_vectorspinors.o -omega_bispinor_couplings.o: omega_vectors.o -omega_bispinor_couplings.o: omega_couplings.o -omega_utils.o: kinds.o -omega_utils.o: omega_vectors.o -omega_utils.o: omega_polarizations.o -omega_utils.o: kinds.o -omega_utils.o: kinds.o -omega_utils.o: kinds.o -omega_utils.o: kinds.o -omega_utils.o: kinds.o -omega_utils.o: kinds.o -omega_utils.o: kinds.o -omega_utils.o: kinds.o -omega_utils.o: kinds.o -omega_utils.o: kinds.o -omega_utils.o: kinds.o -omega_utils.o: kinds.o -omega_utils.o: kinds.o -omega95.o: omega_constants.o -omega95.o: omega_spinors.o -omega95.o: omega_vectors.o -omega95.o: omega_polarizations.o -omega95.o: omega_tensors.o -omega95.o: omega_tensor_polarizations.o -omega95.o: omega_couplings.o -omega95.o: omega_spinor_couplings.o -omega95.o: omega_utils.o -omega95_bispinors.o: omega_constants.o -omega95_bispinors.o: omega_bispinors.o -omega95_bispinors.o: omega_vectors.o -omega95_bispinors.o: omega_vectorspinors.o -omega95_bispinors.o: omega_polarizations.o -omega95_bispinors.o: omega_vspinor_polarizations.o -omega95_bispinors.o: omega_couplings.o -omega95_bispinors.o: omega_bispinor_couplings.o -omega95_bispinors.o: omega_utils.o -omega_parameters.o: kinds.o -omega_parameters.o: omega_constants.o -omega_parameters_madgraph.o: kinds.o -omega_parameters_madgraph.o: omega_parameters.o -test_omega95.o: kinds.o -test_omega95.o: omega95.o -test_omega95.o: omega_testtools.o -test_omega95_bispinors.o: kinds.o -test_omega95_bispinors.o: omega95_bispinors.o -test_omega95_bispinors.o: omega_vspinor_polarizations.o -test_omega95_bispinors.o: omega_testtools.o -omega_testtools.o: kinds.o Index: branches/ohl/omega-development/completed/whizard2/src/omegalib.nw =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/omegalib.nw (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/omegalib.nw (revision 8703) @@ -1,10319 +0,0 @@ -% $Id$ -% -% Copyright (C) 1999-2009 by -% Wolfgang Kilian -% Thorsten Ohl -% Juergen Reuter -% -% WHIZARD is free software; you can redistribute it and/or modify it -% under the terms of the GNU General Public License as published by -% the Free Software Foundation; either version 2, or (at your option) -% any later version. -% -% WHIZARD is distributed in the hope that it will be useful, but -% WITHOUT ANY WARRANTY; without even the implied warranty of -% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -% GNU General Public License for more details. -% -% You should have received a copy of the GNU General Public License -% along with this program; if not, write to the Free Software -% Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -@ -\section{Trivia} -<<[[kinds.f95]]>>= -<> -module kinds - implicit none - private - -! Three types of precision. double is the default, usually. - public :: single, double, quadruple - public :: default, quad_or_single - - integer, parameter :: single = & - & selected_real_kind (precision(1.), range(1.)) - integer, parameter :: double = & - & selected_real_kind (precision(1._single) + 1, range(1._single) + 1) - integer, parameter :: quadruple = & - & selected_real_kind (precision (1._double) + 1, range (1._double)) - - integer, parameter :: default = double - integer, parameter :: quad_or_single = single - -! Integer kinds: 8 bit, 16 bit, 32 bit, and 64 bit -! These should all be available - public :: i8, i16, i32, i64 - - integer, parameter :: i8 = selected_int_kind (2) - integer, parameter :: i16 = selected_int_kind (4) - integer, parameter :: i32 = selected_int_kind (9) - integer, parameter :: i64 = selected_int_kind (18) - -! This is the integer size for binary codes: 32 bit (default) -! corresponds to a 2 -> 30 process, more than sufficient. - public :: TC - - integer, parameter :: TC = i32 - -end module kinds -@ -<<[[omega_constants.f95]]>>= -<> -module omega_constants - use kinds - implicit none - private - real(kind=default), parameter, public :: & - PI = 3.1415926535897932384626433832795028841972_default -end module omega_constants -@ -<>= - double precision PI - parameter (PI = 3.1415926535897932384626433832795028841972D0) -@ -\section{Spinors} -<>= - subroutine o7zs (psi) - implicit none - double complex psi(4) - psi(1) = 0 - psi(2) = 0 - psi(3) = 0 - psi(4) = 0 - end -@ -<>= - subroutine o7zcs (psibar) - implicit none - double complex psibar(4) - psibar(1) = 0 - psibar(2) = 0 - psibar(3) = 0 - psibar(4) = 0 - end -@ -<<[[omega_spinors.f95]]>>= -<> -module omega_spinors - use kinds - use omega_constants - implicit none - private - public :: operator (*), operator (+), operator (-) - public :: abs - <<[[intrinsic :: abs]]>> - type, public :: conjspinor - ! private (omegalib needs access, but DON'T TOUCH IT!) - complex(kind=default), dimension(4) :: a - end type conjspinor - type, public :: spinor - ! private (omegalib needs access, but DON'T TOUCH IT!) - complex(kind=default), dimension(4) :: a - end type spinor - <> - integer, parameter, public :: omega_spinors_2003_03_A = 0 -contains - <> -end module omega_spinors -@ -<<[[intrinsic :: abs]] (if working)>>= -intrinsic :: abs -@ -<<[[intrinsic :: conjg]] (if working)>>= -intrinsic :: conjg -@ well, the Intel Fortran Compiler chokes on these with an internal error: -<<[[intrinsic :: abs]]>>= -@ -<<[[intrinsic :: conjg]]>>= -@ -\subsection{Inner Product} -<>= -interface operator (*) - module procedure conjspinor_spinor -end interface -private :: conjspinor_spinor -@ -\begin{equation} - \bar\psi\psi' -\end{equation} -NB: [[dot_product]] conjugates its first argument, we can either -cancel this or inline [[dot_product]]: -<>= -pure function conjspinor_spinor (psibar, psi) result (psibarpsi) - complex(kind=default) :: psibarpsi - type(conjspinor), intent(in) :: psibar - type(spinor), intent(in) :: psi - psibarpsi = psibar%a(1)*psi%a(1) + psibar%a(2)*psi%a(2) & - + psibar%a(3)*psi%a(3) + psibar%a(4)*psi%a(4) -end function conjspinor_spinor -@ -<>= - subroutine o7css (acc, pb, p) - implicit none - double complex acc, pb(4), p(4) - acc = acc + pb(1)*p(1) + pb(2)*p(2) + pb(3)*p(3) + pb(4)*p(4) - end -@ -\subsection{Spinor Vector Space} -\subsubsection{Scalar Multiplication} -<>= -interface operator (*) - module procedure integer_spinor, spinor_integer, & - real_spinor, double_spinor, & - complex_spinor, dcomplex_spinor, & - spinor_real, spinor_double, & - spinor_complex, spinor_dcomplex -end interface -private :: integer_spinor, spinor_integer, real_spinor, & - double_spinor, complex_spinor, dcomplex_spinor, & - spinor_real, spinor_double, spinor_complex, spinor_dcomplex -@ -<>= -pure function integer_spinor (x, y) result (xy) - integer, intent(in) :: x - type(spinor), intent(in) :: y - type(spinor) :: xy - xy%a = x * y%a -end function integer_spinor -@ -<>= -pure function real_spinor (x, y) result (xy) - real(kind=single), intent(in) :: x - type(spinor), intent(in) :: y - type(spinor) :: xy - xy%a = x * y%a -end function real_spinor -pure function double_spinor (x, y) result (xy) - real(kind=default), intent(in) :: x - type(spinor), intent(in) :: y - type(spinor) :: xy - xy%a = x * y%a -end function double_spinor -pure function complex_spinor (x, y) result (xy) - complex(kind=single), intent(in) :: x - type(spinor), intent(in) :: y - type(spinor) :: xy - xy%a = x * y%a -end function complex_spinor -pure function dcomplex_spinor (x, y) result (xy) - complex(kind=default), intent(in) :: x - type(spinor), intent(in) :: y - type(spinor) :: xy - xy%a = x * y%a -end function dcomplex_spinor -pure function spinor_integer (y, x) result (xy) - integer, intent(in) :: x - type(spinor), intent(in) :: y - type(spinor) :: xy - xy%a = x * y%a -end function spinor_integer -pure function spinor_real (y, x) result (xy) - real(kind=single), intent(in) :: x - type(spinor), intent(in) :: y - type(spinor) :: xy - xy%a = x * y%a -end function spinor_real -pure function spinor_double (y, x) result (xy) - real(kind=default), intent(in) :: x - type(spinor), intent(in) :: y - type(spinor) :: xy - xy%a = x * y%a -end function spinor_double -pure function spinor_complex (y, x) result (xy) - complex(kind=single), intent(in) :: x - type(spinor), intent(in) :: y - type(spinor) :: xy - xy%a = x * y%a -end function spinor_complex -pure function spinor_dcomplex (y, x) result (xy) - complex(kind=default), intent(in) :: x - type(spinor), intent(in) :: y - type(spinor) :: xy - xy%a = x * y%a -end function spinor_dcomplex -@ -<>= -interface operator (*) - module procedure integer_conjspinor, conjspinor_integer, & - real_conjspinor, double_conjspinor, & - complex_conjspinor, dcomplex_conjspinor, & - conjspinor_real, conjspinor_double, & - conjspinor_complex, conjspinor_dcomplex -end interface -private :: integer_conjspinor, conjspinor_integer, real_conjspinor, & - double_conjspinor, complex_conjspinor, dcomplex_conjspinor, & - conjspinor_real, conjspinor_double, conjspinor_complex, & - conjspinor_dcomplex -@ -<>= -pure function integer_conjspinor (x, y) result (xy) - integer, intent(in) :: x - type(conjspinor), intent(in) :: y - type(conjspinor) :: xy - xy%a = x * y%a -end function integer_conjspinor -pure function real_conjspinor (x, y) result (xy) - real(kind=single), intent(in) :: x - type(conjspinor), intent(in) :: y - type(conjspinor) :: xy - xy%a = x * y%a -end function real_conjspinor -pure function double_conjspinor (x, y) result (xy) - real(kind=default), intent(in) :: x - type(conjspinor), intent(in) :: y - type(conjspinor) :: xy - xy%a = x * y%a -end function double_conjspinor -pure function complex_conjspinor (x, y) result (xy) - complex(kind=single), intent(in) :: x - type(conjspinor), intent(in) :: y - type(conjspinor) :: xy - xy%a = x * y%a -end function complex_conjspinor -pure function dcomplex_conjspinor (x, y) result (xy) - complex(kind=default), intent(in) :: x - type(conjspinor), intent(in) :: y - type(conjspinor) :: xy - xy%a = x * y%a -end function dcomplex_conjspinor -pure function conjspinor_integer (y, x) result (xy) - integer, intent(in) :: x - type(conjspinor), intent(in) :: y - type(conjspinor) :: xy - xy%a = x * y%a -end function conjspinor_integer -pure function conjspinor_real (y, x) result (xy) - real(kind=single), intent(in) :: x - type(conjspinor), intent(in) :: y - type(conjspinor) :: xy - xy%a = x * y%a -end function conjspinor_real -pure function conjspinor_double (y, x) result (xy) - real(kind=default), intent(in) :: x - type(conjspinor), intent(in) :: y - type(conjspinor) :: xy - xy%a = x * y%a -end function conjspinor_double -pure function conjspinor_complex (y, x) result (xy) - complex(kind=single), intent(in) :: x - type(conjspinor), intent(in) :: y - type(conjspinor) :: xy - xy%a = x * y%a -end function conjspinor_complex -pure function conjspinor_dcomplex (y, x) result (xy) - complex(kind=default), intent(in) :: x - type(conjspinor), intent(in) :: y - type(conjspinor) :: xy - xy%a = x * y%a -end function conjspinor_dcomplex -@ -\subsubsection{Unary Plus and Minus} -<>= -interface operator (+) - module procedure plus_spinor, plus_conjspinor -end interface -private :: plus_spinor, plus_conjspinor -interface operator (-) - module procedure neg_spinor, neg_conjspinor -end interface -private :: neg_spinor, neg_conjspinor -@ -<>= -pure function plus_spinor (x) result (plus_x) - type(spinor), intent(in) :: x - type(spinor) :: plus_x - plus_x%a = x%a -end function plus_spinor -pure function neg_spinor (x) result (neg_x) - type(spinor), intent(in) :: x - type(spinor) :: neg_x - neg_x%a = - x%a -end function neg_spinor -@ -<>= -pure function plus_conjspinor (x) result (plus_x) - type(conjspinor), intent(in) :: x - type(conjspinor) :: plus_x - plus_x%a = x%a -end function plus_conjspinor -pure function neg_conjspinor (x) result (neg_x) - type(conjspinor), intent(in) :: x - type(conjspinor) :: neg_x - neg_x%a = - x%a -end function neg_conjspinor -@ -\subsubsection{Addition and Subtraction} -<>= -interface operator (+) - module procedure add_spinor, add_conjspinor -end interface -private :: add_spinor, add_conjspinor -interface operator (-) - module procedure sub_spinor, sub_conjspinor -end interface -private :: sub_spinor, sub_conjspinor -@ -<>= -pure function add_spinor (x, y) result (xy) - type(spinor), intent(in) :: x, y - type(spinor) :: xy - xy%a = x%a + y%a -end function add_spinor -pure function sub_spinor (x, y) result (xy) - type(spinor), intent(in) :: x, y - type(spinor) :: xy - xy%a = x%a - y%a -end function sub_spinor -@ -<>= -pure function add_conjspinor (x, y) result (xy) - type(conjspinor), intent(in) :: x, y - type(conjspinor) :: xy - xy%a = x%a + y%a -end function add_conjspinor -pure function sub_conjspinor (x, y) result (xy) - type(conjspinor), intent(in) :: x, y - type(conjspinor) :: xy - xy%a = x%a - y%a -end function sub_conjspinor -@ -\subsection{Norm} -<>= -interface abs - module procedure abs_spinor, abs_conjspinor -end interface -private :: abs_spinor, abs_conjspinor -@ -<>= -pure function abs_spinor (psi) result (x) - type(spinor), intent(in) :: psi - real(kind=default) :: x - x = sqrt (dot_product (psi%a, psi%a)) -end function abs_spinor -@ -<>= -pure function abs_conjspinor (psibar) result (x) - real(kind=default) :: x - type(conjspinor), intent(in) :: psibar - x = sqrt (dot_product (psibar%a, psibar%a)) -end function abs_conjspinor -@ -\section{Spinors Revisited} -<<[[omega_bispinors.f95]]>>= -<> -module omega_bispinors - use kinds - use omega_constants - implicit none - private - public :: operator (*), operator (+), operator (-) - public :: abs - type, public :: bispinor - ! private (omegalib needs access, but DON'T TOUCH IT!) - complex(kind=default), dimension(4) :: a - end type bispinor - <> - integer, parameter, public :: omega_bispinors_2003_03_A = 0 -contains - <> -end module omega_bispinors -@ -<>= -interface operator (*) - module procedure spinor_product -end interface -private :: spinor_product -@ -\begin{equation} - \bar\psi\psi' -\end{equation} -NB: [[dot_product]] conjugates its first argument, we have to cancel this. -<>= -pure function spinor_product (psil, psir) result (psilpsir) - complex(kind=default) :: psilpsir - type(bispinor), intent(in) :: psil, psir - type(bispinor) :: psidum - psidum%a(1) = psir%a(2) - psidum%a(2) = - psir%a(1) - psidum%a(3) = - psir%a(4) - psidum%a(4) = psir%a(3) - psilpsir = dot_product (conjg (psil%a), psidum%a) -end function spinor_product -@ -\subsection{Spinor Vector Space} -\subsubsection{Scalar Multiplication} -<>= -interface operator (*) - module procedure integer_bispinor, bispinor_integer, & - real_bispinor, double_bispinor, & - complex_bispinor, dcomplex_bispinor, & - bispinor_real, bispinor_double, & - bispinor_complex, bispinor_dcomplex -end interface -private :: integer_bispinor, bispinor_integer, real_bispinor, & - double_bispinor, complex_bispinor, dcomplex_bispinor, & - bispinor_real, bispinor_double, bispinor_complex, bispinor_dcomplex -@ -<>= -pure function integer_bispinor (x, y) result (xy) - type(bispinor) :: xy - integer, intent(in) :: x - type(bispinor), intent(in) :: y - xy%a = x * y%a -end function integer_bispinor -@ -<>= -pure function real_bispinor (x, y) result (xy) - type(bispinor) :: xy - real(kind=single), intent(in) :: x - type(bispinor), intent(in) :: y - xy%a = x * y%a -end function real_bispinor -@ -<>= -pure function double_bispinor (x, y) result (xy) - type(bispinor) :: xy - real(kind=default), intent(in) :: x - type(bispinor), intent(in) :: y - xy%a = x * y%a -end function double_bispinor -@ -<>= -pure function complex_bispinor (x, y) result (xy) - type(bispinor) :: xy - complex(kind=single), intent(in) :: x - type(bispinor), intent(in) :: y - xy%a = x * y%a -end function complex_bispinor -@ -<>= -pure function dcomplex_bispinor (x, y) result (xy) - type(bispinor) :: xy - complex(kind=default), intent(in) :: x - type(bispinor), intent(in) :: y - xy%a = x * y%a -end function dcomplex_bispinor -@ -<>= -pure function bispinor_integer (y, x) result (xy) - type(bispinor) :: xy - integer, intent(in) :: x - type(bispinor), intent(in) :: y - xy%a = x * y%a -end function bispinor_integer -@ -<>= -pure function bispinor_real (y, x) result (xy) - type(bispinor) :: xy - real(kind=single), intent(in) :: x - type(bispinor), intent(in) :: y - xy%a = x * y%a -end function bispinor_real -@ -<>= -pure function bispinor_double (y, x) result (xy) - type(bispinor) :: xy - real(kind=default), intent(in) :: x - type(bispinor), intent(in) :: y - xy%a = x * y%a -end function bispinor_double -@ -<>= -pure function bispinor_complex (y, x) result (xy) - type(bispinor) :: xy - complex(kind=single), intent(in) :: x - type(bispinor), intent(in) :: y - xy%a = x * y%a -end function bispinor_complex -@ -<>= -pure function bispinor_dcomplex (y, x) result (xy) - type(bispinor) :: xy - complex(kind=default), intent(in) :: x - type(bispinor), intent(in) :: y - xy%a = x * y%a -end function bispinor_dcomplex -@ -\subsubsection{Unary Plus and Minus} -<>= -interface operator (+) - module procedure plus_bispinor -end interface -private :: plus_bispinor -interface operator (-) - module procedure neg_bispinor -end interface -private :: neg_bispinor -@ -<>= -pure function plus_bispinor (x) result (plus_x) - type(bispinor) :: plus_x - type(bispinor), intent(in) :: x - plus_x%a = x%a -end function plus_bispinor -@ -<>= -pure function neg_bispinor (x) result (neg_x) - type(bispinor) :: neg_x - type(bispinor), intent(in) :: x - neg_x%a = - x%a -end function neg_bispinor -@ -\subsubsection{Addition and Subtraction} -<>= -interface operator (+) - module procedure add_bispinor -end interface -private :: add_bispinor -interface operator (-) - module procedure sub_bispinor -end interface -private :: sub_bispinor -@ -<>= -pure function add_bispinor (x, y) result (xy) - type(bispinor) :: xy - type(bispinor), intent(in) :: x, y - xy%a = x%a + y%a -end function add_bispinor -@ -<>= -pure function sub_bispinor (x, y) result (xy) - type(bispinor) :: xy - type(bispinor), intent(in) :: x, y - xy%a = x%a - y%a -end function sub_bispinor -@ -\subsection{Norm} -<>= -interface abs - module procedure abs_bispinor -end interface -private :: abs_bispinor -@ -<>= -pure function abs_bispinor (psi) result (x) - real(kind=default) :: x - type(bispinor), intent(in) :: psi - x = sqrt (dot_product (psi%a, psi%a)) -end function abs_bispinor -@ -\section{Vectorspinors} -<<[[omega_vectorspinors.f95]]>>= -<> -module omega_vectorspinors - use kinds - use omega_constants - use omega_bispinors - use omega_vectors - implicit none - private - public :: operator (*), operator (+), operator (-) - public :: abs - type, public :: vectorspinor - ! private (omegalib needs access, but DON'T TOUCH IT!) - type(bispinor), dimension(4) :: psi - end type vectorspinor - <> - integer, parameter, public :: omega_vectorspinors_2003_03_A = 0 -contains - <> -end module omega_vectorspinors -@ -<>= -interface operator (*) - module procedure vspinor_product -end interface -private :: vspinor_product -@ -\begin{equation} - \bar\psi^\mu\psi'_\mu -\end{equation} -<>= -pure function vspinor_product (psil, psir) result (psilpsir) - complex(kind=default) :: psilpsir - type(vectorspinor), intent(in) :: psil, psir - psilpsir = psil%psi(1) * psir%psi(1) & - - psil%psi(2) * psir%psi(2) & - - psil%psi(3) * psir%psi(3) & - - psil%psi(4) * psir%psi(4) -end function vspinor_product -@ -\subsection{Vectorspinor Vector Space} -\subsubsection{Scalar Multiplication} -<>= -interface operator (*) - module procedure integer_vectorspinor, vectorspinor_integer, & - real_vectorspinor, double_vectorspinor, & - complex_vectorspinor, dcomplex_vectorspinor, & - vectorspinor_real, vectorspinor_double, & - vectorspinor_complex, vectorspinor_dcomplex, & - momentum_vectorspinor, vectorspinor_momentum -end interface -private :: integer_vectorspinor, vectorspinor_integer, real_vectorspinor, & - double_vectorspinor, complex_vectorspinor, dcomplex_vectorspinor, & - vectorspinor_real, vectorspinor_double, vectorspinor_complex, & - vectorspinor_dcomplex -@ -<>= -pure function integer_vectorspinor (x, y) result (xy) - type(vectorspinor) :: xy - integer, intent(in) :: x - type(vectorspinor), intent(in) :: y - integer :: k - do k = 1,4 - xy%psi(k) = x * y%psi(k) - end do -end function integer_vectorspinor -@ -<>= -pure function real_vectorspinor (x, y) result (xy) - type(vectorspinor) :: xy - real(kind=single), intent(in) :: x - type(vectorspinor), intent(in) :: y - integer :: k - do k = 1,4 - xy%psi(k) = x * y%psi(k) - end do -end function real_vectorspinor -@ -<>= -pure function double_vectorspinor (x, y) result (xy) - type(vectorspinor) :: xy - real(kind=default), intent(in) :: x - type(vectorspinor), intent(in) :: y - integer :: k - do k = 1,4 - xy%psi(k) = x * y%psi(k) - end do -end function double_vectorspinor -@ -<>= -pure function complex_vectorspinor (x, y) result (xy) - type(vectorspinor) :: xy - complex(kind=single), intent(in) :: x - type(vectorspinor), intent(in) :: y - integer :: k - do k = 1,4 - xy%psi(k) = x * y%psi(k) - end do -end function complex_vectorspinor -@ -<>= -pure function dcomplex_vectorspinor (x, y) result (xy) - type(vectorspinor) :: xy - complex(kind=default), intent(in) :: x - type(vectorspinor), intent(in) :: y - integer :: k - do k = 1,4 - xy%psi(k) = x * y%psi(k) - end do -end function dcomplex_vectorspinor -@ -<>= -pure function vectorspinor_integer (y, x) result (xy) - type(vectorspinor) :: xy - integer, intent(in) :: x - type(vectorspinor), intent(in) :: y - integer :: k - do k = 1,4 - xy%psi(k) = y%psi(k) * x - end do -end function vectorspinor_integer -@ -<>= -pure function vectorspinor_real (y, x) result (xy) - type(vectorspinor) :: xy - real(kind=single), intent(in) :: x - type(vectorspinor), intent(in) :: y - integer :: k - do k = 1,4 - xy%psi(k) = y%psi(k) * x - end do -end function vectorspinor_real -@ -<>= -pure function vectorspinor_double (y, x) result (xy) - type(vectorspinor) :: xy - real(kind=default), intent(in) :: x - type(vectorspinor), intent(in) :: y - integer :: k - do k = 1,4 - xy%psi(k) = y%psi(k) * x - end do -end function vectorspinor_double -@ -<>= -pure function vectorspinor_complex (y, x) result (xy) - type(vectorspinor) :: xy - complex(kind=single), intent(in) :: x - type(vectorspinor), intent(in) :: y - integer :: k - do k = 1,4 - xy%psi(k) = y%psi(k) * x - end do -end function vectorspinor_complex -@ -<>= -pure function vectorspinor_dcomplex (y, x) result (xy) - type(vectorspinor) :: xy - complex(kind=default), intent(in) :: x - type(vectorspinor), intent(in) :: y - integer :: k - do k = 1,4 - xy%psi(k) = y%psi(k) * x - end do -end function vectorspinor_dcomplex -@ -<>= -pure function momentum_vectorspinor (y, x) result (xy) - type(bispinor) :: xy - type(momentum), intent(in) :: y - type(vectorspinor), intent(in) :: x - integer :: k - do k = 1,4 - xy%a(k) = y%t * x%psi(1)%a(k) - y%x(1) * x%psi(2)%a(k) - & - y%x(2) * x%psi(3)%a(k) - y%x(3) * x%psi(4)%a(k) - end do -end function momentum_vectorspinor -@ -<>= -pure function vectorspinor_momentum (y, x) result (xy) - type(bispinor) :: xy - type(momentum), intent(in) :: x - type(vectorspinor), intent(in) :: y - integer :: k - do k = 1,4 - xy%a(k) = x%t * y%psi(1)%a(k) - x%x(1) * y%psi(2)%a(k) - & - x%x(2) * y%psi(3)%a(k) - x%x(3) * y%psi(4)%a(k) - end do -end function vectorspinor_momentum -@ -\subsubsection{Unary Plus and Minus} -<>= -interface operator (+) - module procedure plus_vectorspinor -end interface -private :: plus_vectorspinor -interface operator (-) - module procedure neg_vectorspinor -end interface -private :: neg_vectorspinor -@ -<>= -pure function plus_vectorspinor (x) result (plus_x) - type(vectorspinor) :: plus_x - type(vectorspinor), intent(in) :: x - integer :: k - do k = 1,4 - plus_x%psi(k) = + x%psi(k) - end do -end function plus_vectorspinor -@ -<>= -pure function neg_vectorspinor (x) result (neg_x) - type(vectorspinor) :: neg_x - type(vectorspinor), intent(in) :: x - integer :: k - do k = 1,4 - neg_x%psi(k) = - x%psi(k) - end do -end function neg_vectorspinor -@ -\subsubsection{Addition and Subtraction} -<>= -interface operator (+) - module procedure add_vectorspinor -end interface -private :: add_vectorspinor -interface operator (-) - module procedure sub_vectorspinor -end interface -private :: sub_vectorspinor -@ -<>= -pure function add_vectorspinor (x, y) result (xy) - type(vectorspinor) :: xy - type(vectorspinor), intent(in) :: x, y - integer :: k - do k = 1,4 - xy%psi(k) = x%psi(k) + y%psi(k) - end do -end function add_vectorspinor -@ -<>= -pure function sub_vectorspinor (x, y) result (xy) - type(vectorspinor) :: xy - type(vectorspinor), intent(in) :: x, y - integer :: k - do k = 1,4 - xy%psi(k) = x%psi(k) - y%psi(k) - end do -end function sub_vectorspinor -@ -\subsection{Norm} -<>= -interface abs - module procedure abs_vectorspinor -end interface -private :: abs_vectorspinor -@ -<>= -pure function abs_vectorspinor (psi) result (x) - real(kind=default) :: x - type(vectorspinor), intent(in) :: psi - x = sqrt (dot_product (psi%psi(1)%a, psi%psi(1)%a) & - - dot_product (psi%psi(2)%a, psi%psi(2)%a) & - - dot_product (psi%psi(3)%a, psi%psi(3)%a) & - - dot_product (psi%psi(4)%a, psi%psi(4)%a)) -end function abs_vectorspinor -@ -\section{Vectors and Tensors} -Condensed representation of antisymmetric rank-2 tensors: -\begin{equation} - \begin{pmatrix} - T^{00} & T^{01} & T^{02} & T^{03} \\ - T^{10} & T^{11} & T^{12} & T^{13} \\ - T^{20} & T^{21} & T^{22} & T^{23} \\ - T^{30} & T^{31} & T^{32} & T^{33} - \end{pmatrix} - = - \begin{pmatrix} - 0 & T_e^1 & T_e^2 & T_e^3 \\ - -T_e^1 & 0 & T_b^3 & -T_b^2 \\ - -T_e^2 & -T_b^3 & 0 & T_b^1 \\ - -T_e^3 & T_b^2 & -T_b^1 & 0 - \end{pmatrix} -\end{equation} -<<[[omega_vectors.f95]]>>= -<> -module omega_vectors - use kinds - use omega_constants - implicit none - private - public :: assignment (=) - public :: operator (*), operator (+), operator (-), operator (.wedge.) - public :: abs, conjg - public :: random_momentum - <<[[intrinsic :: abs]]>> - <<[[intrinsic :: conjg]]>> - type, public :: momentum - ! private (omegalib needs access, but DON'T TOUCH IT!) - real(kind=default) :: t - real(kind=default), dimension(3) :: x - end type momentum - type, public :: vector - ! private (omegalib needs access, but DON'T TOUCH IT!) - complex(kind=default) :: t - complex(kind=default), dimension(3) :: x - end type vector - type, public :: tensor2odd - ! private (omegalib needs access, but DON'T TOUCH IT!) - complex(kind=default), dimension(3) :: e - complex(kind=default), dimension(3) :: b - end type tensor2odd - <> - integer, parameter, public :: omega_vectors_2003_03_A = 0 -contains - <> -end module omega_vectors -@ -\subsection{Constructors} -<>= -interface assignment (=) - module procedure momentum_of_array, vector_of_momentum, & - vector_of_array, vector_of_double_array, & - array_of_momentum, array_of_vector -end interface -private :: momentum_of_array, vector_of_momentum, vector_of_array, & - vector_of_double_array, array_of_momentum, array_of_vector -@ -<>= -pure subroutine momentum_of_array (m, p) - type(momentum), intent(out) :: m - real(kind=default), dimension(0:), intent(in) :: p - m%t = p(0) - m%x = p(1:3) -end subroutine momentum_of_array -pure subroutine array_of_momentum (p, v) - real(kind=default), dimension(0:), intent(out) :: p - type(momentum), intent(in) :: v - p(0) = v%t - p(1:3) = v%x -end subroutine array_of_momentum -@ -<>= -pure subroutine vector_of_array (v, p) - type(vector), intent(out) :: v - complex(kind=default), dimension(0:), intent(in) :: p - v%t = p(0) - v%x = p(1:3) -end subroutine vector_of_array -pure subroutine vector_of_double_array (v, p) - type(vector), intent(out) :: v - real(kind=default), dimension(0:), intent(in) :: p - v%t = p(0) - v%x = p(1:3) -end subroutine vector_of_double_array -pure subroutine array_of_vector (p, v) - complex(kind=default), dimension(0:), intent(out) :: p - type(vector), intent(in) :: v - p(0) = v%t - p(1:3) = v%x -end subroutine array_of_vector -@ -<>= -pure subroutine vector_of_momentum (v, p) - type(vector), intent(out) :: v - type(momentum), intent(in) :: p - v%t = p%t - v%x = p%x -end subroutine vector_of_momentum -@ -<>= - subroutine o7zv (v) - implicit none - double complex v(0:3) - v(0) = 0 - v(1) = 0 - v(2) = 0 - v(3) = 0 - end -@ -<>= - subroutine o7zt (t) - implicit none - double complex t(6) - integer i - do 10 i = 1, 6 - t(i) = 0 - 10 continue - end -@ -\subsection{Inner Products} -<>= -interface operator (*) - module procedure momentum_momentum, vector_vector, & - vector_momentum, momentum_vector, tensor2odd_tensor2odd -end interface -private :: momentum_momentum, vector_vector, vector_momentum, & - momentum_vector, tensor2odd_tensor2odd -@ -<>= -pure function momentum_momentum (x, y) result (xy) - type(momentum), intent(in) :: x - type(momentum), intent(in) :: y - real(kind=default) :: xy - xy = x%t*y%t - x%x(1)*y%x(1) - x%x(2)*y%x(2) - x%x(3)*y%x(3) -end function momentum_momentum -pure function momentum_vector (x, y) result (xy) - type(momentum), intent(in) :: x - type(vector), intent(in) :: y - complex(kind=default) :: xy - xy = x%t*y%t - x%x(1)*y%x(1) - x%x(2)*y%x(2) - x%x(3)*y%x(3) -end function momentum_vector -pure function vector_momentum (x, y) result (xy) - type(vector), intent(in) :: x - type(momentum), intent(in) :: y - complex(kind=default) :: xy - xy = x%t*y%t - x%x(1)*y%x(1) - x%x(2)*y%x(2) - x%x(3)*y%x(3) -end function vector_momentum -pure function vector_vector (x, y) result (xy) - type(vector), intent(in) :: x - type(vector), intent(in) :: y - complex(kind=default) :: xy - xy = x%t*y%t - x%x(1)*y%x(1) - x%x(2)*y%x(2) - x%x(3)*y%x(3) -end function vector_vector -@ -<>= - subroutine o7vv (acc, x, y) - implicit none - double complex acc, x(0:3), y(0:3) - acc = acc + x(0)*y(0) - x(1)*y(1) - x(2)*y(2) - x(3)*y(3) - end -@ -Just like classical electrodynamics: -\begin{equation} - \frac{1}{2} T_{\mu\nu} U^{\mu\nu} - = \frac{1}{2} \left( - T^{0i} U^{0i} - T^{i0} U^{i0} + T^{ij} U^{ij} \right) - = T_b^k U_b^k - T_e^k U_e^k -\end{equation} -<>= -pure function tensor2odd_tensor2odd (x, y) result (xy) - type(tensor2odd), intent(in) :: x - type(tensor2odd), intent(in) :: y - complex(kind=default) :: xy - xy = x%b(1)*y%b(1) + x%b(2)*y%b(2) + x%b(3)*y%b(3) & - - x%e(1)*y%e(1) - x%e(2)*y%e(2) - x%e(3)*y%e(3) -end function tensor2odd_tensor2odd -@ -<>= - subroutine o7tt (acc, x, y) - implicit none - double complex acc, x(6), y(6) - acc = acc + x(4)*y(4) + x(5)*y(5) + x(6)*y(6) - $ - x(1)*y(1) - x(2)*y(2) - x(3)*y(3) - end -@ -\subsection{Not Entirely Inner Products} -<>= -interface operator (*) - module procedure momentum_tensor2odd, tensor2odd_momentum, & - vector_tensor2odd, tensor2odd_vector -end interface -private :: momentum_tensor2odd, tensor2odd_momentum, vector_tensor2odd, & - tensor2odd_vector -@ -\begin{subequations} -\begin{align} - y^\nu = x_\mu T^{\mu\nu}: - & y^0 = - x^i T^{i0} = x^i T^{0i} \\ - & y^1 = x^0 T^{01} - x^2 T^{21} - x^3 T^{31} \\ - & y^2 = x^0 T^{02} - x^1 T^{12} - x^3 T^{32} \\ - & y^3 = x^0 T^{03} - x^1 T^{13} - x^2 T^{23} -\end{align} -\end{subequations} -<>= -pure function vector_tensor2odd (x, t2) result (xt2) - type(vector), intent(in) :: x - type(tensor2odd), intent(in) :: t2 - type(vector) :: xt2 - xt2%t = x%x(1)*t2%e(1) + x%x(2)*t2%e(2) + x%x(3)*t2%e(3) - xt2%x(1) = x%t*t2%e(1) + x%x(2)*t2%b(3) - x%x(3)*t2%b(2) - xt2%x(2) = x%t*t2%e(2) + x%x(3)*t2%b(1) - x%x(1)*t2%b(3) - xt2%x(3) = x%t*t2%e(3) + x%x(1)*t2%b(2) - x%x(2)*t2%b(1) -end function vector_tensor2odd -pure function momentum_tensor2odd (x, t2) result (xt2) - type(momentum), intent(in) :: x - type(tensor2odd), intent(in) :: t2 - type(vector) :: xt2 - xt2%t = x%x(1)*t2%e(1) + x%x(2)*t2%e(2) + x%x(3)*t2%e(3) - xt2%x(1) = x%t*t2%e(1) + x%x(2)*t2%b(3) - x%x(3)*t2%b(2) - xt2%x(2) = x%t*t2%e(2) + x%x(3)*t2%b(1) - x%x(1)*t2%b(3) - xt2%x(3) = x%t*t2%e(3) + x%x(1)*t2%b(2) - x%x(2)*t2%b(1) -end function momentum_tensor2odd -@ -\begin{subequations} -\begin{align} - y^\mu = T^{\mu\nu} x_\nu : - & y^0 = - T^{0i} x^i \\ - & y^1 = T^{10} x^0 - T^{12} x^2 - T^{13} x^3 \\ - & y^2 = T^{20} x^0 - T^{21} x^1 - T^{23} x^3 \\ - & y^3 = T^{30} x^0 - T^{31} x^1 - T^{32} x^2 -\end{align} -\end{subequations} -<>= -pure function tensor2odd_vector (t2, x) result (t2x) - type(tensor2odd), intent(in) :: t2 - type(vector), intent(in) :: x - type(vector) :: t2x - t2x%t = - t2%e(1)*x%x(1) - t2%e(2)*x%x(2) - t2%e(3)*x%x(3) - t2x%x(1) = - t2%e(1)*x%t + t2%b(2)*x%x(3) - t2%b(3)*x%x(2) - t2x%x(2) = - t2%e(2)*x%t + t2%b(3)*x%x(1) - t2%b(1)*x%x(3) - t2x%x(3) = - t2%e(3)*x%t + t2%b(1)*x%x(2) - t2%b(2)*x%x(1) -end function tensor2odd_vector -pure function tensor2odd_momentum (t2, x) result (t2x) - type(tensor2odd), intent(in) :: t2 - type(momentum), intent(in) :: x - type(vector) :: t2x - t2x%t = - t2%e(1)*x%x(1) - t2%e(2)*x%x(2) - t2%e(3)*x%x(3) - t2x%x(1) = - t2%e(1)*x%t + t2%b(2)*x%x(3) - t2%b(3)*x%x(2) - t2x%x(2) = - t2%e(2)*x%t + t2%b(3)*x%x(1) - t2%b(1)*x%x(3) - t2x%x(3) = - t2%e(3)*x%t + t2%b(1)*x%x(2) - t2%b(2)*x%x(1) -end function tensor2odd_momentum -@ -\subsection{Outer Products} -<>= -interface operator (.wedge.) - module procedure momentum_wedge_momentum, & - momentum_wedge_vector, vector_wedge_momentum, vector_wedge_vector -end interface -private :: momentum_wedge_momentum, momentum_wedge_vector, & - vector_wedge_momentum, vector_wedge_vector -@ -<>= -pure function momentum_wedge_momentum (x, y) result (t2) - type(momentum), intent(in) :: x - type(momentum), intent(in) :: y - type(tensor2odd) :: t2 - t2%e = x%t * y%x - x%x * y%t - t2%b(1) = x%x(2) * y%x(3) - x%x(3) * y%x(2) - t2%b(2) = x%x(3) * y%x(1) - x%x(1) * y%x(3) - t2%b(3) = x%x(1) * y%x(2) - x%x(2) * y%x(1) -end function momentum_wedge_momentum -pure function momentum_wedge_vector (x, y) result (t2) - type(momentum), intent(in) :: x - type(vector), intent(in) :: y - type(tensor2odd) :: t2 - t2%e = x%t * y%x - x%x * y%t - t2%b(1) = x%x(2) * y%x(3) - x%x(3) * y%x(2) - t2%b(2) = x%x(3) * y%x(1) - x%x(1) * y%x(3) - t2%b(3) = x%x(1) * y%x(2) - x%x(2) * y%x(1) -end function momentum_wedge_vector -pure function vector_wedge_momentum (x, y) result (t2) - type(vector), intent(in) :: x - type(momentum), intent(in) :: y - type(tensor2odd) :: t2 - t2%e = x%t * y%x - x%x * y%t - t2%b(1) = x%x(2) * y%x(3) - x%x(3) * y%x(2) - t2%b(2) = x%x(3) * y%x(1) - x%x(1) * y%x(3) - t2%b(3) = x%x(1) * y%x(2) - x%x(2) * y%x(1) -end function vector_wedge_momentum -pure function vector_wedge_vector (x, y) result (t2) - type(vector), intent(in) :: x - type(vector), intent(in) :: y - type(tensor2odd) :: t2 - t2%e = x%t * y%x - x%x * y%t - t2%b(1) = x%x(2) * y%x(3) - x%x(3) * y%x(2) - t2%b(2) = x%x(3) * y%x(1) - x%x(1) * y%x(3) - t2%b(3) = x%x(1) * y%x(2) - x%x(2) * y%x(1) -end function vector_wedge_vector -@ -\subsection{Vector Space} -\subsubsection{Scalar Multiplication} -<>= -interface operator (*) - module procedure integer_momentum, real_momentum, double_momentum, & - complex_momentum, dcomplex_momentum, & - integer_vector, real_vector, double_vector, & - complex_vector, dcomplex_vector, & - integer_tensor2odd, real_tensor2odd, double_tensor2odd, & - complex_tensor2odd, dcomplex_tensor2odd, & - momentum_integer, momentum_real, momentum_double, & - momentum_complex, momentum_dcomplex, & - vector_integer, vector_real, vector_double, & - vector_complex, vector_dcomplex, & - tensor2odd_integer, tensor2odd_real, tensor2odd_double, & - tensor2odd_complex, tensor2odd_dcomplex -end interface -private :: integer_momentum, real_momentum, double_momentum, & - complex_momentum, dcomplex_momentum, integer_vector, real_vector, & - double_vector, complex_vector, dcomplex_vector, & - integer_tensor2odd, real_tensor2odd, double_tensor2odd, & - complex_tensor2odd, dcomplex_tensor2odd, momentum_integer, & - momentum_real, momentum_double, momentum_complex, & - momentum_dcomplex, vector_integer, vector_real, vector_double, & - vector_complex, vector_dcomplex, tensor2odd_integer, & - tensor2odd_real, tensor2odd_double, tensor2odd_complex, & - tensor2odd_dcomplex -@ -<>= -pure function integer_momentum (x, y) result (xy) - integer, intent(in) :: x - type(momentum), intent(in) :: y - type(momentum) :: xy - xy%t = x * y%t - xy%x = x * y%x -end function integer_momentum -pure function real_momentum (x, y) result (xy) - real(kind=single), intent(in) :: x - type(momentum), intent(in) :: y - type(momentum) :: xy - xy%t = x * y%t - xy%x = x * y%x -end function real_momentum -pure function double_momentum (x, y) result (xy) - real(kind=default), intent(in) :: x - type(momentum), intent(in) :: y - type(momentum) :: xy - xy%t = x * y%t - xy%x = x * y%x -end function double_momentum -pure function complex_momentum (x, y) result (xy) - complex(kind=single), intent(in) :: x - type(momentum), intent(in) :: y - type(vector) :: xy - xy%t = x * y%t - xy%x = x * y%x -end function complex_momentum -pure function dcomplex_momentum (x, y) result (xy) - complex(kind=default), intent(in) :: x - type(momentum), intent(in) :: y - type(vector) :: xy - xy%t = x * y%t - xy%x = x * y%x -end function dcomplex_momentum -@ -<>= -pure function integer_vector (x, y) result (xy) - integer, intent(in) :: x - type(vector), intent(in) :: y - type(vector) :: xy - xy%t = x * y%t - xy%x = x * y%x -end function integer_vector -pure function real_vector (x, y) result (xy) - real(kind=single), intent(in) :: x - type(vector), intent(in) :: y - type(vector) :: xy - xy%t = x * y%t - xy%x = x * y%x -end function real_vector -pure function double_vector (x, y) result (xy) - real(kind=default), intent(in) :: x - type(vector), intent(in) :: y - type(vector) :: xy - xy%t = x * y%t - xy%x = x * y%x -end function double_vector -pure function complex_vector (x, y) result (xy) - complex(kind=single), intent(in) :: x - type(vector), intent(in) :: y - type(vector) :: xy - xy%t = x * y%t - xy%x = x * y%x -end function complex_vector -pure function dcomplex_vector (x, y) result (xy) - complex(kind=default), intent(in) :: x - type(vector), intent(in) :: y - type(vector) :: xy - xy%t = x * y%t - xy%x = x * y%x -end function dcomplex_vector -@ -<>= -pure function integer_tensor2odd (x, t2) result (xt2) - integer, intent(in) :: x - type(tensor2odd), intent(in) :: t2 - type(tensor2odd) :: xt2 - xt2%e = x * t2%e - xt2%b = x * t2%b -end function integer_tensor2odd -pure function real_tensor2odd (x, t2) result (xt2) - real(kind=single), intent(in) :: x - type(tensor2odd), intent(in) :: t2 - type(tensor2odd) :: xt2 - xt2%e = x * t2%e - xt2%b = x * t2%b -end function real_tensor2odd -pure function double_tensor2odd (x, t2) result (xt2) - real(kind=default), intent(in) :: x - type(tensor2odd), intent(in) :: t2 - type(tensor2odd) :: xt2 - xt2%e = x * t2%e - xt2%b = x * t2%b -end function double_tensor2odd -pure function complex_tensor2odd (x, t2) result (xt2) - complex(kind=single), intent(in) :: x - type(tensor2odd), intent(in) :: t2 - type(tensor2odd) :: xt2 - xt2%e = x * t2%e - xt2%b = x * t2%b -end function complex_tensor2odd -pure function dcomplex_tensor2odd (x, t2) result (xt2) - complex(kind=default), intent(in) :: x - type(tensor2odd), intent(in) :: t2 - type(tensor2odd) :: xt2 - xt2%e = x * t2%e - xt2%b = x * t2%b -end function dcomplex_tensor2odd -@ -<>= -pure function momentum_integer (y, x) result (xy) - integer, intent(in) :: x - type(momentum), intent(in) :: y - type(momentum) :: xy - xy%t = x * y%t - xy%x = x * y%x -end function momentum_integer -pure function momentum_real (y, x) result (xy) - real(kind=single), intent(in) :: x - type(momentum), intent(in) :: y - type(momentum) :: xy - xy%t = x * y%t - xy%x = x * y%x -end function momentum_real -pure function momentum_double (y, x) result (xy) - real(kind=default), intent(in) :: x - type(momentum), intent(in) :: y - type(momentum) :: xy - xy%t = x * y%t - xy%x = x * y%x -end function momentum_double -pure function momentum_complex (y, x) result (xy) - complex(kind=single), intent(in) :: x - type(momentum), intent(in) :: y - type(vector) :: xy - xy%t = x * y%t - xy%x = x * y%x -end function momentum_complex -pure function momentum_dcomplex (y, x) result (xy) - complex(kind=default), intent(in) :: x - type(momentum), intent(in) :: y - type(vector) :: xy - xy%t = x * y%t - xy%x = x * y%x -end function momentum_dcomplex -@ -<>= -pure function vector_integer (y, x) result (xy) - integer, intent(in) :: x - type(vector), intent(in) :: y - type(vector) :: xy - xy%t = x * y%t - xy%x = x * y%x -end function vector_integer -pure function vector_real (y, x) result (xy) - real(kind=single), intent(in) :: x - type(vector), intent(in) :: y - type(vector) :: xy - xy%t = x * y%t - xy%x = x * y%x -end function vector_real -pure function vector_double (y, x) result (xy) - real(kind=default), intent(in) :: x - type(vector), intent(in) :: y - type(vector) :: xy - xy%t = x * y%t - xy%x = x * y%x -end function vector_double -pure function vector_complex (y, x) result (xy) - complex(kind=single), intent(in) :: x - type(vector), intent(in) :: y - type(vector) :: xy - xy%t = x * y%t - xy%x = x * y%x -end function vector_complex -pure function vector_dcomplex (y, x) result (xy) - complex(kind=default), intent(in) :: x - type(vector), intent(in) :: y - type(vector) :: xy - xy%t = x * y%t - xy%x = x * y%x -end function vector_dcomplex -@ -<>= -pure function tensor2odd_integer (t2, x) result (t2x) - type(tensor2odd), intent(in) :: t2 - integer, intent(in) :: x - type(tensor2odd) :: t2x - t2x%e = x * t2%e - t2x%b = x * t2%b -end function tensor2odd_integer -pure function tensor2odd_real (t2, x) result (t2x) - type(tensor2odd), intent(in) :: t2 - real(kind=single), intent(in) :: x - type(tensor2odd) :: t2x - t2x%e = x * t2%e - t2x%b = x * t2%b -end function tensor2odd_real -pure function tensor2odd_double (t2, x) result (t2x) - type(tensor2odd), intent(in) :: t2 - real(kind=default), intent(in) :: x - type(tensor2odd) :: t2x - t2x%e = x * t2%e - t2x%b = x * t2%b -end function tensor2odd_double -pure function tensor2odd_complex (t2, x) result (t2x) - type(tensor2odd), intent(in) :: t2 - complex(kind=single), intent(in) :: x - type(tensor2odd) :: t2x - t2x%e = x * t2%e - t2x%b = x * t2%b -end function tensor2odd_complex -pure function tensor2odd_dcomplex (t2, x) result (t2x) - type(tensor2odd), intent(in) :: t2 - complex(kind=default), intent(in) :: x - type(tensor2odd) :: t2x - t2x%e = x * t2%e - t2x%b = x * t2%b -end function tensor2odd_dcomplex -@ -\subsubsection{Unary Plus and Minus} -<>= -interface operator (+) - module procedure plus_momentum, plus_vector, plus_tensor2odd -end interface -private :: plus_momentum, plus_vector, plus_tensor2odd -interface operator (-) - module procedure neg_momentum, neg_vector, neg_tensor2odd -end interface -private :: neg_momentum, neg_vector, neg_tensor2odd -@ -<>= -pure function plus_momentum (x) result (plus_x) - type(momentum), intent(in) :: x - type(momentum) :: plus_x - plus_x = x -end function plus_momentum -pure function neg_momentum (x) result (neg_x) - type(momentum), intent(in) :: x - type(momentum) :: neg_x - neg_x%t = - x%t - neg_x%x = - x%x -end function neg_momentum -@ -<>= -pure function plus_vector (x) result (plus_x) - type(vector), intent(in) :: x - type(vector) :: plus_x - plus_x = x -end function plus_vector -pure function neg_vector (x) result (neg_x) - type(vector), intent(in) :: x - type(vector) :: neg_x - neg_x%t = - x%t - neg_x%x = - x%x -end function neg_vector -@ -<>= -pure function plus_tensor2odd (x) result (plus_x) - type(tensor2odd), intent(in) :: x - type(tensor2odd) :: plus_x - plus_x = x -end function plus_tensor2odd -pure function neg_tensor2odd (x) result (neg_x) - type(tensor2odd), intent(in) :: x - type(tensor2odd) :: neg_x - neg_x%e = - x%e - neg_x%b = - x%b -end function neg_tensor2odd -@ -\subsubsection{Addition and Subtraction} -<>= -interface operator (+) - module procedure add_momentum, add_vector, & - add_vector_momentum, add_momentum_vector, add_tensor2odd -end interface -private :: add_momentum, add_vector, add_vector_momentum, & - add_momentum_vector, add_tensor2odd -interface operator (-) - module procedure sub_momentum, sub_vector, & - sub_vector_momentum, sub_momentum_vector, sub_tensor2odd -end interface -private :: sub_momentum, sub_vector, sub_vector_momentum, & - sub_momentum_vector, sub_tensor2odd -@ -<>= -pure function add_momentum (x, y) result (xy) - type(momentum), intent(in) :: x, y - type(momentum) :: xy - xy%t = x%t + y%t - xy%x = x%x + y%x -end function add_momentum -pure function add_vector (x, y) result (xy) - type(vector), intent(in) :: x, y - type(vector) :: xy - xy%t = x%t + y%t - xy%x = x%x + y%x -end function add_vector -pure function add_momentum_vector (x, y) result (xy) - type(momentum), intent(in) :: x - type(vector), intent(in) :: y - type(vector) :: xy - xy%t = x%t + y%t - xy%x = x%x + y%x -end function add_momentum_vector -pure function add_vector_momentum (x, y) result (xy) - type(vector), intent(in) :: x - type(momentum), intent(in) :: y - type(vector) :: xy - xy%t = x%t + y%t - xy%x = x%x + y%x -end function add_vector_momentum -pure function add_tensor2odd (x, y) result (xy) - type(tensor2odd), intent(in) :: x, y - type(tensor2odd) :: xy - xy%e = x%e + y%e - xy%b = x%b + y%b -end function add_tensor2odd -@ -<>= -pure function sub_momentum (x, y) result (xy) - type(momentum), intent(in) :: x, y - type(momentum) :: xy - xy%t = x%t - y%t - xy%x = x%x - y%x -end function sub_momentum -pure function sub_vector (x, y) result (xy) - type(vector), intent(in) :: x, y - type(vector) :: xy - xy%t = x%t - y%t - xy%x = x%x - y%x -end function sub_vector -pure function sub_momentum_vector (x, y) result (xy) - type(momentum), intent(in) :: x - type(vector), intent(in) :: y - type(vector) :: xy - xy%t = x%t - y%t - xy%x = x%x - y%x -end function sub_momentum_vector -pure function sub_vector_momentum (x, y) result (xy) - type(vector), intent(in) :: x - type(momentum), intent(in) :: y - type(vector) :: xy - xy%t = x%t - y%t - xy%x = x%x - y%x -end function sub_vector_momentum -pure function sub_tensor2odd (x, y) result (xy) - type(tensor2odd), intent(in) :: x, y - type(tensor2odd) :: xy - xy%e = x%e - y%e - xy%b = x%b - y%b -end function sub_tensor2odd -@ -\subsection{Norm} -\emph{Not} the covariant length! -<>= -interface abs - module procedure abs_momentum, abs_vector, abs_tensor2odd -end interface -private :: abs_momentum, abs_vector, abs_tensor2odd -@ -<>= -pure function abs_momentum (x) result (absx) - type(momentum), intent(in) :: x - real(kind=default) :: absx - absx = sqrt (x%t*x%t + dot_product (x%x, x%x)) -end function abs_momentum -pure function abs_vector (x) result (absx) - type(vector), intent(in) :: x - real(kind=default) :: absx - absx = sqrt (conjg(x%t)*x%t + dot_product (x%x, x%x)) -end function abs_vector -pure function abs_tensor2odd (x) result (absx) - type(tensor2odd), intent(in) :: x - real(kind=default) :: absx - absx = sqrt (dot_product (x%e, x%e) + dot_product (x%b, x%b)) -end function abs_tensor2odd -@ -\subsection{Conjugation} -<>= -interface conjg - module procedure conjg_momentum, conjg_vector, conjg_tensor2odd -end interface -private :: conjg_momentum, conjg_vector, conjg_tensor2odd -@ -<>= -pure function conjg_momentum (x) result (conjg_x) - type(momentum), intent(in) :: x - type(momentum) :: conjg_x - conjg_x = x -end function conjg_momentum -pure function conjg_vector (x) result (conjg_x) - type(vector), intent(in) :: x - type(vector) :: conjg_x - conjg_x%t = conjg (x%t) - conjg_x%x = conjg (x%x) -end function conjg_vector -pure function conjg_tensor2odd (t2) result (conjg_t2) - type(tensor2odd), intent(in) :: t2 - type(tensor2odd) :: conjg_t2 - conjg_t2%e = conjg (t2%e) - conjg_t2%b = conjg (t2%b) -end function conjg_tensor2odd -@ -\subsection{$\epsilon$-Tensors} -\begin{equation} - \epsilon_{0123} = 1 = - \epsilon^{0123} -\end{equation} -in particular -\begin{equation} - \epsilon(p_1,p_2,p_3,p_4) - = \epsilon_{\mu_1\mu_2\mu_3\mu_4} - p_1^{\mu_1}p_2^{\mu_2}p_3^{\mu_3}p_4^{\mu_4} - = p_1^0 p_2^1 p_3^2 p_4^3 \pm \ldots -\end{equation} -<>= -interface pseudo_scalar - module procedure pseudo_scalar_momentum, pseudo_scalar_vector, & - pseudo_scalar_vec_mom -end interface -public :: pseudo_scalar -private :: pseudo_scalar_momentum, pseudo_scalar_vector -@ -<>= -pure function pseudo_scalar_momentum (p1, p2, p3, p4) result (eps1234) - type(momentum), intent(in) :: p1, p2, p3, p4 - real(kind=default) :: eps1234 - eps1234 = & - p1%t * p2%x(1) * (p3%x(2) * p4%x(3) - p3%x(3) * p4%x(2)) & - + p1%t * p2%x(2) * (p3%x(3) * p4%x(1) - p3%x(1) * p4%x(3)) & - + p1%t * p2%x(3) * (p3%x(1) * p4%x(2) - p3%x(2) * p4%x(1)) & - - p1%x(1) * p2%x(2) * (p3%x(3) * p4%t - p3%t * p4%x(3)) & - - p1%x(1) * p2%x(3) * (p3%t * p4%x(2) - p3%x(2) * p4%t ) & - - p1%x(1) * p2%t * (p3%x(2) * p4%x(3) - p3%x(3) * p4%x(2)) & - + p1%x(2) * p2%x(3) * (p3%t * p4%x(1) - p3%x(1) * p4%t ) & - + p1%x(2) * p2%t * (p3%x(1) * p4%x(3) - p3%x(3) * p4%x(1)) & - + p1%x(2) * p2%x(1) * (p3%x(3) * p4%t - p3%t * p4%x(3)) & - - p1%x(3) * p2%t * (p3%x(1) * p4%x(2) - p3%x(2) * p4%x(1)) & - - p1%x(3) * p2%x(1) * (p3%x(2) * p4%t - p3%t * p4%x(2)) & - - p1%x(3) * p2%x(2) * (p3%t * p4%x(1) - p3%x(1) * p4%t ) -end function pseudo_scalar_momentum -@ -<>= -pure function pseudo_scalar_vector (p1, p2, p3, p4) result (eps1234) - type(vector), intent(in) :: p1, p2, p3, p4 - complex(kind=default) :: eps1234 - eps1234 = & - p1%t * p2%x(1) * (p3%x(2) * p4%x(3) - p3%x(3) * p4%x(2)) & - + p1%t * p2%x(2) * (p3%x(3) * p4%x(1) - p3%x(1) * p4%x(3)) & - + p1%t * p2%x(3) * (p3%x(1) * p4%x(2) - p3%x(2) * p4%x(1)) & - - p1%x(1) * p2%x(2) * (p3%x(3) * p4%t - p3%t * p4%x(3)) & - - p1%x(1) * p2%x(3) * (p3%t * p4%x(2) - p3%x(2) * p4%t ) & - - p1%x(1) * p2%t * (p3%x(2) * p4%x(3) - p3%x(3) * p4%x(2)) & - + p1%x(2) * p2%x(3) * (p3%t * p4%x(1) - p3%x(1) * p4%t ) & - + p1%x(2) * p2%t * (p3%x(1) * p4%x(3) - p3%x(3) * p4%x(1)) & - + p1%x(2) * p2%x(1) * (p3%x(3) * p4%t - p3%t * p4%x(3)) & - - p1%x(3) * p2%t * (p3%x(1) * p4%x(2) - p3%x(2) * p4%x(1)) & - - p1%x(3) * p2%x(1) * (p3%x(2) * p4%t - p3%t * p4%x(2)) & - - p1%x(3) * p2%x(2) * (p3%t * p4%x(1) - p3%x(1) * p4%t ) -end function pseudo_scalar_vector -@ -<>= -pure function pseudo_scalar_vec_mom (p1, v1, p2, v2) result (eps1234) - type(momentum), intent(in) :: p1, p2 - type(vector), intent(in) :: v1, v2 - complex(kind=default) :: eps1234 - eps1234 = & - p1%t * v1%x(1) * (p2%x(2) * v2%x(3) - p2%x(3) * v2%x(2)) & - + p1%t * v1%x(2) * (p2%x(3) * v2%x(1) - p2%x(1) * v2%x(3)) & - + p1%t * v1%x(3) * (p2%x(1) * v2%x(2) - p2%x(2) * v2%x(1)) & - - p1%x(1) * v1%x(2) * (p2%x(3) * v2%t - p2%t * v2%x(3)) & - - p1%x(1) * v1%x(3) * (p2%t * v2%x(2) - p2%x(2) * v2%t ) & - - p1%x(1) * v1%t * (p2%x(2) * v2%x(3) - p2%x(3) * v2%x(2)) & - + p1%x(2) * v1%x(3) * (p2%t * v2%x(1) - p2%x(1) * v2%t ) & - + p1%x(2) * v1%t * (p2%x(1) * v2%x(3) - p2%x(3) * v2%x(1)) & - + p1%x(2) * v1%x(1) * (p2%x(3) * v2%t - p2%t * v2%x(3)) & - - p1%x(3) * v1%t * (p2%x(1) * v2%x(2) - p2%x(2) * v2%x(1)) & - - p1%x(3) * v1%x(1) * (p2%x(2) * v2%t - p2%t * v2%x(2)) & - - p1%x(3) * v1%x(2) * (p2%t * v2%x(1) - p2%x(1) * v2%t ) -end function pseudo_scalar_vec_mom -@ -\begin{equation} - \epsilon_\mu(p_1,p_2,p_3) - = \epsilon_{\mu\mu_1\mu_2\mu_3} - p_1^{\mu_1}p_2^{\mu_2}p_3^{\mu_3} -\end{equation} -i.\,e. -\begin{subequations} -\begin{align} - \epsilon_0(p_1,p_2,p_3) &= p_1^1 p_2^2 p_3^3 \pm \ldots \\ - \epsilon_1(p_1,p_2,p_3) &= p_1^2 p_2^3 p_3^0 \pm \ldots \\ - \epsilon_2(p_1,p_2,p_3) &= - p_1^3 p_2^0 p_3^1 \pm \ldots \\ - \epsilon_3(p_1,p_2,p_3) &= p_1^0 p_2^1 p_3^2 \pm \ldots -\end{align} -\end{subequations} -<>= -interface pseudo_vector - module procedure pseudo_vector_momentum, pseudo_vector_vector, & - pseudo_vector_vec_mom -end interface -public :: pseudo_vector -private :: pseudo_vector_momentum, pseudo_vector_vector -@ -<>= -pure function pseudo_vector_momentum (p1, p2, p3) result (eps123) - type(momentum), intent(in) :: p1, p2, p3 - type(momentum) :: eps123 - eps123%t = & - + p1%x(1) * (p2%x(2) * p3%x(3) - p2%x(3) * p3%x(2)) & - + p1%x(2) * (p2%x(3) * p3%x(1) - p2%x(1) * p3%x(3)) & - + p1%x(3) * (p2%x(1) * p3%x(2) - p2%x(2) * p3%x(1)) - eps123%x(1) = & - + p1%x(2) * (p2%x(3) * p3%t - p2%t * p3%x(3)) & - + p1%x(3) * (p2%t * p3%x(2) - p2%x(2) * p3%t ) & - + p1%t * (p2%x(2) * p3%x(3) - p2%x(3) * p3%x(2)) - eps123%x(2) = & - - p1%x(3) * (p2%t * p3%x(1) - p2%x(1) * p3%t ) & - - p1%t * (p2%x(1) * p3%x(3) - p2%x(3) * p3%x(1)) & - - p1%x(1) * (p2%x(3) * p3%t - p2%t * p3%x(3)) - eps123%x(3) = & - + p1%t * (p2%x(1) * p3%x(2) - p2%x(2) * p3%x(1)) & - + p1%x(1) * (p2%x(2) * p3%t - p2%t * p3%x(2)) & - + p1%x(2) * (p2%t * p3%x(1) - p2%x(1) * p3%t ) -end function pseudo_vector_momentum -@ -<>= -pure function pseudo_vector_vector (p1, p2, p3) result (eps123) - type(vector), intent(in) :: p1, p2, p3 - type(vector) :: eps123 - eps123%t = & - + p1%x(1) * (p2%x(2) * p3%x(3) - p2%x(3) * p3%x(2)) & - + p1%x(2) * (p2%x(3) * p3%x(1) - p2%x(1) * p3%x(3)) & - + p1%x(3) * (p2%x(1) * p3%x(2) - p2%x(2) * p3%x(1)) - eps123%x(1) = & - + p1%x(2) * (p2%x(3) * p3%t - p2%t * p3%x(3)) & - + p1%x(3) * (p2%t * p3%x(2) - p2%x(2) * p3%t ) & - + p1%t * (p2%x(2) * p3%x(3) - p2%x(3) * p3%x(2)) - eps123%x(2) = & - - p1%x(3) * (p2%t * p3%x(1) - p2%x(1) * p3%t ) & - - p1%t * (p2%x(1) * p3%x(3) - p2%x(3) * p3%x(1)) & - - p1%x(1) * (p2%x(3) * p3%t - p2%t * p3%x(3)) - eps123%x(3) = & - + p1%t * (p2%x(1) * p3%x(2) - p2%x(2) * p3%x(1)) & - + p1%x(1) * (p2%x(2) * p3%t - p2%t * p3%x(2)) & - + p1%x(2) * (p2%t * p3%x(1) - p2%x(1) * p3%t ) -end function pseudo_vector_vector -@ -<>= -pure function pseudo_vector_vec_mom (p1, p2, v) result (eps123) - type(momentum), intent(in) :: p1, p2 - type(vector), intent(in) :: v - type(vector) :: eps123 - eps123%t = & - + p1%x(1) * (p2%x(2) * v%x(3) - p2%x(3) * v%x(2)) & - + p1%x(2) * (p2%x(3) * v%x(1) - p2%x(1) * v%x(3)) & - + p1%x(3) * (p2%x(1) * v%x(2) - p2%x(2) * v%x(1)) - eps123%x(1) = & - + p1%x(2) * (p2%x(3) * v%t - p2%t * v%x(3)) & - + p1%x(3) * (p2%t * v%x(2) - p2%x(2) * v%t ) & - + p1%t * (p2%x(2) * v%x(3) - p2%x(3) * v%x(2)) - eps123%x(2) = & - - p1%x(3) * (p2%t * v%x(1) - p2%x(1) * v%t ) & - - p1%t * (p2%x(1) * v%x(3) - p2%x(3) * v%x(1)) & - - p1%x(1) * (p2%x(3) * v%t - p2%t * v%x(3)) - eps123%x(3) = & - + p1%t * (p2%x(1) * v%x(2) - p2%x(2) * v%x(1)) & - + p1%x(1) * (p2%x(2) * v%t - p2%t * v%x(2)) & - + p1%x(2) * (p2%t * v%x(1) - p2%x(1) * v%t ) -end function pseudo_vector_vec_mom -@ -\subsection{Utilities} -<>= -@ -<>= -subroutine random_momentum (p, pabs, m) - type(momentum), intent(out) :: p - real(kind=default), intent(in) :: pabs, m - real(kind=default), dimension(2) :: r - real(kind=default) :: phi, cos_th - call random_number (r) - phi = 2*PI * r(1) - cos_th = 2 * r(2) - 1 - p%t = sqrt (pabs**2 + m**2) - p%x = pabs * (/ cos_th * cos(phi), cos_th * sin(phi), sqrt (1 - cos_th**2) /) -end subroutine random_momentum -@ -\section{Polarization vectors} -<<[[omega_polarizations.f95]]>>= -<> -module omega_polarizations - use kinds - use omega_constants - use omega_vectors - implicit none - private - <> - integer, parameter, public :: omega_polarizations_2003_03_A = 0 -contains - <> -end module omega_polarizations -@ -Here we use a phase convention for the polarization vectors compatible -with the angular momentum coupling to spin 3/2 and spin 2. -\begin{subequations} -\begin{align} - \epsilon^\mu_1(k) &= - \frac{1}{|\vec k|\sqrt{k_x^2+k_y^2}} - \left(0; k_z k_x, k_y k_z, - k_x^2 - k_y^2\right) \\ - \epsilon^\mu_2(k) &= - \frac{1}{\sqrt{k_x^2+k_y^2}} - \left(0; -k_y, k_x, 0\right) \\ - \epsilon^\mu_3(k) &= - \frac{k_0}{m|\vec k|} \left({\vec k}^2/k_0; k_x, k_y, k_z\right) -\end{align} -\end{subequations} -and -\begin{subequations} -\begin{align} - \epsilon^\mu_\pm(k) &= - \frac{1}{\sqrt{2}} (\epsilon^\mu_1(k) \pm \ii\epsilon^\mu_2(k) ) \\ - \epsilon^\mu_0(k) &= \epsilon^\mu_3(k) -\end{align} -\end{subequations} -i.\,e. -\begin{subequations} -\begin{align} - \epsilon^\mu_+(k) &= - \frac{1}{\sqrt{2}\sqrt{k_x^2+k_y^2}} - \left(0; \frac{k_zk_x}{|\vec k|} - \ii k_y, - \frac{k_yk_z}{|\vec k|} + \ii k_x, - - \frac{k_x^2+k_y^2}{|\vec k|}\right) \\ - \epsilon^\mu_-(k) &= - \frac{1}{\sqrt{2}\sqrt{k_x^2+k_y^2}} - \left(0; \frac{k_zk_x}{|\vec k|} + \ii k_y, - \frac{k_yk_z}{|\vec k|} - \ii k_x, - -\frac{k_x^2+k_y^2}{|\vec k|}\right) \\ - \epsilon^\mu_0(k) &= - \frac{k_0}{m|\vec k|} \left({\vec k}^2/k_0; k_x, k_y, k_z\right) -\end{align} -\end{subequations} -Determining the mass from the momenta is a numerically haphazardous for -light particles. Therefore, we accept some redundancy and pass the -mass explicitely. -<>= -public :: eps -@ -<>= -pure function eps (m, k, s) result (e) - type(vector) :: e - real(kind=default), intent(in) :: m - type(momentum), intent(in) :: k - integer, intent(in) :: s - real(kind=default) :: kt, kabs, kabs2, sqrt2 - sqrt2 = sqrt (2.0_default) - kabs2 = dot_product (k%x, k%x) - e%t = 0 - e%x = 0 - if (kabs2 > 0) then - kabs = sqrt (kabs2) - select case (s) - case (1) - kt = sqrt (k%x(1)**2 + k%x(2)**2) - if (abs(kt) <= epsilon(kt) * kabs) then - if (k%x(3) > 0) then - e%x(1) = cmplx ( 1, 0, kind=default) / sqrt2 - e%x(2) = cmplx ( 0, 1, kind=default) / sqrt2 - else - e%x(1) = cmplx ( - 1, 0, kind=default) / sqrt2 - e%x(2) = cmplx ( 0, 1, kind=default) / sqrt2 - end if - else - e%x(1) = cmplx ( k%x(3)*k%x(1)/kabs, & - - k%x(2), kind=default) / kt / sqrt2 - e%x(2) = cmplx ( k%x(2)*k%x(3)/kabs, & - k%x(1), kind=default) / kt / sqrt2 - e%x(3) = - kt / kabs / sqrt2 - end if - case (-1) - kt = sqrt (k%x(1)**2 + k%x(2)**2) - if (abs(kt) <= epsilon(kt) * kabs) then - if (k%x(3) > 0) then - e%x(1) = cmplx ( 1, 0, kind=default) / sqrt2 - e%x(2) = cmplx ( 0, - 1, kind=default) / sqrt2 - else - e%x(1) = cmplx ( -1, 0, kind=default) / sqrt2 - e%x(2) = cmplx ( 0, - 1, kind=default) / sqrt2 - end if - else - e%x(1) = cmplx ( k%x(3)*k%x(1)/kabs, & - k%x(2), kind=default) / kt / sqrt2 - e%x(2) = cmplx ( k%x(2)*k%x(3)/kabs, & - - k%x(1), kind=default) / kt / sqrt2 - e%x(3) = - kt / kabs / sqrt2 - end if - case (0) - if (m > 0) then - e%t = kabs / m - e%x = k%t / (m*kabs) * k%x - end if - case (3) - e = (0,1) * k - case (4) - if (m > 0) then - e = (1 / m) * k - else - e = (1 / k%t) * k - end if - end select - else !!! for particles in their rest frame defined to be - !!! polarized along the 3-direction - select case (s) - case (1) - e%x(1) = cmplx ( 1, 0, kind=default) / sqrt2 - e%x(2) = cmplx ( 0, 1, kind=default) / sqrt2 - case (-1) - e%x(1) = cmplx ( 1, 0, kind=default) / sqrt2 - e%x(2) = cmplx ( 0, - 1, kind=default) / sqrt2 - case (0) - if (m > 0) then - e%x(3) = 1 - end if - case (4) - if (m > 0) then - e = (1 / m) * k - else - e = (1 / k%t) * k - end if - end select - end if -end function eps -!!! OLD VERSION !!!!!! -!!! pure function eps (m, k, s) result (e) -!!! type(vector) :: e -!!! real(kind=default), intent(in) :: m -!!! type(momentum), intent(in) :: k -!!! integer, intent(in) :: s -!!! real(kind=default) :: kt, kabs, kabs2, sqrt2 -!!! integer, parameter :: x = 2, y = 3, z = 1 -!!! sqrt2 = sqrt (2.0_default) -!!! kabs2 = dot_product (k%x, k%x) -!!! e%t = 0 -!!! e%x = 0 -!!! if (kabs2 > 0) then -!!! kabs = sqrt (kabs2) -!!! select case (s) -!!! case (1) -!!! kt = sqrt (k%x(x)**2 + k%x(y)**2) -!!! e%x(x) = cmplx ( k%x(z)*k%x(x)/kabs, & -!!! - k%x(y), kind=default) / kt / sqrt2 -!!! e%x(y) = cmplx ( k%x(y)*k%x(z)/kabs, & -!!! k%x(x), kind=default) / kt / sqrt2 -!!! e%x(z) = - kt / kabs / sqrt2 -!!! case (-1) -!!! kt = sqrt (k%x(x)**2 + k%x(y)**2) -!!! e%x(x) = cmplx ( k%x(z)*k%x(x)/kabs, & -!!! k%x(y), kind=default) / kt / sqrt2 -!!! e%x(y) = cmplx ( k%x(y)*k%x(z)/kabs, & -!!! - k%x(x), kind=default) / kt / sqrt2 -!!! e%x(z) = - kt / kabs / sqrt2 -!!! case (0) -!!! if (m > 0) then -!!! e%t = kabs / m -!!! e%x = k%t / (m*kabs) * k%x -!!! end if -!!! case (3) -!!! e = (0,1) * k -!!! case (4) -!!! if (m > 0) then -!!! e = (1 / m) * k -!!! else -!!! e = (1 / k%t) * k -!!! end if -!!! end select -!!! else -!!! select case (s) -!!! case (1) -!!! e%x(x) = cmplx ( 1, 0, kind=default) / sqrt2 -!!! e%x(y) = cmplx ( 0, 1, kind=default) / sqrt2 -!!! case (-1) -!!! e%x(x) = cmplx ( 1, 0, kind=default) / sqrt2 -!!! e%x(y) = cmplx ( 0, - 1, kind=default) / sqrt2 -!!! case (0) -!!! if (m > 0) then -!!! e%x(z) = 1 -!!! end if -!!! case (4) -!!! if (m > 0) then -!!! e = (1 / m) * k -!!! else -!!! e = (1 / k%t) * k -!!! end if -!!! end select -!!! end if -!!! end function eps -!!!!!!!!!!!!!!!!!!!!!!!! -@ -\section{Polarization vectors revisited} -<<[[omega_polarizations_madgraph.f95]]>>= -<> -module omega_polarizations_madgraph - use kinds - use omega_constants - use omega_vectors - implicit none - private - <> - integer, parameter, public :: omega_pols_madgraph_2003_03_A = 0 -contains - <> -end module omega_polarizations_madgraph -@ -This set of polarization vectors is compatible with HELAS~\cite{HELAS}: -\begin{subequations} -\begin{align} - \epsilon^\mu_1(k) &= - \frac{1}{|\vec k|\sqrt{k_x^2+k_y^2}} - \left(0; k_z k_x, k_y k_z, - k_x^2 - k_y^2\right) \\ - \epsilon^\mu_2(k) &= - \frac{1}{\sqrt{k_x^2+k_y^2}} - \left(0; -k_y, k_x, 0\right) \\ - \epsilon^\mu_3(k) &= - \frac{k_0}{m|\vec k|} \left({\vec k}^2/k_0; k_x, k_y, k_z\right) -\end{align} -\end{subequations} -and -\begin{subequations} -\begin{align} - \epsilon^\mu_\pm(k) &= - \frac{1}{\sqrt{2}} (\mp \epsilon^\mu_1(k) - \ii\epsilon^\mu_2(k) ) \\ - \epsilon^\mu_0(k) &= \epsilon^\mu_3(k) -\end{align} -\end{subequations} -i.\,e. -\begin{subequations} -\begin{align} - \epsilon^\mu_+(k) &= - \frac{1}{\sqrt{2}\sqrt{k_x^2+k_y^2}} - \left(0; -\frac{k_zk_x}{|\vec k|} + \ii k_y, - -\frac{k_yk_z}{|\vec k|} - \ii k_x, - \frac{k_x^2+k_y^2}{|\vec k|}\right) \\ - \epsilon^\mu_-(k) &= - \frac{1}{\sqrt{2}\sqrt{k_x^2+k_y^2}} - \left(0; \frac{k_zk_x}{|\vec k|} + \ii k_y, - \frac{k_yk_z}{|\vec k|} - \ii k_x, - -\frac{k_x^2+k_y^2}{|\vec k|}\right) \\ - \epsilon^\mu_0(k) &= - \frac{k_0}{m|\vec k|} \left({\vec k}^2/k_0; k_x, k_y, k_z\right) -\end{align} -\end{subequations} -Fortunately, for comparing with squared matrix generated by Madgraph -we can also use the modified version, since the difference is only a -phase and does \emph{not} mix helicity states. -@ Determining the mass from the momenta is a numerically haphazardous for -light particles. Therefore, we accept some redundancy and pass the -mass explicitely. -<>= -public :: eps -@ -<>= -pure function eps (m, k, s) result (e) - type(vector) :: e - real(kind=default), intent(in) :: m - type(momentum), intent(in) :: k - integer, intent(in) :: s - real(kind=default) :: kt, kabs, kabs2, sqrt2 - sqrt2 = sqrt (2.0_default) - kabs2 = dot_product (k%x, k%x) - e%t = 0 - e%x = 0 - if (kabs2 > 0) then - kabs = sqrt (kabs2) - select case (s) - case (1) - kt = sqrt (k%x(1)**2 + k%x(2)**2) - if (abs(kt) <= epsilon(kt) * kabs) then - if (k%x(3) > 0) then - e%x(1) = cmplx ( - 1, 0, kind=default) / sqrt2 - e%x(2) = cmplx ( 0, - 1, kind=default) / sqrt2 - else - e%x(1) = cmplx ( 1, 0, kind=default) / sqrt2 - e%x(2) = cmplx ( 0, - 1, kind=default) / sqrt2 - end if - else - e%x(1) = cmplx ( - k%x(3)*k%x(1)/kabs, & - k%x(2), kind=default) / kt / sqrt2 - e%x(2) = cmplx ( - k%x(2)*k%x(3)/kabs, & - - k%x(1), kind=default) / kt / sqrt2 - e%x(3) = kt / kabs / sqrt2 - end if - case (-1) - kt = sqrt (k%x(1)**2 + k%x(2)**2) - if (abs(kt) <= epsilon(kt) * kabs) then - if (k%x(3) > 0) then - e%x(1) = cmplx ( 1, 0, kind=default) / sqrt2 - e%x(2) = cmplx ( 0, - 1, kind=default) / sqrt2 - else - e%x(1) = cmplx ( -1, 0, kind=default) / sqrt2 - e%x(2) = cmplx ( 0, - 1, kind=default) / sqrt2 - end if - else - e%x(1) = cmplx ( k%x(3)*k%x(1)/kabs, & - k%x(2), kind=default) / kt / sqrt2 - e%x(2) = cmplx ( k%x(2)*k%x(3)/kabs, & - - k%x(1), kind=default) / kt / sqrt2 - e%x(3) = - kt / kabs / sqrt2 - end if - case (0) - if (m > 0) then - e%t = kabs / m - e%x = k%t / (m*kabs) * k%x - end if - case (3) - e = (0,1) * k - case (4) - if (m > 0) then - e = (1 / m) * k - else - e = (1 / k%t) * k - end if - end select - else !!! for particles in their rest frame defined to be - !!! polarized along the 3-direction - select case (s) - case (1) - e%x(1) = cmplx ( - 1, 0, kind=default) / sqrt2 - e%x(2) = cmplx ( 0, - 1, kind=default) / sqrt2 - case (-1) - e%x(1) = cmplx ( 1, 0, kind=default) / sqrt2 - e%x(2) = cmplx ( 0, - 1, kind=default) / sqrt2 - case (0) - if (m > 0) then - e%x(3) = 1 - end if - case (4) - if (m > 0) then - e = (1 / m) * k - else - e = (1 / k%t) * k - end if - end select - end if -end function eps -@ -\section{Symmetric Tensors} -Spin-2 polarization tensors are symmetric, transversal and traceless -\begin{subequations} -\begin{align} - \epsilon^{\mu\nu}_{m}(k) &= \epsilon^{\nu\mu}_{m}(k) \\ - k_\mu \epsilon^{\mu\nu}_{m}(k) &= k_\nu \epsilon^{\mu\nu}_{m}(k) = 0 \\ - \epsilon^{\mu}_{m,\mu}(k) &= 0 -\end{align} -\end{subequations} -with $m=1,2,3,4,5$. Our current representation is redundant and does -\emph{not} enforce symmetry or tracelessness. -<<[[omega_tensors.f95]]>>= -<> -module omega_tensors - use kinds - use omega_constants - use omega_vectors - implicit none - private - public :: operator (*), operator (+), operator (-), & - operator (.tprod.) - public :: abs, conjg - <<[[intrinsic :: abs]]>> - <<[[intrinsic :: conjg]]>> - type, public :: tensor - ! private (omegalib needs access, but DON'T TOUCH IT!) - complex(kind=default), dimension(0:3,0:3) :: t - end type tensor - <> - integer, parameter, public :: omega_tensors_2003_03_A = 0 -contains - <> -end module omega_tensors -@ -\subsection{Vector Space} -\subsubsection{Scalar Multliplication} -<>= -interface operator (*) - module procedure integer_tensor, real_tensor, double_tensor, & - complex_tensor, dcomplex_tensor -end interface -private :: integer_tensor, real_tensor, double_tensor -private :: complex_tensor, dcomplex_tensor -@ -<>= -pure function integer_tensor (x, y) result (xy) - integer, intent(in) :: x - type(tensor), intent(in) :: y - type(tensor) :: xy - xy%t = x * y%t -end function integer_tensor -pure function real_tensor (x, y) result (xy) - real(kind=single), intent(in) :: x - type(tensor), intent(in) :: y - type(tensor) :: xy - xy%t = x * y%t -end function real_tensor -pure function double_tensor (x, y) result (xy) - real(kind=default), intent(in) :: x - type(tensor), intent(in) :: y - type(tensor) :: xy - xy%t = x * y%t -end function double_tensor -pure function complex_tensor (x, y) result (xy) - complex(kind=single), intent(in) :: x - type(tensor), intent(in) :: y - type(tensor) :: xy - xy%t = x * y%t -end function complex_tensor -pure function dcomplex_tensor (x, y) result (xy) - complex(kind=default), intent(in) :: x - type(tensor), intent(in) :: y - type(tensor) :: xy - xy%t = x * y%t -end function dcomplex_tensor -@ -\subsubsection{Addition and Subtraction} -<>= -interface operator (+) - module procedure plus_tensor -end interface -private :: plus_tensor -interface operator (-) - module procedure neg_tensor -end interface -private :: neg_tensor -@ -<>= -pure function plus_tensor (t1) result (t2) - type(tensor), intent(in) :: t1 - type(tensor) :: t2 - t2 = t1 -end function plus_tensor -pure function neg_tensor (t1) result (t2) - type(tensor), intent(in) :: t1 - type(tensor) :: t2 - t2%t = - t1%t -end function neg_tensor -@ -<>= -interface operator (+) - module procedure add_tensor -end interface -private :: add_tensor -interface operator (-) - module procedure sub_tensor -end interface -private :: sub_tensor -@ -<>= -pure function add_tensor (x, y) result (xy) - type(tensor), intent(in) :: x, y - type(tensor) :: xy - xy%t = x%t + y%t -end function add_tensor -pure function sub_tensor (x, y) result (xy) - type(tensor), intent(in) :: x, y - type(tensor) :: xy - xy%t = x%t - y%t -end function sub_tensor -@ -<>= -interface operator (.tprod.) - module procedure out_prod_vv, out_prod_vm, & - out_prod_mv, out_prod_mm -end interface -private :: out_prod_vv, out_prod_vm, & - out_prod_mv, out_prod_mm -@ -<>= -pure function out_prod_vv (v, w) result (t) - type(tensor) :: t - type(vector), intent(in) :: v, w - integer :: i, j - t%t(0,0) = v%t * w%t - t%t(0,1:3) = v%t * w%x - t%t(1:3,0) = v%x * w%t - do i = 1, 3 - do j = 1, 3 - t%t(i,j) = v%x(i) * w%x(j) - end do - end do -end function out_prod_vv -@ -<>= -pure function out_prod_vm (v, m) result (t) - type(tensor) :: t - type(vector), intent(in) :: v - type(momentum), intent(in) :: m - integer :: i, j - t%t(0,0) = v%t * m%t - t%t(0,1:3) = v%t * m%x - t%t(1:3,0) = v%x * m%t - do i = 1, 3 - do j = 1, 3 - t%t(i,j) = v%x(i) * m%x(j) - end do - end do -end function out_prod_vm -@ -<>= -pure function out_prod_mv (m, v) result (t) - type(tensor) :: t - type(vector), intent(in) :: v - type(momentum), intent(in) :: m - integer :: i, j - t%t(0,0) = m%t * v%t - t%t(0,1:3) = m%t * v%x - t%t(1:3,0) = m%x * v%t - do i = 1, 3 - do j = 1, 3 - t%t(i,j) = m%x(i) * v%x(j) - end do - end do -end function out_prod_mv -@ -<>= -pure function out_prod_mm (m, n) result (t) - type(tensor) :: t - type(momentum), intent(in) :: m, n - integer :: i, j - t%t(0,0) = m%t * n%t - t%t(0,1:3) = m%t * n%x - t%t(1:3,0) = m%x * n%t - do i = 1, 3 - do j = 1, 3 - t%t(i,j) = m%x(i) * n%x(j) - end do - end do -end function out_prod_mm -@ -<>= -interface abs - module procedure abs_tensor -end interface -private :: abs_tensor -@ -<>= -pure function abs_tensor (t) result (abs_t) - type(tensor), intent(in) :: t - real(kind=default) :: abs_t - abs_t = sqrt (sum ((abs (t%t))**2)) -end function abs_tensor -@ -<>= -interface conjg - module procedure conjg_tensor -end interface -private :: conjg_tensor -@ -<>= -pure function conjg_tensor (t) result (conjg_t) - type(tensor), intent(in) :: t - type(tensor) :: conjg_t - conjg_t%t = conjg (t%t) -end function conjg_tensor -@ -<>= -interface operator (*) - module procedure tensor_tensor, vector_tensor, tensor_vector, & - momentum_tensor, tensor_momentum -end interface -private :: tensor_tensor, vector_tensor, tensor_vector, & - momentum_tensor, tensor_momentum -@ -<>= -pure function tensor_tensor (t1, t2) result (t1t2) - type(tensor), intent(in) :: t1 - type(tensor), intent(in) :: t2 - complex(kind=default) :: t1t2 - integer :: i1, i2 - t1t2 = t1%t(0,0)*t2%t(0,0) & - - dot_product (conjg (t1%t(0,1:)), t2%t(0,1:)) & - - dot_product (conjg (t1%t(1:,0)), t2%t(1:,0)) - do i1 = 1, 3 - do i2 = 1, 3 - t1t2 = t1t2 + t1%t(i1,i2)*t2%t(i1,i2) - end do - end do -end function tensor_tensor -@ -<>= -pure function tensor_vector (t, v) result (tv) - type(tensor), intent(in) :: t - type(vector), intent(in) :: v - type(vector) :: tv - tv%t = t%t(0,0) * v%t - dot_product (conjg (t%t(0,1:)), v%x) - tv%x(1) = t%t(0,1) * v%t - dot_product (conjg (t%t(1,1:)), v%x) - tv%x(2) = t%t(0,2) * v%t - dot_product (conjg (t%t(2,1:)), v%x) - tv%x(3) = t%t(0,3) * v%t - dot_product (conjg (t%t(3,1:)), v%x) -end function tensor_vector -@ -<>= -pure function vector_tensor (v, t) result (vt) - type(vector), intent(in) :: v - type(tensor), intent(in) :: t - type(vector) :: vt - vt%t = v%t * t%t(0,0) - dot_product (conjg (v%x), t%t(1:,0)) - vt%x(1) = v%t * t%t(0,1) - dot_product (conjg (v%x), t%t(1:,1)) - vt%x(2) = v%t * t%t(0,2) - dot_product (conjg (v%x), t%t(1:,2)) - vt%x(3) = v%t * t%t(0,3) - dot_product (conjg (v%x), t%t(1:,3)) -end function vector_tensor -@ -<>= -pure function tensor_momentum (t, p) result (tp) - type(tensor), intent(in) :: t - type(momentum), intent(in) :: p - type(vector) :: tp - tp%t = t%t(0,0) * p%t - dot_product (conjg (t%t(0,1:)), p%x) - tp%x(1) = t%t(0,1) * p%t - dot_product (conjg (t%t(1,1:)), p%x) - tp%x(2) = t%t(0,2) * p%t - dot_product (conjg (t%t(2,1:)), p%x) - tp%x(3) = t%t(0,3) * p%t - dot_product (conjg (t%t(3,1:)), p%x) -end function tensor_momentum -@ -<>= -pure function momentum_tensor (p, t) result (pt) - type(momentum), intent(in) :: p - type(tensor), intent(in) :: t - type(vector) :: pt - pt%t = p%t * t%t(0,0) - dot_product (p%x, t%t(1:,0)) - pt%x(1) = p%t * t%t(0,1) - dot_product (p%x, t%t(1:,1)) - pt%x(2) = p%t * t%t(0,2) - dot_product (p%x, t%t(1:,2)) - pt%x(3) = p%t * t%t(0,3) - dot_product (p%x, t%t(1:,3)) -end function momentum_tensor -@ -\section{Symmetric Polarization Tensors} -\begin{subequations} -\begin{align} - \epsilon^{\mu\nu}_{+2}(k) &= \epsilon^{\mu}_{+}(k)\epsilon^{\nu}_{+}(k) \\ - \epsilon^{\mu\nu}_{+1}(k) &= \frac{1}{\sqrt{2}} - \left( \epsilon^{\mu}_{+}(k)\epsilon^{\nu}_{0}(k) - + \epsilon^{\mu}_{0}(k)\epsilon^{\nu}_{+}(k) \right) \\ - \epsilon^{\mu\nu}_{0}(k) &= \frac{1}{\sqrt{6}} - \left( \epsilon^{\mu}_{+}(k)\epsilon^{\nu}_{-}(k) - + \epsilon^{\mu}_{-}(k)\epsilon^{\nu}_{+}(k) - - 2 \epsilon^{\mu}_{0}(k)\epsilon^{\nu}_{0}(k) \right) \\ - \epsilon^{\mu\nu}_{-1}(k) &= \frac{1}{\sqrt{2}} - \left( \epsilon^{\mu}_{-}(k)\epsilon^{\nu}_{0}(k) - + \epsilon^{\mu}_{0}(k)\epsilon^{\nu}_{-}(k) \right) \\ - \epsilon^{\mu\nu}_{-2}(k) &= \epsilon^{\mu}_{-}(k)\epsilon^{\nu}_{-}(k) -\end{align} -\end{subequations} -Note that~$\epsilon^{\mu}_{\pm2,\mu}(k) = -\epsilon^{\mu}_{\pm}(k)\epsilon_{\pm,\mu}(k) \propto -\epsilon^{\mu}_{\pm}(k)\epsilon_{\mp,\mu}^{*}(k) = 0$ and that the sign in -$\epsilon^{\mu\nu}_{0}(k)$ insures its tracelessness\footnote{ -On the other hand, with the shift operator -$L_{-}\ket{+}=\ee^{\ii\phi}\ket{0}$ and -$L_{-}\ket{0}=\ee^{\ii\chi}\ket{-}$, we find -\begin{equation*} - L_{-}^{2}\ket{++} = - 2\ee^{2\ii\phi}\ket{00} + \ee^{\ii(\phi+\chi)}(\ket{+-}+\ket{-+}) -\end{equation*} -i.\,e.~$\chi-\phi=\pi$, if we want to identify -$\epsilon^{\mu}_{-,0,+}$ with $\ket{-,0,+}$.}. -<<[[omega_tensor_polarizations.f95]]>>= -<> -module omega_tensor_polarizations - use kinds - use omega_constants - use omega_vectors - use omega_tensors - use omega_polarizations - implicit none - private - <> - integer, parameter, public :: omega_tensor_pols_2003_03_A = 0 -contains - <> -end module omega_tensor_polarizations -@ -<>= -public :: eps2 -@ -<>= -pure function eps2 (m, k, s) result (t) - type(tensor) :: t - real(kind=default), intent(in) :: m - type(momentum), intent(in) :: k - integer, intent(in) :: s - type(vector) :: ep, em, e0 - t%t = 0 - select case (s) - case (2) - ep = eps (m, k, 1) - t = ep.tprod.ep - case (1) - ep = eps (m, k, 1) - e0 = eps (m, k, 0) - t = (1 / sqrt (2.0_default)) & - * ((ep.tprod.e0) + (e0.tprod.ep)) - case (0) - ep = eps (m, k, 1) - e0 = eps (m, k, 0) - em = eps (m, k, -1) - t = (1 / sqrt (6.0_default)) & - * ((ep.tprod.em) + (em.tprod.ep) - 2*(e0.tprod.e0)) - case (-1) - e0 = eps (m, k, 0) - em = eps (m, k, -1) - t = (1 / sqrt (2.0_default)) & - * ((em.tprod.e0) + (e0.tprod.em)) - case (-2) - em = eps (m, k, -1) - t = em.tprod.em - end select -end function eps2 -@ \section{Couplings} -<<[[omega_couplings.f95]]>>= -<> -module omega_couplings - use kinds - use omega_constants - use omega_vectors - use omega_tensors - implicit none - private - <> - <> - integer, parameter, public :: omega_couplings_2003_03_A = 0 -contains - <> - <> -end module omega_couplings -@ -<>= -public :: wd_tl -@ -<>= -public :: gauss -@ -\begin{equation} - \Theta(p^2)\Gamma -\end{equation} -<>= -pure function wd_tl (p, w) result (width) - real(kind=default) :: width - type(momentum), intent(in) :: p - real(kind=default), intent(in) :: w - if (p*p > 0) then - width = w - else - width = 0 - end if -end function wd_tl -@ -<>= -pure function gauss (x, mu, w) result (gg) - real(kind=default) :: gg - real(kind=default), intent(in) :: x, mu, w - if (w > 0) then - gg = exp(-(x - mu**2)**2/4.0_default/mu**2/w**2) * & - sqrt(sqrt(PI/2)) / w / mu - else - gg = 1.0_default - end if -end function gauss -@ -<>= -public :: pr_phi, pr_unitarity, pr_feynman, pr_gauge, pr_rxi -public :: pj_phi, pj_unitarity -public :: pg_phi, pg_unitarity -@ -\begin{equation} - \frac{\ii}{p^2-m^2+\ii m\Gamma}\phi -\end{equation} -<>= -pure function pr_phi (p, m, w, phi) result (pphi) - complex(kind=default) :: pphi - type(momentum), intent(in) :: p - real(kind=default), intent(in) :: m, w - complex(kind=default), intent(in) :: phi - pphi = (1 / cmplx (p*p - m**2, m*w, kind=default)) * phi -end function pr_phi -@ -\begin{equation} - \sqrt{\frac{\pi}{M\Gamma}} - \phi -\end{equation} -<>= -pure function pj_phi (m, w, phi) result (pphi) - complex(kind=default) :: pphi - real(kind=default), intent(in) :: m, w - complex(kind=default), intent(in) :: phi - pphi = (0, -1) * sqrt (PI / m / w) * phi -end function pj_phi -@ -<>= -pure function pg_phi (p, m, w, phi) result (pphi) - complex(kind=default) :: pphi - type(momentum), intent(in) :: p - real(kind=default), intent(in) :: m, w - complex(kind=default), intent(in) :: phi - pphi = ((0, 1) * gauss (p*p, m, w)) * phi -end function pg_phi -@ -\begin{equation} - \frac{\ii}{p^2-m^2+\ii m\Gamma} - \left( -g_{\mu\nu} + \frac{p_\mu p_\nu}{m^2} \right) \epsilon^\nu(p) -\end{equation} -NB: the explicit cast to [[vector]] is required here, because a specific -[[complex_momentum]] procedure for [[operator (*)]] would introduce -ambiguities. -NB: we used to use the constructor [[vector (p%t, p%x)]] instead of -the temporary variable, but the Intel Fortran Compiler choked on it. -<>= -pure function pr_unitarity (p, m, w, e) result (pe) - type(vector) :: pe - type(momentum), intent(in) :: p - real(kind=default), intent(in) :: m, w - type(vector), intent(in) :: e - type(vector) :: pv - pv = p - pe = - (1 / cmplx (p*p - m**2, m*w, kind=default)) & - * (e - (p*e / m**2) * pv) -end function pr_unitarity -@ -\begin{equation} - \sqrt{\frac{\pi}{M\Gamma}} - \left( -g_{\mu\nu} + \frac{p_\mu p_\nu}{m^2} \right) \epsilon^\nu(p) -\end{equation} -<>= -pure function pj_unitarity (p, m, w, e) result (pe) - type(vector) :: pe - type(momentum), intent(in) :: p - real(kind=default), intent(in) :: m, w - type(vector), intent(in) :: e - type(vector) :: pv - pv = p - pe = (0, 1) * sqrt (PI / m / w) * (e - (p*e / m**2) * pv) -end function pj_unitarity -@ -<>= -pure function pg_unitarity (p, m, w, e) result (pe) - type(vector) :: pe - type(momentum), intent(in) :: p - real(kind=default), intent(in) :: m, w - type(vector), intent(in) :: e - type(vector) :: pv - pv = p - pe = - gauss (p*p, m, w) & - * (e - (p*e / m**2) * pv) -end function pg_unitarity -@ -\begin{equation} - \frac{-i}{p^2} \epsilon^\nu(p) -\end{equation} -<>= -pure function pr_feynman (p, e) result (pe) - type(vector) :: pe - type(momentum), intent(in) :: p - type(vector), intent(in) :: e - pe = - (1 / (p*p)) * e -end function pr_feynman -@ -\begin{equation} - \frac{\ii}{p^2} - \left( -g_{\mu\nu} + (1-\xi)\frac{p_\mu p_\nu}{p^2} \right) - \epsilon^\nu(p) -\end{equation} -<>= -pure function pr_gauge (p, xi, e) result (pe) - type(vector) :: pe - type(momentum), intent(in) :: p - real(kind=default), intent(in) :: xi - type(vector), intent(in) :: e - real(kind=default) :: p2 - type(vector) :: pv - p2 = p*p - pv = p - pe = - (1 / p2) * (e - ((1 - xi) * (p*e) / p2) * pv) -end function pr_gauge -@ -\begin{equation} - \frac{\ii}{p^2-m^2+\ii m\Gamma} - \left( -g_{\mu\nu} + (1-\xi)\frac{p_\mu p_\nu}{p^2-\xi m^2} \right) - \epsilon^\nu(p) -\end{equation} -<>= -pure function pr_rxi (p, m, w, xi, e) result (pe) - type(vector) :: pe - type(momentum), intent(in) :: p - real(kind=default), intent(in) :: m, w, xi - type(vector), intent(in) :: e - real(kind=default) :: p2 - type(vector) :: pv - p2 = p*p - pv = p - pe = - (1 / cmplx (p2 - m**2, m*w, kind=default)) & - * (e - ((1 - xi) * (p*e) / (p2 - xi * m**2)) * pv) -end function pr_rxi -@ -<>= -public :: pr_tensor -@ -\begin{subequations} -\begin{equation} - \frac{\ii P^{\mu\nu,\rho\sigma}(p,m)}{p^2-m^2+\ii m\Gamma} T_{\rho\sigma} -\end{equation} -with -\begin{multline} - P^{\mu\nu,\rho\sigma}(p,m) - = \frac{1}{2} \left(g^{\mu\rho}-\frac{p^{\mu}p^{\nu}}{m^2}\right) - \left(g^{\nu\sigma}-\frac{p^{\nu}p^{\sigma}}{m^2}\right) - + \frac{1}{2} \left(g^{\mu\sigma}-\frac{p^{\mu}p^{\sigma}}{m^2}\right) - \left(g^{\nu\rho}-\frac{p^{\nu}p^{\rho}}{m^2}\right) \\ - - \frac{1}{3} \left(g^{\mu\nu}-\frac{p^{\mu}p^{\nu}}{m^2}\right) - \left(g^{\rho\sigma}-\frac{p^{\rho}p^{\sigma}}{m^2}\right) -\end{multline} -\end{subequations} -Be careful with raising and lowering of indices: -\begin{subequations} -\begin{align} - g^{\mu\nu}-\frac{k^{\mu}k^{\nu}}{m^2} - &= \begin{pmatrix} - 1 - k^0k^0 / m^2 & - k^0 \vec k / m^2 \\ - - \vec k k^0 / m^2 & - \mathbf{1} - \vec k \otimes \vec k / m^2 - \end{pmatrix} \\ - g^{\mu}_{\hphantom{\mu}\nu}-\frac{k^{\mu}k_{\nu}}{m^2} - &= \begin{pmatrix} - 1 - k^0k^0 / m^2 & k^0 \vec k / m^2 \\ - - \vec k k^0 / m^2 & \mathbf{1} + \vec k \otimes \vec k / m^2 - \end{pmatrix} -\end{align} -\end{subequations} -<>= -pure function pr_tensor (p, m, w, t) result (pt) - type(tensor) :: pt - type(momentum), intent(in) :: p - real(kind=default), intent(in) :: m, w - type(tensor), intent(in) :: t - complex(kind=default) :: p_dd_t - real(kind=default), dimension(0:3,0:3) :: p_uu, p_ud, p_du, p_dd - integer :: i, j - p_uu(0,0) = 1 - p%t * p%t / m**2 - p_uu(0,1:3) = - p%t * p%x / m**2 - p_uu(1:3,0) = p_uu(0,1:3) - do i = 1, 3 - do j = 1, 3 - p_uu(i,j) = - p%x(i) * p%x(j) / m**2 - end do - end do - do i = 1, 3 - p_uu(i,i) = - 1 + p_uu(i,i) - end do - p_ud(:,0) = p_uu(:,0) - p_ud(:,1:3) = - p_uu(:,1:3) - p_du = transpose (p_ud) - p_dd(:,0) = p_du(:,0) - p_dd(:,1:3) = - p_du(:,1:3) - p_dd_t = 0 - do i = 0, 3 - do j = 0, 3 - p_dd_t = p_dd_t + p_dd(i,j) * t%t(i,j) - end do - end do - pt%t = matmul (p_ud, matmul (0.5_default * (t%t + transpose (t%t)), p_du)) & - - (p_dd_t / 3.0_default) * p_uu - pt%t = pt%t / cmplx (p*p - m**2, m*w, kind=default) -end function pr_tensor -@ \subsection{Triple Gauge Couplings} -<>= -public :: g_gg -@ According to~(\ref{eq:fuse-gauge}) -\begin{multline} - A^{a,\mu}(k_1+k_2) = - \ii g - \bigl( (k_1^{\mu}-k_2^{\mu})A^{a_1}(k_1) \cdot A^{a_2}(k_2) \\ - + (2k_2+k_1)\cdot A^{a_1}(k_1)A^{a_2,\mu}(k_2) - - A^{a_1,\mu}(k_1)A^{a_2}(k_2)\cdot(2k_1+k_2) \bigr) -\end{multline} -<>= -pure function g_gg (g, a1, k1, a2, k2) result (a) - complex(kind=default), intent(in) :: g - type(vector), intent(in) :: a1, a2 - type(momentum), intent(in) :: k1, k2 - type(vector) :: a - a = (0, -1) * g * ((k1 - k2) * (a1 * a2) & - + ((2*k2 + k1) * a1) * a2 - a1 * ((2*k1 + k2) * a2)) -end function g_gg -@ \subsection{Quadruple Gauge Couplings} -<>= -public :: x_gg, g_gx -@ -\begin{equation} - T^{a,\mu\nu}(k_1+k_2) = g - \bigl( A^{a_1,\mu}(k_1) A^{a_2,\nu}(k_2) - A^{a_1,\nu}(k_1) A^{a_2,\mu}(k_2) \bigr) -\end{equation} -<>= -pure function x_gg (g, a1, a2) result (x) - complex(kind=default), intent(in) :: g - type(vector), intent(in) :: a1, a2 - type(tensor2odd) :: x - x = g * (a1 .wedge. a2) -end function x_gg -@ -\begin{equation} - A^{a,\mu}(k_1+k_2) = g A^{a_1}_\nu(k_1) T^{a_2,\nu\mu}(k_2) -\end{equation} -<>= -pure function g_gx (g, a1, x) result (a) - complex(kind=default), intent(in) :: g - type(vector), intent(in) :: a1 - type(tensor2odd), intent(in) :: x - type(vector) :: a - a = g * (a1 * x) -end function g_gx -@ \subsection{Scalar Current} -<>= -public :: v_ss, s_vs -@ -\begin{equation} - V^\mu(k_1+k_2) = g(k_1^\mu - k_2^\mu)\phi_1(k_1)\phi_2(k_2) -\end{equation} -<>= -pure function v_ss (g, phi1, k1, phi2, k2) result (v) - complex(kind=default), intent(in) :: g, phi1, phi2 - type(momentum), intent(in) :: k1, k2 - type(vector) :: v - v = (k1 - k2) * (g * phi1 * phi2) -end function v_ss -@ -\begin{equation} - \phi(k_1+k_2) = g(k_1^\mu + 2k_2^\mu)V_\mu(k_1)\phi(k_2) -\end{equation} -<>= -pure function s_vs (g, v1, k1, phi2, k2) result (phi) - complex(kind=default), intent(in) :: g, phi2 - type(vector), intent(in) :: v1 - type(momentum), intent(in) :: k1, k2 - complex(kind=default) :: phi - phi = g * ((k1 + 2*k2) * v1) * phi2 -end function s_vs -@ \subsection{Triple Vector Couplings} -<>= -public :: tkv_vv, lkv_vv, tv_kvv, lv_kvv, kg_kgkg -public :: t5kv_vv, l5kv_vv, t5v_kvv, l5v_kvv, kg5_kgkg, kg_kg5kg -@ -\begin{equation} - V^\mu(k_1+k_2) = \ii g(k_1-k_2)^\mu V_1^\nu(k_1)V_{2,\nu}(k_2) -\end{equation} -<>= -pure function tkv_vv (g, v1, k1, v2, k2) result (v) - complex(kind=default), intent(in) :: g - type(vector), intent(in) :: v1, v2 - type(momentum), intent(in) :: k1, k2 - type(vector) :: v - v = (k1 - k2) * ((0, 1) * g * (v1*v2)) -end function tkv_vv -@ -\begin{equation} - V^\mu(k_1+k_2) = \ii g \epsilon^{\mu\nu\rho\sigma} - (k_1-k_2)_{\nu} V_{1,\rho}(k_1)V_{2,\sigma}(k_2) -\end{equation} -<>= -pure function t5kv_vv (g, v1, k1, v2, k2) result (v) - complex(kind=default), intent(in) :: g - type(vector), intent(in) :: v1, v2 - type(momentum), intent(in) :: k1, k2 - type(vector) :: v - type(vector) :: k - k = k1 - k2 - v = (0, 1) * g * pseudo_vector (k, v1, v2) -end function t5kv_vv -@ -\begin{equation} - V^\mu(k_1+k_2) = \ii g(k_1+k_2)^\mu V_1^\nu(k_1)V_{2,\nu}(k_2) -\end{equation} -<>= -pure function lkv_vv (g, v1, k1, v2, k2) result (v) - complex(kind=default), intent(in) :: g - type(vector), intent(in) :: v1, v2 - type(momentum), intent(in) :: k1, k2 - type(vector) :: v - v = (k1 + k2) * ((0, 1) * g * (v1*v2)) -end function lkv_vv -@ -\begin{equation} - V^\mu(k_1+k_2) = \ii g \epsilon^{\mu\nu\rho\sigma} - (k_1+k_2)_{\nu} V_{1,\rho}(k_1)V_{2,\sigma}(k_2) -\end{equation} -<>= -pure function l5kv_vv (g, v1, k1, v2, k2) result (v) - complex(kind=default), intent(in) :: g - type(vector), intent(in) :: v1, v2 - type(momentum), intent(in) :: k1, k2 - type(vector) :: v - type(vector) :: k - k = k1 + k2 - v = (0, 1) * g * pseudo_vector (k, v1, v2) -end function l5kv_vv -@ -\begin{equation} - V^\mu(k_1+k_2) = \ii g (k_2-k)^\nu V_{1,\nu}(k_1)V_2^\mu(k_2) - = \ii g (2k_2+k_1)^\nu V_{1,\nu}(k_1)V_2^\mu(k_2) -\end{equation} -using $k=-k_1-k_2$ -<>= -pure function tv_kvv (g, v1, k1, v2, k2) result (v) - complex(kind=default), intent(in) :: g - type(vector), intent(in) :: v1, v2 - type(momentum), intent(in) :: k1, k2 - type(vector) :: v - v = v2 * ((0, 1) * g * ((2*k2 + k1)*v1)) -end function tv_kvv -@ -\begin{equation} - V^\mu(k_1+k_2) = \ii g \epsilon^{\mu\nu\rho\sigma} - (2k_2+k_1)_{\nu} V_{1,\rho}(k_1)V_{2,\sigma}(k_2) -\end{equation} -<>= -pure function t5v_kvv (g, v1, k1, v2, k2) result (v) - complex(kind=default), intent(in) :: g - type(vector), intent(in) :: v1, v2 - type(momentum), intent(in) :: k1, k2 - type(vector) :: v - type(vector) :: k - k = k1 + 2*k2 - v = (0, 1) * g * pseudo_vector (k, v1, v2) -end function t5v_kvv -@ -\begin{equation} - V^\mu(k_1+k_2) = - \ii g k_1^\nu V_{1,\nu}(k_1)V_2^\mu(k_2) -\end{equation} -using $k=-k_1-k_2$ -<>= -pure function lv_kvv (g, v1, k1, v2) result (v) - complex(kind=default), intent(in) :: g - type(vector), intent(in) :: v1, v2 - type(momentum), intent(in) :: k1 - type(vector) :: v - v = v2 * ((0, -1) * g * (k1*v1)) -end function lv_kvv -@ -\begin{equation} - V^\mu(k_1+k_2) = - \ii g \epsilon^{\mu\nu\rho\sigma} - k_{1,\nu} V_{1,\rho}(k_1)V_{2,\sigma}(k_2) -\end{equation} -<>= -pure function l5v_kvv (g, v1, k1, v2) result (v) - complex(kind=default), intent(in) :: g - type(vector), intent(in) :: v1, v2 - type(momentum), intent(in) :: k1 - type(vector) :: v - type(vector) :: k - k = k1 - v = (0, -1) * g * pseudo_vector (k, v1, v2) -end function l5v_kvv -@ -\begin{equation} - A^\mu(k_1+k_2) = \ii g k^\nu - \Bigl( F_{1,\nu}^{\hphantom{1,\nu}\rho}(k_1)F_{2,\rho\mu}(k_2) - - F_{1,\mu}^{\hphantom{1,\mu}\rho}(k_1)F_{2,\rho\nu}(k_2) \Bigr) -\end{equation} -with $k=-k_1-k_2$, i.\,e. -\begin{multline} - A^\mu(k_1+k_2) = -\ii g - \Bigl( [(kk_2)(k_1A_2) - (k_1k_2)(kA_2)] A_1^\mu \\ - + [(k_1k_2)(kA_1) - (kk_1)(k_2A_1)] A_2^\mu \\ - + [(k_2A_1)(kA_2) - (kk_2)(A_1A_2)] k_1^\mu \\ - + [(kk_1)(A_1A_2) - (kA_1)(k_1A_2)] k_2^\mu \Bigr) -\end{multline} -<>= -pure function kg_kgkg (g, a1, k1, a2, k2) result (a) - complex(kind=default), intent(in) :: g - type(vector), intent(in) :: a1, a2 - type(momentum), intent(in) :: k1, k2 - type(vector) :: a - real(kind=default) :: k1k1, k2k2, k1k2, kk1, kk2 - complex(kind=default) :: a1a2, k2a1, ka1, k1a2, ka2 - k1k1 = k1 * k1 - k1k2 = k1 * k2 - k2k2 = k2 * k2 - kk1 = k1k1 + k1k2 - kk2 = k1k2 + k2k2 - k2a1 = k2 * a1 - ka1 = k2a1 + k1 * a1 - k1a2 = k1 * a2 - ka2 = k1a2 + k2 * a2 - a1a2 = a1 * a2 - a = (0, -1) * g * ( (kk2 * k1a2 - k1k2 * ka2 ) * a1 & - + (k1k2 * ka1 - kk1 * k2a1) * a2 & - + (ka2 * k2a1 - kk2 * a1a2) * k1 & - + (kk1 * a1a2 - ka1 * k1a2) * k2 ) -end function kg_kgkg -@ -\begin{equation} - A^\mu(k_1+k_2) = \ii g \epsilon^{\mu\nu\rho\sigma} k_{\nu} - F_{1,\rho}^{\hphantom{1,\rho}\lambda}(k_1)F_{2,\lambda\sigma}(k_2) -\end{equation} -with $k=-k_1-k_2$, i.\,e. -\begin{multline} - A^\mu(k_1+k_2) = -2\ii g \epsilon^{\mu\nu\rho\sigma} k_{\nu} - \Bigl( (k_2A_1) k_{1,\rho} A_{2,\sigma} - + (k_1A_2) A_{1,\rho} k_{2,\sigma} \\ - - (A_1A_2) k_{1,\rho} k_{2,\sigma} - - (k_1k_2) A_{1,\rho} A_{2,\sigma} \Bigr) -\end{multline} -<>= -pure function kg5_kgkg (g, a1, k1, a2, k2) result (a) - complex(kind=default), intent(in) :: g - type(vector), intent(in) :: a1, a2 - type(momentum), intent(in) :: k1, k2 - type(vector) :: a - type(vector) :: kv, k1v, k2v - kv = - k1 - k2 - k1v = k1 - k2v = k2 - a = (0, -2) * g * ( (k2*A1) * pseudo_vector (kv, k1v, a2 ) & - + (k1*A2) * pseudo_vector (kv, A1 , k2v) & - - (A1*A2) * pseudo_vector (kv, k1v, k2v) & - - (k1*k2) * pseudo_vector (kv, a1 , a2 ) ) -end function kg5_kgkg -@ -\begin{equation} - A^\mu(k_1+k_2) = \ii g k_{\nu} \Bigl( - \epsilon^{\mu\rho\lambda\sigma} - F_{1,\hphantom{\nu}\rho}^{\hphantom{1,}\nu} - - \epsilon^{\nu\rho\lambda\sigma} - F_{1,\hphantom{\mu}\rho}^{\hphantom{1,}\mu} \Bigr) - \frac{1}{2} F_{1,\lambda\sigma} -\end{equation} -with $k=-k_1-k_2$, i.\,e. -\begin{multline} - A^\mu(k_1+k_2) = -\ii g \Bigl( - \epsilon^{\mu\rho\lambda\sigma} (kk_2) A_{2,\rho} - - \epsilon^{\mu\rho\lambda\sigma} (kA_2) k_{2,\rho} - - k_2^\mu \epsilon^{\nu\rho\lambda\sigma} k_nu A_{2,\rho} - + A_2^\mu \epsilon^{\nu\rho\lambda\sigma} k_nu k_{2,\rho} - \Bigr) k_{1,\lambda} A_{1,\sigma} -\end{multline} -\begin{dubious} - This is not the most efficienct way of doing it: - $\epsilon^{\mu\nu\rho\sigma}F_{1,\rho\sigma}$ should be cached! -\end{dubious} -<>= -pure function kg_kg5kg (g, a1, k1, a2, k2) result (a) - complex(kind=default), intent(in) :: g - type(vector), intent(in) :: a1, a2 - type(momentum), intent(in) :: k1, k2 - type(vector) :: a - type(vector) :: kv, k1v, k2v - kv = - k1 - k2 - k1v = k1 - k2v = k2 - a = (0, -1) * g * ( (kv*k2v) * pseudo_vector (a2 , k1v, a1) & - - (kv*a2 ) * pseudo_vector (k2v, k1v, a1) & - - k2v * pseudo_scalar (kv, a2, k1v, a1) & - + a2 * pseudo_scalar (kv, k2v, k1v, a1) ) -end function kg_kg5kg -@ \section{Graviton Couplings} -<>= -public :: s_gravs, v_gravv, grav_ss, grav_vv -@ -<>= -pure function s_gravs (g, m, k1, k2, t, s) result (phi) - complex(kind=default), intent(in) :: g, s - real(kind=default), intent(in) :: m - type(momentum), intent(in) :: k1, k2 - type(tensor), intent(in) :: t - complex(kind=default) :: phi, t_tr - t_tr = t%t(0,0) - t%t(1,1) - t%t(2,2) - t%t(3,3) - phi = g * s * (((t*k1)*k2) + ((t*k2)*k1) & - - g * (m**2 + (k1*k2))*t_tr)/2.0_default -end function s_gravs -@ -<>= -pure function grav_ss (g, m, k1, k2, s1, s2) result (t) - complex(kind=default), intent(in) :: g, s1, s2 - real(kind=default), intent(in) :: m - type(momentum), intent(in) :: k1, k2 - type(tensor) :: t_metric, t - t_metric%t = 0 - t_metric%t(0,0) = 1.0_default - t_metric%t(1,1) = - 1.0_default - t_metric%t(2,2) = - 1.0_default - t_metric%t(3,3) = - 1.0_default - t = g*s1*s2/2.0_default * (-(m**2 + (k1*k2)) * t_metric & - + (k1.tprod.k2) + (k2.tprod.k1)) -end function grav_ss -@ -<>= -pure function v_gravv (g, m, k1, k2, t, v) result (vec) - complex(kind=default), intent(in) :: g - real(kind=default), intent(in) :: m - type(momentum), intent(in) :: k1, k2 - type(vector), intent(in) :: v - type(tensor), intent(in) :: t - complex(kind=default) :: t_tr - real(kind=default) :: xi - type(vector) :: vec - xi = 1.0_default - t_tr = t%t(0,0) - t%t(1,1) - t%t(2,2) - t%t(3,3) - vec = (-g)/ 2.0_default * (((k1*k2) + m**2) * & - (t*v + v*t - t_tr * v) + t_tr * (k1*v) * k2 & - - (k1*v) * ((k2*t) + (t*k2)) & - - ((k1*(t*v)) + (v*(t*k1))) * k2 & - + ((k1*(t*k2)) + (k2*(t*k1))) * v) -!!! Unitarity gauge: xi -> Infinity -!!! + (1.0_default/xi) * (t_tr * ((k1*v)*k2) + & -!!! (k2*v)*k2 + (k2*v)*k1 - (k1*(t*v))*k1 + & -!!! (k2*v)*(k2*t) - (v*(t*k1))*k1 - (k2*v)*(t*k2))) -end function v_gravv -@ -<>= -pure function grav_vv (g, m, k1, k2, v1, v2) result (t) - complex(kind=default), intent(in) :: g - type(momentum), intent(in) :: k1, k2 - real(kind=default), intent(in) :: m - real(kind=default) :: xi - type(vector), intent (in) :: v1, v2 - type(tensor) :: t_metric, t - xi = 0.00001_default - t_metric%t = 0 - t_metric%t(0,0) = 1.0_default - t_metric%t(1,1) = - 1.0_default - t_metric%t(2,2) = - 1.0_default - t_metric%t(3,3) = - 1.0_default - t = (-g)/2.0_default * ( & - ((k1*k2) + m**2) * ( & - (v1.tprod.v2) + (v2.tprod.v1) - (v1*v2) * t_metric) & - + (v1*k2)*(v2*k1)*t_metric & - - (k2*v1)*((v2.tprod.k1) + (k1.tprod.v2)) & - - (k1*v2)*((v1.tprod.k2) + (k2.tprod.v1)) & - + (v1*v2)*((k1.tprod.k2) + (k2.tprod.k1))) -!!! Unitarity gauge: xi -> Infinity -!!! + (1.0_default/xi) * ( & -!!! ((k1*v1)*(k1*v2) + (k2*v1)*(k2*v2) + (k1*v1)*(k2*v2))* & -!!! t_metric) - (k1*v1) * ((k1.tprod.v2) + (v2.tprod.k1)) & -!!! - (k2*v2) * ((k2.tprod.v1) + (v1.tprod.k2))) -end function grav_vv -@ \section{Tensor Couplings} -<>= -public :: t2_vv, v_t2v -@ \section{Scalar-Vector Dim-5 Couplings} -<>= -public :: phi_vv, v_phiv -@ -<>= -pure function phi_vv (g, k1, k2, v1, v2) result (phi) - complex(kind=default), intent(in) :: g - type(momentum), intent(in) :: k1, k2 - type(vector), intent(in) :: v1, v2 - complex(kind=default) :: phi - phi = g * pseudo_scalar (k1, v1, k2, v2) -end function phi_vv -@ -<>= -pure function v_phiv (g, phi, k1, k2, v) result (w) - complex(kind=default), intent(in) :: g, phi - type(vector), intent(in) :: v - type(momentum), intent(in) :: k1, k2 - type(vector) :: w - w = g * phi * pseudo_vector (k1, k2, v) -end function v_phiv -@ -<>= -pure function t2_vv (g, v1, v2) result (t) - complex(kind=default), intent(in) :: g - type(vector), intent(in) :: v1, v2 - type(tensor) :: t - type(tensor) :: tmp - tmp = v1.tprod.v2 - t%t = g * (tmp%t + transpose (tmp%t)) -end function t2_vv -@ -<>= -pure function v_t2v (g, t, v) result (tv) - complex(kind=default), intent(in) :: g - type(tensor), intent(in) :: t - type(vector), intent(in) :: v - type(vector) :: tv - type(tensor) :: tmp - tmp%t = t%t + transpose (t%t) - tv = g * (tmp * v) -end function v_t2v -@ -<>= -public :: t2_vv_d5_1, v_t2v_d5_1 -@ -<>= -pure function t2_vv_d5_1 (g, v1, k1, v2, k2) result (t) - complex(kind=default), intent(in) :: g - type(vector), intent(in) :: v1, v2 - type(momentum), intent(in) :: k1, k2 - type(tensor) :: t - t = (g * (v1 * v2)) * (k1-k2).tprod.(k1-k2) -end function t2_vv_d5_1 -@ -<>= -pure function v_t2v_d5_1 (g, t1, k1, v2, k2) result (tv) - complex(kind=default), intent(in) :: g - type(tensor), intent(in) :: t1 - type(vector), intent(in) :: v2 - type(momentum), intent(in) :: k1, k2 - type(vector) :: tv - tv = (g * ((k1+2*k2).tprod.(k1+2*k2) * t1)) * v2 -end function v_t2v_d5_1 -@ -<>= -public :: t2_vv_d5_2, v_t2v_d5_2 -@ -<>= -pure function t2_vv_d5_2 (g, v1, k1, v2, k2) result (t) - complex(kind=default), intent(in) :: g - type(vector), intent(in) :: v1, v2 - type(momentum), intent(in) :: k1, k2 - type(tensor) :: t - t = (g * (k2 * v1)) * (k2-k1).tprod.v2 - t%t = t%t + transpose (t%t) -end function t2_vv_d5_2 -@ -<>= -pure function v_t2v_d5_2 (g, t1, k1, v2, k2) result (tv) - complex(kind=default), intent(in) :: g - type(tensor), intent(in) :: t1 - type(vector), intent(in) :: v2 - type(momentum), intent(in) :: k1, k2 - type(vector) :: tv - type(tensor) :: tmp - type(momentum) :: k1_k2, k1_2k2 - k1_k2 = k1 + k2 - k1_2k2 = k1_k2 + k2 - tmp%t = t1%t + transpose (t1%t) - tv = (g * (k1_k2 * v2)) * (k1_2k2 * tmp) -end function v_t2v_d5_2 -@ -<>= -public :: t2_vv_d7, v_t2v_d7 -@ -<>= -pure function t2_vv_d7 (g, v1, k1, v2, k2) result (t) - complex(kind=default), intent(in) :: g - type(vector), intent(in) :: v1, v2 - type(momentum), intent(in) :: k1, k2 - type(tensor) :: t - t = (g * (k2 * v1) * (k1 * v2)) * (k1-k2).tprod.(k1-k2) -end function t2_vv_d7 -@ -<>= -pure function v_t2v_d7 (g, t1, k1, v2, k2) result (tv) - complex(kind=default), intent(in) :: g - type(tensor), intent(in) :: t1 - type(vector), intent(in) :: v2 - type(momentum), intent(in) :: k1, k2 - type(vector) :: tv - type(vector) :: k1_k2, k1_2k2 - k1_k2 = k1 + k2 - k1_2k2 = k1_k2 + k2 - tv = (- g * (k1_k2 * v2) * (k1_2k2.tprod.k1_2k2 * t1)) * k2 -end function v_t2v_d7 -@ \section{Spinor Couplings} -<<[[omega_spinor_couplings.f95]]>>= -<> -module omega_spinor_couplings - use kinds - use omega_constants - use omega_spinors - use omega_vectors - use omega_tensors - use omega_couplings - implicit none - private - <> - <> - <> - <> - integer, parameter, public :: omega_spinor_cpls_2003_03_A = 0 -contains - <> - <> - <> - <> -end module omega_spinor_couplings -@ -See table~\ref{tab:fermionic-currents} for the names of Fortran -functions. We could have used long names instead, but this would -increase the chance of running past continuation line limits without -adding much to the legibility. -@ -\subsection{Fermionic Vector and Axial Couplings} -There's more than one chiral representation. This one is compatible -with HELAS~\cite{HELAS}. -\begin{equation} - \gamma^0 = \begin{pmatrix} 0 & \mathbf{1} \\ \mathbf{1} & 0 \end{pmatrix},\; - \gamma^i = \begin{pmatrix} 0 & \sigma^i \\ -\sigma^i & 0 \end{pmatrix},\; - \gamma_5 = i\gamma^0\gamma^1\gamma^2\gamma^3 - = \begin{pmatrix} -\mathbf{1} & 0 \\ 0 & \mathbf{1} \end{pmatrix} -\end{equation} -Therefore -\begin{subequations} -\begin{align} - g_S + g_P\gamma_5 &= - \begin{pmatrix} - g_S - g_P & 0 & 0 & 0 \\ - 0 & g_S - g_P & 0 & 0 \\ - 0 & 0 & g_S + g_P & 0 \\ - 0 & 0 & 0 & g_S + g_P - \end{pmatrix} \\ - g_V\gamma^0 - g_A\gamma^0\gamma_5 &= - \begin{pmatrix} - 0 & 0 & g_V - g_A & 0 \\ - 0 & 0 & 0 & g_V - g_A \\ - g_V + g_A & 0 & 0 & 0 \\ - 0 & g_V + g_A & 0 & 0 - \end{pmatrix} \\ - g_V\gamma^1 - g_A\gamma^1\gamma_5 &= - \begin{pmatrix} - 0 & 0 & 0 & g_V - g_A \\ - 0 & 0 & g_V - g_A & 0 \\ - 0 & - g_V - g_A & 0 & 0 \\ - - g_V - g_A & 0 & 0 & 0 - \end{pmatrix} \\ - g_V\gamma^2 - g_A\gamma^2\gamma_5 &= - \begin{pmatrix} - 0 & 0 & 0 & -\ii(g_V - g_A) \\ - 0 & 0 & \ii(g_V - g_A) & 0 \\ - 0 & \ii(g_V + g_A) & 0 & 0 \\ - -\ii(g_V + g_A) & 0 & 0 & 0 - \end{pmatrix} \\ - g_V\gamma^3 - g_A\gamma^3\gamma_5 &= - \begin{pmatrix} - 0 & 0 & g_V - g_A & 0 \\ - 0 & 0 & 0 & - g_V + g_A \\ - - g_V - g_A & 0 & 0 & 0 \\ - 0 & g_V + g_A & 0 & 0 - \end{pmatrix} -\end{align} -\end{subequations} -\begin{table} - \begin{center} - \begin{tabular}{>{$}l<{$}|>{$}l<{$}} - \bar\psi(g_V\gamma^\mu - g_A\gamma^\mu\gamma_5)\psi - & \text{\texttt{va\_ff}}(g_V,g_A,\bar\psi,\psi) \\ - g_V\bar\psi\gamma^\mu\psi - & \text{\texttt{v\_ff}}(g_V,\bar\psi,\psi) \\ - g_A\bar\psi\gamma_5\gamma^\mu\psi - & \text{\texttt{a\_ff}}(g_A,\bar\psi,\psi) \\ - g_L\bar\psi\gamma^\mu(1-\gamma_5)\psi - & \text{\texttt{vl\_ff}}(g_L,\bar\psi,\psi) \\ - g_R\bar\psi\gamma^\mu(1+\gamma_5)\psi - & \text{\texttt{vr\_ff}}(g_R,\bar\psi,\psi) \\\hline - \fmslash{V}(g_V - g_A\gamma_5)\psi - & \text{\texttt{f\_vaf}}(g_V,g_A,V,\psi) \\ - g_V\fmslash{V}\psi - & \text{\texttt{f\_vf}}(g_V,V,\psi) \\ - g_A\gamma_5\fmslash{V}\psi - & \text{\texttt{f\_af}}(g_A,V,\psi) \\ - g_L\fmslash{V}(1-\gamma_5)\psi - & \text{\texttt{f\_vlf}}(g_L,V,\psi) \\ - g_R\fmslash{V}(1+\gamma_5)\psi - & \text{\texttt{f\_vrf}}(g_R,V,\psi) \\\hline - \bar\psi\fmslash{V}(g_V - g_A\gamma_5) - & \text{\texttt{f\_fva}}(g_V,g_A,\bar\psi,V) \\ - g_V\bar\psi\fmslash{V} - & \text{\texttt{f\_fv}}(g_V,\bar\psi,V) \\ - g_A\bar\psi\gamma_5\fmslash{V} - & \text{\texttt{f\_fa}}(g_A,\bar\psi,V) \\ - g_L\bar\psi\fmslash{V}(1-\gamma_5) - & \text{\texttt{f\_fvl}}(g_L,\bar\psi,V) \\ - g_R\bar\psi\fmslash{V}(1+\gamma_5) - & \text{\texttt{f\_fvr}}(g_R,\bar\psi,V) - \end{tabular} - \end{center} - \caption{\label{tab:fermionic-currents} - Mnemonically abbreviated names of Fortran functions implementing - fermionic vector and axial currents.} -\end{table} -\begin{table} - \begin{center} - \begin{tabular}{>{$}l<{$}|>{$}l<{$}} - \bar\psi(g_S + g_P\gamma_5)\psi - & \text{\texttt{sp\_ff}}(g_S,g_P,\bar\psi,\psi) \\ - g_S\bar\psi\psi - & \text{\texttt{s\_ff}}(g_S,\bar\psi,\psi) \\ - g_P\bar\psi\gamma_5\psi - & \text{\texttt{p\_ff}}(g_P,\bar\psi,\psi) \\ - g_L\bar\psi(1-\gamma_5)\psi - & \text{\texttt{sl\_ff}}(g_L,\bar\psi,\psi) \\ - g_R\bar\psi(1+\gamma_5)\psi - & \text{\texttt{sr\_ff}}(g_R,\bar\psi,\psi) \\\hline - \phi(g_S + g_P\gamma_5)\psi - & \text{\texttt{f\_spf}}(g_S,g_P,\phi,\psi) \\ - g_S\phi\psi - & \text{\texttt{f\_sf}}(g_S,\phi,\psi) \\ - g_P\phi\gamma_5\psi - & \text{\texttt{f\_pf}}(g_P,\phi,\psi) \\ - g_L\phi(1-\gamma_5)\psi - & \text{\texttt{f\_slf}}(g_L,\phi,\psi) \\ - g_R\phi(1+\gamma_5)\psi - & \text{\texttt{f\_srf}}(g_R,\phi,\psi) \\\hline - \bar\psi\phi(g_S + g_P\gamma_5) - & \text{\texttt{f\_fsp}}(g_S,g_P,\bar\psi,\phi) \\ - g_S\bar\psi\phi - & \text{\texttt{f\_fs}}(g_S,\bar\psi,\phi) \\ - g_P\bar\psi\phi\gamma_5 - & \text{\texttt{f\_fp}}(g_P,\bar\psi,\phi) \\ - g_L\bar\psi\phi(1-\gamma_5) - & \text{\texttt{f\_fsl}}(g_L,\bar\psi,\phi) \\ - g_R\bar\psi\phi(1+\gamma_5) - & \text{\texttt{f\_fsr}}(g_R,\bar\psi,\phi) - \end{tabular} - \end{center} - \caption{\label{tab:fermionic-scalar currents} - Mnemonically abbreviated names of Fortran functions implementing - fermionic scalar and pseudo scalar ``currents''.} -\end{table} -<>= -public :: va_ff, v_ff, a_ff, vl_ff, vr_ff, vlr_ff, grav_ff -@ -<>= -pure function va_ff (gv, ga, psibar, psi) result (j) - type(vector) :: j - complex(kind=default), intent(in) :: gv, ga - type(conjspinor), intent(in) :: psibar - type(spinor), intent(in) :: psi - complex(kind=default) :: gl, gr - complex(kind=default) :: g13, g14, g23, g24, g31, g32, g41, g42 - gl = gv + ga - gr = gv - ga - g13 = psibar%a(1)*psi%a(3) - g14 = psibar%a(1)*psi%a(4) - g23 = psibar%a(2)*psi%a(3) - g24 = psibar%a(2)*psi%a(4) - g31 = psibar%a(3)*psi%a(1) - g32 = psibar%a(3)*psi%a(2) - g41 = psibar%a(4)*psi%a(1) - g42 = psibar%a(4)*psi%a(2) - j%t = gr * ( g13 + g24) + gl * ( g31 + g42) - j%x(1) = gr * ( g14 + g23) - gl * ( g32 + g41) - j%x(2) = (gr * ( - g14 + g23) + gl * ( g32 - g41)) * (0, 1) - j%x(3) = gr * ( g13 - g24) + gl * ( - g31 + g42) -end function va_ff -@ -<>= - subroutine o7vaff (acc, gv, ga, pb, p) - implicit none - double complex acc(0:3), pb(4), p(4) - double precision gv, ga - double precision gl, gr - double complex g13, g14, g23, g24, g31, g32, g41, g42 - gl = gv + ga - gr = gv - ga - g13 = pb(1)*p(3) - g14 = pb(1)*p(4) - g23 = pb(2)*p(3) - g24 = pb(2)*p(4) - g31 = pb(3)*p(1) - g32 = pb(3)*p(2) - g41 = pb(4)*p(1) - g42 = pb(4)*p(2) - acc(0) = acc(0) + gr*( g13+g24) + gl*( g31+g42) - acc(1) = acc(1) + gr*( g14+g23) - gl*( g32+g41) - acc(2) = acc(2) + (gr*(-g14+g23) + gl*( g32-g41)) * (0,1) - acc(3) = acc(3) + gr*( g13-g24) + gl*(-g31+g42) - end -@ Special cases that avoid some multiplications -<>= -pure function v_ff (gv, psibar, psi) result (j) - type(vector) :: j - complex(kind=default), intent(in) :: gv - type(conjspinor), intent(in) :: psibar - type(spinor), intent(in) :: psi - complex(kind=default) :: g13, g14, g23, g24, g31, g32, g41, g42 - g13 = psibar%a(1)*psi%a(3) - g14 = psibar%a(1)*psi%a(4) - g23 = psibar%a(2)*psi%a(3) - g24 = psibar%a(2)*psi%a(4) - g31 = psibar%a(3)*psi%a(1) - g32 = psibar%a(3)*psi%a(2) - g41 = psibar%a(4)*psi%a(1) - g42 = psibar%a(4)*psi%a(2) - j%t = gv * ( g13 + g24 + g31 + g42) - j%x(1) = gv * ( g14 + g23 - g32 - g41) - j%x(2) = gv * ( - g14 + g23 + g32 - g41) * (0, 1) - j%x(3) = gv * ( g13 - g24 - g31 + g42) -end function v_ff -@ -<>= -pure function a_ff (ga, psibar, psi) result (j) - type(vector) :: j - complex(kind=default), intent(in) :: ga - type(conjspinor), intent(in) :: psibar - type(spinor), intent(in) :: psi - complex(kind=default) :: g13, g14, g23, g24, g31, g32, g41, g42 - g13 = psibar%a(1)*psi%a(3) - g14 = psibar%a(1)*psi%a(4) - g23 = psibar%a(2)*psi%a(3) - g24 = psibar%a(2)*psi%a(4) - g31 = psibar%a(3)*psi%a(1) - g32 = psibar%a(3)*psi%a(2) - g41 = psibar%a(4)*psi%a(1) - g42 = psibar%a(4)*psi%a(2) - j%t = ga * ( - g13 - g24 + g31 + g42) - j%x(1) = - ga * ( g14 + g23 + g32 + g41) - j%x(2) = ga * ( g14 - g23 + g32 - g41) * (0, 1) - j%x(3) = ga * ( - g13 + g24 - g31 + g42) -end function a_ff -@ -<>= -pure function vl_ff (gl, psibar, psi) result (j) - type(vector) :: j - complex(kind=default), intent(in) :: gl - type(conjspinor), intent(in) :: psibar - type(spinor), intent(in) :: psi - complex(kind=default) :: gl2 - complex(kind=default) :: g31, g32, g41, g42 - gl2 = 2 * gl - g31 = psibar%a(3)*psi%a(1) - g32 = psibar%a(3)*psi%a(2) - g41 = psibar%a(4)*psi%a(1) - g42 = psibar%a(4)*psi%a(2) - j%t = gl2 * ( g31 + g42) - j%x(1) = - gl2 * ( g32 + g41) - j%x(2) = gl2 * ( g32 - g41) * (0, 1) - j%x(3) = gl2 * ( - g31 + g42) -end function vl_ff -@ -<>= -pure function vr_ff (gr, psibar, psi) result (j) - type(vector) :: j - complex(kind=default), intent(in) :: gr - type(conjspinor), intent(in) :: psibar - type(spinor), intent(in) :: psi - complex(kind=default) :: gr2 - complex(kind=default) :: g13, g14, g23, g24 - gr2 = 2 * gr - g13 = psibar%a(1)*psi%a(3) - g14 = psibar%a(1)*psi%a(4) - g23 = psibar%a(2)*psi%a(3) - g24 = psibar%a(2)*psi%a(4) - j%t = gr2 * ( g13 + g24) - j%x(1) = gr2 * ( g14 + g23) - j%x(2) = gr2 * ( - g14 + g23) * (0, 1) - j%x(3) = gr2 * ( g13 - g24) -end function vr_ff -@ -<>= -pure function grav_ff (g, m, kb, k, psibar, psi) result (j) - type(tensor) :: j - complex(kind=default), intent(in) :: g - real(kind=default), intent(in) :: m - type(conjspinor), intent(in) :: psibar - type(spinor), intent(in) :: psi - type(momentum), intent(in) :: kb, k - complex(kind=default) :: g2, g8, c_dum - type(vector) :: v_dum - type(tensor) :: t_metric - t_metric%t = 0 - t_metric%t(0,0) = 1.0_default - t_metric%t(1,1) = - 1.0_default - t_metric%t(2,2) = - 1.0_default - t_metric%t(3,3) = - 1.0_default - g2 = g/2.0_default - g8 = g/8.0_default - v_dum = v_ff(g8, psibar, psi) - c_dum = (- m) * s_ff (g2, psibar, psi) - (kb+k)*v_dum - j = c_dum*t_metric - (((kb+k).tprod.v_dum) + & - (v_dum.tprod.(kb+k))) -end function grav_ff -@ -\begin{equation} - g_L\gamma_\mu(1-\gamma_5) + g_R\gamma_\mu(1+\gamma_5) - = (g_L+g_R)\gamma_\mu - (g_L-g_R)\gamma_\mu\gamma_5 - = g_V\gamma_\mu - g_A\gamma_\mu\gamma_5 -\end{equation} -\ldots{} give the compiler the benefit of the doubt that it will -optimize the function all. If not, we could inline it \ldots -<>= -pure function vlr_ff (gl, gr, psibar, psi) result (j) - type(vector) :: j - complex(kind=default), intent(in) :: gl, gr - type(conjspinor), intent(in) :: psibar - type(spinor), intent(in) :: psi - j = va_ff (gl+gr, gl-gr, psibar, psi) -end function vlr_ff -@ -and -\begin{equation} - \fmslash{v} - \fmslash{a}\gamma_5 = - \begin{pmatrix} - 0 & 0 & v_- - a_- & - v^* + a^* \\ - 0 & 0 & - v + a & v_+ - a_+ \\ - v_+ + a_+ & v^* + a^* & 0 & 0 \\ - v + a & v_- + a_- & 0 & 0 - \end{pmatrix} -\end{equation} -with $v_\pm=v_0\pm v_3$, $a_\pm=a_0\pm a_3$, $v=v_1+\ii v_2$, -$v^*=v_1-\ii v_2$, $a=a_1+\ii a_2$, and $a^*=a_1-\ii a_2$. But note -that~$\cdot^*$ is \emph{not} complex conjugation for complex~$v_\mu$ -or~$a_\mu$. -<>= -public :: f_vaf, f_vf, f_af, f_vlf, f_vrf, f_vlrf -@ -<>= -pure function f_vaf (gv, ga, v, psi) result (vpsi) - type(spinor) :: vpsi - complex(kind=default), intent(in) :: gv, ga - type(vector), intent(in) :: v - type(spinor), intent(in) :: psi - complex(kind=default) :: gl, gr - complex(kind=default) :: vp, vm, v12, v12s - gl = gv + ga - gr = gv - ga - vp = v%t + v%x(3) - vm = v%t - v%x(3) - v12 = v%x(1) + (0,1)*v%x(2) - v12s = v%x(1) - (0,1)*v%x(2) - vpsi%a(1) = gr * ( vm * psi%a(3) - v12s * psi%a(4)) - vpsi%a(2) = gr * ( - v12 * psi%a(3) + vp * psi%a(4)) - vpsi%a(3) = gl * ( vp * psi%a(1) + v12s * psi%a(2)) - vpsi%a(4) = gl * ( v12 * psi%a(1) + vm * psi%a(2)) -end function f_vaf -@ -<>= -pure function f_vf (gv, v, psi) result (vpsi) - type(spinor) :: vpsi - complex(kind=default), intent(in) :: gv - type(vector), intent(in) :: v - type(spinor), intent(in) :: psi - complex(kind=default) :: vp, vm, v12, v12s - vp = v%t + v%x(3) - vm = v%t - v%x(3) - v12 = v%x(1) + (0,1)*v%x(2) - v12s = v%x(1) - (0,1)*v%x(2) - vpsi%a(1) = gv * ( vm * psi%a(3) - v12s * psi%a(4)) - vpsi%a(2) = gv * ( - v12 * psi%a(3) + vp * psi%a(4)) - vpsi%a(3) = gv * ( vp * psi%a(1) + v12s * psi%a(2)) - vpsi%a(4) = gv * ( v12 * psi%a(1) + vm * psi%a(2)) -end function f_vf -@ -<>= -pure function f_af (ga, v, psi) result (vpsi) - type(spinor) :: vpsi - complex(kind=default), intent(in) :: ga - type(vector), intent(in) :: v - type(spinor), intent(in) :: psi - complex(kind=default) :: vp, vm, v12, v12s - vp = v%t + v%x(3) - vm = v%t - v%x(3) - v12 = v%x(1) + (0,1)*v%x(2) - v12s = v%x(1) - (0,1)*v%x(2) - vpsi%a(1) = ga * ( - vm * psi%a(3) + v12s * psi%a(4)) - vpsi%a(2) = ga * ( v12 * psi%a(3) - vp * psi%a(4)) - vpsi%a(3) = ga * ( vp * psi%a(1) + v12s * psi%a(2)) - vpsi%a(4) = ga * ( v12 * psi%a(1) + vm * psi%a(2)) -end function f_af -@ -<>= -pure function f_vlf (gl, v, psi) result (vpsi) - type(spinor) :: vpsi - complex(kind=default), intent(in) :: gl - type(vector), intent(in) :: v - type(spinor), intent(in) :: psi - complex(kind=default) :: gl2 - complex(kind=default) :: vp, vm, v12, v12s - gl2 = 2 * gl - vp = v%t + v%x(3) - vm = v%t - v%x(3) - v12 = v%x(1) + (0,1)*v%x(2) - v12s = v%x(1) - (0,1)*v%x(2) - vpsi%a(1) = 0 - vpsi%a(2) = 0 - vpsi%a(3) = gl2 * ( vp * psi%a(1) + v12s * psi%a(2)) - vpsi%a(4) = gl2 * ( v12 * psi%a(1) + vm * psi%a(2)) -end function f_vlf -@ -<>= -pure function f_vrf (gr, v, psi) result (vpsi) - type(spinor) :: vpsi - complex(kind=default), intent(in) :: gr - type(vector), intent(in) :: v - type(spinor), intent(in) :: psi - complex(kind=default) :: gr2 - complex(kind=default) :: vp, vm, v12, v12s - gr2 = 2 * gr - vp = v%t + v%x(3) - vm = v%t - v%x(3) - v12 = v%x(1) + (0,1)*v%x(2) - v12s = v%x(1) - (0,1)*v%x(2) - vpsi%a(1) = gr2 * ( vm * psi%a(3) - v12s * psi%a(4)) - vpsi%a(2) = gr2 * ( - v12 * psi%a(3) + vp * psi%a(4)) - vpsi%a(3) = 0 - vpsi%a(4) = 0 -end function f_vrf -@ -<>= -pure function f_vlrf (gl, gr, v, psi) result (vpsi) - type(spinor) :: vpsi - complex(kind=default), intent(in) :: gl, gr - type(vector), intent(in) :: v - type(spinor), intent(in) :: psi - vpsi = f_vaf (gl+gr, gl-gr, v, psi) -end function f_vlrf -@ -<>= -public :: f_fva, f_fv, f_fa, f_fvl, f_fvr, f_fvlr -@ -<>= -pure function f_fva (gv, ga, psibar, v) result (psibarv) - type(conjspinor) :: psibarv - complex(kind=default), intent(in) :: gv, ga - type(conjspinor), intent(in) :: psibar - type(vector), intent(in) :: v - complex(kind=default) :: gl, gr - complex(kind=default) :: vp, vm, v12, v12s - gl = gv + ga - gr = gv - ga - vp = v%t + v%x(3) - vm = v%t - v%x(3) - v12 = v%x(1) + (0,1)*v%x(2) - v12s = v%x(1) - (0,1)*v%x(2) - psibarv%a(1) = gl * ( psibar%a(3) * vp + psibar%a(4) * v12) - psibarv%a(2) = gl * ( psibar%a(3) * v12s + psibar%a(4) * vm ) - psibarv%a(3) = gr * ( psibar%a(1) * vm - psibar%a(2) * v12) - psibarv%a(4) = gr * ( - psibar%a(1) * v12s + psibar%a(2) * vp ) -end function f_fva -@ -<>= -pure function f_fv (gv, psibar, v) result (psibarv) - type(conjspinor) :: psibarv - complex(kind=default), intent(in) :: gv - type(conjspinor), intent(in) :: psibar - type(vector), intent(in) :: v - complex(kind=default) :: vp, vm, v12, v12s - vp = v%t + v%x(3) - vm = v%t - v%x(3) - v12 = v%x(1) + (0,1)*v%x(2) - v12s = v%x(1) - (0,1)*v%x(2) - psibarv%a(1) = gv * ( psibar%a(3) * vp + psibar%a(4) * v12) - psibarv%a(2) = gv * ( psibar%a(3) * v12s + psibar%a(4) * vm ) - psibarv%a(3) = gv * ( psibar%a(1) * vm - psibar%a(2) * v12) - psibarv%a(4) = gv * ( - psibar%a(1) * v12s + psibar%a(2) * vp ) -end function f_fv -@ -<>= -pure function f_fa (ga, psibar, v) result (psibarv) - type(conjspinor) :: psibarv - complex(kind=default), intent(in) :: ga - type(vector), intent(in) :: v - type(conjspinor), intent(in) :: psibar - complex(kind=default) :: vp, vm, v12, v12s - vp = v%t + v%x(3) - vm = v%t - v%x(3) - v12 = v%x(1) + (0,1)*v%x(2) - v12s = v%x(1) - (0,1)*v%x(2) - psibarv%a(1) = ga * ( psibar%a(3) * vp + psibar%a(4) * v12) - psibarv%a(2) = ga * ( psibar%a(3) * v12s + psibar%a(4) * vm ) - psibarv%a(3) = ga * ( - psibar%a(1) * vm + psibar%a(2) * v12) - psibarv%a(4) = ga * ( psibar%a(1) * v12s - psibar%a(2) * vp ) -end function f_fa -@ -<>= -pure function f_fvl (gl, psibar, v) result (psibarv) - type(conjspinor) :: psibarv - complex(kind=default), intent(in) :: gl - type(conjspinor), intent(in) :: psibar - type(vector), intent(in) :: v - complex(kind=default) :: gl2 - complex(kind=default) :: vp, vm, v12, v12s - gl2 = 2 * gl - vp = v%t + v%x(3) - vm = v%t - v%x(3) - v12 = v%x(1) + (0,1)*v%x(2) - v12s = v%x(1) - (0,1)*v%x(2) - psibarv%a(1) = gl2 * ( psibar%a(3) * vp + psibar%a(4) * v12) - psibarv%a(2) = gl2 * ( psibar%a(3) * v12s + psibar%a(4) * vm ) - psibarv%a(3) = 0 - psibarv%a(4) = 0 -end function f_fvl -@ -<>= -pure function f_fvr (gr, psibar, v) result (psibarv) - type(conjspinor) :: psibarv - complex(kind=default), intent(in) :: gr - type(conjspinor), intent(in) :: psibar - type(vector), intent(in) :: v - complex(kind=default) :: gr2 - complex(kind=default) :: vp, vm, v12, v12s - gr2 = 2 * gr - vp = v%t + v%x(3) - vm = v%t - v%x(3) - v12 = v%x(1) + (0,1)*v%x(2) - v12s = v%x(1) - (0,1)*v%x(2) - psibarv%a(1) = 0 - psibarv%a(2) = 0 - psibarv%a(3) = gr2 * ( psibar%a(1) * vm - psibar%a(2) * v12) - psibarv%a(4) = gr2 * ( - psibar%a(1) * v12s + psibar%a(2) * vp ) -end function f_fvr -@ -<>= -pure function f_fvlr (gl, gr, psibar, v) result (psibarv) - type(conjspinor) :: psibarv - complex(kind=default), intent(in) :: gl, gr - type(conjspinor), intent(in) :: psibar - type(vector), intent(in) :: v - psibarv = f_fva (gl+gr, gl-gr, psibar, v) -end function f_fvlr -@ \subsection{Fermionic Scalar and Pseudo Scalar Couplings} -<>= -public :: sp_ff, s_ff, p_ff, sl_ff, sr_ff, slr_ff -@ -<>= -pure function sp_ff (gs, gp, psibar, psi) result (j) - complex(kind=default) :: j - complex(kind=default), intent(in) :: gs, gp - type(conjspinor), intent(in) :: psibar - type(spinor), intent(in) :: psi - j = (gs - gp) * (psibar%a(1)*psi%a(1) + psibar%a(2)*psi%a(2)) & - + (gs + gp) * (psibar%a(3)*psi%a(3) + psibar%a(4)*psi%a(4)) -end function sp_ff -@ -<>= -pure function s_ff (gs, psibar, psi) result (j) - complex(kind=default) :: j - complex(kind=default), intent(in) :: gs - type(conjspinor), intent(in) :: psibar - type(spinor), intent(in) :: psi - j = gs * (psibar * psi) -end function s_ff -@ -<>= -pure function p_ff (gp, psibar, psi) result (j) - complex(kind=default) :: j - complex(kind=default), intent(in) :: gp - type(conjspinor), intent(in) :: psibar - type(spinor), intent(in) :: psi - j = gp * ( psibar%a(3)*psi%a(3) + psibar%a(4)*psi%a(4) & - - psibar%a(1)*psi%a(1) - psibar%a(2)*psi%a(2)) -end function p_ff -@ -<>= -pure function sl_ff (gl, psibar, psi) result (j) - complex(kind=default) :: j - complex(kind=default), intent(in) :: gl - type(conjspinor), intent(in) :: psibar - type(spinor), intent(in) :: psi - j = 2 * gl * (psibar%a(1)*psi%a(1) + psibar%a(2)*psi%a(2)) -end function sl_ff -@ -<>= -pure function sr_ff (gr, psibar, psi) result (j) - complex(kind=default) :: j - complex(kind=default), intent(in) :: gr - type(conjspinor), intent(in) :: psibar - type(spinor), intent(in) :: psi - j = 2 * gr * (psibar%a(3)*psi%a(3) + psibar%a(4)*psi%a(4)) -end function sr_ff -@ -\begin{equation} - g_L(1-\gamma_5) + g_R(1+\gamma_5) - = (g_R+g_L) + (g_R-g_L)\gamma_5 - = g_S + g_P\gamma_5 -\end{equation} -<>= -pure function slr_ff (gl, gr, psibar, psi) result (j) - complex(kind=default) :: j - complex(kind=default), intent(in) :: gl, gr - type(conjspinor), intent(in) :: psibar - type(spinor), intent(in) :: psi - j = sp_ff (gr+gl, gr-gl, psibar, psi) -end function slr_ff -@ -<>= -public :: f_spf, f_sf, f_pf, f_slf, f_srf, f_slrf -@ -<>= -pure function f_spf (gs, gp, phi, psi) result (phipsi) - type(spinor) :: phipsi - complex(kind=default), intent(in) :: gs, gp - complex(kind=default), intent(in) :: phi - type(spinor), intent(in) :: psi - phipsi%a(1:2) = ((gs - gp) * phi) * psi%a(1:2) - phipsi%a(3:4) = ((gs + gp) * phi) * psi%a(3:4) -end function f_spf -@ -<>= -pure function f_sf (gs, phi, psi) result (phipsi) - type(spinor) :: phipsi - complex(kind=default), intent(in) :: gs - complex(kind=default), intent(in) :: phi - type(spinor), intent(in) :: psi - phipsi%a = (gs * phi) * psi%a -end function f_sf -@ -<>= -pure function f_pf (gp, phi, psi) result (phipsi) - type(spinor) :: phipsi - complex(kind=default), intent(in) :: gp - complex(kind=default), intent(in) :: phi - type(spinor), intent(in) :: psi - phipsi%a(1:2) = (- gp * phi) * psi%a(1:2) - phipsi%a(3:4) = ( gp * phi) * psi%a(3:4) -end function f_pf -@ -<>= -pure function f_slf (gl, phi, psi) result (phipsi) - type(spinor) :: phipsi - complex(kind=default), intent(in) :: gl - complex(kind=default), intent(in) :: phi - type(spinor), intent(in) :: psi - phipsi%a(1:2) = (2 * gl * phi) * psi%a(1:2) - phipsi%a(3:4) = 0 -end function f_slf -@ -<>= -pure function f_srf (gr, phi, psi) result (phipsi) - type(spinor) :: phipsi - complex(kind=default), intent(in) :: gr - complex(kind=default), intent(in) :: phi - type(spinor), intent(in) :: psi - phipsi%a(1:2) = 0 - phipsi%a(3:4) = (2 * gr * phi) * psi%a(3:4) -end function f_srf -@ -<>= -pure function f_slrf (gl, gr, phi, psi) result (phipsi) - type(spinor) :: phipsi - complex(kind=default), intent(in) :: gl, gr - complex(kind=default), intent(in) :: phi - type(spinor), intent(in) :: psi - phipsi = f_spf (gr+gl, gr-gl, phi, psi) -end function f_slrf -@ -<>= -public :: f_fsp, f_fs, f_fp, f_fsl, f_fsr, f_fslr -@ -<>= -pure function f_fsp (gs, gp, psibar, phi) result (psibarphi) - type(conjspinor) :: psibarphi - complex(kind=default), intent(in) :: gs, gp - type(conjspinor), intent(in) :: psibar - complex(kind=default), intent(in) :: phi - psibarphi%a(1:2) = ((gs - gp) * phi) * psibar%a(1:2) - psibarphi%a(3:4) = ((gs + gp) * phi) * psibar%a(3:4) -end function f_fsp -@ -<>= -pure function f_fs (gs, psibar, phi) result (psibarphi) - type(conjspinor) :: psibarphi - complex(kind=default), intent(in) :: gs - type(conjspinor), intent(in) :: psibar - complex(kind=default), intent(in) :: phi - psibarphi%a = (gs * phi) * psibar%a -end function f_fs -@ -<>= -pure function f_fp (gp, psibar, phi) result (psibarphi) - type(conjspinor) :: psibarphi - complex(kind=default), intent(in) :: gp - type(conjspinor), intent(in) :: psibar - complex(kind=default), intent(in) :: phi - psibarphi%a(1:2) = (- gp * phi) * psibar%a(1:2) - psibarphi%a(3:4) = ( gp * phi) * psibar%a(3:4) -end function f_fp -@ -<>= -pure function f_fsl (gl, psibar, phi) result (psibarphi) - type(conjspinor) :: psibarphi - complex(kind=default), intent(in) :: gl - type(conjspinor), intent(in) :: psibar - complex(kind=default), intent(in) :: phi - psibarphi%a(1:2) = (2 * gl * phi) * psibar%a(1:2) - psibarphi%a(3:4) = 0 -end function f_fsl -@ -<>= -pure function f_fsr (gr, psibar, phi) result (psibarphi) - type(conjspinor) :: psibarphi - complex(kind=default), intent(in) :: gr - type(conjspinor), intent(in) :: psibar - complex(kind=default), intent(in) :: phi - psibarphi%a(1:2) = 0 - psibarphi%a(3:4) = (2 * gr * phi) * psibar%a(3:4) -end function f_fsr -@ -<>= -pure function f_fslr (gl, gr, psibar, phi) result (psibarphi) - type(conjspinor) :: psibarphi - complex(kind=default), intent(in) :: gl, gr - type(conjspinor), intent(in) :: psibar - complex(kind=default), intent(in) :: phi - psibarphi = f_fsp (gr+gl, gr-gl, psibar, phi) -end function f_fslr -<>= -public :: f_gravf, f_fgrav -@ -<>= -pure function f_gravf (g, m, kb, k, t, psi) result (tpsi) - type(spinor) :: tpsi - complex(kind=default), intent(in) :: g - real(kind=default), intent(in) :: m - type(spinor), intent(in) :: psi - type(tensor), intent(in) :: t - type(momentum), intent(in) :: kb, k - complex(kind=default) :: g2, g8, t_tr - type(vector) :: kkb - kkb = k + kb - g2 = g / 2.0_default - g8 = g / 8.0_default - t_tr = t%t(0,0) - t%t(1,1) - t%t(2,2) - t%t(3,3) - tpsi = (- f_sf (g2, cmplx (m,0.0, kind=default), psi) & - - f_vf ((g8*m), kkb, psi)) * t_tr - & - f_vf (g8,(t*kkb + kkb*t),psi) -end function f_gravf -@ -<>= -pure function f_fgrav (g, m, kb, k, psibar, t) result (psibart) - type(conjspinor) :: psibart - complex(kind=default), intent(in) :: g - real(kind=default), intent(in) :: m - type(conjspinor), intent(in) :: psibar - type(tensor), intent(in) :: t - type(momentum), intent(in) :: kb, k - type(vector) :: kkb - complex(kind=default) :: g2, g8, t_tr - kkb = k + kb - g2 = g / 2.0_default - g8 = g / 8.0_default - t_tr = t%t(0,0) - t%t(1,1) - t%t(2,2) - t%t(3,3) - psibart = (- f_fs (g2, psibar, cmplx (m, 0.0, kind=default)) & - - f_fv ((g8 * m), psibar, kkb)) * t_tr - & - f_fv (g8,psibar,(t*kkb + kkb*t)) -end function f_fgrav -@ \subsection{On Shell Wave Functions} -<>= -public :: u, ubar, v, vbar -private :: chi_plus, chi_minus -@ -\begin{subequations} -\begin{align} - \chi_+(\vec p) &= - \frac{1}{\sqrt{2|\vec p|(|\vec p|+p_3)}} - \begin{pmatrix} |\vec p|+p_3 \\ p_1 + \ii p_2 \end{pmatrix} \\ - \chi_-(\vec p) &= - \frac{1}{\sqrt{2|\vec p|(|\vec p|+p_3)}} - \begin{pmatrix} - p_1 + \ii p_2 \\ |\vec p|+p_3 \end{pmatrix} -\end{align} -\end{subequations} -<>= -pure function chi_plus (p) result (chi) - complex(kind=default), dimension(2) :: chi - type(momentum), intent(in) :: p - real(kind=default) :: pabs - pabs = sqrt (dot_product (p%x, p%x)) - if (pabs + p%x(3) <= 1000 * epsilon (pabs) * pabs) then -!!! OLD VERSION !!!!!! -!!! if (1 + p%x(3) / pabs <= epsilon (pabs)) then -!!!!!!!!!!!!!!!!!!!!!! - chi = (/ cmplx ( 0.0, 0.0, kind=default), & - cmplx ( 1.0, 0.0, kind=default) /) - else - chi = 1 / sqrt (2*pabs*(pabs + p%x(3))) & - * (/ cmplx (pabs + p%x(3), kind=default), & - cmplx (p%x(1), p%x(2), kind=default) /) - end if -end function chi_plus -@ -<>= -pure function chi_minus (p) result (chi) - complex(kind=default), dimension(2) :: chi - type(momentum), intent(in) :: p - real(kind=default) :: pabs - pabs = sqrt (dot_product (p%x, p%x)) - if (pabs + p%x(3) <= 1000 * epsilon (pabs) * pabs) then -!!! OLD VERSION !!!!!!!!!!! -!!! if (1 + p%x(3) / pabs <= epsilon (pabs)) then -!!!!!!!!!!!!!!!!!!!!!!!!!!! - chi = (/ cmplx (-1.0, 0.0, kind=default), & - cmplx ( 0.0, 0.0, kind=default) /) - else - chi = 1 / sqrt (2*pabs*(pabs + p%x(3))) & - * (/ cmplx (-p%x(1), p%x(2), kind=default), & - cmplx (pabs + p%x(3), kind=default) /) - end if -end function chi_minus -@ -\begin{equation} - u_\pm(p) = - \begin{pmatrix} - \sqrt{p_0\mp|\vec p|} \cdot \chi_\pm(\vec p) \\ - \sqrt{p_0\pm|\vec p|} \cdot \chi_\pm(\vec p) - \end{pmatrix} -\end{equation} -Determining the mass from the momenta is a numerically haphazardous for -light particles. Therefore, we accept some redundancy and pass the -mass explicitely. Even if the mass is not used in the chiral -representation, we do so for symmetry with polarization vectors and to -be prepared for other representations. -<>= -pure function u (m, p, s) result (psi) - type(spinor) :: psi - real(kind=default), intent(in) :: m - type(momentum), intent(in) :: p - integer, intent(in) :: s - complex(kind=default), dimension(2) :: chi - real(kind=default) :: pabs - pabs = sqrt (dot_product (p%x, p%x)) - select case (s) - case (1) - chi = chi_plus (p) - psi%a(1:2) = sqrt (max (p%t - pabs, 0.0_default)) * chi - psi%a(3:4) = sqrt (p%t + pabs) * chi - case (-1) - chi = chi_minus (p) - psi%a(1:2) = sqrt (p%t + pabs) * chi - psi%a(3:4) = sqrt (max (p%t - pabs, 0.0_default)) * chi - case default - pabs = m ! make the compiler happy and use m - psi%a = 0 - end select -end function u -@ -<>= -pure function ubar (m, p, s) result (psibar) - type(conjspinor) :: psibar - real(kind=default), intent(in) :: m - type(momentum), intent(in) :: p - integer, intent(in) :: s - type(spinor) :: psi - psi = u (m, p, s) - psibar%a(1:2) = conjg (psi%a(3:4)) - psibar%a(3:4) = conjg (psi%a(1:2)) -end function ubar -@ -\begin{equation} - v_\pm(p) = - \begin{pmatrix} - \mp\sqrt{p_0\pm|\vec p|} \cdot \chi_\mp(\vec p) \\ - \pm\sqrt{p_0\mp|\vec p|} \cdot \chi_\mp(\vec p) - \end{pmatrix} -\end{equation} -<>= -pure function v (m, p, s) result (psi) - type(spinor) :: psi - real(kind=default), intent(in) :: m - type(momentum), intent(in) :: p - integer, intent(in) :: s - complex(kind=default), dimension(2) :: chi - real(kind=default) :: pabs - pabs = sqrt (dot_product (p%x, p%x)) - select case (s) - case (1) - chi = chi_minus (p) - psi%a(1:2) = - sqrt (p%t + pabs) * chi - psi%a(3:4) = sqrt (max (p%t - pabs, 0.0_default)) * chi - case (-1) - chi = chi_plus (p) - psi%a(1:2) = sqrt (max (p%t - pabs, 0.0_default)) * chi - psi%a(3:4) = - sqrt (p%t + pabs) * chi - case default - pabs = m ! make the compiler happy and use m - psi%a = 0 - end select -end function v -@ -<>= -pure function vbar (m, p, s) result (psibar) - type(conjspinor) :: psibar - real(kind=default), intent(in) :: m - type(momentum), intent(in) :: p - integer, intent(in) :: s - type(spinor) :: psi - psi = v (m, p, s) - psibar%a(1:2) = conjg (psi%a(3:4)) - psibar%a(3:4) = conjg (psi%a(1:2)) -end function vbar -@ -\subsection{Off Shell Wave Functions} -I've just taken this over from Christian Schwinn's version. -<>= -public :: brs_u, brs_ubar, brs_v, brs_vbar -@ -The off-shell wave functions needed for gauge checking are obtained from the LSZ-formulas: -\begin{subequations} -\begin{align} -\Braket{\text{Out}|d^\dagger|\text{In}}&=i\int d^4x \bar v -e^{-ikx}(i\fmslash\partial-m)\Braket{\text{Out}|\psi|\text{In}}\\ -\Braket{\text{Out}|b|\text{In}}&=-i\int d^4x \bar u -e^{ikx}(i\fmslash\partial-m)\Braket{\text{Out}|\psi|\text{In}}\\ -\Braket{\text{Out}|d|\text{In}}&= - i\int d^4x \Braket{\text{Out}|\bar \psi| - \text{In}}(-i\fmslash{\overleftarrow\partial}-m)v e^{ikx}\\ -\Braket{\text{Out}|b^\dagger|\text{In}}&= - -i\int d^4x \Braket{\text{Out}|\bar \psi| - \text{In}}(-i\fmslash{\overleftarrow\partial}-m)u e^{-ikx} -\end{align} -\end{subequations} -Since the relative sign between fermions and antifermions is ignored for -on-shell amplitudes we must also ignore it here, so all wavefunctions must -have a $(-i)$ factor. -In momentum space we have: -\begin{equation} -brs u(p)=(-i) (\fmslash p-m)u(p) -\end{equation} -<>= -pure function brs_u (m, p, s) result (dpsi) - type(spinor) :: dpsi,psi - real(kind=default), intent(in) :: m - type(momentum), intent(in) :: p - integer, intent(in) :: s - type (vector)::vp - complex(kind=default), parameter :: one = (1, 0) - vp=p - psi=u(m,p,s) - dpsi=cmplx(0.0,-1.0)*(f_vf(one,vp,psi)-m*psi) -end function brs_u -@ -\begin{equation} -brs v(p)=i (\fmslash p+m)v(p) -\end{equation} -<>= -pure function brs_v (m, p, s) result (dpsi) - type(spinor) :: dpsi, psi - real(kind=default), intent(in) :: m - type(momentum), intent(in) :: p - integer, intent(in) :: s - type (vector)::vp - complex(kind=default), parameter :: one = (1, 0) - vp=p - psi=v(m,p,s) - dpsi=cmplx(0.0,1.0)*(f_vf(one,vp,psi)+m*psi) -end function brs_v -@ -\begin{equation} -brs \bar{u}(p)=(-i)\bar u(p)(\fmslash p-m) -\end{equation} -<>= - pure function brs_ubar (m, p, s)result (dpsibar) - type(conjspinor) :: dpsibar, psibar - real(kind=default), intent(in) :: m - type(momentum), intent(in) :: p - integer, intent(in) :: s - type (vector)::vp - complex(kind=default), parameter :: one = (1, 0) - vp=p - psibar=ubar(m,p,s) - dpsibar=cmplx(0.0,-1.0)*(f_fv(one,psibar,vp)-m*psibar) - end function brs_ubar -@ -\begin{equation} -brs \bar{v}(p)=(i)\bar v(p)(\fmslash p+m) -\end{equation} -<>= - pure function brs_vbar (m, p, s) result (dpsibar) - type(conjspinor) :: dpsibar,psibar - real(kind=default), intent(in) :: m - type(momentum), intent(in) :: p - integer, intent(in) :: s - type(vector)::vp - complex(kind=default), parameter :: one = (1, 0) - vp=p - psibar=vbar(m,p,s) - dpsibar=cmplx(0.0,1.0)*(f_fv(one,psibar,vp)+m*psibar) -end function brs_vbar -@ -NB: The remarks on momentum flow in the propagators don't apply -here since the incoming momenta are flipped for the wave functions. -@ \subsection{Propagators} -NB: the common factor of~$\ii$ is extracted: -<>= -public :: pr_psi, pr_psibar -public :: pj_psi, pj_psibar -public :: pg_psi, pg_psibar -@ -\begin{equation} - \frac{i(-\fmslash{p}+m)}{p^2-m^2+\ii m\Gamma}\psi -\end{equation} -NB: the sign of the momentum comes about because all momenta are -treated as \emph{outgoing} and the particle charge flow is therefore -opposite to the momentum. -<>= -pure function pr_psi (p, m, w, psi) result (ppsi) - type(spinor) :: ppsi - type(momentum), intent(in) :: p - real(kind=default), intent(in) :: m, w - type(spinor), intent(in) :: psi - type(vector) :: vp - complex(kind=default), parameter :: one = (1, 0) - vp = p - ppsi = (1 / cmplx (p*p - m**2, m*w, kind=default)) & - * (- f_vf (one, vp, psi) + m * psi) -end function pr_psi -@ -\begin{equation} - \sqrt{\frac{\pi}{M\Gamma}} - (-\fmslash{p}+m)\psi -\end{equation} -<>= -pure function pj_psi (p, m, w, psi) result (ppsi) - type(spinor) :: ppsi - type(momentum), intent(in) :: p - real(kind=default), intent(in) :: m, w - type(spinor), intent(in) :: psi - type(vector) :: vp - complex(kind=default), parameter :: one = (1, 0) - vp = p - ppsi = (0, -1) * sqrt (PI / m / w) * (- f_vf (one, vp, psi) + m * psi) -end function pj_psi -@ -<>= -pure function pg_psi (p, m, w, psi) result (ppsi) - type(spinor) :: ppsi - type(momentum), intent(in) :: p - real(kind=default), intent(in) :: m, w - type(spinor), intent(in) :: psi - type(vector) :: vp - complex(kind=default), parameter :: one = (1, 0) - vp = p - ppsi = gauss(p*p, m, w) * (- f_vf (one, vp, psi) + m * psi) -end function pg_psi -@ -\begin{equation} - \bar\psi \frac{i(\fmslash{p}+m)}{p^2-m^2+\ii m\Gamma} -\end{equation} -NB: the sign of the momentum comes about because all momenta are -treated as \emph{outgoing} and the antiparticle charge flow is -therefore parallel to the momentum. -<>= -pure function pr_psibar (p, m, w, psibar) result (ppsibar) - type(conjspinor) :: ppsibar - type(momentum), intent(in) :: p - real(kind=default), intent(in) :: m, w - type(conjspinor), intent(in) :: psibar - type(vector) :: vp - complex(kind=default), parameter :: one = (1, 0) - vp = p - ppsibar = (1 / cmplx (p*p - m**2, m*w, kind=default)) & - * (f_fv (one, psibar, vp) + m * psibar) -end function pr_psibar -@ -\begin{equation} - \sqrt{\frac{\pi}{M\Gamma}} - \bar\psi (\fmslash{p}+m) -\end{equation} -NB: the sign of the momentum comes about because all momenta are -treated as \emph{outgoing} and the antiparticle charge flow is -therefore parallel to the momentum. -<>= -pure function pj_psibar (p, m, w, psibar) result (ppsibar) - type(conjspinor) :: ppsibar - type(momentum), intent(in) :: p - real(kind=default), intent(in) :: m, w - type(conjspinor), intent(in) :: psibar - type(vector) :: vp - complex(kind=default), parameter :: one = (1, 0) - vp = p - ppsibar = (0, -1) * sqrt (PI / m / w) * (f_fv (one, psibar, vp) + m * psibar) -end function pj_psibar -@ -<>= -pure function pg_psibar (p, m, w, psibar) result (ppsibar) - type(conjspinor) :: ppsibar - type(momentum), intent(in) :: p - real(kind=default), intent(in) :: m, w - type(conjspinor), intent(in) :: psibar - type(vector) :: vp - complex(kind=default), parameter :: one = (1, 0) - vp = p - ppsibar = gauss (p*p, m, w) * (f_fv (one, psibar, vp) + m * psibar) -end function pg_psibar -@ -\begin{equation} - \frac{i(-\fmslash{p}+m)}{p^2-m^2+\ii m\Gamma} \sum_n \psi_n\otimes\bar\psi_n -\end{equation} -NB: the temporary variables [[psi(1:4)]] are not nice, but the compilers -should be able to optimize the unnecessary copies away. In any case, even -if the copies are performed, they are (probably) negligible compared to the -floating point multiplications anyway \ldots -<<(Not used yet) Declaration of operations for spinors>>= -type, public :: spinordyad - ! private (omegalib needs access, but DON'T TOUCH IT!) - complex(kind=default), dimension(4,4) :: a -end type spinordyad -@ -<<(Not used yet) Implementation of spinor propagators>>= -pure function pr_dyadleft (p, m, w, psipsibar) result (psipsibarp) - type(spinordyad) :: psipsibarp - type(momentum), intent(in) :: p - real(kind=default), intent(in) :: m, w - type(spinordyad), intent(in) :: psipsibar - integer :: i - type(vector) :: vp - type(spinor), dimension(4) :: psi - complex(kind=default) :: pole - complex(kind=default), parameter :: one = (1, 0) - vp = p - pole = 1 / cmplx (p*p - m**2, m*w, kind=default) - do i = 1, 4 - psi(i)%a = psipsibar%a(:,i) - psi(i) = pole * (- f_vf (one, vp, psi(i)) + m * psi(i)) - psipsibarp%a(:,i) = psi(i)%a - end do -end function pr_dyadleft -@ -\begin{equation} - \sum_n \psi_n\otimes\bar\psi_n \frac{i(\fmslash{p}+m)}{p^2-m^2+\ii m\Gamma} -\end{equation} -<<(Not used yet) Implementation of spinor propagators>>= -pure function pr_dyadright (p, m, w, psipsibar) result (psipsibarp) - type(spinordyad) :: psipsibarp - type(momentum), intent(in) :: p - real(kind=default), intent(in) :: m, w - type(spinordyad), intent(in) :: psipsibar - integer :: i - type(vector) :: vp - type(conjspinor), dimension(4) :: psibar - complex(kind=default) :: pole - complex(kind=default), parameter :: one = (1, 0) - vp = p - pole = 1 / cmplx (p*p - m**2, m*w, kind=default) - do i = 1, 4 - psibar(i)%a = psipsibar%a(i,:) - psibar(i) = pole * (f_fv (one, psibar(i), vp) + m * psibar(i)) - psipsibarp%a(i,:) = psibar(i)%a - end do -end function pr_dyadright -@ -\section{Spinor Couplings Revisited} -<<[[omega_bispinor_couplings.f95]]>>= -<> -module omega_bispinor_couplings - use kinds - use omega_constants - use omega_bispinors - use omega_vectorspinors - use omega_vectors - use omega_couplings - implicit none - private - <> - <> - <> - <> - integer, parameter, public :: omega_bispinor_cpls_2003_03_A = 0 -contains - <> - <> - <> - <> -end module omega_bispinor_couplings -@ -See table~\ref{tab:fermionic-currents} for the names of Fortran -functions. We could have used long names instead, but this would -increase the chance of running past continuation line limits without -adding much to the legibility. -@ -\subsection{Fermionic Vector and Axial Couplings} -There's more than one chiral representation. This one is compatible -with HELAS~\cite{HELAS}. -\begin{subequations} -\begin{align} - & \gamma^0 = \begin{pmatrix} 0 & \mathbf{1} \\ \mathbf{1} & 0 - \end{pmatrix},\; - \gamma^i = \begin{pmatrix} 0 & \sigma^i \\ -\sigma^i & 0 \end{pmatrix},\; - \gamma_5 = i\gamma^0\gamma^1\gamma^2\gamma^3 - = \begin{pmatrix} -\mathbf{1} & 0 \\ 0 & \mathbf{1} - \end{pmatrix}, \\ & - C = \begin{pmatrix} \epsilon & 0 \\ 0 & - \epsilon \end{pmatrix} - \; , \qquad \epsilon = \begin{pmatrix} 0 & 1 \\ -1 & 0 \end{pmatrix} . -\end{align} -\end{subequations} -Therefore -\begin{subequations} -\begin{align} - g_S + g_P\gamma_5 &= - \begin{pmatrix} - g_S - g_P & 0 & 0 & 0 \\ - 0 & g_S - g_P & 0 & 0 \\ - 0 & 0 & g_S + g_P & 0 \\ - 0 & 0 & 0 & g_S + g_P - \end{pmatrix} \\ - g_V\gamma^0 - g_A\gamma^0\gamma_5 &= - \begin{pmatrix} - 0 & 0 & g_V - g_A & 0 \\ - 0 & 0 & 0 & g_V - g_A \\ - g_V + g_A & 0 & 0 & 0 \\ - 0 & g_V + g_A & 0 & 0 - \end{pmatrix} \\ - g_V\gamma^1 - g_A\gamma^1\gamma_5 &= - \begin{pmatrix} - 0 & 0 & 0 & g_V - g_A \\ - 0 & 0 & g_V - g_A & 0 \\ - 0 & - g_V - g_A & 0 & 0 \\ - - g_V - g_A & 0 & 0 & 0 - \end{pmatrix} \\ - g_V\gamma^2 - g_A\gamma^2\gamma_5 &= - \begin{pmatrix} - 0 & 0 & 0 & -\ii(g_V - g_A) \\ - 0 & 0 & \ii(g_V - g_A) & 0 \\ - 0 & \ii(g_V + g_A) & 0 & 0 \\ - -\ii(g_V + g_A) & 0 & 0 & 0 - \end{pmatrix} \\ - g_V\gamma^3 - g_A\gamma^3\gamma_5 &= - \begin{pmatrix} - 0 & 0 & g_V - g_A & 0 \\ - 0 & 0 & 0 & - g_V + g_A \\ - - g_V - g_A & 0 & 0 & 0 \\ - 0 & g_V + g_A & 0 & 0 - \end{pmatrix} -\end{align} -\end{subequations} -and -\begin{subequations} -\begin{align} - C(g_S + g_P\gamma_5) &= - \begin{pmatrix} - 0 & g_S - g_P & 0 & 0 \\ - - g_S + g_P & 0 & 0 & 0 \\ - 0 & 0 & 0 & - g_S - g_P \\ - 0 & 0 & g_S + g_P & 0 - \end{pmatrix} \\ - C(g_V\gamma^0 - g_A\gamma^0\gamma_5) &= - \begin{pmatrix} - 0 & 0 & 0 & g_V - g_A \\ - 0 & 0 & - g_V + g_A & 0 \\ - 0 & - g_V - g_A & 0 & 0 \\ - g_V + g_A & 0 & 0 & 0 - \end{pmatrix} \\ - C(g_V\gamma^1 - g_A\gamma^1\gamma_5) &= - \begin{pmatrix} - 0 & 0 & g_V - g_A & 0 \\ - 0 & 0 & 0 & - g_V + g_A \\ - g_V + g_A & 0 & 0 & 0 \\ - 0 & - g_V - g_A & 0 & 0 - \end{pmatrix} \\ - C(g_V\gamma^2 - g_A\gamma^2\gamma_5) &= - \begin{pmatrix} - 0 & 0 & \ii(g_V - g_A) & 0 \\ - 0 & 0 & 0 & \ii(g_V - g_A) \\ - \ii(g_V + g_A) & 0 & 0 & 0 \\ - 0 & \ii(g_V + g_A) & 0 & 0 - \end{pmatrix} \\ - C(g_V\gamma^3 - g_A\gamma^3\gamma_5) &= - \begin{pmatrix} - 0 & 0 & 0 & - g_V + g_A \\ - 0 & 0 & - g_V + g_A & 0 \\ - 0 & - g_V - g_A & 0 & 0 \\ - - g_V - g_A & 0 & 0 & 0 - \end{pmatrix} -\end{align} -\end{subequations} -<>= -public :: va_ff, v_ff, a_ff, vl_ff, vr_ff, vlr_ff -@ -<>= -pure function va_ff (gv, ga, psil, psir) result (j) - type(vector) :: j - complex(kind=default), intent(in) :: gv, ga - type(bispinor), intent(in) :: psil, psir - complex(kind=default) :: gl, gr - complex(kind=default) :: g13, g14, g23, g24, g31, g32, g41, g42 - gl = gv + ga - gr = gv - ga - g13 = psil%a(1)*psir%a(3) - g14 = psil%a(1)*psir%a(4) - g23 = psil%a(2)*psir%a(3) - g24 = psil%a(2)*psir%a(4) - g31 = psil%a(3)*psir%a(1) - g32 = psil%a(3)*psir%a(2) - g41 = psil%a(4)*psir%a(1) - g42 = psil%a(4)*psir%a(2) - j%t = gr * ( g14 - g23) + gl * ( - g32 + g41) - j%x(1) = gr * ( g13 - g24) + gl * ( g31 - g42) - j%x(2) = (gr * ( g13 + g24) + gl * ( g31 + g42)) * (0, 1) - j%x(3) = gr * ( - g14 - g23) + gl * ( - g32 - g41) -end function va_ff -@ -<>= -pure function v_ff (gv, psil, psir) result (j) - type(vector) :: j - complex(kind=default), intent(in) :: gv - type(bispinor), intent(in) :: psil, psir - complex(kind=default) :: g13, g14, g23, g24, g31, g32, g41, g42 - g13 = psil%a(1)*psir%a(3) - g14 = psil%a(1)*psir%a(4) - g23 = psil%a(2)*psir%a(3) - g24 = psil%a(2)*psir%a(4) - g31 = psil%a(3)*psir%a(1) - g32 = psil%a(3)*psir%a(2) - g41 = psil%a(4)*psir%a(1) - g42 = psil%a(4)*psir%a(2) - j%t = gv * ( g14 - g23 - g32 + g41) - j%x(1) = gv * ( g13 - g24 + g31 - g42) - j%x(2) = gv * ( g13 + g24 + g31 + g42) * (0, 1) - j%x(3) = gv * ( - g14 - g23 - g32 - g41) -end function v_ff -@ -<>= -pure function a_ff (ga, psil, psir) result (j) - type(vector) :: j - complex(kind=default), intent(in) :: ga - type(bispinor), intent(in) :: psil, psir - complex(kind=default) :: g13, g14, g23, g24, g31, g32, g41, g42 - g13 = psil%a(1)*psir%a(3) - g14 = psil%a(1)*psir%a(4) - g23 = psil%a(2)*psir%a(3) - g24 = psil%a(2)*psir%a(4) - g31 = psil%a(3)*psir%a(1) - g32 = psil%a(3)*psir%a(2) - g41 = psil%a(4)*psir%a(1) - g42 = psil%a(4)*psir%a(2) - j%t = -ga * ( g14 - g23 + g32 - g41) - j%x(1) = -ga * ( g13 - g24 - g31 + g42) - j%x(2) = -ga * ( g13 + g24 - g31 - g42) * (0, 1) - j%x(3) = -ga * ( - g14 - g23 + g32 + g41) -end function a_ff -@ -<>= -pure function vl_ff (gl, psil, psir) result (j) - type(vector) :: j - complex(kind=default), intent(in) :: gl - type(bispinor), intent(in) :: psil, psir - complex(kind=default) :: gl2 - complex(kind=default) :: g31, g32, g41, g42 - gl2 = 2 * gl - g31 = psil%a(3)*psir%a(1) - g32 = psil%a(3)*psir%a(2) - g41 = psil%a(4)*psir%a(1) - g42 = psil%a(4)*psir%a(2) - j%t = gl2 * ( - g32 + g41) - j%x(1) = gl2 * ( g31 - g42) - j%x(2) = gl2 * ( g31 + g42) * (0, 1) - j%x(3) = gl2 * ( - g32 - g41) -end function vl_ff -@ -<>= -pure function vr_ff (gr, psil, psir) result (j) - type(vector) :: j - complex(kind=default), intent(in) :: gr - type(bispinor), intent(in) :: psil, psir - complex(kind=default) :: gr2 - complex(kind=default) :: g13, g14, g23, g24 - gr2 = 2 * gr - g13 = psil%a(1)*psir%a(3) - g14 = psil%a(1)*psir%a(4) - g23 = psil%a(2)*psir%a(3) - g24 = psil%a(2)*psir%a(4) - j%t = gr2 * ( g14 - g23) - j%x(1) = gr2 * ( g13 - g24) - j%x(2) = gr2 * ( g13 + g24) * (0, 1) - j%x(3) = gr2 * ( - g14 - g23) -end function vr_ff -@ -<>= -pure function vlr_ff (gl, gr, psibar, psi) result (j) - type(vector) :: j - complex(kind=default), intent(in) :: gl, gr - type(bispinor), intent(in) :: psibar - type(bispinor), intent(in) :: psi - j = va_ff (gl+gr, gl-gr, psibar, psi) -end function vlr_ff -@ -and -\begin{equation} - \fmslash{v} - \fmslash{a}\gamma_5 = - \begin{pmatrix} - 0 & 0 & v_- - a_- & - v^* + a^* \\ - 0 & 0 & - v + a & v_+ - a_+ \\ - v_+ + a_+ & v^* + a^* & 0 & 0 \\ - v + a & v_- + a_- & 0 & 0 - \end{pmatrix} -\end{equation} -with $v_\pm=v_0\pm v_3$, $a_\pm=a_0\pm a_3$, $v=v_1+\ii v_2$, -$v^*=v_1-\ii v_2$, $a=a_1+\ii a_2$, and $a^*=a_1-\ii a_2$. But note -that~$\cdot^*$ is \emph{not} complex conjugation for complex~$v_\mu$ -or~$a_\mu$. -<>= -public :: f_vaf, f_vf, f_af, f_vlf, f_vrf, f_vlrf -@ -<>= -pure function f_vaf (gv, ga, v, psi) result (vpsi) - type(bispinor) :: vpsi - complex(kind=default), intent(in) :: gv, ga - type(vector), intent(in) :: v - type(bispinor), intent(in) :: psi - complex(kind=default) :: gl, gr - complex(kind=default) :: vp, vm, v12, v12s - gl = gv + ga - gr = gv - ga - vp = v%t + v%x(3) - vm = v%t - v%x(3) - v12 = v%x(1) + (0,1)*v%x(2) - v12s = v%x(1) - (0,1)*v%x(2) - vpsi%a(1) = gr * ( vm * psi%a(3) - v12s * psi%a(4)) - vpsi%a(2) = gr * ( - v12 * psi%a(3) + vp * psi%a(4)) - vpsi%a(3) = gl * ( vp * psi%a(1) + v12s * psi%a(2)) - vpsi%a(4) = gl * ( v12 * psi%a(1) + vm * psi%a(2)) -end function f_vaf -@ -<>= -pure function f_vf (gv, v, psi) result (vpsi) - type(bispinor) :: vpsi - complex(kind=default), intent(in) :: gv - type(vector), intent(in) :: v - type(bispinor), intent(in) :: psi - complex(kind=default) :: vp, vm, v12, v12s - vp = v%t + v%x(3) - vm = v%t - v%x(3) - v12 = v%x(1) + (0,1)*v%x(2) - v12s = v%x(1) - (0,1)*v%x(2) - vpsi%a(1) = gv * ( vm * psi%a(3) - v12s * psi%a(4)) - vpsi%a(2) = gv * ( - v12 * psi%a(3) + vp * psi%a(4)) - vpsi%a(3) = gv * ( vp * psi%a(1) + v12s * psi%a(2)) - vpsi%a(4) = gv * ( v12 * psi%a(1) + vm * psi%a(2)) -end function f_vf -@ -<>= -pure function f_af (ga, v, psi) result (vpsi) - type(bispinor) :: vpsi - complex(kind=default), intent(in) :: ga - type(vector), intent(in) :: v - type(bispinor), intent(in) :: psi - complex(kind=default) :: vp, vm, v12, v12s - vp = v%t + v%x(3) - vm = v%t - v%x(3) - v12 = v%x(1) + (0,1)*v%x(2) - v12s = v%x(1) - (0,1)*v%x(2) - vpsi%a(1) = ga * ( - vm * psi%a(3) + v12s * psi%a(4)) - vpsi%a(2) = ga * ( v12 * psi%a(3) - vp * psi%a(4)) - vpsi%a(3) = ga * ( vp * psi%a(1) + v12s * psi%a(2)) - vpsi%a(4) = ga * ( v12 * psi%a(1) + vm * psi%a(2)) -end function f_af -@ -<>= -pure function f_vlf (gl, v, psi) result (vpsi) - type(bispinor) :: vpsi - complex(kind=default), intent(in) :: gl - type(vector), intent(in) :: v - type(bispinor), intent(in) :: psi - complex(kind=default) :: gl2 - complex(kind=default) :: vp, vm, v12, v12s - gl2 = 2 * gl - vp = v%t + v%x(3) - vm = v%t - v%x(3) - v12 = v%x(1) + (0,1)*v%x(2) - v12s = v%x(1) - (0,1)*v%x(2) - vpsi%a(1) = 0 - vpsi%a(2) = 0 - vpsi%a(3) = gl2 * ( vp * psi%a(1) + v12s * psi%a(2)) - vpsi%a(4) = gl2 * ( v12 * psi%a(1) + vm * psi%a(2)) -end function f_vlf -@ -<>= -pure function f_vrf (gr, v, psi) result (vpsi) - type(bispinor) :: vpsi - complex(kind=default), intent(in) :: gr - type(vector), intent(in) :: v - type(bispinor), intent(in) :: psi - complex(kind=default) :: gr2 - complex(kind=default) :: vp, vm, v12, v12s - gr2 = 2 * gr - vp = v%t + v%x(3) - vm = v%t - v%x(3) - v12 = v%x(1) + (0,1)*v%x(2) - v12s = v%x(1) - (0,1)*v%x(2) - vpsi%a(1) = gr2 * ( vm * psi%a(3) - v12s * psi%a(4)) - vpsi%a(2) = gr2 * ( - v12 * psi%a(3) + vp * psi%a(4)) - vpsi%a(3) = 0 - vpsi%a(4) = 0 -end function f_vrf -@ -<>= -pure function f_vlrf (gl, gr, v, psi) result (vpsi) - type(bispinor) :: vpsi - complex(kind=default), intent(in) :: gl, gr - type(vector), intent(in) :: v - type(bispinor), intent(in) :: psi - vpsi = f_vaf (gl+gr, gl-gr, v, psi) -end function f_vlrf -@ \subsection{Fermionic Scalar and Pseudo Scalar Couplings} -<>= -public :: sp_ff, s_ff, p_ff, sl_ff, sr_ff, slr_ff -@ -<>= -pure function sp_ff (gs, gp, psil, psir) result (j) - complex(kind=default) :: j - complex(kind=default), intent(in) :: gs, gp - type(bispinor), intent(in) :: psil, psir - j = (gs - gp) * (psil%a(1)*psir%a(2) - psil%a(2)*psir%a(1)) & - + (gs + gp) * (- psil%a(3)*psir%a(4) + psil%a(4)*psir%a(3)) -end function sp_ff -@ -<>= -pure function s_ff (gs, psil, psir) result (j) - complex(kind=default) :: j - complex(kind=default), intent(in) :: gs - type(bispinor), intent(in) :: psil, psir - j = gs * (psil * psir) -end function s_ff -@ -<>= -pure function p_ff (gp, psil, psir) result (j) - complex(kind=default) :: j - complex(kind=default), intent(in) :: gp - type(bispinor), intent(in) :: psil, psir - j = gp * (- psil%a(1)*psir%a(2) + psil%a(2)*psir%a(1) & - - psil%a(3)*psir%a(4) + psil%a(4)*psir%a(3)) -end function p_ff -@ -<>= -pure function sl_ff (gl, psil, psir) result (j) - complex(kind=default) :: j - complex(kind=default), intent(in) :: gl - type(bispinor), intent(in) :: psil, psir - j = 2 * gl * (psil%a(1)*psir%a(2) - psil%a(2)*psir%a(1)) -end function sl_ff -@ -<>= -pure function sr_ff (gr, psil, psir) result (j) - complex(kind=default) :: j - complex(kind=default), intent(in) :: gr - type(bispinor), intent(in) :: psil, psir - j = 2 * gr * (- psil%a(3)*psir%a(4) + psil%a(4)*psir%a(3)) -end function sr_ff -@ -<>= -pure function slr_ff (gl, gr, psibar, psi) result (j) - complex(kind=default) :: j - complex(kind=default), intent(in) :: gl, gr - type(bispinor), intent(in) :: psibar - type(bispinor), intent(in) :: psi - j = sp_ff (gr+gl, gr-gl, psibar, psi) -end function slr_ff -@ -<>= -public :: f_spf, f_sf, f_pf, f_slf, f_srf, f_slrf -@ -<>= -pure function f_spf (gs, gp, phi, psi) result (phipsi) - type(bispinor) :: phipsi - complex(kind=default), intent(in) :: gs, gp - complex(kind=default), intent(in) :: phi - type(bispinor), intent(in) :: psi - phipsi%a(1:2) = ((gs - gp) * phi) * psi%a(1:2) - phipsi%a(3:4) = ((gs + gp) * phi) * psi%a(3:4) -end function f_spf -@ -<>= -pure function f_sf (gs, phi, psi) result (phipsi) - type(bispinor) :: phipsi - complex(kind=default), intent(in) :: gs - complex(kind=default), intent(in) :: phi - type(bispinor), intent(in) :: psi - phipsi%a = (gs * phi) * psi%a -end function f_sf -@ -<>= -pure function f_pf (gp, phi, psi) result (phipsi) - type(bispinor) :: phipsi - complex(kind=default), intent(in) :: gp - complex(kind=default), intent(in) :: phi - type(bispinor), intent(in) :: psi - phipsi%a(1:2) = (- gp * phi) * psi%a(1:2) - phipsi%a(3:4) = ( gp * phi) * psi%a(3:4) -end function f_pf -@ -<>= -pure function f_slf (gl, phi, psi) result (phipsi) - type(bispinor) :: phipsi - complex(kind=default), intent(in) :: gl - complex(kind=default), intent(in) :: phi - type(bispinor), intent(in) :: psi - phipsi%a(1:2) = (2 * gl * phi) * psi%a(1:2) - phipsi%a(3:4) = 0 -end function f_slf -@ -<>= -pure function f_srf (gr, phi, psi) result (phipsi) - type(bispinor) :: phipsi - complex(kind=default), intent(in) :: gr - complex(kind=default), intent(in) :: phi - type(bispinor), intent(in) :: psi - phipsi%a(1:2) = 0 - phipsi%a(3:4) = (2 * gr * phi) * psi%a(3:4) -end function f_srf -@ -<>= -pure function f_slrf (gl, gr, phi, psi) result (phipsi) - type(bispinor) :: phipsi - complex(kind=default), intent(in) :: gl, gr - complex(kind=default), intent(in) :: phi - type(bispinor), intent(in) :: psi - phipsi = f_spf (gr+gl, gr-gl, phi, psi) -end function f_slrf -@ \subsection{Couplings for BRST Transformations} -\subsubsection{3-Couplings} -The lists of needed gamma matrices can be found in the next subsection with -the gravitino couplings. -<>= -private :: vv_ff, f_vvf -@ -<>= -public :: vmom_ff, mom_ff, mom5_ff, moml_ff, momr_ff, lmom_ff, rmom_ff -@ -<>= -pure function vv_ff (psibar, psi, k) result (psibarpsi) - type(vector) :: psibarpsi - type(bispinor), intent(in) :: psibar, psi - type(vector), intent(in) :: k - complex(kind=default) :: kp, km, k12, k12s - type(bispinor) :: kgpsi1, kgpsi2, kgpsi3, kgpsi4 - kp = k%t + k%x(3) - km = k%t - k%x(3) - k12 = k%x(1) + (0,1)*k%x(2) - k12s = k%x(1) - (0,1)*k%x(2) - kgpsi1%a(1) = -k%x(3) * psi%a(1) - k12s * psi%a(2) - kgpsi1%a(2) = -k12 * psi%a(1) + k%x(3) * psi%a(2) - kgpsi1%a(3) = k%x(3) * psi%a(3) + k12s * psi%a(4) - kgpsi1%a(4) = k12 * psi%a(3) - k%x(3) * psi%a(4) - kgpsi2%a(1) = ((0,-1) * k%x(2)) * psi%a(1) - km * psi%a(2) - kgpsi2%a(2) = - kp * psi%a(1) + ((0,1) * k%x(2)) * psi%a(2) - kgpsi2%a(3) = ((0,-1) * k%x(2)) * psi%a(3) + kp * psi%a(4) - kgpsi2%a(4) = km * psi%a(3) + ((0,1) * k%x(2)) * psi%a(4) - kgpsi3%a(1) = (0,1) * (k%x(1) * psi%a(1) + km * psi%a(2)) - kgpsi3%a(2) = (0,-1) * (kp * psi%a(1) + k%x(1) * psi%a(2)) - kgpsi3%a(3) = (0,1) * (k%x(1) * psi%a(3) - kp * psi%a(4)) - kgpsi3%a(4) = (0,1) * (km * psi%a(3) - k%x(1) * psi%a(4)) - kgpsi4%a(1) = -k%t * psi%a(1) - k12s * psi%a(2) - kgpsi4%a(2) = k12 * psi%a(1) + k%t * psi%a(2) - kgpsi4%a(3) = k%t * psi%a(3) - k12s * psi%a(4) - kgpsi4%a(4) = k12 * psi%a(3) - k%t * psi%a(4) - psibarpsi%t = 2 * (psibar * kgpsi1) - psibarpsi%x(1) = 2 * (psibar * kgpsi2) - psibarpsi%x(2) = 2 * (psibar * kgpsi3) - psibarpsi%x(3) = 2 * (psibar * kgpsi4) -end function vv_ff -@ -<>= -pure function f_vvf (v, psi, k) result (kvpsi) - type(bispinor) :: kvpsi - type(bispinor), intent(in) :: psi - type(vector), intent(in) :: k, v - complex(kind=default) :: kv30, kv21, kv01, kv31, kv02, kv32 - complex(kind=default) :: ap, am, bp, bm, bps, bms - kv30 = k%x(3) * v%t - k%t * v%x(3) - kv21 = (0,1) * (k%x(2) * v%x(1) - k%x(1) * v%x(2)) - kv01 = k%t * v%x(1) - k%x(1) * v%t - kv31 = k%x(3) * v%x(1) - k%x(1) * v%x(3) - kv02 = (0,1) * (k%t * v%x(2) - k%x(2) * v%t) - kv32 = (0,1) * (k%x(3) * v%x(2) - k%x(2) * v%x(3)) - ap = 2 * (kv30 + kv21) - am = 2 * (-kv30 + kv21) - bp = 2 * (kv01 + kv31 + kv02 + kv32) - bm = 2 * (kv01 - kv31 + kv02 - kv32) - bps = 2 * (kv01 + kv31 - kv02 - kv32) - bms = 2 * (kv01 - kv31 - kv02 + kv32) - kvpsi%a(1) = am * psi%a(1) + bms * psi%a(2) - kvpsi%a(2) = bp * psi%a(1) - am * psi%a(2) - kvpsi%a(3) = ap * psi%a(3) - bps * psi%a(4) - kvpsi%a(4) = -bm * psi%a(3) - ap * psi%a(4) -end function f_vvf -@ -<>= -pure function vmom_ff (g, psibar, psi, k) result (psibarpsi) - type(vector) :: psibarpsi - complex(kind=default), intent(in) :: g - type(bispinor), intent(in) :: psibar, psi - type(momentum), intent(in) :: k - type(vector) :: vk - vk = k - psibarpsi = g * vv_ff (psibar, psi, vk) -end function vmom_ff -@ -<>= -pure function mom_ff (g, m, psibar, psi, k) result (psibarpsi) - complex(kind=default) :: psibarpsi - type(bispinor), intent(in) :: psibar, psi - type(momentum), intent(in) :: k - complex(kind=default), intent(in) :: g, m - type(bispinor) :: kmpsi - complex(kind=default) :: kp, km, k12, k12s - kp = k%t + k%x(3) - km = k%t - k%x(3) - k12 = k%x(1) + (0,1)*k%x(2) - k12s = k%x(1) - (0,1)*k%x(2) - kmpsi%a(1) = km * psi%a(3) - k12s * psi%a(4) - kmpsi%a(2) = kp * psi%a(4) - k12 * psi%a(3) - kmpsi%a(3) = kp * psi%a(1) + k12s * psi%a(2) - kmpsi%a(4) = k12 * psi%a(1) + km * psi%a(2) - psibarpsi = g * (psibar * kmpsi) + s_ff (m, psibar, psi) -end function mom_ff -@ -<>= -pure function mom5_ff (g, m, psibar, psi, k) result (psibarpsi) - complex(kind=default) :: psibarpsi - type(bispinor), intent(in) :: psibar, psi - type(momentum), intent(in) :: k - complex(kind=default), intent(in) :: g, m - type(bispinor) :: g5psi - g5psi%a(1:2) = - psi%a(1:2) - g5psi%a(3:4) = psi%a(3:4) - psibarpsi = mom_ff (g, m, psibar, g5psi, k) -end function mom5_ff -@ -<>= -pure function moml_ff (g, m, psibar, psi, k) result (psibarpsi) - complex(kind=default) :: psibarpsi - type(bispinor), intent(in) :: psibar, psi - type(momentum), intent(in) :: k - complex(kind=default), intent(in) :: g, m - type(bispinor) :: leftpsi - leftpsi%a(1:2) = 2 * psi%a(1:2) - leftpsi%a(3:4) = 0 - psibarpsi = mom_ff (g, m, psibar, leftpsi, k) -end function moml_ff -@ -<>= -pure function momr_ff (g, m, psibar, psi, k) result (psibarpsi) - complex(kind=default) :: psibarpsi - type(bispinor), intent(in) :: psibar, psi - type(momentum), intent(in) :: k - complex(kind=default), intent(in) :: g, m - type(bispinor) :: rightpsi - rightpsi%a(1:2) = 0 - rightpsi%a(3:4) = 2 * psi%a(3:4) - psibarpsi = mom_ff (g, m, psibar, rightpsi, k) -end function momr_ff -@ -<>= -pure function lmom_ff (g, m, psibar, psi, k) result (psibarpsi) - complex(kind=default) :: psibarpsi - type(bispinor), intent(in) :: psibar, psi - type(momentum), intent(in) :: k - complex(kind=default), intent(in) :: g, m - psibarpsi = mom_ff (g, m, psibar, psi, k) + & - mom5_ff (g,-m, psibar, psi, k) -end function lmom_ff -@ -<>= -pure function rmom_ff (g, m, psibar, psi, k) result (psibarpsi) - complex(kind=default) :: psibarpsi - type(bispinor), intent(in) :: psibar, psi - type(momentum), intent(in) :: k - complex(kind=default), intent(in) :: g, m - psibarpsi = mom_ff (g, m, psibar, psi, k) - & - mom5_ff (g,-m, psibar, psi, k) -end function rmom_ff -@ -<>= -public :: f_vmomf, f_momf, f_mom5f, f_momlf, f_momrf, f_lmomf, f_rmomf -@ -<>= -pure function f_vmomf (g, v, psi, k) result (kvpsi) - type(bispinor) :: kvpsi - type(bispinor), intent(in) :: psi - complex(kind=default), intent(in) :: g - type(momentum), intent(in) :: k - type(vector), intent(in) :: v - type(vector) :: vk - vk = k - kvpsi = g * f_vvf (v, psi, vk) -end function f_vmomf -@ -<>= -pure function f_momf (g, m, phi, psi, k) result (kmpsi) - type(bispinor) :: kmpsi - type(bispinor), intent(in) :: psi - complex(kind=default), intent(in) :: phi, g, m - type(momentum), intent(in) :: k - complex(kind=default) :: kp, km, k12, k12s - kp = k%t + k%x(3) - km = k%t - k%x(3) - k12 = k%x(1) + (0,1)*k%x(2) - k12s = k%x(1) - (0,1)*k%x(2) - kmpsi%a(1) = km * psi%a(3) - k12s * psi%a(4) - kmpsi%a(2) = -k12 * psi%a(3) + kp * psi%a(4) - kmpsi%a(3) = kp * psi%a(1) + k12s * psi%a(2) - kmpsi%a(4) = k12 * psi%a(1) + km * psi%a(2) - kmpsi = g * (phi * kmpsi) + f_sf (m, phi, psi) -end function f_momf -@ -<>= -pure function f_mom5f (g, m, phi, psi, k) result (kmpsi) - type(bispinor) :: kmpsi - type(bispinor), intent(in) :: psi - complex(kind=default), intent(in) :: phi, g, m - type(momentum), intent(in) :: k - type(bispinor) :: g5psi - g5psi%a(1:2) = - psi%a(1:2) - g5psi%a(3:4) = psi%a(3:4) - kmpsi = f_momf (g, m, phi, g5psi, k) -end function f_mom5f -@ -<>= -pure function f_momlf (g, m, phi, psi, k) result (kmpsi) - type(bispinor) :: kmpsi - type(bispinor), intent(in) :: psi - complex(kind=default), intent(in) :: phi, g, m - type(momentum), intent(in) :: k - type(bispinor) :: leftpsi - leftpsi%a(1:2) = 2 * psi%a(1:2) - leftpsi%a(3:4) = 0 - kmpsi = f_momf (g, m, phi, leftpsi, k) -end function f_momlf -@ -<>= -pure function f_momrf (g, m, phi, psi, k) result (kmpsi) - type(bispinor) :: kmpsi - type(bispinor), intent(in) :: psi - complex(kind=default), intent(in) :: phi, g, m - type(momentum), intent(in) :: k - type(bispinor) :: rightpsi - rightpsi%a(1:2) = 0 - rightpsi%a(3:4) = 2 * psi%a(3:4) - kmpsi = f_momf (g, m, phi, rightpsi, k) -end function f_momrf -@ -<>= -pure function f_lmomf (g, m, phi, psi, k) result (kmpsi) - type(bispinor) :: kmpsi - type(bispinor), intent(in) :: psi - complex(kind=default), intent(in) :: phi, g, m - type(momentum), intent(in) :: k - kmpsi = f_momf (g, m, phi, psi, k) + & - f_mom5f (g,-m, phi, psi, k) -end function f_lmomf -@ -<>= -pure function f_rmomf (g, m, phi, psi, k) result (kmpsi) - type(bispinor) :: kmpsi - type(bispinor), intent(in) :: psi - complex(kind=default), intent(in) :: phi, g, m - type(momentum), intent(in) :: k - kmpsi = f_momf (g, m, phi, psi, k) - & - f_mom5f (g,-m, phi, psi, k) -end function f_rmomf -@ -\subsubsection{4-Couplings} -<>= -public :: v2_ff, sv1_ff, sv2_ff, pv1_ff, pv2_ff, svl1_ff, svl2_ff, & - svr1_ff, svr2_ff, svlr1_ff, svlr2_ff -@ -<>= -pure function v2_ff (g, psibar, v, psi) result (v2) - type(vector) :: v2 - complex (kind=default), intent(in) :: g - type(bispinor), intent(in) :: psibar, psi - type(vector), intent(in) :: v - v2 = (-g) * vv_ff (psibar, psi, v) -end function v2_ff -@ -<>= -pure function sv1_ff (g, psibar, v, psi) result (phi) - complex(kind=default) :: phi - type(bispinor), intent(in) :: psibar, psi - type(vector), intent(in) :: v - complex(kind=default), intent(in) :: g - phi = psibar * f_vf (g, v, psi) -end function sv1_ff -@ -<>= -pure function sv2_ff (g, psibar, phi, psi) result (v) - type(vector) :: v - complex(kind=default), intent(in) :: phi, g - type(bispinor), intent(in) :: psibar, psi - v = phi * v_ff (g, psibar, psi) -end function sv2_ff -@ -<>= -pure function pv1_ff (g, psibar, v, psi) result (phi) - complex(kind=default) :: phi - type(bispinor), intent(in) :: psibar, psi - type(vector), intent(in) :: v - complex(kind=default), intent(in) :: g - phi = - (psibar * f_af (g, v, psi)) -end function pv1_ff -@ -<>= -pure function pv2_ff (g, psibar, phi, psi) result (v) - type(vector) :: v - complex(kind=default), intent(in) :: phi, g - type(bispinor), intent(in) :: psibar, psi - v = -(phi * a_ff (g, psibar, psi)) -end function pv2_ff -@ -<>= -pure function svl1_ff (g, psibar, v, psi) result (phi) - complex(kind=default) :: phi - type(bispinor), intent(in) :: psibar, psi - type(vector), intent(in) :: v - complex(kind=default), intent(in) :: g - phi = psibar * f_vlf (g, v, psi) -end function svl1_ff -@ -<>= -pure function svl2_ff (g, psibar, phi, psi) result (v) - type(vector) :: v - complex(kind=default), intent(in) :: phi, g - type(bispinor), intent(in) :: psibar, psi - v = phi * vl_ff (g, psibar, psi) -end function svl2_ff -@ -<>= -pure function svr1_ff (g, psibar, v, psi) result (phi) - complex(kind=default) :: phi - type(bispinor), intent(in) :: psibar, psi - type(vector), intent(in) :: v - complex(kind=default), intent(in) :: g - phi = psibar * f_vrf (g, v, psi) -end function svr1_ff -@ -<>= -pure function svr2_ff (g, psibar, phi, psi) result (v) - type(vector) :: v - complex(kind=default), intent(in) :: phi, g - type(bispinor), intent(in) :: psibar, psi - v = phi * vr_ff (g, psibar, psi) -end function svr2_ff -@ -<>= -pure function svlr1_ff (gl, gr, psibar, v, psi) result (phi) - complex(kind=default) :: phi - type(bispinor), intent(in) :: psibar, psi - type(vector), intent(in) :: v - complex(kind=default), intent(in) :: gl, gr - phi = psibar * f_vlrf (gl, gr, v, psi) -end function svlr1_ff -@ -<>= -pure function svlr2_ff (gl, gr, psibar, phi, psi) result (v) - type(vector) :: v - complex(kind=default), intent(in) :: phi, gl, gr - type(bispinor), intent(in) :: psibar, psi - v = phi * vlr_ff (gl, gr, psibar, psi) -end function svlr2_ff -@ -<>= -public :: f_v2f, f_svf, f_pvf, f_svlf, f_svrf, f_svlrf -@ -<>= -pure function f_v2f (g, v1, v2, psi) result (vpsi) - type(bispinor) :: vpsi - complex(kind=default), intent(in) :: g - type(bispinor), intent(in) :: psi - type(vector), intent(in) :: v1, v2 - vpsi = g * f_vvf (v2, psi, v1) -end function f_v2f -@ -<>= -pure function f_svf (g, phi, v, psi) result (pvpsi) - type(bispinor) :: pvpsi - complex(kind=default), intent(in) :: g, phi - type(bispinor), intent(in) :: psi - type(vector), intent(in) :: v - pvpsi = phi * f_vf (g, v, psi) -end function f_svf -@ -<>= -pure function f_pvf (g, phi, v, psi) result (pvpsi) - type(bispinor) :: pvpsi - complex(kind=default), intent(in) :: g, phi - type(bispinor), intent(in) :: psi - type(vector), intent(in) :: v - pvpsi = -(phi * f_af (g, v, psi)) -end function f_pvf -@ -<>= -pure function f_svlf (g, phi, v, psi) result (pvpsi) - type(bispinor) :: pvpsi - complex(kind=default), intent(in) :: g, phi - type(bispinor), intent(in) :: psi - type(vector), intent(in) :: v - pvpsi = phi * f_vlf (g, v, psi) -end function f_svlf -@ -<>= -pure function f_svrf (g, phi, v, psi) result (pvpsi) - type(bispinor) :: pvpsi - complex(kind=default), intent(in) :: g, phi - type(bispinor), intent(in) :: psi - type(vector), intent(in) :: v - pvpsi = phi * f_vrf (g, v, psi) -end function f_svrf -@ -<>= -pure function f_svlrf (gl, gr, phi, v, psi) result (pvpsi) - type(bispinor) :: pvpsi - complex(kind=default), intent(in) :: gl, gr, phi - type(bispinor), intent(in) :: psi - type(vector), intent(in) :: v - pvpsi = phi * f_vlrf (gl, gr, v, psi) -end function f_svlrf -@ \subsection{Gravitino Couplings} -<>= -public :: pot_grf, pot_fgr, s_grf, s_fgr, p_grf, p_fgr -@ -<>= -private :: fgvgr, fgvg5gr, fggvvgr, grkgf, grkggf, grkkggf, & - fgkgr, fg5gkgr, grvgf, grg5vgf, grkgggf, fggkggr -@ -<>= -pure function pot_grf (g, gravbar, psi) result (j) - complex(kind=default) :: j - complex(kind=default), intent(in) :: g - type(vectorspinor), intent(in) :: gravbar - type(bispinor), intent(in) :: psi - type(vectorspinor) :: gamma_psi - gamma_psi%psi(1)%a(1) = psi%a(3) - gamma_psi%psi(1)%a(2) = psi%a(4) - gamma_psi%psi(1)%a(3) = psi%a(1) - gamma_psi%psi(1)%a(4) = psi%a(2) - gamma_psi%psi(2)%a(1) = psi%a(4) - gamma_psi%psi(2)%a(2) = psi%a(3) - gamma_psi%psi(2)%a(3) = - psi%a(2) - gamma_psi%psi(2)%a(4) = - psi%a(1) - gamma_psi%psi(3)%a(1) = (0,-1) * psi%a(4) - gamma_psi%psi(3)%a(2) = (0,1) * psi%a(3) - gamma_psi%psi(3)%a(3) = (0,1) * psi%a(2) - gamma_psi%psi(3)%a(4) = (0,-1) * psi%a(1) - gamma_psi%psi(4)%a(1) = psi%a(3) - gamma_psi%psi(4)%a(2) = - psi%a(4) - gamma_psi%psi(4)%a(3) = - psi%a(1) - gamma_psi%psi(4)%a(4) = psi%a(2) - j = g * (gravbar * gamma_psi) -end function pot_grf -@ -<>= -pure function pot_fgr (g, psibar, grav) result (j) - complex(kind=default) :: j - complex(kind=default), intent(in) :: g - type(bispinor), intent(in) :: psibar - type(vectorspinor), intent(in) :: grav - type(bispinor) :: gamma_grav - gamma_grav%a(1) = grav%psi(1)%a(3) - grav%psi(2)%a(4) + & - ((0,1)*grav%psi(3)%a(4)) - grav%psi(4)%a(3) - gamma_grav%a(2) = grav%psi(1)%a(4) - grav%psi(2)%a(3) - & - ((0,1)*grav%psi(3)%a(3)) + grav%psi(4)%a(4) - gamma_grav%a(3) = grav%psi(1)%a(1) + grav%psi(2)%a(2) - & - ((0,1)*grav%psi(3)%a(2)) + grav%psi(4)%a(1) - gamma_grav%a(4) = grav%psi(1)%a(2) + grav%psi(2)%a(1) + & - ((0,1)*grav%psi(3)%a(1)) - grav%psi(4)%a(2) - j = g * (psibar * gamma_grav) -end function pot_fgr -@ -<>= -pure function grvgf (gravbar, psi, k) result (j) - complex(kind=default) :: j - complex(kind=default) :: kp, km, k12, k12s - type(vectorspinor), intent(in) :: gravbar - type(bispinor), intent(in) :: psi - type(vector), intent(in) :: k - type(vectorspinor) :: kg_psi - kp = k%t + k%x(3) - km = k%t - k%x(3) - k12 = k%x(1) + (0,1)*k%x(2) - k12s = k%x(1) - (0,1)*k%x(2) - !!! Since we are taking the spinor product here, NO explicit - !!! charge conjugation matrix is needed! - kg_psi%psi(1)%a(1) = km * psi%a(1) - k12s * psi%a(2) - kg_psi%psi(1)%a(2) = - k12 * psi%a(1) + kp * psi%a(2) - kg_psi%psi(1)%a(3) = kp * psi%a(3) + k12s * psi%a(4) - kg_psi%psi(1)%a(4) = k12 * psi%a(3) + km * psi%a(4) - kg_psi%psi(2)%a(1) = k12s * psi%a(1) - km * psi%a(2) - kg_psi%psi(2)%a(2) = - kp * psi%a(1) + k12 * psi%a(2) - kg_psi%psi(2)%a(3) = k12s * psi%a(3) + kp * psi%a(4) - kg_psi%psi(2)%a(4) = km * psi%a(3) + k12 * psi%a(4) - kg_psi%psi(3)%a(1) = (0,1) * (k12s * psi%a(1) + km * psi%a(2)) - kg_psi%psi(3)%a(2) = (0,1) * (- kp * psi%a(1) - k12 * psi%a(2)) - kg_psi%psi(3)%a(3) = (0,1) * (k12s * psi%a(3) - kp * psi%a(4)) - kg_psi%psi(3)%a(4) = (0,1) * (km * psi%a(3) - k12 * psi%a(4)) - kg_psi%psi(4)%a(1) = - km * psi%a(1) - k12s * psi%a(2) - kg_psi%psi(4)%a(2) = k12 * psi%a(1) + kp * psi%a(2) - kg_psi%psi(4)%a(3) = kp * psi%a(3) - k12s * psi%a(4) - kg_psi%psi(4)%a(4) = k12 * psi%a(3) - km * psi%a(4) - j = gravbar * kg_psi -end function grvgf -@ -<>= -pure function grg5vgf (gravbar, psi, k) result (j) - complex(kind=default) :: j - type(vectorspinor), intent(in) :: gravbar - type(bispinor), intent(in) :: psi - type(vector), intent(in) :: k - type(bispinor) :: g5_psi - g5_psi%a(1:2) = - psi%a(1:2) - g5_psi%a(3:4) = psi%a(3:4) - j = grvgf (gravbar, g5_psi, k) -end function grg5vgf -@ -<>= -pure function s_grf (g, gravbar, psi, k) result (j) - complex(kind=default) :: j - complex(kind=default), intent(in) :: g - type(vectorspinor), intent(in) :: gravbar - type(bispinor), intent(in) :: psi - type(momentum), intent(in) :: k - type(vector) :: vk - vk = k - j = g * grvgf (gravbar, psi, vk) -end function s_grf -@ -<>= -pure function fgkgr (psibar, grav, k) result (j) - complex(kind=default) :: j - complex(kind=default) :: kp, km, k12, k12s - type(bispinor), intent(in) :: psibar - type(vectorspinor), intent(in) :: grav - type(vector), intent(in) :: k - type(bispinor) :: gk_grav - kp = k%t + k%x(3) - km = k%t - k%x(3) - k12 = k%x(1) + (0,1)*k%x(2) - k12s = k%x(1) - (0,1)*k%x(2) - !!! Since we are taking the spinor product here, NO explicit - !!! charge conjugation matrix is needed! - gk_grav%a(1) = kp * grav%psi(1)%a(1) + k12s * grav%psi(1)%a(2) & - - k12 * grav%psi(2)%a(1) - km * grav%psi(2)%a(2) & - + (0,1) * k12 * grav%psi(3)%a(1) & - + (0,1) * km * grav%psi(3)%a(2) & - - kp * grav%psi(4)%a(1) - k12s * grav%psi(4)%a(2) - gk_grav%a(2) = k12 * grav%psi(1)%a(1) + km * grav%psi(1)%a(2) & - - kp * grav%psi(2)%a(1) - k12s * grav%psi(2)%a(2) & - - (0,1) * kp * grav%psi(3)%a(1) & - - (0,1) * k12s * grav%psi(3)%a(2) & - + k12 * grav%psi(4)%a(1) + km * grav%psi(4)%a(2) - gk_grav%a(3) = km * grav%psi(1)%a(3) - k12s * grav%psi(1)%a(4) & - - k12 * grav%psi(2)%a(3) + kp * grav%psi(2)%a(4) & - + (0,1) * k12 * grav%psi(3)%a(3) & - - (0,1) * kp * grav%psi(3)%a(4) & - + km * grav%psi(4)%a(3) - k12s * grav%psi(4)%a(4) - gk_grav%a(4) = - k12 * grav%psi(1)%a(3) + kp * grav%psi(1)%a(4) & - + km * grav%psi(2)%a(3) - k12s * grav%psi(2)%a(4) & - + (0,1) * km * grav%psi(3)%a(3) & - - (0,1) * k12s * grav%psi(3)%a(4) & - + k12 * grav%psi(4)%a(3) - kp * grav%psi(4)%a(4) - j = psibar * gk_grav -end function fgkgr -@ -<>= -pure function fg5gkgr (psibar, grav, k) result (j) - complex(kind=default) :: j - type(bispinor), intent(in) :: psibar - type(vectorspinor), intent(in) :: grav - type(vector), intent(in) :: k - type(bispinor) :: psibar_g5 - psibar_g5%a(1:2) = - psibar%a(1:2) - psibar_g5%a(3:4) = psibar%a(3:4) - j = fgkgr (psibar_g5, grav, k) -end function fg5gkgr -@ -<>= -pure function s_fgr (g, psibar, grav, k) result (j) - complex(kind=default) :: j - complex(kind=default), intent(in) :: g - type(bispinor), intent(in) :: psibar - type(vectorspinor), intent(in) :: grav - type(momentum), intent(in) :: k - type(vector) :: vk - vk = k - j = g * fgkgr (psibar, grav, vk) -end function s_fgr -@ -<>= -pure function p_grf (g, gravbar, psi, k) result (j) - complex(kind=default) :: j - complex(kind=default), intent(in) :: g - type(vectorspinor), intent(in) :: gravbar - type(bispinor), intent(in) :: psi - type(momentum), intent(in) :: k - type(vector) :: vk - vk = k - j = g * grg5vgf (gravbar, psi, vk) -end function p_grf -@ -<>= -pure function p_fgr (g, psibar, grav, k) result (j) - complex(kind=default) :: j - complex(kind=default), intent(in) :: g - type(bispinor), intent(in) :: psibar - type(vectorspinor), intent(in) :: grav - type(momentum), intent(in) :: k - type(vector) :: vk - vk = k - j = g * fg5gkgr (psibar, grav, vk) -end function p_fgr -@ -<>= -public :: f_potgr, f_sgr, f_pgr, f_vgr -@ -<>= -pure function f_potgr (g, phi, psi) result (phipsi) - type(bispinor) :: phipsi - complex(kind=default), intent(in) :: g - complex(kind=default), intent(in) :: phi - type(vectorspinor), intent(in) :: psi - phipsi%a(1) = (g * phi) * (psi%psi(1)%a(3) - psi%psi(2)%a(4) + & - ((0,1)*psi%psi(3)%a(4)) - psi%psi(4)%a(3)) - phipsi%a(2) = (g * phi) * (psi%psi(1)%a(4) - psi%psi(2)%a(3) - & - ((0,1)*psi%psi(3)%a(3)) + psi%psi(4)%a(4)) - phipsi%a(3) = (g * phi) * (psi%psi(1)%a(1) + psi%psi(2)%a(2) - & - ((0,1)*psi%psi(3)%a(2)) + psi%psi(4)%a(1)) - phipsi%a(4) = (g * phi) * (psi%psi(1)%a(2) + psi%psi(2)%a(1) + & - ((0,1)*psi%psi(3)%a(1)) - psi%psi(4)%a(2)) -end function f_potgr -@ -The slashed notation: -\begin{equation} - \fmslash{k} = - \begin{pmatrix} - 0 & 0 & k_- & - k^* \\ - 0 & 0 & - k & k_+ \\ - k_+ & k^* & 0 & 0 \\ - k & k_- & 0 & 0 - \end{pmatrix} , \qquad - \fmslash{k}\gamma_5 = - \begin{pmatrix} - 0 & 0 & k_- & - k^* \\ - 0 & 0 & - k & k_+ \\ - - k_+ & - k^* & 0 & 0 \\ - - k & - k_- & 0 & 0 \end{pmatrix} -\end{equation} -with $k_\pm=k_0\pm k_3$, $k=k_1+\ii k_2$, -$k^*=k_1-\ii k_2$. But note that~$\cdot^*$ is \emph{not} complex -conjugation for complex~$k_\mu$. -\begin{subequations} -\begin{alignat}{2} - \gamma^0 \fmslash{k} &= - \begin{pmatrix} - k_+ & k^* & 0 & 0 \\ - k & k_- & 0 & 0 \\ - 0 & 0 & k_- & - k^* \\ - 0 & 0 & - k & k_+ - \end{pmatrix} , & \qquad - \gamma^0 \fmslash{k} \gamma^5 & = - \begin{pmatrix} - - k_+ & - k^* & 0 & 0 \\ - - k & - k_- & 0 & 0 \\ - 0 & 0 & k_- & - k^* \\ - 0 & 0 & - k & k_+ - \end{pmatrix} \\ - \gamma^1 \fmslash{k} &= - \begin{pmatrix} - k & k_- & 0 & 0 \\ - k_+ & k^* & 0 & 0 \\ - 0 & 0 & k & - k_+ \\ - 0 & 0 & - k_- & k^* - \end{pmatrix}, & \qquad - \gamma^1 \fmslash{k} \gamma^5 & = - \begin{pmatrix} - - k & - k_- & 0 & 0 \\ - - k_+ & - k^* & 0 & 0 \\ - 0 & 0 & k & - k_+ \\ - 0 & 0 & - k_- & k^* - \end{pmatrix} \\ - \gamma^2 \fmslash{k} &= - \begin{pmatrix} - - \ii k & - \ii k_- & 0 & 0 \\ - \ii k_+ & \ii k^* & 0 & 0 \\ - 0 & 0 & - \ii k & \ii k_+ \\ - 0 & 0 & - \ii k_- & \ii k^* - \end{pmatrix}, & \qquad - \gamma^2 \fmslash{k} \gamma^5 & = - \begin{pmatrix} - \ii k & \ii k_- & 0 & 0 \\ - - \ii k_+ & - \ii k^* & 0 & 0 \\ - 0 & 0 & - \ii k & \ii k_+ \\ - 0 & 0 & - \ii k_- & \ii k^* - \end{pmatrix} \\ - \gamma^3 \fmslash{k} &= - \begin{pmatrix} - k_+ & k^* & 0 & 0 \\ - - k & - k_- & 0 & 0 \\ - 0 & 0 & - k_- & k^* \\ - 0 & 0 & - k & k_+ - \end{pmatrix}, & \qquad - \gamma^3 \fmslash{k} \gamma^5 & = - \begin{pmatrix} - - k_+ & - k^* & 0 & 0 \\ - k & k_- & 0 & 0 \\ - 0 & 0 & - k_- & k^* \\ - 0 & 0 & - k & k_+ - \end{pmatrix} -\end{alignat} -\end{subequations} -and -\begin{subequations} -\begin{alignat}{2} - \fmslash{k} \gamma^0&= - \begin{pmatrix} - k_- & - k^* & 0 & 0 \\ - - k & k_+ & 0 & 0 \\ - 0 & 0 & k_+ & k^* \\ - 0 & 0 & k & k_- - \end{pmatrix} , & \qquad - \fmslash{k} \gamma^0 \gamma^5 & = - \begin{pmatrix} - - k_- & k^* & 0 & 0 \\ - k & - k_+ & 0 & 0 \\ - 0 & 0 & k_+ & k^* \\ - 0 & 0 & k & k_- - \end{pmatrix} \\ - \fmslash{k} \gamma^1 &= - \begin{pmatrix} - k^* & - k_- & 0 & 0 \\ - - k_+ & k & 0 & 0 \\ - 0 & 0 & k^* & k_+ \\ - 0 & 0 & k_- & k - \end{pmatrix}, & \qquad - \fmslash{k} \gamma^1 \gamma^5 & = - \begin{pmatrix} - - k^* & k_- & 0 & 0 \\ - k_+ & - k & 0 & 0 \\ - 0 & 0 & k^* & k_+ \\ - 0 & 0 & k_- & k - \end{pmatrix} \\ - \fmslash{k} \gamma^2 &= - \begin{pmatrix} - \ii k^* & \ii k_- & 0 & 0 \\ - - \ii k_+ & - \ii k & 0 & 0 \\ - 0 & 0 & \ii k^* & - \ii k_+ \\ - 0 & 0 & \ii k_- & - \ii k - \end{pmatrix}, & \qquad - \fmslash{k} \gamma^2 \gamma^5 & = - \begin{pmatrix} - - \ii k^* & - \ii k_- & 0 & 0 \\ - \ii k_+ & \ii k & 0 & 0 \\ - 0 & 0 & \ii k^* & - \ii k_+ \\ - 0 & 0 & \ii k_- & - \ii k - \end{pmatrix} \\ - \fmslash{k} \gamma^3 &= - \begin{pmatrix} - - k_- & - k^* & 0 & 0 \\ - k & k_+ & 0 & 0 \\ - 0 & 0 & k_+ & - k^* \\ - 0 & 0 & k & - k_- - \end{pmatrix}, & \qquad - \fmslash{k} \gamma^3 \gamma^5 & = - \begin{pmatrix} - k_- & k^* & 0 & 0 \\ - - k & - k_+ & 0 & 0 \\ - 0 & 0 & k_+ & - k^* \\ - 0 & 0 & k & - k_- - \end{pmatrix} -\end{alignat} -\end{subequations} -and -\begin{subequations} -\begin{alignat}{2} - C \gamma^0 \fmslash{k} &= - \begin{pmatrix} - k & k_- & 0 & 0 \\ - - k_+ & - k^* & 0 & 0 \\ - 0 & 0 & k & - k_+ \\ - 0 & 0 & k_- & - k^* - \end{pmatrix} , & \qquad - C \gamma^0 \fmslash{k} \gamma^5 & = - \begin{pmatrix} - - k & - k_- & 0 & 0 \\ - k_+ & k^* & 0 & 0 \\ - 0 & 0 & k & - k_+ \\ - 0 & 0 & k_- & - k^* - \end{pmatrix} \\ - C \gamma^1 \fmslash{k} &= - \begin{pmatrix} - k_+ & k^* & 0 & 0 \\ - - k & - k_- & 0 & 0 \\ - 0 & 0 & k_- & - k^* \\ - 0 & 0 & k & - k_+ - \end{pmatrix}, & \qquad - C \gamma^1 \fmslash{k} \gamma^5 & = - \begin{pmatrix} - - k_+ & - k^* & 0 & 0 \\ - k & k_- & 0 & 0 \\ - 0 & 0 & k_- & - k^* \\ - 0 & 0 & k & - k_+ - \end{pmatrix} \\ - C \gamma^2 \fmslash{k} &= - \begin{pmatrix} - \ii k_+ & \ii k^* & 0 & 0 \\ - \ii k & \ii k_- & 0 & 0 \\ - 0 & 0 & \ii k_- & - \ii k^* \\ - 0 & 0 & - \ii k & \ii k_+ - \end{pmatrix}, & \qquad - C \gamma^2 \fmslash{k} \gamma^5 & = - \begin{pmatrix} - - \ii k_+ & - \ii k^* & 0 & 0 \\ - - \ii k & - \ii k_- & 0 & 0 \\ - 0 & 0 & \ii k_- & - \ii k^* \\ - 0 & 0 & - \ii k & \ii k_+ - \end{pmatrix} \\ - C \gamma^3 \fmslash{k} &= - \begin{pmatrix} - - k & - k_- & 0 & 0 \\ - - k_+ & - k^* & 0 & 0 \\ - 0 & 0 & k & - k_+ \\ - 0 & 0 & - k_- & k^* - \end{pmatrix}, & \qquad - C \gamma^3 \fmslash{k} \gamma^5 & = - \begin{pmatrix} - k & k_- & 0 & 0 \\ - k_+ & k^* & 0 & 0 \\ - 0 & 0 & k & - k_+ \\ - 0 & 0 & - k_- & k^* - \end{pmatrix} -\end{alignat} -\end{subequations} -and -\begin{subequations} -\begin{alignat}{2} - C \fmslash{k} \gamma^0&= - \begin{pmatrix} - - k & k^+ & 0 & 0 \\ - - k_- & k^* & 0 & 0 \\ - 0 & 0 & - k & - k_- \\ - 0 & 0 & k_+ & k^* - \end{pmatrix} , & \qquad - C \fmslash{k} \gamma^0 \gamma^5 & = - \begin{pmatrix} - k & - k_+ & 0 & 0 \\ - k_- & - k^* & 0 & 0 \\ - 0 & 0 & - k & - k_- \\ - 0 & 0 & k_+ & k^* - \end{pmatrix} \\ - C \fmslash{k} \gamma^1 &= - \begin{pmatrix} - - k_+ & k & 0 & 0 \\ - - k^* & k_- & 0 & 0 \\ - 0 & 0 & - k_- & - k \\ - 0 & 0 & k^* & k_+ - \end{pmatrix}, & \qquad - C \fmslash{k} \gamma^1 \gamma^5 & = - \begin{pmatrix} - k_+ & - k & 0 & 0 \\ - k^* & - k_- & 0 & 0 \\ - 0 & 0 & - k_- & - k \\ - 0 & 0 & k^* & k_+ - \end{pmatrix} \\ - C \fmslash{k} \gamma^2 &= - \begin{pmatrix} - - \ii k_+ & - \ii k & 0 & 0 \\ - - \ii k^* & - \ii k_- & 0 & 0 \\ - 0 & 0 & - \ii k_- & \ii k \\ - 0 & 0 & \ii k^* & - \ii k_+ - \end{pmatrix}, & \qquad - C \fmslash{k} \gamma^2 \gamma^5 & = - \begin{pmatrix} - \ii k_+ & \ii k & 0 & 0 \\ - \ii k^* & \ii k_- & 0 & 0 \\ - 0 & 0 & - \ii k_- & \ii k \\ - 0 & 0 & \ii k^* & - \ii k_+ - \end{pmatrix} \\ - C \fmslash{k} \gamma^3 &= - \begin{pmatrix} - k & k_+ & 0 & 0 \\ - k_- & k^* & 0 & 0 \\ - 0 & 0 & - k & k_- \\ - 0 & 0 & k_+ & - k^* - \end{pmatrix}, & \qquad - C \fmslash{k} \gamma^3 \gamma^5 & = - \begin{pmatrix} - - k & - k_+ & 0 & 0 \\ - - k_- & - k^* & 0 & 0 \\ - 0 & 0 & - k & k_- \\ - 0 & 0 & k_+ & - k^* - \end{pmatrix} -\end{alignat} -\end{subequations} -<>= -pure function fgvgr (psi, k) result (kpsi) - type(bispinor) :: kpsi - complex(kind=default) :: kp, km, k12, k12s - type(vector), intent(in) :: k - type(vectorspinor), intent(in) :: psi - kp = k%t + k%x(3) - km = k%t - k%x(3) - k12 = k%x(1) + (0,1)*k%x(2) - k12s = k%x(1) - (0,1)*k%x(2) - kpsi%a(1) = kp * psi%psi(1)%a(1) + k12s * psi%psi(1)%a(2) & - - k12 * psi%psi(2)%a(1) - km * psi%psi(2)%a(2) & - + (0,1) * k12 * psi%psi(3)%a(1) + (0,1) * km * psi%psi(3)%a(2) & - - kp * psi%psi(4)%a(1) - k12s * psi%psi(4)%a(2) - kpsi%a(2) = k12 * psi%psi(1)%a(1) + km * psi%psi(1)%a(2) & - - kp * psi%psi(2)%a(1) - k12s * psi%psi(2)%a(2) & - - (0,1) * kp * psi%psi(3)%a(1) - (0,1) * k12s * psi%psi(3)%a(2) & - + k12 * psi%psi(4)%a(1) + km * psi%psi(4)%a(2) - kpsi%a(3) = km * psi%psi(1)%a(3) - k12s * psi%psi(1)%a(4) & - - k12 * psi%psi(2)%a(3) + kp * psi%psi(2)%a(4) & - + (0,1) * k12 * psi%psi(3)%a(3) - (0,1) * kp * psi%psi(3)%a(4) & - + km * psi%psi(4)%a(3) - k12s * psi%psi(4)%a(4) - kpsi%a(4) = - k12 * psi%psi(1)%a(3) + kp * psi%psi(1)%a(4) & - + km * psi%psi(2)%a(3) - k12s * psi%psi(2)%a(4) & - + (0,1) * km * psi%psi(3)%a(3) - (0,1) * k12s * psi%psi(3)%a(4) & - + k12 * psi%psi(4)%a(3) - kp * psi%psi(4)%a(4) -end function fgvgr -@ -<>= -pure function f_sgr (g, phi, psi, k) result (phipsi) - type(bispinor) :: phipsi - complex(kind=default), intent(in) :: g - complex(kind=default), intent(in) :: phi - type(momentum), intent(in) :: k - type(vectorspinor), intent(in) :: psi - type(vector) :: vk - vk = k - phipsi = (g * phi) * fgvgr (psi, vk) -end function f_sgr -@ -<>= -pure function fgvg5gr (psi, k) result (kpsi) - type(bispinor) :: kpsi - type(vector), intent(in) :: k - type(vectorspinor), intent(in) :: psi - type(bispinor) :: kpsi_dum - kpsi_dum = fgvgr (psi, k) - kpsi%a(1:2) = - kpsi_dum%a(1:2) - kpsi%a(3:4) = kpsi_dum%a(3:4) -end function fgvg5gr -@ -<>= -pure function f_pgr (g, phi, psi, k) result (phipsi) - type(bispinor) :: phipsi - complex(kind=default), intent(in) :: g - complex(kind=default), intent(in) :: phi - type(momentum), intent(in) :: k - type(vectorspinor), intent(in) :: psi - type(vector) :: vk - vk = k - phipsi = (g * phi) * fgvg5gr (psi, vk) -end function f_pgr -@ -The needed construction of gamma matrices involving the commutator -of two gamma matrices. For the slashed terms we use as usual the -abbreviations $k_\pm=k_0\pm k_3$, $k=k_1+\ii k_2$, $k^*=k_1-\ii k_2$ -and analogous expressions for the vector $v^\mu$. We remind you -that~$\cdot^*$ is \emph{not} complex conjugation for complex~$k_\mu$. -Furthermore we introduce (in what follows the brackets around the vector -indices have the usual meaning of antisymmetrizing with respect to the -indices inside the brackets, here without a factor two in the denominator) -\begin{subequations} -\begin{alignat}{2} - a_+ &= \; k_+ v_- + k v^* - k_- v_+ - k^* v & \; = & - \; 2 (k_{[3} v_{0]} + \ii k_{[2} v_{1]}) \\ - a_- &= \; k_- v_+ + k v^* - k_+ v_- - k^* v & \; = & - \; 2 (-k_{[3} v_{0]} + \ii k_{[2} v_{1]}) \\ - b_+ &= \; 2 (k_+ v - k v_+) & \; = & - \; 2 (k_{[0} v_{1]} + k_{[3} v_{1]} + \ii k_{[0} v_{2]} + \ii - k_{[3} v_{2]}) \\ - b_- &= \; 2 (k_- v - k v_-) & \; = & - \; 2 (k_{[0} v_{1]} - k_{[3} v_{1]} + \ii k_{[0} v_{2]} - \ii - k_{[3} v_{2]}) \\ - b_{+*} &= \; 2 (k_+ v^* - k^* v_+) & \; = & - \; 2 (k_{[0} v_{1]} + k_{[3} v_{1]} - \ii k_{[0} v_{2]} - \ii - k_{[3} v_{2]}) \\ - b_{-*} &= \; 2 (k_- v^* - k^* v_-) & \; = & - \; 2 (k_{[0} v_{1]} - k_{[3} v_{1]} - \ii k_{[0} v_{2]} + \ii - k_{[3} v_{2]}) -\end{alignat} -\end{subequations} -Of course, one could introduce a more advanced notation, but we don't want to -become confused. -\begin{subequations} -\begin{align} -\lbrack \fmslash{k} , \gamma^0 \rbrack &= - \begin{pmatrix} - -2k_3 & -2 k^* & 0 & 0 \\ - -2k & 2k_3 & 0 & 0 \\ - 0 & 0 & 2k_3 & 2k^* \\ - 0 & 0 & 2k & -2k_3 - \end{pmatrix} \\ -\lbrack \fmslash{k} , \gamma^1 \rbrack &= - \begin{pmatrix} - -2\ii k_2 & -2k_- & 0 & 0 \\ - -2k_+ & 2\ii k_2 & 0 & 0 \\ - 0 & 0 & -2\ii k_2 & 2k_+ \\ - 0 & 0 & 2k_- & 2\ii k_2 - \end{pmatrix} \\ -\lbrack \fmslash{k} , \gamma^2 \rbrack &= - \begin{pmatrix} - 2\ii k_1 & 2\ii k_- & 0 & 0 \\ - -2\ii k_+ & -2\ii k_1 & 0 & 0 \\ - 0 & 0 & 2\ii k_1 & -2\ii k_+ \\ - 0 & 0 & 2\ii k_- & -2\ii k_1 - \end{pmatrix} \\ -\lbrack \fmslash{k} , \gamma^3 \rbrack &= - \begin{pmatrix} - -2k_0 & -2k^* & 0 & 0 \\ - 2k & 2k_0 & 0 & 0 \\ - 0 & 0 & 2k_0 & -2k^* \\ - 0 & 0 & 2k & -2k_0 - \end{pmatrix} \\ -\lbrack \fmslash{k} , \fmslash{V} \rbrack &= - \begin{pmatrix} - a_- & b_{-*} & 0 & 0 \\ - b_+ & -a_- & 0 & 0 \\ - 0 & 0 & a_+ & -b_{+*} \\ - 0 & 0 & -b_- & -a_+ - \end{pmatrix} \\ - \gamma^5\gamma^0 \lbrack \fmslash{k} , \fmslash{V} \rbrack &= - \begin{pmatrix} - 0 & 0 & - a_+ & b_{+*} \\ - 0 & 0 & b_- & a_+ \\ - a_- & b_{-*} & 0 & 0 \\ - b_+ & - a_- & 0 & 0 - \end{pmatrix} \\ - \gamma^5\gamma^1 \lbrack \fmslash{k} , \fmslash{V} \rbrack &= - \begin{pmatrix} - 0 & 0 & b_- & a_+ \\ - 0 & 0 & -a_+ & b_{+*} \\ - -b_+ & a_- & 0 & 0 & \\ - -a_- & -b_{-*} & 0 & 0 - \end{pmatrix} \\ - \gamma^5\gamma^2 \lbrack \fmslash{k} , \fmslash{V} \rbrack &= - \begin{pmatrix} - 0 & 0 & -\ii b_- & -\ii a_+ \\ - 0 & 0 & -\ii a_+ & \ii b_{+*} \\ - \ii b_+ & -\ii a_- & 0 & 0 \\ - -\ii a_- & -\ii b_{-*} & 0 & 0 - \end{pmatrix} \\ - \gamma^5\gamma^3 \lbrack \fmslash{k} , \fmslash{V} \rbrack &= - \begin{pmatrix} - 0 & 0 & -a_+ & b_{+*} \\ - 0 & 0 & -b_- & -a_+ \\ - -a_- & -b_{-*} & 0 & 0 \\ - b_+ & -a_- & 0 & 0 - \end{pmatrix} -\end{align} -\end{subequations} -and -\begin{subequations} -\begin{align} - \lbrack \fmslash{k} , \fmslash{V} \rbrack \gamma^0 \gamma^5 &= - \begin{pmatrix} - 0 & 0 & a_- & b_{-*} \\ - 0 & 0 & b_+ & -a_- \\ - -a_+ & b_{+*} & 0 & 0 \\ - b_- & a_+ & 0 & 0 - \end{pmatrix} \\ - \lbrack \fmslash{k} , \fmslash{V} \rbrack \gamma^1 \gamma^5 &= - \begin{pmatrix} - 0 & 0 & b_{-*} & a_- \\ - 0 & 0 & -a_- & b_+ \\ - -b_{+*} & a_+ & 0 & 0 \\ - -a_+ & -b_- & 0 & 0 - \end{pmatrix} \\ - \lbrack \fmslash{k} , \fmslash{V} \rbrack \gamma^2 \gamma^5 &= - \begin{pmatrix} - 0 & 0 & \ii b_{-*} & -\ii a_- \\ - 0 & 0 & -\ii a_- & -\ii b_+ \\ - -\ii b_{+*} & -\ii a_+ & 0 & 0 \\ - -\ii a_+ & \ii b_- & 0 & 0 - \end{pmatrix} \\ - \lbrack \fmslash{k} , \fmslash{V} \rbrack \gamma^3 \gamma^5 &= - \begin{pmatrix} - 0 & 0 & a_- & - b_{-*} \\ - 0 & 0 & b_+ & a_- \\ - a_+ & b_{+*} & 0 & 0 \\ - -b_- & a_+ & 0 & 0 - \end{pmatrix} -\end{align} -\end{subequations} -In what follows $l$ always means twice the value of $k$, e.g. $l_+$ = -$2 k_+$. We use the abbreviation $C^{\mu\nu} \equiv C \lbrack -\fmslash{k}, \gamma^\mu \rbrack \gamma^\nu \gamma^5$. -\begin{subequations} -\begin{alignat}{2} - C^{00} &= \begin{pmatrix} - 0 & 0 & -l & -l_3 \\ 0 & 0 & l_3 & l^* \\ - l & -l_3 & 0 & 0 \\ -l_3 & -l^* & 0 & 0 \end{pmatrix} , & \qquad - C^{20} &= \begin{pmatrix} - 0 & 0 & -\ii l_+ & -\ii l_1 \\ 0 & 0 & -\ii l_1 & -\ii l_- \\ - \ii l_- & -\ii l_1 & 0 & 0 \\ -\ii l_1 & \ii l_+ & 0 & 0 - \end{pmatrix} \\ - C^{01} &= \begin{pmatrix} - 0 & 0 & l_3 & -l \\ 0 & 0 & l^* & l_3 \\ - l_3 & -l & 0 & 0 \\ l^* & l_3 & 0 & 0 \end{pmatrix} , & \qquad - C^{21} &= \begin{pmatrix} - 0 & 0 & -\ii l_1 & -\ii l_+ \\ 0 & 0 & -\ii l_- & -\ii l_1 \\ - \ii l_1 & -\ii l_- & 0 & 0 \\ -\ii l_+ & \ii l_1 & 0 & 0 - \end{pmatrix} \\ - C^{02} &= \begin{pmatrix} - 0 & 0 & \ii l_3 & \ii l \\ 0 & 0 & \ii l^* & -\ii l_3 \\ - \ii l_3 & \ii l & 0 & 0 \\ \ii l^* & -\ii l_3 & 0 & 0 \end{pmatrix} - , & \qquad - C^{22} &= \begin{pmatrix} - 0 & 0 & l_1 & -l_+ \\ 0 & 0 & l_- & -l_1 \\ - -l_1 & -l_- & 0 & 0 \\ l_+ & l_1 & 0 & 0 - \end{pmatrix} \\ - C^{03} &= \begin{pmatrix} - 0 & 0 & -l & -l_3 \\ 0 & 0 & l_3 & -l^* \\ - -l & -l_3 & 0 & 0 \\ l_3 & -l^* & 0 & 0 \end{pmatrix} , & \qquad - C^{23} &= \begin{pmatrix} - 0 & 0 & -\ii l_+ & \ii l_1 \\ 0 & 0 & -\ii l_1 & \ii l_- \\ - -\ii l_- & -\ii l_1 & 0 & 0 \\ \ii l_1 & \ii l_+ & 0 & 0 - \end{pmatrix} \\ - C^{10} &= \begin{pmatrix} - 0 & 0 & -l_+ & \ii l_2 \\ 0 & 0 & \ii l_2 & l_- \\ - l_- & \ii l_2 & 0 & 0 \\ \ii l_2 & -l_+ & 0 & 0 \end{pmatrix} , & - \qquad - C^{30} &= \begin{pmatrix} - 0 & 0 & l & l_0 \\ 0 & 0 & l_0 & l^* \\ - l & -l_0 & 0 & 0 \\ -l_0 & l^* & 0 & 0 - \end{pmatrix} \\ - C^{11} &= \begin{pmatrix} - 0 & 0 & \ii l_2 & -l_+ \\ 0 & 0 & l_- & \ii l_2 \\ - -\ii l_2 & -l_- & 0 & 0 \\ l_+ & -\ii l_2 & 0 & 0 \end{pmatrix} , & - \qquad - C^{31} &= \begin{pmatrix} - 0 & 0 & l_0 & l \\ 0 & 0 & l^* & l_0 \\ - l_0 & -l & 0 & 0 \\ -l^* & l_0 & 0 & 0 - \end{pmatrix} \\ - C^{12} &= \begin{pmatrix} - 0 & 0 & -l_2 & \ii l_+ \\ 0 & 0 & \ii l_- & l_2 \\ - l_2 & \ii l_- & 0 & 0 \\ \ii l_+ & -l_2 & 0 & 0 \end{pmatrix} , & - \qquad - C^{32} &= \begin{pmatrix} - 0 & 0 & \ii l_0 & -\ii l \\ 0 & 0 & \ii l^* & -\ii l_0 \\ - \ii l_0 & \ii l & 0 & 0 \\ -\ii l^* & -\ii l_0 & 0 & 0 - \end{pmatrix} \\ - C^{13} &= \begin{pmatrix} - 0 & 0 & -l_+ & -\ii l_2 \\ 0 & 0 & \ii l_2 & - l_- \\ - -l_- & \ii l_2 & 0 & 0 \\ -\ii l_2 & -l_+ & 0 & 0 \end{pmatrix} , & - \qquad - C^{33} &= \begin{pmatrix} - 0 & 0 & l & -l_0 \\ 0 & 0 & l_0 & -l^* \\ - -l & -l_0 & 0 & 0 \\ l_0 & l^* & 0 & 0 - \end{pmatrix} -\end{alignat} -\end{subequations} -and, with the abbreviation $\tilde{C}^{\mu\nu} \equiv C \gamma^5 -\gamma^\nu \lbrack \fmslash{k} , \gamma^\mu \rbrack$ (note the -reversed order of the indices!) -\begin{subequations} -\begin{alignat}{2} - \tilde{C}^{00} &= \begin{pmatrix} - 0 & 0 & -l & l_3 \\ 0 & 0 & l_3 & l^* \\ - l & -l_3 & 0 & 0 \\ -l_3 & -l^* & 0 & 0 \end{pmatrix} , & \qquad - \tilde{C}^{20} &= \begin{pmatrix} - 0 & 0 & -\ii l_- & \ii l_1 \\ 0 & 0 & \ii l_1 & -\ii l_+ \\ - \ii l_+ & \ii l_1 & 0 & 0 \\ \ii l_1 & \ii l_- & 0 & 0 - \end{pmatrix} \\ - \tilde{C}^{01} &= \begin{pmatrix} - 0 & 0 & -l_3 & -l^* \\ 0 & 0 & l & -l_3 \\ - -l_3 & -l^* & 0 & 0 \\ l & -l_3 & 0 & 0 \end{pmatrix} , & \qquad - \tilde{C}^{21} &= \begin{pmatrix} - 0 & 0 & -\ii l_1 & \ii l_+ \\ 0 & 0 & \ii l_- & -\ii l_1 \\ - \ii l_1 & \ii l_- & 0 & 0 \\ \ii l_+ & \ii l_1 & 0 & 0 - \end{pmatrix} \\ - \tilde{C}^{02} &= \begin{pmatrix} - 0 & 0 & -\ii l_3 & -\ii l^* \\ 0 & 0 & -\ii l & \ii l_3 \\ - -\ii l_3 & -\ii l^* & 0 & 0 \\ -\ii l & \ii l_3 & 0 & 0 - \end{pmatrix} , & \qquad - \tilde{C}^{22} &= \begin{pmatrix} - 0 & 0 & l_1 & -l_+ \\ 0 & 0 & l_- & -l_1 \\ - -l_1 & -l_- & 0 & 0 \\ l_+ & l_1 & 0 & 0 - \end{pmatrix} \\ - \tilde{C}^{03} &= \begin{pmatrix} - 0 & 0 & l & -l_3 \\ 0 & 0 & l_3 & l^* \\ - l & -l_3 & 0 & 0 \\ l_3 & l^* & 0 & 0 \end{pmatrix} , & \qquad - \tilde{C}^{23} &= \begin{pmatrix} - 0 & 0 & \ii l_- & -\ii l_1 \\ 0 & 0 & \ii l_1 & -\ii l_+ \\ - \ii l_+ & \ii l_1 & 0 & 0 \\ -\ii l_1 & -\ii l_- & 0 & 0 - \end{pmatrix} \\ - \tilde{C}^{10} &= \begin{pmatrix} - 0 & 0 & -l_- & -\ii l_2 \\ 0 & 0 & -\ii l_2 & l_+ \\ - l_+ & -\ii l_2 & 0 & 0 \\ -\ii l_2 & -l_- & 0 & 0 \end{pmatrix} , & - \qquad - \tilde{C}^{30} &= \begin{pmatrix} - 0 & 0 & -l & l_0 \\ 0 & 0 & l_0 & -l^* \\ - -l & -l_0 & 0 & 0 \\ -l_0 & -l^* & 0 & 0 - \end{pmatrix} \\ - \tilde{C}^{11} &= \begin{pmatrix} - 0 & 0 & \ii l_2 & -l_+ \\ 0 & 0 & l_- & \ii l_2 \\ - -\ii l_2 & -l_- & 0 & 0 \\ l_+ & -\ii l_2 & 0 & 0 \end{pmatrix} , & - \qquad - \tilde{C}^{31} &= \begin{pmatrix} - 0 & 0 & -l_0 & l^* \\ 0 & 0 & l & -l_0 \\ - -l_0 & -l^* & 0 & 0 \\ -l & -l_0 & 0 & 0 - \end{pmatrix} \\ - \tilde{C}^{12} &= \begin{pmatrix} - 0 & 0 & -l_2 & -\ii l_+ \\ 0 & 0 & -\ii l_- & l_2 \\ - l_2 & -\ii l_- & 0 & 0 \\ -\ii l_+ & -l_2 & 0 & 0 \end{pmatrix} , & - \qquad - \tilde{C}^{32} &= \begin{pmatrix} - 0 & 0 & -\ii l_0 & \ii l^* \\ 0 & 0 & -\ii l & \ii l_0 \\ - -\ii l_0 & -\ii l^* & 0 & 0 \\ \ii l & \ii l_0 & 0 & 0 - \end{pmatrix} \\ - \tilde{C}^{13} &= \begin{pmatrix} - 0 & 0 & l_- & \ii l_2 \\ 0 & 0 & -\ii l_2 & l_+ \\ - l_+ & -\ii l_2 & 0 & 0 \\ \ii l_2 & l_- & 0 & 0 \end{pmatrix} , & - \qquad - \tilde{C}^{33} &= \begin{pmatrix} - 0 & 0 & l & -l_0 \\ 0 & 0 & l_0 & -l^* \\ - -l & -l_0 & 0 & 0 \\ l_0 & l^* & 0 & 0 - \end{pmatrix} -\end{alignat} -\end{subequations} -<>= -pure function fggvvgr (v, psi, k) result (psikv) - type(bispinor) :: psikv - type(vectorspinor), intent(in) :: psi - type(vector), intent(in) :: v, k - complex(kind=default) :: kv30, kv21, kv01, kv31, kv02, kv32 - complex(kind=default) :: ap, am, bp, bm, bps, bms - kv30 = k%x(3) * v%t - k%t * v%x(3) - kv21 = (0,1) * (k%x(2) * v%x(1) - k%x(1) * v%x(2)) - kv01 = k%t * v%x(1) - k%x(1) * v%t - kv31 = k%x(3) * v%x(1) - k%x(1) * v%x(3) - kv02 = (0,1) * (k%t * v%x(2) - k%x(2) * v%t) - kv32 = (0,1) * (k%x(3) * v%x(2) - k%x(2) * v%x(3)) - ap = 2 * (kv30 + kv21) - am = 2 * (-kv30 + kv21) - bp = 2 * (kv01 + kv31 + kv02 + kv32) - bm = 2 * (kv01 - kv31 + kv02 - kv32) - bps = 2 * (kv01 + kv31 - kv02 - kv32) - bms = 2 * (kv01 - kv31 - kv02 + kv32) - psikv%a(1) = -ap * psi%psi(1)%a(3) + bps * psi%psi(1)%a(4) & - - bm * psi%psi(2)%a(3) - ap * psi%psi(2)%a(4) & - + (0,1) * (bm * psi%psi(3)%a(3) + ap * psi%psi(3)%a(4)) & - + ap * psi%psi(4)%a(3) - bps * psi%psi(4)%a(4) - psikv%a(2) = bm * psi%psi(1)%a(3) + ap * psi%psi(1)%a(4) & - + ap * psi%psi(2)%a(3) - bps * psi%psi(2)%a(4) & - + (0,1) * (ap * psi%psi(3)%a(3) - bps * psi%psi(3)%a(4)) & - + bm * psi%psi(4)%a(3) + ap * psi%psi(4)%a(4) - psikv%a(3) = am * psi%psi(1)%a(1) + bms * psi%psi(1)%a(2) & - + bp * psi%psi(2)%a(1) - am * psi%psi(2)%a(2) & - - (0,1) * (bp * psi%psi(3)%a(1) - am * psi%psi(3)%a(2)) & - + am * psi%psi(4)%a(1) + bms * psi%psi(4)%a(2) - psikv%a(4) = bp * psi%psi(1)%a(1) - am * psi%psi(1)%a(2) & - + am * psi%psi(2)%a(1) + bms * psi%psi(2)%a(2) & - + (0,1) * (am * psi%psi(3)%a(1) + bms * psi%psi(3)%a(2)) & - - bp * psi%psi(4)%a(1) + am * psi%psi(4)%a(2) -end function fggvvgr -@ -<>= -pure function f_vgr (g, v, psi, k) result (psikv) - type(bispinor) :: psikv - type(vectorspinor), intent(in) :: psi - type(vector), intent(in) :: v - type(momentum), intent(in) :: k - complex(kind=default), intent(in) :: g - type(vector) :: vk - vk = k - psikv = g * fggvvgr (v, psi, vk) -end function f_vgr -@ -<>= -public :: gr_potf, gr_sf, gr_pf, gr_vf -@ -<>= -pure function gr_potf (g, phi, psi) result (phipsi) - type(vectorspinor) :: phipsi - complex(kind=default), intent(in) :: g - complex(kind=default), intent(in) :: phi - type(bispinor), intent(in) :: psi - phipsi%psi(1)%a(1) = (g * phi) * psi%a(3) - phipsi%psi(1)%a(2) = (g * phi) * psi%a(4) - phipsi%psi(1)%a(3) = (g * phi) * psi%a(1) - phipsi%psi(1)%a(4) = (g * phi) * psi%a(2) - phipsi%psi(2)%a(1) = (g * phi) * psi%a(4) - phipsi%psi(2)%a(2) = (g * phi) * psi%a(3) - phipsi%psi(2)%a(3) = (- g * phi) * psi%a(2) - phipsi%psi(2)%a(4) = (- g * phi) * psi%a(1) - phipsi%psi(3)%a(1) = (- (0, 1) * g * phi) * psi%a(4) - phipsi%psi(3)%a(2) = ((0, 1) * g * phi) * psi%a(3) - phipsi%psi(3)%a(3) = ((0, 1) * g * phi) * psi%a(2) - phipsi%psi(3)%a(4) = (- (0, 1) * g * phi) * psi%a(1) - phipsi%psi(4)%a(1) = (g * phi) * psi%a(3) - phipsi%psi(4)%a(2) = (- g * phi) * psi%a(4) - phipsi%psi(4)%a(3) = (- g * phi) * psi%a(1) - phipsi%psi(4)%a(4) = (g * phi) * psi%a(2) -end function gr_potf -@ -<>= -pure function grkgf (psi, k) result (kpsi) - type(vectorspinor) :: kpsi - complex(kind=default) :: kp, km, k12, k12s - type(bispinor), intent(in) :: psi - type(vector), intent(in) :: k - kp = k%t + k%x(3) - km = k%t - k%x(3) - k12 = k%x(1) + (0,1)*k%x(2) - k12s = k%x(1) - (0,1)*k%x(2) - kpsi%psi(1)%a(1) = km * psi%a(1) - k12s * psi%a(2) - kpsi%psi(1)%a(2) = - k12 * psi%a(1) + kp * psi%a(2) - kpsi%psi(1)%a(3) = kp * psi%a(3) + k12s * psi%a(4) - kpsi%psi(1)%a(4) = k12 * psi%a(3) + km * psi%a(4) - kpsi%psi(2)%a(1) = k12s * psi%a(1) - km * psi%a(2) - kpsi%psi(2)%a(2) = - kp * psi%a(1) + k12 * psi%a(2) - kpsi%psi(2)%a(3) = k12s * psi%a(3) + kp * psi%a(4) - kpsi%psi(2)%a(4) = km * psi%a(3) + k12 * psi%a(4) - kpsi%psi(3)%a(1) = (0,1) * (k12s * psi%a(1) + km * psi%a(2)) - kpsi%psi(3)%a(2) = (0,-1) * (kp * psi%a(1) + k12 * psi%a(2)) - kpsi%psi(3)%a(3) = (0,1) * (k12s * psi%a(3) - kp * psi%a(4)) - kpsi%psi(3)%a(4) = (0,1) * (km * psi%a(3) - k12 * psi%a(4)) - kpsi%psi(4)%a(1) = -(km * psi%a(1) + k12s * psi%a(2)) - kpsi%psi(4)%a(2) = k12 * psi%a(1) + kp * psi%a(2) - kpsi%psi(4)%a(3) = kp * psi%a(3) - k12s * psi%a(4) - kpsi%psi(4)%a(4) = k12 * psi%a(3) - km * psi%a(4) -end function grkgf -@ -<>= -pure function gr_sf (g, phi, psi, k) result (phipsi) - type(vectorspinor) :: phipsi - complex(kind=default), intent(in) :: g - complex(kind=default), intent(in) :: phi - type(bispinor), intent(in) :: psi - type(momentum), intent(in) :: k - type(vector) :: vk - vk = k - phipsi = (g * phi) * grkgf (psi, vk) -end function gr_sf -@ -<>= -pure function grkggf (psi, k) result (kpsi) - type(vectorspinor) :: kpsi - complex(kind=default) :: kp, km, k12, k12s - type(bispinor), intent(in) :: psi - type(vector), intent(in) :: k - kp = k%t + k%x(3) - km = k%t - k%x(3) - k12 = k%x(1) + (0,1)*k%x(2) - k12s = k%x(1) - (0,1)*k%x(2) - kpsi%psi(1)%a(1) = - km * psi%a(1) + k12s * psi%a(2) - kpsi%psi(1)%a(2) = k12 * psi%a(1) - kp * psi%a(2) - kpsi%psi(1)%a(3) = kp * psi%a(3) + k12s * psi%a(4) - kpsi%psi(1)%a(4) = k12 * psi%a(3) + km * psi%a(4) - kpsi%psi(2)%a(1) = - k12s * psi%a(1) + km * psi%a(2) - kpsi%psi(2)%a(2) = kp * psi%a(1) - k12 * psi%a(2) - kpsi%psi(2)%a(3) = k12s * psi%a(3) + kp * psi%a(4) - kpsi%psi(2)%a(4) = km * psi%a(3) + k12 * psi%a(4) - kpsi%psi(3)%a(1) = (0,-1) * (k12s * psi%a(1) + km * psi%a(2)) - kpsi%psi(3)%a(2) = (0,1) * (kp * psi%a(1) + k12 * psi%a(2)) - kpsi%psi(3)%a(3) = (0,1) * (k12s * psi%a(3) - kp * psi%a(4)) - kpsi%psi(3)%a(4) = (0,1) * (km * psi%a(3) - k12 * psi%a(4)) - kpsi%psi(4)%a(1) = km * psi%a(1) + k12s * psi%a(2) - kpsi%psi(4)%a(2) = -(k12 * psi%a(1) + kp * psi%a(2)) - kpsi%psi(4)%a(3) = kp * psi%a(3) - k12s * psi%a(4) - kpsi%psi(4)%a(4) = k12 * psi%a(3) - km * psi%a(4) -end function grkggf -@ -<>= -pure function gr_pf (g, phi, psi, k) result (phipsi) - type(vectorspinor) :: phipsi - complex(kind=default), intent(in) :: g - complex(kind=default), intent(in) :: phi - type(bispinor), intent(in) :: psi - type(momentum), intent(in) :: k - type(vector) :: vk - vk = k - phipsi = (g * phi) * grkggf (psi, vk) -end function gr_pf -@ -<>= -pure function grkkggf (v, psi, k) result (psikv) - type(vectorspinor) :: psikv - type(bispinor), intent(in) :: psi - type(vector), intent(in) :: v, k - complex(kind=default) :: kv30, kv21, kv01, kv31, kv02, kv32 - complex(kind=default) :: ap, am, bp, bm, bps, bms - kv30 = k%x(3) * v%t - k%t * v%x(3) - kv21 = (0,1) * (k%x(2) * v%x(1) - k%x(1) * v%x(2)) - kv01 = k%t * v%x(1) - k%x(1) * v%t - kv31 = k%x(3) * v%x(1) - k%x(1) * v%x(3) - kv02 = (0,1) * (k%t * v%x(2) - k%x(2) * v%t) - kv32 = (0,1) * (k%x(3) * v%x(2) - k%x(2) * v%x(3)) - ap = 2 * (kv30 + kv21) - am = 2 * (-kv30 + kv21) - bp = 2 * (kv01 + kv31 + kv02 + kv32) - bm = 2 * (kv01 - kv31 + kv02 - kv32) - bps = 2 * (kv01 + kv31 - kv02 - kv32) - bms = 2 * (kv01 - kv31 - kv02 + kv32) - psikv%psi(1)%a(1) = am * psi%a(3) + bms * psi%a(4) - psikv%psi(1)%a(2) = bp * psi%a(3) - am * psi%a(4) - psikv%psi(1)%a(3) = -ap * psi%a(1) + bps * psi%a(2) - psikv%psi(1)%a(4) = bm * psi%a(1) + ap * psi%a(2) - psikv%psi(2)%a(1) = bms * psi%a(3) + am * psi%a(4) - psikv%psi(2)%a(2) = -am * psi%a(3) + bp * psi%a(4) - psikv%psi(2)%a(3) = -bps * psi%a(1) + ap * psi%a(2) - psikv%psi(2)%a(4) = -ap * psi%a(1) - bm * psi%a(2) - psikv%psi(3)%a(1) = (0,1) * (bms * psi%a(3) - am * psi%a(4)) - psikv%psi(3)%a(2) = (0,-1) * (am * psi%a(3) + bp * psi%a(4)) - psikv%psi(3)%a(3) = (0,-1) * (bps * psi%a(1) + ap * psi%a(2)) - psikv%psi(3)%a(4) = (0,1) * (-ap * psi%a(1) + bm * psi%a(2)) - psikv%psi(4)%a(1) = am * psi%a(3) - bms * psi%a(4) - psikv%psi(4)%a(2) = bp * psi%a(3) + am * psi%a(4) - psikv%psi(4)%a(3) = ap * psi%a(1) + bps * psi%a(2) - psikv%psi(4)%a(4) = -bm * psi%a(1) + ap * psi%a(2) -end function grkkggf -@ -<>= -pure function gr_vf (g, v, psi, k) result (psikv) - type(vectorspinor) :: psikv - type(bispinor), intent(in) :: psi - type(vector), intent(in) :: v - type(momentum), intent(in) :: k - complex(kind=default), intent(in) :: g - type(vector) :: vk - vk = k - psikv = g * grkkggf (v, psi, vk) -end function gr_vf -@ -<>= -public :: v_grf, v_fgr -@ -$V^\mu = \psi_\rho^T C^{\mu\rho} \psi$ -<>= -pure function grkgggf (psil, psir, k) result (j) - type(vector) :: j - type(vectorspinor), intent(in) :: psil - type(bispinor), intent(in) :: psir - type(vector), intent(in) :: k - type(vectorspinor) :: c_psir0, c_psir1, c_psir2, c_psir3 - complex(kind=default) :: kp, km, k12, k12s, ik2 - kp = k%t + k%x(3) - km = k%t - k%x(3) - k12 = k%x(1) + (0,1)*k%x(2) - k12s = k%x(1) - (0,1)*k%x(2) - ik2 = (0,1) * k%x(2) - !!! New version: - c_psir0%psi(1)%a(1) = - k%x(3) * psir%a(3) - k12s * psir%a(4) - c_psir0%psi(1)%a(2) = - k12 * psir%a(3) + k%x(3) * psir%a(4) - c_psir0%psi(1)%a(3) = - k%x(3) * psir%a(1) - k12s * psir%a(2) - c_psir0%psi(1)%a(4) = - k12 * psir%a(1) + k%x(3) * psir%a(2) - c_psir0%psi(2)%a(1) = - k12s * psir%a(3) - k%x(3) * psir%a(4) - c_psir0%psi(2)%a(2) = k%x(3) * psir%a(3) - k12 * psir%a(4) - c_psir0%psi(2)%a(3) = k12s * psir%a(1) + k%x(3) * psir%a(2) - c_psir0%psi(2)%a(4) = - k%x(3) * psir%a(1) + k12 * psir%a(2) - c_psir0%psi(3)%a(1) = (0,1) * (- k12s * psir%a(3) + k%x(3) * psir%a(4)) - c_psir0%psi(3)%a(2) = (0,1) * (k%x(3) * psir%a(3) + k12 * psir%a(4)) - c_psir0%psi(3)%a(3) = (0,1) * (k12s * psir%a(1) - k%x(3) * psir%a(2)) - c_psir0%psi(3)%a(4) = (0,1) * (- k%x(3) * psir%a(1) - k12 * psir%a(2)) - c_psir0%psi(4)%a(1) = - k%x(3) * psir%a(3) + k12s * psir%a(4) - c_psir0%psi(4)%a(2) = - k12 * psir%a(3) - k%x(3) * psir%a(4) - c_psir0%psi(4)%a(3) = k%x(3) * psir%a(1) - k12s * psir%a(2) - c_psir0%psi(4)%a(4) = k12 * psir%a(1) + k%x(3) * psir%a(2) - !!! - c_psir1%psi(1)%a(1) = - ik2 * psir%a(3) - km * psir%a(4) - c_psir1%psi(1)%a(2) = - kp * psir%a(3) + ik2 * psir%a(4) - c_psir1%psi(1)%a(3) = ik2 * psir%a(1) - kp * psir%a(2) - c_psir1%psi(1)%a(4) = - km * psir%a(1) - ik2 * psir%a(2) - c_psir1%psi(2)%a(1) = - km * psir%a(3) - ik2 * psir%a(4) - c_psir1%psi(2)%a(2) = ik2 * psir%a(3) - kp * psir%a(4) - c_psir1%psi(2)%a(3) = kp * psir%a(1) - ik2 * psir%a(2) - c_psir1%psi(2)%a(4) = ik2 * psir%a(1) + km * psir%a(2) - c_psir1%psi(3)%a(1) = ((0,-1) * km) * psir%a(3) - k%x(2) * psir%a(4) - c_psir1%psi(3)%a(2) = - k%x(2) * psir%a(3) + ((0,1) * kp) * psir%a(4) - c_psir1%psi(3)%a(3) = ((0,1) * kp) * psir%a(1) - k%x(2) * psir%a(2) - c_psir1%psi(3)%a(4) = - k%x(2) * psir%a(1) - ((0,1) * km) * psir%a(2) - c_psir1%psi(4)%a(1) = - ik2 * psir%a(3) + km * psir%a(4) - c_psir1%psi(4)%a(2) = - kp * psir%a(3) - ik2 * psir%a(4) - c_psir1%psi(4)%a(3) = - ik2 * psir%a(1) - kp * psir%a(2) - c_psir1%psi(4)%a(4) = km * psir%a(1) - ik2 * psir%a(2) - !!! - c_psir2%psi(1)%a(1) = (0,1) * (k%x(1) * psir%a(3) + km * psir%a(4)) - c_psir2%psi(1)%a(2) = (0,-1) * (kp * psir%a(3) + k%x(1) * psir%a(4)) - c_psir2%psi(1)%a(3) = (0,1) * (-k%x(1) * psir%a(1) + kp * psir%a(2)) - c_psir2%psi(1)%a(4) = (0,1) * (- km * psir%a(1) + k%x(1) * psir%a(2)) - c_psir2%psi(2)%a(1) = (0,1) * (km * psir%a(3) + k%x(1) * psir%a(4)) - c_psir2%psi(2)%a(2) = (0,-1) * (k%x(1) * psir%a(3) + kp * psir%a(4)) - c_psir2%psi(2)%a(3) = (0,-1) * (kp * psir%a(1) - k%x(1) * psir%a(2)) - c_psir2%psi(2)%a(4) = (0,-1) * (k%x(1) * psir%a(1) - km * psir%a(2)) - c_psir2%psi(3)%a(1) = - km * psir%a(3) + k%x(1) * psir%a(4) - c_psir2%psi(3)%a(2) = k%x(1) * psir%a(3) - kp * psir%a(4) - c_psir2%psi(3)%a(3) = kp * psir%a(1) + k%x(1) * psir%a(2) - c_psir2%psi(3)%a(4) = k%x(1) * psir%a(1) + km * psir%a(2) - c_psir2%psi(4)%a(1) = (0,1) * (k%x(1) * psir%a(3) - km * psir%a(4)) - c_psir2%psi(4)%a(2) = (0,1) * (- kp * psir%a(3) + k%x(1) * psir%a(4)) - c_psir2%psi(4)%a(3) = (0,1) * (k%x(1) * psir%a(1) + kp * psir%a(2)) - c_psir2%psi(4)%a(4) = (0,1) * (km * psir%a(1) + k%x(1) * psir%a(2)) - !!! - c_psir3%psi(1)%a(1) = - k%t * psir%a(3) - k12s * psir%a(4) - c_psir3%psi(1)%a(2) = k12 * psir%a(3) + k%t * psir%a(4) - c_psir3%psi(1)%a(3) = - k%t * psir%a(1) + k12s * psir%a(2) - c_psir3%psi(1)%a(4) = - k12 * psir%a(1) + k%t * psir%a(2) - c_psir3%psi(2)%a(1) = - k12s * psir%a(3) - k%t * psir%a(4) - c_psir3%psi(2)%a(2) = k%t * psir%a(3) + k12 * psir%a(4) - c_psir3%psi(2)%a(3) = - k12s * psir%a(1) + k%t * psir%a(2) - c_psir3%psi(2)%a(4) = - k%t * psir%a(1) + k12 * psir%a(2) - c_psir3%psi(3)%a(1) = (0,-1) * (k12s * psir%a(3) - k%t * psir%a(4)) - c_psir3%psi(3)%a(2) = (0,1) * (k%t * psir%a(3) - k12 * psir%a(4)) - c_psir3%psi(3)%a(3) = (0,-1) * (k12s * psir%a(1) + k%t * psir%a(2)) - c_psir3%psi(3)%a(4) = (0,-1) * (k%t * psir%a(1) + k12 * psir%a(2)) - c_psir3%psi(4)%a(1) = - k%t * psir%a(3) + k12s * psir%a(4) - c_psir3%psi(4)%a(2) = k12 * psir%a(3) - k%t * psir%a(4) - c_psir3%psi(4)%a(3) = k%t * psir%a(1) + k12s * psir%a(2) - c_psir3%psi(4)%a(4) = k12 * psir%a(1) + k%t * psir%a(2) - j%t = 2 * (psil * c_psir0) - j%x(1) = 2 * (psil * c_psir1) - j%x(2) = 2 * (psil * c_psir2) - j%x(3) = 2 * (psil * c_psir3) -end function grkgggf -@ -<>= -pure function v_grf (g, psil, psir, k) result (j) - type(vector) :: j - complex(kind=default), intent(in) :: g - type(vectorspinor), intent(in) :: psil - type(bispinor), intent(in) :: psir - type(momentum), intent(in) :: k - type(vector) :: vk - vk = k - j = g * grkgggf (psil, psir, vk) -end function v_grf -@ -$V^\mu = \psi^T \tilde{C}^{\mu\rho} \psi_\rho$; remember the reversed -index order in $\tilde{C}$. -<>= -pure function fggkggr (psil, psir, k) result (j) - type(vector) :: j - type(vectorspinor), intent(in) :: psir - type(bispinor), intent(in) :: psil - type(vector), intent(in) :: k - type(bispinor) :: c_psir0, c_psir1, c_psir2, c_psir3 - complex(kind=default) :: kp, km, k12, k12s, ik1, ik2 - kp = k%t + k%x(3) - km = k%t - k%x(3) - k12 = k%x(1) + (0,1)*k%x(2) - k12s = k%x(1) - (0,1)*k%x(2) - ik1 = (0,1) * k%x(1) - ik2 = (0,1) * k%x(2) - c_psir0%a(1) = k%x(3) * (psir%psi(1)%a(4) + psir%psi(4)%a(4) & - + psir%psi(2)%a(3) + (0,1) * psir%psi(3)%a(3)) - & - k12 * (psir%psi(1)%a(3) + psir%psi(4)%a(3)) + & - k12s * (psir%psi(2)%a(4) + (0,1) * psir%psi(3)%a(4)) - c_psir0%a(2) = k%x(3) * (psir%psi(1)%a(3) - psir%psi(4)%a(3) + & - psir%psi(2)%a(4) - (0,1) * psir%psi(3)%a(4)) + & - k12s * (psir%psi(1)%a(4) - psir%psi(4)%a(4)) - & - k12 * (psir%psi(2)%a(3) - (0,1) * psir%psi(3)%a(3)) - c_psir0%a(3) = k%x(3) * (-psir%psi(1)%a(2) + psir%psi(4)%a(2) + & - psir%psi(2)%a(1) + (0,1) * psir%psi(3)%a(1)) + & - k12 * (psir%psi(1)%a(1) - psir%psi(4)%a(1)) + & - k12s * (psir%psi(2)%a(2) + (0,1) * psir%psi(3)%a(2)) - c_psir0%a(4) = k%x(3) * (-psir%psi(1)%a(1) - psir%psi(4)%a(1) + & - psir%psi(2)%a(2) - (0,1) * psir%psi(3)%a(2)) - & - k12s * (psir%psi(1)%a(2) + psir%psi(4)%a(2)) - & - k12 * (psir%psi(2)%a(1) - (0,1) * psir%psi(3)%a(1)) - !!! - c_psir1%a(1) = ik2 * (-psir%psi(1)%a(4) - psir%psi(4)%a(4) - & - psir%psi(2)%a(3) - (0,1) * psir%psi(3)%a(3)) - & - km * (psir%psi(1)%a(3) + psir%psi(4)%a(3)) + & - kp * (psir%psi(2)%a(4) + (0,1) * psir%psi(3)%a(4)) - c_psir1%a(2) = ik2 * (-psir%psi(1)%a(3) - psir%psi(2)%a(4) + & - psir%psi(4)%a(3) + (0,1) * psir%psi(3)%a(4)) + & - kp * (psir%psi(1)%a(4) - psir%psi(4)%a(4)) - & - km * (psir%psi(2)%a(3) - (0,1) * psir%psi(3)%a(3)) - c_psir1%a(3) = ik2 * (-psir%psi(1)%a(2) + psir%psi(2)%a(1) + & - psir%psi(4)%a(2) + (0,1) * psir%psi(3)%a(1)) + & - kp * (psir%psi(1)%a(1) - psir%psi(4)%a(1)) + & - km * (psir%psi(2)%a(2) + (0,1) * psir%psi(3)%a(2)) - c_psir1%a(4) = ik2 * (-psir%psi(1)%a(1) + psir%psi(2)%a(2) - & - psir%psi(4)%a(1) - (0,1) * psir%psi(3)%a(2)) - & - km * (psir%psi(1)%a(2) + psir%psi(4)%a(2)) - & - kp * (psir%psi(2)%a(1) - (0,1) * psir%psi(3)%a(1)) - !!! - c_psir2%a(1) = ik1 * (psir%psi(2)%a(3) + psir%psi(1)%a(4) & - + psir%psi(4)%a(4) + (0,1) * psir%psi(3)%a(3)) - & - ((0,1)*km) * (psir%psi(1)%a(3) + psir%psi(4)%a(3)) & - + kp * (psir%psi(3)%a(4) - (0,1) * psir%psi(2)%a(4)) - c_psir2%a(2) = ik1 * (psir%psi(1)%a(3) + psir%psi(2)%a(4) - & - psir%psi(4)%a(3) - (0,1) * psir%psi(3)%a(4)) - & - ((0,1)*kp) * (psir%psi(1)%a(4) - psir%psi(4)%a(4)) & - - km * (psir%psi(3)%a(3) + (0,1) * psir%psi(2)%a(3)) - c_psir2%a(3) = ik1 * (psir%psi(1)%a(2) - psir%psi(2)%a(1) - & - psir%psi(4)%a(2) - (0,1) * psir%psi(3)%a(1)) + & - ((0,1)*kp) * (psir%psi(1)%a(1) - psir%psi(4)%a(1)) & - + km * (psir%psi(3)%a(2) - (0,1) * psir%psi(2)%a(2)) - c_psir2%a(4) = ik1 * (psir%psi(1)%a(1) - psir%psi(2)%a(2) + & - psir%psi(4)%a(1) + (0,1) * psir%psi(3)%a(2)) + & - ((0,1)*km) * (psir%psi(1)%a(2) + psir%psi(4)%a(2)) - & - kp * (psir%psi(3)%a(1) + (0,1) * psir%psi(2)%a(1)) - !!! - c_psir3%a(1) = k%t * (psir%psi(1)%a(4) + psir%psi(4)%a(4) + & - psir%psi(2)%a(3) + (0,1) * psir%psi(3)%a(3)) - & - k12 * (psir%psi(1)%a(3) + psir%psi(4)%a(3)) - & - k12s * (psir%psi(2)%a(4) + (0,1) * psir%psi(3)%a(4)) - c_psir3%a(2) = k%t * (psir%psi(1)%a(3) - psir%psi(4)%a(3) + & - psir%psi(2)%a(4) - (0,1) * psir%psi(3)%a(4)) - & - k12s * (psir%psi(1)%a(4) - psir%psi(4)%a(4)) - & - k12 * (psir%psi(2)%a(3) - (0,1) * psir%psi(3)%a(3)) - c_psir3%a(3) = k%t * (-psir%psi(1)%a(2) + psir%psi(2)%a(1) + & - psir%psi(4)%a(2) + (0,1) * psir%psi(3)%a(1)) - & - k12 * (psir%psi(1)%a(1) - psir%psi(4)%a(1)) + & - k12s * (psir%psi(2)%a(2) + (0,1) * psir%psi(3)%a(2)) - c_psir3%a(4) = k%t * (-psir%psi(1)%a(1) + psir%psi(2)%a(2) - & - psir%psi(4)%a(1) - (0,1) * psir%psi(3)%a(2)) - & - k12s * (psir%psi(1)%a(2) + psir%psi(4)%a(2)) + & - k12 * (psir%psi(2)%a(1) - (0,1) * psir%psi(3)%a(1)) - !!! Because we explicitly multiplied the charge conjugation matrix - !!! we have to omit it from the spinor product and take the - !!! ordinary product! - j%t = 2 * dot_product (conjg (psil%a), c_psir0%a) - j%x(1) = 2 * dot_product (conjg (psil%a), c_psir1%a) - j%x(2) = 2 * dot_product (conjg (psil%a), c_psir2%a) - j%x(3) = 2 * dot_product (conjg (psil%a), c_psir3%a) -end function fggkggr -@ -<>= -pure function v_fgr (g, psil, psir, k) result (j) - type(vector) :: j - complex(kind=default), intent(in) :: g - type(vectorspinor), intent(in) :: psir - type(bispinor), intent(in) :: psil - type(momentum), intent(in) :: k - type(vector) :: vk - vk = k - j = g * fggkggr (psil, psir, vk) -end function v_fgr -@ \subsection{Gravitino 4-Couplings} -<>= -public :: f_s2gr, f_svgr, f_pvgr, f_v2gr -@ -<>= -pure function f_s2gr (g, phi1, phi2, psi) result (phipsi) - type(bispinor) :: phipsi - type(vectorspinor), intent(in) :: psi - complex(kind=default), intent(in) :: g - complex(kind=default), intent(in) :: phi1, phi2 - phipsi = phi2 * f_potgr (g, phi1, psi) -end function f_s2gr -@ -<>= -pure function f_svgr (g, phi, v, grav) result (phigrav) - type(bispinor) :: phigrav - type(vectorspinor), intent(in) :: grav - type(vector), intent(in) :: v - complex(kind=default), intent(in) :: g, phi - phigrav = (g * phi) * fgvg5gr (grav, v) -end function f_svgr -@ -<>= -pure function f_pvgr (g, phi, v, grav) result (phigrav) - type(bispinor) :: phigrav - type(vectorspinor), intent(in) :: grav - type(vector), intent(in) :: v - complex(kind=default), intent(in) :: g, phi - phigrav = (g * phi) * fgvgr (grav, v) -end function f_pvgr -@ -<>= -pure function f_v2gr (g, v1, v2, grav) result (psi) - type(bispinor) :: psi - complex(kind=default), intent(in) :: g - type(vectorspinor), intent(in) :: grav - type(vector), intent(in) :: v1, v2 - psi = g * fggvvgr (v2, grav, v1) -end function f_v2gr -@ -<>= -public :: gr_s2f, gr_svf, gr_pvf, gr_v2f -@ -<>= -pure function gr_s2f (g, phi1, phi2, psi) result (phipsi) - type(vectorspinor) :: phipsi - type(bispinor), intent(in) :: psi - complex(kind=default), intent(in) :: g - complex(kind=default), intent(in) :: phi1, phi2 - phipsi = phi2 * gr_potf (g, phi1, psi) -end function gr_s2f -@ -<>= -pure function gr_svf (g, phi, v, psi) result (phipsi) - type(vectorspinor) :: phipsi - type(bispinor), intent(in) :: psi - type(vector), intent(in) :: v - complex(kind=default), intent(in) :: g, phi - phipsi = (g * phi) * grkggf (psi, v) -end function gr_svf -@ -<>= -pure function gr_pvf (g, phi, v, psi) result (phipsi) - type(vectorspinor) :: phipsi - type(bispinor), intent(in) :: psi - type(vector), intent(in) :: v - complex(kind=default), intent(in) :: g, phi - phipsi = (g * phi) * grkgf (psi, v) -end function gr_pvf -@ -<>= -pure function gr_v2f (g, v1, v2, psi) result (vvpsi) - type(vectorspinor) :: vvpsi - complex(kind=default), intent(in) :: g - type(bispinor), intent(in) :: psi - type(vector), intent(in) :: v1, v2 - vvpsi = g * grkkggf (v2, psi, v1) -end function gr_v2f -@ -<>= -public :: s2_grf, s2_fgr, sv1_grf, sv2_grf, sv1_fgr, sv2_fgr, & - pv1_grf, pv2_grf, pv1_fgr, pv2_fgr, v2_grf, v2_fgr -@ -<>= -pure function s2_grf (g, gravbar, phi, psi) result (j) - complex(kind=default) :: j - complex(kind=default), intent(in) :: g, phi - type(vectorspinor), intent(in) :: gravbar - type(bispinor), intent(in) :: psi - j = phi * pot_grf (g, gravbar, psi) -end function s2_grf -@ -<>= -pure function s2_fgr (g, psibar, phi, grav) result (j) - complex(kind=default) :: j - complex(kind=default), intent(in) :: g, phi - type(bispinor), intent(in) :: psibar - type(vectorspinor), intent(in) :: grav - j = phi * pot_fgr (g, psibar, grav) -end function s2_fgr -@ -<>= -pure function sv1_grf (g, gravbar, v, psi) result (j) - complex(kind=default) :: j - complex(kind=default), intent(in) :: g - type(vectorspinor), intent(in) :: gravbar - type(bispinor), intent(in) :: psi - type(vector), intent(in) :: v - j = g * grg5vgf (gravbar, psi, v) -end function sv1_grf -@ -\begin{subequations} -\begin{align} - C \gamma^0 \gamma^0 = - C \gamma^1 \gamma^1 = - C \gamma^2 \gamma^2 - = C \gamma^3 \gamma^3 = C &= \begin{pmatrix} - 0 & 1 & 0 & 0 \\ -1 & 0 & 0 & 0 \\ 0 & 0 & 0 & -1 \\ 0 & 0 & 1 & 0 - \end{pmatrix} \\ - C \gamma^0 \gamma^1 = - C \gamma^1 \gamma^0 &= \begin{pmatrix} - -1 & 0 & 0 & 0 \\ 0 & 1 & 0 & 0 \\ 0 & 0 & -1 & 0 \\ 0 & 0 & 0 & 1 - \end{pmatrix} \\ - C \gamma^0 \gamma^2 = - C \gamma^2 \gamma^0 &= \begin{pmatrix} - -\ii & 0 & 0 & 0 \\ 0 & -\ii & 0 & 0 \\ 0 & 0 & -\ii & 0 \\ 0 & 0 & - 0 & -\ii \end{pmatrix} \\ - C \gamma^0 \gamma^3 = - C \gamma^3 \gamma^0 &= \begin{pmatrix} - 0 & 1 & 0 & 0 \\ 1 & 0 & 0 & 0 \\ 0 & 0 & 0 & 1 \\ 0 & 0 & 1 & 0 - \end{pmatrix} \\ - C \gamma^1 \gamma^2 = - C \gamma^2 \gamma^1 &= \begin{pmatrix} - 0 & \ii & 0 & 0 \\ \ii & 0 & 0 & 0 \\ 0 & 0 & 0 & -\ii \\ 0 & 0 & - -\ii & 0 \end{pmatrix} \\ - C \gamma^1 \gamma^3 = - C \gamma^3 \gamma^1 &= \begin{pmatrix} - -1 & 0 & 0 & 0 \\ 0 & -1 & 0 & 0 \\ 0 & 0 & 1 & 0 \\ 0 & 0 & 0 & 1 - \end{pmatrix} \\ - C \gamma^2 \gamma^3 = - C \gamma^3 \gamma^2 &= \begin{pmatrix} - -\ii & 0 & 0 & 0 \\ 0 & \ii & 0 & 0 \\ 0 & 0 & \ii & 0 \\ 0 & 0 & 0 - & -\ii \end{pmatrix} -\end{align} -\end{subequations} -@ -<>= -pure function sv2_grf (g, gravbar, phi, psi) result (j) - type(vector) :: j - complex(kind=default), intent(in) :: g, phi - type(vectorspinor), intent(in) :: gravbar - type(bispinor), intent(in) :: psi - type(vectorspinor) :: g0_psi, g1_psi, g2_psi, g3_psi - g0_psi%psi(1)%a(1:2) = - psi%a(1:2) - g0_psi%psi(1)%a(3:4) = psi%a(3:4) - g0_psi%psi(2)%a(1) = psi%a(2) - g0_psi%psi(2)%a(2) = psi%a(1) - g0_psi%psi(2)%a(3) = psi%a(4) - g0_psi%psi(2)%a(4) = psi%a(3) - g0_psi%psi(3)%a(1) = (0,-1) * psi%a(2) - g0_psi%psi(3)%a(2) = (0,1) * psi%a(1) - g0_psi%psi(3)%a(3) = (0,-1) * psi%a(4) - g0_psi%psi(3)%a(4) = (0,1) * psi%a(3) - g0_psi%psi(4)%a(1) = psi%a(1) - g0_psi%psi(4)%a(2) = - psi%a(2) - g0_psi%psi(4)%a(3) = psi%a(3) - g0_psi%psi(4)%a(4) = - psi%a(4) - g1_psi%psi(1)%a(1:4) = - g0_psi%psi(2)%a(1:4) - g1_psi%psi(2)%a(1:4) = - g0_psi%psi(1)%a(1:4) - g1_psi%psi(3)%a(1) = (0,1) * psi%a(1) - g1_psi%psi(3)%a(2) = (0,-1) * psi%a(2) - g1_psi%psi(3)%a(3) = (0,-1) * psi%a(3) - g1_psi%psi(3)%a(4) = (0,1) * psi%a(4) - g1_psi%psi(4)%a(1) = - psi%a(2) - g1_psi%psi(4)%a(2) = psi%a(1) - g1_psi%psi(4)%a(3) = psi%a(4) - g1_psi%psi(4)%a(4) = - psi%a(3) - g2_psi%psi(1)%a(1:4) = - g0_psi%psi(3)%a(1:4) - g2_psi%psi(2)%a(1:4) = - g1_psi%psi(3)%a(1:4) - g2_psi%psi(3)%a(1:4) = - g0_psi%psi(1)%a(1:4) - g2_psi%psi(4)%a(1) = (0,1) * psi%a(2) - g2_psi%psi(4)%a(2) = (0,1) * psi%a(1) - g2_psi%psi(4)%a(3) = (0,-1) * psi%a(4) - g2_psi%psi(4)%a(4) = (0,-1) * psi%a(3) - g3_psi%psi(1)%a(1:4) = - g0_psi%psi(4)%a(1:4) - g3_psi%psi(2)%a(1:4) = - g1_psi%psi(4)%a(1:4) - g3_psi%psi(3)%a(1:4) = - g2_psi%psi(4)%a(1:4) - g3_psi%psi(4)%a(1:4) = - g0_psi%psi(1)%a(1:4) - j%t = (g * phi) * (gravbar * g0_psi) - j%x(1) = (g * phi) * (gravbar * g1_psi) - j%x(2) = (g * phi) * (gravbar * g2_psi) - j%x(3) = (g * phi) * (gravbar * g3_psi) -end function sv2_grf -@ -<>= -pure function sv1_fgr (g, psibar, v, grav) result (j) - complex(kind=default) :: j - complex(kind=default), intent(in) :: g - type(bispinor), intent(in) :: psibar - type(vectorspinor), intent(in) :: grav - type(vector), intent(in) :: v - j = g * fg5gkgr (psibar, grav, v) -end function sv1_fgr -@ -<>= -pure function sv2_fgr (g, psibar, phi, grav) result (j) - type(vector) :: j - complex(kind=default), intent(in) :: g, phi - type(bispinor), intent(in) :: psibar - type(vectorspinor), intent(in) :: grav - type(bispinor) :: g0_grav, g1_grav, g2_grav, g3_grav - g0_grav%a(1) = -grav%psi(1)%a(1) + grav%psi(2)%a(2) - & - (0,1) * grav%psi(3)%a(2) + grav%psi(4)%a(1) - g0_grav%a(2) = -grav%psi(1)%a(2) + grav%psi(2)%a(1) + & - (0,1) * grav%psi(3)%a(1) - grav%psi(4)%a(2) - g0_grav%a(3) = grav%psi(1)%a(3) + grav%psi(2)%a(4) - & - (0,1) * grav%psi(3)%a(4) + grav%psi(4)%a(3) - g0_grav%a(4) = grav%psi(1)%a(4) + grav%psi(2)%a(3) + & - (0,1) * grav%psi(3)%a(3) - grav%psi(4)%a(4) - !!! - g1_grav%a(1) = grav%psi(1)%a(2) - grav%psi(2)%a(1) + & - (0,1) * grav%psi(3)%a(1) - grav%psi(4)%a(2) - g1_grav%a(2) = grav%psi(1)%a(1) - grav%psi(2)%a(2) - & - (0,1) * grav%psi(3)%a(2) + grav%psi(4)%a(1) - g1_grav%a(3) = grav%psi(1)%a(4) + grav%psi(2)%a(3) - & - (0,1) * grav%psi(3)%a(3) + grav%psi(4)%a(4) - g1_grav%a(4) = grav%psi(1)%a(3) + grav%psi(2)%a(4) + & - (0,1) * grav%psi(3)%a(4) - grav%psi(4)%a(3) - !!! - g2_grav%a(1) = (0,1) * (-grav%psi(1)%a(2) - grav%psi(2)%a(1) + & - grav%psi(4)%a(2)) - grav%psi(3)%a(1) - g2_grav%a(2) = (0,1) * (grav%psi(1)%a(1) + grav%psi(2)%a(2) + & - grav%psi(4)%a(1)) - grav%psi(3)%a(2) - g2_grav%a(3) = (0,1) * (-grav%psi(1)%a(4) + grav%psi(2)%a(3) - & - grav%psi(4)%a(4)) + grav%psi(3)%a(3) - g2_grav%a(4) = (0,1) * (grav%psi(1)%a(3) - grav%psi(2)%a(4) - & - grav%psi(4)%a(3)) + grav%psi(3)%a(4) - !!! - g3_grav%a(1) = -grav%psi(1)%a(2) + grav%psi(2)%a(2) - & - (0,1) * grav%psi(3)%a(2) - grav%psi(4)%a(1) - g3_grav%a(2) = grav%psi(1)%a(1) - grav%psi(2)%a(1) - & - (0,1) * grav%psi(3)%a(1) - grav%psi(4)%a(2) - g3_grav%a(3) = -grav%psi(1)%a(2) - grav%psi(2)%a(4) + & - (0,1) * grav%psi(3)%a(4) + grav%psi(4)%a(3) - g3_grav%a(4) = -grav%psi(1)%a(4) + grav%psi(2)%a(3) + & - (0,1) * grav%psi(3)%a(3) + grav%psi(4)%a(4) - j%t = (g * phi) * (psibar * g0_grav) - j%x(1) = (g * phi) * (psibar * g1_grav) - j%x(2) = (g * phi) * (psibar * g2_grav) - j%x(3) = (g * phi) * (psibar * g3_grav) -end function sv2_fgr -@ -<>= -pure function pv1_grf (g, gravbar, v, psi) result (j) - complex(kind=default) :: j - complex(kind=default), intent(in) :: g - type(vectorspinor), intent(in) :: gravbar - type(bispinor), intent(in) :: psi - type(vector), intent(in) :: v - j = g * grvgf (gravbar, psi, v) -end function pv1_grf -@ -<>= -pure function pv2_grf (g, gravbar, phi, psi) result (j) - type(vector) :: j - complex(kind=default), intent(in) :: g, phi - type(vectorspinor), intent(in) :: gravbar - type(bispinor), intent(in) :: psi - type(bispinor) :: g5_psi - g5_psi%a(1:2) = - psi%a(1:2) - g5_psi%a(3:4) = psi%a(3:4) - j = sv2_grf (g, gravbar, phi, g5_psi) -end function pv2_grf -@ -<>= -pure function pv1_fgr (g, psibar, v, grav) result (j) - complex(kind=default) :: j - complex(kind=default), intent(in) :: g - type(bispinor), intent(in) :: psibar - type(vectorspinor), intent(in) :: grav - type(vector), intent(in) :: v - j = g * fgkgr (psibar, grav, v) -end function pv1_fgr -@ -<>= -pure function pv2_fgr (g, psibar, phi, grav) result (j) - type(vector) :: j - complex(kind=default), intent(in) :: g, phi - type(vectorspinor), intent(in) :: grav - type(bispinor), intent(in) :: psibar - type(bispinor) :: psibar_g5 - psibar_g5%a(1:2) = - psibar%a(1:2) - psibar_g5%a(3:4) = psibar%a(3:4) - j = sv2_fgr (g, psibar_g5, phi, grav) -end function pv2_fgr -@ -<>= -pure function v2_grf (g, gravbar, v, psi) result (j) - type(vector) :: j - complex(kind=default), intent(in) :: g - type(vectorspinor), intent(in) :: gravbar - type(bispinor), intent(in) :: psi - type(vector), intent(in) :: v - j = -g * grkgggf (gravbar, psi, v) -end function v2_grf -@ -<>= -pure function v2_fgr (g, psibar, v, grav) result (j) - type(vector) :: j - complex(kind=default), intent(in) :: g - type(vectorspinor), intent(in) :: grav - type(bispinor), intent(in) :: psibar - type(vector), intent(in) :: v - j = -g * fggkggr (psibar, grav, v) -end function v2_fgr -@ \subsection{On Shell Wave Functions} -<>= -public :: u, v, ghost -@ -\begin{subequations} -\begin{align} - \chi_+(\vec p) &= - \frac{1}{\sqrt{2|\vec p|(|\vec p|+p_3)}} - \begin{pmatrix} |\vec p|+p_3 \\ p_1 + \ii p_2 \end{pmatrix} \\ - \chi_-(\vec p) &= - \frac{1}{\sqrt{2|\vec p|(|\vec p|+p_3)}} - \begin{pmatrix} - p_1 + \ii p_2 \\ |\vec p|+p_3 \end{pmatrix} -\end{align} -\end{subequations} -@ -\begin{equation} - u_\pm(p) = - \begin{pmatrix} - \sqrt{p_0\mp|\vec p|} \cdot \chi_\pm(\vec p) \\ - \sqrt{p_0\pm|\vec p|} \cdot \chi_\pm(\vec p) - \end{pmatrix} -\end{equation} -<>= -pure function u (m, p, s) result (psi) - type(bispinor) :: psi - real(kind=default), intent(in) :: m - type(momentum), intent(in) :: p - integer, intent(in) :: s - complex(kind=default), dimension(2) :: chip, chim - real(kind=default) :: pabs, norm - pabs = sqrt (dot_product (p%x, p%x)) - if (pabs + p%x(3) <= 1000 * epsilon (pabs) * pabs) then -!!! OLD VERSION !!!!!! -!!! if (1 + p%x(3) / pabs <= epsilon (pabs)) then -!!!!!!!!!!!!!!!!!!!!!! - chip = (/ cmplx ( 0.0, 0.0, kind=default), & - cmplx ( 1.0, 0.0, kind=default) /) - chim = (/ cmplx (-1.0, 0.0, kind=default), & - cmplx ( 0.0, 0.0, kind=default) /) - else - norm = 1 / sqrt (2*pabs*(pabs + p%x(3))) - chip = norm * (/ cmplx (pabs + p%x(3), kind=default), & - cmplx (p%x(1), p%x(2), kind=default) /) - chim = norm * (/ cmplx (-p%x(1), p%x(2), kind=default), & - cmplx (pabs + p%x(3), kind=default) /) - end if - if (s > 0) then - psi%a(1:2) = sqrt (max (p%t - pabs, 0.0_default)) * chip - psi%a(3:4) = sqrt (p%t + pabs) * chip - else - psi%a(1:2) = sqrt (p%t + pabs) * chim - psi%a(3:4) = sqrt (max (p%t - pabs, 0.0_default)) * chim - end if - pabs = m ! make the compiler happy and use m -end function u -!pure function u (m, p, s) result (psi) -! type(bispinor) :: psi -! real(kind=default), intent(in) :: m -! type(momentum), intent(in) :: p -! integer, intent(in) :: s -! complex(kind=default), dimension(2) :: chip, chim -! real(kind=default) :: pabs, norm -! pabs = sqrt (dot_product (p%x, p%x)) -! if (p%x(3) <= epsilon(p%x(3))) then -! chip = (/ cmplx ( 0.0, 0.0, kind=default), & -! cmplx ( 1.0, 0.0, kind=default) /) -! chim = (/ cmplx (-1.0, 0.0, kind=default), & -! cmplx ( 0.0, 0.0, kind=default) /) -! else -! if (1 + p%x(3) / pabs <= epsilon (pabs)) then -! chip = (/ cmplx ( 0.0, 0.0, kind=default), & -! cmplx ( 1.0, 0.0, kind=default) /) -! chim = (/ cmplx (-1.0, 0.0, kind=default), & -! cmplx ( 0.0, 0.0, kind=default) /) -! else -! norm = 1 / sqrt (2*pabs*(pabs + p%x(3))) -! chip = norm * (/ cmplx (pabs + p%x(3), kind=default), & -! cmplx (p%x(1), p%x(2), kind=default) /) -! chim = norm * (/ cmplx (-p%x(1), p%x(2), kind=default), & -! cmplx (pabs + p%x(3), kind=default) /) -! end if -! end if -! if (s > 0) then -! psi%a(1:2) = sqrt (max (p%t - pabs, 0.0_default)) * chip -! psi%a(3:4) = sqrt (p%t + pabs) * chip -! else -! psi%a(1:2) = sqrt (p%t + pabs) * chim -! psi%a(3:4) = sqrt (max (p%t - pabs, 0.0_default)) * chim -! end if -! pabs = m ! make the compiler happy and use m -!end function u -@ -\begin{equation} - v_\pm(p) = - \begin{pmatrix} - \mp\sqrt{p_0\pm|\vec p|} \cdot \chi_\mp(\vec p) \\ - \pm\sqrt{p_0\mp|\vec p|} \cdot \chi_\mp(\vec p) - \end{pmatrix} -\end{equation} -<>= -pure function v (m, p, s) result (psi) - type(bispinor) :: psi - real(kind=default), intent(in) :: m - type(momentum), intent(in) :: p - integer, intent(in) :: s - complex(kind=default), dimension(2) :: chip, chim - real(kind=default) :: pabs, norm - pabs = sqrt (dot_product (p%x, p%x)) - if (pabs + p%x(3) <= 1000 * epsilon (pabs) * pabs) then -!!! OLD VERSION !!!!!! -!!! if (1 + p%x(3) / pabs <= epsilon (pabs)) then -!!!!!!!!!!!!!!!!!!!!!! - chip = (/ cmplx ( 0.0, 0.0, kind=default), & - cmplx ( 1.0, 0.0, kind=default) /) - chim = (/ cmplx (-1.0, 0.0, kind=default), & - cmplx ( 0.0, 0.0, kind=default) /) - else - norm = 1 / sqrt (2*pabs*(pabs + p%x(3))) - chip = norm * (/ cmplx (pabs + p%x(3), kind=default), & - cmplx (p%x(1), p%x(2), kind=default) /) - chim = norm * (/ cmplx (-p%x(1), p%x(2), kind=default), & - cmplx (pabs + p%x(3), kind=default) /) - end if - if (s > 0) then - psi%a(1:2) = - sqrt (p%t + pabs) * chim - psi%a(3:4) = sqrt (max (p%t - pabs, 0.0_default)) * chim - else - psi%a(1:2) = sqrt (max (p%t - pabs, 0.0_default)) * chip - psi%a(3:4) = - sqrt (p%t + pabs) * chip - end if - pabs = m ! make the compiler happy and use m -end function v -!pure function v (m, p, s) result (psi) -! type(bispinor) :: psi -! real(kind=default), intent(in) :: m -! type(momentum), intent(in) :: p -! integer, intent(in) :: s -! complex(kind=default), dimension(2) :: chip, chim -! real(kind=default) :: pabs, norm -! pabs = sqrt (dot_product (p%x, p%x)) -! if (p%x(3) <= epsilon (p%x(3))) then -! chip = (/ cmplx ( 1.0, 0.0, kind=default), & -! cmplx ( 0.0, 0.0, kind=default) /) -! chim = (/ cmplx ( 0.0, 0.0, kind=default), & -! cmplx ( 1.0, 0.0, kind=default) /) -! else -! if (1 + p%x(3) / pabs <= epsilon (pabs)) then -! chip = (/ cmplx ( 0.0, 0.0, kind=default), & -! cmplx ( 1.0, 0.0, kind=default) /) -! chim = (/ cmplx (-1.0, 0.0, kind=default), & -! cmplx ( 0.0, 0.0, kind=default) /) -! else -! norm = 1 / sqrt (2*pabs*(pabs + p%x(3))) -! chip = norm * (/ cmplx (pabs + p%x(3), kind=default), & -! cmplx (p%x(1), p%x(2), kind=default) /) -! chim = norm * (/ cmplx (-p%x(1), p%x(2), kind=default), & -! cmplx (pabs + p%x(3), kind=default) /) -! end if -! end if -! if (s > 0) then -! psi%a(1:2) = - sqrt (p%t + pabs) * chim -! psi%a(3:4) = sqrt (max (p%t - pabs, 0.0_default)) * chim -! else -! psi%a(1:2) = sqrt (max (p%t - pabs, 0.0_default)) * chip -! psi%a(3:4) = - sqrt (p%t + pabs) * chip -! end if -! pabs = m ! make the compiler happy and use m -!end function v -@ -<>= -pure function ghost (m, p, s) result (psi) - type(bispinor) :: psi - real(kind=default), intent(in) :: m - type(momentum), intent(in) :: p - integer, intent(in) :: s - psi%a(:) = 0 - select case (s) - case (1) - psi%a(1) = 1 - psi%a(2:4) = 0 - case (2) - psi%a(1) = 0 - psi%a(2) = 1 - psi%a(3:4) = 0 - case (3) - psi%a(1:2) = 0 - psi%a(3) = 1 - psi%a(4) = 0 - case (4) - psi%a(1:3) = 0 - psi%a(4) = 1 - case (5) - psi%a(1) = 1.4 - psi%a(2) = - 2.3 - psi%a(3) = - 71.5 - psi%a(4) = 0.1 - end select -end function ghost -@ - \subsection{Off Shell Wave Functions} -This is the same as for the Dirac fermions except that the expressions for -[ubar] and [vbar] are missing. -<>= -public :: brs_u, brs_v -@ -In momentum space we have: -\begin{equation} -brs u(p)=(-i) (\fmslash p-m)u(p) -\end{equation} -<>= -pure function brs_u (m, p, s) result (dpsi) - type(bispinor) :: dpsi, psi - real(kind=default), intent(in) :: m - type(momentum), intent(in) :: p - integer, intent(in) :: s - type (vector)::vp - complex(kind=default), parameter :: one = (1, 0) - vp=p - psi=u(m,p,s) - dpsi=cmplx(0.0,-1.0)*(f_vf(one,vp,psi)-m*psi) -end function brs_u -@ -\begin{equation} -brs v(p)=i (\fmslash p+m)v(p) -\end{equation} -<>= -pure function brs_v (m, p, s) result (dpsi) - type(bispinor) :: dpsi, psi - real(kind=default), intent(in) :: m - type(momentum), intent(in) :: p - integer, intent(in) :: s - type (vector)::vp - complex(kind=default), parameter :: one = (1, 0) - vp=p - psi=v(m,p,s) - dpsi=cmplx(0.0,1.0)*(f_vf(one,vp,psi)+m*psi) -end function brs_v -@ \subsection{Propagators} -<>= -public :: pr_psi, pr_grav -public :: pj_psi, pg_psi -@ -\begin{equation} - \frac{\ii(-\fmslash{p}+m)}{p^2-m^2+\ii m\Gamma}\psi -\end{equation} -NB: the sign of the momentum comes about because all momenta are -treated as \emph{outgoing} and the particle charge flow is therefore -opposite to the momentum. -<>= -pure function pr_psi (p, m, w, psi) result (ppsi) - type(bispinor) :: ppsi - type(momentum), intent(in) :: p - real(kind=default), intent(in) :: m, w - type(bispinor), intent(in) :: psi - type(vector) :: vp - complex(kind=default), parameter :: one = (1, 0) - vp = p - ppsi = (1 / cmplx (p*p - m**2, m*w, kind=default)) & - * (- f_vf (one, vp, psi) + m * psi) -end function pr_psi -@ -\begin{equation} - \sqrt{\frac{\pi}{M\Gamma}} - (-\fmslash{p}+m)\psi -\end{equation} -<>= -pure function pj_psi (p, m, w, psi) result (ppsi) - type(bispinor) :: ppsi - type(momentum), intent(in) :: p - real(kind=default), intent(in) :: m, w - type(bispinor), intent(in) :: psi - type(vector) :: vp - complex(kind=default), parameter :: one = (1, 0) - vp = p - ppsi = (0, -1) * sqrt (PI / m / w) * (- f_vf (one, vp, psi) + m * psi) -end function pj_psi -@ -<>= -pure function pg_psi (p, m, w, psi) result (ppsi) - type(bispinor) :: ppsi - type(momentum), intent(in) :: p - real(kind=default), intent(in) :: m, w - type(bispinor), intent(in) :: psi - type(vector) :: vp - complex(kind=default), parameter :: one = (1, 0) - vp = p - ppsi = gauss (p*p, m, w) * (- f_vf (one, vp, psi) + m * psi) -end function pg_psi -@ -\begin{equation} - \dfrac{\ii\biggl\{(-\fmslash{p} + m)\left(-\eta_{\mu\nu} + \dfrac{p_\mu - p_\nu}{m^2}\right) + \dfrac{1}{3} \left(\gamma_\mu -\dfrac{p_\mu}{m}\right) - (\fmslash{p} + m)\left(\gamma_\nu - - \dfrac{p_\nu}{m}\right)\biggr\}}{p^2 - m^2 + \ii m - \Gamma} \; \psi^\nu -\end{equation} -<>= -pure function pr_grav (p, m, w, grav) result (propgrav) - type(vectorspinor) :: propgrav - type(momentum), intent(in) :: p - real(kind=default), intent(in) :: m, w - type(vectorspinor), intent(in) :: grav - type(vector) :: vp - type(bispinor) :: pgrav, ggrav, ggrav1, ggrav2, ppgrav - type(vectorspinor) :: etagrav_dum, etagrav, pppgrav, & - gg_grav_dum, gg_grav - complex(kind=default), parameter :: one = (1, 0) - real(kind=default) :: minv - integer :: i - vp = p - minv = 1/m - pgrav = p%t * grav%psi(1) - p%x(1) * grav%psi(2) - & - p%x(2) * grav%psi(3) - p%x(3) * grav%psi(4) - ggrav%a(1) = grav%psi(1)%a(3) - grav%psi(2)%a(4) + (0,1) * & - grav%psi(3)%a(4) - grav%psi(4)%a(3) - ggrav%a(2) = grav%psi(1)%a(4) - grav%psi(2)%a(3) - (0,1) * & - grav%psi(3)%a(3) + grav%psi(4)%a(4) - ggrav%a(3) = grav%psi(1)%a(1) + grav%psi(2)%a(2) - (0,1) * & - grav%psi(3)%a(2) + grav%psi(4)%a(1) - ggrav%a(4) = grav%psi(1)%a(2) + grav%psi(2)%a(1) + (0,1) * & - grav%psi(3)%a(1) - grav%psi(4)%a(2) - ggrav1 = ggrav - minv * pgrav - ggrav2 = f_vf (one, vp, ggrav1) + m * ggrav - pgrav - ppgrav = -minv**2 * f_vf (one, vp, pgrav) + minv * pgrav - do i = 1, 4 - etagrav_dum%psi(i) = f_vf (one, vp, grav%psi(i)) - end do - etagrav = etagrav_dum - m * grav - pppgrav%psi(1) = p%t * ppgrav - pppgrav%psi(2) = p%x(1) * ppgrav - pppgrav%psi(3) = p%x(2) * ppgrav - pppgrav%psi(4) = p%x(3) * ppgrav - gg_grav_dum%psi(1) = p%t * ggrav2 - gg_grav_dum%psi(2) = p%x(1) * ggrav2 - gg_grav_dum%psi(3) = p%x(2) * ggrav2 - gg_grav_dum%psi(4) = p%x(3) * ggrav2 - gg_grav = gr_potf (one, one, ggrav2) - minv * gg_grav_dum - propgrav = (1 / cmplx (p*p - m**2, m*w, kind=default)) * & - (etagrav + pppgrav + (1/3.0_default) * gg_grav) -end function pr_grav -@ -\section{Polarization vectorspinors} -Here we construct the wavefunctions for (massive) gravitinos out of -the wavefunctions of (massive) vectorbosons and (massive) Majorana -fermions. -\begin{subequations} -\begin{align} -\psi^\mu_{(u; 3/2)} (k) &= \; \epsilon^\mu_+ (k) \cdot u (k, +) \\ -\psi^\mu_{(u; 1/2)} (k) &= \; \sqrt{\dfrac{1}{3}} \, \epsilon^\mu_+ (k) - \cdot u (k, -) + \sqrt{\dfrac{2}{3}} \, \epsilon^\mu_0 (k) \cdot - u (k, +) \\ -\psi^\mu_{(u; -1/2)} (k) &= \; \sqrt{\dfrac{2}{3}} \, \epsilon^\mu_0 (k) - \cdot u (k, -) + \sqrt{\dfrac{1}{3}} \, \epsilon^\mu_- (k) \cdot - u (k, +) \\ -\psi^\mu_{(u; -3/2)} (k) &= \; \epsilon^\mu_- (k) \cdot u (k, -) -\end{align} -\end{subequations} -and in the same manner for $\psi^\mu_{(v; s)}$ with $u$ replaced by -$v$ and with the conjugated polarization vectors. These gravitino -wavefunctions obey the Dirac equation, they are transverse and they -fulfill the irreducibility condition -\begin{equation} - \gamma_\mu \psi^\mu_{(u/v; s)} = 0 . -\end{equation} -<<[[omega_vspinor_polarizations.f95]]>>= -<> -module omega_vspinor_polarizations - use kinds - use omega_constants - use omega_vectors - use omega_bispinors - use omega_bispinor_couplings - use omega_vectorspinors - implicit none - <> - integer, parameter, public :: omega_vspinor_pols_2003_03_A = 0 -contains - <> -end module omega_vspinor_polarizations -@ -<>= -public :: ueps, veps -private :: eps -private :: outer_product -@ -Here we implement the polarization vectors for vectorbosons with -trigonometric functions, without the rotating of components done in -HELAS~\cite{HELAS}. These are only used for generating the -polarization vectorspinors. -\begin{subequations} -\begin{align} - \epsilon^\mu_+(k) &= - \frac{- e^{+\ii\phi}}{\sqrt{2}} - \left(0; \cos\theta\cos\phi - \ii\sin\phi, - \cos\theta\sin\phi + \ii\cos\phi, - -\sin\theta \right) \\ - \epsilon^\mu_-(k) &= - \frac{e^{-\ii\phi}}{\sqrt{2}} - \left(0; \cos\theta\cos\phi + \ii \sin\phi, - \cos\theta\sin\phi - \ii \cos\phi, - - \sin\theta \right) \\ - \epsilon^\mu_0(k) &= - \frac{1}{m} \left(|\vec k|; k^0\sin\theta\cos\phi, - k^0\sin\theta\sin\phi, - k^0\cos\theta\right) -\end{align} -\end{subequations} -Determining the mass from the momenta is a numerically haphazardous for -light particles. Therefore, we accept some redundancy and pass the -mass explicitely. For the case that the momentum lies totally in the -$z$-direction we take the convention $\cos\phi=1$ and $\sin\phi=0$. -<>= -pure function eps (m, k, s) result (e) - type(vector) :: e - real(kind=default), intent(in) :: m - type(momentum), intent(in) :: k - integer, intent(in) :: s - real(kind=default) :: kabs, kabs2, sqrt2 - real(kind=default) :: cos_phi, sin_phi, cos_th, sin_th - complex(kind=default) :: epiphi, emiphi - sqrt2 = sqrt (2.0_default) - kabs2 = dot_product (k%x, k%x) - if (kabs2 > 0) then - kabs = sqrt (kabs2) - if ((k%x(1) == 0) .and. (k%x(2) == 0)) then - cos_phi = 1 - sin_phi = 0 - else - cos_phi = k%x(1) / sqrt(k%x(1)**2 + k%x(2)**2) - sin_phi = k%x(2) / sqrt(k%x(1)**2 + k%x(2)**2) - end if - cos_th = k%x(3) / kabs - sin_th = sqrt(1 - cos_th**2) - epiphi = cos_phi + (0,1) * sin_phi - emiphi = cos_phi - (0,1) * sin_phi - e%t = 0 - e%x = 0 - select case (s) - case (1) - e%x(1) = epiphi * (-cos_th * cos_phi + (0,1) * sin_phi) / sqrt2 - e%x(2) = epiphi * (-cos_th * sin_phi - (0,1) * cos_phi) / sqrt2 - e%x(3) = epiphi * ( sin_th / sqrt2) - case (-1) - e%x(1) = emiphi * ( cos_th * cos_phi + (0,1) * sin_phi) / sqrt2 - e%x(2) = emiphi * ( cos_th * sin_phi - (0,1) * cos_phi) / sqrt2 - e%x(3) = emiphi * (-sin_th / sqrt2) - case (0) - if (m > 0) then - e%t = kabs / m - e%x = k%t / (m*kabs) * k%x - end if - case (4) - if (m > 0) then - e = (1 / m) * k - else - e = (1 / k%t) * k - end if - end select - else !!! for particles in their rest frame defined to be - !!! polarized along the 3-direction - e%t = 0 - e%x = 0 - select case (s) - case (1) - e%x(1) = cmplx ( - 1, 0, kind=default) / sqrt2 - e%x(2) = cmplx ( 0, 1, kind=default) / sqrt2 - case (-1) - e%x(1) = cmplx ( 1, 0, kind=default) / sqrt2 - e%x(2) = cmplx ( 0, 1, kind=default) / sqrt2 - case (0) - if (m > 0) then - e%x(3) = 1 - end if - case (4) - if (m > 0) then - e = (1 / m) * k - else - e = (1 / k%t) * k - end if - end select - end if -end function eps -@ -<>= -pure function ueps (m, k, s) result (t) - type(vectorspinor) :: t - real(kind=default), intent(in) :: m - type(momentum), intent(in) :: k - integer, intent(in) :: s - integer :: i - type(vector) :: ep, e0, em - type(bispinor) :: up, um - do i = 1, 4 - t%psi(i)%a = 0 - end do - select case (s) - case (2) - ep = eps (m, k, 1) - up = u (m, k, 1) - t = outer_product (ep, up) - case (1) - ep = eps (m, k, 1) - e0 = eps (m, k, 0) - up = u (m, k, 1) - um = u (m, k, -1) - t = (1 / sqrt (3.0_default)) * (outer_product (ep, um) & - + sqrt (2.0_default) * outer_product (e0, up)) - case (-1) - e0 = eps (m, k, 0) - em = eps (m, k, -1) - up = u (m, k, 1) - um = u (m, k, -1) - t = (1 / sqrt (3.0_default)) * (sqrt (2.0_default) * & - outer_product (e0, um) + outer_product (em, up)) - case (-2) - em = eps (m, k, -1) - um = u (m, k, -1) - t = outer_product (em, um) - end select -end function ueps -@ -<>= -pure function veps (m, k, s) result (t) - type(vectorspinor) :: t - real(kind=default), intent(in) :: m - type(momentum), intent(in) :: k - integer, intent(in) :: s - integer :: i - type(vector) :: ep, e0, em - type(bispinor) :: vp, vm - do i = 1, 4 - t%psi(i)%a = 0 - end do - select case (s) - case (2) - ep = conjg(eps (m, k, 1)) - vp = v (m, k, 1) - t = outer_product (ep, vp) - case (1) - ep = conjg(eps (m, k, 1)) - e0 = conjg(eps (m, k, 0)) - vp = v (m, k, 1) - vm = v (m, k, -1) - t = (1 / sqrt (3.0_default)) * (outer_product (ep, vm) & - + sqrt (2.0_default) * outer_product (e0, vp)) - case (-1) - e0 = conjg(eps (m, k, 0)) - em = conjg(eps (m, k, -1)) - vp = v (m, k, 1) - vm = v (m, k, -1) - t = (1 / sqrt (3.0_default)) * (sqrt (2.0_default) & - * outer_product (e0, vm) + outer_product (em, vp)) - case (-2) - em = conjg(eps (m, k, -1)) - vm = v (m, k, -1) - t = outer_product (em, vm) - end select -end function veps -@ -<>= -pure function outer_product (ve, sp) result (vs) - type(vectorspinor) :: vs - type(vector), intent(in) :: ve - type(bispinor), intent(in) :: sp - integer :: i - vs%psi(1)%a(1:4) = ve%t * sp%a(1:4) - do i = 1, 3 - vs%psi((i+1))%a(1:4) = ve%x(i) * sp%a(1:4) - end do -end function outer_product -@ -\section{Colors} -\begin{dubious} - A derived data type is probably \emph{not} the optimal solution, - because we have to initialize it \emph{statically} with variable - sizes. This is not possible with \texttt{allocatable} arrays and - allocating lots of arrays anew for each evaluation of the matrix - element is out of the question! -\end{dubious} -\begin{dubious} - However, this might require us to make most of the arithmetic - \texttt{elemental}, which is not possible for Fortran90 compilers. -\end{dubious} -<<[[omega_spinor_colors.m4]]>>= -<> -<> -@ Use m4 diversions to get everything into the right order: -<>= -define(`DECLARATIONS', `undivert(1)') -define(`IMPLEMENTATIONS', `undivert(2)') -@ -We need two versions: One for [[spinor]]s and one for [[bispinor]]s: -<<[[omega_bispinor_colors.m4]]>>= -<> -<> -<<[[omega_spinor_colors.m4]] and [[omega_bispinor_colors.m4]]>> -@ -<<[[omega_spinor_colors.m4]]>>= -<<[[omega_spinor_colors.m4]] and [[omega_bispinor_colors.m4]]>> -@ -<>= -define(`PROPAGATOR', `dnl -divert(1)dnl - public :: $1_c -divert(2)dnl - pure function $1_c (p, $3, iwf) result (owf) - $2, dimension(:), intent(in) :: iwf - $2, dimension(lbound(iwf,dim=1):ubound(iwf,dim=1)) :: owf - type(momentum), intent(in) :: p - real(kind=default), intent(in) :: $3 - integer :: i - do i = lbound(iwf,dim=1), ubound(iwf,dim=1) - owf(i) = $1 (p, $3, iwf(i)) - end do - end function $1_c -divert') -@ -<<[[omega_spinor_colors.m4]]>>= -PROPAGATOR(`pr_psi', `type(spinor)', `m, w') -PROPAGATOR(`pr_psibar', `type(conjspinor)', `m, w') -@ -<<[[omega_bispinor_colors.m4]]>>= -PROPAGATOR(`pr_psi', `type(bispinor)', `m, w') -@ -<<[[omega_spinor_colors.m4]] and [[omega_bispinor_colors.m4]]>>= -PROPAGATOR(`pr_phi', `complex(kind=default)', `m, w') -PROPAGATOR(`pr_unitarity', `type(vector)', `m, w') -dnl PROPAGATOR(`pr_tensor', `type(tensor)', `m, w') -@ -<>= -define(`PROPAGATOR0', `dnl -divert(1)dnl - public :: $1_c -divert(2)dnl - pure function $1_c (p, iwf) result (owf) - $2, dimension(:), intent(in) :: iwf - $2, dimension(lbound(iwf,dim=1):ubound(iwf,dim=1)) :: owf - type(momentum), intent(in) :: p - integer :: i - do i = lbound(iwf,dim=1), ubound(iwf,dim=1) - owf(i) = $1 (p, iwf(i)) - end do - end function $1_c -divert') -@ -<<[[omega_spinor_colors.m4]] and [[omega_bispinor_colors.m4]]>>= -PROPAGATOR0(`pr_feynman', `type(vector)') -@ -<<[[omega_spinor_colors.m4]] and [[omega_bispinor_colors.m4]]>>= -PROPAGATOR(`pr_gauge', `type(vector)', `xi') -PROPAGATOR(`pr_rxi', `type(vector)', `m, w, xi') -@ -<>= -define(`BINARY', `dnl -divert(1)dnl - <> -divert(2)dnl - <> -divert') -@ Three singlets are redundant and a single colored particle would -be inconsistent: -<>= -public :: $1_c_cc -public :: $1_c_sc -public :: $1_c_cs -public :: $1_s_cc -@ -<>= -pure function $1_c_cc (c, $3, wf1, wf2) result (wf) - complex(kind=default), dimension(:,:,:), intent(in) :: c - $2, dimension(lbound(c,dim=1):ubound(c,dim=1)) :: wf - complex(kind=default), intent(in) :: $3 - $4, dimension(:), intent(in) :: wf1 - $5, dimension(:), intent(in) :: wf2 - integer :: i, i1, i2 - do i = lbound(wf,dim=1), ubound(wf,dim=1) - wf(i) = c(i,lbound(wf1,dim=1),lbound(wf2,dim=1)) & - * $1 ($3, wf1(lbound(wf1,dim=1)), wf2(lbound(wf2,dim=1))) - do i2 = lbound(wf2,dim=1) + 1, ubound(wf2,dim=1) - wf(i) = wf(i) + c(i,lbound(wf1,dim=1),i2) & - * $1 ($3, wf1(lbound(wf1,dim=1)), wf2(i2)) - end do - do i1 = lbound(wf1,dim=1) + 1, ubound(wf1,dim=1) - do i2 = lbound(wf2,dim=1), ubound(wf2,dim=1) - wf(i) = wf(i) + c(i,i1,i2) * $1 ($3, wf1(i1), wf2(i2)) - end do - end do - end do -end function $1_c_cc -@ -<>= -pure function $1_c_sc (c, $3, wf1, wf2) result (wf) - complex(kind=default), dimension(:,:), intent(in) :: c - $2, dimension(lbound(c,dim=1):ubound(c,dim=1)) :: wf - complex(kind=default), intent(in) :: $3 - $4, intent(in) :: wf1 - $5, dimension(:), intent(in) :: wf2 - integer :: i, i2 - do i = lbound(wf,dim=1), ubound(wf,dim=1) - wf(i) = c(i,lbound(wf2,dim=1)) * $1 ($3, wf1, wf2(lbound(wf2,dim=1))) - do i2 = lbound(wf2,dim=1) + 1, ubound(wf2,dim=1) - wf(i) = wf(i) + c(i,i2) * $1 ($3, wf1, wf2(i2)) - end do - end do -end function $1_c_sc -@ -<>= -pure function $1_c_cs (c, $3, wf1, wf2) result (wf) - complex(kind=default), dimension(:,:), intent(in) :: c - $2, dimension(lbound(c,dim=1):ubound(c,dim=1)) :: wf - complex(kind=default), intent(in) :: $3 - $4, dimension(:), intent(in) :: wf1 - $5, intent(in) :: wf2 - integer :: i, i1 - do i = lbound(wf,dim=1), ubound(wf,dim=1) - wf(i) = c(i,lbound(wf1,dim=1)) * $1 ($3, wf1(lbound(wf1,dim=1)), wf2) - do i1 = lbound(wf1,dim=1) + 1, ubound(wf1,dim=1) - wf(i) = wf(i) + c(i,i1) * $1 ($3, wf1(i1), wf2) - end do - end do -end function $1_c_cs -@ -<>= -pure function $1_s_cc (c, $3, wf1, wf2) result (wf) - $2 :: wf - complex(kind=default), dimension(:,:), intent(in) :: c - complex(kind=default), intent(in) :: $3 - $4, dimension(:), intent(in) :: wf1 - $5, dimension(:), intent(in) :: wf2 - integer :: i1, i2 - wf = c(lbound(wf1,dim=1),lbound(wf2,dim=1)) & - * $1 ($3, wf1(lbound(wf1,dim=1)), wf2(lbound(wf2,dim=1))) - do i2 = lbound(wf2,dim=1) + 1, ubound(wf2,dim=1) - wf = wf + c(lbound(wf1,dim=1),i2) * $1 ($3, wf1(lbound(wf1,dim=1)), wf2(i2)) - end do - do i1 = lbound(wf1,dim=1) + 1, ubound(wf1,dim=1) - do i2 = lbound(wf2,dim=1), ubound(wf2,dim=1) - wf = wf + c(i1,i2) * $1 ($3, wf1(i1), wf2(i2)) - end do - end do -end function $1_s_cc -@ -<<[[omega_spinor_colors.m4]]>>= -BINARY(`v_ff', `type(vector)', `g', `type(conjspinor)', `type(spinor)') -BINARY(`a_ff', `type(vector)', `g', `type(conjspinor)', `type(spinor)') -BINARY(`vl_ff', `type(vector)', `g', `type(conjspinor)', `type(spinor)') -BINARY(`vr_ff', `type(vector)', `g', `type(conjspinor)', `type(spinor)') -BINARY(`vlr_ff', `type(vector)', `gl, gr', `type(conjspinor)', `type(spinor)') -BINARY(`va_ff', `type(vector)', `gv, ga', `type(conjspinor)', `type(spinor)') -BINARY(`f_vf', `type(spinor)', `g', `type(vector)', `type(spinor)') -BINARY(`f_af', `type(spinor)', `g', `type(vector)', `type(spinor)') -BINARY(`f_vlf', `type(spinor)', `g', `type(vector)', `type(spinor)') -BINARY(`f_vrf', `type(spinor)', `g', `type(vector)', `type(spinor)') -BINARY(`f_vlrf', `type(spinor)', `gl, gr', `type(vector)', `type(spinor)') -BINARY(`f_vaf', `type(spinor)', `gv, ga', `type(vector)', `type(spinor)') -BINARY(`f_fv', `type(conjspinor)', `g', `type(conjspinor)', `type(vector)') -BINARY(`f_fa', `type(conjspinor)', `g', `type(conjspinor)', `type(vector)') -BINARY(`f_fvl', `type(conjspinor)', `g', `type(conjspinor)', `type(vector)') -BINARY(`f_fvr', `type(conjspinor)', `g', `type(conjspinor)', `type(vector)') -BINARY(`f_fvlr', `type(conjspinor)', `gl, gr', `type(conjspinor)', `type(vector)') -BINARY(`f_fva', `type(conjspinor)', `gv, ga', `type(conjspinor)', `type(vector)') -@ -<<[[omega_spinor_colors.m4]]>>= -BINARY(`s_ff', `complex(kind=default)', `g', `type(conjspinor)', `type(spinor)') -BINARY(`p_ff', `complex(kind=default)', `g', `type(conjspinor)', `type(spinor)') -BINARY(`sl_ff', `complex(kind=default)', `g', `type(conjspinor)', `type(spinor)') -BINARY(`sr_ff', `complex(kind=default)', `g', `type(conjspinor)', `type(spinor)') -BINARY(`slr_ff', `complex(kind=default)', `gl, gr', `type(conjspinor)', `type(spinor)') -BINARY(`sp_ff', `complex(kind=default)', `gv, ga', `type(conjspinor)', `type(spinor)') -BINARY(`f_sf', `type(spinor)', `g', `complex(kind=default)', `type(spinor)') -BINARY(`f_pf', `type(spinor)', `g', `complex(kind=default)', `type(spinor)') -BINARY(`f_slf', `type(spinor)', `g', `complex(kind=default)', `type(spinor)') -BINARY(`f_srf', `type(spinor)', `g', `complex(kind=default)', `type(spinor)') -BINARY(`f_slrf', `type(spinor)', `gl, gr', `complex(kind=default)', `type(spinor)') -BINARY(`f_spf', `type(spinor)', `gv, ga', `complex(kind=default)', `type(spinor)') -BINARY(`f_fs', `type(conjspinor)', `g', `type(conjspinor)', `complex(kind=default)') -BINARY(`f_fp', `type(conjspinor)', `g', `type(conjspinor)', `complex(kind=default)') -BINARY(`f_fsl', `type(conjspinor)', `g', `type(conjspinor)', `complex(kind=default)') -BINARY(`f_fsr', `type(conjspinor)', `g', `type(conjspinor)', `complex(kind=default)') -BINARY(`f_fslr', `type(conjspinor)', `gl, gr', `type(conjspinor)', `complex(kind=default)') -BINARY(`f_fsp', `type(conjspinor)', `gv, ga', `type(conjspinor)', `complex(kind=default)') -@ -<<[[omega_bispinor_colors.m4]]>>= -BINARY(`v_ff', `type(vector)', `g', `type(bispinor)', `type(bispinor)') -BINARY(`a_ff', `type(vector)', `g', `type(bispinor)', `type(bispinor)') -BINARY(`vl_ff', `type(vector)', `g', `type(bispinor)', `type(bispinor)') -BINARY(`vr_ff', `type(vector)', `g', `type(bispinor)', `type(bispinor)') -BINARY(`vlr_ff', `type(vector)', `gl, gr', `type(bispinor)', `type(bispinor)') -BINARY(`va_ff', `type(vector)', `gv, ga', `type(bispinor)', `type(bispinor)') -BINARY(`f_vf', `type(bispinor)', `g', `type(vector)', `type(bispinor)') -BINARY(`f_af', `type(bispinor)', `g', `type(vector)', `type(bispinor)') -BINARY(`f_vlf', `type(bispinor)', `g', `type(vector)', `type(bispinor)') -BINARY(`f_vrf', `type(bispinor)', `g', `type(vector)', `type(bispinor)') -BINARY(`f_vlrf', `type(bispinor)', `gl, gr', `type(vector)', `type(bispinor)') -BINARY(`f_vaf', `type(bispinor)', `gv, ga', `type(vector)', `type(bispinor)') -BINARY(`s_ff', `complex(kind=default)', `g', `type(bispinor)', `type(bispinor)') -BINARY(`p_ff', `complex(kind=default)', `g', `type(bispinor)', `type(bispinor)') -BINARY(`sl_ff', `complex(kind=default)', `g', `type(bispinor)', `type(bispinor)') -BINARY(`sr_ff', `complex(kind=default)', `g', `type(bispinor)', `type(bispinor)') -BINARY(`slr_ff', `complex(kind=default)', `gl, gr', `type(bispinor)', `type(bispinor)') -BINARY(`sp_ff', `complex(kind=default)', `gv, ga', `type(bispinor)', `type(bispinor)') -BINARY(`f_sf', `type(bispinor)', `g', `complex(kind=default)', `type(bispinor)') -BINARY(`f_pf', `type(bispinor)', `g', `complex(kind=default)', `type(bispinor)') -BINARY(`f_slf', `type(bispinor)', `g', `complex(kind=default)', `type(bispinor)') -BINARY(`f_srf', `type(bispinor)', `g', `complex(kind=default)', `type(bispinor)') -BINARY(`f_slrf', `type(bispinor)', `gl, gr', `complex(kind=default)', `type(bispinor)') -BINARY(`f_spf', `type(bispinor)', `gv, ga', `complex(kind=default)', `type(bispinor)') -@ -<<[[omega_spinor_colors.m4]]>>= -module omega_spinor_colors - use kinds - use omega_spinors - use omega_vectors - use omega_spinor_couplings - use omega_couplings - implicit none - private -DECLARATIONS -contains -IMPLEMENTATIONS -end module omega_spinor_colors -@ -<<[[omega_bispinor_colors.m4]]>>= -module omega_bispinor_colors - use kinds - use omega_bispinors - use omega_vectors - use omega_bispinor_couplings - use omega_couplings - implicit none - private -DECLARATIONS -contains -IMPLEMENTATIONS -end module omega_bispinor_colors -@ \subsection{Comments} -In the customary normalization -\begin{equation} - \tr\left( T_a T_b \right) = \frac{1}{2}\delta_{ab} -\end{equation} -the structure constants in -\begin{equation} - [ T_a , T_b] = \ii f_{abc} T_c -\end{equation} -are -\begin{equation} - f_{abc} = - 2\ii \tr\left([T_a,T_b]T_c\right) -\end{equation} -and the three gluon vertex can be represented symbolically: -\begin{equation} - \parbox{28mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(24,24) - \threeexternal{3}{1}{2} - \fmf{gluon}{v,e1} - \fmf{gluon}{v,e2} - \fmf{gluon}{v,e3} - \threeoutgoing - \end{fmfgraph*}}} - \quad\to\quad - \parbox{28mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(24,24) - \threeexternal{3}{1}{2} - \fmf{phantom}{v,e1} - \fmf{phantom}{v,e2} - \fmf{phantom}{v,e3} - \fmffreeze - \fmfipair{v,e[],a[],b[]} - \fmfiset{e1}{vloc (__e1)} - \fmfiset{e2}{vloc (__e2)} - \fmfiset{e3}{vloc (__e3)} - \fmfiset{v}{vloc (__v)} - \fmfiset{a1}{e1 shifted (-3thin,0)} - \fmfiset{b1}{e1 shifted (+1thin,-2thin)} - \fmfiset{a2}{e2 shifted (0,-3thin)} - \fmfiset{b2}{e2 shifted (0,+3thin)} - \fmfiset{a3}{e3 shifted (+1thin,+2thin)} - \fmfiset{b3}{e3 shifted (-3thin,0)} - \fmfi{plain}{a1{v-e1}...{e2-v}b2} - \fmfi{plain}{a2{v-e2}...{e3-v}b3} - \fmfi{plain}{a3{v-e3}...{e1-v}b1} - \end{fmfgraph*}}} - \quad-\quad - \parbox{28mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(24,24) - \threeexternal{3}{1}{2} - \fmf{phantom}{v,e1} - \fmf{phantom}{v,e2} - \fmf{phantom}{v,e3} - \fmffreeze - \fmfipair{v,e[],a[],b[]} - \fmfiset{e1}{vloc (__e1)} - \fmfiset{e2}{vloc (__e2)} - \fmfiset{e3}{vloc (__e3)} - \fmfiset{v}{vloc (__v)} - \fmfiset{a1}{e1 shifted (-3thin,0)} - \fmfiset{b1}{e1 shifted (+1thin,-2thin)} - \fmfiset{a2}{e2 shifted (0,-3thin)} - \fmfiset{b2}{e2 shifted (0,+3thin)} - \fmfiset{a3}{e3 shifted (+1thin,+2thin)} - \fmfiset{b3}{e3 shifted (-3thin,0)} - \fmfi{plain,rubout}{a2{v-e2}...{e1-v}b1} - \fmfi{plain,rubout}{a1{v-e1}...{e3-v}b3} - \fmfi{plain,rubout}{a3{v-e3}...{e2-v}b2} - \end{fmfgraph*}}} -\end{equation} -Using the completeness relation -\begin{equation} - [T_a]_{ij} [T_a]_{kl} = - \frac{1}{2} \left( \delta_{il} \delta_{jk} - - \frac{1}{N_C} \delta_{ij} \delta_{kl} \right) -\end{equation} -the contration of two structure constants read -\begin{multline} - \tr\left( T_a T_b T_e \right) \tr\left( T_c T_d T_e \right) - = \frac{1}{2} \tr\left( T_a T_b T_c T_d \right) - - \frac{1}{2N_C} \tr\left( T_a T_b \right) \tr\left( T_c T_d \right) \\ - = \frac{1}{2} \tr\left( T_a T_b T_c T_d \right) - - \frac{1}{8N_C} \delta_{ab} \delta_{cd} -\end{multline} -i.\,e. -\begin{equation} - f_{abe} f_{cde} = - 2 \left( - \tr\left( T_a T_b T_c T_d \right) - \tr\left( T_b T_a T_c T_d \right) - - \tr\left( T_a T_b T_d T_c \right) + \tr\left( T_b T_a T_d T_c \right) - \right) -\end{equation} -\newcommand{\gluonfoursome}{% - \fmfstraight - \fmfleft{a,b} - \fmfright{d,c} - \fmflabel{$a$}{a} - \fmflabel{$b$}{b} - \fmflabel{$c$}{c} - \fmflabel{$d$}{d} - \fmf{phantom}{ab,a} - \fmf{phantom}{ab,b} - \fmf{phantom}{ab,cd} - \fmf{phantom}{c,cd} - \fmf{phantom}{d,cd} - \fmffreeze - \fmfipair{ab,cd,a[],b[],c[],d[]} - \fmfiset{a[0]}{vloc (__a)} - \fmfiset{b[0]}{vloc (__b)} - \fmfiset{c[0]}{vloc (__c)} - \fmfiset{d[0]}{vloc (__d)} - \fmfiset{ab}{vloc (__ab)} - \fmfiset{cd}{vloc (__cd)} - \fmfiset{a[+1]}{a[0] shifted (+thick,-thick)} - \fmfiset{a[-1]}{a[0] shifted (-thick,+thick)} - \fmfiset{b[+1]}{b[0] shifted (-thick,-thick)} - \fmfiset{b[-1]}{b[0] shifted (+thick,+thick)} - \fmfiset{c[+1]}{c[0] shifted (-thick,+thick)} - \fmfiset{c[-1]}{c[0] shifted (+thick,-thick)} - \fmfiset{d[+1]}{d[0] shifted (+thick,+thick)} - \fmfiset{d[-1]}{d[0] shifted (-thick,-thick)}} -\begin{multline} - \parbox{40mm}{\fmfframe(2,4)(2,3){\begin{fmfgraph*}(36,24) - \fmfstraight - \fmfleft{a,b} - \fmfright{d,c} - \fmflabel{$a$}{a} - \fmflabel{$b$}{b} - \fmflabel{$c$}{c} - \fmflabel{$d$}{d} - \fmf{gluon}{ab,a} - \fmf{gluon}{ab,b} - \fmf{gluon}{ab,cd} - \fmf{gluon}{c,cd} - \fmf{gluon}{d,cd} - \fmfdot{ab,cd} - \end{fmfgraph*}}} - \quad\to\quad - \parbox{22mm}{\fmfframe(2,4)(2,3){\begin{fmfgraph*}(18,12) - \gluonfoursome - \fmfi{plain,rubout}{a[-1]{ab-a[0]}...{b[0]-ab}b[+1]} - \fmfi{plain,rubout}{b[-1]{ab-b[0]}...{c[0]-cd}c[+1]} - \fmfi{plain,rubout}{c[-1]{cd-c[0]}...{d[0]-cd}d[+1]} - \fmfi{plain,rubout}{d[-1]{cd-d[0]}...{a[0]-ab}a[+1]} - \end{fmfgraph*}}} \\ - -\quad - \parbox{22mm}{\fmfframe(2,4)(2,3){\begin{fmfgraph*}(18,12) - \gluonfoursome - \fmfi{plain,rubout}{a[-1]{ab-a[0]}...{b[0]-ab}b[+1]} - \fmfi{plain,rubout}{b[-1]{ab-b[0]}...{d[0]-cd}d[+1]} - \fmfi{plain,rubout}{d[-1]{cd-d[0]}...{c[0]-cd}c[+1]} - \fmfi{plain,rubout}{c[-1]{cd-c[0]}...{a[0]-ab}a[+1]} - \end{fmfgraph*}}} - -\quad - \parbox{22mm}{\fmfframe(2,4)(2,3){\begin{fmfgraph*}(18,12) - \gluonfoursome - \fmfi{plain,rubout}{b[-1]{ab-b[0]}...{a[0]-ab}a[+1]} - \fmfi{plain,rubout}{a[-1]{ab-a[0]}...{c[0]-cd}c[+1]} - \fmfi{plain,rubout}{c[-1]{cd-c[0]}...{d[0]-cd}d[+1]} - \fmfi{plain,rubout}{d[-1]{cd-d[0]}...{b[0]-ab}b[+1]} - \end{fmfgraph*}}} - \quad+\quad - \parbox{22mm}{\fmfframe(2,4)(2,3){\begin{fmfgraph*}(18,12) - \gluonfoursome - \fmfi{plain,rubout}{b[-1]{ab-b[0]}...{a[0]-ab}a[+1]} - \fmfi{plain,rubout}{a[-1]{ab-a[0]}...{d[0]-cd}d[+1]} - \fmfi{plain,rubout}{d[-1]{cd-d[0]}...{c[0]-cd}c[+1]} - \fmfi{plain,rubout}{c[-1]{cd-c[0]}...{b[0]-ab}b[+1]} - \end{fmfgraph*}}} -\end{multline} -In a more convenient normalization -\begin{equation} - \tr\left(\hat T_a \hat T_b\right) = \delta_{ab} -\end{equation} -with -\begin{equation} - [ \hat T_a, \hat T_b] = \ii \hat f_{abc} \hat T_c -\end{equation} -i.\,e. -\begin{subequations} -\begin{align} - \hat T_a &= \sqrt{2} \cdot T_a \\ - \hat f_{abc} &= \sqrt{2} \cdot f_{abc} -\end{align} -\end{subequations} -all factors of~$2$ cancel in -\begin{equation} - \hat f_{abc} = - \ii \tr\left([\hat T_a,\hat T_b]\hat T_c\right) -\end{equation} -and -\begin{equation} - [\hat T_a]_{ij} [\hat T_a]_{kl} = - \delta_{il} \delta_{jk} - \frac{1}{N_C} \delta_{ij} \delta_{kl} -\end{equation} -Therefore also in -\begin{multline} - \tr\left( \hat T_a \hat T_b \hat T_e \right) \tr\left( \hat T_c \hat T_d \hat T_e \right) - = \tr\left( \hat T_a \hat T_b \hat T_c \hat T_d \right) - - \frac{1}{N_C} \tr\left( \hat T_a \hat T_b \right) \tr\left( \hat T_c \hat T_d \right) \\ - = \tr\left( \hat T_a \hat T_b \hat T_c \hat T_d \right) - - \frac{1}{N_C} \delta_{ab} \delta_{cd} -\end{multline} -and -\begin{equation} - \hat f_{abe} \hat f_{cde} = - - \tr\left( \hat T_a \hat T_b \hat T_c \hat T_d \right) - + \tr\left( \hat T_b \hat T_a \hat T_c \hat T_d \right) - + \tr\left( \hat T_a \hat T_b \hat T_d \hat T_c \right) - - \tr\left( \hat T_b \hat T_a \hat T_d \hat T_c \right) -\end{equation} -\begin{dubious} - The adjoint representation of $\mathrm{SU}(N_C)$ is not the most convenient - basis: we will use $N_C\otimes\overline{N_C}$ instead and provide a special - version for $N_C\to\infty$. -\end{dubious} -Up to normalization: -\begin{subequations} -\begin{align} - (\alpha,\bar\alpha) \cdot (\beta,\bar\beta) - &= (\alpha,\bar\beta) \delta_{\bar\alpha,\beta} - - (\beta,\bar\alpha) \delta_{\bar\beta,\alpha} \\ - \bar\alpha \cdot (\beta,\bar\beta) - &= \bar\beta \delta_{\bar\alpha,\beta} \\ - (\alpha,\bar\alpha) \cdot \beta - &= \alpha \delta_{\bar\alpha,\beta} -\end{align} -\end{subequations} -\begin{dubious} - Unfortunately -\end{dubious} -@ \section{Utilities} -<<[[omega_utils.f95]]>>= -<> -module omega_utils - use kinds - use omega_vectors - use omega_polarizations - implicit none - private - <> - <> - integer, parameter, private :: REPEAT = 5, SAMPLE = 10 - integer, parameter, public :: omega_utils_2003_03_A = 0 -contains - <> -end module omega_utils -@ \subsection{Diagnostics} -<>= -public :: omega_ward_warn, omega_ward_panic -@ The O'Mega amplitudes have only one particle off shell and are the -sum of \emph{all} possible diagrams with the other particles -on-shell. -\begin{dubious} - The problem with these gauge checks is that are numerically very - small amplitudes that vanish analytically and that violate - transversality. The hard part is to determine the thresholds that - make threse tests usable. -\end{dubious} -<>= -subroutine omega_ward_warn (name, m, k, e) - character(len=*), intent(in) :: name - real(kind=default), intent(in) :: m - type(momentum), intent(in) :: k - type(vector), intent(in) :: e - type(vector) :: ek - real(kind=default) :: abs_eke, abs_ek_abs_e - ek = eps (m, k, 4) - abs_eke = abs (ek * e) - abs_ek_abs_e = abs (ek) * abs (e) - print *, name, ":", abs_eke / abs_ek_abs_e, abs (ek), abs (e) - if (abs_eke > 1000 * epsilon (abs_ek_abs_e)) then - print *, "O'Mega: warning: non-transverse vector field: ", & - name, ":", abs_eke / abs_ek_abs_e, abs (e) - end if -end subroutine omega_ward_warn -@ -<>= -subroutine omega_ward_panic (name, m, k, e) - character(len=*), intent(in) :: name - real(kind=default), intent(in) :: m - type(momentum), intent(in) :: k - type(vector), intent(in) :: e - type(vector) :: ek - real(kind=default) :: abs_eke, abs_ek_abs_e - ek = eps (m, k, 4) - abs_eke = abs (ek * e) - abs_ek_abs_e = abs (ek) * abs (e) - if (abs_eke > 1000 * epsilon (abs_ek_abs_e)) then - print *, "O'Mega: panic: non-transverse vector field: ", & - name, ":", abs_eke / abs_ek_abs_e, abs (e) - stop - end if -end subroutine omega_ward_panic -@ -<>= -public :: omega_slavnov_warn, omega_slavnov_panic -@ -<>= -subroutine omega_slavnov_warn (name, m, k, e, phi) - character(len=*), intent(in) :: name - real(kind=default), intent(in) :: m - type(momentum), intent(in) :: k - type(vector), intent(in) :: e - complex(kind=default), intent(in) :: phi - type(vector) :: ek - real(kind=default) :: abs_eke, abs_ek_abs_e - ek = eps (m, k, 4) - abs_eke = abs (ek * e - phi) - abs_ek_abs_e = abs (ek) * abs (e) - print *, name, ":", abs_eke / abs_ek_abs_e, abs (ek), abs (e) - if (abs_eke > 1000 * epsilon (abs_ek_abs_e)) then - print *, "O'Mega: warning: non-transverse vector field: ", & - name, ":", abs_eke / abs_ek_abs_e, abs (e) - end if -end subroutine omega_slavnov_warn -@ -<>= -subroutine omega_slavnov_panic (name, m, k, e, phi) - character(len=*), intent(in) :: name - real(kind=default), intent(in) :: m - type(momentum), intent(in) :: k - type(vector), intent(in) :: e - complex(kind=default), intent(in) :: phi - type(vector) :: ek - real(kind=default) :: abs_eke, abs_ek_abs_e - ek = eps (m, k, 4) - abs_eke = abs (ek * e - phi) - abs_ek_abs_e = abs (ek) * abs (e) - if (abs_eke > 1000 * epsilon (abs_ek_abs_e)) then - print *, "O'Mega: panic: non-transverse vector field: ", & - name, ":", abs_eke / abs_ek_abs_e, abs (e) - stop - end if -end subroutine omega_slavnov_panic -@ -<>= -public :: omega_check_arguments_warn, omega_check_arguments_panic -@ -<>= -subroutine omega_check_arguments_warn (n, k, s) - integer, intent(in) :: n - real(kind=default), dimension(0:,:), intent(in) :: k - integer, dimension(:), intent(in) :: s - integer :: i - i = size(k,dim=1) - if (i /= 4) then - print *, "O'Mega: warning: wrong # of dimensions:", i - end if - i = size(k,dim=2) - if (i /= n) then - print *, "O'Mega: warning: wrong # of momenta:", i, & - ", expected", n - end if - i = size (s) - if (i /= n) then - print *, "O'Mega: warning: wrong # of spins:", i, & - ", expected", n - end if -end subroutine omega_check_arguments_warn -@ -<>= -subroutine omega_check_arguments_panic (n, k, s) - integer, intent(in) :: n - real(kind=default), dimension(0:,:), intent(in) :: k - integer, dimension(:), intent(in) :: s - logical :: error - integer :: i - error = .false. - i = size(k,dim=1) - if (i /= n) then - print *, "O'Mega: warning: wrong # of dimensions:", i - error = .true. - end if - i = size(k,dim=2) - if (i /= n) then - print *, "O'Mega: warning: wrong # of momenta:", i, & - ", expected", n - error = .true. - end if - i = size (s) - if (i /= n) then - print *, "O'Mega: warning: wrong # of spins:", i, & - ", expected", n - error = .true. - end if - if (error) then - stop - end if -end subroutine omega_check_arguments_panic -@ -<>= -public :: omega_check_helicities_warn, omega_check_helicities_panic -private :: omega_check_helicity -@ -<>= -function omega_check_helicity (m, smax, s) result (error) - real(kind=default), intent(in) :: m - integer, intent(in) :: smax, s - logical :: error - select case (smax) - case (0) - error = (s /= 0) - case (1) - error = (abs (s) /= 1) - case (2) - if (m == 0.0_default) then - error = .not. (abs (s) == 1 .or. abs (s) == 4) - else - error = .not. (abs (s) <= 1 .or. abs (s) == 4) - end if - case (4) - error = .true. - case default - error = .true. - end select -end function omega_check_helicity -@ -<>= -subroutine omega_check_helicities_warn (m, smax, s) - real(kind=default), dimension(:), intent(in) :: m - integer, dimension(:), intent(in) :: smax, s - integer :: i - do i = 1, size (m) - if (omega_check_helicity (m(i), smax(i), s(i))) then - print *, "O'Mega: warning: invalid helicity", s(i) - end if - end do -end subroutine omega_check_helicities_warn -@ -<>= -subroutine omega_check_helicities_panic (m, smax, s) - real(kind=default), dimension(:), intent(in) :: m - integer, dimension(:), intent(in) :: smax, s - logical :: error - logical :: error1 - integer :: i - error = .false. - do i = 1, size (m) - error1 = omega_check_helicity (m(i), smax(i), s(i)) - if (error1) then - print *, "O'Mega: panic: invalid helicity", s(i) - error = .true. - end if - end do - if (error) then - stop - end if -end subroutine omega_check_helicities_panic -@ -<>= -public :: omega_check_momenta_warn, omega_check_momenta_panic -private :: check_momentum_conservation, check_mass_shell -@ -<>= -integer, parameter, private :: MOMENTUM_TOLERANCE = 10000 -@ -<>= -function check_momentum_conservation (k) result (error) - real(kind=default), dimension(0:,:), intent(in) :: k - logical :: error - error = any (abs (sum (k(:,3:), dim = 2) - k(:,1) - k(:,2)) > & - MOMENTUM_TOLERANCE * epsilon (maxval (abs (k), dim = 2))) - if (error) then - print *, sum (k(:,3:), dim = 2) - k(:,1) - k(:,2) - print *, MOMENTUM_TOLERANCE * epsilon (maxval (abs (k), dim = 2)), & - maxval (abs (k), dim = 2) - end if -end function check_momentum_conservation -@ -<>= -integer, parameter, private :: ON_SHELL_TOLERANCE = 1000000 -@ -<>= -function check_mass_shell (m, k) result (error) - real(kind=default), intent(in) :: m - real(kind=default), dimension(0:), intent(in) :: k - real(kind=default) :: e2 - logical :: error - e2 = k(1)**2 + k(2)**2 + k(3)**2 + m**2 - error = abs (k(0)**2 - e2) > ON_SHELL_TOLERANCE * epsilon (max (k(0)**2, e2)) - if (error) then - print *, k(0)**2 - e2 - print *, ON_SHELL_TOLERANCE * epsilon (max (k(0)**2, e2)), max (k(0)**2, e2) - end if -end function check_mass_shell -@ -<>= -subroutine omega_check_momenta_warn (m, k) - real(kind=default), dimension(:), intent(in) :: m - real(kind=default), dimension(0:,:), intent(in) :: k - integer :: i - if (check_momentum_conservation (k)) then - print *, "O'Mega: warning: momentum not conserved" - end if - do i = 1, size(m) - if (check_mass_shell (m(i), k(:,i))) then - print *, "O'Mega: warning: particle #", i, "not on-shell" - end if - end do -end subroutine omega_check_momenta_warn -@ -<>= -subroutine omega_check_momenta_panic (m, k) - real(kind=default), dimension(:), intent(in) :: m - real(kind=default), dimension(0:,:), intent(in) :: k - logical :: error - logical :: error1 - integer :: i - error = check_momentum_conservation (k) - if (error) then - print *, "O'Mega: panic: momentum not conserved" - end if - do i = 1, size(m) - error1 = check_mass_shell (m(i), k(0:,i)) - if (error1) then - print *, "O'Mega: panic: particle #", i, "not on-shell" - error = .true. - end if - end do - if (error) then - stop - end if -end subroutine omega_check_momenta_panic -@ \subsection{Summation \&\ Density Matrices} -<>= -public :: omega_spin_sum_sqme_1, omega_sum_sqme -@ -<>= -pure function omega_spin_sum_sqme_1 & - (amplitude_1, k, f, s_max, smask) result (amp2) - real(kind=default), dimension(0:,:), intent(in) :: k - integer, intent(in) :: f, s_max - logical, dimension(:), intent(in), optional :: smask - real(kind=default) :: amp2 - <> - complex(kind=default) :: amp - integer :: s - amp2 = 0 - if (present (smask)) then - do s = 1, s_max - if (smask(s)) then - amp = amplitude_1 (k, s, f) - amp2 = amp2 + amp * conjg (amp) - end if - end do - else - do s = 1, s_max - amp = amplitude_1 (k, s, f) - amp2 = amp2 + amp * conjg (amp) - end do - end if -end function omega_spin_sum_sqme_1 -@ -<>= -interface - pure function amplitude_1 (k, s, f) result (amp) - use kinds - implicit none - real(kind=default), dimension(0:,:), intent(in) :: k - integer, intent(in) :: s, f - complex(kind=default) :: amp - end function amplitude_1 -end interface -@ -<>= -pure function omega_sum_sqme & - (amplitude_1, k, s_max, f_max, mult, smask, fmask) result (amp2) - real(kind=default), dimension(0:,:), intent(in) :: k - integer, intent(in) :: s_max, f_max - integer, dimension(:), intent(in) :: mult - logical, dimension(:), intent(in), optional :: smask, fmask - real(kind=default) :: amp2 - <> - complex(kind=default) :: amp - integer :: s, f - amp2 = 0 - if (present (smask)) then - if (present (fmask)) then - do s = 1, s_max - if (smask(s)) then - do f = 1, f_max - if (fmask(f)) then - amp = amplitude_1 (k, s, f) - amp2 = amp2 + amp * conjg (amp) / mult(f) - end if - end do - end if - end do - else - do s = 1, s_max - if (smask(s)) then - do f = 1, f_max - amp = amplitude_1 (k, s, f) - amp2 = amp2 + amp * conjg (amp) / mult(f) - end do - end if - end do - end if - else - if (present (fmask)) then - do f = 1, f_max - if (fmask(f)) then - do s = 1, s_max - amp = amplitude_1 (k, s, f) - amp2 = amp2 + amp * conjg (amp) / mult(f) - end do - end if - end do - else - do s = 1, s_max - do f = 1, f_max - amp = amplitude_1 (k, s, f) - amp2 = amp2 + amp * conjg (amp) / mult(f) - end do - end do - end if - end if -end function omega_sum_sqme -@ -<>= -public :: omega_spin_sum_sqme_1_nonzero, omega_sum_sqme_nonzero -@ -<>= -pure subroutine omega_spin_sum_sqme_1_nonzero & - (amplitude_1, amp2, k, f, zero, n, smask) - real(kind=default), intent(out) :: amp2 - real(kind=default), dimension(0:,:), intent(in) :: k - integer, intent(in) :: f - integer, dimension(:,:), intent(inout) :: zero - integer, intent(in) :: n - logical, dimension(:), intent(in), optional :: smask - <> - complex(kind=default) :: amp - real(kind=default) :: dummy - integer :: s, i - if (n <= SAMPLE) then - call omega_sum_sqme_nonzero & - (amplitude_1, dummy, k, (/ (1, i = 1, size(zero,dim=2)) /), zero, n) - end if - amp2 = 0 - if (present (smask)) then - do s = 1, size(zero,dim=1) - if (smask(s)) then - if (zero(s,f) <= REPEAT) then - amp = amplitude_1 (k, s, f) - amp2 = amp2 + amp * conjg (amp) - end if - end if - end do - else - do s = 1, size(zero,dim=1) - if (zero(s,f) <= REPEAT) then - amp = amplitude_1 (k, s, f) - amp2 = amp2 + amp * conjg (amp) - end if - end do - end if -end subroutine omega_spin_sum_sqme_1_nonzero -@ -<>= -pure subroutine omega_sum_sqme_nonzero & - (amplitude_1, amp2, k, mult, zero, n, smask, fmask) - real(kind=default), intent(out) :: amp2 - real(kind=default), dimension(0:,:), intent(in) :: k - integer, dimension(:), intent(in) :: mult - integer, dimension(:,:), intent(inout) :: zero - integer, intent(in) :: n - logical, dimension(:), intent(in), optional :: smask, fmask - <> - complex(kind=default) :: amp - integer :: s, f - if (n <= SAMPLE) then - do s = 1, size(zero,dim=1) - do f = 1, size(zero,dim=2) - if (zero(s,f) <= REPEAT) then - amp = amplitude_1 (k, s, f) - if (real (amp * conjg (amp), kind=default) & - <= tiny (1.0_default)) then - zero(s,f) = zero(s,f) + 1 - end if - end if - end do - end do - end if - amp2 = 0 - if (present (smask)) then - if (present (fmask)) then - do s = 1, size(zero,dim=1) - if (smask(s)) then - do f = 1, size(zero,dim=2) - if (fmask(f)) then - if (zero(s,f) <= REPEAT) then - amp = amplitude_1 (k, s, f) - amp2 = amp2 + amp * conjg (amp) / mult(f) - end if - end if - end do - end if - end do - else - do s = 1, size(zero,dim=1) - if (smask(s)) then - do f = 1, size(zero,dim=2) - if (zero(s,f) <= REPEAT) then - amp = amplitude_1 (k, s, f) - amp2 = amp2 + amp * conjg (amp) / mult(f) - end if - end do - end if - end do - end if - else - if (present (fmask)) then - do f = 1, size(zero,dim=2) - if (fmask(f)) then - do s = 1, size(zero,dim=1) - if (zero(s,f) <= REPEAT) then - amp = amplitude_1 (k, s, f) - amp2 = amp2 + amp * conjg (amp) / mult(f) - end if - end do - end if - end do - else - do s = 1, size(zero,dim=1) - do f = 1, size(zero,dim=2) - if (zero(s,f) <= REPEAT) then - amp = amplitude_1 (k, s, f) - amp2 = amp2 + amp * conjg (amp) / mult(f) - end if - end do - end do - end if - end if -end subroutine omega_sum_sqme_nonzero -@ -<>= -public :: omega_amplitude_1_nonzero, omega_amplitude_2_nonzero -@ -<>= -pure subroutine omega_amplitude_1_nonzero & - (amplitude_1, amp, k, s, f, zero, n) - complex(kind=default), intent(out) :: amp - real(kind=default), dimension(0:,:), intent(in) :: k - integer, intent(in) :: s, f - integer, dimension(:,:), intent(inout) :: zero - integer, intent(in) :: n - <> - integer :: i - real(kind=default) :: dummy - if (n <= SAMPLE) then - call omega_sum_sqme_nonzero & - (amplitude_1, dummy, k, (/ (1, i = 1, size(zero,dim=2)) /), zero, n) - end if - if (zero(s,f) < REPEAT) then - amp = amplitude_1 (k, s, f) - else - amp = 0 - end if -end subroutine omega_amplitude_1_nonzero -@ -<>= -pure subroutine omega_amplitude_2_nonzero & - (amplitude_2, amp, k, s_in, f_in, s_out, f_out, zero, n) - complex(kind=default), intent(out) :: amp - real(kind=default), dimension(0:,:), intent(in) :: k - integer, intent(in) :: s_in, f_in, s_out, f_out - integer, dimension(:,:,:,:), intent(inout) :: zero - integer, intent(in) :: n - <> - integer :: si, fi, so, fo - if (n <= SAMPLE) then - do si = 1, size(zero,dim=1) - do fi = 1, size(zero,dim=2) - do so = 1, size(zero,dim=3) - do fo = 1, size(zero,dim=4) - if (zero(si,fi,so,fo) <= REPEAT) then - amp = amplitude_2 (k, si, fi, so, fo) - if (real (amp * conjg (amp), kind=default) & - <= tiny (1.0_default)) then - zero(si,fi,so,fo) = zero(si,fi,so,fo) + 1 - end if - end if - end do - end do - end do - end do - end if - if (zero(s_in,f_in,s_out,f_out) < REPEAT) then - amp = amplitude_2 (k, s_in, f_in, s_out, f_out) - else - amp = 0 - end if -end subroutine omega_amplitude_2_nonzero -@ -\begin{equation} - \rho \to \rho' = T \rho T^{\dagger} -\end{equation} -I.\,e. -\begin{equation} - \rho'_{ff'} = \sum_{ii'} T_{fi} \rho_{ii'} T^{*}_{i'f'} -\end{equation} -<>= -public :: omega_scatter, omega_scatter_nonzero -@ -<>= -pure subroutine omega_scatter (amplitude_2, k, rho_in, rho_out, mult) - real(kind=default), dimension(0:,:), intent(in) :: k - complex(kind=default), dimension(:,:,:,:), intent(in) :: rho_in - complex(kind=default), dimension(:,:,:,:), intent(inout) :: rho_out - integer, dimension(:), intent(in) :: mult - <> - integer :: s_in1, s_in2, f_in1, f_in2, s_out1, s_out2, f_out1, f_out2 - complex(kind=default), & - dimension(size(rho_in,dim=1),size(rho_in,dim=2),& - size(rho_out,dim=1),size(rho_out,dim=2)) :: a - do s_in1 = 1, size(rho_in,dim=1) - do f_in1 = 1, size(rho_in,dim=2) - do s_out1 = 1, size(rho_out,dim=1) - do f_out1 = 1, size(rho_out,dim=2) - a(s_in1,f_in1,s_out1,f_out1) = & - amplitude_2 (k, s_in1, f_in1, s_out1, f_out1) & - / sqrt (real (mult(f_out1), kind=default)) - end do - end do - end do - end do - do s_out1 = 1, size(rho_out,dim=1) - do f_out1 = 1, size(rho_out,dim=2) - do s_out2 = 1, size(rho_out,dim=3) - do f_out2 = 1, size(rho_out,dim=4) - rho_out(s_out1,f_out1,s_out2,f_out2) = 0 - do s_in1 = 1, size(rho_in,dim=1) - do f_in1 = 1, size(rho_in,dim=2) - do s_in2 = 1, size(rho_in,dim=3) - do f_in2 = 1, size(rho_in,dim=4) - rho_out(s_out1,f_out1,s_out2,f_out2) = & - rho_out(s_out1,f_out1,s_out2,f_out2) & - + a(s_in1,f_in1,s_out1,f_out1) & - * rho_in(s_in1,f_in1,s_in2,f_in2) & - * conjg (a(s_in2,f_in2,s_out2,f_out2)) - end do - end do - end do - end do - end do - end do - end do - end do -end subroutine omega_scatter -@ -<>= -interface - pure function amplitude_2 (k, s_in, f_in, s_out, f_out) result (amp) - use kinds - implicit none - real(kind=default), dimension(0:,:), intent(in) :: k - integer, intent(in) :: s_in, f_in, s_out, f_out - complex(kind=default) :: amp - end function amplitude_2 -end interface -@ -<>= -pure subroutine omega_scatter_nonzero & - (amplitude_2, k, rho_in, rho_out, mult, zero, n) - real(kind=default), dimension(0:,:), intent(in) :: k - complex(kind=default), dimension(:,:,:,:), intent(in) :: rho_in - complex(kind=default), dimension(:,:,:,:), intent(inout) :: rho_out - integer, dimension(:), intent(in) :: mult - integer, dimension(:,:,:,:), intent(inout) :: zero - integer, intent(in) :: n - <> - integer :: s_in1, s_in2, f_in1, f_in2, s_out1, s_out2, f_out1, f_out2 - complex(kind=default), & - dimension(size(rho_in,dim=1),size(rho_in,dim=2),& - size(rho_out,dim=1),size(rho_out,dim=2)) :: a - do s_in1 = 1, size(rho_in,dim=1) - do f_in1 = 1, size(rho_in,dim=2) - do s_out1 = 1, size(rho_out,dim=1) - do f_out1 = 1, size(rho_out,dim=2) - call amplitude_2 (a(s_in1,f_in1,s_out1,f_out1), & - k, s_in1, f_in1, s_out1, f_out1, zero, n) - a(s_in1,f_in1,s_out1,f_out1) = & - a(s_in1,f_in1,s_out1,f_out1) & - / sqrt (real (mult(f_out1), kind=default)) - end do - end do - end do - end do - do s_out1 = 1, size(rho_out,dim=1) - do f_out1 = 1, size(rho_out,dim=2) - do s_out2 = 1, size(rho_out,dim=3) - do f_out2 = 1, size(rho_out,dim=4) - rho_out(s_out1,f_out1,s_out2,f_out2) = 0 - do s_in1 = 1, size(rho_in,dim=1) - do f_in1 = 1, size(rho_in,dim=2) - do s_in2 = 1, size(rho_in,dim=3) - do f_in2 = 1, size(rho_in,dim=4) - rho_out(s_out1,f_out1,s_out2,f_out2) = & - rho_out(s_out1,f_out1,s_out2,f_out2) & - + a(s_in1,f_in1,s_out1,f_out1) & - * rho_in(s_in1,f_in1,s_in2,f_in2) & - * conjg (a(s_in2,f_in2,s_out2,f_out2)) - end do - end do - end do - end do - end do - end do - end do - end do -end subroutine omega_scatter_nonzero -@ -<>= -interface - pure subroutine amplitude_2 (amp, k, s_in, f_in, s_out, f_out, zero, n) - use kinds - implicit none - complex(kind=default), intent(out) :: amp - real(kind=default), dimension(0:,:), intent(in) :: k - integer, intent(in) :: s_in, f_in, s_out, f_out - integer, dimension(:,:,:,:), intent(inout) :: zero - integer, intent(in) :: n - end subroutine amplitude_2 -end interface -@ -\begin{equation} - \rho'_{f} = \sum_i T_{fi} \rho_{i} T^{*}_{if} - = \sum_i |T_{fi}|^2 \rho_{i} -\end{equation} -<>= -public :: omega_scatter_diagonal, omega_scatter_diagonal_nonzero -@ -<>= -pure subroutine omega_scatter_diagonal & - (amplitude_2, k, rho_in, rho_out, mult) - real(kind=default), dimension(0:,:), intent(in) :: k - real(kind=default), dimension(:,:), intent(in) :: rho_in - real(kind=default), dimension(:,:), intent(inout) :: rho_out - integer, dimension(:), intent(in) :: mult - <> - integer :: s_in, f_in, s_out, f_out - complex(kind=default) :: a - do s_out = 1, size(rho_out,dim=1) - do f_out = 1, size(rho_out,dim=2) - rho_out(s_out,f_out) = 0 - do s_in = 1, size(rho_in,dim=1) - do f_in = 1, size(rho_in,dim=2) - a = amplitude_2 (k, s_in, f_in, s_out, f_out) - rho_out(s_out,f_out) = rho_out(s_out,f_out) & - + rho_in(s_in,f_in) * real (a*conjg(a), kind=default) & - / mult(f_out) - end do - end do - end do - end do -end subroutine omega_scatter_diagonal -@ -<>= -pure subroutine omega_scatter_diagonal_nonzero & - (amplitude_2, k, rho_in, rho_out, mult, zero, n) - real(kind=default), dimension(0:,:), intent(in) :: k - real(kind=default), dimension(:,:), intent(in) :: rho_in - real(kind=default), dimension(:,:), intent(inout) :: rho_out - integer, dimension(:), intent(in) :: mult - integer, dimension(:,:,:,:), intent(inout) :: zero - integer, intent(in) :: n - <> - integer :: s_in, f_in, s_out, f_out - complex(kind=default) :: a - do s_out = 1, size(rho_out,dim=1) - do f_out = 1, size(rho_out,dim=2) - rho_out(s_out,f_out) = 0 - do s_in = 1, size(rho_in,dim=1) - do f_in = 1, size(rho_in,dim=2) - call amplitude_2 (a, k, s_in, f_in, s_out, f_out, zero, n) - rho_out(s_out,f_out) = rho_out(s_out,f_out) & - + rho_in(s_in,f_in) * real (a*conjg(a), kind=default) & - / mult(f_out) - end do - end do - end do - end do -end subroutine omega_scatter_diagonal_nonzero -@ \subsubsection{Flavor Summation} -\begin{dubious} - Interface to WHIZARD here \ldots -\end{dubious} -<>= -@ -<>= -@ \subsection{Obsolescent Summation} -\subsubsection{Spin/Helicity Summation} -<>= -public :: omega_sum, omega_sum_nonzero, omega_nonzero -private :: state_index -@ -<>= -pure function omega_sum (omega, p, states, fixed) result (sigma) - real(kind=default) :: sigma - real(kind=default), dimension(0:,:), intent(in) :: p - integer, dimension(:), intent(in), optional :: states, fixed - <<[[interface]] for O'Mega Amplitude>> - integer, dimension(size(p,dim=2)) :: s, nstates - integer :: j - complex(kind=default) :: a - if (present (states)) then - nstates = states - else - nstates = 2 - end if - sigma = 0 - s = -1 - sum_spins: do - if (present (fixed)) then - !!! print *, 's = ', s, ', fixed = ', fixed, ', nstates = ', nstates, & - !!! ', fixed|s = ', merge (fixed, s, mask = nstates == 0) - a = omega (p, merge (fixed, s, mask = nstates == 0)) - else - a = omega (p, s) - end if - sigma = sigma + a * conjg(a) - <> - end do sum_spins - sigma = sigma / num_states (2, nstates(1:2)) -end function omega_sum -@ We're looping over all spins like a $n$-ary numbers $(-1,\ldots,-1,-1)$, -$(-1,\ldots,-1,0)$, $(-1,\ldots,-1,1)$, $(-1,\ldots,0,-1)$, \ldots, -$(1,\ldots,1,0)$, $(1,\ldots,1,1)$: -<>= -do j = size (p, dim = 2), 1, -1 - select case (nstates (j)) - case (3) ! massive vectors - s(j) = modulo (s(j) + 2, 3) - 1 - case (2) ! spinors, massless vectors - s(j) = - s(j) - case (1) ! scalars - s(j) = -1 - case (0) ! fized spin - s(j) = -1 - case default ! ??? - s(j) = -1 - end select - if (s(j) /= -1) then - cycle sum_spins - end if -end do -exit sum_spins -@ The dual operation evaluates an $n$-number: -<>= -pure function state_index (s, states) result (n) - integer, dimension(:), intent(in) :: s - integer, dimension(:), intent(in), optional :: states - integer :: n - integer :: j, p - n = 1 - p = 1 - if (present (states)) then - do j = size (s), 1, -1 - select case (states(j)) - case (3) - n = n + p * (s(j) + 1) - case (2) - n = n + p * (s(j) + 1) / 2 - end select - p = p * states(j) - end do - else - do j = size (s), 1, -1 - n = n + p * (s(j) + 1) / 2 - p = p * 2 - end do - end if -end function state_index -@ -<<[[interface]] for O'Mega Amplitude>>= -interface - pure function omega (p, s) result (me) - use kinds - implicit none - complex(kind=default) :: me - real(kind=default), dimension(0:,:), intent(in) :: p - integer, dimension(:), intent(in) :: s - end function omega -end interface -@ -<>= -pure subroutine omega_sum_nonzero (sigma, omega, p, zero, n, states, fixed) - real(kind=default), intent(out) :: sigma - real(kind=default), dimension(0:,:), intent(in) :: p - integer, dimension(:), intent(inout) :: zero - integer, intent(in) :: n - integer, dimension(:), intent(in), optional :: states, fixed - <<[[interface]] for O'Mega Amplitude>> - integer, dimension(size(p,dim=2)) :: s, nstates - integer :: j, k - complex(kind=default) :: a - real(kind=default) :: a2 - if (present (states)) then - nstates = states - else - nstates = 2 - end if - sigma = 0 - s = -1 - k = 1 - sum_spins: do - if (zero (k) < REPEAT) then - if (present (fixed)) then - a = omega (p, merge (fixed, s, mask = nstates == 0)) - else - a = omega (p, s) - end if - a2 = a * conjg(a) - if (n <= SAMPLE .and. a2 <= tiny (1.0_default)) then - zero (k) = zero (k) + 1 - end if - sigma = sigma + a2 - end if - k = k + 1 - <> - end do sum_spins - sigma = sigma / num_states (2, nstates(1:2)) -end subroutine omega_sum_nonzero -@ -<>= -public :: num_states -@ -<>= -pure function num_states (n, states) result (ns) - integer, intent(in) :: n - integer, dimension(:), intent(in), optional :: states - integer :: ns - if (present (states)) then - ns = product (states, mask = states == 2 .or. states == 3) - else - ns = 2**n - end if -end function num_states -@ -<>= -pure subroutine omega_nonzero (a, omega, p, s, zero, n, states) - complex(kind=default), intent(out) :: a - real(kind=default), dimension(0:,:), intent(in) :: p - integer, dimension(:), intent(in) :: s - integer, dimension(:), intent(inout) :: zero - integer, intent(in) :: n - integer, dimension(:), intent(in), optional :: states - <<[[interface]] for O'Mega Amplitude>> - real(kind=default) :: dummy - if (n < SAMPLE) then - call omega_sum_nonzero (dummy, omega, p, zero, n, states) - end if - if (zero (state_index (s, states)) < REPEAT) then - a = omega (p, s) - else - a = 0 - end if -end subroutine omega_nonzero -@ -\section{\texttt{omega95}} -<<[[omega95.f95]]>>= -<> -module omega95 - use omega_constants - use omega_spinors - use omega_vectors - use omega_polarizations - use omega_tensors - use omega_tensor_polarizations - use omega_couplings - use omega_spinor_couplings - use omega_utils - public -end module omega95 -@ -\section{\texttt{omega95} Revisited} -<<[[omega95_bispinors.f95]]>>= -<> -module omega95_bispinors - use omega_constants - use omega_bispinors - use omega_vectors - use omega_vectorspinors - use omega_polarizations - use omega_vspinor_polarizations - use omega_couplings - use omega_bispinor_couplings - use omega_utils - public -end module omega95_bispinors -@ -\section{Standard Model Parameters} -<<[[omega_parameters.f95]]>>= -<> -module omega_parameters - use kinds - use omega_constants - implicit none - private - public :: setup_parameters, print_parameters - real(kind=default), dimension(37), save, public :: mass = 0, width = 0 - real(kind=default), parameter, public :: GeV = 1.0_default - real(kind=default), parameter, public :: MeV = GeV / 1000 - real(kind=default), parameter, public :: keV = MeV / 1000 - real(kind=default), parameter, public :: TeV = GeV * 1000 - real(kind=default), save, public :: & - alpha = 1.0_default / 137.0359895_default, & - sin2thw = 0.23124_default - !!! There is no fundamental reason in defining vev private; - !!! moreover it is needed for the K-matrix stuff. We also - !!! need g, sinthw and costhw for this - real(kind=default), save, public :: vev - real(kind=default), save, public :: g, sinthw, costhw - complex(kind=default), save, public :: & - qlep = 0, qup = 0, qdwn = 0, gcc = 0, qw = 0, & - gzww = 0, gwww = 0, ghww = 0, ghhww = 0, ghzz = 0, ghhzz = 0, & - ghbb = 0, ghtt = 0, ghcc = 0, ghtautau = 0, gh3 = 0, gh4 = 0, & - ghgaga = 0, ghgaz = 0, ghgg = 0, ghmm = 0, & - iqw = 0, igzww = 0, igwww = 0, & - gw4 = 0, gzzww = 0, gazww = 0, gaaww = 0, & - ig1a = 0, ig1z = 0, rg5a = 0, rg5z = 0, & - ig1pkpg4a = 0, ig1pkpg4z = 0, ig1pkmg4a = 0, ig1pkmg4z = 0, & - ig1mkpg4a = 0, ig1mkpg4z = 0, ig1mkmg4a = 0, ig1mkmg4z = 0, & - ila = 0, ilz = 0, il5a = 0, il5z = 0, ik5a = 0, ik5z = 0, & - ialww0 = 0, ialww2 = 0, ialzw0 = 0, ialzw1 = 0, ialzz = 0, & - alww0 = 0, alww2 = 0, alzw0 = 0, alzw1 = 0, alzz = 0, & - igdh4 = 0, gdh2w2 = 0, gdh2z2 = 0, gdhw2 = 0, gdhz2 = 0, & - gs = 0, igs = 0 - complex(kind=default), save, public :: & - sinckm12 = 0, sinckm13 = 0, sinckm23 = 0, & - cosckm12 = 0, cosckm13 = 0, cosckm23 = 0 - complex(kind=default), save, public :: & - vckm_11 = 0, vckm_12 = 0, vckm_13 = 0, vckm_21 = 0, & - vckm_22 = 0, vckm_23 = 0, vckm_31 = 0, vckm_32 = 0, vckm_33 = 0 - complex(kind=default), save, public :: & - gccq11 = 0, gccq12 = 0, gccq13 = 0, gccq21 = 0, & - gccq22 = 0, gccq23 = 0, gccq31 = 0, gccq32 = 0, gccq33 = 0 - real(kind=default), save, public :: & - a4 = 0, a5 = 0, a6 = 0, a7 = 0, a10 = 0 - real(kind=default), save, public :: & - g1a = 1, g1z = 1, kappaa = 1, kappaz = 1, lambdaa = 0, lambdaz = 0, & - g4a = 0, g4z = 0, g5a = 0, g5z = 0, & - kappa5a = 0, kappa5z = 0, lambda5a = 0, lambda5z = 0, & - alpha4 = 0, alpha5 = 0, tau4 = 0, tau5 = 0 - real(kind=default), save, public :: xia = 1, xi0 = 1, xipm = 1 - real(kind=default), save, public :: kc0 = 0, kp0 = 0, kc1 = 0, & - kp1 = 0, kc2 = 0, kp2 = 0 - real(kind=default), save, public :: lam_reg = 0 - complex(kind=default), dimension(2), save, public :: & - gnclep = 0, gncneu = 0, gncup = 0, gncdwn = 0 - complex(kind=default), save, public :: & - fudge_o1 = 1, fudge_o2 = 1, fudge_o3 = 1, fudge_o4 = 1 - real(kind=default), save, public :: & - fudge_higgs = 1, fudge_km = 1, w_res = 0 - real(kind=default), dimension(1:5), save, public :: & - gkm, mkm, wkm -contains - subroutine setup_parameters () - real(kind=default) :: e, qelep, qeup, qedwn - <> - <> - end subroutine setup_parameters - subroutine print_parameters () - <> - <> - end subroutine print_parameters -end module omega_parameters -@ -<>= -mass(1) = 5.0 * MeV -mass(2) = 3.0 * MeV -mass(3) = 100.0 * MeV -mass(4) = 1.2 * GeV -mass(5) = 4.2 * GeV -mass(6) = 174.0 * GeV -width(1:5) = 0 -width(6) = 1.3 * GeV -mass(11) = 0.51099907 * MeV -mass(12) = 0 -mass(13) = 105.658389 * MeV -mass(14) = 0 -mass(15) = 1777.05 * MeV -mass(16) = 0 -width(11:16) = 0 -mass(21) = 0 -mass(22) = 0 -width(21:22) = 0 -mass(23) = 91.187 * GeV -width(23) = 2.490 * GeV -mass(24) = 80.41 * GeV -width(24) = 2.06 * GeV -mass(25) = 120.00 * GeV -width(25) = 5.00 * GeV -mass(35) = 10000 * GeV -width(35) = 0 -sinckm12 = 0.0_default -sinckm13 = 0.0_default -sinckm23 = 0.0_default -cosckm12 = sqrt ((1.0_default - (sinckm12**2))) -cosckm13 = sqrt ((1.0_default - (sinckm13**2))) -cosckm23 = sqrt ((1.0_default - (sinckm23**2))) -@ -<>= -print *, "Quark masses:" -print *, mass(2:6:2) -print *, mass(1:5:2) -print *, "Lepton masses:" -print *, mass(12:16:2) -print *, mass(11:15:2) -print *, "Quark widths:" -print *, width(2:6:2) -print *, width(1:5:2) -print *, "Lepton widths:" -print *, width(12:16:2) -print *, width(11:15:2) -print *, "SU(2)xU(1) Gauge boson masses/widths:" -print *, mass(22:24) -print *, width(22:24) -print *, "Higgs boson and gluon masses/widths:" -print *, mass(25), mass(21) -print *, width(25), width(21) -@ -<>= -mass(26) = xi0 * mass(23) -width(26) = 0 -mass(27) = xipm * mass(24) -width(27) = 0 -@ -<>= -e = sqrt (4 * PI * alpha) -qelep = - 1 -qeup = 2.0_default / 3.0_default -qedwn = - 1.0_default / 3.0_default -@ -<>= -sinthw = sqrt (sin2thw) -costhw = sqrt (1 - sin2thw) -g = e / sinthw -gcc = - g / 2 / sqrt (2.0_default) -vckm_11 = cosckm12 * cosckm13 -vckm_12 = sinckm12 * cosckm13 -vckm_13 = sinckm13 -vckm_21 = - (sinckm12 * cosckm23 + & - cosckm12 * sinckm23 * sinckm13) -vckm_22 = cosckm12 * cosckm23 - & - sinckm12 * sinckm23 * sinckm13 -vckm_23 = sinckm23 * cosckm13 -vckm_31 = sinckm12 * sinckm23 - & - cosckm12 * cosckm23 * sinckm13 -vckm_32 = - (cosckm12 * sinckm23 + & - sinckm12 * cosckm23 * sinckm13) -vckm_33 = cosckm23 * cosckm13 -gccq11 = gcc * vckm_11 -gccq12 = gcc * vckm_12 -gccq13 = gcc * vckm_13 -gccq21 = gcc * vckm_21 -gccq22 = gcc * vckm_22 -gccq23 = gcc * vckm_23 -gccq31 = gcc * vckm_31 -gccq32 = gcc * vckm_32 -gccq33 = gcc * vckm_33 -@ -<>= -gncneu(1) = - g / 2 / costhw * ( + 0.5_default) -gnclep(1) = - g / 2 / costhw * ( - 0.5_default - 2 * qelep * sin2thw) -gncup(1) = - g / 2 / costhw * ( + 0.5_default - 2 * qeup * sin2thw) -gncdwn(1) = - g / 2 / costhw * ( - 0.5_default - 2 * qedwn * sin2thw) -gncneu(2) = - g / 2 / costhw * ( + 0.5_default) -gnclep(2) = - g / 2 / costhw * ( - 0.5_default) -gncup(2) = - g / 2 / costhw * ( + 0.5_default) -gncdwn(2) = - g / 2 / costhw * ( - 0.5_default) -@ -<>= -print *, "Neutral current couplings:" -print *, "U:", gncup -print *, "D:", gncdwn -print *, "N:", gncneu -print *, "L:", gnclep -@ -<>= -qlep = - e * qelep -qup = - e * qeup -qdwn = - e * qedwn -@ -<>= -print *, "Fermion charges:" -print *, "U:", qup -print *, "D:", qdwn -print *, "L:", qlep -@ -<>= -qw = e -iqw = (0,1)*qw -gzww = g * costhw -igzww = (0,1)*gzww -@ -<>= -print *, "TGC:" -print *, "WWA:", iqw -print *, "WWZ:", igzww -@ -<>= -gwww = g -igwww = (0,1)*gwww -ghww = mass(24) * g -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!!! This is for the old SM3: -!!! ghhww = (0,1) * g / Sqrt(2.0_default) -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -ghhww = g**2 / 2.0_default -ghzz = mass(23) * g / costhw -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!!! This is for the old SM3: -!!! ghhzz = (0,1) * g / costhw / Sqrt(2.0_default) -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -ghhzz = g**2 / 2.0_default / costhw**2 -@ -<>= -print *, "WWW:", igwww -print *, "WWH:", ghww -!!! print *, "WWHH:", ghhww**2 !!! Old SM3 -print *, "WWHH:", ghhww -!!! print *, "ZZHH:", ghhzz**2 !!! Old SM3 -print *, "ZZHH:", ghhzz -@ -<>= -gw4 = g**2 -gzzww = gzww**2 -gazww = gzww*e -gaaww = e**2 -@ -<>= -vev = 2.0 * mass(24) / g -ghtt = - mass(6) / vev -ghbb = - mass(5) / vev -ghcc = - mass(4) / vev -ghtautau = - mass(15) / vev -gh3 = - 3 * mass(25)**2 / vev -gh4 = - 3 * mass(25)**2 / vev**2 -!!! gh4 = mass(25) / vev !!! Old SM3 -@ -<>= -ig1a = iqw * g1a -ig1z = igzww * g1z -ig1pkpg4a = iqw * (g1a + kappaa + g4a) / 2 -ig1pkpg4z = igzww * (g1z + kappaz + g4z) / 2 -ig1pkmg4a = iqw * (g1a + kappaa - g4a) / 2 -ig1pkmg4z = igzww * (g1z + kappaz - g4z) / 2 -ig1mkpg4a = iqw * (g1a - kappaa + g4a) / 2 -ig1mkpg4z = igzww * (g1z - kappaz + g4z) / 2 -ig1mkmg4a = iqw * (g1a - kappaa - g4a) / 2 -ig1mkmg4z = igzww * (g1z - kappaz - g4z) / 2 -ila = iqw * lambdaa / (mass(24)*mass(24)) -ilz = igzww * lambdaz / (mass(24)*mass(24)) -@ -<>= -rg5a = qw * g5a -rg5z = gzww * g5z -ik5a = iqw * kappa5a -ik5z = igzww * kappa5z -il5a = iqw * lambda5a / (mass(24)*mass(24)) -il5z = igzww * lambda5z / (mass(24)*mass(24)) -@ -<>= -alww0 = g**4 * (alpha4 + 2 * alpha5) -alww2 = g**4 * 2 * alpha4 -alzw1 = g**4 / costhw**2 * alpha4 -alzw0 = g**4 / costhw**2 * 2 * alpha5 -alzz = g**4 / costhw**4 * 2 * (alpha4 + alpha5) -@ -<>= -ialww0 = g**2 * sqrt ( - cmplx (alpha4 + 2 * alpha5, kind=default)) -ialww2 = g**2 * sqrt ( - cmplx (2 * alpha4, kind=default)) -ialzw1 = g**2 / costhw * sqrt ( - cmplx (alpha4, kind=default)) -ialzw0 = g**2 / costhw * sqrt ( - cmplx (2 * alpha5, kind=default)) -ialzz = g**2 / (costhw*costhw) & - * sqrt ( - cmplx (2 * (alpha4 + alpha5), kind=default)) -@ -<>= -gdh2w2 = g * vev * sqrt (cmplx (tau4, kind=default)) -gdhw2 = g * vev * sqrt (cmplx (tau5 / 2, kind=default)) -gdh2z2 = g * vev / costhw * sqrt (cmplx (tau4, kind=default)) -gdhz2 = g * vev / costhw * sqrt (cmplx (tau5 / 2, kind=default)) -igdh4 = g**2 * sqrt ( - cmplx (8 * (tau4 + tau5), kind=default)) -@ -<<[[omega_parameters_madgraph.f95]]>>= -<> -module omega_parameters_madgraph - use kinds - use omega_parameters - implicit none - private - public :: export_parameters_to_madgraph - integer, parameter, private :: D = selected_real_kind (14, 100) - real(kind=D), save, public :: gw = 0, gwwa = 0, gwwz = 0 - real(kind=D), dimension(2), save, public :: gal = 0, gau = 0, gad = 0, gwf = 0 - real(kind=D), dimension(2), save, public :: gzn = 0, gzl = 0, gzu = 0, gzd = 0, g1 = 0 - real(kind=D), save, public :: gwwh = 0, gzzh = 0, ghhh = 0, & - gwwhh = 0, gzzhh = 0, ghhhh = 0 - complex(kind=D), dimension(2,12), save, public :: gh = 0 - real(kind=D), save, public :: wmass = 0, wwidth = 0, zmass = 0, zwidth = 0 - real(kind=D), save, public :: amass = 0, awidth = 0, hmass = 0, hwidth = 0 - real(kind=D), dimension(12), save, public :: fmass = 0, fwidth = 0 - complex(kind=D), save, public :: fudge_m1 = 1, fudge_m2 = 1, fudge_m3 = 1, fudge_m4 = 1 -contains - subroutine export_parameters_to_madgraph () - <> - <> - end subroutine export_parameters_to_madgraph -end module omega_parameters_madgraph -@ Electromagnetic couplings -<>= -gal = qlep -gau = qup -gad = qdwn -@ NC couplings -\begin{equation} - \gamma^\mu \left( - g^M_1\frac{1-\gamma_5}{2} + g^M_2\frac{1+\gamma_5}{2} \right) - = \gamma^\mu \left( g^\Omega_1 - g^\Omega_2 \gamma_5 \right) -\end{equation} -therefore -\begin{equation} - \frac{g^M_1 \pm g^M_2}{2} = g^\Omega_{1,2} -\end{equation} -and -\begin{equation} - g^M_{1,2} = g^\Omega_1 \pm g^\Omega_2 -\end{equation} -<>= -gzl(1) = gnclep(1) + gnclep(2) -gzl(2) = gnclep(1) - gnclep(2) -gzn(1) = gncneu(1) + gncneu(2) -gzn(2) = gncneu(1) - gncneu(2) -gzu(1) = gncup(1) + gncup(2) -gzu(2) = gncup(1) - gncup(2) -gzd(1) = gncdwn(1) + gncdwn(2) -gzd(2) = gncdwn(1) - gncdwn(2) -@ CC couplings -\begin{equation} - \gamma^\mu \left( - g^M_1\frac{1-\gamma_5}{2} + g^M_2\frac{1+\gamma_5}{2} \right) - = g^\Omega \gamma^\mu \left( 1 - \gamma_5 \right) -\end{equation} -therefore -\begin{equation} - g^M_1 = 2 g^\Omega,\; g^M_2 = 0 -\end{equation} -<>= -gwf(1) = 2 * gcc -gwf(2) = 0 -@ -<>= -gwwa = qw -gwwz = gzww -gwwh = ghww -!!! gwwhh = ghhww**2 !!! Old SM3 -gwwhh = ghhww -gzzh = ghzz -!!! gzzhh = ghhzz**2 !!! Old SM3 -gzzhh = ghhzz -ghhh = gh3 -ghhhh = gh4 -@ MADGRAPH has the Yukawa couplings disabled: -<>= -ghtt = 0 -ghbb = 0 -ghcc = 0 -ghtautau = 0 -gh3 = 0 -gh4 = 0 -@ -<>= -gh(:,1:6) = 0 -gh(:,7) = ghcc -gh(:,8) = 0 -gh(:,9) = ghtautau -gh(:,10) = 0 -gh(:,11) = ghtt -gh(:,12) = ghbb -@ Leptons -<>= -fmass(1:2) = mass(11:12) -fwidth(1:2) = width(11:12) -fmass(5:6) = mass(13:14) -fwidth(5:6) = width(13:14) -fmass(9:10) = mass(15:16) -fwidth(9:10) = width(15:16) -@ Quarks -<>= -fmass(4) = mass(1) -fwidth(4) = width(1) -fmass(3) = mass(2) -fwidth(3) = width(2) -fmass(8) = mass(3) -fwidth(8) = width(3) -fmass(7) = mass(4) -fwidth(7) = width(4) -fmass(12) = mass(5) -fwidth(12) = width(5) -fmass(11) = mass(6) -fwidth(11) = width(6) -@ Gauge bosons -<>= -amass = mass(22) -awidth = width(22) -zmass = mass(23) -zwidth = width(23) -wmass = mass(24) -wwidth = width(24) -@ EWSB sector masses -<>= -hmass = mass(25) -hwidth = width(25) -@ -<<[[omega_parameters_whizard.f95]]>>= -<> -module omega_parameters_whizard - use kinds - use omega_parameters - use parameters - implicit none - private - public :: import_from_whizard -contains - subroutine import_from_whizard (par) - type(parameter_set), intent(in) :: par - real(kind=default) :: e, g, sinthw, costhw, qelep, qeup, qedwn, v - <> - <> - end subroutine import_from_whizard -end module omega_parameters_whizard -@ -<>= -mass(1:27) = 0 -width(1:27) = 0 -@ -<>= -mass(3) = par%Ms -mass(4) = par%Mc -mass(5) = par%Mb -mass(6) = par%Mtop -width(6) = par%wtop -@ -<>= -mass(11) = par%Me -mass(13) = par%Mm -mass(15) = par%Mt -@ -<>= -mass(23) = par%mZ -width(23) = par%wZ -mass(24) = par%mW -width(24) = par%wW -@ -<>= -mass(25) = par%mH -width(25) = par%wH -@ -<>= -mass(26) = xi0 * mass(23) -width(26) = 0 -mass(27) = xipm * mass(24) -width(27) = 0 -@ -<>= -e = par%EE -sinthw = par%SW -sin2thw = sinthw**2 -costhw = par%CW -@ -<>= -qelep = - 1 -qeup = 2.0_default / 3.0_default -qedwn = - 1.0_default / 3.0_default -@ -<>= -g = e / sinthw -gcc = - g / 2 / sqrt (2.0_default) -gncneu(1) = - g / 2 / costhw * ( + 0.5_default) -gnclep(1) = - g / 2 / costhw * ( - 0.5_default - 2 * qelep * sin2thw) -gncup(1) = - g / 2 / costhw * ( + 0.5_default - 2 * qeup * sin2thw) -gncdwn(1) = - g / 2 / costhw * ( - 0.5_default - 2 * qedwn * sin2thw) -gncneu(2) = - g / 2 / costhw * ( + 0.5_default) -gnclep(2) = - g / 2 / costhw * ( - 0.5_default) -gncup(2) = - g / 2 / costhw * ( + 0.5_default) -gncdwn(2) = - g / 2 / costhw * ( - 0.5_default) -qlep = - e * qelep -qup = - e * qeup -qdwn = - e * qedwn -@ -<>= -qw = e -iqw = (0,1)*qw -gzww = g * costhw -igzww = (0,1)*gzww -gwww = g -igwww = (0,1)*gwww -ghww = mass(24) * g -ghhww = (0,1) * g / Sqrt(2.0_default) -ghzz = mass(23) * g / costhw -ghhzz = (0,1) * g / costhw / Sqrt(2.0_default) -vev = 2.0 * mass(24) / g -ghtt = - mass(6) / vev -ghbb = - mass(5) / vev -ghcc = - mass(4) / vev -ghtautau = - mass(15) / vev -gh3 = - 3 * par%MH**2 / vev -gh4 = par%MH / vev -@ -<>= -ig1a = iqw * g1a -ig1z = igzww * g1z -ig1pkpg4a = iqw * (g1a + kappaa + g4a) / 2 -ig1pkpg4z = igzww * (g1z + kappaz + g4z) / 2 -ig1pkmg4a = iqw * (g1a + kappaa - g4a) / 2 -ig1pkmg4z = igzww * (g1z + kappaz - g4z) / 2 -ig1mkpg4a = iqw * (g1a - kappaa + g4a) / 2 -ig1mkpg4z = igzww * (g1z - kappaz + g4z) / 2 -ig1mkmg4a = iqw * (g1a - kappaa - g4a) / 2 -ig1mkmg4z = igzww * (g1z - kappaz - g4z) / 2 -ila = iqw * lambdaa / (mass(24)*mass(24)) -ilz = igzww * lambdaz / (mass(24)*mass(24)) -rg5a = qw * g5a -rg5z = gzww * g5z -ik5a = iqw * kappa5a -ik5z = igzww * kappa5z -il5a = iqw * lambda5a / (mass(24)*mass(24)) -il5z = igzww * lambda5z / (mass(24)*mass(24)) -ialww0 = g**2 * sqrt ( - cmplx (alpha4 + 2 * alpha5, kind=default)) -ialww2 = g**2 * sqrt ( - cmplx (2 * alpha4, kind=default)) -ialzw1 = g**2 / costhw * sqrt ( - cmplx (alpha4, kind=default)) -ialzw0 = g**2 / costhw * sqrt ( - cmplx (2 * alpha5, kind=default)) -ialzz = g**2 / (costhw*costhw) & - * sqrt ( - cmplx (2 * (alpha4 + alpha5), kind=default)) -@ -<<[[omega_parameters_whizard2.f95]]>>= -<> -module omega_parameters_whizard - use kinds - use omega_parameters - use parameters - implicit none - private - public :: import_from_whizard -contains - subroutine import_from_whizard (par) - type(parameter_set), intent(in) :: par - real(kind=default) :: e, g, sinthw, costhw, qelep, qeup, qedwn, v - <> - <> - end subroutine import_from_whizard -end module omega_parameters_whizard -@ -\section{Testing} -<<[[omega_testtools.f95]]>>= -<> -module omega_testtools - use kinds - implicit none - private - public :: print_matrix - public :: expect - real(kind=default), parameter, private :: TOLERANCE = 1.0e8 - <> -contains - subroutine print_matrix (a) - complex(kind=default), dimension(:,:), intent(in) :: a - integer :: row - do row = 1, size (a, dim=1) - write (unit = *, fmt = "(10(tr2, f5.2, '+', f5.2, 'I'))") a(row,:) - end do - end subroutine print_matrix - <> -end module omega_testtools -@ -<>= -interface expect - module procedure expect_integer, expect_real, expect_complex, & - expect_double_integer, expect_complex_integer, expect_complex_real -end interface -private :: expect_integer, expect_real, expect_complex, & - expect_double_integer, expect_complex_integer, expect_complex_real -@ -<>= -subroutine expect_integer (x, x0, msg) - integer, intent(in) :: x, x0 - character(len=*), intent(in) :: msg - if (x == x0) then - print *, msg, " passed" - else - print *, msg, " FAILED: expected ", x0, " got ", x - end if -end subroutine expect_integer -@ -<>= -subroutine expect_real (x, x0, msg) - real(kind=default), intent(in) :: x, x0 - character(len=*), intent(in) :: msg - if (x == x0) then - print *, msg, " passed exactly" - else if (abs (x - x0) <= epsilon (x)) then - print *, msg, " passed at machine precision" - else if (abs (x - x0) <= TOLERANCE * epsilon (x)) then - print *, msg, " passed at", & - ceiling (abs (x - x0) / epsilon (x)), "* machine precision" - else - print *, msg, " FAILED: expected ", x0, " got ", x, " (", & - (x - x0) / epsilon (x), " epsilon)" - end if -end subroutine expect_real -@ -<>= -subroutine expect_complex (x, x0, msg) - complex(kind=default), intent(in) :: x, x0 - character(len=*), intent(in) :: msg - if (x == x0) then - print *, msg, " passed exactly" - else if (abs (x - x0) <= epsilon (real(x))) then - print *, msg, " passed at machine precision" - else if (abs (x - x0) <= TOLERANCE * epsilon (real(x))) then - print *, msg, " passed at", & - ceiling (abs (x - x0) / epsilon (real(x))), "* machine precision" - else - print *, msg, " FAILED: expected ", x0, " got ", x, " (", & - (x - x0) / epsilon (real(x)), " epsilon)" - end if -end subroutine expect_complex -@ -<>= -subroutine expect_double_integer (x, x0, msg) - real(kind=default), intent(in) :: x - integer, intent(in) :: x0 - character(len=*), intent(in) :: msg - call expect_real (x, real (x0, kind=default), msg) -end subroutine expect_double_integer -@ -<>= -subroutine expect_complex_integer (x, x0, msg) - complex(kind=default), intent(in) :: x - integer, intent(in) :: x0 - character(len=*), intent(in) :: msg - call expect_complex (x, cmplx (x0, kind=default), msg) -end subroutine expect_complex_integer -@ -<>= -subroutine expect_complex_real (x, x0, msg) - complex(kind=default), intent(in) :: x - real(kind=default), intent(in) :: x0 - character(len=*), intent(in) :: msg - call expect_complex (x, cmplx (x0, kind=default), msg) -end subroutine expect_complex_real -@ -<<[[test_omega95.f95]]>>= -<> -program test_omega95 - use kinds - use omega95 - use omega_testtools - implicit none - real(kind=default) :: m, pabs, qabs, w - real(kind=default), dimension(0:3) :: r - complex(kind=default) :: one - type(momentum) :: p, q - type(vector) :: vp, vq, vtest - type(tensor) :: ttest - integer, dimension(8) :: date_time - integer :: rsize - call date_and_time (values = date_time) - call random_seed (size = rsize) - call random_seed (put = spread (product (date_time), dim = 1, ncopies = rsize)) - w = 1.4142 - one = 1 - m = 13 - pabs = 42 - qabs = 137 - call random_number (r) - vtest%t = cmplx (10.0_default * r(0)) - vtest%x(1:3) = cmplx (10.0_default * r(1:3)) - ttest = vtest.tprod.vtest - call random_momentum (p, pabs, m) - call random_momentum (q, qabs, m) - vp = p - vq = q - <> -end program test_omega95 -@ -<>= -print *, "*** Checking the equations of motion ***:" -call expect (abs(f_vf(one,vp,u(m,p,+1))-m*u(m,p,+1)), 0, "|[p-m]u(+)|=0") -call expect (abs(f_vf(one,vp,u(m,p,-1))-m*u(m,p,-1)), 0, "|[p-m]u(-)|=0") -call expect (abs(f_vf(one,vp,v(m,p,+1))+m*v(m,p,+1)), 0, "|[p+m]v(+)|=0") -call expect (abs(f_vf(one,vp,v(m,p,-1))+m*v(m,p,-1)), 0, "|[p+m]v(-)|=0") -call expect (abs(f_fv(one,ubar(m,p,+1),vp)-m*ubar(m,p,+1)), 0, "|ubar(+)[p-m]|=0") -call expect (abs(f_fv(one,ubar(m,p,-1),vp)-m*ubar(m,p,-1)), 0, "|ubar(-)[p-m]|=0") -call expect (abs(f_fv(one,vbar(m,p,+1),vp)+m*vbar(m,p,+1)), 0, "|vbar(+)[p+m]|=0") -call expect (abs(f_fv(one,vbar(m,p,-1),vp)+m*vbar(m,p,-1)), 0, "|vbar(-)[p+m]|=0") -@ -<>= -print *, "*** Checking the normalization ***:" -call expect (ubar(m,p,+1)*u(m,p,+1), +2*m, "ubar(+)*u(+)=+2m") -call expect (ubar(m,p,-1)*u(m,p,-1), +2*m, "ubar(-)*u(-)=+2m") -call expect (vbar(m,p,+1)*v(m,p,+1), -2*m, "vbar(+)*v(+)=-2m") -call expect (vbar(m,p,-1)*v(m,p,-1), -2*m, "vbar(-)*v(-)=-2m") -call expect (ubar(m,p,+1)*v(m,p,+1), 0, "ubar(+)*v(+)=0 ") -call expect (ubar(m,p,-1)*v(m,p,-1), 0, "ubar(-)*v(-)=0 ") -call expect (vbar(m,p,+1)*u(m,p,+1), 0, "vbar(+)*u(+)=0 ") -call expect (vbar(m,p,-1)*u(m,p,-1), 0, "vbar(-)*u(-)=0 ") -@ -<>= -print *, "*** Checking the currents ***:" -call expect (abs(v_ff(one,ubar(m,p,+1),u(m,p,+1))-2*vp), 0, "ubar(+).V.u(+)=2p") -call expect (abs(v_ff(one,ubar(m,p,-1),u(m,p,-1))-2*vp), 0, "ubar(-).V.u(-)=2p") -call expect (abs(v_ff(one,vbar(m,p,+1),v(m,p,+1))-2*vp), 0, "vbar(+).V.v(+)=2p") -call expect (abs(v_ff(one,vbar(m,p,-1),v(m,p,-1))-2*vp), 0, "vbar(-).V.v(-)=2p") -@ -<>= -print *, "*** Checking current conservation ***:" -call expect ((vp-vq)*v_ff(one,ubar(m,p,+1),u(m,q,+1)), 0, "d(ubar(+).V.u(+))=0") -call expect ((vp-vq)*v_ff(one,ubar(m,p,-1),u(m,q,-1)), 0, "d(ubar(-).V.u(-))=0") -call expect ((vp-vq)*v_ff(one,vbar(m,p,+1),v(m,q,+1)), 0, "d(vbar(+).V.v(+))=0") -call expect ((vp-vq)*v_ff(one,vbar(m,p,-1),v(m,q,-1)), 0, "d(vbar(-).V.v(-))=0") -@ -<>= -if (m == 0) then - print *, "*** Checking axial current conservation ***:" - call expect ((vp-vq)*a_ff(one,ubar(m,p,+1),u(m,q,+1)), 0, "d(ubar(+).A.u(+))=0") - call expect ((vp-vq)*a_ff(one,ubar(m,p,-1),u(m,q,-1)), 0, "d(ubar(-).A.u(-))=0") - call expect ((vp-vq)*a_ff(one,vbar(m,p,+1),v(m,q,+1)), 0, "d(vbar(+).A.v(+))=0") - call expect ((vp-vq)*a_ff(one,vbar(m,p,-1),v(m,q,-1)), 0, "d(vbar(-).A.v(-))=0") -end if -@ -<>= -print *, "*** Checking polarisation vectors: ***" -call expect (conjg(eps(m,p, 1))*eps(m,p, 1), -1, "e( 1).e( 1)=-1") -call expect (conjg(eps(m,p, 1))*eps(m,p,-1), 0, "e( 1).e(-1)= 0") -call expect (conjg(eps(m,p,-1))*eps(m,p, 1), 0, "e(-1).e( 1)= 0") -call expect (conjg(eps(m,p,-1))*eps(m,p,-1), -1, "e(-1).e(-1)=-1") -call expect ( p*eps(m,p, 1), 0, " p.e( 1)= 0") -call expect ( p*eps(m,p,-1), 0, " p.e(-1)= 0") -if (m > 0) then - call expect (conjg(eps(m,p, 1))*eps(m,p, 0), 0, "e( 1).e( 0)= 0") - call expect (conjg(eps(m,p, 0))*eps(m,p, 1), 0, "e( 0).e( 1)= 0") - call expect (conjg(eps(m,p, 0))*eps(m,p, 0), -1, "e( 0).e( 0)=-1") - call expect (conjg(eps(m,p, 0))*eps(m,p,-1), 0, "e( 0).e(-1)= 0") - call expect (conjg(eps(m,p,-1))*eps(m,p, 0), 0, "e(-1).e( 0)= 0") - call expect ( p*eps(m,p, 0), 0, " p.e( 0)= 0") -end if -@ -<>= -print *, "*** Checking epsilon tensor: ***" -call expect ( pseudo_scalar(eps(m,p,1),eps(m,q,1),eps(m,p,0),eps(m,q,0)), & - - pseudo_scalar(eps(m,q,1),eps(m,p,1),eps(m,p,0),eps(m,q,0)), "eps(1<->2)") -call expect ( pseudo_scalar(eps(m,p,1),eps(m,q,1),eps(m,p,0),eps(m,q,0)), & - - pseudo_scalar(eps(m,p,0),eps(m,q,1),eps(m,p,1),eps(m,q,0)), "eps(1<->3)") -call expect ( pseudo_scalar(eps(m,p,1),eps(m,q,1),eps(m,p,0),eps(m,q,0)), & - - pseudo_scalar(eps(m,q,0),eps(m,q,1),eps(m,p,0),eps(m,p,1)), "eps(1<->4)") -call expect ( pseudo_scalar(eps(m,p,1),eps(m,q,1),eps(m,p,0),eps(m,q,0)), & - - pseudo_scalar(eps(m,p,1),eps(m,p,0),eps(m,q,1),eps(m,q,0)), "eps(2<->3)") -call expect ( pseudo_scalar(eps(m,p,1),eps(m,q,1),eps(m,p,0),eps(m,q,0)), & - - pseudo_scalar(eps(m,p,1),eps(m,q,0),eps(m,p,0),eps(m,q,1)), "eps(2<->4)") -call expect ( pseudo_scalar(eps(m,p,1),eps(m,q,1),eps(m,p,0),eps(m,q,0)), & - - pseudo_scalar(eps(m,p,1),eps(m,q,1),eps(m,q,0),eps(m,p,0)), "eps(3<->4)") -call expect ( pseudo_scalar(eps(m,p,1),eps(m,q,1),eps(m,p,0),eps(m,q,0)), & - eps(m,p,1)*pseudo_vector(eps(m,q,1),eps(m,p,0),eps(m,q,0)), "eps'") -@ -\begin{equation} - \frac{1}{2} [x\wedge y]^*_{\mu\nu} [x\wedge y]^{\mu\nu} - = \frac{1}{2} (x^*_\mu y^*_\nu-x^*_\nu y^*_\mu) (x^\mu y^\nu-x^\nu y^\mu) - = (x^*x) (y^*y) - (x^*y) (y^*x) -\end{equation} -<>= -print *, "*** Checking tensors: ***" -call expect (conjg(p.wedge.q)*(p.wedge.q), (p*p)*(q*q)-(p*q)**2, & - "[p,q].[q,p]=p.p*q.q-p.q^2") -call expect (conjg(p.wedge.q)*(q.wedge.p), (p*q)**2-(p*p)*(q*q), & - "[p,q].[q,p]=p.q^2-p.p*q.q") -@ i.\,e. -\begin{equation} - \frac{1}{2} [p\wedge\epsilon(p,i)]^*_{\mu\nu} [p\wedge\epsilon(p,j)]^{\mu\nu} - = - p^2 \delta_{ij} -\end{equation} -<>= -call expect (conjg(p.wedge.eps(m,p, 1))*(p.wedge.eps(m,p, 1)), -p*p, & - "[p,e( 1)].[p,e( 1)]=-p.p") -call expect (conjg(p.wedge.eps(m,p, 1))*(p.wedge.eps(m,p,-1)), 0, & - "[p,e( 1)].[p,e(-1)]=0") -call expect (conjg(p.wedge.eps(m,p,-1))*(p.wedge.eps(m,p, 1)), 0, & - "[p,e(-1)].[p,e( 1)]=0") -call expect (conjg(p.wedge.eps(m,p,-1))*(p.wedge.eps(m,p,-1)), -p*p, & - "[p,e(-1)].[p,e(-1)]=-p.p") -if (m > 0) then - call expect (conjg(p.wedge.eps(m,p, 1))*(p.wedge.eps(m,p, 0)), 0, & - "[p,e( 1)].[p,e( 0)]=0") - call expect (conjg(p.wedge.eps(m,p, 0))*(p.wedge.eps(m,p, 1)), 0, & - "[p,e( 0)].[p,e( 1)]=0") - call expect (conjg(p.wedge.eps(m,p, 0))*(p.wedge.eps(m,p, 0)), -p*p, & - "[p,e( 0)].[p,e( 0)]=-p.p") - call expect (conjg(p.wedge.eps(m,p, 0))*(p.wedge.eps(m,p,-1)), 0, & - "[p,e( 1)].[p,e(-1)]=0") - call expect (conjg(p.wedge.eps(m,p,-1))*(p.wedge.eps(m,p, 0)), 0, & - "[p,e(-1)].[p,e( 0)]=0") -end if -@ also -\begin{align} - [x\wedge y]_{\mu\nu} z^\nu &= x_\mu (yz) - y_\mu (xz) \\ - z_\mu [x\wedge y]^{\mu\nu} &= (zx) y^\nu - (zy) x^\nu -\end{align} -<>= -call expect (abs ((p.wedge.eps(m,p, 1))*p + (p*p)*eps(m,p, 1)), 0, & - "[p,e( 1)].p=-p.p*e( 1)]") -call expect (abs ((p.wedge.eps(m,p, 0))*p + (p*p)*eps(m,p, 0)), 0, & - "[p,e( 0)].p=-p.p*e( 0)]") -call expect (abs ((p.wedge.eps(m,p,-1))*p + (p*p)*eps(m,p,-1)), 0, & - "[p,e(-1)].p=-p.p*e(-1)]") -call expect (abs (p*(p.wedge.eps(m,p, 1)) - (p*p)*eps(m,p, 1)), 0, & - "p.[p,e( 1)]=p.p*e( 1)]") -call expect (abs (p*(p.wedge.eps(m,p, 0)) - (p*p)*eps(m,p, 0)), 0, & - "p.[p,e( 0)]=p.p*e( 0)]") -call expect (abs (p*(p.wedge.eps(m,p,-1)) - (p*p)*eps(m,p,-1)), 0, & - "p.[p,e(-1)]=p.p*e(-1)]") -@ -<>= -print *, "*** Checking polarisation tensors: ***" -call expect (conjg(eps2(m,p, 2))*eps2(m,p, 2), 1, "e2( 2).e2( 2)=1") -call expect (conjg(eps2(m,p, 2))*eps2(m,p,-2), 0, "e2( 2).e2(-2)=0") -call expect (conjg(eps2(m,p,-2))*eps2(m,p, 2), 0, "e2(-2).e2( 2)=0") -call expect (conjg(eps2(m,p,-2))*eps2(m,p,-2), 1, "e2(-2).e2(-2)=1") -if (m > 0) then - call expect (conjg(eps2(m,p, 2))*eps2(m,p, 1), 0, "e2( 2).e2( 1)=0") - call expect (conjg(eps2(m,p, 2))*eps2(m,p, 0), 0, "e2( 2).e2( 0)=0") - call expect (conjg(eps2(m,p, 2))*eps2(m,p,-1), 0, "e2( 2).e2(-1)=0") - call expect (conjg(eps2(m,p, 1))*eps2(m,p, 2), 0, "e2( 1).e2( 2)=0") - call expect (conjg(eps2(m,p, 1))*eps2(m,p, 1), 1, "e2( 1).e2( 1)=1") - call expect (conjg(eps2(m,p, 1))*eps2(m,p, 0), 0, "e2( 1).e2( 0)=0") - call expect (conjg(eps2(m,p, 1))*eps2(m,p,-1), 0, "e2( 1).e2(-1)=0") - call expect (conjg(eps2(m,p, 1))*eps2(m,p,-2), 0, "e2( 1).e2(-2)=0") - call expect (conjg(eps2(m,p, 0))*eps2(m,p, 2), 0, "e2( 0).e2( 2)=0") - call expect (conjg(eps2(m,p, 0))*eps2(m,p, 1), 0, "e2( 0).e2( 1)=0") - call expect (conjg(eps2(m,p, 0))*eps2(m,p, 0), 1, "e2( 0).e2( 0)=1") - call expect (conjg(eps2(m,p, 0))*eps2(m,p,-1), 0, "e2( 0).e2(-1)=0") - call expect (conjg(eps2(m,p, 0))*eps2(m,p,-2), 0, "e2( 0).e2(-2)=0") - call expect (conjg(eps2(m,p,-1))*eps2(m,p, 2), 0, "e2(-1).e2( 2)=0") - call expect (conjg(eps2(m,p,-1))*eps2(m,p, 1), 0, "e2(-1).e2( 1)=0") - call expect (conjg(eps2(m,p,-1))*eps2(m,p, 0), 0, "e2(-1).e2( 0)=0") - call expect (conjg(eps2(m,p,-1))*eps2(m,p,-1), 1, "e2(-1).e2(-1)=1") - call expect (conjg(eps2(m,p,-1))*eps2(m,p,-2), 0, "e2(-1).e2(-2)=0") - call expect (conjg(eps2(m,p,-2))*eps2(m,p, 1), 0, "e2(-2).e2( 1)=0") - call expect (conjg(eps2(m,p,-2))*eps2(m,p, 0), 0, "e2(-2).e2( 0)=0") - call expect (conjg(eps2(m,p,-2))*eps2(m,p,-1), 0, "e2(-2).e2(-1)=0") -end if -@ -<>= -call expect ( abs(p*eps2(m,p, 2) ), 0, " |p.e2( 2)| =0") -call expect ( abs(eps2(m,p, 2)*p), 0, " |e2( 2).p|=0") -call expect ( abs(p*eps2(m,p,-2) ), 0, " |p.e2(-2)| =0") -call expect ( abs(eps2(m,p,-2)*p), 0, " |e2(-2).p|=0") -if (m > 0) then - call expect ( abs(p*eps2(m,p, 1) ), 0, " |p.e2( 1)| =0") - call expect ( abs(eps2(m,p, 1)*p), 0, " |e2( 1).p|=0") - call expect ( abs(p*eps2(m,p, 0) ), 0, " |p.e2( 0)| =0") - call expect ( abs(eps2(m,p, 0)*p), 0, " |e2( 0).p|=0") - call expect ( abs(p*eps2(m,p,-1) ), 0, " |p.e2(-1)| =0") - call expect ( abs(eps2(m,p,-1)*p), 0, " |e2(-1).p|=0") -end if -@ -<>= -print *, " *** Checking the polarization tensors for massive gravitons:" -call expect (abs(p * eps2(m,p,2)), 0, "p.e(+2)=0") -call expect (abs(p * eps2(m,p,1)), 0, "p.e(+1)=0") -call expect (abs(p * eps2(m,p,0)), 0, "p.e( 0)=0") -call expect (abs(p * eps2(m,p,-1)), 0, "p.e(-1)=0") -call expect (abs(p * eps2(m,p,-2)), 0, "p.e(-2)=0") -call expect (abs(trace(eps2 (m,p,2))), 0, "Tr[e(+2)]=0") -call expect (abs(trace(eps2 (m,p,1))), 0, "Tr[e(+1)]=0") -call expect (abs(trace(eps2 (m,p,0))), 0, "Tr[e( 0)]=0") -call expect (abs(trace(eps2 (m,p,-1))), 0, "Tr[e(-1)]=0") -call expect (abs(trace(eps2 (m,p,-2))), 0, "Tr[e(-2)]=0") -call expect (abs(eps2(m,p,2) * eps2(m,p,2)), 1, & - "e(2).e(2) = 1") -call expect (abs(eps2(m,p,2) * eps2(m,p,1)), 0, & - "e(2).e(1) = 0") -call expect (abs(eps2(m,p,2) * eps2(m,p,0)), 0, & - "e(2).e(0) = 0") -call expect (abs(eps2(m,p,2) * eps2(m,p,-1)), 0, & - "e(2).e(-1) = 0") -call expect (abs(eps2(m,p,2) * eps2(m,p,-2)), 0, & - "e(2).e(-2) = 0") -call expect (abs(eps2(m,p,1) * eps2(m,p,1)), 1, & - "e(1).e(1) = 1") -call expect (abs(eps2(m,p,1) * eps2(m,p,0)), 0, & - "e(1).e(0) = 0") -call expect (abs(eps2(m,p,1) * eps2(m,p,-1)), 0, & - "e(1).e(-1) = 0") -call expect (abs(eps2(m,p,1) * eps2(m,p,-2)), 0, & - "e(1).e(-2) = 0") -call expect (abs(eps2(m,p,0) * eps2(m,p,0)), 1, & - "e(0).e(0) = 1") -call expect (abs(eps2(m,p,0) * eps2(m,p,-1)), 0, & - "e(0).e(-1) = 0") -call expect (abs(eps2(m,p,0) * eps2(m,p,-2)), 0, & - "e(0).e(-2) = 0") -call expect (abs(eps2(m,p,-1) * eps2(m,p,-1)), 1, & - "e(-1).e(-1) = 1") -call expect (abs(eps2(m,p,-1) * eps2(m,p,-2)), 0, & - "e(-1).e(-2) = 0") -call expect (abs(eps2(m,p,-2) * eps2(m,p,-2)), 1, & - "e(-2).e(-2) = 1") -@ -<>= -print *, " *** Checking the graviton propagator:" -call expect (abs(p * (cmplx (p*p - m**2, m*w, kind=default) * & - pr_tensor(p,m,w,eps2(m,p,-2)))), 0, "p.pr.e(-2)") -call expect (abs(p * (cmplx (p*p - m**2, m*w, kind=default) * & - pr_tensor(p,m,w,eps2(m,p,-1)))), 0, "p.pr.e(-1)") -call expect (abs(p * (cmplx (p*p - m**2, m*w, kind=default) * & - pr_tensor(p,m,w,eps2(m,p,0)))), 0, "p.pr.e(0)") -call expect (abs(p * (cmplx (p*p - m**2, m*w, kind=default) * & - pr_tensor(p,m,w,eps2(m,p,1)))), 0, "p.pr.e(1)") -call expect (abs(p * (cmplx (p*p - m**2, m*w, kind=default) * & - pr_tensor(p,m,w,eps2(m,p,2)))), 0, "p.pr.e(2)") -call expect (abs(p * (cmplx (p*p - m**2, m*w, kind=default) * & - pr_tensor(p,m,w,ttest))), 0, "p.pr.ttest") -@ -<<[[test_omega95_bispinors.f95]]>>= -<> -program test_omega95_bispinors - use kinds - use omega95_bispinors - use omega_vspinor_polarizations - use omega_testtools - implicit none - integer :: i, j - real(kind=default) :: m, pabs, qabs, tabs, zabs, w - real(kind=default), dimension(4) :: r - complex(kind=default) :: one - type(momentum) :: p, q, t, z, p_0 - type(vector) :: vp, vq, vt, vz - type(vectorspinor) :: testv - call random_seed () - one = 1 - w = 1.4142 - m = 13 - pabs = 42 - qabs = 137 - tabs = 84 - zabs = 3.1415 - p_0%t = m - p_0%x = 0 - call random_momentum (p, pabs, m) - call random_momentum (q, qabs, m) - call random_momentum (t, tabs, m) - call random_momentum (z, zabs, m) - call random_number (r) - do i = 1, 4 - testv%psi(1)%a(i) = (0, 0) - end do - do i = 2, 3 - do j = 1, 4 - testv%psi(i)%a(j) = cmplx (10.0_default * r(j)) - end do - end do - testv%psi(4)%a(1) = 1 - testv%psi(4)%a(1) = (0, 2.0_default) - testv%psi(4)%a(1) = 1 - testv%psi(4)%a(1) = (3.0_default, 0) - vp = p - vq = q - vt = t - vz = z -<> -end program test_omega95_bispinors -@ -<>= -print *, "*** Checking the equations of motion ***:" -call expect (abs(f_vf(one,vp,u(m,p,+1))-m*u(m,p,+1)), 0, "|[p-m]u(+)|=0") -call expect (abs(f_vf(one,vp,u(m,p,-1))-m*u(m,p,-1)), 0, "|[p-m]u(-)|=0") -call expect (abs(f_vf(one,vp,v(m,p,+1))+m*v(m,p,+1)), 0, "|[p+m]v(+)|=0") -call expect (abs(f_vf(one,vp,v(m,p,-1))+m*v(m,p,-1)), 0, "|[p+m]v(-)|=0") -@ -<>= -print *, "*** Checking the normalization ***:" -call expect (s_ff(one,v(m,p,+1),u(m,p,+1)), +2*m, "ubar(+)*u(+)=+2m") -call expect (s_ff(one,v(m,p,-1),u(m,p,-1)), +2*m, "ubar(-)*u(-)=+2m") -call expect (s_ff(one,u(m,p,+1),v(m,p,+1)), -2*m, "vbar(+)*v(+)=-2m") -call expect (s_ff(one,u(m,p,-1),v(m,p,-1)), -2*m, "vbar(-)*v(-)=-2m") -call expect (s_ff(one,v(m,p,+1),v(m,p,+1)), 0, "ubar(+)*v(+)=0 ") -call expect (s_ff(one,v(m,p,-1),v(m,p,-1)), 0, "ubar(-)*v(-)=0 ") -call expect (s_ff(one,u(m,p,+1),u(m,p,+1)), 0, "vbar(+)*u(+)=0 ") -call expect (s_ff(one,u(m,p,-1),u(m,p,-1)), 0, "vbar(-)*u(-)=0 ") -@ -<>= -print *, "*** Checking the currents ***:" -call expect (abs(v_ff(one,v(m,p,+1),u(m,p,+1))-2*vp), 0, "ubar(+).V.u(+)=2p") -call expect (abs(v_ff(one,v(m,p,-1),u(m,p,-1))-2*vp), 0, "ubar(-).V.u(-)=2p") -call expect (abs(v_ff(one,u(m,p,+1),v(m,p,+1))-2*vp), 0, "vbar(+).V.v(+)=2p") -call expect (abs(v_ff(one,u(m,p,-1),v(m,p,-1))-2*vp), 0, "vbar(-).V.v(-)=2p") -@ -<>= -print *, "*** Checking current conservation ***:" -call expect ((vp-vq)*v_ff(one,v(m,p,+1),u(m,q,+1)), 0, "d(ubar(+).V.u(+))=0") -call expect ((vp-vq)*v_ff(one,v(m,p,-1),u(m,q,-1)), 0, "d(ubar(-).V.u(-))=0") -call expect ((vp-vq)*v_ff(one,u(m,p,+1),v(m,q,+1)), 0, "d(vbar(+).V.v(+))=0") -call expect ((vp-vq)*v_ff(one,u(m,p,-1),v(m,q,-1)), 0, "d(vbar(-).V.v(-))=0") -@ -<>= -if (m == 0) then - print *, "*** Checking axial current conservation ***:" - call expect ((vp-vq)*a_ff(one,v(m,p,+1),u(m,q,+1)), 0, "d(ubar(+).A.u(+))=0") - call expect ((vp-vq)*a_ff(one,v(m,p,-1),u(m,q,-1)), 0, "d(ubar(-).A.u(-))=0") - call expect ((vp-vq)*a_ff(one,u(m,p,+1),v(m,q,+1)), 0, "d(vbar(+).A.v(+))=0") - call expect ((vp-vq)*a_ff(one,u(m,p,-1),v(m,q,-1)), 0, "d(vbar(-).A.v(-))=0") -end if -@ -<>= -print *, "*** Checking polarization vectors: ***" -call expect (conjg(eps(m,p, 1))*eps(m,p, 1), -1, "e( 1).e( 1)=-1") -call expect (conjg(eps(m,p, 1))*eps(m,p,-1), 0, "e( 1).e(-1)= 0") -call expect (conjg(eps(m,p,-1))*eps(m,p, 1), 0, "e(-1).e( 1)= 0") -call expect (conjg(eps(m,p,-1))*eps(m,p,-1), -1, "e(-1).e(-1)=-1") -call expect ( p*eps(m,p, 1), 0, " p.e( 1)= 0") -call expect ( p*eps(m,p,-1), 0, " p.e(-1)= 0") -if (m > 0) then - call expect (conjg(eps(m,p, 1))*eps(m,p, 0), 0, "e( 1).e( 0)= 0") - call expect (conjg(eps(m,p, 0))*eps(m,p, 1), 0, "e( 0).e( 1)= 0") - call expect (conjg(eps(m,p, 0))*eps(m,p, 0), -1, "e( 0).e( 0)=-1") - call expect (conjg(eps(m,p, 0))*eps(m,p,-1), 0, "e( 0).e(-1)= 0") - call expect (conjg(eps(m,p,-1))*eps(m,p, 0), 0, "e(-1).e( 0)= 0") - call expect ( p*eps(m,p, 0), 0, " p.e( 0)= 0") -end if -@ -<>= -print *, "*** Checking polarization vectorspinors: ***" -call expect (abs(p * ueps(m, p, 2)), 0, "p.ueps ( 2)= 0") -call expect (abs(p * ueps(m, p, 1)), 0, "p.ueps ( 1)= 0") -call expect (abs(p * ueps(m, p, -1)), 0, "p.ueps (-1)= 0") -call expect (abs(p * ueps(m, p, -2)), 0, "p.ueps (-2)= 0") -call expect (abs(p * veps(m, p, 2)), 0, "p.veps ( 2)= 0") -call expect (abs(p * veps(m, p, 1)), 0, "p.veps ( 1)= 0") -call expect (abs(p * veps(m, p, -1)), 0, "p.veps (-1)= 0") -call expect (abs(p * veps(m, p, -2)), 0, "p.veps (-2)= 0") -print *, "*** in the rest frame ***" -call expect (abs(p_0 * ueps(m, p_0, 2)), 0, "p0.ueps ( 2)= 0") -call expect (abs(p_0 * ueps(m, p_0, 1)), 0, "p0.ueps ( 1)= 0") -call expect (abs(p_0 * ueps(m, p_0, -1)), 0, "p0.ueps (-1)= 0") -call expect (abs(p_0 * ueps(m, p_0, -2)), 0, "p0.ueps (-2)= 0") -call expect (abs(p_0 * veps(m, p_0, 2)), 0, "p0.veps ( 2)= 0") -call expect (abs(p_0 * veps(m, p_0, 1)), 0, "p0.veps ( 1)= 0") -call expect (abs(p_0 * veps(m, p_0, -1)), 0, "p0.veps (-1)= 0") -call expect (abs(p_0 * veps(m, p_0, -2)), 0, "p0.veps (-2)= 0") -@ -<>= -print *, "*** Checking the irreducibility condition: ***" -call expect (abs(f_potgr (one, one, ueps(m, p, 2))), 0, "g.ueps ( 2)") -call expect (abs(f_potgr (one, one, ueps(m, p, 1))), 0, "g.ueps ( 1)") -call expect (abs(f_potgr (one, one, ueps(m, p, -1))), 0, "g.ueps (-1)") -call expect (abs(f_potgr (one, one, ueps(m, p, -2))), 0, "g.ueps (-2)") -call expect (abs(f_potgr (one, one, veps(m, p, 2))), 0, "g.veps ( 2)") -call expect (abs(f_potgr (one, one, veps(m, p, 1))), 0, "g.veps ( 1)") -call expect (abs(f_potgr (one, one, veps(m, p, -1))), 0, "g.veps (-1)") -call expect (abs(f_potgr (one, one, veps(m, p, -2))), 0, "g.veps (-2)") -print *, "*** in the rest frame ***" -call expect (abs(f_potgr (one, one, ueps(m, p_0, 2))), 0, "g.ueps ( 2)") -call expect (abs(f_potgr (one, one, ueps(m, p_0, 1))), 0, "g.ueps ( 1)") -call expect (abs(f_potgr (one, one, ueps(m, p_0, -1))), 0, "g.ueps (-1)") -call expect (abs(f_potgr (one, one, ueps(m, p_0, -2))), 0, "g.ueps (-2)") -call expect (abs(f_potgr (one, one, veps(m, p_0, 2))), 0, "g.veps ( 2)") -call expect (abs(f_potgr (one, one, veps(m, p_0, 1))), 0, "g.veps ( 1)") -call expect (abs(f_potgr (one, one, veps(m, p_0, -1))), 0, "g.veps (-1)") -call expect (abs(f_potgr (one, one, veps(m, p_0, -2))), 0, "g.veps (-2)") -@ -<>= -print *, "*** Testing vectorspinor normalization ***" -call expect (veps(m,p, 2)*ueps(m,p, 2), -2*m, "ueps( 2).ueps( 2)= -2m") -call expect (veps(m,p, 1)*ueps(m,p, 1), -2*m, "ueps( 1).ueps( 1)= -2m") -call expect (veps(m,p,-1)*ueps(m,p,-1), -2*m, "ueps(-1).ueps(-1)= -2m") -call expect (veps(m,p,-2)*ueps(m,p,-2), -2*m, "ueps(-2).ueps(-2)= -2m") -call expect (ueps(m,p, 2)*veps(m,p, 2), 2*m, "veps( 2).veps( 2)= +2m") -call expect (ueps(m,p, 1)*veps(m,p, 1), 2*m, "veps( 1).veps( 1)= +2m") -call expect (ueps(m,p,-1)*veps(m,p,-1), 2*m, "veps(-1).veps(-1)= +2m") -call expect (ueps(m,p,-2)*veps(m,p,-2), 2*m, "veps(-2).veps(-2)= +2m") -call expect (ueps(m,p, 2)*ueps(m,p, 2), 0, "ueps( 2).veps( 2)= 0") -call expect (ueps(m,p, 1)*ueps(m,p, 1), 0, "ueps( 1).veps( 1)= 0") -call expect (ueps(m,p,-1)*ueps(m,p,-1), 0, "ueps(-1).veps(-1)= 0") -call expect (ueps(m,p,-2)*ueps(m,p,-2), 0, "ueps(-2).veps(-2)= 0") -call expect (veps(m,p, 2)*veps(m,p, 2), 0, "veps( 2).ueps( 2)= 0") -call expect (veps(m,p, 1)*veps(m,p, 1), 0, "veps( 1).ueps( 1)= 0") -call expect (veps(m,p,-1)*veps(m,p,-1), 0, "veps(-1).ueps(-1)= 0") -call expect (veps(m,p,-2)*veps(m,p,-2), 0, "veps(-2).ueps(-2)= 0") -print *, "*** in the rest frame ***" -call expect (veps(m,p_0, 2)*ueps(m,p_0, 2), -2*m, "ueps( 2).ueps( 2)= -2m") -call expect (veps(m,p_0, 1)*ueps(m,p_0, 1), -2*m, "ueps( 1).ueps( 1)= -2m") -call expect (veps(m,p_0,-1)*ueps(m,p_0,-1), -2*m, "ueps(-1).ueps(-1)= -2m") -call expect (veps(m,p_0,-2)*ueps(m,p_0,-2), -2*m, "ueps(-2).ueps(-2)= -2m") -call expect (ueps(m,p_0, 2)*veps(m,p_0, 2), 2*m, "veps( 2).veps( 2)= +2m") -call expect (ueps(m,p_0, 1)*veps(m,p_0, 1), 2*m, "veps( 1).veps( 1)= +2m") -call expect (ueps(m,p_0,-1)*veps(m,p_0,-1), 2*m, "veps(-1).veps(-1)= +2m") -call expect (ueps(m,p_0,-2)*veps(m,p_0,-2), 2*m, "veps(-2).veps(-2)= +2m") -call expect (ueps(m,p_0, 2)*ueps(m,p_0, 2), 0, "ueps( 2).veps( 2)= 0") -call expect (ueps(m,p_0, 1)*ueps(m,p_0, 1), 0, "ueps( 1).veps( 1)= 0") -call expect (ueps(m,p_0,-1)*ueps(m,p_0,-1), 0, "ueps(-1).veps(-1)= 0") -call expect (ueps(m,p_0,-2)*ueps(m,p_0,-2), 0, "ueps(-2).veps(-2)= 0") -call expect (veps(m,p_0, 2)*veps(m,p_0, 2), 0, "veps( 2).ueps( 2)= 0") -call expect (veps(m,p_0, 1)*veps(m,p_0, 1), 0, "veps( 1).ueps( 1)= 0") -call expect (veps(m,p_0,-1)*veps(m,p_0,-1), 0, "veps(-1).ueps(-1)= 0") -call expect (veps(m,p_0,-2)*veps(m,p_0,-2), 0, "veps(-2).ueps(-2)= 0") -@ -<>= -print *, "*** Majorana properties of gravitino vertices: ***" -call expect (abs(u (m,q,1) * f_sgr (one, one, ueps(m,p,2), t) + & - ueps(m,p,2) * gr_sf(one,one,u(m,q,1),t)), 0, "f_sgr + gr_sf = 0") -!!! call expect (abs(u (m,q,-1) * f_sgr (one, one, ueps(m,p,2), t) + & -!!! ueps(m,p,2) * gr_sf(one,one,u(m,q,-1),t)), 0, "f_sgr + gr_sf = 0") -!!! call expect (abs(u (m,q,1) * f_sgr (one, one, ueps(m,p,1), t) + & -!!! ueps(m,p,1) * gr_sf(one,one,u(m,q,1),t)), 0, "f_sgr + gr_sf = 0") -!!! call expect (abs(u (m,q,-1) * f_sgr (one, one, ueps(m,p,1), t) + & -!!! ueps(m,p,1) * gr_sf(one,one,u(m,q,-1),t)), 0, "f_sgr + gr_sf = 0") -!!! call expect (abs(u (m,q,1) * f_sgr (one, one, ueps(m,p,-1), t) + & -!!! ueps(m,p,-1) * gr_sf(one,one,u(m,q,1),t)), 0, "f_sgr + gr_sf = 0") -!!! call expect (abs(u (m,q,-1) * f_sgr (one, one, ueps(m,p,-1), t) + & -!!! ueps(m,p,-1) * gr_sf(one,one,u(m,q,-1),t)), 0, "f_sgr + gr_sf = 0") -!!! call expect (abs(u (m,q,1) * f_sgr (one, one, ueps(m,p,-2), t) + & -!!! ueps(m,p,-2) * gr_sf(one,one,u(m,q,1),t)), 0, "f_sgr + gr_sf = 0") -!!! call expect (abs(u (m,q,-1) * f_sgr (one, one, ueps(m,p,-2), t) + & -!!! ueps(m,p,-2) * gr_sf(one,one,u(m,q,-1),t)), 0, "f_sgr + gr_sf = 0") -call expect (abs(u (m,q,1) * f_pgr (one, one, ueps(m,p,2), t) + & - ueps(m,p,2) * gr_pf(one,one,u(m,q,1),t)), 0, "f_pgr + gr_pf = 0") -call expect (abs(u (m,q,1) * f_vgr (one, vt, ueps(m,p,2), p+q) + & - ueps(m,p,2) * gr_vf(one,vt,u(m,q,1),p+q)), 0, "f_vgr + gr_vf = 0") -!!! call expect (abs(u (m,q,-1) * f_vgr (one, vt, ueps(m,p,2), p+q) + & -!!! ueps(m,p,2) * gr_vf(one,vt,u(m,q,-1),p+q)), 0, "f_vgr + gr_vf = 0") -!!! call expect (abs(u (m,q,1) * f_vgr (one, vt, ueps(m,p,1), p+q) + & -!!! ueps(m,p,1) * gr_vf(one,vt,u(m,q,1),p+q)), 0, "f_vgr + gr_vf = 0") -!!! call expect (abs(u (m,q,-1) * f_vgr (one, vt, ueps(m,p,1), p+q) + & -!!! ueps(m,p,1) * gr_vf(one,vt,u(m,q,-1),p+q)), 0, "f_vgr + gr_vf = 0") -!!! call expect (abs(u (m,q,1) * f_vgr (one, vt, ueps(m,p,-1), p+q) + & -!!! ueps(m,p,-1) * gr_vf(one,vt,u(m,q,1),p+q)), 0, "f_vgr + gr_vf = 0") -!!! call expect (abs(u (m,q,-1) * f_vgr (one, vt, veps(m,p,-1), p+q) + & -!!! veps(m,p,-1) * gr_vf(one,vt,u(m,q,-1),p+q)), 0, "f_vgr + gr_vf = 0") -!!! call expect (abs(v (m,q,1) * f_vgr (one, vt, ueps(m,p,-2), p+q) + & -!!! ueps(m,p,-2) * gr_vf(one,vt,v(m,q,1),p+q)), 0, "f_vgr + gr_vf = 0") -!!! call expect (abs(u (m,q,-1) * f_vgr (one, vt, ueps(m,p,-2), p+q) + & -!!! ueps(m,p,-2) * gr_vf(one,vt,u(m,q,-1),p+q)), 0, "f_vgr + gr_vf = 0") -call expect (abs(s_grf (one, ueps(m,p,2), u(m,q,1),t) + & - s_fgr(one,u(m,q,1),ueps(m,p,2),t)), 0, "s_grf + s_fgr = 0") -call expect (abs(p_grf (one, ueps(m,p,2), u(m,q,1),t) + & - p_fgr(one,u(m,q,1),ueps(m,p,2),t)), 0, "p_grf + p_fgr = 0") -call expect (abs(v_grf (one, ueps(m,p,2), u(m,q,1),t) + & - v_fgr(one,u(m,q,1),ueps(m,p,2),t)), 0, "v_grf + v_fgr = 0") -call expect (abs(u(m,p,1) * f_potgr (one,one,testv) - testv * gr_potf & - (one,one,u (m,p,1))), 0, "f_potgr - gr_potf = 0") -call expect (abs (pot_fgr (one,u(m,p,1),testv) - pot_grf(one, & - testv,u(m,p,1))), 0, "pot_fgr - pot_grf = 0") -call expect (abs(u(m,p,1) * f_s2gr (one,one,one,testv) - testv * gr_s2f & - (one,one,one,u (m,p,1))), 0, "f_s2gr - gr_s2f = 0") -call expect (abs (s2_fgr (one,u(m,p,1),one,testv) - s2_grf(one, & - testv,one,u(m,p,1))), 0, "s2_fgr - s2_grf = 0") -call expect (abs(u (m,q,1) * f_svgr (one, one, vt, ueps(m,p,2)) + & - ueps(m,p,2) * gr_svf(one,one,vt,u(m,q,1))), 0, "f_svgr + gr_svf = 0") -call expect (abs (sv1_fgr (one,u(m,p,1),vt,ueps(m,q,2)) + sv1_grf(one, & - ueps(m,q,2),vt,u(m,p,1))), 0, "sv1_fgr + sv1_grf = 0") -call expect (abs (sv2_fgr (one,u(m,p,1),one,ueps(m,q,2)) + sv2_grf(one, & - ueps(m,q,2),one,u(m,p,1))), 0, "sv2_fgr + sv2_grf = 0") -call expect (abs(u (m,q,1) * f_pvgr (one, one, vt, ueps(m,p,2)) + & - ueps(m,p,2) * gr_pvf(one,one,vt,u(m,q,1))), 0, "f_pvgr + gr_pvf = 0") -call expect (abs (pv1_fgr (one,u(m,p,1),vt,ueps(m,q,2)) + pv1_grf(one, & - ueps(m,q,2),vt,u(m,p,1))), 0, "pv1_fgr + pv1_grf = 0") -call expect (abs (pv2_fgr (one,u(m,p,1),one,ueps(m,q,2)) + pv2_grf(one, & - ueps(m,q,2),one,u(m,p,1))), 0, "pv2_fgr + pv2_grf = 0") -call expect (abs(u (m,q,1) * f_v2gr (one, vt, vz, ueps(m,p,2)) + & - ueps(m,p,2) * gr_v2f(one,vt,vz,u(m,q,1))), 0, "f_v2gr + gr_v2f = 0") -call expect (abs (v2_fgr (one,u(m,p,1),vt,ueps(m,q,2)) + v2_grf(one, & - ueps(m,q,2),vt,u(m,p,1))), 0, "v2_fgr + v2_grf = 0") -@ -<>= -print *, "*** Testing the gravitino propagator: ***" -print *, "Transversality:" -call expect (abs(p * (cmplx (p*p - m**2, m*w, kind=default) * & - pr_grav(p,m,w,testv))), 0, "p.pr.test") -call expect (abs(p * (cmplx (p*p - m**2, m*w, kind=default) * & - pr_grav(p,m,w,ueps(m,p,2)))), 0, "p.pr.ueps ( 2)") -call expect (abs(p * (cmplx (p*p - m**2, m*w, kind=default) * & - pr_grav(p,m,w,ueps(m,p,1)))), 0, "p.pr.ueps ( 1)") -call expect (abs(p * (cmplx (p*p - m**2, m*w, kind=default) * & - pr_grav(p,m,w,ueps(m,p,-1)))), 0, "p.pr.ueps (-1)") -call expect (abs(p * (cmplx (p*p - m**2, m*w, kind=default) * & - pr_grav(p,m,w,ueps(m,p,-2)))), 0, "p.pr.ueps (-2)") -call expect (abs(p * (cmplx (p*p - m**2, m*w, kind=default) * & - pr_grav(p,m,w,veps(m,p,2)))), 0, "p.pr.veps ( 2)") -call expect (abs(p * (cmplx (p*p - m**2, m*w, kind=default) * & - pr_grav(p,m,w,veps(m,p,1)))), 0, "p.pr.veps ( 1)") -call expect (abs(p * (cmplx (p*p - m**2, m*w, kind=default) * & - pr_grav(p,m,w,veps(m,p,-1)))), 0, "p.pr.veps (-1)") -call expect (abs(p * (cmplx (p*p - m**2, m*w, kind=default) * & - pr_grav(p,m,w,veps(m,p,-2)))), 0, "p.pr.veps (-2)") -print *, "Irreducibility:" -call expect (abs(f_potgr (one, one, (cmplx (p*p - m**2, m*w, & - kind=default) * pr_grav(p,m,w,testv)))), 0, "g.pr.test") -call expect (abs(f_potgr (one, one, (cmplx (p*p - m**2, m*w, & - kind=default) * pr_grav(p,m,w,ueps(m,p,2))))), 0, & - "g.pr.ueps ( 2)") -call expect (abs(f_potgr (one, one, (cmplx (p*p - m**2, m*w, & - kind=default) * pr_grav(p,m,w,ueps(m,p,1))))), 0, & - "g.pr.ueps ( 1)") -call expect (abs(f_potgr (one, one, (cmplx (p*p - m**2, m*w, & - kind=default) * pr_grav(p,m,w,ueps(m,p,-1))))), 0, & - "g.pr.ueps (-1)") -call expect (abs(f_potgr (one, one, (cmplx (p*p - m**2, m*w, & - kind=default) * pr_grav(p,m,w,ueps(m,p,-2))))), 0, & - "g.pr.ueps (-2)") -call expect (abs(f_potgr (one, one, (cmplx (p*p - m**2, m*w, & - kind=default) * pr_grav(p,m,w,veps(m,p,2))))), 0, & - "g.pr.veps ( 2)") -call expect (abs(f_potgr (one, one, (cmplx (p*p - m**2, m*w, & - kind=default) * pr_grav(p,m,w,veps(m,p,1))))), 0, & - "g.pr.veps ( 1)") -call expect (abs(f_potgr (one, one, (cmplx (p*p - m**2, m*w, & - kind=default) * pr_grav(p,m,w,veps(m,p,-1))))), 0, & - "g.pr.veps (-1)") -call expect (abs(f_potgr (one, one, (cmplx (p*p - m**2, m*w, & - kind=default) * pr_grav(p,m,w,veps(m,p,-2))))), 0, & - "g.pr.veps (-2)") -@ -<<[[omega_bundle.f95]]>>= -<<[[kinds.f95]]>> -<<[[omega_constants.f95]]>> -<<[[omega_vectors.f95]]>> -<<[[omega_spinors.f95]]>> -<<[[omega_bispinors.f95]]>> -<<[[omega_vectorspinors.f95]]>> -<<[[omega_polarizations.f95]]>> -<<[[omega_tensors.f95]]>> -<<[[omega_tensor_polarizations.f95]]>> -<<[[omega_couplings.f95]]>> -<<[[omega_spinor_couplings.f95]]>> -<<[[omega_bispinor_couplings.f95]]>> -<<[[omega_vspinor_polarizations.f95]]>> -<<[[omega_utils.f95]]>> -<<[[omega95.f95]]>> -<<[[omega95_bispinors.f95]]>> -<<[[omega_parameters.f95]]>> -<<[[omega_parameters_madgraph.f95]]>> -@ -<<[[omega_bundle_whizard.f95]]>>= -<<[[omega_bundle.f95]]>> -<<[[omega_parameters_whizard.f95]]>> -@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\section{O'Mega Virtual Machine} -<<[[omegavm95.f95]]>>= -<> -module omegavm95 - use kinds - use omega95 - ! use omega95_bispinors - implicit none - private - <> - <> - <> -contains - <> -end module omegavm95 -@ -\subsection{Memory Layout} -On one hand, we need a memory pool for all the intermediate results -<>= -type, public :: ovm - private - complex(kind=default) :: amp - type(momentum), dimension(:), pointer :: p - complex(kind=default), dimension(:), pointer :: phi - type(spinor), dimension(:), pointer :: psi - type(conjspinor), dimension(:), pointer :: psibar - ! type(bispinor), dimension(:), pointer :: chi - type(vector), dimension(:), pointer :: v -end type ovm -@ -<>= -public :: alloc -@ -<>= -subroutine alloc (vm, momenta, scalars, spinors, conjspinors, vectors) - type(ovm), intent(inout) :: vm - integer, intent(in) :: momenta, scalars, spinors, conjspinors, vectors - allocate (vm%p(momenta)) - allocate (vm%phi(scalars)) - allocate (vm%psi(spinors)) - allocate (vm%psibar(conjspinors)) - allocate (vm%v(vectors)) -end subroutine alloc -@ and on the other hand, we need to access coupling parameters that -define the environment -<>= -type, public :: ovm_env - private - real(kind=default), dimension(:), pointer :: gr - real(kind=default), dimension(:,:), pointer :: gr2 - complex(kind=default), dimension(:), pointer :: gc - complex(kind=default), dimension(:,:), pointer :: gc2 -end type ovm_env -@ NB: during, execution, the type of the coupling constant is implicit -in the instruction. -\begin{dubious} - How to load coupling constants? Is brute force linear lookup good - enough? -\end{dubious} -@ \subsection{Instruction Set} -<>= -integer, parameter, private :: MAX_RHS = 3 -type, public :: instr - private - integer :: code, sign, coupl, lhs - integer, dimension(MAX_RHS) :: rhs -end type instr -@ -<>= -public :: eval -@ -<>= -pure subroutine eval (vm, amp, env, amplitude, p, s) - type(ovm), intent(inout) :: vm - complex(kind=default), intent(out) :: amp - type(ovm_env), intent(in) :: env - type(instr), dimension(:), intent(in) :: amplitude - real(kind=default), dimension(0:,:), intent(in) :: p - integer, dimension(:), intent(in) :: s - integer :: code, sign, coupl, lhs - integer, dimension(MAX_RHS) :: rhs - integer :: i, pc - vm%p(1) = - p(:,1) - vm%p(2) = - p(:,2) - do i = 3, size (p, dim = 2) - vm%p(i) = p(:,i) - end do - do pc = 1, size (amplitude) - code = amplitude(pc)%code - sign = amplitude(pc)%sign - coupl = amplitude(pc)%coupl - lhs = amplitude(pc)%lhs - rhs = amplitude(pc)%rhs - select case (code) - <<[[case]]s of [[code]]>> - end select - end do - amp = vm%amp -end subroutine eval -@ \subsubsection{Loading External states} -<>= -integer, public, parameter :: OVM_LOAD_SCALAR = 1 -integer, public, parameter :: OVM_LOAD_U = 2 -integer, public, parameter :: OVM_LOAD_UBAR = 3 -integer, public, parameter :: OVM_LOAD_V = 4 -integer, public, parameter :: OVM_LOAD_VBAR = 5 -integer, public, parameter :: OVM_LOAD_VECTOR = 6 -@ -<<[[case]]s of [[code]]>>= -case (OVM_LOAD_SCALAR) - vm%phi(lhs) = 1 -case (OVM_LOAD_U) - if (lhs <= 2) then - vm%psi(lhs) = u (env%gr(coupl), - vm%p(rhs(1)), s(rhs(2))) - else - vm%psi(lhs) = u (env%gr(coupl), vm%p(rhs(1)), s(rhs(2))) - end if -case (OVM_LOAD_UBAR) - if (lhs <= 2) then - vm%psibar(lhs) = ubar (env%gr(coupl), - vm%p(rhs(1)), s(rhs(2))) - else - vm%psibar(lhs) = ubar (env%gr(coupl), vm%p(rhs(1)), s(rhs(2))) - end if -case (OVM_LOAD_V) - if (lhs <= 2) then - vm%psi(lhs) = v (env%gr(coupl), - vm%p(rhs(1)), s(rhs(2))) - else - vm%psi(lhs) = v (env%gr(coupl), vm%p(rhs(1)), s(rhs(2))) - end if -case (OVM_LOAD_VBAR) - if (lhs <= 2) then - vm%psibar(lhs) = vbar (env%gr(coupl), - vm%p(rhs(1)), s(rhs(2))) - else - vm%psibar(lhs) = vbar (env%gr(coupl), vm%p(rhs(1)), s(rhs(2))) - end if -case (OVM_LOAD_VECTOR) - if (lhs <= 2) then - vm%v(lhs) = eps (env%gr(coupl), - vm%p(rhs(1)), s(rhs(2))) - else - vm%v(lhs) = eps (env%gr(coupl), vm%p(rhs(1)), s(rhs(2))) - end if -@ -<>= -integer, public, parameter :: OVM_ADD_MOMENTA = 10 -@ -<<[[case]]s of [[code]]>>= -case (OVM_ADD_MOMENTA) - vm%p(lhs) = vm%p(rhs(1)) + vm%p(rhs(2)) -@ -<>= -integer, public, parameter :: OVM_PROPAGATE_SCALAR = 11 -integer, public, parameter :: OVM_PROPAGATE_SPINOR = 12 -@ -<<[[case]]s of [[code]]>>= -case (OVM_PROPAGATE_SCALAR) - vm%phi(lhs) = pr_phi (vm%p(lhs),env%gr(rhs(1)),env%gr(rhs(2)),vm%phi(lhs)) -case (OVM_PROPAGATE_SPINOR) - vm%psi(lhs) = pr_psi (vm%p(lhs),env%gr(rhs(1)),env%gr(rhs(2)),vm%psi(lhs)) -@ -<>= -integer, public, parameter :: OVM_FUSE_VECTOR_PSIBAR_PSI = 21 -integer, public, parameter :: OVM_FUSE_PSI_VECTOR_PSI = 22 -integer, public, parameter :: OVM_FUSE_PSIBAR_PSIBAR_VECTOR = 23 -@ -<<[[case]]s of [[code]]>>= -case (OVM_FUSE_VECTOR_PSIBAR_PSI) - vm%v(lhs) = & - v_ff (sign*env%gc(coupl), vm%psibar(rhs(1)), vm%psi(rhs(2))) -case (OVM_FUSE_PSI_VECTOR_PSI) - vm%psi(lhs) = & - f_vf (sign*env%gc(coupl), vm%v(rhs(1)), vm%psi(rhs(2))) -case (OVM_FUSE_PSIBAR_PSIBAR_VECTOR) - vm%psibar(lhs) = & - f_fv (sign*env%gc(coupl), vm%psibar(rhs(1)), vm%v(rhs(2))) -@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -<>= -! $Id$ -! -! Copyright (C) 1999-2009 by -! Wolfgang Kilian -! Thorsten Ohl -! Juergen Reuter -! -! WHIZARD is free software; you can redistribute it and/or modify it -! under the terms of the GNU General Public License as published by -! the Free Software Foundation; either version 2, or (at your option) -! any later version. -! -! WHIZARD is distributed in the hope that it will be useful, but -! WITHOUT ANY WARRANTY; without even the implied warranty of -! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -! GNU General Public License for more details. -! -! You should have received a copy of the GNU General Public License -! along with this program; if not, write to the Free Software -! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -@ -\section{Fortran77} -<<[[omega77.f]]>>= -C $Id$ -C -C Copyright (C) 1999-2009 by -C Wolfgang Kilian -C Thorsten Ohl -C Juergen Reuter -C -C WHIZARD is free software; you can redistribute it and/or modify it -C under the terms of the GNU General Public License as published by -C the Free Software Foundation; either version 2, or (at your option) -C any later version. -C -C WHIZARD is distributed in the hope that it will be useful, but -C WITHOUT ANY WARRANTY; without even the implied warranty of -C MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -C GNU General Public License for more details. -C -C You should have received a copy of the GNU General Public License -C along with this program; if not, write to the Free Software -C Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -<> -<> -<> -@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% Local Variables: -% mode:noweb -% noweb-doc-mode:latex-mode -% noweb-code-mode:f90-mode -% indent-tabs-mode:nil -% page-delimiter:"^@ %%%.*\n" -% End: Index: branches/ohl/omega-development/completed/whizard2/src/f90_SM.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/f90_SM.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/f90_SM.ml (revision 8703) @@ -1,33 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -module O = Omega.Make(Fusion.Mixed23)(Targets.Fortran) - (Models.SM(Models.SM_no_anomalous)) -let _ = O.main () - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/algebra.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/algebra.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/algebra.ml (revision 8703) @@ -1,383 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -(* The terms will be small and there's no need to be fancy and/or efficient. - It's more important to have a unique representation. *) - -module PM = Pmap.List - -(* \thocwmodulesection{Coefficients} *) - -(* For our algebra, we need coefficient rings. *) - -module type CRing = - sig - type t - val null : t - val unit : t - val mul : t -> t -> t - val add : t -> t -> t - val sub : t -> t -> t - val neg : t -> t - val to_string : t -> string - end - -(* And rational numbers provide a particularly important example: *) - -module type Rational = - sig - include CRing - val is_null : t -> bool - val is_unit : t -> bool - val make : int -> int -> t - val to_ratio : t -> int * int - val to_float : t -> float - end - -(* \thocwmodulesection{Naive Rational Arithmetic} *) - -(* \begin{dubious} - This \emph{is} dangerous and will overflow even for simple - applications. The production code will have to be linked to - a library for large integer arithmetic. - \end{dubious} *) - -(* Anyway, here's Euclid's algorithm: *) -let rec gcd i1 i2 = - if i2 = 0 then - abs i1 - else - gcd i2 (i1 mod i2) - -let lcm i1 i2 = (i1 / gcd i1 i2) * i2 - -module Small_Rational : Rational = - struct - type t = int * int - let is_null (n, _) = (n = 0) - let is_unit (n, d) = (n <> 0) && (n = d) - let null = (0, 1) - let unit = (1, 1) - let make n d = - let c = gcd n d in - (n / c, d / c) - let mul (n1, d1) (n2, d2) = make (n1 * n2) (d1 * d2) - let add (n1, d1) (n2, d2) = make (n1 * d2 + n2 * d1) (d1 * d2) - let sub (n1, d1) (n2, d2) = make (n1 * d2 - n2 * d1) (d1 * d2) - let neg (n, d) = (- n, d) - let to_ratio (n, d) = - if d < 0 then - (-n, -d) - else - (n, d) - let to_float (n, d) = float n /. float d - let to_string (n, d) = - if d = 1 then - Printf.sprintf "%d" n - else - Printf.sprintf "(%d/%d)" n d - end - -(* \thocwmodulesection{Expressions: Terms, Rings and Linear Combinations} *) - -(* The tensor algebra will be spanned by an abelian monoid: *) - -module type Term = - sig - type 'a t - val unit : unit -> 'a t - val is_unit : 'a t -> bool - val atom : 'a -> 'a t - val power : int -> 'a t -> 'a t - val mul : 'a t -> 'a t -> 'a t - val map : ('a -> 'b) -> 'a t -> 'b t - val to_string : ('a -> string) -> 'a t -> string - val derive : ('a -> 'b option) -> 'a t -> ('b * int * 'a t) list - val product : 'a t list -> 'a t - val atoms : 'a t -> 'a list - end - -module type Ring = - sig - module C : Rational - type 'a t - val null : unit -> 'a t - val unit : unit -> 'a t - val is_null : 'a t -> bool - val is_unit : 'a t -> bool - val atom : 'a -> 'a t - val scale : C.t -> 'a t -> 'a t - val add : 'a t -> 'a t -> 'a t - val sub : 'a t -> 'a t -> 'a t - val mul : 'a t -> 'a t -> 'a t - val neg : 'a t -> 'a t - val derive_inner : ('a -> 'a t) -> 'a t -> 'a t (* this? *) - val derive_inner' : ('a -> 'a t option) -> 'a t -> 'a t (* or that? *) - val derive_outer : ('a -> 'b option) -> 'a t -> ('b * 'a t) list - val sum : 'a t list -> 'a t - val product : 'a t list -> 'a t - val atoms : 'a t -> 'a list - val to_string : ('a -> string) -> 'a t -> string - end - -module type Linear = - sig - module C : Ring - type ('a, 'c) t - val null : unit -> ('a, 'c) t - val atom : 'a -> ('a, 'c) t - val singleton : 'c C.t -> 'a -> ('a, 'c) t - val scale : 'c C.t -> ('a, 'c) t -> ('a, 'c) t - val add : ('a, 'c) t -> ('a, 'c) t -> ('a, 'c) t - val sub : ('a, 'c) t -> ('a, 'c) t -> ('a, 'c) t - val partial : ('c -> ('a, 'c) t) -> 'c C.t -> ('a, 'c) t - val linear : (('a, 'c) t * 'c C.t) list -> ('a, 'c) t - val map : ('a -> 'c C.t -> ('b, 'd) t) -> ('a, 'c) t -> ('b, 'd) t - val sum : ('a, 'c) t list -> ('a, 'c) t - val atoms : ('a, 'c) t -> 'a list * 'c list - val to_string : ('a -> string) -> ('c -> string) -> ('a, 'c) t -> string - end - -module Term : Term = - struct - - module M = PM - - type 'a t = ('a, int) M.t - - let unit () = M.empty - let is_unit = M.is_empty - - let atom f = M.singleton f 1 - - let power p x = M.map (( * ) p) x - - let insert1 binop f p term = - let p' = binop (try M.find compare f term with Not_found -> 0) p in - if p' = 0 then - M.remove compare f term - else - M.add compare f p' term - - let mul1 f p term = insert1 (+) f p term - let mul x y = M.fold mul1 x y - - let map f term = M.fold (fun t -> mul1 (f t)) term M.empty - - let to_string fmt term = - String.concat "*" - (M.fold (fun f p acc -> - (if p = 0 then - "1" - else if p = 1 then - fmt f - else - "[" ^ fmt f ^ "]^" ^ string_of_int p) :: acc) term []) - - let derive derive1 x = - M.fold (fun f p dx -> - if p <> 0 then - match derive1 f with - | Some df -> (df, p, mul1 f (pred p) (M.remove compare f x)) :: dx - | None -> dx - else - dx) x [] - - let product factors = - List.fold_left mul (unit ()) factors - - let atoms t = - List.map fst (PM.elements t) - - end - -module Make_Ring (C : Rational) (T : Term) : Ring = - struct - - module C = C - let one = C.unit - - module M = PM - - type 'a t = ('a T.t, C.t) M.t - - let null () = M.empty - let is_null = M.is_empty - - let power t p = M.singleton t p - let unit () = power (T.unit ()) one - - let is_unit t = unit () = t - -(* \begin{dubious} - The following should be correct too, but produces to many false - positives instead! What's going on? - \end{dubious} *) - let broken__is_unit t = - match M.elements t with - | [(t, p)] -> T.is_unit t || C.is_null p - | _ -> false - - let atom t = power (T.atom t) one - - let scale c x = M.map (C.mul c) x - - let insert1 binop t c sum = - let c' = binop (try M.find compare t sum with Not_found -> C.null) c in - if C.is_null c' then - M.remove compare t sum - else - M.add compare t c' sum - - let add x y = M.fold (insert1 C.add) x y - - let sub x y = M.fold (insert1 C.sub) y x - - (* One might be tempted to use [Product.outer_self M.fold] instead, - but this would require us to combine~[tx] and~[cx] to~[(tx, cx)]. *) - - let fold2 f x y = - M.fold (fun tx cx -> M.fold (f tx cx) y) x - - let mul x y = - fold2 (fun tx cx ty cy -> insert1 C.add (T.mul tx ty) (C.mul cx cy)) - x y (null ()) - - let neg x = - sub (null ()) x - - let neg x = - scale (C.neg C.unit) x - - (* Multiply the [derivatives] by [c] and add the result to [dx]. *) - let add_derivatives derivatives c dx = - List.fold_left (fun acc (df, dt_c, dt_t) -> - add (mul df (power dt_t (C.mul c (C.make dt_c 1)))) acc) dx derivatives - - let derive_inner derive1 x = - M.fold (fun t -> - add_derivatives (T.derive (fun f -> Some (derive1 f)) t)) x (null ()) - - let derive_inner' derive1 x = - M.fold (fun t -> add_derivatives (T.derive derive1 t)) x (null ()) - - let collect_derivatives derivatives c dx = - List.fold_left (fun acc (df, dt_c, dt_t) -> - (df, power dt_t (C.mul c (C.make dt_c 1))) :: acc) dx derivatives - - let derive_outer derive1 x = - M.fold (fun t -> collect_derivatives (T.derive derive1 t)) x [] - - let sum terms = - List.fold_left add (null ()) terms - - let product factors = - List.fold_left mul (unit ()) factors - - let atoms t = - ThoList.uniq (List.sort compare - (ThoList.flatmap (fun (t, _) -> T.atoms t) (PM.elements t))) - - let to_string fmt sum = - "(" ^ String.concat " + " - (M.fold (fun t c acc -> - if C.is_null c then - acc - else if C.is_unit c then - T.to_string fmt t :: acc - else if C.is_unit (C.neg c) then - ("(-" ^ T.to_string fmt t ^ ")") :: acc - else - (C.to_string c ^ "*[" ^ T.to_string fmt t ^ "]") :: acc) sum []) ^ ")" - - end - -module Make_Linear (C : Ring) : Linear with module C = C = - struct - - module C = C - - module M = PM - - type ('a, 'c) t = ('a, 'c C.t) M.t - - let null () = M.empty - let is_null = M.is_empty - let atom a = M.singleton a (C.unit ()) - let singleton c a = M.singleton a c - - let scale c x = M.map (C.mul c) x - - let insert1 binop t c sum = - let c' = binop (try M.find compare t sum with Not_found -> C.null ()) c in - if C.is_null c' then - M.remove compare t sum - else - M.add compare t c' sum - - let add x y = M.fold (insert1 C.add) x y - let sub x y = M.fold (insert1 C.sub) y x - - let map f t = - M.fold (fun a c -> add (f a c)) t M.empty - - let sum terms = - List.fold_left add (null ()) terms - - let linear terms = - List.fold_left (fun acc (a, c) -> add (scale c a) acc) (null ()) terms - - let partial derive t = - let d t' = - let dt' = derive t' in - if is_null dt' then - None - else - Some dt' in - linear (C.derive_outer d t) - - let atoms t = - let a, c = List.split (PM.elements t) in - (a, ThoList.uniq (List.sort compare (ThoList.flatmap C.atoms c))) - - let to_string fmt cfmt sum = - "(" ^ String.concat " + " - (M.fold (fun t c acc -> - if C.is_null c then - acc - else if C.is_unit c then - fmt t :: acc - else if C.is_unit (C.neg c) then - ("(-" ^ fmt t ^ ")") :: acc - else - (C.to_string cfmt c ^ "*" ^ fmt t) :: acc) - sum []) ^ ")" - - end - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/target.mli =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/target.mli (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/target.mli (revision 8703) @@ -1,50 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -module type T = - sig - type amplitudes - - val options : Options.t - type diagnostic = All | Arguments | Helicities | Momenta | Gauge - -(* Format the amplitudes as a sequence of strings. *) - val amplitudes_to_channel : string -> out_channel -> - (diagnostic * bool) list -> amplitudes -> unit - - val parameters_to_channel : out_channel -> unit - - val rcs_list : RCS.t list - end - -module type Maker = - functor (F : Fusion.Maker) -> - functor (P : Momentum.T) -> functor (CM : Model.Colorized) -> - T with type amplitudes = Fusion.Colored(F)(P)(CM).amplitudes - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/options.mli =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/options.mli (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/options.mli (revision 8703) @@ -1,38 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -type t -val empty : t -val create : (string * Arg.spec * string) list -> t -val parse : t -> string * string -> unit -val list : t -> (string * string) list -val cmdline : string -> t -> (string * Arg.spec * string) list - -exception Invalid of string * string - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/algebra.mli =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/algebra.mli (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/algebra.mli (revision 8703) @@ -1,184 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -(* \thocwmodulesection{Coefficients} *) - -(* For our algebra, we need coefficient rings. *) - -module type CRing = - sig - type t - val null : t - val unit : t - val mul : t -> t -> t - val add : t -> t -> t - val sub : t -> t -> t - val neg : t -> t - val to_string : t -> string - end - -(* And rational numbers provide a particularly important example: *) - -module type Rational = - sig - include CRing - val is_null : t -> bool - val is_unit : t -> bool - val make : int -> int -> t - val to_ratio : t -> int * int - val to_float : t -> float - end - -(* \thocwmodulesection{Naive Rational Arithmetic} *) - -(* \begin{dubious} - This \emph{is} dangerous and will overflow even for simple - applications. The production code will have to be linked to - a library for large integer arithmetic. - \end{dubious} *) - -module Small_Rational : Rational - -(* \thocwmodulesection{Expressions: Terms, Rings and Linear Combinations} *) - -(* The tensor algebra will be spanned by an abelian monoid: *) - -module type Term = - sig - type 'a t - val unit : unit -> 'a t - val is_unit : 'a t -> bool - val atom : 'a -> 'a t - val power : int -> 'a t -> 'a t - val mul : 'a t -> 'a t -> 'a t - val map : ('a -> 'b) -> 'a t -> 'b t - val to_string : ('a -> string) -> 'a t -> string - - (* The derivative of a term is \emph{not} a term, - but a sum of terms instead: - \begin{equation} - D (f_1^{p_1}f_2^{p_2}\cdots f_n^{p_n}) = - \sum_i (Df_i) p_i f_1^{p_1}f_2^{p_2}\cdots f_i^{p_i-1} \cdots f_n^{p_n} - \end{equation} - The function returns the sum as a list of triples - $(Df_i,p_i, f_1^{p_1}f_2^{p_2}\cdots f_i^{p_i-1} \cdots f_n^{p_n})$. - Summing the terms is left to the calling module and the $Df_i$ are - \emph{not} guaranteed to be different. - NB: The function implementating the inner derivative, is supposed to - return~[Some]~$Df_i$ and [None], iff~$Df_i$ vanishes. *) - val derive : ('a -> 'b option) -> 'a t -> ('b * int * 'a t) list - - (* convenience function *) - val product : 'a t list -> 'a t - val atoms : 'a t -> 'a list - - end - -module type Ring = - sig - module C : Rational - type 'a t - val null : unit -> 'a t - val unit : unit -> 'a t - val is_null : 'a t -> bool - val is_unit : 'a t -> bool - val atom : 'a -> 'a t - val scale : C.t -> 'a t -> 'a t - val add : 'a t -> 'a t -> 'a t - val sub : 'a t -> 'a t -> 'a t - val mul : 'a t -> 'a t -> 'a t - val neg : 'a t -> 'a t - - (* Again - \begin{equation} - D (f_1^{p_1}f_2^{p_2}\cdots f_n^{p_n}) = - \sum_i (Df_i) p_i f_1^{p_1}f_2^{p_2}\cdots f_i^{p_i-1} \cdots f_n^{p_n} - \end{equation} - but, iff~$Df_i$ can be identified with a~$f'$, we know how to perform - the sum. *) - - val derive_inner : ('a -> 'a t) -> 'a t -> 'a t (* this? *) - val derive_inner' : ('a -> 'a t option) -> 'a t -> 'a t (* or that? *) - -(* Below, we will need partial derivatives that lead out of the ring: - [derive_outer derive_atom term] returns a list of partial derivatives - ['b] with non-zero coefficients ['a t]: *) - val derive_outer : ('a -> 'b option) -> 'a t -> ('b * 'a t) list - - (* convenience functions *) - val sum : 'a t list -> 'a t - val product : 'a t list -> 'a t - -(* The list of all generators appearing in an expression: *) - val atoms : 'a t -> 'a list - - val to_string : ('a -> string) -> 'a t -> string - - end - -module type Linear = - sig - module C : Ring - type ('a, 'c) t - val null : unit -> ('a, 'c) t - val atom : 'a -> ('a, 'c) t - val singleton : 'c C.t -> 'a -> ('a, 'c) t - val scale : 'c C.t -> ('a, 'c) t -> ('a, 'c) t - val add : ('a, 'c) t -> ('a, 'c) t -> ('a, 'c) t - val sub : ('a, 'c) t -> ('a, 'c) t -> ('a, 'c) t - -(* A partial derivative w.\,r.\,t.~a vector maps from a coefficient ring to - the dual vector space. *) - val partial : ('c -> ('a, 'c) t) -> 'c C.t -> ('a, 'c) t - -(* A linear combination of vectors - \begin{equation} - \text{[linear]} \lbrack (v_1, c_1); (v_2, c_2); \ldots; (v_n, c_n)\rbrack - = \sum_{i=1}^{n} c_i\cdot v_i - \end{equation} *) - val linear : (('a, 'c) t * 'c C.t) list -> ('a, 'c) t - -(* Some convenience functions *) - val map : ('a -> 'c C.t -> ('b, 'd) t) -> ('a, 'c) t -> ('b, 'd) t - val sum : ('a, 'c) t list -> ('a, 'c) t - -(* The list of all generators and the list of all generators of coefficients - appearing in an expression: *) - val atoms : ('a, 'c) t -> 'a list * 'c list - - val to_string : ('a -> string) -> ('c -> string) -> ('a, 'c) t -> string - - end - -module Term : Term - -module Make_Ring (C : Rational) (T : Term) : Ring -module Make_Linear (C : Ring) : Linear with module C = C - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * compile-command:"ocamlc -o vertex thoList.ml{i,} pmap.ml{i,} vertex.ml" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/comphep_syntax.mli =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/comphep_syntax.mli (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/comphep_syntax.mli (revision 8703) @@ -1,50 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -type raw = - | I | Integer of int | Symbol of string - | Application of string * raw - | Dotproduct of raw * raw - | Product of (raw * int) list - | Sum of (raw * int) list - -val symbol : string -> raw -val integer : int -> raw -val imag : raw - -val apply : string -> raw -> raw -val dot : raw -> raw -> raw -val multiply : raw -> raw -> raw -val divide : raw -> raw -> raw -val power : raw -> int -> raw -val add : raw -> raw -> raw -val subtract : raw -> raw -> raw -val neg : raw -> raw - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) - Index: branches/ohl/omega-development/completed/whizard2/src/f90_NMSSM.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/f90_NMSSM.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/f90_NMSSM.ml (revision 8703) @@ -1,33 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -module O = Omega.Make(Fusion.Mixed23_Majorana)(Targets.Fortran_Majorana) - (Models3.ExtMSSM(Models3.NMSSM)) -let _ = O.main () - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/f90_GravTest.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/f90_GravTest.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/f90_GravTest.ml (revision 8703) @@ -1,33 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -module O = Omega.Make(Fusion.Mixed23_Majorana)(Targets.Fortran_Majorana) - (Models4.GravTest(Models4.BSM_bsm)) -let _ = O.main () - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/vertex.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/vertex.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/vertex.ml (revision 8703) @@ -1,211 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -open Vertex_syntax - -let parse text = - try - Vertex_parser.coupling Vertex_lexer.token (Lexing.from_string text) - with - | Vertex_syntax.Syntax_Error (msg, i, j) -> - invalid_arg (Printf.sprintf "syntax error (%s) at: `%s'" - msg (String.sub text i (j - i + 1))) - | Parsing.Parse_error -> invalid_arg ("parse error: " ^ text) - -(*i -let tgv = parse - "(k1.e3 - k2.e3)*e1.e2 + (k2.e1 - k3.e1)*e2.e3 + (k3.e2 - k1.e2)*e3.e1" - -let tgv = parse - "(k1 - k2).e3*e1.e2 + (k2 - k3).e1*e2.e3 + (k3 - k1).e2*e3.e1" -i*) - -type wf = - { lorentz : Coupling.lorentz; - momentum : bool } - -type vertex = - { coupling : Vertex_syntax.scalar; - wfs : wf list } - -let take_nth n list = - let rec take_nth' i rev_head tail = - if i < 0 then - invalid_arg "take_nth" - else if i = 0 then - match tail with - | [] -> invalid_arg "take_nth" - | x :: tail' -> (x, List.rev_append rev_head tail') - else - match tail with - | [] -> invalid_arg "take_nth" - | x :: tail' -> take_nth' (pred i) (x :: rev_head) tail' - in - take_nth' n [] list - -module Fortran = - struct - let type_of_lorentz kind = function - | Coupling.Scalar -> "complex(kind=" ^ kind ^ ")" - | Coupling.Spinor -> "type(spinor)" - | Coupling.ConjSpinor -> "type(conjspinor)" - | Coupling.Majorana -> "type(bispinor)" - | Coupling.Maj_Ghost -> assert false - | Coupling.Vector | Coupling.Massive_Vector -> "type(vector)" - | Coupling.Vectorspinor -> assert false - | Coupling.Tensor_1 -> assert false - | Coupling.Tensor_2 -> assert false - | Coupling.BRS _ -> assert false - - let mnemonic = function - | Coupling.Scalar -> "phi" - | Coupling.Spinor -> "psi" - | Coupling.ConjSpinor -> "psibar" - | Coupling.Majorana -> "chi" - | Coupling.Maj_Ghost -> assert false - | Coupling.Vector | Coupling.Massive_Vector -> "V" - | Coupling.Vectorspinor -> assert false - | Coupling.Tensor_1 -> assert false - | Coupling.Tensor_2 -> assert false - | Coupling.BRS _ -> assert false - - let declare_wf ?(kind = "default") i wf = - Printf.printf " %s, intent(in) :: %s%d\n" - (type_of_lorentz kind wf.lorentz) (mnemonic wf.lorentz) (succ i); - if wf.momentum then begin - Printf.printf " type(momentum), intent(in) :: k%d\n" (succ i); - Printf.printf " type(vector) :: k%dv\n" (succ i) - end - - let vector_of_momentum i wf = - if wf.momentum then begin - Printf.printf " k%dv = k%d\n" (succ i) (succ i) - end - - let print_fusion name i v = - let result, children = take_nth i v.wfs in - let result_name = mnemonic result.lorentz - and result_type = type_of_lorentz "default" result.lorentz in - let children = Array.of_list children in - Printf.printf "pure function %s (%s) result (%s)\n" - name "???" result_name; - Array.iteri declare_wf children; - Printf.printf " %s :: %s\n" result_type result_name; - if result.momentum then - begin - Printf.printf " type(momentum), intent(in) :: k\n"; - Printf.printf " k = \n" - end; - Array.iteri vector_of_momentum children; - Printf.printf "end function %s\n" name - - end - -(* NB: - \begin{dubious} - If the outgoing momentum is used, \emph{all} the incoming momenta - must be passed too, unless the outgoing momentum is passed itself. - \end{dubious} *) - -(*i module IMap = Map.Make (struct type t = int let compare = compare end) i*) - -let insert_scalars order wfs = - let rec insert_scalars' n order = function - | [] -> [] - in - insert_scalars' 0 order wfs - - -let wfs order atoms = - List.sort (fun (n1, _) (n2, _) -> compare n1 n2) - (List.map (fun n -> (n, { lorentz = Coupling.Vector; - momentum = List.mem n atoms.momenta })) atoms.polarizations @ - List.map (fun n -> (n, { lorentz = Coupling.Spinor; - momentum = List.mem n atoms.momenta })) atoms.spinors @ - List.map (fun n -> (n, { lorentz = Coupling.ConjSpinor; - momentum = List.mem n atoms.momenta })) atoms.conj_spinors) - -open Fortran -open Printf - -let process_vertex coupling = - let order = 3 in - printf ">>>>>>>> %s\n" (scalar_to_string coupling); - let atoms = scalar_atoms coupling in - printf " constants: %s\n" - (String.concat ", " atoms.constants); - printf " momenta: %s\n" - (String.concat ", " (List.map string_of_int atoms.momenta)); - printf " polarizations: %s\n" - (String.concat ", " (List.map string_of_int atoms.polarizations)); - printf " external momenta: %s\n" - (String.concat ", " atoms.external_momenta); - printf " spinors: %s\n" - (String.concat ", " (List.map string_of_int atoms.spinors)); - printf "conjugated spinors: %s\n" - (String.concat ", " (List.map string_of_int atoms.conj_spinors)); - printf "d/deps1: %s\n" (vector_to_string (partial_vector (e 1) coupling)); - printf "d/deps2: %s\n" (vector_to_string (partial_vector (e 2) coupling)); - printf "d/deps3: %s\n" (vector_to_string (partial_vector (e 3) coupling)); - printf "d/|1>: %s\n" (conj_spinor_to_string (partial_spinor 1 coupling)); - printf "d/|2>: %s\n" (conj_spinor_to_string (partial_spinor 2 coupling)); - printf "d/|3>: %s\n" (conj_spinor_to_string (partial_spinor 3 coupling)); - printf "d/<1|: %s\n" (spinor_to_string (partial_conj_spinor 1 coupling)); - printf "d/<2|: %s\n" (spinor_to_string (partial_conj_spinor 2 coupling)); - printf "d/<3|: %s\n" (spinor_to_string (partial_conj_spinor 3 coupling)); - print_fusion "foo" 0 - { coupling = coupling; - wfs = List.map snd (wfs order atoms) }; - print_fusion "foo" 1 - { coupling = coupling; - wfs = List.map snd (wfs order atoms) }; - print_fusion "foo" 2 - { coupling = coupling; - wfs = List.map snd (wfs order atoms) } - -let process_vertex coupling = - try - process_vertex coupling - with - | Failure s -> - printf "************************************************************************\n"; - printf "FAILURE: %s!!!\n" s; - printf "************************************************************************\n" - -(*i -let _ = - process_vertex (parse (read_line ())) -i*) - -(* \thocwmodulesection{Code Generation} - \begin{dubious} - Most of this will be moved to [Targets]. - \end{dubious} *) - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * compile-command:"ocamlc -o vertex thoList.ml{i,} pmap.ml{i,} vertex.ml" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/model_syntax.mli =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/model_syntax.mli (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/model_syntax.mli (revision 8703) @@ -1,67 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -(* This is not supposed to be an abstract data type, just the skeleton that - the parser is based on. *) - -type name = - | Charged of string * string - | Neutral of string - -type particle = { name : name; attribs : (string * string) list } -val charged : string -> string -> (string * string) list -> particle -val neutral : string -> (string * string) list -> particle - -type vertex = { fields : string list; expr : Vertex_syntax.scalar } -val vertex : string list -> string -> vertex - -type coupling = string -val coupling : string -> coupling - -type file = - { particles : particle list; - couplings : coupling list; - vertices : vertex list; - authors : string list; - version : string list; - created : string list; - revised : string list } - -val empty : unit -> file -val add_particle : particle -> file -> file -val add_coupling : string -> file -> file -val add_vertex : vertex -> file -> file -val add_author : string -> file -> file -val add_version : string -> file -> file -val add_created : string -> file -> file -val add_revised : string -> file -> file - -exception Syntax_Error of string * int * int - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) - Index: branches/ohl/omega-development/completed/whizard2/src/f90_SM3.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/f90_SM3.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/f90_SM3.ml (revision 8703) @@ -1,33 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -module O = Omega.Make(Fusion.Binary)(Targets.Fortran) - (Models.SM3(Models.SM_no_anomalous)) -let _ = O.main () - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/cascade.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/cascade.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/cascade.ml (revision 8703) @@ -1,272 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -module type T = - sig - - type flavor - type p - - type t - val of_string_list : int -> string list -> t - val to_string : t -> string - - type selectors - val to_selectors : t -> selectors - val no_cascades : selectors - - val select_wf : selectors -> (flavor -> p -> p list -> bool) - val select_p : selectors -> (p -> p list -> bool) - val on_shell : selectors -> (flavor -> p -> bool) - val is_gauss : selectors -> (flavor -> p -> bool) - - val description : selectors -> string option - - end - -module Make (M : Model.T) (P : Momentum.T) : - (T with type flavor = M.flavor_sans_color and type p = P.t) = - struct - - module CS = Cascade_syntax - - type flavor = M.flavor_sans_color - type p = P.t - -(* Since we have - \begin{equation} - p \le q \Longleftrightarrow (-q) \le (-p) - \end{equation} - also for $\le$ as set inclusion [lesseq], only four of the eight - combinations are independent - \begin{equation} - \begin{aligned} - p &\le q &&\Longleftrightarrow & (-q) &\le (-p) \\ - q &\le p &&\Longleftrightarrow & (-p) &\le (-q) \\ - p &\le (-q) &&\Longleftrightarrow & q &\le (-p) \\ - (-q) &\le p &&\Longleftrightarrow & (-p) &\le q - \end{aligned} - \end{equation} *) - - let one_compatible p q = - let neg_q = P.neg q in - P.lesseq p q || - P.lesseq q p || - P.lesseq p neg_q || - P.lesseq neg_q p - -(* 'tis wasteful \ldots (at least by a factor of two, because every momentum - combination is generated, including the negative ones. *) - - let all_compatible p p_list q = - let l = List.length p_list in - if l <= 2 then - one_compatible p q - else - let tuple_lengths = ThoList.range 2 (succ l / 2) in - let tuples = ThoList.flatmap (fun n -> Combinatorics.choose n p_list) tuple_lengths in - let momenta = List.map (List.fold_left P.add (P.zero (P.dim q))) tuples in - List.for_all (one_compatible q) momenta - -(* The following assumes that the [flavor list] is always very short. Otherwise - one should use an efficient set implementation. *) - - type t = - | True - | False - | On_shell of flavor list * P.t - | On_shell_not of flavor list * P.t - | Off_shell of flavor list * P.t - | Off_shell_not of flavor list * P.t - | Gauss of flavor list * P.t - | Gauss_not of flavor list * P.t - | Any_flavor of P.t - | And of t list - - let of_string s = - Cascade_parser.main Cascade_lexer.token (Lexing.from_string s) - - let import dim cascades = - let rec import' = function - | CS.True -> - True - | CS.False -> - False - | CS.On_shell (f, p) -> - On_shell (List.map M.flavor_sans_color_of_string f, P.of_ints dim p) - | CS.On_shell_not (f, p) -> - On_shell_not (List.map M.flavor_sans_color_of_string f, P.of_ints dim p) - | CS.Off_shell (fs, p) -> - Off_shell (List.map M.flavor_sans_color_of_string fs, P.of_ints dim p) - | CS.Off_shell_not (fs, p) -> - Off_shell_not (List.map M.flavor_sans_color_of_string fs, P.of_ints dim p) - | CS.Gauss (f, p) -> - Gauss (List.map M.flavor_sans_color_of_string f, P.of_ints dim p) - | CS.Gauss_not (f, p) -> - Gauss (List.map M.flavor_sans_color_of_string f, P.of_ints dim p) - | CS.Any_flavor p -> - Any_flavor (P.of_ints dim p) - | CS.Or cs -> - invalid_arg "Cascade: OR patterns (||) not supported in this version!" - | CS.And cs -> And (List.map import' cs) in - import' cascades - - let of_string_list dim strings = - match List.map of_string strings with - | [] -> True - | first :: next -> - import dim (List.fold_right CS.mk_and next first) - - let flavors_to_string fs = - (String.concat ":" (List.map M.flavor_sans_color_to_string fs)) - - let rec to_string = function - | True -> - "true" - | False -> - "false" - | On_shell (fs, p) -> - P.to_string p ^ " = " ^ flavors_to_string fs - | On_shell_not (fs, p) -> - P.to_string p ^ " = !" ^ flavors_to_string fs - | Off_shell (fs, p) -> - P.to_string p ^ " ~ " ^ flavors_to_string fs - | Off_shell_not (fs, p) -> - P.to_string p ^ " ~ !" ^ flavors_to_string fs - | Gauss (fs, p) -> - P.to_string p ^ " # " ^ flavors_to_string fs - | Gauss_not (fs, p) -> - P.to_string p ^ " # !" ^ flavors_to_string fs - | Any_flavor p -> - P.to_string p ^ " ~ ?" - | And cs -> - String.concat " && " (List.map (fun c -> "(" ^ to_string c ^ ")") cs) - - type selectors = - { select_p : p -> p list -> bool; - select_wf : flavor -> p -> p list -> bool; - on_shell : flavor -> p -> bool; - is_gauss : flavor -> p -> bool; - description : string option } - - let no_cascades = - { select_p = (fun _ _ -> true); - select_wf = (fun _ _ _ -> true); - on_shell = (fun _ _ -> false); - is_gauss = (fun _ _ -> false); - description = None } - - let select_p s = s.select_p - let select_wf s = s.select_wf - let on_shell s = s.on_shell - let is_gauss s = s.is_gauss - let description s = s.description - - let to_select_p cascades p p_in = - let rec to_select_p' = function - | True -> true - | False -> false - | On_shell (_, momentum) | On_shell_not (_, momentum) - | Off_shell (_, momentum) | Off_shell_not (_, momentum) - | Gauss (_, momentum) | Gauss_not (_, momentum) - | Any_flavor momentum -> all_compatible p p_in momentum - | And [] -> false - | And cs -> List.for_all to_select_p' cs in - to_select_p' cascades - - let to_select_wf cascades f p p_in = - let f' = M.conjugate_sans_color f in - let rec to_select_wf' = function - | True -> true - | False -> false - | On_shell (flavors, momentum) - | Off_shell (flavors, momentum) - | Gauss (flavors, momentum) -> - if p = momentum || p = P.neg momentum then - List.mem f flavors || List.mem f' flavors - else - one_compatible p momentum && all_compatible p p_in momentum - | On_shell_not (flavors, momentum) - | Off_shell_not (flavors, momentum) - | Gauss_not (flavors, momentum) -> - if p = momentum || p = P.neg momentum then - not (List.mem f flavors || List.mem f' flavors) - else - one_compatible p momentum && all_compatible p p_in momentum - | Any_flavor momentum -> - one_compatible p momentum && all_compatible p p_in momentum - | And [] -> false - | And cs -> List.for_all to_select_wf' cs in - to_select_wf' cascades - - -(* In case you're wondering: [to_on_shell f p] and [is_gauss f p] only search - for on shell conditions and are to be used in a target, not in [Fusion]! *) - - let to_on_shell cascades f p = - let f' = M.conjugate_sans_color f in - let rec to_on_shell' = function - | True | False | Any_flavor _ - | Off_shell (_, _) | Off_shell_not (_, _) - | Gauss (_, _) | Gauss_not (_, _) -> false - | On_shell (flavors, momentum) -> - (p = momentum || p = P.neg momentum) && (List.mem f flavors || List.mem f' flavors) - | On_shell_not (flavors, momentum) -> - (p = momentum || p = P.neg momentum) && not (List.mem f flavors || List.mem f' flavors) - | And [] -> false - | And cs -> List.for_all to_on_shell' cs in - to_on_shell' cascades - - - let to_gauss cascades f p = - let f' = M.conjugate_sans_color f in - let rec to_gauss' = function - | True | False | Any_flavor _ - | Off_shell (_, _) | Off_shell_not (_, _) - | On_shell (_, _) | On_shell_not (_, _) -> false - | Gauss (flavors, momentum) -> - (p = momentum || p = P.neg momentum) && (List.mem f flavors || List.mem f' flavors) - | Gauss_not (flavors, momentum) -> - (p = momentum || p = P.neg momentum) && not (List.mem f flavors || List.mem f' flavors) - | And [] -> false - | And cs -> List.for_all to_gauss' cs in - to_gauss' cascades - - let to_selectors = function - | True -> no_cascades - | c -> { select_p = to_select_p c; - select_wf = to_select_wf c; - on_shell = to_on_shell c; - is_gauss = to_gauss c; - description = Some (to_string c) } - - - end - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) - Index: branches/ohl/omega-development/completed/whizard2/src/f90Maj_SM.ml =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/f90Maj_SM.ml (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/f90Maj_SM.ml (revision 8703) @@ -1,34 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -module O = Omega.Make - (Fusion.Binary_Majorana)(Targets.Fortran_Majorana) - (Models.SM(Models.SM_no_anomalous)) -let _ = O.main () - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/src/vertex.mli =================================================================== --- branches/ohl/omega-development/completed/whizard2/src/vertex.mli (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/src/vertex.mli (revision 8703) @@ -1,56 +0,0 @@ -(* $Id$ - - Copyright (C) 1999-2009 by - - Wolfgang Kilian - Thorsten Ohl - Juergen Reuter - - WHIZARD is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - WHIZARD is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) - -(* We're dealing with the tensor algebra freely generated by - momenta, metric and $\epsilon$ tensors, as well as scalars, - vectors and tensors constructed from fermionic bilinears. - - The design problem that we're dealing with is that an implementation - relying on types to guarantee that only legal expressions can be - constructed will be hideously complex. A ``correct'' solution would - represent vertices as tensors, without using indices, external - polarization vectors or currents. However, the presence of - contractions~$g^{\mu\nu}$ and~$\epsilon^{\mu\nu\rho\sigma}$ introduces - a wealth of special cases, corresponding to which combinations of invariant - tensors remains uncontracted. - - Therefore, it appears to be a better strategy to use arithmetic expressions - built from tensors contrated with external polarization vectors. We can then - check at runtime that the expression is linear in these polarization vectors. *) - -(* \thocwmodulesection{Code Generation} - \begin{dubious} - Most of this will be moved to [Targets]. - \end{dubious} *) - -val parse : string -> Vertex_syntax.scalar - -val process_vertex : Vertex_syntax.scalar -> unit - -(*i - * Local Variables: - * mode:caml - * indent-tabs-mode:nil - * page-delimiter:"^(\\* .*\n" - * compile-command:"ocamlc -o vertex thoList.ml{i,} pmap.ml{i,} vertex.ml" - * End: -i*) Index: branches/ohl/omega-development/completed/whizard2/config.guess =================================================================== --- branches/ohl/omega-development/completed/whizard2/config.guess (revision 8702) +++ branches/ohl/omega-development/completed/whizard2/config.guess (revision 8703) @@ -1,1400 +0,0 @@ -#! /bin/sh -# Attempt to guess a canonical system name. -# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001 -# Free Software Foundation, Inc. - -timestamp='2001-02-13' - -# This file is free software; you can redistribute it and/or modify it -# under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2 of the License, or -# (at your option) any later version. -# -# This program is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. -# -# As a special exception to the GNU General Public License, if you -# distribute this file as part of a program that contains a -# configuration script generated by Autoconf, you may include it under -# the same distribution terms that you use for the rest of that program. - -# Written by Per Bothner . -# Please send patches to . -# -# This script attempts to guess a canonical system name similar to -# config.sub. If it succeeds, it prints the system name on stdout, and -# exits with 0. Otherwise, it exits with 1. -# -# The plan is that this can be called by configure scripts if you -# don't specify an explicit build system type. - -me=`echo "$0" | sed -e 's,.*/,,'` - -usage="\ -Usage: $0 [OPTION] - -Output the configuration name of the system \`$me' is run on. - -Operation modes: - -h, --help print this help, then exit - -t, --time-stamp print date of last modification, then exit - -v, --version print version number, then exit - -Report bugs and patches to ." - -version="\ -GNU config.guess ($timestamp) - -Originally written by Per Bothner. -Copyright (C) 1992, 93, 94, 95, 96, 97, 98, 99, 2000 -Free Software Foundation, Inc. - -This is free software; see the source for copying conditions. There is NO -warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." - -help=" -Try \`$me --help' for more information." - -# Parse command line -while test $# -gt 0 ; do - case $1 in - --time-stamp | --time* | -t ) - echo "$timestamp" ; exit 0 ;; - --version | -v ) - echo "$version" ; exit 0 ;; - --help | --h* | -h ) - echo "$usage"; exit 0 ;; - -- ) # Stop option processing - shift; break ;; - - ) # Use stdin as input. - break ;; - -* ) - echo "$me: invalid option $1$help" >&2 - exit 1 ;; - * ) - break ;; - esac -done - -if test $# != 0; then - echo "$me: too many arguments$help" >&2 - exit 1 -fi - - -dummy=dummy-$$ -trap 'rm -f $dummy.c $dummy.o $dummy.rel $dummy; exit 1' 1 2 15 - -# CC_FOR_BUILD -- compiler used by this script. -# Historically, `CC_FOR_BUILD' used to be named `HOST_CC'. We still -# use `HOST_CC' if defined, but it is deprecated. - -case $CC_FOR_BUILD,$HOST_CC,$CC in - ,,) echo "int dummy(){}" > $dummy.c - for c in cc gcc c89 ; do - ($c $dummy.c -c -o $dummy.o) >/dev/null 2>&1 - if test $? = 0 ; then - CC_FOR_BUILD="$c"; break - fi - done - rm -f $dummy.c $dummy.o $dummy.rel - if test x"$CC_FOR_BUILD" = x ; then - CC_FOR_BUILD=no_compiler_found - fi - ;; - ,,*) CC_FOR_BUILD=$CC ;; - ,*,*) CC_FOR_BUILD=$HOST_CC ;; -esac - -# This is needed to find uname on a Pyramid OSx when run in the BSD universe. -# (ghazi@noc.rutgers.edu 8/24/94.) -if (test -f /.attbin/uname) >/dev/null 2>&1 ; then - PATH=$PATH:/.attbin ; export PATH -fi - -UNAME_MACHINE=`(uname -m) 2>/dev/null` || UNAME_MACHINE=unknown -UNAME_RELEASE=`(uname -r) 2>/dev/null` || UNAME_RELEASE=unknown -UNAME_SYSTEM=`(uname -s) 2>/dev/null` || UNAME_SYSTEM=unknown -UNAME_VERSION=`(uname -v) 2>/dev/null` || UNAME_VERSION=unknown - -case "${UNAME_MACHINE}" in - i?86) - test -z "$VENDOR" && VENDOR=pc - ;; - *) - test -z "$VENDOR" && VENDOR=unknown - ;; -esac -test -e /etc/SuSE-release && VENDOR=suse - -# Note: order is significant - the case branches are not exclusive. - -case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in - *:NetBSD:*:*) - # Netbsd (nbsd) targets should (where applicable) match one or - # more of the tupples: *-*-netbsdelf*, *-*-netbsdaout*, - # *-*-netbsdecoff* and *-*-netbsd*. For targets that recently - # switched to ELF, *-*-netbsd* would select the old - # object file format. This provides both forward - # compatibility and a consistent mechanism for selecting the - # object file format. - # Determine the machine/vendor (is the vendor relevant). - case "${UNAME_MACHINE}" in - amiga) machine=m68k-unknown ;; - arm32) machine=arm-unknown ;; - atari*) machine=m68k-atari ;; - sun3*) machine=m68k-sun ;; - mac68k) machine=m68k-apple ;; - macppc) machine=powerpc-apple ;; - hp3[0-9][05]) machine=m68k-hp ;; - ibmrt|romp-ibm) machine=romp-ibm ;; - *) machine=${UNAME_MACHINE}-unknown ;; - esac - # The Operating System including object format, if it has switched - # to ELF recently, or will in the future. - case "${UNAME_MACHINE}" in - i386|sparc|amiga|arm*|hp300|mvme68k|vax|atari|luna68k|mac68k|news68k|next68k|pc532|sun3*|x68k) - if echo __ELF__ | $CC_FOR_BUILD -E - 2>/dev/null \ - | grep __ELF__ >/dev/null - then - # Once all utilities can be ECOFF (netbsdecoff) or a.out (netbsdaout). - # Return netbsd for either. FIX? - os=netbsd - else - os=netbsdelf - fi - ;; - *) - os=netbsd - ;; - esac - # The OS release - release=`echo ${UNAME_RELEASE}|sed -e 's/[-_].*/\./'` - # Since CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM: - # contains redundant information, the shorter form: - # CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM is used. - echo "${machine}-${os}${release}" - exit 0 ;; - alpha:OSF1:*:*) - if test $UNAME_RELEASE = "V4.0"; then - UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $3}'` - fi - # A Vn.n version is a released version. - # A Tn.n version is a released field test version. - # A Xn.n version is an unreleased experimental baselevel. - # 1.2 uses "1.2" for uname -r. - cat <$dummy.s - .data -\$Lformat: - .byte 37,100,45,37,120,10,0 # "%d-%x\n" - - .text - .globl main - .align 4 - .ent main -main: - .frame \$30,16,\$26,0 - ldgp \$29,0(\$27) - .prologue 1 - .long 0x47e03d80 # implver \$0 - lda \$2,-1 - .long 0x47e20c21 # amask \$2,\$1 - lda \$16,\$Lformat - mov \$0,\$17 - not \$1,\$18 - jsr \$26,printf - ldgp \$29,0(\$26) - mov 0,\$16 - jsr \$26,exit - .end main -EOF - $CC_FOR_BUILD $dummy.s -o $dummy 2>/dev/null - if test "$?" = 0 ; then - case `./$dummy` in - 0-0) - UNAME_MACHINE="alpha" - ;; - 1-0) - UNAME_MACHINE="alphaev5" - ;; - 1-1) - UNAME_MACHINE="alphaev56" - ;; - 1-101) - UNAME_MACHINE="alphapca56" - ;; - 2-303) - UNAME_MACHINE="alphaev6" - ;; - 2-307) - UNAME_MACHINE="alphaev67" - ;; - esac - fi - rm -f $dummy.s $dummy - echo ${UNAME_MACHINE}-dec-osf`echo ${UNAME_RELEASE} | sed -e 's/^[VTX]//' | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'` - exit 0 ;; - Alpha\ *:Windows_NT*:*) - # How do we know it's Interix rather than the generic POSIX subsystem? - # Should we change UNAME_MACHINE based on the output of uname instead - # of the specific Alpha model? - echo alpha-pc-interix - exit 0 ;; - 21064:Windows_NT:50:3) - echo alpha-dec-winnt3.5 - exit 0 ;; - Amiga*:UNIX_System_V:4.0:*) - echo m68k-unknown-sysv4 - exit 0;; - amiga:OpenBSD:*:*) - echo m68k-unknown-openbsd${UNAME_RELEASE} - exit 0 ;; - *:[Aa]miga[Oo][Ss]:*:*) - echo ${UNAME_MACHINE}-unknown-amigaos - exit 0 ;; - arc64:OpenBSD:*:*) - echo mips64el-unknown-openbsd${UNAME_RELEASE} - exit 0 ;; - arc:OpenBSD:*:*) - echo mipsel-unknown-openbsd${UNAME_RELEASE} - exit 0 ;; - hkmips:OpenBSD:*:*) - echo mips-unknown-openbsd${UNAME_RELEASE} - exit 0 ;; - pmax:OpenBSD:*:*) - echo mipsel-unknown-openbsd${UNAME_RELEASE} - exit 0 ;; - sgi:OpenBSD:*:*) - echo mips-unknown-openbsd${UNAME_RELEASE} - exit 0 ;; - wgrisc:OpenBSD:*:*) - echo mipsel-unknown-openbsd${UNAME_RELEASE} - exit 0 ;; - *:OS/390:*:*) - echo i370-ibm-openedition - exit 0 ;; - arm:RISC*:1.[012]*:*|arm:riscix:1.[012]*:*) - echo arm-acorn-riscix${UNAME_RELEASE} - exit 0;; - SR2?01:HI-UX/MPP:*:* | SR8000:HI-UX/MPP:*:*) - echo hppa1.1-hitachi-hiuxmpp - exit 0;; - Pyramid*:OSx*:*:* | MIS*:OSx*:*:* | MIS*:SMP_DC-OSx*:*:*) - # akee@wpdis03.wpafb.af.mil (Earle F. Ake) contributed MIS and NILE. - if test "`(/bin/universe) 2>/dev/null`" = att ; then - echo pyramid-pyramid-sysv3 - else - echo pyramid-pyramid-bsd - fi - exit 0 ;; - NILE*:*:*:dcosx) - echo pyramid-pyramid-svr4 - exit 0 ;; - sun4H:SunOS:5.*:*) - echo sparc-hal-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` - exit 0 ;; - sun4*:SunOS:5.*:* | tadpole*:SunOS:5.*:*) - echo sparc-sun-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` - exit 0 ;; - i86pc:SunOS:5.*:*) - echo i386-pc-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` - exit 0 ;; - sun4*:SunOS:6*:*) - # According to config.sub, this is the proper way to canonicalize - # SunOS6. Hard to guess exactly what SunOS6 will be like, but - # it's likely to be more like Solaris than SunOS4. - echo sparc-sun-solaris3`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` - exit 0 ;; - sun4*:SunOS:*:*) - case "`/usr/bin/arch -k`" in - Series*|S4*) - UNAME_RELEASE=`uname -v` - ;; - esac - # Japanese Language versions have a version number like `4.1.3-JL'. - echo sparc-sun-sunos`echo ${UNAME_RELEASE}|sed -e 's/-/_/'` - exit 0 ;; - sun3*:SunOS:*:*) - echo m68k-sun-sunos${UNAME_RELEASE} - exit 0 ;; - sun*:*:4.2BSD:*) - UNAME_RELEASE=`(head -1 /etc/motd | awk '{print substr($5,1,3)}') 2>/dev/null` - test "x${UNAME_RELEASE}" = "x" && UNAME_RELEASE=3 - case "`/bin/arch`" in - sun3) - echo m68k-sun-sunos${UNAME_RELEASE} - ;; - sun4) - echo sparc-sun-sunos${UNAME_RELEASE} - ;; - esac - exit 0 ;; - aushp:SunOS:*:*) - echo sparc-auspex-sunos${UNAME_RELEASE} - exit 0 ;; - atari*:OpenBSD:*:*) - echo m68k-unknown-openbsd${UNAME_RELEASE} - exit 0 ;; - # The situation for MiNT is a little confusing. The machine name - # can be virtually everything (everything which is not - # "atarist" or "atariste" at least should have a processor - # > m68000). The system name ranges from "MiNT" over "FreeMiNT" - # to the lowercase version "mint" (or "freemint"). Finally - # the system name "TOS" denotes a system which is actually not - # MiNT. But MiNT is downward compatible to TOS, so this should - # be no problem. - atarist[e]:*MiNT:*:* | atarist[e]:*mint:*:* | atarist[e]:*TOS:*:*) - echo m68k-atari-mint${UNAME_RELEASE} - exit 0 ;; - atari*:*MiNT:*:* | atari*:*mint:*:* | atarist[e]:*TOS:*:*) - echo m68k-atari-mint${UNAME_RELEASE} - exit 0 ;; - *falcon*:*MiNT:*:* | *falcon*:*mint:*:* | *falcon*:*TOS:*:*) - echo m68k-atari-mint${UNAME_RELEASE} - exit 0 ;; - milan*:*MiNT:*:* | milan*:*mint:*:* | *milan*:*TOS:*:*) - echo m68k-milan-mint${UNAME_RELEASE} - exit 0 ;; - hades*:*MiNT:*:* | hades*:*mint:*:* | *hades*:*TOS:*:*) - echo m68k-hades-mint${UNAME_RELEASE} - exit 0 ;; - *:*MiNT:*:* | *:*mint:*:* | *:*TOS:*:*) - echo m68k-unknown-mint${UNAME_RELEASE} - exit 0 ;; - sun3*:OpenBSD:*:*) - echo m68k-unknown-openbsd${UNAME_RELEASE} - exit 0 ;; - mac68k:OpenBSD:*:*) - echo m68k-unknown-openbsd${UNAME_RELEASE} - exit 0 ;; - mvme68k:OpenBSD:*:*) - echo m68k-unknown-openbsd${UNAME_RELEASE} - exit 0 ;; - mvme88k:OpenBSD:*:*) - echo m88k-unknown-openbsd${UNAME_RELEASE} - exit 0 ;; - powerpc:machten:*:*) - echo powerpc-apple-machten${UNAME_RELEASE} - exit 0 ;; - RISC*:Mach:*:*) - echo mips-dec-mach_bsd4.3 - exit 0 ;; - RISC*:ULTRIX:*:*) - echo mips-dec-ultrix${UNAME_RELEASE} - exit 0 ;; - VAX*:ULTRIX*:*:*) - echo vax-dec-ultrix${UNAME_RELEASE} - exit 0 ;; - 2020:CLIX:*:* | 2430:CLIX:*:*) - echo clipper-intergraph-clix${UNAME_RELEASE} - exit 0 ;; - mips:*:*:UMIPS | mips:*:*:RISCos) - sed 's/^ //' << EOF >$dummy.c -#ifdef __cplusplus -#include /* for printf() prototype */ - int main (int argc, char *argv[]) { -#else - int main (argc, argv) int argc; char *argv[]; { -#endif - #if defined (host_mips) && defined (MIPSEB) - #if defined (SYSTYPE_SYSV) - printf ("mips-mips-riscos%ssysv\n", argv[1]); exit (0); - #endif - #if defined (SYSTYPE_SVR4) - printf ("mips-mips-riscos%ssvr4\n", argv[1]); exit (0); - #endif - #if defined (SYSTYPE_BSD43) || defined(SYSTYPE_BSD) - printf ("mips-mips-riscos%sbsd\n", argv[1]); exit (0); - #endif - #endif - exit (-1); - } -EOF - $CC_FOR_BUILD $dummy.c -o $dummy \ - && ./$dummy `echo "${UNAME_RELEASE}" | sed -n 's/\([0-9]*\).*/\1/p'` \ - && rm $dummy.c $dummy && exit 0 - rm -f $dummy.c $dummy - echo mips-mips-riscos${UNAME_RELEASE} - exit 0 ;; - Night_Hawk:Power_UNIX:*:*) - echo powerpc-harris-powerunix - exit 0 ;; - m88k:CX/UX:7*:*) - echo m88k-harris-cxux7 - exit 0 ;; - m88k:*:4*:R4*) - echo m88k-motorola-sysv4 - exit 0 ;; - m88k:*:3*:R3*) - echo m88k-motorola-sysv3 - exit 0 ;; - AViiON:dgux:*:*) - # DG/UX returns AViiON for all architectures - UNAME_PROCESSOR=`/usr/bin/uname -p` - if [ $UNAME_PROCESSOR = mc88100 ] || [ $UNAME_PROCESSOR = mc88110 ] - then - if [ ${TARGET_BINARY_INTERFACE}x = m88kdguxelfx ] || \ - [ ${TARGET_BINARY_INTERFACE}x = x ] - then - echo m88k-dg-dgux${UNAME_RELEASE} - else - echo m88k-dg-dguxbcs${UNAME_RELEASE} - fi - else - echo i586-dg-dgux${UNAME_RELEASE} - fi - exit 0 ;; - M88*:DolphinOS:*:*) # DolphinOS (SVR3) - echo m88k-dolphin-sysv3 - exit 0 ;; - M88*:*:R3*:*) - # Delta 88k system running SVR3 - echo m88k-motorola-sysv3 - exit 0 ;; - XD88*:*:*:*) # Tektronix XD88 system running UTekV (SVR3) - echo m88k-tektronix-sysv3 - exit 0 ;; - Tek43[0-9][0-9]:UTek:*:*) # Tektronix 4300 system running UTek (BSD) - echo m68k-tektronix-bsd - exit 0 ;; - *:IRIX*:*:*) - echo mips-sgi-irix`echo ${UNAME_RELEASE}|sed -e 's/-/_/g'` - exit 0 ;; - ????????:AIX?:[12].1:2) # AIX 2.2.1 or AIX 2.1.1 is RT/PC AIX. - echo romp-ibm-aix # uname -m gives an 8 hex-code CPU id - exit 0 ;; # Note that: echo "'`uname -s`'" gives 'AIX ' - i?86:AIX:*:*) - echo i386-ibm-aix - exit 0 ;; - ia64:AIX:*:*) - if [ -x /usr/bin/oslevel ] ; then - IBM_REV=`/usr/bin/oslevel` - else - IBM_REV=${UNAME_VERSION}.${UNAME_RELEASE} - fi - echo ${UNAME_MACHINE}-ibm-aix${IBM_REV} - exit 0 ;; - *:AIX:2:3) - if grep bos325 /usr/include/stdio.h >/dev/null 2>&1; then - sed 's/^ //' << EOF >$dummy.c - #include - - main() - { - if (!__power_pc()) - exit(1); - puts("powerpc-ibm-aix3.2.5"); - exit(0); - } -EOF - $CC_FOR_BUILD $dummy.c -o $dummy && ./$dummy && rm $dummy.c $dummy && exit 0 - rm -f $dummy.c $dummy - echo rs6000-ibm-aix3.2.5 - elif grep bos324 /usr/include/stdio.h >/dev/null 2>&1; then - echo rs6000-ibm-aix3.2.4 - else - echo rs6000-ibm-aix3.2 - fi - exit 0 ;; - *:AIX:*:[45]) - IBM_CPU_ID=`/usr/sbin/lsdev -C -c processor -S available | head -1 | awk '{ print $1 }'` - if /usr/sbin/lsattr -El ${IBM_CPU_ID} | grep ' POWER' >/dev/null 2>&1; then - IBM_ARCH=rs6000 - else - IBM_ARCH=powerpc - fi - if [ -x /usr/bin/oslevel ] ; then - IBM_REV=`/usr/bin/oslevel` - else - IBM_REV=${UNAME_VERSION}.${UNAME_RELEASE} - fi - echo ${IBM_ARCH}-ibm-aix${IBM_REV} - exit 0 ;; - *:AIX:*:*) - echo rs6000-ibm-aix - exit 0 ;; - ibmrt:4.4BSD:*|romp-ibm:BSD:*) - echo romp-ibm-bsd4.4 - exit 0 ;; - ibmrt:*BSD:*|romp-ibm:BSD:*) # covers RT/PC BSD and - echo romp-ibm-bsd${UNAME_RELEASE} # 4.3 with uname added to - exit 0 ;; # report: romp-ibm BSD 4.3 - *:BOSX:*:*) - echo rs6000-bull-bosx - exit 0 ;; - DPX/2?00:B.O.S.:*:*) - echo m68k-bull-sysv3 - exit 0 ;; - 9000/[34]??:4.3bsd:1.*:*) - echo m68k-hp-bsd - exit 0 ;; - hp300:4.4BSD:*:* | 9000/[34]??:4.3bsd:2.*:*) - echo m68k-hp-bsd4.4 - exit 0 ;; - 9000/[34678]??:HP-UX:*:*) - HPUX_REV=`echo ${UNAME_RELEASE}|sed -e 's/[^.]*.[0B]*//'` - case "${UNAME_MACHINE}" in - 9000/31? ) HP_ARCH=m68000 ;; - 9000/[34]?? ) HP_ARCH=m68k ;; - 9000/[678][0-9][0-9]) - case "${HPUX_REV}" in - 11.[0-9][0-9]) - if [ -x /usr/bin/getconf ]; then - sc_cpu_version=`/usr/bin/getconf SC_CPU_VERSION 2>/dev/null` - sc_kernel_bits=`/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null` - case "${sc_cpu_version}" in - 523) HP_ARCH="hppa1.0" ;; # CPU_PA_RISC1_0 - 528) HP_ARCH="hppa1.1" ;; # CPU_PA_RISC1_1 - 532) # CPU_PA_RISC2_0 - case "${sc_kernel_bits}" in - 32) HP_ARCH="hppa2.0n" ;; - 64) HP_ARCH="hppa2.0w" ;; - esac ;; - esac - fi ;; - esac - if [ "${HP_ARCH}" = "" ]; then - sed 's/^ //' << EOF >$dummy.c - - #define _HPUX_SOURCE - #include - #include - - int main () - { - #if defined(_SC_KERNEL_BITS) - long bits = sysconf(_SC_KERNEL_BITS); - #endif - long cpu = sysconf (_SC_CPU_VERSION); - - switch (cpu) - { - case CPU_PA_RISC1_0: puts ("hppa1.0"); break; - case CPU_PA_RISC1_1: puts ("hppa1.1"); break; - case CPU_PA_RISC2_0: - #if defined(_SC_KERNEL_BITS) - switch (bits) - { - case 64: puts ("hppa2.0w"); break; - case 32: puts ("hppa2.0n"); break; - default: puts ("hppa2.0"); break; - } break; - #else /* !defined(_SC_KERNEL_BITS) */ - puts ("hppa2.0"); break; - #endif - default: puts ("hppa1.0"); break; - } - exit (0); - } -EOF - (CCOPTS= $CC_FOR_BUILD $dummy.c -o $dummy 2>/dev/null ) && HP_ARCH=`./$dummy` - if test -z "$HP_ARCH"; then HP_ARCH=hppa; fi - rm -f $dummy.c $dummy - fi ;; - esac - echo ${HP_ARCH}-hp-hpux${HPUX_REV} - exit 0 ;; - ia64:HP-UX:*:*) - HPUX_REV=`echo ${UNAME_RELEASE}|sed -e 's/[^.]*.[0B]*//'` - echo ia64-hp-hpux${HPUX_REV} - exit 0 ;; - 3050*:HI-UX:*:*) - sed 's/^ //' << EOF >$dummy.c - #include - int - main () - { - long cpu = sysconf (_SC_CPU_VERSION); - /* The order matters, because CPU_IS_HP_MC68K erroneously returns - true for CPU_PA_RISC1_0. CPU_IS_PA_RISC returns correct - results, however. */ - if (CPU_IS_PA_RISC (cpu)) - { - switch (cpu) - { - case CPU_PA_RISC1_0: puts ("hppa1.0-hitachi-hiuxwe2"); break; - case CPU_PA_RISC1_1: puts ("hppa1.1-hitachi-hiuxwe2"); break; - case CPU_PA_RISC2_0: puts ("hppa2.0-hitachi-hiuxwe2"); break; - default: puts ("hppa-hitachi-hiuxwe2"); break; - } - } - else if (CPU_IS_HP_MC68K (cpu)) - puts ("m68k-hitachi-hiuxwe2"); - else puts ("unknown-hitachi-hiuxwe2"); - exit (0); - } -EOF - $CC_FOR_BUILD $dummy.c -o $dummy && ./$dummy && rm $dummy.c $dummy && exit 0 - rm -f $dummy.c $dummy - echo unknown-hitachi-hiuxwe2 - exit 0 ;; - 9000/7??:4.3bsd:*:* | 9000/8?[79]:4.3bsd:*:* ) - echo hppa1.1-hp-bsd - exit 0 ;; - 9000/8??:4.3bsd:*:*) - echo hppa1.0-hp-bsd - exit 0 ;; - *9??*:MPE/iX:*:*) - echo hppa1.0-hp-mpeix - exit 0 ;; - hp7??:OSF1:*:* | hp8?[79]:OSF1:*:* ) - echo hppa1.1-hp-osf - exit 0 ;; - hp8??:OSF1:*:*) - echo hppa1.0-hp-osf - exit 0 ;; - i?86:OSF1:*:*) - if [ -x /usr/sbin/sysversion ] ; then - echo ${UNAME_MACHINE}-unknown-osf1mk - else - echo ${UNAME_MACHINE}-unknown-osf1 - fi - exit 0 ;; - parisc*:Lites*:*:*) - echo hppa1.1-hp-lites - exit 0 ;; - hppa*:OpenBSD:*:*) - echo hppa-unknown-openbsd - exit 0 ;; - C1*:ConvexOS:*:* | convex:ConvexOS:C1*:*) - echo c1-convex-bsd - exit 0 ;; - C2*:ConvexOS:*:* | convex:ConvexOS:C2*:*) - if getsysinfo -f scalar_acc - then echo c32-convex-bsd - else echo c2-convex-bsd - fi - exit 0 ;; - C34*:ConvexOS:*:* | convex:ConvexOS:C34*:*) - echo c34-convex-bsd - exit 0 ;; - C38*:ConvexOS:*:* | convex:ConvexOS:C38*:*) - echo c38-convex-bsd - exit 0 ;; - C4*:ConvexOS:*:* | convex:ConvexOS:C4*:*) - echo c4-convex-bsd - exit 0 ;; - CRAY*X-MP:*:*:*) - echo xmp-cray-unicos - exit 0 ;; - CRAY*Y-MP:*:*:*) - echo ymp-cray-unicos${UNAME_RELEASE} - exit 0 ;; - CRAY*[A-Z]90:*:*:*) - echo ${UNAME_MACHINE}-cray-unicos${UNAME_RELEASE} \ - | sed -e 's/CRAY.*\([A-Z]90\)/\1/' \ - -e y/ABCDEFGHIJKLMNOPQRSTUVWXYZ/abcdefghijklmnopqrstuvwxyz/ - exit 0 ;; - CRAY*TS:*:*:*) - echo t90-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' - exit 0 ;; - CRAY*T3D:*:*:*) - echo alpha-cray-unicosmk${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' - exit 0 ;; - CRAY*T3E:*:*:*) - echo alphaev5-cray-unicosmk${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' - exit 0 ;; - CRAY*SV1:*:*:*) - echo sv1-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' - exit 0 ;; - CRAY-2:*:*:*) - echo cray2-cray-unicos - exit 0 ;; - F30[01]:UNIX_System_V:*:* | F700:UNIX_System_V:*:*) - FUJITSU_PROC=`uname -m | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'` - FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` - FUJITSU_REL=`echo ${UNAME_RELEASE} | sed -e 's/ /_/'` - echo "${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" - exit 0 ;; - hp300:OpenBSD:*:*) - echo m68k-unknown-openbsd${UNAME_RELEASE} - exit 0 ;; - i?86:BSD/386:*:* | i?86:BSD/OS:*:* | *:Ascend\ Embedded/OS:*:*) - echo ${UNAME_MACHINE}-pc-bsdi${UNAME_RELEASE} - exit 0 ;; - sparc*:BSD/OS:*:*) - echo sparc-unknown-bsdi${UNAME_RELEASE} - exit 0 ;; - *:BSD/OS:*:*) - echo ${UNAME_MACHINE}-unknown-bsdi${UNAME_RELEASE} - exit 0 ;; - *:FreeBSD:*:*) - echo ${UNAME_MACHINE}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` - exit 0 ;; - *:OpenBSD:*:*) - echo ${UNAME_MACHINE}-unknown-openbsd`echo ${UNAME_RELEASE}|sed -e 's/[-_].*/\./'` - exit 0 ;; - i*:CYGWIN*:*) - echo ${UNAME_MACHINE}-pc-cygwin - exit 0 ;; - i*:MINGW*:*) - echo ${UNAME_MACHINE}-pc-mingw32 - exit 0 ;; - i*:PW*:*) - echo ${UNAME_MACHINE}-pc-pw32 - exit 0 ;; - i*:Windows_NT*:* | Pentium*:Windows_NT*:*) - # How do we know it's Interix rather than the generic POSIX subsystem? - # It also conflicts with pre-2.0 versions of AT&T UWIN. Should we - # UNAME_MACHINE based on the output of uname instead of i386? - echo i386-pc-interix - exit 0 ;; - i*:UWIN*:*) - echo ${UNAME_MACHINE}-pc-uwin - exit 0 ;; - p*:CYGWIN*:*) - echo powerpcle-unknown-cygwin - exit 0 ;; - prep*:SunOS:5.*:*) - echo powerpcle-unknown-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` - exit 0 ;; - *:GNU:*:*) - echo `echo ${UNAME_MACHINE}|sed -e 's,[-/].*$,,'`-unknown-gnu`echo ${UNAME_RELEASE}|sed -e 's,/.*$,,'` - exit 0 ;; - i*86:Minix:*:*) - echo ${UNAME_MACHINE}-pc-minix - exit 0 ;; - ia64:Linux:*:*) - echo ${UNAME_MACHINE}-${VENDOR}-linux - exit 0 ;; - s390:Linux:*:* | s390x:Linux:*:*) - echo ${UNAME_MACHINE}-ibm-linux - exit 0 ;; - mips:Linux:*:*) - cat >$dummy.c < /* for printf() prototype */ -int main (int argc, char *argv[]) { -#else -int main (argc, argv) int argc; char *argv[]; { -#endif -#ifdef __MIPSEB__ - printf ("%s-${VENDOR}-linux\n", argv[1]); -#endif -#ifdef __MIPSEL__ - printf ("%sel-${VENDOR}-linux\n", argv[1]); -#endif - return 0; -} -EOF - $CC_FOR_BUILD $dummy.c -o $dummy 2>/dev/null && ./$dummy "${UNAME_MACHINE}" && rm $dummy.c $dummy && exit 0 - rm -f $dummy.c $dummy - ;; - x86_64:Linux:*:*) - echo x86_64-${VENDOR}-linux - exit 0 ;; - parisc:Linux:*:* | hppa:Linux:*:*) - # Look for CPU level - case `grep '^cpu[^a-z]*:' /proc/cpuinfo 2>/dev/null | cut -d' ' -f2` in - PA7*) echo hppa1.1-${VENDOR}-linux ;; - PA8*) echo hppa2.0-${VENDOR}-linux ;; - *) echo hppa-${VENDOR}-linux ;; - esac - exit 0 ;; - parisc64:Linux:*:* | hppa64:Linux:*:*) - echo hppa64-${VENDOR}-linux - exit 0 ;; - sh*:Linux:*:*) - echo ${UNAME_MACHINE}-${VENDOR}-linux - exit 0 ;; - *:Linux:*:*) - # uname on the ARM produces all sorts of strangeness, and we need to - # filter it out. - case $UNAME_MACHINE in - armv*) ;; - arm* | sa110*) UNAME_MACHINE=arm ;; - esac - - # The BFD linker knows what the default object file format is, so - # first see if it will tell us. cd to the root directory to prevent - # problems with other programs or directories called `ld' in the path. - ld_supported_emulations=`cd /; ld --help 2>&1 \ - | sed -ne '/supported emulations:/!d - s/[ ][ ]*/ /g - s/.*supported emulations: *// - s/ .*// - p'` - case "$ld_supported_emulations" in - i?86linux) - echo "${UNAME_MACHINE}-pc-linuxaout" - exit 0 - ;; - elf_i?86) - TENTATIVE="${UNAME_MACHINE}-pc-linux" - ;; - i?86coff) - echo "${UNAME_MACHINE}-pc-linuxcoff" - exit 0 - ;; - sparclinux) - echo "${UNAME_MACHINE}-${VENDOR}-linuxaout" - exit 0 - ;; - elf32_sparc) - echo "${UNAME_MACHINE}-${VENDOR}-linux" - exit 0 - ;; - armlinux) - echo "${UNAME_MACHINE}-${VENDOR}-linuxaout" - exit 0 - ;; - elf32arm*) - echo "${UNAME_MACHINE}-${VENDOR}-linuxoldld" - exit 0 - ;; - armelf_linux*) - echo "${UNAME_MACHINE}-${VENDOR}-linux" - exit 0 - ;; - m68klinux) - echo "${UNAME_MACHINE}-${VENDOR}-linuxaout" - exit 0 - ;; - elf32ppc | elf32ppclinux) - # Determine Lib Version - cat >$dummy.c < -#if defined(__GLIBC__) -extern char __libc_version[]; -extern char __libc_release[]; -#endif -main(argc, argv) - int argc; - char *argv[]; -{ -#if defined(__GLIBC__) - printf("%s %s\n", __libc_version, __libc_release); -#else - printf("unkown\n"); -#endif - return 0; -} -EOF - LIBC="" - $CC_FOR_BUILD $dummy.c -o $dummy 2>/dev/null - if test "$?" = 0 ; then - ./$dummy | grep 1\.99 > /dev/null - if test "$?" = 0 ; then - LIBC="libc1" - fi - fi - rm -f $dummy.c $dummy - echo powerpc-${VENDOR}-linux${LIBC} - exit 0 - ;; - esac - - if test "${UNAME_MACHINE}" = "alpha" ; then - cat <$dummy.s - .data - \$Lformat: - .byte 37,100,45,37,120,10,0 # "%d-%x\n" - - .text - .globl main - .align 4 - .ent main - main: - .frame \$30,16,\$26,0 - ldgp \$29,0(\$27) - .prologue 1 - .long 0x47e03d80 # implver \$0 - lda \$2,-1 - .long 0x47e20c21 # amask \$2,\$1 - lda \$16,\$Lformat - mov \$0,\$17 - not \$1,\$18 - jsr \$26,printf - ldgp \$29,0(\$26) - mov 0,\$16 - jsr \$26,exit - .end main -EOF - LIBC="" - $CC_FOR_BUILD $dummy.s -o $dummy 2>/dev/null - if test "$?" = 0 ; then - case `./$dummy` in - 0-0) UNAME_MACHINE="alpha" ;; - 1-0) UNAME_MACHINE="alphaev5" ;; - 1-1) UNAME_MACHINE="alphaev56" ;; - 1-101) UNAME_MACHINE="alphapca56" ;; - 2-303) UNAME_MACHINE="alphaev6" ;; - 2-307) UNAME_MACHINE="alphaev67" ;; - esac - - objdump --private-headers $dummy | \ - grep ld.so.1 > /dev/null - if test "$?" = 0 ; then - LIBC="libc1" - fi - fi - rm -f $dummy.s $dummy - echo ${UNAME_MACHINE}-${VENDOR}-linux${LIBC} ; exit 0 - else - # Either a pre-BFD a.out linker (linuxoldld) - # or one that does not give us useful --help. - # GCC wants to distinguish between linuxoldld and linuxaout. - # If ld does not provide *any* "supported emulations:" - # that means it is gnuoldld. - test -z "$ld_supported_emulations" \ - && echo "${UNAME_MACHINE}-pc-linuxoldld" && exit 0 - - # Determine whether the default compiler is a.out or elf - cat >$dummy.c < -#ifdef __cplusplus -#include /* for printf() prototype */ - int main (int argc, char *argv[]) { -#else - int main (argc, argv) int argc; char *argv[]; { -#endif -#ifdef __ELF__ -# ifdef __GLIBC__ -# if __GLIBC__ >= 2 - printf ("%s-${VENDOR}-linux\n", argv[1]); -# else - printf ("%s-${VENDOR}-linuxlibc1\n", argv[1]); -# endif -# else - printf ("%s-${VENDOR}-linuxlibc1\n", argv[1]); -# endif -#else - printf ("%s-${VENDOR}-linuxaout\n", argv[1]); -#endif - return 0; -} -EOF - $CC_FOR_BUILD $dummy.c -o $dummy 2>/dev/null && ./$dummy "${UNAME_MACHINE}" && rm $dummy.c $dummy && exit 0 - rm -f $dummy.c $dummy - test x"${TENTATIVE}" != x && echo "${TENTATIVE}" && exit 0 - fi ;; -# ptx 4.0 does uname -s correctly, with DYNIX/ptx in there. earlier versions -# are messed up and put the nodename in both sysname and nodename. - i?86:DYNIX/ptx:4*:*) - echo i386-sequent-sysv4 - exit 0 ;; - i?86:UNIX_SV:4.2MP:2.*) - # Unixware is an offshoot of SVR4, but it has its own version - # number series starting with 2... - # I am not positive that other SVR4 systems won't match this, - # I just have to hope. -- rms. - # Use sysv4.2uw... so that sysv4* matches it. - echo ${UNAME_MACHINE}-pc-sysv4.2uw${UNAME_VERSION} - exit 0 ;; - i?86:*:4.*:* | i?86:SYSTEM_V:4.*:*) - UNAME_REL=`echo ${UNAME_RELEASE} | sed 's/\/MP$//'` - if grep Novell /usr/include/link.h >/dev/null 2>/dev/null; then - echo ${UNAME_MACHINE}-univel-sysv${UNAME_REL} - else - echo ${UNAME_MACHINE}-pc-sysv${UNAME_REL} - fi - exit 0 ;; - i?86:*:5:7*) - # Fixed at (any) Pentium or better - UNAME_MACHINE=i586 - if [ ${UNAME_SYSTEM} = "UnixWare" ] ; then - echo ${UNAME_MACHINE}-sco-sysv${UNAME_RELEASE}uw${UNAME_VERSION} - else - echo ${UNAME_MACHINE}-pc-sysv${UNAME_RELEASE} - fi - exit 0 ;; - i?86:*:3.2:*) - if test -f /usr/options/cb.name; then - UNAME_REL=`sed -n 's/.*Version //p' /dev/null >/dev/null ; then - UNAME_REL=`(/bin/uname -X|egrep Release|sed -e 's/.*= //')` - (/bin/uname -X|egrep i80486 >/dev/null) && UNAME_MACHINE=i486 - (/bin/uname -X|egrep '^Machine.*Pentium' >/dev/null) \ - && UNAME_MACHINE=i586 - (/bin/uname -X|egrep '^Machine.*Pent ?II' >/dev/null) \ - && UNAME_MACHINE=i686 - (/bin/uname -X|egrep '^Machine.*Pentium Pro' >/dev/null) \ - && UNAME_MACHINE=i686 - echo ${UNAME_MACHINE}-pc-sco$UNAME_REL - else - echo ${UNAME_MACHINE}-pc-sysv32 - fi - exit 0 ;; - i?86:*DOS:*:*) - echo ${UNAME_MACHINE}-pc-msdosdjgpp - exit 0 ;; - pc:*:*:*) - # Left here for compatibility: - # uname -m prints for DJGPP always 'pc', but it prints nothing about - # the processor, so we play safe by assuming i386. - echo i386-pc-msdosdjgpp - exit 0 ;; - Intel:Mach:3*:*) - echo i386-pc-mach3 - exit 0 ;; - paragon:*:*:*) - echo i860-intel-osf1 - exit 0 ;; - i860:*:4.*:*) # i860-SVR4 - if grep Stardent /usr/include/sys/uadmin.h >/dev/null 2>&1 ; then - echo i860-stardent-sysv${UNAME_RELEASE} # Stardent Vistra i860-SVR4 - else # Add other i860-SVR4 vendors below as they are discovered. - echo i860-unknown-sysv${UNAME_RELEASE} # Unknown i860-SVR4 - fi - exit 0 ;; - mini*:CTIX:SYS*5:*) - # "miniframe" - echo m68010-convergent-sysv - exit 0 ;; - M68*:*:R3V[567]*:*) - test -r /sysV68 && echo 'm68k-motorola-sysv' && exit 0 ;; - 3[34]??:*:4.0:3.0 | 3[34]??A:*:4.0:3.0 | 3[34]??,*:*:4.0:3.0 | 4850:*:4.0:3.0) - OS_REL='' - test -r /etc/.relid \ - && OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid` - /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ - && echo i486-ncr-sysv4.3${OS_REL} && exit 0 - /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \ - && echo i586-ncr-sysv4.3${OS_REL} && exit 0 ;; - 3[34]??:*:4.0:* | 3[34]??,*:*:4.0:*) - /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ - && echo i486-ncr-sysv4 && exit 0 ;; - m68*:LynxOS:2.*:*) - echo m68k-unknown-lynxos${UNAME_RELEASE} - exit 0 ;; - mc68030:UNIX_System_V:4.*:*) - echo m68k-atari-sysv4 - exit 0 ;; - i?86:LynxOS:2.*:* | i?86:LynxOS:3.[01]*:*) - echo i386-unknown-lynxos${UNAME_RELEASE} - exit 0 ;; - TSUNAMI:LynxOS:2.*:*) - echo sparc-unknown-lynxos${UNAME_RELEASE} - exit 0 ;; - rs6000:LynxOS:2.*:*) - echo rs6000-unknown-lynxos${UNAME_RELEASE} - exit 0 ;; - PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:*) - echo powerpc-unknown-lynxos${UNAME_RELEASE} - exit 0 ;; - SM[BE]S:UNIX_SV:*:*) - echo mips-dde-sysv${UNAME_RELEASE} - exit 0 ;; - RM*:ReliantUNIX-*:*:*) - echo mips-sni-sysv4 - exit 0 ;; - RM*:SINIX-*:*:*) - echo mips-sni-sysv4 - exit 0 ;; - *:SINIX-*:*:*) - if uname -p 2>/dev/null >/dev/null ; then - UNAME_MACHINE=`(uname -p) 2>/dev/null` - echo ${UNAME_MACHINE}-sni-sysv4 - else - echo ns32k-sni-sysv - fi - exit 0 ;; - PENTIUM:CPunix:4.0*:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort - # says - echo i586-unisys-sysv4 - exit 0 ;; - *:UNIX_System_V:4*:FTX*) - # From Gerald Hewes . - # How about differentiating between stratus architectures? -djm - echo hppa1.1-stratus-sysv4 - exit 0 ;; - *:*:*:FTX*) - # From seanf@swdc.stratus.com. - echo i860-stratus-sysv4 - exit 0 ;; - mc68*:A/UX:*:*) - echo m68k-apple-aux${UNAME_RELEASE} - exit 0 ;; - news*:NEWS-OS:6*:*) - echo mips-sony-newsos6 - exit 0 ;; - R[34]000:*System_V*:*:* | R4000:UNIX_SYSV:*:* | R*000:UNIX_SV:*:*) - if [ -d /usr/nec ]; then - echo mips-nec-sysv${UNAME_RELEASE} - else - echo mips-unknown-sysv${UNAME_RELEASE} - fi - exit 0 ;; - BeBox:BeOS:*:*) # BeOS running on hardware made by Be, PPC only. - echo powerpc-be-beos - exit 0 ;; - BeMac:BeOS:*:*) # BeOS running on Mac or Mac clone, PPC only. - echo powerpc-apple-beos - exit 0 ;; - BePC:BeOS:*:*) # BeOS running on Intel PC compatible. - echo i586-pc-beos - exit 0 ;; - SX-4:SUPER-UX:*:*) - echo sx4-nec-superux${UNAME_RELEASE} - exit 0 ;; - SX-5:SUPER-UX:*:*) - echo sx5-nec-superux${UNAME_RELEASE} - exit 0 ;; - Power*:Rhapsody:*:*) - echo powerpc-apple-rhapsody${UNAME_RELEASE} - exit 0 ;; - *:Rhapsody:*:*) - echo ${UNAME_MACHINE}-apple-rhapsody${UNAME_RELEASE} - exit 0 ;; - *:Darwin:*:*) - echo `uname -p`-apple-darwin${UNAME_RELEASE} - exit 0 ;; - *:procnto*:*:* | *:QNX:[0123456789]*:*) - if test "${UNAME_MACHINE}" = "x86pc"; then - UNAME_MACHINE=pc - fi - echo `uname -p`-${UNAME_MACHINE}-nto-qnx - exit 0 ;; - *:QNX:*:4*) - echo i386-pc-qnx - exit 0 ;; - NSR-[KW]:NONSTOP_KERNEL:*:*) - echo nsr-tandem-nsk${UNAME_RELEASE} - exit 0 ;; - *:NonStop-UX:*:*) - echo mips-compaq-nonstopux - exit 0 ;; - BS2000:POSIX*:*:*) - echo bs2000-siemens-sysv - exit 0 ;; - DS/*:UNIX_System_V:*:*) - echo ${UNAME_MACHINE}-${UNAME_SYSTEM}-${UNAME_RELEASE} - exit 0 ;; - *:Plan9:*:*) - # "uname -m" is not consistent, so use $cputype instead. 386 - # is converted to i386 for consistency with other x86 - # operating systems. - if test "$cputype" = "386"; then - UNAME_MACHINE=i386 - else - UNAME_MACHINE="$cputype" - fi - echo ${UNAME_MACHINE}-unknown-plan9 - exit 0 ;; - i?86:OS/2:*:*) - # If we were able to find `uname', then EMX Unix compatibility - # is probably installed. - echo ${UNAME_MACHINE}-pc-os2-emx - exit 0 ;; - *:TOPS-10:*:*) - echo pdp10-unknown-tops10 - exit 0 ;; - *:TENEX:*:*) - echo pdp10-unknown-tenex - exit 0 ;; - KS10:TOPS-20:*:* | KL10:TOPS-20:*:* | TYPE4:TOPS-20:*:*) - echo pdp10-dec-tops20 - exit 0 ;; - XKL-1:TOPS-20:*:* | TYPE5:TOPS-20:*:*) - echo pdp10-xkl-tops20 - exit 0 ;; - *:TOPS-20:*:*) - echo pdp10-unknown-tops20 - exit 0 ;; - *:ITS:*:*) - echo pdp10-unknown-its - exit 0 ;; -esac - -#echo '(No uname command or uname output not recognized.)' 1>&2 -#echo "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" 1>&2 - -cat >$dummy.c < -# include -#endif -main () -{ -#if defined (sony) -#if defined (MIPSEB) - /* BFD wants "bsd" instead of "newsos". Perhaps BFD should be changed, - I don't know.... */ - printf ("mips-sony-bsd\n"); exit (0); -#else -#include - printf ("m68k-sony-newsos%s\n", -#ifdef NEWSOS4 - "4" -#else - "" -#endif - ); exit (0); -#endif -#endif - -#if defined (__arm) && defined (__acorn) && defined (__unix) - printf ("arm-acorn-riscix"); exit (0); -#endif - -#if defined (hp300) && !defined (hpux) - printf ("m68k-hp-bsd\n"); exit (0); -#endif - -#if defined (NeXT) -#if !defined (__ARCHITECTURE__) -#define __ARCHITECTURE__ "m68k" -#endif - int version; - version=`(hostinfo | sed -n 's/.*NeXT Mach \([0-9]*\).*/\1/p') 2>/dev/null`; - if (version < 4) - printf ("%s-next-nextstep%d\n", __ARCHITECTURE__, version); - else - printf ("%s-next-openstep%d\n", __ARCHITECTURE__, version); - exit (0); -#endif - -#if defined (MULTIMAX) || defined (n16) -#if defined (UMAXV) - printf ("ns32k-encore-sysv\n"); exit (0); -#else -#if defined (CMU) - printf ("ns32k-encore-mach\n"); exit (0); -#else - printf ("ns32k-encore-bsd\n"); exit (0); -#endif -#endif -#endif - -#if defined (__386BSD__) - printf ("i386-pc-bsd\n"); exit (0); -#endif - -#if defined (sequent) -#if defined (i386) - printf ("i386-sequent-dynix\n"); exit (0); -#endif -#if defined (ns32000) - printf ("ns32k-sequent-dynix\n"); exit (0); -#endif -#endif - -#if defined (_SEQUENT_) - struct utsname un; - - uname(&un); - - if (strncmp(un.version, "V2", 2) == 0) { - printf ("i386-sequent-ptx2\n"); exit (0); - } - if (strncmp(un.version, "V1", 2) == 0) { /* XXX is V1 correct? */ - printf ("i386-sequent-ptx1\n"); exit (0); - } - printf ("i386-sequent-ptx\n"); exit (0); - -#endif - -#if defined (vax) -# if !defined (ultrix) -# include -# if defined (BSD) -# if BSD == 43 - printf ("vax-dec-bsd4.3\n"); exit (0); -# else -# if BSD == 199006 - printf ("vax-dec-bsd4.3reno\n"); exit (0); -# else - printf ("vax-dec-bsd\n"); exit (0); -# endif -# endif -# else - printf ("vax-dec-bsd\n"); exit (0); -# endif -# else - printf ("vax-dec-ultrix\n"); exit (0); -# endif -#endif - -#if defined (alliant) && defined (i860) - printf ("i860-alliant-bsd\n"); exit (0); -#endif - - exit (1); -} -EOF - -$CC_FOR_BUILD $dummy.c -o $dummy 2>/dev/null && ./$dummy && rm $dummy.c $dummy && exit 0 -rm -f $dummy.c $dummy - -# Apollos put the system type in the environment. - -test -d /usr/apollo && { echo ${ISP}-apollo-${SYSTYPE}; exit 0; } - -# Convex versions that predate uname can use getsysinfo(1) - -if [ -x /usr/convex/getsysinfo ] -then - case `getsysinfo -f cpu_type` in - c1*) - echo c1-convex-bsd - exit 0 ;; - c2*) - if getsysinfo -f scalar_acc - then echo c32-convex-bsd - else echo c2-convex-bsd - fi - exit 0 ;; - c34*) - echo c34-convex-bsd - exit 0 ;; - c38*) - echo c38-convex-bsd - exit 0 ;; - c4*) - echo c4-convex-bsd - exit 0 ;; - esac -fi - -cat >&2 < in order to provide the needed -information to handle your system. - -config.guess timestamp = $timestamp - -uname -m = `(uname -m) 2>/dev/null || echo unknown` -uname -r = `(uname -r) 2>/dev/null || echo unknown` -uname -s = `(uname -s) 2>/dev/null || echo unknown` -uname -v = `(uname -v) 2>/dev/null || echo unknown` - -/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null` -/bin/uname -X = `(/bin/uname -X) 2>/dev/null` - -hostinfo = `(hostinfo) 2>/dev/null` -/bin/universe = `(/bin/universe) 2>/dev/null` -/usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null` -/bin/arch = `(/bin/arch) 2>/dev/null` -/usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null` -/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null` - -UNAME_MACHINE = ${UNAME_MACHINE} -UNAME_RELEASE = ${UNAME_RELEASE} -UNAME_SYSTEM = ${UNAME_SYSTEM} -UNAME_VERSION = ${UNAME_VERSION} -EOF - -exit 1 - -# Local variables: -# eval: (add-hook 'write-file-hooks 'time-stamp) -# time-stamp-start: "timestamp='" -# time-stamp-format: "%:y-%02m-%02d" -# time-stamp-end: "'" -# End: