Index: trunk/omega/src/UFO_targets.mli =================================================================== --- trunk/omega/src/UFO_targets.mli (revision 8359) +++ trunk/omega/src/UFO_targets.mli (revision 8360) @@ -1,47 +1,52 @@ (* UFO_targets.mli -- Copyright (C) 1999-2017 by Wolfgang Kilian Thorsten Ohl Juergen Reuter with contributions from Christian Speckner WHIZARD is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2, or (at your option) any later version. WHIZARD is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the 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{Generating Code for UFO Lorentz Structures} *) module type T = sig (* NB: The [spins : int list] argument is \emph{not} sufficient to determine the domain and codomain of the function. We will need to inspect the flavors, where the Lorentz structure is referenced. *) val lorentz : Format_Fortran.formatter -> string -> Coupling.lorentz array -> UFO_Lorentz.t -> unit + val propagator : + Format_Fortran.formatter -> string -> + Coupling.lorentz * Coupling.lorentz -> + UFO_Lorentz.t -> UFO_Lorentz.t -> unit + val fuse : Algebra.QC.t -> string -> Coupling.lorentzn -> string -> string list -> string list -> Coupling.fusen -> unit val eps4_g4_g44_decl : Format_Fortran.formatter -> unit -> unit val eps4_g4_g44_init : Format_Fortran.formatter -> unit -> unit end module Fortran : T Index: trunk/omega/src/UFO.mli =================================================================== --- trunk/omega/src/UFO.mli (revision 8359) +++ trunk/omega/src/UFO.mli (revision 8360) @@ -1,83 +1,101 @@ (* vertex.mli -- Copyright (C) 1999-2019 by Wolfgang Kilian Thorsten Ohl Juergen Reuter with contributions from Christian Speckner WHIZARD is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2, or (at your option) any later version. WHIZARD is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the 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 parse_string : string -> UFO_syntax.t val parse_file : string -> UFO_syntax.t (* These are the contents of the Python files after lexical analysis as context-free variable declarations, before any semantic interpretation. *) module type Files = sig type t = private { particles : UFO_syntax.t; couplings : UFO_syntax.t; coupling_orders : UFO_syntax.t; vertices : UFO_syntax.t; lorentz : UFO_syntax.t; parameters : UFO_syntax.t; propagators : UFO_syntax.t; decays : UFO_syntax.t } val parse_directory : string -> t end type t exception Unhandled of string module Model : Model.T val parse_directory : string -> t module type Fortran_Target = sig val fuse : Algebra.QC.t -> string -> Coupling.lorentzn -> string -> string list -> string list -> Coupling.fusen -> unit - val lorentz : - ?only:Sets.String.t -> Format_Fortran.formatter -> unit -> unit - val lorentz_module : ?only:Sets.String.t -> ?name:string -> ?fortran_module:string -> Format_Fortran.formatter -> unit -> unit end module Targets : sig module Fortran : Fortran_Target end +(* Export some functions for testing: *) + +module Propagator_UFO : + sig + type t = (* private *) + { name : string; + numerator : UFOx.Lorentz.t; + denominator : UFOx.Lorentz.t } + end + +module Propagator : + sig + type t = (* private *) + { name : string; + spins : Coupling.lorentz * Coupling.lorentz; + numerator : UFO_Lorentz.t; + denominator : UFO_Lorentz.t } + val of_propagator_UFO : Propagator_UFO.t -> t + val transpose : t -> t + end + module type Test = sig val suite : OUnit.test end module Test : Test Index: trunk/omega/src/UFO_Lorentz.mli =================================================================== --- trunk/omega/src/UFO_Lorentz.mli (revision 8359) +++ trunk/omega/src/UFO_Lorentz.mli (revision 8360) @@ -1,96 +1,105 @@ (* UFO_Lorentz.mli -- Copyright (C) 1999-2017 by Wolfgang Kilian Thorsten Ohl Juergen Reuter with contributions from Christian Speckner WHIZARD is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2, or (at your option) any later version. WHIZARD is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the 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{Processed UFO Lorentz Structures} *) (* Just like [UFOx.Lorentz_Atom.dirac], but without the Dirac matrix indices. *) type dirac = (* [private] *) | Gamma5 | ProjM | ProjP | Gamma of int | Sigma of int * int | C + | Minus (* A sandwich of a string of $\gamma$-matrices. [bra] and [ket] are positions of fields in the vertex, \emph{not} spinor indices. *) type dirac_string = (* [private] *) { bra : int; ket : int; gammas : dirac list } +(* In the case of Majorana spinors, we have to insert charge conjugation + matrices. *) +val majorana : dirac_string -> dirac_string +val transpose : dirac_string -> dirac_string + (* The Lorentz indices appearing in a term are either negative internal summation indices or positive external polarization indices. Note that the external indices are not really indices, but denote the position of the particle in the vertex. *) type 'a term = (* [private] *) { indices : int list; atom : 'a } (* Split the list of indices into summation and polarization indices. *) val classify_indices : int list -> int list * int list (* Replace the atom keeping the associated indices. *) val map_atom : ('a -> 'b) -> 'a term -> 'b term (* A contraction consists of a (possibly empty) product of Dirac strings and a (possibly empty) product of Lorentz tensors with a rational coefficient. *) type contraction = (* [private] *) { coeff : Algebra.QC.t; dirac : dirac_string term list; - vector : UFOx.Lorentz_Atom.vector term list } + vector : UFOx.Lorentz_Atom.vector term list; + scalar : UFOx.Lorentz_Atom.scalar list; + inverse : UFOx.Lorentz_Atom.scalar list } (* A sum of [contraction]s. *) type t = contraction list (* Fermion line connections. *) val fermion_lines : t -> Coupling.fermion_lines (* [parse spins lorentz] uses the [spins] to parse the UFO [lorentz] structure as a list of [contraction]s. *) val parse : Coupling.lorentz list -> UFOx.Lorentz.t -> t (* [map_indices f lorentz] applies the map [f] to the free indices in [lorentz]. *) val map_indices : (int -> int) -> t -> t val map_fermion_lines : (int -> int) -> Coupling.fermion_lines -> Coupling.fermion_lines (* Create a readable representation for debugging and documenting generated code. *) val to_string : t -> string val fermion_lines_to_string : Coupling.fermion_lines -> string (* Punting \ldots *) val dummy : t (* More debugging and documenting. *) val dirac_string_to_string : dirac_string -> string (* [dirac_string_to_matrix substitute ds] take a string of $\gamma$-matrices [ds], applies [substitute] to the indices and returns the product as a matrix. *) val dirac_string_to_matrix : (int -> int) -> dirac_string -> Dirac.Chiral.t + Index: trunk/omega/src/UFOx.ml =================================================================== --- trunk/omega/src/UFOx.ml (revision 8359) +++ trunk/omega/src/UFOx.ml (revision 8360) @@ -1,1057 +1,1295 @@ (* vertex.ml -- Copyright (C) 1999-2019 by Wolfgang Kilian Thorsten Ohl Juergen Reuter with contributions from Christian Speckner WHIZARD is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2, or (at your option) any later version. WHIZARD is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the 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 error_in_string text start_pos end_pos = let i = max 0 start_pos.Lexing.pos_cnum in let j = min (String.length text) (max (i + 1) end_pos.Lexing.pos_cnum) in String.sub text i (j - i) let error_in_file name start_pos end_pos = Printf.sprintf "%s:%d.%d-%d.%d" name start_pos.Lexing.pos_lnum (start_pos.Lexing.pos_cnum - start_pos.Lexing.pos_bol) end_pos.Lexing.pos_lnum (end_pos.Lexing.pos_cnum - end_pos.Lexing.pos_bol) +module SMap = Map.Make (struct type t = string let compare = compare end) + module Expr = struct type t = UFOx_syntax.expr let of_string text = try UFOx_parser.input UFOx_lexer.token (UFOx_lexer.init_position "" (Lexing.from_string text)) with | UFO_tools.Lexical_Error (msg, start_pos, end_pos) -> invalid_arg (Printf.sprintf "lexical error (%s) at: `%s'" msg (error_in_string text start_pos end_pos)) | UFOx_syntax.Syntax_Error (msg, start_pos, end_pos) -> invalid_arg (Printf.sprintf "syntax error (%s) at: `%s'" msg (error_in_string text start_pos end_pos)) | Parsing.Parse_error -> invalid_arg ("parse error: " ^ text) let of_strings = function | [] -> UFOx_syntax.integer 0 | string :: strings -> List.fold_right (fun s acc -> UFOx_syntax.add (of_string s) acc) strings (of_string string) open UFOx_syntax let rec map f = function | Integer _ | Float _ | Quoted _ as e -> e | Variable s as e -> begin match f s with | Some value -> value | None -> e end | Sum (e1, e2) -> Sum (map f e1, map f e2) | Difference (e1, e2) -> Difference (map f e1, map f e2) | Product (e1, e2) -> Product (map f e1, map f e2) | Quotient (e1, e2) -> Quotient (map f e1, map f e2) | Power (e1, e2) -> Power (map f e1, map f e2) | Application (s, el) -> Application (s, List.map (map f) el) let substitute name value expr = map (fun s -> if s = name then Some value else None) expr - module SMap = Map.Make (struct type t = string let compare = compare end) - let rename1 name_map name = try Some (Variable (SMap.find name name_map)) with Not_found -> None let rename alist_names value = let name_map = List.fold_left (fun acc (name, name') -> SMap.add name name' acc) SMap.empty alist_names in map (rename1 name_map) value let half name = Quotient (Variable name, Integer 2) let variables = UFOx_syntax.variables let functions = UFOx_syntax.functions end let positive integers = List.filter (fun (i, _) -> i > 0) integers let not_positive integers = List.filter (fun (i, _) -> i <= 0) integers module type Index = sig - val position : int -> int - val factor : int -> int - val unpack : int -> int * int - val pack : int -> int -> int - val map_position : (int -> int) -> int -> int - val to_string : int -> string - val list_to_string : int list -> string - - val free : (int * 'r) list -> (int * 'r) list - val summation : (int * 'r) list -> (int * 'r) list - val classes_to_string : ('r -> string) -> (int * 'r) list -> string + type t = int + + val position : t -> int + val factor : t -> int + val unpack : t -> int * int + val pack : int -> int -> t + val map_position : (int -> int) -> t -> t + val to_string : t -> string + val list_to_string : t list -> string + + val free : (t * 'r) list -> (t * 'r) list + val summation : (t * 'r) list -> (t * 'r) list + val classes_to_string : ('r -> string) -> (t * 'r) list -> string + + val fresh_summation : unit -> t + val named_summation : string -> unit -> t end module Index : Index = struct + type t = int + let free i = positive i let summation i = not_positive i let position i = if i > 0 then i mod 1000 else i let factor i = if i > 0 then i / 1000 else invalid_arg "UFOx.Index.factor: argument not positive" let unpack i = if i > 0 then (position i, factor i) else (i, 0) let pack i j = if j > 0 then if i > 0 then 1000 * j + i else invalid_arg "UFOx.Index.pack: position not positive" else if j = 0 then i else invalid_arg "UFOx.Index.pack: factor negative" let map_position f i = let pos, fac = unpack i in pack (f pos) fac let to_string i = let pos, fac = unpack i in if fac = 0 then Printf.sprintf "%d" pos else Printf.sprintf "%d.%d" pos fac + let to_string' = string_of_int + let list_to_string is = "[" ^ String.concat ", " (List.map to_string is) ^ "]" let classes_to_string rep_to_string index_classes = let reps = ThoList.uniq (List.sort compare (List.map snd index_classes)) in "[" ^ String.concat ", " (List.map (fun r -> (rep_to_string r) ^ "=" ^ (list_to_string (List.map fst (List.filter (fun (_, r') -> r = r') index_classes)))) reps) ^ "]" - + + type factory = + { mutable named : int SMap.t; + mutable used : Sets.Int.t } + + let factory = + { named = SMap.empty; + used = Sets.Int.empty } + + let first_anonymous = -1001 + + let fresh_summation () = + let next_anonymous = + try + pred (Sets.Int.min_elt factory.used) + with + | Not_found -> first_anonymous in + factory.used <- Sets.Int.add next_anonymous factory.used; + next_anonymous + + let named_summation name () = + try + SMap.find name factory.named + with + | Not_found -> + begin + let next_named = fresh_summation () in + factory.named <- SMap.add name next_named factory.named; + next_named + end + end module type Atom = sig type t val map_indices : (int -> int) -> t -> t - val of_expr : string -> UFOx_syntax.expr list -> t + val rename_indices : (int -> int) -> t -> t + val invertible : t -> bool + val invert : t -> t + val of_expr : string -> UFOx_syntax.expr list -> t list val to_string : t -> string type r - val classify_indices : t list -> (int * r) list + val classify_indices : t list -> (Index.t * r) list + val disambiguate_indices : t list -> t list val rep_to_string : r -> string val rep_to_string_whizard : r -> string val rep_of_int : bool -> int -> r val rep_conjugate : r -> r val rep_trivial : r -> bool type r_omega val omega : r -> r_omega end module type Tensor = sig type atom type t = (atom list * Algebra.QC.t) list val map_atoms : (atom -> atom) -> t -> t val map_indices : (int -> int) -> t -> t + val rename_indices : (int -> int) -> t -> t + val map_coef : (Algebra.QC.t -> Algebra.QC.t) -> t -> t val of_expr : UFOx_syntax.expr -> t val of_string : string -> t val of_strings : string list -> t val to_string : t -> string type r - val classify_indices : t -> (int * r) list + val classify_indices : t -> (Index.t * r) list val rep_to_string : r -> string val rep_to_string_whizard : r -> string val rep_of_int : bool -> int -> r val rep_conjugate : r -> r val rep_trivial : r -> bool type r_omega val omega : r -> r_omega end module Tensor (A : Atom) : Tensor with type atom = A.t and type r = A.r and type r_omega = A.r_omega = struct module S = UFOx_syntax (* TODO: we have to switch to [Algebra.QC] to support complex coefficients, as used in custom propagators. *) module Q = Algebra.Q module QC = Algebra.QC type atom = A.t type t = (atom list * QC.t) list let map_atoms f t = List.map (fun (atoms, q) -> (List.map f atoms, q)) t let map_indices f t = map_atoms (A.map_indices f) t + let rename_indices f t = + map_atoms (A.rename_indices f) t + + let map_coef f t = + List.map (fun (atoms, q) -> (atoms, f q)) t + let multiply (t1, c1) (t2, c2) = (List.sort compare (t1 @ t2), QC.mul c1 c2) let compress terms = List.map (fun (t, cs) -> (t, QC.sum cs)) (ThoList.factorize terms) let rec of_expr e = compress (of_expr' e) and of_expr' = function | S.Integer i -> [([], QC.make (Q.make i 1) Q.null)] | S.Float _ -> invalid_arg "UFOx.Tensor.of_expr: unexpected float" | S.Quoted name -> invalid_arg ("UFOx.Tensor.of_expr: unexpected quoted variable '" ^ name ^ "'") | S.Variable name -> invalid_arg ("UFOx.Tensor.of_expr: unexpected variable '" ^ name ^ "'") - | S.Application (name, args) -> [([A.of_expr name args], QC.unit)] + | S.Application ("complex", [re; im]) -> + begin match of_expr re, of_expr im with + | [([], re)], [([], im)] -> + if QC.is_real re && QC.is_real im then + [([], QC.make (QC.real re) (QC.real im))] + else + invalid_arg ("UFOx.Tensor.of_expr: argument of complex is complex") + | _ -> + invalid_arg "UFOx.Tensor.of_expr: unexpected argument of complex" + end + | S.Application (name, args) -> [(A.of_expr name args, QC.unit)] | S.Sum (e1, e2) -> of_expr e1 @ of_expr e2 | S.Difference (e1, e2) -> of_expr e1 @ of_expr (S.Product (S.Integer (-1), e2)) | S.Product (e1, e2) -> Product.list2 multiply (of_expr e1) (of_expr e2) | S.Quotient (n, d) -> begin match of_expr d with - | [([], q)] -> - List.map (fun (t, c) -> (t, QC.div c q)) (of_expr n) - | [] -> - failwith "UFOx.Tensor.of_expr: zero denominator" - | _ -> - failwith "UFOx.Tensor.of_expr: only integer denominators allowed" + | [] -> failwith "UFOx.Tensor.of_expr: zero denominator" + | [([], q)] -> List.map (fun (t, c) -> (t, QC.div c q)) (of_expr n) + | [(invertibles, q)] -> + if List.for_all A.invertible invertibles then + let inverses = List.map A.invert invertibles in + List.map (fun (t, c) -> (inverses @ t, QC.div c q)) (of_expr n) + else + failwith "UFOx.Tensor.of_expr: non-invertible denominator" + | _ -> failwith "UFOx.Tensor.of_expr: illegal denominator" end | S.Power (e, p) -> begin match of_expr e, of_expr p with | [([], q)], [([], p)] -> if QC.is_real p then let re_p = QC.real p in if Q.is_integer re_p then [([], QC.pow q (Q.to_integer re_p))] else failwith "UFOx.Tensor.of_expr: rational power" else failwith "UFOx.Tensor.of_expr: complex power" | [([], q)], _ -> failwith "UFOx.Tensor.of_expr: non-numeric power" | t, [([], p)] -> let qc = QC.sub p (QC.make (Q.make 2 1) Q.null) in if QC.is_null qc then Product.list2 multiply t t else failwith "UFOx.Tensor.of_expr: only 2 as power of tensor allowed" | _ -> failwith "UFOx.Tensor.of_expr: power of tensor" end type r = A.r let rep_to_string = A.rep_to_string let rep_to_string_whizard = A.rep_to_string_whizard let rep_of_int = A.rep_of_int let rep_conjugate = A.rep_conjugate let rep_trivial = A.rep_trivial let classify_indices' filter tensors = ThoList.uniq (List.sort compare (List.map (fun (t, c) -> filter (A.classify_indices t)) tensors)) (* NB: the number of summation indices is not guarateed to be the same! Therefore it was foolish to try to check for uniqueness \ldots *) let classify_indices tensors = match classify_indices' Index.free tensors with | [] -> (* There's always at least an empty list! *) failwith "UFOx.Tensor.classify_indices: can't happen!" | [f] -> f | _ -> invalid_arg "UFOx.Tensor.classify_indices: incompatible free indices!" + let disambiguate_indices1 (atoms, q) = + (A.disambiguate_indices atoms, q) + + let disambiguate_indices tensors = + List.map disambiguate_indices1 tensors + let check_indices t = ignore (classify_indices t) let of_expr e = - let t = of_expr e in + let t = disambiguate_indices (of_expr e) in check_indices t; t let of_string s = of_expr (Expr.of_string s) let of_strings s = of_expr (Expr.of_strings s) let term_to_string (tensors, c) = if QC.is_null c then "" else match tensors with | [] -> QC.to_string c | tensors -> String.concat "*" ((if QC.is_unit c then [] else [QC.to_string c]) @ List.map A.to_string tensors) let to_string terms = String.concat "" (List.map term_to_string terms) type r_omega = A.r_omega let omega = A.omega end module type Lorentz_Atom = sig type dirac = private | C of int * int | Gamma of int * int * int | Gamma5 of int * int | Identity of int * int | ProjP of int * int | ProjM of int * int | Sigma of int * int * int * int type vector = (* private *) | Epsilon of int * int * int * int | Metric of int * int | P of int * int - type t = private + type scalar = (* private *) + | Mass of int + | Width of int + + type t = (* private *) | Dirac of dirac | Vector of vector + | Scalar of scalar + | Inverse of scalar val map_indices_vector : (int -> int) -> vector -> vector + val rename_indices_vector : (int -> int) -> vector -> vector end module Lorentz_Atom = struct type dirac = | C of int * int | Gamma of int * int * int | Gamma5 of int * int | Identity of int * int | ProjP of int * int | ProjM of int * int | Sigma of int * int * int * int - (* TODO: the propagators use additional atoms! *) type vector = | Epsilon of int * int * int * int | Metric of int * int | P of int * int + type scalar = + | Mass of int + | Width of int + type t = | Dirac of dirac | Vector of vector + | Scalar of scalar + | Inverse of scalar let map_indices_vector f = function | Epsilon (mu, nu, ka, la) -> Epsilon (f mu, f nu, f ka, f la) | Metric (mu, nu) -> Metric (f mu, f nu) | P (mu, n) -> P (f mu, f n) + let rename_indices_vector f = function + | Epsilon (mu, nu, ka, la) -> Epsilon (f mu, f nu, f ka, f la) + | Metric (mu, nu) -> Metric (f mu, f nu) + | P (mu, n) -> P (f mu, n) + end module Lorentz_Atom' : Atom with type t = Lorentz_Atom.t and type r_omega = Coupling.lorentz = struct type t = Lorentz_Atom.t open Lorentz_Atom let map_indices_dirac f = function | C (i, j) -> C (f i, f j) | Gamma (mu, i, j) -> Gamma (f mu, f i, f j) | Gamma5 (i, j) -> Gamma5 (f i, f j) | Identity (i, j) -> Identity (f i, f j) | ProjP (i, j) -> ProjP (f i, f j) | ProjM (i, j) -> ProjM (f i, f j) | Sigma (mu, nu, i, j) -> Sigma (f mu, f nu, f i, f j) + let rename_indices_dirac = map_indices_dirac + + let map_indices_scalar f = function + | Mass i -> Mass (f i) + | Width i -> Width (f i) + let map_indices f = function | Dirac d -> Dirac (map_indices_dirac f d) | Vector v -> Vector (map_indices_vector f v) + | Scalar s -> Scalar (map_indices_scalar f s) + | Inverse s -> Inverse (map_indices_scalar f s) + + let rename_indices2 fd fv = function + | Dirac d -> Dirac (rename_indices_dirac fd d) + | Vector v -> Vector (rename_indices_vector fv v) + | Scalar s -> Scalar s + | Inverse s -> Inverse s + + let rename_indices f atom = + rename_indices2 f f atom + + let invert = function + | Dirac _ -> invalid_arg "UFOx.Lorentz_Atom.invert Dirac" + | Vector _ -> invalid_arg "UFOx.Lorentz_Atom.invert Vector" + | Scalar s -> Inverse s + | Inverse s -> Scalar s + + let invertible = function + | Dirac _ | Vector _ -> false + | Scalar _ | Inverse _ -> true + + let i2s = Index.to_string let dirac_to_string = function | C (i, j) -> - Printf.sprintf "C(%d,%d)" i j + Printf.sprintf "C(%s,%s)" (i2s i) (i2s j) | Gamma (mu, i, j) -> - Printf.sprintf "Gamma(%d,%d,%d)" mu i j + Printf.sprintf "Gamma(%s,%s,%s)" (i2s mu) (i2s i) (i2s j) | Gamma5 (i, j) -> - Printf.sprintf "Gamma5(%d,%d)" i j + Printf.sprintf "Gamma5(%s,%s)" (i2s i) (i2s j) | Identity (i, j) -> - Printf.sprintf "Identity(%d,%d)" i j + Printf.sprintf "Identity(%s,%s)" (i2s i) (i2s j) | ProjP (i, j) -> - Printf.sprintf "ProjP(%d,%d)" i j + Printf.sprintf "ProjP(%s,%s)" (i2s i) (i2s j) | ProjM (i, j) -> - Printf.sprintf "ProjM(%d,%d)" i j + Printf.sprintf "ProjM(%s,%s)" (i2s i) (i2s j) | Sigma (mu, nu, i, j) -> - Printf.sprintf "Sigma(%d,%d,%d,%d)" mu nu i j + Printf.sprintf "Sigma(%s,%s,%s,%s)" (i2s mu) (i2s nu) (i2s i) (i2s j) let vector_to_string = function | Epsilon (mu, nu, ka, la) -> - Printf.sprintf "Epsilon(%d,%d,%d,%d)" mu nu ka la + Printf.sprintf "Epsilon(%s,%s,%s,%s)" (i2s mu) (i2s nu) (i2s ka) (i2s la) | Metric (mu, nu) -> - Printf.sprintf "Metric(%d,%d)" mu nu + Printf.sprintf "Metric(%s,%s)" (i2s mu) (i2s nu) | P (mu, n) -> - Printf.sprintf "P(%d,%d)" mu n + Printf.sprintf "P(%s,%d)" (i2s mu) n + + let scalar_to_string = function + | Mass id -> Printf.sprintf "Mass(%d)" id + | Width id -> Printf.sprintf "Width(%d)" id let to_string = function | Dirac d -> dirac_to_string d | Vector v -> vector_to_string v + | Scalar s -> scalar_to_string s + | Inverse s -> "1/" ^ scalar_to_string s module S = UFOx_syntax + (* \begin{dubious} + Here we handle some special cases in order to be able to + parse propagators. This needs to be made more general, + but unfortunately the syntax for the propagator extension + is not well documented and appears to be a bit chaotic! + \end{dubious} *) + + let quoted_index s = + Index.named_summation s () + + let integer_or_id = function + | S.Integer n -> n + | S.Variable "id" -> 1 + | _ -> failwith "UFOx.Lorentz_Atom.integer_or_id: impossible" + + let vector_index = function + | S.Integer n -> n + | S.Quoted mu -> quoted_index mu + | S.Variable id -> + let l = String.length id in + if l > 1 then + if id.[0] = 'l' then + int_of_string (String.sub id 1 (pred l)) + else + invalid_arg ("UFOx.Lorentz_Atom.vector_index: " ^ id) + else + invalid_arg "UFOx.Lorentz_Atom.vector_index: empty variable" + | _ -> invalid_arg "UFOx.Lorentz_Atom.vector_index" + + let spinor_index = function + | S.Integer n -> n + | S.Variable id -> + let l = String.length id in + if l > 1 then + if id.[0] = 's' then + int_of_string (String.sub id 1 (pred l)) + else + invalid_arg ("UFOx.Lorentz_Atom.spinor_index: " ^ id) + else + invalid_arg "UFOx.Lorentz_Atom.spinor_index: empty variable" + | _ -> invalid_arg "UFOx.Lorentz_Atom.spinor_index" + let of_expr name args = match name, args with - | "C", [S.Integer i; S.Integer j] -> Dirac (C (i, j)) + | "C", [i; j] -> [Dirac (C (spinor_index i, spinor_index j))] | "C", _ -> invalid_arg "UFOx.Lorentz.of_expr: invalid arguments to C()" - | "Epsilon", [S.Integer mu; S.Integer nu; S.Integer ka; S.Integer la] -> - Vector (Epsilon (mu, nu, ka, la)) + | "Epsilon", [mu; nu; ka; la] -> + [Vector (Epsilon (vector_index mu, vector_index nu, + vector_index ka, vector_index la))] | "Epsilon", _ -> invalid_arg "UFOx.Lorentz.of_expr: invalid arguments to Epsilon()" - | "Gamma", [S.Integer mu; S.Integer i; S.Integer j] -> - Dirac (Gamma (mu, i, j)) + | "Gamma", [mu; i; j] -> + [Dirac (Gamma (vector_index mu, spinor_index i, spinor_index j))] | "Gamma", _ -> invalid_arg "UFOx.Lorentz.of_expr: invalid arguments to Gamma()" - | "Gamma5", [S.Integer i; S.Integer j] -> Dirac (Gamma5 (i, j)) + | "Gamma5", [i; j] -> [Dirac (Gamma5 (spinor_index i, spinor_index j))] | "Gamma5", _ -> invalid_arg "UFOx.Lorentz.of_expr: invalid arguments to Gamma5()" - | "Identity", [S.Integer i; S.Integer j] -> Dirac (Identity (i, j)) + | "Identity", [i; j] -> [Dirac (Identity (spinor_index i, spinor_index j))] | "Identity", _ -> invalid_arg "UFOx.Lorentz.of_expr: invalid arguments to Identity()" - | "Metric", [S.Integer mu; S.Integer nu] -> Vector (Metric (mu, nu)) + | "Metric", [mu; nu] -> [Vector (Metric (vector_index mu, vector_index nu))] | "Metric", _ -> invalid_arg "UFOx.Lorentz.of_expr: invalid arguments to Metric()" - | "P", [S.Integer mu; S.Integer n] -> Vector (P (mu, n)) + | "P", [mu; id] -> [Vector (P (vector_index mu, integer_or_id id))] | "P", _ -> invalid_arg "UFOx.Lorentz.of_expr: invalid arguments to P()" - | "ProjP", [S.Integer i; S.Integer j] -> Dirac (ProjP (i, j)) + | "ProjP", [i; j] -> [Dirac (ProjP (spinor_index i, spinor_index j))] | "ProjP", _ -> invalid_arg "UFOx.Lorentz.of_expr: invalid arguments to ProjP()" - | "ProjM", [S.Integer i; S.Integer j] -> Dirac (ProjM (i, j)) + | "ProjM", [i; j] -> [Dirac (ProjM (spinor_index i, spinor_index j))] | "ProjM", _ -> invalid_arg "UFOx.Lorentz.of_expr: invalid arguments to ProjM()" - | "Sigma", [S.Integer mu; S.Integer nu; S.Integer i; S.Integer j] -> + | "Sigma", [mu; nu; i; j] -> if mu <> nu then - Dirac (Sigma (mu, nu, i, j)) + [Dirac (Sigma (vector_index mu, vector_index nu, + spinor_index i, spinor_index j))] else invalid_arg "UFOx.Lorentz.of_expr: implausible arguments to Sigma()" | "Sigma", _ -> invalid_arg "UFOx.Lorentz.of_expr: invalid arguments to Sigma()" + | "PSlash", [i; j; id] -> + let mu = Index.fresh_summation () in + [Dirac (Gamma (mu, spinor_index i, spinor_index j)); + Vector (P (mu, integer_or_id id))] + | "PSlash", _ -> + invalid_arg "UFOx.Lorentz.of_expr: invalid arguments to PSlash()" + | "Mass", [id] -> [Scalar (Mass (integer_or_id id))] + | "Mass", _ -> + invalid_arg "UFOx.Lorentz.of_expr: invalid arguments to Mass()" + | "Width", [id] -> [Scalar (Width (integer_or_id id))] + | "Width", _ -> + invalid_arg "UFOx.Lorentz.of_expr: invalid arguments to Width()" | name, _ -> invalid_arg ("UFOx.Lorentz.of_expr: invalid tensor '" ^ name ^ "'") - type r = S | V | T | Sp | CSp | Maj | Ghost + type r = S | V | T | Sp | CSp | Maj | VSp | CVSp | VMaj | Ghost let rep_trivial = function | S | Ghost -> true - | V | T | Sp | CSp | Maj -> false + | V | T | Sp | CSp | Maj | VSp | CVSp | VMaj -> false let rep_to_string = function | S -> "0" | V -> "1" | T -> "2" | Sp -> "1/2" | CSp-> "1/2bar" | Maj -> "1/2M" + | VSp -> "3/2" + | CVSp -> "3/2bar" + | VMaj -> "3/2M" | Ghost -> "Ghost" let rep_to_string_whizard = function | S -> "0" | V -> "1" | T -> "2" | Sp | CSp | Maj -> "1/2" + | VSp | CVSp | VMaj -> "3/2" | Ghost -> "Ghost" let rep_of_int neutral = function | -1 -> Ghost | 1 -> S | 2 -> if neutral then Maj else Sp | -2 -> if neutral then Maj else CSp (* used by [UFO.Particle.force_conjspinor] *) | 3 -> V - | 4 -> failwith "UFOx.Lorentz: spin 3/2 not supported yet!" + | 4 -> if neutral then VMaj else VSp + | -4 -> if neutral then VMaj else CVSp (* used by [UFO.Particle.force_conjspinor] *) | 5 -> T | s when s > 0 -> failwith "UFOx.Lorentz: spin > 2 not supported!" | _ -> invalid_arg "UFOx.Lorentz: invalid non-positive spin value" let rep_conjugate = function | S -> S | V -> V | T -> T | Sp -> CSp (* ??? *) | CSp -> Sp (* ??? *) | Maj -> Maj + | VSp -> CVSp + | CVSp -> VSp + | VMaj -> VMaj | Ghost -> Ghost let classify_vector_indices1 = function | Epsilon (mu, nu, ka, la) -> [(mu, V); (nu, V); (ka, V); (la, V)] | Metric (mu, nu) -> [(mu, V); (nu, V)] | P (mu, n) -> [(mu, V)] let classify_dirac_indices1 = function | C (i, j) -> [(i, CSp); (j, Sp)] (* ??? *) | Gamma5 (i, j) | Identity (i, j) | ProjP (i, j) | ProjM (i, j) -> [(i, CSp); (j, Sp)] | Gamma (mu, i, j) -> [(mu, V); (i, CSp); (j, Sp)] | Sigma (mu, nu, i, j) -> [(mu, V); (nu, V); (i, CSp); (j, Sp)] let classify_indices1 = function | Dirac d -> classify_dirac_indices1 d | Vector v -> classify_vector_indices1 v + | Scalar _ | Inverse _ -> [] module IMap = Map.Make (struct type t = int let compare = compare end) - exception Incompatible_factors + exception Incompatible_factors of r * r let product rep1 rep2 = match rep1, rep2 with | V, V -> T - | _, _ -> raise Incompatible_factors + | V, Sp -> VSp + | V, CSp -> CVSp + | V, Maj -> VMaj + | Sp, V -> VSp + | CSp, V -> CVSp + | Maj, V -> VMaj + | _, _ -> raise (Incompatible_factors (rep1, rep2)) let combine_or_add_index (i, rep) map = let pos, fac = Index.unpack i in try let fac', rep' = IMap.find pos map in if pos < 0 then IMap.add pos (fac, rep) map else if fac <> fac' then IMap.add pos (0, product rep rep') map + else if rep <> rep' then (* Can be disambiguated! *) + IMap.add pos (0, product rep rep') map else invalid_arg (Printf.sprintf "UFO: duplicate subindex %d" pos) with | Not_found -> IMap.add pos (fac, rep) map - | Incompatible_factors -> - invalid_arg (Printf.sprintf "UFO: incompatible factors at %d" pos) + | Incompatible_factors (rep1, rep2) -> + invalid_arg + (Printf.sprintf + "UFO: incompatible factors (%s,%s) at %d" + (rep_to_string rep1) (rep_to_string rep2) pos) let combine_or_add_indices atom map = List.fold_right combine_or_add_index (classify_indices1 atom) map let project_factors (pos, (fac, rep)) = if fac = 0 then (pos, rep) else invalid_arg (Printf.sprintf "UFO: leftover subindex %d.%d" pos fac) let classify_indices atoms = List.map project_factors (IMap.bindings (List.fold_right combine_or_add_indices atoms IMap.empty)) + let add_factor fac indices pos = + if pos > 0 then + if Sets.Int.mem pos indices then + Index.pack pos fac + else + pos + else + pos + + let disambiguate_indices1 indices atom = + rename_indices2 (add_factor 1 indices) (add_factor 2 indices) atom + + let vectorspinors atoms = + List.fold_left + (fun acc (i, r) -> + match r with + | S | V | T | Sp | CSp | Maj | Ghost -> acc + | VSp | CVSp | VMaj -> Sets.Int.add i acc) + Sets.Int.empty (classify_indices atoms) + + let disambiguate_indices atoms = + let vectorspinor_indices = vectorspinors atoms in + List.map (disambiguate_indices1 vectorspinor_indices) atoms + type r_omega = Coupling.lorentz let omega = function | S -> Coupling.Scalar | V -> Coupling.Vector | T -> Coupling.Tensor_2 | Sp -> Coupling.Spinor | CSp -> Coupling.ConjSpinor | Maj -> Coupling.Majorana + | VSp -> Coupling.Vectorspinor + | CVSp -> Coupling.Vectorspinor (* TODO: not really! *) + | VMaj -> Coupling.Vectorspinor (* TODO: not really! *) | Ghost -> Coupling.Scalar end module Lorentz = Tensor(Lorentz_Atom') module type Color_Atom = sig type t = (* private *) | Identity of int * int | Identity8 of int * int | T of int * int * int | F of int * int * int | D of int * int * int | Epsilon of int * int * int | EpsilonBar of int * int * int | T6 of int * int * int | K6 of int * int * int | K6Bar of int * int * int end module Color_Atom = struct type t = | Identity of int * int | Identity8 of int * int | T of int * int * int | F of int * int * int | D of int * int * int | Epsilon of int * int * int | EpsilonBar of int * int * int | T6 of int * int * int | K6 of int * int * int | K6Bar of int * int * int end module Color_Atom' : Atom with type t = Color_Atom.t and type r_omega = Color.t = struct type t = Color_Atom.t module S = UFOx_syntax open Color_Atom let map_indices f = function | Identity (i, j) -> Identity (f i, f j) | Identity8 (a, b) -> Identity8 (f a, f b) | T (a, i, j) -> T (f a, f i, f j) | F (a, i, j) -> F (f a, f i, f j) | D (a, i, j) -> D (f a, f i, f j) | Epsilon (i, j, k) -> Epsilon (f i, f j, f k) | EpsilonBar (i, j, k) -> EpsilonBar (f i, f j, f k) | T6 (a, i', j') -> T6 (f a, f i', f j') | K6 (i', j, k) -> K6 (f i', f j, f k) | K6Bar (i', j, k) -> K6Bar (f i', f j, f k) - let of_expr name args = + let rename_indices = map_indices + + let invert _ = + invalid_arg "UFOx.Color_Atom.invert" + + let invertible _ = + false + + let of_expr1 name args = match name, args with | "Identity", [S.Integer i; S.Integer j] -> Identity (i, j) | "Identity", _ -> invalid_arg "UFOx.Color.of_expr: invalid arguments to Identity()" | "T", [S.Integer a; S.Integer i; S.Integer j] -> T (a, i, j) | "T", _ -> invalid_arg "UFOx.Color.of_expr: invalid arguments to T()" | "f", [S.Integer a; S.Integer b; S.Integer c] -> F (a, b, c) | "f", _ -> invalid_arg "UFOx.Color.of_expr: invalid arguments to f()" | "d", [S.Integer a; S.Integer b; S.Integer c] -> D (a, b, c) | "d", _ -> invalid_arg "UFOx.Color.of_expr: invalid arguments to d()" | "Epsilon", [S.Integer i; S.Integer j; S.Integer k] -> Epsilon (i, j, k) | "Epsilon", _ -> invalid_arg "UFOx.Color.of_expr: invalid arguments to Epsilon()" | "EpsilonBar", [S.Integer i; S.Integer j; S.Integer k] -> EpsilonBar (i, j, k) | "EpsilonBar", _ -> invalid_arg "UFOx.Color.of_expr: invalid arguments to EpsilonBar()" | "T6", [S.Integer a; S.Integer i'; S.Integer j'] -> T6 (a, i', j') | "T6", _ -> invalid_arg "UFOx.Color.of_expr: invalid arguments to T6()" | "K6", [S.Integer i'; S.Integer j; S.Integer k] -> K6 (i', j, k) | "K6", _ -> invalid_arg "UFOx.Color.of_expr: invalid arguments to K6()" | "K6Bar", [S.Integer i'; S.Integer j; S.Integer k] -> K6Bar (i', j, k) | "K6Bar", _ -> invalid_arg "UFOx.Color.of_expr: invalid arguments to K6Bar()" | name, _ -> invalid_arg ("UFOx.Color.of_expr: invalid tensor '" ^ name ^ "'") + let of_expr name args = + [of_expr1 name args] + let to_string = function | Identity (i, j) -> Printf.sprintf "Identity(%d,%d)" i j | Identity8 (a, b) -> Printf.sprintf "Identity8(%d,%d)" a b | T (a, i, j) -> Printf.sprintf "T(%d,%d,%d)" a i j | F (a, b, c) -> Printf.sprintf "f(%d,%d,%d)" a b c | D (a, b, c) -> Printf.sprintf "d(%d,%d,%d)" a b c | Epsilon (i, j, k) -> Printf.sprintf "Epsilon(%d,%d,%d)" i j k | EpsilonBar (i, j, k) -> Printf.sprintf "EpsilonBar(%d,%d,%d)" i j k | T6 (a, i', j') -> Printf.sprintf "T6(%d,%d,%d)" a i' j' | K6 (i', j, k) -> Printf.sprintf "K6(%d,%d,%d)" i' j k | K6Bar (i', j, k) -> Printf.sprintf "K6Bar(%d,%d,%d)" i' j k type r = S | Sbar | F | C | A let rep_trivial = function | S | Sbar -> true | F | C | A-> false let rep_to_string = function | S -> "1" | Sbar -> "1bar" | F -> "3" | C -> "3bar" | A-> "8" let rep_to_string_whizard = function | S -> "1" | Sbar -> "-1" | F -> "3" | C -> "-3" | A-> "8" let rep_of_int neutral = function | 1 -> S | -1 -> Sbar (* UFO appears to use this for colorless antiparticles!. *) | 3 -> F | -3 -> C | 8 -> A | 6 | -6 -> failwith "UFOx.Color: sextets not supported yet!" | _ -> invalid_arg "UFOx.Color: impossible representation!" let rep_conjugate = function | Sbar -> S | S -> Sbar | C -> F | F -> C | A -> A let classify_indices1 = function | Identity (i, j) -> [(i, C); (j, F)] | Identity8 (a, b) -> [(a, A); (b, A)] | T (a, i, j) -> [(i, F); (j, C); (a, A)] | Color_Atom.F (a, b, c) | D (a, b, c) -> [(a, A); (b, A); (c, A)] | Epsilon (i, j, k) -> [(i, F); (j, F); (k, F)] | EpsilonBar (i, j, k) -> [(i, C); (j, C); (k, C)] | T6 (a, i', j') -> failwith "UFOx.Color: sextets not supported yet!" | K6 (i', j, k) -> failwith "UFOx.Color: sextets not supported yet!" | K6Bar (i', j, k) -> failwith "UFOx.Color: sextets not supported yet!" let classify_indices tensors = List.sort compare (List.fold_right (fun v acc -> classify_indices1 v @ acc) tensors []) + let disambiguate_indices atoms = + atoms + type r_omega = Color.t (* FIXME: $N_C=3$ should not be hardcoded! *) let omega = function | S | Sbar -> Color.Singlet | F -> Color.SUN (3) | C -> Color.SUN (-3) | A-> Color.AdjSUN (3) end module Color = Tensor(Color_Atom') module Value = struct module S = UFOx_syntax module Q = Algebra.Q type builtin = | Sqrt | Exp | Log | Log10 | Sin | Asin | Cos | Acos | Tan | Atan | Sinh | Asinh | Cosh | Acosh | Tanh | Atanh | Sec | Asec | Csc | Acsc | Conj let builtin_to_string = function | Sqrt -> "sqrt" | Exp -> "exp" | Log -> "log" | Log10 -> "log10" | Sin -> "sin" | Cos -> "cos" | Tan -> "tan" | Asin -> "asin" | Acos -> "acos" | Atan -> "atan" | Sinh -> "sinh" | Cosh -> "cosh" | Tanh -> "tanh" | Asinh -> "asinh" | Acosh -> "acosh" | Atanh -> "atanh" | Sec -> "sec" | Csc -> "csc" | Asec -> "asec" | Acsc -> "acsc" | Conj -> "conjg" let builtin_of_string = function | "cmath.sqrt" -> Sqrt | "cmath.exp" -> Exp | "cmath.log" -> Log | "cmath.log10" -> Log10 | "cmath.sin" -> Sin | "cmath.cos" -> Cos | "cmath.tan" -> Tan | "cmath.asin" -> Asin | "cmath.acos" -> Acos | "cmath.atan" -> Atan | "cmath.sinh" -> Sinh | "cmath.cosh" -> Cosh | "cmath.tanh" -> Tanh | "cmath.asinh" -> Asinh | "cmath.acosh" -> Acosh | "cmath.atanh" -> Atanh | "sec" -> Sec | "csc" -> Csc | "asec" -> Asec | "acsc" -> Acsc | "complexconjugate" -> Conj | name -> failwith ("UFOx.Value: unsupported function: " ^ name) type t = | Integer of int | Rational of Q.t | Real of float | Complex of float * float | Variable of string | Sum of t list | Difference of t * t | Product of t list | Quotient of t * t | Power of t * t | Application of builtin * t list let rec to_string = function | Integer i -> string_of_int i | Rational q -> Q.to_string q | Real x -> string_of_float x | Complex (0.0, 1.0) -> "I" | Complex (0.0, -1.0) -> "-I" | Complex (0.0, i) -> string_of_float i ^ "*I" | Complex (r, 1.0) -> string_of_float r ^ "+I" | Complex (r, -1.0) -> string_of_float r ^ "-I" | Complex (r, i) -> string_of_float r ^ (if i < 0.0 then "-" else "+") ^ string_of_float (abs_float i) ^ "*I" | Variable s -> s | Sum [] -> "0" | Sum [e] -> to_string e | Sum es -> "(" ^ String.concat "+" (List.map maybe_parentheses es) ^ ")" | Difference (e1, e2) -> to_string e1 ^ "-" ^ maybe_parentheses e2 | Product [] -> "1" | Product ((Integer (-1) | Real (-1.)) :: es) -> "-" ^ maybe_parentheses (Product es) | Product es -> String.concat "*" (List.map maybe_parentheses es) | Quotient (e1, e2) -> to_string e1 ^ "/" ^ maybe_parentheses e2 | Power (e1, e2) -> maybe_parentheses e1 ^ "^" ^ maybe_parentheses e2 | Application (f, [Integer i]) -> to_string (Application (f, [Real (float i)])) | Application (f, es) -> builtin_to_string f ^ "(" ^ String.concat "," (List.map to_string es) ^ ")" and maybe_parentheses = function | Integer i as e -> if i < 0 then "(" ^ to_string e ^ ")" else to_string e | Real x as e -> if x < 0.0 then "(" ^ to_string e ^ ")" else to_string e | Complex (x, 0.0) -> to_string (Real x) | Complex (0.0, 1.0) -> "I" | Variable _ | Power (_, _) | Application (_, _) as e -> to_string e | Sum [e] -> to_string e | Product [e] -> maybe_parentheses e | e -> "(" ^ to_string e ^ ")" let rec to_coupling atom = function | Integer i -> Coupling.Integer i | Rational q -> let n, d = Q.to_ratio q in Coupling.Quot (Coupling.Integer n, Coupling.Integer d) | Real x -> Coupling.Float x | Product es -> Coupling.Prod (List.map (to_coupling atom) es) | Variable s -> Coupling.Atom (atom s) | Complex (r, 0.0) -> Coupling.Float r | Complex (0.0, 1.0) -> Coupling.I | Complex (0.0, -1.0) -> Coupling.Prod [Coupling.I; Coupling.Integer (-1)] | Complex (0.0, i) -> Coupling.Prod [Coupling.I; Coupling.Float i] | Complex (r, 1.0) -> Coupling.Sum [Coupling.Float r; Coupling.I] | Complex (r, -1.0) -> Coupling.Diff (Coupling.Float r, Coupling.I) | Complex (r, i) -> Coupling.Sum [Coupling.Float r; Coupling.Prod [Coupling.I; Coupling.Float i]] | Sum es -> Coupling.Sum (List.map (to_coupling atom) es) | Difference (e1, e2) -> Coupling.Diff (to_coupling atom e1, to_coupling atom e2) | Quotient (e1, e2) -> Coupling.Quot (to_coupling atom e1, to_coupling atom e2) | Power (e1, Integer e2) -> Coupling.Pow (to_coupling atom e1, e2) | Power (e1, e2) -> Coupling.PowX (to_coupling atom e1, to_coupling atom e2) | Application (f, [e]) -> apply1 (to_coupling atom e) f | Application (f, []) -> failwith ("UFOx.Value.to_coupling: " ^ builtin_to_string f ^ ": empty argument list") | Application (f, _::_::_) -> failwith ("UFOx.Value.to_coupling: " ^ builtin_to_string f ^ ": more than one argument in list") and apply1 e = function | Sqrt -> Coupling.Sqrt e | Exp -> Coupling.Exp e | Log -> Coupling.Log e | Log10 -> Coupling.Log10 e | Sin -> Coupling.Sin e | Cos -> Coupling.Cos e | Tan -> Coupling.Tan e | Asin -> Coupling.Asin e | Acos -> Coupling.Acos e | Atan -> Coupling.Atan e | Sinh -> Coupling.Sinh e | Cosh -> Coupling.Cosh e | Tanh -> Coupling.Tanh e | Sec -> Coupling.Quot (Coupling.Integer 1, Coupling.Cos e) | Csc -> Coupling.Quot (Coupling.Integer 1, Coupling.Sin e) | Asec -> Coupling.Acos (Coupling.Quot (Coupling.Integer 1, e)) | Acsc -> Coupling.Asin (Coupling.Quot (Coupling.Integer 1, e)) | Conj -> Coupling.Conj e | (Asinh | Acosh | Atanh as f) -> failwith ("UFOx.Value.to_coupling: function `" ^ builtin_to_string f ^ "' not supported yet!") let compress terms = terms let rec of_expr e = compress (of_expr' e) and of_expr' = function | S.Integer i -> Integer i | S.Float x -> Real x | S.Variable "cmath.pi" -> Variable "pi" | S.Quoted name -> invalid_arg ("UFOx.Value.of_expr: unexpected quoted variable '" ^ name ^ "'") | S.Variable name -> Variable name | S.Sum (e1, e2) -> begin match of_expr e1, of_expr e2 with | (Integer 0 | Real 0.), e -> e | e, (Integer 0 | Real 0.) -> e | Sum e1, Sum e2 -> Sum (e1 @ e2) | e1, Sum e2 -> Sum (e1 :: e2) | Sum e1, e2 -> Sum (e2 :: e1) | e1, e2 -> Sum [e1; e2] end | S.Difference (e1, e2) -> begin match of_expr e1, of_expr e2 with | e1, (Integer 0 | Real 0.) -> e1 | e1, e2 -> Difference (e1, e2) end | S.Product (e1, e2) -> begin match of_expr e1, of_expr e2 with | (Integer 0 | Real 0.), _ -> Integer 0 | _, (Integer 0 | Real 0.) -> Integer 0 | (Integer 1 | Real 1.), e -> e | e, (Integer 1 | Real 1.) -> e | Product e1, Product e2 -> Product (e1 @ e2) | e1, Product e2 -> Product (e1 :: e2) | Product e1, e2 -> Product (e2 :: e1) | e1, e2 -> Product [e1; e2] end | S.Quotient (e1, e2) -> begin match of_expr e1, of_expr e2 with | e1, (Integer 0 | Real 0.) -> invalid_arg "UFOx.Value: divide by 0" | e1, (Integer 1 | Real 1.) -> e1 | e1, e2 -> Quotient (e1, e2) end | S.Power (e, p) -> begin match of_expr e, of_expr p with | (Integer 0 | Real 0.), (Integer 0 | Real 0.) -> invalid_arg "UFOx.Value: 0^0" | _, (Integer 0 | Real 0.) -> Integer 1 | e, (Integer 1 | Real 1.) -> e | e, p -> Power (e, p) end | S.Application ("complex", [r; i]) -> begin match of_expr r, of_expr i with | r, (Integer 0 | Real 0.0) -> r | Real r, Real i -> Complex (r, i) | Integer r, Real i -> Complex (float_of_int r, i) | Real r, Integer i -> Complex (r, float_of_int i) | Integer r, Integer i -> Complex (float_of_int r, float_of_int i) | _ -> invalid_arg "UFOx.Value: complex expects two numeric arguments" end | S.Application ("complex", _) -> invalid_arg "UFOx.Value: complex expects two arguments" | S.Application ("complexconjugate", [e]) -> Application (Conj, [of_expr e]) | S.Application ("complexconjugate", _) -> invalid_arg "UFOx.Value: complexconjugate expects single argument" | S.Application ("cmath.sqrt", [e]) -> Application (Sqrt, [of_expr e]) | S.Application ("cmath.sqrt", _) -> invalid_arg "UFOx.Value: sqrt expects single argument" | S.Application (name, args) -> Application (builtin_of_string name, List.map of_expr args) end module type Test = sig val example : unit -> unit val suite : OUnit.test end - Index: trunk/omega/src/coupling.mli =================================================================== --- trunk/omega/src/coupling.mli (revision 8359) +++ trunk/omega/src/coupling.mli (revision 8360) @@ -1,2896 +1,2897 @@ (* coupling.mli -- Copyright (C) 1999-2019 by Wolfgang Kilian Thorsten Ohl Juergen Reuter with contributions from Christian Speckner Marco Sekulla So Young Shim (only parts of this file) WHIZARD is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2, or (at your option) any later version. WHIZARD is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the 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 type lorentz3 = lorentz * lorentz * lorentz type lorentz4 = lorentz * lorentz * lorentz * lorentz type lorentzn = lorentz list type fermion_lines = (int * int) list (* \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_Tensor_pure | Prop_Vector_pure | Prop_Vectorspinor | Prop_Col_Scalar | Prop_Col_Feynman | Prop_Col_Majorana | Prop_Col_Unitarity | Aux_Scalar | Aux_Vector | Aux_Tensor_1 | Aux_Col_Scalar | Aux_Col_Vector | Aux_Col_Tensor_1 | Aux_Spinor | Aux_ConjSpinor | Aux_Majorana | Only_Insertion + | Prop_UFO of string (* \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 | Complex_Mass | 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 | SPM | S | P | SL | SR | SLR | VA | V | A | VL | VR | VLR | VLRM | VAM | TVA | TLR | TRL | TVAM | TLRM | TRLM | POT | MOM | MOM5 | MOML | MOMR | LMOM | RMOM | VMOM | VA2 | VA3 | VA3M 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 | I_Gauge_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 (* % $\frac14 \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_Scalar2 of int (* % $\phi_1 \partial_\mu \phi_2 \partial^\mu \phi_3$ *) | Dim5_Scalar_Vector_Vector_T of int (* % $\phi(\ii\partial_\mu V_1^\nu)(\ii\partial_\nu V_2^\mu)$ *) | Dim5_Scalar_Vector_Vector_TU of int (* % $(\ii\partial_\nu\phi) (\ii\partial_\mu V_1^\nu) V_2^\mu$ *) | Dim5_Scalar_Vector_Vector_U of int (* % $(\ii\partial_\nu\phi) (\ii\partial_\mu V^\nu) V^\mu$ *) | Scalar_Vector_Vector_t of int (* % $ ( \partial_\mu V_\nu-\partial_\nu V_\mu )^2 $ *) | 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})$ *) | Tensor_2_Vector_Vector_1 of int (* % $T^{\mu\nu} (V_{1,\mu}V_{2,\nu} + V_{1,\nu}V_{2,\mu} - g_{\mu,\nu}V_1^\rho V_{2,\rho} )$ *) | Tensor_2_Vector_Vector_cf of int (* % $T^{\mu\nu} ( % - \frac{c_f}{2} g_{\mu,\nu}V_1^\rho V_{2,\rho} )$ *) | Tensor_2_Scalar_Scalar of int (* % $T^{\mu\nu} (\partial_{\mu}\phi_1\partial_{\nu}\phi_2 + % \partial_{\nu}\phi_1\partial_{\mu}\phi_2 )$ *) | Tensor_2_Scalar_Scalar_cf of int (* % $T^{\mu\nu} ( - \frac{c_f}{2} g_{\mu,\nu} % \partial_{\rho}\phi_1\partial_{\rho}\phi_2 )$ *) | Tensor_2_Vector_Vector_t of int (* % $T^{\mu\nu} (V_{1,\mu}V_{2,\nu} + V_{1,\nu}V_{2,\mu} - g_{\mu,\nu}V_1^\rho V_{2,\rho} )$ *) | 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})) $ *) | Dim6_Scalar_Vector_Vector_D of int (* % $\ii \phi ( - (\partial^\mu \partial^\nu W^{-}_{\mu})W^{+}_{\nu} - (\partial^\mu \partial^\nu W^{+}_{\nu})W^{-}_{\mu} \\ \mbox{} \qquad + ( (\partial^\rho \partial_\rho W^{-}_{\mu})W^{+}_{\nu} + (\partial^\rho \partial_\rho W^{+}_{\nu})W^{-}_{\mu}) g^{\mu\nu}) $ *) | Dim6_Scalar_Vector_Vector_DP of int (* % $\ii ( (\partial^\mu H)(\partial^\nu W^{-}_{\mu})W^{+}_{\nu} + (\partial^\nu H)(\partial^\mu W^{+}_{\nu})W^{-}_{\mu} \\ \mbox{} \qquad - ((\partial^\rho H)(\partial_\rho W^{-}_{\mu})W^{+}_{\nu} (\partial^\rho H)(\partial^\rho W^{+}_{\nu})W^{-}_{\mu}) g^{\mu\nu}) $*) | Dim6_HAZ_D of int (* % $\ii ((\partial^\mu \partial^\nu A_{\mu})Z_{\nu} + (\partial^\rho \partial_\rho A_{\mu})Z_{\nu}g^{\mu\nu} )$ *) | Dim6_HAZ_DP of int (* % $\ii ((\partial^{\nu} A_{\mu})(\partial^{\mu} H)Z_{\nu} - (\partial^{\rho} A_{\mu})(\partial_{\rho} H)Z_{\nu} g^{\mu\nu})$ *) | Dim6_AWW_DP of int (* % $\ii ((\partial^{\rho} A_{\mu}) W^{-}_{\nu} W^{+}_{\rho} g^{\mu\nu} - (\partial^{\nu} A_{\mu}) W^{-}_{\nu} W^{+}_{\rho} g^{\mu\rho}) $ *) | Dim6_AWW_DW of int (*% $\ii [ (3(\partial^\rho A_{\mu})W^{-}_{\nu}W^{+}_{\rho} - (\partial^\rho W^{-}_{\nu})A_{\mu}W^{+}_{\rho} + (\partial^\rho W^{+}_{\rho})A_{\mu} W^{-}_{\nu})g^{\mu\nu} \\ \mbox{} \qquad +(-3(\partial^\nu A_{\mu})W^{-}_{\nu}W^{+}_{\rho} - (\partial^\nu W^{-}_{\nu})A_{\mu}W^{+}_{\rho} + (\partial^\nu W^{+}_{\rho})A_{\mu}W^{-}_{\nu})g^{\mu\rho} \\ \mbox{} \qquad +(2(\partial^\mu W^{-}_{\nu})A_{\mu}W^{+}_{\rho} - 2(\partial^\mu W^{+}_{\rho})A_{\mu}W^{-}_{\nu})g^{\nu\rho} ]$ *) | Dim6_HHH of int (*% $\ii(-(\partial^{\mu}H_1)(\partial_{\mu}H_2)H_3 - (\partial^{\mu}H_1)H_2(\partial_{\mu}H_3) - H_1(\partial^{\mu}H_2)(\partial_{\mu}H_3) )$ *) | Dim6_Gauge_Gauge_Gauge_i of int (*% $\ii (-(\partial^{\nu}V_{\mu})(\partial^{\rho}V_{\nu})(\partial^{\mu}V_{\rho}) + (\partial^{\rho}V_{\mu})(\partial^{\mu}V_{\nu})(\partial^{\nu}V_{\rho}) \\ \mbox{} \qquad + (-\partial^{\nu}V_{\rho} g^{\mu\rho} + \partial^{\mu}V_{\rho} g^{\nu\rho}) (\partial^{\sigma}V_{\mu})(\partial_{\sigma}V_{\nu}) + (\partial^{\rho}V_{\nu} g^{\mu\nu} - \partial^{\mu}V_{\nu} g^{\nu\rho}) (\partial^{\sigma}V_{\mu})(\partial_{\sigma}V_{\rho}) \\ \mbox{} \qquad + (-\partial^{\rho}V_{\mu} g^{\mu\nu} + \partial^{\mu}V_{\mu} g^{\mu\rho}) (\partial^{\sigma}V_{\nu})(\partial_{\sigma}V_{\rho}) )$ *) | Gauge_Gauge_Gauge_i of int | Dim6_GGG of int | Dim6_WWZ_DPWDW of int (* % $\ii( ((\partial^\rho V_{\mu})V_{\nu}V_{\rho} - (\partial^{\rho}V_{\nu})V_{\mu}V_{\rho})g^{\mu\nu} - (\partial^{\nu}V_{\mu})V_{\nu}V_{\rho}g^{\mu\rho} + (\partial^{\mu}V_{\nu})V_{\mu}V_{\rho})g^{\rho\nu} )$ *) | Dim6_WWZ_DW of int (* % $\ii( ((\partial^\mu V_{\mu})V_{\nu}V_{\rho} + V_{\mu}(\partial^\mu V_{\nu})V_{\rho})g^{\nu\rho} - ((\partial^\nu V_{\mu})V_{\nu}V_{\rho} + V_{\mu}(\partial^\nu V_{\nu})V_{\rho})g^{\mu\rho})$ *) | Dim6_WWZ_D of int (* % $\ii ( V_{\mu})V_{\nu}(\partial^{\nu}V_{\rho})g^{\mu\rho} + V_{\mu}V_{\nu}(\partial^{\mu}V_{\rho})g^{\nu\rho})$ *) | TensorVector_Vector_Vector of int | TensorVector_Vector_Vector_cf of int | TensorVector_Scalar_Scalar of int | TensorVector_Scalar_Scalar_cf of int | TensorScalar_Vector_Vector of int | TensorScalar_Vector_Vector_cf of int | TensorScalar_Scalar_Scalar of int | TensorScalar_Scalar_Scalar_cf of int (* 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 | Dim8_Scalar2_Vector2_1 of int | Dim8_Scalar2_Vector2_2 of int | Dim8_Scalar2_Vector2_m_0 of int | Dim8_Scalar2_Vector2_m_1 of int | Dim8_Scalar2_Vector2_m_7 of int | Dim8_Scalar4 of int | Dim8_Vector4_t_0 of (int * contract4) list | Dim8_Vector4_t_1 of (int * contract4) list | Dim8_Vector4_t_2 of (int * contract4) list | Dim8_Vector4_m_0 of (int * contract4) list | Dim8_Vector4_m_1 of (int * contract4) list | Dim8_Vector4_m_7 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 | Vector4_K_Matrix_cf_t0 of int * (int * contract4) list | Vector4_K_Matrix_cf_t1 of int * (int * contract4) list | Vector4_K_Matrix_cf_t2 of int * (int * contract4) list | Vector4_K_Matrix_cf_t_rsi of int * (int * contract4) list | Vector4_K_Matrix_cf_m0 of int * (int * contract4) list | Vector4_K_Matrix_cf_m1 of int * (int * contract4) list | Vector4_K_Matrix_cf_m7 of int * (int * contract4) list | DScalar2_Vector2_K_Matrix_ms of int * (int * contract4) list | DScalar2_Vector2_m_0_K_Matrix_cf of int * (int * contract4) list | DScalar2_Vector2_m_1_K_Matrix_cf of int * (int * contract4) list | DScalar2_Vector2_m_7_K_Matrix_cf of int * (int * contract4) list | DScalar4_K_Matrix_ms of int * (int * contract4) list | Dim6_H4_P2 of int (* % $\ii( -(\partial^{\mu}H_1)(\partial_{\mu}H_2) H_3 H_4 - (\partial^{\mu}H_1)H_2(\partial_{\mu}H_3) H_4 -(\partial^{\mu}H_1)H_2 H_3 (\partial_{mu}H_4) \\ \mbox{} \qquad - H_1(\partial^{\mu}H_2)(\partial_{\mu}H_3) H_4 - H_1(\partial^{\mu}H_2) H_3(\partial_{\mu} H_4) - H_1 H_2 (\partial^{\mu}H_3)(\partial_{\mu} H_4) )$ *) | Dim6_AHWW_DPB of int (* % $\ii H ( (\partial^{\rho} A_{\mu}) W_{\nu}W_{\rho} g^{\mu\nu} - (\partial^{\nu}A_{\mu})W_{\nu}W_{\rho}g^{\mu\rho})$ *) | Dim6_AHWW_DPW of int (* % $\ii ( ((\partial^{\rho}A_{\mu})W_{\nu}W_{\rho} - (\partial^{\rho} H)A_{\mu}W_{\nu}W_{\rho})g^{\mu\nu} \\ \mbox{} \qquad (-(\partial^{\nu}A_{\mu})W_{\nu}W_{\rho} + (\partial^{\nu} H)A_{\mu}W_{\nu}W_{\rho})g^{\mu\rho})$ *) | Dim6_AHWW_DW of int (* % $\ii H( (3(\partial^{\rho}A_{\mu})W_{\nu}W_{\rho} - A_{\mu}(\partial^{\rho}W_{\nu})W_{\rho} + A_{\mu}W_{\nu}(\partial^{\rho}W_{\rho})) g^{\mu\nu} \\ \mbox{} \qquad + (-3(\partial^{\nu}A_{\mu})W_{\nu}W_{\rho} - A_{\mu}(\partial^{\nu}W_{\nu})W_{\rho} + A_{\mu}W_{\nu}(\partial^{\nu}W_{\rho})) g^{\mu\rho} \\ \mbox{} \qquad + 2(A_{\mu}(\partial^{\mu}W_{\nu})W_{\rho} + A_{\mu}W_{\nu}(\partial^{\mu}W_{\rho}))) g^{\nu\rho}) $ *) | Dim6_Vector4_DW of int (*% $\ii ( -V_{1,\mu}V_{2,\nu}V^{3,\nu}V^{4,\mu} - V_{1,\mu}V_{2,\nu}V^{3,\mu}V^{4,\nu} \\ \mbox{} \qquad + 2V_{1,\mu}V^{2,\mu}V_{3,\nu}V^{4,\nu} $ *) | Dim6_Vector4_W of int (* % $\ii (((\partial^{\rho}V_{1,\mu})V_{2}^{\mu} (\partial^{\sigma}V_{3,\rho})V_{4,\sigma} + V_{1,\mu}(\partial^{\rho}V_{2}^{\mu}) (\partial^{\sigma}V_{3,\rho})V_{4,\sigma} \\ \mbox{} \qquad + (\partial^{\sigma}V_{1,\mu})V_{2}^{\mu}V_{3,\rho} (\partial^{\rho}V_{4,\sigma}) + V_{1,\mu}(\partial^{\sigma}V_{2}^{\mu})V_{3,\rho} (\partial^{\rho}V_{4,\sigma})) \\ \mbox{} \qquad + ((\partial^{\sigma}V_{1,\mu})V_{2,\nu} (\partial^{\nu}V_{3}^{\mu})V_{4,\sigma} - V_{1,\mu}(\partial^{\sigma}V_{2,\nu}) (\partial^{\nu}V_{3}^{\mu})V_{4,\sigma} \\ \mbox{} \qquad - (\partial^{\nu}V_{1}^{\mu})V_{2,\nu} (\partial^{\sigma}V_{3,\mu})V_{4,\sigma} - (\partial^{\sigma}V_{1,\mu})V_{2,\nu}V_{3}^{\mu} (\partial^{\nu}V_{4,\sigma})) \\ \mbox{} \qquad + ( -(\partial^{\rho}V_{1,\mu})V_{2,\nu} (\partial^{\nu}V_{3,\rho})V_{4}^{\mu} + (\partial^{\rho}V_{1,\mu})V_{2,\nu}V_{3,\rho} (\partial^{\nu}V_{4}^{\mu}) \\ \mbox{} \qquad - V_{1,\mu}(\partial^{\rho}V_{2,\nu})V_{3,\rho} (\partial^{\nu}V_{4}^{\mu}) - (\partial^{\nu}V_{1,\mu})V_{2,\nu}V_{3,\rho} (\partial^{\rho}V_{4}^{\mu}) ) \\ \mbox{} \qquad +( -(\partial^{\sigma}V_{1,\mu})V_{2,\nu} (\partial^{\mu}V_{3}^{\nu})V_{4,\sigma} + V_{1,\mu}(\partial^{\sigma}V_{2,\nu}) (\partial^{\mu}V_{3}^{\nu})V_{4,\sigma} \\ \mbox{} \qquad - V_{1,\mu}(\partial^{\mu}V_{2,\nu}) (\partial^{\sigma}V_{3}^{\nu})V_{4,\sigma} - V_{1,\mu}(\partial^{\sigma}V_{2,\nu})V_{3}^{\nu} (\partial^{\mu}V_{4,\sigma}) \\ \mbox{} \qquad + ( -V_{1,\mu}(\partial^{\rho}V_{2,\nu}) (\partial^{\mu}V_{3,\rho})V_{4}^{\nu} - (\partial^{\rho}V_{1,\mu})V_{2,\nu}V_{3,\rho} (\partial^{\mu}V_{4}^{\nu}) \\ \mbox{} \qquad + V_{1,\mu}(\partial^{\rho}V_{2,\nu})V_{3,\rho} (\partial^{\mu}V_{4}^{\nu}) - V_{1,\mu}(\partial^{\mu}V_{2,\nu})V_{3,\rho} (\partial^{\rho}V_{4}^{\nu}) ) \\ \mbox{} \qquad + ((\partial^{\nu}V_{1,\mu})V_{2,\nu} (\partial^{\mu}V_{3,\rho})V_{4}^{\rho} + V_{1,\mu}(\partial^{\mu}V_{2,\nu}) (\partial^{\nu}V_{3,\rho})V_{4}^{\rho} \\ \mbox{} \qquad + (\partial^{\nu}V_{1,\mu})V_{2,\nu}V_{3,\rho} (\partial^{\mu}V_{4}^{\rho}) + V_{1,\mu}(\partial^{\mu}V_{2,\nu})V_{3,\rho} (\partial^{\nu}V_{4}^{\rho})) \\ \mbox{} \qquad + (\partial^{\rho}V_{1,\mu})V_{2,\nu}V_{3}^{\mu} (\partial_{\rho}V_{4}^{\nu}) - (\partial^{\rho}V_{1,\mu})V_{2}^{\mu}V_{3,\nu} (\partial_{\rho}V_{4}^{\nu}) \\ \mbox{} \qquad + V_{1,\mu}(\partial^{\rho}V_{2,\nu}) (\partial_{\rho}V_{3}^{\mu})V_{4}^{\nu} - V_{1,\mu}(\partial^{\rho}V_{2}^{\mu}) (\partial_{\rho}V_{3,\nu})V_{4}^{\nu} \\ \mbox{} \qquad + (\partial^{\rho}V_{1,\mu})V_{2,\nu} (\partial_{\rho}V_{3}^{\nu})V_{4}^{\mu} - (\partial^{\rho}V_{1,\mu})V_{2}^{\mu} (\partial_{\rho}V_{3, \nu})V_{4}^{\nu} \\ \mbox{} \qquad + V_{1,\mu}(\partial^{\rho}V_{2,\nu})V_{3}^{\nu} (\partial_{\rho}V_{4}^{\mu}) - V_{1,\mu}(\partial^{\rho}V_{2}^{\mu})V_{3,\nu} (\partial_{\rho}V_{4}^{\nu}) )$ *) | Dim6_Scalar2_Vector2_D of int (*% $\ii H_1 H_2 (-(\partial^{\mu}\partial^{\nu}V_{3,\mu})V_{4,\nu} + (\partial^{\mu}\partial_{\mu}V_{3,\nu})V_{4}^{\nu} \\ \mbox{}\qquad - V_{3,\mu}(\partial^{\mu}\partial^{\nu}V_{4,\nu}) + V_{3,\mu}(\partial^{\nu}\partial_{\nu}V_{4}^{\mu}))$ *) | Dim6_Scalar2_Vector2_DP of int (*% $\ii ((\partial^{\mu}H_1)H_2(\partial^{\nu}V_{3,\mu})V_{4,\nu} - (\partial^{\nu}H_1)H_2(\partial_{\nu}V_{3,\mu})V^{4,\mu} + H_1(\partial^{\mu}H_2)(\partial^{\nu}V_{3,\mu})V_{4,\nu} \\ \mbox{} \qquad - H_1(\partial^{\nu}H_2)(\partial_{\nu}V_{3,\mu})V^{4,\mu} + (\partial^{\nu}H_1)H_2V_{3,\mu}(\partial^{\mu}V_{4,\nu}) - (\partial^{\nu}H_1)H_2V_{3,\mu}(\partial_{\nu}V^{4,\mu}) \\ \mbox{} \qquad + H_1(\partial^{\nu}H_2)V_{3,\mu}(\partial^{\mu}V_{4,\nu}) - H_1(\partial^{\nu}H_2)V_{3,\mu}(\partial_{\nu}V^{4,\mu})) $ *) | Dim6_Scalar2_Vector2_PB of int (*% $\ii (H_1H_2(\partial^{\nu}V_{3,\mu})(\partial^{\mu}V_{4,\nu}) - H_1H_2(\partial^{\nu}V_{3,\mu})(\partial_{\nu}V^{4,\mu})) $ *) | Dim6_HHZZ_T of int (*% $\ii H_1H_2V_{3,\mu}V^{4,\mu}$ *) | Dim6_HWWZ_DW of int (* % $\ii( H_1(\partial^{\rho}W_{2,\mu})W^{3,\mu}Z_{4,\rho} - H_1W_{2,\mu}(\partial^{\rho}W^{3,\mu})Z_{4,\rho} - 2H_1(\partial^{\nu}W_{2,\mu})W_{3,\nu}Z^{4,\mu} \\ \mbox{} \qquad - H_1W_{2,\mu}(\partial^{\nu}W_{3,\nu})Z^{4,\mu} + H_1(\partial^{\mu}W_{2,\mu})W_{3,\nu}Z^{4,\nu} + 2H_1W_{2,\mu}(\partial^{\mu}W_{3,\nu})Z^{4,\nu})$ *) | Dim6_HWWZ_DPB of int (* % $\ii ( - H_1W_{2,\mu}W_{3,\nu}(\partial^{\nu}Z^{4,\mu}) + H_1W_{2,\mu}W_{3,\nu}(\partial^{\mu}Z^{4,\nu}))$ *) | Dim6_HWWZ_DDPW of int (* % $ \ii(H_1(\partial^{\nu}W_{2,\mu})W^{3,\mu}Z_{4,\nu} - H_1W_{2,\mu}(\partial^{\nu}W^{3,\mu})Z_{4,\nu} - H_1(\partial^{\nu}W_{2,\mu})W_{3,\nu}Z^{4,\mu} \\ \mbox{} \qquad + H_1W_{2,\mu}W_{3,\nu}(\partial^{\nu}Z^{4,\mu}) + H_1W_{2,\mu}(\partial^{\mu}W_{3,\nu})Z^{4,\nu} - H_1W_{2,\mu}W_{3,\nu}(\partial^{\mu}Z^{4,\nu}))$ *) | Dim6_HWWZ_DPW of int (* % $\ii ( H_1(\partial^{\nu}W_{2,\mu})W^{3,\mu}Z_{4,\nu} - H_1W_{2,\mu}(\partial^{\nu}W^{3,\mu})Z_{4,\nu} + (\partial^{\nu}H_1)W_{2,\mu}W_{3,\nu}Z^{4,\mu} \\ \mbox{} \qquad - H_1(\partial^{\nu}W_{2,\mu})W_{3,\nu}Z^{4,\mu} - (\partial^{\mu}H_1)W_{2,\mu}W_{3,\nu}Z^{4,\nu} + H_1W_{2,\mu}(\partial^{\mu}W_{3,\nu})Z^{4,\nu} )$ *) | Dim6_AHHZ_D of int (* % $\ii (H_1H_2(\partial^{\mu}\partial^{\nu}A_{\mu})Z_{\nu} - H_1H_2(\partial^{\nu}\partial_{\nu}A_{\mu})Z^{\mu})$ *) | Dim6_AHHZ_DP of int (* % $\ii ((\partial^{\mu}H_1)H_2(\partial^{\nu}A_{\mu})Z_{\nu} + H_1(\partial^{\mu}H_2)(\partial^{\nu}A_{\mu})Z_{\nu} \\ \mbox{} \qquad - (\partial^{\nu}H_1)H_2(\partial_{\nu}A_{\mu})Z^{\mu} - H_1(\partial^{\nu}H_2)(\partial_{\nu}A_{\mu})Z^{\mu} ) $ *) | Dim6_AHHZ_PB of int (* % $\ii (H_1H_2(\partial^{\nu}A_{\mu})(\partial_{\nu}Z^{\mu}) - H_1H_2(\partial^{\nu}A_{\mu})(\partial^{\mu}Z_{\nu}))$ *) type 'a vertexn = | UFO of Algebra.QC.t * string * lorentzn * fermion_lines * Color.Vertex.t (* 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 | Integer of int | Float of float | 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 | PowX of 'a expr * 'a expr | Sqrt of 'a expr | Sin of 'a expr | Cos of 'a expr | Tan of 'a expr | Cot of 'a expr | Asin of 'a expr | Acos of 'a expr | Atan of 'a expr | Atan2 of 'a expr * 'a expr | Sinh of 'a expr | Cosh of 'a expr | Tanh of 'a expr | Exp of 'a expr | Log of 'a expr | Log10 of '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} *) Index: trunk/omega/src/UFO_Lorentz.ml =================================================================== --- trunk/omega/src/UFO_Lorentz.ml (revision 8359) +++ trunk/omega/src/UFO_Lorentz.ml (revision 8360) @@ -1,452 +1,576 @@ (* UFO_Lorentz.ml -- Copyright (C) 1999-2017 by Wolfgang Kilian Thorsten Ohl Juergen Reuter with contributions from Christian Speckner WHIZARD is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2, or (at your option) any later version. WHIZARD is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the 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{Processed UFO Lorentz Structures} *) module Q = Algebra.Q module QC = Algebra.QC module A = UFOx.Lorentz_Atom module D = Dirac.Chiral (* Take a [A.t list] and return the corresponding pair - [A.dirac list * A.vector list], without preserving the - order (currently, the order is reversed). *) + [A.dirac list * A.vector list * A.scalar list * A.scalar list], + without preserving the order (currently, the order is reversed). *) let split_atoms atoms = List.fold_left - (fun (d, v) -> function - | A.Vector v' -> (d, v' :: v) - | A.Dirac d' -> (d' :: d, v)) - ([], []) atoms + (fun (d, v, s, i) -> function + | A.Vector v' -> (d, v' :: v, s, i) + | A.Dirac d' -> (d' :: d, v, s, i) + | A.Scalar s' -> (d, v, s' :: s, i) + | A.Inverse i' -> (d, v, s, i' :: i)) + ([], [], [], []) atoms (* Just like [UFOx.Lorentz_Atom.dirac], but without the Dirac matrix indices. *) type dirac = | Gamma5 | ProjM | ProjP | Gamma of int | Sigma of int * int | C + | Minus let map_indices_gamma f = function - | (Gamma5 | ProjM | ProjP | C as g) -> g + | (Gamma5 | ProjM | ProjP | C | Minus as g) -> g | Gamma mu -> Gamma (f mu) | Sigma (mu, nu) -> Sigma (f mu, f nu) (* A sandwich of a string of $\gamma$-matrices. [bra] and [ket] are positions of fields in the vertex. *) type dirac_string = { bra : int; ket : int; gammas : dirac list } let map_indices_dirac f d = { bra = f d.bra; ket = f d.ket; gammas = List.map (map_indices_gamma f) d.gammas } +(* + Implementation of Dirac couplings using + \texttt{conjspinor\_spinor} + \begin{equation} + \text{\texttt{psibar0 * psi1}} + = \sum_\alpha \bar\psi_{0,\alpha} \psi_{1,\alpha} + = \bar\psi_0\psi_1 + \end{equation} + JRR's implementation of Majorana couplings using + \texttt{spinor\_product} + \begin{equation} + \text{\texttt{chibar0 * chi1}} + = \sum_{\alpha} \bar\chi_{0,\alpha} (C^T\chi_1)_\beta + = \sum_{\alpha} (C\bar\chi_0^T)_\alpha \chi_{1,\alpha} + = (C\bar\chi_0^T)^T \chi_1 + = \tilde\chi_0^T\chi_1 + \end{equation} + with charge conjugation\footnote{% + In detail, to make sure we understand all phases + \begin{multline} + \bar{\tilde\chi} + = \tilde\chi^\dagger\gamma_0 + = \left(C\bar\chi^T\right)^\dagger\gamma_0 + = \left(C(\chi^\dagger\gamma_0)^T\right)^\dagger\gamma_0 + = \left(C\gamma_0^T{\chi^\dagger}^T\right)^\dagger\gamma_0 + = \left(C\gamma_0^T{\chi^T}^\dagger\right)^\dagger\gamma_0 + = {\chi^T} {\gamma_0^T}^\dagger C^\dagger\gamma_0 \\ + = {\chi^T} {\gamma_0^\dagger}^T C^{-1}\gamma_0 + = {\chi^T} {\gamma_0}^T C^{-1}\gamma_0 + = {\chi^T} C^{-1} C {\gamma_0}^T C^{-1}\gamma_0 + = - {\chi^T} C^{-1} \gamma_0 \gamma_0 + = - {\chi^T} C^{-1}\,. + \end{multline}} + \begin{subequations} + \begin{align} + \tilde\chi &= C\bar\chi^T \\ + \bar{\tilde\chi} &= -\chi^T C^{-1} \,. + \end{align} + \end{subequations} + So we write in JRR's implementation + \begin{equation} + \bar\chi_0 \Gamma \chi_1\phi + = \bar\chi_0 C^T C\Gamma \chi_1\phi + = (C\bar\chi_0^T)^T C\Gamma \chi_1\phi + = \tilde\chi_0^T C\Gamma \chi_1\phi + \end{equation} + using~$C^{-1}=C^\dagger$, $C^T=-C$ and the representation + dependent~$C^2=-1$ that holds in all our representation(s). + Analoguously + \begin{multline} + \bar\chi_0 \Gamma \chi_1\phi + = \left(\bar\chi_0 \Gamma \chi_1\right)^T \phi + = - \chi_1^T \Gamma^T \bar\chi_0^T \phi + = \bar{\tilde\chi}_1 C \Gamma^T C^{-1}\tilde\chi_0 \phi + = - \chi_1^T C^{-1} C \Gamma^T C^{-1}\tilde\chi_0 \phi \\ + = - \chi_1^T \Gamma^T C^{-1}\tilde\chi_0 \phi + = - \chi_1^T \Gamma^T C^T \tilde\chi_0 \phi + = - \chi_1^T (C\Gamma)^T \tilde\chi_0 \phi + \end{multline} + *) + +(* \begin{dubious} + There's still something wrong with chiral projectors \ldots + \end{dubious} *) + +(* In the following, note that~$C^{-1}=-C=C^T$: *) + +let inv_c = [Minus; C] + +let transpose1 = function + | (Gamma5 | ProjM | ProjP as g) -> inv_c @ [g; C] + | (Gamma _ | Sigma (_, _) as g) -> [Minus] @ inv_c @ [g; C] + | C -> [Minus; C] + | Minus -> [Minus] + +let rec compress_transpose = function + | [] -> [] + | [g] -> [g] + | Minus :: Minus :: g_list -> compress_transpose g_list + | g :: g_list -> g :: compress_transpose g_list + +let transpose d = + { d with gammas = ThoList.rev_flatmap transpose1 d.gammas } + +(* \begin{dubious} + Why not [ThoList.rev_flatmap] here? + \end{dubious} *) + +let transpose d = + { d with gammas = ThoList.flatmap transpose1 d.gammas } + +let majorana1 g = + [g] + +let majorana d = + { d with gammas = C :: ThoList.flatmap majorana1 d.gammas } + (* [dirac_string bind ds] applies the mapping [bind] to the indices of $\gamma_\mu$ and~$\sigma_{\mu\nu}$ and multiplies the resulting matrices in order using complex rational arithmetic. *) module type To_Matrix = sig val dirac_string : (int -> int) -> dirac_string -> D.t end module To_Matrix : To_Matrix = struct let half = QC.make (Q.make 1 2) Q.null let half_i = QC.make Q.null (Q.make 1 2) let gamma_L = D.times half (D.sub D.unit D.gamma5) let gamma_R = D.times half (D.add D.unit D.gamma5) let sigma = Array.make_matrix 4 4 D.null let () = for mu = 0 to 3 do for nu = 0 to 3 do sigma.(mu).(nu) <- D.times half_i (D.sub (D.mul D.gamma.(mu) D.gamma.(nu)) (D.mul D.gamma.(nu) D.gamma.(mu))) done done let dirac bind_indices = function | Gamma5 -> D.gamma5 | ProjM -> gamma_L | ProjP -> gamma_R | Gamma (mu) -> D.gamma.(bind_indices mu) | Sigma (mu, nu) -> sigma.(bind_indices mu).(bind_indices nu) | C -> D.cc + | Minus -> D.neg D.unit let dirac_string bind_indices ds = D.product (List.map (dirac bind_indices) ds.gammas) end let dirac_string_to_matrix = To_Matrix.dirac_string (* The Lorentz indices appearing in a term are either negative internal summation indices or positive external polarization indices. Note that the external indices are not really indices, but denote the position of the particle in the vertex. *) type 'a term = { indices : int list; atom : 'a } let map_atom f term = { term with atom = f term.atom } let map_term f_index f_atom term = { indices = List.map f_index term.indices; atom = f_atom term.atom } (* Return a pair of lists: first the (negative) summation indices, second the (positive) external indices. *) let classify_indices ilist = List.partition (fun i -> if i < 0 then true else if i > 0 then false else invalid_arg "classify_indices") ilist type contraction = { coeff : QC.t; dirac : dirac_string term list; - vector : A.vector term list } + vector : A.vector term list; + scalar : A.scalar list; + inverse : A.scalar list } let fermion_lines_of_contraction contraction = List.sort compare (List.map (fun term -> (term.atom.ket, term.atom.bra)) contraction.dirac) let map_indices_contraction f c = { coeff = c.coeff; dirac = List.map (map_term f (map_indices_dirac f)) c.dirac; - vector = List.map (map_term f (A.map_indices_vector f)) c.vector } + vector = List.map (map_term f (A.map_indices_vector f)) c.vector; + scalar = c.scalar; + inverse = c.inverse } type t = contraction list let fermion_lines contractions = let pairs = List.map fermion_lines_of_contraction contractions in match ThoList.uniq (List.sort compare pairs) with | [] -> invalid_arg "UFO_Lorentz.fermion_lines: impossible" | [pairs] -> pairs | _ -> invalid_arg "UFO_Lorentz.fermion_lines: ambiguous" let map_indices f contractions = List.map (map_indices_contraction f) contractions let map_fermion_lines f pairs = List.map (fun (i, j) -> (f i, f j)) pairs let dirac_of_atom = function | A.Identity (_, _) -> [] | A.C (_, _) -> [C] | A.Gamma5 (_, _) -> [Gamma5] | A.ProjP (_, _) -> [ProjP] | A.ProjM (_, _) -> [ProjM] | A.Gamma (mu, _, _) -> [Gamma mu] | A.Sigma (mu, nu, _, _) -> [Sigma (mu, nu)] let dirac_indices = function | A.Identity (i, j) | A.C (i, j) | A.Gamma5 (i, j) | A.ProjP (i, j) | A.ProjM (i, j) | A.Gamma (_, i, j) | A.Sigma (_, _, i, j) -> (i, j) let rec scan_for_dirac_string stack = function | [] -> (* We're done with this pass. There must be no leftover atoms on the [stack] of spinor atoms, but we'll check this in the calling function. *) (None, List.rev stack) | atom :: atoms -> let i, j = dirac_indices atom in if i > 0 then if j > 0 then (* That's an atomic Dirac string. Collect all atoms for further processing. *) (Some { bra = i; ket = j; gammas = dirac_of_atom atom}, List.rev_append stack atoms) else (* That's the start of a new Dirac string. Search for the remaining elements, not forgetting matrices that we might pushed on the [stack] earlier. *) collect_dirac_string i j (dirac_of_atom atom) [] (List.rev_append stack atoms) else (* The interior of a Dirac string. Push it on the stack until we find the start. *) scan_for_dirac_string (atom :: stack) atoms (* Complete the string starting with [i] and the current summation index [j]. *) and collect_dirac_string i j rev_ds stack = function | [] -> (* We have consumed all atoms without finding the end of the string. *) invalid_arg "collect_dirac_string: open string" | atom :: atoms -> let i', j' = dirac_indices atom in if i' = j then if j' > 0 then (* Found the conclusion. Collect all atoms on the [stack] for further processing. *) (Some { bra = i; ket = j'; gammas = List.rev_append rev_ds (dirac_of_atom atom)}, List.rev_append stack atoms) else (* Found the continuation. Pop the stack of open indices, since we're looking for a new one. *) collect_dirac_string i j' (dirac_of_atom atom @ rev_ds) [] (List.rev_append stack atoms) else (* Either the start of another Dirac string or a non-matching continuation. Push it on the stack until we're done with the current one. *) collect_dirac_string i j rev_ds (atom :: stack) atoms let dirac_string_of_dirac_atoms atoms = scan_for_dirac_string [] atoms let rec dirac_strings_of_dirac_atoms' rev_ds atoms = match dirac_string_of_dirac_atoms atoms with | (None, []) -> List.rev rev_ds | (None, _) -> invalid_arg "dirac_string_of_dirac_atoms: leftover atoms" | (Some ds, atoms) -> dirac_strings_of_dirac_atoms' (ds :: rev_ds) atoms let dirac_strings_of_dirac_atoms atoms = dirac_strings_of_dirac_atoms' [] atoms let indices_of_vector = function | A.Epsilon (mu1, mu2, mu3, mu4) -> [mu1; mu2; mu3; mu4] | A.Metric (mu1, mu2) -> [mu1; mu2] | A.P (mu, n) -> if n > 0 then [mu] else invalid_arg "indices_of_vector: invalid momentum" let classify_vector atom = { indices = indices_of_vector atom; atom } let indices_of_dirac = function - | Gamma5 | ProjM | ProjP | C -> [] + | Gamma5 | ProjM | ProjP | C | Minus -> [] | Gamma (mu) -> [mu] | Sigma (mu, nu) -> [mu; nu] let indices_of_dirac_string ds = ThoList.flatmap indices_of_dirac ds.gammas let classify_dirac atom = { indices = indices_of_dirac_string atom; atom } let contraction_of_lorentz_atoms (atoms, coeff) = - let dirac_atoms, vector_atoms = split_atoms atoms in + let dirac_atoms, vector_atoms, scalar, inverse = split_atoms atoms in let dirac = List.map classify_dirac (dirac_strings_of_dirac_atoms dirac_atoms) and vector = List.map classify_vector vector_atoms in - { coeff; dirac; vector } + { coeff; dirac; vector; scalar; inverse } type redundancy = | Trace of int | Replace of int * int let rec redundant_metric' rev_atoms = function | [] -> (None, List.rev rev_atoms) | { atom = A.Metric (mu, nu) } as atom :: atoms -> if mu < 1 then if nu = mu then (Some (Trace mu), List.rev_append rev_atoms atoms) else (Some (Replace (mu, nu)), List.rev_append rev_atoms atoms) else if nu < 0 then (Some (Replace (nu, mu)), List.rev_append rev_atoms atoms) else redundant_metric' (atom :: rev_atoms) atoms | { atom = (A.Epsilon (_, _, _, _ ) | A.P (_, _) ) } as atom :: atoms -> redundant_metric' (atom :: rev_atoms) atoms let redundant_metric atoms = redundant_metric' [] atoms (* Substitude any occurance of the index [mu] by the index [nu]: *) let substitute_index_vector1 mu nu = function | A.Epsilon (mu1, mu2, mu3, mu4) as eps -> if mu = mu1 then A.Epsilon (nu, mu2, mu3, mu4) else if mu = mu2 then A.Epsilon (mu1, nu, mu3, mu4) else if mu = mu3 then A.Epsilon (mu1, mu2, nu, mu4) else if mu = mu4 then A.Epsilon (mu1, mu2, mu3, nu) else eps | A.Metric (mu1, mu2) as g -> if mu = mu1 then A.Metric (nu, mu2) else if mu = mu2 then A.Metric (mu1, nu) else g | A.P (mu1, n) as p -> if mu = mu1 then A.P (nu, n) else p let remove a alist = List.filter ((<>) a) alist let substitute_index1 mu nu mu1 = if mu = mu1 then nu else mu1 let substitute_index mu nu indices = List.map (substitute_index1 mu nu) indices (* This assumes that [mu] is a summation index and [nu] is a polarization index. *) let substitute_index_vector mu nu vectors = List.map (fun v -> { indices = substitute_index mu nu v.indices; atom = substitute_index_vector1 mu nu v.atom }) vectors (* Substitude any occurance of the index [mu] by the index [nu]: *) let substitute_index_dirac1 mu nu = function - | (Gamma5 | ProjM | ProjP | C) as g -> g + | (Gamma5 | ProjM | ProjP | C | Minus) as g -> g | Gamma (mu1) as g -> if mu = mu1 then Gamma (nu) else g | Sigma (mu1, mu2) as g -> if mu = mu1 then Sigma (nu, mu2) else if mu = mu2 then Sigma (mu1, nu) else g (* This assumes that [mu] is a summation index and [nu] is a polarization index. *) let substitute_index_dirac mu nu dirac_strings = List.map (fun ds -> { indices = substitute_index mu nu ds.indices; atom = { ds.atom with gammas = List.map (substitute_index_dirac1 mu nu) ds.atom.gammas } } ) dirac_strings let trace_metric = QC.make (Q.make 4 1) Q.null (* FIXME: can this be made typesafe by mapping to a type that \emph{only} contains [P] and [Epsilon]? *) let rec compress_metrics c = match redundant_metric c.vector with | None, _ -> c | Some (Trace mu), vector' -> compress_metrics { coeff = QC.mul trace_metric c.coeff; dirac = c.dirac; - vector = vector' } + vector = vector'; + scalar = c.scalar; + inverse = c.inverse } | Some (Replace (mu, nu)), vector' -> compress_metrics { coeff = c.coeff; dirac = substitute_index_dirac mu nu c.dirac; - vector = substitute_index_vector mu nu vector' } + vector = substitute_index_vector mu nu vector'; + scalar = c.scalar; + inverse = c.inverse } let dummy = [] let parse1 spins atom = compress_metrics (contraction_of_lorentz_atoms atom) let parse spins l = List.map (parse1 spins) l let i2s = UFOx.Index.to_string let vector_to_string = function | A.Epsilon (mu, nu, ka, la) -> Printf.sprintf "Epsilon(%s,%s,%s,%s)" (i2s mu) (i2s nu) (i2s ka) (i2s la) | A.Metric (mu, nu) -> Printf.sprintf "Metric(%s,%s)" (i2s mu) (i2s nu) | A.P (mu, n) -> Printf.sprintf "P(%s,%d)" (i2s mu) n let dirac_to_string = function | Gamma5 -> "g5" | ProjM -> "(1-g5)/2" | ProjP -> "(1+g5)/2" | Gamma (mu) -> Printf.sprintf "g(%s)" (i2s mu) | Sigma (mu, nu) -> Printf.sprintf "s(%s,%s)" (i2s mu) (i2s nu) | C -> "C" + | Minus -> "-1" let dirac_string_to_string ds = match ds.gammas with - | [] -> Printf.sprintf "<%d|%d>" ds.bra ds.ket + | [] -> Printf.sprintf "<%s|%s>" (i2s ds.bra) (i2s ds.ket) | gammas -> Printf.sprintf - "<%d|%s|%d>" - ds.bra (String.concat "*" (List.map dirac_to_string gammas)) ds.ket + "<%s|%s|%s>" + (i2s ds.bra) + (String.concat "*" (List.map dirac_to_string gammas)) + (i2s ds.ket) + +let scalar_to_string = function + | A.Mass _ -> "m" + | A.Width _ -> "w" let contraction_to_string c = - QC.to_string c.coeff ^ " * " ^ - String.concat - " * " (List.map (fun ds -> dirac_string_to_string ds.atom) c.dirac) ^ - " * " ^ - String.concat - " * " (List.map (fun v -> vector_to_string v.atom) c.vector) + String.concat + " * " + (List.concat + [if QC.is_unit c.coeff then + [] + else + [QC.to_string c.coeff]; + List.map (fun ds -> dirac_string_to_string ds.atom) c.dirac; + List.map (fun v -> vector_to_string v.atom) c.vector; + List.map scalar_to_string c.scalar]) ^ + (match c.inverse with + | [] -> "" + | inverse -> + " / (" ^ String.concat "*" (List.map scalar_to_string inverse) ^ ")") let fermion_lines_to_string fermion_lines = ThoList.to_string - (fun (bra, ket) -> Printf.sprintf "%d->%d" bra ket) + (fun (bra, ket) -> Printf.sprintf "%s->%s" (i2s bra) (i2s ket)) fermion_lines let to_string contractions = String.concat " + " (List.map contraction_to_string contractions) Index: trunk/omega/src/UFOx.mli =================================================================== --- trunk/omega/src/UFOx.mli (revision 8359) +++ trunk/omega/src/UFOx.mli (revision 8360) @@ -1,191 +1,220 @@ (* vertex.mli -- Copyright (C) 1999-2019 by Wolfgang Kilian Thorsten Ohl Juergen Reuter with contributions from Christian Speckner WHIZARD is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2, or (at your option) any later version. WHIZARD is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the 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 Expr : sig type t val of_string : string -> t val of_strings : string list -> t val substitute : string -> t -> t -> t val rename : (string * string) list -> t -> t val half : string -> t val variables : t -> Sets.String_Caseless.t val functions : t -> Sets.String_Caseless.t end module type Index = sig (* \begin{dubious} UFO represents rank-2 indices $(i,j)$ as $1000\cdot j + i$. This should be replaced by a proper union type eventually. Unfortunately, this requires many changes in the [Atom]s in [UFOx]. Therefore, we try a quick'n'dirty proof of principle first. \end{dubious} *) + type t = int + + val position : t -> int + val factor : t -> int + val unpack : t -> int * int + val pack : int -> int -> t + val map_position : (int -> int) -> t -> t + val to_string : t -> string + val list_to_string : t list -> string - val position : int -> int - val factor : int -> int - val unpack : int -> int * int - val pack : int -> int -> int - val map_position : (int -> int) -> int -> int - val to_string : int -> string - val list_to_string : int list -> string (* Indices are represented by a pair [int * 'r], where ['r] denotes the representation the index belongs to. *) (* [free indices] returns all free indices in the list [indices], i.\,e.~all positive indices. *) - val free : (int * 'r) list -> (int * 'r) list + val free : (t * 'r) list -> (t * 'r) list (* [summation indices] returns all summation indices in the list [indices], i.\,e.~all negative indices. *) - val summation : (int * 'r) list -> (int * 'r) list + val summation : (t * 'r) list -> (t * 'r) list + + val classes_to_string : ('r -> string) -> (t * 'r) list -> string - val classes_to_string : ('r -> string) -> (int * 'r) list -> string + (* Generate summation indices, starting from~$-1001$. + TODO: check that there are no clashes with explicitely + named indices. *) + val fresh_summation : unit -> t + val named_summation : string -> unit -> t end module Index : Index module type Tensor = sig type atom (* A tensor is linear combination of products of [atom]s with rational coefficients. *) type t = (atom list * Algebra.QC.t) list (* We might need to replace atoms if the syntax is not context free. *) val map_atoms : (atom -> atom) -> t -> t - (* We need to rename indices to implement permutations. *) + (* We need to rename indices to implement permutations \ldots *) val map_indices : (int -> int) -> t -> t + (* \ldots{} but in order to to clean up inconsistencies + in the syntax of \texttt{lorentz.py} and + \texttt{propagators.py} we also need to rename indices + without touching the second argument of \texttt{P}, the + argument of \texttt{Mass} etc. *) + val rename_indices : (int -> int) -> t -> t + + (* We need scale coefficients. *) + val map_coef : (Algebra.QC.t -> Algebra.QC.t) -> t -> t + (* Parsing and unparsing. Lists of [string]s are interpreted as sums. *) val of_expr : UFOx_syntax.expr -> t val of_string : string -> t val of_strings : string list -> t val to_string : t -> string (* The supported representations. *) type r val classify_indices : t -> (int * r) list val rep_to_string : r -> string val rep_to_string_whizard : r -> string val rep_of_int : bool -> int -> r val rep_conjugate : r -> r val rep_trivial : r -> bool (* There is not a 1-to-1 mapping between the representations in the model files and the representations used by O'Mega, e.\,g.~in [Coupling.lorentz]. We might need to use heuristics. *) type r_omega val omega : r -> r_omega end module type Atom = sig type t val map_indices : (int -> int) -> t -> t - val of_expr : string -> UFOx_syntax.expr list -> t + val rename_indices : (int -> int) -> t -> t + val invertible : t -> bool + val invert : t -> t + val of_expr : string -> UFOx_syntax.expr list -> t list val to_string : t -> string type r val classify_indices : t list -> (int * r) list + val disambiguate_indices : t list -> t list val rep_to_string : r -> string val rep_to_string_whizard : r -> string val rep_of_int : bool -> int -> r val rep_conjugate : r -> r val rep_trivial : r -> bool type r_omega val omega : r -> r_omega end module type Lorentz_Atom = sig type dirac = private | C of int * int | Gamma of int * int * int | Gamma5 of int * int | Identity of int * int | ProjP of int * int | ProjM of int * int | Sigma of int * int * int * int type vector = (* private *) | Epsilon of int * int * int * int | Metric of int * int | P of int * int - type t = private + type scalar = (* private *) + | Mass of int + | Width of int + + type t = (* private *) | Dirac of dirac | Vector of vector + | Scalar of scalar + | Inverse of scalar val map_indices_vector : (int -> int) -> vector -> vector + val rename_indices_vector : (int -> int) -> vector -> vector end module Lorentz_Atom : Lorentz_Atom module Lorentz : Tensor with type atom = Lorentz_Atom.t and type r_omega = Coupling.lorentz module type Color_Atom = sig type t = (* private *) | Identity of int * int | Identity8 of int * int | T of int * int * int | F of int * int * int | D of int * int * int | Epsilon of int * int * int | EpsilonBar of int * int * int | T6 of int * int * int | K6 of int * int * int | K6Bar of int * int * int end module Color_Atom : Color_Atom module Color : Tensor with type atom = Color_Atom.t and type r_omega = Color.t module Value : sig type t val of_expr : Expr.t -> t val to_string : t -> string val to_coupling : (string -> 'b) -> t -> 'b Coupling.expr end module type Test = sig val example : unit -> unit val suite : OUnit.test end Index: trunk/omega/src/omega.tex =================================================================== --- trunk/omega/src/omega.tex (revision 8359) +++ trunk/omega/src/omega.tex (revision 8360) @@ -1,1191 +1,1187 @@ % omega.tex -- %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \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;} \IfFileExists{geometry.sty}% {\usepackage{geometry}% \geometry{a4paper,margin=2cm}}% {\relax} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% 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 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \newcommand{\ttfilename}[1]{\texttt{\detokenize{#1}}} \usepackage[noweb,bypages]{ocamlweb} \empaddtoTeX{\usepackage[noweb,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{\ocwindent}[1]{\noindent\ignorespaces} \renewcommand{\ocwbegincode}{\renewcommand{\ocwindent}[1]{\noindent\kern##1}} \renewcommand{\ocwendcode}{\renewcommand{\ocwindent}[1]{\noindent\ignorespaces}} \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 \ttfilename{#1.mli} unavailable!}\end{dubious}}} \newcommand{\application}[1]{% \InputIfFileExists{#1.implementation}{}% {\begin{dubious}\textit{Application \ttfilename{#1.ml} unavailable!}\end{dubious}}} \newcommand{\module}[1]{% \label{mod:#1}% \InputIfFileExists{#1.interface}{}% {\begin{dubious}\textit{Interface \ttfilename{#1.mli} unavailable!}\end{dubious}}% \InputIfFileExists{#1.implementation}{}% {\begin{dubious}\textit{Implementation \ttfilename{#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{% 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;} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \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\\ Emil-Hilb-Weg 22, 97074~W\"urzburg, Germany\\ \hfil\\ J\"urgen Reuter\thanks{\texttt{juergen.reuter@desy.de}}\\ \hfil\\ DESY Theory Group, Notkestr. 85, 22603 Hamburg, Germany\\ \hfil\\ Wolfgang Kilian${}^{c,}$\thanks{\texttt{kilian@physik.uni-siegen.de}}\\ \hfil\\ Theoretische Physik 1\\ Universit\"at Siegen\\ Walter-Flex-Str.~3, 57068 Siegen, Germany\\ \hfil\\ with contributions from Christian Speckner${}^{d,}$\thanks{\texttt{cnspeckn@googlemail.com}}\\ as well as Christian Schwinn et al.} \date{\textbf{unpublished draft, printed \timestamp}} \maketitle \begin{abstract} \ldots \end{abstract} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \newpage \begin{quote} Copyright \textcopyright~1999-2017 by \begin{itemize} \item Wolfgang~Kilian ~\texttt{} \item Thorsten~Ohl~\texttt{} \item J\"urgen~Reuter~\texttt{} \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} \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[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[Modellib_SM.QED] Quantum Electrodynamics \item[Modellib_SM.QCD] Quantum Chromodynamics (not complete yet) \item[Modellib_SM.SM] Minimal Standard Model (not complete yet) \end{modules} etc. \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 \end{modules} Other targets could 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 required for leading order physics applications are in place. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Useful} \begin{enumerate} \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 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} \item complete standard model in $R_\xi$-gauge \item groves (the simple method of cloned generations works) \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} \module{dirac} \module{vertex} \signature{target} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Conserved Quantum Numbers} \label{sec:charges} \module{charges} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Colorization} \label{sec:colorize} \module{colorize} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Processes} \label{sec:process} \module{process} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Model Files} \label{sec:model-files} \module{vertex_syntax} \section{Lexer} \lexer{vertex} \section{Parser} \parser{vertex} \module{vertex} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{UFO Models} \label{sec:ufo} -\section{Abstract Expression Syntax} \module{UFOx_syntax} \section{Expression Lexer} \lexer{UFOx} \section{Expression Parser} \parser{UFOx} -\section{Expressions} \module{UFOx} -\section{Abstract Syntax} \module{UFO_syntax} \section{Lexer} \lexer{UFO} \section{Parser} \parser{UFO} -\section{Models} \module{UFO_Lorentz} \module{UFO} \section{Targets} \module{UFO_targets} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Hardcoded Targets} \label{sec:targets} \module{format_Fortran} \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_SYM} %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_THDM} %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} %\cite{Kilian:2012pz} \bibitem{Kilian:2012pz} W.~Kilian, T.~Ohl, J.~Reuter and C.~Speckner, %``QCD in the Color-Flow Representation,'' JHEP \textbf{1210} (2012) 022 [arXiv:1206.3700 [hep-ph]]. %%CITATION = doi:10.1007/JHEP10(2012)022;%% %37 citations counted in INSPIRE as of 23 Apr 2019 \end{thebibliography} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \appendix %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Autotools} \label{sec:autotools} \module{config} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Textual Options} \label{sec:options} \module{options} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Progress Reports} \label{sec:progress} \module{progress} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{More on Filenames} \label{sec:thoFilename} \module{thoFilename} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \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{More On Strings} \label{sec:thostring} \module{thoString} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Polymorphic Maps} \label{sec:pmap} From~\cite{Ohl:LOTR}. \module{pmap} \module{partial} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \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{Power Sets} \label{sec:powSet} \module{powSet} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Combinatorics} \label{sec:combinatorics} \module{combinatorics} \module{permutation} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \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{Dependency Trees} \label{sec:tree2} \module{tree2} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \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{Partial Maps} \label{sec:partial} \module{partial} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \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 be off 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: trunk/omega/src/UFO_targets.ml =================================================================== --- trunk/omega/src/UFO_targets.ml (revision 8359) +++ trunk/omega/src/UFO_targets.ml (revision 8360) @@ -1,927 +1,1026 @@ (* UFO_targets.ml -- Copyright (C) 1999-2017 by Wolfgang Kilian Thorsten Ohl Juergen Reuter with contributions from Christian Speckner WHIZARD is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2, or (at your option) any later version. WHIZARD is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the 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 (@@) f g x = f (g x) (* \thocwmodulesection{Generating Code for UFO Lorentz Structures} *) (* O'Caml before 4.02 had a module typing bug that forces us to put this definition outside [Lorentz_Fusion]. *) module Q = Algebra.Q module QC = Algebra.QC module type T = sig + (* [lorentz formatter name spins v] writes a representation of the Lorentz structure [v] of particles with the Lorentz representations [spins] as a (Fortran) function [name] to [formatter]. *) val lorentz : Format_Fortran.formatter -> string -> Coupling.lorentz array -> UFO_Lorentz.t -> unit + val propagator : + Format_Fortran.formatter -> string -> + Coupling.lorentz * Coupling.lorentz -> + UFO_Lorentz.t -> UFO_Lorentz.t -> unit + val fuse : Algebra.QC.t -> string -> Coupling.lorentzn -> string -> string list -> string list -> Coupling.fusen -> unit val eps4_g4_g44_decl : Format_Fortran.formatter -> unit -> unit val eps4_g4_g44_init : Format_Fortran.formatter -> unit -> unit end module Fortran : T = struct open Format_Fortran let pp_divide ?(indent=0) ff () = fprintf ff "%*s! %s" indent "" (String.make (70 - indent) '-'); pp_newline ff () let conjugate = function | Coupling.Spinor -> Coupling.ConjSpinor | Coupling.ConjSpinor -> Coupling.Spinor | r -> r let spin_mnemonic = function | Coupling.Scalar -> "phi" | Coupling.Spinor -> "psi" | Coupling.ConjSpinor -> "psibar" | Coupling.Majorana -> "chi" | Coupling.Maj_Ghost -> invalid_arg "UFO_targets: Maj_Ghost" | Coupling.Vector -> "a" | Coupling.Massive_Vector -> "v" - | Coupling.Vectorspinor -> - invalid_arg "UFO_targets: Vectorspinor" + | Coupling.Vectorspinor -> "grav" (* itino *) | Coupling.Tensor_1 -> invalid_arg "UFO_targets: Tensor_1" | Coupling.Tensor_2 -> "h" | Coupling.BRS l -> invalid_arg "UFO_targets: BRS" let fortran_type = function | Coupling.Scalar -> "complex(kind=default)" | Coupling.Spinor -> "type(spinor)" | Coupling.ConjSpinor -> "type(conjspinor)" | Coupling.Majorana -> "type(bispinor)" | Coupling.Maj_Ghost -> invalid_arg "UFO_targets: Maj_Ghost" | Coupling.Vector -> "type(vector)" | Coupling.Massive_Vector -> "type(vector)" - | Coupling.Vectorspinor -> - invalid_arg "UFO_targets: Vectorspinor" + | Coupling.Vectorspinor -> "type(vectorspinor)" | Coupling.Tensor_1 -> invalid_arg "UFO_targets: Tensor_1" | Coupling.Tensor_2 -> "type(tensor)" | Coupling.BRS l -> invalid_arg "UFO_targets: BRS" (* The \texttt{omegalib} separates time from space. Maybe not a good idea after all. Mend it locally \ldots *) type wf = { pos : int; spin : Coupling.lorentz; name : string; local_array : string option; momentum : string; momentum_array : string; fortran_type : string } let wf_table spins = Array.mapi (fun i s -> let spin = if i = 0 then conjugate s else s in let pos = succ i in let i = string_of_int pos in let name = spin_mnemonic s ^ i in let local_array = begin match spin with | Coupling.Vector | Coupling.Massive_Vector -> Some (name ^ "a") | _ -> None end in { pos; spin; name; local_array; momentum = "k" ^ i; momentum_array = "p" ^ i; fortran_type = fortran_type spin } ) spins module L = UFO_Lorentz (* Format rational ([Q.t]) and complex rational ([QC.t]) numbers as fortran values. *) let format_rational q = if Q.is_integer q then string_of_int (Q.to_integer q) else let n, d = Q.to_ratio q in Printf.sprintf "%d.0_default/%d" n d let format_complex_rational cq = let real = QC.real cq and imag = QC.imag cq in if Q.is_null imag then begin if Q.is_negative real then "(" ^ format_rational real ^ ")" else format_rational real end else if Q.is_integer real && Q.is_integer imag then Printf.sprintf "(%d,%d)" (Q.to_integer real) (Q.to_integer imag) else Printf.sprintf "cmplx(%s,%s,kind=default)" (format_rational real) (format_rational imag) (* Optimize the representation if used as a prefactor of a summand in a sum. *) let format_rational_factor q = if Q.is_unit q then "+" else if Q.is_unit (Q.neg q) then "-" else if Q.is_negative q then "-" ^ format_rational (Q.neg q) ^ "*" else "+" ^ format_rational q ^ "*" let format_complex_rational_factor cq = let real = QC.real cq and imag = QC.imag cq in if Q.is_null imag then begin if Q.is_unit real then "+" else if Q.is_unit (Q.neg real) then "-" else if Q.is_negative real then "-" ^ format_rational (Q.neg real) ^ "*" else "+" ^ format_rational real ^ "*" end else if Q.is_integer real && Q.is_integer imag then Printf.sprintf "+(%d,%d)*" (Q.to_integer real) (Q.to_integer imag) else Printf.sprintf "+cmplx(%s,%s,kind=default)*" (format_rational real) (format_rational imag) (* Append a formatted list of indices to [name]. *) let append_indices name = function | [] -> name | indices -> name ^ "(" ^ String.concat "," (List.map string_of_int indices) ^ ")" (* Dirac string variables and their names. *) type dsv = | Ket of int | Bra of int | Braket of int let dsv_name = function | Ket n -> Printf.sprintf "ket%02d" n | Bra n -> Printf.sprintf "bra%02d" n | Braket n -> Printf.sprintf "bkt%02d" n let dirac_dimension dsv indices = let tail ilist = String.concat "," (List.map (fun _ -> "0:3") ilist) ^ ")" in match dsv, indices with | Braket _, [] -> "" | (Ket _ | Bra _), [] -> ", dimension(1:4)" | Braket _, indices -> ", dimension(" ^ tail indices | (Ket _ | Bra _), indices -> ", dimension(1:4," ^ tail indices (* Write Fortran code to [decl] and [eval]: apply the Dirac matrix [gamma] with complex rational entries to the spinor [ket] from the left. [ket] must be the name of a scalar variable and cannot be an array element. The result is stored in [dsv_name (Ket n)] which can have additional [indices]. Return [Ket n] for further processing. *) let dirac_ket_to_fortran_decl ff n indices = let printf fmt = fprintf ff fmt and nl = pp_newline ff in let dsv = Ket n in printf " @[<2>complex(kind=default)%s ::@ %s@]" (dirac_dimension dsv indices) (dsv_name dsv); nl () let dirac_ket_to_fortran_eval ff n indices gamma ket = let printf fmt = fprintf ff fmt and nl = pp_newline ff in let dsv = Ket n in for i = 0 to 3 do let name = append_indices (dsv_name dsv) (succ i :: indices) in printf " @[<%d>%s = 0" (String.length name + 5) name; for j = 0 to 3 do if gamma.(i).(j) <> QC.null then printf "@,%s%s%%a(%d)" (format_complex_rational_factor gamma.(i).(j)) ket.name (succ j) done; printf "@]"; nl () done; dsv (* The same as [dirac_bra_to_fortran], but apply the Dirac matrix [gamma] to [bra] from the right and return [Bra n]. *) let dirac_bra_to_fortran_decl ff n indices = let printf fmt = fprintf ff fmt and nl = pp_newline ff in let dsv = Bra n in printf " @[<2>complex(kind=default)%s ::@ %s@]" (dirac_dimension dsv indices) (dsv_name dsv); nl () let dirac_bra_to_fortran_eval ff n indices bra gamma = let printf fmt = fprintf ff fmt and nl = pp_newline ff in let dsv = Bra n in for j = 0 to 3 do let name = append_indices (dsv_name dsv) (succ j :: indices) in printf " @[<%d>%s = 0" (String.length name + 5) name; for i = 0 to 3 do if gamma.(i).(j) <> QC.null then printf "@,%s%s%%a(%d)" (format_complex_rational_factor gamma.(i).(j)) bra.name (succ i) done; printf "@]"; nl () done; dsv (* More of the same, but evaluating a spinor sandwich and returning [Braket n]. *) let dirac_braket_to_fortran_decl ff n indices = let printf fmt = fprintf ff fmt and nl = pp_newline ff in let dsv = Braket n in printf " @[<2>complex(kind=default)%s ::@ %s@]" (dirac_dimension dsv indices) (dsv_name dsv); nl () let dirac_braket_to_fortran_eval ff n indices bra gamma ket = let printf fmt = fprintf ff fmt and nl = pp_newline ff in let dsv = Braket n in let name = append_indices (dsv_name dsv) indices in printf " @[<%d>%s = 0" (String.length name + 5) name; for i = 0 to 3 do for j = 0 to 3 do if gamma.(i).(j) <> QC.null then printf "@,%s%s%%a(%d)*%s%%a(%d)" (format_complex_rational_factor gamma.(i).(j)) bra.name (succ i) ket.name (succ j) done done; printf "@]"; nl (); dsv (* Choose among the previous functions according to the position of [bra] and [ket] among the wavefunctions. If any is in the first position evaluate the spinor expression with the corresponding spinor removed, otherwise evaluate the spinir sandwich. *) let dirac_bra_or_ket_to_fortran_decl ff n indices bra ket = if bra = 1 then dirac_ket_to_fortran_decl ff n indices else if ket = 1 then dirac_bra_to_fortran_decl ff n indices else dirac_braket_to_fortran_decl ff n indices let dirac_bra_or_ket_to_fortran_eval ff n indices wfs bra gamma ket = if bra = 1 then dirac_ket_to_fortran_eval ff n indices gamma wfs.(pred ket) else if ket = 1 then dirac_bra_to_fortran_eval ff n indices wfs.(pred bra) gamma else dirac_braket_to_fortran_eval ff n indices wfs.(pred bra) gamma wfs.(pred ket) (* UFO summation indices are negative integers. Derive a valid Fortran variable name. *) let prefix_summation = "mu" let prefix_polarization = "nu" let index_spinor = "alpha" let index_tensor = "nu" let index_variable mu = if mu < 0 then Printf.sprintf "%s%d" prefix_summation (- mu) else if mu == 0 then prefix_polarization else Printf.sprintf "%s%d" prefix_polarization mu let format_indices indices = String.concat "," (List.map index_variable indices) module IntPM = Partial.Make (struct type t = int let compare = compare end) type tensor = | DS of dsv | V of string | T of UFOx.Lorentz_Atom.vector + | S of UFOx.Lorentz_Atom.scalar + | Inv of UFOx.Lorentz_Atom.scalar (* Write the [i]th Dirac string [ds] as Fortran code to [eval], including a shorthand representation as a comment. Return [ds] with [ds.L.atom] replaced by the dirac string variable, i,\,e.~[DS dsv] annotated with the internal and external indices. In addition write the declaration to [decl]. *) let dirac_string_to_fortran ~decl ~eval i wfs ds = let printf fmt = fprintf eval fmt and nl = pp_newline eval in let bra = ds.L.atom.L.bra and ket = ds.L.atom.L.ket in pp_divide ~indent:4 eval (); + let atom = + match wfs.(pred bra).spin with + | Coupling.Majorana | Coupling.Vectorspinor -> + if bra = 1 then + ds.L.atom + else if ket = 1 then + L.transpose ds.L.atom + else + L.majorana ds.L.atom + | _ -> ds.L.atom in + printf " ! %s" (L.dirac_string_to_string atom); nl (); begin match ds.L.indices with | [] -> - printf " ! %s" (L.dirac_string_to_string ds.L.atom); nl (); - let gamma = L.dirac_string_to_matrix (fun _ -> 0) ds.L.atom in + let gamma = L.dirac_string_to_matrix (fun _ -> 0) atom in dirac_bra_or_ket_to_fortran_decl decl i [] bra ket; let dsv = dirac_bra_or_ket_to_fortran_eval eval i [] wfs bra gamma ket in L.map_atom (fun _ -> DS dsv) ds | indices -> - printf - " ! %s" - (L.dirac_string_to_string ds.L.atom); nl (); dirac_bra_or_ket_to_fortran_decl decl i indices bra ket; let combinations = Product.power (List.length indices) [0; 1; 2; 3] in let dsv = List.map (fun combination -> let substitution = IntPM.of_lists indices combination in let substitute = IntPM.apply substitution in let indices = List.map substitute indices in - let gamma = - L.dirac_string_to_matrix substitute ds.L.atom in + let gamma = L.dirac_string_to_matrix substitute atom in dirac_bra_or_ket_to_fortran_eval eval i indices wfs bra gamma ket) combinations in begin match ThoList.uniq (List.sort compare dsv) with | [dsv] -> L.map_atom (fun _ -> DS dsv) ds | _ -> failwith "dirac_string_to_fortran: impossible" end end (* Write the Dirac strings in the list [ds_list] as Fortran code to [eval], including shorthand representations as comments. Return the list of variables and corresponding indices to be contracted. *) let dirac_strings_to_fortran ~decl ~eval wfs last ds_list = List.fold_left (fun (i, acc) ds -> let i = succ i in (i, dirac_string_to_fortran ~decl ~eval i wfs ds :: acc)) (last, []) ds_list (* Perform a nested sum of terms, as printed by [print_term] (which takes the number of spaces to indent as only argument) of the cartesian product of [indices] running from 0 to 3. *) let nested_sums ~decl ~eval initial_indent indices print_term = let rec nested_sums' indent = function | [] -> print_term indent | index :: indices -> let var = index_variable index in fprintf eval "%*s@[<2>do %s = 0, 3@]" indent "" var; pp_newline eval (); nested_sums' (indent + 2) indices; pp_newline eval (); fprintf eval "%*s@[<2>end do@]" indent "" in nested_sums' (initial_indent + 2) indices (* Polarization indices also need to be summed over, but they appear only once. *) let indices_of_contractions contractions = let index_pairs, polarizations = L.classify_indices (ThoList.flatmap (fun ds -> ds.L.indices) contractions) in try ThoList.pairs index_pairs @ ThoList.uniq (List.sort compare polarizations) with | Invalid_argument s -> invalid_arg ("indices_of_contractions: " ^ ThoList.to_string string_of_int index_pairs) (*i Printf.eprintf "indices_of_contractions: %s / %s\n" (ThoList.to_string string_of_int index_pairs) (ThoList.to_string string_of_int polarizations); i*) let format_dsv dsv indices = match dsv, indices with | Braket _, [] -> dsv_name dsv | Braket _, ilist -> Printf.sprintf "%s(%s)" (dsv_name dsv) (format_indices indices) | (Bra _ | Ket _), [] -> Printf.sprintf "%s(%s)" (dsv_name dsv) index_spinor | (Bra _ | Ket _), ilist -> Printf.sprintf "%s(%s,%s)" (dsv_name dsv) index_spinor (format_indices indices) let format_tensor t = let indices = t.L.indices in match t.L.atom with | DS dsv -> format_dsv dsv indices | V vector -> Printf.sprintf "%s(%s)" vector (format_indices indices) | T UFOx.Lorentz_Atom.P (mu, n) -> Printf.sprintf "p%d(%s)" n (index_variable mu) | T UFOx.Lorentz_Atom.Epsilon (mu1, mu2, mu3, mu4) -> Printf.sprintf "eps4_(%s)" (format_indices [mu1; mu2; mu3; mu4]) | T UFOx.Lorentz_Atom.Metric (mu1, mu2) -> if mu1 > 0 && mu2 > 0 then Printf.sprintf "g44_(%s)" (format_indices [mu1; mu2]) else failwith "format_tensor: compress_metrics has failed!" + | S (UFOx.Lorentz_Atom.Mass _) -> "m" + | S (UFOx.Lorentz_Atom.Width _) -> "w" + | Inv (UFOx.Lorentz_Atom.Mass _) -> "1/m" + | Inv (UFOx.Lorentz_Atom.Width _) -> "1/w" let rec multiply_tensors ~decl ~eval = function | [] -> fprintf eval "1"; | [t] -> fprintf eval "%s" (format_tensor t) | t :: tensors -> fprintf eval "%s@,*" (format_tensor t); multiply_tensors ~decl ~eval tensors let contract_indices ~decl ~eval indent wf_indices wfs (fusion, contractees) = let printf fmt = fprintf eval fmt and nl = pp_newline eval in let sum_var = begin match wf_indices with | [] -> wfs.(0).name | ilist -> let indices = String.concat "," ilist in begin match wfs.(0).local_array with | None -> let component = begin match wfs.(0).spin with | Coupling.Spinor | Coupling.ConjSpinor | Coupling.Majorana -> "a" | Coupling.Tensor_2 -> "t" | Coupling.Vector | Coupling.Massive_Vector -> failwith "contract_indices: expected local_array for vectors" | _ -> failwith "contract_indices: unexpected spin" end in Printf.sprintf "%s%%%s(%s)" wfs.(0).name component indices | Some a -> Printf.sprintf "%s(%s)" a indices end end in let indices = List.filter (fun i -> UFOx.Index.position i <> 1) (indices_of_contractions contractees) in nested_sums ~decl ~eval indent indices (fun indent -> printf "%*s@[<2>%s = %s" indent "" sum_var sum_var; printf "@,%s" (format_complex_rational_factor fusion.L.coeff); List.iter (fun i -> printf "@,g4_(%s)*" (index_variable i)) indices; printf "@,("; multiply_tensors ~decl ~eval contractees; printf ")@]"); printf "@]"; nl () let external_wf_loop ~decl ~eval ~indent wfs (fusion, _ as contractees) = pp_divide ~indent eval (); fprintf eval "%*s! %s\n" indent "" (L.to_string [fusion]); pp_divide ~indent eval (); match wfs.(0).spin with | Coupling.Scalar -> contract_indices ~decl ~eval 2 [] wfs contractees | Coupling.Spinor | Coupling.ConjSpinor | Coupling.Majorana -> let idx = index_spinor in fprintf eval "%*s@[<2>do %s = 1, 4@]" indent "" idx; pp_newline eval (); contract_indices ~decl ~eval 4 [idx] wfs contractees; fprintf eval "%*send do@]" indent ""; pp_newline eval () - | Coupling.Vector -> + | Coupling.Vector | Coupling.Massive_Vector -> let idx = index_variable 1 in fprintf eval "%*s@[<2>do %s = 0, 3@]" indent "" idx; pp_newline eval (); contract_indices ~decl ~eval 4 [idx] wfs contractees; fprintf eval "%*send do@]" indent ""; pp_newline eval () | Coupling.Tensor_2 -> let idx1 = index_variable (UFOx.Index.pack 1 1) and idx2 = index_variable (UFOx.Index.pack 1 2) in fprintf eval "%*s@[<2>do %s = 0, 3@]" indent "" idx1; pp_newline eval (); fprintf eval "%*s@[<2>do %s = 0, 3@]" (indent + 2) "" idx2; pp_newline eval (); contract_indices ~decl ~eval 6 [idx1; idx2] wfs contractees; fprintf eval "%*send do@]" (indent + 2) ""; pp_newline eval (); fprintf eval "%*send do@]" indent ""; pp_newline eval () - | _ -> failwith "external_wf_loop: incomplete" + | Coupling.Vectorspinor -> + failwith "external_wf_loop: Vectorspinor not supported yet!" + | Coupling.Maj_Ghost -> + failwith "external_wf_loop: unexpected Maj_Ghost" + | Coupling.Tensor_1 -> + failwith "external_wf_loop: unexpected Tensor_1" + | Coupling.BRS _ -> + failwith "external_wf_loop: unexpected BRS" let local_vector_copies ~decl ~eval wfs = begin match wfs.(0).local_array with | None -> () | Some a -> fprintf decl " @[<2>complex(kind=default),@ dimension(0:3) ::@ %s@]" a; pp_newline decl () end; let n = Array.length wfs in for i = 1 to n - 1 do match wfs.(i).local_array with | None -> () | Some a -> fprintf decl " @[<2>complex(kind=default),@ dimension(0:3) ::@ %s@]" a; pp_newline decl (); fprintf eval " @[<2>%s(0) = %s%%t@]" a wfs.(i).name; pp_newline eval (); fprintf eval " @[<2>%s(1:3) = %s%%x@]" a wfs.(i).name; pp_newline eval () done let return_vector ff wfs = let printf fmt = fprintf ff fmt and nl = pp_newline ff in match wfs.(0).local_array with | None -> () | Some a -> pp_divide ~indent:4 ff (); printf " @[<2>%s%%t = %s(0)@]" wfs.(0).name a; nl (); printf " @[<2>%s%%x = %s(1:3)@]" wfs.(0).name a; nl () - let multiply_coupling_and_scalars ff g wfs = + let multiply_coupling_and_scalars ff g_opt wfs = let printf fmt = fprintf ff fmt and nl = pp_newline ff in pp_divide ~indent:4 ff (); - printf " @[<2>%s = %s*%s" wfs.(0).name g wfs.(0).name; + let g = + match g_opt with + | None -> "" + | Some g -> g ^ "*" in + let wfs0name = + match wfs.(0).local_array with + | None -> wfs.(0).name + | Some a -> a in + printf " @[<2>%s = %s%s" wfs0name g wfs0name; for i = 1 to Array.length wfs - 1 do match wfs.(i).spin with | Coupling.Scalar -> printf "@,*%s" wfs.(i).name | _ -> () done; printf "@]"; nl () let local_momentum_copies ~decl ~eval wfs = let n = Array.length wfs in fprintf decl " @[<2>real(kind=default),@ dimension(0:3) ::@ %s" wfs.(0).momentum_array; for i = 1 to n - 1 do fprintf decl ",@ %s" wfs.(i).momentum_array; fprintf eval " @[<2>%s(0) = %s%%t@]" wfs.(i).momentum_array wfs.(i).momentum; pp_newline eval (); fprintf eval " @[<2>%s(1:3) = %s%%x@]" wfs.(i).momentum_array wfs.(i).momentum; pp_newline eval () done; fprintf eval " @[<2>%s =" wfs.(0).momentum_array; for i = 1 to n - 1 do fprintf eval "@ - %s" wfs.(i).momentum_array done; fprintf decl "@]"; pp_newline decl (); fprintf eval "@]"; pp_newline eval () let contractees_of_fusion ~decl ~eval wfs (max_dsv, indices_seen, contractees) fusion = let max_dsv', dirac_strings = dirac_strings_to_fortran ~decl ~eval wfs max_dsv fusion.L.dirac and vectors = List.fold_left (fun acc wf -> match wf.spin, wf.local_array with | Coupling.Tensor_2, None -> { L.atom = V (Printf.sprintf "%s%d%%t" (spin_mnemonic wf.spin) wf.pos); L.indices = [UFOx.Index.pack wf.pos 1; UFOx.Index.pack wf.pos 2] } :: acc | _, None -> acc | _, Some a -> { L.atom = V a; L.indices = [wf.pos] } :: acc) [] (List.tl (Array.to_list wfs)) and tensors = - List.map (L.map_atom (fun t -> T t)) fusion.L.vector in - let contractees' = dirac_strings @ vectors @ tensors in + List.map (L.map_atom (fun t -> T t)) fusion.L.vector + and scalars = + List.map (fun t -> { L.atom = S t; L.indices = [] }) fusion.L.scalar + and inverses = + List.map (fun t -> { L.atom = Inv t; L.indices = [] }) fusion.L.inverse in + let contractees' = dirac_strings @ vectors @ tensors @ scalars @ inverses in let indices_seen' = Sets.Int.of_list (indices_of_contractions contractees') in (max_dsv', Sets.Int.union indices_seen indices_seen', (fusion, contractees') :: contractees) - let fusions_to_fortran ~decl ~eval wfs fusions = + let local_name wf = + match wf.local_array with + | Some a -> a + | None -> + match wf.spin with + | Coupling.Spinor | Coupling.ConjSpinor | Coupling.Majorana -> + wf.name ^ "%a" + | Coupling.Scalar -> wf.name + | Coupling.Tensor_2 -> wf.name ^ "%t" + | Coupling.Vector | Coupling.Massive_Vector -> + failwith "UFO_targets.Fortran.local_name: unexpected spin 1" + | _ -> + failwith "UFO_targets.Fortran.local_name: unhandled spin" + + let pseudo_wfs_for_denominator = + Array.init + 2 + (fun i -> + let ii = string_of_int i in + { pos = i; + spin = Coupling.Scalar; + name = "den"; + local_array = None; + momentum = "k" ^ ii; + momentum_array = "p" ^ ii; + fortran_type = fortran_type Coupling.Scalar }) + + let fusions_to_fortran ~decl ~eval wfs ?(denominator=[]) ?coupling fusions = local_vector_copies ~decl ~eval wfs; local_momentum_copies ~decl ~eval wfs; - let _, indices_used, contractions = + let max_dsv, indices_used, contractions = List.fold_left (contractees_of_fusion ~decl ~eval wfs) (0, Sets.Int.empty, []) fusions in + let _, indices_used, denominator_contractions = + List.fold_left + (contractees_of_fusion ~decl ~eval pseudo_wfs_for_denominator) + (max_dsv, indices_used, []) + denominator in Sets.Int.iter (fun index -> fprintf decl " @[<2>integer ::@ %s@]" (index_variable index); pp_newline decl ()) indices_used; begin match wfs.(0).spin with | Coupling.Spinor | Coupling.ConjSpinor | Coupling.Majorana -> fprintf decl " @[<2>integer ::@ %s@]" index_spinor; pp_newline decl () | _ -> () end; pp_divide ~indent:4 eval (); - begin match wfs.(0).local_array with - | Some a -> fprintf eval " %s = 0" a - | None -> - match wfs.(0).spin with - | Coupling.Spinor | Coupling.ConjSpinor | Coupling.Majorana -> - fprintf eval " %s%%a = 0" wfs.(0).name - | Coupling.Scalar -> fprintf eval " %s = 0" wfs.(0).name - | Coupling.Tensor_2 -> - fprintf eval " %s%%t = 0" wfs.(0).name - | Coupling.Vector | Coupling.Massive_Vector -> - failwith "UFO_targets.Fortran.fusions_to_fortran: unexpected spin 1" - | _ -> - failwith "UFO_targets.Fortran.fusions_to_fortran: unhandled spin" - end; + let wfs0name = local_name wfs.(0) in + fprintf eval " %s = 0" wfs0name; pp_newline eval (); List.iter (external_wf_loop ~decl ~eval ~indent:4 wfs) contractions; + multiply_coupling_and_scalars eval coupling wfs; + begin match denominator_contractions with + | [] -> () + | contractions -> + fprintf decl " @[<2>complex(kind=default) :: den@]"; + pp_newline decl (); + pp_divide ~indent:4 eval (); + fprintf eval " @[<2>den = 0@]"; pp_newline eval (); + List.iter + (external_wf_loop ~decl ~eval ~indent:4 pseudo_wfs_for_denominator) + contractions; + pp_divide ~indent:4 eval (); + fprintf eval " @[<2>%s =@ %s / den@]" wfs0name wfs0name; + pp_newline eval () + end; return_vector eval wfs + (* TODO: eventually, we should include the momentum among the arguments only if required. But this can wait for another day. *) let lorentz ff name spins lorentz = let printf fmt = fprintf ff fmt and nl = pp_newline ff in let wfs = wf_table spins in let n = Array.length wfs in printf " @[<4>pure function %s@ (g,@ " name; for i = 1 to n - 2 do printf "%s,@ %s,@ " wfs.(i).name wfs.(i).momentum done; printf "%s,@ %s" wfs.(n - 1).name wfs.(n - 1).momentum; printf ")@ result (%s)@]" wfs.(0).name; nl (); printf " @[<2>%s ::@ %s@]" wfs.(0).fortran_type wfs.(0).name; nl(); printf " @[<2>complex(kind=default),@ intent(in) ::@ g@]"; nl(); for i = 1 to n - 1 do printf " @[<2>%s, intent(in) :: %s@]" wfs.(i).fortran_type wfs.(i).name; nl(); done; printf " @[<2>type(momentum), intent(in) ::@ %s" wfs.(1).momentum; for i = 2 to n - 1 do printf ",@ %s" wfs.(i).momentum done; printf "@]"; nl (); let width = 80 in (* get this from the default formatter instead! *) let decl_buf = Buffer.create 1024 and eval_buf = Buffer.create 1024 in let decl = formatter_of_buffer ~width decl_buf and eval = formatter_of_buffer ~width eval_buf in - fusions_to_fortran ~decl ~eval wfs lorentz; - multiply_coupling_and_scalars eval "g" wfs; + fusions_to_fortran ~decl ~eval ~coupling:"g" wfs lorentz; pp_flush decl (); pp_flush eval (); pp_divide ~indent:4 ff (); (*i printf " ! %s" (L.to_string lorentz); nl (); pp_divide ~indent:4 ff (); i*) printf "%s" (Buffer.contents decl_buf); pp_divide ~indent:4 ff (); printf "%s" (Buffer.contents eval_buf); printf " end function %s@]" name; nl (); Buffer.reset decl_buf; Buffer.reset eval_buf; () + let propagator ff name (bra_spin, ket_spin) numerator denominator = + let printf fmt = fprintf ff fmt + and nl = pp_newline ff in + let width = 80 in (* get this from the default formatter instead! *) + let wf_name = spin_mnemonic ket_spin + and wf_type = fortran_type ket_spin in + let wfs = wf_table [| ket_spin; ket_spin |] in + printf " @[<4>pure function pr_U_%s@ (k2, m, w, %s2)" name wf_name; + printf " result (%s1)@]" wf_name; nl (); + printf " %s :: %s1" wf_type wf_name; nl (); + printf " type(momentum), intent(in) :: k2"; nl (); + printf " real(kind=default), intent(in) :: m, w"; nl (); + printf " %s, intent(in) :: %s2" wf_type wf_name; nl (); + let decl_buf = Buffer.create 1024 + and eval_buf = Buffer.create 1024 in + let decl = formatter_of_buffer ~width decl_buf + and eval = formatter_of_buffer ~width eval_buf in + fusions_to_fortran ~decl ~eval wfs ~denominator numerator; + pp_flush decl (); + pp_flush eval (); + pp_divide ~indent:4 ff (); + printf "%s" (Buffer.contents decl_buf); + pp_divide ~indent:4 ff (); + printf "%s" (Buffer.contents eval_buf); + printf " end function pr_U_%s@]" name; nl (); + Buffer.reset decl_buf; + Buffer.reset eval_buf; + () + let scale_coupling c g = if c = 1 then g else if c = -1 then "-" ^ g else Printf.sprintf "%d*%s" c g let scale_coupling z g = format_complex_rational_factor z ^ g (* As a prototypical example consider the vertex \begin{equation} \bar\psi\fmslash{A}\psi = \tr\left(\psi\otimes\bar\psi\fmslash{A}\right) \end{equation} encoded as \texttt{FFV} in the SM UFO file. This example is useful, because all three fields have different type and we can use the Fortran compiler to check our implementation. In this case we need to generate the following function calls with the arguments in the following order \begin{center} \begin{tabular}{lcl} \texttt{F12}:&$\psi_1\bar\psi_2\to A$& \texttt{FFV\_p201(g,psi1,p1,psibar2,p2)} \\ \texttt{F21}:&$\bar\psi_1\psi_2\to A$& \texttt{FFV\_p201(g,psi2,p2,psibar1,p1)} \\ \texttt{F23}:&$\bar\psi_1 A_2 \to \bar\psi$& \texttt{FFV\_p012(g,psibar1,p1,A2,p2)} \\ \texttt{F32}:&$A_1\bar\psi_2 \to \bar\psi$& \texttt{FFV\_p012(g,psibar2,p2,A1,p1)} \\ \texttt{F31}:&$A_1\psi_2\to \psi$& \texttt{FFV\_p120(g,A1,p1,psi2,p2)} \\ \texttt{F13}:&$\psi_1A_2\to \psi$& \texttt{FFV\_p120(g,A2,p2,psi1,p1)} \end{tabular} \end{center} *) (* Fortunately, all Fermi signs have been taken care of by [Fusions] and we can concentrate on injecting the wave functions into the correct slots. *) (* \begin{dubious} Eventually, we should use the reverted lists everywhere to become a bit more efficient. \end{dubious} *) module P = Permutation.Default let factor_cyclic f12__n = let f12__, fn = ThoList.split_last f12__n in let cyclic = ThoList.cycle_until fn (List.sort compare f12__n) in (P.of_list (List.map pred cyclic), P.of_lists (List.tl cyclic) f12__) let fuse c v s g wfs ps fusion = let g = scale_coupling c g and cyclic, factor = factor_cyclic fusion in let perm = P.to_string cyclic in let wfs_ps = List.map2 (fun wf p -> (wf, p)) wfs ps in let args = P.list (P.inverse factor) wfs_ps in let args_string = String.concat "," (List.map (fun (wf, p) -> wf ^ "," ^ p) args) in printf "%s_p%s(%s,%s)" v perm g args_string (* \begin{dubious} The following is for reference only, to better understand what JRR was doing\ldots \end{dubious} *) (* The vertex is (suppressing the Lorentz index of~$\phi_2$) \begin{equation} \bar\psi_1 \Gamma\phi_2 \psi_3 = \Gamma_{\alpha\beta} \bar\psi_{1,\alpha} \phi_2 \psi_{3,\beta} \end{equation} *) (* This is the version implemented by [fuse] above. *) let tho_print_dirac_current f c wf1 wf2 fusion = match fusion with | [1; 3] -> printf "%s_ff(%s,%s,%s)" f c wf1 wf2 (* $\Gamma_{\alpha\beta} \bar\psi_{1,\alpha} \psi_{3,\beta}$ *) | [3; 1] -> printf "%s_ff(%s,%s,%s)" f c wf2 wf1 (* $\Gamma_{\alpha\beta} \bar\psi_{1,\alpha} \psi_{3,\beta}$ *) | [2; 3] -> printf "f_%sf(%s,%s,%s)" f c wf1 wf2 (* $\Gamma_{\alpha\beta} \phi_2 \psi_{3,\beta}$ *) | [3; 2] -> printf "f_%sf(%s,%s,%s)" f c wf2 wf1 (* $\Gamma_{\alpha\beta} \phi_2 \psi_{3,\beta}$ *) | [1; 2] -> printf "f_f%s(%s,%s,%s)" f c wf1 wf2 (* $\Gamma_{\alpha\beta} \bar\psi_{1,\alpha} \phi_2$ *) | [2; 1] -> printf "f_f%s(%s,%s,%s)" f c wf2 wf1 (* $\Gamma_{\alpha\beta} \bar\psi_{1,\alpha} \phi_2$ *) | _ -> () (* This is how JRR implemented the Dirac matrices that don't change sign under $C\Gamma^T C^{-1} = \Gamma$, i.\,e.~$\mathbf{1}$, $\gamma_5$ and~$\gamma_5\gamma_\mu$. *) (* In the case of two fermions, the second wave function [wf2] is always put into the right slot, as described in JRR's thesis. *) (* In the case of a boson and a fermion, there is no need for both ["f_%sf"] and ["f_f%s"], since the latter can be obtained by exchanging arguments. *) let jrr_print_majorana_current_S_P_A f c wf1 wf2 fusion = match fusion with | [1; 3] -> printf "%s_ff(%s,%s,%s)" f c wf1 wf2 (* $\Gamma_{\alpha\beta} \bar\psi_{1,\alpha} \psi_{3,\beta} \equiv \Gamma $ *) | [3; 1] -> printf "%s_ff(%s,%s,%s)" f c wf1 wf2 (* $\Gamma_{\alpha\beta} \psi_{3,\alpha} \bar\psi_{1,\beta} \equiv \Gamma = C\Gamma^T C^{-1} $ *) | [2; 3] -> printf "f_%sf(%s,%s,%s)" f c wf1 wf2 (* $\Gamma_{\alpha\beta} \phi_2 \psi_{3,\beta} \equiv \Gamma $ *) | [3; 2] -> printf "f_%sf(%s,%s,%s)" f c wf2 wf1 (* $\Gamma_{\alpha\beta} \phi_2 \psi_{3,\beta} \equiv \Gamma $ *) | [1; 2] -> printf "f_%sf(%s,%s,%s)" f c wf2 wf1 (* $\Gamma_{\alpha\beta} \phi_2 \bar\psi_{1,\beta} \equiv \Gamma = C\Gamma^T C^{-1} $ *) | [2; 1] -> printf "f_%sf(%s,%s,%s)" f c wf1 wf2 (* $\Gamma_{\alpha\beta} \phi_2 \bar\psi_{1,\beta} \equiv \Gamma = C\Gamma^T C^{-1} $ *) | _ -> () (* This is how JRR implemented the Dirac matrices that do change sign under $C\Gamma^T C^{-1} = - \Gamma$, i.\,e.~$\gamma_\mu$ and~$\sigma_{\mu\nu}$ (NB: the latter case never appears!). *) let jrr_print_majorana_current_V f c wf1 wf2 fusion = match fusion with | [1; 3] -> printf "%s_ff( %s,%s,%s)" f c wf1 wf2 (* $ \Gamma_{\alpha\beta} \bar\psi_{1,\alpha} \psi_{3,\beta} \equiv \Gamma $ *) | [3; 1] -> printf "%s_ff(-%s,%s,%s)" f c wf1 wf2 (* $-\Gamma_{\alpha\beta} \bar\psi_{1,\alpha} \psi_{3,\beta} \equiv -\Gamma = C\Gamma^T C^{-1} $ *) | [2; 3] -> printf "f_%sf( %s,%s,%s)" f c wf1 wf2 (* $ \Gamma_{\alpha\beta} \phi_2 \psi_{3,\beta} \equiv \Gamma $ *) | [3; 2] -> printf "f_%sf( %s,%s,%s)" f c wf2 wf1 (* $ \Gamma_{\alpha\beta} \phi_2 \psi_{3,\beta} \equiv \Gamma $ *) | [1; 2] -> printf "f_%sf(-%s,%s,%s)" f c wf2 wf1 (* $-\Gamma_{\alpha\beta} \bar\psi_{1,\alpha} \phi_2 \equiv -\Gamma = C\Gamma^T C^{-1} $ *) | [2; 1] -> printf "f_%sf(-%s,%s,%s)" f c wf1 wf2 (* $-\Gamma_{\alpha\beta} \bar\psi_{1,\alpha} \phi_2 \equiv -\Gamma = C\Gamma^T C^{-1} $ *) | _ -> () (* \begin{dubious} Still need a way to reliably select the Majorana version in the [Target] module! \end{dubious} *) let eps4_g4_g44_decl ff () = let printf fmt = fprintf ff fmt and nl = pp_newline ff in printf " @[<2>integer,@ dimension(0:3)"; printf ",@ save,@ private ::@ g4_@]"; nl (); printf " @[<2>integer,@ dimension(0:3,0:3)"; printf ",@ save,@ private ::@ g44_@]"; nl (); printf " @[<2>integer,@ dimension(0:3,0:3,0:3,0:3)"; printf ",@ save,@ private ::@ eps4_@]"; nl () let eps4_g4_g44_init ff () = let printf fmt = fprintf ff fmt and nl = pp_newline ff in printf " @[<2>data g4_@ /@ 1, -1, -1, -1 /@]"; nl (); printf " @[<2>data g44_(0,:)@ /@ 1, 0, 0, 0 /@]"; nl (); printf " @[<2>data g44_(1,:)@ /@ 0, -1, 0, 0 /@]"; nl (); printf " @[<2>data g44_(2,:)@ /@ 0, 0, -1, 0 /@]"; nl (); printf " @[<2>data g44_(3,:)@ /@ 0, 0, 0, -1 /@]"; nl (); for mu1 = 0 to 3 do for mu2 = 0 to 3 do for mu3 = 0 to 3 do printf " @[<2>data eps4_(%d,%d,%d,:)@ /@ " mu1 mu2 mu3; for mu4 = 0 to 3 do if mu4 <> 0 then printf ",@ "; let mus = [mu1; mu2; mu3; mu4] in if List.sort compare mus = [0; 1; 2; 3] then printf "%2d" (Combinatorics.sign mus) else printf "%2d" 0; done; printf " /@]"; nl () done done done end Index: trunk/omega/src/omega.ocamlinit =================================================================== --- trunk/omega/src/omega.ocamlinit (revision 8359) +++ trunk/omega/src/omega.ocamlinit (revision 8360) @@ -1,12 +1,23 @@ (* This is for running O'Mega inside the utop O'Caml toplevel in order to debug some modules. *) #install_printer Algebra.Laurent.pp;; #install_printer Color.Birdtracks.pp;; #install_printer Color.SU3.pp;; #install_printer Color.U3.pp;; module A = Algebra.Laurent;; module SU3 = Color.SU3;; module U3 = Color.U3;; open SU3;; open BinOps;; + +(* parse and unparse *) +let pnup spins s = + let t = UFOx.Lorentz.of_string s in + String.concat + " >>>> " + [s; UFOx.Lorentz.to_string t; + UFO_Lorentz.to_string (UFO_Lorentz.parse spins t)];; + +let pnup1 spin s = + pnup [spin; spin] s;; Index: trunk/omega/src/dirac.ml =================================================================== --- trunk/omega/src/dirac.ml (revision 8359) +++ trunk/omega/src/dirac.ml (revision 8360) @@ -1,339 +1,339 @@ (* Dirac.ml -- Copyright (C) 1999-2017 by Wolfgang Kilian Thorsten Ohl Juergen Reuter with contributions from Christian Speckner WHIZARD is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2, or (at your option) any later version. WHIZARD is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the 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{Dirac $\gamma$-matrices} *) module type T = sig type qc = Algebra.QC.t type t = qc array array val zero : qc val one : qc val minus_one : qc val i : qc val minus_i : qc val unit : t val null : t val gamma0 : t val gamma1 : t val gamma2 : t val gamma3 : t val gamma5 : t val gamma : t array val cc : t val neg : t -> t val add : t -> t -> t val sub : t -> t -> t val mul : t -> t -> t val times : qc -> t -> t val transpose : t -> t val adjoint : t -> t val conj : t -> t val product : t list -> t val test_suite : OUnit.test end (* \thocwmodulesubsection{Dirac $\gamma$-matrices} *) module Chiral : T = struct module Q = Algebra.Q module QC = Algebra.QC type qc = QC.t type t = qc array array let zero = QC.null let one = QC.unit let minus_one = QC.neg one let i = QC.make Q.null Q.unit let minus_i = QC.conj i let null = [| [| zero; zero; zero; zero |]; [| zero; zero; zero; zero |]; [| zero; zero; zero; zero |]; [| zero; zero; zero; zero |] |] let unit = [| [| one; zero; zero; zero |]; [| zero; one; zero; zero |]; [| zero; zero; one; zero |]; [| zero; zero; zero; one |] |] let gamma0 = [| [| zero; zero; one; zero |]; [| zero; zero; zero; one |]; [| one; zero; zero; zero |]; [| zero; one; zero; zero |] |] let gamma1 = [| [| zero; zero; zero; one |]; [| zero; zero; one; zero |]; [| zero; minus_one; zero; zero |]; [| minus_one; zero; zero; zero |] |] let gamma2 = [| [| zero; zero; zero; minus_i |]; [| zero; zero; i; zero |]; [| zero; i; zero; zero |]; [| minus_i; zero; zero; zero |] |] let gamma3 = [| [| zero; zero; one; zero |]; [| zero; zero; zero; minus_one |]; [| minus_one; zero; zero; zero |]; [| zero; one; zero; zero |] |] let gamma5 = [| [| minus_one; zero; zero; zero |]; [| zero; minus_one; zero; zero |]; [| zero; zero; one; zero |]; [| zero; zero; zero; one |] |] let gamma = [| gamma0; gamma1; gamma2; gamma3 |] let cc = - [| [| zero; minus_one; zero; zero |]; - [| one; zero; zero; zero |]; - [| zero; zero; zero; one |]; - [| zero; zero; minus_one; zero |] |] + [| [| zero; one; zero; zero |]; + [| minus_one; zero; zero; zero |]; + [| zero; zero; zero; minus_one |]; + [| zero; zero; one; zero |] |] let neg g = let g' = Array.make_matrix 4 4 zero in for i = 0 to 3 do for j = 0 to 3 do g'.(i).(j) <- QC.neg g.(i).(j) done done; g' let add g1 g2 = let g12 = Array.make_matrix 4 4 zero in for i = 0 to 3 do for j = 0 to 3 do g12.(i).(j) <- QC.add g1.(i).(j) g2.(i).(j) done done; g12 let sub g1 g2 = let g12 = Array.make_matrix 4 4 zero in for i = 0 to 3 do for j = 0 to 3 do g12.(i).(j) <- QC.sub g1.(i).(j) g2.(i).(j) done done; g12 let mul g1 g2 = let g12 = Array.make_matrix 4 4 zero in for i = 0 to 3 do for k = 0 to 3 do for j = 0 to 3 do g12.(i).(k) <- QC.add g12.(i).(k) (QC.mul g1.(i).(j) g2.(j).(k)) done done done; g12 let times q g = let g' = Array.make_matrix 4 4 zero in for i = 0 to 3 do for j = 0 to 3 do g'.(i).(j) <- QC.mul q g.(i).(j) done done; g' let transpose g = let g' = Array.make_matrix 4 4 zero in for i = 0 to 3 do for j = 0 to 3 do g'.(i).(j) <- g.(j).(i) done done; g' let adjoint g = let g' = Array.make_matrix 4 4 zero in for i = 0 to 3 do for j = 0 to 3 do g'.(i).(j) <- QC.conj g.(j).(i) done done; g' let conj g = let g' = Array.make_matrix 4 4 zero in for i = 0 to 3 do for j = 0 to 3 do g'.(i).(j) <- QC.conj g.(i).(j) done done; g' let product glist = List.fold_right mul glist unit open OUnit let two = QC.make (Q.make 2 1) Q.null let half = QC.make (Q.make 1 2) Q.null let two_unit = times two unit let ac_lhs mu nu = add (mul gamma.(mu) gamma.(nu)) (mul gamma.(nu) gamma.(mu)) let ac_rhs mu nu = if mu = nu then if mu = 0 then two_unit else neg two_unit else null let test_ac mu nu = (ac_lhs mu nu) = (ac_rhs mu nu) let ac_lhs_all = let lhs = Array.make_matrix 4 4 null in for mu = 0 to 3 do for nu = 0 to 3 do lhs.(mu).(nu) <- ac_lhs mu nu done done; lhs let ac_rhs_all = let rhs = Array.make_matrix 4 4 null in for mu = 0 to 3 do for nu = 0 to 3 do rhs.(mu).(nu) <- ac_rhs mu nu done done; rhs let dump2 lhs rhs = for i = 0 to 3 do for j = 0 to 3 do Printf.printf " i = %d, j =%d: %s + %s*I | %s + %s*I\n" i j (Q.to_string (QC.real lhs.(i).(j))) (Q.to_string (QC.imag lhs.(i).(j))) (Q.to_string (QC.real rhs.(i).(j))) (Q.to_string (QC.imag rhs.(i).(j))) done done let dump2_all lhs rhs = for mu = 0 to 3 do for nu = 0 to 3 do Printf.printf "mu = %d, nu =%d: \n" mu nu; dump2 lhs.(mu).(nu) rhs.(mu).(nu) done done let anticommute = "anticommutation relations" >:: (fun () -> assert_bool "" (if ac_lhs_all = ac_rhs_all then true else begin dump2_all ac_lhs_all ac_rhs_all; false end)) let equal_or_dump2 lhs rhs = if lhs = rhs then true else begin dump2 lhs rhs; false end let gamma5_def = "gamma5" >:: (fun () -> assert_bool "definition" (equal_or_dump2 gamma5 (times i (product [gamma0; gamma1; gamma2; gamma3])))) let self_adjoint = "(anti)selfadjointness" >::: [ "gamma0" >:: (fun () -> assert_bool "self" (equal_or_dump2 gamma0 (adjoint gamma0))); "gamma1" >:: (fun () -> assert_bool "anti" (equal_or_dump2 gamma1 (neg (adjoint gamma1)))); "gamma2" >:: (fun () -> assert_bool "anti" (equal_or_dump2 gamma2 (neg (adjoint gamma2)))); "gamma3" >:: (fun () -> assert_bool "anti" (equal_or_dump2 gamma3 (neg (adjoint gamma3)))); "gamma5" >:: (fun () -> assert_bool "self" (equal_or_dump2 gamma5 (adjoint gamma5))) ] let cc_inv = neg cc let cc_gamma g = equal_or_dump2 (neg (transpose g)) (product [cc; g; cc_inv]) let charge_conjugation = "charge conjugation" >::: [ "inverse" >:: (fun () -> assert_bool "" (equal_or_dump2 (mul cc cc_inv) unit)); "gamma0" >:: (fun () -> assert_bool "" (cc_gamma gamma0)); "gamma1" >:: (fun () -> assert_bool "" (cc_gamma gamma1)); "gamma2" >:: (fun () -> assert_bool "" (cc_gamma gamma2)); "gamma3" >:: (fun () -> assert_bool "" (cc_gamma gamma3)); "gamma5" >:: (fun () -> assert_bool "" (equal_or_dump2 (transpose gamma5) (product [cc; gamma5; cc_inv]))) ] let test_suite = "Dirac Matrices" >::: [anticommute; gamma5_def; self_adjoint; charge_conjugation] end Index: trunk/omega/src/UFO.ml =================================================================== --- trunk/omega/src/UFO.ml (revision 8359) +++ trunk/omega/src/UFO.ml (revision 8360) @@ -1,2444 +1,2665 @@ (* UFO.ml -- Copyright (C) 1999-2019 by Wolfgang Kilian Thorsten Ohl Juergen Reuter with contributions from Christian Speckner WHIZARD is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2, or (at your option) any later version. WHIZARD is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) (* Unfortunately, \texttt{ocamlweb} will not typeset all multi character operators nicely. E.\,g.~\verb+f @< g+ comes out as [f @< g]. *) let (@@) f g x = f (g x) let (@@@) f g x y = f (g x y) module SMap = Map.Make (struct type t = string let compare = compare end) module SSet = Sets.String module CMap = Map.Make (struct type t = string let compare = ThoString.compare_caseless end) module CSet = Sets.String_Caseless let error_in_string text start_pos end_pos = let i = start_pos.Lexing.pos_cnum and j = end_pos.Lexing.pos_cnum in String.sub text i (j - i) let error_in_file name start_pos end_pos = Printf.sprintf "%s:%d.%d-%d.%d" name start_pos.Lexing.pos_lnum (start_pos.Lexing.pos_cnum - start_pos.Lexing.pos_bol) end_pos.Lexing.pos_lnum (end_pos.Lexing.pos_cnum - end_pos.Lexing.pos_bol) let parse_string text = try UFO_parser.file UFO_lexer.token (UFO_lexer.init_position "" (Lexing.from_string text)) with | UFO_tools.Lexical_Error (msg, start_pos, end_pos) -> invalid_arg (Printf.sprintf "lexical error (%s) at: `%s'" msg (error_in_string text start_pos end_pos)) | UFO_syntax.Syntax_Error (msg, start_pos, end_pos) -> invalid_arg (Printf.sprintf "syntax error (%s) at: `%s'" msg (error_in_string text start_pos end_pos)) | Parsing.Parse_error -> invalid_arg ("parse error: " ^ text) let parse_file name = let ic = open_in name in let result = begin try UFO_parser.file UFO_lexer.token (UFO_lexer.init_position name (Lexing.from_channel ic)) with | UFO_tools.Lexical_Error (msg, start_pos, end_pos) -> begin close_in ic; invalid_arg (Printf.sprintf "%s: lexical error (%s)" (error_in_file name start_pos end_pos) msg) end | UFO_syntax.Syntax_Error (msg, start_pos, end_pos) -> begin close_in ic; invalid_arg (Printf.sprintf "%s: syntax error (%s)" (error_in_file name start_pos end_pos) msg) end | Parsing.Parse_error -> begin close_in ic; invalid_arg ("parse error: " ^ name) end end in close_in ic; result (* These are the contents of the Python files after lexical analysis as context-free variable declarations, before any semantic interpretation. *) module type Files = sig type t = private { particles : UFO_syntax.t; couplings : UFO_syntax.t; coupling_orders : UFO_syntax.t; vertices : UFO_syntax.t; lorentz : UFO_syntax.t; parameters : UFO_syntax.t; propagators : UFO_syntax.t; decays : UFO_syntax.t } val parse_directory : string -> t end module Files : Files = struct type t = { particles : UFO_syntax.t; couplings : UFO_syntax.t; coupling_orders : UFO_syntax.t; vertices : UFO_syntax.t; lorentz : UFO_syntax.t; parameters : UFO_syntax.t; propagators : UFO_syntax.t; decays : UFO_syntax.t } let parse_directory dir = let parse stem = parse_file (Filename.concat dir (stem ^ ".py")) in { particles = parse "particles"; couplings = parse "couplings"; coupling_orders = (try parse "coupling_orders" with _ -> []); vertices = parse "vertices"; lorentz = parse "lorentz"; parameters = parse "parameters"; propagators = (try parse "propagators" with _ -> []); decays = (try parse "decays" with _ -> []) } end let dump_file pfx f = List.iter (fun s -> print_endline (pfx ^ ": " ^ s)) (UFO_syntax.to_strings f) type charge = | Q_Integer of int | Q_Fraction of int * int let charge_to_string = function | Q_Integer i -> Printf.sprintf "%d" i | Q_Fraction (n, d) -> Printf.sprintf "%d/%d" n d module S = UFO_syntax let find_attrib name attribs = try (List.find (fun a -> name = a.S.a_name) attribs).S.a_value with | Not_found -> failwith ("UFO.find_attrib: \"" ^ name ^ "\" not found") let find_attrib name attribs = (List.find (fun a -> name = a.S.a_name) attribs).S.a_value let name_to_string ?strip name = let stripped = begin match strip, List.rev name with | Some pfx, head :: tail -> if pfx = head then tail else failwith ("UFO.name_to_string: expected prefix '" ^ pfx ^ "', got '" ^ head ^ "'") | _, name -> name end in String.concat "." stripped let name_attrib ?strip name attribs = match find_attrib name attribs with | S.Name n -> name_to_string ?strip n | _ -> invalid_arg name let integer_attrib name attribs = match find_attrib name attribs with | S.Integer i -> i | _ -> invalid_arg name let charge_attrib name attribs = match find_attrib name attribs with | S.Integer i -> Q_Integer i | S.Fraction (n, d) -> Q_Fraction (n, d) | _ -> invalid_arg name let string_attrib name attribs = match find_attrib name attribs with | S.String s -> s | _ -> invalid_arg name let boolean_attrib name attribs = try match ThoString.lowercase (name_attrib name attribs) with | "true" -> true | "false" -> false | _ -> invalid_arg name with | Not_found -> false type value = | Integer of int | Fraction of int * int | Float of float | Expr of UFOx.Expr.t | Name of string list let map_expr f default = function | Integer _ | Fraction (_, _) | Float _ | Name _ -> default | Expr e -> f e let variables = map_expr UFOx.Expr.variables CSet.empty let functions = map_expr UFOx.Expr.functions CSet.empty let add_to_set_in_map key element map = let set = try CMap.find key map with Not_found -> CSet.empty in CMap.add key (CSet.add element set) map (* Add all variables in [value] to the [map] from variables to the names in which they appear, indicating that [name] depends on these variables. *) let dependency name value map = CSet.fold (fun variable acc -> add_to_set_in_map variable name acc) (variables value) map let dependencies name_value_list = List.fold_left (fun acc (name, value) -> dependency name value acc) CMap.empty name_value_list let dependency_to_string (variable, appearences) = Printf.sprintf "%s -> {%s}" variable (String.concat ", " (CSet.elements appearences)) let dependencies_to_strings map = List.map dependency_to_string (CMap.bindings map) let expr_to_string = UFOx.Value.to_string @@ UFOx.Value.of_expr let value_to_string = function | Integer i -> Printf.sprintf "%d" i | Fraction (n, d) -> Printf.sprintf "%d/%d" n d | Float x -> string_of_float x | Expr e -> "'" ^ expr_to_string e ^ "'" | Name n -> name_to_string n let value_to_expr substitutions = function | Integer i -> Printf.sprintf "%d" i | Fraction (n, d) -> Printf.sprintf "%d/%d" n d | Float x -> string_of_float x | Expr e -> expr_to_string (substitutions e) | Name n -> name_to_string n let value_to_coupling substitutions atom = function | Integer i -> Coupling.Integer i | Fraction (n, d) -> Coupling.Quot (Coupling.Integer n, Coupling.Integer d) | Float x -> Coupling.Float x | Expr e -> UFOx.Value.to_coupling atom (UFOx.Value.of_expr (substitutions e)) | Name n -> failwith "UFO.value_to_coupling: Name not supported yet!" let value_to_numeric = function | Integer i -> Printf.sprintf "%d" i | Fraction (n, d) -> Printf.sprintf "%g" (float n /. float d) | Float x -> Printf.sprintf "%g" x | Expr e -> invalid_arg ("UFO.value_to_numeric: expr = " ^ (expr_to_string e)) | Name n -> invalid_arg ("UFO.value_to_numeric: name = " ^ name_to_string n) let value_to_float = function | Integer i -> float i | Fraction (n, d) -> float n /. float d | Float x -> x | Expr e -> invalid_arg ("UFO.value_to_float: string = " ^ (expr_to_string e)) | Name n -> invalid_arg ("UFO.value_to_float: name = " ^ name_to_string n) let value_attrib name attribs = match find_attrib name attribs with | S.Integer i -> Integer i | S.Fraction (n, d) -> Fraction (n, d) | S.Float x -> Float x | S.String s -> Expr (UFOx.Expr.of_string s) | S.Name n -> Name n | _ -> invalid_arg name let string_list_attrib name attribs = match find_attrib name attribs with | S.String_List l -> l | _ -> invalid_arg name let name_list_attrib ~strip name attribs = match find_attrib name attribs with | S.Name_List l -> List.map (name_to_string ~strip) l | _ -> invalid_arg name let integer_list_attrib name attribs = match find_attrib name attribs with | S.Integer_List l -> l | _ -> invalid_arg name let order_dictionary_attrib name attribs = match find_attrib name attribs with | S.Order_Dictionary d -> d | _ -> invalid_arg name let coupling_dictionary_attrib ~strip name attribs = match find_attrib name attribs with | S.Coupling_Dictionary d -> List.map (fun (i, j, c) -> (i, j, name_to_string ~strip c)) d | _ -> invalid_arg name let decay_dictionary_attrib name attribs = match find_attrib name attribs with | S.Decay_Dictionary d -> List.map (fun (p, w) -> (List.map List.hd p, w)) d | _ -> invalid_arg name +(*i The following doesn't typecheck in applications, even with + type annotations ... +let attrib_handlers : type attribs value. + string -> string -> attribs -> + ((string -> attribs -> value) -> string -> value) * + ((string -> attribs -> value) -> string -> value -> value) = + fun kind symbol attribs -> + let required query name = + try + query name attribs + with + | Not_found -> + invalid_arg + (Printf.sprintf + "fatal UFO error: mandatory attribute `%s' missing for %s `%s'!" + name kind symbol) + and optional query name default = + try + query name attribs + with + | Not_found -> default in + (required, optional) i*) + +let required_handler kind symbol attribs query name = + try + query name attribs + with + | Not_found -> + invalid_arg + (Printf.sprintf + "fatal UFO error: mandatory attribute `%s' missing for %s `%s'!" + name kind symbol) + +let optional_handler attribs query name default = + try + query name attribs + with + | Not_found -> default + let warn_symbol_name file symbol name = if name <> symbol then Printf.eprintf "UFO: warning: symbol '%s' <> name '%s' in %s.py: expect errors!\n" symbol name file let map_to_alist map = SMap.fold (fun key value acc -> (key, value) :: acc) map [] let keys map = SMap.fold (fun key _ acc -> key :: acc) map [] let keys_caseless map = CMap.fold (fun key _ acc -> key :: acc) map [] let values map = SMap.fold (fun _ value acc -> value :: acc) map [] module SKey = struct type t = string let hash = Hashtbl.hash let equal = (=) end module SHash = Hashtbl.Make (SKey) module type Particle = sig type t = private { pdg_code : int; name : string; antiname : string; spin : UFOx.Lorentz.r; color : UFOx.Color.r; mass : string; width : string; propagator : string option; texname : string; antitexname : string; charge : charge; ghost_number : int; lepton_number : int; y : int; goldstone : bool; propagating : bool; (* NOT HANDLED YET! *) line : string option; (* NOT HANDLED YET! *) is_anti : bool } val of_file : S.t -> t SMap.t val to_string : string -> t -> string val conjugate : t -> t val force_spinor : t -> t val force_conjspinor : t -> t val force_majorana : t -> t val is_majorana : t -> bool val is_ghost : t -> bool val is_goldstone : t -> bool val is_physical : t -> bool val filter : (t -> bool) -> t SMap.t -> t SMap.t end module Particle : Particle = struct type t = { pdg_code : int; name : string; antiname : string; spin : UFOx.Lorentz.r; color : UFOx.Color.r; mass : string; width : string; propagator : string option; texname : string; antitexname : string; charge : charge; ghost_number : int; lepton_number : int; y : int; goldstone : bool; propagating : bool; (* NOT HANDLED YET! *) line : string option; (* NOT HANDLED YET! *) is_anti : bool } let to_string symbol p = Printf.sprintf "particle: %s => [pdg = %d, name = '%s'/'%s', \ spin = %s, color = %s, \ mass = %s, width = %s,%s \ Q = %s, G = %d, L = %d, Y = %d, \ TeX = '%s'/'%s'%s]" symbol p.pdg_code p.name p.antiname (UFOx.Lorentz.rep_to_string p.spin) (UFOx.Color.rep_to_string p.color) p.mass p.width (match p.propagator with | None -> "" | Some p -> " propagator = " ^ p ^ ",") (charge_to_string p.charge) p.ghost_number p.lepton_number p.y p.texname p.antitexname (if p.goldstone then ", GB" else "") let conjugate_charge = function | Q_Integer i -> Q_Integer (-i) | Q_Fraction (n, d) -> Q_Fraction (-n, d) let is_neutral p = (p.name = p.antiname) (* We \emph{must not} mess with [pdg_code] and [color] if the particle is neutral! *) let conjugate p = if is_neutral p then p else { pdg_code = - p.pdg_code; name = p.antiname; antiname = p.name; spin = UFOx.Lorentz.rep_conjugate p.spin; color = UFOx.Color.rep_conjugate p.color; mass = p.mass; width = p.width; propagator = p.propagator; texname = p.antitexname; antitexname = p.texname; charge = conjugate_charge p.charge; ghost_number = p.ghost_number; lepton_number = p.lepton_number; y = p.y; goldstone = p.goldstone; propagating = p.propagating; line = p.line; is_anti = not p.is_anti } let of_file1 map d = let symbol = d.S.name in match d.S.kind, d.S.attribs with | [ "Particle" ], attribs -> - let name = string_attrib "name" attribs - and antiname = string_attrib "antiname" attribs in + let required query name = + required_handler "particle" symbol attribs query name + and optional query name default = + optional_handler attribs query name default in + let name = required string_attrib "name" + and antiname = required string_attrib "antiname" in let neutral = (name = antiname) in SMap.add symbol - { pdg_code = integer_attrib "pdg_code" attribs; + { (* The required attributes per UFO docs. *) + pdg_code = required integer_attrib "pdg_code"; name; antiname; spin = - UFOx.Lorentz.rep_of_int neutral (integer_attrib "spin" attribs); + UFOx.Lorentz.rep_of_int neutral (required integer_attrib "spin"); color = - UFOx.Color.rep_of_int neutral (integer_attrib "color" attribs); - mass = name_attrib ~strip:"Param" "mass" attribs; - width = name_attrib ~strip:"Param" "width" attribs; + UFOx.Color.rep_of_int neutral (required integer_attrib "color"); + mass = required (name_attrib ~strip:"Param") "mass"; + width = required (name_attrib ~strip:"Param") "width"; + texname = required string_attrib "texname"; + antitexname = required string_attrib "antitexname"; + charge = required charge_attrib "charge"; + (* The optional attributes per UFO docs. *) + ghost_number = optional integer_attrib "GhostNumber" 0; + lepton_number = optional integer_attrib "LeptonNumber" 0; + y = optional integer_attrib "Y" 0; + goldstone = optional boolean_attrib "goldstone" false; + propagating = optional boolean_attrib "propagating" true; + line = + (try Some (name_attrib "line" attribs) with _ -> None); + (* Undocumented extensions. *) propagator = (try Some (name_attrib "propagator" attribs) with _ -> None); - texname = string_attrib "texname" attribs; - antitexname = string_attrib "antitexname" attribs; - charge = charge_attrib "charge" attribs; - ghost_number = integer_attrib "GhostNumber" attribs; - lepton_number = - (try integer_attrib "LeptonNumber" attribs with _ -> 0); - y = (try integer_attrib "Y" attribs with _ -> 0); - goldstone = (try boolean_attrib "goldstone" attribs with _ -> false); - propagating = true; - line = None; - is_anti = false} map + (* O'Mega extensions. *) + is_anti = false } map | [ "anti"; p ], [] -> begin try SMap.add symbol (conjugate (SMap.find p map)) map with | Not_found -> invalid_arg ("Particle.of_file: " ^ p ^ ".anti() not yet defined!") end | _ -> invalid_arg ("Particle.of_file: " ^ name_to_string d.S.kind) let of_file particles = List.fold_left of_file1 SMap.empty particles let is_spinor p = match UFOx.Lorentz.omega p.spin with | Coupling.Spinor | Coupling.ConjSpinor | Coupling.Majorana -> true | _ -> false (* \begin{dubious} TODO: this is a bit of a hack: try to expose the type [UFOx.Lorentz_Atom'.r] instead. \end{dubious} *) let force_spinor p = if is_spinor p then { p with spin = UFOx.Lorentz.rep_of_int false 2 } else p let force_conjspinor p = if is_spinor p then { p with spin = UFOx.Lorentz.rep_of_int false (-2) } else p let force_majorana p = if is_spinor p then { p with spin = UFOx.Lorentz.rep_of_int true 2 } else p let is_majorana p = match UFOx.Lorentz.omega p.spin with | Coupling.Majorana -> true | _ -> false let is_ghost p = p.ghost_number <> 0 let is_goldstone p = p.goldstone let is_physical p = not (is_ghost p || is_goldstone p) let filter predicate map = SMap.filter (fun symbol p -> predicate p) map end module type UFO_Coupling = sig type t = private { name : string; value : UFOx.Expr.t; order : (string * int) list } val of_file : S.t -> t SMap.t val to_string : string -> t -> string end module UFO_Coupling : UFO_Coupling = struct type t = { name : string; value : UFOx.Expr.t; order : (string * int) list } let order_to_string orders = String.concat ", " (List.map (fun (s, i) -> Printf.sprintf "'%s':%d" s i) orders) let to_string symbol c = Printf.sprintf "coupling: %s => [name = '%s', value = '%s', order = [%s]]" symbol c.name (expr_to_string c.value) (order_to_string c.order) let of_file1 map d = let symbol = d.S.name in match d.S.kind, d.S.attribs with | [ "Coupling" ], attribs -> - let name = string_attrib "name" attribs in + let required query name = + required_handler "coupling" symbol attribs query name in + let name = required string_attrib "name" in warn_symbol_name "couplings" symbol name; SMap.add symbol { name; - value = UFOx.Expr.of_string (string_attrib "value" attribs); - order = order_dictionary_attrib "order" attribs } map + value = UFOx.Expr.of_string (required string_attrib "value"); + order = required order_dictionary_attrib "order" } map | _ -> invalid_arg ("UFO_Coupling.of_file: " ^ name_to_string d.S.kind) let of_file couplings = List.fold_left of_file1 SMap.empty couplings end module type Coupling_Order = sig type t = private { name : string; expansion_order : int; hierarchy : int } val of_file : S.t -> t SMap.t val to_string : string -> t -> string end module Coupling_Order : Coupling_Order = struct type t = { name : string; expansion_order : int; hierarchy : int } let to_string symbol c = Printf.sprintf "coupling_order: %s => [name = '%s', \ expansion_order = '%d', \ hierarchy = %d]" symbol c.name c.expansion_order c.hierarchy let of_file1 map d = let symbol = d.S.name in match d.S.kind, d.S.attribs with | [ "CouplingOrder" ], attribs -> - let name = string_attrib "name" attribs in + let required query name = + required_handler "coupling order" symbol attribs query name in + let name = required string_attrib "name" in warn_symbol_name "coupling_orders" symbol name; SMap.add symbol { name; - expansion_order = integer_attrib "expansion_order" attribs; - hierarchy = integer_attrib "hierarchy" attribs } map + expansion_order = required integer_attrib "expansion_order"; + hierarchy = required integer_attrib "hierarchy" } map | _ -> invalid_arg ("Coupling_order.of_file: " ^ name_to_string d.S.kind) let of_file coupling_orders = List.fold_left of_file1 SMap.empty coupling_orders end module type Lorentz_UFO = sig type t = private { name : string; spins : int list; structure : UFOx.Lorentz.t } val of_file : S.t -> t SMap.t val to_string : string -> t -> string end module Lorentz_UFO : Lorentz_UFO = struct type t = { name : string; spins : int list; structure : UFOx.Lorentz.t } let to_string symbol l = Printf.sprintf "lorentz: %s => [name = '%s', spins = [%s], \ structure = %s]" symbol l.name (String.concat ", " (List.map string_of_int l.spins)) (UFOx.Lorentz.to_string l.structure) let of_file1 map d = let symbol = d.S.name in match d.S.kind, d.S.attribs with | [ "Lorentz" ], attribs -> - let name = string_attrib "name" attribs in + let required query name = + required_handler "lorentz" symbol attribs query name in + let name = required string_attrib "name" in warn_symbol_name "lorentz" symbol name; SMap.add symbol { name; - spins = integer_list_attrib "spins" attribs; + spins = required integer_list_attrib "spins"; structure = - UFOx.Lorentz.of_string (string_attrib "structure" attribs) } map + UFOx.Lorentz.of_string (required string_attrib "structure") } map | _ -> invalid_arg ("Lorentz.of_file: " ^ name_to_string d.S.kind) let of_file lorentz = List.fold_left of_file1 SMap.empty lorentz end module type Vertex = sig type lcc = private (* Lorentz-color-coupling *) { lorentz : string; color : UFOx.Color.t; coupling : string } type t = private { name : string; particles : string array; lcc : lcc list } val of_file : Particle.t SMap.t -> S.t -> t SMap.t val to_string : string -> t -> string val to_string_expanded : Lorentz_UFO.t SMap.t -> UFO_Coupling.t SMap.t -> t -> string val contains : Particle.t SMap.t -> (Particle.t -> bool) -> t -> bool val filter : (t -> bool) -> t SMap.t -> t SMap.t end module Vertex : Vertex = struct type lcc = { lorentz : string; color : UFOx.Color.t; coupling : string } type t = { name : string; particles : string array; lcc : lcc list } let to_string symbol c = Printf.sprintf "vertex: %s => [name = '%s', particles = [%s], \ lorentz-color-couplings = [%s]" symbol c.name (String.concat ", " (Array.to_list c.particles)) (String.concat ", " (List.map (fun lcc -> Printf.sprintf "%s * %s * %s" lcc.coupling lcc.lorentz (UFOx.Color.to_string lcc.color)) c.lcc)) let to_string_expanded lorentz couplings c = let expand_lorentz s = try UFOx.Lorentz.to_string (SMap.find s lorentz).Lorentz_UFO.structure with | Not_found -> "?" in Printf.sprintf "expanded: [%s] -> { lorentz-color-couplings = [%s] }" (String.concat ", " (Array.to_list c.particles)) (String.concat ", " (List.map (fun lcc -> Printf.sprintf "%s * %s * %s" lcc.coupling (expand_lorentz lcc.lorentz) (UFOx.Color.to_string lcc.color)) c.lcc)) let contains particles predicate v = let p = v.particles in let rec contains' i = if i < 0 then false else if predicate (SMap.find p.(i) particles) then true else contains' (pred i) in contains' (Array.length p - 1) let force_adj_identity1 adj_indices = function | UFOx.Color_Atom.Identity (a, b) as atom -> begin match List.mem a adj_indices, List.mem b adj_indices with | true, true -> UFOx.Color_Atom.Identity8 (a, b) | false, false -> atom | true, false | false, true -> invalid_arg "force_adj_identity: mixed representations!" end | atom -> atom let force_adj_identity adj_indices tensor = UFOx.Color.map_atoms (force_adj_identity1 adj_indices) tensor let find_adj_indices map particles = let adj_indices = ref [] in Array.iteri (fun i p -> (* We must pattern match against the O'Mega representation, because [UFOx.Color.r] is abstract. *) match UFOx.Color.omega (SMap.find p map).Particle.color with | Color.AdjSUN _ -> adj_indices := succ i :: !adj_indices | _ -> ()) particles; !adj_indices let classify_color_indices map particles = let fund_indices = ref [] and conj_indices = ref [] and adj_indices = ref [] in Array.iteri (fun i p -> (* We must pattern match against the O'Mega representation, because [UFOx.Color.r] is abstract. *) match UFOx.Color.omega (SMap.find p map).Particle.color with | Color.SUN n -> if n > 0 then fund_indices := succ i :: !fund_indices else if n < 0 then conj_indices := succ i :: !conj_indices else failwith "classify_color_indices: SU(0)" | Color.AdjSUN n -> if n <> 0 then adj_indices := succ i :: !adj_indices else failwith "classify_color_indices: SU(0)" | _ -> ()) particles; (!fund_indices, !conj_indices, !adj_indices) (* FIXME: would have expected the opposite order \ldots *) let force_identity1 (fund_indices, conj_indices, adj_indices) = function | UFOx.Color_Atom.Identity (a, b) as atom -> if List.mem a fund_indices then begin if List.mem b conj_indices then UFOx.Color_Atom.Identity (b, a) else invalid_arg "force_adj_identity: mixed representations!" end else if List.mem a conj_indices then begin if List.mem b fund_indices then UFOx.Color_Atom.Identity (a, b) else invalid_arg "force_adj_identity: mixed representations!" end else if List.mem a adj_indices then begin if List.mem b adj_indices then UFOx.Color_Atom.Identity8 (a, b) else invalid_arg "force_adj_identity: mixed representations!" end else atom | atom -> atom let force_identity indices tensor = UFOx.Color.map_atoms (force_identity1 indices) tensor (* Here we don't have the Lorentz structures available yet. Thus we set [fermion_lines = []] for now and correct this later. *) let of_file1 particle_map map d = let symbol = d.S.name in match d.S.kind, d.S.attribs with | [ "Vertex" ], attribs -> - let name = string_attrib "name" attribs in + let required query name = + required_handler "vertex" symbol attribs query name in + let name = required string_attrib "name" in warn_symbol_name "vertices" symbol name; let particles = - Array.of_list (name_list_attrib ~strip:"P" "particles" attribs) in + Array.of_list (required (name_list_attrib ~strip:"P") "particles") in let color = let indices = classify_color_indices particle_map particles in Array.of_list (List.map (force_identity indices @@ UFOx.Color.of_string) - (string_list_attrib "color" attribs)) + (required string_list_attrib "color")) and lorentz = - Array.of_list (name_list_attrib ~strip:"L" "lorentz" attribs) + Array.of_list (required (name_list_attrib ~strip:"L") "lorentz") and couplings_alist = - coupling_dictionary_attrib ~strip:"C" "couplings" attribs in + required (coupling_dictionary_attrib ~strip:"C") "couplings" in let lcc = List.map (fun (i, j, c) -> { lorentz = lorentz.(j); color = color.(i); coupling = c }) couplings_alist in SMap.add symbol { name; particles; lcc } map | _ -> invalid_arg ("Vertex.of_file: " ^ name_to_string d.S.kind) let of_file particles vertices = List.fold_left (of_file1 particles) SMap.empty vertices let filter predicate map = SMap.filter (fun symbol p -> predicate p) map end module type Parameter = sig type nature = private Internal | External type ptype = private Real | Complex type t = private { name : string; nature : nature; ptype : ptype; value : value; texname : string; lhablock : string option; lhacode : int list option; sequence : int } val of_file : S.t -> t SMap.t val to_string : string -> t -> string val missing : string -> t end module Parameter : Parameter = struct type nature = Internal | External let nature_to_string = function | Internal -> "internal" | External -> "external" let nature_of_string = function | "internal" -> Internal | "external" -> External | s -> invalid_arg ("Parameter.nature_of_string: " ^ s) type ptype = Real | Complex let ptype_to_string = function | Real -> "real" | Complex -> "complex" let ptype_of_string = function | "real" -> Real | "complex" -> Complex | s -> invalid_arg ("Parameter.ptype_of_string: " ^ s) type t = { name : string; nature : nature; ptype : ptype; value : value; texname : string; lhablock : string option; lhacode : int list option; sequence : int } let to_string symbol p = Printf.sprintf "parameter: %s => [#%d, name = '%s', nature = %s, type = %s, \ value = %s, texname = '%s', \ lhablock = %s, lhacode = [%s]]" symbol p.sequence p.name (nature_to_string p.nature) (ptype_to_string p.ptype) (value_to_string p.value) p.texname (match p.lhablock with None -> "???" | Some s -> s) (match p.lhacode with | None -> "" | Some c -> String.concat ", " (List.map string_of_int c)) let of_file1 (map, n) d = let symbol = d.S.name in match d.S.kind, d.S.attribs with | [ "Parameter" ], attribs -> - let name = string_attrib "name" attribs in + let required query name = + required_handler "particle" symbol attribs query name in + let name = required string_attrib "name" in warn_symbol_name "parameters" symbol name; (SMap.add symbol { name; - nature = nature_of_string (string_attrib "nature" attribs); - ptype = ptype_of_string (string_attrib "type" attribs); - value = value_attrib "value" attribs; - texname = string_attrib "texname" attribs; + nature = nature_of_string (required string_attrib "nature"); + ptype = ptype_of_string (required string_attrib "type"); + value = required value_attrib "value"; + texname = required string_attrib "texname"; lhablock = (try Some (string_attrib "lhablock" attribs) with Not_found -> None); lhacode = (try Some (integer_list_attrib "lhacode" attribs) with Not_found -> None); sequence = n } map, succ n) | _ -> invalid_arg ("Parameter.of_file: " ^ name_to_string d.S.kind) let of_file parameters = let map, _ = List.fold_left of_file1 (SMap.empty, 0) parameters in map let missing name = { name; nature = External; ptype = Real; value = Integer 0; texname = Printf.sprintf "\\texttt{%s}" name; lhablock = None; lhacode = None; sequence = 0 } end -module type Propagator = +module type Propagator_UFO = sig - type t = private + type t = (* private *) { name : string; - numerator : string; - denominator : string } + numerator : UFOx.Lorentz.t; + denominator : UFOx.Lorentz.t } val of_file : S.t -> t SMap.t val to_string : string -> t -> string end -module Propagator : Propagator = +module Propagator_UFO : Propagator_UFO = struct type t = { name : string; - numerator : string; - denominator : string } + numerator : UFOx.Lorentz.t; + denominator : UFOx.Lorentz.t } let to_string symbol p = Printf.sprintf "propagator: %s => [name = '%s', numerator = '%s', \ denominator = '%s']" - symbol p.name p.numerator p.denominator - - let inspect_propagator symbol numerator denominator = - begin - try - ignore (UFOx.Lorentz.of_string numerator) - with - | Invalid_argument msg -> - Printf.eprintf - "in progress: propagator %s numerator: %s in \"%s\"\n" - symbol msg numerator - end; - begin - try - ignore (UFOx.Expr.of_string denominator) - with - | Invalid_argument msg -> - Printf.eprintf - "in progress: propagator %s denominator: %s in \"%s\"\n" - symbol msg denominator - end + symbol p.name + (UFOx.Lorentz.to_string p.numerator) + (UFOx.Lorentz.to_string p.denominator) + + (* The \texttt{denominator} attribute is optional and + there is a default (cf.~\texttt{arXiv:1308.1668}) *) + let default_denominator = + "P('mu', id) * P('mu', id) \ + - Mass(id) * Mass(id) \ + + complex(0,1) * Mass(id) * Width(id)" - let inspect_propagator symbol numerator denominator = - () + let of_string_with_error_correction symbol num_or_den s = + try + UFOx.Lorentz.of_string s + with + | Invalid_argument msg -> + begin + let fixed = s ^ ")" in + try + let tensor = UFOx.Lorentz.of_string fixed in + Printf.eprintf + "UFO.Propagator.of_string: added missing closing parenthesis \ + in %s of %s: \"%s\"\n" + num_or_den symbol s; + tensor + with + | Invalid_argument _ -> + invalid_arg + (Printf.sprintf + "UFO.Propagator.of_string: %s of %s: %s in \"%s\"\n" + num_or_den symbol msg fixed) + end (* The parser will turn [foo = "bar"] into [foo = "bar"."$"], which will be interpreted as a macro definition for [foo] expanding to ["bar"]. The dollar is used to distinguish it from an empty attribute list. This could also be implemented with a union type for the declarations. *) let of_file1 (macros, map) d = let symbol = d.S.name in match d.S.kind, d.S.attribs with | [ "Propagator" ], attribs -> - let name = string_attrib "name" attribs in + let required query name = + required_handler "particle" symbol attribs query name + and optional query name default = + optional_handler attribs query name default in + let name = required string_attrib "name" in warn_symbol_name "propagators" symbol name; - let numerator = string_attrib "numerator" attribs - and denominator = - begin match find_attrib "denominator" attribs with + let num_string = required string_attrib "numerator" + and den_string = + begin match optional find_attrib "denominator" + (S.String default_denominator) with | S.String s -> s | S.Name [n] -> SMap.find n macros | _ -> invalid_arg "Propagator.denominator: " end in - inspect_propagator symbol numerator denominator; - (macros, - SMap.add symbol - { name; - numerator; - denominator } map) + let numerator = + of_string_with_error_correction symbol "numerator" num_string + and denominator = + of_string_with_error_correction symbol "denominator" den_string in + (macros, SMap.add symbol { name; numerator; denominator } map) | [ "$"; s ], [] -> (SMap.add symbol s macros, map) | _ -> invalid_arg ("Propagator:of_file: " ^ name_to_string d.S.kind) let of_file propagators = let _, propagators' = List.fold_left of_file1 (SMap.empty, SMap.empty) propagators in propagators' end module type Decay = sig type t = private { name : string; particle : string; widths : (string list * string) list } val of_file : S.t -> t SMap.t val to_string : string -> t -> string end module Decay : Decay = struct type t = { name : string; particle : string; widths : (string list * string) list } let width_to_string ws = String.concat ", " (List.map (fun (ps, w) -> "(" ^ String.concat ", " ps ^ ") -> '" ^ w ^ "'") ws) let to_string symbol d = Printf.sprintf "decay: %s => [name = '%s', particle = '%s', widths = [%s]]" symbol d.name d.particle (width_to_string d.widths) let of_file1 map d = let symbol = d.S.name in match d.S.kind, d.S.attribs with | [ "Decay" ], attribs -> - let name = string_attrib "name" attribs in + let required query name = + required_handler "particle" symbol attribs query name in + let name = required string_attrib "name" in warn_symbol_name "decays" symbol name; SMap.add symbol { name; - particle = name_attrib ~strip:"P" "particle" attribs; - widths = decay_dictionary_attrib "partial_widths" attribs } map + particle = required (name_attrib ~strip:"P") "particle"; + widths = required decay_dictionary_attrib "partial_widths" } map | _ -> invalid_arg ("Decay.of_file: " ^ name_to_string d.S.kind) let of_file decays = List.fold_left of_file1 SMap.empty decays end (* We can read the spinor representations off the vertices to check for consistency. *) (* \begin{dubious} Note that we have to conjugate the representations! \end{dubious} *) let collect_spinor_reps_of_vertex particles lorentz v sets = List.fold_left (fun sets' lcc -> let l = (SMap.find lcc.Vertex.lorentz lorentz).Lorentz_UFO.structure in List.fold_left (fun (spinors, conj_spinors as sets'') (i, rep) -> let p = v.Vertex.particles.(pred i) in match UFOx.Lorentz.omega rep with | Coupling.ConjSpinor -> (SSet.add p spinors, conj_spinors) | Coupling.Spinor -> (spinors, SSet.add p conj_spinors) | _ -> sets'') sets' (UFOx.Lorentz.classify_indices l)) sets v.Vertex.lcc let collect_spinor_reps_of_vertices particles lorentz vertices = SMap.fold (fun _ v -> collect_spinor_reps_of_vertex particles lorentz v) vertices (SSet.empty, SSet.empty) let lorentz_reps_of_vertex particles v = ThoList.alist_of_list ~predicate:(not @@ UFOx.Lorentz.rep_trivial) ~offset:1 (List.map (fun p -> (* Why do we need to conjugate??? *) UFOx.Lorentz.rep_conjugate (SMap.find p particles).Particle.spin) (Array.to_list v.Vertex.particles)) let rep_compatible rep_vertex rep_particle = let open UFOx.Lorentz in let open Coupling in match omega rep_vertex, omega rep_particle with | (Spinor | ConjSpinor), Majorana -> true | r1, r2 -> r1 = r2 let reps_compatible reps_vertex reps_particles = List.for_all2 (fun (iv, rv) (ip, rp) -> iv = ip && rep_compatible rv rp) reps_vertex reps_particles let check_lorentz_reps_of_vertex particles lorentz v = let reps_particles = List.sort compare (lorentz_reps_of_vertex particles v) in List.iter (fun lcc -> let l = (SMap.find lcc.Vertex.lorentz lorentz).Lorentz_UFO.structure in let reps_vertex = List.sort compare (UFOx.Lorentz.classify_indices l) in if not (reps_compatible reps_vertex reps_particles) then begin Printf.eprintf "%s <> %s [%s]\n" (UFOx.Index.classes_to_string UFOx.Lorentz.rep_to_string reps_particles) (UFOx.Index.classes_to_string UFOx.Lorentz.rep_to_string reps_vertex) v.Vertex.name (* [(Vertex.to_string v.Vertex.name v)] *); (* [invalid_arg "check_lorentz_reps_of_vertex"] *) () end) v.Vertex.lcc let color_reps_of_vertex particles v = ThoList.alist_of_list ~predicate:(not @@ UFOx.Color.rep_trivial) ~offset:1 (List.map (fun p -> (SMap.find p particles).Particle.color) (Array.to_list v.Vertex.particles)) let check_color_reps_of_vertex particles v = let reps_particles = List.sort compare (color_reps_of_vertex particles v) in List.iter (fun lcc -> let reps_vertex = List.sort compare (UFOx.Color.classify_indices lcc.Vertex.color) in if reps_vertex <> reps_particles then begin Printf.printf "%s <> %s\n" (UFOx.Index.classes_to_string UFOx.Color.rep_to_string reps_particles) (UFOx.Index.classes_to_string UFOx.Color.rep_to_string reps_vertex); invalid_arg "check_color_reps_of_vertex" end) v.Vertex.lcc module P = Permutation.Default module type Lorentz = sig type spins = private | Unused | Unique of Coupling.lorentz array | Ambiguous of Coupling.lorentz array SMap.t type t = private { name : string; n : int; spins : spins; structure : UFO_Lorentz.t; fermion_lines : Coupling.fermion_lines } val permute : P.t -> t -> t val of_lorentz_UFO : Particle.t SMap.t -> Vertex.t SMap.t -> Lorentz_UFO.t SMap.t -> t SMap.t + val lorentz_to_string : Coupling.lorentz -> string val to_string : string -> t -> string end module Lorentz : Lorentz = struct let rec lorentz_to_string = function | Coupling.Scalar -> "Scalar" | Coupling.Spinor -> "Spinor" | Coupling.ConjSpinor -> "ConjSpinor" | Coupling.Majorana -> "Majorana" | Coupling.Maj_Ghost -> "Maj_Ghost" | Coupling.Vector -> "Vector" | Coupling.Massive_Vector -> "Massive_Vector" | Coupling.Vectorspinor -> "Vectorspinor" | Coupling.Tensor_1 -> "Tensor_1" | Coupling.Tensor_2 -> "Tensor_2" | Coupling.BRS l -> "BRS(" ^ lorentz_to_string l ^ ")" (* Unlike UFO, O'Mega distinguishes bewteen spinors and conjugate spinors. However, we can inspect the particles in the vertices in which a Lorentz structure is used to determine the correct quantum numbers. Most model files in the real world contain unused Lorentz structures. This is not a problem, we can just ignore them. *) type spins = | Unused | Unique of Coupling.lorentz array | Ambiguous of Coupling.lorentz array SMap.t type t = { name : string; n : int; spins : spins; structure : UFO_Lorentz.t; fermion_lines : Coupling.fermion_lines } let permute_spins p = function | Unused -> Unused | Unique s -> Unique (P.array p s) | Ambiguous map -> Ambiguous (SMap.map (P.array p) map) (* Note that we apply the \emph{inverse} permutation to the indices in order to match the permutation of the particles/spins. *) - (* \begin{dubious} - FIXME: here we loose the information on the factor - for higher rank representations. - \end{dubious} *) - let permute_structure n p (l, f) = let permuted = P.array (P.inverse p) (Array.init n succ) in let permute_index i = if i > 0 then UFOx.Index.map_position (fun pos -> permuted.(pred pos)) i else i in (UFO_Lorentz.map_indices permute_index l, UFO_Lorentz.map_fermion_lines permute_index f) let permute p l = let structure, fermion_lines = permute_structure l.n p (l.structure, l.fermion_lines) in { name = l.name ^ "_p" ^ P.to_string (P.inverse p); n = l.n; spins = permute_spins p l.spins; structure; fermion_lines } let omega_lorentz_reps n alist = let reps = Array.make n Coupling.Scalar in List.iter (fun (i, rep) -> reps.(pred i) <- UFOx.Lorentz.omega rep) alist; reps let contained lorentz vertex = List.exists (fun lcc1 -> lcc1.Vertex.lorentz = lorentz.Lorentz_UFO.name) vertex.Vertex.lcc (* Find all vertices in with the Lorentz structure [lorentz] is used and build a map from those vertices to the O'Mega Lorentz representations inferred from UFO's Lorentz structure and the [particles] involved. Then scan the bindings and check that we have inferred the same Lorentz representation from all vertices. *) let lorentz_reps_of_structure particles vertices lorentz = let uses = SMap.fold (fun name v acc -> if contained lorentz v then SMap.add name (omega_lorentz_reps (Array.length v.Vertex.particles) (lorentz_reps_of_vertex particles v)) acc else acc) vertices SMap.empty in let variants = ThoList.uniq (List.sort compare (List.map snd (SMap.bindings uses))) in match variants with | [] -> Unused | [s] -> Unique s | _ -> Printf.eprintf "UFO.Lorentz.lorentz_reps_of_structure: AMBIGUOUS!\n"; List.iter (fun variant -> Printf.eprintf "UFO.Lorentz.lorentz_reps_of_structure: %s\n" (ThoList.to_string lorentz_to_string (Array.to_list variant))) variants; Ambiguous uses let of_lorentz_tensor spins lorentz = match spins with | Unique s -> begin try Some (UFO_Lorentz.parse (Array.to_list s) lorentz) with | Failure msg -> begin prerr_endline msg; Some (UFO_Lorentz.dummy) end end | Unused -> Printf.eprintf "UFO.Lorentz: stripping unused structure %s\n" (UFOx.Lorentz.to_string lorentz); None | Ambiguous _ -> invalid_arg "UFO.Lorentz.of_lorentz_tensor: Ambiguous" let of_lorentz_UFO particles vertices lorentz_UFO = SMap.fold (fun name l acc -> let spins = lorentz_reps_of_structure particles vertices l in match of_lorentz_tensor spins l.Lorentz_UFO.structure with | None -> acc | Some structure -> SMap.add name { name = l.Lorentz_UFO.name; n = List.length l.Lorentz_UFO.spins; spins; structure; fermion_lines = UFO_Lorentz.fermion_lines structure } acc) lorentz_UFO SMap.empty let to_string symbol l = Printf.sprintf "lorentz: %s => [name = '%s', spins = %s, \ structure = %s, fermion_lines = %s]" symbol l.name (match l.spins with | Unique s -> "[" ^ String.concat ", " (List.map lorentz_to_string (Array.to_list s)) ^ "]" | Ambiguous _ -> "AMBIGUOUS!" | Unused -> "UNUSED!") (UFO_Lorentz.to_string l.structure) (UFO_Lorentz.fermion_lines_to_string l.fermion_lines) end +(* According to arxiv:1308:1668, there should not be a factor + of~$i$ in the numerators of propagators, but the (unused) + \texttt{propagators.py} in most models violate this rule! *) +let divide_propagators_by_i = ref false + +module type Propagator = + sig + + type t = (* private *) + { name : string; + spins : Coupling.lorentz * Coupling.lorentz; + numerator : UFO_Lorentz.t; + denominator : UFO_Lorentz.t } + + val of_propagator_UFO : Propagator_UFO.t -> t + + val of_propagators_UFO : + Particle.t SMap.t -> Propagator_UFO.t SMap.t -> t SMap.t + + val transpose : t -> t + + val to_string : string -> t -> string + + end + +module Propagator : Propagator = + struct + + type t = (* private *) + { name : string; + spins : Coupling.lorentz * Coupling.lorentz; + numerator : UFO_Lorentz.t; + denominator : UFO_Lorentz.t } + + let lorentz_rep_at rep_classes i = + try + UFOx.Lorentz.omega (List.assoc i rep_classes) + with + | Not_found -> Coupling.Scalar + + let imaginary = Algebra.QC.make Algebra.Q.null Algebra.Q.unit + let scalars = [Coupling.Scalar; Coupling.Scalar] + + (* If~$51$ and~$52$ show up as indices, we must + map $(1,51)\to(1001,2001)$ and $(2,52)\to(1002,2002)$, + as per the UFO conventions for Lorentz structures. *) + + (* \begin{dubious} + This does not work yet, because [UFOx.Lorentz.map_indices] + affects also the position argument of [P], [Mass] and [Width]. + \end{dubious} *) + + let contains_51_52 tensor = + List.exists + (fun (i, _) -> i = 51 || i = 52) + (UFOx.Lorentz.classify_indices tensor) + + let remap_51_52 = function + | 1 -> 1001 | 51 -> 2001 + | 2 -> 1002 | 52 -> 2002 + | i -> i + + let canonicalize_51_52 tensor = + if contains_51_52 tensor then + UFOx.Lorentz.rename_indices remap_51_52 tensor + else + tensor + + (* In the current conventions, the factor of~$i$ is not included: *) + let of_propagator_UFO p = + let numerator = canonicalize_51_52 p.Propagator_UFO.numerator in + let lorentz_reps = UFOx.Lorentz.classify_indices numerator in + let spin1 = lorentz_rep_at lorentz_reps 1 + and spin2 = lorentz_rep_at lorentz_reps 2 in + let numerator_sans_i = + if !divide_propagators_by_i then + UFOx.Lorentz.map_coef (fun q -> Algebra.QC.div q imaginary) numerator + else + numerator in + { name = p.Propagator_UFO.name; + spins = (spin1, spin2); + numerator = UFO_Lorentz.parse [spin1; spin2] numerator_sans_i; + denominator = UFO_Lorentz.parse scalars p.Propagator_UFO.denominator } + + let of_propagators_UFO particles propagators_UFO = + SMap.fold + (fun name p acc -> SMap.add name (of_propagator_UFO p) acc) + propagators_UFO SMap.empty + + let permute12 = function + | 1 -> 2 + | 2 -> 1 + | n -> n + + let transpose_positions t = + UFOx.Index.map_position permute12 t + + let transpose p = + { name = p.name; + spins = (snd p.spins, fst p.spins); + numerator = UFO_Lorentz.map_indices transpose_positions p.numerator; + denominator = p.denominator } + + let to_string symbol p = + Printf.sprintf + "propagator: %s => [name = '%s', spin = '(%s, %s)', numerator/I = '%s', \ + denominator = '%s']" + symbol p.name + (Lorentz.lorentz_to_string (fst p.spins)) + (Lorentz.lorentz_to_string (snd p.spins)) + (UFO_Lorentz.to_string p.numerator) + (UFO_Lorentz.to_string p.denominator) + + end + type t = { particles : Particle.t SMap.t; particle_array : Particle.t array; (* for diagnostics *) couplings : UFO_Coupling.t SMap.t; coupling_orders : Coupling_Order.t SMap.t; vertices : Vertex.t SMap.t; lorentz_UFO : Lorentz_UFO.t SMap.t; lorentz : Lorentz.t SMap.t; parameters : Parameter.t SMap.t; + propagators_UFO : Propagator_UFO.t SMap.t; propagators : Propagator.t SMap.t; decays : Decay.t SMap.t; nc : int } let use_majorana_spinors = ref false let fallback_to_majorana_if_necessary particles vertices lorentz_UFO = let majoranas = SMap.fold (fun p particle acc -> if Particle.is_majorana particle then SSet.add p acc else acc) particles SSet.empty in let spinors, conj_spinors = collect_spinor_reps_of_vertices particles lorentz_UFO vertices in let ambiguous = SSet.diff (SSet.inter spinors conj_spinors) majoranas in let no_majoranas = SSet.is_empty majoranas and no_ambiguities = SSet.is_empty ambiguous in if no_majoranas && no_ambiguities && not !use_majorana_spinors then SMap.mapi (fun p particle -> if SSet.mem p spinors then Particle.force_spinor particle else if SSet.mem p conj_spinors then Particle.force_conjspinor particle else particle) particles else begin if !use_majorana_spinors then Printf.eprintf "O'Mega: Majorana fermions requested.\n"; if not no_majoranas then Printf.eprintf "O'Mega: found Majorana fermions!\n"; if not no_ambiguities then Printf.eprintf "O'Mega: found ambiguous spinor representations for %s!\n" (String.concat ", " (SSet.elements ambiguous)); Printf.eprintf "O'Mega: falling back to the Majorana representation for all fermions.\n"; SMap.map Particle.force_majorana particles end let nc_of_particles particles = let nc_set = List.fold_left (fun nc_set (_, p) -> match UFOx.Color.omega p.Particle.color with | Color.Singlet -> nc_set | Color.SUN nc -> Sets.Int.add (abs nc) nc_set | Color.AdjSUN nc -> Sets.Int.add (abs nc) nc_set) Sets.Int.empty (SMap.bindings particles) in match Sets.Int.elements nc_set with | [] -> 0 | [n] -> n | nc_list -> invalid_arg ("UFO.Model: more than one value of N_C: " ^ String.concat ", " (List.map string_of_int nc_list)) let of_file u = let particles = Particle.of_file u.Files.particles in let vertices = Vertex.of_file particles u.Files.vertices - and lorentz_UFO = Lorentz_UFO.of_file u.Files.lorentz in + and lorentz_UFO = Lorentz_UFO.of_file u.Files.lorentz + and propagators_UFO = Propagator_UFO.of_file u.Files.propagators in let particles = fallback_to_majorana_if_necessary particles vertices lorentz_UFO in let particle_array = Array.of_list (values particles) - and lorentz = Lorentz.of_lorentz_UFO particles vertices lorentz_UFO in + and lorentz = Lorentz.of_lorentz_UFO particles vertices lorentz_UFO + and propagators = Propagator.of_propagators_UFO particles propagators_UFO in let model = { particles; particle_array; couplings = UFO_Coupling.of_file u.Files.couplings; coupling_orders = Coupling_Order.of_file u.Files.coupling_orders; vertices; lorentz_UFO; lorentz; parameters = Parameter.of_file u.Files.parameters; - propagators = Propagator.of_file u.Files.propagators; + propagators_UFO; + propagators; decays = Decay.of_file u.Files.decays; nc = nc_of_particles particles } in SMap.iter (fun _ v -> check_color_reps_of_vertex model.particles v; check_lorentz_reps_of_vertex model.particles model.lorentz_UFO v) model.vertices; model let parse_directory dir = of_file (Files.parse_directory dir) let dump model = Printf.printf "NC = %d\n" model.nc; SMap.iter (print_endline @@@ Particle.to_string) model.particles; SMap.iter (print_endline @@@ UFO_Coupling.to_string) model.couplings; SMap.iter (print_endline @@@ Coupling_Order.to_string) model.coupling_orders; (* [SMap.iter (print_endline @@@ Vertex.to_string) model.vertices;] *) SMap.iter (fun symbol v -> (print_endline @@@ Vertex.to_string) symbol v; print_endline (Vertex.to_string_expanded model.lorentz_UFO model.couplings v)) model.vertices; SMap.iter (print_endline @@@ Lorentz_UFO.to_string) model.lorentz_UFO; SMap.iter (print_endline @@@ Lorentz.to_string) model.lorentz; SMap.iter (print_endline @@@ Parameter.to_string) model.parameters; + SMap.iter (print_endline @@@ Propagator_UFO.to_string) model.propagators_UFO; SMap.iter (print_endline @@@ Propagator.to_string) model.propagators; SMap.iter (print_endline @@@ Decay.to_string) model.decays; SMap.iter (fun symbol d -> List.iter (fun (_, w) -> ignore (UFOx.Expr.of_string w)) d.Decay.widths) model.decays exception Unhandled of string let unhandled s = raise (Unhandled s) module Model = struct (* NB: we could use [type flavor = Particle.t], but that would be very inefficient, because we will use [flavor] as a key for maps below. *) type flavor = int 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 external_flavors = M.external_flavors let lorentz = M.lorentz let color = M.color let nc = M.nc let propagator = M.propagator let width = M.width let goldstone = M.goldstone let conjugate = M.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 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 module Ch = M.Ch let charges = M.charges let rec fermion_of_lorentz = function | Coupling.Spinor -> 1 | Coupling.ConjSpinor -> -1 | Coupling.Majorana -> 2 | Coupling.Maj_Ghost -> 2 | 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 module Q = Algebra.Q module QC = Algebra.QC let dummy_tensor3 = Coupling.Scalar_Scalar_Scalar 1 let dummy_tensor4 = Coupling.Scalar4 1 let triplet p = (p.(0), p.(1), p.(2)) let quartet p = (p.(0), p.(1), p.(2), p.(3)) let half_times q1 q2 = Q.mul (Q.make 1 2) (Q.mul q1 q2) let name g = g.UFO_Coupling.name let fractional_coupling g r = let g = name g in match Q.to_ratio r with | 0, _ -> "0.0_default" | 1, 1 -> g | -1, 1 -> Printf.sprintf "(-%s)" g | n, 1 -> Printf.sprintf "(%d*%s)" n g | 1, d -> Printf.sprintf "(%s/%d)" g d | -1, d -> Printf.sprintf "(-%s/%d)" g d | n, d -> Printf.sprintf "(%d*%s/%d)" n g d let lorentz_of_symbol model symbol = try SMap.find symbol model.lorentz with | Not_found -> invalid_arg ("lorentz_of_symbol: " ^ symbol) let lorentz_UFO_of_symbol model symbol = try SMap.find symbol model.lorentz_UFO with | Not_found -> invalid_arg ("lorentz_UFO_of_symbol: " ^ symbol) let coupling_of_symbol model symbol = try SMap.find symbol model.couplings with | Not_found -> invalid_arg ("coupling_of_symbol: " ^ symbol) let spin_triplet model name = match (lorentz_of_symbol model name).Lorentz.spins with | Lorentz.Unique [|s0; s1; s2|] -> (s0, s1, s2) | Lorentz.Unique _ -> invalid_arg "spin_triplet: wrong number of spins" | Lorentz.Unused -> invalid_arg "spin_triplet: Unused" | Lorentz.Ambiguous _ -> invalid_arg "spin_triplet: Ambiguous" let spin_quartet model name = match (lorentz_of_symbol model name).Lorentz.spins with | Lorentz.Unique [|s0; s1; s2; s3|] -> (s0, s1, s2, s3) | Lorentz.Unique _ -> invalid_arg "spin_quartet: wrong number of spins" | Lorentz.Unused -> invalid_arg "spin_quartet: Unused" | Lorentz.Ambiguous _ -> invalid_arg "spin_quartet: Ambiguous" let spin_multiplet model name = match (lorentz_of_symbol model name).Lorentz.spins with | Lorentz.Unique sarray -> sarray | Lorentz.Unused -> invalid_arg "spin_multiplet: Unused" | Lorentz.Ambiguous _ -> invalid_arg "spin_multiplet: Ambiguous" (* If we have reason to belive that a $\delta_{ab}$-vertex is an effective $\tr(T_aT_b)$-vertex generated at loop level, like~$gg\to H\ldots$ in the SM, we should interpret it as such and use the expression~(6.2) from~\cite{Kilian:2012pz}. *) (* AFAIK, there is no way to distinguish these cases directly in a UFO file. Instead we rely in a heuristic, in which each massless color octet vector particle or ghost is a gluon and colorless scalars are potential Higgses. *) let is_massless p = match ThoString.uppercase p.Particle.mass with | "ZERO" -> true | _ -> false let is_gluon model f = let p = model.particle_array.(f) in match UFOx.Color.omega p.Particle.color, UFOx.Lorentz.omega p.Particle.spin with | Color.AdjSUN _, Coupling.Vector -> is_massless p | Color.AdjSUN _, Coupling.Scalar -> if p.Particle.ghost_number <> 0 then is_massless p else false | _ -> false let is_color_singlet model f = let p = model.particle_array.(f) in match UFOx.Color.omega p.Particle.color with | Color.Singlet -> true | _ -> false let is_higgs_gluon_vertex model p adjoints = if Array.length p > List.length adjoints then List.for_all (fun (i, p) -> if List.mem i adjoints then is_gluon model p else is_color_singlet model p) (ThoList.enumerate 1 (Array.to_list p)) else false let delta8_heuristics model p a b = if is_higgs_gluon_vertex model p [a; b] then Color.Vertex.delta8_loop a b else Color.Vertex.delta8 a b let verbatim_higgs_glue = ref false let translate_color_atom model p = function | UFOx.Color_Atom.Identity (i, j) -> Color.Vertex.delta3 i j | UFOx.Color_Atom.Identity8 (a, b) -> if !verbatim_higgs_glue then Color.Vertex.delta8 a b else delta8_heuristics model p a b | UFOx.Color_Atom.T (a, i, j) -> Color.Vertex.t a i j | UFOx.Color_Atom.F (a, b, c) -> Color.Vertex.f a b c | UFOx.Color_Atom.D (a, b, c) -> Color.Vertex.d a b c | UFOx.Color_Atom.Epsilon (i, j, k) -> Color.Vertex.epsilon i j k | UFOx.Color_Atom.EpsilonBar (i, j, k) -> Color.Vertex.epsilonbar i j k | UFOx.Color_Atom.T6 (a, i, j) -> Color.Vertex.t6 a i j | UFOx.Color_Atom.K6 (i, j, k) -> Color.Vertex.k6 i j k | UFOx.Color_Atom.K6Bar (i, j, k) -> Color.Vertex.k6bar i j k let translate_color_term model p = function | [], q -> Color.Vertex.scale q Color.Vertex.unit | [atom], q -> Color.Vertex.scale q (translate_color_atom model p atom) | atoms, q -> let atoms = List.map (translate_color_atom model p) atoms in Color.Vertex.scale q (Color.Vertex.multiply atoms) let translate_color model p terms = match terms with | [] -> invalid_arg "translate_color: empty" | [ term ] -> translate_color_term model p term | terms -> Color.Vertex.sum (List.map (translate_color_term model p) terms) let translate_coupling_1 model p lcc = let l = lcc.Vertex.lorentz in let s = Array.to_list (spin_multiplet model l) and fl = (SMap.find l model.lorentz).Lorentz.fermion_lines and c = name (coupling_of_symbol model lcc.Vertex.coupling) and col = translate_color model p lcc.Vertex.color in (Array.to_list p, Coupling.UFO (QC.unit, l, s, fl, col), c) let translate_coupling model p lcc = List.map (translate_coupling_1 model p) lcc let long_flavors = ref false module type Lookup = sig type f = private { flavors : flavor list; flavor_of_string : string -> flavor; flavor_of_symbol : string -> flavor; particle : flavor -> Particle.t; flavor_symbol : flavor -> string; conjugate : flavor -> flavor } type flavor_format = | Long | Decimal | Hexadecimal val flavor_format : flavor_format ref val of_model : t -> f end module Lookup : Lookup = struct type f = { flavors : flavor list; flavor_of_string : string -> flavor; flavor_of_symbol : string -> flavor; particle : flavor -> Particle.t; flavor_symbol : flavor -> string; conjugate : flavor -> flavor } type flavor_format = | Long | Decimal | Hexadecimal let flavor_format = ref Hexadecimal let conjugate_of_particle_array particles = Array.init (Array.length particles) (fun i -> let f' = Particle.conjugate particles.(i) in match ThoArray.match_all f' particles with | [i'] -> i' | [] -> invalid_arg ("no charge conjugate: " ^ f'.Particle.name) | _ -> invalid_arg ("multiple charge conjugates: " ^ f'.Particle.name)) let invert_flavor_array a = let table = SHash.create 37 in Array.iteri (fun i s -> SHash.add table s i) a; (fun name -> try SHash.find table name with | Not_found -> invalid_arg ("not found: " ^ name)) let digits base n = let rec digits' acc n = if n < 1 then acc else digits' (succ acc) (n / base) in if n < 0 then digits' 1 (-n) else if n = 0 then 1 else digits' 0 n let of_model model = let particle_array = Array.of_list (values model.particles) in let conjugate_array = conjugate_of_particle_array particle_array and name_array = Array.map (fun f -> f.Particle.name) particle_array and symbol_array = Array.of_list (keys model.particles) in let flavor_symbol f = begin match !flavor_format with | Long -> symbol_array.(f) | Decimal -> let w = digits 10 (Array.length particle_array - 1) in Printf.sprintf "%0*d" w f | Hexadecimal -> let w = digits 16 (Array.length particle_array - 1) in Printf.sprintf "%0*X" w f end in { flavors = ThoList.range 0 (Array.length particle_array - 1); flavor_of_string = invert_flavor_array name_array; flavor_of_symbol = invert_flavor_array symbol_array; particle = Array.get particle_array; flavor_symbol = flavor_symbol; conjugate = Array.get conjugate_array } end (* \begin{dubious} We appear to need to conjugate all flavors. Why??? \end{dubious} *) let translate_vertices model tables = let vn = List.fold_left (fun acc v -> let p = Array.map tables.Lookup.flavor_of_symbol v.Vertex.particles and lcc = v.Vertex.lcc in let p = Array.map conjugate p in (* FIXME: why? *) translate_coupling model p lcc @ acc) [] (values model.vertices) in ([], [], vn) 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 "UFO.Model.propagator_of_lorentz: SUSY ghosts do not propagate" | Coupling.Vector -> Coupling.Prop_Feynman | Coupling.Massive_Vector -> Coupling.Prop_Unitarity | Coupling.Tensor_2 -> Coupling.Prop_Tensor_2 | Coupling.Vectorspinor -> invalid_arg "UFO.Model.propagator_of_lorentz: Vectorspinor" | Coupling.Tensor_1 -> invalid_arg "UFO.Model.propagator_of_lorentz: Tensor_1" | Coupling.BRS _ -> invalid_arg "UFO.Model.propagator_of_lorentz: no BRST" let filter_unphysical model = let physical_particles = Particle.filter Particle.is_physical model.particles in let physical_particle_array = Array.of_list (values physical_particles) in let physical_vertices = Vertex.filter (not @@ (Vertex.contains model.particles (not @@ Particle.is_physical))) model.vertices in { model with particles = physical_particles; particle_array = physical_particle_array; vertices = physical_vertices } let whizard_constants = SSet.of_list [ "ZERO" ] let filter_constants parameters = List.filter (fun p -> not (SSet.mem (ThoString.uppercase p.Parameter.name) whizard_constants)) parameters let add_name set parameter = CSet.add parameter.Parameter.name set let hardcoded_parameters = CSet.of_list ["cmath.pi"] let missing_parameters input derived couplings = let input_parameters = List.fold_left add_name hardcoded_parameters input in let all_parameters = List.fold_left add_name input_parameters derived in let derived_dependencies = dependencies (List.map (fun p -> (p.Parameter.name, p.Parameter.value)) derived) in let coupling_dependencies = dependencies (List.map (fun p -> (p.UFO_Coupling.name, Expr p.UFO_Coupling.value)) (values couplings)) in let missing_input = CMap.filter (fun parameter derived_parameters -> not (CSet.mem parameter all_parameters)) derived_dependencies and missing = CMap.filter (fun parameter couplings -> not (CSet.mem parameter all_parameters)) coupling_dependencies in CMap.iter (fun parameter derived_parameters -> Printf.eprintf "UFO warning: undefined input parameter %s appears in derived \ parameters {%s}: will be added to the list of input parameters!\n" parameter (String.concat "; " (CSet.elements derived_parameters))) missing_input; CMap.iter (fun parameter couplings -> Printf.eprintf "UFO warning: undefined parameter %s appears in couplings {%s}: \ will be added to the list of input parameters!\n" parameter (String.concat "; " (CSet.elements couplings))) missing; keys_caseless missing_input @ keys_caseless missing let classify_parameters model = let compare_parameters p1 p2 = compare p1.Parameter.sequence p2.Parameter.sequence in let input, derived = List.fold_left (fun (input, derived) p -> match p.Parameter.nature with | Parameter.Internal -> (input, p :: derived) | Parameter.External -> begin match p.Parameter.ptype with | Parameter.Real -> () | Parameter.Complex -> Printf.eprintf "UFO warning: invalid complex declaration of input \ parameter `%s' ignored!\n" p.Parameter.name end; (p :: input, derived)) ([], []) (filter_constants (values model.parameters)) in let additional = missing_parameters input derived model.couplings in (List.sort compare_parameters input @ List.map Parameter.missing additional, List.sort compare_parameters derived) (*i List.iter (fun line -> Printf.eprintf "par: %s\n" line) (dependencies_to_strings derived_dependencies); List.iter (fun line -> Printf.eprintf "coupling: %s\n" line) (dependencies_to_strings coupling_dependencies); i*) let translate_name map name = try SMap.find name map with Not_found -> name let translate_input map p = (translate_name map p.Parameter.name, value_to_float p.Parameter.value) let alpha_s_half e = UFOx.Expr.substitute "aS" (UFOx.Expr.half "aS") e let alpha_s_half_etc map e = UFOx.Expr.rename (map_to_alist map) (alpha_s_half e) let translate_derived map p = let make_atom s = s in let c = make_atom (translate_name map p.Parameter.name) and v = value_to_coupling (alpha_s_half_etc map) make_atom p.Parameter.value in match p.Parameter.ptype with | Parameter.Real -> (Coupling.Real c, v) | Parameter.Complex -> (Coupling.Complex c, v) let translate_coupling_constant map c = let make_atom s = s in (Coupling.Complex c.UFO_Coupling.name, Coupling.Quot (value_to_coupling (alpha_s_half_etc map) make_atom (Expr c.UFO_Coupling.value), Coupling.I)) module Lowercase_Parameters = struct type elt = string type base = string let compare_elt = compare let compare_base = compare let pi = ThoString.lowercase end module Lowercase_Bundle = Bundle.Make (Lowercase_Parameters) let coupling_names model = SMap.fold (fun _ c acc -> c.UFO_Coupling.name :: acc) model.couplings [] let parameter_names model = SMap.fold (fun _ c acc -> c.Parameter.name :: acc) model.parameters [] let ambiguous_parameters model = let all_names = List.rev_append (coupling_names model) (parameter_names model) in let lc_bundle = Lowercase_Bundle.of_list all_names in let lc_set = List.fold_left (fun acc s -> SSet.add s acc) SSet.empty (Lowercase_Bundle.base lc_bundle) and ambiguities = List.filter (fun (_, names) -> List.length names > 1) (Lowercase_Bundle.fibers lc_bundle) in (lc_set, ambiguities) let disambiguate1 lc_set name = let rec disambiguate1' i = let name' = Printf.sprintf "%s_%d" name i in let lc_name' = ThoString.lowercase name' in if SSet.mem lc_name' lc_set then disambiguate1' (succ i) else (SSet.add lc_name' lc_set, name') in disambiguate1' 1 let disambiguate lc_set names = let _, replacements = List.fold_left (fun (lc_set', acc) name -> let lc_set'', name' = disambiguate1 lc_set' name in (lc_set'', SMap.add name name' acc)) (lc_set, SMap.empty) names in replacements let omegalib_names = ["u"; "ubar"; "v"; "vbar"; "eps"] let translate_parameters model = let lc_set, ambiguities = ambiguous_parameters model in let replacements = disambiguate lc_set (ThoList.flatmap snd ambiguities) in SMap.iter (Printf.eprintf "warning: case sensitive parameter names: renaming '%s' -> '%s'\n") replacements; let replacements = List.fold_left (fun acc name -> SMap.add name ("UFO_" ^ name) acc) replacements omegalib_names in let input_parameters, derived_parameters = classify_parameters model and couplings = values model.couplings in { Coupling.input = List.map (translate_input replacements) input_parameters; Coupling.derived = List.map (translate_derived replacements) derived_parameters @ List.map (translate_coupling_constant replacements) couplings; Coupling.derived_arrays = [] } (* UFO requires us to look up the mass parameter to distinguish between massless and massive vectors. TODO: this is a candidate for another lookup table. *) let lorentz_of_particle p = match UFOx.Lorentz.omega p.Particle.spin with | Coupling.Vector -> begin match ThoString.uppercase p.Particle.mass with | "ZERO" -> Coupling.Vector | _ -> Coupling.Massive_Vector end | s -> s type state = { directory : string; model : t } let initialized = ref None let is_initialized_from dir = match !initialized with | None -> false | Some state -> dir = state.directory let dump_raw = ref false let init dir = let model = filter_unphysical (parse_directory dir) in if !dump_raw then dump model; let tables = Lookup.of_model model in let vertices () = translate_vertices model tables in let particle f = tables.Lookup.particle f in let lorentz f = lorentz_of_particle (particle f) in + let propagator f = + let p = particle f in + match p.Particle.propagator with + | None -> propagator_of_lorentz (lorentz_of_particle p) + | Some s -> Coupling.Prop_UFO s in let gauge_symbol () = "?GAUGE?" in let constant_symbol s = s in let parameters = translate_parameters model in M.setup ~color:(fun f -> UFOx.Color.omega (particle f).Particle.color) ~nc:(fun () -> model.nc) ~pdg:(fun f -> (particle f).Particle.pdg_code) ~lorentz - ~propagator:(fun f -> propagator_of_lorentz (lorentz f)) + ~propagator ~width:(fun f -> Coupling.Constant) ~goldstone:(fun f -> None) ~conjugate:tables.Lookup.conjugate ~fermion:(fun f -> fermion_of_lorentz (lorentz f)) ~vertices ~flavors:[("All Flavors", tables.Lookup.flavors)] ~parameters:(fun () -> parameters) ~flavor_of_string:tables.Lookup.flavor_of_string ~flavor_to_string:(fun f -> (particle f).Particle.name) ~flavor_to_TeX:(fun f -> (particle f).Particle.texname) ~flavor_symbol:tables.Lookup.flavor_symbol ~gauge_symbol ~mass_symbol:(fun f -> (particle f).Particle.mass) ~width_symbol:(fun f -> (particle f).Particle.width) ~constant_symbol; initialized := Some { directory = dir; model = model } let ufo_directory = ref Config.default_UFO_dir let load () = if is_initialized_from !ufo_directory then () else init !ufo_directory let include_all_fusions = ref false let fusions_of_model ?only model = let include_fusion = match !include_all_fusions, only with | true, _ | false, None -> (fun name -> true) | false, Some names -> (fun name -> SSet.mem name names) in SMap.fold (fun name l acc -> if include_fusion name then List.fold_left (fun acc p -> let l' = Lorentz.permute p l in match l'.Lorentz.spins with | Lorentz.Unused -> acc | Lorentz.Unique spins -> (l'.Lorentz.name, spins, l'.Lorentz.structure) :: acc | Lorentz.Ambiguous _ -> failwith "fusions: Lorentz.Ambiguous") [] (Permutation.Default.cyclic l.Lorentz.n) @ acc else acc) model.lorentz [] let fusions ?only () = match !initialized with | None -> [] | Some { model = model } -> fusions_of_model ?only model + let propagators_of_model ?only model = + let include_propagator = + match !include_all_fusions, only with + | true, _ + | false, None -> (fun name -> true) + | false, Some names -> (fun name -> SSet.mem name names) + in + SMap.fold + (fun name p acc -> + if include_propagator name then + (name, p) :: acc + else + acc) + model.propagators [] + + let propagators ?only () = + match !initialized with + | None -> [] + | Some { model = model } -> propagators_of_model ?only model + let include_hadrons = ref true module Whizard : sig val write : unit -> unit end = struct let write_header dir = Printf.printf "# WHIZARD Model file derived from UFO directory\n"; Printf.printf "# '%s'\n\n" dir; Printf.printf "model \"%s\"\n\n" (Filename.basename dir) let write_input_parameters parameters = let open Parameter in Printf.printf "# Independent (input) Parameters\n"; List.iter (fun p -> Printf.printf "parameter %s = %s\n" p.name (value_to_numeric p.value)) parameters; Printf.printf "\n" let write_derived_parameters parameters = let open Parameter in Printf.printf "# Dependent (derived) Parameters\n"; List.iter (fun p -> Printf.printf "derived %s = %s\n" p.name (value_to_expr alpha_s_half p.value)) parameters let write_particles particles = let open Particle in Printf.printf "# Particles\n"; Printf.printf "# NB: hypercharge assignments appear to be unreliable\n"; Printf.printf "# therefore we can't infer the isospin\n"; Printf.printf "# NB: parton-, gauge- & handedness are unavailable\n"; List.iter (fun p -> if not p.is_anti then begin Printf.printf "particle \"%s\" %d ### parton? gauge? left?\n" p.name p.pdg_code; Printf.printf " spin %s charge %s color %s ### isospin?\n" (UFOx.Lorentz.rep_to_string_whizard p.spin) (charge_to_string p.charge) (UFOx.Color.rep_to_string_whizard p.color); Printf.printf " name \"%s\"\n" p.name; if p.antiname <> p.name then Printf.printf " anti \"%s\"\n" p.antiname; Printf.printf " tex_name \"%s\"\n" p.texname; if p.antiname <> p.name then Printf.printf " tex_anti \"%s\"\n" p.antitexname; Printf.printf " mass %s width %s\n\n" p.mass p.width end) (values particles); Printf.printf "\n" let write_hadrons () = Printf.printf "# Hadrons (protons and beam remnants)\n"; Printf.printf "# NB: these are NOT part of the UFO model\n"; Printf.printf "# but added for WHIZARD's convenience!\n"; Printf.printf "particle PROTON 2212\n"; Printf.printf " spin 1/2 charge 1\n"; Printf.printf " name p \"p+\"\n"; Printf.printf " anti pbar \"p-\"\n"; Printf.printf "particle HADRON_REMNANT 90\n"; Printf.printf " name hr\n"; Printf.printf " tex_name \"had_r\"\n"; Printf.printf "particle HADRON_REMNANT_SINGLET 91\n"; Printf.printf " name hr1\n"; Printf.printf " tex_name \"had_r^{(1)}\"\n"; Printf.printf "particle HADRON_REMNANT_TRIPLET 92\n"; Printf.printf " color 3\n"; Printf.printf " name hr3\n"; Printf.printf " tex_name \"had_r^{(3)}\"\n"; Printf.printf " anti hr3bar\n"; Printf.printf " tex_anti \"had_r^{(\\bar 3)}\"\n"; Printf.printf "particle HADRON_REMNANT_OCTET 93\n"; Printf.printf " color 8\n"; Printf.printf " name hr8\n"; Printf.printf " tex_name \"had_r^{(8)}\"\n"; Printf.printf "\n" let write_vertices model vertices = Printf.printf "# Vertices (for phasespace generation only)\n"; Printf.printf "# NB: particles should be sorted increasing in mass.\n"; Printf.printf "# This is NOT implemented yet!\n"; List.iter (fun v -> let particles = String.concat " " (List.map (fun s -> "\"" ^ (SMap.find s model.particles).Particle.name ^ "\"") (Array.to_list v.Vertex.particles)) in Printf.printf "vertex %s\n" particles) (values vertices); Printf.printf "\n" let write () = match !initialized with | None -> failwith "UFO.Whizard.write: UFO model not initialized" | Some { directory = dir; model = model } -> let input_parameters, derived_parameters = classify_parameters model in write_header dir; write_input_parameters input_parameters; write_derived_parameters derived_parameters; write_particles model.particles; if !include_hadrons then write_hadrons (); write_vertices model model.vertices; exit 0 end let options = Options.create [ ("UFO_dir", Arg.String (fun name -> ufo_directory := name), "UFO model directory (default: " ^ !ufo_directory ^ ")"); ("Majorana", Arg.Set use_majorana_spinors, "use Majorana spinors (must come _before_ exec!)"); + ("divide_propagators_by_i", Arg.Set divide_propagators_by_i, + "divide propagators by I (pre 2013 FeynRules convention)"); ("verbatim_Hg", Arg.Set verbatim_higgs_glue, "don't correct the color flows for effective Higgs Gluon couplings"); ("write_WHIZARD", Arg.Unit Whizard.write, "write the WHIZARD model file (required once per model)"); ("long_flavors", Arg.Unit (fun () -> Lookup.flavor_format := Lookup.Long), "write use the UFO flavor names instead of integers"); ("dump", Arg.Set dump_raw, "dump UFO model for debugging the parser (must come _before_ exec!)"); ("all_fusions", Arg.Set include_all_fusions, "include all fusions in the fortran module"); ("no_hadrons", Arg.Clear include_hadrons, "don't add any particle not in the UFO file"); ("add_hadrons", Arg.Set include_hadrons, "add protons and beam remants for WHIZARD"); ("exec", Arg.Unit load, "load the UFO model files (required _before_ using particles names)"); ("help", Arg.Unit (fun () -> prerr_endline "..."), "print information on the model")] end module type Fortran_Target = sig val fuse : Algebra.QC.t -> string -> Coupling.lorentzn -> string -> string list -> string list -> Coupling.fusen -> unit - val lorentz : - ?only:SSet.t -> Format_Fortran.formatter -> unit -> unit - val lorentz_module : ?only:SSet.t -> ?name:string -> ?fortran_module:string -> Format_Fortran.formatter -> unit -> unit end module Targets = struct module Fortran : Fortran_Target = struct open Format_Fortran let fuse = UFO_targets.Fortran.fuse let lorentz_functions ff fusions () = List.iter (fun (name, s, l) -> UFO_targets.Fortran.lorentz ff name s l) fusions - let lorentz ?only ff () = - lorentz_functions ff (Model.fusions ?only ()) () + let propagator_functions ff propagators () = + List.iter + (fun (name, p) -> + UFO_targets.Fortran.propagator + ff name p.Propagator.spins + p.Propagator.numerator p.Propagator.denominator) + propagators let lorentz_module ?only ?(name="omega_amplitude_ufo") ?(fortran_module="omega95") ff () = let printf fmt = fprintf ff fmt and nl = pp_newline ff in printf "module %s" name; nl (); printf " use kinds"; nl (); printf " use %s" fortran_module; nl (); printf " implicit none"; nl (); printf " private"; nl (); - let fusions = Model.fusions ?only () in + let fusions = Model.fusions ?only () + and propagators = Model.propagators () in List.iter (fun (name, _, _) -> printf " public :: %s" name; nl ()) fusions; + List.iter + (fun (name, _) -> printf " public :: pr_U_%s" name; nl ()) + propagators; UFO_targets.Fortran.eps4_g4_g44_decl ff (); UFO_targets.Fortran.eps4_g4_g44_init ff (); printf "contains"; nl (); lorentz_functions ff fusions (); + propagator_functions ff propagators (); printf "end module %s" name; nl (); pp_flush ff () end end module type Test = sig val suite : OUnit.test end module Test : Test = struct open OUnit let lexer s = UFO_lexer.token (UFO_lexer.init_position "" (Lexing.from_string s)) let suite_lexer_escapes = "escapes" >::: [ "single-quote" >:: (fun () -> assert_equal (UFO_parser.STRING "a'b'c") (lexer "'a\\'b\\'c'")); "unterminated" >:: (fun () -> assert_raises End_of_file (fun () -> lexer "'a\\'b\\'c")) ] let suite_lexer = "lexer" >::: [suite_lexer_escapes] let suite = "UFO" >::: [suite_lexer] end Index: trunk/omega/src/targets.ml =================================================================== --- trunk/omega/src/targets.ml (revision 8359) +++ trunk/omega/src/targets.ml (revision 8360) @@ -1,8285 +1,8293 @@ (* targets.ml -- Copyright (C) 1999-2019 by Wolfgang Kilian Thorsten Ohl Juergen Reuter with contributions from Christian Speckner Fabian Bach (only parts of this file) Marco Sekulla (only parts of this file) Bijan Chokoufe Nejad (only parts of this file) So Young Shim WHIZARD is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2, or (at your option) any later version. WHIZARD is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the 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 (F : Fusion.Maker) (P : Momentum.T) (M : Model.T) = struct type amplitudes = Fusion.Multi(F)(P)(M).amplitudes type diagnostic = All | Arguments | Momenta | Gauge let options = Options.empty let amplitudes_to_channel _ _ _ = failwith "Targets.Dummy" let parameters_to_channel _ = failwith "Targets.Dummy" end (* \thocwmodulesection{O'Mega Virtual Machine with \texttt{Fortran\;90/95}} *) (* \thocwmodulesubsection{Preliminaries} *) module VM (Fusion_Maker : Fusion.Maker) (P : Momentum.T) (M : Model.T) = struct open Coupling open Format module CM = Colorize.It(M) module F = Fusion_Maker(P)(M) module CF = Fusion.Multi(Fusion_Maker)(P)(M) module CFlow = Color.Flow type amplitudes = CF.amplitudes (* Options. *) type diagnostic = All | Arguments | Momenta | Gauge let wrapper_module = ref "ovm_wrapper" let parameter_module_external = ref "some_external_module_with_model_info" let bytecode_file = ref "bytecode.hbc" let md5sum = ref None let openmp = ref false let kind = ref "default" let whizard = ref false let options = Options.create [ "wrapper_module", Arg.String (fun s -> wrapper_module := s), "name of wrapper module"; "bytecode_file", Arg.String (fun s -> bytecode_file := s), "bytecode file to be used in wrapper"; "parameter_module_external", Arg.String (fun s -> parameter_module_external := s), "external parameter module to be used in wrapper"; "md5sum", Arg.String (fun s -> md5sum := Some s), "transfer MD5 checksum in wrapper"; "whizard", Arg.Set whizard, "include WHIZARD interface in wrapper"; "openmp", Arg.Set openmp, "activate parallel computation of amplitude with OpenMP"] (* Integers encode the opcodes (operation codes). *) let ovm_ADD_MOMENTA = 1 let ovm_CALC_BRAKET = 2 let ovm_LOAD_SCALAR = 10 let ovm_LOAD_SPINOR_INC = 11 let ovm_LOAD_SPINOR_OUT = 12 let ovm_LOAD_CONJSPINOR_INC = 13 let ovm_LOAD_CONJSPINOR_OUT = 14 let ovm_LOAD_MAJORANA_INC = 15 let ovm_LOAD_MAJORANA_OUT = 16 let ovm_LOAD_VECTOR_INC = 17 let ovm_LOAD_VECTOR_OUT = 18 let ovm_LOAD_VECTORSPINOR_INC = 19 let ovm_LOAD_VECTORSPINOR_OUT = 20 let ovm_LOAD_TENSOR2_INC = 21 let ovm_LOAD_TENSOR2_OUT = 22 let ovm_LOAD_BRS_SCALAR = 30 let ovm_LOAD_BRS_SPINOR_INC = 31 let ovm_LOAD_BRS_SPINOR_OUT = 32 let ovm_LOAD_BRS_CONJSPINOR_INC = 33 let ovm_LOAD_BRS_CONJSPINOR_OUT = 34 let ovm_LOAD_BRS_VECTOR_INC = 37 let ovm_LOAD_BRS_VECTOR_OUT = 38 let ovm_LOAD_MAJORANA_GHOST_INC = 23 let ovm_LOAD_MAJORANA_GHOST_OUT = 24 let ovm_LOAD_BRS_MAJORANA_INC = 35 let ovm_LOAD_BRS_MAJORANA_OUT = 36 let ovm_PROPAGATE_SCALAR = 51 let ovm_PROPAGATE_COL_SCALAR = 52 let ovm_PROPAGATE_GHOST = 53 let ovm_PROPAGATE_SPINOR = 54 let ovm_PROPAGATE_CONJSPINOR = 55 let ovm_PROPAGATE_MAJORANA = 56 let ovm_PROPAGATE_COL_MAJORANA = 57 let ovm_PROPAGATE_UNITARITY = 58 let ovm_PROPAGATE_COL_UNITARITY = 59 let ovm_PROPAGATE_FEYNMAN = 60 let ovm_PROPAGATE_COL_FEYNMAN = 61 let ovm_PROPAGATE_VECTORSPINOR = 62 let ovm_PROPAGATE_TENSOR2 = 63 (* \begin{dubious} [ovm_PROPAGATE_NONE] has to be split up to different types to work in conjunction with color MC \dots \end{dubious} *) let ovm_PROPAGATE_NONE = 64 let ovm_FUSE_V_FF = -1 let ovm_FUSE_F_VF = -2 let ovm_FUSE_F_FV = -3 let ovm_FUSE_VA_FF = -4 let ovm_FUSE_F_VAF = -5 let ovm_FUSE_F_FVA = -6 let ovm_FUSE_VA2_FF = -7 let ovm_FUSE_F_VA2F = -8 let ovm_FUSE_F_FVA2 = -9 let ovm_FUSE_A_FF = -10 let ovm_FUSE_F_AF = -11 let ovm_FUSE_F_FA = -12 let ovm_FUSE_VL_FF = -13 let ovm_FUSE_F_VLF = -14 let ovm_FUSE_F_FVL = -15 let ovm_FUSE_VR_FF = -16 let ovm_FUSE_F_VRF = -17 let ovm_FUSE_F_FVR = -18 let ovm_FUSE_VLR_FF = -19 let ovm_FUSE_F_VLRF = -20 let ovm_FUSE_F_FVLR = -21 let ovm_FUSE_SP_FF = -22 let ovm_FUSE_F_SPF = -23 let ovm_FUSE_F_FSP = -24 let ovm_FUSE_S_FF = -25 let ovm_FUSE_F_SF = -26 let ovm_FUSE_F_FS = -27 let ovm_FUSE_P_FF = -28 let ovm_FUSE_F_PF = -29 let ovm_FUSE_F_FP = -30 let ovm_FUSE_SL_FF = -31 let ovm_FUSE_F_SLF = -32 let ovm_FUSE_F_FSL = -33 let ovm_FUSE_SR_FF = -34 let ovm_FUSE_F_SRF = -35 let ovm_FUSE_F_FSR = -36 let ovm_FUSE_SLR_FF = -37 let ovm_FUSE_F_SLRF = -38 let ovm_FUSE_F_FSLR = -39 let ovm_FUSE_G_GG = -40 let ovm_FUSE_V_SS = -41 let ovm_FUSE_S_VV = -42 let ovm_FUSE_S_VS = -43 let ovm_FUSE_V_SV = -44 let ovm_FUSE_S_SS = -45 let ovm_FUSE_S_SVV = -46 let ovm_FUSE_V_SSV = -47 let ovm_FUSE_S_SSS = -48 let ovm_FUSE_V_VVV = -49 let ovm_FUSE_S_G2 = -50 let ovm_FUSE_G_SG = -51 let ovm_FUSE_G_GS = -52 let ovm_FUSE_S_G2_SKEW = -53 let ovm_FUSE_G_SG_SKEW = -54 let ovm_FUSE_G_GS_SKEW = -55 let inst_length = 8 (* Some helper functions. *) let printi ~lhs:l ~rhs1:r1 ?coupl:(cp = 0) ?coeff:(co = 0) ?rhs2:(r2 = 0) ?rhs3:(r3 = 0) ?rhs4:(r4 = 0) code = printf "@\n%d %d %d %d %d %d %d %d" code cp co l r1 r2 r3 r4 let nl () = printf "@\n" let print_int_lst lst = nl (); lst |> List.iter (printf "%d ") let print_str_lst lst = nl (); lst |> List.iter (printf "%s ") let break () = printi ~lhs:0 ~rhs1:0 0 (* Copied from below. Needed for header. *) (* \begin{dubious} Could be fused with [lorentz_ordering]. \end{dubious} *) 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} | 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.classify_wfs': 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{Sets and maps} *) (* The OVM identifies all objects via integers. Therefore, we need maps which assign the abstract object a unique ID. *) (* I want [int list]s with less elements to come first. Used in conjunction with the int list representation of momenta, this will set the outer particles at first position and allows the OVM to set them without further instructions. *) (* \begin{dubious} Using the Momentum module might give better performance than integer lists? \end{dubious} *) let rec int_lst_compare (e1 : int list) (e2 : int list) = match e1,e2 with | [], [] -> 0 | _, [] -> +1 | [], _ -> -1 | [_;_], [_] -> +1 | [_], [_;_] -> -1 | hd1 :: tl1, hd2 :: tl2 -> let c = compare hd1 hd2 in if (c != 0 && List.length tl1 = List.length tl2) then c else int_lst_compare tl1 tl2 (* We need a canonical ordering for the different types of wfs. Copied, and slightly modified to order [wf]s, from \texttt{fusion.ml}. *) let lorentz_ordering wf = match CM.lorentz (F.flavor wf) with | Scalar -> 0 | Spinor -> 1 | ConjSpinor -> 2 | Majorana -> 3 | Vector -> 4 | Massive_Vector -> 5 | Tensor_2 -> 6 | Tensor_1 -> 7 | Vectorspinor -> 8 | BRS Scalar -> 9 | BRS Spinor -> 10 | BRS ConjSpinor -> 11 | BRS Majorana -> 12 | BRS Vector -> 13 | BRS Massive_Vector -> 14 | BRS Tensor_2 -> 15 | BRS Tensor_1 -> 16 | BRS Vectorspinor -> 17 | Maj_Ghost -> invalid_arg "lorentz_ordering: not implemented" | BRS _ -> invalid_arg "lorentz_ordering: not needed" let wf_compare (wf1, mult1) (wf2, mult2) = let c1 = compare (lorentz_ordering wf1) (lorentz_ordering wf2) in if c1 <> 0 then c1 else let c2 = compare wf1 wf2 in if c2 <> 0 then c2 else compare mult1 mult2 let amp_compare amp1 amp2 = let cflow a = CM.flow (F.incoming a) (F.outgoing a) in let c1 = compare (cflow amp1) (cflow amp2) in if c1 <> 0 then c1 else let process_sans_color a = (List.map CM.flavor_sans_color (F.incoming a), List.map CM.flavor_sans_color (F.outgoing a)) in compare (process_sans_color amp1) (process_sans_color amp2) let level_compare (f1, amp1) (f2, amp2) = let p1 = F.momentum_list (F.lhs f1) and p2 = F.momentum_list (F.lhs f2) in let c1 = int_lst_compare p1 p2 in if c1 <> 0 then c1 else let c2 = compare f1 f2 in if c2 <> 0 then c2 else amp_compare amp1 amp2 module ISet = Set.Make (struct type t = int list let compare = int_lst_compare end) module WFSet = Set.Make (struct type t = CF.wf * int let compare = wf_compare end) module CSet = Set.Make (struct type t = CM.constant let compare = compare end) module FSet = Set.Make (struct type t = F.fusion * F.amplitude let compare = level_compare end) (* \begin{dubious} It might be preferable to use a [PMap] which maps mom to int, instead of this way. More standard functions like [mem] could be used. Also, [get_ID] would be faster, $\mathcal{O}(\log N)$ instead of $\mathcal{O}(N)$, and simpler. For 8 gluons: N=127 momenta. Minor performance issue. \end{dubious} *) module IMap = Map.Make (struct type t = int let compare = compare end) (* For [wf]s it is crucial for the performance to use a different type of [Map]s. *) module WFMap = Map.Make (struct type t = CF.wf * int let compare = wf_compare end) type lookups = { pmap : int list IMap.t; wfmap : int WFMap.t; cmap : CM.constant IMap.t * CM.constant IMap.t; amap : F.amplitude IMap.t; n_wfs : int list; amplitudes : CF.amplitudes; dict : F.amplitude -> F.wf -> int } let largest_key imap = if (IMap.is_empty imap) then failwith "largest_key: Map is empty!" else fst (IMap.max_binding imap) (* OCaml's [compare] from pervasives cannot compare functional types, e.g. for type [amplitude], if no specific equality function is given ("equal: functional value"). Therefore, we allow to specify the ordering. *) let get_ID' comp map elt : int = let smallmap = IMap.filter (fun _ x -> (comp x elt) = 0 ) map in if IMap.is_empty smallmap then raise Not_found else fst (IMap.min_binding smallmap) (* \begin{dubious} Trying to curry [map] here leads to type errors of the polymorphic function [get_ID]? \end{dubious} *) let get_ID map = match map with | map -> get_ID' compare map let get_const_ID map x = match map with | (map1, map2) -> try get_ID' compare map1 x with _ -> try get_ID' compare map2 x with _ -> failwith "Impossible" (* Creating an integer map of a list with an optional argument that indicates where the map should start counting. *) let map_of_list ?start:(st=1) lst = let g (ind, map) wf = (succ ind, IMap.add ind wf map) in lst |> List.fold_left g (st, IMap.empty) |> snd let wf_map_of_list ?start:(st=1) lst = let g (ind, map) wf = (succ ind, WFMap.add wf ind map) in lst |> List.fold_left g (st, WFMap.empty) |> snd (* \thocwmodulesubsection{Header} *) (* \begin{dubious} It would be nice to safe the creation date as comment. However, the Unix module doesn't seem to be loaded on default. \end{dubious} *) let version = String.concat " " [Config.version; Config.status; Config.date] let model_name = let basename = Filename.basename Sys.executable_name in try Filename.chop_extension basename with | _ -> basename let print_description cmdline = printf "Model %s\n" model_name; printf "OVM %s\n" version; printf "@\nBytecode file generated automatically by O'Mega for OVM"; printf "@\nDo not delete any lines. You called O'Mega with"; printf "@\n %s" cmdline; (*i let t = Unix.localtime (Unix.time() ) in printf "@\n on %5d %5d %5d" (succ t.Unix.tm_mon) t.Unix.tm_mday t.Unix.tm_year; i*) printf "@\n" let num_classified_wfs wfs = let wfs' = classify_wfs wfs in List.map List.length [ wfs'.scalars @ wfs'.brs_scalars; wfs'.spinors @ wfs'.brs_spinors; wfs'.conjspinors @ wfs'.brs_conjspinors; wfs'.realspinors @ wfs'.brs_realspinors @ wfs'.ghostspinors; wfs'.vectors @ wfs'.massive_vectors @ wfs'.brs_vectors @ wfs'.brs_massive_vectors @ wfs'.ward_vectors; wfs'.tensors_2; wfs'.tensors_1; wfs'.vectorspinors ] let description_classified_wfs = [ "N_scalars"; "N_spinors"; "N_conjspinors"; "N_bispinors"; "N_vectors"; "N_tensors_2"; "N_tensors_1"; "N_vectorspinors" ] let num_particles_in amp = match CF.flavors amp with | [] -> 0 | (fin, _) :: _ -> List.length fin let num_particles_out amp = match CF.flavors amp with | [] -> 0 | (_, fout) :: _ -> List.length fout let num_particles amp = match CF.flavors amp with | [] -> 0 | (fin, fout) :: _ -> List.length fin + List.length fout let num_color_indices_default = 2 (* Standard model and non-color-exotica *) let num_color_indices amp = try CFlow.rank (List.hd (CF.color_flows amp)) with _ -> num_color_indices_default let num_color_factors amp = let table = CF.color_factors amp in let n_cflow = Array.length table and n_cfactors = ref 0 in for c1 = 0 to pred n_cflow do for c2 = 0 to pred n_cflow do if c1 <= c2 then begin match table.(c1).(c2) with | [] -> () | _ -> incr n_cfactors end done done; !n_cfactors let num_helicities amp = amp |> CF.helicities |> List.length let num_flavors amp = amp |> CF.flavors |> List.length let num_ks amp = amp |> CF.processes |> List.length let num_color_flows amp = amp |> CF.color_flows |> List.length (* Use [fst] since [WFSet.t = F.wf * int]. *) let num_wfs wfset = wfset |> WFSet.elements |> List.map fst |> num_classified_wfs (* [largest_key] gives the number of momenta if applied to [pmap]. *) let num_lst lookups wfset = [ largest_key lookups.pmap; num_particles lookups.amplitudes; num_particles_in lookups.amplitudes; num_particles_out lookups.amplitudes; num_ks lookups.amplitudes; num_helicities lookups.amplitudes; num_color_flows lookups.amplitudes; num_color_indices lookups.amplitudes; num_flavors lookups.amplitudes; num_color_factors lookups.amplitudes ] @ num_wfs wfset let description_lst = [ "N_momenta"; "N_particles"; "N_prt_in"; "N_prt_out"; "N_amplitudes"; "N_helicities"; "N_col_flows"; "N_col_indices"; "N_flavors"; "N_col_factors" ] @ description_classified_wfs let print_header' numbers = let chopped_num_lst = ThoList.chopn inst_length numbers and chopped_desc_lst = ThoList.chopn inst_length description_lst and printer a b = print_str_lst a; print_int_lst b in List.iter2 printer chopped_desc_lst chopped_num_lst let print_header lookups wfset = print_header' (num_lst lookups wfset) let print_zero_header () = let rec zero_list' j = if j < 1 then [] else 0 :: zero_list' (j - 1) in let zero_list i = zero_list' (i + 1) in description_lst |> List.length |> zero_list |> print_header' (* \thocwmodulesubsection{Tables} *) let print_spin_table' tuples = match tuples with | [] -> () | _ -> tuples |> List.iter ( fun (tuple1, tuple2) -> tuple1 @ tuple2 |> List.map (Printf.sprintf "%d ") |> String.concat "" |> printf "@\n%s" ) let print_spin_table amplitudes = printf "@\nSpin states table"; print_spin_table' @@ CF.helicities amplitudes let print_flavor_table tuples = match tuples with | [] -> () | _ -> List.iter ( fun tuple -> tuple |> List.map (fun f -> Printf.sprintf "%d " @@ M.pdg f) |> String.concat "" |> printf "@\n%s" ) tuples let print_flavor_tables amplitudes = printf "@\nFlavor states table"; print_flavor_table @@ List.map (fun (fin, fout) -> fin @ fout) @@ CF.flavors amplitudes let print_color_flows_table' tuple = match CFlow.to_lists tuple with | [] -> () | cfs -> printf "@\n%s" @@ String.concat "" @@ List.map ( fun cf -> cf |> List.map (Printf.sprintf "%d ") |> String.concat "" ) cfs let print_color_flows_table tuples = match tuples with | [] -> () | _ -> List.iter print_color_flows_table' tuples let print_ghost_flags_table tuples = match tuples with | [] -> () | _ -> List.iter (fun tuple -> match CFlow.ghost_flags tuple with | [] -> () | gfs -> printf "@\n"; List.iter (fun gf -> printf "%s " (if gf then "1" else "0") ) gfs ) tuples let format_power { CFlow.num = num; CFlow.den = den; CFlow.power = pwr } = match num, den, pwr with | _, 0, _ -> invalid_arg "targets.format_power: zero denominator" | n, d, p -> [n; d; p] let format_powers = function | [] -> [0] | powers -> List.flatten (List.map format_power powers) (*i (* We go through the array line by line and collect all colorfactors which * are nonzero because their corresponding color flows match. * With the gained intset, we would be able to print only the necessary * coefficients of the symmetric matrix and indicate from where the OVM * can copy the rest. However, this approach gets really slow for many * gluons and we can save at most 3 numbers per line.*) let print_color_factor_table_funct table = let n_cflow = Array.length table in let (intset, _, _ ) = let rec fold_array (set, cf1, cf2) = if cf1 > pred n_cflow then (set, 0, 0) else let returnset = match table.(cf1).(cf2) with | [] -> set | cf -> ISet.add ([succ cf1; succ cf2] @ (format_powers cf)) set in if cf2 < pred n_cflow then fold_array (returnset, cf1, succ cf2) else fold_array (returnset, succ cf1, 0) in fold_array (ISet.empty, 0, 0) in let map = map_of_list (ISet.elements intset) in List.iter (fun x -> printf "@\n"; let xth = List.nth x in if (xth 0 <= xth 1) then List.iter (printf "%d ") x else printf "%d %d" 0 (get_ID map x)) (ISet.elements intset) let print_color_factor_table_old table = let n_cflow = Array.length table in let (intlsts, _, _ ) = let rec fold_array (lsts, cf1, cf2) = if cf1 > pred n_cflow then (lsts, 0, 0) else let returnlsts = match table.(cf1).(cf2) with | [] -> lsts | cf -> ([succ cf1; succ cf2] @ (format_powers cf)) :: lsts in if cf2 < pred n_cflow then fold_array (returnlsts, cf1, succ cf2) else fold_array (returnlsts, succ cf1, 0) in fold_array ([], 0, 0) in let intlsts = List.rev intlsts in List.iter (fun x -> printf "@\n"; List.iter (printf "%d ") x ) intlsts i*) (* Straightforward iteration gives a great speedup compared to the fancier approach which only collects nonzero colorfactors. *) let print_color_factor_table table = let n_cflow = Array.length table in if n_cflow > 0 then begin for c1 = 0 to pred n_cflow do for c2 = 0 to pred n_cflow do if c1 <= c2 then begin match table.(c1).(c2) with | [] -> () | cf -> printf "@\n"; List.iter (printf "%9d") ([succ c1; succ c2] @ (format_powers cf)); end done done end let option_to_binary = function | Some _ -> "1" | None -> "0" let print_flavor_color_table n_flv n_cflow table = if n_flv > 0 then begin for c = 0 to pred n_cflow do printf "@\n"; for f = 0 to pred n_flv do printf "%s " (option_to_binary table.(f).(c)) done; done; end let print_color_tables amplitudes = let cflows = CF.color_flows amplitudes and cfactors = CF.color_factors amplitudes in printf "@\nColor flows table: [ (i, j) (k, l) -> (m, n) ...]"; print_color_flows_table cflows; printf "@\nColor ghost flags table:"; print_ghost_flags_table cflows; printf "@\nColor factors table: [ i, j: num den power], %s" "i, j are indexed color flows"; print_color_factor_table cfactors; printf "@\nFlavor color combination is allowed:"; print_flavor_color_table (num_flavors amplitudes) (List.length (CF.color_flows amplitudes)) (CF.process_table amplitudes) (* \thocwmodulesubsection{Momenta} *) (* Add the momenta of a WFSet to a Iset. For now, we are throwing away the information to which amplitude the momentum belongs. This could be optimized for random color flow computations. *) let momenta_set wfset = let get_mom wf = wf |> fst |> F.momentum_list in let momenta = List.map get_mom (WFSet.elements wfset) in momenta |> List.fold_left (fun set x -> set |> ISet.add x) ISet.empty let chop_in_3 lst = let ceil_div i j = if (i mod j = 0) then i/j else i/j + 1 in ThoList.chopn (ceil_div (List.length lst) 3) lst (* Assign momenta via instruction code. External momenta [[_]] are already set by the OVM. To avoid unnecessary look-ups of IDs we seperate two cases. If we have more, we split up in two or three parts. *) let add_mom p pmap = let print_mom lhs rhs1 rhs2 rhs3 = if (rhs1!= 0) then printi ~lhs:lhs ~rhs1:rhs1 ~rhs2:rhs2 ~rhs3:rhs3 ovm_ADD_MOMENTA in let get_p_ID = get_ID pmap in match p with | [] | [_] -> print_mom 0 0 0 0 | [rhs1;rhs2] -> print_mom (get_p_ID [rhs1;rhs2]) rhs1 rhs2 0 | [rhs1;rhs2;rhs3] -> print_mom (get_p_ID [rhs1;rhs2;rhs3]) rhs1 rhs2 rhs3 | more -> let ids = List.map get_p_ID (chop_in_3 more) in if (List.length ids = 3) then print_mom (get_p_ID more) (List.nth ids 0) (List.nth ids 1) (List.nth ids 2) else print_mom (get_p_ID more) (List.nth ids 0) (List.nth ids 1) 0 (* Hand through the current level and print level seperators if necessary. *) let add_all_mom lookups pset = let add_all' level p = let level' = List.length p in if (level' > level && level' > 3) then break (); add_mom p lookups.pmap; level' in ignore (pset |> ISet.elements |> List.fold_left add_all' 1) (* Expand a set of momenta to contain all needed momenta for the computation in the OVM. For this, we create a list of sets which contains the chopped momenta and unify them afterwards. If the set has become larger, we expand again. *) let rec expand_pset p = let momlst = ISet.elements p in let pset_of lst = List.fold_left (fun s x -> ISet.add x s) ISet.empty lst in let sets = List.map (fun x -> pset_of (chop_in_3 x) ) momlst in let bigset = List.fold_left ISet.union ISet.empty sets in let biggerset = ISet.union bigset p in if (List.length momlst < List.length (ISet.elements biggerset) ) then expand_pset biggerset else biggerset let mom_ID pmap wf = get_ID pmap (F.momentum_list wf) (* \thocwmodulesubsection{Wavefunctions and externals} *) (* [mult_wf] is needed because the [wf] with same combination of flavor and momentum can have different dependencies and content. *) let mult_wf dict amplitude wf = try wf, dict amplitude wf with | Not_found -> wf, 0 (* Build the union of all [wf]s of all amplitudes and a map of the amplitudes. *) let wfset_amps amplitudes = let amap = amplitudes |> CF.processes |> List.sort amp_compare |> map_of_list and dict = CF.dictionary amplitudes in let wfset_amp amp = let f = mult_wf dict amp in let lst = List.map f ((F.externals amp) @ (F.variables amp)) in lst |> List.fold_left (fun s x -> WFSet.add x s) WFSet.empty in let list_of_sets = amplitudes |> CF.processes |> List.map wfset_amp in List.fold_left WFSet.union WFSet.empty list_of_sets, amap (* To obtain the Fortran index, we substract the number of precedent wave functions. *) let lorentz_ordering_reduced wf = match CM.lorentz (F.flavor wf) with | Scalar | BRS Scalar -> 0 | Spinor | BRS Spinor -> 1 | ConjSpinor | BRS ConjSpinor -> 2 | Majorana | BRS Majorana -> 3 | Vector | BRS Vector | Massive_Vector | BRS Massive_Vector -> 4 | Tensor_2 | BRS Tensor_2 -> 5 | Tensor_1 | BRS Tensor_1 -> 6 | Vectorspinor | BRS Vectorspinor -> 7 | Maj_Ghost -> invalid_arg "lorentz_ordering: not implemented" | BRS _ -> invalid_arg "lorentz_ordering: not needed" let wf_index wfmap num_lst (wf, i) = let wf_ID = WFMap.find (wf, i) wfmap and sum lst = List.fold_left (fun x y -> x+y) 0 lst in wf_ID - sum (ThoList.hdn (lorentz_ordering_reduced wf) num_lst) let print_ext lookups amp_ID inc (wf, i) = let mom = (F.momentum_list wf) in let outer_index = if List.length mom = 1 then List.hd mom else failwith "targets.print_ext: called with non-external particle" and f = F.flavor wf in let pdg = CM.pdg f and wf_code = match CM.lorentz f with | Scalar -> ovm_LOAD_SCALAR | BRS Scalar -> ovm_LOAD_BRS_SCALAR | Spinor -> if inc then ovm_LOAD_SPINOR_INC else ovm_LOAD_SPINOR_OUT | BRS Spinor -> if inc then ovm_LOAD_BRS_SPINOR_INC else ovm_LOAD_BRS_SPINOR_OUT | ConjSpinor -> if inc then ovm_LOAD_CONJSPINOR_INC else ovm_LOAD_CONJSPINOR_OUT | BRS ConjSpinor -> if inc then ovm_LOAD_BRS_CONJSPINOR_INC else ovm_LOAD_BRS_CONJSPINOR_OUT | Vector | Massive_Vector -> if inc then ovm_LOAD_VECTOR_INC else ovm_LOAD_VECTOR_OUT | BRS Vector | BRS Massive_Vector -> if inc then ovm_LOAD_BRS_VECTOR_INC else ovm_LOAD_BRS_VECTOR_OUT | Tensor_2 -> if inc then ovm_LOAD_TENSOR2_INC else ovm_LOAD_TENSOR2_OUT | Vectorspinor | BRS Vectorspinor -> if inc then ovm_LOAD_VECTORSPINOR_INC else ovm_LOAD_VECTORSPINOR_OUT | Majorana -> if inc then ovm_LOAD_MAJORANA_INC else ovm_LOAD_MAJORANA_OUT | BRS Majorana -> if inc then ovm_LOAD_BRS_MAJORANA_INC else ovm_LOAD_BRS_MAJORANA_OUT | Maj_Ghost -> if inc then ovm_LOAD_MAJORANA_GHOST_INC else ovm_LOAD_MAJORANA_GHOST_OUT | Tensor_1 -> invalid_arg "targets.print_ext: Tensor_1 only internal" | BRS _ -> failwith "targets.print_ext: Not implemented" and wf_ind = wf_index lookups.wfmap lookups.n_wfs (wf, i) in printi wf_code ~lhs:wf_ind ~coupl:(abs(pdg)) ~rhs1:outer_index ~rhs4:amp_ID let print_ext_amp lookups amplitude = let incoming = (List.map (fun _ -> true) (F.incoming amplitude) @ List.map (fun _ -> false) (F.outgoing amplitude)) and amp_ID = get_ID' amp_compare lookups.amap amplitude in let wf_tpl wf = mult_wf lookups.dict amplitude wf in let print_ext_wf inc wf = wf |> wf_tpl |> print_ext lookups amp_ID inc in List.iter2 print_ext_wf incoming (F.externals amplitude) let print_externals lookups 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) -> let amp_ID = get_ID' amp_compare lookups.amap amplitude in let wf_tpl = mult_wf lookups.dict amplitude wf in if not (WFSet.mem wf_tpl seen) then begin wf_tpl |> print_ext lookups amp_ID incoming end; WFSet.add wf_tpl seen) seen_wfs externals (* [print_externals] and [print_ext_amp] do in principle the same thing but [print_externals] filters out dublicate external wave functions. Even with [print_externals] the same (numerically) external wave function will be loaded if it belongs to a different color flow, just as in the native Fortran code. For color MC, [print_ext_amp] has to be used (redundant instructions but only one flow is computed) and the filtering of duplicate fusions has to be disabled. *) let print_ext_amps lookups = let print_external_amp s x = print_externals lookups s x in ignore ( List.fold_left print_external_amp WFSet.empty (CF.processes lookups.amplitudes) ) (*i List.iter (print_ext_amp lookups) (CF.processes lookups.amplitudes) i*) (* \thocwmodulesubsection{Currents} *) (* Parallelization issues: All fusions have to be completed before the propagation takes place. Preferably each fusion and propagation is done by one thread. Solution: All fusions are subinstructions, i.e. if they are read by the main loop they are skipped. If a propagation occurs, all fusions have to be computed first. The additional control bit is the sign of the first int of an instruction. *) (*i TODO: (bcn 2014-07-21) Majorana support will come some day maybe i*) let print_fermion_current code_a code_b code_c coeff lhs c wf1 wf2 fusion = let printc code r1 r2 = printi code ~lhs:lhs ~coupl:c ~coeff:coeff ~rhs1:r1 ~rhs2:r2 in match fusion with | F13 -> printc code_a wf1 wf2 | F31 -> printc code_a wf2 wf1 | F23 -> printc code_b wf1 wf2 | F32 -> printc code_b wf2 wf1 | F12 -> printc code_c wf1 wf2 | F21 -> printc code_c wf2 wf1 let ferm_print_current = function | coeff, Psibar, V, Psi -> print_fermion_current ovm_FUSE_V_FF ovm_FUSE_F_VF ovm_FUSE_F_FV coeff | coeff, Psibar, VA, Psi -> print_fermion_current ovm_FUSE_VA_FF ovm_FUSE_F_VAF ovm_FUSE_F_FVA coeff | coeff, Psibar, VA2, Psi -> print_fermion_current ovm_FUSE_VA2_FF ovm_FUSE_F_VA2F ovm_FUSE_F_FVA2 coeff | coeff, Psibar, A, Psi -> print_fermion_current ovm_FUSE_A_FF ovm_FUSE_F_AF ovm_FUSE_F_FA coeff | coeff, Psibar, VL, Psi -> print_fermion_current ovm_FUSE_VL_FF ovm_FUSE_F_VLF ovm_FUSE_F_FVL coeff | coeff, Psibar, VR, Psi -> print_fermion_current ovm_FUSE_VR_FF ovm_FUSE_F_VRF ovm_FUSE_F_FVR coeff | coeff, Psibar, VLR, Psi -> print_fermion_current ovm_FUSE_VLR_FF ovm_FUSE_F_VLRF ovm_FUSE_F_FVLR coeff | coeff, Psibar, SP, Psi -> print_fermion_current ovm_FUSE_SP_FF ovm_FUSE_F_SPF ovm_FUSE_F_FSP coeff | coeff, Psibar, S, Psi -> print_fermion_current ovm_FUSE_S_FF ovm_FUSE_F_SF ovm_FUSE_F_FS coeff | coeff, Psibar, P, Psi -> print_fermion_current ovm_FUSE_P_FF ovm_FUSE_F_PF ovm_FUSE_F_FP coeff | coeff, Psibar, SL, Psi -> print_fermion_current ovm_FUSE_SL_FF ovm_FUSE_F_SLF ovm_FUSE_F_FSL coeff | coeff, Psibar, SR, Psi -> print_fermion_current ovm_FUSE_SR_FF ovm_FUSE_F_SRF ovm_FUSE_F_FSR coeff | coeff, Psibar, SLR, Psi -> print_fermion_current ovm_FUSE_SLR_FF ovm_FUSE_F_SLRF ovm_FUSE_F_FSLR coeff | _, Psibar, _, Psi -> invalid_arg "Targets.Fortran.VM: no superpotential here" | _, Chibar, _, _ | _, _, _, Chi -> invalid_arg "Targets.Fortran.VM: Majorana spinors not handled" | _, Gravbar, _, _ | _, _, _, Grav -> invalid_arg "Targets.Fortran.VM: Gravitinos not handled" 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" let print_vector4 c lhs wf1 wf2 wf3 fusion (coeff, contraction) = let printc r1 r2 r3 = printi ovm_FUSE_V_VVV ~lhs:lhs ~coupl:c ~coeff:coeff ~rhs1:r1 ~rhs2:r2 ~rhs3:r3 in 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) -> printc 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) -> printc 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) -> printc wf1 wf3 wf2 let print_current lookups lhs amplitude rhs = let f = mult_wf lookups.dict amplitude in match F.coupling rhs with | V3 (vertex, fusion, constant) -> let ch1, ch2 = children2 rhs in let wf1 = wf_index lookups.wfmap lookups.n_wfs (f ch1) and wf2 = wf_index lookups.wfmap lookups.n_wfs (f ch2) and p1 = mom_ID lookups.pmap ch1 and p2 = mom_ID lookups.pmap ch2 and const_ID = get_const_ID lookups.cmap constant in let c = if (F.sign rhs) < 0 then - const_ID else const_ID in begin match vertex with | FBF (coeff, fb, b, f) -> begin match coeff, fb, b, f with | _, Psibar, VLRM, Psi | _, Psibar, SPM, Psi | _, Psibar, TVA, Psi | _, Psibar, TVAM, Psi | _, Psibar, TLR, Psi | _, Psibar, TLRM, Psi | _, Psibar, TRL, Psi | _, Psibar, TRLM, Psi -> failwith "print_current: V3: Momentum dependent fermion couplings not implemented" | _, _, _, _ -> ferm_print_current (coeff, fb, b, f) lhs c wf1 wf2 fusion end | PBP (_, _, _, _) -> failwith "print_current: V3: PBP not implemented" | BBB (_, _, _, _) -> failwith "print_current: V3: BBB not implemented" | GBG (_, _, _, _) -> failwith "print_current: V3: GBG not implemented" | Gauge_Gauge_Gauge coeff -> let printc r1 r2 r3 r4 = printi ovm_FUSE_G_GG ~lhs:lhs ~coupl:c ~coeff:coeff ~rhs1:r1 ~rhs2:r2 ~rhs3:r3 ~rhs4:r4 in begin match fusion with | (F23|F31|F12) -> printc wf1 p1 wf2 p2 | (F32|F13|F21) -> printc wf2 p2 wf1 p1 end | I_Gauge_Gauge_Gauge _ -> failwith "print_current: I_Gauge_Gauge_Gauge: not implemented" | Scalar_Vector_Vector coeff -> let printc code r1 r2 = printi code ~lhs:lhs ~coupl:c ~coeff:coeff ~rhs1:r1 ~rhs2:r2 in begin match fusion with | (F23|F32) -> printc ovm_FUSE_S_VV wf1 wf2 | (F12|F13) -> printc ovm_FUSE_V_SV wf1 wf2 | (F21|F31) -> printc ovm_FUSE_V_SV wf2 wf1 end | Scalar_Scalar_Scalar coeff -> printi ovm_FUSE_S_SS ~lhs:lhs ~coupl:c ~coeff:coeff ~rhs1:wf1 ~rhs2:wf2 | Vector_Scalar_Scalar coeff -> let printc code ?flip:(f = 1) r1 r2 r3 r4 = printi code ~lhs:lhs ~coupl:(c*f) ~coeff:coeff ~rhs1:r1 ~rhs2:r2 ~rhs3:r3 ~rhs4:r4 in begin match fusion with | F23 -> printc ovm_FUSE_V_SS wf1 p1 wf2 p2 | F32 -> printc ovm_FUSE_V_SS wf2 p2 wf1 p1 | F12 -> printc ovm_FUSE_S_VS wf1 p1 wf2 p2 | F21 -> printc ovm_FUSE_S_VS wf2 p2 wf1 p1 | F13 -> printc ovm_FUSE_S_VS wf1 p1 wf2 p2 ~flip:(-1) | F31 -> printc ovm_FUSE_S_VS wf2 p2 wf1 p1 ~flip:(-1) end | Aux_Vector_Vector _ -> failwith "print_current: V3: not implemented" | Aux_Scalar_Scalar _ -> failwith "print_current: V3: not implemented" | Aux_Scalar_Vector _ -> failwith "print_current: V3: not implemented" | Graviton_Scalar_Scalar _ -> failwith "print_current: V3: not implemented" | Graviton_Vector_Vector _ -> failwith "print_current: V3: not implemented" | Graviton_Spinor_Spinor _ -> failwith "print_current: V3: not implemented" | Dim4_Vector_Vector_Vector_T _ -> failwith "print_current: V3: not implemented" | Dim4_Vector_Vector_Vector_L _ -> failwith "print_current: V3: not implemented" | Dim6_Gauge_Gauge_Gauge _ -> failwith "print_current: V3: not implemented" | Dim4_Vector_Vector_Vector_T5 _ -> failwith "print_current: V3: not implemented" | Dim4_Vector_Vector_Vector_L5 _ -> failwith "print_current: V3: not implemented" | Dim6_Gauge_Gauge_Gauge_5 _ -> failwith "print_current: V3: not implemented" | Aux_DScalar_DScalar _ -> failwith "print_current: V3: not implemented" | Aux_Vector_DScalar _ -> failwith "print_current: V3: not implemented" | Dim5_Scalar_Gauge2 coeff -> let printc code r1 r2 r3 r4 = printi code ~lhs:lhs ~coupl:c ~coeff:coeff ~rhs1:r1 ~rhs2:r2 ~rhs3:r3 ~rhs4:r4 in begin match fusion with | (F23|F32) -> printc ovm_FUSE_S_G2 wf1 p1 wf2 p2 | (F12|F13) -> printc ovm_FUSE_G_SG wf1 p1 wf2 p2 | (F21|F31) -> printc ovm_FUSE_G_GS wf2 p2 wf1 p1 end | Dim5_Scalar_Gauge2_Skew coeff -> let printc code ?flip:(f = 1) r1 r2 r3 r4 = printi code ~lhs:lhs ~coupl:(c*f) ~coeff:coeff ~rhs1:r1 ~rhs2:r2 ~rhs3:r3 ~rhs4:r4 in begin match fusion with | (F23|F32) -> printc ovm_FUSE_S_G2_SKEW wf1 p1 wf2 p2 | (F12|F13) -> printc ovm_FUSE_G_SG_SKEW wf1 p1 wf2 p2 | (F21|F31) -> printc ovm_FUSE_G_GS_SKEW wf2 p1 wf1 p2 ~flip:(-1) end | Dim5_Scalar_Vector_Vector_T _ -> failwith "print_current: V3: not implemented" | Dim5_Scalar_Vector_Vector_U _ -> failwith "print_current: V3: not implemented" | Dim5_Scalar_Scalar2 _ -> failwith "print_current: V3: not implemented" | Dim6_Vector_Vector_Vector_T _ -> failwith "print_current: V3: not implemented" | Tensor_2_Vector_Vector _ -> failwith "print_current: V3: not implemented" | Tensor_2_Scalar_Scalar _ -> failwith "print_current: V3: not implemented" | Dim5_Tensor_2_Vector_Vector_1 _ -> failwith "print_current: V3: not implemented" | Dim5_Tensor_2_Vector_Vector_2 _ -> failwith "print_current: V3: not implemented" | Dim7_Tensor_2_Vector_Vector_T _ -> failwith "print_current: V3: not implemented" | Dim5_Scalar_Vector_Vector_TU _ -> failwith "print_current: V3: not implemented" | Scalar_Vector_Vector_t _ -> failwith "print_current: V3: not implemented" | Tensor_2_Vector_Vector_cf _ -> failwith "print_current: V3: not implemented" | Tensor_2_Scalar_Scalar_cf _ -> failwith "print_current: V3: not implemented" | Tensor_2_Vector_Vector_1 _ -> failwith "print_current: V3: not implemented" | Tensor_2_Vector_Vector_t _ -> failwith "print_current: V3: not implemented" | TensorVector_Vector_Vector _ -> failwith "print_current: V3: not implemented" | TensorVector_Vector_Vector_cf _ -> failwith "print_current: V3: not implemented" | TensorVector_Scalar_Scalar _ -> failwith "print_current: V3: not implemented" | TensorVector_Scalar_Scalar_cf _ -> failwith "print_current: V3: not implemented" | TensorScalar_Vector_Vector _ -> failwith "print_current: V3: not implemented" | TensorScalar_Vector_Vector_cf _ -> failwith "print_current: V3: not implemented" | TensorScalar_Scalar_Scalar _ -> failwith "print_current: V3: not implemented" | TensorScalar_Scalar_Scalar_cf _ -> failwith "print_current: V3: not implemented" | Dim6_Scalar_Vector_Vector_D _ -> failwith "print_current: V3: not implemented" | Dim6_Scalar_Vector_Vector_DP _ -> failwith "print_current: V3: not implemented" | Dim6_HAZ_D _ -> failwith "print_current: V3: not implemented" | Dim6_HAZ_DP _ -> failwith "print_current: V3: not implemented" | Dim6_HHH _ -> failwith "print_current: V3: not implemented" | Dim6_Gauge_Gauge_Gauge_i _ -> failwith "print_current: V3: not implemented" | Gauge_Gauge_Gauge_i _ -> failwith "print_current: V3: not implemented" | Dim6_GGG _ -> failwith "print_current: V3: not implemented" | Dim6_AWW_DP _ -> failwith "print_current: V3: not implemented" | Dim6_AWW_DW _ -> failwith "print_current: V3: not implemented" | Dim6_WWZ_DPWDW _ -> failwith "print_current: V3: not implemented" | Dim6_WWZ_DW _ -> failwith "print_current: V3: not implemented" | Dim6_WWZ_D _ -> failwith "print_current: V3: not implemented" | Aux_Gauge_Gauge _ -> failwith "print_current: V3 (Aux_Gauge_Gauge): not implemented" end (* Flip the sign in [c] to account for the~$\mathrm{i}^2$ relative to diagrams with only cubic couplings. *) | V4 (vertex, fusion, constant) -> let ch1, ch2, ch3 = children3 rhs in let wf1 = wf_index lookups.wfmap lookups.n_wfs (f ch1) and wf2 = wf_index lookups.wfmap lookups.n_wfs (f ch2) and wf3 = wf_index lookups.wfmap lookups.n_wfs (f ch3) (*i (*and p1 = mom_ID lookups.pmap ch1*) (*and p2 = mom_ID lookups.pmap ch2*) (*and p3 = mom_ID lookups.pmap ch2*) i*) and const_ID = get_const_ID lookups.cmap constant in let c = if (F.sign rhs) < 0 then const_ID else - const_ID in begin match vertex with | Scalar4 coeff -> printi ovm_FUSE_S_SSS ~lhs:lhs ~coupl:c ~coeff:coeff ~rhs1:wf1 ~rhs2:wf2 ~rhs3:wf3 | Scalar2_Vector2 coeff -> let printc code r1 r2 r3 = printi code ~lhs:lhs ~coupl:c ~coeff:coeff ~rhs1:r1 ~rhs2:r2 ~rhs3:r3 in begin match fusion with | F134 | F143 | F234 | F243 -> printc ovm_FUSE_S_SVV wf1 wf2 wf3 | F314 | F413 | F324 | F423 -> printc ovm_FUSE_S_SVV wf2 wf1 wf3 | F341 | F431 | F342 | F432 -> printc ovm_FUSE_S_SVV wf3 wf1 wf2 | F312 | F321 | F412 | F421 -> printc ovm_FUSE_V_SSV wf2 wf3 wf1 | F231 | F132 | F241 | F142 -> printc ovm_FUSE_V_SSV wf1 wf3 wf2 | F123 | F213 | F124 | F214 -> printc ovm_FUSE_V_SSV wf1 wf2 wf3 end | Vector4 contractions -> List.iter (print_vector4 c lhs wf1 wf2 wf3 fusion) contractions | Vector4_K_Matrix_tho _ | Vector4_K_Matrix_jr _ | Vector4_K_Matrix_cf_t0 _ | Vector4_K_Matrix_cf_t1 _ | Vector4_K_Matrix_cf_t2 _ | Vector4_K_Matrix_cf_t_rsi _ | Vector4_K_Matrix_cf_m0 _ | Vector4_K_Matrix_cf_m1 _ | Vector4_K_Matrix_cf_m7 _ | DScalar2_Vector2_K_Matrix_ms _ | DScalar2_Vector2_m_0_K_Matrix_cf _ | DScalar2_Vector2_m_1_K_Matrix_cf _ | DScalar2_Vector2_m_7_K_Matrix_cf _ | DScalar4_K_Matrix_ms _ -> failwith "print_current: V4: K_Matrix not implemented" | Dim8_Scalar2_Vector2_1 _ | Dim8_Scalar2_Vector2_2 _ | Dim8_Scalar2_Vector2_m_0 _ | Dim8_Scalar2_Vector2_m_1 _ | Dim8_Scalar2_Vector2_m_7 _ | Dim8_Scalar4 _ -> failwith "print_current: V4: not implemented" | Dim8_Vector4_t_0 _ -> failwith "print_current: V4: not implemented" | Dim8_Vector4_t_1 _ -> failwith "print_current: V4: not implemented" | Dim8_Vector4_t_2 _ -> failwith "print_current: V4: not implemented" | Dim8_Vector4_m_0 _ -> failwith "print_current: V4: not implemented" | Dim8_Vector4_m_1 _ -> failwith "print_current: V4: not implemented" | Dim8_Vector4_m_7 _ -> failwith "print_current: V4: not implemented" | GBBG _ -> failwith "print_current: V4: GBBG not implemented" | DScalar4 _ | DScalar2_Vector2 _ -> failwith "print_current: V4: DScalars not implemented" | Dim6_H4_P2 _ -> failwith "print_current: V4: not implemented" | Dim6_AHWW_DPB _ -> failwith "print_current: V4: not implemented" | Dim6_AHWW_DPW _ -> failwith "print_current: V4: not implemented" | Dim6_AHWW_DW _ -> failwith "print_current: V4: not implemented" | Dim6_Vector4_DW _ -> failwith "print_current: V4: not implemented" | Dim6_Vector4_W _ -> failwith "print_current: V4: not implemented" | Dim6_Scalar2_Vector2_D _ -> failwith "print_current: V4: not implemented" | Dim6_Scalar2_Vector2_DP _ -> failwith "print_current: V4: not implemented" | Dim6_HWWZ_DW _ -> failwith "print_current: V4: not implemented" | Dim6_HWWZ_DPB _ -> failwith "print_current: V4: not implemented" | Dim6_HWWZ_DDPW _ -> failwith "print_current: V4: not implemented" | Dim6_HWWZ_DPW _ -> failwith "print_current: V4: not implemented" | Dim6_AHHZ_D _ -> failwith "print_current: V4: not implemented" | Dim6_AHHZ_DP _ -> failwith "print_current: V4: not implemented" | Dim6_AHHZ_PB _ -> failwith "print_current: V4: not implemented" | Dim6_Scalar2_Vector2_PB _ -> failwith "print_current: V4: not implemented" | Dim6_HHZZ_T _ -> failwith "print_current: V4: not implemented" end | Vn (_, _, _) -> invalid_arg "Targets.print_current: n-ary fusion." (* \thocwmodulesubsection{Fusions} *) let print_fusion lookups lhs_momID fusion amplitude = if F.on_shell amplitude (F.lhs fusion) then failwith "print_fusion: on_shell projectors not implemented!"; if F.is_gauss amplitude (F.lhs fusion) then failwith "print_fusion: gauss amplitudes not implemented!"; let lhs_wf = mult_wf lookups.dict amplitude (F.lhs fusion) in let lhs_wfID = wf_index lookups.wfmap lookups.n_wfs lhs_wf in let f = F.flavor (F.lhs fusion) in let pdg = CM.pdg f in let w = begin match CM.width f with | Vanishing | Fudged -> 0 | Constant -> 1 | Timelike -> 2 | Complex_Mass -> 3 | Running -> failwith "Targets.VM: running width not available" | Custom _ -> failwith "Targets.VM: custom width not available" end in let propagate code = printi code ~lhs:lhs_wfID ~rhs1:lhs_momID ~coupl:(abs(pdg)) ~coeff:w ~rhs4:(get_ID' amp_compare lookups.amap amplitude) in begin match CM.propagator f with | Prop_Scalar -> propagate ovm_PROPAGATE_SCALAR | Prop_Col_Scalar -> propagate ovm_PROPAGATE_COL_SCALAR | Prop_Ghost -> propagate ovm_PROPAGATE_GHOST | Prop_Spinor -> propagate ovm_PROPAGATE_SPINOR | Prop_ConjSpinor -> propagate ovm_PROPAGATE_CONJSPINOR | Prop_Majorana -> propagate ovm_PROPAGATE_MAJORANA | Prop_Col_Majorana -> propagate ovm_PROPAGATE_COL_MAJORANA | Prop_Unitarity -> propagate ovm_PROPAGATE_UNITARITY | Prop_Col_Unitarity -> propagate ovm_PROPAGATE_COL_UNITARITY | Prop_Feynman -> propagate ovm_PROPAGATE_FEYNMAN | Prop_Col_Feynman -> propagate ovm_PROPAGATE_COL_FEYNMAN | Prop_Vectorspinor -> propagate ovm_PROPAGATE_VECTORSPINOR | Prop_Tensor_2 -> propagate ovm_PROPAGATE_TENSOR2 | Aux_Col_Scalar | Aux_Col_Vector | Aux_Col_Tensor_1 -> failwith "print_fusion: Aux_Col_* not implemented!" | Aux_Vector | Aux_Tensor_1 | Aux_Scalar | Aux_Spinor | Aux_ConjSpinor | Aux_Majorana | Only_Insertion -> propagate ovm_PROPAGATE_NONE | Prop_Gauge _ -> failwith "print_fusion: Prop_Gauge not implemented!" | Prop_Tensor_pure -> failwith "print_fusion: Prop_Tensor_pure not implemented!" | Prop_Vector_pure -> failwith "print_fusion: Prop_Vector_pure not implemented!" | Prop_Rxi _ -> failwith "print_fusion: Prop_Rxi not implemented!" + | Prop_UFO _ -> + failwith "print_fusion: Prop_UFO not implemented!" end; (* Since the OVM knows that we want to propagate a wf, we can send the necessary fusions now. *) List.iter (print_current lookups lhs_wfID amplitude) (F.rhs fusion) let print_all_fusions lookups = let fusions = CF.fusions lookups.amplitudes in let fset = List.fold_left (fun s x -> FSet.add x s) FSet.empty fusions in ignore (List.fold_left (fun level (f, amplitude) -> let wf = F.lhs f in let lhs_momID = mom_ID lookups.pmap wf in let level' = List.length (F.momentum_list wf) in if (level' > level && level' > 2) then break (); print_fusion lookups lhs_momID f amplitude; level') 1 (FSet.elements fset) ) (* \thocwmodulesubsection{Brakets} *) let print_braket lookups amplitude braket = let bra = F.bra braket and ket = F.ket braket in let braID = wf_index lookups.wfmap lookups.n_wfs (mult_wf lookups.dict amplitude bra) in List.iter (print_current lookups braID amplitude) ket (* \begin{equation} \ii T = \ii^{\#\text{vertices}}\ii^{\#\text{propagators}} \cdots = \ii^{n-2}\ii^{n-3} \cdots = -\ii(-1)^n \cdots \end{equation} *) (* All brakets for one cflow amplitude should be calculated by one thread to avoid multiple access on the same memory (amplitude).*) let print_brakets lookups (amplitude, i) = let n = List.length (F.externals amplitude) in let sign = if n mod 2 = 0 then -1 else 1 and sym = F.symmetry amplitude in printi ovm_CALC_BRAKET ~lhs:i ~rhs1:sym ~coupl:sign; amplitude |> F.brakets |> List.iter (print_braket lookups amplitude) (* Fortran arrays/OCaml lists start on 1/0. The amplitude list is sorted by [amp_compare] according to their color flows. In this way the amp array is sorted in the same way as [table_color_factors]. *) let print_all_brakets lookups = let g i elt = print_brakets lookups (elt, i+1) in lookups.amplitudes |> CF.processes |> List.sort amp_compare |> ThoList.iteri g 0 (* \thocwmodulesubsection{Couplings} *) (* For now we only care to catch the arrays [gncneu], [gnclep], [gncup] and [gncdown] of the SM. This will need an overhaul when it is clear how we store the type information of coupling constants. *) let strip_array_tag = function | Real_Array x -> x | Complex_Array x -> x let array_constants_list = let params = M.parameters() and strip_to_constant (lhs, _) = strip_array_tag lhs in List.map strip_to_constant params.derived_arrays let is_array x = List.mem x array_constants_list let constants_map = let first = fun (x, _, _) -> x in let second = fun (_, y, _) -> y in let third = fun (_, _, z) -> z in let v3 = List.map third (first (M.vertices () )) and v4 = List.map third (second (M.vertices () )) in let set = List.fold_left (fun s x -> CSet.add x s) CSet.empty (v3 @ v4) in let (arrays, singles) = CSet.partition is_array set in (singles |> CSet.elements |> map_of_list, arrays |> CSet.elements |> map_of_list) (* \thocwmodulesubsection{Output calls} *) let amplitudes_to_channel (cmdline : string) (oc : out_channel) (diagnostics : (diagnostic * bool) list ) (amplitudes : CF.amplitudes) = set_formatter_out_channel oc; if (num_particles amplitudes = 0) then begin print_description cmdline; print_zero_header (); nl () end else begin let (wfset, amap) = wfset_amps amplitudes in let pset = expand_pset (momenta_set wfset) and n_wfs = num_wfs wfset in let wfmap = wf_map_of_list (WFSet.elements wfset) and pmap = map_of_list (ISet.elements pset) and cmap = constants_map in let lookups = {pmap = pmap; wfmap = wfmap; cmap = cmap; amap = amap; n_wfs = n_wfs; amplitudes = amplitudes; dict = CF.dictionary amplitudes} in print_description cmdline; print_header lookups wfset; print_spin_table amplitudes; print_flavor_tables amplitudes; print_color_tables amplitudes; printf "@\n%s" ("OVM instructions for momenta addition," ^ " fusions and brakets start here: "); break (); add_all_mom lookups pset; print_ext_amps lookups; break (); print_all_fusions lookups; break (); print_all_brakets lookups; break (); nl (); print_flush () end let parameters_to_fortran oc _ = (*i The -params options is used as wrapper between OVM and Whizard. Most * trouble for the OVM comes from the array dimensionalities of couplings * but O'Mega should also know whether a constant is real or complex. * Hopefully all will be clearer with the fully general Lorentz structures * and UFO support. For now, we stick with this brute-force solution. i*) set_formatter_out_channel oc; let arrays_to_set = not (IMap.is_empty (snd constants_map)) in let set_coupl ty dim cmap = IMap.iter (fun key elt -> printf " %s(%s%d) = %s" ty dim key (M.constant_symbol elt); nl () ) cmap in let declarations () = printf " complex(%s), dimension(%d) :: ovm_coupl_cmplx" !kind (constants_map |> fst |> largest_key); nl (); if arrays_to_set then printf " complex(%s), dimension(2, %d) :: ovm_coupl_cmplx2" !kind (constants_map |> snd |> largest_key); nl () in let print_line str = printf "%s" str; nl() in let print_md5sum = function | Some s -> print_line " function md5sum ()"; print_line " character(len=32) :: md5sum"; print_line (" bytecode_file = '" ^ !bytecode_file ^ "'"); print_line " call initialize_vm (vm, bytecode_file)"; print_line " ! DON'T EVEN THINK of modifying the following line!"; print_line (" md5sum = '" ^ s ^ "'"); print_line " end function md5sum"; | None -> () in let print_inquiry_function_openmp () = begin print_line " pure function openmp_supported () result (status)"; print_line " logical :: status"; print_line (" status = " ^ (if !openmp then ".true." else ".false.")); print_line " end function openmp_supported"; nl () end in let print_interface whizard = if whizard then begin print_line " subroutine init (par, scheme)"; print_line " real(kind=default), dimension(*), intent(in) :: par"; print_line " integer, intent(in) :: scheme"; print_line (" bytecode_file = '" ^ !bytecode_file ^ "'"); print_line " call import_from_whizard (par, scheme)"; print_line " call initialize_vm (vm, bytecode_file)"; print_line " end subroutine init"; nl (); print_line " subroutine final ()"; print_line " call vm%final ()"; print_line " end subroutine final"; nl (); print_line " subroutine update_alpha_s (alpha_s)"; print_line (" real(kind=" ^ !kind ^ "), intent(in) :: alpha_s"); print_line " call model_update_alpha_s (alpha_s)"; print_line " end subroutine update_alpha_s"; nl () end else begin print_line " subroutine init ()"; print_line (" bytecode_file = '" ^ !bytecode_file ^ "'"); print_line " call init_parameters ()"; print_line " call initialize_vm (vm, bytecode_file)"; print_line " end subroutine" end in let print_lookup_functions () = begin print_line " pure function number_particles_in () result (n)"; print_line " integer :: n"; print_line " n = vm%number_particles_in ()"; print_line " end function number_particles_in"; nl(); print_line " pure function number_particles_out () result (n)"; print_line " integer :: n"; print_line " n = vm%number_particles_out ()"; print_line " end function number_particles_out"; nl(); print_line " pure function number_spin_states () result (n)"; print_line " integer :: n"; print_line " n = vm%number_spin_states ()"; print_line " end function number_spin_states"; nl(); print_line " pure subroutine spin_states (a)"; print_line " integer, dimension(:,:), intent(out) :: a"; print_line " call vm%spin_states (a)"; print_line " end subroutine spin_states"; nl(); print_line " pure function number_flavor_states () result (n)"; print_line " integer :: n"; print_line " n = vm%number_flavor_states ()"; print_line " end function number_flavor_states"; nl(); print_line " pure subroutine flavor_states (a)"; print_line " integer, dimension(:,:), intent(out) :: a"; print_line " call vm%flavor_states (a)"; print_line " end subroutine flavor_states"; nl(); print_line " pure function number_color_indices () result (n)"; print_line " integer :: n"; print_line " n = vm%number_color_indices ()"; print_line " end function number_color_indices"; nl(); print_line " pure function number_color_flows () result (n)"; print_line " integer :: n"; print_line " n = vm%number_color_flows ()"; print_line " end function number_color_flows"; nl(); print_line " pure subroutine color_flows (a, g)"; print_line " integer, dimension(:,:,:), intent(out) :: a"; print_line " logical, dimension(:,:), intent(out) :: g"; print_line " call vm%color_flows (a, g)"; print_line " end subroutine color_flows"; nl(); print_line " pure function number_color_factors () result (n)"; print_line " integer :: n"; print_line " n = vm%number_color_factors ()"; print_line " end function number_color_factors"; nl(); print_line " pure subroutine color_factors (cf)"; print_line " use omega_color"; print_line " type(omega_color_factor), dimension(:), intent(out) :: cf"; print_line " call vm%color_factors (cf)"; print_line " end subroutine color_factors"; nl(); print_line " !pure unless OpenMP"; print_line " !pure function color_sum (flv, hel) result (amp2)"; print_line " function color_sum (flv, hel) result (amp2)"; print_line " use kinds"; print_line " integer, intent(in) :: flv, hel"; print_line " real(kind=default) :: amp2"; print_line " amp2 = vm%color_sum (flv, hel)"; print_line " end function color_sum"; nl(); print_line " subroutine new_event (p)"; print_line " use kinds"; print_line " real(kind=default), dimension(0:3,*), intent(in) :: p"; print_line " call vm%new_event (p)"; print_line " end subroutine new_event"; nl(); print_line " subroutine reset_helicity_selection (threshold, cutoff)"; print_line " use kinds"; print_line " real(kind=default), intent(in) :: threshold"; print_line " integer, intent(in) :: cutoff"; print_line " call vm%reset_helicity_selection (threshold, cutoff)"; print_line " end subroutine reset_helicity_selection"; nl(); print_line " pure function is_allowed (flv, hel, col) result (yorn)"; print_line " logical :: yorn"; print_line " integer, intent(in) :: flv, hel, col"; print_line " yorn = vm%is_allowed (flv, hel, col)"; print_line " end function is_allowed"; nl(); print_line " pure function get_amplitude (flv, hel, col) result (amp_result)"; print_line " use kinds"; print_line " complex(kind=default) :: amp_result"; print_line " integer, intent(in) :: flv, hel, col"; print_line " amp_result = vm%get_amplitude(flv, hel, col)"; print_line " end function get_amplitude"; nl(); end in print_line ("module " ^ !wrapper_module); print_line (" use " ^ !parameter_module_external); print_line " use iso_varying_string, string_t => varying_string"; print_line " use kinds"; print_line " use omegavm95"; print_line " implicit none"; print_line " private"; print_line " type(vm_t) :: vm"; print_line " type(string_t) :: bytecode_file"; print_line (" public :: number_particles_in, number_particles_out," ^ " number_spin_states, &"); print_line (" spin_states, number_flavor_states, flavor_states," ^ " number_color_indices, &"); print_line (" number_color_flows, color_flows," ^ " number_color_factors, color_factors, &"); print_line (" color_sum, new_event, reset_helicity_selection," ^ " is_allowed, get_amplitude, &"); print_line (" init, " ^ (match !md5sum with Some _ -> "md5sum, " | None -> "") ^ "openmp_supported"); if !whizard then print_line (" public :: final, update_alpha_s") else print_line (" public :: initialize_vm"); declarations (); print_line "contains"; print_line " subroutine setup_couplings ()"; set_coupl "ovm_coupl_cmplx" "" (fst constants_map); if arrays_to_set then set_coupl "ovm_coupl_cmplx2" ":," (snd constants_map); print_line " end subroutine setup_couplings"; print_line " subroutine initialize_vm (vm, bytecode_file)"; print_line " class(vm_t), intent(out) :: vm"; print_line " type(string_t), intent(in) :: bytecode_file"; print_line " type(string_t) :: version"; print_line " type(string_t) :: model"; print_line (" version = 'OVM " ^ version ^ "'"); print_line (" model = 'Model " ^ model_name ^ "'"); print_line " call setup_couplings ()"; print_line " call vm%init (bytecode_file, version, model, verbose=.False., &"; print_line " coupl_cmplx=ovm_coupl_cmplx, &"; if arrays_to_set then print_line " coupl_cmplx2=ovm_coupl_cmplx2, &"; print_line (" mass=mass, width=width, openmp=" ^ (if !openmp then ".true." else ".false.") ^ ")"); print_line " end subroutine initialize_vm"; nl(); print_md5sum !md5sum; print_inquiry_function_openmp (); print_interface !whizard; print_lookup_functions (); print_line ("end module " ^ !wrapper_module) let parameters_to_channel oc = parameters_to_fortran oc (CM.parameters ()) 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_mom : int * fermionbar * boson * fermion -> string -> string -> string -> 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 end module Fortran_Fermions : Fermions = struct 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 ?p ?q () = 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 ')') || (String.contains tail '(') || (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 match p with | None -> s ^ "(" ^ string_of_int i ^ ")" | Some p -> match q with | None -> s ^ "(" ^ p ^ "*" ^ p ^ "," ^ string_of_int i ^ ")" | Some q -> s ^ "(" ^ p ^ "," ^ q ^ "," ^ 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_fermion_current_mom_v1 coeff f c wf1 wf2 p1 p2 p12 fusion = let c = format_coupling 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 ~p:p12 ()) (c2 ~p:p12 ()) wf1 wf2 | F31 -> printf "%s_ff(%s,%s,%s,%s)" f (c1 ~p:p12 ()) (c2 ~p:p12 ()) wf2 wf1 | F23 -> printf "f_%sf(%s,%s,%s,%s)" f (c1 ~p:p1 ()) (c2 ~p:p1 ()) wf1 wf2 | F32 -> printf "f_%sf(%s,%s,%s,%s)" f (c1 ~p:p2 ()) (c2 ~p:p2 ()) wf2 wf1 | F12 -> printf "f_f%s(%s,%s,%s,%s)" f (c1 ~p:p2 ()) (c2 ~p:p2 ()) wf1 wf2 | F21 -> printf "f_f%s(%s,%s,%s,%s)" f (c1 ~p:p1 ()) (c2 ~p:p1 ()) wf2 wf1 let print_fermion_current_mom_v2 coeff f c wf1 wf2 p1 p2 p12 fusion = let c = format_coupling 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 ~p:p12 ()) (c2 ~p:p12 ()) wf1 wf2 p12 | F31 -> printf "%s_ff(%s,%s,@,%s,%s,%s)" f (c1 ~p:p12 ()) (c2 ~p:p12 ()) wf2 wf1 p12 | F23 -> printf "f_%sf(%s,%s,@,%s,%s,%s)" f (c1 ~p:p1 ()) (c2 ~p:p1 ()) wf1 wf2 p1 | F32 -> printf "f_%sf(%s,%s,@,%s,%s,%s)" f (c1 ~p:p2 ()) (c2 ~p:p2 ()) wf2 wf1 p2 | F12 -> printf "f_f%s(%s,%s,@,%s,%s,%s)" f (c1 ~p:p2 ()) (c2 ~p:p2 ()) wf1 wf2 p2 | F21 -> printf "f_f%s(%s,%s,@,%s,%s,%s)" f (c1 ~p:p1 ()) (c2 ~p:p1 ()) wf2 wf1 p1 let print_fermion_current_mom_ff coeff f c wf1 wf2 p1 p2 p12 fusion = let c = format_coupling 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 ~p:p1 ~q:p2 ()) (c2 ~p:p1 ~q:p2 ()) wf1 wf2 | F31 -> printf "%s_ff(%s,%s,%s,%s)" f (c1 ~p:p1 ~q:p2 ()) (c2 ~p:p1 ~q:p2 ()) wf2 wf1 | F23 -> printf "f_%sf(%s,%s,%s,%s)" f (c1 ~p:p12 ~q:p2 ()) (c2 ~p:p12 ~q:p2 ()) wf1 wf2 | F32 -> printf "f_%sf(%s,%s,%s,%s)" f (c1 ~p:p12 ~q:p1 ()) (c2 ~p:p12 ~q:p1 ()) wf2 wf1 | F12 -> printf "f_f%s(%s,%s,%s,%s)" f (c1 ~p:p12 ~q:p1 ()) (c2 ~p:p12 ~q:p1 ()) wf1 wf2 | F21 -> printf "f_f%s(%s,%s,%s,%s)" f (c1 ~p:p12 ~q:p2 ()) (c2 ~p:p12 ~q:p2 ()) 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, VA3, Psi -> print_fermion_current coeff "va3" | 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" | _, 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_mom = function | coeff, Psibar, VLRM, Psi -> print_fermion_current_mom_v1 coeff "vlr" | coeff, Psibar, VAM, Psi -> print_fermion_current_mom_ff coeff "va" | coeff, Psibar, VA3M, Psi -> print_fermion_current_mom_ff coeff "va3" | coeff, Psibar, SPM, Psi -> print_fermion_current_mom_v1 coeff "sp" | coeff, Psibar, TVA, Psi -> print_fermion_current_mom_v1 coeff "tva" | coeff, Psibar, TVAM, Psi -> print_fermion_current_mom_v2 coeff "tvam" | coeff, Psibar, TLR, Psi -> print_fermion_current_mom_v1 coeff "tlr" | coeff, Psibar, TLRM, Psi -> print_fermion_current_mom_v2 coeff "tlrm" | coeff, Psibar, TRL, Psi -> print_fermion_current_mom_v1 coeff "trl" | coeff, Psibar, TRLM, Psi -> print_fermion_current_mom_v2 coeff "trlm" | _, Psibar, _, Psi -> invalid_arg "Targets.Fortran_Fermions: only sigma tensor coupling 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) (M : Model.T) = struct let require_library = Fermions.require_library @ [ "omega_vectors_2010_01_A"; "omega_polarizations_2010_01_A"; "omega_couplings_2010_01_A"; "omega_color_2010_01_A"; "omega_utils_2010_01_A" ] module CM = Colorize.It(M) module F = Fusion_Maker(P)(M) module CF = Fusion.Multi(Fusion_Maker)(P)(M) type amplitudes = CF.amplitudes open Coupling open Format type output_mode = | Single_Function | Single_Module of int | Single_File of int | Multi_File of int let line_length = ref 80 let continuation_lines = ref (-1) (* 255 *) let kind = ref "default" let fortran95 = ref true let module_name = ref "omega_amplitude" let output_mode = ref (Single_Module 10) let use_modules = ref [] let whizard = ref false let amp_triv = 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 km_2_write = ref false let km_2_pure = ref false let openmp = ref false let pure_unless_openmp = 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), "maximum line length"; "continuation", Arg.Int (fun l -> continuation_lines := l), "maximum # of continuation lines"; "module", Arg.String (fun s -> module_name := s), "module name"; "single_function", Arg.Unit (fun () -> output_mode := Single_Function), "compute the matrix element(s) in a monolithic function"; "split_function", Arg.Int (fun n -> output_mode := Single_Module n), "split the matrix element(s) into small functions [default, size = 10]"; "split_module", Arg.Int (fun n -> output_mode := Single_File n), "split the matrix element(s) into small modules"; "split_file", Arg.Int (fun n -> output_mode := Multi_File n), "split the matrix element(s) into small files"; "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"; "amp_triv", Arg.Set amp_triv, "only print trivial amplitude"; "no_write", Arg.Set no_write, "no 'write' statements"; "kmatrix_write", Arg.Set km_2_write, "write K matrix functions"; "kmatrix_2_write", Arg.Set km_write, "write K matrix 2 functions"; "kmatrix_write_pure", Arg.Set km_pure, "write K matrix pure functions"; "kmatrix_2_write_pure", Arg.Set km_2_pure, "write Kmatrix2pure functions"; "openmp", Arg.Set openmp, "activate OpenMP support in generated code"] (* Fortran style line continuation: *) let nl = Format_Fortran.newline let print_list = function | [] -> () | a :: rest -> print_string a; List.iter (fun s -> printf ",@ %s" s) rest (* \thocwmodulesubsection{Variables and Declarations} *) (* ["NC"] is already used up in the module ["constants"]: *) let nc_parameter = "N_" let omega_color_factor_abbrev = "OCF" let openmp_tld_type = "thread_local_data" let openmp_tld = "tld" let flavors_symbol ?(decl = false) flavors = (if !openmp && not decl then openmp_tld ^ "%" else "" ) ^ "oks_" ^ 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) let add_tag wf name = match F.wf_tag wf with | None -> name | Some tag -> name ^ "_" ^ tag let variable ?(decl = false) wf = (if !openmp && not decl then openmp_tld ^ "%" else "") ^ add_tag wf ("owf_" ^ 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 ?(decl = false) wf i = variable ~decl wf ^ "_X" ^ string_of_int i let multiple_variable ?(decl = false) amplitude dictionary wf = try format_multiple_variable ~decl wf (dictionary amplitude wf) with | Not_found -> variable wf let multiple_variables ?(decl = false) multiplicity wf = try List.map (format_multiple_variable ~decl wf) (ThoList.range 1 (multiplicity wf)) with | Not_found -> [variable ~decl wf] let declaration_chunk_size = 64 let declare_list_chunk multiplicity t = function | [] -> () | wfs -> printf " @[<2>%s :: " t; print_list (ThoList.flatmap (multiple_variables ~decl:true multiplicity) wfs); nl () let declare_list multiplicity t = function | [] -> () | wfs -> List.iter (declare_list_chunk multiplicity t) (ThoList.chopn declaration_chunk_size wfs) 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 schisma = ThoList.chopn let schisma_num i n l = ThoList.enumerate i (schisma n l) 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 () (* NB: we use [string_of_float] to make sure that a decimal point is included to make Fortran compilers happy. *) let default_parameter (x, v) = printf "@ %s = %s_%s" (CM.constant_symbol x) (string_of_float 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 format_constant = function | I -> "(0,1)" | Integer c -> if c < 0 then sprintf "(%d.0_%s)" c !kind else sprintf "%d.0_%s" c !kind | Float x -> if x < 0. then sprintf "(%g_%s)" x !kind else sprintf "%g_%s" x !kind | _ -> invalid_arg "format_constant" let rec eval_parameter' = function | (I | Integer _ | Float _) as c -> printf "%s" (format_constant c) | 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 ")" | PowX (x, y) -> printf "@,("; eval_parameter' x; printf "**"; eval_parameter' y; 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 ")" | Asin x -> printf "@,asin ("; eval_parameter' x; printf ")" | Acos x -> printf "@,acos ("; eval_parameter' x; printf ")" | Atan x -> printf "@,atan ("; eval_parameter' x; printf ")" | Atan2 (y, x) -> printf "@,atan2 ("; eval_parameter' y; printf ",@ "; eval_parameter' x; printf ")" | Sinh x -> printf "@,sinh ("; eval_parameter' x; printf ")" | Cosh x -> printf "@,cosh ("; eval_parameter' x; printf ")" | Tanh x -> printf "@,tanh ("; eval_parameter' x; printf ")" | Exp x -> printf "@,exp ("; eval_parameter' x; printf ")" | Log x -> printf "@,log ("; eval_parameter' x; printf ")" | Log10 x -> printf "@,log10 ("; eval_parameter' x; printf ")" | Conj (Integer _ | Float _ as x) -> eval_parameter' x | Conj x -> printf "@,cconjg ("; 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_%03d ()" n; nl (); List.iter eval_parameter l; printf " end subroutine setup_parameters_%03d" 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_%03d ()" n; nl (); List.iter eval_parameter_pair l; printf " end subroutine setup_parameters_%03d" 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 contains params couplings = List.exists (fun (name, _) -> List.mem (CM.constant_symbol name) params) couplings.input let rec depends_on params = function | I | Integer _ | Float _ -> false | Atom name -> List.mem (CM.constant_symbol name) params | Sum es | Prod es -> List.exists (depends_on params) es | Diff (e1, e2) | Quot (e1, e2) | PowX (e1, e2) -> depends_on params e1 || depends_on params e2 | Neg e | Rec e | Pow (e, _) -> depends_on params e | Sqrt e | Exp e | Log e | Log10 e | Sin e | Cos e | Tan e | Cot e | Asin e | Acos e | Atan e | Sinh e | Cosh e | Tanh e | Conj e -> depends_on params e | Atan2 (e1, e2) -> depends_on params e1 || depends_on params e2 let dependencies params couplings = if contains params couplings then List.rev (fst (List.fold_left (fun (deps, plist) (param, v) -> match param with | Real name | Complex name -> if depends_on plist v then ((param, v) :: deps, CM.constant_symbol name :: plist) else (deps, plist)) ([], params) couplings.derived)) else [] let dependencies_arrays params couplings = if contains params couplings then List.rev (fst (List.fold_left (fun (deps, plist) (param, vlist) -> match param with | Real_Array name | Complex_Array name -> if List.exists (depends_on plist) vlist then ((param, vlist) :: deps, CM.constant_symbol name :: plist) else (deps, plist)) ([], params) couplings.derived_arrays)) else [] let parameters_to_fortran oc params = Format_Fortran.set_formatter_out_channel ~width:!line_length oc; let declarations = classify_parameters params in printf "module %s" !parameter_module; nl (); printf " use kinds"; nl (); printf " use constants"; nl (); printf " implicit none"; nl (); printf " private"; nl (); printf " @[<2>public :: setup_parameters"; printf ",@ import_from_whizard"; printf ",@ model_update_alpha_s"; if !no_write then begin printf "! No print_parameters"; end else begin printf ",@ print_parameters"; end; nl (); 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 " interface cconjg"; nl (); printf " module procedure cconjg_real, cconjg_complex"; nl (); printf " end interface"; nl (); printf " private :: cconjg_real, cconjg_complex"; nl (); printf "contains"; nl (); printf " function cconjg_real (x) result (xc)"; nl (); printf " real(kind=default), intent(in) :: x"; nl (); printf " real(kind=default) :: xc"; nl (); printf " xc = x"; nl (); printf " end function cconjg_real"; nl (); printf " function cconjg_complex (z) result (zc)"; nl (); printf " complex(kind=default), intent(in) :: z"; nl (); printf " complex(kind=default) :: zc"; nl (); printf " zc = conjg (z)"; nl (); printf " end function cconjg_complex"; 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 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 (); for i = 1 to num_sub + num_sub_arrays do printf " call setup_parameters_%03d ()" i; nl (); done; printf " end subroutine setup_parameters"; nl (); printf " subroutine import_from_whizard (par_array, scheme)"; nl (); printf " real(%s), dimension(%d), intent(in) :: par_array" !kind (List.length params.input); nl (); printf " integer, intent(in) :: scheme"; nl (); let i = ref 1 in List.iter (fun (p, _) -> printf " %s = par_array(%d)" (CM.constant_symbol p) !i; nl (); incr i) params.input; printf " call setup_parameters ()"; nl (); printf " end subroutine import_from_whizard"; nl (); printf " subroutine model_update_alpha_s (alpha_s)"; nl (); printf " real(%s), intent(in) :: alpha_s" !kind; nl (); begin match (dependencies ["aS"] params, dependencies_arrays ["aS"] params) with | [], [] -> printf " ! 'aS' not among the input parameters"; nl (); | deps, deps_arrays -> printf " aS = alpha_s"; nl (); List.iter eval_parameter deps; List.iter eval_parameter_pair deps_arrays end; printf " end subroutine model_update_alpha_s"; 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 () (* \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_chunk = function | [] -> () | momenta -> printf " @[<2>type(momentum) :: "; print_list (List.map format_momentum momenta); nl () let declare_momenta = function | [] -> () | momenta -> List.iter declare_momenta_chunk (ThoList.chopn declaration_chunk_size momenta) let declare_wavefunctions multiplicity wfs = let wfs' = classify_wfs wfs in declare_list multiplicity ("complex(kind=" ^ !kind ^ ")") (wfs'.scalars @ wfs'.brs_scalars); declare_list multiplicity ("type(" ^ Fermions.psi_type ^ ")") (wfs'.spinors @ wfs'.brs_spinors); declare_list multiplicity ("type(" ^ Fermions.psibar_type ^ ")") (wfs'.conjspinors @ wfs'.brs_conjspinors); declare_list multiplicity ("type(" ^ Fermions.chi_type ^ ")") (wfs'.realspinors @ wfs'.brs_realspinors @ wfs'.ghostspinors); declare_list multiplicity ("type(" ^ Fermions.grav_type ^ ")") wfs'.vectorspinors; declare_list multiplicity "type(vector)" (wfs'.vectors @ wfs'.massive_vectors @ wfs'.brs_vectors @ wfs'.brs_massive_vectors @ wfs'.ward_vectors); declare_list multiplicity "type(tensor2odd)" wfs'.tensors_1; declare_list multiplicity "type(tensor)" wfs'.tensors_2 let flavors a = F.incoming a @ F.outgoing a let declare_brakets_chunk = function | [] -> () | amplitudes -> printf " @[<2>complex(kind=%s) :: " !kind; print_list (List.map (fun a -> flavors_symbol ~decl:true (flavors a)) amplitudes); nl () let declare_brakets = function | [] -> () | amplitudes -> List.iter declare_brakets_chunk (ThoList.chopn declaration_chunk_size amplitudes) let print_variable_declarations amplitudes = let multiplicity = CF.multiplicity amplitudes and processes = CF.processes amplitudes in if not !amp_triv then begin 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 processes)); 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 processes)); if !openmp then begin printf " type %s@[<2>" openmp_tld_type; nl (); end ; declare_wavefunctions multiplicity (WFSet.elements (List.fold_left (fun set a -> WFSet.union set (List.fold_right WFSet.add (F.externals a) WFSet.empty)) WFSet.empty processes)); declare_wavefunctions multiplicity (WFSet.elements (List.fold_left (fun set a -> WFSet.union set (List.fold_right WFSet.add (F.variables a) WFSet.empty)) WFSet.empty processes)); declare_brakets processes; if !openmp then begin printf "@] end type %s\n" openmp_tld_type; printf " type(%s) :: %s" openmp_tld_type openmp_tld; nl (); end; end (* [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_vector4_t_0 c wf1 p1 wf2 p2 wf3 p3 fusion (coeff, contraction) = match contraction, fusion with | C_12_34, (F234|F243|F134|F143|F421|F321|F412|F312) | C_13_42, (F324|F342|F124|F142|F431|F231|F413|F213) | C_14_23, (F423|F432|F123|F132|F341|F241|F314|F214) -> printf "g_dim8g3_t_0(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 wf3 p3 | C_12_34, (F324|F314|F423|F413|F142|F132|F241|F231) | C_13_42, (F234|F214|F432|F412|F143|F123|F341|F321) | C_14_23, (F243|F213|F342|F312|F134|F124|F431|F421) -> printf "g_dim8g3_t_0(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 wf3 p3 | C_12_34, (F342|F341|F432|F431|F124|F123|F214|F213) | C_13_42, (F243|F241|F423|F421|F134|F132|F314|F312) | C_14_23, (F234|F231|F324|F321|F143|F142|F413|F412) -> printf "g_dim8g3_t_0(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf1 p1 wf2 p2 let print_vector4_t_1 c wf1 p1 wf2 p2 wf3 p3 fusion (coeff, contraction) = match contraction, fusion with | C_12_34, (F234|F243|F134|F143|F421|F321|F412|F312) | C_13_42, (F324|F342|F124|F142|F431|F231|F413|F213) | C_14_23, (F423|F432|F123|F132|F341|F241|F314|F214) -> printf "g_dim8g3_t_1(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 wf3 p3 | C_12_34, (F324|F314|F423|F413|F142|F132|F241|F231) | C_13_42, (F234|F214|F432|F412|F143|F123|F341|F321) | C_14_23, (F243|F213|F342|F312|F134|F124|F431|F421) -> printf "g_dim8g3_t_1(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 wf3 p3 | C_12_34, (F342|F341|F432|F431|F124|F123|F214|F213) | C_13_42, (F243|F241|F423|F421|F134|F132|F314|F312) | C_14_23, (F234|F231|F324|F321|F143|F142|F413|F412) -> printf "g_dim8g3_t_1(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf1 p1 wf2 p2 let print_vector4_t_2 c wf1 p1 wf2 p2 wf3 p3 fusion (coeff, contraction) = match contraction, fusion with | C_12_34, (F234|F243|F134|F143|F421|F321|F412|F312) | C_13_42, (F324|F342|F124|F142|F431|F231|F413|F213) | C_14_23, (F423|F432|F123|F132|F341|F241|F314|F214) -> printf "g_dim8g3_t_2(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 wf3 p3 | C_12_34, (F324|F314|F423|F413|F142|F132|F241|F231) | C_13_42, (F234|F214|F432|F412|F143|F123|F341|F321) | C_14_23, (F243|F213|F342|F312|F134|F124|F431|F421) -> printf "g_dim8g3_t_2(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 wf3 p3 | C_12_34, (F342|F341|F432|F431|F124|F123|F214|F213) | C_13_42, (F243|F241|F423|F421|F134|F132|F314|F312) | C_14_23, (F234|F231|F324|F321|F143|F142|F413|F412) -> printf "g_dim8g3_t_2(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf1 p1 wf2 p2 let print_vector4_m_0 c wf1 p1 wf2 p2 wf3 p3 fusion (coeff, contraction) = match contraction, fusion with | C_12_34, (F234|F243|F134|F143|F421|F321|F412|F312) | C_13_42, (F324|F342|F124|F142|F431|F231|F413|F213) | C_14_23, (F423|F432|F123|F132|F341|F241|F314|F214) -> printf "g_dim8g3_m_0(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 wf3 p3 | C_12_34, (F324|F314|F423|F413|F142|F132|F241|F231) | C_13_42, (F234|F214|F432|F412|F143|F123|F341|F321) | C_14_23, (F243|F213|F342|F312|F134|F124|F431|F421) -> printf "g_dim8g3_m_0(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 wf3 p3 | C_12_34, (F342|F341|F432|F431|F124|F123|F214|F213) | C_13_42, (F243|F241|F423|F421|F134|F132|F314|F312) | C_14_23, (F234|F231|F324|F321|F143|F142|F413|F412) -> printf "g_dim8g3_m_0(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf1 p1 wf2 p2 let print_vector4_m_1 c wf1 p1 wf2 p2 wf3 p3 fusion (coeff, contraction) = match contraction, fusion with | C_12_34, (F234|F243|F134|F143|F421|F321|F412|F312) | C_13_42, (F324|F342|F124|F142|F431|F231|F413|F213) | C_14_23, (F423|F432|F123|F132|F341|F241|F314|F214) -> printf "g_dim8g3_m_1(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 wf3 p3 | C_12_34, (F324|F314|F423|F413|F142|F132|F241|F231) | C_13_42, (F234|F214|F432|F412|F143|F123|F341|F321) | C_14_23, (F243|F213|F342|F312|F134|F124|F431|F421) -> printf "g_dim8g3_m_1(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 wf3 p3 | C_12_34, (F342|F341|F432|F431|F124|F123|F214|F213) | C_13_42, (F243|F241|F423|F421|F134|F132|F314|F312) | C_14_23, (F234|F231|F324|F321|F143|F142|F413|F412) -> printf "g_dim8g3_m_1(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf1 p1 wf2 p2 let print_vector4_m_7 c wf1 p1 wf2 p2 wf3 p3 fusion (coeff, contraction) = match contraction, fusion with | C_12_34, (F234|F243|F134|F143|F421|F321|F412|F312) | C_13_42, (F324|F342|F124|F142|F431|F231|F413|F213) | C_14_23, (F423|F432|F123|F132|F341|F241|F314|F214) -> printf "g_dim8g3_m_7(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 wf3 p3 | C_12_34, (F324|F314|F423|F413|F142|F132|F241|F231) | C_13_42, (F234|F214|F432|F412|F143|F123|F341|F321) | C_14_23, (F243|F213|F342|F312|F134|F124|F431|F421) -> printf "g_dim8g3_m_7(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 wf3 p3 | C_12_34, (F342|F341|F432|F431|F124|F123|F214|F213) | C_13_42, (F243|F241|F423|F421|F134|F132|F314|F312) | C_14_23, (F234|F231|F324|F321|F143|F142|F413|F412) -> printf "g_dim8g3_m_7(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf1 p1 wf2 p2 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_vector4_km_t_0 c pa pb wf1 p1 wf2 p2 wf3 p3 fusion (coeff, contraction) = match contraction, fusion with | C_12_34, (F234|F243|F134|F143|F421|F321|F412|F312) | C_13_42, (F324|F342|F124|F142|F431|F231|F413|F213) | C_14_23, (F423|F432|F123|F132|F341|F241|F314|F214) -> printf "@[(%s%s%s+%s)*g_dim8g3_t_0(cmplx(1,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf1 p1 wf2 p2 wf3 p3 | C_12_34, (F324|F314|F423|F413|F142|F132|F241|F231) | C_13_42, (F234|F214|F432|F412|F143|F123|F341|F321) | C_14_23, (F243|F213|F342|F312|F134|F124|F431|F421) -> printf "@[(%s%s%s+%s)*g_dim8g3_t_0(cmplx(1,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf2 p2 wf1 p1 wf3 p3 | C_12_34, (F342|F341|F432|F431|F124|F123|F214|F213) | C_13_42, (F243|F241|F423|F421|F134|F132|F314|F312) | C_14_23, (F234|F231|F324|F321|F143|F142|F413|F412) -> printf "@[(%s%s%s+%s)*g_dim8g3_t_0(cmplx(1,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf3 p3 wf1 p1 wf2 p2 let print_vector4_km_t_1 c pa pb wf1 p1 wf2 p2 wf3 p3 fusion (coeff, contraction) = match contraction, fusion with | C_12_34, (F234|F243|F134|F143|F421|F321|F412|F312) | C_13_42, (F324|F342|F124|F142|F431|F231|F413|F213) | C_14_23, (F423|F432|F123|F132|F341|F241|F314|F214) -> printf "@[(%s%s%s+%s)*g_dim8g3_t_1(cmplx(1,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf1 p1 wf2 p2 wf3 p3 | C_12_34, (F324|F314|F423|F413|F142|F132|F241|F231) | C_13_42, (F234|F214|F432|F412|F143|F123|F341|F321) | C_14_23, (F243|F213|F342|F312|F134|F124|F431|F421) -> printf "@[(%s%s%s+%s)*g_dim8g3_t_1(cmplx(1,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf2 p2 wf1 p1 wf3 p3 | C_12_34, (F342|F341|F432|F431|F124|F123|F214|F213) | C_13_42, (F243|F241|F423|F421|F134|F132|F314|F312) | C_14_23, (F234|F231|F324|F321|F143|F142|F413|F412) -> printf "@[(%s%s%s+%s)*g_dim8g3_t_1(cmplx(1,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf3 p3 wf1 p1 wf2 p2 let print_vector4_km_t_2 c pa pb wf1 p1 wf2 p2 wf3 p3 fusion (coeff, contraction) = match contraction, fusion with | C_12_34, (F234|F243|F134|F143|F421|F321|F412|F312) | C_13_42, (F324|F342|F124|F142|F431|F231|F413|F213) | C_14_23, (F423|F432|F123|F132|F341|F241|F314|F214) -> printf "@[(%s%s%s+%s)*g_dim8g3_t_2(cmplx(1,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf1 p1 wf2 p2 wf3 p3 | C_12_34, (F324|F314|F423|F413|F142|F132|F241|F231) | C_13_42, (F234|F214|F432|F412|F143|F123|F341|F321) | C_14_23, (F243|F213|F342|F312|F134|F124|F431|F421) -> printf "@[(%s%s%s+%s)*g_dim8g3_t_2(cmplx(1,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf2 p2 wf1 p1 wf3 p3 | C_12_34, (F342|F341|F432|F431|F124|F123|F214|F213) | C_13_42, (F243|F241|F423|F421|F134|F132|F314|F312) | C_14_23, (F234|F231|F324|F321|F143|F142|F413|F412) -> printf "@[(%s%s%s+%s)*g_dim8g3_t_2(cmplx(1,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf3 p3 wf1 p1 wf2 p2 let print_vector4_km_t_rsi c pa pb pc wf1 p1 wf2 p2 wf3 p3 fusion (coeff, contraction) = match contraction, fusion with | C_12_34, (F234|F243|F134|F143|F421|F321|F412|F312) | C_13_42, (F324|F342|F124|F142|F431|F231|F413|F213) | C_14_23, (F423|F432|F123|F132|F341|F241|F314|F214) -> printf "@[(%s%s%s+%s)*g_dim8g3_t_0(cmplx(1,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf1 p1 wf2 p2 wf3 p3 | C_12_34, (F324|F314|F423|F413|F142|F132|F241|F231) | C_13_42, (F234|F214|F432|F412|F143|F123|F341|F321) | C_14_23, (F243|F213|F342|F312|F134|F124|F431|F421) -> printf "@[(%s%s%s+%s)*g_dim8g3_t_0(cmplx(1,kind=default),@ %s,%s,%s,%s,%s,%s))*((%s+%s)*(%s+%s)/((%s+%s)*(%s+%s)))@]" (format_coeff coeff) c pa pb wf2 p2 wf1 p1 wf3 p3 pa pb pa pb pb pc pb pc | C_12_34, (F342|F341|F432|F431|F124|F123|F214|F213) | C_13_42, (F243|F241|F423|F421|F134|F132|F314|F312) | C_14_23, (F234|F231|F324|F321|F143|F142|F413|F412) -> printf "@[(%s%s%s+%s)*g_dim8g3_t_0(cmplx(1,kind=default),@ %s,%s,%s,%s,%s,%s))*((%s+%s)*(%s+%s)/((%s+%s)*(%s+%s)))@]" (format_coeff coeff) c pa pb wf3 p3 wf1 p1 wf2 p2 pa pb pa pb pa pc pa pc let print_vector4_km_m_0 c pa pb wf1 p1 wf2 p2 wf3 p3 fusion (coeff, contraction) = match contraction, fusion with | C_12_34, (F234|F243|F134|F143|F421|F321|F412|F312) | C_13_42, (F324|F342|F124|F142|F431|F231|F413|F213) | C_14_23, (F423|F432|F123|F132|F341|F241|F314|F214) -> if (String.contains c 'w' || String.contains c '4') then printf "@[(%s%s%s+%s)*g_dim8g3_m_0(cmplx(1,kind=default),cmplx(1,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf1 p1 wf2 p2 wf3 p3 else printf "@[((%s%s%s+%s))*g_dim8g3_m_0(cmplx(costhw**(-2),kind=default),cmplx(costhw**2,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf1 p1 wf2 p2 wf3 p3 | C_12_34, (F324|F314|F423|F413|F142|F132|F241|F231) | C_13_42, (F234|F214|F432|F412|F143|F123|F341|F321) | C_14_23, (F243|F213|F342|F312|F134|F124|F431|F421) -> if (String.contains c 'w' || String.contains c '4') then printf "@[(%s%s%s+%s)*g_dim8g3_m_0(cmplx(1,kind=default),cmplx(1,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf2 p2 wf1 p1 wf3 p3 else printf "@[(%s%s%s+%s)*g_dim8g3_m_0(cmplx(costhw**(-2),kind=default),cmplx(costhw**2,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf2 p2 wf1 p1 wf3 p3 | C_12_34, (F342|F341|F432|F431|F124|F123|F214|F213) | C_13_42, (F243|F241|F423|F421|F134|F132|F314|F312) | C_14_23, (F234|F231|F324|F321|F143|F142|F413|F412) -> if (String.contains c 'w' || String.contains c '4') then printf "@[(%s%s%s+%s)*g_dim8g3_m_0(cmplx(1,kind=default),cmplx(1,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf3 p3 wf1 p1 wf2 p2 else printf "@[(%s%s%s+%s)*g_dim8g3_m_0(cmplx(costhw**(-2),kind=default),cmplx(costhw**2,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf3 p3 wf1 p1 wf2 p2 let print_vector4_km_m_1 c pa pb wf1 p1 wf2 p2 wf3 p3 fusion (coeff, contraction) = match contraction, fusion with | C_12_34, (F234|F243|F134|F143|F421|F321|F412|F312) | C_13_42, (F324|F342|F124|F142|F431|F231|F413|F213) | C_14_23, (F423|F432|F123|F132|F341|F241|F314|F214) -> if (String.contains c 'w' || String.contains c '4') then printf "@[(%s%s%s+%s)*g_dim8g3_m_1(cmplx(1,kind=default),cmplx(1,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf1 p1 wf2 p2 wf3 p3 else printf "@[(%s%s%s+%s)*g_dim8g3_m_1(cmplx(costhw**(-2),kind=default),cmplx(costhw**2,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf1 p1 wf2 p2 wf3 p3 | C_12_34, (F324|F314|F423|F413|F142|F132|F241|F231) | C_13_42, (F234|F214|F432|F412|F143|F123|F341|F321) | C_14_23, (F243|F213|F342|F312|F134|F124|F431|F421) -> if (String.contains c 'w' || String.contains c '4') then printf "@[(%s%s%s+%s)*g_dim8g3_m_1(cmplx(1,kind=default),cmplx(1,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf2 p2 wf1 p1 wf3 p3 else printf "@[(%s%s%s+%s)*g_dim8g3_m_1(cmplx(costhw**(-2),kind=default),cmplx(costhw**2,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf2 p2 wf1 p1 wf3 p3 | C_12_34, (F342|F341|F432|F431|F124|F123|F214|F213) | C_13_42, (F243|F241|F423|F421|F134|F132|F314|F312) | C_14_23, (F234|F231|F324|F321|F143|F142|F413|F412) -> if (String.contains c 'w' || String.contains c '4') then printf "@[(%s%s%s+%s)*g_dim8g3_m_1(cmplx(1,kind=default),cmplx(1,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf3 p3 wf1 p1 wf2 p2 else printf "@[(%s%s%s+%s)*g_dim8g3_m_1(cmplx(costhw**(-2),kind=default),cmplx(costhw**2,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf3 p3 wf1 p1 wf2 p2 let print_vector4_km_m_7 c pa pb wf1 p1 wf2 p2 wf3 p3 fusion (coeff, contraction) = match contraction, fusion with | C_12_34, (F234|F243|F134|F143|F421|F321|F412|F312) | C_13_42, (F324|F342|F124|F142|F431|F231|F413|F213) | C_14_23, (F423|F432|F123|F132|F341|F241|F314|F214) -> if (String.contains c 'w' || String.contains c '4') then printf "@[(%s%s%s+%s)*@ g_dim8g3_m_7(cmplx(1,kind=default),cmplx(1,kind=default),cmplx(1,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf1 p1 wf2 p2 wf3 p3 else printf "@[(%s%s%s+%s)*@ g_dim8g3_m_7(cmplx(costhw**(-2),kind=default),cmplx(1,kind=default),cmplx(costhw**2,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf1 p1 wf2 p2 wf3 p3 | C_12_34, (F324|F314|F423|F413|F142|F132|F241|F231) | C_13_42, (F234|F214|F432|F412|F143|F123|F341|F321) | C_14_23, (F243|F213|F342|F312|F134|F124|F431|F421) -> if (String.contains c 'w' || String.contains c '4') then printf "@[(%s%s%s+%s)*@ g_dim8g3_m_7(cmplx(1,kind=default),cmplx(1,kind=default),cmplx(1,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf2 p2 wf1 p1 wf3 p3 else printf "@[(%s%s%s+%s)*@ g_dim8g3_m_7(cmplx(costhw**(-2),kind=default),cmplx(1,kind=default),cmplx(costhw**2,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf2 p2 wf1 p1 wf3 p3 | C_12_34, (F342|F341|F432|F431|F124|F123|F214|F213) | C_13_42, (F243|F241|F423|F421|F134|F132|F314|F312) | C_14_23, (F234|F231|F324|F321|F143|F142|F413|F412) -> if (String.contains c 'w' || String.contains c '4') then printf "@[(%s%s%s+%s)*@ g_dim8g3_m_7(cmplx(1,kind=default),cmplx(1,kind=default),cmplx(1,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf3 p3 wf1 p1 wf2 p2 else printf "@[(%s%s%s+%s)*@ g_dim8g3_m_7(cmplx(costhw**(-2),kind=default),cmplx(1,kind=default),cmplx(costhw**2,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf3 p3 wf1 p1 wf2 p2 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) = match contraction, fusion with | C_12_34, (F123|F213|F124|F214) -> printf "(%s%s)*(%s*%s)*(%s*%s)*%s" (format_coeff coeff) c p1 p2 wf1 wf2 wf3 | C_12_34, (F134|F143|F234|F243) -> printf "(%s%s)*(%s*%s)*(%s*%s)*%s" (format_coeff coeff) c p1 p123 wf2 wf3 wf1 | C_12_34, (F132|F231|F142|F241) -> printf "(%s%s)*(%s*%s)*(%s*%s)*%s" (format_coeff coeff) c p1 p3 wf1 wf3 wf2 | 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, (F314|F413|F324|F423) -> printf "(%s%s)*(%s*%s)*(%s*%s)*%s" (format_coeff coeff) c p2 p123 wf1 wf3 wf2 | C_12_34, (F341|F431|F342|F432) -> printf "(%s%s)*(%s*%s)*(%s*%s)*%s" (format_coeff coeff) c p3 p123 wf1 wf2 wf3 | C_13_42, (F123|F214) | C_14_23, (F124|F213) -> printf "((%s%s)*(%s*%s*%s)*%s*%s)" (format_coeff coeff) c wf1 p1 wf3 wf2 p2 | C_13_42, (F124|F213) | C_14_23, (F123|F214) -> printf "((%s%s)*(%s*%s*%s)*%s*%s)" (format_coeff coeff) c wf2 p2 wf3 wf1 p1 | C_13_42, (F132|F241) | C_14_23, (F142|F231) -> printf "((%s%s)*(%s*%s*%s)*%s*%s)" (format_coeff coeff) c wf1 p1 wf2 wf3 p3 | C_13_42, (F142|F231) | C_14_23, (F132|F241) -> printf "((%s%s)*(%s*%s*%s)*%s*%s)" (format_coeff coeff) c wf3 p3 wf2 wf1 p1 | C_13_42, (F312|F421) | C_14_23, (F412|F321) -> printf "((%s%s)*(%s*%s*%s)*%s*%s)" (format_coeff coeff) c wf2 p2 wf1 wf3 p3 | C_13_42, (F321|F412) | C_14_23, (F421|F312) -> printf "((%s%s)*(%s*%s*%s)*%s*%s)" (format_coeff coeff) c wf3 p3 wf1 wf2 p2 | C_13_42, (F134|F243) | C_14_23, (F143|F234) -> printf "((%s%s)*(%s*%s)*(%s*%s*%s))" (format_coeff coeff) c wf3 p123 wf1 p1 wf2 | C_13_42, (F143|F234) | C_14_23, (F134|F243) -> printf "((%s%s)*(%s*%s)*(%s*%s*%s))" (format_coeff coeff) c wf2 p123 wf1 p1 wf3 | C_13_42, (F314|F423) | C_14_23, (F413|F324) -> printf "((%s%s)*(%s*%s)*(%s*%s*%s))" (format_coeff coeff) c wf3 p123 wf2 p2 wf1 | C_13_42, (F324|F413) | C_14_23, (F423|F314) -> printf "((%s%s)*(%s*%s)*(%s*%s*%s))" (format_coeff coeff) c wf1 p123 wf2 p2 wf3 | C_13_42, (F341|F432) | C_14_23, (F431|F342) -> printf "((%s%s)*(%s*%s)*(%s*%s*%s))" (format_coeff coeff) c wf2 p123 wf3 p3 wf1 | C_13_42, (F342|F431) | C_14_23, (F432|F341) -> printf "((%s%s)*(%s*%s)*(%s*%s*%s))" (format_coeff coeff) c wf1 p123 wf3 p3 wf2 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_dscalar2_vector2_km c pa pb wf1 wf2 wf3 p1 p2 p3 p123 fusion (coeff, contraction) = match contraction, fusion with | C_12_34, (F123|F213|F124|F214) -> printf "(%s%s%s+%s))*(%s*%s)*(%s*%s)*%s" (format_coeff coeff) c pa pb p1 p2 wf1 wf2 wf3 | C_12_34, (F134|F143|F234|F243) -> printf "(%s%s%s+%s))*(%s*%s)*(%s*%s)*%s" (format_coeff coeff) c pa pb p1 p123 wf2 wf3 wf1 | C_12_34, (F132|F231|F142|F241) -> printf "(%s%s%s+%s))*(%s*%s)*(%s*%s)*%s" (format_coeff coeff) c pa pb p1 p3 wf1 wf3 wf2 | C_12_34, (F312|F321|F412|F421) -> printf "(%s%s%s+%s))*(%s*%s)*(%s*%s)*%s" (format_coeff coeff) c pa pb p2 p3 wf2 wf3 wf1 | C_12_34, (F314|F413|F324|F423) -> printf "(%s%s%s+%s))*(%s*%s)*(%s*%s)*%s" (format_coeff coeff) c pa pb p2 p123 wf1 wf3 wf2 | C_12_34, (F341|F431|F342|F432) -> printf "(%s%s%s+%s))*(%s*%s)*(%s*%s)*%s" (format_coeff coeff) c pa pb p3 p123 wf1 wf2 wf3 | C_13_42, (F123|F214) | C_14_23, (F124|F213) -> printf "((%s%s%s+%s))*(%s*%s*%s)*%s*%s)" (format_coeff coeff) c pa pb wf1 p1 wf3 wf2 p2 | C_13_42, (F124|F213) | C_14_23, (F123|F214) -> printf "((%s%s%s+%s))*(%s*%s*%s)*%s*%s)" (format_coeff coeff) c pa pb wf2 p2 wf3 wf1 p1 | C_13_42, (F132|F241) | C_14_23, (F142|F231) -> printf "((%s%s%s+%s))*(%s*%s*%s)*%s*%s)" (format_coeff coeff) c pa pb wf1 p1 wf2 wf3 p3 | C_13_42, (F142|F231) | C_14_23, (F132|F241) -> printf "((%s%s%s+%s))*(%s*%s*%s)*%s*%s)" (format_coeff coeff) c pa pb wf3 p3 wf2 wf1 p1 | C_13_42, (F312|F421) | C_14_23, (F412|F321) -> printf "((%s%s%s+%s))*(%s*%s*%s)*%s*%s)" (format_coeff coeff) c pa pb wf2 p2 wf1 wf3 p3 | C_13_42, (F321|F412) | C_14_23, (F421|F312) -> printf "((%s%s%s+%s))*(%s*%s*%s)*%s*%s)" (format_coeff coeff) c pa pb wf3 p3 wf1 wf2 p2 | C_13_42, (F134|F243) | C_14_23, (F143|F234) -> printf "((%s%s%s+%s))*(%s*%s)*(%s*%s*%s))" (format_coeff coeff) c pa pb wf3 p123 wf1 p1 wf2 | C_13_42, (F143|F234) | C_14_23, (F134|F243) -> printf "((%s%s%s+%s))*(%s*%s)*(%s*%s*%s))" (format_coeff coeff) c pa pb wf2 p123 wf1 p1 wf3 | C_13_42, (F314|F423) | C_14_23, (F413|F324) -> printf "((%s%s%s+%s))*(%s*%s)*(%s*%s*%s))" (format_coeff coeff) c pa pb wf3 p123 wf2 p2 wf1 | C_13_42, (F324|F413) | C_14_23, (F423|F314) -> printf "((%s%s%s+%s))*(%s*%s)*(%s*%s*%s))" (format_coeff coeff) c pa pb wf1 p123 wf2 p2 wf3 | C_13_42, (F341|F432) | C_14_23, (F431|F342) -> printf "((%s%s%s+%s))*(%s*%s)*(%s*%s*%s))" (format_coeff coeff) c pa pb wf2 p123 wf3 p3 wf1 | C_13_42, (F342|F431) | C_14_23, (F432|F341) -> printf "((%s%s%s+%s))*(%s*%s)*(%s*%s*%s))" (format_coeff coeff) c pa pb wf1 p123 wf3 p3 wf2 let print_add_dscalar2_vector2_km c pa pb wf1 wf2 wf3 p1 p2 p3 p123 fusion (coeff, contraction) = printf "@ + "; print_dscalar2_vector2_km c pa pb wf1 wf2 wf3 p1 p2 p3 p123 fusion (coeff, contraction) let print_dscalar2_vector2_m_0_km c pa pb wf1 wf2 wf3 p1 p2 p3 fusion (coeff, contraction) = match contraction, fusion with | C_12_34, (F123|F213|F124|F214) -> printf "@[((%s%s%s+%s))*v_phi2v_m_0(cmplx(1,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf1 p1 wf2 p2 wf3 p3 | C_12_34, (F134|F143|F234|F243) -> printf "@[((%s%s%s+%s))*phi_phi2v_m_0(cmplx(1,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf1 p1 wf2 p2 wf3 p3 | C_12_34, (F132|F231|F142|F241) -> printf "@[((%s%s%s+%s))*v_phi2v_m_0(cmplx(1,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf1 p1 wf3 p3 wf2 p2 | C_12_34, (F312|F321|F412|F421) -> printf "@[((%s%s%s+%s))*v_phi2v_m_0(cmplx(1,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf3 p3 wf2 p2 wf1 p1 | C_12_34, (F314|F413|F324|F423) -> printf "@[((%s%s%s+%s))*phi_phi2v_m_0(cmplx(1,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf2 p2 wf1 p1 wf3 p3 | C_12_34, (F341|F431|F342|F432) -> printf "@[((%s%s%s+%s))*phi_phi2v_m_0(cmplx(1,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf3 p3 wf2 p2 wf1 p1 | C_13_42, (F123|F214) | C_14_23, (F124|F213) -> printf "@[((%s%s%s+%s))*v_phi2v_m_0(cmplx(1,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf1 p1 wf2 p3 wf3 p2 | C_13_42, (F124|F213) | C_14_23, (F123|F214) -> printf "@[((%s%s%s+%s))*v_phi2v_m_0(cmplx(1,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf2 p2 wf1 p3 wf3 p1 | C_13_42, (F132|F241) | C_14_23, (F142|F231) -> printf "@[((%s%s%s+%s))*v_phi2v_m_0(cmplx(1,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf1 p1 wf3 p2 wf2 p3 | C_13_42, (F142|F231) | C_14_23, (F132|F241) -> printf "@[((%s%s%s+%s))*v_phi2v_m_0(cmplx(1,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf3 p3 wf1 p2 wf2 p1 | C_13_42, (F312|F421) | C_14_23, (F412|F321) -> printf "@[((%s%s%s+%s))*v_phi2v_m_0(cmplx(1,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf2 p2 wf3 p1 wf1 p3 | C_13_42, (F321|F412) | C_14_23, (F421|F312) -> printf "@[((%s%s%s+%s))*v_phi2v_m_0(cmplx(1,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf3 p3 wf2 p1 wf1 p2 | C_13_42, (F134|F243) | C_14_23, (F143|F234) -> printf "@[((%s%s%s+%s))*phi_phi2v_m_0(cmplx(1,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf1 p3 wf3 p1 wf2 p2 | C_13_42, (F143|F234) | C_14_23, (F134|F243) -> printf "@[((%s%s%s+%s))*phi_phi2v_m_0(cmplx(1,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf1 p2 wf2 p1 wf3 p3 | C_13_42, (F314|F423) | C_14_23, (F413|F324) -> printf "@[((%s%s%s+%s))*phi_phi2v_m_0(cmplx(1,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf2 p3 wf3 p2 wf1 p1 | C_13_42, (F324|F413) | C_14_23, (F423|F314) -> printf "@[((%s%s%s+%s))*phi_phi2v_m_0(cmplx(1,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf2 p1 wf1 p2 wf3 p3 | C_13_42, (F341|F432) | C_14_23, (F431|F342) -> printf "@[((%s%s%s+%s))*phi_phi2v_m_0(cmplx(1,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf3 p2 wf2 p3 wf1 p1 | C_13_42, (F342|F431) | C_14_23, (F432|F341) -> printf "@[((%s%s%s+%s))*phi_phi2v_m_0(cmplx(1,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf3 p1 wf1 p3 wf2 p2 let print_add_dscalar2_vector2_m_0_km c pa pb wf1 wf2 wf3 p1 p2 p3 fusion (coeff, contraction) = printf "@ + "; print_dscalar2_vector2_m_0_km c pa pb wf1 wf2 wf3 p1 p2 p3 fusion (coeff, contraction) let print_dscalar2_vector2_m_1_km c pa pb wf1 wf2 wf3 p1 p2 p3 fusion (coeff, contraction) = match contraction, fusion with | C_12_34, (F123|F213|F124|F214) -> printf "@[((%s%s%s+%s))*v_phi2v_m_1(cmplx(1,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf1 p1 wf2 p2 wf3 p3 | C_12_34, (F134|F143|F234|F243) -> printf "@[((%s%s%s+%s))*phi_phi2v_m_1(cmplx(1,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf1 p1 wf2 p2 wf3 p3 | C_12_34, (F132|F231|F142|F241) -> printf "@[((%s%s%s+%s))*v_phi2v_m_1(cmplx(1,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf1 p1 wf3 p3 wf2 p2 | C_12_34, (F312|F321|F412|F421) -> printf "@[((%s%s%s+%s))*v_phi2v_m_1(cmplx(1,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf3 p3 wf2 p2 wf1 p1 | C_12_34, (F314|F413|F324|F423) -> printf "@[((%s%s%s+%s))*phi_phi2v_m_1(cmplx(1,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf2 p2 wf1 p1 wf3 p3 | C_12_34, (F341|F431|F342|F432) -> printf "@[((%s%s%s+%s))*phi_phi2v_m_1(cmplx(1,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf3 p3 wf2 p2 wf1 p1 | C_13_42, (F123|F214) | C_14_23, (F124|F213) -> printf "@[((%s%s%s+%s))*v_phi2v_m_1(cmplx(1,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf1 p1 wf2 p3 wf3 p2 | C_13_42, (F124|F213) | C_14_23, (F123|F214) -> printf "@[((%s%s%s+%s))*v_phi2v_m_1(cmplx(1,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf2 p2 wf1 p3 wf3 p1 | C_13_42, (F132|F241) | C_14_23, (F142|F231) -> printf "@[((%s%s%s+%s))*v_phi2v_m_1(cmplx(1,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf1 p1 wf3 p2 wf2 p3 | C_13_42, (F142|F231) | C_14_23, (F132|F241) -> printf "@[((%s%s%s+%s))*v_phi2v_m_1(cmplx(1,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf3 p3 wf1 p2 wf2 p1 | C_13_42, (F312|F421) | C_14_23, (F412|F321) -> printf "@[((%s%s%s+%s))*v_phi2v_m_1(cmplx(1,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf2 p2 wf3 p1 wf1 p3 | C_13_42, (F321|F412) | C_14_23, (F421|F312) -> printf "@[((%s%s%s+%s))*v_phi2v_m_1(cmplx(1,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf3 p3 wf2 p1 wf1 p2 | C_13_42, (F134|F243) | C_14_23, (F143|F234) -> printf "@[((%s%s%s+%s))*phi_phi2v_m_1(cmplx(1,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf1 p3 wf3 p1 wf2 p2 | C_13_42, (F143|F234) | C_14_23, (F134|F243) -> printf "@[((%s%s%s+%s))*phi_phi2v_m_1(cmplx(1,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf1 p2 wf2 p1 wf3 p3 | C_13_42, (F314|F423) | C_14_23, (F413|F324) -> printf "@[((%s%s%s+%s))*phi_phi2v_m_1(cmplx(1,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf2 p3 wf3 p2 wf1 p1 | C_13_42, (F324|F413) | C_14_23, (F423|F314) -> printf "@[((%s%s%s+%s))*phi_phi2v_m_1(cmplx(1,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf2 p1 wf1 p2 wf3 p3 | C_13_42, (F341|F432) | C_14_23, (F431|F342) -> printf "@[((%s%s%s+%s))*phi_phi2v_m_1(cmplx(1,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf3 p2 wf2 p3 wf1 p1 | C_13_42, (F342|F431) | C_14_23, (F432|F341) -> printf "@[((%s%s%s+%s))*phi_phi2v_m_1(cmplx(1,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf3 p1 wf1 p3 wf2 p2 let print_add_dscalar2_vector2_m_1_km c pa pb wf1 wf2 wf3 p1 p2 p3 fusion (coeff, contraction) = printf "@ + "; print_dscalar2_vector2_m_1_km c pa pb wf1 wf2 wf3 p1 p2 p3 fusion (coeff, contraction) let print_dscalar2_vector2_m_7_km c pa pb wf1 wf2 wf3 p1 p2 p3 fusion (coeff, contraction) = match contraction, fusion with | C_12_34, (F123|F213|F124|F214) -> printf "@[((%s%s%s+%s))*v_phi2v_m_7(cmplx(1,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf1 p1 wf2 p2 wf3 p3 | C_12_34, (F134|F143|F234|F243) -> printf "@[((%s%s%s+%s))*phi_phi2v_m_7(cmplx(1,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf1 p1 wf2 p2 wf3 p3 | C_12_34, (F132|F231|F142|F241) -> printf "@[((%s%s%s+%s))*v_phi2v_m_7(cmplx(1,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf1 p1 wf3 p3 wf2 p2 | C_12_34, (F312|F321|F412|F421) -> printf "@[((%s%s%s+%s))*v_phi2v_m_7(cmplx(1,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf3 p3 wf2 p2 wf1 p1 | C_12_34, (F314|F413|F324|F423) -> printf "@[((%s%s%s+%s))*phi_phi2v_m_7(cmplx(1,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf2 p2 wf1 p1 wf3 p3 | C_12_34, (F341|F431|F342|F432) -> printf "@[((%s%s%s+%s))*phi_phi2v_m_7(cmplx(1,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf3 p3 wf2 p2 wf1 p1 | C_13_42, (F123|F214) | C_14_23, (F124|F213) -> printf "@[((%s%s%s+%s))*v_phi2v_m_7(cmplx(1,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf1 p1 wf2 p3 wf3 p2 | C_13_42, (F124|F213) | C_14_23, (F123|F214) -> printf "@[((%s%s%s+%s))*v_phi2v_m_7(cmplx(1,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf2 p2 wf1 p3 wf3 p1 | C_13_42, (F132|F241) | C_14_23, (F142|F231) -> printf "@[((%s%s%s+%s))*v_phi2v_m_7(cmplx(1,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf1 p1 wf3 p2 wf2 p3 | C_13_42, (F142|F231) | C_14_23, (F132|F241) -> printf "@[((%s%s%s+%s))*v_phi2v_m_7(cmplx(1,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf3 p3 wf1 p2 wf2 p1 | C_13_42, (F312|F421) | C_14_23, (F412|F321) -> printf "@[((%s%s%s+%s))*v_phi2v_m_7(cmplx(1,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf2 p2 wf3 p1 wf1 p3 | C_13_42, (F321|F412) | C_14_23, (F421|F312) -> printf "@[((%s%s%s+%s))*v_phi2v_m_7(cmplx(1,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf3 p3 wf2 p1 wf1 p2 | C_13_42, (F134|F243) | C_14_23, (F143|F234) -> printf "@[((%s%s%s+%s))*phi_phi2v_m_7(cmplx(1,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf1 p3 wf3 p1 wf2 p2 | C_13_42, (F143|F234) | C_14_23, (F134|F243) -> printf "@[((%s%s%s+%s))*phi_phi2v_m_7(cmplx(1,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf1 p2 wf2 p1 wf3 p3 | C_13_42, (F314|F423) | C_14_23, (F413|F324) -> printf "@[((%s%s%s+%s))*phi_phi2v_m_7(cmplx(1,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf2 p3 wf3 p2 wf1 p1 | C_13_42, (F324|F413) | C_14_23, (F423|F314) -> printf "@[((%s%s%s+%s))*phi_phi2v_m_7(cmplx(1,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf2 p1 wf1 p2 wf3 p3 | C_13_42, (F341|F432) | C_14_23, (F431|F342) -> printf "@[((%s%s%s+%s))*phi_phi2v_m_7(cmplx(1,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf3 p2 wf2 p3 wf1 p1 | C_13_42, (F342|F431) | C_14_23, (F432|F341) -> printf "@[((%s%s%s+%s))*phi_phi2v_m_7(cmplx(1,kind=default),@ %s,%s,%s,%s,%s,%s))@]" (format_coeff coeff) c pa pb wf3 p1 wf1 p3 wf2 p2 let print_add_dscalar2_vector2_m_7_km c pa pb wf1 wf2 wf3 p1 p2 p3 fusion (coeff, contraction) = printf "@ + "; print_dscalar2_vector2_m_7_km c pa pb wf1 wf2 wf3 p1 p2 p3 fusion (coeff, contraction) let print_dscalar4_km c pa pb 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*%s*%s)" (format_coeff coeff) c pa pb 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*%s*%s)" (format_coeff coeff) c pa pb 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*%s*%s)" (format_coeff coeff) c pa pb p1 p3 p2 p123 wf1 wf2 wf3 let print_add_dscalar4_km c pa pb wf1 wf2 wf3 p1 p2 p3 p123 fusion (coeff, contraction) = printf "@ + "; print_dscalar4_km c pa pb 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) -> begin match coeff, fb, b, f with | _, _, (VLRM|SPM|VAM|VA3M|TVA|TVAM|TLR|TLRM|TRL|TRLM), _ -> let p12 = Printf.sprintf "(-%s-%s)" p1 p2 in Fermions.print_current_mom (coeff, fb, b, f) c wf1 wf2 p1 p2 p12 fusion | _, _, _, _ -> Fermions.print_current (coeff, fb, b, f) c wf1 wf2 fusion end | 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 | I_Gauge_Gauge_Gauge coeff -> let c = format_coupling coeff c in begin match fusion with | (F23|F31|F12) -> printf "g_gg((0,1)*(%s),%s,%s,%s,%s)" c wf1 p1 wf2 p2 | (F32|F13|F21) -> printf "g_gg((0,1)*(%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 | Dim5_Scalar_Vector_Vector_U coeff -> let c = format_coupling coeff c in begin match fusion with | (F23|F32) -> printf "phi_u_vv (%s, %s, %s, %s, %s)" c p1 p2 wf1 wf2 | (F12|F13) -> printf "v_u_phiv (%s, %s, %s, %s, %s)" c wf1 p1 p2 wf2 | (F21|F31) -> printf "v_u_phiv (%s, %s, %s, %s, %s)" c wf2 p2 p1 wf1 end | Dim5_Scalar_Vector_Vector_TU coeff -> let c = format_coupling coeff c in begin match fusion with | F23 -> printf "(%s)*((%s*%s)*(-(%s+%s)*%s) - (-(%s+%s)*%s)*(%s*%s))" c p1 wf2 p1 p2 wf1 p1 p2 p1 wf1 wf2 | F32 -> printf "(%s)*((%s*%s)*(-(%s+%s)*%s) - (-(%s+%s)*%s)*(%s*%s))" c p2 wf1 p1 p2 wf2 p1 p2 p2 wf1 wf2 | F12 -> printf "(%s)*%s*((%s*%s)*%s - (%s*%s)*%s)" c wf1 p1 wf2 p2 p1 p2 wf2 | F21 -> printf "(%s)*%s*((%s*%s)*%s - (%s*%s)*%s)" c wf2 p2 wf1 p1 p1 p2 wf1 | F13 -> printf "(%s)*%s*((-(%s+%s)*%s)*%s - (-(%s+%s)*%s)*%s)" c wf1 p1 p2 wf2 p1 p1 p2 p1 wf2 | F31 -> printf "(%s)*%s*((-(%s+%s)*%s)*%s - (-(%s+%s)*%s)*%s)" c wf2 p1 p2 wf1 p2 p1 p2 p2 wf1 end | Dim5_Scalar_Scalar2 coeff-> let c = format_coupling coeff c in begin match fusion with | (F23|F32) -> printf "phi_dim5s2(%s, %s ,%s, %s, %s)" c wf1 p1 wf2 p2 | (F12|F13) -> let p12 = Printf.sprintf "(-%s-%s)" p1 p2 in printf "phi_dim5s2(%s,%s,%s,%s,%s)" c wf1 p12 wf2 p2 | (F21|F31) -> let p12 = Printf.sprintf "(-%s-%s)" p1 p2 in printf "phi_dim5s2(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p12 end | Scalar_Vector_Vector_t coeff -> let c = format_coupling coeff c in begin match fusion with | (F23|F32) -> printf "s_vv_t(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 | (F12|F13) -> printf "v_sv_t(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 | (F21|F31) -> printf "v_sv_t(%s,%s,%s,%s,%s)" c wf2 p2 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 | Tensor_2_Scalar_Scalar coeff-> let c = format_coupling coeff c in begin match fusion with | (F23|F32) -> printf "t2_phi2(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 | (F12|F13) -> printf "phi_t2phi(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 | (F21|F31) -> printf "phi_t2phi(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 end | Tensor_2_Vector_Vector_1 coeff -> let c = format_coupling coeff c in begin match fusion with | (F23|F32) -> printf "t2_vv_1(%s,%s,%s)" c wf1 wf2 | (F12|F13) -> printf "v_t2v_1(%s,%s,%s)" c wf1 wf2 | (F21|F31) -> printf "v_t2v_1(%s,%s,%s)" c wf2 wf1 end | Tensor_2_Vector_Vector_cf coeff-> let c = format_coupling coeff c in begin match fusion with | (F23|F32) -> printf "t2_vv_cf(%s,%s,%s)" c wf1 wf2 | (F12|F13) -> printf "v_t2v_cf(%s,%s,%s)" c wf1 wf2 | (F21|F31) -> printf "v_t2v_cf(%s,%s,%s)" c wf2 wf1 end | Tensor_2_Scalar_Scalar_cf coeff-> let c = format_coupling coeff c in begin match fusion with | (F23|F32) -> printf "t2_phi2_cf(%s,%s,%s,%s, %s)" c wf1 p1 wf2 p2 | (F12|F13) -> printf "phi_t2phi_cf(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 | (F21|F31) -> printf "phi_t2phi_cf(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 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 | Tensor_2_Vector_Vector_t coeff -> let c = format_coupling coeff c in begin match fusion with | (F23|F32) -> printf "t2_vv_t(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 | (F12|F13) -> printf "v_t2v_t(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 | (F21|F31) -> printf "v_t2v_t(%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 | TensorVector_Vector_Vector coeff-> let c = format_coupling coeff c in begin match fusion with | (F23|F32) -> printf "dv_vv(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 | (F12|F13) -> printf "v_dvv(%s,%s,%s,%s)" c wf1 p1 wf2 | (F21|F31) -> printf "v_dvv(%s,%s,%s,%s)" c wf2 p2 wf1 end | TensorVector_Vector_Vector_cf coeff-> let c = format_coupling coeff c in begin match fusion with | (F23|F32) -> printf "dv_vv_cf(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 | (F12|F13) -> printf "v_dvv_cf(%s,%s,%s,%s)" c wf1 p1 wf2 | (F21|F31) -> printf "v_dvv_cf(%s,%s,%s,%s)" c wf2 p2 wf1 end | TensorVector_Scalar_Scalar coeff-> let c = format_coupling coeff c in begin match fusion with | (F23|F32) -> printf "dv_phi2(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 | (F12|F13) -> printf "phi_dvphi(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 | (F21|F31) -> printf "phi_dvphi(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 end | TensorVector_Scalar_Scalar_cf coeff-> let c = format_coupling coeff c in begin match fusion with | (F23|F32) -> printf "dv_phi2_cf(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 | (F12|F13) -> printf "phi_dvphi_cf(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 | (F21|F31) -> printf "phi_dvphi_cf(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 end | TensorScalar_Vector_Vector coeff-> let c = format_coupling coeff c in begin match fusion with | (F23|F32) -> printf "tphi_vv(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 | (F12|F13) -> printf "v_tphiv(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 | (F21|F31) -> printf "v_tphiv(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 end | TensorScalar_Vector_Vector_cf coeff-> let c = format_coupling coeff c in begin match fusion with | (F23|F32) -> printf "tphi_vv_cf(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 | (F12|F13) -> printf "v_tphiv_cf(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 | (F21|F31) -> printf "v_tphiv_cf(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 end | TensorScalar_Scalar_Scalar coeff-> let c = format_coupling coeff c in begin match fusion with | (F23|F32) -> printf "tphi_ss(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 | (F12|F13) -> printf "s_tphis(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 | (F21|F31) -> printf "s_tphis(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 end | TensorScalar_Scalar_Scalar_cf coeff-> let c = format_coupling coeff c in begin match fusion with | (F23|F32) -> printf "tphi_ss_cf(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 | (F12|F13) -> printf "s_tphis_cf(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 | (F21|F31) -> printf "s_tphis_cf(%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 | Dim6_Scalar_Vector_Vector_D coeff -> let c = format_coupling coeff c in begin match fusion with | (F23|F32) -> printf "s_vv_6D(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 | (F12|F13) -> printf "v_sv_6D(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 | (F21|F31) -> printf "v_sv_6D(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 end | Dim6_Scalar_Vector_Vector_DP coeff -> let c = format_coupling coeff c in begin match fusion with | (F23|F32) -> printf "s_vv_6DP(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 | (F12|F13) -> printf "v_sv_6DP(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 | (F21|F31) -> printf "v_sv_6DP(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 end | Dim6_HAZ_D coeff -> let c = format_coupling coeff c in begin match fusion with | F23 -> printf "h_az_D(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 | F32 -> printf "h_az_D(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 | F13 -> printf "a_hz_D(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 | F31 -> printf "a_hz_D(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 | F12 -> printf "z_ah_D(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 | F21 -> printf "z_ah_D(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 end | Dim6_HAZ_DP coeff -> let c = format_coupling coeff c in begin match fusion with | F23 -> printf "h_az_DP(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 | F32 -> printf "h_az_DP(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 | F13 -> printf "a_hz_DP(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 | F31 -> printf "a_hz_DP(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 | F12 -> printf "z_ah_DP(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 | F21 -> printf "z_ah_DP(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 end | Gauge_Gauge_Gauge_i coeff -> let c = format_coupling coeff c in begin match fusion with | F23 -> printf "g_gg_23(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 | F32 -> printf "g_gg_23(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 | F13 -> printf "g_gg_13(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 | F31 -> printf "g_gg_13(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 | F12 -> printf "(-1) * g_gg_13(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 | F21 -> printf "(-1) * g_gg_13(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 end | Dim6_GGG coeff -> let c = format_coupling coeff c in begin match fusion with | F23 -> printf "g_gg_6(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 | F32 -> printf "g_gg_6(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 | F12 -> printf "g_gg_6(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 | F21 -> printf "g_gg_6(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 | F13 -> printf "(-1) * g_gg_6(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 | F31 -> printf "(-1) * g_gg_6(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 end | Dim6_AWW_DP coeff -> let c = format_coupling coeff c in begin match fusion with | F23 -> printf "a_ww_DP(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 | F32 -> printf "a_ww_DP(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 | F13 -> printf "w_aw_DP(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 | F31 -> printf "w_aw_DP(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 | F12 -> printf "(-1) * w_aw_DP(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 | F21 -> printf "(-1) * w_aw_DP(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 end | Dim6_AWW_DW coeff -> let c = format_coupling coeff c in begin match fusion with | F23 -> printf "a_ww_DW(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 | F32 -> printf "a_ww_DW(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 | F13 -> printf "(-1) * a_ww_DW(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 | F31 -> printf "(-1) * a_ww_DW(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 | F12 -> printf "a_ww_DW(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 | F21 -> printf "a_ww_DW(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 end | Dim6_Gauge_Gauge_Gauge_i coeff -> let c = format_coupling coeff c in begin match fusion with | F23 | F31 | F12 -> printf "kg_kgkg_i(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 | F32 | F13 | F21 -> printf "kg_kgkg_i(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 end | Dim6_HHH coeff -> let c = format_coupling coeff c in begin match fusion with | (F23|F32|F12|F21|F13|F31) -> printf "h_hh_6(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 end | Dim6_WWZ_DPWDW coeff -> let c = format_coupling coeff c in begin match fusion with | F23 -> printf "w_wz_DPW(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 | F32 -> printf "w_wz_DPW(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 | F13 -> printf "(-1) * w_wz_DPW(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 | F31 -> printf "(-1) * w_wz_DPW(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 | F12 -> printf "z_ww_DPW(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 | F21 -> printf "z_ww_DPW(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 end | Dim6_WWZ_DW coeff -> let c = format_coupling coeff c in begin match fusion with | F23 -> printf "w_wz_DW(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 | F32 -> printf "w_wz_DW(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 | F13 -> printf "(-1) * w_wz_DW(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 | F31 -> printf "(-1) * w_wz_DW(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 | F12 -> printf "z_ww_DW(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 | F21 -> printf "z_ww_DW(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 end | Dim6_WWZ_D coeff -> let c = format_coupling coeff c in begin match fusion with | F23 -> printf "w_wz_D(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 | F32 -> printf "w_wz_D(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 | F13 -> printf "(-1) * w_wz_D(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 | F31 -> printf "(-1) * w_wz_D(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 | F12 -> printf "z_ww_D(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 | F21 -> printf "z_ww_D(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 end (*i | Dim6_Glu_Glu_Glu coeff -> let c = format_coupling coeff c in begin match fusion with | (F23|F31|F12) -> printf "g_gg_glu(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 | (F32|F13|F21) -> printf "g_gg_glu(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 end i*) end (* Flip the sign to account for the~$\mathrm{i}^2$ relative to diagrams with only cubic couplings. \label{hack:sign(V4)} *) (* \begin{dubious} That's an \emph{slightly dangerous} hack!!! How do we accnount for such signs when treating $n$-ary vertices uniformly? \end{dubious} *) | 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 | Dim8_Vector4_t_0 contractions -> begin match contractions with | [] -> invalid_arg "Targets.print_current: Vector4 []" | head :: tail -> print_vector4_t_0 c wf1 p1 wf2 p2 wf3 p3 fusion head; List.iter (print_add_vector4 c wf1 wf2 wf3 fusion) tail; end | Dim8_Vector4_t_1 contractions -> begin match contractions with | [] -> invalid_arg "Targets.print_current: Vector4 []" | head :: tail -> print_vector4_t_1 c wf1 p1 wf2 p2 wf3 p3 fusion head; List.iter (print_add_vector4 c wf1 wf2 wf3 fusion) tail; end | Dim8_Vector4_t_2 contractions -> begin match contractions with | [] -> invalid_arg "Targets.print_current: Vector4 []" | head :: tail -> print_vector4_t_2 c wf1 p1 wf2 p2 wf3 p3 fusion head; List.iter (print_add_vector4 c wf1 wf2 wf3 fusion) tail; end | Dim8_Vector4_m_0 contractions -> begin match contractions with | [] -> invalid_arg "Targets.print_current: Vector4 []" | head :: tail -> print_vector4_m_0 c wf1 p1 wf2 p2 wf3 p3 fusion head; List.iter (print_add_vector4 c wf1 wf2 wf3 fusion) tail; end | Dim8_Vector4_m_1 contractions -> begin match contractions with | [] -> invalid_arg "Targets.print_current: Vector4 []" | head :: tail -> print_vector4_m_1 c wf1 p1 wf2 p2 wf3 p3 fusion head; List.iter (print_add_vector4 c wf1 wf2 wf3 fusion) tail; end | Dim8_Vector4_m_7 contractions -> begin match contractions with | [] -> invalid_arg "Targets.print_current: Vector4 []" | head :: tail -> print_vector4_m_7 c wf1 p1 wf2 p2 wf3 p3 fusion head; List.iter (print_add_vector4 c wf1 wf2 wf3 fusion) tail; end | Vector4_K_Matrix_tho (_, 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 | Vector4_K_Matrix_cf_t0 (disc, contractions) -> let pa, pb, pc = begin match disc, fusion with | 3, (F143|F413|F142|F412|F321|F231|F324|F234) -> (p1, p2, p3) | 3, (F314|F341|F214|F241|F132|F123|F432|F423) -> (p2, p3, p1) | 3, (F134|F431|F124|F421|F312|F213|F342|F243) -> (p1, p3, p2) | _, (F341|F431|F342|F432|F123|F213|F124|F214) -> (p1, p2, p3) | _, (F134|F143|F234|F243|F312|F321|F412|F421) -> (p2, p3, p1) | _, (F314|F413|F324|F423|F132|F231|F142|F241) -> (p1, p3, p2) end in begin match contractions with | [] -> invalid_arg "Targets.print_current: Vector4_K_Matrix_cf_t0 []" | head :: tail -> printf "("; print_vector4_km_t_0 c pa pb wf1 p1 wf2 p2 wf3 p3 fusion head; List.iter (print_add_vector4_km c pa pb wf1 wf2 wf3 fusion) tail; printf ")" end | Vector4_K_Matrix_cf_t1 (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_cf_t1 []" | head :: tail -> printf "("; print_vector4_km_t_1 c pa pb wf1 p1 wf2 p2 wf3 p3 fusion head; List.iter (print_add_vector4_km c pa pb wf1 wf2 wf3 fusion) tail; printf ")" end | Vector4_K_Matrix_cf_t2 (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_cf_t2 []" | head :: tail -> printf "("; print_vector4_km_t_2 c pa pb wf1 p1 wf2 p2 wf3 p3 fusion head; List.iter (print_add_vector4_km c pa pb wf1 wf2 wf3 fusion) tail; printf ")" end | Vector4_K_Matrix_cf_t_rsi (disc, contractions) -> let pa, pb, pc = begin match disc, fusion with | 3, (F143|F413|F142|F412|F321|F231|F324|F234) -> (p1, p2, p3) | 3, (F314|F341|F214|F241|F132|F123|F432|F423) -> (p2, p3, p1) | 3, (F134|F431|F124|F421|F312|F213|F342|F243) -> (p1, p3, p2) | _, (F341|F431|F342|F432|F123|F213|F124|F214) -> (p1, p2, p3) | _, (F134|F143|F234|F243|F312|F321|F412|F421) -> (p2, p3, p1) | _, (F314|F413|F324|F423|F132|F231|F142|F241) -> (p1, p3, p2) end in begin match contractions with | [] -> invalid_arg "Targets.print_current: Vector4_K_Matrix_cf_t_rsi []" | head :: tail -> printf "("; print_vector4_km_t_rsi c pa pb pc wf1 p1 wf2 p2 wf3 p3 fusion head; List.iter (print_add_vector4_km c pa pb wf1 wf2 wf3 fusion) tail; printf ")" end | Vector4_K_Matrix_cf_m0 (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_cf_m0 []" | head :: tail -> printf "("; print_vector4_km_m_0 c pa pb wf1 p1 wf2 p2 wf3 p3 fusion head; List.iter (print_add_vector4_km c pa pb wf1 wf2 wf3 fusion) tail; printf ")" end | Vector4_K_Matrix_cf_m1 (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_cf_m1 []" | head :: tail -> printf "("; print_vector4_km_m_1 c pa pb wf1 p1 wf2 p2 wf3 p3 fusion head; List.iter (print_add_vector4_km c pa pb wf1 wf2 wf3 fusion) tail; printf ")" end | Vector4_K_Matrix_cf_m7 (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_cf_m7 []" | head :: tail -> printf "("; print_vector4_km_m_7 c pa pb wf1 p1 wf2 p2 wf3 p3 fusion head; List.iter (print_add_vector4_km c pa pb wf1 wf2 wf3 fusion) tail; printf ")" end | DScalar2_Vector2_K_Matrix_ms (disc, contractions) -> let p123 = Printf.sprintf "(-%s-%s-%s)" p1 p2 p3 in 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) | 4, (F143|F413|F142|F412|F321|F231|F324|F234) -> (p1, p2) | 4, (F314|F341|F214|F241|F132|F123|F432|F423) -> (p2, p3) | 4, (F134|F431|F124|F421|F312|F213|F342|F243) -> (p1, p3) | 5, (F143|F413|F142|F412|F321|F231|F324|F234) -> (p1, p2) | 5, (F314|F341|F214|F241|F132|F123|F432|F423) -> (p2, p3) | 5, (F134|F431|F124|F421|F312|F213|F342|F243) -> (p1, p3) | 6, (F134|F132|F314|F312|F241|F243|F421|F423) -> (p1, p2) | 6, (F213|F413|F231|F431|F124|F324|F142|F342) -> (p2, p3) | 6, (F143|F123|F341|F321|F412|F214|F432|F234) -> (p1, p3) | 7, (F134|F132|F314|F312|F241|F243|F421|F423) -> (p1, p2) | 7, (F213|F413|F231|F431|F124|F324|F142|F342) -> (p2, p3) | 7, (F143|F123|F341|F321|F412|F214|F432|F234) -> (p1, p3) | 8, (F134|F132|F314|F312|F241|F243|F421|F423) -> (p1, p2) | 8, (F213|F413|F231|F431|F124|F324|F142|F342) -> (p2, p3) | 8, (F143|F123|F341|F321|F412|F214|F432|F234) -> (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: DScalar2_Vector4_K_Matrix_ms []" | head :: tail -> printf "("; print_dscalar2_vector2_km c pa pb wf1 wf2 wf3 p1 p2 p3 p123 fusion head; List.iter (print_add_dscalar2_vector2_km c pa pb wf1 wf2 wf3 p1 p2 p3 p123 fusion) tail; printf ")" end | DScalar2_Vector2_m_0_K_Matrix_cf (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) | 4, (F143|F413|F142|F412|F321|F231|F324|F234) -> (p1, p2) | 4, (F314|F341|F214|F241|F132|F123|F432|F423) -> (p2, p3) | 4, (F134|F431|F124|F421|F312|F213|F342|F243) -> (p1, p3) | 5, (F143|F413|F142|F412|F321|F231|F324|F234) -> (p1, p2) | 5, (F314|F341|F214|F241|F132|F123|F432|F423) -> (p2, p3) | 5, (F134|F431|F124|F421|F312|F213|F342|F243) -> (p1, p3) | 6, (F134|F132|F314|F312|F241|F243|F421|F423) -> (p1, p2) | 6, (F213|F413|F231|F431|F124|F324|F142|F342) -> (p2, p3) | 6, (F143|F123|F341|F321|F412|F214|F432|F234) -> (p1, p3) | 7, (F134|F132|F314|F312|F241|F243|F421|F423) -> (p1, p2) | 7, (F213|F413|F231|F431|F124|F324|F142|F342) -> (p2, p3) | 7, (F143|F123|F341|F321|F412|F214|F432|F234) -> (p1, p3) | 8, (F134|F132|F314|F312|F241|F243|F421|F423) -> (p1, p2) | 8, (F213|F413|F231|F431|F124|F324|F142|F342) -> (p2, p3) | 8, (F143|F123|F341|F321|F412|F214|F432|F234) -> (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: DScalar2_Vector4_K_Matrix_cf_m0 []" | head :: tail -> printf "("; print_dscalar2_vector2_m_0_km c pa pb wf1 wf2 wf3 p1 p2 p3 fusion head; List.iter (print_add_dscalar2_vector2_m_0_km c pa pb wf1 wf2 wf3 p1 p2 p3 fusion) tail; printf ")" end | DScalar2_Vector2_m_1_K_Matrix_cf (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) | 4, (F143|F413|F142|F412|F321|F231|F324|F234) -> (p1, p2) | 4, (F314|F341|F214|F241|F132|F123|F432|F423) -> (p2, p3) | 4, (F134|F431|F124|F421|F312|F213|F342|F243) -> (p1, p3) | 5, (F143|F413|F142|F412|F321|F231|F324|F234) -> (p1, p2) | 5, (F314|F341|F214|F241|F132|F123|F432|F423) -> (p2, p3) | 5, (F134|F431|F124|F421|F312|F213|F342|F243) -> (p1, p3) | 6, (F134|F132|F314|F312|F241|F243|F421|F423) -> (p1, p2) | 6, (F213|F413|F231|F431|F124|F324|F142|F342) -> (p2, p3) | 6, (F143|F123|F341|F321|F412|F214|F432|F234) -> (p1, p3) | 7, (F134|F132|F314|F312|F241|F243|F421|F423) -> (p1, p2) | 7, (F213|F413|F231|F431|F124|F324|F142|F342) -> (p2, p3) | 7, (F143|F123|F341|F321|F412|F214|F432|F234) -> (p1, p3) | 8, (F134|F132|F314|F312|F241|F243|F421|F423) -> (p1, p2) | 8, (F213|F413|F231|F431|F124|F324|F142|F342) -> (p2, p3) | 8, (F143|F123|F341|F321|F412|F214|F432|F234) -> (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: DScalar2_Vector4_K_Matrix_cf_m1 []" | head :: tail -> printf "("; print_dscalar2_vector2_m_1_km c pa pb wf1 wf2 wf3 p1 p2 p3 fusion head; List.iter (print_add_dscalar2_vector2_m_1_km c pa pb wf1 wf2 wf3 p1 p2 p3 fusion) tail; printf ")" end | DScalar2_Vector2_m_7_K_Matrix_cf (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) | 4, (F143|F413|F142|F412|F321|F231|F324|F234) -> (p1, p2) | 4, (F314|F341|F214|F241|F132|F123|F432|F423) -> (p2, p3) | 4, (F134|F431|F124|F421|F312|F213|F342|F243) -> (p1, p3) | 5, (F143|F413|F142|F412|F321|F231|F324|F234) -> (p1, p2) | 5, (F314|F341|F214|F241|F132|F123|F432|F423) -> (p2, p3) | 5, (F134|F431|F124|F421|F312|F213|F342|F243) -> (p1, p3) | 6, (F134|F132|F314|F312|F241|F243|F421|F423) -> (p1, p2) | 6, (F213|F413|F231|F431|F124|F324|F142|F342) -> (p2, p3) | 6, (F143|F123|F341|F321|F412|F214|F432|F234) -> (p1, p3) | 7, (F134|F132|F314|F312|F241|F243|F421|F423) -> (p1, p2) | 7, (F213|F413|F231|F431|F124|F324|F142|F342) -> (p2, p3) | 7, (F143|F123|F341|F321|F412|F214|F432|F234) -> (p1, p3) | 8, (F134|F132|F314|F312|F241|F243|F421|F423) -> (p1, p2) | 8, (F213|F413|F231|F431|F124|F324|F142|F342) -> (p2, p3) | 8, (F143|F123|F341|F321|F412|F214|F432|F234) -> (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: DScalar2_Vector4_K_Matrix_cf_m7 []" | head :: tail -> printf "("; print_dscalar2_vector2_m_7_km c pa pb wf1 wf2 wf3 p1 p2 p3 fusion head; List.iter (print_add_dscalar2_vector2_m_7_km c pa pb wf1 wf2 wf3 p1 p2 p3 fusion) tail; printf ")" end | DScalar4_K_Matrix_ms (disc, contractions) -> let p123 = Printf.sprintf "(-%s-%s-%s)" p1 p2 p3 in 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: DScalar4_K_Matrix_ms []" | head :: tail -> printf "("; print_dscalar4_km c pa pb wf1 wf2 wf3 p1 p2 p3 p123 fusion head; List.iter (print_add_dscalar4_km c pa pb wf1 wf2 wf3 p1 p2 p3 p123 fusion) tail; printf ")" end | Dim8_Scalar2_Vector2_1 coeff -> let c = format_coupling coeff c in begin match fusion with | F134 | F143 | F234 | F243 -> printf "phi_phi2v_1(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 wf3 p3 | F314 | F413 | F324 | F423 -> printf "phi_phi2v_1(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 wf3 p3 | F341 | F431 | F342 | F432 -> printf "phi_phi2v_1(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf2 p2 wf1 p1 | F312 | F321 | F412 | F421 -> printf "v_phi2v_1(%s,%s,%s,%s,%s,%s)" c wf3 p3 wf2 p2 wf1 | F231 | F132 | F241 | F142 -> printf "v_phi2v_1(%s,%s,%s,%s,%s,%s)" c wf1 p1 wf3 p3 wf2 | F123 | F213 | F124 | F214 -> printf "v_phi2v_1(%s,%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 wf3 end | Dim8_Scalar2_Vector2_2 coeff -> let c = format_coupling coeff c in begin match fusion with | F134 | F143 | F234 | F243 -> printf "phi_phi2v_2(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 wf3 p3 | F314 | F413 | F324 | F423 -> printf "phi_phi2v_2(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 wf3 p3 | F341 | F431 | F342 | F432 -> printf "phi_phi2v_2(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf2 p2 wf1 p1 | F312 | F321 | F412 | F421 -> printf "v_phi2v_2(%s,%s,%s,%s,%s,%s)" c wf3 p3 wf2 p2 wf1 | F231 | F132 | F241 | F142 -> printf "v_phi2v_2(%s,%s,%s,%s,%s,%s)" c wf1 p1 wf3 p3 wf2 | F123 | F213 | F124 | F214 -> printf "v_phi2v_2(%s,%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 wf3 end | Dim8_Scalar2_Vector2_m_0 coeff -> let c = format_coupling coeff c in begin match fusion with | F134 | F143 | F234 | F243 -> printf "phi_phi2v_m_0(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 wf3 p3 | F314 | F413 | F324 | F423 -> printf "phi_phi2v_m_0(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 wf3 p3 | F341 | F431 | F342 | F432 -> printf "phi_phi2v_m_0(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf2 p2 wf1 p1 | F312 | F321 | F412 | F421 -> printf "v_phi2v_m_0(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf2 p2 wf1 p1 | F231 | F132 | F241 | F142 -> printf "v_phi2v_m_0(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf3 p3 wf2 p2 | F123 | F213 | F124 | F214 -> printf "v_phi2v_m_0(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 wf3 p3 end | Dim8_Scalar2_Vector2_m_1 coeff -> let c = format_coupling coeff c in begin match fusion with | F134 | F143 | F234 | F243 -> printf "phi_phi2v_m_1(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 wf3 p3 | F314 | F413 | F324 | F423 -> printf "phi_phi2v_m_1(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 wf3 p3 | F341 | F431 | F342 | F432 -> printf "phi_phi2v_m_1(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf2 p2 wf1 p1 | F312 | F321 | F412 | F421 -> printf "v_phi2v_m_1(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf2 p2 wf1 p1 | F231 | F132 | F241 | F142 -> printf "v_phi2v_m_1(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf3 p3 wf2 p2 | F123 | F213 | F124 | F214 -> printf "v_phi2v_m_1(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 wf3 p3 end | Dim8_Scalar2_Vector2_m_7 coeff -> let c = format_coupling coeff c in begin match fusion with | F134 | F143 | F234 | F243 -> printf "phi_phi2v_m_7(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 wf3 p3 | F314 | F413 | F324 | F423 -> printf "phi_phi2v_m_7(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 wf3 p3 | F341 | F431 | F342 | F432 -> printf "phi_phi2v_m_7(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf2 p2 wf1 p1 | F312 | F321 | F412 | F421 -> printf "v_phi2v_m_7(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf2 p2 wf1 p1 | F231 | F132 | F241 | F142 -> printf "v_phi2v_m_7(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf3 p3 wf2 p2 | F123 | F213 | F124 | F214 -> printf "v_phi2v_m_7(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 wf3 p3 end | Dim8_Scalar4 coeff -> let c = format_coupling coeff c in begin match fusion with | F134 | F143 | F234 | F243 | F314 | F413 | F324 | F423 | F341 | F431 | F342 | F432 | F312 | F321 | F412 | F421 | F231 | F132 | F241 | F142 | F123 | F213 | F124 | F214 -> printf "s_dim8s3 (%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 wf3 p3 end | GBBG (coeff, fb, b, f) -> Fermions.print_current_g4 (coeff, fb, b, f) c wf1 wf2 wf3 fusion | Dim6_H4_P2 coeff -> let c = format_coupling coeff c in begin match fusion with | F134 | F143 | F234 | F243 | F314 | F413 | F324 | F423 | F341 | F431 | F342 | F432 | F312 | F321 | F412 | F421 | F231 | F132 | F241 | F142 | F123 | F213 | F124 | F214 -> printf "hhhh_p2 (%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 wf3 p3 end | Dim6_AHWW_DPB coeff -> let c = format_coupling coeff c in begin match fusion with | F234 -> printf "a_hww_DPB(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 wf3 p3 | F243 -> printf "a_hww_DPB(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf3 p3 wf2 p2 | F342 -> printf "a_hww_DPB(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf1 p1 wf2 p2 | F324 -> printf "a_hww_DPB(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 wf3 p3 | F423 -> printf "a_hww_DPB(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf3 p3 wf1 p1 | F432 -> printf "a_hww_DPB(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf2 p2 wf1 p1 | F134 -> printf "h_aww_DPB(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 wf3 p3 | F143 -> printf "h_aww_DPB(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf3 p3 wf2 p2 | F341 -> printf "h_aww_DPB(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf1 p1 wf2 p2 | F314 -> printf "h_aww_DPB(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 wf3 p3 | F413 -> printf "h_aww_DPB(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf3 p3 wf1 p1 | F431 -> printf "h_aww_DPB(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf2 p2 wf1 p1 | F124 -> printf "w_ahw_DPB(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 wf3 p3 | F142 -> printf "w_ahw_DPB(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf3 p3 wf2 p2 | F241 -> printf "w_ahw_DPB(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf1 p1 wf2 p2 | F214 -> printf "w_ahw_DPB(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 wf3 p3 | F412 -> printf "w_ahw_DPB(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf3 p3 wf1 p1 | F421 -> printf "w_ahw_DPB(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf2 p2 wf1 p1 | F123 -> printf "(-1)*w_ahw_DPB(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 wf3 p3 | F132 -> printf "(-1)*w_ahw_DPB(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf3 p3 wf2 p2 | F231 -> printf "(-1)*w_ahw_DPB(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf1 p1 wf2 p2 | F213 -> printf "(-1)*w_ahw_DPB(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 wf3 p3 | F312 -> printf "(-1)*w_ahw_DPB(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf3 p3 wf1 p1 | F321 -> printf "(-1)*w_ahw_DPB(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf2 p2 wf1 p1 end | Dim6_AHWW_DPW coeff -> let c = format_coupling coeff c in begin match fusion with | F234 -> printf "a_hww_DPW(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 wf3 p3 | F243 -> printf "a_hww_DPW(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf3 p3 wf2 p2 | F342 -> printf "a_hww_DPW(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf1 p1 wf2 p2 | F324 -> printf "a_hww_DPW(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 wf3 p3 | F423 -> printf "a_hww_DPW(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf3 p3 wf1 p1 | F432 -> printf "a_hww_DPW(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf2 p2 wf1 p1 | F134 -> printf "h_aww_DPW(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 wf3 p3 | F143 -> printf "h_aww_DPW(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf3 p3 wf2 p2 | F341 -> printf "h_aww_DPW(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf1 p1 wf2 p2 | F314 -> printf "h_aww_DPW(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 wf3 p3 | F413 -> printf "h_aww_DPW(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf3 p3 wf1 p1 | F431 -> printf "h_aww_DPW(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf2 p2 wf1 p1 | F124 -> printf "w_ahw_DPW(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 wf3 p3 | F142 -> printf "w_ahw_DPW(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf3 p3 wf2 p2 | F241 -> printf "w_ahw_DPW(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf1 p1 wf2 p2 | F214 -> printf "w_ahw_DPW(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 wf3 p3 | F412 -> printf "w_ahw_DPW(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf3 p3 wf1 p1 | F421 -> printf "w_ahw_DPW(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf2 p2 wf1 p1 | F123 -> printf "(-1)*w_ahw_DPW(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 wf3 p3 | F132 -> printf "(-1)*w_ahw_DPW(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf3 p3 wf2 p2 | F231 -> printf "(-1)*w_ahw_DPW(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf1 p1 wf2 p2 | F213 -> printf "(-1)*w_ahw_DPW(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 wf3 p3 | F312 -> printf "(-1)*w_ahw_DPW(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf3 p3 wf1 p1 | F321 -> printf "(-1)*w_ahw_DPW(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf2 p2 wf1 p1 end | Dim6_AHWW_DW coeff -> let c = format_coupling coeff c in begin match fusion with | F234 -> printf "a_hww_DW(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 wf3 p3 | F243 -> printf "a_hww_DW(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf3 p3 wf2 p2 | F342 -> printf "a_hww_DW(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf1 p1 wf2 p2 | F324 -> printf "a_hww_DW(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 wf3 p3 | F423 -> printf "a_hww_DW(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf3 p3 wf1 p1 | F432 -> printf "a_hww_DW(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf2 p2 wf1 p1 | F134 -> printf "h_aww_DW(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 wf3 p3 | F143 -> printf "h_aww_DW(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf3 p3 wf2 p2 | F341 -> printf "h_aww_DW(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf1 p1 wf2 p2 | F314 -> printf "h_aww_DW(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 wf3 p3 | F413 -> printf "h_aww_DW(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf3 p3 wf1 p1 | F431 -> printf "h_aww_DW(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf2 p2 wf1 p1 | F124 -> printf "w3_ahw_DW(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 wf3 p3 | F142 -> printf "w3_ahw_DW(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf3 p3 wf2 p2 | F241 -> printf "w3_ahw_DW(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf1 p1 wf2 p2 | F214 -> printf "w3_ahw_DW(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 wf3 p3 | F412 -> printf "w3_ahw_DW(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf3 p3 wf1 p1 | F421 -> printf "w3_ahw_DW(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf2 p2 wf1 p1 | F123 -> printf "w4_ahw_DW(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 wf3 p3 | F132 -> printf "w4_ahw_DW(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf3 p3 wf2 p2 | F231 -> printf "w4_ahw_DW(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf1 p1 wf2 p2 | F213 -> printf "w4_ahw_DW(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 wf3 p3 | F312 -> printf "w4_ahw_DW(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf3 p3 wf1 p1 | F321 -> printf "w4_ahw_DW(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf2 p2 wf1 p1 (*i | F234 | F134 | F124 | F123 -> printf "a_hww_DW(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 wf3 p3 | F243 | F143 | F142 | F132 -> printf "a_hww_DW(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf3 p3 wf2 p2 | F342 | F341 | F241 | F231 -> printf "a_hww_DW(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf1 p1 wf2 p2 | F324 | F314 | F214 | F213 -> printf "a_hww_DW(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 wf3 p3 | F423 | F413 | F412 | F312 -> printf "a_hww_DW(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf3 p3 wf1 p1 | F432 | F431 | F421 | F321 -> printf "a_hww_DW(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf2 p2 wf1 p1 i*) end | Dim6_Scalar2_Vector2_D coeff -> let c = format_coupling coeff c in begin match fusion with | F234 | F134 -> printf "h_hww_D(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 wf3 p3 | F243 | F143 -> printf "h_hww_D(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf3 p3 wf2 p2 | F342 | F341 -> printf "h_hww_D(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf1 p1 wf2 p2 | F324 | F314 -> printf "h_hww_D(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 wf3 p3 | F423 | F413 -> printf "h_hww_D(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf3 p3 wf1 p1 | F432 | F431 -> printf "h_hww_D(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf2 p2 wf1 p1 | F124 | F123 -> printf "w_hhw_D(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 wf3 p3 | F142 | F132 -> printf "w_hhw_D(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf3 p3 wf2 p2 | F241 | F231 -> printf "w_hhw_D(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf1 p1 wf2 p2 | F214 | F213 -> printf "w_hhw_D(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 wf3 p3 | F412 | F312 -> printf "w_hhw_D(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf3 p3 wf1 p1 | F421 | F321 -> printf "w_hhw_D(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf2 p2 wf1 p1 end | Dim6_Scalar2_Vector2_DP coeff -> let c = format_coupling coeff c in begin match fusion with | F234 | F134 -> printf "h_hww_DP(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 wf3 p3 | F342 | F341 -> printf "h_hww_DP(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf1 p1 wf2 p2 | F423 | F413 -> printf "h_hww_DP(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf3 p3 wf1 p1 | F243 | F143 -> printf "h_hww_DP(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf3 p3 wf2 p2 | F324 | F314 -> printf "h_hww_DP(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 wf3 p3 | F432 | F431 -> printf "h_hww_DP(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf2 p2 wf1 p1 | F123 | F124 -> printf "w_hhw_DP(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 wf3 p3 | F231 | F241-> printf "w_hhw_DP(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf1 p1 wf2 p2 | F312 | F412 -> printf "w_hhw_DP(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf3 p3 wf1 p1 | F132 | F142-> printf "w_hhw_DP(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf3 p3 wf2 p2 | F213 | F214 -> printf "w_hhw_DP(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 wf3 p3 | F321 | F421 -> printf "w_hhw_DP(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf2 p2 wf1 p1 (*i | F234 -> printf "h_hww_DPW(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 wf3 p3 | F243 -> printf "h_hww_DPW(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf3 p3 wf2 p2 | F342 -> printf "h_hww_DPW(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf1 p1 wf2 p2 | F324 -> printf "h_hww_DPW(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 wf3 p3 | F423 -> printf "h_hww_DPW(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf3 p3 wf1 p1 | F432 -> printf "h_hww_DPW(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf2 p2 wf1 p1 | F124 -> printf "w_hhw_DPW(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 wf3 p3 | F142 -> printf "w_hhw_DPW(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf3 p3 wf2 p2 | F241 -> printf "w_hhw_DPW(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf1 p1 wf2 p2 | F214 -> printf "w_hhw_DPW(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 wf3 p3 | F412 -> printf "w_hhw_DPW(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf3 p3 wf1 p1 | F421 -> printf "w_hhw_DPW(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf2 p2 wf1 p1 | F134 -> printf "h_hww_DPW(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 wf3 p3 | F143 -> printf "h_hww_DPW(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf3 p3 wf2 p2 | F341 -> printf "h_hww_DPW(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf1 p1 wf2 p2 | F314 -> printf "h_hww_DPW(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 wf3 p3 | F413 -> printf "h_hww_DPW(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf3 p3 wf1 p1 | F431 -> printf "h_hww_DPW(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf2 p2 wf1 p1 | F123 -> printf "w_hhw_DPW(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 wf3 p3 | F132 -> printf "w_hhw_DPW(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf3 p3 wf2 p2 | F231 -> printf "w_hhw_DPW(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf1 p1 wf2 p2 | F213 -> printf "w_hhw_DPW(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 wf3 p3 | F312 -> printf "w_hhw_DPW(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf3 p3 wf1 p1 | F321 -> printf "w_hhw_DPW(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf2 p2 wf1 p1 i*) end | Dim6_Scalar2_Vector2_PB coeff -> let c = format_coupling coeff c in begin match fusion with | F234 | F134 -> printf "h_hvv_PB(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 wf3 p3 | F342 | F341 -> printf "h_hvv_PB(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf1 p1 wf2 p2 | F423 | F413 -> printf "h_hvv_PB(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf3 p3 wf1 p1 | F243 | F143 -> printf "h_hvv_PB(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf3 p3 wf2 p2 | F324 | F314 -> printf "h_hvv_PB(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 wf3 p3 | F432 | F431 -> printf "h_hvv_PB(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf2 p2 wf1 p1 | F123 | F124 -> printf "v_hhv_PB(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 wf3 p3 | F231 | F241-> printf "v_hhv_PB(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf1 p1 wf2 p2 | F312 | F412 -> printf "v_hhv_PB(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf3 p3 wf1 p1 | F132 | F142-> printf "v_hhv_PB(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf3 p3 wf2 p2 | F213 | F214 -> printf "v_hhv_PB(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 wf3 p3 | F321 | F421 -> printf "v_hhv_PB(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf2 p2 wf1 p1 end | Dim6_HHZZ_T coeff -> let c = format_coupling coeff c in begin match fusion with | F234 | F134 -> printf "(%s)*(%s)*(%s)*(%s)" c wf1 wf2 wf3 | F342 | F341 -> printf "(%s)*(%s)*(%s)*(%s)" c wf3 wf1 wf2 | F423 | F413 -> printf "(%s)*(%s)*(%s)*(%s)" c wf2 wf3 wf1 | F243 | F143 -> printf "(%s)*(%s)*(%s)*(%s)" c wf1 wf3 wf2 | F324 | F314 -> printf "(%s)*(%s)*(%s)*(%s)" c wf2 wf1 wf3 | F432 | F431 -> printf "(%s)*(%s)*(%s)*(%s)" c wf3 wf2 wf1 | F123 | F124 | F231 | F241 | F312 | F412 -> printf "(%s)*(%s)*(%s)*(%s)" c wf1 wf2 wf3 | F132 | F142 | F213 | F214 | F321 | F421 -> printf "(%s)*(%s)*(%s)*(%s)" c wf1 wf2 wf3 end | Dim6_Vector4_DW coeff -> let c = format_coupling coeff c in begin match fusion with | F234 | F134 -> printf "a_aww_DW(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 wf3 p3 | F342 | F341 -> printf "a_aww_DW(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf1 p1 wf2 p2 | F423 | F413 -> printf "a_aww_DW(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf3 p3 wf1 p1 | F243 | F143 -> printf "a_aww_DW(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf3 p3 wf2 p2 | F324 | F314 -> printf "a_aww_DW(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 wf3 p3 | F432 | F431 -> printf "a_aww_DW(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf2 p2 wf1 p1 | F124 | F123 -> printf "w_aaw_DW(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 wf3 p3 | F241 | F231 -> printf "w_aaw_DW(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf1 p1 wf2 p2 | F412 | F312 -> printf "w_aaw_DW(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf3 p3 wf1 p1 | F142 | F132 -> printf "w_aaw_DW(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf3 p3 wf2 p2 | F214 | F213 -> printf "w_aaw_DW(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 wf3 p3 | F421 | F321 -> printf "w_aaw_DW(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf2 p2 wf1 p1 end | Dim6_Vector4_W coeff -> let c = format_coupling coeff c in begin match fusion with | F234 | F134 -> printf "a_aww_W(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 wf3 p3 | F342 | F341 -> printf "a_aww_W(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf1 p1 wf2 p2 | F423 | F413 -> printf "a_aww_W(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf3 p3 wf1 p1 | F243 | F143 -> printf "a_aww_W(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf3 p3 wf2 p2 | F324 | F314 -> printf "a_aww_W(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 wf3 p3 | F432 | F431 -> printf "a_aww_W(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf2 p2 wf1 p1 | F123 | F124 -> printf "w_aaw_W(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 wf3 p3 | F231 | F241-> printf "w_aaw_W(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf1 p1 wf2 p2 | F312 | F412 -> printf "w_aaw_W(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf3 p3 wf1 p1 | F132 | F142-> printf "w_aaw_W(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf3 p3 wf2 p2 | F213 | F214 -> printf "w_aaw_W(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 wf3 p3 | F321 | F421 -> printf "w_aaw_W(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf2 p2 wf1 p1 end | Dim6_HWWZ_DW coeff -> let c = format_coupling coeff c in begin match fusion with | F234 -> printf "h_wwz_DW(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 wf3 p3 | F243 -> printf "h_wwz_DW(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf3 p3 wf2 p2 | F342 -> printf "h_wwz_DW(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf1 p1 wf2 p2 | F324 -> printf "h_wwz_DW(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 wf3 p3 | F423 -> printf "h_wwz_DW(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf3 p3 wf1 p1 | F432 -> printf "h_wwz_DW(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf2 p2 wf1 p1 | F124 -> printf "(-1)*w_hwz_DW(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 wf3 p3 | F142 -> printf "(-1)*w_hwz_DW(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf3 p3 wf2 p2 | F241 -> printf "(-1)*w_hwz_DW(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf1 p1 wf2 p2 | F214 -> printf "(-1)*w_hwz_DW(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 wf3 p3 | F412 -> printf "(-1)*w_hwz_DW(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf3 p3 wf1 p1 | F421 -> printf "(-1)*w_hwz_DW(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf2 p2 wf1 p1 | F134 -> printf "w_hwz_DW(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 wf3 p3 | F143 -> printf "w_hwz_DW(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf3 p3 wf2 p2 | F341 -> printf "w_hwz_DW(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf1 p1 wf2 p2 | F314 -> printf "w_hwz_DW(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 wf3 p3 | F413 -> printf "w_hwz_DW(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf3 p3 wf1 p1 | F431 -> printf "w_hwz_DW(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf2 p2 wf1 p1 | F123 -> printf "z_hww_DW(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 wf3 p3 | F132 -> printf "z_hww_DW(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf3 p3 wf2 p2 | F231 -> printf "z_hww_DW(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf1 p1 wf2 p2 | F213 -> printf "z_hww_DW(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 wf3 p3 | F312 -> printf "z_hww_DW(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf3 p3 wf1 p1 | F321 -> printf "z_hww_DW(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf2 p2 wf1 p1 end | Dim6_HWWZ_DPB coeff -> let c = format_coupling coeff c in begin match fusion with | F234 -> printf "h_wwz_DPB(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 wf3 p3 | F243 -> printf "h_wwz_DPB(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf3 p3 wf2 p2 | F342 -> printf "h_wwz_DPB(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf1 p1 wf2 p2 | F324 -> printf "h_wwz_DPB(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 wf3 p3 | F423 -> printf "h_wwz_DPB(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf3 p3 wf1 p1 | F432 -> printf "h_wwz_DPB(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf2 p2 wf1 p1 | F124 -> printf "(-1)*w_hwz_DPB(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 wf3 p3 | F142 -> printf "(-1)*w_hwz_DPB(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf3 p3 wf2 p2 | F241 -> printf "(-1)*w_hwz_DPB(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf1 p1 wf2 p2 | F214 -> printf "(-1)*w_hwz_DPB(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 wf3 p3 | F412 -> printf "(-1)*w_hwz_DPB(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf3 p3 wf1 p1 | F421 -> printf "(-1)*w_hwz_DPB(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf2 p2 wf1 p1 | F134 -> printf "w_hwz_DPB(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 wf3 p3 | F143 -> printf "w_hwz_DPB(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf3 p3 wf2 p2 | F341 -> printf "w_hwz_DPB(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf1 p1 wf2 p2 | F314 -> printf "w_hwz_DPB(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 wf3 p3 | F413 -> printf "w_hwz_DPB(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf3 p3 wf1 p1 | F431 -> printf "w_hwz_DPB(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf2 p2 wf1 p1 | F123 -> printf "z_hww_DPB(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 wf3 p3 | F132 -> printf "z_hww_DPB(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf3 p3 wf2 p2 | F231 -> printf "z_hww_DPB(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf1 p1 wf2 p2 | F213 -> printf "z_hww_DPB(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 wf3 p3 | F312 -> printf "z_hww_DPB(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf3 p3 wf1 p1 | F321 -> printf "z_hww_DPB(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf2 p2 wf1 p1 end | Dim6_HWWZ_DDPW coeff -> let c = format_coupling coeff c in begin match fusion with | F234 -> printf "h_wwz_DDPW(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 wf3 p3 | F243 -> printf "h_wwz_DDPW(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf3 p3 wf2 p2 | F342 -> printf "h_wwz_DDPW(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf1 p1 wf2 p2 | F324 -> printf "h_wwz_DDPW(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 wf3 p3 | F423 -> printf "h_wwz_DDPW(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf3 p3 wf1 p1 | F432 -> printf "h_wwz_DDPW(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf2 p2 wf1 p1 | F124 -> printf "(-1)*w_hwz_DDPW(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 wf3 p3 | F142 -> printf "(-1)*w_hwz_DDPW(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf3 p3 wf2 p2 | F241 -> printf "(-1)*w_hwz_DDPW(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf1 p1 wf2 p2 | F214 -> printf "(-1)*w_hwz_DDPW(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 wf3 p3 | F412 -> printf "(-1)*w_hwz_DDPW(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf3 p3 wf1 p1 | F421 -> printf "(-1)*w_hwz_DDPW(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf2 p2 wf1 p1 | F134 -> printf "w_hwz_DDPW(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 wf3 p3 | F143 -> printf "w_hwz_DDPW(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf3 p3 wf2 p2 | F341 -> printf "w_hwz_DDPW(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf1 p1 wf2 p2 | F314 -> printf "w_hwz_DDPW(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 wf3 p3 | F413 -> printf "w_hwz_DDPW(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf3 p3 wf1 p1 | F431 -> printf "w_hwz_DDPW(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf2 p2 wf1 p1 | F123 -> printf "z_hww_DDPW(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 wf3 p3 | F132 -> printf "z_hww_DDPW(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf3 p3 wf2 p2 | F231 -> printf "z_hww_DDPW(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf1 p1 wf2 p2 | F213 -> printf "z_hww_DDPW(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 wf3 p3 | F312 -> printf "z_hww_DDPW(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf3 p3 wf1 p1 | F321 -> printf "z_hww_DDPW(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf2 p2 wf1 p1 end | Dim6_HWWZ_DPW coeff -> let c = format_coupling coeff c in begin match fusion with | F234 -> printf "h_wwz_DPW(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 wf3 p3 | F243 -> printf "h_wwz_DPW(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf3 p3 wf2 p2 | F342 -> printf "h_wwz_DPW(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf1 p1 wf2 p2 | F324 -> printf "h_wwz_DPW(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 wf3 p3 | F423 -> printf "h_wwz_DPW(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf3 p3 wf1 p1 | F432 -> printf "h_wwz_DPW(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf2 p2 wf1 p1 | F124 -> printf "(-1)*w_hwz_DPW(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 wf3 p3 | F142 -> printf "(-1)*w_hwz_DPW(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf3 p3 wf2 p2 | F241 -> printf "(-1)*w_hwz_DPW(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf1 p1 wf2 p2 | F214 -> printf "(-1)*w_hwz_DPW(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 wf3 p3 | F412 -> printf "(-1)*w_hwz_DPW(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf3 p3 wf1 p1 | F421 -> printf "(-1)*w_hwz_DPW(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf2 p2 wf1 p1 | F134 -> printf "w_hwz_DPW(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 wf3 p3 | F143 -> printf "w_hwz_DPW(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf3 p3 wf2 p2 | F341 -> printf "w_hwz_DPW(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf1 p1 wf2 p2 | F314 -> printf "w_hwz_DPW(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 wf3 p3 | F413 -> printf "w_hwz_DPW(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf3 p3 wf1 p1 | F431 -> printf "w_hwz_DPW(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf2 p2 wf1 p1 | F123 -> printf "z_hww_DPW(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 wf3 p3 | F132 -> printf "z_hww_DPW(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf3 p3 wf2 p2 | F231 -> printf "z_hww_DPW(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf1 p1 wf2 p2 | F213 -> printf "z_hww_DPW(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 wf3 p3 | F312 -> printf "z_hww_DPW(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf3 p3 wf1 p1 | F321 -> printf "z_hww_DPW(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf2 p2 wf1 p1 end | Dim6_AHHZ_D coeff -> let c = format_coupling coeff c in begin match fusion with | F234 -> printf "a_hhz_D(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 wf3 p3 | F243 -> printf "a_hhz_D(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf3 p3 wf2 p2 | F342 -> printf "a_hhz_D(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf1 p1 wf2 p2 | F324 -> printf "a_hhz_D(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 wf3 p3 | F423 -> printf "a_hhz_D(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf3 p3 wf1 p1 | F432 -> printf "a_hhz_D(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf2 p2 wf1 p1 | F124 -> printf "h_ahz_D(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 wf3 p3 | F142 -> printf "h_ahz_D(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf3 p3 wf2 p2 | F241 -> printf "h_ahz_D(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf1 p1 wf2 p2 | F214 -> printf "h_ahz_D(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 wf3 p3 | F412 -> printf "h_ahz_D(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf3 p3 wf1 p1 | F421 -> printf "h_ahz_D(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf2 p2 wf1 p1 | F134 -> printf "h_ahz_D(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 wf3 p3 | F143 -> printf "h_ahz_D(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf3 p3 wf2 p2 | F341 -> printf "h_ahz_D(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf1 p1 wf2 p2 | F314 -> printf "h_ahz_D(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 wf3 p3 | F413 -> printf "h_ahz_D(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf3 p3 wf1 p1 | F431 -> printf "h_ahz_D(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf2 p2 wf1 p1 | F123 -> printf "z_ahh_D(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 wf3 p3 | F132 -> printf "z_ahh_D(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf3 p3 wf2 p2 | F231 -> printf "z_ahh_D(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf1 p1 wf2 p2 | F213 -> printf "z_ahh_D(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 wf3 p3 | F312 -> printf "z_ahh_D(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf3 p3 wf1 p1 | F321 -> printf "z_ahh_D(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf2 p2 wf1 p1 end | Dim6_AHHZ_DP coeff -> let c = format_coupling coeff c in begin match fusion with | F234 -> printf "a_hhz_DP(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 wf3 p3 | F243 -> printf "a_hhz_DP(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf3 p3 wf2 p2 | F342 -> printf "a_hhz_DP(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf1 p1 wf2 p2 | F324 -> printf "a_hhz_DP(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 wf3 p3 | F423 -> printf "a_hhz_DP(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf3 p3 wf1 p1 | F432 -> printf "a_hhz_DP(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf2 p2 wf1 p1 | F124 -> printf "h_ahz_DP(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 wf3 p3 | F142 -> printf "h_ahz_DP(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf3 p3 wf2 p2 | F241 -> printf "h_ahz_DP(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf1 p1 wf2 p2 | F214 -> printf "h_ahz_DP(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 wf3 p3 | F412 -> printf "h_ahz_DP(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf3 p3 wf1 p1 | F421 -> printf "h_ahz_DP(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf2 p2 wf1 p1 | F134 -> printf "h_ahz_DP(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 wf3 p3 | F143 -> printf "h_ahz_DP(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf3 p3 wf2 p2 | F341 -> printf "h_ahz_DP(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf1 p1 wf2 p2 | F314 -> printf "h_ahz_DP(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 wf3 p3 | F413 -> printf "h_ahz_DP(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf3 p3 wf1 p1 | F431 -> printf "h_ahz_DP(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf2 p2 wf1 p1 | F123 -> printf "z_ahh_DP(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 wf3 p3 | F132 -> printf "z_ahh_DP(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf3 p3 wf2 p2 | F231 -> printf "z_ahh_DP(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf1 p1 wf2 p2 | F213 -> printf "z_ahh_DP(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 wf3 p3 | F312 -> printf "z_ahh_DP(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf3 p3 wf1 p1 | F321 -> printf "z_ahh_DP(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf2 p2 wf1 p1 end | Dim6_AHHZ_PB coeff -> let c = format_coupling coeff c in begin match fusion with | F234 -> printf "a_hhz_PB(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 wf3 p3 | F243 -> printf "a_hhz_PB(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf3 p3 wf2 p2 | F342 -> printf "a_hhz_PB(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf1 p1 wf2 p2 | F324 -> printf "a_hhz_PB(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 wf3 p3 | F423 -> printf "a_hhz_PB(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf3 p3 wf1 p1 | F432 -> printf "a_hhz_PB(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf2 p2 wf1 p1 | F124 -> printf "h_ahz_PB(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 wf3 p3 | F142 -> printf "h_ahz_PB(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf3 p3 wf2 p2 | F241 -> printf "h_ahz_PB(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf1 p1 wf2 p2 | F214 -> printf "h_ahz_PB(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 wf3 p3 | F412 -> printf "h_ahz_PB(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf3 p3 wf1 p1 | F421 -> printf "h_ahz_PB(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf2 p2 wf1 p1 | F134 -> printf "h_ahz_PB(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 wf3 p3 | F143 -> printf "h_ahz_PB(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf3 p3 wf2 p2 | F341 -> printf "h_ahz_PB(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf1 p1 wf2 p2 | F314 -> printf "h_ahz_PB(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 wf3 p3 | F413 -> printf "h_ahz_PB(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf3 p3 wf1 p1 | F431 -> printf "h_ahz_PB(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf2 p2 wf1 p1 | F123 -> printf "z_ahh_PB(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2 wf3 p3 | F132 -> printf "z_ahh_PB(%s,%s,%s,%s,%s,%s,%s)" c wf1 p1 wf3 p3 wf2 p2 | F231 -> printf "z_ahh_PB(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf1 p1 wf2 p2 | F213 -> printf "z_ahh_PB(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1 wf3 p3 | F312 -> printf "z_ahh_PB(%s,%s,%s,%s,%s,%s,%s)" c wf2 p2 wf3 p3 wf1 p1 | F321 -> printf "z_ahh_PB(%s,%s,%s,%s,%s,%s,%s)" c wf3 p3 wf2 p2 wf1 p1 end (* \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 (* \begin{dubious} This reproduces the hack on page~\pageref{hack:sign(V4)} and gives the correct results up to quartic vertices. Make sure that it is also correct in light of~\eqref{eq:factors-of-i}, i.\,e. \begin{equation*} \ii T = \ii^{\#\text{vertices}}\ii^{\#\text{propagators}} \cdots = \ii^{n-2}\ii^{n-3} \cdots = -\ii(-1)^n \cdots \end{equation*} \end{dubious} *) | Vn (UFO (c, v, s, _, color), fusion, constant) -> if Color.Vertex.trivial color then let g = CM.constant_symbol constant and chn = F.children rhs in let wfs = List.map (multiple_variable amplitude dictionary) chn and ps = List.map momentum chn in let n = List.length fusion in let eps = if n mod 2 = 0 then -1 else 1 in printf "@, %s " (if (eps * F.sign rhs) < 0 then "-" else "+"); UFO.Targets.Fortran.fuse c v s g wfs ps fusion else failwith "print_current: nontrivial color structure" 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 | Complex_Mass -> gamma | Timelike -> "wd_tl(" ^ p ^ "," ^ gamma ^ ")" | Running -> failwith "Targets.Fortran: running width not yet available" | Custom f -> f ^ "(" ^ p ^ "," ^ gamma ^ ")" end in let cms = begin match CM.width f with | Complex_Mass -> ".true." | _ -> ".false." 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,%s," Fermions.psi_propagator p m w cms | Prop_ConjSpinor -> printf "%s(%s,%s,%s,%s," Fermions.psibar_propagator p m w cms | Prop_Majorana -> printf "%s(%s,%s,%s,%s," Fermions.chi_propagator p m w cms | Prop_Col_Majorana -> printf "%s * %s(%s,%s,%s,%s," minus_third Fermions.chi_propagator p m w cms | Prop_Unitarity -> printf "pr_unitarity(%s,%s,%s,%s," p m w cms | Prop_Col_Unitarity -> printf "%s * pr_unitarity(%s,%s,%s,%s," minus_third p m w cms | 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_Tensor_pure -> printf "pr_tensor_pure(%s,%s,%s," p m w | Prop_Vector_pure -> printf "pr_vector_pure(%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 "(" | Aux_Col_Scalar | Aux_Col_Vector | Aux_Col_Tensor_1 -> printf "%s * (" minus_third | Only_Insertion -> printf "(" + | Prop_UFO name -> + printf "pr_U_%s(%s,%s,%s," name p m w 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 _ -> invalid_arg "no on-shell massless gauge propagator!" | Prop_Rxi _ -> 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 | Prop_Tensor_pure -> invalid_arg "no on-shell pure Tensor propagator!" | Prop_Vector_pure -> invalid_arg "no on-shell pure Vector propagator!" | Aux_Scalar | Aux_Spinor | Aux_ConjSpinor | Aux_Majorana | Aux_Vector | Aux_Tensor_1 -> printf "(" | Aux_Col_Scalar | Aux_Col_Vector | Aux_Col_Tensor_1 -> printf "%s * (" minus_third | Only_Insertion -> printf "(" + | Prop_UFO name -> + invalid_arg "no on shell UFO propagator" 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 _ -> invalid_arg "no on-shell massless gauge propagator!" | Prop_Rxi _ -> invalid_arg "no on-shell Rxi propagator!" | Prop_Tensor_2 -> printf "pg_tensor(%s,%s,%s," p m gamma | Prop_Tensor_pure -> invalid_arg "no pure tensor propagator!" | Prop_Vector_pure -> invalid_arg "no pure vector propagator!" | Aux_Scalar | Aux_Spinor | Aux_ConjSpinor | Aux_Majorana | Aux_Vector | Aux_Tensor_1 -> printf "(" | Only_Insertion -> printf "(" + | Prop_UFO name -> + invalid_arg "no UFO gauss insertion" | _ -> 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 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) let print_fusions dictionary fusions = List.iter (fun (f, amplitude) -> print_fusion_diagnostics amplitude dictionary f; print_fusion amplitude dictionary f) fusions 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} \label{eq:factors-of-i} \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 " @[<2>%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 " @[<2>%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" (*i unused value 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" i*) (*i unused value 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 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 i*) 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 " @[<2>%s =@, " (variable wf); (if incoming then print_incoming else print_outgoing) wf; nl () end; WFSet.add wf seen) seen_wfs externals (*i unused value let flavors_to_string flavors = String.concat " " (List.map CM.flavor_to_string flavors) i*) (*i unused value let process_to_string amplitude = flavors_to_string (F.incoming amplitude) ^ " -> " ^ flavors_to_string (F.outgoing amplitude) i*) let flavors_sans_color_to_string flavors = String.concat " " (List.map 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) (* \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 elegant 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 :: %s = %d" name value; nl () let print_real_parameter name value = printf " @[<2>real(kind=%s), parameter :: %s = %d" !kind name value; nl () let print_logical_parameter name value = printf " @[<2>logical, parameter :: %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 amplitudes = List.length (CF.color_flows amplitudes) let num_color_indices_default = 2 (* Standard model *) let num_color_indices amplitudes = try CFlow.rank (List.hd (CF.color_flows amplitudes)) 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 protected = ", protected" (* Fortran 2003! *) (*i unused value let print_spin_table_old abbrev name = function | [] -> printf " @[<2>integer, dimension(n_prt,0) ::"; 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 ::"; 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 () i*) let print_spin_table name tuples = printf " @[<2>integer, dimension(n_prt,n_hel), save%s :: table_spin_%s" protected name; nl (); match tuples with | [] -> () | _ -> ignore (List.fold_left (fun i (tuple1, tuple2) -> printf " @[<2>data table_spin_%s(:,%4d) / %s /" name i (String.concat ", " (List.map (Printf.sprintf "%2d") (tuple1 @ tuple2))); nl (); succ i) 1 tuples) let print_spin_tables amplitudes = (* [print_spin_table_old "s" "states_old" (CF.helicities amplitudes);] *) print_spin_table "states" (CF.helicities amplitudes); nl () (*i unused value let print_flavor_table_old n abbrev name = function | [] -> printf " @[<2>integer, dimension(n_prt,0) ::"; 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" (M.pdg f)) tuple)) (String.concat " " (List.map M.flavor_to_string tuple)); nl (); succ i) 1 tuples); printf " @[<2>integer, dimension(n_prt,n_flv), parameter ::"; 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 () i*) let print_flavor_table name tuples = printf " @[<2>integer, dimension(n_prt,n_flv), save%s :: table_flavor_%s" protected name; nl (); match tuples with | [] -> () | _ -> ignore (List.fold_left (fun i tuple -> printf " @[<2>data table_flavor_%s(:,%4d) / %s / ! %s" name i (String.concat ", " (List.map (fun f -> Printf.sprintf "%3d" (M.pdg f)) tuple)) (String.concat " " (List.map M.flavor_to_string tuple)); nl (); succ i) 1 tuples) let print_flavor_tables amplitudes = (* [let n = num_particles amplitudes in] *) (* [print_flavor_table_old n "f" "states_old" (List.map (fun (fin, fout) -> fin @ fout) (CF.flavors amplitudes));] *) print_flavor_table "states" (List.map (fun (fin, fout) -> fin @ fout) (CF.flavors amplitudes)); nl () let num_flavors amplitudes = List.length (CF.flavors amplitudes) (*i unused value let print_color_flows_table_old abbrev = function | [] -> printf " @[<2>integer, dimension(n_cindex, n_prt, n_cflow) ::"; 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 ::"; printf "@ table_color_flows_old =@ 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 () i*) (*i unused value let print_ghost_flags_table_old abbrev = function | [] -> printf " @[<2>logical, dimension(n_prt, n_cflow) ::"; 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 ::"; printf "@ table_ghost_flags_old =@ 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 () i*) let print_color_flows_table tuples = printf " @[<2>integer, dimension(n_cindex,n_prt,n_cflow), save%s :: table_color_flows" protected; nl (); match tuples with | [] -> () | _ :: _ as tuples -> ignore (List.fold_left (fun i tuple -> begin match CFlow.to_lists tuple with | [] -> () | cf1 :: cfn -> printf " @[<2>data table_color_flows(:,:,%4d) /" i; 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; printf "@ /"; nl () end; succ i) 1 tuples) let print_ghost_flags_table tuples = printf " @[<2>logical, dimension(n_prt,n_cflow), save%s :: table_ghost_flags" protected; nl (); match tuples with | [] -> () | _ -> ignore (List.fold_left (fun i tuple -> begin match CFlow.ghost_flags tuple with | [] -> () | gf1 :: gfn -> printf " @[<2>data table_ghost_flags(:,%4d) /" i; printf "@ %s" (if gf1 then "T" else "F"); List.iter (function gf -> printf ",@ %s" (if gf then "T" else "F")) gfn; printf " /"; nl () end; succ i) 1 tuples) let format_power_of x { Color.Flow.num = num; Color.Flow.den = den; Color.Flow.power = pwr } = match num, den, pwr with | _, 0, _ -> invalid_arg "format_power_of: zero denominator" | 0, _, _ -> "+zero" | 1, 1, 0 | -1, -1, 0 -> "+one" | -1, 1, 0 | 1, -1, 0 -> "-one" | 1, 1, 1 | -1, -1, 1 -> "+" ^ x | -1, 1, 1 | 1, -1, 1 -> "-" ^ x | 1, 1, -1 | -1, -1, -1 -> "+1/" ^ x | -1, 1, -1 | 1, -1, -1 -> "-1/" ^ x | 1, 1, p | -1, -1, p -> "+" ^ (if p > 0 then "" else "1/") ^ x ^ "**" ^ string_of_int (abs p) | -1, 1, p | 1, -1, p -> "-" ^ (if p > 0 then "" else "1/") ^ x ^ "**" ^ string_of_int (abs p) | n, 1, 0 -> (if n < 0 then "-" else "+") ^ string_of_int (abs n) ^ ".0_" ^ !kind | n, d, 0 -> (if n * d < 0 then "-" else "+") ^ string_of_int (abs n) ^ ".0_" ^ !kind ^ "/" ^ string_of_int (abs d) | n, 1, 1 -> (if n < 0 then "-" else "+") ^ string_of_int (abs n) ^ "*" ^ x | n, 1, -1 -> (if n < 0 then "-" else "+") ^ string_of_int (abs n) ^ "/" ^ x | n, d, 1 -> (if n * d < 0 then "-" else "+") ^ string_of_int (abs n) ^ ".0_" ^ !kind ^ "/" ^ string_of_int (abs d) ^ "*" ^ x | n, d, -1 -> (if n * d < 0 then "-" else "+") ^ string_of_int (abs n) ^ ".0_" ^ !kind ^ "/" ^ string_of_int (abs d) ^ "/" ^ x | n, 1, p -> (if n < 0 then "-" else "+") ^ string_of_int (abs n) ^ (if p > 0 then "*" else "/") ^ x ^ "**" ^ string_of_int (abs p) | n, d, p -> (if n * d < 0 then "-" else "+") ^ string_of_int (abs n) ^ ".0_" ^ !kind ^ "/" ^ string_of_int (abs d) ^ (if p > 0 then "*" else "/") ^ x ^ "**" ^ string_of_int (abs p) let format_powers_of x = function | [] -> "zero" | powers -> String.concat "" (List.map (format_power_of x) powers) (*i unused value let print_color_factor_table_old table = let n_cflow = Array.length table in let n_cfactors = ref 0 in for c1 = 0 to pred n_cflow do for c2 = 0 to pred n_cflow do match table.(c1).(c2) with | [] -> () | _ -> incr n_cfactors done done; print_integer_parameter "n_cfactors" !n_cfactors; if n_cflow <= 0 then begin printf " @[<2>type(%s), dimension(n_cfactors) ::" omega_color_factor_abbrev; printf "@ table_color_factors"; nl () end else begin printf " @[<2>type(%s), dimension(n_cfactors), parameter ::" omega_color_factor_abbrev; printf "@ table_color_factors = (/@ "; let comma = ref "" in for c1 = 0 to pred n_cflow do for c2 = 0 to pred n_cflow do match table.(c1).(c2) with | [] -> () | cf -> printf "%s@ %s(%d,%d,%s)" !comma omega_color_factor_abbrev (succ c1) (succ c2) (format_powers_of nc_parameter cf); comma := "," done done; printf "@ /)"; nl () end i*) (* \begin{dubious} We can optimize the following slightly by reusing common color factor [parameter]s. \end{dubious} *) let print_color_factor_table table = let n_cflow = Array.length table in let n_cfactors = ref 0 in for c1 = 0 to pred n_cflow do for c2 = 0 to pred n_cflow do match table.(c1).(c2) with | [] -> () | _ -> incr n_cfactors done done; print_integer_parameter "n_cfactors" !n_cfactors; printf " @[<2>type(%s), dimension(n_cfactors), save%s ::" omega_color_factor_abbrev protected; printf "@ table_color_factors"; nl (); let i = ref 1 in if n_cflow > 0 then begin for c1 = 0 to pred n_cflow do for c2 = 0 to pred n_cflow do match table.(c1).(c2) with | [] -> () | cf -> printf " @[<2>real(kind=%s), parameter, private :: color_factor_%06d = %s" !kind !i (format_powers_of nc_parameter cf); nl (); printf " @[<2>data table_color_factors(%6d) / %s(%d,%d,color_factor_%06d) /" !i omega_color_factor_abbrev (succ c1) (succ c2) !i; incr i; nl (); done done end let print_color_tables amplitudes = let cflows = CF.color_flows amplitudes and cfactors = CF.color_factors amplitudes in (* [print_color_flows_table_old "c" cflows; nl ();] *) print_color_flows_table cflows; nl (); (* [print_ghost_flags_table_old "g" cflows; nl ();] *) print_ghost_flags_table cflows; nl (); (* [print_color_factor_table_old cfactors; nl ();] *) print_color_factor_table cfactors; nl () let option_to_logical = function | Some _ -> "T" | None -> "F" (*i unused value let print_flavor_color_table_old abbrev n_flv n_cflow table = if n_flv <= 0 || n_cflow <= 0 then begin printf " @[<2>logical, dimension(n_flv, n_cflow) ::"; 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 ::"; printf "@ flv_col_is_allowed_old =@ 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 i*) let print_flavor_color_table n_flv n_cflow table = printf " @[<2>logical, dimension(n_flv, n_cflow), save%s :: @ flv_col_is_allowed" protected; nl (); if n_flv > 0 then begin for c = 0 to pred n_cflow do printf " @[<2>data flv_col_is_allowed(:,%4d) /" (succ c); printf "@ %s" (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; end let print_amplitude_table a = (* [print_flavor_color_table_old "a" (num_flavors a) (List.length (CF.color_flows a)) (CF.process_table a); nl ();] *) print_flavor_color_table (num_flavors a) (List.length (CF.color_flows a)) (CF.process_table a); nl (); printf " @[<2>complex(kind=%s), dimension(n_flv, n_cflow, n_hel), save :: amp" !kind; nl (); nl () let print_helicity_selection_table () = printf " @[<2>logical, dimension(n_hel), save :: "; printf "hel_is_allowed = T"; nl (); printf " @[<2>real(kind=%s), dimension(n_hel), save :: " !kind; printf "hel_max_abs = 0"; nl (); printf " @[<2>real(kind=%s), save :: " !kind; printf "hel_sum_abs = 0, "; printf "hel_threshold = 1E10"; nl (); printf " @[<2>integer, save :: "; printf "hel_count = 0, "; printf "hel_cutoff = 100"; nl (); printf " @[<2>integer :: "; printf "i"; nl (); printf " @[<2>integer, save, dimension(n_hel) :: "; printf "hel_map = (/(i, i = 1, n_hel)/)"; nl (); printf " @[<2>integer, save :: hel_finite = n_hel"; nl (); nl () (* \thocwmodulesubsection{Optional MD5 sum function} *) let print_md5sum_functions = function | Some s -> 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 () | None -> () (* \thocwmodulesubsection{Maintenance \&\ Inquiry Functions} *) let print_maintenance_functions () = if !whizard then begin printf " subroutine init (par, scheme)"; nl (); printf " real(kind=%s), dimension(*), intent(in) :: par" !kind; nl (); printf " integer, intent(in) :: scheme"; nl (); printf " call import_from_whizard (par, scheme)"; nl (); printf " end subroutine init"; nl (); nl (); printf " subroutine final ()"; nl (); printf " end subroutine final"; nl (); nl (); printf " subroutine update_alpha_s (alpha_s)"; nl (); printf " real(kind=%s), intent(in) :: alpha_s" !kind; nl (); printf " call model_update_alpha_s (alpha_s)"; nl (); printf " end subroutine update_alpha_s"; nl (); nl () end let print_inquiry_function_openmp () = begin printf " pure function openmp_supported () result (status)"; nl (); printf " logical :: status"; nl (); printf " status = %s" (if !openmp then ".true." else ".false."); nl (); printf " end function openmp_supported"; nl (); nl () end (*i unused value let print_inquiry_function_declarations name = printf " @[<2>public :: number_%s,@ %s" name name; nl () i*) (*i unused value 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 () i*) let print_numeric_inquiry_functions (f, v) = printf " @[<5>"; if !fortran95 then printf "pure "; printf "function %s () result (n)" f; nl (); printf " integer :: n"; nl (); printf " n = %s" v; nl (); printf " end function %s" f; 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 number_color_factors () result (n)"; nl (); printf " integer :: n"; nl (); printf " n = size (table_color_factors)"; nl (); printf " end function number_color_factors"; nl (); nl (); printf " @[<5>"; if !fortran95 then printf "pure "; printf "subroutine color_factors (cf)"; nl (); printf " type(%s), dimension(:), intent(out) :: cf" omega_color_factor_abbrev; nl (); printf " cf = table_color_factors"; nl (); printf " end subroutine color_factors"; nl (); nl (); printf " @[<5>"; if !fortran95 && pure_unless_openmp then printf "pure "; printf "function color_sum (flv, hel) result (amp2)"; nl (); printf " integer, intent(in) :: flv, hel"; nl (); printf " real(kind=%s) :: amp2" !kind; nl (); printf " amp2 = real (omega_color_sum (flv, hel, amp, table_color_factors))"; nl (); printf " end function color_sum"; nl (); nl () let print_dispatch_functions () = printf " @[<5>"; printf "subroutine new_event (p)"; nl (); printf " real(kind=%s), dimension(0:3,*), intent(in) :: p" !kind; nl (); printf " logical :: mask_dirty"; nl (); printf " integer :: hel"; 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 @[<3>omega_update_helicity_selection@ (hel_count,@ amp,@ "; printf "hel_max_abs,@ hel_sum_abs,@ hel_is_allowed,@ hel_threshold,@ hel_cutoff,@ mask_dirty)"; nl (); printf " if (mask_dirty) then"; nl (); printf " hel_finite = 0"; nl (); printf " do hel = 1, n_hel"; nl (); printf " if (hel_is_allowed(hel)) then"; nl (); printf " hel_finite = hel_finite + 1"; nl (); printf " hel_map(hel_finite) = hel"; nl (); printf " end if"; nl (); printf " end do"; nl (); printf " end if"; 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=%s), intent(in) :: threshold" !kind; nl (); printf " integer, intent(in) :: cutoff"; nl (); printf " integer :: i"; 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 " hel_map = (/(i, i = 1, n_hel)/)"; nl (); printf " hel_finite = n_hel"; 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=%s) :: amp_result" !kind; nl (); printf " integer, intent(in) :: flv, hel, col"; nl (); printf " amp_result = amp(flv, col, hel)"; nl (); printf " end function get_amplitude"; nl (); nl () (* \thocwmodulesubsection{Main Function} *) let format_power_of_nc { Color.Flow.num = num; Color.Flow.den = den; Color.Flow.power = pwr } = match num, den, pwr with | _, 0, _ -> invalid_arg "format_power_of_nc: zero denominator" | 0, _, _ -> "" | 1, 1, 0 | -1, -1, 0 -> "+ 1" | -1, 1, 0 | 1, -1, 0 -> "- 1" | 1, 1, 1 | -1, -1, 1 -> "+ N" | -1, 1, 1 | 1, -1, 1 -> "- N" | 1, 1, -1 | -1, -1, -1 -> "+ 1/N" | -1, 1, -1 | 1, -1, -1 -> "- 1/N" | 1, 1, p | -1, -1, p -> "+ " ^ (if p > 0 then "" else "1/") ^ "N^" ^ string_of_int (abs p) | -1, 1, p | 1, -1, p -> "- " ^ (if p > 0 then "" else "1/") ^ "N^" ^ string_of_int (abs p) | n, 1, 0 -> (if n < 0 then "- " else "+ ") ^ string_of_int (abs n) | n, d, 0 -> (if n * d < 0 then "- " else "+ ") ^ string_of_int (abs n) ^ "/" ^ string_of_int (abs d) | n, 1, 1 -> (if n < 0 then "- " else "+ ") ^ string_of_int (abs n) ^ "N" | n, 1, -1 -> (if n < 0 then "- " else "+ ") ^ string_of_int (abs n) ^ "/N" | n, d, 1 -> (if n * d < 0 then "- " else "+ ") ^ string_of_int (abs n) ^ "/" ^ string_of_int (abs d) ^ "N" | n, d, -1 -> (if n * d < 0 then "- " else "+ ") ^ string_of_int (abs n) ^ "/" ^ string_of_int (abs d) ^ "/N" | n, 1, p -> (if n < 0 then "- " else "+ ") ^ string_of_int (abs n) ^ (if p > 0 then "*" else "/") ^ "N^" ^ string_of_int (abs p) | n, d, p -> (if n * d < 0 then "- " else "+ ") ^ string_of_int (abs n) ^ "/" ^ string_of_int (abs d) ^ (if p > 0 then "*" else "/") ^ "N^" ^ string_of_int (abs p) let format_powers_of_nc = function | [] -> "0" | powers -> String.concat " " (List.map format_power_of_nc powers) let print_description cmdline amplitudes () = printf "! File generated automatically by O'Mega %s %s %s" Config.version Config.status Config.date; 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 (); if not !amp_triv then begin 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 (); end; printf "!"; nl (); printf "! Color Factors:"; nl (); printf "!"; nl (); if not !amp_triv then begin let cfactors = CF.color_factors amplitudes in for c1 = 0 to pred (Array.length cfactors) do for c2 = 0 to c1 do match cfactors.(c1).(c2) with | [] -> () | cfactor -> printf "! (%3d,%3d): %s" (succ c1) (succ c2) (format_powers_of_nc cfactor); nl () done done; end; printf "!"; nl (); printf "! vanishing or redundant 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; printf "!"; nl () (* \thocwmodulesubsection{Printing Modules} *) type accessibility = | Public | Private | Protected (* Fortran 2003 *) let accessibility_to_string = function | Public -> "public" | Private -> "private" | Protected -> "protected" type used_symbol = | As_Is of string | Aliased of string * string let print_used_symbol = function | As_Is name -> printf "%s" name | Aliased (orig, alias) -> printf "%s => %s" alias orig type used_module = | Full of string | Full_Aliased of string * (string * string) list | Subset of string * used_symbol list let print_used_module = function | Full name | Full_Aliased (name, []) | Subset (name, []) -> printf " use %s" name; nl () | Full_Aliased (name, aliases) -> printf " @[<5>use %s" name; List.iter (fun (orig, alias) -> printf ", %s => %s" alias orig) aliases; nl () | Subset (name, used_symbol :: used_symbols) -> printf " @[<5>use %s, only: " name; print_used_symbol used_symbol; List.iter (fun s -> printf ", "; print_used_symbol s) used_symbols; nl () type fortran_module = { module_name : string; default_accessibility : accessibility; used_modules : used_module list; public_symbols : string list; print_declarations : (unit -> unit) list; print_implementations : (unit -> unit) list } let print_public = function | name1 :: names -> printf " @[<2>public :: %s" name1; List.iter (fun n -> printf ",@ %s" n) names; nl () | [] -> () (*i unused value 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 i*) let print_module m = printf "module %s" m.module_name; nl (); List.iter print_used_module m.used_modules; printf " implicit none"; nl (); printf " %s" (accessibility_to_string m.default_accessibility); nl (); print_public m.public_symbols; nl (); begin match m.print_declarations with | [] -> () | print_declarations -> List.iter (fun f -> f ()) print_declarations; nl () end; begin match m.print_implementations with | [] -> () | print_implementations -> printf "contains"; nl (); nl (); List.iter (fun f -> f ()) print_implementations; nl (); end; printf "end module %s" m.module_name; nl () let print_modules modules = List.iter print_module modules; print_flush () let module_to_file line_length oc prelude m = output_string oc (m.module_name ^ "\n"); let filename = m.module_name ^ ".f90" in let channel = open_out filename in Format_Fortran.set_formatter_out_channel ~width:line_length channel; prelude (); print_modules [m]; close_out channel let modules_to_file line_length oc prelude = function | [] -> () | m :: mlist -> module_to_file line_length oc prelude m; List.iter (module_to_file line_length oc (fun () -> ())) mlist (* \thocwmodulesubsection{Chopping Up Amplitudes} *) let num_fusions_brakets size amplitudes = let num_fusions = max 1 size in let count_brakets = List.fold_left (fun sum process -> sum + List.length (F.brakets process)) 0 (CF.processes amplitudes) and count_processes = List.length (CF.processes amplitudes) in if count_brakets > 0 then let num_brakets = max 1 ((num_fusions * count_processes) / count_brakets) in (num_fusions, num_brakets) else (num_fusions, 1) let chop_amplitudes size amplitudes = let num_fusions, num_brakets = num_fusions_brakets size amplitudes in (ThoList.enumerate 1 (ThoList.chopn num_fusions (CF.fusions amplitudes)), ThoList.enumerate 1 (ThoList.chopn num_brakets (CF.processes amplitudes))) let print_compute_fusions1 dictionary (n, fusions) = if not !amp_triv then begin if !openmp then begin printf " subroutine compute_fusions_%04d (%s)" n openmp_tld; nl (); printf " @[<5>type(%s), intent(inout) :: %s" openmp_tld_type openmp_tld; nl (); end else begin printf " @[<5>subroutine compute_fusions_%04d ()" n; nl (); end; print_fusions dictionary fusions; printf " end subroutine compute_fusions_%04d" n; nl (); end and print_compute_brakets1 dictionary (n, processes) = if not !amp_triv then begin if !openmp then begin printf " subroutine compute_brakets_%04d (%s)" n openmp_tld; nl (); printf " @[<5>type(%s), intent(inout) :: %s" openmp_tld_type openmp_tld; nl (); end else begin printf " @[<5>subroutine compute_brakets_%04d ()" n; nl (); end; List.iter (print_brakets dictionary) processes; printf " end subroutine compute_brakets_%04d" n; nl (); end (* \thocwmodulesubsection{Common Stuff} *) let omega_public_symbols = ["number_particles_in"; "number_particles_out"; "number_color_indices"; "reset_helicity_selection"; "new_event"; "is_allowed"; "get_amplitude"; "color_sum"; "openmp_supported"] @ ThoList.flatmap (fun n -> ["number_" ^ n; n]) ["spin_states"; "flavor_states"; "color_flows"; "color_factors"] let whizard_public_symbols md5sum = ["init"; "final"; "update_alpha_s"] @ (match md5sum with Some _ -> ["md5sum"] | None -> []) let used_modules () = [Full "kinds"; Full Fermions.use_module; Full_Aliased ("omega_color", ["omega_color_factor", omega_color_factor_abbrev])] @ List.map (fun m -> Full m) (match !parameter_module with | "" -> !use_modules | pm -> pm :: !use_modules) let public_symbols () = if !whizard then omega_public_symbols @ (whizard_public_symbols !md5sum) else omega_public_symbols let print_constants amplitudes = 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 amplitudes)) [ ("n_prt", num_particles); ("n_in", num_particles_in); ("n_out", num_particles_out); ("n_cflow", num_color_flows); (* Number of different color amplitudes. *) ("n_cindex", num_color_indices); (* Maximum rank of color tensors. *) ("n_flv", num_flavors); (* Number of different flavor amplitudes. *) ("n_hel", num_helicities) (* Number of different helicty amplitudes. *) ]; nl (); (* Abbreviations. *) printf " ! NB: you MUST NOT change the value of %s here!!!" nc_parameter; nl (); printf " ! It is defined here for convenience only and must be"; nl (); printf " ! compatible with hardcoded values in the amplitude!"; nl (); print_real_parameter nc_parameter (CM.nc ()); (* $N_C$ *) 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 amplitudes; print_amplitude_table amplitudes; print_helicity_selection_table () let print_interface () = print_md5sum_functions !md5sum; print_maintenance_functions (); List.iter print_numeric_inquiry_functions [("number_particles_in", "n_in"); ("number_particles_out", "n_out")]; List.iter print_inquiry_functions ["spin_states"; "flavor_states"]; print_inquiry_function_openmp (); print_color_flows (); print_color_factors (); print_dispatch_functions (); nl (); (* Is this really necessary? *) Format_Fortran.switch_line_continuation false; if !km_write || !km_pure then (Targets_Kmatrix.Fortran.print !km_pure); if !km_2_write || !km_2_pure then (Targets_Kmatrix_2.Fortran.print !km_2_pure); Format_Fortran.switch_line_continuation true; nl () let print_calculate_amplitudes declarations computations amplitudes = printf " @[<5>subroutine calculate_amplitudes (amp, k, mask)"; nl (); printf " complex(kind=%s), dimension(:,:,:), intent(out) :: amp" !kind; nl (); printf " real(kind=%s), dimension(0:3,*), intent(in) :: k" !kind; nl (); printf " logical, dimension(:), intent(in) :: mask"; nl (); printf " integer, dimension(n_prt) :: s"; nl (); printf " integer :: h, hi"; nl (); declarations (); if not !amp_triv then begin begin match CF.processes amplitudes with | p :: _ -> print_external_momenta p | _ -> () end; ignore (List.fold_left print_momenta PSet.empty (CF.processes amplitudes)); end; printf " amp = 0"; nl (); if not !amp_triv then begin if num_helicities amplitudes > 0 then begin printf " if (hel_finite == 0) return"; nl (); if !openmp then begin printf "!$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(s, h, %s) SCHEDULE(STATIC)" openmp_tld; nl (); end; printf " do hi = 1, hel_finite"; nl (); printf " h = hel_map(hi)"; nl (); printf " s = table_spin_states(:,h)"; nl (); ignore (List.fold_left print_externals WFSet.empty (CF.processes amplitudes)); computations (); List.iter print_fudge_factor (CF.processes amplitudes); (* This sorting should slightly improve cache locality. *) let triple_snd = fun (_, x, _) -> x in let triple_fst = fun (x, _, _) -> x in let rec builder1 flvi flowi flows = match flows with | (Some a) :: tl -> (flvi, flowi, flavors_symbol (flavors a)) :: (builder1 flvi (flowi + 1) tl) | None :: tl -> builder1 flvi (flowi + 1) tl | [] -> [] in let rec builder2 flvi flvs = match flvs with | flv :: tl -> (builder1 flvi 1 flv) @ (builder2 (flvi + 1) tl) | [] -> [] in let unsorted = builder2 1 (List.map Array.to_list (Array.to_list (CF.process_table amplitudes))) in let sorted = List.sort (fun a b -> if (triple_snd a != triple_snd b) then triple_snd a - triple_snd b else (triple_fst a - triple_fst b)) unsorted in List.iter (fun (flvi, flowi, flv) -> (printf " amp(%d,%d,h) = %s" flvi flowi flv; nl ();)) sorted; (*i printf " else"; nl (); printf " amp(:,h,:) = 0"; nl (); i*) printf " end do"; nl (); if !openmp then begin printf "!$OMP END PARALLEL DO"; nl (); end; end; end; printf " end subroutine calculate_amplitudes"; nl () let print_compute_chops chopped_fusions chopped_brakets () = List.iter (fun (i, _) -> printf " call compute_fusions_%04d (%s)" i (if !openmp then openmp_tld else ""); nl ()) chopped_fusions; List.iter (fun (i, _) -> printf " call compute_brakets_%04d (%s)" i (if !openmp then openmp_tld else ""); nl ()) chopped_brakets (* \thocwmodulesubsection{UFO Fusions} *) module VSet = Set.Make (struct type t = F.constant Coupling.t let compare = compare end) let ufo_fusions_used amplitudes = let couplings = List.fold_left (fun acc p -> let fusions = ThoList.flatmap F.rhs (F.fusions p) and brakets = ThoList.flatmap F.ket (F.brakets p) in let couplings = VSet.of_list (List.map F.coupling (fusions @ brakets)) in VSet.union acc couplings) VSet.empty (CF.processes amplitudes) in VSet.fold (fun v acc -> match v with | Coupling.Vn (Coupling.UFO (_, v, _, _, _), _, _) -> Sets.String.add v acc | _ -> acc) couplings Sets.String.empty (* \thocwmodulesubsection{Single Function} *) let amplitudes_to_channel_single_function cmdline oc amplitudes = let print_declarations () = print_constants amplitudes and print_implementations () = print_interface (); print_calculate_amplitudes (fun () -> print_variable_declarations amplitudes) (fun () -> print_fusions (CF.dictionary amplitudes) (CF.fusions amplitudes); List.iter (print_brakets (CF.dictionary amplitudes)) (CF.processes amplitudes)) amplitudes in let fortran_module = { module_name = !module_name; used_modules = used_modules (); default_accessibility = Private; public_symbols = public_symbols (); print_declarations = [print_declarations]; print_implementations = [print_implementations] } in Format_Fortran.set_formatter_out_channel ~width:!line_length oc; print_description cmdline amplitudes (); print_modules [fortran_module] (* \thocwmodulesubsection{Single Module} *) let amplitudes_to_channel_single_module cmdline oc size amplitudes = let print_declarations () = print_constants amplitudes; print_variable_declarations amplitudes and print_implementations () = print_interface () in let chopped_fusions, chopped_brakets = chop_amplitudes size amplitudes in let dictionary = CF.dictionary amplitudes in let print_compute_amplitudes () = print_calculate_amplitudes (fun () -> ()) (print_compute_chops chopped_fusions chopped_brakets) amplitudes and print_compute_fusions () = List.iter (print_compute_fusions1 dictionary) chopped_fusions and print_compute_brakets () = List.iter (print_compute_brakets1 dictionary) chopped_brakets in let fortran_module = { module_name = !module_name; used_modules = used_modules (); default_accessibility = Private; public_symbols = public_symbols (); print_declarations = [print_declarations]; print_implementations = [print_implementations; print_compute_amplitudes; print_compute_fusions; print_compute_brakets] } in Format_Fortran.set_formatter_out_channel ~width:!line_length oc; print_description cmdline amplitudes (); print_modules [fortran_module] (* \thocwmodulesubsection{Multiple Modules} *) let modules_of_amplitudes _ _ size amplitudes = let name = !module_name in let print_declarations () = print_constants amplitudes and print_variables () = print_variable_declarations amplitudes in let constants_module = { module_name = name ^ "_constants"; used_modules = used_modules (); default_accessibility = Public; public_symbols = []; print_declarations = [print_declarations]; print_implementations = [] } in let variables_module = { module_name = name ^ "_variables"; used_modules = used_modules (); default_accessibility = Public; public_symbols = []; print_declarations = [print_variables]; print_implementations = [] } in let dictionary = CF.dictionary amplitudes in let print_compute_fusions (n, fusions) () = if not !amp_triv then begin if !openmp then begin printf " subroutine compute_fusions_%04d (%s)" n openmp_tld; nl (); printf " @[<5>type(%s), intent(inout) :: %s" openmp_tld_type openmp_tld; nl (); end else begin printf " @[<5>subroutine compute_fusions_%04d ()" n; nl (); end; print_fusions dictionary fusions; printf " end subroutine compute_fusions_%04d" n; nl (); end in let print_compute_brakets (n, processes) () = if not !amp_triv then begin if !openmp then begin printf " subroutine compute_brakets_%04d (%s)" n openmp_tld; nl (); printf " @[<5>type(%s), intent(inout) :: %s" openmp_tld_type openmp_tld; nl (); end else begin printf " @[<5>subroutine compute_brakets_%04d ()" n; nl (); end; List.iter (print_brakets dictionary) processes; printf " end subroutine compute_brakets_%04d" n; nl (); end in let fusions_module (n, _ as fusions) = let tag = Printf.sprintf "_fusions_%04d" n in { module_name = name ^ tag; used_modules = (used_modules () @ [Full constants_module.module_name; Full variables_module.module_name]); default_accessibility = Private; public_symbols = ["compute" ^ tag]; print_declarations = []; print_implementations = [print_compute_fusions fusions] } in let brakets_module (n, _ as processes) = let tag = Printf.sprintf "_brakets_%04d" n in { module_name = name ^ tag; used_modules = (used_modules () @ [Full constants_module.module_name; Full variables_module.module_name]); default_accessibility = Private; public_symbols = ["compute" ^ tag]; print_declarations = []; print_implementations = [print_compute_brakets processes] } in let chopped_fusions, chopped_brakets = chop_amplitudes size amplitudes in let fusions_modules = List.map fusions_module chopped_fusions in let brakets_modules = List.map brakets_module chopped_brakets in let print_implementations () = print_interface (); print_calculate_amplitudes (fun () -> ()) (print_compute_chops chopped_fusions chopped_brakets) amplitudes in let public_module = { module_name = name; used_modules = (used_modules () @ [Full constants_module.module_name; Full variables_module.module_name ] @ List.map (fun m -> Full m.module_name) (fusions_modules @ brakets_modules)); default_accessibility = Private; public_symbols = public_symbols (); print_declarations = []; print_implementations = [print_implementations] } and private_modules = [constants_module; variables_module] @ fusions_modules @ brakets_modules in (public_module, private_modules) let amplitudes_to_channel_single_file cmdline oc size amplitudes = let public_module, private_modules = modules_of_amplitudes cmdline oc size amplitudes in Format_Fortran.set_formatter_out_channel ~width:!line_length oc; print_description cmdline amplitudes (); print_modules (private_modules @ [public_module]) let amplitudes_to_channel_multi_file cmdline oc size amplitudes = let public_module, private_modules = modules_of_amplitudes cmdline oc size amplitudes in modules_to_file !line_length oc (print_description cmdline amplitudes) (public_module :: private_modules) (* \thocwmodulesubsection{Dispatch} *) let amplitudes_to_channel cmdline oc diagnostics amplitudes = parse_diagnostics diagnostics; let ufo_fusions = let ufo_fusions_set = ufo_fusions_used amplitudes in if Sets.String.is_empty ufo_fusions_set then None else Some ufo_fusions_set in begin match ufo_fusions with | Some only -> let name = !module_name ^ "_ufo" and fortran_module = Fermions.use_module in use_modules := name :: !use_modules; UFO.Targets.Fortran.lorentz_module ~only ~name ~fortran_module (Format_Fortran.formatter_of_out_channel oc) () | None -> () end; match !output_mode with | Single_Function -> amplitudes_to_channel_single_function cmdline oc amplitudes | Single_Module size -> amplitudes_to_channel_single_module cmdline oc size amplitudes | Single_File size -> amplitudes_to_channel_single_file cmdline oc size amplitudes | Multi_File size -> amplitudes_to_channel_multi_file cmdline oc size amplitudes 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 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 ')') || (String.contains tail '(') || (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_mom_v1 coeff f c wf1 wf2 p1 p2 p12 fusion = let c = format_coupling 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_f%s(-(%s),%s,%s,%s)" f c1 c2 wf2 wf1 | F21 -> printf "f_f%s(-(%s),%s,%s,%s)" f c1 c2 wf1 wf2 let print_fermion_current_mom_v1_chiral coeff f c wf1 wf2 p1 p2 p12 fusion = let c = format_coupling 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_f%s(-(%s),-(%s),%s,%s)" f c2 c1 wf2 wf1 | F21 -> printf "f_f%s(-(%s),-(%s),%s,%s)" f c2 c1 wf2 wf1 let print_fermion_current_mom_v2 coeff f c wf1 wf2 p1 p2 p12 fusion = let c = format_coupling 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_f%s(-(%s),%s,%s,%s,%s)" f c1 c2 wf2 wf1 p2 | F21 -> printf "f_f%s(-(%s),%s,%s,%s,%s)" f c1 c2 wf1 wf2 p1 let print_fermion_current_mom_v2_chiral coeff f c wf1 wf2 p1 p2 p12 fusion = let c = format_coupling 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 c2 c1 wf2 wf1 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_f%s(-(%s),-(%s),%s,%s,%s)" f c2 c1 wf1 wf2 p2 | F21 -> printf "f_f%s(-(%s),-(%s),%s,%s,%s)" f c2 c1 wf2 wf1 p1 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" | _, _, _, _ -> 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" | _, _, _, _ -> 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" | _, _, _, _ -> 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 (*i unused value let print_fermion_current_mom_vector 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 i*) 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 _ _ _ 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 _ _ _ 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" | _, _, _, _ -> invalid_arg "Targets.Fortran_Majorana_Fermions: not used in the models" let print_current_mom = function | coeff, _, TVA, _ -> print_fermion_current_mom_v1 coeff "tva" | coeff, _, TVAM, _ -> print_fermion_current_mom_v2 coeff "tvam" | coeff, _, TLR, _ -> print_fermion_current_mom_v1_chiral coeff "tlr" | coeff, _, TLRM, _ -> print_fermion_current_mom_v2_chiral coeff "tlrm" | _, _, _, _ -> invalid_arg "Targets.Fortran_Majorana_Fermions: Not needed 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 _ 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 (*i unused value 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 i*) 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" | _, 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" | _, _, _, 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" | _, _, 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{\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 Index: trunk/omega/tests/keystones.ml =================================================================== --- trunk/omega/tests/keystones.ml (revision 8359) +++ trunk/omega/tests/keystones.ml (revision 8360) @@ -1,333 +1,424 @@ (* keystones.ml -- Copyright (C) 2019-2019 by Wolfgang Kilian Thorsten Ohl Juergen Reuter WHIZARD is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2, or (at your option) any later version. WHIZARD is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) open Coupling type field = lorentz * int type argument = - | G of int (* coupling *) + | G of int (* complex coupling *) + | M of int (* real mass (or width) *) | P of int (* momentum *) | F of field (* field *) + | V of string (* verbatim *) type keystone = - { ket : field; + { bra : field; name : string; args : argument list } type vertex = { tag : string; keystones : keystone list } let order_fields (_, i) (_, j) = compare i j -let extract_fields { ket; args } = +let extract_fields { bra; args } = List.sort order_fields (List.fold_left (fun acc arg -> match arg with | F f -> f :: acc | _ -> acc) - [ket] args) - -let extract_momenta { args } = - List.sort - compare - (List.fold_left - (fun acc arg -> - match arg with - | P i -> i :: acc - | _ -> acc) - [] args) - -let extract_couplings { args } = - List.sort - compare - (List.fold_left - (fun acc arg -> - match arg with - | G i -> i :: acc - | _ -> acc) - [] args) + [bra] args) let check_indices field_list = if List.exists (fun (n, _) -> n > 1) (ThoList.classify (List.map snd field_list)) then invalid_arg "check_indices"; () let spin_to_string = function | Scalar -> "Scalar" | Spinor -> "Spinor" | ConjSpinor -> "ConjSpinor" | Majorana -> "Majorana" | Vector | Massive_Vector -> "Vector" + | Tensor_2 -> "Tensor_2" | _ -> failwith "spin_to_string" let fields_to_string fields = "[" ^ String.concat "; " (List.map (fun (s, i) -> Printf.sprintf "%s(%d)" (spin_to_string s) i) fields) ^ "]" let check_fields ks_list = let fields = List.map extract_fields ks_list in if not (ThoList.homogeneous fields) then begin let spins = "[" ^ String.concat "; " (List.map fields_to_string fields) ^ "]" in invalid_arg ("check_spins: " ^ spins) end; check_indices (List.hd fields) open Format_Fortran let spin_type = function | Scalar -> "complex(kind=default)" | Spinor -> "type(spinor)" | ConjSpinor -> "type(conjspinor)" | Majorana -> "type(bispinor)" | Vector | Massive_Vector -> "type(vector)" + | Tensor_2 -> "type(tensor)" | _ -> failwith "spin_type" let type_arg = function - | G _ -> "complex(kind=default)" - | P _ -> "type(momentum)" - | F (s, _) -> spin_type s + | G _ -> Some "complex(kind=default)" + | M _ -> Some "real(kind=default)" + | P _ -> Some "type(momentum)" + | F (s, _) -> Some (spin_type s) + | V _ -> None let spin_mnemonic = function | Scalar -> "phi" | Spinor -> "psi" | ConjSpinor -> "psibar" | Majorana -> "chi" | Maj_Ghost -> "???" | Vector -> "a" | Massive_Vector -> "v" + | Tensor_2 -> "h" | _ -> failwith "spin_mnemonic" let format_coupling i = Printf.sprintf "g%d" i let format_momentum i = Printf.sprintf "p%d" i +let format_mass i = + Printf.sprintf "m%d" i + let format_field (s, i) = Printf.sprintf "%s%d" (spin_mnemonic s) i let format_arg = function | G i -> format_coupling i + | M i -> format_mass i | P i -> format_momentum i | F f -> format_field f + | V s -> s let fusion_to_fortran ff name args = let printf fmt = fprintf ff fmt in match args with | [] -> invalid_arg "fusion_to_fortran" | arg1 :: arg2n -> printf "%s (%s" name (format_arg arg1); List.iter (fun arg -> printf ",@ %s" (format_arg arg)) arg2n; printf ")" -let keystone_to_fortran ff (ksv, { ket; name; args }) = +(* \begin{dubious} + The ordering here works for Dirac spinors, but fails for + Majorana spinors, leading to a sign ambiguity in this test + \ldots + \end{dubious} *) +let keystone_to_fortran ff (ksv, { bra; name; args }) = let printf fmt = fprintf ff fmt and nl = pp_newline ff in printf " @[<2>%s =@ " ksv; - begin match ket with + begin match bra with | Spinor, _ -> fusion_to_fortran ff name args; - printf "@ * %s" (format_field ket) + printf "@ * %s" (format_field bra) | _, _ -> - printf "%s@ * " (format_field ket); + printf "%s@ * " (format_field bra); fusion_to_fortran ff name args end; printf "@]"; nl() let keystones_to_subroutine ff { tag; keystones } = check_fields keystones; let printf fmt = fprintf ff fmt and nl = pp_newline ff in printf " @[<4>subroutine@ testks_%s@ (repetitions," tag; printf "@ passed,@ threshold,@ quiet,@ abs_threshold)@]"; nl (); printf " integer, intent(in) :: repetitions"; nl (); printf " logical, intent(inout) :: passed"; nl (); printf " logical, intent(in), optional :: quiet"; nl (); printf " @[<2>real(kind=default),@ intent(in),@ optional ::"; printf "@ threshold,@ abs_threshold@]"; nl (); printf " integer :: i"; nl (); let ks1 = List.hd keystones in let all_momenta = List.map (fun i -> P i) (ThoList.range 0 (List.length (extract_fields ks1) - 1)) in let variables = - ThoList.uniq (List.sort compare (F (ks1.ket) :: ks1.args @ all_momenta)) in + ThoList.uniq (List.sort compare (F (ks1.bra) :: ks1.args @ all_momenta)) in List.iter (fun a -> - printf " @[<2>%s :: %s@]" (type_arg a) (format_arg a); nl ()) + match type_arg a with + | None -> () + | Some t -> printf " @[<2>%s :: %s@]" t (format_arg a); nl ()) variables; let ks_list = List.map (fun (n, ks) -> (Printf.sprintf "ks%d" n, ks)) (ThoList.enumerate 0 keystones) in begin match ks_list with | [] -> failwith "keystones_to_fortran" | (ksv1, _) :: ks2n -> printf " @[<2>complex(kind=default) ::@ %s" ksv1; List.iter (fun (ksv, _) -> printf ",@ %s" ksv) ks2n; printf "@]"; nl () end; printf " do i = 1, repetitions"; nl (); List.iter (fun a -> match a with | P 0 -> () (* this will be determined by momentum conservation! *) + | V _ -> () | a -> printf " @[<2>call@ make_random@ (%s)@]" (format_arg a); nl ()) variables; begin match all_momenta with | [] -> failwith "keystones_to_fortran" | p1 :: p2n -> printf " @[<2>%s =" (format_arg p1); List.iter (fun p -> printf "@ - %s" (format_arg p)) p2n; printf "@]"; nl () end; List.iter (keystone_to_fortran ff) ks_list; begin match ks_list with | [] -> failwith "keystones_to_fortran" | (ksv1, ks1) :: ks2n -> List.iter (fun (ksv, ks) -> printf " @[<8>call@ expect@ (%s,@ %s," ksv ksv1; printf "@ '%s: %s <> %s'," tag ks.name ks1.name; printf "@ passed,@ threshold, quiet, abs_threshold)@]"; nl ()) ks2n end; printf " end do"; nl (); printf " @[<2>end@ subroutine@ testks_%s@]" tag; nl () let keystones_to_fortran ff ?(reps=1000) ?(threshold=0.85) + ?(omega_module="omega95") ?(modules=[]) vertices = let printf fmt = fprintf ff fmt and nl = pp_newline ff in printf "program keystones_omegalib_demo"; nl (); List.iter (fun m -> printf " use %s" m; nl ()) - ("kinds" :: "constants" :: "omega95" :: + ("kinds" :: "constants" :: omega_module :: "omega_testtools" :: "keystones_tools" :: modules); printf " implicit none"; nl (); printf " logical :: passed"; nl (); printf " logical, parameter :: quiet = .false."; nl (); printf " integer, parameter :: reps = %d" reps; nl (); printf " real(kind=default), parameter :: threshold = %f" threshold; nl (); printf " real(kind=default), parameter :: abs_threshold = 1E-17"; nl (); printf " integer, dimension(8) :: date_time"; nl (); printf " integer :: rsize"; nl (); printf " call date_and_time (values = date_time)"; nl (); printf " call random_seed (size = rsize)"; nl (); printf " @[<8>call random_seed@ (put = spread (product (date_time),"; printf "@ dim = 1,@ ncopies = rsize))@]"; nl (); printf " passed = .true."; nl (); List.iter (fun v -> printf " @[<8>call testks_%s@ (reps,@ passed," v.tag; printf "@ threshold, quiet, abs_threshold)@]"; nl ()) vertices; printf " if (passed) then"; nl (); printf " stop 0"; nl (); printf " else"; nl (); printf " stop 1"; nl (); printf " end if"; nl (); printf "contains"; nl (); List.iter (keystones_to_subroutine ff) vertices; printf "end program keystones_omegalib_demo"; nl () -let vector_spinor_current tag = - { tag = Printf.sprintf "vector_spinor_current__%s_ff" tag; - keystones = [ { ket = (ConjSpinor, 0); - name = Printf.sprintf "f_%sf" tag; - args = [G (0); F (Vector, 1); F (Spinor, 2)] }; - { ket = (Vector, 1); - name = Printf.sprintf "%s_ff" tag; - args = [G (0); F (ConjSpinor, 0); F (Spinor, 2)] }; - { ket = (Spinor, 2); - name = Printf.sprintf "f_f%s" tag; - args = [G (0); F (ConjSpinor, 0); F (Vector, 1)] } ] } - -let scalar_spinor_current tag = - { tag = Printf.sprintf "scalar_spinor_current__%s_ff" tag; - keystones = [ { ket = (ConjSpinor, 0); - name = Printf.sprintf "f_%sf" tag; - args = [G (0); F (Scalar, 1); F (Spinor, 2)] }; - { ket = (Scalar, 1); - name = Printf.sprintf "%s_ff" tag; - args = [G (0); F (ConjSpinor, 0); F (Spinor, 2)] }; - { ket = (Spinor, 2); - name = Printf.sprintf "f_f%s" tag; - args = [G (0); F (ConjSpinor, 0); F (Scalar, 1)] } ] } - -(* NB: the vertex is anti-symmetric in the scalars and we need to - use a cyclic permutation. *) -let vector_scalar_current = - { tag = "vector_scalar_current__v_ss"; - keystones = [ { ket = (Vector, 0); - name = "v_ss"; - args = [G (0); F (Scalar, 1); P (1); F (Scalar, 2); P (2)] }; - { ket = (Scalar, 2); - name = "s_vs"; - args = [G (0); F (Vector, 0); P (0); F (Scalar, 1); P (1)] } ] } - -let scalar_vector_current tag = - { tag = Printf.sprintf "transversal_vector_current__s_vv_%s" tag; - keystones = [ { ket = (Scalar, 0); - name = Printf.sprintf "s_vv_%s" tag; - args = [G (0); F (Vector, 1); P (1); F (Vector, 2); P (2)] }; - { ket = (Vector, 1); - name = Printf.sprintf "v_sv_%s" tag; - args = [G (0); F (Scalar, 0); P (0); F (Vector, 2); P (2)] } ] } - -let vertices = - List.concat - [ List.map vector_spinor_current ["v"; "a"; "vl"; "vr"]; - List.map scalar_spinor_current ["s"; "p"; "sl"; "sr"]; - [ vector_scalar_current ]; - List.map scalar_vector_current ["t"; "6D"; "6DP"] ] - -let generate ?(reps=1000) ?(threshold=0.85) ?modules vertices = +let generate ?reps ?threshold ?omega_module ?modules vertices = let my_name = Sys.argv.(0) in let verbose = ref false and cat = ref false and usage = "usage: " ^ my_name ^ " ..." in Arg.parse (Arg.align [ ("-cat", Arg.Set cat, " print test snippets"); ("-v", Arg.Set verbose, " be more verbose"); ("-verbose", Arg.Set verbose, " be more verbose") ]) (fun s -> raise (Arg.Bad s)) usage; if !cat then - keystones_to_fortran std_formatter ~reps ~threshold ?modules vertices + keystones_to_fortran + std_formatter ?reps ?threshold ?omega_module ?modules vertices + +type ufo_vertex = + { v_tag : string; + v_spins : lorentz array; + v_tensor : UFOx.Lorentz.t } + +type ufo_propagator = + { p_tag : string; + p_omega : string; + p_spins : lorentz * lorentz; + p_propagator : UFO.Propagator.t } + +let transpose p = + { p_tag = p.p_tag; + p_omega = p.p_omega; + p_spins = (snd p.p_spins, fst p.p_spins); + p_propagator = UFO.Propagator.transpose p.p_propagator } + +let equivalent_tensors v_spins alternatives = + List.map + (fun (v_tag, tensor) -> + { v_tag; v_spins; v_tensor = UFOx.Lorentz.of_string tensor }) + alternatives + +module P = Permutation.Default + +let permute_spins p s = P.array p s + +(* We must permute only the free indices, of course. + Note that we apply the \emph{inverse} permutation to + the indices in order to match the permutation of the + particles/spins. *) +let permute_structure n p l = + let permuted = P.array (P.inverse p) (Array.init n succ) in + let permute_index i = + if i > 0 then + permuted.(pred i) + else + i in + UFOx.Lorentz.map_indices permute_index l + +let permute_vertex n v p = + { v_tag = v.v_tag ^ "_p" ^ P.to_string p; + v_spins = permute_spins p v.v_spins; + v_tensor = permute_structure n p v.v_tensor } + +let vertex_permutations v = + let n = Array.length v.v_spins in + List.map (permute_vertex n v) (P.cyclic n) + +let keystones_of_ufo_vertex { v_tag; v_spins } = + { tag = v_tag; + keystones = + let fields = Array.mapi (fun i s -> (s, i)) v_spins in + let n = Array.length fields in + List.map + (fun p -> + let permuted = P.array p fields in + match Array.to_list permuted with + | [] -> invalid_arg "keystones_of_ufo_vertex" + | bra :: args -> + { bra; + name = v_tag ^ "_p" ^ P.to_string p; + args = + G (0) :: + (ThoList.flatmap (fun (s, i) -> [ F (s, i); P (i) ]) args) }) + (P.cyclic n) } + +let keystones_of_propagator { p_tag; p_omega; p_spins } = + let s0, s1 = p_spins in + let keystone omega s = + match omega, s1 with + | _, (Scalar|Tensor_2) | false, _ -> + { bra = (s0, 0); + name = s; + args = [P (1); M (0); M (1); F (s1, 1) ] } + | _, Vector -> + { bra = (s0, 0); + name = s; + args = [P (1); F (s1, 1) ] } + | true, _ -> + { bra = (s0, 0); + name = s; + args = [P (1); M (0); M (1); V (".false."); F (s1, 1) ] } in + { tag = p_tag; + keystones = [keystone false ("pr_U_" ^ p_tag); keystone true p_omega] } + +let merge (ufo_list, omegalib) = + match ufo_list with + | [] -> omegalib + | ufo1 :: _ -> + { tag = ufo1.v_tag; + keystones = + (omegalib.keystones + @ ThoList.flatmap + (fun ufo -> (keystones_of_ufo_vertex ufo).keystones) + ufo_list) } + +let fusions ff ?(omega_module="omega95") module_name vertices propagators = + let printf fmt = fprintf ff fmt + and nl () = pp_newline ff () in + printf "module %s" module_name; nl (); + printf " use kinds"; nl (); + printf " use %s" omega_module; nl (); + printf " implicit none"; nl (); + printf " private"; nl (); + let permuted_vertices = ThoList.flatmap vertex_permutations vertices in + List.iter + (fun v -> printf " public :: %s" v.v_tag; nl ()) + permuted_vertices; + List.iter + (fun p -> printf " public :: pr_U_%s" p.p_tag; nl ()) + propagators; + UFO_targets.Fortran.eps4_g4_g44_decl std_formatter (); + UFO_targets.Fortran.eps4_g4_g44_init std_formatter (); + printf "contains"; nl (); + List.iter + (fun v -> + let tensor = UFO_Lorentz.parse (Array.to_list v.v_spins) v.v_tensor in + printf " ! %s" (String.make 68 '='); nl (); + printf " ! %s" (UFO_Lorentz.to_string tensor); nl (); + UFO_targets.Fortran.lorentz std_formatter v.v_tag v.v_spins tensor) + permuted_vertices; + List.iter + (fun p -> + UFO_targets.Fortran.propagator + std_formatter p.p_tag p.p_spins + p.p_propagator.UFO.Propagator.numerator + p.p_propagator.UFO.Propagator.denominator) + propagators; + printf "end module %s" module_name; nl () + +let generate_ufo ?omega_module ?reps ?threshold module_name vertices propagators = + fusions + ?omega_module std_formatter module_name + (ThoList.flatmap fst vertices) propagators; + generate + ?reps ?threshold ?omega_module ~modules:[module_name] + (List.map merge vertices @ List.map keystones_of_propagator propagators) + Index: trunk/omega/tests/keystones_tools.f90 =================================================================== --- trunk/omega/tests/keystones_tools.f90 (revision 8359) +++ trunk/omega/tests/keystones_tools.f90 (revision 8360) @@ -1,211 +1,229 @@ ! keystones_tools.f90 -- tools for fusion/keystone/vertex tests !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! ! Copyright (C) 2019- by ! Wolfgang Kilian ! Thorsten Ohl ! Juergen Reuter ! ! WHIZARD is free software; you can redistribute it and/or modify it ! under the terms of the GNU General Public License as published by ! the Free Software Foundation; either version 2, or (at your option) ! any later version. ! ! WHIZARD is distributed in the hope that it will be useful, but ! WITHOUT ANY WARRANTY; without even the implied warranty of ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ! GNU General Public License for more details. ! ! You should have received a copy of the GNU General Public License ! along with this program; if not, write to the Free Software ! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! module keystones_tools ! use ieee_arithmetic use kinds use constants ! use tao_random_numbers use omega95 + use omega95_bispinors, only: bispinor implicit none private public :: make_random interface make_random module procedure & make_random_real, & make_random_real_vector, & make_random_real_array, & make_random_complex, & make_random_complex_vector, & make_random_complex_array, & make_random_momentum, & make_random_momentum_vector, & make_random_vector, & make_random_vector_vector, & make_random_tensor, & make_random_tensor_vector, & make_random_tensor2odd, & make_random_tensor2odd_vector, & make_random_spinor, & make_random_spinor_vector, & make_random_conjspinor, & - make_random_conjspinor_vector + make_random_conjspinor_vector, & + make_random_bispinor, & + make_random_bispinor_vector end interface make_random contains subroutine make_random_real (x, range) real(kind=default), intent(inout) :: x real(kind=default), intent(in), optional :: range call random_number (x) x = 2*x - 1 if (present (range)) then x = range * x end if end subroutine make_random_real subroutine make_random_real_vector (x, range) real(kind=default), dimension(:), intent(inout) :: x real(kind=default), intent(in), optional :: range call random_number (x) x = 2*x - 1 if (present (range)) then x = range * x end if end subroutine make_random_real_vector subroutine make_random_real_array (x, range) real(kind=default), dimension(:,:), intent(inout) :: x real(kind=default), intent(in), optional :: range call random_number (x) x = 2*x - 1 if (present (range)) then x = range * x end if end subroutine make_random_real_array subroutine make_random_complex (z, range) complex(kind=default), intent(inout) :: z real(kind=default), intent(in), optional :: range real(kind=default) :: x, y call make_random_real (x, range) call make_random_real (y, range) z = cmplx (x, y, kind=default) end subroutine make_random_complex subroutine make_random_complex_vector (z, range) complex(kind=default), dimension(:), intent(inout) :: z real(kind=default), intent(in), optional :: range real(kind=default), dimension(size(z)) :: x, y call make_random_real_vector (x, range) call make_random_real_vector (y, range) z = cmplx (x, y, kind=default) end subroutine make_random_complex_vector subroutine make_random_complex_array (z, range) complex(kind=default), dimension(:,:), intent(inout) :: z real(kind=default), intent(in), optional :: range real(kind=default), dimension(size(z, dim=1),size(z, dim=2)) :: x, y call make_random_real_array (x, range) call make_random_real_array (y, range) z = cmplx (x, y, kind=default) end subroutine make_random_complex_array subroutine make_random_momentum (p, range) type(momentum), intent(inout) :: p real(kind=default), intent(in), optional :: range call make_random_real (p%t, range) call make_random_real_vector (p%x, range) end subroutine make_random_momentum subroutine make_random_momentum_vector (p, range) type(momentum), dimension(:), intent(inout) :: p real(kind=default), intent(in), optional :: range integer :: i do i = 1, size(p) call make_random_momentum (p(i), range) end do end subroutine make_random_momentum_vector subroutine make_random_vector (v, range) type(vector), intent(inout) :: v real(kind=default), intent(in), optional :: range call make_random_complex (v%t, range) call make_random_complex_vector (v%x, range) end subroutine make_random_vector subroutine make_random_vector_vector (v, range) type(vector), dimension(:), intent(inout) :: v real(kind=default), intent(in), optional :: range integer :: i do i = 1, size(v) call make_random_vector (v(i), range) end do end subroutine make_random_vector_vector subroutine make_random_spinor (psi, range) type(spinor), intent(inout) :: psi real(kind=default), intent(in), optional :: range call make_random_complex_vector (psi%a, range) end subroutine make_random_spinor subroutine make_random_spinor_vector (psi, range) type(spinor), dimension(:), intent(inout) :: psi real(kind=default), intent(in), optional :: range integer :: i do i = 1, size(psi) call make_random_spinor (psi(i), range) end do end subroutine make_random_spinor_vector subroutine make_random_conjspinor (psibar, range) type(conjspinor), intent(inout) :: psibar real(kind=default), intent(in), optional :: range call make_random_complex_vector (psibar%a, range) end subroutine make_random_conjspinor subroutine make_random_conjspinor_vector (psibar, range) type(conjspinor), dimension(:), intent(inout) :: psibar real(kind=default), intent(in), optional :: range integer :: i do i = 1, size(psibar) call make_random_conjspinor (psibar(i), range) end do end subroutine make_random_conjspinor_vector subroutine make_random_tensor (t, range) type(tensor), intent(inout) :: t real(kind=default), intent(in), optional :: range call make_random_complex_array (t%t, range) end subroutine make_random_tensor subroutine make_random_tensor_vector (t, range) type(tensor), dimension(:), intent(inout) :: t real(kind=default), intent(in), optional :: range integer :: i do i = 1, size(t) call make_random_tensor (t(i), range) end do end subroutine make_random_tensor_vector subroutine make_random_tensor2odd (t, range) type(tensor2odd), intent(inout) :: t real(kind=default), intent(in), optional :: range call make_random_complex_vector (t%e, range) call make_random_complex_vector (t%b, range) end subroutine make_random_tensor2odd subroutine make_random_tensor2odd_vector (t, range) type(tensor2odd), dimension(:), intent(inout) :: t real(kind=default), intent(in), optional :: range integer :: i do i = 1, size(t) call make_random_tensor2odd (t(i), range) end do end subroutine make_random_tensor2odd_vector + subroutine make_random_bispinor (chi, range) + type(bispinor), intent(inout) :: chi + real(kind=default), intent(in), optional :: range + call make_random_complex_vector (chi%a, range) + end subroutine make_random_bispinor + + subroutine make_random_bispinor_vector (chi, range) + type(bispinor), dimension(:), intent(inout) :: chi + real(kind=default), intent(in), optional :: range + integer :: i + do i = 1, size(chi) + call make_random_bispinor (chi(i), range) + end do + end subroutine make_random_bispinor_vector + end module keystones_tools Index: trunk/omega/tests/keystones_omegalib_generate.ml =================================================================== --- trunk/omega/tests/keystones_omegalib_generate.ml (revision 8359) +++ trunk/omega/tests/keystones_omegalib_generate.ml (revision 8360) @@ -1,79 +1,79 @@ (* keystones_omegalib_generate.ml -- Copyright (C) 2019-2019 by Wolfgang Kilian Thorsten Ohl Juergen Reuter WHIZARD is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2, or (at your option) any later version. WHIZARD is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) open Coupling open Keystones let vector_spinor_current tag = { tag = Printf.sprintf "vector_spinor_current__%s_ff" tag; - keystones = [ { ket = (ConjSpinor, 0); + keystones = [ { bra = (ConjSpinor, 0); name = Printf.sprintf "f_%sf" tag; args = [G (0); F (Vector, 1); F (Spinor, 2)] }; - { ket = (Vector, 1); + { bra = (Vector, 1); name = Printf.sprintf "%s_ff" tag; args = [G (0); F (ConjSpinor, 0); F (Spinor, 2)] }; - { ket = (Spinor, 2); + { bra = (Spinor, 2); name = Printf.sprintf "f_f%s" tag; args = [G (0); F (ConjSpinor, 0); F (Vector, 1)] } ] } let scalar_spinor_current tag = { tag = Printf.sprintf "scalar_spinor_current__%s_ff" tag; - keystones = [ { ket = (ConjSpinor, 0); + keystones = [ { bra = (ConjSpinor, 0); name = Printf.sprintf "f_%sf" tag; args = [G (0); F (Scalar, 1); F (Spinor, 2)] }; - { ket = (Scalar, 1); + { bra = (Scalar, 1); name = Printf.sprintf "%s_ff" tag; args = [G (0); F (ConjSpinor, 0); F (Spinor, 2)] }; - { ket = (Spinor, 2); + { bra = (Spinor, 2); name = Printf.sprintf "f_f%s" tag; args = [G (0); F (ConjSpinor, 0); F (Scalar, 1)] } ] } (* NB: the vertex is anti-symmetric in the scalars and we need to use a cyclic permutation. *) let vector_scalar_current = { tag = "vector_scalar_current__v_ss"; - keystones = [ { ket = (Vector, 0); + keystones = [ { bra = (Vector, 0); name = "v_ss"; args = [G (0); F (Scalar, 1); P (1); F (Scalar, 2); P (2)] }; - { ket = (Scalar, 2); + { bra = (Scalar, 2); name = "s_vs"; args = [G (0); F (Vector, 0); P (0); F (Scalar, 1); P (1)] } ] } let scalar_vector_current tag = { tag = Printf.sprintf "transversal_vector_current__s_vv_%s" tag; - keystones = [ { ket = (Scalar, 0); + keystones = [ { bra = (Scalar, 0); name = Printf.sprintf "s_vv_%s" tag; args = [G (0); F (Vector, 1); P (1); F (Vector, 2); P (2)] }; - { ket = (Vector, 1); + { bra = (Vector, 1); name = Printf.sprintf "v_sv_%s" tag; args = [G (0); F (Scalar, 0); P (0); F (Vector, 2); P (2)] } ] } let vertices = List.concat [ List.map vector_spinor_current ["v"; "a"; "vl"; "vr"]; List.map scalar_spinor_current ["s"; "p"; "sl"; "sr"]; [ vector_scalar_current ]; List.map scalar_vector_current ["t"; "6D"; "6DP"] ] let _ = Keystones.generate ~reps:10000 ~threshold:0.70 vertices; exit 0 Index: trunk/omega/tests/keystones_UFO_bispinors_generate.ml =================================================================== --- trunk/omega/tests/keystones_UFO_bispinors_generate.ml (revision 0) +++ trunk/omega/tests/keystones_UFO_bispinors_generate.ml (revision 8360) @@ -0,0 +1,153 @@ +(* keystones_UFO_generate.ml -- + + Copyright (C) 2019-2019 by + + Wolfgang Kilian + Thorsten Ohl + Juergen Reuter + + WHIZARD is free software; you can redistribute it and/or modify it + under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2, or (at your option) + any later version. + + WHIZARD is distributed in the hope that it will be useful, but + WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) + +open Coupling +open Keystones + +let qed = + equivalent_tensors + [| Majorana; Vector; Majorana |] + [ ("qed", "Gamma(2,1,3)") ] + +let axial = + equivalent_tensors + [| Majorana; Vector; Majorana |] + [ ("axial1", "Gamma5(1,-1)*Gamma(2,-1,3)"); + ("axial2", "-Gamma(2,1,-3)*Gamma5(-3,3)") ] + +let left = + equivalent_tensors + [| Majorana; Vector; Majorana |] + [ ("left1", "(Identity(1,-1)+Gamma5(1,-1))*Gamma(2,-1,3)"); + ("left2", "2*ProjP(1,-1)*Gamma(2,-1,3)"); + ("left3", "Gamma(2,1,-3)*(Identity(-3,3)-Gamma5(-3,3))"); + ("left4", "2*Gamma(2,1,-3)*ProjM(-3,3)") ] + +let right = + equivalent_tensors + [| Majorana; Vector; Majorana |] + [ ("right1", "(Identity(1,-1)-Gamma5(1,-1))*Gamma(2,-1,3)"); + ("right2", "2*ProjM(1,-1)*Gamma(2,-1,3)"); + ("right3", "Gamma(2,1,-3)*(Identity(-3,3)+Gamma5(-3,3))"); + ("right4", "2*Gamma(2,1,-3)*ProjP(-3,3)") ] + +let vector_spinor_current tag = + { tag = Printf.sprintf "vector_spinor_current__%s_ff" tag; + keystones = + [ { bra = (Majorana, 0); + name = Printf.sprintf "f_%sf" tag; + args = [G (0); F (Vector, 1); F (Majorana, 2)] }; + { bra = (Vector, 1); + name = Printf.sprintf "%s_ff" tag; + args = [G (0); F (Majorana, 0); F (Majorana, 2)] } ] } + +let scalar = + equivalent_tensors + [| Majorana; Scalar; Majorana |] + [ ("scalar_current", "Identity(1,3)") ] + +let pseudo = + equivalent_tensors + [| Majorana; Scalar; Majorana |] + [ ("pseudo_current", "Gamma5(1,3)") ] + +let left_scalar = + equivalent_tensors + [| Majorana; Scalar; Majorana |] + [ ("left_scalar1", "Identity(1,3)-Gamma5(1,3)"); + ("left_scalar2", "2*ProjM(1,3)") ] + +let right_scalar = + equivalent_tensors + [| Majorana; Scalar; Majorana |] + [ ("right_scalar1", "Identity(1,3)+Gamma5(1,3)"); + ("right_scalar2", "2*ProjP(1,3)") ] + +let scalar_spinor_current tag = + { tag = Printf.sprintf "scalar_spinor_current__%s_ff" tag; + keystones = + [ { bra = (Majorana, 0); + name = Printf.sprintf "f_%sf" tag; + args = [G (0); F (Scalar, 1); F (Majorana, 2)] }; + { bra = (Scalar, 1); + name = Printf.sprintf "%s_ff" tag; + args = [G (0); F (Majorana, 0); F (Majorana, 2)] } ] } + +let empty = { tag = "empty"; keystones = [ ] } + +let vertices = + [ (qed, vector_spinor_current "v"); + (axial, vector_spinor_current "a"); + (left, vector_spinor_current "vl"); + (right, vector_spinor_current "vr"); + (scalar, scalar_spinor_current "s"); + (pseudo, scalar_spinor_current "p"); + (left_scalar, scalar_spinor_current "sl"); + (right_scalar, scalar_spinor_current "sr") ] + +let parse_propagator (p_tag, p_omega, p_spins, numerator, denominator) = + let p = + UFO.Propagator.of_propagator_UFO + { UFO.Propagator_UFO.name = p_tag; + UFO.Propagator_UFO.numerator = UFOx.Lorentz.of_string numerator; + UFO.Propagator_UFO.denominator = UFOx.Lorentz.of_string denominator } in + { p_tag; p_omega; p_spins; + p_propagator = p } + +let default_denominator = + "P('mu', id) * P('mu', id) - Mass(id) * Mass(id) \ + + complex(0,1) * Mass(id) * Width(id)" + +let majorana_propagator = + ( "majorana", "pr_psi", (Majorana, Majorana), + "Gamma('mu', 1, 2) * P('mu', id) + Mass(id) * Identity(1, 2)", + default_denominator ) + +let gravitino_propagator = + ( "vectorspinor", "pr_grav", (Vectorspinor, Vectorspinor), + "(Gamma(-1,1,2)*P(-1,id) - Mass(id)*Identity(1,2)) \ + * (Metric(1,2) - P(1,id)*P(2,id)/Mass(id)**2) \ + + 1/3 * (Gamma(1,1,-1) - P(1,id)/Mass(id)*Identity(1,-1)) \ + * (Gamma(-3,-1,-2)*P(-3,id) + Mass(id)*Identity(-1,-2)) \ + * (Gamma(2,-2,2) - P(2,id)/Mass(id)*Identity(-2,2)) ", + default_denominator ) + +let gravitino_propagator = + ( "vectorspinor", "pr_grav", (Vectorspinor, Vectorspinor), + "(Gamma(-1,2001,2002)*P(-1,id) - Mass(id)*Identity(2001,2002)) \ + * (Metric(1001,1002) - P(1001,id)*P(1002,id)/Mass(id)**2) \ + + 1/3 * (Gamma(1001,2001,-1) - P(1001,id)/Mass(id)*Identity(2001,-1)) \ + * (Gamma(-3,-1,-2)*P(-3,id) + Mass(id)*Identity(-1,-2)) \ + * (Gamma(1002,-2,2002) - P(1002,id)/Mass(id)*Identity(-2,2002)) ", + default_denominator ) + +let propagators = + List.map + parse_propagator + [ majorana_propagator; + (* [gravitino_propagator] *) ] + +let _ = + generate_ufo + ~reps:10000 ~threshold:0.70 ~omega_module:"omega95_bispinors" + "fusions" vertices propagators; + exit 0 Index: trunk/omega/tests/keystones.mli =================================================================== --- trunk/omega/tests/keystones.mli (revision 8359) +++ trunk/omega/tests/keystones.mli (revision 8360) @@ -1,41 +1,64 @@ (* keystones.mli -- Copyright (C) 2019-2019 by Wolfgang Kilian Thorsten Ohl Juergen Reuter WHIZARD is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2, or (at your option) any later version. WHIZARD is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) type field = Coupling.lorentz * int type argument = - | G of int (* coupling *) + | G of int (* complex coupling *) + | M of int (* real mass (or width) *) | P of int (* momentum *) | F of field (* field *) + | V of string (* verbatim *) type keystone = - { ket : field; + { bra : field; name : string; args : argument list } type vertex = { tag : string; keystones : keystone list } val generate : - ?reps:int -> ?threshold:float -> ?modules:(string list) -> + ?reps:int -> ?threshold:float -> + ?omega_module:string -> ?modules:string list -> vertex list -> unit + +type ufo_vertex = + { v_tag : string; + v_spins : Coupling.lorentz array; + v_tensor : UFOx.Lorentz.t } + +type ufo_propagator = + { p_tag : string; + p_omega : string; + p_spins : Coupling.lorentz * Coupling.lorentz; + p_propagator : UFO.Propagator.t } + +val equivalent_tensors : + Coupling.lorentz array -> (string * string) list -> ufo_vertex list + +val transpose : ufo_propagator -> ufo_propagator + +val generate_ufo : + ?omega_module:string -> ?reps:int -> ?threshold:float -> + string -> (ufo_vertex list * vertex) list -> ufo_propagator list -> unit Index: trunk/omega/tests/keystones_omegalib_bispinors_generate.ml =================================================================== --- trunk/omega/tests/keystones_omegalib_bispinors_generate.ml (revision 0) +++ trunk/omega/tests/keystones_omegalib_bispinors_generate.ml (revision 8360) @@ -0,0 +1,53 @@ +(* keystones_omegalib_bispinors_generate.ml -- + + Copyright (C) 2019-2019 by + + Wolfgang Kilian + Thorsten Ohl + Juergen Reuter + + WHIZARD is free software; you can redistribute it and/or modify it + under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2, or (at your option) + any later version. + + WHIZARD is distributed in the hope that it will be useful, but + WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) + +open Coupling +open Keystones + +let vector_spinor_current tag = + { tag = Printf.sprintf "vector_spinor_current__%s_ff" tag; + keystones = [ { bra = (Majorana, 0); + name = Printf.sprintf "f_%sf" tag; + args = [G (0); F (Vector, 1); F (Majorana, 2)] }; + { bra = (Vector, 1); + name = Printf.sprintf "%s_ff" tag; + args = [G (0); F (Majorana, 0); F (Majorana, 2)] } ] } + +let scalar_spinor_current tag = + { tag = Printf.sprintf "scalar_spinor_current__%s_ff" tag; + keystones = [ { bra = (Majorana, 0); + name = Printf.sprintf "f_%sf" tag; + args = [G (0); F (Scalar, 1); F (Majorana, 2)] }; + { bra = (Scalar, 1); + name = Printf.sprintf "%s_ff" tag; + args = [G (0); F (Majorana, 0); F (Majorana, 2)] } ] } + +let vertices = + List.concat + [ List.map vector_spinor_current ["v"; "a"; "vl"; "vr"]; + List.map scalar_spinor_current ["s"; "p"; "sl"; "sr"] ] + +let _ = + Keystones.generate + ~reps:10000 ~threshold:0.70 ~omega_module:"omega95_bispinors" + vertices; + exit 0 Index: trunk/omega/tests/Makefile.am =================================================================== --- trunk/omega/tests/Makefile.am (revision 8359) +++ trunk/omega/tests/Makefile.am (revision 8360) @@ -1,869 +1,914 @@ # Makefile.am -- Makefile for O'Mega within and without WHIZARD ## ## Process this file with automake to produce Makefile.in ## ######################################################################## # # Copyright (C) 1999-2019 by # Wolfgang Kilian # Thorsten Ohl # Juergen Reuter # with contributions from # cf. main AUTHORS file # # WHIZARD is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2, or (at your option) # any later version. # # WHIZARD is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the 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 = UFO DIST_SUBDIRS = UFO # OMEGA_SPLIT = -target:single_function OMEGA_SPLIT = -target:split_function 10 # OMEGA_SPLIT = -target:split_module 10 # OMEGA_SPLIT = -target:split_file 10 OMEGA_QED = $(top_builddir)/omega/bin/omega_QED$(OCAML_NATIVE_EXT) OMEGA_QED_OPTS = $(OMEGA_SPLIT) -target:parameter_module parameters_QED OMEGA_QCD = $(top_builddir)/omega/bin/omega_QCD$(OCAML_NATIVE_EXT) OMEGA_QCD_OPTS = $(OMEGA_SPLIT) -target:parameter_module parameters_QCD OMEGA_SYM = $(top_builddir)/omega/bin/omega_SYM$(OCAML_NATIVE_EXT) OMEGA_SYM_OPTS = $(OMEGA_SPLIT) -target:parameter_module parameters_SYM OMEGA_SM = $(top_builddir)/omega/bin/omega_SM$(OCAML_NATIVE_EXT) OMEGA_SM_OPTS = $(OMEGA_SPLIT) -target:parameter_module parameters_SM OMEGA_SM_CKM = $(top_builddir)/omega/bin/omega_SM_CKM$(OCAML_NATIVE_EXT) OMEGA_SM_Higgs = $(top_builddir)/omega/bin/omega_SM_Higgs$(OCAML_NATIVE_EXT) OMEGA_THDM = $(top_builddir)/omega/bin/omega_THDM$(OCAML_NATIVE_EXT) OMEGA_THDM_CKM = $(top_builddir)/omega/bin/omega_THDM_CKM$(OCAML_NATIVE_EXT) OMEGA_HSExt = $(top_builddir)/omega/bin/omega_HSExt$(OCAML_NATIVE_EXT) OMEGA_Zprime = $(top_builddir)/omega/bin/omega_Zprime$(OCAML_NATIVE_EXT) OMEGA_SM_top_anom = $(top_builddir)/omega/bin/omega_SM_top_anom$(OCAML_NATIVE_EXT) OMEGA_SM_top_anom_OPTS = $(OMEGA_SPLIT) -target:parameter_module parameters_SM_top_anom OMEGA_UFO = $(top_builddir)/omega/bin/omega_UFO$(OCAML_NATIVE_EXT) OMEGA_UFO_OPTS = -target:parameter_module parameters_UFO OMEGA_XXX = $(top_builddir)/omega/bin/omega_%%%$(OCAML_NATIVE_EXT) OMEGA_XXX_OPTS = -target:parameter_module parameters_%%% OMEGA_UFO_XXX_OPTS = \ "-model:UFO_dir $(top_srcdir)/omega/tests/UFO/%%%/ -model:exec" OMEGA_QED_VM = $(top_builddir)/omega/bin/omega_QED_VM$(OCAML_NATIVE_EXT) OMEGA_QCD_VM = $(top_builddir)/omega/bin/omega_QCD_VM$(OCAML_NATIVE_EXT) OMEGA_SM_VM = $(top_builddir)/omega/bin/omega_SM_VM$(OCAML_NATIVE_EXT) OMEGA_SM_CKM_VM = $(top_builddir)/omega/bin/omega_SM_CKM_VM$(OCAML_NATIVE_EXT) OMEGA_THDM_VM = $(top_builddir)/omega/bin/omega_THDM_VM$(OCAML_NATIVE_EXT) OMEGA_THDM_CKM_VM = $(top_builddir)/omega/bin/omega_THDM_CKM_VM$(OCAML_NATIVE_EXT) OMEGA_HSExt_VM = $(top_builddir)/omega/bin/omega_HSExt_VM$(OCAML_NATIVE_EXT) OMEGA_Zprime_VM = $(top_builddir)/omega/bin/omega_Zprime_VM$(OCAML_NATIVE_EXT) OMEGA_SM_Higgs_VM = $(top_builddir)/omega/bin/omega_SM_Higgs_VM$(OCAML_NATIVE_EXT) OMEGA_XXX_VM = $(top_builddir)/omega/bin/omega_%%%_VM$(OCAML_NATIVE_EXT) OMEGA_XXX_VM_PARAMS_OPTS = -params -target:parameter_module_external \ parameters_%%% -target:wrapper_module %% -target:bytecode_file % AM_FCFLAGS = -I$(top_builddir)/omega/src AM_LDFLAGS = ######################################################################## ## Default Fortran compiler options ## OpenMP if FC_USE_OPENMP AM_FCFLAGS += $(FCFLAGS_OPENMP) AM_TESTS_ENVIRONMENT = \ export OMP_NUM_THREADS=1; endif ######################################################################## TESTS = XFAIL_TESTS = EXTRA_PROGRAMS = EXTRA_DIST = ######################################################################## include $(top_srcdir)/omega/src/Makefile.ocaml if OCAML_AVAILABLE OCAMLFLAGS += -I $(top_builddir)/omega/src OMEGA_CORE = $(top_builddir)/omega/src/omega_core.cmxa OMEGA_MODELS = $(top_builddir)/omega/src/omega_models.cmxa TESTS += omega_unit EXTRA_PROGRAMS += omega_unit omega_unit_SOURCES = omega_unit.ml omega_unit: $(OMEGA_CORE) omega_unit.cmx @if $(AM_V_P); then :; else echo " OCAMLOPT " $@; fi $(AM_V_at)$(OCAMLOPT) $(OCAMLFLAGS) $(OCAMLOPTFLAGS) -o omega_unit \ unix.cmxa $(OMEGA_CORE) omega_unit.cmx omega_unit.cmx: omega_unit.ml omega_unit.cmx: $(OMEGA_CORE) endif ######################################################################## KINDS = $(top_builddir)/omega/src/kinds.lo TESTS += test_omega95 test_omega95_bispinors EXTRA_PROGRAMS += test_omega95 test_omega95_bispinors test_omega95_SOURCES = test_omega95.f90 omega_testtools.f90 test_omega95_LDADD = $(KINDS) $(top_builddir)/omega/src/libomega_core.la test_omega95_bispinors_SOURCES = test_omega95_bispinors.f90 omega_testtools.f90 test_omega95_bispinors_LDADD = $(KINDS) $(top_builddir)/omega/src/libomega_core.la test_omega95.o test_omega95_bispinors.o: omega_testtools.o if NOWEB_AVAILABLE test_omega95.f90: $(top_srcdir)/omega/src/omegalib.nw $(NOTANGLE) -R[[$@]] $< | $(CPIF) $@ test_omega95_bispinors.f90: $(top_srcdir)/omega/src/omegalib.nw $(NOTANGLE) -R[[$@]] $< | $(CPIF) $@ omega_testtools.f90: $(top_srcdir)/omega/src/omegalib.nw $(NOTANGLE) -R[[$@]] $< | $(CPIF) $@ endif NOWEB_AVAILABLE ######################################################################## TESTS += test_qed_eemm EXTRA_PROGRAMS += test_qed_eemm test_qed_eemm_SOURCES = test_qed_eemm.f90 parameters_QED.f90 nodist_test_qed_eemm_SOURCES = amplitude_qed_eemm.f90 test_qed_eemm_LDADD = $(KINDS) $(top_builddir)/omega/src/libomega_core.la amplitude_qed_eemm.f90: $(OMEGA_QED) Makefile $(OMEGA_QED) $(OMEGA_QED_OPTS) -target:module amplitude_qed_eemm \ -scatter "e+ e- -> m+ m-" > $@ test_qed_eemm.o: amplitude_qed_eemm.o test_qed_eemm.o: parameters_QED.o amplitude_qed_eemm.o: parameters_QED.o ######################################################################## EXTENDED_COLOR_TESTS = \ $(srcdir)/fc_s.ects \ $(srcdir)/fc_a.ects $(srcdir)/cf_a.ects $(srcdir)/fa_f.ects \ $(srcdir)/ca_c.ects $(srcdir)/af_f.ects $(srcdir)/ac_c.ects \ $(srcdir)/aa_a.ects \ $(srcdir)/fc_fc.ects \ $(srcdir)/aa_s.ects $(srcdir)/as_a.ects $(srcdir)/sa_a.ects TESTS += ects EXTRA_PROGRAMS += ects EXTRA_DIST += ects_driver.sh $(EXTENDED_COLOR_TESTS) # Explicitly state dependence on model files ects.f90: $(OMEGA_QCD) $(OMEGA_SYM) $(OMEGA_SM) ects.f90: ects_driver.sh $(EXTENDED_COLOR_TESTS) @if $(AM_V_P); then :; else echo " ECTS_DRIVER"; fi $(AM_V_at)$(SHELL) $(srcdir)/ects_driver.sh \ $(OMEGA_XXX) $(EXTENDED_COLOR_TESTS) > $@ ects_SOURCES = color_test_lib.f90 \ parameters_SM.f90 parameters_QED.f90 parameters_QCD.f90 parameters_SYM.f90 nodist_ects_SOURCES = ects.f90 ects_LDADD = $(KINDS) $(top_builddir)/omega/src/libomega_core.la ######################################################################## TESTS += cascade # if there is some debugging output ... # XFAIL_TESTS += cascade CASCADE_TESTS = \ bhabha-s-channel.cascade bhabha-t-channel.cascade bhabha-full.cascade \ ww-onlycc.cascade ww-notgc.cascade \ jjj-notgc.cascade \ vbf-noh.cascade cascade: cascade_driver.sh Makefile $(SED) -e 's|%%cascade_tests%%|$(CASCADE_TESTS)|' \ -e 's|%%srcdir%%|$(srcdir)|' \ -e 's|%%SED%%|$(SED)|' \ -e 's|%%top_builddir%%|$(top_builddir)|' \ -e 's|%%OCAML_NATIVE_EXT%%|$(OCAML_NATIVE_EXT)|' $< >$@ chmod +x $@ EXTRA_DIST += cascade_driver.sh $(CASCADE_TESTS) ######################################################################## TESTS += phase_space PHASE_SPACE_TESTS = eeee.phs qqggg.phs phase_space: phase_space_driver.sh Makefile $(SED) -e 's|%%phase_space_tests%%|$(PHASE_SPACE_TESTS)|' \ -e 's|%%srcdir%%|$(srcdir)|' \ -e 's|%%SED%%|$(SED)|' \ -e 's|%%top_builddir%%|$(top_builddir)|' \ -e 's|%%OCAML_NATIVE_EXT%%|$(OCAML_NATIVE_EXT)|' $< >$@ chmod +x $@ EXTRA_DIST += phase_space_driver.sh $(PHASE_SPACE_TESTS) ######################################################################## TESTS += fermi # XFAIL_TESTS += fermi EXTRA_PROGRAMS += fermi EXTRA_DIST += fermi_driver.sh EXTRA_DIST += fermi.list FERMI_SUPPORT_F90 = \ omega_interface.f90 omega_testtools.f90 tao_random_numbers.f90 \ parameters_QED.f90 parameters_QCD.f90 parameters_SYM.f90 \ parameters_SM.f90 parameters_MSSM.f90 parameters_SM_top_anom.f90 FERMI_SUPPORT_O = $(FERMI_SUPPORT_F90:.f90=.o) fermi_lib.o: $(FERMI_SUPPORT_O) FERMI_LIB_F90 = fermi_lib.f90 $(FERMI_SUPPORT_F90) FERMI_LIB_O = $(FERMI_LIB_F90:.f90=.o) run_fermi: fermi ./fermi fermi.f90: fermi_driver.sh $(OMEGA_QED) $(OMEGA_QCD) $(OMEGA_SYM) fermi.f90: $(OMEGA_SM) $(OMEGA_SM_top_anom) fermi.f90: fermi.list @if $(AM_V_P); then :; else echo " FERMI_DRIVER"; fi $(AM_V_at)$(SHELL) $(srcdir)/fermi_driver.sh \ $(OMEGA_XXX) $(OMEGA_SPLIT) < $< > $@ fermi_SOURCES = $(FERMI_LIB_F90) nodist_fermi_SOURCES = fermi.f90 fermi_LDADD = $(KINDS) $(top_builddir)/omega/src/libomega_core.la fermi.o: $(FERMI_LIB_O) ######################################################################## TESTS += ward EXTRA_PROGRAMS += ward EXTRA_DIST += ward_driver.sh EXTRA_DIST += ward_identities.list WARD_SUPPORT_F90 = \ omega_interface.f90 omega_testtools.f90 tao_random_numbers.f90 \ parameters_QED.f90 parameters_QCD.f90 parameters_SYM.f90 \ parameters_SM.f90 parameters_SM_top_anom.f90 WARD_SUPPORT_O = $(WARD_SUPPORT_F90:.f90=.o) ward_lib.o: $(WARD_SUPPORT_O) WARD_LIB_F90 = ward_lib.f90 $(WARD_SUPPORT_F90) WARD_LIB_O = $(WARD_LIB_F90:.f90=.o) run_ward: ward ./ward ward.f90: ward_driver.sh $(OMEGA_QED) $(OMEGA_QCD) $(OMEGA_SYM) ward.f90: $(OMEGA_SM) $(OMEGA_SM_top_anom) ward.f90: ward_identities.list @if $(AM_V_P); then :; else echo " WARD_DRIVER"; fi $(AM_V_at)$(SHELL) $(srcdir)/ward_driver.sh \ $(OMEGA_XXX) $(OMEGA_SPLIT) < $< > $@ ward_SOURCES = $(WARD_LIB_F90) nodist_ward_SOURCES = ward.f90 ward_LDADD = $(KINDS) $(top_builddir)/omega/src/libomega_core.la ward.o: $(WARD_LIB_O) ######################################################################## EXTRA_PROGRAMS += ward_long EXTRA_DIST += ward_identities_long.list run_ward_long: ward_long ./ward_long ward_long.f90: ward_driver.sh ward_long.f90: ward_identities_long.list @if $(AM_V_P); then :; else echo " WARD_DRIVER"; fi $(AM_V_at)$(SHELL) $(srcdir)/ward_driver.sh \ $(OMEGA_XXX) $(OMEGA_SPLIT) < $< > $@ ward_long_SOURCES = $(WARD_LIB_F90) nodist_ward_long_SOURCES = ward_long.f90 ward_long_LDADD = $(KINDS) $(top_builddir)/omega/src/libomega_core.la # ward_long.o: ward_long.f90 # $(FCCOMPILE) -c -o $@ $(FCFLAGS_f90) -O0 $< ward_long.o: $(WARD_LIB_O) ######################################################################## EXTRA_PROGRAMS += ward_fail EXTRA_DIST += ward_identities_fail.list run_ward_fail: ward_fail ./ward_fail ward_fail.f90: ward_driver.sh ward_fail.f90: ward_identities_fail.list @if $(AM_V_P); then :; else echo " WARD_DRIVER"; fi $(AM_V_at)$(SHELL) $(srcdir)/ward_driver.sh \ $(OMEGA_XXX) $(OMEGA_SPLIT) < $< > $@ ward_fail_SOURCES = $(WARD_LIB_F90) nodist_ward_fail_SOURCES = ward_fail.f90 ward_fail_LDADD = $(KINDS) $(top_builddir)/omega/src/libomega_core.la ward_fail.o: ward_fail.f90 $(FCCOMPILE) -c -o $@ $(FCFLAGS_f90) -O0 $< ward_fail.o: $(WARD_LIB_O) ######################################################################## TESTS += compare_split_function compare_split_module EXTRA_PROGRAMS += compare_split_function compare_split_module EXTRA_DIST += compare_driver.sh EXTRA_DIST += comparisons.list COMPARE_SUPPORT_F90 = $(WARD_SUPPORT_F90) COMPARE_SUPPORT_O = $(WARD_SUPPORT_O) compare_lib.o: $(COMPARE_SUPPORT_O) COMPARE_LIB_F90 = compare_lib.f90 $(COMPARE_SUPPORT_F90) COMPARE_LIB_O = $(COMPARE_LIB_F90:.f90=.o) run_compare: compare_split_function compare_split_module ./compare_split_function ./compare_split_module compare_split_function.f90: comparisons.list @if $(AM_V_P); then :; else echo " COMPARE_DRIVER"; fi $(AM_V_at)$(SHELL) $(srcdir)/compare_driver.sh SF \ "$(OMEGA_XXX) -target:single_function" \ "$(OMEGA_XXX) -target:split_function 10" < $< > $@ compare_split_module.f90: comparisons.list @if $(AM_V_P); then :; else echo " COMPARE_DRIVER"; fi $(AM_V_at)$(SHELL) $(srcdir)/compare_driver.sh SM \ "$(OMEGA_XXX) -target:single_function" \ "$(OMEGA_XXX) -target:split_module 10" < $< > $@ compare_split_function.f90 compare_split_module.f90: \ compare_driver.sh $(OMEGA_QCD) $(OMEGA_SM) compare_split_function_SOURCES = $(COMPARE_LIB_F90) nodist_compare_split_function_SOURCES = compare_split_function.f90 compare_split_function_LDADD = $(KINDS) $(top_builddir)/omega/src/libomega_core.la compare_split_module_SOURCES = $(COMPARE_LIB_F90) nodist_compare_split_module_SOURCES = compare_split_module.f90 compare_split_module_LDADD = $(KINDS) $(top_builddir)/omega/src/libomega_core.la compare_split_function.o compare_split_module.o: $(COMPARE_LIB_O) ######################################################################## # At quadruple or extended precision, these tests take waaaaaayyyy too long! if FC_PREC else TESTS += compare_amplitude_UFO # XFAIL_TESTS += compare_amplitude_UFO EXTRA_PROGRAMS += compare_amplitude_UFO EXTRA_DIST += compare_driver_UFO.sh EXTRA_DIST += comparisons_UFO.list compare_amplitude_UFO_SOURCES = \ parameters_SM_from_UFO.f90 compare_lib.f90 \ omega_interface.f90 omega_testtools.f90 tao_random_numbers.f90 compare_amplitude_UFO.f90: comparisons_UFO.list compare_driver_UFO.sh $(OMEGA_UFO) @if $(AM_V_P); then :; else echo " COMPARE_DRIVER_UFO"; fi $(AM_V_at)$(SHELL) $(srcdir)/compare_driver_UFO.sh UFO \ "$(OMEGA_XXX) -model:constant_width" \ "$(OMEGA_UFO) -model:UFO_dir $(top_srcdir)/omega/tests/UFO/%%%/ -model:exec" \ < $< > $@ # -model:long_flavors parameters_SM_UFO.f90: $(OMEGA_UFO) $(OMEGA_UFO) \ -model:UFO_dir $(top_srcdir)/omega/tests/UFO/SM/ -model:exec \ -target:parameter_module parameters_sm_ufo -params > $@ nodist_compare_amplitude_UFO_SOURCES = \ compare_amplitude_UFO.f90 parameters_SM_UFO.f90 compare_amplitude_UFO_LDADD = $(KINDS) $(top_builddir)/omega/src/libomega_core.la parameters_SM_from_UFO.o: parameters_SM_UFO.o compare_amplitude_UFO.o: parameters_SM_UFO.o parameters_SM_from_UFO.o compare_amplitude_UFO.o: $(COMPARE_LIB_O) endif ######################################################################## # At quadruple or extended precision, these tests take waaaaaayyyy too long! if FC_PREC else TESTS += fermi_UFO # XFAIL_TESTS += fermi_UFO # We need more work on the parameters to pass the tests # at quadruple or extended precision. if FC_PREC XFAIL_TESTS += fermi_UFO endif EXTRA_PROGRAMS += fermi_UFO EXTRA_DIST += fermi_driver_UFO.sh EXTRA_DIST += fermi_UFO.list FERMI_UFO_SUPPORT_F90 = \ omega_interface.f90 omega_testtools.f90 tao_random_numbers.f90 FERMI_UFO_SUPPORT_O = $(FERMI_UFO_SUPPORT_F90:.f90=.o) fermi_UFO_lib.o: $(FERMI_SUPPORT_O) FERMI_UFO_LIB_F90 = fermi_lib.f90 $(FERMI_UFO_SUPPORT_F90) FERMI_UFO_LIB_O = $(FERMI_UFO_LIB_F90:.f90=.o) run_fermi_UFO: fermi_UFO ./fermi_UFO fermi_UFO.f90: fermi_UFO.list fermi_driver_UFO.sh $(OMEGA_UFO) @if $(AM_V_P); then :; else echo " FERMI_UFO_DRIVER"; fi $(AM_V_at)$(SHELL) $(srcdir)/fermi_driver_UFO.sh \ $(OMEGA_UFO) -model:UFO_dir $(top_srcdir)/omega/tests/UFO/SM/ \ $(OMEGA_SPLIT) < $< > $@ fermi_UFO_SOURCES = $(FERMI_UFO_LIB_F90) nodist_fermi_UFO_SOURCES = fermi_UFO.f90 parameters_SM_UFO.f90 fermi_UFO_LDADD = $(KINDS) $(top_builddir)/omega/src/libomega_core.la fermi_UFO.o: $(FERMI_UFO_LIB_O) endif ######################################################################## # At quadruple or extended precision, these tests take waaaaaayyyy too long! if FC_PREC else TESTS += ward_UFO # We need more work on the parameters to pass the tests # at quadruple or extended precision. if FC_PREC XFAIL_TESTS += ward_UFO endif EXTRA_PROGRAMS += ward_UFO EXTRA_DIST += ward_driver_UFO.sh EXTRA_DIST += ward_identities_UFO.list WARD_UFO_SUPPORT_F90 = \ omega_interface.f90 omega_testtools.f90 tao_random_numbers.f90 WARD_UFO_SUPPORT_O = $(WARD_UFO_SUPPORT_F90:.f90=.o) ward_UFO_lib.o: $(WARD_SUPPORT_O) WARD_UFO_LIB_F90 = ward_lib.f90 $(WARD_UFO_SUPPORT_F90) WARD_UFO_LIB_O = $(WARD_UFO_LIB_F90:.f90=.o) run_ward_UFO: ward_UFO ./ward_UFO ward_UFO.f90: ward_identities_UFO.list ward_driver_UFO.sh $(OMEGA_UFO) @if $(AM_V_P); then :; else echo " WARD_UFO_DRIVER"; fi $(AM_V_at)$(SHELL) $(srcdir)/ward_driver_UFO.sh \ $(OMEGA_UFO) -model:UFO_dir $(top_srcdir)/omega/tests/UFO/SM/ \ $(OMEGA_SPLIT) < $< > $@ ward_UFO_SOURCES = $(WARD_UFO_LIB_F90) nodist_ward_UFO_SOURCES = ward_UFO.f90 parameters_SM_UFO.f90 ward_UFO_LDADD = $(KINDS) $(top_builddir)/omega/src/libomega_core.la ward_UFO.o: $(WARD_UFO_LIB_O) endif ######################################################################## TESTS += compare_amplitude_VM EXTRA_PROGRAMS += compare_amplitude_VM EXTRA_DIST += compare_driver_VM.sh compare_driver_VM_wrappers.sh EXTRA_DIST += comparisons_VM.list compare_amplitude_VM.f90: comparisons_VM.list comparisons_VM.wrappers.o @if $(AM_V_P); then :; else echo " COMPARE_DRIVER_VM"; fi $(AM_V_at)$(SHELL) $(srcdir)/compare_driver_VM.sh \ "$(OMEGA_XXX) " "$(OMEGA_XXX_VM) " "$(OMEGA_XXX_VM_PARAMS_OPTS)" < $< > $@ comparisons_VM.wrappers.f90: comparisons_VM.list @if $(AM_V_P); then :; else echo " COMPARE_DRIVER_VM_WRAPPERS"; fi $(AM_V_at)$(SHELL) $(srcdir)/compare_driver_VM_wrappers.sh \ "$(OMEGA_XXX) " "$(OMEGA_XXX_VM) " "$(OMEGA_XXX_VM_PARAMS_OPTS)" < $< > $@ # Explicitly state dependence on model files compare_amplitude_VM.f90: compare_driver_VM.sh \ $(OMEGA_QED) $(OMEGA_QED_VM) \ $(OMEGA_QCD) $(OMEGA_QCD_VM) \ $(OMEGA_SM) $(OMEGA_SM_VM) \ $(OMEGA_SM_CKM) $(OMEGA_SM_CKM_VM) \ $(OMEGA_SM_Higgs) $(OMEGA_SM_Higgs_VM) \ $(OMEGA_THDM) $(OMEGA_THDM_VM) \ $(OMEGA_THDM_CKM) $(OMEGA_THDM_CKM_VM) \ $(OMEGA_HSExt) $(OMEGA_HSExt_VM) \ $(OMEGA_Zprime) $(OMEGA_Zprime_VM) COMPARE_EXTRA_MODELS = parameters_SM_CKM.f90 parameters_SM_Higgs.f90 \ parameters_THDM.f90 parameters_THDM_CKM.f90 parameters_HSExt.f90 \ parameters_Zprime.f90 compare_amplitude_VM_SOURCES = $(COMPARE_LIB_F90) $(COMPARE_EXTRA_MODELS) nodist_compare_amplitude_VM_SOURCES = compare_amplitude_VM.f90 comparisons_VM.wrappers.f90 compare_amplitude_VM_LDADD = $(KINDS) $(top_builddir)/omega/src/libomega_core.la compare_amplitude_VM.o: $(COMPARE_LIB_O) ######################################################################## if FC_USE_OPENMP TESTS += test_openmp EXTRA_PROGRAMS += test_openmp TESTOPENMP_SUPPORT_F90 = $(WARD_SUPPORT_F90) TESTOPENMP_SUPPORT_O = $(WARD_SUPPORT_O) test_openmp_SOURCES = test_openmp.f90 $(TESTOPENMP_SUPPORT_F90) nodist_test_openmp_SOURCES = amplitude_openmp.f90 test_openmp_LDADD = $(KINDS) $(top_builddir)/omega/src/libomega_core.la amplitude_openmp.f90: $(OMEGA_QCD) Makefile $(OMEGA_QCD) $(OMEGA_QCD_OPTS) -target:openmp \ -target:module amplitude_openmp -scatter "gl gl -> gl gl gl" > $@ test_openmp.o: amplitude_openmp.o test_openmp.o: $(TESTOPENMP_SUPPORT_O) amplitude_openmp.o: parameters_QCD.o endif ######################################################################## EXTRA_PROGRAMS += benchmark_VM_vs_Fortran EXTRA_DIST += benchmark_VM_vs_Fortran_driver.sh BENCHMARK_LIB_F90 = benchmark_lib.f90 $(WARD_SUPPORT_F90) BENCHMARK_LIB_O = $(BENCHMARK_LIB_F90:.f90=.o) benchmark_VM_vs_Fortran.f90: benchmark_processes.list benchmark_processes.wrappers.o @if $(AM_V_P); then :; else echo " BENCHMARK_VM_DRIVER"; fi $(AM_V_at)$(SHELL) $(srcdir)/benchmark_VM_vs_Fortran_driver.sh \ "$(OMEGA_XXX) " "$(OMEGA_XXX_VM) " "$(OMEGA_XXX_VM_PARAMS_OPTS)" < $< > $@ benchmark_processes.wrappers.f90: benchmark_processes.list @if $(AM_V_P); then :; else echo " BENCHMARK_DRIVER_WRAPPERS"; fi $(AM_V_at)$(SHELL) $(srcdir)/benchmark_driver_wrappers.sh \ "$(OMEGA_XXX) " "$(OMEGA_XXX_VM) " "$(OMEGA_XXX_VM_PARAMS_OPTS)" < $< > $@ # Explicitly state dependence on model files benchmark_VM_vs_Fortran.f90: benchmark_VM_vs_Fortran_driver.sh \ $(OMEGA_QED) $(OMEGA_QED_VM) \ $(OMEGA_QCD) $(OMEGA_QCD_VM) \ $(OMEGA_SM) $(OMEGA_SM_VM) benchmark_VM_vs_Fortran_SOURCES = $(BENCHMARK_LIB_F90) nodist_benchmark_VM_vs_Fortran_SOURCES = benchmark_VM_vs_Fortran.f90 benchmark_processes.wrappers.f90 benchmark_VM_vs_Fortran_LDADD = $(KINDS) $(top_builddir)/omega/src/libomega_core.la benchmark_VM_vs_Fortran.o: $(BENCHMARK_LIB_O) ######################################################################## if FC_USE_OPENMP EXTRA_PROGRAMS += benchmark_amp_parallel benchmark_amp_parallel.f90: benchmark_processes.list benchmark_processes.wrappers.o @if $(AM_V_P); then :; else echo " BENCHMARK_PARALLEL_DRIVER"; fi $(AM_V_at)$(SHELL) $(srcdir)/benchmark_amp_parallel_driver.sh \ "$(OMEGA_XXX) " "$(OMEGA_XXX_VM) " "$(OMEGA_XXX_VM_PARAMS_OPTS)" < $< > $@ # Explicitly state dependence on model files benchmark_amp_parallel.f90: benchmark_amp_parallel_driver.sh \ $(OMEGA_QED) $(OMEGA_QED_VM) \ $(OMEGA_QCD) $(OMEGA_QCD_VM) \ $(OMEGA_SM) $(OMEGA_SM_VM) benchmark_amp_parallel_SOURCES = $(BENCHMARK_LIB_F90) nodist_benchmark_amp_parallel_SOURCES = benchmark_amp_parallel.f90 benchmark_processes.wrappers.f90 benchmark_amp_parallel_LDADD = $(KINDS) $(top_builddir)/omega/src/libomega_core.la benchmark_amp_parallel.o: $(BENCHMARK_LIB_O) endif ######################################################################## EXTRA_PROGRAMS += benchmark run_benchmark: benchmark ./benchmark BENCHMARK_PROCESS = -scatter "gl gl -> gl gl gl" BENCHMARK_SPLIT_SIZE = 10 benchmark_SOURCES = benchmark.f90 parameters_QCD.f90 nodist_benchmark_SOURCES = \ amplitude_benchmark_v1.f90 amplitude_benchmark_v2.f90 \ amplitude_benchmark_v3.f90 # amplitude_benchmark_v4.f90 benchmark_LDADD = $(KINDS) $(top_builddir)/omega/src/libomega_core.la amplitude_benchmark_v1.f90: $(OMEGA_QCD) Makefile $(OMEGA_QCD) $(OMEGA_QCD_OPTS) -target:module amplitude_benchmark_v1 \ $(BENCHMARK_PROCESS) -target:single_function > $@ amplitude_benchmark_v2.f90: $(OMEGA_QCD) Makefile $(OMEGA_QCD) $(OMEGA_QCD_OPTS) -target:module amplitude_benchmark_v2 \ $(BENCHMARK_PROCESS) -target:split_function $(BENCHMARK_SPLIT_SIZE) > $@ amplitude_benchmark_v3.f90: $(OMEGA_QCD) Makefile $(OMEGA_QCD) $(OMEGA_QCD_OPTS) -target:module amplitude_benchmark_v3 \ $(BENCHMARK_PROCESS) -target:split_module $(BENCHMARK_SPLIT_SIZE) > $@ amplitude_benchmark_v4.f90: $(OMEGA_QCD) Makefile $(OMEGA_QCD) $(OMEGA_QCD_OPTS) -target:module amplitude_benchmark_v4 \ $(BENCHMARK_PROCESS) -target:split_file $(BENCHMARK_SPLIT_SIZE) > $@ benchmark.o: \ amplitude_benchmark_v1.o amplitude_benchmark_v2.o \ amplitude_benchmark_v3.o # amplitude_benchmark_v4.o benchmark.o: parameters_QCD.o amplitude_benchmark_v1.o amplitude_benchmark_v2.o \ amplitude_benchmark_v3.o amplitude_benchmark_v4.o: parameters_QCD.o ######################################################################## if OCAML_AVAILABLE TESTS += vertex_unit EXTRA_PROGRAMS += vertex_unit vertex_unit_SOURCES = vertex_unit.ml vertex_unit: $(OMEGA_CORE) vertex_unit.cmx @if $(AM_V_P); then :; else echo " OCAMLOPT " $@; fi $(AM_V_at)$(OCAMLOPT) $(OCAMLFLAGS) $(OCAMLOPTFLAGS) -o vertex_unit \ unix.cmxa $(OMEGA_CORE) $(OMEGA_MODELS) vertex_unit.cmx vertex_unit.cmx: vertex_unit.ml vertex_unit.cmx: $(OMEGA_CORE) $(OMEGA_MODELS) endif ######################################################################## if OCAML_AVAILABLE TESTS += ufo_unit EXTRA_PROGRAMS += ufo_unit ufo_unit_SOURCES = ufo_unit.ml ufo_unit: $(OMEGA_CORE) ufo_unit.cmx @if $(AM_V_P); then :; else echo " OCAMLOPT " $@; fi $(AM_V_at)$(OCAMLOPT) $(OCAMLFLAGS) $(OCAMLOPTFLAGS) -o ufo_unit \ unix.cmxa $(OMEGA_CORE) $(OMEGA_MODELS) ufo_unit.cmx ufo_unit.cmx: ufo_unit.ml ufo_unit.cmx: $(OMEGA_CORE) $(OMEGA_MODELS) endif ######################################################################## if OCAML_AVAILABLE TESTS += keystones_omegalib keystones_UFO +TESTS += keystones_omegalib_bispinors keystones_UFO_bispinors # XFAIL_TESTS += keystones_UFO +XFAIL_TESTS += keystones_UFO_bispinors EXTRA_PROGRAMS += keystones_omegalib keystones_UFO +EXTRA_PROGRAMS += keystones_omegalib_bispinors keystones_UFO_bispinors keystones_omegalib_SOURCES = omega_testtools.f90 keystones_tools.f90 nodist_keystones_omegalib_SOURCES = keystones_omegalib.f90 keystones_omegalib_LDADD = $(KINDS) $(top_builddir)/omega/src/libomega_core.la keystones_UFO_SOURCES = omega_testtools.f90 keystones_tools.f90 nodist_keystones_UFO_SOURCES = keystones_UFO.f90 keystones_UFO_LDADD = $(KINDS) $(top_builddir)/omega/src/libomega_core.la +keystones_omegalib_bispinors_SOURCES = omega_testtools.f90 keystones_tools.f90 +nodist_keystones_omegalib_bispinors_SOURCES = keystones_omegalib_bispinors.f90 +keystones_omegalib_bispinors_LDADD = $(KINDS) $(top_builddir)/omega/src/libomega_core.la + +keystones_UFO_bispinors_SOURCES = omega_testtools.f90 keystones_tools.f90 +nodist_keystones_UFO_bispinors_SOURCES = keystones_UFO_bispinors.f90 +keystones_UFO_bispinors_LDADD = $(KINDS) $(top_builddir)/omega/src/libomega_core.la + EXTRA_PROGRAMS += keystones_omegalib_generate keystones_UFO_generate +EXTRA_PROGRAMS += keystones_omegalib_bispinors_generate keystones_UFO_bispinors_generate keystones_omegalib_generate_SOURCES = \ keystones.ml keystones.mli keystones_omegalib_generate.ml keystones_UFO_generate_SOURCES = \ keystones.ml keystones.mli keystones_UFO_generate.ml +keystones_omegalib_bispinors_generate_SOURCES = \ + keystones.ml keystones.mli keystones_omegalib_bispinors_generate.ml +keystones_UFO_bispinors_generate_SOURCES = \ + keystones.ml keystones.mli keystones_UFO_bispinors_generate.ml keystones_omegalib.f90: keystones_omegalib_generate ./keystones_omegalib_generate -cat > $@ keystones_UFO.f90: keystones_UFO_generate ./keystones_UFO_generate -cat > $@ +keystones_omegalib_bispinors.f90: keystones_omegalib_bispinors_generate + ./keystones_omegalib_bispinors_generate -cat > $@ + +keystones_UFO_bispinors.f90: keystones_UFO_bispinors_generate + ./keystones_UFO_bispinors_generate -cat > $@ + keystones_omegalib_generate: $(OMEGA_CORE) keystones_omegalib_generate.cmx @if $(AM_V_P); then :; else echo " OCAMLOPT " $@; fi $(AM_V_at)$(OCAMLOPT) $(OCAMLFLAGS) $(OCAMLOPTFLAGS) \ -o keystones_omegalib_generate \ unix.cmxa $(OMEGA_CORE) $(OMEGA_MODELS) \ keystones.cmx keystones_omegalib_generate.cmx keystones_UFO_generate: $(OMEGA_CORE) keystones_UFO_generate.cmx @if $(AM_V_P); then :; else echo " OCAMLOPT " $@; fi $(AM_V_at)$(OCAMLOPT) $(OCAMLFLAGS) $(OCAMLOPTFLAGS) \ -o keystones_UFO_generate \ unix.cmxa $(OMEGA_CORE) $(OMEGA_MODELS) \ keystones.cmx keystones_UFO_generate.cmx +keystones_omegalib_bispinors_generate: $(OMEGA_CORE) keystones_omegalib_bispinors_generate.cmx + @if $(AM_V_P); then :; else echo " OCAMLOPT " $@; fi + $(AM_V_at)$(OCAMLOPT) $(OCAMLFLAGS) $(OCAMLOPTFLAGS) \ + -o keystones_omegalib_bispinors_generate \ + unix.cmxa $(OMEGA_CORE) $(OMEGA_MODELS) \ + keystones.cmx keystones_omegalib_bispinors_generate.cmx + +keystones_UFO_bispinors_generate: $(OMEGA_CORE) keystones_UFO_bispinors_generate.cmx + @if $(AM_V_P); then :; else echo " OCAMLOPT " $@; fi + $(AM_V_at)$(OCAMLOPT) $(OCAMLFLAGS) $(OCAMLOPTFLAGS) \ + -o keystones_UFO_bispinors_generate \ + unix.cmxa $(OMEGA_CORE) $(OMEGA_MODELS) \ + keystones.cmx keystones_UFO_bispinors_generate.cmx + keystones_omegalib_generate.cmx: \ keystones.cmi keystones.cmx keystones_omegalib_generate.ml keystones_omegalib_generate.cmx: $(OMEGA_CORE) $(OMEGA_MODELS) keystones_UFO_generate.cmx: \ keystones.cmi keystones.cmx keystones_UFO_generate.ml keystones_UFO_generate.cmx: $(OMEGA_CORE) $(OMEGA_MODELS) +keystones_omegalib_bispinors_generate.cmx: \ + keystones.cmi keystones.cmx keystones_omegalib_bispinors_generate.ml +keystones_omegalib_bispinors_generate.cmx: $(OMEGA_CORE) $(OMEGA_MODELS) + +keystones_UFO_bispinors_generate.cmx: \ + keystones.cmi keystones.cmx keystones_UFO_bispinors_generate.ml +keystones_UFO_bispinors_generate.cmx: $(OMEGA_CORE) $(OMEGA_MODELS) + keystones.cmx: keystones.ml keystones.cmi keystones.cmx: $(OMEGA_CORE) $(OMEGA_MODELS) keystones.cmi: keystones.mli endif ######################################################################## if RECOLA_AVAILABLE TESTS += compare_amplitude_recola # We need more work on the parameters to pass the tests # at quadruple or extended precision if FC_PREC XFAIL_TESTS += compare_amplitude_recola endif EXTRA_PROGRAMS += compare_amplitude_recola AM_FCFLAGS += $(RECOLA_INCLUDES) compare_amplitude_recola_SOURCES = \ parameters_SM_Higgs_recola.f90 \ omega_interface.f90 compare_lib.f90 compare_lib_recola.f90 \ omega_testtools.f90 tao_random_numbers.f90 nodist_compare_amplitude_recola_SOURCES = compare_amplitude_recola.f90 compare_amplitude_recola.f90: comparisons_recola.list compare_driver_recola.sh @if $(AM_V_P); then :; else echo " COMPARE_DRIVER_RECOLA"; fi $(AM_V_at)$(SHELL) $(srcdir)/compare_driver_recola.sh \ "$(OMEGA_XXX) -model:constant_width" < $< > $@ compare_amplitude_recola.o: \ omega_testtools.f90 compare_lib.o compare_lib_recola.o \ tao_random_numbers.o \ parameters_SM_Higgs_recola.o compare_lib_recola.o: \ omega_testtools.f90 compare_lib.o tao_random_numbers.o \ parameters_SM_Higgs_recola.o compare_amplitude_recola_LDADD = \ $(LDFLAGS_RECOLA) \ $(KINDS) $(top_builddir)/omega/src/libomega_core.la run_compare_recola: compare_amplitude_recola ./compare_amplitude_recola endif ######################################################################## installcheck-local: PATH=$(DESTDIR)$(bindir):$$PATH; export PATH; \ LD_LIBRARY_PATH=$(DESTDIR)$(libdir):$(DESTDIR)$(pkglibdir):$$LD_LIBRARY_PATH; \ export LD_LIBRARY_PATH; \ omega_QED.opt $(OMEGA_QED_OPTS) -scatter "e+ e- -> m+ m-" \ -target:module amplitude_qed_eemm > amplitude_qed_eemm.f90; \ $(FC) $(AM_FCFLAGS) $(FCFLAGS) -I$(pkgincludedir) \ -L$(DESTDIR)$(libdir) -L$(DESTDIR)$(pkglibdir) \ $(srcdir)/parameters_QED.f90 amplitude_qed_eemm.f90 \ $(srcdir)/test_qed_eemm.f90 -lomega_core; \ ./a.out ######################################################################## ### Remove DWARF debug information on MAC OS X clean-macosx: -rm -rf a.out.dSYM -rm -rf compare_amplitude_UFO.dSYM -rm -rf compare_amplitude_VM.dSYM -rm -rf compare_split_function.dSYM -rm -rf compare_split_module.dSYM -rm -rf ects.dSYM -rm -rf test_omega95.dSYM -rm -rf test_omega95_bispinors.dSYM -rm -rf test_qed_eemm.dSYM -rm -rf ward.dSYM .PHONY: clean-macosx clean-local: clean-macosx rm -f a.out gmon.out *.$(FC_MODULE_EXT) \ *.o *.cmi *.cmo *.cmx amplitude_*.f90 \ $(EXTRA_PROGRAMS) ects.f90 ward.f90 ward_UFO.f90 \ fermi.f90 fermi_UFO.f90 compare_*.f90 \ parameters_SM_UFO.f90 keystones_omegalib.f90 keystones_UFO.f90 \ + keystones_UFO_bispinors.f90 keystones_omegalib_bispinors.f90 \ omega_testtools.f90 test_omega95*.f90 benchmark*.f90 \ *.hbc *wrappers.f90 cascade phase_space \ output.rcl recola.log rm -fr output_cll if FC_SUBMODULES -rm -f *.smod endif ######################################################################## ## The End. ######################################################################## Index: trunk/omega/tests/keystones_UFO_generate.ml =================================================================== --- trunk/omega/tests/keystones_UFO_generate.ml (revision 8359) +++ trunk/omega/tests/keystones_UFO_generate.ml (revision 8360) @@ -1,339 +1,357 @@ (* keystones_UFO_generate.ml -- Copyright (C) 2019-2019 by Wolfgang Kilian Thorsten Ohl Juergen Reuter WHIZARD is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2, or (at your option) any later version. WHIZARD is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) open Coupling open Keystones -open Format_Fortran - -type ufo_vertex = - { ufo_tag : string; - spins : lorentz array; - tensor : UFOx.Lorentz.t } - -module P = Permutation.Default - -let permute_spins p s = P.array p s - -(* We must permute only the free indices, of course. - Note that we apply the \emph{inverse} permutation to - the indices in order to match the permutation of the - particles/spins. *) -let permute_structure n p l = - let permuted = P.array (P.inverse p) (Array.init n succ) in - let permute_index i = - if i > 0 then - permuted.(pred i) - else - i in - UFOx.Lorentz.map_indices permute_index l - -let permute_vertex n v p = - { ufo_tag = v.ufo_tag ^ "_p" ^ P.to_string p; - spins = permute_spins p v.spins; - tensor = permute_structure n p v.tensor } - -let vertex_permutations v = - let n = Array.length v.spins in - List.map (permute_vertex n v) (P.cyclic n) - -let keystones_of_ufo_vertex { ufo_tag; spins } = - { tag = ufo_tag; - keystones = - let fields = Array.mapi (fun i s -> (s, i)) spins in - let n = Array.length fields in - List.map - (fun p -> - let permuted = P.array p fields in - match Array.to_list permuted with - | [] -> invalid_arg "keystones_of_ufo_vertex" - | ket :: args -> - { ket = ket; - name = ufo_tag ^ "_p" ^ P.to_string p; - args = - G (0) :: - (ThoList.flatmap (fun (s, i) -> [ F (s, i); P (i) ]) args) }) - (P.cyclic n) } - -let merge (ufo_list, omegalib) = - match ufo_list with - | [] -> omegalib - | ufo1 :: _ -> - { tag = ufo1.ufo_tag; - keystones = - (ThoList.flatmap - (fun ufo -> (keystones_of_ufo_vertex ufo).keystones) - ufo_list) - @ omegalib.keystones } - -let fusions ff module_name vertices = - let printf fmt = fprintf ff fmt - and nl () = pp_newline ff () in - printf "module %s" module_name; nl (); - printf " use kinds"; nl (); - printf " use omega95"; nl (); - printf " implicit none"; nl (); - printf " ! private"; nl (); - UFO_targets.Fortran.eps4_g4_g44_decl std_formatter (); - UFO_targets.Fortran.eps4_g4_g44_init std_formatter (); - printf "contains"; nl (); - List.iter - (fun v -> - List.iter - (fun v' -> - let tensor = UFO_Lorentz.parse (Array.to_list v'.spins) v'.tensor in - printf " ! %s" (String.make 68 '='); nl (); - printf " ! %s" (UFO_Lorentz.to_string tensor); nl (); - UFO_targets.Fortran.lorentz - std_formatter v'.ufo_tag v'.spins tensor) - (vertex_permutations v)) - vertices; - printf "end module %s" module_name; nl () - -let generate ?reps ?threshold module_name vertices = - fusions std_formatter module_name (ThoList.flatmap fst vertices); - Keystones.generate - ?reps ?threshold ~modules:[module_name] - (List.map merge vertices) - -let equivalent_tensors spins alternatives = - List.map - (fun (ufo_tag, tensor) -> - { ufo_tag; spins; tensor = UFOx.Lorentz.of_string tensor }) - alternatives let qed = equivalent_tensors [| ConjSpinor; Vector; Spinor |] [ ("qed", "Gamma(2,1,3)") ] let axial = equivalent_tensors [| ConjSpinor; Vector; Spinor |] [ ("axial1", "Gamma5(1,-1)*Gamma(2,-1,3)"); ("axial2", "-Gamma(2,1,-3)*Gamma5(-3,3)") ] let left = equivalent_tensors [| ConjSpinor; Vector; Spinor |] [ ("left1", "(Identity(1,-1)+Gamma5(1,-1))*Gamma(2,-1,3)"); ("left2", "2*ProjP(1,-1)*Gamma(2,-1,3)"); ("left3", "Gamma(2,1,-3)*(Identity(-3,3)-Gamma5(-3,3))"); ("left4", "2*Gamma(2,1,-3)*ProjM(-3,3)") ] let right = equivalent_tensors [| ConjSpinor; Vector; Spinor |] [ ("right1", "(Identity(1,-1)-Gamma5(1,-1))*Gamma(2,-1,3)"); ("right2", "2*ProjM(1,-1)*Gamma(2,-1,3)"); ("right3", "Gamma(2,1,-3)*(Identity(-3,3)+Gamma5(-3,3))"); ("right4", "2*Gamma(2,1,-3)*ProjP(-3,3)") ] let vector_spinor_current tag = { tag = Printf.sprintf "vector_spinor_current__%s_ff" tag; keystones = - [ { ket = (ConjSpinor, 0); + [ { bra = (ConjSpinor, 0); name = Printf.sprintf "f_%sf" tag; args = [G (0); F (Vector, 1); F (Spinor, 2)] }; - { ket = (Vector, 1); + { bra = (Vector, 1); name = Printf.sprintf "%s_ff" tag; args = [G (0); F (ConjSpinor, 0); F (Spinor, 2)] }; - { ket = (Spinor, 2); + { bra = (Spinor, 2); name = Printf.sprintf "f_f%s" tag; args = [G (0); F (ConjSpinor, 0); F (Vector, 1)] } ] } +let scalar = + equivalent_tensors + [| ConjSpinor; Scalar; Spinor |] + [ ("scalar_current", "Identity(1,3)") ] + +let pseudo = + equivalent_tensors + [| ConjSpinor; Scalar; Spinor |] + [ ("pseudo_current", "Gamma5(1,3)") ] + +let left_scalar = + equivalent_tensors + [| ConjSpinor; Scalar; Spinor |] + [ ("left_scalar1", "Identity(1,3)-Gamma5(1,3)"); + ("left_scalar2", "2*ProjM(1,3)") ] + +let right_scalar = + equivalent_tensors + [| ConjSpinor; Scalar; Spinor |] + [ ("right_scalar1", "Identity(1,3)+Gamma5(1,3)"); + ("right_scalar2", "2*ProjP(1,3)") ] + +let scalar_spinor_current tag = + { tag = Printf.sprintf "scalar_spinor_current__%s_ff" tag; + keystones = + [ { bra = (ConjSpinor, 0); + name = Printf.sprintf "f_%sf" tag; + args = [G (0); F (Scalar, 1); F (Spinor, 2)] }; + { bra = (Scalar, 1); + name = Printf.sprintf "%s_ff" tag; + args = [G (0); F (ConjSpinor, 0); F (Spinor, 2)] }; + { bra = (Spinor, 2); + name = Printf.sprintf "f_f%s" tag; + args = [G (0); F (ConjSpinor, 0); F (Scalar, 1)] } ] } + let fermi_ss = equivalent_tensors [| ConjSpinor; Spinor; ConjSpinor; Spinor |] [ ("fermi_ss", "Identity(1,2)*Identity(3,4)"); ("fermi_ss_f", " (1/4) * Identity(1,4)*Identity(3,2)" ^ " + (1/4) * Gamma(-1,1,4)*Gamma(-1,3,2)" ^ " + (1/8) * Sigma(-1,-2,1,4)*Sigma(-1,-2,3,2)" ^ " - (1/4) * Gamma(-1,1,-4)*Gamma5(-4,4)*Gamma(-1,3,-2)*Gamma5(-2,2)" ^ " + (1/4) * Gamma5(1,4)*Gamma5(3,2)") ] let fermi_vv = equivalent_tensors [| ConjSpinor; Spinor; ConjSpinor; Spinor |] [ ("fermi_vv", "Gamma(-1,1,2)*Gamma(-1,3,4)"); ("fermi_vv_f", " Identity(1,4)*Identity(3,2)" ^ " - (1/2) * Gamma(-1,1,4)*Gamma(-1,3,2)" ^ " - (1/2) * Gamma(-1,1,-4)*Gamma5(-4,4)*Gamma(-1,3,-2)*Gamma5(-2,2)" ^ " - Gamma5(1,4)*Gamma5(3,2)") ] let fermi_tt = equivalent_tensors [| ConjSpinor; Spinor; ConjSpinor; Spinor |] [ ("fermi_tt1", " Sigma(-1,-2,1,2)*Sigma(-1,-2,3,4)"); ("fermi_tt2", " - Sigma(-1,-2,1,2)*Sigma(-2,-1,3,4)"); ("fermi_tt3", " - Sigma(-2,-1,1,2)*Sigma(-1,-2,3,4)"); ("fermi_tt_f", " 3 * Identity(1,4)*Identity(3,2)" ^ " - (1/2) * Sigma(-1,-2,1,4)*Sigma(-1,-2,3,2)" ^ " + 3 * Gamma5(1,4)*Gamma5(3,2)") ] let fermi_aa = equivalent_tensors [| ConjSpinor; Spinor; ConjSpinor; Spinor |] [ ("fermi_aa", "Gamma5(1,-2)*Gamma(-1,-2,2)*Gamma5(3,-3)*Gamma(-1,-3,4)"); ("fermi_aa_f", " - Identity(1,4)*Identity(3,2)" ^ " - (1/2) * Gamma(-1,1,4)*Gamma(-1,3,2)" ^ " - (1/2) * Gamma(-1,1,-4)*Gamma5(-4,4)*Gamma(-1,3,-2)*Gamma5(-2,2)" ^ " + Gamma5(1,4)*Gamma5(3,2)") ] let fermi_pp = equivalent_tensors [| ConjSpinor; Spinor; ConjSpinor; Spinor |] [ ("fermi_pp", "Gamma5(1,2)*Gamma5(3,4)"); ("fermi_pp_f", " (1/4) * Identity(1,4)*Identity(3,2)" ^ " - (1/4) * Gamma(-1,1,4)*Gamma(-1,3,2)" ^ " + (1/8) * Sigma(-1,-2,1,4)*Sigma(-1,-2,3,2)" ^ " + (1/4) * Gamma(-1,1,-4)*Gamma5(-4,4)*Gamma(-1,3,-2)*Gamma5(-2,2)" ^ " + (1/4) * Gamma5(1,4)*Gamma5(3,2)") ] let fermi_ll = equivalent_tensors [| ConjSpinor; Spinor; ConjSpinor; Spinor |] [ ("fermi_ll", " Gamma(-1,1,-2)*ProjM(-2,2)*Gamma(-1,3,-4)*ProjM(-4,4)"); ("fermi_ll_f", " - Gamma(-1,1,-2)*ProjM(-2,4)*Gamma(-1,3,-4)*ProjM(-4,2)") ] let fermi_va = equivalent_tensors [| ConjSpinor; Spinor; ConjSpinor; Spinor |] [ ("fermi_va", "Gamma(-1,1,2)*Gamma5(3,-3)*Gamma(-1,-3,4)") ] let fermi_av = equivalent_tensors [| ConjSpinor; Spinor; ConjSpinor; Spinor |] [ ("fermi_av", "Gamma5(1,-2)*Gamma(-1,-2,2)*Gamma(-1,3,4)") ] let sqed = equivalent_tensors [| Scalar; Vector; Scalar |] [ ("sqed1", "P(2,3)-P(2,1)"); ("sqed2", "2*P(2,3)+P(2,2)"); ("sqed3", "-P(2,2)-2*P(2,1)") ] let vector_scalar_current = { tag = "vector_scalar_current__v_ss"; keystones = - [ { ket = (Vector, 1); + [ { bra = (Vector, 1); name = "v_ss"; args = [G (0); F (Scalar, 2); P (2); F (Scalar, 0); P (0)] }; - { ket = (Scalar, 0); + { bra = (Scalar, 0); name = "s_vs"; args = [G (0); F (Vector, 1); P (1); F (Scalar, 2); P (2)] } ] } let svv_t = equivalent_tensors [| Scalar; Vector; Vector |] [ ("svv_t", "P(-1,2)*P(-1,3)*Metric(2,3)-P(2,3)*P(3,2)") ] let scalar_vector_current tag = { tag = Printf.sprintf "transversal_vector_current__s_vv_%s" tag; - keystones = [ { ket = (Scalar, 0); + keystones = [ { bra = (Scalar, 0); name = Printf.sprintf "s_vv_%s" tag; args = [G (0); F (Vector, 1); P (1); F (Vector, 2); P (2)] }; - { ket = (Vector, 1); + { bra = (Vector, 1); name = Printf.sprintf "v_sv_%s" tag; args = [G (0); F (Scalar, 0); P (0); F (Vector, 2); P (2)] } ] } let gauge = equivalent_tensors [| Vector; Vector; Vector |] [ ("gauge", " Metric(1,2)*P(3,1) - Metric(1,2)*P(3,2) \ + Metric(3,1)*P(2,3) - Metric(3,1)*P(2,1) \ + Metric(2,3)*P(1,2) - Metric(2,3)*P(1,3)") ] let gauge_omega = { tag = "g_gg"; keystones = - [ { ket = (Vector, 0); + [ { bra = (Vector, 0); name = "(0,1)*g_gg"; args = [G (0); F (Vector, 1); P (1); F (Vector, 2); P (2)] } ] } (* Note that $C^{-1}=-C$ for the charge conjugation matrix.*) let charge_conjugate_s = equivalent_tensors [| Scalar; ConjSpinor; Spinor |] [ ("gamma1", "Identity(2,3)"); ("gamma1_cc", "C(3,-3)*Identity(-3,-2)*(-C(-2,2))"); ("gamma1_cx", "C(3,-1)*(-C(-1,2))") ] (* $C \gamma_5 C^{-1} = \gamma_5^T$ *) let charge_conjugate_p = equivalent_tensors [| Scalar; ConjSpinor; Spinor |] [ ("gamma5", "Gamma5(2,3)"); ("gamma5_cc", "C(3,-3)*Gamma5(-3,-2)*(-C(-2,2))") ] (* $C \gamma_\mu C^{-1} = - \gamma_\mu^T$ *) let charge_conjugate_v = equivalent_tensors [| Vector; ConjSpinor; Spinor |] [ ("gamma_mu", "Gamma(1,2,3)"); ("gamma_mu_cc", "-C(3,-3)*Gamma(1,-3,-2)*(-C(-2,2))") ] (* $C \gamma_5\gamma_\mu C^{-1} = (\gamma_5\gamma_\mu)^T$ *) let charge_conjugate_a = equivalent_tensors [| Vector; ConjSpinor; Spinor |] [ ("gamma_5mu", "Gamma5(2,-2)*Gamma(1,-2,3)"); ("gamma_5mu_cc", "C(3,-3)*Gamma5(-3,-1)*Gamma(1,-1,-2)*(-C(-2,2))") ] (* $C \sigma_{\mu\nu} C^{-1} = - \sigma_{\mu\nu}^T$ *) let charge_conjugate_t = equivalent_tensors [| Vector; Vector; ConjSpinor; Spinor |] [ ("sigma_munu", "Sigma(1,2,3,4)"); ("sigma_munu_cc", "-C(4,-4)*Sigma(1,2,-4,-3)*(-C(-3,3))") ] let empty = { tag = "empty"; keystones = [ ] } let vertices = [ (qed, vector_spinor_current "v"); (axial, vector_spinor_current "a"); (left, vector_spinor_current "vl"); (right, vector_spinor_current "vr"); + (scalar, scalar_spinor_current "s"); + (pseudo, scalar_spinor_current "p"); + (left_scalar, scalar_spinor_current "sl"); + (right_scalar, scalar_spinor_current "sr"); (sqed, vector_scalar_current); (fermi_ss, empty); (fermi_vv, empty); (fermi_tt, empty); (fermi_aa, empty); (fermi_pp, empty); (fermi_ll, empty); (fermi_va, empty); (fermi_av, empty); (svv_t, scalar_vector_current "t"); (gauge, gauge_omega); (charge_conjugate_s, empty); (charge_conjugate_p, empty); (charge_conjugate_v, empty); (charge_conjugate_a, empty); (charge_conjugate_t, empty) ] +let parse_propagator (p_tag, p_omega, p_spins, numerator, denominator) = + let p = + UFO.Propagator.of_propagator_UFO + { UFO.Propagator_UFO.name = p_tag; + UFO.Propagator_UFO.numerator = UFOx.Lorentz.of_string numerator; + UFO.Propagator_UFO.denominator = UFOx.Lorentz.of_string denominator } in + { p_tag; p_omega; p_spins; + p_propagator = p } + +let default_denominator = + "P('mu', id) * P('mu', id) - Mass(id) * Mass(id) \ + + complex(0,1) * Mass(id) * Width(id)" + +let scalar_propagator = + ( "scalar", "pr_phi", (Scalar, Scalar), + "1", + default_denominator ) + +let spinor_propagator = + ( "spinor", "pr_psi", (ConjSpinor, Spinor), + "Gamma('mu', 1, 2) * P('mu', id) + Mass(id) * Identity(1, 2)", + default_denominator ) + +let conjspinor_propagator = + ( "conjspinor", "pr_psibar", (ConjSpinor, Spinor), + "Gamma('mu', 1, 2) * P('mu', id) + Mass(id) * Identity(1, 2)", + default_denominator ) + +let feynman_propagator = + ( "feynman", "pr_feynman", (Vector, Vector), + " - Metric(1, 2)", + "P('mu', id) * P('mu', id)" ) + +let unitarity_propagator = + ( "unitarity", "pr_unitarity", (Massive_Vector, Massive_Vector), + "- Metric(1, 2) + Metric(1,'mu')*P('mu', id)*P(2, id)/Mass(id)**2", + default_denominator ) + +let tensor_propagator = + ( "tensor", "pr_tensor", (Tensor_2, Tensor_2), + " 1/2 * (Metric(1001,1002) - P(1001,id)*P(1002,id)/Mass(id)**2) \ + * (Metric(2001,2002) - P(2001,id)*P(2002,id)/Mass(id)**2) \ + + 1/2 * (Metric(1001,2002) - P(1001,id)*P(2002,id)/Mass(id)**2) \ + * (Metric(2001,1002) - P(2001,id)*P(1002,id)/Mass(id)**2) \ + - 1/3 * (Metric(1001,2001) - P(1001,id)*P(2001,id)/Mass(id)**2) \ + * (Metric(1002,2002) - P(1002,id)*P(2002,id)/Mass(id)**2) ", + default_denominator ) + +let tensor_propagator_51_52 = + ( "tensor_51_52", "pr_tensor", (Tensor_2, Tensor_2), + " 1/2 * (Metric( 1, 2) - P( 1,id)*P( 2,id)/Mass(id)**2) \ + * (Metric(51,52) - P(51,id)*P(52,id)/Mass(id)**2) \ + + 1/2 * (Metric( 1,52) - P( 1,id)*P(52,id)/Mass(id)**2) \ + * (Metric(51, 2) - P(51,id)*P( 2,id)/Mass(id)**2) \ + - 1/3 * (Metric( 1,51) - P( 1,id)*P(51,id)/Mass(id)**2) \ + * (Metric( 2,52) - P( 2,id)*P(52,id)/Mass(id)**2) ", + default_denominator ) + +let propagators = + List.map + parse_propagator + [ scalar_propagator; + spinor_propagator; + feynman_propagator; + unitarity_propagator; + tensor_propagator; + tensor_propagator_51_52 ] + +let conjugate_propagators = + List.map + (fun p -> transpose (parse_propagator p)) + [ conjspinor_propagator ] + +let all_propagators = propagators @ conjugate_propagators + let _ = - generate ~reps:10000 ~threshold:0.70 "fusions" vertices; + generate_ufo + ~reps:10000 ~threshold:0.70 "fusions" vertices all_propagators; exit 0 Index: trunk/ChangeLog =================================================================== --- trunk/ChangeLog (revision 8359) +++ trunk/ChangeLog (revision 8360) @@ -1,1967 +1,1971 @@ ChangeLog -- Summary of changes to the WHIZARD package Use svn log to see detailed changes. Version 2.8.3 2020-01-09 RELEASE: version 2.8.3 +2019-12-19 + Support for UFO customized propagators + O'Mega unit tests for fermion-number violating interactions + 2019-12-10 For distribution building: check for graphviz/dot version 2.40 or newer 2019-11-21 Bug fix: alternate setups now work correctly Infrastructure for accessing alpha_QED event-by-event Guard against tiny numbers that break ASCII event output Enable inverse hyperbolic functions as SINDARIN observables Remove old compiler bug workarounds 2019-11-20 Allow quoted -e argument, implemented -f option 2019-11-19 Bug fix: resonance histories now work also with UFO models Fix in numerical precision of ASCII VAMP2 grids 2019-11-06 Add squared matrix elements to the LCIO event header 2019-11-05 Do not include RNG state in MD5 sum for CIRCE1/2 2019-11-04 Full CIRCE2 ILC 250 and 500 GeV beam spectra added Minor update on LCIO event header information 2019-10-30 NLO QCD for final states completed When using Openloops, v2.1.1+ mandatory 2019-10-25 Binary grid files for VAMP2 integrator ################################################################## 2019-10-24 RELEASE: version 2.8.2 2019-10-20 Bug fix for HepMC linker flags 2019-10-19 Support for spin-2 particles from UFO files 2019-09-27 LCIO event format allows rescan and alternate weights 2019-09-24 Compatibility fix for OCaml v4.08.0+ ################################################################## 2019-09-21 RELEASE: version 2.8.1 2019-09-19 Carriage return characters in UFO models can be parsed Mathematica symbols in UFO models possible Unused/undefined parameters in UFO models handled 2019-09-13 New extended NLO test suite for ee and pp processes 2019-09-09 Photon isolation (separation of perturbative and fragmentation part a la Frixione) 2019-09-05 Major progress on NLO QCD for hadron collisions: - correctly assign flavor structures for alpha regions - fix crossing of particles for initial state splittings - correct assignment for PDF factors for real subtractions - fix kinematics for collinear splittings - bug fix for integrated virtual subtraction terms 2019-09-03 b and c jet selection in cuts and analysis 2019-08-27 Support for Intel MPI 2019-08-20 Complete (preliminary) HepMC3 support (incl. backwards HepMC2 write/read mode) 2019-08-08 Bug fix: handle carriage returns in UFO files (non-Unix OS) ################################################################## 2019-08-07 RELEASE: version 2.8.0 2019-07-31 Complete WHIZARD UFO interface: - general Lorentz structures - matrix element support for general color factors - missing features: Majorana fermions and SLHA 2019-07-20 Make WHIZARD compatible with OCaml 4.08.0+ 2019-07-19 Fix version testing for LHAPDF 6.2.3 and newer Minimal required OCaml version is now 4.02.3. 2019-04-18 Correctly generate ordered FKS tuples for alpha regions from all possible underlying Born processes 2019-04-08 Extended O'Mega/Recola matrix element test suite 2019-03-29 Correct identical particle symmetry factors for FKS subtraction 2019-03-28 Correct assertion of spin-correlated matrix elements for hadron collisions 2019-03-27 Bug fix for cut-off parameter delta_i for collinear plus/minus regions ################################################################## 2019-03-27 RELEASE: version 2.7.1 2019-02-19 Further infrastructure for HepMC3 interface (v3.01.00) 2019-02-07 Explicit configure option for using debugging options Bug fix for performance by removing unnecessary debug operations 2019-01-29 Bug fix for DGLAP remnants with cut-off parameter delta_i 2019-01-24 Radiative decay neu2 -> neu1 A added to MSSM_Hgg model ################################################################## 2019-01-21 RELEASE: version 2.7.0 2018-12-18 Support RECOLA for integrated und unintegrated subtractions 2018-12-11 FCNC top-up sector in model SM_top_anom 2018-12-05 Use libtirpc instead of SunRPC on Arch Linux etc. 2018-11-30 Display rescaling factor for weighted event samples with cuts 2018-11-29 Reintroduce check against different masses in flavor sums Bug fix for wrong couplings in the Littlest Higgs model(s) 2018-11-22 Bug fix for rescanning events with beam structure 2018-11-09 Major refactoring of internal process data 2018-11-02 PYTHIA8 interface 2018-10-29 Flat phase space parametrization with RAMBO (on diet) implemented 2018-10-17 Revise extended test suite 2018-09-27 Process container for RECOLA processes 2018-09-15 Fixes by M. Berggren for PYTHIA6 interface 2018-09-14 First fixes after HepForge modernization ################################################################## 2018-08-23 RELEASE: version 2.6.4 2018-08-09 Infrastructure to check colored subevents 2018-07-10 Infrastructure for running WHIZARD in batch mode 2018-07-04 MPI available from distribution tarball 2018-06-03 Support Intel Fortran Compiler under MAC OS X 2018-05-07 FKS slicing parameter delta_i (initial state) implementend 2018-05-03 Refactor structure function assignment for NLO 2018-05-02 FKS slicing parameter xi_cut, delta_0 implemented 2018-04-20 Workspace subdirectory for process integration (grid/phs files) Packing/unpacking of files at job end/start Exporting integration results from scan loops 2018-04-13 Extended QCD NLO test suite 2018-04-09 Bug fix for Higgs Singlet Extension model 2018-04-06 Workspace subdirectory for process generation and compilation --job-id option for creating job-specific names 2018-03-20 Bug fix for color flow matching in hadron collisions with identical initial state quarks 2018-03-08 Structure functions quantum numbers correctly assigned for NLO 2018-02-24 Configure setup includes 'pgfortran' and 'flang' 2018-02-21 Include spin-correlated matrix elements in interactions 2018-02-15 Separate module for QED ISR structure functions ################################################################## 2018-02-10 RELEASE: version 2.6.3 2018-02-08 Improvements in memory management for PS generation 2018-01-31 Partial refactoring: quantum number assigment NLO Initial-state QCD splittings for hadron collisions 2018-01-25 Bug fix for weighted events with VAMP2 2018-01-17 Generalized interface for Recola versions 1.3+ and 2.1+ 2018-01-15 Channel equivalences also for VAMP2 integrator 2018-01-12 Fix for OCaml compiler 4.06 (and newer) 2017-12-19 RECOLA matrix elements with flavor sums can be integrated 2017-12-18 Bug fix for segmentation fault in empty resonance histories 2017-12-16 Fixing a bug in PYTHIA6 PYHEPC routine by omitting CMShowers from transferral between PYTHIA and WHIZARD event records 2017-12-15 Event index for multiple processes in event file correct ################################################################## 2017-12-13 RELEASE: version 2.6.2 2017-12-07 User can set offset in event numbers 2017-11-29 Possibility to have more than one RECOLA process in one file 2017-11-23 Transversal/mixed (and unitarized) dim-8 operators 2017-11-16 epa_q_max replaces epa_e_max (trivial factor 2) 2017-11-15 O'Mega matrix element compilation silent now 2017-11-14 Complete expanded P-wave form factor for top threshold 2017-11-10 Incoming particles can be accessed in SINDARIN 2017-11-08 Improved handling of resonance insertion, additional parameters 2017-11-04 Added Higgs-electron coupling (SM_Higgs) ################################################################## 2017-11-03 RELEASE: version 2.6.1 2017-10-20 More than 5 NLO components possible at same time 2017-10-19 Gaussian cutoff for shower resonance matching 2017-10-12 Alternative (more efficient) method to generate phase space file 2017-10-11 Bug fix for shower resonance histories for processes with multiple components 2017-09-25 Bugfix for process libraries in shower resonance histories 2017-09-21 Correctly generate pT distribution for EPA remnants 2017-09-20 Set branching ratios for unstable particles also by hand 2017-09-14 Correctly generate pT distribution for ISR photons ################################################################## 2017-09-08 RELEASE: version 2.6.0 2017-09-05 Bug fix for initial state NLO QCD flavor structures Real and virtual NLO QCD hadron collider processes work with internal interactions 2017-09-04 Fully validated MPI integration and event generation 2017-09-01 Resonance histories for shower: full support Bug fix in O'Mega model constraints O'Mega allows to output a parsable form of the DAG 2017-08-24 Resonance histories in events for transferral to parton shower (e.g. in ee -> jjjj) 2017-08-01 Alpha version of HepMC v3 interface (not yet really functional) 2017-07-31 Beta version for RECOLA OLP support 2017-07-06 Radiation generator fix for LHC processes 2017-06-30 Fix bug for NLO with structure functions and/or polarization 2017-06-23 Collinear limit for QED corrections works 2017-06-17 POWHEG grids generated already during integration 2017-06-12 Soft limit for QED corrections works 2017-05-16 Beta version of full MPI parallelization (VAMP2) Check consistency of POWHEG grid files Logfile config-summary.log for configure summary 2017-05-12 Allow polarization in top threshold 2017-05-09 Minimal demand automake 1.12.2 Silent rules for make procedures 2017-05-07 Major fix for POWHEG damping Correctly initialize FKS ISR phasespace ################################################################## 2017-05-06 RELEASE: version 2.5.0 2017-05-05 Full UFO support (SM-like models) Fixed-beam ISR FKS phase space 2017-04-26 QED splittings in radiation generator 2017-04-10 Retire deprecated O'Mega vertex cache files ################################################################## 2017-03-24 RELEASE: version 2.4.1 2017-03-16 Distinguish resonance charge in phase space channels Keep track of resonance histories in phase space Complex mass scheme default for OpenLoops amplitudes 2017-03-13 Fix helicities for polarized OpenLoops calculations 2017-03-09 Possibility to advance RNG state in rng_stream 2017-03-04 General setup for partitioning real emission phase space 2017-03-06 Bugfix on rescan command for converting event files 2017-02-27 Alternative multi-channel VEGAS implementation VAMP2: serial backbone for MPI setup Smoothstep top threshold matching 2017-02-25 Single-beam structure function with s-channel mapping supported Safeguard against invalid process libraries 2017-02-16 Radiation generator for photon emission 2017-02-10 Fixes for NLO QCD processes (color correlations) 2017-01-16 LCIO variable takes precedence over LCIO_DIR 2017-01-13 Alternative random number generator rng_stream (cf. L'Ecuyer et al.) 2017-01-01 Fix for multi-flavor BLHA tree matrix elements 2016-12-31 Grid path option for VAMP grids 2016-12-28 Alpha version of Recola OLP support 2016-12-27 Dalitz plots for FKS phase space 2016-12-14 NLO multi-flavor events possible 2016-12-09 LCIO event header information added 2016-12-02 Alpha version of RECOLA interface Bugfix for generator status in LCIO ################################################################## 2016-11-28 RELEASE: version 2.4.0 2016-11-24 Bugfix for OpenLoops interface: EW scheme is set by WHIZARD Bugfixes for top threshold implementation 2016-11-11 Refactoring of dispatching 2016-10-18 Bug fix for LCIO output 2016-10-10 First implementation for collinear soft terms 2016-10-06 First full WHIZARD models from UFO files 2016-10-05 WHIZARD does not support legacy gcc 4.7.4 any longer 2016-09-30 Major refactoring of process core and NLO components 2016-09-23 WHIZARD homogeneous entity: discarding subconfigures for CIRCE1/2, O'Mega, VAMP subpackages; these are reconstructable by script projectors 2016-09-06 Introduce main configure summary 2016-08-26 Fix memory leak in event generation ################################################################## 2016-08-25 RELEASE: version 2.3.1 2016-08-19 Bug fix for EW-scheme dependence of gluino propagators 2016-08-01 Beta version of complex mass scheme support 2016-07-26 Fix bug in POWHEG damping for the matching ################################################################## 2016-07-21 RELEASE: version 2.3.0 2016-07-20 UFO file support (alpha version) in O'Mega 2016-07-13 New (more) stable of WHIZARD GUI Support for EW schemes for OpenLoops Factorized NLO top decays for threshold model 2016-06-15 Passing factorization scale to PYTHIA6 Adding charge and neutral observables 2016-06-14 Correcting angular distribution/tweaked kinematics in non-collinear structure functions splittings 2016-05-10 Include (Fortran) TAUOLA/PHOTOS for tau decays via PYTHIA6 (backwards validation of LC CDR/TDR samples) 2016-04-27 Within OpenLoops virtuals: support for Collier library 2016-04-25 O'Mega vertex tables only loaded at first usage 2016-04-21 New CJ15 PDF parameterizations added 2016-04-21 Support for hadron collisions at NLO QCD 2016-04-05 Support for different (parameter) schemes in model files 2016-03-31 Correct transferral of lifetime/vertex from PYTHIA/TAUOLA into the event record 2016-03-21 New internal implementation of polarization via Bloch vectors, remove pointer constructions 2016-03-13 Extension of cascade syntax for processes: exclude propagators/vertices etc. possible 2016-02-24 Full support for OpenLoops QCD NLO matrix elements, inclusion in test suite 2016-02-12 Substantial progress on QCD NLO support 2016-02-02 Automated resonance mapping for FKS subtraction 2015-12-17 New BSM model WZW for diphoton resonances ################################################################## 2015-11-22 RELEASE: version 2.2.8 2015-11-21 Bugfix for fixed-order NLO events 2015-11-20 Anomalous FCNC top-charm vertices 2015-11-19 StdHEP output via HEPEVT/HEPEV4 supported 2015-11-18 Full set of electroweak dim-6 operators included 2015-10-22 Polarized one-loop amplitudes supported 2015-10-21 Fixes for event formats for showered events 2015-10-14 Callback mechanism for event output 2015-09-22 Bypass matrix elements in pure event sample rescans StdHep frozen final version v5.06.01 included internally 2015-09-21 configure option --with-precision to demand 64bit, 80bit, or 128bit Fortran and bind C precision types 2015-09-07 More extensive tests of NLO infrastructure and POWHEG matching 2015-09-01 NLO decay infrastructure User-defined squared matrix elements Inclusive FastJet algorithm plugin Numerical improvement for small boosts ################################################################## 2015-08-11 RELEASE: version 2.2.7 2015-08-10 Infrastructure for damped POWHEG Massive emitters in POWHEG Born matrix elements via BLHA GoSam filters via SINDARIN Minor running coupling bug fixes Fixed-order NLO events 2015-08-06 CT14 PDFs included (LO, NLO, NNLL) 2015-07-07 Revalidation of ILC WHIZARD-PYTHIA event chain Extended test suite for showered events Alpha version of massive FSR for POWHEG 2015-06-09 Fix memory leak in interaction for long cascades Catch mismatch between beam definition and CIRCE2 spectrum 2015-06-08 Automated POWHEG matching: beta version Infrastructure for GKS matching Alpha version of fixed-order NLO events CIRCE2 polarization averaged spectra with explicitly polarized beams 2015-05-12 Abstract matching type: OO structure for matching/merging 2015-05-07 Bug fix in event record WHIZARD-PYTHIA6 transferral Gaussian beam spectra for lepton colliders ################################################################## 2015-05-02 RELEASE: version 2.2.6 2015-05-01 Models for (unitarized) tensor resonances in VBS 2015-04-28 Bug fix in channel weights for event generation. 2015-04-18 Improved event record transfer WHIZARD/PYTHIA6 2015-03-19 POWHEG matching: alpha version ################################################################## 2015-02-27 RELEASE: version 2.2.5 2015-02-26 Abstract types for quantum numbers 2015-02-25 Read-in of StdHEP events, self-tests 2015-02-22 Bugfix for mother-daughter relations in showered/hadronized events 2015-02-20 Projection on polarization in intermediate states 2015-02-13 Correct treatment of beam remnants in event formats (also LC remnants) ################################################################## 2015-02-06 RELEASE: version 2.2.4 2015-02-06 Bugfix in event output 2015-02-05 LCIO event format supported 2015-01-30 Including state matrices in WHIZARD's internal IO Versioning for WHIZARD's internal IO Libtool update from 2.4.3 to 2.4.5 LCIO event output (beta version) 2015-01-27 Progress on NLO integration Fixing a bug for multiple processes in a single event file when using beam event files 2015-01-19 Bug fix for spin correlations evaluated in the rest frame of the mother particle 2015-01-17 Regression fix for statically linked processes from SARAH and FeynRules 2015-01-10 NLO: massive FKS emitters supported (experimental) 2015-01-06 MMHT2014 PDF sets included 2015-01-05 Handling mass degeneracies in auto_decays 2014-12-19 Fixing bug in rescan of event files ################################################################## 2014-11-30 RELEASE: version 2.2.3 2014-11-29 Beta version of LO continuum/NLL-threshold matched top threshold model for e+e- physics 2014-11-28 More internal refactoring: disentanglement of module dependencies 2014-11-21 OVM: O'Mega Virtual Machine, bytecode instructions instead of compiled Fortran code 2014-11-01 Higgs Singlet extension model included 2014-10-18 Internal restructuring of code; half-way WHIZARD main code file disassembled 2014-07-09 Alpha version of NLO infrastructure ################################################################## 2014-07-06 RELEASE: version 2.2.2 2014-07-05 CIRCE2: correlated LC beam spectra and GuineaPig Interface to LC machine parameters 2014-07-01 Reading LHEF for decayed/factorized/showered/ hadronized events 2014-06-25 Configure support for GoSAM/Ninja/Form/QGraf 2014-06-22 LHAPDF6 interface 2014-06-18 Module for automatic generation of radiation and loop infrastructure code 2014-06-11 Improved internal directory structure ################################################################## 2014-06-03 RELEASE: version 2.2.1 2014-05-30 Extensions of internal PDG arrays 2014-05-26 FastJet interface 2014-05-24 CJ12 PDFs included 2014-05-20 Regression fix for external models (via SARAH or FeynRules) ################################################################## 2014-05-18 RELEASE: version 2.2.0 2014-04-11 Multiple components: inclusive process definitions, syntax: process A + B + ... 2014-03-13 Improved PS mappings for e+e- ISR ILC TDR and CLIC spectra included in CIRCE1 2014-02-23 New models: AltH w\ Higgs for exclusion purposes, SM_rx for Dim 6-/Dim-8 operators, SSC for general strong interactions (w/ Higgs), and NoH_rx (w\ Higgs) 2014-02-14 Improved s-channel mapping, new on-shell production mapping (e.g. Drell-Yan) 2014-02-03 PRE-RELEASE: version 2.2.0_beta 2014-01-26 O'Mega: Feynman diagram generation possible (again) 2013-12-16 HOPPET interface for b parton matching 2013-11-15 PRE-RELEASE: version 2.2.0_alpha-4 2013-10-27 LHEF standards 1.0/2.0/3.0 implemented 2013-10-15 PRE-RELEASE: version 2.2.0_alpha-3 2013-10-02 PRE-RELEASE: version 2.2.0_alpha-2 2013-09-25 PRE-RELEASE: version 2.2.0_alpha-1 2013-09-12 PRE-RELEASE: version 2.2.0_alpha 2013-09-03 General 2HDM implemented 2013-08-18 Rescanning/recalculating events 2013-06-07 Reconstruction of complete event from 4-momenta possible 2013-05-06 Process library stacks 2013-05-02 Process stacks 2013-04-29 Single-particle phase space module 2013-04-26 Abstract interface for random number generator 2013-04-24 More object-orientation on modules Midpoint-rule integrator 2013-04-05 Object-oriented integration and event generation 2013-03-12 Processes recasted object-oriented: MEs, scales, structure functions First infrastructure for general Lorentz structures 2013-01-17 Object-orientated reworking of library and process core, more variable internal structure, unit tests 2012-12-14 Update Pythia version to 6.4.27 2012-12-04 Fix the phase in HAZ vertices 2012-11-21 First O'Mega unit tests, some infrastructure 2012-11-13 Bugfix in anom. HVV Lorentz structures ################################################################## 2012-09-18 RELEASE: version 2.1.1 2012-09-11 Model MSSM_Hgg with Hgg and HAA vertices 2012-09-10 First version of implementation of multiple interactions in WHIZARD 2012-09-05 Infrastructure for internal CKKW matching 2012-09-02 C, C++, Python API 2012-07-19 Fixing particle numbering in HepMC format ################################################################## 2012-06-15 RELEASE: version 2.1.0 2012-06-14 Analytical and kT-ordered shower officially released PYTHIA interface officially released 2012-05-09 Intrisince PDFs can be used for showering 2012-05-04 Anomalous Higgs couplings a la hep-ph/9902321 ################################################################## 2012-03-19 RELEASE: version 2.0.7 2012-03-15 Run IDs are available now More event variables in analysis Modified raw event format (compatibility mode exists) 2012-03-12 Bugfix in decay-integration order MLM matching steered completely internally now 2012-03-09 Special phase space mapping for narrow resonances decaying to 4-particle final states with far off-shell intermediate states Running alphas from PDF collaborations with builtin PDFs 2012-02-16 Bug fix in cascades decay infrastructure 2012-02-04 WHIZARD documentation compatible with TeXLive 2011 2012-02-01 Bug fix in FeynRules interface with --prefix flag 2012-01-29 Bug fix with name clash of O'Mega variable names 2012-01-27 Update internal PYTHIA to version 6.4.26 Bug fix in LHEF output 2012-01-21 Catching stricter automake 1.11.2 rules 2011-12-23 Bug fix in decay cascade setup 2011-12-20 Bug fix in helicity selection rules 2011-12-16 Accuracy goal reimplemented 2011-12-14 WHIZARD compatible with TeXLive 2011 2011-12-09 Option --user-target added ################################################################## 2011-12-07 RELEASE: version 2.0.6 2011-12-07 Bug fixes in SM_top_anom Added missing entries to HepMC format 2011-12-06 Allow to pass options to O'Mega Bug fix for HEPEVT block for showered/hadronized events 2011-12-01 Reenabled user plug-in for external code for cuts, structure functions, routines etc. 2011-11-29 Changed model SM_Higgs for Higgs phenomenology 2011-11-25 Supporting a Y, (B-L) Z' model 2011-11-23 Make WHIZARD compatible for MAC OS X Lion/XCode 4 2011-09-25 WHIZARD paper published: Eur.Phys.J. C71 (2011) 1742 2011-08-16 Model SM_QCD: QCD with one EW insertion 2011-07-19 Explicit output channel for dvips avoids printing 2011-07-10 Test suite for WHIZARD unit tests 2011-07-01 Commands for matrix element tests More OpenMP parallelization of kinematics Added unit tests 2011-06-23 Conversion of CIRCE2 from F77 to F90, major clean-up 2011-06-14 Conversion of CIRCE1 from F77 to F90 2011-06-10 OpenMP parallelization of channel kinematics (by Matthias Trudewind) 2011-05-31 RELEASE: version 1.97 2011-05-24 Minor bug fixes: update grids and elsif statement. ################################################################## 2011-05-10 RELEASE: version 2.0.5 2011-05-09 Fixed bug in final state flavor sums Minor improvements on phase-space setup 2011-05-05 Minor bug fixes 2011-04-15 WHIZARD as a precompiled 64-bit binary available 2011-04-06 Wall clock instead of cpu time for time estimates 2011-04-05 Major improvement on the phase space setup 2011-04-02 OpenMP parallelization for helicity loop in O'Mega matrix elements 2011-03-31 Tools for relocating WHIZARD and use in batch environments 2011-03-29 Completely static builds possible, profiling options 2011-03-28 Visualization of integration history 2011-03-27 Fixed broken K-matrix implementation 2011-03-23 Including the GAMELAN manual in the distribution 2011-01-26 WHIZARD analysis can handle hadronized event files 2011-01-17 MSTW2008 and CT10 PDF sets included 2010-12-23 Inclusion of NMSSM with Hgg couplings 2010-12-21 Advanced options for integration passes 2010-11-16 WHIZARD supports CTEQ6 and possibly other PDFs directly; data files included in the distribution ################################################################## 2010-10-26 RELEASE: version 2.0.4 2010-10-06 Bug fix in MSSM implementation 2010-10-01 Update to libtool 2.4 2010-09-29 Support for anomalous top couplings (form factors etc.) Bug fix for running gauge Yukawa SUSY couplings 2010-09-28 RELEASE: version 1.96 2010-09-21 Beam remnants and pT spectra for lepton collider re-enabled Restructuring subevt class 2010-09-16 Shower and matching are disabled by default PYTHIA as a conditional on these two options 2010-09-14 Possibility to read in beam spectra re-enabled (e.g. Guinea Pig) 2010-09-13 Energy scan as (pseudo-) structure functions re-implemented 2010-09-10 CIRCE2 included again in WHIZARD 2 and validated 2010-09-02 Re-implementation of asymmetric beam energies and collision angles, e-p collisions work, inclusion of a HERA DIS test case ################################################################## 2010-10-18 RELEASE: version 2.0.3 2010-08-08 Bug in CP-violating anomalous triple TGCs fixed 2010-08-06 Solving backwards compatibility problem with O'Caml 3.12.0 2010-07-12 Conserved quantum numbers speed up O'Mega code generation 2010-07-07 Attaching full ISR/FSR parton shower and MPI/ISR module Added SM model containing Hgg, HAA, HAZ vertices 2010-07-02 Matching output available as LHEF and STDHEP 2010-06-30 Various bug fixes, missing files, typos 2010-06-26 CIRCE1 completely re-enabled Chaining structure functions supported 2010-06-25 Partial support for conserved quantum numbers in O'Mega 2010-06-21 Major upgrade of the graphics package: error bars, smarter SINDARIN steering, documentation, and all that... 2010-06-17 MLM matching with PYTHIA shower included 2010-06-16 Added full CIRCE1 and CIRCE2 versions including full documentation and miscellanea to the trunk 2010-06-12 User file management supported, improved variable and command structure 2010-05-24 Improved handling of variables in local command lists 2010-05-20 PYTHIA interface re-enabled 2010-05-19 ASCII file formats for interfacing ROOT and gnuplot in data analysis ################################################################## 2010-05-18 RELEASE: version 2.0.2 2010-05-14 Reimplementation of visualization of phase space channels Minor bug fixes 2010-05-12 Improved phase space - elimination of redundancies 2010-05-08 Interface for polarization completed: polarized beams etc. 2010-05-06 Full quantum numbers appear in process log Integration results are usable as user variables Communication with external programs 2010-05-05 Split module commands into commands, integration, simulation modules 2010-05-04 FSR+ISR for the first time connected to the WHIZARD 2 core ################################################################## 2010-04-25 RELEASE: version 2.0.1 2010-04-23 Automatic compile and integrate if simulate is called Minor bug fixes in O'Mega 2010-04-21 Checkpointing for event generation Flush statements to use WHIZARD inside a pipe 2010-04-20 Reimplementation of signal handling in WGIZARD 2.0 2010-04-19 VAMP is now a separately configurable and installable unit of WHIZARD, included VAMP self-checks Support again compilation in quadruple precision 2010-04-06 Allow for logarithmic plots in GAMELAN, reimplement the possibility to set the number of bins 2010-04-15 Improvement on time estimates for event generation ################################################################## 2010-04-12 RELEASE: version 2.0.0 2010-04-09 Per default, the code for the amplitudes is subdivided to allow faster compiler optimization More advanced and unified and straightforward command language syntax Final bug fixes 2010-04-07 Improvement on SINDARIN syntax; printf, sprintf function thorugh a C interface 2010-04-05 Colorizing DAGs instead of model vertices: speed boost in colored code generation 2010-03-31 Generalized options for normalization of weighted and unweighted events Grid and weight histories added again to log files Weights can be used in analyses 2010-03-28 Cascade decays completely implemented including color and spin correlations 2010-03-07 Added new WHIZARD header with logo 2010-03-05 Removed conflict in O'Mega amplitudes between flavour sums and cascades StdHEP interface re-implemented 2010-03-03 RELEASE: version 2.0.0rc3 Several bug fixes for preventing abuse in input files OpenMP support for amplitudes Reimplementation of WHIZARD 1 HEPEVT ASCII event formats FeynRules interface successfully passed MSSM test 2010-02-26 Eliminating ghost gluons from multi-gluon amplitudes 2010-02-25 RELEASE: version 1.95 HEPEVT format from WHIZARD 1 re-implemented in WHIZARD 2 2010-02-23 Running alpha_s implemented in the FeynRules interface 2010-02-19 MSSM (semi-) automatized self-tests finalized 2010-02-17 RELEASE: version 1.94 2010-02-16 Closed memory corruption in WHIZARD 1 Fixed problems of old MadGraph and CompHep drivers with modern compilers Uncolored vertex selection rules for colored amplitudes in O'Mega 2010-02-15 Infrastructure for color correlation computation in O'Mega finished Forbidden processes are warned about, but treated as non-fatal 2010-02-14 Color correlation computation in O'Mega finalized 2010-02-10 Improving phase space mappings for identical particles in initial and final states Introduction of more extended multi-line error message 2010-02-08 First O'Caml code for computation of color correlations in O'Mega 2010-02-07 First MLM matching with e+ e- -> jets ################################################################## 2010-02-06 RELEASE: version 2.0.0rc2 2010-02-05 Reconsidered the Makefile structure and more extended tests Catch a crash between WHIZARD and O'Mega for forbidden processes Tensor products of arbitrary color structures in jet definitions 2010-02-04 Color correlation computation in O'Mega finalized ################################################################## 2010-02-03 RELEASE: version 2.0.0rc1 ################################################################## 2010-01-31 Reimplemented numerical helicity selection rules Phase space functionality of version 1 restored and improved 2009-12-05 NMSSM validated with FeynRules in WHIZARD 1 (Felix Braam) 2009-12-04 RELEASE: version 2.0.0alpha ################################################################## 2009-04-16 RELEASE: version 1.93 2009-04-15 Clean-up of Makefiles and configure scripts Reconfiguration of BSM model implementation extended supersymmetric models 2008-12-23 New model NMSSM (Felix Braam) SLHA2 added Bug in LHAPDF interface fixed 2008-08-16 Bug fixed in K matrix implementation Gravitino option in the MSSM added 2008-03-20 Improved color and flavor sums ################################################################## 2008-03-12 RELEASE: version 1.92 LHEF (Les Houches Event File) format added Fortran 2003 command-line interface (if supported by the compiler) Automated interface to colored models More bug fixes and workarounds for compiler compatibility ################################################################## 2008-03-06 RELEASE: version 1.91 New model K-matrix (resonances and anom. couplings in WW scattering) EWA spectrum Energy-scan pseudo spectrum Preliminary parton shower module (only from final-state quarks) Cleanup and improvements of configure process Improvements for O'Mega parameter files Quadruple precision works again More plotting options: lines, symbols, errors Documentation with PDF bookmarks enabled Various bug fixes 2007-11-29 New model UED ################################################################## 2007-11-23 RELEASE: version 1.90 O'Mega now part of the WHIZARD tree Madgraph/CompHEP disabled by default (but still usable) Support for LHAPDF (preliminary) Added new models: SMZprime, SM_km, Template Improved compiler recognition and compatibility Minor bug fixes ################################################################## 2006-06-15 RELEASE: version 1.51 Support for anomaly-type Higgs couplings (to gluon and photon/Z) Support for spin 3/2 and spin 2 New models: Little Higgs (4 versions), toy models for extra dimensions and gravitinos Fixes to the whizard.nw source documentation to run through LaTeX Intel 9.0 bug workaround (deallocation of some arrays) 2006-05-15 O'Mega RELEASE: version 0.11 merged JRR's O'Mega extensions ################################################################## 2006-02-07 RELEASE: version 1.50 To avoid confusion: Mention outdated manual example in BUGS file O'Mega becomes part of the WHIZARD generator 2006-02-02 [bug fix update] Bug fix: spurious error when writing event files for weighted events Bug fix: 'r' option for omega produced garbage for some particle names Workaround for ifort90 bug (crash when compiling whizard_event) Workaround for ifort90 bug (crash when compiling hepevt_common) 2006-01-27 Added process definition files for MSSM 2->2 processes Included beam recoil for EPA (T.Barklow) Updated STDHEP byte counts (for STDHEP 5.04.02) Fixed STDHEP compatibility (avoid linking of incomplete .so libs) Fixed issue with comphep requiring Xlibs on Opteron Fixed issue with ifort 8.x on Opteron (compiling 'signal' interface) Fixed color-flow code: was broken for omega with option 'c' and 'w' Workaround hacks for g95 compatibility 2005-11-07 O'Mega RELEASE: version 0.10 O'Mega, merged JRR's and WK's color hack for WHiZard O'Mega, EXPERIMENTAL: cache fusion tables (required for colors a la JRR/WK) O'Mega, make JRR's MSSM official ################################################################## 2005-10-25 RELEASE: version 1.43 Minor fixes in MSSM couplings (Higgs/3rd gen squarks). This should be final, since the MSSM results agree now completely with Madgraph and Sherpa User-defined lower and upper limits for split event file count Allow for counters (events, bytes) exceeding $2^{31}$ Revised checksum treatment and implementation (now MD5) Bug fix: missing process energy scale in raw event file ################################################################## 2005-09-30 RELEASE: version 1.42 Graphical display of integration history ('make history') Allow for switching off signals even if supported (configure option) 2005-09-29 Revised phase space generation code, in particular for flavor sums Negative cut and histogram codes use initial beams instead of initial parton momenta. This allows for computing, e.g., E_miss Support constant-width and zero-width options for O'Mega Width options now denoted by w:X (X=f,c,z). f option obsolescent Bug fix: colorized code: flipped indices could screw up result Bug fix: O'Mega with 'c' and 'w:f' option together (still some problem) Bug fix: dvips on systems where dvips defaults to lpr Bug fix: integer overflow if too many events are requested 2005-07-29 Allow for 2 -> 1 processes (if structure functions are on) 2005-07-26 Fixed and expanded the 'test' matrix element: Unit matrix element with option 'u' / default: normalized phase space ################################################################## 2005-07-15 RELEASE: version 1.41 Bug fix: no result for particle decay processes with width=0 Bug fix: line breaks in O'Mega files with color decomposition 2005-06-02 New self-tests (make test-QED / test-QCD / test-SM) check lists of 2->2 processes Bug fix: HELAS calling convention for wwwwxx and jwwwxx (4W-Vertex) 2005-05-25 Revised Makefile structure Eliminated obsolete references to ISAJET/SUSY (superseded by SLHA) 2005-05-19 Support for color in O'Mega (using color flow decomposition) New model QCD Parameter file changes that correspond to replaced SM module in O'Mega Bug fixes in MSSM (O'Mega) parameter file 2005-05-18 New event file formats, useful for LHC applications: ATHENA and Les Houches Accord (external fragmentation) Naive (i.e., leading 1/N) color factor now implemented both for incoming and outgoing partons 2005-01-26 include missing HELAS files for bundle pgf90 compatibility issues [note: still internal error in pgf90] ################################################################## 2004-12-13 RELEASE: version 1.40 compatibility fix: preprocessor marks in helas code now commented out minor bug fix: format string in madgraph source 2004-12-03 support for arbitray beam energies and directions allow for pT kick in structure functions bug fix: rounding error could result in zero cross section (compiler-dependent) 2004-10-07 simulate decay processes list fraction (of total width/cross section) instead of efficiency in process summary new cut/analysis parameters AA, AAD, CTA: absolute polar angle 2004-10-04 Replaced Madgraph I by Madgraph II. Main improvement: model no longer hardcoded introduced parameter reset_seed_each_process (useful for debugging) bug fix: color initialization for some processes was undefined 2004-09-21 don't compile unix_args module if it is not required ################################################################## 2004-09-20 RELEASE: version 1.30 g95 compatibility issues resolved some (irrelevant) memory leaks closed removed obsolete warning in circe1 manual update (essentially) finished 2004-08-03 O'Mega RELEASE: version 0.9 O'Mega, 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. 2004-07-26 minor fixes and improvements in make process 2004-06-29 workarounds for new Intel compiler bugs ... no rebuild of madgraph/comphep executables after 'make clean' bug fix in phase space routine: wrong energy for massive initial particles bug fix in (new) model interface: name checks for antiparticles pre-run checks for comphep improved ww-strong model file extended Model files particle name fixes, chep SM vertices included 2004-06-22 O'Mega RELEASE: version 0.8 O'Mega MSSM: sign of W+/W-/A and W+/W-/Z couplings 2004-05-05 Fixed bug in PDFLIB interface: p+pbar was initialized as p+p (ThO) NAG compiler: set number of continuation lines to 200 as default Extended format for cross section summary; appears now in whizard.out Fixed 'bundle' feature 2004-04-28 Fixed compatibility with revised O'Mega SM_ac model Fixed problem with x=0 or x=1 when calling PDFLIB (ThO) Fixed bug in comphep module: Vtb was overlooked ################################################################## 2004-04-15 RELEASE: version 1.28 Fixed bug: Color factor was missing for O'Mega processes with four quarks and more Manual partially updated 2004-04-08 Support for grid files in binary format New default value show_histories=F (reduce output file size) Revised phase space switches: removed annihilation_lines, removed s_channel_resonance, changed meaning of extra_off_shell_lines, added show_deleted_channels Bug fixed which lead to omission of some phase space channels Color flow guessed only if requested by guess_color_flow 2004-03-10 New model interface: Only one model name specified in whizard.prc All model-dependent files reside in conf/models (modellib removed) 2004-03-03 Support for input/output in SUSY Les Houches Accord format Split event files if requested Support for overall time limit Support for CIRCE and CIRCE2 generator mode Support for reading beam events from file 2004-02-05 Fixed compiler problems with Intel Fortran 7.1 and 8.0 Support for catching signals ################################################################## 2003-08-06 RELEASE: version 1.27 User-defined PDF libraries as an alternative to the standard PDFLIB 2003-07-23 Revised phase space module: improved mappings for massless particles, equivalences of phase space channels are exploited Improved mapping for PDF (hadron colliders) Madgraph module: increased max number of color flows from 250 to 1000 ################################################################## 2003-06-23 RELEASE: version 1.26 CIRCE2 support Fixed problem with 'TC' integer kind [Intel compiler complained] 2003-05-28 Support for drawing histograms of grids Bug fixes for MSSM definitions ################################################################## 2003-05-22 RELEASE: version 1.25 Experimental MSSM support with ISAJET interface Improved capabilities of generating/analyzing weighted events Optional drawing phase space diagrams using FeynMF ################################################################## 2003-01-31 RELEASE: version 1.24 A few more fixes and workarounds (Intel and Lahey compiler) 2003-01-15 Fixes and workarounds needed for WHIZARD to run with Intel compiler Command-line option interface for the Lahey compiler Bug fix: problem with reading whizard.phs ################################################################## 2002-12-10 RELEASE: version 1.23 Command-line options (on some systems) Allow for initial particles in the event record, ordered: [beams, initials] - [remnants] - outgoing partons Support for PYTHIA 6.2: Les Houches external process interface String pythia_parameters can be up to 1000 characters long Select color flow states in (internal) analysis Bug fix in color flow content of raw event files Support for transversal polarization of fermion beams Cut codes: PHI now for absolute azimuthal angle, DPHI for distance 'Test' matrix elements optionally respect polarization User-defined code can be inserted for spectra, structure functions and fragmentation Time limits can be specified for adaptation and simulation User-defined file names and file directory Initial weights in input file no longer supported Bug fix in MadGraph (wave function counter could overflow) Bug fix: Gamelan (graphical analysis) was not built if noweb absent ################################################################## 2002-03-16 RELEASE: version 1.22 Allow for beam remnants in the event record 2002-03-01 Handling of aliases in whizard.prc fixed (aliases are whole tokens) 2002-02-28 Optimized phase space handling routines (total execution time reduced by 20-60%, depending on process) ################################################################## 2002-02-26 RELEASE: version 1.21 Fixed ISR formula (ISR was underestimated in previous versions). New version includes ISR in leading-log approximation up to third order. Parameter ISR_sqrts renamed to ISR_scale. ################################################################## 2002-02-19 RELEASE: version 1.20 New process-generating method 'test' (dummy matrix element) Compatibility with autoconf 2.50 and current O'Mega version 2002-02-05 Prevent integration channels from being dropped (optionally) New internal mapping for structure functions improves performance Old whizard.phx file deleted after recompiling (could cause trouble) 2002-01-24 Support for user-defined cuts and matrix element reweighting STDHEP output now written by write_events_format=20 (was 3) 2002-01-16 Improved structure function handling; small changes in user interface: new parameter structured_beams in &process_input parameter fixed_energy in &beam_input removed Support for multiple initial states Eta-phi (cone) cut possible (hadron collider applications) Fixed bug: Whizard library was not always recompiled when necessary Fixed bug: Default cuts were insufficient in some cases Fixed bug: Unusable phase space mappings generated in some cases 2001-12-06 Reorganized document source 2001-12-05 Preliminary CIRCE2 support (no functionality yet) 2001-11-27 Intel compiler support (does not yet work because of compiler bugs) New cut and analysis mode cos-theta* and related Fixed circular jetset_interface dependency warning Some broadcast routines removed (parallel support disabled anyway) Minor shifts in cleanup targets (Makefiles) Modified library search, check for pdflib8* 2001-08-06 Fixed bug: I/O unit number could be undefined when reading phase space Fixed bug: Unitialized variable could cause segfault when event generation was disabled Fixed bug: Undefined subroutine in CIRCE replacement module Enabled feature: TGCs in O'Mega (not yet CompHEP!) matrix elements (CompHEP model sm-GF #5, O'Mega model SM_ac) Fixed portability issue: Makefile did rely on PWD environment variable Fixed portability issue: PYTHIA library search ambiguity resolved 2001-08-01 Default whizard.prc and whizard.in depend on activated modules Fixed bug: TEX=latex was not properly enabled when making plots 2001-07-20 Fixed output settings in PERL script calls Cache enabled in various configure checks 2001-07-13 Support for multiple processes in a single WHIZARD run. The integrations are kept separate, but the generated events are mixed The whizard.evx format has changed (incompatible), including now the color flow information for PYTHIA fragmentation Output files are now process-specific, except for the event file Phase space file whizard.phs (if present) is used only as input, program-generated phase space is now in whizard.phx 2001-07-10 Bug fix: Undefined parameters in parameters_SM_ac.f90 removed 2001-07-04 Bug fix: Compiler options for the case OMEGA is disabled Small inconsistencies in whizard.out format fixed 2001-07-01 Workaround for missing PDFLIB dummy routines in PYTHIA library ################################################################## 2001-06-30 RELEASE: version 1.13 Default path /cern/pro/lib in configure script 2001-06-20 New fragmentation option: Interface for PYTHIA with full color flow information, beam remnants etc. 2001-06-18 Severe bug fixed in madgraph interface: 3-gluon coupling was missing Enabled color flow information in madgraph 2001-06-11 VAMP interface module rewritten Revised output format: Multiple VAMP iterations count as one WHIZARD iteration in integration passes 1 and 3 Improved message and error handling Bug fix in VAMP: handle exceptional cases in rebinning_weights 2001-05-31 new parameters for grid adaptation: accuracy_goal and efficiency_goal ################################################################## 2001-05-29 RELEASE: version 1.12 bug fixes (compilation problems): deleted/modified unused functions 2001-05-16 diagram selection improved and documented 2001-05-06 allow for disabling packages during configuration 2001-05-03 slight changes in whizard.out format; manual extended ################################################################## 2001-04-20 RELEASE: version 1.11 fixed some configuration and compilation problems (PDFLIB etc.) 2001-04-18 linked PDFLIB: support for quark/gluon structure functions 2001-04-05 parameter interface written by PERL script SM_ac model file: fixed error in continuation line 2001-03-13 O'Mega, O'Caml 3.01: incompatible changes O'Mega, src/trie.mli: add covariance annotation to T.t This breaks O'Caml 3.00, but is required for O'Caml 3.01. O'Mega, many instances: replace `sig include Module.T end' by `Module.T', since the bug is fixed in O'Caml 3.01 2001-02-28 O'Mega, src/model.mli: new field Model.vertices required for model functors, will retire Model.fuse2, Model.fuse3, Model.fusen soon. ################################################################## 2001-03-27 RELEASE: version 1.10 reorganized the modules as libraries linked PYTHIA: support for parton fragmentation 2000-12-14 fixed some configuration problems (if noweb etc. are absent) ################################################################## 2000-12-01 RELEASE of first public version: version 1.00beta