Page MenuHomeHEPForge

No OneTemporary

This file is larger than 256 KB, so syntax highlighting was skipped.
This document is not UTF8. It was detected as ISO-8859-1 (Latin 1) and converted to UTF8 for display.
Index: branches/ohl/omega-development/hgg-vertex/tools/kinematics.f90
===================================================================
--- branches/ohl/omega-development/hgg-vertex/tools/kinematics.f90 (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/tools/kinematics.f90 (revision 8717)
@@ -1,93 +0,0 @@
-! $Id$
-
-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 = omega_prec), dimension(0:), intent(in) :: p, q
- real(kind = omega_prec) :: pq
- pq = p(0)*q(0) - dot_product (p(1:), q(1:))
- end function dot
-
- pure function mass2 (p) result (m2)
- real (kind = omega_prec), dimension(0:), intent(in) :: p
- real (kind = omega_prec) :: 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 = omega_prec), intent(in) :: roots, m1, m2
- real (kind = omega_prec), dimension(0:), intent(out) :: p1, p2
- real (kind = omega_prec) :: 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 = omega_prec), intent(in) :: mass, m1, m2, costh, phi
- real (kind = omega_prec), dimension(0:), intent(out) :: p1, p2
- real (kind = omega_prec) :: 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 = omega_prec), dimension(0:), intent(in) :: v, p
- real (kind = omega_prec), 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 = omega_prec), dimension(0:), intent(in) :: v
- real (kind = omega_prec), dimension(0:,:), intent(in) :: p
- real (kind = omega_prec), 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 = omega_prec), dimension(0:), intent(in) :: p
- real (kind = omega_prec), dimension(0:), intent(out) :: p_plus, p_minus
- real (kind = omega_prec), dimension(3) :: q
- real (kind = omega_prec), dimension(0:3) :: b
- real (kind = omega_prec) :: 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/hgg-vertex/tools/testbed_old.f90
===================================================================
--- branches/ohl/omega-development/hgg-vertex/tools/testbed_old.f90 (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/tools/testbed_old.f90 (revision 8717)
@@ -1,1585 +0,0 @@
-! $Id$
-
-module testbed_old
- use kinds
- use omega95
- use kinematics
- use rambo
- use omega_parameters
- use omega_parameters_madgraph
- implicit none
- real(kind=omega_prec), parameter, private :: THRESHOLD_SIGMA = 1.0e-21_omega_prec
- 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=omega_prec), intent(in) :: s1, s2
- character(len=*), intent(in) :: n1, n2
- real(kind=omega_prec), intent(in) :: threshold
- integer, intent(in), optional :: tolerance
- real(kind=omega_prec) :: 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=omega_prec), intent(in) :: s1, s2
- character(len=*), intent(in) :: n1, n2
- integer, dimension(:), intent(in) :: s
- real(kind=omega_prec), intent(in) :: threshold
- integer, intent(in), optional :: tolerance
- real(kind=omega_prec) :: 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=omega_prec), intent(in) :: a1, a2
- character(len=*), intent(in) :: n1, n2
- integer, dimension(:), intent(in) :: s
- real(kind=omega_prec), intent(in) :: threshold
- integer, intent(in), optional :: tolerance
- real(kind=omega_prec) :: 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=omega_prec), intent(in) :: roots
- real(kind=omega_prec), dimension(:), intent(in) :: masses
- integer, dimension(:), intent(in), optional :: states
- integer, intent(in), optional :: tolerance
- interface
- pure function omega1 (p, s) result (m)
- use omega_kinds
- implicit none
- complex(kind=omega_prec) :: m
- real(kind=omega_prec), dimension(0:,:), intent(in) :: p
- integer, dimension(:), intent(in) :: s
- end function omega1
- pure function omega2 (p, s) result (m)
- use omega_kinds
- implicit none
- complex(kind=omega_prec) :: m
- real(kind=omega_prec), dimension(0:,:), intent(in) :: p
- integer, dimension(:), intent(in) :: s
- end function omega2
- end interface
- integer :: k, j
- real(kind=omega_prec) :: threshold, threshold1, threshold2
- complex(kind=omega_prec) :: a1, a2
- real(kind=omega_prec), 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=omega_prec), intent(in) :: roots
- real(kind=omega_prec), dimension(:), intent(in) :: masses
- integer, dimension(:), intent(in), optional :: states
- integer, intent(in), optional :: tolerance
- interface
- pure function omega1 (p, s) result (m)
- use omega_kinds
- implicit none
- complex(kind=omega_prec) :: m
- real(kind=omega_prec), dimension(0:,:), intent(in) :: p
- integer, dimension(:), intent(in) :: s
- end function omega1
- pure function omega2 (p, s) result (m)
- use omega_kinds
- implicit none
- complex(kind=omega_prec) :: m
- real(kind=omega_prec), dimension(0:,:), intent(in) :: p
- integer, dimension(:), intent(in) :: s
- end function omega2
- end interface
- integer :: k
- real(kind=omega_prec) :: s1, s2
- real(kind=omega_prec), 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=omega_prec), intent(in) :: roots
- real(kind=omega_prec), 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 omega_kinds
- implicit none
- complex(kind=omega_prec) :: m
- real(kind=omega_prec), dimension(0:,:), intent(in) :: p
- integer, dimension(:), intent(in) :: s
- end function omega
- end interface
- integer, dimension(size(masses)) :: s, sx, nstates
- real(kind=omega_prec), dimension(0:3,size(masses)) :: p, px
- integer :: k, j
- complex(kind=omega_prec) :: a, ax
- real(kind=omega_prec) :: 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=omega_prec), intent(in) :: roots
- real(kind=omega_prec), 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 omega_kinds
- implicit none
- complex(kind=omega_prec) :: m
- real(kind=omega_prec), dimension(0:,:), intent(in) :: p
- integer, dimension(:), intent(in) :: s
- end function omega1
- pure function omega2 (p, s) result (m)
- use omega_kinds
- implicit none
- complex(kind=omega_prec) :: m
- real(kind=omega_prec), 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=omega_prec), intent(in) :: roots
- real(kind=omega_prec), 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 omega_kinds
- implicit none
- complex(kind=omega_prec) :: m
- real(kind=omega_prec), dimension(0:,:), intent(in) :: p
- integer, dimension(:), intent(in) :: s
- end function omega
- end interface
- integer, dimension(size(masses)) :: s, nstates
- real(kind=omega_prec), dimension(0:3,size(masses)) :: p
- integer :: k, j
- complex(kind=omega_prec) :: a
- real(kind=omega_prec) :: 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=omega_prec), intent(in) :: roots
- real(kind=omega_prec), 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 omega_kinds
- implicit none
- complex(kind=omega_prec) :: m
- real(kind=omega_prec), dimension(0:,:), intent(in) :: p
- integer, dimension(:), intent(in) :: s
- end function omega
- function madgraph (p1, p2, p3, p4, hel) result (m)
- use omega_kinds
- implicit none
- real(kind=omega_prec) :: m
- real(kind=omega_prec), dimension(0:3) :: p1, p2, p3, p4
- integer, dimension(4) :: hel
- end function madgraph
- end interface
- integer, dimension(size(masses)) :: s, nstates
- real(kind=omega_prec), dimension(0:3,size(masses)) :: p
- integer :: k, j
- complex(kind=omega_prec) :: a
- real(kind=omega_prec) :: 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=omega_prec), intent(in) :: roots
- real(kind=omega_prec), dimension(:), intent(in) :: masses
- integer, dimension(:), intent(in), optional :: states
- integer, intent(in), optional :: tolerance
- interface
- pure function omega (p, s) result (m)
- use omega_kinds
- implicit none
- complex(kind=omega_prec) :: m
- real(kind=omega_prec), dimension(0:,:), intent(in) :: p
- integer, dimension(:), intent(in) :: s
- end function omega
- function madgraph (p1, p2, p3, p4, hel) result (m)
- use omega_kinds
- implicit none
- real(kind=omega_prec) :: m
- real(kind=omega_prec), dimension(0:3) :: p1, p2, p3, p4
- integer, dimension(4) :: hel
- end function madgraph
- end interface
- integer :: k, j
- real(kind=omega_prec) :: threshold, sm, so
- complex(kind=omega_prec) :: ao
- real(kind=omega_prec), 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=omega_prec), intent(in) :: roots
- real(kind=omega_prec), dimension(:), intent(in) :: masses
- integer, dimension(:), intent(in), optional :: states
- integer, intent(in), optional :: tolerance
- interface
- pure function omega (p, s) result (m)
- use omega_kinds
- implicit none
- complex(kind=omega_prec) :: m
- real(kind=omega_prec), dimension(0:,:), intent(in) :: p
- integer, dimension(:), intent(in) :: s
- end function omega
- function madgraph (p1, p2, p3, p4, p5, hel) result (m)
- use omega_kinds
- implicit none
- real(kind=omega_prec) :: m
- real(kind=omega_prec), dimension(0:3) :: p1, p2, p3, p4, p5
- integer, dimension(5) :: hel
- end function madgraph
- end interface
- integer :: k, j
- real(kind=omega_prec) :: threshold, sm, so
- complex(kind=omega_prec) :: ao
- real(kind=omega_prec), 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=omega_prec), intent(in) :: roots
- real(kind=omega_prec), dimension(:), intent(in) :: masses
- integer, dimension(:), intent(in), optional :: states
- integer, intent(in), optional :: tolerance
- interface
- pure function omega (p, s) result (m)
- use omega_kinds
- implicit none
- complex(kind=omega_prec) :: m
- real(kind=omega_prec), 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 omega_kinds
- implicit none
- real(kind=omega_prec) :: m
- real(kind=omega_prec), dimension(0:3) :: p1, p2, p3, p4, p5, p6
- integer, dimension(6) :: hel
- end function madgraph
- end interface
- integer :: k, j
- real(kind=omega_prec) :: threshold, sm, so
- complex(kind=omega_prec) :: ao
- real(kind=omega_prec), 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=omega_prec), intent(in) :: roots
- real(kind=omega_prec), dimension(:), intent(in) :: masses
- integer, dimension(:), intent(in), optional :: states
- integer, intent(in), optional :: tolerance
- interface
- pure function omega (p, s) result (m)
- use omega_kinds
- implicit none
- complex(kind=omega_prec) :: m
- real(kind=omega_prec), 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 omega_kinds
- implicit none
- real(kind=omega_prec) :: m
- real(kind=omega_prec), dimension(0:3) :: p1, p2, p3, p4, p5, p6, p7
- integer, dimension(7) :: hel
- end function madgraph
- end interface
- integer :: k, j
- real(kind=omega_prec) :: threshold, sm, so
- complex(kind=omega_prec) :: ao
- real(kind=omega_prec), 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=omega_prec), intent(in) :: roots
- real(kind=omega_prec), dimension(:), intent(in) :: masses
- integer, dimension(:), intent(in), optional :: states
- integer, intent(in), optional :: tolerance
- interface
- pure function omega (p, s) result (m)
- use omega_kinds
- implicit none
- complex(kind=omega_prec) :: m
- real(kind=omega_prec), 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 omega_kinds
- implicit none
- real(kind=omega_prec) :: m
- real(kind=omega_prec), 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=omega_prec) :: threshold, sm, so
- complex(kind=omega_prec) :: ao
- real(kind=omega_prec), 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=omega_prec), intent(in) :: roots
- real(kind=omega_prec), 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 omega_kinds
- implicit none
- complex(kind=omega_prec) :: m
- real(kind=omega_prec), dimension(0:,:), intent(in) :: p
- integer, dimension(:), intent(in) :: s
- end function omega
- function madgraph (p1, p2, p3, p4) result (s)
- use omega_kinds
- implicit none
- real(kind=omega_prec) :: s
- real(kind=omega_prec), dimension(0:3) :: p1, p2, p3, p4
- end function madgraph
- end interface
- real(kind=omega_prec), save :: s = 0
- integer :: k
- character(len=8) :: mode_local
- real(kind=omega_prec) :: sm, so
- real(kind=omega_prec), 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=omega_prec), intent(in) :: roots
- real(kind=omega_prec), 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 omega_kinds
- implicit none
- complex(kind=omega_prec) :: m
- real(kind=omega_prec), dimension(0:,:), intent(in) :: p
- integer, dimension(:), intent(in) :: s
- end function omega
- function madgraph (p1, p2, p3, p4, p5) result (s)
- use omega_kinds
- implicit none
- real(kind=omega_prec) :: s
- real(kind=omega_prec), dimension(0:3) :: p1, p2, p3, p4, p5
- end function madgraph
- end interface
- real(kind=omega_prec), save :: s = 0
- integer :: k
- character(len=8) :: mode_local
- real(kind=omega_prec) :: sm, so
- real(kind=omega_prec), 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=omega_prec), intent(in) :: roots
- real(kind=omega_prec), 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 omega_kinds
- implicit none
- complex(kind=omega_prec) :: m
- real(kind=omega_prec), dimension(0:,:), intent(in) :: p
- integer, dimension(:), intent(in) :: s
- end function omega
- function madgraph (p1, p2, p3, p4, p5, p6) result (s)
- use omega_kinds
- implicit none
- real(kind=omega_prec) :: s
- real(kind=omega_prec), dimension(0:3) :: p1, p2, p3, p4, p5, p6
- end function madgraph
- end interface
- real(kind=omega_prec), save :: s = 0
- integer :: k
- character(len=8) :: mode_local
- real(kind=omega_prec) :: sm, so
- real(kind=omega_prec), 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=omega_prec), intent(in) :: roots
- real(kind=omega_prec), 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 omega_kinds
- implicit none
- complex(kind=omega_prec) :: m
- real(kind=omega_prec), 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 omega_kinds
- implicit none
- real(kind=omega_prec) :: s
- real(kind=omega_prec), dimension(0:3) :: p1, p2, p3, p4, p5, p6, p7
- end function madgraph
- end interface
- real(kind=omega_prec), save :: s = 0
- integer :: k
- character(len=8) :: mode_local
- real(kind=omega_prec) :: sm, so
- real(kind=omega_prec), 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=omega_prec), intent(in) :: roots
- real(kind=omega_prec), 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 omega_kinds
- implicit none
- complex(kind=omega_prec) :: m
- real(kind=omega_prec), 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 omega_kinds
- implicit none
- real(kind=omega_prec) :: s
- real(kind=omega_prec), dimension(0:3) :: &
- p1, p2, p3, p4, p5, p6, p7, p8
- end function madgraph
- end interface
- real(kind=omega_prec), save :: s = 0
- integer :: k
- character(len=8) :: mode_local
- real(kind=omega_prec) :: sm, so
- real(kind=omega_prec), 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=omega_prec), intent(in) :: roots
- real(kind=omega_prec), 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 omega_kinds
- implicit none
- complex(kind=omega_prec) :: m
- real(kind=omega_prec), dimension(0:,:), intent(in) :: p
- integer, dimension(:), intent(in) :: s
- end function omega
- function smadgraph (p1, p2, p3, p4) result (s)
- use omega_kinds
- implicit none
- real(kind=omega_prec) :: s
- real(kind=omega_prec), dimension(0:3) :: p1, p2, p3, p4
- end function smadgraph
- function madgraph (p1, p2, p3, p4, hel) result (m)
- use omega_kinds
- implicit none
- real(kind=omega_prec) :: m
- real(kind=omega_prec), 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=omega_prec), intent(in) :: roots
- real(kind=omega_prec), 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 omega_kinds
- implicit none
- complex(kind=omega_prec) :: m
- real(kind=omega_prec), dimension(0:,:), intent(in) :: p
- integer, dimension(:), intent(in) :: s
- end function omega
- function smadgraph (p1, p2, p3, p4, p5) result (s)
- use omega_kinds
- implicit none
- real(kind=omega_prec) :: s
- real(kind=omega_prec), dimension(0:3) :: p1, p2, p3, p4, p5
- end function smadgraph
- function madgraph (p1, p2, p3, p4, p5, hel) result (m)
- use omega_kinds
- implicit none
- real(kind=omega_prec) :: m
- real(kind=omega_prec), 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=omega_prec), intent(in) :: roots
- real(kind=omega_prec), 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 omega_kinds
- implicit none
- complex(kind=omega_prec) :: m
- real(kind=omega_prec), dimension(0:,:), intent(in) :: p
- integer, dimension(:), intent(in) :: s
- end function omega
- function smadgraph (p1, p2, p3, p4, p5, p6) result (s)
- use omega_kinds
- implicit none
- real(kind=omega_prec) :: s
- real(kind=omega_prec), dimension(0:3) :: p1, p2, p3, p4, p5, p6
- end function smadgraph
- function madgraph (p1, p2, p3, p4, p5, p6, hel) result (m)
- use omega_kinds
- implicit none
- real(kind=omega_prec) :: m
- real(kind=omega_prec), 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=omega_prec), intent(in) :: roots
- real(kind=omega_prec), 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 omega_kinds
- implicit none
- complex(kind=omega_prec) :: m
- real(kind=omega_prec), 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 omega_kinds
- implicit none
- real(kind=omega_prec) :: s
- real(kind=omega_prec), 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 omega_kinds
- implicit none
- real(kind=omega_prec) :: m
- real(kind=omega_prec), 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=omega_prec), intent(in) :: roots
- real(kind=omega_prec), 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 omega_kinds
- implicit none
- complex(kind=omega_prec) :: m
- real(kind=omega_prec), 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 omega_kinds
- implicit none
- real(kind=omega_prec) :: s
- real(kind=omega_prec), 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 omega_kinds
- implicit none
- real(kind=omega_prec) :: m
- real(kind=omega_prec), 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/hgg-vertex/tools/testbed.f90
===================================================================
--- branches/ohl/omega-development/hgg-vertex/tools/testbed.f90 (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/tools/testbed.f90 (revision 8717)
@@ -1,1569 +0,0 @@
-! $Id$
-
-module testbed
- use kinds
- use omega95
- use kinematics
- use rambo
- use omega_parameters
- use omega_parameters_madgraph
- implicit none
- real(kind=omega_prec), parameter, private :: THRESHOLD_SIGMA = 1.0e-21_omega_prec
- 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=omega_prec), intent(in) :: s1, s2
- character(len=*), intent(in) :: n1, n2
- real(kind=omega_prec), intent(in) :: threshold
- integer, intent(in), optional :: tolerance
- real(kind=omega_prec) :: 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=omega_prec), intent(in) :: s1, s2
- character(len=*), intent(in) :: n1, n2
- integer, dimension(:), intent(in) :: s
- real(kind=omega_prec), intent(in) :: threshold
- integer, intent(in), optional :: tolerance
- real(kind=omega_prec) :: 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=omega_prec), intent(in) :: a1, a2
- character(len=*), intent(in) :: n1, n2
- integer, dimension(:), intent(in) :: s
- real(kind=omega_prec), intent(in) :: threshold
- integer, intent(in), optional :: tolerance
- real(kind=omega_prec) :: 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=omega_prec), intent(in) :: roots
- real(kind=omega_prec), dimension(:), intent(in) :: masses
- integer, intent(in), optional :: tolerance
- interface
- pure function omega1 (p, s, f) result (m)
- use omega_kinds
- implicit none
- complex(kind=omega_prec) :: m
- real(kind=omega_prec), 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 omega_kinds
- implicit none
- complex(kind=omega_prec) :: m
- real(kind=omega_prec), dimension(0:,:), intent(in) :: p
- integer, intent(in) :: s
- integer, intent(in) :: f
- end function omega2
- end interface
- integer :: k
- real(kind=omega_prec) :: threshold, threshold1, threshold2
- complex(kind=omega_prec) :: a1, a2
- real(kind=omega_prec), 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=omega_prec), intent(in) :: roots
- real(kind=omega_prec), dimension(:), intent(in) :: masses
- integer, dimension(:), intent(in), optional :: states
- integer, intent(in), optional :: tolerance
- interface
- pure function omega1 (p, s) result (m)
- use omega_kinds
- implicit none
- complex(kind=omega_prec) :: m
- real(kind=omega_prec), dimension(0:,:), intent(in) :: p
- integer, dimension(:), intent(in) :: s
- end function omega1
- pure function omega2 (p, s) result (m)
- use omega_kinds
- implicit none
- complex(kind=omega_prec) :: m
- real(kind=omega_prec), dimension(0:,:), intent(in) :: p
- integer, dimension(:), intent(in) :: s
- end function omega2
- end interface
- integer :: k
- real(kind=omega_prec) :: s1, s2
- real(kind=omega_prec), 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=omega_prec), intent(in) :: roots
- real(kind=omega_prec), 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 omega_kinds
- implicit none
- complex(kind=omega_prec) :: m
- real(kind=omega_prec), dimension(0:,:), intent(in) :: p
- integer, dimension(:), intent(in) :: s
- end function omega
- end interface
- integer, dimension(size(masses)) :: s, sx, nstates
- real(kind=omega_prec), dimension(0:3,size(masses)) :: p, px
- integer :: k, j
- complex(kind=omega_prec) :: a, ax
- real(kind=omega_prec) :: 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=omega_prec), intent(in) :: roots
- real(kind=omega_prec), 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 omega_kinds
- implicit none
- complex(kind=omega_prec) :: m
- real(kind=omega_prec), dimension(0:,:), intent(in) :: p
- integer, dimension(:), intent(in) :: s
- end function omega1
- pure function omega2 (p, s) result (m)
- use omega_kinds
- implicit none
- complex(kind=omega_prec) :: m
- real(kind=omega_prec), 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=omega_prec), intent(in) :: roots
- real(kind=omega_prec), 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 omega_kinds
- implicit none
- complex(kind=omega_prec) :: m
- real(kind=omega_prec), dimension(0:,:), intent(in) :: p
- integer, dimension(:), intent(in) :: s
- end function omega
- end interface
- integer, dimension(size(masses)) :: s, nstates
- real(kind=omega_prec), dimension(0:3,size(masses)) :: p
- integer :: k, j
- complex(kind=omega_prec) :: a
- real(kind=omega_prec) :: 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=omega_prec), intent(in) :: roots
- real(kind=omega_prec), 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 omega_kinds
- implicit none
- complex(kind=omega_prec) :: m
- real(kind=omega_prec), dimension(0:,:), intent(in) :: p
- integer, dimension(:), intent(in) :: s
- end function omega
- function madgraph (p1, p2, p3, p4, hel) result (m)
- use omega_kinds
- implicit none
- real(kind=omega_prec) :: m
- real(kind=omega_prec), 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=omega_prec), dimension(0:3,size(masses)) :: p
- integer :: k, j
- complex(kind=omega_prec) :: a
- real(kind=omega_prec) :: 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=omega_prec), intent(in) :: roots
- real(kind=omega_prec), dimension(:), intent(in) :: masses
- integer, dimension(:), intent(in), optional :: states
- integer, intent(in), optional :: tolerance
- interface
- pure function omega (p, s) result (m)
- use omega_kinds
- implicit none
- complex(kind=omega_prec) :: m
- real(kind=omega_prec), dimension(0:,:), intent(in) :: p
- integer, dimension(:), intent(in) :: s
- end function omega
- function madgraph (p1, p2, p3, p4, hel) result (m)
- use omega_kinds
- implicit none
- real(kind=omega_prec) :: m
- real(kind=omega_prec), dimension(0:3) :: p1, p2, p3, p4
- integer, dimension(4) :: hel
- end function madgraph
- end interface
- integer :: k, j
- real(kind=omega_prec) :: threshold, sm, so
- complex(kind=omega_prec) :: ao
- real(kind=omega_prec), 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=omega_prec), intent(in) :: roots
- real(kind=omega_prec), dimension(:), intent(in) :: masses
- integer, dimension(:), intent(in), optional :: states
- integer, intent(in), optional :: tolerance
- interface
- pure function omega (p, s) result (m)
- use omega_kinds
- implicit none
- complex(kind=omega_prec) :: m
- real(kind=omega_prec), dimension(0:,:), intent(in) :: p
- integer, dimension(:), intent(in) :: s
- end function omega
- function madgraph (p1, p2, p3, p4, p5, hel) result (m)
- use omega_kinds
- implicit none
- real(kind=omega_prec) :: m
- real(kind=omega_prec), dimension(0:3) :: p1, p2, p3, p4, p5
- integer, dimension(5) :: hel
- end function madgraph
- end interface
- integer :: k, j
- real(kind=omega_prec) :: threshold, sm, so
- complex(kind=omega_prec) :: ao
- real(kind=omega_prec), 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=omega_prec), intent(in) :: roots
- real(kind=omega_prec), dimension(:), intent(in) :: masses
- integer, dimension(:), intent(in), optional :: states
- integer, intent(in), optional :: tolerance
- interface
- pure function omega (p, s) result (m)
- use omega_kinds
- implicit none
- complex(kind=omega_prec) :: m
- real(kind=omega_prec), 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 omega_kinds
- implicit none
- real(kind=omega_prec) :: m
- real(kind=omega_prec), dimension(0:3) :: p1, p2, p3, p4, p5, p6
- integer, dimension(6) :: hel
- end function madgraph
- end interface
- integer :: k, j
- real(kind=omega_prec) :: threshold, sm, so
- complex(kind=omega_prec) :: ao
- real(kind=omega_prec), 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=omega_prec), intent(in) :: roots
- real(kind=omega_prec), dimension(:), intent(in) :: masses
- integer, dimension(:), intent(in), optional :: states
- integer, intent(in), optional :: tolerance
- interface
- pure function omega (p, s) result (m)
- use omega_kinds
- implicit none
- complex(kind=omega_prec) :: m
- real(kind=omega_prec), 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 omega_kinds
- implicit none
- real(kind=omega_prec) :: m
- real(kind=omega_prec), dimension(0:3) :: p1, p2, p3, p4, p5, p6, p7
- integer, dimension(7) :: hel
- end function madgraph
- end interface
- integer :: k, j
- real(kind=omega_prec) :: threshold, sm, so
- complex(kind=omega_prec) :: ao
- real(kind=omega_prec), 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=omega_prec), intent(in) :: roots
- real(kind=omega_prec), dimension(:), intent(in) :: masses
- integer, dimension(:), intent(in), optional :: states
- integer, intent(in), optional :: tolerance
- interface
- pure function omega (p, s) result (m)
- use omega_kinds
- implicit none
- complex(kind=omega_prec) :: m
- real(kind=omega_prec), 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 omega_kinds
- implicit none
- real(kind=omega_prec) :: m
- real(kind=omega_prec), 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=omega_prec) :: threshold, sm, so
- complex(kind=omega_prec) :: ao
- real(kind=omega_prec), 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=omega_prec), intent(in) :: roots
- real(kind=omega_prec), 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 omega_kinds
- implicit none
- complex(kind=omega_prec) :: m
- real(kind=omega_prec), dimension(0:,:), intent(in) :: p
- integer, dimension(:), intent(in) :: s
- end function omega
- function madgraph (p1, p2, p3, p4) result (s)
- use omega_kinds
- implicit none
- real(kind=omega_prec) :: s
- real(kind=omega_prec), dimension(0:3) :: p1, p2, p3, p4
- end function madgraph
- end interface
- real(kind=omega_prec), save :: s = 0
- integer :: k
- character(len=8) :: mode_local
- real(kind=omega_prec) :: sm, so
- real(kind=omega_prec), 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=omega_prec), intent(in) :: roots
- real(kind=omega_prec), 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 omega_kinds
- implicit none
- complex(kind=omega_prec) :: m
- real(kind=omega_prec), dimension(0:,:), intent(in) :: p
- integer, dimension(:), intent(in) :: s
- end function omega
- function madgraph (p1, p2, p3, p4, p5) result (s)
- use omega_kinds
- implicit none
- real(kind=omega_prec) :: s
- real(kind=omega_prec), dimension(0:3) :: p1, p2, p3, p4, p5
- end function madgraph
- end interface
- real(kind=omega_prec), save :: s = 0
- integer :: k
- character(len=8) :: mode_local
- real(kind=omega_prec) :: sm, so
- real(kind=omega_prec), 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=omega_prec), intent(in) :: roots
- real(kind=omega_prec), 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 omega_kinds
- implicit none
- complex(kind=omega_prec) :: m
- real(kind=omega_prec), dimension(0:,:), intent(in) :: p
- integer, dimension(:), intent(in) :: s
- end function omega
- function madgraph (p1, p2, p3, p4, p5, p6) result (s)
- use omega_kinds
- implicit none
- real(kind=omega_prec) :: s
- real(kind=omega_prec), dimension(0:3) :: p1, p2, p3, p4, p5, p6
- end function madgraph
- end interface
- real(kind=omega_prec), save :: s = 0
- integer :: k
- character(len=8) :: mode_local
- real(kind=omega_prec) :: sm, so
- real(kind=omega_prec), 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=omega_prec), intent(in) :: roots
- real(kind=omega_prec), 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 omega_kinds
- implicit none
- complex(kind=omega_prec) :: m
- real(kind=omega_prec), 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 omega_kinds
- implicit none
- real(kind=omega_prec) :: s
- real(kind=omega_prec), dimension(0:3) :: p1, p2, p3, p4, p5, p6, p7
- end function madgraph
- end interface
- real(kind=omega_prec), save :: s = 0
- integer :: k
- character(len=8) :: mode_local
- real(kind=omega_prec) :: sm, so
- real(kind=omega_prec), 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=omega_prec), intent(in) :: roots
- real(kind=omega_prec), 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 omega_kinds
- implicit none
- complex(kind=omega_prec) :: m
- real(kind=omega_prec), 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 omega_kinds
- implicit none
- real(kind=omega_prec) :: s
- real(kind=omega_prec), dimension(0:3) :: p1, p2, p3, p4, p5, p6, p7, p8
- end function madgraph
- end interface
- real(kind=omega_prec), save :: s = 0
- integer :: k
- character(len=8) :: mode_local
- real(kind=omega_prec) :: sm, so
- real(kind=omega_prec), 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=omega_prec), intent(in) :: roots
- real(kind=omega_prec), 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 omega_kinds
- implicit none
- complex(kind=omega_prec) :: m
- real(kind=omega_prec), dimension(0:,:), intent(in) :: p
- integer, dimension(:), intent(in) :: s
- end function omega
- function smadgraph (p1, p2, p3, p4) result (s)
- use omega_kinds
- implicit none
- real(kind=omega_prec) :: s
- real(kind=omega_prec), dimension(0:3) :: p1, p2, p3, p4
- end function smadgraph
- function madgraph (p1, p2, p3, p4, hel) result (m)
- use omega_kinds
- implicit none
- real(kind=omega_prec) :: m
- real(kind=omega_prec), 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=omega_prec), intent(in) :: roots
- real(kind=omega_prec), 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 omega_kinds
- implicit none
- complex(kind=omega_prec) :: m
- real(kind=omega_prec), dimension(0:,:), intent(in) :: p
- integer, dimension(:), intent(in) :: s
- end function omega
- function smadgraph (p1, p2, p3, p4, p5) result (s)
- use omega_kinds
- implicit none
- real(kind=omega_prec) :: s
- real(kind=omega_prec), dimension(0:3) :: p1, p2, p3, p4, p5
- end function smadgraph
- function madgraph (p1, p2, p3, p4, p5, hel) result (m)
- use omega_kinds
- implicit none
- real(kind=omega_prec) :: m
- real(kind=omega_prec), 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=omega_prec), intent(in) :: roots
- real(kind=omega_prec), 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 omega_kinds
- implicit none
- complex(kind=omega_prec) :: m
- real(kind=omega_prec), dimension(0:,:), intent(in) :: p
- integer, dimension(:), intent(in) :: s
- end function omega
- function smadgraph (p1, p2, p3, p4, p5, p6) result (s)
- use omega_kinds
- implicit none
- real(kind=omega_prec) :: s
-! real(kind=omega_prec), dimension(0:3), intent(in) :: &
- real(kind=omega_prec), dimension(0:3) :: &
- p1, p2, p3, p4, p5, p6
- end function smadgraph
- function madgraph (p1, p2, p3, p4, p5, p6, hel) result (m)
- use omega_kinds
- implicit none
- real(kind=omega_prec) :: m
- real(kind=omega_prec), 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=omega_prec), intent(in) :: roots
- real(kind=omega_prec), 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 omega_kinds
- implicit none
- complex(kind=omega_prec) :: m
- real(kind=omega_prec), 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 omega_kinds
- implicit none
- real(kind=omega_prec) :: s
- real(kind=omega_prec), 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 omega_kinds
- implicit none
- real(kind=omega_prec) :: m
- real(kind=omega_prec), 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=omega_prec), intent(in) :: roots
- real(kind=omega_prec), 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 omega_kinds
- implicit none
- complex(kind=omega_prec) :: m
- real(kind=omega_prec), 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 omega_kinds
- implicit none
- real(kind=omega_prec) :: s
- real(kind=omega_prec), 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 omega_kinds
- implicit none
- real(kind=omega_prec) :: m
- real(kind=omega_prec), 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/hgg-vertex/tools/Makefile.am
===================================================================
--- branches/ohl/omega-development/hgg-vertex/tools/Makefile.am (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/tools/Makefile.am (revision 8717)
@@ -1,27 +0,0 @@
-# Makefile.am -- Makefile for O'Mega within and without WHIZARD
-# $Id$
-##
-## Process this file with automake to produce Makefile.in
-##
-########################################################################
-#
-# Copyright (C) 1999-2010 by
-# Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
-# Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
-# Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-#
-# 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.
-#
-########################################################################
Index: branches/ohl/omega-development/hgg-vertex/tools/tao_random_numbers.f90
===================================================================
--- branches/ohl/omega-development/hgg-vertex/tools/tao_random_numbers.f90 (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/tools/tao_random_numbers.f90 (revision 8717)
@@ -1,897 +0,0 @@
-! $Id$
-!
-! Copyright (C) 1999-2009 by
-!
-! Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
-! Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
-! Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-!
-! 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/hgg-vertex/tools/rambo.f90
===================================================================
--- branches/ohl/omega-development/hgg-vertex/tools/rambo.f90 (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/tools/rambo.f90 (revision 8717)
@@ -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 = omega_prec), private, parameter :: &
- PI = 3.1415926535897932384626433832795028841972
-
-contains
-
- !!! The massless RAMBO algorithm
- subroutine massless_isotropic_decay (roots, p)
- real (kind = omega_prec), intent(in) :: roots
- ! It's a bit stupid that F disallows an explicit `dimension(0:3,:)' here.
- real (kind = omega_prec), dimension(0:,:), intent(out) :: p
- real (kind = omega_prec), dimension(0:3,size(p,dim=2)) :: q
- real (kind = omega_prec), dimension(0:3) :: qsum
- real (kind = double), dimension(4) :: ran
- real (kind = omega_prec) :: 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 = omega_prec), intent(in) :: roots
- real (kind = omega_prec), dimension(:), intent(in) :: m
- real (kind = omega_prec), dimension(0:,:), intent(out) :: p
- real (kind = omega_prec), dimension(0:3,size(p,dim=2)) :: q
- real (kind = omega_prec), dimension(size(p,dim=2)) :: p2, m2, p0
- real (kind = omega_prec), dimension(0:3) :: qsum
- real (kind = double), dimension(2) :: ran
- real (kind = omega_prec) :: c, s, f, qq
- real (kind = omega_prec) :: w, a, xu, u, umax, xv, v, vmax, x
- real (kind = omega_prec) :: 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/hgg-vertex/share/Makefile.am
===================================================================
--- branches/ohl/omega-development/hgg-vertex/share/Makefile.am (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/share/Makefile.am (revision 8717)
@@ -1,35 +0,0 @@
-# Makefile.am -- Makefile for O'Mega within and without WHIZARD
-# $Id: Makefile.am 1564 2010-01-21 18:19:23Z ohl $
-##
-## Process this file with automake to produce Makefile.in
-##
-########################################################################
-#
-# Copyright (C) 1999-2010 by
-# Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
-# Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
-# Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-#
-# 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.
-#
-########################################################################
-
-### Subdirectories to configure
-SUBDIRS = doc
-
-########################################################################
-## The End.
-########################################################################
-
Index: branches/ohl/omega-development/hgg-vertex/share/doc/bhabha0.eps
===================================================================
--- branches/ohl/omega-development/hgg-vertex/share/doc/bhabha0.eps (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/share/doc/bhabha0.eps (revision 8717)
@@ -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/hgg-vertex/share/doc/feynmp.sty
===================================================================
--- branches/ohl/omega-development/hgg-vertex/share/doc/feynmp.sty (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/share/doc/feynmp.sty (revision 8717)
@@ -1,339 +0,0 @@
-%%
-%% This is file `feynmp.sty',
-%% generated with the docstrip utility.
-%%
-%% The original source files were:
-%%
-%% feynmf.dtx (with options: `style,mp')
-%%
-%% Copyright (C) 1989, 1990, 1992-1995 by Thorsten.Ohl@Physik.TH-Darmstadt.de
-%%
-%% This file is NOT the source for feynmf, because almost all comments
-%% have been stripped from it. It is NOT the preferred form of feynmf
-%% for making modifications to it.
-%%
-%% Therefore you can NOT redistribute and/or modify THIS file. You can
-%% however redistribute the complete source (feynmf.dtx and feynmf.ins)
-%% 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.
-%%
-%% As a special exception, you can redistribute parts of this file for
-%% the electronic distribution of scientific papers, provided that you
-%% include a short note pointing to the complete source.
-%%
-%% Feynmf 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.
-%%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% \CheckSum{928}
-%% \CharacterTable
-%% {Upper-case \A\B\C\D\E\F\G\H\I\J\K\L\M\N\O\P\Q\R\S\T\U\V\W\X\Y\Z
-%% Lower-case \a\b\c\d\e\f\g\h\i\j\k\l\m\n\o\p\q\r\s\t\u\v\w\x\y\z
-%% Digits \0\1\2\3\4\5\6\7\8\9
-%% Exclamation \! Double quote \" Hash (number) \#
-%% Dollar \$ Percent \% Ampersand \&
-%% Acute accent \' Left paren \( Right paren \)
-%% Asterisk \* Plus \+ Comma \,
-%% Minus \- Point \. Solidus \/
-%% Colon \: Semicolon \; Less than \<
-%% Equals \= Greater than \> Question mark \?
-%% Commercial at \@ Left bracket \[ Backslash \\
-%% Right bracket \] Circumflex \^ Underscore \_
-%% Grave accent \` Left brace \{ Vertical bar \|
-%% Right brace \} Tilde \~}
-%%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\def\fileversion{v1.08}
-\NeedsTeXFormat{LaTeX2e}
-{\def\RCS#1#2\endRCS{%
- \ifx$#1%
- \@RCS $#2 \endRCS
- \else
- \@RCS $*: #1#2$ \endRCS
- \fi}%
- \def\@RCS $#1: #2,v #3 #4 #5 #6 #7$ \endRCS{%
- \gdef\filename{#2}%
- \gdef\filerevision{#3}%
- \gdef\filedate{#4}%
- \gdef\filemaintainer{#6}}%
-\RCS $Id: feynmf.dtx,v 1.32 1997/06/14 23:35:51 ohl Exp $ \endRCS}%
-\ProvidesPackage{feynmp}[\filedate\space\fileversion\space
- LaTeX/MetaPost Feynman Diagram Package (\filemaintainer)]
-\let\fmf@noexpandoff\relax
-\DeclareOption{pre-1.03}{%
- \PackageWarning{feynmf}{%
- Pre v1.03 compatibility can clash with font loading}
- \def\fmf@noexpandoff{\let\noexpand\relax}}
-\DeclareOption{errorstop}{\let\@interactionmode\errorstopmode}
-\DeclareOption{scroll}{\let\@interactionmode\scrollmode}
-\DeclareOption{nonstop}{\let\@interactionmode\nonstopmode}
-\DeclareOption{batch}{\let\@interactionmode\batchmode}
-\let\@interactionmode\errorstopmode
-\DeclareOption*{\PassOptionsToPackage{\CurrentOption}{graphics}}
-\ProcessOptions
-\RequirePackage{graphics}[1994/12/15]
-\let\mdqrestore\relax
-\@ifundefined{mdqoff}{}{%
- \mdqoff
- \let\mdqrestore\mdqon}
-\def\fmfcmd#1{%
- \if@fmfio
- \immediate\write\@outfmf{#1}%
- \fi
- \ignorespaces}
-\newif\if@fmfio
-\@fmfiotrue
-\newwrite\@outfmf
-\newtoks\fmfbuf@
-{\catcode`\%=11\gdef\p@rcent{%}}
-\edef\fmf@revision{\filerevision}
-\def\fmffile#1{%
- \def\thefmffile{#1}%
- \equaltojobname{\thefmffile}{%
- \errhelp={The argument of \fmffile MUST NOT be identical to the^^J%
- name of your main input file! I will use fmfdefault.mf^^J%
- this time around, but you'd better fix your code now!}%
- \errmessage{Invalid arument of \string\fmffile!}%
- \def\thefmffile{fmfdefault}}{}%
- \if@fmfio
- \@ifundefined{ifmeasuring@}%
- {}%
- {\def\if@fmfio{\ifmeasuring@\else}}%
- \immediate\openout\@outfmf=\thefmffile.mp\relax
- \fmfcmd{\p@rcent\space \thefmffile.mp -- do not edit, %
- generated automatically by \jobname.tex^^J%
- input feynmp^^J%
- require_RCS_revision "\fmf@revision";}%
- \fi
- \setcounter{fmfgraph}{0}}
-\let\thefmffile\relax
-\newcounter{fmfgraph}
-\def\equaltojobname#1#2#3{%
- \edef\@tempa{#1}%
- \edef\@tempa{\meaning\@tempa}%
- \edef\@tempb{\jobname}%
- \edef\@tempb{\meaning\@tempb}%
- \ifx\@tempa\@tempb
- #2
- \else
- #3
- \fi}
-\def\endfmffile{%
- \fmfcmd{\p@rcent\space the end.^^J%
- end.^^J%
- endinput;}%
- \let\thefmffile\relax
- \if@fmfio
- \immediate\closeout\@outfmf
- \fi}
-{\catcode`\#=11\gdef\sh@rp{#}%
- \catcode`\"=11\gdef\dqu@te{"}}
-\def\fmf@graph#1#2{%
- \ifx\thefmffile\relax
- \errhelp={Outside a fmffile environment, I have no clue as to where^^J%
- the METAFONT commands should go. I will use fmfdefault.mf^^J%
- for this graph, but you'd better fix your code!}%
- \errmessage{I detected a fmfgraph environment outside of fmffile}%
- \fmffile{fmfdefault}
- \fi
- \global\advance\c@fmfgraph\@ne
- \fmfcmd{beginchar(\thefmfgraph, #1*\the\unitlength\sh@rp, %
- #2*\the\unitlength\sh@rp, 0);^^J%
- \dqu@te feynmf: \thefmfgraph\dqu@te;}%
- \fmfcmd{LaTeX_unitlength:=\the\unitlength;}%
- \begin{fmfsubgraph}(0,0)(w,h)
- \fmfinit
- \fmfpen{thin}}
-\def\fmfgraph(#1,#2){%
- \fmf@graph{#1}{#2}%
- \def\fmfkeep##1{\fmf@keep{#1}{#2}{##1}}%
- \leavevmode
- \IfFileExists{\thefmffile.\thefmfgraph}%
- {\includegraphics{\thefmffile.\thefmfgraph}}%
- {\typeout{%
- feynmp: File \thefmffile.\thefmfgraph\space not found:^^J%
- feynmp: Process \thefmffile.mp with MetaPost and then %
- reprocess this file.}}%
- \ignorespaces}
-\def\endfmfgraph{%
- \fmffreeze
- \fmfdraw
- \end{fmfsubgraph}
- \fmfcmd{endchar;}%
- \def\fmfkeep##1{\fmf@nokeep}}
-\def\fmfchar{\@nameuse{fmfgraph}}
-\def\endfmfchar{\@nameuse{endfmfgraph}}
-\@namedef{fmfgraph*}(#1,#2){%
- \begin{picture}(#1,#2)
- \fmf@graph{#1}{#2}%
- \def\fmfkeep##1{\fmf@keepstar{#1}{#2}{##1}}%
- \IfFileExists{\thefmffile.\thefmfgraph}%
- {\put(0,0){\includegraphics{\thefmffile.\thefmfgraph}}}%
- {\typeout{%
- feynmp: File \thefmffile.\thefmfgraph\space not found:^^J%
- feynmp: Process \thefmffile.mp with MetaPost and then %
- reprocess this file.}}%
- \ignorespaces}
-\@namedef{endfmfgraph*}{%
- \endfmfgraph
- \if@fmfio
- {\catcode`\%=14\relax
- \fmf@noexpandoff
- \InputIfFileExists{\thefmffile.t\thefmfgraph}{}{%
- \typeout{%
- feynmf: Label file \thefmffile.t\thefmfgraph\space not found:^^J%
- feynmf: Process \thefmffile.mp with MetaPost and then %
- reprocess this file.}}}%
- \fi
- \end{picture}}
-\@namedef{fmfchar*}{\@nameuse{fmfgraph*}}
-\@namedef{endfmfchar*}{\@nameuse{endfmfgraph*}}
-\def\fmfkeep#1{\fmf@nokeep}
-\def\fmf@nokeep{%
- \errhelp={There's nothing to \string\fmfkeep!}%
- \errmessage{feynmf: \string\fmfkeep\space outside of `fmfgraph'!}}
-\def\fmf@keep#1#2#3{%
- \global\@namedef{fmf@k:e:#3}{\begin{fmfgraph}(#1,#2)\end{fmfgraph}}%
- \global\e@namedef{fmf@k:f:#3}{\thefmffile}%
- \global\e@namedef{fmf@k:c:#3}{\thefmfgraph}}
-\def\fmf@keepstar#1#2#3{%
- \global\@namedef{fmf@k:e:#3}{\begin{fmfgraph*}(#1,#2)\end{fmfgraph*}}%
- \global\e@namedef{fmf@k:f:#3}{\thefmffile}%
- \global\e@namedef{fmf@k:c:#3}{\thefmfgraph}}
-\def\e@namedef#1{\expandafter\edef\csname #1\endcsname}
-\def\fmfreuse#1{%
- \@ifundefined{fmf@k:e:#1}%
- {\typeout{%
- feynmf: \string\fmfreuse: %
- missing \string\fmfkeep\space for `#1'!}}%
- {{\edef\thefmffile{\@nameuse{fmf@k:f:#1}}%
- \edef\@@@c@fmfgraph{\thefmfgraph}%
- \setcounter{fmfgraph}{\@nameuse{fmf@k:c:#1}}%
- \advance\c@fmfgraph-1%
- \def\fmfcmd##1{\ignorespaces}%
- \@nameuse{fmf@k:e:#1}%
- \setcounter{fmfgraph}{\@@@c@fmfgraph}}}}
-\def\fmfframe(#1,#2)(#3,#4)#5{%
- \leavevmode
- \hbox{\vbox{\vskip#2\unitlength\par
- \hbox{\hskip#1\unitlength#5\hskip#3\unitlength}\par
- \vskip#4\unitlength}}}
-\def\fmfpen#1{\fmfcmd{pickup pencircle scaled #1;}}
-\def\fmfsubgraph(#1,#2)(#3,#4){\fmfcmd{subgraph (#1, #2, #3, #4);}}
-\def\endfmfsubgraph{\fmfcmd{endsubgraph;}}
-\def\Compose#1#2#3{#1{#2{#3}}}
-\def\gobblefalse\else\gobbletrue\fi#1#2{\fi#1}
-\def\gobbletrue\fi#1#2{\fi#2}
-\def\TeXif#1{#1\gobblefalse\else\gobbletrue\fi}
-\def\Nil#1#2{#2}
-\def\Cons#1#2#3#4{#3{#1}{#2}}
-\def\Singleton#1{\Cons{#1}\Nil}
-\def\Foldr#1#2#3{#3{\Foldr@{#1}{#2}}{#2}}
-\def\Foldr@#1#2#3#4{#1{#3}{\Foldr{#1}{#2}{#4}}}
-\def\Map#1{\Foldr{\Compose\Cons{#1}}\Nil}
-\def\Unlistize#1{#1\Unlistize@{}}
-\def\Unlistize@#1{#1\Foldr\Commaize{}}
-\def\Commaize#1#2{, #1#2}
-\def\Listize#1{\Listize@#1,\relax @@@}
-\def\Listize@#1,#2@@@{%
- \TeXif{\ifx\relax#2}%
- {\Singleton{#1}}%
- {\Cons{#1}{\Listize@#2@@@}}}
-\def\fmfpfx@#1{__#1}
-\def\fmfpfx#1{\Unlistize{\Map\fmfpfx@{\Listize{#1}}}}
-\def\fmfwizard{\fmfcmd{feynmfwizard := true;}}
-\def\fmfnowizard{\fmfcmd{feynmfwizard := false;}}
-\def\fmfshrink#1{\fmfcmd{shrink (#1);}}
-\def\endfmfshrink{\fmfcmd{endshrink;}}
-\def\fmfinit{\fmfcmd{vinit;}}
-\def\fmf#1#2{%
- \fmfbuf@={#1}%
- \fmfcmd{vconnect ("\the\fmfbuf@", \fmfpfx{#2});}}
-\def\fmfn#1#2#3{
- \fmfbuf@={#1}%
- \fmfcmd{vconnectn ("\the\fmfbuf@", \fmfpfx{#2}, #3);}}
-\def\fmfcyclen#1#2#3{%
- \fmfbuf@={#1}%
- \fmfcmd{vcyclen ("\the\fmfbuf@", \fmfpfx{#2}, #3);}}
-\def\fmfrcyclen#1#2#3{%
- \fmfbuf@={#1}%
- \fmfcmd{vrcyclen ("\the\fmfbuf@", \fmfpfx{#2}, #3);}}
-\def\fmfforce#1#2{\fmfcmd{vforce ((#1), \fmfpfx{#2});}}
-\def\fmfshift#1#2{\fmfcmd{vshift ((#1), \fmfpfx{#2});}}
-\def\fmffixed#1#2{\fmfcmd{vconstraint ((#1), \fmfpfx{#2});}}
-\def\fmffixedx#1#2{\fmfcmd{vconstraint (((#1),whatever), \fmfpfx{#2});}}
-\def\fmffixedy#1#2{\fmfcmd{vconstraint ((whatever,(#1)), \fmfpfx{#2});}}
-\def\fmfpoly#1#2{%
- \fmfbuf@={#1}%
- \fmfcmd{vpolygon ("\the\fmfbuf@", \fmfpfx{#2});}}
-\def\fmfpolyn#1#2#3{%
- \fmfbuf@={#1}%
- \fmfcmd{vpolygonn ("\the\fmfbuf@", \fmfpfx{#2}, #3);}}
-\def\fmfrpolyn#1#2#3{%
- \fmfbuf@={#1}%
- \fmfcmd{vrpolygonn ("\the\fmfbuf@", \fmfpfx{#2}, #3);}}
-\def\fmflabel#1#2{%
- \fmfbuf@={#1}%
- \fmfcmd{vlabel ("\the\fmfbuf@", \fmfpfx{#2});}}
-\def\fmfv#1#2{%
- \fmfbuf@={#1}%
- \fmfcmd{vvertex ("\the\fmfbuf@", \fmfpfx{#2});}}
-\def\fmfvn#1#2#3{%
- \fmfbuf@={#1}%
- \fmfcmd{vvertexn ("\the\fmfbuf@", \fmfpfx{#2}, #3);}}
-\def\fmfblob#1#2{\fmfcmd{vblob ((#1), \fmfpfx{#2});}}
-\def\fmfdot#1{\fmfcmd{vdot (\fmfpfx{#1});}}
-\def\fmfblobn#1#2{\fmfcmd{vblobn (\fmfpfx{#1}, #2);}}
-\def\fmfdotn#1#2{\fmfcmd{vdotn (\fmfpfx{#1}, #2);}}
-\def\fmfleft#1{\fmfcmd{vleft (\fmfpfx{#1});}}
-\def\fmfright#1{\fmfcmd{vright (\fmfpfx{#1});}}
-\def\fmfbottom#1{\fmfcmd{vbottom (\fmfpfx{#1});}}
-\def\fmftop#1{\fmfcmd{vtop (\fmfpfx{#1});}}
-\let\fmfincoming\fmfleft
-\let\fmfoutgoing\fmfright
-\def\fmfsurround#1{\fmfcmd{vsurround (\fmfpfx{#1});}}
-\def\fmfcurved{\fmfcmd{curved_galleries;}}
-\def\fmfstraight{\fmfcmd{straight_galleries;}}
-\let\fmfcurvedgalleries\fmfcurved
-\let\fmfstraightgalleries\fmfstraight
-\def\fmfleftn#1#2{\fmfcmd{vleftn (\fmfpfx{#1}, #2);}}
-\def\fmfrightn#1#2{\fmfcmd{vrightn (\fmfpfx{#1}, #2);}}
-\def\fmfbottomn#1#2{\fmfcmd{vbottomn (\fmfpfx{#1}, #2);}}
-\def\fmftopn#1#2{\fmfcmd{vtopn (\fmfpfx{#1}, #2);}}
-\let\fmfincomingn\fmfleftn
-\let\fmfoutgoingn\fmfrightn
-\def\fmfsurroundn#1#2{\fmfcmd{vsurroundn (\fmfpfx{#1}, #2);}}
-\def\fmffor#1#2#3#4{\fmfcmd{for #1 = #2 step #3 until #4:}}
-\def\endfmffor{\fmfcmd{endfor}}
-\def\fmfgroup{\fmfcmd{begingroup}}
-\def\endfmfgroup{\fmfcmd{endgroup;}}
-\def\fmfset#1#2{\fmfcmd{save #1; #1:=#2;}}
-\def\fmffreeze{\fmfcmd{vfreeze;}}
-\let\fmfposition\fmffreeze
-\def\fmfi#1#2{%
- \fmfbuf@={#1}%
- \fmfcmd{idraw ("\the\fmfbuf@", #2);}}
-\def\fmfiv#1#2{%
- \fmfbuf@={#1}%
- \fmfcmd{ivertex ("\the\fmfbuf@", #2);}}
-\def\fmfipath#1{\fmfcmd{path #1;}}
-\def\fmfipair#1{\fmfcmd{pair #1;}}
-\def\fmfiset#1#2{\fmfcmd{#1:=#2;}}
-\def\fmfiequ#1#2{\fmfcmd{#1=#2;}}
-\def\fmfdraw{\fmfcmd{vdraw;}}
-\def\fmfL(#1,#2,#3)#4{\put(#1,#2){\makebox(0,0)[#3]{#4}}}
-\def\fmfdisplay{\fmfcmd{show_all_diagrams (100,100);}}
-\def\fmfstopdisplay{\fmfcmd{showstopping:=1;}\fmfdisplay}
-\def\fmftrace{\fmfcmd{vtracing:=true;}}
-\def\fmfnotrace{\fmfcmd{vtracing:=false;}}
-\mdqrestore
-\endinput
-%%
-%% End of file `feynmp.sty'.
Index: branches/ohl/omega-development/hgg-vertex/share/doc/thophys.sty
===================================================================
--- branches/ohl/omega-development/hgg-vertex/share/doc/thophys.sty (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/share/doc/thophys.sty (revision 8717)
@@ -1,153 +0,0 @@
-%%
-%% This is file `thophys.sty',
-%% generated with the docstrip utility.
-%%
-%% The original source files were:
-%%
-%% thophys.dtx (with options: `package')
-%%
-%% Copyright (C) 1994 by Thorsten.Ohl@Physik.TH-Darmstadt.de
-%%
-%% This file is NOT the source for thophys, because almost all comments
-%% have been stripped from it. It is NOT the preferred form of thophys
-%% for making modifications to it.
-%%
-%% Therefore you can NOT redistribute and/or modify THIS file. You can
-%% however redistribute the complete source (thophys.dtx and thophys.ins)
-%% 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.
-%%
-%% Thophys 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.
-%%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% \CheckSum{268}
-%% \CharacterTable
-%% {Upper-case \A\B\C\D\E\F\G\H\I\J\K\L\M\N\O\P\Q\R\S\T\U\V\W\X\Y\Z
-%% Lower-case \a\b\c\d\e\f\g\h\i\j\k\l\m\n\o\p\q\r\s\t\u\v\w\x\y\z
-%% Digits \0\1\2\3\4\5\6\7\8\9
-%% Exclamation \! Double quote \" Hash (number) \#
-%% Dollar \$ Percent \% Ampersand \&
-%% Acute accent \' Left paren \( Right paren \)
-%% Asterisk \* Plus \+ Comma \,
-%% Minus \- Point \. Solidus \/
-%% Colon \: Semicolon \; Less than \<
-%% Equals \= Greater than \> Question mark \?
-%% Commercial at \@ Left bracket \[ Backslash \\
-%% Right bracket \] Circumflex \^ Underscore \_
-%% Grave accent \` Left brace \{ Vertical bar \|
-%% Right brace \} Tilde \~}
-%%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\NeedsTeXFormat{LaTeX2e}
-{\def\RCS#1#2\endRCS{%
- \ifx$#1%
- \@RCS $#2 \endRCS
- \else
- \@RCS $*: #1#2$ \endRCS
- \fi}%
- \def\@RCS $#1: #2,v #3 #4 #5 #6$ \endRCS{%
- \gdef\filename{#2}%
- \gdef\fileversion{v#3}%
- \gdef\filedate{#4}%
- \gdef\docdate{#4}}%
-\RCS $Id: thophys.dtx,v 1.12 1995/01/07 14:58:13 ohl Exp $ \endRCS}%
-\ProvidesPackage{thophys}[\filedate\space Physics Support for LaTeX]
-\typeout{Package: `thophys'
- \fileversion\space <\filedate> (tho) PRELIMINARY TEST RELEASE}
-\wlog{English documentation \@spaces<\docdate> (tho)}
-\ProcessOptions
-\def\bra#1{\mathinner{\langle\mathcode`\|"8000{#1|}}}
-\def\Bra#1{\left\langle\mathcode`\|"8000 {#1|}\right.}
-\def\ket#1{\mathinner{\mathcode`\|"8000{|#1}\rangle}}
-\def\Ket#1{\left.\mathcode`\|"8000 {|#1}\right\rangle}
-\def\braket#1{\mathinner{\langle{#1}\rangle}}
-\def\Braket#1{\left\langle \mathcode`\|"8000 {#1}\right\rangle}
-{\catcode`\|=\active \gdef|{\egroup\,\vrule\,\bgroup}}
-\newcommand{\vev}[1]{\braket{0|#1|0}}
-\newcommand{\Vev}[1]{\Braket{0|#1|0}}
-\newcommand{\Tprod}[1]{\mathop{\rm T}\left[#1\right]}
-\newcommand{\tprod}[1]{\mathop{\rm T}[#1]}
-\newcommand{\greensfunc}[1]{\vev{\tprod{#1}}}
-\newcommand{\Greensfunc}[1]{\Vev{\Tprod{#1}}}
-\newcommand{\f@rcerm}[1]{%
- \ifmmode
- \mathop{{\rm#1}}\nolimits
- \else
- \textrm{#1}%
- \fi}
-\let\th@unit\f@rcerm
-\newcommand{\declareunit}[1]{%
- \expandafter\newcommand\csname#1\endcsname{\th@unit{#1}}}
-\newcommand{\declareunits}[1]{%
- \@for\@@@unit:=#1\do{%
- \expandafter\declareunit\expandafter{\@@@unit}}}
-\newcommand{\redeclareunit}[1]{%
- \expandafter\renewcommand\csname#1\endcsname{\th@unit{#1}}}
-\newcommand{\redeclareunits}[1]{%
- \@for\@@@unit:=#1\do{%
- \expandafter\redeclareunit\expandafter{\@@@unit}}}
-\newcommand{\th@group}[2]{\f@rcerm{#1}(#2)}
-\newcommand{\declaregroup}[1]{%
- \expandafter\newcommand\csname#1\endcsname[1]{\th@group{#1}{##1}}}
-\newcommand{\declaregroups}[1]{%
- \@for\@@@group:=#1\do{%
- \expandafter\declaregroup\expandafter{\@@@group}}}
-\newcommand{\redeclaregroup}[1]{%
- \expandafter\renewcommand\csname#1\endcsname[1]{\th@group{#1}{##1}}}
-\newcommand{\redeclaregroups}[1]{%
- \@for\@@@group:=#1\do{%
- \expandafter\redeclaregroup\expandafter{\@@@group}}}
-\newcommand{\contraction}[5][1ex]{%
- \mathchoice
- {\contraction@\displaystyle{#2}{#3}{#4}{#5}{#1}}%
- {\contraction@\textstyle{#2}{#3}{#4}{#5}{#1}}%
- {\contraction@\scriptstyle{#2}{#3}{#4}{#5}{#1}}%
- {\contraction@\scriptscriptstyle{#2}{#3}{#4}{#5}{#1}}}%
-\newcommand{\contraction@}[6]{%
- \setbox0=\hbox{$#1#2$}%
- \setbox2=\hbox{$#1#3$}%
- \setbox4=\hbox{$#1#4$}%
- \setbox6=\hbox{$#1#5$}%
- \dimen0=\wd2%
- \advance\dimen0 by \wd6%
- \divide\dimen0 by 2%
- \advance\dimen0 by \wd4%
- \vbox{%
- \hbox to 0pt{%
- \kern \wd0%
- \kern 0.5\wd2%
- \contraction@@{\dimen0}{#6}%
- \hss}%
- \vskip 0.2ex%
- \vskip\ht2}}
-\newcommand{\contracted}[5][1ex]{%
- \contraction[#1]{#2}{#3}{#4}{#5}\ensuremath{#2#3#4#5}}
-\newcommand{\contraction@@}[3][0.06em]{%
- \hbox{%
- \vrule width #1 height 0pt depth #3%
- \vrule width #2 height 0pt depth #1%
- \vrule width #1 height 0pt depth #3%
- \relax}}
-\newcommand{\fmslash}[2][0mu]{%
- \mathchoice
- {\fmsl@sh\displaystyle{#1}{#2}}%
- {\fmsl@sh\textstyle{#1}{#2}}%
- {\fmsl@sh\scriptstyle{#1}{#2}}%
- {\fmsl@sh\scriptscriptstyle{#1}{#2}}}
-\newcommand{\fmsl@sh}[3]{%
- \m@th\ooalign{$\hfil#1\mkern#2/\hfil$\crcr$#1#3$}}
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\endinput
-%%
-%% End of file `thophys.sty'.
Index: branches/ohl/omega-development/hgg-vertex/share/doc/flex.cls
===================================================================
--- branches/ohl/omega-development/hgg-vertex/share/doc/flex.cls (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/share/doc/flex.cls (revision 8717)
@@ -1,839 +0,0 @@
-%%
-%% This is file `flex.cls',
-%% generated with the docstrip utility.
-%%
-%% The original source files were:
-%%
-%% flex.dtx (with options: `class')
-%%
-%% Copyright (C) 1997 by Thorsten.Ohl@Physik.TH-Darmstadt.de
-%%
-%% This file is NOT the source for flex, because almost all comments
-%% have been stripped from it. It is NOT the preferred form of flex
-%% for making modifications to it.
-%%
-%% Therefore you can NOT redistribute and/or modify THIS file. You can
-%% however redistribute the complete source (flex.dtx and flex.ins)
-%% 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.
-%%
-%% As a special exception, you can redistribute parts of this file for
-%% the electronic distribution of scientific papers, provided that you
-%% include a short note pointing to the complete source.
-%%
-%% Flex 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.
-%%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% \CheckSum{1603}
-%% \CharacterTable
-%% {Upper-case \A\B\C\D\E\F\G\H\I\J\K\L\M\N\O\P\Q\R\S\T\U\V\W\X\Y\Z
-%% Lower-case \a\b\c\d\e\f\g\h\i\j\k\l\m\n\o\p\q\r\s\t\u\v\w\x\y\z
-%% Digits \0\1\2\3\4\5\6\7\8\9
-%% Exclamation \! Double quote \" Hash (number) \#
-%% Dollar \$ Percent \% Ampersand \&
-%% Acute accent \' Left paren \( Right paren \)
-%% Asterisk \* Plus \+ Comma \,
-%% Minus \- Point \. Solidus \/
-%% Colon \: Semicolon \; Less than \<
-%% Equals \= Greater than \> Question mark \?
-%% Commercial at \@ Left bracket \[ Backslash \\
-%% Right bracket \] Circumflex \^ Underscore \_
-%% Grave accent \` Left brace \{ Vertical bar \|
-%% Right brace \} Tilde \~}
-%%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\def\fileversion{v0.00}
-\NeedsTeXFormat{LaTeX2e}[1995/12/01]
-{\def\RCS#1#2\endRCS{%
- \ifx$#1%
- \@RCS $#2 \endRCS
- \else
- \@RCS $*: #1#2$ \endRCS
- \fi}%
- \def\@RCS $#1: #2,v #3 #4 #5 #6 #7$ \endRCS{%
- \gdef\filename{#2}%
- \gdef\filerevision{#3}%
- \gdef\filedate{#4}%
- \gdef\filemaintainer{#6}}%
-\RCS $Id: flex.dtx,v 1.2 1997/06/22 17:50:51 ohl Exp $ \endRCS}%
-\ProvidesPackage{flex}[\filedate\space\fileversion\space
- FLEXible Document Class for LaTeX2e (\filemaintainer)]
-\newcommand\@ptsize{}
-\newif\if@restonecol
-\newif\if@titlepage
-\@titlepagetrue
-\newif\if@openright
-\DeclareOption{a4paper}
- {\setlength{\paperheight}{297mm}\setlength{\paperwidth}{210mm}}
-\DeclareOption{a5paper}
- {\setlength{\paperheight}{210mm}\setlength{\paperwidth}{148mm}}
-\DeclareOption{b5paper}
- {\setlength{\paperheight}{250mm}\setlength{\paperwidth}{176mm}}
-\DeclareOption{letterpaper}
- {\setlength{\paperheight}{11in}\setlength{\paperwidth}{8.5in}}
-\DeclareOption{legalpaper}
- {\setlength{\paperheight}{14in}\setlength{\paperwidth}{8.5in}}
-\DeclareOption{executivepaper}
- {\setlength{\paperheight}{10.5in}\setlength{\paperwidth}{7.25in}}
-\DeclareOption{landscape}
- {\setlength{\@tempdima}{\paperheight}%
- \setlength{\paperheight}{\paperwidth}%
- \setlength{\paperwidth}{\@tempdima}}
-\DeclareOption{10pt}{\renewcommand{\@ptsize}{0}}
-\DeclareOption{11pt}{\renewcommand{\@ptsize}{1}}
-\DeclareOption{12pt}{\renewcommand{\@ptsize}{2}}
-\DeclareOption{oneside}{\@twosidefalse\@mparswitchfalse}
-\DeclareOption{twoside}{\@twosidetrue\@mparswitchtrue}
-\DeclareOption{draft}{\setlength{\overfullrule}{5pt}}
-\DeclareOption{final}{\setlength{\overfullrule}{0pt}}
-\DeclareOption{titlepage}{\@titlepagetrue}
-\DeclareOption{notitlepage}{\@titlepagefalse}
-\DeclareOption{openright}{\@openrighttrue}
-\DeclareOption{openany}{\@openrightfalse}
-\DeclareOption{onecolumn}{\@twocolumnfalse}
-\DeclareOption{twocolumn}{\@twocolumntrue}
-\DeclareOption{leqno}{\input{leqno.clo}}
-\DeclareOption{fleqn}{\input{fleqn.clo}}
-\DeclareOption{openbib}{%
- \AtEndOfPackage{%
- \renewcommand{\@openbib@code}{%
- \advance\leftmargin\bibindent
- \itemindent -\bibindent
- \listparindent \itemindent
- \parsep\z@}%
- \renewcommand{\newblock}{\par}}}
-\DeclareOption{chapters}{\@flx@chapterstrue}
-\DeclareOption{nochapters}{\@flx@chaptersfalse}
-\newif\if@flx@chapters
-\@flx@chaptersfalse
-\ExecuteOptions{letterpaper,10pt,oneside,onecolumn,final,openany}
-\ProcessOptions
-\input{size1\@ptsize.clo}
-\setlength{\lineskip}{1\p@}
-\setlength{\normallineskip}{1\p@}
-\renewcommand{\baselinestretch}{}
-\setlength{\parskip}{0\p@\@plus\p@}
-\@lowpenalty=51
-\@medpenalty=151
-\@highpenalty=301
-\setcounter{topnumber}{2}
-\renewcommand{\topfraction}{.7}
-\setcounter{bottomnumber}{1}
-\renewcommand{\bottomfraction}{.3}
-\setcounter{totalnumber}{3}
-\renewcommand{\textfraction}{.2}
-\renewcommand{\floatpagefraction}{.5}
-\setcounter{dbltopnumber}{2}
-\renewcommand{\dbltopfraction}{.7}
-\renewcommand{\dblfloatpagefraction}{.5}
-\if@twoside
- \def\ps@headings{%
- \let\@oddfoot\@empty
- \let\@evenfoot\@empty
- \def\@evenhead{\thepage\hfil\slshape\leftmark}%
- \def\@oddhead{{\slshape\rightmark}\hfil\thepage}%
- \let\@mkboth\markboth
- \def\chaptermark##1{%
- \markboth{\MakeUppercase{%
- \ifnum\c@secnumdepth>\m@ne
- \@chapapp\ \thechapter. \ %
- \fi
- ##1}}{}}%
- \def\sectionmark##1{%
- \markright{\MakeUppercase{%
- \ifnum\c@secnumdepth>\z@
- \thesection. \ %
- \fi
- ##1}}}}
-\else
- \def\ps@headings{%
- \let\@oddfoot\@empty
- \def\@oddhead{{\slshape\rightmark}\hfil\thepage}%
- \let\@mkboth\markboth
- \def\chaptermark##1{%
- \markright{\MakeUppercase{%
- \ifnum\c@secnumdepth>\m@ne
- \@chapapp\ \thechapter. \ %
- \fi
- ##1}}}}
-\fi
-\def\ps@myheadings{%
- \let\@oddfoot\@empty
- \let\@evenfoot\@empty
- \def\@evenhead{\thepage\hfil\slshape\leftmark}%
- \def\@oddhead{{\slshape\rightmark}\hfil\thepage}%
- \let\@mkboth\@gobbletwo
- \let\chaptermark\@gobble
- \let\sectionmark\@gobble}
-\if@titlepage
- \newcommand{\maketitle}{%
- \begin{titlepage}%
- \let\footnotesize\small
- \let\footnoterule\relax
- \let\footnote\thanks
- \null\vfil
- \vskip 60\p@
- \begin{center}%
- {\LARGE \@title \par}%
- \vskip 3em%
- {\large
- \lineskip .75em%
- \begin{tabular}[t]{c}%
- \@author
- \end{tabular}\par}%
- \vskip 1.5em%
- {\large \@date \par}%
- \end{center}\par
- \@thanks
- \vfil\null
- \end{titlepage}%
- \setcounter{footnote}{0}%
- \global\let\thanks\relax
- \global\let\maketitle\relax
- \global\let\@thanks\@empty
- \global\let\@author\@empty
- \global\let\@date\@empty
- \global\let\@title\@empty
- \global\let\title\relax
- \global\let\author\relax
- \global\let\date\relax
- \global\let\and\relax}
-\else
- \newcommand{\maketitle}{\par
- \begingroup
- \renewcommand{\thefootnote}{\@fnsymbol\c@footnote}%
- \def\@makefnmark{\rlap{\@textsuperscript{\normalfont\@thefnmark}}}%
- \long\def\@makefntext##1{%
- \parindent 1em\noindent
- \hb@xt@1.8em{\hss\@textsuperscript{\normalfont\@thefnmark}}##1}%
- \if@twocolumn
- \ifnum\col@number=\@ne
- \@maketitle
- \else
- \twocolumn[\@maketitle]%
- \fi
- \else
- \newpage
- \global\@topnum\z@ % Prevents figures from going at top of page.
- \@maketitle
- \fi
- \thispagestyle{plain}\@thanks
- \endgroup
- \setcounter{footnote}{0}%
- \global\let\thanks\relax
- \global\let\maketitle\relax
- \global\let\@maketitle\relax
- \global\let\@thanks\@empty
- \global\let\@author\@empty
- \global\let\@date\@empty
- \global\let\@title\@empty
- \global\let\title\relax
- \global\let\author\relax
- \global\let\date\relax
- \global\let\and\relax}
- \def\@maketitle{%
- \newpage
- \null
- \vskip 2em%
- \begin{center}%
- \let\footnote\thanks
- {\LARGE \@title \par}%
- \vskip 1.5em%
- {\large
- \lineskip .5em%
- \begin{tabular}[t]{c}%
- \@author
- \end{tabular}\par}%
- \vskip 1em%
- {\large \@date}%
- \end{center}%
- \par
- \vskip 1.5em}
-\fi
-\newcommand{\flxDefFont}[2]{\@namedef{flx:font:#1}{#2}}
-\newcommand{\flxFont}[1]{\@nameuse{flx:font:#1}}
-\newcommand{\flxDefSize}[2]{\@namedef{flx:Size:#1}{#2}}
-\newcommand{\flxSize}[1]{\@nameuse{flx:Size:#1}}
-\newcommand{\flxDefAlign}[2]{\@namedef{flx:align:#1}{#2}}
-\newcommand{\flxAlign}[1]{\@nameuse{flx:align:#1}}
-\newcommand{\flxDefFontAll}[1]{%
- \flxDefFont{part}{#1}%
- \flxDefFont{chapter}{#1}%
- \flxDefFont{section}{#1}%
- \flxDefFont{subsection}{#1}%
- \flxDefFont{subsubsection}{#1}%
- \flxDefFont{paragraph}{#1}%
- \flxDefFont{subparagraph}{#1}}
-\newcommand{\flxDefSizeAll}[1]{%
- \flxDefSize{part}{#1}%
- \flxDefSize{chapter}{#1}%
- \flxDefSize{section}{#1}%
- \flxDefSize{subsection}{#1}%
- \flxDefSize{subsubsection}{#1}%
- \flxDefSize{paragraph}{#1}%
- \flxDefSize{subparagraph}{#1}}
-\newcommand{\flxDefAlignAll}[1]{%
- \flxDefAlign{part}{#1}%
- \flxDefAlign{chapter}{#1}%
- \flxDefAlign{section}{#1}%
- \flxDefAlign{subsection}{#1}%
- \flxDefAlign{subsubsection}{#1}%
- \flxDefAlign{paragraph}{#1}%
- \flxDefAlign{subparagraph}{#1}}
-\newcommand{\flxDefNumber}[2]{\@namedef{flx:num:#1}{#2}}
-\newcommand{\flxNumber}[1]{\@nameuse{flx:num:#1}}
-\def\flxChapter{\@chapapp}
-\newcommand{\flx@startsection}[5]{%
- \@startsection{#1}{#2}{#3}{#4}{#5}%
- {\normalfont\flxSize{#1}\flxFont{#1}\flxAlign{#1}}}
-\newcommand*{\chaptermark}[1]{}
-\setcounter{secnumdepth}{2}
-\newcounter{part}
-\renewcommand{\thepart}{\@Roman\c@part}
-\newcommand{\part}{%
- \if@openright
- \cleardoublepage
- \else
- \clearpage
- \fi
- \thispagestyle{plain}%
- \if@twocolumn
- \onecolumn
- \@tempswatrue
- \else
- \@tempswafalse
- \fi
- \null\vfil
- \secdef\@part\@spart}
-\def\@part[#1]#2{%
- \ifnum\c@secnumdepth>-2\relax
- \refstepcounter{part}%
- \addcontentsline{toc}{part}{\thepart\hspace{1em}#1}%
- \else
- \addcontentsline{toc}{part}{#1}%
- \fi
- \markboth{}{}%
- {\interlinepenalty\@M
- \normalfont\flxSize{chapter}\flxFont{chapter}\flxAlign{chapter}%
- \ifnum\c@secnumdepth>-2\relax
- {\flxNumber{part}}%
- \fi
- #2\par}%
- \@endpart}
-\def\@spart#1{%
- {\interlinepenalty\@M
- \normalfont\flxSize{chapter}\flxFont{chapter}\flxAlign{chapter}%
- #1\par}%
- \@endpart}
-\def\@endpart{%
- \vfil\newpage
- \if@twoside
- \null
- \thispagestyle{empty}%
- \newpage
- \fi
- \if@tempswa
- \twocolumn
- \fi}
-\newcommand*{\l@part}[2]{%
- \ifnum\c@tocdepth >-2\relax
- \addpenalty{-\@highpenalty}%
- \addvspace{2.25em \@plus\p@}%
- \begingroup
- \setlength{\@tempdima}{3em}%
- \parindent\z@
- \rightskip\@pnumwidth
- \parfillskip-\@pnumwidth
- {\leavevmode
- \large\flxFont{part}%
- #1\hfil\hb@xt@\@pnumwidth{\hss #2}}\par
- \nobreak
- \global\@nobreaktrue
- \everypar{\global\@nobreakfalse\everypar{}}%
- \endgroup
- \fi}
-\if@flx@chapters
- \newcommand{\@chapapp}{\chaptername}
- \newcounter{chapter}
- \renewcommand{\thechapter}{\@arabic\c@chapter}
- \newcommand{\chapter}{%
- \if@openright
- \cleardoublepage
- \else
- \clearpage
- \fi
- \thispagestyle{plain}%
- \global\@topnum\z@
- \@afterindentfalse
- \secdef\@chapter\@schapter}
- \def\@chapter[#1]#2{%
- \ifnum\c@secnumdepth>\m@ne
- \refstepcounter{chapter}%
- \typeout{\@chapapp\space\thechapter.}%
- \addcontentsline{toc}{chapter}{\protect\numberline{\thechapter}#1}%
- \else
- \addcontentsline{toc}{chapter}{#1}%
- \fi
- \chaptermark{#1}%
- \addtocontents{lof}{\protect\addvspace{10\p@}}%
- \addtocontents{lot}{\protect\addvspace{10\p@}}%
- \if@twocolumn
- \@topnewpage[\@makechapterhead{#2}]%
- \else
- \@makechapterhead{#2}%
- \@afterheading
- \fi}
- \def\@makechapterhead#1{%
- \vspace*{50\p@}%
- {\parindent\z@
- \normalfont\flxSize{chapter}\flxFont{chapter}\flxAlign{chapter}%
- \ifnum\c@secnumdepth>\m@ne
- {\flxNumber{chapter}}%
- \fi
- \interlinepenalty\@M
- #1\par\nobreak
- \vskip 40\p@}}
- \def\@schapter#1{%
- \if@twocolumn
- \@topnewpage[\@makeschapterhead{#1}]%
- \else
- \@makeschapterhead{#1}%
- \@afterheading
- \fi}
- \def\@makeschapterhead#1{%
- \vspace*{50\p@}%
- {\parindent\z@
- \interlinepenalty\@M
- \normalfont\flxSize{chapter}\flxFont{chapter}\flxAlign{chapter}%
- #1\par\nobreak
- \vskip 40\p@}}
- \newcommand*\l@chapter[2]{%
- \ifnum \c@tocdepth >\m@ne
- \addpenalty{-\@highpenalty}%
- \vskip 1.0em \@plus\p@
- \setlength\@tempdima{1.5em}%
- \begingroup
- \parindent \z@ \rightskip \@pnumwidth
- \parfillskip -\@pnumwidth
- \leavevmode
- \flxFont{chapter}%
- \advance\leftskip\@tempdima
- \hskip -\leftskip
- #1\nobreak\hfil \nobreak\hb@xt@\@pnumwidth{\hss #2}\par
- \penalty\@highpenalty
- \endgroup
- \fi}
-\fi
-\if@flx@chapters
- \newcounter{section}[chapter]
- \renewcommand{\thesection}{\thechapter.\@arabic\c@section}
-\else
- \newcounter{section}
- \renewcommand{\thesection}{\@arabic\c@section}
-\fi
-\newcommand{\section}{%
- \flx@startsection{section}{1}%
- {\z@}%
- {-3.5ex \@plus -1ex \@minus -.2ex}%
- {2.3ex \@plus .2ex}}
-\newcommand*{\l@section}{%
- \flxFont{section}\@dottedtocline{1}{1.5em}{2.3em}}
-\newcounter{subsection}[section]
-\renewcommand{\thesubsection}{\thesection.\@arabic\c@subsection}
-\newcommand{\subsection}{%
- \flx@startsection{subsection}{2}%
- {\z@}%
- {-3.25ex\@plus -1ex \@minus -.2ex}%
- {1.5ex \@plus .2ex}}
-\newcommand*{\l@subsection}{%
- \flxFont{subsection}\@dottedtocline{2}{3.8em}{3.2em}}
-\newcounter{subsubsection}[subsection]
-\renewcommand{\thesubsubsection}{\thesubsection .\@arabic\c@subsubsection}
-\newcommand{\subsubsection}{%
- \flx@startsection{subsubsection}{3}%
- {\z@}%
- {-3.25ex\@plus -1ex \@minus -.2ex}%
- {1.5ex \@plus .2ex}}
-\newcommand*{\l@subsubsection}{%
- \flxFont{subsubsection}\@dottedtocline{3}{7.0em}{4.1em}}
-\newcounter{paragraph}[subsubsection]
-\renewcommand{\theparagraph}{\thesubsubsection.\@arabic\c@paragraph}
-\newcommand{\paragraph}{%
- \flx@startsection{paragraph}{4}%
- {\z@}%
- {3.25ex \@plus1ex \@minus.2ex}%
- {-1em}}
-\newcommand*{\l@paragraph}{%
- \flxFont{paragraph}\@dottedtocline{4}{10em}{5em}}
-\newcounter{subparagraph}[paragraph]
-\renewcommand{\thesubparagraph}{\theparagraph.\@arabic\c@subparagraph}
-\newcommand{\subparagraph}{%
- \flx@startsection{subparagraph}{5}%
- {\parindent}%
- {3.25ex \@plus1ex \@minus .2ex}%
- {-1em}}
-\newcommand*{\l@subparagraph}{%
- \flxFont{subparagraph}\@dottedtocline{5}{12em}{6em}}
-\if@twocolumn
- \setlength{\leftmargini}{2em}
-\else
- \setlength{\leftmargini}{2.5em}
-\fi
-\leftmargin\leftmargini
-\setlength{\leftmarginii}{2.2em}
-\setlength{\leftmarginiii}{1.87em}
-\setlength{\leftmarginiv}{1.7em}
-\if@twocolumn
- \setlength{\leftmarginv}{.5em}
- \setlength{\leftmarginvi}{.5em}
-\else
- \setlength{\leftmarginv}{1em}
- \setlength{\leftmarginvi}{1em}
-\fi
-\setlength{\labelsep}{.5em}
-\setlength{\labelwidth}{\leftmargini}
-\addtolength{\labelwidth}{-\labelsep}
-\@beginparpenalty=-\@lowpenalty
-\@endparpenalty=-\@lowpenalty
-\@itempenalty=-\@lowpenalty
-\renewcommand{\theenumi}{\@arabic\c@enumi}
-\renewcommand{\theenumii}{\@alph\c@enumii}
-\renewcommand{\theenumiii}{\@roman\c@enumiii}
-\renewcommand{\theenumiv}{\@Alph\c@enumiv}
-\newcommand{\labelenumi}{\theenumi.}
-\newcommand{\labelenumii}{(\theenumii)}
-\newcommand{\labelenumiii}{\theenumiii.}
-\newcommand{\labelenumiv}{\theenumiv.}
-\renewcommand{\p@enumii}{\theenumi}
-\renewcommand{\p@enumiii}{\theenumi(\theenumii)}
-\renewcommand{\p@enumiv}{\p@enumiii\theenumiii}
-\newcommand{\labelitemi}{\textbullet}
-\newcommand{\labelitemii}{\normalfont\bfseries \textendash}
-\newcommand{\labelitemiii}{\textasteriskcentered}
-\newcommand{\labelitemiv}{\textperiodcentered}
-\newenvironment{description}
- {\list{}{%
- \labelwidth\z@
- \itemindent-\leftmargin
- \let\makelabel\descriptionlabel}}
- {\endlist}
-\newcommand*{\descriptionlabel}[1]{%
- \hspace\labelsep\normalfont\bfseries #1}
-\if@titlepage
- \newenvironment{abstract}
- {\titlepage
- \null\vfil
- \@beginparpenalty\@lowpenalty
- \begin{center}%
- \bfseries\abstractname
- \@endparpenalty\@M
- \end{center}}%
- {\par\vfil\null\endtitlepage}
-\else
- \newenvironment{abstract}
- {\if@twocolumn
- \section*{\abstractname}%
- \else
- \small
- \begin{center}%
- {\bfseries\abstractname\vspace{-.5em}\vspace{\z@}}%
- \end{center}%
- \quotation
- \fi}
- {\if@twocolumn\else\endquotation\fi}
-\fi
-\newenvironment{verse}
- {\let\\\@centercr
- \list{}{%
- \itemsep=\z@
- \itemindent=-1.5em%
- \listparindent=\itemindent
- \rightmargin=\leftmargin
- \advance\leftmargin by 1.5em}%
- \item\relax}
- {\endlist}
-\newenvironment{quotation}
- {\list{}{%
- \listparindent=1.5em%
- \itemindent=\listparindent
- \rightmargin=\leftmargin
- \parsep=\z@\@plus\p@}%
- \item\relax}
- {\endlist}
-\newenvironment{quote}
- {\list{}{\rightmargin\leftmargin}\item\relax}
- {\endlist}
-\newenvironment{titlepage}
- {\if@twocolumn
- \@restonecoltrue\onecolumn
- \else
- \@restonecolfalse\newpage
- \fi
- \thispagestyle{empty}%
- \setcounter{page}\@ne}%
- {\if@restonecol
- \twocolumn
- \else
- \newpage
- \fi
- \if@twoside\else
- \setcounter{page}\@ne
- \fi}
-\newcommand{\appendix}{%
- \par
- \setcounter{chapter}{0}%
- \setcounter{section}{0}%
- \renewcommand\@chapapp{\appendixname}%
- \renewcommand\thechapter{\@Alph\c@chapter}}
-\setlength{\arraycolsep}{5\p@}
-\setlength{\tabcolsep}{6\p@}
-\setlength{\arrayrulewidth}{.4\p@}
-\setlength{\doublerulesep}{2\p@}
-\setlength{\tabbingsep}{\labelsep}
-\skip\@mpfootins=\skip\footins
-\setlength{\fboxsep}{3\p@}
-\setlength{\fboxrule}{.4\p@}
-\if@flx@chapters
- \@addtoreset{equation}{chapter}
- \renewcommand{\theequation}{%
- \ifnum\c@chapter>\z@\thechapter.\fi\@arabic\c@equation}
-\else
- \renewcommand{\theequation}{\@arabic\c@equation}
-\fi
-\if@flx@chapters
- \newcounter{figure}[chapter]
- \renewcommand{\thefigure}{%
- \ifnum\c@chapter>\z@\thechapter.\fi\@arabic\c@figure}
-\else
- \newcounter{figure}
- \renewcommand{\thefigure}{\@arabic\c@figure}
-\fi
-\def\fps@figure{tbp}
-\def\ftype@figure{1}
-\def\ext@figure{lof}
-\def\fnum@figure{\figurename~\thefigure}
-\newenvironment{figure}
- {\@float{figure}}
- {\end@float}
-\newenvironment{figure*}
- {\@dblfloat{figure}}
- {\end@dblfloat}
-\if@flx@chapters
- \newcounter{table}[chapter]
- \renewcommand{\thetable}{%
- \ifnum\c@chapter>\z@\thechapter.\fi\@arabic\c@table}
-\else
- \newcounter{table}
- \renewcommand{\thetable}{\@arabic\c@table}
-\fi
-\def\fps@table{tbp}
-\def\ftype@table{2}
-\def\ext@table{lot}
-\def\fnum@table{\tablename~\thetable}
-\newenvironment{table}
- {\@float{table}}
- {\end@float}
-\newenvironment{table*}
- {\@dblfloat{table}}
- {\end@dblfloat}
-\newlength{\abovecaptionskip}
-\newlength{\belowcaptionskip}
-\setlength{\abovecaptionskip}{10\p@}
-\setlength{\belowcaptionskip}{0\p@}
-\long\def\@makecaption#1#2{%
- \vskip\abovecaptionskip
- \sbox\@tempboxa{#1: #2}%
- \ifdim\wd\@tempboxa>\hsize
- #1: #2\par
- \else
- \global\@minipagefalse
- \hb@xt@\hsize{\hfil\box\@tempboxa\hfil}%
- \fi
- \vskip\belowcaptionskip}
-\DeclareOldFontCommand{\rm}{\normalfont\rmfamily}{\mathrm}
-\DeclareOldFontCommand{\sf}{\normalfont\sffamily}{\mathsf}
-\DeclareOldFontCommand{\tt}{\normalfont\ttfamily}{\mathtt}
-\DeclareOldFontCommand{\bf}{\normalfont\bfseries}{\mathbf}
-\DeclareOldFontCommand{\it}{\normalfont\itshape}{\mathit}
-\DeclareOldFontCommand{\sl}{\normalfont\slshape}{\@nomath\sl}
-\DeclareOldFontCommand{\sc}{\normalfont\scshape}{\@nomath\sc}
-\DeclareRobustCommand*{\cal}{\@fontswitch\relax\mathcal}
-\DeclareRobustCommand*{\mit}{\@fontswitch\relax\mathnormal}
-\newcommand{\@pnumwidth}{1.55em}
-\newcommand{\@tocrmarg}{2.55em}
-\newcommand{\@dotsep}{4.5}
-\setcounter{tocdepth}{2}
-\newcommand{\tableofcontents}{%
- \if@twocolumn
- \@restonecoltrue\onecolumn
- \else
- \@restonecolfalse
- \fi
- \chapter*{%
- \contentsname
- \@mkboth{\MakeUppercase\contentsname}%
- {\MakeUppercase\contentsname}}%
- \@starttoc{toc}%
- \if@restonecol
- \twocolumn
- \fi}
-\newcommand{\listoffigures}{%
- \if@twocolumn
- \@restonecoltrue\onecolumn
- \else
- \@restonecolfalse
- \fi
- \chapter*{%
- \listfigurename
- \@mkboth{\MakeUppercase\listfigurename}%
- {\MakeUppercase\listfigurename}}%
- \@starttoc{lof}%
- \if@restonecol
- \twocolumn
- \fi}
-\newcommand*{\l@figure}{\@dottedtocline{1}{1.5em}{2.3em}}
-\newcommand\listoftables{%
- \if@twocolumn
- \@restonecoltrue\onecolumn
- \else
- \@restonecolfalse
- \fi
- \chapter*{%
- \listtablename
- \@mkboth{\MakeUppercase\listtablename}%
- {\MakeUppercase\listtablename}}%
- \@starttoc{lot}%
- \if@restonecol
- \twocolumn
- \fi}
-\let\l@table\l@figure
-\newdimen{\bibindent}
-\setlength{\bibindent}{1.5em}
-\newenvironment{thebibliography}[1]
- {\chapter*{%
- \bibname
- \@mkboth{\MakeUppercase\bibname}%
- {\MakeUppercase\bibname}}%
- \list{\@biblabel{\@arabic\c@enumiv}}{%
- \settowidth{\labelwidth}{\@biblabel{#1}}%
- \leftmargin=\labelwidth
- \advance\leftmargin\labelsep
- \@openbib@code
- \usecounter{enumiv}%
- \let\p@enumiv\@empty
- \renewcommand{\theenumiv}{\@arabic\c@enumiv}}%
- \sloppy
- \clubpenalty4000
- \@clubpenalty \clubpenalty
- \widowpenalty4000%
- \sfcode`\.\@m}
- {\def\@noitemerr{%
- \@latex@warning{Empty `thebibliography' environment}}%
- \endlist}
-\newcommand\newblock{\hskip .11em\@plus.33em\@minus.07em}
-\let\@openbib@code\@empty
-\newenvironment{theindex}
- {\if@twocolumn
- \@restonecolfalse
- \else
- \@restonecoltrue
- \fi
- \columnseprule \z@
- \columnsep 35\p@
- \twocolumn[\@makeschapterhead{\indexname}]%
- \@mkboth{\MakeUppercase\indexname}%
- {\MakeUppercase\indexname}%
- \thispagestyle{plain}\parindent\z@
- \parskip\z@ \@plus .3\p@\relax
- \let\item\@idxitem}
- {\if@restonecol
- \onecolumn
- \else
- \clearpage
- \fi}
-\newcommand{\@idxitem}{\par\hangindent 40\p@}
-\newcommand{\subitem}{\@idxitem \hspace*{20\p@}}
-\newcommand{\subsubitem}{\@idxitem \hspace*{30\p@}}
-\newcommand{\indexspace}{\par \vskip 10\p@ \@plus5\p@ \@minus3\p@\relax}
-\renewcommand{\footnoterule}{%
- \kern-3\p@
- \hrule\@width.4\columnwidth
- \kern2.6\p@}
-\@addtoreset{footnote}{chapter}
-\newcommand{\@makefntext}[1]{%
- \parindent 1em%
- \noindent
- \hb@xt@1.8em{\hss\@makefnmark}#1}
-\newcommand{\contentsname}{Contents}
-\newcommand{\listfigurename}{List of Figures}
-\newcommand{\listtablename}{List of Tables}
-\newcommand{\bibname}{Bibliography}
-\newcommand{\indexname}{Index}
-\newcommand{\figurename}{Figure}
-\newcommand{\tablename}{Table}
-\newcommand{\partname}{Part}
-\newcommand{\chaptername}{Chapter}
-\newcommand{\appendixname}{Appendix}
-\newcommand{\abstractname}{Abstract}
-\newcommand{\today}{}
-\edef\today{%
- \ifcase\month
- \or January%
- \or February%
- \or March%
- \or April%
- \or May%
- \or June%
- \or July%
- \or August%
- \or September%
- \or October%
- \or November%
- \or December%
- \fi
- \space\number\day, \number\year}
-\setlength\columnsep{10\p@}
-\setlength\columnseprule{0\p@}
-\pagestyle{plain}
-\pagenumbering{arabic}
-\if@twoside
-\else
- \raggedbottom
-\fi
-\if@twocolumn
- \twocolumn
- \sloppy
- \flushbottom
-\else
- \onecolumn
-\fi
-\flxDefAlignAll{\centering}
-\flxDefAlign{paragraph}{\relax}
-\flxDefAlign{subparagraph}{\relax}
-\flxDefSizeAll{\normalsize}
-\flxDefSize{part}{\LARGE}
-\flxDefSize{chapter}{\LARGE}
-\flxDefSize{section}{\Large}
-\flxDefSize{subsection}{\large}
-\flxDefFontAll{\itshape}
-\flxDefFont{part}{\scshape}
-\flxDefFont{chapter}{\scshape}
-\flxDefNumber{part}{%
- \huge\bfseries\partname~\thepart\par
- \nobreak\vskip20pt\relax}
-\flxDefNumber{chapter}{%
- \huge\bfseries\flxChapter\space\thechapter\par
- \nobreak\vskip20pt\relax}
-\flxDefNumber{part}{\Huge---\thepart---\par\nobreak}
-\flxDefNumber{chapter}{\Huge---\thechapter---\par\nobreak}
-\endinput
-%%
-%% End of file `flex.cls'.
Index: branches/ohl/omega-development/hgg-vertex/share/doc/preview.tex
===================================================================
--- branches/ohl/omega-development/hgg-vertex/share/doc/preview.tex (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/share/doc/preview.tex (revision 8717)
@@ -1,1790 +0,0 @@
-% $Id$
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%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/hgg-vertex/share/doc/preview.ps.gz
===================================================================
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Index: branches/ohl/omega-development/hgg-vertex/share/doc/thohacks.sty
===================================================================
--- branches/ohl/omega-development/hgg-vertex/share/doc/thohacks.sty (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/share/doc/thohacks.sty (revision 8717)
@@ -1,65 +0,0 @@
-%%
-%% This is file `thohacks.sty', generated on <1993/11/23>
-%% with the docstrip utility (2.0r).
-%%
-%% The original source files were:
-%%
-%% thohacks.doc (with options: `style,a4,thd')
-%%
-%% IMPORTANT NOTICE:
-%% You are not allowed to distribute this file.
-%% For distribution of the original source see
-%% the copyright notice in the file thohacks.doc .
-%%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% \CheckSum{108}
-%% \CharacterTable
-%% {Upper-case \A\B\C\D\E\F\G\H\I\J\K\L\M\N\O\P\Q\R\S\T\U\V\W\X\Y\Z
-%% Lower-case \a\b\c\d\e\f\g\h\i\j\k\l\m\n\o\p\q\r\s\t\u\v\w\x\y\z
-%% Digits \0\1\2\3\4\5\6\7\8\9
-%% Exclamation \! Double quote \" Hash (number) \#
-%% Dollar \$ Percent \% Ampersand \&
-%% Acute accent \' Left paren \( Right paren \)
-%% Asterisk \* Plus \+ Comma \,
-%% Minus \- Point \. Solidus \/
-%% Colon \: Semicolon \; Less than \<
-%% Equals \= Greater than \> Question mark \?
-%% Commercial at \@ Left bracket \[ Backslash \\
-%% Right bracket \] Circumflex \^ Underscore \_
-%% Grave accent \` Left brace \{ Vertical bar \|
-%% Right brace \} Tilde \~}
-%%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\@ifundefined{th@hacks}{}{\endinput}
-\def\th@hacks{loaded}
-{\def\$#1: #2.doc,v #3${Style option: `#2' v#3}
-\typeout{\$Id: thohacks.doc,v 1.6 1993/01/20 01:56:56 ohl Exp $}}
-\newcount\twodigits
-\def\gobbleone1{}
-\def\printtwodigits{\advance\twodigits100
- \expandafter\gobbleone\number\twodigits
- \advance\twodigits-100 }
-\def\timestamp{%
- \twodigits=\month \printtwodigits
- \twodigits=\day /\printtwodigits/\number\year,
- \twodigits=\time \divide\twodigits by 60 \printtwodigits
- \multiply\twodigits by-60 \advance\twodigits by\time :\printtwodigits}
-\newenvironment{motto}[2]{\begin{flushright}
- \def\m@tt@author{#1}\def\m@tt@source{#2}\it}{\\
- \sc\m@tt@author:~\rm\m@tt@source\end{flushright}}
-\font\manfnt=manfnt
-\def\Watchout{\@ifnextchar [{\W@tchout}{\W@tchout[1]}}
-\def\W@tchout[#1]{{\manfnt\@tempcnta#1\relax%
- \@whilenum\@tempcnta>\z@\do{%
- \char"7F\hskip 0.3em\advance\@tempcnta\m@ne}}}
-\let\foo\W@tchout
-\def\dubious{\@ifnextchar[{\@dubious}{\@dubious[1]}}
-\let\enddubious\endlist
-\def\@dubious[#1]{%
- \setbox\@tempboxa\hbox{\@W@tchout#1}
- \@tempdima\wd\@tempboxa
- \list{}{\leftmargin\@tempdima}\item[\hbox to 0pt{\hss\@W@tchout#1}]}
-\def\@W@tchout#1{\W@tchout[#1]}
-\endinput
-%%
-%% End of file `thohacks.sty'.
Index: branches/ohl/omega-development/hgg-vertex/share/doc/epemudbarmunumubar.eps
===================================================================
--- branches/ohl/omega-development/hgg-vertex/share/doc/epemudbarmunumubar.eps (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/share/doc/epemudbarmunumubar.eps (revision 8717)
@@ -1,965 +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 883 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 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/hgg-vertex/share/doc/custom.hva
===================================================================
--- branches/ohl/omega-development/hgg-vertex/share/doc/custom.hva (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/share/doc/custom.hva (revision 8717)
@@ -1,39 +0,0 @@
-% custom.hva -- tuning HEVEA for O'Mega documentation
-% $Id$
-% 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/hgg-vertex/share/doc/epemudbardubar0.eps
===================================================================
--- branches/ohl/omega-development/hgg-vertex/share/doc/epemudbardubar0.eps (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/share/doc/epemudbardubar0.eps (revision 8717)
@@ -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/hgg-vertex/share/doc/noweb.sty
===================================================================
--- branches/ohl/omega-development/hgg-vertex/share/doc/noweb.sty (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/share/doc/noweb.sty (revision 8717)
@@ -1,927 +0,0 @@
-% noweb.sty -- LaTeX support for noweb
-% DON'T read or edit this file! Use ...noweb-source/tex/support.nw instead.
-{\obeyspaces\AtBeginDocument{\global\let =\ }} % from texbook, p 381
-\def\nwopt@nomargintag{\let\nwmargintag=\@gobble}
-\def\nwopt@margintag{%
- \def\nwmargintag##1{\leavevmode\llap{##1\kern\nwmarginglue\kern\codemargin}}}
-\def\nwopt@margintag{%
- \def\nwmargintag##1{\leavevmode\kern-\codemargin\nwthemargintag{##1}\kern\codemargin}}
-\def\nwthemargintag#1{\llap{#1\kern\nwmarginglue}}
-\nwopt@margintag
-\newdimen\nwmarginglue
-\nwmarginglue=0.3in
-\def\nwtagstyle{\footnotesize\Rm}
-% make \hsize in code sufficient for 88 columns
-\setbox0=\hbox{\tt m}
-\newdimen\codehsize
-\codehsize=91\wd0 % 88 columns wasn't enough; I don't know why
-\newdimen\codemargin
-\codemargin=0pt
-\newdimen\nwdefspace
-\nwdefspace=\codehsize
-% need to use \textwidth in {\LaTeX} to handle styles with
-% non-standard margins (David Bruce). Don't know why we sometimes
-% wanted \hsize. 27 August 1997.
-%% \advance\nwdefspace by -\hsize\relax
-\ifx\textwidth\undefined
- \advance\nwdefspace by -\hsize\relax
-\else
- \advance\nwdefspace by -\textwidth\relax
-\fi
-\chardef\other=12
-\def\setupcode{%
- \chardef\\=`\\
- \chardef\{=`\{
- \chardef\}=`\}
- \catcode`\$=\other
- \catcode`\&=\other
- \catcode`\#=\other
- \catcode`\%=\other
- \catcode`\~=\other
- \catcode`\_=\other
- \catcode`\^=\other
- \catcode`\"=\other % fixes problem with german.sty
- \obeyspaces\Tt
-}
-\let\nwlbrace=\{
-\let\nwrbrace=\}
-\def\nwendquote{\relax\ifhmode\spacefactor=1000 \fi}
-{\catcode`\^^M=\active % make CR an active character
- \gdef\newlines{\catcode`\^^M=\active % make CR an active character
- \def^^M{\par\startline}}%
- \gdef\eatline#1^^M{\relax}%
-}
-%%% DON'T \gdef^^M{\par\startline}}% in case ^^M appears in a \write
-\def\startline{\noindent\hskip\parindent\ignorespaces}
-\def\nwnewline{\ifvmode\else\hfil\break\leavevmode\hbox{}\fi}
-\def\setupmodname{%
- \catcode`\$=3
- \catcode`\&=4
- \catcode`\#=6
- \catcode`\%=14
- \catcode`\~=13
- \catcode`\_=8
- \catcode`\^=7
- \catcode`\ =10
- \catcode`\^^M=5
- \let\{\nwlbrace
- \let\}\nwrbrace
- % bad news --- don't know what catcode to give "
- \Rm}
-\def\LA{\begingroup\maybehbox\bgroup\setupmodname\It$\langle$}
-\def\RA{\/$\rangle$\egroup\endgroup}
-\def\code{\leavevmode\begingroup\setupcode\newlines}
-\def\edoc{\endgroup}
-\let\maybehbox\relax
-\newbox\equivbox
-\setbox\equivbox=\hbox{$\equiv$}
-\newbox\plusequivbox
-\setbox\plusequivbox=\hbox{$\mathord{+}\mathord{\equiv}$}
-% \moddef can't have an argument because there might be \code...\edoc
-\def\moddef{\leavevmode\kern-\codemargin\LA}
-\def\endmoddef{\RA\ifmmode\equiv\else\unhcopy\equivbox\fi
- \nobreak\hfill\nobreak}
-\def\plusendmoddef{\RA\ifmmode\mathord{+}\mathord{\equiv}\else\unhcopy\plusequivbox\fi
- \nobreak\hfill\nobreak}
-\def\chunklist{%
-\errhelp{I changed \chunklist to \nowebchunks.
-I'll try to avoid such incompatible changes in the future.}%
-\errmessage{Use \string\nowebchunks\space instead of \string\chunklist}}
-\def\nowebchunks{\message{<Warning: You need noweave -x to use \string\nowebchunks>}}
-\def\nowebindex{\message{<Warning: You need noweave -index to use \string\nowebindex>}}
-% here is support for the new-style (capitalized) font-changing commands
-% thanks to Dave Love
-\ifx\documentstyle\undefined
- \let\Rm=\rm \let\It=\it \let\Tt=\tt % plain
-\else\ifx\selectfont\undefined
- \let\Rm=\rm \let\It=\it \let\Tt=\tt % LaTeX OFSS
-\else % LaTeX NFSS
- \def\Rm{\reset@font\rm}
- \def\It{\reset@font\it}
- \def\Tt{\reset@font\tt}
- \def\Bf{\reset@font\bf}
-\fi\fi
-\ifx\reset@font\undefined \let\reset@font=\relax \fi
-\def\noweboptions#1{%
- \def\@nwoptionlist{#1}%
- \@for\@nwoption:=\@nwoptionlist\do{%
- \@ifundefined{nwopt@\@nwoption}{%
- \@latexerr{There is no such noweb option as '\@nwoption'}\@eha}{%
- \csname nwopt@\@nwoption\endcsname}}}
-\codemargin=10pt
-\advance\codehsize by \codemargin % make room for indentation of code
-\advance\nwdefspace by \codemargin % and fix adjustment for def/use
-\def\setcodemargin#1{%
- \advance\codehsize by -\codemargin % make room for indentation of code
- \advance\nwdefspace by -\codemargin % and fix adjustment for def/use
- \codemargin=#1
- \advance\codehsize by \codemargin % make room for indentation of code
- \advance\nwdefspace by \codemargin % and fix adjustment for
- % def/use
-}
-\def\nwopt@shift{%
- \dimen@=-0.8in
- \if@twoside % Values for two-sided printing:
- \advance\evensidemargin by \dimen@
- \else % Values for one-sided printing:
- \advance\evensidemargin by \dimen@
- \advance\oddsidemargin by \dimen@
- \fi
-% \advance \marginparwidth -\dimen@
-}
-\let\nwopt@noshift\@empty
-\def\nwbegincode#1{%
- \begingroup
- \topsep \nwcodetopsep
- \@beginparpenalty \@highpenalty
- \@endparpenalty -\@highpenalty
- \@begincode }
-\def\nwendcode{\endtrivlist \endgroup \filbreak} % keeps code on 1 page
-
-\newenvironment{webcode}{%
- \@begincode
-}{%
- \endtrivlist}
-\def\@begincode{%
- \trivlist \item[]%
- \leftskip\@totalleftmargin \advance\leftskip\codemargin
- \rightskip\hsize \advance\rightskip -\codehsize
- \parskip\z@ \parindent\z@ \parfillskip\@flushglue
- \linewidth\codehsize
- \@@par
- \def\par{\leavevmode\null \@@par \penalty\nwcodepenalty}%
- \obeylines
- \@noligs \ifx\verbatim@nolig@list\undefined\else
- \let\do=\nw@makeother \verbatim@nolig@list \do@noligs\`
- \fi
- \setupcode \frenchspacing \@vobeyspaces
- \nowebsize \setupcode
- \let\maybehbox\mbox }
- \newskip\nwcodetopsep \nwcodetopsep = 3pt plus 1.2pt minus 1pt
- \let\nowebsize=\normalsize
- \def\nwopt@tinycode{\let\nowebsize=\tiny}
- \def\nwopt@footnotesizecode{\let\nowebsize=\footnotesize}
- \def\nwopt@scriptsizecode{\let\nowebsize=\scriptsize}
- \def\nwopt@smallcode{\let\nowebsize=\small}
- \def\nwopt@normalsizecode{\let\nowebsize=\normalsize}
- \def\nwopt@largecode{\let\nowebsize=\large}
- \def\nwopt@Largecode{\let\nowebsize=\Large}
- \def\nwopt@LARGEcode{\let\nowebsize=\LARGE}
- \def\nwopt@hugecode{\let\nowebsize=\huge}
- \def\nwopt@Hugecode{\let\nowebsize=\Huge}
-\newcount\nwcodepenalty \nwcodepenalty=\@highpenalty
-\def\nw@makeother#1{\catcode`#1=12 }
-\def\nwbegindocs#1{\ifvmode\noindent\fi}
-\let\nwenddocs=\relax
-\let\nwdocspar=\filbreak
-\def\@nwsemifilbreak#1{\vskip0pt plus#1\penalty-200\vskip0pt plus -#1}
-\newdimen\nwbreakcodespace
-\nwbreakcodespace=0.2in % by default, leave no more than this on a page
-\def\nwopt@breakcode{%
- \def\nwdocspar{\@nwsemifilbreak{0.2in}}%
- \def\nwendcode{\endtrivlist\endgroup} % ditches filbreak
-}
-\raggedbottom
-\def\code{\leavevmode\begingroup\setupcode\@vobeyspaces\obeylines}
-\let\edoc=\endgroup
-\newdimen\@original@textwidth
-\def\ps@noweb{%
- \@original@textwidth=\textwidth
- \let\@mkboth\@gobbletwo
- \def\@oddfoot{}\def\@evenfoot{}% No feet.
- \if@twoside % If two-sided printing.
- \def\@evenhead{\hbox to \@original@textwidth{%
- \Rm \thepage\qquad{\Tt\leftmark}\hfil\today}}% Left heading.
- \def\@oddhead{\hbox to \@original@textwidth{%
- \Rm \today\hfil{\Tt\leftmark}\qquad\thepage}}% Right heading.
- \else % If one-sided printing.
- \def\@oddhead{\hbox to \@original@textwidth{%
- \Rm \today\hfil{\Tt\leftmark}\qquad\thepage}}% Right heading.
- \let\@evenhead\@oddhead
- \fi
- \let\chaptermark\@gobble
- \let\sectionmark\@gobble
- \let\subsectionmark\@gobble
- \let\subsubsectionmark\@gobble
- \let\paragraphmark\@gobble
- \let\subparagraphmark\@gobble
- \def\nwfilename{\begingroup\let\do\@makeother\dospecials
- \catcode`\{=1 \catcode`\}=2 \nw@filename}
- \def\nw@filename##1{\endgroup\markboth{##1}{##1}\let\nw@filename=\nw@laterfilename}%
-}
-\def\nw@laterfilename#1{\endgroup\clearpage \markboth{#1}{#1}}
-\let\nwfilename=\@gobble
-\def\nwcodecomment#1{\@@par\penalty\nwcodepenalty
- \if@firstnwcodecomment
- \vskip\nwcodecommentsep\penalty\nwcodepenalty\@firstnwcodecommentfalse
- \fi%
- \hspace{-\codemargin}{%
- \rightskip=0pt plus1in
- \interlinepenalty\nwcodepenalty
- \let\\\relax\footnotesize\Rm #1\@@par\penalty\nwcodepenalty}}
-\def\@nwalsodefined#1{\nwcodecomment{\@nwlangdepdef\ \nwpageprep\ \@pagesl{#1}.}}
-\def\@nwused#1{\nwcodecomment{\@nwlangdepcud\ \nwpageprep\ \@pagesl{#1}.}}
-\def\@nwnotused#1{\nwcodecomment{\@nwlangdeprtc.}}
-\def\nwoutput#1{\nwcodecomment{\@nwlangdepcwf\ {\Tt \@stripstar#1*\stripped}.}}
-\def\@stripstar#1*#2\stripped{#1}
-\newcommand{\nwprevdefptr}[1]{%
- \mbox{$\mathord{\triangleleft}\,\mathord{\mbox{\subpageref{#1}}}$}}
-\newcommand{\nwnextdefptr}[1]{%
- \mbox{$\mathord{\mbox{\subpageref{#1}}}\,\mathord{\triangleright}$}}
-
-\newcommand{\@nwprevnextdefs}[2]{%
- {\nwtagstyle
- \ifx\relax#1\else ~~\nwprevdefptr{#1}\fi
- \ifx\relax#2\else ~~\nwnextdefptr{#2}\fi}}
-\newcommand{\@nwusesondefline}[1]{{\nwtagstyle~~(\@pagenumsl{#1})}}
-\newcommand{\@nwstartdeflinemarkup}{\nobreak\hskip 1.5em plus 1fill\nobreak}
-\newcommand{\@nwenddeflinemarkup}{\nobreak\hskip \nwdefspace minus\nwdefspace\nobreak}
-\def\nwopt@longxref{%
- \let\nwalsodefined\@nwalsodefined
- \let\nwused\@nwused
- \let\nwnotused\@nwnotused
- \let\nwprevnextdefs\@gobbletwo
- \let\nwusesondefline\@gobble
- \let\nwstartdeflinemarkup\relax
- \let\nwenddeflinemarkup\relax
-}
-\def\nwopt@shortxref{%
- \let\nwalsodefined\@gobble
- \let\nwused\@gobble
- \let\nwnotused\@gobble
- \let\nwprevnextdefs\@nwprevnextdefs
- \let\nwusesondefline\@nwusesondefline
- \let\nwstartdeflinemarkup\@nwstartdeflinemarkup
- \let\nwenddeflinemarkup\@nwenddeflinemarkup
-}
-\def\nwopt@noxref{%
- \let\nwalsodefined\@gobble
- \let\nwused\@gobble
- \let\nwnotused\@gobble
- \let\nwprevnextdefs\@gobbletwo
- \let\nwusesondefline\@gobble
- \let\nwstartdeflinemarkup\relax
- \let\nwenddeflinemarkup\relax
-}
-\nwopt@shortxref % to hell with backward compatibility!
-\newskip\nwcodecommentsep \nwcodecommentsep=3pt plus 1pt minus 1pt
-\newif\if@firstnwcodecomment\@firstnwcodecommenttrue
-\newcount\@nwlopage\newcount\@nwhipage % range lo..hi-1
-\newcount\@nwlosub % subpage of lo
-\newcount\@nwhisub % subpage of hi
-\def\@nwfirstpage#1#2#3{% subpage page xref-tag
- \@nwlopage=#2 \@nwlosub=#1
- \def\@nwloxreftag{#3}%
- \advance\@nwpagecount by \@ne
- \@nwhipage=\@nwlopage\advance\@nwhipage by \@ne }
-\def\@nwnextpage#1#2#3{% subpage page xref-tag
- \ifnum\@nwhipage=#2
- \advance\@nwhipage by \@ne
- \advance\@nwpagecount by \@ne
- \@nwhisub=#1
- \def\@nwhixreftag{#3}\else
- \ifnum#2<\@nwlopage \advance\@nwhipage by \m@ne
- \ifnum\@nwhipage=\@nwlopage
- \edef\@tempa{\noexpand\noexpand\noexpand\\%
- {{\nwthepagenum{\number\@nwlosub}{\number\@nwlopage}}%
- {\@nwloxreftag}}}%
- \else
- \count@=\@nwhipage \advance\count@ by \m@ne
- \ifnum\count@=\@nwlopage % consecutive pages
- \edef\@tempa{\noexpand\noexpand\noexpand\\%
- {{\nwthepagenum{\number\@nwlosub}{\number\@nwlopage}}%
- {\@nwloxreftag}}%
- \noexpand\noexpand\noexpand\\%
- {{\nwthepagenum{\number\@nwhisub}{\number\@nwhipage}}
- {\@nwhixreftag}}}%
- \else \ifnum\@nwlopage<110 \edef\@tempa{\noexpand\noexpand\noexpand\\{{\number\@nwlopage--\number\@nwhipage}{}}}\else
- \count@=\@nwlopage \divide\count@ by 100 \multiply\count@ by 100
- \ifnum\count@=\@nwlopage \edef\@tempa{\noexpand\noexpand\noexpand\\{{\number\@nwlopage--\number\@nwhipage}{}}}\else
- \count@=\@nwlopage \divide\count@ by 100
- \@nwpagetemp=\@nwhipage \divide\@nwpagetemp by 100
- \ifnum\count@=\@nwpagetemp % lo--least 2 digits of hi
- \multiply\@nwpagetemp by 100
- \advance \@nwhipage by -\@nwpagetemp
- \edef\@tempa{\noexpand\noexpand\noexpand\\{{\number\@nwlopage--\number\@nwhipage}{}}}%
- \else \edef\@tempa{\noexpand\noexpand\noexpand\\{{\number\@nwlopage--\number\@nwhipage}{}}}%
- \fi
- \fi
- \fi%
- \fi
- \fi%
- \edef\@tempa{\noexpand\nwix@cons\noexpand\nw@pages{\@tempa}}\@tempa\@nwfirstpage{#1}{#2}{#3}\else
- \ifnum#2>\@nwhipage \advance\@nwhipage by \m@ne
- \ifnum\@nwhipage=\@nwlopage
- \edef\@tempa{\noexpand\noexpand\noexpand\\%
- {{\nwthepagenum{\number\@nwlosub}{\number\@nwlopage}}%
- {\@nwloxreftag}}}%
- \else
- \count@=\@nwhipage \advance\count@ by \m@ne
- \ifnum\count@=\@nwlopage % consecutive pages
- \edef\@tempa{\noexpand\noexpand\noexpand\\%
- {{\nwthepagenum{\number\@nwlosub}{\number\@nwlopage}}%
- {\@nwloxreftag}}%
- \noexpand\noexpand\noexpand\\%
- {{\nwthepagenum{\number\@nwhisub}{\number\@nwhipage}}
- {\@nwhixreftag}}}%
- \else \ifnum\@nwlopage<110 \edef\@tempa{\noexpand\noexpand\noexpand\\{{\number\@nwlopage--\number\@nwhipage}{}}}\else
- \count@=\@nwlopage \divide\count@ by 100 \multiply\count@ by 100
- \ifnum\count@=\@nwlopage \edef\@tempa{\noexpand\noexpand\noexpand\\{{\number\@nwlopage--\number\@nwhipage}{}}}\else
- \count@=\@nwlopage \divide\count@ by 100
- \@nwpagetemp=\@nwhipage \divide\@nwpagetemp by 100
- \ifnum\count@=\@nwpagetemp % lo--least 2 digits of hi
- \multiply\@nwpagetemp by 100
- \advance \@nwhipage by -\@nwpagetemp
- \edef\@tempa{\noexpand\noexpand\noexpand\\{{\number\@nwlopage--\number\@nwhipage}{}}}%
- \else \edef\@tempa{\noexpand\noexpand\noexpand\\{{\number\@nwlopage--\number\@nwhipage}{}}}%
- \fi
- \fi
- \fi%
- \fi
- \fi%
- \edef\@tempa{\noexpand\nwix@cons\noexpand\nw@pages{\@tempa}}\@tempa\@nwfirstpage{#1}{#2}{#3}\else
- \@nwlosub=0 \@nwhisub=0
- \fi\fi\fi
- }
-\newcount\@nwpagetemp
-\newcount\@nwpagecount
-\def\@nwfirstpagel#1{% label
- \@ifundefined{r@#1}{\@warning{Reference `#1' on page \thepage \space undefined}%
- \nwix@cons\nw@pages{\\{\bf ??}}}{%
- \edef\@tempa{\noexpand\@nwfirstpage\subpagepair{#1}{#1}}\@tempa}}
-\def\@nwnextpagel#1{% label
- \@ifundefined{r@#1}{\@warning{Reference `#1' on page \thepage \space undefined}%
- \nwix@cons\nw@pages{\\{\bf ??}}}{%
- \edef\@tempa{\noexpand\@nwnextpage\subpagepair{#1}{#1}}\@tempa}}
-\def\@pagesl#1{% list of labels
- \gdef\nw@pages{}\@nwpagecount=0
- \def\\##1{\@nwfirstpagel{##1}\let\\=\@nwnextpagel}#1%
- \advance\@nwhipage by \m@ne
- \ifnum\@nwhipage=\@nwlopage
- \edef\@tempa{\noexpand\noexpand\noexpand\\%
- {{\nwthepagenum{\number\@nwlosub}{\number\@nwlopage}}%
- {\@nwloxreftag}}}%
- \else
- \count@=\@nwhipage \advance\count@ by \m@ne
- \ifnum\count@=\@nwlopage % consecutive pages
- \edef\@tempa{\noexpand\noexpand\noexpand\\%
- {{\nwthepagenum{\number\@nwlosub}{\number\@nwlopage}}%
- {\@nwloxreftag}}%
- \noexpand\noexpand\noexpand\\%
- {{\nwthepagenum{\number\@nwhisub}{\number\@nwhipage}}
- {\@nwhixreftag}}}%
- \else \ifnum\@nwlopage<110 \edef\@tempa{\noexpand\noexpand\noexpand\\{{\number\@nwlopage--\number\@nwhipage}{}}}\else
- \count@=\@nwlopage \divide\count@ by 100 \multiply\count@ by 100
- \ifnum\count@=\@nwlopage \edef\@tempa{\noexpand\noexpand\noexpand\\{{\number\@nwlopage--\number\@nwhipage}{}}}\else
- \count@=\@nwlopage \divide\count@ by 100
- \@nwpagetemp=\@nwhipage \divide\@nwpagetemp by 100
- \ifnum\count@=\@nwpagetemp % lo--least 2 digits of hi
- \multiply\@nwpagetemp by 100
- \advance \@nwhipage by -\@nwpagetemp
- \edef\@tempa{\noexpand\noexpand\noexpand\\{{\number\@nwlopage--\number\@nwhipage}{}}}%
- \else \edef\@tempa{\noexpand\noexpand\noexpand\\{{\number\@nwlopage--\number\@nwhipage}{}}}%
- \fi
- \fi
- \fi%
- \fi
- \fi%
- \edef\@tempa{\noexpand\nwix@cons\noexpand\nw@pages{\@tempa}}\@tempa\def\\##1{\@nwhyperpagenum##1}%
- \ifnum\@nwpagecount=1 \nwpageword \else \nwpagesword\fi~\commafy{\nw@pages}}
-\def\@nwhyperpagenum#1#2{\nwhyperreference{#2}{#1}}
-
-\def\@pagenumsl#1{% list of labels -- doesn't include word `pages', commas, or `and'
- \gdef\nw@pages{}\@nwpagecount=0
- \def\\##1{\@nwfirstpagel{##1}\let\\=\@nwnextpagel}#1%
- \advance\@nwhipage by \m@ne
- \ifnum\@nwhipage=\@nwlopage
- \edef\@tempa{\noexpand\noexpand\noexpand\\%
- {{\nwthepagenum{\number\@nwlosub}{\number\@nwlopage}}%
- {\@nwloxreftag}}}%
- \else
- \count@=\@nwhipage \advance\count@ by \m@ne
- \ifnum\count@=\@nwlopage % consecutive pages
- \edef\@tempa{\noexpand\noexpand\noexpand\\%
- {{\nwthepagenum{\number\@nwlosub}{\number\@nwlopage}}%
- {\@nwloxreftag}}%
- \noexpand\noexpand\noexpand\\%
- {{\nwthepagenum{\number\@nwhisub}{\number\@nwhipage}}
- {\@nwhixreftag}}}%
- \else \ifnum\@nwlopage<110 \edef\@tempa{\noexpand\noexpand\noexpand\\{{\number\@nwlopage--\number\@nwhipage}{}}}\else
- \count@=\@nwlopage \divide\count@ by 100 \multiply\count@ by 100
- \ifnum\count@=\@nwlopage \edef\@tempa{\noexpand\noexpand\noexpand\\{{\number\@nwlopage--\number\@nwhipage}{}}}\else
- \count@=\@nwlopage \divide\count@ by 100
- \@nwpagetemp=\@nwhipage \divide\@nwpagetemp by 100
- \ifnum\count@=\@nwpagetemp % lo--least 2 digits of hi
- \multiply\@nwpagetemp by 100
- \advance \@nwhipage by -\@nwpagetemp
- \edef\@tempa{\noexpand\noexpand\noexpand\\{{\number\@nwlopage--\number\@nwhipage}{}}}%
- \else \edef\@tempa{\noexpand\noexpand\noexpand\\{{\number\@nwlopage--\number\@nwhipage}{}}}%
- \fi
- \fi
- \fi%
- \fi
- \fi%
- \edef\@tempa{\noexpand\nwix@cons\noexpand\nw@pages{\@tempa}}\@tempa%
- \def\\##1{\@nwhyperpagenum##1\let\\=\@nwpagenumslrest}\nw@pages}
-\def\@nwpagenumslrest#1{~\@nwhyperpagenum#1}
-\def\subpages#1{% list of {{subpage}{page}}
- \gdef\nw@pages{}\@nwpagecount=0
- \def\\##1{\edef\@tempa{\noexpand\@nwfirstpage##1{}}\@tempa
- \def\\####1{\edef\@tempa{\noexpand\@nwnextpage####1}\@tempa}}#1%
- \advance\@nwhipage by \m@ne
- \ifnum\@nwhipage=\@nwlopage
- \edef\@tempa{\noexpand\noexpand\noexpand\\%
- {{\nwthepagenum{\number\@nwlosub}{\number\@nwlopage}}%
- {\@nwloxreftag}}}%
- \else
- \count@=\@nwhipage \advance\count@ by \m@ne
- \ifnum\count@=\@nwlopage % consecutive pages
- \edef\@tempa{\noexpand\noexpand\noexpand\\%
- {{\nwthepagenum{\number\@nwlosub}{\number\@nwlopage}}%
- {\@nwloxreftag}}%
- \noexpand\noexpand\noexpand\\%
- {{\nwthepagenum{\number\@nwhisub}{\number\@nwhipage}}
- {\@nwhixreftag}}}%
- \else \ifnum\@nwlopage<110 \edef\@tempa{\noexpand\noexpand\noexpand\\{{\number\@nwlopage--\number\@nwhipage}{}}}\else
- \count@=\@nwlopage \divide\count@ by 100 \multiply\count@ by 100
- \ifnum\count@=\@nwlopage \edef\@tempa{\noexpand\noexpand\noexpand\\{{\number\@nwlopage--\number\@nwhipage}{}}}\else
- \count@=\@nwlopage \divide\count@ by 100
- \@nwpagetemp=\@nwhipage \divide\@nwpagetemp by 100
- \ifnum\count@=\@nwpagetemp % lo--least 2 digits of hi
- \multiply\@nwpagetemp by 100
- \advance \@nwhipage by -\@nwpagetemp
- \edef\@tempa{\noexpand\noexpand\noexpand\\{{\number\@nwlopage--\number\@nwhipage}{}}}%
- \else \edef\@tempa{\noexpand\noexpand\noexpand\\{{\number\@nwlopage--\number\@nwhipage}{}}}%
- \fi
- \fi
- \fi%
- \fi
- \fi%
- \edef\@tempa{\noexpand\nwix@cons\noexpand\nw@pages{\@tempa}}\@tempa\def\\##1{\@firstoftwo##1}%
- \ifnum\@nwpagecount=1 \nwpageword \else \nwpagesword\fi~\commafy{\nw@pages}}
-\def\@nwaddrange{\advance\@nwhipage by \m@ne
- \ifnum\@nwhipage=\@nwlopage
- \edef\@tempa{\noexpand\noexpand\noexpand\\%
- {{\nwthepagenum{\number\@nwlosub}{\number\@nwlopage}}%
- {\@nwloxreftag}}}%
- \else
- \count@=\@nwhipage \advance\count@ by \m@ne
- \ifnum\count@=\@nwlopage % consecutive pages
- \edef\@tempa{\noexpand\noexpand\noexpand\\%
- {{\nwthepagenum{\number\@nwlosub}{\number\@nwlopage}}%
- {\@nwloxreftag}}%
- \noexpand\noexpand\noexpand\\%
- {{\nwthepagenum{\number\@nwhisub}{\number\@nwhipage}}
- {\@nwhixreftag}}}%
- \else \ifnum\@nwlopage<110 \edef\@tempa{\noexpand\noexpand\noexpand\\{{\number\@nwlopage--\number\@nwhipage}{}}}\else
- \count@=\@nwlopage \divide\count@ by 100 \multiply\count@ by 100
- \ifnum\count@=\@nwlopage \edef\@tempa{\noexpand\noexpand\noexpand\\{{\number\@nwlopage--\number\@nwhipage}{}}}\else
- \count@=\@nwlopage \divide\count@ by 100
- \@nwpagetemp=\@nwhipage \divide\@nwpagetemp by 100
- \ifnum\count@=\@nwpagetemp % lo--least 2 digits of hi
- \multiply\@nwpagetemp by 100
- \advance \@nwhipage by -\@nwpagetemp
- \edef\@tempa{\noexpand\noexpand\noexpand\\{{\number\@nwlopage--\number\@nwhipage}{}}}%
- \else \edef\@tempa{\noexpand\noexpand\noexpand\\{{\number\@nwlopage--\number\@nwhipage}{}}}%
- \fi
- \fi
- \fi%
- \fi
- \fi%
- \edef\@tempa{\noexpand\nwix@cons\noexpand\nw@pages{\@tempa}}\@tempa}
-\def\nwpageword{\@nwlangdepchk} % chunk, was page
-\def\nwpagesword{\@nwlangdepchks} % chunk, was page
-\def\nwpageprep{\@nwlangdepin} % in, was on
-\newcommand\nw@genericref[2]{% what to do, name of ref
- \expandafter\nw@g@nericref\csname r@#2\endcsname#1{#2}}
-\newcommand\nw@g@nericref[3]{% control sequence, what to do, name
- \ifx#1\relax
- \ref{#3}% trigger the standard `undefined ref' mechanisms
- \else
- \expandafter#2#1.\\%
- \fi}
-\def\nw@selectone#1#2#3\\{#1}
-\def\nw@selecttwo#1#2#3\\{#2}
-\def\nw@selectonetwo#1#2#3\\{{#1}{#2}}
-\newcommand{\subpageref}[1]{%
- \nwhyperreference{#1}{\nw@genericref\@subpageref{#1}}}
-\def\@subpageref#1#2#3\\{%
- \@ifundefined{2on#2}{#2}{\nwthepagenum{#1}{#2}}}
-\newcommand{\subpagepair}[1]{% % produces {subpage}{page}
- \@ifundefined{r@#1}%
- {{0}{0}}%
- {\nw@genericref\@subpagepair{#1}}}
-\def\@subpagepair#1#2#3\\{%
- \@ifundefined{2on#2}{{0}{#2}}{{#1}{#2}}}
-\newcommand{\sublabel}[1]{%
- \@bsphack
- \nwblindhyperanchor{#1}%
- \if@filesw {\let\thepage\relax
- \def\protect{\noexpand\noexpand\noexpand}%
- \edef\@tempa{\write\@auxout{\string
- \newsublabel{#1}{{}{\thepage}}}}%
- \expandafter}\@tempa
- \if@nobreak \ifvmode\nobreak\fi\fi\fi\@esphack}
-\newcommand{\nosublabel}[1]{%
- \@bsphack\if@filesw {\let\thepage\relax
- \def\protect{\noexpand\noexpand\noexpand}%
- \edef\@tempa{\write\@auxout{\string
- \newlabel{#1}{{0}{\thepage}}}}%
- \expandafter}\@tempa
- \if@nobreak \ifvmode\nobreak\fi\fi\fi\@esphack}
-\newcommand\newsublabel{%
- \nw@settrailers
- \global\let\newsublabel\@newsublabel
- \@newsublabel}
-\newcommand{\@newsublabel}[2]{%
- \edef\this@page{\@cdr#2\@nil}%
- \ifx\this@page\last@page\else
- \sub@page=\z@
- \fi
- \edef\last@page{\this@page}
- \advance\sub@page by \@ne
- \ifnum\sub@page=\tw@
- \global\@namedef{2on\this@page}{}%
- \fi
- \pendingsublabel{#1}%
- \edef\@tempa##1{\noexpand\newlabel{##1}%
- {{\number\sub@page}{\this@page}\nw@labeltrailers}}%
- \pending@sublabels
- \def\pending@sublabels{}}
-\newcommand\nw@settrailers{% -- won't work on first run
- \@ifpackageloaded{nameref}%
- {\gdef\nw@labeltrailers{{}{}{}}}%
- {\gdef\nw@labeltrailers{}}}
-\renewcommand\nw@settrailers{%
- \@ifundefined{@secondoffive}%
- {\gdef\nw@labeltrailers{}}%
- {\gdef\nw@labeltrailers{{}{}{}}}}
-\newcommand{\nextchunklabel}[1]{%
- \nwblindhyperanchor{#1}% % looks slightly bogus --- nr
- \@bsphack\if@filesw {\let\thepage\relax
- \edef\@tempa{\write\@auxout{\string\pendingsublabel{#1}}}%
- \expandafter}\@tempa
- \if@nobreak \ifvmode\nobreak\fi\fi\fi\@esphack}
-\newcommand\pendingsublabel[1]{%
- \def\@tempa{\noexpand\@tempa}%
- \edef\pending@sublabels{\noexpand\@tempa{#1}\pending@sublabels}}
-\def\pending@sublabels{}
-\def\last@page{\relax}
-\newcount\sub@page
-\def\@alphasubpagenum#1#2{#2\ifnum#1=0 \else\@alph{#1}\fi}
-\def\@nosubpagenum#1#2{#2}
-\def\@numsubpagenum#1#2{#2\ifnum#1=0 \else.\@arabic{#1}\fi}
-\def\nwopt@nosubpage{\let\nwthepagenum=\@nosubpagenum\nwopt@nomargintag}
-\def\nwopt@numsubpage{\let\nwthepagenum=\@numsubpagenum}
-\def\nwopt@alphasubpage{\let\nwthepagenum=\@alphasubpagenum}
-\nwopt@alphasubpage
-\newcount\@nwalph@n
-\let\@nwalph@d\@tempcnta
-\let\@nwalph@bound\@tempcntb
-\def\@nwlongalph#1{{%
- \@nwalph@n=#1\advance\@nwalph@n by-1
- \@nwalph@bound=26
- \loop\ifnum\@nwalph@n<\@nwalph@bound\else
- \advance\@nwalph@n by -\@nwalph@bound
- \multiply\@nwalph@bound by 26
- \repeat
- \loop\ifnum\@nwalph@bound>1
- \divide\@nwalph@bound by 26
- \@nwalph@d=\@nwalph@n\divide\@nwalph@d by \@nwalph@bound
- % d := d * bound ; n -:= d; d := d / bound --- saves a temporary
- \multiply\@nwalph@d by \@nwalph@bound
- \advance\@nwalph@n by -\@nwalph@d
- \divide\@nwalph@d by \@nwalph@bound
- \advance\@nwalph@d by 1 \@alph{\@nwalph@d}%
- \repeat
-}}
-\newcount\nw@chunkcount
-\nw@chunkcount=\@ne
-\newcommand{\weblabel}[1]{%
- \@bsphack
- \nwblindhyperanchor{#1}%
- \if@filesw {\let\thepage\relax
- \def\protect{\noexpand\noexpand\noexpand}%
- \edef\@tempa{\write\@auxout{\string
- \newsublabel{#1}{{}{\number\nw@chunkcount}}}}%
- \expandafter}\@tempa
- \global\advance\nw@chunkcount by \@ne
- \if@nobreak \ifvmode\nobreak\fi\fi\fi\@esphack}
-\def\nwopt@webnumbering{%
- \let\sublabel=\weblabel
- \def\nwpageword{chunk}\def\nwpagesword{chunks}%
- \def\nwpageprep{in}}
-% \nwindexdefn{printable name}{identifying label}{label of chunk}
-% \nwindexuse{printable name}{identifying label}{label of chunk}
-
-\def\nwindexdefn#1#2#3{\@auxix{\protect\nwixd}{#2}{#3}}
-\def\nwindexuse#1#2#3{\@auxix{\protect\nwixu}{#2}{#3}}
-
-\def\@auxix#1#2#3{% {marker}{id label}{subpage label}
- \@bsphack\if@filesw {\let\nwixd\relax\let\nwixu\relax
- \def\protect{\noexpand\noexpand\noexpand}%
- \edef\@tempa{\write\@auxout{\string\nwixadd{#1}{#2}{#3}}}%
- \expandafter}\@tempa
- \if@nobreak \ifvmode\nobreak\fi\fi\fi\@esphack}
-% \nwixadd{marker}{idlabel}{subpage label}
-\def\nwixadd#1#2#3{%
- \@ifundefined{nwixl@#2}%
- {\global\@namedef{nwixl@#2}{#1{#3}}}%
- {\expandafter\nwix@cons\csname nwixl@#2\endcsname{#1{#3}}}}
-\def\@nwsubscriptident#1#2{\mbox{$\mbox{#1}_{\mathrm{\subpageref{#2}}}$}}
-\def\@nwnosubscriptident#1#2{#1}
-\def\@nwhyperident#1#2{\leavevmode\nwhyperreference{#2}{#1}}
-\def\nwopt@subscriptidents{%
- \let\nwlinkedidentq\@nwsubscriptident
- \let\nwlinkedidentc\@nwsubscriptident
-}
-\def\nwopt@nosubscriptidents{%
- \let\nwlinkedidentq\@nwnosubscriptident
- \let\nwlinkedidentc\@nwnosubscriptident
-}
-\def\nwopt@hyperidents{%
- \let\nwlinkedidentq\@nwhyperident
- \let\nwlinkedidentc\@nwhyperident
-}
-\def\nwopt@nohyperidents{%
- \let\nwlinkedidentq\@nwnosubscriptident
- \let\nwlinkedidentc\@nwnosubscriptident
-}
-\def\nwopt@subscriptquotedidents{%
- \let\nwlinkedidentq\@nwsubscriptident
-}
-\def\nwopt@nosubscriptquotedidents{%
- \let\nwlinkedidentq\@nwnosubscriptident
-}
-\def\nwopt@hyperquotedidents{%
- \let\nwlinkedidentq\@nwhyperident
-}
-\def\nwopt@nohyperquotedidents{%
- \let\nwlinkedidentq\@nwnosubscriptident
-}
-\nwopt@hyperidents
-\newcount\@commacount
-\def\commafy#1{%
- {\nwix@listcount{#1}\@commacount=\nwix@counter
- \let\@comma@each=\\%
- \ifcase\@commacount\let\\=\@comma@each\or\let\\=\@comma@each\or
- \def\\{\def\\{ \@nwlangdepand\ \@comma@each}\@comma@each}\else
- \def\\{\def\\{, %
- \advance\@commacount by \m@ne
- \ifnum\@commacount=1 \@nwlangdepand~\fi\@comma@each}\@comma@each}\fi
- #1}}
-\def\nwix@cons#1#2{% {list}{\marker{element}}
- {\toks0=\expandafter{#1}\def\@tempa{#2}\toks2=\expandafter{\@tempa}%
- \xdef#1{\the\toks0 \the\toks2 }}}
-\def\nwix@uses#1{% {label}
- \def\nwixu{\\}\let\nwixd\@gobble\@nameuse{nwixl@#1}}
-\def\nwix@defs#1{% {label}
- \def\nwixd{\\}\let\nwixu\@gobble\@nameuse{nwixl@#1}}
-\newcount\nwix@counter
-\def\nwix@listcount#1{% {list with \\}
- {\count@=0
- \def\\##1{\advance\count@ by \@ne }%
- #1\global\nwix@counter=\count@ }}
-\def\nwix@usecount#1{\nwix@listcount{\nwix@uses{#1}}}
-\def\nwix@defcount#1{\nwix@listcount{\nwix@defs{#1}}}
-\def\nwix@id@defs#1{% index pair
- {{\Tt \@car#1\@nil}%
- \def\\##1{\nwix@defs@space\subpageref{##1}}\nwix@defs{\@cdr#1\@nil}}}
- % useful above to change ~ into something that can break
-% this option is undocumented because I think breakdefs is always right
-\def\nwopt@breakdefs{\def\nwix@defs@space{\penalty200\ }}
-\def\nwopt@nobreakdefs{\def\nwix@defs@space{~}} % old code
-\nwopt@breakdefs
-\def\nwidentuses#1{% list of index pairs
- \nwcodecomment{\@nwlangdepuss\ \let\\=\nwix@id@defs\commafy{#1}.}}
-\def\nwix@totaluses#1{% list of index pairs
- {\count@=0
- \def\\##1{\nwix@usecount{\@cdr##1\@nil}\advance\count@ by\nwix@counter}%
- #1\global\nwix@counter\count@ }}
-\def\nwix@id@uses#1#2{% {ident}{label}
- \nwix@usecount{#2}\ifnum\nwix@counter>0
- {\advance\leftskip by \codemargin
- \nwcodecomment{{\Tt #1}, \@nwlangdepusd\ \nwpageprep\ \@pagesl{\nwix@uses{#2}}.}}%
- \else
- \ifnw@hideunuseddefs\else
- {\advance\leftskip by \codemargin \nwcodecomment{{\Tt #1}, \@nwlangdepnvu.}}%
- \fi
- \fi}
-\def\nwidentdefs#1{% list of index pairs
- \ifnw@hideunuseddefs\nwix@totaluses{#1}\else\nwix@listcount{#1}\fi
- \ifnum\nwix@counter>0
- \nwcodecomment{\@nwlangdepdfs:}%
- {\def\\##1{\nwix@id@uses ##1}#1}%
- \fi}
-\newif\ifnw@hideunuseddefs\nw@hideunuseddefsfalse
-\def\nwopt@hideunuseddefs{\nw@hideunuseddefstrue}
-\def\nwopt@noidentxref{%
- \let\nwidentdefs\@gobble
- \let\nwidentuses\@gobble}
-\def\nw@underlinedefs{% {list with \nwixd, \nwixu}
- \let\\=\relax\def\nw@comma{, }
- \def\nwixd##1{\\\underline{\subpageref{##1}}\let\\\nw@comma}%
- \def\nwixu##1{\\\subpageref{##1}\let\\\nw@comma}}
-
-\def\nw@indexline#1#2{%
- {\indent {\Tt #1}: \nw@underlinedefs\@nameuse{nwixl@#2}\par}}
-
-\newenvironment{thenowebindex}{\parindent=-10pt \parskip=\z@
- \advance\leftskip by 10pt
- \advance\rightskip by 0pt plus1in\par\@afterindenttrue
- \def\\##1{\nw@indexline##1}}{}
-\def\nowebindex{%
- \@ifundefined{nwixs@i}%
- {\@warning{The \string\nowebindex\space is empty}}%
- {\begin{thenowebindex}\@nameuse{nwixs@i}\end{thenowebindex}}}
-\def\nowebindex@external{%
- {\let\nwixadds@c=\@gobble
- \def\nwixadds@i##1{\nw@indexline##1}%
- \def\nwixaddsx##1##2{\@nameuse{nwixadds@##1}{##2}}%
- \begin{thenowebindex}\@input{\jobname.nwi}\end{thenowebindex}}}
-\def\nwixlogsorted#1#2{% list data
- \@bsphack\if@filesw
- \toks0={#2}\immediate\write\@auxout{\string\nwixadds{#1}{\the\toks0}}
- \if@nobreak \ifvmode\nobreak\fi\fi\fi\@esphack}
-\def\nwixadds#1#2{%
- \@ifundefined{nwixs@#1}%
- {\global\@namedef{nwixs@#1}{\\{#2}}}%
- {\expandafter\nwix@cons\csname nwixs@#1\endcsname{\\{#2}}}}
-\let\nwixaddsx=\@gobbletwo
-\def\nwopt@externalindex{%
- \ifx\nwixadds\@gobbletwo % already called
- \else
- \let\nwixaddsx=\nwixadds \let\nwixadds=\@gobbletwo
- \let\nowebindex=\nowebindex@external
- \let\nowebchunks=\nowebchunks@external
- \fi}
-\def\nowebchunks{%
- \@ifundefined{nwixs@c}%
- {\@warning{The are no \string\nowebchunks}}%
- {\begin{thenowebchunks}\@nameuse{nwixs@c}\end{thenowebchunks}}}
-\def\nowebchunks@external{%
- {\let\nwixadds@i=\@gobble
- \def\nwixadds@c##1{\nw@onechunk##1}%
- \def\nwixaddsx##1##2{\@nameuse{nwixadds@##1}{##2}}%
- \begin{thenowebchunks}\@input{\jobname.nwi}\end{thenowebchunks}}}
- \@namedef{r@nw@notdef}{{0}{(\@nwlangdepnvd)}}
-\def\nw@chunkunderlinedefs{% {list of labels with \nwixd, \nwixu}
- \let\\=\relax\def\nw@comma{, }
- \def\nwixd##1{\\\underline{\subpageref{##1}}\let\\\nw@comma}%
- \def\nwixu##1{\\\subpageref{##1}\let\\\nw@comma}}
-\def\nw@onechunk#1#2#3{% {name}{label of first definition}{list with \nwixd, \nwixu}
- \@ifundefined{r@#2}{}{%
- \indent\LA #1~{\nwtagstyle\subpageref{#2}}\RA
- \if@nwlongchunks{~\nw@chunkunderlinedefs#3}\fi\par}}
-\newenvironment{thenowebchunks}{\vskip3pt
- \parskip=\z@\parindent=-10pt \advance\leftskip by 10pt
- \advance\rightskip by 0pt plus10pt \@afterindenttrue
- \def\\##1{\nw@onechunk##1}}{}
-\newif\if@nwlongchunks
-\@nwlongchunksfalse
-\let\nwopt@longchunks\@nwlongchunkstrue
-\newcommand\@nw@hyper@ref{\hyperreference} % naras
-\newcommand\@nw@hyper@anc{\blindhyperanchor} % naras
-\newcommand\@nw@hyperref@ref[2]{\hyperlink{noweb.#1}{#2}} % nr
-\newcommand\@nw@hyperref@anc[1]{\hypertarget{noweb.#1}{\relax}} % nr
-%%\renewcommand\@nw@hyperref@ref[2]{{#2}} % nr
-%%\renewcommand\@nw@hyperref@anc[1]{} % nr
-\newcommand\nwhyperreference{%
- \@ifundefined{hyperlink}
- {\@ifundefined{hyperreference}
- {\global\let\nwhyperreference\@gobble}
- {\global\let\nwhyperreference\@nw@hyper@ref}}
- {\global\let\nwhyperreference\@nw@hyperref@ref}%
- \nwhyperreference
-}
-
-\newcommand\nwblindhyperanchor{%
- \@ifundefined{hyperlink}
- {\@ifundefined{hyperreference}
- {\global\let\nwblindhyperanchor\@gobble}
- {\global\let\nwblindhyperanchor\@nw@hyper@anc}}
- {\global\let\nwblindhyperanchor\@nw@hyperref@anc}%
- \nwblindhyperanchor
-}
-\newcommand\nwanchorto{%
- \begingroup\let\do\@makeother\dospecials
- \catcode`\{=1 \catcode`\}=2 \nw@anchorto}
-\newcommand\nw@anchorto[1]{\endgroup\def\nw@next{#1}\nw@anchortofin}
-\newcommand\nw@anchortofin[1]{#1\footnote{See URL \texttt{\nw@next}.}}
-\let\nwanchorname\@gobble
-\newif\ifhtml
-\htmlfalse
-\let\nwixident=\relax
-\def\nwbackslash{\char92}
-\def\nwlbrace{\char123}
-\def\nwrbrace{\char125}
-\def\nwopt@english{%
- \def\@nwlangdepdef{This definition is continued}%
- \def\@nwlangdepcud{This code is used}%
- \def\@nwlangdeprtc{Root chunk (not used in this document)}%
- \def\@nwlangdepcwf{This code is written to file}%
- \def\@nwlangdepchk{chunk}%
- \def\@nwlangdepchks{chunks}%
- \def\@nwlangdepin{in}%
- \def\@nwlangdepand{and}%
- \def\@nwlangdepuss{Uses}%
- \def\@nwlangdepusd{used}%
- \def\@nwlangdepnvu{never used}%
- \def\@nwlangdepdfs{Defines}%
- \def\@nwlangdepnvd{never defined}%
-}
-\let\nwopt@american\nwopt@english
-\def\nwopt@portuges{%
- \def\@nwlangdepdef{Defini\c{c}\~ao continuada em}%
- % This definition is continued
- \def\@nwlangdepcud{C\'odigo usado em}%
- % This code is used
- \def\@nwlangdeprtc{Fragmento de topo (sem uso no documento)}%
- % Root chunk (not used in this document)
- \def\@nwlangdepcwf{Este c\'odigo foi escrito no ficheiro}%
- % This code is written to file
- \def\@nwlangdepchk{fragmento}%
- % chunk
- \def\@nwlangdepchks{fragmentos}%
- % chunks
- \def\@nwlangdepin{no(s)}%
- % in
- \def\@nwlangdepand{e}%
- % and
- \def\@nwlangdepuss{Usa}%
- % Uses
- \def\@nwlangdepusd{usado}%
- % used
- \def\@nwlangdepnvu{nunca usado}%
- % never used
- \def\@nwlangdepdfs{Define}%
- % Defines
- \def\@nwlangdepnvd{nunca definido}%
- % never defined
-}
-\def\nwopt@frenchb{%
- \def\@nwlangdepdef{Cette d\'efinition suit}%
- % This definition is continued
- \def\@nwlangdepcud{Ce code est employ\'e}%
- % This code is used
- \def\@nwlangdeprtc{Morceau racine (pas employ\'e dans ce document)}%
- % Root chunk (not used in this document)
- \def\@nwlangdepcwf{Ce code est \'ecrit aux fichier}%
- % This code is written to file
- \def\@nwlangdepchk{le morceau}%
- % chunk
- \def\@nwlangdepchks{les morceaux}%
- % chunks
- \def\@nwlangdepin{dans}%
- % in
- \def\@nwlangdepand{et}%
- % and
- \def\@nwlangdepuss{Il emploie}%
- % Uses
- \def\@nwlangdepusd{employ\'{e}}%
- % used
- \def\@nwlangdepnvu{jamais employ\'{e}}%
- % never used
- \def\@nwlangdepdfs{Il d\'{e}fine}%
- % Defines
- % Cannot use the accent here: \def\@nwlangdepnvd{jamais d\'{e}fini}%
- \def\@nwlangdepnvd{jamais defini}%
- % never defined
-}
-\let\nwopt@french\nwopt@frenchb
-\def\nwopt@german{%
- \def\@nwlangdepdef{Diese Definition wird fortgesetzt}%
- % This definition is continued
- \def\@nwlangdepcud{Dieser Code wird benutzt}%
- % This code is used
- \def\@nwlangdeprtc{Hauptteil (nicht in diesem Dokument benutzt)}%
- % Root chunk (not used in this document)
- \def\@nwlangdepcwf{Dieser Code schreibt man zum File}%
- % This code is written to file
- \def\@nwlangdepchk{Teil}%
- % chunk
- \def\@nwlangdepchks{Teils}%
- % chunks
- \def\@nwlangdepin{im}%
- % in
- \def\@nwlangdepand{und}%
- % and
- \def\@nwlangdepuss{Benutzt}%
- % Uses
- \def\@nwlangdepusd{benutzt}%
- % used
- \def\@nwlangdepnvu{nicht benutzt}%
- % never used
- \def\@nwlangdepdfs{Definiert}%
- % Defines
- \def\@nwlangdepnvd{nicht definiert}%
- % never defined
-}
-\let\nwopt@ngerman\nwopt@german
-\ifx\languagename\undefined % default is English
- \noweboptions{english}
-\else
- \@ifundefined{nwopt@\languagename}
- {\noweboptions{english}}
- {\expandafter\noweboptions\expandafter{\languagename}}
-\fi
Index: branches/ohl/omega-development/hgg-vertex/share/doc/bhabha.eps
===================================================================
--- branches/ohl/omega-development/hgg-vertex/share/doc/bhabha.eps (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/share/doc/bhabha.eps (revision 8717)
@@ -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/hgg-vertex/share/doc/modules.eps
===================================================================
--- branches/ohl/omega-development/hgg-vertex/share/doc/modules.eps (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/share/doc/modules.eps (revision 8717)
@@ -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/hgg-vertex/share/doc/emp.sty
===================================================================
--- branches/ohl/omega-development/hgg-vertex/share/doc/emp.sty (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/share/doc/emp.sty (revision 8717)
@@ -1,239 +0,0 @@
-%%
-%% This is file `emp.sty',
-%% generated with the docstrip utility.
-%%
-%% The original source files were:
-%%
-%% emp.dtx (with options: `style')
-%%
-%% Copyright (C) 1997-1999 Thorsten Ohl <ohl@hep.tu-darmstadt.de>
-%%
-%% This file is NOT the source for emp, because almost all comments
-%% have been stripped from it. It is NOT the preferred form of emp
-%% for making modifications to it.
-%%
-%% Therefore you can NOT redistribute and/or modify THIS file. You can
-%% however redistribute the complete source (emp.dtx and emp.ins)
-%% 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.
-%%
-%% As a special exception, you can redistribute parts of this file for
-%% the electronic distribution of scientific papers, provided that you
-%% include a short note pointing to the complete source.
-%%
-%% Emp 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.
-%%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% \CheckSum{353}
-%% \CharacterTable
-%% {Upper-case \A\B\C\D\E\F\G\H\I\J\K\L\M\N\O\P\Q\R\S\T\U\V\W\X\Y\Z
-%% Lower-case \a\b\c\d\e\f\g\h\i\j\k\l\m\n\o\p\q\r\s\t\u\v\w\x\y\z
-%% Digits \0\1\2\3\4\5\6\7\8\9
-%% Exclamation \! Double quote \" Hash (number) \#
-%% Dollar \$ Percent \% Ampersand \&
-%% Acute accent \' Left paren \( Right paren \)
-%% Asterisk \* Plus \+ Comma \,
-%% Minus \- Point \. Solidus \/
-%% Colon \: Semicolon \; Less than \<
-%% Equals \= Greater than \> Question mark \?
-%% Commercial at \@ Left bracket \[ Backslash \\
-%% Right bracket \] Circumflex \^ Underscore \_
-%% Grave accent \` Left brace \{ Vertical bar \|
-%% Right brace \} Tilde \~}
-%%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\def\fileversion{v1.02}
-\NeedsTeXFormat{LaTeX2e}
-{\def\RCS#1#2\endRCS{%
- \ifx$#1%
- \@RCS $#2 \endRCS
- \else
- \@RCS $*: #1#2$ \endRCS
- \fi}%
- \def\@RCS $#1: #2,v #3 #4 #5 #6 #7$ \endRCS{%
- \gdef\filename{#2}%
- \gdef\filerevision{#3}%
- \gdef\filedate{#4}%
- \gdef\filemaintainer{#6}}%
-\RCS $Id: emp.dtx,v 1.16 1999/11/12 10:43:19 ohl Exp $ \endRCS}%
-\ProvidesPackage{emp}[\filedate\space\fileversion\space
- Encapsulated MetaPost LaTeX Package (\filemaintainer)]
-\DeclareOption*{\PassOptionsToPackage{\CurrentOption}{graphics}}
-\ProcessOptions
-\RequirePackage{graphics}[1994/12/15]
-\RequirePackage{verbatim}
-{\catcode`\%=11\gdef\p@rcent{%}}
-\def\empwrite#1{%
- \if@empio
- \immediate\write\@outemp{#1}%
- \fi
- \ignorespaces}
-\newif\if@empio
-\@empiotrue
-\newwrite\@outemp
-\def\empcmd#1{%
- \empbuf@={#1}%
- \empwrite{\the\empbuf@}}
-\newtoks\empbuf@
-\newcommand{\empfile}[1][\jobname]{%
- \def\theempfile{#1}%
- \if@empio
- \@ifundefined{ifmeasuring@}%
- {}%
- {\def\if@empio{\ifmeasuring@\else}}%
- \immediate\openout\@outemp=\theempfile.mp\relax
- \empwrite{\p@rcent\p@rcent\p@rcent\space \theempfile.mp -- %
- do not edit, generated automatically by \jobname.tex}%
- \expandafter\ifx\expandafter*\the\emp@TeX*\else
- \emp@TeX=\expandafter{\the\emp@TeX^^J\begin{document}}%
- \empwrite{verbatimtex^^J\the\emp@TeX^^Jetex;}%
- \fi
- \expandafter\ifx\expandafter*\the\emp@prelude*\else
- \empwrite{\the\emp@prelude;}%
- \fi
- \fi
- \setcounter{empfig}{0}}
-\let\theempfile\relax
-\newcounter{empfig}
-\newtoks\emp@TeX
-\newtoks\emp@prelude
-\@ifundefined{@ptsize}%
- {\emp@TeX={\documentclass{article}}}%
- {\ifcase\@ptsize
- \emp@TeX={\documentclass[10pt]{article}}%
- \or
- \emp@TeX={\documentclass[11pt]{article}}%
- \or
- \emp@TeX={\documentclass[12pt]{article}}%
- \else
- \emp@TeX={\documentclass{article}}%
- \fi}
-\def\empTeX#1{\emp@TeX={#1}}
-\def\empaddtoTeX#1{\emp@TeX=\expandafter{\the\emp@TeX^^J#1}}
-\def\empprelude#1{\emp@prelude={#1}}
-\def\empaddtoprelude#1{\emp@prelude=\expandafter{\the\emp@prelude^^J#1}}
-\def\endempfile{%
- \expandafter\ifx\expandafter*\the\emp@TeX*\else
- \empwrite{verbatimtex^^J\string\end{document}^^Jetex;}%
- \fi
- \empwrite{\p@rcent\p@rcent\p@rcent\space the end.^^J%
- end.^^J%
- endinput;}%
- \let\theempfile\relax
- \if@empio
- \immediate\closeout\@outemp
- \fi}
-\newcommand{\emp}[1][*]{%
- \def\emp@@name{#1}%
- \emp@}
-\newcommand{\empx}[1][*]{%
- \def\emp@@name{#1}%
- \empx@}
-\def\emp@(#1,#2){%
- \emp@start{#1}{#2}%
- \emp@includegraphics{\theempfile}{\theempfig}%
- \empcmds}
-\def\empx@(#1,#2){%
- \emp@start{#1}{#2}%
- \emp@includegraphics{\theempfile}{\theempfig}%
- \begingroup
- \@bsphack}
-\def\emp@start#1#2{%
- \emp@checkfile
- \global\expandafter\advance\csname c@empfig\endcsname \@ne
- \emp@@def{\emp@@name}%
- \empwrite{beginfig(\theempfig);^^J%
- LaTeX_unitlength := \the\unitlength;^^J%
- w := #1*LaTeX_unitlength;^^J%
- h := #2*LaTeX_unitlength;}}
-\def\emp@checkfile{%
- \ifx\theempfile\relax
- \errhelp={Outside a empfile environment, I have no clue as to where^^J%
- the MetaPost commands should go. I will use empdefault.mp^^J%
- for this graph, but you'd better fix your code!}%
- \errmessage{I detected a emp environment outside of empfile}%
- \empfile[empdefault]
- \fi}
-\def\emp@includegraphics#1#2{%
- \leavevmode
- \IfFileExists{#1.#2}%
- {\includegraphics{#1.#2}}%
- {\typeout{%
- emp: File #1.#2\space not found:^^J%
- emp: Process #1.mp with MetaPost and then %
- reprocess this file.}}}
-\def\empcmds{%
- \begingroup
- \@bsphack
- \let\do\@makeother\dospecials
- \catcode`\^^M\active
- \def\verbatim@processline{\empwrite{\the\verbatim@line}}%
- \verbatim@start}%
-\def\endempcmds{%
- \@esphack
- \endgroup}
-\def\endemp{%
- \endempcmds
- \empwrite{endfig;}}
-\def\endempx{%
- \@esphack
- \endgroup
- \empwrite{endfig;}}
-\newcommand{\empdef}[1][\relax]{%
- \def\emp@@name{#1}%
- \emp@def}
-\newcommand{\empxdef}[1][\relax]{%
- \def\emp@@name{#1}%
- \empx@def}
-\def\emp@def(#1,#2){%
- \emp@start{#1}{#2}%
- \empcmds}
-\def\empx@def(#1,#2){%
- \emp@start{#1}{#2}%
- \begingroup
- \@bsphack}
-\def\endempdef{\endemp}
-\def\endempdef{\endempx}
-\def\emp@@def#1{%
- \global\e@namedef{emp@k:f:#1}{\theempfile}%
- \global\e@namedef{emp@k:c:#1}{\theempfig}}
-\def\e@namedef#1{\expandafter\edef\csname #1\endcsname}
-\newcommand{\empgraph}[1][*]{%
- \def\emp@@name{#1}%
- \emp@graph}
-\newcommand{\empxgraph}[1][*]{%
- \def\emp@@name{#1}%
- \empx@graph}
-\def\emp@graph(#1,#2){%
- \emp@start{#1}{#2}%
- \empwrite{draw begingraph (w, h);}%
- \emp@includegraphics{\theempfile}{\theempfig}%
- \empcmds}
-\def\empx@graph(#1,#2){%
- \emp@start{#1}{#2}%
- \empwrite{draw begingraph (w, h);}%
- \emp@includegraphics{\theempfile}{\theempfig}%
- \begingroup
- \@bsphack}
-\def\endempgraph{%
- \endempcmds
- \empwrite{endgraph;^^Jendfig;}}
-\def\endempxgraph{%
- \@esphack
- \endgroup
- \empwrite{endgraph;^^Jendfig;}}
-\def\empuse#1{%
- \@ifundefined{emp@k:f:#1}%
- {\typeout{emp: \string\empuse: `#1' undefined!}}%
- {\emp@includegraphics{\@nameuse{emp@k:f:#1}}{\@nameuse{emp@k:c:#1}}}}
-\endinput
-%%
-%% End of file `emp.sty'.
Index: branches/ohl/omega-development/hgg-vertex/share/doc/preview-title.ps.gz
===================================================================
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Index: branches/ohl/omega-development/hgg-vertex/share/doc/el_te_ph.eps
===================================================================
--- branches/ohl/omega-development/hgg-vertex/share/doc/el_te_ph.eps (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/share/doc/el_te_ph.eps (revision 8717)
@@ -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/hgg-vertex/share/doc/epemudbarmunumubar0.eps
===================================================================
--- branches/ohl/omega-development/hgg-vertex/share/doc/epemudbarmunumubar0.eps (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/share/doc/epemudbarmunumubar0.eps (revision 8717)
@@ -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/hgg-vertex/share/doc/ocamlweb.sty
===================================================================
--- branches/ohl/omega-development/hgg-vertex/share/doc/ocamlweb.sty (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/share/doc/ocamlweb.sty (revision 8717)
@@ -1,255 +0,0 @@
-% This is ocamlweb.sty, by Jean-Christophe Filliâtre
-% modified by Claude Marché
-% This LaTeX package is used by ocamlweb (http://www.lri.fr/~filliatr/ocamlweb)
-%
-% You can modify the following macros to customize the appearance
-% of the document.
-
-\newif\iflatexsectioning\latexsectioningfalse
-% the following comment tells HeVeA to ignore all this until END LATEX
-%BEGIN LATEX
-
-\NeedsTeXFormat{LaTeX2e}
-\ProvidesPackage{ocamlweb}[1999/05/21]
-
-% package options
-
-% option for the sectioning style
-% if false, the sectioning is similar to the web sectioning, sections
-% numbered in sequences. If true, structured sectioning is allowed
-% using LaTeX sectioning commands.
-
-\DeclareOption{noweb}{\latexsectioningtrue}
-\DeclareOption{web-sects}{\latexsectioningfalse}
-
-% option for visible spaces
-
-\newif\ifvisiblespaces\visiblespacestrue
-\DeclareOption{novisiblespaces}{\visiblespacesfalse}
-
-% option for index by pages
-
-\newif\ifbypage\bypagetrue
-\DeclareOption{bypages}{\bypagetrue}
-\DeclareOption{bysections}{\bypagefalse}
-
-\ProcessOptions
-
-% needed to make hypertex work
-\AtBeginDocument{\let\Hy@tempa\relax}
-
-%END LATEX
-% HeVeA reads the following
-
-% Hevea puts to much space with \medskip and \bigskip
-%HEVEA\renewcommand{\medskip}{}
-%HEVEA\renewcommand{\bigskip}{}
-
-% own name
-\newcommand{\ocamlweb}{\textsf{ocamlweb}}
-
-% pretty underscores (the package fontenc causes ugly underscores)
-%BEGIN LATEX
-\def\_{\kern.08em\vbox{\hrule width.35em height.6pt}\kern.08em}
-%END LATEX
-
-% Bigger underscore for ocamllex files (lexers).
-\newcommand{\ocwlexwc}{\textnormal{\large \_\,}}
-
-% macro for typesetting ocamllex keywords and for regexp and rule idents
-\newcommand{\ocwlexkw}[1]{\textsf{#1}}
-\newcommand{\ocwlexident}[1]{\ensuremath{\mathit{#1\/}}}
-
-% macro for typesetting ocamlyacc keywords and for non-terminals and tokens
-\newcommand{\ocwyacckw}[1]{\textsf{#1}}
-\newcommand{\ocwyaccident}[1]{\ensuremath{\mathit{#1\/}}}
-
-% macro for typesetting keywords
-\newcommand{\ocwkw}[1]{\textsf{#1}}
-
-% macro for typesetting base types (int, bool, string, etc.)
-\newcommand{\ocwbt}[1]{\textit{#1\/}}
-
-% macro for typesetting type variables
-\newcommand{\ocwtv}[1]{\textit{'#1\/}}
-
-% macro for typesetting identifiers
-\newcommand{\ocwsymbolid}[1]{{#1}}
-
-\newcommand{\ocwlowerid}[1]{\ensuremath{\mathit{#1\/}}}
-\newcommand{\ocwupperid}[1]{\ensuremath{\mathit{#1\/}}}
-
-% macros for typesetting constants
-\newcommand{\ocwhexconst}[1]{\ensuremath{\mathtt{#1}_{16}}}
-\newcommand{\ocwoctconst}[1]{\ensuremath{#1_8}}
-\newcommand{\ocwbinconst}[1]{\ensuremath{#1_2}}
-
-\newcommand{\ocwfloatconst}[2]{\ensuremath{#1\cdot 10^{#2}}}
-\newcommand{\ocwfloatconstexp}[1]{\ensuremath{10^{#1}}}
-
-% newline, and indentation
-%BEGIN LATEX
-\newcommand{\ocweol}{\setlength\parskip{0pt}\par\penalty5000}
-\newcommand{\ocwindent}[1]{\noindent\kern#1}
-%END LATEX
-%HEVEA\newcommand{\ocweol}{\begin{rawhtml}<BR>\end{rawhtml}}
-%HEVEA\newcommand{\ocwindent}[1]{\hspace{#1}\hspace{#1}}
-
-% macro for typesetting comments
-\newcommand{\ocwbc}{\ensuremath{(\ast}}
-\newcommand{\ocwec}{\ensuremath{\ast)}}
-% yacc comments
-\newcommand{\ocwbyc}{\ensuremath{/\ast}}
-\newcommand{\ocweyc}{\ensuremath{\ast/}}
-
-% yacc special notations
-\iflatexsectioning
-\newcommand{\ocwyaccrules}{\subsection*{Grammar rules}}
-\newcommand{\ocwyacctrailer}{\subsection*{Trailer}}
-\newcommand{\ocwyaccopercentbrace}{\subsection*{Header}}
-\newcommand{\ocwyacccpercentbrace}{\subsection*{Token declarations}}
-\else
-\newcommand{\ocwyaccrules}{}
-\newcommand{\ocwyacctrailer}{}
-\newcommand{\ocwyaccopercentbrace}{}
-\newcommand{\ocwyacccpercentbrace}{}
-\fi
-\newcommand{\ocwyacccolon}{\ensuremath{::=}}
-\newcommand{\ocwyaccendrule}{}
-\newcommand{\ocwyaccpipe}{\ensuremath{\mid}}
-
-
-%BEGIN LATEX
-\newbox\boxA
-\newbox\boxB
-\newdimen\boxwidth
-\def\ocwcomment{\unskip\hskip 2em\null\par\nointerlineskip
- \setbox\boxA=\lastbox
- \setbox\boxB=\hbox{\strut\unhbox\boxA}\boxwidth=\wd\boxB
- \noindent\box\boxB\par
- \ifdim\boxwidth<.5\hsize\vskip -\baselineskip
- \else\boxwidth=.5\hsize\fi
- \noindent\hangafter=0 \hangindent=\boxwidth
- \llap{$(*$ }\ignorespaces}
-\def\ocwendcomment{\unskip~$*)$\strut\par}
-%END LATEX
-%HEVEA\newcommand{\ocwcomment}{(*}
-%HEVEA\newcommand{\ocwendcomment}{*)}
-
-%BEGIN LATEX
-\def\ocwbegincode{}
-\def\ocwendcode{}
-\def\ocwbegindcode{}
-\def\ocwenddcode{}
-%END LATEX
-%HEVEA\newcommand{\ocwbegincode}{}
-%HEVEA\newcommand{\ocwendcode}{}
-%HEVEA\newcommand{\ocwbegindcode}{}
-%HEVEA\newcommand{\ocwenddcode}{}
-
-%HEVEA\newcommand{\endgraf}{}
-
-\newcommand{\ocwstring}[1]{\texttt{#1}}
-% visible space in a string
-%BEGIN LATEX
-\ifvisiblespaces
-\newcommand{\ocwvspace}{{\tt\char`\ }}
-\else
-\newcommand{\ocwvspace}{{\tt ~}}
-\fi
-%END LATEX
-%HEVEA\newcommand{\ocwvspace}{\hspace{1em}}
-
-% macro to insert a title and to set the header accordingly
-%BEGIN LATEX
-\def\currentmodule{}
-\newcommand{\ocwheader}[1]{\gdef\currentmodule{#1}}
-
-\newcommand{\ocwtitle}[1]{%
- \section*{#1}%
- \def\currentmodule{#1}%
- \addtocounter{ocwcounter}{1}%
- \markboth{}{#1 \hfill {\rm\S\theocwcounter}\quad}%
- \addtocounter{ocwcounter}{-1}%
-}
-%END LATEX
-%HEVEA\newcommand{\ocwtitle}[1]{\section*{#1}}
-
-% macro for typesetting the title of a module implementation
-\newcommand{\ocwmodule}[1]{\ocwtitle{Module #1}}
-
-% macro for typesetting the title of a module interface
-\newcommand{\ocwinterface}[1]{\ocwtitle{Interface for module #1}}
-
-% interface part of a module
-\newcommand{\ocwinterfacepart}{\subsection*{Interface}}
-
-% code part of a module
-\newcommand{\ocwcodepart}{\subsection*{Code}}
-
-% macro for typesetting the title of a lex description
-\newcommand{\ocwlexmodule}[1]{\ocwtitle{Module #1 (Lex)}}
-
-% macro for typesetting the title of a yacc description
-\newcommand{\ocwyaccmodule}[1]{\ocwtitle{Module #1 (Yacc)}}
-
-% new WEB section
-\newcounter{ocwcounter}
-\setcounter{ocwcounter}{0}
-\newcommand{\ocwsection}{%
-\refstepcounter{ocwcounter}%
-\bigskip\noindent{\bf\theocwcounter.}%
-%BEGIN LATEX
-\markboth{}{\currentmodule \hfill {\rm\S\theocwcounter}\quad}%
-\kern1em%
-%END LATEX
-%HEVEA\hspace{1em}
-}
-%HEVEA\newcommand{\currentmodule}{}
-
-% index
-%BEGIN LATEX
-\newcommand{\ocwbeginindex}{%
- \markboth{}{Index \hfill {\rm\S\theocwcounter}\quad}%
- \begin{theindex}%
-}%
-\newcommand{\ocwendindex}{\end{theindex}}
-%END LATEX
-%HEVEA\newcommand{\ocwbeginindex}{\section{Index}\begin{itemize}}
-%HEVEA\newcommand{\ocwendindex}{\end{itemize}}
-
-% index entry in web-sects option
-\newcommand{\ocwwebindexentry}[3]{\item #1,\quad#2#3}
-
-% index entry in noweb option
-
-%BEGIN LATEX
-\def\loopbody{%
-\edef\ocwnext{%
-\@ifundefined{r@\ocwloop}{??}{\ifbypage\pageref{\ocwloop}\else
- \ref{\ocwloop}\fi}}%
-\ifx\ocwprevious\ocwnext\relax
-\else
-\ocwsep\ocwoutputref{\ocwnext}%
-\edef\ocwprevious{\ocwnext}%
-\def\ocwsep{, }%
-\fi}
-
-\newcommand{\ocwrefindexentry}[5]{\item #1,\quad
-\def\ocwsep{\relax}%
-\def\ocwoutputref{\textbf}%
-\def\ocwprevious{0}%
-\@for\ocwloop:=#2\do{\loopbody}%
-\def\ocwoutputref{\textrm}%
-\def\ocwprevious{0}%
-\@for\ocwloop:=#3\do{\loopbody}%
-}
-%END LATEX
-%HEVEA\newcommand{\ocwrefindexentry}[5]{\item #1,\quad#4, #5}
-
-
-%HEVEA\newcommand{\lnot}{\ocwkw{not}}
-%HEVEA\newcommand{\lor}{\ocwkw{or}}
-%HEVEA\newcommand{\land}{\&}
-%HEVEA\newcommand{\markboth}{}{}
-
Index: branches/ohl/omega-development/hgg-vertex/share/doc/epemudbardubar.eps
===================================================================
--- branches/ohl/omega-development/hgg-vertex/share/doc/epemudbardubar.eps (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/share/doc/epemudbardubar.eps (revision 8717)
@@ -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/hgg-vertex/share/doc/feynmp.mp
===================================================================
--- branches/ohl/omega-development/hgg-vertex/share/doc/feynmp.mp (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/share/doc/feynmp.mp (revision 8717)
@@ -1,2029 +0,0 @@
-%%
-%% This is file `feynmp.mp',
-%% generated with the docstrip utility.
-%%
-%% The original source files were:
-%%
-%% feynmf.dtx (with options: `base,mp')
-%%
-%% Copyright (C) 1989, 1990, 1992-1995 by Thorsten.Ohl@Physik.TH-Darmstadt.de
-%%
-%% This file is NOT the source for feynmf, because almost all comments
-%% have been stripped from it. It is NOT the preferred form of feynmf
-%% for making modifications to it.
-%%
-%% Therefore you can NOT redistribute and/or modify THIS file. You can
-%% however redistribute the complete source (feynmf.dtx and feynmf.ins)
-%% 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.
-%%
-%% As a special exception, you can redistribute parts of this file for
-%% the electronic distribution of scientific papers, provided that you
-%% include a short note pointing to the complete source.
-%%
-%% Feynmf 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.
-%%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% \CheckSum{928}
-%% \CharacterTable
-%% {Upper-case \A\B\C\D\E\F\G\H\I\J\K\L\M\N\O\P\Q\R\S\T\U\V\W\X\Y\Z
-%% Lower-case \a\b\c\d\e\f\g\h\i\j\k\l\m\n\o\p\q\r\s\t\u\v\w\x\y\z
-%% Digits \0\1\2\3\4\5\6\7\8\9
-%% Exclamation \! Double quote \" Hash (number) \#
-%% Dollar \$ Percent \% Ampersand \&
-%% Acute accent \' Left paren \( Right paren \)
-%% Asterisk \* Plus \+ Comma \,
-%% Minus \- Point \. Solidus \/
-%% Colon \: Semicolon \; Less than \<
-%% Equals \= Greater than \> Question mark \?
-%% Commercial at \@ Left bracket \[ Backslash \\
-%% Right bracket \] Circumflex \^ Underscore \_
-%% Grave accent \` Left brace \{ Vertical bar \|
-%% Right brace \} Tilde \~}
-%%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-def subgraph (expr x, y, wd, ht) =
- begingroup
- save c, ne, nw, sw, se;
- pair c, ne, nw, sw, se;
- sw = (x,y);
- se = sw + (wd,0);
- nw = sw + (0,ht);
- ne = sw + (wd,ht);
- c = .5[sw,ne];
-enddef;
-def endsubgraph =
- endgroup
-enddef;
-if known cmbase:
- errhelp
- "feynmf will only work with plain Metafont, as described in the book.";
- errmessage "feynmf: CMBASE detected. Please use the PLAIN base.";
- forever:
- errmessage "No use in trying! You'd better eXit now ...";
- errorstopmode;
- endfor
-fi
-vardef parse_RCS (suffix RCS) (expr s) =
- save n, c;
- numeric n, RCS[];
- string c;
- RCS[0] := 0;
- for n = 1 upto length (s):
- c := substring (n-1,n) of s;
- exitif ((RCS[0] > 0) and (c = " "));
- if ((c = "0") or (c = "1") or (c = "2")
- or (c = "3") or (c = "4") or (c = "5")
- or (c = "6") or (c = "7") or (c = "8")
- or (c = "9")):
- if RCS[0] = 0:
- RCS[0] := 1;
- RCS[RCS[0]] := 0;
- fi
- RCS[RCS[0]] := 10 * RCS[RCS[0]] + scantokens (c);
- elseif c = ".":
- RCS[0] := RCS[0] + 1;
- RCS[RCS[0]] := 0;
- else:
- fi
- endfor
-enddef;
-vardef require_RCS_revision expr s =
- save n, TeX_rev, mf_rev;
- numeric n;
- parse_RCS (TeX_rev, s);
- parse_RCS (mf_rev, "$Revision: 1.32 $");
- for n = 1 upto min (2, TeX_rev[0], mf_rev[0]):
- if TeX_rev[n] > mf_rev[n]:
- errhelp
- "Your version of `feynmf.sty' is higher that of your `feynmf.mf'.";
- errmessage "feynmf: Metafont macros out of date";
- elseif TeX_rev[n] < mf_rev[n]:
- errhelp
- "Your version of `feynmf.mf' is higher that of your `feynmf.sty'.";
- errmessage "feynmf: LaTeX style out of date";
- fi
- exitif (TeX_rev[n] <> mf_rev[n]);
- endfor
-enddef;
-vardef cullit = \ enddef;
-color foreground;
-foreground = black;
-vardef beginchar (expr c, wd, ht, dp) =
- LaTeX_file := "";
- beginfig(c);
- w:=wd;
- h:=ht;
-enddef;
-string LaTeX_file;
-vardef endchar =
- setbounds currentpicture to (0,0)--(w,0)--(w,h)--(0,h)--cycle;
- if LaTeX_file <> "":
- write EOF to LaTeX_file;
- LaTeX_file := "";
- fi
- endfig
-enddef;
-bp# := bp;
-cc# := cc;
-cm# := cm;
-dd# := dd;
-in# := in;
-mm# := mm;
-pc# := pc;
-pt# := pt;
-vardef define_blacker_pixels(text t) =
- forsuffixes $=t:
- $:=$.#;
- endfor
-enddef;
-picture unitpixel;
-unitpixel = nullpicture;
-addto unitpixel contour unitsquare;
-def t_ = \ enddef;
-boolean feynmfwizard;
-feynmfwizard := false;
-thin# := 1pt#; % dimension of the lines
-thick# := 2thin#;
-arrow_len# := 4mm#;
-arrow_ang := 15;
-curly_len# := 3mm#;
-dash_len# := 3mm#; % 'photon' lines
-dot_len# := 2mm#; % 'photon' lines
-wiggly_len# := 4mm#; % 'photon' lines
-wiggly_slope := 60;
-zigzag_len# := 2mm#;
-zigzag_width# := 2thick#;
-decor_size# := 5mm#;
-dot_size# := 2thick#;
-define_blacker_pixels (thick, thin,
- dash_len, dot_len, wiggly_len, curly_len,
- zigzag_len, zigzag_width, arrow_len, decor_size, dot_size);
-def shrink expr s =
- begingroup
- if shrinkables <> "":
- save tmp_;
- forsuffixes $ = scantokens shrinkables:
- if known $.#:
- tmp_ := $.#;
- save $;
- $.# := s * tmp_;
- define_blacker_pixels ($);
- else:
- tmp_ := $;
- save $;
- $ := s * tmp_;
- fi
- endfor
- fi
-enddef;
-def endshrink =
- endgroup
-enddef;
-string shrinkables;
-shrinkables := "";
-vardef addto_shrinkables (text l) =
- forsuffixes $ = l:
- shrinkables := shrinkables & "," & str $;
- endfor
-enddef;
-shrinkables := "thick,thin";
-addto_shrinkables (dash_len, dot_len);
-addto_shrinkables (wiggly_len, curly_len);
-addto_shrinkables (zigzag_len, zigzag_width);
-addto_shrinkables (arrow_len);
-addto_shrinkables (decor_size, dot_size);
-LaTeX_unitlength := mm;
-vardef count (text list) =
- forsuffixes $ = list: + 1 endfor
-enddef;
-vardef getopt (suffix opt) (expr s) =
- save n, argp, escape, anchor, skip;
- numeric opt.first, opt.last, n, anchor;
- string opt[], opt[]arg;
- boolean opt[]tainted, argp, escape, skip;
- opt.first := 0;
- opt.last := 0;
- opt[opt.last] := "";
- argp := false;
- escape := false;
- anchor := 0;
- skip := true;
- for n = 1 upto length (s):
- if skip and (substring (n-1, n) of s = " "):
- anchor := anchor + 1;
- else:
- skip := false;
- if not escape and (substring (n-1, n) of s = ","):
- if substring (n, n+1) of s = ",":
- escape := true;
- opt[opt.last]tainted := true;
- else:
- if argp:
- opt[opt.last]arg := substring (anchor, n-1) of s;
- else:
- opt[opt.last] := substring (anchor, n-1) of s;
- fi
- anchor := n;
- argp := false;
- skip := true;
- opt.last := opt.last + 1;
- fi
- elseif not argp and (substring (n-1, n) of s = "="):
- opt[opt.last] := substring (anchor, n-1) of s;
- anchor := n;
- argp := true;
- skip := true;
- elseif argp or (substring (n-1, n) of s <> " "):
- escape := false;
- fi
- fi
- endfor
- if argp:
- opt[opt.last]arg := substring (anchor, length s) of s;
- else:
- opt[opt.last] := substring (anchor, length s) of s;
- fi
- for n = opt.first upto opt.last:
- if known opt[n]tainted:
- if opt[n]tainted:
- opt[n]arg := untaint_string opt[n]arg;
- fi
- fi
- endfor
-enddef;
-vardef untaint_string suffix s =
- save n, anchor;
- numeric n, anchor;
- anchor := 0;
- for n = 1 upto length (s) - 1:
- if substring (n-1,n+1) of s = ",,":
- substring (anchor, n-1) of s &
- hide (anchor := n)
- fi
- endfor
- substring (anchor, length s) of s
-enddef;
-vardef split_string (suffix comp) (expr s) =
- save n, anchor;
- numeric comp.first, comp.last, n, anchor;
- string comp[];
- comp.first := 0;
- comp.last := 0;
- comp[comp.last] := "";
- anchor := 0;
- for n = 1 upto length (s):
- if substring (n-1,n) of s = ".":
- comp[comp.last] := substring (anchor, n-1) of s;
- comp.last := comp.last + 1;
- anchor := n;
- fi
- endfor
- comp[comp.last] := substring (anchor, length s) of s;
-enddef;
-vardef match_prefix (expr prefix, s) =
- (prefix = substring (0, length prefix) of s)
-enddef;
-vardef match_option (expr s, option) =
- save sc, optionc, n, i;
- numeric sc.first, sc.last, optionc.first, optionc.last;
- string sc[], optionc[];
- numeric n, i;
- split_string (sc, s);
- split_string (optionc, option);
- n := sc.last - sc.first;
- if n <> (optionc.last - optionc.first):
- false
- else:
- true
- for i = 0 upto n:
- and match_prefix (sc[sc.first+i],
- optionc[optionc.first+i])
- endfor
- fi
-enddef;
-def save_picture text t =
- save t; picture t; forsuffixes p=t: p:=nullpicture; endfor
-enddef;
-def begin_sketch =
- begingroup save_picture currentpicture;
- sketchlevel := sketchlevel+1;
-enddef;
-def end_sketch =
- sketchlevel := sketchlevel-1;
- sketchpad[sketchlevel] := currentpicture;
- endgroup
-enddef;
-picture sketchpad[];
-sketchlevel := 1;
-vardef use_sketch text t =
- addto currentpicture also (sketchpad[sketchlevel] t)
-enddef;
-vardef cdraw expr p =
- draw p withcolor foreground
-enddef;
-vardef cfill expr p =
- fill p withcolor foreground
-enddef;
-vardef cfilldraw expr p =
- filldraw p withcolor foreground
-enddef;
-vardef ccutdraw expr p =
- cutdraw p withcolor foreground
-enddef;
-vardef cdrawdot expr p =
- drawdot p withcolor foreground
-enddef;
-vardef isdigit expr s =
- save n;
- (s = "0")
- for n = 1 upto 9:
- or (s = decimal n)
- endfor
-enddef;
-vardef digits_index (expr s, start) =
- save n, m, from, to;
- for n = start upto (length s)-1:
- if isdigit (substring (n,n+1) of s):
- from := n;
- for m = n upto length s:
- if not isdigit (substring (m,m+1) of s):
- to := m;
- fi
- exitif known to;
- endfor
- fi
- exitif known from;
- endfor
- (from, if known to: to else: infinity fi)
-enddef;
-vardef digits_to_brackets suffix suf =
- save s, idx;
- string s;
- pair idx;
- s = str suf;
- idx = (0,0);
- forever:
- idx := digits_index (s, xpart idx);
- exitif unknown xpart idx;
- s := substring (0,xpart idx) of s
- & "[]" & substring (ypart idx,infinity) of s;
- endfor
- s
-enddef;
-tile_grain := 1in/300;
-vardef def_tile (suffix t) (expr wd, ht) =
- if not picture tlist.t:
- picture tlist.scantokens (digits_to_brackets t);
- fi
- tlist.t := nullpicture;
- tlist.t.dx := max (floor wd, 1);
- tlist.t.dy := max (floor ht, 1);
-enddef;
-vardef use_tile (suffix t) (expr x, y, wd, ht) =
- fill unitsquare xscaled wd yscaled ht shifted (x,y)
- withcolor background;
- if str t = "shaded":
- shade_rectangle (4thin, x, y, wd, ht);
- elseif str t = "hatched":
- shade_rectangle (5thin, x, y, wd, ht);
- shade_rectangle (-5thin, x, y, wd, ht);
- else:
- if (picture tlist.t):
- for nx = 0 upto wd/tlist.t.dx:
- for ny = 0 upto ht/tlist.t.dy:
- addto currentpicture
- also (tlist.t shifted
- ((x,y) + (nx*tlist.t.dx, ny*tlist.t.dy)) t_);
- endfor
- endfor
- else:
- errhelp "feynmf: your tiling has not been defined, "
- & "check spelling and reprocess!";
- errmessage "feynmf: tiling `" & str t & "' not known, "
- & "replaced by `shaded'";
- use_tile (shaded, x, y, wd, ht);
- fi
- fi
-enddef;
-vardef shade_rectangle (expr dd, x, y, wd, ht) =
- save d, u, dx, dy, currentpen;
- pen currentpen;
- pickup pencircle scaled thin;
- d := max (floor (abs dd), 1);
- dx := max (wd, ht);
- dy := max (wd, ht);
- for u = 0 step d/dx until 1:
- if dd > 0:
- cdraw (x-d,y+u*dy-d)--(x+(1-u)*dx+d,y+dy+d);
- cdraw (x+u*dx-d,y-d)--(x+dx+d,y+(1-u)*dy+d);
- else:
- cdraw (x-d,y+u*dy+d)--(x+u*dx+d,y-d);
- cdraw (x+(1-u)*dx-d,y+dy+d)--(x+dx+d,y+(1-u)*dy-d);
- fi
- endfor
-enddef;
-def addto_tile (suffix t) =
- addto tlist.t
-enddef;
-vardef tile_from_string (suffix t) (expr str) =
- tile_grain := max (floor tile_grain, 1);
- save grain, mx, x, y, n, c, pic;
- string c;
- picture pic;
- pic := nullpicture;
- grain := tile_grain;
- mx := 0;
- x := 0;
- y := 0;
- for n := 1 upto length str:
- c := substring (n-1,n) of str;
- if c = "/":
- mx := max (mx, x);
- y := y+1;
- x := 0;
- elseif c = "*":
- addto pic also (unitpixel shifted (x,-y) t_);
- x := x+1;
- elseif c = ".":
- x := x+1;
- fi
- endfor
- def_tile (t, grain*mx, grain*(y+1));
- addto_tile (t) also (pic shifted (0,y) scaled grain t_);
- pic := nullpicture;
-enddef;
-tile_from_string (gray10,
- " ... /"&
- " .*. /"&
- " ... ");
-tile_from_string (gray25,
- " .. /"&
- " *. ");
-tile_from_string (gray50,
- " .* /"&
- " *. ");
-tile_from_string (gray75,
- " ** /"&
- " .* ");
-tile_from_string (gray90,
- " *** /"&
- " *.* /"&
- " *** ");
-vardef make_halftone (suffix t) (expr g, wd, ht) =
- def_tile (t, wd, ht);
- addto tlist.t contour unitsquare
- xscaled wd yscaled ht withcolor ((1-g)*foreground + g*background)
-enddef;
-vardef tile (suffix t) (expr p) =
- save u, x, y, max_x, min_x, max_y, min_y, xx, yy;
- -max_x = -max_y = min_x = min_y = infinity;
- for u = 0 step 0.1 until length p:
- x := xpart (point u of p);
- y := ypart (point u of p);
- max_x := max(max_x, x);
- max_y := max(max_y, y);
- min_x := min(min_x, x);
- min_y := min(min_y, y);
- endfor
- begin_sketch
- use_tile (t, min_x, min_y, max_x-min_x, max_y-min_y);
- clip currentpicture to p;
- end_sketch;
- use_sketch;
-enddef;
-vardef drawtile (suffix t) (expr p) =
- tile (t, p);
- cdraw p
-enddef;
-vardef use_halftone (expr g, x, y, wd, ht) =
- fill unitsquare xscaled wd yscaled ht
- shifted (x,y) withcolor ((1-g)*foreground + g*background)
-enddef;
-vardef halftone (expr g, p) =
- fill p withcolor ((1-g)*foreground + g*background)
-enddef;
-vardef drawhalftone (expr g, p) =
- fill p withcolor ((1-g)*foreground + g*background);
- cdraw p
-enddef;
-vardef shade expr p =
- tile (shaded, p)
-enddef;
-vardef hatch expr p =
- tile (hatched, p)
-enddef;
-vardef emptydraw expr p =
- cullit;
- unfill p;
- cullit;
- cdraw p;
-enddef;
-vardef shadedraw expr p =
- cullit;
- unfill p;
- cullit;
- shade p;
- cdraw p;
-enddef;
-vardef hatchdraw expr p =
- cullit;
- unfill p;
- cullit;
- hatch p;
- cdraw p;
-enddef;
-vardef marrow (expr p, frac) =
- save a, t, z;
- pair z;
- a = angle direction frac*length(p) of p;
- z = point frac*length(p) of p;
- (t1,whatever) = p intersectiontimes
- (halfcircle scaled 2/3arrow_len rotated (a+90) shifted z);
- (t2,whatever) = p intersectiontimes
- (halfcircle scaled 4/3arrow_len rotated (a-90) shifted z);
- arrow_head (p, t1, t2, arrow_ang)
-enddef;
-vardef tarrow (expr p, frac) =
- save a, t, z;
- pair z;
- t1 = frac*length p;
- a = angle direction t1 of p;
- z = point t1 of p;
- (t2,whatever) = p intersectiontimes
- (halfcircle scaled 2arrow_len rotated (a-90) shifted z);
- arrow_head (p, t1, t2, arrow_ang)
-enddef;
-vardef harrow (expr p, frac) =
- save a, t, z;
- pair z;
- t2 = frac*length p;
- a = angle direction t2 of p;
- z = point t2 of p;
- (t1,whatever) = p intersectiontimes
- (halfcircle scaled 2arrow_len rotated (a+90) shifted z);
- arrow_head (p, t1, t2, arrow_ang)
-enddef;
-vardef arrow_head (expr p, from, to, ang) =
- save tip, ap, t;
- pair tip;
- path ap;
- t1 := from;
- t2 := to;
- if t1 = -1: t1 := 0; fi
- if t2 = -1: t2 := infinity; fi
- tip = point t2 of p;
- ap = subpath (t1,t2) of p shifted -tip;
- (ap rotated ang
- forced_join reverse ap rotated -ang
- -- cycle) shifted tip
-enddef;
-vardef arrow expr p =
- marrow (p, .5)
-enddef;
-tertiarydef p forced_join q =
- subpath (0, length p - 1) of p
- & point (length p - 1) of p
- .. controls postcontrol (length p - 1) of p
- and precontrol infinity of p
- .. .5[point infinity of p, point 0 of q]
- .. controls postcontrol 0 of q and precontrol 1 of q
- .. point 1 of q
- & subpath (1, infinity) of q
-enddef;
-vardef cut_decors (suffix from) (expr p) (suffix to) =
- subpath (if known from.decor.shape:
- xpart (p intersectiontimes
- (from.decor.shape scaled from.decor.size
- shifted from.loc))
- else:
- 0
- fi,
- if known to.decor.shape:
- length p
- - xpart (reverse p intersectiontimes
- (to.decor.shape scaled to.decor.size
- shifted to.loc))
- else:
- infinity
- fi) of p
-enddef;
-vardef make_blob (expr z_arg, diameter) =
- save p,currentpen; path p; pen currentpen;
- pickup pencircle scaled thick;
- p = fullcircle scaled diameter shifted z_arg;
- shadedraw p;
-enddef;
-vardef draw_blob (expr z_arg, diameter) =
- if sketched_blob_diameter <> diameter: % drawn lately?
- begin_sketch make_blob (origin, diameter); end_sketch; % redo hard work!
- sketched_blob_diameter:= diameter; % record it
- fi
- use_sketch shifted z_arg; % the easy way ...
-enddef;
-def force_new_blob = sketched_blob_diameter := -1; enddef;
-force_new_blob; % initialize it.
-vardef pixlen (expr p, n) =
- for k=1 upto length(p): + segment_pixlen (subpath (k-1,k) of p, n) endfor
-enddef;
-vardef segment_pixlen (expr p, n) =
- for k=1 upto n: + abs (point k/n of p - point (k-1)/n of p) endfor
-enddef;
-vardef wiggly expr p_arg =
- save wpp;
- numeric wpp;
- wpp = ceiling (pixlen (p_arg, 10) / wiggly_len) / length p_arg;
- for k=0 upto wpp*length(p_arg) - 1:
- point k/wpp of p_arg
- {direction k/wpp of p_arg rotated wiggly_slope} ..
- point (k+.5)/wpp of p_arg
- {direction (k+.5)/wpp of p_arg rotated - wiggly_slope} ..
- endfor
- if cycle p_arg: cycle else: point infinity of p_arg fi
-enddef;
-vardef curly expr p =
- save cpp;
- numeric cpp;
- cpp := ceiling (pixlen (p, 10) / curly_len) / length p;
- if cycle p:
- for k=0 upto cpp*length(p) - 1:
- point (k+.33)/cpp of p
- {direction (k+.33)/cpp of p rotated 90} ..
- point (k-.33)/cpp of p
- {direction (k-.33)/cpp of p rotated -90} ..
- endfor
- cycle
- else:
- point 0 of p
- {direction 0 of p rotated -90} ..
- for k=1 upto cpp*length(p) - 1:
- point (k+.33)/cpp of p
- {direction (k+.33)/cpp of p rotated 90} ..
- point (k-.33)/cpp of p
- {direction (k-.33)/cpp of p rotated -90} ..
- endfor
- point infinity of p
- {direction infinity of p rotated 90}
- fi
-enddef;
-vardef zigzag expr p =
- save zpp;
- numeric zpp;
- zpp = ceiling (pixlen (p, 10) / zigzag_len) / length p;
- if not cycle p:
- point 0 of p --
- fi
- for k = 0 upto zpp*length(p) - 1:
- point (k+1/3)/zpp of p shifted
- (zigzag_width
- * dir angle (direction (k+1/3)/zpp of p rotated 90)) --
- point (k+2/3)/zpp of p shifted
- (zigzag_width
- * dir angle (direction (k+2/3)/zpp of p rotated -90)) --
- endfor
- if cycle p:
- cycle
- else:
- point infinity of p
- fi
-enddef;
-save vsty_hash;
-def style_def suffix s =
- vsty_hash.s := 1;
- expandafter quote vardef scantokens ("draw_" & str s)
-enddef;
-vardef vsty_exists suffix s =
- known vsty_hash.s
-enddef;
-vardef valid_style expr s =
- expandafter vsty_exists scantokens (s)
-enddef;
-style_def phantom expr p =
- \
-enddef;
-style_def phantom_arrow expr p =
- cfill (arrow p);
-enddef;
-style_def plain expr p =
- cdraw p;
-enddef;
-style_def plain_arrow expr p =
- cdraw p;
- cfill (arrow p);
-enddef;
-style_def dbl_plain expr p =
- draw_double p;
-enddef;
-style_def dbl_plain_arrow expr p =
- draw_double_arrow p;
-enddef;
-style_def wiggly expr p =
- cdraw (wiggly p);
-enddef;
-style_def dbl_wiggly expr p =
- draw_double (wiggly p);
-enddef;
-style_def curly expr p =
- cdraw (curly p);
-enddef;
-style_def dbl_curly expr p =
- draw_double (curly p);
-enddef;
-style_def zigzag expr p =
- cdraw (zigzag p);
-enddef;
-style_def dbl_zigzag expr p =
- draw_double (zigzag p);
-enddef;
-style_def dashes expr p =
- save dpp;
- numeric dpp;
- dpp = ceiling (pixlen (p, 10) / dash_len) / length p;
- for k=0 upto dpp*length(p) - 1:
- cdraw point k/dpp of p ..
- point (k+.5)/dpp of p;
- endfor
-enddef;
-style_def dbl_dashes expr p =
- save dpp;
- numeric dpp;
- dpp = ceiling (pixlen (p, 10) / dash_len) / length p;
- for k=0 upto dpp*length(p) - 1:
- draw_double point k/dpp of p ..
- point (k+.5)/dpp of p;
- endfor
-enddef;
-style_def dbl_dashes_arrow expr p =
- draw_dbl_dashes p;
- shrink (1.5);
- cfill (arrow p);
- endshrink;
-enddef;
-style_def dashes_arrow expr p =
- draw_dashes p;
- cfill (arrow p);
-enddef;
-style_def dots expr p =
- save dpp;
- numeric dpp;
- dpp = ceiling (pixlen (p, 10) / dot_len) / length p;
- for k=0 upto dpp*length(p):
- cdrawdot point k/dpp of p;
- endfor
-enddef;
-style_def dbl_dots expr p =
- save dpp;
- numeric dpp;
- dpp = ceiling (pixlen (p, 10) / dot_len) / length p;
- begingroup
- save oldpen;
- pen oldpen;
- oldpen := currentpen;
- pickup oldpen scaled 3; % draw a thick linn
- for k=0 upto dpp*length(p):
- cdrawdot point k/dpp of p;
- endfor
- pickup oldpen;
- cullit;
- for k=0 upto dpp*length(p):
- undrawdot point k/dpp of p;
- endfor
- cullit; % and remove the stuffing
- endgroup;
-enddef;
-style_def dbl_dots_arrow expr p =
- draw_dbl_dots p;
- shrink (1.5);
- cfill (arrow p);
- endshrink;
-enddef;
-style_def dots_arrow expr p =
- draw_dots p;
- cfill (arrow p);
-enddef;
-style_def double expr p =
- save oldpen;
- pen oldpen;
- oldpen := currentpen;
- pickup oldpen scaled 3;
- ccutdraw p;
- pickup oldpen;
- cullit; undraw p; cullit;
-enddef;
-style_def double_arrow expr p =
- draw_double p;
- shrink (1.5);
- cfill (arrow p);
- endshrink;
-enddef;
-style_def vanilla expr p = draw_plain p enddef;
-style_def fermion expr p = draw_plain_arrow p enddef;
-style_def quark expr p = draw_plain_arrow p enddef;
-style_def electron expr p = draw_plain_arrow p enddef;
-style_def photon expr p = draw_wiggly p enddef;
-style_def boson expr p = draw_wiggly p enddef;
-style_def gluon expr p = draw_curly p enddef;
-style_def heavy expr p = draw_dbl_plain_arrow p enddef;
-style_def ghost expr p = draw_dots_arrow p enddef;
-style_def scalar expr p = draw_dashes_arrow p enddef;
-vardef fermion expr path_arg =
- cfill (arrow (path_arg));
- path_arg
-enddef;
-vardef photon expr path_arg =
- wiggly path_arg
-enddef;
-vardef gluon expr path_arg =
- curly path_arg
-enddef;
-tracingstats:=1;
-boolean vtracing;
-vtracing := false; % true
-def vinit =
- save vhash;
- numeric vlist.first, vlist.last;
- vlist.first := 1;
- vlist.last := 0;
- pair vlist[]loc;
- numeric vlist[]decor.size, vlist[]decor.ang,
- vlist[]arc.first, vlist[]arc.last,
- vlist[]arc[], vlist[]arc[]lsr,
- vlist[]arc[]tns, vlist[]arc[]lbl.dist,
- vlist[]arc[]tag, vlist[]arc[]wd, vlist[]arc[]rub,
- vlist[]constr.first, vlist[]constr.last,
- vlist[]constr[], lambdax[][], lambday[][];
- string vlist[]name, vlist[]lbl, vlist[]decor.sty,
- vlist[]arc[]sty, vlist[]arc[]lbl, vlist[]arc[]lbl.side;
- numeric vlist[]lbl.ang;
- path vlist[]decor.shape;
- color vlist[]fore, vlist[]back,
- vlist[]arc[]fore, vlist[]arc[]back;
- numeric plist.first, plist.last, plist[]cnt, plist[]vtx[],
- plist[]pull, plist[]lbl.ang, plist[]lbl.dist;
- string plist[]lbl, plist[]sty, plist[]cona, plist[]conb;
- plist.first := 1;
- plist.last := 0;
- numeric vlist[]poly.first, vlist[]poly.last,
- vlist[]poly[], vlist[]poly[]idx;
- pair lambdap[][];
- color plist[]fore, plist[]back;
-enddef;
-def vertices =
- vlist.first upto vlist.last
-enddef;
-def varcs (text i) =
- vlist[i]arc.first upto vlist[i]arc.last
-enddef;
-def vconstr (text i) =
- vlist[i]constr.first upto vlist[i]constr.last
-enddef;
-def polygons =
- plist.first upto plist.last
-enddef;
-def vpoly (text i) =
- vlist[i]poly.first upto vlist[i]poly.last
-enddef;
-vardef venter suffix v =
- if not vexists v:
- vlist.last := vlist.last + 1;
- vhash.v := vlist.last;
- vlist[vhash.v]name := str v;
- vlist[vhash.v]loc := (whatever,whatever);
- vlist[vhash.v]arc.first := 1;
- vlist[vhash.v]arc.last := 0;
- vlist[vhash.v]constr.first := 1;
- vlist[vhash.v]constr.last := 0;
- vlist[vhash.v]lbl := "";
- vlist[vhash.v]lbl.ang := whatever;
- vlist[vhash.v]lbl.dist := 3thick;
- vlist[vhash.v]fore := (whatever, whatever, whatever);
- vlist[vhash.v]back := (whatever, whatever, whatever);
- vlist[vhash.v]poly.first := 1;
- vlist[vhash.v]poly.last := 0;
- fi
-enddef;
-vardef vexists suffix v =
- if known vhash.v: true else: false fi
-enddef;
-vardef vlookup suffix v =
- if vexists v: vhash.v else: 0 fi
-enddef;
-vardef vloc suffix v =
- vlist[vlookup v]loc
-enddef;
-vardef vconnect (expr linesty) (text vl) =
- save from, nfrom, nto, nopt, sty;
- numeric from, nfrom, nto, nopt;
- string sty;
- getopt (opt, linesty);
- sty := opt[opt.first];
- if known opt[opt.first]arg:
- message "feynmf: line styles don't take arguments. "
- & "Argument `" & opt[opt.first]arg & "' ignored.";
- fi
- opt.first := opt.first + 1;
- forsuffixes to = vl:
- venter to;
- nto := vlookup to;
- if known nfrom:
- vlist[nfrom]arc.last := vlist[nfrom]arc.last + 1;
- vlist[nfrom]arc[vlist[nfrom]arc.last] := nto;
- vlist[nfrom]arc[vlist[nfrom]arc.last]tns := 1;
- if nfrom <> nto:
- vlist[nto]arc.last := vlist[nto]arc.last + 1;
- vlist[nto]arc[vlist[nto]arc.last] := nfrom;
- vlist[nto]arc[vlist[nto]arc.last]tns := 1;
- fi
- vlist[nfrom]arc[vlist[nfrom]arc.last]lbl := "";
- vlist[nfrom]arc[vlist[nfrom]arc.last]lbl.side := "";
- vlist[nfrom]arc[vlist[nfrom]arc.last]lbl.dist := 3thick;
- for nopt = opt.first upto opt.last:
- if match_option (opt[nopt], "tension"):
- get_argument (opt[nopt], scantokens (opt[nopt]arg),
- vlist[nfrom]arc[vlist[nfrom]arc.last]tns);
- get_argument (opt[nopt], scantokens (opt[nopt]arg),
- vlist[nto]arc[vlist[nto]arc.last]tns);
- elseif match_option (opt[nopt], "left"):
- if known opt[nopt]arg:
- vlist[nfrom]arc[vlist[nfrom]arc.last]lsr
- := - scantokens (opt[nopt]arg);
- else:
- vlist[nfrom]arc[vlist[nfrom]arc.last]lsr := -1;
- fi
- elseif match_option (opt[nopt], "straight"):
- vlist[nfrom]arc[vlist[nfrom]arc.last]lsr := 0;
- ignore_argument (opt[nopt], opt[nopt]arg);
- elseif match_option (opt[nopt], "right"):
- if known opt[nopt]arg:
- vlist[nfrom]arc[vlist[nfrom]arc.last]lsr
- := scantokens (opt[nopt]arg);
- else:
- vlist[nfrom]arc[vlist[nfrom]arc.last]lsr := 1;
- fi
- elseif match_option (opt[nopt], "label"):
- get_argument (opt[nopt], opt[nopt]arg,
- vlist[nfrom]arc[vlist[nfrom]arc.last]lbl);
- elseif match_option (opt[nopt], "label.side"):
- get_argument (opt[nopt], opt[nopt]arg,
- vlist[nfrom]arc[vlist[nfrom]arc.last]lbl.side);
- elseif match_option (opt[nopt], "label.dist"):
- get_argument (opt[nopt], scantokens (opt[nopt]arg),
- vlist[nfrom]arc[vlist[nfrom]arc.last]lbl.dist);
- elseif match_option (opt[nopt], "tag"):
- if known opt[nopt]arg:
- vlist[nfrom]arc[vlist[nfrom]arc.last]tag
- := scantokens (opt[nopt]arg);
- else:
- vlist[nfrom]arc[vlist[nfrom]arc.last]tag := 0;
- fi
- elseif match_option (opt[nopt], "width"):
- get_argument (opt[nopt], scantokens (opt[nopt]arg),
- vlist[nfrom]arc[vlist[nfrom]arc.last]wd);
- elseif match_option (opt[nopt], "foreground"):
- get_argument (opt[nopt], scantokens (opt[nopt]arg),
- vlist[nfrom]arc[vlist[nfrom]arc.last]fore);
- elseif match_option (opt[nopt], "background"):
- get_argument (opt[nopt], scantokens (opt[nopt]arg),
- vlist[nfrom]arc[vlist[nfrom]arc.last]back);
- elseif match_option (opt[nopt], "rubout"):
- if known opt[nopt]arg:
- vlist[nfrom]arc[vlist[nfrom]arc.last]rub
- := scantokens (opt[nopt]arg);
- else:
- vlist[nfrom]arc[vlist[nfrom]arc.last]rub := 2;
- fi
- else:
- ignore_option (opt[nopt], opt[nopt]arg);
- fi
- endfor
- handle_line_style (vlist[nfrom]arc[vlist[nfrom]arc.last]sty, sty);
- vlist[nto]arc[vlist[nto]arc.last]lsr
- := vlist[nfrom]arc[vlist[nfrom]arc.last]lsr;
- fi
- nfrom := nto;
- endfor
-enddef;
-vardef handle_line_style (suffix sty) (expr name) =
- if valid_style name:
- sty := name;
- else:
- errhelp "feynmf: your linestyle is not recognizable, "
- & "check spelling and reprocess!";
- errmessage "feynmf: line style `" & name & "' not known, "
- & "replaced by `vanilla'";
- sty := "vanilla";
- fi
-enddef;
-vardef get_argument (expr opt, arg) (suffix variable) =
- if known arg:
- variable := arg;
- else:
- message "feynmf: option `" & opt & "' needs an argument. Ignored.";
- fi
-enddef;
-vardef ignore_argument (expr opt, arg) =
- if known arg:
- message "feynmf: option `" & opt & "' doesn't take an argument. "
- & "Argument `" & arg & "' ignored.";
- fi
-enddef;
-vardef ignore_option (expr opt, arg)=
- if known arg:
- message "feynmf: ignoring option " & opt & "=" & arg & ".";
- else:
- message "feynmf: ignoring option " & opt & ".";
- fi
-enddef;
-vardef vconnectn (expr linesty) (suffix v) (expr n) =
- vconnect (linesty, vmklist (v, n));
-enddef;
-vardef vpath@# (suffix from, to) =
- save nfrom, nto, origin, index, unknown_path;
- numeric nfrom, nto, origin, index;
- path unknown_path;
- if (known vloc from) and (known vloc to):
- nfrom := vlookup from;
- nto := vlookup to;
- vmatch_path (nfrom, nto, maybe_empty@#);
- if (unknown origin) or (unknown index):
- vmatch_path (nto, nfrom, maybe_empty@#);
- fi
- fi
- if (known origin) and (known index):
- vbuild_cut_arc (origin, index)
- else:
- unknown_path
- fi
-enddef;
-vardef maybe_empty@# =
- save _prefix;
- _prefix=137;
- if known _prefix@#:
- whatever
- else:
- @#
- fi
-enddef;
-vardef vmatch_path (expr nfrom, nto, t) =
- save i;
- for i = varcs (nfrom):
- if (vlist[nfrom]arc[i] = nto) and (known vlist[nfrom]arc[i]sty):
- if unknown t:
- origin := nfrom;
- index := i;
- else:
- if known vlist[nfrom]arc[i]tag:
- if vlist[nfrom]arc[i]tag = t:
- origin := nfrom;
- index := i;
- fi
- fi
- fi
- fi
- endfor
-enddef;
-vardef vcyclen (expr sty) (suffix v) (expr n) =
- for $ = 1 upto n - 1:
- vconnect (sty, v[$], v[$+1]);
- endfor
- vconnect (sty, v[n], v[1]);
-enddef;
-vardef vrcyclen (expr sty) (suffix v) (expr n) =
- vconnect (sty, v[1], v[n]);
- for $ = n downto 2:
- vconnect (sty, v[$], v[$-1]);
- endfor
-enddef;
-vardef vforce (expr z) (suffix v) =
- venter v;
- vlist[vlookup v]loc := z;
-enddef;
-vardef vshift (expr z) (text vl) =
- forsuffixes $=vl:
- if vexists $:
- vlist[vlookup $]loc := vlist[vlookup $]loc + z;
- fi
- endfor
-enddef;
-vardef vconstraint (expr z) (text vl) =
- save nfrom, nto;
- numeric nfrom, nto;
- forsuffixes to = vl:
- venter to;
- nto := vlookup to;
- if known nfrom:
- vlist[nfrom]constr.last := vlist[nfrom]constr.last + 1;
- vlist[nto]constr.last := vlist[nto]constr.last + 1;
- vlist[nfrom]constr[vlist[nfrom]constr.last] := nto;
- vlist[nto]constr[vlist[nto]constr.last] := nfrom;
- vlist[nto]loc = vlist[nfrom]loc + z;
- fi
- nfrom := nto;
- endfor
-enddef;
-vardef vpolygon (expr psty) (suffix v) (text vl) =
- save nopt, csty, nfrom, nfrom_, nto, i, n, j;
- numeric nopt, nfrom, nfrom_, nto, i, n, j;
- string csty;
- n := count (vl) + 1;
- plist.last := plist.last + 1;
- plist[plist.last]cnt := n;
- plist[plist.last]lbl := "";
- plist[plist.last]lbl.ang := whatever;
- plist[plist.last]lbl.dist := 0;
- csty := "phantom";
- getopt (opt, psty);
- for nopt = opt.first upto opt.last:
- if match_option (opt[nopt], "filled"):
- get_argument (opt[nopt], opt[nopt]arg, plist[plist.last]sty);
- elseif match_option (opt[nopt], "tension"):
- if known opt[nopt]arg:
- csty := csty & ",tension=" & opt[nopt]arg;
- else:
- message "feynmf: option `tension' needs an argument. Ignored.";
- fi
- elseif match_option (opt[nopt], "label"):
- get_argument (opt[nopt], opt[nopt]arg, plist[plist.last]lbl);
- elseif match_option (opt[nopt], "label.angle"):
- get_argument (opt[nopt], scantokens (opt[nopt]arg),
- plist[plist.last]lbl.ang);
- elseif match_option (opt[nopt], "label.dist"):
- get_argument (opt[nopt], scantokens (opt[nopt]arg),
- plist[plist.last]lbl.dist);
- elseif match_option (opt[nopt], "pull"):
- get_argument (opt[nopt], scantokens (opt[nopt]arg),
- plist[plist.last]pull);
- elseif match_option (opt[nopt], "cona"):
- get_argument (opt[nopt], opt[nopt]arg, plist[plist.last]cona);
- elseif match_option (opt[nopt], "conb"):
- get_argument (opt[nopt], opt[nopt]arg, plist[plist.last]conb);
- elseif match_option (opt[nopt], "smooth"):
- plist[plist.last]cona := "..";
- plist[plist.last]conb := "..";
- ignore_argument (opt[nopt], opt[nopt]arg);
- elseif match_option (opt[nopt], "foreground"):
- get_argument (opt[nopt], scantokens (opt[nopt]arg),
- plist[plist.last]fore);
- elseif match_option (opt[nopt], "background"):
- get_argument (opt[nopt], scantokens (opt[nopt]arg),
- plist[plist.last]back);
- elseif match_option (opt[nopt], "phantom"):
- plist[plist.last]sty := "phantom";
- elseif match_option (opt[nopt], "empty"):
- plist[plist.last]sty := "empty";
- elseif match_option (opt[nopt], "full"):
- plist[plist.last]sty := "full";
- elseif match_option (opt[nopt], "hatched"):
- plist[plist.last]sty := "hatched";
- elseif match_option (opt[nopt], "shaded"):
- plist[plist.last]sty := "shaded";
- else:
- ignore_option (opt[nopt], opt[nopt]arg);
- fi
- endfor
- canonicalize_filling plist[plist.last]sty;
- vconnect (csty, v, vl, v);
- i := 1;
- forsuffixes to = v, vl, v:
- nto := vlookup to;
- if known nfrom:
- if known nfrom_:
- vlist[nto]loc = vlist[nfrom]loc
- + (vlist[nfrom]loc - vlist[nfrom_]loc) rotated (360/n);
- fi
- vlist[nto]poly.last := vlist[nto]poly.last + 1;
- vlist[nto]poly[vlist[nto]poly.last] := plist.last;
- vlist[nto]poly[vlist[nto]poly.last]idx := i;
- plist[plist.last]vtx[i] := nto;
- i := i + 1;
- nfrom_ := nfrom;
- fi
- nfrom := nto;
- endfor
-enddef;
-vardef canonicalize_filling suffix f =
- if known f:
- if is_a_number (f):
- if scantokens f <= 1:
- f :=
- if scantokens f = 1:
- "full"
- elseif scantokens f > 0:
- "shaded"
- elseif scantokens f = 0:
- "empty"
- else:
- "hatched"
- fi;
- fi
- fi
- fi
-enddef;
-vardef vpolygonn (expr sty) (suffix v) (expr n) =
- vpolygon (sty, v[1], for $=2 upto n-1: v[$], endfor v[n]);
-enddef;
-vardef vrpolygonn (expr sty) (suffix v) (expr n) =
- vpolygon (sty, v[n], for $=n-1 downto 2: v[$], endfor v[1]);
-enddef;
-vardef vlabel (expr s) (suffix v) =
- venter v;
- vlist[vlookup v]lbl := s;
-enddef;
-vardef vvertex (expr vtxsty) (text vl) =
- save nopt, sty, arg;
- numeric nopt, arg;
- string sty;
- getopt (opt, vtxsty);
- forsuffixes v = vl:
- venter v;
- n := vlookup v;
- for nopt = opt.first upto opt.last:
- handle_vertex_option (vlist[n], opt[nopt], opt[nopt]arg);
- endfor
- endfor
-enddef;
-vardef handle_vertex_option (suffix v) (expr opt, arg) =
- if match_option (opt, "label"):
- get_argument (opt, arg, v.lbl);
- elseif match_option (opt, "label.angle"):
- get_argument (opt, scantokens (arg), v.lbl.ang);
- elseif match_option (opt, "label.dist"):
- get_argument (opt, scantokens (arg), v.lbl.dist);
- elseif match_option (opt, "decoration.shape"):
- if known arg:
- make_decor_shape (v.decor.shape, arg);
- else:
- message "feynmf: option `decor.shape' needs an argument. Ignored.";
- fi
- elseif match_option (opt, "decoration.filled"):
- get_argument (opt, arg, v.decor.sty);
- canonicalize_filling v.decor.sty;
- elseif match_option (opt, "decoration.size"):
- get_argument (opt, scantokens (arg), v.decor.size);
- elseif match_option (opt, "decoration.angle"):
- get_argument (opt, scantokens (arg), v.decor.ang);
- elseif match_option (opt, "foreground"):
- get_argument (opt, scantokens (arg), v.fore);
- elseif match_option (opt, "background"):
- get_argument (opt, scantokens (arg), v.back);
- else:
- ignore_option (opt, arg);
- fi
-enddef;
-vardef make_decor_shape (suffix p) (expr n) =
- if match_prefix (n, "circle"): p := fullcircle;
- elseif match_prefix (n, "square"):
- p := unitsquare shifted -(.5,.5);
- elseif match_prefix (n, "cross"): p := polycross 4;
- elseif match_prefix (n, "triangle"): p := polygon 3;
- elseif match_prefix (n, "triagon"): p := polygon 3;
- elseif match_prefix (n, "diamond"): p := polygon 4;
- elseif match_prefix (n, "tetragon"): p := polygon 4;
- elseif match_prefix (n, "pentagon"): p := polygon 5;
- elseif match_prefix (n, "hexagon"): p := polygon 6;
- elseif match_prefix (n, "triagram"): p := polygram 3;
- elseif match_prefix (n, "tetragram"): p := polygram 4;
- elseif match_prefix (n, "pentagram"): p := polygram 5;
- elseif match_prefix (n, "hexagram"): p := polygram 6;
- elseif match_prefix (n, "triacross"): p := polycross 3;
- elseif match_prefix (n, "tetracross"): p := polycross 4;
- elseif match_prefix (n, "pentacross"): p := polycross 5;
- elseif match_prefix (n, "hexacross"): p := polycross 6;
- else:
- if feynmfwizard:
- p := scantokens(n);
- else:
- message "feynmf: invalid argument `" & n
- & "' to option `decor.shape'. Ignored.";
- fi
- fi
-enddef;
-vardef is_a_number expr s =
- save n;
- if known s:
- (true
- for n = 1 upto length s:
- and ((substring (n-1,n) of s = ".")
- or (substring (n-1,n) of s = "-")
- or isdigit substring (n-1,n) of s)
- endfor)
- else:
- false
- fi
-enddef;
-vardef vvertexn (expr vtxsty) (suffix v) (expr n) =
- vvertex (vtxsty, vmklist (v, n));
-enddef;
-vardef vblob (expr bd) (text vl)=
- forsuffixes $=vl:
- if not vexists $: venter $; fi
- vlist[vlookup $]decor.shape := fullcircle;
- vlist[vlookup $]decor.size := bd;
- vlist[vlookup $]decor.sty := "shaded";
- endfor
-enddef;
-vardef vdot (text vl)=
- forsuffixes $=vl:
- if not vexists $: venter $; fi
- vlist[vlookup $]decor.shape := fullcircle;
- vlist[vlookup $]decor.size := dot_size;
- vlist[vlookup $]decor.sty := "full";
- endfor
-enddef;
-vardef vdotn (suffix v) (expr n) =
- vdot (vmklist (v, n));
-enddef;
-vardef vblobn (suffix v) (expr n) =
- vblob (vmklist (v, n));
-enddef;
-vardef curved_left_gallery = .9[se,sw] .. .5[sw,nw] .. .1[nw,ne] enddef;
-vardef curved_right_gallery = .9[sw,se] .. .5[se,ne] .. .1[ne,nw] enddef;
-vardef curved_bottom_gallery = .9[nw,sw] .. .5[sw,se] .. .1[se,ne] enddef;
-vardef curved_top_gallery = .9[sw,nw] .. .5[nw,ne] .. .1[ne,se] enddef;
-vardef curved_surround_gallery =
- superellipse (.5[se,ne], .5[ne,nw], .5[nw,sw], .5[sw,se], .75)
-enddef;
-vardef straight_left_gallery = sw -- nw enddef;
-vardef straight_right_gallery = se -- ne enddef;
-vardef straight_bottom_gallery = sw -- se enddef;
-vardef straight_top_gallery = nw -- ne enddef;
-vardef straight_surround_gallery =
- .5[se,ne] -- ne -- .5[ne,nw] -- nw
- -- .5[nw,sw] -- sw -- .5[sw,se] -- se -- cycle
-enddef;
-vardef curved_galleries =
- vardef left_gallery = curved_left_gallery enddef;
- vardef right_gallery = curved_right_gallery enddef;
- vardef bottom_gallery = curved_bottom_gallery enddef;
- vardef top_gallery = curved_top_gallery enddef;
- vardef surround_gallery = curved_surround_gallery enddef;
-enddef;
-vardef straight_galleries =
- vardef left_gallery = straight_left_gallery enddef;
- vardef right_gallery = straight_right_gallery enddef;
- vardef bottom_gallery = straight_bottom_gallery enddef;
- vardef top_gallery = straight_top_gallery enddef;
- vardef surround_gallery = straight_surround_gallery enddef;
-enddef;
-vardef vleft (text vl) = vdistribute (left_gallery, vl) enddef;
-vardef vright (text vl) = vdistribute (right_gallery, vl) enddef;
-vardef vbottom (text vl) = vdistribute (bottom_gallery, vl) enddef;
-vardef vtop (text vl) = vdistribute (top_gallery, vl) enddef;
-vardef vsurround (text vl) = vdistribute (surround_gallery, vl) enddef;
-curved_galleries;
-vardef vdistribute (expr p) (text vl) =
- save numv, len, off;
- numeric numv, len, off;
- numv = count (vl);
- if cycle p: numv := numv + 1; fi
- len := length (p);
- if numv = 1:
- vforce (point len/2 of p, vl);
- else:
- off := 0;
- forsuffixes $ = vl:
- vforce (point off of p, $);
- off := off + len/(numv-1);
- endfor
- fi
-enddef;
-def vmklist (suffix v) (expr n) =
- for $ = 1 upto n-1: v[$], endfor v[n]
-enddef;
-vardef vleftn (suffix v) (expr n) =
- vleft (vmklist (v, n));
-enddef;
-vardef vrightn (suffix v) (expr n) =
- vright (vmklist (v, n));
-enddef;
-vardef vbottomn (suffix v) (expr n) =
- vbottom (vmklist (v, n));
-enddef;
-vardef vtopn (suffix v) (expr n) =
- vtop (vmklist (v, n));
-enddef;
-vardef vsurroundn (suffix v) (expr n) =
- vsurround (vmklist (v, n));
-enddef;
-vardef vfreeze =
- for i = vertices:
- if unknown vlist[i]loc:
- origin = origin
- for j = varcs (i):
- + vlist[i]arc[j]tns * (vlist[i]loc - vlist[vlist[i]arc[j]]loc)
- endfor
- for j = vconstr (i):
- if i < vlist[i]constr[j]:
- + lambda (i, vlist[i]constr[j])
- elseif i > vlist[i]constr[j]:
- - lambda (vlist[i]constr[j], i)
- fi
- endfor
- for j = vpoly (i):
- + lambdapoly (vlist[i]poly[j], plist[vlist[i]poly[j]]cnt,
- vlist[i]poly[j]idx)
- endfor;
- fi
- endfor
- if vtracing: vdump; fi
-enddef;
-vardef lambda (expr i, j) =
- (if known (xpart(vlist[i]loc - vlist[j]loc)):
- lambdax[i][j]
- else:
- 0
- fi,
- if known (ypart(vlist[i]loc - vlist[j]loc)):
- lambday[i][j]
- else:
- 0
- fi)
-enddef;
-vardef lambdapoly (expr p, n, i) =
- origin
- if i = 1:
- + lambdap[p][2] rotated (-360/n)
- elseif i = 2:
- - lambdap[p][1]
- fi
- if i = n - 1:
- - lambdap[p][n] rotated (-360/n)
- elseif i = n:
- + lambdap[p][n-1]
- fi
- if (i > 1) and (i < n):
- + lambdap[p][i-1] + lambdap[p][i+1] rotated (-360/n)
- - lambdap[p][i] - lambdap[p][i] rotated (-360/n)
- fi
-enddef;
-vardef idraw (expr linesty, p) =
- save nopt, sty, lbl, wd, rub;
- numeric nopt, lbl.dist, wd, rub;
- save fore, back;
- color fore, back;
- string sty, lbl, lbl.side;
- getopt (opt, linesty);
- sty := opt[opt.first];
- if known opt[opt.first]arg:
- message "feynmf: line styles don't take arguments. "
- & "Argument `" & opt[opt.first]arg & "' ignored.";
- fi
- opt.first := opt.first + 1;
- lbl := "";
- lbl.side := "";
- lbl.dist := 3thick;
- for nopt = opt.first upto opt.last:
- if match_option (opt[nopt], "label"):
- get_argument (opt[nopt], opt[nopt]arg, lbl);
- elseif match_option (opt[nopt], "label.side"):
- get_argument (opt[nopt], opt[nopt]arg, lbl.side);
- elseif match_option (opt[nopt], "label.dist"):
- get_argument (opt[nopt], scantokens (opt[nopt]arg), lbl.dist);
- elseif match_option (opt[nopt], "width"):
- get_argument (opt[nopt], scantokens (opt[nopt]arg), wd);
- elseif match_option (opt[nopt], "foreground"):
- get_argument (opt[nopt], scantokens (opt[nopt]arg), fore);
- elseif match_option (opt[nopt], "background"):
- get_argument (opt[nopt], scantokens (opt[nopt]arg), back);
- elseif match_option (opt[nopt], "rubout"):
- if known opt[nopt]arg:
- rub := scantokens (opt[nopt]arg);
- else:
- rub := 2;
- fi
- else:
- ignore_option (opt[nopt], opt[nopt]arg);
- fi
- endfor
- handle_line_style (sty, sty);
- begingroup
- if known fore:
- save foreground;
- color foreground;
- foreground = fore;
- fi
- if known back:
- save background;
- color background;
- foreground = back;
- fi
- vdraw_arc_rubout (rub, sty, wd, p, lbl);
- endgroup;
-enddef;
-vardef ivertex (expr vtxsty, pos) =
- save nopt, v;
- numeric nopt, v.lbl.ang, v.lbl.dist,
- v.decor.size, v.decor.ang;
- pair v.loc;
- string v.lbl, v.decor.sty;
- path v.decor.shape;
- v.loc := pos;
- v.lbl := "";
- v.lbl.ang := whatever;
- v.lbl.dist := 3thick;
- v.decor.size := decor_size;
- getopt (opt, vtxsty);
- for nopt = opt.first upto opt.last:
- handle_vertex_option (v, opt[nopt], opt[nopt]arg);
- endfor
- vdraw_label (v.loc, v.lbl);
- vdraw_vertex v;
-enddef;
-vardef vdraw =
- if not feynmfwizard:
- vcheck_typos;
- fi
- for i = vertices:
- if not known vlist[i]loc:
- errhelp "Your graph specification was not complete (probably a "
- & "lone vertex). Check logic and reprocess!";
- errmessage "feynmf: vertex `" & vlist[i]name & "' not determined, "
- & "replaced by `(0,0)'.";
- vlist[i]loc := origin;
- fi
- if unknown vlist[i]decor.size:
- vlist[i]decor.size = decor_size;
- fi
- endfor
- for i = vertices:
- for j = varcs (i):
- if known vlist[i]arc[j]sty:
- if vlist[i]arc[j]sty <> "":
- if unknown vlist[i]arc[j]rub:
- begingroup
- if known vlist[i]arc[j]fore:
- save foreground; color foreground;
- foreground = vlist[i]arc[j]fore;
- fi
- if known vlist[i]arc[j]back:
- save background; color background;
- background = vlist[i]arc[j]back;
- fi
- vdraw_arc (vlist[i]arc[j]sty, vlist[i]arc[j]wd,
- vbuild_cut_arc (i, j), vlist[i]arc[j]lbl);
- vlist[i]arc[j]sty := "";
- endgroup;
- fi
- fi
- fi
- endfor;
- endfor
- for i = polygons:
- vdraw_label (pcenter plist[i], plist[i]lbl);
- vdraw_polygon plist[i];
- endfor
- for i = vertices:
- vdraw_label (vlist[i]loc, vlist[i]lbl);
- vdraw_vertex vlist[i];
- endfor
- for i = vertices:
- for j = varcs (i):
- if known vlist[i]arc[j]sty:
- if vlist[i]arc[j]sty <> "":
- if known vlist[i]arc[j]rub:
- begingroup
- if known vlist[i]arc[j]fore:
- save foreground; color foreground;
- foreground = vlist[i]arc[j]fore;
- fi
- if known vlist[i]arc[j]back:
- save background; color background;
- background = vlist[i]arc[j]back;
- fi
- vdraw_arc_rubout (vlist[i]arc[j]rub,
- vlist[i]arc[j]sty,
- vlist[i]arc[j]wd,
- vbuild_cut_arc (i, j),
- vlist[i]arc[j]lbl);
- vlist[i]arc[j]sty := "";
- endgroup;
- fi
- fi
- fi
- endfor;
- endfor
-enddef;
-vardef vcheck_typos =
- save j, err;
- boolean wrn;
- wrn := false;
- for i = vertices:
- save connections;
- connections = vlist[i]arc.last - vlist[i]arc.first + 1;
- if connections < 1:
- if unknown vlist[i]loc:
- message "feynmf: warning: disconnected and unspecified vertex `"
- & substring (2,infinity) of vlist[i]name
- & "'.";
- wrn := true;
- fi
- elseif connections = 1:
- j := vlist[i]arc[vlist[i]arc.last];
- if j < i:
- if vlist[i]loc = vlist[j]loc:
- message "feynmf: warning: dangling vertex `"
- & substring (2,infinity) of vlist[i]name
- & "' colliding with `"
- & substring (2,infinity) of vlist[j]name
- & "'.";
- wrn := true;
- fi
- fi
- fi
- endfor
- if wrn:
- message "feynmf: Have you seen the warning messages above?";
- message " They are usually caused by misspelling a vertex'";
- message " name and can trigger errors further below!";
- message " Fix the typos and run LaTeX and Metafont again.";
- fi
-enddef;
-vardef vbuild_arc (expr lsr, from, to) =
- if unknown lsr:
- from -- to
- else:
- if lsr = 0:
- from -- to
- else:
- from
- .. (1-lsr)/2 *(to rotatedabout (.5[from,to], 90))
- + (1+lsr)/2 * (to rotatedabout (.5[from,to], -90))
- .. to
- fi
- fi
-enddef;
-vardef vbuild_cut_arc (expr origin, index) =
- cut_decors (vlist[origin],
- if vlist[origin]arc[index] <> origin:
- vbuild_arc (vlist[origin]arc[index]lsr,
- vlist[origin]loc,
- vlist[vlist[origin]arc[index]]loc)
- else:
- vbuild_tadpole (origin, index)
- fi,
- vlist[vlist[origin]arc[index]])
-enddef;
-vardef vbuild_tadpole (expr origin, index) =
- save j, n, nn, nnn, aidx, aang, agap, bgap, ngap, distsum;
- n := 0;
- distsum := 0;
- for j = varcs (origin):
- if vlist[origin]arc[j] <> origin:
- ang := angle direction 0 of
- vbuild_arc (vlist[origin]arc[j]lsr,
- vlist[origin]loc,
- vlist[vlist[origin]arc[j]]loc);
- n := n + 1;
- distsum := distsum
- + abs (vlist[vlist[origin]arc[j]]loc - vlist[origin]loc);
- aang[n] := 360;
- for nn = 1 upto n:
- if ang < aang[nn]:
- for nnn = n - 1 downto nn:
- aang[nnn+1] := aang[nnn];
- aidx[nnn+1] := aidx[nnn];
- endfor
- aang[nn] := ang;
- aidx[nn] := n;
- fi
- exitif known aidx[n];
- endfor
- fi
- endfor
- aidx[n+1] := aidx[1];
- aang[n+1] := aang[1] + 360;
- for nn = 1 upto n:
- agap[nn] = aang[nn+1] - aang[nn];
- endfor
- if known vlist[origin]arc[index]lsr:
- ngap := n;
- for nn = 1 upto n:
- if (aang[nn] < vlist[origin]arc[index]lsr)
- and (vlist[origin]arc[index]lsr < aang[nn+1]):
- ngap := nn;
- fi
- endfor
- else:
- bgap := 0;
- for nn = 1 upto n:
- if agap[nn] > bgap:
- bgap := agap[nn];
- ngap := nn;
- fi
- endfor
- fi
- if vtracing: adump (n + 1); fi
- vlist[origin]loc{dir(aang[ngap]+agap[ngap]/4)}
- ... vlist[origin]loc + 2/3 * distsum/n
- / vlist[origin]arc[index]tns
- * dir(aang[ngap]+agap[ngap]/2)
- ... {-dir(aang[ngap+1]-agap[ngap]/4)}vlist[origin]loc
-enddef;
-vardef adump expr n =
- save i;
- for i = 1 upto n:
- message "aidx[" & decimal_ (i) & "]=" & decimal_ (aidx[i])
- & ", aang[" & decimal_ (i) & "]=" & decimal_ (aang[i])
- & ", agap[" & decimal_ (i) & "]=" & decimal_ (agap[i]);
- endfor
-enddef;
-vardef vdraw_arc (expr sty, wd, arc) (suffix lbl) =
- if known wd:
- save currentpen;
- pen currentpen;
- pickup pencircle scaled wd;
- fi
- scantokens ("draw_" & sty) (arc);
- vdraw_arc_label (arc, lbl);
-enddef;
-let plain_draw = draw;
-vardef vdraw_arc_rubout (expr rub, sty, wd, arc) (suffix lbl) =
- if known rub:
- begingroup
- def draw expr p =
- save oldpen; pen oldpen;
- oldpen := currentpen;
- save currentpen; pen currentpen;
- pickup oldpen scaled rub;
- erase plain_draw (subpath (.1,.9)*length(p) of p)
- enddef;
- vdraw_arc (sty, wd, arc, lbl);
- let draw = plain_draw;
- endgroup;
- fi
- vdraw_arc (sty, wd, arc, lbl);
-enddef;
-vardef vbuild_polygon suffix p =
- if known p.pull:
- save c; pair c;
- c := pcenter p;
- for i = 1 upto (p.cnt - 1):
- vbuild_polygon_section (p, i, i+1)
- endfor
- vbuild_polygon_section (p, p.cnt, 1)
- else:
- for i = 1 upto p.cnt:
- vlist[p.vtx[i]]loc
- if known p.cona: scantokens (p.cona) else: -- fi
- endfor
- fi
- cycle
-enddef;
-def vbuild_polygon_section (suffix p) (expr from, to) =
- vlist[p.vtx[from]]loc
- if known p.cona: scantokens (p.cona) else: -- fi
- p.pull[c,.5[vlist[p.vtx[from]]loc,vlist[p.vtx[to]]loc]]
- if known p.conb: scantokens (p.conb) else: -- fi
-enddef;
-vardef pcenter suffix p =
- (origin for i = 1 upto p.cnt:
- + vlist[p.vtx[i]]loc
- endfor) / p.cnt
-enddef;
-vardef vdraw_arc_label (expr arc) (suffix lbl) =
- if lbl <> "":
- save _a, _z, _zz, _r;
- numeric _a;
- pair _z, _zz, _r;
- _z := point .5 length (arc) of arc;
- if lbl.dist = 0:
- LaTeX_text (_z, whatever, lbl);
- else:
- _r := direction .5 length (arc) of arc rotated - 90;
- if lbl.side = "left":
- _a := angle (-_r);
- elseif lbl.side = "right":
- _a := angle (_r);
- else:
- _zz = _z - .5[point 0 of arc, point infinity of arc];
- if ((_zz if length (_zz) > 0: / length (_zz) fi)
- dotprod _r) >= 0:
- _a := angle (_r);
- else:
- _a := angle (-_r);
- fi
- fi
- LaTeX_text (_z + lbl.dist * dir _a, _a, lbl);
- fi
- fi
-enddef;
-vardef vdraw_label (expr loc) (suffix lbl) =
- if lbl <> "":
- save a;
- numeric a;
- if lbl.dist = 0:
- LaTeX_text (loc, whatever, lbl);
- else:
- if unknown lbl.ang:
- if loc = (.5w,.5h):
- a := 0;
- else:
- a := angle (loc - (.5w,.5h));
- fi
- else:
- a := lbl.ang;
- fi
- LaTeX_text (loc + lbl.dist * dir a, a, lbl);
- fi
- fi
-enddef;
-vardef vdraw_vertex suffix v =
- if known v.decor.shape:
- if known v.fore:
- save foreground;
- color foreground;
- foreground = v.fore;
- fi
- if known v.back:
- save background;
- color background;
- background = v.back;
- fi
- if known v.decor.sty:
- if v.decor.sty = "empty":
- emptydraw (
- elseif v.decor.sty = "full":
- cfilldraw (
- elseif is_a_number v.decor.sty:
- drawhalftone (1 - scantokens v.decor.sty / 100,
- else:
- drawtile (scantokens v.decor.sty,
- fi
- else:
- cfilldraw (
- fi
- v.decor.shape
- if known v.decor.ang: rotated v.decor.ang fi
- scaled v.decor.size shifted v.loc);
- fi
-enddef;
-vardef polygon expr n =
- if n > 2:
- for i = 1 upto n:
- (.5up rotated (360i/n)) --
- endfor
- cycle
- else:
- fullcircle
- fi
-enddef;
-vardef polygram expr n =
- if n > 2:
- for i = 1 upto n:
- (.5up rotated (360i/n)) --
- (.2up rotated (360(i+.5)/n)) --
- endfor
- cycle
- else:
- fullcircle
- fi
-enddef;
-vardef polycross expr n =
- save i;
- for i = 1 upto n:
- origin -- .5 dir (360(i-.5)/n) --
- endfor
- cycle
-enddef;
-vardef vdraw_polygon suffix p =
- if known p.fore:
- save foreground;
- color foreground;
- foreground = p.fore;
- fi
- if known p.back:
- save background;
- color background;
- background = p.back;
- fi
- if known p.sty:
- if p.sty = "phantom":
- elseif p.sty = "empty":
- emptydraw (vbuild_polygon p);
- elseif p.sty = "full":
- cfilldraw (vbuild_polygon p);
- elseif is_a_number p.sty:
- drawhalftone (1 - scantokens p.sty / 100, vbuild_polygon p);
- else:
- drawtile (scantokens p.sty, vbuild_polygon p);
- fi
- else:
- cdraw (vbuild_polygon p);
- fi
-enddef;
-vardef LaTeX expr text =
- if LaTeX_file = "":
- LaTeX_file := jobname & ".t" & decimal charcode;
- write ("% " & LaTeX_file & " -- generated from " & jobname & ".mp")
- to LaTeX_file;
- fi
- write (text & "%") to LaTeX_file
-enddef;
-vardef LaTeX_text (expr z, a, txt) =
- LaTeX "\fmfL(" & (decimal (xpart z/LaTeX_unitlength)) & ","
- & (decimal (ypart z/LaTeX_unitlength)) & ","
- & (voctant a) & "){" & txt & "}";
-enddef;
-vardef voctant expr a =
- if known a:
- voctant_list[floor (a/45 + .5)]
- else:
- "c"
- fi
-enddef;
-string voctant_list[];
-voctant_list[-4] := "r";
-voctant_list[-3] := "rt";
-voctant_list[-2] := "t";
-voctant_list[-1] := "lt";
-voctant_list[0] := "l";
-voctant_list[1] := "lb";
-voctant_list[2] := "b";
-voctant_list[3] := "rb";
-voctant_list[4] := "r";
-vardef vdump =
- message ">>>>> Vertices and arcs for diagram #" & decimal charcode
- & " of " & jobname & ".mf:";
- for i = vertices:
- message "> " & vlist[i]name & "=" & decimal_pair (vlist[i]loc)
- & ": #lines="
- & decimal (vlist[i]arc.last - vlist[i]arc.first + 1)
- if vlist[i]lbl <> "":
- & ", lbl=" & vlist[i]lbl
- & ", l.angle=" & decimal_ (vlist[i]lbl.ang)
- & ", l.dist=" & decimal_ (vlist[i]lbl.dist)
- fi
- & ".";
- endfor
- for i = vertices:
- for j = varcs (i):
- if known vlist[i]arc[j]sty:
- message "> " & vlist[i]name & "*" & vlist[vlist[i]arc[j]]name
- & ": " & vlist[i]arc[j]sty
- & ", tns=" & decimal_ (vlist[i]arc[j]tns)
- & ", lsr=" & decimal_ (vlist[i]arc[j]lsr)
- & ", wd=" & decimal_ (vlist[i]arc[j]wd)
- & ", rub=" & decimal_ (vlist[i]arc[j]rub)
- if vlist[i]arc[j]lbl <> "":
- & ", lbl=" & vlist[i]arc[j]lbl
- & ", l.side=" & vlist[i]arc[j]lbl.side
- & ", l.dist=" & decimal_ (vlist[i]arc[j]lbl.dist)
- fi
- & ".";
- fi
- endfor
- for j = vconstr (i):
- if i < vlist[i]constr[j]:
- save z;
- pair z;
- z = vlist[vlist[i]constr[j]]loc - vlist[i]loc;
- message "> " & vlist[i]name & "&"
- & vlist[vlist[i]constr[j]]name
- & ": " & decimal_pair (z);
- fi
- endfor;
- endfor
-enddef;
-vardef decimal_ (text n) =
- if known n: decimal n else: "?" fi
-enddef;
-vardef decimal_pair (text z) =
- "(" & decimal_ (xpart z) & "," & decimal_ (ypart z) & ")"
-enddef;
-def show_diagram_ expr frame =
- if (screen_cols < w + 2 xpart frame) or (screen_rows < h + 2 ypart frame):
- screen_cols := w + 2 xpart frame;
- screen_rows := h + 2 ypart frame;
- openwindow currentwindow
- from origin to (screen_rows, screen_cols)
- at (- xpart frame, h + ypart frame);
- fi
- showit_;
- if showstopping > 0:
- stop "This is diagram #" & decimal charcode
- & ". Hit return to continue...";
- fi
-enddef;
-def show_diagram =
- def show_diagram =
- display blankpicture inwindow currentwindow;
- show_diagram_
- enddef;
- show_diagram_
-enddef;
-def show_all_diagrams expr frame =
- def showit = show_diagram frame enddef;
- displaying:=1;
-enddef;
-endinput;
-\endinput
-%%
-%% End of file `feynmp.mp'.
Index: branches/ohl/omega-development/hgg-vertex/share/doc/Makefile.am
===================================================================
--- branches/ohl/omega-development/hgg-vertex/share/doc/Makefile.am (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/share/doc/Makefile.am (revision 8717)
@@ -1,182 +0,0 @@
-# Makefile.am -- Makefile for O'Mega within and without WHIZARD
-# $Id$
-##
-## Process this file with automake to produce Makefile.in
-##
-########################################################################
-#
-# Copyright (C) 1999-2010 by
-# Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
-# Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
-# Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-#
-# 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.
-#
-########################################################################
-
-########################################################################
-### TODO: fix weaving of lexers and parsers
-########################################################################
-
-include $(top_srcdir)/src/Makefile.sources
-
-VPATH = $(srcdir):$(top_builddir)/src:$(srcdir):$(top_srcdir)/src
-
-## This relies on conventions of Karl Berry's kpathsearch library.
-## Is it safe to assume that all TeX installation use it?
-MPINPUTS = .:$(srcdir):
-
-PICTURES_EPS = \
- el_te_ph.eps \
- modules.eps \
- bhabha.eps bhabha0.eps \
- epemudbardubar.eps epemudbardubar0.eps \
- epemudbarmunumubar.eps epemudbarmunumubar0.eps
-
-PICTURES_PDF = $(PICTURES_EPS:.eps=.pdf)
-
-LATEX_STYLES = \
- flex.cls thophys.sty thohacks.sty \
- noweb.sty ocamlweb.sty \
- feynmp.sty feynmp.mp emp.sty
-
-### Files needed to be installed with the O'Mega distribution
-modelsdir = $(pkgdatadir)/doc
-if SUPP_PDF_AVAILABLE
-dist_doc_DATA = omega.pdf
-else
-dist_doc_DATA =
-endif
-
-EXTRA_DIST = $(PICTURES_EPS) $(LATEX_STYLES)
-
-if NOWEB_AVAILABLE
-pdf-local: \
- omega.pdf
-else
-pdf-local:
-endif
-
-SUFFIXES = .mly .mll .ml .implementation .mli .interface .nw .tex .dvi .eps .pdf .ps
-
-if SUPP_PDF_AVAILABLE
-if PDFLATEX_AVAILABLE
-.tex.pdf:
- -$(PDFLATEX) $<
-if MPOST_AVAILABLE
- MPINPUTS=$(MPINPUTS) $(MPOST) $*pics
- TEX=$(LATEX) $(MPOST) $*
-endif
- echo "skipping -bibtex $*"
- $(PDFLATEX) $<
- while $(GREP) -s 'Rerun to get cross-references right.' $*.log; do \
- $(PDFLATEX) $<; \
- done
-else
-if LATEX_AVAILABLE
-if DVIPS_AVAILABLE
-if PS2PDF_AVAILABLE
- -$(LATEX) $<
-if MPOST_AVAILABLE
- MPINPUTS=$(MPINPUTS) $(MPOST) $*pics
- TEX=$(LATEX) MPINPUTS=$(MPINPUTS) $(MPOST) $*
-endif
- echo "skipping -bibtex $*"
- $(LATEX) $<
- while $(GREP) -s 'Rerun to get cross-references right.' $*.log; do \
- $(LATEX) $<; \
- done
- $(DVIPS) $*
- $(PS2PDF) $*
-endif
-endif
-endif
-endif
-endif
-
-OMEGA_CORE_INTERFACES = $(OMEGA_CORE_MLI:.mli=.interface)
-OMEGA_CORE_IMPLEMENTATIONS = $(OMEGA_CORE_ML:.ml=.implementation)
-OMEGA_MODELLIB_INTERFACES = $(OMEGA_MODELLIB_MLI:.mli=.interface)
-OMEGA_MODELLIB_IMPLEMENTATIONS = $(OMEGA_MODELLIB_ML:.ml=.implementation)
-OMEGA_TARGETLIB_INTERFACES = $(OMEGA_TARGETLIB_MLI:.mli=.interface)
-OMEGA_TARGETLIB_IMPLEMENTATIONS = $(OMEGA_TARGETLIB_ML:.ml=.implementation)
-OMEGA_APPLICATIONS_IMPLEMENTATIONS = $(OMEGA_APPLICATIONS_ML:.ml=.implementation)
-
-OMEGA_INTERFACES = \
- $(OMEGA_CORE_INTERFACES) \
- $(OMEGA_MODELLIB_INTERFACES) \
- $(OMEGA_TARGETLIB_INTERFACES)
-
-OMEGA_IMPLEMENTATIONS = \
- $(OMEGA_CORE_IMPLEMENTATIONS) \
- $(OMEGA_MODELLIB_IMPLEMENTATIONS) \
- $(OMEGA_TARGETLIB_IMPLEMENTATIONS) \
- $(OMEGA_APPLICATIONS_IMPLEMENTATIONS)
-
-if !NOWEB_AVAILABLE
-
-omega.pdf:
-
-else NOWEB_AVAILABLE
-
-omega.pdf: \
- $(OMEGA_INTERFACES) $(OMEGA_IMPLEMENTATIONS) omegalib.tex index.tex \
- $(PICTURES_PDF) $(PICTURES_PS)
-
-.nw.tex:
- $(NOWEAVE) -delay $< | $(CPIF) $@
-
-if OCAMLWEB_AVAILABLE
-
-.mll.implementation:
- $(OCAMLWEB) --no-preamble --noweb --no-index $< >$@
-
-.mly.implementation:
- $(OCAMLWEB) --no-preamble --noweb --no-index $< >$@
-
-.ml.implementation:
- $(OCAMLWEB) --no-preamble --noweb --no-index $< >$@
-
-.mli.interface:
- $(OCAMLWEB) --no-preamble --noweb --no-index $< >$@
-
-index.tex: $(OMEGA_CAML)
- $(OCAMLWEB) --no-preamble --noweb $^ | \
- sed -n '/\\ocwbeginindex{}/,/\\ocwendindex{}/p' >$@
-
-endif OCAMLWEB_AVAILABLE
-
-endif NOWEB_AVAILABLE
-
-if EPSTOPDF_AVAILABLE
-.eps.pdf:
- $(EPSTOPDF) --outfile=$@ $<
-endif
-
-########################################################################
-
-clean-local:
- rm -f *.pdf *.log *.aux *.toc *.mp *.mpx *.idx *.out \
- omegapics.t[0-9]* omegapics.[0-9]* \
- $(OMEGA_INTERFACES) $(OMEGA_IMPLEMENTATIONS) omegalib.tex \
- $(PICTURES_PDF) $(PICTURES_PS) \
- index.tex
-
-distclean-local:
- -test "$(srcdir)" != "." && rm -f $(LATEX_STYLES)
-
-########################################################################
-## The End.
-########################################################################
Index: branches/ohl/omega-development/hgg-vertex/tests/Makefile.am
===================================================================
--- branches/ohl/omega-development/hgg-vertex/tests/Makefile.am (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/tests/Makefile.am (revision 8717)
@@ -1,98 +0,0 @@
-# Makefile.am -- Makefile for O'Mega within and without WHIZARD
-# $Id$
-##
-## Process this file with automake to produce Makefile.in
-##
-########################################################################
-#
-# Copyright (C) 1999-2010 by
-# Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
-# Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
-# Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-#
-# 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.
-#
-########################################################################
-
-SUBDIRS = MSSM SM people
-
-EXTRA_DIST = $(srcdir)/test_functions \
- test_qed_eemm test_qed_eeee \
- test_sm_eemm test_sm_eeee test_sm_uugg
-
-TESTS = \
- test_qed_eemm test_qed_eeee \
- test_sm_eemm test_sm_eeee test_sm_uugg \
- test2_qed_eemm \
- test_color_factors
-
-XFAIL_TESTS =
-
-EXTRA_PROGRAMS = \
- test2_qed_eemm \
- test_color_factors
-
-test2_qed_eemm_SOURCES = test2_qed_eemm.f90 parameters_qed.f90
-nodist_test2_qed_eemm_SOURCES = amplitude_qed_eemm.f90
-test2_qed_eemm_LDADD = $(top_builddir)/src/libomega_core.la
-
-test_color_factors_SOURCES = test_color_factors.f90 parameters_qcd.f90
-nodist_test_color_factors_SOURCES = amplitude_color_factors.f90
-test_color_factors_LDADD = $(top_builddir)/src/libomega_core.la
-
-OMEGA_QED = $(top_builddir)/bin/omega_QED.opt
-OMEGA_QED_OPTS = -target:parameter_module parameters_qed
-
-OMEGA_QCD = $(top_builddir)/bin/omega_QCD.opt
-OMEGA_QCD_OPTS = -target:parameter_module parameters_qcd
-
-AM_FCFLAGS = -I$(top_builddir)/src
-
-amplitude_qed_eemm.f90: $(OMEGA_QED) Makefile
- $(OMEGA_QED) $(OMEGA_QED_OPTS) -target:module amplitude_qed_eemm \
- -scatter "e+ e- -> m+ m-" > $@
-
-amplitude_color_factors.f90: $(OMEGA_QCD) Makefile
- $(OMEGA_QCD) $(OMEGA_QCD_OPTS) -target:module amplitude_color_factors \
- -scatter "u ubar -> d dbar" > $@
-
-test2_qed_eemm.o: amplitude_qed_eemm.o
-test2_qed_eemm.o: parameters_qed.o
-amplitude_qed_eemm.o: parameters_qed.o
-
-test_color_factors.o: amplitude_color_factors.o
-test_color_factors.o: parameters_qcd.o
-amplitude_color_factors.o: parameters_qcd.o
-
-installcheck-local:
- PATH=$(bindir):$$PATH; export PATH; \
- LD_LIBRARY_PATH=$(pkglibdir):$$LD_LIBRARY_PATH; export LD_LIBRARY_PATH; \
- omega_QED.opt $(OMEGA_QED_OPTS) -scatter "e+ e- -> m+ m-" > amplitude_qed_eemm.f90; \
- $(FC) $(FCFLAGS) -I$(pkgincludedir) -L$(pkglibdir) \
- $(srcdir)/parameters_qed.f90 amplitude_qed_eemm.f90 \
- $(srcdir)/test2_qed_eemm.f90 -lomega_core; \
- ./a.out
-
-########################################################################
-
-clean-local:
- rm -f a.out gmon.out $(OMEGA_CACHES) *.$(FC_MODULE_EXT) *.o amplitude_*.f90 \
- $(EXTRA_PROGRAMS)
-
-########################################################################
-## The End.
-########################################################################
-
-
Index: branches/ohl/omega-development/hgg-vertex/tests/parameters_qed.f90
===================================================================
--- branches/ohl/omega-development/hgg-vertex/tests/parameters_qed.f90 (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/tests/parameters_qed.f90 (revision 8717)
@@ -1,48 +0,0 @@
-! $Id: parameters.QED.omega.f90,v 1.1 2004/03/11 04:21:17 kilian Exp $
-!
-! Copyright (C) 1999-2009 by
-! Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
-! Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
-! Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-!
-! 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 parameters_qed
- use kinds
-
- implicit none
- private
- public :: init_parameters
-
- real(default), dimension(22), public :: mass, width
- complex(default), public :: qlep
-
- integer, parameter :: qelep = -1
- complex(default), parameter :: e = 0.3_default
-
-contains
-
- subroutine init_parameters
- mass(1:22) = 0
- width(1:22) = 0
- ! mass(11) = 511e-6_default
- ! mass(13) = 105.66e-3_default
- ! mass(15) = 1.777_default
- qlep = - e * qelep
- end subroutine init_parameters
-
-end module parameters_qed
Index: branches/ohl/omega-development/hgg-vertex/tests/test2_qed_eemm.f90
===================================================================
--- branches/ohl/omega-development/hgg-vertex/tests/test2_qed_eemm.f90 (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/tests/test2_qed_eemm.f90 (revision 8717)
@@ -1,83 +0,0 @@
-! $Id$
-! driver.f90 -- O'Mega self test driver
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!
-! Copyright (C) 1999-2009 by
-! Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
-! Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
-! Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-!
-! 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.
-!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-program test2_qed_eemm
-
- use kinds
- use parameters_qed
- use amplitude_qed_eemm
-
- real(default), dimension(0:3,4) :: p
- complex(default) :: a
- integer :: h, n_flv, n_hel, n_col
-
- n_flv = number_flavor_states ()
- n_hel = number_spin_states ()
- n_col = number_color_flows ()
-
- if (n_flv /= 1) then
- print *, "unexpected # of flavor combinations"
- stop 1
- end if
-
- if (n_hel /= 16) then
- print *, "unexpected # of helicity combinations"
- stop 1
- end if
-
- if (n_col /= 1) then
- print *, "unexpected # of color flows"
- stop 1
- end if
-
- call init_parameters
-
- p(:,1) = (/ 100.0_default, 0.0_default, 0.0_default, 100.0_default /)
- p(:,2) = (/ 100.0_default, 0.0_default, 0.0_default, - 100.0_default /)
- p(:,3) = (/ 100.0_default, 0.0_default, 100.0_default, 0.0_default /)
- p(:,4) = (/ 100.0_default, 0.0_default, - 100.0_default, 0.0_default /)
-
- call new_event (p)
-
- do h = 1, n_hel
- a = get_amplitude (1, h, 1)
- ! print *, "HEL = ", h, ", AMP = ", a
- if (h == 6 .OR. h == 10) then
- if (abs (a + (0.0_default, 0.09_default)) > epsilon (1.0_default)) then
- print *, "unexpected value"
- stop 1
- end if
- else if (h == 7 .OR. h == 11) then
- if (abs (a - (0.0_default, 0.09_default)) > epsilon (1.0_default)) then
- print *, "unexpected value"
- stop 1
- end if
- end if
- end do
-
- stop 0
-
-end program test2_qed_eemm
-
Index: branches/ohl/omega-development/hgg-vertex/tests/test_color_factors.f90
===================================================================
--- branches/ohl/omega-development/hgg-vertex/tests/test_color_factors.f90 (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/tests/test_color_factors.f90 (revision 8717)
@@ -1,57 +0,0 @@
-! $Id$
-! driver.f90 -- O'Mega self test driver
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!
-! Copyright (C) 1999-2009 by
-! Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
-! Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
-! Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-!
-! 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.
-!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-program test_color_factors
-
- use kinds
- use parameters_qcd
- use amplitude_color_factors
-
- real(kind=default), allocatable :: cf(:,:)
- real(kind=default), parameter :: NC = 3
- integer :: n_cf
-
- n_cf = number_color_flows ()
- allocate (cf(n_cf,n_cf))
-
- call init_parameters
- call color_factors (cf)
-
- call expect (cf(1,1) - cf(1,2) / NC - cf(2,1) / NC + cf(2,2) / NC**2, NC**2 - 1, 1)
-
- stop 0
-
- contains
-
- subroutine expect (x, y, tolerance)
- real(kind=default), intent(in) :: x, y
- integer, intent(in) :: tolerance
- if (abs (x - y) .gt. tolerance * epsilon (x)) then
- stop 1
- end if
- end subroutine expect
-
-end program test_color_factors
-
Index: branches/ohl/omega-development/hgg-vertex/tests/test_qed_eeee
===================================================================
--- branches/ohl/omega-development/hgg-vertex/tests/test_qed_eeee (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/tests/test_qed_eeee (revision 8717)
@@ -1,28 +0,0 @@
-#! /bin/sh
-# $Id$
-########################################################################
-#
-# Copyright (C) 1999-2009 by
-# Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
-# Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
-# Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-#
-# 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.
-#
-########################################################################
-
-. `dirname $0`/test_functions
-
-expect_summary ../bin/omega_QED.opt "e+ e- -> e+ e-" "SUMMARY: 6 fusions, 2 propagators, 2 diagrams"
\ No newline at end of file
Index: branches/ohl/omega-development/hgg-vertex/tests/test_qed_eemm
===================================================================
--- branches/ohl/omega-development/hgg-vertex/tests/test_qed_eemm (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/tests/test_qed_eemm (revision 8717)
@@ -1,28 +0,0 @@
-#! /bin/sh
-# $Id$
-########################################################################
-#
-# Copyright (C) 1999-2009 by
-# Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
-# Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
-# Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-#
-# 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.
-#
-########################################################################
-
-. `dirname $0`/test_functions
-
-expect_summary ../bin/omega_QED.opt "e+ e- -> m+ m-" "SUMMARY: 3 fusions, 1 propagators, 1 diagrams"
\ No newline at end of file
Index: branches/ohl/omega-development/hgg-vertex/tests/MSSM/main4.f90
===================================================================
--- branches/ohl/omega-development/hgg-vertex/tests/MSSM/main4.f90 (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/tests/MSSM/main4.f90 (revision 8717)
@@ -1,190 +0,0 @@
-! $Id$
-
-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/hgg-vertex/tests/MSSM/Makefile.am
===================================================================
--- branches/ohl/omega-development/hgg-vertex/tests/MSSM/Makefile.am (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/tests/MSSM/Makefile.am (revision 8717)
@@ -1,792 +0,0 @@
-# Makefile.am -- Makefile for O'Mega within and without WHIZARD
-# $Id$
-##
-## Process this file with automake to produce Makefile.in
-##
-########################################################################
-#
-# Copyright (C) 1999-2009 by
-# Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
-# Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
-# Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-#
-# 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
-###
-### auxdir = $(top_srcdir)/src/misc
-###
-### 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.f90=) \
-### -target:module $(@:.f90=) \
-### -target:parameter_module omega_parameters_mssm_4
-###
-### FC_OPT = @FC_OPT@
-### FC_DUSTY = -FI
-### # FC_DUSTY = @FC_DUSTY@
-### FC_WIDE = @FC_WIDE@
-### FC_FLAGS = $(FC_OPT) -I$(build_libdir)
-###
-### if FC_IMPURE
-### FC_FILTER = \
-### sed -e '/^[ ]*elemental[ ]/s/elemental[ ]//' \
-### -e '/^[ ]*pure[ ]/s/pure[ ]//' | $(CPIF)
-### else
-### FC_FILTER = $(CPIF)
-### endif
-###
-### 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 $(@:.f90=.ps); mv $(@:.f90=.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.f90 \
-### obbb_wpwm_module.f90 ozz_hh_module.f90 \
-### oepem_wpwm_module.f90 owpwm_wpwm_module.f90 \
-### owpwm_zz_module.f90 owpwm_za_module.f90 owpwm_aa_module.f90 \
-### oepem_epem_module.f90 oepem_veve_module.f90 \
-### oudb_udb_module.f90 oepem_mumu_module.f90 \
-### oemem_emem_module.f90 oema_ema_module.f90 \
-### oaa_epem_module.f90 oza_epem_module.f90 \
-### oza_uub_module.f90 oza_ddb_module.f90 \
-### ozz_epem_module.f90 ozz_veve_module.f90 \
-### oepem_aa_module.f90 oepem_za_module.f90 oepem_zz_module.f90
-###
-### OMEGA_SRC5 = \
-### oepem_epema_module.f90 oemem_emema_module.f90 \
-### oepem_aaa_module.f90 oepem_zaa_module.f90 \
-### oemep_emvewp_module.f90 \
-### oepem_wpwmz_module.f90 oepem_wpwma_module.f90
-###
-### OMEGA_SRC6 = \
-### oepem_muvmtavt_module.f90 oepem_epveemve_module.f90 \
-### oepem_mumuaa_module.f90 oepem_epemaa_module.f90 \
-### omuem_muemaa_module.f90 oemem_ememaa_module.f90 \
-### oepem_aaaa_module.f90 oepem_epemepem_module.f90 \
-### oemep_emvewpa_module.f90 oemep_vevewpwm_module.f90 \
-### oemep_emepwpwm_module.f90 owpwm_uubssb_module.f90 \
-### oepem_vevebbb_module.f90
-###
-### OMEGA_SRC7 = \
-### oepem_muvmtavta_module.f90 oemep_emveudba_module.f90 \
-### oepem_aaaaa_module.f90 oepem_epemaaa_module.f90 \
-### oepem_epemepema_module.f90 oaa_epemaaa_module.f90 \
-### oaa_epemmumua_module.f90 oaa_epemepema_module.f90 \
-### oepem_veveuubz_module.f90
-###
-### OMEGA_SRC8 = \
-### oepem_muvmtavtaa_module.f90 oepem_epemaaaa_module.f90 \
-### oepem_mumutatauub_module.f90 oepem_muvmtavtuub_module.f90 \
-### oepem_vevemuvmudb_module.f90
-###
-### OMEGA_SRCX = \
-### oepem_wpwmaa_module.f90 \
-### oepem_muvmtavtaa_module.f90 \
-### owpwm_zaa_module.f90 owpwm_aaa_module.f90 owpwm_wpwma_module.f90 \
-### oepem_epvebbbdub_module.f90
-###
-### # OMEGA_SRCT = \
-### # single_top_module.f90 \
-### # single_top_fudged_module.f90 \
-### # single_top_constant_module.f90
-###
-### OMEGA_SRCT = oepem_wpwm_module.f90
-###
-### OMEGA_SRC = \
-### $(OMEGA_SRC4) $(OMEGA_SRC5) $(OMEGA_SRC6) \
-### $(OMEGA_SRC7) $(OMEGA_SRC8) $(OMEGA_SRCX)
-###
-### MADGRAPH_SRC4 = $(patsubst o%_module.f90,%.f90, $(OMEGA_SRC4))
-### MADGRAPH_SRC5 = $(patsubst o%_module.f90,%.f90, $(OMEGA_SRC5))
-### MADGRAPH_SRC6 = $(patsubst o%_module.f90,%.f90, $(OMEGA_SRC6))
-### MADGRAPH_SRC7 = $(patsubst o%_module.f90,%.f90, $(OMEGA_SRC7))
-### MADGRAPH_SRC8 = $(patsubst o%_module.f90,%.f90, $(OMEGA_SRC8))
-### MADGRAPH_SRCX = $(patsubst o%_module.f90,%.f90, $(OMEGA_SRCX))
-### MADGRAPH_SRC = $(patsubst o%_module.f90,%.f90, $(OMEGA_SRC))
-###
-### OMEGA_OBJ4 = $(OMEGA_SRC4:.f90=.o)
-### OMEGA_OBJ5 = $(OMEGA_SRC5:.f90=.o)
-### OMEGA_OBJ6 = $(OMEGA_SRC6:.f90=.o)
-### OMEGA_OBJ7 = $(OMEGA_SRC7:.f90=.o)
-### OMEGA_OBJ8 = $(OMEGA_SRC8:.f90=.o)
-### OMEGA_OBJX = $(OMEGA_SRCX:.f90=.o)
-### OMEGA_OBJ = $(OMEGA_SRC:.f90=.o)
-###
-### OMEGA_OBJT = $(OMEGA_SRCT:.f90=.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_SRC_EXT): %.f90
-### cat $< | $(FC_FILTER) $(build_srcdir)/$*.$(FC_SRC_EXT)
-###
-### %.o: $(build_srcdir)/%.$(FC_SRC_EXT) parameters.MSSM_4.omega.o
-### $(FC) $(FC_FLAGS) -c -o $@ $<
-###
-### %_p.o: $(build_srcdir)/%.$(FC_SRC_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_SRC_EXT) lib$(HELAS).a
-### $(FC) $(FC_DUSTY) $(FC_FLAGS) $(FC_WIDE) -c -o $@ $<
-###
-### madgraph5.o: $(build_srcdir)/madgraph5.$(FC_SRC_EXT) lib$(HELAS).a
-### $(FC) $(FC_DUSTY) $(FC_FLAGS) $(FC_WIDE) -c -o $@ $<
-###
-### madgraph6.o: $(build_srcdir)/madgraph6.$(FC_SRC_EXT) lib$(HELAS).a
-### $(FC) $(FC_DUSTY) $(FC_FLAGS) $(FC_WIDE) -c -o $@ $<
-###
-### madgraph7.o: $(build_srcdir)/madgraph7.$(FC_SRC_EXT) lib$(HELAS).a
-### $(FC) $(FC_DUSTY) $(FC_FLAGS) $(FC_WIDE) -c -o $@ $<
-###
-### madgraph8.o: $(build_srcdir)/madgraph8.$(FC_SRC_EXT) lib$(HELAS).a
-### $(FC) $(FC_DUSTY) $(FC_FLAGS) $(FC_WIDE) -c -o $@ $<
-###
-### madgraphx.o: $(build_srcdir)/madgraphx.$(FC_SRC_EXT) lib$(HELAS).a
-### $(FC) $(FC_DUSTY) $(FC_FLAGS) $(FC_WIDE) -c -o $@ $<
-###
-### ########################################################################
-### #
-### # 4 external lines:
-### #
-### ########################################################################
-###
-### ozz_hh_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "Z Z -> H H" >$@
-###
-### odbd_wpwm_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "dbar d -> W+ W-" >$@
-###
-### obbb_wpwm_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "bbar b -> W+ W-" >$@
-###
-### owpwm_aa_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "W+ W- -> A A" >$@
-###
-### owpwm_za_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "W+ W- -> Z A" >$@
-###
-### owpwm_zz_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "W+ W- -> Z Z" >$@
-###
-### owpwm_wpwm_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "W+ W- -> W+ W-" >$@
-###
-### oepem_wpwm_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> W+ W-" >$@
-###
-### oepem_epem_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> e+ e-" >$@
-###
-### oepem_veve_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> nue nuebar" >$@
-###
-### oudb_udb_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "u dbar -> u dbar" >$@
-###
-### oepem_mumu_module.f90: $(OMEGA_QED)
-### $(OMEGA_QED) $(OFLAGS) -scatter "e+ e- -> m+ m-" >$@
-###
-### oepem_aa_module.f90: $(OMEGA_QED)
-### $(OMEGA_QED) $(OFLAGS) -scatter "e+ e- -> A A" >$@
-###
-### oepem_za_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> Z A" >$@
-###
-### oepem_zz_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> Z Z" >$@
-###
-### oaa_epem_module.f90: $(OMEGA_QED)
-### $(OMEGA_QED) $(OFLAGS) -scatter "A A -> e+ e-" >$@
-###
-### oza_epem_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "Z A -> e+ e-" >$@
-###
-### ozz_epem_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "Z Z -> e+ e-" >$@
-###
-### ozz_veve_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "Z Z -> nue nuebar" >$@
-###
-### oza_uub_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "Z A -> u ubar" >$@
-###
-### oza_ddb_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "Z A -> d dbar" >$@
-###
-### oemem_emem_module.f90: $(OMEGA_QED)
-### $(OMEGA_QED) $(OFLAGS) -scatter "e- e- -> e- e-" >$@
-###
-### oema_ema_module.f90: $(OMEGA_QED)
-### $(OMEGA_QED) $(OFLAGS) -scatter "e- A -> e- A" >$@
-###
-### ifneq ($(MADGRAPH),false)
-###
-### zz_hh.f90:
-### (echo "z z -> h h"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### dbd_wpwm.f90:
-### (echo "d~ d -> w+ w-"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### bbb_wpwm.f90:
-### (echo "b~ b -> w+ w-"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### wpwm_wpwm.f90:
-### (echo "w+ w- -> w+ w-"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### wpwm_aa.f90:
-### (echo "w+ w- -> a a"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### wpwm_za.f90:
-### (echo "w+ w- -> z a"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### wpwm_zz.f90:
-### (echo "w+ w- -> z z"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### epem_wpwm.f90:
-### (echo "e+ e- -> w+ w-"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### epem_epem.f90:
-### (echo "e+ e- -> e+ e-"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### udb_udb.f90:
-### (echo "u d~ -> u d~"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### epem_veve.f90:
-### (echo "e+ e- -> ve ve~"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### epem_mumu.f90:
-### (echo "e+ e- -> mu+ mu-"; $(MG_QED)) | $(RUN_MADGRAPH)
-###
-### epem_aa.f90:
-### (echo "e+ e- -> a a"; $(MG_QED)) | $(RUN_MADGRAPH)
-###
-### epem_za.f90:
-### (echo "e+ e- -> z a"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### epem_zz.f90:
-### (echo "e+ e- -> z z"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### aa_epem.f90:
-### (echo "a a -> e+ e-"; $(MG_QED)) | $(RUN_MADGRAPH)
-###
-### za_epem.f90:
-### (echo "z a -> e+ e-"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### za_uub.f90:
-### (echo "z a -> u u~"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### za_ddb.f90:
-### (echo "z a -> d d~"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### zz_epem.f90:
-### (echo "z z -> e+ e-"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### zz_veve.f90:
-### (echo "z z -> ve ve~"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### emem_emem.f90:
-### (echo "e- e- -> e- e-"; $(MG_QED)) | $(RUN_MADGRAPH)
-###
-### ema_ema.f90:
-### (echo "e- a -> e- a"; $(MG_QED)) | $(RUN_MADGRAPH)
-###
-### endif
-###
-### ########################################################################
-### #
-### # 5 external lines:
-### #
-### ########################################################################
-###
-### owpwm_zaa_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "W+ W- -> Z A A" >$@
-###
-### owpwm_wpwma_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "W+ W- -> W+ W- A" >$@
-###
-### owpwm_aaa_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "W+ W- -> A A A" >$@
-###
-### oemep_emvewp_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "e- e+ -> e- nuebar W+" >$@
-###
-### oepem_epema_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> e+ e- A" >$@
-###
-### oemem_emema_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "e- e- -> e- e- A" >$@
-###
-### oepem_aaa_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> A A A" >$@
-###
-### oepem_zaa_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> Z A A" >$@
-###
-### oepem_wpwmz_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> W+ W- Z" >$@
-###
-### oepem_wpwma_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> W+ W- A" >$@
-###
-### ifneq ($(MADGRAPH),false)
-###
-### wpwm_zaa.f90:
-### (echo "w+ w- -> z a a"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### wpwm_wpwma.f90:
-### (echo "w+ w- -> w+ w- a"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### wpwm_aaa.f90:
-### (echo "w+ w- -> a a a"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### emep_emvewp.f90:
-### (echo "e- e+ -> e- ve~ w+"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### epem_epema.f90:
-### (echo "e+ e- -> e+ e- a"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### emem_emema.f90:
-### (echo "e- e- -> e- e- a"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### epem_aaa.f90:
-### (echo "e+ e- -> a a a"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### epem_zaa.f90:
-### (echo "e+ e- -> z a a"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### epem_wpwmz.f90:
-### (echo "e+ e- -> w+ w- z"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### epem_wpwma.f90:
-### (echo "e+ e- -> w+ w- a"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### endif
-###
-### ########################################################################
-### #
-### # 6 external lines:
-### #
-### ########################################################################
-###
-### oemep_emvewpa_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "e- e+ -> e- nuebar W+ A" >$@
-###
-### owpwm_uubssb_module.f90:
-### $(OMEGA_SM) $(OFLAGS) \
-### -target:function $(@:_module.f90=) -target:module $(@:.f90=) \
-### -scatter "W+ W- -> u ubar s sbar" | \
-### sed '/! CAVEAT: color factor not known!/s||amp = amp * sqrt (9.0_omega_prec / 1.0_omega_prec) ! CAVEAT: naive color factor|' >$@
-###
-### oemep_vevewpwm_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "e- e+ -> nue nuebar W+ W-" >$@
-###
-### oemep_emepwpwm_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "e- e+ -> e- e+ W+ W-" >$@
-###
-### oepem_muvmtavt_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> mu- numubar tau+ nutau" >$@
-###
-### oepem_epveemve_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> e+ nue e- nuebar" >$@
-###
-### oepem_mumuaa_module.f90: $(OMEGA_QED)
-### $(OMEGA_QED) $(OFLAGS) -scatter "e+ e- -> m+ m- A A" >$@
-###
-### oepem_epemaa_module.f90: $(OMEGA_QED)
-### $(OMEGA_QED) $(OFLAGS) -scatter "e+ e- -> e+ e- A A" >$@
-###
-### omuem_muemaa_module.f90: $(OMEGA_QED)
-### $(OMEGA_QED) $(OFLAGS) -scatter "m- e- -> m- e- A A" >$@
-###
-### oemem_ememaa_module.f90: $(OMEGA_QED)
-### $(OMEGA_QED) $(OFLAGS) -scatter "e- e- -> e- e- A A" >$@
-###
-### oepem_aaaa_module.f90: $(OMEGA_QED)
-### $(OMEGA_QED) $(OFLAGS) -scatter "e+ e- -> A A A A" >$@
-###
-### oepem_epemepem_module.f90: $(OMEGA_QED)
-### $(OMEGA_QED) $(OFLAGS) -scatter "e+ e- -> e+ e- e+ e-" >$@
-###
-### oepem_wpwmaa_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> W+ W- A A" >$@
-###
-### oepem_vevebbb_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> nue nuebar b bbar" >$@
-###
-### ifneq ($(MADGRAPH),false)
-###
-### wpwm_uubssb.f90:
-### (echo "w+ w- -> u u~ s s~"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### emep_vevewpwm.f90:
-### (echo "e- e+ -> ve ve~ w+ w-"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### emep_emepwpwm.f90:
-### (echo "e- e+ -> e- e+ w+ w-"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### emep_emvewpa.f90:
-### (echo "e- e+ -> e- ve~ w+ a"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### epem_muvmtavt.f90:
-### (echo "e+ e- -> mu- vm~ ta+ vt"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### epem_epveemve.f90:
-### (echo "e+ e- -> e+ ve e- ve~"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### epem_mumuaa.f90:
-### (echo "e+ e- -> mu+ mu- a a"; $(MG_QED)) | $(RUN_MADGRAPH)
-###
-### epem_epemaa.f90:
-### (echo "e+ e- -> e+ e- a a"; $(MG_QED)) | $(RUN_MADGRAPH)
-###
-### muem_muemaa.f90:
-### (echo "mu- e- -> mu- e- a a"; $(MG_QED)) | $(RUN_MADGRAPH)
-###
-### emem_ememaa.f90:
-### (echo "e- e- -> e- e- a a"; $(MG_QED)) | $(RUN_MADGRAPH)
-###
-### epem_aaaa.f90:
-### (echo "e+ e- -> a a a a"; $(MG_QED)) | $(RUN_MADGRAPH)
-###
-### epem_epemepem.f90:
-### (echo "e+ e- -> e+ e- e+ e-"; $(MG_QED)) | $(RUN_MADGRAPH)
-###
-### epem_wpwmaa.f90:
-### (echo "e+ e- -> w+ w- a a"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### epem_vevebbb.f90:
-### (echo "e+ e- -> ve ve~ b b~"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### endif
-###
-### ########################################################################
-### #
-### # 7 external lines:
-### #
-### ########################################################################
-###
-### oemep_emveudba_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) e- e+ e- nuebar u dbar A >$@
-###
-### oepem_veveuubz_module.f90:
-### $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> nue nuebar u ubar Z" >$@
-###
-### oepem_muvmtavta_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> mu- numubar tau+ nutau A" >$@
-###
-### oepem_epemepema_module.f90: $(OMEGA_QED)
-### $(OMEGA_QED) $(OFLAGS) -scatter "e+ e- -> e+ e- e+ e- A" >$@
-###
-### oepem_epemaaa_module.f90: $(OMEGA_QED)
-### $(OMEGA_QED) $(OFLAGS) -scatter "e+ e- -> e+ e- A A A" >$@
-###
-### oepem_aaaaa_module.f90: $(OMEGA_QED)
-### $(OMEGA_QED) $(OFLAGS) -scatter "e+ e- -> A A A A A" >$@
-###
-### oaa_epemaaa_module.f90: $(OMEGA_QED)
-### $(OMEGA_QED) $(OFLAGS) -scatter "A A -> e+ e- A A A" >$@
-###
-### oaa_epemmumua_module.f90: $(OMEGA_QED)
-### $(OMEGA_QED) $(OFLAGS) -scatter "A A -> e+ e- m+ m- A" >$@
-###
-### oaa_epemepema_module.f90: $(OMEGA_QED)
-### $(OMEGA_QED) $(OFLAGS) -scatter "A A -> e+ e- e+ e- A" >$@
-###
-### ifneq ($(MADGRAPH),false)
-###
-### epem_veveuubz.f90:
-### (echo "e+ e- -> ve ve~ u u~ Z"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### emep_emveudba.f90:
-### (echo "e- e+ -> e- ve~ u d~ a"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### epem_muvmtavta.f90:
-### (echo "e+ e- -> mu- vm~ ta+ vt a"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### epem_epemaaa.f90:
-### (echo "e+ e- -> e+ e- a a a"; $(MG_QED)) | $(RUN_MADGRAPH)
-###
-### epem_epemepema.f90:
-### (echo "e+ e- -> e+ e- e+ e- a"; $(MG_QED)) | $(RUN_MADGRAPH)
-###
-### epem_aaaaa.f90:
-### (echo "e+ e- -> a a a a a"; $(MG_QED)) | $(RUN_MADGRAPH)
-###
-### aa_epemaaa.f90:
-### (echo "a a -> e+ e- a a a"; $(MG_QED)) | $(RUN_MADGRAPH)
-###
-### aa_epemmumua.f90:
-### (echo "a a -> e+ e- mu+ mu- a"; $(MG_QED)) | $(RUN_MADGRAPH)
-###
-### aa_epemepema.f90:
-### (echo "a a -> e+ e- e+ e- a"; $(MG_QED)) | $(RUN_MADGRAPH)
-###
-### endif
-###
-### ########################################################################
-### #
-### # 8 external lines:
-### #
-### ########################################################################
-###
-### oepem_muvmtavtaa_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> mu- numubar tau+ nutau A A" >$@
-###
-### oepem_epemaaaa_module.f90: $(OMEGA_QED)
-### $(OMEGA_QED) $(OFLAGS) -scatter "e+ e- -> e+ e- A A A A" >$@
-###
-### oepem_mumutatauub_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> mu+ mu- tau+ tau- u ubar" >$@
-###
-### oepem_muvmtavtuub_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> mu- numubar tau+ nutau u ubar" >$@
-###
-### oepem_vevemuvmudb_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> nue nuebar mu- numubar u dbar" >$@
-###
-### oepem_epvebbbdub_module.f90: $(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_omega_prec / 1.0_omega_prec) ! CAVEAT: naive color factor|' >$@
-###
-### single_top_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> e+ nue b bbar d ubar" >$@
-###
-### single_top_fudged_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) -model:fudged_width $(OFLAGS) \
-### -scatter "e+ e- -> e+ nue b bbar d ubar" >$@
-###
-### single_top_constant_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) -model:constant_width $(OFLAGS) \
-### -scatter "e+ e- -> e+ nue b bbar d ubar" >$@
-###
-### ifneq ($(MADGRAPH),false)
-###
-### epem_muvmtavtaa.f90:
-### (echo "e+ e- -> mu- vm~ ta+ vt a a"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### epem_epemaaaa.f90:
-### (echo "e+ e- -> e+ e- a a a a"; $(MG_QED)) | $(RUN_MADGRAPH)
-###
-### epem_mumutatauub.f90:
-### (echo "e+ e- -> mu+ mu- ta+ ta- u u~"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### epem_muvmtavtuub.f90:
-### (echo "e+ e- -> mu- vm~ ta+ vt u u~"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### epem_vevemuvmudb.f90:
-### (echo "e+ e- -> ve ve~ mu- vm~ u d~"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### epem_epvebbbdub.f90:
-### (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_SRC_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.f90: $(MADGRAPH_SRC4) Makefile
-### (echo " module madgraph4"; \
-### $(MADGRAPH_HEADER) $(MADGRAPH_SRC4); \
-### echo " end module madgraph4" ) >$@
-###
-### madgraph5.f90: $(MADGRAPH_SRC5) Makefile
-### (echo " module madgraph5"; \
-### $(MADGRAPH_HEADER) $(MADGRAPH_SRC5); \
-### echo " end module madgraph5" ) >$@
-###
-### madgraph6.f90: $(MADGRAPH_SRC6) Makefile
-### (echo " module madgraph6"; \
-### $(MADGRAPH_HEADER) $(MADGRAPH_SRC6); \
-### echo " end module madgraph6" ) >$@
-###
-### madgraph7.f90: $(MADGRAPH_SRC7) Makefile
-### (echo " module madgraph7"; \
-### $(MADGRAPH_HEADER) $(MADGRAPH_SRC7); \
-### echo " end module madgraph7" ) >$@
-###
-### madgraph8.f90: $(MADGRAPH_SRC8) Makefile
-### (echo " module madgraph8"; \
-### $(MADGRAPH_HEADER) $(MADGRAPH_SRC8); \
-### echo " end module madgraph8" ) >$@
-###
-### madgraphx.f90: $(MADGRAPH_SRCX) Makefile
-### (echo " module madgraphx"; \
-### $(MADGRAPH_HEADER) $(MADGRAPH_SRCX); \
-### echo " end module madgraphx" ) >$@
-###
-### omega_amplitudes4.f90: Makefile
-### (echo "module $(@:.f90=)"; \
-### for m in $(OMEGA_SRC4:.f90=); do echo " use $$m"; done; \
-### echo " public"; \
-### echo "end module $(@:.f90=)") >$@
-###
-### omega_amplitudes5.f90: Makefile
-### (echo "module $(@:.f90=)"; \
-### for m in $(OMEGA_SRC5:.f90=); do echo " use $$m"; done; \
-### echo " public"; \
-### echo "end module $(@:.f90=)") >$@
-###
-### omega_amplitudes6.f90: Makefile
-### (echo "module $(@:.f90=)"; \
-### for m in $(OMEGA_SRC6:.f90=); do echo " use $$m"; done; \
-### echo " public"; \
-### echo "end module $(@:.f90=)") >$@
-###
-### omega_amplitudes7.f90: Makefile
-### (echo "module $(@:.f90=)"; \
-### for m in $(OMEGA_SRC7:.f90=); do echo " use $$m"; done; \
-### echo " public"; \
-### echo "end module $(@:.f90=)") >$@
-###
-### omega_amplitudes8.f90: Makefile
-### (echo "module $(@:.f90=)"; \
-### for m in $(OMEGA_SRC8:.f90=); do echo " use $$m"; done; \
-### echo " public"; \
-### echo "end module $(@:.f90=)") >$@
-###
-### omega_amplitudesx.f90: Makefile
-### (echo "module $(@:.f90=)"; \
-### for m in $(OMEGA_SRCX:.f90=); do echo " use $$m"; done; \
-### echo " public"; \
-### echo "end module $(@:.f90=)") >$@
-###
-### omega_amplitudest.f90: Makefile
-### (echo "module $(@:.f90=)"; \
-### for m in $(OMEGA_SRCT:.f90=); do echo " use $$m"; done; \
-### echo " public"; \
-### echo "end module $(@:.f90=)") >$@
-###
-### omega_amplitudes.o: $(OMEGA_OBJ)
-###
-### madgraph.o: $(auxdir)/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)=======
Index: branches/ohl/omega-development/hgg-vertex/tests/MSSM/dhelas.f90
===================================================================
--- branches/ohl/omega-development/hgg-vertex/tests/MSSM/dhelas.f90 (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/tests/MSSM/dhelas.f90 (revision 8717)
@@ -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 <e,A,e'|
-C
- implicit none
- COMPLEX*16 EAO(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.*CHLF**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
- EAO((5-3*NHE)/2) = COEFF*ME*S*(1.+XNNP*.5)
- EAO((5-NHE)/2) = RNHE*XNNP *COEFF*ME*SHLF**2*PHS
- EAO((5+NHE)/2) = COEFF*EB*S*(-2.+XNNM)
- EAO((5+3*NHE)/2) = REAL(NHA-NHE)*COEFF*EB*X*CHLF**2*PHS*2.
-C
- EAO(5) = EB*dCMPLX( X-1. , X*C+1. )
- EAO(6) = EB*X*S*dCMPLX( CSP , SNP )
-C
- RETURN
- end subroutine
-c
-c ----------------------------------------------------------------------
-c
- subroutine fsixxx(fi,sc,gc,fmass,fwidth , fsi)
-c
-c this subroutine computes an off-shell fermion wavefunction from a
-c flowing-in external fermion and a vector boson.
-c
-c input:
-c complex*16 fi(6) : flow-in fermion |fi>
-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 <fo|
-c complex*16 sc(6) : 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 fso(6) : off-shell fermion <fo,s,f'|
-c
- complex*16 fo(6),sc(6),fso(6),gc(2),sl1,sl2,sr1,sr2,ds
- real*8 pf(0:3),fmass,fwidth,pf2,p0p3,p0m3
-c
- fso(5) = fo(5)+sc(2)
- fso(6) = fo(6)+sc(3)
-c
- pf(0)=dble( fso(5))
- pf(1)=dble( fso(6))
- pf(2)=dimag(fso(6))
- pf(3)=dimag(fso(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(2)*(p0p3*fo(3) +fso(6) *fo(4))
- sl2=gc(2)*(p0m3*fo(4)+dconjg(fso(6))*fo(3))
- sr1=gc(1)*(p0m3*fo(1) -fso(6) *fo(2))
- sr2=gc(1)*(p0p3*fo(2)-dconjg(fso(6))*fo(1))
-c
- fso(1) = ( gc(1)*fmass*fo(1) + sl1 )*ds
- fso(2) = ( gc(1)*fmass*fo(2) + sl2 )*ds
- fso(3) = ( gc(2)*fmass*fo(3) + sr1 )*ds
- fso(4) = ( gc(2)*fmass*fo(4) + sr2 )*ds
-c
- return
- end subroutine
-c
-c ----------------------------------------------------------------------
-c
- subroutine fvixxx(fi,vc,g,fmass,fwidth , fvi)
-c
-c this subroutine computes an off-shell fermion wavefunction from a
-c flowing-in external fermion and a vector boson.
-c
-c input:
-c complex fi(6) : flow-in fermion |fi>
-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 <fo|
-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 fvo(6) : off-shell fermion <fo,v,f'|
-c
- complex*16 fo(6),vc(6),fvo(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
- fvo(5) = fo(5)+vc(5)
- fvo(6) = fo(6)+vc(6)
-c
- pf(0)=dble( fvo(5))
- pf(1)=dble( fvo(6))
- pf(2)=dimag(fvo(6))
- pf(3)=dimag(fvo(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))*fo(3)
- & +(vc(2)+c_imag*vc(3))*fo(4)
- sl2= (vc(2)-c_imag*vc(3))*fo(3)
- & +(vc(1)- vc(4))*fo(4)
-c
- if ( g(2) .ne. r_zero ) then
- sr1= (vc(1)- vc(4))*fo(1)
- & -(vc(2)+c_imag*vc(3))*fo(2)
- sr2=-(vc(2)-c_imag*vc(3))*fo(1)
- & +(vc(1)+ vc(4))*fo(2)
-c
- fvo(1) = ( g(2)*( (pf(0)+pf(3))*sr1 +fvo(6)*sr2)
- & +g(1)*fmass*sl1)*d
- fvo(2) = ( g(2)*( dconjg(fvo(6))*sr1 +(pf(0)-pf(3))*sr2)
- & +g(1)*fmass*sl2)*d
- fvo(3) = ( g(1)*( (pf(0)-pf(3))*sl1 -fvo(6)*sl2)
- & +g(2)*fmass*sr1)*d
- fvo(4) = ( g(1)*(-dconjg(fvo(6))*sl1 +(pf(0)+pf(3))*sl2)
- & +g(2)*fmass*sr2)*d
-c
- else
- fvo(1) = g(1)*fmass*sl1*d
- fvo(2) = g(1)*fmass*sl2*d
- fvo(3) = g(1)*( (pf(0)-pf(3))*sl1 -fvo(6)*sl2)*d
- fvo(4) = g(1)*(-dconjg(fvo(6))*sl1 +(pf(0)+pf(3))*sl2)*d
- end if
-c
- return
- end subroutine
-c
-c ----------------------------------------------------------------------
-c
- subroutine ggggxx(wm,w31,wp,w32,g, 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 g : coupling of w31 with w-/w+
-c (see the table below)
-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
- implicit none
- 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 pwm(0:3),pw31(0:3),pwp(0:3),pw32(0:3),g
- real*8 dp1(0:3),dp2(0:3),dp3(0:3),dp4(0:3)
-c
- real*8 r_zero, r_one
- parameter( r_zero=0.0d0, r_one=1.0d0 )
-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))
- pw31(0)=dble( w31(5))
- pw31(1)=dble( w31(6))
- pw31(2)=dimag(w31(6))
- pw31(3)=dimag(w31(5))
- pw32(0)=dble( w32(5))
- pw32(1)=dble( w32(6))
- pw32(2)=dimag(w32(6))
- pw32(3)=dimag(w32(5))
-c
- dv1(0)=dcmplx(wm(1))
- dv1(1)=dcmplx(wm(2))
- dv1(2)=dcmplx(wm(3))
- dv1(3)=dcmplx(wm(4))
- dp1(0)=dble(pwm(0))
- dp1(1)=dble(pwm(1))
- dp1(2)=dble(pwm(2))
- dp1(3)=dble(pwm(3))
- dv2(0)=dcmplx(w31(1))
- dv2(1)=dcmplx(w31(2))
- dv2(2)=dcmplx(w31(3))
- dv2(3)=dcmplx(w31(4))
- dp2(0)=dble(pw31(0))
- dp2(1)=dble(pw31(1))
- dp2(2)=dble(pw31(2))
- dp2(3)=dble(pw31(3))
- dv3(0)=dcmplx(wp(1))
- dv3(1)=dcmplx(wp(2))
- dv3(2)=dcmplx(wp(3))
- dv3(3)=dcmplx(wp(4))
- dp3(0)=dble(pwp(0))
- dp3(1)=dble(pwp(1))
- dp3(2)=dble(pwp(2))
- dp3(3)=dble(pwp(3))
- dv4(0)=dcmplx(w32(1))
- dv4(1)=dcmplx(w32(2))
- dv4(2)=dcmplx(w32(3))
- dv4(3)=dcmplx(w32(4))
- dp4(0)=dble(pw32(0))
- dp4(1)=dble(pw32(1))
- dp4(2)=dble(pw32(2))
- dp4(3)=dble(pw32(3))
-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)
-
- dvertx = v14*v23 -v13*v24
-c
- vertex = dcmplx( dvertx ) * (g*g)
-c
- return
- end subroutine
-c
-c ======================================================================
-c
- subroutine gggxxx(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
- subroutine hioxxx(fi,fo,gc,smass,swidth , hio)
-c
-c this subroutine computes an off-shell scalar current from an external
-c fermion pair.
-c
-c input:
-c complex fi(6) : flow-in fermion |fi>
-c complex fo(6) : flow-out fermion <fo|
-c complex gc(2) : coupling constants gchf
-c real smass : mass of output scalar s
-c real swidth : width of output scalar s
-c
-c output:
-c complex hio(3) : scalar current j(<fi|s|fo>)
-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 <FO|
-C complex SC(3) : input scalar S
-C complex GC(2) : coupling constants GCHF
-C
-C OUTPUT:
-C complex VERTEX : amplitude <FO|S|FI>
-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 <fo|
-c complex vc(6) : input vector v
-c real g(2) : coupling constants gvf
-c
-c output:
-c complex vertex : amplitude <fo|v|fi>
-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 <duff@phenom.physics.wisc.edu>
-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 <fo|
-c real gaf(2) : fi couplings with a gaf
-c real gzf(2) : fi couplings with z gzf
-c real zmass : mass of z
-c real zwidth : width of z
-c
-c output:
-c complex j3(6) : w3 current j^mu(<fo|w3|fi>)
-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(<e|A|e>)
-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 <fo|
-c real g(2) : coupling constants gvf
-c real vmass : mass of output vector v
-c real vwidth : width of output vector v
-c
-c output:
-c complex jio(6) : vector current j^mu(<fo|v|fi>)
-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 <fo|
-c real g(2) : coupling constants gvf
-c
-c output:
-c complex jio(6) : vector current j^mu(<fo|v|fi>)
-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., <f|
-c A replacement for the HELAS routine OXXXXX
-c
-c Adam Duff, 1992 August 31
-c <duff@phenom.physics.wisc.edu>
-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 <duff@phenom.physics.wisc.edu>
-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/hgg-vertex/tests/SM/dhelas.f90
===================================================================
--- branches/ohl/omega-development/hgg-vertex/tests/SM/dhelas.f90 (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/tests/SM/dhelas.f90 (revision 8717)
@@ -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 <e,A,e'|
-C
- implicit none
- COMPLEX*16 EAO(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.*CHLF**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
- EAO((5-3*NHE)/2) = COEFF*ME*S*(1.+XNNP*.5)
- EAO((5-NHE)/2) = RNHE*XNNP *COEFF*ME*SHLF**2*PHS
- EAO((5+NHE)/2) = COEFF*EB*S*(-2.+XNNM)
- EAO((5+3*NHE)/2) = REAL(NHA-NHE)*COEFF*EB*X*CHLF**2*PHS*2.
-C
- EAO(5) = EB*dCMPLX( X-1. , X*C+1. )
- EAO(6) = EB*X*S*dCMPLX( CSP , SNP )
-C
- RETURN
- end subroutine
-c
-c ----------------------------------------------------------------------
-c
- subroutine fsixxx(fi,sc,gc,fmass,fwidth , fsi)
-c
-c this subroutine computes an off-shell fermion wavefunction from a
-c flowing-in external fermion and a vector boson.
-c
-c input:
-c complex*16 fi(6) : flow-in fermion |fi>
-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 <fo|
-c complex*16 sc(6) : 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 fso(6) : off-shell fermion <fo,s,f'|
-c
- complex*16 fo(6),sc(6),fso(6),gc(2),sl1,sl2,sr1,sr2,ds
- real*8 pf(0:3),fmass,fwidth,pf2,p0p3,p0m3
-c
- fso(5) = fo(5)+sc(2)
- fso(6) = fo(6)+sc(3)
-c
- pf(0)=dble( fso(5))
- pf(1)=dble( fso(6))
- pf(2)=dimag(fso(6))
- pf(3)=dimag(fso(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(2)*(p0p3*fo(3) +fso(6) *fo(4))
- sl2=gc(2)*(p0m3*fo(4)+dconjg(fso(6))*fo(3))
- sr1=gc(1)*(p0m3*fo(1) -fso(6) *fo(2))
- sr2=gc(1)*(p0p3*fo(2)-dconjg(fso(6))*fo(1))
-c
- fso(1) = ( gc(1)*fmass*fo(1) + sl1 )*ds
- fso(2) = ( gc(1)*fmass*fo(2) + sl2 )*ds
- fso(3) = ( gc(2)*fmass*fo(3) + sr1 )*ds
- fso(4) = ( gc(2)*fmass*fo(4) + sr2 )*ds
-c
- return
- end subroutine
-c
-c ----------------------------------------------------------------------
-c
- subroutine fvixxx(fi,vc,g,fmass,fwidth , fvi)
-c
-c this subroutine computes an off-shell fermion wavefunction from a
-c flowing-in external fermion and a vector boson.
-c
-c input:
-c complex fi(6) : flow-in fermion |fi>
-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 <fo|
-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 fvo(6) : off-shell fermion <fo,v,f'|
-c
- complex*16 fo(6),vc(6),fvo(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
- fvo(5) = fo(5)+vc(5)
- fvo(6) = fo(6)+vc(6)
-c
- pf(0)=dble( fvo(5))
- pf(1)=dble( fvo(6))
- pf(2)=dimag(fvo(6))
- pf(3)=dimag(fvo(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))*fo(3)
- & +(vc(2)+c_imag*vc(3))*fo(4)
- sl2= (vc(2)-c_imag*vc(3))*fo(3)
- & +(vc(1)- vc(4))*fo(4)
-c
- if ( g(2) .ne. r_zero ) then
- sr1= (vc(1)- vc(4))*fo(1)
- & -(vc(2)+c_imag*vc(3))*fo(2)
- sr2=-(vc(2)-c_imag*vc(3))*fo(1)
- & +(vc(1)+ vc(4))*fo(2)
-c
- fvo(1) = ( g(2)*( (pf(0)+pf(3))*sr1 +fvo(6)*sr2)
- & +g(1)*fmass*sl1)*d
- fvo(2) = ( g(2)*( dconjg(fvo(6))*sr1 +(pf(0)-pf(3))*sr2)
- & +g(1)*fmass*sl2)*d
- fvo(3) = ( g(1)*( (pf(0)-pf(3))*sl1 -fvo(6)*sl2)
- & +g(2)*fmass*sr1)*d
- fvo(4) = ( g(1)*(-dconjg(fvo(6))*sl1 +(pf(0)+pf(3))*sl2)
- & +g(2)*fmass*sr2)*d
-c
- else
- fvo(1) = g(1)*fmass*sl1*d
- fvo(2) = g(1)*fmass*sl2*d
- fvo(3) = g(1)*( (pf(0)-pf(3))*sl1 -fvo(6)*sl2)*d
- fvo(4) = g(1)*(-dconjg(fvo(6))*sl1 +(pf(0)+pf(3))*sl2)*d
- end if
-c
- return
- end subroutine
-c
-c ----------------------------------------------------------------------
-c
- subroutine ggggxx(wm,w31,wp,w32,g, 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 g : coupling of w31 with w-/w+
-c (see the table below)
-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
- implicit none
- 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 pwm(0:3),pw31(0:3),pwp(0:3),pw32(0:3),g
- real*8 dp1(0:3),dp2(0:3),dp3(0:3),dp4(0:3)
-c
- real*8 r_zero, r_one
- parameter( r_zero=0.0d0, r_one=1.0d0 )
-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))
- pw31(0)=dble( w31(5))
- pw31(1)=dble( w31(6))
- pw31(2)=dimag(w31(6))
- pw31(3)=dimag(w31(5))
- pw32(0)=dble( w32(5))
- pw32(1)=dble( w32(6))
- pw32(2)=dimag(w32(6))
- pw32(3)=dimag(w32(5))
-c
- dv1(0)=dcmplx(wm(1))
- dv1(1)=dcmplx(wm(2))
- dv1(2)=dcmplx(wm(3))
- dv1(3)=dcmplx(wm(4))
- dp1(0)=dble(pwm(0))
- dp1(1)=dble(pwm(1))
- dp1(2)=dble(pwm(2))
- dp1(3)=dble(pwm(3))
- dv2(0)=dcmplx(w31(1))
- dv2(1)=dcmplx(w31(2))
- dv2(2)=dcmplx(w31(3))
- dv2(3)=dcmplx(w31(4))
- dp2(0)=dble(pw31(0))
- dp2(1)=dble(pw31(1))
- dp2(2)=dble(pw31(2))
- dp2(3)=dble(pw31(3))
- dv3(0)=dcmplx(wp(1))
- dv3(1)=dcmplx(wp(2))
- dv3(2)=dcmplx(wp(3))
- dv3(3)=dcmplx(wp(4))
- dp3(0)=dble(pwp(0))
- dp3(1)=dble(pwp(1))
- dp3(2)=dble(pwp(2))
- dp3(3)=dble(pwp(3))
- dv4(0)=dcmplx(w32(1))
- dv4(1)=dcmplx(w32(2))
- dv4(2)=dcmplx(w32(3))
- dv4(3)=dcmplx(w32(4))
- dp4(0)=dble(pw32(0))
- dp4(1)=dble(pw32(1))
- dp4(2)=dble(pw32(2))
- dp4(3)=dble(pw32(3))
-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)
-
- dvertx = v14*v23 -v13*v24
-c
- vertex = dcmplx( dvertx ) * (g*g)
-c
- return
- end subroutine
-c
-c ======================================================================
-c
- subroutine gggxxx(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
- subroutine hioxxx(fi,fo,gc,smass,swidth , hio)
-c
-c this subroutine computes an off-shell scalar current from an external
-c fermion pair.
-c
-c input:
-c complex fi(6) : flow-in fermion |fi>
-c complex fo(6) : flow-out fermion <fo|
-c complex gc(2) : coupling constants gchf
-c real smass : mass of output scalar s
-c real swidth : width of output scalar s
-c
-c output:
-c complex hio(3) : scalar current j(<fi|s|fo>)
-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 <FO|
-C complex SC(3) : input scalar S
-C complex GC(2) : coupling constants GCHF
-C
-C OUTPUT:
-C complex VERTEX : amplitude <FO|S|FI>
-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 <fo|
-c complex vc(6) : input vector v
-c real g(2) : coupling constants gvf
-c
-c output:
-c complex vertex : amplitude <fo|v|fi>
-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 <duff@phenom.physics.wisc.edu>
-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 <fo|
-c real gaf(2) : fi couplings with a gaf
-c real gzf(2) : fi couplings with z gzf
-c real zmass : mass of z
-c real zwidth : width of z
-c
-c output:
-c complex j3(6) : w3 current j^mu(<fo|w3|fi>)
-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(<e|A|e>)
-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 <fo|
-c real g(2) : coupling constants gvf
-c real vmass : mass of output vector v
-c real vwidth : width of output vector v
-c
-c output:
-c complex jio(6) : vector current j^mu(<fo|v|fi>)
-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 <fo|
-c real g(2) : coupling constants gvf
-c
-c output:
-c complex jio(6) : vector current j^mu(<fo|v|fi>)
-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., <f|
-c A replacement for the HELAS routine OXXXXX
-c
-c Adam Duff, 1992 August 31
-c <duff@phenom.physics.wisc.edu>
-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 <duff@phenom.physics.wisc.edu>
-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/hgg-vertex/tests/SM/omega_helas.f90
===================================================================
--- branches/ohl/omega-development/hgg-vertex/tests/SM/omega_helas.f90 (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/tests/SM/omega_helas.f90 (revision 8717)
@@ -1,6 +0,0 @@
-module omega_helas
- use kinds
- implicit none
- real(kind=default), dimension(22), save, public :: mass = 0, width = 0
- real(kind=default), dimension(2), save, public :: gva = 1
-end module omega_helas
Index: branches/ohl/omega-development/hgg-vertex/tests/SM/xsect.f90
===================================================================
--- branches/ohl/omega-development/hgg-vertex/tests/SM/xsect.f90 (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/tests/SM/xsect.f90 (revision 8717)
@@ -1,295 +0,0 @@
-! $Id$
-
-module gauss
- use omega_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 omega_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 omega_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 omega_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 omega_kinds
- use omega_constants
- use omega_utils
- use kinematics
- implicit none
- private
-
- public :: dsigma_dcosth, dsigma_dcosth_pol
-
- ! picobarn
- real (kind = omega_prec), public, parameter :: &
- HBARC2 = 0.38937966E9_omega_prec
-
-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 omega_kinds
- implicit none
- real(kind=omega_prec), dimension(0:,:), intent(in) :: k
- integer, dimension(:), intent(in) :: s
- complex(kind=omega_prec) :: 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 omega_kinds
- implicit none
- real(kind=omega_prec), dimension(0:,:), intent(in) :: k
- integer, dimension(:), intent(in) :: s
- complex(kind=omega_prec) :: 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 omega_kinds
- use omega_amplitudes
- use differential
- implicit none
- private
- public :: wpwm, wpwm_pol, zz, zz_pol
- ! Global variables to facilitate integration:
- real (kind = omega_prec), 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 omega_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/hgg-vertex/tests/SM/main4.f90
===================================================================
--- branches/ohl/omega-development/hgg-vertex/tests/SM/main4.f90 (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/tests/SM/main4.f90 (revision 8717)
@@ -1,166 +0,0 @@
-! $Id$
-
-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/hgg-vertex/tests/SM/maint.f90
===================================================================
--- branches/ohl/omega-development/hgg-vertex/tests/SM/maint.f90 (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/tests/SM/maint.f90 (revision 8717)
@@ -1,46 +0,0 @@
-! $Id$
-
-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/hgg-vertex/tests/SM/main5.f90
===================================================================
--- branches/ohl/omega-development/hgg-vertex/tests/SM/main5.f90 (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/tests/SM/main5.f90 (revision 8717)
@@ -1,60 +0,0 @@
-! $Id$
-
-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/hgg-vertex/tests/SM/main6.f90
===================================================================
--- branches/ohl/omega-development/hgg-vertex/tests/SM/main6.f90 (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/tests/SM/main6.f90 (revision 8717)
@@ -1,100 +0,0 @@
-! $Id$
-
-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/hgg-vertex/tests/SM/main7.f90
===================================================================
--- branches/ohl/omega-development/hgg-vertex/tests/SM/main7.f90 (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/tests/SM/main7.f90 (revision 8717)
@@ -1,90 +0,0 @@
-! $Id$
-
-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/hgg-vertex/tests/SM/Makefile.am
===================================================================
--- branches/ohl/omega-development/hgg-vertex/tests/SM/Makefile.am (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/tests/SM/Makefile.am (revision 8717)
@@ -1,834 +0,0 @@
-# Makefile.am -- Makefile for O'Mega within and without WHIZARD
-# $Id$
-##
-## Process this file with automake to produce Makefile.in
-##
-########################################################################
-#
-# Copyright (C) 1999-2009 by
-# Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
-# Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
-# Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-#
-# 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
-###
-### auxdir = $(top_srcdir)/src/misc
-###
-### 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.f90=) -target:module $(@:.f90=) -old-interface
-###
-### FC = @FC@
-### FC_OPT = @FC_OPT@
-### FC_PROF = @FC_PROF@
-### FC_EXT = @FC_EXT@
-### 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)
-###
-### if FC_IMPURE
-### FC_FILTER = \
-### sed -e '/^[ ]*elemental[ ]/s/elemental[ ]//' \
-### -e '/^[ ]*pure[ ]/s/pure[ ]//' | $(CPIF)
-### else
-### FC_FILTER = $(CPIF)
-### endif
-###
-### 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 $(@:.f90=.ps); mv $(@:.f90=.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.f90 ozz_hh_module.f90 \
-### oepem_wpwm_module.f90 owpwm_wpwm_module.f90 \
-### owpwm_zz_module.f90 owpwm_za_module.f90 owpwm_aa_module.f90 \
-### oepem_epem_module.f90 oepem_veve_module.f90 \
-### oudb_udb_module.f90 oepem_mumu_module.f90 \
-### oemem_emem_module.f90 oema_ema_module.f90 \
-### oaa_epem_module.f90 oza_epem_module.f90 \
-### oza_uub_module.f90 oza_ddb_module.f90 \
-### ozz_epem_module.f90 ozz_veve_module.f90 \
-### oepem_aa_module.f90 oepem_za_module.f90 oepem_zz_module.f90
-###
-### OMEGA_SRC5 = \
-### oepem_epema_module.f90 oemem_emema_module.f90 \
-### oepem_aaa_module.f90 oepem_zaa_module.f90 \
-### oemep_emvewp_module.f90 \
-### oepem_wpwmz_module.f90 oepem_wpwma_module.f90
-###
-### OMEGA_SRC6 = \
-### oepem_muvmtavt_module.f90 oepem_epveemve_module.f90 \
-### oepem_mumuaa_module.f90 oepem_epemaa_module.f90 \
-### omuem_muemaa_module.f90 oemem_ememaa_module.f90 \
-### oepem_aaaa_module.f90 oepem_epemepem_module.f90 \
-### oemep_emvewpa_module.f90 oemep_vevewpwm_module.f90 \
-### oemep_emepwpwm_module.f90 owpwm_uubssb_module.f90 \
-### oepem_vevebbb_module.f90
-###
-### OMEGA_SRC7 = \
-### oepem_muvmtavta_module.f90 oemep_emveudba_module.f90 \
-### oepem_aaaaa_module.f90 oepem_epemaaa_module.f90 \
-### oepem_epemepema_module.f90 oaa_epemaaa_module.f90 \
-### oaa_epemmumua_module.f90 oaa_epemepema_module.f90 \
-### oepem_veveuubz_module.f90
-###
-### OMEGA_SRC8 = \
-### oepem_muvmtavtaa_module.f90 oepem_epemaaaa_module.f90 \
-### oepem_mumutatauub_module.f90 oepem_muvmtavtuub_module.f90 \
-### oepem_vevemuvmudb_module.f90
-###
-### OMEGA_SRCX = \
-### oepem_wpwmaa_module.f90 \
-### oepem_muvmtavtaa_module.f90 \
-### owpwm_zaa_module.f90 owpwm_aaa_module.f90 owpwm_wpwma_module.f90 \
-### oepem_epvebbbdub_module.f90
-###
-### # OMEGA_SRCT = \
-### # single_top_module.f90 \
-### # single_top_fudged_module.f90 \
-### # single_top_constant_module.f90
-###
-### OMEGA_SRCT = oepem_wpwm_module.f90
-###
-### OMEGA_SRC = \
-### $(OMEGA_SRC4) $(OMEGA_SRC5) $(OMEGA_SRC6) \
-### $(OMEGA_SRC7) $(OMEGA_SRC8) $(OMEGA_SRCX)
-###
-### MADGRAPH_SRC4 = $(patsubst o%_module.f90,%.f90, $(OMEGA_SRC4))
-### MADGRAPH_SRC5 = $(patsubst o%_module.f90,%.f90, $(OMEGA_SRC5))
-### MADGRAPH_SRC6 = $(patsubst o%_module.f90,%.f90, $(OMEGA_SRC6))
-### MADGRAPH_SRC7 = $(patsubst o%_module.f90,%.f90, $(OMEGA_SRC7))
-### MADGRAPH_SRC8 = $(patsubst o%_module.f90,%.f90, $(OMEGA_SRC8))
-### MADGRAPH_SRCX = $(patsubst o%_module.f90,%.f90, $(OMEGA_SRCX))
-### MADGRAPH_SRC = $(patsubst o%_module.f90,%.f90, $(OMEGA_SRC))
-###
-### OMEGA_OBJ4 = $(OMEGA_SRC4:.f90=.o)
-### OMEGA_OBJ5 = $(OMEGA_SRC5:.f90=.o)
-### OMEGA_OBJ6 = $(OMEGA_SRC6:.f90=.o)
-### OMEGA_OBJ7 = $(OMEGA_SRC7:.f90=.o)
-### OMEGA_OBJ8 = $(OMEGA_SRC8:.f90=.o)
-### OMEGA_OBJX = $(OMEGA_SRCX:.f90=.o)
-### OMEGA_OBJ = $(OMEGA_SRC:.f90=.o)
-###
-### OMEGA_OBJT = $(OMEGA_SRCT:.f90=.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): %.f90
-### 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.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "Z Z -> H H" >$@
-###
-### obbb_wpwm_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "b bbar -> W+ W-" >$@
-###
-### owpwm_aa_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "W+ W- -> A A" >$@
-###
-### owpwm_za_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "W+ W- -> Z A" >$@
-###
-### owpwm_zz_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "W+ W- -> Z Z" >$@
-###
-### owpwm_wpwm_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "W+ W- -> W+ W-" >$@
-###
-### oepem_wpwm_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> W+ W-" >$@
-###
-### oepem_epem_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> e+ e-" >$@
-###
-### oepem_veve_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> nue nuebar" >$@
-###
-### oudb_udb_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "u dbar -> u dbar" >$@
-###
-### oepem_mumu_module.f90: $(OMEGA_QED)
-### $(OMEGA_QED) $(OFLAGS) -scatter "e+ e- -> m+ m-" >$@
-###
-### oepem_aa_module.f90: $(OMEGA_QED)
-### $(OMEGA_QED) $(OFLAGS) -scatter "e+ e- -> A A" >$@
-###
-### oepem_za_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> Z A" >$@
-###
-### oepem_zz_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> Z Z" >$@
-###
-### oaa_epem_module.f90: $(OMEGA_QED)
-### $(OMEGA_QED) $(OFLAGS) -scatter "A A -> e+ e-" >$@
-###
-### oza_epem_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "Z A -> e+ e-" >$@
-###
-### ozz_epem_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "Z Z -> e+ e-" >$@
-###
-### ozz_veve_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "Z Z -> nue nuebar" >$@
-###
-### oza_uub_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "Z A -> u ubar" >$@
-###
-### oza_ddb_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "Z A -> d dbar" >$@
-###
-### oemem_emem_module.f90: $(OMEGA_QED)
-### $(OMEGA_QED) $(OFLAGS) -scatter "e- e- -> e- e-" >$@
-###
-### oema_ema_module.f90: $(OMEGA_QED)
-### $(OMEGA_QED) $(OFLAGS) -scatter "e- A -> e- A" >$@
-###
-### ifneq ($(MADGRAPH),false)
-###
-### zz_hh.f90:
-### (echo "z z -> h h"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### bbb_wpwm.f90:
-### (echo "b b~ -> w+ w-"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### wpwm_wpwm.f90:
-### (echo "w+ w- -> w+ w-"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### wpwm_aa.f90:
-### (echo "w+ w- -> a a"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### wpwm_za.f90:
-### (echo "w+ w- -> z a"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### wpwm_zz.f90:
-### (echo "w+ w- -> z z"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### epem_wpwm.f90:
-### (echo "e+ e- -> w+ w-"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### epem_epem.f90:
-### (echo "e+ e- -> e+ e-"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### udb_udb.f90:
-### (echo "u d~ -> u d~"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### epem_veve.f90:
-### (echo "e+ e- -> ve ve~"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### epem_mumu.f90:
-### (echo "e+ e- -> mu+ mu-"; $(MG_QED)) | $(RUN_MADGRAPH)
-###
-### epem_aa.f90:
-### (echo "e+ e- -> a a"; $(MG_QED)) | $(RUN_MADGRAPH)
-###
-### epem_za.f90:
-### (echo "e+ e- -> z a"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### epem_zz.f90:
-### (echo "e+ e- -> z z"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### aa_epem.f90:
-### (echo "a a -> e+ e-"; $(MG_QED)) | $(RUN_MADGRAPH)
-###
-### za_epem.f90:
-### (echo "z a -> e+ e-"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### za_uub.f90:
-### (echo "z a -> u u~"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### za_ddb.f90:
-### (echo "z a -> d d~"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### zz_epem.f90:
-### (echo "z z -> e+ e-"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### zz_veve.f90:
-### (echo "z z -> ve ve~"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### emem_emem.f90:
-### (echo "e- e- -> e- e-"; $(MG_QED)) | $(RUN_MADGRAPH)
-###
-### ema_ema.f90:
-### (echo "e- a -> e- a"; $(MG_QED)) | $(RUN_MADGRAPH)
-###
-### endif
-###
-### ########################################################################
-### #
-### # 5 external lines:
-### #
-### ########################################################################
-###
-### owpwm_zaa_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "W+ W- -> Z A A" >$@
-###
-### owpwm_wpwma_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "W+ W- -> W+ W- A" >$@
-###
-### owpwm_aaa_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "W+ W- -> A A A" >$@
-###
-### oemep_emvewp_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "e- e+ -> e- nuebar W+" >$@
-###
-### oepem_epema_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> e+ e- A" >$@
-###
-### oemem_emema_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "e- e- -> e- e- A" >$@
-###
-### oepem_aaa_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> A A A" >$@
-###
-### oepem_zaa_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> Z A A" >$@
-###
-### oepem_wpwmz_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> W+ W- Z" >$@
-###
-### oepem_wpwma_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> W+ W- A" >$@
-###
-### ifneq ($(MADGRAPH),false)
-###
-### wpwm_zaa.f90:
-### (echo "w+ w- -> z a a"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### wpwm_wpwma.f90:
-### (echo "w+ w- -> w+ w- a"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### wpwm_aaa.f90:
-### (echo "w+ w- -> a a a"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### emep_emvewp.f90:
-### (echo "e- e+ -> e- ve~ w+"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### epem_epema.f90:
-### (echo "e+ e- -> e+ e- a"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### emem_emema.f90:
-### (echo "e- e- -> e- e- a"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### epem_aaa.f90:
-### (echo "e+ e- -> a a a"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### epem_zaa.f90:
-### (echo "e+ e- -> z a a"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### epem_wpwmz.f90:
-### (echo "e+ e- -> w+ w- z"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### epem_wpwma.f90:
-### (echo "e+ e- -> w+ w- a"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### endif
-###
-### ########################################################################
-### #
-### # 6 external lines:
-### #
-### ########################################################################
-###
-### # oemep_emvewpa_module.f90: $(OMEGA_SM)
-### # $(OMEGA_SM) $(OFLAGS) -scatter "e- e+ -> e- nuebar W+ A" >$@
-###
-### oemep_emvewpa_module.f90: $(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=omega_prec), dimension(0:,:), intent(in) :: k" >>$@
-### echo " integer, dimension(:), intent(in) :: s" >>$@
-### echo " complex(kind=omega_prec) :: 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.f90=_t) -target:module $(@:.f90=) \
-### -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.f90=_s) -target:module $(@:.f90=) \
-### -scatter "e-/1 e+/1 -> e-/2 nuebar/2 W+ A" | \
-### sed -e '/^module/,/^contains/d' >>$@
-###
-### owpwm_uubssb_module.f90:
-### $(OMEGA_SM) $(OFLAGS) \
-### -target:function $(@:_module.f90=) -target:module $(@:.f90=) \
-### -scatter "W+ W- -> u ubar s sbar" | \
-### sed '/! CAVEAT: color factor not known!/s||amp = amp * sqrt (9.0_omega_prec / 1.0_omega_prec) ! CAVEAT: naive color factor|' >$@
-###
-### oemep_vevewpwm_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "e- e+ -> nue nuebar W+ W-" >$@
-###
-### oemep_emepwpwm_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "e- e+ -> e- e+ W+ W-" >$@
-###
-### oepem_muvmtavt_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> mu- numubar tau+ nutau" >$@
-###
-### oepem_epveemve_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> e+ nue e- nuebar" >$@
-###
-### oepem_mumuaa_module.f90: $(OMEGA_QED)
-### $(OMEGA_QED) $(OFLAGS) -scatter "e+ e- -> m+ m- A A" >$@
-###
-### oepem_epemaa_module.f90: $(OMEGA_QED)
-### $(OMEGA_QED) $(OFLAGS) -scatter "e+ e- -> e+ e- A A" >$@
-###
-### omuem_muemaa_module.f90: $(OMEGA_QED)
-### $(OMEGA_QED) $(OFLAGS) -scatter "m- e- -> m- e- A A" >$@
-###
-### oemem_ememaa_module.f90: $(OMEGA_QED)
-### $(OMEGA_QED) $(OFLAGS) -scatter "e- e- -> e- e- A A" >$@
-###
-### oepem_aaaa_module.f90: $(OMEGA_QED)
-### $(OMEGA_QED) $(OFLAGS) -scatter "e+ e- -> A A A A" >$@
-###
-### oepem_epemepem_module.f90: $(OMEGA_QED)
-### $(OMEGA_QED) $(OFLAGS) -scatter "e+ e- -> e+ e- e+ e-" >$@
-###
-### oepem_wpwmaa_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> W+ W- A A" >$@
-###
-### oepem_vevebbb_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> nue nuebar b bbar" >$@
-###
-### ifneq ($(MADGRAPH),false)
-###
-### wpwm_uubssb.f90:
-### (echo "w+ w- -> u u~ s s~"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### emep_vevewpwm.f90:
-### (echo "e- e+ -> ve ve~ w+ w-"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### emep_emepwpwm.f90:
-### (echo "e- e+ -> e- e+ w+ w-"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### emep_emvewpa.f90:
-### (echo "e- e+ -> e- ve~ w+ a"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### epem_muvmtavt.f90:
-### (echo "e+ e- -> mu- vm~ ta+ vt"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### epem_epveemve.f90:
-### (echo "e+ e- -> e+ ve e- ve~"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### epem_mumuaa.f90:
-### (echo "e+ e- -> mu+ mu- a a"; $(MG_QED)) | $(RUN_MADGRAPH)
-###
-### epem_epemaa.f90:
-### (echo "e+ e- -> e+ e- a a"; $(MG_QED)) | $(RUN_MADGRAPH)
-###
-### muem_muemaa.f90:
-### (echo "mu- e- -> mu- e- a a"; $(MG_QED)) | $(RUN_MADGRAPH)
-###
-### emem_ememaa.f90:
-### (echo "e- e- -> e- e- a a"; $(MG_QED)) | $(RUN_MADGRAPH)
-###
-### epem_aaaa.f90:
-### (echo "e+ e- -> a a a a"; $(MG_QED)) | $(RUN_MADGRAPH)
-###
-### epem_epemepem.f90:
-### (echo "e+ e- -> e+ e- e+ e-"; $(MG_QED)) | $(RUN_MADGRAPH)
-###
-### epem_wpwmaa.f90:
-### (echo "e+ e- -> w+ w- a a"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### epem_vevebbb.f90:
-### (echo "e+ e- -> ve ve~ b b~"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### endif
-###
-### ########################################################################
-### #
-### # 7 external lines:
-### #
-### ########################################################################
-###
-### # oemep_emveudba_module.f90: $(OMEGA_SM)
-### # $(OMEGA_SM) $(OFLAGS) e- e+ e- nuebar u dbar A >$@
-###
-### oemep_emveudba_module.f90: $(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=omega_prec), dimension(0:,:), intent(in) :: k" >>$@
-### echo " integer, dimension(:), intent(in) :: s" >>$@
-### echo " complex(kind=omega_prec) :: 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.f90=_t) -target:module $(@:.f90=) \
-### -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.f90=_s) -target:module $(@:.f90=) \
-### -scatter "e-/1 e+/1 -> e-/2 nuebar/2 u dbar A" | \
-### sed -e '/^module/,/^contains/d' >>$@
-###
-### oepem_veveuubz_module.f90:
-### $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> nue nuebar u ubar Z" >$@
-###
-### oepem_muvmtavta_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> mu- numubar tau+ nutau A" >$@
-###
-### oepem_epemepema_module.f90: $(OMEGA_QED)
-### $(OMEGA_QED) $(OFLAGS) -scatter "e+ e- -> e+ e- e+ e- A" >$@
-###
-### oepem_epemaaa_module.f90: $(OMEGA_QED)
-### $(OMEGA_QED) $(OFLAGS) -scatter "e+ e- -> e+ e- A A A" >$@
-###
-### oepem_aaaaa_module.f90: $(OMEGA_QED)
-### $(OMEGA_QED) $(OFLAGS) -scatter "e+ e- -> A A A A A" >$@
-###
-### oaa_epemaaa_module.f90: $(OMEGA_QED)
-### $(OMEGA_QED) $(OFLAGS) -scatter "A A -> e+ e- A A A" >$@
-###
-### oaa_epemmumua_module.f90: $(OMEGA_QED)
-### $(OMEGA_QED) $(OFLAGS) -scatter "A A -> e+ e- m+ m- A" >$@
-###
-### oaa_epemepema_module.f90: $(OMEGA_QED)
-### $(OMEGA_QED) $(OFLAGS) -scatter "A A -> e+ e- e+ e- A" >$@
-###
-### ifneq ($(MADGRAPH),false)
-###
-### epem_veveuubz.f90:
-### (echo "e+ e- -> ve ve~ u u~ Z"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### emep_emveudba.f90:
-### (echo "e- e+ -> e- ve~ u d~ a"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### epem_muvmtavta.f90:
-### (echo "e+ e- -> mu- vm~ ta+ vt a"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### epem_epemaaa.f90:
-### (echo "e+ e- -> e+ e- a a a"; $(MG_QED)) | $(RUN_MADGRAPH)
-###
-### epem_epemepema.f90:
-### (echo "e+ e- -> e+ e- e+ e- a"; $(MG_QED)) | $(RUN_MADGRAPH)
-###
-### epem_aaaaa.f90:
-### (echo "e+ e- -> a a a a a"; $(MG_QED)) | $(RUN_MADGRAPH)
-###
-### aa_epemaaa.f90:
-### (echo "a a -> e+ e- a a a"; $(MG_QED)) | $(RUN_MADGRAPH)
-###
-### aa_epemmumua.f90:
-### (echo "a a -> e+ e- mu+ mu- a"; $(MG_QED)) | $(RUN_MADGRAPH)
-###
-### aa_epemepema.f90:
-### (echo "a a -> e+ e- e+ e- a"; $(MG_QED)) | $(RUN_MADGRAPH)
-###
-### endif
-###
-### ########################################################################
-### #
-### # 8 external lines:
-### #
-### ########################################################################
-###
-### oepem_muvmtavtaa_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> mu- numubar tau+ nutau A A" >$@
-###
-### oepem_epemaaaa_module.f90: $(OMEGA_QED)
-### $(OMEGA_QED) $(OFLAGS) -scatter "e+ e- -> e+ e- A A A A" >$@
-###
-### oepem_mumutatauub_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> mu+ mu- tau+ tau- u ubar" >$@
-###
-### oepem_muvmtavtuub_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> mu- numubar tau+ nutau u ubar" >$@
-###
-### oepem_vevemuvmudb_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> nue nuebar mu- numubar u dbar" >$@
-###
-### oepem_epvebbbdub_module.f90: $(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_omega_prec / 1.0_omega_prec) ! CAVEAT: naive color factor|' >$@
-###
-### single_top_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) $(OFLAGS) -scatter "e+ e- -> e+ nue b bbar d ubar" >$@
-###
-### single_top_fudged_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) -model:fudged_width $(OFLAGS) \
-### -scatter "e+ e- -> e+ nue b bbar d ubar" >$@
-###
-### single_top_constant_module.f90: $(OMEGA_SM)
-### $(OMEGA_SM) -model:constant_width $(OFLAGS) \
-### -scatter "e+ e- -> e+ nue b bbar d ubar" >$@
-###
-### ifneq ($(MADGRAPH),false)
-###
-### epem_muvmtavtaa.f90:
-### (echo "e+ e- -> mu- vm~ ta+ vt a a"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### epem_epemaaaa.f90:
-### (echo "e+ e- -> e+ e- a a a a"; $(MG_QED)) | $(RUN_MADGRAPH)
-###
-### epem_mumutatauub.f90:
-### (echo "e+ e- -> mu+ mu- ta+ ta- u u~"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### epem_muvmtavtuub.f90:
-### (echo "e+ e- -> mu- vm~ ta+ vt u u~"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### epem_vevemuvmudb.f90:
-### (echo "e+ e- -> ve ve~ mu- vm~ u d~"; $(MG_SM)) | $(RUN_MADGRAPH)
-###
-### epem_epvebbbdub.f90:
-### (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*
-###
-### 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.f90: $(MADGRAPH_SRC4) Makefile
-### (echo " module madgraph4"; \
-### $(MADGRAPH_HEADER) $(MADGRAPH_SRC4); \
-### echo " end module madgraph4" ) >$@
-###
-### madgraph5.f90: $(MADGRAPH_SRC5) Makefile
-### (echo " module madgraph5"; \
-### $(MADGRAPH_HEADER) $(MADGRAPH_SRC5); \
-### echo " end module madgraph5" ) >$@
-###
-### madgraph6.f90: $(MADGRAPH_SRC6) Makefile
-### (echo " module madgraph6"; \
-### $(MADGRAPH_HEADER) $(MADGRAPH_SRC6); \
-### echo " end module madgraph6" ) >$@
-###
-### madgraph7.f90: $(MADGRAPH_SRC7) Makefile
-### (echo " module madgraph7"; \
-### $(MADGRAPH_HEADER) $(MADGRAPH_SRC7); \
-### echo " end module madgraph7" ) >$@
-###
-### madgraph8.f90: $(MADGRAPH_SRC8) Makefile
-### (echo " module madgraph8"; \
-### $(MADGRAPH_HEADER) $(MADGRAPH_SRC8); \
-### echo " end module madgraph8" ) >$@
-###
-### madgraphx.f90: $(MADGRAPH_SRCX) Makefile
-### (echo " module madgraphx"; \
-### $(MADGRAPH_HEADER) $(MADGRAPH_SRCX); \
-### echo " end module madgraphx" ) >$@
-###
-### omega_amplitudes4.f90: Makefile
-### (echo "module $(@:.f90=)"; \
-### for m in $(OMEGA_SRC4:.f90=); do echo " use $$m"; done; \
-### echo " public"; \
-### echo "end module $(@:.f90=)") >$@
-###
-### omega_amplitudes5.f90: Makefile
-### (echo "module $(@:.f90=)"; \
-### for m in $(OMEGA_SRC5:.f90=); do echo " use $$m"; done; \
-### echo " public"; \
-### echo "end module $(@:.f90=)") >$@
-###
-### omega_amplitudes6.f90: Makefile
-### (echo "module $(@:.f90=)"; \
-### for m in $(OMEGA_SRC6:.f90=); do echo " use $$m"; done; \
-### echo " public"; \
-### echo "end module $(@:.f90=)") >$@
-###
-### omega_amplitudes7.f90: Makefile
-### (echo "module $(@:.f90=)"; \
-### for m in $(OMEGA_SRC7:.f90=); do echo " use $$m"; done; \
-### echo " public"; \
-### echo "end module $(@:.f90=)") >$@
-###
-### omega_amplitudes8.f90: Makefile
-### (echo "module $(@:.f90=)"; \
-### for m in $(OMEGA_SRC8:.f90=); do echo " use $$m"; done; \
-### echo " public"; \
-### echo "end module $(@:.f90=)") >$@
-###
-### omega_amplitudesx.f90: Makefile
-### (echo "module $(@:.f90=)"; \
-### for m in $(OMEGA_SRCX:.f90=); do echo " use $$m"; done; \
-### echo " public"; \
-### echo "end module $(@:.f90=)") >$@
-###
-### omega_amplitudest.f90: Makefile
-### (echo "module $(@:.f90=)"; \
-### for m in $(OMEGA_SRCT:.f90=); do echo " use $$m"; done; \
-### echo " public"; \
-### echo "end module $(@:.f90=)") >$@
-###
-### omega_amplitudes.o: $(OMEGA_OBJ)
-###
-### madgraph.o: $(auxdir)/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/hgg-vertex/tests/SM/main8.f90
===================================================================
--- branches/ohl/omega-development/hgg-vertex/tests/SM/main8.f90 (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/tests/SM/main8.f90 (revision 8717)
@@ -1,50 +0,0 @@
-! $Id$
-
-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/hgg-vertex/tests/SM/mainx.f90
===================================================================
--- branches/ohl/omega-development/hgg-vertex/tests/SM/mainx.f90 (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/tests/SM/mainx.f90 (revision 8717)
@@ -1,69 +0,0 @@
-! $Id$
-
-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/hgg-vertex/tests/test_sm_eeee
===================================================================
--- branches/ohl/omega-development/hgg-vertex/tests/test_sm_eeee (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/tests/test_sm_eeee (revision 8717)
@@ -1,28 +0,0 @@
-#! /bin/sh
-# $Id$
-########################################################################
-#
-# Copyright (C) 1999-2009 by
-# Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
-# Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
-# Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-#
-# 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.
-#
-########################################################################
-
-. `dirname $0`/test_functions
-
-expect_summary ../bin/omega_SM.opt "e+ e- -> e+ e-" "SUMMARY: 12 fusions, 4 propagators, 4 diagrams"
\ No newline at end of file
Index: branches/ohl/omega-development/hgg-vertex/tests/test_sm_eemm
===================================================================
--- branches/ohl/omega-development/hgg-vertex/tests/test_sm_eemm (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/tests/test_sm_eemm (revision 8717)
@@ -1,33 +0,0 @@
-#! /bin/sh
-# $Id$
-########################################################################
-#
-# Copyright (C) 1999-2009 by
-# Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
-# Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
-# Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-#
-# 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.
-#
-########################################################################
-
-. `dirname $0`/test_functions
-
-expect_summary ../bin/omega_SM.opt "u ubar -> g g" "\
-SUMMARY: 6 fusions, 2 propagators, 2 diagrams
-SUMMARY: 6 fusions, 2 propagators, 2 diagrams
-SUMMARY: 6 fusions, 2 propagators, 2 diagrams
-SUMMARY: 6 fusions, 2 propagators, 2 diagrams
-SUMMARY: 6 fusions, 2 propagators, 2 diagrams"
\ No newline at end of file
Index: branches/ohl/omega-development/hgg-vertex/tests/people/Makefile.am
===================================================================
--- branches/ohl/omega-development/hgg-vertex/tests/people/Makefile.am (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/tests/people/Makefile.am (revision 8717)
@@ -1,29 +0,0 @@
-# Makefile.am -- Makefile for O'Mega within and without WHIZARD
-# $Id$
-##
-## Process this file with automake to produce Makefile.in
-##
-########################################################################
-#
-# Copyright (C) 1999-2009 by
-# Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
-# Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
-# Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-#
-# 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.
-#
-########################################################################
-
-SUBDIRS = jr tho
Index: branches/ohl/omega-development/hgg-vertex/tests/people/tho/main.f90
===================================================================
--- branches/ohl/omega-development/hgg-vertex/tests/people/tho/main.f90 (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/tests/people/tho/main.f90 (revision 8717)
@@ -1,76 +0,0 @@
-! $Id$
-
-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/hgg-vertex/tests/people/tho/Makefile.am
===================================================================
--- branches/ohl/omega-development/hgg-vertex/tests/people/tho/Makefile.am (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/tests/people/tho/Makefile.am (revision 8717)
@@ -1,27 +0,0 @@
-# Makefile.am -- Makefile for O'Mega within and without WHIZARD
-# $Id$
-##
-## Process this file with automake to produce Makefile.in
-##
-########################################################################
-#
-# Copyright (C) 1999-2009 by
-# Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
-# Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
-# Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-#
-# 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.
-#
-########################################################################
Index: branches/ohl/omega-development/hgg-vertex/tests/people/jr/main6.f90
===================================================================
--- branches/ohl/omega-development/hgg-vertex/tests/people/jr/main6.f90 (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/tests/people/jr/main6.f90 (revision 8717)
@@ -1,48 +0,0 @@
-! $Id$
-
-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/hgg-vertex/tests/people/jr/Makefile.am
===================================================================
--- branches/ohl/omega-development/hgg-vertex/tests/people/jr/Makefile.am (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/tests/people/jr/Makefile.am (revision 8717)
@@ -1,230 +0,0 @@
-# Makefile.am -- Makefile for O'Mega within and without WHIZARD
-# $Id$
-##
-## Process this file with automake to produce Makefile.in
-##
-########################################################################
-#
-# Copyright (C) 1999-2009 by
-# Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
-# Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
-# Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-#
-# 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.
-#
-########################################################################
-
-### auxdir = $(top_srcdir)/src/misc
-###
-### 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.f90=) -target:module $(@:.f90=) \
-### -target:parameter_module omega_parameters_jr -old-interface
-###
-### 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.f90 off_ff_module.f90 oaa_ff_module.f90 \
-### off_aa_module.f90
-###
-### OMEGA_SRC5 =
-###
-### OMEGA_SRC6 = oaa_ffpp_module.f90 obb_ffff_module.f90 off_ppaa_module.f90 \
-### oaa_pppp_module.f90 oaa_ffff_module.f90
-###
-### OMEGA_SRC8 = oaa_ffffpp_module.f90
-###
-### OMEGA_SRC = $(OMEGA_SRC4) $(OMEGA_SRC5) $(OMEGA_SRC6) $(OMEGA_SRC8)
-###
-### OMEGA_OBJ4 = $(OMEGA_SRC4:.f90=.o)
-### OMEGA_OBJ5 = $(OMEGA_SRC5:.f90=.o)
-### OMEGA_OBJ6 = $(OMEGA_SRC6:.f90=.o)
-### OMEGA_OBJ8 = $(OMEGA_SRC8:.f90=.o)
-### OMEGA_OBJ = $(OMEGA_SRC:.f90=.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_SRC_EXT)
-### $(FC) $(FCOPT) -c -o $@ $(TEST_OBJS) $<
-###
-### omega_parameters_jr.o: omega_parameters_jr.$(FC_SRC_EXT)
-### $(FC) $(FCOPT) -c -o $@ $<
-###
-### omega_parameters_jr.$(FC_SRC_EXT): $(OMEGA_SAGT)
-### $(OMEGA_SAGT) -params > $@
-###
-### %.$(FC_SRC_EXT): %.f90
-### if FC_IMPURE
-### sed '/^[ ]*pure[ ]/s/pure[ ]//' $< | $(CPIF) $@
-### else
-### $(CPIF) $@ < $<
-### 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.f90: $(OMEGA_SAGT) $(TEST_OBJS)
-### $(OMEGA_SAGT) $(OFLAGS) -scatter "a a -> f f" >$@
-###
-### off_aa_module.f90: $(OMEGA_SAGT) $(TEST_OBJS)
-### $(OMEGA_SAGT) $(OFLAGS) -scatter "f f -> a a" >$@
-###
-### ofa_fa_module.f90: $(OMEGA_SAGT) $(TEST_OBJS)
-### $(OMEGA_SAGT) $(OFLAGS) -scatter "f a -> f a" >$@
-###
-### off_ff_module.f90: $(OMEGA_SAGT) $(TEST_OBJS)
-### $(OMEGA_SAGT) $(OFLAGS) -scatter "f f -> f f" >$@
-###
-### oaa_ffff_module.f90: $(OMEGA_SAGT) $(TEST_OBJS)
-### $(OMEGA_SAGT) $(OFLAGS) -scatter "a a -> f f f f" >$@
-###
-### oaa_pppp_module.f90: $(OMEGA_SAGT) $(TEST_OBJS)
-### $(OMEGA_SAGT) $(OFLAGS) -scatter "a a -> phino phino phino phino" >$@
-###
-### oaa_ffpp_module.f90: $(OMEGA_SAGT) $(TEST_OBJS)
-### $(OMEGA_SAGT) $(OFLAGS) -scatter "a a -> f f phino phino" >$@
-###
-### off_ppaa_module.f90: $(OMEGA_SAGT) $(TEST_OBJS)
-### $(OMEGA_SAGT) $(OFLAGS) -scatter "f f -> phino phino a a" >$@
-###
-### obb_ffff_module.f90: $(OMEGA_SAGT) $(TEST_OBJS)
-### $(OMEGA_SAGT) $(OFLAGS) -scatter "b b -> f f f f" >$@
-###
-### oaa_ffffpp_module.f90: $(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_SRC_EXT)
-### $(FC) $(FC_DUSTY) $(FCOPT) -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
-###
-### omega_amplitudes4.f90: Makefile
-### (echo "module $(@:.f90=)"; \
-### for m in $(OMEGA_SRC4:.f90=); do echo " use $$m"; done; \
-### echo " public"; \
-### echo "end module $(@:.f90=)") >$@
-###
-### omega_amplitudes5.f90: Makefile
-### (echo "module $(@:.f90=)"; \
-### for m in $(OMEGA_SRC5:.f90=); do echo " use $$m"; done; \
-### echo " public"; \
-### echo "end module $(@:.f90=)") >$@
-###
-### omega_amplitudes6.f90: Makefile
-### (echo "module $(@:.f90=)"; \
-### for m in $(OMEGA_SRC6:.f90=); do echo " use $$m"; done; \
-### echo " public"; \
-### echo "end module $(@:.f90=)") >$@
-###
-### omega_amplitudes8.f90: Makefile
-### (echo "module $(@:.f90=)"; \
-### for m in $(OMEGA_SRC8:.f90=); do echo " use $$m"; done; \
-### echo " public"; \
-### echo "end module $(@:.f90=)") >$@
-###
-### kinematics.o: $(auxdir)/kinds.o
-### rambo.o: $(auxdir)/kinds.o kinematics.o tao_random_numbers.o
-### testbed.o: $(auxdir)/kinds.o rambo.o
-###
-### $(auxdir)/kinds.o: $(auxdir)/kinds.f90
-### $(MAKE) -C $(auxdir)
-###
-### $(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/hgg-vertex/tests/people/jr/main8.f90
===================================================================
--- branches/ohl/omega-development/hgg-vertex/tests/people/jr/main8.f90 (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/tests/people/jr/main8.f90 (revision 8717)
@@ -1,27 +0,0 @@
-! $Id$
-
-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/hgg-vertex/tests/people/jr/main4.f90
===================================================================
--- branches/ohl/omega-development/hgg-vertex/tests/people/jr/main4.f90 (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/tests/people/jr/main4.f90 (revision 8717)
@@ -1,43 +0,0 @@
-! $Id$
-
-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/hgg-vertex/tests/test_sm_uugg
===================================================================
--- branches/ohl/omega-development/hgg-vertex/tests/test_sm_uugg (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/tests/test_sm_uugg (revision 8717)
@@ -1,28 +0,0 @@
-#! /bin/sh
-# $Id$
-########################################################################
-#
-# Copyright (C) 1999-2009 by
-# Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
-# Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
-# Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-#
-# 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.
-#
-########################################################################
-
-. `dirname $0`/test_functions
-
-expect_summary ../bin/omega_SM.opt "e+ e- -> e+ e-" "SUMMARY: 12 fusions, 4 propagators, 4 diagrams"
\ No newline at end of file
Index: branches/ohl/omega-development/hgg-vertex/tests/parameters_qcd.f90
===================================================================
--- branches/ohl/omega-development/hgg-vertex/tests/parameters_qcd.f90 (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/tests/parameters_qcd.f90 (revision 8717)
@@ -1,45 +0,0 @@
-! $Id: parameters.QED.omega.f90,v 1.1 2004/03/11 04:21:17 kilian Exp $
-!
-! Copyright (C) 1999-2009 by
-! Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
-! Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
-! Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-!
-! 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 parameters_qcd
- use kinds
- use constants
-
- implicit none
- private
- public :: init_parameters
-
- real(default), dimension(22), public :: mass, width
- complex(default), public :: gs
-
- complex(default), parameter :: ALPHAS = 0.12
-
-contains
-
- subroutine init_parameters
- mass(1:22) = 0
- width(1:22) = 0
- gs = sqrt(4.0_default*PI*ALPHAS) / sqrt(2.0_default)
- end subroutine init_parameters
-
-end module parameters_qcd
Index: branches/ohl/omega-development/hgg-vertex/tests/test_functions
===================================================================
--- branches/ohl/omega-development/hgg-vertex/tests/test_functions (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/tests/test_functions (revision 8717)
@@ -1,37 +0,0 @@
-#! /bin/sh
-# $Id$
-########################################################################
-#
-# Copyright (C) 1999-2009 by
-# Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
-# Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
-# Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-#
-# 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.
-#
-########################################################################
-
-expect_summary () {
- omega_bin="$1"
- process="$2"
- expected="$3"
- result="`$omega_bin -scatter \"$process\" 2>&1 >/dev/null | grep SUMMARY`"
- if test "$result" = "$expected"; then
- exit 0
- else
- echo "$omega_bin -scatter '$process' produced '$result' instead of '$expected'"
- exit 1
- fi
-}
Index: branches/ohl/omega-development/hgg-vertex/hgg-notes.pdf
===================================================================
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Index: branches/ohl/omega-development/hgg-vertex/configure.ac
===================================================================
--- branches/ohl/omega-development/hgg-vertex/configure.ac (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/configure.ac (revision 8717)
@@ -1,273 +0,0 @@
-dnl configure.ac -- Main configuration script for O'Mega
-dnl $Id:$
-dnl
-dnl Process this file with autoconf to produce a configure script.
-dnl
-dnl ************************************************************************
-dnl
-dnl (C) 1999-2010 by
-dnl Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
-dnl Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
-dnl Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-dnl and others
-dnl
-dnl WHIZARD is free software; you can redistribute it and/or modify it
-dnl under the terms of the GNU General Public License as published by
-dnl the Free Software Foundation; either version 2, or (at your option)
-dnl any later version.
-dnl
-dnl WHIZARD is distributed in the hope that it will be useful, but
-dnl WITHOUT ANY WARRANTY; without even the implied warranty of
-dnl MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-dnl GNU General Public License for more details.
-dnl
-dnl You should have received a copy of the GNU General Public License
-dnl along with this program; if not, write to the Free Software
-dnl Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-dnl
-dnl ***********************************************************************
-dnl
-dnl Environment variables that can be set by the user:
-dnl FC Fortran compiler
-dnl FCFLAGS Fortran compiler flags
-dnl
-dnl ***********************************************************************
-
-AC_INIT([omega],[2.0.0_rc3])
-AC_CONFIG_AUX_DIR([.])
-AM_INIT_AUTOMAKE([1.10])
-
-dnl ***********************************************************************
-
-AC_PROG_CC
-AC_PROG_RANLIB
-AC_PROG_LIBTOOL
-AC_PROG_MKDIR_P
-
-LT_INIT
-LT_PREREQ([2.2.6b])
-
-dnl ***********************************************************************
-
-AC_PROG_OCAML
-if test "$enable_ocaml" != "no"; then
- AC_OCAML_VERSION_CHECK(304000)
- AC_PROG_OCAMLLEX
- AC_PROG_OCAMLYACC
- AC_PROG_OCAMLCP
- ### Ocamlweb is required to be newer than v0.9
- AC_PROG_OCAMLWEB(009000)
- AC_PROG_OCAML_LABLGTK
- AC_PATH_PROGS(OCAMLDOT,ocamldot)
- AC_PATH_PROGS(OCAMLDEFUN,ocamldefun)
-else
- AC_MSG_NOTICE([WARNING: O'Caml and O'Mega matrix elements disabled by request!])
- AM_CONDITIONAL([OCAMLWEB_AVAILABLE],[false])
-fi
-
-comment_model_file=""
-comment_model_file="#"
-AC_SUBST([comment_model_file])
-
-dnl ***********************************************************************
-
-AM_CONDITIONAL([STANDALONE_OMEGA_BUILD], [test "yes" = "yes"])
-WO_PROG_NOWEB
-
-dnl WO_CONFIGURE_SECTION([Fortran compiler checks])
-
-AC_PROG_FC
-WO_FC_GET_VENDOR_AND_VERSION
-
-
-FC_FIND_EXTENSION([FC_EXT], [$FC], [f03 f95 f90])
-
-AC_FC_SRCEXT([f90])
-WO_FC_PARAMETERS
-WO_FC_LIBRARY_LDFLAGS
-WO_FC_CHECK_F95
-
-dnl WO_FC_CHECK_TR15581
-dnl WO_FC_CHECK_ALLOCATABLE_SCALARS
-dnl WO_FC_CHECK_C_BINDING
-dnl WO_FC_CHECK_PROCEDURE_POINTERS
-dnl WO_FC_CHECK_OO_FEATURES
-dnl WO_FC_CHECK_CMDLINE
-
-WO_FC_CHECK_QUADRUPLE
-WO_FC_CHECK_QUADRUPLE_C
-WO_FC_SET_PRECISION
-WO_FC_SET_PROFILING
-WO_FC_SET_OMEGA_IMPURE
-
-FC_MODULE_FILE([FC_MODULE_NAME], [FC_MODULE_EXT], [$FC], [$FC_EXT])
-WO_FC_FILENAME_CASE_CONVERSION
-AC_SUBST([FC_MAKE_MODULE_NAME])
-case "$FC_MODULE_NAME" in
- module_NAME)
- FC_MAKE_MODULE_NAME='$*.$(FC_MODULE_EXT)'
- ;;
- module_name)
- FC_MAKE_MODULE_NAME='"`echo $* | $(LOWERCASE)`".$(FC_MODULE_EXT)'
- ;;
- MODULE_NAME)
- FC_MAKE_MODULE_NAME='"`echo $* | $(UPPERCASE)`".$(FC_MODULE_EXT)'
- ;;
- conftest)
- FC_MAKE_MODULE_NAME='$*.$(FC_MODULE_EXT)'
- ;;
- *)
- ;;
-esac
-AC_CONFIG_FILES([src/kinds.f90])
-
-AC_PROG_LATEX
-AC_PROG_PDFLATEX
-AC_PROG_SUPP_PDF
-AC_PROG_MPOST
-AC_PROG_EPSTOPDF
-AC_PROG_DVIPS
-AC_PROG_PS2PDF
-
-########################################################################
-# Copy LaTeX files to the build directory
-########################################################################
-
-case "$srcdir" in
- .) ;;
- *) $MKDIR_P ./share/doc
- for f in noweb.sty ocamlweb.sty feynmp.sty feynmp.mp emp.sty \
- flex.cls thophys.sty thohacks.sty; do
- rm -f ./share/doc/$f
- cp $srcdir/share/doc/$f ./share/doc/$f
- done
-esac
-
-########################################################################
-# O'Mega options for the configure script
-########################################################################
-
-OMEGA_MAX_COLOR_LINES=8
-AC_ARG_ENABLE([max-color-lines],
-[ --enable-max-color-lines=number
- The maximum number of gluons and (anti-)quark
- pairs allowed. Values larger than the default 8
- make not much sense currently.],
-[case "$enableval" in
- [0-9][0-9]|[0-9][0-9])
- OMEGA_MAX_COLOR_LINES="$enableval"
- ;;
- *) AC_MSG_WARN([non-integer max-color-lines, using default=$OMEGA_MAX_COLOR_LINES])
- ;;
-esac])
-AC_SUBST([OMEGA_MAX_COLOR_LINES])
-
-AC_ARG_ENABLE([install-all-caches],
-[ --enable-install-all-caches
- Create the complete set of cache files for O'Mega
- (including more exotic models). This takes some
- time (make -j helps), but speeds up the self tests
- (i.e. make check) later [[default=no]].],
-[case "$enableval" in
- yes|no) OMEGA_INSTALL_ALL_CACHES="$enableval"
- ;;
- *) OMEGA_INSTALL_ALL_CACHES=no
- AC_MSG_WARN([Invalid argument to --enable-install-all-caches, using default=no])
- ;;
-esac],
-[eval OMEGA_INSTALL_ALL_CACHES=no])
-AM_CONDITIONAL([OMEGA_INSTALL_ALL_CACHES], [test "$OMEGA_INSTALL_ALL_CACHES" = "yes"])
-
-AC_ARG_ENABLE([system-cache],
-[ --enable-system-cache=directory
- Read precomputed model tables from this directory,
- which will be populated by an administrator at
- install time [[default=$localstatedir/cache, enabled]].],
-[case "$enableval" in
- no) OMEGA_SYSTEM_CACHE_DIR="."
- ;;
- *) OMEGA_SYSTEM_CACHE_DIR="$enableval"
- ;;
-esac],
-[### use eval b/c $localstatedir defaults to unexpanded ${prefix}/var
-eval OMEGA_SYSTEM_CACHE_DIR="$localstatedir/cache"])
-AC_SUBST([OMEGA_SYSTEM_CACHE_DIR])
-
-AC_ARG_ENABLE([user-cache],
-[ --enable-user-cache=directory
- Store precomputed model tables in this directory
- and read them to avoid lengthy recomputations.
- Leading "~" will be replaced at runtime by ${HOME}.
- [[Must be user writable, default=${HOME}/.whizard/var/cache,
- enabled]].],
-[case "$enableval" in
- no) OMEGA_USER_CACHE_DIR="."
- ;;
- *) OMEGA_USER_CACHE_DIR="$enableval"
- ;;
-esac],
-[eval OMEGA_USER_CACHE_DIR="${HOME}/.whizard/var/cache"])
-AC_SUBST([OMEGA_USER_CACHE_DIR])
-
-case "$OMEGA_SYSTEM_CACHE_DIR" in
- .|""|NONE*) OMEGA_SYSTEM_CACHE_DIR="."
- ;;
- *) AC_MSG_NOTICE([Creating system cache directory $OMEGA_SYSTEM_CACHE_DIR])
- $MKDIR_P "$OMEGA_SYSTEM_CACHE_DIR" 2>/dev/null
- chmod u+w "$OMEGA_SYSTEM_CACHE_DIR" 2>/dev/null
- ;;
-esac
-
-case "$OMEGA_USER_CACHE_DIR" in
- .|""|NONE*) OMEGA_USER_CACHE_DIR="."
- ;;
- *) AC_MSG_NOTICE([Creating user cache directory $OMEGA_USER_CACHE_DIR])
- $MKDIR_P "$OMEGA_USER_CACHE_DIR" 2>/dev/null
- chmod u+w "$OMEGA_USER_CACHE_DIR" 2>/dev/null
- ;;
-esac
-
-OMEGA_CACHE_SUFFIX=".cache"
-AC_SUBST([OMEGA_CACHE_SUFFIX])
-
-AC_CONFIG_FILES([src/config.ml])
-
-########################################################################
-# Copy config.mli to the build directory (otherwise ocamlc and/or
-# ocamlopt would create one on their own).
-########################################################################
-
-case "$srcdir" in
- .) ;;
- *) $MKDIR_P ./src
- rm -f ./src/config.mli
- cp $srcdir/src/config.mli ./src/config.mli 1>/dev/null 2>&1;;
-esac
-
-dnl ***********************************************************************
-
-AC_CONFIG_FILES([
- Makefile
- bin/Makefile
- lib/Makefile
- models/Makefile
- src/Makefile
- share/Makefile
- share/doc/Makefile
- extensions/Makefile
- extensions/people/Makefile
- extensions/people/jr/Makefile
- extensions/people/tho/Makefile
- tests/Makefile
- tests/MSSM/Makefile
- tests/SM/Makefile
- tests/people/Makefile
- tests/people/jr/Makefile
- tests/people/tho/Makefile
- tools/Makefile])
-
-dnl ***********************************************************************
-AC_OUTPUT
-dnl ***********************************************************************
-
-
Index: branches/ohl/omega-development/hgg-vertex/TODO
===================================================================
--- branches/ohl/omega-development/hgg-vertex/TODO (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/TODO (revision 8717)
@@ -1,22 +0,0 @@
-Physics:
-========
-
- - check symmetry factors for "gl gl -> H" color flow amplitudes
- and arbitray color (including sextets)
-
-Programming:
-============
-
- - re-enable diagram drawing
-
- - update the testbeds
-
-Maintainance:
-=============
-
- - Makefile and Makefile.in are not always rebuilt if out of date
- w.r.t. Makefile.am
-
- - adding a new module to the Makefile.ams is too tedious
-
- - adding a new application to the Makefile.ams is torture
Index: branches/ohl/omega-development/hgg-vertex/INSTALL
===================================================================
--- branches/ohl/omega-development/hgg-vertex/INSTALL (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/INSTALL (revision 8717)
@@ -1,238 +0,0 @@
-#-------------------------------------------------------------
-# Installing O'Mega (standalone without WHIZARD)
-#-------------------------------------------------------------
-
-Note that the matrix element generator O'Mega is part of the WHIZARD
-event generator (http://projects.hepforge.org/whizard). It is
-nevertheless fully functional as a stand-alone tool. O'Mega always
-gets the same version number now as the corresponding main WHIZARD.
-
-#-------------------------------------------------------------
-# Installing from a source code tar ball
-#-------------------------------------------------------------
-
-Although it is possible to build the O'Mega libraries from this
-directory, we recommend that you create a separate build directory and
-work from there.
-
-O'Mega is Free Software and the sources can be obtained (as either
-from
-
- http://whizard.event-generator.org
-
-or the HepForge repository:
-
- http://projects.hepforge.org/whizard
-
-The command
-
- gzip -cd omega-2.X.X.tgz | tar xf -
-
-will unpack the sources in a subdirectory whizard-2.X.X,
-where XX is the current version number.
-
-Prerequisites are:
-
- - Make
- - Objective Caml compiler (version 3.04 or higher)
- - Fortran 95/03 compiler
-
-The Objective Caml (O'Caml) compiler is available from
-http://pauillac.inria.fr/ocaml/
-
-#-------------------------------------------------------------
-# External libraries and programs
-#-------------------------------------------------------------
-
-There is no dependence on external libraries and programs for the pure
-matrix element generator.
-
-#-------------------------------------------------------------
-# platform specific issues
-#-------------------------------------------------------------
-
-None known yet.
-
-#-------------------------------------------------------------
-# installing from a source code tar ball
-#-------------------------------------------------------------
-
-Unwind the source code tar ball in some relevant directory.
-Autoconf and automake will already have been run.
-Determine where the files will be installed.
-We recommend that you create a separate build directory that is NOT in
-the source code directory tree.
-
-cd <build_directory>
-<source_code_directory>/configure --prefix=<install_dir>
- (Note that files will be installed under /usr/local if you do not
- specify a prefix.)
-make
- (Build temporary copies of libraries and executables.)
-make check [optional]
- (Perform sanity checks and standard tests)
-make install
- (Copy libraries, headers, executables, etc. to relevant
- subdirectories under <install_dir>.)
-
-#-------------------------------------------------------------
-# configure options
-#-------------------------------------------------------------
-
-A variety of options can be given to configure. Below is a list
-of the options that you are likely to find most useful.
-Defaults for the options are specified in brackets.
-
-Configuration:
- -h, --help display this help and exit
- --help=short display options specific to this package
- --help=recursive display the short help of all the included packages
- -V, --version display version information and exit
- -q, --quiet, --silent do not print `checking...' messages
- --cache-file=FILE cache test results in FILE [disabled]
- -C, --config-cache alias for `--cache-file=config.cache'
- -n, --no-create do not create output files
- --srcdir=DIR find the sources in DIR [configure dir or `..']
-
-Installation directories:
- --prefix=PREFIX install architecture-independent files in PREFIX
- [/usr/local]
- --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX
- [PREFIX]
-
-By default, `make install' will install all the files in
-`/usr/local/bin', `/usr/local/lib' etc. You can specify
-an installation prefix other than `/usr/local' using `--prefix',
-for instance `--prefix=$HOME'.
-
-For better control, use the options below.
-
-Fine tuning of the installation directories:
- --bindir=DIR user executables [EPREFIX/bin]
- --sbindir=DIR system admin executables [EPREFIX/sbin]
- --libexecdir=DIR program executables [EPREFIX/libexec]
- --sysconfdir=DIR read-only single-machine data [PREFIX/etc]
- --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com]
- --localstatedir=DIR modifiable single-machine data [PREFIX/var]
- --libdir=DIR object code libraries [EPREFIX/lib]
- --includedir=DIR C header files [PREFIX/include]
- --oldincludedir=DIR C header files for non-gcc [/usr/include]
- --datarootdir=DIR read-only arch.-independent data root [PREFIX/share]
- --datadir=DIR read-only architecture-independent data [DATAROOTDIR]
- --infodir=DIR info documentation [DATAROOTDIR/info]
- --localedir=DIR locale-dependent data [DATAROOTDIR/locale]
- --mandir=DIR man documentation [DATAROOTDIR/man]
- --docdir=DIR documentation root [DATAROOTDIR/doc/omega]
- --htmldir=DIR html documentation [DOCDIR]
- --dvidir=DIR dvi documentation [DOCDIR]
- --pdfdir=DIR pdf documentation [DOCDIR]
- --psdir=DIR ps documentation [DOCDIR]
-
-Program names:
- --program-prefix=PREFIX prepend PREFIX to installed program names
- --program-suffix=SUFFIX append SUFFIX to installed program names
- --program-transform-name=PROGRAM run sed PROGRAM on installed program names
-
-System types:
- --build=BUILD configure for building on BUILD [guessed]
- --host=HOST cross-compile to build programs to run on HOST [BUILD]
-
-Optional Features:
- --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no)
- --enable-FEATURE[=ARG] include FEATURE [ARG=yes]
- --disable-dependency-tracking speeds up one-time build
- --enable-dependency-tracking do not reject slow dependency extractors
- --enable-shared[=PKGS] build shared libraries [default=yes]
- --enable-static[=PKGS] build static libraries [default=yes]
- --enable-fast-install[=PKGS]
- optimize for fast installation [default=yes]
- --disable-libtool-lock avoid locking (might break parallel builds)
- --disable-ocaml disable the OCaml programs, even if available [[no]]
- --disable-noweb disable the noweb programs, even if available [[no]]
- --enable-fc-quadruple use quadruple precision in Fortran code [[no]]
- --enable-fc-profiling use profiling for the Fortran code [[no]]
- --enable-fc-impure compile Omega libraries impure [[no]]
- --enable-max-color-lines=number
- The maximum number of gluons and (anti-)quark
- pairs allowed. Values larger than the default 8
- make not much sense currently.
- --enable-install-all-caches
- Create the complete set of cache files for O'Mega
- (including more exotic models). This takes some
- time (make -j helps), but speeds up the self tests
- (i.e. make check) later [default=no].
- --enable-system-cache=directory
- Read precomputed model tables from this directory,
- which will be populated by an administrator at
- install time [default=$localstatedir/cache, enabled].
- --enable-user-cache=directory
- Store precomputed model tables in this directory
- and read them to avoid lengthy recomputations.
- Leading "~" will be replaced at runtime by ${HOME}.
- [Must be user writable, default=${HOME}/var/cache,
- enabled].
-
-Optional Packages:
- --with-PACKAGE[=ARG] use PACKAGE [ARG=yes]
- --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no)
- --with-pic try to use only PIC/non-PIC objects [default=use
- both]
- --with-gnu-ld assume the C compiler uses GNU ld [default=no]
-
-Some influential environment variables:
- CC C compiler command
- CFLAGS C compiler flags
- LDFLAGS linker flags, e.g. -L<lib dir> if you have libraries in a
- nonstandard directory <lib dir>
- LIBS libraries to pass to the linker, e.g. -l<library>
- CPPFLAGS C/C++/Objective C preprocessor flags, e.g. -I<include dir> if
- you have headers in a nonstandard directory <include dir>
- CPP C preprocessor
- FC Fortran compiler command
- FCFLAGS Fortran compiler flags
-
-#-------------------------------------------------------------
-# building from svn
-#-------------------------------------------------------------
-
-You will need current versions of automake and autoconf.
-On some machines, you will need to build them. See building autotools below.
-To build the documentations, LaTeX, MetaPost and OcamlWeb
-are also necessary tools. Although the first two are quite standard, you
-can get them from http://www.tug.org/texlive/. Follow the instructions there.
-OcamlWeb is available from http://www.lri.fr/~filliatr/ocamlweb/.
-
-svn co svn.hepforge.org/hepforge/home/whizard/event-generators/whizard/trunk/src/omega
-
-cd omega
-autoreconf
-
-Now continue with directions as if you unpacked a source code tarball.
-
-#-------------------------------------------------------------
-# building autotools
-#-------------------------------------------------------------
-
-If you do not have at least autoconf 2.60 and automake 1.10, you will
-need to build autoconf, automake, and libtool. On some platforms,
-you may also need to build m4 and texinfo.
-
-Download the relevant tarballs from gnu.org
-(http://www.gnu.org/software/autoconf/, http://www.gnu.org/software/automake/),
-Untar them in a common source code tree.
-Decide whether you want to install them in /usr/local or your own
-install directory. If you use your own install directory, use
-
- --prefix=<install_dir>
-
-with configure.
-
-For each autotool package:
-
- <source_code_dir>/configure [--prefix=<install_dir>]
- make
- make install
-
-Make sure that <install_dir>/bin is before /usr/bin in your path.
-
-#-------------------------------------------------------------
Index: branches/ohl/omega-development/hgg-vertex/lib/Makefile.am
===================================================================
--- branches/ohl/omega-development/hgg-vertex/lib/Makefile.am (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/lib/Makefile.am (revision 8717)
@@ -1,31 +0,0 @@
-# Makefile.am -- Makefile for O'Mega within and without WHIZARD
-# $Id$
-##
-## Process this file with automake to produce Makefile.in
-##
-########################################################################
-#
-# Copyright (C) 1999-2010 by
-# Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
-# Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
-# Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-#
-# 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 End.
-########################################################################
Index: branches/ohl/omega-development/hgg-vertex/COPYING
===================================================================
--- branches/ohl/omega-development/hgg-vertex/COPYING (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/COPYING (revision 8717)
@@ -1,339 +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
-
- Appendix: 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.
-
- <one line to give the program's name and a brief idea of what it does.>
- Copyright (C) 19yy <name of author>
-
- 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) 19yy 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.
-
- <signature of Ty Coon>, 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/hgg-vertex/bin/Makefile.am
===================================================================
--- branches/ohl/omega-development/hgg-vertex/bin/Makefile.am (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/bin/Makefile.am (revision 8717)
@@ -1,94 +0,0 @@
-# Makefile.am -- Makefile for O'Mega within and without WHIZARD
-# $Id$
-##
-## Process this file with automake to produce Makefile.in
-##
-########################################################################
-#
-# Copyright (C) 1999-2010 by
-# Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
-# Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
-# Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-#
-# 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.
-#
-########################################################################
-
-VPATH = $(top_builddir)/src:$(top_srcdir)/src
-
-bin_SCRIPTS = $(OMEGA_APPLICATIONS_NATIVE)
-
-bytecode: $(OMEGA_APPLICATIONS_BYTECODE)
-
-OMEGA_CMXA = omega_core.cmxa omega_targets.cmxa omega_models.cmxa
-OMEGA_CMA = $(OMEGA_CMXA:.cmxa=.cma)
-
-########################################################################
-
-include $(top_srcdir)/src/Makefile.ocaml
-include $(top_srcdir)/src/Makefile.sources
-include $(top_srcdir)/src/Makefile.depend
-
-OCAMLFLAGS += -I $(top_builddir)/src
-
-$(OMEGA_APPLICATIONS_NATIVE): $(OMEGA_CMXA)
-$(OMEGA_APPLICATIONS_BYTECODE): $(OMEGA_CMA)
-
-########################################################################
-
-SUFFIXES += $(OCAML_NATIVE_EXT) $(OMEGA_CACHE_SUFFIX)
-
-$(OCAML_NATIVE_EXT)$(OMEGA_CACHE_SUFFIX):
- echo $*:
- ./$< -initialize .
-
-
-if OMEGA_INSTALL_ALL_CACHES
-OMEGA_INSTALLED_CACHES = $(OMEGA_CACHES)
-else
-OMEGA_INSTALLED_CACHES = $(OMEGA_MINIMAL_CACHES)
-endif
-
-install-data-local: $(OMEGA_INSTALLED_CACHES)
- $(INSTALL) -d -m 755 $(OMEGA_USER_CACHE_DIR)
- $(INSTALL) -d -m 755 $(OMEGA_SYSTEM_CACHE_DIR)
- if test -w $(OMEGA_SYSTEM_CACHE_DIR) ; then \
- $(INSTALL) -m 644 -c $^ $(OMEGA_SYSTEM_CACHE_DIR) ; \
- elif test -w $(OMEGA_USER_CACHE_DIR) ; then \
- $(INSTALL) -m 644 -c $^ $(OMEGA_USER_CACHE_DIR) ; \
- fi
-
-install-all-caches: $(OMEGA_CACHES)
- $(INSTALL) -d -m 755 $(OMEGA_USER_CACHE_DIR)
- $(INSTALL) -d -m 755 $(OMEGA_SYSTEM_CACHE_DIR)
- if test -w $(OMEGA_SYSTEM_CACHE_DIR) ; then \
- $(INSTALL) -m 644 -c $^ $(OMEGA_SYSTEM_CACHE_DIR) ; \
- elif test -w $(OMEGA_USER_CACHE_DIR) ; then \
- $(INSTALL) -m 644 -c $^ $(OMEGA_USER_CACHE_DIR) ; \
- fi
-
-uninstall-local:
- for cache in $(OMEGA_CACHES); do \
- rm -f $(OMEGA_SYSTEM_CACHE_DIR)/$$cache $(OMEGA_USER_CACHE_DIR)/$$cache; \
- done
-
-clean-local:
- rm -f *.cm[iox] *.o \
- $(OMEGA_APPLICATIONS_BYTECODE) $(OMEGA_APPLICATIONS_NATIVE) \
- $(OMEGA_CACHES)
-
-########################################################################
-## The End.
-########################################################################
Index: branches/ohl/omega-development/hgg-vertex/missing
===================================================================
--- branches/ohl/omega-development/hgg-vertex/missing (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/missing (revision 8717)
@@ -1,376 +0,0 @@
-#! /bin/sh
-# Common stub for a few missing GNU programs while installing.
-
-scriptversion=2009-04-28.21; # UTC
-
-# Copyright (C) 1996, 1997, 1999, 2000, 2002, 2003, 2004, 2005, 2006,
-# 2008, 2009 Free Software Foundation, Inc.
-# Originally by Fran,cois Pinard <pinard@iro.umontreal.ca>, 1996.
-
-# 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, 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, see <http://www.gnu.org/licenses/>.
-
-# 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.
-
-if test $# -eq 0; then
- echo 1>&2 "Try \`$0 --help' for more information"
- exit 1
-fi
-
-run=:
-sed_output='s/.* --output[ =]\([^ ]*\).*/\1/p'
-sed_minuso='s/.* -o \([^ ]*\).*/\1/p'
-
-# In the cases where this matters, `missing' is being run in the
-# srcdir already.
-if test -f configure.ac; then
- configure_ac=configure.ac
-else
- configure_ac=configure.in
-fi
-
-msg="missing on your system"
-
-case $1 in
---run)
- # Try to run requested program, and just exit if it succeeds.
- run=
- shift
- "$@" && exit 0
- # Exit code 63 means version mismatch. This often happens
- # when the user try to use an ancient version of a tool on
- # a file that requires a minimum version. In this case we
- # we should proceed has if the program had been absent, or
- # if --run hadn't been passed.
- if test $? = 63; then
- run=:
- msg="probably too old"
- fi
- ;;
-
- -h|--h|--he|--hel|--help)
- echo "\
-$0 [OPTION]... PROGRAM [ARGUMENT]...
-
-Handle \`PROGRAM [ARGUMENT]...' for when PROGRAM is missing, or return an
-error status if there is no known handling for PROGRAM.
-
-Options:
- -h, --help display this help and exit
- -v, --version output version information and exit
- --run try to run the given command, and emulate it if it fails
-
-Supported PROGRAM values:
- aclocal touch file \`aclocal.m4'
- autoconf touch file \`configure'
- autoheader touch file \`config.h.in'
- autom4te touch the output file, or create a stub one
- automake touch all \`Makefile.in' files
- bison create \`y.tab.[ch]', if possible, from existing .[ch]
- flex create \`lex.yy.c', if possible, from existing .c
- help2man touch the output file
- lex create \`lex.yy.c', if possible, from existing .c
- makeinfo touch the output file
- tar try tar, gnutar, gtar, then tar without non-portable flags
- yacc create \`y.tab.[ch]', if possible, from existing .[ch]
-
-Version suffixes to PROGRAM as well as the prefixes \`gnu-', \`gnu', and
-\`g' are ignored when checking the name.
-
-Send bug reports to <bug-automake@gnu.org>."
- exit $?
- ;;
-
- -v|--v|--ve|--ver|--vers|--versi|--versio|--version)
- echo "missing $scriptversion (GNU Automake)"
- exit $?
- ;;
-
- -*)
- echo 1>&2 "$0: Unknown \`$1' option"
- echo 1>&2 "Try \`$0 --help' for more information"
- exit 1
- ;;
-
-esac
-
-# normalize program name to check for.
-program=`echo "$1" | sed '
- s/^gnu-//; t
- s/^gnu//; t
- s/^g//; t'`
-
-# Now exit if we have it, but it failed. Also exit now if we
-# don't have it and --version was passed (most likely to detect
-# the program). This is about non-GNU programs, so use $1 not
-# $program.
-case $1 in
- lex*|yacc*)
- # Not GNU programs, they don't have --version.
- ;;
-
- tar*)
- if test -n "$run"; then
- echo 1>&2 "ERROR: \`tar' requires --run"
- exit 1
- elif test "x$2" = "x--version" || test "x$2" = "x--help"; then
- exit 1
- fi
- ;;
-
- *)
- if test -z "$run" && ($1 --version) > /dev/null 2>&1; then
- # We have it, but it failed.
- exit 1
- elif test "x$2" = "x--version" || test "x$2" = "x--help"; then
- # Could not run --version or --help. This is probably someone
- # running `$TOOL --version' or `$TOOL --help' to check whether
- # $TOOL exists and not knowing $TOOL uses missing.
- exit 1
- fi
- ;;
-esac
-
-# If it does not exist, or fails to run (possibly an outdated version),
-# try to emulate it.
-case $program in
- aclocal*)
- echo 1>&2 "\
-WARNING: \`$1' is $msg. You should only need it if
- you modified \`acinclude.m4' or \`${configure_ac}'. You might want
- to install the \`Automake' and \`Perl' packages. Grab them from
- any GNU archive site."
- touch aclocal.m4
- ;;
-
- autoconf*)
- echo 1>&2 "\
-WARNING: \`$1' is $msg. You should only need it if
- you modified \`${configure_ac}'. You might want to install the
- \`Autoconf' and \`GNU m4' packages. Grab them from any GNU
- archive site."
- touch configure
- ;;
-
- autoheader*)
- echo 1>&2 "\
-WARNING: \`$1' is $msg. You should only need it if
- you modified \`acconfig.h' or \`${configure_ac}'. You might want
- to install the \`Autoconf' and \`GNU m4' packages. Grab them
- from any GNU archive site."
- files=`sed -n 's/^[ ]*A[CM]_CONFIG_HEADER(\([^)]*\)).*/\1/p' ${configure_ac}`
- test -z "$files" && files="config.h"
- touch_files=
- for f in $files; do
- case $f in
- *:*) touch_files="$touch_files "`echo "$f" |
- sed -e 's/^[^:]*://' -e 's/:.*//'`;;
- *) touch_files="$touch_files $f.in";;
- esac
- done
- touch $touch_files
- ;;
-
- automake*)
- echo 1>&2 "\
-WARNING: \`$1' is $msg. You should only need it if
- you modified \`Makefile.am', \`acinclude.m4' or \`${configure_ac}'.
- You might want to install the \`Automake' and \`Perl' packages.
- Grab them from any GNU archive site."
- find . -type f -name Makefile.am -print |
- sed 's/\.am$/.in/' |
- while read f; do touch "$f"; done
- ;;
-
- autom4te*)
- echo 1>&2 "\
-WARNING: \`$1' is needed, but is $msg.
- You might have modified some files without having the
- proper tools for further handling them.
- You can get \`$1' as part of \`Autoconf' from any GNU
- archive site."
-
- file=`echo "$*" | sed -n "$sed_output"`
- test -z "$file" && file=`echo "$*" | sed -n "$sed_minuso"`
- if test -f "$file"; then
- touch $file
- else
- test -z "$file" || exec >$file
- echo "#! /bin/sh"
- echo "# Created by GNU Automake missing as a replacement of"
- echo "# $ $@"
- echo "exit 0"
- chmod +x $file
- exit 1
- fi
- ;;
-
- bison*|yacc*)
- echo 1>&2 "\
-WARNING: \`$1' $msg. You should only need it if
- you modified a \`.y' file. You may need the \`Bison' package
- in order for those modifications to take effect. You can get
- \`Bison' from any GNU archive site."
- rm -f y.tab.c y.tab.h
- if test $# -ne 1; then
- eval LASTARG="\${$#}"
- case $LASTARG in
- *.y)
- SRCFILE=`echo "$LASTARG" | sed 's/y$/c/'`
- if test -f "$SRCFILE"; then
- cp "$SRCFILE" y.tab.c
- fi
- SRCFILE=`echo "$LASTARG" | sed 's/y$/h/'`
- if test -f "$SRCFILE"; then
- cp "$SRCFILE" y.tab.h
- fi
- ;;
- esac
- fi
- if test ! -f y.tab.h; then
- echo >y.tab.h
- fi
- if test ! -f y.tab.c; then
- echo 'main() { return 0; }' >y.tab.c
- fi
- ;;
-
- lex*|flex*)
- echo 1>&2 "\
-WARNING: \`$1' is $msg. You should only need it if
- you modified a \`.l' file. You may need the \`Flex' package
- in order for those modifications to take effect. You can get
- \`Flex' from any GNU archive site."
- rm -f lex.yy.c
- if test $# -ne 1; then
- eval LASTARG="\${$#}"
- case $LASTARG in
- *.l)
- SRCFILE=`echo "$LASTARG" | sed 's/l$/c/'`
- if test -f "$SRCFILE"; then
- cp "$SRCFILE" lex.yy.c
- fi
- ;;
- esac
- fi
- if test ! -f lex.yy.c; then
- echo 'main() { return 0; }' >lex.yy.c
- fi
- ;;
-
- help2man*)
- echo 1>&2 "\
-WARNING: \`$1' is $msg. You should only need it if
- you modified a dependency of a manual page. You may need the
- \`Help2man' package in order for those modifications to take
- effect. You can get \`Help2man' from any GNU archive site."
-
- file=`echo "$*" | sed -n "$sed_output"`
- test -z "$file" && file=`echo "$*" | sed -n "$sed_minuso"`
- if test -f "$file"; then
- touch $file
- else
- test -z "$file" || exec >$file
- echo ".ab help2man is required to generate this page"
- exit $?
- fi
- ;;
-
- makeinfo*)
- echo 1>&2 "\
-WARNING: \`$1' is $msg. You should only need it if
- you modified a \`.texi' or \`.texinfo' file, or any other file
- indirectly affecting the aspect of the manual. The spurious
- call might also be the consequence of using a buggy \`make' (AIX,
- DU, IRIX). You might want to install the \`Texinfo' package or
- the \`GNU make' package. Grab either from any GNU archive site."
- # The file to touch is that specified with -o ...
- file=`echo "$*" | sed -n "$sed_output"`
- test -z "$file" && file=`echo "$*" | sed -n "$sed_minuso"`
- if test -z "$file"; then
- # ... or it is the one specified with @setfilename ...
- infile=`echo "$*" | sed 's/.* \([^ ]*\) *$/\1/'`
- file=`sed -n '
- /^@setfilename/{
- s/.* \([^ ]*\) *$/\1/
- p
- q
- }' $infile`
- # ... or it is derived from the source name (dir/f.texi becomes f.info)
- test -z "$file" && file=`echo "$infile" | sed 's,.*/,,;s,.[^.]*$,,'`.info
- fi
- # If the file does not exist, the user really needs makeinfo;
- # let's fail without touching anything.
- test -f $file || exit 1
- touch $file
- ;;
-
- tar*)
- shift
-
- # We have already tried tar in the generic part.
- # Look for gnutar/gtar before invocation to avoid ugly error
- # messages.
- if (gnutar --version > /dev/null 2>&1); then
- gnutar "$@" && exit 0
- fi
- if (gtar --version > /dev/null 2>&1); then
- gtar "$@" && exit 0
- fi
- firstarg="$1"
- if shift; then
- case $firstarg in
- *o*)
- firstarg=`echo "$firstarg" | sed s/o//`
- tar "$firstarg" "$@" && exit 0
- ;;
- esac
- case $firstarg in
- *h*)
- firstarg=`echo "$firstarg" | sed s/h//`
- tar "$firstarg" "$@" && exit 0
- ;;
- esac
- fi
-
- echo 1>&2 "\
-WARNING: I can't seem to be able to run \`tar' with the given arguments.
- You may want to install GNU tar or Free paxutils, or check the
- command line arguments."
- exit 1
- ;;
-
- *)
- echo 1>&2 "\
-WARNING: \`$1' is needed, and is $msg.
- You might have modified some files without having the
- proper tools for further handling them. Check the \`README' file,
- it often tells you about the needed prerequisites for installing
- this package. You may also peek at any GNU archive site, in case
- some other package would contain this missing \`$1' program."
- exit 1
- ;;
-esac
-
-exit 0
-
-# Local variables:
-# eval: (add-hook 'write-file-hooks 'time-stamp)
-# time-stamp-start: "scriptversion="
-# time-stamp-format: "%:y-%02m-%02d.%02H"
-# time-stamp-time-zone: "UTC"
-# time-stamp-end: "; # UTC"
-# End:
Index: branches/ohl/omega-development/hgg-vertex/Makefile.am
===================================================================
--- branches/ohl/omega-development/hgg-vertex/Makefile.am (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/Makefile.am (revision 8717)
@@ -1,91 +0,0 @@
-# Makefile.am -- Makefile for O'Mega within and without WHIZARD
-# $Id$
-##
-## Process this file with automake to produce Makefile.in
-##
-########################################################################
-#
-# Copyright (C) 1999-2010 by
-# Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
-# Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
-# Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-#
-# 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 do our own dependency checking for fortran and and ocaml:
-AUTOMAKE_OPTIONS = no-dependencies
-
-## Use the m4 directory for local Autoconf macros
-ACLOCAL_AMFLAGS = -I m4
-
-## Subdirectories to configure
-if OCAML_AVAILABLE
-OPT_OMEGA = bin models share tests extensions
-else
-OPT_OMEGA =
-endif
-SUBDIRS = src lib $(OPT_OMEGA) tools
-DIST_SUBDIRS = src lib models bin share tools extensions tests
-
-## Use the same compiler and compiler flags for distcheck
-DISTCHECK_CONFIGURE_FLAGS = FC=$(FC) FCFLAGS="$(FCFLAGS)" LIBS="$(LIBS)"
-
-EXTRA_DISTCHECK_CONFIGURE_FLAGS = \
- "--disable-noweb" \
- "--disable-noweb --disable-omega" \
- "--disable-noweb --disable-shared" \
- "--disable-noweb --disable-static" \
- "--disable-noweb --enable-fc-quadruple"
-
-extra-distcheck:
- @echo "=================================================" >$@.log
- @echo "make distcheck with additional configure options:" >>$@.log
- for flag in $(EXTRA_DISTCHECK_CONFIGURE_FLAGS); do \
- if $(MAKE) $(AM_MAKEFLAGS) \
- DISTCHECK_CONFIGURE_FLAGS='$(DISTCHECK_CONFIGURE_FLAGS) '"$$flag" \
- distcheck; then \
- echo "PASS $$flag" >>$@.log; \
- else \
- echo "FAIL $$flag" >>$@.log; \
- fi; \
- done
- @echo "=================================================" >>$@.log
- @cat $@.log
- @rm -f $@.log
-
-########################################################################
-
-clean-local:
-# rm -fr var
-
-if OCAML_AVAILABLE
-install-all-caches:
- cd bin && $(MAKE) $(AM_MAKEFLAGS) install-all-caches
-
-install-data-local:
- $(INSTALL) -d -m 755 $(OMEGA_USER_CACHE_DIR)
- $(INSTALL) -d -m 755 $(OMEGA_SYSTEM_CACHE_DIR)
-endif
-
-uninstall-local:
- rm -f $(OMEGA_USER_CACHE_DIR)/*$(OMEGA_CACHE_SUFFIX)
- rm -f $(OMEGA_SYSTEM_CACHE_DIR)/*$(OMEGA_CACHE_SUFFIX)
-
-########################################################################
-## The End.
-########################################################################
-
Index: branches/ohl/omega-development/hgg-vertex/NEWS
===================================================================
--- branches/ohl/omega-development/hgg-vertex/NEWS (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/NEWS (revision 8717)
@@ -1,8 +0,0 @@
-NEWS -- User-visible changes for O'Mega
-
-version 2.0.0
- -- color flows are now fully generated by O'Mega (O'Mega
- handles color flows internally)
- -- there is a common subexpression elimination (CSE) across
- flavors
- -- newly structured model libraries for the BSM models
\ No newline at end of file
Index: branches/ohl/omega-development/hgg-vertex/.depend
===================================================================
--- branches/ohl/omega-development/hgg-vertex/.depend (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/.depend (revision 8717)
@@ -1,85 +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
Index: branches/ohl/omega-development/hgg-vertex/install-sh
===================================================================
--- branches/ohl/omega-development/hgg-vertex/install-sh (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/install-sh (revision 8717)
@@ -1,520 +0,0 @@
-#!/bin/sh
-# install - install a program, script, or datafile
-
-scriptversion=2009-04-28.21; # UTC
-
-# This originates from X11R5 (mit/util/scripts/install.sh), which was
-# later released in X11R6 (xc/config/util/install.sh) with the
-# following copyright and license.
-#
-# Copyright (C) 1994 X Consortium
-#
-# Permission is hereby granted, free of charge, to any person obtaining a copy
-# of this software and associated documentation files (the "Software"), to
-# deal in the Software without restriction, including without limitation the
-# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
-# sell copies of the Software, and to permit persons to whom the Software is
-# furnished to do so, subject to the following conditions:
-#
-# The above copyright notice and this permission notice shall be included in
-# all copies or substantial portions of the Software.
-#
-# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
-# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
-# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
-# X CONSORTIUM BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN
-# AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNEC-
-# TION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
-#
-# Except as contained in this notice, the name of the X Consortium shall not
-# be used in advertising or otherwise to promote the sale, use or other deal-
-# ings in this Software without prior written authorization from the X Consor-
-# tium.
-#
-#
-# FSF changes to this file are in the public domain.
-#
-# 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.
-
-nl='
-'
-IFS=" "" $nl"
-
-# set DOITPROG to echo to test this script
-
-# Don't use :- since 4.3BSD and earlier shells don't like it.
-doit=${DOITPROG-}
-if test -z "$doit"; then
- doit_exec=exec
-else
- doit_exec=$doit
-fi
-
-# Put in absolute file names if you don't have them in your path;
-# or use environment vars.
-
-chgrpprog=${CHGRPPROG-chgrp}
-chmodprog=${CHMODPROG-chmod}
-chownprog=${CHOWNPROG-chown}
-cmpprog=${CMPPROG-cmp}
-cpprog=${CPPROG-cp}
-mkdirprog=${MKDIRPROG-mkdir}
-mvprog=${MVPROG-mv}
-rmprog=${RMPROG-rm}
-stripprog=${STRIPPROG-strip}
-
-posix_glob='?'
-initialize_posix_glob='
- test "$posix_glob" != "?" || {
- if (set -f) 2>/dev/null; then
- posix_glob=
- else
- posix_glob=:
- fi
- }
-'
-
-posix_mkdir=
-
-# Desired mode of installed file.
-mode=0755
-
-chgrpcmd=
-chmodcmd=$chmodprog
-chowncmd=
-mvcmd=$mvprog
-rmcmd="$rmprog -f"
-stripcmd=
-
-src=
-dst=
-dir_arg=
-dst_arg=
-
-copy_on_change=false
-no_target_directory=
-
-usage="\
-Usage: $0 [OPTION]... [-T] SRCFILE DSTFILE
- or: $0 [OPTION]... SRCFILES... DIRECTORY
- or: $0 [OPTION]... -t DIRECTORY SRCFILES...
- or: $0 [OPTION]... -d DIRECTORIES...
-
-In the 1st form, copy SRCFILE to DSTFILE.
-In the 2nd and 3rd, copy all SRCFILES to DIRECTORY.
-In the 4th, create DIRECTORIES.
-
-Options:
- --help display this help and exit.
- --version display version info and exit.
-
- -c (ignored)
- -C install only if different (preserve the last data modification time)
- -d create directories instead of installing files.
- -g GROUP $chgrpprog installed files to GROUP.
- -m MODE $chmodprog installed files to MODE.
- -o USER $chownprog installed files to USER.
- -s $stripprog installed files.
- -t DIRECTORY install into DIRECTORY.
- -T report an error if DSTFILE is a directory.
-
-Environment variables override the default commands:
- CHGRPPROG CHMODPROG CHOWNPROG CMPPROG CPPROG MKDIRPROG MVPROG
- RMPROG STRIPPROG
-"
-
-while test $# -ne 0; do
- case $1 in
- -c) ;;
-
- -C) copy_on_change=true;;
-
- -d) dir_arg=true;;
-
- -g) chgrpcmd="$chgrpprog $2"
- shift;;
-
- --help) echo "$usage"; exit $?;;
-
- -m) mode=$2
- case $mode in
- *' '* | *' '* | *'
-'* | *'*'* | *'?'* | *'['*)
- echo "$0: invalid mode: $mode" >&2
- exit 1;;
- esac
- shift;;
-
- -o) chowncmd="$chownprog $2"
- shift;;
-
- -s) stripcmd=$stripprog;;
-
- -t) dst_arg=$2
- shift;;
-
- -T) no_target_directory=true;;
-
- --version) echo "$0 $scriptversion"; exit $?;;
-
- --) shift
- break;;
-
- -*) echo "$0: invalid option: $1" >&2
- exit 1;;
-
- *) break;;
- esac
- shift
-done
-
-if test $# -ne 0 && test -z "$dir_arg$dst_arg"; then
- # When -d is used, all remaining arguments are directories to create.
- # When -t is used, the destination is already specified.
- # Otherwise, the last argument is the destination. Remove it from $@.
- for arg
- do
- if test -n "$dst_arg"; then
- # $@ is not empty: it contains at least $arg.
- set fnord "$@" "$dst_arg"
- shift # fnord
- fi
- shift # arg
- dst_arg=$arg
- done
-fi
-
-if test $# -eq 0; then
- if test -z "$dir_arg"; then
- echo "$0: no input file specified." >&2
- exit 1
- fi
- # It's OK to call `install-sh -d' without argument.
- # This can happen when creating conditional directories.
- exit 0
-fi
-
-if test -z "$dir_arg"; then
- trap '(exit $?); exit' 1 2 13 15
-
- # Set umask so as not to create temps with too-generous modes.
- # However, 'strip' requires both read and write access to temps.
- case $mode in
- # Optimize common cases.
- *644) cp_umask=133;;
- *755) cp_umask=22;;
-
- *[0-7])
- if test -z "$stripcmd"; then
- u_plus_rw=
- else
- u_plus_rw='% 200'
- fi
- cp_umask=`expr '(' 777 - $mode % 1000 ')' $u_plus_rw`;;
- *)
- if test -z "$stripcmd"; then
- u_plus_rw=
- else
- u_plus_rw=,u+rw
- fi
- cp_umask=$mode$u_plus_rw;;
- esac
-fi
-
-for src
-do
- # Protect names starting with `-'.
- case $src in
- -*) src=./$src;;
- esac
-
- if test -n "$dir_arg"; then
- dst=$src
- dstdir=$dst
- test -d "$dstdir"
- dstdir_status=$?
- else
-
- # Waiting for this to be detected by the "$cpprog $src $dsttmp" command
- # might cause directories to be created, which would be especially bad
- # if $src (and thus $dsttmp) contains '*'.
- if test ! -f "$src" && test ! -d "$src"; then
- echo "$0: $src does not exist." >&2
- exit 1
- fi
-
- if test -z "$dst_arg"; then
- echo "$0: no destination specified." >&2
- exit 1
- fi
-
- dst=$dst_arg
- # Protect names starting with `-'.
- case $dst in
- -*) dst=./$dst;;
- esac
-
- # If destination is a directory, append the input filename; won't work
- # if double slashes aren't ignored.
- if test -d "$dst"; then
- if test -n "$no_target_directory"; then
- echo "$0: $dst_arg: Is a directory" >&2
- exit 1
- fi
- dstdir=$dst
- dst=$dstdir/`basename "$src"`
- dstdir_status=0
- else
- # Prefer dirname, but fall back on a substitute if dirname fails.
- dstdir=`
- (dirname "$dst") 2>/dev/null ||
- expr X"$dst" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
- X"$dst" : 'X\(//\)[^/]' \| \
- X"$dst" : 'X\(//\)$' \| \
- X"$dst" : 'X\(/\)' \| . 2>/dev/null ||
- echo X"$dst" |
- sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
- s//\1/
- q
- }
- /^X\(\/\/\)[^/].*/{
- s//\1/
- q
- }
- /^X\(\/\/\)$/{
- s//\1/
- q
- }
- /^X\(\/\).*/{
- s//\1/
- q
- }
- s/.*/./; q'
- `
-
- test -d "$dstdir"
- dstdir_status=$?
- fi
- fi
-
- obsolete_mkdir_used=false
-
- if test $dstdir_status != 0; then
- case $posix_mkdir in
- '')
- # Create intermediate dirs using mode 755 as modified by the umask.
- # This is like FreeBSD 'install' as of 1997-10-28.
- umask=`umask`
- case $stripcmd.$umask in
- # Optimize common cases.
- *[2367][2367]) mkdir_umask=$umask;;
- .*0[02][02] | .[02][02] | .[02]) mkdir_umask=22;;
-
- *[0-7])
- mkdir_umask=`expr $umask + 22 \
- - $umask % 100 % 40 + $umask % 20 \
- - $umask % 10 % 4 + $umask % 2
- `;;
- *) mkdir_umask=$umask,go-w;;
- esac
-
- # With -d, create the new directory with the user-specified mode.
- # Otherwise, rely on $mkdir_umask.
- if test -n "$dir_arg"; then
- mkdir_mode=-m$mode
- else
- mkdir_mode=
- fi
-
- posix_mkdir=false
- case $umask in
- *[123567][0-7][0-7])
- # POSIX mkdir -p sets u+wx bits regardless of umask, which
- # is incompatible with FreeBSD 'install' when (umask & 300) != 0.
- ;;
- *)
- tmpdir=${TMPDIR-/tmp}/ins$RANDOM-$$
- trap 'ret=$?; rmdir "$tmpdir/d" "$tmpdir" 2>/dev/null; exit $ret' 0
-
- if (umask $mkdir_umask &&
- exec $mkdirprog $mkdir_mode -p -- "$tmpdir/d") >/dev/null 2>&1
- then
- if test -z "$dir_arg" || {
- # Check for POSIX incompatibilities with -m.
- # HP-UX 11.23 and IRIX 6.5 mkdir -m -p sets group- or
- # other-writeable bit of parent directory when it shouldn't.
- # FreeBSD 6.1 mkdir -m -p sets mode of existing directory.
- ls_ld_tmpdir=`ls -ld "$tmpdir"`
- case $ls_ld_tmpdir in
- d????-?r-*) different_mode=700;;
- d????-?--*) different_mode=755;;
- *) false;;
- esac &&
- $mkdirprog -m$different_mode -p -- "$tmpdir" && {
- ls_ld_tmpdir_1=`ls -ld "$tmpdir"`
- test "$ls_ld_tmpdir" = "$ls_ld_tmpdir_1"
- }
- }
- then posix_mkdir=:
- fi
- rmdir "$tmpdir/d" "$tmpdir"
- else
- # Remove any dirs left behind by ancient mkdir implementations.
- rmdir ./$mkdir_mode ./-p ./-- 2>/dev/null
- fi
- trap '' 0;;
- esac;;
- esac
-
- if
- $posix_mkdir && (
- umask $mkdir_umask &&
- $doit_exec $mkdirprog $mkdir_mode -p -- "$dstdir"
- )
- then :
- else
-
- # The umask is ridiculous, or mkdir does not conform to POSIX,
- # or it failed possibly due to a race condition. Create the
- # directory the slow way, step by step, checking for races as we go.
-
- case $dstdir in
- /*) prefix='/';;
- -*) prefix='./';;
- *) prefix='';;
- esac
-
- eval "$initialize_posix_glob"
-
- oIFS=$IFS
- IFS=/
- $posix_glob set -f
- set fnord $dstdir
- shift
- $posix_glob set +f
- IFS=$oIFS
-
- prefixes=
-
- for d
- do
- test -z "$d" && continue
-
- prefix=$prefix$d
- if test -d "$prefix"; then
- prefixes=
- else
- if $posix_mkdir; then
- (umask=$mkdir_umask &&
- $doit_exec $mkdirprog $mkdir_mode -p -- "$dstdir") && break
- # Don't fail if two instances are running concurrently.
- test -d "$prefix" || exit 1
- else
- case $prefix in
- *\'*) qprefix=`echo "$prefix" | sed "s/'/'\\\\\\\\''/g"`;;
- *) qprefix=$prefix;;
- esac
- prefixes="$prefixes '$qprefix'"
- fi
- fi
- prefix=$prefix/
- done
-
- if test -n "$prefixes"; then
- # Don't fail if two instances are running concurrently.
- (umask $mkdir_umask &&
- eval "\$doit_exec \$mkdirprog $prefixes") ||
- test -d "$dstdir" || exit 1
- obsolete_mkdir_used=true
- fi
- fi
- fi
-
- if test -n "$dir_arg"; then
- { test -z "$chowncmd" || $doit $chowncmd "$dst"; } &&
- { test -z "$chgrpcmd" || $doit $chgrpcmd "$dst"; } &&
- { test "$obsolete_mkdir_used$chowncmd$chgrpcmd" = false ||
- test -z "$chmodcmd" || $doit $chmodcmd $mode "$dst"; } || exit 1
- else
-
- # Make a couple of temp file names in the proper directory.
- dsttmp=$dstdir/_inst.$$_
- rmtmp=$dstdir/_rm.$$_
-
- # Trap to clean up those temp files at exit.
- trap 'ret=$?; rm -f "$dsttmp" "$rmtmp" && exit $ret' 0
-
- # Copy the file name to the temp name.
- (umask $cp_umask && $doit_exec $cpprog "$src" "$dsttmp") &&
-
- # 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 $cpprog $src $dsttmp" command.
- #
- { test -z "$chowncmd" || $doit $chowncmd "$dsttmp"; } &&
- { test -z "$chgrpcmd" || $doit $chgrpcmd "$dsttmp"; } &&
- { test -z "$stripcmd" || $doit $stripcmd "$dsttmp"; } &&
- { test -z "$chmodcmd" || $doit $chmodcmd $mode "$dsttmp"; } &&
-
- # If -C, don't bother to copy if it wouldn't change the file.
- if $copy_on_change &&
- old=`LC_ALL=C ls -dlL "$dst" 2>/dev/null` &&
- new=`LC_ALL=C ls -dlL "$dsttmp" 2>/dev/null` &&
-
- eval "$initialize_posix_glob" &&
- $posix_glob set -f &&
- set X $old && old=:$2:$4:$5:$6 &&
- set X $new && new=:$2:$4:$5:$6 &&
- $posix_glob set +f &&
-
- test "$old" = "$new" &&
- $cmpprog "$dst" "$dsttmp" >/dev/null 2>&1
- then
- rm -f "$dsttmp"
- else
- # Rename the file to the real destination.
- $doit $mvcmd -f "$dsttmp" "$dst" 2>/dev/null ||
-
- # The rename failed, perhaps because mv can't rename something else
- # to itself, or perhaps because mv is so ancient that it does not
- # support -f.
- {
- # Now remove or move aside any old file at destination location.
- # We try this two ways since rm can't unlink itself on some
- # systems and the destination file might be busy for other
- # reasons. In this case, the final cleanup might fail but the new
- # file should still install successfully.
- {
- test ! -f "$dst" ||
- $doit $rmcmd -f "$dst" 2>/dev/null ||
- { $doit $mvcmd -f "$dst" "$rmtmp" 2>/dev/null &&
- { $doit $rmcmd -f "$rmtmp" 2>/dev/null; :; }
- } ||
- { echo "$0: cannot unlink or rename $dst" >&2
- (exit 1); exit 1
- }
- } &&
-
- # Now rename the file to the real destination.
- $doit $mvcmd "$dsttmp" "$dst"
- }
- fi || exit 1
-
- trap '' 0
- fi
-done
-
-# Local variables:
-# eval: (add-hook 'write-file-hooks 'time-stamp)
-# time-stamp-start: "scriptversion="
-# time-stamp-format: "%:y-%02m-%02d.%02H"
-# time-stamp-time-zone: "UTC"
-# time-stamp-end: "; # UTC"
-# End:
Index: branches/ohl/omega-development/hgg-vertex/m4/ltsugar.m4
===================================================================
--- branches/ohl/omega-development/hgg-vertex/m4/ltsugar.m4 (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/m4/ltsugar.m4 (revision 8717)
@@ -1,123 +0,0 @@
-# ltsugar.m4 -- libtool m4 base layer. -*-Autoconf-*-
-#
-# Copyright (C) 2004, 2005, 2007, 2008 Free Software Foundation, Inc.
-# Written by Gary V. Vaughan, 2004
-#
-# This file is free software; the Free Software Foundation gives
-# unlimited permission to copy and/or distribute it, with or without
-# modifications, as long as this notice is preserved.
-
-# serial 6 ltsugar.m4
-
-# This is to help aclocal find these macros, as it can't see m4_define.
-AC_DEFUN([LTSUGAR_VERSION], [m4_if([0.1])])
-
-
-# lt_join(SEP, ARG1, [ARG2...])
-# -----------------------------
-# Produce ARG1SEPARG2...SEPARGn, omitting [] arguments and their
-# associated separator.
-# Needed until we can rely on m4_join from Autoconf 2.62, since all earlier
-# versions in m4sugar had bugs.
-m4_define([lt_join],
-[m4_if([$#], [1], [],
- [$#], [2], [[$2]],
- [m4_if([$2], [], [], [[$2]_])$0([$1], m4_shift(m4_shift($@)))])])
-m4_define([_lt_join],
-[m4_if([$#$2], [2], [],
- [m4_if([$2], [], [], [[$1$2]])$0([$1], m4_shift(m4_shift($@)))])])
-
-
-# lt_car(LIST)
-# lt_cdr(LIST)
-# ------------
-# Manipulate m4 lists.
-# These macros are necessary as long as will still need to support
-# Autoconf-2.59 which quotes differently.
-m4_define([lt_car], [[$1]])
-m4_define([lt_cdr],
-[m4_if([$#], 0, [m4_fatal([$0: cannot be called without arguments])],
- [$#], 1, [],
- [m4_dquote(m4_shift($@))])])
-m4_define([lt_unquote], $1)
-
-
-# lt_append(MACRO-NAME, STRING, [SEPARATOR])
-# ------------------------------------------
-# Redefine MACRO-NAME to hold its former content plus `SEPARATOR'`STRING'.
-# Note that neither SEPARATOR nor STRING are expanded; they are appended
-# to MACRO-NAME as is (leaving the expansion for when MACRO-NAME is invoked).
-# No SEPARATOR is output if MACRO-NAME was previously undefined (different
-# than defined and empty).
-#
-# This macro is needed until we can rely on Autoconf 2.62, since earlier
-# versions of m4sugar mistakenly expanded SEPARATOR but not STRING.
-m4_define([lt_append],
-[m4_define([$1],
- m4_ifdef([$1], [m4_defn([$1])[$3]])[$2])])
-
-
-
-# lt_combine(SEP, PREFIX-LIST, INFIX, SUFFIX1, [SUFFIX2...])
-# ----------------------------------------------------------
-# Produce a SEP delimited list of all paired combinations of elements of
-# PREFIX-LIST with SUFFIX1 through SUFFIXn. Each element of the list
-# has the form PREFIXmINFIXSUFFIXn.
-# Needed until we can rely on m4_combine added in Autoconf 2.62.
-m4_define([lt_combine],
-[m4_if(m4_eval([$# > 3]), [1],
- [m4_pushdef([_Lt_sep], [m4_define([_Lt_sep], m4_defn([lt_car]))])]]dnl
-[[m4_foreach([_Lt_prefix], [$2],
- [m4_foreach([_Lt_suffix],
- ]m4_dquote(m4_dquote(m4_shift(m4_shift(m4_shift($@)))))[,
- [_Lt_sep([$1])[]m4_defn([_Lt_prefix])[$3]m4_defn([_Lt_suffix])])])])])
-
-
-# lt_if_append_uniq(MACRO-NAME, VARNAME, [SEPARATOR], [UNIQ], [NOT-UNIQ])
-# -----------------------------------------------------------------------
-# Iff MACRO-NAME does not yet contain VARNAME, then append it (delimited
-# by SEPARATOR if supplied) and expand UNIQ, else NOT-UNIQ.
-m4_define([lt_if_append_uniq],
-[m4_ifdef([$1],
- [m4_if(m4_index([$3]m4_defn([$1])[$3], [$3$2$3]), [-1],
- [lt_append([$1], [$2], [$3])$4],
- [$5])],
- [lt_append([$1], [$2], [$3])$4])])
-
-
-# lt_dict_add(DICT, KEY, VALUE)
-# -----------------------------
-m4_define([lt_dict_add],
-[m4_define([$1($2)], [$3])])
-
-
-# lt_dict_add_subkey(DICT, KEY, SUBKEY, VALUE)
-# --------------------------------------------
-m4_define([lt_dict_add_subkey],
-[m4_define([$1($2:$3)], [$4])])
-
-
-# lt_dict_fetch(DICT, KEY, [SUBKEY])
-# ----------------------------------
-m4_define([lt_dict_fetch],
-[m4_ifval([$3],
- m4_ifdef([$1($2:$3)], [m4_defn([$1($2:$3)])]),
- m4_ifdef([$1($2)], [m4_defn([$1($2)])]))])
-
-
-# lt_if_dict_fetch(DICT, KEY, [SUBKEY], VALUE, IF-TRUE, [IF-FALSE])
-# -----------------------------------------------------------------
-m4_define([lt_if_dict_fetch],
-[m4_if(lt_dict_fetch([$1], [$2], [$3]), [$4],
- [$5],
- [$6])])
-
-
-# lt_dict_filter(DICT, [SUBKEY], VALUE, [SEPARATOR], KEY, [...])
-# --------------------------------------------------------------
-m4_define([lt_dict_filter],
-[m4_if([$5], [], [],
- [lt_join(m4_quote(m4_default([$4], [[, ]])),
- lt_unquote(m4_split(m4_normalize(m4_foreach(_Lt_key, lt_car([m4_shiftn(4, $@)]),
- [lt_if_dict_fetch([$1], _Lt_key, [$2], [$3], [_Lt_key ])])))))])[]dnl
-])
Index: branches/ohl/omega-development/hgg-vertex/m4/libtool.m4
===================================================================
--- branches/ohl/omega-development/hgg-vertex/m4/libtool.m4 (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/m4/libtool.m4 (revision 8717)
@@ -1,7371 +0,0 @@
-# libtool.m4 - Configure libtool for the host system. -*-Autoconf-*-
-#
-# Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2003, 2004, 2005,
-# 2006, 2007, 2008 Free Software Foundation, Inc.
-# Written by Gordon Matzigkeit, 1996
-#
-# This file is free software; the Free Software Foundation gives
-# unlimited permission to copy and/or distribute it, with or without
-# modifications, as long as this notice is preserved.
-
-m4_define([_LT_COPYING], [dnl
-# Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2003, 2004, 2005,
-# 2006, 2007, 2008 Free Software Foundation, Inc.
-# Written by Gordon Matzigkeit, 1996
-#
-# This file is part of GNU Libtool.
-#
-# GNU Libtool 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.
-#
-# As a special exception to the GNU General Public License,
-# if you distribute this file as part of a program or library that
-# is built using GNU Libtool, you may include this file under the
-# same distribution terms that you use for the rest of that program.
-#
-# GNU Libtool 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 GNU Libtool; see the file COPYING. If not, a copy
-# can be downloaded from http://www.gnu.org/licenses/gpl.html, or
-# obtained by writing to the Free Software Foundation, Inc.,
-# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
-])
-
-# serial 56 LT_INIT
-
-
-# LT_PREREQ(VERSION)
-# ------------------
-# Complain and exit if this libtool version is less that VERSION.
-m4_defun([LT_PREREQ],
-[m4_if(m4_version_compare(m4_defn([LT_PACKAGE_VERSION]), [$1]), -1,
- [m4_default([$3],
- [m4_fatal([Libtool version $1 or higher is required],
- 63)])],
- [$2])])
-
-
-# _LT_CHECK_BUILDDIR
-# ------------------
-# Complain if the absolute build directory name contains unusual characters
-m4_defun([_LT_CHECK_BUILDDIR],
-[case `pwd` in
- *\ * | *\ *)
- AC_MSG_WARN([Libtool does not cope well with whitespace in `pwd`]) ;;
-esac
-])
-
-
-# LT_INIT([OPTIONS])
-# ------------------
-AC_DEFUN([LT_INIT],
-[AC_PREREQ([2.58])dnl We use AC_INCLUDES_DEFAULT
-AC_BEFORE([$0], [LT_LANG])dnl
-AC_BEFORE([$0], [LT_OUTPUT])dnl
-AC_BEFORE([$0], [LTDL_INIT])dnl
-m4_require([_LT_CHECK_BUILDDIR])dnl
-
-dnl Autoconf doesn't catch unexpanded LT_ macros by default:
-m4_pattern_forbid([^_?LT_[A-Z_]+$])dnl
-m4_pattern_allow([^(_LT_EOF|LT_DLGLOBAL|LT_DLLAZY_OR_NOW|LT_MULTI_MODULE)$])dnl
-dnl aclocal doesn't pull ltoptions.m4, ltsugar.m4, or ltversion.m4
-dnl unless we require an AC_DEFUNed macro:
-AC_REQUIRE([LTOPTIONS_VERSION])dnl
-AC_REQUIRE([LTSUGAR_VERSION])dnl
-AC_REQUIRE([LTVERSION_VERSION])dnl
-AC_REQUIRE([LTOBSOLETE_VERSION])dnl
-m4_require([_LT_PROG_LTMAIN])dnl
-
-dnl Parse OPTIONS
-_LT_SET_OPTIONS([$0], [$1])
-
-# This can be used to rebuild libtool when needed
-LIBTOOL_DEPS="$ltmain"
-
-# Always use our own libtool.
-LIBTOOL='$(SHELL) $(top_builddir)/libtool'
-AC_SUBST(LIBTOOL)dnl
-
-_LT_SETUP
-
-# Only expand once:
-m4_define([LT_INIT])
-])# LT_INIT
-
-# Old names:
-AU_ALIAS([AC_PROG_LIBTOOL], [LT_INIT])
-AU_ALIAS([AM_PROG_LIBTOOL], [LT_INIT])
-dnl aclocal-1.4 backwards compatibility:
-dnl AC_DEFUN([AC_PROG_LIBTOOL], [])
-dnl AC_DEFUN([AM_PROG_LIBTOOL], [])
-
-
-# _LT_CC_BASENAME(CC)
-# -------------------
-# Calculate cc_basename. Skip known compiler wrappers and cross-prefix.
-m4_defun([_LT_CC_BASENAME],
-[for cc_temp in $1""; do
- case $cc_temp in
- compile | *[[\\/]]compile | ccache | *[[\\/]]ccache ) ;;
- distcc | *[[\\/]]distcc | purify | *[[\\/]]purify ) ;;
- \-*) ;;
- *) break;;
- esac
-done
-cc_basename=`$ECHO "X$cc_temp" | $Xsed -e 's%.*/%%' -e "s%^$host_alias-%%"`
-])
-
-
-# _LT_FILEUTILS_DEFAULTS
-# ----------------------
-# It is okay to use these file commands and assume they have been set
-# sensibly after `m4_require([_LT_FILEUTILS_DEFAULTS])'.
-m4_defun([_LT_FILEUTILS_DEFAULTS],
-[: ${CP="cp -f"}
-: ${MV="mv -f"}
-: ${RM="rm -f"}
-])# _LT_FILEUTILS_DEFAULTS
-
-
-# _LT_SETUP
-# ---------
-m4_defun([_LT_SETUP],
-[AC_REQUIRE([AC_CANONICAL_HOST])dnl
-AC_REQUIRE([AC_CANONICAL_BUILD])dnl
-_LT_DECL([], [host_alias], [0], [The host system])dnl
-_LT_DECL([], [host], [0])dnl
-_LT_DECL([], [host_os], [0])dnl
-dnl
-_LT_DECL([], [build_alias], [0], [The build system])dnl
-_LT_DECL([], [build], [0])dnl
-_LT_DECL([], [build_os], [0])dnl
-dnl
-AC_REQUIRE([AC_PROG_CC])dnl
-AC_REQUIRE([LT_PATH_LD])dnl
-AC_REQUIRE([LT_PATH_NM])dnl
-dnl
-AC_REQUIRE([AC_PROG_LN_S])dnl
-test -z "$LN_S" && LN_S="ln -s"
-_LT_DECL([], [LN_S], [1], [Whether we need soft or hard links])dnl
-dnl
-AC_REQUIRE([LT_CMD_MAX_LEN])dnl
-_LT_DECL([objext], [ac_objext], [0], [Object file suffix (normally "o")])dnl
-_LT_DECL([], [exeext], [0], [Executable file suffix (normally "")])dnl
-dnl
-m4_require([_LT_FILEUTILS_DEFAULTS])dnl
-m4_require([_LT_CHECK_SHELL_FEATURES])dnl
-m4_require([_LT_CMD_RELOAD])dnl
-m4_require([_LT_CHECK_MAGIC_METHOD])dnl
-m4_require([_LT_CMD_OLD_ARCHIVE])dnl
-m4_require([_LT_CMD_GLOBAL_SYMBOLS])dnl
-
-_LT_CONFIG_LIBTOOL_INIT([
-# See if we are running on zsh, and set the options which allow our
-# commands through without removal of \ escapes INIT.
-if test -n "\${ZSH_VERSION+set}" ; then
- setopt NO_GLOB_SUBST
-fi
-])
-if test -n "${ZSH_VERSION+set}" ; then
- setopt NO_GLOB_SUBST
-fi
-
-_LT_CHECK_OBJDIR
-
-m4_require([_LT_TAG_COMPILER])dnl
-_LT_PROG_ECHO_BACKSLASH
-
-case $host_os in
-aix3*)
- # AIX sometimes has problems with the GCC collect2 program. For some
- # reason, if we set the COLLECT_NAMES environment variable, the problems
- # vanish in a puff of smoke.
- if test "X${COLLECT_NAMES+set}" != Xset; then
- COLLECT_NAMES=
- export COLLECT_NAMES
- fi
- ;;
-esac
-
-# Sed substitution that helps us do robust quoting. It backslashifies
-# metacharacters that are still active within double-quoted strings.
-sed_quote_subst='s/\([["`$\\]]\)/\\\1/g'
-
-# Same as above, but do not quote variable references.
-double_quote_subst='s/\([["`\\]]\)/\\\1/g'
-
-# Sed substitution to delay expansion of an escaped shell variable in a
-# double_quote_subst'ed string.
-delay_variable_subst='s/\\\\\\\\\\\$/\\\\\\$/g'
-
-# Sed substitution to delay expansion of an escaped single quote.
-delay_single_quote_subst='s/'\''/'\'\\\\\\\'\''/g'
-
-# Sed substitution to avoid accidental globbing in evaled expressions
-no_glob_subst='s/\*/\\\*/g'
-
-# Global variables:
-ofile=libtool
-can_build_shared=yes
-
-# All known linkers require a `.a' archive for static linking (except MSVC,
-# which needs '.lib').
-libext=a
-
-with_gnu_ld="$lt_cv_prog_gnu_ld"
-
-old_CC="$CC"
-old_CFLAGS="$CFLAGS"
-
-# Set sane defaults for various variables
-test -z "$CC" && CC=cc
-test -z "$LTCC" && LTCC=$CC
-test -z "$LTCFLAGS" && LTCFLAGS=$CFLAGS
-test -z "$LD" && LD=ld
-test -z "$ac_objext" && ac_objext=o
-
-_LT_CC_BASENAME([$compiler])
-
-# Only perform the check for file, if the check method requires it
-test -z "$MAGIC_CMD" && MAGIC_CMD=file
-case $deplibs_check_method in
-file_magic*)
- if test "$file_magic_cmd" = '$MAGIC_CMD'; then
- _LT_PATH_MAGIC
- fi
- ;;
-esac
-
-# Use C for the default configuration in the libtool script
-LT_SUPPORTED_TAG([CC])
-_LT_LANG_C_CONFIG
-_LT_LANG_DEFAULT_CONFIG
-_LT_CONFIG_COMMANDS
-])# _LT_SETUP
-
-
-# _LT_PROG_LTMAIN
-# ---------------
-# Note that this code is called both from `configure', and `config.status'
-# now that we use AC_CONFIG_COMMANDS to generate libtool. Notably,
-# `config.status' has no value for ac_aux_dir unless we are using Automake,
-# so we pass a copy along to make sure it has a sensible value anyway.
-m4_defun([_LT_PROG_LTMAIN],
-[m4_ifdef([AC_REQUIRE_AUX_FILE], [AC_REQUIRE_AUX_FILE([ltmain.sh])])dnl
-_LT_CONFIG_LIBTOOL_INIT([ac_aux_dir='$ac_aux_dir'])
-ltmain="$ac_aux_dir/ltmain.sh"
-])# _LT_PROG_LTMAIN
-
-
-## ------------------------------------- ##
-## Accumulate code for creating libtool. ##
-## ------------------------------------- ##
-
-# So that we can recreate a full libtool script including additional
-# tags, we accumulate the chunks of code to send to AC_CONFIG_COMMANDS
-# in macros and then make a single call at the end using the `libtool'
-# label.
-
-
-# _LT_CONFIG_LIBTOOL_INIT([INIT-COMMANDS])
-# ----------------------------------------
-# Register INIT-COMMANDS to be passed to AC_CONFIG_COMMANDS later.
-m4_define([_LT_CONFIG_LIBTOOL_INIT],
-[m4_ifval([$1],
- [m4_append([_LT_OUTPUT_LIBTOOL_INIT],
- [$1
-])])])
-
-# Initialize.
-m4_define([_LT_OUTPUT_LIBTOOL_INIT])
-
-
-# _LT_CONFIG_LIBTOOL([COMMANDS])
-# ------------------------------
-# Register COMMANDS to be passed to AC_CONFIG_COMMANDS later.
-m4_define([_LT_CONFIG_LIBTOOL],
-[m4_ifval([$1],
- [m4_append([_LT_OUTPUT_LIBTOOL_COMMANDS],
- [$1
-])])])
-
-# Initialize.
-m4_define([_LT_OUTPUT_LIBTOOL_COMMANDS])
-
-
-# _LT_CONFIG_SAVE_COMMANDS([COMMANDS], [INIT_COMMANDS])
-# -----------------------------------------------------
-m4_defun([_LT_CONFIG_SAVE_COMMANDS],
-[_LT_CONFIG_LIBTOOL([$1])
-_LT_CONFIG_LIBTOOL_INIT([$2])
-])
-
-
-# _LT_FORMAT_COMMENT([COMMENT])
-# -----------------------------
-# Add leading comment marks to the start of each line, and a trailing
-# full-stop to the whole comment if one is not present already.
-m4_define([_LT_FORMAT_COMMENT],
-[m4_ifval([$1], [
-m4_bpatsubst([m4_bpatsubst([$1], [^ *], [# ])],
- [['`$\]], [\\\&])]m4_bmatch([$1], [[!?.]$], [], [.])
-)])
-
-
-
-## ------------------------ ##
-## FIXME: Eliminate VARNAME ##
-## ------------------------ ##
-
-
-# _LT_DECL([CONFIGNAME], VARNAME, VALUE, [DESCRIPTION], [IS-TAGGED?])
-# -------------------------------------------------------------------
-# CONFIGNAME is the name given to the value in the libtool script.
-# VARNAME is the (base) name used in the configure script.
-# VALUE may be 0, 1 or 2 for a computed quote escaped value based on
-# VARNAME. Any other value will be used directly.
-m4_define([_LT_DECL],
-[lt_if_append_uniq([lt_decl_varnames], [$2], [, ],
- [lt_dict_add_subkey([lt_decl_dict], [$2], [libtool_name],
- [m4_ifval([$1], [$1], [$2])])
- lt_dict_add_subkey([lt_decl_dict], [$2], [value], [$3])
- m4_ifval([$4],
- [lt_dict_add_subkey([lt_decl_dict], [$2], [description], [$4])])
- lt_dict_add_subkey([lt_decl_dict], [$2],
- [tagged?], [m4_ifval([$5], [yes], [no])])])
-])
-
-
-# _LT_TAGDECL([CONFIGNAME], VARNAME, VALUE, [DESCRIPTION])
-# --------------------------------------------------------
-m4_define([_LT_TAGDECL], [_LT_DECL([$1], [$2], [$3], [$4], [yes])])
-
-
-# lt_decl_tag_varnames([SEPARATOR], [VARNAME1...])
-# ------------------------------------------------
-m4_define([lt_decl_tag_varnames],
-[_lt_decl_filter([tagged?], [yes], $@)])
-
-
-# _lt_decl_filter(SUBKEY, VALUE, [SEPARATOR], [VARNAME1..])
-# ---------------------------------------------------------
-m4_define([_lt_decl_filter],
-[m4_case([$#],
- [0], [m4_fatal([$0: too few arguments: $#])],
- [1], [m4_fatal([$0: too few arguments: $#: $1])],
- [2], [lt_dict_filter([lt_decl_dict], [$1], [$2], [], lt_decl_varnames)],
- [3], [lt_dict_filter([lt_decl_dict], [$1], [$2], [$3], lt_decl_varnames)],
- [lt_dict_filter([lt_decl_dict], $@)])[]dnl
-])
-
-
-# lt_decl_quote_varnames([SEPARATOR], [VARNAME1...])
-# --------------------------------------------------
-m4_define([lt_decl_quote_varnames],
-[_lt_decl_filter([value], [1], $@)])
-
-
-# lt_decl_dquote_varnames([SEPARATOR], [VARNAME1...])
-# ---------------------------------------------------
-m4_define([lt_decl_dquote_varnames],
-[_lt_decl_filter([value], [2], $@)])
-
-
-# lt_decl_varnames_tagged([SEPARATOR], [VARNAME1...])
-# ---------------------------------------------------
-m4_define([lt_decl_varnames_tagged],
-[m4_assert([$# <= 2])dnl
-_$0(m4_quote(m4_default([$1], [[, ]])),
- m4_ifval([$2], [[$2]], [m4_dquote(lt_decl_tag_varnames)]),
- m4_split(m4_normalize(m4_quote(_LT_TAGS)), [ ]))])
-m4_define([_lt_decl_varnames_tagged],
-[m4_ifval([$3], [lt_combine([$1], [$2], [_], $3)])])
-
-
-# lt_decl_all_varnames([SEPARATOR], [VARNAME1...])
-# ------------------------------------------------
-m4_define([lt_decl_all_varnames],
-[_$0(m4_quote(m4_default([$1], [[, ]])),
- m4_if([$2], [],
- m4_quote(lt_decl_varnames),
- m4_quote(m4_shift($@))))[]dnl
-])
-m4_define([_lt_decl_all_varnames],
-[lt_join($@, lt_decl_varnames_tagged([$1],
- lt_decl_tag_varnames([[, ]], m4_shift($@))))dnl
-])
-
-
-# _LT_CONFIG_STATUS_DECLARE([VARNAME])
-# ------------------------------------
-# Quote a variable value, and forward it to `config.status' so that its
-# declaration there will have the same value as in `configure'. VARNAME
-# must have a single quote delimited value for this to work.
-m4_define([_LT_CONFIG_STATUS_DECLARE],
-[$1='`$ECHO "X$][$1" | $Xsed -e "$delay_single_quote_subst"`'])
-
-
-# _LT_CONFIG_STATUS_DECLARATIONS
-# ------------------------------
-# We delimit libtool config variables with single quotes, so when
-# we write them to config.status, we have to be sure to quote all
-# embedded single quotes properly. In configure, this macro expands
-# each variable declared with _LT_DECL (and _LT_TAGDECL) into:
-#
-# <var>='`$ECHO "X$<var>" | $Xsed -e "$delay_single_quote_subst"`'
-m4_defun([_LT_CONFIG_STATUS_DECLARATIONS],
-[m4_foreach([_lt_var], m4_quote(lt_decl_all_varnames),
- [m4_n([_LT_CONFIG_STATUS_DECLARE(_lt_var)])])])
-
-
-# _LT_LIBTOOL_TAGS
-# ----------------
-# Output comment and list of tags supported by the script
-m4_defun([_LT_LIBTOOL_TAGS],
-[_LT_FORMAT_COMMENT([The names of the tagged configurations supported by this script])dnl
-available_tags="_LT_TAGS"dnl
-])
-
-
-# _LT_LIBTOOL_DECLARE(VARNAME, [TAG])
-# -----------------------------------
-# Extract the dictionary values for VARNAME (optionally with TAG) and
-# expand to a commented shell variable setting:
-#
-# # Some comment about what VAR is for.
-# visible_name=$lt_internal_name
-m4_define([_LT_LIBTOOL_DECLARE],
-[_LT_FORMAT_COMMENT(m4_quote(lt_dict_fetch([lt_decl_dict], [$1],
- [description])))[]dnl
-m4_pushdef([_libtool_name],
- m4_quote(lt_dict_fetch([lt_decl_dict], [$1], [libtool_name])))[]dnl
-m4_case(m4_quote(lt_dict_fetch([lt_decl_dict], [$1], [value])),
- [0], [_libtool_name=[$]$1],
- [1], [_libtool_name=$lt_[]$1],
- [2], [_libtool_name=$lt_[]$1],
- [_libtool_name=lt_dict_fetch([lt_decl_dict], [$1], [value])])[]dnl
-m4_ifval([$2], [_$2])[]m4_popdef([_libtool_name])[]dnl
-])
-
-
-# _LT_LIBTOOL_CONFIG_VARS
-# -----------------------
-# Produce commented declarations of non-tagged libtool config variables
-# suitable for insertion in the LIBTOOL CONFIG section of the `libtool'
-# script. Tagged libtool config variables (even for the LIBTOOL CONFIG
-# section) are produced by _LT_LIBTOOL_TAG_VARS.
-m4_defun([_LT_LIBTOOL_CONFIG_VARS],
-[m4_foreach([_lt_var],
- m4_quote(_lt_decl_filter([tagged?], [no], [], lt_decl_varnames)),
- [m4_n([_LT_LIBTOOL_DECLARE(_lt_var)])])])
-
-
-# _LT_LIBTOOL_TAG_VARS(TAG)
-# -------------------------
-m4_define([_LT_LIBTOOL_TAG_VARS],
-[m4_foreach([_lt_var], m4_quote(lt_decl_tag_varnames),
- [m4_n([_LT_LIBTOOL_DECLARE(_lt_var, [$1])])])])
-
-
-# _LT_TAGVAR(VARNAME, [TAGNAME])
-# ------------------------------
-m4_define([_LT_TAGVAR], [m4_ifval([$2], [$1_$2], [$1])])
-
-
-# _LT_CONFIG_COMMANDS
-# -------------------
-# Send accumulated output to $CONFIG_STATUS. Thanks to the lists of
-# variables for single and double quote escaping we saved from calls
-# to _LT_DECL, we can put quote escaped variables declarations
-# into `config.status', and then the shell code to quote escape them in
-# for loops in `config.status'. Finally, any additional code accumulated
-# from calls to _LT_CONFIG_LIBTOOL_INIT is expanded.
-m4_defun([_LT_CONFIG_COMMANDS],
-[AC_PROVIDE_IFELSE([LT_OUTPUT],
- dnl If the libtool generation code has been placed in $CONFIG_LT,
- dnl instead of duplicating it all over again into config.status,
- dnl then we will have config.status run $CONFIG_LT later, so it
- dnl needs to know what name is stored there:
- [AC_CONFIG_COMMANDS([libtool],
- [$SHELL $CONFIG_LT || AS_EXIT(1)], [CONFIG_LT='$CONFIG_LT'])],
- dnl If the libtool generation code is destined for config.status,
- dnl expand the accumulated commands and init code now:
- [AC_CONFIG_COMMANDS([libtool],
- [_LT_OUTPUT_LIBTOOL_COMMANDS], [_LT_OUTPUT_LIBTOOL_COMMANDS_INIT])])
-])#_LT_CONFIG_COMMANDS
-
-
-# Initialize.
-m4_define([_LT_OUTPUT_LIBTOOL_COMMANDS_INIT],
-[
-
-# The HP-UX ksh and POSIX shell print the target directory to stdout
-# if CDPATH is set.
-(unset CDPATH) >/dev/null 2>&1 && unset CDPATH
-
-sed_quote_subst='$sed_quote_subst'
-double_quote_subst='$double_quote_subst'
-delay_variable_subst='$delay_variable_subst'
-_LT_CONFIG_STATUS_DECLARATIONS
-LTCC='$LTCC'
-LTCFLAGS='$LTCFLAGS'
-compiler='$compiler_DEFAULT'
-
-# Quote evaled strings.
-for var in lt_decl_all_varnames([[ \
-]], lt_decl_quote_varnames); do
- case \`eval \\\\\$ECHO "X\\\\\$\$var"\` in
- *[[\\\\\\\`\\"\\\$]]*)
- eval "lt_\$var=\\\\\\"\\\`\\\$ECHO \\"X\\\$\$var\\" | \\\$Xsed -e \\"\\\$sed_quote_subst\\"\\\`\\\\\\""
- ;;
- *)
- eval "lt_\$var=\\\\\\"\\\$\$var\\\\\\""
- ;;
- esac
-done
-
-# Double-quote double-evaled strings.
-for var in lt_decl_all_varnames([[ \
-]], lt_decl_dquote_varnames); do
- case \`eval \\\\\$ECHO "X\\\\\$\$var"\` in
- *[[\\\\\\\`\\"\\\$]]*)
- eval "lt_\$var=\\\\\\"\\\`\\\$ECHO \\"X\\\$\$var\\" | \\\$Xsed -e \\"\\\$double_quote_subst\\" -e \\"\\\$sed_quote_subst\\" -e \\"\\\$delay_variable_subst\\"\\\`\\\\\\""
- ;;
- *)
- eval "lt_\$var=\\\\\\"\\\$\$var\\\\\\""
- ;;
- esac
-done
-
-# Fix-up fallback echo if it was mangled by the above quoting rules.
-case \$lt_ECHO in
-*'\\\[$]0 --fallback-echo"')dnl "
- lt_ECHO=\`\$ECHO "X\$lt_ECHO" | \$Xsed -e 's/\\\\\\\\\\\\\\\[$]0 --fallback-echo"\[$]/\[$]0 --fallback-echo"/'\`
- ;;
-esac
-
-_LT_OUTPUT_LIBTOOL_INIT
-])
-
-
-# LT_OUTPUT
-# ---------
-# This macro allows early generation of the libtool script (before
-# AC_OUTPUT is called), incase it is used in configure for compilation
-# tests.
-AC_DEFUN([LT_OUTPUT],
-[: ${CONFIG_LT=./config.lt}
-AC_MSG_NOTICE([creating $CONFIG_LT])
-cat >"$CONFIG_LT" <<_LTEOF
-#! $SHELL
-# Generated by $as_me.
-# Run this file to recreate a libtool stub with the current configuration.
-
-lt_cl_silent=false
-SHELL=\${CONFIG_SHELL-$SHELL}
-_LTEOF
-
-cat >>"$CONFIG_LT" <<\_LTEOF
-AS_SHELL_SANITIZE
-_AS_PREPARE
-
-exec AS_MESSAGE_FD>&1
-exec AS_MESSAGE_LOG_FD>>config.log
-{
- echo
- AS_BOX([Running $as_me.])
-} >&AS_MESSAGE_LOG_FD
-
-lt_cl_help="\
-\`$as_me' creates a local libtool stub from the current configuration,
-for use in further configure time tests before the real libtool is
-generated.
-
-Usage: $[0] [[OPTIONS]]
-
- -h, --help print this help, then exit
- -V, --version print version number, then exit
- -q, --quiet do not print progress messages
- -d, --debug don't remove temporary files
-
-Report bugs to <bug-libtool@gnu.org>."
-
-lt_cl_version="\
-m4_ifset([AC_PACKAGE_NAME], [AC_PACKAGE_NAME ])config.lt[]dnl
-m4_ifset([AC_PACKAGE_VERSION], [ AC_PACKAGE_VERSION])
-configured by $[0], generated by m4_PACKAGE_STRING.
-
-Copyright (C) 2008 Free Software Foundation, Inc.
-This config.lt script is free software; the Free Software Foundation
-gives unlimited permision to copy, distribute and modify it."
-
-while test $[#] != 0
-do
- case $[1] in
- --version | --v* | -V )
- echo "$lt_cl_version"; exit 0 ;;
- --help | --h* | -h )
- echo "$lt_cl_help"; exit 0 ;;
- --debug | --d* | -d )
- debug=: ;;
- --quiet | --q* | --silent | --s* | -q )
- lt_cl_silent=: ;;
-
- -*) AC_MSG_ERROR([unrecognized option: $[1]
-Try \`$[0] --help' for more information.]) ;;
-
- *) AC_MSG_ERROR([unrecognized argument: $[1]
-Try \`$[0] --help' for more information.]) ;;
- esac
- shift
-done
-
-if $lt_cl_silent; then
- exec AS_MESSAGE_FD>/dev/null
-fi
-_LTEOF
-
-cat >>"$CONFIG_LT" <<_LTEOF
-_LT_OUTPUT_LIBTOOL_COMMANDS_INIT
-_LTEOF
-
-cat >>"$CONFIG_LT" <<\_LTEOF
-AC_MSG_NOTICE([creating $ofile])
-_LT_OUTPUT_LIBTOOL_COMMANDS
-AS_EXIT(0)
-_LTEOF
-chmod +x "$CONFIG_LT"
-
-# configure is writing to config.log, but config.lt does its own redirection,
-# appending to config.log, which fails on DOS, as config.log is still kept
-# open by configure. Here we exec the FD to /dev/null, effectively closing
-# config.log, so it can be properly (re)opened and appended to by config.lt.
-if test "$no_create" != yes; then
- lt_cl_success=:
- test "$silent" = yes &&
- lt_config_lt_args="$lt_config_lt_args --quiet"
- exec AS_MESSAGE_LOG_FD>/dev/null
- $SHELL "$CONFIG_LT" $lt_config_lt_args || lt_cl_success=false
- exec AS_MESSAGE_LOG_FD>>config.log
- $lt_cl_success || AS_EXIT(1)
-fi
-])# LT_OUTPUT
-
-
-# _LT_CONFIG(TAG)
-# ---------------
-# If TAG is the built-in tag, create an initial libtool script with a
-# default configuration from the untagged config vars. Otherwise add code
-# to config.status for appending the configuration named by TAG from the
-# matching tagged config vars.
-m4_defun([_LT_CONFIG],
-[m4_require([_LT_FILEUTILS_DEFAULTS])dnl
-_LT_CONFIG_SAVE_COMMANDS([
- m4_define([_LT_TAG], m4_if([$1], [], [C], [$1]))dnl
- m4_if(_LT_TAG, [C], [
- # See if we are running on zsh, and set the options which allow our
- # commands through without removal of \ escapes.
- if test -n "${ZSH_VERSION+set}" ; then
- setopt NO_GLOB_SUBST
- fi
-
- cfgfile="${ofile}T"
- trap "$RM \"$cfgfile\"; exit 1" 1 2 15
- $RM "$cfgfile"
-
- cat <<_LT_EOF >> "$cfgfile"
-#! $SHELL
-
-# `$ECHO "$ofile" | sed 's%^.*/%%'` - Provide generalized library-building support services.
-# Generated automatically by $as_me ($PACKAGE$TIMESTAMP) $VERSION
-# Libtool was configured on host `(hostname || uname -n) 2>/dev/null | sed 1q`:
-# NOTE: Changes made to this file will be lost: look at ltmain.sh.
-#
-_LT_COPYING
-_LT_LIBTOOL_TAGS
-
-# ### BEGIN LIBTOOL CONFIG
-_LT_LIBTOOL_CONFIG_VARS
-_LT_LIBTOOL_TAG_VARS
-# ### END LIBTOOL CONFIG
-
-_LT_EOF
-
- case $host_os in
- aix3*)
- cat <<\_LT_EOF >> "$cfgfile"
-# AIX sometimes has problems with the GCC collect2 program. For some
-# reason, if we set the COLLECT_NAMES environment variable, the problems
-# vanish in a puff of smoke.
-if test "X${COLLECT_NAMES+set}" != Xset; then
- COLLECT_NAMES=
- export COLLECT_NAMES
-fi
-_LT_EOF
- ;;
- esac
-
- _LT_PROG_LTMAIN
-
- # We use sed instead of cat because bash on DJGPP gets confused if
- # if finds mixed CR/LF and LF-only lines. Since sed operates in
- # text mode, it properly converts lines to CR/LF. This bash problem
- # is reportedly fixed, but why not run on old versions too?
- sed '/^# Generated shell functions inserted here/q' "$ltmain" >> "$cfgfile" \
- || (rm -f "$cfgfile"; exit 1)
-
- _LT_PROG_XSI_SHELLFNS
-
- sed -n '/^# Generated shell functions inserted here/,$p' "$ltmain" >> "$cfgfile" \
- || (rm -f "$cfgfile"; exit 1)
-
- mv -f "$cfgfile" "$ofile" ||
- (rm -f "$ofile" && cp "$cfgfile" "$ofile" && rm -f "$cfgfile")
- chmod +x "$ofile"
-],
-[cat <<_LT_EOF >> "$ofile"
-
-dnl Unfortunately we have to use $1 here, since _LT_TAG is not expanded
-dnl in a comment (ie after a #).
-# ### BEGIN LIBTOOL TAG CONFIG: $1
-_LT_LIBTOOL_TAG_VARS(_LT_TAG)
-# ### END LIBTOOL TAG CONFIG: $1
-_LT_EOF
-])dnl /m4_if
-],
-[m4_if([$1], [], [
- PACKAGE='$PACKAGE'
- VERSION='$VERSION'
- TIMESTAMP='$TIMESTAMP'
- RM='$RM'
- ofile='$ofile'], [])
-])dnl /_LT_CONFIG_SAVE_COMMANDS
-])# _LT_CONFIG
-
-
-# LT_SUPPORTED_TAG(TAG)
-# ---------------------
-# Trace this macro to discover what tags are supported by the libtool
-# --tag option, using:
-# autoconf --trace 'LT_SUPPORTED_TAG:$1'
-AC_DEFUN([LT_SUPPORTED_TAG], [])
-
-
-# C support is built-in for now
-m4_define([_LT_LANG_C_enabled], [])
-m4_define([_LT_TAGS], [])
-
-
-# LT_LANG(LANG)
-# -------------
-# Enable libtool support for the given language if not already enabled.
-AC_DEFUN([LT_LANG],
-[AC_BEFORE([$0], [LT_OUTPUT])dnl
-m4_case([$1],
- [C], [_LT_LANG(C)],
- [C++], [_LT_LANG(CXX)],
- [Java], [_LT_LANG(GCJ)],
- [Fortran 77], [_LT_LANG(F77)],
- [Fortran], [_LT_LANG(FC)],
- [Windows Resource], [_LT_LANG(RC)],
- [m4_ifdef([_LT_LANG_]$1[_CONFIG],
- [_LT_LANG($1)],
- [m4_fatal([$0: unsupported language: "$1"])])])dnl
-])# LT_LANG
-
-
-# _LT_LANG(LANGNAME)
-# ------------------
-m4_defun([_LT_LANG],
-[m4_ifdef([_LT_LANG_]$1[_enabled], [],
- [LT_SUPPORTED_TAG([$1])dnl
- m4_append([_LT_TAGS], [$1 ])dnl
- m4_define([_LT_LANG_]$1[_enabled], [])dnl
- _LT_LANG_$1_CONFIG($1)])dnl
-])# _LT_LANG
-
-
-# _LT_LANG_DEFAULT_CONFIG
-# -----------------------
-m4_defun([_LT_LANG_DEFAULT_CONFIG],
-[AC_PROVIDE_IFELSE([AC_PROG_CXX],
- [LT_LANG(CXX)],
- [m4_define([AC_PROG_CXX], defn([AC_PROG_CXX])[LT_LANG(CXX)])])
-
-AC_PROVIDE_IFELSE([AC_PROG_F77],
- [LT_LANG(F77)],
- [m4_define([AC_PROG_F77], defn([AC_PROG_F77])[LT_LANG(F77)])])
-
-AC_PROVIDE_IFELSE([AC_PROG_FC],
- [LT_LANG(FC)],
- [m4_define([AC_PROG_FC], defn([AC_PROG_FC])[LT_LANG(FC)])])
-
-dnl The call to [A][M_PROG_GCJ] is quoted like that to stop aclocal
-dnl pulling things in needlessly.
-AC_PROVIDE_IFELSE([AC_PROG_GCJ],
- [LT_LANG(GCJ)],
- [AC_PROVIDE_IFELSE([A][M_PROG_GCJ],
- [LT_LANG(GCJ)],
- [AC_PROVIDE_IFELSE([LT_PROG_GCJ],
- [LT_LANG(GCJ)],
- [m4_ifdef([AC_PROG_GCJ],
- [m4_define([AC_PROG_GCJ], defn([AC_PROG_GCJ])[LT_LANG(GCJ)])])
- m4_ifdef([A][M_PROG_GCJ],
- [m4_define([A][M_PROG_GCJ], defn([A][M_PROG_GCJ])[LT_LANG(GCJ)])])
- m4_ifdef([LT_PROG_GCJ],
- [m4_define([LT_PROG_GCJ], defn([LT_PROG_GCJ])[LT_LANG(GCJ)])])])])])
-
-AC_PROVIDE_IFELSE([LT_PROG_RC],
- [LT_LANG(RC)],
- [m4_define([LT_PROG_RC], defn([LT_PROG_RC])[LT_LANG(RC)])])
-])# _LT_LANG_DEFAULT_CONFIG
-
-# Obsolete macros:
-AU_DEFUN([AC_LIBTOOL_CXX], [LT_LANG(C++)])
-AU_DEFUN([AC_LIBTOOL_F77], [LT_LANG(Fortran 77)])
-AU_DEFUN([AC_LIBTOOL_FC], [LT_LANG(Fortran)])
-AU_DEFUN([AC_LIBTOOL_GCJ], [LT_LANG(Java)])
-dnl aclocal-1.4 backwards compatibility:
-dnl AC_DEFUN([AC_LIBTOOL_CXX], [])
-dnl AC_DEFUN([AC_LIBTOOL_F77], [])
-dnl AC_DEFUN([AC_LIBTOOL_FC], [])
-dnl AC_DEFUN([AC_LIBTOOL_GCJ], [])
-
-
-# _LT_TAG_COMPILER
-# ----------------
-m4_defun([_LT_TAG_COMPILER],
-[AC_REQUIRE([AC_PROG_CC])dnl
-
-_LT_DECL([LTCC], [CC], [1], [A C compiler])dnl
-_LT_DECL([LTCFLAGS], [CFLAGS], [1], [LTCC compiler flags])dnl
-_LT_TAGDECL([CC], [compiler], [1], [A language specific compiler])dnl
-_LT_TAGDECL([with_gcc], [GCC], [0], [Is the compiler the GNU compiler?])dnl
-
-# If no C compiler was specified, use CC.
-LTCC=${LTCC-"$CC"}
-
-# If no C compiler flags were specified, use CFLAGS.
-LTCFLAGS=${LTCFLAGS-"$CFLAGS"}
-
-# Allow CC to be a program name with arguments.
-compiler=$CC
-])# _LT_TAG_COMPILER
-
-
-# _LT_COMPILER_BOILERPLATE
-# ------------------------
-# Check for compiler boilerplate output or warnings with
-# the simple compiler test code.
-m4_defun([_LT_COMPILER_BOILERPLATE],
-[m4_require([_LT_DECL_SED])dnl
-ac_outfile=conftest.$ac_objext
-echo "$lt_simple_compile_test_code" >conftest.$ac_ext
-eval "$ac_compile" 2>&1 >/dev/null | $SED '/^$/d; /^ *+/d' >conftest.err
-_lt_compiler_boilerplate=`cat conftest.err`
-$RM conftest*
-])# _LT_COMPILER_BOILERPLATE
-
-
-# _LT_LINKER_BOILERPLATE
-# ----------------------
-# Check for linker boilerplate output or warnings with
-# the simple link test code.
-m4_defun([_LT_LINKER_BOILERPLATE],
-[m4_require([_LT_DECL_SED])dnl
-ac_outfile=conftest.$ac_objext
-echo "$lt_simple_link_test_code" >conftest.$ac_ext
-eval "$ac_link" 2>&1 >/dev/null | $SED '/^$/d; /^ *+/d' >conftest.err
-_lt_linker_boilerplate=`cat conftest.err`
-$RM -r conftest*
-])# _LT_LINKER_BOILERPLATE
-
-# _LT_REQUIRED_DARWIN_CHECKS
-# -------------------------
-m4_defun_once([_LT_REQUIRED_DARWIN_CHECKS],[
- case $host_os in
- rhapsody* | darwin*)
- AC_CHECK_TOOL([DSYMUTIL], [dsymutil], [:])
- AC_CHECK_TOOL([NMEDIT], [nmedit], [:])
- AC_CHECK_TOOL([LIPO], [lipo], [:])
- AC_CHECK_TOOL([OTOOL], [otool], [:])
- AC_CHECK_TOOL([OTOOL64], [otool64], [:])
- _LT_DECL([], [DSYMUTIL], [1],
- [Tool to manipulate archived DWARF debug symbol files on Mac OS X])
- _LT_DECL([], [NMEDIT], [1],
- [Tool to change global to local symbols on Mac OS X])
- _LT_DECL([], [LIPO], [1],
- [Tool to manipulate fat objects and archives on Mac OS X])
- _LT_DECL([], [OTOOL], [1],
- [ldd/readelf like tool for Mach-O binaries on Mac OS X])
- _LT_DECL([], [OTOOL64], [1],
- [ldd/readelf like tool for 64 bit Mach-O binaries on Mac OS X 10.4])
-
- AC_CACHE_CHECK([for -single_module linker flag],[lt_cv_apple_cc_single_mod],
- [lt_cv_apple_cc_single_mod=no
- if test -z "${LT_MULTI_MODULE}"; then
- # By default we will add the -single_module flag. You can override
- # by either setting the environment variable LT_MULTI_MODULE
- # non-empty at configure time, or by adding -multi_module to the
- # link flags.
- rm -rf libconftest.dylib*
- echo "int foo(void){return 1;}" > conftest.c
- echo "$LTCC $LTCFLAGS $LDFLAGS -o libconftest.dylib \
--dynamiclib -Wl,-single_module conftest.c" >&AS_MESSAGE_LOG_FD
- $LTCC $LTCFLAGS $LDFLAGS -o libconftest.dylib \
- -dynamiclib -Wl,-single_module conftest.c 2>conftest.err
- _lt_result=$?
- if test -f libconftest.dylib && test ! -s conftest.err && test $_lt_result = 0; then
- lt_cv_apple_cc_single_mod=yes
- else
- cat conftest.err >&AS_MESSAGE_LOG_FD
- fi
- rm -rf libconftest.dylib*
- rm -f conftest.*
- fi])
- AC_CACHE_CHECK([for -exported_symbols_list linker flag],
- [lt_cv_ld_exported_symbols_list],
- [lt_cv_ld_exported_symbols_list=no
- save_LDFLAGS=$LDFLAGS
- echo "_main" > conftest.sym
- LDFLAGS="$LDFLAGS -Wl,-exported_symbols_list,conftest.sym"
- AC_LINK_IFELSE([AC_LANG_PROGRAM([],[])],
- [lt_cv_ld_exported_symbols_list=yes],
- [lt_cv_ld_exported_symbols_list=no])
- LDFLAGS="$save_LDFLAGS"
- ])
- case $host_os in
- rhapsody* | darwin1.[[012]])
- _lt_dar_allow_undefined='${wl}-undefined ${wl}suppress' ;;
- darwin1.*)
- _lt_dar_allow_undefined='${wl}-flat_namespace ${wl}-undefined ${wl}suppress' ;;
- darwin*) # darwin 5.x on
- # if running on 10.5 or later, the deployment target defaults
- # to the OS version, if on x86, and 10.4, the deployment
- # target defaults to 10.4. Don't you love it?
- case ${MACOSX_DEPLOYMENT_TARGET-10.0},$host in
- 10.0,*86*-darwin8*|10.0,*-darwin[[91]]*)
- _lt_dar_allow_undefined='${wl}-undefined ${wl}dynamic_lookup' ;;
- 10.[[012]]*)
- _lt_dar_allow_undefined='${wl}-flat_namespace ${wl}-undefined ${wl}suppress' ;;
- 10.*)
- _lt_dar_allow_undefined='${wl}-undefined ${wl}dynamic_lookup' ;;
- esac
- ;;
- esac
- if test "$lt_cv_apple_cc_single_mod" = "yes"; then
- _lt_dar_single_mod='$single_module'
- fi
- if test "$lt_cv_ld_exported_symbols_list" = "yes"; then
- _lt_dar_export_syms=' ${wl}-exported_symbols_list,$output_objdir/${libname}-symbols.expsym'
- else
- _lt_dar_export_syms='~$NMEDIT -s $output_objdir/${libname}-symbols.expsym ${lib}'
- fi
- if test "$DSYMUTIL" != ":"; then
- _lt_dsymutil='~$DSYMUTIL $lib || :'
- else
- _lt_dsymutil=
- fi
- ;;
- esac
-])
-
-
-# _LT_DARWIN_LINKER_FEATURES
-# --------------------------
-# Checks for linker and compiler features on darwin
-m4_defun([_LT_DARWIN_LINKER_FEATURES],
-[
- m4_require([_LT_REQUIRED_DARWIN_CHECKS])
- _LT_TAGVAR(archive_cmds_need_lc, $1)=no
- _LT_TAGVAR(hardcode_direct, $1)=no
- _LT_TAGVAR(hardcode_automatic, $1)=yes
- _LT_TAGVAR(hardcode_shlibpath_var, $1)=unsupported
- _LT_TAGVAR(whole_archive_flag_spec, $1)=''
- _LT_TAGVAR(link_all_deplibs, $1)=yes
- _LT_TAGVAR(allow_undefined_flag, $1)="$_lt_dar_allow_undefined"
- case $cc_basename in
- ifort*) _lt_dar_can_shared=yes ;;
- *) _lt_dar_can_shared=$GCC ;;
- esac
- if test "$_lt_dar_can_shared" = "yes"; then
- output_verbose_link_cmd=echo
- _LT_TAGVAR(archive_cmds, $1)="\$CC -dynamiclib \$allow_undefined_flag -o \$lib \$libobjs \$deplibs \$compiler_flags -install_name \$rpath/\$soname \$verstring $_lt_dar_single_mod${_lt_dsymutil}"
- _LT_TAGVAR(module_cmds, $1)="\$CC \$allow_undefined_flag -o \$lib -bundle \$libobjs \$deplibs \$compiler_flags${_lt_dsymutil}"
- _LT_TAGVAR(archive_expsym_cmds, $1)="sed 's,^,_,' < \$export_symbols > \$output_objdir/\${libname}-symbols.expsym~\$CC -dynamiclib \$allow_undefined_flag -o \$lib \$libobjs \$deplibs \$compiler_flags -install_name \$rpath/\$soname \$verstring ${_lt_dar_single_mod}${_lt_dar_export_syms}${_lt_dsymutil}"
- _LT_TAGVAR(module_expsym_cmds, $1)="sed -e 's,^,_,' < \$export_symbols > \$output_objdir/\${libname}-symbols.expsym~\$CC \$allow_undefined_flag -o \$lib -bundle \$libobjs \$deplibs \$compiler_flags${_lt_dar_export_syms}${_lt_dsymutil}"
- m4_if([$1], [CXX],
-[ if test "$lt_cv_apple_cc_single_mod" != "yes"; then
- _LT_TAGVAR(archive_cmds, $1)="\$CC -r -keep_private_externs -nostdlib -o \${lib}-master.o \$libobjs~\$CC -dynamiclib \$allow_undefined_flag -o \$lib \${lib}-master.o \$deplibs \$compiler_flags -install_name \$rpath/\$soname \$verstring${_lt_dsymutil}"
- _LT_TAGVAR(archive_expsym_cmds, $1)="sed 's,^,_,' < \$export_symbols > \$output_objdir/\${libname}-symbols.expsym~\$CC -r -keep_private_externs -nostdlib -o \${lib}-master.o \$libobjs~\$CC -dynamiclib \$allow_undefined_flag -o \$lib \${lib}-master.o \$deplibs \$compiler_flags -install_name \$rpath/\$soname \$verstring${_lt_dar_export_syms}${_lt_dsymutil}"
- fi
-],[])
- else
- _LT_TAGVAR(ld_shlibs, $1)=no
- fi
-])
-
-# _LT_SYS_MODULE_PATH_AIX
-# -----------------------
-# Links a minimal program and checks the executable
-# for the system default hardcoded library path. In most cases,
-# this is /usr/lib:/lib, but when the MPI compilers are used
-# the location of the communication and MPI libs are included too.
-# If we don't find anything, use the default library path according
-# to the aix ld manual.
-m4_defun([_LT_SYS_MODULE_PATH_AIX],
-[m4_require([_LT_DECL_SED])dnl
-AC_LINK_IFELSE(AC_LANG_PROGRAM,[
-lt_aix_libpath_sed='
- /Import File Strings/,/^$/ {
- /^0/ {
- s/^0 *\(.*\)$/\1/
- p
- }
- }'
-aix_libpath=`dump -H conftest$ac_exeext 2>/dev/null | $SED -n -e "$lt_aix_libpath_sed"`
-# Check for a 64-bit object if we didn't find anything.
-if test -z "$aix_libpath"; then
- aix_libpath=`dump -HX64 conftest$ac_exeext 2>/dev/null | $SED -n -e "$lt_aix_libpath_sed"`
-fi],[])
-if test -z "$aix_libpath"; then aix_libpath="/usr/lib:/lib"; fi
-])# _LT_SYS_MODULE_PATH_AIX
-
-
-# _LT_SHELL_INIT(ARG)
-# -------------------
-m4_define([_LT_SHELL_INIT],
-[ifdef([AC_DIVERSION_NOTICE],
- [AC_DIVERT_PUSH(AC_DIVERSION_NOTICE)],
- [AC_DIVERT_PUSH(NOTICE)])
-$1
-AC_DIVERT_POP
-])# _LT_SHELL_INIT
-
-
-# _LT_PROG_ECHO_BACKSLASH
-# -----------------------
-# Add some code to the start of the generated configure script which
-# will find an echo command which doesn't interpret backslashes.
-m4_defun([_LT_PROG_ECHO_BACKSLASH],
-[_LT_SHELL_INIT([
-# Check that we are running under the correct shell.
-SHELL=${CONFIG_SHELL-/bin/sh}
-
-case X$lt_ECHO in
-X*--fallback-echo)
- # Remove one level of quotation (which was required for Make).
- ECHO=`echo "$lt_ECHO" | sed 's,\\\\\[$]\\[$]0,'[$]0','`
- ;;
-esac
-
-ECHO=${lt_ECHO-echo}
-if test "X[$]1" = X--no-reexec; then
- # Discard the --no-reexec flag, and continue.
- shift
-elif test "X[$]1" = X--fallback-echo; then
- # Avoid inline document here, it may be left over
- :
-elif test "X`{ $ECHO '\t'; } 2>/dev/null`" = 'X\t' ; then
- # Yippee, $ECHO works!
- :
-else
- # Restart under the correct shell.
- exec $SHELL "[$]0" --no-reexec ${1+"[$]@"}
-fi
-
-if test "X[$]1" = X--fallback-echo; then
- # used as fallback echo
- shift
- cat <<_LT_EOF
-[$]*
-_LT_EOF
- exit 0
-fi
-
-# The HP-UX ksh and POSIX shell print the target directory to stdout
-# if CDPATH is set.
-(unset CDPATH) >/dev/null 2>&1 && unset CDPATH
-
-if test -z "$lt_ECHO"; then
- if test "X${echo_test_string+set}" != Xset; then
- # find a string as large as possible, as long as the shell can cope with it
- for cmd in 'sed 50q "[$]0"' 'sed 20q "[$]0"' 'sed 10q "[$]0"' 'sed 2q "[$]0"' 'echo test'; do
- # expected sizes: less than 2Kb, 1Kb, 512 bytes, 16 bytes, ...
- if { echo_test_string=`eval $cmd`; } 2>/dev/null &&
- { test "X$echo_test_string" = "X$echo_test_string"; } 2>/dev/null
- then
- break
- fi
- done
- fi
-
- if test "X`{ $ECHO '\t'; } 2>/dev/null`" = 'X\t' &&
- echo_testing_string=`{ $ECHO "$echo_test_string"; } 2>/dev/null` &&
- test "X$echo_testing_string" = "X$echo_test_string"; then
- :
- else
- # The Solaris, AIX, and Digital Unix default echo programs unquote
- # backslashes. This makes it impossible to quote backslashes using
- # echo "$something" | sed 's/\\/\\\\/g'
- #
- # So, first we look for a working echo in the user's PATH.
-
- lt_save_ifs="$IFS"; IFS=$PATH_SEPARATOR
- for dir in $PATH /usr/ucb; do
- IFS="$lt_save_ifs"
- if (test -f $dir/echo || test -f $dir/echo$ac_exeext) &&
- test "X`($dir/echo '\t') 2>/dev/null`" = 'X\t' &&
- echo_testing_string=`($dir/echo "$echo_test_string") 2>/dev/null` &&
- test "X$echo_testing_string" = "X$echo_test_string"; then
- ECHO="$dir/echo"
- break
- fi
- done
- IFS="$lt_save_ifs"
-
- if test "X$ECHO" = Xecho; then
- # We didn't find a better echo, so look for alternatives.
- if test "X`{ print -r '\t'; } 2>/dev/null`" = 'X\t' &&
- echo_testing_string=`{ print -r "$echo_test_string"; } 2>/dev/null` &&
- test "X$echo_testing_string" = "X$echo_test_string"; then
- # This shell has a builtin print -r that does the trick.
- ECHO='print -r'
- elif { test -f /bin/ksh || test -f /bin/ksh$ac_exeext; } &&
- test "X$CONFIG_SHELL" != X/bin/ksh; then
- # If we have ksh, try running configure again with it.
- ORIGINAL_CONFIG_SHELL=${CONFIG_SHELL-/bin/sh}
- export ORIGINAL_CONFIG_SHELL
- CONFIG_SHELL=/bin/ksh
- export CONFIG_SHELL
- exec $CONFIG_SHELL "[$]0" --no-reexec ${1+"[$]@"}
- else
- # Try using printf.
- ECHO='printf %s\n'
- if test "X`{ $ECHO '\t'; } 2>/dev/null`" = 'X\t' &&
- echo_testing_string=`{ $ECHO "$echo_test_string"; } 2>/dev/null` &&
- test "X$echo_testing_string" = "X$echo_test_string"; then
- # Cool, printf works
- :
- elif echo_testing_string=`($ORIGINAL_CONFIG_SHELL "[$]0" --fallback-echo '\t') 2>/dev/null` &&
- test "X$echo_testing_string" = 'X\t' &&
- echo_testing_string=`($ORIGINAL_CONFIG_SHELL "[$]0" --fallback-echo "$echo_test_string") 2>/dev/null` &&
- test "X$echo_testing_string" = "X$echo_test_string"; then
- CONFIG_SHELL=$ORIGINAL_CONFIG_SHELL
- export CONFIG_SHELL
- SHELL="$CONFIG_SHELL"
- export SHELL
- ECHO="$CONFIG_SHELL [$]0 --fallback-echo"
- elif echo_testing_string=`($CONFIG_SHELL "[$]0" --fallback-echo '\t') 2>/dev/null` &&
- test "X$echo_testing_string" = 'X\t' &&
- echo_testing_string=`($CONFIG_SHELL "[$]0" --fallback-echo "$echo_test_string") 2>/dev/null` &&
- test "X$echo_testing_string" = "X$echo_test_string"; then
- ECHO="$CONFIG_SHELL [$]0 --fallback-echo"
- else
- # maybe with a smaller string...
- prev=:
-
- for cmd in 'echo test' 'sed 2q "[$]0"' 'sed 10q "[$]0"' 'sed 20q "[$]0"' 'sed 50q "[$]0"'; do
- if { test "X$echo_test_string" = "X`eval $cmd`"; } 2>/dev/null
- then
- break
- fi
- prev="$cmd"
- done
-
- if test "$prev" != 'sed 50q "[$]0"'; then
- echo_test_string=`eval $prev`
- export echo_test_string
- exec ${ORIGINAL_CONFIG_SHELL-${CONFIG_SHELL-/bin/sh}} "[$]0" ${1+"[$]@"}
- else
- # Oops. We lost completely, so just stick with echo.
- ECHO=echo
- fi
- fi
- fi
- fi
- fi
-fi
-
-# Copy echo and quote the copy suitably for passing to libtool from
-# the Makefile, instead of quoting the original, which is used later.
-lt_ECHO=$ECHO
-if test "X$lt_ECHO" = "X$CONFIG_SHELL [$]0 --fallback-echo"; then
- lt_ECHO="$CONFIG_SHELL \\\$\[$]0 --fallback-echo"
-fi
-
-AC_SUBST(lt_ECHO)
-])
-_LT_DECL([], [SHELL], [1], [Shell to use when invoking shell scripts])
-_LT_DECL([], [ECHO], [1],
- [An echo program that does not interpret backslashes])
-])# _LT_PROG_ECHO_BACKSLASH
-
-
-# _LT_ENABLE_LOCK
-# ---------------
-m4_defun([_LT_ENABLE_LOCK],
-[AC_ARG_ENABLE([libtool-lock],
- [AS_HELP_STRING([--disable-libtool-lock],
- [avoid locking (might break parallel builds)])])
-test "x$enable_libtool_lock" != xno && enable_libtool_lock=yes
-
-# Some flags need to be propagated to the compiler or linker for good
-# libtool support.
-case $host in
-ia64-*-hpux*)
- # Find out which ABI we are using.
- echo 'int i;' > conftest.$ac_ext
- if AC_TRY_EVAL(ac_compile); then
- case `/usr/bin/file conftest.$ac_objext` in
- *ELF-32*)
- HPUX_IA64_MODE="32"
- ;;
- *ELF-64*)
- HPUX_IA64_MODE="64"
- ;;
- esac
- fi
- rm -rf conftest*
- ;;
-*-*-irix6*)
- # Find out which ABI we are using.
- echo '[#]line __oline__ "configure"' > conftest.$ac_ext
- if AC_TRY_EVAL(ac_compile); then
- if test "$lt_cv_prog_gnu_ld" = yes; then
- case `/usr/bin/file conftest.$ac_objext` in
- *32-bit*)
- LD="${LD-ld} -melf32bsmip"
- ;;
- *N32*)
- LD="${LD-ld} -melf32bmipn32"
- ;;
- *64-bit*)
- LD="${LD-ld} -melf64bmip"
- ;;
- esac
- else
- case `/usr/bin/file conftest.$ac_objext` in
- *32-bit*)
- LD="${LD-ld} -32"
- ;;
- *N32*)
- LD="${LD-ld} -n32"
- ;;
- *64-bit*)
- LD="${LD-ld} -64"
- ;;
- esac
- fi
- fi
- rm -rf conftest*
- ;;
-
-x86_64-*kfreebsd*-gnu|x86_64-*linux*|ppc*-*linux*|powerpc*-*linux*| \
-s390*-*linux*|s390*-*tpf*|sparc*-*linux*)
- # Find out which ABI we are using.
- echo 'int i;' > conftest.$ac_ext
- if AC_TRY_EVAL(ac_compile); then
- case `/usr/bin/file conftest.o` in
- *32-bit*)
- case $host in
- x86_64-*kfreebsd*-gnu)
- LD="${LD-ld} -m elf_i386_fbsd"
- ;;
- x86_64-*linux*)
- LD="${LD-ld} -m elf_i386"
- ;;
- ppc64-*linux*|powerpc64-*linux*)
- LD="${LD-ld} -m elf32ppclinux"
- ;;
- s390x-*linux*)
- LD="${LD-ld} -m elf_s390"
- ;;
- sparc64-*linux*)
- LD="${LD-ld} -m elf32_sparc"
- ;;
- esac
- ;;
- *64-bit*)
- case $host in
- x86_64-*kfreebsd*-gnu)
- LD="${LD-ld} -m elf_x86_64_fbsd"
- ;;
- x86_64-*linux*)
- LD="${LD-ld} -m elf_x86_64"
- ;;
- ppc*-*linux*|powerpc*-*linux*)
- LD="${LD-ld} -m elf64ppc"
- ;;
- s390*-*linux*|s390*-*tpf*)
- LD="${LD-ld} -m elf64_s390"
- ;;
- sparc*-*linux*)
- LD="${LD-ld} -m elf64_sparc"
- ;;
- esac
- ;;
- esac
- fi
- rm -rf conftest*
- ;;
-
-*-*-sco3.2v5*)
- # On SCO OpenServer 5, we need -belf to get full-featured binaries.
- SAVE_CFLAGS="$CFLAGS"
- CFLAGS="$CFLAGS -belf"
- AC_CACHE_CHECK([whether the C compiler needs -belf], lt_cv_cc_needs_belf,
- [AC_LANG_PUSH(C)
- AC_LINK_IFELSE([AC_LANG_PROGRAM([[]],[[]])],[lt_cv_cc_needs_belf=yes],[lt_cv_cc_needs_belf=no])
- AC_LANG_POP])
- if test x"$lt_cv_cc_needs_belf" != x"yes"; then
- # this is probably gcc 2.8.0, egcs 1.0 or newer; no need for -belf
- CFLAGS="$SAVE_CFLAGS"
- fi
- ;;
-sparc*-*solaris*)
- # Find out which ABI we are using.
- echo 'int i;' > conftest.$ac_ext
- if AC_TRY_EVAL(ac_compile); then
- case `/usr/bin/file conftest.o` in
- *64-bit*)
- case $lt_cv_prog_gnu_ld in
- yes*) LD="${LD-ld} -m elf64_sparc" ;;
- *)
- if ${LD-ld} -64 -r -o conftest2.o conftest.o >/dev/null 2>&1; then
- LD="${LD-ld} -64"
- fi
- ;;
- esac
- ;;
- esac
- fi
- rm -rf conftest*
- ;;
-esac
-
-need_locks="$enable_libtool_lock"
-])# _LT_ENABLE_LOCK
-
-
-# _LT_CMD_OLD_ARCHIVE
-# -------------------
-m4_defun([_LT_CMD_OLD_ARCHIVE],
-[AC_CHECK_TOOL(AR, ar, false)
-test -z "$AR" && AR=ar
-test -z "$AR_FLAGS" && AR_FLAGS=cru
-_LT_DECL([], [AR], [1], [The archiver])
-_LT_DECL([], [AR_FLAGS], [1])
-
-AC_CHECK_TOOL(STRIP, strip, :)
-test -z "$STRIP" && STRIP=:
-_LT_DECL([], [STRIP], [1], [A symbol stripping program])
-
-AC_CHECK_TOOL(RANLIB, ranlib, :)
-test -z "$RANLIB" && RANLIB=:
-_LT_DECL([], [RANLIB], [1],
- [Commands used to install an old-style archive])
-
-# Determine commands to create old-style static archives.
-old_archive_cmds='$AR $AR_FLAGS $oldlib$oldobjs'
-old_postinstall_cmds='chmod 644 $oldlib'
-old_postuninstall_cmds=
-
-if test -n "$RANLIB"; then
- case $host_os in
- openbsd*)
- old_postinstall_cmds="$old_postinstall_cmds~\$RANLIB -t \$oldlib"
- ;;
- *)
- old_postinstall_cmds="$old_postinstall_cmds~\$RANLIB \$oldlib"
- ;;
- esac
- old_archive_cmds="$old_archive_cmds~\$RANLIB \$oldlib"
-fi
-_LT_DECL([], [old_postinstall_cmds], [2])
-_LT_DECL([], [old_postuninstall_cmds], [2])
-_LT_TAGDECL([], [old_archive_cmds], [2],
- [Commands used to build an old-style archive])
-])# _LT_CMD_OLD_ARCHIVE
-
-
-# _LT_COMPILER_OPTION(MESSAGE, VARIABLE-NAME, FLAGS,
-# [OUTPUT-FILE], [ACTION-SUCCESS], [ACTION-FAILURE])
-# ----------------------------------------------------------------
-# Check whether the given compiler option works
-AC_DEFUN([_LT_COMPILER_OPTION],
-[m4_require([_LT_FILEUTILS_DEFAULTS])dnl
-m4_require([_LT_DECL_SED])dnl
-AC_CACHE_CHECK([$1], [$2],
- [$2=no
- m4_if([$4], , [ac_outfile=conftest.$ac_objext], [ac_outfile=$4])
- echo "$lt_simple_compile_test_code" > conftest.$ac_ext
- lt_compiler_flag="$3"
- # Insert the option either (1) after the last *FLAGS variable, or
- # (2) before a word containing "conftest.", or (3) at the end.
- # Note that $ac_compile itself does not contain backslashes and begins
- # with a dollar sign (not a hyphen), so the echo should work correctly.
- # The option is referenced via a variable to avoid confusing sed.
- lt_compile=`echo "$ac_compile" | $SED \
- -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \
- -e 's: [[^ ]]*conftest\.: $lt_compiler_flag&:; t' \
- -e 's:$: $lt_compiler_flag:'`
- (eval echo "\"\$as_me:__oline__: $lt_compile\"" >&AS_MESSAGE_LOG_FD)
- (eval "$lt_compile" 2>conftest.err)
- ac_status=$?
- cat conftest.err >&AS_MESSAGE_LOG_FD
- echo "$as_me:__oline__: \$? = $ac_status" >&AS_MESSAGE_LOG_FD
- if (exit $ac_status) && test -s "$ac_outfile"; then
- # The compiler can only warn and ignore the option if not recognized
- # So say no if there are warnings other than the usual output.
- $ECHO "X$_lt_compiler_boilerplate" | $Xsed -e '/^$/d' >conftest.exp
- $SED '/^$/d; /^ *+/d' conftest.err >conftest.er2
- if test ! -s conftest.er2 || diff conftest.exp conftest.er2 >/dev/null; then
- $2=yes
- fi
- fi
- $RM conftest*
-])
-
-if test x"[$]$2" = xyes; then
- m4_if([$5], , :, [$5])
-else
- m4_if([$6], , :, [$6])
-fi
-])# _LT_COMPILER_OPTION
-
-# Old name:
-AU_ALIAS([AC_LIBTOOL_COMPILER_OPTION], [_LT_COMPILER_OPTION])
-dnl aclocal-1.4 backwards compatibility:
-dnl AC_DEFUN([AC_LIBTOOL_COMPILER_OPTION], [])
-
-
-# _LT_LINKER_OPTION(MESSAGE, VARIABLE-NAME, FLAGS,
-# [ACTION-SUCCESS], [ACTION-FAILURE])
-# ----------------------------------------------------
-# Check whether the given linker option works
-AC_DEFUN([_LT_LINKER_OPTION],
-[m4_require([_LT_FILEUTILS_DEFAULTS])dnl
-m4_require([_LT_DECL_SED])dnl
-AC_CACHE_CHECK([$1], [$2],
- [$2=no
- save_LDFLAGS="$LDFLAGS"
- LDFLAGS="$LDFLAGS $3"
- echo "$lt_simple_link_test_code" > conftest.$ac_ext
- if (eval $ac_link 2>conftest.err) && test -s conftest$ac_exeext; then
- # The linker can only warn and ignore the option if not recognized
- # So say no if there are warnings
- if test -s conftest.err; then
- # Append any errors to the config.log.
- cat conftest.err 1>&AS_MESSAGE_LOG_FD
- $ECHO "X$_lt_linker_boilerplate" | $Xsed -e '/^$/d' > conftest.exp
- $SED '/^$/d; /^ *+/d' conftest.err >conftest.er2
- if diff conftest.exp conftest.er2 >/dev/null; then
- $2=yes
- fi
- else
- $2=yes
- fi
- fi
- $RM -r conftest*
- LDFLAGS="$save_LDFLAGS"
-])
-
-if test x"[$]$2" = xyes; then
- m4_if([$4], , :, [$4])
-else
- m4_if([$5], , :, [$5])
-fi
-])# _LT_LINKER_OPTION
-
-# Old name:
-AU_ALIAS([AC_LIBTOOL_LINKER_OPTION], [_LT_LINKER_OPTION])
-dnl aclocal-1.4 backwards compatibility:
-dnl AC_DEFUN([AC_LIBTOOL_LINKER_OPTION], [])
-
-
-# LT_CMD_MAX_LEN
-#---------------
-AC_DEFUN([LT_CMD_MAX_LEN],
-[AC_REQUIRE([AC_CANONICAL_HOST])dnl
-# find the maximum length of command line arguments
-AC_MSG_CHECKING([the maximum length of command line arguments])
-AC_CACHE_VAL([lt_cv_sys_max_cmd_len], [dnl
- i=0
- teststring="ABCD"
-
- case $build_os in
- msdosdjgpp*)
- # On DJGPP, this test can blow up pretty badly due to problems in libc
- # (any single argument exceeding 2000 bytes causes a buffer overrun
- # during glob expansion). Even if it were fixed, the result of this
- # check would be larger than it should be.
- lt_cv_sys_max_cmd_len=12288; # 12K is about right
- ;;
-
- gnu*)
- # Under GNU Hurd, this test is not required because there is
- # no limit to the length of command line arguments.
- # Libtool will interpret -1 as no limit whatsoever
- lt_cv_sys_max_cmd_len=-1;
- ;;
-
- cygwin* | mingw* | cegcc*)
- # On Win9x/ME, this test blows up -- it succeeds, but takes
- # about 5 minutes as the teststring grows exponentially.
- # Worse, since 9x/ME are not pre-emptively multitasking,
- # you end up with a "frozen" computer, even though with patience
- # the test eventually succeeds (with a max line length of 256k).
- # Instead, let's just punt: use the minimum linelength reported by
- # all of the supported platforms: 8192 (on NT/2K/XP).
- lt_cv_sys_max_cmd_len=8192;
- ;;
-
- amigaos*)
- # On AmigaOS with pdksh, this test takes hours, literally.
- # So we just punt and use a minimum line length of 8192.
- lt_cv_sys_max_cmd_len=8192;
- ;;
-
- netbsd* | freebsd* | openbsd* | darwin* | dragonfly*)
- # This has been around since 386BSD, at least. Likely further.
- if test -x /sbin/sysctl; then
- lt_cv_sys_max_cmd_len=`/sbin/sysctl -n kern.argmax`
- elif test -x /usr/sbin/sysctl; then
- lt_cv_sys_max_cmd_len=`/usr/sbin/sysctl -n kern.argmax`
- else
- lt_cv_sys_max_cmd_len=65536 # usable default for all BSDs
- fi
- # And add a safety zone
- lt_cv_sys_max_cmd_len=`expr $lt_cv_sys_max_cmd_len \/ 4`
- lt_cv_sys_max_cmd_len=`expr $lt_cv_sys_max_cmd_len \* 3`
- ;;
-
- interix*)
- # We know the value 262144 and hardcode it with a safety zone (like BSD)
- lt_cv_sys_max_cmd_len=196608
- ;;
-
- osf*)
- # Dr. Hans Ekkehard Plesser reports seeing a kernel panic running configure
- # due to this test when exec_disable_arg_limit is 1 on Tru64. It is not
- # nice to cause kernel panics so lets avoid the loop below.
- # First set a reasonable default.
- lt_cv_sys_max_cmd_len=16384
- #
- if test -x /sbin/sysconfig; then
- case `/sbin/sysconfig -q proc exec_disable_arg_limit` in
- *1*) lt_cv_sys_max_cmd_len=-1 ;;
- esac
- fi
- ;;
- sco3.2v5*)
- lt_cv_sys_max_cmd_len=102400
- ;;
- sysv5* | sco5v6* | sysv4.2uw2*)
- kargmax=`grep ARG_MAX /etc/conf/cf.d/stune 2>/dev/null`
- if test -n "$kargmax"; then
- lt_cv_sys_max_cmd_len=`echo $kargmax | sed 's/.*[[ ]]//'`
- else
- lt_cv_sys_max_cmd_len=32768
- fi
- ;;
- *)
- lt_cv_sys_max_cmd_len=`(getconf ARG_MAX) 2> /dev/null`
- if test -n "$lt_cv_sys_max_cmd_len"; then
- lt_cv_sys_max_cmd_len=`expr $lt_cv_sys_max_cmd_len \/ 4`
- lt_cv_sys_max_cmd_len=`expr $lt_cv_sys_max_cmd_len \* 3`
- else
- # Make teststring a little bigger before we do anything with it.
- # a 1K string should be a reasonable start.
- for i in 1 2 3 4 5 6 7 8 ; do
- teststring=$teststring$teststring
- done
- SHELL=${SHELL-${CONFIG_SHELL-/bin/sh}}
- # If test is not a shell built-in, we'll probably end up computing a
- # maximum length that is only half of the actual maximum length, but
- # we can't tell.
- while { test "X"`$SHELL [$]0 --fallback-echo "X$teststring$teststring" 2>/dev/null` \
- = "XX$teststring$teststring"; } >/dev/null 2>&1 &&
- test $i != 17 # 1/2 MB should be enough
- do
- i=`expr $i + 1`
- teststring=$teststring$teststring
- done
- # Only check the string length outside the loop.
- lt_cv_sys_max_cmd_len=`expr "X$teststring" : ".*" 2>&1`
- teststring=
- # Add a significant safety factor because C++ compilers can tack on
- # massive amounts of additional arguments before passing them to the
- # linker. It appears as though 1/2 is a usable value.
- lt_cv_sys_max_cmd_len=`expr $lt_cv_sys_max_cmd_len \/ 2`
- fi
- ;;
- esac
-])
-if test -n $lt_cv_sys_max_cmd_len ; then
- AC_MSG_RESULT($lt_cv_sys_max_cmd_len)
-else
- AC_MSG_RESULT(none)
-fi
-max_cmd_len=$lt_cv_sys_max_cmd_len
-_LT_DECL([], [max_cmd_len], [0],
- [What is the maximum length of a command?])
-])# LT_CMD_MAX_LEN
-
-# Old name:
-AU_ALIAS([AC_LIBTOOL_SYS_MAX_CMD_LEN], [LT_CMD_MAX_LEN])
-dnl aclocal-1.4 backwards compatibility:
-dnl AC_DEFUN([AC_LIBTOOL_SYS_MAX_CMD_LEN], [])
-
-
-# _LT_HEADER_DLFCN
-# ----------------
-m4_defun([_LT_HEADER_DLFCN],
-[AC_CHECK_HEADERS([dlfcn.h], [], [], [AC_INCLUDES_DEFAULT])dnl
-])# _LT_HEADER_DLFCN
-
-
-# _LT_TRY_DLOPEN_SELF (ACTION-IF-TRUE, ACTION-IF-TRUE-W-USCORE,
-# ACTION-IF-FALSE, ACTION-IF-CROSS-COMPILING)
-# ----------------------------------------------------------------
-m4_defun([_LT_TRY_DLOPEN_SELF],
-[m4_require([_LT_HEADER_DLFCN])dnl
-if test "$cross_compiling" = yes; then :
- [$4]
-else
- lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2
- lt_status=$lt_dlunknown
- cat > conftest.$ac_ext <<_LT_EOF
-[#line __oline__ "configure"
-#include "confdefs.h"
-
-#if HAVE_DLFCN_H
-#include <dlfcn.h>
-#endif
-
-#include <stdio.h>
-
-#ifdef RTLD_GLOBAL
-# define LT_DLGLOBAL RTLD_GLOBAL
-#else
-# ifdef DL_GLOBAL
-# define LT_DLGLOBAL DL_GLOBAL
-# else
-# define LT_DLGLOBAL 0
-# endif
-#endif
-
-/* We may have to define LT_DLLAZY_OR_NOW in the command line if we
- find out it does not work in some platform. */
-#ifndef LT_DLLAZY_OR_NOW
-# ifdef RTLD_LAZY
-# define LT_DLLAZY_OR_NOW RTLD_LAZY
-# else
-# ifdef DL_LAZY
-# define LT_DLLAZY_OR_NOW DL_LAZY
-# else
-# ifdef RTLD_NOW
-# define LT_DLLAZY_OR_NOW RTLD_NOW
-# else
-# ifdef DL_NOW
-# define LT_DLLAZY_OR_NOW DL_NOW
-# else
-# define LT_DLLAZY_OR_NOW 0
-# endif
-# endif
-# endif
-# endif
-#endif
-
-void fnord() { int i=42;}
-int main ()
-{
- void *self = dlopen (0, LT_DLGLOBAL|LT_DLLAZY_OR_NOW);
- int status = $lt_dlunknown;
-
- if (self)
- {
- if (dlsym (self,"fnord")) status = $lt_dlno_uscore;
- else if (dlsym( self,"_fnord")) status = $lt_dlneed_uscore;
- /* dlclose (self); */
- }
- else
- puts (dlerror ());
-
- return status;
-}]
-_LT_EOF
- if AC_TRY_EVAL(ac_link) && test -s conftest${ac_exeext} 2>/dev/null; then
- (./conftest; exit; ) >&AS_MESSAGE_LOG_FD 2>/dev/null
- lt_status=$?
- case x$lt_status in
- x$lt_dlno_uscore) $1 ;;
- x$lt_dlneed_uscore) $2 ;;
- x$lt_dlunknown|x*) $3 ;;
- esac
- else :
- # compilation failed
- $3
- fi
-fi
-rm -fr conftest*
-])# _LT_TRY_DLOPEN_SELF
-
-
-# LT_SYS_DLOPEN_SELF
-# ------------------
-AC_DEFUN([LT_SYS_DLOPEN_SELF],
-[m4_require([_LT_HEADER_DLFCN])dnl
-if test "x$enable_dlopen" != xyes; then
- enable_dlopen=unknown
- enable_dlopen_self=unknown
- enable_dlopen_self_static=unknown
-else
- lt_cv_dlopen=no
- lt_cv_dlopen_libs=
-
- case $host_os in
- beos*)
- lt_cv_dlopen="load_add_on"
- lt_cv_dlopen_libs=
- lt_cv_dlopen_self=yes
- ;;
-
- mingw* | pw32* | cegcc*)
- lt_cv_dlopen="LoadLibrary"
- lt_cv_dlopen_libs=
- ;;
-
- cygwin*)
- lt_cv_dlopen="dlopen"
- lt_cv_dlopen_libs=
- ;;
-
- darwin*)
- # if libdl is installed we need to link against it
- AC_CHECK_LIB([dl], [dlopen],
- [lt_cv_dlopen="dlopen" lt_cv_dlopen_libs="-ldl"],[
- lt_cv_dlopen="dyld"
- lt_cv_dlopen_libs=
- lt_cv_dlopen_self=yes
- ])
- ;;
-
- *)
- AC_CHECK_FUNC([shl_load],
- [lt_cv_dlopen="shl_load"],
- [AC_CHECK_LIB([dld], [shl_load],
- [lt_cv_dlopen="shl_load" lt_cv_dlopen_libs="-ldld"],
- [AC_CHECK_FUNC([dlopen],
- [lt_cv_dlopen="dlopen"],
- [AC_CHECK_LIB([dl], [dlopen],
- [lt_cv_dlopen="dlopen" lt_cv_dlopen_libs="-ldl"],
- [AC_CHECK_LIB([svld], [dlopen],
- [lt_cv_dlopen="dlopen" lt_cv_dlopen_libs="-lsvld"],
- [AC_CHECK_LIB([dld], [dld_link],
- [lt_cv_dlopen="dld_link" lt_cv_dlopen_libs="-ldld"])
- ])
- ])
- ])
- ])
- ])
- ;;
- esac
-
- if test "x$lt_cv_dlopen" != xno; then
- enable_dlopen=yes
- else
- enable_dlopen=no
- fi
-
- case $lt_cv_dlopen in
- dlopen)
- save_CPPFLAGS="$CPPFLAGS"
- test "x$ac_cv_header_dlfcn_h" = xyes && CPPFLAGS="$CPPFLAGS -DHAVE_DLFCN_H"
-
- save_LDFLAGS="$LDFLAGS"
- wl=$lt_prog_compiler_wl eval LDFLAGS=\"\$LDFLAGS $export_dynamic_flag_spec\"
-
- save_LIBS="$LIBS"
- LIBS="$lt_cv_dlopen_libs $LIBS"
-
- AC_CACHE_CHECK([whether a program can dlopen itself],
- lt_cv_dlopen_self, [dnl
- _LT_TRY_DLOPEN_SELF(
- lt_cv_dlopen_self=yes, lt_cv_dlopen_self=yes,
- lt_cv_dlopen_self=no, lt_cv_dlopen_self=cross)
- ])
-
- if test "x$lt_cv_dlopen_self" = xyes; then
- wl=$lt_prog_compiler_wl eval LDFLAGS=\"\$LDFLAGS $lt_prog_compiler_static\"
- AC_CACHE_CHECK([whether a statically linked program can dlopen itself],
- lt_cv_dlopen_self_static, [dnl
- _LT_TRY_DLOPEN_SELF(
- lt_cv_dlopen_self_static=yes, lt_cv_dlopen_self_static=yes,
- lt_cv_dlopen_self_static=no, lt_cv_dlopen_self_static=cross)
- ])
- fi
-
- CPPFLAGS="$save_CPPFLAGS"
- LDFLAGS="$save_LDFLAGS"
- LIBS="$save_LIBS"
- ;;
- esac
-
- case $lt_cv_dlopen_self in
- yes|no) enable_dlopen_self=$lt_cv_dlopen_self ;;
- *) enable_dlopen_self=unknown ;;
- esac
-
- case $lt_cv_dlopen_self_static in
- yes|no) enable_dlopen_self_static=$lt_cv_dlopen_self_static ;;
- *) enable_dlopen_self_static=unknown ;;
- esac
-fi
-_LT_DECL([dlopen_support], [enable_dlopen], [0],
- [Whether dlopen is supported])
-_LT_DECL([dlopen_self], [enable_dlopen_self], [0],
- [Whether dlopen of programs is supported])
-_LT_DECL([dlopen_self_static], [enable_dlopen_self_static], [0],
- [Whether dlopen of statically linked programs is supported])
-])# LT_SYS_DLOPEN_SELF
-
-# Old name:
-AU_ALIAS([AC_LIBTOOL_DLOPEN_SELF], [LT_SYS_DLOPEN_SELF])
-dnl aclocal-1.4 backwards compatibility:
-dnl AC_DEFUN([AC_LIBTOOL_DLOPEN_SELF], [])
-
-
-# _LT_COMPILER_C_O([TAGNAME])
-# ---------------------------
-# Check to see if options -c and -o are simultaneously supported by compiler.
-# This macro does not hard code the compiler like AC_PROG_CC_C_O.
-m4_defun([_LT_COMPILER_C_O],
-[m4_require([_LT_DECL_SED])dnl
-m4_require([_LT_FILEUTILS_DEFAULTS])dnl
-m4_require([_LT_TAG_COMPILER])dnl
-AC_CACHE_CHECK([if $compiler supports -c -o file.$ac_objext],
- [_LT_TAGVAR(lt_cv_prog_compiler_c_o, $1)],
- [_LT_TAGVAR(lt_cv_prog_compiler_c_o, $1)=no
- $RM -r conftest 2>/dev/null
- mkdir conftest
- cd conftest
- mkdir out
- echo "$lt_simple_compile_test_code" > conftest.$ac_ext
-
- lt_compiler_flag="-o out/conftest2.$ac_objext"
- # Insert the option either (1) after the last *FLAGS variable, or
- # (2) before a word containing "conftest.", or (3) at the end.
- # Note that $ac_compile itself does not contain backslashes and begins
- # with a dollar sign (not a hyphen), so the echo should work correctly.
- lt_compile=`echo "$ac_compile" | $SED \
- -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \
- -e 's: [[^ ]]*conftest\.: $lt_compiler_flag&:; t' \
- -e 's:$: $lt_compiler_flag:'`
- (eval echo "\"\$as_me:__oline__: $lt_compile\"" >&AS_MESSAGE_LOG_FD)
- (eval "$lt_compile" 2>out/conftest.err)
- ac_status=$?
- cat out/conftest.err >&AS_MESSAGE_LOG_FD
- echo "$as_me:__oline__: \$? = $ac_status" >&AS_MESSAGE_LOG_FD
- if (exit $ac_status) && test -s out/conftest2.$ac_objext
- then
- # The compiler can only warn and ignore the option if not recognized
- # So say no if there are warnings
- $ECHO "X$_lt_compiler_boilerplate" | $Xsed -e '/^$/d' > out/conftest.exp
- $SED '/^$/d; /^ *+/d' out/conftest.err >out/conftest.er2
- if test ! -s out/conftest.er2 || diff out/conftest.exp out/conftest.er2 >/dev/null; then
- _LT_TAGVAR(lt_cv_prog_compiler_c_o, $1)=yes
- fi
- fi
- chmod u+w . 2>&AS_MESSAGE_LOG_FD
- $RM conftest*
- # SGI C++ compiler will create directory out/ii_files/ for
- # template instantiation
- test -d out/ii_files && $RM out/ii_files/* && rmdir out/ii_files
- $RM out/* && rmdir out
- cd ..
- $RM -r conftest
- $RM conftest*
-])
-_LT_TAGDECL([compiler_c_o], [lt_cv_prog_compiler_c_o], [1],
- [Does compiler simultaneously support -c and -o options?])
-])# _LT_COMPILER_C_O
-
-
-# _LT_COMPILER_FILE_LOCKS([TAGNAME])
-# ----------------------------------
-# Check to see if we can do hard links to lock some files if needed
-m4_defun([_LT_COMPILER_FILE_LOCKS],
-[m4_require([_LT_ENABLE_LOCK])dnl
-m4_require([_LT_FILEUTILS_DEFAULTS])dnl
-_LT_COMPILER_C_O([$1])
-
-hard_links="nottested"
-if test "$_LT_TAGVAR(lt_cv_prog_compiler_c_o, $1)" = no && test "$need_locks" != no; then
- # do not overwrite the value of need_locks provided by the user
- AC_MSG_CHECKING([if we can lock with hard links])
- hard_links=yes
- $RM conftest*
- ln conftest.a conftest.b 2>/dev/null && hard_links=no
- touch conftest.a
- ln conftest.a conftest.b 2>&5 || hard_links=no
- ln conftest.a conftest.b 2>/dev/null && hard_links=no
- AC_MSG_RESULT([$hard_links])
- if test "$hard_links" = no; then
- AC_MSG_WARN([`$CC' does not support `-c -o', so `make -j' may be unsafe])
- need_locks=warn
- fi
-else
- need_locks=no
-fi
-_LT_DECL([], [need_locks], [1], [Must we lock files when doing compilation?])
-])# _LT_COMPILER_FILE_LOCKS
-
-
-# _LT_CHECK_OBJDIR
-# ----------------
-m4_defun([_LT_CHECK_OBJDIR],
-[AC_CACHE_CHECK([for objdir], [lt_cv_objdir],
-[rm -f .libs 2>/dev/null
-mkdir .libs 2>/dev/null
-if test -d .libs; then
- lt_cv_objdir=.libs
-else
- # MS-DOS does not allow filenames that begin with a dot.
- lt_cv_objdir=_libs
-fi
-rmdir .libs 2>/dev/null])
-objdir=$lt_cv_objdir
-_LT_DECL([], [objdir], [0],
- [The name of the directory that contains temporary libtool files])dnl
-m4_pattern_allow([LT_OBJDIR])dnl
-AC_DEFINE_UNQUOTED(LT_OBJDIR, "$lt_cv_objdir/",
- [Define to the sub-directory in which libtool stores uninstalled libraries.])
-])# _LT_CHECK_OBJDIR
-
-
-# _LT_LINKER_HARDCODE_LIBPATH([TAGNAME])
-# --------------------------------------
-# Check hardcoding attributes.
-m4_defun([_LT_LINKER_HARDCODE_LIBPATH],
-[AC_MSG_CHECKING([how to hardcode library paths into programs])
-_LT_TAGVAR(hardcode_action, $1)=
-if test -n "$_LT_TAGVAR(hardcode_libdir_flag_spec, $1)" ||
- test -n "$_LT_TAGVAR(runpath_var, $1)" ||
- test "X$_LT_TAGVAR(hardcode_automatic, $1)" = "Xyes" ; then
-
- # We can hardcode non-existent directories.
- if test "$_LT_TAGVAR(hardcode_direct, $1)" != no &&
- # If the only mechanism to avoid hardcoding is shlibpath_var, we
- # have to relink, otherwise we might link with an installed library
- # when we should be linking with a yet-to-be-installed one
- ## test "$_LT_TAGVAR(hardcode_shlibpath_var, $1)" != no &&
- test "$_LT_TAGVAR(hardcode_minus_L, $1)" != no; then
- # Linking always hardcodes the temporary library directory.
- _LT_TAGVAR(hardcode_action, $1)=relink
- else
- # We can link without hardcoding, and we can hardcode nonexisting dirs.
- _LT_TAGVAR(hardcode_action, $1)=immediate
- fi
-else
- # We cannot hardcode anything, or else we can only hardcode existing
- # directories.
- _LT_TAGVAR(hardcode_action, $1)=unsupported
-fi
-AC_MSG_RESULT([$_LT_TAGVAR(hardcode_action, $1)])
-
-if test "$_LT_TAGVAR(hardcode_action, $1)" = relink ||
- test "$_LT_TAGVAR(inherit_rpath, $1)" = yes; then
- # Fast installation is not supported
- enable_fast_install=no
-elif test "$shlibpath_overrides_runpath" = yes ||
- test "$enable_shared" = no; then
- # Fast installation is not necessary
- enable_fast_install=needless
-fi
-_LT_TAGDECL([], [hardcode_action], [0],
- [How to hardcode a shared library path into an executable])
-])# _LT_LINKER_HARDCODE_LIBPATH
-
-
-# _LT_CMD_STRIPLIB
-# ----------------
-m4_defun([_LT_CMD_STRIPLIB],
-[m4_require([_LT_DECL_EGREP])
-striplib=
-old_striplib=
-AC_MSG_CHECKING([whether stripping libraries is possible])
-if test -n "$STRIP" && $STRIP -V 2>&1 | $GREP "GNU strip" >/dev/null; then
- test -z "$old_striplib" && old_striplib="$STRIP --strip-debug"
- test -z "$striplib" && striplib="$STRIP --strip-unneeded"
- AC_MSG_RESULT([yes])
-else
-# FIXME - insert some real tests, host_os isn't really good enough
- case $host_os in
- darwin*)
- if test -n "$STRIP" ; then
- striplib="$STRIP -x"
- old_striplib="$STRIP -S"
- AC_MSG_RESULT([yes])
- else
- AC_MSG_RESULT([no])
- fi
- ;;
- *)
- AC_MSG_RESULT([no])
- ;;
- esac
-fi
-_LT_DECL([], [old_striplib], [1], [Commands to strip libraries])
-_LT_DECL([], [striplib], [1])
-])# _LT_CMD_STRIPLIB
-
-
-# _LT_SYS_DYNAMIC_LINKER([TAG])
-# -----------------------------
-# PORTME Fill in your ld.so characteristics
-m4_defun([_LT_SYS_DYNAMIC_LINKER],
-[AC_REQUIRE([AC_CANONICAL_HOST])dnl
-m4_require([_LT_DECL_EGREP])dnl
-m4_require([_LT_FILEUTILS_DEFAULTS])dnl
-m4_require([_LT_DECL_OBJDUMP])dnl
-m4_require([_LT_DECL_SED])dnl
-AC_MSG_CHECKING([dynamic linker characteristics])
-m4_if([$1],
- [], [
-if test "$GCC" = yes; then
- case $host_os in
- darwin*) lt_awk_arg="/^libraries:/,/LR/" ;;
- *) lt_awk_arg="/^libraries:/" ;;
- esac
- lt_search_path_spec=`$CC -print-search-dirs | awk $lt_awk_arg | $SED -e "s/^libraries://" -e "s,=/,/,g"`
- if $ECHO "$lt_search_path_spec" | $GREP ';' >/dev/null ; then
- # if the path contains ";" then we assume it to be the separator
- # otherwise default to the standard path separator (i.e. ":") - it is
- # assumed that no part of a normal pathname contains ";" but that should
- # okay in the real world where ";" in dirpaths is itself problematic.
- lt_search_path_spec=`$ECHO "$lt_search_path_spec" | $SED -e 's/;/ /g'`
- else
- lt_search_path_spec=`$ECHO "$lt_search_path_spec" | $SED -e "s/$PATH_SEPARATOR/ /g"`
- fi
- # Ok, now we have the path, separated by spaces, we can step through it
- # and add multilib dir if necessary.
- lt_tmp_lt_search_path_spec=
- lt_multi_os_dir=`$CC $CPPFLAGS $CFLAGS $LDFLAGS -print-multi-os-directory 2>/dev/null`
- for lt_sys_path in $lt_search_path_spec; do
- if test -d "$lt_sys_path/$lt_multi_os_dir"; then
- lt_tmp_lt_search_path_spec="$lt_tmp_lt_search_path_spec $lt_sys_path/$lt_multi_os_dir"
- else
- test -d "$lt_sys_path" && \
- lt_tmp_lt_search_path_spec="$lt_tmp_lt_search_path_spec $lt_sys_path"
- fi
- done
- lt_search_path_spec=`$ECHO $lt_tmp_lt_search_path_spec | awk '
-BEGIN {RS=" "; FS="/|\n";} {
- lt_foo="";
- lt_count=0;
- for (lt_i = NF; lt_i > 0; lt_i--) {
- if ($lt_i != "" && $lt_i != ".") {
- if ($lt_i == "..") {
- lt_count++;
- } else {
- if (lt_count == 0) {
- lt_foo="/" $lt_i lt_foo;
- } else {
- lt_count--;
- }
- }
- }
- }
- if (lt_foo != "") { lt_freq[[lt_foo]]++; }
- if (lt_freq[[lt_foo]] == 1) { print lt_foo; }
-}'`
- sys_lib_search_path_spec=`$ECHO $lt_search_path_spec`
-else
- sys_lib_search_path_spec="/lib /usr/lib /usr/local/lib"
-fi])
-library_names_spec=
-libname_spec='lib$name'
-soname_spec=
-shrext_cmds=".so"
-postinstall_cmds=
-postuninstall_cmds=
-finish_cmds=
-finish_eval=
-shlibpath_var=
-shlibpath_overrides_runpath=unknown
-version_type=none
-dynamic_linker="$host_os ld.so"
-sys_lib_dlsearch_path_spec="/lib /usr/lib"
-need_lib_prefix=unknown
-hardcode_into_libs=no
-
-# when you set need_version to no, make sure it does not cause -set_version
-# flags to be left without arguments
-need_version=unknown
-
-case $host_os in
-aix3*)
- version_type=linux
- library_names_spec='${libname}${release}${shared_ext}$versuffix $libname.a'
- shlibpath_var=LIBPATH
-
- # AIX 3 has no versioning support, so we append a major version to the name.
- soname_spec='${libname}${release}${shared_ext}$major'
- ;;
-
-aix[[4-9]]*)
- version_type=linux
- need_lib_prefix=no
- need_version=no
- hardcode_into_libs=yes
- if test "$host_cpu" = ia64; then
- # AIX 5 supports IA64
- library_names_spec='${libname}${release}${shared_ext}$major ${libname}${release}${shared_ext}$versuffix $libname${shared_ext}'
- shlibpath_var=LD_LIBRARY_PATH
- else
- # With GCC up to 2.95.x, collect2 would create an import file
- # for dependence libraries. The import file would start with
- # the line `#! .'. This would cause the generated library to
- # depend on `.', always an invalid library. This was fixed in
- # development snapshots of GCC prior to 3.0.
- case $host_os in
- aix4 | aix4.[[01]] | aix4.[[01]].*)
- if { echo '#if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 97)'
- echo ' yes '
- echo '#endif'; } | ${CC} -E - | $GREP yes > /dev/null; then
- :
- else
- can_build_shared=no
- fi
- ;;
- esac
- # AIX (on Power*) has no versioning support, so currently we can not hardcode correct
- # soname into executable. Probably we can add versioning support to
- # collect2, so additional links can be useful in future.
- if test "$aix_use_runtimelinking" = yes; then
- # If using run time linking (on AIX 4.2 or later) use lib<name>.so
- # instead of lib<name>.a to let people know that these are not
- # typical AIX shared libraries.
- library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
- else
- # We preserve .a as extension for shared libraries through AIX4.2
- # and later when we are not doing run time linking.
- library_names_spec='${libname}${release}.a $libname.a'
- soname_spec='${libname}${release}${shared_ext}$major'
- fi
- shlibpath_var=LIBPATH
- fi
- ;;
-
-amigaos*)
- case $host_cpu in
- powerpc)
- # Since July 2007 AmigaOS4 officially supports .so libraries.
- # When compiling the executable, add -use-dynld -Lsobjs: to the compileline.
- library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
- ;;
- m68k)
- library_names_spec='$libname.ixlibrary $libname.a'
- # Create ${libname}_ixlibrary.a entries in /sys/libs.
- finish_eval='for lib in `ls $libdir/*.ixlibrary 2>/dev/null`; do libname=`$ECHO "X$lib" | $Xsed -e '\''s%^.*/\([[^/]]*\)\.ixlibrary$%\1%'\''`; test $RM /sys/libs/${libname}_ixlibrary.a; $show "cd /sys/libs && $LN_S $lib ${libname}_ixlibrary.a"; cd /sys/libs && $LN_S $lib ${libname}_ixlibrary.a || exit 1; done'
- ;;
- esac
- ;;
-
-beos*)
- library_names_spec='${libname}${shared_ext}'
- dynamic_linker="$host_os ld.so"
- shlibpath_var=LIBRARY_PATH
- ;;
-
-bsdi[[45]]*)
- version_type=linux
- need_version=no
- library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
- soname_spec='${libname}${release}${shared_ext}$major'
- finish_cmds='PATH="\$PATH:/sbin" ldconfig $libdir'
- shlibpath_var=LD_LIBRARY_PATH
- sys_lib_search_path_spec="/shlib /usr/lib /usr/X11/lib /usr/contrib/lib /lib /usr/local/lib"
- sys_lib_dlsearch_path_spec="/shlib /usr/lib /usr/local/lib"
- # the default ld.so.conf also contains /usr/contrib/lib and
- # /usr/X11R6/lib (/usr/X11 is a link to /usr/X11R6), but let us allow
- # libtool to hard-code these into programs
- ;;
-
-cygwin* | mingw* | pw32* | cegcc*)
- version_type=windows
- shrext_cmds=".dll"
- need_version=no
- need_lib_prefix=no
-
- case $GCC,$host_os in
- yes,cygwin* | yes,mingw* | yes,pw32* | yes,cegcc*)
- library_names_spec='$libname.dll.a'
- # DLL is installed to $(libdir)/../bin by postinstall_cmds
- postinstall_cmds='base_file=`basename \${file}`~
- dlpath=`$SHELL 2>&1 -c '\''. $dir/'\''\${base_file}'\''i; echo \$dlname'\''`~
- dldir=$destdir/`dirname \$dlpath`~
- test -d \$dldir || mkdir -p \$dldir~
- $install_prog $dir/$dlname \$dldir/$dlname~
- chmod a+x \$dldir/$dlname~
- if test -n '\''$stripme'\'' && test -n '\''$striplib'\''; then
- eval '\''$striplib \$dldir/$dlname'\'' || exit \$?;
- fi'
- postuninstall_cmds='dldll=`$SHELL 2>&1 -c '\''. $file; echo \$dlname'\''`~
- dlpath=$dir/\$dldll~
- $RM \$dlpath'
- shlibpath_overrides_runpath=yes
-
- case $host_os in
- cygwin*)
- # Cygwin DLLs use 'cyg' prefix rather than 'lib'
- soname_spec='`echo ${libname} | sed -e 's/^lib/cyg/'``echo ${release} | $SED -e 's/[[.]]/-/g'`${versuffix}${shared_ext}'
- sys_lib_search_path_spec="/usr/lib /lib/w32api /lib /usr/local/lib"
- ;;
- mingw* | cegcc*)
- # MinGW DLLs use traditional 'lib' prefix
- soname_spec='${libname}`echo ${release} | $SED -e 's/[[.]]/-/g'`${versuffix}${shared_ext}'
- sys_lib_search_path_spec=`$CC -print-search-dirs | $GREP "^libraries:" | $SED -e "s/^libraries://" -e "s,=/,/,g"`
- if $ECHO "$sys_lib_search_path_spec" | [$GREP ';[c-zC-Z]:/' >/dev/null]; then
- # It is most probably a Windows format PATH printed by
- # mingw gcc, but we are running on Cygwin. Gcc prints its search
- # path with ; separators, and with drive letters. We can handle the
- # drive letters (cygwin fileutils understands them), so leave them,
- # especially as we might pass files found there to a mingw objdump,
- # which wouldn't understand a cygwinified path. Ahh.
- sys_lib_search_path_spec=`$ECHO "$sys_lib_search_path_spec" | $SED -e 's/;/ /g'`
- else
- sys_lib_search_path_spec=`$ECHO "$sys_lib_search_path_spec" | $SED -e "s/$PATH_SEPARATOR/ /g"`
- fi
- ;;
- pw32*)
- # pw32 DLLs use 'pw' prefix rather than 'lib'
- library_names_spec='`echo ${libname} | sed -e 's/^lib/pw/'``echo ${release} | $SED -e 's/[[.]]/-/g'`${versuffix}${shared_ext}'
- ;;
- esac
- ;;
-
- *)
- library_names_spec='${libname}`echo ${release} | $SED -e 's/[[.]]/-/g'`${versuffix}${shared_ext} $libname.lib'
- ;;
- esac
- dynamic_linker='Win32 ld.exe'
- # FIXME: first we should search . and the directory the executable is in
- shlibpath_var=PATH
- ;;
-
-darwin* | rhapsody*)
- dynamic_linker="$host_os dyld"
- version_type=darwin
- need_lib_prefix=no
- need_version=no
- library_names_spec='${libname}${release}${major}$shared_ext ${libname}$shared_ext'
- soname_spec='${libname}${release}${major}$shared_ext'
- shlibpath_overrides_runpath=yes
- shlibpath_var=DYLD_LIBRARY_PATH
- shrext_cmds='`test .$module = .yes && echo .so || echo .dylib`'
-m4_if([$1], [],[
- sys_lib_search_path_spec="$sys_lib_search_path_spec /usr/local/lib"])
- sys_lib_dlsearch_path_spec='/usr/local/lib /lib /usr/lib'
- ;;
-
-dgux*)
- version_type=linux
- need_lib_prefix=no
- need_version=no
- library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname$shared_ext'
- soname_spec='${libname}${release}${shared_ext}$major'
- shlibpath_var=LD_LIBRARY_PATH
- ;;
-
-freebsd1*)
- dynamic_linker=no
- ;;
-
-freebsd* | dragonfly*)
- # DragonFly does not have aout. When/if they implement a new
- # versioning mechanism, adjust this.
- if test -x /usr/bin/objformat; then
- objformat=`/usr/bin/objformat`
- else
- case $host_os in
- freebsd[[123]]*) objformat=aout ;;
- *) objformat=elf ;;
- esac
- fi
- version_type=freebsd-$objformat
- case $version_type in
- freebsd-elf*)
- library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext} $libname${shared_ext}'
- need_version=no
- need_lib_prefix=no
- ;;
- freebsd-*)
- library_names_spec='${libname}${release}${shared_ext}$versuffix $libname${shared_ext}$versuffix'
- need_version=yes
- ;;
- esac
- shlibpath_var=LD_LIBRARY_PATH
- case $host_os in
- freebsd2*)
- shlibpath_overrides_runpath=yes
- ;;
- freebsd3.[[01]]* | freebsdelf3.[[01]]*)
- shlibpath_overrides_runpath=yes
- hardcode_into_libs=yes
- ;;
- freebsd3.[[2-9]]* | freebsdelf3.[[2-9]]* | \
- freebsd4.[[0-5]] | freebsdelf4.[[0-5]] | freebsd4.1.1 | freebsdelf4.1.1)
- shlibpath_overrides_runpath=no
- hardcode_into_libs=yes
- ;;
- *) # from 4.6 on, and DragonFly
- shlibpath_overrides_runpath=yes
- hardcode_into_libs=yes
- ;;
- esac
- ;;
-
-gnu*)
- version_type=linux
- need_lib_prefix=no
- need_version=no
- library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}${major} ${libname}${shared_ext}'
- soname_spec='${libname}${release}${shared_ext}$major'
- shlibpath_var=LD_LIBRARY_PATH
- hardcode_into_libs=yes
- ;;
-
-hpux9* | hpux10* | hpux11*)
- # Give a soname corresponding to the major version so that dld.sl refuses to
- # link against other versions.
- version_type=sunos
- need_lib_prefix=no
- need_version=no
- case $host_cpu in
- ia64*)
- shrext_cmds='.so'
- hardcode_into_libs=yes
- dynamic_linker="$host_os dld.so"
- shlibpath_var=LD_LIBRARY_PATH
- shlibpath_overrides_runpath=yes # Unless +noenvvar is specified.
- library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
- soname_spec='${libname}${release}${shared_ext}$major'
- if test "X$HPUX_IA64_MODE" = X32; then
- sys_lib_search_path_spec="/usr/lib/hpux32 /usr/local/lib/hpux32 /usr/local/lib"
- else
- sys_lib_search_path_spec="/usr/lib/hpux64 /usr/local/lib/hpux64"
- fi
- sys_lib_dlsearch_path_spec=$sys_lib_search_path_spec
- ;;
- hppa*64*)
- shrext_cmds='.sl'
- hardcode_into_libs=yes
- dynamic_linker="$host_os dld.sl"
- shlibpath_var=LD_LIBRARY_PATH # How should we handle SHLIB_PATH
- shlibpath_overrides_runpath=yes # Unless +noenvvar is specified.
- library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
- soname_spec='${libname}${release}${shared_ext}$major'
- sys_lib_search_path_spec="/usr/lib/pa20_64 /usr/ccs/lib/pa20_64"
- sys_lib_dlsearch_path_spec=$sys_lib_search_path_spec
- ;;
- *)
- shrext_cmds='.sl'
- dynamic_linker="$host_os dld.sl"
- shlibpath_var=SHLIB_PATH
- shlibpath_overrides_runpath=no # +s is required to enable SHLIB_PATH
- library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
- soname_spec='${libname}${release}${shared_ext}$major'
- ;;
- esac
- # HP-UX runs *really* slowly unless shared libraries are mode 555.
- postinstall_cmds='chmod 555 $lib'
- ;;
-
-interix[[3-9]]*)
- version_type=linux
- need_lib_prefix=no
- need_version=no
- library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major ${libname}${shared_ext}'
- soname_spec='${libname}${release}${shared_ext}$major'
- dynamic_linker='Interix 3.x ld.so.1 (PE, like ELF)'
- shlibpath_var=LD_LIBRARY_PATH
- shlibpath_overrides_runpath=no
- hardcode_into_libs=yes
- ;;
-
-irix5* | irix6* | nonstopux*)
- case $host_os in
- nonstopux*) version_type=nonstopux ;;
- *)
- if test "$lt_cv_prog_gnu_ld" = yes; then
- version_type=linux
- else
- version_type=irix
- fi ;;
- esac
- need_lib_prefix=no
- need_version=no
- soname_spec='${libname}${release}${shared_ext}$major'
- library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major ${libname}${release}${shared_ext} $libname${shared_ext}'
- case $host_os in
- irix5* | nonstopux*)
- libsuff= shlibsuff=
- ;;
- *)
- case $LD in # libtool.m4 will add one of these switches to LD
- *-32|*"-32 "|*-melf32bsmip|*"-melf32bsmip ")
- libsuff= shlibsuff= libmagic=32-bit;;
- *-n32|*"-n32 "|*-melf32bmipn32|*"-melf32bmipn32 ")
- libsuff=32 shlibsuff=N32 libmagic=N32;;
- *-64|*"-64 "|*-melf64bmip|*"-melf64bmip ")
- libsuff=64 shlibsuff=64 libmagic=64-bit;;
- *) libsuff= shlibsuff= libmagic=never-match;;
- esac
- ;;
- esac
- shlibpath_var=LD_LIBRARY${shlibsuff}_PATH
- shlibpath_overrides_runpath=no
- sys_lib_search_path_spec="/usr/lib${libsuff} /lib${libsuff} /usr/local/lib${libsuff}"
- sys_lib_dlsearch_path_spec="/usr/lib${libsuff} /lib${libsuff}"
- hardcode_into_libs=yes
- ;;
-
-# No shared lib support for Linux oldld, aout, or coff.
-linux*oldld* | linux*aout* | linux*coff*)
- dynamic_linker=no
- ;;
-
-# This must be Linux ELF.
-linux* | k*bsd*-gnu)
- version_type=linux
- need_lib_prefix=no
- need_version=no
- library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
- soname_spec='${libname}${release}${shared_ext}$major'
- finish_cmds='PATH="\$PATH:/sbin" ldconfig -n $libdir'
- shlibpath_var=LD_LIBRARY_PATH
- shlibpath_overrides_runpath=no
- # Some binutils ld are patched to set DT_RUNPATH
- save_LDFLAGS=$LDFLAGS
- save_libdir=$libdir
- eval "libdir=/foo; wl=\"$_LT_TAGVAR(lt_prog_compiler_wl, $1)\"; \
- LDFLAGS=\"\$LDFLAGS $_LT_TAGVAR(hardcode_libdir_flag_spec, $1)\""
- AC_LINK_IFELSE([AC_LANG_PROGRAM([],[])],
- [AS_IF([ ($OBJDUMP -p conftest$ac_exeext) 2>/dev/null | grep "RUNPATH.*$libdir" >/dev/null],
- [shlibpath_overrides_runpath=yes])])
- LDFLAGS=$save_LDFLAGS
- libdir=$save_libdir
-
- # This implies no fast_install, which is unacceptable.
- # Some rework will be needed to allow for fast_install
- # before this can be enabled.
- hardcode_into_libs=yes
-
- # Append ld.so.conf contents to the search path
- if test -f /etc/ld.so.conf; then
- lt_ld_extra=`awk '/^include / { system(sprintf("cd /etc; cat %s 2>/dev/null", \[$]2)); skip = 1; } { if (!skip) print \[$]0; skip = 0; }' < /etc/ld.so.conf | $SED -e 's/#.*//;/^[ ]*hwcap[ ]/d;s/[:, ]/ /g;s/=[^=]*$//;s/=[^= ]* / /g;/^$/d' | tr '\n' ' '`
- sys_lib_dlsearch_path_spec="/lib /usr/lib $lt_ld_extra"
- fi
-
- # We used to test for /lib/ld.so.1 and disable shared libraries on
- # powerpc, because MkLinux only supported shared libraries with the
- # GNU dynamic linker. Since this was broken with cross compilers,
- # most powerpc-linux boxes support dynamic linking these days and
- # people can always --disable-shared, the test was removed, and we
- # assume the GNU/Linux dynamic linker is in use.
- dynamic_linker='GNU/Linux ld.so'
- ;;
-
-netbsd*)
- version_type=sunos
- need_lib_prefix=no
- need_version=no
- if echo __ELF__ | $CC -E - | $GREP __ELF__ >/dev/null; then
- library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${shared_ext}$versuffix'
- finish_cmds='PATH="\$PATH:/sbin" ldconfig -m $libdir'
- dynamic_linker='NetBSD (a.out) ld.so'
- else
- library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major ${libname}${shared_ext}'
- soname_spec='${libname}${release}${shared_ext}$major'
- dynamic_linker='NetBSD ld.elf_so'
- fi
- shlibpath_var=LD_LIBRARY_PATH
- shlibpath_overrides_runpath=yes
- hardcode_into_libs=yes
- ;;
-
-newsos6)
- version_type=linux
- library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
- shlibpath_var=LD_LIBRARY_PATH
- shlibpath_overrides_runpath=yes
- ;;
-
-*nto* | *qnx*)
- version_type=qnx
- need_lib_prefix=no
- need_version=no
- library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
- soname_spec='${libname}${release}${shared_ext}$major'
- shlibpath_var=LD_LIBRARY_PATH
- shlibpath_overrides_runpath=no
- hardcode_into_libs=yes
- dynamic_linker='ldqnx.so'
- ;;
-
-openbsd*)
- version_type=sunos
- sys_lib_dlsearch_path_spec="/usr/lib"
- need_lib_prefix=no
- # Some older versions of OpenBSD (3.3 at least) *do* need versioned libs.
- case $host_os in
- openbsd3.3 | openbsd3.3.*) need_version=yes ;;
- *) need_version=no ;;
- esac
- library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${shared_ext}$versuffix'
- finish_cmds='PATH="\$PATH:/sbin" ldconfig -m $libdir'
- shlibpath_var=LD_LIBRARY_PATH
- if test -z "`echo __ELF__ | $CC -E - | $GREP __ELF__`" || test "$host_os-$host_cpu" = "openbsd2.8-powerpc"; then
- case $host_os in
- openbsd2.[[89]] | openbsd2.[[89]].*)
- shlibpath_overrides_runpath=no
- ;;
- *)
- shlibpath_overrides_runpath=yes
- ;;
- esac
- else
- shlibpath_overrides_runpath=yes
- fi
- ;;
-
-os2*)
- libname_spec='$name'
- shrext_cmds=".dll"
- need_lib_prefix=no
- library_names_spec='$libname${shared_ext} $libname.a'
- dynamic_linker='OS/2 ld.exe'
- shlibpath_var=LIBPATH
- ;;
-
-osf3* | osf4* | osf5*)
- version_type=osf
- need_lib_prefix=no
- need_version=no
- soname_spec='${libname}${release}${shared_ext}$major'
- library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
- shlibpath_var=LD_LIBRARY_PATH
- sys_lib_search_path_spec="/usr/shlib /usr/ccs/lib /usr/lib/cmplrs/cc /usr/lib /usr/local/lib /var/shlib"
- sys_lib_dlsearch_path_spec="$sys_lib_search_path_spec"
- ;;
-
-rdos*)
- dynamic_linker=no
- ;;
-
-solaris*)
- version_type=linux
- need_lib_prefix=no
- need_version=no
- library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
- soname_spec='${libname}${release}${shared_ext}$major'
- shlibpath_var=LD_LIBRARY_PATH
- shlibpath_overrides_runpath=yes
- hardcode_into_libs=yes
- # ldd complains unless libraries are executable
- postinstall_cmds='chmod +x $lib'
- ;;
-
-sunos4*)
- version_type=sunos
- library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${shared_ext}$versuffix'
- finish_cmds='PATH="\$PATH:/usr/etc" ldconfig $libdir'
- shlibpath_var=LD_LIBRARY_PATH
- shlibpath_overrides_runpath=yes
- if test "$with_gnu_ld" = yes; then
- need_lib_prefix=no
- fi
- need_version=yes
- ;;
-
-sysv4 | sysv4.3*)
- version_type=linux
- library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
- soname_spec='${libname}${release}${shared_ext}$major'
- shlibpath_var=LD_LIBRARY_PATH
- case $host_vendor in
- sni)
- shlibpath_overrides_runpath=no
- need_lib_prefix=no
- runpath_var=LD_RUN_PATH
- ;;
- siemens)
- need_lib_prefix=no
- ;;
- motorola)
- need_lib_prefix=no
- need_version=no
- shlibpath_overrides_runpath=no
- sys_lib_search_path_spec='/lib /usr/lib /usr/ccs/lib'
- ;;
- esac
- ;;
-
-sysv4*MP*)
- if test -d /usr/nec ;then
- version_type=linux
- library_names_spec='$libname${shared_ext}.$versuffix $libname${shared_ext}.$major $libname${shared_ext}'
- soname_spec='$libname${shared_ext}.$major'
- shlibpath_var=LD_LIBRARY_PATH
- fi
- ;;
-
-sysv5* | sco3.2v5* | sco5v6* | unixware* | OpenUNIX* | sysv4*uw2*)
- version_type=freebsd-elf
- need_lib_prefix=no
- need_version=no
- library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext} $libname${shared_ext}'
- soname_spec='${libname}${release}${shared_ext}$major'
- shlibpath_var=LD_LIBRARY_PATH
- shlibpath_overrides_runpath=yes
- hardcode_into_libs=yes
- if test "$with_gnu_ld" = yes; then
- sys_lib_search_path_spec='/usr/local/lib /usr/gnu/lib /usr/ccs/lib /usr/lib /lib'
- else
- sys_lib_search_path_spec='/usr/ccs/lib /usr/lib'
- case $host_os in
- sco3.2v5*)
- sys_lib_search_path_spec="$sys_lib_search_path_spec /lib"
- ;;
- esac
- fi
- sys_lib_dlsearch_path_spec='/usr/lib'
- ;;
-
-tpf*)
- # TPF is a cross-target only. Preferred cross-host = GNU/Linux.
- version_type=linux
- need_lib_prefix=no
- need_version=no
- library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
- shlibpath_var=LD_LIBRARY_PATH
- shlibpath_overrides_runpath=no
- hardcode_into_libs=yes
- ;;
-
-uts4*)
- version_type=linux
- library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
- soname_spec='${libname}${release}${shared_ext}$major'
- shlibpath_var=LD_LIBRARY_PATH
- ;;
-
-*)
- dynamic_linker=no
- ;;
-esac
-AC_MSG_RESULT([$dynamic_linker])
-test "$dynamic_linker" = no && can_build_shared=no
-
-variables_saved_for_relink="PATH $shlibpath_var $runpath_var"
-if test "$GCC" = yes; then
- variables_saved_for_relink="$variables_saved_for_relink GCC_EXEC_PREFIX COMPILER_PATH LIBRARY_PATH"
-fi
-
-if test "${lt_cv_sys_lib_search_path_spec+set}" = set; then
- sys_lib_search_path_spec="$lt_cv_sys_lib_search_path_spec"
-fi
-if test "${lt_cv_sys_lib_dlsearch_path_spec+set}" = set; then
- sys_lib_dlsearch_path_spec="$lt_cv_sys_lib_dlsearch_path_spec"
-fi
-
-_LT_DECL([], [variables_saved_for_relink], [1],
- [Variables whose values should be saved in libtool wrapper scripts and
- restored at link time])
-_LT_DECL([], [need_lib_prefix], [0],
- [Do we need the "lib" prefix for modules?])
-_LT_DECL([], [need_version], [0], [Do we need a version for libraries?])
-_LT_DECL([], [version_type], [0], [Library versioning type])
-_LT_DECL([], [runpath_var], [0], [Shared library runtime path variable])
-_LT_DECL([], [shlibpath_var], [0],[Shared library path variable])
-_LT_DECL([], [shlibpath_overrides_runpath], [0],
- [Is shlibpath searched before the hard-coded library search path?])
-_LT_DECL([], [libname_spec], [1], [Format of library name prefix])
-_LT_DECL([], [library_names_spec], [1],
- [[List of archive names. First name is the real one, the rest are links.
- The last name is the one that the linker finds with -lNAME]])
-_LT_DECL([], [soname_spec], [1],
- [[The coded name of the library, if different from the real name]])
-_LT_DECL([], [postinstall_cmds], [2],
- [Command to use after installation of a shared archive])
-_LT_DECL([], [postuninstall_cmds], [2],
- [Command to use after uninstallation of a shared archive])
-_LT_DECL([], [finish_cmds], [2],
- [Commands used to finish a libtool library installation in a directory])
-_LT_DECL([], [finish_eval], [1],
- [[As "finish_cmds", except a single script fragment to be evaled but
- not shown]])
-_LT_DECL([], [hardcode_into_libs], [0],
- [Whether we should hardcode library paths into libraries])
-_LT_DECL([], [sys_lib_search_path_spec], [2],
- [Compile-time system search path for libraries])
-_LT_DECL([], [sys_lib_dlsearch_path_spec], [2],
- [Run-time system search path for libraries])
-])# _LT_SYS_DYNAMIC_LINKER
-
-
-# _LT_PATH_TOOL_PREFIX(TOOL)
-# --------------------------
-# find a file program which can recognize shared library
-AC_DEFUN([_LT_PATH_TOOL_PREFIX],
-[m4_require([_LT_DECL_EGREP])dnl
-AC_MSG_CHECKING([for $1])
-AC_CACHE_VAL(lt_cv_path_MAGIC_CMD,
-[case $MAGIC_CMD in
-[[\\/*] | ?:[\\/]*])
- lt_cv_path_MAGIC_CMD="$MAGIC_CMD" # Let the user override the test with a path.
- ;;
-*)
- lt_save_MAGIC_CMD="$MAGIC_CMD"
- lt_save_ifs="$IFS"; IFS=$PATH_SEPARATOR
-dnl $ac_dummy forces splitting on constant user-supplied paths.
-dnl POSIX.2 word splitting is done only on the output of word expansions,
-dnl not every word. This closes a longstanding sh security hole.
- ac_dummy="m4_if([$2], , $PATH, [$2])"
- for ac_dir in $ac_dummy; do
- IFS="$lt_save_ifs"
- test -z "$ac_dir" && ac_dir=.
- if test -f $ac_dir/$1; then
- lt_cv_path_MAGIC_CMD="$ac_dir/$1"
- if test -n "$file_magic_test_file"; then
- case $deplibs_check_method in
- "file_magic "*)
- file_magic_regex=`expr "$deplibs_check_method" : "file_magic \(.*\)"`
- MAGIC_CMD="$lt_cv_path_MAGIC_CMD"
- if eval $file_magic_cmd \$file_magic_test_file 2> /dev/null |
- $EGREP "$file_magic_regex" > /dev/null; then
- :
- else
- cat <<_LT_EOF 1>&2
-
-*** Warning: the command libtool uses to detect shared libraries,
-*** $file_magic_cmd, produces output that libtool cannot recognize.
-*** The result is that libtool may fail to recognize shared libraries
-*** as such. This will affect the creation of libtool libraries that
-*** depend on shared libraries, but programs linked with such libtool
-*** libraries will work regardless of this problem. Nevertheless, you
-*** may want to report the problem to your system manager and/or to
-*** bug-libtool@gnu.org
-
-_LT_EOF
- fi ;;
- esac
- fi
- break
- fi
- done
- IFS="$lt_save_ifs"
- MAGIC_CMD="$lt_save_MAGIC_CMD"
- ;;
-esac])
-MAGIC_CMD="$lt_cv_path_MAGIC_CMD"
-if test -n "$MAGIC_CMD"; then
- AC_MSG_RESULT($MAGIC_CMD)
-else
- AC_MSG_RESULT(no)
-fi
-_LT_DECL([], [MAGIC_CMD], [0],
- [Used to examine libraries when file_magic_cmd begins with "file"])dnl
-])# _LT_PATH_TOOL_PREFIX
-
-# Old name:
-AU_ALIAS([AC_PATH_TOOL_PREFIX], [_LT_PATH_TOOL_PREFIX])
-dnl aclocal-1.4 backwards compatibility:
-dnl AC_DEFUN([AC_PATH_TOOL_PREFIX], [])
-
-
-# _LT_PATH_MAGIC
-# --------------
-# find a file program which can recognize a shared library
-m4_defun([_LT_PATH_MAGIC],
-[_LT_PATH_TOOL_PREFIX(${ac_tool_prefix}file, /usr/bin$PATH_SEPARATOR$PATH)
-if test -z "$lt_cv_path_MAGIC_CMD"; then
- if test -n "$ac_tool_prefix"; then
- _LT_PATH_TOOL_PREFIX(file, /usr/bin$PATH_SEPARATOR$PATH)
- else
- MAGIC_CMD=:
- fi
-fi
-])# _LT_PATH_MAGIC
-
-
-# LT_PATH_LD
-# ----------
-# find the pathname to the GNU or non-GNU linker
-AC_DEFUN([LT_PATH_LD],
-[AC_REQUIRE([AC_PROG_CC])dnl
-AC_REQUIRE([AC_CANONICAL_HOST])dnl
-AC_REQUIRE([AC_CANONICAL_BUILD])dnl
-m4_require([_LT_DECL_SED])dnl
-m4_require([_LT_DECL_EGREP])dnl
-
-AC_ARG_WITH([gnu-ld],
- [AS_HELP_STRING([--with-gnu-ld],
- [assume the C compiler uses GNU ld @<:@default=no@:>@])],
- [test "$withval" = no || with_gnu_ld=yes],
- [with_gnu_ld=no])dnl
-
-ac_prog=ld
-if test "$GCC" = yes; then
- # Check if gcc -print-prog-name=ld gives a path.
- AC_MSG_CHECKING([for ld used by $CC])
- case $host in
- *-*-mingw*)
- # gcc leaves a trailing carriage return which upsets mingw
- ac_prog=`($CC -print-prog-name=ld) 2>&5 | tr -d '\015'` ;;
- *)
- ac_prog=`($CC -print-prog-name=ld) 2>&5` ;;
- esac
- case $ac_prog in
- # Accept absolute paths.
- [[\\/]]* | ?:[[\\/]]*)
- re_direlt='/[[^/]][[^/]]*/\.\./'
- # Canonicalize the pathname of ld
- ac_prog=`$ECHO "$ac_prog"| $SED 's%\\\\%/%g'`
- while $ECHO "$ac_prog" | $GREP "$re_direlt" > /dev/null 2>&1; do
- ac_prog=`$ECHO $ac_prog| $SED "s%$re_direlt%/%"`
- done
- test -z "$LD" && LD="$ac_prog"
- ;;
- "")
- # If it fails, then pretend we aren't using GCC.
- ac_prog=ld
- ;;
- *)
- # If it is relative, then search for the first ld in PATH.
- with_gnu_ld=unknown
- ;;
- esac
-elif test "$with_gnu_ld" = yes; then
- AC_MSG_CHECKING([for GNU ld])
-else
- AC_MSG_CHECKING([for non-GNU ld])
-fi
-AC_CACHE_VAL(lt_cv_path_LD,
-[if test -z "$LD"; then
- lt_save_ifs="$IFS"; IFS=$PATH_SEPARATOR
- for ac_dir in $PATH; do
- IFS="$lt_save_ifs"
- test -z "$ac_dir" && ac_dir=.
- if test -f "$ac_dir/$ac_prog" || test -f "$ac_dir/$ac_prog$ac_exeext"; then
- lt_cv_path_LD="$ac_dir/$ac_prog"
- # Check to see if the program is GNU ld. I'd rather use --version,
- # but apparently some variants of GNU ld only accept -v.
- # Break only if it was the GNU/non-GNU ld that we prefer.
- case `"$lt_cv_path_LD" -v 2>&1 </dev/null` in
- *GNU* | *'with BFD'*)
- test "$with_gnu_ld" != no && break
- ;;
- *)
- test "$with_gnu_ld" != yes && break
- ;;
- esac
- fi
- done
- IFS="$lt_save_ifs"
-else
- lt_cv_path_LD="$LD" # Let the user override the test with a path.
-fi])
-LD="$lt_cv_path_LD"
-if test -n "$LD"; then
- AC_MSG_RESULT($LD)
-else
- AC_MSG_RESULT(no)
-fi
-test -z "$LD" && AC_MSG_ERROR([no acceptable ld found in \$PATH])
-_LT_PATH_LD_GNU
-AC_SUBST([LD])
-
-_LT_TAGDECL([], [LD], [1], [The linker used to build libraries])
-])# LT_PATH_LD
-
-# Old names:
-AU_ALIAS([AM_PROG_LD], [LT_PATH_LD])
-AU_ALIAS([AC_PROG_LD], [LT_PATH_LD])
-dnl aclocal-1.4 backwards compatibility:
-dnl AC_DEFUN([AM_PROG_LD], [])
-dnl AC_DEFUN([AC_PROG_LD], [])
-
-
-# _LT_PATH_LD_GNU
-#- --------------
-m4_defun([_LT_PATH_LD_GNU],
-[AC_CACHE_CHECK([if the linker ($LD) is GNU ld], lt_cv_prog_gnu_ld,
-[# I'd rather use --version here, but apparently some GNU lds only accept -v.
-case `$LD -v 2>&1 </dev/null` in
-*GNU* | *'with BFD'*)
- lt_cv_prog_gnu_ld=yes
- ;;
-*)
- lt_cv_prog_gnu_ld=no
- ;;
-esac])
-with_gnu_ld=$lt_cv_prog_gnu_ld
-])# _LT_PATH_LD_GNU
-
-
-# _LT_CMD_RELOAD
-# --------------
-# find reload flag for linker
-# -- PORTME Some linkers may need a different reload flag.
-m4_defun([_LT_CMD_RELOAD],
-[AC_CACHE_CHECK([for $LD option to reload object files],
- lt_cv_ld_reload_flag,
- [lt_cv_ld_reload_flag='-r'])
-reload_flag=$lt_cv_ld_reload_flag
-case $reload_flag in
-"" | " "*) ;;
-*) reload_flag=" $reload_flag" ;;
-esac
-reload_cmds='$LD$reload_flag -o $output$reload_objs'
-case $host_os in
- darwin*)
- if test "$GCC" = yes; then
- reload_cmds='$LTCC $LTCFLAGS -nostdlib ${wl}-r -o $output$reload_objs'
- else
- reload_cmds='$LD$reload_flag -o $output$reload_objs'
- fi
- ;;
-esac
-_LT_DECL([], [reload_flag], [1], [How to create reloadable object files])dnl
-_LT_DECL([], [reload_cmds], [2])dnl
-])# _LT_CMD_RELOAD
-
-
-# _LT_CHECK_MAGIC_METHOD
-# ----------------------
-# how to check for library dependencies
-# -- PORTME fill in with the dynamic library characteristics
-m4_defun([_LT_CHECK_MAGIC_METHOD],
-[m4_require([_LT_DECL_EGREP])
-m4_require([_LT_DECL_OBJDUMP])
-AC_CACHE_CHECK([how to recognize dependent libraries],
-lt_cv_deplibs_check_method,
-[lt_cv_file_magic_cmd='$MAGIC_CMD'
-lt_cv_file_magic_test_file=
-lt_cv_deplibs_check_method='unknown'
-# Need to set the preceding variable on all platforms that support
-# interlibrary dependencies.
-# 'none' -- dependencies not supported.
-# `unknown' -- same as none, but documents that we really don't know.
-# 'pass_all' -- all dependencies passed with no checks.
-# 'test_compile' -- check by making test program.
-# 'file_magic [[regex]]' -- check by looking for files in library path
-# which responds to the $file_magic_cmd with a given extended regex.
-# If you have `file' or equivalent on your system and you're not sure
-# whether `pass_all' will *always* work, you probably want this one.
-
-case $host_os in
-aix[[4-9]]*)
- lt_cv_deplibs_check_method=pass_all
- ;;
-
-beos*)
- lt_cv_deplibs_check_method=pass_all
- ;;
-
-bsdi[[45]]*)
- lt_cv_deplibs_check_method='file_magic ELF [[0-9]][[0-9]]*-bit [[ML]]SB (shared object|dynamic lib)'
- lt_cv_file_magic_cmd='/usr/bin/file -L'
- lt_cv_file_magic_test_file=/shlib/libc.so
- ;;
-
-cygwin*)
- # func_win32_libid is a shell function defined in ltmain.sh
- lt_cv_deplibs_check_method='file_magic ^x86 archive import|^x86 DLL'
- lt_cv_file_magic_cmd='func_win32_libid'
- ;;
-
-mingw* | pw32*)
- # Base MSYS/MinGW do not provide the 'file' command needed by
- # func_win32_libid shell function, so use a weaker test based on 'objdump',
- # unless we find 'file', for example because we are cross-compiling.
- if ( file / ) >/dev/null 2>&1; then
- lt_cv_deplibs_check_method='file_magic ^x86 archive import|^x86 DLL'
- lt_cv_file_magic_cmd='func_win32_libid'
- else
- lt_cv_deplibs_check_method='file_magic file format pei*-i386(.*architecture: i386)?'
- lt_cv_file_magic_cmd='$OBJDUMP -f'
- fi
- ;;
-
-cegcc)
- # use the weaker test based on 'objdump'. See mingw*.
- lt_cv_deplibs_check_method='file_magic file format pe-arm-.*little(.*architecture: arm)?'
- lt_cv_file_magic_cmd='$OBJDUMP -f'
- ;;
-
-darwin* | rhapsody*)
- lt_cv_deplibs_check_method=pass_all
- ;;
-
-freebsd* | dragonfly*)
- if echo __ELF__ | $CC -E - | $GREP __ELF__ > /dev/null; then
- case $host_cpu in
- i*86 )
- # Not sure whether the presence of OpenBSD here was a mistake.
- # Let's accept both of them until this is cleared up.
- lt_cv_deplibs_check_method='file_magic (FreeBSD|OpenBSD|DragonFly)/i[[3-9]]86 (compact )?demand paged shared library'
- lt_cv_file_magic_cmd=/usr/bin/file
- lt_cv_file_magic_test_file=`echo /usr/lib/libc.so.*`
- ;;
- esac
- else
- lt_cv_deplibs_check_method=pass_all
- fi
- ;;
-
-gnu*)
- lt_cv_deplibs_check_method=pass_all
- ;;
-
-hpux10.20* | hpux11*)
- lt_cv_file_magic_cmd=/usr/bin/file
- case $host_cpu in
- ia64*)
- lt_cv_deplibs_check_method='file_magic (s[[0-9]][[0-9]][[0-9]]|ELF-[[0-9]][[0-9]]) shared object file - IA64'
- lt_cv_file_magic_test_file=/usr/lib/hpux32/libc.so
- ;;
- hppa*64*)
- [lt_cv_deplibs_check_method='file_magic (s[0-9][0-9][0-9]|ELF-[0-9][0-9]) shared object file - PA-RISC [0-9].[0-9]']
- lt_cv_file_magic_test_file=/usr/lib/pa20_64/libc.sl
- ;;
- *)
- lt_cv_deplibs_check_method='file_magic (s[[0-9]][[0-9]][[0-9]]|PA-RISC[[0-9]].[[0-9]]) shared library'
- lt_cv_file_magic_test_file=/usr/lib/libc.sl
- ;;
- esac
- ;;
-
-interix[[3-9]]*)
- # PIC code is broken on Interix 3.x, that's why |\.a not |_pic\.a here
- lt_cv_deplibs_check_method='match_pattern /lib[[^/]]+(\.so|\.a)$'
- ;;
-
-irix5* | irix6* | nonstopux*)
- case $LD in
- *-32|*"-32 ") libmagic=32-bit;;
- *-n32|*"-n32 ") libmagic=N32;;
- *-64|*"-64 ") libmagic=64-bit;;
- *) libmagic=never-match;;
- esac
- lt_cv_deplibs_check_method=pass_all
- ;;
-
-# This must be Linux ELF.
-linux* | k*bsd*-gnu)
- lt_cv_deplibs_check_method=pass_all
- ;;
-
-netbsd*)
- if echo __ELF__ | $CC -E - | $GREP __ELF__ > /dev/null; then
- lt_cv_deplibs_check_method='match_pattern /lib[[^/]]+(\.so\.[[0-9]]+\.[[0-9]]+|_pic\.a)$'
- else
- lt_cv_deplibs_check_method='match_pattern /lib[[^/]]+(\.so|_pic\.a)$'
- fi
- ;;
-
-newos6*)
- lt_cv_deplibs_check_method='file_magic ELF [[0-9]][[0-9]]*-bit [[ML]]SB (executable|dynamic lib)'
- lt_cv_file_magic_cmd=/usr/bin/file
- lt_cv_file_magic_test_file=/usr/lib/libnls.so
- ;;
-
-*nto* | *qnx*)
- lt_cv_deplibs_check_method=pass_all
- ;;
-
-openbsd*)
- if test -z "`echo __ELF__ | $CC -E - | $GREP __ELF__`" || test "$host_os-$host_cpu" = "openbsd2.8-powerpc"; then
- lt_cv_deplibs_check_method='match_pattern /lib[[^/]]+(\.so\.[[0-9]]+\.[[0-9]]+|\.so|_pic\.a)$'
- else
- lt_cv_deplibs_check_method='match_pattern /lib[[^/]]+(\.so\.[[0-9]]+\.[[0-9]]+|_pic\.a)$'
- fi
- ;;
-
-osf3* | osf4* | osf5*)
- lt_cv_deplibs_check_method=pass_all
- ;;
-
-rdos*)
- lt_cv_deplibs_check_method=pass_all
- ;;
-
-solaris*)
- lt_cv_deplibs_check_method=pass_all
- ;;
-
-sysv5* | sco3.2v5* | sco5v6* | unixware* | OpenUNIX* | sysv4*uw2*)
- lt_cv_deplibs_check_method=pass_all
- ;;
-
-sysv4 | sysv4.3*)
- case $host_vendor in
- motorola)
- lt_cv_deplibs_check_method='file_magic ELF [[0-9]][[0-9]]*-bit [[ML]]SB (shared object|dynamic lib) M[[0-9]][[0-9]]* Version [[0-9]]'
- lt_cv_file_magic_test_file=`echo /usr/lib/libc.so*`
- ;;
- ncr)
- lt_cv_deplibs_check_method=pass_all
- ;;
- sequent)
- lt_cv_file_magic_cmd='/bin/file'
- lt_cv_deplibs_check_method='file_magic ELF [[0-9]][[0-9]]*-bit [[LM]]SB (shared object|dynamic lib )'
- ;;
- sni)
- lt_cv_file_magic_cmd='/bin/file'
- lt_cv_deplibs_check_method="file_magic ELF [[0-9]][[0-9]]*-bit [[LM]]SB dynamic lib"
- lt_cv_file_magic_test_file=/lib/libc.so
- ;;
- siemens)
- lt_cv_deplibs_check_method=pass_all
- ;;
- pc)
- lt_cv_deplibs_check_method=pass_all
- ;;
- esac
- ;;
-
-tpf*)
- lt_cv_deplibs_check_method=pass_all
- ;;
-esac
-])
-file_magic_cmd=$lt_cv_file_magic_cmd
-deplibs_check_method=$lt_cv_deplibs_check_method
-test -z "$deplibs_check_method" && deplibs_check_method=unknown
-
-_LT_DECL([], [deplibs_check_method], [1],
- [Method to check whether dependent libraries are shared objects])
-_LT_DECL([], [file_magic_cmd], [1],
- [Command to use when deplibs_check_method == "file_magic"])
-])# _LT_CHECK_MAGIC_METHOD
-
-
-# LT_PATH_NM
-# ----------
-# find the pathname to a BSD- or MS-compatible name lister
-AC_DEFUN([LT_PATH_NM],
-[AC_REQUIRE([AC_PROG_CC])dnl
-AC_CACHE_CHECK([for BSD- or MS-compatible name lister (nm)], lt_cv_path_NM,
-[if test -n "$NM"; then
- # Let the user override the test.
- lt_cv_path_NM="$NM"
-else
- lt_nm_to_check="${ac_tool_prefix}nm"
- if test -n "$ac_tool_prefix" && test "$build" = "$host"; then
- lt_nm_to_check="$lt_nm_to_check nm"
- fi
- for lt_tmp_nm in $lt_nm_to_check; do
- lt_save_ifs="$IFS"; IFS=$PATH_SEPARATOR
- for ac_dir in $PATH /usr/ccs/bin/elf /usr/ccs/bin /usr/ucb /bin; do
- IFS="$lt_save_ifs"
- test -z "$ac_dir" && ac_dir=.
- tmp_nm="$ac_dir/$lt_tmp_nm"
- if test -f "$tmp_nm" || test -f "$tmp_nm$ac_exeext" ; then
- # Check to see if the nm accepts a BSD-compat flag.
- # Adding the `sed 1q' prevents false positives on HP-UX, which says:
- # nm: unknown option "B" ignored
- # Tru64's nm complains that /dev/null is an invalid object file
- case `"$tmp_nm" -B /dev/null 2>&1 | sed '1q'` in
- */dev/null* | *'Invalid file or object type'*)
- lt_cv_path_NM="$tmp_nm -B"
- break
- ;;
- *)
- case `"$tmp_nm" -p /dev/null 2>&1 | sed '1q'` in
- */dev/null*)
- lt_cv_path_NM="$tmp_nm -p"
- break
- ;;
- *)
- lt_cv_path_NM=${lt_cv_path_NM="$tmp_nm"} # keep the first match, but
- continue # so that we can try to find one that supports BSD flags
- ;;
- esac
- ;;
- esac
- fi
- done
- IFS="$lt_save_ifs"
- done
- : ${lt_cv_path_NM=no}
-fi])
-if test "$lt_cv_path_NM" != "no"; then
- NM="$lt_cv_path_NM"
-else
- # Didn't find any BSD compatible name lister, look for dumpbin.
- AC_CHECK_TOOLS(DUMPBIN, ["dumpbin -symbols" "link -dump -symbols"], :)
- AC_SUBST([DUMPBIN])
- if test "$DUMPBIN" != ":"; then
- NM="$DUMPBIN"
- fi
-fi
-test -z "$NM" && NM=nm
-AC_SUBST([NM])
-_LT_DECL([], [NM], [1], [A BSD- or MS-compatible name lister])dnl
-
-AC_CACHE_CHECK([the name lister ($NM) interface], [lt_cv_nm_interface],
- [lt_cv_nm_interface="BSD nm"
- echo "int some_variable = 0;" > conftest.$ac_ext
- (eval echo "\"\$as_me:__oline__: $ac_compile\"" >&AS_MESSAGE_LOG_FD)
- (eval "$ac_compile" 2>conftest.err)
- cat conftest.err >&AS_MESSAGE_LOG_FD
- (eval echo "\"\$as_me:__oline__: $NM \\\"conftest.$ac_objext\\\"\"" >&AS_MESSAGE_LOG_FD)
- (eval "$NM \"conftest.$ac_objext\"" 2>conftest.err > conftest.out)
- cat conftest.err >&AS_MESSAGE_LOG_FD
- (eval echo "\"\$as_me:__oline__: output\"" >&AS_MESSAGE_LOG_FD)
- cat conftest.out >&AS_MESSAGE_LOG_FD
- if $GREP 'External.*some_variable' conftest.out > /dev/null; then
- lt_cv_nm_interface="MS dumpbin"
- fi
- rm -f conftest*])
-])# LT_PATH_NM
-
-# Old names:
-AU_ALIAS([AM_PROG_NM], [LT_PATH_NM])
-AU_ALIAS([AC_PROG_NM], [LT_PATH_NM])
-dnl aclocal-1.4 backwards compatibility:
-dnl AC_DEFUN([AM_PROG_NM], [])
-dnl AC_DEFUN([AC_PROG_NM], [])
-
-
-# LT_LIB_M
-# --------
-# check for math library
-AC_DEFUN([LT_LIB_M],
-[AC_REQUIRE([AC_CANONICAL_HOST])dnl
-LIBM=
-case $host in
-*-*-beos* | *-*-cygwin* | *-*-pw32* | *-*-darwin*)
- # These system don't have libm, or don't need it
- ;;
-*-ncr-sysv4.3*)
- AC_CHECK_LIB(mw, _mwvalidcheckl, LIBM="-lmw")
- AC_CHECK_LIB(m, cos, LIBM="$LIBM -lm")
- ;;
-*)
- AC_CHECK_LIB(m, cos, LIBM="-lm")
- ;;
-esac
-AC_SUBST([LIBM])
-])# LT_LIB_M
-
-# Old name:
-AU_ALIAS([AC_CHECK_LIBM], [LT_LIB_M])
-dnl aclocal-1.4 backwards compatibility:
-dnl AC_DEFUN([AC_CHECK_LIBM], [])
-
-
-# _LT_COMPILER_NO_RTTI([TAGNAME])
-# -------------------------------
-m4_defun([_LT_COMPILER_NO_RTTI],
-[m4_require([_LT_TAG_COMPILER])dnl
-
-_LT_TAGVAR(lt_prog_compiler_no_builtin_flag, $1)=
-
-if test "$GCC" = yes; then
- _LT_TAGVAR(lt_prog_compiler_no_builtin_flag, $1)=' -fno-builtin'
-
- _LT_COMPILER_OPTION([if $compiler supports -fno-rtti -fno-exceptions],
- lt_cv_prog_compiler_rtti_exceptions,
- [-fno-rtti -fno-exceptions], [],
- [_LT_TAGVAR(lt_prog_compiler_no_builtin_flag, $1)="$_LT_TAGVAR(lt_prog_compiler_no_builtin_flag, $1) -fno-rtti -fno-exceptions"])
-fi
-_LT_TAGDECL([no_builtin_flag], [lt_prog_compiler_no_builtin_flag], [1],
- [Compiler flag to turn off builtin functions])
-])# _LT_COMPILER_NO_RTTI
-
-
-# _LT_CMD_GLOBAL_SYMBOLS
-# ----------------------
-m4_defun([_LT_CMD_GLOBAL_SYMBOLS],
-[AC_REQUIRE([AC_CANONICAL_HOST])dnl
-AC_REQUIRE([AC_PROG_CC])dnl
-AC_REQUIRE([LT_PATH_NM])dnl
-AC_REQUIRE([LT_PATH_LD])dnl
-m4_require([_LT_DECL_SED])dnl
-m4_require([_LT_DECL_EGREP])dnl
-m4_require([_LT_TAG_COMPILER])dnl
-
-# Check for command to grab the raw symbol name followed by C symbol from nm.
-AC_MSG_CHECKING([command to parse $NM output from $compiler object])
-AC_CACHE_VAL([lt_cv_sys_global_symbol_pipe],
-[
-# These are sane defaults that work on at least a few old systems.
-# [They come from Ultrix. What could be older than Ultrix?!! ;)]
-
-# Character class describing NM global symbol codes.
-symcode='[[BCDEGRST]]'
-
-# Regexp to match symbols that can be accessed directly from C.
-sympat='\([[_A-Za-z]][[_A-Za-z0-9]]*\)'
-
-# Define system-specific variables.
-case $host_os in
-aix*)
- symcode='[[BCDT]]'
- ;;
-cygwin* | mingw* | pw32* | cegcc*)
- symcode='[[ABCDGISTW]]'
- ;;
-hpux*)
- if test "$host_cpu" = ia64; then
- symcode='[[ABCDEGRST]]'
- fi
- ;;
-irix* | nonstopux*)
- symcode='[[BCDEGRST]]'
- ;;
-osf*)
- symcode='[[BCDEGQRST]]'
- ;;
-solaris*)
- symcode='[[BDRT]]'
- ;;
-sco3.2v5*)
- symcode='[[DT]]'
- ;;
-sysv4.2uw2*)
- symcode='[[DT]]'
- ;;
-sysv5* | sco5v6* | unixware* | OpenUNIX*)
- symcode='[[ABDT]]'
- ;;
-sysv4)
- symcode='[[DFNSTU]]'
- ;;
-esac
-
-# If we're using GNU nm, then use its standard symbol codes.
-case `$NM -V 2>&1` in
-*GNU* | *'with BFD'*)
- symcode='[[ABCDGIRSTW]]' ;;
-esac
-
-# Transform an extracted symbol line into a proper C declaration.
-# Some systems (esp. on ia64) link data and code symbols differently,
-# so use this general approach.
-lt_cv_sys_global_symbol_to_cdecl="sed -n -e 's/^T .* \(.*\)$/extern int \1();/p' -e 's/^$symcode* .* \(.*\)$/extern char \1;/p'"
-
-# Transform an extracted symbol line into symbol name and symbol address
-lt_cv_sys_global_symbol_to_c_name_address="sed -n -e 's/^: \([[^ ]]*\) $/ {\\\"\1\\\", (void *) 0},/p' -e 's/^$symcode* \([[^ ]]*\) \([[^ ]]*\)$/ {\"\2\", (void *) \&\2},/p'"
-lt_cv_sys_global_symbol_to_c_name_address_lib_prefix="sed -n -e 's/^: \([[^ ]]*\) $/ {\\\"\1\\\", (void *) 0},/p' -e 's/^$symcode* \([[^ ]]*\) \(lib[[^ ]]*\)$/ {\"\2\", (void *) \&\2},/p' -e 's/^$symcode* \([[^ ]]*\) \([[^ ]]*\)$/ {\"lib\2\", (void *) \&\2},/p'"
-
-# Handle CRLF in mingw tool chain
-opt_cr=
-case $build_os in
-mingw*)
- opt_cr=`$ECHO 'x\{0,1\}' | tr x '\015'` # option cr in regexp
- ;;
-esac
-
-# Try without a prefix underscore, then with it.
-for ac_symprfx in "" "_"; do
-
- # Transform symcode, sympat, and symprfx into a raw symbol and a C symbol.
- symxfrm="\\1 $ac_symprfx\\2 \\2"
-
- # Write the raw and C identifiers.
- if test "$lt_cv_nm_interface" = "MS dumpbin"; then
- # Fake it for dumpbin and say T for any non-static function
- # and D for any global variable.
- # Also find C++ and __fastcall symbols from MSVC++,
- # which start with @ or ?.
- lt_cv_sys_global_symbol_pipe="$AWK ['"\
-" {last_section=section; section=\$ 3};"\
-" /Section length .*#relocs.*(pick any)/{hide[last_section]=1};"\
-" \$ 0!~/External *\|/{next};"\
-" / 0+ UNDEF /{next}; / UNDEF \([^|]\)*()/{next};"\
-" {if(hide[section]) next};"\
-" {f=0}; \$ 0~/\(\).*\|/{f=1}; {printf f ? \"T \" : \"D \"};"\
-" {split(\$ 0, a, /\||\r/); split(a[2], s)};"\
-" s[1]~/^[@?]/{print s[1], s[1]; next};"\
-" s[1]~prfx {split(s[1],t,\"@\"); print t[1], substr(t[1],length(prfx))}"\
-" ' prfx=^$ac_symprfx]"
- else
- lt_cv_sys_global_symbol_pipe="sed -n -e 's/^.*[[ ]]\($symcode$symcode*\)[[ ]][[ ]]*$ac_symprfx$sympat$opt_cr$/$symxfrm/p'"
- fi
-
- # Check to see that the pipe works correctly.
- pipe_works=no
-
- rm -f conftest*
- cat > conftest.$ac_ext <<_LT_EOF
-#ifdef __cplusplus
-extern "C" {
-#endif
-char nm_test_var;
-void nm_test_func(void);
-void nm_test_func(void){}
-#ifdef __cplusplus
-}
-#endif
-int main(){nm_test_var='a';nm_test_func();return(0);}
-_LT_EOF
-
- if AC_TRY_EVAL(ac_compile); then
- # Now try to grab the symbols.
- nlist=conftest.nm
- if AC_TRY_EVAL(NM conftest.$ac_objext \| $lt_cv_sys_global_symbol_pipe \> $nlist) && test -s "$nlist"; then
- # Try sorting and uniquifying the output.
- if sort "$nlist" | uniq > "$nlist"T; then
- mv -f "$nlist"T "$nlist"
- else
- rm -f "$nlist"T
- fi
-
- # Make sure that we snagged all the symbols we need.
- if $GREP ' nm_test_var$' "$nlist" >/dev/null; then
- if $GREP ' nm_test_func$' "$nlist" >/dev/null; then
- cat <<_LT_EOF > conftest.$ac_ext
-#ifdef __cplusplus
-extern "C" {
-#endif
-
-_LT_EOF
- # Now generate the symbol file.
- eval "$lt_cv_sys_global_symbol_to_cdecl"' < "$nlist" | $GREP -v main >> conftest.$ac_ext'
-
- cat <<_LT_EOF >> conftest.$ac_ext
-
-/* The mapping between symbol names and symbols. */
-const struct {
- const char *name;
- void *address;
-}
-lt__PROGRAM__LTX_preloaded_symbols[[]] =
-{
- { "@PROGRAM@", (void *) 0 },
-_LT_EOF
- $SED "s/^$symcode$symcode* \(.*\) \(.*\)$/ {\"\2\", (void *) \&\2},/" < "$nlist" | $GREP -v main >> conftest.$ac_ext
- cat <<\_LT_EOF >> conftest.$ac_ext
- {0, (void *) 0}
-};
-
-/* This works around a problem in FreeBSD linker */
-#ifdef FREEBSD_WORKAROUND
-static const void *lt_preloaded_setup() {
- return lt__PROGRAM__LTX_preloaded_symbols;
-}
-#endif
-
-#ifdef __cplusplus
-}
-#endif
-_LT_EOF
- # Now try linking the two files.
- mv conftest.$ac_objext conftstm.$ac_objext
- lt_save_LIBS="$LIBS"
- lt_save_CFLAGS="$CFLAGS"
- LIBS="conftstm.$ac_objext"
- CFLAGS="$CFLAGS$_LT_TAGVAR(lt_prog_compiler_no_builtin_flag, $1)"
- if AC_TRY_EVAL(ac_link) && test -s conftest${ac_exeext}; then
- pipe_works=yes
- fi
- LIBS="$lt_save_LIBS"
- CFLAGS="$lt_save_CFLAGS"
- else
- echo "cannot find nm_test_func in $nlist" >&AS_MESSAGE_LOG_FD
- fi
- else
- echo "cannot find nm_test_var in $nlist" >&AS_MESSAGE_LOG_FD
- fi
- else
- echo "cannot run $lt_cv_sys_global_symbol_pipe" >&AS_MESSAGE_LOG_FD
- fi
- else
- echo "$progname: failed program was:" >&AS_MESSAGE_LOG_FD
- cat conftest.$ac_ext >&5
- fi
- rm -rf conftest* conftst*
-
- # Do not use the global_symbol_pipe unless it works.
- if test "$pipe_works" = yes; then
- break
- else
- lt_cv_sys_global_symbol_pipe=
- fi
-done
-])
-if test -z "$lt_cv_sys_global_symbol_pipe"; then
- lt_cv_sys_global_symbol_to_cdecl=
-fi
-if test -z "$lt_cv_sys_global_symbol_pipe$lt_cv_sys_global_symbol_to_cdecl"; then
- AC_MSG_RESULT(failed)
-else
- AC_MSG_RESULT(ok)
-fi
-
-_LT_DECL([global_symbol_pipe], [lt_cv_sys_global_symbol_pipe], [1],
- [Take the output of nm and produce a listing of raw symbols and C names])
-_LT_DECL([global_symbol_to_cdecl], [lt_cv_sys_global_symbol_to_cdecl], [1],
- [Transform the output of nm in a proper C declaration])
-_LT_DECL([global_symbol_to_c_name_address],
- [lt_cv_sys_global_symbol_to_c_name_address], [1],
- [Transform the output of nm in a C name address pair])
-_LT_DECL([global_symbol_to_c_name_address_lib_prefix],
- [lt_cv_sys_global_symbol_to_c_name_address_lib_prefix], [1],
- [Transform the output of nm in a C name address pair when lib prefix is needed])
-]) # _LT_CMD_GLOBAL_SYMBOLS
-
-
-# _LT_COMPILER_PIC([TAGNAME])
-# ---------------------------
-m4_defun([_LT_COMPILER_PIC],
-[m4_require([_LT_TAG_COMPILER])dnl
-_LT_TAGVAR(lt_prog_compiler_wl, $1)=
-_LT_TAGVAR(lt_prog_compiler_pic, $1)=
-_LT_TAGVAR(lt_prog_compiler_static, $1)=
-
-AC_MSG_CHECKING([for $compiler option to produce PIC])
-m4_if([$1], [CXX], [
- # C++ specific cases for pic, static, wl, etc.
- if test "$GXX" = yes; then
- _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
- _LT_TAGVAR(lt_prog_compiler_static, $1)='-static'
-
- case $host_os in
- aix*)
- # All AIX code is PIC.
- if test "$host_cpu" = ia64; then
- # AIX 5 now supports IA64 processor
- _LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic'
- fi
- ;;
-
- amigaos*)
- case $host_cpu in
- powerpc)
- # see comment about AmigaOS4 .so support
- _LT_TAGVAR(lt_prog_compiler_pic, $1)='-fPIC'
- ;;
- m68k)
- # FIXME: we need at least 68020 code to build shared libraries, but
- # adding the `-m68020' flag to GCC prevents building anything better,
- # like `-m68040'.
- _LT_TAGVAR(lt_prog_compiler_pic, $1)='-m68020 -resident32 -malways-restore-a4'
- ;;
- esac
- ;;
-
- beos* | irix5* | irix6* | nonstopux* | osf3* | osf4* | osf5*)
- # PIC is the default for these OSes.
- ;;
- mingw* | cygwin* | os2* | pw32* | cegcc*)
- # This hack is so that the source file can tell whether it is being
- # built for inclusion in a dll (and should export symbols for example).
- # Although the cygwin gcc ignores -fPIC, still need this for old-style
- # (--disable-auto-import) libraries
- m4_if([$1], [GCJ], [],
- [_LT_TAGVAR(lt_prog_compiler_pic, $1)='-DDLL_EXPORT'])
- ;;
- darwin* | rhapsody*)
- # PIC is the default on this platform
- # Common symbols not allowed in MH_DYLIB files
- _LT_TAGVAR(lt_prog_compiler_pic, $1)='-fno-common'
- ;;
- *djgpp*)
- # DJGPP does not support shared libraries at all
- _LT_TAGVAR(lt_prog_compiler_pic, $1)=
- ;;
- interix[[3-9]]*)
- # Interix 3.x gcc -fpic/-fPIC options generate broken code.
- # Instead, we relocate shared libraries at runtime.
- ;;
- sysv4*MP*)
- if test -d /usr/nec; then
- _LT_TAGVAR(lt_prog_compiler_pic, $1)=-Kconform_pic
- fi
- ;;
- hpux*)
- # PIC is the default for 64-bit PA HP-UX, but not for 32-bit
- # PA HP-UX. On IA64 HP-UX, PIC is the default but the pic flag
- # sets the default TLS model and affects inlining.
- case $host_cpu in
- hppa*64*)
- ;;
- *)
- _LT_TAGVAR(lt_prog_compiler_pic, $1)='-fPIC'
- ;;
- esac
- ;;
- *qnx* | *nto*)
- # QNX uses GNU C++, but need to define -shared option too, otherwise
- # it will coredump.
- _LT_TAGVAR(lt_prog_compiler_pic, $1)='-fPIC -shared'
- ;;
- *)
- _LT_TAGVAR(lt_prog_compiler_pic, $1)='-fPIC'
- ;;
- esac
- else
- case $host_os in
- aix[[4-9]]*)
- # All AIX code is PIC.
- if test "$host_cpu" = ia64; then
- # AIX 5 now supports IA64 processor
- _LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic'
- else
- _LT_TAGVAR(lt_prog_compiler_static, $1)='-bnso -bI:/lib/syscalls.exp'
- fi
- ;;
- chorus*)
- case $cc_basename in
- cxch68*)
- # Green Hills C++ Compiler
- # _LT_TAGVAR(lt_prog_compiler_static, $1)="--no_auto_instantiation -u __main -u __premain -u _abort -r $COOL_DIR/lib/libOrb.a $MVME_DIR/lib/CC/libC.a $MVME_DIR/lib/classix/libcx.s.a"
- ;;
- esac
- ;;
- dgux*)
- case $cc_basename in
- ec++*)
- _LT_TAGVAR(lt_prog_compiler_pic, $1)='-KPIC'
- ;;
- ghcx*)
- # Green Hills C++ Compiler
- _LT_TAGVAR(lt_prog_compiler_pic, $1)='-pic'
- ;;
- *)
- ;;
- esac
- ;;
- freebsd* | dragonfly*)
- # FreeBSD uses GNU C++
- ;;
- hpux9* | hpux10* | hpux11*)
- case $cc_basename in
- CC*)
- _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
- _LT_TAGVAR(lt_prog_compiler_static, $1)='${wl}-a ${wl}archive'
- if test "$host_cpu" != ia64; then
- _LT_TAGVAR(lt_prog_compiler_pic, $1)='+Z'
- fi
- ;;
- aCC*)
- _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
- _LT_TAGVAR(lt_prog_compiler_static, $1)='${wl}-a ${wl}archive'
- case $host_cpu in
- hppa*64*|ia64*)
- # +Z the default
- ;;
- *)
- _LT_TAGVAR(lt_prog_compiler_pic, $1)='+Z'
- ;;
- esac
- ;;
- *)
- ;;
- esac
- ;;
- interix*)
- # This is c89, which is MS Visual C++ (no shared libs)
- # Anyone wants to do a port?
- ;;
- irix5* | irix6* | nonstopux*)
- case $cc_basename in
- CC*)
- _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
- _LT_TAGVAR(lt_prog_compiler_static, $1)='-non_shared'
- # CC pic flag -KPIC is the default.
- ;;
- *)
- ;;
- esac
- ;;
- linux* | k*bsd*-gnu)
- case $cc_basename in
- KCC*)
- # KAI C++ Compiler
- _LT_TAGVAR(lt_prog_compiler_wl, $1)='--backend -Wl,'
- _LT_TAGVAR(lt_prog_compiler_pic, $1)='-fPIC'
- ;;
- ecpc* )
- # old Intel C++ for x86_64 which still supported -KPIC.
- _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
- _LT_TAGVAR(lt_prog_compiler_pic, $1)='-KPIC'
- _LT_TAGVAR(lt_prog_compiler_static, $1)='-static'
- ;;
- icpc* )
- # Intel C++, used to be incompatible with GCC.
- # ICC 10 doesn't accept -KPIC any more.
- _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
- _LT_TAGVAR(lt_prog_compiler_pic, $1)='-fPIC'
- _LT_TAGVAR(lt_prog_compiler_static, $1)='-static'
- ;;
- pgCC* | pgcpp*)
- # Portland Group C++ compiler
- _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
- _LT_TAGVAR(lt_prog_compiler_pic, $1)='-fpic'
- _LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic'
- ;;
- cxx*)
- # Compaq C++
- # Make sure the PIC flag is empty. It appears that all Alpha
- # Linux and Compaq Tru64 Unix objects are PIC.
- _LT_TAGVAR(lt_prog_compiler_pic, $1)=
- _LT_TAGVAR(lt_prog_compiler_static, $1)='-non_shared'
- ;;
- xlc* | xlC*)
- # IBM XL 8.0 on PPC
- _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
- _LT_TAGVAR(lt_prog_compiler_pic, $1)='-qpic'
- _LT_TAGVAR(lt_prog_compiler_static, $1)='-qstaticlink'
- ;;
- *)
- case `$CC -V 2>&1 | sed 5q` in
- *Sun\ C*)
- # Sun C++ 5.9
- _LT_TAGVAR(lt_prog_compiler_pic, $1)='-KPIC'
- _LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic'
- _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Qoption ld '
- ;;
- esac
- ;;
- esac
- ;;
- lynxos*)
- ;;
- m88k*)
- ;;
- mvs*)
- case $cc_basename in
- cxx*)
- _LT_TAGVAR(lt_prog_compiler_pic, $1)='-W c,exportall'
- ;;
- *)
- ;;
- esac
- ;;
- netbsd*)
- ;;
- *qnx* | *nto*)
- # QNX uses GNU C++, but need to define -shared option too, otherwise
- # it will coredump.
- _LT_TAGVAR(lt_prog_compiler_pic, $1)='-fPIC -shared'
- ;;
- osf3* | osf4* | osf5*)
- case $cc_basename in
- KCC*)
- _LT_TAGVAR(lt_prog_compiler_wl, $1)='--backend -Wl,'
- ;;
- RCC*)
- # Rational C++ 2.4.1
- _LT_TAGVAR(lt_prog_compiler_pic, $1)='-pic'
- ;;
- cxx*)
- # Digital/Compaq C++
- _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
- # Make sure the PIC flag is empty. It appears that all Alpha
- # Linux and Compaq Tru64 Unix objects are PIC.
- _LT_TAGVAR(lt_prog_compiler_pic, $1)=
- _LT_TAGVAR(lt_prog_compiler_static, $1)='-non_shared'
- ;;
- *)
- ;;
- esac
- ;;
- psos*)
- ;;
- solaris*)
- case $cc_basename in
- CC*)
- # Sun C++ 4.2, 5.x and Centerline C++
- _LT_TAGVAR(lt_prog_compiler_pic, $1)='-KPIC'
- _LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic'
- _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Qoption ld '
- ;;
- gcx*)
- # Green Hills C++ Compiler
- _LT_TAGVAR(lt_prog_compiler_pic, $1)='-PIC'
- ;;
- *)
- ;;
- esac
- ;;
- sunos4*)
- case $cc_basename in
- CC*)
- # Sun C++ 4.x
- _LT_TAGVAR(lt_prog_compiler_pic, $1)='-pic'
- _LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic'
- ;;
- lcc*)
- # Lucid
- _LT_TAGVAR(lt_prog_compiler_pic, $1)='-pic'
- ;;
- *)
- ;;
- esac
- ;;
- sysv5* | unixware* | sco3.2v5* | sco5v6* | OpenUNIX*)
- case $cc_basename in
- CC*)
- _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
- _LT_TAGVAR(lt_prog_compiler_pic, $1)='-KPIC'
- _LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic'
- ;;
- esac
- ;;
- tandem*)
- case $cc_basename in
- NCC*)
- # NonStop-UX NCC 3.20
- _LT_TAGVAR(lt_prog_compiler_pic, $1)='-KPIC'
- ;;
- *)
- ;;
- esac
- ;;
- vxworks*)
- ;;
- *)
- _LT_TAGVAR(lt_prog_compiler_can_build_shared, $1)=no
- ;;
- esac
- fi
-],
-[
- if test "$GCC" = yes; then
- _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
- _LT_TAGVAR(lt_prog_compiler_static, $1)='-static'
-
- case $host_os in
- aix*)
- # All AIX code is PIC.
- if test "$host_cpu" = ia64; then
- # AIX 5 now supports IA64 processor
- _LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic'
- fi
- ;;
-
- amigaos*)
- case $host_cpu in
- powerpc)
- # see comment about AmigaOS4 .so support
- _LT_TAGVAR(lt_prog_compiler_pic, $1)='-fPIC'
- ;;
- m68k)
- # FIXME: we need at least 68020 code to build shared libraries, but
- # adding the `-m68020' flag to GCC prevents building anything better,
- # like `-m68040'.
- _LT_TAGVAR(lt_prog_compiler_pic, $1)='-m68020 -resident32 -malways-restore-a4'
- ;;
- esac
- ;;
-
- beos* | irix5* | irix6* | nonstopux* | osf3* | osf4* | osf5*)
- # PIC is the default for these OSes.
- ;;
-
- mingw* | cygwin* | pw32* | os2* | cegcc*)
- # This hack is so that the source file can tell whether it is being
- # built for inclusion in a dll (and should export symbols for example).
- # Although the cygwin gcc ignores -fPIC, still need this for old-style
- # (--disable-auto-import) libraries
- m4_if([$1], [GCJ], [],
- [_LT_TAGVAR(lt_prog_compiler_pic, $1)='-DDLL_EXPORT'])
- ;;
-
- darwin* | rhapsody*)
- # PIC is the default on this platform
- # Common symbols not allowed in MH_DYLIB files
- _LT_TAGVAR(lt_prog_compiler_pic, $1)='-fno-common'
- ;;
-
- hpux*)
- # PIC is the default for 64-bit PA HP-UX, but not for 32-bit
- # PA HP-UX. On IA64 HP-UX, PIC is the default but the pic flag
- # sets the default TLS model and affects inlining.
- case $host_cpu in
- hppa*64*)
- # +Z the default
- ;;
- *)
- _LT_TAGVAR(lt_prog_compiler_pic, $1)='-fPIC'
- ;;
- esac
- ;;
-
- interix[[3-9]]*)
- # Interix 3.x gcc -fpic/-fPIC options generate broken code.
- # Instead, we relocate shared libraries at runtime.
- ;;
-
- msdosdjgpp*)
- # Just because we use GCC doesn't mean we suddenly get shared libraries
- # on systems that don't support them.
- _LT_TAGVAR(lt_prog_compiler_can_build_shared, $1)=no
- enable_shared=no
- ;;
-
- *nto* | *qnx*)
- # QNX uses GNU C++, but need to define -shared option too, otherwise
- # it will coredump.
- _LT_TAGVAR(lt_prog_compiler_pic, $1)='-fPIC -shared'
- ;;
-
- sysv4*MP*)
- if test -d /usr/nec; then
- _LT_TAGVAR(lt_prog_compiler_pic, $1)=-Kconform_pic
- fi
- ;;
-
- *)
- _LT_TAGVAR(lt_prog_compiler_pic, $1)='-fPIC'
- ;;
- esac
- else
- # PORTME Check for flag to pass linker flags through the system compiler.
- case $host_os in
- aix*)
- _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
- if test "$host_cpu" = ia64; then
- # AIX 5 now supports IA64 processor
- _LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic'
- else
- _LT_TAGVAR(lt_prog_compiler_static, $1)='-bnso -bI:/lib/syscalls.exp'
- fi
- ;;
-
- mingw* | cygwin* | pw32* | os2* | cegcc*)
- # This hack is so that the source file can tell whether it is being
- # built for inclusion in a dll (and should export symbols for example).
- m4_if([$1], [GCJ], [],
- [_LT_TAGVAR(lt_prog_compiler_pic, $1)='-DDLL_EXPORT'])
- ;;
-
- hpux9* | hpux10* | hpux11*)
- _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
- # PIC is the default for IA64 HP-UX and 64-bit HP-UX, but
- # not for PA HP-UX.
- case $host_cpu in
- hppa*64*|ia64*)
- # +Z the default
- ;;
- *)
- _LT_TAGVAR(lt_prog_compiler_pic, $1)='+Z'
- ;;
- esac
- # Is there a better lt_prog_compiler_static that works with the bundled CC?
- _LT_TAGVAR(lt_prog_compiler_static, $1)='${wl}-a ${wl}archive'
- ;;
-
- irix5* | irix6* | nonstopux*)
- _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
- # PIC (with -KPIC) is the default.
- _LT_TAGVAR(lt_prog_compiler_static, $1)='-non_shared'
- ;;
-
- linux* | k*bsd*-gnu)
- case $cc_basename in
- # old Intel for x86_64 which still supported -KPIC.
- ecc*)
- _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
- _LT_TAGVAR(lt_prog_compiler_pic, $1)='-KPIC'
- _LT_TAGVAR(lt_prog_compiler_static, $1)='-static'
- ;;
-dnl #### WK: add support for more compilers, fix ifort tags ####
-# # icc used to be incompatible with GCC.
-# # ICC 10 doesn't accept -KPIC any more.
-# icc* | ifort*)
-# _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
-# _LT_TAGVAR(lt_prog_compiler_pic, $1)='-fPIC'
-# _LT_TAGVAR(lt_prog_compiler_static, $1)='-static'
-# ;;
- ifort*)
- _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
- _LT_TAGVAR(lt_prog_compiler_pic, $1)='-fpic'
- _LT_TAGVAR(lt_prog_compiler_static, $1)='-static'
- ;;
- nagfor*)
- # NAG Fortran compiler
- _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,-Wl,,'
- _LT_TAGVAR(lt_prog_compiler_pic, $1)='-pic'
- _LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic'
- ;;
-dnl #### WK: end of change ####
-
- # Lahey Fortran 8.1.
- lf95*)
- _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
- _LT_TAGVAR(lt_prog_compiler_pic, $1)='--shared'
- _LT_TAGVAR(lt_prog_compiler_static, $1)='--static'
- ;;
- pgcc* | pgf77* | pgf90* | pgf95*)
- # Portland Group compilers (*not* the Pentium gcc compiler,
- # which looks to be a dead project)
- _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
- _LT_TAGVAR(lt_prog_compiler_pic, $1)='-fpic'
- _LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic'
- ;;
- ccc*)
- _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
- # All Alpha code is PIC.
- _LT_TAGVAR(lt_prog_compiler_static, $1)='-non_shared'
- ;;
- xl*)
- # IBM XL C 8.0/Fortran 10.1 on PPC
- _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
- _LT_TAGVAR(lt_prog_compiler_pic, $1)='-qpic'
- _LT_TAGVAR(lt_prog_compiler_static, $1)='-qstaticlink'
- ;;
- *)
- case `$CC -V 2>&1 | sed 5q` in
- *Sun\ C*)
- # Sun C 5.9
- _LT_TAGVAR(lt_prog_compiler_pic, $1)='-KPIC'
- _LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic'
- _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
- ;;
- *Sun\ F*)
- # Sun Fortran 8.3 passes all unrecognized flags to the linker
- _LT_TAGVAR(lt_prog_compiler_pic, $1)='-KPIC'
- _LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic'
- _LT_TAGVAR(lt_prog_compiler_wl, $1)=''
- ;;
- esac
- ;;
- esac
- ;;
-
- newsos6)
- _LT_TAGVAR(lt_prog_compiler_pic, $1)='-KPIC'
- _LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic'
- ;;
-
- *nto* | *qnx*)
- # QNX uses GNU C++, but need to define -shared option too, otherwise
- # it will coredump.
- _LT_TAGVAR(lt_prog_compiler_pic, $1)='-fPIC -shared'
- ;;
-
- osf3* | osf4* | osf5*)
- _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
- # All OSF/1 code is PIC.
- _LT_TAGVAR(lt_prog_compiler_static, $1)='-non_shared'
- ;;
-
- rdos*)
- _LT_TAGVAR(lt_prog_compiler_static, $1)='-non_shared'
- ;;
-
- solaris*)
- _LT_TAGVAR(lt_prog_compiler_pic, $1)='-KPIC'
- _LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic'
- case $cc_basename in
- f77* | f90* | f95*)
- _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Qoption ld ';;
- *)
- _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,';;
- esac
- ;;
-
- sunos4*)
- _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Qoption ld '
- _LT_TAGVAR(lt_prog_compiler_pic, $1)='-PIC'
- _LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic'
- ;;
-
- sysv4 | sysv4.2uw2* | sysv4.3*)
- _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
- _LT_TAGVAR(lt_prog_compiler_pic, $1)='-KPIC'
- _LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic'
- ;;
-
- sysv4*MP*)
- if test -d /usr/nec ;then
- _LT_TAGVAR(lt_prog_compiler_pic, $1)='-Kconform_pic'
- _LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic'
- fi
- ;;
-
- sysv5* | unixware* | sco3.2v5* | sco5v6* | OpenUNIX*)
- _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
- _LT_TAGVAR(lt_prog_compiler_pic, $1)='-KPIC'
- _LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic'
- ;;
-
- unicos*)
- _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
- _LT_TAGVAR(lt_prog_compiler_can_build_shared, $1)=no
- ;;
-
- uts4*)
- _LT_TAGVAR(lt_prog_compiler_pic, $1)='-pic'
- _LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic'
- ;;
-
- *)
- _LT_TAGVAR(lt_prog_compiler_can_build_shared, $1)=no
- ;;
- esac
- fi
-])
-case $host_os in
- # For platforms which do not support PIC, -DPIC is meaningless:
- *djgpp*)
- _LT_TAGVAR(lt_prog_compiler_pic, $1)=
- ;;
- *)
- _LT_TAGVAR(lt_prog_compiler_pic, $1)="$_LT_TAGVAR(lt_prog_compiler_pic, $1)@&t@m4_if([$1],[],[ -DPIC],[m4_if([$1],[CXX],[ -DPIC],[])])"
- ;;
-esac
-AC_MSG_RESULT([$_LT_TAGVAR(lt_prog_compiler_pic, $1)])
-_LT_TAGDECL([wl], [lt_prog_compiler_wl], [1],
- [How to pass a linker flag through the compiler])
-
-#
-# Check to make sure the PIC flag actually works.
-#
-if test -n "$_LT_TAGVAR(lt_prog_compiler_pic, $1)"; then
- _LT_COMPILER_OPTION([if $compiler PIC flag $_LT_TAGVAR(lt_prog_compiler_pic, $1) works],
- [_LT_TAGVAR(lt_cv_prog_compiler_pic_works, $1)],
- [$_LT_TAGVAR(lt_prog_compiler_pic, $1)@&t@m4_if([$1],[],[ -DPIC],[m4_if([$1],[CXX],[ -DPIC],[])])], [],
- [case $_LT_TAGVAR(lt_prog_compiler_pic, $1) in
- "" | " "*) ;;
- *) _LT_TAGVAR(lt_prog_compiler_pic, $1)=" $_LT_TAGVAR(lt_prog_compiler_pic, $1)" ;;
- esac],
- [_LT_TAGVAR(lt_prog_compiler_pic, $1)=
- _LT_TAGVAR(lt_prog_compiler_can_build_shared, $1)=no])
-fi
-_LT_TAGDECL([pic_flag], [lt_prog_compiler_pic], [1],
- [Additional compiler flags for building library objects])
-
-#
-# Check to make sure the static flag actually works.
-#
-wl=$_LT_TAGVAR(lt_prog_compiler_wl, $1) eval lt_tmp_static_flag=\"$_LT_TAGVAR(lt_prog_compiler_static, $1)\"
-_LT_LINKER_OPTION([if $compiler static flag $lt_tmp_static_flag works],
- _LT_TAGVAR(lt_cv_prog_compiler_static_works, $1),
- $lt_tmp_static_flag,
- [],
- [_LT_TAGVAR(lt_prog_compiler_static, $1)=])
-_LT_TAGDECL([link_static_flag], [lt_prog_compiler_static], [1],
- [Compiler flag to prevent dynamic linking])
-])# _LT_COMPILER_PIC
-
-
-# _LT_LINKER_SHLIBS([TAGNAME])
-# ----------------------------
-# See if the linker supports building shared libraries.
-m4_defun([_LT_LINKER_SHLIBS],
-[AC_REQUIRE([LT_PATH_LD])dnl
-AC_REQUIRE([LT_PATH_NM])dnl
-m4_require([_LT_FILEUTILS_DEFAULTS])dnl
-m4_require([_LT_DECL_EGREP])dnl
-m4_require([_LT_DECL_SED])dnl
-m4_require([_LT_CMD_GLOBAL_SYMBOLS])dnl
-m4_require([_LT_TAG_COMPILER])dnl
-AC_MSG_CHECKING([whether the $compiler linker ($LD) supports shared libraries])
-m4_if([$1], [CXX], [
- _LT_TAGVAR(export_symbols_cmds, $1)='$NM $libobjs $convenience | $global_symbol_pipe | $SED '\''s/.* //'\'' | sort | uniq > $export_symbols'
- case $host_os in
- aix[[4-9]]*)
- # If we're using GNU nm, then we don't want the "-C" option.
- # -C means demangle to AIX nm, but means don't demangle with GNU nm
- if $NM -V 2>&1 | $GREP 'GNU' > /dev/null; then
- _LT_TAGVAR(export_symbols_cmds, $1)='$NM -Bpg $libobjs $convenience | awk '\''{ if (((\$ 2 == "T") || (\$ 2 == "D") || (\$ 2 == "B")) && ([substr](\$ 3,1,1) != ".")) { print \$ 3 } }'\'' | sort -u > $export_symbols'
- else
- _LT_TAGVAR(export_symbols_cmds, $1)='$NM -BCpg $libobjs $convenience | awk '\''{ if (((\$ 2 == "T") || (\$ 2 == "D") || (\$ 2 == "B")) && ([substr](\$ 3,1,1) != ".")) { print \$ 3 } }'\'' | sort -u > $export_symbols'
- fi
- ;;
- pw32*)
- _LT_TAGVAR(export_symbols_cmds, $1)="$ltdll_cmds"
- ;;
- cygwin* | mingw* | cegcc*)
- _LT_TAGVAR(export_symbols_cmds, $1)='$NM $libobjs $convenience | $global_symbol_pipe | $SED -e '\''/^[[BCDGRS]][[ ]]/s/.*[[ ]]\([[^ ]]*\)/\1 DATA/;/^.*[[ ]]__nm__/s/^.*[[ ]]__nm__\([[^ ]]*\)[[ ]][[^ ]]*/\1 DATA/;/^I[[ ]]/d;/^[[AITW]][[ ]]/s/.* //'\'' | sort | uniq > $export_symbols'
- ;;
- *)
- _LT_TAGVAR(export_symbols_cmds, $1)='$NM $libobjs $convenience | $global_symbol_pipe | $SED '\''s/.* //'\'' | sort | uniq > $export_symbols'
- ;;
- esac
- _LT_TAGVAR(exclude_expsyms, $1)=['_GLOBAL_OFFSET_TABLE_|_GLOBAL__F[ID]_.*']
-], [
- runpath_var=
- _LT_TAGVAR(allow_undefined_flag, $1)=
- _LT_TAGVAR(always_export_symbols, $1)=no
- _LT_TAGVAR(archive_cmds, $1)=
- _LT_TAGVAR(archive_expsym_cmds, $1)=
- _LT_TAGVAR(compiler_needs_object, $1)=no
- _LT_TAGVAR(enable_shared_with_static_runtimes, $1)=no
- _LT_TAGVAR(export_dynamic_flag_spec, $1)=
- _LT_TAGVAR(export_symbols_cmds, $1)='$NM $libobjs $convenience | $global_symbol_pipe | $SED '\''s/.* //'\'' | sort | uniq > $export_symbols'
- _LT_TAGVAR(hardcode_automatic, $1)=no
- _LT_TAGVAR(hardcode_direct, $1)=no
- _LT_TAGVAR(hardcode_direct_absolute, $1)=no
- _LT_TAGVAR(hardcode_libdir_flag_spec, $1)=
- _LT_TAGVAR(hardcode_libdir_flag_spec_ld, $1)=
- _LT_TAGVAR(hardcode_libdir_separator, $1)=
- _LT_TAGVAR(hardcode_minus_L, $1)=no
- _LT_TAGVAR(hardcode_shlibpath_var, $1)=unsupported
- _LT_TAGVAR(inherit_rpath, $1)=no
- _LT_TAGVAR(link_all_deplibs, $1)=unknown
- _LT_TAGVAR(module_cmds, $1)=
- _LT_TAGVAR(module_expsym_cmds, $1)=
- _LT_TAGVAR(old_archive_from_new_cmds, $1)=
- _LT_TAGVAR(old_archive_from_expsyms_cmds, $1)=
- _LT_TAGVAR(thread_safe_flag_spec, $1)=
- _LT_TAGVAR(whole_archive_flag_spec, $1)=
- # include_expsyms should be a list of space-separated symbols to be *always*
- # included in the symbol list
- _LT_TAGVAR(include_expsyms, $1)=
- # exclude_expsyms can be an extended regexp of symbols to exclude
- # it will be wrapped by ` (' and `)$', so one must not match beginning or
- # end of line. Example: `a|bc|.*d.*' will exclude the symbols `a' and `bc',
- # as well as any symbol that contains `d'.
- _LT_TAGVAR(exclude_expsyms, $1)=['_GLOBAL_OFFSET_TABLE_|_GLOBAL__F[ID]_.*']
- # Although _GLOBAL_OFFSET_TABLE_ is a valid symbol C name, most a.out
- # platforms (ab)use it in PIC code, but their linkers get confused if
- # the symbol is explicitly referenced. Since portable code cannot
- # rely on this symbol name, it's probably fine to never include it in
- # preloaded symbol tables.
- # Exclude shared library initialization/finalization symbols.
-dnl Note also adjust exclude_expsyms for C++ above.
- extract_expsyms_cmds=
-
- case $host_os in
- cygwin* | mingw* | pw32* | cegcc*)
- # FIXME: the MSVC++ port hasn't been tested in a loooong time
- # When not using gcc, we currently assume that we are using
- # Microsoft Visual C++.
- if test "$GCC" != yes; then
- with_gnu_ld=no
- fi
- ;;
- interix*)
- # we just hope/assume this is gcc and not c89 (= MSVC++)
- with_gnu_ld=yes
- ;;
- openbsd*)
- with_gnu_ld=no
- ;;
- esac
-
- _LT_TAGVAR(ld_shlibs, $1)=yes
- if test "$with_gnu_ld" = yes; then
- # If archive_cmds runs LD, not CC, wlarc should be empty
- wlarc='${wl}'
-
- # Set some defaults for GNU ld with shared library support. These
- # are reset later if shared libraries are not supported. Putting them
- # here allows them to be overridden if necessary.
- runpath_var=LD_RUN_PATH
- _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='${wl}-rpath ${wl}$libdir'
- _LT_TAGVAR(export_dynamic_flag_spec, $1)='${wl}--export-dynamic'
- # ancient GNU ld didn't support --whole-archive et. al.
- if $LD --help 2>&1 | $GREP 'no-whole-archive' > /dev/null; then
- _LT_TAGVAR(whole_archive_flag_spec, $1)="$wlarc"'--whole-archive$convenience '"$wlarc"'--no-whole-archive'
- else
- _LT_TAGVAR(whole_archive_flag_spec, $1)=
- fi
- supports_anon_versioning=no
- case `$LD -v 2>&1` in
- *\ [[01]].* | *\ 2.[[0-9]].* | *\ 2.10.*) ;; # catch versions < 2.11
- *\ 2.11.93.0.2\ *) supports_anon_versioning=yes ;; # RH7.3 ...
- *\ 2.11.92.0.12\ *) supports_anon_versioning=yes ;; # Mandrake 8.2 ...
- *\ 2.11.*) ;; # other 2.11 versions
- *) supports_anon_versioning=yes ;;
- esac
-
- # See if GNU ld supports shared libraries.
- case $host_os in
- aix[[3-9]]*)
- # On AIX/PPC, the GNU linker is very broken
- if test "$host_cpu" != ia64; then
- _LT_TAGVAR(ld_shlibs, $1)=no
- cat <<_LT_EOF 1>&2
-
-*** Warning: the GNU linker, at least up to release 2.9.1, is reported
-*** to be unable to reliably create shared libraries on AIX.
-*** Therefore, libtool is disabling shared libraries support. If you
-*** really care for shared libraries, you may want to modify your PATH
-*** so that a non-GNU linker is found, and then restart.
-
-_LT_EOF
- fi
- ;;
-
- amigaos*)
- case $host_cpu in
- powerpc)
- # see comment about AmigaOS4 .so support
- _LT_TAGVAR(archive_cmds, $1)='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib'
- _LT_TAGVAR(archive_expsym_cmds, $1)=''
- ;;
- m68k)
- _LT_TAGVAR(archive_cmds, $1)='$RM $output_objdir/a2ixlibrary.data~$ECHO "#define NAME $libname" > $output_objdir/a2ixlibrary.data~$ECHO "#define LIBRARY_ID 1" >> $output_objdir/a2ixlibrary.data~$ECHO "#define VERSION $major" >> $output_objdir/a2ixlibrary.data~$ECHO "#define REVISION $revision" >> $output_objdir/a2ixlibrary.data~$AR $AR_FLAGS $lib $libobjs~$RANLIB $lib~(cd $output_objdir && a2ixlibrary -32)'
- _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-L$libdir'
- _LT_TAGVAR(hardcode_minus_L, $1)=yes
- ;;
- esac
- ;;
-
- beos*)
- if $LD --help 2>&1 | $GREP ': supported targets:.* elf' > /dev/null; then
- _LT_TAGVAR(allow_undefined_flag, $1)=unsupported
- # Joseph Beckenbach <jrb3@best.com> says some releases of gcc
- # support --undefined. This deserves some investigation. FIXME
- _LT_TAGVAR(archive_cmds, $1)='$CC -nostart $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib'
- else
- _LT_TAGVAR(ld_shlibs, $1)=no
- fi
- ;;
-
- cygwin* | mingw* | pw32* | cegcc*)
- # _LT_TAGVAR(hardcode_libdir_flag_spec, $1) is actually meaningless,
- # as there is no search path for DLLs.
- _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-L$libdir'
- _LT_TAGVAR(allow_undefined_flag, $1)=unsupported
- _LT_TAGVAR(always_export_symbols, $1)=no
- _LT_TAGVAR(enable_shared_with_static_runtimes, $1)=yes
- _LT_TAGVAR(export_symbols_cmds, $1)='$NM $libobjs $convenience | $global_symbol_pipe | $SED -e '\''/^[[BCDGRS]][[ ]]/s/.*[[ ]]\([[^ ]]*\)/\1 DATA/'\'' | $SED -e '\''/^[[AITW]][[ ]]/s/.*[[ ]]//'\'' | sort | uniq > $export_symbols'
-
- if $LD --help 2>&1 | $GREP 'auto-import' > /dev/null; then
- _LT_TAGVAR(archive_cmds, $1)='$CC -shared $libobjs $deplibs $compiler_flags -o $output_objdir/$soname ${wl}--enable-auto-image-base -Xlinker --out-implib -Xlinker $lib'
- # If the export-symbols file already is a .def file (1st line
- # is EXPORTS), use it as is; otherwise, prepend...
- _LT_TAGVAR(archive_expsym_cmds, $1)='if test "x`$SED 1q $export_symbols`" = xEXPORTS; then
- cp $export_symbols $output_objdir/$soname.def;
- else
- echo EXPORTS > $output_objdir/$soname.def;
- cat $export_symbols >> $output_objdir/$soname.def;
- fi~
- $CC -shared $output_objdir/$soname.def $libobjs $deplibs $compiler_flags -o $output_objdir/$soname ${wl}--enable-auto-image-base -Xlinker --out-implib -Xlinker $lib'
- else
- _LT_TAGVAR(ld_shlibs, $1)=no
- fi
- ;;
-
- interix[[3-9]]*)
- _LT_TAGVAR(hardcode_direct, $1)=no
- _LT_TAGVAR(hardcode_shlibpath_var, $1)=no
- _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='${wl}-rpath,$libdir'
- _LT_TAGVAR(export_dynamic_flag_spec, $1)='${wl}-E'
- # Hack: On Interix 3.x, we cannot compile PIC because of a broken gcc.
- # Instead, shared libraries are loaded at an image base (0x10000000 by
- # default) and relocated if they conflict, which is a slow very memory
- # consuming and fragmenting process. To avoid this, we pick a random,
- # 256 KiB-aligned image base between 0x50000000 and 0x6FFC0000 at link
- # time. Moving up from 0x10000000 also allows more sbrk(2) space.
- _LT_TAGVAR(archive_cmds, $1)='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags ${wl}-h,$soname ${wl}--image-base,`expr ${RANDOM-$$} % 4096 / 2 \* 262144 + 1342177280` -o $lib'
- _LT_TAGVAR(archive_expsym_cmds, $1)='sed "s,^,_," $export_symbols >$output_objdir/$soname.expsym~$CC -shared $pic_flag $libobjs $deplibs $compiler_flags ${wl}-h,$soname ${wl}--retain-symbols-file,$output_objdir/$soname.expsym ${wl}--image-base,`expr ${RANDOM-$$} % 4096 / 2 \* 262144 + 1342177280` -o $lib'
- ;;
-
- gnu* | linux* | tpf* | k*bsd*-gnu)
- tmp_diet=no
- if test "$host_os" = linux-dietlibc; then
- case $cc_basename in
- diet\ *) tmp_diet=yes;; # linux-dietlibc with static linking (!diet-dyn)
- esac
- fi
- if $LD --help 2>&1 | $EGREP ': supported targets:.* elf' > /dev/null \
- && test "$tmp_diet" = no
- then
- tmp_addflag=
- tmp_sharedflag='-shared'
- case $cc_basename,$host_cpu in
- pgcc*) # Portland Group C compiler
- _LT_TAGVAR(whole_archive_flag_spec, $1)='${wl}--whole-archive`for conv in $convenience\"\"; do test -n \"$conv\" && new_convenience=\"$new_convenience,$conv\"; done; $ECHO \"$new_convenience\"` ${wl}--no-whole-archive'
- tmp_addflag=' $pic_flag'
- ;;
- pgf77* | pgf90* | pgf95*) # Portland Group f77 and f90 compilers
- _LT_TAGVAR(whole_archive_flag_spec, $1)='${wl}--whole-archive`for conv in $convenience\"\"; do test -n \"$conv\" && new_convenience=\"$new_convenience,$conv\"; done; $ECHO \"$new_convenience\"` ${wl}--no-whole-archive'
- tmp_addflag=' $pic_flag -Mnomain' ;;
- ecc*,ia64* | icc*,ia64*) # Intel C compiler on ia64
- tmp_addflag=' -i_dynamic' ;;
- efc*,ia64* | ifort*,ia64*) # Intel Fortran compiler on ia64
- tmp_addflag=' -i_dynamic -nofor_main' ;;
- ifc* | ifort*) # Intel Fortran compiler
- tmp_addflag=' -nofor_main' ;;
- lf95*) # Lahey Fortran 8.1
- _LT_TAGVAR(whole_archive_flag_spec, $1)=
- tmp_sharedflag='--shared' ;;
- xl[[cC]]*) # IBM XL C 8.0 on PPC (deal with xlf below)
- tmp_sharedflag='-qmkshrobj'
- tmp_addflag= ;;
- esac
- case `$CC -V 2>&1 | sed 5q` in
- *Sun\ C*) # Sun C 5.9
- _LT_TAGVAR(whole_archive_flag_spec, $1)='${wl}--whole-archive`new_convenience=; for conv in $convenience\"\"; do test -z \"$conv\" || new_convenience=\"$new_convenience,$conv\"; done; $ECHO \"$new_convenience\"` ${wl}--no-whole-archive'
- _LT_TAGVAR(compiler_needs_object, $1)=yes
- tmp_sharedflag='-G' ;;
- *Sun\ F*) # Sun Fortran 8.3
- tmp_sharedflag='-G' ;;
- esac
- _LT_TAGVAR(archive_cmds, $1)='$CC '"$tmp_sharedflag""$tmp_addflag"' $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib'
-
- if test "x$supports_anon_versioning" = xyes; then
- _LT_TAGVAR(archive_expsym_cmds, $1)='echo "{ global:" > $output_objdir/$libname.ver~
- cat $export_symbols | sed -e "s/\(.*\)/\1;/" >> $output_objdir/$libname.ver~
- echo "local: *; };" >> $output_objdir/$libname.ver~
- $CC '"$tmp_sharedflag""$tmp_addflag"' $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname ${wl}-version-script ${wl}$output_objdir/$libname.ver -o $lib'
- fi
-
- case $cc_basename in
- xlf*)
- # IBM XL Fortran 10.1 on PPC cannot create shared libs itself
- _LT_TAGVAR(whole_archive_flag_spec, $1)='--whole-archive$convenience --no-whole-archive'
- _LT_TAGVAR(hardcode_libdir_flag_spec, $1)=
- _LT_TAGVAR(hardcode_libdir_flag_spec_ld, $1)='-rpath $libdir'
- _LT_TAGVAR(archive_cmds, $1)='$LD -shared $libobjs $deplibs $compiler_flags -soname $soname -o $lib'
- if test "x$supports_anon_versioning" = xyes; then
- _LT_TAGVAR(archive_expsym_cmds, $1)='echo "{ global:" > $output_objdir/$libname.ver~
- cat $export_symbols | sed -e "s/\(.*\)/\1;/" >> $output_objdir/$libname.ver~
- echo "local: *; };" >> $output_objdir/$libname.ver~
- $LD -shared $libobjs $deplibs $compiler_flags -soname $soname -version-script $output_objdir/$libname.ver -o $lib'
- fi
- ;;
- esac
- else
- _LT_TAGVAR(ld_shlibs, $1)=no
- fi
- ;;
-
- netbsd*)
- if echo __ELF__ | $CC -E - | $GREP __ELF__ >/dev/null; then
- _LT_TAGVAR(archive_cmds, $1)='$LD -Bshareable $libobjs $deplibs $linker_flags -o $lib'
- wlarc=
- else
- _LT_TAGVAR(archive_cmds, $1)='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib'
- _LT_TAGVAR(archive_expsym_cmds, $1)='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname ${wl}-retain-symbols-file $wl$export_symbols -o $lib'
- fi
- ;;
-
- solaris*)
- if $LD -v 2>&1 | $GREP 'BFD 2\.8' > /dev/null; then
- _LT_TAGVAR(ld_shlibs, $1)=no
- cat <<_LT_EOF 1>&2
-
-*** Warning: The releases 2.8.* of the GNU linker cannot reliably
-*** create shared libraries on Solaris systems. Therefore, libtool
-*** is disabling shared libraries support. We urge you to upgrade GNU
-*** binutils to release 2.9.1 or newer. Another option is to modify
-*** your PATH or compiler configuration so that the native linker is
-*** used, and then restart.
-
-_LT_EOF
- elif $LD --help 2>&1 | $GREP ': supported targets:.* elf' > /dev/null; then
- _LT_TAGVAR(archive_cmds, $1)='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib'
- _LT_TAGVAR(archive_expsym_cmds, $1)='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname ${wl}-retain-symbols-file $wl$export_symbols -o $lib'
- else
- _LT_TAGVAR(ld_shlibs, $1)=no
- fi
- ;;
-
- sysv5* | sco3.2v5* | sco5v6* | unixware* | OpenUNIX*)
- case `$LD -v 2>&1` in
- *\ [[01]].* | *\ 2.[[0-9]].* | *\ 2.1[[0-5]].*)
- _LT_TAGVAR(ld_shlibs, $1)=no
- cat <<_LT_EOF 1>&2
-
-*** Warning: Releases of the GNU linker prior to 2.16.91.0.3 can not
-*** reliably create shared libraries on SCO systems. Therefore, libtool
-*** is disabling shared libraries support. We urge you to upgrade GNU
-*** binutils to release 2.16.91.0.3 or newer. Another option is to modify
-*** your PATH or compiler configuration so that the native linker is
-*** used, and then restart.
-
-_LT_EOF
- ;;
- *)
- # For security reasons, it is highly recommended that you always
- # use absolute paths for naming shared libraries, and exclude the
- # DT_RUNPATH tag from executables and libraries. But doing so
- # requires that you compile everything twice, which is a pain.
- if $LD --help 2>&1 | $GREP ': supported targets:.* elf' > /dev/null; then
- _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='${wl}-rpath ${wl}$libdir'
- _LT_TAGVAR(archive_cmds, $1)='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib'
- _LT_TAGVAR(archive_expsym_cmds, $1)='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname ${wl}-retain-symbols-file $wl$export_symbols -o $lib'
- else
- _LT_TAGVAR(ld_shlibs, $1)=no
- fi
- ;;
- esac
- ;;
-
- sunos4*)
- _LT_TAGVAR(archive_cmds, $1)='$LD -assert pure-text -Bshareable -o $lib $libobjs $deplibs $linker_flags'
- wlarc=
- _LT_TAGVAR(hardcode_direct, $1)=yes
- _LT_TAGVAR(hardcode_shlibpath_var, $1)=no
- ;;
-
- *)
- if $LD --help 2>&1 | $GREP ': supported targets:.* elf' > /dev/null; then
- _LT_TAGVAR(archive_cmds, $1)='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib'
- _LT_TAGVAR(archive_expsym_cmds, $1)='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname ${wl}-retain-symbols-file $wl$export_symbols -o $lib'
- else
- _LT_TAGVAR(ld_shlibs, $1)=no
- fi
- ;;
- esac
-
- if test "$_LT_TAGVAR(ld_shlibs, $1)" = no; then
- runpath_var=
- _LT_TAGVAR(hardcode_libdir_flag_spec, $1)=
- _LT_TAGVAR(export_dynamic_flag_spec, $1)=
- _LT_TAGVAR(whole_archive_flag_spec, $1)=
- fi
- else
- # PORTME fill in a description of your system's linker (not GNU ld)
- case $host_os in
- aix3*)
- _LT_TAGVAR(allow_undefined_flag, $1)=unsupported
- _LT_TAGVAR(always_export_symbols, $1)=yes
- _LT_TAGVAR(archive_expsym_cmds, $1)='$LD -o $output_objdir/$soname $libobjs $deplibs $linker_flags -bE:$export_symbols -T512 -H512 -bM:SRE~$AR $AR_FLAGS $lib $output_objdir/$soname'
- # Note: this linker hardcodes the directories in LIBPATH if there
- # are no directories specified by -L.
- _LT_TAGVAR(hardcode_minus_L, $1)=yes
- if test "$GCC" = yes && test -z "$lt_prog_compiler_static"; then
- # Neither direct hardcoding nor static linking is supported with a
- # broken collect2.
- _LT_TAGVAR(hardcode_direct, $1)=unsupported
- fi
- ;;
-
- aix[[4-9]]*)
- if test "$host_cpu" = ia64; then
- # On IA64, the linker does run time linking by default, so we don't
- # have to do anything special.
- aix_use_runtimelinking=no
- exp_sym_flag='-Bexport'
- no_entry_flag=""
- else
- # If we're using GNU nm, then we don't want the "-C" option.
- # -C means demangle to AIX nm, but means don't demangle with GNU nm
- if $NM -V 2>&1 | $GREP 'GNU' > /dev/null; then
- _LT_TAGVAR(export_symbols_cmds, $1)='$NM -Bpg $libobjs $convenience | awk '\''{ if (((\$ 2 == "T") || (\$ 2 == "D") || (\$ 2 == "B")) && ([substr](\$ 3,1,1) != ".")) { print \$ 3 } }'\'' | sort -u > $export_symbols'
- else
- _LT_TAGVAR(export_symbols_cmds, $1)='$NM -BCpg $libobjs $convenience | awk '\''{ if (((\$ 2 == "T") || (\$ 2 == "D") || (\$ 2 == "B")) && ([substr](\$ 3,1,1) != ".")) { print \$ 3 } }'\'' | sort -u > $export_symbols'
- fi
- aix_use_runtimelinking=no
-
- # Test if we are trying to use run time linking or normal
- # AIX style linking. If -brtl is somewhere in LDFLAGS, we
- # need to do runtime linking.
- case $host_os in aix4.[[23]]|aix4.[[23]].*|aix[[5-9]]*)
- for ld_flag in $LDFLAGS; do
- if (test $ld_flag = "-brtl" || test $ld_flag = "-Wl,-brtl"); then
- aix_use_runtimelinking=yes
- break
- fi
- done
- ;;
- esac
-
- exp_sym_flag='-bexport'
- no_entry_flag='-bnoentry'
- fi
-
- # When large executables or shared objects are built, AIX ld can
- # have problems creating the table of contents. If linking a library
- # or program results in "error TOC overflow" add -mminimal-toc to
- # CXXFLAGS/CFLAGS for g++/gcc. In the cases where that is not
- # enough to fix the problem, add -Wl,-bbigtoc to LDFLAGS.
-
- _LT_TAGVAR(archive_cmds, $1)=''
- _LT_TAGVAR(hardcode_direct, $1)=yes
- _LT_TAGVAR(hardcode_direct_absolute, $1)=yes
- _LT_TAGVAR(hardcode_libdir_separator, $1)=':'
- _LT_TAGVAR(link_all_deplibs, $1)=yes
- _LT_TAGVAR(file_list_spec, $1)='${wl}-f,'
-
- if test "$GCC" = yes; then
- case $host_os in aix4.[[012]]|aix4.[[012]].*)
- # We only want to do this on AIX 4.2 and lower, the check
- # below for broken collect2 doesn't work under 4.3+
- collect2name=`${CC} -print-prog-name=collect2`
- if test -f "$collect2name" &&
- strings "$collect2name" | $GREP resolve_lib_name >/dev/null
- then
- # We have reworked collect2
- :
- else
- # We have old collect2
- _LT_TAGVAR(hardcode_direct, $1)=unsupported
- # It fails to find uninstalled libraries when the uninstalled
- # path is not listed in the libpath. Setting hardcode_minus_L
- # to unsupported forces relinking
- _LT_TAGVAR(hardcode_minus_L, $1)=yes
- _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-L$libdir'
- _LT_TAGVAR(hardcode_libdir_separator, $1)=
- fi
- ;;
- esac
- shared_flag='-shared'
- if test "$aix_use_runtimelinking" = yes; then
- shared_flag="$shared_flag "'${wl}-G'
- fi
- else
- # not using gcc
- if test "$host_cpu" = ia64; then
- # VisualAge C++, Version 5.5 for AIX 5L for IA-64, Beta 3 Release
- # chokes on -Wl,-G. The following line is correct:
- shared_flag='-G'
- else
- if test "$aix_use_runtimelinking" = yes; then
- shared_flag='${wl}-G'
- else
- shared_flag='${wl}-bM:SRE'
- fi
- fi
- fi
-
- _LT_TAGVAR(export_dynamic_flag_spec, $1)='${wl}-bexpall'
- # It seems that -bexpall does not export symbols beginning with
- # underscore (_), so it is better to generate a list of symbols to export.
- _LT_TAGVAR(always_export_symbols, $1)=yes
- if test "$aix_use_runtimelinking" = yes; then
- # Warning - without using the other runtime loading flags (-brtl),
- # -berok will link without error, but may produce a broken library.
- _LT_TAGVAR(allow_undefined_flag, $1)='-berok'
- # Determine the default libpath from the value encoded in an
- # empty executable.
- _LT_SYS_MODULE_PATH_AIX
- _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='${wl}-blibpath:$libdir:'"$aix_libpath"
- _LT_TAGVAR(archive_expsym_cmds, $1)='$CC -o $output_objdir/$soname $libobjs $deplibs '"\${wl}$no_entry_flag"' $compiler_flags `if test "x${allow_undefined_flag}" != "x"; then $ECHO "X${wl}${allow_undefined_flag}" | $Xsed; else :; fi` '"\${wl}$exp_sym_flag:\$export_symbols $shared_flag"
- else
- if test "$host_cpu" = ia64; then
- _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='${wl}-R $libdir:/usr/lib:/lib'
- _LT_TAGVAR(allow_undefined_flag, $1)="-z nodefs"
- _LT_TAGVAR(archive_expsym_cmds, $1)="\$CC $shared_flag"' -o $output_objdir/$soname $libobjs $deplibs '"\${wl}$no_entry_flag"' $compiler_flags ${wl}${allow_undefined_flag} '"\${wl}$exp_sym_flag:\$export_symbols"
- else
- # Determine the default libpath from the value encoded in an
- # empty executable.
- _LT_SYS_MODULE_PATH_AIX
- _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='${wl}-blibpath:$libdir:'"$aix_libpath"
- # Warning - without using the other run time loading flags,
- # -berok will link without error, but may produce a broken library.
- _LT_TAGVAR(no_undefined_flag, $1)=' ${wl}-bernotok'
- _LT_TAGVAR(allow_undefined_flag, $1)=' ${wl}-berok'
- # Exported symbols can be pulled into shared objects from archives
- _LT_TAGVAR(whole_archive_flag_spec, $1)='$convenience'
- _LT_TAGVAR(archive_cmds_need_lc, $1)=yes
- # This is similar to how AIX traditionally builds its shared libraries.
- _LT_TAGVAR(archive_expsym_cmds, $1)="\$CC $shared_flag"' -o $output_objdir/$soname $libobjs $deplibs ${wl}-bnoentry $compiler_flags ${wl}-bE:$export_symbols${allow_undefined_flag}~$AR $AR_FLAGS $output_objdir/$libname$release.a $output_objdir/$soname'
- fi
- fi
- ;;
-
- amigaos*)
- case $host_cpu in
- powerpc)
- # see comment about AmigaOS4 .so support
- _LT_TAGVAR(archive_cmds, $1)='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib'
- _LT_TAGVAR(archive_expsym_cmds, $1)=''
- ;;
- m68k)
- _LT_TAGVAR(archive_cmds, $1)='$RM $output_objdir/a2ixlibrary.data~$ECHO "#define NAME $libname" > $output_objdir/a2ixlibrary.data~$ECHO "#define LIBRARY_ID 1" >> $output_objdir/a2ixlibrary.data~$ECHO "#define VERSION $major" >> $output_objdir/a2ixlibrary.data~$ECHO "#define REVISION $revision" >> $output_objdir/a2ixlibrary.data~$AR $AR_FLAGS $lib $libobjs~$RANLIB $lib~(cd $output_objdir && a2ixlibrary -32)'
- _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-L$libdir'
- _LT_TAGVAR(hardcode_minus_L, $1)=yes
- ;;
- esac
- ;;
-
- bsdi[[45]]*)
- _LT_TAGVAR(export_dynamic_flag_spec, $1)=-rdynamic
- ;;
-
- cygwin* | mingw* | pw32* | cegcc*)
- # When not using gcc, we currently assume that we are using
- # Microsoft Visual C++.
- # hardcode_libdir_flag_spec is actually meaningless, as there is
- # no search path for DLLs.
- _LT_TAGVAR(hardcode_libdir_flag_spec, $1)=' '
- _LT_TAGVAR(allow_undefined_flag, $1)=unsupported
- # Tell ltmain to make .lib files, not .a files.
- libext=lib
- # Tell ltmain to make .dll files, not .so files.
- shrext_cmds=".dll"
- # FIXME: Setting linknames here is a bad hack.
- _LT_TAGVAR(archive_cmds, $1)='$CC -o $lib $libobjs $compiler_flags `$ECHO "X$deplibs" | $Xsed -e '\''s/ -lc$//'\''` -link -dll~linknames='
- # The linker will automatically build a .lib file if we build a DLL.
- _LT_TAGVAR(old_archive_from_new_cmds, $1)='true'
- # FIXME: Should let the user specify the lib program.
- _LT_TAGVAR(old_archive_cmds, $1)='lib -OUT:$oldlib$oldobjs$old_deplibs'
- _LT_TAGVAR(fix_srcfile_path, $1)='`cygpath -w "$srcfile"`'
- _LT_TAGVAR(enable_shared_with_static_runtimes, $1)=yes
- ;;
-
- darwin* | rhapsody*)
- _LT_DARWIN_LINKER_FEATURES($1)
- ;;
-
- dgux*)
- _LT_TAGVAR(archive_cmds, $1)='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
- _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-L$libdir'
- _LT_TAGVAR(hardcode_shlibpath_var, $1)=no
- ;;
-
- freebsd1*)
- _LT_TAGVAR(ld_shlibs, $1)=no
- ;;
-
- # FreeBSD 2.2.[012] allows us to include c++rt0.o to get C++ constructor
- # support. Future versions do this automatically, but an explicit c++rt0.o
- # does not break anything, and helps significantly (at the cost of a little
- # extra space).
- freebsd2.2*)
- _LT_TAGVAR(archive_cmds, $1)='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags /usr/lib/c++rt0.o'
- _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-R$libdir'
- _LT_TAGVAR(hardcode_direct, $1)=yes
- _LT_TAGVAR(hardcode_shlibpath_var, $1)=no
- ;;
-
- # Unfortunately, older versions of FreeBSD 2 do not have this feature.
- freebsd2*)
- _LT_TAGVAR(archive_cmds, $1)='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags'
- _LT_TAGVAR(hardcode_direct, $1)=yes
- _LT_TAGVAR(hardcode_minus_L, $1)=yes
- _LT_TAGVAR(hardcode_shlibpath_var, $1)=no
- ;;
-
- # FreeBSD 3 and greater uses gcc -shared to do shared libraries.
- freebsd* | dragonfly*)
- _LT_TAGVAR(archive_cmds, $1)='$CC -shared -o $lib $libobjs $deplibs $compiler_flags'
- _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-R$libdir'
- _LT_TAGVAR(hardcode_direct, $1)=yes
- _LT_TAGVAR(hardcode_shlibpath_var, $1)=no
- ;;
-
- hpux9*)
- if test "$GCC" = yes; then
- _LT_TAGVAR(archive_cmds, $1)='$RM $output_objdir/$soname~$CC -shared -fPIC ${wl}+b ${wl}$install_libdir -o $output_objdir/$soname $libobjs $deplibs $compiler_flags~test $output_objdir/$soname = $lib || mv $output_objdir/$soname $lib'
- else
- _LT_TAGVAR(archive_cmds, $1)='$RM $output_objdir/$soname~$LD -b +b $install_libdir -o $output_objdir/$soname $libobjs $deplibs $linker_flags~test $output_objdir/$soname = $lib || mv $output_objdir/$soname $lib'
- fi
- _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='${wl}+b ${wl}$libdir'
- _LT_TAGVAR(hardcode_libdir_separator, $1)=:
- _LT_TAGVAR(hardcode_direct, $1)=yes
-
- # hardcode_minus_L: Not really in the search PATH,
- # but as the default location of the library.
- _LT_TAGVAR(hardcode_minus_L, $1)=yes
- _LT_TAGVAR(export_dynamic_flag_spec, $1)='${wl}-E'
- ;;
-
- hpux10*)
- if test "$GCC" = yes -a "$with_gnu_ld" = no; then
- _LT_TAGVAR(archive_cmds, $1)='$CC -shared -fPIC ${wl}+h ${wl}$soname ${wl}+b ${wl}$install_libdir -o $lib $libobjs $deplibs $compiler_flags'
- else
- _LT_TAGVAR(archive_cmds, $1)='$LD -b +h $soname +b $install_libdir -o $lib $libobjs $deplibs $linker_flags'
- fi
- if test "$with_gnu_ld" = no; then
- _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='${wl}+b ${wl}$libdir'
- _LT_TAGVAR(hardcode_libdir_flag_spec_ld, $1)='+b $libdir'
- _LT_TAGVAR(hardcode_libdir_separator, $1)=:
- _LT_TAGVAR(hardcode_direct, $1)=yes
- _LT_TAGVAR(hardcode_direct_absolute, $1)=yes
- _LT_TAGVAR(export_dynamic_flag_spec, $1)='${wl}-E'
- # hardcode_minus_L: Not really in the search PATH,
- # but as the default location of the library.
- _LT_TAGVAR(hardcode_minus_L, $1)=yes
- fi
- ;;
-
- hpux11*)
- if test "$GCC" = yes -a "$with_gnu_ld" = no; then
- case $host_cpu in
- hppa*64*)
- _LT_TAGVAR(archive_cmds, $1)='$CC -shared ${wl}+h ${wl}$soname -o $lib $libobjs $deplibs $compiler_flags'
- ;;
- ia64*)
- _LT_TAGVAR(archive_cmds, $1)='$CC -shared -fPIC ${wl}+h ${wl}$soname ${wl}+nodefaultrpath -o $lib $libobjs $deplibs $compiler_flags'
- ;;
- *)
- _LT_TAGVAR(archive_cmds, $1)='$CC -shared -fPIC ${wl}+h ${wl}$soname ${wl}+b ${wl}$install_libdir -o $lib $libobjs $deplibs $compiler_flags'
- ;;
- esac
- else
- case $host_cpu in
- hppa*64*)
- _LT_TAGVAR(archive_cmds, $1)='$CC -b ${wl}+h ${wl}$soname -o $lib $libobjs $deplibs $compiler_flags'
- ;;
- ia64*)
- _LT_TAGVAR(archive_cmds, $1)='$CC -b ${wl}+h ${wl}$soname ${wl}+nodefaultrpath -o $lib $libobjs $deplibs $compiler_flags'
- ;;
- *)
- _LT_TAGVAR(archive_cmds, $1)='$CC -b ${wl}+h ${wl}$soname ${wl}+b ${wl}$install_libdir -o $lib $libobjs $deplibs $compiler_flags'
- ;;
- esac
- fi
- if test "$with_gnu_ld" = no; then
- _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='${wl}+b ${wl}$libdir'
- _LT_TAGVAR(hardcode_libdir_separator, $1)=:
-
- case $host_cpu in
- hppa*64*|ia64*)
- _LT_TAGVAR(hardcode_direct, $1)=no
- _LT_TAGVAR(hardcode_shlibpath_var, $1)=no
- ;;
- *)
- _LT_TAGVAR(hardcode_direct, $1)=yes
- _LT_TAGVAR(hardcode_direct_absolute, $1)=yes
- _LT_TAGVAR(export_dynamic_flag_spec, $1)='${wl}-E'
-
- # hardcode_minus_L: Not really in the search PATH,
- # but as the default location of the library.
- _LT_TAGVAR(hardcode_minus_L, $1)=yes
- ;;
- esac
- fi
- ;;
-
- irix5* | irix6* | nonstopux*)
- if test "$GCC" = yes; then
- _LT_TAGVAR(archive_cmds, $1)='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname ${wl}$soname `test -n "$verstring" && $ECHO "X${wl}-set_version ${wl}$verstring" | $Xsed` ${wl}-update_registry ${wl}${output_objdir}/so_locations -o $lib'
- # Try to use the -exported_symbol ld option, if it does not
- # work, assume that -exports_file does not work either and
- # implicitly export all symbols.
- save_LDFLAGS="$LDFLAGS"
- LDFLAGS="$LDFLAGS -shared ${wl}-exported_symbol ${wl}foo ${wl}-update_registry ${wl}/dev/null"
- AC_LINK_IFELSE(int foo(void) {},
- _LT_TAGVAR(archive_expsym_cmds, $1)='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname ${wl}$soname `test -n "$verstring" && $ECHO "X${wl}-set_version ${wl}$verstring" | $Xsed` ${wl}-update_registry ${wl}${output_objdir}/so_locations ${wl}-exports_file ${wl}$export_symbols -o $lib'
- )
- LDFLAGS="$save_LDFLAGS"
- else
- _LT_TAGVAR(archive_cmds, $1)='$CC -shared $libobjs $deplibs $compiler_flags -soname $soname `test -n "$verstring" && $ECHO "X-set_version $verstring" | $Xsed` -update_registry ${output_objdir}/so_locations -o $lib'
- _LT_TAGVAR(archive_expsym_cmds, $1)='$CC -shared $libobjs $deplibs $compiler_flags -soname $soname `test -n "$verstring" && $ECHO "X-set_version $verstring" | $Xsed` -update_registry ${output_objdir}/so_locations -exports_file $export_symbols -o $lib'
- fi
- _LT_TAGVAR(archive_cmds_need_lc, $1)='no'
- _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='${wl}-rpath ${wl}$libdir'
- _LT_TAGVAR(hardcode_libdir_separator, $1)=:
- _LT_TAGVAR(inherit_rpath, $1)=yes
- _LT_TAGVAR(link_all_deplibs, $1)=yes
- ;;
-
- netbsd*)
- if echo __ELF__ | $CC -E - | $GREP __ELF__ >/dev/null; then
- _LT_TAGVAR(archive_cmds, $1)='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags' # a.out
- else
- _LT_TAGVAR(archive_cmds, $1)='$LD -shared -o $lib $libobjs $deplibs $linker_flags' # ELF
- fi
- _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-R$libdir'
- _LT_TAGVAR(hardcode_direct, $1)=yes
- _LT_TAGVAR(hardcode_shlibpath_var, $1)=no
- ;;
-
- newsos6)
- _LT_TAGVAR(archive_cmds, $1)='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
- _LT_TAGVAR(hardcode_direct, $1)=yes
- _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='${wl}-rpath ${wl}$libdir'
- _LT_TAGVAR(hardcode_libdir_separator, $1)=:
- _LT_TAGVAR(hardcode_shlibpath_var, $1)=no
- ;;
-
- *nto* | *qnx*)
- ;;
-
- openbsd*)
- if test -f /usr/libexec/ld.so; then
- _LT_TAGVAR(hardcode_direct, $1)=yes
- _LT_TAGVAR(hardcode_shlibpath_var, $1)=no
- _LT_TAGVAR(hardcode_direct_absolute, $1)=yes
- if test -z "`echo __ELF__ | $CC -E - | $GREP __ELF__`" || test "$host_os-$host_cpu" = "openbsd2.8-powerpc"; then
- _LT_TAGVAR(archive_cmds, $1)='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags'
- _LT_TAGVAR(archive_expsym_cmds, $1)='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags ${wl}-retain-symbols-file,$export_symbols'
- _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='${wl}-rpath,$libdir'
- _LT_TAGVAR(export_dynamic_flag_spec, $1)='${wl}-E'
- else
- case $host_os in
- openbsd[[01]].* | openbsd2.[[0-7]] | openbsd2.[[0-7]].*)
- _LT_TAGVAR(archive_cmds, $1)='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags'
- _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-R$libdir'
- ;;
- *)
- _LT_TAGVAR(archive_cmds, $1)='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags'
- _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='${wl}-rpath,$libdir'
- ;;
- esac
- fi
- else
- _LT_TAGVAR(ld_shlibs, $1)=no
- fi
- ;;
-
- os2*)
- _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-L$libdir'
- _LT_TAGVAR(hardcode_minus_L, $1)=yes
- _LT_TAGVAR(allow_undefined_flag, $1)=unsupported
- _LT_TAGVAR(archive_cmds, $1)='$ECHO "LIBRARY $libname INITINSTANCE" > $output_objdir/$libname.def~$ECHO "DESCRIPTION \"$libname\"" >> $output_objdir/$libname.def~$ECHO DATA >> $output_objdir/$libname.def~$ECHO " SINGLE NONSHARED" >> $output_objdir/$libname.def~$ECHO EXPORTS >> $output_objdir/$libname.def~emxexp $libobjs >> $output_objdir/$libname.def~$CC -Zdll -Zcrtdll -o $lib $libobjs $deplibs $compiler_flags $output_objdir/$libname.def'
- _LT_TAGVAR(old_archive_from_new_cmds, $1)='emximp -o $output_objdir/$libname.a $output_objdir/$libname.def'
- ;;
-
- osf3*)
- if test "$GCC" = yes; then
- _LT_TAGVAR(allow_undefined_flag, $1)=' ${wl}-expect_unresolved ${wl}\*'
- _LT_TAGVAR(archive_cmds, $1)='$CC -shared${allow_undefined_flag} $libobjs $deplibs $compiler_flags ${wl}-soname ${wl}$soname `test -n "$verstring" && $ECHO "X${wl}-set_version ${wl}$verstring" | $Xsed` ${wl}-update_registry ${wl}${output_objdir}/so_locations -o $lib'
- else
- _LT_TAGVAR(allow_undefined_flag, $1)=' -expect_unresolved \*'
- _LT_TAGVAR(archive_cmds, $1)='$CC -shared${allow_undefined_flag} $libobjs $deplibs $compiler_flags -soname $soname `test -n "$verstring" && $ECHO "X-set_version $verstring" | $Xsed` -update_registry ${output_objdir}/so_locations -o $lib'
- fi
- _LT_TAGVAR(archive_cmds_need_lc, $1)='no'
- _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='${wl}-rpath ${wl}$libdir'
- _LT_TAGVAR(hardcode_libdir_separator, $1)=:
- ;;
-
- osf4* | osf5*) # as osf3* with the addition of -msym flag
- if test "$GCC" = yes; then
- _LT_TAGVAR(allow_undefined_flag, $1)=' ${wl}-expect_unresolved ${wl}\*'
- _LT_TAGVAR(archive_cmds, $1)='$CC -shared${allow_undefined_flag} $libobjs $deplibs $compiler_flags ${wl}-msym ${wl}-soname ${wl}$soname `test -n "$verstring" && $ECHO "X${wl}-set_version ${wl}$verstring" | $Xsed` ${wl}-update_registry ${wl}${output_objdir}/so_locations -o $lib'
- _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='${wl}-rpath ${wl}$libdir'
- else
- _LT_TAGVAR(allow_undefined_flag, $1)=' -expect_unresolved \*'
- _LT_TAGVAR(archive_cmds, $1)='$CC -shared${allow_undefined_flag} $libobjs $deplibs $compiler_flags -msym -soname $soname `test -n "$verstring" && $ECHO "X-set_version $verstring" | $Xsed` -update_registry ${output_objdir}/so_locations -o $lib'
- _LT_TAGVAR(archive_expsym_cmds, $1)='for i in `cat $export_symbols`; do printf "%s %s\\n" -exported_symbol "\$i" >> $lib.exp; done; printf "%s\\n" "-hidden">> $lib.exp~
- $CC -shared${allow_undefined_flag} ${wl}-input ${wl}$lib.exp $compiler_flags $libobjs $deplibs -soname $soname `test -n "$verstring" && $ECHO "X-set_version $verstring" | $Xsed` -update_registry ${output_objdir}/so_locations -o $lib~$RM $lib.exp'
-
- # Both c and cxx compiler support -rpath directly
- _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-rpath $libdir'
- fi
- _LT_TAGVAR(archive_cmds_need_lc, $1)='no'
- _LT_TAGVAR(hardcode_libdir_separator, $1)=:
- ;;
-
- solaris*)
- _LT_TAGVAR(no_undefined_flag, $1)=' -z defs'
- if test "$GCC" = yes; then
- wlarc='${wl}'
- _LT_TAGVAR(archive_cmds, $1)='$CC -shared ${wl}-z ${wl}text ${wl}-h ${wl}$soname -o $lib $libobjs $deplibs $compiler_flags'
- _LT_TAGVAR(archive_expsym_cmds, $1)='echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~echo "local: *; };" >> $lib.exp~
- $CC -shared ${wl}-z ${wl}text ${wl}-M ${wl}$lib.exp ${wl}-h ${wl}$soname -o $lib $libobjs $deplibs $compiler_flags~$RM $lib.exp'
- else
- case `$CC -V 2>&1` in
- *"Compilers 5.0"*)
- wlarc=''
- _LT_TAGVAR(archive_cmds, $1)='$LD -G${allow_undefined_flag} -h $soname -o $lib $libobjs $deplibs $linker_flags'
- _LT_TAGVAR(archive_expsym_cmds, $1)='echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~echo "local: *; };" >> $lib.exp~
- $LD -G${allow_undefined_flag} -M $lib.exp -h $soname -o $lib $libobjs $deplibs $linker_flags~$RM $lib.exp'
- ;;
- *)
- wlarc='${wl}'
- _LT_TAGVAR(archive_cmds, $1)='$CC -G${allow_undefined_flag} -h $soname -o $lib $libobjs $deplibs $compiler_flags'
- _LT_TAGVAR(archive_expsym_cmds, $1)='echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~echo "local: *; };" >> $lib.exp~
- $CC -G${allow_undefined_flag} -M $lib.exp -h $soname -o $lib $libobjs $deplibs $compiler_flags~$RM $lib.exp'
- ;;
- esac
- fi
- _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-R$libdir'
- _LT_TAGVAR(hardcode_shlibpath_var, $1)=no
- case $host_os in
- solaris2.[[0-5]] | solaris2.[[0-5]].*) ;;
- *)
- # The compiler driver will combine and reorder linker options,
- # but understands `-z linker_flag'. GCC discards it without `$wl',
- # but is careful enough not to reorder.
- # Supported since Solaris 2.6 (maybe 2.5.1?)
- if test "$GCC" = yes; then
- _LT_TAGVAR(whole_archive_flag_spec, $1)='${wl}-z ${wl}allextract$convenience ${wl}-z ${wl}defaultextract'
- else
- _LT_TAGVAR(whole_archive_flag_spec, $1)='-z allextract$convenience -z defaultextract'
- fi
- ;;
- esac
- _LT_TAGVAR(link_all_deplibs, $1)=yes
- ;;
-
- sunos4*)
- if test "x$host_vendor" = xsequent; then
- # Use $CC to link under sequent, because it throws in some extra .o
- # files that make .init and .fini sections work.
- _LT_TAGVAR(archive_cmds, $1)='$CC -G ${wl}-h $soname -o $lib $libobjs $deplibs $compiler_flags'
- else
- _LT_TAGVAR(archive_cmds, $1)='$LD -assert pure-text -Bstatic -o $lib $libobjs $deplibs $linker_flags'
- fi
- _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-L$libdir'
- _LT_TAGVAR(hardcode_direct, $1)=yes
- _LT_TAGVAR(hardcode_minus_L, $1)=yes
- _LT_TAGVAR(hardcode_shlibpath_var, $1)=no
- ;;
-
- sysv4)
- case $host_vendor in
- sni)
- _LT_TAGVAR(archive_cmds, $1)='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
- _LT_TAGVAR(hardcode_direct, $1)=yes # is this really true???
- ;;
- siemens)
- ## LD is ld it makes a PLAMLIB
- ## CC just makes a GrossModule.
- _LT_TAGVAR(archive_cmds, $1)='$LD -G -o $lib $libobjs $deplibs $linker_flags'
- _LT_TAGVAR(reload_cmds, $1)='$CC -r -o $output$reload_objs'
- _LT_TAGVAR(hardcode_direct, $1)=no
- ;;
- motorola)
- _LT_TAGVAR(archive_cmds, $1)='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
- _LT_TAGVAR(hardcode_direct, $1)=no #Motorola manual says yes, but my tests say they lie
- ;;
- esac
- runpath_var='LD_RUN_PATH'
- _LT_TAGVAR(hardcode_shlibpath_var, $1)=no
- ;;
-
- sysv4.3*)
- _LT_TAGVAR(archive_cmds, $1)='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
- _LT_TAGVAR(hardcode_shlibpath_var, $1)=no
- _LT_TAGVAR(export_dynamic_flag_spec, $1)='-Bexport'
- ;;
-
- sysv4*MP*)
- if test -d /usr/nec; then
- _LT_TAGVAR(archive_cmds, $1)='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
- _LT_TAGVAR(hardcode_shlibpath_var, $1)=no
- runpath_var=LD_RUN_PATH
- hardcode_runpath_var=yes
- _LT_TAGVAR(ld_shlibs, $1)=yes
- fi
- ;;
-
- sysv4*uw2* | sysv5OpenUNIX* | sysv5UnixWare7.[[01]].[[10]]* | unixware7* | sco3.2v5.0.[[024]]*)
- _LT_TAGVAR(no_undefined_flag, $1)='${wl}-z,text'
- _LT_TAGVAR(archive_cmds_need_lc, $1)=no
- _LT_TAGVAR(hardcode_shlibpath_var, $1)=no
- runpath_var='LD_RUN_PATH'
-
- if test "$GCC" = yes; then
- _LT_TAGVAR(archive_cmds, $1)='$CC -shared ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
- _LT_TAGVAR(archive_expsym_cmds, $1)='$CC -shared ${wl}-Bexport:$export_symbols ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
- else
- _LT_TAGVAR(archive_cmds, $1)='$CC -G ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
- _LT_TAGVAR(archive_expsym_cmds, $1)='$CC -G ${wl}-Bexport:$export_symbols ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
- fi
- ;;
-
- sysv5* | sco3.2v5* | sco5v6*)
- # Note: We can NOT use -z defs as we might desire, because we do not
- # link with -lc, and that would cause any symbols used from libc to
- # always be unresolved, which means just about no library would
- # ever link correctly. If we're not using GNU ld we use -z text
- # though, which does catch some bad symbols but isn't as heavy-handed
- # as -z defs.
- _LT_TAGVAR(no_undefined_flag, $1)='${wl}-z,text'
- _LT_TAGVAR(allow_undefined_flag, $1)='${wl}-z,nodefs'
- _LT_TAGVAR(archive_cmds_need_lc, $1)=no
- _LT_TAGVAR(hardcode_shlibpath_var, $1)=no
- _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='${wl}-R,$libdir'
- _LT_TAGVAR(hardcode_libdir_separator, $1)=':'
- _LT_TAGVAR(link_all_deplibs, $1)=yes
- _LT_TAGVAR(export_dynamic_flag_spec, $1)='${wl}-Bexport'
- runpath_var='LD_RUN_PATH'
-
- if test "$GCC" = yes; then
- _LT_TAGVAR(archive_cmds, $1)='$CC -shared ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
- _LT_TAGVAR(archive_expsym_cmds, $1)='$CC -shared ${wl}-Bexport:$export_symbols ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
- else
- _LT_TAGVAR(archive_cmds, $1)='$CC -G ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
- _LT_TAGVAR(archive_expsym_cmds, $1)='$CC -G ${wl}-Bexport:$export_symbols ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
- fi
- ;;
-
- uts4*)
- _LT_TAGVAR(archive_cmds, $1)='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
- _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-L$libdir'
- _LT_TAGVAR(hardcode_shlibpath_var, $1)=no
- ;;
-
- *)
- _LT_TAGVAR(ld_shlibs, $1)=no
- ;;
- esac
-
- if test x$host_vendor = xsni; then
- case $host in
- sysv4 | sysv4.2uw2* | sysv4.3* | sysv5*)
- _LT_TAGVAR(export_dynamic_flag_spec, $1)='${wl}-Blargedynsym'
- ;;
- esac
- fi
- fi
-])
-AC_MSG_RESULT([$_LT_TAGVAR(ld_shlibs, $1)])
-test "$_LT_TAGVAR(ld_shlibs, $1)" = no && can_build_shared=no
-
-_LT_TAGVAR(with_gnu_ld, $1)=$with_gnu_ld
-
-_LT_DECL([], [libext], [0], [Old archive suffix (normally "a")])dnl
-_LT_DECL([], [shrext_cmds], [1], [Shared library suffix (normally ".so")])dnl
-_LT_DECL([], [extract_expsyms_cmds], [2],
- [The commands to extract the exported symbol list from a shared archive])
-
-#
-# Do we need to explicitly link libc?
-#
-case "x$_LT_TAGVAR(archive_cmds_need_lc, $1)" in
-x|xyes)
- # Assume -lc should be added
- _LT_TAGVAR(archive_cmds_need_lc, $1)=yes
-
- if test "$enable_shared" = yes && test "$GCC" = yes; then
- case $_LT_TAGVAR(archive_cmds, $1) in
- *'~'*)
- # FIXME: we may have to deal with multi-command sequences.
- ;;
- '$CC '*)
- # Test whether the compiler implicitly links with -lc since on some
- # systems, -lgcc has to come before -lc. If gcc already passes -lc
- # to ld, don't add -lc before -lgcc.
- AC_MSG_CHECKING([whether -lc should be explicitly linked in])
- $RM conftest*
- echo "$lt_simple_compile_test_code" > conftest.$ac_ext
-
- if AC_TRY_EVAL(ac_compile) 2>conftest.err; then
- soname=conftest
- lib=conftest
- libobjs=conftest.$ac_objext
- deplibs=
- wl=$_LT_TAGVAR(lt_prog_compiler_wl, $1)
- pic_flag=$_LT_TAGVAR(lt_prog_compiler_pic, $1)
- compiler_flags=-v
- linker_flags=-v
- verstring=
- output_objdir=.
- libname=conftest
- lt_save_allow_undefined_flag=$_LT_TAGVAR(allow_undefined_flag, $1)
- _LT_TAGVAR(allow_undefined_flag, $1)=
- if AC_TRY_EVAL(_LT_TAGVAR(archive_cmds, $1) 2\>\&1 \| $GREP \" -lc \" \>/dev/null 2\>\&1)
- then
- _LT_TAGVAR(archive_cmds_need_lc, $1)=no
- else
- _LT_TAGVAR(archive_cmds_need_lc, $1)=yes
- fi
- _LT_TAGVAR(allow_undefined_flag, $1)=$lt_save_allow_undefined_flag
- else
- cat conftest.err 1>&5
- fi
- $RM conftest*
- AC_MSG_RESULT([$_LT_TAGVAR(archive_cmds_need_lc, $1)])
- ;;
- esac
- fi
- ;;
-esac
-
-_LT_TAGDECL([build_libtool_need_lc], [archive_cmds_need_lc], [0],
- [Whether or not to add -lc for building shared libraries])
-_LT_TAGDECL([allow_libtool_libs_with_static_runtimes],
- [enable_shared_with_static_runtimes], [0],
- [Whether or not to disallow shared libs when runtime libs are static])
-_LT_TAGDECL([], [export_dynamic_flag_spec], [1],
- [Compiler flag to allow reflexive dlopens])
-_LT_TAGDECL([], [whole_archive_flag_spec], [1],
- [Compiler flag to generate shared objects directly from archives])
-_LT_TAGDECL([], [compiler_needs_object], [1],
- [Whether the compiler copes with passing no objects directly])
-_LT_TAGDECL([], [old_archive_from_new_cmds], [2],
- [Create an old-style archive from a shared archive])
-_LT_TAGDECL([], [old_archive_from_expsyms_cmds], [2],
- [Create a temporary old-style archive to link instead of a shared archive])
-_LT_TAGDECL([], [archive_cmds], [2], [Commands used to build a shared archive])
-_LT_TAGDECL([], [archive_expsym_cmds], [2])
-_LT_TAGDECL([], [module_cmds], [2],
- [Commands used to build a loadable module if different from building
- a shared archive.])
-_LT_TAGDECL([], [module_expsym_cmds], [2])
-_LT_TAGDECL([], [with_gnu_ld], [1],
- [Whether we are building with GNU ld or not])
-_LT_TAGDECL([], [allow_undefined_flag], [1],
- [Flag that allows shared libraries with undefined symbols to be built])
-_LT_TAGDECL([], [no_undefined_flag], [1],
- [Flag that enforces no undefined symbols])
-_LT_TAGDECL([], [hardcode_libdir_flag_spec], [1],
- [Flag to hardcode $libdir into a binary during linking.
- This must work even if $libdir does not exist])
-_LT_TAGDECL([], [hardcode_libdir_flag_spec_ld], [1],
- [[If ld is used when linking, flag to hardcode $libdir into a binary
- during linking. This must work even if $libdir does not exist]])
-_LT_TAGDECL([], [hardcode_libdir_separator], [1],
- [Whether we need a single "-rpath" flag with a separated argument])
-_LT_TAGDECL([], [hardcode_direct], [0],
- [Set to "yes" if using DIR/libNAME${shared_ext} during linking hardcodes
- DIR into the resulting binary])
-_LT_TAGDECL([], [hardcode_direct_absolute], [0],
- [Set to "yes" if using DIR/libNAME${shared_ext} during linking hardcodes
- DIR into the resulting binary and the resulting library dependency is
- "absolute", i.e impossible to change by setting ${shlibpath_var} if the
- library is relocated])
-_LT_TAGDECL([], [hardcode_minus_L], [0],
- [Set to "yes" if using the -LDIR flag during linking hardcodes DIR
- into the resulting binary])
-_LT_TAGDECL([], [hardcode_shlibpath_var], [0],
- [Set to "yes" if using SHLIBPATH_VAR=DIR during linking hardcodes DIR
- into the resulting binary])
-_LT_TAGDECL([], [hardcode_automatic], [0],
- [Set to "yes" if building a shared library automatically hardcodes DIR
- into the library and all subsequent libraries and executables linked
- against it])
-_LT_TAGDECL([], [inherit_rpath], [0],
- [Set to yes if linker adds runtime paths of dependent libraries
- to runtime path list])
-_LT_TAGDECL([], [link_all_deplibs], [0],
- [Whether libtool must link a program against all its dependency libraries])
-_LT_TAGDECL([], [fix_srcfile_path], [1],
- [Fix the shell variable $srcfile for the compiler])
-_LT_TAGDECL([], [always_export_symbols], [0],
- [Set to "yes" if exported symbols are required])
-_LT_TAGDECL([], [export_symbols_cmds], [2],
- [The commands to list exported symbols])
-_LT_TAGDECL([], [exclude_expsyms], [1],
- [Symbols that should not be listed in the preloaded symbols])
-_LT_TAGDECL([], [include_expsyms], [1],
- [Symbols that must always be exported])
-_LT_TAGDECL([], [prelink_cmds], [2],
- [Commands necessary for linking programs (against libraries) with templates])
-_LT_TAGDECL([], [file_list_spec], [1],
- [Specify filename containing input files])
-dnl FIXME: Not yet implemented
-dnl _LT_TAGDECL([], [thread_safe_flag_spec], [1],
-dnl [Compiler flag to generate thread safe objects])
-])# _LT_LINKER_SHLIBS
-
-
-# _LT_LANG_C_CONFIG([TAG])
-# ------------------------
-# Ensure that the configuration variables for a C compiler are suitably
-# defined. These variables are subsequently used by _LT_CONFIG to write
-# the compiler configuration to `libtool'.
-m4_defun([_LT_LANG_C_CONFIG],
-[m4_require([_LT_DECL_EGREP])dnl
-lt_save_CC="$CC"
-AC_LANG_PUSH(C)
-
-# Source file extension for C test sources.
-ac_ext=c
-
-# Object file extension for compiled C test sources.
-objext=o
-_LT_TAGVAR(objext, $1)=$objext
-
-# Code to be used in simple compile tests
-lt_simple_compile_test_code="int some_variable = 0;"
-
-# Code to be used in simple link tests
-lt_simple_link_test_code='int main(){return(0);}'
-
-_LT_TAG_COMPILER
-# Save the default compiler, since it gets overwritten when the other
-# tags are being tested, and _LT_TAGVAR(compiler, []) is a NOP.
-compiler_DEFAULT=$CC
-
-# save warnings/boilerplate of simple test code
-_LT_COMPILER_BOILERPLATE
-_LT_LINKER_BOILERPLATE
-
-## CAVEAT EMPTOR:
-## There is no encapsulation within the following macros, do not change
-## the running order or otherwise move them around unless you know exactly
-## what you are doing...
-if test -n "$compiler"; then
- _LT_COMPILER_NO_RTTI($1)
- _LT_COMPILER_PIC($1)
- _LT_COMPILER_C_O($1)
- _LT_COMPILER_FILE_LOCKS($1)
- _LT_LINKER_SHLIBS($1)
- _LT_SYS_DYNAMIC_LINKER($1)
- _LT_LINKER_HARDCODE_LIBPATH($1)
- LT_SYS_DLOPEN_SELF
- _LT_CMD_STRIPLIB
-
- # Report which library types will actually be built
- AC_MSG_CHECKING([if libtool supports shared libraries])
- AC_MSG_RESULT([$can_build_shared])
-
- AC_MSG_CHECKING([whether to build shared libraries])
- test "$can_build_shared" = "no" && enable_shared=no
-
- # On AIX, shared libraries and static libraries use the same namespace, and
- # are all built from PIC.
- case $host_os in
- aix3*)
- test "$enable_shared" = yes && enable_static=no
- if test -n "$RANLIB"; then
- archive_cmds="$archive_cmds~\$RANLIB \$lib"
- postinstall_cmds='$RANLIB $lib'
- fi
- ;;
-
- aix[[4-9]]*)
- if test "$host_cpu" != ia64 && test "$aix_use_runtimelinking" = no ; then
- test "$enable_shared" = yes && enable_static=no
- fi
- ;;
- esac
- AC_MSG_RESULT([$enable_shared])
-
- AC_MSG_CHECKING([whether to build static libraries])
- # Make sure either enable_shared or enable_static is yes.
- test "$enable_shared" = yes || enable_static=yes
- AC_MSG_RESULT([$enable_static])
-
- _LT_CONFIG($1)
-fi
-AC_LANG_POP
-CC="$lt_save_CC"
-])# _LT_LANG_C_CONFIG
-
-
-# _LT_PROG_CXX
-# ------------
-# Since AC_PROG_CXX is broken, in that it returns g++ if there is no c++
-# compiler, we have our own version here.
-m4_defun([_LT_PROG_CXX],
-[
-pushdef([AC_MSG_ERROR], [_lt_caught_CXX_error=yes])
-AC_PROG_CXX
-if test -n "$CXX" && ( test "X$CXX" != "Xno" &&
- ( (test "X$CXX" = "Xg++" && `g++ -v >/dev/null 2>&1` ) ||
- (test "X$CXX" != "Xg++"))) ; then
- AC_PROG_CXXCPP
-else
- _lt_caught_CXX_error=yes
-fi
-popdef([AC_MSG_ERROR])
-])# _LT_PROG_CXX
-
-dnl aclocal-1.4 backwards compatibility:
-dnl AC_DEFUN([_LT_PROG_CXX], [])
-
-
-# _LT_LANG_CXX_CONFIG([TAG])
-# --------------------------
-# Ensure that the configuration variables for a C++ compiler are suitably
-# defined. These variables are subsequently used by _LT_CONFIG to write
-# the compiler configuration to `libtool'.
-m4_defun([_LT_LANG_CXX_CONFIG],
-[AC_REQUIRE([_LT_PROG_CXX])dnl
-m4_require([_LT_FILEUTILS_DEFAULTS])dnl
-m4_require([_LT_DECL_EGREP])dnl
-
-AC_LANG_PUSH(C++)
-_LT_TAGVAR(archive_cmds_need_lc, $1)=no
-_LT_TAGVAR(allow_undefined_flag, $1)=
-_LT_TAGVAR(always_export_symbols, $1)=no
-_LT_TAGVAR(archive_expsym_cmds, $1)=
-_LT_TAGVAR(compiler_needs_object, $1)=no
-_LT_TAGVAR(export_dynamic_flag_spec, $1)=
-_LT_TAGVAR(hardcode_direct, $1)=no
-_LT_TAGVAR(hardcode_direct_absolute, $1)=no
-_LT_TAGVAR(hardcode_libdir_flag_spec, $1)=
-_LT_TAGVAR(hardcode_libdir_flag_spec_ld, $1)=
-_LT_TAGVAR(hardcode_libdir_separator, $1)=
-_LT_TAGVAR(hardcode_minus_L, $1)=no
-_LT_TAGVAR(hardcode_shlibpath_var, $1)=unsupported
-_LT_TAGVAR(hardcode_automatic, $1)=no
-_LT_TAGVAR(inherit_rpath, $1)=no
-_LT_TAGVAR(module_cmds, $1)=
-_LT_TAGVAR(module_expsym_cmds, $1)=
-_LT_TAGVAR(link_all_deplibs, $1)=unknown
-_LT_TAGVAR(old_archive_cmds, $1)=$old_archive_cmds
-_LT_TAGVAR(no_undefined_flag, $1)=
-_LT_TAGVAR(whole_archive_flag_spec, $1)=
-_LT_TAGVAR(enable_shared_with_static_runtimes, $1)=no
-
-# Source file extension for C++ test sources.
-ac_ext=cpp
-
-# Object file extension for compiled C++ test sources.
-objext=o
-_LT_TAGVAR(objext, $1)=$objext
-
-# No sense in running all these tests if we already determined that
-# the CXX compiler isn't working. Some variables (like enable_shared)
-# are currently assumed to apply to all compilers on this platform,
-# and will be corrupted by setting them based on a non-working compiler.
-if test "$_lt_caught_CXX_error" != yes; then
- # Code to be used in simple compile tests
- lt_simple_compile_test_code="int some_variable = 0;"
-
- # Code to be used in simple link tests
- lt_simple_link_test_code='int main(int, char *[[]]) { return(0); }'
-
- # ltmain only uses $CC for tagged configurations so make sure $CC is set.
- _LT_TAG_COMPILER
-
- # save warnings/boilerplate of simple test code
- _LT_COMPILER_BOILERPLATE
- _LT_LINKER_BOILERPLATE
-
- # Allow CC to be a program name with arguments.
- lt_save_CC=$CC
- lt_save_LD=$LD
- lt_save_GCC=$GCC
- GCC=$GXX
- lt_save_with_gnu_ld=$with_gnu_ld
- lt_save_path_LD=$lt_cv_path_LD
- if test -n "${lt_cv_prog_gnu_ldcxx+set}"; then
- lt_cv_prog_gnu_ld=$lt_cv_prog_gnu_ldcxx
- else
- $as_unset lt_cv_prog_gnu_ld
- fi
- if test -n "${lt_cv_path_LDCXX+set}"; then
- lt_cv_path_LD=$lt_cv_path_LDCXX
- else
- $as_unset lt_cv_path_LD
- fi
- test -z "${LDCXX+set}" || LD=$LDCXX
- CC=${CXX-"c++"}
- compiler=$CC
- _LT_TAGVAR(compiler, $1)=$CC
- _LT_CC_BASENAME([$compiler])
-
- if test -n "$compiler"; then
- # We don't want -fno-exception when compiling C++ code, so set the
- # no_builtin_flag separately
- if test "$GXX" = yes; then
- _LT_TAGVAR(lt_prog_compiler_no_builtin_flag, $1)=' -fno-builtin'
- else
- _LT_TAGVAR(lt_prog_compiler_no_builtin_flag, $1)=
- fi
-
- if test "$GXX" = yes; then
- # Set up default GNU C++ configuration
-
- LT_PATH_LD
-
- # Check if GNU C++ uses GNU ld as the underlying linker, since the
- # archiving commands below assume that GNU ld is being used.
- if test "$with_gnu_ld" = yes; then
- _LT_TAGVAR(archive_cmds, $1)='$CC -shared -nostdlib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags ${wl}-soname $wl$soname -o $lib'
- _LT_TAGVAR(archive_expsym_cmds, $1)='$CC -shared -nostdlib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags ${wl}-soname $wl$soname ${wl}-retain-symbols-file $wl$export_symbols -o $lib'
-
- _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='${wl}-rpath ${wl}$libdir'
- _LT_TAGVAR(export_dynamic_flag_spec, $1)='${wl}--export-dynamic'
-
- # If archive_cmds runs LD, not CC, wlarc should be empty
- # XXX I think wlarc can be eliminated in ltcf-cxx, but I need to
- # investigate it a little bit more. (MM)
- wlarc='${wl}'
-
- # ancient GNU ld didn't support --whole-archive et. al.
- if eval "`$CC -print-prog-name=ld` --help 2>&1" |
- $GREP 'no-whole-archive' > /dev/null; then
- _LT_TAGVAR(whole_archive_flag_spec, $1)="$wlarc"'--whole-archive$convenience '"$wlarc"'--no-whole-archive'
- else
- _LT_TAGVAR(whole_archive_flag_spec, $1)=
- fi
- else
- with_gnu_ld=no
- wlarc=
-
- # A generic and very simple default shared library creation
- # command for GNU C++ for the case where it uses the native
- # linker, instead of GNU ld. If possible, this setting should
- # overridden to take advantage of the native linker features on
- # the platform it is being used on.
- _LT_TAGVAR(archive_cmds, $1)='$CC -shared -nostdlib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags -o $lib'
- fi
-
- # Commands to make compiler produce verbose output that lists
- # what "hidden" libraries, object files and flags are used when
- # linking a shared library.
- output_verbose_link_cmd='$CC -shared $CFLAGS -v conftest.$objext 2>&1 | $GREP "\-L"'
-
- else
- GXX=no
- with_gnu_ld=no
- wlarc=
- fi
-
- # PORTME: fill in a description of your system's C++ link characteristics
- AC_MSG_CHECKING([whether the $compiler linker ($LD) supports shared libraries])
- _LT_TAGVAR(ld_shlibs, $1)=yes
- case $host_os in
- aix3*)
- # FIXME: insert proper C++ library support
- _LT_TAGVAR(ld_shlibs, $1)=no
- ;;
- aix[[4-9]]*)
- if test "$host_cpu" = ia64; then
- # On IA64, the linker does run time linking by default, so we don't
- # have to do anything special.
- aix_use_runtimelinking=no
- exp_sym_flag='-Bexport'
- no_entry_flag=""
- else
- aix_use_runtimelinking=no
-
- # Test if we are trying to use run time linking or normal
- # AIX style linking. If -brtl is somewhere in LDFLAGS, we
- # need to do runtime linking.
- case $host_os in aix4.[[23]]|aix4.[[23]].*|aix[[5-9]]*)
- for ld_flag in $LDFLAGS; do
- case $ld_flag in
- *-brtl*)
- aix_use_runtimelinking=yes
- break
- ;;
- esac
- done
- ;;
- esac
-
- exp_sym_flag='-bexport'
- no_entry_flag='-bnoentry'
- fi
-
- # When large executables or shared objects are built, AIX ld can
- # have problems creating the table of contents. If linking a library
- # or program results in "error TOC overflow" add -mminimal-toc to
- # CXXFLAGS/CFLAGS for g++/gcc. In the cases where that is not
- # enough to fix the problem, add -Wl,-bbigtoc to LDFLAGS.
-
- _LT_TAGVAR(archive_cmds, $1)=''
- _LT_TAGVAR(hardcode_direct, $1)=yes
- _LT_TAGVAR(hardcode_direct_absolute, $1)=yes
- _LT_TAGVAR(hardcode_libdir_separator, $1)=':'
- _LT_TAGVAR(link_all_deplibs, $1)=yes
- _LT_TAGVAR(file_list_spec, $1)='${wl}-f,'
-
- if test "$GXX" = yes; then
- case $host_os in aix4.[[012]]|aix4.[[012]].*)
- # We only want to do this on AIX 4.2 and lower, the check
- # below for broken collect2 doesn't work under 4.3+
- collect2name=`${CC} -print-prog-name=collect2`
- if test -f "$collect2name" &&
- strings "$collect2name" | $GREP resolve_lib_name >/dev/null
- then
- # We have reworked collect2
- :
- else
- # We have old collect2
- _LT_TAGVAR(hardcode_direct, $1)=unsupported
- # It fails to find uninstalled libraries when the uninstalled
- # path is not listed in the libpath. Setting hardcode_minus_L
- # to unsupported forces relinking
- _LT_TAGVAR(hardcode_minus_L, $1)=yes
- _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-L$libdir'
- _LT_TAGVAR(hardcode_libdir_separator, $1)=
- fi
- esac
- shared_flag='-shared'
- if test "$aix_use_runtimelinking" = yes; then
- shared_flag="$shared_flag "'${wl}-G'
- fi
- else
- # not using gcc
- if test "$host_cpu" = ia64; then
- # VisualAge C++, Version 5.5 for AIX 5L for IA-64, Beta 3 Release
- # chokes on -Wl,-G. The following line is correct:
- shared_flag='-G'
- else
- if test "$aix_use_runtimelinking" = yes; then
- shared_flag='${wl}-G'
- else
- shared_flag='${wl}-bM:SRE'
- fi
- fi
- fi
-
- _LT_TAGVAR(export_dynamic_flag_spec, $1)='${wl}-bexpall'
- # It seems that -bexpall does not export symbols beginning with
- # underscore (_), so it is better to generate a list of symbols to
- # export.
- _LT_TAGVAR(always_export_symbols, $1)=yes
- if test "$aix_use_runtimelinking" = yes; then
- # Warning - without using the other runtime loading flags (-brtl),
- # -berok will link without error, but may produce a broken library.
- _LT_TAGVAR(allow_undefined_flag, $1)='-berok'
- # Determine the default libpath from the value encoded in an empty
- # executable.
- _LT_SYS_MODULE_PATH_AIX
- _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='${wl}-blibpath:$libdir:'"$aix_libpath"
-
- _LT_TAGVAR(archive_expsym_cmds, $1)='$CC -o $output_objdir/$soname $libobjs $deplibs '"\${wl}$no_entry_flag"' $compiler_flags `if test "x${allow_undefined_flag}" != "x"; then $ECHO "X${wl}${allow_undefined_flag}" | $Xsed; else :; fi` '"\${wl}$exp_sym_flag:\$export_symbols $shared_flag"
- else
- if test "$host_cpu" = ia64; then
- _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='${wl}-R $libdir:/usr/lib:/lib'
- _LT_TAGVAR(allow_undefined_flag, $1)="-z nodefs"
- _LT_TAGVAR(archive_expsym_cmds, $1)="\$CC $shared_flag"' -o $output_objdir/$soname $libobjs $deplibs '"\${wl}$no_entry_flag"' $compiler_flags ${wl}${allow_undefined_flag} '"\${wl}$exp_sym_flag:\$export_symbols"
- else
- # Determine the default libpath from the value encoded in an
- # empty executable.
- _LT_SYS_MODULE_PATH_AIX
- _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='${wl}-blibpath:$libdir:'"$aix_libpath"
- # Warning - without using the other run time loading flags,
- # -berok will link without error, but may produce a broken library.
- _LT_TAGVAR(no_undefined_flag, $1)=' ${wl}-bernotok'
- _LT_TAGVAR(allow_undefined_flag, $1)=' ${wl}-berok'
- # Exported symbols can be pulled into shared objects from archives
- _LT_TAGVAR(whole_archive_flag_spec, $1)='$convenience'
- _LT_TAGVAR(archive_cmds_need_lc, $1)=yes
- # This is similar to how AIX traditionally builds its shared
- # libraries.
- _LT_TAGVAR(archive_expsym_cmds, $1)="\$CC $shared_flag"' -o $output_objdir/$soname $libobjs $deplibs ${wl}-bnoentry $compiler_flags ${wl}-bE:$export_symbols${allow_undefined_flag}~$AR $AR_FLAGS $output_objdir/$libname$release.a $output_objdir/$soname'
- fi
- fi
- ;;
-
- beos*)
- if $LD --help 2>&1 | $GREP ': supported targets:.* elf' > /dev/null; then
- _LT_TAGVAR(allow_undefined_flag, $1)=unsupported
- # Joseph Beckenbach <jrb3@best.com> says some releases of gcc
- # support --undefined. This deserves some investigation. FIXME
- _LT_TAGVAR(archive_cmds, $1)='$CC -nostart $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib'
- else
- _LT_TAGVAR(ld_shlibs, $1)=no
- fi
- ;;
-
- chorus*)
- case $cc_basename in
- *)
- # FIXME: insert proper C++ library support
- _LT_TAGVAR(ld_shlibs, $1)=no
- ;;
- esac
- ;;
-
- cygwin* | mingw* | pw32* | cegcc*)
- # _LT_TAGVAR(hardcode_libdir_flag_spec, $1) is actually meaningless,
- # as there is no search path for DLLs.
- _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-L$libdir'
- _LT_TAGVAR(allow_undefined_flag, $1)=unsupported
- _LT_TAGVAR(always_export_symbols, $1)=no
- _LT_TAGVAR(enable_shared_with_static_runtimes, $1)=yes
-
- if $LD --help 2>&1 | $GREP 'auto-import' > /dev/null; then
- _LT_TAGVAR(archive_cmds, $1)='$CC -shared -nostdlib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags -o $output_objdir/$soname ${wl}--enable-auto-image-base -Xlinker --out-implib -Xlinker $lib'
- # If the export-symbols file already is a .def file (1st line
- # is EXPORTS), use it as is; otherwise, prepend...
- _LT_TAGVAR(archive_expsym_cmds, $1)='if test "x`$SED 1q $export_symbols`" = xEXPORTS; then
- cp $export_symbols $output_objdir/$soname.def;
- else
- echo EXPORTS > $output_objdir/$soname.def;
- cat $export_symbols >> $output_objdir/$soname.def;
- fi~
- $CC -shared -nostdlib $output_objdir/$soname.def $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags -o $output_objdir/$soname ${wl}--enable-auto-image-base -Xlinker --out-implib -Xlinker $lib'
- else
- _LT_TAGVAR(ld_shlibs, $1)=no
- fi
- ;;
- darwin* | rhapsody*)
- _LT_DARWIN_LINKER_FEATURES($1)
- ;;
-
- dgux*)
- case $cc_basename in
- ec++*)
- # FIXME: insert proper C++ library support
- _LT_TAGVAR(ld_shlibs, $1)=no
- ;;
- ghcx*)
- # Green Hills C++ Compiler
- # FIXME: insert proper C++ library support
- _LT_TAGVAR(ld_shlibs, $1)=no
- ;;
- *)
- # FIXME: insert proper C++ library support
- _LT_TAGVAR(ld_shlibs, $1)=no
- ;;
- esac
- ;;
-
- freebsd[[12]]*)
- # C++ shared libraries reported to be fairly broken before
- # switch to ELF
- _LT_TAGVAR(ld_shlibs, $1)=no
- ;;
-
- freebsd-elf*)
- _LT_TAGVAR(archive_cmds_need_lc, $1)=no
- ;;
-
- freebsd* | dragonfly*)
- # FreeBSD 3 and later use GNU C++ and GNU ld with standard ELF
- # conventions
- _LT_TAGVAR(ld_shlibs, $1)=yes
- ;;
-
- gnu*)
- ;;
-
- hpux9*)
- _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='${wl}+b ${wl}$libdir'
- _LT_TAGVAR(hardcode_libdir_separator, $1)=:
- _LT_TAGVAR(export_dynamic_flag_spec, $1)='${wl}-E'
- _LT_TAGVAR(hardcode_direct, $1)=yes
- _LT_TAGVAR(hardcode_minus_L, $1)=yes # Not in the search PATH,
- # but as the default
- # location of the library.
-
- case $cc_basename in
- CC*)
- # FIXME: insert proper C++ library support
- _LT_TAGVAR(ld_shlibs, $1)=no
- ;;
- aCC*)
- _LT_TAGVAR(archive_cmds, $1)='$RM $output_objdir/$soname~$CC -b ${wl}+b ${wl}$install_libdir -o $output_objdir/$soname $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags~test $output_objdir/$soname = $lib || mv $output_objdir/$soname $lib'
- # Commands to make compiler produce verbose output that lists
- # what "hidden" libraries, object files and flags are used when
- # linking a shared library.
- #
- # There doesn't appear to be a way to prevent this compiler from
- # explicitly linking system object files so we need to strip them
- # from the output so that they don't get included in the library
- # dependencies.
- output_verbose_link_cmd='templist=`($CC -b $CFLAGS -v conftest.$objext 2>&1) | $EGREP "\-L"`; list=""; for z in $templist; do case $z in conftest.$objext) list="$list $z";; *.$objext);; *) list="$list $z";;esac; done; $ECHO "X$list" | $Xsed'
- ;;
- *)
- if test "$GXX" = yes; then
- _LT_TAGVAR(archive_cmds, $1)='$RM $output_objdir/$soname~$CC -shared -nostdlib -fPIC ${wl}+b ${wl}$install_libdir -o $output_objdir/$soname $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags~test $output_objdir/$soname = $lib || mv $output_objdir/$soname $lib'
- else
- # FIXME: insert proper C++ library support
- _LT_TAGVAR(ld_shlibs, $1)=no
- fi
- ;;
- esac
- ;;
-
- hpux10*|hpux11*)
- if test $with_gnu_ld = no; then
- _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='${wl}+b ${wl}$libdir'
- _LT_TAGVAR(hardcode_libdir_separator, $1)=:
-
- case $host_cpu in
- hppa*64*|ia64*)
- ;;
- *)
- _LT_TAGVAR(export_dynamic_flag_spec, $1)='${wl}-E'
- ;;
- esac
- fi
- case $host_cpu in
- hppa*64*|ia64*)
- _LT_TAGVAR(hardcode_direct, $1)=no
- _LT_TAGVAR(hardcode_shlibpath_var, $1)=no
- ;;
- *)
- _LT_TAGVAR(hardcode_direct, $1)=yes
- _LT_TAGVAR(hardcode_direct_absolute, $1)=yes
- _LT_TAGVAR(hardcode_minus_L, $1)=yes # Not in the search PATH,
- # but as the default
- # location of the library.
- ;;
- esac
-
- case $cc_basename in
- CC*)
- # FIXME: insert proper C++ library support
- _LT_TAGVAR(ld_shlibs, $1)=no
- ;;
- aCC*)
- case $host_cpu in
- hppa*64*)
- _LT_TAGVAR(archive_cmds, $1)='$CC -b ${wl}+h ${wl}$soname -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags'
- ;;
- ia64*)
- _LT_TAGVAR(archive_cmds, $1)='$CC -b ${wl}+h ${wl}$soname ${wl}+nodefaultrpath -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags'
- ;;
- *)
- _LT_TAGVAR(archive_cmds, $1)='$CC -b ${wl}+h ${wl}$soname ${wl}+b ${wl}$install_libdir -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags'
- ;;
- esac
- # Commands to make compiler produce verbose output that lists
- # what "hidden" libraries, object files and flags are used when
- # linking a shared library.
- #
- # There doesn't appear to be a way to prevent this compiler from
- # explicitly linking system object files so we need to strip them
- # from the output so that they don't get included in the library
- # dependencies.
- output_verbose_link_cmd='templist=`($CC -b $CFLAGS -v conftest.$objext 2>&1) | $GREP "\-L"`; list=""; for z in $templist; do case $z in conftest.$objext) list="$list $z";; *.$objext);; *) list="$list $z";;esac; done; $ECHO "X$list" | $Xsed'
- ;;
- *)
- if test "$GXX" = yes; then
- if test $with_gnu_ld = no; then
- case $host_cpu in
- hppa*64*)
- _LT_TAGVAR(archive_cmds, $1)='$CC -shared -nostdlib -fPIC ${wl}+h ${wl}$soname -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags'
- ;;
- ia64*)
- _LT_TAGVAR(archive_cmds, $1)='$CC -shared -nostdlib -fPIC ${wl}+h ${wl}$soname ${wl}+nodefaultrpath -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags'
- ;;
- *)
- _LT_TAGVAR(archive_cmds, $1)='$CC -shared -nostdlib -fPIC ${wl}+h ${wl}$soname ${wl}+b ${wl}$install_libdir -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags'
- ;;
- esac
- fi
- else
- # FIXME: insert proper C++ library support
- _LT_TAGVAR(ld_shlibs, $1)=no
- fi
- ;;
- esac
- ;;
-
- interix[[3-9]]*)
- _LT_TAGVAR(hardcode_direct, $1)=no
- _LT_TAGVAR(hardcode_shlibpath_var, $1)=no
- _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='${wl}-rpath,$libdir'
- _LT_TAGVAR(export_dynamic_flag_spec, $1)='${wl}-E'
- # Hack: On Interix 3.x, we cannot compile PIC because of a broken gcc.
- # Instead, shared libraries are loaded at an image base (0x10000000 by
- # default) and relocated if they conflict, which is a slow very memory
- # consuming and fragmenting process. To avoid this, we pick a random,
- # 256 KiB-aligned image base between 0x50000000 and 0x6FFC0000 at link
- # time. Moving up from 0x10000000 also allows more sbrk(2) space.
- _LT_TAGVAR(archive_cmds, $1)='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags ${wl}-h,$soname ${wl}--image-base,`expr ${RANDOM-$$} % 4096 / 2 \* 262144 + 1342177280` -o $lib'
- _LT_TAGVAR(archive_expsym_cmds, $1)='sed "s,^,_," $export_symbols >$output_objdir/$soname.expsym~$CC -shared $pic_flag $libobjs $deplibs $compiler_flags ${wl}-h,$soname ${wl}--retain-symbols-file,$output_objdir/$soname.expsym ${wl}--image-base,`expr ${RANDOM-$$} % 4096 / 2 \* 262144 + 1342177280` -o $lib'
- ;;
- irix5* | irix6*)
- case $cc_basename in
- CC*)
- # SGI C++
- _LT_TAGVAR(archive_cmds, $1)='$CC -shared -all -multigot $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags -soname $soname `test -n "$verstring" && $ECHO "X-set_version $verstring" | $Xsed` -update_registry ${output_objdir}/so_locations -o $lib'
-
- # Archives containing C++ object files must be created using
- # "CC -ar", where "CC" is the IRIX C++ compiler. This is
- # necessary to make sure instantiated templates are included
- # in the archive.
- _LT_TAGVAR(old_archive_cmds, $1)='$CC -ar -WR,-u -o $oldlib $oldobjs'
- ;;
- *)
- if test "$GXX" = yes; then
- if test "$with_gnu_ld" = no; then
- _LT_TAGVAR(archive_cmds, $1)='$CC -shared -nostdlib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags ${wl}-soname ${wl}$soname `test -n "$verstring" && $ECHO "X${wl}-set_version ${wl}$verstring" | $Xsed` ${wl}-update_registry ${wl}${output_objdir}/so_locations -o $lib'
- else
- _LT_TAGVAR(archive_cmds, $1)='$CC -shared -nostdlib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags ${wl}-soname ${wl}$soname `test -n "$verstring" && $ECHO "X${wl}-set_version ${wl}$verstring" | $Xsed` -o $lib'
- fi
- fi
- _LT_TAGVAR(link_all_deplibs, $1)=yes
- ;;
- esac
- _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='${wl}-rpath ${wl}$libdir'
- _LT_TAGVAR(hardcode_libdir_separator, $1)=:
- _LT_TAGVAR(inherit_rpath, $1)=yes
- ;;
-
- linux* | k*bsd*-gnu)
- case $cc_basename in
- KCC*)
- # Kuck and Associates, Inc. (KAI) C++ Compiler
-
- # KCC will only create a shared library if the output file
- # ends with ".so" (or ".sl" for HP-UX), so rename the library
- # to its proper name (with version) after linking.
- _LT_TAGVAR(archive_cmds, $1)='tempext=`echo $shared_ext | $SED -e '\''s/\([[^()0-9A-Za-z{}]]\)/\\\\\1/g'\''`; templib=`echo $lib | $SED -e "s/\${tempext}\..*/.so/"`; $CC $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags --soname $soname -o \$templib; mv \$templib $lib'
- _LT_TAGVAR(archive_expsym_cmds, $1)='tempext=`echo $shared_ext | $SED -e '\''s/\([[^()0-9A-Za-z{}]]\)/\\\\\1/g'\''`; templib=`echo $lib | $SED -e "s/\${tempext}\..*/.so/"`; $CC $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags --soname $soname -o \$templib ${wl}-retain-symbols-file,$export_symbols; mv \$templib $lib'
- # Commands to make compiler produce verbose output that lists
- # what "hidden" libraries, object files and flags are used when
- # linking a shared library.
- #
- # There doesn't appear to be a way to prevent this compiler from
- # explicitly linking system object files so we need to strip them
- # from the output so that they don't get included in the library
- # dependencies.
- output_verbose_link_cmd='templist=`$CC $CFLAGS -v conftest.$objext -o libconftest$shared_ext 2>&1 | $GREP "ld"`; rm -f libconftest$shared_ext; list=""; for z in $templist; do case $z in conftest.$objext) list="$list $z";; *.$objext);; *) list="$list $z";;esac; done; $ECHO "X$list" | $Xsed'
-
- _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='${wl}-rpath,$libdir'
- _LT_TAGVAR(export_dynamic_flag_spec, $1)='${wl}--export-dynamic'
-
- # Archives containing C++ object files must be created using
- # "CC -Bstatic", where "CC" is the KAI C++ compiler.
- _LT_TAGVAR(old_archive_cmds, $1)='$CC -Bstatic -o $oldlib $oldobjs'
- ;;
- icpc* | ecpc* )
- # Intel C++
- with_gnu_ld=yes
- # version 8.0 and above of icpc choke on multiply defined symbols
- # if we add $predep_objects and $postdep_objects, however 7.1 and
- # earlier do not add the objects themselves.
- case `$CC -V 2>&1` in
- *"Version 7."*)
- _LT_TAGVAR(archive_cmds, $1)='$CC -shared $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags ${wl}-soname $wl$soname -o $lib'
- _LT_TAGVAR(archive_expsym_cmds, $1)='$CC -shared $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags ${wl}-soname $wl$soname ${wl}-retain-symbols-file $wl$export_symbols -o $lib'
- ;;
- *) # Version 8.0 or newer
- tmp_idyn=
- case $host_cpu in
- ia64*) tmp_idyn=' -i_dynamic';;
- esac
- _LT_TAGVAR(archive_cmds, $1)='$CC -shared'"$tmp_idyn"' $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib'
- _LT_TAGVAR(archive_expsym_cmds, $1)='$CC -shared'"$tmp_idyn"' $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname ${wl}-retain-symbols-file $wl$export_symbols -o $lib'
- ;;
- esac
- _LT_TAGVAR(archive_cmds_need_lc, $1)=no
- _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='${wl}-rpath,$libdir'
- _LT_TAGVAR(export_dynamic_flag_spec, $1)='${wl}--export-dynamic'
- _LT_TAGVAR(whole_archive_flag_spec, $1)='${wl}--whole-archive$convenience ${wl}--no-whole-archive'
- ;;
- pgCC* | pgcpp*)
- # Portland Group C++ compiler
- case `$CC -V` in
- *pgCC\ [[1-5]]* | *pgcpp\ [[1-5]]*)
- _LT_TAGVAR(prelink_cmds, $1)='tpldir=Template.dir~
- rm -rf $tpldir~
- $CC --prelink_objects --instantiation_dir $tpldir $objs $libobjs $compile_deplibs~
- compile_command="$compile_command `find $tpldir -name \*.o | $NL2SP`"'
- _LT_TAGVAR(old_archive_cmds, $1)='tpldir=Template.dir~
- rm -rf $tpldir~
- $CC --prelink_objects --instantiation_dir $tpldir $oldobjs$old_deplibs~
- $AR $AR_FLAGS $oldlib$oldobjs$old_deplibs `find $tpldir -name \*.o | $NL2SP`~
- $RANLIB $oldlib'
- _LT_TAGVAR(archive_cmds, $1)='tpldir=Template.dir~
- rm -rf $tpldir~
- $CC --prelink_objects --instantiation_dir $tpldir $predep_objects $libobjs $deplibs $convenience $postdep_objects~
- $CC -shared $pic_flag $predep_objects $libobjs $deplibs `find $tpldir -name \*.o | $NL2SP` $postdep_objects $compiler_flags ${wl}-soname ${wl}$soname -o $lib'
- _LT_TAGVAR(archive_expsym_cmds, $1)='tpldir=Template.dir~
- rm -rf $tpldir~
- $CC --prelink_objects --instantiation_dir $tpldir $predep_objects $libobjs $deplibs $convenience $postdep_objects~
- $CC -shared $pic_flag $predep_objects $libobjs $deplibs `find $tpldir -name \*.o | $NL2SP` $postdep_objects $compiler_flags ${wl}-soname ${wl}$soname ${wl}-retain-symbols-file ${wl}$export_symbols -o $lib'
- ;;
- *) # Version 6 will use weak symbols
- _LT_TAGVAR(archive_cmds, $1)='$CC -shared $pic_flag $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags ${wl}-soname ${wl}$soname -o $lib'
- _LT_TAGVAR(archive_expsym_cmds, $1)='$CC -shared $pic_flag $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags ${wl}-soname ${wl}$soname ${wl}-retain-symbols-file ${wl}$export_symbols -o $lib'
- ;;
- esac
-
- _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='${wl}--rpath ${wl}$libdir'
- _LT_TAGVAR(export_dynamic_flag_spec, $1)='${wl}--export-dynamic'
- _LT_TAGVAR(whole_archive_flag_spec, $1)='${wl}--whole-archive`for conv in $convenience\"\"; do test -n \"$conv\" && new_convenience=\"$new_convenience,$conv\"; done; $ECHO \"$new_convenience\"` ${wl}--no-whole-archive'
- ;;
- cxx*)
- # Compaq C++
- _LT_TAGVAR(archive_cmds, $1)='$CC -shared $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags ${wl}-soname $wl$soname -o $lib'
- _LT_TAGVAR(archive_expsym_cmds, $1)='$CC -shared $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags ${wl}-soname $wl$soname -o $lib ${wl}-retain-symbols-file $wl$export_symbols'
-
- runpath_var=LD_RUN_PATH
- _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-rpath $libdir'
- _LT_TAGVAR(hardcode_libdir_separator, $1)=:
-
- # Commands to make compiler produce verbose output that lists
- # what "hidden" libraries, object files and flags are used when
- # linking a shared library.
- #
- # There doesn't appear to be a way to prevent this compiler from
- # explicitly linking system object files so we need to strip them
- # from the output so that they don't get included in the library
- # dependencies.
- output_verbose_link_cmd='templist=`$CC -shared $CFLAGS -v conftest.$objext 2>&1 | $GREP "ld"`; templist=`$ECHO "X$templist" | $Xsed -e "s/\(^.*ld.*\)\( .*ld .*$\)/\1/"`; list=""; for z in $templist; do case $z in conftest.$objext) list="$list $z";; *.$objext);; *) list="$list $z";;esac; done; $ECHO "X$list" | $Xsed'
- ;;
- xl*)
- # IBM XL 8.0 on PPC, with GNU ld
- _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='${wl}-rpath ${wl}$libdir'
- _LT_TAGVAR(export_dynamic_flag_spec, $1)='${wl}--export-dynamic'
- _LT_TAGVAR(archive_cmds, $1)='$CC -qmkshrobj $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib'
- if test "x$supports_anon_versioning" = xyes; then
- _LT_TAGVAR(archive_expsym_cmds, $1)='echo "{ global:" > $output_objdir/$libname.ver~
- cat $export_symbols | sed -e "s/\(.*\)/\1;/" >> $output_objdir/$libname.ver~
- echo "local: *; };" >> $output_objdir/$libname.ver~
- $CC -qmkshrobj $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname ${wl}-version-script ${wl}$output_objdir/$libname.ver -o $lib'
- fi
- ;;
- *)
- case `$CC -V 2>&1 | sed 5q` in
- *Sun\ C*)
- # Sun C++ 5.9
- _LT_TAGVAR(no_undefined_flag, $1)=' -zdefs'
- _LT_TAGVAR(archive_cmds, $1)='$CC -G${allow_undefined_flag} -h$soname -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags'
- _LT_TAGVAR(archive_expsym_cmds, $1)='$CC -G${allow_undefined_flag} -h$soname -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags ${wl}-retain-symbols-file ${wl}$export_symbols'
- _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-R$libdir'
- _LT_TAGVAR(whole_archive_flag_spec, $1)='${wl}--whole-archive`new_convenience=; for conv in $convenience\"\"; do test -z \"$conv\" || new_convenience=\"$new_convenience,$conv\"; done; $ECHO \"$new_convenience\"` ${wl}--no-whole-archive'
- _LT_TAGVAR(compiler_needs_object, $1)=yes
-
- # Not sure whether something based on
- # $CC $CFLAGS -v conftest.$objext -o libconftest$shared_ext 2>&1
- # would be better.
- output_verbose_link_cmd='echo'
-
- # Archives containing C++ object files must be created using
- # "CC -xar", where "CC" is the Sun C++ compiler. This is
- # necessary to make sure instantiated templates are included
- # in the archive.
- _LT_TAGVAR(old_archive_cmds, $1)='$CC -xar -o $oldlib $oldobjs'
- ;;
- esac
- ;;
- esac
- ;;
-
- lynxos*)
- # FIXME: insert proper C++ library support
- _LT_TAGVAR(ld_shlibs, $1)=no
- ;;
-
- m88k*)
- # FIXME: insert proper C++ library support
- _LT_TAGVAR(ld_shlibs, $1)=no
- ;;
-
- mvs*)
- case $cc_basename in
- cxx*)
- # FIXME: insert proper C++ library support
- _LT_TAGVAR(ld_shlibs, $1)=no
- ;;
- *)
- # FIXME: insert proper C++ library support
- _LT_TAGVAR(ld_shlibs, $1)=no
- ;;
- esac
- ;;
-
- netbsd*)
- if echo __ELF__ | $CC -E - | $GREP __ELF__ >/dev/null; then
- _LT_TAGVAR(archive_cmds, $1)='$LD -Bshareable -o $lib $predep_objects $libobjs $deplibs $postdep_objects $linker_flags'
- wlarc=
- _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-R$libdir'
- _LT_TAGVAR(hardcode_direct, $1)=yes
- _LT_TAGVAR(hardcode_shlibpath_var, $1)=no
- fi
- # Workaround some broken pre-1.5 toolchains
- output_verbose_link_cmd='$CC -shared $CFLAGS -v conftest.$objext 2>&1 | $GREP conftest.$objext | $SED -e "s:-lgcc -lc -lgcc::"'
- ;;
-
- *nto* | *qnx*)
- _LT_TAGVAR(ld_shlibs, $1)=yes
- ;;
-
- openbsd2*)
- # C++ shared libraries are fairly broken
- _LT_TAGVAR(ld_shlibs, $1)=no
- ;;
-
- openbsd*)
- if test -f /usr/libexec/ld.so; then
- _LT_TAGVAR(hardcode_direct, $1)=yes
- _LT_TAGVAR(hardcode_shlibpath_var, $1)=no
- _LT_TAGVAR(hardcode_direct_absolute, $1)=yes
- _LT_TAGVAR(archive_cmds, $1)='$CC -shared $pic_flag $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags -o $lib'
- _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='${wl}-rpath,$libdir'
- if test -z "`echo __ELF__ | $CC -E - | grep __ELF__`" || test "$host_os-$host_cpu" = "openbsd2.8-powerpc"; then
- _LT_TAGVAR(archive_expsym_cmds, $1)='$CC -shared $pic_flag $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags ${wl}-retain-symbols-file,$export_symbols -o $lib'
- _LT_TAGVAR(export_dynamic_flag_spec, $1)='${wl}-E'
- _LT_TAGVAR(whole_archive_flag_spec, $1)="$wlarc"'--whole-archive$convenience '"$wlarc"'--no-whole-archive'
- fi
- output_verbose_link_cmd=echo
- else
- _LT_TAGVAR(ld_shlibs, $1)=no
- fi
- ;;
-
- osf3* | osf4* | osf5*)
- case $cc_basename in
- KCC*)
- # Kuck and Associates, Inc. (KAI) C++ Compiler
-
- # KCC will only create a shared library if the output file
- # ends with ".so" (or ".sl" for HP-UX), so rename the library
- # to its proper name (with version) after linking.
- _LT_TAGVAR(archive_cmds, $1)='tempext=`echo $shared_ext | $SED -e '\''s/\([[^()0-9A-Za-z{}]]\)/\\\\\1/g'\''`; templib=`echo "$lib" | $SED -e "s/\${tempext}\..*/.so/"`; $CC $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags --soname $soname -o \$templib; mv \$templib $lib'
-
- _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='${wl}-rpath,$libdir'
- _LT_TAGVAR(hardcode_libdir_separator, $1)=:
-
- # Archives containing C++ object files must be created using
- # the KAI C++ compiler.
- case $host in
- osf3*) _LT_TAGVAR(old_archive_cmds, $1)='$CC -Bstatic -o $oldlib $oldobjs' ;;
- *) _LT_TAGVAR(old_archive_cmds, $1)='$CC -o $oldlib $oldobjs' ;;
- esac
- ;;
- RCC*)
- # Rational C++ 2.4.1
- # FIXME: insert proper C++ library support
- _LT_TAGVAR(ld_shlibs, $1)=no
- ;;
- cxx*)
- case $host in
- osf3*)
- _LT_TAGVAR(allow_undefined_flag, $1)=' ${wl}-expect_unresolved ${wl}\*'
- _LT_TAGVAR(archive_cmds, $1)='$CC -shared${allow_undefined_flag} $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags ${wl}-soname $soname `test -n "$verstring" && $ECHO "X${wl}-set_version $verstring" | $Xsed` -update_registry ${output_objdir}/so_locations -o $lib'
- _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='${wl}-rpath ${wl}$libdir'
- ;;
- *)
- _LT_TAGVAR(allow_undefined_flag, $1)=' -expect_unresolved \*'
- _LT_TAGVAR(archive_cmds, $1)='$CC -shared${allow_undefined_flag} $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags -msym -soname $soname `test -n "$verstring" && $ECHO "X-set_version $verstring" | $Xsed` -update_registry ${output_objdir}/so_locations -o $lib'
- _LT_TAGVAR(archive_expsym_cmds, $1)='for i in `cat $export_symbols`; do printf "%s %s\\n" -exported_symbol "\$i" >> $lib.exp; done~
- echo "-hidden">> $lib.exp~
- $CC -shared$allow_undefined_flag $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags -msym -soname $soname ${wl}-input ${wl}$lib.exp `test -n "$verstring" && $ECHO "X-set_version $verstring" | $Xsed` -update_registry ${output_objdir}/so_locations -o $lib~
- $RM $lib.exp'
- _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-rpath $libdir'
- ;;
- esac
-
- _LT_TAGVAR(hardcode_libdir_separator, $1)=:
-
- # Commands to make compiler produce verbose output that lists
- # what "hidden" libraries, object files and flags are used when
- # linking a shared library.
- #
- # There doesn't appear to be a way to prevent this compiler from
- # explicitly linking system object files so we need to strip them
- # from the output so that they don't get included in the library
- # dependencies.
- output_verbose_link_cmd='templist=`$CC -shared $CFLAGS -v conftest.$objext 2>&1 | $GREP "ld" | $GREP -v "ld:"`; templist=`$ECHO "X$templist" | $Xsed -e "s/\(^.*ld.*\)\( .*ld.*$\)/\1/"`; list=""; for z in $templist; do case $z in conftest.$objext) list="$list $z";; *.$objext);; *) list="$list $z";;esac; done; $ECHO "X$list" | $Xsed'
- ;;
- *)
- if test "$GXX" = yes && test "$with_gnu_ld" = no; then
- _LT_TAGVAR(allow_undefined_flag, $1)=' ${wl}-expect_unresolved ${wl}\*'
- case $host in
- osf3*)
- _LT_TAGVAR(archive_cmds, $1)='$CC -shared -nostdlib ${allow_undefined_flag} $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags ${wl}-soname ${wl}$soname `test -n "$verstring" && $ECHO "X${wl}-set_version ${wl}$verstring" | $Xsed` ${wl}-update_registry ${wl}${output_objdir}/so_locations -o $lib'
- ;;
- *)
- _LT_TAGVAR(archive_cmds, $1)='$CC -shared -nostdlib ${allow_undefined_flag} $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags ${wl}-msym ${wl}-soname ${wl}$soname `test -n "$verstring" && $ECHO "${wl}-set_version ${wl}$verstring" | $Xsed` ${wl}-update_registry ${wl}${output_objdir}/so_locations -o $lib'
- ;;
- esac
-
- _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='${wl}-rpath ${wl}$libdir'
- _LT_TAGVAR(hardcode_libdir_separator, $1)=:
-
- # Commands to make compiler produce verbose output that lists
- # what "hidden" libraries, object files and flags are used when
- # linking a shared library.
- output_verbose_link_cmd='$CC -shared $CFLAGS -v conftest.$objext 2>&1 | $GREP "\-L"'
-
- else
- # FIXME: insert proper C++ library support
- _LT_TAGVAR(ld_shlibs, $1)=no
- fi
- ;;
- esac
- ;;
-
- psos*)
- # FIXME: insert proper C++ library support
- _LT_TAGVAR(ld_shlibs, $1)=no
- ;;
-
- sunos4*)
- case $cc_basename in
- CC*)
- # Sun C++ 4.x
- # FIXME: insert proper C++ library support
- _LT_TAGVAR(ld_shlibs, $1)=no
- ;;
- lcc*)
- # Lucid
- # FIXME: insert proper C++ library support
- _LT_TAGVAR(ld_shlibs, $1)=no
- ;;
- *)
- # FIXME: insert proper C++ library support
- _LT_TAGVAR(ld_shlibs, $1)=no
- ;;
- esac
- ;;
-
- solaris*)
- case $cc_basename in
- CC*)
- # Sun C++ 4.2, 5.x and Centerline C++
- _LT_TAGVAR(archive_cmds_need_lc,$1)=yes
- _LT_TAGVAR(no_undefined_flag, $1)=' -zdefs'
- _LT_TAGVAR(archive_cmds, $1)='$CC -G${allow_undefined_flag} -h$soname -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags'
- _LT_TAGVAR(archive_expsym_cmds, $1)='echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~echo "local: *; };" >> $lib.exp~
- $CC -G${allow_undefined_flag} ${wl}-M ${wl}$lib.exp -h$soname -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags~$RM $lib.exp'
-
- _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-R$libdir'
- _LT_TAGVAR(hardcode_shlibpath_var, $1)=no
- case $host_os in
- solaris2.[[0-5]] | solaris2.[[0-5]].*) ;;
- *)
- # The compiler driver will combine and reorder linker options,
- # but understands `-z linker_flag'.
- # Supported since Solaris 2.6 (maybe 2.5.1?)
- _LT_TAGVAR(whole_archive_flag_spec, $1)='-z allextract$convenience -z defaultextract'
- ;;
- esac
- _LT_TAGVAR(link_all_deplibs, $1)=yes
-
- output_verbose_link_cmd='echo'
-
- # Archives containing C++ object files must be created using
- # "CC -xar", where "CC" is the Sun C++ compiler. This is
- # necessary to make sure instantiated templates are included
- # in the archive.
- _LT_TAGVAR(old_archive_cmds, $1)='$CC -xar -o $oldlib $oldobjs'
- ;;
- gcx*)
- # Green Hills C++ Compiler
- _LT_TAGVAR(archive_cmds, $1)='$CC -shared $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags ${wl}-h $wl$soname -o $lib'
-
- # The C++ compiler must be used to create the archive.
- _LT_TAGVAR(old_archive_cmds, $1)='$CC $LDFLAGS -archive -o $oldlib $oldobjs'
- ;;
- *)
- # GNU C++ compiler with Solaris linker
- if test "$GXX" = yes && test "$with_gnu_ld" = no; then
- _LT_TAGVAR(no_undefined_flag, $1)=' ${wl}-z ${wl}defs'
- if $CC --version | $GREP -v '^2\.7' > /dev/null; then
- _LT_TAGVAR(archive_cmds, $1)='$CC -shared -nostdlib $LDFLAGS $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags ${wl}-h $wl$soname -o $lib'
- _LT_TAGVAR(archive_expsym_cmds, $1)='echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~echo "local: *; };" >> $lib.exp~
- $CC -shared -nostdlib ${wl}-M $wl$lib.exp -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags~$RM $lib.exp'
-
- # Commands to make compiler produce verbose output that lists
- # what "hidden" libraries, object files and flags are used when
- # linking a shared library.
- output_verbose_link_cmd='$CC -shared $CFLAGS -v conftest.$objext 2>&1 | $GREP "\-L"'
- else
- # g++ 2.7 appears to require `-G' NOT `-shared' on this
- # platform.
- _LT_TAGVAR(archive_cmds, $1)='$CC -G -nostdlib $LDFLAGS $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags ${wl}-h $wl$soname -o $lib'
- _LT_TAGVAR(archive_expsym_cmds, $1)='echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~echo "local: *; };" >> $lib.exp~
- $CC -G -nostdlib ${wl}-M $wl$lib.exp -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags~$RM $lib.exp'
-
- # Commands to make compiler produce verbose output that lists
- # what "hidden" libraries, object files and flags are used when
- # linking a shared library.
- output_verbose_link_cmd='$CC -G $CFLAGS -v conftest.$objext 2>&1 | $GREP "\-L"'
- fi
-
- _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='${wl}-R $wl$libdir'
- case $host_os in
- solaris2.[[0-5]] | solaris2.[[0-5]].*) ;;
- *)
- _LT_TAGVAR(whole_archive_flag_spec, $1)='${wl}-z ${wl}allextract$convenience ${wl}-z ${wl}defaultextract'
- ;;
- esac
- fi
- ;;
- esac
- ;;
-
- sysv4*uw2* | sysv5OpenUNIX* | sysv5UnixWare7.[[01]].[[10]]* | unixware7* | sco3.2v5.0.[[024]]*)
- _LT_TAGVAR(no_undefined_flag, $1)='${wl}-z,text'
- _LT_TAGVAR(archive_cmds_need_lc, $1)=no
- _LT_TAGVAR(hardcode_shlibpath_var, $1)=no
- runpath_var='LD_RUN_PATH'
-
- case $cc_basename in
- CC*)
- _LT_TAGVAR(archive_cmds, $1)='$CC -G ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
- _LT_TAGVAR(archive_expsym_cmds, $1)='$CC -G ${wl}-Bexport:$export_symbols ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
- ;;
- *)
- _LT_TAGVAR(archive_cmds, $1)='$CC -shared ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
- _LT_TAGVAR(archive_expsym_cmds, $1)='$CC -shared ${wl}-Bexport:$export_symbols ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
- ;;
- esac
- ;;
-
- sysv5* | sco3.2v5* | sco5v6*)
- # Note: We can NOT use -z defs as we might desire, because we do not
- # link with -lc, and that would cause any symbols used from libc to
- # always be unresolved, which means just about no library would
- # ever link correctly. If we're not using GNU ld we use -z text
- # though, which does catch some bad symbols but isn't as heavy-handed
- # as -z defs.
- _LT_TAGVAR(no_undefined_flag, $1)='${wl}-z,text'
- _LT_TAGVAR(allow_undefined_flag, $1)='${wl}-z,nodefs'
- _LT_TAGVAR(archive_cmds_need_lc, $1)=no
- _LT_TAGVAR(hardcode_shlibpath_var, $1)=no
- _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='${wl}-R,$libdir'
- _LT_TAGVAR(hardcode_libdir_separator, $1)=':'
- _LT_TAGVAR(link_all_deplibs, $1)=yes
- _LT_TAGVAR(export_dynamic_flag_spec, $1)='${wl}-Bexport'
- runpath_var='LD_RUN_PATH'
-
- case $cc_basename in
- CC*)
- _LT_TAGVAR(archive_cmds, $1)='$CC -G ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
- _LT_TAGVAR(archive_expsym_cmds, $1)='$CC -G ${wl}-Bexport:$export_symbols ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
- ;;
- *)
- _LT_TAGVAR(archive_cmds, $1)='$CC -shared ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
- _LT_TAGVAR(archive_expsym_cmds, $1)='$CC -shared ${wl}-Bexport:$export_symbols ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
- ;;
- esac
- ;;
-
- tandem*)
- case $cc_basename in
- NCC*)
- # NonStop-UX NCC 3.20
- # FIXME: insert proper C++ library support
- _LT_TAGVAR(ld_shlibs, $1)=no
- ;;
- *)
- # FIXME: insert proper C++ library support
- _LT_TAGVAR(ld_shlibs, $1)=no
- ;;
- esac
- ;;
-
- vxworks*)
- # FIXME: insert proper C++ library support
- _LT_TAGVAR(ld_shlibs, $1)=no
- ;;
-
- *)
- # FIXME: insert proper C++ library support
- _LT_TAGVAR(ld_shlibs, $1)=no
- ;;
- esac
-
- AC_MSG_RESULT([$_LT_TAGVAR(ld_shlibs, $1)])
- test "$_LT_TAGVAR(ld_shlibs, $1)" = no && can_build_shared=no
-
- _LT_TAGVAR(GCC, $1)="$GXX"
- _LT_TAGVAR(LD, $1)="$LD"
-
- ## CAVEAT EMPTOR:
- ## There is no encapsulation within the following macros, do not change
- ## the running order or otherwise move them around unless you know exactly
- ## what you are doing...
- _LT_SYS_HIDDEN_LIBDEPS($1)
- _LT_COMPILER_PIC($1)
- _LT_COMPILER_C_O($1)
- _LT_COMPILER_FILE_LOCKS($1)
- _LT_LINKER_SHLIBS($1)
- _LT_SYS_DYNAMIC_LINKER($1)
- _LT_LINKER_HARDCODE_LIBPATH($1)
-
- _LT_CONFIG($1)
- fi # test -n "$compiler"
-
- CC=$lt_save_CC
- LDCXX=$LD
- LD=$lt_save_LD
- GCC=$lt_save_GCC
- with_gnu_ld=$lt_save_with_gnu_ld
- lt_cv_path_LDCXX=$lt_cv_path_LD
- lt_cv_path_LD=$lt_save_path_LD
- lt_cv_prog_gnu_ldcxx=$lt_cv_prog_gnu_ld
- lt_cv_prog_gnu_ld=$lt_save_with_gnu_ld
-fi # test "$_lt_caught_CXX_error" != yes
-
-AC_LANG_POP
-])# _LT_LANG_CXX_CONFIG
-
-
-# _LT_SYS_HIDDEN_LIBDEPS([TAGNAME])
-# ---------------------------------
-# Figure out "hidden" library dependencies from verbose
-# compiler output when linking a shared library.
-# Parse the compiler output and extract the necessary
-# objects, libraries and library flags.
-m4_defun([_LT_SYS_HIDDEN_LIBDEPS],
-[m4_require([_LT_FILEUTILS_DEFAULTS])dnl
-# Dependencies to place before and after the object being linked:
-_LT_TAGVAR(predep_objects, $1)=
-_LT_TAGVAR(postdep_objects, $1)=
-_LT_TAGVAR(predeps, $1)=
-_LT_TAGVAR(postdeps, $1)=
-_LT_TAGVAR(compiler_lib_search_path, $1)=
-
-dnl we can't use the lt_simple_compile_test_code here,
-dnl because it contains code intended for an executable,
-dnl not a library. It's possible we should let each
-dnl tag define a new lt_????_link_test_code variable,
-dnl but it's only used here...
-m4_if([$1], [], [cat > conftest.$ac_ext <<_LT_EOF
-int a;
-void foo (void) { a = 0; }
-_LT_EOF
-], [$1], [CXX], [cat > conftest.$ac_ext <<_LT_EOF
-class Foo
-{
-public:
- Foo (void) { a = 0; }
-private:
- int a;
-};
-_LT_EOF
-], [$1], [F77], [cat > conftest.$ac_ext <<_LT_EOF
- subroutine foo
- implicit none
- integer*4 a
- a=0
- return
- end
-_LT_EOF
-], [$1], [FC], [cat > conftest.$ac_ext <<_LT_EOF
- subroutine foo
- implicit none
- integer a
- a=0
- return
- end
-_LT_EOF
-], [$1], [GCJ], [cat > conftest.$ac_ext <<_LT_EOF
-public class foo {
- private int a;
- public void bar (void) {
- a = 0;
- }
-};
-_LT_EOF
-])
-dnl Parse the compiler output and extract the necessary
-dnl objects, libraries and library flags.
-if AC_TRY_EVAL(ac_compile); then
- # Parse the compiler output and extract the necessary
- # objects, libraries and library flags.
-
- # Sentinel used to keep track of whether or not we are before
- # the conftest object file.
- pre_test_object_deps_done=no
-
- for p in `eval "$output_verbose_link_cmd"`; do
- case $p in
-
- -L* | -R* | -l*)
- # Some compilers place space between "-{L,R}" and the path.
- # Remove the space.
- if test $p = "-L" ||
- test $p = "-R"; then
- prev=$p
- continue
- else
- prev=
- fi
-
- if test "$pre_test_object_deps_done" = no; then
- case $p in
- -L* | -R*)
- # Internal compiler library paths should come after those
- # provided the user. The postdeps already come after the
- # user supplied libs so there is no need to process them.
- if test -z "$_LT_TAGVAR(compiler_lib_search_path, $1)"; then
- _LT_TAGVAR(compiler_lib_search_path, $1)="${prev}${p}"
- else
- _LT_TAGVAR(compiler_lib_search_path, $1)="${_LT_TAGVAR(compiler_lib_search_path, $1)} ${prev}${p}"
- fi
- ;;
- # The "-l" case would never come before the object being
- # linked, so don't bother handling this case.
- esac
- else
- if test -z "$_LT_TAGVAR(postdeps, $1)"; then
- _LT_TAGVAR(postdeps, $1)="${prev}${p}"
- else
- _LT_TAGVAR(postdeps, $1)="${_LT_TAGVAR(postdeps, $1)} ${prev}${p}"
- fi
- fi
- ;;
-
- *.$objext)
- # This assumes that the test object file only shows up
- # once in the compiler output.
- if test "$p" = "conftest.$objext"; then
- pre_test_object_deps_done=yes
- continue
- fi
-
- if test "$pre_test_object_deps_done" = no; then
- if test -z "$_LT_TAGVAR(predep_objects, $1)"; then
- _LT_TAGVAR(predep_objects, $1)="$p"
- else
- _LT_TAGVAR(predep_objects, $1)="$_LT_TAGVAR(predep_objects, $1) $p"
- fi
- else
- if test -z "$_LT_TAGVAR(postdep_objects, $1)"; then
- _LT_TAGVAR(postdep_objects, $1)="$p"
- else
- _LT_TAGVAR(postdep_objects, $1)="$_LT_TAGVAR(postdep_objects, $1) $p"
- fi
- fi
- ;;
-
- *) ;; # Ignore the rest.
-
- esac
- done
-
- # Clean up.
- rm -f a.out a.exe
-else
- echo "libtool.m4: error: problem compiling $1 test program"
-fi
-
-$RM -f confest.$objext
-
-# PORTME: override above test on systems where it is broken
-m4_if([$1], [CXX],
-[case $host_os in
-interix[[3-9]]*)
- # Interix 3.5 installs completely hosed .la files for C++, so rather than
- # hack all around it, let's just trust "g++" to DTRT.
- _LT_TAGVAR(predep_objects,$1)=
- _LT_TAGVAR(postdep_objects,$1)=
- _LT_TAGVAR(postdeps,$1)=
- ;;
-
-linux*)
- case `$CC -V 2>&1 | sed 5q` in
- *Sun\ C*)
- # Sun C++ 5.9
-
- # The more standards-conforming stlport4 library is
- # incompatible with the Cstd library. Avoid specifying
- # it if it's in CXXFLAGS. Ignore libCrun as
- # -library=stlport4 depends on it.
- case " $CXX $CXXFLAGS " in
- *" -library=stlport4 "*)
- solaris_use_stlport4=yes
- ;;
- esac
-
- if test "$solaris_use_stlport4" != yes; then
- _LT_TAGVAR(postdeps,$1)='-library=Cstd -library=Crun'
- fi
- ;;
- esac
- ;;
-
-solaris*)
- case $cc_basename in
- CC*)
- # The more standards-conforming stlport4 library is
- # incompatible with the Cstd library. Avoid specifying
- # it if it's in CXXFLAGS. Ignore libCrun as
- # -library=stlport4 depends on it.
- case " $CXX $CXXFLAGS " in
- *" -library=stlport4 "*)
- solaris_use_stlport4=yes
- ;;
- esac
-
- # Adding this requires a known-good setup of shared libraries for
- # Sun compiler versions before 5.6, else PIC objects from an old
- # archive will be linked into the output, leading to subtle bugs.
- if test "$solaris_use_stlport4" != yes; then
- _LT_TAGVAR(postdeps,$1)='-library=Cstd -library=Crun'
- fi
- ;;
- esac
- ;;
-esac
-])
-
-case " $_LT_TAGVAR(postdeps, $1) " in
-*" -lc "*) _LT_TAGVAR(archive_cmds_need_lc, $1)=no ;;
-esac
- _LT_TAGVAR(compiler_lib_search_dirs, $1)=
-if test -n "${_LT_TAGVAR(compiler_lib_search_path, $1)}"; then
- _LT_TAGVAR(compiler_lib_search_dirs, $1)=`echo " ${_LT_TAGVAR(compiler_lib_search_path, $1)}" | ${SED} -e 's! -L! !g' -e 's!^ !!'`
-fi
-_LT_TAGDECL([], [compiler_lib_search_dirs], [1],
- [The directories searched by this compiler when creating a shared library])
-_LT_TAGDECL([], [predep_objects], [1],
- [Dependencies to place before and after the objects being linked to
- create a shared library])
-_LT_TAGDECL([], [postdep_objects], [1])
-_LT_TAGDECL([], [predeps], [1])
-_LT_TAGDECL([], [postdeps], [1])
-_LT_TAGDECL([], [compiler_lib_search_path], [1],
- [The library search path used internally by the compiler when linking
- a shared library])
-])# _LT_SYS_HIDDEN_LIBDEPS
-
-
-# _LT_PROG_F77
-# ------------
-# Since AC_PROG_F77 is broken, in that it returns the empty string
-# if there is no fortran compiler, we have our own version here.
-m4_defun([_LT_PROG_F77],
-[
-pushdef([AC_MSG_ERROR], [_lt_disable_F77=yes])
-AC_PROG_F77
-if test -z "$F77" || test "X$F77" = "Xno"; then
- _lt_disable_F77=yes
-fi
-popdef([AC_MSG_ERROR])
-])# _LT_PROG_F77
-
-dnl aclocal-1.4 backwards compatibility:
-dnl AC_DEFUN([_LT_PROG_F77], [])
-
-
-# _LT_LANG_F77_CONFIG([TAG])
-# --------------------------
-# Ensure that the configuration variables for a Fortran 77 compiler are
-# suitably defined. These variables are subsequently used by _LT_CONFIG
-# to write the compiler configuration to `libtool'.
-m4_defun([_LT_LANG_F77_CONFIG],
-[AC_REQUIRE([_LT_PROG_F77])dnl
-AC_LANG_PUSH(Fortran 77)
-
-_LT_TAGVAR(archive_cmds_need_lc, $1)=no
-_LT_TAGVAR(allow_undefined_flag, $1)=
-_LT_TAGVAR(always_export_symbols, $1)=no
-_LT_TAGVAR(archive_expsym_cmds, $1)=
-_LT_TAGVAR(export_dynamic_flag_spec, $1)=
-_LT_TAGVAR(hardcode_direct, $1)=no
-_LT_TAGVAR(hardcode_direct_absolute, $1)=no
-_LT_TAGVAR(hardcode_libdir_flag_spec, $1)=
-_LT_TAGVAR(hardcode_libdir_flag_spec_ld, $1)=
-_LT_TAGVAR(hardcode_libdir_separator, $1)=
-_LT_TAGVAR(hardcode_minus_L, $1)=no
-_LT_TAGVAR(hardcode_automatic, $1)=no
-_LT_TAGVAR(inherit_rpath, $1)=no
-_LT_TAGVAR(module_cmds, $1)=
-_LT_TAGVAR(module_expsym_cmds, $1)=
-_LT_TAGVAR(link_all_deplibs, $1)=unknown
-_LT_TAGVAR(old_archive_cmds, $1)=$old_archive_cmds
-_LT_TAGVAR(no_undefined_flag, $1)=
-_LT_TAGVAR(whole_archive_flag_spec, $1)=
-_LT_TAGVAR(enable_shared_with_static_runtimes, $1)=no
-
-# Source file extension for f77 test sources.
-ac_ext=f
-
-# Object file extension for compiled f77 test sources.
-objext=o
-_LT_TAGVAR(objext, $1)=$objext
-
-# No sense in running all these tests if we already determined that
-# the F77 compiler isn't working. Some variables (like enable_shared)
-# are currently assumed to apply to all compilers on this platform,
-# and will be corrupted by setting them based on a non-working compiler.
-if test "$_lt_disable_F77" != yes; then
- # Code to be used in simple compile tests
- lt_simple_compile_test_code="\
- subroutine t
- return
- end
-"
-
- # Code to be used in simple link tests
- lt_simple_link_test_code="\
- program t
- end
-"
-
- # ltmain only uses $CC for tagged configurations so make sure $CC is set.
- _LT_TAG_COMPILER
-
- # save warnings/boilerplate of simple test code
- _LT_COMPILER_BOILERPLATE
- _LT_LINKER_BOILERPLATE
-
- # Allow CC to be a program name with arguments.
- lt_save_CC="$CC"
- lt_save_GCC=$GCC
- CC=${F77-"f77"}
- compiler=$CC
- _LT_TAGVAR(compiler, $1)=$CC
- _LT_CC_BASENAME([$compiler])
- GCC=$G77
- if test -n "$compiler"; then
- AC_MSG_CHECKING([if libtool supports shared libraries])
- AC_MSG_RESULT([$can_build_shared])
-
- AC_MSG_CHECKING([whether to build shared libraries])
- test "$can_build_shared" = "no" && enable_shared=no
-
- # On AIX, shared libraries and static libraries use the same namespace, and
- # are all built from PIC.
- case $host_os in
- aix3*)
- test "$enable_shared" = yes && enable_static=no
- if test -n "$RANLIB"; then
- archive_cmds="$archive_cmds~\$RANLIB \$lib"
- postinstall_cmds='$RANLIB $lib'
- fi
- ;;
- aix[[4-9]]*)
- if test "$host_cpu" != ia64 && test "$aix_use_runtimelinking" = no ; then
- test "$enable_shared" = yes && enable_static=no
- fi
- ;;
- esac
- AC_MSG_RESULT([$enable_shared])
-
- AC_MSG_CHECKING([whether to build static libraries])
- # Make sure either enable_shared or enable_static is yes.
- test "$enable_shared" = yes || enable_static=yes
- AC_MSG_RESULT([$enable_static])
-
- _LT_TAGVAR(GCC, $1)="$G77"
- _LT_TAGVAR(LD, $1)="$LD"
-
- ## CAVEAT EMPTOR:
- ## There is no encapsulation within the following macros, do not change
- ## the running order or otherwise move them around unless you know exactly
- ## what you are doing...
- _LT_COMPILER_PIC($1)
- _LT_COMPILER_C_O($1)
- _LT_COMPILER_FILE_LOCKS($1)
- _LT_LINKER_SHLIBS($1)
- _LT_SYS_DYNAMIC_LINKER($1)
- _LT_LINKER_HARDCODE_LIBPATH($1)
-
- _LT_CONFIG($1)
- fi # test -n "$compiler"
-
- GCC=$lt_save_GCC
- CC="$lt_save_CC"
-fi # test "$_lt_disable_F77" != yes
-
-AC_LANG_POP
-])# _LT_LANG_F77_CONFIG
-
-
-# _LT_PROG_FC
-# -----------
-# Since AC_PROG_FC is broken, in that it returns the empty string
-# if there is no fortran compiler, we have our own version here.
-m4_defun([_LT_PROG_FC],
-[
-pushdef([AC_MSG_ERROR], [_lt_disable_FC=yes])
-AC_PROG_FC
-if test -z "$FC" || test "X$FC" = "Xno"; then
- _lt_disable_FC=yes
-fi
-popdef([AC_MSG_ERROR])
-])# _LT_PROG_FC
-
-dnl aclocal-1.4 backwards compatibility:
-dnl AC_DEFUN([_LT_PROG_FC], [])
-
-
-# _LT_LANG_FC_CONFIG([TAG])
-# -------------------------
-# Ensure that the configuration variables for a Fortran compiler are
-# suitably defined. These variables are subsequently used by _LT_CONFIG
-# to write the compiler configuration to `libtool'.
-m4_defun([_LT_LANG_FC_CONFIG],
-[AC_REQUIRE([_LT_PROG_FC])dnl
-AC_LANG_PUSH(Fortran)
-
-_LT_TAGVAR(archive_cmds_need_lc, $1)=no
-_LT_TAGVAR(allow_undefined_flag, $1)=
-_LT_TAGVAR(always_export_symbols, $1)=no
-_LT_TAGVAR(archive_expsym_cmds, $1)=
-_LT_TAGVAR(export_dynamic_flag_spec, $1)=
-_LT_TAGVAR(hardcode_direct, $1)=no
-_LT_TAGVAR(hardcode_direct_absolute, $1)=no
-_LT_TAGVAR(hardcode_libdir_flag_spec, $1)=
-_LT_TAGVAR(hardcode_libdir_flag_spec_ld, $1)=
-_LT_TAGVAR(hardcode_libdir_separator, $1)=
-_LT_TAGVAR(hardcode_minus_L, $1)=no
-_LT_TAGVAR(hardcode_automatic, $1)=no
-_LT_TAGVAR(inherit_rpath, $1)=no
-_LT_TAGVAR(module_cmds, $1)=
-_LT_TAGVAR(module_expsym_cmds, $1)=
-_LT_TAGVAR(link_all_deplibs, $1)=unknown
-_LT_TAGVAR(old_archive_cmds, $1)=$old_archive_cmds
-_LT_TAGVAR(no_undefined_flag, $1)=
-_LT_TAGVAR(whole_archive_flag_spec, $1)=
-_LT_TAGVAR(enable_shared_with_static_runtimes, $1)=no
-
-# Source file extension for fc test sources.
-ac_ext=${ac_fc_srcext-f}
-
-# Object file extension for compiled fc test sources.
-objext=o
-_LT_TAGVAR(objext, $1)=$objext
-
-# No sense in running all these tests if we already determined that
-# the FC compiler isn't working. Some variables (like enable_shared)
-# are currently assumed to apply to all compilers on this platform,
-# and will be corrupted by setting them based on a non-working compiler.
-if test "$_lt_disable_FC" != yes; then
- # Code to be used in simple compile tests
- lt_simple_compile_test_code="\
- subroutine t
- return
- end
-"
-
- # Code to be used in simple link tests
- lt_simple_link_test_code="\
- program t
- end
-"
-
- # ltmain only uses $CC for tagged configurations so make sure $CC is set.
- _LT_TAG_COMPILER
-
- # save warnings/boilerplate of simple test code
- _LT_COMPILER_BOILERPLATE
- _LT_LINKER_BOILERPLATE
-
- # Allow CC to be a program name with arguments.
- lt_save_CC="$CC"
- lt_save_GCC=$GCC
- CC=${FC-"f95"}
- compiler=$CC
- GCC=$ac_cv_fc_compiler_gnu
-
- _LT_TAGVAR(compiler, $1)=$CC
- _LT_CC_BASENAME([$compiler])
-
- if test -n "$compiler"; then
- AC_MSG_CHECKING([if libtool supports shared libraries])
- AC_MSG_RESULT([$can_build_shared])
-
- AC_MSG_CHECKING([whether to build shared libraries])
- test "$can_build_shared" = "no" && enable_shared=no
-
- # On AIX, shared libraries and static libraries use the same namespace, and
- # are all built from PIC.
- case $host_os in
- aix3*)
- test "$enable_shared" = yes && enable_static=no
- if test -n "$RANLIB"; then
- archive_cmds="$archive_cmds~\$RANLIB \$lib"
- postinstall_cmds='$RANLIB $lib'
- fi
- ;;
- aix[[4-9]]*)
- if test "$host_cpu" != ia64 && test "$aix_use_runtimelinking" = no ; then
- test "$enable_shared" = yes && enable_static=no
- fi
- ;;
- esac
- AC_MSG_RESULT([$enable_shared])
-
- AC_MSG_CHECKING([whether to build static libraries])
- # Make sure either enable_shared or enable_static is yes.
- test "$enable_shared" = yes || enable_static=yes
- AC_MSG_RESULT([$enable_static])
-
- _LT_TAGVAR(GCC, $1)="$ac_cv_fc_compiler_gnu"
- _LT_TAGVAR(LD, $1)="$LD"
-
- ## CAVEAT EMPTOR:
- ## There is no encapsulation within the following macros, do not change
- ## the running order or otherwise move them around unless you know exactly
- ## what you are doing...
- _LT_SYS_HIDDEN_LIBDEPS($1)
- _LT_COMPILER_PIC($1)
- _LT_COMPILER_C_O($1)
- _LT_COMPILER_FILE_LOCKS($1)
- _LT_LINKER_SHLIBS($1)
- _LT_SYS_DYNAMIC_LINKER($1)
- _LT_LINKER_HARDCODE_LIBPATH($1)
-
- _LT_CONFIG($1)
- fi # test -n "$compiler"
-
- GCC=$lt_save_GCC
- CC="$lt_save_CC"
-fi # test "$_lt_disable_FC" != yes
-
-AC_LANG_POP
-])# _LT_LANG_FC_CONFIG
-
-
-# _LT_LANG_GCJ_CONFIG([TAG])
-# --------------------------
-# Ensure that the configuration variables for the GNU Java Compiler compiler
-# are suitably defined. These variables are subsequently used by _LT_CONFIG
-# to write the compiler configuration to `libtool'.
-m4_defun([_LT_LANG_GCJ_CONFIG],
-[AC_REQUIRE([LT_PROG_GCJ])dnl
-AC_LANG_SAVE
-
-# Source file extension for Java test sources.
-ac_ext=java
-
-# Object file extension for compiled Java test sources.
-objext=o
-_LT_TAGVAR(objext, $1)=$objext
-
-# Code to be used in simple compile tests
-lt_simple_compile_test_code="class foo {}"
-
-# Code to be used in simple link tests
-lt_simple_link_test_code='public class conftest { public static void main(String[[]] argv) {}; }'
-
-# ltmain only uses $CC for tagged configurations so make sure $CC is set.
-_LT_TAG_COMPILER
-
-# save warnings/boilerplate of simple test code
-_LT_COMPILER_BOILERPLATE
-_LT_LINKER_BOILERPLATE
-
-# Allow CC to be a program name with arguments.
-lt_save_CC="$CC"
-lt_save_GCC=$GCC
-GCC=yes
-CC=${GCJ-"gcj"}
-compiler=$CC
-_LT_TAGVAR(compiler, $1)=$CC
-_LT_TAGVAR(LD, $1)="$LD"
-_LT_CC_BASENAME([$compiler])
-
-# GCJ did not exist at the time GCC didn't implicitly link libc in.
-_LT_TAGVAR(archive_cmds_need_lc, $1)=no
-
-_LT_TAGVAR(old_archive_cmds, $1)=$old_archive_cmds
-
-## CAVEAT EMPTOR:
-## There is no encapsulation within the following macros, do not change
-## the running order or otherwise move them around unless you know exactly
-## what you are doing...
-if test -n "$compiler"; then
- _LT_COMPILER_NO_RTTI($1)
- _LT_COMPILER_PIC($1)
- _LT_COMPILER_C_O($1)
- _LT_COMPILER_FILE_LOCKS($1)
- _LT_LINKER_SHLIBS($1)
- _LT_LINKER_HARDCODE_LIBPATH($1)
-
- _LT_CONFIG($1)
-fi
-
-AC_LANG_RESTORE
-
-GCC=$lt_save_GCC
-CC="$lt_save_CC"
-])# _LT_LANG_GCJ_CONFIG
-
-
-# _LT_LANG_RC_CONFIG([TAG])
-# -------------------------
-# Ensure that the configuration variables for the Windows resource compiler
-# are suitably defined. These variables are subsequently used by _LT_CONFIG
-# to write the compiler configuration to `libtool'.
-m4_defun([_LT_LANG_RC_CONFIG],
-[AC_REQUIRE([LT_PROG_RC])dnl
-AC_LANG_SAVE
-
-# Source file extension for RC test sources.
-ac_ext=rc
-
-# Object file extension for compiled RC test sources.
-objext=o
-_LT_TAGVAR(objext, $1)=$objext
-
-# Code to be used in simple compile tests
-lt_simple_compile_test_code='sample MENU { MENUITEM "&Soup", 100, CHECKED }'
-
-# Code to be used in simple link tests
-lt_simple_link_test_code="$lt_simple_compile_test_code"
-
-# ltmain only uses $CC for tagged configurations so make sure $CC is set.
-_LT_TAG_COMPILER
-
-# save warnings/boilerplate of simple test code
-_LT_COMPILER_BOILERPLATE
-_LT_LINKER_BOILERPLATE
-
-# Allow CC to be a program name with arguments.
-lt_save_CC="$CC"
-lt_save_GCC=$GCC
-GCC=
-CC=${RC-"windres"}
-compiler=$CC
-_LT_TAGVAR(compiler, $1)=$CC
-_LT_CC_BASENAME([$compiler])
-_LT_TAGVAR(lt_cv_prog_compiler_c_o, $1)=yes
-
-if test -n "$compiler"; then
- :
- _LT_CONFIG($1)
-fi
-
-GCC=$lt_save_GCC
-AC_LANG_RESTORE
-CC="$lt_save_CC"
-])# _LT_LANG_RC_CONFIG
-
-
-# LT_PROG_GCJ
-# -----------
-AC_DEFUN([LT_PROG_GCJ],
-[m4_ifdef([AC_PROG_GCJ], [AC_PROG_GCJ],
- [m4_ifdef([A][M_PROG_GCJ], [A][M_PROG_GCJ],
- [AC_CHECK_TOOL(GCJ, gcj,)
- test "x${GCJFLAGS+set}" = xset || GCJFLAGS="-g -O2"
- AC_SUBST(GCJFLAGS)])])[]dnl
-])
-
-# Old name:
-AU_ALIAS([LT_AC_PROG_GCJ], [LT_PROG_GCJ])
-dnl aclocal-1.4 backwards compatibility:
-dnl AC_DEFUN([LT_AC_PROG_GCJ], [])
-
-
-# LT_PROG_RC
-# ----------
-AC_DEFUN([LT_PROG_RC],
-[AC_CHECK_TOOL(RC, windres,)
-])
-
-# Old name:
-AU_ALIAS([LT_AC_PROG_RC], [LT_PROG_RC])
-dnl aclocal-1.4 backwards compatibility:
-dnl AC_DEFUN([LT_AC_PROG_RC], [])
-
-
-# _LT_DECL_EGREP
-# --------------
-# If we don't have a new enough Autoconf to choose the best grep
-# available, choose the one first in the user's PATH.
-m4_defun([_LT_DECL_EGREP],
-[AC_REQUIRE([AC_PROG_EGREP])dnl
-AC_REQUIRE([AC_PROG_FGREP])dnl
-test -z "$GREP" && GREP=grep
-_LT_DECL([], [GREP], [1], [A grep program that handles long lines])
-_LT_DECL([], [EGREP], [1], [An ERE matcher])
-_LT_DECL([], [FGREP], [1], [A literal string matcher])
-dnl Non-bleeding-edge autoconf doesn't subst GREP, so do it here too
-AC_SUBST([GREP])
-])
-
-
-# _LT_DECL_OBJDUMP
-# --------------
-# If we don't have a new enough Autoconf to choose the best objdump
-# available, choose the one first in the user's PATH.
-m4_defun([_LT_DECL_OBJDUMP],
-[AC_CHECK_TOOL(OBJDUMP, objdump, false)
-test -z "$OBJDUMP" && OBJDUMP=objdump
-_LT_DECL([], [OBJDUMP], [1], [An object symbol dumper])
-AC_SUBST([OBJDUMP])
-])
-
-
-# _LT_DECL_SED
-# ------------
-# Check for a fully-functional sed program, that truncates
-# as few characters as possible. Prefer GNU sed if found.
-m4_defun([_LT_DECL_SED],
-[AC_PROG_SED
-test -z "$SED" && SED=sed
-Xsed="$SED -e 1s/^X//"
-_LT_DECL([], [SED], [1], [A sed program that does not truncate output])
-_LT_DECL([], [Xsed], ["\$SED -e 1s/^X//"],
- [Sed that helps us avoid accidentally triggering echo(1) options like -n])
-])# _LT_DECL_SED
-
-m4_ifndef([AC_PROG_SED], [
-############################################################
-# NOTE: This macro has been submitted for inclusion into #
-# GNU Autoconf as AC_PROG_SED. When it is available in #
-# a released version of Autoconf we should remove this #
-# macro and use it instead. #
-############################################################
-
-m4_defun([AC_PROG_SED],
-[AC_MSG_CHECKING([for a sed that does not truncate output])
-AC_CACHE_VAL(lt_cv_path_SED,
-[# Loop through the user's path and test for sed and gsed.
-# Then use that list of sed's as ones to test for truncation.
-as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- for lt_ac_prog in sed gsed; do
- for ac_exec_ext in '' $ac_executable_extensions; do
- if $as_executable_p "$as_dir/$lt_ac_prog$ac_exec_ext"; then
- lt_ac_sed_list="$lt_ac_sed_list $as_dir/$lt_ac_prog$ac_exec_ext"
- fi
- done
- done
-done
-IFS=$as_save_IFS
-lt_ac_max=0
-lt_ac_count=0
-# Add /usr/xpg4/bin/sed as it is typically found on Solaris
-# along with /bin/sed that truncates output.
-for lt_ac_sed in $lt_ac_sed_list /usr/xpg4/bin/sed; do
- test ! -f $lt_ac_sed && continue
- cat /dev/null > conftest.in
- lt_ac_count=0
- echo $ECHO_N "0123456789$ECHO_C" >conftest.in
- # Check for GNU sed and select it if it is found.
- if "$lt_ac_sed" --version 2>&1 < /dev/null | grep 'GNU' > /dev/null; then
- lt_cv_path_SED=$lt_ac_sed
- break
- fi
- while true; do
- cat conftest.in conftest.in >conftest.tmp
- mv conftest.tmp conftest.in
- cp conftest.in conftest.nl
- echo >>conftest.nl
- $lt_ac_sed -e 's/a$//' < conftest.nl >conftest.out || break
- cmp -s conftest.out conftest.nl || break
- # 10000 chars as input seems more than enough
- test $lt_ac_count -gt 10 && break
- lt_ac_count=`expr $lt_ac_count + 1`
- if test $lt_ac_count -gt $lt_ac_max; then
- lt_ac_max=$lt_ac_count
- lt_cv_path_SED=$lt_ac_sed
- fi
- done
-done
-])
-SED=$lt_cv_path_SED
-AC_SUBST([SED])
-AC_MSG_RESULT([$SED])
-])#AC_PROG_SED
-])#m4_ifndef
-
-# Old name:
-AU_ALIAS([LT_AC_PROG_SED], [AC_PROG_SED])
-dnl aclocal-1.4 backwards compatibility:
-dnl AC_DEFUN([LT_AC_PROG_SED], [])
-
-
-# _LT_CHECK_SHELL_FEATURES
-# ------------------------
-# Find out whether the shell is Bourne or XSI compatible,
-# or has some other useful features.
-m4_defun([_LT_CHECK_SHELL_FEATURES],
-[AC_MSG_CHECKING([whether the shell understands some XSI constructs])
-# Try some XSI features
-xsi_shell=no
-( _lt_dummy="a/b/c"
- test "${_lt_dummy##*/},${_lt_dummy%/*},"${_lt_dummy%"$_lt_dummy"}, \
- = c,a/b,, \
- && eval 'test $(( 1 + 1 )) -eq 2 \
- && test "${#_lt_dummy}" -eq 5' ) >/dev/null 2>&1 \
- && xsi_shell=yes
-AC_MSG_RESULT([$xsi_shell])
-_LT_CONFIG_LIBTOOL_INIT([xsi_shell='$xsi_shell'])
-
-AC_MSG_CHECKING([whether the shell understands "+="])
-lt_shell_append=no
-( foo=bar; set foo baz; eval "$[1]+=\$[2]" && test "$foo" = barbaz ) \
- >/dev/null 2>&1 \
- && lt_shell_append=yes
-AC_MSG_RESULT([$lt_shell_append])
-_LT_CONFIG_LIBTOOL_INIT([lt_shell_append='$lt_shell_append'])
-
-if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then
- lt_unset=unset
-else
- lt_unset=false
-fi
-_LT_DECL([], [lt_unset], [0], [whether the shell understands "unset"])dnl
-
-# test EBCDIC or ASCII
-case `echo X|tr X '\101'` in
- A) # ASCII based system
- # \n is not interpreted correctly by Solaris 8 /usr/ucb/tr
- lt_SP2NL='tr \040 \012'
- lt_NL2SP='tr \015\012 \040\040'
- ;;
- *) # EBCDIC based system
- lt_SP2NL='tr \100 \n'
- lt_NL2SP='tr \r\n \100\100'
- ;;
-esac
-_LT_DECL([SP2NL], [lt_SP2NL], [1], [turn spaces into newlines])dnl
-_LT_DECL([NL2SP], [lt_NL2SP], [1], [turn newlines into spaces])dnl
-])# _LT_CHECK_SHELL_FEATURES
-
-
-# _LT_PROG_XSI_SHELLFNS
-# ---------------------
-# Bourne and XSI compatible variants of some useful shell functions.
-m4_defun([_LT_PROG_XSI_SHELLFNS],
-[case $xsi_shell in
- yes)
- cat << \_LT_EOF >> "$cfgfile"
-
-# func_dirname file append nondir_replacement
-# Compute the dirname of FILE. If nonempty, add APPEND to the result,
-# otherwise set result to NONDIR_REPLACEMENT.
-func_dirname ()
-{
- case ${1} in
- */*) func_dirname_result="${1%/*}${2}" ;;
- * ) func_dirname_result="${3}" ;;
- esac
-}
-
-# func_basename file
-func_basename ()
-{
- func_basename_result="${1##*/}"
-}
-
-# func_dirname_and_basename file append nondir_replacement
-# perform func_basename and func_dirname in a single function
-# call:
-# dirname: Compute the dirname of FILE. If nonempty,
-# add APPEND to the result, otherwise set result
-# to NONDIR_REPLACEMENT.
-# value returned in "$func_dirname_result"
-# basename: Compute filename of FILE.
-# value retuned in "$func_basename_result"
-# Implementation must be kept synchronized with func_dirname
-# and func_basename. For efficiency, we do not delegate to
-# those functions but instead duplicate the functionality here.
-func_dirname_and_basename ()
-{
- case ${1} in
- */*) func_dirname_result="${1%/*}${2}" ;;
- * ) func_dirname_result="${3}" ;;
- esac
- func_basename_result="${1##*/}"
-}
-
-# func_stripname prefix suffix name
-# strip PREFIX and SUFFIX off of NAME.
-# PREFIX and SUFFIX must not contain globbing or regex special
-# characters, hashes, percent signs, but SUFFIX may contain a leading
-# dot (in which case that matches only a dot).
-func_stripname ()
-{
- # pdksh 5.2.14 does not do ${X%$Y} correctly if both X and Y are
- # positional parameters, so assign one to ordinary parameter first.
- func_stripname_result=${3}
- func_stripname_result=${func_stripname_result#"${1}"}
- func_stripname_result=${func_stripname_result%"${2}"}
-}
-
-# func_opt_split
-func_opt_split ()
-{
- func_opt_split_opt=${1%%=*}
- func_opt_split_arg=${1#*=}
-}
-
-# func_lo2o object
-func_lo2o ()
-{
- case ${1} in
- *.lo) func_lo2o_result=${1%.lo}.${objext} ;;
- *) func_lo2o_result=${1} ;;
- esac
-}
-
-# func_xform libobj-or-source
-func_xform ()
-{
- func_xform_result=${1%.*}.lo
-}
-
-# func_arith arithmetic-term...
-func_arith ()
-{
- func_arith_result=$(( $[*] ))
-}
-
-# func_len string
-# STRING may not start with a hyphen.
-func_len ()
-{
- func_len_result=${#1}
-}
-
-_LT_EOF
- ;;
- *) # Bourne compatible functions.
- cat << \_LT_EOF >> "$cfgfile"
-
-# func_dirname file append nondir_replacement
-# Compute the dirname of FILE. If nonempty, add APPEND to the result,
-# otherwise set result to NONDIR_REPLACEMENT.
-func_dirname ()
-{
- # Extract subdirectory from the argument.
- func_dirname_result=`$ECHO "X${1}" | $Xsed -e "$dirname"`
- if test "X$func_dirname_result" = "X${1}"; then
- func_dirname_result="${3}"
- else
- func_dirname_result="$func_dirname_result${2}"
- fi
-}
-
-# func_basename file
-func_basename ()
-{
- func_basename_result=`$ECHO "X${1}" | $Xsed -e "$basename"`
-}
-
-dnl func_dirname_and_basename
-dnl A portable version of this function is already defined in general.m4sh
-dnl so there is no need for it here.
-
-# func_stripname prefix suffix name
-# strip PREFIX and SUFFIX off of NAME.
-# PREFIX and SUFFIX must not contain globbing or regex special
-# characters, hashes, percent signs, but SUFFIX may contain a leading
-# dot (in which case that matches only a dot).
-# func_strip_suffix prefix name
-func_stripname ()
-{
- case ${2} in
- .*) func_stripname_result=`$ECHO "X${3}" \
- | $Xsed -e "s%^${1}%%" -e "s%\\\\${2}\$%%"`;;
- *) func_stripname_result=`$ECHO "X${3}" \
- | $Xsed -e "s%^${1}%%" -e "s%${2}\$%%"`;;
- esac
-}
-
-# sed scripts:
-my_sed_long_opt='1s/^\(-[[^=]]*\)=.*/\1/;q'
-my_sed_long_arg='1s/^-[[^=]]*=//'
-
-# func_opt_split
-func_opt_split ()
-{
- func_opt_split_opt=`$ECHO "X${1}" | $Xsed -e "$my_sed_long_opt"`
- func_opt_split_arg=`$ECHO "X${1}" | $Xsed -e "$my_sed_long_arg"`
-}
-
-# func_lo2o object
-func_lo2o ()
-{
- func_lo2o_result=`$ECHO "X${1}" | $Xsed -e "$lo2o"`
-}
-
-# func_xform libobj-or-source
-func_xform ()
-{
- func_xform_result=`$ECHO "X${1}" | $Xsed -e 's/\.[[^.]]*$/.lo/'`
-}
-
-# func_arith arithmetic-term...
-func_arith ()
-{
- func_arith_result=`expr "$[@]"`
-}
-
-# func_len string
-# STRING may not start with a hyphen.
-func_len ()
-{
- func_len_result=`expr "$[1]" : ".*" 2>/dev/null || echo $max_cmd_len`
-}
-
-_LT_EOF
-esac
-
-case $lt_shell_append in
- yes)
- cat << \_LT_EOF >> "$cfgfile"
-
-# func_append var value
-# Append VALUE to the end of shell variable VAR.
-func_append ()
-{
- eval "$[1]+=\$[2]"
-}
-_LT_EOF
- ;;
- *)
- cat << \_LT_EOF >> "$cfgfile"
-
-# func_append var value
-# Append VALUE to the end of shell variable VAR.
-func_append ()
-{
- eval "$[1]=\$$[1]\$[2]"
-}
-
-_LT_EOF
- ;;
- esac
-])
Index: branches/ohl/omega-development/hgg-vertex/m4/ltversion.m4
===================================================================
--- branches/ohl/omega-development/hgg-vertex/m4/ltversion.m4 (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/m4/ltversion.m4 (revision 8717)
@@ -1,23 +0,0 @@
-# ltversion.m4 -- version numbers -*- Autoconf -*-
-#
-# Copyright (C) 2004 Free Software Foundation, Inc.
-# Written by Scott James Remnant, 2004
-#
-# This file is free software; the Free Software Foundation gives
-# unlimited permission to copy and/or distribute it, with or without
-# modifications, as long as this notice is preserved.
-
-# Generated from ltversion.in.
-
-# serial 3017 ltversion.m4
-# This file is part of GNU Libtool
-
-m4_define([LT_PACKAGE_VERSION], [2.2.6b])
-m4_define([LT_PACKAGE_REVISION], [1.3017])
-
-AC_DEFUN([LTVERSION_VERSION],
-[macro_version='2.2.6b'
-macro_revision='1.3017'
-_LT_DECL(, macro_version, 0, [Which release of libtool.m4 was used?])
-_LT_DECL(, macro_revision, 0)
-])
Index: branches/ohl/omega-development/hgg-vertex/m4/omega.m4
===================================================================
--- branches/ohl/omega-development/hgg-vertex/m4/omega.m4 (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/m4/omega.m4 (revision 8717)
@@ -1,82 +0,0 @@
-dnl omega.m4 -- options for the O'Mega matrix element generator
-dnl
-
-### Enable/disable unreleased O'Mega models
-AC_DEFUN([WO_SET_OMEGA_UNRELEASED],
-[dnl
-AC_ARG_ENABLE([omega_unreleased],
- [AC_HELP_STRING([--enable-omega-unreleased],
- [build unreleased Omega modules (not tested extensively yet) [[no]]])])
-AM_CONDITIONAL([SELECT_OMEGA_UNRELEASED],
- [test -n "$omega_unreleased"])
-])
-### end WO_SET_OMEGA_UNRELEASED
-
-### Enable/disable unsupported O'Mega models
-AC_DEFUN([WO_SET_OMEGA_UNSUPPORTED],
-[dnl
-AC_ARG_ENABLE([omega_unsupported],
- [AC_HELP_STRING([--enable-omega-unsupported],
- [build unsupported Omega applications that are still under development [[no]]])])
-AM_CONDITIONAL([SELECT_OMEGA_UNRELASED],
- [test "$omega_unsupported" = "yes"])
-AM_CONDITIONAL([SELECT_OMEGA_THEORETICAL],
- [test "$omega_unsupported" = "yes"])
-AM_CONDITIONAL([SELECT_OMEGA_REDUNDANT],
- [test "$omega_unsupported" = "yes"])
-AM_CONDITIONAL([SELECT_OMEGA_DEVELOPERS],
- [test "$omega_unsupported" = "yes"])
-AM_CONDITIONAL([SELECT_OMEGA_OBSOLETE],
- [test "$omega_unsupported" = "yes"])
-])
-### end WO_SET_OMEGA_UNSUPPORTED
-
-AC_DEFUN([WO_SET_OMEGA_THEORETICAL],
-[dnl
-AC_ARG_ENABLE([omega_theoretical],
- [AC_HELP_STRING([--enable-omega-theoretical],
- [build some theoretical models not realized in nature [[no]]])])
-AM_CONDITIONAL([SELECT_OMEGA_THEORETICAL],
- [test "$omega_theoretical" = "yes"])
-])
-### end WO_SET_OMEGA_THEORETICAL
-
-AC_DEFUN([WO_SET_OMEGA_REDUNDANT],
-[dnl
-AC_ARG_ENABLE([omega_redundant],
- [AC_HELP_STRING([--enable-omega-redundant],
- [build some redundant models for consistency checks [[no]]])])
-AM_CONDITIONAL([SELECT_OMEGA_REDUNDANT],
- [test "$omega_redundant" = "yes"])
-])
-### end WO_SET_OMEGA_REDUNDANT
-
-AC_DEFUN([WO_SET_OMEGA_DEVELOPERS],
-[dnl
-AC_ARG_ENABLE([omega_developers],
- [AC_HELP_STRING([--enable-omega-developers],
- [build unreleased components (developers only!) [[no]]])])
-AM_CONDITIONAL([SELECT_OMEGA_DEVELOPERS],
- [test "$omega_developers" = "yes" -a $OCAMLINTEGERVERSION -ge 307000])
-])
-### end WO_SET_OMEGA_DEVELOPERS
-
-AC_DEFUN([WO_SET_OMEGA_OBSOLETE],
-[dnl
-AC_ARG_ENABLE([omega_obsolete],
- [AC_HELP_STRING([--enable-omega-obsolete],
- [build some obsolete/historical implementations [[no]]])])
-AM_CONDITIONAL([SELECT_OMEGA_OBSOLETE],
- [test "$omega_obsolete" = "yes"])
-])
-### end WO_SET_OMEGA_OBSOLETE
-
-AC_DEFUN([WO_SET_OMEGA_GUI],
-[dnl
-AC_ARG_ENABLE([omega_gui],
- [AC_HELP_STRING([--enable-omega-gui],
- [build a partial Omega GUI (requires LablGTK!!!) [[no]]])])
-AM_CONDITIONAL([SELECT_OMEGA_GUI],
- [test -n "$LABLGTKDIR" -a "$omega_gui" = "yes"])
-])
-### end WO_SET_OMEGA_GUI
Index: branches/ohl/omega-development/hgg-vertex/m4/lt~obsolete.m4
===================================================================
--- branches/ohl/omega-development/hgg-vertex/m4/lt~obsolete.m4 (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/m4/lt~obsolete.m4 (revision 8717)
@@ -1,92 +0,0 @@
-# lt~obsolete.m4 -- aclocal satisfying obsolete definitions. -*-Autoconf-*-
-#
-# Copyright (C) 2004, 2005, 2007 Free Software Foundation, Inc.
-# Written by Scott James Remnant, 2004.
-#
-# This file is free software; the Free Software Foundation gives
-# unlimited permission to copy and/or distribute it, with or without
-# modifications, as long as this notice is preserved.
-
-# serial 3
-
-# These exist entirely to fool aclocal when bootstrapping libtool.
-#
-# In the past libtool.m4 has provided macros via AC_DEFUN (or AU_DEFUN)
-# which have later been changed to m4_define as they aren't part of the
-# exported API, or moved to Autoconf or Automake where they belong.
-#
-# The trouble is, aclocal is a bit thick. It'll see the old AC_DEFUN
-# in /usr/share/aclocal/libtool.m4 and remember it, then when it sees us
-# using a macro with the same name in our local m4/libtool.m4 it'll
-# pull the old libtool.m4 in (it doesn't see our shiny new m4_define
-# and doesn't know about Autoconf macros at all.)
-#
-# So we provide this file, which has a silly filename so it's always
-# included after everything else. This provides aclocal with the
-# AC_DEFUNs it wants, but when m4 processes it, it doesn't do anything
-# because those macros already exist, or will be overwritten later.
-# We use AC_DEFUN over AU_DEFUN for compatibility with aclocal-1.6.
-#
-# Anytime we withdraw an AC_DEFUN or AU_DEFUN, remember to add it here.
-# Yes, that means every name once taken will need to remain here until
-# we give up compatibility with versions before 1.7, at which point
-# we need to keep only those names which we still refer to.
-
-# This is to help aclocal find these macros, as it can't see m4_define.
-AC_DEFUN([LTOBSOLETE_VERSION], [m4_if([1])])
-
-m4_ifndef([AC_LIBTOOL_LINKER_OPTION], [AC_DEFUN([AC_LIBTOOL_LINKER_OPTION])])
-m4_ifndef([AC_PROG_EGREP], [AC_DEFUN([AC_PROG_EGREP])])
-m4_ifndef([_LT_AC_PROG_ECHO_BACKSLASH], [AC_DEFUN([_LT_AC_PROG_ECHO_BACKSLASH])])
-m4_ifndef([_LT_AC_SHELL_INIT], [AC_DEFUN([_LT_AC_SHELL_INIT])])
-m4_ifndef([_LT_AC_SYS_LIBPATH_AIX], [AC_DEFUN([_LT_AC_SYS_LIBPATH_AIX])])
-m4_ifndef([_LT_PROG_LTMAIN], [AC_DEFUN([_LT_PROG_LTMAIN])])
-m4_ifndef([_LT_AC_TAGVAR], [AC_DEFUN([_LT_AC_TAGVAR])])
-m4_ifndef([AC_LTDL_ENABLE_INSTALL], [AC_DEFUN([AC_LTDL_ENABLE_INSTALL])])
-m4_ifndef([AC_LTDL_PREOPEN], [AC_DEFUN([AC_LTDL_PREOPEN])])
-m4_ifndef([_LT_AC_SYS_COMPILER], [AC_DEFUN([_LT_AC_SYS_COMPILER])])
-m4_ifndef([_LT_AC_LOCK], [AC_DEFUN([_LT_AC_LOCK])])
-m4_ifndef([AC_LIBTOOL_SYS_OLD_ARCHIVE], [AC_DEFUN([AC_LIBTOOL_SYS_OLD_ARCHIVE])])
-m4_ifndef([_LT_AC_TRY_DLOPEN_SELF], [AC_DEFUN([_LT_AC_TRY_DLOPEN_SELF])])
-m4_ifndef([AC_LIBTOOL_PROG_CC_C_O], [AC_DEFUN([AC_LIBTOOL_PROG_CC_C_O])])
-m4_ifndef([AC_LIBTOOL_SYS_HARD_LINK_LOCKS], [AC_DEFUN([AC_LIBTOOL_SYS_HARD_LINK_LOCKS])])
-m4_ifndef([AC_LIBTOOL_OBJDIR], [AC_DEFUN([AC_LIBTOOL_OBJDIR])])
-m4_ifndef([AC_LTDL_OBJDIR], [AC_DEFUN([AC_LTDL_OBJDIR])])
-m4_ifndef([AC_LIBTOOL_PROG_LD_HARDCODE_LIBPATH], [AC_DEFUN([AC_LIBTOOL_PROG_LD_HARDCODE_LIBPATH])])
-m4_ifndef([AC_LIBTOOL_SYS_LIB_STRIP], [AC_DEFUN([AC_LIBTOOL_SYS_LIB_STRIP])])
-m4_ifndef([AC_PATH_MAGIC], [AC_DEFUN([AC_PATH_MAGIC])])
-m4_ifndef([AC_PROG_LD_GNU], [AC_DEFUN([AC_PROG_LD_GNU])])
-m4_ifndef([AC_PROG_LD_RELOAD_FLAG], [AC_DEFUN([AC_PROG_LD_RELOAD_FLAG])])
-m4_ifndef([AC_DEPLIBS_CHECK_METHOD], [AC_DEFUN([AC_DEPLIBS_CHECK_METHOD])])
-m4_ifndef([AC_LIBTOOL_PROG_COMPILER_NO_RTTI], [AC_DEFUN([AC_LIBTOOL_PROG_COMPILER_NO_RTTI])])
-m4_ifndef([AC_LIBTOOL_SYS_GLOBAL_SYMBOL_PIPE], [AC_DEFUN([AC_LIBTOOL_SYS_GLOBAL_SYMBOL_PIPE])])
-m4_ifndef([AC_LIBTOOL_PROG_COMPILER_PIC], [AC_DEFUN([AC_LIBTOOL_PROG_COMPILER_PIC])])
-m4_ifndef([AC_LIBTOOL_PROG_LD_SHLIBS], [AC_DEFUN([AC_LIBTOOL_PROG_LD_SHLIBS])])
-m4_ifndef([AC_LIBTOOL_POSTDEP_PREDEP], [AC_DEFUN([AC_LIBTOOL_POSTDEP_PREDEP])])
-m4_ifndef([LT_AC_PROG_EGREP], [AC_DEFUN([LT_AC_PROG_EGREP])])
-m4_ifndef([LT_AC_PROG_SED], [AC_DEFUN([LT_AC_PROG_SED])])
-m4_ifndef([_LT_CC_BASENAME], [AC_DEFUN([_LT_CC_BASENAME])])
-m4_ifndef([_LT_COMPILER_BOILERPLATE], [AC_DEFUN([_LT_COMPILER_BOILERPLATE])])
-m4_ifndef([_LT_LINKER_BOILERPLATE], [AC_DEFUN([_LT_LINKER_BOILERPLATE])])
-m4_ifndef([_AC_PROG_LIBTOOL], [AC_DEFUN([_AC_PROG_LIBTOOL])])
-m4_ifndef([AC_LIBTOOL_SETUP], [AC_DEFUN([AC_LIBTOOL_SETUP])])
-m4_ifndef([_LT_AC_CHECK_DLFCN], [AC_DEFUN([_LT_AC_CHECK_DLFCN])])
-m4_ifndef([AC_LIBTOOL_SYS_DYNAMIC_LINKER], [AC_DEFUN([AC_LIBTOOL_SYS_DYNAMIC_LINKER])])
-m4_ifndef([_LT_AC_TAGCONFIG], [AC_DEFUN([_LT_AC_TAGCONFIG])])
-m4_ifndef([AC_DISABLE_FAST_INSTALL], [AC_DEFUN([AC_DISABLE_FAST_INSTALL])])
-m4_ifndef([_LT_AC_LANG_CXX], [AC_DEFUN([_LT_AC_LANG_CXX])])
-m4_ifndef([_LT_AC_LANG_F77], [AC_DEFUN([_LT_AC_LANG_F77])])
-m4_ifndef([_LT_AC_LANG_GCJ], [AC_DEFUN([_LT_AC_LANG_GCJ])])
-m4_ifndef([AC_LIBTOOL_RC], [AC_DEFUN([AC_LIBTOOL_RC])])
-m4_ifndef([AC_LIBTOOL_LANG_C_CONFIG], [AC_DEFUN([AC_LIBTOOL_LANG_C_CONFIG])])
-m4_ifndef([_LT_AC_LANG_C_CONFIG], [AC_DEFUN([_LT_AC_LANG_C_CONFIG])])
-m4_ifndef([AC_LIBTOOL_LANG_CXX_CONFIG], [AC_DEFUN([AC_LIBTOOL_LANG_CXX_CONFIG])])
-m4_ifndef([_LT_AC_LANG_CXX_CONFIG], [AC_DEFUN([_LT_AC_LANG_CXX_CONFIG])])
-m4_ifndef([AC_LIBTOOL_LANG_F77_CONFIG], [AC_DEFUN([AC_LIBTOOL_LANG_F77_CONFIG])])
-m4_ifndef([_LT_AC_LANG_F77_CONFIG], [AC_DEFUN([_LT_AC_LANG_F77_CONFIG])])
-m4_ifndef([AC_LIBTOOL_LANG_GCJ_CONFIG], [AC_DEFUN([AC_LIBTOOL_LANG_GCJ_CONFIG])])
-m4_ifndef([_LT_AC_LANG_GCJ_CONFIG], [AC_DEFUN([_LT_AC_LANG_GCJ_CONFIG])])
-m4_ifndef([AC_LIBTOOL_LANG_RC_CONFIG], [AC_DEFUN([AC_LIBTOOL_LANG_RC_CONFIG])])
-m4_ifndef([_LT_AC_LANG_RC_CONFIG], [AC_DEFUN([_LT_AC_LANG_RC_CONFIG])])
-m4_ifndef([AC_LIBTOOL_CONFIG], [AC_DEFUN([AC_LIBTOOL_CONFIG])])
-m4_ifndef([_LT_AC_FILE_LTDLL_C], [AC_DEFUN([_LT_AC_FILE_LTDLL_C])])
Index: branches/ohl/omega-development/hgg-vertex/m4/noweb.m4
===================================================================
--- branches/ohl/omega-development/hgg-vertex/m4/noweb.m4 (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/m4/noweb.m4 (revision 8717)
@@ -1,23 +0,0 @@
-dnl noweb.m4 -- checks for NOWEB programs
-dnl
-
-### Determine paths to noweb components
-AC_DEFUN([WO_PROG_NOWEB],
-[dnl
-AC_ARG_ENABLE([noweb],
- [AC_HELP_STRING([--disable-noweb],
- [disable the noweb programs, even if available [[no]]])])
-if test "$enable_noweb" != "no"; then
-AC_PATH_PROG([NOTANGLE], [notangle])
-AC_PATH_PROG([CPIF], [cpif])
-AC_PATH_PROG([NOWEAVE], [noweave])
-fi
-AC_SUBST([NOTANGLE])
-AC_SUBST([NOWEAVE])
-AC_SUBST([CPIF])
-AM_CONDITIONAL([NOWEB_AVAILABLE],
- [test "$enable_noweb" != "no" -a -n "$NOTANGLE" -a -n "$CPIF" -a -n "$NOWEAVE"])
-])
-
-
-
Index: branches/ohl/omega-development/hgg-vertex/m4/fortran.m4
===================================================================
--- branches/ohl/omega-development/hgg-vertex/m4/fortran.m4 (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/m4/fortran.m4 (revision 8717)
@@ -1,861 +0,0 @@
-dnl fortran.m4 -- Fortran compiler checks beyond Autoconf built-ins
-dnl
-
-dnl The standard Fortran compiler test is AC_PROG_FC.
-dnl At the end FC, FCFLAGS and FCFLAGS_f90 are set, if successful.
-
-### Determine vendor and version string.
-AC_DEFUN([WO_FC_GET_VENDOR_AND_VERSION],
-[dnl
-AC_REQUIRE([AC_PROG_FC])
-
-AC_CACHE_CHECK([the compiler ID string],
-[wo_cv_fc_id_string],
-[dnl
-$FC -version >conftest.log 2>&1
-$FC -V >>conftest.log 2>&1
-$FC --version >>conftest.log 2>&1
-
-wo_fc_grep_GFORTRAN=`grep -i 'GNU Fortran' conftest.log | head -1`
-wo_fc_grep_G95=`grep -i 'g95' conftest.log | grep -i 'gcc' | head -1`
-wo_fc_grep_NAG=`grep 'NAG' conftest.log | head -1`
-wo_fc_grep_Intel=`grep 'Intel' conftest.log | head -1`
-wo_fc_grep_Sun=`grep 'Sun' conftest.log | head -1`
-wo_fc_grep_Lahey=`grep 'Lahey' conftest.log | head -1`
-wo_fc_grep_PGI=`grep 'pgf' conftest.log | head -1`
-wo_fc_grep_default=`cat conftest.log | head -1`
-
-if test -n "$wo_fc_grep_GFORTRAN"; then
- wo_cv_fc_id_string=$wo_fc_grep_GFORTRAN
-elif test -n "$wo_fc_grep_G95"; then
- wo_cv_fc_id_string=$wo_fc_grep_G95
-elif test -n "$wo_fc_grep_NAG"; then
- wo_cv_fc_id_string=$wo_fc_grep_NAG
-elif test -n "$wo_fc_grep_Intel"; then
- wo_cv_fc_id_string=$wo_fc_grep_Intel
-elif test -n "$wo_fc_grep_Sun"; then
- wo_cv_fc_id_string=$wo_fc_grep_Sun
-elif test -n "$wo_fc_grep_Lahey"; then
- wo_cv_fc_id_string=$wo_fc_grep_Lahey
-elif test -n "$wo_fc_grep_PGI"; then
- wo_cv_fc_id_string=$wo_fc_grep_PGI
-else
- wo_cv_fc_id_string=$wo_fc_grep_default
-fi
-
-rm -f conftest.log
-])
-FC_ID_STRING="$wo_cv_fc_id_string"
-AC_SUBST([FC_ID_STRING])
-
-AC_CACHE_CHECK([the compiler vendor],
-[wo_cv_fc_vendor],
-[dnl
-if test -n "$wo_fc_grep_GFORTRAN"; then
- wo_cv_fc_vendor="gfortran"
-elif test -n "$wo_fc_grep_G95"; then
- wo_cv_fc_vendor="g95"
-elif test -n "$wo_fc_grep_NAG"; then
- wo_cv_fc_vendor="NAG"
-elif test -n "$wo_fc_grep_Intel"; then
- wo_cv_fc_vendor="Intel"
-elif test -n "$wo_fc_grep_Sun"; then
- wo_cv_fc_vendor="Sun"
-elif test -n "$wo_fc_grep_Lahey"; then
- wo_cv_fc_vendor="Lahey"
-elif test -n "$wo_fc_grep_PGI"; then
- wo_cv_fc_vendor="PGI"
-else
- wo_cv_fc_vendor="unknown"
-fi
-])
-FC_VENDOR="$wo_cv_fc_vendor"
-
-
-AC_SUBST([FC_VENDOR])
-
-AM_CONDITIONAL([FC_IS_GFORTRAN],
- [test "$FC_VENDOR" = gfortran])
-
-AC_CACHE_CHECK([the compiler version],
-[wo_cv_fc_version],
-[dnl
-case $FC_VENDOR in
-gfortran)
- wo_cv_fc_version=[`echo $FC_ID_STRING | sed -e 's/.*\([0-9][0-9]*\.[0-9][0-9]*\.[0-9][0-9]*\).*/\1/'`]
- ;;
-g95)
- wo_cv_fc_version=[`echo $FC_ID_STRING | sed -e 's/.*g95 \([0-9][0-9]*\.[0-9][0-9]*\).*$/\1/'`]
- ;;
-NAG)
- wo_cv_fc_version=[`echo $FC_ID_STRING | sed -e 's/.* Release \([0-9][0-9]*\.[0-9][0-9]*.*$\)/\1/'`]
- ;;
-Intel)
- wo_cv_fc_version=[`echo $FC_ID_STRING | sed -e 's/.* Version \([0-9][0-9]*\.[0-9][0-9]*\) .*/\1/'`]
- ;;
-Sun)
- wo_cv_fc_version=[`echo $FC_ID_STRING | sed -e 's/.* Fortran 95 \([0-9][0-9]*\.[0-9][0-9]*\) .*/\1/'`]
- ;;
-*)
- wo_cv_fc_version="unknown"
- ;;
-esac
-])
-FC_VERSION="$wo_cv_fc_version"
-AC_SUBST([FC_VERSION])
-
-AC_CACHE_CHECK([the major version],
-[wo_cv_fc_major_version],
-[wo_cv_fc_major_version=[`echo $wo_cv_fc_version | sed -e 's/\([0-9][0-9]*\)\..*/\1/'`]
-])
-FC_MAJOR_VERSION="$wo_cv_fc_major_version"
-AC_SUBST([FC_MAJOR_VERSION])
-
-
-# case "$FC_VENDOR" in
-#
-# Intel)
-#
-# if test "$FC_MAJOR_VERSION" -lt 7; then
-# AC_MSG_ERROR([versions before 7.0 of the Intel Fortran compiler dnl
-# are not supported, because they are too old and buggy.])
-# fi
-#
-# if test "$FC_MAJOR_VERSION" -lt 11; then
-# AC_MSG_ERROR([versions before 11.0 of the Intel Fortran compiler dnl
-# do not support F2003 features.])
-# fi
-#
-# THO_FORTRAN_FIND_OPTION([FC_OPT], [$FC], [$FC_EXT], [-O3 -O])
-# THO_FORTRAN_FILTER_OPTIONS([FC_OPT], [$FC], [$FC_EXT], [-u])
-# THO_FORTRAN_FIND_OPTION([FC_PROF], [$FC], [$FC_EXT], [-p])
-#
-# if test "$FC_IFC_VERSION" -ge 8; then
-# FC_MDIR=-module
-# FC_WIDE=-132
-# FC_DUSTY=-FI
-# else
-# FC_MDIR=
-# FC_WIDE=-extend_source
-# FC_DUSTY=-FI
-# fi
-#
-# Lahey)
-# THO_FORTRAN_FILTER_OPTIONS([FC_OPT], [$FC], [$FC_EXT],
-# [-O --tpp --nap --nchk --npca --nsav --ntrace dnl
-# --fc --in --nli --quiet --warn])
-# THO_FORTRAN_FIND_OPTION([FC_PROF], [$FC], [$FC_EXT], [-pg])
-# FC_MDIR=
-# FC_WIDE=--wide
-# FC_DUSTY=--fix
-# ;;
-#
-# NAG)
-# THO_FORTRAN_FIND_OPTION([FC_OPT], [$FC], [$FC_EXT],
-# ["-O3 -Oassumed=contig" -O3 -O])
-# THO_FORTRAN_FIND_OPTION([FC_PROF], [$FC], [$FC_EXT], [-pg])
-# FC_MDIR=-mdir
-# FC_WIDE=-132
-# FC_DUSTY="-dcfuns -fixed"
-# ;;
-#
-# Compaq)
-# THO_FORTRAN_FIND_OPTION([FC_OPT], [$FC], [$FC_EXT], [-O])
-# THO_FORTRAN_FIND_OPTION([FC_PROF], [$FC], [$FC_EXT], [-pg])
-# FC_MDIR=-module
-# FC_WIDE=-132
-# FC_DUSTY=-extend_source
-# ;;
-#
-# Sun)
-# THO_FORTRAN_FIND_OPTION([FC_OPT], [$FC], [$FC_EXT], [-O])
-# THO_FORTRAN_FIND_OPTION([FC_PROF], [$FC], [$FC_EXT], [-pg])
-# FC_MDIR=-moddir=
-# FC_MDIR_NOSPACE=yes
-# FC_WIDE=-e
-# FC_DUSTY=-fixed
-# ;;
-#
-# *)
-# THO_FORTRAN_FIND_OPTION([FC_OPT], [$FC], [$FC_EXT], [-O])
-# THO_FORTRAN_FIND_OPTION([FC_PROF], [$FC], [$FC_EXT], [-pg])
-# FC_MDIR=
-# FC_WIDE=-132
-# FC_DUSTY="-dcfuns -fixed"
-# ;;
-#
-# esac
-
-])
-### end WO_FC_GET_VENDOR_AND_VERSION
-
-### This is for deviations of the FORTRAN naming convention for modules from
-### .mod
-
-WO_FORTRAN90_MODULE_FILE([FC_MODULE_NAME], [FC_MODULE_EXT], [$FC], [$FC_EXT])
-
-AC_SUBST([FC_MAKE_MODULE_NAME])
-case "$FC_MODULE_NAME" in
- module_NAME)
- FC_MAKE_MODULE_NAME='$*.$(FC_MODULE_EXT)'
- ;;
- module_name)
- FC_MAKE_MODULE_NAME='"`echo $* | $(LOWERCASE)`".$(FC_MODULE_EXT)'
- ;;
- MODULE_NAME)
- FC_MAKE_MODULE_NAME='"`echo $* | $(UPPERCASE)`".$(FC_MODULE_EXT)'
- ;;
- conftest)
- FC_MAKE_MODULE_NAME='$*.$(FC_MODULE_EXT)'
- ;;
- *)
- ;;
-esac
-
-### Determine Fortran flags and file extensions
-AC_DEFUN([WO_FC_PARAMETERS],
-[dnl
-AC_REQUIRE([AC_PROG_FC])
-AC_REQUIRE([_LT_COMPILER_PIC])
-AC_LANG([Fortran])
-
-AC_MSG_CHECKING([for $FC flags])
-AC_MSG_RESULT([$FCFLAGS])
-
-AC_MSG_CHECKING([for $FC flag to produce position-independent code])
-AC_MSG_RESULT([$lt_prog_compiler_pic_FC])
-FCFLAGS_PIC=$lt_prog_compiler_pic_FC
-AC_SUBST([FCFLAGS_PIC])
-
-AC_MSG_CHECKING([for $FC source extension])
-AC_MSG_RESULT([$ac_fc_srcext])
-FC_SRC_EXT=$ac_fc_srcext
-AC_SUBST([FC_SRC_EXT])
-
-AC_MSG_CHECKING([for object file extension])
-AC_MSG_RESULT([$ac_objext])
-OBJ_EXT=$ac_objext
-AC_SUBST([OBJ_EXT])
-])
-### end WO_FC_PARAMETERS
-
-
-### Determine runtime libraries
-### The standard check is insufficient for some compilers
-AC_DEFUN([WO_FC_LIBRARY_LDFLAGS],
-[dnl
-AC_REQUIRE([AC_PROG_FC])
-case "$FC" in
-nagfor*)
- WO_NAGFOR_LIBRARY_LDFLAGS()
- ;;
-*)
- AC_FC_LIBRARY_LDFLAGS
- ;;
-esac
-])
-
-### Check the NAG Fortran compiler
-### Use the '-dryrun' feature and extract the libraries from the link command
-### Note that the linker is gcc, not ld
-AC_DEFUN([WO_NAGFOR_LIBRARY_LDFLAGS],
-[dnl
- AC_CACHE_CHECK([Fortran libraries of $FC],
- [wo_cv_fc_libs],
- [dnl
- if test -z "$FCLIBS"; then
- AC_LANG([Fortran])
- AC_LANG_CONFTEST([AC_LANG_PROGRAM([])])
- wo_save_fcflags=$FCFLAGS
- FCFLAGS="-dryrun"
- eval "set x $ac_link"
- echo "set x $ac_link"
- shift
- _AS_ECHO_LOG([$[*]])
- wo_nagfor_output=`eval $ac_link AS_MESSAGE_LOG_FD>&1 2>&1`
- echo "$wo_nagfor_output" >&AS_MESSAGE_LOG_FD
- FCFLAGS=$wo_save_fcflags
- wo_cv_fc_libs=`echo $wo_nagfor_output | sed -e 's/.* -o conftest \(.*\)$/\1/' | sed -e "s/conftest.$ac_objext //"`
- else
- wo_cv_fc_libs=$FCLIBS
- fi
- ])
- FCLIBS=$wo_cv_fc_libs
- AC_SUBST([FCLIBS])
-])
-
-### Check for basic F95 features
-AC_DEFUN([WO_FC_CHECK_F95],
-[dnl
-AC_CACHE_CHECK([whether $FC supports Fortran 95 features],
-[wo_cv_fc_supports_f95],
-[dnl
-AC_REQUIRE([AC_PROG_FC])
-AC_LANG([Fortran])
-AC_COMPILE_IFELSE([dnl
- program conftest
- integer, dimension(2) :: ii
- integer :: i
- type :: foo
- integer, pointer :: bar => null ()
- end type foo
- forall (i = 1:2) ii(i) = i
- contains
- elemental function f(x)
- real, intent(in) :: x
- real :: f
- f = x
- end function f
- pure function g (x) result (gx)
- real, intent(in) :: x
- real :: gx
- gx = x
- end function g
- end program conftest
- ],
- [wo_cv_fc_supports_f95="yes"],
- [wo_cv_fc_supports_f95="no"])
-])
-FC_SUPPORTS_F95="$wo_cv_fc_supports_f95"
-AC_SUBST([FC_SUPPORTS_F95])
-if test "$FC_SUPPORTS_F95" = "no"; then
-AC_MSG_NOTICE([error: ******************************************************************])
-AC_MSG_NOTICE([error: Fortran compiler is not a genuine F95 compiler, configure aborted.])
-AC_MSG_ERROR([******************************************************************])
-fi])
-### end WO_FC_CHECK_F95
-
-### Check for the TR15581 extensions (allocatable subobjects)
-AC_DEFUN([WO_FC_CHECK_TR15581],
-[AC_CACHE_CHECK([whether $FC supports allocatable subobjects],
-[wo_cv_fc_allocatable],
-[dnl
-AC_REQUIRE([AC_PROG_FC])
-AC_LANG([Fortran])
-AC_COMPILE_IFELSE([dnl
- program conftest
- type :: foo
- integer, dimension(:), allocatable :: bar
- end type foo
- end program conftest
- ],
- [wo_cv_fc_allocatable="yes"],
- [wo_cv_fc_allocatable="no"])
-])
-FC_SUPPORTS_ALLOCATABLE="$wo_cv_fc_allocatable"
-AC_SUBST([FC_SUPPORTS_ALLOCATABLE])
-])
-### end WO_FC_CHECK_TR15581
-
-
-### Check for allocatable scalars
-AC_DEFUN([WO_FC_CHECK_ALLOCATABLE_SCALARS],
-[AC_CACHE_CHECK([whether $FC supports allocatable scalars],
-[wo_cv_fc_allocatable_scalars],
-[dnl
-AC_REQUIRE([AC_PROG_FC])
-AC_LANG([Fortran])
-AC_COMPILE_IFELSE([dnl
- program conftest
- type :: foo
- integer, allocatable :: bar
- end type foo
- end program conftest
- ],
- [wo_cv_fc_allocatable_scalars="yes"],
- [wo_cv_fc_allocatable_scalars="no"])
-])
-FC_SUPPORTS_ALLOCATABLE_SCALARS="$wo_cv_fc_allocatable"
-AC_SUBST([FC_SUPPORTS_ALLOCATABLE_SCALARS])
-])
-### end WO_FC_CHECK_ALLOCATABLE_SCALARS
-
-
-### Check for the C bindings extensions of Fortran 2003
-AC_DEFUN([WO_FC_CHECK_C_BINDING],
-[AC_CACHE_CHECK([whether $FC supports ISO C binding and standard numeric types],
-[wo_cv_fc_c_binding],
-[dnl
-AC_REQUIRE([AC_PROG_FC])
-AC_LANG([Fortran])
-AC_COMPILE_IFELSE([dnl
- program conftest
- use iso_c_binding
- type, bind(c) :: t
- integer(c_int) :: i
- real(c_float) :: x1
- real(c_double) :: x2
- complex(c_float_complex) :: z1
- complex(c_double_complex) :: z2
- end type t
- end program conftest
- ],
- [wo_cv_fc_c_binding="yes"],
- [wo_cv_fc_c_binding="no"])
-])
-FC_SUPPORTS_C_BINDING="$wo_cv_fc_c_binding"
-AC_SUBST([FC_SUPPORTS_C_BINDING])
-if test "$FC_SUPPORTS_C_BINDING" = "no"; then
-AC_MSG_NOTICE([error: *******************************************************************])
-AC_MSG_NOTICE([error: Fortran compiler does not support ISO C binding, configure aborted.])
-AC_MSG_ERROR([********************************************************************])
-fi
-])
-### end WO_FC_CHECK_C_BINDING
-
-
-### Check for procedure pointers
-AC_DEFUN([WO_FC_CHECK_PROCEDURE_POINTERS],
-[AC_CACHE_CHECK([whether $FC supports procedure pointers (F2003)],
-[wo_cv_prog_f03_procedure_pointers],
-[dnl
-AC_REQUIRE([AC_PROG_FC])
-AC_LANG([Fortran])
-AC_COMPILE_IFELSE([dnl
- program conftest
- type :: foo
- procedure (proc_template), nopass, pointer :: proc => null ()
- end type foo
- abstract interface
- subroutine proc_template ()
- end subroutine proc_template
- end interface
- end program conftest
- ],
- [wo_cv_prog_f03_procedure_pointers="yes"],
- [wo_cv_prog_f03_procedure_pointers="no"])
-])
-FC_SUPPORTS_PROCEDURE_POINTERS="$wo_cv_prog_f03_procedure_pointers"
-AC_SUBST([FC_SUPPORTS_PROCEDURE_POINTERS])
-if test "$FC_SUPPORTS_PROCEDURE_POINTERS" = "no"; then
-AC_MSG_NOTICE([error: ***************************************************************************])
-AC_MSG_NOTICE([error: Fortran compiler does not understand procedure pointers, configure aborted.])
-AC_MSG_ERROR([***************************************************************************])
-fi])
-### end WO_FC_CHECK_PROCEDURE_POINTERS
-
-
-### Check for the OO extensions of Fortran 2003
-AC_DEFUN([WO_FC_CHECK_OO_FEATURES],
-[AC_CACHE_CHECK([whether $FC supports OO features (F2003)],
-[wo_cv_prog_f03_oo_features],
-[dnl
-AC_REQUIRE([AC_PROG_FC])
-AC_LANG([Fortran])
-AC_COMPILE_IFELSE([dnl
- module conftest
- type, abstract :: foo
- contains
- procedure (proc_template), deferred :: proc
- end type foo
- type, extends (foo) :: foobar
- contains
- procedure :: proc
- end type foobar
- abstract interface
- subroutine proc_template (f)
- import foo
- class(foo), intent(inout) :: f
- end subroutine proc_template
- end interface
- contains
- subroutine proc (f)
- class(foobar), intent(inout) :: f
- end subroutine proc
- end module conftest
- program main
- use conftest
- end program main
- ],
- [wo_cv_prog_f03_oo_features="yes"],
- [wo_cv_prog_f03_oo_features="no"])
-])
-FC_SUPPORTS_OO_FEATURES="$wo_cv_prog_f03_oo_features"
-AC_SUBST([FC_SUPPORTS_OO_FEATURES])
-])
-### end WO_FC_CHECK_OO_FEATURES
-
-
-### Check for the command line interface of Fortran 2003
-### We actually have to link in order to check availability
-AC_DEFUN([WO_FC_CHECK_CMDLINE],
-[AC_CACHE_CHECK([whether $FC interfaces the command line (F2003)],
- [wo_cv_fc_cmdline],
- [dnl
-AC_REQUIRE([AC_PROG_FC])
-AC_LANG([Fortran])
-AC_LINK_IFELSE([dnl
- program conftest
- call get_command_argument (command_argument_count ())
- end program conftest
- ],
- [wo_cv_fc_cmdline="yes"],
- [wo_cv_fc_cmdline="no"])
-])
-FC_SUPPORTS_CMDLINE="$wo_cv_fc_cmdline"
-AC_SUBST([FC_SUPPORTS_CMDLINE])
-])
-### end WO_FC_CHECK_CMDLINE
-
-### Check for wrapping of linker flags
-### (nagfor 'feature': must be wrapped twice)
-AC_DEFUN([WO_FC_CHECK_LDFLAGS_WRAPPING],
-[AC_CACHE_CHECK([for wrapping of linker flags via -Wl],
- [wo_cv_fc_ldflags_wrapping],
- [dnl
-AC_REQUIRE([AC_PROG_FC])
-AC_LANG([Fortran])
-ldflags_tmp=$LDFLAGS
-LDFLAGS=-Wl,-rpath,/usr/lib
-AC_LINK_IFELSE(AC_LANG_PROGRAM(),
- [wo_cv_fc_ldflags_wrapping="once"],
- [wo_cv_fc_ldflags_wrapping="unknown"])
-if test "$wo_cv_fc_ldflags_wrapping" = "unknown"; then
- LDFLAGS=-Wl,-Wl,,-rpath,,/usr/lib
- AC_LINK_IFELSE(AC_LANG_PROGRAM(),
- [wo_cv_fc_ldflags_wrapping="twice"])
-fi
-LDFLAGS=$ldflags_tmp
-])
-FC_LDFLAGS_WRAPPING="$wo_cv_fc_ldflags_wrapping"
-AC_SUBST([FC_LDFLAGS_WRAPPING])
-])
-### end WO_FC_CHECK_LDFLAGS_WRAPPING
-
-### Check for profiling support
-AC_DEFUN([WO_FC_CHECK_PROFILING],
-[AC_CACHE_CHECK([whether $FC supports profiling via -pg],
- [wo_cv_fc_profiling],
- [dnl
-AC_REQUIRE([AC_PROG_FC])
-AC_LANG([Fortran])
-fcflags_tmp=$FCFLAGS
-FCFLAGS="-pg $FCFLAGS"
-rm -f gmon.out
-AC_RUN_IFELSE([dnl
- program conftest
- end program conftest
- ],
- [dnl
- if test -f gmon.out; then
- wo_cv_fc_profiling="yes"
- else
- wo_cv_fc_profiling="no"
- fi],
- [wo_cv_fc_profiling="no"],
- [wo_cv_fc_profiling="maybe [cross-compiling]"])
-rm -f gmon.out
-FCFLAGS=$fcflags_tmp
-])
-FC_SUPPORTS_PROFILING="$wo_cv_fc_profiling"
-AC_SUBST([FC_SUPPORTS_PROFILING])
-])
-### end WO_FC_CHECK_PROFILING
-
-### Enable/disable profiling support
-AC_DEFUN([WO_FC_SET_PROFILING],
-[dnl
-AC_REQUIRE([WO_FC_CHECK_PROFILING])
-AC_ARG_ENABLE([profiling],
- [AS_HELP_STRING([--enable-fc-profiling],
- [use profiling for the Fortran code [[no]]])])
-AC_CACHE_CHECK([the default setting for profiling], [wo_cv_fc_prof],
-[dnl
-if test "$FC_SUPPORTS_PROFILING" = "yes" -a "$profiling" = "yes"; then
- wo_cv_fc_prof="yes"
- FC_PROF="-pg"
-else
- wo_cv_fc_prof="no"
- FC_PROF=""
-fi])
-AC_SUBST(FC_PROF)
-AM_CONDITIONAL([FC_PROF_SET],
- [test -n "$FC_PROF"])
-])
-### end WO_FC_SET_PROFILING
-
-### Enable/disable impure Omega compilation
-AC_DEFUN([WO_FC_SET_OMEGA_IMPURE],
-[dnl
-AC_REQUIRE([WO_FC_CHECK_F95])
-AC_ARG_ENABLE([impure_omega],
- [AS_HELP_STRING([--enable-fc-impure],
- [compile Omega libraries impure [[no]]])])
-AC_CACHE_CHECK([the default setting for impure omegalib], [wo_cv_fc_impure],
-[dnl
-if test "$impure_omega" = "yes" -o "$FC_SUPPORTS_F95" = "no"; then
- wo_cv_fc_impure="yes"
-else
- wo_cv_fc_impure="no"
-fi])
-AM_CONDITIONAL([FC_IMPURE],
- [test "$wo_cv_fc_impure" = "yes"])
-])
-### end WO_FC_OMEGA_IMPURE
-
-### Check for quadruple precision support (real and complex!)
-AC_DEFUN([WO_FC_CHECK_QUADRUPLE],
-[dnl
-AC_CACHE_CHECK([whether $FC permits quadruple real and complex],
- [wo_cv_fc_quadruple],
- [dnl
-AC_REQUIRE([AC_PROG_FC])
-AC_LANG([Fortran])
-AC_COMPILE_IFELSE([dnl
- program conftest
- 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 program conftest
- ],
- [wo_cv_fc_quadruple="yes"],
- [wo_cv_fc_quadruple="no"])
-])
-FC_SUPPORTS_QUADRUPLE="$wo_cv_fc_quadruple"
-AC_SUBST([FC_SUPPORTS_QUADRUPLE])
-])
-### end WO_FC_CHECK_QUADRUPLE
-
-### Check for C quadruple precision support (real and complex!)
-AC_DEFUN([WO_FC_CHECK_QUADRUPLE_C],
-[dnl
-AC_CACHE_CHECK([whether $FC permits quadruple-precision C types],
- [wo_cv_fc_quadruple_c],
- [dnl
-AC_REQUIRE([AC_PROG_FC])
-AC_LANG([Fortran])
-AC_COMPILE_IFELSE([dnl
- program conftest
- use iso_c_binding
- real(c_long_double) :: x
- complex(c_long_double_complex) :: z
- end program conftest
- ],
- [wo_cv_fc_quadruple_c="yes"],
- [wo_cv_fc_quadruple_c="no"])
-])
-FC_SUPPORTS_QUADRUPLE_C="$wo_cv_fc_quadruple_c"
-AC_SUBST([FC_SUPPORTS_QUADRUPLE_C])
-])
-### end WO_FC_CHECK_QUADRUPLE_C
-
-
-### Enable/disable quadruple precision and set default precision
-AC_DEFUN([WO_FC_SET_PRECISION],
-[dnl
-AC_REQUIRE([WO_FC_CHECK_QUADRUPLE])
-AC_ARG_ENABLE([quadruple],
- [AS_HELP_STRING([--enable-fc-quadruple],
- [use quadruple precision in Fortran code [[no]]])])
-if test "$enable_quadruple" = "yes"; then
- FC_QUAD_OR_SINGLE="quadruple"
-else
- FC_QUAD_OR_SINGLE="single"
-fi
-AC_SUBST([FC_QUAD_OR_SINGLE])
-AC_CACHE_CHECK([the default numeric precision], [wo_cv_fc_precision],
-[dnl
-if test "$FC_SUPPORTS_QUADRUPLE" = "yes" \
- -a "$FC_SUPPORTS_QUADRUPLE_C" = "yes" \
- -a "$enable_quadruple" = "yes"; then
- wo_cv_fc_precision="quadruple"
- wo_cv_fc_precision_c="c_long_double"
-else
- wo_cv_fc_precision="double"
- wo_cv_fc_precision_c="c_double"
-fi
-])
-FC_PRECISION="$wo_cv_fc_precision"
-FC_PRECISION_C="$wo_cv_fc_precision_c"
-AC_SUBST(FC_PRECISION)
-AC_SUBST(FC_PRECISION_C)
-AM_CONDITIONAL([FC_QUAD],
- [test "$FC_PRECISION" = "quadruple"])
-])
-### end WO_FC_SET_PRECISION
-
-### filename_case_conversion, define two variables LOWERCASE and
-### UPPERCASE for /bin/sh filters that convert strings to lower
-### and upper case, respectively
-AC_DEFUN([WO_FC_FILENAME_CASE_CONVERSION],
-[dnl
-AC_SUBST([LOWERCASE])
-AC_SUBST([UPPERCASE])
-AC_PATH_PROGS(TR,tr)
-AC_MSG_CHECKING([for case conversion])
-if test -n "$TR"; then
- LOWERCASE="$TR A-Z a-z"
- UPPERCASE="$TR a-z A-Z"
- WO_FC_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/"
- WO_FC_FILENAME_CASE_CONVERSION_TEST
- if test -n "$UPPERCASE" && test -n "$LOWERCASE"; then
- AC_MSG_RESULT([$SED works])
- fi
-fi])
-### end WO_FC_FILE_CASE_CONVERSION
-dnl
-AC_DEFUN([WO_FC_FILENAME_CASE_CONVERSION_TEST],
-[dnl
-if test "`echo fOo | $LOWERCASE`" != "foo"; then
- LOWERCASE=""
-fi
-if test "`echo fOo | $UPPERCASE`" != "FOO"; then
- UPPERCASE=""
-fi])
-
-dnl
-dnl --------------------------------------------------------------------
-dnl
-dnl FC_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([FC_TEST_OPTION],
-[if test -n "$2"; then
- COMPILE_FC([$1], [$2 $4], [$3], [], [$4], [])
-fi])
-
-dnl
-dnl --------------------------------------------------------------------
-dnl
-dnl COMPILE_FC(VARIABLE, COMPILER, EXTENSION, MODULE,
-dnl VALUE_SUCCESS, VALUE_FAILURE, KEEP)
-dnl
-AC_DEFUN([COMPILE_FC],
-[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 -rf conftest* CONFTEST*
-fi])
-
-
-dnl --------------------------------------------------------------------
-dnl
-dnl FC_TEST_EXTENSION(VARIABLE, COMPILER, EXTENSION)
-dnl
-
-AC_DEFUN([FC_TEST_EXTENSION],
-[AC_SUBST([$1])
-if test -n "$2"; then
- COMPILE_FC([$1], [$2], [$3], [], [$3], [])
-fi])
-
-dnl
-dnl --------------------------------------------------------------------
-dnl
-dnl FC_FIND_EXTENSION(VARIABLE, COMPILER, EXTENSIONS)
-dnl
-AC_DEFUN([FC_FIND_EXTENSION],
-[AC_SUBST([$1])
-for ext in $3; do
- AC_MSG_CHECKING([whether $2 supports .$ext])
- FC_TEST_EXTENSION([$1], [$2], [$ext])
- if test -n "[$]$1"; then
- AC_MSG_RESULT([yes]);
- FC_COMPILES="yes"
- break
- else
- AC_MSG_RESULT([no])
- fi
-done
-AC_SUBST([FC_COMPILES])
-if test "$FC_COMPILES" != "yes"; then
-AC_MSG_NOTICE([error: **************************************************************])
-AC_MSG_NOTICE([error: Fortran compiler cannot create executables, configure aborted.])
-AC_MSG_ERROR([**************************************************************])
-fi]
-)
-
-dnl
-dnl
-dnl --------------------------------------------------------------------
-dnl
-dnl FC_FIND_OPTION(VARIABLE, COMPILER, EXTENSION, OPTIONS)
-dnl
-dnl Append the first accepted option from OPTIONS to VARIABLE.
-dnl
-AC_DEFUN([FC_FIND_OPTION],
-[AC_SUBST([$1])
-for option in $4; do
- AC_MSG_CHECKING([whether '$2' accepts $option])
- FC_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 FC_FILTER_OPTIONS(VARIABLE, COMPILER, EXTENSION, OPTIONS)
-dnl
-dnl Append all accepted options from OPTIONS to VARIABLE.
-dnl
-AC_DEFUN([FC_FILTER_OPTIONS],
-[AC_SUBST([$1])
-for option in $4; do
- AC_MSG_CHECKING([whether '$2' accepts $option])
- FC_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 FC_MODULE_FILE(NAME, EXTENSION, COMPILER, EXTENSION)
-dnl
-AC_DEFUN([FC_MODULE_FILE],
-[AC_SUBST([$1])
-AC_SUBST([$2])
-AC_MSG_CHECKING([for Fortran90 module file naming convention])
-COMPILE_FC([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 -rf conftest* CONFTEST* module_name* module_NAME* MODULE_NAME*])
Index: branches/ohl/omega-development/hgg-vertex/m4/ltoptions.m4
===================================================================
--- branches/ohl/omega-development/hgg-vertex/m4/ltoptions.m4 (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/m4/ltoptions.m4 (revision 8717)
@@ -1,368 +0,0 @@
-# Helper functions for option handling. -*- Autoconf -*-
-#
-# Copyright (C) 2004, 2005, 2007, 2008 Free Software Foundation, Inc.
-# Written by Gary V. Vaughan, 2004
-#
-# This file is free software; the Free Software Foundation gives
-# unlimited permission to copy and/or distribute it, with or without
-# modifications, as long as this notice is preserved.
-
-# serial 6 ltoptions.m4
-
-# This is to help aclocal find these macros, as it can't see m4_define.
-AC_DEFUN([LTOPTIONS_VERSION], [m4_if([1])])
-
-
-# _LT_MANGLE_OPTION(MACRO-NAME, OPTION-NAME)
-# ------------------------------------------
-m4_define([_LT_MANGLE_OPTION],
-[[_LT_OPTION_]m4_bpatsubst($1__$2, [[^a-zA-Z0-9_]], [_])])
-
-
-# _LT_SET_OPTION(MACRO-NAME, OPTION-NAME)
-# ---------------------------------------
-# Set option OPTION-NAME for macro MACRO-NAME, and if there is a
-# matching handler defined, dispatch to it. Other OPTION-NAMEs are
-# saved as a flag.
-m4_define([_LT_SET_OPTION],
-[m4_define(_LT_MANGLE_OPTION([$1], [$2]))dnl
-m4_ifdef(_LT_MANGLE_DEFUN([$1], [$2]),
- _LT_MANGLE_DEFUN([$1], [$2]),
- [m4_warning([Unknown $1 option `$2'])])[]dnl
-])
-
-
-# _LT_IF_OPTION(MACRO-NAME, OPTION-NAME, IF-SET, [IF-NOT-SET])
-# ------------------------------------------------------------
-# Execute IF-SET if OPTION is set, IF-NOT-SET otherwise.
-m4_define([_LT_IF_OPTION],
-[m4_ifdef(_LT_MANGLE_OPTION([$1], [$2]), [$3], [$4])])
-
-
-# _LT_UNLESS_OPTIONS(MACRO-NAME, OPTION-LIST, IF-NOT-SET)
-# -------------------------------------------------------
-# Execute IF-NOT-SET unless all options in OPTION-LIST for MACRO-NAME
-# are set.
-m4_define([_LT_UNLESS_OPTIONS],
-[m4_foreach([_LT_Option], m4_split(m4_normalize([$2])),
- [m4_ifdef(_LT_MANGLE_OPTION([$1], _LT_Option),
- [m4_define([$0_found])])])[]dnl
-m4_ifdef([$0_found], [m4_undefine([$0_found])], [$3
-])[]dnl
-])
-
-
-# _LT_SET_OPTIONS(MACRO-NAME, OPTION-LIST)
-# ----------------------------------------
-# OPTION-LIST is a space-separated list of Libtool options associated
-# with MACRO-NAME. If any OPTION has a matching handler declared with
-# LT_OPTION_DEFINE, dispatch to that macro; otherwise complain about
-# the unknown option and exit.
-m4_defun([_LT_SET_OPTIONS],
-[# Set options
-m4_foreach([_LT_Option], m4_split(m4_normalize([$2])),
- [_LT_SET_OPTION([$1], _LT_Option)])
-
-m4_if([$1],[LT_INIT],[
- dnl
- dnl Simply set some default values (i.e off) if boolean options were not
- dnl specified:
- _LT_UNLESS_OPTIONS([LT_INIT], [dlopen], [enable_dlopen=no
- ])
- _LT_UNLESS_OPTIONS([LT_INIT], [win32-dll], [enable_win32_dll=no
- ])
- dnl
- dnl If no reference was made to various pairs of opposing options, then
- dnl we run the default mode handler for the pair. For example, if neither
- dnl `shared' nor `disable-shared' was passed, we enable building of shared
- dnl archives by default:
- _LT_UNLESS_OPTIONS([LT_INIT], [shared disable-shared], [_LT_ENABLE_SHARED])
- _LT_UNLESS_OPTIONS([LT_INIT], [static disable-static], [_LT_ENABLE_STATIC])
- _LT_UNLESS_OPTIONS([LT_INIT], [pic-only no-pic], [_LT_WITH_PIC])
- _LT_UNLESS_OPTIONS([LT_INIT], [fast-install disable-fast-install],
- [_LT_ENABLE_FAST_INSTALL])
- ])
-])# _LT_SET_OPTIONS
-
-
-## --------------------------------- ##
-## Macros to handle LT_INIT options. ##
-## --------------------------------- ##
-
-# _LT_MANGLE_DEFUN(MACRO-NAME, OPTION-NAME)
-# -----------------------------------------
-m4_define([_LT_MANGLE_DEFUN],
-[[_LT_OPTION_DEFUN_]m4_bpatsubst(m4_toupper([$1__$2]), [[^A-Z0-9_]], [_])])
-
-
-# LT_OPTION_DEFINE(MACRO-NAME, OPTION-NAME, CODE)
-# -----------------------------------------------
-m4_define([LT_OPTION_DEFINE],
-[m4_define(_LT_MANGLE_DEFUN([$1], [$2]), [$3])[]dnl
-])# LT_OPTION_DEFINE
-
-
-# dlopen
-# ------
-LT_OPTION_DEFINE([LT_INIT], [dlopen], [enable_dlopen=yes
-])
-
-AU_DEFUN([AC_LIBTOOL_DLOPEN],
-[_LT_SET_OPTION([LT_INIT], [dlopen])
-AC_DIAGNOSE([obsolete],
-[$0: Remove this warning and the call to _LT_SET_OPTION when you
-put the `dlopen' option into LT_INIT's first parameter.])
-])
-
-dnl aclocal-1.4 backwards compatibility:
-dnl AC_DEFUN([AC_LIBTOOL_DLOPEN], [])
-
-
-# win32-dll
-# ---------
-# Declare package support for building win32 dll's.
-LT_OPTION_DEFINE([LT_INIT], [win32-dll],
-[enable_win32_dll=yes
-
-case $host in
-*-*-cygwin* | *-*-mingw* | *-*-pw32* | *-cegcc*)
- AC_CHECK_TOOL(AS, as, false)
- AC_CHECK_TOOL(DLLTOOL, dlltool, false)
- AC_CHECK_TOOL(OBJDUMP, objdump, false)
- ;;
-esac
-
-test -z "$AS" && AS=as
-_LT_DECL([], [AS], [0], [Assembler program])dnl
-
-test -z "$DLLTOOL" && DLLTOOL=dlltool
-_LT_DECL([], [DLLTOOL], [0], [DLL creation program])dnl
-
-test -z "$OBJDUMP" && OBJDUMP=objdump
-_LT_DECL([], [OBJDUMP], [0], [Object dumper program])dnl
-])# win32-dll
-
-AU_DEFUN([AC_LIBTOOL_WIN32_DLL],
-[AC_REQUIRE([AC_CANONICAL_HOST])dnl
-_LT_SET_OPTION([LT_INIT], [win32-dll])
-AC_DIAGNOSE([obsolete],
-[$0: Remove this warning and the call to _LT_SET_OPTION when you
-put the `win32-dll' option into LT_INIT's first parameter.])
-])
-
-dnl aclocal-1.4 backwards compatibility:
-dnl AC_DEFUN([AC_LIBTOOL_WIN32_DLL], [])
-
-
-# _LT_ENABLE_SHARED([DEFAULT])
-# ----------------------------
-# implement the --enable-shared flag, and supports the `shared' and
-# `disable-shared' LT_INIT options.
-# DEFAULT is either `yes' or `no'. If omitted, it defaults to `yes'.
-m4_define([_LT_ENABLE_SHARED],
-[m4_define([_LT_ENABLE_SHARED_DEFAULT], [m4_if($1, no, no, yes)])dnl
-AC_ARG_ENABLE([shared],
- [AS_HELP_STRING([--enable-shared@<:@=PKGS@:>@],
- [build shared libraries @<:@default=]_LT_ENABLE_SHARED_DEFAULT[@:>@])],
- [p=${PACKAGE-default}
- case $enableval in
- yes) enable_shared=yes ;;
- no) enable_shared=no ;;
- *)
- enable_shared=no
- # Look at the argument we got. We use all the common list separators.
- lt_save_ifs="$IFS"; IFS="${IFS}$PATH_SEPARATOR,"
- for pkg in $enableval; do
- IFS="$lt_save_ifs"
- if test "X$pkg" = "X$p"; then
- enable_shared=yes
- fi
- done
- IFS="$lt_save_ifs"
- ;;
- esac],
- [enable_shared=]_LT_ENABLE_SHARED_DEFAULT)
-
- _LT_DECL([build_libtool_libs], [enable_shared], [0],
- [Whether or not to build shared libraries])
-])# _LT_ENABLE_SHARED
-
-LT_OPTION_DEFINE([LT_INIT], [shared], [_LT_ENABLE_SHARED([yes])])
-LT_OPTION_DEFINE([LT_INIT], [disable-shared], [_LT_ENABLE_SHARED([no])])
-
-# Old names:
-AC_DEFUN([AC_ENABLE_SHARED],
-[_LT_SET_OPTION([LT_INIT], m4_if([$1], [no], [disable-])[shared])
-])
-
-AC_DEFUN([AC_DISABLE_SHARED],
-[_LT_SET_OPTION([LT_INIT], [disable-shared])
-])
-
-AU_DEFUN([AM_ENABLE_SHARED], [AC_ENABLE_SHARED($@)])
-AU_DEFUN([AM_DISABLE_SHARED], [AC_DISABLE_SHARED($@)])
-
-dnl aclocal-1.4 backwards compatibility:
-dnl AC_DEFUN([AM_ENABLE_SHARED], [])
-dnl AC_DEFUN([AM_DISABLE_SHARED], [])
-
-
-
-# _LT_ENABLE_STATIC([DEFAULT])
-# ----------------------------
-# implement the --enable-static flag, and support the `static' and
-# `disable-static' LT_INIT options.
-# DEFAULT is either `yes' or `no'. If omitted, it defaults to `yes'.
-m4_define([_LT_ENABLE_STATIC],
-[m4_define([_LT_ENABLE_STATIC_DEFAULT], [m4_if($1, no, no, yes)])dnl
-AC_ARG_ENABLE([static],
- [AS_HELP_STRING([--enable-static@<:@=PKGS@:>@],
- [build static libraries @<:@default=]_LT_ENABLE_STATIC_DEFAULT[@:>@])],
- [p=${PACKAGE-default}
- case $enableval in
- yes) enable_static=yes ;;
- no) enable_static=no ;;
- *)
- enable_static=no
- # Look at the argument we got. We use all the common list separators.
- lt_save_ifs="$IFS"; IFS="${IFS}$PATH_SEPARATOR,"
- for pkg in $enableval; do
- IFS="$lt_save_ifs"
- if test "X$pkg" = "X$p"; then
- enable_static=yes
- fi
- done
- IFS="$lt_save_ifs"
- ;;
- esac],
- [enable_static=]_LT_ENABLE_STATIC_DEFAULT)
-
- _LT_DECL([build_old_libs], [enable_static], [0],
- [Whether or not to build static libraries])
-])# _LT_ENABLE_STATIC
-
-LT_OPTION_DEFINE([LT_INIT], [static], [_LT_ENABLE_STATIC([yes])])
-LT_OPTION_DEFINE([LT_INIT], [disable-static], [_LT_ENABLE_STATIC([no])])
-
-# Old names:
-AC_DEFUN([AC_ENABLE_STATIC],
-[_LT_SET_OPTION([LT_INIT], m4_if([$1], [no], [disable-])[static])
-])
-
-AC_DEFUN([AC_DISABLE_STATIC],
-[_LT_SET_OPTION([LT_INIT], [disable-static])
-])
-
-AU_DEFUN([AM_ENABLE_STATIC], [AC_ENABLE_STATIC($@)])
-AU_DEFUN([AM_DISABLE_STATIC], [AC_DISABLE_STATIC($@)])
-
-dnl aclocal-1.4 backwards compatibility:
-dnl AC_DEFUN([AM_ENABLE_STATIC], [])
-dnl AC_DEFUN([AM_DISABLE_STATIC], [])
-
-
-
-# _LT_ENABLE_FAST_INSTALL([DEFAULT])
-# ----------------------------------
-# implement the --enable-fast-install flag, and support the `fast-install'
-# and `disable-fast-install' LT_INIT options.
-# DEFAULT is either `yes' or `no'. If omitted, it defaults to `yes'.
-m4_define([_LT_ENABLE_FAST_INSTALL],
-[m4_define([_LT_ENABLE_FAST_INSTALL_DEFAULT], [m4_if($1, no, no, yes)])dnl
-AC_ARG_ENABLE([fast-install],
- [AS_HELP_STRING([--enable-fast-install@<:@=PKGS@:>@],
- [optimize for fast installation @<:@default=]_LT_ENABLE_FAST_INSTALL_DEFAULT[@:>@])],
- [p=${PACKAGE-default}
- case $enableval in
- yes) enable_fast_install=yes ;;
- no) enable_fast_install=no ;;
- *)
- enable_fast_install=no
- # Look at the argument we got. We use all the common list separators.
- lt_save_ifs="$IFS"; IFS="${IFS}$PATH_SEPARATOR,"
- for pkg in $enableval; do
- IFS="$lt_save_ifs"
- if test "X$pkg" = "X$p"; then
- enable_fast_install=yes
- fi
- done
- IFS="$lt_save_ifs"
- ;;
- esac],
- [enable_fast_install=]_LT_ENABLE_FAST_INSTALL_DEFAULT)
-
-_LT_DECL([fast_install], [enable_fast_install], [0],
- [Whether or not to optimize for fast installation])dnl
-])# _LT_ENABLE_FAST_INSTALL
-
-LT_OPTION_DEFINE([LT_INIT], [fast-install], [_LT_ENABLE_FAST_INSTALL([yes])])
-LT_OPTION_DEFINE([LT_INIT], [disable-fast-install], [_LT_ENABLE_FAST_INSTALL([no])])
-
-# Old names:
-AU_DEFUN([AC_ENABLE_FAST_INSTALL],
-[_LT_SET_OPTION([LT_INIT], m4_if([$1], [no], [disable-])[fast-install])
-AC_DIAGNOSE([obsolete],
-[$0: Remove this warning and the call to _LT_SET_OPTION when you put
-the `fast-install' option into LT_INIT's first parameter.])
-])
-
-AU_DEFUN([AC_DISABLE_FAST_INSTALL],
-[_LT_SET_OPTION([LT_INIT], [disable-fast-install])
-AC_DIAGNOSE([obsolete],
-[$0: Remove this warning and the call to _LT_SET_OPTION when you put
-the `disable-fast-install' option into LT_INIT's first parameter.])
-])
-
-dnl aclocal-1.4 backwards compatibility:
-dnl AC_DEFUN([AC_ENABLE_FAST_INSTALL], [])
-dnl AC_DEFUN([AM_DISABLE_FAST_INSTALL], [])
-
-
-# _LT_WITH_PIC([MODE])
-# --------------------
-# implement the --with-pic flag, and support the `pic-only' and `no-pic'
-# LT_INIT options.
-# MODE is either `yes' or `no'. If omitted, it defaults to `both'.
-m4_define([_LT_WITH_PIC],
-[AC_ARG_WITH([pic],
- [AS_HELP_STRING([--with-pic],
- [try to use only PIC/non-PIC objects @<:@default=use both@:>@])],
- [pic_mode="$withval"],
- [pic_mode=default])
-
-test -z "$pic_mode" && pic_mode=m4_default([$1], [default])
-
-_LT_DECL([], [pic_mode], [0], [What type of objects to build])dnl
-])# _LT_WITH_PIC
-
-LT_OPTION_DEFINE([LT_INIT], [pic-only], [_LT_WITH_PIC([yes])])
-LT_OPTION_DEFINE([LT_INIT], [no-pic], [_LT_WITH_PIC([no])])
-
-# Old name:
-AU_DEFUN([AC_LIBTOOL_PICMODE],
-[_LT_SET_OPTION([LT_INIT], [pic-only])
-AC_DIAGNOSE([obsolete],
-[$0: Remove this warning and the call to _LT_SET_OPTION when you
-put the `pic-only' option into LT_INIT's first parameter.])
-])
-
-dnl aclocal-1.4 backwards compatibility:
-dnl AC_DEFUN([AC_LIBTOOL_PICMODE], [])
-
-## ----------------- ##
-## LTDL_INIT Options ##
-## ----------------- ##
-
-m4_define([_LTDL_MODE], [])
-LT_OPTION_DEFINE([LTDL_INIT], [nonrecursive],
- [m4_define([_LTDL_MODE], [nonrecursive])])
-LT_OPTION_DEFINE([LTDL_INIT], [recursive],
- [m4_define([_LTDL_MODE], [recursive])])
-LT_OPTION_DEFINE([LTDL_INIT], [subproject],
- [m4_define([_LTDL_MODE], [subproject])])
-
-m4_define([_LTDL_TYPE], [])
-LT_OPTION_DEFINE([LTDL_INIT], [installable],
- [m4_define([_LTDL_TYPE], [installable])])
-LT_OPTION_DEFINE([LTDL_INIT], [convenience],
- [m4_define([_LTDL_TYPE], [convenience])])
Index: branches/ohl/omega-development/hgg-vertex/m4/ocaml.m4
===================================================================
--- branches/ohl/omega-development/hgg-vertex/m4/ocaml.m4 (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/m4/ocaml.m4 (revision 8717)
@@ -1,315 +0,0 @@
-dnl autoconf macros for OCaml
-dnl
-dnl JR added check for ocaml binary
-dnl JR added check for ocamlcp
-dnl JR added check for ocamlweb
-dnl JR added routine for lablgtk
-dnl JR added check for ocaml version
-dnl
-dnl Copyright © 2009 Richard W.M. Jones
-dnl Copyright © 2009 Stefano Zacchiroli
-dnl Copyright © 2000-2005 Olivier Andrieu
-dnl Copyright © 2000-2005 Jean-Christophe Filliâtre
-dnl Copyright © 2000-2005 Georges Mariano
-dnl
-dnl For documentation, please read the ocaml.m4 man page.
-
-AC_DEFUN([AC_PROG_OCAML],
-[dnl
-AC_ARG_ENABLE([ocaml],
- [AC_HELP_STRING([--disable-ocaml],
- [disable the OCaml parts, even if OCaml available [[no]]])])
- if test "$enable_ocaml" != "no"; then
- # checking for ocamlc
- AC_CHECK_TOOL([OCAML], [ocaml], [])
- AC_CHECK_TOOL([OCAMLC],[ocamlc],[no])
-
- if test "$OCAMLC" != "no"; then
- OCAMLVERSION=`$OCAMLC -v | sed -n -e 's|.*version* *\(.*\)$|\1|p'`
- #####
- # JR inserted this ocamlintegerversion for version checking
- #####
- AC_CACHE_VAL([wo_ocaml_cv_integer_version],
- [wo_ocaml_cv_integer_version="`$OCAMLC -v | \
- $AWK 'NR==1 && [$]5 ~ /version/ {
- changequote(<<,>>)dnl
- split (<<$>>6, version, "[.+]+");
- printf ("%d%02d%03d", version[1], version[2], version[3])}'`"
- changequote([,])])
- OCAMLINTEGERVERSION=$wo_ocaml_cv_integer_version
- #####
- AC_MSG_RESULT([OCaml version is $OCAMLVERSION])
- OCAMLLIB=`$OCAMLC -where 2>/dev/null || $OCAMLC -v|tail -1|cut -d ' ' -f 4`
- AC_MSG_RESULT([OCaml library path is $OCAMLLIB])
-
-
- AC_SUBST([OCAMLVERSION])
- AC_SUBST([OCAMLINTEGERVERSION])
- AC_SUBST([OCAMLLIB])
-
- AM_CONDITIONAL([OCAML_304],
- [test $OCAMLINTEGERVERSION -ge 304000])
-
- # checking for ocamlopt
- AC_CHECK_TOOL([OCAMLOPT],[ocamlopt],[no])
- OCAMLBEST=byte
- if test "$OCAMLOPT" = "no"; then
- AC_MSG_WARN([Cannot find ocamlopt; bytecode compilation only.])
- else
- TMPVERSION=`$OCAMLOPT -v | sed -n -e 's|.*version* *\(.*\)$|\1|p' `
- if test "$TMPVERSION" != "$OCAMLVERSION" ; then
- AC_MSG_RESULT([versions differs from ocamlc; ocamlopt discarded.])
- OCAMLOPT=no
- else
- OCAMLBEST=opt
- fi
- fi
-
- AC_SUBST([OCAMLBEST])
-
- # checking for ocamlc.opt
- AC_CHECK_TOOL([OCAMLCDOTOPT],[ocamlc.opt],[no])
- if test "$OCAMLCDOTOPT" != "no"; then
- TMPVERSION=`$OCAMLCDOTOPT -v | sed -n -e 's|.*version* *\(.*\)$|\1|p' `
- if test "$TMPVERSION" != "$OCAMLVERSION" ; then
- AC_MSG_RESULT([versions differs from ocamlc; ocamlc.opt discarded.])
- else
- OCAMLC=$OCAMLCDOTOPT
- fi
- fi
-
- # checking for ocamlopt.opt
- if test "$OCAMLOPT" != "no" ; then
- AC_CHECK_TOOL([OCAMLOPTDOTOPT],[ocamlopt.opt],[no])
- if test "$OCAMLOPTDOTOPT" != "no"; then
- TMPVERSION=`$OCAMLOPTDOTOPT -v | sed -n -e 's|.*version* *\(.*\)$|\1|p' `
- if test "$TMPVERSION" != "$OCAMLVERSION" ; then
- AC_MSG_RESULT([version differs from ocamlc; ocamlopt.opt discarded.])
- else
- OCAMLOPT=$OCAMLOPTDOTOPT
- fi
- fi
- fi
-
- AC_SUBST([OCAMLOPT])
- fi
-
- AC_SUBST([OCAMLC])
-
- # checking for ocamldep
- AC_CHECK_TOOL([OCAMLDEP],[ocamldep],[no])
-
- # checking for ocamlmktop
- AC_CHECK_TOOL([OCAMLMKTOP],[ocamlmktop],[no])
-
- # checking for ocamlmklib
- AC_CHECK_TOOL([OCAMLMKLIB],[ocamlmklib],[no])
-
- # checking for ocamldoc
- AC_CHECK_TOOL([OCAMLDOC],[ocamldoc],[no])
-
- # checking for ocamlbuild
- AC_CHECK_TOOL([OCAMLBUILD],[ocamlbuild],[no])
- else
- AM_CONDITIONAL([OCAML_304], false)
- fi
- AM_CONDITIONAL([OCAML_AVAILABLE],
- [test "$enable_ocaml" != "no"])
-])
-])
-
-
-AC_DEFUN([AC_PROG_OCAMLLEX],
-[dnl
- # checking for ocamllex
- AC_CHECK_TOOL([OCAMLLEX],[ocamllex],[no])
- if test "$OCAMLLEX" != "no"; then
- AC_CHECK_TOOL([OCAMLLEXDOTOPT],[ocamllex.opt],[no])
- if test "$OCAMLLEXDOTOPT" != "no"; then
- OCAMLLEX=$OCAMLLEXDOTOPT
- fi
- fi
- AC_SUBST([OCAMLLEX])
-])
-
-AC_DEFUN([AC_PROG_OCAMLYACC],
-[dnl
- AC_CHECK_TOOL([OCAMLYACC],[ocamlyacc],[no])
- AC_SUBST([OCAMLYACC])
-])
-
-AC_DEFUN([AC_PROG_OCAMLCP],
-[dnl
- AC_CHECK_TOOL([OCAMLCP],[ocamlcp],[no])
- AC_SUBST([OCAMLCP])
-])
-
-AC_DEFUN([AC_PROG_CAMLP4],
-[dnl
- AC_REQUIRE([AC_PROG_OCAML])dnl
-
- # checking for camlp4
- AC_CHECK_TOOL([CAMLP4],[camlp4],[no])
- if test "$CAMLP4" != "no"; then
- TMPVERSION=`$CAMLP4 -v 2>&1| sed -n -e 's|.*version *\(.*\)$|\1|p'`
- if test "$TMPVERSION" != "$OCAMLVERSION" ; then
- AC_MSG_RESULT([versions differs from ocamlc])
- CAMLP4=no
- fi
- fi
- AC_SUBST([CAMLP4])
-
- # checking for companion tools
- AC_CHECK_TOOL([CAMLP4BOOT],[camlp4boot],[no])
- AC_CHECK_TOOL([CAMLP4O],[camlp4o],[no])
- AC_CHECK_TOOL([CAMLP4OF],[camlp4of],[no])
- AC_CHECK_TOOL([CAMLP4OOF],[camlp4oof],[no])
- AC_CHECK_TOOL([CAMLP4ORF],[camlp4orf],[no])
- AC_CHECK_TOOL([CAMLP4PROF],[camlp4prof],[no])
- AC_CHECK_TOOL([CAMLP4R],[camlp4r],[no])
- AC_CHECK_TOOL([CAMLP4RF],[camlp4rf],[no])
- AC_SUBST([CAMLP4BOOT])
- AC_SUBST([CAMLP4O])
- AC_SUBST([CAMLP4OF])
- AC_SUBST([CAMLP4OOF])
- AC_SUBST([CAMLP4ORF])
- AC_SUBST([CAMLP4PROF])
- AC_SUBST([CAMLP4R])
- AC_SUBST([CAMLP4RF])
-])
-
-
-AC_DEFUN([AC_PROG_FINDLIB],
-[dnl
- AC_REQUIRE([AC_PROG_OCAML])dnl
-
- # checking for ocamlfind
- AC_CHECK_TOOL([OCAMLFIND],[ocamlfind],[no])
- AC_SUBST([OCAMLFIND])
-])
-
-
-dnl Thanks to Jim Meyering for working this next bit out for us.
-dnl XXX We should define AS_TR_SH if it's not defined already
-dnl (eg. for old autoconf).
-AC_DEFUN([AC_CHECK_OCAML_PKG],
-[dnl
- AC_REQUIRE([AC_PROG_FINDLIB])dnl
-
- AC_MSG_CHECKING([for OCaml findlib package $1])
-
- unset found
- unset pkg
- found=no
- for pkg in $1 $2 ; do
- if $OCAMLFIND query $pkg >/dev/null 2>/dev/null; then
- AC_MSG_RESULT([found])
- AS_TR_SH([OCAML_PKG_$1])=$pkg
- found=yes
- break
- fi
- done
- if test "$found" = "no" ; then
- AC_MSG_RESULT([not found])
- AS_TR_SH([OCAML_PKG_$1])=no
- fi
-
- AC_SUBST(AS_TR_SH([OCAML_PKG_$1]))
-])
-
-
-AC_DEFUN([AC_CHECK_OCAML_MODULE],
-[dnl
- AC_MSG_CHECKING([for OCaml module $2])
-
- cat > conftest.ml <<EOF
-open $3
-EOF
- unset found
- for $1 in $$1 $4 ; do
- if $OCAMLC -c -I "$$1" conftest.ml >&5 2>&5 ; then
- found=yes
- break
- fi
- done
-
- if test "$found" ; then
- AC_MSG_RESULT([$$1])
- else
- AC_MSG_RESULT([not found])
- $1=no
- fi
- AC_SUBST([$1])
-])
-
-
-dnl XXX Cross-compiling
-AC_DEFUN([AC_CHECK_OCAML_WORD_SIZE],
-[dnl
- AC_MSG_CHECKING([for OCaml compiler word size])
- cat > conftest.ml <<EOF
- print_endline (string_of_int Sys.word_size)
- EOF
- OCAML_WORD_SIZE=`ocaml conftest.ml`
- AC_MSG_RESULT([$OCAML_WORD_SIZE])
- AC_SUBST([OCAML_WORD_SIZE])
-])
-
-dnl Check for ocamlweb
-AC_DEFUN([AC_PROG_OCAMLWEB],
-[dnl
- AC_CHECK_TOOL([OCAMLWEB],[ocamlweb],[no])
- AC_SUBST([OCAMLWEB])
- if test "$OCAMLWEB" != "no"; then
- OCAMLWEBVERSION=`$OCAMLWEB --version | sed -n -e 's|.*version* *\(.*\)$|\1|p'`
- AC_CACHE_VAL([wo_ocamlweb_cv_integer_version],
- [wo_ocamlweb_cv_integer_version="`$OCAMLWEB --version | \
- $AWK 'NR==1 && [$]5 ~ /version/ {
- changequote(<<,>>)dnl
- split (<<$>>6, version, "[.+]+");
- printf ("%d%02d%03d", version[1], version[2], version[3])}'`"
- changequote([,])])
- OCAMLWEBINTEGERVERSION=$wo_ocamlweb_cv_integer_version
- if test "$OCAMLINTEGERVERSION" -ge "$1"; then
- AC_MSG_RESULT([OCamlweb version is $OCAMLWEBVERSION: ok])
- else
- AC_MSG_RESULT([OCamlweb version is $OCAMLWEBVERSION: too old])
- OCAMLWEB=no
- fi
- fi
- AC_SUBST([OCAMLWEB])
- AC_SUBST([OCAMLWEBVERSION])
- AM_CONDITIONAL([OCAMLWEB_AVAILABLE],[test "$OCAMLWEB" != "no"])
-])
-
-dnl
-dnl --------------------------------------------------------------------
-dnl
-AC_DEFUN([AC_PROG_OCAML_LABLGTK],
-[AC_REQUIRE([AC_PROG_OCAML])
-AC_SUBST(LABLGTKDIR)
-LABLGTKDIR=$OCAMLLIB
-AC_MSG_CHECKING([for OCaml/GTK+ toolkit directory])
-if test -f $LABLGTKDIR/lablgtk.cma; then
- AC_MSG_RESULT([$LABLGTKDIR])
-else
- LABLGTKDIR=$OCAMLLIB/lablgtk
- if test -f $LABLGTKDIR/lablgtk.cma; then
- AC_MSG_RESULT([$LABLGTKDIR])
- else
- AC_MSG_RESULT([not found])
- fi
-fi])
-
-dnl
-dnl --------------------------------------------------------------------
-dnl
-AC_DEFUN([AC_OCAML_VERSION_CHECK],
-[AC_REQUIRE([AC_PROG_OCAML])
-AC_MSG_CHECKING([for OCaml version $1])
-if test $OCAMLINTEGERVERSION -ge "$1"; then
- AC_MSG_RESULT([ok])
-else
- AC_MSG_ERROR([found version $OCAMLVERSION, too old!])
-fi])
-
Index: branches/ohl/omega-development/hgg-vertex/m4/latex.m4
===================================================================
--- branches/ohl/omega-development/hgg-vertex/m4/latex.m4 (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/m4/latex.m4 (revision 8717)
@@ -1,157 +0,0 @@
-dnl latex.m4 -- checks for LaTeX programs
-dnl
-
-AC_DEFUN([AC_PROG_TEX], [dnl
-AC_CHECK_PROGS(PLAINTEX,[tex],no)
-AM_CONDITIONAL([TEX_AVAILABLE], [test "$PLAINTEX" != "no"])
-AC_SUBST(PLAINTEX)
-])
-
-AC_DEFUN([AC_PROG_LATEX], [dnl
-AC_CHECK_PROGS(LATEX,[latex elatex lambda],no)
-AM_CONDITIONAL([LATEX_AVAILABLE], [test "$LATEX" != "no"])
-AC_SUBST(LATEX)
-])
-
-
-AC_DEFUN([_AC_LATEX_TEST], [dnl
-AC_REQUIRE([AC_PROG_LATEX])
-rm -rf .tmps_latex
-mkdir .tmps_latex
-cd .tmps_latex
-ifelse($#,2,[
-$2="no"; export $2;
-cat &gt; testconf.tex &lt;&lt; \EOF
-$1
-EOF
-],$#,3,[
-echo "\\documentclass{$3}" &gt; testconf.tex
-cat &gt;&gt; testconf.tex &lt;&lt; \EOF
-$1
-EOF
-],$#,4,[
-echo "\\documentclass{$3}" &gt; testconf.tex
-echo "\\usepackage{$4}" &gt; testconf.tex
-cat &gt;&gt; testconf.tex &lt;&lt; \EOF
-$1
-])
-cat testconf.tex | $latex 2&gt;&amp;1 1&gt;/dev/null &amp;&amp; $2=yes; export $2;
-cd ..
-rm -rf .tmps_latex
-])
-
-dnl AC_LATEX_CLASSES([book],book)
-dnl should set $book="yes"
-dnl
-dnl AC_LATEX_CLASSES(allo,book)
-dnl should set $book="no"
-
-
-AC_DEFUN([AC_LATEX_CLASS], [dnl
-AC_CACHE_CHECK([for class $1],[ac_cv_latex_class_]translit($1,[-],[_]),[
-_AC_LATEX_TEST([
-\begin{document}
-\end{document}
-],[ac_cv_latex_class_]translit($1,[-],[_]),$1)
-])
-$2=$[ac_cv_latex_class_]translit($1,[-],[_]) ; export $2;
-AC_SUBST($2)
-])
-
-dnl Checking for dvips
-
-AC_DEFUN([AC_PROG_DVIPS], [dnl
-AC_CHECK_PROGS(DVIPS,dvips,no)
-AM_CONDITIONAL([DVIPS_AVAILABLE], [test "$DVIPS" != "no"])
-AC_SUBST(DVIPS)
-])
-
-
-dnl Checking for ps2pdf and friends
-
-AC_DEFUN([AC_PROG_PS2PDF], [dnl
-AC_CHECK_PROGS(PS2PDF,[ps2pdf14 ps2pdf13 ps2pdf12 ps2pdf],no)
-AM_CONDITIONAL([PS2PDF_AVAILABLE], [test "$PS2PDF" != "no"])
-AC_SUBST(PS2PDF)
-])
-
-dnl Checking for epstopdf
-
-AC_DEFUN([AC_PROG_EPSTOPDF], [dnl
-AC_CHECK_PROGS(EPSTOPDF,[epstopdf],no)
-AM_CONDITIONAL([EPSTOPDF_AVAILABLE], [test "$EPSTOPDF" != "no"])
-AC_SUBST(EPSTOPDF)
-])
-
-
-dnl Checking for supp-pdf.tex (auxiliary for PDF output)
-
-AC_DEFUN([AC_PROG_SUPP_PDF], [dnl
-AC_REQUIRE([AC_PROG_TEX])
-AC_CACHE_CHECK([for supp-pdf.tex],
-[wo_cv_supp_pdf_exists],
-[dnl
-wo_cv_supp_pdf_exists="no"
-if test "$PLAINTEX" != "no"; then
- wo_cmd='echo \\input supp-pdf.tex \\end > conftest.tex'
- eval "$wo_cmd"
- wo_cmd='$PLAINTEX conftest.tex >&5'
- (eval "$wo_cmd") 2>&5 && wo_cv_supp_pdf_exists="yes"
-fi])
-AM_CONDITIONAL([SUPP_PDF_AVAILABLE], [test "$wo_cv_supp_pdf_exists" != "no"])
-])
-
-dnl Checking for pdflatex
-
-AC_DEFUN([AC_PROG_PDFLATEX], [dnl
-AC_CHECK_PROGS(PDFLATEX,[pdflatex],no)
-AM_CONDITIONAL([PDFLATEX_AVAILABLE], [test "$PDFLATEX" != "no"])
-AC_SUBST(PDFLATEX)
-])
-
-dnl Checking for Metapost
-
-AC_DEFUN([AC_PROG_MPOST], [dnl
-AC_CHECK_PROGS(MPOST,[mpost metapost],no)
-AM_CONDITIONAL([MPOST_AVAILABLE], [test "$MPOST" != "no"])
-AC_SUBST(MPOST)
-])
-
-dnl Putting the above together, check possibilities for online event analysis
-AC_DEFUN([WO_CHECK_EVENT_ANALYSIS_METHODS], [dnl
-AC_REQUIRE([AC_PROG_LATEX])
-AC_REQUIRE([AC_PROG_MPOST])
-AC_REQUIRE([AC_PROG_DVIPS])
-AC_REQUIRE([AC_PROG_PS2PDF])
-
-AC_CACHE_CHECK([whether we can display event analysis in PostScript format],
-[wo_cv_event_analysis_ps],
-[dnl
-if test "$LATEX" != "no" -a "$MPOST" != "no" -a "$DVIPS" != "no"; then
- wo_cv_event_analysis_ps="yes"
-else
- wo_cv_event_analysis_ps="no"
-fi])
-EVENT_ANALYSIS_PS="$wo_cv_event_analysis_ps"
-AC_SUBST([EVENT_ANALYSIS_PS])
-
-AC_CACHE_CHECK([whether we can display event analysis in PDF format],
-[wo_cv_event_analysis_pdf],
-[dnl
-if test "$EVENT_ANALYSIS_PS" != "no" -a "$PS2PDF" != "no"; then
- wo_cv_event_analysis_pdf="yes"
-else
- wo_cv_event_analysis_pdf="no"
-fi])
-EVENT_ANALYSIS_PDF="$wo_cv_event_analysis_pdf"
-AC_SUBST([EVENT_ANALYSIS_PDF])
-])
-
-
-dnl Checking for gzip (putting this together with the LaTeX part)
-
-AC_DEFUN([AC_PROG_GZIP],[
-AC_CHECK_PROGS(GZIP,[gzip],no)
-AM_CONDITIONAL([GZIP_AVAILABLE], [test "$GZIP" != "no"])
-AC_SUBST(GZIP)
-])
Index: branches/ohl/omega-development/hgg-vertex/m4/ltdl.m4
===================================================================
--- branches/ohl/omega-development/hgg-vertex/m4/ltdl.m4 (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/m4/ltdl.m4 (revision 8717)
@@ -1,804 +0,0 @@
-# ltdl.m4 - Configure ltdl for the target system. -*-Autoconf-*-
-#
-# Copyright (C) 1999-2006, 2007, 2008 Free Software Foundation, Inc.
-# Written by Thomas Tanner, 1999
-#
-# This file is free software; the Free Software Foundation gives
-# unlimited permission to copy and/or distribute it, with or without
-# modifications, as long as this notice is preserved.
-
-# serial 17 LTDL_INIT
-
-# LT_CONFIG_LTDL_DIR(DIRECTORY, [LTDL-MODE])
-# ------------------------------------------
-# DIRECTORY contains the libltdl sources. It is okay to call this
-# function multiple times, as long as the same DIRECTORY is always given.
-AC_DEFUN([LT_CONFIG_LTDL_DIR],
-[AC_BEFORE([$0], [LTDL_INIT])
-_$0($*)
-])# LT_CONFIG_LTDL_DIR
-
-# We break this out into a separate macro, so that we can call it safely
-# internally without being caught accidentally by the sed scan in libtoolize.
-m4_defun([_LT_CONFIG_LTDL_DIR],
-[dnl remove trailing slashes
-m4_pushdef([_ARG_DIR], m4_bpatsubst([$1], [/*$]))
-m4_case(_LTDL_DIR,
- [], [dnl only set lt_ltdl_dir if _ARG_DIR is not simply `.'
- m4_if(_ARG_DIR, [.],
- [],
- [m4_define([_LTDL_DIR], _ARG_DIR)
- _LT_SHELL_INIT([lt_ltdl_dir=']_ARG_DIR['])])],
- [m4_if(_ARG_DIR, _LTDL_DIR,
- [],
- [m4_fatal([multiple libltdl directories: `]_LTDL_DIR[', `]_ARG_DIR['])])])
-m4_popdef([_ARG_DIR])
-])# _LT_CONFIG_LTDL_DIR
-
-# Initialise:
-m4_define([_LTDL_DIR], [])
-
-
-# _LT_BUILD_PREFIX
-# ----------------
-# If Autoconf is new enough, expand to `${top_build_prefix}', otherwise
-# to `${top_builddir}/'.
-m4_define([_LT_BUILD_PREFIX],
-[m4_ifdef([AC_AUTOCONF_VERSION],
- [m4_if(m4_version_compare(m4_defn([AC_AUTOCONF_VERSION]), [2.62]),
- [-1], [m4_ifdef([_AC_HAVE_TOP_BUILD_PREFIX],
- [${top_build_prefix}],
- [${top_builddir}/])],
- [${top_build_prefix}])],
- [${top_builddir}/])[]dnl
-])
-
-
-# LTDL_CONVENIENCE
-# ----------------
-# sets LIBLTDL to the link flags for the libltdl convenience library and
-# LTDLINCL to the include flags for the libltdl header and adds
-# --enable-ltdl-convenience to the configure arguments. Note that
-# AC_CONFIG_SUBDIRS is not called here. LIBLTDL will be prefixed with
-# '${top_build_prefix}' if available, otherwise with '${top_builddir}/',
-# and LTDLINCL will be prefixed with '${top_srcdir}/' (note the single
-# quotes!). If your package is not flat and you're not using automake,
-# define top_build_prefix, top_builddir, and top_srcdir appropriately
-# in your Makefiles.
-AC_DEFUN([LTDL_CONVENIENCE],
-[AC_BEFORE([$0], [LTDL_INIT])dnl
-dnl Although the argument is deprecated and no longer documented,
-dnl LTDL_CONVENIENCE used to take a DIRECTORY orgument, if we have one
-dnl here make sure it is the same as any other declaration of libltdl's
-dnl location! This also ensures lt_ltdl_dir is set when configure.ac is
-dnl not yet using an explicit LT_CONFIG_LTDL_DIR.
-m4_ifval([$1], [_LT_CONFIG_LTDL_DIR([$1])])dnl
-_$0()
-])# LTDL_CONVENIENCE
-
-# AC_LIBLTDL_CONVENIENCE accepted a directory argument in older libtools,
-# now we have LT_CONFIG_LTDL_DIR:
-AU_DEFUN([AC_LIBLTDL_CONVENIENCE],
-[_LT_CONFIG_LTDL_DIR([m4_default([$1], [libltdl])])
-_LTDL_CONVENIENCE])
-
-dnl aclocal-1.4 backwards compatibility:
-dnl AC_DEFUN([AC_LIBLTDL_CONVENIENCE], [])
-
-
-# _LTDL_CONVENIENCE
-# -----------------
-# Code shared by LTDL_CONVENIENCE and LTDL_INIT([convenience]).
-m4_defun([_LTDL_CONVENIENCE],
-[case $enable_ltdl_convenience in
- no) AC_MSG_ERROR([this package needs a convenience libltdl]) ;;
- "") enable_ltdl_convenience=yes
- ac_configure_args="$ac_configure_args --enable-ltdl-convenience" ;;
-esac
-LIBLTDL='_LT_BUILD_PREFIX'"${lt_ltdl_dir+$lt_ltdl_dir/}libltdlc.la"
-LTDLDEPS=$LIBLTDL
-LTDLINCL='-I${top_srcdir}'"${lt_ltdl_dir+/$lt_ltdl_dir}"
-
-AC_SUBST([LIBLTDL])
-AC_SUBST([LTDLDEPS])
-AC_SUBST([LTDLINCL])
-
-# For backwards non-gettext consistent compatibility...
-INCLTDL="$LTDLINCL"
-AC_SUBST([INCLTDL])
-])# _LTDL_CONVENIENCE
-
-
-# LTDL_INSTALLABLE
-# ----------------
-# sets LIBLTDL to the link flags for the libltdl installable library
-# and LTDLINCL to the include flags for the libltdl header and adds
-# --enable-ltdl-install to the configure arguments. Note that
-# AC_CONFIG_SUBDIRS is not called from here. If an installed libltdl
-# is not found, LIBLTDL will be prefixed with '${top_build_prefix}' if
-# available, otherwise with '${top_builddir}/', and LTDLINCL will be
-# prefixed with '${top_srcdir}/' (note the single quotes!). If your
-# package is not flat and you're not using automake, define top_build_prefix,
-# top_builddir, and top_srcdir appropriately in your Makefiles.
-# In the future, this macro may have to be called after LT_INIT.
-AC_DEFUN([LTDL_INSTALLABLE],
-[AC_BEFORE([$0], [LTDL_INIT])dnl
-dnl Although the argument is deprecated and no longer documented,
-dnl LTDL_INSTALLABLE used to take a DIRECTORY orgument, if we have one
-dnl here make sure it is the same as any other declaration of libltdl's
-dnl location! This also ensures lt_ltdl_dir is set when configure.ac is
-dnl not yet using an explicit LT_CONFIG_LTDL_DIR.
-m4_ifval([$1], [_LT_CONFIG_LTDL_DIR([$1])])dnl
-_$0()
-])# LTDL_INSTALLABLE
-
-# AC_LIBLTDL_INSTALLABLE accepted a directory argument in older libtools,
-# now we have LT_CONFIG_LTDL_DIR:
-AU_DEFUN([AC_LIBLTDL_INSTALLABLE],
-[_LT_CONFIG_LTDL_DIR([m4_default([$1], [libltdl])])
-_LTDL_INSTALLABLE])
-
-dnl aclocal-1.4 backwards compatibility:
-dnl AC_DEFUN([AC_LIBLTDL_INSTALLABLE], [])
-
-
-# _LTDL_INSTALLABLE
-# -----------------
-# Code shared by LTDL_INSTALLABLE and LTDL_INIT([installable]).
-m4_defun([_LTDL_INSTALLABLE],
-[if test -f $prefix/lib/libltdl.la; then
- lt_save_LDFLAGS="$LDFLAGS"
- LDFLAGS="-L$prefix/lib $LDFLAGS"
- AC_CHECK_LIB([ltdl], [lt_dlinit], [lt_lib_ltdl=yes])
- LDFLAGS="$lt_save_LDFLAGS"
- if test x"${lt_lib_ltdl-no}" = xyes; then
- if test x"$enable_ltdl_install" != xyes; then
- # Don't overwrite $prefix/lib/libltdl.la without --enable-ltdl-install
- AC_MSG_WARN([not overwriting libltdl at $prefix, force with `--enable-ltdl-install'])
- enable_ltdl_install=no
- fi
- elif test x"$enable_ltdl_install" = xno; then
- AC_MSG_WARN([libltdl not installed, but installation disabled])
- fi
-fi
-
-# If configure.ac declared an installable ltdl, and the user didn't override
-# with --disable-ltdl-install, we will install the shipped libltdl.
-case $enable_ltdl_install in
- no) ac_configure_args="$ac_configure_args --enable-ltdl-install=no"
- LIBLTDL="-lltdl"
- LTDLDEPS=
- LTDLINCL=
- ;;
- *) enable_ltdl_install=yes
- ac_configure_args="$ac_configure_args --enable-ltdl-install"
- LIBLTDL='_LT_BUILD_PREFIX'"${lt_ltdl_dir+$lt_ltdl_dir/}libltdl.la"
- LTDLDEPS=$LIBLTDL
- LTDLINCL='-I${top_srcdir}'"${lt_ltdl_dir+/$lt_ltdl_dir}"
- ;;
-esac
-
-AC_SUBST([LIBLTDL])
-AC_SUBST([LTDLDEPS])
-AC_SUBST([LTDLINCL])
-
-# For backwards non-gettext consistent compatibility...
-INCLTDL="$LTDLINCL"
-AC_SUBST([INCLTDL])
-])# LTDL_INSTALLABLE
-
-
-# _LTDL_MODE_DISPATCH
-# -------------------
-m4_define([_LTDL_MODE_DISPATCH],
-[dnl If _LTDL_DIR is `.', then we are configuring libltdl itself:
-m4_if(_LTDL_DIR, [],
- [],
- dnl if _LTDL_MODE was not set already, the default value is `subproject':
- [m4_case(m4_default(_LTDL_MODE, [subproject]),
- [subproject], [AC_CONFIG_SUBDIRS(_LTDL_DIR)
- _LT_SHELL_INIT([lt_dlopen_dir="$lt_ltdl_dir"])],
- [nonrecursive], [_LT_SHELL_INIT([lt_dlopen_dir="$lt_ltdl_dir"; lt_libobj_prefix="$lt_ltdl_dir/"])],
- [recursive], [],
- [m4_fatal([unknown libltdl mode: ]_LTDL_MODE)])])dnl
-dnl Be careful not to expand twice:
-m4_define([$0], [])
-])# _LTDL_MODE_DISPATCH
-
-
-# _LT_LIBOBJ(MODULE_NAME)
-# -----------------------
-# Like AC_LIBOBJ, except that MODULE_NAME goes into _LT_LIBOBJS instead
-# of into LIBOBJS.
-AC_DEFUN([_LT_LIBOBJ], [
- m4_pattern_allow([^_LT_LIBOBJS$])
- _LT_LIBOBJS="$_LT_LIBOBJS $1.$ac_objext"
-])# _LT_LIBOBJS
-
-
-# LTDL_INIT([OPTIONS])
-# --------------------
-# Clients of libltdl can use this macro to allow the installer to
-# choose between a shipped copy of the ltdl sources or a preinstalled
-# version of the library. If the shipped ltdl sources are not in a
-# subdirectory named libltdl, the directory name must be given by
-# LT_CONFIG_LTDL_DIR.
-AC_DEFUN([LTDL_INIT],
-[dnl Parse OPTIONS
-_LT_SET_OPTIONS([$0], [$1])
-
-dnl We need to keep our own list of libobjs separate from our parent project,
-dnl and the easiest way to do that is redefine the AC_LIBOBJs macro while
-dnl we look for our own LIBOBJs.
-m4_pushdef([AC_LIBOBJ], m4_defn([_LT_LIBOBJ]))
-m4_pushdef([AC_LIBSOURCES])
-
-dnl If not otherwise defined, default to the 1.5.x compatible subproject mode:
-m4_if(_LTDL_MODE, [],
- [m4_define([_LTDL_MODE], m4_default([$2], [subproject]))
- m4_if([-1], [m4_bregexp(_LTDL_MODE, [\(subproject\|\(non\)?recursive\)])],
- [m4_fatal([unknown libltdl mode: ]_LTDL_MODE)])])
-
-AC_ARG_WITH([included_ltdl],
- [AS_HELP_STRING([--with-included-ltdl],
- [use the GNU ltdl sources included here])])
-
-if test "x$with_included_ltdl" != xyes; then
- # We are not being forced to use the included libltdl sources, so
- # decide whether there is a useful installed version we can use.
- AC_CHECK_HEADER([ltdl.h],
- [AC_CHECK_DECL([lt_dlinterface_register],
- [AC_CHECK_LIB([ltdl], [lt_dladvise_preload],
- [with_included_ltdl=no],
- [with_included_ltdl=yes])],
- [with_included_ltdl=yes],
- [AC_INCLUDES_DEFAULT
- #include <ltdl.h>])],
- [with_included_ltdl=yes],
- [AC_INCLUDES_DEFAULT]
- )
-fi
-
-dnl If neither LT_CONFIG_LTDL_DIR, LTDL_CONVENIENCE nor LTDL_INSTALLABLE
-dnl was called yet, then for old times' sake, we assume libltdl is in an
-dnl eponymous directory:
-AC_PROVIDE_IFELSE([LT_CONFIG_LTDL_DIR], [], [_LT_CONFIG_LTDL_DIR([libltdl])])
-
-AC_ARG_WITH([ltdl_include],
- [AS_HELP_STRING([--with-ltdl-include=DIR],
- [use the ltdl headers installed in DIR])])
-
-if test -n "$with_ltdl_include"; then
- if test -f "$with_ltdl_include/ltdl.h"; then :
- else
- AC_MSG_ERROR([invalid ltdl include directory: `$with_ltdl_include'])
- fi
-else
- with_ltdl_include=no
-fi
-
-AC_ARG_WITH([ltdl_lib],
- [AS_HELP_STRING([--with-ltdl-lib=DIR],
- [use the libltdl.la installed in DIR])])
-
-if test -n "$with_ltdl_lib"; then
- if test -f "$with_ltdl_lib/libltdl.la"; then :
- else
- AC_MSG_ERROR([invalid ltdl library directory: `$with_ltdl_lib'])
- fi
-else
- with_ltdl_lib=no
-fi
-
-case ,$with_included_ltdl,$with_ltdl_include,$with_ltdl_lib, in
- ,yes,no,no,)
- m4_case(m4_default(_LTDL_TYPE, [convenience]),
- [convenience], [_LTDL_CONVENIENCE],
- [installable], [_LTDL_INSTALLABLE],
- [m4_fatal([unknown libltdl build type: ]_LTDL_TYPE)])
- ;;
- ,no,no,no,)
- # If the included ltdl is not to be used, then use the
- # preinstalled libltdl we found.
- AC_DEFINE([HAVE_LTDL], [1],
- [Define this if a modern libltdl is already installed])
- LIBLTDL=-lltdl
- LTDLDEPS=
- LTDLINCL=
- ;;
- ,no*,no,*)
- AC_MSG_ERROR([`--with-ltdl-include' and `--with-ltdl-lib' options must be used together])
- ;;
- *) with_included_ltdl=no
- LIBLTDL="-L$with_ltdl_lib -lltdl"
- LTDLDEPS=
- LTDLINCL="-I$with_ltdl_include"
- ;;
-esac
-INCLTDL="$LTDLINCL"
-
-# Report our decision...
-AC_MSG_CHECKING([where to find libltdl headers])
-AC_MSG_RESULT([$LTDLINCL])
-AC_MSG_CHECKING([where to find libltdl library])
-AC_MSG_RESULT([$LIBLTDL])
-
-_LTDL_SETUP
-
-dnl restore autoconf definition.
-m4_popdef([AC_LIBOBJ])
-m4_popdef([AC_LIBSOURCES])
-
-AC_CONFIG_COMMANDS_PRE([
- _ltdl_libobjs=
- _ltdl_ltlibobjs=
- if test -n "$_LT_LIBOBJS"; then
- # Remove the extension.
- _lt_sed_drop_objext='s/\.o$//;s/\.obj$//'
- for i in `for i in $_LT_LIBOBJS; do echo "$i"; done | sed "$_lt_sed_drop_objext" | sort -u`; do
- _ltdl_libobjs="$_ltdl_libobjs $lt_libobj_prefix$i.$ac_objext"
- _ltdl_ltlibobjs="$_ltdl_ltlibobjs $lt_libobj_prefix$i.lo"
- done
- fi
- AC_SUBST([ltdl_LIBOBJS], [$_ltdl_libobjs])
- AC_SUBST([ltdl_LTLIBOBJS], [$_ltdl_ltlibobjs])
-])
-
-# Only expand once:
-m4_define([LTDL_INIT])
-])# LTDL_INIT
-
-# Old names:
-AU_DEFUN([AC_LIB_LTDL], [LTDL_INIT($@)])
-AU_DEFUN([AC_WITH_LTDL], [LTDL_INIT($@)])
-AU_DEFUN([LT_WITH_LTDL], [LTDL_INIT($@)])
-dnl aclocal-1.4 backwards compatibility:
-dnl AC_DEFUN([AC_LIB_LTDL], [])
-dnl AC_DEFUN([AC_WITH_LTDL], [])
-dnl AC_DEFUN([LT_WITH_LTDL], [])
-
-
-# _LTDL_SETUP
-# -----------
-# Perform all the checks necessary for compilation of the ltdl objects
-# -- including compiler checks and header checks. This is a public
-# interface mainly for the benefit of libltdl's own configure.ac, most
-# other users should call LTDL_INIT instead.
-AC_DEFUN([_LTDL_SETUP],
-[AC_REQUIRE([AC_PROG_CC])dnl
-AC_REQUIRE([LT_SYS_MODULE_EXT])dnl
-AC_REQUIRE([LT_SYS_MODULE_PATH])dnl
-AC_REQUIRE([LT_SYS_DLSEARCH_PATH])dnl
-AC_REQUIRE([LT_LIB_DLLOAD])dnl
-AC_REQUIRE([LT_SYS_SYMBOL_USCORE])dnl
-AC_REQUIRE([LT_FUNC_DLSYM_USCORE])dnl
-AC_REQUIRE([LT_SYS_DLOPEN_DEPLIBS])dnl
-AC_REQUIRE([gl_FUNC_ARGZ])dnl
-
-m4_require([_LT_CHECK_OBJDIR])dnl
-m4_require([_LT_HEADER_DLFCN])dnl
-m4_require([_LT_CHECK_DLPREOPEN])dnl
-m4_require([_LT_DECL_SED])dnl
-
-dnl Don't require this, or it will be expanded earlier than the code
-dnl that sets the variables it relies on:
-_LT_ENABLE_INSTALL
-
-dnl _LTDL_MODE specific code must be called at least once:
-_LTDL_MODE_DISPATCH
-
-# In order that ltdl.c can compile, find out the first AC_CONFIG_HEADERS
-# the user used. This is so that ltdl.h can pick up the parent projects
-# config.h file, The first file in AC_CONFIG_HEADERS must contain the
-# definitions required by ltdl.c.
-# FIXME: Remove use of undocumented AC_LIST_HEADERS (2.59 compatibility).
-AC_CONFIG_COMMANDS_PRE([dnl
-m4_pattern_allow([^LT_CONFIG_H$])dnl
-m4_ifset([AH_HEADER],
- [LT_CONFIG_H=AH_HEADER],
- [m4_ifset([AC_LIST_HEADERS],
- [LT_CONFIG_H=`echo "AC_LIST_HEADERS" | $SED 's,^[[ ]]*,,;s,[[ :]].*$,,'`],
- [])])])
-AC_SUBST([LT_CONFIG_H])
-
-AC_CHECK_HEADERS([unistd.h dl.h sys/dl.h dld.h mach-o/dyld.h dirent.h],
- [], [], [AC_INCLUDES_DEFAULT])
-
-AC_CHECK_FUNCS([closedir opendir readdir], [], [AC_LIBOBJ([lt__dirent])])
-AC_CHECK_FUNCS([strlcat strlcpy], [], [AC_LIBOBJ([lt__strl])])
-
-AC_DEFINE_UNQUOTED([LT_LIBEXT],["$libext"],[The archive extension])
-
-name=ltdl
-LTDLOPEN=`eval "\\$ECHO \"$libname_spec\""`
-AC_SUBST([LTDLOPEN])
-])# _LTDL_SETUP
-
-
-# _LT_ENABLE_INSTALL
-# ------------------
-m4_define([_LT_ENABLE_INSTALL],
-[AC_ARG_ENABLE([ltdl-install],
- [AS_HELP_STRING([--enable-ltdl-install], [install libltdl])])
-
-case ,${enable_ltdl_install},${enable_ltdl_convenience} in
- *yes*) ;;
- *) enable_ltdl_convenience=yes ;;
-esac
-
-m4_ifdef([AM_CONDITIONAL],
-[AM_CONDITIONAL(INSTALL_LTDL, test x"${enable_ltdl_install-no}" != xno)
- AM_CONDITIONAL(CONVENIENCE_LTDL, test x"${enable_ltdl_convenience-no}" != xno)])
-])# _LT_ENABLE_INSTALL
-
-
-# LT_SYS_DLOPEN_DEPLIBS
-# ---------------------
-AC_DEFUN([LT_SYS_DLOPEN_DEPLIBS],
-[AC_REQUIRE([AC_CANONICAL_HOST])dnl
-AC_CACHE_CHECK([whether deplibs are loaded by dlopen],
- [lt_cv_sys_dlopen_deplibs],
- [# PORTME does your system automatically load deplibs for dlopen?
- # or its logical equivalent (e.g. shl_load for HP-UX < 11)
- # For now, we just catch OSes we know something about -- in the
- # future, we'll try test this programmatically.
- lt_cv_sys_dlopen_deplibs=unknown
- case $host_os in
- aix3*|aix4.1.*|aix4.2.*)
- # Unknown whether this is true for these versions of AIX, but
- # we want this `case' here to explicitly catch those versions.
- lt_cv_sys_dlopen_deplibs=unknown
- ;;
- aix[[4-9]]*)
- lt_cv_sys_dlopen_deplibs=yes
- ;;
- amigaos*)
- case $host_cpu in
- powerpc)
- lt_cv_sys_dlopen_deplibs=no
- ;;
- esac
- ;;
- darwin*)
- # Assuming the user has installed a libdl from somewhere, this is true
- # If you are looking for one http://www.opendarwin.org/projects/dlcompat
- lt_cv_sys_dlopen_deplibs=yes
- ;;
- freebsd* | dragonfly*)
- lt_cv_sys_dlopen_deplibs=yes
- ;;
- gnu* | linux* | k*bsd*-gnu)
- # GNU and its variants, using gnu ld.so (Glibc)
- lt_cv_sys_dlopen_deplibs=yes
- ;;
- hpux10*|hpux11*)
- lt_cv_sys_dlopen_deplibs=yes
- ;;
- interix*)
- lt_cv_sys_dlopen_deplibs=yes
- ;;
- irix[[12345]]*|irix6.[[01]]*)
- # Catch all versions of IRIX before 6.2, and indicate that we don't
- # know how it worked for any of those versions.
- lt_cv_sys_dlopen_deplibs=unknown
- ;;
- irix*)
- # The case above catches anything before 6.2, and it's known that
- # at 6.2 and later dlopen does load deplibs.
- lt_cv_sys_dlopen_deplibs=yes
- ;;
- netbsd*)
- lt_cv_sys_dlopen_deplibs=yes
- ;;
- openbsd*)
- lt_cv_sys_dlopen_deplibs=yes
- ;;
- osf[[1234]]*)
- # dlopen did load deplibs (at least at 4.x), but until the 5.x series,
- # it did *not* use an RPATH in a shared library to find objects the
- # library depends on, so we explicitly say `no'.
- lt_cv_sys_dlopen_deplibs=no
- ;;
- osf5.0|osf5.0a|osf5.1)
- # dlopen *does* load deplibs and with the right loader patch applied
- # it even uses RPATH in a shared library to search for shared objects
- # that the library depends on, but there's no easy way to know if that
- # patch is installed. Since this is the case, all we can really
- # say is unknown -- it depends on the patch being installed. If
- # it is, this changes to `yes'. Without it, it would be `no'.
- lt_cv_sys_dlopen_deplibs=unknown
- ;;
- osf*)
- # the two cases above should catch all versions of osf <= 5.1. Read
- # the comments above for what we know about them.
- # At > 5.1, deplibs are loaded *and* any RPATH in a shared library
- # is used to find them so we can finally say `yes'.
- lt_cv_sys_dlopen_deplibs=yes
- ;;
- qnx*)
- lt_cv_sys_dlopen_deplibs=yes
- ;;
- solaris*)
- lt_cv_sys_dlopen_deplibs=yes
- ;;
- sysv5* | sco3.2v5* | sco5v6* | unixware* | OpenUNIX* | sysv4*uw2*)
- libltdl_cv_sys_dlopen_deplibs=yes
- ;;
- esac
- ])
-if test "$lt_cv_sys_dlopen_deplibs" != yes; then
- AC_DEFINE([LTDL_DLOPEN_DEPLIBS], [1],
- [Define if the OS needs help to load dependent libraries for dlopen().])
-fi
-])# LT_SYS_DLOPEN_DEPLIBS
-
-# Old name:
-AU_ALIAS([AC_LTDL_SYS_DLOPEN_DEPLIBS], [LT_SYS_DLOPEN_DEPLIBS])
-dnl aclocal-1.4 backwards compatibility:
-dnl AC_DEFUN([AC_LTDL_SYS_DLOPEN_DEPLIBS], [])
-
-
-# LT_SYS_MODULE_EXT
-# -----------------
-AC_DEFUN([LT_SYS_MODULE_EXT],
-[m4_require([_LT_SYS_DYNAMIC_LINKER])dnl
-AC_CACHE_CHECK([which extension is used for runtime loadable modules],
- [libltdl_cv_shlibext],
-[
-module=yes
-eval libltdl_cv_shlibext=$shrext_cmds
- ])
-if test -n "$libltdl_cv_shlibext"; then
- m4_pattern_allow([LT_MODULE_EXT])dnl
- AC_DEFINE_UNQUOTED([LT_MODULE_EXT], ["$libltdl_cv_shlibext"],
- [Define to the extension used for runtime loadable modules, say, ".so".])
-fi
-])# LT_SYS_MODULE_EXT
-
-# Old name:
-AU_ALIAS([AC_LTDL_SHLIBEXT], [LT_SYS_MODULE_EXT])
-dnl aclocal-1.4 backwards compatibility:
-dnl AC_DEFUN([AC_LTDL_SHLIBEXT], [])
-
-
-# LT_SYS_MODULE_PATH
-# ------------------
-AC_DEFUN([LT_SYS_MODULE_PATH],
-[m4_require([_LT_SYS_DYNAMIC_LINKER])dnl
-AC_CACHE_CHECK([which variable specifies run-time module search path],
- [lt_cv_module_path_var], [lt_cv_module_path_var="$shlibpath_var"])
-if test -n "$lt_cv_module_path_var"; then
- m4_pattern_allow([LT_MODULE_PATH_VAR])dnl
- AC_DEFINE_UNQUOTED([LT_MODULE_PATH_VAR], ["$lt_cv_module_path_var"],
- [Define to the name of the environment variable that determines the run-time module search path.])
-fi
-])# LT_SYS_MODULE_PATH
-
-# Old name:
-AU_ALIAS([AC_LTDL_SHLIBPATH], [LT_SYS_MODULE_PATH])
-dnl aclocal-1.4 backwards compatibility:
-dnl AC_DEFUN([AC_LTDL_SHLIBPATH], [])
-
-
-# LT_SYS_DLSEARCH_PATH
-# --------------------
-AC_DEFUN([LT_SYS_DLSEARCH_PATH],
-[m4_require([_LT_SYS_DYNAMIC_LINKER])dnl
-AC_CACHE_CHECK([for the default library search path],
- [lt_cv_sys_dlsearch_path],
- [lt_cv_sys_dlsearch_path="$sys_lib_dlsearch_path_spec"])
-if test -n "$lt_cv_sys_dlsearch_path"; then
- sys_dlsearch_path=
- for dir in $lt_cv_sys_dlsearch_path; do
- if test -z "$sys_dlsearch_path"; then
- sys_dlsearch_path="$dir"
- else
- sys_dlsearch_path="$sys_dlsearch_path$PATH_SEPARATOR$dir"
- fi
- done
- m4_pattern_allow([LT_DLSEARCH_PATH])dnl
- AC_DEFINE_UNQUOTED([LT_DLSEARCH_PATH], ["$sys_dlsearch_path"],
- [Define to the system default library search path.])
-fi
-])# LT_SYS_DLSEARCH_PATH
-
-# Old name:
-AU_ALIAS([AC_LTDL_SYSSEARCHPATH], [LT_SYS_DLSEARCH_PATH])
-dnl aclocal-1.4 backwards compatibility:
-dnl AC_DEFUN([AC_LTDL_SYSSEARCHPATH], [])
-
-
-# _LT_CHECK_DLPREOPEN
-# -------------------
-m4_defun([_LT_CHECK_DLPREOPEN],
-[m4_require([_LT_CMD_GLOBAL_SYMBOLS])dnl
-AC_CACHE_CHECK([whether libtool supports -dlopen/-dlpreopen],
- [libltdl_cv_preloaded_symbols],
- [if test -n "$lt_cv_sys_global_symbol_pipe"; then
- libltdl_cv_preloaded_symbols=yes
- else
- libltdl_cv_preloaded_symbols=no
- fi
- ])
-if test x"$libltdl_cv_preloaded_symbols" = xyes; then
- AC_DEFINE([HAVE_PRELOADED_SYMBOLS], [1],
- [Define if libtool can extract symbol lists from object files.])
-fi
-])# _LT_CHECK_DLPREOPEN
-
-
-# LT_LIB_DLLOAD
-# -------------
-AC_DEFUN([LT_LIB_DLLOAD],
-[m4_pattern_allow([^LT_DLLOADERS$])
-LT_DLLOADERS=
-AC_SUBST([LT_DLLOADERS])
-
-AC_LANG_PUSH([C])
-
-LIBADD_DLOPEN=
-AC_SEARCH_LIBS([dlopen], [dl],
- [AC_DEFINE([HAVE_LIBDL], [1],
- [Define if you have the libdl library or equivalent.])
- if test "$ac_cv_search_dlopen" != "none required" ; then
- LIBADD_DLOPEN="-ldl"
- fi
- libltdl_cv_lib_dl_dlopen="yes"
- LT_DLLOADERS="$LT_DLLOADERS ${lt_dlopen_dir+$lt_dlopen_dir/}dlopen.la"],
- [AC_LINK_IFELSE([AC_LANG_PROGRAM([[#if HAVE_DLFCN_H
-# include <dlfcn.h>
-#endif
- ]], [[dlopen(0, 0);]])],
- [AC_DEFINE([HAVE_LIBDL], [1],
- [Define if you have the libdl library or equivalent.])
- libltdl_cv_func_dlopen="yes"
- LT_DLLOADERS="$LT_DLLOADERS ${lt_dlopen_dir+$lt_dlopen_dir/}dlopen.la"],
- [AC_CHECK_LIB([svld], [dlopen],
- [AC_DEFINE([HAVE_LIBDL], [1],
- [Define if you have the libdl library or equivalent.])
- LIBADD_DLOPEN="-lsvld" libltdl_cv_func_dlopen="yes"
- LT_DLLOADERS="$LT_DLLOADERS ${lt_dlopen_dir+$lt_dlopen_dir/}dlopen.la"])])])
-if test x"$libltdl_cv_func_dlopen" = xyes || test x"$libltdl_cv_lib_dl_dlopen" = xyes
-then
- lt_save_LIBS="$LIBS"
- LIBS="$LIBS $LIBADD_DLOPEN"
- AC_CHECK_FUNCS([dlerror])
- LIBS="$lt_save_LIBS"
-fi
-AC_SUBST([LIBADD_DLOPEN])
-
-LIBADD_SHL_LOAD=
-AC_CHECK_FUNC([shl_load],
- [AC_DEFINE([HAVE_SHL_LOAD], [1],
- [Define if you have the shl_load function.])
- LT_DLLOADERS="$LT_DLLOADERS ${lt_dlopen_dir+$lt_dlopen_dir/}shl_load.la"],
- [AC_CHECK_LIB([dld], [shl_load],
- [AC_DEFINE([HAVE_SHL_LOAD], [1],
- [Define if you have the shl_load function.])
- LT_DLLOADERS="$LT_DLLOADERS ${lt_dlopen_dir+$lt_dlopen_dir/}shl_load.la"
- LIBADD_SHL_LOAD="-ldld"])])
-AC_SUBST([LIBADD_SHL_LOAD])
-
-case $host_os in
-darwin[[1567]].*)
-# We only want this for pre-Mac OS X 10.4.
- AC_CHECK_FUNC([_dyld_func_lookup],
- [AC_DEFINE([HAVE_DYLD], [1],
- [Define if you have the _dyld_func_lookup function.])
- LT_DLLOADERS="$LT_DLLOADERS ${lt_dlopen_dir+$lt_dlopen_dir/}dyld.la"])
- ;;
-beos*)
- LT_DLLOADERS="$LT_DLLOADERS ${lt_dlopen_dir+$lt_dlopen_dir/}load_add_on.la"
- ;;
-cygwin* | mingw* | os2* | pw32*)
- AC_CHECK_DECLS([cygwin_conv_path], [], [], [[#include <sys/cygwin.h>]])
- LT_DLLOADERS="$LT_DLLOADERS ${lt_dlopen_dir+$lt_dlopen_dir/}loadlibrary.la"
- ;;
-esac
-
-AC_CHECK_LIB([dld], [dld_link],
- [AC_DEFINE([HAVE_DLD], [1],
- [Define if you have the GNU dld library.])
- LT_DLLOADERS="$LT_DLLOADERS ${lt_dlopen_dir+$lt_dlopen_dir/}dld_link.la"])
-AC_SUBST([LIBADD_DLD_LINK])
-
-m4_pattern_allow([^LT_DLPREOPEN$])
-LT_DLPREOPEN=
-if test -n "$LT_DLLOADERS"
-then
- for lt_loader in $LT_DLLOADERS; do
- LT_DLPREOPEN="$LT_DLPREOPEN-dlpreopen $lt_loader "
- done
- AC_DEFINE([HAVE_LIBDLLOADER], [1],
- [Define if libdlloader will be built on this platform])
-fi
-AC_SUBST([LT_DLPREOPEN])
-
-dnl This isn't used anymore, but set it for backwards compatibility
-LIBADD_DL="$LIBADD_DLOPEN $LIBADD_SHL_LOAD"
-AC_SUBST([LIBADD_DL])
-
-AC_LANG_POP
-])# LT_LIB_DLLOAD
-
-# Old name:
-AU_ALIAS([AC_LTDL_DLLIB], [LT_LIB_DLLOAD])
-dnl aclocal-1.4 backwards compatibility:
-dnl AC_DEFUN([AC_LTDL_DLLIB], [])
-
-
-# LT_SYS_SYMBOL_USCORE
-# --------------------
-# does the compiler prefix global symbols with an underscore?
-AC_DEFUN([LT_SYS_SYMBOL_USCORE],
-[m4_require([_LT_CMD_GLOBAL_SYMBOLS])dnl
-AC_CACHE_CHECK([for _ prefix in compiled symbols],
- [lt_cv_sys_symbol_underscore],
- [lt_cv_sys_symbol_underscore=no
- cat > conftest.$ac_ext <<_LT_EOF
-void nm_test_func(){}
-int main(){nm_test_func;return 0;}
-_LT_EOF
- if AC_TRY_EVAL(ac_compile); then
- # Now try to grab the symbols.
- ac_nlist=conftest.nm
- if AC_TRY_EVAL(NM conftest.$ac_objext \| $lt_cv_sys_global_symbol_pipe \> $ac_nlist) && test -s "$ac_nlist"; then
- # See whether the symbols have a leading underscore.
- if grep '^. _nm_test_func' "$ac_nlist" >/dev/null; then
- lt_cv_sys_symbol_underscore=yes
- else
- if grep '^. nm_test_func ' "$ac_nlist" >/dev/null; then
- :
- else
- echo "configure: cannot find nm_test_func in $ac_nlist" >&AS_MESSAGE_LOG_FD
- fi
- fi
- else
- echo "configure: cannot run $lt_cv_sys_global_symbol_pipe" >&AS_MESSAGE_LOG_FD
- fi
- else
- echo "configure: failed program was:" >&AS_MESSAGE_LOG_FD
- cat conftest.c >&AS_MESSAGE_LOG_FD
- fi
- rm -rf conftest*
- ])
- sys_symbol_underscore=$lt_cv_sys_symbol_underscore
- AC_SUBST([sys_symbol_underscore])
-])# LT_SYS_SYMBOL_USCORE
-
-# Old name:
-AU_ALIAS([AC_LTDL_SYMBOL_USCORE], [LT_SYS_SYMBOL_USCORE])
-dnl aclocal-1.4 backwards compatibility:
-dnl AC_DEFUN([AC_LTDL_SYMBOL_USCORE], [])
-
-
-# LT_FUNC_DLSYM_USCORE
-# --------------------
-AC_DEFUN([LT_FUNC_DLSYM_USCORE],
-[AC_REQUIRE([LT_SYS_SYMBOL_USCORE])dnl
-if test x"$lt_cv_sys_symbol_underscore" = xyes; then
- if test x"$libltdl_cv_func_dlopen" = xyes ||
- test x"$libltdl_cv_lib_dl_dlopen" = xyes ; then
- AC_CACHE_CHECK([whether we have to add an underscore for dlsym],
- [libltdl_cv_need_uscore],
- [libltdl_cv_need_uscore=unknown
- save_LIBS="$LIBS"
- LIBS="$LIBS $LIBADD_DLOPEN"
- _LT_TRY_DLOPEN_SELF(
- [libltdl_cv_need_uscore=no], [libltdl_cv_need_uscore=yes],
- [], [libltdl_cv_need_uscore=cross])
- LIBS="$save_LIBS"
- ])
- fi
-fi
-
-if test x"$libltdl_cv_need_uscore" = xyes; then
- AC_DEFINE([NEED_USCORE], [1],
- [Define if dlsym() requires a leading underscore in symbol names.])
-fi
-])# LT_FUNC_DLSYM_USCORE
-
-# Old name:
-AU_ALIAS([AC_LTDL_DLSYM_USCORE], [LT_FUNC_DLSYM_USCORE])
-dnl aclocal-1.4 backwards compatibility:
-dnl AC_DEFUN([AC_LTDL_DLSYM_USCORE], [])
Index: branches/ohl/omega-development/hgg-vertex/update
===================================================================
--- branches/ohl/omega-development/hgg-vertex/update (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/update (revision 8717)
@@ -1,201 +0,0 @@
-#! /bin/sh
-# update -- generate fresh Makefile.depend etc.
-# $Id$
-########################################################################
-#
-# Copyright (C) 1999-2010 by
-# Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
-# Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
-# Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-#
-# 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.
-#
-########################################################################
-
-########################################################################
-#
-# Syncing version tags with WHIZARD
-#
-########################################################################
-
-configure_ac_parent=../../configure.ac
-configure_ac=configure.ac
-tmp=configure.ac.$$
-
-if test -f "$configure_ac_parent"; then
-
- AC_INIT="`sed -n '/^AC_INIT/s/WHIZARD/omega/p' $configure_ac_parent`"
- AM_INIT_AUTOMAKE="`grep '^AM_INIT_AUTOMAKE' $configure_ac_parent`"
- AC_PREREQ="`grep '^AC_PREREQ' $configure_ac_parent`"
- LT_PREREQ="`grep '^LT_PREREQ' $configure_ac_parent`"
-
- sed \
- -e "/^AC_INIT/s/^.*\$/$AC_INIT/" \
- -e "/^AM_INIT_AUTOMAKE/s/^.*\$/$AM_INIT_AUTOMAKE/" \
- -e "/^AC_PREREQ/s/^.*\$/$AC_PREREQ/" \
- -e "/^LT_PREREQ/s/^.*\$/$LT_PREREQ/" $configure_ac > $tmp
-
- if cmp -s $tmp $configure_ac; then
- rm $tmp
- else
- mv $tmp $configure_ac
- fi
-
-fi
-
-########################################################################
-#
-# Syncing files with the WHIZARD
-#
-########################################################################
-
-inherit_files () {
- while read whizard omega; do
- if test -f "$whizard"; then
- if test "$whizard" -nt "$omega"; then
- cp "$whizard" "$omega"
- elif test "$omega" -nt "$whizard" && ! cmp -s "$omega" "$whizard"; then
- echo "$omega" newer than "$whizard": consider "diff -u $whizard $omega"
- fi
- fi
- done
-}
-
-inherit_files <<EOF
- ../../AUTHORS AUTHORS
- ../../COPYING COPYING
- ../../config.guess config.guess
- ../../config.sub config.sub
- ../../install-sh install-sh
- ../../ltmain.sh ltmain.sh
- ../../m4/fortran.m4 m4/fortran.m4
- ../../m4/latex.m4 m4/latex.m4
- ../../m4/libtool.m4 m4/libtool.m4
- ../../m4/ltversion.m4 m4/ltversion.m4
- ../../m4/ltoptions.m4 m4/ltoptions.m4
- ../../m4/ltsugar.m4 m4/ltsugar.m4
- ../../m4/ltdl.m4 m4/ltdl.m4
- ../../m4/noweb.m4 m4/noweb.m4
- ../../m4/ocaml.m4 m4/ocaml.m4
- ../../missing missing
- ../misc/constants.f90 src/constants.f90
- ../misc/kinds.f90.in src/kinds.f90.in
- ../../share/doc/noweb.sty share/doc/noweb.sty
-EOF
-
-########################################################################
-#
-# The trouble with .depend:
-#
-# automake will expand the `include' and use the .depend file from
-# the source tree. However, if we're working on new but unfinished
-# modules, they need to be included in the current .depend, but NOT
-# in the distributed ones. We should use dist-hook or similar to
-# make sure that the correct .depend gets distributed. Life would be
-# simpler, if we could simply run ocamldep from `make depend' in the
-# source directory.
-#
-# Another option would be to run ocamldep from configure, but this
-# fails if we insist on all the `include's being handled by automake.
-#
-########################################################################
-
-PARSERS="cascade comphep vertex model_file"
-
-OMEGALIB="omega_utils
- omega_spinors omega_bispinors omega_vectors omega_vectorspinors omega_tensors
- omega_couplings omega_spinor_couplings omega_bispinor_couplings
- omega_polarizations omega_polarizations_madgraph
- omega_tensor_polarizations omega_vspinor_polarizations
- omega95 omega95_bispinors"
-
-# EXTRA_MODULES="kinds constants"
-EXTRA_MODULES="constants"
-
-makedepend_f90 () {
- module="$1"
- grep '^ *use ' \
- | grep -v '!NODEP!' \
- | sed -e "s/^ *use */$module.lo: /" \
- -e "s/, *only:.*//" \
- -e "s/, *&//" \
- -e "s/, *.*=>.*//" \
- -e "s/\$/.lo/"
-}
-
-have_ocamldep=false
-if ocamldep </dev/null >/dev/null 2>&1; then
- have_ocamldep=true
-else
- echo "update: ocamldep not found: can not update dependencies!" 1>&2
- exit 2
-fi
-
-have_notangle=false
-if echo "<<*>>=" notangle >/dev/null 2>&1; then
- have_notangle=true
-else
- echo "update: notangle not found: can not update dependencies!" 1>&2
- exit 2
-fi
-
-have_uniq=false
-uniq_or_cat=cat
-if test "`(echo 1; echo 1) | uniq`" = 1; then
- have_uniq=true
- uniq_or_cat=uniq
-fi
-
-( cd src 1>/dev/null 2>/dev/null
-
- echo "# \$Id:\$"
- echo "# no not edit: generated by $0"
-
- if $have_ocamldep; then
- ocamldep *.mli *.ml | grep -v ': *$'
- fi
-
-cat <<EOF
-config.cmo: config.cmi
-config.cmx: config.cmi
-cache.cmx: config.cmx
-EOF
-
- for parser in ${PARSERS}; do
- cat <<EOF
-${parser}.cmi: ${parser}_lexer.cmi
-${parser}_lexer.cmi: ${parser}_parser.cmi
-${parser}_parser.cmi: ${parser}_syntax.cmi
-${parser}_parser.mli: ${parser}_parser.ml
-${parser}.cmo: ${parser}.cmi
-${parser}.cmx: ${parser}.cmi ${parser}_lexer.cmx
-${parser}_lexer.cmo: ${parser}_lexer.cmi
-${parser}_lexer.cmx: ${parser}_lexer.cmi ${parser}_parser.cmx
-${parser}_parser.cmo: ${parser}_parser.cmi ${parser}_syntax.cmi
-${parser}_parser.cmx: ${parser}_parser.cmi ${parser}_syntax.cmi ${parser}_syntax.cmx
-EOF
- done
-
- for module in $EXTRA_MODULES; do
- makedepend_f90 $module < $module.f90
- done
-
- for module in $OMEGALIB; do
- notangle -R[[$module.f90]] omegalib.nw | makedepend_f90 $module
- done
-
-) | $uniq_or_cat >src/Makefile.depend
-
-
Index: branches/ohl/omega-development/hgg-vertex/models/sample.mdl
===================================================================
--- branches/ohl/omega-development/hgg-vertex/models/sample.mdl (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/models/sample.mdl (revision 8717)
@@ -1,38 +0,0 @@
-author { Thorsten Ohl <ohl@physik.uni-wuerzburg.de> }
-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/hgg-vertex/models/sample.omf
===================================================================
--- branches/ohl/omega-development/hgg-vertex/models/sample.omf (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/models/sample.omf (revision 8717)
@@ -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/hgg-vertex/models/Makefile.am
===================================================================
--- branches/ohl/omega-development/hgg-vertex/models/Makefile.am (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/models/Makefile.am (revision 8717)
@@ -1,27 +0,0 @@
-# Makefile.am -- Makefile for O'Mega within and without WHIZARD
-# $Id$
-##
-## Process this file with automake to produce Makefile.in
-##
-########################################################################
-#
-# Copyright (C) 1999-2010 by
-# Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
-# Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
-# Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-#
-# 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.
-#
-########################################################################
Index: branches/ohl/omega-development/hgg-vertex/AUTHORS
===================================================================
--- branches/ohl/omega-development/hgg-vertex/AUTHORS (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/AUTHORS (revision 8717)
@@ -1,5 +0,0 @@
-WHIZARD Authors:
-
-Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
-Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
-Juergen Reuter <reuter@physik.uni-freiburg.de>
Index: branches/ohl/omega-development/hgg-vertex/src/Makefile.sources
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/Makefile.sources (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/Makefile.sources (revision 8717)
@@ -1,216 +0,0 @@
-# Makefile.sources -- Makefile component for O'Mega
-# $Id$
-##
-## Process Makefile.am with automake to include this file in Makefile.in
-##
-########################################################################
-#
-# Copyright (C) 1999-2009 by
-# Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
-# Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
-# Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-#
-# 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 define the source files in a separate file so that they can be
-## include by Makefiles in multiple directories.
-##
-########################################################################
-
-########################################################################
-#
-# O'Caml sources
-#
-########################################################################
-#
-# NB:
-#
-# * all modules MUST be given in the correct sequence for linking
-#
-# * foo.ml as a source file implies foo.mli as a source files
-#
-# * we must use ocamlc -i to generate *_lexer.mli from *_lexer.ml in
-# order to treat *_lexer.ml like all other modules
-#
-# * automake conditionals are not available here, use
-# autoconf substitutions that expand to '#' or ''
-#
-########################################################################
-
-CASCADE_MLL = cascade_lexer.mll
-CASCADE_MLY = cascade_parser.mly
-CASCADE_ML = \
- cascade_syntax.ml cascade_lexer.ml cascade_parser.ml cascade.ml
-
-COMPHEP_MLL = comphep_lexer.mll
-COMPHEP_MLY = comphep_parser.mly
-COMPHEP_ML = \
- comphep_syntax.ml comphep_lexer.ml comphep_parser.ml comphep.ml
-
-VERTEX_MLL = @comment_model_file@ vertex_lexer.mll
-VERTEX_MLY = @comment_model_file@ vertex_parser.mly
-VERTEX_ML = \
- @comment_model_file@ vertex_syntax.ml vertex_lexer.ml vertex_parser.ml vertex.ml
-
-MODEL_FILE_MLL = @comment_model_file@ model_lexer.mll
-MODEL_FILE_MLY = @comment_model_file@ model_parser.mly
-MODEL_FILE_ML = \
- @comment_model_file@ model_syntax.ml model_lexer.ml model_parser.ml model_file.ml
-
-OMEGA_MLL = $(CASCADE_MLL) $(COMPHEP_MLL) $(VERTEX_MLL) $(MODEL_FILE_MLL)
-OMEGA_MLY = $(CASCADE_MLY) $(COMPHEP_MLY) $(VERTEX_MLY) $(MODEL_FILE_MLY)
-
-OMEGA_DERIVED_CAML = \
- $(OMEGA_MLL:.mll=.mli) $(OMEGA_MLL:.mll=.ml) \
- $(OMEGA_MLY:.mly=.mli) $(OMEGA_MLY:.mly=.ml)
-
-OMEGA_INTERFACES_MLI = \
- coupling.mli \
- model.mli \
- target.mli
-
-OMEGA_CORE_ML = \
- config.ml pmap.ml thoList.ml thoArray.ml thoString.ml bundle.ml rCS.ml \
- cache.ml progress.ml trie.ml linalg.ml tree2.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 modeltools.ml whizard.ml \
- $(VERTEX_ML) $(MODEL_FILE_ML) $(COMPHEP_ML) $(CASCADE_ML) \
- colorize.ml process.ml fusion.ml omega.ml
-
-OMEGA_CORE_MLI = \
- $(OMEGA_INTERFACES_MLI) \
- $(OMEGA_CORE_ML:.ml=.mli)
-
-OMEGA_MODELLIB_ML = \
- modellib_SM.ml \
- modellib_MSSM.ml \
- modellib_NMSSM.ml \
- modellib_PSSSM.ml \
- modellib_BSM.ml
-
-OMEGA_MODELLIB_MLI = $(OMEGA_MODELLIB_ML:.ml=.mli)
-
-OMEGA_TARGETLIB_ML = \
- targets_Kmatrix.ml \
- targets.ml
-
-OMEGA_TARGETLIB_MLI = $(OMEGA_TARGETLIB_ML:.ml=.mli)
-
-########################################################################
-# The supported models:
-########################################################################
-
-OMEGA_MINIMAL_APPLICATIONS_ML = \
- omega_QED.ml \
- omega_QCD.ml \
- omega_SM.ml
-
-OMEGA_APPLICATIONS_ML = \
- omega_QED.ml \
- omega_QCD.ml \
- omega_SM.ml \
- omega_SM_CKM.ml \
- omega_SM_ac.ml \
- omega_SM_ac_CKM.ml \
- omega_SM_top.ml \
- omega_SM_Hgg.ml \
- omega_MSSM.ml \
- omega_MSSM_CKM.ml \
- omega_MSSM_Grav.ml \
- omega_NMSSM.ml \
- omega_NMSSM_CKM.ml \
- omega_PSSSM.ml \
- omega_Littlest.ml \
- omega_Littlest_Eta.ml \
- omega_Littlest_Tpar.ml \
- omega_Simplest.ml \
- omega_Simplest_univ.ml \
- omega_Xdim.ml \
- omega_GravTest.ml \
- omega_SM_km.ml \
- omega_UED.ml \
- omega_Zprime.ml \
- omega_Threeshl.ml \
- omega_Threeshl_nohf.ml \
- omega_Template.ml
-
-### omega_E6SSM ???
-
-OMEGA_CORE_CMO = $(OMEGA_CORE_ML:.ml=.cmo)
-OMEGA_CORE_CMX = $(OMEGA_CORE_ML:.ml=.cmx)
-OMEGA_TARGETS_CMO = $(OMEGA_TARGETLIB_ML:.ml=.cmo)
-OMEGA_TARGETS_CMX = $(OMEGA_TARGETLIB_ML:.ml=.cmx)
-OMEGA_MODELS_CMO = $(OMEGA_MODELLIB_ML:.ml=.cmo)
-OMEGA_MODELS_CMX = $(OMEGA_MODELLIB_ML:.ml=.cmx)
-
-OMEGA_APPLICATIONS_CMO = $(OMEGA_APPLICATIONS_ML:.ml=.cmo)
-OMEGA_APPLICATIONS_CMX = $(OMEGA_APPLICATIONS_ML:.ml=.cmx)
-OMEGA_APPLICATIONS_BYTECODE = $(OMEGA_APPLICATIONS_ML:.ml=$(OCAML_BYTECODE_EXT))
-OMEGA_APPLICATIONS_NATIVE = $(OMEGA_APPLICATIONS_ML:.ml=$(OCAML_NATIVE_EXT))
-OMEGA_CACHES = $(OMEGA_APPLICATIONS_ML:.ml=$(OMEGA_CACHE_SUFFIX))
-
-OMEGA_MINIMAL_APPLICATIONS_BYTECODE = $(OMEGA_MINIMAL_APPLICATIONS_ML:.ml=$(OCAML_BYTECODE_EXT))
-OMEGA_MINIMAL_APPLICATIONS_NATIVE = $(OMEGA_MINIMAL_APPLICATIONS_ML:.ml=$(OCAML_NATIVE_EXT))
-OMEGA_MINIMAL_CACHES = $(OMEGA_MINIMAL_APPLICATIONS_ML:.ml=$(OMEGA_CACHE_SUFFIX))
-
-OMEGA_ML = \
- $(OMEGA_CORE_ML) \
- $(OMEGA_MODELLIB_ML) \
- $(OMEGA_TARGETLIB_ML) \
- $(OMEGA_APPLICATIONS_ML)
-
-OMEGA_MLI = \
- $(OMEGA_CORE_MLI) \
- $(OMEGA_MODELLIB_MLI) \
- $(OMEGA_TARGETLIB_MLI)
-
-OMEGA_CAML = $(OMEGA_ML) $(OMEGA_MLI) $(OMEGA_MLL) $(OMEGA_MLY) # $(OMEGA_DERIVED_CAML)
-
-########################################################################
-#
-# Fortran 90/95/2003 sources
-#
-########################################################################
-
-if STANDALONE_OMEGA_BUILD
- KINDS_F90 = kinds.f90
- CONSTANTS_F90 = constants.f90
- OMEGA_PARAMETERS_F90 = # omega_parameters.f90 omega_parameters_madgraph.f90
-else
-# use the copies in ../../misc instead
-endif
-
-OMEGALIB_DERIVED_F90 = \
- omega_spinors.f90 omega_bispinors.f90 omega_vectors.f90 \
- omega_vectorspinors.f90 omega_tensors.f90 \
- omega_couplings.f90 omega_spinor_couplings.f90 omega_bispinor_couplings.f90 \
- omega_polarizations.f90 omega_polarizations_madgraph.f90 \
- omega_tensor_polarizations.f90 omega_vspinor_polarizations.f90 \
- omega_utils.f90 \
- omega95.f90 omega95_bispinors.f90
-
-OMEGALIB_F90 = \
- $(KINDS_F90) $(CONSTANTS_F90) \
- $(OMEGALIB_DERIVED_F90) \
- $(OMEGA_PARAMETERS_F90)
-
-OMEGALIB_MOD = $(OMEGALIB_F90:.f90=.mod)
-
-########################################################################
-## The End.
-########################################################################
Index: branches/ohl/omega-development/hgg-vertex/src/omega_SM_ac.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/omega_SM_ac.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/omega_SM_ac.ml (revision 8717)
@@ -1,33 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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)
- (Modellib_SM.SM(Modellib_SM.SM_anomalous))
-let _ = O.main ()
-
-(*i
- * Local Variables:
- * mode:caml
- * indent-tabs-mode:nil
- * page-delimiter:"^(\\* .*\n"
- * End:
-i*)
Index: branches/ohl/omega-development/hgg-vertex/src/comphep.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/comphep.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/comphep.ml (revision 8717)
@@ -1,511 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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 = Modeltools.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_to_TeX = M.flavor_to_TeX
- 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_to_TeX = flavor_to_TeX
- 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 = Modeltools.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_to_TeX:(fun f ->
- flavors.(clamp_flavor "flavor_to_TeX" 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/hgg-vertex/src/cascade_lexer.mll
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/cascade_lexer.mll (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/cascade_lexer.mll (revision 8717)
@@ -1,55 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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/hgg-vertex/src/thoGMenu.mli
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/thoGMenu.mli (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/thoGMenu.mli (revision 8717)
@@ -1,90 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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/hgg-vertex/src/rCS.mli
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/rCS.mli (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/rCS.mli (revision 8717)
@@ -1,69 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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/hgg-vertex/src/thoGWindow.mli
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/thoGWindow.mli (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/thoGWindow.mli (revision 8717)
@@ -1,34 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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/hgg-vertex/src/test_linalg.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/test_linalg.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/test_linalg.ml (revision 8717)
@@ -1,73 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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/hgg-vertex/src/combinatorics.mli
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/combinatorics.mli (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/combinatorics.mli (revision 8717)
@@ -1,163 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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/hgg-vertex/src/model_file.mli
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/model_file.mli (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/model_file.mli (revision 8717)
@@ -1,32 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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/hgg-vertex/src/model_lexer.mll
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/model_lexer.mll (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/model_lexer.mll (revision 8717)
@@ -1,58 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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/hgg-vertex/src/omega_logo.mp
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/omega_logo.mp (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/omega_logo.mp (revision 8717)
@@ -1,501 +0,0 @@
-% $Id$
-%
-% Copyright (C) 1999-2009 by
-%
-% Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
-% Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
-% Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-%
-% 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]<t[j]|
-% whenever |i<j|. Also |t[n]-t[1]| should be less than the length of |p|.
-% The |adj_fill| macro takes four lists of time values given as indices into
-% the |t| array. The avoids the necessity of writing \MF\ macros to sort
-% the time values.
-% Groups of paths are allowed to have points ``tied together.'' This is
-% implemented by saving coordinates in a special array of type |pair|
-% called |tiept|. If a path contains a point that is tied to a point in
-% an already computed path, then the adjusted coordinates of that point will
-% be saved in the |tiept| array. This array should be made unknown before
-% starting a new group of paths; e.g., in |beginchar|.
-
-
-% Make |y'a| and |y'b| rounded versions of |y.a| and |y.b|, so that
-% |y'a-y'b| is as close as possible to |y.a-y.b|.
-% If a time value is given as both fixed and vertical or horizontal then
-% |y'a| or |y'b| or both may already be known. Then we just round what
-% we can.
-
-vardef rnd_pr_y(suffix a, b) =
- if known y'a: if unknown y'b: y'b-y'a=round(y.b-y.a); fi
- elseif known y'b: y'b-y'a=round(y.b-y.a);
- else:
- y'a-y'b = round(y.a-y.b);
- y'a = round(.5(y.a + y.b + y'a - y'b));
- fi
-enddef;
-
-% Rounding |x| coordinates is similar except we use the special |stem_round|
-% routine.
-
-vardef rnd_pr_x(suffix a, b) =
-% use the next line if you want to see what channel settings are reasonable
-% (also set tracingtitles:=1 in such a case)
-% message decimal t.a&","&decimal t.b&":"&decimal((x.b-x.a)/h);
- if known x'a: if unknown x'b: x'b-x'a=stem_round(x.b-x.a); fi
- elseif known x'b: x'b-x'a=stem_round(x.b-x.a);
- else:
- x'a-x'b = stem_round(x.a-x.b);
- x'a = round(.5(x.a + x.b + x'a - x'b));
- fi
-enddef;
-
-
-
-% Set up a transform |curtx=tx.a| that takes |x.a| into |x'a| and |x.b|
-% into |x'b| without slanting or changing $y$-components.
-
-vardef set_tx(suffix a,b) =
- save u,v;
- xypart tx.a = yxpart tx.a = 0;
- (x.a,0) transformed tx.a = (x'a,0);
- (u,v) = (x.b,1) transformed tx.a - (x'b,1);
- if known u: xxpart tx.a = yypart tx.a = 1;
- else: (u,v)=origin;
- fi
- curtx := tx.a
-enddef;
-
-
-% Set up a transform |curty=ty.a| that takes |y.a| into |y'a| and |y.b|
-% into |y'b| without slanting or changing $x$-components.
-
-vardef set_ty(suffix a,b) =
- save u,v;
- xypart ty.a = yxpart ty.a = 0;
- (0,y.a) transformed ty.a = (0,y'a);
- (u,v) = (1,y.b) transformed ty.a - (1,y'b);
- if known v: xxpart ty.a = yypart ty.a = 1;
- else: (u,v)=origin;
- fi
- curty := ty.a
-enddef;
-
-
-% The following macros ensure that |x'i| or |y'i| agree with the current
-% transform. It is important that this be done for all relevant |i| each
-% time |set_tx| or |set_ty| is called. Since some points may be tied to
-% others, this can affect which |x'j| and |y'j| are known. Future calls to
-% |set_tx| and |set_ty| should be based on the most up to date possible
-% information.
-
-vardef yset@# = (0,y'@#) = (0,y@#) transformed curty; enddef;
-vardef xset@# = (x'@#,0) = (x@#,0) transformed curtx; enddef;
-
-
-% Apply |set_txy| to each pair indices |a,b| such that |xy'[a]| and |xy'[b]|
-% are known, but |xy'[c] is unknown for all |c| between |a| and |b|.
-% This leaves the appropriate initial transformation in |curtx| or |curty|.
-% The |xyset| parameter is either |xset| or |yset| as explained above.
-
-vardef set_trans(suffix xy, set_txy, xyset) =
- save previ, firsti;
- for i=1 upto n: if known xy'[i]:
- if known firsti:
- set_txy([previ], [i]);
- for j=previ+1 upto i-1: xyset[j]; endfor
- else: firsti = i;
- fi
- previ := i;
- fi endfor
- if known firsti:
- for i=1 upto firsti: if known xy'[i]:
- set_txy([previ], [i]);
- if previ>=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 a<b: a else: b fi
- endgroup
-enddef;
-
-
-% Adjust the time value |tt| to the nearest time when the direction of |p_path|
-% is |dir| or |-dir|.
-
-vardef adj_t(suffix tt)(expr dir) =
- save p, a, b; path p;
- p = subpath (tt,tt+nn) of p_path & cycle;
- a = extremetime dir of p;
- a := if a<1: a[tt,floor tt+1] else: a+floor tt fi;
- b = extremetime dir of reverse p;
- b := if b<1: b[tt,ceiling tt-1] else: ceiling tt - b fi;
- tt := if b+a>2tt: 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/hgg-vertex/src/linalg.mli
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/linalg.mli (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/linalg.mli (revision 8717)
@@ -1,41 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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/hgg-vertex/src/product.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/product.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/product.ml (revision 8717)
@@ -1,122 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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/hgg-vertex/src/omega.tex
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/omega.tex (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/omega.tex (revision 8717)
@@ -1,1099 +0,0 @@
-% $Id$
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\NeedsTeXFormat{LaTeX2e}
-\RequirePackage{ifpdf}
-\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}
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%% allow VERY overfull hboxes
-\setlength{\hfuzz}{5cm}
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\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~1999-2009 by
- \begin{itemize}
- \item Wolfgang~Kilian ~\texttt{<kilian@hep.physik.uni-siegen.de>}
- \item Thorsten~Ohl~\texttt{<ohl@physik.uni-wuerzburg.de>}
- \item J\"urgen~Reuter~\texttt{<juergen.reuter@physik.uni-freiburg.de>}
- \end{itemize}
-\end{quote}
-\begin{quote}
- 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.
-\end{quote}
-\begin{quote}
- WHIZARD 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}
-\label{sec:colorize}
-\module{colorize}
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\chapter{Processes}
-\label{sec:process}
-\module{process}
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\chapter{Vertices}
-\label{sec:vertex}
-\begin{dubious}
- Temporarily disabled, until, we implement some conditional weaving\ldots
-\end{dubious}
-%%% \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}
-\begin{dubious}
- Temporarily disabled, until, we implement some conditional weaving\ldots
-\end{dubious}
-%%% \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{omega_Phi3}
-%application{omega_Phi3h}
-%application{omega_Phi4}
-%application{omega_Phi4h}
-\application{omega_QED}
-\application{omega_QCD}
-%application{omega_SM3}
-%application{omega_SM3_ac}
-\application{omega_SM}
-%application{omega_SM_ac}
-%application{f90Maj_SM}
-%application{f90Maj_SM4}
-%application{omega_MSSM}
-%application{omega_MSSM_g}
-%application{omega_SM_Rxi}
-%application{omega_SM_clones}
-%application{omega_2HDM}
-%application{omega_SMh}
-%application{omega_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{Cache Files}
-\label{sec:cache}
-\module{cache}
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\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{(Fiber) Bundles}
-\label{sec:bundle}
-\module{bundle}
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\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}.
-\begin{dubious}
- Temporarily disabled, until, we implement some conditional weaving\ldots
-\end{dubious}
-%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/hgg-vertex/src/tree2.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/tree2.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/tree2.ml (revision 8717)
@@ -1,52 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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. *)
-
-(* Dependency trees for wavefunctions. *)
-
-type 'n t =
- | Node of ('n * 'n t list) list
- | Leaf of 'n
-
-let leaf node = Leaf node
-
-let sort_children (node, children) = (node, List.sort compare children)
-
-let cons fusions = Node (List.sort compare (List.map sort_children fusions))
-
-let rec to_string n2s = function
- | Leaf n -> n2s n
- | Node children ->
- "{" ^
- String.concat ","
- (List.map
- (fun (n, ch_list) ->
- n2s n ^ "<(" ^ (String.concat ";" (List.map (to_string n2s) ch_list)) ^ ")")
- children) ^
- "}"
-
-(*i
- * Local Variables:
- * mode:caml
- * indent-tabs-mode:nil
- * page-delimiter:"^(\\* .*\n"
- * End:
-i*)
Index: branches/ohl/omega-development/hgg-vertex/src/modeltools.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/modeltools.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/modeltools.ml (revision 8717)
@@ -1,377 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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 "Modeltools" ["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_to_TeX, flavor_to_TeX =
- declare (fun f -> unitialized "flavor_to_TeX")
- 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_to_TeX, flavor_sans_color_to_TeX =
- declare (fun f -> unitialized "flavor_sans_color_to_TeX")
- 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_to_TeX ~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_to_TeX flavor_to_TeX;
- 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_to_TeX flavor_to_TeX;
- 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
-
-(*i
- * Local Variables:
- * mode:caml
- * indent-tabs-mode:nil
- * page-delimiter:"^(\\* .*\n"
- * End:
-i*)
-
Index: branches/ohl/omega-development/hgg-vertex/src/bundle.mli
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/bundle.mli (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/bundle.mli (revision 8717)
@@ -1,71 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2010 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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 Projection =
- sig
-
- type elt
- val compare_elt : elt -> elt -> int
-
- type base
- val compare_base : base -> base -> int
-
- (* $\pi: E \to B$ *)
- val pi : elt -> base
-
- end
-
-module type T =
- sig
-
- type t
-
- type elt
- type fiber = elt list
- type base
-
- val of_list : elt list -> t
-
- (* $\pi: E \to B$ *)
- val pi : elt -> base
-
- (* $\pi^{-1}: B \to E$ *)
- val inv_pi : base -> t -> fiber
-
- val base : t -> base list
-
- (* $\pi^{-1}\circ\pi$ *)
- val fiber : elt -> t -> fiber
-
- val fibers : t -> (base * fiber) list
- end
-
-module Make (P : Projection) : T with type elt = P.elt and type base = P.base
-
-
-(*i
- * Local Variables:
- * mode:caml
- * indent-tabs-mode:nil
- * page-delimiter:"^(\\* .*\n"
- * End:
-i*)
Index: branches/ohl/omega-development/hgg-vertex/src/targets.mli
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/targets.mli (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/targets.mli (revision 8717)
@@ -1,44 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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/hgg-vertex/src/phasespace.mli
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/phasespace.mli (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/phasespace.mli (revision 8717)
@@ -1,63 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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/hgg-vertex/src/modules.attrib
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/modules.attrib (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/modules.attrib (revision 8717)
@@ -1,67 +0,0 @@
-# $Id$
-
-### 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="{{<f77>Fortran77|<f90>Fortran|<helas>Helas}|{<c>C|<cpp>C++|<java>Java}|{<ocaml>O'Caml|<form>Form|<latex>LaTeX|...}|Targets}"]; \
-"Models" [shape=record,label="{{<qed>QED|<qcd>QCD|<sm>SM}|{<mssm>MSSM|<user>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/hgg-vertex/src/modellib_MSSM.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/modellib_MSSM.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/modellib_MSSM.ml (revision 8717)
@@ -1,2597 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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. *)
-
-(* $Id$ *)
-
-let rcs_file = RCS.parse "Models2" ["Supersymmetric Models"]
- { 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
- val gravitino : bool
- end
-
-module MSSM_no_goldstone : MSSM_flags =
- struct
- let include_goldstone = false
- let include_four = true
- let ckm_present = false
- let gravitino = false
- end
-
-module MSSM_goldstone : MSSM_flags =
- struct
- let include_goldstone = true
- let include_four = true
- let ckm_present = false
- let gravitino = false
- end
-
-module MSSM_no_4 : MSSM_flags =
- struct
- let include_goldstone = false
- let include_four = false
- let ckm_present = false
- let gravitino = false
- end
-
-module MSSM_no_4_ckm : MSSM_flags =
- struct
- let include_goldstone = false
- let include_four = false
- let ckm_present = true
- let gravitino = false
- end
-
-module MSSM_Grav : MSSM_flags =
- struct
- let include_goldstone = false
- let include_four = false
- let ckm_present = false
- let gravitino = 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 | Grino
- | 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.gravitino then external_flavors'' @ ["Gravitino", [Grino]]
- else
- external_flavors''
- 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
-(*i | Ga -> Ward_Vector i*)
- | 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
- | Grino -> Vectorspinor
-
- 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
- | 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 | Neutralino _ -> Prop_Majorana
- | Grino -> Only_Insertion
-
-(* Note, that we define the gravitino only as an insertion since when using propagators
- we are effectively going to a higher order in the gravitational coupling. This would
- enforce us to also include higher-dimensional vertices with two gravitinos for
- a consistent power counting in $1/M_{\text{Planck}}$. *)
-
-(*i | Grino -> Prop_Vectorspinor i*)
-
-(* 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
- | Grino -> Grino
- | Neutralino n -> Neutralino n | Chargino c -> Chargino (conj_char c)
-
- 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 | Grino -> 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
- | 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
- | G_Grav | G_Gr_Ch of char | G_Gr_Z_Neu of neu
- | G_Gr_A_Neu of neu | G_Gr4_Neu of neu
- | G_Gr4_A_Ch of char | G_Gr4_Z_Ch of char
- | G_Grav_N | G_Grav_U of int*sfm | G_Grav_D of int*sfm
- | G_Grav_L of int*sfm | G_Grav_Uc of int*sfm | G_Grav_Dc of int*sfm
- | G_Grav_Lc of int*sfm | G_GravGl
- | G_Gr_H_Ch of char | G_Gr_H1_Neu of neu
- | G_Gr_H2_Neu of neu | G_Gr_H3_Neu of neu
- | G_Gr4A_Sl of int*sfm | G_Gr4A_Slc of int*sfm
- | G_Gr4A_Su of int*sfm | G_Gr4A_Suc of int*sfm
- | G_Gr4A_Sd of int*sfm | G_Gr4A_Sdc of int*sfm
- | G_Gr4Z_Sn | G_Gr4Z_Snc
- | G_Gr4Z_Sl of int*sfm | G_Gr4Z_Slc of int*sfm
- | G_Gr4Z_Su of int*sfm | G_Gr4Z_Suc of int*sfm
- | G_Gr4Z_Sd of int*sfm | G_Gr4Z_Sdc of int*sfm
- | G_Gr4W_Sl of int*sfm | G_Gr4W_Slc of int*sfm
- | G_Gr4W_Su of int*sfm | G_Gr4W_Suc of int*sfm
- | G_Gr4W_Sd of int*sfm | G_Gr4W_Sdc of int*sfm
- | G_Gr4W_Sn | G_Gr4W_Snc
- | G_Gr4Gl_Su of int*sfm | G_Gr4Gl_Suc of int*sfm
- | G_Gr4Gl_Sd of int*sfm | G_Gr4Gl_Sdc of int*sfm
- | G_Gr4_Z_H1 of neu | G_Gr4_Z_H2 of neu | G_Gr4_Z_H3 of neu
- | G_Gr4_W_H of neu | G_Gr4_W_Hc of neu | G_Gr4_H_A of char
- | G_Gr4_H_Z of char
-
- 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 = Modeltools.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)]
-
-
-(* The gravitino coupling is generically $1/(4 M_{Pl.})$ *)
-
-(*** Triple vertices containing graivitinos. ***)
- let triple_gravitino' g =
- [ ((Grino, Sneutrino (-g), N g), GBG (1, Gravbar, Coupling.SL, Psi), G_Grav_N);
- ((N (-g), Sneutrino g, Grino), GBG (1, Psibar, Coupling.SL, Grav), G_Grav_N)]
-
- let triple_gravitino'' g m =
- [ ((Grino, Slepton (m, -g), L g), GBG (1, Gravbar, SLR, Psi), G_Grav_L (g,m));
- ((L (-g), Slepton (m, g), Grino), GBG (1, Psibar, SLR, Grav), G_Grav_Lc (g,m));
- ((Grino, Sup (m, -g), U g), GBG (1, Gravbar, SLR, Psi), G_Grav_U (g,m));
- ((U (-g), Sup (m, g), Grino), GBG (1, Psibar, SLR, Grav), G_Grav_Uc (g,m));
- ((Grino, Sdown (m, -g), D g), GBG (1, Gravbar, SLR, Psi), G_Grav_D (g,m));
- ((D (-g), Sdown (m, g), Grino), GBG (1, Psibar, SLR, Grav), G_Grav_Dc (g,m)) ]
-
- let higgs_ch_gravitino c =
- let cc = conj_char c in
- [ ((Grino, Hm, Chargino c), GBG (1, Gravbar, SLR, Psi), G_Gr_H_Ch c);
- ((Chargino cc, Hp, Grino), GBG (1, Psibar, SLR, Grav), G_Gr_H_Ch cc) ]
-
- let higgs_neu_gravitino n =
- [ ((Grino, H_Light, Neutralino n), GBG (1, Gravbar, SLR, Chi), G_Gr_H1_Neu n);
- ((Grino, H_Heavy, Neutralino n), GBG (1, Gravbar, SLR, Chi), G_Gr_H2_Neu n);
- ((Grino, A, Neutralino n), GBG (1, Gravbar, SLR, Chi), G_Gr_H3_Neu n) ]
-
- let gravitino_gaugino_3 =
- [ ((Grino, Gl, Gluino), GBG (1, Gravbar, V, Chi), G_Grav);
- ((Gluino, Gl, Grino), GBG (1, Chibar, V, Grav), G_Grav);
- ((Chargino C1c, Wp, Grino), GBG (1, Psibar, VLR, Grav), G_Gr_Ch C1);
- ((Chargino C2c, Wp, Grino), GBG (1, Psibar, VLR, Grav), G_Gr_Ch C2);
- ((Grino, Wm, Chargino C1), GBG (1, Gravbar, VLR, Psi), G_Gr_Ch C1c);
- ((Grino, Wm, Chargino C2), GBG (1, Gravbar, VLR, Psi), G_Gr_Ch C2c);
- ((Grino, Z, Neutralino N1), GBG (1, Gravbar, VLR, Chi), G_Gr_Z_Neu N1);
- ((Grino, Z, Neutralino N2), GBG (1, Gravbar, VLR, Chi), G_Gr_Z_Neu N2);
- ((Grino, Z, Neutralino N3), GBG (1, Gravbar, VLR, Chi), G_Gr_Z_Neu N3);
- ((Grino, Z, Neutralino N4), GBG (1, Gravbar, VLR, Chi), G_Gr_Z_Neu N4);
- ((Grino, Ga, Neutralino N1), GBG (1, Gravbar, VLR, Chi), G_Gr_A_Neu N1);
- ((Grino, Ga, Neutralino N2), GBG (1, Gravbar, VLR, Chi), G_Gr_A_Neu N2);
- ((Grino, Ga, Neutralino N3), GBG (1, Gravbar, VLR, Chi), G_Gr_A_Neu N3);
- ((Grino, Ga, Neutralino N4), GBG (1, Gravbar, VLR, Chi), G_Gr_A_Neu N4) ]
-
- let triple_gravitino =
- ThoList.flatmap triple_gravitino' [1;2;3] @
- List.flatten (Product.list2 triple_gravitino'' [1;2;3] [M1; M2]) @
- ThoList.flatmap higgs_ch_gravitino [C1; C2] @
- ThoList.flatmap higgs_neu_gravitino [N1; N2; N3; N4] @
- gravitino_gaugino_3
-
-
-(*** 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 quartic_grav_gauge g m =
- [ ((Grino, Slepton (m, -g), Ga, L g), GBBG (1, Gravbar, SLRV, Psi), G_Gr4A_Sl (g,m));
- ((L (-g), Slepton (m, g), Ga, Grino), GBBG (1, Psibar, SLRV, Grav), G_Gr4A_Slc (g,m));
- ((Grino, Sup (m, -g), Ga, U g), GBBG (1, Gravbar, SLRV, Psi), G_Gr4A_Su (g,m));
- ((U (-g), Sup (m, g), Ga, Grino), GBBG (1, Psibar, SLRV, Grav), G_Gr4A_Suc (g,m));
- ((Grino, Sdown (m, -g), Ga, D g), GBBG (1, Gravbar, SLRV, Psi), G_Gr4A_Sd (g,m));
- ((D (-g), Sdown (m, g), Ga, Grino), GBBG (1, Psibar, SLRV, Grav), G_Gr4A_Sdc (g,m));
- ((Grino, Slepton (m, -g), Z, L g), GBBG (1, Gravbar, SLRV, Psi), G_Gr4Z_Sl (g,m));
- ((L (-g), Slepton (m, g), Z, Grino), GBBG (1, Psibar, SLRV, Grav), G_Gr4Z_Slc (g,m));
- ((Grino, Sup (m, -g), Z, U g), GBBG (1, Gravbar, SLRV, Psi), G_Gr4Z_Su (g,m));
- ((U (-g), Sup (m, g), Z, Grino), GBBG (1, Psibar, SLRV, Grav), G_Gr4Z_Suc (g,m));
- ((Grino, Sdown (m, -g), Z, D g), GBBG (1, Gravbar, SLRV, Psi), G_Gr4Z_Sd (g,m));
- ((D (-g), Sdown (m, g), Z, Grino), GBBG (1, Psibar, SLRV, Grav), G_Gr4Z_Sdc (g,m));
- ((Grino, Sup (m, -g), Gl, U g), GBBG (1, Gravbar, SLRV, Psi), G_Gr4Gl_Su (g,m));
- ((U (-g), Sup (m, g), Gl, Grino), GBBG (1, Psibar, SLRV, Grav), G_Gr4Gl_Suc (g,m));
- ((Grino, Sdown (m, -g), Gl, D g), GBBG (1, Gravbar, SLRV, Psi), G_Gr4Gl_Sd (g,m));
- ((D (-g), Sdown (m, g), Gl, Grino), GBBG (1, Psibar, SLRV, Grav), G_Gr4Gl_Sdc (g,m));
- ((Grino, Slepton (m, -g), Wp, N g), GBBG (1, Gravbar, SLV, Psi), G_Gr4W_Sl (g,m));
- ((N (-g), Slepton (m, g), Wm, Grino), GBBG (1, Psibar, SLV, Grav), G_Gr4Z_Slc (g,m));
- ((Grino, Sup (m, -g), Wp, D g), GBBG (1, Gravbar, SLV, Psi), G_Gr4W_Su (g,m));
- ((D (-g), Sup (m, g), Wm, Grino), GBBG (1, Psibar, SLV, Grav), G_Gr4W_Suc (g,m));
- ((Grino, Sdown (m, -g), Wm, U g), GBBG (1, Gravbar, SLV, Psi), G_Gr4W_Sd (g,m));
- ((U (-g), Sdown (m, g), Wp, Grino), GBBG (1, Psibar, SLV, Grav), G_Gr4W_Sdc (g,m)) ]
-
- let quartic_grav_sneutrino g =
- [ ((Grino, Sneutrino (-g), Z, N g), GBBG (1, Gravbar, SLV, Psi), G_Gr4Z_Sn);
- ((N (-g), Sneutrino g, Z, Grino), GBBG (1, Psibar, SLV, Grav), G_Gr4Z_Snc);
- ((Grino, Sneutrino (-g), Wp, L g), GBBG (1, Gravbar, SLV, Psi), G_Gr4W_Sn);
- ((L (-g), Sneutrino g, Wm, Grino), GBBG (1, Psibar, SLV, Grav), G_Gr4W_Snc) ]
-
- let quartic_grav_neu n =
- [ ((Grino, Wp, Wm, Neutralino n), GBBG (1, Gravbar, V2LR, Chi), G_Gr4_Neu n);
- ((Grino, H_Light, Z, Neutralino n), GBBG (1, Gravbar, SLRV, Chi), G_Gr4_Z_H1 n);
- ((Grino, H_Heavy, Z, Neutralino n), GBBG (1, Gravbar, SLRV, Chi), G_Gr4_Z_H2 n);
- ((Grino, A, Z, Neutralino n), GBBG (1, Gravbar, SLRV, Chi), G_Gr4_Z_H3 n);
- ((Grino, Hm, Wp, Neutralino n), GBBG (1, Gravbar, SLRV, Chi), G_Gr4_W_H n);
- ((Grino, Hp, Wm, Neutralino n), GBBG (1, Gravbar, SLRV, Chi), G_Gr4_W_Hc n) ]
-
- let quartic_grav_char c =
- let cc = conj_char c in
- [ ((Grino, Wm, Ga, Chargino c), GBBG (1, Gravbar, V2LR, Psi), G_Gr4_A_Ch c);
- ((Grino, Wm, Z, Chargino c), GBBG (1, Gravbar, V2LR, Psi), G_Gr4_Z_Ch c);
- ((Chargino cc, Wp, Ga, Grino), GBBG ((-1), Psibar, V2LR, Grav), G_Gr4_A_Ch cc);
- ((Chargino cc, Wp, Z, Grino), GBBG ((-1), Psibar, V2LR, Grav), G_Gr4_Z_Ch cc);
- ((Grino, Hm, Ga, Chargino c), GBBG (1, Gravbar, SLRV, Psi), G_Gr4_H_A c);
- ((Chargino cc, Hp, Ga, Grino), GBBG (1, Psibar, SLRV, Grav), G_Gr4_H_A cc);
- ((Grino, Hm, Z, Chargino c), GBBG (1, Gravbar, SLRV, Psi), G_Gr4_H_Z c);
- ((Chargino cc, Hp, Z, Grino), GBBG (1, Psibar, SLRV, Grav), G_Gr4_H_Z cc)]
-
- let quartic_gravitino =
- [ ((Grino, Gl, Gl, Gluino), GBBG (1, Gravbar, V2, Chi), G_GravGl)] @
- ThoList.flatmap quartic_grav_neu [N1; N2; N3; N4] @
- ThoList.flatmap quartic_grav_char [C1; C2] @
- List.flatten (Product.list2 quartic_grav_gauge [1; 2; 3] [M1; M2]) @
- ThoList.flatmap quartic_grav_sneutrino [1; 2; 3]
-
- let vertices3'' =
- if Flags.ckm_present then
- (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]) @
- 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)] @
- 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 @
- List.flatten (Product.list2 higgs_charg_neutr [N1;N2;N3;N4] [C1;C2]) @
- higgs_neutr @ higgs_sneutrino @ higgs_sfermion @
- higgs_squark @ yukawa_v @
- ThoList.flatmap col_currents [1;2;3] @
- List.flatten (Product.list2 col_sfermion_currents [1;2;3] [M1;M2]))
- else
- (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]) @
- 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)] @
- 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 @
- List.flatten (Product.list2 higgs_charg_neutr [N1;N2;N3;N4] [C1;C2]) @
- higgs_neutr @ higgs_sneutrino @ higgs_sfermion @
- higgs_squark @ yukawa_v @
- ThoList.flatmap col_currents [1;2;3] @
- List.flatten (Product.list2 col_sfermion_currents [1;2;3] [M1;M2]))
-
-
-(*i OLD VERSION !!!!!!!!!!!!!!!!!!!!!
- 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]) @
- ThoList.flatmap yukawa_higgs_quark [(3,3)] @
- (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]))
-i*)
-
-
- let vertices3' =
- if Flags.gravitino then (vertices3'' @ triple_gravitino)
- else vertices3''
- 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.gravitino then (vertices4''' @ quartic_gravitino)
- else vertices4'''
- 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
- | "GR" -> Grino
- | _ -> 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"
- | L _ -> invalid_arg
- "Models.MSSM.flavor_to_string: invalid lepton"
- | N _ -> invalid_arg
- "Models.MSSM.flavor_to_string: invalid neutrino"
- | 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"
- | Slepton _ -> invalid_arg
- "Models.MSSM.flavor_to_string: invalid slepton"
- | Sneutrino _ -> invalid_arg
- "Models.MSSM.flavor_to_string: invalid sneutrino"
- | Sup _ -> invalid_arg
- "Models.MSSM.flavor_to_string: invalid up type squark"
- | Sdown _ -> invalid_arg
- "Models.MSSM.flavor_to_string: invalid down type squark"
- | Chargino C1 -> "ch1+" | Chargino C1c -> "ch1-"
- | Chargino C2 -> "ch2+" | Chargino C2c -> "ch2-"
- | Grino -> "GR"
-
- 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" | Grino -> "gv"
-
- let flavor_to_TeX = function
- | L 1 -> "e^-" | L (-1) -> "e^+"
- | L 2 -> "\\mu^-" | L (-2) -> "\\mu^+"
- | L 3 -> "\\tau^-" | L (-3) -> "\\tau^+"
- | N 1 -> "\\nu_e" | N (-1) -> "\\bar{\\nu}_e"
- | N 2 -> "\\nu_\\mu" | N (-2) -> "\\bar{\\nu}_\\mu"
- | N 3 -> "\\nu_\\tau" | N (-3) -> "\\bar{\\nu}_\\tau"
- | U 1 -> "u" | U (-1) -> "\\bar{u}"
- | U 2 -> "c" | U (-2) -> "\\bar{c}"
- | U 3 -> "t" | U (-3) -> "\\bar{t}"
- | D 1 -> "d" | D (-1) -> "\\bar{d}"
- | D 2 -> "s" | D (-2) -> "\\bar{s}"
- | D 3 -> "b" | D (-3) -> "\\bar{b}"
- | L _ -> invalid_arg
- "Models.MSSM.flavor_to_TeX: invalid lepton"
- | N _ -> invalid_arg
- "Models.MSSM.flavor_to_TeX: invalid neutrino"
- | U _ -> invalid_arg
- "Models.MSSM.flavor_to_TeX: invalid up type quark"
- | D _ -> invalid_arg
- "Models.MSSM.flavor_to_TeX: invalid down type quark"
- | Gl -> "g" | Gluino -> "\\widetilde{g}"
- | Ga -> "\\gamma" | Z -> "Z" | Wp -> "W^+" | Wm -> "W^-"
- | Phip -> "\\phi^+" | Phim -> "\\phi^-" | Phi0 -> "\\phi^0"
- | H_Heavy -> "H^0" | H_Light -> "h^0" | A -> "A^0"
- | Hp -> "H^+" | Hm -> "H^-"
- | Slepton (M1,1) -> "\\widetilde{e}_1^-"
- | Slepton (M1,-1) -> "\\widetilde{e}_1^+"
- | Slepton (M1,2) -> "\\widetilde{\\mu}_1^-"
- | Slepton (M1,-2) -> "\\widetilde{\\mu}_1^+"
- | Slepton (M1,3) -> "\\widetilde{\\tau}_1^-"
- | Slepton (M1,-3) -> "\\widetilde{\\tau}_1^+"
- | Slepton (M2,1) -> "\\widetilde{e}_2^-"
- | Slepton (M2,-1) -> "\\widetilde{e}_2^+"
- | Slepton (M2,2) -> "\\widetilde{\\mu}_2^-"
- | Slepton (M2,-2) -> "\\widetilde{\\mu}_2^+"
- | Slepton (M2,3) -> "\\widetilde{\\tau}_2^-"
- | Slepton (M2,-3) -> "\\widetilde{\\tau}_2^+"
- | Sneutrino 1 -> "\\widetilde{\\nu}_e"
- | Sneutrino (-1) -> "\\widetilde{\\nu}_e^*"
- | Sneutrino 2 -> "\\widetilde{\\nu}_\\mu"
- | Sneutrino (-2) -> "\\widetilde{\\nu}_\\mu^*"
- | Sneutrino 3 -> "\\widetilde{\\nu}_\\tau"
- | Sneutrino (-3) -> "\\widetilde{\\nu}_\\tau^*"
- | Sup (M1,1) -> "\\widetilde{u}_1"
- | Sup (M1,-1) -> "\\widetilde{u}_1^*"
- | Sup (M1,2) -> "\\widetilde{c}_1"
- | Sup (M1,-2) -> "\\widetilde{c}_1^*"
- | Sup (M1,3) -> "\\widetilde{t}_1"
- | Sup (M1,-3) -> "\\widetilde{t}_1^*"
- | Sup (M2,1) -> "\\widetilde{u}_2"
- | Sup (M2,-1) -> "\\widetilde{u}_2^*"
- | Sup (M2,2) -> "\\widetilde{c}_2"
- | Sup (M2,-2) -> "\\widetilde{c}_2^*"
- | Sup (M2,3) -> "\\widetilde{t}_2"
- | Sup (M2,-3) -> "\\widetilde{t}_2^*"
- | Sdown (M1,1) -> "\\widetilde{d}_1"
- | Sdown (M1,-1) -> "\\widetilde{d}_1^*"
- | Sdown (M1,2) -> "\\widetilde{s}_1"
- | Sdown (M1,-2) -> "\\widetilde{s}_1^*"
- | Sdown (M1,3) -> "\\widetilde{b}_1"
- | Sdown (M1,-3) -> "\\widetilde{b}_1^*"
- | Sdown (M2,1) -> "\\widetilde{d}_2"
- | Sdown (M2,-1) -> "\\widetilde{d}_2^*"
- | Sdown (M2,2) -> "\\widetilde{s}_2"
- | Sdown (M2,-2) -> "\\widetilde{s}_2^*"
- | Sdown (M2,3) -> "\\widetilde{b}_2"
- | Sdown (M2,-3) -> "\\widetilde{b}_2^*"
- | Neutralino N1 -> "\\widetilde{\\chi}^0_1"
- | Neutralino N2 -> "\\widetilde{\\chi}^0_2"
- | Neutralino N3 -> "\\widetilde{\\chi}^0_3"
- | Neutralino N4 -> "\\widetilde{\\chi}^0_4"
- | Slepton _ -> invalid_arg
- "Models.MSSM.flavor_to_TeX: invalid slepton"
- | Sneutrino _ -> invalid_arg
- "Models.MSSM.flavor_to_TeX: invalid sneutrino"
- | Sup _ -> invalid_arg
- "Models.MSSM.flavor_to_TeX: invalid up type squark"
- | Sdown _ -> invalid_arg
- "Models.MSSM.flavor_to_TeX: invalid down type squark"
- | Chargino C1 -> "\\widetilde{\\chi}_1^+"
- | Chargino C1c -> "\\widetilde{\\chi}_1^-"
- | Chargino C2 -> "\\widetilde{\\chi}_2^+"
- | Chargino C2c -> "\\widetilde{\\chi}_2^-"
- | Grino -> "\\widetilde{G}"
-
- let flavor_sans_color_of_string = flavor_of_string
- let flavor_sans_color_to_string = flavor_to_string
- let flavor_sans_color_to_TeX = flavor_to_TeX
- 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
- | Grino -> 1000039
- | 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
- $\widetilde{\psi}_\mu$ & gravitino & 39 \\\hline\hline
- $\widetilde{d}_L$ & down-squark 1 & 41 \\\hline
- $\widetilde{u}_L$ & up-squark 1 & 42 \\\hline
- $\widetilde{s}_L$ & strange-squark 1 & 43 \\\hline
- $\widetilde{c}_L$ & charm-squark 1 & 44 \\\hline
- $\widetilde{b}_L$ & bottom-squark 1 & 45 \\\hline
- $\widetilde{t}_L$ & top-squark 1 & 46 \\\hline
- $\widetilde{d}_R$ & down-squark 2 & 47 \\\hline
- $\widetilde{u}_R$ & up-squark 2 & 48 \\\hline
- $\widetilde{s}_R$ & strange-squark 2 & 49 \\\hline
- $\widetilde{c}_R$ & charm-squark 2 & 50 \\\hline
- $\widetilde{b}_R$ & bottom-squark 2 & 51 \\\hline
- $\widetilde{t}_R$ & top-squark 2 & 52 \\\hline\hline
- $\widetilde{e}_L$ & selectron 1 & 53 \\\hline
- $\widetilde{\nu}_{e,L}$ & electron-sneutrino & 54 \\\hline
- $\widetilde{\mu}_L$ & smuon 1 & 55 \\\hline
- $\widetilde{\nu}_{\mu,L}$ & muon-sneutrino & 56 \\\hline
- $\widetilde{\tau}_L$ & stau 1 & 57 \\\hline
- $\widetilde{\nu}_{\tau,L}$ & tau-sneutrino & 58 \\\hline
- $\widetilde{e}_R$ & selectron 2 & 59 \\\hline
- $\widetilde{\mu}_R$ & smuon 2 & 61 \\\hline
- $\widetilde{\tau}_R$ & stau 2 & 63 \\\hline\hline
- $\widetilde{g}$ & gluino & 64 \\\hline
- $\widetilde{\chi}^0_1$ & neutralino 1 & 65 \\\hline
- $\widetilde{\chi}^0_2$ & neutralino 2 & 66 \\\hline
- $\widetilde{\chi}^0_3$ & neutralino 3 & 67 \\\hline
- $\widetilde{\chi}^0_4$ & neutralino 4 & 68 \\\hline
- $\widetilde{\chi}^+_1$ & chargino 1 & 69 \\\hline
- $\widetilde{\chi}^+_2$ & chargino 2 & 70 \\\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
- | Grino -> 39
- | 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_GH _ -> failwith "this G_GH coupling is not available"
- | 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_GH4 _ -> failwith "this G_GH4 coupling is not available"
- | 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
- | 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_GHGo4 _ -> failwith "Coupling G_GHGo4 is not available"
- | 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
- | G_Grav -> "ggrav" | G_Gr_Ch C1 -> "ggrch1" | G_Gr_Ch C2 -> "ggrch2"
- | G_Gr_Ch C1c -> "ggrch1c" | G_Gr_Ch C2c -> "ggrch2c"
- | G_Gr_Z_Neu n -> "ggrzneu" ^ string_of_neu n
- | G_Gr_A_Neu n -> "ggraneu" ^ string_of_neu n
- | G_Gr4_Neu n -> "ggr4neu" ^ string_of_neu n
- | G_Gr4_A_Ch C1 -> "ggr4ach1" | G_Gr4_A_Ch C2 -> "ggr4ach2"
- | G_Gr4_A_Ch C1c -> "ggr4ach1c" | G_Gr4_A_Ch C2c -> "ggr4ach2c"
- | G_Gr4_Z_Ch C1 -> "ggr4zch1" | G_Gr4_Z_Ch C2 -> "ggr4zch2"
- | G_Gr4_Z_Ch C1c -> "ggr4zch1c" | G_Gr4_Z_Ch C2c -> "ggr4zch2c"
- | G_Grav_N -> "ggravn"
- | G_GravGl -> "gs * ggrav"
- | G_Grav_L (g,m) -> "ggravl" ^ string_of_int g ^ string_of_sfm m
- | G_Grav_Lc (g,m) -> "ggravl" ^ string_of_int g ^ string_of_sfm m ^ "c"
- | G_Grav_U (g,m) -> "ggravu" ^ string_of_int g ^ string_of_sfm m
- | G_Grav_Uc (g,m) -> "ggravu" ^ string_of_int g ^ string_of_sfm m ^ "c"
- | G_Grav_D (g,m) -> "ggravd" ^ string_of_int g ^ string_of_sfm m
- | G_Grav_Dc (g,m) -> "ggravd" ^ string_of_int g ^ string_of_sfm m ^ "c"
- | G_Gr_H_Ch C1 -> "ggrhch1" | G_Gr_H_Ch C2 -> "ggrhch2"
- | G_Gr_H_Ch C1c -> "ggrhch1c" | G_Gr_H_Ch C2c -> "ggrhch2c"
- | G_Gr_H1_Neu n -> "ggrh1neu" ^ string_of_neu n
- | G_Gr_H2_Neu n -> "ggrh2neu" ^ string_of_neu n
- | G_Gr_H3_Neu n -> "ggrh3neu" ^ string_of_neu n
- | G_Gr4A_Sl (g,m) -> "ggr4asl" ^ string_of_int g ^ string_of_sfm m
- | G_Gr4A_Slc (g,m) -> "ggr4asl" ^ string_of_int g ^ string_of_sfm m ^ "c"
- | G_Gr4A_Su (g,m) -> "ggr4asu" ^ string_of_int g ^ string_of_sfm m
- | G_Gr4A_Suc (g,m) -> "ggr4asu" ^ string_of_int g ^ string_of_sfm m ^ "c"
- | G_Gr4A_Sd (g,m) -> "ggr4asd" ^ string_of_int g ^ string_of_sfm m
- | G_Gr4A_Sdc (g,m) -> "ggr4asd" ^ string_of_int g ^ string_of_sfm m ^ "c"
- | G_Gr4Z_Sn -> "ggr4zsn" | G_Gr4Z_Snc -> "ggr4zsnc"
- | G_Gr4Z_Sl (g,m) -> "ggr4zsl" ^ string_of_int g ^ string_of_sfm m
- | G_Gr4Z_Slc (g,m) -> "ggr4zsl" ^ string_of_int g ^ string_of_sfm m ^ "c"
- | G_Gr4Z_Su (g,m) -> "ggr4zsu" ^ string_of_int g ^ string_of_sfm m
- | G_Gr4Z_Suc (g,m) -> "ggr4zsu" ^ string_of_int g ^ string_of_sfm m ^ "c"
- | G_Gr4Z_Sd (g,m) -> "ggr4zsd" ^ string_of_int g ^ string_of_sfm m
- | G_Gr4Z_Sdc (g,m) -> "ggr4zsd" ^ string_of_int g ^ string_of_sfm m ^ "c"
- | G_Gr4W_Sl (g,m) -> "ggr4wsl" ^ string_of_int g ^ string_of_sfm m
- | G_Gr4W_Slc (g,m) -> "ggr4wsl" ^ string_of_int g ^ string_of_sfm m ^ "c"
- | G_Gr4W_Su (g,m) -> "ggr4wsu" ^ string_of_int g ^ string_of_sfm m
- | G_Gr4W_Suc (g,m) -> "ggr4wsu" ^ string_of_int g ^ string_of_sfm m ^ "c"
- | G_Gr4W_Sd (g,m) -> "ggr4wsd" ^ string_of_int g ^ string_of_sfm m
- | G_Gr4W_Sdc (g,m) -> "ggr4wsd" ^ string_of_int g ^ string_of_sfm m ^ "c"
- | G_Gr4Gl_Su (g,m) -> "ggr4glsu" ^ string_of_int g ^ string_of_sfm m
- | G_Gr4Gl_Suc (g,m) -> "ggr4glsu" ^ string_of_int g ^ string_of_sfm m ^ "c"
- | G_Gr4Gl_Sd (g,m) -> "ggr4glsd" ^ string_of_int g ^ string_of_sfm m
- | G_Gr4Gl_Sdc (g,m) -> "ggr4glsd" ^ string_of_int g ^ string_of_sfm m ^ "c"
- | G_Gr4_Z_H1 n -> "ggr4zh1_" ^ string_of_neu n
- | G_Gr4_Z_H2 n -> "ggr4zh2_" ^ string_of_neu n
- | G_Gr4_Z_H3 n -> "ggr4zh3_" ^ string_of_neu n
- | G_Gr4_W_H n -> "ggr4wh_" ^ string_of_neu n
- | G_Gr4_W_Hc n -> "ggr4whc_" ^ string_of_neu n
- | G_Gr4_H_A C1 -> "ggr4ha1" | G_Gr4_H_A C2 -> "ggr4ha2"
- | G_Gr4_H_A C1c -> "ggr4ha1c" | G_Gr4_H_A C2c -> "ggr4ha2c"
- | G_Gr4_H_Z C1 -> "ggr4hz1" | G_Gr4_H_Z C2 -> "ggr4hz2"
- | G_Gr4_H_Z C1c -> "ggr4hz1c" | G_Gr4_H_Z C2c -> "ggr4hz2c"
- | G_Gr4W_Sn -> "ggr4wsn"
- | G_Gr4W_Snc -> "ggr4wsnc"
-
- end
-
-(*i
- * Local Variables:
- * mode:caml
- * indent-tabs-mode:nil
- * page-delimiter:"^(\\* .*\n"
- * End:
-i*)
Index: branches/ohl/omega-development/hgg-vertex/src/modellib_SM.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/modellib_SM.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/modellib_SM.ml (revision 8717)
@@ -1,2891 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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 "Modellib_SM" ["Lagragians"]
- { RCS.revision = "$Revision$";
- RCS.date = "$Date$";
- RCS.author = "$Author$";
- RCS.source
- = "$URL$" }
-
-(* \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 = Modeltools.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_to_TeX 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_to_TeX = flavor_to_TeX
- 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 = Modeltools.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_to_TeX 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_to_TeX = flavor_to_TeX
- 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 = Modeltools.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_to_TeX = function
- | Electron -> "e^-" | Positron -> "e^+"
- | Muon -> "\\mu^-" | AntiMuon -> "\\mu^+"
- | Tau -> "^\\tau^-" | AntiTau -> "\\tau+^"
- | Photon -> "\\gamma"
-
- 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_to_TeX = flavor_to_TeX
- 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 = Modeltools.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_to_TeX = function
- | Quark -> "q"
- | Antiquark -> "\\bar{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_to_TeX = flavor_to_TeX
- 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 higgs_triangle : bool (* $H\gamma\gamma$, $Hg\gamma$ and $Hgg couplings *)
- 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 higgs_triangle = false
- 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 higgs_triangle = false
- 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 higgs_triangle = false
- 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 higgs_triangle = false
- 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 higgs_triangle = false
- let triple_anom = false
- let quartic_anom = true
- let higgs_anom = false
- let k_matrix = true
- let ckm_present = false
- end
-
-module SM_Hgg : SM_flags =
- struct
- let higgs_triangle = true
- let triple_anom = false
- let quartic_anom = false
- let higgs_anom = false
- let k_matrix = false
- 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 = Modeltools.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 higgs_triangle_vertices =
- if Flags.higgs_triangle then
- [ (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 ]
- else
- []
-
- 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 @ higgs_triangle_vertices @ 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_to_TeX = 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_TeX: invalid lepton"
- | N 1 -> "\\nu_e" | N (-1) -> "\\bar{\\nu}_e"
- | N 2 -> "\\nu_\\mu" | N (-2) -> "\\bar{\\nu}_\\mu"
- | N 3 -> "\\nu_\\tau" | N (-3) -> "\\bar{\\nu}_\\tau"
- | N _ -> invalid_arg
- "Models.SM3.flavor_to_TeX: invalid neutrino"
- | U 1 -> "u" | U (-1) -> "\\bar{u}"
- | U 2 -> "c" | U (-2) -> "\\bar{c}"
- | U 3 -> "t" | U (-3) -> "\\bar{t}"
- | U _ -> invalid_arg
- "Models.SM3.flavor_to_TeX: invalid up type quark"
- | D 1 -> "d" | D (-1) -> "\\bar{d}"
- | D 2 -> "s" | D (-2) -> "\\bar{s}"
- | D 3 -> "b" | D (-3) -> "\\bar{b}"
- | D _ -> invalid_arg
- "Models.SM3.flavor_to_TeX: invalid down type quark"
- end
- | G f ->
- begin match f with
- | Gl -> "g"
- | Ga -> "\\gamma" | 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_to_TeX = flavor_to_TeX
- 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 = Modeltools.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 higgs_triangle_vertices =
- if Flags.higgs_triangle then
- [ (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 ]
- else
- []
-
- 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 @ higgs_triangle_vertices
- @ 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_to_TeX = 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_TeX: invalid lepton"
- | N 1 -> "\\nu_e" | N (-1) -> "\\bar{\\nu}_e"
- | N 2 -> "\\nu_\\mu" | N (-2) -> "\\bar{\\nu}_\\mu"
- | N 3 -> "\\nu_\\tau" | N (-3) -> "\\bar{\\nu}_\\tau"
- | N _ -> invalid_arg
- "Models.SM.flavor_to_TeX: invalid neutrino"
- | U 1 -> "u" | U (-1) -> "\\bar{u}"
- | U 2 -> "c" | U (-2) -> "\\bar{c}"
- | U 3 -> "t" | U (-3) -> "\\bar{t}"
- | U _ -> invalid_arg
- "Models.SM.flavor_to_TeX: invalid up type quark"
- | D 1 -> "d" | D (-1) -> "\\bar{d}"
- | D 2 -> "s" | D (-2) -> "\\bar{s}"
- | D 3 -> "b" | D (-3) -> "\\bar{b}"
- | D _ -> invalid_arg
- "Models.SM.flavor_to_TeX: invalid down type quark"
- end
- | G f ->
- begin match f with
- | Gl -> "g"
- | Ga -> "\\gamma" | Z -> "Z"
- | Wp -> "W^+" | Wm -> "W^-"
- end
- | O f ->
- begin match f with
- | Phip -> "\\phi^+" | Phim -> "\\phi^-" | Phi0 -> "\\phi^0"
- | 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_to_TeX = flavor_to_TeX
- 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 = Modeltools.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_to_TeX = SM.flavor_to_TeX
- 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_to_TeX = SM.flavor_sans_color_to_TeX
- 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_to_TeX = function
- | M (_, g) as f -> format_generation g (M.flavor_to_TeX (project f))
- | f -> M.flavor_to_TeX (project f)
-
- let flavor_sans_color_of_string = flavor_of_string
- let flavor_sans_color_to_string = flavor_to_string
- let flavor_sans_color_to_TeX = flavor_to_TeX
- let flavor_symbol = flavor_symbol
-
- 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 = Modeltools.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/hgg-vertex/src/omega_MSSM.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/omega_MSSM.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/omega_MSSM.ml (revision 8717)
@@ -1,33 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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)
- (Modellib_MSSM.MSSM(Modellib_MSSM.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/hgg-vertex/src/process.mli
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/process.mli (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/process.mli (revision 8717)
@@ -1,75 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2010 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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
-
-(* \begin{dubious}
- Eventually this should become an abstract type:
- \end{dubious} *)
- type t = flavor list * flavor list
-
- val incoming : t -> flavor list
- val outgoing : t -> flavor list
-
-(* [parse_decay s] decodes a decay description ["a -> b c ..."], where
- each word is split into a bag of flavors separated by [':']s. *)
- type decay
- val parse_decay : string -> decay
- val expand_decays : decay list -> t list
-
-(* [parse_scattering s] decodes a scattering description ["a b -> c d ..."],
- where each word is split into a bag of flavors separated by [':']s. *)
- type scattering
- val parse_scattering : string -> scattering
- val expand_scatterings : scattering list -> t list
-
-(* [parse_process s] 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. *)
- type any
- type process = Any of any | Decay of decay | Scattering of scattering
- val parse_process : string -> process
-
- val remove_duplicate_final_states : t list -> t list
-
- val diff : t list -> t list -> t list
-
- end
-
-module Make (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/hgg-vertex/src/tuple.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/tuple.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/tuple.ml (revision 8717)
@@ -1,490 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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/hgg-vertex/src/cascade_syntax.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/cascade_syntax.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/cascade_syntax.ml (revision 8717)
@@ -1,106 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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/hgg-vertex/src/combinatorics.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/combinatorics.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/combinatorics.ml (revision 8717)
@@ -1,403 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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<n<|l|$ and handle the cases $n\in\{0,|l|\}$
- explicitely. Use reflection symmetry for a small optimization. *)
-
-let ordered_split_unsafe n abs_l l =
- let abs_l = List.length l in
- if n = 0 then
- [[], l]
- else if n = abs_l then
- [l, []]
- else if n <= abs_l / 2 then
- split' n [] [] l
- else
- List.rev_map (fun (a, b) -> (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/hgg-vertex/src/cascade.mli
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/cascade.mli (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/cascade.mli (revision 8717)
@@ -1,70 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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/hgg-vertex/src/pmap.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/pmap.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/pmap.ml (revision 8717)
@@ -1,540 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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/hgg-vertex/src/thoGButton.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/thoGButton.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/thoGButton.ml (revision 8717)
@@ -1,81 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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/hgg-vertex/src/colorize.mli
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/colorize.mli (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/colorize.mli (revision 8717)
@@ -1,52 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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
-
-(*i
-module Dynamical (M : Model.T) :
- Model.Colorized with module M = M
-i*)
-
-(* \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/hgg-vertex/src/tree.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/tree.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/tree.ml (revision 8717)
@@ -1,656 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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 cons 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
-
-let node = function
- | Leaf (n, _) -> n
- | Node (n, _) -> n
-
-(* 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 * 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 species prop = fst (style prop)
-let tex_lbl prop = snd (style prop)
-
-let leaf_label tex io leaf lab = function
- | None -> fprintf tex " \\fmflabel{$%s$}{%s%s}\n" lab io leaf
- | Some s ->
- fprintf tex " \\fmflabel{$%s{}^{(%s)}$}{%s%s}\n" s lab 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) (tex_lbl prop) prop.label ;
- fprintf tex " \\fmfdot{v%d}\n" n;
- if rev then
- fprintf tex " \\fmf{%s%s}{%s%s,v%d}\n"
- (species prop) tension io (to_string leaf) n
- else
- fprintf tex " \\fmf{%s%s}{v%d,%s%s}\n"
- (species 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,label=\\begin{scriptsize}$%s$\\end{scriptsize}}{v%d,v%d}\n"
- (species prop) (tex_lbl prop) n' n
- else
- fprintf tex
- " \\fmf{%s,label=\\begin{scriptsize}$%s$\\end{scriptsize}}{v%d,v%d}\n"
- (species prop) (tex_lbl 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" (tex_lbl prop) prop.label;
- if prop.rev then
- fprintf tex " \\fmf{%s}{i1,v%d}\n" (species prop) n
- else
- fprintf tex " \\fmf{%s}{v%d,i1}\n" (species 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 " \\fmfpen{.1pt}\n";
- fprintf tex " \\fmfset{arrow_len}{2mm}\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/hgg-vertex/src/thoList.mli
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/thoList.mli (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/thoList.mli (revision 8717)
@@ -1,95 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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/hgg-vertex/src/comphep_parser.mly
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/comphep_parser.mly (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/comphep_parser.mly (revision 8717)
@@ -1,63 +0,0 @@
-/* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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/hgg-vertex/src/oVM.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/oVM.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/oVM.ml (revision 8717)
@@ -1,90 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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/hgg-vertex/src/omega_SM_Maj3.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/omega_SM_Maj3.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/omega_SM_Maj3.ml (revision 8717)
@@ -1,34 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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)
- (Modellib_SM.SM3(Modellib_SM.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/hgg-vertex/src/omega.mli
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/omega.mli (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/omega.mli (revision 8717)
@@ -1,47 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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/hgg-vertex/src/momentum.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/momentum.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/momentum.ml (revision 8717)
@@ -1,672 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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/hgg-vertex/src/thoArray.mli
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/thoArray.mli (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/thoArray.mli (revision 8717)
@@ -1,55 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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/hgg-vertex/src/Makefile.am
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/Makefile.am (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/Makefile.am (revision 8717)
@@ -1,135 +0,0 @@
-# Makefile.am -- Makefile for O'Mega within and without WHIZARD
-# $Id$
-##
-## Process this file with automake to produce Makefile.in
-##
-########################################################################
-#
-# Copyright (C) 1999-2010 by
-# Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
-# Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
-# Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-#
-# 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.
-#
-########################################################################
-
-# Build the O'Mega Fortran library using libtool
-# (use pkglib_ instead of lib_ to make the -rpath and *.lai business work ...)
-pkglib_LTLIBRARIES = libomega_core.la
-pkginclude_DATA = $(OMEGALIB_MOD)
-
-libomega_core_la_SOURCES = $(OMEGALIB_F90)
-
-EXTRA_DIST = \
- $(OMEGA_CAML) \
- omegalib.nw $(OMEGALIB_F90)
-
-OMEGA_CMXA = omega_core.cmxa omega_targets.cmxa omega_models.cmxa
-OMEGA_CMA = $(OMEGA_CMXA:.cmxa=.cma)
-
-if OCAML_AVAILABLE
-all-local: $(OMEGA_CMXA) $(OMEGA_APPLICATIONS_CMX)
-bytecode: $(OMEGA_CMA) $(OMEGA_APPLICATIONS_CMO)
-else
-all-local:
-bytecode:
-endif
-
-########################################################################
-
-include $(top_srcdir)/src/Makefile.ocaml
-include $(top_srcdir)/src/Makefile.sources
-include $(top_srcdir)/src/Makefile.depend
-
-if OCAML_AVAILABLE
-omega_core.cmxa: $(OMEGA_CORE_CMX)
- $(OCAMLOPT) $(OCAMLFLAGS) $(OCAMLOPTFLAGS) -a -o $@ $^
-
-omega_core.cma: $(OMEGA_CORE_CMO)
- $(OCAMLC) $(OCAMLFLAGS) -a -o $@ $^
-
-omega_targets.cmxa: $(OMEGA_TARGETS_CMX)
- $(OCAMLOPT) $(OCAMLFLAGS) $(OCAMLOPTFLAGS) -a -o $@ $^
-
-omega_targets.cma: $(OMEGA_TARGETS_CMO)
- $(OCAMLC) $(OCAMLFLAGS) -a -o $@ $^
-
-omega_models.cmxa: $(OMEGA_MODELS_CMX)
- $(OCAMLOPT) $(OCAMLFLAGS) $(OCAMLOPTFLAGS) -a -o $@ $^
-
-omega_models.cma: $(OMEGA_MODELS_CMO)
- $(OCAMLC) $(OCAMLFLAGS) -a -o $@ $^
-
-cascade_lexer.mli: cascade_lexer.ml cascade_parser.cmi
- $(OCAMLC) -i $< | $(GREP) 'val token' >$@
-
-comphep_lexer.mli: comphep_lexer.ml comphep_parser.cmi
- $(OCAMLC) -i $< | $(GREP) 'val token' >$@
-
-vertex_lexer.mli: vertex_lexer.ml vertex_parser.cmi
- $(OCAMLC) -i $< | $(GREP) 'val token' >$@
-
-model_file_lexer.mli: model_file_lexer.ml model_file_parser.cmi
- $(OCAMLC) -i $< | $(GREP) 'val token' >$@
-endif
-
-MYPRECIOUS = $(OMEGA_DERIVED_CAML)
-
-SUFFIXES += .lo .$(FC_MODULE_EXT)
-
-# Fortran90 module files are generated at the same time as object files
-.lo.$(FC_MODULE_EXT):
- @:
-# touch $@
-
-########################################################################
-
-$(OMEGALIB_DERIVED_F90): omegalib.stamp
-
-if NOWEB_AVAILABLE
-
-omegalib.stamp: $(srcdir)/omegalib.nw
- @rm -f omegalib.tmp
- @touch omegalib.tmp
- for src in $(OMEGALIB_DERIVED_F90); do \
- $(NOTANGLE) -R[[$$src]] $< | $(CPIF) $$src; \
- done
- @mv -f omegalib.tmp omegalib.stamp
-
-else
-
-omegalib.stamp:
-
-
-endif
-
-MYPRECIOUS += $(OMEGALIB_DERIVED_F90)
-
-########################################################################
-# Don't trigger remakes by deleting intermediate files.
-.PRECIOUS = $(MYPRECIOUS)
-
-clean-local:
- rm -f *.cm[aiox] *.cmxa *.[ao] *.l[oa] *.$(FC_MODULE_EXT) \
- $(OMEGA_DERIVED_CAML) \
- $(OMEGALIB_DERIVED_F90) omegalib.stamp
-
-distclean-local:
- -test "$(srcdir)" != "." && rm -f config.mli
-
-########################################################################
-## The End.
-########################################################################
Index: branches/ohl/omega-development/hgg-vertex/src/trie.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/trie.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/trie.ml (revision 8717)
@@ -1,355 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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/hgg-vertex/src/dAG.mli
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/dAG.mli (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/dAG.mli (revision 8717)
@@ -1,323 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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 $x<y$} \\
- 0 & \text{for $x=y$} \\
- 1 & \text{for $x>y$}
- \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
-
-(* [dependencies dag node] returns a canonically sorted [Tree2.t] of all
- nodes reachable from [node]. *)
- val dependencies : t -> node -> node Tree2.t
-
-(* [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/hgg-vertex/src/model_parser.mly
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/model_parser.mly (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/model_parser.mly (revision 8717)
@@ -1,101 +0,0 @@
-/* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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/hgg-vertex/src/thoGButton.mli
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/thoGButton.mli (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/thoGButton.mli (revision 8717)
@@ -1,60 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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/hgg-vertex/src/pmap.mli
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/pmap.mli (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/pmap.mli (revision 8717)
@@ -1,73 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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/hgg-vertex/src/model_syntax.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/model_syntax.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/model_syntax.ml (revision 8717)
@@ -1,90 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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/hgg-vertex/src/whizard.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/whizard.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/whizard.ml (revision 8717)
@@ -1,419 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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/hgg-vertex/src/omega_Simplest.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/omega_Simplest.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/omega_Simplest.ml (revision 8717)
@@ -1,33 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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)
- (Modellib_BSM.Simplest(Modellib_BSM.BSM_bsm))
-let _ = O.main ()
-
-(*i
- * Local Variables:
- * mode:caml
- * indent-tabs-mode:nil
- * page-delimiter:"^(\\* .*\n"
- * End:
-i*)
Index: branches/ohl/omega-development/hgg-vertex/src/omega_SM3.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/omega_SM3.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/omega_SM3.ml (revision 8717)
@@ -1,33 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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)
- (Modellib_SM.SM3(Modellib_SM.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/hgg-vertex/src/phasespace.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/phasespace.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/phasespace.ml (revision 8717)
@@ -1,378 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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<p_D$, where~$p_D$ is the overall
- momentum of a decay tree~$D$, we can add $p$ to $D$ at the top or somewhere
- in the middle. Note that `$<$' is not a total ordering and the operation
- can fail (raise exceptions) if the set of momenta does not correspond to
- a tree. Also note that a momentum can already be present without flavor
- as a complement in a branching entered earlier. *)
-
- exception Duplicate of momentum
- exception Unordered of momentum
-
- let rec embed_in_decay (p, f as pf) = function
- | Leaf (p', f' as pf') as d' ->
- 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/hgg-vertex/src/omega_Phi4.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/omega_Phi4.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/omega_Phi4.ml (revision 8717)
@@ -1,32 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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)(Modellib_SM.Phi4)
-let _ = O.main ()
-
-(*i
- * Local Variables:
- * mode:caml
- * indent-tabs-mode:nil
- * page-delimiter:"^(\\* .*\n"
- * End:
-i*)
Index: branches/ohl/omega-development/hgg-vertex/src/fusion.mli
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/fusion.mli (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/fusion.mli (revision 8717)
@@ -1,313 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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 options : Options.t
-
-(* 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
-
- val dependencies : amplitude -> wf -> wf Tree2.t
-
-(* 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{Performance Hacks} *)
-
- val initialize_cache : string -> unit
-
-(* \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 process = flavor list * flavor list
- type amplitude
- type selectors
- type amplitudes
-
- (* Construct all possible color flow amplitudes for a given process. *)
- val amplitudes : bool -> selectors -> process list -> amplitudes
- val empty : amplitudes
-
- (* Precompute the vertex table cache. *)
- val initialize_cache : string -> unit
-
- (* The list of all combinations of incoming and outgoing particles
- with a nonvanishing scattering amplitude. *)
- val flavors : amplitudes -> process list
-
- (* The list of all combinations of incoming and outgoing particles that
- don't lead to any color flow with non vanishing scattering amplitude. *)
- val vanishing_flavors : amplitudes -> process list
-
- (* The list of all color flows with a nonvanishing scattering amplitude. *)
- val color_flows : amplitudes -> Color.Flow.t list
-
- (* The list of all valid helicity combinations. *)
- val helicities : amplitudes -> (int list * int list) list
-
- (* The list of all amlitudes. *)
- val processes : amplitudes -> amplitude list
-
- (* [(process_table a).(f).(c)] returns the amplitude for the [f]th
- allowed flavor combination and the [c]th allowed color flow as
- an [amplitude option]. *)
- val process_table : amplitudes -> amplitude option array array
-
- (* [(color_factors a).(c1).(c2)] power of~$N_C$ for the given product
- of color flows. *)
- val color_factors : amplitudes -> int option array array
-
- (* 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/hgg-vertex/src/thoString.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/thoString.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/thoString.ml (revision 8717)
@@ -1,116 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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/hgg-vertex/src/omega_Template.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/omega_Template.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/omega_Template.ml (revision 8717)
@@ -1,33 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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)
- (Modellib_BSM.Template(Modellib_BSM.BSM_bsm))
-let _ = O.main ()
-
-(*i
- * Local Variables:
- * mode:caml
- * indent-tabs-mode:nil
- * page-delimiter:"^(\\* .*\n"
- * End:
-i*)
Index: branches/ohl/omega-development/hgg-vertex/src/omega_SM_ac_CKM.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/omega_SM_ac_CKM.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/omega_SM_ac_CKM.ml (revision 8717)
@@ -1,33 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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)
- (Modellib_SM.SM(Modellib_SM.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/hgg-vertex/src/omega_Phi4h.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/omega_Phi4h.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/omega_Phi4h.ml (revision 8717)
@@ -1,34 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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)(Modellib_SM.Phi4)
-let _ = O.main ()
-
-(*i
- * Local Variables:
- * mode:caml
- * indent-tabs-mode:nil
- * page-delimiter:"^(\\* .*\n"
- * End:
-i*)
Index: branches/ohl/omega-development/hgg-vertex/src/omegalib.nw
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/omegalib.nw (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/omegalib.nw (revision 8717)
@@ -1,9785 +0,0 @@
-% $Id$
-%
-% Copyright (C) 1999-2009 by
-% Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
-% Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
-% Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-%
-% 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}
-<<[[omega_spinors.f90]]>>=
-<<Copyleft>>
-module omega_spinors
- use kinds
- use 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
- <<Declaration of operations for spinors>>
- integer, parameter, public :: omega_spinors_2010_01_A = 0
-contains
- <<Implementation of operations for spinors>>
-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}
-<<Declaration of operations for spinors>>=
-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]]:
-<<Implementation of operations for spinors>>=
-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
-@
-\subsection{Spinor Vector Space}
-\subsubsection{Scalar Multiplication}
-<<Declaration of operations for spinors>>=
-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
-@
-<<Implementation of operations for spinors>>=
-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
-@
-<<Implementation of operations for spinors>>=
-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
-@
-<<Declaration of operations for spinors>>=
-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
-@
-<<Implementation of operations for spinors>>=
-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}
-<<Declaration of operations for spinors>>=
-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
-@
-<<Implementation of operations for spinors>>=
-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
-@
-<<Implementation of operations for spinors>>=
-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}
-<<Declaration of operations for spinors>>=
-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
-@
-<<Implementation of operations for spinors>>=
-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
-@
-<<Implementation of operations for spinors>>=
-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}
-<<Declaration of operations for spinors>>=
-interface abs
- module procedure abs_spinor, abs_conjspinor
-end interface
-private :: abs_spinor, abs_conjspinor
-@
-<<Implementation of operations for spinors>>=
-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
-@
-<<Implementation of operations for spinors>>=
-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.f90]]>>=
-<<Copyleft>>
-module omega_bispinors
- use kinds
- use 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
- <<Declaration of operations for bispinors>>
- integer, parameter, public :: omega_bispinors_2010_01_A = 0
-contains
- <<Implementation of operations for bispinors>>
-end module omega_bispinors
-@
-<<Declaration of operations for 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.
-<<Implementation of operations for bispinors>>=
-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}
-<<Declaration of operations for bispinors>>=
-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
-@
-<<Implementation of operations for bispinors>>=
-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
-@
-<<Implementation of operations for bispinors>>=
-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
-@
-<<Implementation of operations for bispinors>>=
-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
-@
-<<Implementation of operations for bispinors>>=
-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
-@
-<<Implementation of operations for bispinors>>=
-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
-@
-<<Implementation of operations for bispinors>>=
-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
-@
-<<Implementation of operations for bispinors>>=
-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
-@
-<<Implementation of operations for bispinors>>=
-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
-@
-<<Implementation of operations for bispinors>>=
-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
-@
-<<Implementation of operations for bispinors>>=
-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}
-<<Declaration of operations for bispinors>>=
-interface operator (+)
- module procedure plus_bispinor
-end interface
-private :: plus_bispinor
-interface operator (-)
- module procedure neg_bispinor
-end interface
-private :: neg_bispinor
-@
-<<Implementation of operations for bispinors>>=
-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
-@
-<<Implementation of operations for bispinors>>=
-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}
-<<Declaration of operations for bispinors>>=
-interface operator (+)
- module procedure add_bispinor
-end interface
-private :: add_bispinor
-interface operator (-)
- module procedure sub_bispinor
-end interface
-private :: sub_bispinor
-@
-<<Implementation of operations for bispinors>>=
-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
-@
-<<Implementation of operations for bispinors>>=
-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}
-<<Declaration of operations for bispinors>>=
-interface abs
- module procedure abs_bispinor
-end interface
-private :: abs_bispinor
-@
-<<Implementation of operations for bispinors>>=
-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.f90]]>>=
-<<Copyleft>>
-module omega_vectorspinors
- use kinds
- use 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
- <<Declaration of operations for vectorspinors>>
- integer, parameter, public :: omega_vectorspinors_2010_01_A = 0
-contains
- <<Implementation of operations for vectorspinors>>
-end module omega_vectorspinors
-@
-<<Declaration of operations for vectorspinors>>=
-interface operator (*)
- module procedure vspinor_product
-end interface
-private :: vspinor_product
-@
-\begin{equation}
- \bar\psi^\mu\psi'_\mu
-\end{equation}
-<<Implementation of operations for vectorspinors>>=
-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}
-<<Declaration of operations for vectorspinors>>=
-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
-@
-<<Implementation of operations for vectorspinors>>=
-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
-@
-<<Implementation of operations for vectorspinors>>=
-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
-@
-<<Implementation of operations for vectorspinors>>=
-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
-@
-<<Implementation of operations for vectorspinors>>=
-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
-@
-<<Implementation of operations for vectorspinors>>=
-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
-@
-<<Implementation of operations for vectorspinors>>=
-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
-@
-<<Implementation of operations for vectorspinors>>=
-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
-@
-<<Implementation of operations for vectorspinors>>=
-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
-@
-<<Implementation of operations for vectorspinors>>=
-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
-@
-<<Implementation of operations for vectorspinors>>=
-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
-@
-<<Implementation of operations for vectorspinors>>=
-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
-@
-<<Implementation of operations for vectorspinors>>=
-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}
-<<Declaration of operations for vectorspinors>>=
-interface operator (+)
- module procedure plus_vectorspinor
-end interface
-private :: plus_vectorspinor
-interface operator (-)
- module procedure neg_vectorspinor
-end interface
-private :: neg_vectorspinor
-@
-<<Implementation of operations for vectorspinors>>=
-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
-@
-<<Implementation of operations for vectorspinors>>=
-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}
-<<Declaration of operations for vectorspinors>>=
-interface operator (+)
- module procedure add_vectorspinor
-end interface
-private :: add_vectorspinor
-interface operator (-)
- module procedure sub_vectorspinor
-end interface
-private :: sub_vectorspinor
-@
-<<Implementation of operations for vectorspinors>>=
-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
-@
-<<Implementation of operations for vectorspinors>>=
-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}
-<<Declaration of operations for vectorspinors>>=
-interface abs
- module procedure abs_vectorspinor
-end interface
-private :: abs_vectorspinor
-@
-<<Implementation of operations for vectorspinors>>=
-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.f90]]>>=
-<<Copyleft>>
-module omega_vectors
- use kinds
- use 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
- <<Declaration of operations for vectors>>
- integer, parameter, public :: omega_vectors_2010_01_A = 0
-contains
- <<Implementation of operations for vectors>>
-end module omega_vectors
-@
-\subsection{Constructors}
-<<Declaration of operations for vectors>>=
-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
-@
-<<Implementation of operations for vectors>>=
-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
-@
-<<Implementation of operations for vectors>>=
-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
-@
-<<Implementation of operations for vectors>>=
-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
-@
-\subsection{Inner Products}
-<<Declaration of operations for vectors>>=
-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
-@
-<<Implementation of operations for vectors>>=
-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
-@
-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}
-<<Implementation of operations for vectors>>=
-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
-@
-\subsection{Not Entirely Inner Products}
-<<Declaration of operations for vectors>>=
-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}
-<<Implementation of operations for vectors>>=
-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}
-<<Implementation of operations for vectors>>=
-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}
-<<Declaration of operations for vectors>>=
-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
-@
-<<Implementation of operations for vectors>>=
-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}
-<<Declaration of operations for vectors>>=
-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
-@
-<<Implementation of operations for vectors>>=
-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
-@
-<<Implementation of operations for vectors>>=
-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
-@
-<<Implementation of operations for vectors>>=
-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
-@
-<<Implementation of operations for vectors>>=
-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
-@
-<<Implementation of operations for vectors>>=
-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
-@
-<<Implementation of operations for vectors>>=
-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}
-<<Declaration of operations for vectors>>=
-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
-@
-<<Implementation of operations for vectors>>=
-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
-@
-<<Implementation of operations for vectors>>=
-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
-@
-<<Implementation of operations for vectors>>=
-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}
-<<Declaration of operations for vectors>>=
-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
-@
-<<Implementation of operations for vectors>>=
-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
-@
-<<Implementation of operations for vectors>>=
-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!
-<<Declaration of operations for vectors>>=
-interface abs
- module procedure abs_momentum, abs_vector, abs_tensor2odd
-end interface
-private :: abs_momentum, abs_vector, abs_tensor2odd
-@
-<<Implementation of operations for vectors>>=
-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}
-<<Declaration of operations for vectors>>=
-interface conjg
- module procedure conjg_momentum, conjg_vector, conjg_tensor2odd
-end interface
-private :: conjg_momentum, conjg_vector, conjg_tensor2odd
-@
-<<Implementation of operations for vectors>>=
-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}
-<<Declaration of operations for vectors>>=
-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
-@
-<<Implementation of operations for vectors>>=
-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
-@
-<<Implementation of operations for vectors>>=
-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
-@
-<<Implementation of operations for vectors>>=
-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}
-<<Declaration of operations for vectors>>=
-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
-@
-<<Implementation of operations for vectors>>=
-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
-@
-<<Implementation of operations for vectors>>=
-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
-@
-<<Implementation of operations for vectors>>=
-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}
-<<Declaration of operations for vectors>>=
-@
-<<Implementation of operations for vectors>>=
-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.f90]]>>=
-<<Copyleft>>
-module omega_polarizations
- use kinds
- use constants
- use omega_vectors
- implicit none
- private
- <<Declaration of polarization vectors>>
- integer, parameter, public :: omega_polarizations_2010_01_A = 0
-contains
- <<Implementation of polarization vectors>>
-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.
-<<Declaration of polarization vectors>>=
-public :: eps
-@
-<<Implementation of polarization vectors>>=
-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.f90]]>>=
-<<Copyleft>>
-module omega_polarizations_madgraph
- use kinds
- use constants
- use omega_vectors
- implicit none
- private
- <<Declaration of polarization vectors for madgraph>>
- integer, parameter, public :: omega_pols_madgraph_2010_01_A = 0
-contains
- <<Implementation of polarization vectors for madgraph>>
-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.
-<<Declaration of polarization vectors for madgraph>>=
-public :: eps
-@
-<<Implementation of polarization vectors for madgraph>>=
-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.f90]]>>=
-<<Copyleft>>
-module omega_tensors
- use kinds
- use 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
- <<Declaration of operations for tensors>>
- integer, parameter, public :: omega_tensors_2010_01_A = 0
-contains
- <<Implementation of operations for tensors>>
-end module omega_tensors
-@
-\subsection{Vector Space}
-\subsubsection{Scalar Multliplication}
-<<Declaration of operations for tensors>>=
-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
-@
-<<Implementation of operations for tensors>>=
-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}
-<<Declaration of operations for tensors>>=
-interface operator (+)
- module procedure plus_tensor
-end interface
-private :: plus_tensor
-interface operator (-)
- module procedure neg_tensor
-end interface
-private :: neg_tensor
-@
-<<Implementation of operations for tensors>>=
-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
-@
-<<Declaration of operations for tensors>>=
-interface operator (+)
- module procedure add_tensor
-end interface
-private :: add_tensor
-interface operator (-)
- module procedure sub_tensor
-end interface
-private :: sub_tensor
-@
-<<Implementation of operations for tensors>>=
-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
-@
-<<Declaration of operations for tensors>>=
-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
-@
-<<Implementation of operations for tensors>>=
-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
-@
-<<Implementation of operations for tensors>>=
-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
-@
-<<Implementation of operations for tensors>>=
-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
-@
-<<Implementation of operations for tensors>>=
-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
-@
-<<Declaration of operations for tensors>>=
-interface abs
- module procedure abs_tensor
-end interface
-private :: abs_tensor
-@
-<<Implementation of operations for tensors>>=
-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
-@
-<<Declaration of operations for tensors>>=
-interface conjg
- module procedure conjg_tensor
-end interface
-private :: conjg_tensor
-@
-<<Implementation of operations for tensors>>=
-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
-@
-<<Declaration of operations for tensors>>=
-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
-@
-<<Implementation of operations for tensors>>=
-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
-@
-<<Implementation of operations for tensors>>=
-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
-@
-<<Implementation of operations for tensors>>=
-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
-@
-<<Implementation of operations for tensors>>=
-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
-@
-<<Implementation of operations for tensors>>=
-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.f90]]>>=
-<<Copyleft>>
-module omega_tensor_polarizations
- use kinds
- use constants
- use omega_vectors
- use omega_tensors
- use omega_polarizations
- implicit none
- private
- <<Declaration of polarization tensors>>
- integer, parameter, public :: omega_tensor_pols_2010_01_A = 0
-contains
- <<Implementation of polarization tensors>>
-end module omega_tensor_polarizations
-@
-<<Declaration of polarization tensors>>=
-public :: eps2
-@
-<<Implementation of polarization tensors>>=
-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.f90]]>>=
-<<Copyleft>>
-module omega_couplings
- use kinds
- use constants
- use omega_vectors
- use omega_tensors
- implicit none
- private
- <<Declaration of couplings>>
- <<Declaration of propagators>>
- integer, parameter, public :: omega_couplings_2010_01_A = 0
-contains
- <<Implementation of couplings>>
- <<Implementation of propagators>>
-end module omega_couplings
-@
-<<Declaration of propagators>>=
-public :: wd_tl
-@
-<<Declaration of propagators>>=
-public :: gauss
-@
-\begin{equation}
- \Theta(p^2)\Gamma
-\end{equation}
-<<Implementation of propagators>>=
-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
-@
-<<Implementation of propagators>>=
-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
-@
-<<Declaration of propagators>>=
-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}
-<<Implementation of propagators>>=
-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}
-<<Implementation of propagators>>=
-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
-@
-<<Implementation of propagators>>=
-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.
-<<Implementation of propagators>>=
-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}
-<<Implementation of propagators>>=
-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
-@
-<<Implementation of propagators>>=
-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}
-<<Implementation of propagators>>=
-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}
-<<Implementation of propagators>>=
-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}
-<<Implementation of propagators>>=
-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
-@
-<<Declaration of propagators>>=
-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}
-<<Implementation of propagators>>=
-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}
-<<Declaration of 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}
-<<Implementation of couplings>>=
-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}
-<<Declaration of 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}
-<<Implementation of couplings>>=
-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}
-<<Implementation of couplings>>=
-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}
-<<Declaration of couplings>>=
-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}
-<<Implementation of couplings>>=
-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}
-<<Implementation of couplings>>=
-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}
-<<Declaration of 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}
-<<Implementation of couplings>>=
-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}
-<<Implementation of couplings>>=
-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}
-<<Implementation of couplings>>=
-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}
-<<Implementation of couplings>>=
-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$
-<<Implementation of couplings>>=
-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}
-<<Implementation of couplings>>=
-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$
-<<Implementation of couplings>>=
-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}
-<<Implementation of couplings>>=
-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}
-<<Implementation of couplings>>=
-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}
-<<Implementation of couplings>>=
-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}
-<<Implementation of couplings>>=
-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}
-<<Declaration of couplings>>=
-public :: s_gravs, v_gravv, grav_ss, grav_vv
-@
-<<Implementation of couplings>>=
-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
-@
-<<Implementation of couplings>>=
-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
-@
-<<Implementation of couplings>>=
-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
-@
-<<Implementation of couplings>>=
-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}
-<<Declaration of couplings>>=
-public :: t2_vv, v_t2v
-@ \section{Scalar-Vector Dim-5 Couplings}
-<<Declaration of couplings>>=
-public :: phi_vv, v_phiv
-@
-<<Implementation of couplings>>=
-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
-@
-<<Implementation of couplings>>=
-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
-@
-<<Implementation of couplings>>=
-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
-@
-<<Implementation of couplings>>=
-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
-@
-<<Declaration of couplings>>=
-public :: t2_vv_d5_1, v_t2v_d5_1
-@
-<<Implementation of couplings>>=
-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
-@
-<<Implementation of couplings>>=
-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
-@
-<<Declaration of couplings>>=
-public :: t2_vv_d5_2, v_t2v_d5_2
-@
-<<Implementation of couplings>>=
-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
-@
-<<Implementation of couplings>>=
-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
-@
-<<Declaration of couplings>>=
-public :: t2_vv_d7, v_t2v_d7
-@
-<<Implementation of couplings>>=
-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
-@
-<<Implementation of couplings>>=
-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.f90]]>>=
-<<Copyleft>>
-module omega_spinor_couplings
- use kinds
- use constants
- use omega_spinors
- use omega_vectors
- use omega_tensors
- use omega_couplings
- implicit none
- private
- <<Declaration of spinor on shell wave functions>>
- <<Declaration of spinor off shell wave functions>>
- <<Declaration of spinor currents>>
- <<Declaration of spinor propagators>>
- integer, parameter, public :: omega_spinor_cpls_2010_01_A = 0
-contains
- <<Implementation of spinor on shell wave functions>>
- <<Implementation of spinor off shell wave functions>>
- <<Implementation of spinor currents>>
- <<Implementation of spinor propagators>>
-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}
-<<Declaration of spinor currents>>=
-public :: va_ff, v_ff, a_ff, vl_ff, vr_ff, vlr_ff, grav_ff, va2_ff
-@
-<<Implementation of spinor currents>>=
-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
-@
-<<Implementation of spinor currents>>=
-pure function va2_ff (gva, psibar, psi) result (j)
- type(vector) :: j
- complex(kind=default), intent(in), dimension(2) :: gva
- 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 = gva(1) + gva(2)
- gr = gva(1) - gva(2)
- 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 va2_ff
-@ Special cases that avoid some multiplications
-<<Implementation of spinor currents>>=
-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
-@
-<<Implementation of spinor currents>>=
-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
-@
-<<Implementation of spinor currents>>=
-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
-@
-<<Implementation of spinor currents>>=
-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
-@
-<<Implementation of spinor currents>>=
-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
-<<Implementation of spinor currents>>=
-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$.
-<<Declaration of spinor currents>>=
-public :: f_vaf, f_vf, f_af, f_vlf, f_vrf, f_vlrf, f_va2f
-@
-<<Implementation of spinor currents>>=
-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
-@
-<<Implementation of spinor currents>>=
-pure function f_va2f (gva, v, psi) result (vpsi)
- type(spinor) :: vpsi
- complex(kind=default), intent(in), dimension(2) :: gva
- type(vector), intent(in) :: v
- type(spinor), intent(in) :: psi
- complex(kind=default) :: gl, gr
- complex(kind=default) :: vp, vm, v12, v12s
- gl = gva(1) + gva(2)
- gr = gva(1) - gva(2)
- 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_va2f
-@
-<<Implementation of spinor currents>>=
-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
-@
-<<Implementation of spinor currents>>=
-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
-@
-<<Implementation of spinor currents>>=
-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
-@
-<<Implementation of spinor currents>>=
-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
-@
-<<Implementation of spinor currents>>=
-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
-@
-<<Declaration of spinor currents>>=
-public :: f_fva, f_fv, f_fa, f_fvl, f_fvr, f_fvlr, f_fva2
-@
-<<Implementation of spinor currents>>=
-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
-@
-<<Implementation of spinor currents>>=
-pure function f_fva2 (gva, psibar, v) result (psibarv)
- type(conjspinor) :: psibarv
- complex(kind=default), intent(in), dimension(2) :: gva
- type(conjspinor), intent(in) :: psibar
- type(vector), intent(in) :: v
- complex(kind=default) :: gl, gr
- complex(kind=default) :: vp, vm, v12, v12s
- gl = gva(1) + gva(2)
- gr = gva(1) - gva(2)
- 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_fva2
-@
-<<Implementation of spinor currents>>=
-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
-@
-<<Implementation of spinor currents>>=
-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
-@
-<<Implementation of spinor currents>>=
-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
-@
-<<Implementation of spinor currents>>=
-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
-@
-<<Implementation of spinor currents>>=
-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}
-<<Declaration of spinor currents>>=
-public :: sp_ff, s_ff, p_ff, sl_ff, sr_ff, slr_ff
-@
-<<Implementation of spinor currents>>=
-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
-@
-<<Implementation of spinor currents>>=
-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
-@
-<<Implementation of spinor currents>>=
-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
-@
-<<Implementation of spinor currents>>=
-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
-@
-<<Implementation of spinor currents>>=
-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}
-<<Implementation of spinor currents>>=
-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
-@
-<<Declaration of spinor currents>>=
-public :: f_spf, f_sf, f_pf, f_slf, f_srf, f_slrf
-@
-<<Implementation of spinor currents>>=
-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
-@
-<<Implementation of spinor currents>>=
-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
-@
-<<Implementation of spinor currents>>=
-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
-@
-<<Implementation of spinor currents>>=
-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
-@
-<<Implementation of spinor currents>>=
-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
-@
-<<Implementation of spinor currents>>=
-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
-@
-<<Declaration of spinor currents>>=
-public :: f_fsp, f_fs, f_fp, f_fsl, f_fsr, f_fslr
-@
-<<Implementation of spinor currents>>=
-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
-@
-<<Implementation of spinor currents>>=
-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
-@
-<<Implementation of spinor currents>>=
-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
-@
-<<Implementation of spinor currents>>=
-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
-@
-<<Implementation of spinor currents>>=
-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
-@
-<<Implementation of spinor currents>>=
-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
-<<Declaration of spinor currents>>=
-public :: f_gravf, f_fgrav
-@
-<<Implementation of spinor currents>>=
-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
-@
-<<Implementation of spinor currents>>=
-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}
-<<Declaration of spinor 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}
-<<Implementation of spinor on shell wave functions>>=
-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
-@
-<<Implementation of spinor on shell wave functions>>=
-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.
-<<Implementation of spinor on shell wave functions>>=
-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
-@
-<<Implementation of spinor on shell wave functions>>=
-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}
-<<Implementation of spinor on shell wave functions>>=
-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
-@
-<<Implementation of spinor on shell wave functions>>=
-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.
-<<Declaration of spinor off shell wave functions>>=
-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}
-<<Implementation of spinor off shell wave functions>>=
-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}
-<<Implementation of spinor off shell wave functions>>=
-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}
-<<Implementation of spinor off shell wave functions>>=
- 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}
-<<Implementation of spinor off shell wave functions>>=
- 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:
-<<Declaration of spinor propagators>>=
-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.
-<<Implementation of spinor propagators>>=
-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}
-<<Implementation of spinor propagators>>=
-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
-@
-<<Implementation of spinor propagators>>=
-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.
-<<Implementation of spinor propagators>>=
-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.
-<<Implementation of spinor propagators>>=
-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
-@
-<<Implementation of spinor propagators>>=
-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.f90]]>>=
-<<Copyleft>>
-module omega_bispinor_couplings
- use kinds
- use constants
- use omega_bispinors
- use omega_vectorspinors
- use omega_vectors
- use omega_couplings
- implicit none
- private
- <<Declaration of bispinor on shell wave functions>>
- <<Declaration of bispinor off shell wave functions>>
- <<Declaration of bispinor currents>>
- <<Declaration of bispinor propagators>>
- integer, parameter, public :: omega_bispinor_cpls_2010_01_A = 0
-contains
- <<Implementation of bispinor on shell wave functions>>
- <<Implementation of bispinor off shell wave functions>>
- <<Implementation of bispinor currents>>
- <<Implementation of bispinor propagators>>
-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}
-<<Declaration of bispinor currents>>=
-public :: va_ff, v_ff, a_ff, vl_ff, vr_ff, vlr_ff, va2_ff
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-pure function va2_ff (gva, psil, psir) result (j)
- type(vector) :: j
- complex(kind=default), intent(in), dimension(2) :: gva
- type(bispinor), intent(in) :: psil, psir
- complex(kind=default) :: gl, gr
- complex(kind=default) :: g13, g14, g23, g24, g31, g32, g41, g42
- gl = gva(1) + gva(2)
- gr = gva(1) - gva(2)
- 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 va2_ff
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-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$.
-<<Declaration of bispinor currents>>=
-public :: f_vaf, f_vf, f_af, f_vlf, f_vrf, f_vlrf, f_va2f
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-pure function f_va2f (gva, v, psi) result (vpsi)
- type(bispinor) :: vpsi
- complex(kind=default), intent(in), dimension(2) :: gva
- type(vector), intent(in) :: v
- type(bispinor), intent(in) :: psi
- complex(kind=default) :: gl, gr
- complex(kind=default) :: vp, vm, v12, v12s
- gl = gva(1) + gva(2)
- gr = gva(1) - gva(2)
- 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_va2f
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-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}
-<<Declaration of bispinor currents>>=
-public :: sp_ff, s_ff, p_ff, sl_ff, sr_ff, slr_ff
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Declaration of bispinor currents>>=
-public :: f_spf, f_sf, f_pf, f_slf, f_srf, f_slrf
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-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.
-<<Declaration of bispinor currents>>=
-private :: vv_ff, f_vvf
-@
-<<Declaration of bispinor currents>>=
-public :: vmom_ff, mom_ff, mom5_ff, moml_ff, momr_ff, lmom_ff, rmom_ff
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Declaration of bispinor currents>>=
-public :: f_vmomf, f_momf, f_mom5f, f_momlf, f_momrf, f_lmomf, f_rmomf
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-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}
-<<Declaration of bispinor currents>>=
-public :: v2_ff, sv1_ff, sv2_ff, pv1_ff, pv2_ff, svl1_ff, svl2_ff, &
- svr1_ff, svr2_ff, svlr1_ff, svlr2_ff
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Declaration of bispinor currents>>=
-public :: f_v2f, f_svf, f_pvf, f_svlf, f_svrf, f_svlrf
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-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}
-<<Declaration of bispinor currents>>=
-public :: pot_grf, pot_fgr, s_grf, s_fgr, p_grf, p_fgr, &
- sl_grf, sl_fgr, sr_grf, sr_fgr, slr_grf, slr_fgr
-@
-<<Declaration of bispinor currents>>=
-private :: fgvgr, fgvg5gr, fggvvgr, grkgf, grkggf, grkkggf, &
- fgkgr, fg5gkgr, grvgf, grg5vgf, grkgggf, fggkggr
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-pure function sl_grf (gl, gravbar, psi, k) result (j)
- complex(kind=default) :: j
- complex(kind=default), intent(in) :: gl
- type(vectorspinor), intent(in) :: gravbar
- type(bispinor), intent(in) :: psi
- type(bispinor) :: psi_l
- type(momentum), intent(in) :: k
- psi_l%a(1:2) = psi%a(1:2)
- psi_l%a(3:4) = 0
- j = s_grf (gl, gravbar, psi_l, k)
-end function sl_grf
-@
-<<Implementation of bispinor currents>>=
-pure function sr_grf (gr, gravbar, psi, k) result (j)
- complex(kind=default) :: j
- complex(kind=default), intent(in) :: gr
- type(vectorspinor), intent(in) :: gravbar
- type(bispinor), intent(in) :: psi
- type(bispinor) :: psi_r
- type(momentum), intent(in) :: k
- psi_r%a(1:2) = 0
- psi_r%a(3:4) = psi%a(3:4)
- j = s_grf (gr, gravbar, psi_r, k)
-end function sr_grf
-@
-<<Implementation of bispinor currents>>=
-pure function slr_grf (gl, gr, gravbar, psi, k) result (j)
- complex(kind=default) :: j
- complex(kind=default), intent(in) :: gl, gr
- type(vectorspinor), intent(in) :: gravbar
- type(bispinor), intent(in) :: psi
- type(momentum), intent(in) :: k
- j = sl_grf (gl, gravbar, psi, k) + sr_grf (gr, gravbar, psi, k)
-end function slr_grf
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-pure function sl_fgr (gl, psibar, grav, k) result (j)
- complex(kind=default) :: j
- complex(kind=default), intent(in) :: gl
- type(bispinor), intent(in) :: psibar
- type(bispinor) :: psibar_l
- type(vectorspinor), intent(in) :: grav
- type(momentum), intent(in) :: k
- psibar_l%a(1:2) = psibar%a(1:2)
- psibar_l%a(3:4) = 0
- j = s_fgr (gl, psibar_l, grav, k)
-end function sl_fgr
-@
-<<Implementation of bispinor currents>>=
-pure function sr_fgr (gr, psibar, grav, k) result (j)
- complex(kind=default) :: j
- complex(kind=default), intent(in) :: gr
- type(bispinor), intent(in) :: psibar
- type(bispinor) :: psibar_r
- type(vectorspinor), intent(in) :: grav
- type(momentum), intent(in) :: k
- psibar_r%a(1:2) = 0
- psibar_r%a(3:4) = psibar%a(3:4)
- j = s_fgr (gr, psibar_r, grav, k)
-end function sr_fgr
-@
-@
-<<Implementation of bispinor currents>>=
-pure function slr_fgr (gl, gr, psibar, grav, k) result (j)
- complex(kind=default) :: j
- complex(kind=default), intent(in) :: gl, gr
- type(bispinor), intent(in) :: psibar
- type(bispinor) :: psibar_r
- type(vectorspinor), intent(in) :: grav
- type(momentum), intent(in) :: k
- j = sl_fgr (gl, psibar, grav, k) + sr_fgr (gr, psibar, grav, k)
-end function slr_fgr
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Declaration of bispinor currents>>=
-public :: f_potgr, f_sgr, f_pgr, f_vgr, f_vlrgr, f_slgr, f_srgr, f_slrgr
-@
-<<Implementation of bispinor currents>>=
-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}
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-pure function f_slgr (gl, phi, psi, k) result (phipsi)
- type(bispinor) :: phipsi
- complex(kind=default), intent(in) :: gl
- complex(kind=default), intent(in) :: phi
- type(momentum), intent(in) :: k
- type(vectorspinor), intent(in) :: psi
- phipsi = f_sgr (gl, phi, psi, k)
- phipsi%a(3:4) = 0
-end function f_slgr
-@
-<<Implementation of bispinor currents>>=
-pure function f_srgr (gr, phi, psi, k) result (phipsi)
- type(bispinor) :: phipsi
- complex(kind=default), intent(in) :: gr
- complex(kind=default), intent(in) :: phi
- type(momentum), intent(in) :: k
- type(vectorspinor), intent(in) :: psi
- phipsi = f_sgr (gr, phi, psi, k)
- phipsi%a(1:2) = 0
-end function f_srgr
-@
-<<Implementation of bispinor currents>>=
-pure function f_slrgr (gl, gr, phi, psi, k) result (phipsi)
- type(bispinor) :: phipsi, phipsi_l, phipsi_r
- complex(kind=default), intent(in) :: gl, gr
- complex(kind=default), intent(in) :: phi
- type(momentum), intent(in) :: k
- type(vectorspinor), intent(in) :: psi
- phipsi_l = f_slgr (gl, phi, psi, k)
- phipsi_r = f_srgr (gr, phi, psi, k)
- phipsi%a(1:2) = phipsi_l%a(1:2)
- phipsi%a(3:4) = phipsi_r%a(3:4)
-end function f_slrgr
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-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}
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-pure function f_vgr (g, v, psi, k) result (psikkkv)
- type(bispinor) :: psikkkv
- 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
- psikkkv = g * (fggvvgr (v, psi, vk))
-end function f_vgr
-@
-<<Implementation of bispinor currents>>=
-pure function f_vlrgr (gl, gr, 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) :: gl, gr
- type(vector) :: vk
- vk = k
- psikv = fggvvgr (v, psi, vk)
- psikv%a(1:2) = gl * psikv%a(1:2)
- psikv%a(3:4) = gr * psikv%a(3:4)
-end function f_vlrgr
-@
-<<Declaration of bispinor currents>>=
-public :: gr_potf, gr_sf, gr_pf, gr_vf, gr_vlrf, gr_slf, gr_srf, gr_slrf
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-pure function gr_slf (gl, phi, psi, k) result (phipsi)
- type(vectorspinor) :: phipsi
- complex(kind=default), intent(in) :: gl
- complex(kind=default), intent(in) :: phi
- type(bispinor), intent(in) :: psi
- type(bispinor) :: psi_l
- type(momentum), intent(in) :: k
- psi_l%a(1:2) = psi%a(1:2)
- psi_l%a(3:4) = 0
- phipsi = gr_sf (gl, phi, psi_l, k)
-end function gr_slf
-@
-<<Implementation of bispinor currents>>=
-pure function gr_srf (gr, phi, psi, k) result (phipsi)
- type(vectorspinor) :: phipsi
- complex(kind=default), intent(in) :: gr
- complex(kind=default), intent(in) :: phi
- type(bispinor), intent(in) :: psi
- type(bispinor) :: psi_r
- type(momentum), intent(in) :: k
- psi_r%a(1:2) = 0
- psi_r%a(3:4) = psi%a(3:4)
- phipsi = gr_sf (gr, phi, psi_r, k)
-end function gr_srf
-@
-<<Implementation of bispinor currents>>=
-pure function gr_slrf (gl, gr, phi, psi, k) result (phipsi)
- type(vectorspinor) :: phipsi
- complex(kind=default), intent(in) :: gl, gr
- complex(kind=default), intent(in) :: phi
- type(bispinor), intent(in) :: psi
- type(bispinor) :: psi_r
- type(momentum), intent(in) :: k
- phipsi = gr_slf (gl, phi, psi, k) + gr_srf (gr, phi, psi, k)
-end function gr_slrf
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-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, imago
- imago = (0.0_default,1.0_default)
- kv30 = k%x(3) * v%t - k%t * v%x(3)
- kv21 = imago * (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 = imago * (k%t * v%x(2) - k%x(2) * v%t)
- kv32 = imago * (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) = imago * (bms * psi%a(3) - am * psi%a(4))
- psikv%psi(3)%a(2) = (-imago) * (am * psi%a(3) + bp * psi%a(4))
- psikv%psi(3)%a(3) = (-imago) * (bps * psi%a(1) + ap * psi%a(2))
- psikv%psi(3)%a(4) = imago * ((-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
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-pure function gr_vlrf (gl, gr, v, psi, k) result (psikv)
- type(vectorspinor) :: psikv
- type(bispinor), intent(in) :: psi
- type(bispinor) :: psi_l, psi_r
- type(vector), intent(in) :: v
- type(momentum), intent(in) :: k
- complex(kind=default), intent(in) :: gl, gr
- type(vector) :: vk
- vk = k
- psi_l%a(1:2) = psi%a(1:2)
- psi_l%a(3:4) = 0
- psi_r%a(1:2) = 0
- psi_r%a(3:4) = psi%a(3:4)
- psikv = gl * grkkggf (v, psi_l, vk) + gr * grkkggf (v, psi_r, vk)
-end function gr_vlrf
-@
-<<Declaration of bispinor currents>>=
-public :: v_grf, v_fgr
-@
-<<Declaration of bispinor currents>>=
-public :: vlr_grf, vlr_fgr
-@
-$V^\mu = \psi_\rho^T C^{\mu\rho} \psi$
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-pure function vlr_grf (gl, gr, psil, psir, k) result (j)
- type(vector) :: j
- complex(kind=default), intent(in) :: gl, gr
- type(vectorspinor), intent(in) :: psil
- type(bispinor), intent(in) :: psir
- type(bispinor) :: psir_l, psir_r
- type(momentum), intent(in) :: k
- type(vector) :: vk
- vk = k
- psir_l%a(1:2) = psir%a(1:2)
- psir_l%a(3:4) = 0
- psir_r%a(1:2) = 0
- psir_r%a(3:4) = psir%a(3:4)
- j = gl * grkgggf (psil, psir_l, vk) + gr * grkgggf (psil, psir_r, vk)
-end function vlr_grf
-@
-$V^\mu = \psi^T \tilde{C}^{\mu\rho} \psi_\rho$; remember the reversed
-index order in $\tilde{C}$.
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-pure function vlr_fgr (gl, gr, psil, psir, k) result (j)
- type(vector) :: j
- complex(kind=default), intent(in) :: gl, gr
- type(vectorspinor), intent(in) :: psir
- type(bispinor), intent(in) :: psil
- type(bispinor) :: psil_l
- type(bispinor) :: psil_r
- type(momentum), intent(in) :: k
- type(vector) :: vk
- vk = k
- psil_l%a(1:2) = psil%a(1:2)
- psil_l%a(3:4) = 0
- psil_r%a(1:2) = 0
- psil_r%a(3:4) = psil%a(3:4)
- j = gl * fggkggr (psil_l, psir, vk) + gr * fggkggr (psil_r, psir, vk)
-end function vlr_fgr
-@ \subsection{Gravitino 4-Couplings}
-<<Declaration of bispinor currents>>=
-public :: f_s2gr, f_svgr, f_slvgr, f_srvgr, f_slrvgr, f_pvgr, f_v2gr, f_v2lrgr
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-pure function f_slvgr (gl, phi, v, grav) result (phigrav)
- type(bispinor) :: phigrav, phidum
- type(vectorspinor), intent(in) :: grav
- type(vector), intent(in) :: v
- complex(kind=default), intent(in) :: gl, phi
- phidum = (gl * phi) * fgvg5gr (grav, v)
- phigrav%a(1:2) = phidum%a(1:2)
- phigrav%a(3:4) = 0
-end function f_slvgr
-@
-<<Implementation of bispinor currents>>=
-pure function f_srvgr (gr, phi, v, grav) result (phigrav)
- type(bispinor) :: phigrav, phidum
- type(vectorspinor), intent(in) :: grav
- type(vector), intent(in) :: v
- complex(kind=default), intent(in) :: gr, phi
- phidum = (gr * phi) * fgvg5gr (grav, v)
- phigrav%a(1:2) = 0
- phigrav%a(3:4) = phidum%a(3:4)
-end function f_srvgr
-@
-<<Implementation of bispinor currents>>=
-pure function f_slrvgr (gl, gr, phi, v, grav) result (phigrav)
- type(bispinor) :: phigrav, phidum
- type(vectorspinor), intent(in) :: grav
- type(vector), intent(in) :: v
- complex(kind=default), intent(in) :: gl, gr, phi
- phigrav = f_slvgr (gl, phi, v, grav) + f_srvgr (gr, phi, v, grav)
-end function f_slrvgr
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-pure function f_v2lrgr (gl, gr, v1, v2, grav) result (psi)
- type(bispinor) :: psi
- complex(kind=default), intent(in) :: gl, gr
- type(vectorspinor), intent(in) :: grav
- type(vector), intent(in) :: v1, v2
- psi = fggvvgr (v2, grav, v1)
- psi%a(1:2) = gl * psi%a(1:2)
- psi%a(3:4) = gr * psi%a(3:4)
-end function f_v2lrgr
-@
-<<Declaration of bispinor currents>>=
-public :: gr_s2f, gr_svf, gr_pvf, gr_slvf, gr_srvf, gr_slrvf, gr_v2f, gr_v2lrf
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-pure function gr_slvf (gl, phi, v, psi) result (phipsi)
- type(vectorspinor) :: phipsi
- type(bispinor), intent(in) :: psi
- type(bispinor) :: psi_l
- type(vector), intent(in) :: v
- complex(kind=default), intent(in) :: gl, phi
- psi_l%a(1:2) = psi%a(1:2)
- psi_l%a(3:4) = 0
- phipsi = (gl * phi) * grkggf (psi_l, v)
-end function gr_slvf
-@
-<<Implementation of bispinor currents>>=
-pure function gr_srvf (gr, phi, v, psi) result (phipsi)
- type(vectorspinor) :: phipsi
- type(bispinor), intent(in) :: psi
- type(bispinor) :: psi_r
- type(vector), intent(in) :: v
- complex(kind=default), intent(in) :: gr, phi
- psi_r%a(1:2) = 0
- psi_r%a(3:4) = psi%a(3:4)
- phipsi = (gr * phi) * grkggf (psi_r, v)
-end function gr_srvf
-@
-<<Implementation of bispinor currents>>=
-pure function gr_slrvf (gl, gr, phi, v, psi) result (phipsi)
- type(vectorspinor) :: phipsi
- type(bispinor), intent(in) :: psi
- type(bispinor) :: psi_r
- type(vector), intent(in) :: v
- complex(kind=default), intent(in) :: gl, gr, phi
- phipsi = gr_slvf (gl, phi, v, psi) + gr_srvf (gr, phi, v, psi)
-end function gr_slrvf
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-pure function gr_v2lrf (gl, gr, v1, v2, psi) result (vvpsi)
- type(vectorspinor) :: vvpsi
- complex(kind=default), intent(in) :: gl, gr
- type(bispinor), intent(in) :: psi
- type(bispinor) :: psi_l, psi_r
- type(vector), intent(in) :: v1, v2
- psi_l%a(1:2) = psi%a(1:2)
- psi_l%a(3:4) = 0
- psi_r%a(1:2) = 0
- psi_r%a(3:4) = psi%a(3:4)
- vvpsi = gl * grkkggf (v2, psi_l, v1) + gr * grkkggf (v2, psi_r, v1)
-end function gr_v2lrf
-@
-<<Declaration of bispinor currents>>=
-public :: s2_grf, s2_fgr, sv1_grf, sv2_grf, sv1_fgr, sv2_fgr, &
- slv1_grf, slv2_grf, slv1_fgr, slv2_fgr, &
- srv1_grf, srv2_grf, srv1_fgr, srv2_fgr, &
- slrv1_grf, slrv2_grf, slrv1_fgr, slrv2_fgr, &
- pv1_grf, pv2_grf, pv1_fgr, pv2_fgr, v2_grf, v2_fgr, &
- v2lr_grf, v2lr_fgr
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-pure function slv1_grf (gl, gravbar, v, psi) result (j)
- complex(kind=default) :: j
- complex(kind=default), intent(in) :: gl
- type(vectorspinor), intent(in) :: gravbar
- type(bispinor), intent(in) :: psi
- type(bispinor) :: psi_l
- type(vector), intent(in) :: v
- psi_l%a(1:2) = psi%a(1:2)
- psi_l%a(3:4) = 0
- j = gl * grg5vgf (gravbar, psi_l, v)
-end function slv1_grf
-@
-<<Implementation of bispinor currents>>=
-pure function srv1_grf (gr, gravbar, v, psi) result (j)
- complex(kind=default) :: j
- complex(kind=default), intent(in) :: gr
- type(vectorspinor), intent(in) :: gravbar
- type(bispinor), intent(in) :: psi
- type(bispinor) :: psi_r
- type(vector), intent(in) :: v
- psi_r%a(1:2) = 0
- psi_r%a(3:4) = psi%a(3:4)
- j = gr * grg5vgf (gravbar, psi_r, v)
-end function srv1_grf
-@
-<<Implementation of bispinor currents>>=
-pure function slrv1_grf (gl, gr, gravbar, v, psi) result (j)
- complex(kind=default) :: j
- complex(kind=default), intent(in) :: gl, gr
- type(vectorspinor), intent(in) :: gravbar
- type(bispinor), intent(in) :: psi
- type(bispinor) :: psi_l, psi_r
- type(vector), intent(in) :: v
- psi_l%a(1:2) = psi%a(1:2)
- psi_l%a(3:4) = 0
- psi_r%a(1:2) = 0
- psi_r%a(3:4) = psi%a(3:4)
- j = gl * grg5vgf (gravbar, psi_l, v) + gr * grg5vgf (gravbar, psi_r, v)
-end function slrv1_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}
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-pure function slv2_grf (gl, gravbar, phi, psi) result (j)
- type(vector) :: j
- complex(kind=default), intent(in) :: gl, phi
- type(vectorspinor), intent(in) :: gravbar
- type(bispinor), intent(in) :: psi
- type(bispinor) :: psi_l
- psi_l%a(1:2) = psi%a(1:2)
- psi_l%a(3:4) = 0
- j = sv2_grf (gl, gravbar, phi, psi_l)
-end function slv2_grf
-@
-<<Implementation of bispinor currents>>=
-pure function srv2_grf (gr, gravbar, phi, psi) result (j)
- type(vector) :: j
- complex(kind=default), intent(in) :: gr, phi
- type(vectorspinor), intent(in) :: gravbar
- type(bispinor), intent(in) :: psi
- type(bispinor) :: psi_r
- psi_r%a(1:2) = 0
- psi_r%a(3:4) = psi%a(3:4)
- j = sv2_grf (gr, gravbar, phi, psi_r)
-end function srv2_grf
-@
-<<Implementation of bispinor currents>>=
-pure function slrv2_grf (gl, gr, gravbar, phi, psi) result (j)
- type(vector) :: j
- complex(kind=default), intent(in) :: gl, gr, phi
- type(vectorspinor), intent(in) :: gravbar
- type(bispinor), intent(in) :: psi
- type(bispinor) :: psi_l, psi_r
- psi_l%a(1:2) = psi%a(1:2)
- psi_l%a(3:4) = 0
- psi_r%a(1:2) = 0
- psi_r%a(3:4) = psi%a(3:4)
- j = sv2_grf (gl, gravbar, phi, psi_l) + sv2_grf (gr, gravbar, phi, psi_r)
-end function slrv2_grf
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-pure function slv1_fgr (gl, psibar, v, grav) result (j)
- complex(kind=default) :: j
- complex(kind=default), intent(in) :: gl
- type(bispinor), intent(in) :: psibar
- type(bispinor) :: psibar_l
- type(vectorspinor), intent(in) :: grav
- type(vector), intent(in) :: v
- psibar_l%a(1:2) = psibar%a(1:2)
- psibar_l%a(3:4) = 0
- j = gl * fg5gkgr (psibar_l, grav, v)
-end function slv1_fgr
-@
-<<Implementation of bispinor currents>>=
-pure function srv1_fgr (gr, psibar, v, grav) result (j)
- complex(kind=default) :: j
- complex(kind=default), intent(in) :: gr
- type(bispinor), intent(in) :: psibar
- type(bispinor) :: psibar_r
- type(vectorspinor), intent(in) :: grav
- type(vector), intent(in) :: v
- psibar_r%a(1:2) = 0
- psibar_r%a(3:4) = psibar%a(3:4)
- j = gr * fg5gkgr (psibar_r, grav, v)
-end function srv1_fgr
-@
-<<Implementation of bispinor currents>>=
-pure function slrv1_fgr (gl, gr, psibar, v, grav) result (j)
- complex(kind=default) :: j
- complex(kind=default), intent(in) :: gl, gr
- type(bispinor), intent(in) :: psibar
- type(bispinor) :: psibar_l, psibar_r
- type(vectorspinor), intent(in) :: grav
- type(vector), intent(in) :: v
- psibar_l%a(1:2) = psibar%a(1:2)
- psibar_l%a(3:4) = 0
- psibar_r%a(1:2) = 0
- psibar_r%a(3:4) = psibar%a(3:4)
- j = gl * fg5gkgr (psibar_l, grav, v) + gr * fg5gkgr (psibar_r, grav, v)
-end function slrv1_fgr
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-pure function slv2_fgr (gl, psibar, phi, grav) result (j)
- type(vector) :: j
- complex(kind=default), intent(in) :: gl, phi
- type(bispinor), intent(in) :: psibar
- type(bispinor) :: psibar_l
- type(vectorspinor), intent(in) :: grav
- psibar_l%a(1:2) = psibar%a(1:2)
- psibar_l%a(3:4) = 0
- j = sv2_fgr (gl, psibar_l, phi, grav)
-end function slv2_fgr
-@
-<<Implementation of bispinor currents>>=
-pure function srv2_fgr (gr, psibar, phi, grav) result (j)
- type(vector) :: j
- complex(kind=default), intent(in) :: gr, phi
- type(bispinor), intent(in) :: psibar
- type(bispinor) :: psibar_r
- type(vectorspinor), intent(in) :: grav
- psibar_r%a(1:2) = 0
- psibar_r%a(3:4) = psibar%a(3:4)
- j = sv2_fgr (gr, psibar_r, phi, grav)
-end function srv2_fgr
-@
-<<Implementation of bispinor currents>>=
-pure function slrv2_fgr (gl, gr, psibar, phi, grav) result (j)
- type(vector) :: j
- complex(kind=default), intent(in) :: gl, gr, phi
- type(bispinor), intent(in) :: psibar
- type(bispinor) :: psibar_l, psibar_r
- type(vectorspinor), intent(in) :: grav
- psibar_l%a(1:2) = psibar%a(1:2)
- psibar_l%a(3:4) = 0
- psibar_r%a(1:2) = 0
- psibar_r%a(3:4) = psibar%a(3:4)
- j = sv2_fgr (gl, psibar_l, phi, grav) + sv2_fgr (gr, psibar_r, phi, grav)
-end function slrv2_fgr
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-pure function v2lr_grf (gl, gr, gravbar, v, psi) result (j)
- type(vector) :: j
- complex(kind=default), intent(in) :: gl, gr
- type(vectorspinor), intent(in) :: gravbar
- type(bispinor), intent(in) :: psi
- type(bispinor) :: psi_l, psi_r
- type(vector), intent(in) :: v
- psi_l%a(1:2) = psi%a(1:2)
- psi_l%a(3:4) = 0
- psi_r%a(1:2) = 0
- psi_r%a(3:4) = psi%a(3:4)
- j = -(gl * grkgggf (gravbar, psi_l, v) + gr * grkgggf (gravbar, psi_r, v))
-end function v2lr_grf
-@
-<<Implementation of bispinor currents>>=
-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
-@
-<<Implementation of bispinor currents>>=
-pure function v2lr_fgr (gl, gr, psibar, v, grav) result (j)
- type(vector) :: j
- complex(kind=default), intent(in) :: gl, gr
- type(vectorspinor), intent(in) :: grav
- type(bispinor), intent(in) :: psibar
- type(bispinor) :: psibar_l, psibar_r
- type(vector), intent(in) :: v
- psibar_l%a(1:2) = psibar%a(1:2)
- psibar_l%a(3:4) = 0
- psibar_r%a(1:2) = 0
- psibar_r%a(3:4) = psibar%a(3:4)
- j = -(gl * fggkggr (psibar_l, grav, v) + gr * fggkggr (psibar_r, grav, v))
-end function v2lr_fgr
-@ \subsection{On Shell Wave Functions}
-<<Declaration of bispinor 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}
-<<Implementation of bispinor on shell wave functions>>=
-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}
-<<Implementation of bispinor on shell wave functions>>=
-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
-@
-<<Implementation of bispinor on shell wave functions>>=
-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.
-<<Declaration of bispinor off shell wave functions>>=
-public :: brs_u, brs_v
-@
-In momentum space we have:
-\begin{equation}
-brs u(p)=(-i) (\fmslash p-m)u(p)
-\end{equation}
-<<Implementation of bispinor off shell wave functions>>=
-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}
-<<Implementation of bispinor off shell wave functions>>=
-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}
-<<Declaration of bispinor 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.
-<<Implementation of bispinor propagators>>=
-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}
-<<Implementation of bispinor propagators>>=
-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
-@
-<<Implementation of bispinor propagators>>=
-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}
-<<Implementation of bispinor propagators>>=
-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.f90]]>>=
-<<Copyleft>>
-module omega_vspinor_polarizations
- use kinds
- use constants
- use omega_vectors
- use omega_bispinors
- use omega_bispinor_couplings
- use omega_vectorspinors
- implicit none
- <<Declaration of polarization vectorspinors>>
- integer, parameter, public :: omega_vspinor_pols_2010_01_A = 0
-contains
- <<Implementation of polarization vectorspinors>>
-end module omega_vspinor_polarizations
-@
-<<Declaration of polarization vectorspinors>>=
-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$.
-<<Implementation of polarization vectorspinors>>=
-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
-@
-<<Implementation of polarization vectorspinors>>=
-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
-@
-<<Implementation of polarization vectorspinors>>=
-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
-@
-<<Implementation of polarization vectorspinors>>=
-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{Utilities}
-<<[[omega_utils.f90]]>>=
-<<Copyleft>>
-module omega_utils
- use kinds
- use omega_vectors
- use omega_polarizations
- implicit none
- private
- <<Declaration of utility functions>>
- <<Numerical tolerances>>
- integer, parameter, private :: REPEAT = 5, SAMPLE = 10
- integer, parameter, public :: omega_utils_2010_01_A = 0
-contains
- <<Implementation of utility functions>>
-end module omega_utils
-@ \subsection{Helicity Selection Rule Heuristics}
-<<Declaration of utility functions>>=
-public :: omega_update_helicity_selection
-@
-<<Implementation of utility functions>>=
-pure subroutine omega_update_helicity_selection &
- (count, amp, max_abs, sum_abs, mask, threshold, cutoff)
- integer, intent(inout) :: count
- complex(kind=default), dimension(:,:,:), intent(in) :: amp
- real(kind=default), dimension(:), intent(inout) :: max_abs
- real(kind=default), intent(inout) :: sum_abs
- logical, dimension(:), intent(out) :: mask
- real(kind=default), intent(in) :: threshold
- integer, intent(in) :: cutoff
- integer :: h
- real(kind=default) :: avg
- if (threshold .gt. 0) then
- count = count + 1
- if (count .le. cutoff) then
- forall (h = lbound (amp, 2) : ubound (amp, 2))
- max_abs(h) = max (max_abs(h), maxval (abs (amp(:,h,:))))
- end forall
- sum_abs = sum_abs + sum (abs (amp))
- if (count .eq. cutoff) then
- avg = sum_abs / size (amp) / cutoff
- mask = max_abs .ge. threshold * epsilon (avg) * avg
- end if
- end if
- end if
-end subroutine omega_update_helicity_selection
-@ \subsection{Diagnostics}
-<<Declaration of utility functions>>=
-public :: omega_report_helicity_selection
-@
-<<Implementation of utility functions>>=
-subroutine omega_report_helicity_selection (mask, spin_states, threshold)
- logical, dimension(:), intent(in) :: mask
- integer, dimension(:,:), intent(in) :: spin_states
- real(kind=default), intent(in) :: threshold
- integer :: h, i
- write (unit = *, &
- fmt = "('| ','Contributing Helicity Combinations: ', I5, ' of ', I5)") &
- count (mask), size (mask)
- write (unit = *, &
- fmt = "('| ','Threshold: amp / avg > ', E9.2, ' = ', E9.2, ' * epsilon()')") &
- threshold * epsilon (threshold), threshold
- i = 0
- do h = 1, size (mask)
- if (mask(h)) then
- i = i + 1
- write (unit = *, fmt = "('| ',I4,': ',20I4)") i, spin_states (:, h)
- end if
- end do
-end subroutine omega_report_helicity_selection
-@
-<<Declaration of utility functions>>=
-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}
-<<Implementation of utility functions>>=
-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
-@
-<<Implementation of utility functions>>=
-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
-@
-<<Declaration of utility functions>>=
-public :: omega_slavnov_warn, omega_slavnov_panic
-@
-<<Implementation of utility functions>>=
-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
-@
-<<Implementation of utility functions>>=
-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
-@
-<<Declaration of utility functions>>=
-public :: omega_check_arguments_warn, omega_check_arguments_panic
-@
-<<Implementation of utility functions>>=
-subroutine omega_check_arguments_warn (n, k)
- integer, intent(in) :: n
- real(kind=default), dimension(0:,:), intent(in) :: k
- 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
-end subroutine omega_check_arguments_warn
-@
-<<Implementation of utility functions>>=
-subroutine omega_check_arguments_panic (n, k)
- integer, intent(in) :: n
- real(kind=default), dimension(0:,:), intent(in) :: k
- 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
- if (error) then
- stop
- end if
-end subroutine omega_check_arguments_panic
-@
-<<Declaration of utility functions>>=
-public :: omega_check_helicities_warn, omega_check_helicities_panic
-private :: omega_check_helicity
-@
-<<Implementation of utility functions>>=
-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
-@
-<<Implementation of utility functions>>=
-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
-@
-<<Implementation of utility functions>>=
-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
-@
-<<Declaration of utility functions>>=
-public :: omega_check_momenta_warn, omega_check_momenta_panic
-private :: check_momentum_conservation, check_mass_shell
-@
-<<Numerical tolerances>>=
-integer, parameter, private :: MOMENTUM_TOLERANCE = 10000
-@
-<<Implementation of utility functions>>=
-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
-@
-<<Numerical tolerances>>=
-integer, parameter, private :: ON_SHELL_TOLERANCE = 1000000
-@
-<<Implementation of utility functions>>=
-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
-@
-<<Implementation of utility functions>>=
-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
-@
-<<Implementation of utility functions>>=
-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}
-<<Declaration of utility functions>>=
-public :: omega_spin_sum_sqme_1, omega_sum_sqme
-@
-<<Implementation of utility functions>>=
-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
- <<Interface [[amplitude_1]]>>
- 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 [[amplitude_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
-@
-<<Implementation of utility functions>>=
-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
- <<Interface [[amplitude_1]]>>
- 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
-@
-<<Declaration of utility functions>>=
-public :: omega_spin_sum_sqme_1_nonzero, omega_sum_sqme_nonzero
-@
-<<Implementation of utility functions>>=
-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
- <<Interface [[amplitude_1]]>>
- 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
-@
-<<Implementation of utility functions>>=
-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
- <<Interface [[amplitude_1]]>>
- 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
-@
-<<Declaration of utility functions>>=
-public :: omega_amplitude_1_nonzero, omega_amplitude_2_nonzero
-@
-<<Implementation of utility functions>>=
-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
- <<Interface [[amplitude_1]]>>
- 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
-@
-<<Implementation of utility functions>>=
-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
- <<Interface [[amplitude_2]]>>
- 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}
-<<Declaration of utility functions>>=
-public :: omega_scatter, omega_scatter_nonzero
-@
-<<Implementation of utility functions>>=
-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
- <<Interface [[amplitude_2]]>>
- 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 [[amplitude_2]]>>=
-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
-@
-<<Implementation of utility functions>>=
-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
- <<Interface [[amplitude_2]] (non zero)>>
- 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 [[amplitude_2]] (non zero)>>=
-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}
-<<Declaration of utility functions>>=
-public :: omega_scatter_diagonal, omega_scatter_diagonal_nonzero
-@
-<<Implementation of utility functions>>=
-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
- <<Interface [[amplitude_2]]>>
- 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
-@
-<<Implementation of utility functions>>=
-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
- <<Interface [[amplitude_2]] (non zero)>>
- 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}
-<<Declaration of utility functions>>=
-@
-<<Implementation of utility functions>>=
-@ \subsection{Obsolescent Summation}
-\subsubsection{Spin/Helicity Summation}
-<<Declaration of utility functions>>=
-public :: omega_sum, omega_sum_nonzero, omega_nonzero
-private :: state_index
-@
-<<Implementation of utility functions>>=
-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)
- <<Step [[s]] like a $n$-ary number and terminate when [[all (s == -1)]]>>
- 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)$:
-<<Step [[s]] like a $n$-ary number and terminate when [[all (s == -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:
-<<Implementation of utility functions>>=
-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
-@
-<<Implementation of utility functions>>=
-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
- <<Step [[s]] like a $n$-ary number and terminate when [[all (s == -1)]]>>
- end do sum_spins
- sigma = sigma / num_states (2, nstates(1:2))
-end subroutine omega_sum_nonzero
-@
-<<Declaration of utility functions>>=
-public :: num_states
-@
-<<Implementation of utility functions>>=
-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
-@
-<<Implementation of utility functions>>=
-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.f90]]>>=
-<<Copyleft>>
-module omega95
- use 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.f90]]>>=
-<<Copyleft>>
-module omega95_bispinors
- use 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{Testing}
-<<[[omega_testtools.f90]]>>=
-<<Copyleft>>
-module omega_testtools
- use kinds
- implicit none
- private
- public :: print_matrix
- public :: expect
- real(kind=default), parameter, private :: TOLERANCE = 1.0e8
- <<Declare [[expect]]>>
-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
- <<Implement [[expect]]>>
-end module omega_testtools
-@
-<<Declare [[expect]]>>=
-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
-@
-<<Implement [[expect]]>>=
-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
-@
-<<Implement [[expect]]>>=
-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
-@
-<<Implement [[expect]]>>=
-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
-@
-<<Implement [[expect]]>>=
-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
-@
-<<Implement [[expect]]>>=
-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
-@
-<<Implement [[expect]]>>=
-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_omega.f90]]>>=
-<<Copyleft>>
-program test_omega
- 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
- <<Test [[omega95]]>>
-end program test_omega
-@
-<<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")
-@
-<<Test [[omega95]]>>=
-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 ")
-@
-<<Test [[omega95]]>>=
-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")
-@
-<<Test [[omega95]]>>=
-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")
-@
-<<Test [[omega95]]>>=
-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
-@
-<<Test [[omega95]]>>=
-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
-@
-<<Test [[omega95]]>>=
-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}
-<<Test [[omega95]]>>=
-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}
-<<Test [[omega95]]>>=
-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}
-<<Test [[omega95]]>>=
-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)]")
-@
-<<Test [[omega95]]>>=
-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
-@
-<<Test [[omega95]]>>=
-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
-@
-<<XXX Test [[omega95]]>>=
-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")
-@
-<<Test [[omega95]]>>=
-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_omega_bispinors.f90]]>>=
-<<Copyleft>>
-program test_omega_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, two
- type(momentum) :: p, q, t, z, p_0
- type(vector) :: vp, vq, vt, vz
- type(vectorspinor) :: testv
- call random_seed ()
- one = 1
- two = 2
- 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_default, 0.0_default)
- 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.0_default, 0.0_default)
- testv%psi(4)%a(1) = (0.0_default, 2.0_default)
- testv%psi(4)%a(1) = (1.0_default, 0.0_default)
- testv%psi(4)%a(1) = (3.0_default, 0.0_default)
- vp = p
- vq = q
- vt = t
- vz = z
-<<Test [[omega95_bispinors]]>>
-end program test_omega_bispinors
-@
-<<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")
-@
-<<Test [[omega95_bispinors]]>>=
-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 ")
-@
-<<Test [[omega95_bispinors]]>>=
-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")
-@
-<<Test [[omega95_bispinors]]>>=
-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")
-@
-<<Test [[omega95_bispinors]]>>=
-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
-@
-<<Test [[omega95_bispinors]]>>=
-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
-@
-<<Test [[omega95_bispinors]]>>=
-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")
-@
-<<Test [[omega95_bispinors]]>>=
-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)")
-@
-<<Test [[omega95_bispinors]]>>=
-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")
-@
-<<Test [[omega95_bispinors]]>>=
-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_slgr (one, one, ueps(m,p,2), t) + &
- ueps(m,p,2) * gr_slf(one,one,u(m,q,1),t)), 0, "f_slgr + gr_slf = 0")
-call expect (abs(u (m,q,1) * f_srgr (one, one, ueps(m,p,2), t) + &
- ueps(m,p,2) * gr_srf(one,one,u(m,q,1),t)), 0, "f_srgr + gr_srf = 0")
-call expect (abs(u (m,q,1) * f_slrgr (one, two, one, ueps(m,p,2), t) + &
- ueps(m,p,2) * gr_slrf(one,two,one,u(m,q,1),t)), 0, "f_slrgr + gr_slrf = 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_vlrgr (one, two, vt, ueps(m,p,2), p+q) + &
- ueps(m,p,2) * gr_vlrf(one,two,vt,u(m,q,1),p+q)), 0, "f_vlrgr + gr_vlrf = 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(sl_grf (one, ueps(m,p,2), u(m,q,1),t) + &
- sl_fgr(one,u(m,q,1),ueps(m,p,2),t)), 0, "sl_grf + sl_fgr = 0")
-call expect (abs(sr_grf (one, ueps(m,p,2), u(m,q,1),t) + &
- sr_fgr(one,u(m,q,1),ueps(m,p,2),t)), 0, "sr_grf + sr_fgr = 0")
-call expect (abs(slr_grf (one, two, ueps(m,p,2), u(m,q,1),t) + &
- slr_fgr(one,two,u(m,q,1),ueps(m,p,2),t)), 0, "slr_grf + slr_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(vlr_grf (one, two, ueps(m,p,2), u(m,q,1),t) + &
- vlr_fgr(one,two,u(m,q,1),ueps(m,p,2),t)), 0, "vlr_grf + vlr_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(u (m,q,1) * f_slvgr (one, one, vt, ueps(m,p,2)) + &
- ueps(m,p,2) * gr_slvf(one,one,vt,u(m,q,1))), 0, "f_slvgr + gr_slvf = 0")
-call expect (abs(u (m,q,1) * f_srvgr (one, one, vt, ueps(m,p,2)) + &
- ueps(m,p,2) * gr_srvf(one,one,vt,u(m,q,1))), 0, "f_srvgr + gr_srvf = 0")
-call expect (abs(u (m,q,1) * f_slrvgr (one, two, one, vt, ueps(m,p,2)) + &
- ueps(m,p,2) * gr_slrvf(one,two,one,vt,u(m,q,1))), 0, "f_slrvgr + gr_slrvf = 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 (slv1_fgr (one,u(m,p,1),vt,ueps(m,q,2)) + slv1_grf(one, &
- ueps(m,q,2),vt,u(m,p,1))), 0, "slv1_fgr + slv1_grf = 0")
-call expect (abs (srv2_fgr (one,u(m,p,1),one,ueps(m,q,2)) + srv2_grf(one, &
- ueps(m,q,2),one,u(m,p,1))), 0, "srv2_fgr + srv2_grf = 0")
-call expect (abs (slrv1_fgr (one,two,u(m,p,1),vt,ueps(m,q,2)) + slrv1_grf(one,two, &
- ueps(m,q,2),vt,u(m,p,1))), 0, "slrv1_fgr + slrv1_grf = 0")
-call expect (abs (slrv2_fgr (one,two,u(m,p,1),one,ueps(m,q,2)) + slrv2_grf(one, &
- two,ueps(m,q,2),one,u(m,p,1))), 0, "slrv2_fgr + slrv2_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(u (m,q,1) * f_v2lrgr (one, two, vt, vz, ueps(m,p,2)) + &
- ueps(m,p,2) * gr_v2lrf(one,two,vt,vz,u(m,q,1))), 0, "f_v2lrgr + gr_v2lrf = 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")
-call expect (abs (v2lr_fgr (one,two,u(m,p,1),vt,ueps(m,q,2)) + v2lr_grf(one, two, &
- ueps(m,q,2),vt,u(m,p,1))), 0, "v2lr_fgr + v2lr_grf = 0")
-@
-<<Test [[omega95_bispinors]]>>=
-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.f90]]>>=
-<<[[omega_vectors.f90]]>>
-<<[[omega_spinors.f90]]>>
-<<[[omega_bispinors.f90]]>>
-<<[[omega_vectorspinors.f90]]>>
-<<[[omega_polarizations.f90]]>>
-<<[[omega_tensors.f90]]>>
-<<[[omega_tensor_polarizations.f90]]>>
-<<[[omega_couplings.f90]]>>
-<<[[omega_spinor_couplings.f90]]>>
-<<[[omega_bispinor_couplings.f90]]>>
-<<[[omega_vspinor_polarizations.f90]]>>
-<<[[omega_utils.f90]]>>
-<<[[omega95.f90]]>>
-<<[[omega95_bispinors.f90]]>>
-<<[[omega_parameters.f90]]>>
-<<[[omega_parameters_madgraph.f90]]>>
-@
-<<[[omega_bundle_whizard.f90]]>>=
-<<[[omega_bundle.f90]]>>
-<<[[omega_parameters_whizard.f90]]>>
-@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{O'Mega Virtual Machine}
-<<[[omegavm95.f90]]>>=
-<<Copyleft>>
-module omegavm95
- use kinds
- use omega95
- ! use omega95_bispinors
- implicit none
- private
- <<OVM Procedure Declarations>>
- <<OVM Data Declarations>>
- <<OVM Instructions>>
-contains
- <<OVM Procedure Implementations>>
-end module omegavm95
-@
-\subsection{Memory Layout}
-On one hand, we need a memory pool for all the intermediate results
-<<OVM Data Declarations>>=
-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
-@
-<<OVM Procedure Declarations>>=
-public :: alloc
-@
-<<OVM Procedure Implementations>>=
-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
-<<OVM Data Declarations>>=
-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}
-<<OVM Data Declarations>>=
-integer, parameter, private :: MAX_RHS = 3
-type, public :: instr
- private
- integer :: code, sign, coupl, lhs
- integer, dimension(MAX_RHS) :: rhs
-end type instr
-@
-<<OVM Procedure Declarations>>=
-public :: eval
-@
-<<OVM Procedure Implementations>>=
-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}
-<<OVM Instructions>>=
-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
-@
-<<OVM Instructions>>=
-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))
-@
-<<OVM Instructions>>=
-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))
-@
-<<OVM Instructions>>=
-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)))
-@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-<<Copyleft>>=
-! $Id$
-!
-! Copyright (C) 1999-2009 by
-! Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
-! Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
-! Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-!
-! 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.
-!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-% 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/hgg-vertex/src/algebra.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/algebra.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/algebra.ml (revision 8717)
@@ -1,383 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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/hgg-vertex/src/modellib_MSSM.mli
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/modellib_MSSM.mli (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/modellib_MSSM.mli (revision 8717)
@@ -1,46 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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
- val gravitino : 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_Grav : 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/hgg-vertex/src/modellib_SM.mli
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/modellib_SM.mli (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/modellib_SM.mli (revision 8717)
@@ -1,62 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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{Hardcoded Models} *)
-
-module Phi3 : Model.T
-module Phi4 : Model.T
-module QED : Model.T
-module YM : Model.T
-
-module type SM_flags =
- sig
- val higgs_triangle : bool (* $H\gamma\gamma$, $Hg\gamma$ and $Hgg couplings *)
- 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 SM_Hgg : 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/hgg-vertex/src/omega_SMh.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/omega_SMh.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/omega_SMh.ml (revision 8717)
@@ -1,34 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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)(Modellib_SM.SM(Modellib_SM.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/hgg-vertex/src/target.mli
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/target.mli (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/target.mli (revision 8717)
@@ -1,50 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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 | 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/hgg-vertex/src/omega_Threeshl_nohf.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/omega_Threeshl_nohf.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/omega_Threeshl_nohf.ml (revision 8717)
@@ -1,33 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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)
- (Modellib_BSM.Threeshl(Modellib_BSM.Threeshl_no_ckm_no_hf))
-let _ = O.main ()
-
-(*i
- * Local Variables:
- * mode:caml
- * indent-tabs-mode:nil
- * page-delimiter:"^(\\* .*\n"
- * End:
-i*)
Index: branches/ohl/omega-development/hgg-vertex/src/Makefile.ocaml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/Makefile.ocaml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/Makefile.ocaml (revision 8717)
@@ -1,66 +0,0 @@
-# Makefile.am -- O'Caml rules for O'Mega Makefiles
-# $Id$
-##
-## Process Makefile.am with automake to include this file in Makefile.in
-##
-########################################################################
-#
-# Copyright (C) 1999-2009 by
-# Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
-# Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
-# Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-#
-# 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.
-#
-########################################################################
-
-OCAMLC += $(DBG)
-OCAMLCI = $(OCAMLC)
-OCAMLFLAGS =
-OCAMLOPTFLAGS = -inline 64 $(GPROF)
-OCAML_NATIVE_EXT = .opt
-OCAML_BYTECODE_EXT = .bin
-
-########################################################################
-
-SUFFIXES = .mll .mly .ml .mli .cmi .cmo .cmx .bin .opt
-
-.cmx$(OCAML_NATIVE_EXT):
- $(OCAMLOPT) $(OCAMLFLAGS) $(OCAMLOPTFLAGS) -o $@ $(OMEGA_CMXA) $<
-
-.cmo$(OCAML_BYTECODE_EXT):
- $(OCAMLC) $(OCAMLFLAGS) -o $@ $(OMEGA_CMA) $<
-
-.ml.cmx:
- $(OCAMLOPT) $(OCAMLFLAGS) $(OCAMLOPTFLAGS) -o $@ -c $<
-
-.mli.cmi:
- $(OCAMLCI) $(OCAMLFLAGS) -o $@ -c $<
-
-.ml.cmo:
- $(OCAMLC) $(OCAMLFLAGS) -o $@ -c $<
-
-.mll.ml:
- $(OCAMLLEX) -o $@ $<
-
-.mly.mli:
- $(OCAMLYACC) -b$* $<
-
-.mly.ml:
- $(OCAMLYACC) -b$* $<
-
-########################################################################
-## The End.
-########################################################################
Index: branches/ohl/omega-development/hgg-vertex/src/omega_2HDM.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/omega_2HDM.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/omega_2HDM.ml (revision 8717)
@@ -1,570 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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 = Modeltools.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 "Modellib_SM.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
- "Modellib_SM.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
- "Modellib_SM.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
- "Modellib_SM.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
- "Modellib_SM.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_to_TeX = flavor_to_TeX
- 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/hgg-vertex/src/options.mli
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/options.mli (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/options.mli (revision 8717)
@@ -1,39 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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 extend : t -> (string * Arg.spec * string) list -> 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/hgg-vertex/src/algebra.mli
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/algebra.mli (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/algebra.mli (revision 8717)
@@ -1,184 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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/hgg-vertex/src/omega_Xdim.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/omega_Xdim.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/omega_Xdim.ml (revision 8717)
@@ -1,33 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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)
- (Modellib_BSM.Xdim(Modellib_BSM.BSM_bsm))
-let _ = O.main ()
-
-(*i
- * Local Variables:
- * mode:caml
- * indent-tabs-mode:nil
- * page-delimiter:"^(\\* .*\n"
- * End:
-i*)
Index: branches/ohl/omega-development/hgg-vertex/src/omega_SM_Rxi.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/omega_SM_Rxi.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/omega_SM_Rxi.ml (revision 8717)
@@ -1,32 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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)(Modellib_SM.SM_Rxi)
-let _ = O.main ()
-
-(*i
- * Local Variables:
- * mode:caml
- * indent-tabs-mode:nil
- * page-delimiter:"^(\\* .*\n"
- * End:
-i*)
Index: branches/ohl/omega-development/hgg-vertex/src/omega_Simplest_univ.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/omega_Simplest_univ.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/omega_Simplest_univ.ml (revision 8717)
@@ -1,33 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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)
- (Modellib_BSM.Simplest(Modellib_BSM.BSM_anom))
-let _ = O.main ()
-
-(*i
- * Local Variables:
- * mode:caml
- * indent-tabs-mode:nil
- * page-delimiter:"^(\\* .*\n"
- * End:
-i*)
Index: branches/ohl/omega-development/hgg-vertex/src/config.ml.in
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/config.ml.in (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/config.ml.in (revision 8717)
@@ -1,48 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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 max_color_lines = @OMEGA_MAX_COLOR_LINES@
-
-let system_cache_dir = "@OMEGA_SYSTEM_CACHE_DIR@"
-let user_cache_dir = "@OMEGA_USER_CACHE_DIR@"
-
-(* \begin{dubious}
- This relies on the fast that the executable names should be unique.
- \end{dubious} *)
-let cache_prefix =
- let basename = Filename.basename Sys.executable_name in
- try Filename.chop_extension basename with | _ -> basename
-
-let cache_suffix = "@OMEGA_CACHE_SUFFIX@"
-
-(*i
- * Local Variables:
- * mode:caml
- * indent-tabs-mode:nil
- * page-delimiter:"^(\\* .*\n"
- * End:
-i*)
-
-
-
-
-
Index: branches/ohl/omega-development/hgg-vertex/src/comphep_syntax.mli
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/comphep_syntax.mli (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/comphep_syntax.mli (revision 8717)
@@ -1,50 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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/hgg-vertex/src/vertex.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/vertex.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/vertex.ml (revision 8717)
@@ -1,211 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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/hgg-vertex/src/omega_QCD.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/omega_QCD.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/omega_QCD.ml (revision 8717)
@@ -1,240 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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
- = "$Source: /home/sources/ohl/ml/omega/src/omega_QCD.ml,v $" }
-
-(* 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 = Modeltools.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_to_TeX = function
- | U -> "u"
- | Ubar -> "\bar{u}"
- | D -> "d"
- | Dbar -> "\bar{d}"
- | C -> "c"
- | Cbar -> "bar{c}"
- | S -> "s"
- | Sbar -> "\bar{s}"
- | T -> "t"
- | Tbar -> "\bar{t}"
- | B -> "b"
- | Bbar -> "\bar{b}"
- | Gl -> "g"
-
- 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_to_TeX = flavor_to_TeX
- 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/hgg-vertex/src/model_syntax.mli
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/model_syntax.mli (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/model_syntax.mli (revision 8717)
@@ -1,67 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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/hgg-vertex/src/omega_QED.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/omega_QED.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/omega_QED.ml (revision 8717)
@@ -1,32 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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)(Modellib_SM.QED)
-let _ = O.main ()
-
-(*i
- * Local Variables:
- * mode:caml
- * indent-tabs-mode:nil
- * page-delimiter:"^(\\* .*\n"
- * End:
-i*)
Index: branches/ohl/omega-development/hgg-vertex/src/cascade.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/cascade.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/cascade.ml (revision 8717)
@@ -1,272 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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/hgg-vertex/src/vertex.mli
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/vertex.mli (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/vertex.mli (revision 8717)
@@ -1,56 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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/hgg-vertex/src/dAG.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/dAG.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/dAG.ml (revision 8717)
@@ -1,496 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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 dependencies : t -> node -> node Tree2.t
- 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 dependencies dag node =
- let rec dependencies' node' =
- let offspring = Parents.find node' dag in
- if Offspring.is_empty offspring then
- Tree2.leaf node'
- else
- Tree2.cons
- (Offspring.fold
- (fun o acc ->
- (node', F.fold (fun wf acc' -> dependencies' wf :: acc') o []) :: acc)
- offspring [])
- in
- dependencies' node
-
- 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.cons (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/hgg-vertex/src/omega_NMSSM_CKM.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/omega_NMSSM_CKM.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/omega_NMSSM_CKM.ml (revision 8717)
@@ -1,33 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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)
- (Modellib_NMSSM.NMSSM_func(Modellib_NMSSM.NMSSM_CKM))
-let _ = O.main ()
-
-(*i
- * Local Variables:
- * mode:caml
- * indent-tabs-mode:nil
- * page-delimiter:"^(\\* .*\n"
- * End:
-i*)
Index: branches/ohl/omega-development/hgg-vertex/src/omega_Littlest_Tpar.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/omega_Littlest_Tpar.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/omega_Littlest_Tpar.ml (revision 8717)
@@ -1,33 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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)
- (Modellib_BSM.Littlest_Tpar(Modellib_BSM.BSM_bsm))
-let _ = O.main ()
-
-(*i
- * Local Variables:
- * mode:caml
- * indent-tabs-mode:nil
- * page-delimiter:"^(\\* .*\n"
- * End:
-i*)
Index: branches/ohl/omega-development/hgg-vertex/src/fusion.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/fusion.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/fusion.ml (revision 8717)
@@ -1,1643 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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
- val options : Options.t
- 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 dependencies : amplitude -> wf -> wf Tree2.t
- 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 initialize_cache : string -> unit
- 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" ]
-
- type cache_mode = Cache_Use | Cache_Ignore | Cache_Overwrite
- let cache_option = ref Cache_Use
-
- let options = Options.create
- [ "ignore-cache", Arg.Unit (fun () -> cache_option := Cache_Ignore),
- "ignore cached model tables";
- "overwrite-cache", Arg.Unit (fun () -> cache_option := Cache_Overwrite),
- "overwrite cached model tables" ]
-
- 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!} *)
-
- type vertices = (flavor * (constant Coupling.t * flavor PT.t) list) list
-
- let vertices_nocache max_degree flavors : vertices =
- VSet.fold (fun f rhs v -> (f, rhs) :: v)
- (PT.power_fold collect_vertices flavors VSet.empty) []
-
-(* Performance hack: *)
-
- type vertex_table =
- ((flavor * flavor * flavor) * constant Coupling.vertex3 * constant) list
- * ((flavor * flavor * flavor * flavor) * constant Coupling.vertex4 * constant) list
- * (flavor list * constant Coupling.vertexn * constant) list
-
- module VCache =
- Cache.Make (struct type t = vertex_table end) (struct type t = RCS.t * vertices end)
-
- let vertices_cache = ref None
- let hash = VCache.hash (M.vertices ())
-
- let filename = Config.cache_prefix
-
- let vertices max_degree flavors : vertices =
- match !vertices_cache with
- | None ->
- begin match !cache_option with
- | Cache_Use ->
- begin match VCache.maybe_read hash filename with
- | None ->
- Printf.eprintf
- " >>> Initializing lookup table. This may take some time ... ";
- flush stderr;
- let result = vertices_nocache max_degree flavors in
- VCache.write hash filename (M.rcs, result);
- vertices_cache := Some result;
- Printf.eprintf "done. <<< \n";
- flush stderr;
- result
- | Some (rcs, result) -> result
- end
- | Cache_Overwrite ->
- Printf.eprintf
- " >>> Overwriting lookup table. This may take some time ... ";
- flush stderr;
- let result = vertices_nocache max_degree flavors in
- VCache.write hash filename (M.rcs, result);
- vertices_cache := Some result;
- Printf.eprintf "done. <<< \n";
- flush stderr;
- result
- | Cache_Ignore ->
- Printf.eprintf
- " >>> Ignoring lookup table. This may take some time ... ";
- flush stderr;
- let result = vertices_nocache max_degree flavors in
- vertices_cache := Some result;
- Printf.eprintf "done. <<< \n";
- flush stderr;
- 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
-(*i | Coupling.Ward_Vector -> 19 i*)
-
- 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;
- dependencies : wf -> wf Tree2.t;
- 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 lhs a.fusions
- let dependencies a = a.dependencies
-
- 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} *)
-
- module WFMap = Map.Make (struct type t = wf let compare = compare end)
-
-(* [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_dag = D.map f (fun node rhs -> map_rhs rhs) in
- let tower = map_dag a.fusion_tower
- and dag = map_dag a.fusion_dag in
- let dependencies_map =
- D.fold (fun wf _ -> WFMap.add wf (D.dependencies dag wf)) dag WFMap.empty in
- { fusions = List.map map_fusion a.fusions;
- brakets = List.map map_braket 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;
- dependencies = (fun wf -> WFMap.find wf dependencies_map);
- fusion_tower = tower;
- fusion_dag = 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
-
- let dependencies_map =
- D.fold (fun wf _ -> WFMap.add wf (D.dependencies dag wf)) dag WFMap.empty 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;
- dependencies = (fun wf -> WFMap.find wf dependencies_map);
- fusion_tower = tower;
- fusion_dag = dag }
-
- let initialize_cache dir =
- Printf.eprintf " >>> Initializing lookup table. This may take some time ... ";
- flush stderr;
- VCache.write_dir hash dir filename
- (M.rcs, vertices_nocache (M.max_degree ()) (M.flavors()));
- Printf.eprintf "done. <<< \n"
-
-(* \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 process = flavor list * flavor list
- type amplitude
- type selectors
- type amplitudes
- val amplitudes : bool -> selectors -> process list -> amplitudes
- val empty : amplitudes
- val initialize_cache : string -> unit
- val flavors : amplitudes -> process list
- val vanishing_flavors : amplitudes -> process list
- val color_flows : amplitudes -> Color.Flow.t list
- val helicities : amplitudes -> (int list * int list) list
- val processes : amplitudes -> amplitude list
- val process_table : amplitudes -> amplitude option array array
- val color_factors : amplitudes -> int option array array
- 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_mode =
- | Quiet
- | Channel of out_channel
- | File of string
-
- let progress_option = ref Quiet
-
- module F = Fusion_Maker(P)(CM)
- module C = Cascade.Make(CM)(P)
-
- let options = Options.extend F.options
- [ "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" ]
-
- type flavor = CM.flavor_sans_color
- type p = F.p
- type process = flavor list * flavor list
- 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 : process list;
- vanishing_flavors : process list;
- color_flows : Color.Flow.t list;
- helicities : (int list * int list) list;
- processes : amplitude list;
- process_table : amplitude option array array;
- color_factors : int option array array;
- constraints : string option }
-
- let flavors a = a.flavors
- let vanishing_flavors a = a.vanishing_flavors
- let color_flows a = a.color_flows
- let helicities a = a.helicities
- let processes a = a.processes
- let process_table a = a.process_table
- let color_factors a = a.color_factors
- 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_sans_color a =
- (sans_colors (F.incoming a), sans_colors (F.outgoing a))
-
- let color_flow a =
- CM.flow (F.incoming a) (F.outgoing a)
-
- 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.length colored_processes
-
- module FMap =
- Map.Make (struct type t = process let compare = compare end)
-
- module CMap =
- Map.Make (struct type t = Color.Flow.t let compare = compare end)
-
-(* 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))
-
- module Proc = Process.Make (CM.M)
-
-(* \thocwmodulesubsection{Calculate All The Amplitudes} *)
-
- let amplitudes goldstones select_wf processes =
-
-(* \begin{dubious}
- Eventually, we might want to support inhomogeneous helicities. However,
- this makes little physics sense for external particles on the mas shell,
- unless we have a model with degenerate massive fermions and bosons.
- \end{dubious} *)
-
- if not (ThoList.homogeneous (List.map hs_of_flavors processes)) then
- invalid_arg "Fusion.Colored.amplitudes: incompatible helicities";
-
- let colored_processes =
- ThoList.flatmap
- (fun p -> CM.amplitude (Proc.incoming p) (Proc.outgoing p))
- (Proc.remove_duplicate_final_states 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
- (fun (fi, fo) ->
- Progress.begin_step progress (process_to_string fi fo);
- let amp = F.amplitude goldstones select_wf fi fo in
- if F.allowed amp then
- Progress.end_step progress "allowed"
- else
- Progress.end_step progress "forbidden";
- amp) colored_processes in
-
- Progress.summary progress "all processes done";
-
- let allowed =
- List.filter F.allowed all in
-
- let color_flows =
- ThoList.uniq (List.sort compare (List.map color_flow allowed))
- and flavors =
- ThoList.uniq (List.sort compare (List.map process_sans_color allowed)) in
-
- let vanishing_flavors =
- Proc.remove_duplicate_final_states (Proc.diff processes flavors) in
-
- let helicities =
- helicity_table flavors in
-
- let f_index =
- fst (List.fold_left
- (fun (m, i) f -> (FMap.add f i m, succ i))
- (FMap.empty, 0) flavors)
- and c_index =
- fst (List.fold_left
- (fun (m, i) c -> (CMap.add c i m, succ i))
- (CMap.empty, 0) color_flows) in
-
- let table =
- Array.make_matrix (List.length flavors) (List.length color_flows) None in
- List.iter
- (fun a ->
- let f = FMap.find (process_sans_color a) f_index
- and c = CMap.find (color_flow a) c_index in
- table.(f).(c) <- Some (a))
- allowed;
-
- let cf_array = Array.of_list color_flows in
- let ncf = Array.length cf_array in
- let color_factor_table = Array.make_matrix ncf ncf None in
-
- for i = 0 to pred ncf do
- for j = 0 to i do
- color_factor_table.(i).(j) <-
- Color.Flow.power_of_nc cf_array.(i) cf_array.(j);
- color_factor_table.(j).(i) <-
- color_factor_table.(i).(j)
- done
- done;
-
- { flavors = flavors;
- vanishing_flavors = vanishing_flavors;
- color_flows = color_flows;
- helicities = helicities;
- processes = allowed;
- process_table = table;
- color_factors = color_factor_table;
- constraints = C.description select_wf }
-
- let initialize_cache = F.initialize_cache
-
- let empty =
- { flavors = [];
- vanishing_flavors = [];
- color_flows = [];
- helicities = [];
- processes = [];
- process_table = Array.make_matrix 0 0 None;
- color_factors = Array.make_matrix 0 0 None;
- constraints = None }
-
- end
-
-(*i
- * Local Variables:
- * mode:caml
- * indent-tabs-mode:nil
- * page-delimiter:"^(\\* .*\n"
- * End:
-i*)
Index: branches/ohl/omega-development/hgg-vertex/src/whizard_tool.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/whizard_tool.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/whizard_tool.ml (revision 8717)
@@ -1,69 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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/hgg-vertex/src/omega_MSSM_Grav.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/omega_MSSM_Grav.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/omega_MSSM_Grav.ml (revision 8717)
@@ -1,33 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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)
- (Modellib_MSSM.MSSM(Modellib_MSSM.MSSM_Grav))
-let _ = O.main ()
-
-(*i
- * Local Variables:
- * mode:caml
- * indent-tabs-mode:nil
- * page-delimiter:"^(\\* .*\n"
- * End:
-i*)
Index: branches/ohl/omega-development/hgg-vertex/src/omega_GravTest.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/omega_GravTest.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/omega_GravTest.ml (revision 8717)
@@ -1,33 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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)
- (Modellib_BSM.GravTest(Modellib_BSM.BSM_bsm))
-let _ = O.main ()
-
-(*i
- * Local Variables:
- * mode:caml
- * indent-tabs-mode:nil
- * page-delimiter:"^(\\* .*\n"
- * End:
-i*)
Index: branches/ohl/omega-development/hgg-vertex/src/tree.mli
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/tree.mli (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/tree.mli (revision 8717)
@@ -1,118 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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
-
-(* [cons n ch] returns a tree node. *)
-val cons : 'n -> ('n, 'l) t list -> ('n, 'l) t
-
-(* [node t] returns the top node of the tree [t]. *)
-val node : ('n, 'l) t -> 'n
-
-(* [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} *)
-(* \begin{dubious}
- [style : (string * string) option] should be replaced by
- [style : string option; tex_label : string option]
- \end{dubious} *)
-type feynmf =
- { style : (string * string) option;
- rev : bool;
- label : string option;
- tension : float option }
-val vanilla : feynmf
-val sty : (string * 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/hgg-vertex/src/model.mli
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/model.mli (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/model.mli (revision 8717)
@@ -1,271 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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
-
-(* \TeX{} and \LaTeX{} *)
- val flavor_to_TeX : flavor -> string
- val flavor_sans_color_to_TeX : 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_to_TeX:(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/hgg-vertex/src/partition.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/partition.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/partition.ml (revision 8717)
@@ -1,91 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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/hgg-vertex/src/omega_SM3_ac.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/omega_SM3_ac.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/omega_SM3_ac.ml (revision 8717)
@@ -1,33 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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)
- (Modellib_SM.SM3(Modellib_SM.SM_anomalous))
-let _ = O.main ()
-
-(*i
- * Local Variables:
- * mode:caml
- * indent-tabs-mode:nil
- * page-delimiter:"^(\\* .*\n"
- * End:
-i*)
Index: branches/ohl/omega-development/hgg-vertex/src/modellib_NMSSM.mli
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/modellib_NMSSM.mli (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/modellib_NMSSM.mli (revision 8717)
@@ -1,45 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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 NMSSM_flags =
- sig
- val ckm_present : bool
- end
-
-module NMSSM : NMSSM_flags
-module NMSSM_CKM : NMSSM_flags
-module NMSSM_func : functor (F: NMSSM_flags) -> Model.T
-
-(*i
- * Local Variables:
- * mode:caml
- * indent-tabs-mode:nil
- * page-delimiter:"^(\\* .*\n"
- * End:
-i*)
Index: branches/ohl/omega-development/hgg-vertex/src/thoGDraw.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/thoGDraw.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/thoGDraw.ml (revision 8717)
@@ -1,751 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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/hgg-vertex/src/vertex_parser.mly
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/vertex_parser.mly (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/vertex_parser.mly (revision 8717)
@@ -1,146 +0,0 @@
-/* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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/hgg-vertex/src/topology.mli
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/topology.mli (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/topology.mli (revision 8717)
@@ -1,160 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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/hgg-vertex/src/modellib_BSM.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/modellib_BSM.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/modellib_BSM.ml (revision 8717)
@@ -1,6062 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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 "Modellib_BSM" ["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 "Modellib_BSM.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 = Modeltools.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 "Modellib_BSM.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 "Modellib_BSM.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 "Modellib_BSM.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 "Modellib_BSM.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 "Modellib_BSM.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_to_TeX = 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 "Modellib_BSM.Littlest.flavor_to_TeX"
- | N 1 -> "\\nu_e" | N (-1) -> "\\bar{\\nu}_e"
- | N 2 -> "\\nu_\\mu" | N (-2) -> "\\bar{\\nu}_\\mu"
- | N 3 -> "\\nu_\\tau" | N (-3) -> "\\bar{\\nu}_\\tau"
- | N _ -> invalid_arg "Modellib_BSM.Littlest.flavor_to_TeX"
- | U 1 -> "u" | U (-1) -> "\\bar{u}"
- | U 2 -> "c" | U (-2) -> "\\bar{c}"
- | U 3 -> "t" | U (-3) -> "\\bar{t}"
- | U _ -> invalid_arg "Modellib_BSM.Littlest.flavor_to_TeX"
- | D 1 -> "d" | D (-1) -> "\\bar{d}"
- | D 2 -> "s" | D (-2) -> "\\bar{s}"
- | D 3 -> "b" | D (-3) -> "\\bar{b}"
- | D _ -> invalid_arg "Modellib_BSM.Littlest.flavor_to_TeX"
- | TopH -> "T" | TopHb -> "\\bar{T}"
- end
- | G f ->
- begin match f with
- | Gl -> "g"
- | Ga -> "\\gamma" | Z -> "Z"
- | Wp -> "W^+" | Wm -> "W^-"
- | ZH -> "Z_H" | AH -> "\\gamma_H" | WHp -> "W_H^+" | WHm -> "W_H^-"
- end
- | O f ->
- begin match f with
- | Phip -> "\\Phi^+" | Phim -> "\\Phi^-" | Phi0 -> "\\Phi^0"
- | H -> "H" | Eta -> "\\eta"
- | Psi0 -> "\\Psi_S" | Psi1 -> "\\Psi_P" | 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_to_TeX = flavor_to_TeX
- 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 "Modellib_BSM.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 = Modeltools.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 "Modellib_BSM.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 "Modellib_BSM.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 "Modellib_BSM.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 "Modellib_BSM.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 "Modellib_BSM.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 "Modellib_BSM.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 "Modellib_BSM.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 "Modellib_BSM.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 "Modellib_BSM.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_to_TeX = function
- | L 1 -> "e^-" | L (-1) -> "e^+"
- | L 2 -> "\\mu^-" | L (-2) -> "\\mu^+"
- | L 3 -> "\\tau^-" | L (-3) -> "\\tau^+"
- | L _ -> invalid_arg "Modellib_BSM.Littlest_Tpar.flavor_to_TeX"
- | N 1 -> "\\nu_e" | N (-1) -> "\\bar{\\nu}_e"
- | N 2 -> "\\nu_\\mu" | N (-2) -> "\\bar{\\nu}_\\mu"
- | N 3 -> "\\nu_\\tau" | N (-3) -> "\\bar{\\nu}_\\tau"
- | N _ -> invalid_arg "Modellib_BSM.Littlest_Tpar.flavor_to_TeX"
- | Lodd 1 -> "L_1^-" | Lodd (-1) -> "L_1^+"
- | Lodd 2 -> "L_2^-" | Lodd (-2) -> "L_2^+"
- | Lodd 3 -> "L_3^-" | Lodd (-3) -> "L_3^+"
- | Lodd _ -> invalid_arg "Modellib_BSM.Littlest_Tpar.flavor_to_TeX"
- | Nodd 1 -> "N_1" | Nodd (-1) -> "\\bar{N}_1"
- | Nodd 2 -> "N_2" | Nodd (-2) -> "\\bar{N}_2"
- | Nodd 3 -> "N_3" | Nodd (-3) -> "\\bar{N}_3"
- | Nodd _ -> invalid_arg "Modellib_BSM.Littlest_Tpar.flavor_to_TeX"
- | U 1 -> "u" | U (-1) -> "\\bar{u}"
- | U 2 -> "c" | U (-2) -> "\\bar{c}"
- | U 3 -> "t" | U (-3) -> "\\bar{t}"
- | U _ -> invalid_arg "Modellib_BSM.Littlest_Tpar.flavor_to_TeX"
- | D 1 -> "d" | D (-1) -> "\\bar{d}"
- | D 2 -> "s" | D (-2) -> "\\bar{s}"
- | D 3 -> "b" | D (-3) -> "\\bar{b}"
- | D _ -> invalid_arg "Modellib_BSM.Littlest_Tpar.flavor_to_TeX"
- | Uodd 1 -> "U" | Uodd (-1) -> "\\bar{U}"
- | Uodd 2 -> "C" | Uodd (-2) -> "\\bar{C}"
- | Uodd 3 -> "T_1" | Uodd (-3) -> "\\bar{T}_1"
- | Uodd 4 -> "T_2" | Uodd (-4) -> "\\bar{T}_2"
- | Uodd _ -> invalid_arg "Modellib_BSM.Littlest_Tpar.flavor_to_TeX"
- | Dodd 1 -> "D" | Dodd (-1) -> "\\bar{D}"
- | Dodd 2 -> "S" | Dodd (-2) -> "\\bar{S}"
- | Dodd 3 -> "B" | Dodd (-3) -> "\\bar{B}"
- | Dodd _ -> invalid_arg "Modellib_BSM.Littlest_Tpar.flavor_to_TeX"
- | Topp -> "T^\\prime" | Toppb -> "\\bar{T}^\\prime"
- | Gl -> "g"
- | Ga -> "\\gamma" | Z -> "Z"
- | Wp -> "W^+" | Wm -> "W^-"
- | ZH -> "Z_H" | AH -> "\\gamma_H" | WHp -> "W_H^+" | WHm -> "W_H^-"
- | Phip -> "\\Phi^+" | Phim -> "\\Phi^-" | Phi0 -> "\\Phi^0"
- | H -> "H" | Eta -> "\\eta"
- | Psi0 -> "\\Psi_S" | Psi1 -> "\\Psi_P" | 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_to_TeX = flavor_to_TeX
- 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 "Modellib_BSM.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 = Modeltools.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
- "Modellib_BSM.Simplest.flavor_of_string"
- | "dh" -> if Flags.anom_ferm_ass then invalid_arg
- "Modellib_BSM.Simplest.flavor_of_string" else QH 1
- | "uhbar" -> if Flags.anom_ferm_ass then QH (-1) else invalid_arg
- "Modellib_BSM.Simplest.flavor_of_string"
- | "dhbar" -> if Flags.anom_ferm_ass then invalid_arg
- "Modellib_BSM.Simplest.flavor_of_string" else QH (-1)
- | "ch" -> if Flags.anom_ferm_ass then QH 2 else invalid_arg
- "Modellib_BSM.Simplest.flavor_of_string"
- | "sh" -> if Flags.anom_ferm_ass then invalid_arg
- "Modellib_BSM.Simplest.flavor_of_string" else QH 2
- | "chbar" -> if Flags.anom_ferm_ass then QH (-2) else invalid_arg
- "Modellib_BSM.Simplest.flavor_of_string"
- | "shbar" -> if Flags.anom_ferm_ass then invalid_arg
- "Modellib_BSM.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 "Modellib_BSM.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
- "Modellib_BSM.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
- "Modellib_BSM.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
- "Modellib_BSM.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
- "Modellib_BSM.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
- "Modellib_BSM.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_to_TeX = function
- | L 1 -> "e^-" | L (-1) -> "\\e^+"
- | L 2 -> "\\mu^-" | L (-2) -> "\\mu^+"
- | L 3 -> "\\tau^-" | L (-3) -> "\\tau^+"
- | L _ -> invalid_arg
- "Modellib_BSM.Simplest.flavor_to_TeX: invalid lepton"
- | N 1 -> "\\nu_e" | N (-1) -> "\\bar{\\nu}_e"
- | N 2 -> "\\nu_\\mu" | N (-2) -> "\\bar{\\nu}_\\mu"
- | N 3 -> "\\nu_\\tau" | N (-3) -> "\\bar{\\nu}_\\tau"
- | N _ -> invalid_arg
- "Modellib_BSM.Simplest.flavor_to_TeX: invalid neutrino"
- | U 1 -> "u" | U (-1) -> "\\bar{u}"
- | U 2 -> "c" | U (-2) -> "\\bar{c}"
- | U 3 -> "t" | U (-3) -> "\\bar{t}"
- | U _ -> invalid_arg
- "Modellib_BSM.Simplest.flavor_to_TeX: invalid up type quark"
- | D 1 -> "d" | D (-1) -> "\\bar{d}"
- | D 2 -> "s" | D (-2) -> "\\bar{s}"
- | D 3 -> "b" | D (-3) -> "\\bar{b}"
- | D _ -> invalid_arg
- "Modellib_BSM.Simplest.flavor_to_TeX: invalid down type quark"
- | QH 1 -> if Flags.anom_ferm_ass then "U" else "D"
- | QH 2 -> if Flags.anom_ferm_ass then "C" else "S"
- | QH 3 -> "T"
- | QH (-1) -> if Flags.anom_ferm_ass then "\\bar{U}" else "\\bar{D}"
- | QH (-2) -> if Flags.anom_ferm_ass then "\\bar{C}" else "\\bar{S}"
- | QH (-3) -> "thbar"
- | QH _ -> invalid_arg
- "Modellib_BSM.Simplest.flavor_to_TeX: invalid heavy quark"
- | NH n when n > 0 -> "N_" ^ string_of_int n
- | NH n -> "\\bar{N}_" ^ string_of_int (abs n)
- | Ga -> "\\gamma" | Z -> "Z" | Gl -> "g"
- | Wp -> "W^+" | Wm -> "W^-"
- | Xp -> "X^+" | Xm -> "X^-" | X0 -> "X^0" | Y0 -> "Y^0" | ZH -> "Z_H"
- | Phip -> "\\phi^+" | Phim -> "\\phi^-" | Phi0 -> "\\phi^0"
- | 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_to_TeX = flavor_to_TeX
- 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 "Modellib_BSM.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 "Modellib_BSM.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 = Modeltools.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 "Modellib_BSM.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
- "Modellib_BSM.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
- "Modellib_BSM.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
- "Modellib_BSM.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
- "Modellib_BSM.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_to_TeX = 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
- "Modellib_BSM.Xdim.flavor_to_TeX: invalid lepton"
- | N 1 -> "\\nu_e" | N (-1) -> "\\bar{\\nu}_e"
- | N 2 -> "\\nu_\\mu" | N (-2) -> "\\bar{\\nu}_\\mu"
- | N 3 -> "\\nu_\\tau" | N (-3) -> "\\bar{\\nu}_\\tau"
- | N _ -> invalid_arg
- "Modellib_BSM.Xdim.flavor_to_TeX: invalid neutrino"
- | U 1 -> "u" | U (-1) -> "\\bar{u}"
- | U 2 -> "c" | U (-2) -> "\\bar{c}"
- | U 3 -> "t" | U (-3) -> "\\bar{t}"
- | U _ -> invalid_arg
- "Modellib_BSM.Xdim.flavor_to_TeX: invalid up type quark"
- | D 1 -> "d" | D (-1) -> "\\bar{d}"
- | D 2 -> "s" | D (-2) -> "\\bar{s}"
- | D 3 -> "b" | D (-3) -> "\\bar{b}"
- | D _ -> invalid_arg
- "Modellib_BSM.Xdim.flavor_to_TeX: invalid down type quark"
- end
- | G f ->
- begin match f with
- | Gl -> "g"
- | Ga -> "\\gamma" | Z -> "Z"
- | Wp -> "W^+" | Wm -> "W^-"
- end
- | O f ->
- begin match f with
- | Phip -> "\\phi^+" | Phim -> "\\phi^-" | Phi0 -> "\\phi^0"
- | H -> "H" | Grav -> "G"
- 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_to_TeX = flavor_to_TeX
- 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 "Modellib_BSM.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 "Modellib_BSM.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 = Modeltools.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 "Modellib_BSM.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
- "Modellib_BSM.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
- "Modellib_BSM.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
- "Modellib_BSM.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
- "Modellib_BSM.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
- "Modellib_BSM.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
- "Modellib_BSM.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
- "Modellib_BSM.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
- "Modellib_BSM.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
- "Modellib_BSM.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
- "Modellib_BSM.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
- "Modellib_BSM.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
- "Modellib_BSM.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
- "Modellib_BSM.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
- "Modellib_BSM.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
- "Modellib_BSM.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
- "Modellib_BSM.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
- "Modellib_BSM.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
- "Modellib_BSM.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_to_TeX = 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
- "Modellib_BSM.UED.flavor_to_TeX: invalid lepton"
- | N 1 -> "\\nu_e" | N (-1) -> "\\bar{\\nu}_e"
- | N 2 -> "\\nu_\\mu" | N (-2) -> "\\bar{\\nu}_\\mu"
- | N 3 -> "\\nu_\\tau" | N (-3) -> "\\bar{\\nu}_\\tau"
- | N _ -> invalid_arg
- "Modellib_BSM.UED.flavor_to_TeX: invalid neutrino"
- | U 1 -> "u" | U (-1) -> "\\bar{u}"
- | U 2 -> "c" | U (-2) -> "\\bar{c}"
- | U 3 -> "t" | U (-3) -> "\\bar{t}"
- | U _ -> invalid_arg
- "Modellib_BSM.UED.flavor_to_TeX: 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
- "Modellib_BSM.UED.flavor_to_TeX: invalid down type quark"
- | U_K1_L 1 -> "u^\\prime_L" | U_K1_L (-1) -> "\\bar{u}^\\prime_L"
- | U_K1_L 2 -> "c^\\prime_L" | U_K1_L (-2) -> "\\bar{c}^\\prime_L"
- | U_K1_L 3 -> "t^\\prime_L" | U_K1_L (-3) -> "\\bar{t}^\\prime_L"
- | U_K1_L _ -> invalid_arg
- "Modellib_BSM.UED.flavor_to_TeX: invalid up type quark"
- | D_K1_L 1 -> "d^\\prime_L" | D_K1_L (-1) -> "\\bar{d}^\\prime_L"
- | D_K1_L 2 -> "s^\\prime_L" | D_K1_L (-2) -> "\\bar{s}^\\prime_L"
- | D_K1_L 3 -> "b^\\prime_L" | D_K1_L (-3) -> "\\bar{b}^\\prime_L"
- | D_K1_L _ -> invalid_arg
- "Modellib_BSM.UED.flavor_to_TeX: invalid down type quark"
- | U_K1_R 1 -> "u^\\prime_R" | U_K1_R (-1) -> "\\bar{u}^\\prime_R"
- | U_K1_R 2 -> "c^\\prime_R" | U_K1_R (-2) -> "\\bar{c}^\\prime_R"
- | U_K1_R 3 -> "t^\\prime_R" | U_K1_R (-3) -> "\\bar{t}^\\prime_R"
- | U_K1_R _ -> invalid_arg
- "Modellib_BSM.UED.flavor_to_TeX: invalid up type quark"
- | D_K1_R 1 -> "d^\\prime_R" | D_K1_R (-1) -> "\\bar{d}^\\prime_R"
- | D_K1_R 2 -> "s^\\prime_R" | D_K1_R (-2) -> "\\bar{s}^\\prime_R"
- | D_K1_R 3 -> "b^\\prime_R" | D_K1_R (-3) -> "\\bar{b}^\\prime_R"
- | D_K1_R _ -> invalid_arg
- "Modellib_BSM.UED.flavor_to_TeX: invalid down type quark"
- | U_K2_L 1 -> "u^{\\prime\\prime}_L" | U_K2_L (-1) -> "\\bar{u}^{\\prime\\prime}_L"
- | U_K2_L 2 -> "c^{\\prime\\prime}_L" | U_K2_L (-2) -> "\\bar{c}^{\\prime\\prime}_L"
- | U_K2_L 3 -> "t^{\\prime\\prime}_L" | U_K2_L (-3) -> "\\bar{t}^{\\prime\\prime}_L"
- | U_K2_L _ -> invalid_arg
- "Modellib_BSM.UED.flavor_to_TeX: invalid up type quark"
- | D_K2_L 1 -> "d^{\\prime\\prime}_L" | D_K2_L (-1) -> "\\bar{d}^{\\prime\\prime}_L"
- | D_K2_L 2 -> "s^{\\prime\\prime}_L" | D_K2_L (-2) -> "\\bar{s}^{\\prime\\prime}_L"
- | D_K2_L 3 -> "b^{\\prime\\prime}_L" | D_K2_L (-3) -> "\\bar{b}^{\\prime\\prime}_L"
- | D_K2_L _ -> invalid_arg
- "Modellib_BSM.UED.flavor_to_TeX: invalid down type quark"
- | U_K2_R 1 -> "u^{\\prime\\prime}_R" | U_K2_R (-1) -> "\\bar{u}^{\\prime\\prime}_R"
- | U_K2_R 2 -> "c^{\\prime\\prime}_R" | U_K2_R (-2) -> "\\bar{c}^{\\prime\\prime}_R"
- | U_K2_R 3 -> "t^{\\prime\\prime}_R" | U_K2_R (-3) -> "\\bar{t}^{\\prime\\prime}_R"
- | U_K2_R _ -> invalid_arg
- "Modellib_BSM.UED.flavor_to_TeX: invalid up type quark"
- | D_K2_R 1 -> "d^\\prime_R" | D_K2_R (-1) -> "\\bar{d}^{\\prime\\prime}_R"
- | D_K2_R 2 -> "s^\\prime_R" | D_K2_R (-2) -> "\\bar{s}^{\\prime\\prime}_R"
- | D_K2_R 3 -> "b^\\prime_R" | D_K2_R (-3) -> "\\bar{b}^{\\prime\\prime}_R"
- | D_K2_R _ -> invalid_arg
- "Modellib_BSM.UED.flavor_to_TeX: invalid down type quark"
- | L_K1_L 1 -> "e_L^{\\prime,,-}" | L_K1_L (-1) -> "\\bar{e}_L^{\\prime,,+}"
- | L_K1_L 2 -> "\\mu_L^{\\prime,,-}" | L_K1_L (-2) -> "\\bar{\\mu}_L^{{\\prime,,+}"
- | L_K1_L 3 -> "\\tau_L^{\\prime,,-}" | L_K1_L (-3) -> "\\bar{\\tau}_L^{\\prime,,+}"
- | L_K1_L _ -> invalid_arg
- "Modellib_BSM.UED.flavor_to_TeX: invalid lepton"
- | L_K1_R 1 -> "e_R^{\\prime,,-}" | L_K1_R (-1) -> "\\bar{e}_R^{\\prime,,+}"
- | L_K1_R 2 -> "\\mu_R{\\prime,,-}" | L_K1_R (-2) -> "\\bar{\\mu}_R^{\\prime,,+}"
- | L_K1_R 3 -> "\\tau_R¬{\\prime,,-}" | L_K1_R (-3) -> "\\bar{\\tau}_R¬{\\prime,,+}"
- | L_K1_R _ -> invalid_arg
- "Modellib_BSM.UED.flavor_to_TeX: invalid lepton"
- | L_K2_L 1 -> "e^{\\prime\\prime,,-}_L" | L_K2_L (-1) -> "\\bar{e}_L^{\\prime\\prime,,+}"
- | L_K2_L 2 -> "\\mu_L^{\\prime\\prime,,-}" | L_K2_L (-2) -> "\\bar{\\mu}_L^{\\prime\\prime,,+}"
- | L_K2_L 3 -> "\\tau_L^{\\prime\\prime,,-}" | L_K2_L (-3) -> "\\bar{\\tau}_L^{\\prime\\prime,,+}"
- | L_K2_L _ -> invalid_arg
- "Modellib_BSM.UED.flavor_to_TeX: invalid lepton"
- | L_K2_R 1 -> "e_R^{\\prime\\prime,,-}" | L_K2_R (-1) -> "\\bar{e}_R^{\\prime\\prime,,+}"
- | L_K2_R 2 -> "\\mu_R^{\\prime\\prime,,-}" | L_K2_R (-2) -> "\\bar{\\mu}_R^{\\prime\\prime,,+}"
- | L_K2_R 3 -> "\\tau_R{\\prime\\prime,,-}" | L_K2_R (-3) -> "\\bar{\\tau}_R^{\\prime\\prime,,+}"
- | L_K2_R _ -> invalid_arg
- "Modellib_BSM.UED.flavor_to_TeX: invalid lepton"
- | N_K1 1 -> "\\nu_e^\\prime" | N_K1 (-1) -> "\\bar{\\nu}_e^\\prime"
- | N_K1 2 -> "\\nu_\\mu^\\prime" | N_K1 (-2) -> "\\bar{\\nu}_\\mu^\\prime"
- | N_K1 3 -> "\\nu_\\tau^\\prime" | N_K1 (-3) -> "\\bar{\\nu}_\\tau^\\prime"
- | N_K1 _ -> invalid_arg
- "Modellib_BSM.UED.flavor_to_TeX: invalid neutrino"
- | N_K2 1 -> "\\nu_e^{\\prime\\prime}" | N_K2 (-1) -> "\\bar{\\nu}_e^{\\prime\\prime}"
- | N_K2 2 -> "\\nu_\\mu^{\\prime\\prime}" | N_K2 (-2) -> "\\bar{\\nu}_\\mu^{\\prime\\prime}"
- | N_K2 3 -> "\\nu_\\tau^{\\prime\\prime}" | N_K2 (-3) -> "\\bar{\\nu}_\\tau^{\\prime\\prime}"
- | N_K2 _ -> invalid_arg
- "Modellib_BSM.UED.flavor_to_TeX: invalid neutrino"
- end
- | G f ->
- begin match f with
- | Gl -> "g"
- | Ga -> "\\gamma" | Z -> "Z"
- | Wp -> "W^+" | Wm -> "W^-"
- | Gl_K1 -> "g^\\prime" | Gl_K2 -> "g^{\\prime\\prime}"
- | B1 -> "B^\\prime" | B2 -> "B^{\\prime\\prime}"
- | Z1 -> "Z^\\prime" | Z2 -> "Z^{\\prime\\prime}"
- | Wp1 -> "W^{\\prime,,+}" | Wm1 -> "W^{\\prime,,-}"
- | Wp2 -> "W^{\\prime\\prime,,+}" | Wm2 -> "W^{\\prime\\prime,,-}"
- end
- | O f ->
- begin match f with
- | Phip -> "\\phi^+" | Phim -> "\\phi^-" | Phi0 -> "\\phi^0"
- | H -> "H" | H1up -> "H1u+" | H1um -> "H1u-"
- | H1dp -> "H1d+" | H1dm -> "H1d-"
- | H2up -> "H2u+" | H2um -> "H2u-"
- | H2dp -> "H2d+" | H2dm -> "H2d-"
- | Grav -> "G^\\prime"
- 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_to_TeX = flavor_to_TeX
- 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 "Modellib_BSM.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 "Modellib_BSM.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 = Modeltools.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 "Modellib_BSM.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
- "Modellib_BSM.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
- "Modellib_BSM.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
- "Modellib_BSM.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
- "Modellib_BSM.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
- "Modellib_BSM.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_to_TeX = 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
- "Modellib_BSM.GravTest.flavor_to_TeX: invalid lepton"
- | SL 1 -> "\\tilde{e}^-" | SL (-1) -> "\\tilde{e}^+"
- | SL 2 -> "\\tilde{\\mu}^-" | SL (-2) -> "\\tilde{\\mu}^+"
- | SL 3 -> "\\tilde{\\tau}^-" | SL (-3) -> "\\tilde{\\tau}^+"
- | SL _ -> invalid_arg
- "Modellib_BSM.GravTest.flavor_to_TeX: invalid slepton"
- | N 1 -> "\\nu_e" | N (-1) -> "\\bar{\\nu}_e"
- | N 2 -> "\\nu_\\mu" | N (-2) -> "\\bar{\\nu}_\\mu"
- | N 3 -> "\\nu_\\tau" | N (-3) -> "\\bar{\\nu}_\\tau"
- | N _ -> invalid_arg
- "Modellib_BSM.GravTest.flavor_to_TeX: invalid neutrino"
- | U 1 -> "u" | U (-1) -> "\\bar{u}"
- | U 2 -> "c" | U (-2) -> "\\bar{c}"
- | U 3 -> "t" | U (-3) -> "\\bar{t}"
- | U _ -> invalid_arg
- "Modellib_BSM.SM.flavor_to_TeX: invalid up type quark"
- | D 1 -> "d" | D (-1) -> "\\bar{d}"
- | D 2 -> "s" | D (-2) -> "\\bar{s}"
- | D 3 -> "b" | D (-3) -> "\\bar{b}"
- | D _ -> invalid_arg
- "Modellib_BSM.GravTest.flavor_to_TeX: invalid down type quark"
- end
- | G f ->
- begin match f with
- | Gl -> "g"
- | Ga -> "\\gamma" | Z -> "Z"
- | Wp -> "W^+" | Wm -> "W^-"
- | Phino -> "\\tilde{\\phi}"
- end
- | O f ->
- begin match f with
- | Phip -> "\\phi^+" | Phim -> "\\phi^-" | Phi0 -> "\\phi^0"
- | H -> "H" | Grino -> "\\tilde{G}"
- 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_to_TeX = flavor_to_TeX
- 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 "Modellib_BSM.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 "Modellib_BSM.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 = Modeltools.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 "Modellib_BSM.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
- "Modellib_BSM.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
- "Modellib_BSM.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
- "Modellib_BSM.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
- "Modellib_BSM.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_to_TeX = 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
- "Modellib_BSM.Template.flavor_to_TeX: invalid lepton"
- | N 1 -> "\\nu_e" | N (-1) -> "\\bar{\\nu}_e"
- | N 2 -> "\\nu_\\mu" | N (-2) -> "\\bar{\\nu}_\\mu"
- | N 3 -> "\\nu_\\tau" | N (-3) -> "\\bar{\\nu}_\\tau"
- | N _ -> invalid_arg
- "Modellib_BSM.Template.flavor_to_TeX: invalid neutrino"
- | U 1 -> "u" | U (-1) -> "\\bar{u}"
- | U 2 -> "c" | U (-2) -> "\\bar{c}"
- | U 3 -> "t" | U (-3) -> "\\bar{t}"
- | U _ -> invalid_arg
- "Modellib_BSM.Template.flavor_to_TeX: invalid up type quark"
- | D 1 -> "d" | D (-1) -> "\\bar{d}"
- | D 2 -> "s" | D (-2) -> "\\bar{s}"
- | D 3 -> "b" | D (-3) -> "\\bar{b}"
- | D _ -> invalid_arg
- "Modellib_BSM.Template.flavor_to_TeX: invalid down type quark"
- end
- | G f ->
- begin match f with
- | Gl -> "g"
- | Ga -> "\\gamma" | Z -> "Z"
- | Wp -> "W^+" | Wm -> "W^-"
- end
- | O f ->
- begin match f with
- | Phip -> "\\phi^+" | Phim -> "\\phi^-" | Phi0 -> "\\phi^0"
- | 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_to_TeX = flavor_to_TeX
- 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
-
-(* \thocwmodulesection{Three-Site Higgsless Model} *)
-
-module type Threeshl_options =
- sig
- val include_ckm: bool
- val include_hf: bool
- val diet: bool
- end
-
-module Threeshl_no_ckm: Threeshl_options =
- struct
- let include_ckm = false
- let include_hf = true
- let diet = false
- end
-
-module Threeshl_ckm: Threeshl_options =
- struct
- let include_ckm = true
- let include_hf = true
- let diet = false
- end
-
-module Threeshl_no_ckm_no_hf: Threeshl_options =
- struct
- let include_ckm = false
- let include_hf = false
- let diet = false
- end
-
-module Threeshl_ckm_no_hf: Threeshl_options =
- struct
- let include_ckm = true
- let include_hf = false
- let diet = false
- end
-
-module Threeshl_diet_no_hf: Threeshl_options =
- struct
- let include_ckm = false
- let include_hf = false
- let diet = true
- end
-
-module Threeshl_diet: Threeshl_options =
- struct
- let include_ckm = false
- let include_hf = true
- let diet = true
- end
-
-(* We use one generic implementation of the model and implement different features via option
-modules given to a functor *)
-module Threeshl (Module_options: Threeshl_options) =
- struct
-
- open Coupling
-
- let modname = "Modellib_BSM.Threeshl"
-
- let rcs =
- let renderbool = function true -> "true" | false -> "false"
- in RCS.rename rcs_file "Modellib_BSM.Threeshl"
- ["Three-Site Higgsless Model, " ^
- "flavor mixing: " ^ (renderbool Module_options.include_ckm) ^
- ", heavy fermions: " ^ (renderbool Module_options.include_hf) ^
- ", reduced set of couplings: " ^ (renderbool Module_options.diet)
- ]
-
-
- (* Shamelessly stolen from Models.SM3, but with no support for fudged width yet *)
- let default_width = ref Timelike
-
- (* If this flag is set true, all gauge bosons are assumed to be massless and are assigned
- feynman gauge propagators. This in conjunction with the unbroken three site model is intended for
- checking gauge invariance via the ward identites. *)
- let all_feynman = ref false
-
- let options = Options.create [
- "constant_width", Arg.Unit (fun _ -> default_width := Constant),
- "use constant width (also in t-channel)";
- "custom_width", Arg.String (fun x -> default_width := Custom x),
- "use custom width";
- "cancel_widths", Arg.Unit (fun _ -> default_width := Vanishing),
- "use vanishing width";
- "all_feynman", Arg.Unit (fun _ -> all_feynman := true),
- "assign feynman gauge propagators to all gauge bosons\n"
- ^ "\t(for checking the ward identities); use only if you *really* know\n"
- ^ "\twhat you are doing"]
-
- (* The quantum numbers that are carried by the particles. \verb$csign$ is \emph{not} the charge
- carried by the particle, but differentiates between particles (\verb$Pos$) and antiparticles
- (\verb$Neg$) *)
- type kkmode = Light | Heavy
- type generation = Gen0 | Gen1 | Gen2
- type csign = Pos | Neg
- type isospin = Iso_up | Iso_down
-
- (* Necessary to represent the indices of the couplings defined in FORTRAN *)
- type kk2 = Light2 | Heavy2 | Light_Heavy
-
- (* Map the different types to the constants used in the FORTRAN module *)
- let fspec_of_kkmode = function Light -> "l_mode" | Heavy -> "h_mode"
- let fspec_of_kk2 = function
- Light2 -> "l_mode" | Heavy2 -> "h_mode" | Light_Heavy -> "lh_mode"
- let fspec_of_gen = function Gen0 -> "gen_0" | Gen1 -> "gen_1" | Gen2 -> "gen_2"
- let fspec_of_iso = function Iso_up -> "iso_up" | Iso_down -> "iso_down"
-
- (* Covert the ``charge sign'' into a numeric sign (used e.g. in the determination of the MCID
- codes) *)
- let int_of_csign = function Pos -> 1 | Neg -> -1
-
- (* Convert the generation into an integer (dito) *)
- let int_of_gen = function Gen0 -> 1 | Gen1 -> 2 | Gen2 -> 3
-
- (* The type \verb$flavor$ is implemented as a variant. Fermions are implemented as a variant
- differentating between leptons and quarks (seemed the most natural way as this is also the way
- in which the FORTRAN code is structured). Bosons are implemented as a variant the
- differentiates between $W$, $Z$ and $A$. All other quantum numbers that are required for
- identifying the particles are carried by the variant constructors. *)
- type fermion =
- | Lepton of (kkmode * csign * generation * isospin)
- | Quark of (kkmode * csign * generation * isospin)
-
- type boson =
- | W of (kkmode * csign)
- | Z of kkmode
- | A
- | G
-
- type flavor = Fermion of fermion | Boson of boson
-
- (* Helpers to construct particles from quantum numbers *)
- let lepton kk cs gen iso = Lepton (kk, cs, gen, iso)
- let quark kk cs gen iso = Quark (kk, cs, gen, iso)
- let w kk cs = W (kk, cs)
- let z kk = Z kk
- let flavor_of_f x = Fermion x
- let flavor_of_b x = Boson x
-
- (* Map a list of functions to the list (partially) applied to a value *)
- let revmap funs v = List.map (fun x -> x v) funs
-
- (* The same for a list of values; the result is flattened *)
- let revmap2 funs vals = ThoList.flatmap (revmap funs) vals
-
- (* Functions to loop the constructors over quantum numbers for list creation purposes *)
- let loop_kk flist = revmap2 flist [Light; Heavy]
- let loop_cs flist = revmap2 flist [Pos; Neg]
- let loop_gen flist = revmap2 flist [Gen0; Gen1; Gen2]
- let loop_iso flist = revmap2 flist [Iso_up; Iso_down]
- let loop_kk2 flist = revmap2 flist [Light2; Heavy2; Light_Heavy]
-
- (* Conditional looping over kk modes depending on whether to include heavy fermions *)
- let cloop_kk flist = match Module_options.include_hf with
- | true -> loop_kk flist
- | false -> revmap flist Light
- let cloop_kk2 flist = match Module_options.include_hf with
- | true -> loop_kk2 flist
- | false -> revmap flist Light2
-
- (* Having defined the necessary helpers, the magic of currying makes building lists of
- particles as easy as nesting the loop functions in the correct order... *)
- let all_leptons = loop_iso (loop_gen (loop_cs (cloop_kk [lepton] )))
- let all_quarks = loop_iso( loop_gen (loop_cs (cloop_kk [quark] )))
- let all_bosons = (loop_cs (loop_kk [w] )) @ [Z Light; Z Heavy; A; G]
-
- (* Converts a flavor spec to the BCD identifier defined in the FORTRAN module. Splitting the
- function into two parts \verb$prefix$ and \verb$rump$ removes a lot of redundancy. *)
- let bcdi_of_flavor =
- let prefix = function
- | Fermion (Lepton (Heavy, _, _, _)) | Fermion (Quark (Heavy, _, _, _))
- | Boson (W (Heavy, _)) | Boson (Z Heavy) -> "h"
- | _ -> ""
- in let rump = function
- | Fermion (Lepton spec) -> (match spec with
- | (_, _, Gen0, Iso_up) -> "nue"
- | (_, _, Gen0, Iso_down) -> "e"
- | (_, _, Gen1, Iso_up) -> "numu"
- | (_, _, Gen1, Iso_down) -> "mu"
- | (_, _, Gen2, Iso_up) -> "nutau"
- | (_, _, Gen2, Iso_down) -> "tau")
- | Fermion (Quark spec) -> (match spec with
- | (_, _, Gen0, Iso_up) -> "u"
- | (_, _, Gen0, Iso_down) -> "d"
- | (_, _, Gen1, Iso_up) -> "c"
- | (_, _, Gen1, Iso_down) -> "s"
- | (_, _, Gen2, Iso_up) -> "t"
- | (_, _, Gen2, Iso_down) -> "b")
- | Boson (W _) -> "w" | Boson (Z _) -> "z"
- | Boson A -> invalid_arg (modname ^ ".bcd_of_flavor: no bcd for photon!")
- | Boson G -> invalid_arg (modname ^ ".bcd_of_flavor: no bcd for gluon!")
- in function x -> (prefix x) ^ (rump x) ^ "_bcd"
-
- (* The function defined in the model signature which returns the colour representation of a
- particle *)
- let color =
- let quarkrep = function
- | (_, Pos, _, _) -> Color.SUN 3
- | (_, Neg, _, _) -> Color.SUN (-3)
- in function
- | Fermion (Quark x) -> quarkrep x
- | Boson G -> Color.AdjSUN 3
- | _ -> Color.Singlet
-
- (* Function for calculating the MCID code of a particle. Convenctions have been choosen such
- that the heavy modes are identified by the same numbers as the light ones, prefixed with
- \verb$99$. This is supposedly in accord with the conventions for adding new particles to the list
- of MCID codes. This function is required by the signature. *)
- let pdg =
- let iso_delta = function Iso_down -> 0 | Iso_up -> 1
- in let gen_delta = function Gen0 -> 0 | Gen1 -> 2 | Gen2 -> 4
- in let kk_delta = function Light -> 0 | Heavy -> 9900
- in function
- | Fermion ( Lepton (kk, cs, gen, iso)) ->
- (int_of_csign cs) * (11 + (gen_delta gen) + (iso_delta iso) + (kk_delta kk))
- | Fermion ( Quark (kk, cs, gen, iso)) ->
- (int_of_csign cs) * (1 + (gen_delta gen) + (iso_delta iso)+ (kk_delta kk))
- | Boson (W (kk, cs)) -> (int_of_csign cs) * (24 + (kk_delta kk))
- | Boson (Z kk) -> 23 + (kk_delta kk)
- | Boson A -> 22
- | Boson G -> 21
-
- (* Returns the lorentz representation of a particle; required by the signature. *)
- let lorentz =
- let spinor = function
- | (_, Pos, _, _) -> Spinor
- | (_, Neg, _, _) -> ConjSpinor
- in function
- | Fermion (Lepton x) | Fermion (Quark x) -> spinor x
- | Boson (W _) | Boson (Z _) -> Massive_Vector
- | Boson A -> Vector
- | Boson G -> Vector
-
- (* O'Mega supports models that allow different gauges; however, we only implement unitary
- gauge and therefore stub this (SM3 does the same thing). The \verb$gauge$ type as well as
- \verb$gauge_symbol$ are required by the signature. *)
- type gauge = unit
-
- let gauge_symbol () =
- failwith (modname ^ ".gauge_symbol: internal error")
-
- (* Returns the propagator for a given particle type. Required by signature. *)
- let propagator =
- let spinorprop = function
- | (_, Pos, _, _) -> Prop_Spinor
- | (_, Neg, _, _) -> Prop_ConjSpinor
- in function
- | Fermion (Lepton x) | Fermion (Quark x) -> spinorprop x
- | Boson (W _) | Boson (Z _) ->
- (match !all_feynman with false -> Prop_Unitarity | true -> Prop_Feynman)
- | Boson A -> Prop_Feynman
- | Boson G -> Prop_Feynman
-
- (* Return the width of a particle, required by signature. \\
- \emph{TODO:} Refine such that stable particles always are treade via vanishing width, as this
- might speed up the generated code a bit. *)
- let width _ = !default_width
-
- (* Returns the conjugate particle; required by signature. *)
- let conjugate =
- let conj_csign = function
- | Pos -> Neg
- | Neg -> Pos
- in function
- | Fermion (Lepton (kk, cs, gen, iso)) -> Fermion (Lepton (kk, conj_csign cs, gen, iso))
- | Fermion (Quark (kk, cs, gen, iso)) -> Fermion (Quark (kk, conj_csign cs, gen, iso))
- | Boson (W (kk, cs)) -> Boson (W (kk, conj_csign cs))
- | x -> x
-
- (* Tells the diagram generator whether a particle is a fermion, a conjugate fermion or a
- boson. Required by signature *)
- let fermion = function
- | Fermion (Lepton (_, cs, _, _)) | Fermion (Quark (_, cs, _, _)) -> int_of_csign cs
- | Boson _ -> 0
-
- (* A variant to represent the different coupling constants, choosen to mimic the FORTRAN part.
- Required by signature. *)
- type constant =
- | G_a_lep | G_a_quark of isospin
- | G_aww | G_aaww
- | G_w_lep of (kkmode * kkmode * generation * kkmode * generation)
- | G_w_quark of (kkmode * kkmode * generation * kkmode * generation)
- | G_z_lep of (kkmode * kk2 * generation * isospin)
- | G_z_quark of (kkmode * kk2 * generation * isospin)
- | G_wwz of (kk2 * kkmode)
- | G_wwzz of (kk2 * kk2)
- | G_wwza of (kk2 * kkmode)
- | G_wwww of int
- | G_s
- | IG_s
- | G_s2
-
- (* Functions for the construction of constants from indices *)
- let g_a_quark x = G_a_quark x
- let g_w_lep kk1 kk2 gen1 kk3 gen2 = G_w_lep (kk1, kk2, gen1, kk3, gen2)
- let g_w_quark kk1 kk2 gen1 kk3 gen2 = G_w_quark (kk1, kk2, gen1, kk3, gen2)
- let g_z_lep kk1 kk2 gen iso = G_z_lep (kk1, kk2, gen, iso)
- let g_z_quark kk1 kk2 gen iso = G_z_quark (kk1, kk2, gen, iso)
- let g_wwz kk1 kk2 = G_wwz (kk1, kk2)
- let g_wwzz kk1 kk2 = G_wwzz (kk1, kk2)
- let g_wwza kk1 kk2 = G_wwza (kk1, kk2)
- let g_wwww nhw = if (nhw >= 0) & (nhw <= 4) then G_wwww nhw
- else failwith (modname ^ ".g_wwww: invalid integer, very bad")
-
- (* Build a list of the different constants *)
- let clist = [G_a_lep; G_aww; G_aaww] @ (loop_iso [g_a_quark]) @
- (loop_gen (cloop_kk (loop_gen (cloop_kk (loop_kk [g_w_lep] ))))) @
- (loop_gen (cloop_kk (loop_gen (cloop_kk (loop_kk [g_w_quark] ))))) @
- (loop_iso (loop_gen (cloop_kk2 (loop_kk [g_z_lep] )))) @
- (loop_iso (loop_gen (cloop_kk2 (loop_kk [g_z_quark] )))) @
- (loop_kk (loop_kk2 [g_wwz] )) @ (loop_kk2 (loop_kk2 [g_wwzz] )) @
- (loop_kk (loop_kk2 [g_wwza] )) @ (List.map g_wwww [0; 1; 2; 3; 4])
-
- (* Maximum number of lines meeting at a vertex, required by signature. *)
- let max_degree () = 4
-
- (* Transform a pair of kk identifiers into a kk2 identifier *)
- let get_kk2 = function (Light, Light) -> Light2 | (Heavy, Heavy) -> Heavy2
- | (Light, Heavy) | (Heavy, Light) -> Light_Heavy
-
- (* Flip isospin *)
- let conj_iso = function Iso_up -> Iso_down | Iso_down -> Iso_up
-
- (* Below, lists of couplings are generated which ultimately are joined into a list of all
- couplings in the model. The generated lists can be viewed using the \verb$dump.ml$ script in the
- O'Mega toplevel directory. \\
- The individual couplings are defined as 5-tupels resp. 6-tupels consisting in this
- order of the particles meeting at the vertex, the coupling type (see \verb$couplings.ml$) and the
- coupling constant. *)
-
- (* List of $llA$ type vertices *)
- let vertices_all =
- let vgen kk gen =
- ((Fermion (Lepton (kk, Neg, gen, Iso_down)), Boson A, Fermion (Lepton (kk, Pos, gen,
- Iso_down))), FBF(1, Psibar, V, Psi), G_a_lep)
- in loop_gen (cloop_kk [vgen])
-
- (* List of $qqA$ type vertices *)
- let vertices_aqq =
- let vgen kk gen iso =
- ((Fermion (Quark (kk, Neg, gen, iso)), Boson A, Fermion (Quark (kk, Pos, gen,
- iso))), FBF(1, Psibar, V, Psi), G_a_quark iso)
- in loop_iso (loop_gen (cloop_kk [vgen]))
-
-
- (* List of $\nu lW$ type vertices *)
- let vertices_wll =
- let vgen kkw kk_f kk_fbar iso_f gen =
- ((Fermion (Lepton (kk_fbar, Neg, gen, conj_iso iso_f)),
- Boson (W (kkw, (match iso_f with Iso_up -> Neg | _ -> Pos))),
- Fermion (Lepton (kk_f, Pos, gen, iso_f))),
- FBF (1, Psibar, VA2, Psi),
- G_w_lep (kkw, (match iso_f with Iso_up -> kk_f | _ -> kk_fbar), gen,
- (match iso_f with Iso_up -> kk_fbar | _ -> kk_f), gen) )
- in loop_gen (loop_iso (cloop_kk (cloop_kk (loop_kk [vgen] ))))
-
- (* The same list, but without couplings between the $W^\prime$ and light fermions *)
- let vertices_wll_diet =
- let filter = function
- | ((Fermion (Lepton (Light, _, _, _)), Boson (W (Heavy, _)),
- Fermion (Lepton (Light, _, _, _))), _, _) -> false
- | _ -> true
- in List.filter filter vertices_wll
-
- (* List of $udW$ type vertices, flavor-diagonal *)
- let vertices_wqq_no_ckm =
- let vgen kkw kk_f kk_fbar iso_f gen =
- ((Fermion (Quark (kk_fbar, Neg, gen, conj_iso iso_f)),
- Boson (W (kkw, (match iso_f with Iso_up -> Neg | _ -> Pos))),
- Fermion (Quark (kk_f, Pos, gen, iso_f))),
- FBF (1, Psibar, VA2, Psi),
- G_w_quark (kkw, (match iso_f with Iso_up -> kk_f | _ -> kk_fbar), gen,
- (match iso_f with Iso_up -> kk_fbar | _ -> kk_f), gen) )
- in loop_gen (loop_iso (cloop_kk (cloop_kk (loop_kk [vgen] ))))
-
- (* The same list, but without couplings between the $W^\prime$ and the first two generations
- of quarks *)
- let vertices_wqq_no_ckm_diet =
- let filter = function
- | ((Fermion (Quark (Light, _, gen, _)), Boson (W (Heavy, _)),
- Fermion (Quark (Light, _, _, _))), _, _) ->
- (match gen with Gen2 -> true | _ -> false)
- | _ -> true
- in List.filter filter vertices_wqq_no_ckm
-
- (* List of $udW$ type vertices, including non flavor-diagonal couplings *)
- let vertices_wqq =
- let vgen kkw kk_f gen_f kk_fbar gen_fbar iso_f =
- ((Fermion (Quark (kk_fbar, Neg, gen_fbar, conj_iso iso_f)),
- Boson (W (kkw, (match iso_f with Iso_up -> Neg | _ -> Pos))),
- Fermion (Quark (kk_f, Pos, gen_f, iso_f))),
- FBF (1, Psibar, VA2, Psi),
- G_w_quark (match iso_f with
- | Iso_up -> (kkw, kk_f, gen_f, kk_fbar, gen_fbar)
- | Iso_down -> (kkw, kk_fbar, gen_fbar, kk_f, gen_f)))
- in loop_iso (loop_gen (cloop_kk (loop_gen (cloop_kk (loop_kk [vgen] )))))
-
-
- (* List of $llZ$ / $\nu\nu Z$ type vertices *)
- let vertices_zll =
- let vgen kkz kk_f kk_fbar gen iso =
- ((Fermion (Lepton (kk_fbar, Neg, gen, iso)), Boson (Z kkz),
- Fermion (Lepton (kk_f, Pos, gen, iso))),
- FBF (1, Psibar, VA2, Psi),
- G_z_lep (kkz, get_kk2 (kk_f, kk_fbar), gen, iso))
- in loop_iso (loop_gen (cloop_kk (cloop_kk (loop_kk [vgen] ))))
-
- (* List of $qqZ$ type vertices *)
- let vertices_zqq =
- let vgen kkz kk_f kk_fbar gen iso =
- ((Fermion (Quark (kk_fbar, Neg, gen, iso)), Boson (Z kkz),
- Fermion (Quark (kk_f, Pos, gen, iso))),
- FBF (1, Psibar, VA2, Psi),
- G_z_quark (kkz, get_kk2 (kk_f, kk_fbar), gen, iso))
- in loop_iso (loop_gen (cloop_kk (cloop_kk (loop_kk [vgen] ))))
-
- (* $gq\bar{q}$ *)
- let vertices_gqq =
- let vgen kk gen iso =
- ((Fermion (Quark (kk, Neg, gen, iso)), Boson G, Fermion (Quark (kk, Pos, gen, iso))),
- FBF (1, Psibar, V, Psi), G_s)
- in loop_iso (loop_gen (cloop_kk [vgen]))
-
- (* AWW *)
- let vertices_aww =
- let vgen kk =
- ( (Boson A, Boson (W (kk, Pos)), Boson (W (kk, Neg))), Gauge_Gauge_Gauge 1, G_aww)
- in loop_kk [vgen]
-
- (* ZWW *)
- let vertices_zww =
- let vgen kkz kkwp kkwm =
- ((Boson (Z kkz), Boson (W (kkwp, Pos)), Boson (W (kkwm, Neg))), Gauge_Gauge_Gauge 1,
- G_wwz (get_kk2 (kkwp, kkwm), kkz))
- in loop_kk (loop_kk (loop_kk [vgen]))
-
- (* $ggg$ *)
- let vertices_ggg = [(Boson G, Boson G, Boson G), Gauge_Gauge_Gauge (-1), IG_s]
-
- (* Stolen from Models.SM; the signs seem to be OK. See \verb$couplings.ml$ for more docs. *)
- 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)]
-
- (* AAWW *)
- let vertices_aaww =
- let vgen kk =
- ((Boson A, Boson (W (kk, Pos)), Boson A, Boson (W (kk, Neg))), minus_gauge4, G_aaww)
- in loop_kk [vgen]
-
- (* WWZZ *)
- let vertices_wwzz =
- let vgen kkwp kkwm kk2z =
- ((Boson (Z (match kk2z with Heavy2 -> Heavy | Light2 | Light_Heavy -> Light)),
- Boson (W (kkwp, Pos)),
- Boson (Z (match kk2z with Heavy2 | Light_Heavy -> Heavy | Light2 -> Light)),
- Boson (W (kkwm, Neg))), minus_gauge4, G_wwzz (get_kk2 (kkwp, kkwm), kk2z))
- in loop_kk2 (loop_kk (loop_kk [vgen]))
-
- (* WWZA *)
- let vertices_wwza =
- let vgen kkwp kkwm kkz =
- ((Boson A, Boson (W (kkwp, Pos)), Boson (Z kkz), Boson (W (kkwm, Neg))),
- minus_gauge4, G_wwza (get_kk2 (kkwp, kkwm), kkz))
- in loop_kk (loop_kk (loop_kk [vgen]))
-
- (* WWWW *)
- let vertices_wwww =
- let count = function Light2 -> 0 | Light_Heavy -> 1 | Heavy2 -> 2
- in let vgen kk2wp kk2wm =
- ((Boson (W ((match kk2wp with Heavy2 -> Heavy | Light2 | Light_Heavy -> Light), Pos)),
- Boson (W ((match kk2wm with Heavy2 -> Heavy | Light2 | Light_Heavy -> Light), Neg)),
- Boson (W ((match kk2wp with Heavy2 | Light_Heavy -> Heavy | Light2 -> Light), Pos)),
- Boson (W ((match kk2wm with Heavy2 | Light_Heavy -> Heavy | Light2 -> Light), Neg))),
- gauge4, G_wwww ((count kk2wp) + (count kk2wm)))
- in loop_kk2 (loop_kk2 [vgen])
-
- (* gggg *)
- let vertices_gggg = [(Boson G, Boson G, Boson G, Boson G), gauge4, G_s2]
-
- (* The list of couplings is transformed into the fusion lists required by the generator by
- the Model.Fusions functor. *)
-
- (* This is copy\& paste from the other models; check again with Thorsten if it is correct *)
- module F = Modeltools.Fusions (struct
- type f = flavor
- type c = constant
- let compare = compare
- let conjugate = conjugate
- end )
-
- (* Not sure yet whether F.fusex also creates the conjugate vertices; by looking at the
- implementation of the other models, I assume it doesn't. Still, better ask Thorsten to be
- sure!!!\\
- \emph{Update:} Still didn't get to ask, but since the results are consistent, I suspect my assertion
- is correct. \\
- The stuff below is required by the signature. *)
-
- let vertices () = (vertices_all @ vertices_aqq @
- (match Module_options.diet with
- | false -> vertices_wll
- | true -> vertices_wll_diet) @
- (match (Module_options.include_ckm, Module_options.diet) with
- | (true, false) -> vertices_wqq
- | (false, false) -> vertices_wqq_no_ckm
- | (false, true) -> vertices_wqq_no_ckm_diet
- | (true, true) -> raise (Failure
- ("Modules4.Threeshl.vertices: CKM matrix together with option diet is not" ^
- " implemented yet!"))) @
- vertices_zll @ vertices_zqq @ vertices_aww @ vertices_zww @ vertices_gqq @ vertices_ggg,
- vertices_aaww @ vertices_wwzz @ vertices_wwza @ vertices_wwww @ vertices_gggg
- , [])
- let table = F.of_vertices (vertices ())
- let fuse2 = F.fuse2 table
- let fuse3 = F.fuse3 table
- let fuse = F.fuse table
-
- (* A function that returns a list of a flavours known to the model, required by the signature.
- *)
- let flavors () = (List.map flavor_of_f (all_leptons @ all_quarks)) @
- (List.map flavor_of_b all_bosons)
-
- (* dito, external flavours, also required. *)
- let external_flavors () = [
- "light leptons", List.map flavor_of_f (loop_iso (loop_gen( loop_cs [lepton Light])));
- "light quarks", List.map flavor_of_f (loop_iso (loop_gen( loop_cs [quark Light])));
- "light gauge bosons", List.map flavor_of_b [W (Light, Pos); W (Light, Neg); Z Light; A];
- "heavy gauge bosons", List.map flavor_of_b [W (Heavy, Pos); W (Heavy, Neg); Z Heavy]] @
- (match Module_options.include_hf with
- | true -> [
- "heavy leptons", List.map flavor_of_f (loop_iso (loop_gen( loop_cs [lepton Heavy])));
- "heavy quarks", List.map flavor_of_f (loop_iso (loop_gen( loop_cs [quark Heavy])))]
- | false -> [] ) @ ["gluons", [Boson G]]
-
- (* Which of the particles are goldstones? $\rightarrow$ none. Required by the signature. *)
- let goldstone x = None
-
- (* This is wrong but handy for debugging the constant identifier generation via -params.
- Usually, this function would return a record consisting of the parameters as well as
- expression for the dependent quantities that can be used to generate FORTRAN code for
- calculating them. However, we have a seperate module for the threeshl, so we can abuse this
- for debugging. Required by signature. *)
- let parameters () = {input = List.map (fun x -> (x, 0.)) clist;
- derived = []; derived_arrays = []}
-
- (* Convert a flavour into a ID string with which it will be referred by the user interface of
- the compiled generator. Required by signature *)
- let flavor_to_string =
- let prefix = function
- | Fermion (Lepton (Heavy, _, _, _)) | Fermion (Quark (Heavy, _, _, _))
- | Boson (W (Heavy, _)) | Boson (Z Heavy) -> "H"
- | _ -> ""
- in let postfix = function
- | Fermion (Lepton (_, cs, _, Iso_down)) -> (match cs with Pos -> "-" | Neg -> "+")
- | Fermion (Quark (_, Neg, _, _)) | Fermion (Lepton (_, Neg, _, Iso_up)) -> "bar"
- | Boson (W (_, cs)) -> (match cs with Pos -> "+" | Neg -> "-")
- | _ -> ""
- in let rump = function
- | Fermion (Lepton desc) -> (match desc with
- | (_, _, Gen0, Iso_up) -> "nue"
- | (_, _, Gen0, Iso_down) -> "e"
- | (_, _, Gen1, Iso_up) -> "numu"
- | (_, _, Gen1, Iso_down) -> "mu"
- | (_, _, Gen2, Iso_up) -> "nutau"
- | (_, _, Gen2, Iso_down) -> "tau")
- | Fermion (Quark desc) -> (match desc with
- | (_, _, Gen0, Iso_up) -> "u"
- | (_, _, Gen0, Iso_down) -> "d"
- | (_, _, Gen1, Iso_up) -> "c"
- | (_, _, Gen1, Iso_down) -> "s"
- | (_, _, Gen2, Iso_up) -> "t"
- | (_, _, Gen2, Iso_down) -> "b")
- | Boson (W _) -> "W" | Boson (Z _) -> "Z" | Boson A -> "A" | Boson G -> "gl"
- in function x -> (prefix x) ^ (rump x) ^ (postfix x)
-
- (* Conversion of the ID string into a particle flavor. Instead of going through all cases
- again, we generate a ``dictionary'' of flavor / ID pairs which we use to identify the correct
- flavor. Required by signature. *)
- let flavor_of_string x =
- let dict = List.map (fun x -> (x, flavor_to_string x)) (flavors ())
- in let get_ident = function (x, _) -> x
- in try
- get_ident (List.find (fun (_, y) -> (x = y)) dict)
- with
- Not_found -> (match x with
- | "g" -> Boson G
- | _ -> invalid_arg (modname ^ ".flavor_of_string")
- )
-
- (* Converts a flavor into a symbol used as identification in the generated FORTRAN code (has
- to comply to the conventions of valid FORTRAN identifiers therefore). We stick to the same
- convenctions as SM3, prefixing heavy modes with a \verb$H$. Required by signature. *)
- let flavor_symbol =
- let prefix = function
- | Fermion (Lepton (Heavy, _, _, _)) | Fermion (Quark (Heavy, _, _, _))
- | Boson (W (Heavy, _)) | Boson (Z Heavy) -> "H"
- | _ -> ""
- in let postfix = function
- | Fermion (Lepton (_, Neg, _, _)) | Fermion (Quark (_, Neg, _, _)) -> "b"
- | _ -> ""
- in let rump = function
- | Fermion spec -> (match spec with
- | Lepton (_, _, gen, Iso_up) -> "n" ^ (string_of_int (int_of_gen gen))
- | Lepton (_, _, gen, Iso_down) -> "l" ^ (string_of_int (int_of_gen gen))
- | Quark (_, _, gen, Iso_up) -> "u" ^ (string_of_int (int_of_gen gen))
- | Quark (_, _, gen, Iso_down) -> "d"^ (string_of_int (int_of_gen gen)))
- | Boson spec -> (match spec with
- | W (_, Pos) -> "wp" | W (_, Neg) -> "wm"
- | Z _ -> "z" | A -> "a" | G -> "gl" )
- in function
- x -> (prefix x) ^ (rump x) ^ (postfix x)
-
- (* Generate TeX for a flavor *)
- let flavor_to_TeX =
- let bar x y = match x with Neg -> "\\overline{" ^ y ^ "}" | Pos -> y
- in let pm x y = match x with Neg -> "{" ^ y ^ "}^+" | Pos -> "{" ^ y ^ "}^-"
- in let prime x y = match x with Light -> y | Heavy -> "{" ^ y ^ "}^\\prime"
- in function
- | Fermion (Lepton desc) -> (match desc with
- | (kk, cs, gen, Iso_up) -> prime kk (bar cs (match gen with
- | Gen0 -> "\\nu_e"
- | Gen1 -> "\\nu_\\mu"
- | Gen2 -> "\\nu_\\tau"))
- | (kk, cs, gen, Iso_down) -> prime kk (pm cs (match gen with
- | Gen0 -> "e" | Gen1 -> "\\mu" | Gen2 -> "\\tau")))
- | Fermion (Quark (kk, cs, gen, iso)) -> prime kk (bar cs (match (gen, iso) with
- | (Gen0, Iso_up) -> "u"
- | (Gen0, Iso_down) -> "d"
- | (Gen1, Iso_up) -> "c"
- | (Gen1, Iso_down) -> "s"
- | (Gen2, Iso_up) -> "t"
- | (Gen2, Iso_down) -> "b"))
- | Boson spec -> (match spec with
- | W (kk, cs) -> prime kk (pm (match cs with Pos -> Neg | Neg -> Pos) "W")
- | Z kk -> prime kk "Z"
- | A -> "A" | G -> "g")
-
- (* Returns the string referring to the particle mass in the generated FORTRAN code. Required
- by signature. *)
- let mass_symbol = function
- | Boson A | Boson G-> "0._default"
- | x -> "mass_array(" ^ (bcdi_of_flavor x) ^ ")"
-
- (* Dito, for width. Required by signature. *)
- let width_symbol = function
- | Boson A | Boson G -> "0._default"
- | x -> "width_array(" ^ (bcdi_of_flavor x) ^ ")"
-
- (* Determines the string referring to a coupling constant in the generated FORTRAN code.
- Required by signature. *)
- let constant_symbol =
- let c = ", "
- in let g_w_ferm = function
- (kk1, kk2, gen1, kk3, gen2) ->
- ":, " ^ (fspec_of_kkmode kk1) ^ c ^ (fspec_of_kkmode kk2) ^ c ^ (fspec_of_gen gen1) ^ c ^
- (fspec_of_kkmode kk3) ^ c ^ (fspec_of_gen gen2)
- in let g_z_ferm = function
- (kk1, kk2, gen, iso) ->
- ":, " ^ (fspec_of_kkmode kk1) ^ c ^ (fspec_of_kk2 kk2) ^ c ^ (fspec_of_gen gen) ^ c ^
- (fspec_of_iso iso)
- in function
- | G_a_lep -> "g_a_lep"
- | G_s -> "g_s_norm"
- | IG_s -> "ig_s_norm"
- | G_s2 -> "g_s_norm2"
- | G_a_quark iso -> "g_a_quark(" ^ (fspec_of_iso iso) ^ ")"
- | G_aww -> "ig_aww"
- | G_aaww -> "g_aaww"
- | G_w_lep spec -> "g_w_lep_va(" ^ (g_w_ferm spec) ^ ")"
- | G_w_quark spec -> "g_w_quark_va(" ^ (g_w_ferm spec) ^ ")"
- | G_z_lep spec -> "g_z_lep_va(" ^ (g_z_ferm spec) ^ ")"
- | G_z_quark spec -> "g_z_quark_va(" ^ (g_z_ferm spec) ^ ")"
- | G_wwz (kk1, kk2) -> "ig_wwz(" ^ (fspec_of_kk2 kk1) ^ c ^
- (fspec_of_kkmode kk2) ^ ")"
- | G_wwzz (kk1, kk2) -> "g_wwzz(" ^ (fspec_of_kk2 kk1) ^ c ^
- (fspec_of_kk2 kk2) ^ ")"
- | G_wwza (kk1, kk2) -> "g_wwza(" ^(fspec_of_kk2 kk1) ^ c ^
- (fspec_of_kkmode kk2) ^ ")"
- | G_wwww nhw -> if (0 <= nhw) & (nhw <= 4) then
- "g_wwww(" ^ (string_of_int nhw) ^ ")"
- else failwith "Modules4.Threeshl.constant_symbol: invalid int for G_wwww; very bad"
-
- (* Stubs for the colorizer. *)
- type flavor_sans_color = flavor
- let flavor_sans_color x = x
- let conjugate_sans_color = conjugate
- let flavor_sans_color_of_string = flavor_of_string
- let flavor_sans_color_to_string = flavor_to_string
- let flavor_sans_color_to_TeX = flavor_to_TeX
- let flavor_sans_color_symbol = flavor_symbol
-
- end
-
-
-(*i
- * Local Variables:
- * mode:caml
- * indent-tabs-mode:nil
- * page-delimiter:"^(\\* .*\n"
- * End:
-i*)
Index: branches/ohl/omega-development/hgg-vertex/src/cascade_parser.mly
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/cascade_parser.mly (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/cascade_parser.mly (revision 8717)
@@ -1,84 +0,0 @@
-/* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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/hgg-vertex/src/count.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/count.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/count.ml (revision 8717)
@@ -1,250 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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 ( > ) = ( >/ )
- 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/hgg-vertex/src/product.mli
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/product.mli (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/product.mli (revision 8717)
@@ -1,61 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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/hgg-vertex/src/thoGWindow.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/thoGWindow.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/thoGWindow.ml (revision 8717)
@@ -1,39 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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/hgg-vertex/src/coupling.mli
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/coupling.mli (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/coupling.mli (revision 8717)
@@ -1,2552 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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
-(*i | Ward_Vector i*)
- | 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.} Choosing VA2 over
- VA will cause the FORTRAN backend to pass the coupling as a whole array *)
-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 | VA2
-type boson2 = S2 | P2 | S2P | S2L | S2R | S2LR
- | SV | PV | SLV | SRV | SLRV | V2 | V2LR
-
-(* 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/hgg-vertex/src/options.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/options.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/options.ml (revision 8717)
@@ -1,66 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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 extend old options =
- { actions = List.fold_left
- (fun a (s, f, _) -> A.add s f a) old.actions options;
- raw = options @ old.raw }
-
-let create = extend empty
-
-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/hgg-vertex/src/omega_Littlest_Zprime.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/omega_Littlest_Zprime.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/omega_Littlest_Zprime.ml (revision 8717)
@@ -1,984 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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 = Modeltools.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/hgg-vertex/src/modellib_NMSSM.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/modellib_NMSSM.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/modellib_NMSSM.ml (revision 8717)
@@ -1,1518 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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" ["NMSSM and all that"]
- { RCS.revision = "$Revision$";
- RCS.date = "$Date$";
- RCS.author = "$Author$";
- RCS.source
- = "$URL$" }
-
-(* \thocwmodulesection{Next-to-Minimal Supersymmetric Standard Model} *)
-
-(* This is based on the NMSSM implementation by Felix Braam. Note that for the
- Higgs sector vertices the conventions of the Franke/Fraas paper have been
- used. *)
-
-module type NMSSM_flags =
- sig
- val ckm_present : bool
- end
-
-module NMSSM : NMSSM_flags =
- struct
- let ckm_present = false
- end
-
-module NMSSM_CKM : NMSSM_flags =
- struct
- let ckm_present = true
- end
-
-module NMSSM_func (Flags : NMSSM_flags) =
- struct
- let rcs = RCS.rename rcs_file "Models.NMSSM"
- [ "NMSSM and more" ]
-
- 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"]
-
-(* Yields a list of tuples consistig of the off-diag combinations of the elements in "set". *)
-
- let choose2 set =
- List.map (function [x;y] -> (x,y) | _ -> failwith "choose2")
- (Combinatorics.choose 2 set)
-
-(* [pairs] appends the diagonal combinations to [choose2]. *)
-
- let rec diag = function
- | [] -> []
- | x1 :: rest -> (x1, x1) :: diag rest
-
- let pairs l = choose2 l @ diag l
-
- let rec cloop set i j k =
- if i > ((List.length set)-1) then []
- else if j > i then cloop set (succ i) (j-i-1) (j-i-1)
- else if k > j then cloop set i (succ j) (k-j-1)
- else (List.nth set i, List.nth set j, List.nth set k) :: cloop set i j (succ k)
-
- let triples set = cloop set 0 0 0
-
- let rec two_and_one' l1 z n =
- if n < 0 then []
- else
- ((fst (List.nth (pairs l1) n)),(snd (List.nth (pairs l1) n)), z):: two_and_one' l1 z (pred n)
-
- let two_and_one l1 l2 =
- let f z = two_and_one' l1 z ((List.length (pairs l1))-1)
- in
- List.flatten ( List.map f l2 )
-
- 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 -> "5"
-
-(* For the Higgs bosons, we follow the conventions of Franke/Fraas. *)
-
- type shiggs =
- | S1 | S2 | S3
-
- type phiggs =
- | P1 | P2
-
- let string_of_shiggs = function
- | S1 -> "1" | S2 -> "2" | S3 -> "3"
-
- let string_of_phiggs = function
- | P1 -> "1" | P2 -> "2"
-
- 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
- | SHiggs of shiggs | Hp | Hm | PHiggs of phiggs
-
- type flavor_sans_color = flavor
- let flavor_sans_color f = f
-
- let string_of_fermion_type = function
- | L _ -> "l" | U _ -> "u" | D _ -> "d" | N _ -> "n"
- | _ -> failwith "Models.NMSSM.string_of_fermion_type: invalid fermion type"
-
- let string_of_fermion_gen = function
- | L g | U g | D g | N g -> string_of_int (abs (g))
- | _ -> failwith "Models.NMSSM.string_of_fermion_gen: invalid fermion type"
-
- type gauge = unit
-
- let gauge_symbol () =
- failwith "Models.NMSSM.gauge_symbol: internal error"
-
-(* At this point we will forget graviton and -ino. *)
-
- 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 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; Neutralino N5];
- "Higgs Bosons", [SHiggs S1; SHiggs S2; SHiggs S3; Hp; Hm; PHiggs P1; PHiggs P2];
- "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.NMSSM.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
- | SHiggs _ | PHiggs _ | Hp | Hm
- | Sup _ | Sdown _ | Slepton _ | Sneutrino _ -> Scalar
- | Neutralino _ | Gluino -> Majorana
-
- 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.NMSSM.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
- | SHiggs _ | PHiggs _ -> Prop_Scalar
- | Hp | Hm -> Prop_Scalar
- | Sup _ | Sdown _ | Slepton _ | Sneutrino _ -> Prop_Scalar
- | Gluino -> Prop_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
- | SHiggs s -> SHiggs s
- | PHiggs p -> PHiggs p
- | Hp -> Hm | Hm -> Hp
- | Gluino -> Gluino
- | Neutralino n -> Neutralino n | Chargino c -> Chargino (conj_char c)
-
- 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
- | SHiggs _ | Hp | Hm | PHiggs _ -> 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
-
-(* 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 =
- | E | G
- | Mu (*lambda*<s>*) | Lambda
- | 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_SS | I_G_S | Gs
- | G_NZN of neu*neu | G_CZC of char*char
- | G_YUK_FFS of flavor*flavor*shiggs
- | G_YUK_FFP of flavor*flavor*phiggs
- | G_YUK_LCN of int
- | G_YUK_UCD of int*int | G_YUK_DCU of int*int
- | G_NHC of vc*neu*char
- | G_YUK_C of vc*flavor*char*sff*sfm
- | G_YUK_Q of vc*int*flavor*char*sff*sfm
- | G_YUK_N of vc*flavor*neu*sff*sfm
- | G_YUK_G of vc*flavor*sff*sfm
- | G_NWC of neu*char | G_CWN of char*neu
- | G_CSC of char*char*shiggs
- | G_CPC of char*char*phiggs
- | G_WSQ of vc*int*int*sfm*sfm
- | G_SLSNW of vc*int*sfm
- | G_ZSF of sff*int*sfm*sfm
- | G_CICIS of neu*neu*shiggs
- | G_CICIP of neu*neu*phiggs
- | G_GH_WPC of phiggs | G_GH_WSC of shiggs
- | G_GH_ZSP of shiggs*phiggs | G_GH_WWS of shiggs
- | G_GH_ZZS of shiggs | G_GH_ZCC
- | G_GH_GaCC
- | G_GH4_ZZPP of phiggs*phiggs
- | G_GH4_ZZSS of shiggs*shiggs
- | G_GH4_ZZCC | G_GH4_GaGaCC
- | G_GH4_ZGaCC | G_GH4_WWCC
- | G_GH4_WWPP of phiggs*phiggs
- | G_GH4_WWSS of shiggs*shiggs
- | G_GH4_ZWSC of shiggs
- | G_GH4_GaWSC of shiggs
- | G_GH4_ZWPC of phiggs
- | G_GH4_GaWPC of phiggs
- | G_WWSFSF of sff*int*sfm*sfm
- | G_WPSLSN of vc*int*sfm
- | G_H3_SCC of shiggs
- | G_H3_SSS of shiggs*shiggs*shiggs
- | G_H3_SPP of shiggs*phiggs*phiggs
- | G_SFSFS of shiggs*sff*int*sfm*sfm
- | G_SFSFP of phiggs*sff*int*sfm*sfm
- | G_HSNSL of vc*int*sfm
- | G_HSUSD 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
-
-(* \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 = Modeltools.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+. FB ***)
- 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+. FB***)
- 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+. FB***)
- 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+. FB***)
- 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. *)
-(** FB **)
- 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+. FB ***)
- 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+.FB ***)
- 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+. FB***)
- 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+. FB***)
- let charged_squark_currents' g h m1 m2 =
- [ ((Wm, Sup (m1,g), Sdown (m2,-h)), Vector_Scalar_Scalar (-1), G_WSQ
- (true,g,h,m1,m2));
- ((Wp, Sup (m1,-g), Sdown (m2,h)), Vector_Scalar_Scalar 1, G_WSQ
- (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+. FB ***)
- 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)) ]
-
-(*** REVISED: Compatible with CD+. FB***)
- let neutral_Z (n,m) =
- [ ((Neutralino n, Z, Neutralino m), FBF (1, Chibar, VLR, Chi),
- (G_NZN (n,m))) ]
-
-(*** REVISED: Compatible with CD+. FB***)
- 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. FB***)
-
- let yukawa_v =
- [ (Gluino, Gl, Gluino), FBF (1, Chibar, V, Chi), Gs]
-
-(*** REVISED: Independent of the sign of CD. ***)
-(*** REVISED: Felix Braam: Compact version using new COMBOS + FF-Couplings *)
- let yukawa_higgs_FFS f s =
- [((conjugate f, SHiggs s, f ), FBF (1, Psibar, S, Psi),
- G_YUK_FFS (conjugate f, f, s))]
- let yukawa_higgs_FFP f p =
- [((conjugate f, PHiggs p, f), FBF (1, Psibar, P, Psi),
- G_YUK_FFP (conjugate f ,f , p))]
- let yukawa_higgs_NLC g =
- [ ((N (-g), Hp, L g), FBF (1, Psibar, Coupling.SR, Psi), G_YUK_LCN g);
- ((L (-g), Hm, N g), FBF (1, Psibar, Coupling.SL, Psi), G_YUK_LCN g)]
-
-
- let yukawa_higgs g =
- yukawa_higgs_NLC g @
- List.flatten ( Product.list2 yukawa_higgs_FFS [L g; U g; D g] [S1; S2; S3]) @
- List.flatten ( Product.list2 yukawa_higgs_FFP [L g; U g; D g] [P1; P2])
-
-
-(*** REVISED: Independent of the sign of CD. FB***)
- let yukawa_higgs_quark (g,h) =
- [ ((U (-g), Hp, D h), FBF (1, Psibar, SLR, Psi), G_YUK_UCD (g, h));
- ((D (-h), Hm, U g), FBF (1, Psibar, SLR, Psi), G_YUK_DCU (g, h)) ]
-
-(*** REVISED: Compatible with CD+. ***)
-(*** REVISED: Felix Braam: Compact version using new COMBOS*)
- let yukawa_shiggs_2 c1 c2 s =
- let cc1 = conj_char c1 in
- ((Chargino cc1, SHiggs s, Chargino c2), FBF (1, Psibar, SLR, Psi),
- G_CSC (c1,c2,s))
-
- let yukawa_phiggs_2 c1 c2 p =
- let cc1 = conj_char c1 in
- ((Chargino cc1, PHiggs p, Chargino c2), FBF (1, Psibar, SLR, Psi),
- G_CPC (c1,c2,p))
-
- let yukawa_higgs_2 =
- Product.list3 yukawa_shiggs_2 [C1;C2] [C1;C2] [S1;S2;S3] @
- Product.list3 yukawa_phiggs_2 [C1;C2] [C1;C2] [P1;P2]
-
-(*** REVISED: Compatible with CD+.FB ***)
- let higgs_charg_neutr n c =
- let cc = conj_char c in
- [ ((Neutralino n, Hm, Chargino c), FBF (-1, Chibar, SLR, Psi),
- G_NHC (false,n,c));
- ((Chargino cc, Hp, Neutralino n), FBF (-1, Psibar, SLR, Chi),
- G_NHC (true,n,c)) ]
-
-(*** REVISED: Compatible with CD+. ***)
-(*** REVISED: Felix Braam: Compact version using new COMBOS*)
- let shiggs_neutr (n,m,s) =
- ((Neutralino n, SHiggs s, Neutralino m), FBF (1, Chibar, SLR, Chi),
- G_CICIS (n,m,s))
- let phiggs_neutr (n,m,p) =
- ((Neutralino n, PHiggs p, Neutralino m), FBF (1, Chibar, SLR, Chi),
- G_CICIP (n,m,p))
-
- let higgs_neutr =
- List.map shiggs_neutr (two_and_one [N1;N2;N3;N4;N5] [S1;S2;S3]) @
- List.map phiggs_neutr (two_and_one [N1;N2;N3;N4;N5] [P1;P2])
-
-(*** REVISED: Compatible with CD+. FB***)
- let yukawa_n_2 n m g =
- [ ((Neutralino n, Slepton (m,-g), L g), FBF (1, Chibar, SLR, Psi),
- G_YUK_N (true,L g,n,SL,m));
- ((L (-g), Slepton (m,g), Neutralino n), FBF (1, Psibar, SLR, Chi),
- G_YUK_N (false,L g,n,SL,m));
- ((Neutralino n, Sup (m,-g), U g), FBF (1, Chibar, SLR, Psi),
- G_YUK_N (true,U g,n,SU,m));
- ((U (-g), Sup (m,g), Neutralino n), FBF (1, Psibar, SLR, Chi),
- G_YUK_N (false,U g,n,SU,m));
- ((Neutralino n, Sdown (m,-g), D g), FBF (1, Chibar, SLR, Psi),
- G_YUK_N (true,D g,n,SD,m));
- ((D (-g), Sdown (m,g), Neutralino n), FBF (1, Psibar, SLR, Chi),
- G_YUK_N (false,D g,n,SD,m)) ]
- let yukawa_n_3 n g =
- [ ((Neutralino n, Sneutrino (-g), N g), FBF (1, Chibar, SLR, Psi),
- G_YUK_N (true,N g,n,SN,M1));
- ((N (-g), Sneutrino g, Neutralino n), FBF (1, Psibar, SLR, Chi),
- G_YUK_N (false,N g, n,SN,M1)) ]
-
- let yukawa_n_5 g m =
- [ ((U (-g), Sup (m,g), Gluino), FBF (1, Psibar, SLR, Chi),
- G_YUK_G (false,U g,SU,m));
- ((D (-g), Sdown (m,g), Gluino), FBF (1, Psibar, SLR, Chi),
- G_YUK_G (false,D g,SD,m));
- ((Gluino, Sup (m,-g), U g), FBF (1, Chibar, SLR, Psi),
- G_YUK_G (true,U g,SU,m));
- ((Gluino, Sdown (m,-g), D g), FBF (1, Chibar, SLR, Psi),
- G_YUK_G (true,D g,SD,m))]
- let yukawa_n =
- List.flatten (Product.list3 yukawa_n_2 [N1;N2;N3;N4;N5] [M1;M2] [1;2;3]) @
- List.flatten (Product.list2 yukawa_n_3 [N1;N2;N3;N4;N5] [1;2;3]) @
- List.flatten (Product.list2 yukawa_n_5 [1;2;3] [M1;M2])
-
-
-(*** REVISED: Compatible with CD+.FB ***)
- let yukawa_c_2 c g =
- let cc = conj_char c in
- [ ((L (-g), Sneutrino g, Chargino cc), BBB (1, Psibar, SLR,
- Psibar), G_YUK_C (true,L g,c,SN,M1));
- ((Chargino c, Sneutrino (-g), L g), PBP (1, Psi, SLR, Psi),
- G_YUK_C (false,L g,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, SLR,
- Psi), G_YUK_C (true,N g,c,SL,m));
- ((Chargino cc, Slepton (m,-g), N g), FBF (1, Psibar, SLR,
- Psi), G_YUK_C (false,N g,c,SL,m)) ]
- let yukawa_c c =
- ThoList.flatmap (yukawa_c_2 c) [1;2;3] @
- List.flatten (Product.list2 (yukawa_c_3 c) [M1;M2] [1;2;3])
-
-
-(*** REVISED: Compatible with CD+. FB***)
- 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,D h,c,SU,m));
- ((D (-h), Sup (m,g), Chargino cc), BBB (1, Psibar, SLR, Psibar),
- G_YUK_Q (true,g,D h,c,SU,m));
- ((Chargino cc, Sdown (m,-g), U h), FBF (1, Psibar, SLR, Psi),
- G_YUK_Q (true,g,U h,c,SD,m));
- ((U (-h), Sdown (m,g), Chargino c), FBF (1, Psibar, SLR, Psi),
- G_YUK_Q (false,g,U h,c,SD,m)) ]
- let yukawa_cq c =
- if Flags.ckm_present then
- List.flatten (Product.list2 (yukawa_cq' c) [(1,1);(1,2);(2,1);(2,2);(1,3);(2,3);(3,3);(3,2);(3,1)] [M1;M2])
- else
- List.flatten (Product.list2 (yukawa_cq' c) [(1,1);(2,2);(3,3)] [M1;M2])
-
-
-(*** 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.
-**FB*)
- 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.
-**FB*)
-
- let chg = function
- | M1 -> M2 | M2 -> M1
-
- 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+. **FB*)
- 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. **FB*)
- 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+. FB***)
-(*** Revision: 2005-03-10: first two vertices corrected. ***)
-(*** REVISED: Compact version using new COMBOS*)
-(*** REVISED: Couplings adjusted to FF-convention*)
- let gauge_higgs_WPC p=
- [ ((Wm, Hp, PHiggs p), Vector_Scalar_Scalar 1, G_GH_WPC p);
- ((Wp, Hm, PHiggs p), Vector_Scalar_Scalar 1, G_GH_WPC p)]
- let gauge_higgs_WSC s=
- [((Wm, Hp, SHiggs s),Vector_Scalar_Scalar 1, G_GH_WSC s);
- ((Wp, Hm, SHiggs s),Vector_Scalar_Scalar (-1), G_GH_WSC s)]
- let gauge_higgs_ZSP s p =
- [((Z, SHiggs s, PHiggs p),Vector_Scalar_Scalar 1, G_GH_ZSP (s,p))]
- let gauge_higgs_WWS s=
- ((SHiggs s, Wp, Wm),Scalar_Vector_Vector 1, G_GH_WWS s)
- let gauge_higgs_ZZS s=
- ((SHiggs s, Z, Z), Scalar_Vector_Vector 1, G_GH_ZZS s)
- let gauge_higgs_ZCC =
- ((Z, Hp, Hm),Vector_Scalar_Scalar 1, G_GH_ZCC )
- let gauge_higgs_GaCC =
- ((Ga, Hp, Hm),Vector_Scalar_Scalar 1, G_GH_GaCC )
-
- let gauge_higgs =
- ThoList.flatmap gauge_higgs_WPC [P1;P2] @
- ThoList.flatmap gauge_higgs_WSC [S1;S2;S3] @
- List.flatten (Product.list2 gauge_higgs_ZSP [S1;S2;S3] [P1;P2]) @
- List.map gauge_higgs_WWS [S1;S2;S3] @
- List.map gauge_higgs_ZZS [S1;S2;S3] @
- [gauge_higgs_ZCC] @ [gauge_higgs_GaCC]
-(*** REVISED: Compact version using new COMBOS*)
-(*** REVISED: Couplings adjusted to FF-convention*)
- let gauge_higgs4_ZZPP (p1,p2) =
- ((PHiggs p1, PHiggs p2, Z, Z), Scalar2_Vector2 1, G_GH4_ZZPP (p1,p2))
-
- let gauge_higgs4_ZZSS (s1,s2) =
- ((SHiggs s1, SHiggs s2 , Z, Z), Scalar2_Vector2 1, G_GH4_ZZSS (s1,s2))
-
- let gauge_higgs4_ZZCC =
- ((Hp, Hm, Z, Z), Scalar2_Vector2 1, G_GH4_ZZCC)
-
- let gauge_higgs4_GaGaCC =
- ((Hp, Hm, Ga, Ga), Scalar2_Vector2 1, G_GH4_GaGaCC)
-
- let gauge_higgs4_ZGaCC =
- ((Hp, Hm, Ga, Z), Scalar2_Vector2 1, G_GH4_ZGaCC )
-
- let gauge_higgs4_WWCC =
- ((Hp, Hm, Wp, Wm), Scalar2_Vector2 1, G_GH4_WWCC )
-
- let gauge_higgs4_WWPP (p1,p2) =
- ((PHiggs p1, PHiggs p2, Wp, Wm), Scalar2_Vector2 1, G_GH4_WWPP (p1,p2))
-
- let gauge_higgs4_WWSS (s1,s2) =
- ((SHiggs s1, SHiggs s2, Wp, Wm), Scalar2_Vector2 1, G_GH4_WWSS (s1,s2))
-
- let gauge_higgs4_ZWSC s =
- [ ((Hp, SHiggs s, Wm, Z), Scalar2_Vector2 1, G_GH4_ZWSC s);
- ((Hm, SHiggs s, Wp, Z), Scalar2_Vector2 1, G_GH4_ZWSC s)]
-
- let gauge_higgs4_GaWSC s =
- [ ((Hp, SHiggs s, Wm, Ga), Scalar2_Vector2 1, G_GH4_GaWSC s);
- ((Hm, SHiggs s, Wp, Ga), Scalar2_Vector2 1, G_GH4_GaWSC s) ]
-
- let gauge_higgs4_ZWPC p =
- [ ((Hp, PHiggs p, Wm, Z), Scalar2_Vector2 1, G_GH4_ZWPC p);
- ((Hm, PHiggs p, Wp, Z), Scalar2_Vector2 (-1), G_GH4_ZWPC p)]
-
- let gauge_higgs4_GaWPC p =
- [ ((Hp, PHiggs p, Wm, Ga), Scalar2_Vector2 1, G_GH4_GaWPC p);
- ((Hm, PHiggs p, Wp, Ga), Scalar2_Vector2 (-1), G_GH4_GaWPC p) ]
-
- let gauge_higgs4 =
- List.map gauge_higgs4_ZZPP (pairs [P1;P2]) @
- List.map gauge_higgs4_ZZSS (pairs [S1;S2;S3]) @
- [gauge_higgs4_ZZCC] @ [gauge_higgs4_GaGaCC] @
- [gauge_higgs4_ZGaCC] @ [gauge_higgs4_WWCC] @
- List.map gauge_higgs4_WWPP (pairs [P1;P2]) @
- List.map gauge_higgs4_WWSS (pairs [S1;S2;S3]) @
- ThoList.flatmap gauge_higgs4_ZWSC [S1;S2;S3] @
- ThoList.flatmap gauge_higgs4_GaWSC [S1;S2;S3] @
- ThoList.flatmap gauge_higgs4_ZWPC [P1;P2] @
- ThoList.flatmap gauge_higgs4_GaWPC [P1;P2]
-
-(**********************************************FB****)
- 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)) ]
-
-(*** Added by Felix Braam. ***)
-
- 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])
-
-(**********************************FB*********************)
-
- 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])
-
-(***********************************FB********************)
-
- 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]
-(*************************************FB******************)
-
- 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. *FB**)
-(*** REVISED: Compact version using new COMBOS*)
-(*** REVISED: Couplings adjusted to FF-convention*)
- let higgs_SCC s =
- ((Hp, Hm, SHiggs s), Scalar_Scalar_Scalar 1, G_H3_SCC s )
- let higgs_SSS (s1,s2,s3)=
- ((SHiggs s1, SHiggs s2, SHiggs s3), Scalar_Scalar_Scalar 1,
- G_H3_SSS (s1,s2,s3))
- let higgs_SPP (p1,p2,s) =
- ((SHiggs s, PHiggs p1, PHiggs p2), Scalar_Scalar_Scalar 1,
- G_H3_SPP (s,p1,p2))
-
- let higgs =
- List.map higgs_SCC [S1;S2;S3]@
- List.map higgs_SSS (triples [S1;S2;S3])@
- List.map higgs_SPP (two_and_one [P1;P2] [S1;S2;S3])
-
-
- let higgs4 = []
-(* 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' s g =
- ((SHiggs s, Sneutrino g, Sneutrino (-g)), Scalar_Scalar_Scalar 1,
- G_SFSFS (s,SN,g,M1,M1))
- let higgs_sneutrino'' g m =
- [((Hp, Sneutrino (-g), Slepton (m,g)), Scalar_Scalar_Scalar 1,
- G_HSNSL (false,g,m));
- ((Hm, Sneutrino g, Slepton (m,-g)), Scalar_Scalar_Scalar 1,
- G_HSNSL (true,g,m))]
- let higgs_sneutrino =
- Product.list2 higgs_sneutrino' [S1;S2;S3] [1;2;3] @
- List.flatten ( Product.list2 higgs_sneutrino'' [1;2;3] [M1;M2] )
-
-
-(* 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_S s g m1 m2 =
- [ ((SHiggs s, Slepton (m1,g), Slepton (m2,-g)), Scalar_Scalar_Scalar 1,
- G_SFSFS (s,SL,g,m1,m2));
- ((SHiggs s, Sup (m1,g), Sup (m2,-g)), Scalar_Scalar_Scalar 1,
- G_SFSFS (s,SU,g,m1,m2));
- ((SHiggs s, Sdown (m1,g), Sdown (m2,-g)), Scalar_Scalar_Scalar 1,
- G_SFSFS (s,SD,g,m1,m2))]
-
- let higgs_sfermion' g m1 m2 =
- (higgs_sfermion_S S1 g m1 m2) @ (higgs_sfermion_S S2 g m1 m2) @ (higgs_sfermion_S S3 g m1 m2)
-
- let higgs_sfermion_P p g m1 m2 =
- [ ((PHiggs p, Slepton (m1,g), Slepton (m2,-g)), Scalar_Scalar_Scalar 1,
- G_SFSFP (p,SL,g,m1,m2));
- ((PHiggs p, Sup (m1,g), Sup (m2,-g)), Scalar_Scalar_Scalar 1,
- G_SFSFP (p,SU,g,m1,m2));
- ((PHiggs p, Sdown (m1,g), Sdown (m2,-g)), Scalar_Scalar_Scalar 1,
- G_SFSFP (p,SD,g,m1,m2)) ]
-
- let higgs_sfermion'' g m1 m2 =
- (higgs_sfermion_P P1 g m1 m2) @ (higgs_sfermion_P P2 g m1 m2)
- let higgs_sfermion = List.flatten (Product.list3 higgs_sfermion' [1;2;3] [M1;M2] [M1;M2]) @
- List.flatten (Product.list3 higgs_sfermion'' [1;2;3] [M1;M2] [M1;M2])
-
-(*** 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;N5]
- [C1;C2]) @ triple_gauge @
- ThoList.flatmap neutral_Z (pairs [N1;N2;N3;N4;N5]) @
- 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;N5] [C1;C2]) @
- higgs_neutr @ higgs_sneutrino @ higgs_sfermion @
- 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
-
-
-(*SLHA2-Nomenclature for neutral Higgses*)
- 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
- | "h01" -> SHiggs S1 | "h02" -> SHiggs S2 | "h03" -> SHiggs S3
- | "A01" -> PHiggs P1 | "A02" -> PHiggs P2
- | "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)
- | "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
- | "neu5" -> Neutralino N5
- | "ch1+" -> Chargino C1 | "ch2+" -> Chargino C2
- | "ch1-" -> Chargino C1c | "ch2-" -> Chargino C2c
- | s -> invalid_arg ("Fatal error: %s Models.NMSSM.flavor_of_string:" ^ s)
-
- 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.NMSSM.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.NMSSM.flavor_to_string: invalid down type quark"
- | Gl -> "gl" | Gluino -> "sgl"
- | Ga -> "A" | Z -> "Z"
- | Wp -> "W+" | Wm -> "W-"
- | SHiggs S1 -> "h01" | SHiggs S2 -> "h02" | SHiggs S3 -> "h03"
- | PHiggs P1 -> "A01" | PHiggs P2 -> "A02"
- | 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 N5 -> "neu5"
- | Chargino C1 -> "ch1+" | Chargino C1c -> "ch1-"
- | Chargino C2 -> "ch2+" | Chargino C2c -> "ch2-"
- | _ -> invalid_arg "Models.NMSSM.flavor_to_string"
-
- let flavor_to_TeX = function
- | L 1 -> "e^-" | L (-1) -> "e^+"
- | L 2 -> "\\mu^-" | L (-2) -> "\\mu^+"
- | L 3 -> "\\tau^-" | L (-3) -> "\\tau^+"
- | N 1 -> "\\nu_e" | N (-1) -> "\\bar{\\nu}_e"
- | N 2 -> "\\nu_\\mu" | N (-2) -> "\\bar{\\nu}_\\mu"
- | N 3 -> "\\nu_\\tau" | N (-3) -> "\\bar{\\nu}_\\tau"
- | U 1 -> "u" | U (-1) -> "\\bar{u}"
- | U 2 -> "c" | U (-2) -> "\\bar{c}"
- | U 3 -> "t" | U (-3) -> "\\bar{t}"
- | D 1 -> "d" | D (-1) -> "\\bar{d}"
- | D 2 -> "s" | D (-2) -> "\\bar{s}"
- | D 3 -> "b" | D (-3) -> "\\bar{b}"
- | L _ -> invalid_arg
- "Models.NMSSM.flavor_to_TeX: invalid lepton"
- | N _ -> invalid_arg
- "Models.NMSSM.flavor_to_TeX: invalid neutrino"
- | U _ -> invalid_arg
- "Models.NMSSM.flavor_to_TeX: invalid up type quark"
- | D _ -> invalid_arg
- "Models.NMSSM.flavor_to_TeX: invalid down type quark"
- | Gl -> "g" | Gluino -> "\\widetilde{g}"
- | Ga -> "\\gamma" | Z -> "Z" | Wp -> "W^+" | Wm -> "W^-"
- | SHiggs S1 -> "S_1" | SHiggs S2 -> "S_2" | SHiggs S3 -> "S_3"
- | PHiggs P1 -> "P_1" | PHiggs P2 -> "P_2"
- | Hp -> "H^+" | Hm -> "H^-"
- | Slepton (M1,1) -> "\\widetilde{e}_1^-"
- | Slepton (M1,-1) -> "\\widetilde{e}_1^+"
- | Slepton (M1,2) -> "\\widetilde{\\mu}_1^-"
- | Slepton (M1,-2) -> "\\widetilde{\\mu}_1^+"
- | Slepton (M1,3) -> "\\widetilde{\\tau}_1^-"
- | Slepton (M1,-3) -> "\\widetilde{\\tau}_1^+"
- | Slepton (M2,1) -> "\\widetilde{e}_2^-"
- | Slepton (M2,-1) -> "\\widetilde{e}_2^+"
- | Slepton (M2,2) -> "\\widetilde{\\mu}_2^-"
- | Slepton (M2,-2) -> "\\widetilde{\\mu}_2^+"
- | Slepton (M2,3) -> "\\widetilde{\\tau}_2^-"
- | Slepton (M2,-3) -> "\\widetilde{\\tau}_2^+"
- | Sneutrino 1 -> "\\widetilde{\\nu}_e"
- | Sneutrino (-1) -> "\\widetilde{\\nu}_e^*"
- | Sneutrino 2 -> "\\widetilde{\\nu}_\\mu"
- | Sneutrino (-2) -> "\\widetilde{\\nu}_\\mu^*"
- | Sneutrino 3 -> "\\widetilde{\\nu}_\\tau"
- | Sneutrino (-3) -> "\\widetilde{\\nu}_\\tau^*"
- | Sup (M1,1) -> "\\widetilde{u}_1"
- | Sup (M1,-1) -> "\\widetilde{u}_1^*"
- | Sup (M1,2) -> "\\widetilde{c}_1"
- | Sup (M1,-2) -> "\\widetilde{c}_1^*"
- | Sup (M1,3) -> "\\widetilde{t}_1"
- | Sup (M1,-3) -> "\\widetilde{t}_1^*"
- | Sup (M2,1) -> "\\widetilde{u}_2"
- | Sup (M2,-1) -> "\\widetilde{u}_2^*"
- | Sup (M2,2) -> "\\widetilde{c}_2"
- | Sup (M2,-2) -> "\\widetilde{c}_2^*"
- | Sup (M2,3) -> "\\widetilde{t}_2"
- | Sup (M2,-3) -> "\\widetilde{t}_2^*"
- | Sdown (M1,1) -> "\\widetilde{d}_1"
- | Sdown (M1,-1) -> "\\widetilde{d}_1^*"
- | Sdown (M1,2) -> "\\widetilde{s}_1"
- | Sdown (M1,-2) -> "\\widetilde{s}_1^*"
- | Sdown (M1,3) -> "\\widetilde{b}_1"
- | Sdown (M1,-3) -> "\\widetilde{b}_1^*"
- | Sdown (M2,1) -> "\\widetilde{d}_2"
- | Sdown (M2,-1) -> "\\widetilde{d}_2^*"
- | Sdown (M2,2) -> "\\widetilde{s}_2"
- | Sdown (M2,-2) -> "\\widetilde{s}_2^*"
- | Sdown (M2,3) -> "\\widetilde{b}_2"
- | Sdown (M2,-3) -> "\\widetilde{b}_2^*"
- | Neutralino N1 -> "\\widetilde{\\chi}^0_1"
- | Neutralino N2 -> "\\widetilde{\\chi}^0_2"
- | Neutralino N3 -> "\\widetilde{\\chi}^0_3"
- | Neutralino N4 -> "\\widetilde{\\chi}^0_4"
- | Neutralino N5 -> "\\widetilde{\\chi}^0_5"
- | Slepton _ -> invalid_arg
- "Models.NMSSM.flavor_to_TeX: invalid slepton"
- | Sneutrino _ -> invalid_arg
- "Models.NMSSM.flavor_to_TeX: invalid sneutrino"
- | Sup _ -> invalid_arg
- "Models.NMSSM.flavor_to_TeX: invalid up type squark"
- | Sdown _ -> invalid_arg
- "Models.NMSSM.flavor_to_TeX: invalid down type squark"
- | Chargino C1 -> "\\widetilde{\\chi}_1^+"
- | Chargino C1c -> "\\widetilde{\\chi}_1^-"
- | Chargino C2 -> "\\widetilde{\\chi}_2^+"
- | Chargino C2c -> "\\widetilde{\\chi}_2^-"
-
- 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"
- | SHiggs s -> "h0" ^ (string_of_shiggs s)
- | PHiggs p -> "A0" ^ (string_of_phiggs p)
- | 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_to_TeX = flavor_to_TeX
- 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)
- | SHiggs S1 -> 25 | SHiggs S2 -> 35 | SHiggs S3 -> 45
- | PHiggs P1 -> 36 | PHiggs P2 -> 46
- | 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
- | Neutralino N5 -> 1000045
-
-(* 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_5$ & neutralino 5 & 69 \\\hline
- $\tilde{\chi4}^+_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)
- | SHiggs S1 -> 25 | SHiggs S2 -> 35 | PHiggs P1 -> 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
- | PHiggs P2 -> 72 | SHiggs S3 -> 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
- | E -> "e" | G -> "g"
- | Mu -> "mu" | Lambda -> "lambda" | G_Z -> "gz"
- | Q_lepton -> "qlep" | Q_up -> "qup" | Q_down -> "qdwn"
- | Q_charg -> "qchar"
- | 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, "g_ccq" ) ^ "(" ^
- 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_GH4_ZZPP (p1,p2) -> "g_ZZA0A0(" ^ string_of_phiggs p1 ^ ","
- ^ string_of_phiggs p2 ^ ")"
- | G_GH4_ZZSS (s1,s2) -> "g_ZZh0h0(" ^ string_of_shiggs s1 ^ ","
- ^ string_of_shiggs s2 ^ ")"
- | G_GH4_ZZCC -> "g_zzhphm"
- | G_GH4_GaGaCC -> "g_AAhphm"
- | G_GH4_ZGaCC -> "g_zAhphm"
- | G_GH4_WWCC -> "g_wwhphm"
- | G_GH4_WWPP (p1,p2) -> "g_WWA0A0(" ^ string_of_phiggs p1 ^ "," ^
- string_of_phiggs p2 ^ ")"
- | G_GH4_WWSS (s1,s2) -> "g_WWh0h0(" ^ string_of_shiggs s1 ^ "," ^
- string_of_shiggs s2 ^ ")"
- | G_GH4_ZWSC s -> "g_ZWhph0(" ^ string_of_shiggs s ^")"
- | G_GH4_GaWSC s -> "g_AWhph0(" ^ string_of_shiggs s ^")"
- | G_GH4_ZWPC p -> "g_ZWhpA0(" ^ string_of_phiggs p ^")"
- | G_GH4_GaWPC p -> "g_AWhpA0(" ^ string_of_phiggs p ^")"
- | G_CICIS (n1,n2,s) -> "g_neuneuh0(" ^ string_of_neu n1 ^ "," ^
- string_of_neu n2 ^ "," ^ string_of_shiggs s ^ ")"
- | G_CICIP (n1,n2,p) -> "g_neuneuA0(" ^ string_of_neu n1 ^ "," ^
- string_of_neu n2 ^ "," ^ string_of_phiggs p ^ ")"
- | G_H3_SCC s -> "g_h0hphm(" ^ string_of_shiggs s ^ ")"
- | G_H3_SPP (s,p1,p2) -> "g_h0A0A0(" ^ string_of_shiggs s ^ "," ^
- string_of_phiggs p1 ^ "," ^ string_of_phiggs p2 ^ ")"
- | G_H3_SSS (s1,s2,s3) -> "g_h0h0h0(" ^ string_of_shiggs s1 ^ "," ^
- string_of_shiggs s2 ^ "," ^ string_of_shiggs s3 ^ ")"
- | G_CSC (c1,c2,s) -> "g_chchh0(" ^ string_of_char c1 ^ "," ^
- string_of_char c2 ^ "," ^ string_of_shiggs s ^")"
- | G_CPC (c1,c2,p) -> "g_chchA0(" ^ string_of_char c1 ^ "," ^
- string_of_char c2 ^ "," ^ string_of_phiggs p ^")"
- | G_YUK_FFS (f1,f2,s) -> "g_yuk_h0_" ^ string_of_fermion_type f1 ^
- string_of_fermion_type f2 ^ "(" ^ string_of_shiggs s ^ "," ^
- string_of_fermion_gen f1 ^ ")"
- | G_YUK_FFP (f1,f2,p) -> "g_yuk_A0_" ^ string_of_fermion_type f1 ^
- string_of_fermion_type f2 ^ "(" ^ string_of_phiggs p ^ "," ^
- string_of_fermion_gen f1 ^ ")"
- | G_YUK_LCN g -> "g_yuk_hp_ln(" ^ string_of_int g ^ ")"
- | G_NWC (n,c) -> "g_nwc(" ^ string_of_char c ^ "," ^ string_of_neu n
- ^ ")"
- | G_CWN (c,n) -> "g_cwn(" ^ string_of_char c ^ "," ^ string_of_neu n
- ^ ")"
- | G_SLSNW (vc,g,m) -> conj_symbol (vc, "g_wslsn") ^ "(" ^
- string_of_int g ^ "," ^ string_of_sfm m ^ ")"
- | G_NZN (n1,n2) -> "g_zneuneu(" ^ string_of_neu n1 ^ ","
- ^ string_of_neu n2 ^ ")"
- | G_CZC (c1,c2) -> "g_zchch(" ^ string_of_char c1 ^ "," ^
- string_of_char c2 ^ ")"
- | Gs -> "gs"
- | G_YUK_UCD (n,m) -> "g_yuk_hp_ud(" ^ string_of_int n ^ "," ^
- string_of_int m ^ ")"
- | G_YUK_DCU (n,m) -> "g_yuk_hm_du(" ^ string_of_int n ^ "," ^
- string_of_int m ^ ")"
- | G_YUK_N (vc,f,n,sf,m) -> conj_symbol (vc, "g_yuk_neu_" ^
- string_of_fermion_type f ^ string_of_sff sf) ^ "(" ^
- string_of_fermion_gen f ^ "," ^ string_of_neu n ^ "," ^
- string_of_sfm m ^ ")"
- | G_YUK_G (vc,f,sf,m) -> conj_symbol (vc, "g_yuk_gluino_" ^
- string_of_fermion_type f ^ string_of_sff sf) ^ "(" ^
- string_of_fermion_gen f ^ "," ^ string_of_sfm m ^ ")"
- | G_YUK_C (vc,f,c,sf,m) -> conj_symbol (vc, "g_yuk_char_" ^
- string_of_fermion_type f ^ string_of_sff sf) ^ "(" ^
- string_of_fermion_gen f ^ "," ^ string_of_char c ^ "," ^
- string_of_sfm m ^ ")"
- | G_YUK_Q (vc,g1,f,c,sf,m) -> conj_symbol (vc, "g_yuk_char_" ^
- string_of_fermion_type f ^ string_of_sff sf) ^ "(" ^ string_of_int
- g1 ^ "," ^ string_of_fermion_gen f ^ "," ^ string_of_char c ^ ","
- ^ string_of_sfm m ^ ")"
- | G_WPSUSD (vc,m1,m2,g1,g2) -> conj_symbol (vc, "g_wA_susd") ^ "(" ^
- string_of_int g1 ^ "," ^ string_of_int g2 ^ "," ^ string_of_sfm m1 ^
- "," ^ string_of_sfm m2 ^ ")"
- | G_WZSUSD (vc,m1,m2,g1,g2) -> conj_symbol (vc, "g_wz_susd") ^ "(" ^
- string_of_int g1 ^ "," ^ string_of_int g2 ^ "," ^ string_of_sfm m1 ^
- "," ^ string_of_sfm m2 ^ ")"
- | G_GH_ZSP (s,p) -> "g_zh0a0(" ^ string_of_shiggs s ^ "," ^
- string_of_phiggs p ^ ")"
- | G_GH_WSC s -> "g_Whph0(" ^ string_of_shiggs s ^ ")"
- | G_GH_WPC p -> "g_WhpA0(" ^ string_of_phiggs p ^ ")"
- | G_GH_ZZS s -> "g_ZZh0(" ^ string_of_shiggs s ^ ")"
- | G_GH_WWS s -> "g_WWh0(" ^ string_of_shiggs s ^ ")"
- | G_GH_ZCC -> "g_Zhmhp"
- | G_GH_GaCC -> "g_Ahmhp"
- | G_ZSF (f,g,m1,m2) -> "g_z" ^ string_of_sff f ^ string_of_sff f ^ "(" ^
- string_of_int g ^ "," ^ string_of_sfm m1 ^ "," ^ string_of_sfm m2
- ^ ")"
- | G_HSNSL (vc,g,m) -> conj_symbol (vc, "g_hp_sl" ^ string_of_sfm m ^
- "sn1") ^ "(" ^ string_of_int g ^ ")"
- | G_GlGlSQSQ -> "g_gg_sqsq"
- | G_PPSFSF f -> "g_AA_" ^ string_of_sff f ^ string_of_sff f
- | G_ZZSFSF (f,g,m1,m2) -> "g_zz_" ^ string_of_sff f ^ string_of_sff f ^
- "(" ^ string_of_int g ^","^ string_of_sfm m1
- ^ "," ^ string_of_sfm m2 ^ ")"
- | G_ZPSFSF (f,g,m1,m2) -> "g_zA_" ^ string_of_sff f ^ string_of_sff f ^
- "(" ^ string_of_int g ^","^ string_of_sfm m1
- ^ "," ^ string_of_sfm m2 ^ ")"
- | G_GlPSQSQ -> "g_gA_sqsq"
- | G_GlZSFSF (f,g,m1,m2) -> "g_gz_" ^ string_of_sff f ^ string_of_sff f ^
- "(" ^ string_of_int g ^ "," ^ string_of_sfm m1 ^ "," ^ string_of_sfm
- m2 ^ ")"
- | G_GlWSUSD (vc,m1,m2,g1,g2) -> conj_symbol (vc, "g_gw_susd") ^ "(" ^
- string_of_int g1 ^ "," ^ string_of_int g2 ^ "," ^ string_of_sfm m1 ^
- "," ^ string_of_sfm m2 ^ ")"
- | G_SS -> "gs**2"
- | I_G_S -> "igs"
- | G_NHC (vc,n,c) -> conj_symbol(vc,"g_neuhmchar") ^ "(" ^
- string_of_neu n ^ "," ^ string_of_char c ^")"
- | G_WWSFSF (f,g,m1,m2) -> "g_ww_" ^ string_of_sff f
- ^ string_of_sff f ^"(" ^ string_of_int g ^ "," ^ string_of_sfm m1 ^
- "," ^ string_of_sfm m2 ^ ")"
- | G_WPSLSN (vc,g,m) -> conj_symbol (vc, "g_wA_slsn") ^ "(" ^
- string_of_int g ^ "," ^ string_of_sfm m ^ ")"
- | G_WZSLSN (vc,g,m) -> conj_symbol (vc, "g_wz_slsn") ^"("^ string_of_int
- g ^ "," ^ string_of_sfm m ^ ")"
- | G_SFSFS (s,f,g,m1,m2) -> "g_h0_"^ string_of_sff f ^ string_of_sfm m1
- ^ string_of_sff f ^ string_of_sfm m2 ^ "(" ^ string_of_shiggs s ^ ","
- ^ string_of_int g ^ ")"
- | G_SFSFP (p,f,g,m1,m2) -> "g_A0_"^ string_of_sff f ^ string_of_sfm m1
- ^ string_of_sff f ^ string_of_sfm m2 ^ "(" ^ string_of_phiggs p ^ ","
- ^ string_of_int g ^ ")"
- | G_HSUSD (vc,m1,m2,g1,g2) -> conj_symbol (vc, "g_hp_su" ^ string_of_sfm
- m1 ^ "sd" ^ string_of_sfm m2 )^ "(" ^ string_of_int g1 ^ ","
- ^ string_of_int g2 ^")"
- | G_WSQ (vc,g1,g2,m1,m2) -> conj_symbol (vc, "g_wsusd") ^ "("
- ^ string_of_int g1 ^ "," ^ string_of_int g2 ^ "," ^ string_of_sfm m1
- ^ "," ^ string_of_sfm m2 ^ ")"
-
- end
-
-(*i
- * Local Variables:
- * mode:caml
- * indent-tabs-mode:nil
- * page-delimiter:"^(\\* .*\n"
- * End:
-i*)
Index: branches/ohl/omega-development/hgg-vertex/src/complex.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/complex.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/complex.ml (revision 8717)
@@ -1,249 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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/hgg-vertex/src/targets_Kmatrix.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/targets_Kmatrix.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/targets_Kmatrix.ml (revision 8717)
@@ -1,535 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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)/2 + (m**4+6*m**2*s+6*s**2) &"; nl();
- printf " /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)))/6/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 " a00(4) = cc(4)**2/vev**2 * (d0stu(s,m(4)) &"; nl ();
- printf " /3.0 + 11.0*s**2/m(4)**2/36.0)"; nl ();
- printf " a00(4) = vev**4/s**2*a00(4)/&"; nl ();
- printf " (1.0_default - fudge_km*ii*a00(4))"; nl ();
- printf " !!! Tensor isoquintet"; nl ();
- printf " a00(5) = 5.0*cc(5)**2/vev**2*(d0stu(s,m(5))&"; nl ();
- printf " /3.0 + s**2/m(5)**2/18.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)*((1.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**2/m(4)**2/180.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 " (1.+6.*s/m(4)**2+6.*s**2/m(4)**4)*s2stu(s,m(4))/ &"; nl ();
- printf " 3. + s**2/m(4)**2/180.)"; 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*(1.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**2/m(5)**2/216.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)) &"; nl ();
- printf " /3.0 - s**2/m(4)**2/36.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)) &"; nl ();
- printf " + s**2/m(5)**2/12.0)/36.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)) &"; nl ();
- printf " /3.0 + s**2/m(4)**2/18.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 " a20(5) = cc(5)**2/vev**2*(d0stu(s,m(5)) &"; nl ();
- printf " + 5.0*s**2/m(4)**2/3.0)/36.0"; nl ();
- printf " a20(5) = vev**4/s**2*a20(5)/&"; nl ();
- printf " (1.0_default - fudge_km*ii*a20(5))"; 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*((1.0 + 6.0*s/m(4)**2+6.0* &"; nl ();
- printf " s**2/m(4)**4)*s2stu(s,m(4))/3.0 + s**2/m(4)**2/180.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/60.0 + &"; nl ();
- printf " (s-m(5)**2)*((1.0+6.0*s/m(5)**2+6.0* &"; nl ();
- printf " s**2/m(5)**4)*s2stu(s,m(5))/36.0 &"; nl ();
- printf " + s**2/m(5)**2/2160.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. + (1.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**2/m(5)**2/2160.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/hgg-vertex/src/bundle.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/bundle.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/bundle.ml (revision 8717)
@@ -1,104 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2010 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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 Projection =
- sig
- type elt
- type base
- val compare_elt : elt -> elt -> int
- val compare_base : base -> base -> int
- val pi : elt -> base
- end
-
-module type T =
- sig
- type t
- type elt
- type fiber = elt list
- type base
- val of_list : elt list -> t
- val pi : elt -> base
- val inv_pi : base -> t -> fiber
- val base : t -> base list
- val fiber : elt -> t -> fiber
- val fibers : t -> (base * fiber) list
- end
-
-module Make (P : Projection) =
- struct
-
- type elt = P.elt
- type base = P.base
- let pi = P.pi
-
- type fiber = elt list
-
- module InvPi = Map.Make (struct type t = P.base let compare = P.compare_base end)
- module Fiber = Set.Make (struct type t = P.elt let compare = P.compare_elt end)
-
- type t = Fiber.t InvPi.t
-
- let of_list list =
- List.fold_left
- (fun fibers element ->
- let base = pi element in
- let fiber =
- try InvPi.find base fibers with Not_found -> Fiber.empty in
- InvPi.add base (Fiber.add element fiber) fibers) InvPi.empty list
-
- let fibers bundle =
- InvPi.fold
- (fun base fiber acc -> (base, Fiber.elements fiber) :: acc) bundle []
-
- let base bundle =
- InvPi.fold
- (fun base fiber acc -> base :: acc) bundle []
-
- let inv_pi base bundle =
- Fiber.elements (InvPi.find base bundle)
-
- let fiber elt bundle =
- inv_pi (pi elt) bundle
-
- end
-
-(*i
-module Test = Make (struct
- type fiber = int
- type base = int
- let compare_fiber = compare
- let compare_base = compare
- let pi = abs
-end)
-
-let sample = [-1; -4; 7; -8; 9; 42; -137; -42; 42; 4; 1; -9]
-
-Test.fibers (Test.classify sample);;
-i*)
-
-(*i
- * Local Variables:
- * mode:caml
- * indent-tabs-mode:nil
- * page-delimiter:"^(\\* .*\n"
- * End:
-i*)
Index: branches/ohl/omega-development/hgg-vertex/src/targets.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/targets.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/targets.ml (revision 8717)
@@ -1,3345 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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 | 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
-
-(* \begin{dubious}
- JR's coupling constant HACK, necessitated by tho's bad design descition.
- \end{dubious} *)
-
- let fastener s i =
- try
- let offset = (String.index s '(') in
- if ((String.get s (String.length s - 1)) != ')') then
- failwith "fastener: wrong usage of parentheses"
- else
- let func_name = (String.sub s 0 offset) and
- tail =
- (String.sub s (succ offset) (String.length s - offset - 2)) in
- if (String.contains func_name ')') or
- (String.contains tail '(') or
- (String.contains tail ')') then
- failwith "fastener: wrong usage of parentheses"
- else
- func_name ^ "(" ^ string_of_int i ^ "," ^ tail ^ ")"
- with
- | Not_found ->
- if (String.contains s ')') then
- failwith "fastener: wrong usage of parentheses"
- else
- s ^ "(" ^ string_of_int i ^ ")"
-
- 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
- let c1 = fastener c 1
- and c2 = fastener c 2 in
- match fusion with
- | F13 -> printf "%s_ff(%s,%s,%s,%s)" f c1 c2 wf1 wf2
- | F31 -> printf "%s_ff(%s,%s,%s,%s)" f c1 c2 wf2 wf1
- | F23 -> printf "f_%sf(%s,%s,%s,%s)" f c1 c2 wf1 wf2
- | F32 -> printf "f_%sf(%s,%s,%s,%s)" f c1 c2 wf2 wf1
- | F12 -> printf "f_f%s(%s,%s,%s,%s)" f c1 c2 wf1 wf2
- | F21 -> printf "f_f%s(%s,%s,%s,%s)" f c1 c2 wf2 wf1
-
- let print_current = function
- | coeff, Psibar, VA, Psi -> print_fermion_current2 coeff "va"
- | coeff, Psibar, VA2, Psi -> print_fermion_current coeff "va2"
- | 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_2010_01_A"; "omega_spinor_cpls_2010_01_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_2010_01_A"; "omega_polarizations_2010_01_A";
- "omega_couplings_2010_01_A"; "omega_utils_2010_01_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 ""
- let md5sum = ref None
- 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";
- "md5sum", Arg.String (fun s -> md5sum := Some s),
- "transfer MD5 checksum";
- "whizard", Arg.Set whizard, "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 flavors_symbol flavors =
- String.concat "" (List.map CM.flavor_symbol flavors)
-
- 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)
- module WFSet = Set.Make (struct type t = F.wf let compare = compare end)
- module WFSet2 = Set.Make (struct type t = F.wf * F.wf Tree2.t let compare = compare end)
- module WFMap = Map.Make (struct type t = F.wf let compare = compare end)
- module WFMap2 = Map.Make (struct type t = F.wf * F.wf Tree2.t let compare = compare end)
- module WFTSet = Set.Make (struct type t = F.wf Tree2.t 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 format_multiple_variable wf i =
- variable wf ^ "_X" ^ string_of_int i
-
- let multiple_variable amplitude dictionary wf =
- try
- format_multiple_variable wf (WFMap2.find (wf, F.dependencies amplitude wf) dictionary)
- with
- | Not_found -> variable wf
-
- let multiple_variables multiplicities wf =
- try
- List.map
- (format_multiple_variable wf)
- (ThoList.range 1 (WFMap.find wf multiplicities))
- with
- | Not_found -> [variable wf]
-
- let declare_list multiplicities t = function
- | [] -> ()
- | wfs ->
- printf " @[<2>%s :: " t;
- print_list (ThoList.flatmap (multiple_variables multiplicities) 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;
- ward_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}
-(*i | Ward_Vector -> {acc with ward_vectors = wf :: acc.ward_vectors}
-i*)
- | 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 = [];
- ward_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 constants"; nl ();
-(*i printf " use omega_constants"; nl (); i*)
- 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 | 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_momenta = ref Off
- let diagnose_gauge = ref Off
-
- let rec parse_diagnostic = function
- | All, panic ->
- parse_diagnostic (Arguments, panic);
- parse_diagnostic (Momenta, panic);
- parse_diagnostic (Gauge, panic)
- | Arguments, panic ->
- diagnose_arguments := 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_momenta = function
- | [] -> ()
- | momenta ->
- printf " @[<2>type(momentum) :: ";
- print_list (List.map format_momentum momenta); nl ()
-
- let declare_wavefunctions multiplicities wfs =
- let wfs' = classify_wfs wfs in
- declare_list multiplicities ("complex(kind=" ^ !kind ^ ")")
- (wfs'.scalars @ wfs'.brs_scalars);
- declare_list multiplicities ("type(" ^ Fermions.psi_type ^ ")")
- (wfs'.spinors @ wfs'.brs_spinors);
- declare_list multiplicities ("type(" ^ Fermions.psibar_type ^ ")")
- (wfs'.conjspinors @ wfs'.brs_conjspinors);
- declare_list multiplicities ("type(" ^ Fermions.chi_type ^ ")")
- (wfs'.realspinors @ wfs'.brs_realspinors @ wfs'.ghostspinors);
- declare_list multiplicities ("type(" ^ Fermions.grav_type ^ ")") wfs'.vectorspinors;
- declare_list multiplicities "type(vector)" (wfs'.vectors @ wfs'.massive_vectors @
- wfs'.brs_vectors @ wfs'.brs_massive_vectors @ wfs'.ward_vectors);
- declare_list multiplicities "type(tensor2odd)" wfs'.tensors_1;
- declare_list multiplicities "type(tensor)" wfs'.tensors_2
-
- let flavors a = F.incoming a @ F.outgoing a
-
- let declare_brakets = function
- | [] -> ()
- | amplitudes ->
- printf " @[<2>complex(kind=%s) :: " !kind;
- print_list (List.map (fun a -> flavors_symbol (flavors a)) amplitudes); nl ()
-
- let print_declarations multiplicities dictionary amplitudes =
- declare_momenta
- (PSet.elements
- (List.fold_left
- (fun set a ->
- PSet.union set (List.fold_right
- (fun wf -> PSet.add (F.momentum_list wf))
- (F.externals a) PSet.empty))
- PSet.empty amplitudes));
- declare_wavefunctions multiplicities
- (WFSet.elements
- (List.fold_left
- (fun set a ->
- WFSet.union set (List.fold_right WFSet.add (F.externals a) WFSet.empty))
- WFSet.empty amplitudes));
- declare_momenta
- (PSet.elements
- (List.fold_left
- (fun set a ->
- PSet.union set (List.fold_right
- (fun wf -> PSet.add (F.momentum_list wf))
- (F.variables a) PSet.empty))
- PSet.empty amplitudes));
- declare_wavefunctions multiplicities
- (WFSet.elements
- (List.fold_left
- (fun set a ->
- WFSet.union set (List.fold_right WFSet.add (F.variables a) WFSet.empty))
- WFSet.empty amplitudes));
- declare_brakets amplitudes
-
-(* [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 amplitude dictionary rhs =
- match F.coupling rhs with
- | V3 (vertex, fusion, constant) ->
- let ch1, ch2 = children2 rhs in
- let wf1 = multiple_variable amplitude dictionary ch1
- and wf2 = multiple_variable amplitude dictionary 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 = multiple_variable amplitude dictionary ch1
- and wf2 = multiple_variable amplitude dictionary ch2
- and wf3 = multiple_variable amplitude dictionary 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 amplitude dictionary 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 amplitude dictionary) (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 dictionary fusion =
- let lhs = F.lhs fusion in
- let dependencies = F.dependencies amplitude lhs in
- let f = F.flavor lhs in
- printf " @[<2>%s = " (multiple_variable amplitude dictionary 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 amplitude dictionary) (F.rhs fusion);
- printf ")"; nl ()
-
- let print_momenta seen_momenta amplitude =
- 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;
- PSet.add p seen)
- seen_momenta (F.fusions amplitude)
-
-(* All wavefunctions are unique per amplitude. So we can use per-amplitude
- dependency trees without additional \emph{internal} tags to identify identical
- wave functions. *)
-
-(* \textbf{NB:} we miss potential optimizations, because we assume all coupling to
- be different, while in fact we have horizontal/family symmetries and non abelian
- gauge couplings are universal anyway. *)
-
- let disambiguate_fusions amplitudes =
- let fusions =
- ThoList.flatmap (fun amplitude ->
- List.map
- (fun fusion -> (fusion, F.dependencies amplitude (F.lhs fusion)))
- (F.fusions amplitude))
- amplitudes in
- let duplicates =
- List.fold_left
- (fun map (fusion, dependencies) ->
- let wf = F.lhs fusion in
- let set = try WFMap.find wf map with Not_found -> WFTSet.empty in
- WFMap.add wf (WFTSet.add dependencies set) map)
- WFMap.empty fusions in
- let multiplicities =
- WFMap.fold (fun wf dependencies acc ->
- let cardinal = WFTSet.cardinal dependencies in
- if cardinal <= 1 then
- acc
- else
- WFMap.add wf cardinal acc)
- duplicates WFMap.empty
- and dictionary =
- WFMap.fold (fun wf dependencies acc ->
- let cardinal = WFTSet.cardinal dependencies in
- if cardinal <= 1 then
- acc
- else
- snd (WFTSet.fold
- (fun dependency (i', acc') ->
- (succ i', WFMap2.add (wf, dependency) i' acc'))
- dependencies (1, acc)))
- duplicates WFMap2.empty
- in
- (multiplicities, dictionary)
-
- let print_fusions dictionary seen_wfs amplitude =
- List.fold_left (fun seen f ->
- let wf = F.lhs f in
- let dependencies = F.dependencies amplitude wf in
-(*i printf " ! %s <- %s"
- (multiple_variable amplitude dictionary wf)
- (Tree2.to_string variable dependencies); nl (); i*)
- let p = F.momentum_list wf in
- if not (WFSet2.mem (wf, dependencies) seen) then begin
- print_fusion_diagnostics amplitude dictionary f;
- print_fusion amplitude dictionary f;
- end;
- WFSet2.add (wf, dependencies) seen)
- seen_wfs (F.fusions amplitude)
-
- let print_braket amplitude dictionary 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*(@," (multiple_variable amplitude dictionary bra);
- List.iter (print_current amplitude dictionary) ket;
- printf ")"
- | true ->
- printf "(@,";
- List.iter (print_current amplitude dictionary) ket;
- printf ")*%s" (multiple_variable amplitude dictionary 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} *)
-
-(* \begin{dubious}
- [tho:] we write some brakets twice using different names. Is it useful
- to cache them?
- \end{dubious} *)
-
- let print_brakets dictionary amplitude =
- let name = flavors_symbol (flavors amplitude) in
- printf " %s = 0" name; nl ();
- List.iter (print_braket amplitude dictionary 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
-(*i | Ward_Vector -> printf "%s" p i*)
- | 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
-(*i | Ward_Vector -> printf "%s" p i*)
- | 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)"
- (suffix diagnose_arguments) n; 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_external_momenta 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"
- (momentum wf) (ext_momentum wf)
- else
- printf " %s = k(:,%d) ! outgoing"
- (momentum wf) (ext_momentum wf); nl ()) externals
-
- let print_externals seen_wfs amplitude =
- let externals =
- List.combine
- (F.externals amplitude)
- (List.map (fun _ -> true) (F.incoming amplitude) @
- List.map (fun _ -> false) (F.outgoing amplitude)) in
- List.fold_left (fun seen (wf, incoming) ->
- if not (WFSet.mem wf seen) then begin
- printf " %s = " (variable wf);
- (if incoming then print_incoming else print_outgoing) wf; nl ()
- end;
- WFSet.add wf seen) seen_wfs externals
-
- 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 print_fudge_factor amplitude =
- let name = flavors_symbol (flavors amplitude) in
- 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 num_helicities amplitudes =
- List.length (CF.helicities amplitudes)
-
- let print_amplitudes amplitudes =
- printf " @[<5>"; if !fortran95 then printf "pure ";
- printf "subroutine calculate_amplitudes (amp, k, mask)"; nl ();
- printf " complex(kind=default), dimension(:,:,:), intent(out) :: amp"; nl ();
- printf " real(kind=default), dimension(0:3,*), intent(in) :: k"; nl ();
- printf " logical, dimension(:), intent(in) :: mask"; nl ();
- printf " integer, dimension(n_prt) :: s"; nl ();
- printf " integer :: h"; nl ();
- let multiplicities, dictionary = disambiguate_fusions (CF.processes amplitudes) in
- print_declarations multiplicities dictionary (CF.processes amplitudes);
- List.iter print_argument_diagnostics (CF.processes amplitudes);
- begin match CF.processes amplitudes with
- | p :: _ -> print_external_momenta p
- | _ -> ()
- end;
- ignore (List.fold_left print_momenta PSet.empty (CF.processes amplitudes));
- printf " amp = 0"; nl ();
- if num_helicities amplitudes > 0 then begin
- printf " do h = 1, n_hel"; nl ();
- printf " if (mask(h)) then"; nl ();
- printf " s = table_spin_states(:,h)"; nl ();
- ignore (List.fold_left print_externals WFSet.empty (CF.processes amplitudes));
- ignore (List.fold_left (print_fusions dictionary) WFSet2.empty (CF.processes amplitudes));
- List.iter (print_brakets dictionary) (CF.processes amplitudes);
- List.iter print_fudge_factor (CF.processes amplitudes);
- Array.iteri (fun f c_list ->
- Array.iteri (fun c -> function
- | Some a ->
- printf " amp(%d,h,%d) = %s"
- (succ f) (succ c) (flavors_symbol (flavors a)); nl ()
- | None -> ())
- c_list)
- (CF.process_table amplitudes);
-(*i printf " else"; nl ();
- printf " amp(:,h,:) = 0"; nl (); i*)
- printf " end if"; nl ();
- printf " end do"; nl ();
- end;
- 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 the same algorithm every time.
- \end{dubious} *)
-
- let print_integer_parameter name value =
- printf " @[<2>integer, parameter, private :: %s = %d" name value; nl ()
-
- let print_real_parameter name value =
- printf " @[<2>real(kind=%s), parameter, private :: %s = %d_%s"
- !kind name value !kind; 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 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), 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), 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 format_power_of x = function
- | None -> "zero"
- | Some 0 -> "one"
- | Some 1 -> x
- | Some -1 -> "1/" ^ x
- | Some pwr when pwr < -1 -> "1/" ^ x ^ "**" ^ string_of_int (- pwr)
- | Some pwr -> x ^ "**" ^ string_of_int pwr
-
- let print_color_factor_table abbrev table =
- let n_cflow = Array.length table in
- if n_cflow <= 0 then begin
- printf " @[<2>real(kind=default), dimension(n_cflow, n_cflow), private ::";
- printf "@ color_factor_table"; nl ()
- end else begin
- for c2 = 0 to pred n_cflow do
- printf
- " @[<2>real(kind=default), dimension(n_cflow), parameter, private ::";
- printf "@ %s%04d = (/@ %s" abbrev (succ c2) (format_power_of "n_c" table.(0).(c2));
- for c1 = 1 to pred n_cflow do
- printf ",@ %s" (format_power_of "n_c" table.(c1).(c2))
- done;
- printf "@ /)"; nl ()
- done;
- printf
- " @[<2>real(kind=default), dimension(n_cflow, n_cflow), parameter, private ::";
- printf "@ color_factor_table =@ reshape ( (/@ %s%04d" abbrev 1;
- for c = 1 to pred n_cflow do
- printf ",@ %s%04d" abbrev (succ c)
- done;
- printf "@ /),@ (/ n_cflow, n_cflow /) )"; nl ()
- end
-
- let print_color_tables cflows cfactors =
- print_color_flows_table "c" cflows;
- print_ghost_flags_table "g" cflows;
- print_color_factor_table "k" cfactors;
- nl ()
-
- let option_to_logical = function
- | Some _ -> "T"
- | None -> "F"
-
- let print_flavor_color_table abbrev n_flv n_cflow table =
- if n_flv <= 0 or n_cflow <= 0 then begin
- printf " @[<2>logical, dimension(n_flv, n_cflow), private ::";
- printf "@ flv_col_is_allowed"; nl ()
- end else begin
- for c = 0 to pred n_cflow do
- printf
- " @[<2>logical, dimension(n_flv), parameter, private ::";
- printf "@ %s%04d = (/@ %s" abbrev (succ c) (option_to_logical table.(0).(c));
- for f = 1 to pred n_flv do
- printf ",@ %s" (option_to_logical table.(f).(c))
- done;
- printf "@ /)"; nl ()
- done;
- printf
- " @[<2>logical, dimension(n_flv, n_cflow), parameter, private ::";
- printf "@ flv_col_is_allowed =@ reshape ( (/@ %s%04d" abbrev 1;
- for c = 1 to pred n_cflow do
- printf ",@ %s%04d" abbrev (succ c)
- done;
- printf "@ /),@ (/ n_flv, n_cflow /) )"; nl ()
- end
-
- let print_amplitude_table a =
- print_flavor_color_table "a"
- (num_flavors a) (List.length (CF.color_flows a)) (CF.process_table a);
- nl ();
- printf
- " @[<2>complex(kind=default), dimension(n_flv, n_hel, n_cflow), private, save :: amp";
- nl ();
- nl ()
-
- let print_helicity_selection_table () =
- printf " @[<2>logical, dimension(n_hel), private, save :: ";
- printf "hel_is_allowed = T"; nl();
- printf " @[<2>real(kind=default), dimension(n_hel), private, save :: ";
- printf "hel_max_abs = 0"; nl ();
- printf " @[<2>real(kind=default), private, save :: ";
- printf "hel_sum_abs = 0, ";
- printf "hel_threshold = 1E10"; nl ();
- printf " @[<2>integer, private, save :: ";
- printf "hel_count = 0, ";
- printf "hel_cutoff = 100"; nl ();
- nl ()
-
-(* \thocwmodulesubsection{Optional MD5 sum function} *)
-
- let print_md5sum_functions () =
- match !md5sum with
- | Some s ->
- begin
- printf " @[<5>"; if !fortran95 then printf "pure ";
- printf "function md5sum ()"; nl ();
- printf " character(len=32) :: md5sum"; nl ();
- printf " ! DON'T EVEN THINK of modifying the following line!"; nl ();
- printf " md5sum = \"%s\"" s; nl ();
- printf " end function md5sum"; nl ();
- nl ()
- end
- | None -> ()
-
-(* \thocwmodulesubsection{Maintenance \&\ Inquiry Functions} *)
-
- let print_maintenance_functions amplitudes =
- if !whizard then begin
- printf " subroutine init (par)"; nl ();
- printf " real(default), dimension(*), intent(in) :: par"; nl ();
- printf " call import_from_whizard (par)"; nl ();
- printf " end subroutine init"; nl ();
- nl ();
- printf " subroutine final ()"; nl ();
- printf " if (hel_threshold .gt. 0) then"; nl ();
- printf " call omega_report_helicity_selection ";
- printf "(hel_is_allowed, table_spin_states, hel_threshold)"; nl ();
- printf " end if"; nl ();
- printf " end subroutine final"; nl ();
- nl ();
- printf " subroutine update_alpha_s (alpha_s)"; nl ();
- printf " real(default), intent(in) :: alpha_s"; nl ();
- printf " call model_update_alpha_s (alpha_s)"; nl ();
- printf " end subroutine update_alpha_s"; 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_color_factors () =
- printf " @[<5>"; if !fortran95 then printf "pure ";
- printf "function color_factor (cflow1, cflow2) result (cf)"; nl ();
- printf " real(kind=default) :: cf"; nl ();
- printf " integer, intent(in) :: cflow1, cflow2"; nl ();
- printf " cf = color_factor_table(cflow1,cflow2)"; nl ();
- printf " end function color_factor"; nl ();
- nl ();
- printf " @[<5>"; if !fortran95 then printf "pure ";
- printf "subroutine color_factors (cf)"; nl ();
- printf " real(kind=default), dimension(:,:), intent(out) :: cf"; nl ();
- printf " cf = color_factor_table"; nl ();
- printf " end subroutine color_factors"; nl ();
- nl ()
-
- let print_dispatch_functions () =
- printf " @[<5>";
- printf "subroutine new_event (p)"; nl ();
- printf " real(kind=default), dimension(0:3,*), intent(in) :: p"; nl ();
- printf " call calculate_amplitudes (amp, p, hel_is_allowed)"; nl ();
- printf " if ((hel_threshold .gt. 0) .and. (hel_count .le. hel_cutoff)) then"; nl ();
- printf " call omega_update_helicity_selection (hel_count, amp, ";
- printf "hel_max_abs, hel_sum_abs, hel_is_allowed, hel_threshold, hel_cutoff)"; nl ();
- printf " end if"; nl();
- printf " end subroutine new_event"; nl ();
- nl ();
- printf " @[<5>";
- printf "subroutine reset_helicity_selection (threshold, cutoff)"; nl ();
- printf " real(kind=default), intent(in) :: threshold"; nl ();
- printf " integer, intent(in) :: cutoff"; nl ();
- printf " hel_is_allowed = T"; nl ();
- printf " hel_max_abs = 0"; nl ();
- printf " hel_sum_abs = 0"; nl ();
- printf " hel_count = 0"; nl ();
- printf " hel_threshold = threshold"; nl ();
- printf " hel_cutoff = cutoff"; nl ();
- printf " end subroutine reset_helicity_selection"; nl ();
- nl ();
- printf " @[<5>"; if !fortran95 then printf "pure ";
- printf "function is_allowed (flv, hel, col) result (yorn)"; nl ();
- printf " logical :: yorn"; nl ();
- printf " integer, intent(in) :: flv, hel, col"; nl ();
- printf " yorn = hel_is_allowed(hel) .and. ";
- printf "flv_col_is_allowed(flv,col)"; 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(flv, hel, col)"; 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 "! flavor combinations:"; nl ();
- printf "!"; nl ();
- ThoList.iteri
- (fun i process ->
- printf "! %3d: %s" i (process_sans_color_to_string process); nl ())
- 1 (CF.flavors amplitudes);
- printf "!"; nl ();
- printf "! color flows:"; nl ();
- printf "!"; nl ();
- ThoList.iteri
- (fun i cflow ->
- printf "! %3d: %s" i (cflow_to_string cflow); nl ())
- 1 (CF.color_flows amplitudes);
- printf "!"; nl ();
- printf "! NB: i.g. not all color flows contribute to all flavor"; nl ();
- printf "! combinations. Consult the array FLV_COL_IS_ALLOWED"; nl ();
- printf "! below for the allowed combinations."; nl ();
- printf "!"; nl ();
- printf "! powers of Nc (EXPERIMENTAL!!!):"; nl ();
- printf "!"; nl ();
- printf "! ";
- Array.iteri
- (fun c2 _ -> printf " %3d" (succ c2))
- (CF.color_factors amplitudes);
- nl ();
- Array.iteri
- (fun c1 c2s ->
- printf "! %3d:" (succ c1);
- Array.iteri
- (fun c2 -> function
- | Some power_of_nc -> printf " %3d" power_of_nc
- | None -> printf " ") c2s; nl ())
- (CF.color_factors amplitudes);
- printf "!"; nl ();
- printf "! forbidden flavor combinations:"; nl ();
- printf "!"; nl ();
- List.iter (fun process ->
- printf "! %s" (process_sans_color_to_string process); nl ())
- (CF.vanishing_flavors 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
- and cfactors = CF.color_factors amplitudes in
- printf "module %s" !module_name; nl (); nl ();
- List.iter (fun s -> printf " use %s" s; nl ())
- (["kinds"; Fermions.use_module] @
- !use_modules); nl ();
- if ((String.length !parameter_module) > 0) then
- printf " use %s" !parameter_module; nl (); nl ();
- printf " implicit none"; nl ();
- printf " private"; nl (); nl ();
- begin match !md5sum with
- | Some _ -> print_public ["md5sum"]
- | None -> ()
- end;
- 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"; "color_factor"; "color_factors"];
- if !whizard then
- print_public ["init"; "final"; "update_alpha_s"];
- print_public ["reset_helicity_selection"]; nl ();
- 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. *)
- print_real_parameter "n_c" 3; (* $N_C$ *)
- (* [print_real_parameter "one" 1;] provided by \texttt{constants} *)
- print_real_parameter "zero" 1; (* $0$ *)
- 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 cfactors;
- print_amplitude_table amplitudes;
- print_helicity_selection_table ();
- printf "contains"; nl (); nl ();
- print_md5sum_functions ();
- print_maintenance_functions amplitudes;
- print_numeric_inquiry_functions ();
- List.iter print_inquiry_functions
- ["spin_states"; "flavor_states"];
- print_color_flows ();
- print_color_factors ();
- 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
-
-(* \begin{dubious}
- JR's coupling constant HACK, necessitated by tho's bad design descition.
- \end{dubious} *)
-
- let fastener s i =
- try
- let offset = (String.index s '(') in
- if ((String.get s (String.length s - 1)) != ')') then
- failwith "fastener: wrong usage of parentheses"
- else
- let func_name = (String.sub s 0 offset) and
- tail =
- (String.sub s (succ offset) (String.length s - offset - 2)) in
- if (String.contains func_name ')') or
- (String.contains tail '(') or
- (String.contains tail ')') then
- failwith "fastener: wrong usage of parentheses"
- else
- func_name ^ "(" ^ string_of_int i ^ "," ^ tail ^ ")"
- with
- | Not_found ->
- if (String.contains s ')') then
- failwith "fastener: wrong usage of parentheses"
- else
- s ^ "(" ^ string_of_int i ^ ")"
-
- 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
- let c1 = fastener c 1 and
- c2 = fastener c 2 in
- match fusion with
- | F13 | F31 -> printf "%s_ff(%s,%s,%s,%s)" f c1 c2 wf1 wf2
- | F23 | F21 -> printf "f_%sf(%s,%s,%s,%s)" f c1 c2 wf1 wf2
- | F32 | F12 -> printf "f_%sf(%s,%s,%s,%s)" f c1 c2 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
- let c1 = fastener c 1 and
- c2 = fastener c 2 in
- match fusion with
- | F13 -> printf "%s_ff(%s,%s,%s,%s)" f c1 c2 wf1 wf2
- | F31 -> printf "%s_ff(-(%s),%s,%s,%s)" f c1 c2 wf1 wf2
- | F23 -> printf "f_%sf(%s,%s,%s,%s)" f c1 c2 wf1 wf2
- | F32 -> printf "f_%sf(%s,%s,%s,%s)" f c1 c2 wf2 wf1
- | F12 -> printf "f_%sf(-(%s),%s,%s,%s)" f c1 c2 wf2 wf1
- | F21 -> printf "f_%sf(-(%s),%s,%s,%s)" f c1 c2 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
- let c1 = fastener c 1 and
- c2 = fastener c 2 in
- match fusion with
- | F13 -> printf "%s_ff(%s,%s,%s,%s)" f c1 c2 wf1 wf2
- | F31 -> printf "%s_ff(-(%s),-(%s),%s,%s)" f c2 c1 wf1 wf2
- | F23 -> printf "f_%sf(%s,%s,%s,%s)" f c1 c2 wf1 wf2
- | F32 -> printf "f_%sf(%s,%s,%s,%s)" f c1 c2 wf2 wf1
- | F12 -> printf "f_%sf(-(%s),-(%s),%s,%s)" f c2 c1 wf2 wf1
- | F21 -> printf "f_%sf(-(%s),-(%s),%s,%s)" f c2 c1 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 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 coeff c in
- let c1 = fastener c 1 and
- c2 = fastener c 2 in
- match fusion with
- | F13 -> printf "%s_ff(%s,%s,%s,%s,%s)" f c1 c2 wf1 wf2 p12
- | F31 -> printf "%s_ff(%s,%s,%s,%s,%s)" f c1 c2 wf1 wf2 p12
- | F23 -> printf "f_%sf(%s,%s,%s,%s,%s)" f c1 c2 wf1 wf2 p1
- | F32 -> printf "f_%sf(%s,%s,%s,%s,%s)" f c1 c2 wf2 wf1 p2
- | F12 -> printf "f_%sf(%s,%s,%s,%s,%s)" f c1 c2 wf2 wf1 p2
- | F21 -> printf "f_%sf(%s,%s,%s,%s,%s)" f c1 c2 wf1 wf2 p1
-
- let print_fermion_current_mom_sign coeff f c wf1 wf2 p1 p2 p12 fusion =
- let c = format_coupling_mom coeff c in
- let c1 = fastener c 1 and
- c2 = fastener c 2 in
- match fusion with
- | F13 -> printf "%s_ff(%s,%s,%s,%s,%s)" f c1 c2 wf1 wf2 p12
- | F31 -> printf "%s_ff(%s,%s,%s,%s,-(%s))" f c1 c2 wf1 wf2 p12
- | F23 -> printf "f_%sf(%s,%s,%s,%s,%s)" f c1 c2 wf1 wf2 p1
- | F32 -> printf "f_%sf(%s,%s,%s,%s,%s)" f c1 c2 wf2 wf1 p2
- | F12 -> printf "f_%sf(%s,%s,%s,%s,-(%s))" f c1 c2 wf2 wf1 p2
- | F21 -> printf "f_%sf(%s,%s,%s,%s,-(%s))" f c1 c2 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 coeff c and
- cf = commute_proj f in
- let c1 = fastener c 1 and
- c2 = fastener c 2 in
- match fusion with
- | F13 -> printf "%s_ff(%s,%s,%s,%s,%s)" f c1 c2 wf1 wf2 p12
- | F31 -> printf "%s_ff(%s,%s,%s, %s,-(%s))" cf c1 c2 wf1 wf2 p12
- | F23 -> printf "f_%sf(%s,%s,%s,%s,%s)" f c1 c2 wf1 wf2 p1
- | F32 -> printf "f_%sf(%s,%s,%s,%s,%s)" f c1 c2 wf2 wf1 p2
- | F12 -> printf "f_%sf(%s,%s,%s,%s,-(%s))" cf c1 c2 wf2 wf1 p2
- | F21 -> printf "f_%sf(%s,%s,%s,%s,-(%s))" cf c1 c2 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_2_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(1),%s(2),%s,%s,%s)" f c c wf1 wf2 p12
- | F31 -> printf "%s_fgr(%s(1),%s(2),%s,%s,%s)" f c c wf1 wf2 p12
- | F23 -> printf "gr_%sf(%s(1),%s(2),%s,%s,%s)" f c c wf1 wf2 p1
- | F32 -> printf "gr_%sf(%s(1),%s(2),%s,%s,%s)" f c c wf2 wf1 p2
- | F12 -> printf "f_%sgr(%s(1),%s(2),%s,%s,%s)" f c c wf2 wf1 p2
- | F21 -> printf "f_%sgr(%s(1),%s(2),%s,%s,%s)" f c 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_2_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(1),%s(2),%s,%s,%s)" f c c wf1 wf2 p12
- | F31 -> printf "%s_grf(%s(1),%s(2),%s,%s,%s)" f c c wf1 wf2 p12
- | F23 -> printf "f_%sgr(%s(1),%s(2),%s,%s,%s)" f c c wf1 wf2 p1
- | F32 -> printf "f_%sgr(%s(1),%s(2),%s,%s,%s)" f c c wf2 wf1 p2
- | F12 -> printf "gr_%sf(%s(1),%s(2),%s,%s,%s)" f c c wf2 wf1 p2
- | F21 -> printf "gr_%sf(%s(1),%s(2),%s,%s,%s)" f c 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, SL, _ -> print_fermion_g_current coeff "sl"
- | coeff, Gravbar, SR, _ -> print_fermion_g_current coeff "sr"
- | coeff, Gravbar, SLR, _ -> print_fermion_g_2_current coeff "slr"
- | coeff, Gravbar, P, _ -> print_fermion_g_current coeff "p"
- | coeff, Gravbar, V, _ -> print_fermion_g_current coeff "v"
- | coeff, Gravbar, VLR, _ -> print_fermion_g_2_current coeff "vlr"
- | coeff, Gravbar, POT, _ -> print_fermion_g_current_vector coeff "pot"
- | coeff, _, S, Grav -> print_fermion_g_current_rev coeff "s"
- | coeff, _, SL, Grav -> print_fermion_g_current_rev coeff "sl"
- | coeff, _, SR, Grav -> print_fermion_g_current_rev coeff "sr"
- | coeff, _, SLR, Grav -> print_fermion_g_2_current_rev coeff "slr"
- | coeff, _, P, Grav -> print_fermion_g_current_rev (-coeff) "p"
- | coeff, _, V, Grav -> print_fermion_g_current_rev coeff "v"
- | coeff, _, VLR, Grav -> print_fermion_g_2_current_rev coeff "vlr"
- | 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"|"slrv") -> "1"
- | 1, _ -> ""
- | 2, ("sv"|"pv"|"svl"|"svr"|"slrv") -> "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
- let c1 = fastener c 1 and
- c2 = fastener c 2 in
- match fusion with
- | (F123|F213|F132|F231|F312|F321) ->
- printf "f_svlrf(-(%s),-(%s),%s,%s,%s)" c2 c1 f1 f2 f3
- | (F423|F243|F432|F234|F342|F324) ->
- printf "f_svlrf(%s,%s,%s,%s,%s)" c1 c2 f1 f2 f3
- | (F134|F143|F314) ->
- printf "svlr2_ff(%s,%s,%s,%s,%s)" c1 c2 f1 f2 f3
- | (F124|F142|F214) ->
- printf "svlr1_ff(%s,%s,%s,%s,%s)" c1 c2 f1 f2 f3
- | (F413|F431|F341) ->
- printf "svlr2_ff(-(%s),-(%s),%s,%s,%s)" c2 c1 f1 f2 f3
- | (F241|F412|F421) ->
- printf "svlr1_ff(-(%s),-(%s),%s,%s,%s)" c2 c1 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
- let c1 = fastener c 1 and
- c2 = fastener c 2 in
- match fusion with
- | (F123|F213|F132|F231|F312|F321) ->
- printf "%s * f_%sf(%s,-(%s),%s,%s)" f1 f c1 c2 f2 f3
- | (F423|F243|F432|F234|F342|F324) ->
- printf "%s * f_%sf(%s,%s,%s,%s)" f1 f c1 c2 f2 f3
- | (F134|F143|F314) ->
- printf "%s * %s_ff(%s,%s,%s,%s)" f2 f c1 c2 f1 f3
- | (F124|F142|F214) ->
- printf "%s * %s_ff(%s,%s,%s,%s)" f2 f c1 c2 f1 f3
- | (F413|F431|F341) ->
- printf "%s * %s_ff(%s,-(%s),%s,%s)" f2 f c1 c2 f1 f3
- | (F241|F412|F421) ->
- printf "%s * %s_ff(%s,-(%s),%s,%s)" f2 f c1 c2 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
- let c1 = fastener c 1 and
- c2 = fastener c 2 in
- match fusion with
- | (F123|F213|F132|F231|F312|F321) ->
- printf "%s * f_%sf(%s,%s,%s,%s)" f1 f c2 c1 f2 f3
- | (F423|F243|F432|F234|F342|F324) ->
- printf "%s * f_%sf(%s,%s,%s,%s)" f1 f c1 c2 f2 f3
- | (F134|F143|F314) ->
- printf "%s * %s_ff(%s,%s,%s,%s)" f2 f c1 c2 f1 f3
- | (F124|F142|F214) ->
- printf "%s * %s_ff(%s,%s,%s,%s)" f2 f c1 c2 f1 f3
- | (F413|F431|F341) ->
- printf "%s * %s_ff(%s,%s,%s,%s)" f2 f c2 c1 f1 f3
- | (F241|F412|F421) ->
- printf "%s * %s_ff(%s,%s,%s,%s)" f2 f c2 c1 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_2_g4_current coeff f c wf1 wf2 wf3 fusion =
- let 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
- let c = format_coupling_2 coeff c in
- let c1 = fastener c 1 and
- c2 = fastener c 2 in
- match fusion with
- | (F123|F213|F132|F231|F312|F321) ->
- printf "f_%sgr(-(%s),-(%s),%s,%s,%s)" f c2 c1 f1 f2 f3
- | (F423|F243|F432|F234|F342|F324) ->
- printf "gr_%sf(%s,%s,%s,%s,%s)" f c1 c2 f1 f2 f3
- | (F134|F143|F314|F124|F142|F214) ->
- printf "%s_grf(%s,%s,%s,%s,%s)" f c1 c2 f1 f2 f3
- | (F413|F431|F341|F241|F412|F421) ->
- printf "%s_fgr(-(%s),-(%s),%s,%s,%s)" f c2 c1 f1 f2 f3
-
- let print_fermion_2_g4_current coeff f c wf1 wf2 wf3 fusion =
- let 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
- let c = format_coupling_2 coeff c in
- let c1 = fastener c 1 and
- c2 = fastener c 2 in
- match fusion with
- | (F123|F213|F132|F231|F312|F321) ->
- printf "f_%sgr(-(%s),-(%s),%s,%s,%s)" f c2 c1 f1 f2 f3
- | (F423|F243|F432|F234|F342|F324) ->
- printf "gr_%sf(%s,%s,%s,%s,%s)" f c1 c2 f1 f2 f3
- | (F134|F143|F314|F124|F142|F214) ->
- printf "%s_grf(%s,%s,%s,%s,%s)" f c1 c2 f1 f2 f3
- | (F413|F431|F341|F241|F412|F421) ->
- printf "%s_fgr(-(%s),-(%s),%s,%s,%s)" f c2 c1 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 "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
-
-(* 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_2_g4_vector_current coeff f c wf1 wf2 wf3 fusion =
- let 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
- let c = format_coupling_2 coeff c in
- let c1 = fastener c 1 and
- c2 = fastener c 2 in
- match fusion with
- | (F123|F213|F132|F231|F312|F321) ->
- printf "f_%sgr(%s,%s,%s,%s,%s)" f c1 c2 f1 f2 f3
- | (F423|F243|F432|F234|F342|F324) ->
- printf "gr_%sf(%s,%s,%s,%s,%s)" f c1 c2 f1 f2 f3
- | (F134|F143|F314) -> printf "%s%s_grf(%s,%s,%s,%s,%s)" f d1 c1 c2 f1 f2 f3
- | (F124|F142|F214) -> printf "%s%s_grf(%s,%s,%s,%s,%s)" f d2 c1 c2 f1 f2 f3
- | (F413|F431|F341) -> printf "%s%s_fgr(%s,%s,%s,%s,%s)" f d1 c1 c2 f1 f2 f3
- | (F241|F412|F421) -> printf "%s%s_fgr(%s,%s,%s,%s,%s)" f d2 c1 c2 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_fermion_2_g4_current_rev coeff f c wf1 wf2 wf3 fusion =
- let c = format_coupling_2 coeff c in
- let c1 = fastener c 1 and
- c2 = fastener c 2 and
- d1 = d_p (1,f) and
- d2 = d_p (2,f) in
- let 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,%s)" f c1 c2 f1 f2 f3
- | (F423|F243|F432|F234|F342|F324) ->
- printf "f_%sgr(-(%s),-(%s),%s,%s,%s)" f c1 c2 f1 f2 f3
- | (F134|F143|F314) ->
- printf "%s%s_fgr(-(%s),-(%s),%s,%s,%s)" f d1 c1 c2 f1 f2 f3
- | (F124|F142|F214) ->
- printf "%s%s_fgr(-(%s),-(%s),%s,%s,%s)" f d2 c1 c2 f1 f2 f3
- | (F413|F431|F341) ->
- printf "%s%s_grf(%s,%s,%s,%s,%s)" f d1 c1 c2 f1 f2 f3
- | (F241|F412|F421) ->
- printf "%s%s_grf(%s,%s,%s,%s,%s)" f d2 c1 c2 f1 f2 f3
-
- let print_fermion_2_g4_vector_current_rev coeff f c wf1 wf2 wf3 fusion =
- (* Here we put in the extra minus sign from the coeff. *)
- let c = format_coupling coeff c in
- let c1 = fastener c 1 and
- c2 = fastener c 2 in
- let 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,%s)" f c1 c2 f1 f2 f3
- | (F423|F243|F432|F234|F342|F324) ->
- printf "f_%sgr(%s,%s,%s,%s,%s)" f c1 c2 f1 f2 f3
- | (F134|F143|F314) -> printf "%s%s_fgr(%s,%s,%s,%s,%s)" f d1 c1 c2 f1 f2 f3
- | (F124|F142|F214) -> printf "%s%s_fgr(%s,%s,%s,%s,%s)" f d2 c1 c2 f1 f2 f3
- | (F413|F431|F341) -> printf "%s%s_grf(%s,%s,%s,%s,%s)" f d1 c1 c2 f1 f2 f3
- | (F241|F412|F421) -> printf "%s%s_grf(%s,%s,%s,%s,%s)" f d2 c1 c2 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, SLV, _ -> print_fermion_g4_vector_current coeff "slv"
- | coeff, Gravbar, SRV, _ -> print_fermion_g4_vector_current coeff "srv"
- | coeff, Gravbar, SLRV, _ -> print_fermion_2_g4_vector_current coeff "slrv"
- | coeff, Gravbar, PV, _ -> print_fermion_g4_vector_current coeff "pv"
- | coeff, Gravbar, V2, _ -> print_fermion_g4_current coeff "v2"
- | coeff, Gravbar, V2LR, _ -> print_fermion_2_g4_current coeff "v2lr"
- | 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, _, SLV, Grav -> print_fermion_g4_vector_current_rev (-coeff) "slv"
- | coeff, _, SRV, Grav -> print_fermion_g4_vector_current_rev (-coeff) "srv"
- | coeff, _, SLRV, Grav -> print_fermion_2_g4_vector_current_rev coeff "slrv"
- | coeff, _, PV, Grav -> print_fermion_g4_vector_current_rev coeff "pv"
- | coeff, _, V2, Grav -> print_fermion_g4_vector_current_rev coeff "v2"
- | coeff, _, V2LR, Grav -> print_fermion_2_g4_current_rev coeff "v2lr"
- | 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"
- | coeff, _, V2LR, _ -> invalid_arg "Targets.print_current: not available"
-
- let reverse_braket _ = false
-
- let use_module = "omega95_bispinors"
- let require_library =
- ["omega_bispinors_2010_01_A"; "omega_bispinor_cpls_2010_01_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 | 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/hgg-vertex/src/topology.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/topology.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/topology.ml (revision 8717)
@@ -1,894 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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/hgg-vertex/src/color.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/color.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/color.ml (revision 8717)
@@ -1,278 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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
-
-let compare c1 c2 =
- match c1, c2 with
- | Singlet, Singlet -> 0
- | Singlet, _ -> -1
- | _, Singlet -> 1
- | SUN n, SUN n' -> compare n n'
- | SUN _, AdjSUN _ -> -1
- | AdjSUN _, SUN _ -> 1
- | AdjSUN n, AdjSUN n' -> compare n n'
-
-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
- exception Open_flow
- val power_of_nc : t -> t -> int option
- 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
-
-(* \thocwmodulesubsection{Evaluation} *)
-
-(* \begin{dubious}
- The following code is \textbf{in development} and most
- likely \textbf{not yet operational!}. Its only in the trunk,
- because it doesn't disturb the rest. Please don't read it, because
- the errors included can do damage to your brain \ldots
- \end{dubious} *)
-
- let count_ghosts1 colors =
- List.fold_left
- (fun acc -> function Ghost -> succ acc | _ -> acc)
- 0 colors
-
- let count_ghosts (fin, fout) =
- count_ghosts1 fin + count_ghosts1 fout
-
- type t2 =
- | Square of (int * int) list
- | Mismatch
-
- exception Mismatched_Amplitudes
-
- let conjugate = function
- | Lines (c1, c2) -> Lines (-c2, -c1)
- | Ghost -> Ghost
-
- let cross_in (cin, cout) =
- cin @ (List.map conjugate cout)
-
- let cross_out (cin, cout) =
- (List.map conjugate cin) @ cout
-
- let square f1 f2 =
- let rec square' next_free f1' f2' =
- match f1', f2' with
- | [], [] -> []
- | _, [] | [], _ ->
- raise Mismatched_Amplitudes
- | Ghost :: rest1, Ghost :: rest2 ->
- let c1 = next_free in
- let c2 = succ c1 in
- (c1, c2) :: (-c1, -c2) :: square' (next_free + 2) rest1 rest2
- | Lines (0, 0) :: rest1, Lines (0, 0) :: rest2 ->
- square' next_free rest1 rest2
- | Lines (0, c1') :: rest1, Lines (0, c2') :: rest2 ->
- (c1', c2') :: square' next_free rest1 rest2
- | Lines (c1, 0) :: rest1, Lines (c2, 0) :: rest2 ->
- (c1, c2) :: square' next_free rest1 rest2
- | Lines (0, _) :: _, _ | _ , Lines (0, _) :: _
- | Lines (_, 0) :: _, _ | _, Lines (_, 0) :: _ ->
- raise Mismatched_Amplitudes
- | Lines (c1, c1') :: rest1, Lines (c2, c2') :: rest2 ->
- (c1, c2) :: (c1', c2') :: square' next_free rest1 rest2
- | Lines (c1, c1') :: rest1, Ghost :: rest2 ->
- let c2 = next_free in
- (c1, c2) :: (c1', -c2) :: square' (succ next_free) rest1 rest2
- | Ghost :: rest1, Lines (c2, c2') :: rest2 ->
- let c1 = next_free in
- (c1, c2) :: (-c1, c2') :: square' (succ next_free) rest1 rest2 in
- try
- Square (square'
- (List.length (fst f1) + List.length (snd f1) + 1)
- (cross_out f1) (cross_out f2))
- with
- | Mismatched_Amplitudes -> Mismatch
-
-(* \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} *)
-
- exception Open_flow
-
- let rec find_fst c_final c1 seen = function
- | [] -> raise Open_flow
- | (c1', c2') as c12' :: rest ->
- if c1 = c1' then
- find_snd c_final (-c2') [] (List.rev_append seen rest)
- else
- find_fst c_final c1 (c12' :: seen) rest
-
- and find_snd c_final c2 seen = function
- | [] -> raise Open_flow
- | (c1', c2') as c12' :: rest->
- if c2' = c2 then begin
- if c1' = c_final then
- List.rev_append seen rest
- else
- find_fst c_final (-c1') [] (List.rev_append seen rest)
- end else
- find_snd c_final c2 (c12' :: seen) rest
-
- let consume_cycle = function
- | [] -> []
- | (c1, c2) :: rest -> find_snd (-c1) (-c2) [] rest
-
- let count_cycles colors =
- let rec count_cycles' acc = function
- | [] -> acc
- | rest -> count_cycles' (succ acc) (consume_cycle rest) in
- count_cycles' 0 colors
-
- let power_of_nc f1 f2 =
- match square f1 f2 with
- | Square f12 -> Some (count_cycles (f12) - count_ghosts f1 - count_ghosts f2)
- | Mismatch -> None
-
- let of_pair (c1, c2) = of_list [c1; c2]
-
- let of_pairs l1 l2 =
- (List.map of_pair l1, List.map of_pair l2)
-
- let f1 =
- of_pairs [( 1, 0); ( 0, -1)] [( 2, 0); ( 0, -2)]
-
- let f2 =
- of_pairs [( 2, 0); ( 0, -1)] [( 2, 0); ( 0, -1)]
-
- end
-
-(*i
-open Flow
-#trace find_fst
-#trace find_snd
-#trace consume_cycle
-let _ = count_cycles (square f1 f1)
-let _ = count_cycles (square f2 f2)
-let _ = count_cycles (square f1 f2)
-let _ = count_cycles (square f2 f1)
-i*)
-
-(* 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
- * Local Variables:
- * mode:caml
- * indent-tabs-mode:nil
- * page-delimiter:"^(\\* .*\n"
- * End:
-i*)
Index: branches/ohl/omega-development/hgg-vertex/src/omega_SM_CKM.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/omega_SM_CKM.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/omega_SM_CKM.ml (revision 8717)
@@ -1,33 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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)
- (Modellib_SM.SM(Modellib_SM.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/hgg-vertex/src/whizard.mli
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/whizard.mli (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/whizard.mli (revision 8717)
@@ -1,47 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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/hgg-vertex/src/omega_Threeshl.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/omega_Threeshl.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/omega_Threeshl.ml (revision 8717)
@@ -1,33 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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)
- (Modellib_BSM.Threeshl(Modellib_BSM.Threeshl_no_ckm))
-let _ = O.main ()
-
-(*i
- * Local Variables:
- * mode:caml
- * indent-tabs-mode:nil
- * page-delimiter:"^(\\* .*\n"
- * End:
-i*)
Index: branches/ohl/omega-development/hgg-vertex/src/thoArray.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/thoArray.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/thoArray.ml (revision 8717)
@@ -1,104 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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/hgg-vertex/src/tree2.mli
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/tree2.mli (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/tree2.mli (revision 8717)
@@ -1,38 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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. *)
-
-
-(* Dependency trees for wavefunctions. *)
-
-type 'n t
-val cons : ('n * 'n t list) list -> 'n t
-val leaf : 'n -> 'n t
-
-val to_string : ('n -> string) -> 'n t -> string
-
-(*i
- * Local Variables:
- * mode:caml
- * indent-tabs-mode:nil
- * page-delimiter:"^(\\* .*\n"
- * End:
-i*)
Index: branches/ohl/omega-development/hgg-vertex/src/modeltools.mli
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/modeltools.mli (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/modeltools.mli (revision 8717)
@@ -1,62 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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
-
-(*i
- * Local Variables:
- * mode:caml
- * indent-tabs-mode:nil
- * page-delimiter:"^(\\* .*\n"
- * End:
-i*)
Index: branches/ohl/omega-development/hgg-vertex/src/vertex_syntax.mli
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/vertex_syntax.mli (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/vertex_syntax.mli (revision 8717)
@@ -1,123 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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/hgg-vertex/src/tuple.mli
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/tuple.mli (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/tuple.mli (revision 8717)
@@ -1,207 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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/hgg-vertex/src/cascade_syntax.mli
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/cascade_syntax.mli (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/cascade_syntax.mli (revision 8717)
@@ -1,59 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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/hgg-vertex/src/Makefile.depend
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/Makefile.depend (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/Makefile.depend (revision 8717)
@@ -1,398 +0,0 @@
-# $Id$
-# no not edit: generated by ./update
-cascade.cmi: momentum.cmi model.cmi
-colorize.cmi: model.cmi
-comphep.cmi: model.cmi
-dAG.cmi: tuple.cmi tree2.cmi tree.cmi rCS.cmi
-fusion.cmi: tuple.cmi tree2.cmi tree.cmi rCS.cmi options.cmi momentum.cmi \
- model.cmi coupling.cmi color.cmi cascade.cmi
-model.cmi: rCS.cmi options.cmi coupling.cmi color.cmi
-model_file.cmi: model_syntax.cmi
-model_syntax.cmi: vertex_syntax.cmi
-modellib_BSM.cmi: model.cmi
-modellib_MSSM.cmi: model.cmi
-modellib_NMSSM.cmi: model.cmi
-modellib_PSSSM.cmi: model.cmi
-modellib_SM.cmi: model.cmi
-modeltools.cmi: model.cmi coupling.cmi
-momentum.cmi: rCS.cmi
-oVM.cmi: fusion.cmi
-omega.cmi: tree.cmi target.cmi momentum.cmi model.cmi fusion.cmi
-partition.cmi: rCS.cmi
-phasespace.cmi: momentum.cmi
-process.cmi: model.cmi
-target.cmi: rCS.cmi options.cmi momentum.cmi model.cmi fusion.cmi
-targets.cmi: target.cmi
-thoGDraw.cmi: tree.cmi color.cmi
-thoGMenu.cmi: thoGButton.cmi
-topology.cmi: tuple.cmi rCS.cmi
-trie.cmi: pmap.cmi
-tuple.cmi: rCS.cmi
-vertex.cmi: vertex_syntax.cmi
-whizard.cmi: momentum.cmi model.cmi fusion.cmi
-algebra.cmo: thoList.cmi pmap.cmi algebra.cmi
-algebra.cmx: thoList.cmx pmap.cmx algebra.cmi
-bundle.cmo: bundle.cmi
-bundle.cmx: bundle.cmi
-cache.cmo: config.cmi cache.cmi
-cache.cmx: config.cmi cache.cmi
-cascade.cmo: thoList.cmi momentum.cmi model.cmi combinatorics.cmi \
- cascade_syntax.cmi cascade.cmi
-cascade.cmx: thoList.cmx momentum.cmx model.cmi combinatorics.cmx \
- cascade_syntax.cmx cascade.cmi
-cascade_syntax.cmo: cascade_syntax.cmi
-cascade_syntax.cmx: cascade_syntax.cmi
-color.cmo: color.cmi
-color.cmx: color.cmi
-colorize.cmo: thoList.cmi rCS.cmi modeltools.cmi model.cmi coupling.cmi \
- combinatorics.cmi color.cmi colorize.cmi
-colorize.cmx: thoList.cmx rCS.cmx modeltools.cmx model.cmi coupling.cmi \
- combinatorics.cmx color.cmx colorize.cmi
-combinatorics.cmo: thoList.cmi product.cmi combinatorics.cmi
-combinatorics.cmx: thoList.cmx product.cmx combinatorics.cmi
-comphep.cmo: thoList.cmi rCS.cmi options.cmi modeltools.cmi coupling.cmi \
- comphep_syntax.cmi color.cmi comphep.cmi
-comphep.cmx: thoList.cmx rCS.cmx options.cmx modeltools.cmx coupling.cmi \
- comphep_syntax.cmx color.cmx comphep.cmi
-comphep_syntax.cmo: comphep_syntax.cmi
-comphep_syntax.cmx: comphep_syntax.cmi
-complex.cmo: complex.cmi
-complex.cmx: complex.cmi
-count.cmo: topology.cmi thoList.cmi combinatorics.cmi
-count.cmx: topology.cmx thoList.cmx combinatorics.cmx
-dAG.cmo: tuple.cmi tree2.cmi tree.cmi rCS.cmi product.cmi dAG.cmi
-dAG.cmx: tuple.cmx tree2.cmx tree.cmx rCS.cmx product.cmx dAG.cmi
-fusion.cmo: tuple.cmi tree2.cmi tree.cmi topology.cmi thoList.cmi rCS.cmi \
- progress.cmi product.cmi process.cmi options.cmi momentum.cmi model.cmi \
- dAG.cmi coupling.cmi config.cmi combinatorics.cmi color.cmi cascade.cmi \
- cache.cmi fusion.cmi
-fusion.cmx: tuple.cmx tree2.cmx tree.cmx topology.cmx thoList.cmx rCS.cmx \
- progress.cmx product.cmx process.cmx options.cmx momentum.cmx model.cmi \
- dAG.cmx coupling.cmi config.cmi combinatorics.cmx color.cmx cascade.cmx \
- cache.cmx fusion.cmi
-linalg.cmo: linalg.cmi
-linalg.cmx: linalg.cmi
-model_file.cmo: vertex.cmi model_syntax.cmi coupling.cmi model_file.cmi
-model_file.cmx: vertex.cmx model_syntax.cmx coupling.cmi model_file.cmi
-model_syntax.cmo: vertex_syntax.cmi vertex.cmi model_syntax.cmi
-model_syntax.cmx: vertex_syntax.cmx vertex.cmx model_syntax.cmi
-modellib_BSM.cmo: thoList.cmi rCS.cmi options.cmi modeltools.cmi coupling.cmi \
- color.cmi modellib_BSM.cmi
-modellib_BSM.cmx: thoList.cmx rCS.cmx options.cmx modeltools.cmx coupling.cmi \
- color.cmx modellib_BSM.cmi
-modellib_MSSM.cmo: thoList.cmi rCS.cmi product.cmi options.cmi modeltools.cmi \
- coupling.cmi color.cmi modellib_MSSM.cmi
-modellib_MSSM.cmx: thoList.cmx rCS.cmx product.cmx options.cmx modeltools.cmx \
- coupling.cmi color.cmx modellib_MSSM.cmi
-modellib_NMSSM.cmo: thoList.cmi rCS.cmi product.cmi options.cmi \
- modeltools.cmi coupling.cmi combinatorics.cmi color.cmi \
- modellib_NMSSM.cmi
-modellib_NMSSM.cmx: thoList.cmx rCS.cmx product.cmx options.cmx \
- modeltools.cmx coupling.cmi combinatorics.cmx color.cmx \
- modellib_NMSSM.cmi
-modellib_PSSSM.cmo: thoList.cmi rCS.cmi product.cmi options.cmi \
- modeltools.cmi coupling.cmi combinatorics.cmi color.cmi \
- modellib_PSSSM.cmi
-modellib_PSSSM.cmx: thoList.cmx rCS.cmx product.cmx options.cmx \
- modeltools.cmx coupling.cmi combinatorics.cmx color.cmx \
- modellib_PSSSM.cmi
-modellib_SM.cmo: thoList.cmi rCS.cmi product.cmi options.cmi modeltools.cmi \
- model.cmi coupling.cmi color.cmi modellib_SM.cmi
-modellib_SM.cmx: thoList.cmx rCS.cmx product.cmx options.cmx modeltools.cmx \
- model.cmi coupling.cmi color.cmx modellib_SM.cmi
-modeltools.cmo: thoList.cmi rCS.cmi options.cmi coupling.cmi modeltools.cmi
-modeltools.cmx: thoList.cmx rCS.cmx options.cmx coupling.cmi modeltools.cmi
-momentum.cmo: thoList.cmi rCS.cmi momentum.cmi
-momentum.cmx: thoList.cmx rCS.cmx momentum.cmi
-oVM.cmo: rCS.cmi fusion.cmi complex.cmi oVM.cmi
-oVM.cmx: rCS.cmx fusion.cmx complex.cmx oVM.cmi
-ogiga.cmo: thoList.cmi thoGWindow.cmi thoGMenu.cmi thoGDraw.cmi \
- thoGButton.cmi targets.cmi rCS.cmi omega.cmi momentum.cmi model.cmi \
- fusion.cmi coupling.cmi color.cmi
-ogiga.cmx: thoList.cmx thoGWindow.cmx thoGMenu.cmx thoGDraw.cmx \
- thoGButton.cmx targets.cmx rCS.cmx omega.cmx momentum.cmx model.cmi \
- fusion.cmx coupling.cmi color.cmx
-omega.cmo: whizard.cmi tree.cmi thoString.cmi thoList.cmi target.cmi rCS.cmi \
- process.cmi options.cmi momentum.cmi model.cmi fusion.cmi config.cmi \
- colorize.cmi cascade.cmi omega.cmi
-omega.cmx: whizard.cmx tree.cmx thoString.cmx thoList.cmx target.cmi rCS.cmx \
- process.cmx options.cmx momentum.cmx model.cmi fusion.cmx config.cmi \
- colorize.cmx cascade.cmx omega.cmi
-omega_2HDM.cmo: thoList.cmi targets.cmi rCS.cmi options.cmi omega.cmi \
- modeltools.cmi model.cmi fusion.cmi coupling.cmi color.cmi
-omega_2HDM.cmx: thoList.cmx targets.cmx rCS.cmx options.cmx omega.cmx \
- modeltools.cmx model.cmi fusion.cmx coupling.cmi color.cmx
-omega_CQED.cmo: thoList.cmi targets.cmi rCS.cmi options.cmi omega.cmi \
- modeltools.cmi model.cmi fusion.cmi coupling.cmi color.cmi
-omega_CQED.cmx: thoList.cmx targets.cmx rCS.cmx options.cmx omega.cmx \
- modeltools.cmx model.cmi fusion.cmx coupling.cmi color.cmx
-omega_Comphep.cmo: targets.cmi omega.cmi fusion.cmi comphep.cmi
-omega_Comphep.cmx: targets.cmx omega.cmx fusion.cmx comphep.cmx
-omega_GravTest.cmo: targets.cmi omega.cmi modellib_BSM.cmi fusion.cmi
-omega_GravTest.cmx: targets.cmx omega.cmx modellib_BSM.cmx fusion.cmx
-omega_Littlest.cmo: targets.cmi omega.cmi modellib_BSM.cmi fusion.cmi
-omega_Littlest.cmx: targets.cmx omega.cmx modellib_BSM.cmx fusion.cmx
-omega_Littlest_Eta.cmo: targets.cmi omega.cmi modellib_BSM.cmi fusion.cmi
-omega_Littlest_Eta.cmx: targets.cmx omega.cmx modellib_BSM.cmx fusion.cmx
-omega_Littlest_Tpar.cmo: targets.cmi omega.cmi modellib_BSM.cmi fusion.cmi
-omega_Littlest_Tpar.cmx: targets.cmx omega.cmx modellib_BSM.cmx fusion.cmx
-omega_Littlest_Zprime.cmo: thoList.cmi targets.cmi rCS.cmi options.cmi \
- omega.cmi modeltools.cmi fusion.cmi coupling.cmi color.cmi
-omega_Littlest_Zprime.cmx: thoList.cmx targets.cmx rCS.cmx options.cmx \
- omega.cmx modeltools.cmx fusion.cmx coupling.cmi color.cmx
-omega_MSSM.cmo: targets.cmi omega.cmi modellib_MSSM.cmi fusion.cmi
-omega_MSSM.cmx: targets.cmx omega.cmx modellib_MSSM.cmx fusion.cmx
-omega_MSSM_CKM.cmo: targets.cmi omega.cmi modellib_MSSM.cmi fusion.cmi
-omega_MSSM_CKM.cmx: targets.cmx omega.cmx modellib_MSSM.cmx fusion.cmx
-omega_MSSM_Grav.cmo: targets.cmi omega.cmi modellib_MSSM.cmi fusion.cmi
-omega_MSSM_Grav.cmx: targets.cmx omega.cmx modellib_MSSM.cmx fusion.cmx
-omega_NMSSM.cmo: targets.cmi omega.cmi modellib_NMSSM.cmi fusion.cmi
-omega_NMSSM.cmx: targets.cmx omega.cmx modellib_NMSSM.cmx fusion.cmx
-omega_NMSSM_CKM.cmo: targets.cmi omega.cmi modellib_NMSSM.cmi fusion.cmi
-omega_NMSSM_CKM.cmx: targets.cmx omega.cmx modellib_NMSSM.cmx fusion.cmx
-omega_PSSSM.cmo: targets.cmi omega.cmi modellib_PSSSM.cmi fusion.cmi
-omega_PSSSM.cmx: targets.cmx omega.cmx modellib_PSSSM.cmx fusion.cmx
-omega_Phi3.cmo: targets.cmi omega.cmi modellib_SM.cmi fusion.cmi
-omega_Phi3.cmx: targets.cmx omega.cmx modellib_SM.cmx fusion.cmx
-omega_Phi3h.cmo: targets.cmi omega.cmi modellib_SM.cmi fusion.cmi
-omega_Phi3h.cmx: targets.cmx omega.cmx modellib_SM.cmx fusion.cmx
-omega_Phi4.cmo: targets.cmi omega.cmi modellib_SM.cmi fusion.cmi
-omega_Phi4.cmx: targets.cmx omega.cmx modellib_SM.cmx fusion.cmx
-omega_Phi4h.cmo: targets.cmi omega.cmi modellib_SM.cmi fusion.cmi
-omega_Phi4h.cmx: targets.cmx omega.cmx modellib_SM.cmx fusion.cmx
-omega_QCD.cmo: thoList.cmi targets.cmi rCS.cmi options.cmi omega.cmi \
- modeltools.cmi model.cmi fusion.cmi coupling.cmi color.cmi
-omega_QCD.cmx: thoList.cmx targets.cmx rCS.cmx options.cmx omega.cmx \
- modeltools.cmx model.cmi fusion.cmx coupling.cmi color.cmx
-omega_QED.cmo: targets.cmi omega.cmi modellib_SM.cmi fusion.cmi
-omega_QED.cmx: targets.cmx omega.cmx modellib_SM.cmx fusion.cmx
-omega_SM.cmo: targets.cmi omega.cmi modellib_SM.cmi fusion.cmi
-omega_SM.cmx: targets.cmx omega.cmx modellib_SM.cmx fusion.cmx
-omega_SM3.cmo: targets.cmi omega.cmi modellib_SM.cmi fusion.cmi
-omega_SM3.cmx: targets.cmx omega.cmx modellib_SM.cmx fusion.cmx
-omega_SM3_ac.cmo: targets.cmi omega.cmi modellib_SM.cmi fusion.cmi
-omega_SM3_ac.cmx: targets.cmx omega.cmx modellib_SM.cmx fusion.cmx
-omega_SM3_clones.cmo: targets.cmi omega.cmi modellib_SM.cmi fusion.cmi
-omega_SM3_clones.cmx: targets.cmx omega.cmx modellib_SM.cmx fusion.cmx
-omega_SM3h.cmo: targets.cmi omega.cmi modellib_SM.cmi fusion.cmi
-omega_SM3h.cmx: targets.cmx omega.cmx modellib_SM.cmx fusion.cmx
-omega_SM_CKM.cmo: targets.cmi omega.cmi modellib_SM.cmi fusion.cmi
-omega_SM_CKM.cmx: targets.cmx omega.cmx modellib_SM.cmx fusion.cmx
-omega_SM_Hgg.cmo: targets.cmi omega.cmi modellib_SM.cmi fusion.cmi
-omega_SM_Hgg.cmx: targets.cmx omega.cmx modellib_SM.cmx fusion.cmx
-omega_SM_Maj.cmo: targets.cmi omega.cmi modellib_SM.cmi fusion.cmi
-omega_SM_Maj.cmx: targets.cmx omega.cmx modellib_SM.cmx fusion.cmx
-omega_SM_Maj3.cmo: targets.cmi omega.cmi modellib_SM.cmi fusion.cmi
-omega_SM_Maj3.cmx: targets.cmx omega.cmx modellib_SM.cmx fusion.cmx
-omega_SM_Rxi.cmo: targets.cmi omega.cmi modellib_SM.cmi fusion.cmi
-omega_SM_Rxi.cmx: targets.cmx omega.cmx modellib_SM.cmx fusion.cmx
-omega_SM_ac.cmo: targets.cmi omega.cmi modellib_SM.cmi fusion.cmi
-omega_SM_ac.cmx: targets.cmx omega.cmx modellib_SM.cmx fusion.cmx
-omega_SM_ac_CKM.cmo: targets.cmi omega.cmi modellib_SM.cmi fusion.cmi
-omega_SM_ac_CKM.cmx: targets.cmx omega.cmx modellib_SM.cmx fusion.cmx
-omega_SM_clones.cmo: targets.cmi omega.cmi modellib_SM.cmi fusion.cmi
-omega_SM_clones.cmx: targets.cmx omega.cmx modellib_SM.cmx fusion.cmx
-omega_SM_km.cmo: targets.cmi omega.cmi modellib_SM.cmi fusion.cmi
-omega_SM_km.cmx: targets.cmx omega.cmx modellib_SM.cmx fusion.cmx
-omega_SM_top.cmo: thoList.cmi targets.cmi rCS.cmi options.cmi omega.cmi \
- modeltools.cmi fusion.cmi coupling.cmi color.cmi
-omega_SM_top.cmx: thoList.cmx targets.cmx rCS.cmx options.cmx omega.cmx \
- modeltools.cmx fusion.cmx coupling.cmi color.cmx
-omega_SMh.cmo: targets.cmi omega.cmi modellib_SM.cmi fusion.cmi
-omega_SMh.cmx: targets.cmx omega.cmx modellib_SM.cmx fusion.cmx
-omega_Simplest.cmo: targets.cmi omega.cmi modellib_BSM.cmi fusion.cmi
-omega_Simplest.cmx: targets.cmx omega.cmx modellib_BSM.cmx fusion.cmx
-omega_Simplest_univ.cmo: targets.cmi omega.cmi modellib_BSM.cmi fusion.cmi
-omega_Simplest_univ.cmx: targets.cmx omega.cmx modellib_BSM.cmx fusion.cmx
-omega_Template.cmo: targets.cmi omega.cmi modellib_BSM.cmi fusion.cmi
-omega_Template.cmx: targets.cmx omega.cmx modellib_BSM.cmx fusion.cmx
-omega_Threeshl.cmo: targets.cmi omega.cmi modellib_BSM.cmi fusion.cmi
-omega_Threeshl.cmx: targets.cmx omega.cmx modellib_BSM.cmx fusion.cmx
-omega_Threeshl_nohf.cmo: targets.cmi omega.cmi modellib_BSM.cmi fusion.cmi
-omega_Threeshl_nohf.cmx: targets.cmx omega.cmx modellib_BSM.cmx fusion.cmx
-omega_UED.cmo: targets.cmi omega.cmi modellib_BSM.cmi fusion.cmi
-omega_UED.cmx: targets.cmx omega.cmx modellib_BSM.cmx fusion.cmx
-omega_Xdim.cmo: targets.cmi omega.cmi modellib_BSM.cmi fusion.cmi
-omega_Xdim.cmx: targets.cmx omega.cmx modellib_BSM.cmx fusion.cmx
-omega_Zprime.cmo: thoList.cmi targets.cmi rCS.cmi options.cmi omega.cmi \
- modeltools.cmi fusion.cmi coupling.cmi color.cmi
-omega_Zprime.cmx: thoList.cmx targets.cmx rCS.cmx options.cmx omega.cmx \
- modeltools.cmx fusion.cmx coupling.cmi color.cmx
-options.cmo: options.cmi
-options.cmx: options.cmi
-ovm_SM.cmo: targets.cmi omega.cmi modellib_SM.cmi fusion.cmi
-ovm_SM.cmx: targets.cmx omega.cmx modellib_SM.cmx fusion.cmx
-partition.cmo: rCS.cmi partition.cmi
-partition.cmx: rCS.cmx partition.cmi
-phasespace.cmo: momentum.cmi phasespace.cmi
-phasespace.cmx: momentum.cmx phasespace.cmi
-pmap.cmo: pmap.cmi
-pmap.cmx: pmap.cmi
-process.cmo: thoList.cmi product.cmi model.cmi color.cmi bundle.cmi \
- process.cmi
-process.cmx: thoList.cmx product.cmx model.cmi color.cmx bundle.cmx \
- process.cmi
-product.cmo: thoList.cmi product.cmi
-product.cmx: thoList.cmx product.cmi
-progress.cmo: progress.cmi
-progress.cmx: progress.cmi
-rCS.cmo: thoString.cmi rCS.cmi
-rCS.cmx: thoString.cmx rCS.cmi
-targets.cmo: tree2.cmi thoList.cmi targets_Kmatrix.cmi rCS.cmi options.cmi \
- momentum.cmi model.cmi fusion.cmi coupling.cmi color.cmi targets.cmi
-targets.cmx: tree2.cmx thoList.cmx targets_Kmatrix.cmx rCS.cmx options.cmx \
- momentum.cmx model.cmi fusion.cmx coupling.cmi color.cmx targets.cmi
-targets_Kmatrix.cmo: rCS.cmi targets_Kmatrix.cmi
-targets_Kmatrix.cmx: rCS.cmx targets_Kmatrix.cmi
-test_linalg.cmo: linalg.cmi
-test_linalg.cmx: linalg.cmx
-thoArray.cmo: pmap.cmi thoArray.cmi
-thoArray.cmx: pmap.cmx thoArray.cmi
-thoGButton.cmo: thoGButton.cmi
-thoGButton.cmx: thoGButton.cmi
-thoGDraw.cmo: tree.cmi thoGWindow.cmi color.cmi thoGDraw.cmi
-thoGDraw.cmx: tree.cmx thoGWindow.cmx color.cmx thoGDraw.cmi
-thoGMenu.cmo: thoGButton.cmi thoGMenu.cmi
-thoGMenu.cmx: thoGButton.cmx thoGMenu.cmi
-thoGWindow.cmo: thoGWindow.cmi
-thoGWindow.cmx: thoGWindow.cmi
-thoList.cmo: thoList.cmi
-thoList.cmx: thoList.cmi
-thoString.cmo: thoString.cmi
-thoString.cmx: thoString.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
-tree.cmo: thoList.cmi product.cmi pmap.cmi linalg.cmi tree.cmi
-tree.cmx: thoList.cmx product.cmx pmap.cmx linalg.cmx tree.cmi
-tree2.cmo: tree2.cmi
-tree2.cmx: tree2.cmi
-trie.cmo: pmap.cmi trie.cmi
-trie.cmx: pmap.cmx trie.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
-vertex.cmo: vertex_syntax.cmi coupling.cmi vertex.cmi
-vertex.cmx: vertex_syntax.cmx coupling.cmi vertex.cmi
-vertex_syntax.cmo: pmap.cmi algebra.cmi vertex_syntax.cmi
-vertex_syntax.cmx: pmap.cmx algebra.cmx vertex_syntax.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
-whizard_tool.cmo: whizard.cmi
-whizard_tool.cmx: whizard.cmx
-config.cmo: config.cmi
-config.cmx: config.cmi
-cache.cmx: config.cmx
-cascade.cmi: cascade_lexer.cmi
-cascade_lexer.cmi: cascade_parser.cmi
-cascade_parser.cmi: cascade_syntax.cmi
-cascade_parser.mli: cascade_parser.ml
-cascade.cmo: cascade.cmi
-cascade.cmx: cascade.cmi cascade_lexer.cmx
-cascade_lexer.cmo: cascade_lexer.cmi
-cascade_lexer.cmx: cascade_lexer.cmi cascade_parser.cmx
-cascade_parser.cmo: cascade_parser.cmi cascade_syntax.cmi
-cascade_parser.cmx: cascade_parser.cmi cascade_syntax.cmi cascade_syntax.cmx
-comphep.cmi: comphep_lexer.cmi
-comphep_lexer.cmi: comphep_parser.cmi
-comphep_parser.cmi: comphep_syntax.cmi
-comphep_parser.mli: comphep_parser.ml
-comphep.cmo: comphep.cmi
-comphep.cmx: comphep.cmi comphep_lexer.cmx
-comphep_lexer.cmo: comphep_lexer.cmi
-comphep_lexer.cmx: comphep_lexer.cmi comphep_parser.cmx
-comphep_parser.cmo: comphep_parser.cmi comphep_syntax.cmi
-comphep_parser.cmx: comphep_parser.cmi comphep_syntax.cmi comphep_syntax.cmx
-vertex.cmi: vertex_lexer.cmi
-vertex_lexer.cmi: vertex_parser.cmi
-vertex_parser.cmi: vertex_syntax.cmi
-vertex_parser.mli: vertex_parser.ml
-vertex.cmo: vertex.cmi
-vertex.cmx: vertex.cmi vertex_lexer.cmx
-vertex_lexer.cmo: vertex_lexer.cmi
-vertex_lexer.cmx: vertex_lexer.cmi vertex_parser.cmx
-vertex_parser.cmo: vertex_parser.cmi vertex_syntax.cmi
-vertex_parser.cmx: vertex_parser.cmi vertex_syntax.cmi vertex_syntax.cmx
-model_file.cmi: model_file_lexer.cmi
-model_file_lexer.cmi: model_file_parser.cmi
-model_file_parser.cmi: model_file_syntax.cmi
-model_file_parser.mli: model_file_parser.ml
-model_file.cmo: model_file.cmi
-model_file.cmx: model_file.cmi model_file_lexer.cmx
-model_file_lexer.cmo: model_file_lexer.cmi
-model_file_lexer.cmx: model_file_lexer.cmi model_file_parser.cmx
-model_file_parser.cmo: model_file_parser.cmi model_file_syntax.cmi
-model_file_parser.cmx: model_file_parser.cmi model_file_syntax.cmi model_file_syntax.cmx
-constants.lo: kinds.lo
-omega_utils.lo: kinds.lo
-omega_utils.lo: omega_vectors.lo
-omega_utils.lo: omega_polarizations.lo
-omega_utils.lo: kinds.lo
-omega_spinors.lo: kinds.lo
-omega_spinors.lo: constants.lo
-omega_bispinors.lo: kinds.lo
-omega_bispinors.lo: constants.lo
-omega_vectors.lo: kinds.lo
-omega_vectors.lo: constants.lo
-omega_vectorspinors.lo: kinds.lo
-omega_vectorspinors.lo: constants.lo
-omega_vectorspinors.lo: omega_bispinors.lo
-omega_vectorspinors.lo: omega_vectors.lo
-omega_tensors.lo: kinds.lo
-omega_tensors.lo: constants.lo
-omega_tensors.lo: omega_vectors.lo
-omega_couplings.lo: kinds.lo
-omega_couplings.lo: constants.lo
-omega_couplings.lo: omega_vectors.lo
-omega_couplings.lo: omega_tensors.lo
-omega_spinor_couplings.lo: kinds.lo
-omega_spinor_couplings.lo: constants.lo
-omega_spinor_couplings.lo: omega_spinors.lo
-omega_spinor_couplings.lo: omega_vectors.lo
-omega_spinor_couplings.lo: omega_tensors.lo
-omega_spinor_couplings.lo: omega_couplings.lo
-omega_bispinor_couplings.lo: kinds.lo
-omega_bispinor_couplings.lo: constants.lo
-omega_bispinor_couplings.lo: omega_bispinors.lo
-omega_bispinor_couplings.lo: omega_vectorspinors.lo
-omega_bispinor_couplings.lo: omega_vectors.lo
-omega_bispinor_couplings.lo: omega_couplings.lo
-omega_polarizations.lo: kinds.lo
-omega_polarizations.lo: constants.lo
-omega_polarizations.lo: omega_vectors.lo
-omega_polarizations_madgraph.lo: kinds.lo
-omega_polarizations_madgraph.lo: constants.lo
-omega_polarizations_madgraph.lo: omega_vectors.lo
-omega_tensor_polarizations.lo: kinds.lo
-omega_tensor_polarizations.lo: constants.lo
-omega_tensor_polarizations.lo: omega_vectors.lo
-omega_tensor_polarizations.lo: omega_tensors.lo
-omega_tensor_polarizations.lo: omega_polarizations.lo
-omega_vspinor_polarizations.lo: kinds.lo
-omega_vspinor_polarizations.lo: constants.lo
-omega_vspinor_polarizations.lo: omega_vectors.lo
-omega_vspinor_polarizations.lo: omega_bispinors.lo
-omega_vspinor_polarizations.lo: omega_bispinor_couplings.lo
-omega_vspinor_polarizations.lo: omega_vectorspinors.lo
-omega95.lo: constants.lo
-omega95.lo: omega_spinors.lo
-omega95.lo: omega_vectors.lo
-omega95.lo: omega_polarizations.lo
-omega95.lo: omega_tensors.lo
-omega95.lo: omega_tensor_polarizations.lo
-omega95.lo: omega_couplings.lo
-omega95.lo: omega_spinor_couplings.lo
-omega95.lo: omega_utils.lo
-omega95_bispinors.lo: constants.lo
-omega95_bispinors.lo: omega_bispinors.lo
-omega95_bispinors.lo: omega_vectors.lo
-omega95_bispinors.lo: omega_vectorspinors.lo
-omega95_bispinors.lo: omega_polarizations.lo
-omega95_bispinors.lo: omega_vspinor_polarizations.lo
-omega95_bispinors.lo: omega_couplings.lo
-omega95_bispinors.lo: omega_bispinor_couplings.lo
-omega95_bispinors.lo: omega_utils.lo
Index: branches/ohl/omega-development/hgg-vertex/src/omega_Littlest_Eta.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/omega_Littlest_Eta.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/omega_Littlest_Eta.ml (revision 8717)
@@ -1,33 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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)
- (Modellib_BSM.Littlest(Modellib_BSM.BSM_ungauged))
-let _ = O.main ()
-
-(*i
- * Local Variables:
- * mode:caml
- * indent-tabs-mode:nil
- * page-delimiter:"^(\\* .*\n"
- * End:
-i*)
Index: branches/ohl/omega-development/hgg-vertex/src/omega_NMSSM.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/omega_NMSSM.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/omega_NMSSM.ml (revision 8717)
@@ -1,33 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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)
- (Modellib_NMSSM.NMSSM_func(Modellib_NMSSM.NMSSM))
-let _ = O.main ()
-
-(*i
- * Local Variables:
- * mode:caml
- * indent-tabs-mode:nil
- * page-delimiter:"^(\\* .*\n"
- * End:
-i*)
Index: branches/ohl/omega-development/hgg-vertex/src/comphep_lexer.mll
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/comphep_lexer.mll (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/comphep_lexer.mll (revision 8717)
@@ -1,54 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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/hgg-vertex/src/momentum.mli
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/momentum.mli (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/momentum.mli (revision 8717)
@@ -1,211 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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<p_2$. *)
- val compare : t -> 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/hgg-vertex/src/oVM.mli
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/oVM.mli (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/oVM.mli (revision 8717)
@@ -1,44 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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/hgg-vertex/src/omega_SM_Hgg.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/omega_SM_Hgg.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/omega_SM_Hgg.ml (revision 8717)
@@ -1,33 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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)
- (Modellib_SM.SM(Modellib_SM.SM_Hgg))
-let _ = O.main ()
-
-(*i
- * Local Variables:
- * mode:caml
- * indent-tabs-mode:nil
- * page-delimiter:"^(\\* .*\n"
- * End:
-i*)
Index: branches/ohl/omega-development/hgg-vertex/src/cache.mli
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/cache.mli (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/cache.mli (revision 8717)
@@ -1,61 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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
- type hash = string
- type value
-
- exception Mismatch of string * string * string
-
- val hash : key -> hash
- val exists : hash -> string -> bool
- val find : hash -> string -> string option
- val write : hash -> string -> value -> unit
- val write_dir : hash -> string -> string -> value -> unit
- val read : hash -> string -> value
- val maybe_read : hash -> string -> value option
-
- end
-
-module type Key =
- sig
- type t
- end
-
-module type Value =
- sig
- type t
- end
-
-module Make (Key : Key) (Value : Value) :
- T with type key = Key.t and type value = Value.t
-
-(*i
- * Local Variables:
- * mode:caml
- * indent-tabs-mode:nil
- * page-delimiter:"^(\\* .*\n"
- * End:
-i*)
Index: branches/ohl/omega-development/hgg-vertex/src/omega_SM3_clones.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/omega_SM3_clones.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/omega_SM3_clones.ml (revision 8717)
@@ -1,33 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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)(Modellib_SM.SM3_clones)
-
-let _ = O.main ()
-
-(*i
- * Local Variables:
- * mode:caml
- * indent-tabs-mode:nil
- * page-delimiter:"^(\\* .*\n"
- * End:
-i*)
Index: branches/ohl/omega-development/hgg-vertex/src/omega_Phi3h.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/omega_Phi3h.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/omega_Phi3h.ml (revision 8717)
@@ -1,34 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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)(Modellib_SM.Phi3)
-let _ = O.main ()
-
-(*i
- * Local Variables:
- * mode:caml
- * indent-tabs-mode:nil
- * page-delimiter:"^(\\* .*\n"
- * End:
-i*)
Index: branches/ohl/omega-development/hgg-vertex/src/modellib_PSSSM.mli
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/modellib_PSSSM.mli (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/modellib_PSSSM.mli (revision 8717)
@@ -1,45 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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
- end
-
-module PSSSM : extMSSM_flags
-module PSSSM_QCD : 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/hgg-vertex/src/ogiga.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/ogiga.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/ogiga.ml (revision 8717)
@@ -1,351 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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/hgg-vertex/src/rCS.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/rCS.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/rCS.ml (revision 8717)
@@ -1,111 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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/hgg-vertex/src/color.mli
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/color.mli (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/color.mli (revision 8717)
@@ -1,76 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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 a single~$\textrm{SU}(N_C)$ for the moment. Therefore,
- particles are either color singlets or live in the defining
- representation of $\textrm{SU}(N_C)$: [SUN]$(|N_C|)$, its conjugate
- [SUN]$(-|N_C|)$ or in the adjoint representation of
- $\textrm{SU}(N_C)$: [AdjSUN]$(N_C)$. *)
-
-type t = Singlet | SUN of int | AdjSUN of int
-
-module type NC =
- sig
- val nc : int
- end
-
-val conjugate : t -> t
-val compare : t -> t -> int
-
-(* \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
-
- exception Open_flow
- val power_of_nc : t -> t -> int option
-
- end
-
-module Flow : Flow
-
-(*i
- * Local Variables:
- * mode:caml
- * indent-tabs-mode:nil
- * page-delimiter:"^(\\* .*\n"
- * End:
-i*)
Index: branches/ohl/omega-development/hgg-vertex/src/omega.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/omega.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/omega.ml (revision 8717)
@@ -1,353 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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 = Config.max_color_lines end)(M')
-
- module M = CM.M
- type flavor = M.flavor
-
- module Proc = Process.Make(M)
-
-(* \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 ^ "]"
-
- 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)
-
- type cache_mode =
- | Cache_Default
- | Cache_Initialize of string
-
- let cache_option = ref Cache_Default
-
-(* \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;
- "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");
- ("-initialize", Arg.String (fun s -> cache_option := Cache_Initialize s),
- "precompute large lookup table(s) and store them in the directory");
- ("-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 cmdline =
- String.concat " " (List.map ThoString.quote (Array.to_list Sys.argv)) in
-
- let output_channel =
- match !output_file with
- | None -> stdout
- | Some name -> open_out name in
-
- let processes =
- try
- ThoList.uniq
- (List.sort compare
- (match List.rev !rev_scatterings, List.rev !rev_decays with
- | [], [] -> []
- | scatterings, [] ->
- Proc.expand_scatterings (List.map Proc.parse_scattering scatterings)
- | [], decays ->
- Proc.expand_decays (List.map Proc.parse_decay decays)
- | scatterings, decays ->
- invalid_arg "mixed scattering and decay!"))
- with
- | Invalid_argument s ->
- begin
- Printf.eprintf "O'Mega: invalid process specification: %s!\n" s;
- flush stderr;
- []
- end in
-
-(* \begin{dubious}
- This is still crude. Eventually, we want to catch \emph{all} exceptions
- and write an empty (but compilable) amplitude unless one of the special options
- is selected.
- \end{dubious} *)
-
- begin match processes, !cache_option, !params with
- | [], Cache_Initialize dir, false ->
- CF.initialize_cache dir;
- exit 0
- | _, _, true ->
- T.parameters_to_channel output_channel;
- exit 0
- | [], _, false ->
- T.amplitudes_to_channel cmdline output_channel !checks CF.empty;
- exit 0
- | _, _, false ->
-
- let selectors =
- let fin, fout = List.hd processes in
- C.to_selectors (C.of_string_list (List.length fin + List.length fout) !cascades) in
-
- let amplitudes =
- try
- CF.amplitudes (include_goldstones !checks) selectors processes
- with
- | exc ->
- begin
- Printf.eprintf
- "O'Mega: exception %s in amplitude construction!\n"
- (Printexc.to_string exc);
- flush stderr;
- CF.empty;
- end in
-
- if !write then
- T.amplitudes_to_channel cmdline output_channel !checks amplitudes;
-
- if not !quiet then begin
- 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
- (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 (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 (F.amplitude_to_dot ch) (CF.processes amplitudes);
- close_out ch
- | None -> ()
- end;
-
- if !print_forest then
- 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 = 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
-
- end
-
-(* \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/hgg-vertex/src/thoGDraw.mli
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/thoGDraw.mli (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/thoGDraw.mli (revision 8717)
@@ -1,246 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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/hgg-vertex/src/vertex_lexer.mll
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/vertex_lexer.mll (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/vertex_lexer.mll (revision 8717)
@@ -1,68 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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/hgg-vertex/src/omega_SM_clones.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/omega_SM_clones.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/omega_SM_clones.ml (revision 8717)
@@ -1,33 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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)(Modellib_SM.SM_clones)
-
-let _ = O.main ()
-
-(*i
- * Local Variables:
- * mode:caml
- * indent-tabs-mode:nil
- * page-delimiter:"^(\\* .*\n"
- * End:
-i*)
Index: branches/ohl/omega-development/hgg-vertex/src/thoString.mli
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/thoString.mli (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/thoString.mli (revision 8717)
@@ -1,58 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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/hgg-vertex/src/model_file.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/model_file.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/model_file.ml (revision 8717)
@@ -1,364 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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/hgg-vertex/src/comphep_syntax.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/comphep_syntax.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/comphep_syntax.ml (revision 8717)
@@ -1,121 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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/hgg-vertex/src/constants.f90
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/constants.f90 (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/constants.f90 (revision 8717)
@@ -1,66 +0,0 @@
-! WHIZARD <<Version>> <<Date>>
-
-! (C) 1999-2009 by
-! Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
-! Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
-! Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-! with contributions by Sebastian Schmidt
-!
-! 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 constants
-
- use kinds, only: default
-
- implicit none
- private
-
- complex(default), parameter, public :: &
- ii = (0._default, 1._default)
-
- real(default), parameter, public :: &
- one = 1.0_default, two = 2.0_default, three = 3.0_default, &
- four = 4.0_default, five = 5.0_default
-
- real(default), parameter, public :: &
- pi = 3.1415926535897932384626433832795028841972_default
-
- real(default), parameter, public :: &
- twopi = 2*pi, &
- twopi2 = twopi**2, twopi3 = twopi**3, twopi4 = twopi**4, &
- twopi5 = twopi**5, twopi6 = twopi**6
-
- real(default), parameter, public :: &
- degree = pi/180
-
- real(default), parameter, public :: &
- conv = 0.38937966e12_default
-
- real(default), parameter, public :: &
- pb_per_fb = 1.e-3_default
-
- real(default), parameter, public :: &
- NC = three, CF = (NC**2 - one)/two/NC, CA = NC, &
- TR = one/two
-
- character(*), parameter, public :: &
- energy_unit = "GeV"
-
- character(*), parameter, public :: &
- cross_section_unit = "fb"
-
-end module constants
Index: branches/ohl/omega-development/hgg-vertex/src/omega_logo.xpm
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/omega_logo.xpm (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/omega_logo.xpm (revision 8717)
@@ -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/hgg-vertex/src/comphep.mli
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/comphep.mli (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/comphep.mli (revision 8717)
@@ -1,33 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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/hgg-vertex/src/omega_SM_top.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/omega_SM_top.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/omega_SM_top.ml (revision 8717)
@@ -1,566 +0,0 @@
-(* $Id: f90_SMtop.ml,v 1.3.10.2 2006/05/15 09:06:23 ohl Exp $ *)
-(* Copyright (C) 2000-2004 by Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- 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.
- O'Mega 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_SMtop" ["Standard Model with anomalous top"]
- { RCS.revision = "$Revision: $";
- RCS.date = "$Date: 2009/05/08 16:35:21 $";
- RCS.author = "$Author: jr_reuter $";
- RCS.source
- = "$Source: xxx $" }
-
-(* \thocwmodulesection{SM with anomalous top} *)
-
-module type SM_flags =
- sig
- val include_gluons : bool
- val include_anomalous : bool
- val k_matrix : bool
- end
-
-module SM_no_anomalous : SM_flags =
- struct
- let include_gluons = false
- let include_anomalous = false
- let k_matrix = false
- end
-
-module SM_gluons : SM_flags =
- struct
- let include_gluons = true
- let include_anomalous = false
- let k_matrix = false
- end
-
-module Anomtop (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" ]
-
- 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.Anomtop.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", [O 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
-
- let colsymm _ = (0,false),(0,false)
-
- type constant =
- | Unit | Pi | Alpha_QED | Sin2thw
- | Sinthw | Costhw | E | G_weak | Vev
- | Q_lepton | Q_up | Q_down | Q_top | G_CC
- | G_NC_neutrino | G_NC_lepton | G_NC_up | G_NC_down | G_NC_top
- | 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
- | 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 = Modeltools.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);
- ((D (-n), Ga, D n), FBF (1, Psibar, V, Psi), Q_down) ]
- let em_up_type_currents =
- List.map mgm
- [ ((U (-1), Ga, U 1), FBF (1, Psibar, V, Psi), Q_up);
- ((U (-2), Ga, U 2), FBF (1, Psibar, V, Psi), Q_up);
- ((U (-3), Ga, U 3), FBF (1, Psibar, V, Psi), Q_top)]
- let electromagnetic_currents =
- ThoList.flatmap electromagnetic_currents' [1;2;3] @
- em_up_type_currents
-
- 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);
- ((D (-n), Z, D n), FBF (1, Psibar, VA, Psi), G_NC_down) ]
- let neutral_up_type_currents =
- List.map mgm
- [ ((U (-1), Z, U 1), FBF (1, Psibar, VA, Psi), G_NC_up);
- ((U (-2), Z, U 2), FBF (1, Psibar, VA, Psi), G_NC_up);
- ((U (-3), Z, U 3), FBF (1, Psibar, VA, Psi), G_NC_top) ]
- let neutral_currents =
- ThoList.flatmap neutral_currents' [1;2;3] @
- neutral_up_type_currents
-
-(* \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_up_currents =
- List.map mgm
- [ ((U (-1), Wp, D 1), FBF (1, Psibar, VL, Psi), G_CC);
- ((U (-2), Wp, D 2), FBF (1, Psibar, VL, Psi), G_CC);
- ((U (-3), Wm, D 3), FBF (1, Psibar, VL, Psi), G_CC);
- ((D (-1), Wm, U 1), FBF (1, Psibar, VL, Psi), G_CC);
- ((D (-2), Wm, U 2), FBF (1, Psibar, VL, Psi), G_CC);
- ((D (-3), Wp, U 3), FBF (1, Psibar, VL, Psi), G_CC) ]
- let charged_currents =
- ThoList.flatmap charged_currents' [1;2;3] @
- charged_up_currents
-
- 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) ]
-
-(* \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);
- ((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 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 =
- (electromagnetic_currents @
- ThoList.flatmap color_currents [1;2;3] @
- neutral_currents @
- charged_currents @
- yukawa @ 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-" -> 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.Anomtop.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.Anomtop.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.Anomtop.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.Anomtop.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.Anomtop.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_to_TeX = 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.Anomtop.flavor_to_TeX: invalid lepton"
- | N 1 -> "\\nu_e" | N (-1) -> "\\bar{\\nu}_e"
- | N 2 -> "\\nu_\\mu" | N (-2) -> "\\bar{\\nu}_\\mu"
- | N 3 -> "\\nu_\\tau" | N (-3) -> "\\bar{\\nu}_\\tau"
- | N _ -> invalid_arg
- "Models.Anomtop.flavor_to_TeX: invalid neutrino"
- | U 1 -> "u" | U (-1) -> "\\bar{u}"
- | U 2 -> "c" | U (-2) -> "\\bar{c}"
- | U 3 -> "t" | U (-3) -> "\\bar{t}"
- | U _ -> invalid_arg
- "Models.Anomtop.flavor_to_TeX: invalid up type quark"
- | D 1 -> "d" | D (-1) -> "\\bar{d}"
- | D 2 -> "s" | D (-2) -> "\\bar{s}"
- | D 3 -> "b" | D (-3) -> "\\bar{b}"
- | D _ -> invalid_arg
- "Models.Anomtop.flavor_to_TeX: invalid down type quark"
- end
- | G f ->
- begin match f with
- | Gl -> "g"
- | Ga -> "\\gamma" | 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_to_TeX = flavor_to_TeX
- 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"
- | Q_top -> "qtop"
- | G_NC_lepton -> "gnclep" | G_NC_neutrino -> "gncneu"
- | G_NC_up -> "gncup" | G_NC_down -> "gncdwn"
- | G_NC_top -> "gnctop"
- | 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_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
-
-module O = Omega.Make(Fusion.Mixed23)(Targets.Fortran)
- (Anomtop(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/hgg-vertex/src/omega_Phi3.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/omega_Phi3.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/omega_Phi3.ml (revision 8717)
@@ -1,32 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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)(Modellib_SM.Phi3)
-let _ = O.main ()
-
-(*i
- * Local Variables:
- * mode:caml
- * indent-tabs-mode:nil
- * page-delimiter:"^(\\* .*\n"
- * End:
-i*)
Index: branches/ohl/omega-development/hgg-vertex/src/modellib_PSSSM.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/modellib_PSSSM.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/modellib_PSSSM.ml (revision 8717)
@@ -1,1940 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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{Extended Supersymmetric Standard Model(s)} *)
-
-(* This is based on the NMSSM implementation by Felix Braam, and extended to
- the exotica -- leptoquarks, leptoquarkinos, additional Higgses etc. -- by
- Daniel Wiesler. Note that for the Higgs sector vertices the conventions of
- the Franke/Fraas paper have been used. *)
-
-module type extMSSM_flags =
- sig
- val ckm_present : bool
- end
-
-module PSSSM : extMSSM_flags =
- struct
- let ckm_present = false
- end
-
-module PSSSM_QCD : extMSSM_flags =
- struct
- let ckm_present = false
- end
-
-module ExtMSSM (Flags : extMSSM_flags) =
- struct
- let rcs = RCS.rename rcs_file "Models.NMSSM"
- [ "NMSSM and more" ]
-
- 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"]
-
-
-(*additional combinatorics *)
-(* yields a list of tuples consistig of the off-diag combinations of the elements in "set" *)
- let choose2 set =
- List.map (function [x;y] -> (x,y) | _ -> failwith "choose2")
- (Combinatorics.choose 2 set)
-
-
-(************pairs***********************************)
-(*pairs appends the diagonal combinations to choose2 *)
- let rec diag = function
- | [] -> []
- | x1 :: rest -> (x1, x1) :: diag rest
-
-
- let pairs l = choose2 l @ diag l
-(************triples******************************************)
-(* rank 3 generalization of pairs *)
- let rec cloop set i j k =
- if i > ((List.length set)-1) then []
- else if j > i then cloop set (succ i) (j-i-1) (j-i-1)
- else if k > j then cloop set i (succ j) (k-j-1)
- else (List.nth set i, List.nth set j, List.nth set k) :: cloop set i j (succ k)
-
- let triples set = cloop set 0 0 0
-(******************two_and_one**********************************)
-
- let rec two_and_one' l1 z n =
- if n < 0 then []
- else
- ((fst (List.nth (pairs l1) n)),(snd (List.nth (pairs l1) n)), z):: two_and_one' l1 z (pred n)
-
- let two_and_one l1 l2 =
- let f z = two_and_one' l1 z ((List.length (pairs l1))-1)
- in
- List.flatten ( List.map f l2 )
-(*******************************************************)
-
-
-
- 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 | C3 | C3c | C4 | C4c
-
- type neu =
- | N1 | N2 | N3 | N4 | N5 | N6 | N7 | N8 | N9 | N10 | N11
-
- let int_of_char = function
- | C1 -> 1 | C2 -> 2 | C1c -> -1 | C2c -> -2
- | C3 -> 3 | C4 -> 4 | C3c -> -3 | C4c -> -4
-
- let string_of_char c = string_of_int (int_of_char c)
-
- let conj_char = function
- | C1 -> C1c | C2 -> C2c | C1c -> C1 | C2c -> C2
- | C3 -> C3c | C4 -> C4c | C3c -> C3 | C4c -> C4
-
- let string_of_neu = function
- | N1 -> "1" | N2 -> "2" | N3 -> "3" | N4 -> "4" | N5 -> "5" | N6 -> "6"
- | N7 -> "7" | N8 -> "8" | N9 -> "9" | N10 -> "10"| N11 -> "11"
-
-(* For NMSSM-like the Higgs bosons, we follow the conventions of
- Franke/Fraas. Daniel Wiesler: extended to E6 models. *)
-
- type shiggs =
- | S1 | S2 | S3 | S4 | S5 | S6 | S7 | S8 | S9
-
- type phiggs =
- | P1 | P2 | P3 | P4 | P5 | P6 | P7
-
-(* [HCx] is always the $H^+$, [HCxc] the $H^-$. *)
-
- type chiggs =
- | HC1 | HC2 | HC3 | HC4 | HC5 | HC1c | HC2c | HC3c | HC4c | HC5c
-
- let conj_chiggs = function
- | HC1 -> HC1c | HC2 -> HC2c | HC1c -> HC1 | HC2c -> HC2
- | HC3 -> HC3c | HC4 -> HC4c | HC3c -> HC3 | HC4c -> HC4
- | HC5 -> HC5c | HC5c -> HC5
-
- let string_of_shiggs = function
- | S1 -> "1" | S2 -> "2" | S3 -> "3" | S4 -> "4" | S5 -> "5"
- | S6 -> "6" | S7 -> "7" | S8 -> "8" | S9 -> "9"
-
- let string_of_phiggs = function
- | P1 -> "1" | P2 -> "2" | P3 -> "3" | P4 -> "4" | P5 -> "5"
- | P6 -> "6" | P7 -> "7"
-
- let nlist = [ N1; N2; N3; N4; N5; N6; N7; N8; N9; N10; N11 ]
- let slist = [ S1; S2; S3; S4; S5; S6; S7; S8; S9 ]
- let plist = [ P1; P2; P3; P4; P5; P6; P7 ]
- let clist = [ HC1; HC2; HC3; HC4; HC5; HC1c; HC2c; HC3c; HC4c; HC5c ]
- let charlist = [ C1; C2; C3; C4; C1c; C2c; C3c; C4c ]
-
- 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 | SHiggs of shiggs | PHiggs of phiggs
- | CHiggs of chiggs
- | LQ of sfm*int
- | LQino of int
-
- type flavor_sans_color = flavor
- let flavor_sans_color f = f
-
- let string_of_fermion_type = function
- | L _ -> "l" | U _ -> "u" | D _ -> "d" | N _ -> "n"
- | _ -> failwith
- "Models.ExtMSSM.string_of_fermion_type: invalid fermion type"
-
- let string_of_fermion_gen = function
- | L g | U g | D g | N g -> string_of_int (abs (g))
- | _ -> failwith
- "Models.ExtMSSM.string_of_fermion_gen: invalid fermion type"
-
- type gauge = unit
-
- let gauge_symbol () =
- failwith "Models.ExtMSSM.gauge_symbol: internal error"
-
-(* At this point we will forget graviton and -ino. *)
-
- 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);
- LQ (M1,g); LQ (M2,g); LQino g ]
-
- 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", List.map (fun a -> Chargino a) charlist;
- "Neutralinos", List.map (fun a -> Neutralino a) nlist;
- "Higgs Bosons", List.map (fun a -> SHiggs a) slist @
- List.map (fun a -> PHiggs a) plist @
- List.map (fun a -> CHiggs a) clist;
- "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
- | LQino g -> spinor g 0
- | Chargino c -> spinor (int_of_char c) 0
- | Ga | Gl -> Vector
- | Wp | Wm | Z -> Massive_Vector
- | SHiggs _ | PHiggs _ | CHiggs _
- | Sup _ | Sdown _ | Slepton _ | Sneutrino _ | LQ _ -> Scalar
- | Neutralino _ | Gluino -> Majorana
-
- 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)
- | LQ (m,g) -> Color.SUN (if g > 0 then 3 else -3)
- | LQino 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
- | LQino g -> prop_spinor g 0
- | Chargino c -> prop_spinor (int_of_char c) 0
- | Ga | Gl -> Prop_Feynman
- | Wp | Wm | Z -> Prop_Unitarity
- | SHiggs _ | PHiggs _ | CHiggs _ -> Prop_Scalar
- | Sup _ | Sdown _ | Slepton _ | Sneutrino _ -> Prop_Scalar
- | LQ _ -> Prop_Scalar
- | Gluino -> Prop_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
- | SHiggs s -> SHiggs s
- | PHiggs p -> PHiggs p
- | CHiggs c -> CHiggs (conj_chiggs c)
- | Gluino -> Gluino
- | Neutralino n -> Neutralino n | Chargino c -> Chargino (conj_char c)
- | LQino g -> LQino (-g)
- | LQ (m,g) -> LQ (m,-g)
-
- 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
- | SHiggs _ | PHiggs _ | CHiggs _ -> 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
- | LQ _ -> 0
- | LQino g -> if g > 0 then 1 else -1
-
-(* 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 =
- | E | G
- | 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
- | Gs
- | G_NZN of neu*neu | G_CZC of char*char
- | G_YUK_FFS of flavor*flavor*shiggs
- | G_YUK_FFP of flavor*flavor*phiggs
- | G_YUK_LCN of int
- | G_YUK_UCD of int*int | G_YUK_DCU of int*int
- | G_NHC of vc*neu*char
- | G_YUK_C of vc*flavor*char*sff*sfm
- | G_YUK_Q of vc*int*flavor*char*sff*sfm
- | G_YUK_N of vc*flavor*neu*sff*sfm
- | G_YUK_G of vc*flavor*sff*sfm
- | G_NWC of neu*char | G_CWN of char*neu
- | G_CSC of char*char*shiggs
- | G_CPC of char*char*phiggs
- | G_WSQ of vc*int*int*sfm*sfm
- | G_SLSNW of vc*int*sfm
- | G_ZSF of sff*int*sfm*sfm
- | G_CICIS of neu*neu*shiggs
- | G_CICIP of neu*neu*phiggs
- | G_GH_WPC of phiggs | G_GH_WSC of shiggs
- | G_GH_ZSP of shiggs*phiggs | G_GH_WWS of shiggs
- | G_GH_ZZS of shiggs | G_GH_ZCC
- | G_GH_GaCC
- | G_GH4_ZZPP of phiggs*phiggs
- | G_GH4_ZZSS of shiggs*shiggs
- | G_GH4_ZZCC | G_GH4_GaGaCC
- | G_GH4_ZGaCC | G_GH4_WWCC
- | G_GH4_WWPP of phiggs*phiggs
- | G_GH4_WWSS of shiggs*shiggs
- | G_GH4_ZWSC of shiggs
- | G_GH4_GaWSC of shiggs
- | G_GH4_ZWPC of phiggs
- | G_GH4_GaWPC of phiggs
- | G_WWSFSF of sff*int*sfm*sfm
- | G_WPSLSN of vc*int*sfm
- | G_H3_SCC of shiggs
- | G_H3_SSS of shiggs*shiggs*shiggs
- | G_H3_SPP of shiggs*phiggs*phiggs
- | G_SFSFS of shiggs*sff*int*sfm*sfm
- | G_SFSFP of phiggs*sff*int*sfm*sfm
- | G_HSNSL of vc*int*sfm
- | G_HSUSD 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_YUK_LQ_S of int*shiggs*int
- | G_YUK_LQ_P of int*phiggs*int
- | G_LQ_NEU of sfm*int*int*neu
- | G_LQ_EC_UC of vc*sfm*int*int*int
- | G_LQ_GG of sfm*int*int
- | G_LQ_SSU of sfm*sfm*sfm*int*int*int
- | G_LQ_SSD of sfm*sfm*int*int*int
- | G_LQ_S of sfm*sfm*int*shiggs*int
- | G_LQ_P of sfm*sfm*int*phiggs*int
- | G_ZLQ of int*sfm*sfm
- | G_ZZLQLQ | G_ZPLQLQ | G_PPLQLQ | G_ZGlLQLQ | G_PGlLQLQ | G_NLQC | G_GlGlLQLQ
-
-(* \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 = Modeltools.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+. FB ***)
- 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+. FB***)
- 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+. FB***)
- 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+. FB***)
- 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. *)
-(** FB **)
- 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+. FB ***)
- 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+.FB ***)
- 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+. FB***)
- 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+. FB***)
- let charged_squark_currents' g h m1 m2 =
- [ ((Wm, Sup (m1,g), Sdown (m2,-h)), Vector_Scalar_Scalar (-1), G_WSQ
- (true,g,h,m1,m2));
- ((Wp, Sup (m1,-g), Sdown (m2,h)), Vector_Scalar_Scalar 1, G_WSQ
- (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+. FB ***)
- 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+. FB***)
- let neutral_Z (n,m) =
- [ ((Neutralino n, Z, Neutralino m), FBF (1, Chibar, VA, Chi),
- (G_NZN (n,m))) ]
-
-(*** REVISED: Compatible with CD+. FB***)
- 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. FB***)
-
- let yukawa_v =
- [ (Gluino, Gl, Gluino), FBF (1, Chibar, V, Chi), Gs]
-
-(*** REVISED: Independent of the sign of CD. ***)
-(*** REVISED: Felix Braam: Compact version using new COMBOS + FF-Couplings *)
- let yukawa_higgs_FFS f s =
- [((conjugate f, SHiggs s, f ), FBF (1, Psibar, S, Psi),
- G_YUK_FFS (conjugate f, f, s))]
- let yukawa_higgs_FFP f p =
- [((conjugate f, PHiggs p, f), FBF (1, Psibar, P, Psi),
- G_YUK_FFP (conjugate f ,f , p))]
-
-(* JR: Only the first charged Higgs. *)
- let yukawa_higgs_NLC g =
- [ ((N (-g), CHiggs HC1, L g), FBF (1, Psibar, Coupling.SR, Psi),
- G_YUK_LCN g);
- ((L (-g), CHiggs HC1c, N g), FBF (1, Psibar, Coupling.SL, Psi),
- G_YUK_LCN g)]
-
- let yukawa_higgs g =
- yukawa_higgs_NLC g @
- List.flatten ( Product.list2 yukawa_higgs_FFS [L g; U g; D g] [S1; S2; S3]) @
- List.flatten ( Product.list2 yukawa_higgs_FFP [L g; U g; D g] [P1; P2])
-
-
-(* JR: Only the first charged Higgs. *)
-(*** REVISED: Independent of the sign of CD. FB***)
- let yukawa_higgs_quark (g,h) =
- [ ((U (-g), CHiggs HC1, D h), FBF (1, Psibar, SLR, Psi),
- G_YUK_UCD (g, h));
- ((D (-h), CHiggs HC1c, U g), FBF (1, Psibar, SLR, Psi),
- G_YUK_DCU (g, h)) ]
-
-(*** REVISED: Compatible with CD+.FB*)
-(*** REVISED: Compact version using new COMBOS*)
- let yukawa_shiggs_2 c1 c2 s =
- let cc1 = conj_char c1 in
- ((Chargino cc1, SHiggs s, Chargino c2), FBF (1, Psibar, SLR, Psi),
- G_CSC (c1,c2,s))
-
- let yukawa_phiggs_2 c1 c2 p =
- let cc1 = conj_char c1 in
- ((Chargino cc1, PHiggs p, Chargino c2), FBF (1, Psibar, SLR, Psi),
- G_CPC (c1,c2,p))
-
- let yukawa_higgs_2 =
- Product.list3 yukawa_shiggs_2 [C1;C2] [C1;C2] [S1;S2;S3] @
- Product.list3 yukawa_phiggs_2 [C1;C2] [C1;C2] [P1;P2]
-
-(* JR: Only the first charged Higgs. *)
-(*** REVISED: Compatible with CD+.FB ***)
- let higgs_charg_neutr n c =
- let cc = conj_char c in
- [ ((Neutralino n, CHiggs HC1c, Chargino c), FBF (-1, Chibar, SLR, Psi),
- G_NHC (false,n,c));
- ((Chargino cc, CHiggs HC1, Neutralino n), FBF (-1, Psibar, SLR, Chi),
- G_NHC (true,n,c)) ]
-
-(*** REVISED: Compatible with CD+. FB***)
-(*** REVISED: Compact version using new COMBOS*)
- let shiggs_neutr (n,m,s) =
- ((Neutralino n, SHiggs s, Neutralino m), FBF (1, Chibar, SP, Chi),
- G_CICIS (n,m,s))
- let phiggs_neutr (n,m,p) =
- ((Neutralino n, PHiggs p, Neutralino m), FBF (1, Chibar, SP, Chi),
- G_CICIP (n,m,p))
-
- let higgs_neutr =
- List.map shiggs_neutr (two_and_one [N1;N2;N3;N4;N5] [S1;S2;S3]) @
- List.map phiggs_neutr (two_and_one [N1;N2;N3;N4;N5] [P1;P2])
-
-(*** REVISED: Compatible with CD+. FB***)
- let yukawa_n_2 n m g =
- [ ((Neutralino n, Slepton (m,-g), L g), FBF (1, Chibar, SLR, Psi),
- G_YUK_N (true,L g,n,SL,m));
- ((L (-g), Slepton (m,g), Neutralino n), FBF (1, Psibar, SLR, Chi),
- G_YUK_N (false,L g,n,SL,m));
- ((Neutralino n, Sup (m,-g), U g), FBF (1, Chibar, SLR, Psi),
- G_YUK_N (true,U g,n,SU,m));
- ((U (-g), Sup (m,g), Neutralino n), FBF (1, Psibar, SLR, Chi),
- G_YUK_N (false,U g,n,SU,m));
- ((Neutralino n, Sdown (m,-g), D g), FBF (1, Chibar, SLR, Psi),
- G_YUK_N (true,D g,n,SD,m));
- ((D (-g), Sdown (m,g), Neutralino n), FBF (1, Psibar, SLR, Chi),
- G_YUK_N (false,D g,n,SD,m)) ]
- let yukawa_n_3 n g =
- [ ((Neutralino n, Sneutrino (-g), N g), FBF (1, Chibar, SLR, Psi),
- G_YUK_N (true,N g,n,SN,M1));
- ((N (-g), Sneutrino g, Neutralino n), FBF (1, Psibar, SLR, Chi),
- G_YUK_N (false,N g, n,SN,M1)) ]
-
- let yukawa_n_5 g m =
- [ ((U (-g), Sup (m,g), Gluino), FBF (1, Psibar, SLR, Chi),
- G_YUK_G (false,U g,SU,m));
- ((D (-g), Sdown (m,g), Gluino), FBF (1, Psibar, SLR, Chi),
- G_YUK_G (false,D g,SD,m));
- ((Gluino, Sup (m,-g), U g), FBF (1, Chibar, SLR, Psi),
- G_YUK_G (true,U g,SU,m));
- ((Gluino, Sdown (m,-g), D g), FBF (1, Chibar, SLR, Psi),
- G_YUK_G (true,D g,SD,m))]
- let yukawa_n =
- List.flatten (Product.list3 yukawa_n_2 [N1;N2;N3;N4;N5] [M1;M2] [1;2;3]) @
- List.flatten (Product.list2 yukawa_n_3 [N1;N2;N3;N4;N5] [1;2;3]) @
- List.flatten (Product.list2 yukawa_n_5 [1;2;3] [M1;M2])
-
-
-(*** REVISED: Compatible with CD+.FB ***)
- let yukawa_c_2 c g =
- let cc = conj_char c in
- [ ((L (-g), Sneutrino g, Chargino cc), BBB (1, Psibar, SLR,
- Psibar), G_YUK_C (true,L g,c,SN,M1));
- ((Chargino c, Sneutrino (-g), L g), PBP (1, Psi, SLR, Psi),
- G_YUK_C (false,L g,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, SLR,
- Psi), G_YUK_C (true,N g,c,SL,m));
- ((Chargino cc, Slepton (m,-g), N g), FBF (1, Psibar, SLR,
- Psi), G_YUK_C (false,N g,c,SL,m)) ]
- let yukawa_c c =
- ThoList.flatmap (yukawa_c_2 c) [1;2;3] @
- List.flatten (Product.list2 (yukawa_c_3 c) [M1;M2] [1;2;3])
-
-
-(*** REVISED: Compatible with CD+. FB***)
- 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,D h,c,SU,m));
- ((D (-h), Sup (m,g), Chargino cc), BBB (1, Psibar, SLR, Psibar),
- G_YUK_Q (true,g,D h,c,SU,m));
- ((Chargino cc, Sdown (m,-g), U h), FBF (1, Psibar, SLR, Psi),
- G_YUK_Q (true,g,U h,c,SD,m));
- ((U (-h), Sdown (m,g), Chargino c), FBF (1, Psibar, SLR, Psi),
- G_YUK_Q (false,g,U h,c,SD,m)) ]
- let yukawa_cq c =
- if Flags.ckm_present then
- List.flatten (Product.list2 (yukawa_cq' c) [(1,1);(1,2);(2,1);(2,2);(1,3);(2,3);(3,3);(3,2);(3,1)] [M1;M2])
- else
- List.flatten (Product.list2 (yukawa_cq' c) [(1,1);(2,2);(3,3)] [M1;M2])
-
-
-(*** 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.
-**FB*)
- 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.
-**FB*)
-
-(** LQ-coupl. **DW**)
-
-
- let chg = function
- | M1 -> M2 | M2 -> M1
-
-
-(** LQ - Yuk's **)
-
-
- let yuk_lqino_se_uc1' g1 g2 g3 m =
- let cm = chg m in
- [ ((U (-g3), Slepton (m,-g2), LQino g1), FBF (1, Psibar, SLR, Psi),
- G_LQ_EC_UC (true,cm,g1,g2,g3)) ]
-
- let yuk_lqino_se_uc1 g1 g2 g3 =
- ThoList.flatmap (yuk_lqino_se_uc1' g1 g2 g3) [M1;M2]
-
- let yuk_lqino_se_uc2' g1 g2 g3 m =
- let cm = chg m in
- [ ((LQino (-g1), Slepton (m,g2), U g3), FBF (1, Psibar, SLR, Psi),
- G_LQ_EC_UC (false,cm,g1,g2,g3)) ]
-
- let yuk_lqino_se_uc2 g1 g2 g3 =
- ThoList.flatmap (yuk_lqino_se_uc2' g1 g2 g3) [M1;M2]
-
-
- let yuk_lqino_sn_dc1 g1 g2 g3 =
- [ ((D (-g3), Sneutrino (-g2), LQino g1), FBF (-1, Psibar, SLR, Psi),
- G_LQ_EC_UC (true,M2,g1,g2,g3)) ]
-
- let yuk_lqino_sn_dc2 g1 g2 g3 =
- [ ((LQino (-g1), Sneutrino g2, D g3), FBF (-1, Psibar, SLR, Psi),
- G_LQ_EC_UC (false,M2,g1,g2,g3)) ]
-
- let yuk_lqino_ec_su1' g1 g2 g3 m =
- let cm = chg m in
- [ ((LQino (-g1), Sup (m,g3), L g2), FBF (1, Psibar, SLR, Psi),
- G_LQ_EC_UC (true,cm,g1,g2,g3)) ]
-
- let yuk_lqino_ec_su1 g1 g2 g3 =
- ThoList.flatmap (yuk_lqino_ec_su1' g1 g2 g3) [M1;M2]
-
- let yuk_lqino_ec_su2' g1 g2 g3 m =
- let cm = chg m in
- [ ((L (-g2), Sup (m,-g3), LQino (g1)), FBF (1, Psibar, SLR, Psi),
- G_LQ_EC_UC (false,cm,g1,g2,g3)) ]
-
- let yuk_lqino_ec_su2 g1 g2 g3 =
- ThoList.flatmap (yuk_lqino_ec_su2' g1 g2 g3) [M1;M2]
-
- let yuk_lqino_nc_sd1 g1 g2 g3 =
- [ ((LQino (-g1), Sdown (M1,g3), N g2), FBF (-1, Psibar, SLR, Psi),
- G_LQ_EC_UC (true,M2,g1,g2,g3)) ]
-
- let yuk_lqino_nc_sd2 g1 g2 g3 =
- [ ((N (-g2), Sdown (M1,-g3), LQino (g1)), FBF (-1, Psibar, SLR, Psi),
- G_LQ_EC_UC (false,M2,g1,g2,g3)) ]
-
- let yuk_lq_ec_uc' g1 g2 g3 m =
- [ ((L (-g2), LQ (m,g1), U (-g3)), BBB (1, Psibar, SLR, Psibar),
- G_LQ_EC_UC (false,m,g1,g2,g3)) ]
-
- let yuk_lq_ec_uc g1 g2 g3 =
- ThoList.flatmap (yuk_lq_ec_uc' g1 g2 g3) [M1;M2]
-
- let yuk_lq_ec_uc2' g1 g2 g3 m =
- [ ((L (g2), LQ (m,-g1), U (g3)), PBP (1, Psi, SLR, Psi),
- G_LQ_EC_UC (true,m,g1,g2,g3)) ]
-
- let yuk_lq_ec_uc2 g1 g2 g3 =
- ThoList.flatmap (yuk_lq_ec_uc2' g1 g2 g3) [M1;M2]
-
- let yuk_lq_nc_dc g1 g2 g3 =
- [ ((N (-g2), LQ (M2,g1), D (-g3)), BBB (-1, Psibar, SLR, Psibar),
- G_LQ_EC_UC (false,M2,g1,g2,g3)) ]
-
- let yuk_lq_nc_dc2 g1 g2 g3 =
- [ ((N (g2), LQ (M2,-g1), D (g3)), PBP (-1, Psi, SLR, Psi),
- G_LQ_EC_UC (true,M2,g1,g2,g3)) ]
-
-(*** Daniel Wiesler: LQ - F-Term w/ vev ***)
-
- let lq_se_su' g1 g2 g3 m1 m2 m3 =
- [ ((LQ (m1,g1), Slepton (m2,-g2), Sup (m3,-g3)), Scalar_Scalar_Scalar 1,
- G_LQ_SSU (m1,m2,m3,g1,g2,g3)) ]
-
- let lq_se_su g1 g2 g3 =
- List.flatten (Product.list3 (lq_se_su' g1 g2 g3) [M1;M2] [M1;M2] [M1;M2] )
-
- let lq_snu_sd' g1 g2 g3 m1 m2 =
- [ ((LQ (m1,g1), Sdown (m2,-g2), Sneutrino (-g3)), Scalar_Scalar_Scalar 1,
- G_LQ_SSD (m1,m2,g1,g2,g3)) ]
-
- let lq_snu_sd g1 g2 g3 =
- List.flatten (Product.list2 (lq_snu_sd' g1 g2 g3) [M1;M2] [M1;M2] )
-
-(*** Daniel Wiesler: LQ - Higgs ***)
-
- let lq_shiggs' g1 s g2 m1 m2 =
- [ ((LQ (m1,g1), SHiggs s, LQ (m2,-g2)), Scalar_Scalar_Scalar 1, G_LQ_S (m1,m2,g1,s,g2))]
-
- let lq_shiggs g1 s g2 =
- List.flatten ( Product.list2 (lq_shiggs' g1 s g2) [M1;M2] [M1;M2])
-
- let lq_phiggs' g1 p g2 m1 m2 =
- [ ((LQ (m1,g1), PHiggs p, LQ (m2,-g2)), Scalar_Scalar_Scalar 1, G_LQ_P (m1,m2,g1,p,g2))]
-
- let lq_phiggs g1 p g2 =
- List.flatten ( Product.list2 (lq_phiggs' g1 p g2) [M1;M2] [M1;M2])
-
- let yuk_lqino_shiggs g1 s g2 =
- [ ((LQino (-g1), SHiggs s, LQino g2), FBF (1, Psibar, SLR, Psi),
- G_YUK_LQ_S (g1,s,g2)) ]
-
- let yuk_lqino_phiggs g1 p g2 =
- [ ((LQino (-g1), PHiggs p, LQino g2), FBF (1, Psibar, SLR, Psi),
- G_YUK_LQ_P (g1,p,g2)) ]
-
-(*** Daniel Wiesler: LQ - Neutralinos. ***)
-
- let lqino_lq_neu' n g1 g2 m =
- [ ((Neutralino n, LQ (m,-g1), LQino g2), FBF (1, Chibar, SLR, Psi),
- G_LQ_NEU (m,g1,g2,n)) ]
-
- let lqino_lq_neu n g1 g2 =
- ThoList.flatmap (lqino_lq_neu' n g1 g2) [M1;M2]
-
- let lqino_lq_neu2' n g1 g2 m =
- [ ((LQino (-g2), LQ (m,g1), Neutralino n), FBF (1, Psibar, SLR, Chi),
- G_LQ_NEU (m,g1,g2,n)) ]
-
- let lqino_lq_neu2 n g1 g2 =
- ThoList.flatmap (lqino_lq_neu2' n g1 g2) [M1;M2]
-
-(*** Daniel Wiesler: LQ-LQino-Gluino ***)
- let lqino_lq_gg' g1 g2 m =
- [ ((Gluino, LQ (m,-g1), LQino g2), FBF (1, Chibar, SLR, Psi),
- G_LQ_GG (m,g1,g2)) ]
-
- let lqino_lq_gg g1 g2 =
- ThoList.flatmap (lqino_lq_gg' g1 g2) [M1;M2]
-
-(*** Daniel Wiesler: LQ - Gauge ***)
-
- let col_lqino_currents g =
- [ ((LQino (-g), Gl, LQino g), FBF ((-1), Psibar, V, Psi), Gs)]
-
- let neutr_lqino_current g =
- [ ((LQino (-g), Z, LQino g), FBF (1, Psibar, V, Psi), G_NLQC)]
-
- let col_lq_currents m g =
- [ ((Gl, LQ (m,-g), LQ (m,g)), Vector_Scalar_Scalar (-1), Gs)]
-
- let lq_neutr_Z g m1 m2 =
- [ ((Z, LQ (m1,-g), LQ (m2,g)), Vector_Scalar_Scalar (-1), G_ZLQ (g,m1,m2))]
-
- let em_lq_currents g m =
- [ ((Ga, LQ (m,-g), LQ (m,g)), Vector_Scalar_Scalar 1, Q_down)]
-
- let em_lqino_currents g =
- [ ((LQino (-g), Ga, LQino g), FBF (1, Psibar, V, Psi), Q_down)]
-
- let gluon2_lq2' g m =
- [ ((LQ (m,g), LQ (m,-g), Gl, Gl), Scalar2_Vector2 2, G_GlGlLQLQ)]
- let gluon2_lq2 g =
- ThoList.flatmap (gluon2_lq2' g) [M1;M2]
-
- let lq_gauge4' g m =
- [ ((Z, Z, LQ (m,g), LQ (m,-g)), Scalar2_Vector2 1, G_ZZLQLQ);
- ((Z, Ga, LQ (m,g), LQ (m,-g)), Scalar2_Vector2 1, G_ZPLQLQ);
- ((Ga, Ga, LQ (m,g), LQ (m,-g)), Scalar2_Vector2 1, G_PPLQLQ)]
-
- let lq_gauge4 g =
- ThoList.flatmap (lq_gauge4' g) [M1;M2]
-
- let lq_gg_gauge2' g m =
- [ ((Z, Gl, LQ (m,g), LQ (m,-g)), Scalar2_Vector2 1, G_ZGlLQLQ);
- ((Ga, Gl, LQ (m,g), LQ (m,-g)), Scalar2_Vector2 1, G_PGlLQLQ)]
-
- let lq_gg_gauge2 g =
- ThoList.flatmap (lq_gg_gauge2' g) [M1;M2]
-
-
-
- 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+. **FB*)
- 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. **FB*)
- 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. *)
-
-(* JR: Only the first charged Higgs. *)
-(*** REVISED: Compatible with CD+. ***)
-(*** Revision: 2005-03-10: first two vertices corrected. ***)
-(*** REVISED: Felix Braam: Compact version using new COMBOS*)
-(*** REVISED: Felix Braam: Couplings adjusted to FF-convention*)
- let gauge_higgs_WPC p=
- [ ((Wm, CHiggs HC1, PHiggs p), Vector_Scalar_Scalar 1, G_GH_WPC p);
- ((Wp, CHiggs HC1c, PHiggs p), Vector_Scalar_Scalar 1, G_GH_WPC p)]
- let gauge_higgs_WSC s=
- [((Wm, CHiggs HC1, SHiggs s),Vector_Scalar_Scalar 1, G_GH_WSC s);
- ((Wp, CHiggs HC1c, SHiggs s),Vector_Scalar_Scalar (-1), G_GH_WSC s)]
- let gauge_higgs_ZSP s p =
- [((Z, SHiggs s, PHiggs p),Vector_Scalar_Scalar 1, G_GH_ZSP (s,p))]
- let gauge_higgs_WWS s=
- ((SHiggs s, Wp, Wm),Scalar_Vector_Vector 1, G_GH_WWS s)
- let gauge_higgs_ZZS s=
- ((SHiggs s, Z, Z), Scalar_Vector_Vector 1, G_GH_ZZS s)
- let gauge_higgs_ZCC =
- ((Z, CHiggs HC1, CHiggs HC1c),Vector_Scalar_Scalar 1, G_GH_ZCC )
- let gauge_higgs_GaCC =
- ((Ga, CHiggs HC1, CHiggs HC1c),Vector_Scalar_Scalar 1, G_GH_GaCC )
-
- let gauge_higgs =
- ThoList.flatmap gauge_higgs_WPC [P1;P2] @
- ThoList.flatmap gauge_higgs_WSC [S1;S2;S3] @
- List.flatten (Product.list2 gauge_higgs_ZSP [S1;S2;S3] [P1;P2]) @
- List.map gauge_higgs_WWS [S1;S2;S3] @
- List.map gauge_higgs_ZZS [S1;S2;S3] @
- [gauge_higgs_ZCC] @ [gauge_higgs_GaCC]
-
-(*** REVISED: Compact version using new COMBOS*)
-(*** REVISED: Couplings adjusted to FF-convention*)
-
- let gauge_higgs4_ZZPP (p1,p2) =
- ((PHiggs p1, PHiggs p2, Z, Z), Scalar2_Vector2 1, G_GH4_ZZPP (p1,p2))
-
- let gauge_higgs4_ZZSS (s1,s2) =
- ((SHiggs s1, SHiggs s2 , Z, Z), Scalar2_Vector2 1, G_GH4_ZZSS (s1,s2))
-
-(* JR: Only the first charged Higgs. *)
- let gauge_higgs4_ZZCC =
- ((CHiggs HC1, CHiggs HC1c, Z, Z), Scalar2_Vector2 1, G_GH4_ZZCC)
-
- let gauge_higgs4_GaGaCC =
- ((CHiggs HC1, CHiggs HC1c, Ga, Ga), Scalar2_Vector2 1, G_GH4_GaGaCC)
-
- let gauge_higgs4_ZGaCC =
- ((CHiggs HC1, CHiggs HC1c, Ga, Z), Scalar2_Vector2 1, G_GH4_ZGaCC )
-
- let gauge_higgs4_WWCC =
- ((CHiggs HC1, CHiggs HC1c, Wp, Wm), Scalar2_Vector2 1, G_GH4_WWCC )
-
- let gauge_higgs4_WWPP (p1,p2) =
- ((PHiggs p1, PHiggs p2, Wp, Wm), Scalar2_Vector2 1, G_GH4_WWPP (p1,p2))
-
- let gauge_higgs4_WWSS (s1,s2) =
- ((SHiggs s1, SHiggs s2, Wp, Wm), Scalar2_Vector2 1, G_GH4_WWSS (s1,s2))
-
-(* JR: Only the first charged Higgs. *)
- let gauge_higgs4_ZWSC s =
- [ ((CHiggs HC1, SHiggs s, Wm, Z), Scalar2_Vector2 1, G_GH4_ZWSC s);
- ((CHiggs HC1c, SHiggs s, Wp, Z), Scalar2_Vector2 1, G_GH4_ZWSC s)]
-
- let gauge_higgs4_GaWSC s =
- [ ((CHiggs HC1, SHiggs s, Wm, Ga), Scalar2_Vector2 1, G_GH4_GaWSC s);
- ((CHiggs HC1c, SHiggs s, Wp, Ga), Scalar2_Vector2 1, G_GH4_GaWSC s) ]
-
- let gauge_higgs4_ZWPC p =
- [ ((CHiggs HC1, PHiggs p, Wm, Z), Scalar2_Vector2 1, G_GH4_ZWPC p);
- ((CHiggs HC1c, PHiggs p, Wp, Z), Scalar2_Vector2 (-1), G_GH4_ZWPC p)]
-
- let gauge_higgs4_GaWPC p =
- [ ((CHiggs HC1, PHiggs p, Wm, Ga), Scalar2_Vector2 1, G_GH4_GaWPC p);
- ((CHiggs HC1c, PHiggs p, Wp, Ga), Scalar2_Vector2 (-1),
- G_GH4_GaWPC p) ]
-
- let gauge_higgs4 =
- List.map gauge_higgs4_ZZPP (pairs [P1;P2]) @
- List.map gauge_higgs4_ZZSS (pairs [S1;S2;S3]) @
- [gauge_higgs4_ZZCC] @ [gauge_higgs4_GaGaCC] @
- [gauge_higgs4_ZGaCC] @ [gauge_higgs4_WWCC] @
- List.map gauge_higgs4_WWPP (pairs [P1;P2]) @
- List.map gauge_higgs4_WWSS (pairs [S1;S2;S3]) @
- ThoList.flatmap gauge_higgs4_ZWSC [S1;S2;S3] @
- ThoList.flatmap gauge_higgs4_GaWSC [S1;S2;S3] @
- ThoList.flatmap gauge_higgs4_ZWPC [P1;P2] @
- ThoList.flatmap gauge_higgs4_GaWPC [P1;P2]
-
-(*** Added by Felix Braam. ***)
- 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)) ]
-
-
-(*** Modified by Felix Braam. ***)
- 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])
-
-(*** Modified by Felix Braam. ***)
- 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) ]
-
-(*** Modified by Felix Braam. ***)
- 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]
-
-
-(* JR: Only the first charged Higgs. *)
-(*** REVISED: Independent of the sign of CD. ***)
-(*** REVISED: Felix Braam: Compact version using new COMBOS *)
-(*** REVISED: Felix Braam: Couplings adjusted to FF-convention *)
- let higgs_SCC s =
- ((CHiggs HC1, CHiggs HC1c, SHiggs s), Scalar_Scalar_Scalar 1,
- G_H3_SCC s )
- let higgs_SSS (s1,s2,s3)=
- ((SHiggs s1, SHiggs s2, SHiggs s3), Scalar_Scalar_Scalar 1,
- G_H3_SSS (s1,s2,s3))
- let higgs_SPP (p1,p2,s) =
- ((SHiggs s, PHiggs p1, PHiggs p2), Scalar_Scalar_Scalar 1,
- G_H3_SPP (s,p1,p2))
-
- let higgs =
- List.map higgs_SCC [S1;S2;S3]@
- List.map higgs_SSS (triples [S1;S2;S3])@
- List.map higgs_SPP (two_and_one [P1;P2] [S1;S2;S3])
-
-
- let higgs4 = []
-(* 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. *)
-
-(* JR: Only the first charged Higgs. *)
-(*** REVISED: Independent of the sign of CD. ***)
- let higgs_sneutrino' s g =
- ((SHiggs s, Sneutrino g, Sneutrino (-g)), Scalar_Scalar_Scalar 1,
- G_SFSFS (s,SN,g,M1,M1))
- let higgs_sneutrino'' g m =
- [((CHiggs HC1, Sneutrino (-g), Slepton (m,g)),
- Scalar_Scalar_Scalar 1, G_HSNSL (false,g,m));
- ((CHiggs HC1c, Sneutrino g, Slepton (m,-g)), Scalar_Scalar_Scalar 1,
- G_HSNSL (true,g,m))]
- let higgs_sneutrino =
- Product.list2 higgs_sneutrino' [S1;S2;S3] [1;2;3] @
- List.flatten ( Product.list2 higgs_sneutrino'' [1;2;3] [M1;M2] )
-
-
-(* 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_S s g m1 m2 =
- [ ((SHiggs s, Slepton (m1,g), Slepton (m2,-g)), Scalar_Scalar_Scalar 1,
- G_SFSFS (s,SL,g,m1,m2));
- ((SHiggs s, Sup (m1,g), Sup (m2,-g)), Scalar_Scalar_Scalar 1,
- G_SFSFS (s,SU,g,m1,m2));
- ((SHiggs s, Sdown (m1,g), Sdown (m2,-g)), Scalar_Scalar_Scalar 1,
- G_SFSFS (s,SD,g,m1,m2))]
-
- let higgs_sfermion' g m1 m2 =
- (higgs_sfermion_S S1 g m1 m2) @ (higgs_sfermion_S S2 g m1 m2) @ (higgs_sfermion_S S3 g m1 m2)
-
- let higgs_sfermion_P p g m1 m2 =
- [ ((PHiggs p, Slepton (m1,g), Slepton (m2,-g)), Scalar_Scalar_Scalar 1,
- G_SFSFP (p,SL,g,m1,m2));
- ((PHiggs p, Sup (m1,g), Sup (m2,-g)), Scalar_Scalar_Scalar 1,
- G_SFSFP (p,SU,g,m1,m2));
- ((PHiggs p, Sdown (m1,g), Sdown (m2,-g)), Scalar_Scalar_Scalar 1,
- G_SFSFP (p,SD,g,m1,m2)) ]
-
- let higgs_sfermion'' g m1 m2 =
- (higgs_sfermion_P P1 g m1 m2) @ (higgs_sfermion_P P2 g m1 m2)
- let higgs_sfermion = List.flatten (Product.list3 higgs_sfermion' [1;2;3] [M1;M2] [M1;M2]) @
- List.flatten (Product.list3 higgs_sfermion'' [1;2;3] [M1;M2] [M1;M2])
-
-(* JR: Only the first charged Higgs. *)
-(*** REVISED: Independent of the sign of CD. ***)
- let higgs_squark' g h m1 m2 =
- [ ((CHiggs HC1, Sup (m1,-g), Sdown (m2,h)), Scalar_Scalar_Scalar 1,
- G_HSUSD (false,m1,m2,g,h));
- ((CHiggs HC1c, 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;N5]
- [C1;C2]) @ triple_gauge @
- ThoList.flatmap neutral_Z (pairs [N1;N2;N3;N4;N5]) @
- 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;N5] [C1;C2]) @
- higgs_neutr @ higgs_sneutrino @ higgs_sfermion @
- higgs_squark @ yukawa_v @
- ThoList.flatmap col_currents [1;2;3] @
- List.flatten (Product.list2 col_sfermion_currents [1;2;3] [M1;M2])) @
- List.flatten (Product.list2 col_lq_currents [M1;M2] [1;2;3]) @
- ThoList.flatmap col_lqino_currents [1;2;3] @
- ThoList.flatmap em_lqino_currents [1;2;3] @
- ThoList.flatmap neutr_lqino_current [1;2;3] @
- List.flatten (Product.list3 yuk_lqino_se_uc1 [1;2;3] [1;2;3] [1;2;3]) @
- List.flatten (Product.list3 yuk_lqino_se_uc2 [1;2;3] [1;2;3] [1;2;3]) @
- List.flatten (Product.list3 yuk_lqino_ec_su1 [1;2;3] [1;2;3] [1;2;3]) @
- List.flatten (Product.list3 yuk_lqino_ec_su2 [1;2;3] [1;2;3] [1;2;3]) @
- List.flatten (Product.list3 yuk_lqino_sn_dc1 [1;2;3] [1;2;3] [1;2;3]) @
- List.flatten (Product.list3 yuk_lqino_sn_dc2 [1;2;3] [1;2;3] [1;2;3]) @
- List.flatten (Product.list3 yuk_lqino_nc_sd1 [1;2;3] [1;2;3] [1;2;3]) @
- List.flatten (Product.list3 yuk_lqino_nc_sd2 [1;2;3] [1;2;3] [1;2;3]) @
- List.flatten (Product.list3 yuk_lq_ec_uc [1;2;3] [1;2;3] [1;2;3]) @
- List.flatten (Product.list3 yuk_lq_ec_uc2 [1;2;3] [1;2;3] [1;2;3]) @
- List.flatten (Product.list3 yuk_lq_nc_dc [1;2;3] [1;2;3] [1;2;3]) @
- List.flatten (Product.list3 yuk_lq_nc_dc2 [1;2;3] [1;2;3] [1;2;3]) @
- List.flatten (Product.list3 lq_neutr_Z [1;2;3] [M1;M2] [M1;M2]) @
- List.flatten (Product.list2 em_lq_currents [1;2;3] [M1;M2]) @
- List.flatten (Product.list3 lq_shiggs [1;2;3] [S1;S2;S3;S4;S5;S6;S7;S8;S9] [1;2;3]) @
- List.flatten (Product.list3 lq_phiggs [1;2;3] [P1;P2;P3;P4;P5;P6;P7] [1;2;3]) @
- List.flatten (Product.list3 yuk_lqino_shiggs [1;2;3] [S1;S2;S3;S4;S5;S6;S7;S8;S9] [1;2;3]) @
- List.flatten (Product.list3 yuk_lqino_phiggs [1;2;3] [P1;P2;P3;P4;P5;P6;P7] [1;2;3]) @
- List.flatten (Product.list3 lqino_lq_neu nlist [1;2;3] [1;2;3]) @
- List.flatten (Product.list3 lqino_lq_neu2 nlist [1;2;3] [1;2;3]) @
- List.flatten (Product.list3 lq_se_su [1;2;3] [1;2;3] [1;2;3]) @
- List.flatten (Product.list3 lq_snu_sd [1;2;3] [1;2;3] [1;2;3]) @
- List.flatten (Product.list2 lqino_lq_gg [1;2;3] [1;2;3])
-
-(* 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] @
- ThoList.flatmap gluon2_lq2 [1;2;3] @
- ThoList.flatmap lq_gauge4 [1;2;3] @
- ThoList.flatmap lq_gg_gauge2 [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
-
-
-(*SLHA2-Nomenclature for neutral Higgses*)
- 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
- | "h01" -> SHiggs S1 | "h02" -> SHiggs S2 | "h03" -> SHiggs S3
- | "A01" -> PHiggs P1 | "A02" -> PHiggs P2
- | "h04" -> SHiggs S4 | "h05" -> SHiggs S5 | "h06" -> SHiggs S6
- | "A03" -> PHiggs P3 | "A04" -> PHiggs P4
- | "h07" -> SHiggs S7 | "h08" -> SHiggs S8 | "h09" -> SHiggs S9
- | "A05" -> PHiggs P5 | "A06" -> PHiggs P6 | "A07" -> PHiggs P7
-(* JR: Only the first charged Higgs. *)
- | "H+" -> CHiggs HC1 | "H-" -> CHiggs HC1c
- | "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
- | "neu5" -> Neutralino N5 | "neu6" -> Neutralino N6
- | "neu7" -> Neutralino N7 | "neu8" -> Neutralino N8
- | "neu9" -> Neutralino N9 | "neu10" -> Neutralino N10
- | "neu11" -> Neutralino N11
- | "ch1+" -> Chargino C1 | "ch2+" -> Chargino C2
- | "ch1-" -> Chargino C1c | "ch2-" -> Chargino C2c
- | "ch3+" -> Chargino C3 | "ch4+" -> Chargino C4
- | "ch3-" -> Chargino C3c | "ch4-" -> Chargino C4c
- | "lq11" -> LQ (M1,1) | "lq11c" -> LQ (M1,-1)
- | "lq12" -> LQ (M2,1) | "lq12c" -> LQ (M2,-1)
- | "lq21" -> LQ (M1,2) | "lq21c" -> LQ (M1,-2)
- | "lq22" -> LQ (M2,2) | "lq22c" -> LQ (M2,-2)
- | "lq31" -> LQ (M1,3) | "lq31c" -> LQ (M1,-3)
- | "lq32" -> LQ (M2,3) | "lq32c" -> LQ (M2,-3)
- | "lqino1" -> LQino 1 | "lqino1b" -> LQino (-1)
- | "lqino2" -> LQino 2 | "lqino2b" -> LQino (-2)
- | "lqino3" -> LQino 3 | "lqino3b" -> LQino (-3)
- | s -> invalid_arg ("HUBABUBA: %s Models.ExtMSSM.flavor_of_string:" ^ s)
-
- 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-"
- | SHiggs S1 -> "h01" | SHiggs S2 -> "h02" | SHiggs S3 -> "h03"
- | PHiggs P1 -> "A01" | PHiggs P2 -> "A02"
- | SHiggs S4 -> "h04" | SHiggs S5 -> "h05" | SHiggs S6 -> "h06"
- | PHiggs P3 -> "A03" | PHiggs P4 -> "A04"
- | SHiggs S7 -> "h07" | SHiggs S8 -> "h08" | SHiggs S9 -> "h09"
- | PHiggs P5 -> "A05" | PHiggs P6 -> "A06" | PHiggs P7 -> "A07"
-(* JR: Only the first charged Higgs. *)
- | CHiggs HC1 -> "H+" | CHiggs HC1c -> "H-"
- | CHiggs HC2 -> "HX_1+" | CHiggs HC2c -> "HX_1-"
- | CHiggs HC3 -> "HX_2+" | CHiggs HC3c -> "HX_2-"
- | CHiggs HC4 -> "HX_3+" | CHiggs HC4c -> "HX_3-"
- | CHiggs HC5 -> "HX_4+" | CHiggs HC5c -> "HX_4-"
- | 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 n -> "neu" ^ string_of_neu n
- | Chargino C1 -> "ch1+" | Chargino C1c -> "ch1-"
- | Chargino C2 -> "ch2+" | Chargino C2c -> "ch2-"
- | Chargino C3 -> "ch3+" | Chargino C3c -> "ch3-"
- | Chargino C4 -> "ch4+" | Chargino C4c -> "ch4-"
- | LQ (M1,1) -> "lq11" | LQ (M1,-1) -> "lq11c"
- | LQ (M2,1) -> "lq12" | LQ (M2,-1) -> "lq12c"
- | LQ (M1,2) -> "lq21" | LQ (M1,-2) -> "lq21c"
- | LQ (M2,2) -> "lq22" | LQ (M2,-2) -> "lq22c"
- | LQ (M1,3) -> "lq31" | LQ (M1,-3) -> "lq31c"
- | LQ (M2,3) -> "lq32" | LQ (M2,-3) -> "lq32c"
- | LQino 1 -> "lqino1" | LQino (-1) -> "lqino1b"
- | LQino 2 -> "lqino2" | LQino (-2) -> "lqino2b"
- | LQino 3 -> "lqino3" | LQino (-3) -> "lqino3b"
- | _ -> invalid_arg "Models.ExtMSSM.flavor_to_string"
-
- let flavor_to_TeX = function
- | L 1 -> "e^-" | L (-1) -> "e^+"
- | L 2 -> "\\mu^-" | L (-2) -> "\\mu^+"
- | L 3 -> "\\tau^-" | L (-3) -> "\\tau^+"
- | N 1 -> "\\nu_e" | N (-1) -> "\\bar{\\nu}_e"
- | N 2 -> "\\nu_\\mu" | N (-2) -> "\\bar{\\nu}_\\mu"
- | N 3 -> "\\nu_\\tau" | N (-3) -> "\\bar{\\nu}_\\tau"
- | U 1 -> "u" | U (-1) -> "\\bar{u}"
- | U 2 -> "c" | U (-2) -> "\\bar{c}"
- | U 3 -> "t" | U (-3) -> "\\bar{t}"
- | D 1 -> "d" | D (-1) -> "\\bar{d}"
- | D 2 -> "s" | D (-2) -> "\\bar{s}"
- | D 3 -> "b" | D (-3) -> "\\bar{b}"
- | L _ -> invalid_arg
- "Models.ExtMSSM.flavor_to_TeX: invalid lepton"
- | N _ -> invalid_arg
- "Models.ExtMSSM.flavor_to_TeX: invalid neutrino"
- | U _ -> invalid_arg
- "Models.ExtMSSM.flavor_to_TeX: invalid up type quark"
- | D _ -> invalid_arg
- "Models.ExtMSSM.flavor_to_TeX: invalid down type quark"
- | Gl -> "g" | Gluino -> "\\widetilde{g}"
- | Ga -> "\\gamma" | Z -> "Z" | Wp -> "W^+" | Wm -> "W^-"
- | SHiggs S1 -> "S_1" | SHiggs S2 -> "S_2" | SHiggs S3 -> "S_3"
- | SHiggs S4 -> "S_4" | SHiggs S5 -> "S_5" | SHiggs S6 -> "S_6"
- | SHiggs S7 -> "S_7" | SHiggs S8 -> "S_8" | SHiggs S9 -> "S_9"
- | PHiggs P1 -> "P_1" | PHiggs P2 -> "P_2" | PHiggs P3 -> "P_3"
- | PHiggs P4 -> "P_4" | PHiggs P5 -> "P_5" | PHiggs P6 -> "P_6"
- | PHiggs P7 -> "P_7"
- | CHiggs HC1 -> "H^+" | CHiggs HC1c -> "H^-"
- | CHiggs HC2 -> "X_{H,1}^+" | CHiggs HC2c -> "X_{H,1}^-"
- | CHiggs HC3 -> "X_{H,2}^+" | CHiggs HC3c -> "X_{H,2}^-"
- | CHiggs HC4 -> "X_{H,3}^+" | CHiggs HC4c -> "X_{H,3}^-"
- | CHiggs HC5 -> "X_{H,4}^+" | CHiggs HC5c -> "X_{H,4}^-"
- | Slepton (M1,1) -> "\\widetilde{e}_1^-"
- | Slepton (M1,-1) -> "\\widetilde{e}_1^+"
- | Slepton (M1,2) -> "\\widetilde{\\mu}_1^-"
- | Slepton (M1,-2) -> "\\widetilde{\\mu}_1^+"
- | Slepton (M1,3) -> "\\widetilde{\\tau}_1^-"
- | Slepton (M1,-3) -> "\\widetilde{\\tau}_1^+"
- | Slepton (M2,1) -> "\\widetilde{e}_2^-"
- | Slepton (M2,-1) -> "\\widetilde{e}_2^+"
- | Slepton (M2,2) -> "\\widetilde{\\mu}_2^-"
- | Slepton (M2,-2) -> "\\widetilde{\\mu}_2^+"
- | Slepton (M2,3) -> "\\widetilde{\\tau}_2^-"
- | Slepton (M2,-3) -> "\\widetilde{\\tau}_2^+"
- | Sneutrino 1 -> "\\widetilde{\\nu}_e"
- | Sneutrino (-1) -> "\\widetilde{\\nu}_e^*"
- | Sneutrino 2 -> "\\widetilde{\\nu}_\\mu"
- | Sneutrino (-2) -> "\\widetilde{\\nu}_\\mu^*"
- | Sneutrino 3 -> "\\widetilde{\\nu}_\\tau"
- | Sneutrino (-3) -> "\\widetilde{\\nu}_\\tau^*"
- | Sup (M1,1) -> "\\widetilde{u}_1"
- | Sup (M1,-1) -> "\\widetilde{u}_1^*"
- | Sup (M1,2) -> "\\widetilde{c}_1"
- | Sup (M1,-2) -> "\\widetilde{c}_1^*"
- | Sup (M1,3) -> "\\widetilde{t}_1"
- | Sup (M1,-3) -> "\\widetilde{t}_1^*"
- | Sup (M2,1) -> "\\widetilde{u}_2"
- | Sup (M2,-1) -> "\\widetilde{u}_2^*"
- | Sup (M2,2) -> "\\widetilde{c}_2"
- | Sup (M2,-2) -> "\\widetilde{c}_2^*"
- | Sup (M2,3) -> "\\widetilde{t}_2"
- | Sup (M2,-3) -> "\\widetilde{t}_2^*"
- | Sdown (M1,1) -> "\\widetilde{d}_1"
- | Sdown (M1,-1) -> "\\widetilde{d}_1^*"
- | Sdown (M1,2) -> "\\widetilde{s}_1"
- | Sdown (M1,-2) -> "\\widetilde{s}_1^*"
- | Sdown (M1,3) -> "\\widetilde{b}_1"
- | Sdown (M1,-3) -> "\\widetilde{b}_1^*"
- | Sdown (M2,1) -> "\\widetilde{d}_2"
- | Sdown (M2,-1) -> "\\widetilde{d}_2^*"
- | Sdown (M2,2) -> "\\widetilde{s}_2"
- | Sdown (M2,-2) -> "\\widetilde{s}_2^*"
- | Sdown (M2,3) -> "\\widetilde{b}_2"
- | Sdown (M2,-3) -> "\\widetilde{b}_2^*"
- | Neutralino N1 -> "\\widetilde{\\chi}^0_1"
- | Neutralino N2 -> "\\widetilde{\\chi}^0_2"
- | Neutralino N3 -> "\\widetilde{\\chi}^0_3"
- | Neutralino N4 -> "\\widetilde{\\chi}^0_4"
- | Neutralino N5 -> "\\widetilde{\\chi}^0_5"
- | Neutralino N6 -> "\\widetilde{\\chi}^0_6"
- | Neutralino N7 -> "\\widetilde{\\chi}^0_7"
- | Neutralino N8 -> "\\widetilde{\\chi}^0_8"
- | Neutralino N9 -> "\\widetilde{\\chi}^0_9"
- | Neutralino N10 -> "\\widetilde{\\chi}^0_{10}"
- | Neutralino N11 -> "\\widetilde{\\chi}^0_{11}"
- | Slepton _ -> invalid_arg
- "Models.ExtMSSM.flavor_to_TeX: invalid slepton"
- | Sneutrino _ -> invalid_arg
- "Models.ExtMSSM.flavor_to_TeX: invalid sneutrino"
- | Sup _ -> invalid_arg
- "Models.ExtMSSM.flavor_to_TeX: invalid up type squark"
- | Sdown _ -> invalid_arg
- "Models.ExtMSSM.flavor_to_TeX: invalid down type squark"
- | Chargino C1 -> "\\widetilde{\\chi}_1^+"
- | Chargino C1c -> "\\widetilde{\\chi}_1^-"
- | Chargino C2 -> "\\widetilde{\\chi}_2^+"
- | Chargino C2c -> "\\widetilde{\\chi}_2^-"
- | Chargino C3 -> "\\widetilde{\\chi}_3^+"
- | Chargino C3c -> "\\widetilde{\\chi}_3^-"
- | Chargino C4 -> "\\widetilde{\\chi}_4^+"
- | Chargino C4c -> "\\widetilde{\\chi}_4^-"
- | LQ (M1,1) -> "D_{1,,1}" | LQ (M1,-1) -> "D_{1,,1}^*"
- | LQ (M2,1) -> "D_{1,,2}" | LQ (M2,-1) -> "D_{1,,2}^*"
- | LQ (M1,2) -> "D_{2,,1}" | LQ (M1,-2) -> "D_{2,,1}^*"
- | LQ (M2,2) -> "D_{2,,2}" | LQ (M2,-2) -> "D_{2,,2}^*"
- | LQ (M1,3) -> "D_{3,,1}" | LQ (M1,-3) -> "D_{3,,1}^*"
- | LQ (M2,3) -> "D_{3,,2}" | LQ (M2,-3) -> "D_{3,,2}^*"
- | LQino 1 -> "\\widetilde{D}_1" | LQino (-1) -> "\\bar\\widetilde{D}_1"
- | LQino 2 -> "\\widetilde{D}_2" | LQino (-2) -> "\\bar\\widetilde{D}_2"
- | LQino 3 -> "\\widetilde{D}_3" | LQino (-3) -> "\\bar\\widetilde{D}_3"
- | LQ _ -> invalid_arg
- "Models.ExtMSSM.flavor_to_TeX: invalid leptoquark type"
- | LQino _ -> invalid_arg
- "Models.ExtMSSM.flavor_to_TeX: invalid leptoquarkino type"
-
- 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"
- | SHiggs s -> "h0" ^ (string_of_shiggs s)
- | PHiggs p -> "A0" ^ (string_of_phiggs p)
- | CHiggs HC1 -> "hp" | CHiggs HC1c -> "hm"
- | CHiggs _ -> invalid_arg "charged Higgs not yet implemented"
- | LQ (M1,g) when g > 0 -> "lq" ^ string_of_int g ^ "1"
- | LQ (M1,g) -> "lq" ^ string_of_int (abs g) ^ "1c"
- | LQ (M2,g) when g > 0 -> "lq" ^ string_of_int g ^ "2"
- | LQ (M2,g) -> "lq" ^ string_of_int (abs g) ^ "2c"
- | LQino g when g > 0 -> "lqino" ^ string_of_int g
- | LQino g -> "lqino" ^ string_of_int (abs g) ^ "b"
-
- let flavor_sans_color_of_string = flavor_of_string
- let flavor_sans_color_to_string = flavor_to_string
- let flavor_sans_color_to_TeX = flavor_to_TeX
- 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)
- | SHiggs S1 -> 25 | SHiggs S2 -> 35 | PHiggs P1 -> 36
-(* JR: Only the first charged Higgs. *)
- | CHiggs HC1 -> 37 | CHiggs HC1c -> (-37)
- | CHiggs _ -> invalid_arg "charged Higgs not yet implemented"
- | 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
-(* JR: only the first two charginos. *)
- | Chargino C1 -> 1000024 | Chargino C1c -> (-1000024)
- | Chargino C2 -> 1000037 | Chargino C2c -> (-1000037)
- | Chargino C3 -> 1000039 | Chargino C3c -> (-1000039)
- | Chargino C4 -> 1000041 | Chargino C4c -> (-1000041)
- | Neutralino N1 -> 1000022 | Neutralino N2 -> 1000023
- | Neutralino N3 -> 1000025 | Neutralino N4 -> 1000035
-(* According to SLHA2 (not anymore ?!?)*)
- | Neutralino N5 -> 1000045 | Neutralino N6 -> 1000046
- | Neutralino N7 -> 1000047 | Neutralino N8 -> 1000048
- | Neutralino N9 -> 1000049 | Neutralino N10 -> 1000050
- | Neutralino N11 -> 1000051
- | PHiggs P2 -> 46 | PHiggs P3 -> 47 | PHiggs P4 -> 48
- | PHiggs P5 -> 49 | PHiggs P6 -> 50 | PHiggs P7 -> 51
- | SHiggs S3 -> 45 | SHiggs S4 -> 52 | SHiggs S5 -> 53
- | SHiggs S6 -> 54 | SHiggs S7 -> 55 | SHiggs S8 -> 56
- | SHiggs S9 -> 57
- | LQ (M1,g) when g > 0 -> 1000059 + g
- | LQ (M1,g) -> - 1000059 + g
- | LQ (M2,g) when g > 0 -> 2000059 + g
- | LQ (M2,g) -> - 2000059 + g
- | LQino g when g > 0 -> 59 + g
- | LQino g -> -59 + g
-
-(* 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 5 & 69 \\\hline
- $\tilde{\chi4}^+_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)
- | SHiggs S1 -> 25 | SHiggs S2 -> 35 | PHiggs P1 -> 36
-(* JR: Only the first charged Higgs. *)
- | CHiggs HC1 -> 37 | CHiggs HC1c -> (-37)
- | CHiggs _ -> invalid_arg "charged Higgs not yet implemented"
- | 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
-(* JR: Only the first two charginos. *)
- | Chargino C1 -> 70 | Chargino C1c -> (-70)
- | Chargino C2 -> 71 | Chargino C2c -> (-71)
- | Chargino C3 -> 106 | Chargino C3c -> (-106)
- | Chargino C4 -> 107 | Chargino C4c -> (-107)
- | Neutralino N1 -> 65 | Neutralino N2 -> 66
- | Neutralino N3 -> 67 | Neutralino N4 -> 68
- | Neutralino N5 -> 69 | Neutralino N6 -> 100
- | Neutralino N7 -> 101 | Neutralino N8 -> 102
- | Neutralino N9 -> 103 | Neutralino N10 -> 104
- | Neutralino N11 -> 105
- | PHiggs P2 -> 72 | PHiggs P3 -> 89 | PHiggs P4 -> 90
- | PHiggs P5 -> 91 | PHiggs P6 -> 92 | PHiggs P7 -> 93
- | SHiggs S3 -> 73 | SHiggs S4 -> 94 | SHiggs S5 -> 95
- | SHiggs S6 -> 96 | SHiggs S7 -> 97 | SHiggs S8 -> 98
- | SHiggs S9 -> 99
- | LQ (M1,g) when g > 0 -> 78 + 2*g
- | LQ (M1,g) -> - 78 + 2*g
- | LQ (M2,g) when g > 0 -> 79 + 2*g
- | LQ (M2,g) -> - 79 + 2*g
- | LQino g when g > 0 -> 85 + g
- | LQino g -> - 85 + g
-
- 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
- | E -> "e" | G -> "g" | G_Z -> "gz"
- | Q_lepton -> "qlep" | Q_up -> "qup" | Q_down -> "qdwn"
- | Q_charg -> "qchar"
- | 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, "g_ccq" ) ^ "("
- ^ 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_GH4_ZZPP (p1,p2) -> "g_ZZA0A0(" ^ string_of_phiggs p1 ^ "," ^
- string_of_phiggs p2 ^ ")"
- | G_GH4_ZZSS (s1,s2) -> "g_ZZh0h0(" ^ string_of_shiggs s1 ^ "," ^
- string_of_shiggs s2 ^ ")"
- | G_GH4_ZZCC -> "g_zzhphm"
- | G_GH4_GaGaCC -> "g_AAhphm"
- | G_GH4_ZGaCC -> "g_zAhphm"
- | G_GH4_WWCC -> "g_wwhphm"
- | G_GH4_WWPP (p1,p2) -> "g_WWA0A0(" ^ string_of_phiggs p1 ^ "," ^
- string_of_phiggs p2 ^ ")"
- | G_GH4_WWSS (s1,s2) -> "g_WWh0h0(" ^ string_of_shiggs s1 ^ "," ^
- string_of_shiggs s2 ^ ")"
- | G_GH4_ZWSC s -> "g_ZWhph0(" ^ string_of_shiggs s ^")"
- | G_GH4_GaWSC s -> "g_AWhph0(" ^ string_of_shiggs s ^")"
- | G_GH4_ZWPC p -> "g_ZWhpA0(" ^ string_of_phiggs p ^")"
- | G_GH4_GaWPC p -> "g_AWhpA0(" ^ string_of_phiggs p ^")"
- | G_CICIS (n1,n2,s) -> "g_neuneuh0(" ^ string_of_neu n1 ^ "," ^
- string_of_neu n2 ^ "," ^ string_of_shiggs s ^ ")"
- | G_CICIP (n1,n2,p) -> "g_neuneuA0(" ^ string_of_neu n1 ^ "," ^
- string_of_neu n2 ^ "," ^ string_of_phiggs p ^ ")"
- | G_H3_SCC s -> "g_h0hphm(" ^ string_of_shiggs s ^ ")"
- | G_H3_SPP (s,p1,p2) -> "g_h0A0A0(" ^ string_of_shiggs s ^ "," ^
- string_of_phiggs p1 ^ "," ^ string_of_phiggs p2 ^ ")"
- | G_H3_SSS (s1,s2,s3) -> "g_h0h0h0(" ^ string_of_shiggs s1 ^ "," ^
- string_of_shiggs s2 ^ "," ^ string_of_shiggs s3 ^ ")"
- | G_CSC (c1,c2,s) -> "g_chchh0(" ^ string_of_char c1 ^ "," ^
- string_of_char c2 ^ "," ^ string_of_shiggs s ^ ")"
- | G_CPC (c1,c2,p) -> "g_chchA0(" ^ string_of_char c1 ^ "," ^
- string_of_char c2 ^ "," ^ string_of_phiggs p ^")"
- | G_YUK_FFS (f1,f2,s) -> "g_yuk_h0_" ^ string_of_fermion_type f1 ^
- string_of_fermion_type f2 ^ "(" ^ string_of_shiggs s ^ "," ^
- string_of_fermion_gen f1 ^ ")"
- | G_YUK_FFP (f1,f2,p) -> "g_yuk_A0_" ^ string_of_fermion_type f1 ^
- string_of_fermion_type f2 ^ "(" ^ string_of_phiggs p ^ "," ^
- string_of_fermion_gen f1 ^ ")"
- | G_YUK_LCN g -> "g_yuk_hp_ln(" ^ string_of_int g ^ ")"
- | G_NWC (n,c) -> "g_nwc(" ^ string_of_char c ^ "," ^ string_of_neu n ^ ")"
- | G_CWN (c,n) -> "g_cwn(" ^ string_of_char c ^ "," ^ string_of_neu n ^ ")"
- | G_SLSNW (vc,g,m) -> conj_symbol (vc, "g_wslsn") ^ "(" ^ string_of_int g
- ^ "," ^ string_of_sfm m ^ ")"
- | G_NZN (n1,n2) -> "g_zneuneu(" ^ string_of_neu n1 ^ ","
- ^ string_of_neu n2 ^ ")"
- | G_CZC (c1,c2) -> "g_zchch(" ^ string_of_char c1 ^ ","
- ^ string_of_char c2 ^ ")"
- | Gs -> "gs"
- | G_YUK_UCD (n,m) -> "g_yuk_hp_ud(" ^ string_of_int n ^ "," ^
- string_of_int m ^ ")"
- | G_YUK_DCU (n,m) -> "g_yuk_hm_du(" ^ string_of_int n ^ "," ^
- string_of_int m ^ ")"
- | G_YUK_N (vc,f,n,sf,m) -> conj_symbol (vc, "g_yuk_neu_" ^
- string_of_fermion_type f ^ string_of_sff sf) ^ "(" ^
- string_of_fermion_gen f ^ "," ^ string_of_neu n ^ "," ^
- string_of_sfm m ^ ")"
- | G_YUK_G (vc,f,sf,m) -> conj_symbol (vc, "g_yuk_gluino_" ^
- string_of_fermion_type f ^ string_of_sff sf) ^ "(" ^
- string_of_fermion_gen f ^ "," ^ string_of_sfm m ^ ")"
- | G_YUK_C (vc,f,c,sf,m) -> conj_symbol (vc, "g_yuk_char_" ^
- string_of_fermion_type f ^ string_of_sff sf) ^ "(" ^
- string_of_fermion_gen f ^ "," ^ string_of_char c ^ "," ^
- string_of_sfm m ^ ")"
- | G_YUK_Q (vc,g1,f,c,sf,m) -> conj_symbol (vc, "g_yuk_char_" ^
- string_of_fermion_type f ^ string_of_sff sf) ^"("^string_of_int g1 ^
- "," ^ string_of_fermion_gen f ^ "," ^ string_of_char c ^ "," ^
- string_of_sfm m ^ ")"
- | G_WPSUSD (vc,m1,m2,g1,g2) -> conj_symbol (vc, "g_wA_susd") ^ "(" ^
- string_of_int g1 ^ "," ^ string_of_int g2 ^ "," ^ string_of_sfm m1 ^
- "," ^ string_of_sfm m2 ^ ")"
- | G_WZSUSD (vc,m1,m2,g1,g2) -> conj_symbol (vc, "g_wz_susd") ^ "(" ^
- string_of_int g1 ^ "," ^ string_of_int g2 ^ "," ^ string_of_sfm m1
- ^ "," ^ string_of_sfm m2 ^ ")"
- (**** 3vertex: Higgs-Gauge a la Franke-Fraas*)
-(***Nomenclature consistent with flavor_of_string***)
- | G_GH_ZSP (s,p) -> "g_zh0a0(" ^ string_of_shiggs s ^ "," ^
- string_of_phiggs p ^ ")"
- | G_GH_WSC s -> "g_Whph0(" ^ string_of_shiggs s ^ ")"
- | G_GH_WPC p -> "g_WhpA0(" ^ string_of_phiggs p^ ")"
- | G_GH_ZZS s -> "g_ZZh0(" ^ string_of_shiggs s ^ ")"
- | G_GH_WWS s -> "g_WWh0(" ^ string_of_shiggs s ^ ")"
- | G_GH_ZCC -> "g_Zhmhp"
- | G_GH_GaCC -> "g_Ahmhp"
- | G_ZSF (f,g,m1,m2) -> "g_z" ^ string_of_sff f ^ string_of_sff f ^ "(" ^
- string_of_int g ^ "," ^ string_of_sfm m1 ^ "," ^ string_of_sfm m2 ^ ")"
- | G_HSNSL (vc,g,m) -> conj_symbol (vc, "g_hp_sl" ^ string_of_sfm m ^ "sn1" )
- ^ "(" ^ string_of_int g ^ ")"
- | G_GlGlSQSQ -> "g_gg_sqsq"
- | G_PPSFSF f -> "g_AA_" ^ string_of_sff f ^ string_of_sff f
- | G_ZZSFSF (f,g,m1,m2) -> "g_zz_" ^ string_of_sff f ^string_of_sff f ^ "(" ^
- string_of_int g ^ "," ^ string_of_sfm m1 ^ "," ^ string_of_sfm m2 ^ ")"
- | G_ZPSFSF (f,g,m1,m2) -> "g_zA_" ^ string_of_sff f ^string_of_sff f ^ "("
- ^ string_of_int g ^","^ string_of_sfm m1 ^ "," ^ string_of_sfm m2 ^ ")"
- | G_GlPSQSQ -> "g_gA_sqsq"
- | G_GlZSFSF (f,g,m1,m2) -> "g_gz_" ^ string_of_sff f ^ string_of_sff f ^
- "(" ^ string_of_int g ^ "," ^ string_of_sfm m1 ^ "," ^ string_of_sfm
- m2 ^ ")"
- | G_GlWSUSD (vc,m1,m2,g1,g2) -> conj_symbol (vc, "g_gw_susd") ^ "(" ^
- string_of_int g1 ^ "," ^string_of_int g2 ^ "," ^ string_of_sfm m1 ^ ","
- ^ string_of_sfm m2 ^ ")"
- | G_strong -> "gs" | G_SS -> "gs**2"
- | I_G_S -> "igs"
- | G_NHC (vc,n,c) -> conj_symbol(vc,"g_neuhmchar") ^ "(" ^
- string_of_neu n ^ "," ^ string_of_char c ^ ")"
- | G_WWSFSF (f,g,m1,m2) -> "g_ww_" ^ string_of_sff f ^ string_of_sff f ^
- "(" ^ string_of_int g ^ "," ^ string_of_sfm m1 ^ "," ^ string_of_sfm m2
- ^ ")"
- | G_WPSLSN (vc,g,m) -> conj_symbol (vc, "g_wA_slsn") ^"("^ string_of_int g
- ^ "," ^ string_of_sfm m ^ ")"
- | G_WZSLSN (vc,g,m) -> conj_symbol (vc, "g_wz_slsn") ^ "(" ^ string_of_int
- g ^ "," ^ string_of_sfm m ^ ")"
- | G_SFSFS (s,f,g,m1,m2) -> "g_h0_"^ string_of_sff f ^ string_of_sfm m1
- ^ string_of_sff f ^ string_of_sfm m2 ^ "(" ^ string_of_shiggs s ^ "," ^
- string_of_int g ^ ")"
- | G_SFSFP (p,f,g,m1,m2) -> "g_A0_"^ string_of_sff f ^ string_of_sfm m1
- ^ string_of_sff f ^ string_of_sfm m2 ^ "(" ^ string_of_phiggs p ^ "," ^
- string_of_int g ^ ")"
- | G_HSUSD (vc,m1,m2,g1,g2) -> conj_symbol (vc, "g_hp_su" ^ string_of_sfm m1
- ^ "sd" ^ string_of_sfm m2 ) ^ "(" ^ string_of_int g1 ^ ","
- ^ string_of_int g2 ^ ")"
- | G_WSQ (vc,g1,g2,m1,m2) -> conj_symbol (vc, "g_wsusd") ^ "("
- ^ string_of_int g1 ^ "," ^ string_of_int g2 ^ "," ^ string_of_sfm m1 ^
- "," ^ string_of_sfm m2 ^ ")"
- | G_YUK_LQ_S (g1,s,g3) -> "g_yuk_lq_s(" ^ string_of_int g1 ^ "," ^
- string_of_shiggs s ^"," ^ string_of_int g3 ^")"
- | G_YUK_LQ_P (g1,p,g3) -> "g_yuk_lq_p(" ^ string_of_int g1 ^ "," ^
- string_of_phiggs p ^ "," ^ string_of_int g3 ^ ")"
- | G_LQ_NEU (m,g1,g2,n) -> "g_lq_neu(" ^ string_of_sfm m ^ "," ^
- string_of_int g1 ^ "," ^ string_of_int g2 ^ "," ^ string_of_neu n ^ ")"
- | G_LQ_GG (m,g1,g2) -> "g_lq_gg(" ^ string_of_sfm m ^ "," ^
- string_of_int g1 ^ "," ^ string_of_int g2 ^ ")"
- | G_LQ_EC_UC (vc,m,g1,g2,g3) -> conj_symbol(vc,"g_lq_ec_uc") ^ "(" ^
- string_of_sfm m ^ "," ^ string_of_int g1 ^ "," ^ string_of_int g2 ^ ","
- ^ string_of_int g3 ^ ")"
- | G_LQ_SSU (m1,m2,m3,g1,g2,g3) -> "g_lq_sst(" ^ string_of_sfm m1 ^ "," ^
- string_of_sfm m2 ^ "," ^ string_of_sfm m3 ^ "," ^ string_of_int g1 ^ "," ^
- string_of_int g2 ^ "," ^ string_of_int g3 ^ ")"
- | G_LQ_SSD (m1,m2,g1,g2,g3) -> "g_lq_ssta(" ^ string_of_sfm m1 ^ "," ^
- string_of_sfm m2 ^ "," ^ string_of_int g1 ^ "," ^ string_of_int g2 ^
- "," ^ string_of_int g3 ^ ")"
- | G_LQ_S (m1,m2,g1,s,g2) -> "g_lq_s(" ^ string_of_sfm m1 ^ "," ^ string_of_sfm m2 ^ ","
- ^ string_of_int g1 ^ "," ^ string_of_shiggs s ^ "," ^ string_of_int g2 ^ ")"
- | G_LQ_P (m1,m2,g1,p,g2) -> "g_lq_s(" ^ string_of_sfm m1 ^ "," ^ string_of_sfm m2 ^ ","
- ^ string_of_int g1 ^ "," ^ string_of_phiggs p ^ "," ^ string_of_int g2 ^ ")"
- | G_ZLQ (g,m1,m2) -> "g_zlqlq(" ^ string_of_int g ^ "," ^
- string_of_sfm m1 ^ "," ^ string_of_sfm m2 ^ ")"
- | G_ZZLQLQ -> "g_zz_lqlq"
- | G_ZPLQLQ -> "g_zA_lqlq"
- | G_PPLQLQ -> "g_AA_lqlq"
- | G_ZGlLQLQ -> "g_zg_lqlq"
- | G_PGlLQLQ -> "g_Ag_lqlq"
- | G_GlGlLQLQ -> "g_gg_lqlq"
- | G_NLQC -> "g_nlqc"
-
- end
-
-(*i
- * Local Variables:
- * mode:caml
- * indent-tabs-mode:nil
- * page-delimiter:"^(\\* .*\n"
- * End:
-i*)
Index: branches/ohl/omega-development/hgg-vertex/src/progress.mli
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/progress.mli (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/progress.mli (revision 8717)
@@ -1,40 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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/hgg-vertex/src/omega_SM_km.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/omega_SM_km.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/omega_SM_km.ml (revision 8717)
@@ -1,33 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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)
- (Modellib_SM.SM(Modellib_SM.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/hgg-vertex/src/config.mli
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/config.mli (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/config.mli (revision 8717)
@@ -1,40 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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 max_color_lines : int
-
-(* Cache writing is attempted in the order [[system_cache_dir]], [[user_cache_dir]], [["."]]
- and cache reading in the opposite order. *)
-
-val system_cache_dir : string
-val user_cache_dir : string
-
-val cache_prefix : string
-val cache_suffix : string
-
-(*i
- * Local Variables:
- * mode:caml
- * indent-tabs-mode:nil
- * page-delimiter:"^(\\* .*\n"
- * End:
-i*)
Index: branches/ohl/omega-development/hgg-vertex/src/omega_Zprime.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/omega_Zprime.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/omega_Zprime.ml (revision 8717)
@@ -1,588 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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
- = "$Source: /home/sources/ohl/ml/omega/src/omega_Zprime.ml,v $" }
-
-(* \thocwmodulesection{SM with additional Z'} *)
-
-module type SM_flags =
- sig
- val include_gluons : bool
- val include_anomalous : bool
- val k_matrix : bool
- end
-
-module SM_no_anomalous : SM_flags =
- struct
- let include_gluons = false
- let include_anomalous = false
- let k_matrix = false
- end
-
-module SM_gluons : SM_flags =
- struct
- let include_gluons = true
- let include_anomalous = false
- 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
- type gauge_boson = Ga | Wp | Wm | Z | Gl | ZH
- 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.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];
- "Gauge Bosons", List.map gauge_boson [Ga; Z; Wp; Wm; Gl; ZH];
- "Higgs", [O H];
- "Goldstone Bosons", List.map other [Phip; Phim; Phi0] ]
-
- let flavors () = ThoList.flatmap snd (external_flavors ())
-
- 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
- end
- | G f ->
- begin match f with
- | Ga | Gl -> Vector
- | Wp | Wm | Z | ZH -> 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 | ZH -> 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))
- | _ -> !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 | ZH -> ZH
- 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 | ZH -> 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
- | G_NC_h_neutrino | G_NC_h_lepton | G_NC_h_up | G_NC_h_down
- | I_Q_W | I_G_ZWW | I_G_WWW
- | 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_strong
- | 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 = Modeltools.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) ]
-
-(* 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, VA, Psi), G_NC_h_lepton);
- ((N (-n), ZH, N n), FBF (1, Psibar, VA, Psi), G_NC_h_neutrino);
- ((U (-n), ZH, U n), FBF (1, Psibar, VA, Psi), G_NC_h_up);
- ((D (-n), ZH, D n), FBF (1, Psibar, VA, Psi), G_NC_h_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 (-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 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 Flags.include_gluons then
- List.map tgc
- [ ((Gl, Gl, Gl), Gauge_Gauge_Gauge 1, G_strong)]
- else
- []
-
- 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 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 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] @
- 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
- | "ZH" | "ZH0" | "Zh" | "Zh0" -> G ZH
- | "W+" -> G Wp | "W-" -> G Wm
- | "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"
- end
- | G f ->
- begin match f with
- | Gl -> "g"
- | Ga -> "A" | Z -> "Z"
- | Wp -> "W+" | Wm -> "W-"
- | ZH -> "ZH"
- end
- | O f ->
- begin match f with
- | Phip -> "phi+" | Phim -> "phi-" | Phi0 -> "phi0"
- | H -> "H"
- end
-
- let flavor_to_TeX = 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_TeX: invalid lepton"
- | N 1 -> "\\nu_e" | N (-1) -> "\\bar{\\nu}_e"
- | N 2 -> "\\nu_\\mu" | N (-2) -> "\\bar{\\nu}_\\mu"
- | N 3 -> "\\nu_\\tau" | N (-3) -> "\\bar{\\nu}_\\tau"
- | N _ -> invalid_arg
- "Models.Zprime.flavor_to_TeX: invalid neutrino"
- | U 1 -> "u" | U (-1) -> "\\bar{u}"
- | U 2 -> "c" | U (-2) -> "\\bar{c}"
- | U 3 -> "t" | U (-3) -> "\\bar{t}"
- | U _ -> invalid_arg
- "Models.Zprime.flavor_to_TeX: invalid up type quark"
- | D 1 -> "d" | D (-1) -> "\\bar{d}"
- | D 2 -> "s" | D (-2) -> "\\bar{s}"
- | D 3 -> "b" | D (-3) -> "\\bar{b}"
- | D _ -> invalid_arg
- "Models.Zprime.flavor_to_TeX: invalid down type quark"
- end
- | G f ->
- begin match f with
- | Gl -> "g"
- | Ga -> "\\gamma" | Z -> "Z"
- | Wp -> "W^+" | Wm -> "W^-"
- | ZH -> "Z_H"
- 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"
- | ZH -> "zh"
- 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_to_TeX = flavor_to_TeX
- 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'.
-*)
-
- 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)
- | ZH -> 32
- 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_NC_h_lepton -> "gnchlep" | G_NC_h_neutrino -> "gnchneu"
- | G_NC_h_up -> "gnchup" | G_NC_h_down -> "gnchdwn"
- | 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_HZZ -> "ghzz"
- | G_HHWW -> "ghhww" | G_HHZZ -> "ghhzz"
- | G_Htt -> "ghtt" | G_Hbb -> "ghbb"
- | G_Htautau -> "ghtautau" | G_Hcc -> "ghcc"
- | 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)
- (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/hgg-vertex/src/complex.mli
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/complex.mli (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/complex.mli (revision 8717)
@@ -1,72 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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/hgg-vertex/src/omega_MSSM_CKM.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/omega_MSSM_CKM.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/omega_MSSM_CKM.ml (revision 8717)
@@ -1,33 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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)
- (Modellib_MSSM.MSSM(Modellib_MSSM.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/hgg-vertex/src/vertex_syntax.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/vertex_syntax.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/vertex_syntax.ml (revision 8717)
@@ -1,481 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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/hgg-vertex/src/omega_CQED.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/omega_CQED.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/omega_CQED.ml (revision 8717)
@@ -1,165 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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 = Modeltools.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 "Modellib_SM.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_to_TeX = flavor_to_TeX
- let flavor_sans_color_symbol = flavor_symbol
-
- let gauge_symbol () =
- failwith "Modellib_SM.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/hgg-vertex/src/omega_UED.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/omega_UED.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/omega_UED.ml (revision 8717)
@@ -1,33 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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)
- (Modellib_BSM.UED(Modellib_BSM.BSM_bsm))
-let _ = O.main ()
-
-(*i
- * Local Variables:
- * mode:caml
- * indent-tabs-mode:nil
- * page-delimiter:"^(\\* .*\n"
- * End:
-i*)
Index: branches/ohl/omega-development/hgg-vertex/src/thoGMenu.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/thoGMenu.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/thoGMenu.ml (revision 8717)
@@ -1,146 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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/hgg-vertex/src/omega_SM.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/omega_SM.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/omega_SM.ml (revision 8717)
@@ -1,33 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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)
- (Modellib_SM.SM(Modellib_SM.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/hgg-vertex/src/ovm_SM.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/ovm_SM.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/ovm_SM.ml (revision 8717)
@@ -1,33 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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)
- (Modellib_SM.SM(Modellib_SM.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/hgg-vertex/src/modellib_BSM.mli
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/modellib_BSM.mli (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/modellib_BSM.mli (revision 8717)
@@ -1,65 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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
-
-module type Threeshl_options =
- sig
- val include_ckm: bool
- val include_hf: bool
- val diet: bool
- end
-
-module Threeshl_no_ckm: Threeshl_options
-module Threeshl_ckm: Threeshl_options
-module Threeshl_no_ckm_no_hf: Threeshl_options
-module Threeshl_ckm_no_hf: Threeshl_options
-module Threeshl_diet_no_hf: Threeshl_options
-module Threeshl_diet: Threeshl_options
-module Threeshl: functor (Module_options: Threeshl_options) -> Model.T
-
-
-(*i
- * Local Variables:
- * mode:caml
- * indent-tabs-mode:nil
- * page-delimiter:"^(\\* .*\n"
- * End:
-i*)
Index: branches/ohl/omega-development/hgg-vertex/src/omega_Comphep.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/omega_Comphep.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/omega_Comphep.ml (revision 8717)
@@ -1,32 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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/hgg-vertex/src/cache.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/cache.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/cache.ml (revision 8717)
@@ -1,147 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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 suffix = Config.cache_suffix
-
-let search_path =
- [ Filename.current_dir_name;
- Config.user_cache_dir;
- Config.system_cache_dir ]
-
-module type T =
- sig
-
- type key
- type hash = string
- type value
-
- exception Mismatch of string * string * string
-
- val hash : key -> hash
- val exists : hash -> string -> bool
- val find : hash -> string -> string option
- val write : hash -> string -> value -> unit
- val write_dir : hash -> string -> string -> value -> unit
- val read : hash -> string -> value
- val maybe_read : hash -> string -> value option
-
- end
-
-module type Key =
- sig
- type t
- end
-
-module type Value =
- sig
- type t
- end
-
-module Make (Key : Key) (Value : Value) =
- struct
-
- type key = Key.t
- type hash = string
- type value = Value.t
-
- type tagged =
- { tag : hash;
- value : value; }
-
- let hash value =
- Digest.string (Marshal.to_string value [])
-
- let file name =
- name ^ suffix
-
- let find_first path name =
- let rec find_first' = function
- | [] -> raise Not_found
- | dir :: path ->
- let f = Filename.concat dir name in
- if Sys.file_exists f then
- f
- else
- find_first' path
- in
- find_first' path
-
- let find hash name =
- try Some (find_first search_path (file name)) with Not_found -> None
-
- let exists hash name =
- match find hash name with
- | None -> false
- | Some _ -> true
-
- let try_first f path name =
- let rec try_first' = function
- | [] -> raise Not_found
- | dir :: path ->
- try (f (Filename.concat dir name), dir) with _ -> try_first' path
- in
- try_first' path
-
- let open_in_bin_first = try_first open_in_bin
- let open_out_bin_last path = try_first open_out_bin (List.rev path)
-
- let write hash name value =
- let filename = file name in
- let oc, _ = open_out_bin_last search_path filename in
- Marshal.to_channel oc { tag = hash; value = value } [];
- close_out oc
-
- let write_dir hash dir name value =
- let oc = open_out_bin (Filename.concat dir (file name)) in
- Marshal.to_channel oc { tag = hash; value = value } [];
- close_out oc
-
- exception Mismatch of string * string * string
-
- let read hash name =
- let filename = file name in
- let ic, dir = open_in_bin_first search_path filename in
- let { tag = tag; value = value } = Marshal.from_channel ic in
- close_in ic;
- if tag = hash then
- value
- else
- raise (Mismatch (filename, hash, tag))
-
- let maybe_read hash name =
- try Some (read hash name) with Not_found -> None
-
- end
-
-(*i
- * Local Variables:
- * mode:caml
- * indent-tabs-mode:nil
- * page-delimiter:"^(\\* .*\n"
- * End:
-i*)
-
-
-
-
-
Index: branches/ohl/omega-development/hgg-vertex/src/kinds.f90.in
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/kinds.f90.in (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/kinds.f90.in (revision 8717)
@@ -1,67 +0,0 @@
-! WHIZARD <<Version>> <<Date>>
-!
-! (C) 1999-2009 by
-! Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
-! Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
-! Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-! with contributions by Sebastian Schmidt
-!
-! 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 kinds
-
- use iso_c_binding
-
- 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 = @FC_PRECISION@
- integer, parameter :: quad_or_single = @FC_QUAD_OR_SINGLE@
-
-! Their C equivalents.
- public :: c_default_float, c_default_complex
-
- integer, parameter :: c_default_float = @FC_PRECISION_C@
- integer, parameter :: c_default_complex = @FC_PRECISION_C@_complex
-
-
-! 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
Index: branches/ohl/omega-development/hgg-vertex/src/progress.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/progress.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/progress.ml (revision 8717)
@@ -1,164 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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/hgg-vertex/src/linalg.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/linalg.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/linalg.ml (revision 8717)
@@ -1,307 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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/hgg-vertex/src/trie.mli
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/trie.mli (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/trie.mli (revision 8717)
@@ -1,119 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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/hgg-vertex/src/omega_Littlest.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/omega_Littlest.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/omega_Littlest.ml (revision 8717)
@@ -1,33 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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)
- (Modellib_BSM.Littlest(Modellib_BSM.BSM_bsm))
-let _ = O.main ()
-
-(*i
- * Local Variables:
- * mode:caml
- * indent-tabs-mode:nil
- * page-delimiter:"^(\\* .*\n"
- * End:
-i*)
Index: branches/ohl/omega-development/hgg-vertex/src/omega_PSSSM.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/omega_PSSSM.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/omega_PSSSM.ml (revision 8717)
@@ -1,33 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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)
- (Modellib_PSSSM.ExtMSSM(Modellib_PSSSM.PSSSM))
-let _ = O.main ()
-
-(*i
- * Local Variables:
- * mode:caml
- * indent-tabs-mode:nil
- * page-delimiter:"^(\\* .*\n"
- * End:
-i*)
Index: branches/ohl/omega-development/hgg-vertex/src/process.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/process.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/process.ml (revision 8717)
@@ -1,226 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2010 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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 t = flavor list * flavor list
- val incoming : t -> flavor list
- val outgoing : t -> flavor list
- type decay
- val parse_decay : string -> decay
- val expand_decays : decay list -> t list
- type scattering
- val parse_scattering : string -> scattering
- val expand_scatterings : scattering list -> t list
- type any
- type process = Any of any | Decay of decay | Scattering of scattering
- val parse_process : string -> process
- val remove_duplicate_final_states : t list -> t list
- val diff : t list -> t list -> t list
- end
-
-module Make (M : Model.T) =
- struct
-
- type flavor = M.flavor
-
- type t = flavor list * flavor list
-
- let incoming (fin, _ ) = fin
- let outgoing (_, fout) = fout
-
-(* \thocwmodulesection{Parsing Process Descriptions} *)
-
- type 'a bag = 'a list
-
- type any = flavor bag list
- type decay = flavor bag * flavor bag list
- type scattering = flavor bag * flavor bag * flavor bag list
-
- type process =
- | Any of any
- | Decay of decay
- | Scattering of scattering
-
- 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)
-
- 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"
-
- 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
-
-(* \thocwmodulesection{Remove Duplicate Final States} *)
-
- let by_color f1 f2 =
- let c = Color.compare (M.color f1) (M.color f2) in
- if c <> 0 then
- c
- else
- compare f1 f2
-
- module Process_Projection =
- struct
-
- type elt = t
- type base = elt
-
- let compare_elt (fin1, fout1) (fin2, fout2) =
- let c = ThoList.compare ~cmp:by_color fin1 fin2 in
- if c <> 0 then
- c
- else
- ThoList.compare ~cmp:by_color fout1 fout2
-
- let compare_base b1 b2 = compare_elt b2 b1
-
- let pi (fin, fout) =
- (fin, List.sort by_color fout)
-
- end
-
- module Process_Bundle = Bundle.Make (Process_Projection)
-
- let to_string (fin, fout) =
- String.concat " " (List.map M.flavor_to_string fin)
- ^ " -> " ^ String.concat " " (List.map M.flavor_to_string fout)
-
- let fiber_to_string (base, fiber) =
- (to_string base) ^ " -> [" ^
- (String.concat ", " (List.map to_string fiber)) ^ "]"
-
- let bundle_to_strings list =
- List.map fiber_to_string list
-
- let remove_duplicate_final_states = function
- | [] -> []
- | [process] -> [process]
- | list -> Process_Bundle.base (Process_Bundle.of_list list)
-
-(*i
- let remove_duplicate_final_states list =
- List.iter (fun (fin, fout) ->
- Printf.eprintf ">>> %s\n" (process_to_string fin fout)) list;
- let result = remove_duplicate_final_states list in
- List.iter (fun (fin, fout) ->
- Printf.eprintf "<<< %s\n" (process_to_string fin fout)) result;
- result
-i*)
-
- module PSet =
- Set.Make (struct
- type t = Process_Projection.elt
- let compare = Process_Projection.compare_elt
- end)
-
- let set list =
- List.fold_right PSet.add list PSet.empty
-
- let diff list1 list2 =
- PSet.elements (PSet.diff (set list1) (set list2))
-
- end
-
-(*i
- * Local Variables:
- * mode:caml
- * indent-tabs-mode:nil
- * page-delimiter:"^(\\* .*\n"
- * End:
-i*)
Index: branches/ohl/omega-development/hgg-vertex/src/omega_SM_Maj.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/omega_SM_Maj.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/omega_SM_Maj.ml (revision 8717)
@@ -1,34 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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)
- (Modellib_SM.SM(Modellib_SM.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/hgg-vertex/src/targets_Kmatrix.mli
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/targets_Kmatrix.mli (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/targets_Kmatrix.mli (revision 8717)
@@ -1,31 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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/hgg-vertex/src/omega_SM3h.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/omega_SM3h.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/omega_SM3h.ml (revision 8717)
@@ -1,34 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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)(Modellib_SM.SM3(Modellib_SM.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/hgg-vertex/src/partition.mli
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/partition.mli (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/partition.mli (revision 8717)
@@ -1,45 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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/hgg-vertex/src/omega_parameters_tool.nw
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/omega_parameters_tool.nw (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/omega_parameters_tool.nw (revision 8717)
@@ -1,159 +0,0 @@
-% $Id: omega_parameters_tool.nw 784 2009-06-12 12:14:23Z ohl $
-%
-% Copyright (C) 1999-2009 by
-% Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
-% Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
-% Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-%
-% 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 Genel Public License for more details.
-%
-% You shou have received a copy of the GNU General Public License
-% along wi this program; if not, write to the Free Software
-% Foundati, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-@
-<<[[omega_aux_functions.f90]]>>=
-<<Copyleft>
-module omega_aux_function
- use kinds
- use omega_constants
- use omega_parameters
-
- implicit none
- private
-
- integer, parameter, public :: &
- n0 = 5, nloop = 2
- real(kind=default), parameter :: &
- acc = 1.e-12_default
- real(kind=default), parameter :: &
- asmz = 0.118_default
- type(parameter_set) :: par
-
- function faux (x) result (y)
- real(kind=default) :: x
- complex(kind=default) :: y
- if (1 <= x) then
- y = asin(sqrt(1/x))**2
- else
- y = - 1/4.0_default * (log((1 + sqrt(1 - x))/ &
- (1 - sqrt(1 - x))) - cmplx (0.0_default, PI))**2
- end if
- end function faux
-
- function fonehalf (x) result (y)
- real(kind=default), intent(in) :: x
- complex(kind=default) :: y
- if (x==0) then
- y = 0
- else
- y = - 2.0_default * x * (1 + (1 - x) * faux(x))
- end if
- end function fonehalf
-
- function fone (x) result (y)
- real(kind=default), intent(in) :: x
- complex(kind=default) :: y
- if (x==0) then
- y = 2.0_default
- else
- y = 2.0_default + 3.0_default * x + &
- 3.0_default * x * (2.0_default - x) * &
- faux(x)
- end if
- end function fone
-
- function gaux (x) result (y)
- real(kind=default), intent(in) :: x
- complex(kind=default) :: y
- if (1 <= x) then
- y = sqrt(x - 1) * asin(sqrt(1/x))
- else
- y = sqrt(1 - x) * (log((1 + sqrt(1 - x)) / &
- (1 - sqrt(1 - x))) - cmplx (0.0_default, PI)) / 2
- end if
- end function gaux
-
- function i1 (a,b) result (y)
- real(kind=default), intent(in) :: a,b
- complex(kind=default) :: y
- y = a*b/2.0_default/(a-b) + a**2 * b**2/2.0_default/(a-b)**2 * &
- (faux(a) - faux(b)) + &
- a**2 * b/(a-b)**2 * (gaux(a) - gaux(b))
- end function i1
-
- function i2 (a,b) result (y)
- real(kind=default), intent(in) :: a,b
- complex(kind=default) :: y
- y = - a * b / 2.0_default / (a-b) * (faux(a) - faux(b))
- end function i2
-
- function b0 (nf) result (bnull)
- integer, intent(in) :: nf
- real(kind=default) :: bnull
- bnull = 33.0_default - 2.0_default * nf
- end function b0
-
- function b1 (nf) result (bone)
- integer, intent(in) :: nf
- real(kind=default) :: bone
- bone = 6.0_default * (153.0_default - 19.0_default * nf)/b0(nf)**2
- end function b1
-
- function aa (nf) result (aaa)
- integer, intent(in) :: nf
- real(kind=default) :: aaa
- aaa = 12.0_default * PI / b0(nf)
- end function aa
-
- function bb (nf) result (bbb)
- integer, intent(in) :: nf
- real(kind=default) :: bbb
- bbb = b1(nf) / aa(nf)
- end function bb
-
-end module omega_aux_functions
-@
-
-
-@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-<<Copyleft>>=
-! $Id: omega_parameters_tool.nw 784 2009-06-12 12:14:23Z ohl $
-!
-! Copyright (C) 1999-2009 by
-! Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
-! Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
-! Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-!
-! 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.
-!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-% 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/hgg-vertex/src/thoList.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/thoList.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/thoList.ml (revision 8717)
@@ -1,197 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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/hgg-vertex/src/colorize.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/src/colorize.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/src/colorize.ml (revision 8717)
@@ -1,1873 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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, c1, c2) ->
- if c1 = c2 then
- Only_Insertion
- else
- 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_pairs_ordered =
- ThoList.flatmap
- (function
- | [c1; c2] -> [(c1, c2)]
- | _ -> failwith "Colorize.It().color_flow_pairs_ordered: 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 c -> CF_io (f, c, c)) color_flows) @
- (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 = Modeltools.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: *)
-
- | C.AdjSUN nc1, C.AdjSUN nc2, C.Singlet ->
- if nc1 <> nc2 then
- []
- else if f1 = f2 then
- List.map (fun (c1, c2) ->
- ((CF_io (f1, c1, c2), CF_io (f2, c2, c1), White f3), v, g))
- color_flow_pairs_ordered
- @ ThoList.flatmap (fun c ->
- [((CF_io (f1, c, c), CF_aux f2, White f3), v, g)])
- color_flows
- @ [((CF_aux f1, CF_aux f2, White f3), mult_vertex3 (abs nc1) v, g)]
- else
- List.map (fun (c1, c2) ->
- ((CF_io (f1, c1, c2), CF_io (f2, c2, c1), White f3), v, g))
- color_flow_pairs
- @ ThoList.flatmap (fun c ->
- [((CF_io (f1, c, c), CF_aux f2, White f3), v, g);
- ((CF_aux f1, CF_io (f2, c, c), White f3), v, g)])
- color_flows
- @ [((CF_aux f1, CF_aux f2, White f3), mult_vertex3 (abs nc1) v, g)]
-
- | C.AdjSUN nc1, C.Singlet, C.AdjSUN nc3 ->
- if nc1 <> nc3 then
- []
- else if f1 = f3 then
- List.map (fun (c1, c3) ->
- ((CF_io (f1, c1, c3), White f2, CF_io (f3, c3, c1)), v, g))
- color_flow_pairs_ordered
- @ ThoList.flatmap (fun c ->
- [((CF_io (f1, c, c), White f2, CF_aux f3), v, g)])
- color_flows
- @ [((CF_aux f1, White f2, CF_aux f3), v, g)]
- else
- List.map (fun (c1, c3) ->
- ((CF_io (f1, c1, c3), White f2, CF_io (f3, c3, c1)), v, g))
- color_flow_pairs
- @ ThoList.flatmap (fun c ->
- [((CF_io (f1, c, c), White f2, CF_aux f3), v, g);
- ((CF_aux f1, White f2, CF_io (f3, c, c)), v, g)])
- color_flows
- @ [((CF_aux f1, White f2, CF_aux f3), mult_vertex3 (abs nc1) v, g)]
-
- | C.Singlet, C.AdjSUN nc2, C.AdjSUN nc3 ->
- if nc2 <> nc2 then
- []
- else if f2 = f3 then
- List.map (fun (c2, c3) ->
- ((White f1, CF_io (f2, c2, c3), CF_io (f3, c3, c2)), v, g))
- color_flow_pairs_ordered
- @ ThoList.flatmap (fun c ->
- [((White f1, CF_io (f2, c, c), CF_aux f3), v, g)])
- color_flows
- @ [((White f1, CF_aux f2, CF_aux f3), mult_vertex3 (abs nc2) v, g)]
- else
- List.map (fun (c2, c3) ->
- ((White f1, CF_io (f2, c2, c3), CF_io (f3, c3, c2)), v, g))
- color_flow_pairs
- @ ThoList.flatmap (fun c ->
- [((White f1, CF_io (f2, c, c), CF_aux f3), v, g);
- ((White f1, CF_aux f2, CF_io (f3, c, c)), v, g)])
- color_flows
- @ [((White f1, CF_aux f2, CF_aux f3), mult_vertex3 (abs nc2) 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_to_TeX = function
- | White f ->
- M.flavor_to_TeX f
- | CF_in (f, c) ->
- "{" ^ M.flavor_to_TeX f ^ "}_c" ^ string_of_int c
- | CF_out (f, c) ->
- "{" ^ M.flavor_to_TeX f ^ "}_a" ^ string_of_int c
- | CF_io (f, c1, c2) ->
- "{" ^ M.flavor_to_TeX f ^ "}_{c" ^ string_of_int c1 ^ "_a" ^ string_of_int c2 ^ "}"
- | CF_aux f ->
- "{" ^ M.flavor_to_TeX f ^ "}_0"
-
- let flavor_sans_color_to_TeX = M.flavor_to_TeX
-
- 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
-(*i invalid_arg
- "Colorize.It().external_color_flows: crossed amplitude not a singlet!"
- i*)
- []
- 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)
-
-(* We use [List.hd] and [List.tl] instead of pattern matching, because we
- consume [ecf_in] and [ecf_out] at a different pace. *)
-
- let cons x xlist =
- x :: xlist
-
- let tail_opt = function
- | [] -> []
- | _ :: tail -> tail
-
- let head_req = function
- | [] ->
- invalid_arg "Colorize.It().colorize_crossed_amplitude1: insufficient flows"
- | x :: _ -> x
-
- let rec colorize_crossed_amplitude1_rev acc f_list (ecf_in, ecf_out) =
- match f_list, ecf_in, ecf_out with
- | [], [], [] -> acc
- | [], _, _ ->
- invalid_arg "Colorize.It().colorize_crossed_amplitude1: leftover flows"
- | f :: rest, _, _ ->
- begin match M.color f with
- | C.Singlet ->
- colorize_crossed_amplitude1_rev
- (List.map (cons (White f)) acc) rest (ecf_in, ecf_out)
- | C.SUN nc ->
- if nc > 0 then
- colorize_crossed_amplitude1_rev
- (List.map (cons (CF_in (f, head_req ecf_in))) acc)
- rest (tail_opt ecf_in, ecf_out)
- else if nc < 0 then
- colorize_crossed_amplitude1_rev
- (List.map (cons (CF_out (f, head_req ecf_out))) acc)
- rest (ecf_in, tail_opt ecf_out)
- else
- su0 "colorize_flavor"
- | C.AdjSUN _ ->
- let ecf_in' = head_req ecf_in
- and ecf_out' = head_req ecf_out in
- if ecf_in' = ecf_out' then
- colorize_crossed_amplitude1_rev
- (Product.list2 cons [CF_aux f; CF_io (f, ecf_in', ecf_out')] acc)
- rest (tail_opt ecf_in, tail_opt ecf_out)
- else
- colorize_crossed_amplitude1_rev
- (List.map (cons (CF_io (f, ecf_in', ecf_out'))) acc)
- rest (tail_opt ecf_in, tail_opt ecf_out)
- end
-
- let colorize_crossed_amplitude1 f_list (ecf_in, ecf_out) =
- List.map List.rev (colorize_crossed_amplitude1_rev [[]] f_list (ecf_in, ecf_out))
-
- let colorize_crossed_amplitude p_list =
- ThoList.flatmap (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(" ^ string_of_int F.max_lines ^ "," ^ 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_to_TeX = CM.flavor_to_TeX
- 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_to_TeX = CM.flavor_sans_color_to_TeX
- 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(" ^ string_of_int F.max_lines ^ "," ^ RCS.name M.rcs ^ ")")
- [String.concat " " (RCS.description M.rcs @ ["(statically colorized)"])]
-
- end
-
-(*i **************************************************************************************
-
-(* \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 = Modeltools.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_to_TeX = function
- | White f ->
- M.flavor_to_TeX f
- | CF_in (f, c) ->
- "{" ^ M.flavor_to_TeX f ^ "}_c" ^ string_of_int c
- | CF_out (f, c) ->
- "{" ^ M.flavor_to_TeX f ^ "}_a" ^ string_of_int c
- | CF_io (f, c1, c2) ->
- "{" ^ M.flavor_to_TeX f ^ "}_c" ^ string_of_int c1 ^ string_of_int c2
- | CF_aux f ->
- "{" ^ M.flavor_to_TeX f ^ "}_0"
-
- let flavor_sans_color_to_TeX = M.flavor_to_TeX
-
- 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, head_req ecf_in) ::
- colorize_crossed_amplitude1 rest (List.tl ecf_in, ecf_out)
- else if nc < 0 then
- CF_out (f, head_req ecf_out) ::
- colorize_crossed_amplitude1 rest (ecf_in, List.tl ecf_out)
- else
- su0 "colorize_flavor"
- | C.AdjSUN _ ->
- let ecf_in' = head_req ecf_in
- and ecf_out' = head_req 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*)
-
-(*i
- * Local Variables:
- * mode:caml
- * indent-tabs-mode:nil
- * page-delimiter:"^(\\* .*\n"
- * End:
-i*)
Index: branches/ohl/omega-development/hgg-vertex/ChangeLog
===================================================================
--- branches/ohl/omega-development/hgg-vertex/ChangeLog (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/ChangeLog (revision 8717)
@@ -1,76 +0,0 @@
-ChangeLog -- Summary of changes to the O'Mega package
-
-Use svn log to see detailed changes.
-
- Version 2.0.0 (beta/rc3)
-
-
-##################################################################
-
-2010-02-16
- Uncolored vertex selection rules for colored amplitudes
-
-2010-02-14
- Color correlation computation in O'Mega finalized
-
-2010-02-08
- First O'Caml code for computation of color correlations in
- O'Mega
-
-##################################################################
-
-2010-02-06
- Arbitrary color structures in tensor products for jets
-
-##################################################################
-
-2006
- O'Mega becomes part of the WHIZARD generator
-
-##################################################################
-
-2006-05-15
- RELEASE: version 0.11
- merged Juergen's extensions
-
-##################################################################
-
-2005-11-07
- RELEASE: version 0.10
- 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
-
-##################################################################
-
-2004-08-93
- RELEASE: version 0.9
- 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
- RELEASE: version 0.8
- MSSM: sign of W+/W-/A and W+/W-/Z couplings
-
-##################################################################
-
-2002-2004
- loads of changes
-
-2001-03-13
- 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
- src/model.mli:
- new field Model.vertices required for model functors, will
- retire Model.fuse2, Model.fuse3, Model.fusen soon.
Index: branches/ohl/omega-development/hgg-vertex/config.guess
===================================================================
--- branches/ohl/omega-development/hgg-vertex/config.guess (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/config.guess (revision 8717)
@@ -1,1500 +0,0 @@
-#! /bin/sh
-# Attempt to guess a canonical system name.
-# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
-# 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation,
-# Inc.
-
-timestamp='2006-07-02'
-
-# 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., 51 Franklin Street - Fifth Floor, Boston, MA
-# 02110-1301, 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.
-
-
-# Originally written by Per Bothner <per@bothner.com>.
-# Please send patches to <config-patches@gnu.org>. Submit a context
-# diff and a properly formatted ChangeLog entry.
-#
-# 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 <config-patches@gnu.org>."
-
-version="\
-GNU config.guess ($timestamp)
-
-Originally written by Per Bothner.
-Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005
-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 ;;
- --version | -v )
- echo "$version" ; exit ;;
- --help | --h* | -h )
- echo "$usage"; exit ;;
- -- ) # 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
-
-trap 'exit 1' 1 2 15
-
-# CC_FOR_BUILD -- compiler used by this script. Note that the use of a
-# compiler to aid in system detection is discouraged as it requires
-# temporary files to be created and, as you can see below, it is a
-# headache to deal with in a portable fashion.
-
-# Historically, `CC_FOR_BUILD' used to be named `HOST_CC'. We still
-# use `HOST_CC' if defined, but it is deprecated.
-
-# Portable tmp directory creation inspired by the Autoconf team.
-
-set_cc_for_build='
-trap "exitcode=\$?; (rm -f \$tmpfiles 2>/dev/null; rmdir \$tmp 2>/dev/null) && exit \$exitcode" 0 ;
-trap "rm -f \$tmpfiles 2>/dev/null; rmdir \$tmp 2>/dev/null; exit 1" 1 2 13 15 ;
-: ${TMPDIR=/tmp} ;
- { tmp=`(umask 077 && mktemp -d "$TMPDIR/cgXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" ; } ||
- { test -n "$RANDOM" && tmp=$TMPDIR/cg$$-$RANDOM && (umask 077 && mkdir $tmp) ; } ||
- { tmp=$TMPDIR/cg-$$ && (umask 077 && mkdir $tmp) && echo "Warning: creating insecure temp directory" >&2 ; } ||
- { echo "$me: cannot create a temporary directory in $TMPDIR" >&2 ; exit 1 ; } ;
-dummy=$tmp/dummy ;
-tmpfiles="$dummy.c $dummy.o $dummy.rel $dummy" ;
-case $CC_FOR_BUILD,$HOST_CC,$CC in
- ,,) echo "int x;" > $dummy.c ;
- for c in cc gcc c89 c99 ; do
- if ($c -c -o $dummy.o $dummy.c) >/dev/null 2>&1 ; then
- CC_FOR_BUILD="$c"; break ;
- fi ;
- done ;
- 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 ; set_cc_for_build= ;'
-
-# This is needed to find uname on a Pyramid OSx when run in the BSD universe.
-# (ghazi@noc.rutgers.edu 1994-08-24)
-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
-
-# 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.
- #
- # Note: NetBSD doesn't particularly care about the vendor
- # portion of the name. We always set it to "unknown".
- sysctl="sysctl -n hw.machine_arch"
- UNAME_MACHINE_ARCH=`(/sbin/$sysctl 2>/dev/null || \
- /usr/sbin/$sysctl 2>/dev/null || echo unknown)`
- case "${UNAME_MACHINE_ARCH}" in
- armeb) machine=armeb-unknown ;;
- arm*) machine=arm-unknown ;;
- sh3el) machine=shl-unknown ;;
- sh3eb) machine=sh-unknown ;;
- *) machine=${UNAME_MACHINE_ARCH}-unknown ;;
- esac
- # The Operating System including object format, if it has switched
- # to ELF recently, or will in the future.
- case "${UNAME_MACHINE_ARCH}" in
- arm*|i386|m68k|ns32k|sh3*|sparc|vax)
- eval $set_cc_for_build
- 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
- # Debian GNU/NetBSD machines have a different userland, and
- # thus, need a distinct triplet. However, they do not need
- # kernel version information, so it can be replaced with a
- # suitable tag, in the style of linux-gnu.
- case "${UNAME_VERSION}" in
- Debian*)
- release='-gnu'
- ;;
- *)
- release=`echo ${UNAME_RELEASE}|sed -e 's/[-_].*/\./'`
- ;;
- esac
- # 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 ;;
- *:OpenBSD:*:*)
- UNAME_MACHINE_ARCH=`arch | sed 's/OpenBSD.//'`
- echo ${UNAME_MACHINE_ARCH}-unknown-openbsd${UNAME_RELEASE}
- exit ;;
- *:ekkoBSD:*:*)
- echo ${UNAME_MACHINE}-unknown-ekkobsd${UNAME_RELEASE}
- exit ;;
- *:SolidBSD:*:*)
- echo ${UNAME_MACHINE}-unknown-solidbsd${UNAME_RELEASE}
- exit ;;
- macppc:MirBSD:*:*)
- echo powerpc-unknown-mirbsd${UNAME_RELEASE}
- exit ;;
- *:MirBSD:*:*)
- echo ${UNAME_MACHINE}-unknown-mirbsd${UNAME_RELEASE}
- exit ;;
- alpha:OSF1:*:*)
- case $UNAME_RELEASE in
- *4.0)
- UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $3}'`
- ;;
- *5.*)
- UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $4}'`
- ;;
- esac
- # According to Compaq, /usr/sbin/psrinfo has been available on
- # OSF/1 and Tru64 systems produced since 1995. I hope that
- # covers most systems running today. This code pipes the CPU
- # types through head -n 1, so we only detect the type of CPU 0.
- ALPHA_CPU_TYPE=`/usr/sbin/psrinfo -v | sed -n -e 's/^ The alpha \(.*\) processor.*$/\1/p' | head -n 1`
- case "$ALPHA_CPU_TYPE" in
- "EV4 (21064)")
- UNAME_MACHINE="alpha" ;;
- "EV4.5 (21064)")
- UNAME_MACHINE="alpha" ;;
- "LCA4 (21066/21068)")
- UNAME_MACHINE="alpha" ;;
- "EV5 (21164)")
- UNAME_MACHINE="alphaev5" ;;
- "EV5.6 (21164A)")
- UNAME_MACHINE="alphaev56" ;;
- "EV5.6 (21164PC)")
- UNAME_MACHINE="alphapca56" ;;
- "EV5.7 (21164PC)")
- UNAME_MACHINE="alphapca57" ;;
- "EV6 (21264)")
- UNAME_MACHINE="alphaev6" ;;
- "EV6.7 (21264A)")
- UNAME_MACHINE="alphaev67" ;;
- "EV6.8CB (21264C)")
- UNAME_MACHINE="alphaev68" ;;
- "EV6.8AL (21264B)")
- UNAME_MACHINE="alphaev68" ;;
- "EV6.8CX (21264D)")
- UNAME_MACHINE="alphaev68" ;;
- "EV6.9A (21264/EV69A)")
- UNAME_MACHINE="alphaev69" ;;
- "EV7 (21364)")
- UNAME_MACHINE="alphaev7" ;;
- "EV7.9 (21364A)")
- UNAME_MACHINE="alphaev79" ;;
- esac
- # A Pn.n version is a patched version.
- # 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.
- echo ${UNAME_MACHINE}-dec-osf`echo ${UNAME_RELEASE} | sed -e 's/^[PVTX]//' | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'`
- exit ;;
- 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 ;;
- 21064:Windows_NT:50:3)
- echo alpha-dec-winnt3.5
- exit ;;
- Amiga*:UNIX_System_V:4.0:*)
- echo m68k-unknown-sysv4
- exit ;;
- *:[Aa]miga[Oo][Ss]:*:*)
- echo ${UNAME_MACHINE}-unknown-amigaos
- exit ;;
- *:[Mm]orph[Oo][Ss]:*:*)
- echo ${UNAME_MACHINE}-unknown-morphos
- exit ;;
- *:OS/390:*:*)
- echo i370-ibm-openedition
- exit ;;
- *:z/VM:*:*)
- echo s390-ibm-zvmoe
- exit ;;
- *:OS400:*:*)
- echo powerpc-ibm-os400
- exit ;;
- arm:RISC*:1.[012]*:*|arm:riscix:1.[012]*:*)
- echo arm-acorn-riscix${UNAME_RELEASE}
- exit ;;
- arm:riscos:*:*|arm:RISCOS:*:*)
- echo arm-unknown-riscos
- exit ;;
- SR2?01:HI-UX/MPP:*:* | SR8000:HI-UX/MPP:*:*)
- echo hppa1.1-hitachi-hiuxmpp
- exit ;;
- 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 ;;
- NILE*:*:*:dcosx)
- echo pyramid-pyramid-svr4
- exit ;;
- DRS?6000:unix:4.0:6*)
- echo sparc-icl-nx6
- exit ;;
- DRS?6000:UNIX_SV:4.2*:7* | DRS?6000:isis:4.2*:7*)
- case `/usr/bin/uname -p` in
- sparc) echo sparc-icl-nx7; exit ;;
- esac ;;
- sun4H:SunOS:5.*:*)
- echo sparc-hal-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
- exit ;;
- sun4*:SunOS:5.*:* | tadpole*:SunOS:5.*:*)
- echo sparc-sun-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
- exit ;;
- i86pc:SunOS:5.*:*)
- echo i386-pc-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
- exit ;;
- 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 ;;
- 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 ;;
- sun3*:SunOS:*:*)
- echo m68k-sun-sunos${UNAME_RELEASE}
- exit ;;
- sun*:*:4.2BSD:*)
- UNAME_RELEASE=`(sed 1q /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 ;;
- aushp:SunOS:*:*)
- echo sparc-auspex-sunos${UNAME_RELEASE}
- exit ;;
- # 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 ;;
- atari*:*MiNT:*:* | atari*:*mint:*:* | atarist[e]:*TOS:*:*)
- echo m68k-atari-mint${UNAME_RELEASE}
- exit ;;
- *falcon*:*MiNT:*:* | *falcon*:*mint:*:* | *falcon*:*TOS:*:*)
- echo m68k-atari-mint${UNAME_RELEASE}
- exit ;;
- milan*:*MiNT:*:* | milan*:*mint:*:* | *milan*:*TOS:*:*)
- echo m68k-milan-mint${UNAME_RELEASE}
- exit ;;
- hades*:*MiNT:*:* | hades*:*mint:*:* | *hades*:*TOS:*:*)
- echo m68k-hades-mint${UNAME_RELEASE}
- exit ;;
- *:*MiNT:*:* | *:*mint:*:* | *:*TOS:*:*)
- echo m68k-unknown-mint${UNAME_RELEASE}
- exit ;;
- m68k:machten:*:*)
- echo m68k-apple-machten${UNAME_RELEASE}
- exit ;;
- powerpc:machten:*:*)
- echo powerpc-apple-machten${UNAME_RELEASE}
- exit ;;
- RISC*:Mach:*:*)
- echo mips-dec-mach_bsd4.3
- exit ;;
- RISC*:ULTRIX:*:*)
- echo mips-dec-ultrix${UNAME_RELEASE}
- exit ;;
- VAX*:ULTRIX*:*:*)
- echo vax-dec-ultrix${UNAME_RELEASE}
- exit ;;
- 2020:CLIX:*:* | 2430:CLIX:*:*)
- echo clipper-intergraph-clix${UNAME_RELEASE}
- exit ;;
- mips:*:*:UMIPS | mips:*:*:RISCos)
- eval $set_cc_for_build
- sed 's/^ //' << EOF >$dummy.c
-#ifdef __cplusplus
-#include <stdio.h> /* 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 -o $dummy $dummy.c &&
- dummyarg=`echo "${UNAME_RELEASE}" | sed -n 's/\([0-9]*\).*/\1/p'` &&
- SYSTEM_NAME=`$dummy $dummyarg` &&
- { echo "$SYSTEM_NAME"; exit; }
- echo mips-mips-riscos${UNAME_RELEASE}
- exit ;;
- Motorola:PowerMAX_OS:*:*)
- echo powerpc-motorola-powermax
- exit ;;
- Motorola:*:4.3:PL8-*)
- echo powerpc-harris-powermax
- exit ;;
- Night_Hawk:*:*:PowerMAX_OS | Synergy:PowerMAX_OS:*:*)
- echo powerpc-harris-powermax
- exit ;;
- Night_Hawk:Power_UNIX:*:*)
- echo powerpc-harris-powerunix
- exit ;;
- m88k:CX/UX:7*:*)
- echo m88k-harris-cxux7
- exit ;;
- m88k:*:4*:R4*)
- echo m88k-motorola-sysv4
- exit ;;
- m88k:*:3*:R3*)
- echo m88k-motorola-sysv3
- exit ;;
- 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 ;;
- M88*:DolphinOS:*:*) # DolphinOS (SVR3)
- echo m88k-dolphin-sysv3
- exit ;;
- M88*:*:R3*:*)
- # Delta 88k system running SVR3
- echo m88k-motorola-sysv3
- exit ;;
- XD88*:*:*:*) # Tektronix XD88 system running UTekV (SVR3)
- echo m88k-tektronix-sysv3
- exit ;;
- Tek43[0-9][0-9]:UTek:*:*) # Tektronix 4300 system running UTek (BSD)
- echo m68k-tektronix-bsd
- exit ;;
- *:IRIX*:*:*)
- echo mips-sgi-irix`echo ${UNAME_RELEASE}|sed -e 's/-/_/g'`
- exit ;;
- ????????: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 ;; # Note that: echo "'`uname -s`'" gives 'AIX '
- i*86:AIX:*:*)
- echo i386-ibm-aix
- exit ;;
- 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 ;;
- *:AIX:2:3)
- if grep bos325 /usr/include/stdio.h >/dev/null 2>&1; then
- eval $set_cc_for_build
- sed 's/^ //' << EOF >$dummy.c
- #include <sys/systemcfg.h>
-
- main()
- {
- if (!__power_pc())
- exit(1);
- puts("powerpc-ibm-aix3.2.5");
- exit(0);
- }
-EOF
- if $CC_FOR_BUILD -o $dummy $dummy.c && SYSTEM_NAME=`$dummy`
- then
- echo "$SYSTEM_NAME"
- else
- echo rs6000-ibm-aix3.2.5
- fi
- 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 ;;
- *:AIX:*:[45])
- IBM_CPU_ID=`/usr/sbin/lsdev -C -c processor -S available | sed 1q | 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 ;;
- *:AIX:*:*)
- echo rs6000-ibm-aix
- exit ;;
- ibmrt:4.4BSD:*|romp-ibm:BSD:*)
- echo romp-ibm-bsd4.4
- exit ;;
- ibmrt:*BSD:*|romp-ibm:BSD:*) # covers RT/PC BSD and
- echo romp-ibm-bsd${UNAME_RELEASE} # 4.3 with uname added to
- exit ;; # report: romp-ibm BSD 4.3
- *:BOSX:*:*)
- echo rs6000-bull-bosx
- exit ;;
- DPX/2?00:B.O.S.:*:*)
- echo m68k-bull-sysv3
- exit ;;
- 9000/[34]??:4.3bsd:1.*:*)
- echo m68k-hp-bsd
- exit ;;
- hp300:4.4BSD:*:* | 9000/[34]??:4.3bsd:2.*:*)
- echo m68k-hp-bsd4.4
- exit ;;
- 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])
- 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" ;;
- '') HP_ARCH="hppa2.0" ;; # HP-UX 10.20
- esac ;;
- esac
- fi
- if [ "${HP_ARCH}" = "" ]; then
- eval $set_cc_for_build
- sed 's/^ //' << EOF >$dummy.c
-
- #define _HPUX_SOURCE
- #include <stdlib.h>
- #include <unistd.h>
-
- 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 -o $dummy $dummy.c 2>/dev/null) && HP_ARCH=`$dummy`
- test -z "$HP_ARCH" && HP_ARCH=hppa
- fi ;;
- esac
- if [ ${HP_ARCH} = "hppa2.0w" ]
- then
- eval $set_cc_for_build
-
- # hppa2.0w-hp-hpux* has a 64-bit kernel and a compiler generating
- # 32-bit code. hppa64-hp-hpux* has the same kernel and a compiler
- # generating 64-bit code. GNU and HP use different nomenclature:
- #
- # $ CC_FOR_BUILD=cc ./config.guess
- # => hppa2.0w-hp-hpux11.23
- # $ CC_FOR_BUILD="cc +DA2.0w" ./config.guess
- # => hppa64-hp-hpux11.23
-
- if echo __LP64__ | (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) |
- grep __LP64__ >/dev/null
- then
- HP_ARCH="hppa2.0w"
- else
- HP_ARCH="hppa64"
- fi
- fi
- echo ${HP_ARCH}-hp-hpux${HPUX_REV}
- exit ;;
- ia64:HP-UX:*:*)
- HPUX_REV=`echo ${UNAME_RELEASE}|sed -e 's/[^.]*.[0B]*//'`
- echo ia64-hp-hpux${HPUX_REV}
- exit ;;
- 3050*:HI-UX:*:*)
- eval $set_cc_for_build
- sed 's/^ //' << EOF >$dummy.c
- #include <unistd.h>
- 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 -o $dummy $dummy.c && SYSTEM_NAME=`$dummy` &&
- { echo "$SYSTEM_NAME"; exit; }
- echo unknown-hitachi-hiuxwe2
- exit ;;
- 9000/7??:4.3bsd:*:* | 9000/8?[79]:4.3bsd:*:* )
- echo hppa1.1-hp-bsd
- exit ;;
- 9000/8??:4.3bsd:*:*)
- echo hppa1.0-hp-bsd
- exit ;;
- *9??*:MPE/iX:*:* | *3000*:MPE/iX:*:*)
- echo hppa1.0-hp-mpeix
- exit ;;
- hp7??:OSF1:*:* | hp8?[79]:OSF1:*:* )
- echo hppa1.1-hp-osf
- exit ;;
- hp8??:OSF1:*:*)
- echo hppa1.0-hp-osf
- exit ;;
- i*86:OSF1:*:*)
- if [ -x /usr/sbin/sysversion ] ; then
- echo ${UNAME_MACHINE}-unknown-osf1mk
- else
- echo ${UNAME_MACHINE}-unknown-osf1
- fi
- exit ;;
- parisc*:Lites*:*:*)
- echo hppa1.1-hp-lites
- exit ;;
- C1*:ConvexOS:*:* | convex:ConvexOS:C1*:*)
- echo c1-convex-bsd
- exit ;;
- C2*:ConvexOS:*:* | convex:ConvexOS:C2*:*)
- if getsysinfo -f scalar_acc
- then echo c32-convex-bsd
- else echo c2-convex-bsd
- fi
- exit ;;
- C34*:ConvexOS:*:* | convex:ConvexOS:C34*:*)
- echo c34-convex-bsd
- exit ;;
- C38*:ConvexOS:*:* | convex:ConvexOS:C38*:*)
- echo c38-convex-bsd
- exit ;;
- C4*:ConvexOS:*:* | convex:ConvexOS:C4*:*)
- echo c4-convex-bsd
- exit ;;
- CRAY*Y-MP:*:*:*)
- echo ymp-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/'
- exit ;;
- CRAY*[A-Z]90:*:*:*)
- echo ${UNAME_MACHINE}-cray-unicos${UNAME_RELEASE} \
- | sed -e 's/CRAY.*\([A-Z]90\)/\1/' \
- -e y/ABCDEFGHIJKLMNOPQRSTUVWXYZ/abcdefghijklmnopqrstuvwxyz/ \
- -e 's/\.[^.]*$/.X/'
- exit ;;
- CRAY*TS:*:*:*)
- echo t90-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/'
- exit ;;
- CRAY*T3E:*:*:*)
- echo alphaev5-cray-unicosmk${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/'
- exit ;;
- CRAY*SV1:*:*:*)
- echo sv1-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/'
- exit ;;
- *:UNICOS/mp:*:*)
- echo craynv-cray-unicosmp${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/'
- exit ;;
- 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 ;;
- 5000:UNIX_System_V:4.*:*)
- FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'`
- FUJITSU_REL=`echo ${UNAME_RELEASE} | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/ /_/'`
- echo "sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}"
- exit ;;
- i*86:BSD/386:*:* | i*86:BSD/OS:*:* | *:Ascend\ Embedded/OS:*:*)
- echo ${UNAME_MACHINE}-pc-bsdi${UNAME_RELEASE}
- exit ;;
- sparc*:BSD/OS:*:*)
- echo sparc-unknown-bsdi${UNAME_RELEASE}
- exit ;;
- *:BSD/OS:*:*)
- echo ${UNAME_MACHINE}-unknown-bsdi${UNAME_RELEASE}
- exit ;;
- *:FreeBSD:*:*)
- case ${UNAME_MACHINE} in
- pc98)
- echo i386-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;;
- amd64)
- echo x86_64-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;;
- *)
- echo ${UNAME_MACHINE}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;;
- esac
- exit ;;
- i*:CYGWIN*:*)
- echo ${UNAME_MACHINE}-pc-cygwin
- exit ;;
- i*:MINGW*:*)
- echo ${UNAME_MACHINE}-pc-mingw32
- exit ;;
- i*:windows32*:*)
- # uname -m includes "-pc" on this system.
- echo ${UNAME_MACHINE}-mingw32
- exit ;;
- i*:PW*:*)
- echo ${UNAME_MACHINE}-pc-pw32
- exit ;;
- x86:Interix*:[3456]*)
- echo i586-pc-interix${UNAME_RELEASE}
- exit ;;
- EM64T:Interix*:[3456]*)
- echo x86_64-unknown-interix${UNAME_RELEASE}
- exit ;;
- [345]86:Windows_95:* | [345]86:Windows_98:* | [345]86:Windows_NT:*)
- echo i${UNAME_MACHINE}-pc-mks
- exit ;;
- 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 i586-pc-interix
- exit ;;
- i*:UWIN*:*)
- echo ${UNAME_MACHINE}-pc-uwin
- exit ;;
- amd64:CYGWIN*:*:* | x86_64:CYGWIN*:*:*)
- echo x86_64-unknown-cygwin
- exit ;;
- p*:CYGWIN*:*)
- echo powerpcle-unknown-cygwin
- exit ;;
- prep*:SunOS:5.*:*)
- echo powerpcle-unknown-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
- exit ;;
- *:GNU:*:*)
- # the GNU system
- echo `echo ${UNAME_MACHINE}|sed -e 's,[-/].*$,,'`-unknown-gnu`echo ${UNAME_RELEASE}|sed -e 's,/.*$,,'`
- exit ;;
- *:GNU/*:*:*)
- # other systems with GNU libc and userland
- echo ${UNAME_MACHINE}-unknown-`echo ${UNAME_SYSTEM} | sed 's,^[^/]*/,,' | tr '[A-Z]' '[a-z]'``echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`-gnu
- exit ;;
- i*86:Minix:*:*)
- echo ${UNAME_MACHINE}-pc-minix
- exit ;;
- arm*:Linux:*:*)
- echo ${UNAME_MACHINE}-unknown-linux-gnu
- exit ;;
- avr32*:Linux:*:*)
- echo ${UNAME_MACHINE}-unknown-linux-gnu
- exit ;;
- cris:Linux:*:*)
- echo cris-axis-linux-gnu
- exit ;;
- crisv32:Linux:*:*)
- echo crisv32-axis-linux-gnu
- exit ;;
- frv:Linux:*:*)
- echo frv-unknown-linux-gnu
- exit ;;
- ia64:Linux:*:*)
- echo ${UNAME_MACHINE}-unknown-linux-gnu
- exit ;;
- m32r*:Linux:*:*)
- echo ${UNAME_MACHINE}-unknown-linux-gnu
- exit ;;
- m68*:Linux:*:*)
- echo ${UNAME_MACHINE}-unknown-linux-gnu
- exit ;;
- mips:Linux:*:*)
- eval $set_cc_for_build
- sed 's/^ //' << EOF >$dummy.c
- #undef CPU
- #undef mips
- #undef mipsel
- #if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL)
- CPU=mipsel
- #else
- #if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB)
- CPU=mips
- #else
- CPU=
- #endif
- #endif
-EOF
- eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n '
- /^CPU/{
- s: ::g
- p
- }'`"
- test x"${CPU}" != x && { echo "${CPU}-unknown-linux-gnu"; exit; }
- ;;
- mips64:Linux:*:*)
- eval $set_cc_for_build
- sed 's/^ //' << EOF >$dummy.c
- #undef CPU
- #undef mips64
- #undef mips64el
- #if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL)
- CPU=mips64el
- #else
- #if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB)
- CPU=mips64
- #else
- CPU=
- #endif
- #endif
-EOF
- eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n '
- /^CPU/{
- s: ::g
- p
- }'`"
- test x"${CPU}" != x && { echo "${CPU}-unknown-linux-gnu"; exit; }
- ;;
- or32:Linux:*:*)
- echo or32-unknown-linux-gnu
- exit ;;
- ppc:Linux:*:*)
- echo powerpc-unknown-linux-gnu
- exit ;;
- ppc64:Linux:*:*)
- echo powerpc64-unknown-linux-gnu
- exit ;;
- alpha:Linux:*:*)
- case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' < /proc/cpuinfo` in
- EV5) UNAME_MACHINE=alphaev5 ;;
- EV56) UNAME_MACHINE=alphaev56 ;;
- PCA56) UNAME_MACHINE=alphapca56 ;;
- PCA57) UNAME_MACHINE=alphapca56 ;;
- EV6) UNAME_MACHINE=alphaev6 ;;
- EV67) UNAME_MACHINE=alphaev67 ;;
- EV68*) UNAME_MACHINE=alphaev68 ;;
- esac
- objdump --private-headers /bin/sh | grep ld.so.1 >/dev/null
- if test "$?" = 0 ; then LIBC="libc1" ; else LIBC="" ; fi
- echo ${UNAME_MACHINE}-unknown-linux-gnu${LIBC}
- exit ;;
- 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-unknown-linux-gnu ;;
- PA8*) echo hppa2.0-unknown-linux-gnu ;;
- *) echo hppa-unknown-linux-gnu ;;
- esac
- exit ;;
- parisc64:Linux:*:* | hppa64:Linux:*:*)
- echo hppa64-unknown-linux-gnu
- exit ;;
- s390:Linux:*:* | s390x:Linux:*:*)
- echo ${UNAME_MACHINE}-ibm-linux
- exit ;;
- sh64*:Linux:*:*)
- echo ${UNAME_MACHINE}-unknown-linux-gnu
- exit ;;
- sh*:Linux:*:*)
- echo ${UNAME_MACHINE}-unknown-linux-gnu
- exit ;;
- sparc:Linux:*:* | sparc64:Linux:*:*)
- echo ${UNAME_MACHINE}-unknown-linux-gnu
- exit ;;
- vax:Linux:*:*)
- echo ${UNAME_MACHINE}-dec-linux-gnu
- exit ;;
- x86_64:Linux:*:*)
- echo x86_64-unknown-linux-gnu
- exit ;;
- i*86:Linux:*:*)
- # 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.
- # Set LC_ALL=C to ensure ld outputs messages in English.
- ld_supported_targets=`cd /; LC_ALL=C ld --help 2>&1 \
- | sed -ne '/supported targets:/!d
- s/[ ][ ]*/ /g
- s/.*supported targets: *//
- s/ .*//
- p'`
- case "$ld_supported_targets" in
- elf32-i386)
- TENTATIVE="${UNAME_MACHINE}-pc-linux-gnu"
- ;;
- a.out-i386-linux)
- echo "${UNAME_MACHINE}-pc-linux-gnuaout"
- exit ;;
- coff-i386)
- echo "${UNAME_MACHINE}-pc-linux-gnucoff"
- exit ;;
- "")
- # Either a pre-BFD a.out linker (linux-gnuoldld) or
- # one that does not give us useful --help.
- echo "${UNAME_MACHINE}-pc-linux-gnuoldld"
- exit ;;
- esac
- # Determine whether the default compiler is a.out or elf
- eval $set_cc_for_build
- sed 's/^ //' << EOF >$dummy.c
- #include <features.h>
- #ifdef __ELF__
- # ifdef __GLIBC__
- # if __GLIBC__ >= 2
- LIBC=gnu
- # else
- LIBC=gnulibc1
- # endif
- # else
- LIBC=gnulibc1
- # endif
- #else
- #if defined(__INTEL_COMPILER) || defined(__PGI) || defined(__SUNPRO_C) || defined(__SUNPRO_CC)
- LIBC=gnu
- #else
- LIBC=gnuaout
- #endif
- #endif
- #ifdef __dietlibc__
- LIBC=dietlibc
- #endif
-EOF
- eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n '
- /^LIBC/{
- s: ::g
- p
- }'`"
- test x"${LIBC}" != x && {
- echo "${UNAME_MACHINE}-pc-linux-${LIBC}"
- exit
- }
- test x"${TENTATIVE}" != x && { echo "${TENTATIVE}"; exit; }
- ;;
- i*86:DYNIX/ptx:4*:*)
- # 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.
- echo i386-sequent-sysv4
- exit ;;
- 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 ;;
- 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 ;;
- i*86:XTS-300:*:STOP)
- echo ${UNAME_MACHINE}-unknown-stop
- exit ;;
- i*86:atheos:*:*)
- echo ${UNAME_MACHINE}-unknown-atheos
- exit ;;
- i*86:syllable:*:*)
- echo ${UNAME_MACHINE}-pc-syllable
- exit ;;
- i*86:LynxOS:2.*:* | i*86:LynxOS:3.[01]*:* | i*86:LynxOS:4.0*:*)
- echo i386-unknown-lynxos${UNAME_RELEASE}
- exit ;;
- i*86:*DOS:*:*)
- echo ${UNAME_MACHINE}-pc-msdosdjgpp
- exit ;;
- 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 ;;
- i*86:*:5:[678]*)
- # UnixWare 7.x, OpenUNIX and OpenServer 6.
- case `/bin/uname -X | grep "^Machine"` in
- *486*) UNAME_MACHINE=i486 ;;
- *Pentium) UNAME_MACHINE=i586 ;;
- *Pent*|*Celeron) UNAME_MACHINE=i686 ;;
- esac
- echo ${UNAME_MACHINE}-unknown-sysv${UNAME_RELEASE}${UNAME_SYSTEM}${UNAME_VERSION}
- exit ;;
- i*86:*:3.2:*)
- if test -f /usr/options/cb.name; then
- UNAME_REL=`sed -n 's/.*Version //p' </usr/options/cb.name`
- echo ${UNAME_MACHINE}-pc-isc$UNAME_REL
- elif /bin/uname -X 2>/dev/null >/dev/null ; then
- UNAME_REL=`(/bin/uname -X|grep Release|sed -e 's/.*= //')`
- (/bin/uname -X|grep i80486 >/dev/null) && UNAME_MACHINE=i486
- (/bin/uname -X|grep '^Machine.*Pentium' >/dev/null) \
- && UNAME_MACHINE=i586
- (/bin/uname -X|grep '^Machine.*Pent *II' >/dev/null) \
- && UNAME_MACHINE=i686
- (/bin/uname -X|grep '^Machine.*Pentium Pro' >/dev/null) \
- && UNAME_MACHINE=i686
- echo ${UNAME_MACHINE}-pc-sco$UNAME_REL
- else
- echo ${UNAME_MACHINE}-pc-sysv32
- fi
- exit ;;
- 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 ;;
- Intel:Mach:3*:*)
- echo i386-pc-mach3
- exit ;;
- paragon:*:*:*)
- echo i860-intel-osf1
- exit ;;
- 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 ;;
- mini*:CTIX:SYS*5:*)
- # "miniframe"
- echo m68010-convergent-sysv
- exit ;;
- mc68k:UNIX:SYSTEM5:3.51m)
- echo m68k-convergent-sysv
- exit ;;
- M680?0:D-NIX:5.3:*)
- echo m68k-diab-dnix
- exit ;;
- M68*:*:R3V[5678]*:*)
- test -r /sysV68 && { echo 'm68k-motorola-sysv'; exit; } ;;
- 3[345]??:*:4.0:3.0 | 3[34]??A:*:4.0:3.0 | 3[34]??,*:*:4.0:3.0 | 3[34]??/*:*:4.0:3.0 | 4400:*:4.0:3.0 | 4850:*:4.0:3.0 | SKA40:*:4.0:3.0 | SDS2:*:4.0:3.0 | SHG2:*:4.0:3.0 | S7501*:*: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; }
- /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \
- && { echo i586-ncr-sysv4.3${OS_REL}; exit; } ;;
- 3[34]??:*:4.0:* | 3[34]??,*:*:4.0:*)
- /bin/uname -p 2>/dev/null | grep 86 >/dev/null \
- && { echo i486-ncr-sysv4; exit; } ;;
- m68*:LynxOS:2.*:* | m68*:LynxOS:3.0*:*)
- echo m68k-unknown-lynxos${UNAME_RELEASE}
- exit ;;
- mc68030:UNIX_System_V:4.*:*)
- echo m68k-atari-sysv4
- exit ;;
- TSUNAMI:LynxOS:2.*:*)
- echo sparc-unknown-lynxos${UNAME_RELEASE}
- exit ;;
- rs6000:LynxOS:2.*:*)
- echo rs6000-unknown-lynxos${UNAME_RELEASE}
- exit ;;
- PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:* | PowerPC:LynxOS:4.0*:*)
- echo powerpc-unknown-lynxos${UNAME_RELEASE}
- exit ;;
- SM[BE]S:UNIX_SV:*:*)
- echo mips-dde-sysv${UNAME_RELEASE}
- exit ;;
- RM*:ReliantUNIX-*:*:*)
- echo mips-sni-sysv4
- exit ;;
- RM*:SINIX-*:*:*)
- echo mips-sni-sysv4
- exit ;;
- *: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 ;;
- PENTIUM:*:4.0*:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort
- # says <Richard.M.Bartel@ccMail.Census.GOV>
- echo i586-unisys-sysv4
- exit ;;
- *:UNIX_System_V:4*:FTX*)
- # From Gerald Hewes <hewes@openmarket.com>.
- # How about differentiating between stratus architectures? -djm
- echo hppa1.1-stratus-sysv4
- exit ;;
- *:*:*:FTX*)
- # From seanf@swdc.stratus.com.
- echo i860-stratus-sysv4
- exit ;;
- i*86:VOS:*:*)
- # From Paul.Green@stratus.com.
- echo ${UNAME_MACHINE}-stratus-vos
- exit ;;
- *:VOS:*:*)
- # From Paul.Green@stratus.com.
- echo hppa1.1-stratus-vos
- exit ;;
- mc68*:A/UX:*:*)
- echo m68k-apple-aux${UNAME_RELEASE}
- exit ;;
- news*:NEWS-OS:6*:*)
- echo mips-sony-newsos6
- exit ;;
- 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 ;;
- BeBox:BeOS:*:*) # BeOS running on hardware made by Be, PPC only.
- echo powerpc-be-beos
- exit ;;
- BeMac:BeOS:*:*) # BeOS running on Mac or Mac clone, PPC only.
- echo powerpc-apple-beos
- exit ;;
- BePC:BeOS:*:*) # BeOS running on Intel PC compatible.
- echo i586-pc-beos
- exit ;;
- SX-4:SUPER-UX:*:*)
- echo sx4-nec-superux${UNAME_RELEASE}
- exit ;;
- SX-5:SUPER-UX:*:*)
- echo sx5-nec-superux${UNAME_RELEASE}
- exit ;;
- SX-6:SUPER-UX:*:*)
- echo sx6-nec-superux${UNAME_RELEASE}
- exit ;;
- Power*:Rhapsody:*:*)
- echo powerpc-apple-rhapsody${UNAME_RELEASE}
- exit ;;
- *:Rhapsody:*:*)
- echo ${UNAME_MACHINE}-apple-rhapsody${UNAME_RELEASE}
- exit ;;
- *:Darwin:*:*)
- UNAME_PROCESSOR=`uname -p` || UNAME_PROCESSOR=unknown
- case $UNAME_PROCESSOR in
- unknown) UNAME_PROCESSOR=powerpc ;;
- esac
- echo ${UNAME_PROCESSOR}-apple-darwin${UNAME_RELEASE}
- exit ;;
- *:procnto*:*:* | *:QNX:[0123456789]*:*)
- UNAME_PROCESSOR=`uname -p`
- if test "$UNAME_PROCESSOR" = "x86"; then
- UNAME_PROCESSOR=i386
- UNAME_MACHINE=pc
- fi
- echo ${UNAME_PROCESSOR}-${UNAME_MACHINE}-nto-qnx${UNAME_RELEASE}
- exit ;;
- *:QNX:*:4*)
- echo i386-pc-qnx
- exit ;;
- NSE-?:NONSTOP_KERNEL:*:*)
- echo nse-tandem-nsk${UNAME_RELEASE}
- exit ;;
- NSR-?:NONSTOP_KERNEL:*:*)
- echo nsr-tandem-nsk${UNAME_RELEASE}
- exit ;;
- *:NonStop-UX:*:*)
- echo mips-compaq-nonstopux
- exit ;;
- BS2000:POSIX*:*:*)
- echo bs2000-siemens-sysv
- exit ;;
- DS/*:UNIX_System_V:*:*)
- echo ${UNAME_MACHINE}-${UNAME_SYSTEM}-${UNAME_RELEASE}
- exit ;;
- *: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 ;;
- *:TOPS-10:*:*)
- echo pdp10-unknown-tops10
- exit ;;
- *:TENEX:*:*)
- echo pdp10-unknown-tenex
- exit ;;
- KS10:TOPS-20:*:* | KL10:TOPS-20:*:* | TYPE4:TOPS-20:*:*)
- echo pdp10-dec-tops20
- exit ;;
- XKL-1:TOPS-20:*:* | TYPE5:TOPS-20:*:*)
- echo pdp10-xkl-tops20
- exit ;;
- *:TOPS-20:*:*)
- echo pdp10-unknown-tops20
- exit ;;
- *:ITS:*:*)
- echo pdp10-unknown-its
- exit ;;
- SEI:*:*:SEIUX)
- echo mips-sei-seiux${UNAME_RELEASE}
- exit ;;
- *:DragonFly:*:*)
- echo ${UNAME_MACHINE}-unknown-dragonfly`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`
- exit ;;
- *:*VMS:*:*)
- UNAME_MACHINE=`(uname -p) 2>/dev/null`
- case "${UNAME_MACHINE}" in
- A*) echo alpha-dec-vms ; exit ;;
- I*) echo ia64-dec-vms ; exit ;;
- V*) echo vax-dec-vms ; exit ;;
- esac ;;
- *:XENIX:*:SysV)
- echo i386-pc-xenix
- exit ;;
- i*86:skyos:*:*)
- echo ${UNAME_MACHINE}-pc-skyos`echo ${UNAME_RELEASE}` | sed -e 's/ .*$//'
- exit ;;
- i*86:rdos:*:*)
- echo ${UNAME_MACHINE}-pc-rdos
- exit ;;
-esac
-
-#echo '(No uname command or uname output not recognized.)' 1>&2
-#echo "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" 1>&2
-
-eval $set_cc_for_build
-cat >$dummy.c <<EOF
-#ifdef _SEQUENT_
-# include <sys/types.h>
-# include <sys/utsname.h>
-#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 <sys/param.h>
- 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\n"); 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 <sys/param.h>
-# 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 -o $dummy $dummy.c 2>/dev/null && SYSTEM_NAME=`$dummy` &&
- { echo "$SYSTEM_NAME"; exit; }
-
-# Apollos put the system type in the environment.
-
-test -d /usr/apollo && { echo ${ISP}-apollo-${SYSTYPE}; exit; }
-
-# 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 ;;
- c2*)
- if getsysinfo -f scalar_acc
- then echo c32-convex-bsd
- else echo c2-convex-bsd
- fi
- exit ;;
- c34*)
- echo c34-convex-bsd
- exit ;;
- c38*)
- echo c38-convex-bsd
- exit ;;
- c4*)
- echo c4-convex-bsd
- exit ;;
- esac
-fi
-
-cat >&2 <<EOF
-$0: unable to guess system type
-
-This script, last modified $timestamp, has failed to recognize
-the operating system you are using. It is advised that you
-download the most up to date version of the config scripts from
-
- http://savannah.gnu.org/cgi-bin/viewcvs/*checkout*/config/config/config.guess
-and
- http://savannah.gnu.org/cgi-bin/viewcvs/*checkout*/config/config/config.sub
-
-If the version you run ($0) is already up to date, please
-send the following data and any information you think might be
-pertinent to <config-patches@gnu.org> 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:
Index: branches/ohl/omega-development/hgg-vertex/hgg-notes.tex
===================================================================
--- branches/ohl/omega-development/hgg-vertex/hgg-notes.tex (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/hgg-notes.tex (revision 8717)
@@ -1,1609 +0,0 @@
-% $Id$
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\documentclass[12pt,a4paper]{article}
-\usepackage{graphicx}
- \DeclareGraphicsRule{*}{mps}{*}{}
-\usepackage{feynmp}
-\usepackage{amsmath}
-\allowdisplaybreaks
-\begin{document}
-\setlength{\unitlength}{1mm}
-\begin{fmffile}{\jobname pics}
-\fmfset{arrow_ang}{10}
-\fmfset{curly_len}{2mm}
-\fmfset{wiggly_len}{3mm}
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\newcommand{\setupggH}{%
- \fmfi{dashes}{(0.5w,0.1h)--(0.5w,0.9h)}
- \fmfipath{loop}
- \fmfiset{loop}{fullcircle scaled 0.5w shifted c}
- \fmfipath{projt,projb}
- \fmfipair{Hl,Hr}
- \fmfiset{projt}{subpath ((0/2,1/2)*length loop) of loop}
- \fmfiset{projb}{subpath ((1/2,2/2)*length loop) of loop}
- \fmfiset{Hr}{point (0/2*length loop) of loop}
- \fmfiset{Hl}{point (1/2*length loop) of loop}}
-\newcommand{\setupggHamp}{%
- \fmfipath{loop}
- \fmfiset{loop}{halfcircle rotated -90 scaled w shifted (0,w)}
- \fmfipath{projt,projb}
- \fmfipair{H}
- \fmfiset{projt}{subpath ((1/2,2/2)*length loop) of loop}
- \fmfiset{projb}{subpath ((0/2,1/2)*length loop) of loop}
- \fmfiset{H}{point (1/2*length loop) of loop}}
-\newcommand{\setupggHH}{%
- \fmfi{dashes}{(0.5w,0.1h)--(0.5w,0.9h)}
- \fmfipath{loop}
- \fmfiset{loop}{fullcircle rotated 45 scaled 0.5w shifted c}
- \fmfipath{propl,propr,projt,projb}
- \fmfipair{Hlt,Hlb,Hrt,Hrb}
- \fmfiset{projt}{subpath ((0/4,1/4)*length loop) of loop}
- \fmfiset{propl}{subpath ((1/4,2/4)*length loop) of loop}
- \fmfiset{projb}{subpath ((2/4,3/4)*length loop) of loop}
- \fmfiset{propr}{subpath ((3/4,4/4)*length loop) of loop}
- \fmfiset{Hrt}{point (0/4*length loop) of loop}
- \fmfiset{Hlt}{point (1/4*length loop) of loop}
- \fmfiset{Hlb}{point (2/4*length loop) of loop}
- \fmfiset{Hrb}{point (3/4*length loop) of loop}}
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\fmfcmd{%
- numeric joindiameter;
- joindiameter := 7thick;}
-\fmfcmd{%
- vardef sideways_at (expr d, p, frac) =
- save len; len = length p;
- (point frac*len of p) shifted ((d,0) rotated (90 + angle direction frac*len of p))
- enddef;
- secondarydef p sideways d =
- for frac = 0 step 0.01 until 0.99:
- sideways_at (d, p, frac) ..
- endfor
- sideways_at (d, p, 1)
- enddef;
- secondarydef p choptail d =
- subpath (ypart (fullcircle scaled d shifted (point 0 of p) intersectiontimes p), infinity) of p
- enddef;
- secondarydef p choptip d =
- reverse ((reverse p) choptail d)
- enddef;
- secondarydef p pointtail d =
- fullcircle scaled d shifted (point 0 of p) intersectionpoint p
- enddef;
- secondarydef p pointtip d =
- (reverse p) pointtail d
- enddef;
- secondarydef pa join pb =
- pa choptip joindiameter .. pb choptail joindiameter
- enddef;
- vardef cyclejoin (expr p) =
- subpath (0.5*length p, infinity) of p join subpath (0, 0.5*length p) of p .. cycle
- enddef;}
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\fmfcmd{%
- style_def double_line_arrow expr p =
- save pi, po;
- path pi, po;
- pi = reverse (p sideways thick);
- po = p sideways -thick;
- cdraw pi;
- cdraw po;
- cfill (arrow pi);
- cfill (arrow po);
- enddef;}
-\fmfcmd{%
- style_def double_line_arrow_beg expr p =
- save pi, po, pc;
- path pi, po, pc;
- pc = p choptail 7thick;
- pi = reverse (pc sideways thick);
- po = pc sideways -thick;
- cdraw pi .. p pointtail 5thick .. po;
- cfill (arrow pi);
- cfill (arrow po);
- enddef;}
-\fmfcmd{%
- style_def double_line_arrow_end expr p =
- save pi, po, pc;
- path pi, po, pc;
- pc = p choptip 7thick;
- pi = reverse (pc sideways thick);
- po = pc sideways -thick;
- cdraw po .. p pointtip 5thick .. pi;
- cfill (arrow pi);
- cfill (arrow po);
- enddef;}
-\fmfcmd{%
- style_def double_line_arrow_both expr p =
- save pi, po, pc;
- path pi, po, pc;
- pc = p choptip 7thick choptail 7thick;
- pi = reverse (pc sideways thick);
- po = pc sideways -thick;
- cdraw po .. p pointtip 5thick .. pi .. p pointtail 5thick .. cycle;
- cfill (arrow pi);
- cfill (arrow po);
- enddef;}
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\newcommand{\G}[1]{%
- \fmfi{dots,label=\footnotesize$\frac{-1}{N_C}$,label.dist=4thick}{#1}}
-\newcommand{\A}[1]{%
- \fmfi{dbl_dots,label=\footnotesize$N_C$,label.dist=4thick}{#1}}
-\newcommand{\C}[1]{%
- \fmfi{double_line_arrow_both,label=\footnotesize$N_C$,label.dist=5thick}{#1}}
-\newcommand{\g}[2]{\fmfi{#1}{#2}}
-\newcommand{\Hgg}[1]{\fmfiv{d.shape=circle,d.size=3thick,d.filled=full}{#1}}
-\newcommand{\HGG}[1]{%
- \fmfiv{d.shape=circle,d.size=3thick,d.filled=full,%
- label=\footnotesize$N_C$,label.dist=2thick}{#1}}
-\newcommand{\HCA}[1]{%
- \fmfiv{d.shape=circle,d.size=3thick,d.filled=full,%
- label=\footnotesize$\frac{1}{N_C}$,label.dist=2thick}{#1}}
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{Naive Feynman Rules}
-From the color flows in the triangle diagram\par\hfil
-\begin{multline}
-\parbox{25\unitlength}{%
- \begin{fmfgraph*}(25,25)
- \fmfleft{g2,g1}
- \fmfright{H}
- \fmflabel{$ij$}{g1}
- \fmflabel{$kl$}{g2}
- \fmf{gluon}{v1,g1}
- \fmf{gluon}{g2,v2}
- \fmf{fermion,tension=0.5}{v1,v2,vH,v1}
- \fmf{plain}{vH,H}
- \fmfdot{v1,v2,vH}
- \end{fmfgraph*}} \Longleftrightarrow
-\parbox{25\unitlength}{%
- \begin{fmfgraph*}(25,25)
- \fmfleft{g2,g1}
- \fmfright{H}
- \fmflabel{$ij$}{g1}
- \fmflabel{$ij$}{g2}
- \fmf{phantom}{g2,v2}
- \fmf{phantom}{v1,g1}
- \fmf{phantom_arrow,tension=0.5}{v1,v2,vH,v1}
- \fmf{plain}{vH,H}
- \fmffreeze
- \fmfi{phantom_arrow}{vpath (__g1, __v1) sideways -thick}
- \fmfi{phantom_arrow}{(reverse vpath (__g1, __v1)) sideways -thick}
- \fmfi{phantom_arrow}{vpath (__g2, __v2) sideways -thick}
- \fmfi{phantom_arrow}{(reverse vpath (__g2, __v2)) sideways -thick}
- \fmfi{plain}{%
- vpath (__g2, __v2) sideways -thick
- join vpath (__v2, __vH)
- join vpath (__vH, __v1)
- join vpath (__v1, __g1) sideways -thick}
- \fmfi{plain}{%
- (reverse vpath (__v1, __g1)) sideways -thick
- join vpath (__v2, __v1)
- join (reverse vpath (__v2, __g2)) sideways -thick}
- \fmfdot{vH}
- \end{fmfgraph*}}
-\parbox{25\unitlength}{%
- \begin{fmfgraph*}(25,25)
- \fmfleft{g2,g1}
- \fmfright{H}
- \fmflabel{$ii$}{g1}
- \fmf{phantom}{v1,g1}
- \fmf{dots}{g2,v2}
- \fmf{phantom_arrow,tension=0.5}{v2,vH,v1,v2}
- \fmf{plain}{vH,H}
- \fmffreeze
- \fmfi{phantom_arrow}{vpath (__g1, __v1) sideways -thick}
- \fmfi{phantom_arrow}{(reverse vpath (__g1, __v1)) sideways -thick}
- \fmfi{plain}{%
- (reverse vpath (__v1, __g1)) sideways -thick
- join vpath (__v1, __v2)
- join vpath (__v2, __vH)
- join vpath (__vH, __v1)
- join vpath (__v1, __g1) sideways -thick}
- \fmfdot{v2,vH}
- \end{fmfgraph*}}
-\parbox{25\unitlength}{%
- \begin{fmfgraph*}(25,25)
- \fmfleft{g2,g1}
- \fmfright{H}
- \fmflabel{$ii$}{g2}
- \fmf{dots}{g1,v1}
- \fmf{phantom}{g2,v2}
- \fmf{phantom_arrow,tension=0.5}{v1,v2,vH,v1}
- \fmf{plain}{vH,H}
- \fmffreeze
- \fmfi{phantom_arrow}{vpath (__g2, __v2) sideways -thick}
- \fmfi{phantom_arrow}{(reverse vpath (__g2, __v2)) sideways -thick}
- \fmfi{plain}{%
- vpath (__g2, __v2) sideways -thick
- join vpath (__v2, __vH)
- join vpath (__vH, __v1)
- join vpath (__v1, __v2)
- join (reverse vpath (__v2, __g2)) sideways -thick}
- \fmfdot{v1,vH}
- \end{fmfgraph*}}
-\parbox{25\unitlength}{%
- \begin{fmfgraph*}(25,25)
- \fmfleft{g2,g1}
- \fmfright{H}
- \fmf{dots}{g1,v1}
- \fmf{dots}{g2,v2}
- \fmf{phantom_arrow,tension=0.5}{v1,v2,vH,v1}
- \fmf{plain}{vH,H}
- \fmffreeze
- \fmfi{plain}{%
- cyclejoin ( vpath (__v2, __vH)
- join vpath (__vH, __v1)
- join vpath (__v1, __v2))}
- \fmfdot{v1,v2,vH}
- \end{fmfgraph*}}
-\end{multline}
-\hfil\\
-it appears that we can derive a set of equivalent Feynman rules\par\hfil
-\begin{multline}
-\parbox{25\unitlength}{%
- \begin{fmfgraph*}(25,25)
- \fmfleft{g2,g1}
- \fmfright{H}
- \fmflabel{$ij$}{g1}
- \fmflabel{$kl$}{g2}
- \fmf{gluon}{v,g1}
- \fmf{gluon}{g2,v}
- \fmf{plain}{v,H}
- \fmfdot{v}
- \end{fmfgraph*}} \Longleftrightarrow
-\parbox{25\unitlength}{%
- \begin{fmfgraph*}(25,25)
- \fmfleft{g2,g1}
- \fmfright{H}
- \fmflabel{$ij$}{g1}
- \fmflabel{$ij$}{g2}
- \fmf{phantom}{v,g1}
- \fmf{phantom}{g2,v}
- \fmf{plain}{v,H}
- \fmffreeze
- \fmfi{phantom_arrow}{vpath (__g1, __v) sideways -thick}
- \fmfi{phantom_arrow}{(reverse vpath (__g1, __v)) sideways -thick}
- \fmfi{phantom_arrow}{vpath (__g2, __v) sideways -thick}
- \fmfi{phantom_arrow}{(reverse vpath (__g2, __v)) sideways -thick}
- \fmfi{plain}{%
- (vpath (__g2, __v) join vpath (__v, __g1)) sideways -thick}
- \fmfi{plain}{%
- (vpath (__g2, __v) join vpath (__v, __g1)) sideways thick}
- \fmfdot{v}
- \end{fmfgraph*}}
-\parbox{25\unitlength}{%
- \begin{fmfgraph*}(25,25)
- \fmfleft{g2,g1}
- \fmfright{H}
- \fmflabel{$ii$}{g1}
- \fmf{double_line_arrow_end}{g1,v}
- \fmf{dots}{g2,v}
- \fmf{plain}{v,H}
- \fmfdot{v}
- \end{fmfgraph*}}
-\parbox{25\unitlength}{%
- \begin{fmfgraph*}(25,25)
- \fmfleft{g2,g1}
- \fmfright{H}
- \fmf{dots}{g1,v}
- \fmflabel{$ii$}{g2}
- \fmf{double_line_arrow_end}{g2,v}
- \fmf{plain}{v,H}
- \fmfdot{v}
- \end{fmfgraph*}}
-\parbox{25\unitlength}{%
- \begin{fmfgraph*}(25,25)
- \fmfleft{g2,g1}
- \fmfright{H}
- \fmf{dots}{g1,v}
- \fmf{dots}{g2,v}
- \fmf{plain}{v,H}
- \fmfv{d.shape=circle,d.size=3thick,d.filled=full,
- label=\footnotesize$N_C$,label.dist=2thick,label.ang=60}{v}
- \end{fmfgraph*}}
-\end{multline}
-with \emph{both} $i\not=j$ and $i=j$! However, there's no\par\hfil
-\begin{equation}
-\parbox{25\unitlength}{%
- \begin{fmfgraph*}(25,25)
- \fmfleft{g2,g1}
- \fmfright{H}
- \fmflabel{$ii$}{g1}
- \fmflabel{$jj$}{g2}
- \fmf{double_line_arrow_end}{g1,v}
- \fmf{double_line_arrow_end}{g2,v}
- \fmf{plain}{v,H}
- \fmfdot{v}
- \end{fmfgraph*}}
-\end{equation}
-with $i\not=j$.
-
-
-\subsection{$gg\to H$}
-\begin{multline}
-\parbox{25\unitlength}{%
- \begin{fmfgraph*}(25,25)
- \fmfi{dashes}{(0.5w,0.1h)--(0.5w,0.9h)}
- \fmftop{g1}
- \fmfbottom{g2}
- \fmfleft{Hl}
- \fmfright{Hr}
- \fmf{gluon}{vr1,g1}
- \fmf{gluon}{g2,vr2}
- \fmf{gluon}{g1,vl1}
- \fmf{gluon}{vl2,g2}
- \fmf{fermion}{vr1,vr2,Hr,vr1}
- \fmf{fermion}{vl1,vl2,Hl,vl1}
- \fmfdot{vr1,vr2,Hr}
- \fmfdot{vl1,vl2,Hl}
- \end{fmfgraph*}} =
-\parbox{25\unitlength}{%
- \begin{fmfgraph*}(25,25)
- \fmfi{dashes}{(0.5w,0.1h)--(0.5w,0.9h)}
- \fmftop{g1}
- \fmfbottom{g2}
- \fmfleft{Hl}
- \fmfright{Hr}
- \fmf{phantom}{vr1,g1}
- \fmf{phantom}{g2,vr2}
- \fmf{phantom}{g1,vl1}
- \fmf{phantom}{vl2,g2}
- \fmf{phantom_arrow}{vr1,vr2,Hr,vr1}
- \fmf{phantom_arrow}{vl1,vl2,Hl,vl1}
- \fmfdot{vr1,vr2,Hr}
- \fmfdot{vl1,vl2,Hl}
- \end{fmfgraph*}} +
-\parbox{25\unitlength}{%
- \begin{fmfgraph*}(25,25)
- \fmfi{dashes}{(0.5w,0.1h)--(0.5w,0.9h)}
- \fmftop{g1}
- \fmfbottom{g2}
- \fmfleft{Hl}
- \fmfright{Hr}
- \fmf{dots}{vr1,g1}
- \fmf{phantom}{g2,vr2}
- \fmf{dots}{g1,vl1}
- \fmf{phantom}{vl2,g2}
- \fmf{phantom_arrow}{vr1,vr2,Hr,vr1}
- \fmf{phantom_arrow}{vl1,vl2,Hl,vl1}
- \fmfdot{vr1,vr2,Hr}
- \fmfdot{vl1,vl2,Hl}
- \end{fmfgraph*}} +
-\parbox{25\unitlength}{%
- \begin{fmfgraph*}(25,25)
- \fmfi{dashes}{(0.5w,0.1h)--(0.5w,0.9h)}
- \fmftop{g1}
- \fmfbottom{g2}
- \fmfleft{Hl}
- \fmfright{Hr}
- \fmf{phantom}{vr1,g1}
- \fmf{dots}{g2,vr2}
- \fmf{phantom}{g1,vl1}
- \fmf{dots}{vl2,g2}
- \fmf{phantom_arrow}{vr1,vr2,Hr,vr1}
- \fmf{phantom_arrow}{vl1,vl2,Hl,vl1}
- \fmfdot{vr1,vr2,Hr}
- \fmfdot{vl1,vl2,Hl}
- \end{fmfgraph*}} +
-\parbox{25\unitlength}{%
- \begin{fmfgraph*}(25,25)
- \fmfi{dashes}{(0.5w,0.1h)--(0.5w,0.9h)}
- \fmftop{g1}
- \fmfbottom{g2}
- \fmfleft{Hl}
- \fmfright{Hr}
- \fmf{dots}{vr1,g1}
- \fmf{dots}{g2,vr2}
- \fmf{dots}{g1,vl1}
- \fmf{dots}{vl2,g2}
- \fmf{phantom_arrow}{vr1,vr2,Hr,vr1}
- \fmf{phantom_arrow}{vl1,vl2,Hl,vl1}
- \fmfdot{vr1,vr2,Hr}
- \fmfdot{vl1,vl2,Hl}
- \end{fmfgraph*}}
-\end{multline}
-This works
-\begin{equation}
-\parbox{20\unitlength}{%
- \begin{fmfgraph*}(20,35)
- \setupggHamp
- \g{gluon}{projt}
- \g{gluon}{projb}
- \Hgg{H}
- \end{fmfgraph*}} =
-\parbox{20\unitlength}{%
- \begin{fmfgraph*}(20,35)
- \setupggHamp
- \fmfi{double_line_arrow}{projt}
- \fmfi{double_line_arrow}{projb}
- \Hgg{H}
- \end{fmfgraph*}} +
-\parbox{20\unitlength}{%
- \begin{fmfgraph*}(20,35)
- \setupggHamp
- \fmfi{double_line_arrow_beg}{projt}
- \g{dots}{projb}
- \Hgg{H}
- \end{fmfgraph*}} +
-\parbox{20\unitlength}{%
- \begin{fmfgraph*}(20,35)
- \setupggHamp
- \g{dots}{projt}
- \fmfi{double_line_arrow_end}{projb}
- \Hgg{H}
- \end{fmfgraph*}} +
-\parbox{20\unitlength}{%
- \begin{fmfgraph*}(20,35)
- \setupggHamp
- \g{dots}{projt}
- \g{dots}{projb}
- \HGG{H}
- \end{fmfgraph*}}
-\end{equation}
-because there are no interferences at all:
-\begin{multline}
-\parbox{35\unitlength}{%
- \begin{fmfgraph*}(35,35)
- \setupggH
- \g{gluon}{projt}
- \g{gluon}{projb}
- \Hgg{Hl}
- \Hgg{Hr}
- \end{fmfgraph*}} =
-\parbox{35\unitlength}{%
- \begin{fmfgraph*}(35,35)
- \setupggH
- \g{double_line_arrow,label=\footnotesize$N_C^2$,label.dist=5thick}{projt}
- \g{double_line_arrow}{projb}
- \Hgg{Hl}
- \Hgg{Hr}
- \end{fmfgraph*}} \\ +
-\parbox{35\unitlength}{%
- \begin{fmfgraph*}(35,35)
- \setupggH
- \G{projt}
- \C{projb}
- \Hgg{Hl}
- \Hgg{Hr}
- \end{fmfgraph*}} +
-\parbox{35\unitlength}{%
- \begin{fmfgraph*}(35,35)
- \setupggH
- \C{projt}
- \G{projb}
- \Hgg{Hl}
- \Hgg{Hr}
- \end{fmfgraph*}} +
-\parbox{35\unitlength}{%
- \begin{fmfgraph*}(35,35)
- \setupggH
- \G{projt}
- \G{projb}
- \HGG{Hl}
- \HGG{Hr}
- \end{fmfgraph*}} \\ =
- N_C^2 - \frac{N_C}{N_C} - \frac{N_C}{N_C} + \frac{N_C^2}{N_C^2} = N_C^2 - 1
-\end{multline}
-
-%%% \subsubsection{Potential Problem Child}
-%%% \begin{equation}
-%%% \parbox{35\unitlength}{%
-%%% \begin{fmfgraph*}(35,35)
-%%% \setupggH
-%%% \C{projt}
-%%% \C{projb}
-%%% \Hgg{Hl}
-%%% \Hgg{Hr}
-%%% \end{fmfgraph*}}
-%%% \end{equation}
-%%% will not be generated, if each color flow index crosses the cut twice
-%%% (NB: $i=j$ in the vertices).
-
-\subsection{$gg\to HH$}
-This almost works, but can't be implemented easily (see below):
-\begin{multline}
-\parbox{35\unitlength}{%
- \begin{fmfgraph*}(35,35)
- \setupggHH
- \g{gluon}{projt}
- \g{gluon}{propl}
- \g{gluon}{projb}
- \g{gluon}{propr}
- \Hgg{Hlt}
- \Hgg{Hlb}
- \Hgg{Hrt}
- \Hgg{Hrb}
- \end{fmfgraph*}} =
-\parbox{35\unitlength}{%
- \begin{fmfgraph*}(35,35)
- \setupggHH
- \g{double_line_arrow,label=\footnotesize$N_C^2$,label.dist=5thick}{projt}
- \g{double_line_arrow}{propl}
- \g{double_line_arrow}{projb}
- \g{double_line_arrow}{propr}
- \Hgg{Hlt}
- \Hgg{Hlb}
- \Hgg{Hrt}
- \Hgg{Hrb}
- \end{fmfgraph*}} \\ +
-\parbox{35\unitlength}{%
- \begin{fmfgraph*}(35,35)
- \setupggHH
- \g{double_line_arrow_end}{projt}
- \G{propl}
- \g{double_line_arrow_beg}{projb}
- \g{double_line_arrow,label=\footnotesize$N_C$}{propr}
- \Hgg{Hlt}
- \Hgg{Hlb}
- \Hgg{Hrt}
- \Hgg{Hrb}
- \end{fmfgraph*}} +
-\parbox{35\unitlength}{%
- \begin{fmfgraph*}(35,35)
- \setupggHH
- \g{double_line_arrow_beg}{projt}
- \g{double_line_arrow,label=\footnotesize$N_C$}{propl}
- \g{double_line_arrow_end}{projb}
- \G{propr}
- \Hgg{Hlt}
- \Hgg{Hlb}
- \Hgg{Hrt}
- \Hgg{Hrb}
- \end{fmfgraph*}} +
-\parbox{35\unitlength}{%
- \begin{fmfgraph*}(35,35)
- \setupggHH
- \g{double_line_arrow_both,label=\footnotesize$N_C$}{projt}
- \G{propl}
- \g{double_line_arrow_both,label=\footnotesize$N_C$}{projb}
- \G{propr}
- \Hgg{Hlt}
- \Hgg{Hlb}
- \Hgg{Hrt}
- \Hgg{Hrb}
- \end{fmfgraph*}} \\ +
-\parbox{35\unitlength}{%
- \begin{fmfgraph*}(35,35)
- \setupggHH
- \g{double_line_arrow,label=\footnotesize$N_C$}{projt}
- \g{double_line_arrow_end}{propl}
- \G{projb}
- \g{double_line_arrow_beg}{propr}
- \Hgg{Hlt}
- \Hgg{Hlb}
- \Hgg{Hrt}
- \Hgg{Hrb}
- \end{fmfgraph*}} +
-\parbox{35\unitlength}{%
- \begin{fmfgraph*}(35,35)
- \setupggHH
- \g{double_line_arrow_end}{projt}
- \G{propl}
- \G{projb}
- \g{double_line_arrow_beg,label=\footnotesize$N_C$}{propr}
- \Hgg{Hlt}
- \HGG{Hlb}
- \Hgg{Hrt}
- \Hgg{Hrb}
- \end{fmfgraph*}} +
-\parbox{35\unitlength}{%
- \begin{fmfgraph*}(35,35)
- \setupggHH
- \g{double_line_arrow_beg,label=\footnotesize$N_C$}{projt}
- \g{double_line_arrow_end}{propl}
- \G{projb}
- \G{propr}
- \Hgg{Hlt}
- \Hgg{Hlb}
- \Hgg{Hrt}
- \HGG{Hrb}
- \end{fmfgraph*}} +
-\parbox{35\unitlength}{%
- \begin{fmfgraph*}(35,35)
- \setupggHH
- \g{double_line_arrow_both,label=\footnotesize$N_C$}{projt}
- \G{propl}
- \G{projb}
- \G{propr}
- \Hgg{Hlt}
- \HGG{Hlb}
- \Hgg{Hrt}
- \HGG{Hrb}
- \end{fmfgraph*}} \\ +
-\parbox{35\unitlength}{%
- \begin{fmfgraph*}(35,35)
- \setupggHH
- \G{projt}
- \g{double_line_arrow_beg}{propl}
- \g{double_line_arrow,label=\footnotesize$N_C$,label.dist=5thick}{projb}
- \g{double_line_arrow_end}{propr}
- \Hgg{Hlt}
- \Hgg{Hlb}
- \Hgg{Hrt}
- \Hgg{Hrb}
- \end{fmfgraph*}} +
-\parbox{35\unitlength}{%
- \begin{fmfgraph*}(35,35)
- \setupggHH
- \G{projt}
- \G{propl}
- \g{double_line_arrow_beg,label=\footnotesize$N_C$}{projb}
- \g{double_line_arrow_end}{propr}
- \HGG{Hlt}
- \Hgg{Hlb}
- \Hgg{Hrt}
- \Hgg{Hrb}
- \end{fmfgraph*}} +
-\parbox{35\unitlength}{%
- \begin{fmfgraph*}(35,35)
- \setupggHH
- \G{projt}
- \g{double_line_arrow_beg,label=\footnotesize$N_C$}{propl}
- \g{double_line_arrow_end}{projb}
- \G{propr}
- \Hgg{Hlt}
- \Hgg{Hlb}
- \HGG{Hrt}
- \Hgg{Hrb}
- \end{fmfgraph*}} +
-\parbox{35\unitlength}{%
- \begin{fmfgraph*}(35,35)
- \setupggHH
- \G{projt}
- \G{propl}
- \g{double_line_arrow_both,label=\footnotesize$N_C$}{projb}
- \G{propr}
- \HGG{Hlt}
- \Hgg{Hlb}
- \HGG{Hrt}
- \Hgg{Hrb}
- \end{fmfgraph*}} \\ +
-\parbox{35\unitlength}{%
- \begin{fmfgraph*}(35,35)
- \setupggHH
- \G{projt}
- \g{double_line_arrow_both,label=\footnotesize$N_C$}{propl}
- \G{projb}
- \g{double_line_arrow_both,label=\footnotesize$N_C$}{propr}
- \Hgg{Hlt}
- \Hgg{Hlb}
- \Hgg{Hrt}
- \Hgg{Hrb}
- \end{fmfgraph*}} +
-\parbox{35\unitlength}{%
- \begin{fmfgraph*}(35,35)
- \setupggHH
- \G{projt}
- \G{propl}
- \G{projb}
- \g{double_line_arrow_both,label=\footnotesize$N_C$}{propr}
- \HGG{Hlt}
- \HGG{Hlb}
- \Hgg{Hrt}
- \Hgg{Hrb}
- \end{fmfgraph*}} +
-\parbox{35\unitlength}{%
- \begin{fmfgraph*}(35,35)
- \setupggHH
- \G{projt}
- \g{double_line_arrow_both,label=\footnotesize$N_C$}{propl}
- \G{projb}
- \G{propr}
- \Hgg{Hlt}
- \Hgg{Hlb}
- \HGG{Hrt}
- \HGG{Hrb}
- \end{fmfgraph*}} +
-\parbox{35\unitlength}{%
- \begin{fmfgraph*}(35,35)
- \setupggHH
- \G{projt}
- \G{propl}
- \G{projb}
- \G{propr}
- \HGG{Hlt}
- \HGG{Hlb}
- \HGG{Hrt}
- \HGG{Hrb}
- \end{fmfgraph*}} \\ =
- N_C^2
- - 2 \frac{N_C}{N_C} + \frac{N_C^2}{N_C^2}
- + 2 \left(
- - \frac{N_C}{N_C} + 2 \frac{N_C^2}{N_C^2} - \frac{N_C^3}{N_C^3}
- \right)
- + \frac{N_C^2}{N_C^2} - 2 \frac{N_C^3}{N_C^3} + \frac{N_C^4}{N_C^4} \\
- = N_C^2 - 1 + 2\dot0 + 0 = N_C^2 - 1
-\end{multline}
-
-\subsubsection{Problem Children}
-In
-\begin{equation}
-\parbox{35\unitlength}{%
- \begin{fmfgraph*}(35,35)
- \setupggHH
- \g{double_line_arrow_end}{projt}
- \G{propl}
- \g{double_line_arrow_beg}{projb}
- \g{double_line_arrow,label=\footnotesize$N_C$}{propr}
- \Hgg{Hlt}
- \Hgg{Hlb}
- \Hgg{Hrt}
- \Hgg{Hrb}
- \end{fmfgraph*}}
-\parbox{35\unitlength}{%
- \begin{fmfgraph*}(35,35)
- \setupggHH
- \g{double_line_arrow_beg}{projt}
- \g{double_line_arrow,label=\footnotesize$N_C$}{propl}
- \g{double_line_arrow_end}{projb}
- \G{propr}
- \Hgg{Hlt}
- \Hgg{Hlb}
- \Hgg{Hrt}
- \Hgg{Hrb}
- \end{fmfgraph*}}
-\end{equation}
-the \emph{same} color flow index crosses the cut \emph{four} times!
-In
-\begin{multline}
-\parbox{35\unitlength}{%
- \begin{fmfgraph*}(35,35)
- \setupggHH
- \G{projt}
- \g{double_line_arrow_both,label=\footnotesize$N_C$}{propl}
- \G{projb}
- \G{propr}
- \Hgg{Hlt}
- \Hgg{Hlb}
- \HGG{Hrt}
- \HGG{Hrb}
- \end{fmfgraph*}}
-\parbox{35\unitlength}{%
- \begin{fmfgraph*}(35,35)
- \setupggHH
- \G{projt}
- \G{propl}
- \G{projb}
- \g{double_line_arrow_both,label=\footnotesize$N_C$}{propr}
- \HGG{Hlt}
- \HGG{Hlb}
- \Hgg{Hrt}
- \Hgg{Hrb}
- \end{fmfgraph*}}
-\parbox{35\unitlength}{%
- \begin{fmfgraph*}(35,35)
- \setupggHH
- \G{projt}
- \g{double_line_arrow_both,label=\footnotesize$N_C$}{propl}
- \G{projb}
- \g{double_line_arrow_both,label=\footnotesize$N_C$}{propr}
- \Hgg{Hlt}
- \Hgg{Hlb}
- \Hgg{Hrt}
- \Hgg{Hrb}
- \end{fmfgraph*}}
-\end{multline}
-we have to let the ``diagonal gluons'' propagate (there's one for each
-color flow index \ldots) and we need the factors~$N_C$ (would be
-trivial), otherwise we're missing
-\begin{equation}
- - \frac{N_C^3}{N_C^3} - \frac{N_C^3}{N_C^3} + \frac{N_C^2}{N_C^2} = -1
-\end{equation}
-
-\subsubsection{Brute Force}
-Dropping all $i=j$ propagators misses the mark:
-\begin{multline}
-\parbox{35\unitlength}{%
- \begin{fmfgraph*}(35,35)
- \setupggHH
- \g{gluon}{projt}
- \g{gluon}{propl}
- \g{gluon}{projb}
- \g{gluon}{propr}
- \Hgg{Hlt}
- \Hgg{Hlb}
- \Hgg{Hrt}
- \Hgg{Hrb}
- \end{fmfgraph*}} =
-\parbox{35\unitlength}{%
- \begin{fmfgraph*}(35,35)
- \setupggHH
- \g{double_line_arrow,label=\footnotesize$N_C^2$,label.dist=5thick}{projt}
- \g{double_line_arrow}{propl}
- \g{double_line_arrow}{projb}
- \g{double_line_arrow}{propr}
- \Hgg{Hlt}
- \Hgg{Hlb}
- \Hgg{Hrt}
- \Hgg{Hrb}
- \end{fmfgraph*}} \\ +
-\parbox{35\unitlength}{%
- \begin{fmfgraph*}(35,35)
- \setupggHH
- \g{double_line_arrow_both,label=\footnotesize$N_C$}{projt}
- \G{propl}
- \g{double_line_arrow_both,label=\footnotesize$N_C$}{projb}
- \G{propr}
- \Hgg{Hlt}
- \Hgg{Hlb}
- \Hgg{Hrt}
- \Hgg{Hrb}
- \end{fmfgraph*}} +
-\parbox{35\unitlength}{%
- \begin{fmfgraph*}(35,35)
- \setupggHH
- \g{double_line_arrow_both,label=\footnotesize$N_C$}{projt}
- \G{propl}
- \G{projb}
- \G{propr}
- \Hgg{Hlt}
- \HGG{Hlb}
- \Hgg{Hrt}
- \HGG{Hrb}
- \end{fmfgraph*}} +
-\parbox{35\unitlength}{%
- \begin{fmfgraph*}(35,35)
- \setupggHH
- \G{projt}
- \G{propl}
- \g{double_line_arrow_both,label=\footnotesize$N_C$}{projb}
- \G{propr}
- \HGG{Hlt}
- \Hgg{Hlb}
- \HGG{Hrt}
- \Hgg{Hrb}
- \end{fmfgraph*}} +
-\parbox{35\unitlength}{%
- \begin{fmfgraph*}(35,35)
- \setupggHH
- \G{projt}
- \G{propl}
- \G{projb}
- \G{propr}
- \HGG{Hlt}
- \HGG{Hlb}
- \HGG{Hrt}
- \HGG{Hrb}
- \end{fmfgraph*}} \\ =
- N_C^2
- + \frac{N_C^2}{N_C^2}
- - 2 \frac{N_C^3}{N_C^3}
- + \frac{N_C^4}{N_C^4}
- = N_C^2 + 1 - 2 + 1 = N_C^2
-\end{multline}
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{Improved Feynman Rules (Attempted Ad Hoc Solution)}
-New particle with propagator residue~$N_C$ and coupling~$1/N_C$,
-but \emph{no sources}, while the diagonal ghost's don't propagate
-anymore:
-\begin{multline}
-\parbox{25\unitlength}{%
- \begin{fmfgraph*}(25,25)
- \fmfleft{g2,g1}
- \fmfright{H}
- \fmflabel{$ij$}{g1}
- \fmflabel{$kl$}{g2}
- \fmf{gluon}{v,g1}
- \fmf{gluon}{g2,v}
- \fmf{plain}{v,H}
- \fmfdot{v}
- \end{fmfgraph*}} \Longleftrightarrow
-\parbox{25\unitlength}{%
- \begin{fmfgraph*}(25,25)
- \fmfleft{g2,g1}
- \fmfright{H}
- \fmflabel{$ij$}{g1}
- \fmflabel{$ij$}{g2}
- \fmf{phantom}{v,g1}
- \fmf{phantom}{g2,v}
- \fmf{plain}{v,H}
- \fmffreeze
- \fmfi{phantom_arrow}{vpath (__g1, __v) sideways -thick}
- \fmfi{phantom_arrow}{(reverse vpath (__g1, __v)) sideways -thick}
- \fmfi{phantom_arrow}{vpath (__g2, __v) sideways -thick}
- \fmfi{phantom_arrow}{(reverse vpath (__g2, __v)) sideways -thick}
- \fmfi{plain}{%
- (vpath (__g2, __v) join vpath (__v, __g1)) sideways -thick}
- \fmfi{plain}{%
- (vpath (__g2, __v) join vpath (__v, __g1)) sideways thick}
- \fmfdot{v}
- \end{fmfgraph*}}
-\parbox{25\unitlength}{%
- \begin{fmfgraph*}(25,25)
- \fmfleft{g2,g1}
- \fmfright{H}
- \fmflabel{$ii$}{g1}
- \fmf{double_line_arrow_end}{g1,v}
- \fmf{dots}{g2,v}
- \fmf{plain}{v,H}
- \fmfdot{v}
- \end{fmfgraph*}}
-\parbox{25\unitlength}{%
- \begin{fmfgraph*}(25,25)
- \fmfleft{g2,g1}
- \fmfright{H}
- \fmf{dots}{g1,v}
- \fmflabel{$ii$}{g2}
- \fmf{double_line_arrow_end}{g2,v}
- \fmf{plain}{v,H}
- \fmfdot{v}
- \end{fmfgraph*}}
-\parbox{25\unitlength}{%
- \begin{fmfgraph*}(25,25)
- \fmfleft{g2,g1}
- \fmfright{H}
- \fmf{dots}{g1,v}
- \fmf{dots}{g2,v}
- \fmf{plain}{v,H}
- \fmfv{d.shape=circle,d.size=3thick,d.filled=full,
- label=\footnotesize$N_C$,label.dist=2thick,label.ang=60}{v}
- \end{fmfgraph*}} \\
-\parbox{25\unitlength}{%
- \begin{fmfgraph*}(25,25)
- \fmfleft{g2,g1}
- \fmfright{H}
- \fmf{dbl_dots}{g1,v}
- \fmf{dbl_dots}{g2,v}
- \fmf{plain}{v,H}
- \fmfv{d.shape=circle,d.size=3thick,d.filled=full,
- label=\footnotesize$\frac{1}{N_C}$,label.dist=2thick,label.ang=60}{v}
- \end{fmfgraph*}}
-\parbox{25\unitlength}{%
- \begin{fmfgraph*}(25,25)
- \fmfleft{g2,g1}
- \fmfright{H}
- \fmflabel{$ii$}{g1}
- \fmf{double_line_arrow_end}{g1,v}
- \fmf{dbl_dots}{g2,v}
- \fmf{plain}{v,H}
- \fmfv{d.shape=circle,d.size=3thick,d.filled=full,
- label=\footnotesize$\frac{1}{N_C}$,label.dist=2thick,label.ang=60}{v}
- \end{fmfgraph*}}
-\parbox{25\unitlength}{%
- \begin{fmfgraph*}(25,25)
- \fmfleft{g2,g1}
- \fmfright{H}
- \fmf{dbl_dots}{g1,v}
- \fmflabel{$ii$}{g2}
- \fmf{double_line_arrow_end}{g2,v}
- \fmf{plain}{v,H}
- \fmfv{d.shape=circle,d.size=3thick,d.filled=full,
- label=\footnotesize$\frac{1}{N_C}$,label.dist=2thick,label.ang=60}{v}
- \end{fmfgraph*}}
-\parbox{25\unitlength}{%
- \begin{fmfgraph*}(25,25)
- \fmfleft{g2,g1}
- \fmfright{H}
- \fmf{dots}{g1,v}
- \fmf{dbl_dots}{g2,v}
- \fmf{plain}{v,H}
- \fmfdot{v}
- \end{fmfgraph*}}
-\parbox{25\unitlength}{%
- \begin{fmfgraph*}(25,25)
- \fmfleft{g2,g1}
- \fmfright{H}
- \fmf{dbl_dots}{g1,v}
- \fmf{dots}{g2,v}
- \fmf{plain}{v,H}
- \fmfdot{v}
- \end{fmfgraph*}}
-\end{multline}
-
-\subsection{$gg\to H$}
-No changes.
-
-\subsection{$gg\to HH$}
-\begin{quote}
- \textit{Verify that these are all diagrams and that the factors are correct!}
-\end{quote}
-\begin{multline}
-\parbox{35\unitlength}{%
- \begin{fmfgraph*}(35,35)
- \setupggHH
- \g{gluon}{projt}
- \g{gluon}{propl}
- \g{gluon}{projb}
- \g{gluon}{propr}
- \Hgg{Hlt}
- \Hgg{Hlb}
- \Hgg{Hrt}
- \Hgg{Hrb}
- \end{fmfgraph*}} =
-\parbox{35\unitlength}{%
- \begin{fmfgraph*}(35,35)
- \setupggHH
- \g{double_line_arrow,label=\footnotesize$N_C$,label.dist=5thick}{projt}
- \g{double_line_arrow}{propl}
- \g{double_line_arrow}{projb}
- \g{double_line_arrow}{propr}
- \Hgg{Hlt}
- \Hgg{Hlb}
- \Hgg{Hrt}
- \Hgg{Hrb}
- \end{fmfgraph*}} \\ +
-\parbox{35\unitlength}{%
- \begin{fmfgraph*}(35,35)
- \setupggHH
- \C{projt}
- \G{propl}
- \C{projb}
- \A{propr}
- \Hgg{Hlt}
- \Hgg{Hlb}
- \HCA{Hrt}
- \HCA{Hrb}
- \end{fmfgraph*}} +
-\parbox{35\unitlength}{%
- \begin{fmfgraph*}(35,35)
- \setupggHH
- \C{projt}
- \A{propl}
- \C{projb}
- \G{propr}
- \HCA{Hlt}
- \HCA{Hlb}
- \Hgg{Hrt}
- \Hgg{Hrb}
- \end{fmfgraph*}} +
-\parbox{35\unitlength}{%
- \begin{fmfgraph*}(35,35)
- \setupggHH
- \C{projt}
- \G{propl}
- \C{projb}
- \G{propr}
- \Hgg{Hlt}
- \Hgg{Hlb}
- \Hgg{Hrt}
- \Hgg{Hrb}
- \end{fmfgraph*}} \\ +
-\parbox{35\unitlength}{%
- \begin{fmfgraph*}(35,35)
- \setupggHH
- \C{projt}
- \A{propl}
- \G{projb}
- \A{propr}
- \HCA{Hlt}
- \Hgg{Hlb}
- \HCA{Hrt}
- \Hgg{Hrb}
- \end{fmfgraph*}} +
-\parbox{35\unitlength}{%
- \begin{fmfgraph*}(35,35)
- \setupggHH
- \C{projt}
- \G{propl}
- \G{projb}
- \A{propr}
- \Hgg{Hlt}
- \HGG{Hlb}
- \HCA{Hrt}
- \Hgg{Hrb}
- \end{fmfgraph*}} +
-\parbox{35\unitlength}{%
- \begin{fmfgraph*}(35,35)
- \setupggHH
- \C{projt}
- \A{propl}
- \G{projb}
- \G{propr}
- \HCA{Hlt}
- \Hgg{Hlb}
- \Hgg{Hrt}
- \HGG{Hrb}
- \end{fmfgraph*}} +
-\parbox{35\unitlength}{%
- \begin{fmfgraph*}(35,35)
- \setupggHH
- \g{double_line_arrow_both,label=\footnotesize$N_C$}{projt}
- \G{propl}
- \G{projb}
- \G{propr}
- \Hgg{Hlt}
- \HGG{Hlb}
- \Hgg{Hrt}
- \HGG{Hrb}
- \end{fmfgraph*}} \\ +
-\parbox{35\unitlength}{%
- \begin{fmfgraph*}(35,35)
- \setupggHH
- \G{projt}
- \A{propl}
- \C{projb}
- \A{propr}
- \Hgg{Hlt}
- \HCA{Hlb}
- \Hgg{Hrt}
- \HCA{Hrb}
- \end{fmfgraph*}} +
-\parbox{35\unitlength}{%
- \begin{fmfgraph*}(35,35)
- \setupggHH
- \G{projt}
- \G{propl}
- \C{projb}
- \A{propr}
- \HGG{Hlt}
- \Hgg{Hlb}
- \Hgg{Hrt}
- \HCA{Hrb}
- \end{fmfgraph*}} +
-\parbox{35\unitlength}{%
- \begin{fmfgraph*}(35,35)
- \setupggHH
- \G{projt}
- \A{propl}
- \C{projb}
- \G{propr}
- \Hgg{Hlt}
- \HCA{Hlb}
- \HGG{Hrt}
- \Hgg{Hrb}
- \end{fmfgraph*}} +
-\parbox{35\unitlength}{%
- \begin{fmfgraph*}(35,35)
- \setupggHH
- \G{projt}
- \G{propl}
- \g{double_line_arrow_both,label=\footnotesize$N_C$}{projb}
- \G{propr}
- \HGG{Hlt}
- \Hgg{Hlb}
- \HGG{Hrt}
- \Hgg{Hrb}
- \end{fmfgraph*}} \\ +
-\parbox{35\unitlength}{%
- \begin{fmfgraph*}(35,35)
- \setupggHH
- \G{projt}
- \A{propl}
- \G{projb}
- \A{propr}
- \Hgg{Hlt}
- \Hgg{Hlb}
- \Hgg{Hrt}
- \Hgg{Hrb}
- \end{fmfgraph*}} +
-\parbox{35\unitlength}{%
- \begin{fmfgraph*}(35,35)
- \setupggHH
- \G{projt}
- \G{propl}
- \G{projb}
- \A{propr}
- \HGG{Hlt}
- \HGG{Hlb}
- \Hgg{Hrt}
- \Hgg{Hrb}
- \end{fmfgraph*}} +
-\parbox{35\unitlength}{%
- \begin{fmfgraph*}(35,35)
- \setupggHH
- \G{projt}
- \A{propl}
- \G{projb}
- \G{propr}
- \Hgg{Hlt}
- \Hgg{Hlb}
- \HGG{Hrt}
- \HGG{Hrb}
- \end{fmfgraph*}} +
-\parbox{35\unitlength}{%
- \begin{fmfgraph*}(35,35)
- \setupggHH
- \G{projt}
- \G{propl}
- \G{projb}
- \G{propr}
- \HGG{Hlt}
- \HGG{Hlb}
- \HGG{Hrt}
- \HGG{Hrb}
- \end{fmfgraph*}} \\ =
- N_C^2
- - 2 \frac{N_C^3}{N_C^3} + \frac{N_C^2}{N_C^2}
- + 2 ( -1 + 2 - 1) \frac{N_C^3}{N_C^3}
- + \frac{N_C^2}{N_C^2} - 2 \frac{N_C^3}{N_C^3} + \frac{N_C^4}{N_C^4} \\
- = N_C^2 - 2 + 1 - 2\cdot0 + 1 - 2 + 1 = N_C^2 - 1
-\end{multline}
-
-\subsubsection{More Problem Children}
-The diagram
-\begin{equation}
-\parbox{35\unitlength}{%
- \begin{fmfgraph*}(35,35)
- \setupggHH
- \C{projt}
- \A{propl}
- \C{projb}
- \A{propr}
- \HCA{Hlt}
- \HCA{Hlb}
- \HCA{Hrt}
- \HCA{Hrb}
- \end{fmfgraph*}}
-\end{equation}
-should be included, but spoils the party \ldots
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{Derivation Using Effective Field Theory}
-Suppressing Lorentz indices:
-\begin{equation}
- \mathcal{L}_{\text{Maltoni et al.}}
- = \frac{1}{2} \partial_\mu A_{ij} \partial^\mu A_{ij}
- - \frac{N_C}{2} \partial_\mu \phi \partial^\mu \phi
- + j_A^{ij} A_{ij} + j_{\phi} \phi
-\end{equation}
-where $i\not=j$ is understood. Naively adding a Higgs:
-\begin{equation}
- \mathcal{L}_{Hgg}
- = g H A_{ij} A_{ij} + g H N_C \phi^2
-\end{equation}
-\begin{quote}
- \textit{t.\,b.\,c.\,\ldots}
-\end{quote}
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{Christian S's Proposal}
-In the squared amplitudes, recognize gluons that pass through by the
-matching color flow index pairs and apply a factor
-\begin{equation}
- \frac{N_C^2 - 2}{N_C^2}
-\end{equation}
-
-\begin{equation}
-\parbox{25\unitlength}{%
- \begin{fmfgraph*}(25,25)
- \fmfleft{g2,g1}
- \fmfright{H}
- \fmflabel{$ij$}{g1}
- \fmflabel{$kl$}{g2}
- \fmf{gluon}{v,g1}
- \fmf{gluon}{g2,v}
- \fmf{plain}{v,H}
- \fmfdot{v}
- \end{fmfgraph*}} \Longleftrightarrow
-\parbox{25\unitlength}{%
- \begin{fmfgraph*}(25,25)
- \fmfleft{g2,g1}
- \fmfright{H}
- \fmflabel{$ij$}{g1}
- \fmflabel{$ij$}{g2}
- \fmf{phantom}{v,g1}
- \fmf{phantom}{g2,v}
- \fmf{plain}{v,H}
- \fmffreeze
- \fmfi{phantom_arrow}{vpath (__g1, __v) sideways -thick}
- \fmfi{phantom_arrow}{(reverse vpath (__g1, __v)) sideways -thick}
- \fmfi{phantom_arrow}{vpath (__g2, __v) sideways -thick}
- \fmfi{phantom_arrow}{(reverse vpath (__g2, __v)) sideways -thick}
- \fmfi{plain}{%
- (vpath (__g2, __v) join vpath (__v, __g1)) sideways -thick}
- \fmfi{plain}{%
- (vpath (__g2, __v) join vpath (__v, __g1)) sideways thick}
- \fmfdot{v}
- \end{fmfgraph*}}
-\parbox{25\unitlength}{%
- \begin{fmfgraph*}(25,25)
- \fmfleft{g2,g1}
- \fmfright{H}
- \fmf{dots}{g1,v}
- \fmf{dots}{g2,v}
- \fmf{plain}{v,H}
- \fmfv{d.shape=circle,d.size=3thick,d.filled=full,
- label=\footnotesize$N_C$,label.dist=2thick,label.ang=60}{v}
- \end{fmfgraph*}}
-\end{equation}
-
-\subsection{$gg\to H$}
-This works
-\begin{multline}
-\parbox{35\unitlength}{%
- \begin{fmfgraph*}(35,35)
- \setupggH
- \g{gluon}{projt}
- \g{gluon}{projb}
- \Hgg{Hl}
- \Hgg{Hr}
- \end{fmfgraph*}} = \frac{N_C^2 - 2}{N_C^2} \cdot
-\parbox{35\unitlength}{%
- \begin{fmfgraph*}(35,35)
- \setupggH
- \g{double_line_arrow,label=\footnotesize$N_C^2$,label.dist=5thick}{projt}
- \g{double_line_arrow}{projb}
- \Hgg{Hl}
- \Hgg{Hr}
- \end{fmfgraph*}} +
-\parbox{35\unitlength}{%
- \begin{fmfgraph*}(35,35)
- \setupggH
- \G{projt}
- \G{projb}
- \HGG{Hl}
- \HGG{Hr}
- \end{fmfgraph*}} \\ =
- \frac{N_C^2 - 2}{N_C^2} \cdot N_C^2 + \frac{N_C^2}{N_C^2}
- = N_C^2 - 2 + 1 = N_C^2 - 1
-\end{multline}
-
-\subsection{$gg\to HH$}
-This works
-\begin{multline}
-\parbox{35\unitlength}{%
- \begin{fmfgraph*}(35,35)
- \setupggHH
- \g{gluon}{projt}
- \g{gluon}{projb}
- \g{gluon}{propl}
- \g{gluon}{propr}
- \Hgg{Hlt}
- \Hgg{Hrt}
- \Hgg{Hlb}
- \Hgg{Hrb}
- \end{fmfgraph*}} = \frac{N_C^2 - 2}{N_C^2} \cdot
-\parbox{35\unitlength}{%
- \begin{fmfgraph*}(35,35)
- \setupggHH
- \g{double_line_arrow,label=\footnotesize$N_C^2$,label.dist=5thick}{projt}
- \g{double_line_arrow}{projb}
- \g{double_line_arrow}{propl}
- \g{double_line_arrow}{propr}
- \Hgg{Hlt}
- \Hgg{Hrt}
- \Hgg{Hlb}
- \Hgg{Hrb}
- \end{fmfgraph*}} +
-\parbox{35\unitlength}{%
- \begin{fmfgraph*}(35,35)
- \setupggHH
- \G{projt}
- \G{projb}
- \G{propl}
- \G{propr}
- \HGG{Hlt}
- \HGG{Hrt}
- \HGG{Hlb}
- \HGG{Hrb}
- \end{fmfgraph*}} \\ =
- \frac{N_C^2 - 2}{N_C^2} \cdot N_C^2 + \frac{N_C^4}{N_C^4}
- = N_C^2 - 2 + 1 = N_C^2 - 1
-\end{multline}
-
-\subsection{$qg\to q H$ and $qq\to qq H$}
-\begin{quote}
-\textit{Does it work for internal lines?}
-\end{quote}
-
-\begin{multline}
-\parbox{25\unitlength}{%
- \begin{fmfgraph*}(25,25)
- \fmfleft{g2,q1}
- \fmfright{H,qq1}
- \fmf{fermion}{q1,g1,qq1}
- \fmf{phantom}{q1,g1}
- \fmf{gluon}{v1,g1}
- \fmf{gluon}{g2,v2}
- \fmf{fermion,tension=0.5}{v1,v2,vH,v1}
- \fmf{plain}{vH,H}
- \fmfdot{g1,v1,v2,vH}
- \end{fmfgraph*}} \Longleftrightarrow
-\parbox{25\unitlength}{%
- \begin{fmfgraph*}(25,25)
- \fmfleft{g2,q1}
- \fmfright{H,qq1}
- \fmflabel{$ij$}{g2}
- \fmf{phantom_arrow}{q1,g1,qq1}
- \fmf{phantom}{q1,g1}
- \fmf{phantom}{v1,g1}
- \fmf{phantom}{g2,v2}
- \fmf{phantom_arrow,tension=0.5}{v1,v2,vH,v1}
- \fmf{plain}{vH,H}
- \fmffreeze
- \fmfi{phantom_arrow}{vpath (__g1, __v1) sideways -thick}
- \fmfi{phantom_arrow}{(reverse vpath (__g1, __v1)) sideways -thick}
- \fmfi{phantom_arrow}{vpath (__g2, __v2) sideways -thick}
- \fmfi{phantom_arrow}{(reverse vpath (__g2, __v2)) sideways -thick}
- \fmfi{plain}{%
- (vpath (__g2, __v2) sideways -thick)
- join vpath (__v2, __vH)
- join vpath (__vH, __v1)
- join (vpath (__v1, __g1) sideways -thick)
- join vpath (__g1, __qq1)}
- \fmfi{plain}{%
- vpath (__q1, __g1)
- join ((reverse vpath (__v1, __g1)) sideways -thick)
- join vpath (__v2, __v1)
- join ((reverse vpath (__v2, __g2)) sideways -thick)}
- \fmfdot{vH}
- \end{fmfgraph*}}
-\parbox{25\unitlength}{%
- \begin{fmfgraph*}(25,25)
- \fmfleft{g2,q1}
- \fmfright{H,qq1}
- \fmflabel{$ij$}{g2}
- \fmf{phantom_arrow}{q1,g1,qq1}
- \fmf{phantom}{q1,g1}
- \fmf{phantom}{v1,g1}
- \fmf{dots}{g2,v2}
- \fmf{phantom_arrow,tension=0.5}{v1,v2,vH,v1}
- \fmf{plain}{vH,H}
- \fmffreeze
- \fmfi{phantom_arrow}{vpath (__g1, __v1) sideways -thick}
- \fmfi{phantom_arrow}{(reverse vpath (__g1, __v1)) sideways -thick}
- \fmfi{plain}{%
- vpath (__q1, __g1)
- join ((reverse vpath (__v1, __g1)) sideways -thick)
- join vpath (__v1, __v2)
- join vpath (__v2, __vH)
- join vpath (__vH, __v1)
- join (vpath (__v1, __g1) sideways -thick)
- join vpath (__g1, __qq1)}
- \fmfdot{v2,vH}
- \end{fmfgraph*}}
-\parbox{25\unitlength}{%
- \begin{fmfgraph*}(25,25)
- \fmfleft{g2,q1}
- \fmfright{H,qq1}
- \fmflabel{$ij$}{g2}
- \fmf{fermion}{q1,g1,qq1}
- \fmf{phantom}{q1,g1}
- \fmf{dots}{v1,g1}
- \fmf{phantom}{g2,v2}
- \fmf{phantom_arrow,tension=0.5}{v1,v2,vH,v1}
- \fmf{plain}{vH,H}
- \fmffreeze
- \fmfi{phantom_arrow}{vpath (__g2, __v2) sideways -thick}
- \fmfi{phantom_arrow}{(reverse vpath (__g2, __v2)) sideways -thick}
- \fmfi{plain}{%
- vpath (__g2, __v2) sideways -thick
- join vpath (__v2, __vH)
- join vpath (__vH, __v1)
- join vpath (__v1, __v2)
- join (reverse vpath (__v2, __g2)) sideways -thick}
- \fmfdot{g1,v1,vH}
- \end{fmfgraph*}}
-\parbox{25\unitlength}{%
- \begin{fmfgraph*}(25,25)
- \fmfleft{g2,q1}
- \fmfright{H,qq1}
- \fmflabel{$ij$}{g2}
- \fmf{fermion}{q1,g1,qq1}
- \fmf{phantom}{q1,g1}
- \fmf{dots}{v1,g1}
- \fmf{dots}{g2,v2}
- \fmf{phantom_arrow,tension=0.5}{v1,v2,vH,v1}
- \fmf{plain}{vH,H}
- \fmffreeze
- \fmfi{plain}{%
- cyclejoin ( vpath (__v2, __vH)
- join vpath (__vH, __v1)
- join vpath (__v1, __v2))}
- \fmfdot{g1,v1,v2,vH}
- \end{fmfgraph*}}
-\end{multline}
-\hfil\\
-vs.\\
-\hfil
-\begin{equation}
-\parbox{25\unitlength}{%
- \begin{fmfgraph*}(25,25)
- \fmfleft{g2,q1}
- \fmfright{H,qq1}
- \fmf{fermion}{q1,g1,qq1}
- \fmf{phantom}{q1,g1}
- \fmf{gluon}{v,g1}
- \fmf{gluon}{g2,v}
- \fmf{plain}{v,H}
- \fmfdot{g1,v}
- \end{fmfgraph*}} \Longleftrightarrow
-\parbox{25\unitlength}{%
- \begin{fmfgraph*}(25,25)
- \fmfleft{g2,q1}
- \fmfright{H,qq1}
- \fmf{phantom_arrow}{q1,g1,qq1}
- \fmf{phantom}{q1,g1}
- \fmf{phantom}{v,g1}
- \fmf{phantom}{g2,v}
- \fmf{plain}{v,H}
- \fmffreeze
- \fmfi{phantom_arrow}{vpath (__g1, __v) sideways -thick}
- \fmfi{phantom_arrow}{(reverse vpath (__g1, __v)) sideways -thick}
- \fmfi{phantom_arrow}{vpath (__g2, __v) sideways -thick}
- \fmfi{phantom_arrow}{(reverse vpath (__g2, __v)) sideways -thick}
- \fmfi{plain}{%
- ((vpath (__g2, __v) join vpath (__v, __g1)) sideways -thick) join vpath (__g1, __qq1)}
- \fmfi{plain}{%
- vpath (__q1, __g1) join reverse ((vpath (__g2, __v) join vpath (__v, __g1)) sideways thick)}
- \fmfdot{v}
- \end{fmfgraph*}}
-\parbox{25\unitlength}{%
- \begin{fmfgraph*}(25,25)
- \fmfleft{g2,q1}
- \fmfright{H,qq1}
- \fmflabel{$ij$}{g2}
- \fmf{fermion}{q1,g1,qq1}
- \fmf{phantom}{q1,g1}
- \fmf{dots}{v1,g1}
- \fmf{dots}{g2,v2}
- \fmf{phantom_arrow,tension=0.5}{v1,v2,vH,v1}
- \fmf{plain}{vH,H}
- \fmffreeze
- \fmfi{plain}{%
- cyclejoin ( vpath (__v2, __vH)
- join vpath (__vH, __v1)
- join vpath (__v1, __v2))}
- \fmfdot{g1,v1,v2,vH}
- \end{fmfgraph*}}
-\end{equation}
-
-\subsubsection{Problem Children}
-\begin{equation}
-\parbox{25\unitlength}{%
- \begin{fmfgraph*}(25,25)
- \fmfleft{g2,q1}
- \fmfright{H,qq1}
- \fmflabel{$ij$}{g2}
- \fmf{phantom_arrow}{q1,g1,qq1}
- \fmf{phantom}{q1,g1}
- \fmf{phantom}{v1,g1}
- \fmf{dots}{g2,v2}
- \fmf{phantom_arrow,tension=0.5}{v1,v2,vH,v1}
- \fmf{plain}{vH,H}
- \fmffreeze
- \fmfi{phantom_arrow}{vpath (__g1, __v1) sideways -thick}
- \fmfi{phantom_arrow}{(reverse vpath (__g1, __v1)) sideways -thick}
- \fmfi{plain}{%
- vpath (__q1, __g1)
- join ((reverse vpath (__v1, __g1)) sideways -thick)
- join vpath (__v1, __v2)
- join vpath (__v2, __vH)
- join vpath (__vH, __v1)
- join (vpath (__v1, __g1) sideways -thick)
- join vpath (__g1, __qq1)}
- \fmfdot{v2,vH}
- \end{fmfgraph*}}
-\parbox{25\unitlength}{%
- \begin{fmfgraph*}(25,25)
- \fmfleft{g2,q1}
- \fmfright{H,qq1}
- \fmflabel{$ij$}{g2}
- \fmf{fermion}{q1,g1,qq1}
- \fmf{phantom}{q1,g1}
- \fmf{dots}{v1,g1}
- \fmf{phantom}{g2,v2}
- \fmf{phantom_arrow,tension=0.5}{v1,v2,vH,v1}
- \fmf{plain}{vH,H}
- \fmffreeze
- \fmfi{phantom_arrow}{vpath (__g2, __v2) sideways -thick}
- \fmfi{phantom_arrow}{(reverse vpath (__g2, __v2)) sideways -thick}
- \fmfi{plain}{%
- vpath (__g2, __v2) sideways -thick
- join vpath (__v2, __vH)
- join vpath (__vH, __v1)
- join vpath (__v1, __v2)
- join (reverse vpath (__v2, __g2)) sideways -thick}
- \fmfdot{g1,v1,vH}
- \end{fmfgraph*}}
-\end{equation}
-
-%%% \begin{equation}
-%%% \parbox{25\unitlength}{%
-%%% \begin{fmfgraph*}(25,25)
-%%% \fmfleft{q2,q1}
-%%% \fmfright{qq2,H,qq1}
-%%% \fmf{fermion}{q1,g1,qq1}
-%%% \fmf{fermion}{q2,g2,qq2}
-%%% \fmf{phantom}{q1,g1}
-%%% \fmf{phantom}{q2,g2}
-%%% \fmf{gluon}{v1,g1}
-%%% \fmf{gluon}{g2,v2}
-%%% \fmf{fermion,tension=0.5}{v1,v2,vH,v1}
-%%% \fmf{plain}{vH,H}
-%%% \fmfdot{g1,g2,v1,v2,vH}
-%%% \end{fmfgraph*}} \Longleftrightarrow \ldots
-%%% \end{equation}
-
-\end{fmffile}
-\end{document}
Index: branches/ohl/omega-development/hgg-vertex/ltmain.sh
===================================================================
--- branches/ohl/omega-development/hgg-vertex/ltmain.sh (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/ltmain.sh (revision 8717)
@@ -1,8406 +0,0 @@
-# Generated from ltmain.m4sh.
-
-# ltmain.sh (GNU libtool) 2.2.6b
-# Written by Gordon Matzigkeit <gord@gnu.ai.mit.edu>, 1996
-
-# Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2003, 2004, 2005, 2006, 2007 2008 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.
-
-# GNU Libtool 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.
-#
-# As a special exception to the GNU General Public License,
-# if you distribute this file as part of a program or library that
-# is built using GNU Libtool, you may include this file under the
-# same distribution terms that you use for the rest of that program.
-#
-# GNU Libtool 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 GNU Libtool; see the file COPYING. If not, a copy
-# can be downloaded from http://www.gnu.org/licenses/gpl.html,
-# or obtained by writing to the Free Software Foundation, Inc.,
-# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
-
-# Usage: $progname [OPTION]... [MODE-ARG]...
-#
-# Provide generalized library-building support services.
-#
-# --config show all configuration variables
-# --debug enable verbose shell tracing
-# -n, --dry-run display commands without modifying any files
-# --features display basic configuration information and exit
-# --mode=MODE use operation mode MODE
-# --preserve-dup-deps don't remove duplicate dependency libraries
-# --quiet, --silent don't print informational messages
-# --tag=TAG use configuration variables from tag TAG
-# -v, --verbose print informational messages (default)
-# --version print version information
-# -h, --help print short or long help message
-#
-# MODE must be one of the following:
-#
-# clean remove files from the build directory
-# compile compile a source file into a libtool object
-# execute automatically set library path, then run a program
-# finish complete the installation of libtool libraries
-# install install libraries or executables
-# link create a library or an executable
-# uninstall remove libraries from an installed directory
-#
-# MODE-ARGS vary depending on the MODE.
-# Try `$progname --help --mode=MODE' for a more detailed description of MODE.
-#
-# When reporting a bug, please describe a test case to reproduce it and
-# include the following information:
-#
-# host-triplet: $host
-# shell: $SHELL
-# compiler: $LTCC
-# compiler flags: $LTCFLAGS
-# linker: $LD (gnu? $with_gnu_ld)
-# $progname: (GNU libtool) 2.2.6b
-# automake: $automake_version
-# autoconf: $autoconf_version
-#
-# Report bugs to <bug-libtool@gnu.org>.
-
-PROGRAM=ltmain.sh
-PACKAGE=libtool
-VERSION=2.2.6b
-TIMESTAMP=""
-package_revision=1.3017
-
-# Be Bourne compatible
-if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then
- emulate sh
- NULLCMD=:
- # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which
- # is contrary to our usage. Disable this feature.
- alias -g '${1+"$@"}'='"$@"'
- setopt NO_GLOB_SUBST
-else
- case `(set -o) 2>/dev/null` in *posix*) set -o posix;; esac
-fi
-BIN_SH=xpg4; export BIN_SH # for Tru64
-DUALCASE=1; export DUALCASE # for MKS sh
-
-# NLS nuisances: We save the old values to restore during execute mode.
-# Only set LANG and LC_ALL to C if already set.
-# These must not be set unconditionally because not all systems understand
-# e.g. LANG=C (notably SCO).
-lt_user_locale=
-lt_safe_locale=
-for lt_var in LANG LANGUAGE LC_ALL LC_CTYPE LC_COLLATE LC_MESSAGES
-do
- eval "if test \"\${$lt_var+set}\" = set; then
- save_$lt_var=\$$lt_var
- $lt_var=C
- export $lt_var
- lt_user_locale=\"$lt_var=\\\$save_\$lt_var; \$lt_user_locale\"
- lt_safe_locale=\"$lt_var=C; \$lt_safe_locale\"
- fi"
-done
-
-$lt_unset CDPATH
-
-
-
-
-
-: ${CP="cp -f"}
-: ${ECHO="echo"}
-: ${EGREP="/bin/grep -E"}
-: ${FGREP="/bin/grep -F"}
-: ${GREP="/bin/grep"}
-: ${LN_S="ln -s"}
-: ${MAKE="make"}
-: ${MKDIR="mkdir"}
-: ${MV="mv -f"}
-: ${RM="rm -f"}
-: ${SED="/bin/sed"}
-: ${SHELL="${CONFIG_SHELL-/bin/sh}"}
-: ${Xsed="$SED -e 1s/^X//"}
-
-# Global variables:
-EXIT_SUCCESS=0
-EXIT_FAILURE=1
-EXIT_MISMATCH=63 # $? = 63 is used to indicate version mismatch to missing.
-EXIT_SKIP=77 # $? = 77 is used to indicate a skipped test to automake.
-
-exit_status=$EXIT_SUCCESS
-
-# Make sure IFS has a sensible default
-lt_nl='
-'
-IFS=" $lt_nl"
-
-dirname="s,/[^/]*$,,"
-basename="s,^.*/,,"
-
-# func_dirname_and_basename file append nondir_replacement
-# perform func_basename and func_dirname in a single function
-# call:
-# dirname: Compute the dirname of FILE. If nonempty,
-# add APPEND to the result, otherwise set result
-# to NONDIR_REPLACEMENT.
-# value returned in "$func_dirname_result"
-# basename: Compute filename of FILE.
-# value retuned in "$func_basename_result"
-# Implementation must be kept synchronized with func_dirname
-# and func_basename. For efficiency, we do not delegate to
-# those functions but instead duplicate the functionality here.
-func_dirname_and_basename ()
-{
- # Extract subdirectory from the argument.
- func_dirname_result=`$ECHO "X${1}" | $Xsed -e "$dirname"`
- if test "X$func_dirname_result" = "X${1}"; then
- func_dirname_result="${3}"
- else
- func_dirname_result="$func_dirname_result${2}"
- fi
- func_basename_result=`$ECHO "X${1}" | $Xsed -e "$basename"`
-}
-
-# Generated shell functions inserted here.
-
-# Work around backward compatibility issue on IRIX 6.5. On IRIX 6.4+, sh
-# is ksh but when the shell is invoked as "sh" and the current value of
-# the _XPG environment variable is not equal to 1 (one), the special
-# positional parameter $0, within a function call, is the name of the
-# function.
-progpath="$0"
-
-# The name of this program:
-# In the unlikely event $progname began with a '-', it would play havoc with
-# func_echo (imagine progname=-n), so we prepend ./ in that case:
-func_dirname_and_basename "$progpath"
-progname=$func_basename_result
-case $progname in
- -*) progname=./$progname ;;
-esac
-
-# Make sure we have an absolute path for reexecution:
-case $progpath in
- [\\/]*|[A-Za-z]:\\*) ;;
- *[\\/]*)
- progdir=$func_dirname_result
- progdir=`cd "$progdir" && pwd`
- progpath="$progdir/$progname"
- ;;
- *)
- save_IFS="$IFS"
- IFS=:
- for progdir in $PATH; do
- IFS="$save_IFS"
- test -x "$progdir/$progname" && break
- done
- IFS="$save_IFS"
- test -n "$progdir" || progdir=`pwd`
- progpath="$progdir/$progname"
- ;;
-esac
-
-# Sed substitution that helps us do robust quoting. It backslashifies
-# metacharacters that are still active within double-quoted strings.
-Xsed="${SED}"' -e 1s/^X//'
-sed_quote_subst='s/\([`"$\\]\)/\\\1/g'
-
-# Same as above, but do not quote variable references.
-double_quote_subst='s/\(["`\\]\)/\\\1/g'
-
-# Re-`\' parameter expansions in output of double_quote_subst that were
-# `\'-ed in input to the same. If an odd number of `\' preceded a '$'
-# in input to double_quote_subst, that '$' was protected from expansion.
-# Since each input `\' is now two `\'s, look for any number of runs of
-# four `\'s followed by two `\'s and then a '$'. `\' that '$'.
-bs='\\'
-bs2='\\\\'
-bs4='\\\\\\\\'
-dollar='\$'
-sed_double_backslash="\
- s/$bs4/&\\
-/g
- s/^$bs2$dollar/$bs&/
- s/\\([^$bs]\\)$bs2$dollar/\\1$bs2$bs$dollar/g
- s/\n//g"
-
-# Standard options:
-opt_dry_run=false
-opt_help=false
-opt_quiet=false
-opt_verbose=false
-opt_warning=:
-
-# func_echo arg...
-# Echo program name prefixed message, along with the current mode
-# name if it has been set yet.
-func_echo ()
-{
- $ECHO "$progname${mode+: }$mode: $*"
-}
-
-# func_verbose arg...
-# Echo program name prefixed message in verbose mode only.
-func_verbose ()
-{
- $opt_verbose && func_echo ${1+"$@"}
-
- # A bug in bash halts the script if the last line of a function
- # fails when set -e is in force, so we need another command to
- # work around that:
- :
-}
-
-# func_error arg...
-# Echo program name prefixed message to standard error.
-func_error ()
-{
- $ECHO "$progname${mode+: }$mode: "${1+"$@"} 1>&2
-}
-
-# func_warning arg...
-# Echo program name prefixed warning message to standard error.
-func_warning ()
-{
- $opt_warning && $ECHO "$progname${mode+: }$mode: warning: "${1+"$@"} 1>&2
-
- # bash bug again:
- :
-}
-
-# func_fatal_error arg...
-# Echo program name prefixed message to standard error, and exit.
-func_fatal_error ()
-{
- func_error ${1+"$@"}
- exit $EXIT_FAILURE
-}
-
-# func_fatal_help arg...
-# Echo program name prefixed message to standard error, followed by
-# a help hint, and exit.
-func_fatal_help ()
-{
- func_error ${1+"$@"}
- func_fatal_error "$help"
-}
-help="Try \`$progname --help' for more information." ## default
-
-
-# func_grep expression filename
-# Check whether EXPRESSION matches any line of FILENAME, without output.
-func_grep ()
-{
- $GREP "$1" "$2" >/dev/null 2>&1
-}
-
-
-# func_mkdir_p directory-path
-# Make sure the entire path to DIRECTORY-PATH is available.
-func_mkdir_p ()
-{
- my_directory_path="$1"
- my_dir_list=
-
- if test -n "$my_directory_path" && test "$opt_dry_run" != ":"; then
-
- # Protect directory names starting with `-'
- case $my_directory_path in
- -*) my_directory_path="./$my_directory_path" ;;
- esac
-
- # While some portion of DIR does not yet exist...
- while test ! -d "$my_directory_path"; do
- # ...make a list in topmost first order. Use a colon delimited
- # list incase some portion of path contains whitespace.
- my_dir_list="$my_directory_path:$my_dir_list"
-
- # If the last portion added has no slash in it, the list is done
- case $my_directory_path in */*) ;; *) break ;; esac
-
- # ...otherwise throw away the child directory and loop
- my_directory_path=`$ECHO "X$my_directory_path" | $Xsed -e "$dirname"`
- done
- my_dir_list=`$ECHO "X$my_dir_list" | $Xsed -e 's,:*$,,'`
-
- save_mkdir_p_IFS="$IFS"; IFS=':'
- for my_dir in $my_dir_list; do
- IFS="$save_mkdir_p_IFS"
- # mkdir can fail with a `File exist' error if two processes
- # try to create one of the directories concurrently. Don't
- # stop in that case!
- $MKDIR "$my_dir" 2>/dev/null || :
- done
- IFS="$save_mkdir_p_IFS"
-
- # Bail out if we (or some other process) failed to create a directory.
- test -d "$my_directory_path" || \
- func_fatal_error "Failed to create \`$1'"
- fi
-}
-
-
-# func_mktempdir [string]
-# Make a temporary directory that won't clash with other running
-# libtool processes, and avoids race conditions if possible. If
-# given, STRING is the basename for that directory.
-func_mktempdir ()
-{
- my_template="${TMPDIR-/tmp}/${1-$progname}"
-
- if test "$opt_dry_run" = ":"; then
- # Return a directory name, but don't create it in dry-run mode
- my_tmpdir="${my_template}-$$"
- else
-
- # If mktemp works, use that first and foremost
- my_tmpdir=`mktemp -d "${my_template}-XXXXXXXX" 2>/dev/null`
-
- if test ! -d "$my_tmpdir"; then
- # Failing that, at least try and use $RANDOM to avoid a race
- my_tmpdir="${my_template}-${RANDOM-0}$$"
-
- save_mktempdir_umask=`umask`
- umask 0077
- $MKDIR "$my_tmpdir"
- umask $save_mktempdir_umask
- fi
-
- # If we're not in dry-run mode, bomb out on failure
- test -d "$my_tmpdir" || \
- func_fatal_error "cannot create temporary directory \`$my_tmpdir'"
- fi
-
- $ECHO "X$my_tmpdir" | $Xsed
-}
-
-
-# func_quote_for_eval arg
-# Aesthetically quote ARG to be evaled later.
-# This function returns two values: FUNC_QUOTE_FOR_EVAL_RESULT
-# is double-quoted, suitable for a subsequent eval, whereas
-# FUNC_QUOTE_FOR_EVAL_UNQUOTED_RESULT has merely all characters
-# which are still active within double quotes backslashified.
-func_quote_for_eval ()
-{
- case $1 in
- *[\\\`\"\$]*)
- func_quote_for_eval_unquoted_result=`$ECHO "X$1" | $Xsed -e "$sed_quote_subst"` ;;
- *)
- func_quote_for_eval_unquoted_result="$1" ;;
- esac
-
- case $func_quote_for_eval_unquoted_result in
- # Double-quote args containing shell metacharacters to delay
- # word splitting, command substitution and and variable
- # expansion for a subsequent eval.
- # Many Bourne shells cannot handle close brackets correctly
- # in scan sets, so we specify it separately.
- *[\[\~\#\^\&\*\(\)\{\}\|\;\<\>\?\'\ \ ]*|*]*|"")
- func_quote_for_eval_result="\"$func_quote_for_eval_unquoted_result\""
- ;;
- *)
- func_quote_for_eval_result="$func_quote_for_eval_unquoted_result"
- esac
-}
-
-
-# func_quote_for_expand arg
-# Aesthetically quote ARG to be evaled later; same as above,
-# but do not quote variable references.
-func_quote_for_expand ()
-{
- case $1 in
- *[\\\`\"]*)
- my_arg=`$ECHO "X$1" | $Xsed \
- -e "$double_quote_subst" -e "$sed_double_backslash"` ;;
- *)
- my_arg="$1" ;;
- esac
-
- case $my_arg in
- # Double-quote args containing shell metacharacters to delay
- # word splitting and command substitution for a subsequent eval.
- # Many Bourne shells cannot handle close brackets correctly
- # in scan sets, so we specify it separately.
- *[\[\~\#\^\&\*\(\)\{\}\|\;\<\>\?\'\ \ ]*|*]*|"")
- my_arg="\"$my_arg\""
- ;;
- esac
-
- func_quote_for_expand_result="$my_arg"
-}
-
-
-# func_show_eval cmd [fail_exp]
-# Unless opt_silent is true, then output CMD. Then, if opt_dryrun is
-# not true, evaluate CMD. If the evaluation of CMD fails, and FAIL_EXP
-# is given, then evaluate it.
-func_show_eval ()
-{
- my_cmd="$1"
- my_fail_exp="${2-:}"
-
- ${opt_silent-false} || {
- func_quote_for_expand "$my_cmd"
- eval "func_echo $func_quote_for_expand_result"
- }
-
- if ${opt_dry_run-false}; then :; else
- eval "$my_cmd"
- my_status=$?
- if test "$my_status" -eq 0; then :; else
- eval "(exit $my_status); $my_fail_exp"
- fi
- fi
-}
-
-
-# func_show_eval_locale cmd [fail_exp]
-# Unless opt_silent is true, then output CMD. Then, if opt_dryrun is
-# not true, evaluate CMD. If the evaluation of CMD fails, and FAIL_EXP
-# is given, then evaluate it. Use the saved locale for evaluation.
-func_show_eval_locale ()
-{
- my_cmd="$1"
- my_fail_exp="${2-:}"
-
- ${opt_silent-false} || {
- func_quote_for_expand "$my_cmd"
- eval "func_echo $func_quote_for_expand_result"
- }
-
- if ${opt_dry_run-false}; then :; else
- eval "$lt_user_locale
- $my_cmd"
- my_status=$?
- eval "$lt_safe_locale"
- if test "$my_status" -eq 0; then :; else
- eval "(exit $my_status); $my_fail_exp"
- fi
- fi
-}
-
-
-
-
-
-# func_version
-# Echo version message to standard output and exit.
-func_version ()
-{
- $SED -n '/^# '$PROGRAM' (GNU /,/# warranty; / {
- s/^# //
- s/^# *$//
- s/\((C)\)[ 0-9,-]*\( [1-9][0-9]*\)/\1\2/
- p
- }' < "$progpath"
- exit $?
-}
-
-# func_usage
-# Echo short help message to standard output and exit.
-func_usage ()
-{
- $SED -n '/^# Usage:/,/# -h/ {
- s/^# //
- s/^# *$//
- s/\$progname/'$progname'/
- p
- }' < "$progpath"
- $ECHO
- $ECHO "run \`$progname --help | more' for full usage"
- exit $?
-}
-
-# func_help
-# Echo long help message to standard output and exit.
-func_help ()
-{
- $SED -n '/^# Usage:/,/# Report bugs to/ {
- s/^# //
- s/^# *$//
- s*\$progname*'$progname'*
- s*\$host*'"$host"'*
- s*\$SHELL*'"$SHELL"'*
- s*\$LTCC*'"$LTCC"'*
- s*\$LTCFLAGS*'"$LTCFLAGS"'*
- s*\$LD*'"$LD"'*
- s/\$with_gnu_ld/'"$with_gnu_ld"'/
- s/\$automake_version/'"`(automake --version) 2>/dev/null |$SED 1q`"'/
- s/\$autoconf_version/'"`(autoconf --version) 2>/dev/null |$SED 1q`"'/
- p
- }' < "$progpath"
- exit $?
-}
-
-# func_missing_arg argname
-# Echo program name prefixed message to standard error and set global
-# exit_cmd.
-func_missing_arg ()
-{
- func_error "missing argument for $1"
- exit_cmd=exit
-}
-
-exit_cmd=:
-
-
-
-
-
-# Check that we have a working $ECHO.
-if test "X$1" = X--no-reexec; then
- # Discard the --no-reexec flag, and continue.
- shift
-elif test "X$1" = X--fallback-echo; then
- # Avoid inline document here, it may be left over
- :
-elif test "X`{ $ECHO '\t'; } 2>/dev/null`" = 'X\t'; then
- # Yippee, $ECHO works!
- :
-else
- # Restart under the correct shell, and then maybe $ECHO will work.
- exec $SHELL "$progpath" --no-reexec ${1+"$@"}
-fi
-
-if test "X$1" = X--fallback-echo; then
- # used as fallback echo
- shift
- cat <<EOF
-$*
-EOF
- exit $EXIT_SUCCESS
-fi
-
-magic="%%%MAGIC variable%%%"
-magic_exe="%%%MAGIC EXE variable%%%"
-
-# Global variables.
-# $mode is unset
-nonopt=
-execute_dlfiles=
-preserve_args=
-lo2o="s/\\.lo\$/.${objext}/"
-o2lo="s/\\.${objext}\$/.lo/"
-extracted_archives=
-extracted_serial=0
-
-opt_dry_run=false
-opt_duplicate_deps=false
-opt_silent=false
-opt_debug=:
-
-# If this variable is set in any of the actions, the command in it
-# will be execed at the end. This prevents here-documents from being
-# left over by shells.
-exec_cmd=
-
-# func_fatal_configuration arg...
-# Echo program name prefixed message to standard error, followed by
-# a configuration failure hint, and exit.
-func_fatal_configuration ()
-{
- func_error ${1+"$@"}
- func_error "See the $PACKAGE documentation for more information."
- func_fatal_error "Fatal configuration error."
-}
-
-
-# func_config
-# Display the configuration for all the tags in this script.
-func_config ()
-{
- re_begincf='^# ### BEGIN LIBTOOL'
- re_endcf='^# ### END LIBTOOL'
-
- # Default configuration.
- $SED "1,/$re_begincf CONFIG/d;/$re_endcf CONFIG/,\$d" < "$progpath"
-
- # Now print the configurations for the tags.
- for tagname in $taglist; do
- $SED -n "/$re_begincf TAG CONFIG: $tagname\$/,/$re_endcf TAG CONFIG: $tagname\$/p" < "$progpath"
- done
-
- exit $?
-}
-
-# func_features
-# Display the features supported by this script.
-func_features ()
-{
- $ECHO "host: $host"
- if test "$build_libtool_libs" = yes; then
- $ECHO "enable shared libraries"
- else
- $ECHO "disable shared libraries"
- fi
- if test "$build_old_libs" = yes; then
- $ECHO "enable static libraries"
- else
- $ECHO "disable static libraries"
- fi
-
- exit $?
-}
-
-# func_enable_tag tagname
-# Verify that TAGNAME is valid, and either flag an error and exit, or
-# enable the TAGNAME tag. We also add TAGNAME to the global $taglist
-# variable here.
-func_enable_tag ()
-{
- # Global variable:
- tagname="$1"
-
- re_begincf="^# ### BEGIN LIBTOOL TAG CONFIG: $tagname\$"
- re_endcf="^# ### END LIBTOOL TAG CONFIG: $tagname\$"
- sed_extractcf="/$re_begincf/,/$re_endcf/p"
-
- # Validate tagname.
- case $tagname in
- *[!-_A-Za-z0-9,/]*)
- func_fatal_error "invalid tag name: $tagname"
- ;;
- esac
-
- # Don't test for the "default" C tag, as we know it's
- # there but not specially marked.
- case $tagname in
- CC) ;;
- *)
- if $GREP "$re_begincf" "$progpath" >/dev/null 2>&1; then
- taglist="$taglist $tagname"
-
- # Evaluate the configuration. Be careful to quote the path
- # and the sed script, to avoid splitting on whitespace, but
- # also don't use non-portable quotes within backquotes within
- # quotes we have to do it in 2 steps:
- extractedcf=`$SED -n -e "$sed_extractcf" < "$progpath"`
- eval "$extractedcf"
- else
- func_error "ignoring unknown tag $tagname"
- fi
- ;;
- esac
-}
-
-# Parse options once, thoroughly. This comes as soon as possible in
-# the script to make things like `libtool --version' happen quickly.
-{
-
- # Shorthand for --mode=foo, only valid as the first argument
- case $1 in
- clean|clea|cle|cl)
- shift; set dummy --mode clean ${1+"$@"}; shift
- ;;
- compile|compil|compi|comp|com|co|c)
- shift; set dummy --mode compile ${1+"$@"}; shift
- ;;
- execute|execut|execu|exec|exe|ex|e)
- shift; set dummy --mode execute ${1+"$@"}; shift
- ;;
- finish|finis|fini|fin|fi|f)
- shift; set dummy --mode finish ${1+"$@"}; shift
- ;;
- install|instal|insta|inst|ins|in|i)
- shift; set dummy --mode install ${1+"$@"}; shift
- ;;
- link|lin|li|l)
- shift; set dummy --mode link ${1+"$@"}; shift
- ;;
- uninstall|uninstal|uninsta|uninst|unins|unin|uni|un|u)
- shift; set dummy --mode uninstall ${1+"$@"}; shift
- ;;
- esac
-
- # Parse non-mode specific arguments:
- while test "$#" -gt 0; do
- opt="$1"
- shift
-
- case $opt in
- --config) func_config ;;
-
- --debug) preserve_args="$preserve_args $opt"
- func_echo "enabling shell trace mode"
- opt_debug='set -x'
- $opt_debug
- ;;
-
- -dlopen) test "$#" -eq 0 && func_missing_arg "$opt" && break
- execute_dlfiles="$execute_dlfiles $1"
- shift
- ;;
-
- --dry-run | -n) opt_dry_run=: ;;
- --features) func_features ;;
- --finish) mode="finish" ;;
-
- --mode) test "$#" -eq 0 && func_missing_arg "$opt" && break
- case $1 in
- # Valid mode arguments:
- clean) ;;
- compile) ;;
- execute) ;;
- finish) ;;
- install) ;;
- link) ;;
- relink) ;;
- uninstall) ;;
-
- # Catch anything else as an error
- *) func_error "invalid argument for $opt"
- exit_cmd=exit
- break
- ;;
- esac
-
- mode="$1"
- shift
- ;;
-
- --preserve-dup-deps)
- opt_duplicate_deps=: ;;
-
- --quiet|--silent) preserve_args="$preserve_args $opt"
- opt_silent=:
- ;;
-
- --verbose| -v) preserve_args="$preserve_args $opt"
- opt_silent=false
- ;;
-
- --tag) test "$#" -eq 0 && func_missing_arg "$opt" && break
- preserve_args="$preserve_args $opt $1"
- func_enable_tag "$1" # tagname is set here
- shift
- ;;
-
- # Separate optargs to long options:
- -dlopen=*|--mode=*|--tag=*)
- func_opt_split "$opt"
- set dummy "$func_opt_split_opt" "$func_opt_split_arg" ${1+"$@"}
- shift
- ;;
-
- -\?|-h) func_usage ;;
- --help) opt_help=: ;;
- --version) func_version ;;
-
- -*) func_fatal_help "unrecognized option \`$opt'" ;;
-
- *) nonopt="$opt"
- break
- ;;
- esac
- done
-
-
- case $host in
- *cygwin* | *mingw* | *pw32* | *cegcc*)
- # don't eliminate duplications in $postdeps and $predeps
- opt_duplicate_compiler_generated_deps=:
- ;;
- *)
- opt_duplicate_compiler_generated_deps=$opt_duplicate_deps
- ;;
- esac
-
- # Having warned about all mis-specified options, bail out if
- # anything was wrong.
- $exit_cmd $EXIT_FAILURE
-}
-
-# func_check_version_match
-# Ensure that we are using m4 macros, and libtool script from the same
-# release of libtool.
-func_check_version_match ()
-{
- if test "$package_revision" != "$macro_revision"; then
- if test "$VERSION" != "$macro_version"; then
- if test -z "$macro_version"; then
- cat >&2 <<_LT_EOF
-$progname: Version mismatch error. This is $PACKAGE $VERSION, but the
-$progname: definition of this LT_INIT comes from an older release.
-$progname: You should recreate aclocal.m4 with macros from $PACKAGE $VERSION
-$progname: and run autoconf again.
-_LT_EOF
- else
- cat >&2 <<_LT_EOF
-$progname: Version mismatch error. This is $PACKAGE $VERSION, but the
-$progname: definition of this LT_INIT comes from $PACKAGE $macro_version.
-$progname: You should recreate aclocal.m4 with macros from $PACKAGE $VERSION
-$progname: and run autoconf again.
-_LT_EOF
- fi
- else
- cat >&2 <<_LT_EOF
-$progname: Version mismatch error. This is $PACKAGE $VERSION, revision $package_revision,
-$progname: but the definition of this LT_INIT comes from revision $macro_revision.
-$progname: You should recreate aclocal.m4 with macros from revision $package_revision
-$progname: of $PACKAGE $VERSION and run autoconf again.
-_LT_EOF
- fi
-
- exit $EXIT_MISMATCH
- fi
-}
-
-
-## ----------- ##
-## Main. ##
-## ----------- ##
-
-$opt_help || {
- # Sanity checks first:
- func_check_version_match
-
- if test "$build_libtool_libs" != yes && test "$build_old_libs" != yes; then
- func_fatal_configuration "not configured to build any kind of library"
- fi
-
- test -z "$mode" && func_fatal_error "error: you must specify a MODE."
-
-
- # Darwin sucks
- eval std_shrext=\"$shrext_cmds\"
-
-
- # Only execute mode is allowed to have -dlopen flags.
- if test -n "$execute_dlfiles" && test "$mode" != execute; then
- func_error "unrecognized option \`-dlopen'"
- $ECHO "$help" 1>&2
- exit $EXIT_FAILURE
- fi
-
- # Change the help message to a mode-specific one.
- generic_help="$help"
- help="Try \`$progname --help --mode=$mode' for more information."
-}
-
-
-# func_lalib_p file
-# True iff FILE is a libtool `.la' library or `.lo' object file.
-# This function is only a basic sanity check; it will hardly flush out
-# determined imposters.
-func_lalib_p ()
-{
- test -f "$1" &&
- $SED -e 4q "$1" 2>/dev/null \
- | $GREP "^# Generated by .*$PACKAGE" > /dev/null 2>&1
-}
-
-# func_lalib_unsafe_p file
-# True iff FILE is a libtool `.la' library or `.lo' object file.
-# This function implements the same check as func_lalib_p without
-# resorting to external programs. To this end, it redirects stdin and
-# closes it afterwards, without saving the original file descriptor.
-# As a safety measure, use it only where a negative result would be
-# fatal anyway. Works if `file' does not exist.
-func_lalib_unsafe_p ()
-{
- lalib_p=no
- if test -f "$1" && test -r "$1" && exec 5<&0 <"$1"; then
- for lalib_p_l in 1 2 3 4
- do
- read lalib_p_line
- case "$lalib_p_line" in
- \#\ Generated\ by\ *$PACKAGE* ) lalib_p=yes; break;;
- esac
- done
- exec 0<&5 5<&-
- fi
- test "$lalib_p" = yes
-}
-
-# func_ltwrapper_script_p file
-# True iff FILE is a libtool wrapper script
-# This function is only a basic sanity check; it will hardly flush out
-# determined imposters.
-func_ltwrapper_script_p ()
-{
- func_lalib_p "$1"
-}
-
-# func_ltwrapper_executable_p file
-# True iff FILE is a libtool wrapper executable
-# This function is only a basic sanity check; it will hardly flush out
-# determined imposters.
-func_ltwrapper_executable_p ()
-{
- func_ltwrapper_exec_suffix=
- case $1 in
- *.exe) ;;
- *) func_ltwrapper_exec_suffix=.exe ;;
- esac
- $GREP "$magic_exe" "$1$func_ltwrapper_exec_suffix" >/dev/null 2>&1
-}
-
-# func_ltwrapper_scriptname file
-# Assumes file is an ltwrapper_executable
-# uses $file to determine the appropriate filename for a
-# temporary ltwrapper_script.
-func_ltwrapper_scriptname ()
-{
- func_ltwrapper_scriptname_result=""
- if func_ltwrapper_executable_p "$1"; then
- func_dirname_and_basename "$1" "" "."
- func_stripname '' '.exe' "$func_basename_result"
- func_ltwrapper_scriptname_result="$func_dirname_result/$objdir/${func_stripname_result}_ltshwrapper"
- fi
-}
-
-# func_ltwrapper_p file
-# True iff FILE is a libtool wrapper script or wrapper executable
-# This function is only a basic sanity check; it will hardly flush out
-# determined imposters.
-func_ltwrapper_p ()
-{
- func_ltwrapper_script_p "$1" || func_ltwrapper_executable_p "$1"
-}
-
-
-# func_execute_cmds commands fail_cmd
-# Execute tilde-delimited COMMANDS.
-# If FAIL_CMD is given, eval that upon failure.
-# FAIL_CMD may read-access the current command in variable CMD!
-func_execute_cmds ()
-{
- $opt_debug
- save_ifs=$IFS; IFS='~'
- for cmd in $1; do
- IFS=$save_ifs
- eval cmd=\"$cmd\"
- func_show_eval "$cmd" "${2-:}"
- done
- IFS=$save_ifs
-}
-
-
-# func_source file
-# Source FILE, adding directory component if necessary.
-# Note that it is not necessary on cygwin/mingw to append a dot to
-# FILE even if both FILE and FILE.exe exist: automatic-append-.exe
-# behavior happens only for exec(3), not for open(2)! Also, sourcing
-# `FILE.' does not work on cygwin managed mounts.
-func_source ()
-{
- $opt_debug
- case $1 in
- */* | *\\*) . "$1" ;;
- *) . "./$1" ;;
- esac
-}
-
-
-# func_infer_tag arg
-# Infer tagged configuration to use if any are available and
-# if one wasn't chosen via the "--tag" command line option.
-# Only attempt this if the compiler in the base compile
-# command doesn't match the default compiler.
-# arg is usually of the form 'gcc ...'
-func_infer_tag ()
-{
- $opt_debug
- if test -n "$available_tags" && test -z "$tagname"; then
- CC_quoted=
- for arg in $CC; do
- func_quote_for_eval "$arg"
- CC_quoted="$CC_quoted $func_quote_for_eval_result"
- done
- case $@ in
- # Blanks in the command may have been stripped by the calling shell,
- # but not from the CC environment variable when configure was run.
- " $CC "* | "$CC "* | " `$ECHO $CC` "* | "`$ECHO $CC` "* | " $CC_quoted"* | "$CC_quoted "* | " `$ECHO $CC_quoted` "* | "`$ECHO $CC_quoted` "*) ;;
- # Blanks at the start of $base_compile will cause this to fail
- # if we don't check for them as well.
- *)
- for z in $available_tags; do
- if $GREP "^# ### BEGIN LIBTOOL TAG CONFIG: $z$" < "$progpath" > /dev/null; then
- # Evaluate the configuration.
- eval "`${SED} -n -e '/^# ### BEGIN LIBTOOL TAG CONFIG: '$z'$/,/^# ### END LIBTOOL TAG CONFIG: '$z'$/p' < $progpath`"
- CC_quoted=
- for arg in $CC; do
- # Double-quote args containing other shell metacharacters.
- func_quote_for_eval "$arg"
- CC_quoted="$CC_quoted $func_quote_for_eval_result"
- done
- case "$@ " in
- " $CC "* | "$CC "* | " `$ECHO $CC` "* | "`$ECHO $CC` "* | " $CC_quoted"* | "$CC_quoted "* | " `$ECHO $CC_quoted` "* | "`$ECHO $CC_quoted` "*)
- # The compiler in the base compile command matches
- # the one in the tagged configuration.
- # Assume this is the tagged configuration we want.
- tagname=$z
- break
- ;;
- esac
- fi
- done
- # If $tagname still isn't set, then no tagged configuration
- # was found and let the user know that the "--tag" command
- # line option must be used.
- if test -z "$tagname"; then
- func_echo "unable to infer tagged configuration"
- func_fatal_error "specify a tag with \`--tag'"
-# else
-# func_verbose "using $tagname tagged configuration"
- fi
- ;;
- esac
- fi
-}
-
-
-
-# func_write_libtool_object output_name pic_name nonpic_name
-# Create a libtool object file (analogous to a ".la" file),
-# but don't create it if we're doing a dry run.
-func_write_libtool_object ()
-{
- write_libobj=${1}
- if test "$build_libtool_libs" = yes; then
- write_lobj=\'${2}\'
- else
- write_lobj=none
- fi
-
- if test "$build_old_libs" = yes; then
- write_oldobj=\'${3}\'
- else
- write_oldobj=none
- fi
-
- $opt_dry_run || {
- cat >${write_libobj}T <<EOF
-# $write_libobj - a libtool object file
-# Generated by $PROGRAM (GNU $PACKAGE$TIMESTAMP) $VERSION
-#
-# Please DO NOT delete this file!
-# It is necessary for linking the library.
-
-# Name of the PIC object.
-pic_object=$write_lobj
-
-# Name of the non-PIC object
-non_pic_object=$write_oldobj
-
-EOF
- $MV "${write_libobj}T" "${write_libobj}"
- }
-}
-
-# func_mode_compile arg...
-func_mode_compile ()
-{
- $opt_debug
- # Get the compilation command and the source file.
- base_compile=
- srcfile="$nonopt" # always keep a non-empty value in "srcfile"
- suppress_opt=yes
- suppress_output=
- arg_mode=normal
- libobj=
- later=
- pie_flag=
-
- for arg
- do
- case $arg_mode in
- arg )
- # do not "continue". Instead, add this to base_compile
- lastarg="$arg"
- arg_mode=normal
- ;;
-
- target )
- libobj="$arg"
- arg_mode=normal
- continue
- ;;
-
- normal )
- # Accept any command-line options.
- case $arg in
- -o)
- test -n "$libobj" && \
- func_fatal_error "you cannot specify \`-o' more than once"
- arg_mode=target
- continue
- ;;
-
- -pie | -fpie | -fPIE)
- pie_flag="$pie_flag $arg"
- continue
- ;;
-
- -shared | -static | -prefer-pic | -prefer-non-pic)
- later="$later $arg"
- continue
- ;;
-
- -no-suppress)
- suppress_opt=no
- continue
- ;;
-
- -Xcompiler)
- arg_mode=arg # the next one goes into the "base_compile" arg list
- continue # The current "srcfile" will either be retained or
- ;; # replaced later. I would guess that would be a bug.
-
- -Wc,*)
- func_stripname '-Wc,' '' "$arg"
- args=$func_stripname_result
- lastarg=
- save_ifs="$IFS"; IFS=','
- for arg in $args; do
- IFS="$save_ifs"
- func_quote_for_eval "$arg"
- lastarg="$lastarg $func_quote_for_eval_result"
- done
- IFS="$save_ifs"
- func_stripname ' ' '' "$lastarg"
- lastarg=$func_stripname_result
-
- # Add the arguments to base_compile.
- base_compile="$base_compile $lastarg"
- continue
- ;;
-
- *)
- # Accept the current argument as the source file.
- # The previous "srcfile" becomes the current argument.
- #
- lastarg="$srcfile"
- srcfile="$arg"
- ;;
- esac # case $arg
- ;;
- esac # case $arg_mode
-
- # Aesthetically quote the previous argument.
- func_quote_for_eval "$lastarg"
- base_compile="$base_compile $func_quote_for_eval_result"
- done # for arg
-
- case $arg_mode in
- arg)
- func_fatal_error "you must specify an argument for -Xcompile"
- ;;
- target)
- func_fatal_error "you must specify a target with \`-o'"
- ;;
- *)
- # Get the name of the library object.
- test -z "$libobj" && {
- func_basename "$srcfile"
- libobj="$func_basename_result"
- }
- ;;
- esac
-
- # Recognize several different file suffixes.
- # If the user specifies -o file.o, it is replaced with file.lo
- case $libobj in
- *.[cCFSifmso] | \
- *.ada | *.adb | *.ads | *.asm | \
- *.c++ | *.cc | *.ii | *.class | *.cpp | *.cxx | \
- *.[fF][09]? | *.for | *.java | *.obj | *.sx)
- func_xform "$libobj"
- libobj=$func_xform_result
- ;;
- esac
-
- case $libobj in
- *.lo) func_lo2o "$libobj"; obj=$func_lo2o_result ;;
- *)
- func_fatal_error "cannot determine name of library object from \`$libobj'"
- ;;
- esac
-
- func_infer_tag $base_compile
-
- for arg in $later; do
- case $arg in
- -shared)
- test "$build_libtool_libs" != yes && \
- func_fatal_configuration "can not build a shared library"
- build_old_libs=no
- continue
- ;;
-
- -static)
- build_libtool_libs=no
- build_old_libs=yes
- continue
- ;;
-
- -prefer-pic)
- pic_mode=yes
- continue
- ;;
-
- -prefer-non-pic)
- pic_mode=no
- continue
- ;;
- esac
- done
-
- func_quote_for_eval "$libobj"
- test "X$libobj" != "X$func_quote_for_eval_result" \
- && $ECHO "X$libobj" | $GREP '[]~#^*{};<>?"'"'"' &()|`$[]' \
- && func_warning "libobj name \`$libobj' may not contain shell special characters."
- func_dirname_and_basename "$obj" "/" ""
- objname="$func_basename_result"
- xdir="$func_dirname_result"
- lobj=${xdir}$objdir/$objname
-
- test -z "$base_compile" && \
- func_fatal_help "you must specify a compilation command"
-
- # Delete any leftover library objects.
- if test "$build_old_libs" = yes; then
- removelist="$obj $lobj $libobj ${libobj}T"
- else
- removelist="$lobj $libobj ${libobj}T"
- fi
-
- # On Cygwin there's no "real" PIC flag so we must build both object types
- case $host_os in
- cygwin* | mingw* | pw32* | os2* | cegcc*)
- pic_mode=default
- ;;
- esac
- if test "$pic_mode" = no && test "$deplibs_check_method" != pass_all; then
- # non-PIC code in shared libraries is not supported
- pic_mode=default
- fi
-
- # Calculate the filename of the output object if compiler does
- # not support -o with -c
- if test "$compiler_c_o" = no; then
- output_obj=`$ECHO "X$srcfile" | $Xsed -e 's%^.*/%%' -e 's%\.[^.]*$%%'`.${objext}
- lockfile="$output_obj.lock"
- else
- output_obj=
- need_locks=no
- lockfile=
- fi
-
- # Lock this critical section if it is needed
- # We use this script file to make the link, it avoids creating a new file
- if test "$need_locks" = yes; then
- until $opt_dry_run || ln "$progpath" "$lockfile" 2>/dev/null; do
- func_echo "Waiting for $lockfile to be removed"
- sleep 2
- done
- elif test "$need_locks" = warn; then
- if test -f "$lockfile"; then
- $ECHO "\
-*** ERROR, $lockfile exists and contains:
-`cat $lockfile 2>/dev/null`
-
-This indicates that another process is trying to use the same
-temporary object file, and libtool could not work around it because
-your compiler does not support \`-c' and \`-o' together. If you
-repeat this compilation, it may succeed, by chance, but you had better
-avoid parallel builds (make -j) in this platform, or get a better
-compiler."
-
- $opt_dry_run || $RM $removelist
- exit $EXIT_FAILURE
- fi
- removelist="$removelist $output_obj"
- $ECHO "$srcfile" > "$lockfile"
- fi
-
- $opt_dry_run || $RM $removelist
- removelist="$removelist $lockfile"
- trap '$opt_dry_run || $RM $removelist; exit $EXIT_FAILURE' 1 2 15
-
- if test -n "$fix_srcfile_path"; then
- eval srcfile=\"$fix_srcfile_path\"
- fi
- func_quote_for_eval "$srcfile"
- qsrcfile=$func_quote_for_eval_result
-
- # Only build a PIC object if we are building libtool libraries.
- if test "$build_libtool_libs" = yes; then
- # Without this assignment, base_compile gets emptied.
- fbsd_hideous_sh_bug=$base_compile
-
- if test "$pic_mode" != no; then
- command="$base_compile $qsrcfile $pic_flag"
- else
- # Don't build PIC code
- command="$base_compile $qsrcfile"
- fi
-
- func_mkdir_p "$xdir$objdir"
-
- if test -z "$output_obj"; then
- # Place PIC objects in $objdir
- command="$command -o $lobj"
- fi
-
- func_show_eval_locale "$command" \
- 'test -n "$output_obj" && $RM $removelist; exit $EXIT_FAILURE'
-
- if test "$need_locks" = warn &&
- test "X`cat $lockfile 2>/dev/null`" != "X$srcfile"; then
- $ECHO "\
-*** ERROR, $lockfile contains:
-`cat $lockfile 2>/dev/null`
-
-but it should contain:
-$srcfile
-
-This indicates that another process is trying to use the same
-temporary object file, and libtool could not work around it because
-your compiler does not support \`-c' and \`-o' together. If you
-repeat this compilation, it may succeed, by chance, but you had better
-avoid parallel builds (make -j) in this platform, or get a better
-compiler."
-
- $opt_dry_run || $RM $removelist
- exit $EXIT_FAILURE
- fi
-
- # Just move the object if needed, then go on to compile the next one
- if test -n "$output_obj" && test "X$output_obj" != "X$lobj"; then
- func_show_eval '$MV "$output_obj" "$lobj"' \
- 'error=$?; $opt_dry_run || $RM $removelist; exit $error'
- fi
-
- # Allow error messages only from the first compilation.
- if test "$suppress_opt" = yes; then
- suppress_output=' >/dev/null 2>&1'
- fi
- fi
-
- # Only build a position-dependent object if we build old libraries.
- if test "$build_old_libs" = yes; then
- if test "$pic_mode" != yes; then
- # Don't build PIC code
- command="$base_compile $qsrcfile$pie_flag"
- else
- command="$base_compile $qsrcfile $pic_flag"
- fi
- if test "$compiler_c_o" = yes; then
- command="$command -o $obj"
- fi
-
- # Suppress compiler output if we already did a PIC compilation.
- command="$command$suppress_output"
- func_show_eval_locale "$command" \
- '$opt_dry_run || $RM $removelist; exit $EXIT_FAILURE'
-
- if test "$need_locks" = warn &&
- test "X`cat $lockfile 2>/dev/null`" != "X$srcfile"; then
- $ECHO "\
-*** ERROR, $lockfile contains:
-`cat $lockfile 2>/dev/null`
-
-but it should contain:
-$srcfile
-
-This indicates that another process is trying to use the same
-temporary object file, and libtool could not work around it because
-your compiler does not support \`-c' and \`-o' together. If you
-repeat this compilation, it may succeed, by chance, but you had better
-avoid parallel builds (make -j) in this platform, or get a better
-compiler."
-
- $opt_dry_run || $RM $removelist
- exit $EXIT_FAILURE
- fi
-
- # Just move the object if needed
- if test -n "$output_obj" && test "X$output_obj" != "X$obj"; then
- func_show_eval '$MV "$output_obj" "$obj"' \
- 'error=$?; $opt_dry_run || $RM $removelist; exit $error'
- fi
- fi
-
- $opt_dry_run || {
- func_write_libtool_object "$libobj" "$objdir/$objname" "$objname"
-
- # Unlock the critical section if it was locked
- if test "$need_locks" != no; then
- removelist=$lockfile
- $RM "$lockfile"
- fi
- }
-
- exit $EXIT_SUCCESS
-}
-
-$opt_help || {
-test "$mode" = compile && func_mode_compile ${1+"$@"}
-}
-
-func_mode_help ()
-{
- # We need to display help for each of the modes.
- case $mode in
- "")
- # Generic help is extracted from the usage comments
- # at the start of this file.
- func_help
- ;;
-
- clean)
- $ECHO \
-"Usage: $progname [OPTION]... --mode=clean RM [RM-OPTION]... FILE...
-
-Remove files from the build directory.
-
-RM is the name of the program to use to delete files associated with each FILE
-(typically \`/bin/rm'). RM-OPTIONS are options (such as \`-f') to be passed
-to RM.
-
-If FILE is a libtool library, object or program, all the files associated
-with it are deleted. Otherwise, only FILE itself is deleted using RM."
- ;;
-
- compile)
- $ECHO \
-"Usage: $progname [OPTION]... --mode=compile COMPILE-COMMAND... SOURCEFILE
-
-Compile a source file into a libtool library object.
-
-This mode accepts the following additional options:
-
- -o OUTPUT-FILE set the output file name to OUTPUT-FILE
- -no-suppress do not suppress compiler output for multiple passes
- -prefer-pic try to building PIC objects only
- -prefer-non-pic try to building non-PIC objects only
- -shared do not build a \`.o' file suitable for static linking
- -static only build a \`.o' file suitable for static linking
-
-COMPILE-COMMAND is a command to be used in creating a \`standard' object file
-from the given SOURCEFILE.
-
-The output file name is determined by removing the directory component from
-SOURCEFILE, then substituting the C source code suffix \`.c' with the
-library object suffix, \`.lo'."
- ;;
-
- execute)
- $ECHO \
-"Usage: $progname [OPTION]... --mode=execute COMMAND [ARGS]...
-
-Automatically set library path, then run a program.
-
-This mode accepts the following additional options:
-
- -dlopen FILE add the directory containing FILE to the library path
-
-This mode sets the library path environment variable according to \`-dlopen'
-flags.
-
-If any of the ARGS are libtool executable wrappers, then they are translated
-into their corresponding uninstalled binary, and any of their required library
-directories are added to the library path.
-
-Then, COMMAND is executed, with ARGS as arguments."
- ;;
-
- finish)
- $ECHO \
-"Usage: $progname [OPTION]... --mode=finish [LIBDIR]...
-
-Complete the installation of libtool libraries.
-
-Each LIBDIR is a directory that contains libtool libraries.
-
-The commands that this mode executes may require superuser privileges. Use
-the \`--dry-run' option if you just want to see what would be executed."
- ;;
-
- install)
- $ECHO \
-"Usage: $progname [OPTION]... --mode=install INSTALL-COMMAND...
-
-Install executables or libraries.
-
-INSTALL-COMMAND is the installation command. The first component should be
-either the \`install' or \`cp' program.
-
-The following components of INSTALL-COMMAND are treated specially:
-
- -inst-prefix PREFIX-DIR Use PREFIX-DIR as a staging area for installation
-
-The rest of the components are interpreted as arguments to that command (only
-BSD-compatible install options are recognized)."
- ;;
-
- link)
- $ECHO \
-"Usage: $progname [OPTION]... --mode=link LINK-COMMAND...
-
-Link object files or libraries together to form another library, or to
-create an executable program.
-
-LINK-COMMAND is a command using the C compiler that you would use to create
-a program from several object files.
-
-The following components of LINK-COMMAND are treated specially:
-
- -all-static do not do any dynamic linking at all
- -avoid-version do not add a version suffix if possible
- -dlopen FILE \`-dlpreopen' FILE if it cannot be dlopened at runtime
- -dlpreopen FILE link in FILE and add its symbols to lt_preloaded_symbols
- -export-dynamic allow symbols from OUTPUT-FILE to be resolved with dlsym(3)
- -export-symbols SYMFILE
- try to export only the symbols listed in SYMFILE
- -export-symbols-regex REGEX
- try to export only the symbols matching REGEX
- -LLIBDIR search LIBDIR for required installed libraries
- -lNAME OUTPUT-FILE requires the installed library libNAME
- -module build a library that can dlopened
- -no-fast-install disable the fast-install mode
- -no-install link a not-installable executable
- -no-undefined declare that a library does not refer to external symbols
- -o OUTPUT-FILE create OUTPUT-FILE from the specified objects
- -objectlist FILE Use a list of object files found in FILE to specify objects
- -precious-files-regex REGEX
- don't remove output files matching REGEX
- -release RELEASE specify package release information
- -rpath LIBDIR the created library will eventually be installed in LIBDIR
- -R[ ]LIBDIR add LIBDIR to the runtime path of programs and libraries
- -shared only do dynamic linking of libtool libraries
- -shrext SUFFIX override the standard shared library file extension
- -static do not do any dynamic linking of uninstalled libtool libraries
- -static-libtool-libs
- do not do any dynamic linking of libtool libraries
- -version-info CURRENT[:REVISION[:AGE]]
- specify library version info [each variable defaults to 0]
- -weak LIBNAME declare that the target provides the LIBNAME interface
-
-All other options (arguments beginning with \`-') are ignored.
-
-Every other argument is treated as a filename. Files ending in \`.la' are
-treated as uninstalled libtool libraries, other files are standard or library
-object files.
-
-If the OUTPUT-FILE ends in \`.la', then a libtool library is created,
-only library objects (\`.lo' files) may be specified, and \`-rpath' is
-required, except when creating a convenience library.
-
-If OUTPUT-FILE ends in \`.a' or \`.lib', then a standard library is created
-using \`ar' and \`ranlib', or on Windows using \`lib'.
-
-If OUTPUT-FILE ends in \`.lo' or \`.${objext}', then a reloadable object file
-is created, otherwise an executable program is created."
- ;;
-
- uninstall)
- $ECHO \
-"Usage: $progname [OPTION]... --mode=uninstall RM [RM-OPTION]... FILE...
-
-Remove libraries from an installation directory.
-
-RM is the name of the program to use to delete files associated with each FILE
-(typically \`/bin/rm'). RM-OPTIONS are options (such as \`-f') to be passed
-to RM.
-
-If FILE is a libtool library, all the files associated with it are deleted.
-Otherwise, only FILE itself is deleted using RM."
- ;;
-
- *)
- func_fatal_help "invalid operation mode \`$mode'"
- ;;
- esac
-
- $ECHO
- $ECHO "Try \`$progname --help' for more information about other modes."
-
- exit $?
-}
-
- # Now that we've collected a possible --mode arg, show help if necessary
- $opt_help && func_mode_help
-
-
-# func_mode_execute arg...
-func_mode_execute ()
-{
- $opt_debug
- # The first argument is the command name.
- cmd="$nonopt"
- test -z "$cmd" && \
- func_fatal_help "you must specify a COMMAND"
-
- # Handle -dlopen flags immediately.
- for file in $execute_dlfiles; do
- test -f "$file" \
- || func_fatal_help "\`$file' is not a file"
-
- dir=
- case $file in
- *.la)
- # Check to see that this really is a libtool archive.
- func_lalib_unsafe_p "$file" \
- || func_fatal_help "\`$lib' is not a valid libtool archive"
-
- # Read the libtool library.
- dlname=
- library_names=
- func_source "$file"
-
- # Skip this library if it cannot be dlopened.
- if test -z "$dlname"; then
- # Warn if it was a shared library.
- test -n "$library_names" && \
- func_warning "\`$file' was not linked with \`-export-dynamic'"
- continue
- fi
-
- func_dirname "$file" "" "."
- dir="$func_dirname_result"
-
- if test -f "$dir/$objdir/$dlname"; then
- dir="$dir/$objdir"
- else
- if test ! -f "$dir/$dlname"; then
- func_fatal_error "cannot find \`$dlname' in \`$dir' or \`$dir/$objdir'"
- fi
- fi
- ;;
-
- *.lo)
- # Just add the directory containing the .lo file.
- func_dirname "$file" "" "."
- dir="$func_dirname_result"
- ;;
-
- *)
- func_warning "\`-dlopen' is ignored for non-libtool libraries and objects"
- continue
- ;;
- esac
-
- # Get the absolute pathname.
- absdir=`cd "$dir" && pwd`
- test -n "$absdir" && dir="$absdir"
-
- # Now add the directory to shlibpath_var.
- if eval "test -z \"\$$shlibpath_var\""; then
- eval "$shlibpath_var=\"\$dir\""
- else
- eval "$shlibpath_var=\"\$dir:\$$shlibpath_var\""
- fi
- done
-
- # This variable tells wrapper scripts just to set shlibpath_var
- # rather than running their programs.
- libtool_execute_magic="$magic"
-
- # Check if any of the arguments is a wrapper script.
- args=
- for file
- do
- case $file in
- -*) ;;
- *)
- # Do a test to see if this is really a libtool program.
- if func_ltwrapper_script_p "$file"; then
- func_source "$file"
- # Transform arg to wrapped name.
- file="$progdir/$program"
- elif func_ltwrapper_executable_p "$file"; then
- func_ltwrapper_scriptname "$file"
- func_source "$func_ltwrapper_scriptname_result"
- # Transform arg to wrapped name.
- file="$progdir/$program"
- fi
- ;;
- esac
- # Quote arguments (to preserve shell metacharacters).
- func_quote_for_eval "$file"
- args="$args $func_quote_for_eval_result"
- done
-
- if test "X$opt_dry_run" = Xfalse; then
- if test -n "$shlibpath_var"; then
- # Export the shlibpath_var.
- eval "export $shlibpath_var"
- fi
-
- # Restore saved environment variables
- for lt_var in LANG LANGUAGE LC_ALL LC_CTYPE LC_COLLATE LC_MESSAGES
- do
- eval "if test \"\${save_$lt_var+set}\" = set; then
- $lt_var=\$save_$lt_var; export $lt_var
- else
- $lt_unset $lt_var
- fi"
- done
-
- # Now prepare to actually exec the command.
- exec_cmd="\$cmd$args"
- else
- # Display what would be done.
- if test -n "$shlibpath_var"; then
- eval "\$ECHO \"\$shlibpath_var=\$$shlibpath_var\""
- $ECHO "export $shlibpath_var"
- fi
- $ECHO "$cmd$args"
- exit $EXIT_SUCCESS
- fi
-}
-
-test "$mode" = execute && func_mode_execute ${1+"$@"}
-
-
-# func_mode_finish arg...
-func_mode_finish ()
-{
- $opt_debug
- libdirs="$nonopt"
- admincmds=
-
- if test -n "$finish_cmds$finish_eval" && test -n "$libdirs"; then
- for dir
- do
- libdirs="$libdirs $dir"
- done
-
- for libdir in $libdirs; do
- if test -n "$finish_cmds"; then
- # Do each command in the finish commands.
- func_execute_cmds "$finish_cmds" 'admincmds="$admincmds
-'"$cmd"'"'
- fi
- if test -n "$finish_eval"; then
- # Do the single finish_eval.
- eval cmds=\"$finish_eval\"
- $opt_dry_run || eval "$cmds" || admincmds="$admincmds
- $cmds"
- fi
- done
- fi
-
- # Exit here if they wanted silent mode.
- $opt_silent && exit $EXIT_SUCCESS
-
- $ECHO "X----------------------------------------------------------------------" | $Xsed
- $ECHO "Libraries have been installed in:"
- for libdir in $libdirs; do
- $ECHO " $libdir"
- done
- $ECHO
- $ECHO "If you ever happen to want to link against installed libraries"
- $ECHO "in a given directory, LIBDIR, you must either use libtool, and"
- $ECHO "specify the full pathname of the library, or use the \`-LLIBDIR'"
- $ECHO "flag during linking and do at least one of the following:"
- if test -n "$shlibpath_var"; then
- $ECHO " - add LIBDIR to the \`$shlibpath_var' environment variable"
- $ECHO " during execution"
- fi
- if test -n "$runpath_var"; then
- $ECHO " - add LIBDIR to the \`$runpath_var' environment variable"
- $ECHO " during linking"
- fi
- if test -n "$hardcode_libdir_flag_spec"; then
- libdir=LIBDIR
- eval flag=\"$hardcode_libdir_flag_spec\"
-
- $ECHO " - use the \`$flag' linker flag"
- fi
- if test -n "$admincmds"; then
- $ECHO " - have your system administrator run these commands:$admincmds"
- fi
- if test -f /etc/ld.so.conf; then
- $ECHO " - have your system administrator add LIBDIR to \`/etc/ld.so.conf'"
- fi
- $ECHO
-
- $ECHO "See any operating system documentation about shared libraries for"
- case $host in
- solaris2.[6789]|solaris2.1[0-9])
- $ECHO "more information, such as the ld(1), crle(1) and ld.so(8) manual"
- $ECHO "pages."
- ;;
- *)
- $ECHO "more information, such as the ld(1) and ld.so(8) manual pages."
- ;;
- esac
- $ECHO "X----------------------------------------------------------------------" | $Xsed
- exit $EXIT_SUCCESS
-}
-
-test "$mode" = finish && func_mode_finish ${1+"$@"}
-
-
-# func_mode_install arg...
-func_mode_install ()
-{
- $opt_debug
- # There may be an optional sh(1) argument at the beginning of
- # install_prog (especially on Windows NT).
- if test "$nonopt" = "$SHELL" || test "$nonopt" = /bin/sh ||
- # Allow the use of GNU shtool's install command.
- $ECHO "X$nonopt" | $GREP shtool >/dev/null; then
- # Aesthetically quote it.
- func_quote_for_eval "$nonopt"
- install_prog="$func_quote_for_eval_result "
- arg=$1
- shift
- else
- install_prog=
- arg=$nonopt
- fi
-
- # The real first argument should be the name of the installation program.
- # Aesthetically quote it.
- func_quote_for_eval "$arg"
- install_prog="$install_prog$func_quote_for_eval_result"
-
- # We need to accept at least all the BSD install flags.
- dest=
- files=
- opts=
- prev=
- install_type=
- isdir=no
- stripme=
- for arg
- do
- if test -n "$dest"; then
- files="$files $dest"
- dest=$arg
- continue
- fi
-
- case $arg in
- -d) isdir=yes ;;
- -f)
- case " $install_prog " in
- *[\\\ /]cp\ *) ;;
- *) prev=$arg ;;
- esac
- ;;
- -g | -m | -o)
- prev=$arg
- ;;
- -s)
- stripme=" -s"
- continue
- ;;
- -*)
- ;;
- *)
- # If the previous option needed an argument, then skip it.
- if test -n "$prev"; then
- prev=
- else
- dest=$arg
- continue
- fi
- ;;
- esac
-
- # Aesthetically quote the argument.
- func_quote_for_eval "$arg"
- install_prog="$install_prog $func_quote_for_eval_result"
- done
-
- test -z "$install_prog" && \
- func_fatal_help "you must specify an install program"
-
- test -n "$prev" && \
- func_fatal_help "the \`$prev' option requires an argument"
-
- if test -z "$files"; then
- if test -z "$dest"; then
- func_fatal_help "no file or destination specified"
- else
- func_fatal_help "you must specify a destination"
- fi
- fi
-
- # Strip any trailing slash from the destination.
- func_stripname '' '/' "$dest"
- dest=$func_stripname_result
-
- # Check to see that the destination is a directory.
- test -d "$dest" && isdir=yes
- if test "$isdir" = yes; then
- destdir="$dest"
- destname=
- else
- func_dirname_and_basename "$dest" "" "."
- destdir="$func_dirname_result"
- destname="$func_basename_result"
-
- # Not a directory, so check to see that there is only one file specified.
- set dummy $files; shift
- test "$#" -gt 1 && \
- func_fatal_help "\`$dest' is not a directory"
- fi
- case $destdir in
- [\\/]* | [A-Za-z]:[\\/]*) ;;
- *)
- for file in $files; do
- case $file in
- *.lo) ;;
- *)
- func_fatal_help "\`$destdir' must be an absolute directory name"
- ;;
- esac
- done
- ;;
- esac
-
- # This variable tells wrapper scripts just to set variables rather
- # than running their programs.
- libtool_install_magic="$magic"
-
- staticlibs=
- future_libdirs=
- current_libdirs=
- for file in $files; do
-
- # Do each installation.
- case $file in
- *.$libext)
- # Do the static libraries later.
- staticlibs="$staticlibs $file"
- ;;
-
- *.la)
- # Check to see that this really is a libtool archive.
- func_lalib_unsafe_p "$file" \
- || func_fatal_help "\`$file' is not a valid libtool archive"
-
- library_names=
- old_library=
- relink_command=
- func_source "$file"
-
- # Add the libdir to current_libdirs if it is the destination.
- if test "X$destdir" = "X$libdir"; then
- case "$current_libdirs " in
- *" $libdir "*) ;;
- *) current_libdirs="$current_libdirs $libdir" ;;
- esac
- else
- # Note the libdir as a future libdir.
- case "$future_libdirs " in
- *" $libdir "*) ;;
- *) future_libdirs="$future_libdirs $libdir" ;;
- esac
- fi
-
- func_dirname "$file" "/" ""
- dir="$func_dirname_result"
- dir="$dir$objdir"
-
- if test -n "$relink_command"; then
- # Determine the prefix the user has applied to our future dir.
- inst_prefix_dir=`$ECHO "X$destdir" | $Xsed -e "s%$libdir\$%%"`
-
- # Don't allow the user to place us outside of our expected
- # location b/c this prevents finding dependent libraries that
- # are installed to the same prefix.
- # At present, this check doesn't affect windows .dll's that
- # are installed into $libdir/../bin (currently, that works fine)
- # but it's something to keep an eye on.
- test "$inst_prefix_dir" = "$destdir" && \
- func_fatal_error "error: cannot install \`$file' to a directory not ending in $libdir"
-
- if test -n "$inst_prefix_dir"; then
- # Stick the inst_prefix_dir data into the link command.
- relink_command=`$ECHO "X$relink_command" | $Xsed -e "s%@inst_prefix_dir@%-inst-prefix-dir $inst_prefix_dir%"`
- else
- relink_command=`$ECHO "X$relink_command" | $Xsed -e "s%@inst_prefix_dir@%%"`
- fi
-
- func_warning "relinking \`$file'"
- func_show_eval "$relink_command" \
- 'func_fatal_error "error: relink \`$file'\'' with the above command before installing it"'
- fi
-
- # See the names of the shared library.
- set dummy $library_names; shift
- if test -n "$1"; then
- realname="$1"
- shift
-
- srcname="$realname"
- test -n "$relink_command" && srcname="$realname"T
-
- # Install the shared library and build the symlinks.
- func_show_eval "$install_prog $dir/$srcname $destdir/$realname" \
- 'exit $?'
- tstripme="$stripme"
- case $host_os in
- cygwin* | mingw* | pw32* | cegcc*)
- case $realname in
- *.dll.a)
- tstripme=""
- ;;
- esac
- ;;
- esac
- if test -n "$tstripme" && test -n "$striplib"; then
- func_show_eval "$striplib $destdir/$realname" 'exit $?'
- fi
-
- if test "$#" -gt 0; then
- # Delete the old symlinks, and create new ones.
- # Try `ln -sf' first, because the `ln' binary might depend on
- # the symlink we replace! Solaris /bin/ln does not understand -f,
- # so we also need to try rm && ln -s.
- for linkname
- do
- test "$linkname" != "$realname" \
- && func_show_eval "(cd $destdir && { $LN_S -f $realname $linkname || { $RM $linkname && $LN_S $realname $linkname; }; })"
- done
- fi
-
- # Do each command in the postinstall commands.
- lib="$destdir/$realname"
- func_execute_cmds "$postinstall_cmds" 'exit $?'
- fi
-
- # Install the pseudo-library for information purposes.
- func_basename "$file"
- name="$func_basename_result"
- instname="$dir/$name"i
- func_show_eval "$install_prog $instname $destdir/$name" 'exit $?'
-
- # Maybe install the static library, too.
- test -n "$old_library" && staticlibs="$staticlibs $dir/$old_library"
- ;;
-
- *.lo)
- # Install (i.e. copy) a libtool object.
-
- # Figure out destination file name, if it wasn't already specified.
- if test -n "$destname"; then
- destfile="$destdir/$destname"
- else
- func_basename "$file"
- destfile="$func_basename_result"
- destfile="$destdir/$destfile"
- fi
-
- # Deduce the name of the destination old-style object file.
- case $destfile in
- *.lo)
- func_lo2o "$destfile"
- staticdest=$func_lo2o_result
- ;;
- *.$objext)
- staticdest="$destfile"
- destfile=
- ;;
- *)
- func_fatal_help "cannot copy a libtool object to \`$destfile'"
- ;;
- esac
-
- # Install the libtool object if requested.
- test -n "$destfile" && \
- func_show_eval "$install_prog $file $destfile" 'exit $?'
-
- # Install the old object if enabled.
- if test "$build_old_libs" = yes; then
- # Deduce the name of the old-style object file.
- func_lo2o "$file"
- staticobj=$func_lo2o_result
- func_show_eval "$install_prog \$staticobj \$staticdest" 'exit $?'
- fi
- exit $EXIT_SUCCESS
- ;;
-
- *)
- # Figure out destination file name, if it wasn't already specified.
- if test -n "$destname"; then
- destfile="$destdir/$destname"
- else
- func_basename "$file"
- destfile="$func_basename_result"
- destfile="$destdir/$destfile"
- fi
-
- # If the file is missing, and there is a .exe on the end, strip it
- # because it is most likely a libtool script we actually want to
- # install
- stripped_ext=""
- case $file in
- *.exe)
- if test ! -f "$file"; then
- func_stripname '' '.exe' "$file"
- file=$func_stripname_result
- stripped_ext=".exe"
- fi
- ;;
- esac
-
- # Do a test to see if this is really a libtool program.
- case $host in
- *cygwin* | *mingw*)
- if func_ltwrapper_executable_p "$file"; then
- func_ltwrapper_scriptname "$file"
- wrapper=$func_ltwrapper_scriptname_result
- else
- func_stripname '' '.exe' "$file"
- wrapper=$func_stripname_result
- fi
- ;;
- *)
- wrapper=$file
- ;;
- esac
- if func_ltwrapper_script_p "$wrapper"; then
- notinst_deplibs=
- relink_command=
-
- func_source "$wrapper"
-
- # Check the variables that should have been set.
- test -z "$generated_by_libtool_version" && \
- func_fatal_error "invalid libtool wrapper script \`$wrapper'"
-
- finalize=yes
- for lib in $notinst_deplibs; do
- # Check to see that each library is installed.
- libdir=
- if test -f "$lib"; then
- func_source "$lib"
- fi
- libfile="$libdir/"`$ECHO "X$lib" | $Xsed -e 's%^.*/%%g'` ### testsuite: skip nested quoting test
- if test -n "$libdir" && test ! -f "$libfile"; then
- func_warning "\`$lib' has not been installed in \`$libdir'"
- finalize=no
- fi
- done
-
- relink_command=
- func_source "$wrapper"
-
- outputname=
- if test "$fast_install" = no && test -n "$relink_command"; then
- $opt_dry_run || {
- if test "$finalize" = yes; then
- tmpdir=`func_mktempdir`
- func_basename "$file$stripped_ext"
- file="$func_basename_result"
- outputname="$tmpdir/$file"
- # Replace the output file specification.
- relink_command=`$ECHO "X$relink_command" | $Xsed -e 's%@OUTPUT@%'"$outputname"'%g'`
-
- $opt_silent || {
- func_quote_for_expand "$relink_command"
- eval "func_echo $func_quote_for_expand_result"
- }
- if eval "$relink_command"; then :
- else
- func_error "error: relink \`$file' with the above command before installing it"
- $opt_dry_run || ${RM}r "$tmpdir"
- continue
- fi
- file="$outputname"
- else
- func_warning "cannot relink \`$file'"
- fi
- }
- else
- # Install the binary that we compiled earlier.
- file=`$ECHO "X$file$stripped_ext" | $Xsed -e "s%\([^/]*\)$%$objdir/\1%"`
- fi
- fi
-
- # remove .exe since cygwin /usr/bin/install will append another
- # one anyway
- case $install_prog,$host in
- */usr/bin/install*,*cygwin*)
- case $file:$destfile in
- *.exe:*.exe)
- # this is ok
- ;;
- *.exe:*)
- destfile=$destfile.exe
- ;;
- *:*.exe)
- func_stripname '' '.exe' "$destfile"
- destfile=$func_stripname_result
- ;;
- esac
- ;;
- esac
- func_show_eval "$install_prog\$stripme \$file \$destfile" 'exit $?'
- $opt_dry_run || if test -n "$outputname"; then
- ${RM}r "$tmpdir"
- fi
- ;;
- esac
- done
-
- for file in $staticlibs; do
- func_basename "$file"
- name="$func_basename_result"
-
- # Set up the ranlib parameters.
- oldlib="$destdir/$name"
-
- func_show_eval "$install_prog \$file \$oldlib" 'exit $?'
-
- if test -n "$stripme" && test -n "$old_striplib"; then
- func_show_eval "$old_striplib $oldlib" 'exit $?'
- fi
-
- # Do each command in the postinstall commands.
- func_execute_cmds "$old_postinstall_cmds" 'exit $?'
- done
-
- test -n "$future_libdirs" && \
- func_warning "remember to run \`$progname --finish$future_libdirs'"
-
- if test -n "$current_libdirs"; then
- # Maybe just do a dry run.
- $opt_dry_run && current_libdirs=" -n$current_libdirs"
- exec_cmd='$SHELL $progpath $preserve_args --finish$current_libdirs'
- else
- exit $EXIT_SUCCESS
- fi
-}
-
-test "$mode" = install && func_mode_install ${1+"$@"}
-
-
-# func_generate_dlsyms outputname originator pic_p
-# Extract symbols from dlprefiles and create ${outputname}S.o with
-# a dlpreopen symbol table.
-func_generate_dlsyms ()
-{
- $opt_debug
- my_outputname="$1"
- my_originator="$2"
- my_pic_p="${3-no}"
- my_prefix=`$ECHO "$my_originator" | sed 's%[^a-zA-Z0-9]%_%g'`
- my_dlsyms=
-
- if test -n "$dlfiles$dlprefiles" || test "$dlself" != no; then
- if test -n "$NM" && test -n "$global_symbol_pipe"; then
- my_dlsyms="${my_outputname}S.c"
- else
- func_error "not configured to extract global symbols from dlpreopened files"
- fi
- fi
-
- if test -n "$my_dlsyms"; then
- case $my_dlsyms in
- "") ;;
- *.c)
- # Discover the nlist of each of the dlfiles.
- nlist="$output_objdir/${my_outputname}.nm"
-
- func_show_eval "$RM $nlist ${nlist}S ${nlist}T"
-
- # Parse the name list into a source file.
- func_verbose "creating $output_objdir/$my_dlsyms"
-
- $opt_dry_run || $ECHO > "$output_objdir/$my_dlsyms" "\
-/* $my_dlsyms - symbol resolution table for \`$my_outputname' dlsym emulation. */
-/* Generated by $PROGRAM (GNU $PACKAGE$TIMESTAMP) $VERSION */
-
-#ifdef __cplusplus
-extern \"C\" {
-#endif
-
-/* External symbol declarations for the compiler. */\
-"
-
- if test "$dlself" = yes; then
- func_verbose "generating symbol list for \`$output'"
-
- $opt_dry_run || echo ': @PROGRAM@ ' > "$nlist"
-
- # Add our own program objects to the symbol list.
- progfiles=`$ECHO "X$objs$old_deplibs" | $SP2NL | $Xsed -e "$lo2o" | $NL2SP`
- for progfile in $progfiles; do
- func_verbose "extracting global C symbols from \`$progfile'"
- $opt_dry_run || eval "$NM $progfile | $global_symbol_pipe >> '$nlist'"
- done
-
- if test -n "$exclude_expsyms"; then
- $opt_dry_run || {
- eval '$EGREP -v " ($exclude_expsyms)$" "$nlist" > "$nlist"T'
- eval '$MV "$nlist"T "$nlist"'
- }
- fi
-
- if test -n "$export_symbols_regex"; then
- $opt_dry_run || {
- eval '$EGREP -e "$export_symbols_regex" "$nlist" > "$nlist"T'
- eval '$MV "$nlist"T "$nlist"'
- }
- fi
-
- # Prepare the list of exported symbols
- if test -z "$export_symbols"; then
- export_symbols="$output_objdir/$outputname.exp"
- $opt_dry_run || {
- $RM $export_symbols
- eval "${SED} -n -e '/^: @PROGRAM@ $/d' -e 's/^.* \(.*\)$/\1/p' "'< "$nlist" > "$export_symbols"'
- case $host in
- *cygwin* | *mingw* | *cegcc* )
- eval "echo EXPORTS "'> "$output_objdir/$outputname.def"'
- eval 'cat "$export_symbols" >> "$output_objdir/$outputname.def"'
- ;;
- esac
- }
- else
- $opt_dry_run || {
- eval "${SED} -e 's/\([].[*^$]\)/\\\\\1/g' -e 's/^/ /' -e 's/$/$/'"' < "$export_symbols" > "$output_objdir/$outputname.exp"'
- eval '$GREP -f "$output_objdir/$outputname.exp" < "$nlist" > "$nlist"T'
- eval '$MV "$nlist"T "$nlist"'
- case $host in
- *cygwin | *mingw* | *cegcc* )
- eval "echo EXPORTS "'> "$output_objdir/$outputname.def"'
- eval 'cat "$nlist" >> "$output_objdir/$outputname.def"'
- ;;
- esac
- }
- fi
- fi
-
- for dlprefile in $dlprefiles; do
- func_verbose "extracting global C symbols from \`$dlprefile'"
- func_basename "$dlprefile"
- name="$func_basename_result"
- $opt_dry_run || {
- eval '$ECHO ": $name " >> "$nlist"'
- eval "$NM $dlprefile 2>/dev/null | $global_symbol_pipe >> '$nlist'"
- }
- done
-
- $opt_dry_run || {
- # Make sure we have at least an empty file.
- test -f "$nlist" || : > "$nlist"
-
- if test -n "$exclude_expsyms"; then
- $EGREP -v " ($exclude_expsyms)$" "$nlist" > "$nlist"T
- $MV "$nlist"T "$nlist"
- fi
-
- # Try sorting and uniquifying the output.
- if $GREP -v "^: " < "$nlist" |
- if sort -k 3 </dev/null >/dev/null 2>&1; then
- sort -k 3
- else
- sort +2
- fi |
- uniq > "$nlist"S; then
- :
- else
- $GREP -v "^: " < "$nlist" > "$nlist"S
- fi
-
- if test -f "$nlist"S; then
- eval "$global_symbol_to_cdecl"' < "$nlist"S >> "$output_objdir/$my_dlsyms"'
- else
- $ECHO '/* NONE */' >> "$output_objdir/$my_dlsyms"
- fi
-
- $ECHO >> "$output_objdir/$my_dlsyms" "\
-
-/* The mapping between symbol names and symbols. */
-typedef struct {
- const char *name;
- void *address;
-} lt_dlsymlist;
-"
- case $host in
- *cygwin* | *mingw* | *cegcc* )
- $ECHO >> "$output_objdir/$my_dlsyms" "\
-/* DATA imports from DLLs on WIN32 con't be const, because
- runtime relocations are performed -- see ld's documentation
- on pseudo-relocs. */"
- lt_dlsym_const= ;;
- *osf5*)
- echo >> "$output_objdir/$my_dlsyms" "\
-/* This system does not cope well with relocations in const data */"
- lt_dlsym_const= ;;
- *)
- lt_dlsym_const=const ;;
- esac
-
- $ECHO >> "$output_objdir/$my_dlsyms" "\
-extern $lt_dlsym_const lt_dlsymlist
-lt_${my_prefix}_LTX_preloaded_symbols[];
-$lt_dlsym_const lt_dlsymlist
-lt_${my_prefix}_LTX_preloaded_symbols[] =
-{\
- { \"$my_originator\", (void *) 0 },"
-
- case $need_lib_prefix in
- no)
- eval "$global_symbol_to_c_name_address" < "$nlist" >> "$output_objdir/$my_dlsyms"
- ;;
- *)
- eval "$global_symbol_to_c_name_address_lib_prefix" < "$nlist" >> "$output_objdir/$my_dlsyms"
- ;;
- esac
- $ECHO >> "$output_objdir/$my_dlsyms" "\
- {0, (void *) 0}
-};
-
-/* This works around a problem in FreeBSD linker */
-#ifdef FREEBSD_WORKAROUND
-static const void *lt_preloaded_setup() {
- return lt_${my_prefix}_LTX_preloaded_symbols;
-}
-#endif
-
-#ifdef __cplusplus
-}
-#endif\
-"
- } # !$opt_dry_run
-
- pic_flag_for_symtable=
- case "$compile_command " in
- *" -static "*) ;;
- *)
- case $host in
- # compiling the symbol table file with pic_flag works around
- # a FreeBSD bug that causes programs to crash when -lm is
- # linked before any other PIC object. But we must not use
- # pic_flag when linking with -static. The problem exists in
- # FreeBSD 2.2.6 and is fixed in FreeBSD 3.1.
- *-*-freebsd2*|*-*-freebsd3.0*|*-*-freebsdelf3.0*)
- pic_flag_for_symtable=" $pic_flag -DFREEBSD_WORKAROUND" ;;
- *-*-hpux*)
- pic_flag_for_symtable=" $pic_flag" ;;
- *)
- if test "X$my_pic_p" != Xno; then
- pic_flag_for_symtable=" $pic_flag"
- fi
- ;;
- esac
- ;;
- esac
- symtab_cflags=
- for arg in $LTCFLAGS; do
- case $arg in
- -pie | -fpie | -fPIE) ;;
- *) symtab_cflags="$symtab_cflags $arg" ;;
- esac
- done
-
- # Now compile the dynamic symbol file.
- func_show_eval '(cd $output_objdir && $LTCC$symtab_cflags -c$no_builtin_flag$pic_flag_for_symtable "$my_dlsyms")' 'exit $?'
-
- # Clean up the generated files.
- func_show_eval '$RM "$output_objdir/$my_dlsyms" "$nlist" "${nlist}S" "${nlist}T"'
-
- # Transform the symbol file into the correct name.
- symfileobj="$output_objdir/${my_outputname}S.$objext"
- case $host in
- *cygwin* | *mingw* | *cegcc* )
- if test -f "$output_objdir/$my_outputname.def"; then
- compile_command=`$ECHO "X$compile_command" | $Xsed -e "s%@SYMFILE@%$output_objdir/$my_outputname.def $symfileobj%"`
- finalize_command=`$ECHO "X$finalize_command" | $Xsed -e "s%@SYMFILE@%$output_objdir/$my_outputname.def $symfileobj%"`
- else
- compile_command=`$ECHO "X$compile_command" | $Xsed -e "s%@SYMFILE@%$symfileobj%"`
- finalize_command=`$ECHO "X$finalize_command" | $Xsed -e "s%@SYMFILE@%$symfileobj%"`
- fi
- ;;
- *)
- compile_command=`$ECHO "X$compile_command" | $Xsed -e "s%@SYMFILE@%$symfileobj%"`
- finalize_command=`$ECHO "X$finalize_command" | $Xsed -e "s%@SYMFILE@%$symfileobj%"`
- ;;
- esac
- ;;
- *)
- func_fatal_error "unknown suffix for \`$my_dlsyms'"
- ;;
- esac
- else
- # We keep going just in case the user didn't refer to
- # lt_preloaded_symbols. The linker will fail if global_symbol_pipe
- # really was required.
-
- # Nullify the symbol file.
- compile_command=`$ECHO "X$compile_command" | $Xsed -e "s% @SYMFILE@%%"`
- finalize_command=`$ECHO "X$finalize_command" | $Xsed -e "s% @SYMFILE@%%"`
- fi
-}
-
-# func_win32_libid arg
-# return the library type of file 'arg'
-#
-# Need a lot of goo to handle *both* DLLs and import libs
-# Has to be a shell function in order to 'eat' the argument
-# that is supplied when $file_magic_command is called.
-func_win32_libid ()
-{
- $opt_debug
- win32_libid_type="unknown"
- win32_fileres=`file -L $1 2>/dev/null`
- case $win32_fileres in
- *ar\ archive\ import\ library*) # definitely import
- win32_libid_type="x86 archive import"
- ;;
- *ar\ archive*) # could be an import, or static
- if eval $OBJDUMP -f $1 | $SED -e '10q' 2>/dev/null |
- $EGREP 'file format pe-i386(.*architecture: i386)?' >/dev/null ; then
- win32_nmres=`eval $NM -f posix -A $1 |
- $SED -n -e '
- 1,100{
- / I /{
- s,.*,import,
- p
- q
- }
- }'`
- case $win32_nmres in
- import*) win32_libid_type="x86 archive import";;
- *) win32_libid_type="x86 archive static";;
- esac
- fi
- ;;
- *DLL*)
- win32_libid_type="x86 DLL"
- ;;
- *executable*) # but shell scripts are "executable" too...
- case $win32_fileres in
- *MS\ Windows\ PE\ Intel*)
- win32_libid_type="x86 DLL"
- ;;
- esac
- ;;
- esac
- $ECHO "$win32_libid_type"
-}
-
-
-
-# func_extract_an_archive dir oldlib
-func_extract_an_archive ()
-{
- $opt_debug
- f_ex_an_ar_dir="$1"; shift
- f_ex_an_ar_oldlib="$1"
- func_show_eval "(cd \$f_ex_an_ar_dir && $AR x \"\$f_ex_an_ar_oldlib\")" 'exit $?'
- if ($AR t "$f_ex_an_ar_oldlib" | sort | sort -uc >/dev/null 2>&1); then
- :
- else
- func_fatal_error "object name conflicts in archive: $f_ex_an_ar_dir/$f_ex_an_ar_oldlib"
- fi
-}
-
-
-# func_extract_archives gentop oldlib ...
-func_extract_archives ()
-{
- $opt_debug
- my_gentop="$1"; shift
- my_oldlibs=${1+"$@"}
- my_oldobjs=""
- my_xlib=""
- my_xabs=""
- my_xdir=""
-
- for my_xlib in $my_oldlibs; do
- # Extract the objects.
- case $my_xlib in
- [\\/]* | [A-Za-z]:[\\/]*) my_xabs="$my_xlib" ;;
- *) my_xabs=`pwd`"/$my_xlib" ;;
- esac
- func_basename "$my_xlib"
- my_xlib="$func_basename_result"
- my_xlib_u=$my_xlib
- while :; do
- case " $extracted_archives " in
- *" $my_xlib_u "*)
- func_arith $extracted_serial + 1
- extracted_serial=$func_arith_result
- my_xlib_u=lt$extracted_serial-$my_xlib ;;
- *) break ;;
- esac
- done
- extracted_archives="$extracted_archives $my_xlib_u"
- my_xdir="$my_gentop/$my_xlib_u"
-
- func_mkdir_p "$my_xdir"
-
- case $host in
- *-darwin*)
- func_verbose "Extracting $my_xabs"
- # Do not bother doing anything if just a dry run
- $opt_dry_run || {
- darwin_orig_dir=`pwd`
- cd $my_xdir || exit $?
- darwin_archive=$my_xabs
- darwin_curdir=`pwd`
- darwin_base_archive=`basename "$darwin_archive"`
- darwin_arches=`$LIPO -info "$darwin_archive" 2>/dev/null | $GREP Architectures 2>/dev/null || true`
- if test -n "$darwin_arches"; then
- darwin_arches=`$ECHO "$darwin_arches" | $SED -e 's/.*are://'`
- darwin_arch=
- func_verbose "$darwin_base_archive has multiple architectures $darwin_arches"
- for darwin_arch in $darwin_arches ; do
- func_mkdir_p "unfat-$$/${darwin_base_archive}-${darwin_arch}"
- $LIPO -thin $darwin_arch -output "unfat-$$/${darwin_base_archive}-${darwin_arch}/${darwin_base_archive}" "${darwin_archive}"
- cd "unfat-$$/${darwin_base_archive}-${darwin_arch}"
- func_extract_an_archive "`pwd`" "${darwin_base_archive}"
- cd "$darwin_curdir"
- $RM "unfat-$$/${darwin_base_archive}-${darwin_arch}/${darwin_base_archive}"
- done # $darwin_arches
- ## Okay now we've a bunch of thin objects, gotta fatten them up :)
- darwin_filelist=`find unfat-$$ -type f -name \*.o -print -o -name \*.lo -print | $SED -e "$basename" | sort -u`
- darwin_file=
- darwin_files=
- for darwin_file in $darwin_filelist; do
- darwin_files=`find unfat-$$ -name $darwin_file -print | $NL2SP`
- $LIPO -create -output "$darwin_file" $darwin_files
- done # $darwin_filelist
- $RM -rf unfat-$$
- cd "$darwin_orig_dir"
- else
- cd $darwin_orig_dir
- func_extract_an_archive "$my_xdir" "$my_xabs"
- fi # $darwin_arches
- } # !$opt_dry_run
- ;;
- *)
- func_extract_an_archive "$my_xdir" "$my_xabs"
- ;;
- esac
- my_oldobjs="$my_oldobjs "`find $my_xdir -name \*.$objext -print -o -name \*.lo -print | $NL2SP`
- done
-
- func_extract_archives_result="$my_oldobjs"
-}
-
-
-
-# func_emit_wrapper_part1 [arg=no]
-#
-# Emit the first part of a libtool wrapper script on stdout.
-# For more information, see the description associated with
-# func_emit_wrapper(), below.
-func_emit_wrapper_part1 ()
-{
- func_emit_wrapper_part1_arg1=no
- if test -n "$1" ; then
- func_emit_wrapper_part1_arg1=$1
- fi
-
- $ECHO "\
-#! $SHELL
-
-# $output - temporary wrapper script for $objdir/$outputname
-# Generated by $PROGRAM (GNU $PACKAGE$TIMESTAMP) $VERSION
-#
-# The $output program cannot be directly executed until all the libtool
-# libraries that it depends on are installed.
-#
-# This wrapper script should never be moved out of the build directory.
-# If it is, it will not operate correctly.
-
-# Sed substitution that helps us do robust quoting. It backslashifies
-# metacharacters that are still active within double-quoted strings.
-Xsed='${SED} -e 1s/^X//'
-sed_quote_subst='$sed_quote_subst'
-
-# Be Bourne compatible
-if test -n \"\${ZSH_VERSION+set}\" && (emulate sh) >/dev/null 2>&1; then
- emulate sh
- NULLCMD=:
- # Zsh 3.x and 4.x performs word splitting on \${1+\"\$@\"}, which
- # is contrary to our usage. Disable this feature.
- alias -g '\${1+\"\$@\"}'='\"\$@\"'
- setopt NO_GLOB_SUBST
-else
- case \`(set -o) 2>/dev/null\` in *posix*) set -o posix;; esac
-fi
-BIN_SH=xpg4; export BIN_SH # for Tru64
-DUALCASE=1; export DUALCASE # for MKS sh
-
-# The HP-UX ksh and POSIX shell print the target directory to stdout
-# if CDPATH is set.
-(unset CDPATH) >/dev/null 2>&1 && unset CDPATH
-
-relink_command=\"$relink_command\"
-
-# This environment variable determines our operation mode.
-if test \"\$libtool_install_magic\" = \"$magic\"; then
- # install mode needs the following variables:
- generated_by_libtool_version='$macro_version'
- notinst_deplibs='$notinst_deplibs'
-else
- # When we are sourced in execute mode, \$file and \$ECHO are already set.
- if test \"\$libtool_execute_magic\" != \"$magic\"; then
- ECHO=\"$qecho\"
- file=\"\$0\"
- # Make sure echo works.
- if test \"X\$1\" = X--no-reexec; then
- # Discard the --no-reexec flag, and continue.
- shift
- elif test \"X\`{ \$ECHO '\t'; } 2>/dev/null\`\" = 'X\t'; then
- # Yippee, \$ECHO works!
- :
- else
- # Restart under the correct shell, and then maybe \$ECHO will work.
- exec $SHELL \"\$0\" --no-reexec \${1+\"\$@\"}
- fi
- fi\
-"
- $ECHO "\
-
- # Find the directory that this script lives in.
- thisdir=\`\$ECHO \"X\$file\" | \$Xsed -e 's%/[^/]*$%%'\`
- test \"x\$thisdir\" = \"x\$file\" && thisdir=.
-
- # Follow symbolic links until we get to the real thisdir.
- file=\`ls -ld \"\$file\" | ${SED} -n 's/.*-> //p'\`
- while test -n \"\$file\"; do
- destdir=\`\$ECHO \"X\$file\" | \$Xsed -e 's%/[^/]*\$%%'\`
-
- # If there was a directory component, then change thisdir.
- if test \"x\$destdir\" != \"x\$file\"; then
- case \"\$destdir\" in
- [\\\\/]* | [A-Za-z]:[\\\\/]*) thisdir=\"\$destdir\" ;;
- *) thisdir=\"\$thisdir/\$destdir\" ;;
- esac
- fi
-
- file=\`\$ECHO \"X\$file\" | \$Xsed -e 's%^.*/%%'\`
- file=\`ls -ld \"\$thisdir/\$file\" | ${SED} -n 's/.*-> //p'\`
- done
-"
-}
-# end: func_emit_wrapper_part1
-
-# func_emit_wrapper_part2 [arg=no]
-#
-# Emit the second part of a libtool wrapper script on stdout.
-# For more information, see the description associated with
-# func_emit_wrapper(), below.
-func_emit_wrapper_part2 ()
-{
- func_emit_wrapper_part2_arg1=no
- if test -n "$1" ; then
- func_emit_wrapper_part2_arg1=$1
- fi
-
- $ECHO "\
-
- # Usually 'no', except on cygwin/mingw when embedded into
- # the cwrapper.
- WRAPPER_SCRIPT_BELONGS_IN_OBJDIR=$func_emit_wrapper_part2_arg1
- if test \"\$WRAPPER_SCRIPT_BELONGS_IN_OBJDIR\" = \"yes\"; then
- # special case for '.'
- if test \"\$thisdir\" = \".\"; then
- thisdir=\`pwd\`
- fi
- # remove .libs from thisdir
- case \"\$thisdir\" in
- *[\\\\/]$objdir ) thisdir=\`\$ECHO \"X\$thisdir\" | \$Xsed -e 's%[\\\\/][^\\\\/]*$%%'\` ;;
- $objdir ) thisdir=. ;;
- esac
- fi
-
- # Try to get the absolute directory name.
- absdir=\`cd \"\$thisdir\" && pwd\`
- test -n \"\$absdir\" && thisdir=\"\$absdir\"
-"
-
- if test "$fast_install" = yes; then
- $ECHO "\
- program=lt-'$outputname'$exeext
- progdir=\"\$thisdir/$objdir\"
-
- if test ! -f \"\$progdir/\$program\" ||
- { file=\`ls -1dt \"\$progdir/\$program\" \"\$progdir/../\$program\" 2>/dev/null | ${SED} 1q\`; \\
- test \"X\$file\" != \"X\$progdir/\$program\"; }; then
-
- file=\"\$\$-\$program\"
-
- if test ! -d \"\$progdir\"; then
- $MKDIR \"\$progdir\"
- else
- $RM \"\$progdir/\$file\"
- fi"
-
- $ECHO "\
-
- # relink executable if necessary
- if test -n \"\$relink_command\"; then
- if relink_command_output=\`eval \$relink_command 2>&1\`; then :
- else
- $ECHO \"\$relink_command_output\" >&2
- $RM \"\$progdir/\$file\"
- exit 1
- fi
- fi
-
- $MV \"\$progdir/\$file\" \"\$progdir/\$program\" 2>/dev/null ||
- { $RM \"\$progdir/\$program\";
- $MV \"\$progdir/\$file\" \"\$progdir/\$program\"; }
- $RM \"\$progdir/\$file\"
- fi"
- else
- $ECHO "\
- program='$outputname'
- progdir=\"\$thisdir/$objdir\"
-"
- fi
-
- $ECHO "\
-
- if test -f \"\$progdir/\$program\"; then"
-
- # Export our shlibpath_var if we have one.
- if test "$shlibpath_overrides_runpath" = yes && test -n "$shlibpath_var" && test -n "$temp_rpath"; then
- $ECHO "\
- # Add our own library path to $shlibpath_var
- $shlibpath_var=\"$temp_rpath\$$shlibpath_var\"
-
- # Some systems cannot cope with colon-terminated $shlibpath_var
- # The second colon is a workaround for a bug in BeOS R4 sed
- $shlibpath_var=\`\$ECHO \"X\$$shlibpath_var\" | \$Xsed -e 's/::*\$//'\`
-
- export $shlibpath_var
-"
- fi
-
- # fixup the dll searchpath if we need to.
- if test -n "$dllsearchpath"; then
- $ECHO "\
- # Add the dll search path components to the executable PATH
- PATH=$dllsearchpath:\$PATH
-"
- fi
-
- $ECHO "\
- if test \"\$libtool_execute_magic\" != \"$magic\"; then
- # Run the actual program with our arguments.
-"
- case $host in
- # Backslashes separate directories on plain windows
- *-*-mingw | *-*-os2* | *-cegcc*)
- $ECHO "\
- exec \"\$progdir\\\\\$program\" \${1+\"\$@\"}
-"
- ;;
-
- *)
- $ECHO "\
- exec \"\$progdir/\$program\" \${1+\"\$@\"}
-"
- ;;
- esac
- $ECHO "\
- \$ECHO \"\$0: cannot exec \$program \$*\" 1>&2
- exit 1
- fi
- else
- # The program doesn't exist.
- \$ECHO \"\$0: error: \\\`\$progdir/\$program' does not exist\" 1>&2
- \$ECHO \"This script is just a wrapper for \$program.\" 1>&2
- $ECHO \"See the $PACKAGE documentation for more information.\" 1>&2
- exit 1
- fi
-fi\
-"
-}
-# end: func_emit_wrapper_part2
-
-
-# func_emit_wrapper [arg=no]
-#
-# Emit a libtool wrapper script on stdout.
-# Don't directly open a file because we may want to
-# incorporate the script contents within a cygwin/mingw
-# wrapper executable. Must ONLY be called from within
-# func_mode_link because it depends on a number of variables
-# set therein.
-#
-# ARG is the value that the WRAPPER_SCRIPT_BELONGS_IN_OBJDIR
-# variable will take. If 'yes', then the emitted script
-# will assume that the directory in which it is stored is
-# the $objdir directory. This is a cygwin/mingw-specific
-# behavior.
-func_emit_wrapper ()
-{
- func_emit_wrapper_arg1=no
- if test -n "$1" ; then
- func_emit_wrapper_arg1=$1
- fi
-
- # split this up so that func_emit_cwrapperexe_src
- # can call each part independently.
- func_emit_wrapper_part1 "${func_emit_wrapper_arg1}"
- func_emit_wrapper_part2 "${func_emit_wrapper_arg1}"
-}
-
-
-# func_to_host_path arg
-#
-# Convert paths to host format when used with build tools.
-# Intended for use with "native" mingw (where libtool itself
-# is running under the msys shell), or in the following cross-
-# build environments:
-# $build $host
-# mingw (msys) mingw [e.g. native]
-# cygwin mingw
-# *nix + wine mingw
-# where wine is equipped with the `winepath' executable.
-# In the native mingw case, the (msys) shell automatically
-# converts paths for any non-msys applications it launches,
-# but that facility isn't available from inside the cwrapper.
-# Similar accommodations are necessary for $host mingw and
-# $build cygwin. Calling this function does no harm for other
-# $host/$build combinations not listed above.
-#
-# ARG is the path (on $build) that should be converted to
-# the proper representation for $host. The result is stored
-# in $func_to_host_path_result.
-func_to_host_path ()
-{
- func_to_host_path_result="$1"
- if test -n "$1" ; then
- case $host in
- *mingw* )
- lt_sed_naive_backslashify='s|\\\\*|\\|g;s|/|\\|g;s|\\|\\\\|g'
- case $build in
- *mingw* ) # actually, msys
- # awkward: cmd appends spaces to result
- lt_sed_strip_trailing_spaces="s/[ ]*\$//"
- func_to_host_path_tmp1=`( cmd //c echo "$1" |\
- $SED -e "$lt_sed_strip_trailing_spaces" ) 2>/dev/null || echo ""`
- func_to_host_path_result=`echo "$func_to_host_path_tmp1" |\
- $SED -e "$lt_sed_naive_backslashify"`
- ;;
- *cygwin* )
- func_to_host_path_tmp1=`cygpath -w "$1"`
- func_to_host_path_result=`echo "$func_to_host_path_tmp1" |\
- $SED -e "$lt_sed_naive_backslashify"`
- ;;
- * )
- # Unfortunately, winepath does not exit with a non-zero
- # error code, so we are forced to check the contents of
- # stdout. On the other hand, if the command is not
- # found, the shell will set an exit code of 127 and print
- # *an error message* to stdout. So we must check for both
- # error code of zero AND non-empty stdout, which explains
- # the odd construction:
- func_to_host_path_tmp1=`winepath -w "$1" 2>/dev/null`
- if test "$?" -eq 0 && test -n "${func_to_host_path_tmp1}"; then
- func_to_host_path_result=`echo "$func_to_host_path_tmp1" |\
- $SED -e "$lt_sed_naive_backslashify"`
- else
- # Allow warning below.
- func_to_host_path_result=""
- fi
- ;;
- esac
- if test -z "$func_to_host_path_result" ; then
- func_error "Could not determine host path corresponding to"
- func_error " '$1'"
- func_error "Continuing, but uninstalled executables may not work."
- # Fallback:
- func_to_host_path_result="$1"
- fi
- ;;
- esac
- fi
-}
-# end: func_to_host_path
-
-# func_to_host_pathlist arg
-#
-# Convert pathlists to host format when used with build tools.
-# See func_to_host_path(), above. This function supports the
-# following $build/$host combinations (but does no harm for
-# combinations not listed here):
-# $build $host
-# mingw (msys) mingw [e.g. native]
-# cygwin mingw
-# *nix + wine mingw
-#
-# Path separators are also converted from $build format to
-# $host format. If ARG begins or ends with a path separator
-# character, it is preserved (but converted to $host format)
-# on output.
-#
-# ARG is a pathlist (on $build) that should be converted to
-# the proper representation on $host. The result is stored
-# in $func_to_host_pathlist_result.
-func_to_host_pathlist ()
-{
- func_to_host_pathlist_result="$1"
- if test -n "$1" ; then
- case $host in
- *mingw* )
- lt_sed_naive_backslashify='s|\\\\*|\\|g;s|/|\\|g;s|\\|\\\\|g'
- # Remove leading and trailing path separator characters from
- # ARG. msys behavior is inconsistent here, cygpath turns them
- # into '.;' and ';.', and winepath ignores them completely.
- func_to_host_pathlist_tmp2="$1"
- # Once set for this call, this variable should not be
- # reassigned. It is used in tha fallback case.
- func_to_host_pathlist_tmp1=`echo "$func_to_host_pathlist_tmp2" |\
- $SED -e 's|^:*||' -e 's|:*$||'`
- case $build in
- *mingw* ) # Actually, msys.
- # Awkward: cmd appends spaces to result.
- lt_sed_strip_trailing_spaces="s/[ ]*\$//"
- func_to_host_pathlist_tmp2=`( cmd //c echo "$func_to_host_pathlist_tmp1" |\
- $SED -e "$lt_sed_strip_trailing_spaces" ) 2>/dev/null || echo ""`
- func_to_host_pathlist_result=`echo "$func_to_host_pathlist_tmp2" |\
- $SED -e "$lt_sed_naive_backslashify"`
- ;;
- *cygwin* )
- func_to_host_pathlist_tmp2=`cygpath -w -p "$func_to_host_pathlist_tmp1"`
- func_to_host_pathlist_result=`echo "$func_to_host_pathlist_tmp2" |\
- $SED -e "$lt_sed_naive_backslashify"`
- ;;
- * )
- # unfortunately, winepath doesn't convert pathlists
- func_to_host_pathlist_result=""
- func_to_host_pathlist_oldIFS=$IFS
- IFS=:
- for func_to_host_pathlist_f in $func_to_host_pathlist_tmp1 ; do
- IFS=$func_to_host_pathlist_oldIFS
- if test -n "$func_to_host_pathlist_f" ; then
- func_to_host_path "$func_to_host_pathlist_f"
- if test -n "$func_to_host_path_result" ; then
- if test -z "$func_to_host_pathlist_result" ; then
- func_to_host_pathlist_result="$func_to_host_path_result"
- else
- func_to_host_pathlist_result="$func_to_host_pathlist_result;$func_to_host_path_result"
- fi
- fi
- fi
- IFS=:
- done
- IFS=$func_to_host_pathlist_oldIFS
- ;;
- esac
- if test -z "$func_to_host_pathlist_result" ; then
- func_error "Could not determine the host path(s) corresponding to"
- func_error " '$1'"
- func_error "Continuing, but uninstalled executables may not work."
- # Fallback. This may break if $1 contains DOS-style drive
- # specifications. The fix is not to complicate the expression
- # below, but for the user to provide a working wine installation
- # with winepath so that path translation in the cross-to-mingw
- # case works properly.
- lt_replace_pathsep_nix_to_dos="s|:|;|g"
- func_to_host_pathlist_result=`echo "$func_to_host_pathlist_tmp1" |\
- $SED -e "$lt_replace_pathsep_nix_to_dos"`
- fi
- # Now, add the leading and trailing path separators back
- case "$1" in
- :* ) func_to_host_pathlist_result=";$func_to_host_pathlist_result"
- ;;
- esac
- case "$1" in
- *: ) func_to_host_pathlist_result="$func_to_host_pathlist_result;"
- ;;
- esac
- ;;
- esac
- fi
-}
-# end: func_to_host_pathlist
-
-# func_emit_cwrapperexe_src
-# emit the source code for a wrapper executable on stdout
-# Must ONLY be called from within func_mode_link because
-# it depends on a number of variable set therein.
-func_emit_cwrapperexe_src ()
-{
- cat <<EOF
-
-/* $cwrappersource - temporary wrapper executable for $objdir/$outputname
- Generated by $PROGRAM (GNU $PACKAGE$TIMESTAMP) $VERSION
-
- The $output program cannot be directly executed until all the libtool
- libraries that it depends on are installed.
-
- This wrapper executable should never be moved out of the build directory.
- If it is, it will not operate correctly.
-
- Currently, it simply execs the wrapper *script* "$SHELL $output",
- but could eventually absorb all of the scripts functionality and
- exec $objdir/$outputname directly.
-*/
-EOF
- cat <<"EOF"
-#include <stdio.h>
-#include <stdlib.h>
-#ifdef _MSC_VER
-# include <direct.h>
-# include <process.h>
-# include <io.h>
-# define setmode _setmode
-#else
-# include <unistd.h>
-# include <stdint.h>
-# ifdef __CYGWIN__
-# include <io.h>
-# define HAVE_SETENV
-# ifdef __STRICT_ANSI__
-char *realpath (const char *, char *);
-int putenv (char *);
-int setenv (const char *, const char *, int);
-# endif
-# endif
-#endif
-#include <malloc.h>
-#include <stdarg.h>
-#include <assert.h>
-#include <string.h>
-#include <ctype.h>
-#include <errno.h>
-#include <fcntl.h>
-#include <sys/stat.h>
-
-#if defined(PATH_MAX)
-# define LT_PATHMAX PATH_MAX
-#elif defined(MAXPATHLEN)
-# define LT_PATHMAX MAXPATHLEN
-#else
-# define LT_PATHMAX 1024
-#endif
-
-#ifndef S_IXOTH
-# define S_IXOTH 0
-#endif
-#ifndef S_IXGRP
-# define S_IXGRP 0
-#endif
-
-#ifdef _MSC_VER
-# define S_IXUSR _S_IEXEC
-# define stat _stat
-# ifndef _INTPTR_T_DEFINED
-# define intptr_t int
-# endif
-#endif
-
-#ifndef DIR_SEPARATOR
-# define DIR_SEPARATOR '/'
-# define PATH_SEPARATOR ':'
-#endif
-
-#if defined (_WIN32) || defined (__MSDOS__) || defined (__DJGPP__) || \
- defined (__OS2__)
-# define HAVE_DOS_BASED_FILE_SYSTEM
-# define FOPEN_WB "wb"
-# ifndef DIR_SEPARATOR_2
-# define DIR_SEPARATOR_2 '\\'
-# endif
-# ifndef PATH_SEPARATOR_2
-# define PATH_SEPARATOR_2 ';'
-# endif
-#endif
-
-#ifndef DIR_SEPARATOR_2
-# define IS_DIR_SEPARATOR(ch) ((ch) == DIR_SEPARATOR)
-#else /* DIR_SEPARATOR_2 */
-# define IS_DIR_SEPARATOR(ch) \
- (((ch) == DIR_SEPARATOR) || ((ch) == DIR_SEPARATOR_2))
-#endif /* DIR_SEPARATOR_2 */
-
-#ifndef PATH_SEPARATOR_2
-# define IS_PATH_SEPARATOR(ch) ((ch) == PATH_SEPARATOR)
-#else /* PATH_SEPARATOR_2 */
-# define IS_PATH_SEPARATOR(ch) ((ch) == PATH_SEPARATOR_2)
-#endif /* PATH_SEPARATOR_2 */
-
-#ifdef __CYGWIN__
-# define FOPEN_WB "wb"
-#endif
-
-#ifndef FOPEN_WB
-# define FOPEN_WB "w"
-#endif
-#ifndef _O_BINARY
-# define _O_BINARY 0
-#endif
-
-#define XMALLOC(type, num) ((type *) xmalloc ((num) * sizeof(type)))
-#define XFREE(stale) do { \
- if (stale) { free ((void *) stale); stale = 0; } \
-} while (0)
-
-#undef LTWRAPPER_DEBUGPRINTF
-#if defined DEBUGWRAPPER
-# define LTWRAPPER_DEBUGPRINTF(args) ltwrapper_debugprintf args
-static void
-ltwrapper_debugprintf (const char *fmt, ...)
-{
- va_list args;
- va_start (args, fmt);
- (void) vfprintf (stderr, fmt, args);
- va_end (args);
-}
-#else
-# define LTWRAPPER_DEBUGPRINTF(args)
-#endif
-
-const char *program_name = NULL;
-
-void *xmalloc (size_t num);
-char *xstrdup (const char *string);
-const char *base_name (const char *name);
-char *find_executable (const char *wrapper);
-char *chase_symlinks (const char *pathspec);
-int make_executable (const char *path);
-int check_executable (const char *path);
-char *strendzap (char *str, const char *pat);
-void lt_fatal (const char *message, ...);
-void lt_setenv (const char *name, const char *value);
-char *lt_extend_str (const char *orig_value, const char *add, int to_end);
-void lt_opt_process_env_set (const char *arg);
-void lt_opt_process_env_prepend (const char *arg);
-void lt_opt_process_env_append (const char *arg);
-int lt_split_name_value (const char *arg, char** name, char** value);
-void lt_update_exe_path (const char *name, const char *value);
-void lt_update_lib_path (const char *name, const char *value);
-
-static const char *script_text_part1 =
-EOF
-
- func_emit_wrapper_part1 yes |
- $SED -e 's/\([\\"]\)/\\\1/g' \
- -e 's/^/ "/' -e 's/$/\\n"/'
- echo ";"
- cat <<EOF
-
-static const char *script_text_part2 =
-EOF
- func_emit_wrapper_part2 yes |
- $SED -e 's/\([\\"]\)/\\\1/g' \
- -e 's/^/ "/' -e 's/$/\\n"/'
- echo ";"
-
- cat <<EOF
-const char * MAGIC_EXE = "$magic_exe";
-const char * LIB_PATH_VARNAME = "$shlibpath_var";
-EOF
-
- if test "$shlibpath_overrides_runpath" = yes && test -n "$shlibpath_var" && test -n "$temp_rpath"; then
- func_to_host_pathlist "$temp_rpath"
- cat <<EOF
-const char * LIB_PATH_VALUE = "$func_to_host_pathlist_result";
-EOF
- else
- cat <<"EOF"
-const char * LIB_PATH_VALUE = "";
-EOF
- fi
-
- if test -n "$dllsearchpath"; then
- func_to_host_pathlist "$dllsearchpath:"
- cat <<EOF
-const char * EXE_PATH_VARNAME = "PATH";
-const char * EXE_PATH_VALUE = "$func_to_host_pathlist_result";
-EOF
- else
- cat <<"EOF"
-const char * EXE_PATH_VARNAME = "";
-const char * EXE_PATH_VALUE = "";
-EOF
- fi
-
- if test "$fast_install" = yes; then
- cat <<EOF
-const char * TARGET_PROGRAM_NAME = "lt-$outputname"; /* hopefully, no .exe */
-EOF
- else
- cat <<EOF
-const char * TARGET_PROGRAM_NAME = "$outputname"; /* hopefully, no .exe */
-EOF
- fi
-
-
- cat <<"EOF"
-
-#define LTWRAPPER_OPTION_PREFIX "--lt-"
-#define LTWRAPPER_OPTION_PREFIX_LENGTH 5
-
-static const size_t opt_prefix_len = LTWRAPPER_OPTION_PREFIX_LENGTH;
-static const char *ltwrapper_option_prefix = LTWRAPPER_OPTION_PREFIX;
-
-static const char *dumpscript_opt = LTWRAPPER_OPTION_PREFIX "dump-script";
-
-static const size_t env_set_opt_len = LTWRAPPER_OPTION_PREFIX_LENGTH + 7;
-static const char *env_set_opt = LTWRAPPER_OPTION_PREFIX "env-set";
- /* argument is putenv-style "foo=bar", value of foo is set to bar */
-
-static const size_t env_prepend_opt_len = LTWRAPPER_OPTION_PREFIX_LENGTH + 11;
-static const char *env_prepend_opt = LTWRAPPER_OPTION_PREFIX "env-prepend";
- /* argument is putenv-style "foo=bar", new value of foo is bar${foo} */
-
-static const size_t env_append_opt_len = LTWRAPPER_OPTION_PREFIX_LENGTH + 10;
-static const char *env_append_opt = LTWRAPPER_OPTION_PREFIX "env-append";
- /* argument is putenv-style "foo=bar", new value of foo is ${foo}bar */
-
-int
-main (int argc, char *argv[])
-{
- char **newargz;
- int newargc;
- char *tmp_pathspec;
- char *actual_cwrapper_path;
- char *actual_cwrapper_name;
- char *target_name;
- char *lt_argv_zero;
- intptr_t rval = 127;
-
- int i;
-
- program_name = (char *) xstrdup (base_name (argv[0]));
- LTWRAPPER_DEBUGPRINTF (("(main) argv[0] : %s\n", argv[0]));
- LTWRAPPER_DEBUGPRINTF (("(main) program_name : %s\n", program_name));
-
- /* very simple arg parsing; don't want to rely on getopt */
- for (i = 1; i < argc; i++)
- {
- if (strcmp (argv[i], dumpscript_opt) == 0)
- {
-EOF
- case "$host" in
- *mingw* | *cygwin* )
- # make stdout use "unix" line endings
- echo " setmode(1,_O_BINARY);"
- ;;
- esac
-
- cat <<"EOF"
- printf ("%s", script_text_part1);
- printf ("%s", script_text_part2);
- return 0;
- }
- }
-
- newargz = XMALLOC (char *, argc + 1);
- tmp_pathspec = find_executable (argv[0]);
- if (tmp_pathspec == NULL)
- lt_fatal ("Couldn't find %s", argv[0]);
- LTWRAPPER_DEBUGPRINTF (("(main) found exe (before symlink chase) at : %s\n",
- tmp_pathspec));
-
- actual_cwrapper_path = chase_symlinks (tmp_pathspec);
- LTWRAPPER_DEBUGPRINTF (("(main) found exe (after symlink chase) at : %s\n",
- actual_cwrapper_path));
- XFREE (tmp_pathspec);
-
- actual_cwrapper_name = xstrdup( base_name (actual_cwrapper_path));
- strendzap (actual_cwrapper_path, actual_cwrapper_name);
-
- /* wrapper name transforms */
- strendzap (actual_cwrapper_name, ".exe");
- tmp_pathspec = lt_extend_str (actual_cwrapper_name, ".exe", 1);
- XFREE (actual_cwrapper_name);
- actual_cwrapper_name = tmp_pathspec;
- tmp_pathspec = 0;
-
- /* target_name transforms -- use actual target program name; might have lt- prefix */
- target_name = xstrdup (base_name (TARGET_PROGRAM_NAME));
- strendzap (target_name, ".exe");
- tmp_pathspec = lt_extend_str (target_name, ".exe", 1);
- XFREE (target_name);
- target_name = tmp_pathspec;
- tmp_pathspec = 0;
-
- LTWRAPPER_DEBUGPRINTF (("(main) libtool target name: %s\n",
- target_name));
-EOF
-
- cat <<EOF
- newargz[0] =
- XMALLOC (char, (strlen (actual_cwrapper_path) +
- strlen ("$objdir") + 1 + strlen (actual_cwrapper_name) + 1));
- strcpy (newargz[0], actual_cwrapper_path);
- strcat (newargz[0], "$objdir");
- strcat (newargz[0], "/");
-EOF
-
- cat <<"EOF"
- /* stop here, and copy so we don't have to do this twice */
- tmp_pathspec = xstrdup (newargz[0]);
-
- /* do NOT want the lt- prefix here, so use actual_cwrapper_name */
- strcat (newargz[0], actual_cwrapper_name);
-
- /* DO want the lt- prefix here if it exists, so use target_name */
- lt_argv_zero = lt_extend_str (tmp_pathspec, target_name, 1);
- XFREE (tmp_pathspec);
- tmp_pathspec = NULL;
-EOF
-
- case $host_os in
- mingw*)
- cat <<"EOF"
- {
- char* p;
- while ((p = strchr (newargz[0], '\\')) != NULL)
- {
- *p = '/';
- }
- while ((p = strchr (lt_argv_zero, '\\')) != NULL)
- {
- *p = '/';
- }
- }
-EOF
- ;;
- esac
-
- cat <<"EOF"
- XFREE (target_name);
- XFREE (actual_cwrapper_path);
- XFREE (actual_cwrapper_name);
-
- lt_setenv ("BIN_SH", "xpg4"); /* for Tru64 */
- lt_setenv ("DUALCASE", "1"); /* for MSK sh */
- lt_update_lib_path (LIB_PATH_VARNAME, LIB_PATH_VALUE);
- lt_update_exe_path (EXE_PATH_VARNAME, EXE_PATH_VALUE);
-
- newargc=0;
- for (i = 1; i < argc; i++)
- {
- if (strncmp (argv[i], env_set_opt, env_set_opt_len) == 0)
- {
- if (argv[i][env_set_opt_len] == '=')
- {
- const char *p = argv[i] + env_set_opt_len + 1;
- lt_opt_process_env_set (p);
- }
- else if (argv[i][env_set_opt_len] == '\0' && i + 1 < argc)
- {
- lt_opt_process_env_set (argv[++i]); /* don't copy */
- }
- else
- lt_fatal ("%s missing required argument", env_set_opt);
- continue;
- }
- if (strncmp (argv[i], env_prepend_opt, env_prepend_opt_len) == 0)
- {
- if (argv[i][env_prepend_opt_len] == '=')
- {
- const char *p = argv[i] + env_prepend_opt_len + 1;
- lt_opt_process_env_prepend (p);
- }
- else if (argv[i][env_prepend_opt_len] == '\0' && i + 1 < argc)
- {
- lt_opt_process_env_prepend (argv[++i]); /* don't copy */
- }
- else
- lt_fatal ("%s missing required argument", env_prepend_opt);
- continue;
- }
- if (strncmp (argv[i], env_append_opt, env_append_opt_len) == 0)
- {
- if (argv[i][env_append_opt_len] == '=')
- {
- const char *p = argv[i] + env_append_opt_len + 1;
- lt_opt_process_env_append (p);
- }
- else if (argv[i][env_append_opt_len] == '\0' && i + 1 < argc)
- {
- lt_opt_process_env_append (argv[++i]); /* don't copy */
- }
- else
- lt_fatal ("%s missing required argument", env_append_opt);
- continue;
- }
- if (strncmp (argv[i], ltwrapper_option_prefix, opt_prefix_len) == 0)
- {
- /* however, if there is an option in the LTWRAPPER_OPTION_PREFIX
- namespace, but it is not one of the ones we know about and
- have already dealt with, above (inluding dump-script), then
- report an error. Otherwise, targets might begin to believe
- they are allowed to use options in the LTWRAPPER_OPTION_PREFIX
- namespace. The first time any user complains about this, we'll
- need to make LTWRAPPER_OPTION_PREFIX a configure-time option
- or a configure.ac-settable value.
- */
- lt_fatal ("Unrecognized option in %s namespace: '%s'",
- ltwrapper_option_prefix, argv[i]);
- }
- /* otherwise ... */
- newargz[++newargc] = xstrdup (argv[i]);
- }
- newargz[++newargc] = NULL;
-
- LTWRAPPER_DEBUGPRINTF (("(main) lt_argv_zero : %s\n", (lt_argv_zero ? lt_argv_zero : "<NULL>")));
- for (i = 0; i < newargc; i++)
- {
- LTWRAPPER_DEBUGPRINTF (("(main) newargz[%d] : %s\n", i, (newargz[i] ? newargz[i] : "<NULL>")));
- }
-
-EOF
-
- case $host_os in
- mingw*)
- cat <<"EOF"
- /* execv doesn't actually work on mingw as expected on unix */
- rval = _spawnv (_P_WAIT, lt_argv_zero, (const char * const *) newargz);
- if (rval == -1)
- {
- /* failed to start process */
- LTWRAPPER_DEBUGPRINTF (("(main) failed to launch target \"%s\": errno = %d\n", lt_argv_zero, errno));
- return 127;
- }
- return rval;
-EOF
- ;;
- *)
- cat <<"EOF"
- execv (lt_argv_zero, newargz);
- return rval; /* =127, but avoids unused variable warning */
-EOF
- ;;
- esac
-
- cat <<"EOF"
-}
-
-void *
-xmalloc (size_t num)
-{
- void *p = (void *) malloc (num);
- if (!p)
- lt_fatal ("Memory exhausted");
-
- return p;
-}
-
-char *
-xstrdup (const char *string)
-{
- return string ? strcpy ((char *) xmalloc (strlen (string) + 1),
- string) : NULL;
-}
-
-const char *
-base_name (const char *name)
-{
- const char *base;
-
-#if defined (HAVE_DOS_BASED_FILE_SYSTEM)
- /* Skip over the disk name in MSDOS pathnames. */
- if (isalpha ((unsigned char) name[0]) && name[1] == ':')
- name += 2;
-#endif
-
- for (base = name; *name; name++)
- if (IS_DIR_SEPARATOR (*name))
- base = name + 1;
- return base;
-}
-
-int
-check_executable (const char *path)
-{
- struct stat st;
-
- LTWRAPPER_DEBUGPRINTF (("(check_executable) : %s\n",
- path ? (*path ? path : "EMPTY!") : "NULL!"));
- if ((!path) || (!*path))
- return 0;
-
- if ((stat (path, &st) >= 0)
- && (st.st_mode & (S_IXUSR | S_IXGRP | S_IXOTH)))
- return 1;
- else
- return 0;
-}
-
-int
-make_executable (const char *path)
-{
- int rval = 0;
- struct stat st;
-
- LTWRAPPER_DEBUGPRINTF (("(make_executable) : %s\n",
- path ? (*path ? path : "EMPTY!") : "NULL!"));
- if ((!path) || (!*path))
- return 0;
-
- if (stat (path, &st) >= 0)
- {
- rval = chmod (path, st.st_mode | S_IXOTH | S_IXGRP | S_IXUSR);
- }
- return rval;
-}
-
-/* Searches for the full path of the wrapper. Returns
- newly allocated full path name if found, NULL otherwise
- Does not chase symlinks, even on platforms that support them.
-*/
-char *
-find_executable (const char *wrapper)
-{
- int has_slash = 0;
- const char *p;
- const char *p_next;
- /* static buffer for getcwd */
- char tmp[LT_PATHMAX + 1];
- int tmp_len;
- char *concat_name;
-
- LTWRAPPER_DEBUGPRINTF (("(find_executable) : %s\n",
- wrapper ? (*wrapper ? wrapper : "EMPTY!") : "NULL!"));
-
- if ((wrapper == NULL) || (*wrapper == '\0'))
- return NULL;
-
- /* Absolute path? */
-#if defined (HAVE_DOS_BASED_FILE_SYSTEM)
- if (isalpha ((unsigned char) wrapper[0]) && wrapper[1] == ':')
- {
- concat_name = xstrdup (wrapper);
- if (check_executable (concat_name))
- return concat_name;
- XFREE (concat_name);
- }
- else
- {
-#endif
- if (IS_DIR_SEPARATOR (wrapper[0]))
- {
- concat_name = xstrdup (wrapper);
- if (check_executable (concat_name))
- return concat_name;
- XFREE (concat_name);
- }
-#if defined (HAVE_DOS_BASED_FILE_SYSTEM)
- }
-#endif
-
- for (p = wrapper; *p; p++)
- if (*p == '/')
- {
- has_slash = 1;
- break;
- }
- if (!has_slash)
- {
- /* no slashes; search PATH */
- const char *path = getenv ("PATH");
- if (path != NULL)
- {
- for (p = path; *p; p = p_next)
- {
- const char *q;
- size_t p_len;
- for (q = p; *q; q++)
- if (IS_PATH_SEPARATOR (*q))
- break;
- p_len = q - p;
- p_next = (*q == '\0' ? q : q + 1);
- if (p_len == 0)
- {
- /* empty path: current directory */
- if (getcwd (tmp, LT_PATHMAX) == NULL)
- lt_fatal ("getcwd failed");
- tmp_len = strlen (tmp);
- concat_name =
- XMALLOC (char, tmp_len + 1 + strlen (wrapper) + 1);
- memcpy (concat_name, tmp, tmp_len);
- concat_name[tmp_len] = '/';
- strcpy (concat_name + tmp_len + 1, wrapper);
- }
- else
- {
- concat_name =
- XMALLOC (char, p_len + 1 + strlen (wrapper) + 1);
- memcpy (concat_name, p, p_len);
- concat_name[p_len] = '/';
- strcpy (concat_name + p_len + 1, wrapper);
- }
- if (check_executable (concat_name))
- return concat_name;
- XFREE (concat_name);
- }
- }
- /* not found in PATH; assume curdir */
- }
- /* Relative path | not found in path: prepend cwd */
- if (getcwd (tmp, LT_PATHMAX) == NULL)
- lt_fatal ("getcwd failed");
- tmp_len = strlen (tmp);
- concat_name = XMALLOC (char, tmp_len + 1 + strlen (wrapper) + 1);
- memcpy (concat_name, tmp, tmp_len);
- concat_name[tmp_len] = '/';
- strcpy (concat_name + tmp_len + 1, wrapper);
-
- if (check_executable (concat_name))
- return concat_name;
- XFREE (concat_name);
- return NULL;
-}
-
-char *
-chase_symlinks (const char *pathspec)
-{
-#ifndef S_ISLNK
- return xstrdup (pathspec);
-#else
- char buf[LT_PATHMAX];
- struct stat s;
- char *tmp_pathspec = xstrdup (pathspec);
- char *p;
- int has_symlinks = 0;
- while (strlen (tmp_pathspec) && !has_symlinks)
- {
- LTWRAPPER_DEBUGPRINTF (("checking path component for symlinks: %s\n",
- tmp_pathspec));
- if (lstat (tmp_pathspec, &s) == 0)
- {
- if (S_ISLNK (s.st_mode) != 0)
- {
- has_symlinks = 1;
- break;
- }
-
- /* search backwards for last DIR_SEPARATOR */
- p = tmp_pathspec + strlen (tmp_pathspec) - 1;
- while ((p > tmp_pathspec) && (!IS_DIR_SEPARATOR (*p)))
- p--;
- if ((p == tmp_pathspec) && (!IS_DIR_SEPARATOR (*p)))
- {
- /* no more DIR_SEPARATORS left */
- break;
- }
- *p = '\0';
- }
- else
- {
- char *errstr = strerror (errno);
- lt_fatal ("Error accessing file %s (%s)", tmp_pathspec, errstr);
- }
- }
- XFREE (tmp_pathspec);
-
- if (!has_symlinks)
- {
- return xstrdup (pathspec);
- }
-
- tmp_pathspec = realpath (pathspec, buf);
- if (tmp_pathspec == 0)
- {
- lt_fatal ("Could not follow symlinks for %s", pathspec);
- }
- return xstrdup (tmp_pathspec);
-#endif
-}
-
-char *
-strendzap (char *str, const char *pat)
-{
- size_t len, patlen;
-
- assert (str != NULL);
- assert (pat != NULL);
-
- len = strlen (str);
- patlen = strlen (pat);
-
- if (patlen <= len)
- {
- str += len - patlen;
- if (strcmp (str, pat) == 0)
- *str = '\0';
- }
- return str;
-}
-
-static void
-lt_error_core (int exit_status, const char *mode,
- const char *message, va_list ap)
-{
- fprintf (stderr, "%s: %s: ", program_name, mode);
- vfprintf (stderr, message, ap);
- fprintf (stderr, ".\n");
-
- if (exit_status >= 0)
- exit (exit_status);
-}
-
-void
-lt_fatal (const char *message, ...)
-{
- va_list ap;
- va_start (ap, message);
- lt_error_core (EXIT_FAILURE, "FATAL", message, ap);
- va_end (ap);
-}
-
-void
-lt_setenv (const char *name, const char *value)
-{
- LTWRAPPER_DEBUGPRINTF (("(lt_setenv) setting '%s' to '%s'\n",
- (name ? name : "<NULL>"),
- (value ? value : "<NULL>")));
- {
-#ifdef HAVE_SETENV
- /* always make a copy, for consistency with !HAVE_SETENV */
- char *str = xstrdup (value);
- setenv (name, str, 1);
-#else
- int len = strlen (name) + 1 + strlen (value) + 1;
- char *str = XMALLOC (char, len);
- sprintf (str, "%s=%s", name, value);
- if (putenv (str) != EXIT_SUCCESS)
- {
- XFREE (str);
- }
-#endif
- }
-}
-
-char *
-lt_extend_str (const char *orig_value, const char *add, int to_end)
-{
- char *new_value;
- if (orig_value && *orig_value)
- {
- int orig_value_len = strlen (orig_value);
- int add_len = strlen (add);
- new_value = XMALLOC (char, add_len + orig_value_len + 1);
- if (to_end)
- {
- strcpy (new_value, orig_value);
- strcpy (new_value + orig_value_len, add);
- }
- else
- {
- strcpy (new_value, add);
- strcpy (new_value + add_len, orig_value);
- }
- }
- else
- {
- new_value = xstrdup (add);
- }
- return new_value;
-}
-
-int
-lt_split_name_value (const char *arg, char** name, char** value)
-{
- const char *p;
- int len;
- if (!arg || !*arg)
- return 1;
-
- p = strchr (arg, (int)'=');
-
- if (!p)
- return 1;
-
- *value = xstrdup (++p);
-
- len = strlen (arg) - strlen (*value);
- *name = XMALLOC (char, len);
- strncpy (*name, arg, len-1);
- (*name)[len - 1] = '\0';
-
- return 0;
-}
-
-void
-lt_opt_process_env_set (const char *arg)
-{
- char *name = NULL;
- char *value = NULL;
-
- if (lt_split_name_value (arg, &name, &value) != 0)
- {
- XFREE (name);
- XFREE (value);
- lt_fatal ("bad argument for %s: '%s'", env_set_opt, arg);
- }
-
- lt_setenv (name, value);
- XFREE (name);
- XFREE (value);
-}
-
-void
-lt_opt_process_env_prepend (const char *arg)
-{
- char *name = NULL;
- char *value = NULL;
- char *new_value = NULL;
-
- if (lt_split_name_value (arg, &name, &value) != 0)
- {
- XFREE (name);
- XFREE (value);
- lt_fatal ("bad argument for %s: '%s'", env_prepend_opt, arg);
- }
-
- new_value = lt_extend_str (getenv (name), value, 0);
- lt_setenv (name, new_value);
- XFREE (new_value);
- XFREE (name);
- XFREE (value);
-}
-
-void
-lt_opt_process_env_append (const char *arg)
-{
- char *name = NULL;
- char *value = NULL;
- char *new_value = NULL;
-
- if (lt_split_name_value (arg, &name, &value) != 0)
- {
- XFREE (name);
- XFREE (value);
- lt_fatal ("bad argument for %s: '%s'", env_append_opt, arg);
- }
-
- new_value = lt_extend_str (getenv (name), value, 1);
- lt_setenv (name, new_value);
- XFREE (new_value);
- XFREE (name);
- XFREE (value);
-}
-
-void
-lt_update_exe_path (const char *name, const char *value)
-{
- LTWRAPPER_DEBUGPRINTF (("(lt_update_exe_path) modifying '%s' by prepending '%s'\n",
- (name ? name : "<NULL>"),
- (value ? value : "<NULL>")));
-
- if (name && *name && value && *value)
- {
- char *new_value = lt_extend_str (getenv (name), value, 0);
- /* some systems can't cope with a ':'-terminated path #' */
- int len = strlen (new_value);
- while (((len = strlen (new_value)) > 0) && IS_PATH_SEPARATOR (new_value[len-1]))
- {
- new_value[len-1] = '\0';
- }
- lt_setenv (name, new_value);
- XFREE (new_value);
- }
-}
-
-void
-lt_update_lib_path (const char *name, const char *value)
-{
- LTWRAPPER_DEBUGPRINTF (("(lt_update_lib_path) modifying '%s' by prepending '%s'\n",
- (name ? name : "<NULL>"),
- (value ? value : "<NULL>")));
-
- if (name && *name && value && *value)
- {
- char *new_value = lt_extend_str (getenv (name), value, 0);
- lt_setenv (name, new_value);
- XFREE (new_value);
- }
-}
-
-
-EOF
-}
-# end: func_emit_cwrapperexe_src
-
-# func_mode_link arg...
-func_mode_link ()
-{
- $opt_debug
- case $host in
- *-*-cygwin* | *-*-mingw* | *-*-pw32* | *-*-os2* | *-cegcc*)
- # It is impossible to link a dll without this setting, and
- # we shouldn't force the makefile maintainer to figure out
- # which system we are compiling for in order to pass an extra
- # flag for every libtool invocation.
- # allow_undefined=no
-
- # FIXME: Unfortunately, there are problems with the above when trying
- # to make a dll which has undefined symbols, in which case not
- # even a static library is built. For now, we need to specify
- # -no-undefined on the libtool link line when we can be certain
- # that all symbols are satisfied, otherwise we get a static library.
- allow_undefined=yes
- ;;
- *)
- allow_undefined=yes
- ;;
- esac
- libtool_args=$nonopt
- base_compile="$nonopt $@"
- compile_command=$nonopt
- finalize_command=$nonopt
-
- compile_rpath=
- finalize_rpath=
- compile_shlibpath=
- finalize_shlibpath=
- convenience=
- old_convenience=
- deplibs=
- old_deplibs=
- compiler_flags=
- linker_flags=
- dllsearchpath=
- lib_search_path=`pwd`
- inst_prefix_dir=
- new_inherited_linker_flags=
-
- avoid_version=no
- dlfiles=
- dlprefiles=
- dlself=no
- export_dynamic=no
- export_symbols=
- export_symbols_regex=
- generated=
- libobjs=
- ltlibs=
- module=no
- no_install=no
- objs=
- non_pic_objects=
- precious_files_regex=
- prefer_static_libs=no
- preload=no
- prev=
- prevarg=
- release=
- rpath=
- xrpath=
- perm_rpath=
- temp_rpath=
- thread_safe=no
- vinfo=
- vinfo_number=no
- weak_libs=
- single_module="${wl}-single_module"
- func_infer_tag $base_compile
-
- # We need to know -static, to get the right output filenames.
- for arg
- do
- case $arg in
- -shared)
- test "$build_libtool_libs" != yes && \
- func_fatal_configuration "can not build a shared library"
- build_old_libs=no
- break
- ;;
- -all-static | -static | -static-libtool-libs)
- case $arg in
- -all-static)
- if test "$build_libtool_libs" = yes && test -z "$link_static_flag"; then
- func_warning "complete static linking is impossible in this configuration"
- fi
- if test -n "$link_static_flag"; then
- dlopen_self=$dlopen_self_static
- fi
- prefer_static_libs=yes
- ;;
- -static)
- if test -z "$pic_flag" && test -n "$link_static_flag"; then
- dlopen_self=$dlopen_self_static
- fi
- prefer_static_libs=built
- ;;
- -static-libtool-libs)
- if test -z "$pic_flag" && test -n "$link_static_flag"; then
- dlopen_self=$dlopen_self_static
- fi
- prefer_static_libs=yes
- ;;
- esac
- build_libtool_libs=no
- build_old_libs=yes
- break
- ;;
- esac
- done
-
- # See if our shared archives depend on static archives.
- test -n "$old_archive_from_new_cmds" && build_old_libs=yes
-
- # Go through the arguments, transforming them on the way.
- while test "$#" -gt 0; do
- arg="$1"
- shift
- func_quote_for_eval "$arg"
- qarg=$func_quote_for_eval_unquoted_result
- func_append libtool_args " $func_quote_for_eval_result"
-
- # If the previous option needs an argument, assign it.
- if test -n "$prev"; then
- case $prev in
- output)
- func_append compile_command " @OUTPUT@"
- func_append finalize_command " @OUTPUT@"
- ;;
- esac
-
- case $prev in
- dlfiles|dlprefiles)
- if test "$preload" = no; then
- # Add the symbol object into the linking commands.
- func_append compile_command " @SYMFILE@"
- func_append finalize_command " @SYMFILE@"
- preload=yes
- fi
- case $arg in
- *.la | *.lo) ;; # We handle these cases below.
- force)
- if test "$dlself" = no; then
- dlself=needless
- export_dynamic=yes
- fi
- prev=
- continue
- ;;
- self)
- if test "$prev" = dlprefiles; then
- dlself=yes
- elif test "$prev" = dlfiles && test "$dlopen_self" != yes; then
- dlself=yes
- else
- dlself=needless
- export_dynamic=yes
- fi
- prev=
- continue
- ;;
- *)
- if test "$prev" = dlfiles; then
- dlfiles="$dlfiles $arg"
- else
- dlprefiles="$dlprefiles $arg"
- fi
- prev=
- continue
- ;;
- esac
- ;;
- expsyms)
- export_symbols="$arg"
- test -f "$arg" \
- || func_fatal_error "symbol file \`$arg' does not exist"
- prev=
- continue
- ;;
- expsyms_regex)
- export_symbols_regex="$arg"
- prev=
- continue
- ;;
- framework)
- case $host in
- *-*-darwin*)
- case "$deplibs " in
- *" $qarg.ltframework "*) ;;
- *) deplibs="$deplibs $qarg.ltframework" # this is fixed later
- ;;
- esac
- ;;
- esac
- prev=
- continue
- ;;
- inst_prefix)
- inst_prefix_dir="$arg"
- prev=
- continue
- ;;
- objectlist)
- if test -f "$arg"; then
- save_arg=$arg
- moreargs=
- for fil in `cat "$save_arg"`
- do
-# moreargs="$moreargs $fil"
- arg=$fil
- # A libtool-controlled object.
-
- # Check to see that this really is a libtool object.
- if func_lalib_unsafe_p "$arg"; then
- pic_object=
- non_pic_object=
-
- # Read the .lo file
- func_source "$arg"
-
- if test -z "$pic_object" ||
- test -z "$non_pic_object" ||
- test "$pic_object" = none &&
- test "$non_pic_object" = none; then
- func_fatal_error "cannot find name of object for \`$arg'"
- fi
-
- # Extract subdirectory from the argument.
- func_dirname "$arg" "/" ""
- xdir="$func_dirname_result"
-
- if test "$pic_object" != none; then
- # Prepend the subdirectory the object is found in.
- pic_object="$xdir$pic_object"
-
- if test "$prev" = dlfiles; then
- if test "$build_libtool_libs" = yes && test "$dlopen_support" = yes; then
- dlfiles="$dlfiles $pic_object"
- prev=
- continue
- else
- # If libtool objects are unsupported, then we need to preload.
- prev=dlprefiles
- fi
- fi
-
- # CHECK ME: I think I busted this. -Ossama
- if test "$prev" = dlprefiles; then
- # Preload the old-style object.
- dlprefiles="$dlprefiles $pic_object"
- prev=
- fi
-
- # A PIC object.
- func_append libobjs " $pic_object"
- arg="$pic_object"
- fi
-
- # Non-PIC object.
- if test "$non_pic_object" != none; then
- # Prepend the subdirectory the object is found in.
- non_pic_object="$xdir$non_pic_object"
-
- # A standard non-PIC object
- func_append non_pic_objects " $non_pic_object"
- if test -z "$pic_object" || test "$pic_object" = none ; then
- arg="$non_pic_object"
- fi
- else
- # If the PIC object exists, use it instead.
- # $xdir was prepended to $pic_object above.
- non_pic_object="$pic_object"
- func_append non_pic_objects " $non_pic_object"
- fi
- else
- # Only an error if not doing a dry-run.
- if $opt_dry_run; then
- # Extract subdirectory from the argument.
- func_dirname "$arg" "/" ""
- xdir="$func_dirname_result"
-
- func_lo2o "$arg"
- pic_object=$xdir$objdir/$func_lo2o_result
- non_pic_object=$xdir$func_lo2o_result
- func_append libobjs " $pic_object"
- func_append non_pic_objects " $non_pic_object"
- else
- func_fatal_error "\`$arg' is not a valid libtool object"
- fi
- fi
- done
- else
- func_fatal_error "link input file \`$arg' does not exist"
- fi
- arg=$save_arg
- prev=
- continue
- ;;
- precious_regex)
- precious_files_regex="$arg"
- prev=
- continue
- ;;
- release)
- release="-$arg"
- prev=
- continue
- ;;
- rpath | xrpath)
- # We need an absolute path.
- case $arg in
- [\\/]* | [A-Za-z]:[\\/]*) ;;
- *)
- func_fatal_error "only absolute run-paths are allowed"
- ;;
- esac
- if test "$prev" = rpath; then
- case "$rpath " in
- *" $arg "*) ;;
- *) rpath="$rpath $arg" ;;
- esac
- else
- case "$xrpath " in
- *" $arg "*) ;;
- *) xrpath="$xrpath $arg" ;;
- esac
- fi
- prev=
- continue
- ;;
- shrext)
- shrext_cmds="$arg"
- prev=
- continue
- ;;
- weak)
- weak_libs="$weak_libs $arg"
- prev=
- continue
- ;;
- xcclinker)
- linker_flags="$linker_flags $qarg"
- compiler_flags="$compiler_flags $qarg"
- prev=
- func_append compile_command " $qarg"
- func_append finalize_command " $qarg"
- continue
- ;;
- xcompiler)
- compiler_flags="$compiler_flags $qarg"
- prev=
- func_append compile_command " $qarg"
- func_append finalize_command " $qarg"
- continue
- ;;
- xlinker)
- linker_flags="$linker_flags $qarg"
- compiler_flags="$compiler_flags $wl$qarg"
- prev=
- func_append compile_command " $wl$qarg"
- func_append finalize_command " $wl$qarg"
- continue
- ;;
- *)
- eval "$prev=\"\$arg\""
- prev=
- continue
- ;;
- esac
- fi # test -n "$prev"
-
- prevarg="$arg"
-
- case $arg in
- -all-static)
- if test -n "$link_static_flag"; then
- # See comment for -static flag below, for more details.
- func_append compile_command " $link_static_flag"
- func_append finalize_command " $link_static_flag"
- fi
- continue
- ;;
-
- -allow-undefined)
- # FIXME: remove this flag sometime in the future.
- func_fatal_error "\`-allow-undefined' must not be used because it is the default"
- ;;
-
- -avoid-version)
- avoid_version=yes
- continue
- ;;
-
- -dlopen)
- prev=dlfiles
- continue
- ;;
-
- -dlpreopen)
- prev=dlprefiles
- continue
- ;;
-
- -export-dynamic)
- export_dynamic=yes
- continue
- ;;
-
- -export-symbols | -export-symbols-regex)
- if test -n "$export_symbols" || test -n "$export_symbols_regex"; then
- func_fatal_error "more than one -exported-symbols argument is not allowed"
- fi
- if test "X$arg" = "X-export-symbols"; then
- prev=expsyms
- else
- prev=expsyms_regex
- fi
- continue
- ;;
-
- -framework)
- prev=framework
- continue
- ;;
-
- -inst-prefix-dir)
- prev=inst_prefix
- continue
- ;;
-
- # The native IRIX linker understands -LANG:*, -LIST:* and -LNO:*
- # so, if we see these flags be careful not to treat them like -L
- -L[A-Z][A-Z]*:*)
- case $with_gcc/$host in
- no/*-*-irix* | /*-*-irix*)
- func_append compile_command " $arg"
- func_append finalize_command " $arg"
- ;;
- esac
- continue
- ;;
-
- -L*)
- func_stripname '-L' '' "$arg"
- dir=$func_stripname_result
- if test -z "$dir"; then
- if test "$#" -gt 0; then
- func_fatal_error "require no space between \`-L' and \`$1'"
- else
- func_fatal_error "need path for \`-L' option"
- fi
- fi
- # We need an absolute path.
- case $dir in
- [\\/]* | [A-Za-z]:[\\/]*) ;;
- *)
- absdir=`cd "$dir" && pwd`
- test -z "$absdir" && \
- func_fatal_error "cannot determine absolute directory name of \`$dir'"
- dir="$absdir"
- ;;
- esac
- case "$deplibs " in
- *" -L$dir "*) ;;
- *)
- deplibs="$deplibs -L$dir"
- lib_search_path="$lib_search_path $dir"
- ;;
- esac
- case $host in
- *-*-cygwin* | *-*-mingw* | *-*-pw32* | *-*-os2* | *-cegcc*)
- testbindir=`$ECHO "X$dir" | $Xsed -e 's*/lib$*/bin*'`
- case :$dllsearchpath: in
- *":$dir:"*) ;;
- ::) dllsearchpath=$dir;;
- *) dllsearchpath="$dllsearchpath:$dir";;
- esac
- case :$dllsearchpath: in
- *":$testbindir:"*) ;;
- ::) dllsearchpath=$testbindir;;
- *) dllsearchpath="$dllsearchpath:$testbindir";;
- esac
- ;;
- esac
- continue
- ;;
-
- -l*)
- if test "X$arg" = "X-lc" || test "X$arg" = "X-lm"; then
- case $host in
- *-*-cygwin* | *-*-mingw* | *-*-pw32* | *-*-beos* | *-cegcc*)
- # These systems don't actually have a C or math library (as such)
- continue
- ;;
- *-*-os2*)
- # These systems don't actually have a C library (as such)
- test "X$arg" = "X-lc" && continue
- ;;
- *-*-openbsd* | *-*-freebsd* | *-*-dragonfly*)
- # Do not include libc due to us having libc/libc_r.
- test "X$arg" = "X-lc" && continue
- ;;
- *-*-rhapsody* | *-*-darwin1.[012])
- # Rhapsody C and math libraries are in the System framework
- deplibs="$deplibs System.ltframework"
- continue
- ;;
- *-*-sco3.2v5* | *-*-sco5v6*)
- # Causes problems with __ctype
- test "X$arg" = "X-lc" && continue
- ;;
- *-*-sysv4.2uw2* | *-*-sysv5* | *-*-unixware* | *-*-OpenUNIX*)
- # Compiler inserts libc in the correct place for threads to work
- test "X$arg" = "X-lc" && continue
- ;;
- esac
- elif test "X$arg" = "X-lc_r"; then
- case $host in
- *-*-openbsd* | *-*-freebsd* | *-*-dragonfly*)
- # Do not include libc_r directly, use -pthread flag.
- continue
- ;;
- esac
- fi
- deplibs="$deplibs $arg"
- continue
- ;;
-
- -module)
- module=yes
- continue
- ;;
-
- # Tru64 UNIX uses -model [arg] to determine the layout of C++
- # classes, name mangling, and exception handling.
- # Darwin uses the -arch flag to determine output architecture.
- -model|-arch|-isysroot)
- compiler_flags="$compiler_flags $arg"
- func_append compile_command " $arg"
- func_append finalize_command " $arg"
- prev=xcompiler
- continue
- ;;
-
- -mt|-mthreads|-kthread|-Kthread|-pthread|-pthreads|--thread-safe|-threads)
- compiler_flags="$compiler_flags $arg"
- func_append compile_command " $arg"
- func_append finalize_command " $arg"
- case "$new_inherited_linker_flags " in
- *" $arg "*) ;;
- * ) new_inherited_linker_flags="$new_inherited_linker_flags $arg" ;;
- esac
- continue
- ;;
-
- -multi_module)
- single_module="${wl}-multi_module"
- continue
- ;;
-
- -no-fast-install)
- fast_install=no
- continue
- ;;
-
- -no-install)
- case $host in
- *-*-cygwin* | *-*-mingw* | *-*-pw32* | *-*-os2* | *-*-darwin* | *-cegcc*)
- # The PATH hackery in wrapper scripts is required on Windows
- # and Darwin in order for the loader to find any dlls it needs.
- func_warning "\`-no-install' is ignored for $host"
- func_warning "assuming \`-no-fast-install' instead"
- fast_install=no
- ;;
- *) no_install=yes ;;
- esac
- continue
- ;;
-
- -no-undefined)
- allow_undefined=no
- continue
- ;;
-
- -objectlist)
- prev=objectlist
- continue
- ;;
-
- -o) prev=output ;;
-
- -precious-files-regex)
- prev=precious_regex
- continue
- ;;
-
- -release)
- prev=release
- continue
- ;;
-
- -rpath)
- prev=rpath
- continue
- ;;
-
- -R)
- prev=xrpath
- continue
- ;;
-
- -R*)
- func_stripname '-R' '' "$arg"
- dir=$func_stripname_result
- # We need an absolute path.
- case $dir in
- [\\/]* | [A-Za-z]:[\\/]*) ;;
- *)
- func_fatal_error "only absolute run-paths are allowed"
- ;;
- esac
- case "$xrpath " in
- *" $dir "*) ;;
- *) xrpath="$xrpath $dir" ;;
- esac
- continue
- ;;
-
- -shared)
- # The effects of -shared are defined in a previous loop.
- continue
- ;;
-
- -shrext)
- prev=shrext
- continue
- ;;
-
- -static | -static-libtool-libs)
- # The effects of -static are defined in a previous loop.
- # We used to do the same as -all-static on platforms that
- # didn't have a PIC flag, but the assumption that the effects
- # would be equivalent was wrong. It would break on at least
- # Digital Unix and AIX.
- continue
- ;;
-
- -thread-safe)
- thread_safe=yes
- continue
- ;;
-
- -version-info)
- prev=vinfo
- continue
- ;;
-
- -version-number)
- prev=vinfo
- vinfo_number=yes
- continue
- ;;
-
- -weak)
- prev=weak
- continue
- ;;
-
- -Wc,*)
- func_stripname '-Wc,' '' "$arg"
- args=$func_stripname_result
- arg=
- save_ifs="$IFS"; IFS=','
- for flag in $args; do
- IFS="$save_ifs"
- func_quote_for_eval "$flag"
- arg="$arg $wl$func_quote_for_eval_result"
- compiler_flags="$compiler_flags $func_quote_for_eval_result"
- done
- IFS="$save_ifs"
- func_stripname ' ' '' "$arg"
- arg=$func_stripname_result
- ;;
-
- -Wl,*)
- func_stripname '-Wl,' '' "$arg"
- args=$func_stripname_result
- arg=
- save_ifs="$IFS"; IFS=','
- for flag in $args; do
- IFS="$save_ifs"
- func_quote_for_eval "$flag"
- arg="$arg $wl$func_quote_for_eval_result"
- compiler_flags="$compiler_flags $wl$func_quote_for_eval_result"
- linker_flags="$linker_flags $func_quote_for_eval_result"
- done
- IFS="$save_ifs"
- func_stripname ' ' '' "$arg"
- arg=$func_stripname_result
- ;;
-
- -Xcompiler)
- prev=xcompiler
- continue
- ;;
-
- -Xlinker)
- prev=xlinker
- continue
- ;;
-
- -XCClinker)
- prev=xcclinker
- continue
- ;;
-
- # -msg_* for osf cc
- -msg_*)
- func_quote_for_eval "$arg"
- arg="$func_quote_for_eval_result"
- ;;
-
- # -64, -mips[0-9] enable 64-bit mode on the SGI compiler
- # -r[0-9][0-9]* specifies the processor on the SGI compiler
- # -xarch=*, -xtarget=* enable 64-bit mode on the Sun compiler
- # +DA*, +DD* enable 64-bit mode on the HP compiler
- # -q* pass through compiler args for the IBM compiler
- # -m*, -t[45]*, -txscale* pass through architecture-specific
- # compiler args for GCC
- # -F/path gives path to uninstalled frameworks, gcc on darwin
- # -p, -pg, --coverage, -fprofile-* pass through profiling flag for GCC
- # @file GCC response files
- -64|-mips[0-9]|-r[0-9][0-9]*|-xarch=*|-xtarget=*|+DA*|+DD*|-q*|-m*| \
- -t[45]*|-txscale*|-p|-pg|--coverage|-fprofile-*|-F*|@*)
- func_quote_for_eval "$arg"
- arg="$func_quote_for_eval_result"
- func_append compile_command " $arg"
- func_append finalize_command " $arg"
- compiler_flags="$compiler_flags $arg"
- continue
- ;;
-
- # Some other compiler flag.
- -* | +*)
- func_quote_for_eval "$arg"
- arg="$func_quote_for_eval_result"
- ;;
-
- *.$objext)
- # A standard object.
- objs="$objs $arg"
- ;;
-
- *.lo)
- # A libtool-controlled object.
-
- # Check to see that this really is a libtool object.
- if func_lalib_unsafe_p "$arg"; then
- pic_object=
- non_pic_object=
-
- # Read the .lo file
- func_source "$arg"
-
- if test -z "$pic_object" ||
- test -z "$non_pic_object" ||
- test "$pic_object" = none &&
- test "$non_pic_object" = none; then
- func_fatal_error "cannot find name of object for \`$arg'"
- fi
-
- # Extract subdirectory from the argument.
- func_dirname "$arg" "/" ""
- xdir="$func_dirname_result"
-
- if test "$pic_object" != none; then
- # Prepend the subdirectory the object is found in.
- pic_object="$xdir$pic_object"
-
- if test "$prev" = dlfiles; then
- if test "$build_libtool_libs" = yes && test "$dlopen_support" = yes; then
- dlfiles="$dlfiles $pic_object"
- prev=
- continue
- else
- # If libtool objects are unsupported, then we need to preload.
- prev=dlprefiles
- fi
- fi
-
- # CHECK ME: I think I busted this. -Ossama
- if test "$prev" = dlprefiles; then
- # Preload the old-style object.
- dlprefiles="$dlprefiles $pic_object"
- prev=
- fi
-
- # A PIC object.
- func_append libobjs " $pic_object"
- arg="$pic_object"
- fi
-
- # Non-PIC object.
- if test "$non_pic_object" != none; then
- # Prepend the subdirectory the object is found in.
- non_pic_object="$xdir$non_pic_object"
-
- # A standard non-PIC object
- func_append non_pic_objects " $non_pic_object"
- if test -z "$pic_object" || test "$pic_object" = none ; then
- arg="$non_pic_object"
- fi
- else
- # If the PIC object exists, use it instead.
- # $xdir was prepended to $pic_object above.
- non_pic_object="$pic_object"
- func_append non_pic_objects " $non_pic_object"
- fi
- else
- # Only an error if not doing a dry-run.
- if $opt_dry_run; then
- # Extract subdirectory from the argument.
- func_dirname "$arg" "/" ""
- xdir="$func_dirname_result"
-
- func_lo2o "$arg"
- pic_object=$xdir$objdir/$func_lo2o_result
- non_pic_object=$xdir$func_lo2o_result
- func_append libobjs " $pic_object"
- func_append non_pic_objects " $non_pic_object"
- else
- func_fatal_error "\`$arg' is not a valid libtool object"
- fi
- fi
- ;;
-
- *.$libext)
- # An archive.
- deplibs="$deplibs $arg"
- old_deplibs="$old_deplibs $arg"
- continue
- ;;
-
- *.la)
- # A libtool-controlled library.
-
- if test "$prev" = dlfiles; then
- # This library was specified with -dlopen.
- dlfiles="$dlfiles $arg"
- prev=
- elif test "$prev" = dlprefiles; then
- # The library was specified with -dlpreopen.
- dlprefiles="$dlprefiles $arg"
- prev=
- else
- deplibs="$deplibs $arg"
- fi
- continue
- ;;
-
- # Some other compiler argument.
- *)
- # Unknown arguments in both finalize_command and compile_command need
- # to be aesthetically quoted because they are evaled later.
- func_quote_for_eval "$arg"
- arg="$func_quote_for_eval_result"
- ;;
- esac # arg
-
- # Now actually substitute the argument into the commands.
- if test -n "$arg"; then
- func_append compile_command " $arg"
- func_append finalize_command " $arg"
- fi
- done # argument parsing loop
-
- test -n "$prev" && \
- func_fatal_help "the \`$prevarg' option requires an argument"
-
- if test "$export_dynamic" = yes && test -n "$export_dynamic_flag_spec"; then
- eval arg=\"$export_dynamic_flag_spec\"
- func_append compile_command " $arg"
- func_append finalize_command " $arg"
- fi
-
- oldlibs=
- # calculate the name of the file, without its directory
- func_basename "$output"
- outputname="$func_basename_result"
- libobjs_save="$libobjs"
-
- if test -n "$shlibpath_var"; then
- # get the directories listed in $shlibpath_var
- eval shlib_search_path=\`\$ECHO \"X\${$shlibpath_var}\" \| \$Xsed -e \'s/:/ /g\'\`
- else
- shlib_search_path=
- fi
- eval sys_lib_search_path=\"$sys_lib_search_path_spec\"
- eval sys_lib_dlsearch_path=\"$sys_lib_dlsearch_path_spec\"
-
- func_dirname "$output" "/" ""
- output_objdir="$func_dirname_result$objdir"
- # Create the object directory.
- func_mkdir_p "$output_objdir"
-
- # Determine the type of output
- case $output in
- "")
- func_fatal_help "you must specify an output file"
- ;;
- *.$libext) linkmode=oldlib ;;
- *.lo | *.$objext) linkmode=obj ;;
- *.la) linkmode=lib ;;
- *) linkmode=prog ;; # Anything else should be a program.
- esac
-
- specialdeplibs=
-
- libs=
- # Find all interdependent deplibs by searching for libraries
- # that are linked more than once (e.g. -la -lb -la)
- for deplib in $deplibs; do
- if $opt_duplicate_deps ; then
- case "$libs " in
- *" $deplib "*) specialdeplibs="$specialdeplibs $deplib" ;;
- esac
- fi
- libs="$libs $deplib"
- done
-
- if test "$linkmode" = lib; then
- libs="$predeps $libs $compiler_lib_search_path $postdeps"
-
- # Compute libraries that are listed more than once in $predeps
- # $postdeps and mark them as special (i.e., whose duplicates are
- # not to be eliminated).
- pre_post_deps=
- if $opt_duplicate_compiler_generated_deps; then
- for pre_post_dep in $predeps $postdeps; do
- case "$pre_post_deps " in
- *" $pre_post_dep "*) specialdeplibs="$specialdeplibs $pre_post_deps" ;;
- esac
- pre_post_deps="$pre_post_deps $pre_post_dep"
- done
- fi
- pre_post_deps=
- fi
-
- deplibs=
- newdependency_libs=
- newlib_search_path=
- need_relink=no # whether we're linking any uninstalled libtool libraries
- notinst_deplibs= # not-installed libtool libraries
- notinst_path= # paths that contain not-installed libtool libraries
-
- case $linkmode in
- lib)
- passes="conv dlpreopen link"
- for file in $dlfiles $dlprefiles; do
- case $file in
- *.la) ;;
- *)
- func_fatal_help "libraries can \`-dlopen' only libtool libraries: $file"
- ;;
- esac
- done
- ;;
- prog)
- compile_deplibs=
- finalize_deplibs=
- alldeplibs=no
- newdlfiles=
- newdlprefiles=
- passes="conv scan dlopen dlpreopen link"
- ;;
- *) passes="conv"
- ;;
- esac
-
- for pass in $passes; do
- # The preopen pass in lib mode reverses $deplibs; put it back here
- # so that -L comes before libs that need it for instance...
- if test "$linkmode,$pass" = "lib,link"; then
- ## FIXME: Find the place where the list is rebuilt in the wrong
- ## order, and fix it there properly
- tmp_deplibs=
- for deplib in $deplibs; do
- tmp_deplibs="$deplib $tmp_deplibs"
- done
- deplibs="$tmp_deplibs"
- fi
-
- if test "$linkmode,$pass" = "lib,link" ||
- test "$linkmode,$pass" = "prog,scan"; then
- libs="$deplibs"
- deplibs=
- fi
- if test "$linkmode" = prog; then
- case $pass in
- dlopen) libs="$dlfiles" ;;
- dlpreopen) libs="$dlprefiles" ;;
- link) libs="$deplibs %DEPLIBS% $dependency_libs" ;;
- esac
- fi
- if test "$linkmode,$pass" = "lib,dlpreopen"; then
- # Collect and forward deplibs of preopened libtool libs
- for lib in $dlprefiles; do
- # Ignore non-libtool-libs
- dependency_libs=
- case $lib in
- *.la) func_source "$lib" ;;
- esac
-
- # Collect preopened libtool deplibs, except any this library
- # has declared as weak libs
- for deplib in $dependency_libs; do
- deplib_base=`$ECHO "X$deplib" | $Xsed -e "$basename"`
- case " $weak_libs " in
- *" $deplib_base "*) ;;
- *) deplibs="$deplibs $deplib" ;;
- esac
- done
- done
- libs="$dlprefiles"
- fi
- if test "$pass" = dlopen; then
- # Collect dlpreopened libraries
- save_deplibs="$deplibs"
- deplibs=
- fi
-
- for deplib in $libs; do
- lib=
- found=no
- case $deplib in
- -mt|-mthreads|-kthread|-Kthread|-pthread|-pthreads|--thread-safe|-threads)
- if test "$linkmode,$pass" = "prog,link"; then
- compile_deplibs="$deplib $compile_deplibs"
- finalize_deplibs="$deplib $finalize_deplibs"
- else
- compiler_flags="$compiler_flags $deplib"
- if test "$linkmode" = lib ; then
- case "$new_inherited_linker_flags " in
- *" $deplib "*) ;;
- * ) new_inherited_linker_flags="$new_inherited_linker_flags $deplib" ;;
- esac
- fi
- fi
- continue
- ;;
- -l*)
- if test "$linkmode" != lib && test "$linkmode" != prog; then
- func_warning "\`-l' is ignored for archives/objects"
- continue
- fi
- func_stripname '-l' '' "$deplib"
- name=$func_stripname_result
- if test "$linkmode" = lib; then
- searchdirs="$newlib_search_path $lib_search_path $compiler_lib_search_dirs $sys_lib_search_path $shlib_search_path"
- else
- searchdirs="$newlib_search_path $lib_search_path $sys_lib_search_path $shlib_search_path"
- fi
- for searchdir in $searchdirs; do
- for search_ext in .la $std_shrext .so .a; do
- # Search the libtool library
- lib="$searchdir/lib${name}${search_ext}"
- if test -f "$lib"; then
- if test "$search_ext" = ".la"; then
- found=yes
- else
- found=no
- fi
- break 2
- fi
- done
- done
- if test "$found" != yes; then
- # deplib doesn't seem to be a libtool library
- if test "$linkmode,$pass" = "prog,link"; then
- compile_deplibs="$deplib $compile_deplibs"
- finalize_deplibs="$deplib $finalize_deplibs"
- else
- deplibs="$deplib $deplibs"
- test "$linkmode" = lib && newdependency_libs="$deplib $newdependency_libs"
- fi
- continue
- else # deplib is a libtool library
- # If $allow_libtool_libs_with_static_runtimes && $deplib is a stdlib,
- # We need to do some special things here, and not later.
- if test "X$allow_libtool_libs_with_static_runtimes" = "Xyes" ; then
- case " $predeps $postdeps " in
- *" $deplib "*)
- if func_lalib_p "$lib"; then
- library_names=
- old_library=
- func_source "$lib"
- for l in $old_library $library_names; do
- ll="$l"
- done
- if test "X$ll" = "X$old_library" ; then # only static version available
- found=no
- func_dirname "$lib" "" "."
- ladir="$func_dirname_result"
- lib=$ladir/$old_library
- if test "$linkmode,$pass" = "prog,link"; then
- compile_deplibs="$deplib $compile_deplibs"
- finalize_deplibs="$deplib $finalize_deplibs"
- else
- deplibs="$deplib $deplibs"
- test "$linkmode" = lib && newdependency_libs="$deplib $newdependency_libs"
- fi
- continue
- fi
- fi
- ;;
- *) ;;
- esac
- fi
- fi
- ;; # -l
- *.ltframework)
- if test "$linkmode,$pass" = "prog,link"; then
- compile_deplibs="$deplib $compile_deplibs"
- finalize_deplibs="$deplib $finalize_deplibs"
- else
- deplibs="$deplib $deplibs"
- if test "$linkmode" = lib ; then
- case "$new_inherited_linker_flags " in
- *" $deplib "*) ;;
- * ) new_inherited_linker_flags="$new_inherited_linker_flags $deplib" ;;
- esac
- fi
- fi
- continue
- ;;
- -L*)
- case $linkmode in
- lib)
- deplibs="$deplib $deplibs"
- test "$pass" = conv && continue
- newdependency_libs="$deplib $newdependency_libs"
- func_stripname '-L' '' "$deplib"
- newlib_search_path="$newlib_search_path $func_stripname_result"
- ;;
- prog)
- if test "$pass" = conv; then
- deplibs="$deplib $deplibs"
- continue
- fi
- if test "$pass" = scan; then
- deplibs="$deplib $deplibs"
- else
- compile_deplibs="$deplib $compile_deplibs"
- finalize_deplibs="$deplib $finalize_deplibs"
- fi
- func_stripname '-L' '' "$deplib"
- newlib_search_path="$newlib_search_path $func_stripname_result"
- ;;
- *)
- func_warning "\`-L' is ignored for archives/objects"
- ;;
- esac # linkmode
- continue
- ;; # -L
- -R*)
- if test "$pass" = link; then
- func_stripname '-R' '' "$deplib"
- dir=$func_stripname_result
- # Make sure the xrpath contains only unique directories.
- case "$xrpath " in
- *" $dir "*) ;;
- *) xrpath="$xrpath $dir" ;;
- esac
- fi
- deplibs="$deplib $deplibs"
- continue
- ;;
- *.la) lib="$deplib" ;;
- *.$libext)
- if test "$pass" = conv; then
- deplibs="$deplib $deplibs"
- continue
- fi
- case $linkmode in
- lib)
- # Linking convenience modules into shared libraries is allowed,
- # but linking other static libraries is non-portable.
- case " $dlpreconveniencelibs " in
- *" $deplib "*) ;;
- *)
- valid_a_lib=no
- case $deplibs_check_method in
- match_pattern*)
- set dummy $deplibs_check_method; shift
- match_pattern_regex=`expr "$deplibs_check_method" : "$1 \(.*\)"`
- if eval "\$ECHO \"X$deplib\"" 2>/dev/null | $Xsed -e 10q \
- | $EGREP "$match_pattern_regex" > /dev/null; then
- valid_a_lib=yes
- fi
- ;;
- pass_all)
- valid_a_lib=yes
- ;;
- esac
- if test "$valid_a_lib" != yes; then
- $ECHO
- $ECHO "*** Warning: Trying to link with static lib archive $deplib."
- $ECHO "*** I have the capability to make that library automatically link in when"
- $ECHO "*** you link to this library. But I can only do this if you have a"
- $ECHO "*** shared version of the library, which you do not appear to have"
- $ECHO "*** because the file extensions .$libext of this argument makes me believe"
- $ECHO "*** that it is just a static archive that I should not use here."
- else
- $ECHO
- $ECHO "*** Warning: Linking the shared library $output against the"
- $ECHO "*** static library $deplib is not portable!"
- deplibs="$deplib $deplibs"
- fi
- ;;
- esac
- continue
- ;;
- prog)
- if test "$pass" != link; then
- deplibs="$deplib $deplibs"
- else
- compile_deplibs="$deplib $compile_deplibs"
- finalize_deplibs="$deplib $finalize_deplibs"
- fi
- continue
- ;;
- esac # linkmode
- ;; # *.$libext
- *.lo | *.$objext)
- if test "$pass" = conv; then
- deplibs="$deplib $deplibs"
- elif test "$linkmode" = prog; then
- if test "$pass" = dlpreopen || test "$dlopen_support" != yes || test "$build_libtool_libs" = no; then
- # If there is no dlopen support or we're linking statically,
- # we need to preload.
- newdlprefiles="$newdlprefiles $deplib"
- compile_deplibs="$deplib $compile_deplibs"
- finalize_deplibs="$deplib $finalize_deplibs"
- else
- newdlfiles="$newdlfiles $deplib"
- fi
- fi
- continue
- ;;
- %DEPLIBS%)
- alldeplibs=yes
- continue
- ;;
- esac # case $deplib
-
- if test "$found" = yes || test -f "$lib"; then :
- else
- func_fatal_error "cannot find the library \`$lib' or unhandled argument \`$deplib'"
- fi
-
- # Check to see that this really is a libtool archive.
- func_lalib_unsafe_p "$lib" \
- || func_fatal_error "\`$lib' is not a valid libtool archive"
-
- func_dirname "$lib" "" "."
- ladir="$func_dirname_result"
-
- dlname=
- dlopen=
- dlpreopen=
- libdir=
- library_names=
- old_library=
- inherited_linker_flags=
- # If the library was installed with an old release of libtool,
- # it will not redefine variables installed, or shouldnotlink
- installed=yes
- shouldnotlink=no
- avoidtemprpath=
-
-
- # Read the .la file
- func_source "$lib"
-
- # Convert "-framework foo" to "foo.ltframework"
- if test -n "$inherited_linker_flags"; then
- tmp_inherited_linker_flags=`$ECHO "X$inherited_linker_flags" | $Xsed -e 's/-framework \([^ $]*\)/\1.ltframework/g'`
- for tmp_inherited_linker_flag in $tmp_inherited_linker_flags; do
- case " $new_inherited_linker_flags " in
- *" $tmp_inherited_linker_flag "*) ;;
- *) new_inherited_linker_flags="$new_inherited_linker_flags $tmp_inherited_linker_flag";;
- esac
- done
- fi
- dependency_libs=`$ECHO "X $dependency_libs" | $Xsed -e 's% \([^ $]*\).ltframework% -framework \1%g'`
- if test "$linkmode,$pass" = "lib,link" ||
- test "$linkmode,$pass" = "prog,scan" ||
- { test "$linkmode" != prog && test "$linkmode" != lib; }; then
- test -n "$dlopen" && dlfiles="$dlfiles $dlopen"
- test -n "$dlpreopen" && dlprefiles="$dlprefiles $dlpreopen"
- fi
-
- if test "$pass" = conv; then
- # Only check for convenience libraries
- deplibs="$lib $deplibs"
- if test -z "$libdir"; then
- if test -z "$old_library"; then
- func_fatal_error "cannot find name of link library for \`$lib'"
- fi
- # It is a libtool convenience library, so add in its objects.
- convenience="$convenience $ladir/$objdir/$old_library"
- old_convenience="$old_convenience $ladir/$objdir/$old_library"
- elif test "$linkmode" != prog && test "$linkmode" != lib; then
- func_fatal_error "\`$lib' is not a convenience library"
- fi
- tmp_libs=
- for deplib in $dependency_libs; do
- deplibs="$deplib $deplibs"
- if $opt_duplicate_deps ; then
- case "$tmp_libs " in
- *" $deplib "*) specialdeplibs="$specialdeplibs $deplib" ;;
- esac
- fi
- tmp_libs="$tmp_libs $deplib"
- done
- continue
- fi # $pass = conv
-
-
- # Get the name of the library we link against.
- linklib=
- for l in $old_library $library_names; do
- linklib="$l"
- done
- if test -z "$linklib"; then
- func_fatal_error "cannot find name of link library for \`$lib'"
- fi
-
- # This library was specified with -dlopen.
- if test "$pass" = dlopen; then
- if test -z "$libdir"; then
- func_fatal_error "cannot -dlopen a convenience library: \`$lib'"
- fi
- if test -z "$dlname" ||
- test "$dlopen_support" != yes ||
- test "$build_libtool_libs" = no; then
- # If there is no dlname, no dlopen support or we're linking
- # statically, we need to preload. We also need to preload any
- # dependent libraries so libltdl's deplib preloader doesn't
- # bomb out in the load deplibs phase.
- dlprefiles="$dlprefiles $lib $dependency_libs"
- else
- newdlfiles="$newdlfiles $lib"
- fi
- continue
- fi # $pass = dlopen
-
- # We need an absolute path.
- case $ladir in
- [\\/]* | [A-Za-z]:[\\/]*) abs_ladir="$ladir" ;;
- *)
- abs_ladir=`cd "$ladir" && pwd`
- if test -z "$abs_ladir"; then
- func_warning "cannot determine absolute directory name of \`$ladir'"
- func_warning "passing it literally to the linker, although it might fail"
- abs_ladir="$ladir"
- fi
- ;;
- esac
- func_basename "$lib"
- laname="$func_basename_result"
-
- # Find the relevant object directory and library name.
- if test "X$installed" = Xyes; then
- if test ! -f "$libdir/$linklib" && test -f "$abs_ladir/$linklib"; then
- func_warning "library \`$lib' was moved."
- dir="$ladir"
- absdir="$abs_ladir"
- libdir="$abs_ladir"
- else
- dir="$libdir"
- absdir="$libdir"
- fi
- test "X$hardcode_automatic" = Xyes && avoidtemprpath=yes
- else
- if test ! -f "$ladir/$objdir/$linklib" && test -f "$abs_ladir/$linklib"; then
- dir="$ladir"
- absdir="$abs_ladir"
- # Remove this search path later
- notinst_path="$notinst_path $abs_ladir"
- else
- dir="$ladir/$objdir"
- absdir="$abs_ladir/$objdir"
- # Remove this search path later
- notinst_path="$notinst_path $abs_ladir"
- fi
- fi # $installed = yes
- func_stripname 'lib' '.la' "$laname"
- name=$func_stripname_result
-
- # This library was specified with -dlpreopen.
- if test "$pass" = dlpreopen; then
- if test -z "$libdir" && test "$linkmode" = prog; then
- func_fatal_error "only libraries may -dlpreopen a convenience library: \`$lib'"
- fi
- # Prefer using a static library (so that no silly _DYNAMIC symbols
- # are required to link).
- if test -n "$old_library"; then
- newdlprefiles="$newdlprefiles $dir/$old_library"
- # Keep a list of preopened convenience libraries to check
- # that they are being used correctly in the link pass.
- test -z "$libdir" && \
- dlpreconveniencelibs="$dlpreconveniencelibs $dir/$old_library"
- # Otherwise, use the dlname, so that lt_dlopen finds it.
- elif test -n "$dlname"; then
- newdlprefiles="$newdlprefiles $dir/$dlname"
- else
- newdlprefiles="$newdlprefiles $dir/$linklib"
- fi
- fi # $pass = dlpreopen
-
- if test -z "$libdir"; then
- # Link the convenience library
- if test "$linkmode" = lib; then
- deplibs="$dir/$old_library $deplibs"
- elif test "$linkmode,$pass" = "prog,link"; then
- compile_deplibs="$dir/$old_library $compile_deplibs"
- finalize_deplibs="$dir/$old_library $finalize_deplibs"
- else
- deplibs="$lib $deplibs" # used for prog,scan pass
- fi
- continue
- fi
-
-
- if test "$linkmode" = prog && test "$pass" != link; then
- newlib_search_path="$newlib_search_path $ladir"
- deplibs="$lib $deplibs"
-
- linkalldeplibs=no
- if test "$link_all_deplibs" != no || test -z "$library_names" ||
- test "$build_libtool_libs" = no; then
- linkalldeplibs=yes
- fi
-
- tmp_libs=
- for deplib in $dependency_libs; do
- case $deplib in
- -L*) func_stripname '-L' '' "$deplib"
- newlib_search_path="$newlib_search_path $func_stripname_result"
- ;;
- esac
- # Need to link against all dependency_libs?
- if test "$linkalldeplibs" = yes; then
- deplibs="$deplib $deplibs"
- else
- # Need to hardcode shared library paths
- # or/and link against static libraries
- newdependency_libs="$deplib $newdependency_libs"
- fi
- if $opt_duplicate_deps ; then
- case "$tmp_libs " in
- *" $deplib "*) specialdeplibs="$specialdeplibs $deplib" ;;
- esac
- fi
- tmp_libs="$tmp_libs $deplib"
- done # for deplib
- continue
- fi # $linkmode = prog...
-
- if test "$linkmode,$pass" = "prog,link"; then
- if test -n "$library_names" &&
- { { test "$prefer_static_libs" = no ||
- test "$prefer_static_libs,$installed" = "built,yes"; } ||
- test -z "$old_library"; }; then
- # We need to hardcode the library path
- if test -n "$shlibpath_var" && test -z "$avoidtemprpath" ; then
- # Make sure the rpath contains only unique directories.
- case "$temp_rpath:" in
- *"$absdir:"*) ;;
- *) temp_rpath="$temp_rpath$absdir:" ;;
- esac
- fi
-
- # Hardcode the library path.
- # Skip directories that are in the system default run-time
- # search path.
- case " $sys_lib_dlsearch_path " in
- *" $absdir "*) ;;
- *)
- case "$compile_rpath " in
- *" $absdir "*) ;;
- *) compile_rpath="$compile_rpath $absdir"
- esac
- ;;
- esac
- case " $sys_lib_dlsearch_path " in
- *" $libdir "*) ;;
- *)
- case "$finalize_rpath " in
- *" $libdir "*) ;;
- *) finalize_rpath="$finalize_rpath $libdir"
- esac
- ;;
- esac
- fi # $linkmode,$pass = prog,link...
-
- if test "$alldeplibs" = yes &&
- { test "$deplibs_check_method" = pass_all ||
- { test "$build_libtool_libs" = yes &&
- test -n "$library_names"; }; }; then
- # We only need to search for static libraries
- continue
- fi
- fi
-
- link_static=no # Whether the deplib will be linked statically
- use_static_libs=$prefer_static_libs
- if test "$use_static_libs" = built && test "$installed" = yes; then
- use_static_libs=no
- fi
- if test -n "$library_names" &&
- { test "$use_static_libs" = no || test -z "$old_library"; }; then
- case $host in
- *cygwin* | *mingw* | *cegcc*)
- # No point in relinking DLLs because paths are not encoded
- notinst_deplibs="$notinst_deplibs $lib"
- need_relink=no
- ;;
- *)
- if test "$installed" = no; then
- notinst_deplibs="$notinst_deplibs $lib"
- need_relink=yes
- fi
- ;;
- esac
- # This is a shared library
-
- # Warn about portability, can't link against -module's on some
- # systems (darwin). Don't bleat about dlopened modules though!
- dlopenmodule=""
- for dlpremoduletest in $dlprefiles; do
- if test "X$dlpremoduletest" = "X$lib"; then
- dlopenmodule="$dlpremoduletest"
- break
- fi
- done
- if test -z "$dlopenmodule" && test "$shouldnotlink" = yes && test "$pass" = link; then
- $ECHO
- if test "$linkmode" = prog; then
- $ECHO "*** Warning: Linking the executable $output against the loadable module"
- else
- $ECHO "*** Warning: Linking the shared library $output against the loadable module"
- fi
- $ECHO "*** $linklib is not portable!"
- fi
- if test "$linkmode" = lib &&
- test "$hardcode_into_libs" = yes; then
- # Hardcode the library path.
- # Skip directories that are in the system default run-time
- # search path.
- case " $sys_lib_dlsearch_path " in
- *" $absdir "*) ;;
- *)
- case "$compile_rpath " in
- *" $absdir "*) ;;
- *) compile_rpath="$compile_rpath $absdir"
- esac
- ;;
- esac
- case " $sys_lib_dlsearch_path " in
- *" $libdir "*) ;;
- *)
- case "$finalize_rpath " in
- *" $libdir "*) ;;
- *) finalize_rpath="$finalize_rpath $libdir"
- esac
- ;;
- esac
- fi
-
- if test -n "$old_archive_from_expsyms_cmds"; then
- # figure out the soname
- set dummy $library_names
- shift
- realname="$1"
- shift
- libname=`eval "\\$ECHO \"$libname_spec\""`
- # use dlname if we got it. it's perfectly good, no?
- if test -n "$dlname"; then
- soname="$dlname"
- elif test -n "$soname_spec"; then
- # bleh windows
- case $host in
- *cygwin* | mingw* | *cegcc*)
- func_arith $current - $age
- major=$func_arith_result
- versuffix="-$major"
- ;;
- esac
- eval soname=\"$soname_spec\"
- else
- soname="$realname"
- fi
-
- # Make a new name for the extract_expsyms_cmds to use
- soroot="$soname"
- func_basename "$soroot"
- soname="$func_basename_result"
- func_stripname 'lib' '.dll' "$soname"
- newlib=libimp-$func_stripname_result.a
-
- # If the library has no export list, then create one now
- if test -f "$output_objdir/$soname-def"; then :
- else
- func_verbose "extracting exported symbol list from \`$soname'"
- func_execute_cmds "$extract_expsyms_cmds" 'exit $?'
- fi
-
- # Create $newlib
- if test -f "$output_objdir/$newlib"; then :; else
- func_verbose "generating import library for \`$soname'"
- func_execute_cmds "$old_archive_from_expsyms_cmds" 'exit $?'
- fi
- # make sure the library variables are pointing to the new library
- dir=$output_objdir
- linklib=$newlib
- fi # test -n "$old_archive_from_expsyms_cmds"
-
- if test "$linkmode" = prog || test "$mode" != relink; then
- add_shlibpath=
- add_dir=
- add=
- lib_linked=yes
- case $hardcode_action in
- immediate | unsupported)
- if test "$hardcode_direct" = no; then
- add="$dir/$linklib"
- case $host in
- *-*-sco3.2v5.0.[024]*) add_dir="-L$dir" ;;
- *-*-sysv4*uw2*) add_dir="-L$dir" ;;
- *-*-sysv5OpenUNIX* | *-*-sysv5UnixWare7.[01].[10]* | \
- *-*-unixware7*) add_dir="-L$dir" ;;
- *-*-darwin* )
- # if the lib is a (non-dlopened) module then we can not
- # link against it, someone is ignoring the earlier warnings
- if /usr/bin/file -L $add 2> /dev/null |
- $GREP ": [^:]* bundle" >/dev/null ; then
- if test "X$dlopenmodule" != "X$lib"; then
- $ECHO "*** Warning: lib $linklib is a module, not a shared library"
- if test -z "$old_library" ; then
- $ECHO
- $ECHO "*** And there doesn't seem to be a static archive available"
- $ECHO "*** The link will probably fail, sorry"
- else
- add="$dir/$old_library"
- fi
- elif test -n "$old_library"; then
- add="$dir/$old_library"
- fi
- fi
- esac
- elif test "$hardcode_minus_L" = no; then
- case $host in
- *-*-sunos*) add_shlibpath="$dir" ;;
- esac
- add_dir="-L$dir"
- add="-l$name"
- elif test "$hardcode_shlibpath_var" = no; then
- add_shlibpath="$dir"
- add="-l$name"
- else
- lib_linked=no
- fi
- ;;
- relink)
- if test "$hardcode_direct" = yes &&
- test "$hardcode_direct_absolute" = no; then
- add="$dir/$linklib"
- elif test "$hardcode_minus_L" = yes; then
- add_dir="-L$dir"
- # Try looking first in the location we're being installed to.
- if test -n "$inst_prefix_dir"; then
- case $libdir in
- [\\/]*)
- add_dir="$add_dir -L$inst_prefix_dir$libdir"
- ;;
- esac
- fi
- add="-l$name"
- elif test "$hardcode_shlibpath_var" = yes; then
- add_shlibpath="$dir"
- add="-l$name"
- else
- lib_linked=no
- fi
- ;;
- *) lib_linked=no ;;
- esac
-
- if test "$lib_linked" != yes; then
- func_fatal_configuration "unsupported hardcode properties"
- fi
-
- if test -n "$add_shlibpath"; then
- case :$compile_shlibpath: in
- *":$add_shlibpath:"*) ;;
- *) compile_shlibpath="$compile_shlibpath$add_shlibpath:" ;;
- esac
- fi
- if test "$linkmode" = prog; then
- test -n "$add_dir" && compile_deplibs="$add_dir $compile_deplibs"
- test -n "$add" && compile_deplibs="$add $compile_deplibs"
- else
- test -n "$add_dir" && deplibs="$add_dir $deplibs"
- test -n "$add" && deplibs="$add $deplibs"
- if test "$hardcode_direct" != yes &&
- test "$hardcode_minus_L" != yes &&
- test "$hardcode_shlibpath_var" = yes; then
- case :$finalize_shlibpath: in
- *":$libdir:"*) ;;
- *) finalize_shlibpath="$finalize_shlibpath$libdir:" ;;
- esac
- fi
- fi
- fi
-
- if test "$linkmode" = prog || test "$mode" = relink; then
- add_shlibpath=
- add_dir=
- add=
- # Finalize command for both is simple: just hardcode it.
- if test "$hardcode_direct" = yes &&
- test "$hardcode_direct_absolute" = no; then
- add="$libdir/$linklib"
- elif test "$hardcode_minus_L" = yes; then
- add_dir="-L$libdir"
- add="-l$name"
- elif test "$hardcode_shlibpath_var" = yes; then
- case :$finalize_shlibpath: in
- *":$libdir:"*) ;;
- *) finalize_shlibpath="$finalize_shlibpath$libdir:" ;;
- esac
- add="-l$name"
- elif test "$hardcode_automatic" = yes; then
- if test -n "$inst_prefix_dir" &&
- test -f "$inst_prefix_dir$libdir/$linklib" ; then
- add="$inst_prefix_dir$libdir/$linklib"
- else
- add="$libdir/$linklib"
- fi
- else
- # We cannot seem to hardcode it, guess we'll fake it.
- add_dir="-L$libdir"
- # Try looking first in the location we're being installed to.
- if test -n "$inst_prefix_dir"; then
- case $libdir in
- [\\/]*)
- add_dir="$add_dir -L$inst_prefix_dir$libdir"
- ;;
- esac
- fi
- add="-l$name"
- fi
-
- if test "$linkmode" = prog; then
- test -n "$add_dir" && finalize_deplibs="$add_dir $finalize_deplibs"
- test -n "$add" && finalize_deplibs="$add $finalize_deplibs"
- else
- test -n "$add_dir" && deplibs="$add_dir $deplibs"
- test -n "$add" && deplibs="$add $deplibs"
- fi
- fi
- elif test "$linkmode" = prog; then
- # Here we assume that one of hardcode_direct or hardcode_minus_L
- # is not unsupported. This is valid on all known static and
- # shared platforms.
- if test "$hardcode_direct" != unsupported; then
- test -n "$old_library" && linklib="$old_library"
- compile_deplibs="$dir/$linklib $compile_deplibs"
- finalize_deplibs="$dir/$linklib $finalize_deplibs"
- else
- compile_deplibs="-l$name -L$dir $compile_deplibs"
- finalize_deplibs="-l$name -L$dir $finalize_deplibs"
- fi
- elif test "$build_libtool_libs" = yes; then
- # Not a shared library
- if test "$deplibs_check_method" != pass_all; then
- # We're trying link a shared library against a static one
- # but the system doesn't support it.
-
- # Just print a warning and add the library to dependency_libs so
- # that the program can be linked against the static library.
- $ECHO
- $ECHO "*** Warning: This system can not link to static lib archive $lib."
- $ECHO "*** I have the capability to make that library automatically link in when"
- $ECHO "*** you link to this library. But I can only do this if you have a"
- $ECHO "*** shared version of the library, which you do not appear to have."
- if test "$module" = yes; then
- $ECHO "*** But as you try to build a module library, libtool will still create "
- $ECHO "*** a static module, that should work as long as the dlopening application"
- $ECHO "*** is linked with the -dlopen flag to resolve symbols at runtime."
- if test -z "$global_symbol_pipe"; then
- $ECHO
- $ECHO "*** However, this would only work if libtool was able to extract symbol"
- $ECHO "*** lists from a program, using \`nm' or equivalent, but libtool could"
- $ECHO "*** not find such a program. So, this module is probably useless."
- $ECHO "*** \`nm' from GNU binutils and a full rebuild may help."
- fi
- if test "$build_old_libs" = no; then
- build_libtool_libs=module
- build_old_libs=yes
- else
- build_libtool_libs=no
- fi
- fi
- else
- deplibs="$dir/$old_library $deplibs"
- link_static=yes
- fi
- fi # link shared/static library?
-
- if test "$linkmode" = lib; then
- if test -n "$dependency_libs" &&
- { test "$hardcode_into_libs" != yes ||
- test "$build_old_libs" = yes ||
- test "$link_static" = yes; }; then
- # Extract -R from dependency_libs
- temp_deplibs=
- for libdir in $dependency_libs; do
- case $libdir in
- -R*) func_stripname '-R' '' "$libdir"
- temp_xrpath=$func_stripname_result
- case " $xrpath " in
- *" $temp_xrpath "*) ;;
- *) xrpath="$xrpath $temp_xrpath";;
- esac;;
- *) temp_deplibs="$temp_deplibs $libdir";;
- esac
- done
- dependency_libs="$temp_deplibs"
- fi
-
- newlib_search_path="$newlib_search_path $absdir"
- # Link against this library
- test "$link_static" = no && newdependency_libs="$abs_ladir/$laname $newdependency_libs"
- # ... and its dependency_libs
- tmp_libs=
- for deplib in $dependency_libs; do
- newdependency_libs="$deplib $newdependency_libs"
- if $opt_duplicate_deps ; then
- case "$tmp_libs " in
- *" $deplib "*) specialdeplibs="$specialdeplibs $deplib" ;;
- esac
- fi
- tmp_libs="$tmp_libs $deplib"
- done
-
- if test "$link_all_deplibs" != no; then
- # Add the search paths of all dependency libraries
- for deplib in $dependency_libs; do
- case $deplib in
- -L*) path="$deplib" ;;
- *.la)
- func_dirname "$deplib" "" "."
- dir="$func_dirname_result"
- # We need an absolute path.
- case $dir in
- [\\/]* | [A-Za-z]:[\\/]*) absdir="$dir" ;;
- *)
- absdir=`cd "$dir" && pwd`
- if test -z "$absdir"; then
- func_warning "cannot determine absolute directory name of \`$dir'"
- absdir="$dir"
- fi
- ;;
- esac
- if $GREP "^installed=no" $deplib > /dev/null; then
- case $host in
- *-*-darwin*)
- depdepl=
- eval deplibrary_names=`${SED} -n -e 's/^library_names=\(.*\)$/\1/p' $deplib`
- if test -n "$deplibrary_names" ; then
- for tmp in $deplibrary_names ; do
- depdepl=$tmp
- done
- if test -f "$absdir/$objdir/$depdepl" ; then
- depdepl="$absdir/$objdir/$depdepl"
- darwin_install_name=`${OTOOL} -L $depdepl | awk '{if (NR == 2) {print $1;exit}}'`
- if test -z "$darwin_install_name"; then
- darwin_install_name=`${OTOOL64} -L $depdepl | awk '{if (NR == 2) {print $1;exit}}'`
- fi
- compiler_flags="$compiler_flags ${wl}-dylib_file ${wl}${darwin_install_name}:${depdepl}"
- linker_flags="$linker_flags -dylib_file ${darwin_install_name}:${depdepl}"
- path=
- fi
- fi
- ;;
- *)
- path="-L$absdir/$objdir"
- ;;
- esac
- else
- eval libdir=`${SED} -n -e 's/^libdir=\(.*\)$/\1/p' $deplib`
- test -z "$libdir" && \
- func_fatal_error "\`$deplib' is not a valid libtool archive"
- test "$absdir" != "$libdir" && \
- func_warning "\`$deplib' seems to be moved"
-
- path="-L$absdir"
- fi
- ;;
- esac
- case " $deplibs " in
- *" $path "*) ;;
- *) deplibs="$path $deplibs" ;;
- esac
- done
- fi # link_all_deplibs != no
- fi # linkmode = lib
- done # for deplib in $libs
- if test "$pass" = link; then
- if test "$linkmode" = "prog"; then
- compile_deplibs="$new_inherited_linker_flags $compile_deplibs"
- finalize_deplibs="$new_inherited_linker_flags $finalize_deplibs"
- else
- compiler_flags="$compiler_flags "`$ECHO "X $new_inherited_linker_flags" | $Xsed -e 's% \([^ $]*\).ltframework% -framework \1%g'`
- fi
- fi
- dependency_libs="$newdependency_libs"
- if test "$pass" = dlpreopen; then
- # Link the dlpreopened libraries before other libraries
- for deplib in $save_deplibs; do
- deplibs="$deplib $deplibs"
- done
- fi
- if test "$pass" != dlopen; then
- if test "$pass" != conv; then
- # Make sure lib_search_path contains only unique directories.
- lib_search_path=
- for dir in $newlib_search_path; do
- case "$lib_search_path " in
- *" $dir "*) ;;
- *) lib_search_path="$lib_search_path $dir" ;;
- esac
- done
- newlib_search_path=
- fi
-
- if test "$linkmode,$pass" != "prog,link"; then
- vars="deplibs"
- else
- vars="compile_deplibs finalize_deplibs"
- fi
- for var in $vars dependency_libs; do
- # Add libraries to $var in reverse order
- eval tmp_libs=\"\$$var\"
- new_libs=
- for deplib in $tmp_libs; do
- # FIXME: Pedantically, this is the right thing to do, so
- # that some nasty dependency loop isn't accidentally
- # broken:
- #new_libs="$deplib $new_libs"
- # Pragmatically, this seems to cause very few problems in
- # practice:
- case $deplib in
- -L*) new_libs="$deplib $new_libs" ;;
- -R*) ;;
- *)
- # And here is the reason: when a library appears more
- # than once as an explicit dependence of a library, or
- # is implicitly linked in more than once by the
- # compiler, it is considered special, and multiple
- # occurrences thereof are not removed. Compare this
- # with having the same library being listed as a
- # dependency of multiple other libraries: in this case,
- # we know (pedantically, we assume) the library does not
- # need to be listed more than once, so we keep only the
- # last copy. This is not always right, but it is rare
- # enough that we require users that really mean to play
- # such unportable linking tricks to link the library
- # using -Wl,-lname, so that libtool does not consider it
- # for duplicate removal.
- case " $specialdeplibs " in
- *" $deplib "*) new_libs="$deplib $new_libs" ;;
- *)
- case " $new_libs " in
- *" $deplib "*) ;;
- *) new_libs="$deplib $new_libs" ;;
- esac
- ;;
- esac
- ;;
- esac
- done
- tmp_libs=
- for deplib in $new_libs; do
- case $deplib in
- -L*)
- case " $tmp_libs " in
- *" $deplib "*) ;;
- *) tmp_libs="$tmp_libs $deplib" ;;
- esac
- ;;
- *) tmp_libs="$tmp_libs $deplib" ;;
- esac
- done
- eval $var=\"$tmp_libs\"
- done # for var
- fi
- # Last step: remove runtime libs from dependency_libs
- # (they stay in deplibs)
- tmp_libs=
- for i in $dependency_libs ; do
- case " $predeps $postdeps $compiler_lib_search_path " in
- *" $i "*)
- i=""
- ;;
- esac
- if test -n "$i" ; then
- tmp_libs="$tmp_libs $i"
- fi
- done
- dependency_libs=$tmp_libs
- done # for pass
- if test "$linkmode" = prog; then
- dlfiles="$newdlfiles"
- fi
- if test "$linkmode" = prog || test "$linkmode" = lib; then
- dlprefiles="$newdlprefiles"
- fi
-
- case $linkmode in
- oldlib)
- if test -n "$dlfiles$dlprefiles" || test "$dlself" != no; then
- func_warning "\`-dlopen' is ignored for archives"
- fi
-
- case " $deplibs" in
- *\ -l* | *\ -L*)
- func_warning "\`-l' and \`-L' are ignored for archives" ;;
- esac
-
- test -n "$rpath" && \
- func_warning "\`-rpath' is ignored for archives"
-
- test -n "$xrpath" && \
- func_warning "\`-R' is ignored for archives"
-
- test -n "$vinfo" && \
- func_warning "\`-version-info/-version-number' is ignored for archives"
-
- test -n "$release" && \
- func_warning "\`-release' is ignored for archives"
-
- test -n "$export_symbols$export_symbols_regex" && \
- func_warning "\`-export-symbols' is ignored for archives"
-
- # Now set the variables for building old libraries.
- build_libtool_libs=no
- oldlibs="$output"
- objs="$objs$old_deplibs"
- ;;
-
- lib)
- # Make sure we only generate libraries of the form `libNAME.la'.
- case $outputname in
- lib*)
- func_stripname 'lib' '.la' "$outputname"
- name=$func_stripname_result
- eval shared_ext=\"$shrext_cmds\"
- eval libname=\"$libname_spec\"
- ;;
- *)
- test "$module" = no && \
- func_fatal_help "libtool library \`$output' must begin with \`lib'"
-
- if test "$need_lib_prefix" != no; then
- # Add the "lib" prefix for modules if required
- func_stripname '' '.la' "$outputname"
- name=$func_stripname_result
- eval shared_ext=\"$shrext_cmds\"
- eval libname=\"$libname_spec\"
- else
- func_stripname '' '.la' "$outputname"
- libname=$func_stripname_result
- fi
- ;;
- esac
-
- if test -n "$objs"; then
- if test "$deplibs_check_method" != pass_all; then
- func_fatal_error "cannot build libtool library \`$output' from non-libtool objects on this host:$objs"
- else
- $ECHO
- $ECHO "*** Warning: Linking the shared library $output against the non-libtool"
- $ECHO "*** objects $objs is not portable!"
- libobjs="$libobjs $objs"
- fi
- fi
-
- test "$dlself" != no && \
- func_warning "\`-dlopen self' is ignored for libtool libraries"
-
- set dummy $rpath
- shift
- test "$#" -gt 1 && \
- func_warning "ignoring multiple \`-rpath's for a libtool library"
-
- install_libdir="$1"
-
- oldlibs=
- if test -z "$rpath"; then
- if test "$build_libtool_libs" = yes; then
- # Building a libtool convenience library.
- # Some compilers have problems with a `.al' extension so
- # convenience libraries should have the same extension an
- # archive normally would.
- oldlibs="$output_objdir/$libname.$libext $oldlibs"
- build_libtool_libs=convenience
- build_old_libs=yes
- fi
-
- test -n "$vinfo" && \
- func_warning "\`-version-info/-version-number' is ignored for convenience libraries"
-
- test -n "$release" && \
- func_warning "\`-release' is ignored for convenience libraries"
- else
-
- # Parse the version information argument.
- save_ifs="$IFS"; IFS=':'
- set dummy $vinfo 0 0 0
- shift
- IFS="$save_ifs"
-
- test -n "$7" && \
- func_fatal_help "too many parameters to \`-version-info'"
-
- # convert absolute version numbers to libtool ages
- # this retains compatibility with .la files and attempts
- # to make the code below a bit more comprehensible
-
- case $vinfo_number in
- yes)
- number_major="$1"
- number_minor="$2"
- number_revision="$3"
- #
- # There are really only two kinds -- those that
- # use the current revision as the major version
- # and those that subtract age and use age as
- # a minor version. But, then there is irix
- # which has an extra 1 added just for fun
- #
- case $version_type in
- darwin|linux|osf|windows|none)
- func_arith $number_major + $number_minor
- current=$func_arith_result
- age="$number_minor"
- revision="$number_revision"
- ;;
- freebsd-aout|freebsd-elf|sunos)
- current="$number_major"
- revision="$number_minor"
- age="0"
- ;;
- irix|nonstopux)
- func_arith $number_major + $number_minor
- current=$func_arith_result
- age="$number_minor"
- revision="$number_minor"
- lt_irix_increment=no
- ;;
- esac
- ;;
- no)
- current="$1"
- revision="$2"
- age="$3"
- ;;
- esac
-
- # Check that each of the things are valid numbers.
- case $current in
- 0|[1-9]|[1-9][0-9]|[1-9][0-9][0-9]|[1-9][0-9][0-9][0-9]|[1-9][0-9][0-9][0-9][0-9]) ;;
- *)
- func_error "CURRENT \`$current' must be a nonnegative integer"
- func_fatal_error "\`$vinfo' is not valid version information"
- ;;
- esac
-
- case $revision in
- 0|[1-9]|[1-9][0-9]|[1-9][0-9][0-9]|[1-9][0-9][0-9][0-9]|[1-9][0-9][0-9][0-9][0-9]) ;;
- *)
- func_error "REVISION \`$revision' must be a nonnegative integer"
- func_fatal_error "\`$vinfo' is not valid version information"
- ;;
- esac
-
- case $age in
- 0|[1-9]|[1-9][0-9]|[1-9][0-9][0-9]|[1-9][0-9][0-9][0-9]|[1-9][0-9][0-9][0-9][0-9]) ;;
- *)
- func_error "AGE \`$age' must be a nonnegative integer"
- func_fatal_error "\`$vinfo' is not valid version information"
- ;;
- esac
-
- if test "$age" -gt "$current"; then
- func_error "AGE \`$age' is greater than the current interface number \`$current'"
- func_fatal_error "\`$vinfo' is not valid version information"
- fi
-
- # Calculate the version variables.
- major=
- versuffix=
- verstring=
- case $version_type in
- none) ;;
-
- darwin)
- # Like Linux, but with the current version available in
- # verstring for coding it into the library header
- func_arith $current - $age
- major=.$func_arith_result
- versuffix="$major.$age.$revision"
- # Darwin ld doesn't like 0 for these options...
- func_arith $current + 1
- minor_current=$func_arith_result
- xlcverstring="${wl}-compatibility_version ${wl}$minor_current ${wl}-current_version ${wl}$minor_current.$revision"
- verstring="-compatibility_version $minor_current -current_version $minor_current.$revision"
- ;;
-
- freebsd-aout)
- major=".$current"
- versuffix=".$current.$revision";
- ;;
-
- freebsd-elf)
- major=".$current"
- versuffix=".$current"
- ;;
-
- irix | nonstopux)
- if test "X$lt_irix_increment" = "Xno"; then
- func_arith $current - $age
- else
- func_arith $current - $age + 1
- fi
- major=$func_arith_result
-
- case $version_type in
- nonstopux) verstring_prefix=nonstopux ;;
- *) verstring_prefix=sgi ;;
- esac
- verstring="$verstring_prefix$major.$revision"
-
- # Add in all the interfaces that we are compatible with.
- loop=$revision
- while test "$loop" -ne 0; do
- func_arith $revision - $loop
- iface=$func_arith_result
- func_arith $loop - 1
- loop=$func_arith_result
- verstring="$verstring_prefix$major.$iface:$verstring"
- done
-
- # Before this point, $major must not contain `.'.
- major=.$major
- versuffix="$major.$revision"
- ;;
-
- linux)
- func_arith $current - $age
- major=.$func_arith_result
- versuffix="$major.$age.$revision"
- ;;
-
- osf)
- func_arith $current - $age
- major=.$func_arith_result
- versuffix=".$current.$age.$revision"
- verstring="$current.$age.$revision"
-
- # Add in all the interfaces that we are compatible with.
- loop=$age
- while test "$loop" -ne 0; do
- func_arith $current - $loop
- iface=$func_arith_result
- func_arith $loop - 1
- loop=$func_arith_result
- verstring="$verstring:${iface}.0"
- done
-
- # Make executables depend on our current version.
- verstring="$verstring:${current}.0"
- ;;
-
- qnx)
- major=".$current"
- versuffix=".$current"
- ;;
-
- sunos)
- major=".$current"
- versuffix=".$current.$revision"
- ;;
-
- windows)
- # Use '-' rather than '.', since we only want one
- # extension on DOS 8.3 filesystems.
- func_arith $current - $age
- major=$func_arith_result
- versuffix="-$major"
- ;;
-
- *)
- func_fatal_configuration "unknown library version type \`$version_type'"
- ;;
- esac
-
- # Clear the version info if we defaulted, and they specified a release.
- if test -z "$vinfo" && test -n "$release"; then
- major=
- case $version_type in
- darwin)
- # we can't check for "0.0" in archive_cmds due to quoting
- # problems, so we reset it completely
- verstring=
- ;;
- *)
- verstring="0.0"
- ;;
- esac
- if test "$need_version" = no; then
- versuffix=
- else
- versuffix=".0.0"
- fi
- fi
-
- # Remove version info from name if versioning should be avoided
- if test "$avoid_version" = yes && test "$need_version" = no; then
- major=
- versuffix=
- verstring=""
- fi
-
- # Check to see if the archive will have undefined symbols.
- if test "$allow_undefined" = yes; then
- if test "$allow_undefined_flag" = unsupported; then
- func_warning "undefined symbols not allowed in $host shared libraries"
- build_libtool_libs=no
- build_old_libs=yes
- fi
- else
- # Don't allow undefined symbols.
- allow_undefined_flag="$no_undefined_flag"
- fi
-
- fi
-
- func_generate_dlsyms "$libname" "$libname" "yes"
- libobjs="$libobjs $symfileobj"
- test "X$libobjs" = "X " && libobjs=
-
- if test "$mode" != relink; then
- # Remove our outputs, but don't remove object files since they
- # may have been created when compiling PIC objects.
- removelist=
- tempremovelist=`$ECHO "$output_objdir/*"`
- for p in $tempremovelist; do
- case $p in
- *.$objext | *.gcno)
- ;;
- $output_objdir/$outputname | $output_objdir/$libname.* | $output_objdir/${libname}${release}.*)
- if test "X$precious_files_regex" != "X"; then
- if $ECHO "$p" | $EGREP -e "$precious_files_regex" >/dev/null 2>&1
- then
- continue
- fi
- fi
- removelist="$removelist $p"
- ;;
- *) ;;
- esac
- done
- test -n "$removelist" && \
- func_show_eval "${RM}r \$removelist"
- fi
-
- # Now set the variables for building old libraries.
- if test "$build_old_libs" = yes && test "$build_libtool_libs" != convenience ; then
- oldlibs="$oldlibs $output_objdir/$libname.$libext"
-
- # Transform .lo files to .o files.
- oldobjs="$objs "`$ECHO "X$libobjs" | $SP2NL | $Xsed -e '/\.'${libext}'$/d' -e "$lo2o" | $NL2SP`
- fi
-
- # Eliminate all temporary directories.
- #for path in $notinst_path; do
- # lib_search_path=`$ECHO "X$lib_search_path " | $Xsed -e "s% $path % %g"`
- # deplibs=`$ECHO "X$deplibs " | $Xsed -e "s% -L$path % %g"`
- # dependency_libs=`$ECHO "X$dependency_libs " | $Xsed -e "s% -L$path % %g"`
- #done
-
- if test -n "$xrpath"; then
- # If the user specified any rpath flags, then add them.
- temp_xrpath=
- for libdir in $xrpath; do
- temp_xrpath="$temp_xrpath -R$libdir"
- case "$finalize_rpath " in
- *" $libdir "*) ;;
- *) finalize_rpath="$finalize_rpath $libdir" ;;
- esac
- done
- if test "$hardcode_into_libs" != yes || test "$build_old_libs" = yes; then
- dependency_libs="$temp_xrpath $dependency_libs"
- fi
- fi
-
- # Make sure dlfiles contains only unique files that won't be dlpreopened
- old_dlfiles="$dlfiles"
- dlfiles=
- for lib in $old_dlfiles; do
- case " $dlprefiles $dlfiles " in
- *" $lib "*) ;;
- *) dlfiles="$dlfiles $lib" ;;
- esac
- done
-
- # Make sure dlprefiles contains only unique files
- old_dlprefiles="$dlprefiles"
- dlprefiles=
- for lib in $old_dlprefiles; do
- case "$dlprefiles " in
- *" $lib "*) ;;
- *) dlprefiles="$dlprefiles $lib" ;;
- esac
- done
-
- if test "$build_libtool_libs" = yes; then
- if test -n "$rpath"; then
- case $host in
- *-*-cygwin* | *-*-mingw* | *-*-pw32* | *-*-os2* | *-*-beos* | *-cegcc*)
- # these systems don't actually have a c library (as such)!
- ;;
- *-*-rhapsody* | *-*-darwin1.[012])
- # Rhapsody C library is in the System framework
- deplibs="$deplibs System.ltframework"
- ;;
- *-*-netbsd*)
- # Don't link with libc until the a.out ld.so is fixed.
- ;;
- *-*-openbsd* | *-*-freebsd* | *-*-dragonfly*)
- # Do not include libc due to us having libc/libc_r.
- ;;
- *-*-sco3.2v5* | *-*-sco5v6*)
- # Causes problems with __ctype
- ;;
- *-*-sysv4.2uw2* | *-*-sysv5* | *-*-unixware* | *-*-OpenUNIX*)
- # Compiler inserts libc in the correct place for threads to work
- ;;
- *)
- # Add libc to deplibs on all other systems if necessary.
- if test "$build_libtool_need_lc" = "yes"; then
- deplibs="$deplibs -lc"
- fi
- ;;
- esac
- fi
-
- # Transform deplibs into only deplibs that can be linked in shared.
- name_save=$name
- libname_save=$libname
- release_save=$release
- versuffix_save=$versuffix
- major_save=$major
- # I'm not sure if I'm treating the release correctly. I think
- # release should show up in the -l (ie -lgmp5) so we don't want to
- # add it in twice. Is that correct?
- release=""
- versuffix=""
- major=""
- newdeplibs=
- droppeddeps=no
- case $deplibs_check_method in
- pass_all)
- # Don't check for shared/static. Everything works.
- # This might be a little naive. We might want to check
- # whether the library exists or not. But this is on
- # osf3 & osf4 and I'm not really sure... Just
- # implementing what was already the behavior.
- newdeplibs=$deplibs
- ;;
- test_compile)
- # This code stresses the "libraries are programs" paradigm to its
- # limits. Maybe even breaks it. We compile a program, linking it
- # against the deplibs as a proxy for the library. Then we can check
- # whether they linked in statically or dynamically with ldd.
- $opt_dry_run || $RM conftest.c
- cat > conftest.c <<EOF
- int main() { return 0; }
-EOF
- $opt_dry_run || $RM conftest
- if $LTCC $LTCFLAGS -o conftest conftest.c $deplibs; then
- ldd_output=`ldd conftest`
- for i in $deplibs; do
- case $i in
- -l*)
- func_stripname -l '' "$i"
- name=$func_stripname_result
- if test "X$allow_libtool_libs_with_static_runtimes" = "Xyes" ; then
- case " $predeps $postdeps " in
- *" $i "*)
- newdeplibs="$newdeplibs $i"
- i=""
- ;;
- esac
- fi
- if test -n "$i" ; then
- libname=`eval "\\$ECHO \"$libname_spec\""`
- deplib_matches=`eval "\\$ECHO \"$library_names_spec\""`
- set dummy $deplib_matches; shift
- deplib_match=$1
- if test `expr "$ldd_output" : ".*$deplib_match"` -ne 0 ; then
- newdeplibs="$newdeplibs $i"
- else
- droppeddeps=yes
- $ECHO
- $ECHO "*** Warning: dynamic linker does not accept needed library $i."
- $ECHO "*** I have the capability to make that library automatically link in when"
- $ECHO "*** you link to this library. But I can only do this if you have a"
- $ECHO "*** shared version of the library, which I believe you do not have"
- $ECHO "*** because a test_compile did reveal that the linker did not use it for"
- $ECHO "*** its dynamic dependency list that programs get resolved with at runtime."
- fi
- fi
- ;;
- *)
- newdeplibs="$newdeplibs $i"
- ;;
- esac
- done
- else
- # Error occurred in the first compile. Let's try to salvage
- # the situation: Compile a separate program for each library.
- for i in $deplibs; do
- case $i in
- -l*)
- func_stripname -l '' "$i"
- name=$func_stripname_result
- $opt_dry_run || $RM conftest
- if $LTCC $LTCFLAGS -o conftest conftest.c $i; then
- ldd_output=`ldd conftest`
- if test "X$allow_libtool_libs_with_static_runtimes" = "Xyes" ; then
- case " $predeps $postdeps " in
- *" $i "*)
- newdeplibs="$newdeplibs $i"
- i=""
- ;;
- esac
- fi
- if test -n "$i" ; then
- libname=`eval "\\$ECHO \"$libname_spec\""`
- deplib_matches=`eval "\\$ECHO \"$library_names_spec\""`
- set dummy $deplib_matches; shift
- deplib_match=$1
- if test `expr "$ldd_output" : ".*$deplib_match"` -ne 0 ; then
- newdeplibs="$newdeplibs $i"
- else
- droppeddeps=yes
- $ECHO
- $ECHO "*** Warning: dynamic linker does not accept needed library $i."
- $ECHO "*** I have the capability to make that library automatically link in when"
- $ECHO "*** you link to this library. But I can only do this if you have a"
- $ECHO "*** shared version of the library, which you do not appear to have"
- $ECHO "*** because a test_compile did reveal that the linker did not use this one"
- $ECHO "*** as a dynamic dependency that programs can get resolved with at runtime."
- fi
- fi
- else
- droppeddeps=yes
- $ECHO
- $ECHO "*** Warning! Library $i is needed by this library but I was not able to"
- $ECHO "*** make it link in! You will probably need to install it or some"
- $ECHO "*** library that it depends on before this library will be fully"
- $ECHO "*** functional. Installing it before continuing would be even better."
- fi
- ;;
- *)
- newdeplibs="$newdeplibs $i"
- ;;
- esac
- done
- fi
- ;;
- file_magic*)
- set dummy $deplibs_check_method; shift
- file_magic_regex=`expr "$deplibs_check_method" : "$1 \(.*\)"`
- for a_deplib in $deplibs; do
- case $a_deplib in
- -l*)
- func_stripname -l '' "$a_deplib"
- name=$func_stripname_result
- if test "X$allow_libtool_libs_with_static_runtimes" = "Xyes" ; then
- case " $predeps $postdeps " in
- *" $a_deplib "*)
- newdeplibs="$newdeplibs $a_deplib"
- a_deplib=""
- ;;
- esac
- fi
- if test -n "$a_deplib" ; then
- libname=`eval "\\$ECHO \"$libname_spec\""`
- for i in $lib_search_path $sys_lib_search_path $shlib_search_path; do
- potential_libs=`ls $i/$libname[.-]* 2>/dev/null`
- for potent_lib in $potential_libs; do
- # Follow soft links.
- if ls -lLd "$potent_lib" 2>/dev/null |
- $GREP " -> " >/dev/null; then
- continue
- fi
- # The statement above tries to avoid entering an
- # endless loop below, in case of cyclic links.
- # We might still enter an endless loop, since a link
- # loop can be closed while we follow links,
- # but so what?
- potlib="$potent_lib"
- while test -h "$potlib" 2>/dev/null; do
- potliblink=`ls -ld $potlib | ${SED} 's/.* -> //'`
- case $potliblink in
- [\\/]* | [A-Za-z]:[\\/]*) potlib="$potliblink";;
- *) potlib=`$ECHO "X$potlib" | $Xsed -e 's,[^/]*$,,'`"$potliblink";;
- esac
- done
- if eval $file_magic_cmd \"\$potlib\" 2>/dev/null |
- $SED -e 10q |
- $EGREP "$file_magic_regex" > /dev/null; then
- newdeplibs="$newdeplibs $a_deplib"
- a_deplib=""
- break 2
- fi
- done
- done
- fi
- if test -n "$a_deplib" ; then
- droppeddeps=yes
- $ECHO
- $ECHO "*** Warning: linker path does not have real file for library $a_deplib."
- $ECHO "*** I have the capability to make that library automatically link in when"
- $ECHO "*** you link to this library. But I can only do this if you have a"
- $ECHO "*** shared version of the library, which you do not appear to have"
- $ECHO "*** because I did check the linker path looking for a file starting"
- if test -z "$potlib" ; then
- $ECHO "*** with $libname but no candidates were found. (...for file magic test)"
- else
- $ECHO "*** with $libname and none of the candidates passed a file format test"
- $ECHO "*** using a file magic. Last file checked: $potlib"
- fi
- fi
- ;;
- *)
- # Add a -L argument.
- newdeplibs="$newdeplibs $a_deplib"
- ;;
- esac
- done # Gone through all deplibs.
- ;;
- match_pattern*)
- set dummy $deplibs_check_method; shift
- match_pattern_regex=`expr "$deplibs_check_method" : "$1 \(.*\)"`
- for a_deplib in $deplibs; do
- case $a_deplib in
- -l*)
- func_stripname -l '' "$a_deplib"
- name=$func_stripname_result
- if test "X$allow_libtool_libs_with_static_runtimes" = "Xyes" ; then
- case " $predeps $postdeps " in
- *" $a_deplib "*)
- newdeplibs="$newdeplibs $a_deplib"
- a_deplib=""
- ;;
- esac
- fi
- if test -n "$a_deplib" ; then
- libname=`eval "\\$ECHO \"$libname_spec\""`
- for i in $lib_search_path $sys_lib_search_path $shlib_search_path; do
- potential_libs=`ls $i/$libname[.-]* 2>/dev/null`
- for potent_lib in $potential_libs; do
- potlib="$potent_lib" # see symlink-check above in file_magic test
- if eval "\$ECHO \"X$potent_lib\"" 2>/dev/null | $Xsed -e 10q | \
- $EGREP "$match_pattern_regex" > /dev/null; then
- newdeplibs="$newdeplibs $a_deplib"
- a_deplib=""
- break 2
- fi
- done
- done
- fi
- if test -n "$a_deplib" ; then
- droppeddeps=yes
- $ECHO
- $ECHO "*** Warning: linker path does not have real file for library $a_deplib."
- $ECHO "*** I have the capability to make that library automatically link in when"
- $ECHO "*** you link to this library. But I can only do this if you have a"
- $ECHO "*** shared version of the library, which you do not appear to have"
- $ECHO "*** because I did check the linker path looking for a file starting"
- if test -z "$potlib" ; then
- $ECHO "*** with $libname but no candidates were found. (...for regex pattern test)"
- else
- $ECHO "*** with $libname and none of the candidates passed a file format test"
- $ECHO "*** using a regex pattern. Last file checked: $potlib"
- fi
- fi
- ;;
- *)
- # Add a -L argument.
- newdeplibs="$newdeplibs $a_deplib"
- ;;
- esac
- done # Gone through all deplibs.
- ;;
- none | unknown | *)
- newdeplibs=""
- tmp_deplibs=`$ECHO "X $deplibs" | $Xsed \
- -e 's/ -lc$//' -e 's/ -[LR][^ ]*//g'`
- if test "X$allow_libtool_libs_with_static_runtimes" = "Xyes" ; then
- for i in $predeps $postdeps ; do
- # can't use Xsed below, because $i might contain '/'
- tmp_deplibs=`$ECHO "X $tmp_deplibs" | $Xsed -e "s,$i,,"`
- done
- fi
- if $ECHO "X $tmp_deplibs" | $Xsed -e 's/[ ]//g' |
- $GREP . >/dev/null; then
- $ECHO
- if test "X$deplibs_check_method" = "Xnone"; then
- $ECHO "*** Warning: inter-library dependencies are not supported in this platform."
- else
- $ECHO "*** Warning: inter-library dependencies are not known to be supported."
- fi
- $ECHO "*** All declared inter-library dependencies are being dropped."
- droppeddeps=yes
- fi
- ;;
- esac
- versuffix=$versuffix_save
- major=$major_save
- release=$release_save
- libname=$libname_save
- name=$name_save
-
- case $host in
- *-*-rhapsody* | *-*-darwin1.[012])
- # On Rhapsody replace the C library with the System framework
- newdeplibs=`$ECHO "X $newdeplibs" | $Xsed -e 's/ -lc / System.ltframework /'`
- ;;
- esac
-
- if test "$droppeddeps" = yes; then
- if test "$module" = yes; then
- $ECHO
- $ECHO "*** Warning: libtool could not satisfy all declared inter-library"
- $ECHO "*** dependencies of module $libname. Therefore, libtool will create"
- $ECHO "*** a static module, that should work as long as the dlopening"
- $ECHO "*** application is linked with the -dlopen flag."
- if test -z "$global_symbol_pipe"; then
- $ECHO
- $ECHO "*** However, this would only work if libtool was able to extract symbol"
- $ECHO "*** lists from a program, using \`nm' or equivalent, but libtool could"
- $ECHO "*** not find such a program. So, this module is probably useless."
- $ECHO "*** \`nm' from GNU binutils and a full rebuild may help."
- fi
- if test "$build_old_libs" = no; then
- oldlibs="$output_objdir/$libname.$libext"
- build_libtool_libs=module
- build_old_libs=yes
- else
- build_libtool_libs=no
- fi
- else
- $ECHO "*** The inter-library dependencies that have been dropped here will be"
- $ECHO "*** automatically added whenever a program is linked with this library"
- $ECHO "*** or is declared to -dlopen it."
-
- if test "$allow_undefined" = no; then
- $ECHO
- $ECHO "*** Since this library must not contain undefined symbols,"
- $ECHO "*** because either the platform does not support them or"
- $ECHO "*** it was explicitly requested with -no-undefined,"
- $ECHO "*** libtool will only create a static version of it."
- if test "$build_old_libs" = no; then
- oldlibs="$output_objdir/$libname.$libext"
- build_libtool_libs=module
- build_old_libs=yes
- else
- build_libtool_libs=no
- fi
- fi
- fi
- fi
- # Done checking deplibs!
- deplibs=$newdeplibs
- fi
- # Time to change all our "foo.ltframework" stuff back to "-framework foo"
- case $host in
- *-*-darwin*)
- newdeplibs=`$ECHO "X $newdeplibs" | $Xsed -e 's% \([^ $]*\).ltframework% -framework \1%g'`
- new_inherited_linker_flags=`$ECHO "X $new_inherited_linker_flags" | $Xsed -e 's% \([^ $]*\).ltframework% -framework \1%g'`
- deplibs=`$ECHO "X $deplibs" | $Xsed -e 's% \([^ $]*\).ltframework% -framework \1%g'`
- ;;
- esac
-
- # move library search paths that coincide with paths to not yet
- # installed libraries to the beginning of the library search list
- new_libs=
- for path in $notinst_path; do
- case " $new_libs " in
- *" -L$path/$objdir "*) ;;
- *)
- case " $deplibs " in
- *" -L$path/$objdir "*)
- new_libs="$new_libs -L$path/$objdir" ;;
- esac
- ;;
- esac
- done
- for deplib in $deplibs; do
- case $deplib in
- -L*)
- case " $new_libs " in
- *" $deplib "*) ;;
- *) new_libs="$new_libs $deplib" ;;
- esac
- ;;
- *) new_libs="$new_libs $deplib" ;;
- esac
- done
- deplibs="$new_libs"
-
- # All the library-specific variables (install_libdir is set above).
- library_names=
- old_library=
- dlname=
-
- # Test again, we may have decided not to build it any more
- if test "$build_libtool_libs" = yes; then
- if test "$hardcode_into_libs" = yes; then
- # Hardcode the library paths
- hardcode_libdirs=
- dep_rpath=
- rpath="$finalize_rpath"
- test "$mode" != relink && rpath="$compile_rpath$rpath"
- for libdir in $rpath; do
- if test -n "$hardcode_libdir_flag_spec"; then
- if test -n "$hardcode_libdir_separator"; then
- if test -z "$hardcode_libdirs"; then
- hardcode_libdirs="$libdir"
- else
- # Just accumulate the unique libdirs.
- case $hardcode_libdir_separator$hardcode_libdirs$hardcode_libdir_separator in
- *"$hardcode_libdir_separator$libdir$hardcode_libdir_separator"*)
- ;;
- *)
- hardcode_libdirs="$hardcode_libdirs$hardcode_libdir_separator$libdir"
- ;;
- esac
- fi
- else
- eval flag=\"$hardcode_libdir_flag_spec\"
- dep_rpath="$dep_rpath $flag"
- fi
- elif test -n "$runpath_var"; then
- case "$perm_rpath " in
- *" $libdir "*) ;;
- *) perm_rpath="$perm_rpath $libdir" ;;
- esac
- fi
- done
- # Substitute the hardcoded libdirs into the rpath.
- if test -n "$hardcode_libdir_separator" &&
- test -n "$hardcode_libdirs"; then
- libdir="$hardcode_libdirs"
- if test -n "$hardcode_libdir_flag_spec_ld"; then
- eval dep_rpath=\"$hardcode_libdir_flag_spec_ld\"
- else
- eval dep_rpath=\"$hardcode_libdir_flag_spec\"
- fi
- fi
- if test -n "$runpath_var" && test -n "$perm_rpath"; then
- # We should set the runpath_var.
- rpath=
- for dir in $perm_rpath; do
- rpath="$rpath$dir:"
- done
- eval "$runpath_var='$rpath\$$runpath_var'; export $runpath_var"
- fi
- test -n "$dep_rpath" && deplibs="$dep_rpath $deplibs"
- fi
-
- shlibpath="$finalize_shlibpath"
- test "$mode" != relink && shlibpath="$compile_shlibpath$shlibpath"
- if test -n "$shlibpath"; then
- eval "$shlibpath_var='$shlibpath\$$shlibpath_var'; export $shlibpath_var"
- fi
-
- # Get the real and link names of the library.
- eval shared_ext=\"$shrext_cmds\"
- eval library_names=\"$library_names_spec\"
- set dummy $library_names
- shift
- realname="$1"
- shift
-
- if test -n "$soname_spec"; then
- eval soname=\"$soname_spec\"
- else
- soname="$realname"
- fi
- if test -z "$dlname"; then
- dlname=$soname
- fi
-
- lib="$output_objdir/$realname"
- linknames=
- for link
- do
- linknames="$linknames $link"
- done
-
- # Use standard objects if they are pic
- test -z "$pic_flag" && libobjs=`$ECHO "X$libobjs" | $SP2NL | $Xsed -e "$lo2o" | $NL2SP`
- test "X$libobjs" = "X " && libobjs=
-
- delfiles=
- if test -n "$export_symbols" && test -n "$include_expsyms"; then
- $opt_dry_run || cp "$export_symbols" "$output_objdir/$libname.uexp"
- export_symbols="$output_objdir/$libname.uexp"
- delfiles="$delfiles $export_symbols"
- fi
-
- orig_export_symbols=
- case $host_os in
- cygwin* | mingw* | cegcc*)
- if test -n "$export_symbols" && test -z "$export_symbols_regex"; then
- # exporting using user supplied symfile
- if test "x`$SED 1q $export_symbols`" != xEXPORTS; then
- # and it's NOT already a .def file. Must figure out
- # which of the given symbols are data symbols and tag
- # them as such. So, trigger use of export_symbols_cmds.
- # export_symbols gets reassigned inside the "prepare
- # the list of exported symbols" if statement, so the
- # include_expsyms logic still works.
- orig_export_symbols="$export_symbols"
- export_symbols=
- always_export_symbols=yes
- fi
- fi
- ;;
- esac
-
- # Prepare the list of exported symbols
- if test -z "$export_symbols"; then
- if test "$always_export_symbols" = yes || test -n "$export_symbols_regex"; then
- func_verbose "generating symbol list for \`$libname.la'"
- export_symbols="$output_objdir/$libname.exp"
- $opt_dry_run || $RM $export_symbols
- cmds=$export_symbols_cmds
- save_ifs="$IFS"; IFS='~'
- for cmd in $cmds; do
- IFS="$save_ifs"
- eval cmd=\"$cmd\"
- func_len " $cmd"
- len=$func_len_result
- if test "$len" -lt "$max_cmd_len" || test "$max_cmd_len" -le -1; then
- func_show_eval "$cmd" 'exit $?'
- skipped_export=false
- else
- # The command line is too long to execute in one step.
- func_verbose "using reloadable object file for export list..."
- skipped_export=:
- # Break out early, otherwise skipped_export may be
- # set to false by a later but shorter cmd.
- break
- fi
- done
- IFS="$save_ifs"
- if test -n "$export_symbols_regex" && test "X$skipped_export" != "X:"; then
- func_show_eval '$EGREP -e "$export_symbols_regex" "$export_symbols" > "${export_symbols}T"'
- func_show_eval '$MV "${export_symbols}T" "$export_symbols"'
- fi
- fi
- fi
-
- if test -n "$export_symbols" && test -n "$include_expsyms"; then
- tmp_export_symbols="$export_symbols"
- test -n "$orig_export_symbols" && tmp_export_symbols="$orig_export_symbols"
- $opt_dry_run || eval '$ECHO "X$include_expsyms" | $Xsed | $SP2NL >> "$tmp_export_symbols"'
- fi
-
- if test "X$skipped_export" != "X:" && test -n "$orig_export_symbols"; then
- # The given exports_symbols file has to be filtered, so filter it.
- func_verbose "filter symbol list for \`$libname.la' to tag DATA exports"
- # FIXME: $output_objdir/$libname.filter potentially contains lots of
- # 's' commands which not all seds can handle. GNU sed should be fine
- # though. Also, the filter scales superlinearly with the number of
- # global variables. join(1) would be nice here, but unfortunately
- # isn't a blessed tool.
- $opt_dry_run || $SED -e '/[ ,]DATA/!d;s,\(.*\)\([ \,].*\),s|^\1$|\1\2|,' < $export_symbols > $output_objdir/$libname.filter
- delfiles="$delfiles $export_symbols $output_objdir/$libname.filter"
- export_symbols=$output_objdir/$libname.def
- $opt_dry_run || $SED -f $output_objdir/$libname.filter < $orig_export_symbols > $export_symbols
- fi
-
- tmp_deplibs=
- for test_deplib in $deplibs; do
- case " $convenience " in
- *" $test_deplib "*) ;;
- *)
- tmp_deplibs="$tmp_deplibs $test_deplib"
- ;;
- esac
- done
- deplibs="$tmp_deplibs"
-
- if test -n "$convenience"; then
- if test -n "$whole_archive_flag_spec" &&
- test "$compiler_needs_object" = yes &&
- test -z "$libobjs"; then
- # extract the archives, so we have objects to list.
- # TODO: could optimize this to just extract one archive.
- whole_archive_flag_spec=
- fi
- if test -n "$whole_archive_flag_spec"; then
- save_libobjs=$libobjs
- eval libobjs=\"\$libobjs $whole_archive_flag_spec\"
- test "X$libobjs" = "X " && libobjs=
- else
- gentop="$output_objdir/${outputname}x"
- generated="$generated $gentop"
-
- func_extract_archives $gentop $convenience
- libobjs="$libobjs $func_extract_archives_result"
- test "X$libobjs" = "X " && libobjs=
- fi
- fi
-
- if test "$thread_safe" = yes && test -n "$thread_safe_flag_spec"; then
- eval flag=\"$thread_safe_flag_spec\"
- linker_flags="$linker_flags $flag"
- fi
-
- # Make a backup of the uninstalled library when relinking
- if test "$mode" = relink; then
- $opt_dry_run || eval '(cd $output_objdir && $RM ${realname}U && $MV $realname ${realname}U)' || exit $?
- fi
-
- # Do each of the archive commands.
- if test "$module" = yes && test -n "$module_cmds" ; then
- if test -n "$export_symbols" && test -n "$module_expsym_cmds"; then
- eval test_cmds=\"$module_expsym_cmds\"
- cmds=$module_expsym_cmds
- else
- eval test_cmds=\"$module_cmds\"
- cmds=$module_cmds
- fi
- else
- if test -n "$export_symbols" && test -n "$archive_expsym_cmds"; then
- eval test_cmds=\"$archive_expsym_cmds\"
- cmds=$archive_expsym_cmds
- else
- eval test_cmds=\"$archive_cmds\"
- cmds=$archive_cmds
- fi
- fi
-
- if test "X$skipped_export" != "X:" &&
- func_len " $test_cmds" &&
- len=$func_len_result &&
- test "$len" -lt "$max_cmd_len" || test "$max_cmd_len" -le -1; then
- :
- else
- # The command line is too long to link in one step, link piecewise
- # or, if using GNU ld and skipped_export is not :, use a linker
- # script.
-
- # Save the value of $output and $libobjs because we want to
- # use them later. If we have whole_archive_flag_spec, we
- # want to use save_libobjs as it was before
- # whole_archive_flag_spec was expanded, because we can't
- # assume the linker understands whole_archive_flag_spec.
- # This may have to be revisited, in case too many
- # convenience libraries get linked in and end up exceeding
- # the spec.
- if test -z "$convenience" || test -z "$whole_archive_flag_spec"; then
- save_libobjs=$libobjs
- fi
- save_output=$output
- output_la=`$ECHO "X$output" | $Xsed -e "$basename"`
-
- # Clear the reloadable object creation command queue and
- # initialize k to one.
- test_cmds=
- concat_cmds=
- objlist=
- last_robj=
- k=1
-
- if test -n "$save_libobjs" && test "X$skipped_export" != "X:" && test "$with_gnu_ld" = yes; then
- output=${output_objdir}/${output_la}.lnkscript
- func_verbose "creating GNU ld script: $output"
- $ECHO 'INPUT (' > $output
- for obj in $save_libobjs
- do
- $ECHO "$obj" >> $output
- done
- $ECHO ')' >> $output
- delfiles="$delfiles $output"
- elif test -n "$save_libobjs" && test "X$skipped_export" != "X:" && test "X$file_list_spec" != X; then
- output=${output_objdir}/${output_la}.lnk
- func_verbose "creating linker input file list: $output"
- : > $output
- set x $save_libobjs
- shift
- firstobj=
- if test "$compiler_needs_object" = yes; then
- firstobj="$1 "
- shift
- fi
- for obj
- do
- $ECHO "$obj" >> $output
- done
- delfiles="$delfiles $output"
- output=$firstobj\"$file_list_spec$output\"
- else
- if test -n "$save_libobjs"; then
- func_verbose "creating reloadable object files..."
- output=$output_objdir/$output_la-${k}.$objext
- eval test_cmds=\"$reload_cmds\"
- func_len " $test_cmds"
- len0=$func_len_result
- len=$len0
-
- # Loop over the list of objects to be linked.
- for obj in $save_libobjs
- do
- func_len " $obj"
- func_arith $len + $func_len_result
- len=$func_arith_result
- if test "X$objlist" = X ||
- test "$len" -lt "$max_cmd_len"; then
- func_append objlist " $obj"
- else
- # The command $test_cmds is almost too long, add a
- # command to the queue.
- if test "$k" -eq 1 ; then
- # The first file doesn't have a previous command to add.
- eval concat_cmds=\"$reload_cmds $objlist $last_robj\"
- else
- # All subsequent reloadable object files will link in
- # the last one created.
- eval concat_cmds=\"\$concat_cmds~$reload_cmds $objlist $last_robj~\$RM $last_robj\"
- fi
- last_robj=$output_objdir/$output_la-${k}.$objext
- func_arith $k + 1
- k=$func_arith_result
- output=$output_objdir/$output_la-${k}.$objext
- objlist=$obj
- func_len " $last_robj"
- func_arith $len0 + $func_len_result
- len=$func_arith_result
- fi
- done
- # Handle the remaining objects by creating one last
- # reloadable object file. All subsequent reloadable object
- # files will link in the last one created.
- test -z "$concat_cmds" || concat_cmds=$concat_cmds~
- eval concat_cmds=\"\${concat_cmds}$reload_cmds $objlist $last_robj\"
- if test -n "$last_robj"; then
- eval concat_cmds=\"\${concat_cmds}~\$RM $last_robj\"
- fi
- delfiles="$delfiles $output"
-
- else
- output=
- fi
-
- if ${skipped_export-false}; then
- func_verbose "generating symbol list for \`$libname.la'"
- export_symbols="$output_objdir/$libname.exp"
- $opt_dry_run || $RM $export_symbols
- libobjs=$output
- # Append the command to create the export file.
- test -z "$concat_cmds" || concat_cmds=$concat_cmds~
- eval concat_cmds=\"\$concat_cmds$export_symbols_cmds\"
- if test -n "$last_robj"; then
- eval concat_cmds=\"\$concat_cmds~\$RM $last_robj\"
- fi
- fi
-
- test -n "$save_libobjs" &&
- func_verbose "creating a temporary reloadable object file: $output"
-
- # Loop through the commands generated above and execute them.
- save_ifs="$IFS"; IFS='~'
- for cmd in $concat_cmds; do
- IFS="$save_ifs"
- $opt_silent || {
- func_quote_for_expand "$cmd"
- eval "func_echo $func_quote_for_expand_result"
- }
- $opt_dry_run || eval "$cmd" || {
- lt_exit=$?
-
- # Restore the uninstalled library and exit
- if test "$mode" = relink; then
- ( cd "$output_objdir" && \
- $RM "${realname}T" && \
- $MV "${realname}U" "$realname" )
- fi
-
- exit $lt_exit
- }
- done
- IFS="$save_ifs"
-
- if test -n "$export_symbols_regex" && ${skipped_export-false}; then
- func_show_eval '$EGREP -e "$export_symbols_regex" "$export_symbols" > "${export_symbols}T"'
- func_show_eval '$MV "${export_symbols}T" "$export_symbols"'
- fi
- fi
-
- if ${skipped_export-false}; then
- if test -n "$export_symbols" && test -n "$include_expsyms"; then
- tmp_export_symbols="$export_symbols"
- test -n "$orig_export_symbols" && tmp_export_symbols="$orig_export_symbols"
- $opt_dry_run || eval '$ECHO "X$include_expsyms" | $Xsed | $SP2NL >> "$tmp_export_symbols"'
- fi
-
- if test -n "$orig_export_symbols"; then
- # The given exports_symbols file has to be filtered, so filter it.
- func_verbose "filter symbol list for \`$libname.la' to tag DATA exports"
- # FIXME: $output_objdir/$libname.filter potentially contains lots of
- # 's' commands which not all seds can handle. GNU sed should be fine
- # though. Also, the filter scales superlinearly with the number of
- # global variables. join(1) would be nice here, but unfortunately
- # isn't a blessed tool.
- $opt_dry_run || $SED -e '/[ ,]DATA/!d;s,\(.*\)\([ \,].*\),s|^\1$|\1\2|,' < $export_symbols > $output_objdir/$libname.filter
- delfiles="$delfiles $export_symbols $output_objdir/$libname.filter"
- export_symbols=$output_objdir/$libname.def
- $opt_dry_run || $SED -f $output_objdir/$libname.filter < $orig_export_symbols > $export_symbols
- fi
- fi
-
- libobjs=$output
- # Restore the value of output.
- output=$save_output
-
- if test -n "$convenience" && test -n "$whole_archive_flag_spec"; then
- eval libobjs=\"\$libobjs $whole_archive_flag_spec\"
- test "X$libobjs" = "X " && libobjs=
- fi
- # Expand the library linking commands again to reset the
- # value of $libobjs for piecewise linking.
-
- # Do each of the archive commands.
- if test "$module" = yes && test -n "$module_cmds" ; then
- if test -n "$export_symbols" && test -n "$module_expsym_cmds"; then
- cmds=$module_expsym_cmds
- else
- cmds=$module_cmds
- fi
- else
- if test -n "$export_symbols" && test -n "$archive_expsym_cmds"; then
- cmds=$archive_expsym_cmds
- else
- cmds=$archive_cmds
- fi
- fi
- fi
-
- if test -n "$delfiles"; then
- # Append the command to remove temporary files to $cmds.
- eval cmds=\"\$cmds~\$RM $delfiles\"
- fi
-
- # Add any objects from preloaded convenience libraries
- if test -n "$dlprefiles"; then
- gentop="$output_objdir/${outputname}x"
- generated="$generated $gentop"
-
- func_extract_archives $gentop $dlprefiles
- libobjs="$libobjs $func_extract_archives_result"
- test "X$libobjs" = "X " && libobjs=
- fi
-
- save_ifs="$IFS"; IFS='~'
- for cmd in $cmds; do
- IFS="$save_ifs"
- eval cmd=\"$cmd\"
- $opt_silent || {
- func_quote_for_expand "$cmd"
- eval "func_echo $func_quote_for_expand_result"
- }
- $opt_dry_run || eval "$cmd" || {
- lt_exit=$?
-
- # Restore the uninstalled library and exit
- if test "$mode" = relink; then
- ( cd "$output_objdir" && \
- $RM "${realname}T" && \
- $MV "${realname}U" "$realname" )
- fi
-
- exit $lt_exit
- }
- done
- IFS="$save_ifs"
-
- # Restore the uninstalled library and exit
- if test "$mode" = relink; then
- $opt_dry_run || eval '(cd $output_objdir && $RM ${realname}T && $MV $realname ${realname}T && $MV ${realname}U $realname)' || exit $?
-
- if test -n "$convenience"; then
- if test -z "$whole_archive_flag_spec"; then
- func_show_eval '${RM}r "$gentop"'
- fi
- fi
-
- exit $EXIT_SUCCESS
- fi
-
- # Create links to the real library.
- for linkname in $linknames; do
- if test "$realname" != "$linkname"; then
- func_show_eval '(cd "$output_objdir" && $RM "$linkname" && $LN_S "$realname" "$linkname")' 'exit $?'
- fi
- done
-
- # If -module or -export-dynamic was specified, set the dlname.
- if test "$module" = yes || test "$export_dynamic" = yes; then
- # On all known operating systems, these are identical.
- dlname="$soname"
- fi
- fi
- ;;
-
- obj)
- if test -n "$dlfiles$dlprefiles" || test "$dlself" != no; then
- func_warning "\`-dlopen' is ignored for objects"
- fi
-
- case " $deplibs" in
- *\ -l* | *\ -L*)
- func_warning "\`-l' and \`-L' are ignored for objects" ;;
- esac
-
- test -n "$rpath" && \
- func_warning "\`-rpath' is ignored for objects"
-
- test -n "$xrpath" && \
- func_warning "\`-R' is ignored for objects"
-
- test -n "$vinfo" && \
- func_warning "\`-version-info' is ignored for objects"
-
- test -n "$release" && \
- func_warning "\`-release' is ignored for objects"
-
- case $output in
- *.lo)
- test -n "$objs$old_deplibs" && \
- func_fatal_error "cannot build library object \`$output' from non-libtool objects"
-
- libobj=$output
- func_lo2o "$libobj"
- obj=$func_lo2o_result
- ;;
- *)
- libobj=
- obj="$output"
- ;;
- esac
-
- # Delete the old objects.
- $opt_dry_run || $RM $obj $libobj
-
- # Objects from convenience libraries. This assumes
- # single-version convenience libraries. Whenever we create
- # different ones for PIC/non-PIC, this we'll have to duplicate
- # the extraction.
- reload_conv_objs=
- gentop=
- # reload_cmds runs $LD directly, so let us get rid of
- # -Wl from whole_archive_flag_spec and hope we can get by with
- # turning comma into space..
- wl=
-
- if test -n "$convenience"; then
- if test -n "$whole_archive_flag_spec"; then
- eval tmp_whole_archive_flags=\"$whole_archive_flag_spec\"
- reload_conv_objs=$reload_objs\ `$ECHO "X$tmp_whole_archive_flags" | $Xsed -e 's|,| |g'`
- else
- gentop="$output_objdir/${obj}x"
- generated="$generated $gentop"
-
- func_extract_archives $gentop $convenience
- reload_conv_objs="$reload_objs $func_extract_archives_result"
- fi
- fi
-
- # Create the old-style object.
- reload_objs="$objs$old_deplibs "`$ECHO "X$libobjs" | $SP2NL | $Xsed -e '/\.'${libext}$'/d' -e '/\.lib$/d' -e "$lo2o" | $NL2SP`" $reload_conv_objs" ### testsuite: skip nested quoting test
-
- output="$obj"
- func_execute_cmds "$reload_cmds" 'exit $?'
-
- # Exit if we aren't doing a library object file.
- if test -z "$libobj"; then
- if test -n "$gentop"; then
- func_show_eval '${RM}r "$gentop"'
- fi
-
- exit $EXIT_SUCCESS
- fi
-
- if test "$build_libtool_libs" != yes; then
- if test -n "$gentop"; then
- func_show_eval '${RM}r "$gentop"'
- fi
-
- # Create an invalid libtool object if no PIC, so that we don't
- # accidentally link it into a program.
- # $show "echo timestamp > $libobj"
- # $opt_dry_run || eval "echo timestamp > $libobj" || exit $?
- exit $EXIT_SUCCESS
- fi
-
- if test -n "$pic_flag" || test "$pic_mode" != default; then
- # Only do commands if we really have different PIC objects.
- reload_objs="$libobjs $reload_conv_objs"
- output="$libobj"
- func_execute_cmds "$reload_cmds" 'exit $?'
- fi
-
- if test -n "$gentop"; then
- func_show_eval '${RM}r "$gentop"'
- fi
-
- exit $EXIT_SUCCESS
- ;;
-
- prog)
- case $host in
- *cygwin*) func_stripname '' '.exe' "$output"
- output=$func_stripname_result.exe;;
- esac
- test -n "$vinfo" && \
- func_warning "\`-version-info' is ignored for programs"
-
- test -n "$release" && \
- func_warning "\`-release' is ignored for programs"
-
- test "$preload" = yes \
- && test "$dlopen_support" = unknown \
- && test "$dlopen_self" = unknown \
- && test "$dlopen_self_static" = unknown && \
- func_warning "\`LT_INIT([dlopen])' not used. Assuming no dlopen support."
-
- case $host in
- *-*-rhapsody* | *-*-darwin1.[012])
- # On Rhapsody replace the C library is the System framework
- compile_deplibs=`$ECHO "X $compile_deplibs" | $Xsed -e 's/ -lc / System.ltframework /'`
- finalize_deplibs=`$ECHO "X $finalize_deplibs" | $Xsed -e 's/ -lc / System.ltframework /'`
- ;;
- esac
-
- case $host in
- *-*-darwin*)
- # Don't allow lazy linking, it breaks C++ global constructors
- # But is supposedly fixed on 10.4 or later (yay!).
- if test "$tagname" = CXX ; then
- case ${MACOSX_DEPLOYMENT_TARGET-10.0} in
- 10.[0123])
- compile_command="$compile_command ${wl}-bind_at_load"
- finalize_command="$finalize_command ${wl}-bind_at_load"
- ;;
- esac
- fi
- # Time to change all our "foo.ltframework" stuff back to "-framework foo"
- compile_deplibs=`$ECHO "X $compile_deplibs" | $Xsed -e 's% \([^ $]*\).ltframework% -framework \1%g'`
- finalize_deplibs=`$ECHO "X $finalize_deplibs" | $Xsed -e 's% \([^ $]*\).ltframework% -framework \1%g'`
- ;;
- esac
-
-
- # move library search paths that coincide with paths to not yet
- # installed libraries to the beginning of the library search list
- new_libs=
- for path in $notinst_path; do
- case " $new_libs " in
- *" -L$path/$objdir "*) ;;
- *)
- case " $compile_deplibs " in
- *" -L$path/$objdir "*)
- new_libs="$new_libs -L$path/$objdir" ;;
- esac
- ;;
- esac
- done
- for deplib in $compile_deplibs; do
- case $deplib in
- -L*)
- case " $new_libs " in
- *" $deplib "*) ;;
- *) new_libs="$new_libs $deplib" ;;
- esac
- ;;
- *) new_libs="$new_libs $deplib" ;;
- esac
- done
- compile_deplibs="$new_libs"
-
-
- compile_command="$compile_command $compile_deplibs"
- finalize_command="$finalize_command $finalize_deplibs"
-
- if test -n "$rpath$xrpath"; then
- # If the user specified any rpath flags, then add them.
- for libdir in $rpath $xrpath; do
- # This is the magic to use -rpath.
- case "$finalize_rpath " in
- *" $libdir "*) ;;
- *) finalize_rpath="$finalize_rpath $libdir" ;;
- esac
- done
- fi
-
- # Now hardcode the library paths
- rpath=
- hardcode_libdirs=
- for libdir in $compile_rpath $finalize_rpath; do
- if test -n "$hardcode_libdir_flag_spec"; then
- if test -n "$hardcode_libdir_separator"; then
- if test -z "$hardcode_libdirs"; then
- hardcode_libdirs="$libdir"
- else
- # Just accumulate the unique libdirs.
- case $hardcode_libdir_separator$hardcode_libdirs$hardcode_libdir_separator in
- *"$hardcode_libdir_separator$libdir$hardcode_libdir_separator"*)
- ;;
- *)
- hardcode_libdirs="$hardcode_libdirs$hardcode_libdir_separator$libdir"
- ;;
- esac
- fi
- else
- eval flag=\"$hardcode_libdir_flag_spec\"
- rpath="$rpath $flag"
- fi
- elif test -n "$runpath_var"; then
- case "$perm_rpath " in
- *" $libdir "*) ;;
- *) perm_rpath="$perm_rpath $libdir" ;;
- esac
- fi
- case $host in
- *-*-cygwin* | *-*-mingw* | *-*-pw32* | *-*-os2* | *-cegcc*)
- testbindir=`${ECHO} "$libdir" | ${SED} -e 's*/lib$*/bin*'`
- case :$dllsearchpath: in
- *":$libdir:"*) ;;
- ::) dllsearchpath=$libdir;;
- *) dllsearchpath="$dllsearchpath:$libdir";;
- esac
- case :$dllsearchpath: in
- *":$testbindir:"*) ;;
- ::) dllsearchpath=$testbindir;;
- *) dllsearchpath="$dllsearchpath:$testbindir";;
- esac
- ;;
- esac
- done
- # Substitute the hardcoded libdirs into the rpath.
- if test -n "$hardcode_libdir_separator" &&
- test -n "$hardcode_libdirs"; then
- libdir="$hardcode_libdirs"
- eval rpath=\" $hardcode_libdir_flag_spec\"
- fi
- compile_rpath="$rpath"
-
- rpath=
- hardcode_libdirs=
- for libdir in $finalize_rpath; do
- if test -n "$hardcode_libdir_flag_spec"; then
- if test -n "$hardcode_libdir_separator"; then
- if test -z "$hardcode_libdirs"; then
- hardcode_libdirs="$libdir"
- else
- # Just accumulate the unique libdirs.
- case $hardcode_libdir_separator$hardcode_libdirs$hardcode_libdir_separator in
- *"$hardcode_libdir_separator$libdir$hardcode_libdir_separator"*)
- ;;
- *)
- hardcode_libdirs="$hardcode_libdirs$hardcode_libdir_separator$libdir"
- ;;
- esac
- fi
- else
- eval flag=\"$hardcode_libdir_flag_spec\"
- rpath="$rpath $flag"
- fi
- elif test -n "$runpath_var"; then
- case "$finalize_perm_rpath " in
- *" $libdir "*) ;;
- *) finalize_perm_rpath="$finalize_perm_rpath $libdir" ;;
- esac
- fi
- done
- # Substitute the hardcoded libdirs into the rpath.
- if test -n "$hardcode_libdir_separator" &&
- test -n "$hardcode_libdirs"; then
- libdir="$hardcode_libdirs"
- eval rpath=\" $hardcode_libdir_flag_spec\"
- fi
- finalize_rpath="$rpath"
-
- if test -n "$libobjs" && test "$build_old_libs" = yes; then
- # Transform all the library objects into standard objects.
- compile_command=`$ECHO "X$compile_command" | $SP2NL | $Xsed -e "$lo2o" | $NL2SP`
- finalize_command=`$ECHO "X$finalize_command" | $SP2NL | $Xsed -e "$lo2o" | $NL2SP`
- fi
-
- func_generate_dlsyms "$outputname" "@PROGRAM@" "no"
-
- # template prelinking step
- if test -n "$prelink_cmds"; then
- func_execute_cmds "$prelink_cmds" 'exit $?'
- fi
-
- wrappers_required=yes
- case $host in
- *cygwin* | *mingw* )
- if test "$build_libtool_libs" != yes; then
- wrappers_required=no
- fi
- ;;
- *cegcc)
- # Disable wrappers for cegcc, we are cross compiling anyway.
- wrappers_required=no
- ;;
- *)
- if test "$need_relink" = no || test "$build_libtool_libs" != yes; then
- wrappers_required=no
- fi
- ;;
- esac
- if test "$wrappers_required" = no; then
- # Replace the output file specification.
- compile_command=`$ECHO "X$compile_command" | $Xsed -e 's%@OUTPUT@%'"$output"'%g'`
- link_command="$compile_command$compile_rpath"
-
- # We have no uninstalled library dependencies, so finalize right now.
- exit_status=0
- func_show_eval "$link_command" 'exit_status=$?'
-
- # Delete the generated files.
- if test -f "$output_objdir/${outputname}S.${objext}"; then
- func_show_eval '$RM "$output_objdir/${outputname}S.${objext}"'
- fi
-
- exit $exit_status
- fi
-
- if test -n "$compile_shlibpath$finalize_shlibpath"; then
- compile_command="$shlibpath_var=\"$compile_shlibpath$finalize_shlibpath\$$shlibpath_var\" $compile_command"
- fi
- if test -n "$finalize_shlibpath"; then
- finalize_command="$shlibpath_var=\"$finalize_shlibpath\$$shlibpath_var\" $finalize_command"
- fi
-
- compile_var=
- finalize_var=
- if test -n "$runpath_var"; then
- if test -n "$perm_rpath"; then
- # We should set the runpath_var.
- rpath=
- for dir in $perm_rpath; do
- rpath="$rpath$dir:"
- done
- compile_var="$runpath_var=\"$rpath\$$runpath_var\" "
- fi
- if test -n "$finalize_perm_rpath"; then
- # We should set the runpath_var.
- rpath=
- for dir in $finalize_perm_rpath; do
- rpath="$rpath$dir:"
- done
- finalize_var="$runpath_var=\"$rpath\$$runpath_var\" "
- fi
- fi
-
- if test "$no_install" = yes; then
- # We don't need to create a wrapper script.
- link_command="$compile_var$compile_command$compile_rpath"
- # Replace the output file specification.
- link_command=`$ECHO "X$link_command" | $Xsed -e 's%@OUTPUT@%'"$output"'%g'`
- # Delete the old output file.
- $opt_dry_run || $RM $output
- # Link the executable and exit
- func_show_eval "$link_command" 'exit $?'
- exit $EXIT_SUCCESS
- fi
-
- if test "$hardcode_action" = relink; then
- # Fast installation is not supported
- link_command="$compile_var$compile_command$compile_rpath"
- relink_command="$finalize_var$finalize_command$finalize_rpath"
-
- func_warning "this platform does not like uninstalled shared libraries"
- func_warning "\`$output' will be relinked during installation"
- else
- if test "$fast_install" != no; then
- link_command="$finalize_var$compile_command$finalize_rpath"
- if test "$fast_install" = yes; then
- relink_command=`$ECHO "X$compile_var$compile_command$compile_rpath" | $Xsed -e 's%@OUTPUT@%\$progdir/\$file%g'`
- else
- # fast_install is set to needless
- relink_command=
- fi
- else
- link_command="$compile_var$compile_command$compile_rpath"
- relink_command="$finalize_var$finalize_command$finalize_rpath"
- fi
- fi
-
- # Replace the output file specification.
- link_command=`$ECHO "X$link_command" | $Xsed -e 's%@OUTPUT@%'"$output_objdir/$outputname"'%g'`
-
- # Delete the old output files.
- $opt_dry_run || $RM $output $output_objdir/$outputname $output_objdir/lt-$outputname
-
- func_show_eval "$link_command" 'exit $?'
-
- # Now create the wrapper script.
- func_verbose "creating $output"
-
- # Quote the relink command for shipping.
- if test -n "$relink_command"; then
- # Preserve any variables that may affect compiler behavior
- for var in $variables_saved_for_relink; do
- if eval test -z \"\${$var+set}\"; then
- relink_command="{ test -z \"\${$var+set}\" || $lt_unset $var || { $var=; export $var; }; }; $relink_command"
- elif eval var_value=\$$var; test -z "$var_value"; then
- relink_command="$var=; export $var; $relink_command"
- else
- func_quote_for_eval "$var_value"
- relink_command="$var=$func_quote_for_eval_result; export $var; $relink_command"
- fi
- done
- relink_command="(cd `pwd`; $relink_command)"
- relink_command=`$ECHO "X$relink_command" | $Xsed -e "$sed_quote_subst"`
- fi
-
- # Quote $ECHO for shipping.
- if test "X$ECHO" = "X$SHELL $progpath --fallback-echo"; then
- case $progpath in
- [\\/]* | [A-Za-z]:[\\/]*) qecho="$SHELL $progpath --fallback-echo";;
- *) qecho="$SHELL `pwd`/$progpath --fallback-echo";;
- esac
- qecho=`$ECHO "X$qecho" | $Xsed -e "$sed_quote_subst"`
- else
- qecho=`$ECHO "X$ECHO" | $Xsed -e "$sed_quote_subst"`
- fi
-
- # Only actually do things if not in dry run mode.
- $opt_dry_run || {
- # win32 will think the script is a binary if it has
- # a .exe suffix, so we strip it off here.
- case $output in
- *.exe) func_stripname '' '.exe' "$output"
- output=$func_stripname_result ;;
- esac
- # test for cygwin because mv fails w/o .exe extensions
- case $host in
- *cygwin*)
- exeext=.exe
- func_stripname '' '.exe' "$outputname"
- outputname=$func_stripname_result ;;
- *) exeext= ;;
- esac
- case $host in
- *cygwin* | *mingw* )
- func_dirname_and_basename "$output" "" "."
- output_name=$func_basename_result
- output_path=$func_dirname_result
- cwrappersource="$output_path/$objdir/lt-$output_name.c"
- cwrapper="$output_path/$output_name.exe"
- $RM $cwrappersource $cwrapper
- trap "$RM $cwrappersource $cwrapper; exit $EXIT_FAILURE" 1 2 15
-
- func_emit_cwrapperexe_src > $cwrappersource
-
- # The wrapper executable is built using the $host compiler,
- # because it contains $host paths and files. If cross-
- # compiling, it, like the target executable, must be
- # executed on the $host or under an emulation environment.
- $opt_dry_run || {
- $LTCC $LTCFLAGS -o $cwrapper $cwrappersource
- $STRIP $cwrapper
- }
-
- # Now, create the wrapper script for func_source use:
- func_ltwrapper_scriptname $cwrapper
- $RM $func_ltwrapper_scriptname_result
- trap "$RM $func_ltwrapper_scriptname_result; exit $EXIT_FAILURE" 1 2 15
- $opt_dry_run || {
- # note: this script will not be executed, so do not chmod.
- if test "x$build" = "x$host" ; then
- $cwrapper --lt-dump-script > $func_ltwrapper_scriptname_result
- else
- func_emit_wrapper no > $func_ltwrapper_scriptname_result
- fi
- }
- ;;
- * )
- $RM $output
- trap "$RM $output; exit $EXIT_FAILURE" 1 2 15
-
- func_emit_wrapper no > $output
- chmod +x $output
- ;;
- esac
- }
- exit $EXIT_SUCCESS
- ;;
- esac
-
- # See if we need to build an old-fashioned archive.
- for oldlib in $oldlibs; do
-
- if test "$build_libtool_libs" = convenience; then
- oldobjs="$libobjs_save $symfileobj"
- addlibs="$convenience"
- build_libtool_libs=no
- else
- if test "$build_libtool_libs" = module; then
- oldobjs="$libobjs_save"
- build_libtool_libs=no
- else
- oldobjs="$old_deplibs $non_pic_objects"
- if test "$preload" = yes && test -f "$symfileobj"; then
- oldobjs="$oldobjs $symfileobj"
- fi
- fi
- addlibs="$old_convenience"
- fi
-
- if test -n "$addlibs"; then
- gentop="$output_objdir/${outputname}x"
- generated="$generated $gentop"
-
- func_extract_archives $gentop $addlibs
- oldobjs="$oldobjs $func_extract_archives_result"
- fi
-
- # Do each command in the archive commands.
- if test -n "$old_archive_from_new_cmds" && test "$build_libtool_libs" = yes; then
- cmds=$old_archive_from_new_cmds
- else
-
- # Add any objects from preloaded convenience libraries
- if test -n "$dlprefiles"; then
- gentop="$output_objdir/${outputname}x"
- generated="$generated $gentop"
-
- func_extract_archives $gentop $dlprefiles
- oldobjs="$oldobjs $func_extract_archives_result"
- fi
-
- # POSIX demands no paths to be encoded in archives. We have
- # to avoid creating archives with duplicate basenames if we
- # might have to extract them afterwards, e.g., when creating a
- # static archive out of a convenience library, or when linking
- # the entirety of a libtool archive into another (currently
- # not supported by libtool).
- if (for obj in $oldobjs
- do
- func_basename "$obj"
- $ECHO "$func_basename_result"
- done | sort | sort -uc >/dev/null 2>&1); then
- :
- else
- $ECHO "copying selected object files to avoid basename conflicts..."
- gentop="$output_objdir/${outputname}x"
- generated="$generated $gentop"
- func_mkdir_p "$gentop"
- save_oldobjs=$oldobjs
- oldobjs=
- counter=1
- for obj in $save_oldobjs
- do
- func_basename "$obj"
- objbase="$func_basename_result"
- case " $oldobjs " in
- " ") oldobjs=$obj ;;
- *[\ /]"$objbase "*)
- while :; do
- # Make sure we don't pick an alternate name that also
- # overlaps.
- newobj=lt$counter-$objbase
- func_arith $counter + 1
- counter=$func_arith_result
- case " $oldobjs " in
- *[\ /]"$newobj "*) ;;
- *) if test ! -f "$gentop/$newobj"; then break; fi ;;
- esac
- done
- func_show_eval "ln $obj $gentop/$newobj || cp $obj $gentop/$newobj"
- oldobjs="$oldobjs $gentop/$newobj"
- ;;
- *) oldobjs="$oldobjs $obj" ;;
- esac
- done
- fi
- eval cmds=\"$old_archive_cmds\"
-
- func_len " $cmds"
- len=$func_len_result
- if test "$len" -lt "$max_cmd_len" || test "$max_cmd_len" -le -1; then
- cmds=$old_archive_cmds
- else
- # the command line is too long to link in one step, link in parts
- func_verbose "using piecewise archive linking..."
- save_RANLIB=$RANLIB
- RANLIB=:
- objlist=
- concat_cmds=
- save_oldobjs=$oldobjs
- oldobjs=
- # Is there a better way of finding the last object in the list?
- for obj in $save_oldobjs
- do
- last_oldobj=$obj
- done
- eval test_cmds=\"$old_archive_cmds\"
- func_len " $test_cmds"
- len0=$func_len_result
- len=$len0
- for obj in $save_oldobjs
- do
- func_len " $obj"
- func_arith $len + $func_len_result
- len=$func_arith_result
- func_append objlist " $obj"
- if test "$len" -lt "$max_cmd_len"; then
- :
- else
- # the above command should be used before it gets too long
- oldobjs=$objlist
- if test "$obj" = "$last_oldobj" ; then
- RANLIB=$save_RANLIB
- fi
- test -z "$concat_cmds" || concat_cmds=$concat_cmds~
- eval concat_cmds=\"\${concat_cmds}$old_archive_cmds\"
- objlist=
- len=$len0
- fi
- done
- RANLIB=$save_RANLIB
- oldobjs=$objlist
- if test "X$oldobjs" = "X" ; then
- eval cmds=\"\$concat_cmds\"
- else
- eval cmds=\"\$concat_cmds~\$old_archive_cmds\"
- fi
- fi
- fi
- func_execute_cmds "$cmds" 'exit $?'
- done
-
- test -n "$generated" && \
- func_show_eval "${RM}r$generated"
-
- # Now create the libtool archive.
- case $output in
- *.la)
- old_library=
- test "$build_old_libs" = yes && old_library="$libname.$libext"
- func_verbose "creating $output"
-
- # Preserve any variables that may affect compiler behavior
- for var in $variables_saved_for_relink; do
- if eval test -z \"\${$var+set}\"; then
- relink_command="{ test -z \"\${$var+set}\" || $lt_unset $var || { $var=; export $var; }; }; $relink_command"
- elif eval var_value=\$$var; test -z "$var_value"; then
- relink_command="$var=; export $var; $relink_command"
- else
- func_quote_for_eval "$var_value"
- relink_command="$var=$func_quote_for_eval_result; export $var; $relink_command"
- fi
- done
- # Quote the link command for shipping.
- relink_command="(cd `pwd`; $SHELL $progpath $preserve_args --mode=relink $libtool_args @inst_prefix_dir@)"
- relink_command=`$ECHO "X$relink_command" | $Xsed -e "$sed_quote_subst"`
- if test "$hardcode_automatic" = yes ; then
- relink_command=
- fi
-
- # Only create the output if not a dry run.
- $opt_dry_run || {
- for installed in no yes; do
- if test "$installed" = yes; then
- if test -z "$install_libdir"; then
- break
- fi
- output="$output_objdir/$outputname"i
- # Replace all uninstalled libtool libraries with the installed ones
- newdependency_libs=
- for deplib in $dependency_libs; do
- case $deplib in
- *.la)
- func_basename "$deplib"
- name="$func_basename_result"
- eval libdir=`${SED} -n -e 's/^libdir=\(.*\)$/\1/p' $deplib`
- test -z "$libdir" && \
- func_fatal_error "\`$deplib' is not a valid libtool archive"
- newdependency_libs="$newdependency_libs $libdir/$name"
- ;;
- *) newdependency_libs="$newdependency_libs $deplib" ;;
- esac
- done
- dependency_libs="$newdependency_libs"
- newdlfiles=
-
- for lib in $dlfiles; do
- case $lib in
- *.la)
- func_basename "$lib"
- name="$func_basename_result"
- eval libdir=`${SED} -n -e 's/^libdir=\(.*\)$/\1/p' $lib`
- test -z "$libdir" && \
- func_fatal_error "\`$lib' is not a valid libtool archive"
- newdlfiles="$newdlfiles $libdir/$name"
- ;;
- *) newdlfiles="$newdlfiles $lib" ;;
- esac
- done
- dlfiles="$newdlfiles"
- newdlprefiles=
- for lib in $dlprefiles; do
- case $lib in
- *.la)
- # Only pass preopened files to the pseudo-archive (for
- # eventual linking with the app. that links it) if we
- # didn't already link the preopened objects directly into
- # the library:
- func_basename "$lib"
- name="$func_basename_result"
- eval libdir=`${SED} -n -e 's/^libdir=\(.*\)$/\1/p' $lib`
- test -z "$libdir" && \
- func_fatal_error "\`$lib' is not a valid libtool archive"
- newdlprefiles="$newdlprefiles $libdir/$name"
- ;;
- esac
- done
- dlprefiles="$newdlprefiles"
- else
- newdlfiles=
- for lib in $dlfiles; do
- case $lib in
- [\\/]* | [A-Za-z]:[\\/]*) abs="$lib" ;;
- *) abs=`pwd`"/$lib" ;;
- esac
- newdlfiles="$newdlfiles $abs"
- done
- dlfiles="$newdlfiles"
- newdlprefiles=
- for lib in $dlprefiles; do
- case $lib in
- [\\/]* | [A-Za-z]:[\\/]*) abs="$lib" ;;
- *) abs=`pwd`"/$lib" ;;
- esac
- newdlprefiles="$newdlprefiles $abs"
- done
- dlprefiles="$newdlprefiles"
- fi
- $RM $output
- # place dlname in correct position for cygwin
- tdlname=$dlname
- case $host,$output,$installed,$module,$dlname in
- *cygwin*,*lai,yes,no,*.dll | *mingw*,*lai,yes,no,*.dll | *cegcc*,*lai,yes,no,*.dll) tdlname=../bin/$dlname ;;
- esac
- $ECHO > $output "\
-# $outputname - a libtool library file
-# Generated by $PROGRAM (GNU $PACKAGE$TIMESTAMP) $VERSION
-#
-# Please DO NOT delete this file!
-# It is necessary for linking the library.
-
-# The name that we can dlopen(3).
-dlname='$tdlname'
-
-# Names of this library.
-library_names='$library_names'
-
-# The name of the static archive.
-old_library='$old_library'
-
-# Linker flags that can not go in dependency_libs.
-inherited_linker_flags='$new_inherited_linker_flags'
-
-# Libraries that this one depends upon.
-dependency_libs='$dependency_libs'
-
-# Names of additional weak libraries provided by this library
-weak_library_names='$weak_libs'
-
-# Version information for $libname.
-current=$current
-age=$age
-revision=$revision
-
-# Is this an already installed library?
-installed=$installed
-
-# Should we warn about portability when linking against -modules?
-shouldnotlink=$module
-
-# Files to dlopen/dlpreopen
-dlopen='$dlfiles'
-dlpreopen='$dlprefiles'
-
-# Directory that this library needs to be installed in:
-libdir='$install_libdir'"
- if test "$installed" = no && test "$need_relink" = yes; then
- $ECHO >> $output "\
-relink_command=\"$relink_command\""
- fi
- done
- }
-
- # Do a symbolic link so that the libtool archive can be found in
- # LD_LIBRARY_PATH before the program is installed.
- func_show_eval '( cd "$output_objdir" && $RM "$outputname" && $LN_S "../$outputname" "$outputname" )' 'exit $?'
- ;;
- esac
- exit $EXIT_SUCCESS
-}
-
-{ test "$mode" = link || test "$mode" = relink; } &&
- func_mode_link ${1+"$@"}
-
-
-# func_mode_uninstall arg...
-func_mode_uninstall ()
-{
- $opt_debug
- RM="$nonopt"
- files=
- rmforce=
- exit_status=0
-
- # This variable tells wrapper scripts just to set variables rather
- # than running their programs.
- libtool_install_magic="$magic"
-
- for arg
- do
- case $arg in
- -f) RM="$RM $arg"; rmforce=yes ;;
- -*) RM="$RM $arg" ;;
- *) files="$files $arg" ;;
- esac
- done
-
- test -z "$RM" && \
- func_fatal_help "you must specify an RM program"
-
- rmdirs=
-
- origobjdir="$objdir"
- for file in $files; do
- func_dirname "$file" "" "."
- dir="$func_dirname_result"
- if test "X$dir" = X.; then
- objdir="$origobjdir"
- else
- objdir="$dir/$origobjdir"
- fi
- func_basename "$file"
- name="$func_basename_result"
- test "$mode" = uninstall && objdir="$dir"
-
- # Remember objdir for removal later, being careful to avoid duplicates
- if test "$mode" = clean; then
- case " $rmdirs " in
- *" $objdir "*) ;;
- *) rmdirs="$rmdirs $objdir" ;;
- esac
- fi
-
- # Don't error if the file doesn't exist and rm -f was used.
- if { test -L "$file"; } >/dev/null 2>&1 ||
- { test -h "$file"; } >/dev/null 2>&1 ||
- test -f "$file"; then
- :
- elif test -d "$file"; then
- exit_status=1
- continue
- elif test "$rmforce" = yes; then
- continue
- fi
-
- rmfiles="$file"
-
- case $name in
- *.la)
- # Possibly a libtool archive, so verify it.
- if func_lalib_p "$file"; then
- func_source $dir/$name
-
- # Delete the libtool libraries and symlinks.
- for n in $library_names; do
- rmfiles="$rmfiles $objdir/$n"
- done
- test -n "$old_library" && rmfiles="$rmfiles $objdir/$old_library"
-
- case "$mode" in
- clean)
- case " $library_names " in
- # " " in the beginning catches empty $dlname
- *" $dlname "*) ;;
- *) rmfiles="$rmfiles $objdir/$dlname" ;;
- esac
- test -n "$libdir" && rmfiles="$rmfiles $objdir/$name $objdir/${name}i"
- ;;
- uninstall)
- if test -n "$library_names"; then
- # Do each command in the postuninstall commands.
- func_execute_cmds "$postuninstall_cmds" 'test "$rmforce" = yes || exit_status=1'
- fi
-
- if test -n "$old_library"; then
- # Do each command in the old_postuninstall commands.
- func_execute_cmds "$old_postuninstall_cmds" 'test "$rmforce" = yes || exit_status=1'
- fi
- # FIXME: should reinstall the best remaining shared library.
- ;;
- esac
- fi
- ;;
-
- *.lo)
- # Possibly a libtool object, so verify it.
- if func_lalib_p "$file"; then
-
- # Read the .lo file
- func_source $dir/$name
-
- # Add PIC object to the list of files to remove.
- if test -n "$pic_object" &&
- test "$pic_object" != none; then
- rmfiles="$rmfiles $dir/$pic_object"
- fi
-
- # Add non-PIC object to the list of files to remove.
- if test -n "$non_pic_object" &&
- test "$non_pic_object" != none; then
- rmfiles="$rmfiles $dir/$non_pic_object"
- fi
- fi
- ;;
-
- *)
- if test "$mode" = clean ; then
- noexename=$name
- case $file in
- *.exe)
- func_stripname '' '.exe' "$file"
- file=$func_stripname_result
- func_stripname '' '.exe' "$name"
- noexename=$func_stripname_result
- # $file with .exe has already been added to rmfiles,
- # add $file without .exe
- rmfiles="$rmfiles $file"
- ;;
- esac
- # Do a test to see if this is a libtool program.
- if func_ltwrapper_p "$file"; then
- if func_ltwrapper_executable_p "$file"; then
- func_ltwrapper_scriptname "$file"
- relink_command=
- func_source $func_ltwrapper_scriptname_result
- rmfiles="$rmfiles $func_ltwrapper_scriptname_result"
- else
- relink_command=
- func_source $dir/$noexename
- fi
-
- # note $name still contains .exe if it was in $file originally
- # as does the version of $file that was added into $rmfiles
- rmfiles="$rmfiles $objdir/$name $objdir/${name}S.${objext}"
- if test "$fast_install" = yes && test -n "$relink_command"; then
- rmfiles="$rmfiles $objdir/lt-$name"
- fi
- if test "X$noexename" != "X$name" ; then
- rmfiles="$rmfiles $objdir/lt-${noexename}.c"
- fi
- fi
- fi
- ;;
- esac
- func_show_eval "$RM $rmfiles" 'exit_status=1'
- done
- objdir="$origobjdir"
-
- # Try to remove the ${objdir}s in the directories where we deleted files
- for dir in $rmdirs; do
- if test -d "$dir"; then
- func_show_eval "rmdir $dir >/dev/null 2>&1"
- fi
- done
-
- exit $exit_status
-}
-
-{ test "$mode" = uninstall || test "$mode" = clean; } &&
- func_mode_uninstall ${1+"$@"}
-
-test -z "$mode" && {
- help="$generic_help"
- func_fatal_help "you must specify a MODE"
-}
-
-test -z "$exec_cmd" && \
- func_fatal_help "invalid operation mode \`$mode'"
-
-if test -n "$exec_cmd"; then
- eval exec "$exec_cmd"
- exit $EXIT_FAILURE
-fi
-
-exit $exit_status
-
-
-# The TAGs below are defined such that we never get into a situation
-# in which we disable both kinds of libraries. Given conflicting
-# choices, we go for a static library, that is the most portable,
-# since we can't tell whether shared libraries were disabled because
-# the user asked for that or because the platform doesn't support
-# them. This is particularly important on AIX, because we don't
-# support having both static and shared libraries enabled at the same
-# time on that platform, so we default to a shared-only configuration.
-# If a disable-shared tag is given, we'll fallback to a static-only
-# configuration. But we'll never go from static-only to shared-only.
-
-# ### BEGIN LIBTOOL TAG CONFIG: disable-shared
-build_libtool_libs=no
-build_old_libs=yes
-# ### END LIBTOOL TAG CONFIG: disable-shared
-
-# ### BEGIN LIBTOOL TAG CONFIG: disable-static
-build_old_libs=`case $build_libtool_libs in yes) echo no;; *) echo yes;; esac`
-# ### END LIBTOOL TAG CONFIG: disable-static
-
-# Local Variables:
-# mode:shell-script
-# sh-indentation:2
-# End:
-# vi:sw=2
-
Index: branches/ohl/omega-development/hgg-vertex/README
===================================================================
--- branches/ohl/omega-development/hgg-vertex/README (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/README (revision 8717)
@@ -1,26 +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)
-
- share/doc/ typeset versions of the sources in bin/
- (requires ocamlweb, ocamlweb.sty and noweb.sty)
- additional documentation
-
- tests/ regression tests
- (some of the old tests need MADGRAPH, some of
- the tests an extended version of MADGRAPH)
Index: branches/ohl/omega-development/hgg-vertex/config.sub
===================================================================
--- branches/ohl/omega-development/hgg-vertex/config.sub (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/config.sub (revision 8717)
@@ -1,1608 +0,0 @@
-#! /bin/sh
-# Configuration validation subroutine script.
-# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
-# 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation,
-# Inc.
-
-timestamp='2006-07-02'
-
-# 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., 51 Franklin Street - Fifth Floor, Boston, MA
-# 02110-1301, 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 <config-patches@gnu.org>. Submit a context
-# diff and a properly formatted ChangeLog entry.
-#
-# 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 <config-patches@gnu.org>."
-
-version="\
-GNU config.sub ($timestamp)
-
-Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005
-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 ;;
- --version | -v )
- echo "$version" ; exit ;;
- --help | --h* | -h )
- echo "$usage"; exit ;;
- -- ) # 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 ;;
-
- * )
- 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* | linux-dietlibc | linux-newlib* | linux-uclibc* | \
- uclinux-uclibc* | uclinux-gnu* | kfreebsd*-gnu* | knetbsd*-gnu* | netbsd*-gnu* | \
- storm-chaos* | os2-emx* | rtmk-nova*)
- 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 | -knuth | -cray)
- os=
- basic_machine=$1
- ;;
- -sim | -cisco | -oki | -wec | -winbond)
- os=
- basic_machine=$1
- ;;
- -scout)
- ;;
- -wrs)
- os=-vxworks
- basic_machine=$1
- ;;
- -chorusos*)
- os=-chorusos
- basic_machine=$1
- ;;
- -chorusrdb)
- os=-chorusrdb
- basic_machine=$1
- ;;
- -hiux*)
- os=-hiuxwe2
- ;;
- -sco6)
- os=-sco5v6
- basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
- ;;
- -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/'`
- ;;
- -sco5v6*)
- # 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.
- 1750a | 580 \
- | a29k \
- | alpha | alphaev[4-8] | alphaev56 | alphaev6[78] | alphapca5[67] \
- | alpha64 | alpha64ev[4-8] | alpha64ev56 | alpha64ev6[78] | alpha64pca5[67] \
- | am33_2.0 \
- | arc | arm | arm[bl]e | arme[lb] | armv[2345] | armv[345][lb] | avr | avr32 \
- | bfin \
- | c4x | clipper \
- | d10v | d30v | dlx | dsp16xx \
- | fr30 | frv \
- | h8300 | h8500 | hppa | hppa1.[01] | hppa2.0 | hppa2.0[nw] | hppa64 \
- | i370 | i860 | i960 | ia64 \
- | ip2k | iq2000 \
- | m32c | m32r | m32rle | m68000 | m68k | m88k \
- | maxq | mb | microblaze | mcore \
- | mips | mipsbe | mipseb | mipsel | mipsle \
- | mips16 \
- | mips64 | mips64el \
- | mips64vr | mips64vrel \
- | mips64orion | mips64orionel \
- | mips64vr4100 | mips64vr4100el \
- | mips64vr4300 | mips64vr4300el \
- | mips64vr5000 | mips64vr5000el \
- | mips64vr5900 | mips64vr5900el \
- | mipsisa32 | mipsisa32el \
- | mipsisa32r2 | mipsisa32r2el \
- | mipsisa64 | mipsisa64el \
- | mipsisa64r2 | mipsisa64r2el \
- | mipsisa64sb1 | mipsisa64sb1el \
- | mipsisa64sr71k | mipsisa64sr71kel \
- | mipstx39 | mipstx39el \
- | mn10200 | mn10300 \
- | mt \
- | msp430 \
- | nios | nios2 \
- | ns16k | ns32k \
- | or32 \
- | pdp10 | pdp11 | pj | pjl \
- | powerpc | powerpc64 | powerpc64le | powerpcle | ppcbe \
- | pyramid \
- | sh | sh[1234] | sh[24]a | sh[23]e | sh[34]eb | sheb | shbe | shle | sh[1234]le | sh3ele \
- | sh64 | sh64le \
- | sparc | sparc64 | sparc64b | sparc64v | sparc86x | sparclet | sparclite \
- | sparcv8 | sparcv9 | sparcv9b | sparcv9v \
- | spu | strongarm \
- | tahoe | thumb | tic4x | tic80 | tron \
- | v850 | v850e \
- | we32k \
- | x86 | xscale | xscalee[bl] | xstormy16 | xtensa \
- | z8k)
- 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 | v70 | w65 | z8k)
- ;;
- ms1)
- basic_machine=mt-unknown
- ;;
-
- # 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*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.
- 580-* \
- | a29k-* \
- | alpha-* | alphaev[4-8]-* | alphaev56-* | alphaev6[78]-* \
- | alpha64-* | alpha64ev[4-8]-* | alpha64ev56-* | alpha64ev6[78]-* \
- | alphapca5[67]-* | alpha64pca5[67]-* | arc-* \
- | arm-* | armbe-* | armle-* | armeb-* | armv*-* \
- | avr-* | avr32-* \
- | bfin-* | bs2000-* \
- | c[123]* | c30-* | [cjt]90-* | c4x-* | c54x-* | c55x-* | c6x-* \
- | clipper-* | craynv-* | cydra-* \
- | d10v-* | d30v-* | dlx-* \
- | elxsi-* \
- | f30[01]-* | f700-* | fr30-* | frv-* | fx80-* \
- | h8300-* | h8500-* \
- | hppa-* | hppa1.[01]-* | hppa2.0-* | hppa2.0[nw]-* | hppa64-* \
- | i*86-* | i860-* | i960-* | ia64-* \
- | ip2k-* | iq2000-* \
- | m32c-* | m32r-* | m32rle-* \
- | m68000-* | m680[012346]0-* | m68360-* | m683?2-* | m68k-* \
- | m88110-* | m88k-* | maxq-* | mcore-* \
- | mips-* | mipsbe-* | mipseb-* | mipsel-* | mipsle-* \
- | mips16-* \
- | mips64-* | mips64el-* \
- | mips64vr-* | mips64vrel-* \
- | mips64orion-* | mips64orionel-* \
- | mips64vr4100-* | mips64vr4100el-* \
- | mips64vr4300-* | mips64vr4300el-* \
- | mips64vr5000-* | mips64vr5000el-* \
- | mips64vr5900-* | mips64vr5900el-* \
- | mipsisa32-* | mipsisa32el-* \
- | mipsisa32r2-* | mipsisa32r2el-* \
- | mipsisa64-* | mipsisa64el-* \
- | mipsisa64r2-* | mipsisa64r2el-* \
- | mipsisa64sb1-* | mipsisa64sb1el-* \
- | mipsisa64sr71k-* | mipsisa64sr71kel-* \
- | mipstx39-* | mipstx39el-* \
- | mmix-* \
- | mt-* \
- | msp430-* \
- | nios-* | nios2-* \
- | none-* | np1-* | ns16k-* | ns32k-* \
- | orion-* \
- | pdp10-* | pdp11-* | pj-* | pjl-* | pn-* | power-* \
- | powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* | ppcbe-* \
- | pyramid-* \
- | romp-* | rs6000-* \
- | sh-* | sh[1234]-* | sh[24]a-* | sh[23]e-* | sh[34]eb-* | sheb-* | shbe-* \
- | shle-* | sh[1234]le-* | sh3ele-* | sh64-* | sh64le-* \
- | sparc-* | sparc64-* | sparc64b-* | sparc64v-* | sparc86x-* | sparclet-* \
- | sparclite-* \
- | sparcv8-* | sparcv9-* | sparcv9b-* | sparcv9v-* | strongarm-* | sv1-* | sx?-* \
- | tahoe-* | thumb-* \
- | tic30-* | tic4x-* | tic54x-* | tic55x-* | tic6x-* | tic80-* \
- | tron-* \
- | v850-* | v850e-* | vax-* \
- | we32k-* \
- | x86-* | x86_64-* | xps100-* | xscale-* | xscalee[bl]-* \
- | xstormy16-* | xtensa-* \
- | ymp-* \
- | z8k-*)
- ;;
- # 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
- ;;
- abacus)
- basic_machine=abacus-unknown
- ;;
- 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
- ;;
- amd64)
- basic_machine=x86_64-pc
- ;;
- amd64-*)
- basic_machine=x86_64-`echo $basic_machine | sed 's/^[^-]*-//'`
- ;;
- 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
- ;;
- c90)
- basic_machine=c90-cray
- os=-unicos
- ;;
- 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 | j90)
- basic_machine=j90-cray
- os=-unicos
- ;;
- craynv)
- basic_machine=craynv-cray
- os=-unicosmp
- ;;
- cr16c)
- basic_machine=cr16c-unknown
- os=-elf
- ;;
- crds | unos)
- basic_machine=m68k-crds
- ;;
- crisv32 | crisv32-* | etraxfs*)
- basic_machine=crisv32-axis
- ;;
- cris | cris-* | etrax*)
- basic_machine=cris-axis
- ;;
- crx)
- basic_machine=crx-unknown
- os=-elf
- ;;
- da30 | da30-*)
- basic_machine=m68k-da30
- ;;
- decstation | decstation-3100 | pmax | pmax-* | pmin | dec3100 | decstatn)
- basic_machine=mips-dec
- ;;
- decsystem10* | dec10*)
- basic_machine=pdp10-dec
- os=-tops10
- ;;
- decsystem20* | dec20*)
- basic_machine=pdp10-dec
- os=-tops20
- ;;
- delta | 3300 | motorola-3300 | motorola-delta \
- | 3300-motorola | delta-motorola)
- basic_machine=m68k-motorola
- ;;
- delta88)
- basic_machine=m88k-motorola
- os=-sysv3
- ;;
- djgpp)
- basic_machine=i586-pc
- os=-msdosdjgpp
- ;;
- 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*86v32)
- basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'`
- os=-sysv32
- ;;
- i*86v4*)
- basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'`
- os=-sysv4
- ;;
- i*86v)
- basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'`
- os=-sysv
- ;;
- i*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
- ;;
- mips3*-*)
- basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'`
- ;;
- mips3*)
- basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'`-unknown
- ;;
- monitor)
- basic_machine=m68k-rom68k
- os=-coff
- ;;
- morphos)
- basic_machine=powerpc-unknown
- os=-morphos
- ;;
- msdos)
- basic_machine=i386-pc
- os=-msdos
- ;;
- ms1-*)
- basic_machine=`echo $basic_machine | sed -e 's/ms1-/mt-/'`
- ;;
- 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
- ;;
- openrisc | openrisc-*)
- basic_machine=or32-unknown
- ;;
- os400)
- basic_machine=powerpc-ibm
- os=-os400
- ;;
- 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
- ;;
- pc98)
- basic_machine=i386-pc
- ;;
- pc98-*)
- basic_machine=i386-`echo $basic_machine | sed 's/^[^-]*-//'`
- ;;
- pentium | p5 | k5 | k6 | nexgen | viac3)
- basic_machine=i586-pc
- ;;
- pentiumpro | p6 | 6x86 | athlon | athlon_*)
- basic_machine=i686-pc
- ;;
- pentiumii | pentium2 | pentiumiii | pentium3)
- basic_machine=i686-pc
- ;;
- pentium4)
- basic_machine=i786-pc
- ;;
- pentium-* | p5-* | k5-* | k6-* | nexgen-* | viac3-*)
- basic_machine=i586-`echo $basic_machine | sed 's/^[^-]*-//'`
- ;;
- pentiumpro-* | p6-* | 6x86-* | athlon-*)
- basic_machine=i686-`echo $basic_machine | sed 's/^[^-]*-//'`
- ;;
- pentiumii-* | pentium2-* | pentiumiii-* | pentium3-*)
- basic_machine=i686-`echo $basic_machine | sed 's/^[^-]*-//'`
- ;;
- pentium4-*)
- basic_machine=i786-`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/^[^-]*-//'`
- ;;
- ppc64) basic_machine=powerpc64-unknown
- ;;
- ppc64-*) basic_machine=powerpc64-`echo $basic_machine | sed 's/^[^-]*-//'`
- ;;
- ppc64le | powerpc64little | ppc64-le | powerpc64-little)
- basic_machine=powerpc64le-unknown
- ;;
- ppc64le-* | powerpc64little-*)
- basic_machine=powerpc64le-`echo $basic_machine | sed 's/^[^-]*-//'`
- ;;
- ps2)
- basic_machine=i386-ibm
- ;;
- pw32)
- basic_machine=i586-unknown
- os=-pw32
- ;;
- rdos)
- basic_machine=i386-pc
- os=-rdos
- ;;
- rom68k)
- basic_machine=m68k-rom68k
- os=-coff
- ;;
- rm[46]00)
- basic_machine=mips-siemens
- ;;
- rtpc | rtpc-*)
- basic_machine=romp-ibm
- ;;
- s390 | s390-*)
- basic_machine=s390-ibm
- ;;
- s390x | s390x-*)
- basic_machine=s390x-ibm
- ;;
- sa29200)
- basic_machine=a29k-amd
- os=-udi
- ;;
- sb1)
- basic_machine=mipsisa64sb1-unknown
- ;;
- sb1el)
- basic_machine=mipsisa64sb1el-unknown
- ;;
- sei)
- basic_machine=mips-sei
- os=-seiux
- ;;
- sequent)
- basic_machine=i386-sequent
- ;;
- sh)
- basic_machine=sh-hitachi
- os=-hms
- ;;
- sh64)
- basic_machine=sh64-unknown
- ;;
- sparclite-wrs | simso-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=alphaev5-cray
- os=-unicos
- ;;
- t90)
- basic_machine=t90-cray
- os=-unicos
- ;;
- tic54x | c54x*)
- basic_machine=tic54x-unknown
- os=-coff
- ;;
- tic55x | c55x*)
- basic_machine=tic55x-unknown
- os=-coff
- ;;
- tic6x | c6x*)
- basic_machine=tic6x-unknown
- os=-coff
- ;;
- tx39)
- basic_machine=mipstx39-unknown
- ;;
- tx39el)
- basic_machine=mipstx39el-unknown
- ;;
- toad1)
- basic_machine=pdp10-xkl
- os=-tops20
- ;;
- tower | tower-32)
- basic_machine=m68k-ncr
- ;;
- tpf)
- basic_machine=s390x-ibm
- os=-tpf
- ;;
- 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
- ;;
- xbox)
- basic_machine=i686-pc
- os=-mingw32
- ;;
- xps | xps100)
- basic_machine=xps100-honeywell
- ;;
- ymp)
- basic_machine=ymp-cray
- os=-unicos
- ;;
- 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
- ;;
- romp)
- basic_machine=romp-ibm
- ;;
- mmix)
- basic_machine=mmix-knuth
- ;;
- 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
- ;;
- sh[1234] | sh[24]a | sh[34]eb | sh[1234]le | sh[23]ele)
- basic_machine=sh-unknown
- ;;
- sparc | sparcv8 | sparcv9 | sparcv9b | sparcv9v)
- 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
- ;;
- *-unknown)
- # Make sure to match an already-canonicalized machine name.
- ;;
- *)
- 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* | -knetbsd* | -mirbsd* | -netbsd* \
- | -openbsd* | -solidbsd* \
- | -ekkobsd* | -kfreebsd* | -freebsd* | -riscix* | -lynxos* \
- | -bosx* | -nextstep* | -cxux* | -aout* | -elf* | -oabi* \
- | -ptx* | -coff* | -ecoff* | -winnt* | -domain* | -vsta* \
- | -udi* | -eabi* | -lites* | -ieee* | -go32* | -aux* \
- | -chorusos* | -chorusrdb* \
- | -cygwin* | -pe* | -psos* | -moss* | -proelf* | -rtems* \
- | -mingw32* | -linux-gnu* | -linux-newlib* | -linux-uclibc* \
- | -uxpv* | -beos* | -mpeix* | -udk* \
- | -interix* | -uwin* | -mks* | -rhapsody* | -darwin* | -opened* \
- | -openstep* | -oskit* | -conix* | -pw32* | -nonstopux* \
- | -storm-chaos* | -tops10* | -tenex* | -tops20* | -its* \
- | -os2* | -vos* | -palmos* | -uclinux* | -nucleus* \
- | -morphos* | -superux* | -rtmk* | -rtmk-nova* | -windiss* \
- | -powermax* | -dnix* | -nx6 | -nx7 | -sei* | -dragonfly* \
- | -skyos* | -haiku* | -rdos* | -toppers*)
- # Remember, each alternative MUST END IN *, to match a version number.
- ;;
- -qnx*)
- case $basic_machine in
- x86-* | i*86-*)
- ;;
- *)
- os=-nto$os
- ;;
- esac
- ;;
- -nto-qnx*)
- ;;
- -nto*)
- os=`echo $os | sed -e 's|nto|nto-qnx|'`
- ;;
- -sim | -es1800* | -hms* | -xray | -os68k* | -none* | -v88r* \
- | -windows* | -osx | -abug | -netware* | -os9* | -beos* | -haiku* \
- | -macos* | -mpw* | -magic* | -mmixware* | -mon960* | -lnews*)
- ;;
- -mac*)
- os=`echo $os | sed -e 's|mac|macos|'`
- ;;
- -linux-dietlibc)
- os=-linux-dietlibc
- ;;
- -linux*)
- os=`echo $os | sed -e 's|linux|linux-gnu|'`
- ;;
- -sunos5*)
- os=`echo $os | sed -e 's|sunos5|solaris2|'`
- ;;
- -sunos6*)
- os=`echo $os | sed -e 's|sunos6|solaris3|'`
- ;;
- -opened*)
- os=-openedition
- ;;
- -os400*)
- os=-os400
- ;;
- -wince*)
- os=-wince
- ;;
- -osfrose*)
- os=-osfrose
- ;;
- -osf*)
- os=-osf
- ;;
- -utek*)
- os=-bsd
- ;;
- -dynix*)
- os=-bsd
- ;;
- -acis*)
- os=-aos
- ;;
- -atheos*)
- os=-atheos
- ;;
- -syllable*)
- os=-syllable
- ;;
- -386bsd)
- os=-bsd
- ;;
- -ctix* | -uts*)
- os=-sysv
- ;;
- -nova*)
- os=-rtmk-nova
- ;;
- -ns2 )
- os=-nextstep2
- ;;
- -nsk*)
- os=-nsk
- ;;
- # Preserve the version number of sinix5.
- -sinix5.*)
- os=`echo $os | sed -e 's|sinix|sysv|'`
- ;;
- -sinix*)
- os=-sysv4
- ;;
- -tpf*)
- os=-tpf
- ;;
- -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
- ;;
- -aros*)
- os=-aros
- ;;
- -kaos*)
- os=-kaos
- ;;
- -zvmoe)
- os=-zvmoe
- ;;
- -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
- spu-*)
- os=-elf
- ;;
- *-acorn)
- os=-riscix1.2
- ;;
- arm*-rebel)
- os=-linux
- ;;
- arm*-semi)
- os=-aout
- ;;
- c4x-* | tic4x-*)
- os=-coff
- ;;
- # This must come before the *-dec entry.
- 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
- ;;
- or32-*)
- os=-coff
- ;;
- *-tti) # must be before sparc entry or we get the wrong os.
- os=-sysv3
- ;;
- sparc-* | *-sun)
- os=-sunos4.1.1
- ;;
- *-be)
- os=-beos
- ;;
- *-haiku)
- os=-haiku
- ;;
- *-ibm)
- os=-aix
- ;;
- *-knuth)
- os=-mmixware
- ;;
- *-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
- ;;
- -os400*)
- vendor=ibm
- ;;
- -ptx*)
- vendor=sequent
- ;;
- -tpf*)
- vendor=ibm
- ;;
- -vxsim* | -vxworks* | -windiss*)
- vendor=wrs
- ;;
- -aux*)
- vendor=apple
- ;;
- -hms*)
- vendor=hitachi
- ;;
- -mpw* | -macos*)
- vendor=apple
- ;;
- -*mint | -mint[0-9]* | -*MiNT | -MiNT[0-9]*)
- vendor=atari
- ;;
- -vos*)
- vendor=stratus
- ;;
- esac
- basic_machine=`echo $basic_machine | sed "s/unknown/$vendor/"`
- ;;
-esac
-
-echo $basic_machine$os
-exit
-
-# 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/hgg-vertex/extensions/people/Makefile.am
===================================================================
--- branches/ohl/omega-development/hgg-vertex/extensions/people/Makefile.am (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/extensions/people/Makefile.am (revision 8717)
@@ -1,29 +0,0 @@
-# Makefile.am -- Makefile for O'Mega within and without WHIZARD
-# $Id$
-##
-## Process this file with automake to produce Makefile.in
-##
-########################################################################
-#
-# Copyright (C) 1999-2010 by
-# Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
-# Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
-# Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-#
-# 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.
-#
-########################################################################
-
-SUBDIRS = jr tho
Index: branches/ohl/omega-development/hgg-vertex/extensions/people/tho/f90_O2.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/extensions/people/tho/f90_O2.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/extensions/people/tho/f90_O2.ml (revision 8717)
@@ -1,584 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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/hgg-vertex/extensions/people/tho/main2.tex
===================================================================
--- branches/ohl/omega-development/hgg-vertex/extensions/people/tho/main2.tex (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/extensions/people/tho/main2.tex (revision 8717)
@@ -1,42 +0,0 @@
-% $Id$
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\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/hgg-vertex/extensions/people/tho/Makefile.am
===================================================================
--- branches/ohl/omega-development/hgg-vertex/extensions/people/tho/Makefile.am (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/extensions/people/tho/Makefile.am (revision 8717)
@@ -1,27 +0,0 @@
-# Makefile.am -- Makefile for O'Mega within and without WHIZARD
-# $Id$
-##
-## Process this file with automake to produce Makefile.in
-##
-########################################################################
-#
-# Copyright (C) 1999-2010 by
-# Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
-# Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
-# Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-#
-# 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.
-#
-########################################################################
Index: branches/ohl/omega-development/hgg-vertex/extensions/people/tho/f90_O2_test.f90
===================================================================
--- branches/ohl/omega-development/hgg-vertex/extensions/people/tho/f90_O2_test.f90 (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/extensions/people/tho/f90_O2_test.f90 (revision 8717)
@@ -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/hgg-vertex/extensions/people/jr/f90_SQED.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/extensions/people/jr/f90_SQED.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/extensions/people/jr/f90_SQED.ml (revision 8717)
@@ -1,382 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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/hgg-vertex/extensions/people/jr/f90_SAGT.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/extensions/people/jr/f90_SAGT.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/extensions/people/jr/f90_SAGT.ml (revision 8717)
@@ -1,1270 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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/hgg-vertex/extensions/people/jr/main.tex
===================================================================
--- branches/ohl/omega-development/hgg-vertex/extensions/people/jr/main.tex (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/extensions/people/jr/main.tex (revision 8717)
@@ -1,42 +0,0 @@
-% $Id$
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\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/hgg-vertex/extensions/people/jr/f90_WZ.ml
===================================================================
--- branches/ohl/omega-development/hgg-vertex/extensions/people/jr/f90_WZ.ml (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/extensions/people/jr/f90_WZ.ml (revision 8717)
@@ -1,875 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2009 by
-
- Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-
- 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/hgg-vertex/extensions/people/jr/main3.tex
===================================================================
--- branches/ohl/omega-development/hgg-vertex/extensions/people/jr/main3.tex (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/extensions/people/jr/main3.tex (revision 8717)
@@ -1,42 +0,0 @@
-% $Id$
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\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/hgg-vertex/extensions/people/jr/main4.tex
===================================================================
--- branches/ohl/omega-development/hgg-vertex/extensions/people/jr/main4.tex (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/extensions/people/jr/main4.tex (revision 8717)
@@ -1,42 +0,0 @@
-% $Id$
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\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/hgg-vertex/extensions/people/jr/f90_SAGT_test.f90
===================================================================
--- branches/ohl/omega-development/hgg-vertex/extensions/people/jr/f90_SAGT_test.f90 (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/extensions/people/jr/f90_SAGT_test.f90 (revision 8717)
@@ -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=omega_prec), save :: roots = 100, nada = 0
- real(kind=omega_prec), dimension(N+1) :: m
- real(kind=omega_prec), dimension(0:3,N+1) :: p
- real(kind=omega_prec) :: rel
- complex(kind=omega_prec) :: j1, j2, j3, j4, j5, j6, res
- ! complex(kind=omega_prec) :: 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_omega_prec
- 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_omega_prec
-! rel = (abs(j1)+abs(j2)+abs(j3))/3.0_omega_prec
-! 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_omega_prec
- !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=omega_prec), dimension(0:,:), intent(in) :: k
- integer, dimension(:), intent(in) :: s, f
- complex(kind=omega_prec) :: 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=omega_prec), dimension(0:,:), intent(in) :: k
- integer, dimension(:), intent(in) :: s, f
- complex(kind=omega_prec) :: 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=omega_prec), dimension(0:,:), intent(in) :: k
- integer, dimension(:), intent(in) :: s, f
- complex(kind=omega_prec) :: 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=omega_prec), dimension(0:,:), intent(in) :: k
- integer, dimension(:), intent(in) :: s, f
- complex(kind=omega_prec) :: 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=omega_prec), dimension(0:,:), intent(in) :: k
-! integer, dimension(:), intent(in) :: s, f
-! complex(kind=omega_prec) :: 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=omega_prec), dimension(0:,:), intent(in) :: k
- ! integer, dimension(:), intent(in) :: s, f
- ! complex(kind=omega_prec) :: 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=omega_prec), dimension(0:,:), intent(in) :: k
- integer, dimension(:), intent(in) :: s, f
- complex(kind=omega_prec) :: amp
- amp = symmetry (f) * amplitude (k, s, f)
- end function currenta
-end program f90_SAGT_test
-
-
Index: branches/ohl/omega-development/hgg-vertex/extensions/people/jr/Makefile.am
===================================================================
--- branches/ohl/omega-development/hgg-vertex/extensions/people/jr/Makefile.am (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/extensions/people/jr/Makefile.am (revision 8717)
@@ -1,27 +0,0 @@
-# Makefile.am -- Makefile for O'Mega within and without WHIZARD
-# $Id$
-##
-## Process this file with automake to produce Makefile.in
-##
-########################################################################
-#
-# Copyright (C) 1999-2010 by
-# Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
-# Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
-# Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-#
-# 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.
-#
-########################################################################
Index: branches/ohl/omega-development/hgg-vertex/extensions/Makefile.am
===================================================================
--- branches/ohl/omega-development/hgg-vertex/extensions/Makefile.am (revision 8716)
+++ branches/ohl/omega-development/hgg-vertex/extensions/Makefile.am (revision 8717)
@@ -1,29 +0,0 @@
-# Makefile.am -- Makefile for O'Mega within and without WHIZARD
-# $Id$
-##
-## Process this file with automake to produce Makefile.in
-##
-########################################################################
-#
-# Copyright (C) 1999-2010 by
-# Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
-# Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
-# Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
-#
-# 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.
-#
-########################################################################
-
-SUBDIRS = people

File Metadata

Mime Type
application/octet-stream
Expires
Sun, Apr 21, 2:19 PM (1 d, 23 h)
Storage Engine
chunks
Storage Format
Chunks
Storage Handle
kiZn39xHxTy7
Default Alt Text
(4 MB)

Event Timeline