Ticket #310: fr_sm_test_mdl.ml

(* --------------------------------------------------------------------------------
   Autogenerated by the preliminary FeynRules <-> WHIZARD automaton on 4/24/2010 , 15:46:53
   FeynRules version: $Revision: 119 $
   WHIZARD interface svn revision info: $Id: WhizardOmegaInterface.m 137 2010-04-23 23:22:18Z ChristianSpeckner $
   Code generated for WHIZARD / O'Mega version 2.0
   Model: Standard_Model
   Short model name: fr_sm_test
   Gauge: Unitarity
   Maximum number of couplings per FORTRAN module: 500
   -------------------------------------------------------------------------------- *)

type gauge = Unitarity | Feynman | Rxi

module type Frules_options =
sig
   val gauge: gauge
   val color: bool
end

module Implementation (Opts: Frules_options) =
struct

   open Coupling

   (* The FeynRules classes with their members *)

   type f1_Vl =
      | Ve | Ve_bar | Vm | Vm_bar | Vt | Vt_bar
   type f2_L =
      | E_minus | E_plus | M_minus | M_plus | Tt_minus | Tt_plus
   type f3_Uq =
      | U | U_bar | C | C_bar | T | T_bar
   type f4_Dq =
      | D | D_bar | S | S_bar | B | B_bar
   type v1_A =
      | A_1
   type v2_Z =
      | Z_1
   type v3_W =
      | W_plus | W_minus
   type v4_G =
      | G_1
   type s1_H =
      | H_1
   type s2_Phi =
      | Phi0
   type s3_Phi2 =
      | Phi_plus | Phi_minus

   (* The FeynRules lorentz types with the corresponding classes *)

   type scalar =
      | S1_H of s1_H | S2_Phi of s2_Phi | S3_Phi2 of s3_Phi2
   type fermion =
      | F1_Vl of f1_Vl | F2_L of f2_L | F3_Uq of f3_Uq | F4_Dq of f4_Dq
   type vector =
      | V1_A of v1_A | V2_Z of v2_Z | V3_W of v3_W | V4_G of v4_G

   (* The actual flavor type *)

   type flavor =
      | FRS of scalar | FRF of fermion | FRV of vector

   (* Trampoline functions *)

   let fermion_of_f1_Vl c = F1_Vl c
   let fermion_of_f2_L c = F2_L c
   let fermion_of_f3_Uq c = F3_Uq c
   let fermion_of_f4_Dq c = F4_Dq c
   let vector_of_v1_A c = V1_A c
   let vector_of_v2_Z c = V2_Z c
   let vector_of_v3_W c = V3_W c
   let vector_of_v4_G c = V4_G c
   let scalar_of_s1_H c = S1_H c
   let scalar_of_s2_Phi c = S2_Phi c
   let scalar_of_s3_Phi2 c = S3_Phi2 c
   let flavor_of_scalar lt = FRS lt
   let flavor_of_fermion lt = FRF lt
   let flavor_of_vector lt = FRV lt

   (* Particle lists *)

   let f1_Vl_members =
      [Ve; Ve_bar; Vm; Vm_bar; Vt; Vt_bar;]
   let f2_L_members =
      [E_minus; E_plus; M_minus; M_plus; Tt_minus; Tt_plus;]
   let f3_Uq_members =
      [U; U_bar; C; C_bar; T; T_bar;]
   let f4_Dq_members =
      [D; D_bar; S; S_bar; B; B_bar;]
   let v1_A_members =
      [A_1;]
   let v2_Z_members =
      [Z_1;]
   let v3_W_members =
      [W_plus; W_minus;]
   let v4_G_members =
      [G_1;]
   let s1_H_members =
      [H_1;]
   let s2_Phi_members =
      [Phi0;]
   let s3_Phi2_members =
      [Phi_plus; Phi_minus;]
   let all_scalars = []
      @ (List.map scalar_of_s1_H s1_H_members)
      @ (List.map scalar_of_s2_Phi s2_Phi_members)
      @ (List.map scalar_of_s3_Phi2 s3_Phi2_members)
   let all_fermions = []
      @ (List.map fermion_of_f1_Vl f1_Vl_members)
      @ (List.map fermion_of_f2_L f2_L_members)
      @ (List.map fermion_of_f3_Uq f3_Uq_members)
      @ (List.map fermion_of_f4_Dq f4_Dq_members)
   let all_vectors = []
      @ (List.map vector_of_v1_A v1_A_members)
      @ (List.map vector_of_v2_Z v2_Z_members)
      @ (List.map vector_of_v3_W v3_W_members)
      @ (List.map vector_of_v4_G v4_G_members)

   (* The conjugation operation on a single class *)

   let conjugate_f1_Vl = function 
      | Ve -> Ve_bar | Ve_bar -> Ve | Vm -> Vm_bar | Vm_bar -> Vm | Vt -> Vt_bar
      | Vt_bar -> Vt
   let conjugate_f2_L = function 
      | E_minus -> E_plus | E_plus -> E_minus | M_minus -> M_plus | M_plus -> M_minus
      | Tt_minus -> Tt_plus | Tt_plus -> Tt_minus
   let conjugate_f3_Uq = function 
      | U -> U_bar | U_bar -> U | C -> C_bar | C_bar -> C | T -> T_bar | T_bar -> T
   let conjugate_f4_Dq = function 
      | D -> D_bar | D_bar -> D | S -> S_bar | S_bar -> S | B -> B_bar | B_bar -> B
   let conjugate_v1_A = function 
      | x -> x
   let conjugate_v2_Z = function 
      | x -> x
   let conjugate_v3_W = function 
      | W_plus -> W_minus | W_minus -> W_plus
   let conjugate_v4_G = function 
      | x -> x
   let conjugate_s1_H = function 
      | x -> x
   let conjugate_s2_Phi = function 
      | x -> x
   let conjugate_s3_Phi2 = function 
      | Phi_plus -> Phi_minus | Phi_minus -> Phi_plus

   (* The conjugation operation on a lorentz type *)

   let conjugate_scalar = function 
      | S1_H x -> S1_H (conjugate_s1_H x)
      | S2_Phi x -> S2_Phi (conjugate_s2_Phi x)
      | S3_Phi2 x -> S3_Phi2 (conjugate_s3_Phi2 x)
   let conjugate_fermion = function 
      | F1_Vl x -> F1_Vl (conjugate_f1_Vl x)
      | F2_L x -> F2_L (conjugate_f2_L x)
      | F3_Uq x -> F3_Uq (conjugate_f3_Uq x)
      | F4_Dq x -> F4_Dq (conjugate_f4_Dq x)
   let conjugate_vector = function 
      | V1_A x -> V1_A (conjugate_v1_A x)
      | V2_Z x -> V2_Z (conjugate_v2_Z x)
      | V3_W x -> V3_W (conjugate_v3_W x)
      | V4_G x -> V4_G (conjugate_v4_G x)

   (* Conjugation for the masses *)

   let conjugate = function
      | FRS x -> FRS (conjugate_scalar x)
      | FRF x -> FRF (conjugate_fermion x)
      | FRV x -> FRV (conjugate_vector x)

   let color = function
      | FRS _ -> Color.Singlet
      | FRF x -> (match x with 
         | F1_Vl _ -> Color.Singlet
         | F2_L _ -> Color.Singlet
         | F3_Uq x -> (match x with 
            | U | C | T -> Color.SUN 3 | U_bar | C_bar | T_bar -> Color.SUN (-3))
         | F4_Dq x -> (match x with 
            | D | S | B -> Color.SUN 3 | D_bar | S_bar | B_bar -> Color.SUN (-3)))
      | FRV x -> (match x with 
         | V1_A _ -> Color.Singlet
         | V2_Z _ -> Color.Singlet
         | V3_W _ -> Color.Singlet
         | V4_G G_1 -> Color.AdjSUN 3)

   let pdg = function
      | FRS x -> (match x with 
         | S1_H H_1 -> 25
         | S2_Phi Phi0 -> 250
         | S3_Phi2 x -> (match x with 
            | Phi_plus -> 251 | Phi_minus -> -251))
      | FRF x -> (match x with 
         | F1_Vl x -> (match x with 
            | Ve -> 12 | Ve_bar -> -12 | Vm -> 14 | Vm_bar -> -14 | Vt -> 16 | Vt_bar -> -16)

         | F2_L x -> (match x with 
            | E_minus -> 11 | E_plus -> -11 | M_minus -> 13 | M_plus -> -13 | Tt_minus -> 15
            | Tt_plus -> -15)
         | F3_Uq x -> (match x with 
            | U -> 2 | U_bar -> -2 | C -> 4 | C_bar -> -4 | T -> 6 | T_bar -> -6)
         | F4_Dq x -> (match x with 
            | D -> 1 | D_bar -> -1 | S -> 3 | S_bar -> -3 | B -> 5 | B_bar -> -5))
      | FRV x -> (match x with 
         | V1_A A_1 -> 22
         | V2_Z Z_1 -> 23
         | V3_W x -> (match x with 
            | W_plus -> 24 | W_minus -> -24)
         | V4_G G_1 -> 21)

   let lorentz = function
      | FRF x -> (match x with 
         | F1_Vl x -> (match x with 
            | Ve | Vm | Vt -> Spinor | Ve_bar | Vm_bar | Vt_bar -> ConjSpinor)
         | F2_L x -> (match x with 
            | E_minus | M_minus | Tt_minus -> Spinor | E_plus | M_plus | Tt_plus -> ConjSpinor)

         | F3_Uq x -> (match x with 
            | U | C | T -> Spinor | U_bar | C_bar | T_bar -> ConjSpinor)
         | F4_Dq x -> (match x with 
            | D | S | B -> Spinor | D_bar | S_bar | B_bar -> ConjSpinor))
      | FRV x -> (match x with 
         | V1_A A_1 -> Vector
         | V2_Z Z_1 -> Massive_Vector
         | V3_W x -> (match x with 
            | W_plus | W_minus -> Massive_Vector)
         | V4_G G_1 -> Vector)
      | FRS _ -> Scalar

   type gauge = Xi

   let propagator = 
      let msg = "fr_sm_test.Implementation: invalid lorentz rep in propagator" in function
      | FRS _ -> Prop_Scalar
      | FRF x -> (match lorentz (FRF x) with
         | Spinor -> Prop_Spinor
         | ConjSpinor -> Prop_ConjSpinor
         | Majorana -> Prop_Majorana
         | _ -> invalid_arg msg)
      | FRV x -> (match Opts.gauge with
         | Unitarity -> (match lorentz (FRV x) with
            | Vector -> Prop_Feynman
            | Massive_Vector -> Prop_Unitarity
            | _ -> invalid_arg msg)
         | Feynman -> (match lorentz (FRV x) with
            | Vector -> Prop_Feynman
            | Massive_Vector -> Prop_Rxi Xi
            | _ -> invalid_arg msg)
         | Rxi -> (match lorentz (FRV x) with
            | Vector -> Prop_Gauge Xi
            | Massive_Vector -> Prop_Rxi Xi
            | _ -> invalid_arg msg))

   let width_symbol = function
      | FRS x -> (match x with 
         | S1_H H_1 -> "wh"
         | S2_Phi Phi0 -> "wphi"
         | S3_Phi2 x -> (match x with 
            | Phi_plus -> "wphi2" | Phi_minus -> "wphi2"))
      | FRF x -> (match x with 
         | F1_Vl _ -> "fr_zero"
         | F2_L _ -> "fr_zero"
         | F3_Uq x -> (match x with 
            | T -> "wt" | T_bar -> "wt" | _ -> "fr_zero")
         | F4_Dq _ -> "fr_zero")
      | FRV x -> (match x with 
         | V1_A _ -> "fr_zero"
         | V2_Z Z_1 -> "wz"
         | V3_W x -> (match x with 
            | W_plus -> "ww" | W_minus -> "ww")
         | V4_G _ -> "fr_zero")

   let width x = match width_symbol x with 
      | "0" -> Vanishing
      | _ -> Timelike

   let fermion x = (match lorentz x with
      | Spinor -> 1 | ConjSpinor -> -1 | Majorana -> 2 | _ -> 0)

   let colsymm _ = (0, false), (0, false)

   let flavors () = []
      @ (List.map flavor_of_scalar all_scalars)
      @ (List.map flavor_of_fermion all_fermions)
      @ (List.map flavor_of_vector all_vectors)

   let external_flavors () = ["FeynRules autogenerated flavors", flavors ()]

   let goldstone _ = None

   let flavor_to_string = function
      | FRS x -> (match x with 
         | S1_H H_1 -> "H"
         | S2_Phi Phi0 -> "phi0"
         | S3_Phi2 x -> (match x with 
            | Phi_plus -> "phi+" | Phi_minus -> "phi-"))
      | FRF x -> (match x with 
         | F1_Vl x -> (match x with 
            | Ve -> "ve" | Ve_bar -> "ve~" | Vm -> "vm" | Vm_bar -> "vm~" | Vt -> "vt"
            | Vt_bar -> "vt~")
         | F2_L x -> (match x with 
            | E_minus -> "e-" | E_plus -> "e+" | M_minus -> "m-" | M_plus -> "m+"
            | Tt_minus -> "tt-" | Tt_plus -> "tt+")
         | F3_Uq x -> (match x with 
            | U -> "u" | U_bar -> "u~" | C -> "c" | C_bar -> "c~" | T -> "t" | T_bar -> "t~")

         | F4_Dq x -> (match x with 
            | D -> "d" | D_bar -> "d~" | S -> "s" | S_bar -> "s~" | B -> "b" | B_bar -> "b~"))
      | FRV x -> (match x with 
         | V1_A A_1 -> "A"
         | V2_Z Z_1 -> "Z"
         | V3_W x -> (match x with 
            | W_plus -> "W+" | W_minus -> "W-")
         | V4_G G_1 -> "G")

   let flavor_to_TeX = function
      | FRS x -> (match x with 
         | S1_H H_1 -> "\\phi"
         | S2_Phi Phi0 -> "phi0"
         | S3_Phi2 x -> (match x with 
            | Phi_plus -> "\\phi^+" | Phi_minus -> "\\phi^-"))
      | FRF x -> (match x with 
         | F1_Vl x -> (match x with 
            | Ve -> "ve" | Ve_bar -> "ve~" | Vm -> "vm" | Vm_bar -> "vm~" | Vt -> "vt"
            | Vt_bar -> "vt~")
         | F2_L x -> (match x with 
            | E_minus -> "e-" | E_plus -> "e+" | M_minus -> "m-" | M_plus -> "m+"
            | Tt_minus -> "tt-" | Tt_plus -> "tt+")
         | F3_Uq x -> (match x with 
            | U -> "u" | U_bar -> "u~" | C -> "c" | C_bar -> "c~" | T -> "t" | T_bar -> "t~")

         | F4_Dq x -> (match x with 
            | D -> "d" | D_bar -> "d~" | S -> "s" | S_bar -> "s~" | B -> "b" | B_bar -> "b~"))
      | FRV x -> (match x with 
         | V1_A A_1 -> "A"
         | V2_Z Z_1 -> "Z"
         | V3_W x -> (match x with 
            | W_plus -> "W+" | W_minus -> "W-")
         | V4_G G_1 -> "G")

   let flavor_of_string x =
      let dict = List.map (fun x -> (x, flavor_to_string x)) (flavors ())
      in try
         fst (List.find (fun (_, y) -> (x = y)) dict)
      with
         Not_found -> invalid_arg "fr_sm_test.Implementation: flavor_of_string: invalid particle?"

   let flavor_symbol = function
      | FRS x -> (match x with 
         | S1_H H_1 -> "h_1"
         | S2_Phi Phi0 -> "phi0"
         | S3_Phi2 x -> (match x with 
            | Phi_plus -> "phi_plus" | Phi_minus -> "phi_minus"))
      | FRF x -> (match x with 
         | F1_Vl x -> (match x with 
            | Ve -> "ve" | Ve_bar -> "ve_bar" | Vm -> "vm" | Vm_bar -> "vm_bar" | Vt -> "vt"
            | Vt_bar -> "vt_bar")
         | F2_L x -> (match x with 
            | E_minus -> "e_minus" | E_plus -> "e_plus" | M_minus -> "m_minus"
            | M_plus -> "m_plus" | Tt_minus -> "tt_minus" | Tt_plus -> "tt_plus")
         | F3_Uq x -> (match x with 
            | U -> "u" | U_bar -> "u_bar" | C -> "c" | C_bar -> "c_bar" | T -> "t"
            | T_bar -> "t_bar")
         | F4_Dq x -> (match x with 
            | D -> "d" | D_bar -> "d_bar" | S -> "s" | S_bar -> "s_bar" | B -> "b"
            | B_bar -> "b_bar"))
      | FRV x -> (match x with 
         | V1_A A_1 -> "a_1"
         | V2_Z Z_1 -> "z_1"
         | V3_W x -> (match x with 
            | W_plus -> "w_plus" | W_minus -> "w_minus")
         | V4_G G_1 -> "g_1")

   let gauge_symbol = function
      Xi -> (match Opts.gauge with
         | Unitarity -> invalid_arg
            "fr_sm_test.Implementation: requesting gauge symbol in unitarity gauge!"
         | Feynman -> "one"
         | Rxi -> "Rxi")

   let mass_symbol = function
      | FRS x -> (match x with 
         | S1_H H_1 -> "mh"
         | S2_Phi Phi0 -> "mz"
         | S3_Phi2 x -> (match x with 
            | Phi_plus -> "mw" | Phi_minus -> "mw"))
      | FRF x -> (match x with 
         | F1_Vl _ -> "fr_zero"
         | F2_L x -> (match x with 
            | E_minus -> "me" | E_plus -> "me" | M_minus -> "mm" | M_plus -> "mm"
            | Tt_minus -> "mta" | Tt_plus -> "mta")
         | F3_Uq x -> (match x with 
            | U -> "mu" | U_bar -> "mu" | C -> "mc" | C_bar -> "mc" | T -> "mt"
            | T_bar -> "mt")
         | F4_Dq x -> (match x with 
            | D -> "md" | D_bar -> "md" | S -> "ms" | S_bar -> "ms" | B -> "mb"
            | B_bar -> "mb"))
      | FRV x -> (match x with 
         | V1_A _ -> "fr_zero"
         | V2_Z Z_1 -> "mz"
         | V3_W x -> (match x with 
            | W_plus -> "mw" | W_minus -> "mw")
         | V4_G _ -> "fr_zero")

   (* Coupling constants and parameters *)

   type constant =
      | G_h_1_h_1_h_1_h_1 | G_h_1_h_1_h_1 | G_g_1_g_1_g_1_g_1 | G_b_bar_g_1_b
      | G_a_1_w_minus_w_plus | G_h_1_h_1_w_plus_w_minus | G_h_1_w_plus_w_minus
      | G_a_1_a_1_w_plus_w_minus | G_z_1_w_plus_w_minus
      | G_w_plus_w_plus_w_minus_w_minus | G_d_bar_h_1_d | G_s_bar_h_1_s
      | G_b_bar_h_1_b | G_e_plus_h_1_e_minus | G_m_plus_h_1_m_minus
      | G_tt_plus_h_1_tt_minus | G_u_bar_h_1_u | G_c_bar_h_1_c | G_t_bar_h_1_t
      | G_a_1_w_plus_w_minus_z_1 | G_h_1_h_1_z_1_z_1 | G_h_1_z_1_z_1
      | G_w_plus_w_minus_z_1_z_1 | G_b_bar_a_1_b | G_e_plus_a_1_e_minus
      | G_c_bar_a_1_c | G_ve_bar_w_plus_e_minus | G_c_bar_w_plus_b | G_c_bar_w_plus_d
      | G_c_bar_w_plus_s | G_t_bar_w_plus_b | G_t_bar_w_plus_d | G_t_bar_w_plus_s
      | G_u_bar_w_plus_b | G_u_bar_w_plus_d | G_u_bar_w_plus_s | G_b_bar_w_minus_c
      | G_b_bar_w_minus_t | G_b_bar_w_minus_u | G_d_bar_w_minus_c | G_d_bar_w_minus_t
      | G_d_bar_w_minus_u | G_s_bar_w_minus_c | G_s_bar_w_minus_t | G_s_bar_w_minus_u
      | G_b_bar_z_1_b | G_e_plus_z_1_e_minus | G_c_bar_z_1_c | G_ve_bar_z_1_ve

   let parameters () = {input = []; derived = []; derived_arrays = []}

   let constant_symbol = function
      | G_h_1_h_1_h_1_h_1 -> "G_h_1_h_1_h_1_h_1" | G_h_1_h_1_h_1 -> "G_h_1_h_1_h_1"
      | G_g_1_g_1_g_1_g_1 -> "G_g_1_g_1_g_1_g_1" | G_b_bar_g_1_b -> "G_b_bar_g_1_b"
      | G_a_1_w_minus_w_plus -> "G_a_1_w_minus_w_plus"
      | G_h_1_h_1_w_plus_w_minus -> "G_h_1_h_1_w_plus_w_minus"
      | G_h_1_w_plus_w_minus -> "G_h_1_w_plus_w_minus"
      | G_a_1_a_1_w_plus_w_minus -> "G_a_1_a_1_w_plus_w_minus"
      | G_z_1_w_plus_w_minus -> "G_z_1_w_plus_w_minus"
      | G_w_plus_w_plus_w_minus_w_minus -> "G_w_plus_w_plus_w_minus_w_minus"
      | G_d_bar_h_1_d -> "G_d_bar_h_1_d" | G_s_bar_h_1_s -> "G_s_bar_h_1_s"
      | G_b_bar_h_1_b -> "G_b_bar_h_1_b"
      | G_e_plus_h_1_e_minus -> "G_e_plus_h_1_e_minus"
      | G_m_plus_h_1_m_minus -> "G_m_plus_h_1_m_minus"
      | G_tt_plus_h_1_tt_minus -> "G_tt_plus_h_1_tt_minus"
      | G_u_bar_h_1_u -> "G_u_bar_h_1_u" | G_c_bar_h_1_c -> "G_c_bar_h_1_c"
      | G_t_bar_h_1_t -> "G_t_bar_h_1_t"
      | G_a_1_w_plus_w_minus_z_1 -> "G_a_1_w_plus_w_minus_z_1"
      | G_h_1_h_1_z_1_z_1 -> "G_h_1_h_1_z_1_z_1" | G_h_1_z_1_z_1 -> "G_h_1_z_1_z_1"
      | G_w_plus_w_minus_z_1_z_1 -> "G_w_plus_w_minus_z_1_z_1"
      | G_b_bar_a_1_b -> "G_b_bar_a_1_b"
      | G_e_plus_a_1_e_minus -> "G_e_plus_a_1_e_minus"
      | G_c_bar_a_1_c -> "G_c_bar_a_1_c"
      | G_ve_bar_w_plus_e_minus -> "G_ve_bar_w_plus_e_minus"
      | G_c_bar_w_plus_b -> "G_c_bar_w_plus_b"
      | G_c_bar_w_plus_d -> "G_c_bar_w_plus_d"
      | G_c_bar_w_plus_s -> "G_c_bar_w_plus_s"
      | G_t_bar_w_plus_b -> "G_t_bar_w_plus_b"
      | G_t_bar_w_plus_d -> "G_t_bar_w_plus_d"
      | G_t_bar_w_plus_s -> "G_t_bar_w_plus_s"
      | G_u_bar_w_plus_b -> "G_u_bar_w_plus_b"
      | G_u_bar_w_plus_d -> "G_u_bar_w_plus_d"
      | G_u_bar_w_plus_s -> "G_u_bar_w_plus_s"
      | G_b_bar_w_minus_c -> "G_b_bar_w_minus_c"
      | G_b_bar_w_minus_t -> "G_b_bar_w_minus_t"
      | G_b_bar_w_minus_u -> "G_b_bar_w_minus_u"
      | G_d_bar_w_minus_c -> "G_d_bar_w_minus_c"
      | G_d_bar_w_minus_t -> "G_d_bar_w_minus_t"
      | G_d_bar_w_minus_u -> "G_d_bar_w_minus_u"
      | G_s_bar_w_minus_c -> "G_s_bar_w_minus_c"
      | G_s_bar_w_minus_t -> "G_s_bar_w_minus_t"
      | G_s_bar_w_minus_u -> "G_s_bar_w_minus_u" | G_b_bar_z_1_b -> "G_b_bar_z_1_b"
      | G_e_plus_z_1_e_minus -> "G_e_plus_z_1_e_minus"
      | G_c_bar_z_1_c -> "G_c_bar_z_1_c" | G_ve_bar_z_1_ve -> "G_ve_bar_z_1_ve"

   (* Vertices and fusions *)

   let max_degree () = 4

   let gauge4 = Coupling.Vector4 [2, Coupling.C_13_42; (-1), Coupling.C_12_34; (-1), Coupling.C_14_23]

   let vertices_3 = [
      (FRS (S1_H H_1), FRS (S1_H H_1), FRS (S1_H H_1)),
       Scalar_Scalar_Scalar 1,
       G_h_1_h_1_h_1
      ;
      (FRV (V3_W W_minus), FRV (V3_W W_plus), FRV (V1_A A_1)),
       Dim4_Vector_Vector_Vector_T 1,
       G_a_1_w_minus_w_plus
      ;
      (FRV (V3_W W_plus), FRV (V1_A A_1), FRV (V3_W W_minus)),
       Dim4_Vector_Vector_Vector_T 1,
       G_a_1_w_minus_w_plus
      ;
      (FRV (V1_A A_1), FRV (V3_W W_minus), FRV (V3_W W_plus)),
       Dim4_Vector_Vector_Vector_T 1,
       G_a_1_w_minus_w_plus
      ;
      (FRS (S1_H H_1), FRV (V3_W W_plus), FRV (V3_W W_minus)),
       Scalar_Vector_Vector 1,
       G_h_1_w_plus_w_minus
      ;
      (FRV (V3_W W_plus), FRV (V3_W W_minus), FRV (V2_Z Z_1)),
       Dim4_Vector_Vector_Vector_T 1,
       G_z_1_w_plus_w_minus
      ;
      (FRV (V3_W W_minus), FRV (V2_Z Z_1), FRV (V3_W W_plus)),
       Dim4_Vector_Vector_Vector_T 1,
       G_z_1_w_plus_w_minus
      ;
      (FRV (V2_Z Z_1), FRV (V3_W W_plus), FRV (V3_W W_minus)),
       Dim4_Vector_Vector_Vector_T 1,
       G_z_1_w_plus_w_minus
      ;
      (FRF (F4_Dq D_bar), FRS (S1_H H_1), FRF (F4_Dq D)),
       Coupling.FBF (1, Coupling.Psibar, Coupling.S, Coupling.Psi),
       G_d_bar_h_1_d
      ;
      (FRF (F4_Dq S_bar), FRS (S1_H H_1), FRF (F4_Dq S)),
       Coupling.FBF (1, Coupling.Psibar, Coupling.S, Coupling.Psi),
       G_s_bar_h_1_s
      ;
      (FRF (F4_Dq B_bar), FRS (S1_H H_1), FRF (F4_Dq B)),
       Coupling.FBF (1, Coupling.Psibar, Coupling.S, Coupling.Psi),
       G_b_bar_h_1_b
      ;
      (FRF (F2_L E_plus), FRS (S1_H H_1), FRF (F2_L E_minus)),
       Coupling.FBF (1, Coupling.Psibar, Coupling.S, Coupling.Psi),
       G_e_plus_h_1_e_minus
      ;
      (FRF (F2_L M_plus), FRS (S1_H H_1), FRF (F2_L M_minus)),
       Coupling.FBF (1, Coupling.Psibar, Coupling.S, Coupling.Psi),
       G_m_plus_h_1_m_minus
      ;
      (FRF (F2_L Tt_plus), FRS (S1_H H_1), FRF (F2_L Tt_minus)),
       Coupling.FBF (1, Coupling.Psibar, Coupling.S, Coupling.Psi),
       G_tt_plus_h_1_tt_minus
      ;
      (FRF (F3_Uq U_bar), FRS (S1_H H_1), FRF (F3_Uq U)),
       Coupling.FBF (1, Coupling.Psibar, Coupling.S, Coupling.Psi),
       G_u_bar_h_1_u
      ;
      (FRF (F3_Uq C_bar), FRS (S1_H H_1), FRF (F3_Uq C)),
       Coupling.FBF (1, Coupling.Psibar, Coupling.S, Coupling.Psi),
       G_c_bar_h_1_c
      ;
      (FRF (F3_Uq T_bar), FRS (S1_H H_1), FRF (F3_Uq T)),
       Coupling.FBF (1, Coupling.Psibar, Coupling.S, Coupling.Psi),
       G_t_bar_h_1_t
      ;
      (FRS (S1_H H_1), FRV (V2_Z Z_1), FRV (V2_Z Z_1)),
       Scalar_Vector_Vector 1,
       G_h_1_z_1_z_1
      ;
      (FRF (F4_Dq B_bar), FRV (V1_A A_1), FRF (F4_Dq B)),
       Coupling.FBF (1, Coupling.Psibar, Coupling.V, Coupling.Psi),
       G_b_bar_a_1_b
      ;
      (FRF (F4_Dq D_bar), FRV (V1_A A_1), FRF (F4_Dq D)),
       Coupling.FBF (1, Coupling.Psibar, Coupling.V, Coupling.Psi),
       G_b_bar_a_1_b
      ;
      (FRF (F4_Dq S_bar), FRV (V1_A A_1), FRF (F4_Dq S)),
       Coupling.FBF (1, Coupling.Psibar, Coupling.V, Coupling.Psi),
       G_b_bar_a_1_b
      ;
      (FRF (F2_L E_plus), FRV (V1_A A_1), FRF (F2_L E_minus)),
       Coupling.FBF (1, Coupling.Psibar, Coupling.V, Coupling.Psi),
       G_e_plus_a_1_e_minus
      ;
      (FRF (F2_L M_plus), FRV (V1_A A_1), FRF (F2_L M_minus)),
       Coupling.FBF (1, Coupling.Psibar, Coupling.V, Coupling.Psi),
       G_e_plus_a_1_e_minus
      ;
      (FRF (F2_L Tt_plus), FRV (V1_A A_1), FRF (F2_L Tt_minus)),
       Coupling.FBF (1, Coupling.Psibar, Coupling.V, Coupling.Psi),
       G_e_plus_a_1_e_minus
      ;
      (FRF (F3_Uq C_bar), FRV (V1_A A_1), FRF (F3_Uq C)),
       Coupling.FBF (1, Coupling.Psibar, Coupling.V, Coupling.Psi),
       G_c_bar_a_1_c
      ;
      (FRF (F3_Uq T_bar), FRV (V1_A A_1), FRF (F3_Uq T)),
       Coupling.FBF (1, Coupling.Psibar, Coupling.V, Coupling.Psi),
       G_c_bar_a_1_c
      ;
      (FRF (F3_Uq U_bar), FRV (V1_A A_1), FRF (F3_Uq U)),
       Coupling.FBF (1, Coupling.Psibar, Coupling.V, Coupling.Psi),
       G_c_bar_a_1_c
      ;
      (FRF (F1_Vl Ve_bar), FRV (V3_W W_plus), FRF (F2_L E_minus)),
       Coupling.FBF (1, Coupling.Psibar, Coupling.VL, Coupling.Psi),
       G_ve_bar_w_plus_e_minus
      ;
      (FRF (F1_Vl Vm_bar), FRV (V3_W W_plus), FRF (F2_L M_minus)),
       Coupling.FBF (1, Coupling.Psibar, Coupling.VL, Coupling.Psi),
       G_ve_bar_w_plus_e_minus
      ;
      (FRF (F1_Vl Vt_bar), FRV (V3_W W_plus), FRF (F2_L Tt_minus)),
       Coupling.FBF (1, Coupling.Psibar, Coupling.VL, Coupling.Psi),
       G_ve_bar_w_plus_e_minus
      ;
      (FRF (F3_Uq C_bar), FRV (V3_W W_plus), FRF (F4_Dq B)),
       Coupling.FBF (1, Coupling.Psibar, Coupling.VL, Coupling.Psi),
       G_c_bar_w_plus_b
      ;
      (FRF (F3_Uq C_bar), FRV (V3_W W_plus), FRF (F4_Dq D)),
       Coupling.FBF (1, Coupling.Psibar, Coupling.VL, Coupling.Psi),
       G_c_bar_w_plus_d
      ;
      (FRF (F3_Uq C_bar), FRV (V3_W W_plus), FRF (F4_Dq S)),
       Coupling.FBF (1, Coupling.Psibar, Coupling.VL, Coupling.Psi),
       G_c_bar_w_plus_s
      ;
      (FRF (F3_Uq T_bar), FRV (V3_W W_plus), FRF (F4_Dq B)),
       Coupling.FBF (1, Coupling.Psibar, Coupling.VL, Coupling.Psi),
       G_t_bar_w_plus_b
      ;
      (FRF (F3_Uq T_bar), FRV (V3_W W_plus), FRF (F4_Dq D)),
       Coupling.FBF (1, Coupling.Psibar, Coupling.VL, Coupling.Psi),
       G_t_bar_w_plus_d
      ;
      (FRF (F3_Uq T_bar), FRV (V3_W W_plus), FRF (F4_Dq S)),
       Coupling.FBF (1, Coupling.Psibar, Coupling.VL, Coupling.Psi),
       G_t_bar_w_plus_s
      ;
      (FRF (F3_Uq U_bar), FRV (V3_W W_plus), FRF (F4_Dq B)),
       Coupling.FBF (1, Coupling.Psibar, Coupling.VL, Coupling.Psi),
       G_u_bar_w_plus_b
      ;
      (FRF (F3_Uq U_bar), FRV (V3_W W_plus), FRF (F4_Dq D)),
       Coupling.FBF (1, Coupling.Psibar, Coupling.VL, Coupling.Psi),
       G_u_bar_w_plus_d
      ;
      (FRF (F3_Uq U_bar), FRV (V3_W W_plus), FRF (F4_Dq S)),
       Coupling.FBF (1, Coupling.Psibar, Coupling.VL, Coupling.Psi),
       G_u_bar_w_plus_s
      ;
      (FRF (F2_L E_plus), FRV (V3_W W_minus), FRF (F1_Vl Ve)),
       Coupling.FBF (1, Coupling.Psibar, Coupling.VL, Coupling.Psi),
       G_ve_bar_w_plus_e_minus
      ;
      (FRF (F2_L M_plus), FRV (V3_W W_minus), FRF (F1_Vl Vm)),
       Coupling.FBF (1, Coupling.Psibar, Coupling.VL, Coupling.Psi),
       G_ve_bar_w_plus_e_minus
      ;
      (FRF (F2_L Tt_plus), FRV (V3_W W_minus), FRF (F1_Vl Vt)),
       Coupling.FBF (1, Coupling.Psibar, Coupling.VL, Coupling.Psi),
       G_ve_bar_w_plus_e_minus
      ;
      (FRF (F4_Dq B_bar), FRV (V3_W W_minus), FRF (F3_Uq C)),
       Coupling.FBF (1, Coupling.Psibar, Coupling.VL, Coupling.Psi),
       G_b_bar_w_minus_c
      ;
      (FRF (F4_Dq B_bar), FRV (V3_W W_minus), FRF (F3_Uq T)),
       Coupling.FBF (1, Coupling.Psibar, Coupling.VL, Coupling.Psi),
       G_b_bar_w_minus_t
      ;
      (FRF (F4_Dq B_bar), FRV (V3_W W_minus), FRF (F3_Uq U)),
       Coupling.FBF (1, Coupling.Psibar, Coupling.VL, Coupling.Psi),
       G_b_bar_w_minus_u
      ;
      (FRF (F4_Dq D_bar), FRV (V3_W W_minus), FRF (F3_Uq C)),
       Coupling.FBF (1, Coupling.Psibar, Coupling.VL, Coupling.Psi),
       G_d_bar_w_minus_c
      ;
      (FRF (F4_Dq D_bar), FRV (V3_W W_minus), FRF (F3_Uq T)),
       Coupling.FBF (1, Coupling.Psibar, Coupling.VL, Coupling.Psi),
       G_d_bar_w_minus_t
      ;
      (FRF (F4_Dq D_bar), FRV (V3_W W_minus), FRF (F3_Uq U)),
       Coupling.FBF (1, Coupling.Psibar, Coupling.VL, Coupling.Psi),
       G_d_bar_w_minus_u
      ;
      (FRF (F4_Dq S_bar), FRV (V3_W W_minus), FRF (F3_Uq C)),
       Coupling.FBF (1, Coupling.Psibar, Coupling.VL, Coupling.Psi),
       G_s_bar_w_minus_c
      ;
      (FRF (F4_Dq S_bar), FRV (V3_W W_minus), FRF (F3_Uq T)),
       Coupling.FBF (1, Coupling.Psibar, Coupling.VL, Coupling.Psi),
       G_s_bar_w_minus_t
      ;
      (FRF (F4_Dq S_bar), FRV (V3_W W_minus), FRF (F3_Uq U)),
       Coupling.FBF (1, Coupling.Psibar, Coupling.VL, Coupling.Psi),
       G_s_bar_w_minus_u
      ;
      (FRF (F4_Dq B_bar), FRV (V2_Z Z_1), FRF (F4_Dq B)),
       Coupling.FBF (1, Coupling.Psibar, Coupling.VLR, Coupling.Psi),
       G_b_bar_z_1_b
      ;
      (FRF (F4_Dq D_bar), FRV (V2_Z Z_1), FRF (F4_Dq D)),
       Coupling.FBF (1, Coupling.Psibar, Coupling.VLR, Coupling.Psi),
       G_b_bar_z_1_b
      ;
      (FRF (F4_Dq S_bar), FRV (V2_Z Z_1), FRF (F4_Dq S)),
       Coupling.FBF (1, Coupling.Psibar, Coupling.VLR, Coupling.Psi),
       G_b_bar_z_1_b
      ;
      (FRF (F2_L E_plus), FRV (V2_Z Z_1), FRF (F2_L E_minus)),
       Coupling.FBF (1, Coupling.Psibar, Coupling.VLR, Coupling.Psi),
       G_e_plus_z_1_e_minus
      ;
      (FRF (F2_L M_plus), FRV (V2_Z Z_1), FRF (F2_L M_minus)),
       Coupling.FBF (1, Coupling.Psibar, Coupling.VLR, Coupling.Psi),
       G_e_plus_z_1_e_minus
      ;
      (FRF (F2_L Tt_plus), FRV (V2_Z Z_1), FRF (F2_L Tt_minus)),
       Coupling.FBF (1, Coupling.Psibar, Coupling.VLR, Coupling.Psi),
       G_e_plus_z_1_e_minus
      ;
      (FRF (F3_Uq C_bar), FRV (V2_Z Z_1), FRF (F3_Uq C)),
       Coupling.FBF (1, Coupling.Psibar, Coupling.VLR, Coupling.Psi),
       G_c_bar_z_1_c
      ;
      (FRF (F3_Uq T_bar), FRV (V2_Z Z_1), FRF (F3_Uq T)),
       Coupling.FBF (1, Coupling.Psibar, Coupling.VLR, Coupling.Psi),
       G_c_bar_z_1_c
      ;
      (FRF (F3_Uq U_bar), FRV (V2_Z Z_1), FRF (F3_Uq U)),
       Coupling.FBF (1, Coupling.Psibar, Coupling.VLR, Coupling.Psi),
       G_c_bar_z_1_c
      ;
      (FRF (F1_Vl Ve_bar), FRV (V2_Z Z_1), FRF (F1_Vl Ve)),
       Coupling.FBF (1, Coupling.Psibar, Coupling.VL, Coupling.Psi),
       G_ve_bar_z_1_ve
      ;
      (FRF (F1_Vl Vm_bar), FRV (V2_Z Z_1), FRF (F1_Vl Vm)),
       Coupling.FBF (1, Coupling.Psibar, Coupling.VL, Coupling.Psi),
       G_ve_bar_z_1_ve
      ;
      (FRF (F1_Vl Vt_bar), FRV (V2_Z Z_1), FRF (F1_Vl Vt)),
       Coupling.FBF (1, Coupling.Psibar, Coupling.VL, Coupling.Psi),
       G_ve_bar_z_1_ve
   ]

   let vertices_3_qcd = [
      (FRF (F4_Dq B_bar), FRV (V4_G G_1), FRF (F4_Dq B)),
       Coupling.FBF (1, Coupling.Psibar, Coupling.V, Coupling.Psi),
       G_b_bar_g_1_b
      ;
      (FRF (F4_Dq D_bar), FRV (V4_G G_1), FRF (F4_Dq D)),
       Coupling.FBF (1, Coupling.Psibar, Coupling.V, Coupling.Psi),
       G_b_bar_g_1_b
      ;
      (FRF (F4_Dq S_bar), FRV (V4_G G_1), FRF (F4_Dq S)),
       Coupling.FBF (1, Coupling.Psibar, Coupling.V, Coupling.Psi),
       G_b_bar_g_1_b
      ;
      (FRF (F3_Uq C_bar), FRV (V4_G G_1), FRF (F3_Uq C)),
       Coupling.FBF (1, Coupling.Psibar, Coupling.V, Coupling.Psi),
       G_b_bar_g_1_b
      ;
      (FRF (F3_Uq T_bar), FRV (V4_G G_1), FRF (F3_Uq T)),
       Coupling.FBF (1, Coupling.Psibar, Coupling.V, Coupling.Psi),
       G_b_bar_g_1_b
      ;
      (FRF (F3_Uq U_bar), FRV (V4_G G_1), FRF (F3_Uq U)),
       Coupling.FBF (1, Coupling.Psibar, Coupling.V, Coupling.Psi),
       G_b_bar_g_1_b
   ]

   let vertices_4 = [
      (FRS (S1_H H_1), FRS (S1_H H_1), FRS (S1_H H_1), FRS (S1_H H_1)),
       Scalar4 1,
       G_h_1_h_1_h_1_h_1
      ;
      (FRS (S1_H H_1), FRS (S1_H H_1), FRV (V3_W W_plus), FRV (V3_W W_minus)),
       Scalar2_Vector2 1,
       G_h_1_h_1_w_plus_w_minus
      ;
      (FRV (V1_A A_1), FRV (V1_A A_1), FRV (V3_W W_plus), FRV (V3_W W_minus)),
       Vector4 [2, Coupling.C_12_34; -1, Coupling.C_13_42; -1, Coupling.C_14_23],
       G_a_1_a_1_w_plus_w_minus
      ;
      (FRV (V3_W W_plus), FRV (V3_W W_plus), FRV (V3_W W_minus), FRV (V3_W W_minus)),
       Vector4 [2, Coupling.C_12_34; -1, Coupling.C_13_42; -1, Coupling.C_14_23],
       G_w_plus_w_plus_w_minus_w_minus
      ;
      (FRV (V1_A A_1), FRV (V3_W W_plus), FRV (V3_W W_minus), FRV (V2_Z Z_1)),
       Vector4 [1, Coupling.C_12_34; 1, Coupling.C_13_42; -2, Coupling.C_14_23],
       G_a_1_w_plus_w_minus_z_1
      ;
      (FRS (S1_H H_1), FRS (S1_H H_1), FRV (V2_Z Z_1), FRV (V2_Z Z_1)),
       Scalar2_Vector2 1,
       G_h_1_h_1_z_1_z_1
      ;
      (FRV (V3_W W_plus), FRV (V3_W W_minus), FRV (V2_Z Z_1), FRV (V2_Z Z_1)),
       Vector4 [2, Coupling.C_12_34; -1, Coupling.C_13_42; -1, Coupling.C_14_23],
       G_w_plus_w_minus_z_1_z_1
   ]

   let vertices_4_qcd = [
      (FRV (V4_G G_1), FRV (V4_G G_1), FRV (V4_G G_1), FRV (V4_G G_1)),
       Vector4 [1, Coupling.C_12_34; -2, Coupling.C_13_42; 1, Coupling.C_14_23],
       G_g_1_g_1_g_1_g_1
   ]

   let vertices_n = []

   let vertices_n_qcd = []

   let vertices () = (
      vertices_3 @ (match Opts.color with true -> vertices_3_qcd | false -> []),
      vertices_4 @ (match Opts.color with true -> vertices_4_qcd | false -> []),
      vertices_n @ (match Opts.color with true -> vertices_n_qcd | false -> [])
   )

   module F = Modeltools.Fusions (struct
      type f = flavor
      type c = constant
      let compare = compare
      let conjugate = conjugate
   end)

   let table = F.of_vertices (vertices ())
   let fuse2 = F.fuse2 table
   let fuse3 = F.fuse3 table
   let fuse = F.fuse table

   (* Misc. infrastructure *)

   let options = Options.empty

   let rcs = RCS.parse "fr_sm_test" ["automatically generate FeynRules model - testing only"] {
      RCS.revision = "Revision: Noop";
      RCS.date = "Date: Noop";
      RCS.author = "Author: FeynRules automaton";
      RCS.source = "Source: Noop"
   }

   type flavor_sans_color = flavor
   let flavor_sans_color x = x
   let conjugate_sans_color = conjugate
   let flavor_sans_color_of_string = flavor_of_string
   let flavor_sans_color_to_string = flavor_to_string
   let flavor_sans_color_to_TeX = flavor_to_TeX
   let flavor_sans_color_symbol = flavor_symbol
end