Index: trunk/ChangeLog =================================================================== --- trunk/ChangeLog (revision 8230) +++ trunk/ChangeLog (revision 8231) @@ -1,1826 +1,1829 @@ ChangeLog -- Summary of changes to the WHIZARD package Use svn log to see detailed changes. Version 2.7.1 2019-03-31 RELEASE: version 2.7.1 +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 Index: trunk/src/models/parameters.MSSM_Hgg.f90 =================================================================== --- trunk/src/models/parameters.MSSM_Hgg.f90 (revision 8230) +++ trunk/src/models/parameters.MSSM_Hgg.f90 (revision 8231) @@ -1,4158 +1,4177 @@ ! parameters.MSSM_Hgg.omega.f90 ! ! 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. ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! module parameters_mssm_hgg use kinds use constants implicit none private public :: import_from_whizard, model_update_alpha_s real(kind=default), dimension(70), save, public :: mass = 0, width = 0 real(kind=default), parameter, public :: GeV = 1.0_default real(kind=default), parameter, public :: MeV = GeV / 1000 real(kind=default), parameter, public :: keV = MeV / 1000 real(kind=default), parameter, public :: TeV = GeV * 1000 real(kind=default), save, public :: & alpha = 1.0_default / 137.0359895_default, & sin2thw = 0.23124_default integer, save, public :: & sign1 = +1, sign2 = +1, sign3 = +1, sign4 = +1 real(kind=default), save, public :: & sigch1 = +1, sigch2 = +1 complex(kind=default), save, private :: vev real(kind=default), public, save :: sind = 0._default, & cosd = 1._default, sinckm12 = 0.223_default, & sinckm13 = 0.004_default, sinckm23 = 0.04_default, & tana = 30._default, tanb = 30._default, as = 0._default real(kind=default), public, save :: cos2am2b, sin2am2b, sinamb, & sinapb, cosamb, cosapb, cos4be, sin4be, sin4al, sin2al, sin2be, cos2al, & cos2be, cosbe, sinbe, cosal, sinal, costhw, sinthw real(kind=default), public, save :: q_lep, q_up, q_down complex(kind=default), public, save :: gcc, qchar, qdwn, qup, qlep, & gz, g, e, gs complex(kind=default), save, public :: xia = 1, xi0 = 1, xipm = 1 complex(kind=default), dimension(2), public, save :: gncdwn complex(kind=default), dimension(2), public, save :: gncup complex(kind=default), dimension(2), public, save :: gnclep complex(kind=default), dimension(2), public, save :: gncneu complex(kind=default), public, save :: g_yuk_ch1_sn1_2_c, & g_yuk_ch1_sn1_2, g_yuk_ch1_sn1_1_c, g_yuk_ch1_sn1_1, g_yuk_ch2_sn1_2_c, & g_yuk_ch2_sn1_2, g_yuk_ch2_sn1_1_c, g_yuk_ch2_sn1_1 complex(kind=default), public, save :: g_yuk_ch2_su1_1_2_c, & g_yuk_ch2_su1_1_2, g_yuk_ch2_sd1_1_2_c, g_yuk_ch2_sd1_1_2, & g_yuk_ch1_su1_1_2_c, g_yuk_ch1_su1_1_2, g_yuk_ch1_sd1_1_2_c, & g_yuk_ch1_sd1_1_2, g_yuk_ch2_su1_1_1_c, g_yuk_ch2_su1_1_1, & g_yuk_ch2_sd1_1_1_c, g_yuk_ch2_sd1_1_1, g_yuk_ch1_su1_1_1_c, & g_yuk_ch1_su1_1_1, g_yuk_ch1_sd1_1_1_c, g_yuk_ch1_sd1_1_1, & g_yuk_ch2_su1_2_2_c, g_yuk_ch2_su1_2_2, g_yuk_ch2_sd1_2_2_c, & g_yuk_ch2_sd1_2_2, g_yuk_ch1_su1_2_2_c, g_yuk_ch1_su1_2_2, & g_yuk_ch1_sd1_2_2_c, g_yuk_ch1_sd1_2_2, g_yuk_ch2_su1_2_1_c, & g_yuk_ch2_su1_2_1, g_yuk_ch2_sd1_2_1_c, g_yuk_ch2_sd1_2_1, & g_yuk_ch1_su1_2_1_c, g_yuk_ch1_su1_2_1, g_yuk_ch1_sd1_2_1_c, & g_yuk_ch1_sd1_2_1 complex(kind=default), public, save :: g_yuk_n4_sn1_3_c, g_yuk_n4_sn1_3, & g_yuk_n4_sn1_2_c, g_yuk_n4_sn1_2, g_yuk_n4_sn1_1_c, g_yuk_n4_sn1_1, & g_yuk_n3_sn1_3_c, g_yuk_n3_sn1_3, g_yuk_n3_sn1_2_c, g_yuk_n3_sn1_2, & g_yuk_n3_sn1_1_c, g_yuk_n3_sn1_1, g_yuk_n2_sn1_3_c, g_yuk_n2_sn1_3, & g_yuk_n2_sn1_2_c, g_yuk_n2_sn1_2, g_yuk_n2_sn1_1_c, g_yuk_n2_sn1_1, & g_yuk_n1_sn1_3_c, g_yuk_n1_sn1_3, g_yuk_n1_sn1_2_c, g_yuk_n1_sn1_2, & g_yuk_n1_sn1_1_c, g_yuk_n1_sn1_1, g_yuk_ch2_sl2_3_c, g_yuk_ch2_sl2_3, & g_yuk_ch2_sl1_3_c, g_yuk_ch2_sl1_3, g_yuk_ch2_sl1_2_c, g_yuk_ch2_sl1_2, & g_yuk_ch2_sl1_1_c, g_yuk_ch2_sl1_1, g_yuk_ch1_sl2_3_c, g_yuk_ch1_sl2_3, & g_yuk_ch1_sl1_3_c, g_yuk_ch1_sl1_3, g_yuk_ch1_sl1_2_c, g_yuk_ch1_sl1_2, & g_yuk_ch1_sl1_1_c, g_yuk_ch1_sl1_1, ghsu2sd2_3_3_c, ghsu2sd2_3_3, & ghsu2sd1_3_3_c, ghsu2sd1_3_3, ghsu1sd2_3_3_c, ghsu1sd2_3_3, ghsu1sd1_3_3_c, & ghsu1sd1_3_3, ghsu2sd2_3_2_c, ghsu2sd2_3_2, ghsu2sd1_3_2_c, ghsu2sd1_3_2, & ghsu1sd2_3_2_c, ghsu1sd2_3_2, ghsu1sd1_3_2_c, ghsu1sd1_3_2, ghsu2sd2_3_1_c, & ghsu2sd2_3_1, ghsu2sd1_3_1_c, ghsu2sd1_3_1, ghsu1sd2_3_1_c complex(kind=default), public, save :: ghsu1sd2_3_1, ghsu1sd1_3_1_c, & ghsu1sd1_3_1, ghsu2sd2_2_3_c, ghsu2sd2_2_3, ghsu2sd1_2_3_c, ghsu2sd1_2_3, & ghsu1sd2_2_3_c, ghsu1sd2_2_3, ghsu1sd1_2_3_c, ghsu1sd1_2_3, ghsu1sd1_2_2_c, & ghsu1sd1_2_2, ghsu1sd1_2_1_c, ghsu1sd1_2_1, ghsu2sd2_1_3_c, ghsu2sd2_1_3, & ghsu2sd1_1_3_c, ghsu2sd1_1_3, ghsu1sd2_1_3_c, ghsu1sd2_1_3, ghsu1sd1_1_3_c, & ghsu1sd1_1_3, ghsu1sd1_1_2_c, ghsu1sd1_1_2, ghsu1sd1_1_1_c, ghsu1sd1_1_1, & gh2sn1sn1_3, gh1sn1sn1_3, ghsnsl2_3_c, ghsnsl2_3, ghsnsl1_3_c, ghsnsl1_3, & gh2sd2sd2_3, gh2su2su2_3, gh2sl2sl2_3, gh1sd2sd2_3, gh1su2su2_3, gh1sl2sl2_3 complex(kind=default), public, save :: g_yuk_n4_sd2_2_c, g_yuk_n4_sd2_2, & g_yuk_n4_su2_2_c, g_yuk_n4_su2_2, g_yuk_n4_sl2_2_c, g_yuk_n4_sl2_2, & g_yuk_n3_sd2_2_c, g_yuk_n3_sd2_2, g_yuk_n3_su2_2_c, g_yuk_n3_su2_2, & g_yuk_n3_sl2_2_c, g_yuk_n3_sl2_2, g_yuk_n2_sd2_2_c, g_yuk_n2_sd2_2, & g_yuk_n2_su2_2_c, g_yuk_n2_su2_2, g_yuk_n2_sl2_2_c, g_yuk_n2_sl2_2, & g_yuk_n1_sd2_2_c, g_yuk_n1_sd2_2, g_yuk_n1_su2_2_c, g_yuk_n1_su2_2, & g_yuk_n1_sl2_2_c, g_yuk_n1_sl2_2, g_yuk_n4_sd1_2_c, g_yuk_n4_sd1_2, & g_yuk_n4_su1_2_c, g_yuk_n4_su1_2, g_yuk_n4_sl1_2_c, g_yuk_n4_sl1_2, & g_yuk_n3_sd1_2_c, g_yuk_n3_sd1_2, g_yuk_n3_su1_2_c, g_yuk_n3_su1_2, & g_yuk_n3_sl1_2_c, g_yuk_n3_sl1_2, g_yuk_n2_sd1_2_c, g_yuk_n2_sd1_2, & g_yuk_n2_su1_2_c, g_yuk_n2_su1_2, g_yuk_n2_sl1_2_c, g_yuk_n2_sl1_2, & g_yuk_n1_sd1_2_c, g_yuk_n1_sd1_2, g_yuk_n1_su1_2_c, g_yuk_n1_su1_2, & g_yuk_n1_sl1_2_c, g_yuk_n1_sl1_2, g_yuk_n4_sd2_1_c, g_yuk_n4_sd2_1, & g_yuk_n4_su2_1_c, g_yuk_n4_su2_1, g_yuk_n4_sl2_1_c, g_yuk_n4_sl2_1, & g_yuk_n3_sd2_1_c, g_yuk_n3_sd2_1, g_yuk_n3_su2_1_c, g_yuk_n3_su2_1, & g_yuk_n3_sl2_1_c, g_yuk_n3_sl2_1, g_yuk_n2_sd2_1_c, g_yuk_n2_sd2_1, & g_yuk_n2_su2_1_c, g_yuk_n2_su2_1, g_yuk_n2_sl2_1_c, g_yuk_n2_sl2_1, & g_yuk_n1_sd2_1_c, g_yuk_n1_sd2_1, g_yuk_n1_su2_1_c, g_yuk_n1_su2_1, & g_yuk_n1_sl2_1_c, g_yuk_n1_sl2_1, g_yuk_n4_sd1_1_c, g_yuk_n4_sd1_1, & g_yuk_n4_su1_1_c, g_yuk_n4_su1_1, g_yuk_n4_sl1_1_c, g_yuk_n4_sl1_1, & g_yuk_n3_sd1_1_c, g_yuk_n3_sd1_1, g_yuk_n3_su1_1_c, g_yuk_n3_su1_1, & g_yuk_n3_sl1_1_c, g_yuk_n3_sl1_1, g_yuk_n2_sd1_1_c, g_yuk_n2_sd1_1, & g_yuk_n2_su1_1_c, g_yuk_n2_su1_1, g_yuk_n2_sl1_1_c, g_yuk_n2_sl1_1, & g_yuk_n1_sd1_1_c, g_yuk_n1_sd1_1, g_yuk_n1_su1_1_c, g_yuk_n1_su1_1, & g_yuk_n1_sl1_1_c, g_yuk_n1_sl1_1 complex(kind=default), public, save :: gh2sd2sd1_3, gh2su2su1_3, & gh2sl2sl1_3, gh1sd2sd1_3, gh1su2su1_3, gh1sl2sl1_3, & gh2sd1sd2_3, gh2su1su2_3, gh2sl1sl2_3, gh1sd1sd2_3, & gh1su1su2_3, gh1sl1sl2_3, gh2sd1sd1_3, & gh2su1su1_3, gh2sl1sl1_3, gh1sd1sd1_3, gh1su1su1_3, gh1sl1sl1_3, & gh2sn1sn1_2, gh1sn1sn1_2, ghsnsl1_2_c, ghsnsl1_2, & gh2sd2sd2_2, gh2su2su2_2, gh2sl2sl2_2, & gh1sd2sd2_2, gh1su2su2_2, gh1sl2sl2_2, & gh2sd1sd1_2, gh2su1su1_2, gh2sl1sl1_2, gh1sd1sd1_2, & gh1su1su1_2, gh1sl1sl1_2, gh2sn1sn1_1, gh1sn1sn1_1 !!! complex(kind=default), public, save :: ghsnsl2_1, ghsnsl2_1_c & !!! ghsnsl2_2_c, ghsnsl2_2, complex(kind=default), public, save :: ghsnsl1_1_c, ghsnsl1_1, & gh2sd2sd2_1, gh2su2su2_1, gh2sl2sl2_1, & gh1sd2sd2_1, gh1su2su2_1, gh1sl2sl2_1, & gh2sd1sd1_1, gh2su1su1_1, gh2sl1sl1_1, gh1sd1sd1_1, & gh1su1su1_1, gh1sl1sl1_1 complex(kind=default), public, save :: gasl2sl2_3, gasl2sl1_3, & gasl1sl2_3, gasl1sl1_3 !!! , gasl2sl2_2, gasl2sl1_2, gasl1sl2_2, & !!! gasl1sl1_2, gasl2sl2_1, gasl2sl1_1, gasl1sl2_1, gasl1sl1_1 complex(kind=default), public, save :: gasu2su2_3, gasu2su1_3, & gasu1su2_3, gasu1su1_3 !!! , gasu2su2_2, gasu2su1_2, gasu1su2_2, & !!! gasu1su1_2, gasu2su2_1, gasu2su1_1, gasu1su2_1, gasu1su1_1 complex(kind=default), public, save :: gasd2sd2_3, gasd2sd1_3, & gasd1sd2_3, gasd1sd1_3 !!! , gasd2sd2_2, gasd2sd1_2, gasd1sd2_2, & !!! gasd1sd1_2, gasd2sd2_1, gasd2sd1_1, gasd1sd2_1, gasd1sd1_1 complex(kind=default), public, save :: g_h43_321susd, g_h43_312susd, & g_h43_322susd, g_h43_311susd, g_h43_221susd, g_h43_212susd, g_h43_222susd, & g_h43_211susd, g_h43_121susd complex(kind=default), public, save :: g_h43_112susd, g_h43_122susd, & g_h43_111susd, g_h42_321susd, g_h42_312susd, g_h42_322susd, g_h42_311susd, & g_h42_211susd, g_h42_111susd, g_h41_321susd, g_h41_312susd, g_h41_322susd, & g_h41_311susd, g_h41_211susd, g_h41_111susd, & g_h4312slsn, g_h4311slsn, g_h3321slsl, g_h3312slsl, g_h2321slsl, & g_h2312slsl, g_h2322slsl, g_h2311slsl, g_h2311snsn, g_h1321slsl, & g_h1312slsl, g_h1322slsl, g_h1311slsl, g_h1311snsn, g_h3321sdsd, & g_h3312sdsd, g_h3321susu, g_h3312susu, g_h2321sdsd, g_h2312sdsd, & g_h2322sdsd, g_h2311sdsd, g_h2321susu, g_h2312susu, g_h2322susu, & g_h2311susu, g_h1321sdsd, g_h1312sdsd, g_h1322sdsd, g_h1311sdsd, & g_h1321susu, g_h1312susu, g_h1322susu, g_h1311susu, g_h4211slsn, & g_h2222slsl, g_h2211slsl complex(kind=default), public, save :: g_h2211snsn, & g_h1222slsl, g_h1211slsl, g_h1211snsn, g_h2222sdsd, g_h2211sdsd, & g_h2222susu, g_h2211susu, g_h1222sdsd, g_h1211sdsd, g_h1222susu, & g_h1211susu, g_h4111slsn, g_h2122slsl, g_h2111slsl, g_h2111snsn, & g_h1122slsl, g_h1111slsl, g_h1111snsn, g_h2122sdsd, g_h2111sdsd, & g_h2122susu, g_h2111susu, g_h1122sdsd, g_h1111sdsd, & g_h1122susu, g_h1111susu, gnzn_4_4, gnzn_3_3, gnzn_2_2, & gnzn_1_1, rnch_42, lnch_42, rnc_42 complex(kind=default), public, save :: gcicih1_1_1, gcicih1_2_2, & gcicih1_3_3, gcicih1_4_4, gcicih2_1_1, gcicih2_2_2, gcicih2_3_3, & gcicih2_4_4, gcicia_1_1, gcicia_2_2, gcicia_3_3, gcicia_4_4 !!! complex(kind=default), public, save :: g_h3112susu, g_h3121susu, & !!! g_h3112sdsd, g_h3121sdsd, g_h3112slsl, g_h3121slsl, g_h3212susu, & !!! g_h3221susu, g_h3212sdsd, g_h3221sdsd, g_h3212slsl, g_h3221slsl, & !!! complex(kind=default), public, save :: g_h4112slsn, g_h4212slsn, & complex(kind=default), public, save :: lnc_42, rnch_41, & lnch_41, rnc_41, lnc_41, rnch_32, lnch_32, rnc_32, lnc_32, rnch_31, & lnch_31, rnc_31, lnc_31, rnch_22, lnch_22, rnc_22, lnc_22, rnch_21, & lnch_21, rnc_21, lnc_21, rnch_12, lnch_12, rnc_12, lnc_12, rnch_11, & lnch_11, rnc_11, lnc_11, rcn_24, lcn_24, rcn_23, lcn_23, rcn_22, & lcn_22, rcn_21, lcn_21 complex(kind=default), public, save :: gch1c_1_1, gch1c_2_2, & gch2c_1_1, gch2c_2_2, gcac_1_1, gcac_2_2 complex(kind=default), public, save :: rcn_14, lcn_14, & rcn_13, lcn_13, rcn_12, lcn_12, rcn_11, lcn_11, ap_22, vp_22, & ap_21, vp_21, ap_12, vp_12, ap_11, vp_11, pnna_44, snna_44, & pnnh2_44, snnh2_44, pnnh1_44 complex(kind=default), public, save :: snnh1_44, axial0_44, vector0_44, & pnna_34, snna_34, pnnh2_34, snnh2_34, pnnh1_34, & snnh1_34, axial0_34, vector0_34, pnna_33, snna_33, & pnnh2_33, snnh2_33, pnnh1_33, snnh1_33, axial0_33, vector0_33 complex(kind=default), public, save :: pnna_24, & snna_24, pnnh2_24, snnh2_24, pnnh1_24, snnh1_24, & axial0_24, vector0_24, pnna_23, snna_23, pnnh2_23, snnh2_23, & pnnh1_23, snnh1_23, axial0_23, vector0_23, pnna_22, snna_22, & pnnh2_22, snnh2_22, pnnh1_22, snnh1_22, axial0_22, vector0_22, & pnna_14, snna_14, pnnh2_14, snnh2_14, pnnh1_14, snnh1_14, & axial0_14, vector0_14, pnna_13, snna_13, pnnh2_13, snnh2_13, & pnnh1_13, snnh1_13, axial0_13, vector0_13, pnna_12, snna_12, & pnnh2_12 complex(kind=default), public, save :: snnh2_12, pnnh1_12, snnh1_12, & axial0_12, vector0_12, pnna_11, snna_11, pnnh2_11, snnh2_11, & pnnh1_11, snnh1_11, axial0_11, vector0_11, gglwsu2sd1_3_3_c, gglwsu1sd2_3_3_c, & gglwsu2sd2_3_3_c, gglwsu1sd1_3_3_c, gglwsu2sd1_3_3, gglwsu1sd2_3_3, & gglwsu2sd2_3_3, gglwsu1sd1_3_3, gglwsu2sd1_3_2_c, gglwsu1sd2_3_2_c, & gglwsu2sd2_3_2_c, gglwsu1sd1_3_2_c, gglwsu2sd1_3_2, gglwsu1sd2_3_2, & gglwsu2sd2_3_2, gglwsu1sd1_3_2, gglwsu2sd1_3_1_c, gglwsu1sd2_3_1_c, & gglwsu2sd2_3_1_c, gglwsu1sd1_3_1_c, gglwsu2sd1_3_1, gglwsu1sd2_3_1, & gglwsu2sd2_3_1, gglwsu1sd1_3_1, gglwsu2sd1_2_3_c, gglwsu1sd2_2_3_c, & gglwsu2sd2_2_3_c, gglwsu1sd1_2_3_c, gglwsu2sd1_2_3, gglwsu1sd2_2_3, & gglwsu2sd2_2_3, gglwsu1sd1_2_3, gglwsu2sd1_2_2_c, gglwsu1sd2_2_2_c, & gglwsu2sd2_2_2_c, gglwsu1sd1_2_2_c, gglwsu2sd1_2_2, gglwsu1sd2_2_2, & gglwsu2sd2_2_2, gglwsu1sd1_2_2, gglwsu2sd1_2_1_c, gglwsu1sd2_2_1_c, & gglwsu2sd2_2_1_c, gglwsu1sd1_2_1_c, gglwsu2sd1_2_1, gglwsu1sd2_2_1, & gglwsu2sd2_2_1, gglwsu1sd1_2_1, gglwsu2sd1_1_3_c, gglwsu1sd2_1_3_c, & gglwsu2sd2_1_3_c, gglwsu1sd1_1_3_c, gglwsu2sd1_1_3, gglwsu1sd2_1_3 complex(kind=default), public, save :: gglwsu2sd2_1_3, gglwsu1sd1_1_3, & gglwsu2sd1_1_2_c, gglwsu1sd2_1_2_c, gglwsu2sd2_1_2_c, gglwsu1sd1_1_2_c, & gglwsu2sd1_1_2, gglwsu1sd2_1_2, gglwsu2sd2_1_2, gglwsu1sd1_1_2, & gglwsu2sd1_1_1_c, gglwsu1sd2_1_1_c, gglwsu2sd2_1_1_c, gglwsu1sd1_1_1_c, & gglwsu2sd1_1_1, gglwsu1sd2_1_1, gglwsu2sd2_1_1, gglwsu1sd1_1_1, mix_sd322, & mix_sd321, mix_sd312, mix_sd311, mix_sd222, mix_sd221, mix_sd212, & mix_sd211, mix_sd122, mix_sd121, mix_sd112, mix_sd111, mix_su322, & mix_su321, mix_su312, mix_su311, mix_su222, mix_su221, mix_su212, & mix_su211, mix_su122, mix_su121, mix_su112, mix_su111, mix_sl322, & mix_sl321, mix_sl312, mix_sl311, mix_sl222, mix_sl221, mix_sl212, & mix_sl211, mix_sl122, mix_sl121, mix_sl112, mix_sl111, gglsd2sd1_3, & gglsd1sd2_3, gglsd2sd2_3, gglsd1sd1_3, gglsu2su1_3, gglsu1su2_3, & gglsu2su2_3, gglsu1su1_3, gglsd2sd1_2, gglsd1sd2_2, gglsd2sd2_2, & gglsd1sd1_2, gglsu2su1_2, gglsu1su2_2, gglsu2su2_2 complex(kind=default), public, save :: gglsu1su1_2, gglsd2sd1_1, & gglsd1sd2_1, gglsd2sd2_1, gglsd1sd1_1, gglsu2su1_1, gglsu1su2_1, & gglsu2su2_1, gglsu1su1_1, gglpsqsq, gglglsqsq, gzwpsu2sd1_3_3_c, & gzwpsu1sd2_3_3_c, gzwpsu2sd2_3_3_c, gzwpsu1sd1_3_3_c, gzwpsu2sd1_3_3, & gzwpsu1sd2_3_3, gzwpsu2sd2_3_3, gzwpsu1sd1_3_3, gpwpsu2sd1_3_3_c, & gpwpsu1sd2_3_3_c, gpwpsu2sd2_3_3_c, gpwpsu1sd1_3_3_c, gpwpsu2sd1_3_3, & gpwpsu1sd2_3_3, gpwpsu2sd2_3_3, gpwpsu1sd1_3_3, gzwpsu2sd1_3_2_c, & gzwpsu1sd2_3_2_c, gzwpsu2sd2_3_2_c, gzwpsu1sd1_3_2_c, gzwpsu2sd1_3_2, & gzwpsu1sd2_3_2, gzwpsu2sd2_3_2, gzwpsu1sd1_3_2, gpwpsu2sd1_3_2_c, & gpwpsu1sd2_3_2_c, gpwpsu2sd2_3_2_c, gpwpsu1sd1_3_2_c, gpwpsu2sd1_3_2, & gpwpsu1sd2_3_2, gpwpsu2sd2_3_2, gpwpsu1sd1_3_2, gzwpsu2sd1_3_1_c, & gzwpsu1sd2_3_1_c, gzwpsu2sd2_3_1_c, gzwpsu1sd1_3_1_c, gzwpsu2sd1_3_1, & gzwpsu1sd2_3_1, gzwpsu2sd2_3_1, gzwpsu1sd1_3_1, gpwpsu2sd1_3_1_c, & gpwpsu1sd2_3_1_c, gpwpsu2sd2_3_1_c, gpwpsu1sd1_3_1_c, gpwpsu2sd1_3_1, & gpwpsu1sd2_3_1, gpwpsu2sd2_3_1, gpwpsu1sd1_3_1, gzwpsu2sd1_2_3_c, & gzwpsu1sd2_2_3_c, gzwpsu2sd2_2_3_c, gzwpsu1sd1_2_3_c, gzwpsu2sd1_2_3, & gzwpsu1sd2_2_3, gzwpsu2sd2_2_3, gzwpsu1sd1_2_3, gpwpsu2sd1_2_3_c, & gpwpsu1sd2_2_3_c complex(kind=default), public, save :: gpwpsu2sd2_2_3_c, gpwpsu1sd1_2_3_c, & gpwpsu2sd1_2_3, gpwpsu1sd2_2_3, gpwpsu2sd2_2_3, gpwpsu1sd1_2_3, & gzwpsu2sd1_2_2_c, gzwpsu1sd2_2_2_c, gzwpsu2sd2_2_2_c, gzwpsu1sd1_2_2_c, & gzwpsu2sd1_2_2, gzwpsu1sd2_2_2, gzwpsu2sd2_2_2, gzwpsu1sd1_2_2, & gpwpsu2sd1_2_2_c, gpwpsu1sd2_2_2_c, gpwpsu2sd2_2_2_c, gpwpsu1sd1_2_2_c, & gpwpsu2sd1_2_2, gpwpsu1sd2_2_2, gpwpsu2sd2_2_2, gpwpsu1sd1_2_2, & gzwpsu2sd1_2_1_c, gzwpsu1sd2_2_1_c, gzwpsu2sd2_2_1_c, gzwpsu1sd1_2_1_c, & gzwpsu2sd1_2_1, gzwpsu1sd2_2_1, gzwpsu2sd2_2_1, gzwpsu1sd1_2_1, & gpwpsu2sd1_2_1_c, gpwpsu1sd2_2_1_c, gpwpsu2sd2_2_1_c, gpwpsu1sd1_2_1_c, & gpwpsu2sd1_2_1, gpwpsu1sd2_2_1, gpwpsu2sd2_2_1, gpwpsu1sd1_2_1, & gzwpsu2sd1_1_3_c, gzwpsu1sd2_1_3_c, gzwpsu2sd2_1_3_c, gzwpsu1sd1_1_3_c, & gzwpsu2sd1_1_3, gzwpsu1sd2_1_3, gzwpsu2sd2_1_3, gzwpsu1sd1_1_3, & gpwpsu2sd1_1_3_c, gpwpsu1sd2_1_3_c, gpwpsu2sd2_1_3_c, gpwpsu1sd1_1_3_c, & gpwpsu2sd1_1_3, gpwpsu1sd2_1_3, gpwpsu2sd2_1_3, gpwpsu1sd1_1_3, & gzwpsu2sd1_1_2_c, gzwpsu1sd2_1_2_c, gzwpsu2sd2_1_2_c, gzwpsu1sd1_1_2_c, & gzwpsu2sd1_1_2, gzwpsu1sd2_1_2, gzwpsu2sd2_1_2, gzwpsu1sd1_1_2, & gpwpsu2sd1_1_2_c, gpwpsu1sd2_1_2_c, gpwpsu2sd2_1_2_c, gpwpsu1sd1_1_2_c, & gpwpsu2sd1_1_2, gpwpsu1sd2_1_2, gpwpsu2sd2_1_2 complex(kind=default), public, save :: gpwpsu1sd1_1_2, gzwpsu2sd1_1_1_c, & gzwpsu1sd2_1_1_c, gzwpsu2sd2_1_1_c, gzwpsu1sd1_1_1_c, gzwpsu2sd1_1_1, & gzwpsu1sd2_1_1, gzwpsu2sd2_1_1, gzwpsu1sd1_1_1, gpwpsu2sd1_1_1_c, & gpwpsu1sd2_1_1_c, gpwpsu2sd2_1_1_c, gpwpsu1sd1_1_1_c, gpwpsu2sd1_1_1, & gpwpsu1sd2_1_1, gpwpsu2sd2_1_1, gpwpsu1sd1_1_1, gwzsl2sn_3_c, gwzsl1sn_3_c, & gwzsl2sn_3, gwzsl1sn_3, gpwsl2sn_3_c, gpwsl1sn_3_c, gpwsl2sn_3, gpwsl1sn_3, & gwwsd2sd1_3, gwwsd1sd2_3, gwwsd2sd2_3, gwwsd1sd1_3, gwwsu2su1_3, & gwwsu1su2_3, gwwsu2su2_3, gwwsu1su1_3, gwwsn1sn1_3, gwwsl2sl1_3, & gwwsl1sl2_3, gwwsl2sl2_3, gwwsl1sl1_3, gzpsd2sd1_3, gzpsd1sd2_3, & gzpsd2sd2_3, gzpsd1sd1_3, gzpsu2su1_3, gzpsu1su2_3, gzpsu2su2_3, & gzpsu1su1_3, gzpsl2sl1_3, gzpsl1sl2_3, gzpsl2sl2_3, gzpsl1sl1_3, & gzzsd2sd1_3, gzzsd1sd2_3, gzzsd2sd2_3, gzzsd1sd1_3, gzzsu2su1_3, & gzzsu1su2_3, gzzsu2su2_3, gzzsu1su1_3, gzzsn1sn1_3, gzzsl2sl1_3, & gzzsl1sl2_3, gzzsl2sl2_3, gzzsl1sl1_3, gwzsl2sn_2_c, gwzsl1sn_2_c, & gwzsl2sn_2, gwzsl1sn_2, gpwsl2sn_2_c, gpwsl1sn_2_c complex(kind=default), public, save :: gpwsl2sn_2, gpwsl1sn_2, & gwwsd2sd1_2, gwwsd1sd2_2, gwwsd2sd2_2, gwwsd1sd1_2, gwwsu2su1_2, & gwwsu1su2_2, gwwsu2su2_2, gwwsu1su1_2, gwwsn1sn1_2, gwwsl2sl1_2, & gwwsl1sl2_2, gwwsl2sl2_2, gwwsl1sl1_2, gzpsd2sd1_2, gzpsd1sd2_2, & gzpsd2sd2_2, gzpsd1sd1_2, gzpsu2su1_2, gzpsu1su2_2, gzpsu2su2_2, & gzpsu1su1_2, gzpsl2sl1_2, gzpsl1sl2_2, gzpsl2sl2_2, gzpsl1sl1_2, & gzzsd2sd1_2, gzzsd1sd2_2, gzzsd2sd2_2, gzzsd1sd1_2, gzzsu2su1_2, & gzzsu1su2_2, gzzsu2su2_2, gzzsu1su1_2, gzzsn1sn1_2, gzzsl2sl1_2, & gzzsl1sl2_2, gzzsl2sl2_2, gzzsl1sl1_2, gwzsl2sn_1_c, gwzsl1sn_1_c, & gwzsl2sn_1, gwzsl1sn_1, gpwsl2sn_1_c, gpwsl1sn_1_c, gpwsl2sn_1, gpwsl1sn_1, & gwwsd2sd1_1, gwwsd1sd2_1, gwwsd2sd2_1, gwwsd1sd1_1, gwwsu2su1_1, & gwwsu1su2_1, gwwsu2su2_1, gwwsu1su1_1, gwwsn1sn1_1, gwwsl2sl1_1, & gwwsl1sl2_1, gwwsl2sl2_1, gwwsl1sl1_1, gzpsd2sd1_1, gzpsd1sd2_1, & gzpsd2sd2_1, gzpsd1sd1_1, gzpsu2su1_1, gzpsu1su2_1, gzpsu2su2_1, & gzpsu1su1_1 complex(kind=default), public, save :: gzpsl2sl1_1, gzpsl1sl2_1, & gzpsl2sl2_1, gzpsl1sl1_1, gzzsd2sd1_1, gzzsd1sd2_1, gzzsd2sd2_1, & gzzsd1sd1_1, gzzsu2su1_1, gzzsu1su2_1, gzzsu2su2_1, gzzsu1su1_1, & gzzsn1sn1_1, gzzsl2sl1_1, gzzsl1sl2_1, gzzsl2sl2_1, gzzsl1sl1_1, gppsdsd, & gppsusu, gppslsl, gsl2_3snw_c, gsl1_3snw_c, gsl2_3snw, gsl1_3snw, & gsd2zsd1_3, gsd1zsd2_3, gsd2zsd2_3, gsd1zsd1_3, gsu2zsu1_3, gsu1zsu2_3, & gsu2zsu2_3, gsu1zsu1_3, gsn1zsn1_3, gsl2zsl1_3, gsl1zsl2_3, gsl2zsl2_3, & gsl1zsl1_3, gsl2_2snw_c, gsl1_2snw_c, gsl2_2snw, gsl1_2snw, gsd2zsd1_2, & gsd1zsd2_2, gsd2zsd2_2, gsd1zsd1_2, gsu2zsu1_2, gsu1zsu2_2, gsu2zsu2_2, & gsu1zsu1_2, gsn1zsn1_2, gsl2zsl1_2, gsl1zsl2_2, gsl2zsl2_2, gsl1zsl1_2, & gsl2_1snw_c, gsl1_1snw_c, gsl2_1snw, gsl1_1snw, gsd2zsd1_1, gsd1zsd2_1, & gsd2zsd2_1, gsd1zsd1_1, gsu2zsu1_1, gsu1zsu2_1, gsu2zsu2_1, gsu1zsu1_1, & gsn1zsn1_1, gsl2zsl1_1, gsl1zsl2_1 complex(kind=default), public, save :: gsl2zsl2_1, gsl1zsl1_1, & gs2ws1_3_3_c, gs1ws2_3_3_c, gs2ws2_3_3_c, gs1ws1_3_3_c, gs2ws1_3_3, & gs1ws2_3_3, gs2ws2_3_3, gs1ws1_3_3, gs2ws1_3_2_c, gs1ws2_3_2_c, & gs2ws2_3_2_c, gs1ws1_3_2_c, gs2ws1_3_2, gs1ws2_3_2, gs2ws2_3_2, & gs1ws1_3_2, gs2ws1_3_1_c, gs1ws2_3_1_c, gs2ws2_3_1_c, gs1ws1_3_1_c, & gs2ws1_3_1, gs1ws2_3_1, gs2ws2_3_1, gs1ws1_3_1, gs2ws1_2_3_c, & gs1ws2_2_3_c, gs2ws2_2_3_c, gs1ws1_2_3_c, gs2ws1_2_3, gs1ws2_2_3, & gs2ws2_2_3, gs1ws1_2_3, gs2ws1_2_2_c, gs1ws2_2_2_c, gs2ws2_2_2_c, & gs1ws1_2_2_c, gs2ws1_2_2, gs1ws2_2_2, gs2ws2_2_2, gs1ws1_2_2, & gs2ws1_2_1_c, gs1ws2_2_1_c, gs2ws2_2_1_c, gs1ws1_2_1_c, gs2ws1_2_1, & gs1ws2_2_1, gs2ws2_2_1, gs1ws1_2_1, gs2ws1_1_3_c, gs1ws2_1_3_c, & gs2ws2_1_3_c, gs1ws1_1_3_c, gs2ws1_1_3, gs1ws2_1_3, gs2ws2_1_3, & gs1ws1_1_3, gs2ws1_1_2_c, gs1ws2_1_2_c, gs2ws2_1_2_c, gs1ws1_1_2_c, & gs2ws1_1_2, gs1ws2_1_2, gs2ws2_1_2, gs1ws1_1_2, gs2ws1_1_1_c, & gs1ws2_1_1_c complex(kind=default), public, save :: gs2ws2_1_1_c, gs1ws1_1_1_c, & gs2ws1_1_1, gs1ws2_1_1, gs2ws2_1_1, gs1ws1_1_1, g_yuk15_3, g_yuk14_3, & g_yuk13_3, g_yuk12_3, g_yuk11_3, g_yuk10_3, g_yuk9_3, g_yuk8_3, & g_yuk7_3, g_yuk6_3, g_yuk15_2, g_yuk14_2, g_yuk13_2, g_yuk12_2, & g_yuk11_2, g_yuk10_2, g_yuk9_2, g_yuk8_2, g_yuk7_2, g_yuk6_2, g_yuk15_1, & g_yuk14_1, g_yuk13_1, g_yuk12_1, g_yuk11_1, g_yuk10_1, g_yuk9_1, & g_yuk8_1, g_yuk7_1, g_yuk6_1, ghhww, gh2h2ww, gh1h1ww, gaaww, ghh2wp, & ghawp, ghawz, gh2az, gh1az, ghaw, ghh1wp, ghh2wz, ghh1wz, ghphmpz, & ghphmpp, ghphmzz, gh2h2zz, gh1h1zz, gaazz, ghhp, ghhz, gh2zz, gh1zz, & ghh2w, ghh1w, gh2ww, gh1ww, gh4_11, gh4_10, gh4_9, gh4_8, gh4_7, gh4_6, & gh4_5, gh4_4 complex(kind=default), public, save :: gh4_3, gh4_2, gh4_1, gh3_8, & gh3_7, gh3_6, gh3_5, gh3_4, gh3_3, gh3_2, gh3_1, mu, ad_3, au_3, al_3, & ad_2, au_2, al_2, ad_1, au_1, al_1, mv_22, mv_21, mv_12, mv_11, mu_22, & mu_21, mu_12, mu_11, mn_44, mn_43, mn_42, mn_41, mn_34, mn_33, mn_32, & mn_31, mn_24, mn_23, mn_22, mn_21, mn_14, mn_13, mn_12, mn_11 !!! complex(kind=default), public, save :: sinthsu3, & !!! sinthsu2, sinthsu1, sinthsd3, sinthsd2, sinthsd1, sinthsl3, sinthsl2, & !!! sinthsl1, costhsu3, costhsu2, costhsu1, costhsd3, costhsd2, costhsd1, & !!! costhsl3, costhsl2, costhsl1 complex(kind=default), public, save :: eta1, eta2, eta3, eta4 complex(kind=default), public, save :: eidelta, cosckm23, cosckm13, & cosckm12, vckm_33, vckm_32, vckm_31, vckm_23, vckm_22, vckm_21, vckm_13, & vckm_12, vckm_11, gpzww, gppww, gzzww, gw4, igwww, igzww, iqw, igs, & gssq complex(kind=default), public, save :: gccq_3_3_c, gccq_3_3, & gccq_3_2_c, gccq_3_2, gccq_3_1_c, gccq_3_1, gccq_2_3_c, gccq_2_3, & gccq_2_2_c, gccq_2_2, gccq_2_1_c, gccq_2_1, gccq_1_3_c, gccq_1_3, & gccq_1_2_c, gccq_1_2, gccq_1_1_c, gccq_1_1 complex(kind=default), dimension(2), public, save :: g_yuk_gsd2_3_c, & g_yuk_gsd2_3, g_yuk_gsu2_3_c, g_yuk_gsu2_3, g_yuk_gsd1_3_c, & g_yuk_gsd1_3, g_yuk_gsu1_3_c, g_yuk_gsu1_3, g_yuk_n4_sd2_3_c, & g_yuk_n4_sd2_3, g_yuk_n4_su2_3_c, g_yuk_n4_su2_3, g_yuk_n4_sl2_3_c, & g_yuk_n4_sl2_3, g_yuk_n3_sd2_3_c, g_yuk_n3_sd2_3, g_yuk_n3_su2_3_c, & g_yuk_n3_su2_3, g_yuk_n3_sl2_3_c, g_yuk_n3_sl2_3, g_yuk_n2_sd2_3_c, & g_yuk_n2_sd2_3, g_yuk_n2_su2_3_c, g_yuk_n2_su2_3, g_yuk_n2_sl2_3_c, & g_yuk_n2_sl2_3, g_yuk_n1_sd2_3_c, g_yuk_n1_sd2_3, g_yuk_n1_su2_3_c, & g_yuk_n1_su2_3, g_yuk_n1_sl2_3_c, g_yuk_n1_sl2_3, g_yuk_n4_sd1_3_c, & g_yuk_n4_sd1_3, g_yuk_n4_su1_3_c, g_yuk_n4_su1_3, g_yuk_n4_sl1_3_c, & g_yuk_n4_sl1_3, g_yuk_n3_sd1_3_c, g_yuk_n3_sd1_3, g_yuk_n3_su1_3_c, & g_yuk_n3_su1_3, g_yuk_n3_sl1_3_c, g_yuk_n3_sl1_3, g_yuk_n2_sd1_3_c, & g_yuk_n2_sd1_3, g_yuk_n2_su1_3_c, g_yuk_n2_su1_3, g_yuk_n2_sl1_3_c, & g_yuk_n2_sl1_3, g_yuk_n1_sd1_3_c, g_yuk_n1_sd1_3, g_yuk_n1_su1_3_c, & g_yuk_n1_su1_3, g_yuk_n1_sl1_3_c, g_yuk_n1_sl1_3 complex(kind=default), dimension(2), public, save :: g_yuk_ch2_su2_3_3_c, & g_yuk_ch2_su2_3_3, g_yuk_ch2_sd2_3_3_c, g_yuk_ch2_sd2_3_3, & g_yuk_ch2_su1_3_3_c, g_yuk_ch2_su1_3_3, g_yuk_ch2_sd1_3_3_c, & g_yuk_ch2_sd1_3_3, g_yuk_ch1_su2_3_3_c, g_yuk_ch1_su2_3_3, & g_yuk_ch1_sd2_3_3_c, g_yuk_ch1_sd2_3_3, g_yuk_ch1_su1_3_3_c, & g_yuk_ch1_su1_3_3, g_yuk_ch1_sd1_3_3_c, g_yuk_ch1_sd1_3_3, & g_yuk_ch2_su2_3_2_c, g_yuk_ch2_su2_3_2, g_yuk_ch2_sd2_3_2_c, & g_yuk_ch2_sd2_3_2, g_yuk_ch2_su1_3_2_c, g_yuk_ch2_su1_3_2, & g_yuk_ch2_sd1_3_2_c, g_yuk_ch2_sd1_3_2, g_yuk_ch1_su2_3_2_c, & g_yuk_ch1_su2_3_2, g_yuk_ch1_sd2_3_2_c, g_yuk_ch1_sd2_3_2, & g_yuk_ch1_su1_3_2_c, g_yuk_ch1_su1_3_2, g_yuk_ch1_sd1_3_2_c, & g_yuk_ch1_sd1_3_2, g_yuk_ch2_su2_3_1_c, g_yuk_ch2_su2_3_1, & g_yuk_ch2_sd2_3_1_c, g_yuk_ch2_sd2_3_1, g_yuk_ch2_su1_3_1_c, & g_yuk_ch2_su1_3_1, g_yuk_ch2_sd1_3_1_c, g_yuk_ch2_sd1_3_1, & g_yuk_ch1_su2_3_1_c, g_yuk_ch1_su2_3_1, g_yuk_ch1_sd2_3_1_c, & g_yuk_ch1_sd2_3_1, g_yuk_ch1_su1_3_1_c, g_yuk_ch1_su1_3_1, & g_yuk_ch1_sd1_3_1_c, g_yuk_ch1_sd1_3_1, g_yuk_ch2_su2_2_3_c, & g_yuk_ch2_su2_2_3, g_yuk_ch2_sd2_2_3_c, g_yuk_ch2_sd2_2_3, & g_yuk_ch2_su1_2_3_c, g_yuk_ch2_su1_2_3, g_yuk_ch2_sd1_2_3_c, & g_yuk_ch2_sd1_2_3, g_yuk_ch1_su2_2_3_c, g_yuk_ch1_su2_2_3, & g_yuk_ch1_sd2_2_3_c, g_yuk_ch1_sd2_2_3, g_yuk_ch1_su1_2_3_c, & g_yuk_ch1_su1_2_3, g_yuk_ch1_sd1_2_3_c, g_yuk_ch1_sd1_2_3, & g_yuk_ch2_su2_1_3_c, g_yuk_ch2_su2_1_3, g_yuk_ch2_sd2_1_3_c, & g_yuk_ch2_sd2_1_3, g_yuk_ch2_su1_1_3_c, g_yuk_ch2_su1_1_3, & g_yuk_ch2_sd1_1_3_c, g_yuk_ch2_sd1_1_3, g_yuk_ch1_su2_1_3_c, & g_yuk_ch1_su2_1_3, g_yuk_ch1_sd2_1_3_c, g_yuk_ch1_sd2_1_3, & g_yuk_ch1_su1_1_3_c, g_yuk_ch1_su1_1_3, g_yuk_ch1_sd1_1_3_c, & g_yuk_ch1_sd1_1_3, g_yuk_ch2_sn1_3_c, g_yuk_ch2_sn1_3, & g_yuk_ch1_sn1_3_c, g_yuk_ch1_sn1_3 complex(kind=default), dimension(2), public, save :: gcac_2_1, & gch2c_2_1, gch1c_2_1, gcac_1_2, gch2c_1_2, gch1c_1_2, gcicia_3_4, & gcicih2_3_4, gcicih1_3_4, gcicia_2_4, gcicih2_2_4, gcicih1_2_4, & gcicia_2_3, gcicih2_2_3, gcicih1_2_3, gcicia_1_4, gcicih2_1_4, & gcicih1_1_4, gcicia_1_3, gcicih2_1_3, gcicih1_1_3, gcicia_1_2, & gcicih2_1_2, gcicih1_1_2, g_chn_4_2, gcwn_2_4, g_chn_3_2, gcwn_2_3, & g_chn_2_2, gcwn_2_2, g_chn_1_2, gcwn_2_1, g_chn_4_1, gcwn_1_4, g_chn_3_1, & gcwn_1_3, g_chn_2_1, gcwn_1_2, g_chn_1_1, gcwn_1_1, g_nhc_4_2, gnwc_4_2, & g_nhc_4_1, gnwc_4_1, g_nhc_3_2, gnwc_3_2, g_nhc_3_1, gnwc_3_1, g_nhc_2_2, & gnwc_2_2, g_nhc_2_1, gnwc_2_1, g_nhc_1_2, gnwc_1_2, g_nhc_1_1, gnwc_1_1, & gczc_2_2, gczc_2_1, gczc_1_2, gczc_1_1, gnzn_3_4, gnzn_2_4, gnzn_2_3, & gnzn_1_4, gnzn_1_3, gnzn_1_2, g_yuk2_3_3, g_yuk2_3_2, g_yuk2_3_1, & g_yuk2_2_3, g_yuk2_1_3, g_yuk1_3_3, g_yuk1_3_2, g_yuk1_3_1, g_yuk1_2_3, & g_yuk1_1_3 complex(kind=default), public, save :: gglglh, gglglhh, gglgla, gpph, & gpphh, gppa + complex(kind=default), dimension(2), public, save :: gnna + real(kind=default) :: neu2_dec contains subroutine import_from_whizard (par_array, scheme) - real(default), dimension(138), intent(in) :: par_array + real(default), dimension(142), intent(in) :: par_array integer, intent(in) :: scheme type :: parameter_set !!! DON'T EVEN THINK OF CHANGING THE ORDER real(default) :: gf real(default) :: mZ real(default) :: wZ real(default) :: mW real(default) :: wW real(default) :: me real(default) :: mmu real(default) :: mtau real(default) :: ms real(default) :: mc real(default) :: mb real(default) :: mtop real(default) :: wtop real(default) :: alphas real(default) :: mtype real(default) :: m_zero real(default) :: m_half real(default) :: A0 real(default) :: tanb real(default) :: sgn_mu real(default) :: lambda real(default) :: m_mes real(default) :: n5 real(default) :: c_grav real(default) :: m_grav real(default) :: ae_33 real(default) :: au_33 real(default) :: ad_33 real(default) :: mh real(default) :: wh real(default) :: mhh real(default) :: mha real(default) :: mhpm real(default) :: whh real(default) :: whpm real(default) :: wha real(default) :: al_h real(default) :: mu_h real(default) :: tanb_h real(default) :: msu1 real(default) :: msd1 real(default) :: msc1 real(default) :: mss1 real(default) :: mstop1 real(default) :: msb1 real(default) :: msu2 real(default) :: msd2 real(default) :: msc2 real(default) :: mss2 real(default) :: mstop2 real(default) :: msb2 real(default) :: mse1 real(default) :: msne real(default) :: msmu1 real(default) :: msnmu real(default) :: mstau1 real(default) :: msntau real(default) :: mse2 real(default) :: msmu2 real(default) :: mstau2 real(default) :: mgg real(default) :: mch1 real(default) :: mch2 real(default) :: mneu1 real(default) :: mneu2 real(default) :: mneu3 real(default) :: mneu4 real(default) :: wsu1 real(default) :: wsd1 real(default) :: wsc1 real(default) :: wss1 real(default) :: wstop1 real(default) :: wsb1 real(default) :: wsu2 real(default) :: wsd2 real(default) :: wsc2 real(default) :: wss2 real(default) :: wstop2 real(default) :: wsb2 real(default) :: wse1 real(default) :: wsne real(default) :: wsmu1 real(default) :: wsnmu real(default) :: wstau1 real(default) :: wsntau real(default) :: wse2 real(default) :: wsmu2 real(default) :: wstau2 real(default) :: wgg real(default) :: wch1 real(default) :: wch2 real(default) :: wneu1 real(default) :: wneu2 real(default) :: wneu3 real(default) :: wneu4 real(default) :: mt_11 real(default) :: mt_12 real(default) :: mt_21 real(default) :: mt_22 real(default) :: mb_11 real(default) :: mb_12 real(default) :: mb_21 real(default) :: mb_22 real(default) :: ml_11 real(default) :: ml_12 real(default) :: ml_21 real(default) :: ml_22 real(default) :: mn_11 real(default) :: mn_12 real(default) :: mn_13 real(default) :: mn_14 real(default) :: mn_21 real(default) :: mn_22 real(default) :: mn_23 real(default) :: mn_24 real(default) :: mn_31 real(default) :: mn_32 real(default) :: mn_33 real(default) :: mn_34 real(default) :: mn_41 real(default) :: mn_42 real(default) :: mn_43 real(default) :: mn_44 real(default) :: mu_11 real(default) :: mu_12 real(default) :: mu_21 real(default) :: mu_22 real(default) :: mv_11 real(default) :: mv_12 real(default) :: mv_21 real(default) :: mv_22 real(default) :: hgg_fac real(default) :: hgg_sq real(default) :: haa_fac + real(default) :: nna_v_fac + real(default) :: nna_a_fac + real(default) :: nna_v + real(default) :: nna_a real(default) :: v real(default) :: cw real(default) :: sw real(default) :: ee end type parameter_set type(parameter_set) :: par real(kind=default) :: qelep, qeup, qedwn, v par%gf = par_array(1) par%mZ = par_array(2) par%wZ = par_array(3) par%mW = par_array(4) par%wW = par_array(5) par%me = par_array(6) par%mmu = par_array(7) par%mtau = par_array(8) par%ms = par_array(9) par%mc = par_array(10) par%mb = par_array(11) par%mtop = par_array(12) par%wtop = par_array(13) par%alphas = par_array(14) par%mtype = par_array(15) par%m_zero = par_array(16) par%m_half = par_array(17) par%A0 = par_array(18) par%tanb = par_array(19) par%sgn_mu = par_array(20) par%lambda = par_array(21) par%m_mes = par_array(22) par%n5 = par_array(23) par%c_grav = par_array(24) par%m_grav = par_array(25) par%ae_33 = par_array(26) par%au_33 = par_array(27) par%ad_33 = par_array(28) par%mh = par_array(29) par%wh = par_array(30) par%mhh = par_array(31) par%mha = par_array(32) par%mhpm = par_array(33) par%whh = par_array(34) par%whpm = par_array(35) par%wha = par_array(36) par%al_h = par_array(37) par%mu_h = par_array(38) par%tanb_h = par_array(39) par%msu1 = par_array(40) par%msd1 = par_array(41) par%msc1 = par_array(42) par%mss1 = par_array(43) par%mstop1 = par_array(44) par%msb1 = par_array(45) par%msu2 = par_array(46) par%msd2 = par_array(47) par%msc2 = par_array(48) par%mss2 = par_array(49) par%mstop2 = par_array(50) par%msb2 = par_array(51) par%mse1 = par_array(52) par%msne = par_array(53) par%msmu1 = par_array(54) par%msnmu = par_array(55) par%mstau1 = par_array(56) par%msntau = par_array(57) par%mse2 = par_array(58) par%msmu2 = par_array(59) par%mstau2 = par_array(60) par%mgg = par_array(61) par%mch1 = par_array(62) par%mch2 = par_array(63) par%mneu1 = par_array(64) par%mneu2 = par_array(65) par%mneu3 = par_array(66) par%mneu4 = par_array(67) par%wsu1 = par_array(68) par%wsd1 = par_array(69) par%wsc1 = par_array(70) par%wss1 = par_array(71) par%wstop1 = par_array(72) par%wsb1 = par_array(73) par%wsu2 = par_array(74) par%wsd2 = par_array(75) par%wsc2 = par_array(76) par%wss2 = par_array(77) par%wstop2 = par_array(78) par%wsb2 = par_array(79) par%wse1 = par_array(80) par%wsne = par_array(81) par%wsmu1 = par_array(82) par%wsnmu = par_array(83) par%wstau1 = par_array(84) par%wsntau = par_array(85) par%wse2 = par_array(86) par%wsmu2 = par_array(87) par%wstau2 = par_array(88) par%wgg = par_array(89) par%wch1 = par_array(90) par%wch2 = par_array(91) par%wneu1 = par_array(92) par%wneu2 = par_array(93) par%wneu3 = par_array(94) par%wneu4 = par_array(95) par%mt_11 = par_array(96) par%mt_12 = par_array(97) par%mt_21 = par_array(98) par%mt_22 = par_array(99) par%mb_11 = par_array(100) par%mb_12 = par_array(101) par%mb_21 = par_array(102) par%mb_22 = par_array(103) par%ml_11 = par_array(104) par%ml_12 = par_array(105) par%ml_21 = par_array(106) par%ml_22 = par_array(107) par%mn_11 = par_array(108) par%mn_12 = par_array(109) par%mn_13 = par_array(110) par%mn_14 = par_array(111) par%mn_21 = par_array(112) par%mn_22 = par_array(113) par%mn_23 = par_array(114) par%mn_24 = par_array(115) par%mn_31 = par_array(116) par%mn_32 = par_array(117) par%mn_33 = par_array(118) par%mn_34 = par_array(119) par%mn_41 = par_array(120) par%mn_42 = par_array(121) par%mn_43 = par_array(122) par%mn_44 = par_array(123) par%mu_11 = par_array(124) par%mu_12 = par_array(125) par%mu_21 = par_array(126) par%mu_22 = par_array(127) par%mv_11 = par_array(128) par%mv_12 = par_array(129) par%mv_21 = par_array(130) par%mv_22 = par_array(131) par%hgg_fac= par_array(132) par%hgg_sq = par_array(133) par%haa_fac= par_array(134) - par%v = par_array(135) - par%cw = par_array(136) - par%sw = par_array(137) - par%ee = par_array(138) + par%nna_v_fac = par_array(135) + par%nna_a_fac = par_array(136) + par%nna_v = par_array(137) + par%nna_a = par_array(138) + par%v = par_array(139) + par%cw = par_array(140) + par%sw = par_array(141) + par%ee = par_array(142) mass(1:70) = 0 width(1:70) = 0 mass(3) = par%ms mass(4) = par%mc mass(5) = par%mb mass(6) = par%mtop width(6) = par%wtop mass(11) = par%me mass(13) = par%mmu mass(15) = par%mtau mass(23) = par%mZ width(23) = par%wZ mass(24) = par%mW width(24) = par%wW mass(25) = par%mh width(25) = par%wh mass(26) = xi0 * mass(23) width(26) = 0 mass(27) = xipm * mass(24) width(27) = 0 mass(35) = par%mHH width(35) = par%wHH mass(36) = par%mHA width(36) = par%wHA mass(37) = par%mHpm width(37) = par%wHpm mass(41) = par%msd1 width(41) = par%wsd1 mass(42) = par%msu1 width(42) = par%wsu1 mass(43) = par%mss1 width(43) = par%wss1 mass(44) = par%msc1 width(44) = par%wsc1 mass(45) = par%msb1 width(45) = par%wsb1 mass(46) = par%mstop1 width(46) = par%wstop1 mass(47) = par%msd2 width(47) = par%wsd2 mass(48) = par%msu2 width(48) = par%wsu2 mass(49) = par%mss2 width(49) = par%wss2 mass(50) = par%msc2 width(50) = par%wsc2 mass(51) = par%msb2 width(51) = par%wsb2 mass(52) = par%mstop2 width(52) = par%wstop2 mass(53) = par%mse1 width(53) = par%wse1 mass(54) = par%msne width(54) = par%wsne mass(55) = par%msmu1 width(55) = par%wsmu1 mass(56) = par%msnmu width(56) = par%wsnmu mass(57) = par%mstau1 width(57) = par%wstau1 mass(58) = par%msntau width(58) = par%wsntau mass(59) = par%mse2 width(59) = par%wse2 mass(61) = par%msmu2 width(61) = par%wsmu2 mass(63) = par%mstau2 width(63) = par%wstau2 mass(64) = par%mgg width(64) = par%wgg mass(65) = abs(par%mneu1) width(65) = par%wneu1 mass(66) = abs(par%mneu2) width(66) = par%wneu2 mass(67) = abs(par%mneu3) width(67) = par%wneu3 mass(68) = abs(par%mneu4) width(68) = par%wneu4 mass(69) = abs(par%mch1) width(69) = par%wch1 mass(70) = abs(par%mch2) width(70) = par%wch2 sigch1 = sign (1._default, par%mch1) sigch2 = sign (1._default, par%mch2) sign1 = sign (1, int(par%mneu1)) sign2 = sign (1, int(par%mneu2)) sign3 = sign (1, int(par%mneu3)) sign4 = sign (1, int(par%mneu4)) vckm_11 = 1 vckm_12 = 0 vckm_13 = 0 vckm_21 = 0 vckm_22 = 1 vckm_23 = 0 vckm_31 = 0 vckm_32 = 0 vckm_33 = 1 v = 2 * par%mW * par%sw / par%ee e = par%ee !!! This should not be in the color flow basis !!! as = par%alphas tanb = par%tanb_h tana = tan(par%al_h) select case (sign1) case (1) eta1 = (1.0_default,0.0_default) case (-1) eta1 = (0.0_default,1.0_default) case default print *, 'sign1', sign1 stop "parameters_MSSM: No definite sign neutralino1" end select select case (sign2) case (1) eta2 = (1.0_default,0.0_default) case (-1) eta2 = (0.0_default,1.0_default) case default print *, 'sign2', sign2 stop "parameters_MSSM: No definite sign neutralino2" end select select case (sign3) case (1) eta3 = (1.0_default,0.0_default) case (-1) eta3 = (0.0_default,1.0_default) case default print *, 'sign3', sign3 stop "parameters_MSSM: No definite sign neutralino3" end select select case (sign4) case (1) eta4 = (1.0_default,0.0_default) case (-1) eta4 = (0.0_default,1.0_default) case default print *, 'sign4', sign4 stop "parameters_MSSM: No definite sign neutralino4" end select sinthw = par%sw sin2thw = sinthw**2 costhw = par%cw qelep = - 1.0_default qeup = 2.0_default / 3.0_default qedwn = - 1.0_default / 3.0_default call setup_parameters1 call setup_parameters2 call setup_parameters3 call setup_parameters4 call setup_parameters5 call setup_parameters6 call setup_parameters7 call setup_parameters8 call setup_parameters9 call setup_parameters10 call setup_parameters11 call setup_parameters12 call setup_parameters13 call setup_parameters14 call setup_parameters15 call setup_parameters16 call setup_parameters17 contains subroutine setup_parameters1 () g = (e / sinthw) gz = (g / costhw) !!! Color flow basis, divide by sqrt(2) gs = sqrt(2.0_default * PI * par%alphas) igs = (imago * gs) vev = ((2.0_default * mass(24)) / g) q_lep = (- 1.0_default) q_up = (2.0_default / 3.0_default) q_down = (- 1.0_default / 3.0_default) qlep = - e * qelep !!! This is the negative particle charge !!! qup = - e * qeup !!! This is the negative particle charge !!! qdwn = - e * qedwn !!! This is the negative particle charge !!! qchar = ( - e) !!! This is the negative particle charge !!! ! qlep = ((-1.0_default) * e) ! qup = ((2.0_default / 3.0_default) * e) ! qdwn = (((-1.0_default) / 3.0_default) * e) gcc = (g / (2.0_default * sqrt (2.0_default))) gssq = (gs / sqrt (2.0_default)) iqw = imago * e igzww = imago * g * costhw gw4 = (g**2) gzzww = ((g**2) * (costhw**2)) gppww = (e**2) gpzww = (e * g * costhw) sinal = sin (par%al_h) cosal = cos (par%al_h) sinbe = (tanb / sqrt ((1.0_default + (tanb**2)))) cosbe = (1.0_default / sqrt ((1.0_default + (tanb**2)))) eidelta = (cosd + (imago * sind)) cos2be = ((cosbe**2) - (sinbe**2)) cos2al = ((cosal**2) - (sinal**2)) sin2be = (2.0_default * cosbe * sinbe) sin2al = (2.0_default * cosal * sinal) sin4al = (2.0_default * cos2al * sin2al) sin4be = (2.0_default * cos2be * sin2be) cos4be = ((cos2be**2) - (sin2be**2)) cosapb = ((cosal * cosbe) - (sinal * sinbe)) cosamb = ((cosal * cosbe) + (sinal * sinbe)) sinapb = ((cosal * sinbe) + (sinal * cosbe)) sinamb = ((sinal * cosbe) - (sinbe * cosal)) sin2am2b = (2.0_default * sinamb * cosamb) cos2am2b = ((cosamb**2) - (sinamb**2)) mn_11 = eta1 * par%mn_11 mn_12 = eta1 * par%mn_12 mn_13 = eta1 * par%mn_13 mn_14 = eta1 * par%mn_14 mn_21 = eta2 * par%mn_21 mn_22 = eta2 * par%mn_22 mn_23 = eta2 * par%mn_23 mn_24 = eta2 * par%mn_24 mn_31 = eta3 * par%mn_31 mn_32 = eta3 * par%mn_32 mn_33 = eta3 * par%mn_33 mn_34 = eta3 * par%mn_34 mn_41 = eta4 * par%mn_41 mn_42 = eta4 * par%mn_42 mn_43 = eta4 * par%mn_43 mn_44 = eta4 * par%mn_44 !!! Checked by JR !!! mu_11 = par%mu_11 !!! Rotat. matrix containing phi_R mu_12 = par%mu_12 !!! Rotat. matrix containing phi_R mu_21 = par%mu_21 !!! Rotat. matrix containing phi_R mu_22 = par%mu_22 !!! Rotat. matrix containing phi_R mv_11 = sigch1 * par%mv_11 !!! Rotat. matrix containing phi_L mv_12 = sigch1 * par%mv_12 !!! Rotat. matrix containing phi_L mv_21 = sigch2 * par%mv_21 !!! Rotat. matrix containing phi_L mv_22 = sigch2 * par%mv_22 !!! Rotat. matrix containing phi_L al_1 = 0 au_1 = 0 ad_1 = 0 al_2 = 0 au_2 = 0 ad_2 = 0 al_3 = par%Ae_33 au_3 = par%Au_33 ad_3 = par%Ad_33 mu = par%mu_h mix_sl111 = 1.0_default mix_sl112 = 0.0_default mix_sl122 = 1.0_default mix_sl121 = 0.0_default mix_sl211 = 1.0_default mix_sl212 = 0.0_default mix_sl222 = 1.0_default mix_sl221 = 0.0_default mix_su111 = 1.0_default mix_su112 = 0.0_default mix_su122 = 1.0_default mix_su121 = 0.0_default mix_su211 = 1.0_default mix_su212 = 0.0_default mix_su222 = 1.0_default mix_su221 = 0.0_default mix_sd111 = 1.0_default mix_sd112 = 0.0_default mix_sd122 = 1.0_default mix_sd121 = 0.0_default mix_sd211 = 1.0_default mix_sd212 = 0.0_default mix_sd222 = 1.0_default mix_sd221 = 0.0_default !!! Checked by JR !!! mix_sl311 = par%ml_11 mix_sl312 = par%ml_12 mix_sl321 = par%ml_21 mix_sl322 = par%ml_22 mix_su311 = par%mt_11 mix_su312 = par%mt_12 mix_su321 = par%mt_21 mix_su322 = par%mt_22 mix_sd311 = par%mb_11 mix_sd312 = par%mb_12 mix_sd321 = par%mb_21 mix_sd322 = par%mb_22 gh3_1 = ((mass(23) * (gz / 2.0_default) * cos2be * cosapb) - & (mass(24) * g * cosamb)) gh3_2 = ((mass(24) * g * sinamb) - ( & (gz / 2.0_default) * mass(23) * cos2be * sinapb)) gh3_3 = ((gz / 2.0_default) * mass(23) * ( & (2.0_default * sin2al * cosapb) + (cos2al * sinapb))) gh3_4 = ( - ( & (3.0_default / 2.0_default) * gz * mass(23) * cos2al * cosapb)) gh3_5 = ( - ( & (3.0_default / 2.0_default) * gz * mass(23) * cos2al * sinapb)) gh3_6 = ((gz / 2.0_default) * mass(23) * ((cos2al * cosapb) - & (2.0_default * sin2al * sinapb))) gh3_7 = ((gz / 2.0_default) * mass(23) * cos2be * cosapb) gh3_8 = ( - ((gz / 2.0_default) * mass(23) * cos2be * sinapb)) gh4_1 = ( - (((gz**2) / 2.0_default) * (cos2be**2))) end subroutine setup_parameters1 subroutine setup_parameters2 () gh4_2 = ((((gz**2) / 4.0_default) * cos2al * cos2be) - (( & (g**2) / 2.0_default) * (cosamb**2))) gh4_3 = ( - ((((gz**2) / 4.0_default) * cos2al * cos2be) + (( & (g**2) / 2.0_default) * (sinamb**2)))) gh4_4 = ((((g**2) / 2.0_default) * cosamb * sinamb) - (( & (gz**2) / 4.0_default) * sin2al * cos2be)) gh4_5 = ( - (((gz**2) / 4.0_default) * (cos2be**2))) gh4_6 = ( - ((3.0_default / 4.0_default) * (gz**2) * (cos2al**2))) gh4_7 = (((gz**2) / 4.0_default) * (1.0_default - (3.0_default * & (sin2al**2)))) gh4_8 = ( - ((3.0_default / 8.0_default) * (gz**2) * sin4al)) gh4_9 = (((gz**2) / 4.0_default) * cos2al * cos2be) gh4_10 = ( - (((gz**2) / 4.0_default) * sin2al * cos2be)) gh4_11 = ( - ((3.0_default / 4.0_default) * (gz**2) * (cos2be**2))) ghaw = ( - (imago * (g / 2.0_default))) gh1az = (imago * & (gz / 2.0_default) * cosamb) gh2az = (imago * & (gz / 2.0_default) * sinamb) gh1ww = ( - (g * mass(24) * sinamb)) gh2ww = (g * mass(24) * cosamb) ghh1w = ((g / 2.0_default) * cosamb) ghh2w = ((g / 2.0_default) * sinamb) gh1zz = ( - (gz * mass(23) * sinamb)) gh2zz = (gz * mass(23) * cosamb) ghhz = ((gz / 2.0_default) * (1.0_default - & (2.0_default * sin2thw))) ghhp = e gaazz = ((gz**2) / 2.0_default) gh1h1zz = gaazz gh2h2zz = gaazz ghphmzz = (gaazz * (((2.0_default * (costhw**2)) - 1.0_default)**2)) ghphmpp = (2.0_default * (e**2)) ghphmpz = (e * gz * ((2.0_default * (costhw**2)) - 1.0_default)) ghh1wz = ( - ( & (1.0_default / 2.0_default) * g * gz * sin2thw * cosamb)) ghh2wz = ( - ( & (1.0_default / 2.0_default) * g * gz * sin2thw * sinamb)) ghh1wp = (e * (g / 2.0_default) * cosamb) ghh2wp = (e * (g / 2.0_default) * sinamb) gaaww = ((g**2) / 2.0_default) gh1h1ww = gaaww gh2h2ww = gaaww ghhww = gaaww ghawz = (imago * g * gz * & (1.0_default / 2.0_default) * sin2thw) ghawp = ( - (imago * e * g * & (1.0_default / 2.0_default))) g_yuk6_1 = (gcc * (mass(11) / mass(24)) * tanb) g_yuk7_1 = ( - ((g / 2.0_default) * (mass(11) / mass(24)) * & (cosal / cosbe))) g_yuk8_1 = ((g / 2.0_default) * (mass(11) / mass(24)) * (sinal / cosbe)) g_yuk9_1 = (imago * & (g / 2.0_default) * (mass(11) / mass(24)) * tanb) g_yuk10_1 = ( - ((g / 2.0_default) * (mass(2) / mass(24)) * & (sinal / sinbe))) g_yuk11_1 = ( - ((g / 2.0_default) * (mass(2) / mass(24)) * & (cosal / sinbe))) g_yuk12_1 = (imago * & (g / 2.0_default) * (mass(2) / mass(24)) * (1.0_default / tanb)) g_yuk13_1 = ( - ((g / 2.0_default) * (mass(1) / mass(24)) * & (cosal / cosbe))) g_yuk14_1 = ((g / 2.0_default) * (mass(1) / mass(24)) * (sinal / cosbe)) g_yuk15_1 = (imago * & (g / 2.0_default) * (mass(1) / mass(24)) * tanb) g_yuk6_2 = (gcc * (mass(13) / mass(24)) * tanb) g_yuk7_2 = ( - ((g / 2.0_default) * (mass(13) / mass(24)) * & (cosal / cosbe))) g_yuk8_2 = ((g / 2.0_default) * (mass(13) / mass(24)) * (sinal / cosbe)) g_yuk9_2 = (imago * & (g / 2.0_default) * (mass(13) / mass(24)) * tanb) g_yuk10_2 = ( - ((g / 2.0_default) * (mass(4) / mass(24)) * & (sinal / sinbe))) g_yuk11_2 = ( - ((g / 2.0_default) * (mass(4) / mass(24)) * & (cosal / sinbe))) g_yuk12_2 = (imago * & (g / 2.0_default) * (mass(4) / mass(24)) * (1.0_default / tanb)) g_yuk13_2 = ( - ((g / 2.0_default) * (mass(3) / mass(24)) * & (cosal / cosbe))) g_yuk14_2 = ((g / 2.0_default) * (mass(3) / mass(24)) * (sinal / cosbe)) g_yuk15_2 = (imago * & (g / 2.0_default) * (mass(3) / mass(24)) * tanb) g_yuk6_3 = (gcc * (mass(15) / mass(24)) * tanb) g_yuk7_3 = ( - ((g / 2.0_default) * (mass(15) / mass(24)) * & (cosal / cosbe))) g_yuk8_3 = ((g / 2.0_default) * (mass(15) / mass(24)) * (sinal / cosbe)) g_yuk9_3 = (imago * & (g / 2.0_default) * (mass(15) / mass(24)) * tanb) g_yuk10_3 = ( - ((g / 2.0_default) * (mass(6) / mass(24)) * & (sinal / sinbe))) g_yuk11_3 = ( - ((g / 2.0_default) * (mass(6) / mass(24)) * & (cosal / sinbe))) g_yuk12_3 = (imago * & (g / 2.0_default) * (mass(6) / mass(24)) * (1.0_default / tanb)) g_yuk13_3 = ( - ((g / 2.0_default) * (mass(5) / mass(24)) * & (cosal / cosbe))) g_yuk14_3 = ((g / 2.0_default) * (mass(5) / mass(24)) * (sinal / cosbe)) g_yuk15_3 = (imago * & (g / 2.0_default) * (mass(5) / mass(24)) * tanb) gccq_1_1 = (gcc * vckm_11) gccq_1_1_c = (gcc * conjg (vckm_11)) gccq_1_2 = (gcc * vckm_12) gccq_1_2_c = (gcc * conjg (vckm_12)) gccq_1_3 = (gcc * vckm_13) gccq_1_3_c = (gcc * conjg (vckm_13)) gccq_2_1 = (gcc * vckm_21) gccq_2_1_c = (gcc * conjg (vckm_21)) gccq_2_2 = (gcc * vckm_22) gccq_2_2_c = (gcc * conjg (vckm_22)) gccq_2_3 = (gcc * vckm_23) gccq_2_3_c = (gcc * conjg (vckm_23)) gccq_3_1 = (gcc * vckm_31) gccq_3_1_c = (gcc * conjg (vckm_31)) gccq_3_2 = (gcc * vckm_32) gccq_3_2_c = (gcc * conjg (vckm_32)) gccq_3_3 = (gcc * vckm_33) gccq_3_3_c = (gcc * conjg (vckm_33)) gs1ws1_1_1 = ( - (gcc * 2.0_default * vckm_11 * & conjg (mix_su111) * mix_sd111)) gs2ws2_1_1 = ( - (gcc * 2.0_default * vckm_11 * & conjg (mix_su121) * mix_sd121)) gs1ws2_1_1 = ( - (gcc * 2.0_default * vckm_11 * & conjg (mix_su111) * mix_sd121)) gs2ws1_1_1 = ( - (gcc * 2.0_default * vckm_11 * & conjg (mix_su121) * mix_sd111)) gs1ws1_1_1_c = conjg (gs1ws1_1_1) gs2ws2_1_1_c = conjg (gs2ws2_1_1) gs1ws2_1_1_c = conjg (gs1ws2_1_1) gs2ws1_1_1_c = conjg (gs2ws1_1_1) gs1ws1_1_2 = ( - (gcc * 2.0_default * vckm_12 * & conjg (mix_su111) * mix_sd211)) gs2ws2_1_2 = ( - (gcc * 2.0_default * vckm_12 * & conjg (mix_su121) * mix_sd221)) gs1ws2_1_2 = ( - (gcc * 2.0_default * vckm_12 * & conjg (mix_su111) * mix_sd221)) gs2ws1_1_2 = ( - (gcc * 2.0_default * vckm_12 * & conjg (mix_su121) * mix_sd211)) gs1ws1_1_2_c = conjg (gs1ws1_1_2) gs2ws2_1_2_c = conjg (gs2ws2_1_2) gs1ws2_1_2_c = conjg (gs1ws2_1_2) gs2ws1_1_2_c = conjg (gs2ws1_1_2) gs1ws1_1_3 = ( - (gcc * 2.0_default * vckm_13 * & conjg (mix_su111) * mix_sd311)) gs2ws2_1_3 = ( - (gcc * 2.0_default * vckm_13 * & conjg (mix_su121) * mix_sd321)) gs1ws2_1_3 = ( - (gcc * 2.0_default * vckm_13 * & conjg (mix_su111) * mix_sd321)) gs2ws1_1_3 = ( - (gcc * 2.0_default * vckm_13 * & conjg (mix_su121) * mix_sd311)) gs1ws1_1_3_c = conjg (gs1ws1_1_3) gs2ws2_1_3_c = conjg (gs2ws2_1_3) gs1ws2_1_3_c = conjg (gs1ws2_1_3) gs2ws1_1_3_c = conjg (gs2ws1_1_3) gs1ws1_2_1 = ( - (gcc * 2.0_default * vckm_21 * & conjg (mix_su211) * mix_sd111)) gs2ws2_2_1 = ( - (gcc * 2.0_default * vckm_21 * & conjg (mix_su221) * mix_sd121)) gs1ws2_2_1 = ( - (gcc * 2.0_default * vckm_21 * & conjg (mix_su211) * mix_sd121)) gs2ws1_2_1 = ( - (gcc * 2.0_default * vckm_21 * & conjg (mix_su221) * mix_sd111)) gs1ws1_2_1_c = conjg (gs1ws1_2_1) gs2ws2_2_1_c = conjg (gs2ws2_2_1) gs1ws2_2_1_c = conjg (gs1ws2_2_1) gs2ws1_2_1_c = conjg (gs2ws1_2_1) gs1ws1_2_2 = ( - (gcc * 2.0_default * vckm_22 * & conjg (mix_su211) * mix_sd211)) gs2ws2_2_2 = ( - (gcc * 2.0_default * vckm_22 * & conjg (mix_su221) * mix_sd221)) gs1ws2_2_2 = ( - (gcc * 2.0_default * vckm_22 * & conjg (mix_su211) * mix_sd221)) gs2ws1_2_2 = ( - (gcc * 2.0_default * vckm_22 * & conjg (mix_su221) * mix_sd211)) gs1ws1_2_2_c = conjg (gs1ws1_2_2) gs2ws2_2_2_c = conjg (gs2ws2_2_2) gs1ws2_2_2_c = conjg (gs1ws2_2_2) gs2ws1_2_2_c = conjg (gs2ws1_2_2) gs1ws1_2_3 = ( - (gcc * 2.0_default * vckm_23 * & conjg (mix_su211) * mix_sd311)) gs2ws2_2_3 = ( - (gcc * 2.0_default * vckm_23 * & conjg (mix_su221) * mix_sd321)) gs1ws2_2_3 = ( - (gcc * 2.0_default * vckm_23 * & conjg (mix_su211) * mix_sd321)) gs2ws1_2_3 = ( - (gcc * 2.0_default * vckm_23 * & conjg (mix_su221) * mix_sd311)) gs1ws1_2_3_c = conjg (gs1ws1_2_3) gs2ws2_2_3_c = conjg (gs2ws2_2_3) gs1ws2_2_3_c = conjg (gs1ws2_2_3) gs2ws1_2_3_c = conjg (gs2ws1_2_3) gs1ws1_3_1 = ( - (gcc * 2.0_default * vckm_31 * & conjg (mix_su311) * mix_sd111)) gs2ws2_3_1 = ( - (gcc * 2.0_default * vckm_31 * & conjg (mix_su321) * mix_sd121)) end subroutine setup_parameters2 subroutine setup_parameters3 () gs1ws2_3_1 = ( - (gcc * 2.0_default * vckm_31 * & conjg (mix_su311) * mix_sd121)) gs2ws1_3_1 = ( - (gcc * 2.0_default * vckm_31 * & conjg (mix_su321) * mix_sd111)) gs1ws1_3_1_c = conjg (gs1ws1_3_1) gs2ws2_3_1_c = conjg (gs2ws2_3_1) gs1ws2_3_1_c = conjg (gs1ws2_3_1) gs2ws1_3_1_c = conjg (gs2ws1_3_1) gs1ws1_3_2 = ( - (gcc * 2.0_default * vckm_32 * & conjg (mix_su311) * mix_sd211)) gs2ws2_3_2 = ( - (gcc * 2.0_default * vckm_32 * & conjg (mix_su321) * mix_sd221)) gs1ws2_3_2 = ( - (gcc * 2.0_default * vckm_32 * & conjg (mix_su311) * mix_sd221)) gs2ws1_3_2 = ( - (gcc * 2.0_default * vckm_32 * & conjg (mix_su321) * mix_sd211)) gs1ws1_3_2_c = conjg (gs1ws1_3_2) gs2ws2_3_2_c = conjg (gs2ws2_3_2) gs1ws2_3_2_c = conjg (gs1ws2_3_2) gs2ws1_3_2_c = conjg (gs2ws1_3_2) gs1ws1_3_3 = ( - (gcc * 2.0_default * vckm_33 * & conjg (mix_su311) * mix_sd311)) gs2ws2_3_3 = ( - (gcc * 2.0_default * vckm_33 * & conjg (mix_su321) * mix_sd321)) gs1ws2_3_3 = ( - (gcc * 2.0_default * vckm_33 * & conjg (mix_su311) * mix_sd321)) gs2ws1_3_3 = ( - (gcc * 2.0_default * vckm_33 * & conjg (mix_su321) * mix_sd311)) gs1ws1_3_3_c = conjg (gs1ws1_3_3) gs2ws2_3_3_c = conjg (gs2ws2_3_3) gs1ws2_3_3_c = conjg (gs1ws2_3_3) gs2ws1_3_3_c = conjg (gs2ws1_3_3) gsl1zsl1_1 = ((gz / 2.0_default) * ((2.0_default * sin2thw) - & (mix_sl111 * conjg (mix_sl111)))) gsl2zsl2_1 = ((gz / 2.0_default) * ((2.0_default * sin2thw) - & (mix_sl121 * conjg (mix_sl121)))) gsl1zsl2_1 = ((( - gz) / 2.0_default) * conjg (mix_sl111) * mix_sl121) gsl2zsl1_1 = conjg (gsl1zsl2_1) gsn1zsn1_1 = (gz / 2.0_default) gsu1zsu1_1 = ((gz / 2.0_default) * ((mix_su111 * conjg (mix_su111)) - ( & (4.0_default / 3.0_default) * sin2thw))) gsu2zsu2_1 = ((gz / 2.0_default) * ((mix_su121 * conjg (mix_su121)) - ( & (4.0_default / 3.0_default) * sin2thw))) gsu1zsu2_1 = ((gz / 2.0_default) * conjg (mix_su111) * mix_su121) gsu2zsu1_1 = conjg (gsu1zsu2_1) gsd1zsd1_1 = ((gz / 2.0_default) * (( & (2.0_default / 3.0_default) * sin2thw) - (mix_sd111 * & conjg (mix_sd111)))) gsd2zsd2_1 = ((gz / 2.0_default) * (( & (2.0_default / 3.0_default) * sin2thw) - (mix_sd121 * & conjg (mix_sd121)))) gsd1zsd2_1 = ((( - gz) / 2.0_default) * conjg (mix_sd111) * mix_sd121) gsd2zsd1_1 = conjg (gsd1zsd2_1) gsl1_1snw = (gcc * 2.0_default * mix_sl111) gsl2_1snw = (gcc * 2.0_default * mix_sl121) gsl1_1snw_c = (gcc * 2.0_default * conjg (mix_sl111)) gsl2_1snw_c = (gcc * 2.0_default * conjg (mix_sl121)) gsl1zsl1_2 = ((gz / 2.0_default) * ((2.0_default * sin2thw) - & (mix_sl211 * conjg (mix_sl211)))) gsl2zsl2_2 = ((gz / 2.0_default) * ((2.0_default * sin2thw) - & (mix_sl221 * conjg (mix_sl221)))) gsl1zsl2_2 = ((( - gz) / 2.0_default) * conjg (mix_sl211) * mix_sl221) gsl2zsl1_2 = conjg (gsl1zsl2_2) gsn1zsn1_2 = (gz / 2.0_default) gsu1zsu1_2 = ((gz / 2.0_default) * ((mix_su211 * conjg (mix_su211)) - ( & (4.0_default / 3.0_default) * sin2thw))) gsu2zsu2_2 = ((gz / 2.0_default) * ((mix_su221 * conjg (mix_su221)) - ( & (4.0_default / 3.0_default) * sin2thw))) gsu1zsu2_2 = ((gz / 2.0_default) * conjg (mix_su211) * mix_su221) gsu2zsu1_2 = conjg (gsu1zsu2_2) gsd1zsd1_2 = ((gz / 2.0_default) * (( & (2.0_default / 3.0_default) * sin2thw) - (mix_sd211 * & conjg (mix_sd211)))) gsd2zsd2_2 = ((gz / 2.0_default) * (( & (2.0_default / 3.0_default) * sin2thw) - (mix_sd221 * & conjg (mix_sd221)))) gsd1zsd2_2 = ((( - gz) / 2.0_default) * conjg (mix_sd211) * mix_sd221) gsd2zsd1_2 = conjg (gsd1zsd2_2) gsl1_2snw = (gcc * 2.0_default * mix_sl211) gsl2_2snw = (gcc * 2.0_default * mix_sl221) gsl1_2snw_c = (gcc * 2.0_default * conjg (mix_sl211)) gsl2_2snw_c = (gcc * 2.0_default * conjg (mix_sl221)) gsl1zsl1_3 = ((gz / 2.0_default) * ((2.0_default * sin2thw) - & (mix_sl311 * conjg (mix_sl311)))) gsl2zsl2_3 = ((gz / 2.0_default) * ((2.0_default * sin2thw) - & (mix_sl321 * conjg (mix_sl321)))) gsl1zsl2_3 = ((( - gz) / 2.0_default) * conjg (mix_sl311) * mix_sl321) gsl2zsl1_3 = conjg (gsl1zsl2_3) gsn1zsn1_3 = (gz / 2.0_default) gsu1zsu1_3 = ((gz / 2.0_default) * ((mix_su311 * conjg (mix_su311)) - ( & (4.0_default / 3.0_default) * sin2thw))) gsu2zsu2_3 = ((gz / 2.0_default) * ((mix_su321 * conjg (mix_su321)) - ( & (4.0_default / 3.0_default) * sin2thw))) gsu1zsu2_3 = ((gz / 2.0_default) * conjg (mix_su311) * mix_su321) gsu2zsu1_3 = conjg (gsu1zsu2_3) gsd1zsd1_3 = ((gz / 2.0_default) * (( & (2.0_default / 3.0_default) * sin2thw) - (mix_sd311 * & conjg (mix_sd311)))) gsd2zsd2_3 = ((gz / 2.0_default) * (( & (2.0_default / 3.0_default) * sin2thw) - (mix_sd321 * & conjg (mix_sd321)))) gsd1zsd2_3 = ((( - gz) / 2.0_default) * conjg (mix_sd311) * mix_sd321) gsd2zsd1_3 = conjg (gsd1zsd2_3) gsl1_3snw = (gcc * 2.0_default * mix_sl311) gsl2_3snw = (gcc * 2.0_default * mix_sl321) gsl1_3snw_c = (gcc * 2.0_default * conjg (mix_sl311)) gsl2_3snw_c = (gcc * 2.0_default * conjg (mix_sl321)) gppslsl = (2.0_default * (e**2)) gppsusu = ((8.0_default / 9.0_default) * (e**2)) gppsdsd = ((2.0_default / 9.0_default) * (e**2)) gzzsl1sl1_1 = (((gz**2) / 2.0_default) * (((1.0_default - & (4.0_default * sin2thw)) * (mix_sl111 * conjg (mix_sl111))) + & (4.0_default * (sin2thw**2)))) gzzsl2sl2_1 = (((gz**2) / 2.0_default) * (((1.0_default - & (4.0_default * sin2thw)) * (mix_sl121 * conjg (mix_sl121))) + & (4.0_default * (sin2thw**2)))) gzzsl1sl2_1 = (((gz**2) / 2.0_default) * (1.0_default - & (4.0_default * sin2thw)) * mix_sl111 * conjg (mix_sl121)) gzzsl2sl1_1 = conjg(gzzsl1sl2_1) gzzsn1sn1_1 = ((gz**2) / 2.0_default) gzzsu1su1_1 = (((gz**2) / 2.0_default) * (((1.0_default - ( & (8.0_default / 3.0_default) * sin2thw)) * (mix_su111 * & conjg (mix_su111))) + ((sin2thw**2) * & (16.0_default / 9.0_default)))) gzzsu2su2_1 = (((gz**2) / 2.0_default) * (((1.0_default - ( & (8.0_default / 3.0_default) * sin2thw)) * (mix_su121 * & conjg (mix_su121))) + ((sin2thw**2) * & (16.0_default / 9.0_default)))) gzzsu1su2_1 = (((gz**2) / 2.0_default) * (1.0_default - (sin2thw * & (8.0_default / 3.0_default))) * mix_su111 * conjg (mix_su121)) gzzsu2su1_1 = conjg(gzzsu1su2_1) gzzsd1sd1_1 = (((gz**2) / 2.0_default) * (((1.0_default - (sin2thw * & (4.0_default / 3.0_default))) * (mix_sd111 * conjg (mix_sd111))) + & ((sin2thw**2) * (4.0_default / 9.0_default)))) gzzsd2sd2_1 = (((gz**2) / 2.0_default) * (((1.0_default - (sin2thw * & (4.0_default / 3.0_default))) * (mix_sd121 * conjg (mix_sd121))) + & ((sin2thw**2) * (4.0_default / 9.0_default)))) gzzsd1sd2_1 = (((gz**2) / 2.0_default) * (1.0_default - (sin2thw * & (4.0_default / 3.0_default))) * mix_sd111 * conjg (mix_sd121)) gzzsd2sd1_1 = conjg(gzzsd1sd2_1) gzpsl1sl1_1 = (e * gz * ((mix_sl111 * conjg (mix_sl111)) - & (2.0_default * sin2thw))) gzpsl2sl2_1 = (e * gz * ((mix_sl121 * conjg (mix_sl121)) - & (2.0_default * sin2thw))) gzpsl1sl2_1 = (e * gz * mix_sl111 * conjg (mix_sl121)) gzpsl2sl1_1 = (e * gz * mix_sl121 * conjg (mix_sl111)) gzpsu1su1_1 = (e * gz * (2.0_default / 3.0_default) * ((mix_su111 * & conjg (mix_su111)) - (sin2thw * (4.0_default / 3.0_default)))) gzpsu2su2_1 = (e * gz * (2.0_default / 3.0_default) * ((mix_su121 * & conjg (mix_su121)) - (sin2thw * (4.0_default / 3.0_default)))) gzpsu1su2_1 = (e * gz * (2.0_default / 3.0_default) * mix_su111 * & conjg (mix_su121)) gzpsu2su1_1 = (e * gz * (2.0_default / 3.0_default) * mix_su121 * & conjg (mix_su111)) gzpsd1sd1_1 = (e * gz * (1.0_default / 3.0_default) * ((mix_sd111 * & conjg (mix_sd111)) - (sin2thw * (2.0_default / 3.0_default)))) gzpsd2sd2_1 = (e * gz * (1.0_default / 3.0_default) * ((mix_sd121 * & conjg (mix_sd121)) - (sin2thw * (2.0_default / 3.0_default)))) gzpsd1sd2_1 = (e * gz * (1.0_default / 3.0_default) * mix_sd111 * & conjg (mix_sd121)) gzpsd2sd1_1 = (e * gz * (1.0_default / 3.0_default) * mix_sd121 * & conjg (mix_sd111)) gwwsl1sl1_1 = (((g**2) / 2.0_default) * (mix_sl111 * conjg (mix_sl111))) gwwsl2sl2_1 = (((g**2) / 2.0_default) * (mix_sl121 * conjg (mix_sl121))) gwwsl1sl2_1 = (((g**2) / 2.0_default) * mix_sl111 * conjg (mix_sl121)) gwwsl2sl1_1 = (((g**2) / 2.0_default) * mix_sl121 * conjg (mix_sl111)) gwwsn1sn1_1 = ((g**2) / 2.0_default) gwwsu1su1_1 = (((g**2) / 2.0_default) * (mix_su111 * conjg (mix_su111))) gwwsu2su2_1 = (((g**2) / 2.0_default) * (mix_su121 * conjg (mix_su121))) gwwsu1su2_1 = (((g**2) / 2.0_default) * mix_su111 * conjg (mix_su121)) gwwsu2su1_1 = (((g**2) / 2.0_default) * mix_su121 * conjg (mix_su111)) gwwsd1sd1_1 = (((g**2) / 2.0_default) * (mix_sd111 * conjg (mix_sd111))) gwwsd2sd2_1 = (((g**2) / 2.0_default) * (mix_sd121 * conjg (mix_sd121))) gwwsd1sd2_1 = (((g**2) / 2.0_default) * mix_sd111 * conjg (mix_sd121)) gwwsd2sd1_1 = (((g**2) / 2.0_default) * mix_sd121 * conjg (mix_sd111)) gpwsl1sn_1 = ( - (e * 2.0_default * gcc * mix_sl111)) gpwsl2sn_1 = ( - (e * 2.0_default * gcc * mix_sl121)) gpwsl1sn_1_c = ( - (e * 2.0_default * gcc * conjg (mix_sl111))) gpwsl2sn_1_c = ( - (e * 2.0_default * gcc * conjg (mix_sl121))) gwzsl1sn_1 = (gcc * gz * 2.0_default * sin2thw * mix_sl111) end subroutine setup_parameters3 subroutine setup_parameters4 () gwzsl2sn_1 = (gcc * gz * 2.0_default * sin2thw * mix_sl121) gwzsl1sn_1_c = (gcc * gz * 2.0_default * sin2thw * conjg (mix_sl111)) gwzsl2sn_1_c = (gcc * gz * 2.0_default * sin2thw * conjg (mix_sl121)) gzzsl1sl1_2 = (((gz**2) / 2.0_default) * (((1.0_default - & (4.0_default * sin2thw)) * (mix_sl211 * conjg (mix_sl211))) + & (4.0_default * (sin2thw**2)))) gzzsl2sl2_2 = (((gz**2) / 2.0_default) * (((1.0_default - & (4.0_default * sin2thw)) * (mix_sl221 * conjg (mix_sl221))) + & (4.0_default * (sin2thw**2)))) gzzsl1sl2_2 = (((gz**2) / 2.0_default) * (1.0_default - & (4.0_default * sin2thw)) * mix_sl211 * conjg (mix_sl221)) gzzsl2sl1_2 = conjg(gzzsl1sl2_2) gzzsn1sn1_2 = ((gz**2) / 2.0_default) gzzsu1su1_2 = (((gz**2) / 2.0_default) * (((1.0_default - ( & (8.0_default / 3.0_default) * sin2thw)) * (mix_su211 * & conjg (mix_su211))) + ((sin2thw**2) * & (16.0_default / 9.0_default)))) gzzsu2su2_2 = (((gz**2) / 2.0_default) * (((1.0_default - ( & (8.0_default / 3.0_default) * sin2thw)) * (mix_su221 * & conjg (mix_su221))) + ((sin2thw**2) * & (16.0_default / 9.0_default)))) gzzsu1su2_2 = (((gz**2) / 2.0_default) * (1.0_default - (sin2thw * & (8.0_default / 3.0_default))) * mix_su211 * conjg (mix_su221)) gzzsu2su1_2 = conjg(gzzsu1su2_2) gzzsd1sd1_2 = (((gz**2) / 2.0_default) * (((1.0_default - (sin2thw * & (4.0_default / 3.0_default))) * (mix_sd211 * conjg (mix_sd211))) + & ((sin2thw**2) * (4.0_default / 9.0_default)))) gzzsd2sd2_2 = (((gz**2) / 2.0_default) * (((1.0_default - (sin2thw * & (4.0_default / 3.0_default))) * (mix_sd221 * conjg (mix_sd221))) + & ((sin2thw**2) * (4.0_default / 9.0_default)))) gzzsd1sd2_2 = (((gz**2) / 2.0_default) * (1.0_default - (sin2thw * & (4.0_default / 3.0_default))) * mix_sd211 * conjg (mix_sd221)) gzzsd2sd1_2 = conjg(gzzsd1sd2_2) gzpsl1sl1_2 = (e * gz * ((mix_sl211 * conjg (mix_sl211)) - & (2.0_default * sin2thw))) gzpsl2sl2_2 = (e * gz * ((mix_sl221 * conjg (mix_sl221)) - & (2.0_default * sin2thw))) gzpsl1sl2_2 = (e * gz * mix_sl211 * conjg (mix_sl221)) gzpsl2sl1_2 = (e * gz * mix_sl221 * conjg (mix_sl211)) gzpsu1su1_2 = (e * gz * (2.0_default / 3.0_default) * ((mix_su211 * & conjg (mix_su211)) - (sin2thw * (4.0_default / 3.0_default)))) gzpsu2su2_2 = (e * gz * (2.0_default / 3.0_default) * ((mix_su221 * & conjg (mix_su221)) - (sin2thw * (4.0_default / 3.0_default)))) gzpsu1su2_2 = (e * gz * (2.0_default / 3.0_default) * mix_su211 * & conjg (mix_su221)) gzpsu2su1_2 = (e * gz * (2.0_default / 3.0_default) * mix_su221 * & conjg (mix_su211)) gzpsd1sd1_2 = (e * gz * (1.0_default / 3.0_default) * ((mix_sd211 * & conjg (mix_sd211)) - (sin2thw * (2.0_default / 3.0_default)))) gzpsd2sd2_2 = (e * gz * (1.0_default / 3.0_default) * ((mix_sd221 * & conjg (mix_sd221)) - (sin2thw * (2.0_default / 3.0_default)))) gzpsd1sd2_2 = (e * gz * (1.0_default / 3.0_default) * mix_sd211 * & conjg (mix_sd221)) gzpsd2sd1_2 = (e * gz * (1.0_default / 3.0_default) * mix_sd221 * & conjg (mix_sd211)) gwwsl1sl1_2 = (((g**2) / 2.0_default) * (mix_sl211 * conjg (mix_sl211))) gwwsl2sl2_2 = (((g**2) / 2.0_default) * (mix_sl221 * conjg (mix_sl221))) gwwsl1sl2_2 = (((g**2) / 2.0_default) * mix_sl211 * conjg (mix_sl221)) gwwsl2sl1_2 = (((g**2) / 2.0_default) * mix_sl221 * conjg (mix_sl211)) gwwsn1sn1_2 = ((g**2) / 2.0_default) gwwsu1su1_2 = (((g**2) / 2.0_default) * (mix_su211 * conjg (mix_su211))) gwwsu2su2_2 = (((g**2) / 2.0_default) * (mix_su221 * conjg (mix_su221))) gwwsu1su2_2 = (((g**2) / 2.0_default) * mix_su211 * conjg (mix_su221)) gwwsu2su1_2 = (((g**2) / 2.0_default) * mix_su221 * conjg (mix_su211)) gwwsd1sd1_2 = (((g**2) / 2.0_default) * (mix_sd211 * conjg (mix_sd211))) gwwsd2sd2_2 = (((g**2) / 2.0_default) * (mix_sd221 * conjg (mix_sd221))) gwwsd1sd2_2 = (((g**2) / 2.0_default) * mix_sd211 * conjg (mix_sd221)) gwwsd2sd1_2 = (((g**2) / 2.0_default) * mix_sd221 * conjg (mix_sd211)) gpwsl1sn_2 = ( - (e * 2.0_default * gcc * mix_sl211)) gpwsl2sn_2 = ( - (e * 2.0_default * gcc * mix_sl221)) gpwsl1sn_2_c = ( - (e * 2.0_default * gcc * conjg (mix_sl211))) gpwsl2sn_2_c = ( - (e * 2.0_default * gcc * conjg (mix_sl221))) gwzsl1sn_2 = (gcc * gz * 2.0_default * sin2thw * mix_sl211) gwzsl2sn_2 = (gcc * gz * 2.0_default * sin2thw * mix_sl221) gwzsl1sn_2_c = (gcc * gz * 2.0_default * sin2thw * conjg (mix_sl211)) gwzsl2sn_2_c = (gcc * gz * 2.0_default * sin2thw * conjg (mix_sl221)) gzzsl1sl1_3 = (((gz**2) / 2.0_default) * (((1.0_default - & (4.0_default * sin2thw)) * (mix_sl311 * conjg (mix_sl311))) + & (4.0_default * (sin2thw**2)))) gzzsl2sl2_3 = (((gz**2) / 2.0_default) * (((1.0_default - & (4.0_default * sin2thw)) * (mix_sl321 * conjg (mix_sl321))) + & (4.0_default * (sin2thw**2)))) gzzsl1sl2_3 = (((gz**2) / 2.0_default) * (1.0_default - & (4.0_default * sin2thw)) * mix_sl311 * conjg (mix_sl321)) gzzsl2sl1_3 = conjg(gzzsl1sl2_3) gzzsn1sn1_3 = ((gz**2) / 2.0_default) gzzsu1su1_3 = (((gz**2) / 2.0_default) * (((1.0_default - ( & (8.0_default / 3.0_default) * sin2thw)) * (mix_su311 * & conjg (mix_su311))) + ((sin2thw**2) * & (16.0_default / 9.0_default)))) gzzsu2su2_3 = (((gz**2) / 2.0_default) * (((1.0_default - ( & (8.0_default / 3.0_default) * sin2thw)) * (mix_su321 * & conjg (mix_su321))) + ((sin2thw**2) * & (16.0_default / 9.0_default)))) gzzsu1su2_3 = (((gz**2) / 2.0_default) * (1.0_default - (sin2thw * & (8.0_default / 3.0_default))) * mix_su311 * conjg (mix_su321)) gzzsu2su1_3 = conjg(gzzsu1su2_3) gzzsd1sd1_3 = (((gz**2) / 2.0_default) * (((1.0_default - (sin2thw * & (4.0_default / 3.0_default))) * (mix_sd311 * conjg (mix_sd311))) + & ((sin2thw**2) * (4.0_default / 9.0_default)))) gzzsd2sd2_3 = (((gz**2) / 2.0_default) * (((1.0_default - (sin2thw * & (4.0_default / 3.0_default))) * (mix_sd321 * conjg (mix_sd321))) + & ((sin2thw**2) * (4.0_default / 9.0_default)))) gzzsd1sd2_3 = (((gz**2) / 2.0_default) * (1.0_default - (sin2thw * & (4.0_default / 3.0_default))) * mix_sd311 * conjg (mix_sd321)) gzzsd2sd1_3 = conjg(gzzsd1sd2_3) gzpsl1sl1_3 = (e * gz * ((mix_sl311 * conjg (mix_sl311)) - & (2.0_default * sin2thw))) gzpsl2sl2_3 = (e * gz * ((mix_sl321 * conjg (mix_sl321)) - & (2.0_default * sin2thw))) gzpsl1sl2_3 = (e * gz * mix_sl311 * conjg (mix_sl321)) gzpsl2sl1_3 = (e * gz * mix_sl321 * conjg (mix_sl311)) gzpsu1su1_3 = (e * gz * (2.0_default / 3.0_default) * ((mix_su311 * & conjg (mix_su311)) - (sin2thw * (4.0_default / 3.0_default)))) gzpsu2su2_3 = (e * gz * (2.0_default / 3.0_default) * ((mix_su321 * & conjg (mix_su321)) - (sin2thw * (4.0_default / 3.0_default)))) gzpsu1su2_3 = (e * gz * (2.0_default / 3.0_default) * mix_su311 * & conjg (mix_su321)) gzpsu2su1_3 = (e * gz * (2.0_default / 3.0_default) * mix_su321 * & conjg (mix_su311)) gzpsd1sd1_3 = (e * gz * (1.0_default / 3.0_default) * ((mix_sd311 * & conjg (mix_sd311)) - (sin2thw * (2.0_default / 3.0_default)))) gzpsd2sd2_3 = (e * gz * (1.0_default / 3.0_default) * ((mix_sd321 * & conjg (mix_sd321)) - (sin2thw * (2.0_default / 3.0_default)))) gzpsd1sd2_3 = (e * gz * (1.0_default / 3.0_default) * mix_sd311 * & conjg (mix_sd321)) gzpsd2sd1_3 = (e * gz * (1.0_default / 3.0_default) * mix_sd321 * & conjg (mix_sd311)) gwwsl1sl1_3 = (((g**2) / 2.0_default) * (mix_sl311 * conjg (mix_sl311))) gwwsl2sl2_3 = (((g**2) / 2.0_default) * (mix_sl321 * conjg (mix_sl321))) gwwsl1sl2_3 = (((g**2) / 2.0_default) * mix_sl311 * conjg (mix_sl321)) gwwsl2sl1_3 = (((g**2) / 2.0_default) * mix_sl321 * conjg (mix_sl311)) gwwsn1sn1_3 = ((g**2) / 2.0_default) gwwsu1su1_3 = (((g**2) / 2.0_default) * (mix_su311 * conjg (mix_su311))) gwwsu2su2_3 = (((g**2) / 2.0_default) * (mix_su321 * conjg (mix_su321))) gwwsu1su2_3 = (((g**2) / 2.0_default) * mix_su311 * conjg (mix_su321)) gwwsu2su1_3 = (((g**2) / 2.0_default) * mix_su321 * conjg (mix_su311)) gwwsd1sd1_3 = (((g**2) / 2.0_default) * (mix_sd311 * conjg (mix_sd311))) gwwsd2sd2_3 = (((g**2) / 2.0_default) * (mix_sd321 * conjg (mix_sd321))) gwwsd1sd2_3 = (((g**2) / 2.0_default) * mix_sd311 * conjg (mix_sd321)) gwwsd2sd1_3 = (((g**2) / 2.0_default) * mix_sd321 * conjg (mix_sd311)) gpwsl1sn_3 = ( - (e * 2.0_default * gcc * mix_sl311)) gpwsl2sn_3 = ( - (e * 2.0_default * gcc * mix_sl321)) gpwsl1sn_3_c = ( - (e * 2.0_default * gcc * conjg (mix_sl311))) gpwsl2sn_3_c = ( - (e * 2.0_default * gcc * conjg (mix_sl321))) gwzsl1sn_3 = (gcc * gz * 2.0_default * sin2thw * mix_sl311) gwzsl2sn_3 = (gcc * gz * 2.0_default * sin2thw * mix_sl321) gwzsl1sn_3_c = (gcc * gz * 2.0_default * sin2thw * conjg (mix_sl311)) gwzsl2sn_3_c = (gcc * gz * 2.0_default * sin2thw * conjg (mix_sl321)) gpwpsu1sd1_1_1 = (e * gcc * (2.0_default / 3.0_default) * vckm_11 * & conjg (mix_su111) * mix_sd111) gpwpsu2sd2_1_1 = (e * gcc * (2.0_default / 3.0_default) * vckm_11 * & conjg (mix_su121) * mix_sd121) gpwpsu1sd2_1_1 = (e * gcc * (2.0_default / 3.0_default) * vckm_11 * & conjg (mix_su111) * mix_sd121) gpwpsu2sd1_1_1 = (e * gcc * (2.0_default / 3.0_default) * vckm_11 * & conjg (mix_su121) * mix_sd111) gpwpsu1sd1_1_1_c = conjg (gpwpsu1sd1_1_1) gpwpsu2sd2_1_1_c = conjg (gpwpsu2sd2_1_1) gpwpsu1sd2_1_1_c = conjg (gpwpsu1sd2_1_1) gpwpsu2sd1_1_1_c = conjg (gpwpsu2sd1_1_1) gzwpsu1sd1_1_1 = ( - (gcc * gz * & (2.0_default / 3.0_default) * sin2thw * vckm_11 * & conjg (mix_su111) * mix_sd111)) gzwpsu2sd2_1_1 = ( - (gcc * gz * & (2.0_default / 3.0_default) * sin2thw * vckm_11 * & conjg (mix_su121) * mix_sd121)) gzwpsu1sd2_1_1 = ( - (gcc * gz * & (2.0_default / 3.0_default) * sin2thw * vckm_11 * & conjg (mix_su111) * mix_sd121)) gzwpsu2sd1_1_1 = ( - (gcc * gz * & (2.0_default / 3.0_default) * sin2thw * vckm_11 * & conjg (mix_su121) * mix_sd111)) gzwpsu1sd1_1_1_c = conjg (gzwpsu1sd1_1_1) gzwpsu2sd2_1_1_c = conjg (gzwpsu2sd2_1_1) gzwpsu1sd2_1_1_c = conjg (gzwpsu1sd2_1_1) gzwpsu2sd1_1_1_c = conjg (gzwpsu2sd1_1_1) gpwpsu1sd1_1_2 = (e * gcc * (2.0_default / 3.0_default) * vckm_12 * & conjg (mix_su111) * mix_sd211) gpwpsu2sd2_1_2 = (e * gcc * (2.0_default / 3.0_default) * vckm_12 * & conjg (mix_su121) * mix_sd221) gpwpsu1sd2_1_2 = (e * gcc * (2.0_default / 3.0_default) * vckm_12 * & conjg (mix_su111) * mix_sd221) gpwpsu2sd1_1_2 = (e * gcc * (2.0_default / 3.0_default) * vckm_12 * & conjg (mix_su121) * mix_sd211) gpwpsu1sd1_1_2_c = conjg (gpwpsu1sd1_1_2) gpwpsu2sd2_1_2_c = conjg (gpwpsu2sd2_1_2) gpwpsu1sd2_1_2_c = conjg (gpwpsu1sd2_1_2) gpwpsu2sd1_1_2_c = conjg (gpwpsu2sd1_1_2) gzwpsu1sd1_1_2 = ( - (gcc * gz * & (2.0_default / 3.0_default) * sin2thw * vckm_12 * & conjg (mix_su111) * mix_sd211)) end subroutine setup_parameters4 subroutine setup_parameters5 () gzwpsu2sd2_1_2 = ( - (gcc * gz * & (2.0_default / 3.0_default) * sin2thw * vckm_12 * & conjg (mix_su121) * mix_sd221)) gzwpsu1sd2_1_2 = ( - (gcc * gz * & (2.0_default / 3.0_default) * sin2thw * vckm_12 * & conjg (mix_su111) * mix_sd221)) gzwpsu2sd1_1_2 = ( - (gcc * gz * & (2.0_default / 3.0_default) * sin2thw * vckm_12 * & conjg (mix_su121) * mix_sd211)) gzwpsu1sd1_1_2_c = conjg (gzwpsu1sd1_1_2) gzwpsu2sd2_1_2_c = conjg (gzwpsu2sd2_1_2) gzwpsu1sd2_1_2_c = conjg (gzwpsu1sd2_1_2) gzwpsu2sd1_1_2_c = conjg (gzwpsu2sd1_1_2) gpwpsu1sd1_1_3 = (e * gcc * (2.0_default / 3.0_default) * vckm_13 * & conjg (mix_su111) * mix_sd311) gpwpsu2sd2_1_3 = (e * gcc * (2.0_default / 3.0_default) * vckm_13 * & conjg (mix_su121) * mix_sd321) gpwpsu1sd2_1_3 = (e * gcc * (2.0_default / 3.0_default) * vckm_13 * & conjg (mix_su111) * mix_sd321) gpwpsu2sd1_1_3 = (e * gcc * (2.0_default / 3.0_default) * vckm_13 * & conjg (mix_su121) * mix_sd311) gpwpsu1sd1_1_3_c = conjg (gpwpsu1sd1_1_3) gpwpsu2sd2_1_3_c = conjg (gpwpsu2sd2_1_3) gpwpsu1sd2_1_3_c = conjg (gpwpsu1sd2_1_3) gpwpsu2sd1_1_3_c = conjg (gpwpsu2sd1_1_3) gzwpsu1sd1_1_3 = ( - (gcc * gz * & (2.0_default / 3.0_default) * sin2thw * vckm_13 * & conjg (mix_su111) * mix_sd311)) gzwpsu2sd2_1_3 = ( - (gcc * gz * & (2.0_default / 3.0_default) * sin2thw * vckm_13 * & conjg (mix_su121) * mix_sd321)) gzwpsu1sd2_1_3 = ( - (gcc * gz * & (2.0_default / 3.0_default) * sin2thw * vckm_13 * & conjg (mix_su111) * mix_sd321)) gzwpsu2sd1_1_3 = ( - (gcc * gz * & (2.0_default / 3.0_default) * sin2thw * vckm_13 * & conjg (mix_su121) * mix_sd311)) gzwpsu1sd1_1_3_c = conjg (gzwpsu1sd1_1_3) gzwpsu2sd2_1_3_c = conjg (gzwpsu2sd2_1_3) gzwpsu1sd2_1_3_c = conjg (gzwpsu1sd2_1_3) gzwpsu2sd1_1_3_c = conjg (gzwpsu2sd1_1_3) gpwpsu1sd1_2_1 = (e * gcc * (2.0_default / 3.0_default) * vckm_21 * & conjg (mix_su211) * mix_sd111) gpwpsu2sd2_2_1 = (e * gcc * (2.0_default / 3.0_default) * vckm_21 * & conjg (mix_su221) * mix_sd121) gpwpsu1sd2_2_1 = (e * gcc * (2.0_default / 3.0_default) * vckm_21 * & conjg (mix_su211) * mix_sd121) gpwpsu2sd1_2_1 = (e * gcc * (2.0_default / 3.0_default) * vckm_21 * & conjg (mix_su221) * mix_sd111) gpwpsu1sd1_2_1_c = conjg (gpwpsu1sd1_2_1) gpwpsu2sd2_2_1_c = conjg (gpwpsu2sd2_2_1) gpwpsu1sd2_2_1_c = conjg (gpwpsu1sd2_2_1) gpwpsu2sd1_2_1_c = conjg (gpwpsu2sd1_2_1) gzwpsu1sd1_2_1 = ( - (gcc * gz * & (2.0_default / 3.0_default) * sin2thw * vckm_21 * & conjg (mix_su211) * mix_sd111)) gzwpsu2sd2_2_1 = ( - (gcc * gz * & (2.0_default / 3.0_default) * sin2thw * vckm_21 * & conjg (mix_su221) * mix_sd121)) gzwpsu1sd2_2_1 = ( - (gcc * gz * & (2.0_default / 3.0_default) * sin2thw * vckm_21 * & conjg (mix_su211) * mix_sd121)) gzwpsu2sd1_2_1 = ( - (gcc * gz * & (2.0_default / 3.0_default) * sin2thw * vckm_21 * & conjg (mix_su221) * mix_sd111)) gzwpsu1sd1_2_1_c = conjg (gzwpsu1sd1_2_1) gzwpsu2sd2_2_1_c = conjg (gzwpsu2sd2_2_1) gzwpsu1sd2_2_1_c = conjg (gzwpsu1sd2_2_1) gzwpsu2sd1_2_1_c = conjg (gzwpsu2sd1_2_1) gpwpsu1sd1_2_2 = (e * gcc * (2.0_default / 3.0_default) * vckm_22 * & conjg (mix_su211) * mix_sd211) gpwpsu2sd2_2_2 = (e * gcc * (2.0_default / 3.0_default) * vckm_22 * & conjg (mix_su221) * mix_sd221) gpwpsu1sd2_2_2 = (e * gcc * (2.0_default / 3.0_default) * vckm_22 * & conjg (mix_su211) * mix_sd221) gpwpsu2sd1_2_2 = (e * gcc * (2.0_default / 3.0_default) * vckm_22 * & conjg (mix_su221) * mix_sd211) gpwpsu1sd1_2_2_c = conjg (gpwpsu1sd1_2_2) gpwpsu2sd2_2_2_c = conjg (gpwpsu2sd2_2_2) gpwpsu1sd2_2_2_c = conjg (gpwpsu1sd2_2_2) gpwpsu2sd1_2_2_c = conjg (gpwpsu2sd1_2_2) gzwpsu1sd1_2_2 = ( - (gcc * gz * & (2.0_default / 3.0_default) * sin2thw * vckm_22 * & conjg (mix_su211) * mix_sd211)) gzwpsu2sd2_2_2 = ( - (gcc * gz * & (2.0_default / 3.0_default) * sin2thw * vckm_22 * & conjg (mix_su221) * mix_sd221)) gzwpsu1sd2_2_2 = ( - (gcc * gz * & (2.0_default / 3.0_default) * sin2thw * vckm_22 * & conjg (mix_su211) * mix_sd221)) gzwpsu2sd1_2_2 = ( - (gcc * gz * & (2.0_default / 3.0_default) * sin2thw * vckm_22 * & conjg (mix_su221) * mix_sd211)) gzwpsu1sd1_2_2_c = conjg (gzwpsu1sd1_2_2) gzwpsu2sd2_2_2_c = conjg (gzwpsu2sd2_2_2) gzwpsu1sd2_2_2_c = conjg (gzwpsu1sd2_2_2) gzwpsu2sd1_2_2_c = conjg (gzwpsu2sd1_2_2) gpwpsu1sd1_2_3 = (e * gcc * (2.0_default / 3.0_default) * vckm_23 * & conjg (mix_su211) * mix_sd311) gpwpsu2sd2_2_3 = (e * gcc * (2.0_default / 3.0_default) * vckm_23 * & conjg (mix_su221) * mix_sd321) gpwpsu1sd2_2_3 = (e * gcc * (2.0_default / 3.0_default) * vckm_23 * & conjg (mix_su211) * mix_sd321) gpwpsu2sd1_2_3 = (e * gcc * (2.0_default / 3.0_default) * vckm_23 * & conjg (mix_su221) * mix_sd311) gpwpsu1sd1_2_3_c = conjg (gpwpsu1sd1_2_3) gpwpsu2sd2_2_3_c = conjg (gpwpsu2sd2_2_3) gpwpsu1sd2_2_3_c = conjg (gpwpsu1sd2_2_3) gpwpsu2sd1_2_3_c = conjg (gpwpsu2sd1_2_3) gzwpsu1sd1_2_3 = ( - (gcc * gz * & (2.0_default / 3.0_default) * sin2thw * vckm_23 * & conjg (mix_su211) * mix_sd311)) gzwpsu2sd2_2_3 = ( - (gcc * gz * & (2.0_default / 3.0_default) * sin2thw * vckm_23 * & conjg (mix_su221) * mix_sd321)) gzwpsu1sd2_2_3 = ( - (gcc * gz * & (2.0_default / 3.0_default) * sin2thw * vckm_23 * & conjg (mix_su211) * mix_sd321)) gzwpsu2sd1_2_3 = ( - (gcc * gz * & (2.0_default / 3.0_default) * sin2thw * vckm_23 * & conjg (mix_su221) * mix_sd311)) gzwpsu1sd1_2_3_c = conjg (gzwpsu1sd1_2_3) gzwpsu2sd2_2_3_c = conjg (gzwpsu2sd2_2_3) gzwpsu1sd2_2_3_c = conjg (gzwpsu1sd2_2_3) gzwpsu2sd1_2_3_c = conjg (gzwpsu2sd1_2_3) gpwpsu1sd1_3_1 = (e * gcc * (2.0_default / 3.0_default) * vckm_31 * & conjg (mix_su311) * mix_sd111) gpwpsu2sd2_3_1 = (e * gcc * (2.0_default / 3.0_default) * vckm_31 * & conjg (mix_su321) * mix_sd121) gpwpsu1sd2_3_1 = (e * gcc * (2.0_default / 3.0_default) * vckm_31 * & conjg (mix_su311) * mix_sd121) gpwpsu2sd1_3_1 = (e * gcc * (2.0_default / 3.0_default) * vckm_31 * & conjg (mix_su321) * mix_sd111) gpwpsu1sd1_3_1_c = conjg (gpwpsu1sd1_3_1) gpwpsu2sd2_3_1_c = conjg (gpwpsu2sd2_3_1) gpwpsu1sd2_3_1_c = conjg (gpwpsu1sd2_3_1) gpwpsu2sd1_3_1_c = conjg (gpwpsu2sd1_3_1) gzwpsu1sd1_3_1 = ( - (gcc * gz * & (2.0_default / 3.0_default) * sin2thw * vckm_31 * & conjg (mix_su311) * mix_sd111)) gzwpsu2sd2_3_1 = ( - (gcc * gz * & (2.0_default / 3.0_default) * sin2thw * vckm_31 * & conjg (mix_su321) * mix_sd121)) gzwpsu1sd2_3_1 = ( - (gcc * gz * & (2.0_default / 3.0_default) * sin2thw * vckm_31 * & conjg (mix_su311) * mix_sd121)) gzwpsu2sd1_3_1 = ( - (gcc * gz * & (2.0_default / 3.0_default) * sin2thw * vckm_31 * & conjg (mix_su321) * mix_sd111)) gzwpsu1sd1_3_1_c = conjg (gzwpsu1sd1_3_1) gzwpsu2sd2_3_1_c = conjg (gzwpsu2sd2_3_1) gzwpsu1sd2_3_1_c = conjg (gzwpsu1sd2_3_1) gzwpsu2sd1_3_1_c = conjg (gzwpsu2sd1_3_1) gpwpsu1sd1_3_2 = (e * gcc * (2.0_default / 3.0_default) * vckm_32 * & conjg (mix_su311) * mix_sd211) gpwpsu2sd2_3_2 = (e * gcc * (2.0_default / 3.0_default) * vckm_32 * & conjg (mix_su321) * mix_sd221) gpwpsu1sd2_3_2 = (e * gcc * (2.0_default / 3.0_default) * vckm_32 * & conjg (mix_su311) * mix_sd221) gpwpsu2sd1_3_2 = (e * gcc * (2.0_default / 3.0_default) * vckm_32 * & conjg (mix_su321) * mix_sd211) gpwpsu1sd1_3_2_c = conjg (gpwpsu1sd1_3_2) gpwpsu2sd2_3_2_c = conjg (gpwpsu2sd2_3_2) gpwpsu1sd2_3_2_c = conjg (gpwpsu1sd2_3_2) gpwpsu2sd1_3_2_c = conjg (gpwpsu2sd1_3_2) gzwpsu1sd1_3_2 = ( - (gcc * gz * & (2.0_default / 3.0_default) * sin2thw * vckm_32 * & conjg (mix_su311) * mix_sd211)) gzwpsu2sd2_3_2 = ( - (gcc * gz * & (2.0_default / 3.0_default) * sin2thw * vckm_32 * & conjg (mix_su321) * mix_sd221)) gzwpsu1sd2_3_2 = ( - (gcc * gz * & (2.0_default / 3.0_default) * sin2thw * vckm_32 * & conjg (mix_su311) * mix_sd221)) gzwpsu2sd1_3_2 = ( - (gcc * gz * & (2.0_default / 3.0_default) * sin2thw * vckm_32 * & conjg (mix_su321) * mix_sd211)) gzwpsu1sd1_3_2_c = conjg (gzwpsu1sd1_3_2) gzwpsu2sd2_3_2_c = conjg (gzwpsu2sd2_3_2) gzwpsu1sd2_3_2_c = conjg (gzwpsu1sd2_3_2) gzwpsu2sd1_3_2_c = conjg (gzwpsu2sd1_3_2) gpwpsu1sd1_3_3 = (e * gcc * (2.0_default / 3.0_default) * vckm_33 * & conjg (mix_su311) * mix_sd311) gpwpsu2sd2_3_3 = (e * gcc * (2.0_default / 3.0_default) * vckm_33 * & conjg (mix_su321) * mix_sd321) gpwpsu1sd2_3_3 = (e * gcc * (2.0_default / 3.0_default) * vckm_33 * & conjg (mix_su311) * mix_sd321) gpwpsu2sd1_3_3 = (e * gcc * (2.0_default / 3.0_default) * vckm_33 * & conjg (mix_su321) * mix_sd311) gpwpsu1sd1_3_3_c = conjg (gpwpsu1sd1_3_3) gpwpsu2sd2_3_3_c = conjg (gpwpsu2sd2_3_3) gpwpsu1sd2_3_3_c = conjg (gpwpsu1sd2_3_3) gpwpsu2sd1_3_3_c = conjg (gpwpsu2sd1_3_3) gzwpsu1sd1_3_3 = ( - (gcc * gz * & (2.0_default / 3.0_default) * sin2thw * vckm_33 * & conjg (mix_su311) * mix_sd311)) gzwpsu2sd2_3_3 = ( - (gcc * gz * & (2.0_default / 3.0_default) * sin2thw * vckm_33 * & conjg (mix_su321) * mix_sd321)) gzwpsu1sd2_3_3 = ( - (gcc * gz * & (2.0_default / 3.0_default) * sin2thw * vckm_33 * & conjg (mix_su311) * mix_sd321)) gzwpsu2sd1_3_3 = ( - (gcc * gz * & (2.0_default / 3.0_default) * sin2thw * vckm_33 * & conjg (mix_su321) * mix_sd311)) gzwpsu1sd1_3_3_c = conjg (gzwpsu1sd1_3_3) gzwpsu2sd2_3_3_c = conjg (gzwpsu2sd2_3_3) gzwpsu1sd2_3_3_c = conjg (gzwpsu1sd2_3_3) gzwpsu2sd1_3_3_c = conjg (gzwpsu2sd1_3_3) gglglsqsq = (gs**2) end subroutine setup_parameters5 subroutine setup_parameters6 () gglpsqsq = 2.0_default * e * gs / 3.0_default gglsu1su1_1 = (gz * gs * (((1.0_default / 2.0_default) * & (mix_su111 * conjg (mix_su111))) - (sin2thw * & (2.0_default / 3.0_default)))) gglsu2su2_1 = (gz * gs * (((1.0_default / 2.0_default) * & (mix_su121 * conjg (mix_su121))) - (sin2thw * & (2.0_default / 3.0_default)))) gglsu1su2_1 = (gz * gs * (1.0_default / 2.0_default) * mix_su111 * & conjg (mix_su121)) gglsu2su1_1 = (gz * gs * (1.0_default / 2.0_default) * mix_su121 * & conjg (mix_su111)) gglsd1sd1_1 = ( - (gz * gs * (((1.0_default / 2.0_default) * & (mix_sd111 * conjg (mix_sd111))) - (sin2thw * & (1.0_default / 3.0_default))))) gglsd2sd2_1 = ( - (gz * gs * (((1.0_default / 2.0_default) * & (mix_sd121 * conjg (mix_sd121))) - (sin2thw * & (1.0_default / 3.0_default))))) gglsd1sd2_1 = ( - (gz * gs * & (1.0_default / 2.0_default) * mix_sd111 * conjg (mix_sd121))) gglsd2sd1_1 = ( - (gz * gs * & (1.0_default / 2.0_default) * mix_sd121 * conjg (mix_sd111))) gglsu1su1_2 = (gz * gs * (((1.0_default / 2.0_default) * & (mix_su211 * conjg (mix_su211))) - (sin2thw * & (2.0_default / 3.0_default)))) gglsu2su2_2 = (gz * gs * (((1.0_default / 2.0_default) * & (mix_su221 * conjg (mix_su221))) - (sin2thw * & (2.0_default / 3.0_default)))) gglsu1su2_2 = (gz * gs * (1.0_default / 2.0_default) * mix_su211 * & conjg (mix_su221)) gglsu2su1_2 = (gz * gs * (1.0_default / 2.0_default) * mix_su221 * & conjg (mix_su211)) gglsd1sd1_2 = ( - (gz * gs * (((1.0_default / 2.0_default) * & (mix_sd211 * conjg (mix_sd211))) - (sin2thw * & (1.0_default / 3.0_default))))) gglsd2sd2_2 = ( - (gz * gs * (((1.0_default / 2.0_default) * & (mix_sd221 * conjg (mix_sd221))) - (sin2thw * & (1.0_default / 3.0_default))))) gglsd1sd2_2 = ( - (gz * gs * & (1.0_default / 2.0_default) * mix_sd211 * conjg (mix_sd221))) gglsd2sd1_2 = ( - (gz * gs * & (1.0_default / 2.0_default) * mix_sd221 * conjg (mix_sd211))) gglsu1su1_3 = (gz * gs * (((1.0_default / 2.0_default) * & (mix_su311 * conjg (mix_su311))) - (sin2thw * & (2.0_default / 3.0_default)))) gglsu2su2_3 = (gz * gs * (((1.0_default / 2.0_default) * & (mix_su321 * conjg (mix_su321))) - (sin2thw * & (2.0_default / 3.0_default)))) gglsu1su2_3 = (gz * gs * (1.0_default / 2.0_default) * mix_su311 * & conjg (mix_su321)) gglsu2su1_3 = (gz * gs * (1.0_default / 2.0_default) * mix_su321 * & conjg (mix_su311)) gglsd1sd1_3 = ( - (gz * gs * (((1.0_default / 2.0_default) * & (mix_sd311 * conjg (mix_sd311))) - (sin2thw * & (1.0_default / 3.0_default))))) gglsd2sd2_3 = ( - (gz * gs * (((1.0_default / 2.0_default) * & (mix_sd321 * conjg (mix_sd321))) - (sin2thw * & (1.0_default / 3.0_default))))) gglsd1sd2_3 = ( - (gz * gs * & (1.0_default / 2.0_default) * mix_sd311 * conjg (mix_sd321))) gglsd2sd1_3 = ( - (gz * gs * & (1.0_default / 2.0_default) * mix_sd321 * conjg (mix_sd311))) gglwsu1sd1_1_1 = (g * gs * sqrt (2.0_default) * vckm_11 * & conjg (mix_su111) * mix_sd111) gglwsu2sd2_1_1 = (g * gs * sqrt (2.0_default) * vckm_11 * & conjg (mix_su121) * mix_sd121) gglwsu1sd2_1_1 = (g * gs * sqrt (2.0_default) * vckm_11 * & conjg (mix_su111) * mix_sd121) gglwsu2sd1_1_1 = (g * gs * sqrt (2.0_default) * vckm_11 * & conjg (mix_su121) * mix_sd111) gglwsu1sd1_1_1_c = conjg (gglwsu1sd1_1_1) gglwsu2sd2_1_1_c = conjg (gglwsu2sd2_1_1) gglwsu1sd2_1_1_c = conjg (gglwsu1sd2_1_1) gglwsu2sd1_1_1_c = conjg (gglwsu2sd1_1_1) gglwsu1sd1_1_2 = (g * gs * sqrt (2.0_default) * vckm_12 * & conjg (mix_su111) * mix_sd211) gglwsu2sd2_1_2 = (g * gs * sqrt (2.0_default) * vckm_12 * & conjg (mix_su121) * mix_sd221) gglwsu1sd2_1_2 = (g * gs * sqrt (2.0_default) * vckm_12 * & conjg (mix_su111) * mix_sd221) gglwsu2sd1_1_2 = (g * gs * sqrt (2.0_default) * vckm_12 * & conjg (mix_su121) * mix_sd211) gglwsu1sd1_1_2_c = conjg (gglwsu1sd1_1_2) gglwsu2sd2_1_2_c = conjg (gglwsu2sd2_1_2) gglwsu1sd2_1_2_c = conjg (gglwsu1sd2_1_2) gglwsu2sd1_1_2_c = conjg (gglwsu2sd1_1_2) gglwsu1sd1_1_3 = (g * gs * sqrt (2.0_default) * vckm_13 * & conjg (mix_su111) * mix_sd311) gglwsu2sd2_1_3 = (g * gs * sqrt (2.0_default) * vckm_13 * & conjg (mix_su121) * mix_sd321) gglwsu1sd2_1_3 = (g * gs * sqrt (2.0_default) * vckm_13 * & conjg (mix_su111) * mix_sd321) gglwsu2sd1_1_3 = (g * gs * sqrt (2.0_default) * vckm_13 * & conjg (mix_su121) * mix_sd311) gglwsu1sd1_1_3_c = conjg (gglwsu1sd1_1_3) gglwsu2sd2_1_3_c = conjg (gglwsu2sd2_1_3) gglwsu1sd2_1_3_c = conjg (gglwsu1sd2_1_3) gglwsu2sd1_1_3_c = conjg (gglwsu2sd1_1_3) gglwsu1sd1_2_1 = (g * gs * sqrt (2.0_default) * vckm_21 * & conjg (mix_su211) * mix_sd111) gglwsu2sd2_2_1 = (g * gs * sqrt (2.0_default) * vckm_21 * & conjg (mix_su221) * mix_sd121) gglwsu1sd2_2_1 = (g * gs * sqrt (2.0_default) * vckm_21 * & conjg (mix_su211) * mix_sd121) gglwsu2sd1_2_1 = (g * gs * sqrt (2.0_default) * vckm_21 * & conjg (mix_su221) * mix_sd111) gglwsu1sd1_2_1_c = conjg (gglwsu1sd1_2_1) gglwsu2sd2_2_1_c = conjg (gglwsu2sd2_2_1) gglwsu1sd2_2_1_c = conjg (gglwsu1sd2_2_1) gglwsu2sd1_2_1_c = conjg (gglwsu2sd1_2_1) gglwsu1sd1_2_2 = (g * gs * sqrt (2.0_default) * vckm_22 * & conjg (mix_su211) * mix_sd211) gglwsu2sd2_2_2 = (g * gs * sqrt (2.0_default) * vckm_22 * & conjg (mix_su221) * mix_sd221) gglwsu1sd2_2_2 = (g * gs * sqrt (2.0_default) * vckm_22 * & conjg (mix_su211) * mix_sd221) gglwsu2sd1_2_2 = (g * gs * sqrt (2.0_default) * vckm_22 * & conjg (mix_su221) * mix_sd211) gglwsu1sd1_2_2_c = conjg (gglwsu1sd1_2_2) gglwsu2sd2_2_2_c = conjg (gglwsu2sd2_2_2) gglwsu1sd2_2_2_c = conjg (gglwsu1sd2_2_2) gglwsu2sd1_2_2_c = conjg (gglwsu2sd1_2_2) gglwsu1sd1_2_3 = (g * gs * sqrt (2.0_default) * vckm_23 * & conjg (mix_su211) * mix_sd311) gglwsu2sd2_2_3 = (g * gs * sqrt (2.0_default) * vckm_23 * & conjg (mix_su221) * mix_sd321) gglwsu1sd2_2_3 = (g * gs * sqrt (2.0_default) * vckm_23 * & conjg (mix_su211) * mix_sd321) gglwsu2sd1_2_3 = (g * gs * sqrt (2.0_default) * vckm_23 * & conjg (mix_su221) * mix_sd311) gglwsu1sd1_2_3_c = conjg (gglwsu1sd1_2_3) gglwsu2sd2_2_3_c = conjg (gglwsu2sd2_2_3) gglwsu1sd2_2_3_c = conjg (gglwsu1sd2_2_3) gglwsu2sd1_2_3_c = conjg (gglwsu2sd1_2_3) gglwsu1sd1_3_1 = (g * gs * sqrt (2.0_default) * vckm_31 * & conjg (mix_su311) * mix_sd111) gglwsu2sd2_3_1 = (g * gs * sqrt (2.0_default) * vckm_31 * & conjg (mix_su321) * mix_sd121) gglwsu1sd2_3_1 = (g * gs * sqrt (2.0_default) * vckm_31 * & conjg (mix_su311) * mix_sd121) gglwsu2sd1_3_1 = (g * gs * sqrt (2.0_default) * vckm_31 * & conjg (mix_su321) * mix_sd111) gglwsu1sd1_3_1_c = conjg (gglwsu1sd1_3_1) gglwsu2sd2_3_1_c = conjg (gglwsu2sd2_3_1) gglwsu1sd2_3_1_c = conjg (gglwsu1sd2_3_1) gglwsu2sd1_3_1_c = conjg (gglwsu2sd1_3_1) gglwsu1sd1_3_2 = (g * gs * sqrt (2.0_default) * vckm_32 * & conjg (mix_su311) * mix_sd211) gglwsu2sd2_3_2 = (g * gs * sqrt (2.0_default) * vckm_32 * & conjg (mix_su321) * mix_sd221) gglwsu1sd2_3_2 = (g * gs * sqrt (2.0_default) * vckm_32 * & conjg (mix_su311) * mix_sd221) end subroutine setup_parameters6 subroutine setup_parameters7 () gglwsu2sd1_3_2 = (g * gs * sqrt (2.0_default) * vckm_32 * & conjg (mix_su321) * mix_sd211) gglwsu1sd1_3_2_c = conjg (gglwsu1sd1_3_2) gglwsu2sd2_3_2_c = conjg (gglwsu2sd2_3_2) gglwsu1sd2_3_2_c = conjg (gglwsu1sd2_3_2) gglwsu2sd1_3_2_c = conjg (gglwsu2sd1_3_2) gglwsu1sd1_3_3 = (g * gs * sqrt (2.0_default) * vckm_33 * & conjg (mix_su311) * mix_sd311) gglwsu2sd2_3_3 = (g * gs * sqrt (2.0_default) * vckm_33 * & conjg (mix_su321) * mix_sd321) gglwsu1sd2_3_3 = (g * gs * sqrt (2.0_default) * vckm_33 * & conjg (mix_su311) * mix_sd321) gglwsu2sd1_3_3 = (g * gs * sqrt (2.0_default) * vckm_33 * & conjg (mix_su321) * mix_sd311) gglwsu1sd1_3_3_c = conjg (gglwsu1sd1_3_3) gglwsu2sd2_3_3_c = conjg (gglwsu2sd2_3_3) gglwsu1sd2_3_3_c = conjg (gglwsu1sd2_3_3) gglwsu2sd1_3_3_c = conjg (gglwsu2sd1_3_3) axial0_11 = real ((mn_14 * conjg (mn_14)) - (mn_13 * conjg (mn_13))) & / 2.0_default snnh1_11 = 2.0_default * ( - real ((mn_12 - ( & (sinthw / costhw) * mn_11)) * ((sinal * mn_13) + (cosal * mn_14)))) snnh2_11 = 2.0_default * real ((mn_12 - ((sinthw / costhw) * mn_11)) * & ((cosal * mn_13) - (sinal * mn_14))) pnna_11 = 2.0_default * cmplx (0.0_default, real ((mn_12 - (mn_11 * (sinthw / costhw))) * ( & (mn_13 * sinbe) - (mn_14 * cosbe))),kind=default) vector0_12 = cmplx (0.0_default, aimag ((mn_14 * conjg (mn_24)) - & (mn_13 * conjg (mn_23))), kind=default) / 2.0_default axial0_12 = real ((mn_14 * conjg (mn_24)) - (mn_13 * conjg (mn_23))) & / 2.0_default snnh1_12 = ( - real (((mn_12 - ((sinthw / costhw) * mn_11)) * ((sinal & * mn_23) + (cosal * mn_24))) + ((mn_22 - ((sinthw / costhw) * mn_21)) & * ((sinal * mn_13) + (cosal * mn_14))))) pnnh1_12 = ( - cmplx (0.0_default, aimag (((mn_12 - ( & (sinthw / costhw) * mn_11)) * ((sinal * mn_23) + (cosal * mn_24))) + ( & (mn_22 - ((sinthw / costhw) * mn_21)) * ((sinal * mn_13) + & (cosal * mn_14)))), kind=default)) snnh2_12 = real (((mn_12 - ((sinthw / costhw) * mn_11)) * ((cosal * & mn_23) - (sinal * mn_24))) + ((mn_22 - ((sinthw / costhw) * mn_21)) * ( & (cosal * mn_13) - (sinal * mn_14)))) pnnh2_12 = cmplx (0.0_default, aimag (((mn_12 - ((sinthw / costhw) & * mn_11)) * ((cosal * mn_23) - (sinal * mn_24))) + ((mn_22 - ( & (sinthw / costhw) * mn_21)) * ((cosal * mn_13) - & (sinal * mn_14)))), kind=default) snna_12 = - aimag (((mn_12 - (mn_11 * & (sinthw / costhw))) * ((mn_23 * sinbe) - (mn_24 * cosbe))) + ((mn_22 - & (mn_21 * (sinthw / costhw))) * ((mn_13 * sinbe) - & (mn_14 * cosbe)))) pnna_12 = cmplx (0.0_default, real (((mn_12 - (mn_11 * (sinthw / costhw))) * ((mn_23 * sinbe) & - (mn_24 * cosbe))) + ((mn_22 - (mn_21 * (sinthw / costhw))) * ( & (mn_13 * sinbe) - (mn_14 * cosbe)))),kind=default) vector0_13 = cmplx (0.0_default, aimag ((mn_14 * conjg (mn_34)) - (mn_13 * & conjg (mn_33))), kind=default) / 2.0_default axial0_13 = real ((mn_14 * conjg (mn_34)) - (mn_13 * conjg (mn_33))) & / 2.0_default snnh1_13 = ( - real (((mn_12 - ((sinthw / costhw) * mn_11)) * ((sinal * & mn_33) + (cosal * mn_34))) + ((mn_32 - ((sinthw / costhw) * mn_31)) * ( & (sinal * mn_13) + (cosal * mn_14))))) pnnh1_13 = ( - cmplx (0.0_default, aimag (((mn_12 - ( & (sinthw / costhw) * mn_11)) * ((sinal * mn_33) + (cosal * mn_34))) + ( & (mn_32 - ((sinthw / costhw) * mn_31)) * ((sinal * mn_13) + & (cosal * mn_14)))), kind=default)) snnh2_13 = real (((mn_12 - ((sinthw / costhw) * mn_11)) * ((cosal * & mn_33) - (sinal * mn_34))) + ((mn_32 - ((sinthw / costhw) * mn_31)) * ( & (cosal * mn_13) - (sinal * mn_14)))) pnnh2_13 = cmplx (0.0_default, aimag (((mn_12 - ((sinthw / costhw) * & mn_11)) * ((cosal * mn_33) - (sinal * mn_34))) + ((mn_32 - ( & (sinthw / costhw) * mn_31)) * ((cosal * mn_13) - & (sinal * mn_14)))), kind=default) snna_13 = - aimag (((mn_12 - (mn_11 * & (sinthw / costhw))) * ((mn_33 * sinbe) - (mn_34 * cosbe))) + ((mn_32 - & (mn_31 * (sinthw / costhw))) * ((mn_13 * sinbe) - & (mn_14 * cosbe)))) pnna_13 = cmplx (0.0_default, real (((mn_12 - (mn_11 * (sinthw / costhw))) * ((mn_33 * sinbe) & - (mn_34 * cosbe))) + ((mn_32 - (mn_31 * (sinthw / costhw))) * ( & (mn_13 * sinbe) - (mn_14 * cosbe)))),kind=default) vector0_14 = cmplx (0.0_default, aimag ((mn_14 * conjg (mn_44)) - (mn_13 * & conjg (mn_43))), kind=default) / 2.0_default axial0_14 = real ((mn_14 * conjg (mn_44)) - (mn_13 * conjg (mn_43))) & / 2.0_default snnh1_14 = ( - real (((mn_12 - ((sinthw / costhw) * mn_11)) * ((sinal * & mn_43) + (cosal * mn_44))) + ((mn_42 - ((sinthw / costhw) * mn_41)) * ( & (sinal * mn_13) + (cosal * mn_14))))) pnnh1_14 = ( - cmplx (0.0_default, aimag (((mn_12 - ( & (sinthw / costhw) * mn_11)) * ((sinal * mn_43) + (cosal * mn_44))) + ( & (mn_42 - ((sinthw / costhw) * mn_41)) * ((sinal * mn_13) + & (cosal * mn_14)))), kind=default)) snnh2_14 = real (((mn_12 - ((sinthw / costhw) * mn_11)) * ((cosal * & mn_43) - (sinal * mn_44))) + ((mn_42 - ((sinthw / costhw) * mn_41)) * ( & (cosal * mn_13) - (sinal * mn_14)))) pnnh2_14 = cmplx (0.0_default, aimag (((mn_12 - ((sinthw / costhw) * & mn_11)) * ((cosal * mn_43) - (sinal * mn_44))) + ((mn_42 - ( & (sinthw / costhw) * mn_41)) * ((cosal * mn_13) - & (sinal * mn_14)))), kind=default) snna_14 = - aimag (((mn_12 - (mn_11 * & (sinthw / costhw))) * ((mn_43 * sinbe) - (mn_44 * cosbe))) + ((mn_42 - & (mn_41 * (sinthw / costhw))) * ((mn_13 * sinbe) - & (mn_14 * cosbe)))) pnna_14 = cmplx (0.0_default, real (((mn_12 - (mn_11 * (sinthw / costhw))) * ((mn_43 * sinbe) & - (mn_44 * cosbe))) + ((mn_42 - (mn_41 * (sinthw / costhw))) * ( & (mn_13 * sinbe) - (mn_14 * cosbe)))),kind=default) axial0_22 = real ((mn_24 * conjg (mn_24)) - (mn_23 * conjg (mn_23))) & / 2.0_default snnh1_22 = 2.0_default * ( - real ((mn_22 - ( & (sinthw / costhw) * mn_21)) * ((sinal * mn_23) + (cosal * mn_24)))) snnh2_22 = 2.0_default * real ((mn_22 - ((sinthw / costhw) * mn_21)) & * ((cosal * mn_23) - (sinal * mn_24))) pnna_22 = 2.0_default * cmplx (0.0_default, real ((mn_22 - (mn_21 * (sinthw / costhw))) * ( & (mn_23 * sinbe) - (mn_24 * cosbe))),kind=default) vector0_23 = cmplx (0.0_default, aimag ((mn_24 * conjg (mn_34)) - (mn_23 * & conjg (mn_33))), kind=default) / 2.0_default axial0_23 = real ((mn_24 * conjg (mn_34)) - (mn_23 * conjg (mn_33))) & / 2.0_default snnh1_23 = ( - real (((mn_22 - ((sinthw / costhw) * mn_21)) * ((sinal * & mn_33) + (cosal * mn_34))) + ((mn_32 - ((sinthw / costhw) * mn_31)) * ( & (sinal * mn_23) + (cosal * mn_24))))) pnnh1_23 = ( - cmplx (0.0_default, aimag (((mn_22 - ( & (sinthw / costhw) * mn_21)) * ((sinal * mn_33) + (cosal * mn_34))) + ( & (mn_32 - ((sinthw / costhw) * mn_31)) * ((sinal * mn_23) + & (cosal * mn_24)))), kind=default)) snnh2_23 = real (((mn_22 - ((sinthw / costhw) * mn_21)) * ((cosal * & mn_33) - (sinal * mn_34))) + ((mn_32 - ((sinthw / costhw) * mn_31)) * ( & (cosal * mn_23) - (sinal * mn_24)))) pnnh2_23 = cmplx (0.0_default, aimag (((mn_22 - ((sinthw / costhw) * & mn_21)) * ((cosal * mn_33) - (sinal * mn_34))) + ((mn_32 - ( & (sinthw / costhw) * mn_31)) * ((cosal * mn_23) - & (sinal * mn_24)))), kind=default) snna_23 = - aimag (((mn_22 - (mn_21 * & (sinthw / costhw))) * ((mn_33 * sinbe) - (mn_34 * cosbe))) + ((mn_32 - & (mn_31 * (sinthw / costhw))) * ((mn_23 * sinbe) - & (mn_24 * cosbe)))) pnna_23 = cmplx (0.0_default, real (((mn_22 - (mn_21 * (sinthw / costhw))) * ((mn_33 * sinbe) & - (mn_34 * cosbe))) + ((mn_32 - (mn_31 * (sinthw / costhw))) * ( & (mn_23 * sinbe) - (mn_24 * cosbe)))),kind=default) vector0_24 = cmplx (0.0_default, aimag ((mn_24 * conjg (mn_44)) - (mn_23 * & conjg (mn_43))), kind=default) / 2.0_default axial0_24 = real ((mn_24 * conjg (mn_44)) - (mn_23 * conjg (mn_43))) & / 2.0_default snnh1_24 = - real (((mn_22 - ((sinthw / costhw) * mn_21)) * ((sinal * & mn_43) + (cosal * mn_44))) + ((mn_42 - ((sinthw / costhw) * mn_41)) * ( & (sinal * mn_23) + (cosal * mn_24)))) pnnh1_24 = ( - cmplx (0.0_default, aimag (((mn_22 - ( & (sinthw / costhw) * mn_21)) * ((sinal * mn_43) + (cosal * mn_44))) + ( & (mn_42 - ((sinthw / costhw) * mn_41)) * ((sinal * mn_23) + & (cosal * mn_24)))), kind=default)) snnh2_24 = real (((mn_22 - ((sinthw / costhw) * mn_21)) * ((cosal * & mn_43) - (sinal * mn_44))) + ((mn_42 - ((sinthw / costhw) * mn_41)) * ( & (cosal * mn_23) - (sinal * mn_24)))) pnnh2_24 = cmplx (0.0_default, aimag (((mn_22 - ((sinthw / costhw) * & mn_21)) * ((cosal * mn_43) - (sinal * mn_44))) + ((mn_42 - ( & (sinthw / costhw) * mn_41)) * ((cosal * mn_23) - & (sinal * mn_24)))), kind=default) snna_24 = - aimag (((mn_22 - (mn_21 * & (sinthw / costhw))) * ((mn_43 * sinbe) - (mn_44 * cosbe))) + ((mn_42 - & (mn_41 * (sinthw / costhw))) * ((mn_23 * sinbe) - & (mn_24 * cosbe)))) pnna_24 = cmplx (0.0_default, real (((mn_22 - (mn_21 * (sinthw / costhw))) * ((mn_43 * sinbe) & - (mn_44 * cosbe))) + ((mn_42 - (mn_41 * (sinthw / costhw))) * ( & (mn_23 * sinbe) - (mn_24 * cosbe)))),kind=default) axial0_33 = real ((mn_34 * conjg (mn_34)) - (mn_33 * conjg (mn_33))) & / 2.0_default snnh1_33 = 2.0_default * ( - real ((mn_32 - ( & (sinthw / costhw) * mn_31)) * ((sinal * mn_33) + (cosal * mn_34)))) snnh2_33 = 2.0_default * real ((mn_32 - ((sinthw / costhw) * mn_31)) & * ((cosal * mn_33) - (sinal * mn_34))) pnna_33 = 2.0_default * cmplx (0.0_default, real ((mn_32 - (mn_31 * (sinthw / costhw))) * ( & (mn_33 * sinbe) - (mn_34 * cosbe))),kind=default) end subroutine setup_parameters7 subroutine setup_parameters8 () vector0_34 = cmplx (0.0_default, aimag ((mn_34 * conjg (mn_44)) - (mn_33 * & conjg (mn_43))), kind=default) / 2.0_default axial0_34 = real ((mn_34 * conjg (mn_44)) - (mn_33 * conjg (mn_43))) & / 2.0_default snnh1_34 = ( - real (((mn_32 - ((sinthw / costhw) * mn_31)) * ((sinal * & mn_43) + (cosal * mn_44))) + ((mn_42 - ((sinthw / costhw) * mn_41)) * ( & (sinal * mn_33) + (cosal * mn_34))))) pnnh1_34 = ( - cmplx (0.0_default, aimag (((mn_32 - ( & (sinthw / costhw) * mn_31)) * ((sinal * mn_43) + (cosal * mn_44))) + ( & (mn_42 - ((sinthw / costhw) * mn_41)) * ((sinal * mn_33) + & (cosal * mn_34)))), kind=default)) snnh2_34 = real (((mn_32 - ((sinthw / costhw) * mn_31)) * ((cosal * & mn_43) - (sinal * mn_44))) + ((mn_42 - ((sinthw / costhw) * mn_41)) * ( & (cosal * mn_33) - (sinal * mn_34)))) pnnh2_34 = cmplx (0.0_default, aimag (((mn_32 - ((sinthw / costhw) * & mn_31)) * ((cosal * mn_43) - (sinal * mn_44))) + ((mn_42 - ( & (sinthw / costhw) * mn_41)) * ((cosal * mn_33) - & (sinal * mn_34)))), kind=default) snna_34 = - aimag (((mn_32 - (mn_31 * & (sinthw / costhw))) * ((mn_43 * sinbe) - (mn_44 * cosbe))) + ((mn_42 - & (mn_41 * (sinthw / costhw))) * ((mn_33 * sinbe) - & (mn_34 * cosbe)))) pnna_34 = cmplx (0.0_default, real (((mn_32 - (mn_31 * (sinthw / costhw))) * ((mn_43 * sinbe) & - (mn_44 * cosbe))) + ((mn_42 - (mn_41 * (sinthw / costhw))) * ( & (mn_33 * sinbe) - (mn_34 * cosbe)))),kind=default) axial0_44 = real ((mn_44 * conjg (mn_44)) - (mn_43 * conjg (mn_43))) & / 2.0_default snnh1_44 = 2.0_default * ( - real ((mn_42 - ( & (sinthw / costhw) * mn_41)) * ((sinal * mn_43) + (cosal * mn_44)))) snnh2_44 = 2.0_default * real ((mn_42 - ((sinthw / costhw) * mn_41)) & * ((cosal * mn_43) - (sinal * mn_44))) pnna_44 = 2.0_default * cmplx (0.0_default, real ((mn_42 - (mn_41 * (sinthw / costhw))) * ( & (mn_43 * sinbe) - (mn_44 * cosbe))),kind=default) vp_11 = ((((1.0_default - & (2.0_default * sin2thw)) / 4.0_default) * ((mv_12 * conjg (mv_12)) & + (conjg (mu_12) * mu_12))) + (((costhw**2) / 2.0_default) * ( & (mv_11 * conjg (mv_11)) + (conjg (mu_11) * mu_11)))) ap_11 = ((((1.0_default - & (2.0_default * sin2thw)) / 4.0_default) * ((mv_12 * & conjg (mv_12)) - (conjg (mu_12) * mu_12))) + (( & (costhw**2) / 2.0_default) * ((mv_11 * conjg (mv_11)) - ( & conjg (mu_11) * mu_11)))) vp_12 = ((((1.0_default - & (2.0_default * sin2thw)) / 4.0_default) * ((mv_12 * conjg (mv_22)) & + (conjg (mu_12) * mu_22))) + (((costhw**2) / 2.0_default) * ( & (mv_11 * conjg (mv_21)) + (conjg (mu_11) * mu_21)))) ap_12 = ((((1.0_default - & (2.0_default * sin2thw)) / 4.0_default) * ((mv_12 * & conjg (mv_22)) - (conjg (mu_12) * mu_22))) + (( & (costhw**2) / 2.0_default) * ((mv_11 * conjg (mv_21)) - ( & conjg (mu_11) * mu_21)))) vp_21 = conjg (vp_12) ap_21 = conjg (ap_12) vp_22 = ((((1.0_default - & (2.0_default * sin2thw)) / 4.0_default) * ((mv_22 * conjg (mv_22)) & + (conjg (mu_22) * mu_22))) + (((costhw**2) / 2.0_default) * ( & (mv_21 * conjg (mv_21)) + (conjg (mu_21) * mu_21)))) ap_22 = ((((1.0_default - & (2.0_default * sin2thw)) / 4.0_default) * ((mv_22 * & conjg (mv_22)) - (conjg (mu_22) * mu_22))) + (( & (costhw**2) / 2.0_default) * ((mv_21 * conjg (mv_21)) - ( & conjg (mu_21) * mu_21)))) lcn_11 = ((conjg (mn_12) * mv_11 * sqrt (2.0_default)) - ( & conjg (mn_14) * mv_12)) rcn_11 = ((mn_12 * conjg (mu_11) * sqrt (2.0_default)) + (mn_13 * & conjg (mu_12))) lnch_11 = (cosbe * ((conjg (mn_14) * conjg (mv_11)) + ((conjg (mv_12) / & sqrt (2.0_default)) * (conjg (mn_12) + ((sinthw / costhw) * & conjg (mn_11)))))) rnch_11 = (sinbe * ((mn_13 * mu_11) - ((mu_12 / sqrt (2.0_default)) * & (mn_12 + ((sinthw / costhw) * mn_11))))) lcn_12 = ((conjg (mn_22) * mv_11 * sqrt (2.0_default)) - ( & conjg (mn_24) * mv_12)) rcn_12 = ((mn_22 * conjg (mu_11) * sqrt (2.0_default)) + (mn_23 * & conjg (mu_12))) lnch_21 = (cosbe * ((conjg (mn_24) * conjg (mv_11)) + ((conjg (mv_12) / & sqrt (2.0_default)) * (conjg (mn_22) + ((sinthw / costhw) * & conjg (mn_21)))))) rnch_21 = (sinbe * ((mn_23 * mu_11) - ((mu_12 / sqrt (2.0_default)) * & (mn_22 + ((sinthw / costhw) * mn_21))))) lcn_13 = ((conjg (mn_32) * mv_11 * sqrt (2.0_default)) - ( & conjg (mn_34) * mv_12)) rcn_13 = ((mn_32 * conjg (mu_11) * sqrt (2.0_default)) + (mn_33 * & conjg (mu_12))) lnch_31 = (cosbe * ((conjg (mn_34) * conjg (mv_11)) + ((conjg (mv_12) / & sqrt (2.0_default)) * (conjg (mn_32) + ((sinthw / costhw) * & conjg (mn_31)))))) rnch_31 = (sinbe * ((mn_33 * mu_11) - ((mu_12 / sqrt (2.0_default)) * & (mn_32 + ((sinthw / costhw) * mn_31))))) lcn_14 = ((conjg (mn_42) * mv_11 * sqrt (2.0_default)) - ( & conjg (mn_44) * mv_12)) rcn_14 = ((mn_42 * conjg (mu_11) * sqrt (2.0_default)) + (mn_43 * & conjg (mu_12))) lnch_41 = (cosbe * ((conjg (mn_44) * conjg (mv_11)) + ((conjg (mv_12) / & sqrt (2.0_default)) * (conjg (mn_42) + ((sinthw / costhw) * & conjg (mn_41)))))) rnch_41 = (sinbe * ((mn_43 * mu_11) - ((mu_12 / sqrt (2.0_default)) * & (mn_42 + ((sinthw / costhw) * mn_41))))) lcn_21 = ((conjg (mn_12) * mv_21 * sqrt (2.0_default)) - ( & conjg (mn_14) * mv_22)) rcn_21 = ((mn_12 * conjg (mu_21) * sqrt (2.0_default)) + (mn_13 * & conjg (mu_22))) lnch_12 = (cosbe * ((conjg (mn_14) * conjg (mv_21)) + ((conjg (mv_22) / & sqrt (2.0_default)) * (conjg (mn_12) + ((sinthw / costhw) * & conjg (mn_11)))))) end subroutine setup_parameters8 subroutine setup_parameters9 () rnch_12 = (sinbe * ((mn_13 * mu_21) - ((mu_22 / sqrt (2.0_default)) * & (mn_12 + ((sinthw / costhw) * mn_11))))) lcn_22 = ((conjg (mn_22) * mv_21 * sqrt (2.0_default)) - ( & conjg (mn_24) * mv_22)) rcn_22 = ((mn_22 * conjg (mu_21) * sqrt (2.0_default)) + (mn_23 * & conjg (mu_22))) lnch_22 = (cosbe * ((conjg (mn_24) * conjg (mv_21)) + ((conjg (mv_22) / & sqrt (2.0_default)) * (conjg (mn_22) + ((sinthw / costhw) * & conjg (mn_21)))))) rnch_22 = (sinbe * ((mn_23 * mu_21) - ((mu_22 / sqrt (2.0_default)) * & (mn_22 + ((sinthw / costhw) * mn_21))))) lcn_23 = ((conjg (mn_32) * mv_21 * sqrt (2.0_default)) - ( & conjg (mn_34) * mv_22)) rcn_23 = ((mn_32 * conjg (mu_21) * sqrt (2.0_default)) + (mn_33 * & conjg (mu_22))) lnch_32 = (cosbe * ((conjg (mn_34) * conjg (mv_21)) + ((conjg (mv_22) / & sqrt (2.0_default)) * (conjg (mn_32) + ((sinthw / costhw) * & conjg (mn_31)))))) rnch_32 = (sinbe * ((mn_33 * mu_21) - ((mu_22 / sqrt (2.0_default)) * & (mn_32 + ((sinthw / costhw) * mn_31))))) lcn_24 = ((conjg (mn_42) * mv_21 * sqrt (2.0_default)) - ( & conjg (mn_44) * mv_22)) rcn_24 = ((mn_42 * conjg (mu_21) * sqrt (2.0_default)) + (mn_43 * & conjg (mu_22))) lnch_42 = (cosbe * ((conjg (mn_44) * conjg (mv_21)) + ((conjg (mv_22) / & sqrt (2.0_default)) * (conjg (mn_42) + ((sinthw / costhw) * & conjg (mn_41)))))) rnch_42 = (sinbe * ((mn_43 * mu_21) - ((mu_22 / sqrt (2.0_default)) * & (mn_42 + ((sinthw / costhw) * mn_41))))) lnc_11 = conjg (lcn_11) rnc_11 = conjg (rcn_11) lnc_12 = conjg (lcn_21) rnc_12 = conjg (rcn_21) lnc_21 = conjg (lcn_12) rnc_21 = conjg (rcn_12) lnc_22 = conjg (lcn_22) rnc_22 = conjg (rcn_22) lnc_31 = conjg (lcn_13) rnc_31 = conjg (rcn_13) lnc_32 = conjg (lcn_23) rnc_32 = conjg (rcn_23) lnc_41 = conjg (lcn_14) rnc_41 = conjg (rcn_14) lnc_42 = conjg (lcn_24) rnc_42 = conjg (rcn_24) gnzn_1_1 = (gz * axial0_11) gnzn_2_2 = (gz * axial0_22) gnzn_3_3 = (gz * axial0_33) gnzn_4_4 = (gz * axial0_44) !!! JR check 01.04.2005 g_h1111susu = (gz * mass(23) * ((1.0_default / 2.0_default) - & (sin2thw * q_up)) * sinapb) g_h1122susu = (gz * mass(23) * q_up * sinapb * sin2thw) g_h1111sdsd = (gz * mass(23) * (( - (1.0_default / 2.0_default)) - & (sin2thw * q_down)) * sinapb) g_h1122sdsd = (gz * mass(23) * q_down * sinapb * sin2thw) g_h2111susu = ( - (gz * mass(23) * ((1.0_default / 2.0_default) - & (sin2thw * q_up)) * cosapb)) g_h2122susu = ( - gz * mass(23) * q_up * cosapb * sin2thw) g_h2111sdsd = ( - (gz * mass(23) * (( - (1.0_default / 2.0_default)) - & (sin2thw * q_down)) * cosapb)) g_h2122sdsd = ( - gz * mass(23) * q_down * cosapb * sin2thw) !!! g_h3112susu = - (imago * ((g * mass(2) * (( & !!! conjg (au_1) * cosbe) + (mu * sinbe))) / & !!! (2.0_default * mass(24) * sinbe))) !!! g_h3121susu = conjg (g_h3112susu) !!! g_h3112sdsd = - (imago * ((g * mass(1) * (( & !!! conjg (ad_1) * tanb) + mu)) / (2.0_default * mass(24)))) !!! g_h3121sdsd = conjg (g_h3112sdsd) g_h1111snsn = (gz * mass(23) * (1.0_default / 2.0_default) * sinapb) g_h1111slsl = (gz * mass(23) * (( - (1.0_default / 2.0_default)) - & (sin2thw * ( - 1.0_default))) * sinapb) g_h1122slsl = (gz * mass(23) * ( - 1.0_default) * sinapb * sin2thw) g_h2111snsn = ( - (gz * mass(23) * (1.0_default / 2.0_default)) * cosapb) g_h2111slsl = ( - (gz * mass(23) * (( - (1.0_default / 2.0_default)) - & (sin2thw * ( - 1.0_default))) * cosapb)) g_h2122slsl = ( - (gz * mass(23) * ( - 1.0_default) * cosapb * sin2thw)) !!! g_h3112slsl = - (imago * ((g * mass(11) * (( & !!! conjg (al_1) * tanb) + mu)) / (2.0_default * mass(24)))) !!! g_h3121slsl = conjg (g_h3112slsl) g_h4111slsn = ((- g / (sqrt (2.0_default) * mass(24))) * (mass(24)**2) * sin2be) !!! g_h4112slsn = (sqrt (2.0_default) * ((g * mass(11) * ((conjg ( & !!! al_1) * sinbe) + (mu * cosbe))) / & !!! (2.0_default * mass(24) * cosbe))) g_h1211susu = g_h1111susu g_h1222susu = g_h1122susu g_h1211sdsd = g_h1111sdsd g_h1222sdsd = g_h1122sdsd g_h2211susu = g_h2111susu g_h2222susu = g_h2122susu g_h2211sdsd = g_h2111sdsd g_h2222sdsd = g_h2122sdsd !!! g_h1211susu = (gz * mass(23) * ((1.0_default / 2.0_default) - & !!! (sin2thw * q_up)) * sinapb) !!! g_h1222susu = (gz * mass(23) * q_up * sinapb * sin2thw) !!! g_h1211sdsd = (gz * mass(23) * (( - (1.0_default / 2.0_default)) - & !!! (sin2thw * q_down)) * sinapb) !!! g_h1222sdsd = (gz * mass(23) * q_down * sinapb * sin2thw) !!! g_h2211susu = ( - (gz * mass(23) * ((1.0_default / 2.0_default) - & !!! (sin2thw * q_up)) * cosapb)) !!! g_h2222susu = ( - gz * mass(23) * q_up * cosapb * sin2thw) end subroutine setup_parameters9 subroutine setup_parameters10 () !!1 g_h2211sdsd = ( - (gz * mass(23) * (( - (1.0_default / 2.0_default)) - & !!1 (sin2thw * q_down)) * cosapb)) !!1 g_h2222sdsd = ( - gz * mass(23) * q_down * cosapb * sin2thw) !!! g_h3212susu = - (imago * ((g * mass(4) * (( & !!! conjg (au_2) * cosbe) + (mu * sinbe))) / & !!! (2.0_default * mass(24) * sinbe))) !!! g_h3221susu = conjg (g_h3212susu) !!! g_h3212sdsd = - (imago * ((g * mass(3) * (( & !!! conjg (ad_2) * sinbe) + (mu * cosbe))) / & !!! (2.0_default * mass(24) * cosbe))) !!! g_h3221sdsd = conjg (g_h3212sdsd) g_h1211snsn = g_h1111snsn g_h1211slsl = g_h1111slsl g_h1222slsl = g_h1122slsl g_h2211snsn = g_h2111snsn g_h2211slsl = g_h2111slsl g_h2222slsl = g_h2122slsl !!! g_h1211snsn = (gz * mass(23) * (1.0_default / 2.0_default)) !!! g_h1211slsl = (gz * mass(23) * (( - (1.0_default / 2.0_default)) - & !!! (sin2thw * ( - 1.0_default))) * sinapb) !!! g_h1222slsl = (gz * mass(23) * ( - 1.0_default) * sinapb * sin2thw) !!! g_h2211snsn = ( - (gz * mass(23) * (1.0_default / 2.0_default))) !!! g_h2211slsl = ( - (gz * mass(23) * (( - (1.0_default / 2.0_default)) - & !!! (sin2thw * ( - 1.0_default))) * cosapb)) !!! g_h2222slsl = ( - (gz * mass(23) * ( - 1.0_default) * cosapb * sin2thw)) !!! g_h3212slsl = - (imago * ((g * mass(13) * (( & !!! conjg (al_2) * sinbe) + (mu * cosbe))) / & !!! (2.0_default * mass(24) * cosbe))) !!! g_h3221slsl = conjg (g_h3212slsl) g_h4211slsn = ((- g / (sqrt (2.0_default) * mass(24))) * (mass(24)**2) * sin2be) !!! g_h4212slsn = (sqrt (2.0_default) * ((g * mass(13) * ((conjg ( & !!! al_2) * sinbe) + (mu * cosbe))) / & !!! (2.0_default * mass(24) * cosbe))) g_h1311susu = ((gz * mass(23) * ((1.0_default / 2.0_default) - & (sin2thw * q_up)) * sinapb) - ((g * & (mass(6)**2) * cosal) / (mass(24) * sinbe))) g_h1322susu = ((gz * mass(23) * q_up * sinapb * sin2thw) - ((g * & (mass(6)**2) * cosal) / (mass(24) * sinbe))) g_h1312susu = - ((g * mass(6) * ((conjg (au_3) * cosal) + ( & mu * sinal))) / (2.0_default * mass(24) * sinbe)) g_h1321susu = conjg (g_h1312susu) g_h1311sdsd = ((gz * mass(23) * (( - (1.0_default / 2.0_default)) - & (sin2thw * q_down)) * sinapb) + ((g * & (mass(5)**2) * sinal) / (mass(24) * cosbe))) g_h1322sdsd = ((gz * mass(23) * q_down * sinapb * sin2thw) + ((g * & (mass(5)**2) * sinal) / (mass(24) * cosbe))) g_h1312sdsd = ((g * mass(5) * ((conjg (ad_3) * sinal) + ( & mu * cosal))) / (2.0_default * mass(24) * cosbe)) g_h1321sdsd = conjg (g_h1312sdsd) g_h2311susu = ( - ((gz * mass(23) * ((1.0_default / 2.0_default) - & (sin2thw * q_up)) * cosapb) + ((g * & (mass(6)**2) * sinal) / (mass(24) * sinbe)))) g_h2322susu = ( - ((gz * mass(23) * q_up * cosapb * sin2thw) + ((g * & (mass(6)**2) * sinal) / (mass(24) * sinbe)))) g_h2312susu = ((g * mass(6) * ((conjg (- au_3) * sinal) + ( & mu * cosal))) / (2.0_default * mass(24) * sinbe)) g_h2321susu = conjg (g_h2312susu) g_h2311sdsd = ( - ((gz * mass(23) * (( - (1.0_default / 2.0_default)) - & (sin2thw * q_down)) * cosapb) + ((g * & (mass(5)**2) * cosal) / (mass(24) * cosbe)))) g_h2322sdsd = ( - ((gz * mass(23) * q_down * cosapb * sin2thw) + ((g * & (mass(5)**2) * cosal) / (mass(24) * cosbe)))) g_h2312sdsd = ((g * mass(5) * ((conjg (- ad_3) * cosal) + ( & mu * sinal))) / (2.0_default * mass(24) * cosbe)) g_h2321sdsd = conjg (g_h2312sdsd) g_h3312susu = - (imago * ((g * mass(6) * (( & conjg (au_3) * cosbe) + (mu * sinbe))) / & (2.0_default * mass(24) * sinbe))) g_h3321susu = conjg (g_h3312susu) g_h3312sdsd = - (imago * ((g * mass(5) * (( & conjg (ad_3) * sinbe) + (mu * cosbe))) / & (2.0_default * mass(24) * cosbe))) g_h3321sdsd = conjg (g_h3312sdsd) g_h1311snsn = (gz * mass(23) * (1.0_default / 2.0_default) * sinapb) g_h1311slsl = ((gz * mass(23) * (( - (1.0_default / 2.0_default)) - & (sin2thw * ( - 1.0_default))) * sinapb) + ((g * & (mass(15)**2) * sinal) / (mass(24) * cosbe))) g_h1322slsl = ((gz * mass(23) * ( - 1.0_default) * sinapb * sin2thw) + ( & (g * (mass(15)**2) * sinal) / (mass(24) * cosbe))) g_h1312slsl = ((g * mass(15) * ((conjg (al_3) * sinal) + ( & mu * cosal))) / (2.0_default * mass(24) * cosbe)) g_h1321slsl = conjg (g_h1312slsl) g_h2311snsn = ( - (gz * mass(23) * (1.0_default / 2.0_default) * cosapb)) g_h2311slsl = ( - ((gz * mass(23) * (( - (1.0_default / 2.0_default)) - & (sin2thw * ( - 1.0_default))) * cosapb) + ((g * & (mass(15)**2) * cosal) / (mass(24) * cosbe)))) g_h2322slsl = ( - ((gz * mass(23) * ( - 1.0_default) * cosapb * sin2thw) + ( & (g * (mass(15)**2) * cosal) / (mass(24) * cosbe)))) g_h2312slsl = ((g * mass(15) * ((conjg (- al_3) * cosal) + ( & mu * sinal))) / (2.0_default * mass(24) * cosbe)) g_h2321slsl = conjg (g_h2312slsl) g_h3312slsl = - (imago * ((g * mass(15) * (( & conjg (al_3) * sinbe) + (mu * cosbe))) / & (2.0_default * mass(24) * cosbe))) g_h3321slsl = conjg (g_h3312slsl) g_h4311slsn = ((g / (sqrt (2.0_default) * mass(24))) * (( & (mass(15)**2) * tanb) - ((mass(24)**2) * sin2be))) g_h4312slsn = (sqrt (2.0_default) * ((g * mass(15) * ((conjg ( & al_3) * sinbe) + (mu * cosbe))) / & (2.0_default * mass(24) * cosbe))) g_h41_111susd = ((g / (sqrt (2.0_default) * mass(24))) * vckm_11 * ( - ( & (mass(24)**2) * sin2be))) g_h41_211susd = ((g / (sqrt (2.0_default) * mass(24))) * vckm_12 * ( - ( & (mass(24)**2) * sin2be))) g_h41_311susd = ((g / (sqrt (2.0_default) * mass(24))) * vckm_13 * (( - ( & (mass(24)**2) * sin2be)) + (((mass(5)**2) * tanb) + ((mass(2)**2) / tanb)))) g_h41_322susd = ((sqrt (2.0_default) * g * mass(2) * mass(5) * vckm_13) / & (mass(24) * sin2be)) g_h41_312susd = (((g * mass(5)) / ( & sqrt (2.0_default) * mass(24))) * vckm_13 * (mu + ( & conjg (ad_3) * tanb))) g_h41_321susd = (((g * mass(2)) / ( & sqrt (2.0_default) * mass(24))) * vckm_13 * (conjg (mu) + & (au_1 / tanb))) g_h42_111susd = ((g / (sqrt (2.0_default) * mass(24))) * vckm_21 * ( - ( & (mass(24)**2) * sin2be))) g_h42_211susd = ((g / (sqrt (2.0_default) * mass(24))) * vckm_22 * ( - ( & (mass(24)**2) * sin2be))) g_h42_311susd = ((g / (sqrt (2.0_default) * mass(24))) * vckm_23 * (( - ( & (mass(24)**2) * sin2be)) + (((mass(5)**2) * tanb) + ((mass(4)**2) / tanb)))) g_h42_322susd = ((sqrt (2.0_default) * g * mass(4) * mass(5) * vckm_23) / & (mass(24) * sin2be)) g_h42_312susd = (((g * mass(5)) / ( & sqrt (2.0_default) * mass(24))) * vckm_23 * (mu + ( & conjg (ad_3) * tanb))) g_h42_321susd = (((g * mass(4)) / ( & sqrt (2.0_default) * mass(24))) * vckm_23 * (conjg (mu) + & (au_2 / tanb))) g_h43_111susd = ((g / (sqrt (2.0_default) * mass(24))) * vckm_31 * (( - ( & (mass(24)**2) * sin2be)) + (((mass(1)**2) * tanb) + ((mass(6)**2) / tanb)))) g_h43_122susd = ((sqrt (2.0_default) * g * mass(6) * mass(1) * vckm_31) / & (mass(24) * sin2be)) g_h43_112susd = (((g * mass(1)) / ( & sqrt (2.0_default) * mass(24))) * vckm_31 * (mu + ( & conjg (ad_1) * tanb))) g_h43_121susd = (((g * mass(6)) / ( & sqrt (2.0_default) * mass(24))) * vckm_31 * (conjg (mu) + & (au_3 / tanb))) g_h43_211susd = ((g / (sqrt (2.0_default) * mass(24))) * vckm_32 * (( - ( & (mass(24)**2) * sin2be)) + (((mass(3)**2) * tanb) + ((mass(6)**2) / tanb)))) g_h43_222susd = ((sqrt (2.0_default) * g * mass(6) * mass(3) * vckm_32) / & (mass(24) * sin2be)) g_h43_212susd = (((g * mass(3)) / ( & sqrt (2.0_default) * mass(24))) * vckm_32 * (mu + ( & conjg (ad_2) * tanb))) g_h43_221susd = (((g * mass(6)) / ( & sqrt (2.0_default) * mass(24))) * vckm_32 * (conjg (mu) + & (au_3 / tanb))) g_h43_311susd = ((g / (sqrt (2.0_default) * mass(24))) * vckm_33 * (( - ( & (mass(24)**2) * sin2be)) + (((mass(5)**2) * tanb) + ((mass(6)**2) / tanb)))) g_h43_322susd = ((sqrt (2.0_default) * g * mass(6) * mass(5) * vckm_33) / & (mass(24) * sin2be)) g_h43_312susd = (((g * mass(5)) / ( & sqrt (2.0_default) * mass(24))) * vckm_33 * (mu + ( & conjg (ad_3) * tanb))) g_h43_321susd = (((g * mass(6)) / ( & sqrt (2.0_default) * mass(24))) * vckm_33 * (conjg (mu) + & (au_3 / tanb))) end subroutine setup_parameters10 subroutine setup_parameters11 () gh1sl1sl1_1 = g_h1111slsl gh1su1su1_1 = g_h1111susu gh1sd1sd1_1 = g_h1111sdsd gh2sl1sl1_1 = g_h2111slsl gh2su1su1_1 = g_h2111susu gh2sd1sd1_1 = g_h2111sdsd !!! gasl1sl1_1 = ((conjg (mix_sl111) * mix_sl112 * g_h3112slsl) + ( & !!! conjg (mix_sl112) * mix_sl111 * g_h3121slsl)) !!! gasu1su1_1 = ((conjg (mix_su111) * mix_su112 * g_h3112susu) + ( & !!! conjg (mix_su112) * mix_su111 * g_h3121susu)) !!! gasd1sd1_1 = ((conjg (mix_sd111) * mix_sd112 * g_h3112sdsd) + ( & !!! conjg (mix_sd112) * mix_sd111 * g_h3121sdsd)) !!! gasl1sl2_1 = ((conjg (mix_sl111) * mix_sl122 * g_h3112slsl) + ( & !!! conjg (mix_sl112) * mix_sl121 * g_h3121slsl)) !!! gasu1su2_1 = ((conjg (mix_su111) * mix_su122 * g_h3112susu) + ( & !!! conjg (mix_su112) * mix_su121 * g_h3121susu)) !!! gasd1sd2_1 = ((conjg (mix_sd111) * mix_sd122 * g_h3112sdsd) + ( & !!! conjg (mix_sd112) * mix_sd121 * g_h3121sdsd)) !!! gasl2sl1_1 = ((conjg (mix_sl121) * mix_sl112 * g_h3112slsl) + ( & !!! conjg (mix_sl122) * mix_sl111 * g_h3121slsl)) !!! gasu2su1_1 = ((conjg (mix_su121) * mix_su112 * g_h3112susu) + ( & !!! conjg (mix_su122) * mix_su111 * g_h3121susu)) !!! gasd2sd1_1 = ((conjg (mix_sd121) * mix_sd112 * g_h3112sdsd) + ( & !!! conjg (mix_sd122) * mix_sd111 * g_h3121sdsd)) gh1sl2sl2_1 = g_h1122slsl gh1su2su2_1 = g_h1122susu gh1sd2sd2_1 = g_h1122sdsd gh2sl2sl2_1 = g_h2122slsl gh2su2su2_1 = g_h2122susu gh2sd2sd2_1 = g_h2122sdsd !!! gasl2sl2_1 = ((conjg (mix_sl121) * mix_sl122 * g_h3112slsl) + ( & !!! conjg (mix_sl122) * mix_sl121 * g_h3121slsl)) !!! gasu2su2_1 = ((conjg (mix_su121) * mix_su122 * g_h3112susu) + ( & !!! conjg (mix_su122) * mix_su121 * g_h3121susu)) !!! gasd2sd2_1 = ((conjg (mix_sd121) * mix_sd122 * g_h3112sdsd) + ( & !!! conjg (mix_sd122) * mix_sd121 * g_h3121sdsd)) !!! ghsnsl1_1 = g_h4111slsn !!! ghsnsl1_1 = ((conjg (mix_sl111) * g_h4111slsn) + ( & !!! conjg (mix_sl112) * g_h4112slsn)) !!! ghsnsl1_1_c = conjg (ghsnsl1_1) ghsnsl1_1 = g_h4111slsn !!! ghsnsl2_1 = ((conjg (mix_sl121) * g_h4111slsn) + ( & !!! conjg (mix_sl122) * g_h4112slsn)) ghsnsl1_1_c = conjg (ghsnsl1_1) gh1sn1sn1_1 = g_h1111snsn gh2sn1sn1_1 = g_h2111snsn gh1sl1sl1_2 = g_h1211slsl gh1su1su1_2 = g_h1211susu gh1sd1sd1_2 = g_h1211sdsd gh2sl1sl1_2 = g_h2211slsl gh2su1su1_2 = g_h2211susu gh2sd1sd1_2 = g_h2211sdsd !!! gasl1sl1_2 = ((conjg (mix_sl211) * mix_sl212 * g_h3212slsl) + ( & !!! conjg (mix_sl212) * mix_sl211 * g_h3221slsl)) !!! gasu1su1_2 = ((conjg (mix_su211) * mix_su212 * g_h3212susu) + ( & !!! conjg (mix_su212) * mix_su211 * g_h3221susu)) !!! gasd1sd1_2 = ((conjg (mix_sd211) * mix_sd212 * g_h3212sdsd) + ( & !!! conjg (mix_sd212) * mix_sd211 * g_h3221sdsd)) !!! gasl1sl2_2 = ((conjg (mix_sl211) * mix_sl222 * g_h3212slsl) + ( & !!! conjg (mix_sl212) * mix_sl221 * g_h3221slsl)) !!! gasu1su2_2 = ((conjg (mix_su211) * mix_su222 * g_h3212susu) + ( & !!! conjg (mix_su212) * mix_su221 * g_h3221susu)) !!! gasd1sd2_2 = ((conjg (mix_sd211) * mix_sd222 * g_h3212sdsd) + ( & !!! conjg (mix_sd212) * mix_sd221 * g_h3221sdsd)) !!! gasl2sl1_2 = ((conjg (mix_sl221) * mix_sl212 * g_h3212slsl) + ( & !!! conjg (mix_sl222) * mix_sl211 * g_h3221slsl)) !!! gasu2su1_2 = ((conjg (mix_su221) * mix_su212 * g_h3212susu) + ( & !!! conjg (mix_su222) * mix_su211 * g_h3221susu)) !!! gasd2sd1_2 = ((conjg (mix_sd221) * mix_sd212 * g_h3212sdsd) + ( & !!! conjg (mix_sd222) * mix_sd211 * g_h3221sdsd)) gh1sl2sl2_2 = g_h1222slsl gh1su2su2_2 = g_h1222susu gh1sd2sd2_2 = g_h1222sdsd gh2sl2sl2_2 = g_h2222slsl gh2su2su2_2 = g_h2222susu gh2sd2sd2_2 = g_h2222sdsd !!! gasl2sl2_2 = ((conjg (mix_sl221) * mix_sl222 * g_h3212slsl) + ( & !!! conjg (mix_sl222) * mix_sl221 * g_h3221slsl)) !!! gasu2su2_2 = ((conjg (mix_su221) * mix_su222 * g_h3212susu) + ( & !!! conjg (mix_su222) * mix_su221 * g_h3221susu)) !!! gasd2sd2_2 = ((conjg (mix_sd221) * mix_sd222 * g_h3212sdsd) + ( & !!! conjg (mix_sd222) * mix_sd221 * g_h3221sdsd)) ghsnsl1_2 = g_h4211slsn !!! ghsnsl1_2 = ((conjg (mix_sl211) * g_h4211slsn) + ( & !!! conjg (mix_sl212) * g_h4212slsn)) ghsnsl1_2_c = conjg (ghsnsl1_2) !!! ghsnsl2_2 = g_h4211slsn !!! ghsnsl2_2 = ((conjg (mix_sl221) * g_h4211slsn) + ( & !!! conjg (mix_sl222) * g_h4212slsn)) !!! ghsnsl2_2_c = conjg (ghsnsl2_2) gh1sn1sn1_2 = g_h1211snsn gh2sn1sn1_2 = g_h2211snsn gh1sl1sl1_3 = ((conjg (mix_sl311) * mix_sl311 * g_h1311slsl) + ( & conjg (mix_sl312) * mix_sl312 * g_h1322slsl) + ( & conjg (mix_sl311) * mix_sl312 * g_h1312slsl) + ( & conjg (mix_sl312) * mix_sl311 * g_h1321slsl)) gh1su1su1_3 = ((conjg (mix_su311) * mix_su311 * g_h1311susu) + ( & conjg (mix_su312) * mix_su312 * g_h1322susu) + ( & conjg (mix_su311) * mix_su312 * g_h1312susu) + ( & conjg (mix_su312) * mix_su311 * g_h1321susu)) gh1sd1sd1_3 = ((conjg (mix_sd311) * mix_sd311 * g_h1311sdsd) + ( & conjg (mix_sd312) * mix_sd312 * g_h1322sdsd) + ( & conjg (mix_sd311) * mix_sd312 * g_h1312sdsd) + ( & conjg (mix_sd312) * mix_sd311 * g_h1321sdsd)) gh2sl1sl1_3 = ((conjg (mix_sl311) * mix_sl311 * g_h2311slsl) + ( & conjg (mix_sl312) * mix_sl312 * g_h2322slsl) + ( & conjg (mix_sl311) * mix_sl312 * g_h2312slsl) + ( & conjg (mix_sl312) * mix_sl311 * g_h2321slsl)) gh2su1su1_3 = ((conjg (mix_su311) * mix_su311 * g_h2311susu) + ( & conjg (mix_su312) * mix_su312 * g_h2322susu) + ( & conjg (mix_su311) * mix_su312 * g_h2312susu) + ( & conjg (mix_su312) * mix_su311 * g_h2321susu)) gh2sd1sd1_3 = ((conjg (mix_sd311) * mix_sd311 * g_h2311sdsd) + ( & conjg (mix_sd312) * mix_sd312 * g_h2322sdsd) + ( & conjg (mix_sd311) * mix_sd312 * g_h2312sdsd) + ( & conjg (mix_sd312) * mix_sd311 * g_h2321sdsd)) gasl1sl1_3 = ((conjg (mix_sl311) * mix_sl312 * g_h3312slsl) + ( & conjg (mix_sl312) * mix_sl311 * g_h3321slsl)) gasu1su1_3 = ((conjg (mix_su311) * mix_su312 * g_h3312susu) + ( & conjg (mix_su312) * mix_su311 * g_h3321susu)) gasd1sd1_3 = ((conjg (mix_sd311) * mix_sd312 * g_h3312sdsd) + ( & conjg (mix_sd312) * mix_sd311 * g_h3321sdsd)) gh1sl1sl2_3 = ((conjg (mix_sl311) * mix_sl321 * g_h1311slsl) + ( & conjg (mix_sl312) * mix_sl322 * g_h1322slsl) + ( & conjg (mix_sl311) * mix_sl322 * g_h1312slsl) + ( & conjg (mix_sl312) * mix_sl321 * g_h1321slsl)) gh1su1su2_3 = ((conjg (mix_su311) * mix_su321 * g_h1311susu) + ( & conjg (mix_su312) * mix_su322 * g_h1322susu) + ( & conjg (mix_su311) * mix_su322 * g_h1312susu) + ( & conjg (mix_su312) * mix_su321 * g_h1321susu)) gh1sd1sd2_3 = ((conjg (mix_sd311) * mix_sd321 * g_h1311sdsd) + ( & conjg (mix_sd312) * mix_sd322 * g_h1322sdsd) + ( & conjg (mix_sd311) * mix_sd322 * g_h1312sdsd) + ( & conjg (mix_sd312) * mix_sd321 * g_h1321sdsd)) gh2sl1sl2_3 = ((conjg (mix_sl311) * mix_sl321 * g_h2311slsl) + ( & conjg (mix_sl312) * mix_sl322 * g_h2322slsl) + ( & conjg (mix_sl311) * mix_sl322 * g_h2312slsl) + ( & conjg (mix_sl312) * mix_sl321 * g_h2321slsl)) gh2su1su2_3 = ((conjg (mix_su311) * mix_su321 * g_h2311susu) + ( & conjg (mix_su312) * mix_su322 * g_h2322susu) + ( & conjg (mix_su311) * mix_su322 * g_h2312susu) + ( & conjg (mix_su312) * mix_su321 * g_h2321susu)) gh2sd1sd2_3 = ((conjg (mix_sd311) * mix_sd321 * g_h2311sdsd) + ( & conjg (mix_sd312) * mix_sd322 * g_h2322sdsd) + ( & conjg (mix_sd311) * mix_sd322 * g_h2312sdsd) + ( & conjg (mix_sd312) * mix_sd321 * g_h2321sdsd)) gasl1sl2_3 = ((conjg (mix_sl311) * mix_sl322 * g_h3312slsl) + ( & conjg (mix_sl312) * mix_sl321 * g_h3321slsl)) gasu1su2_3 = ((conjg (mix_su311) * mix_su322 * g_h3312susu) + ( & conjg (mix_su312) * mix_su321 * g_h3321susu)) gasd1sd2_3 = ((conjg (mix_sd311) * mix_sd322 * g_h3312sdsd) + ( & conjg (mix_sd312) * mix_sd321 * g_h3321sdsd)) gh1sl2sl1_3 = ((conjg (mix_sl321) * mix_sl311 * g_h1311slsl) + ( & conjg (mix_sl322) * mix_sl312 * g_h1322slsl) + ( & conjg (mix_sl321) * mix_sl312 * g_h1312slsl) + ( & conjg (mix_sl322) * mix_sl311 * g_h1321slsl)) gh1su2su1_3 = ((conjg (mix_su321) * mix_su311 * g_h1311susu) + ( & conjg (mix_su322) * mix_su312 * g_h1322susu) + ( & conjg (mix_su321) * mix_su312 * g_h1312susu) + ( & conjg (mix_su322) * mix_su311 * g_h1321susu)) gh1sd2sd1_3 = ((conjg (mix_sd321) * mix_sd311 * g_h1311sdsd) + ( & conjg (mix_sd322) * mix_sd312 * g_h1322sdsd) + ( & conjg (mix_sd321) * mix_sd312 * g_h1312sdsd) + ( & conjg (mix_sd322) * mix_sd311 * g_h1321sdsd)) gh2sl2sl1_3 = ((conjg (mix_sl321) * mix_sl311 * g_h2311slsl) + ( & conjg (mix_sl322) * mix_sl312 * g_h2322slsl) + ( & conjg (mix_sl321) * mix_sl312 * g_h2312slsl) + ( & conjg (mix_sl322) * mix_sl311 * g_h2321slsl)) gh2su2su1_3 = ((conjg (mix_su321) * mix_su311 * g_h2311susu) + ( & conjg (mix_su322) * mix_su312 * g_h2322susu) + ( & conjg (mix_su321) * mix_su312 * g_h2312susu) + ( & conjg (mix_su322) * mix_su311 * g_h2321susu)) gh2sd2sd1_3 = ((conjg (mix_sd321) * mix_sd311 * g_h2311sdsd) + ( & conjg (mix_sd322) * mix_sd312 * g_h2322sdsd) + ( & conjg (mix_sd321) * mix_sd312 * g_h2312sdsd) + ( & conjg (mix_sd322) * mix_sd311 * g_h2321sdsd)) gasl2sl1_3 = ((conjg (mix_sl321) * mix_sl312 * g_h3312slsl) + ( & conjg (mix_sl322) * mix_sl311 * g_h3321slsl)) end subroutine setup_parameters11 subroutine setup_parameters12 () gasu2su1_3 = ((conjg (mix_su321) * mix_su312 * g_h3312susu) + ( & conjg (mix_su322) * mix_su311 * g_h3321susu)) gasd2sd1_3 = ((conjg (mix_sd321) * mix_sd312 * g_h3312sdsd) + ( & conjg (mix_sd322) * mix_sd311 * g_h3321sdsd)) gh1sl2sl2_3 = ((conjg (mix_sl321) * mix_sl321 * g_h1311slsl) + ( & conjg (mix_sl322) * mix_sl322 * g_h1322slsl) + ( & conjg (mix_sl321) * mix_sl322 * g_h1312slsl) + ( & conjg (mix_sl322) * mix_sl321 * g_h1321slsl)) gh1su2su2_3 = ((conjg (mix_su321) * mix_su321 * g_h1311susu) + ( & conjg (mix_su322) * mix_su322 * g_h1322susu) + ( & conjg (mix_su321) * mix_su322 * g_h1312susu) + ( & conjg (mix_su322) * mix_su321 * g_h1321susu)) gh1sd2sd2_3 = ((conjg (mix_sd321) * mix_sd321 * g_h1311sdsd) + ( & conjg (mix_sd322) * mix_sd322 * g_h1322sdsd) + ( & conjg (mix_sd321) * mix_sd322 * g_h1312sdsd) + ( & conjg (mix_sd322) * mix_sd321 * g_h1321sdsd)) gh2sl2sl2_3 = ((conjg (mix_sl321) * mix_sl321 * g_h2311slsl) + ( & conjg (mix_sl322) * mix_sl322 * g_h2322slsl) + ( & conjg (mix_sl321) * mix_sl322 * g_h2312slsl) + ( & conjg (mix_sl322) * mix_sl321 * g_h2321slsl)) gh2su2su2_3 = ((conjg (mix_su321) * mix_su321 * g_h2311susu) + ( & conjg (mix_su322) * mix_su322 * g_h2322susu) + ( & conjg (mix_su321) * mix_su322 * g_h2312susu) + ( & conjg (mix_su322) * mix_su321 * g_h2321susu)) gh2sd2sd2_3 = ((conjg (mix_sd321) * mix_sd321 * g_h2311sdsd) + ( & conjg (mix_sd322) * mix_sd322 * g_h2322sdsd) + ( & conjg (mix_sd321) * mix_sd322 * g_h2312sdsd) + ( & conjg (mix_sd322) * mix_sd321 * g_h2321sdsd)) gasl2sl2_3 = ((conjg (mix_sl321) * mix_sl322 * g_h3312slsl) + ( & conjg (mix_sl322) * mix_sl321 * g_h3321slsl)) gasu2su2_3 = ((conjg (mix_su321) * mix_su322 * g_h3312susu) + ( & conjg (mix_su322) * mix_su321 * g_h3321susu)) gasd2sd2_3 = ((conjg (mix_sd321) * mix_sd322 * g_h3312sdsd) + ( & conjg (mix_sd322) * mix_sd321 * g_h3321sdsd)) ghsnsl1_3 = ((conjg (mix_sl311) * g_h4311slsn) + ( & conjg (mix_sl312) * g_h4312slsn)) ghsnsl1_3_c = conjg (ghsnsl1_3) ghsnsl2_3 = ((conjg (mix_sl321) * g_h4311slsn) + ( & conjg (mix_sl322) * g_h4312slsn)) ghsnsl2_3_c = conjg (ghsnsl2_3) gh1sn1sn1_3 = g_h1311snsn gh2sn1sn1_3 = g_h2311snsn ghsu1sd1_1_1 = g_h41_111susd ghsu1sd1_1_1_c = conjg (ghsu1sd1_1_1) ghsu1sd1_1_2 = g_h41_211susd ghsu1sd1_1_2_c = conjg (ghsu1sd1_1_2) ghsu1sd1_1_3 = ((conjg (mix_su111) * mix_sd311 * g_h41_311susd) + ( & conjg (mix_su112) * mix_sd312 * g_h41_322susd) + ( & conjg (mix_su111) * mix_sd312 * g_h41_312susd) + ( & conjg (mix_su112) * mix_sd311 * g_h41_321susd)) ghsu1sd1_1_3_c = conjg (ghsu1sd1_1_3) ghsu1sd2_1_3 = ((conjg (mix_su111) * mix_sd321 * g_h41_311susd) + ( & conjg (mix_su112) * mix_sd322 * g_h41_322susd) + ( & conjg (mix_su111) * mix_sd322 * g_h41_312susd) + ( & conjg (mix_su112) * mix_sd321 * g_h41_321susd)) ghsu1sd2_1_3_c = conjg (ghsu1sd2_1_3) ghsu2sd1_1_3 = ((conjg (mix_su121) * mix_sd311 * g_h41_311susd) + ( & conjg (mix_su122) * mix_sd312 * g_h41_322susd) + ( & conjg (mix_su121) * mix_sd312 * g_h41_312susd) + ( & conjg (mix_su122) * mix_sd311 * g_h41_321susd)) ghsu2sd1_1_3_c = conjg (ghsu2sd1_1_3) ghsu2sd2_1_3 = ((conjg (mix_su121) * mix_sd321 * g_h41_311susd) + ( & conjg (mix_su122) * mix_sd322 * g_h41_322susd) + ( & conjg (mix_su121) * mix_sd322 * g_h41_312susd) + ( & conjg (mix_su122) * mix_sd321 * g_h41_321susd)) ghsu2sd2_1_3_c = conjg (ghsu2sd2_1_3) ghsu1sd1_2_1 = g_h42_111susd ghsu1sd1_2_1_c = conjg (ghsu1sd1_2_1) ghsu1sd1_2_2 = g_h42_211susd ghsu1sd1_2_2_c = conjg (ghsu1sd1_2_2) ghsu1sd1_2_3 = ((conjg (mix_su211) * mix_sd311 * g_h42_311susd) + ( & conjg (mix_su212) * mix_sd312 * g_h42_322susd) + ( & conjg (mix_su211) * mix_sd312 * g_h42_312susd) + ( & conjg (mix_su212) * mix_sd311 * g_h42_321susd)) ghsu1sd1_2_3_c = conjg (ghsu1sd1_2_3) ghsu1sd2_2_3 = ((conjg (mix_su211) * mix_sd321 * g_h42_311susd) + ( & conjg (mix_su212) * mix_sd322 * g_h42_322susd) + ( & conjg (mix_su211) * mix_sd322 * g_h42_312susd) + ( & conjg (mix_su212) * mix_sd321 * g_h42_321susd)) ghsu1sd2_2_3_c = conjg (ghsu1sd2_2_3) ghsu2sd1_2_3 = ((conjg (mix_su221) * mix_sd311 * g_h42_311susd) + ( & conjg (mix_su222) * mix_sd312 * g_h42_322susd) + ( & conjg (mix_su221) * mix_sd312 * g_h42_312susd) + ( & conjg (mix_su222) * mix_sd311 * g_h42_321susd)) ghsu2sd1_2_3_c = conjg (ghsu2sd1_2_3) ghsu2sd2_2_3 = ((conjg (mix_su221) * mix_sd321 * g_h42_311susd) + ( & conjg (mix_su222) * mix_sd322 * g_h42_322susd) + ( & conjg (mix_su221) * mix_sd322 * g_h42_312susd) + ( & conjg (mix_su222) * mix_sd321 * g_h42_321susd)) ghsu2sd2_2_3_c = conjg (ghsu2sd2_2_3) ghsu1sd1_3_1 = ((conjg (mix_su311) * mix_sd111 * g_h43_111susd) + ( & conjg (mix_su312) * mix_sd112 * g_h43_122susd) + ( & conjg (mix_su311) * mix_sd112 * g_h43_112susd) + ( & conjg (mix_su312) * mix_sd111 * g_h43_121susd)) ghsu1sd1_3_1_c = conjg (ghsu1sd1_3_1) ghsu1sd2_3_1 = ((conjg (mix_su311) * mix_sd121 * g_h43_111susd) + ( & conjg (mix_su312) * mix_sd122 * g_h43_122susd) + ( & conjg (mix_su311) * mix_sd122 * g_h43_112susd) + ( & conjg (mix_su312) * mix_sd121 * g_h43_121susd)) ghsu1sd2_3_1_c = conjg (ghsu1sd2_3_1) ghsu2sd1_3_1 = ((conjg (mix_su321) * mix_sd111 * g_h43_111susd) + ( & conjg (mix_su322) * mix_sd112 * g_h43_122susd) + ( & conjg (mix_su321) * mix_sd112 * g_h43_112susd) + ( & conjg (mix_su322) * mix_sd111 * g_h43_121susd)) ghsu2sd1_3_1_c = conjg (ghsu2sd1_3_1) ghsu2sd2_3_1 = ((conjg (mix_su321) * mix_sd121 * g_h43_111susd) + ( & conjg (mix_su322) * mix_sd122 * g_h43_122susd) + ( & conjg (mix_su321) * mix_sd122 * g_h43_112susd) + ( & conjg (mix_su322) * mix_sd121 * g_h43_121susd)) ghsu2sd2_3_1_c = conjg (ghsu2sd2_3_1) ghsu1sd1_3_2 = ((conjg (mix_su311) * mix_sd211 * g_h43_211susd) + ( & conjg (mix_su312) * mix_sd212 * g_h43_222susd) + ( & conjg (mix_su311) * mix_sd212 * g_h43_212susd) + ( & conjg (mix_su312) * mix_sd211 * g_h43_221susd)) ghsu1sd1_3_2_c = conjg (ghsu1sd1_3_2) ghsu1sd2_3_2 = ((conjg (mix_su311) * mix_sd221 * g_h43_211susd) + ( & conjg (mix_su312) * mix_sd222 * g_h43_222susd) + ( & conjg (mix_su311) * mix_sd222 * g_h43_212susd) + ( & conjg (mix_su312) * mix_sd221 * g_h43_221susd)) ghsu1sd2_3_2_c = conjg (ghsu1sd2_3_2) ghsu2sd1_3_2 = ((conjg (mix_su321) * mix_sd211 * g_h43_211susd) + ( & conjg (mix_su322) * mix_sd212 * g_h43_222susd) + ( & conjg (mix_su321) * mix_sd212 * g_h43_212susd) + ( & conjg (mix_su322) * mix_sd211 * g_h43_221susd)) ghsu2sd1_3_2_c = conjg (ghsu2sd1_3_2) ghsu2sd2_3_2 = ((conjg (mix_su321) * mix_sd221 * g_h43_211susd) + ( & conjg (mix_su322) * mix_sd222 * g_h43_222susd) + ( & conjg (mix_su321) * mix_sd222 * g_h43_212susd) + ( & conjg (mix_su322) * mix_sd221 * g_h43_221susd)) ghsu2sd2_3_2_c = conjg (ghsu2sd2_3_2) ghsu1sd1_3_3 = ((conjg (mix_su311) * mix_sd311 * g_h43_311susd) + ( & conjg (mix_su312) * mix_sd312 * g_h43_322susd) + ( & conjg (mix_su311) * mix_sd312 * g_h43_312susd) + ( & conjg (mix_su312) * mix_sd311 * g_h43_321susd)) ghsu1sd1_3_3_c = conjg (ghsu1sd1_3_3) ghsu1sd2_3_3 = ((conjg (mix_su311) * mix_sd321 * g_h43_311susd) + ( & conjg (mix_su312) * mix_sd322 * g_h43_322susd) + ( & conjg (mix_su311) * mix_sd322 * g_h43_312susd) + ( & conjg (mix_su312) * mix_sd321 * g_h43_321susd)) ghsu1sd2_3_3_c = conjg (ghsu1sd2_3_3) ghsu2sd1_3_3 = ((conjg (mix_su321) * mix_sd311 * g_h43_311susd) + ( & conjg (mix_su322) * mix_sd312 * g_h43_322susd) + ( & conjg (mix_su321) * mix_sd312 * g_h43_312susd) + ( & conjg (mix_su322) * mix_sd311 * g_h43_321susd)) ghsu2sd1_3_3_c = conjg (ghsu2sd1_3_3) ghsu2sd2_3_3 = ((conjg (mix_su321) * mix_sd321 * g_h43_311susd) + ( & conjg (mix_su322) * mix_sd322 * g_h43_322susd) + ( & conjg (mix_su321) * mix_sd322 * g_h43_312susd) + ( & conjg (mix_su322) * mix_sd321 * g_h43_321susd)) ghsu2sd2_3_3_c = conjg (ghsu2sd2_3_3) g_yuk_ch1_sl1_1_c = ((( - g) / 2.0_default) * mu_11) g_yuk_ch1_sl1_1 = conjg (g_yuk_ch1_sl1_1_c) g_yuk_ch1_sl1_2_c = ((( - g) / 2.0_default) * mu_11) g_yuk_ch1_sl1_2 = conjg (g_yuk_ch1_sl1_2_c) g_yuk_ch1_sl1_3_c = ((((( - g) / 2.0_default) * mu_11) * & conjg (mix_sl311)) + (((gcc * mass(15) * mu_12) / (mass(24) * cosbe)) * & conjg (mix_sl312))) g_yuk_ch1_sl1_3 = conjg (g_yuk_ch1_sl1_3_c) g_yuk_ch1_sl2_3_c = ((((( - g) / 2.0_default) * mu_11) * & conjg (mix_sl321)) + (((gcc * mass(15) * mu_12) / (mass(24) * cosbe)) * & conjg (mix_sl322))) g_yuk_ch1_sl2_3 = conjg (g_yuk_ch1_sl2_3_c) g_yuk_ch1_sn1_1_c = ( - ((g / 2.0_default) * mv_11)) g_yuk_ch1_sn1_1 = conjg (g_yuk_ch1_sn1_1_c) g_yuk_ch1_sn1_2_c = ( - ((g / 2.0_default) * mv_11)) g_yuk_ch1_sn1_2 = conjg (g_yuk_ch1_sn1_2_c) g_yuk_ch2_sl1_1_c = ((( - g) / 2.0_default) * mu_21) g_yuk_ch2_sl1_1 = conjg (g_yuk_ch2_sl1_1_c) g_yuk_ch2_sl1_2_c = ((( - g) / 2.0_default) * mu_21) g_yuk_ch2_sl1_2 = conjg (g_yuk_ch2_sl1_2_c) g_yuk_ch2_sl1_3_c = ((((( - g) / 2.0_default) * mu_21) * & conjg (mix_sl311)) + (((gcc * mass(15) * mu_22) / (mass(24) * cosbe)) * & conjg (mix_sl312))) g_yuk_ch2_sl1_3 = conjg (g_yuk_ch2_sl1_3_c) g_yuk_ch2_sl2_3_c = ((((( - g) / 2.0_default) * mu_21) * & conjg (mix_sl321)) + (((gcc * mass(15) * mu_22) / (mass(24) * cosbe)) * & conjg (mix_sl322))) g_yuk_ch2_sl2_3 = conjg (g_yuk_ch2_sl2_3_c) g_yuk_ch2_sl2_3_c = conjg (g_yuk_ch2_sl2_3) g_yuk_ch2_sn1_1_c = ( - ((g / 2.0_default) * mv_21)) g_yuk_ch2_sn1_1 = conjg (g_yuk_ch2_sn1_1_c) g_yuk_ch2_sn1_2_c = ( - ((g / 2.0_default) * mv_21)) g_yuk_ch2_sn1_2 = conjg (g_yuk_ch2_sn1_2_c) g_yuk_ch1_sd1_1_1 = ( - ((g / 2.0_default) * conjg (mu_11) * vckm_11)) g_yuk_ch1_sd1_1_1_c = conjg (g_yuk_ch1_sd1_1_1) g_yuk_ch1_su1_1_1 = ( - ((g / 2.0_default) * conjg (mv_11) * vckm_11)) g_yuk_ch1_su1_1_1_c = conjg (g_yuk_ch1_su1_1_1) g_yuk_ch1_sd1_1_2 = ( - ((g / 2.0_default) * conjg (mu_11) * vckm_12)) g_yuk_ch1_sd1_1_2_c = conjg (g_yuk_ch1_sd1_1_2) g_yuk_ch1_su1_1_2 = ( - ((g / 2.0_default) * conjg (mv_11) * vckm_12)) g_yuk_ch1_su1_1_2_c = conjg (g_yuk_ch1_su1_1_2) g_yuk_ch1_sd1_2_1 = ( - ((g / 2.0_default) * conjg (mu_11) * vckm_21)) g_yuk_ch1_sd1_2_1_c = conjg (g_yuk_ch1_sd1_2_1) g_yuk_ch1_su1_2_1 = ( - ((g / 2.0_default) * conjg (mv_11) * vckm_21)) g_yuk_ch1_su1_2_1_c = conjg (g_yuk_ch1_su1_2_1) g_yuk_ch1_sd1_2_2 = ( - ((g / 2.0_default) * conjg (mu_11) * vckm_22)) g_yuk_ch1_sd1_2_2_c = conjg (g_yuk_ch1_sd1_2_2) g_yuk_ch1_su1_2_2 = ( - ((g / 2.0_default) * conjg (mv_11) * vckm_22)) g_yuk_ch1_su1_2_2_c = conjg (g_yuk_ch1_su1_2_2) g_yuk_ch2_sd1_1_1 = ( - ((g / 2.0_default) * conjg (mu_21) * vckm_11)) g_yuk_ch2_sd1_1_1_c = conjg (g_yuk_ch2_sd1_1_1) g_yuk_ch2_su1_1_1 = ( - ((g / 2.0_default) * conjg (mv_21) * vckm_11)) g_yuk_ch2_su1_1_1_c = conjg (g_yuk_ch2_su1_1_1) g_yuk_ch2_sd1_1_2 = ( - ((g / 2.0_default) * conjg (mu_21) * vckm_12)) g_yuk_ch2_sd1_1_2_c = conjg (g_yuk_ch2_sd1_1_2) g_yuk_ch2_su1_1_2 = ( - ((g / 2.0_default) * conjg (mv_21) * vckm_12)) g_yuk_ch2_su1_1_2_c = conjg (g_yuk_ch2_su1_1_2) g_yuk_ch2_sd1_2_1 = ( - ((g / 2.0_default) * conjg (mu_21) * vckm_21)) g_yuk_ch2_sd1_2_1_c = conjg (g_yuk_ch2_sd1_2_1) g_yuk_ch2_su1_2_1 = ( - ((g / 2.0_default) * conjg (mv_21) * vckm_21)) g_yuk_ch2_su1_2_1_c = conjg (g_yuk_ch2_su1_2_1) g_yuk_ch2_sd1_2_2 = ( - ((g / 2.0_default) * conjg (mu_21) * vckm_22)) g_yuk_ch2_sd1_2_2_c = conjg (g_yuk_ch2_sd1_2_2) g_yuk_ch2_su1_2_2 = ( - ((g / 2.0_default) * conjg (mv_21) * vckm_22)) g_yuk_ch2_su1_2_2_c = conjg (g_yuk_ch2_su1_2_2) g_yuk_n1_sn1_1 = (gcc * ((mn_11 * (sinthw / costhw)) - mn_12)) g_yuk_n1_sn1_1_c = conjg (g_yuk_n1_sn1_1) g_yuk_n1_sn1_2 = (gcc * ((mn_11 * (sinthw / costhw)) - mn_12)) g_yuk_n1_sn1_2_c = conjg (g_yuk_n1_sn1_2) g_yuk_n1_sn1_3 = (gcc * ((mn_11 * (sinthw / costhw)) - mn_12)) g_yuk_n1_sn1_3_c = conjg (g_yuk_n1_sn1_3) g_yuk_n2_sn1_1 = (gcc * ((mn_21 * (sinthw / costhw)) - mn_22)) g_yuk_n2_sn1_1_c = conjg (g_yuk_n2_sn1_1) g_yuk_n2_sn1_2 = (gcc * ((mn_21 * (sinthw / costhw)) - mn_22)) g_yuk_n2_sn1_2_c = conjg (g_yuk_n2_sn1_2) g_yuk_n2_sn1_3 = (gcc * ((mn_21 * (sinthw / costhw)) - mn_22)) g_yuk_n2_sn1_3_c = conjg (g_yuk_n2_sn1_3) g_yuk_n3_sn1_1 = (gcc * ((mn_31 * (sinthw / costhw)) - mn_32)) g_yuk_n3_sn1_1_c = conjg (g_yuk_n3_sn1_1) g_yuk_n3_sn1_2 = (gcc * ((mn_31 * (sinthw / costhw)) - mn_32)) g_yuk_n3_sn1_2_c = conjg (g_yuk_n3_sn1_2) g_yuk_n3_sn1_3 = (gcc * ((mn_31 * (sinthw / costhw)) - mn_32)) g_yuk_n3_sn1_3_c = conjg (g_yuk_n3_sn1_3) g_yuk_n4_sn1_1 = (gcc * ((mn_41 * (sinthw / costhw)) - mn_42)) g_yuk_n4_sn1_1_c = conjg (g_yuk_n4_sn1_1) g_yuk_n4_sn1_2 = (gcc * ((mn_41 * (sinthw / costhw)) - mn_42)) g_yuk_n4_sn1_2_c = conjg (g_yuk_n4_sn1_2) g_yuk_n4_sn1_3 = (gcc * ((mn_41 * (sinthw / costhw)) - mn_42)) g_yuk_n4_sn1_3_c = conjg (g_yuk_n4_sn1_3) g_yuk_n1_sl1_1 = (gcc * (mn_12 + ((sinthw * mn_11) / costhw))) g_yuk_n1_sl1_1_c = conjg (g_yuk_n1_sl1_1) g_yuk_n1_sl2_1 = ((gcc * 2.0_default * q_lep * sinthw * & conjg (mn_11)) / costhw) g_yuk_n1_sl2_1_c = conjg (g_yuk_n1_sl2_1) g_yuk_n1_su1_1 = (( - gcc) * (mn_12 + ((sinthw * mn_11) / & (3.0_default * costhw)))) g_yuk_n1_su1_1_c = conjg (g_yuk_n1_su1_1) g_yuk_n1_su2_1 = ((gcc * 2.0_default * q_up * sinthw * & conjg (mn_11)) / costhw) g_yuk_n1_su2_1_c = conjg (g_yuk_n1_su2_1) g_yuk_n1_sd1_1 = (gcc * (mn_12 - ((sinthw * mn_11) / & (costhw * 3.0_default)))) g_yuk_n1_sd1_1_c = conjg (g_yuk_n1_sd1_1) g_yuk_n1_sd2_1 = ((gcc * 2.0_default * q_down * sinthw * & conjg (mn_11)) / costhw) g_yuk_n1_sd2_1_c = conjg (g_yuk_n1_sd2_1) g_yuk_n2_sl1_1 = (gcc * (mn_22 + ((sinthw * mn_21) / costhw))) g_yuk_n2_sl1_1_c = conjg (g_yuk_n2_sl1_1) g_yuk_n2_sl2_1 = ((gcc * 2.0_default * q_lep * sinthw * & conjg (mn_21)) / costhw) g_yuk_n2_sl2_1_c = conjg (g_yuk_n2_sl2_1) g_yuk_n2_su1_1 = (( - gcc) * (mn_22 + ((sinthw * mn_21) / & (3.0_default * costhw)))) g_yuk_n2_su1_1_c = conjg (g_yuk_n2_su1_1) g_yuk_n2_su2_1 = ((gcc * 2.0_default * q_up * sinthw * & conjg (mn_21)) / costhw) g_yuk_n2_su2_1_c = conjg (g_yuk_n2_su2_1) g_yuk_n2_sd1_1 = (gcc * (mn_22 - ((sinthw * mn_21) / & (costhw * 3.0_default)))) g_yuk_n2_sd1_1_c = conjg (g_yuk_n2_sd1_1) g_yuk_n2_sd2_1 = ((gcc * 2.0_default * q_down * sinthw * & conjg (mn_21)) / costhw) g_yuk_n2_sd2_1_c = conjg (g_yuk_n2_sd2_1) g_yuk_n3_sl1_1 = (gcc * (mn_32 + ((sinthw * mn_31) / costhw))) g_yuk_n3_sl1_1_c = conjg (g_yuk_n3_sl1_1) g_yuk_n3_sl2_1 = ((gcc * 2.0_default * q_lep * sinthw * & conjg (mn_31)) / costhw) g_yuk_n3_sl2_1_c = conjg (g_yuk_n3_sl2_1) g_yuk_n3_su1_1 = (( - gcc) * (mn_32 + ((sinthw * mn_31) / & (3.0_default * costhw)))) g_yuk_n3_su1_1_c = conjg (g_yuk_n3_su1_1) g_yuk_n3_su2_1 = ((gcc * 2.0_default * q_up * sinthw * & conjg (mn_31)) / costhw) g_yuk_n3_su2_1_c = conjg (g_yuk_n3_su2_1) g_yuk_n3_sd1_1 = (gcc * (mn_32 - ((sinthw * mn_31) / & (costhw * 3.0_default)))) g_yuk_n3_sd1_1_c = conjg (g_yuk_n3_sd1_1) g_yuk_n3_sd2_1 = ((gcc * 2.0_default * q_down * sinthw * & conjg (mn_31)) / costhw) g_yuk_n3_sd2_1_c = conjg (g_yuk_n3_sd2_1) g_yuk_n4_sl1_1 = (gcc * (mn_42 + ((sinthw * mn_41) / costhw))) g_yuk_n4_sl1_1_c = conjg (g_yuk_n4_sl1_1) g_yuk_n4_sl2_1 = ((gcc * 2.0_default * q_lep * sinthw * & conjg (mn_41)) / costhw) g_yuk_n4_sl2_1_c = conjg (g_yuk_n4_sl2_1) g_yuk_n4_su1_1 = (( - gcc) * (mn_42 + ((sinthw * mn_41) / & (3.0_default * costhw)))) g_yuk_n4_su1_1_c = conjg (g_yuk_n4_su1_1) g_yuk_n4_su2_1 = ((gcc * 2.0_default * q_up * sinthw * & conjg (mn_41)) / costhw) g_yuk_n4_su2_1_c = conjg (g_yuk_n4_su2_1) g_yuk_n4_sd1_1 = (gcc * (mn_42 - ((sinthw * mn_41) / & (costhw * 3.0_default)))) g_yuk_n4_sd1_1_c = conjg (g_yuk_n4_sd1_1) g_yuk_n4_sd2_1 = ((gcc * 2.0_default * q_down * sinthw * & conjg (mn_41)) / costhw) g_yuk_n4_sd2_1_c = conjg (g_yuk_n4_sd2_1) g_yuk_n1_sl1_2 = (gcc * (mn_12 + ((sinthw * mn_11) / costhw))) g_yuk_n1_sl1_2_c = conjg (g_yuk_n1_sl1_2) g_yuk_n1_sl2_2 = ((gcc * 2.0_default * q_lep * sinthw * & conjg (mn_11)) / costhw) g_yuk_n1_sl2_2_c = conjg (g_yuk_n1_sl2_2) g_yuk_n1_su1_2 = (( - gcc) * (mn_12 + ((sinthw * mn_11) / & (3.0_default * costhw)))) g_yuk_n1_su1_2_c = conjg (g_yuk_n1_su1_2) g_yuk_n1_su2_2 = ((gcc * 2.0_default * q_up * sinthw * & conjg (mn_11)) / costhw) g_yuk_n1_su2_2_c = conjg (g_yuk_n1_su2_2) g_yuk_n1_sd1_2 = (gcc * (mn_12 - ((sinthw * mn_11) / & (costhw * 3.0_default)))) g_yuk_n1_sd1_2_c = conjg (g_yuk_n1_sd1_2) g_yuk_n1_sd2_2 = ((gcc * 2.0_default * q_down * sinthw * & conjg (mn_11)) / costhw) g_yuk_n1_sd2_2_c = conjg (g_yuk_n1_sd2_2) g_yuk_n2_sl1_2 = (gcc * (mn_22 + ((sinthw * mn_21) / costhw))) g_yuk_n2_sl1_2_c = conjg (g_yuk_n2_sl1_2) g_yuk_n2_sl2_2 = ((gcc * 2.0_default * q_lep * sinthw * & conjg (mn_21)) / costhw) g_yuk_n2_sl2_2_c = conjg (g_yuk_n2_sl2_2) g_yuk_n2_su1_2 = (( - gcc) * (mn_22 + ((sinthw * mn_21) / & (3.0_default * costhw)))) g_yuk_n2_su1_2_c = conjg (g_yuk_n2_su1_2) g_yuk_n2_su2_2 = ((gcc * 2.0_default * q_up * sinthw * & conjg (mn_21)) / costhw) g_yuk_n2_su2_2_c = conjg (g_yuk_n2_su2_2) g_yuk_n2_sd1_2 = (gcc * (mn_22 - ((sinthw * mn_21) / & (costhw * 3.0_default)))) g_yuk_n2_sd1_2_c = conjg (g_yuk_n2_sd1_2) g_yuk_n2_sd2_2 = ((gcc * 2.0_default * q_down * sinthw * & conjg (mn_21)) / costhw) g_yuk_n2_sd2_2_c = conjg (g_yuk_n2_sd2_2) g_yuk_n3_sl1_2 = (gcc * (mn_32 + ((sinthw * mn_31) / costhw))) g_yuk_n3_sl1_2_c = conjg (g_yuk_n3_sl1_2) g_yuk_n3_sl2_2 = ((gcc * 2.0_default * q_lep * sinthw * & conjg (mn_31)) / costhw) g_yuk_n3_sl2_2_c = conjg (g_yuk_n3_sl2_2) g_yuk_n3_su1_2 = (( - gcc) * (mn_32 + ((sinthw * mn_31) / & (3.0_default * costhw)))) g_yuk_n3_su1_2_c = conjg (g_yuk_n3_su1_2) g_yuk_n3_su2_2 = ((gcc * 2.0_default * q_up * sinthw * & conjg (mn_31)) / costhw) g_yuk_n3_su2_2_c = conjg (g_yuk_n3_su2_2) g_yuk_n3_sd1_2 = (gcc * (mn_32 - ((sinthw * mn_31) / & (costhw * 3.0_default)))) g_yuk_n3_sd1_2_c = conjg (g_yuk_n3_sd1_2) g_yuk_n3_sd2_2 = ((gcc * 2.0_default * q_down * sinthw * & conjg (mn_31)) / costhw) g_yuk_n3_sd2_2_c = conjg (g_yuk_n3_sd2_2) g_yuk_n4_sl1_2 = (gcc * (mn_42 + ((sinthw * mn_41) / costhw))) g_yuk_n4_sl1_2_c = conjg (g_yuk_n4_sl1_2) g_yuk_n4_sl2_2 = ((gcc * 2.0_default * q_lep * sinthw * & conjg (mn_41)) / costhw) g_yuk_n4_sl2_2_c = conjg (g_yuk_n4_sl2_2) g_yuk_n4_su1_2 = (( - gcc) * (mn_42 + ((sinthw * mn_41) / & (3.0_default * costhw)))) g_yuk_n4_su1_2_c = conjg (g_yuk_n4_su1_2) g_yuk_n4_su2_2 = ((gcc * 2.0_default * q_up * sinthw * & conjg (mn_41)) / costhw) g_yuk_n4_su2_2_c = conjg (g_yuk_n4_su2_2) g_yuk_n4_sd1_2 = (gcc * (mn_42 - ((sinthw * mn_41) / & (costhw * 3.0_default)))) g_yuk_n4_sd1_2_c = conjg (g_yuk_n4_sd1_2) g_yuk_n4_sd2_2 = ((gcc * 2.0_default * q_down * sinthw * & conjg (mn_41)) / costhw) g_yuk_n4_sd2_2_c = conjg (g_yuk_n4_sd2_2) end subroutine setup_parameters12 subroutine setup_parameters13 () gncneu(1) = ((gz / 2.0_default) * ( & (2.0_default * 0.0_default * sin2thw) - & (1.0_default / 2.0_default))) gncneu(2) = ((( - gz) / 2.0_default) * & (1.0_default / 2.0_default)) gnclep(1) = ((gz / 2.0_default) * ( & (2.0_default * (-1.0_default) * sin2thw) - ( - & (1.0_default / 2.0_default)))) gnclep(2) = ((( - gz) / 2.0_default) * ( - & (1.0_default / 2.0_default))) gncup(1) = ((gz / 2.0_default) * ((2.0_default * & (2.0_default / 3.0_default) * sin2thw) - & (1.0_default / 2.0_default))) gncup(2) = ((( - gz) / 2.0_default) * (1.0_default / 2.0_default)) gncdwn(1) = ((gz / 2.0_default) * ((2.0_default * & ((-1.0_default) / 3.0_default) * sin2thw) - ( - & (1.0_default / 2.0_default)))) gncdwn(2) = ((( - gz) / 2.0_default) * ( - & (1.0_default / 2.0_default))) g_yuk1_1_3(1) = ((gcc / mass(24)) * vckm_13 * (mass(2) / tanb)) g_yuk1_1_3(2) = ((gcc / mass(24)) * vckm_13 * tanb * mass(5)) g_yuk1_2_3(1) = ((gcc / mass(24)) * vckm_23 * (mass(4) / tanb)) g_yuk1_2_3(2) = ((gcc / mass(24)) * vckm_23 * tanb * mass(5)) g_yuk1_3_3(1) = ((gcc / mass(24)) * vckm_33 * (mass(6) / tanb)) g_yuk1_3_3(2) = ((gcc / mass(24)) * vckm_33 * tanb * mass(5)) g_yuk1_3_2(1) = ((gcc / mass(24)) * vckm_32 * (mass(6) / tanb)) g_yuk1_3_2(2) = ((gcc / mass(24)) * vckm_32 * tanb * mass(3)) g_yuk1_3_1(1) = ((gcc / mass(24)) * vckm_31 * (mass(6) / tanb)) g_yuk1_3_1(2) = ((gcc / mass(24)) * vckm_31 * tanb * mass(1)) g_yuk2_1_3(1) = conjg (g_yuk1_1_3(2)) g_yuk2_1_3(2) = conjg (g_yuk1_1_3(1)) g_yuk2_2_3(1) = conjg (g_yuk1_2_3(2)) g_yuk2_2_3(2) = conjg (g_yuk1_2_3(1)) g_yuk2_3_1(1) = conjg (g_yuk1_3_1(2)) g_yuk2_3_1(2) = conjg (g_yuk1_3_1(1)) g_yuk2_3_2(1) = conjg (g_yuk1_3_2(2)) g_yuk2_3_2(2) = conjg (g_yuk1_3_2(1)) g_yuk2_3_3(1) = conjg (g_yuk1_3_3(2)) g_yuk2_3_3(2) = conjg (g_yuk1_3_3(1)) gnzn_1_2(1) = (gz * vector0_12) gnzn_1_2(2) = (gz * axial0_12) gnzn_1_3(1) = (gz * vector0_13) gnzn_1_3(2) = (gz * axial0_13) gnzn_1_4(1) = (gz * vector0_14) gnzn_1_4(2) = (gz * axial0_14) gnzn_2_3(1) = (gz * vector0_23) gnzn_2_3(2) = (gz * axial0_23) gnzn_2_4(1) = (gz * vector0_24) gnzn_2_4(2) = (gz * axial0_24) gnzn_3_4(1) = (gz * vector0_34) gnzn_3_4(2) = (gz * axial0_34) gczc_1_1(1) = (gz * vp_11) gczc_1_1(2) = (gz * ap_11) gczc_1_2(1) = (gz * vp_12) gczc_1_2(2) = (gz * ap_12) gczc_2_1(1) = (gz * vp_21) gczc_2_1(2) = (gz * ap_21) gczc_2_2(1) = (gz * vp_22) gczc_2_2(2) = (gz * ap_22) gnwc_1_1(1) = (gcc * lnc_11) gnwc_1_1(2) = (gcc * rnc_11) g_nhc_1_1(1) = ((g / 2.0_default) * lnch_11) g_nhc_1_1(2) = ((g / 2.0_default) * rnch_11) gnwc_1_2(1) = (gcc * lnc_12) gnwc_1_2(2) = (gcc * rnc_12) g_nhc_1_2(1) = ((g / 2.0_default) * lnch_12) g_nhc_1_2(2) = ((g / 2.0_default) * rnch_12) gnwc_2_1(1) = (gcc * lnc_21) gnwc_2_1(2) = (gcc * rnc_21) g_nhc_2_1(1) = ((g / 2.0_default) * lnch_21) g_nhc_2_1(2) = ((g / 2.0_default) * rnch_21) gnwc_2_2(1) = (gcc * lnc_22) gnwc_2_2(2) = (gcc * rnc_22) g_nhc_2_2(1) = ((g / 2.0_default) * lnch_22) g_nhc_2_2(2) = ((g / 2.0_default) * rnch_22) gnwc_3_1(1) = (gcc * lnc_31) gnwc_3_1(2) = (gcc * rnc_31) g_nhc_3_1(1) = ((g / 2.0_default) * lnch_31) g_nhc_3_1(2) = ((g / 2.0_default) * rnch_31) gnwc_3_2(1) = (gcc * lnc_32) gnwc_3_2(2) = (gcc * rnc_32) g_nhc_3_2(1) = ((g / 2.0_default) * lnch_32) g_nhc_3_2(2) = ((g / 2.0_default) * rnch_32) gnwc_4_1(1) = (gcc * lnc_41) gnwc_4_1(2) = (gcc * rnc_41) g_nhc_4_1(1) = ((g / 2.0_default) * lnch_41) g_nhc_4_1(2) = ((g / 2.0_default) * rnch_41) gnwc_4_2(1) = (gcc * lnc_42) gnwc_4_2(2) = (gcc * rnc_42) g_nhc_4_2(1) = ((g / 2.0_default) * lnch_42) g_nhc_4_2(2) = ((g / 2.0_default) * rnch_42) gcwn_1_1(1) = (gcc * lcn_11) gcwn_1_1(2) = (gcc * rcn_11) g_chn_1_1(1) = ((g / 2.0_default) * conjg (rnch_11)) g_chn_1_1(2) = ((g / 2.0_default) * conjg (lnch_11)) gcwn_1_2(1) = (gcc * lcn_12) gcwn_1_2(2) = (gcc * rcn_12) g_chn_2_1(1) = ((g / 2.0_default) * conjg (rnch_21)) g_chn_2_1(2) = ((g / 2.0_default) * conjg (lnch_21)) gcwn_1_3(1) = (gcc * lcn_13) gcwn_1_3(2) = (gcc * rcn_13) g_chn_3_1(1) = ((g / 2.0_default) * conjg (rnch_31)) g_chn_3_1(2) = ((g / 2.0_default) * conjg (lnch_31)) gcwn_1_4(1) = (gcc * lcn_14) gcwn_1_4(2) = (gcc * rcn_14) g_chn_4_1(1) = ((g / 2.0_default) * conjg (rnch_41)) g_chn_4_1(2) = ((g / 2.0_default) * conjg (lnch_41)) gcwn_2_1(1) = (gcc * lcn_21) gcwn_2_1(2) = (gcc * rcn_21) g_chn_1_2(1) = ((g / 2.0_default) * conjg (rnch_12)) g_chn_1_2(2) = ((g / 2.0_default) * conjg (lnch_12)) gcwn_2_2(1) = (gcc * lcn_22) gcwn_2_2(2) = (gcc * rcn_22) g_chn_2_2(1) = ((g / 2.0_default) * conjg (rnch_22)) g_chn_2_2(2) = ((g / 2.0_default) * conjg (lnch_22)) gcwn_2_3(1) = (gcc * lcn_23) gcwn_2_3(2) = (gcc * rcn_23) g_chn_3_2(1) = ((g / 2.0_default) * conjg (rnch_32)) g_chn_3_2(2) = ((g / 2.0_default) * conjg (lnch_32)) gcwn_2_4(1) = (gcc * lcn_24) gcwn_2_4(2) = (gcc * rcn_24) g_chn_4_2(1) = ((g / 2.0_default) * conjg (rnch_42)) g_chn_4_2(2) = ((g / 2.0_default) * conjg (lnch_42)) gcicih1_1_1 = ((( - g ) / 2.0_default) * snnh1_11) gcicih2_1_1 = ((( - g ) / 2.0_default) * snnh2_11) gcicia_1_1 = ((( - g ) / 2.0_default) * pnna_11) gcicih1_1_2(1) = ((( - g ) / 2.0_default) * snnh1_12) gcicih1_1_2(2) = ((( - g ) / 2.0_default) * pnnh1_12) gcicih2_1_2(1) = ((( - g ) / 2.0_default) * snnh2_12) gcicih2_1_2(2) = ((( - g ) / 2.0_default) * pnnh2_12) gcicia_1_2(1) = ((( - g ) / 2.0_default) * snna_12) gcicia_1_2(2) = ((( - g ) / 2.0_default) * pnna_12) gcicih1_1_3(1) = ((( - g ) / 2.0_default) * snnh1_13) gcicih1_1_3(2) = ((( - g ) / 2.0_default) * pnnh1_13) gcicih2_1_3(1) = ((( - g ) / 2.0_default) * snnh2_13) gcicih2_1_3(2) = ((( - g ) / 2.0_default) * pnnh2_13) gcicia_1_3(1) = ((( - g ) / 2.0_default) * snna_13) gcicia_1_3(2) = ((( - g ) / 2.0_default) * pnna_13) gcicih1_1_4(1) = ((( - g ) / 2.0_default) * snnh1_14) gcicih1_1_4(2) = ((( - g ) / 2.0_default) * pnnh1_14) gcicih2_1_4(1) = ((( - g ) / 2.0_default) * snnh2_14) gcicih2_1_4(2) = ((( - g ) / 2.0_default) * pnnh2_14) gcicia_1_4(1) = ((( - g ) / 2.0_default) * snna_14) gcicia_1_4(2) = ((( - g ) / 2.0_default) * pnna_14) gcicih1_2_2 = ((( - g ) / 2.0_default) * snnh1_22) gcicih2_2_2 = ((( - g ) / 2.0_default) * snnh2_22) gcicia_2_2 = ((( - g ) / 2.0_default) * pnna_22) gcicih1_2_3(1) = ((( - g ) / 2.0_default) * snnh1_23) gcicih1_2_3(2) = ((( - g ) / 2.0_default) * pnnh1_23) gcicih2_2_3(1) = ((( - g ) / 2.0_default) * snnh2_23) gcicih2_2_3(2) = ((( - g ) / 2.0_default) * pnnh2_23) end subroutine setup_parameters13 subroutine setup_parameters14 () !!! JR checked gch[x]h_[x]_[x] gcicia_2_3(1) = ((( - g ) / 2.0_default) * snna_23) gcicia_2_3(2) = ((( - g ) / 2.0_default) * pnna_23) gcicih1_2_4(1) = ((( - g ) / 2.0_default) * snnh1_24) gcicih1_2_4(2) = ((( - g ) / 2.0_default) * pnnh1_24) gcicih2_2_4(1) = ((( - g ) / 2.0_default) * snnh2_24) gcicih2_2_4(2) = ((( - g ) / 2.0_default) * pnnh2_24) gcicia_2_4(1) = ((( - g ) / 2.0_default) * snna_24) gcicia_2_4(2) = ((( - g ) / 2.0_default) * pnna_24) gcicih1_3_3 = ((( - g ) / 2.0_default) * snnh1_33) gcicih2_3_3 = ((( - g ) / 2.0_default) * snnh2_33) gcicia_3_3 = ((( - g ) / 2.0_default) * pnna_33) gcicih1_3_4(1) = ((( - g ) / 2.0_default) * snnh1_34) gcicih1_3_4(2) = ((( - g ) / 2.0_default) * pnnh1_34) gcicih2_3_4(1) = ((( - g ) / 2.0_default) * snnh2_34) gcicih2_3_4(2) = ((( - g ) / 2.0_default) * pnnh2_34) gcicia_3_4(1) = ((( - g ) / 2.0_default) * snna_34) gcicia_3_4(2) = ((( - g ) / 2.0_default) * pnna_34) gcicih1_4_4 = ((( - g ) / 2.0_default) * snnh1_44) gcicih2_4_4 = ((( - g ) / 2.0_default) * snnh2_44) gcicia_4_4 = ((( - g ) / 2.0_default) * pnna_44) gch1c_1_1 = (( - (g / sqrt (2.0_default))) * ((conjg (mu_11) * & conjg (mv_12) * cosal) - (conjg (mu_12) * conjg (mv_11) * sinal))) gch2c_1_1 = (( - (g / sqrt (2.0_default))) * ((conjg (mu_12) * & conjg (mv_11) * cosal) + (conjg (mu_11) * conjg (mv_12) * sinal))) gcac_1_1 = (imago * ( - (g / & sqrt (2.0_default))) * ((mv_11 * mu_12 * sinbe) + & (mv_12 * mu_11 * cosbe))) gch1c_1_2(1) = (( - gcc) * ((conjg (mu_11) * & conjg (mv_22) * cosal) - (conjg (mu_12) * conjg (mv_21) * sinal))) gch1c_1_2(2) = (( - gcc) * ( & (mv_12 * mu_21 * cosal) - (mv_11 * mu_22 * sinal))) gch2c_1_2(1) = (( - gcc) * ((conjg (mu_12) * & conjg (mv_21) * cosal) + (conjg (mu_11) * conjg (mv_22) * sinal))) gch2c_1_2(2) = (( - gcc) * ((mv_11 * mu_22 * cosal) & + (mv_12 * mu_21 * sinal))) gcac_1_2(1) = (imago * gcc * (( & conjg (mu_12) * conjg (mv_21) * sinbe) + ( & conjg (mu_11) * conjg (mv_22) * cosbe))) gcac_1_2(2) = (( - imago) * gcc * (( & mv_11 * mu_22 * sinbe) + (mv_12 * mu_21 * cosbe))) gch1c_2_1(1) = conjg (gch1c_1_2(2)) gch1c_2_1(2) = conjg (gch1c_1_2(1)) gch2c_2_1(1) = conjg (gch2c_1_2(2)) gch2c_2_1(2) = conjg (gch2c_1_2(1)) gcac_2_1(1) = conjg (gcac_1_2(2)) gcac_2_1(2) = conjg (gcac_1_2(1)) gch1c_2_2 = (( - (g / sqrt (2.0_default))) * ((conjg (mu_21) * & conjg (mv_22) * cosal) - (conjg (mu_22) * conjg (mv_21) * sinal))) gch2c_2_2 = (( - (g / sqrt (2.0_default))) * ((conjg (mu_22) * & conjg (mv_21) * cosal) + (conjg (mu_21) * conjg (mv_22) * sinal))) gcac_2_2 = (imago * ( - (g / & sqrt (2.0_default))) * ((mv_21 * mu_22 * sinbe) + & (mv_22 * mu_21 * cosbe))) g_yuk_ch1_sn1_3_c(1) = ((gcc * mass(15) * conjg (mu_12)) / (mass(24) & * cosbe)) g_yuk_ch1_sn1_3_c(2) = ( - ((g * mv_11) / 2.0_default)) g_yuk_ch1_sn1_3(1) = conjg (g_yuk_ch1_sn1_3_c(2)) g_yuk_ch1_sn1_3(2) = conjg (g_yuk_ch1_sn1_3_c(1)) g_yuk_ch2_sn1_3_c(1) = ((gcc * mass(15) * conjg (mu_22)) / (mass(24) & * cosbe)) g_yuk_ch2_sn1_3_c(2) = ( - ((g * mv_21) / 2.0_default)) g_yuk_ch2_sn1_3(1) = conjg (g_yuk_ch2_sn1_3_c(2)) g_yuk_ch2_sn1_3(2) = conjg (g_yuk_ch2_sn1_3_c(1)) g_yuk_ch1_sd1_1_3(1) = ((vckm_13 * gcc * mv_12 * mass(2) * & conjg (mix_sd311)) / (mass(24) * sinbe)) g_yuk_ch1_sd1_1_3(2) = (vckm_13 * gcc * (((conjg (mu_12) * mass(5) * & conjg (mix_sd312)) / (mass(24) * cosbe)) - (conjg (mu_11) * & sqrt (2.0_default) * conjg (mix_sd311)))) g_yuk_ch1_sd1_1_3_c(1) = conjg (g_yuk_ch1_sd1_1_3(2)) g_yuk_ch1_sd1_1_3_c(2) = conjg (g_yuk_ch1_sd1_1_3(1)) g_yuk_ch1_su1_1_3(1) = (vckm_13 * gcc * (((conjg (mv_12) * mass(2) * & conjg (mix_su112)) / (mass(24) * sinbe)) - (conjg (mv_11) * & sqrt (2.0_default) * conjg (mix_su111)))) g_yuk_ch1_su1_1_3(2) = ((vckm_13 * gcc * mu_12 * mass(5) * & conjg (mix_su111)) / (mass(24) * cosbe)) g_yuk_ch1_su1_1_3_c(1) = conjg (g_yuk_ch1_su1_1_3(2)) g_yuk_ch1_su1_1_3_c(2) = conjg (g_yuk_ch1_su1_1_3(1)) end subroutine setup_parameters14 subroutine setup_parameters15 () g_yuk_ch1_sd1_2_3(1) = ((vckm_23 * gcc * mv_12 * mass(4) * & conjg (mix_sd311)) / (mass(24) * sinbe)) g_yuk_ch1_sd1_2_3(2) = (vckm_23 * gcc * (((conjg (mu_12) * mass(5) * & conjg (mix_sd312)) / (mass(24) * cosbe)) - (conjg (mu_11) * & sqrt (2.0_default) * conjg (mix_sd311)))) g_yuk_ch1_sd1_2_3_c(1) = conjg (g_yuk_ch1_sd1_2_3(2)) g_yuk_ch1_sd1_2_3_c(2) = conjg (g_yuk_ch1_sd1_2_3(1)) g_yuk_ch1_su1_2_3(1) = (vckm_23 * gcc * (((conjg (mv_12) * mass(4) * & conjg (mix_su212)) / (mass(24) * sinbe)) - (conjg (mv_11) * & sqrt (2.0_default) * conjg (mix_su211)))) g_yuk_ch1_su1_2_3(2) = ((vckm_23 * gcc * mu_12 * mass(5) * & conjg (mix_su211)) / (mass(24) * cosbe)) g_yuk_ch1_su1_2_3_c(1) = conjg (g_yuk_ch1_su1_2_3(2)) g_yuk_ch1_su1_2_3_c(2) = conjg (g_yuk_ch1_su1_2_3(1)) g_yuk_ch1_sd1_3_3(1) = ((vckm_33 * gcc * mv_12 * mass(6) * & conjg (mix_sd311)) / (mass(24) * sinbe)) g_yuk_ch1_sd1_3_3(2) = (vckm_33 * gcc * (((conjg (mu_12) * mass(5) * & conjg (mix_sd312)) / (mass(24) * cosbe)) - (conjg (mu_11) * & sqrt (2.0_default) * conjg (mix_sd311)))) g_yuk_ch1_sd1_3_3_c(1) = conjg (g_yuk_ch1_sd1_3_3(2)) g_yuk_ch1_sd1_3_3_c(2) = conjg (g_yuk_ch1_sd1_3_3(1)) g_yuk_ch1_su1_3_3(1) = (vckm_33 * gcc * (((conjg (mv_12) * mass(6) * & conjg (mix_su312)) / (mass(24) * sinbe)) - (conjg (mv_11) * & sqrt (2.0_default) * conjg (mix_su311)))) g_yuk_ch1_su1_3_3(2) = ((vckm_33 * gcc * mu_12 * mass(5) * & conjg (mix_su311)) / (mass(24) * cosbe)) g_yuk_ch1_su1_3_3_c(1) = conjg (g_yuk_ch1_su1_3_3(2)) g_yuk_ch1_su1_3_3_c(2) = conjg (g_yuk_ch1_su1_3_3(1)) g_yuk_ch1_sd1_3_2(1) = ((vckm_32 * gcc * mv_12 * mass(6) * & conjg (mix_sd211)) / (mass(24) * sinbe)) g_yuk_ch1_sd1_3_2(2) = (vckm_32 * gcc * (((conjg (mu_12) * mass(3) * & conjg (mix_sd212)) / (mass(24) * cosbe)) - (conjg (mu_11) * & sqrt (2.0_default) * conjg (mix_sd211)))) g_yuk_ch1_sd1_3_2_c(1) = conjg (g_yuk_ch1_sd1_3_2(2)) g_yuk_ch1_sd1_3_2_c(2) = conjg (g_yuk_ch1_sd1_3_2(1)) g_yuk_ch1_su1_3_2(1) = (vckm_32 * gcc * (((conjg (mv_12) * mass(6) * & conjg (mix_su312)) / (mass(24) * sinbe)) - (conjg (mv_11) * & sqrt (2.0_default) * conjg (mix_su311)))) g_yuk_ch1_su1_3_2(2) = ((vckm_32 * gcc * mu_12 * mass(3) * & conjg (mix_su311)) / (mass(24) * cosbe)) g_yuk_ch1_su1_3_2_c(1) = conjg (g_yuk_ch1_su1_3_2(2)) g_yuk_ch1_su1_3_2_c(2) = conjg (g_yuk_ch1_su1_3_2(1)) g_yuk_ch1_sd1_3_1(1) = ((vckm_31 * gcc * mv_12 * mass(6) * & conjg (mix_sd111)) / (mass(24) * sinbe)) g_yuk_ch1_sd1_3_1(2) = (vckm_31 * gcc * (((conjg (mu_12) * mass(1) * & conjg (mix_sd112)) / (mass(24) * cosbe)) - (conjg (mu_11) * & sqrt (2.0_default) * conjg (mix_sd111)))) g_yuk_ch1_sd1_3_1_c(1) = conjg (g_yuk_ch1_sd1_3_1(2)) g_yuk_ch1_sd1_3_1_c(2) = conjg (g_yuk_ch1_sd1_3_1(1)) g_yuk_ch1_su1_3_1(1) = (vckm_31 * gcc * (((conjg (mv_12) * mass(6) * & conjg (mix_su312)) / (mass(24) * sinbe)) - (conjg (mv_11) * & sqrt (2.0_default) * conjg (mix_su311)))) g_yuk_ch1_su1_3_1(2) = ((vckm_31 * gcc * mu_12 * mass(1) * & conjg (mix_su311)) / (mass(24) * cosbe)) g_yuk_ch1_su1_3_1_c(1) = conjg (g_yuk_ch1_su1_3_1(2)) g_yuk_ch1_su1_3_1_c(2) = conjg (g_yuk_ch1_su1_3_1(1)) g_yuk_ch1_sd2_1_3(1) = ((vckm_13 * gcc * mv_12 * mass(2) * & conjg (mix_sd321)) / (mass(24) * sinbe)) g_yuk_ch1_sd2_1_3(2) = (vckm_13 * gcc * (((conjg (mu_12) * mass(5) * & conjg (mix_sd322)) / (mass(24) * cosbe)) - (conjg (mu_11) * & sqrt (2.0_default) * conjg (mix_sd321)))) g_yuk_ch1_sd2_1_3_c(1) = conjg (g_yuk_ch1_sd2_1_3(2)) g_yuk_ch1_sd2_1_3_c(2) = conjg (g_yuk_ch1_sd2_1_3(1)) g_yuk_ch1_su2_1_3(1) = (vckm_13 * gcc * (((conjg (mv_12) * mass(2) * & conjg (mix_su122)) / (mass(24) * sinbe)) - (conjg (mv_11) * & sqrt (2.0_default) * conjg (mix_su121)))) g_yuk_ch1_su2_1_3(2) = ((vckm_13 * gcc * mu_12 * mass(5) * & conjg (mix_su121)) / (mass(24) * cosbe)) g_yuk_ch1_su2_1_3_c(1) = conjg (g_yuk_ch1_su2_1_3(2)) g_yuk_ch1_su2_1_3_c(2) = conjg (g_yuk_ch1_su2_1_3(1)) g_yuk_ch1_sd2_2_3(1) = ((vckm_23 * gcc * mv_12 * mass(4) * & conjg (mix_sd321)) / (mass(24) * sinbe)) g_yuk_ch1_sd2_2_3(2) = (vckm_23 * gcc * (((conjg (mu_12) * mass(5) * & conjg (mix_sd322)) / (mass(24) * cosbe)) - (conjg (mu_11) * & sqrt (2.0_default) * conjg (mix_sd321)))) g_yuk_ch1_sd2_2_3_c(1) = conjg (g_yuk_ch1_sd2_2_3(2)) g_yuk_ch1_sd2_2_3_c(2) = conjg (g_yuk_ch1_sd2_2_3(1)) g_yuk_ch1_su2_2_3(1) = (vckm_23 * gcc * (((conjg (mv_12) * mass(4) * & conjg (mix_su222)) / (mass(24) * sinbe)) - (conjg (mv_11) * & sqrt (2.0_default) * conjg (mix_su221)))) g_yuk_ch1_su2_2_3(2) = ((vckm_23 * gcc * mu_12 * mass(5) * & conjg (mix_su221)) / (mass(24) * cosbe)) g_yuk_ch1_su2_2_3_c(1) = conjg (g_yuk_ch1_su2_2_3(2)) g_yuk_ch1_su2_2_3_c(2) = conjg (g_yuk_ch1_su2_2_3(1)) g_yuk_ch1_sd2_3_3(1) = ((vckm_33 * gcc * mv_12 * mass(6) * & conjg (mix_sd321)) / (mass(24) * sinbe)) g_yuk_ch1_sd2_3_3(2) = (vckm_33 * gcc * (((conjg (mu_12) * mass(5) * & conjg (mix_sd322)) / (mass(24) * cosbe)) - (conjg (mu_11) * & sqrt (2.0_default) * conjg (mix_sd321)))) g_yuk_ch1_sd2_3_3_c(1) = conjg (g_yuk_ch1_sd2_3_3(2)) g_yuk_ch1_sd2_3_3_c(2) = conjg (g_yuk_ch1_sd2_3_3(1)) g_yuk_ch1_su2_3_3(1) = (vckm_33 * gcc * (((conjg (mv_12) * mass(6) * & conjg (mix_su322)) / (mass(24) * sinbe)) - (conjg (mv_11) * & sqrt (2.0_default) * conjg (mix_su321)))) g_yuk_ch1_su2_3_3(2) = ((vckm_33 * gcc * mu_12 * mass(5) * & conjg (mix_su321)) / (mass(24) * cosbe)) g_yuk_ch1_su2_3_3_c(1) = conjg (g_yuk_ch1_su2_3_3(2)) g_yuk_ch1_su2_3_3_c(2) = conjg (g_yuk_ch1_su2_3_3(1)) g_yuk_ch1_sd2_3_2(1) = ((vckm_32 * gcc * mv_12 * mass(6) * & conjg (mix_sd221)) / (mass(24) * sinbe)) g_yuk_ch1_sd2_3_2(2) = (vckm_32 * gcc * (((conjg (mu_12) * mass(3) * & conjg (mix_sd222)) / (mass(24) * cosbe)) - (conjg (mu_11) * & sqrt (2.0_default) * conjg (mix_sd221)))) g_yuk_ch1_sd2_3_2_c(1) = conjg (g_yuk_ch1_sd2_3_2(2)) g_yuk_ch1_sd2_3_2_c(2) = conjg (g_yuk_ch1_sd2_3_2(1)) g_yuk_ch1_su2_3_2(1) = (vckm_32 * gcc * (((conjg (mv_12) * mass(6) * & conjg (mix_su322)) / (mass(24) * sinbe)) - (conjg (mv_11) * & sqrt (2.0_default) * conjg (mix_su321)))) g_yuk_ch1_su2_3_2(2) = ((vckm_32 * gcc * mu_12 * mass(3) * & conjg (mix_su321)) / (mass(24) * cosbe)) g_yuk_ch1_su2_3_2_c(1) = conjg (g_yuk_ch1_su2_3_3(2)) g_yuk_ch1_su2_3_2_c(2) = conjg (g_yuk_ch1_su2_3_3(1)) g_yuk_ch1_sd2_3_1(1) = ((vckm_31 * gcc * mv_12 * mass(6) * & conjg (mix_sd121)) / (mass(24) * sinbe)) g_yuk_ch1_sd2_3_1(2) = (vckm_31 * gcc * (((conjg (mu_12) * mass(1) * & conjg (mix_sd122)) / (mass(24) * cosbe)) - (conjg (mu_11) * & sqrt (2.0_default) * conjg (mix_sd121)))) g_yuk_ch1_sd2_3_1_c(1) = conjg (g_yuk_ch1_sd2_3_1(2)) g_yuk_ch1_sd2_3_1_c(2) = conjg (g_yuk_ch1_sd2_3_1(1)) g_yuk_ch1_su2_3_1(1) = (vckm_31 * gcc * (((conjg (mv_12) * mass(6) * & conjg (mix_su322)) / (mass(24) * sinbe)) - (conjg (mv_11) * & sqrt (2.0_default) * conjg (mix_su321)))) g_yuk_ch1_su2_3_1(2) = ((vckm_31 * gcc * mu_12 * mass(1) * & conjg (mix_su321)) / (mass(24) * cosbe)) g_yuk_ch1_su2_3_1_c(1) = conjg (g_yuk_ch1_su2_3_1(2)) g_yuk_ch1_su2_3_1_c(2) = conjg (g_yuk_ch1_su2_3_1(1)) g_yuk_ch2_sd1_1_3(1) = ((vckm_13 * gcc * mv_22 * mass(2) * & conjg (mix_sd311)) / (mass(24) * sinbe)) g_yuk_ch2_sd1_1_3(2) = (vckm_13 * gcc * (((conjg (mu_22) * mass(5) * & conjg (mix_sd312)) / (mass(24) * cosbe)) - (conjg (mu_21) * & sqrt (2.0_default) * conjg (mix_sd311)))) g_yuk_ch2_sd1_1_3_c(1) = conjg (g_yuk_ch2_sd1_1_3(2)) g_yuk_ch2_sd1_1_3_c(2) = conjg (g_yuk_ch2_sd1_1_3(1)) g_yuk_ch2_su1_1_3(1) = (vckm_13 * gcc * (((conjg (mv_22) * mass(2) * & conjg (mix_su112)) / (mass(24) * sinbe)) - (conjg (mv_21) * & sqrt (2.0_default) * conjg (mix_su111)))) g_yuk_ch2_su1_1_3(2) = ((vckm_13 * gcc * mu_22 * mass(5) * & conjg (mix_su111)) / (mass(24) * cosbe)) g_yuk_ch2_su1_1_3_c(1) = conjg (g_yuk_ch2_su1_1_3(2)) g_yuk_ch2_su1_1_3_c(2) = conjg (g_yuk_ch2_su1_1_3(1)) g_yuk_ch2_sd1_2_3(1) = ((vckm_23 * gcc * mv_22 * mass(4) * & conjg (mix_sd311)) / (mass(24) * sinbe)) g_yuk_ch2_sd1_2_3(2) = (vckm_23 * gcc * (((conjg (mu_22) * mass(5) * & conjg (mix_sd312)) / (mass(24) * cosbe)) - (conjg (mu_21) * & sqrt (2.0_default) * conjg (mix_sd311)))) g_yuk_ch2_sd1_2_3_c(1) = conjg (g_yuk_ch2_sd1_2_3(2)) g_yuk_ch2_sd1_2_3_c(2) = conjg (g_yuk_ch2_sd1_2_3(1)) g_yuk_ch2_su1_2_3(1) = (vckm_23 * gcc * (((conjg (mv_22) * mass(4) * & conjg (mix_su212)) / (mass(24) * sinbe)) - (conjg (mv_21) * & sqrt (2.0_default) * conjg (mix_su211)))) g_yuk_ch2_su1_2_3(2) = ((vckm_23 * gcc * mu_22 * mass(5) * & conjg (mix_su211)) / (mass(24) * cosbe)) g_yuk_ch2_su1_2_3_c(1) = conjg (g_yuk_ch2_su1_2_3(2)) g_yuk_ch2_su1_2_3_c(2) = conjg (g_yuk_ch2_su1_2_3(1)) g_yuk_ch2_sd1_3_3(1) = ((vckm_33 * gcc * mv_22 * mass(6) * & conjg (mix_sd311)) / (mass(24) * sinbe)) g_yuk_ch2_sd1_3_3(2) = (vckm_33 * gcc * (((conjg (mu_22) * mass(5) * & conjg (mix_sd312)) / (mass(24) * cosbe)) - (conjg (mu_21) * & sqrt (2.0_default) * conjg (mix_sd311)))) g_yuk_ch2_sd1_3_3_c(1) = conjg (g_yuk_ch2_sd1_3_3(2)) g_yuk_ch2_sd1_3_3_c(2) = conjg (g_yuk_ch2_sd1_3_3(1)) g_yuk_ch2_su1_3_3(1) = (vckm_33 * gcc * (((conjg (mv_22) * mass(6) * & conjg (mix_su312)) / (mass(24) * sinbe)) - (conjg (mv_21) * & sqrt (2.0_default) * conjg (mix_su311)))) g_yuk_ch2_su1_3_3(2) = ((vckm_33 * gcc * mu_22 * mass(5) * & conjg (mix_su311)) / (mass(24) * cosbe)) g_yuk_ch2_su1_3_3_c(1) = conjg (g_yuk_ch2_su1_3_3(2)) g_yuk_ch2_su1_3_3_c(2) = conjg (g_yuk_ch2_su1_3_3(1)) g_yuk_ch2_sd1_3_2(1) = ((vckm_32 * gcc * mv_22 * mass(6) * & conjg (mix_sd211)) / (mass(24) * sinbe)) g_yuk_ch2_sd1_3_2(2) = (vckm_32 * gcc * (((conjg (mu_22) * mass(3) * & conjg (mix_sd212)) / (mass(24) * cosbe)) - (conjg (mu_21) * & sqrt (2.0_default) * conjg (mix_sd211)))) g_yuk_ch2_sd1_3_2_c(1) = conjg (g_yuk_ch2_sd1_3_2(2)) g_yuk_ch2_sd1_3_2_c(2) = conjg (g_yuk_ch2_sd1_3_2(1)) g_yuk_ch2_su1_3_2(1) = (vckm_32 * gcc * (((conjg (mv_22) * mass(6) * & conjg (mix_su312)) / (mass(24) * sinbe)) - (conjg (mv_21) * & sqrt (2.0_default) * conjg (mix_su311)))) g_yuk_ch2_su1_3_2(2) = ((vckm_32 * gcc * mu_22 * mass(3) * & conjg (mix_su311)) / (mass(24) * cosbe)) g_yuk_ch2_su1_3_2_c(1) = conjg (g_yuk_ch2_su1_3_2(2)) g_yuk_ch2_su1_3_2_c(2) = conjg (g_yuk_ch2_su1_3_2(1)) g_yuk_ch2_sd1_3_1(1) = ((vckm_31 * gcc * mv_22 * mass(6) * & conjg (mix_sd111)) / (mass(24) * sinbe)) g_yuk_ch2_sd1_3_1(2) = (vckm_31 * gcc * (((conjg (mu_22) * mass(1) * & conjg (mix_sd112)) / (mass(24) * cosbe)) - (conjg (mu_21) * & sqrt (2.0_default) * conjg (mix_sd111)))) g_yuk_ch2_sd1_3_1_c(1) = conjg (g_yuk_ch2_sd1_3_1(2)) g_yuk_ch2_sd1_3_1_c(2) = conjg (g_yuk_ch2_sd1_3_1(1)) g_yuk_ch2_su1_3_1(1) = (vckm_31 * gcc * (((conjg (mv_22) * mass(6) * & conjg (mix_su312)) / (mass(24) * sinbe)) - (conjg (mv_21) * & sqrt (2.0_default) * conjg (mix_su311)))) g_yuk_ch2_su1_3_1(2) = ((vckm_31 * gcc * mu_22 * mass(1) * & conjg (mix_su311)) / (mass(24) * cosbe)) g_yuk_ch2_su1_3_1_c(1) = conjg (g_yuk_ch2_su1_3_1(2)) g_yuk_ch2_su1_3_1_c(2) = conjg (g_yuk_ch2_su1_3_1(1)) g_yuk_ch2_sd2_1_3(1) = ((vckm_13 * gcc * mv_22 * mass(2) * & conjg (mix_sd321)) / (mass(24) * sinbe)) g_yuk_ch2_sd2_1_3(2) = (vckm_13 * gcc * (((conjg (mu_22) * mass(5) * & conjg (mix_sd322)) / (mass(24) * cosbe)) - (conjg (mu_21) * & sqrt (2.0_default) * conjg (mix_sd321)))) g_yuk_ch2_sd2_1_3_c(1) = conjg (g_yuk_ch2_sd2_1_3(2)) g_yuk_ch2_sd2_1_3_c(2) = conjg (g_yuk_ch2_sd2_1_3(1)) g_yuk_ch2_su2_1_3(1) = (vckm_13 * gcc * (((conjg (mv_22) * mass(2) * & conjg (mix_su122)) / (mass(24) * sinbe)) - (conjg (mv_21) * & sqrt (2.0_default) * conjg (mix_su121)))) g_yuk_ch2_su2_1_3(2) = ((vckm_13 * gcc * mu_22 * mass(5) * & conjg (mix_su121)) / (mass(24) * cosbe)) g_yuk_ch2_su2_1_3_c(1) = conjg (g_yuk_ch2_su2_1_3(2)) g_yuk_ch2_su2_1_3_c(2) = conjg (g_yuk_ch2_su2_1_3(1)) g_yuk_ch2_sd2_2_3(1) = ((vckm_23 * gcc * mv_22 * mass(4) * & conjg (mix_sd321)) / (mass(24) * sinbe)) g_yuk_ch2_sd2_2_3(2) = (vckm_23 * gcc * (((conjg (mu_22) * mass(5) * & conjg (mix_sd322)) / (mass(24) * cosbe)) - (conjg (mu_21) * & sqrt (2.0_default) * conjg (mix_sd321)))) g_yuk_ch2_sd2_2_3_c(1) = conjg (g_yuk_ch2_sd2_2_3(2)) g_yuk_ch2_sd2_2_3_c(2) = conjg (g_yuk_ch2_sd2_2_3(1)) g_yuk_ch2_su2_2_3(1) = (vckm_23 * gcc * (((conjg (mv_22) * mass(4) * & conjg (mix_su222)) / (mass(24) * sinbe)) - (conjg (mv_21) * & sqrt (2.0_default) * conjg (mix_su221)))) g_yuk_ch2_su2_2_3(2) = ((vckm_23 * gcc * mu_22 * mass(5) * & conjg (mix_su221)) / (mass(24) * cosbe)) g_yuk_ch2_su2_2_3_c(1) = conjg (g_yuk_ch2_su2_2_3(2)) g_yuk_ch2_su2_2_3_c(2) = conjg (g_yuk_ch2_su2_2_3(1)) g_yuk_ch2_sd2_3_3(1) = ((vckm_33 * gcc * mv_22 * mass(6) * & conjg (mix_sd321)) / (mass(24) * sinbe)) g_yuk_ch2_sd2_3_3(2) = (vckm_33 * gcc * (((conjg (mu_22) * mass(5) * & conjg (mix_sd322)) / (mass(24) * cosbe)) - (conjg (mu_21) * & sqrt (2.0_default) * conjg (mix_sd321)))) g_yuk_ch2_sd2_3_3_c(1) = conjg (g_yuk_ch2_sd2_3_3(2)) g_yuk_ch2_sd2_3_3_c(2) = conjg (g_yuk_ch2_sd2_3_3(1)) g_yuk_ch2_su2_3_3(1) = (vckm_33 * gcc * (((conjg (mv_22) * mass(6) * & conjg (mix_su322)) / (mass(24) * sinbe)) - (conjg (mv_21) * & sqrt (2.0_default) * conjg (mix_su321)))) g_yuk_ch2_su2_3_3(2) = ((vckm_33 * gcc * mu_22 * mass(5) * & conjg (mix_su321)) / (mass(24) * cosbe)) g_yuk_ch2_su2_3_3_c(1) = conjg (g_yuk_ch2_su2_3_3(2)) g_yuk_ch2_su2_3_3_c(2) = conjg (g_yuk_ch2_su2_3_3(1)) g_yuk_ch2_sd2_3_2(1) = ((vckm_32 * gcc * mv_22 * mass(6) * & conjg (mix_sd221)) / (mass(24) * sinbe)) g_yuk_ch2_sd2_3_2(2) = (vckm_32 * gcc * (((conjg (mu_22) * mass(3) * & conjg (mix_sd222)) / (mass(24) * cosbe)) - (conjg (mu_21) * & sqrt (2.0_default) * conjg (mix_sd221)))) g_yuk_ch2_sd2_3_2_c(1) = conjg (g_yuk_ch2_sd2_3_2(2)) g_yuk_ch2_sd2_3_2_c(2) = conjg (g_yuk_ch2_sd2_3_2(1)) g_yuk_ch2_su2_3_2(1) = (vckm_32 * gcc * (((conjg (mv_22) * mass(6) * & conjg (mix_su322)) / (mass(24) * sinbe)) - (conjg (mv_21) * & sqrt (2.0_default) * conjg (mix_su321)))) g_yuk_ch2_su2_3_2(2) = ((vckm_32 * gcc * mu_22 * mass(3) * & conjg (mix_su321)) / (mass(24) * cosbe)) g_yuk_ch2_su2_3_2_c(1) = conjg (g_yuk_ch2_su2_3_2(2)) g_yuk_ch2_su2_3_2_c(2) = conjg (g_yuk_ch2_su2_3_2(1)) g_yuk_ch2_sd2_3_1(1) = ((vckm_31 * gcc * mv_22 * mass(6) * & conjg (mix_sd121)) / (mass(24) * sinbe)) g_yuk_ch2_sd2_3_1(2) = (vckm_31 * gcc * (((conjg (mu_22) * mass(1) * & conjg (mix_sd122)) / (mass(24) * cosbe)) - (conjg (mu_21) * & sqrt (2.0_default) * conjg (mix_sd121)))) g_yuk_ch2_sd2_3_1_c(1) = conjg (g_yuk_ch2_sd2_3_1(2)) g_yuk_ch2_sd2_3_1_c(2) = conjg (g_yuk_ch2_sd2_3_1(1)) g_yuk_ch2_su2_3_1(1) = (vckm_31 * gcc * (((conjg (mv_22) * mass(6) * & conjg (mix_su322)) / (mass(24) * sinbe)) - (conjg (mv_21) * & sqrt (2.0_default) * conjg (mix_su321)))) g_yuk_ch2_su2_3_1(2) = ((vckm_31 * gcc * mu_22 * mass(1) * & conjg (mix_su321)) / (mass(24) * cosbe)) g_yuk_ch2_su2_3_1_c(1) = conjg (g_yuk_ch2_su2_3_1(2)) g_yuk_ch2_su2_3_1_c(2) = conjg (g_yuk_ch2_su2_3_1(1)) end subroutine setup_parameters15 subroutine setup_parameters16 () g_yuk_n1_sl1_3(1) = ( - (gcc * ((2.0_default * ( - & q_lep) * conjg (mn_11) * (sinthw / costhw) * mix_sl312) & + ((conjg (mn_13) * mass(15) * mix_sl311) / (mass(24) * cosbe))))) g_yuk_n1_sl1_3(2) = (gcc * ((1.0_default * (mn_12 + (1.0_default * & (sinthw / costhw) * mn_11)) * mix_sl311) - ( & (mn_13 * mass(15) * mix_sl312) / (mass(24) * cosbe)))) g_yuk_n1_sl1_3_c(1) = conjg (g_yuk_n1_sl1_3(2)) g_yuk_n1_sl1_3_c(2) = conjg (g_yuk_n1_sl1_3(1)) g_yuk_n1_su1_3(1) = ( - (gcc * ((2.0_default * ( - & q_up) * conjg (mn_11) * & (sinthw / costhw) * mix_su312) + ((conjg (mn_14) * mass(6) * mix_su311) / & (mass(24) * sinbe))))) g_yuk_n1_su1_3(2) = (gcc * (((-1.0_default) * (mn_12 + ( & (1.0_default / 3.0_default) * & (sinthw / costhw) * mn_11)) * mix_su311) - ( & (mn_14 * mass(6) * mix_su312) / (mass(24) * sinbe)))) g_yuk_n1_su1_3_c(1) = conjg (g_yuk_n1_su1_3(2)) g_yuk_n1_su1_3_c(2) = conjg (g_yuk_n1_su1_3(1)) g_yuk_n1_sd1_3(1) = ( - (gcc * ((2.0_default * ( - ( - & (1.0_default / 3.0_default))) * conjg (mn_11) * & (sinthw / costhw) * mix_sd312) + ((conjg (mn_13) * mass(5) * mix_sd311) / & (mass(24) * cosbe))))) g_yuk_n1_sd1_3(2) = (gcc * ((1.0_default * (mn_12 + (( - & (1.0_default / 3.0_default)) * & (sinthw / costhw) * mn_11)) * mix_sd311) - ( & (mn_13 * mass(5) * mix_sd312) / (mass(24) * cosbe)))) g_yuk_n1_sd1_3_c(1) = conjg (g_yuk_n1_sd1_3(2)) g_yuk_n1_sd1_3_c(2) = conjg (g_yuk_n1_sd1_3(1)) g_yuk_n2_sl1_3(1) = ( - (gcc * ((2.0_default * ( - & q_lep) * conjg (mn_21) * (sinthw / costhw) * mix_sl312) + ( & (conjg (mn_23) * mass(15) * mix_sl311) / (mass(24) * cosbe))))) g_yuk_n2_sl1_3(2) = (gcc * ((1.0_default * (mn_22 + (1.0_default * & (sinthw / costhw) * mn_21)) * mix_sl311) - ( & (mn_23 * mass(15) * mix_sl312) / (mass(24) * cosbe)))) g_yuk_n2_sl1_3_c(1) = conjg (g_yuk_n2_sl1_3(2)) g_yuk_n2_sl1_3_c(2) = conjg (g_yuk_n2_sl1_3(1)) g_yuk_n2_su1_3(1) = ( - (gcc * ((2.0_default * ( - & q_up) * conjg (mn_21) * & (sinthw / costhw) * mix_su312) + ((conjg (mn_24) * mass(6) * mix_su311) / & (mass(24) * sinbe))))) g_yuk_n2_su1_3(2) = (gcc * (((-1.0_default) * (mn_22 + ( & (1.0_default / 3.0_default) * & (sinthw / costhw) * mn_21)) * mix_su311) - ( & (mn_24 * mass(6) * mix_su312) / (mass(24) * sinbe)))) g_yuk_n2_su1_3_c(1) = conjg (g_yuk_n2_su1_3(2)) g_yuk_n2_su1_3_c(2) = conjg (g_yuk_n2_su1_3(1)) g_yuk_n2_sd1_3(1) = ( - (gcc * ((2.0_default * ( - ( - & (1.0_default / 3.0_default))) * conjg (mn_21) * & (sinthw / costhw) * mix_sd312) + ((conjg (mn_23) * mass(5) * mix_sd311) / & (mass(24) * cosbe))))) g_yuk_n2_sd1_3(2) = (gcc * ((1.0_default * (mn_22 + (( - & (1.0_default / 3.0_default)) * & (sinthw / costhw) * mn_21)) * mix_sd311) - ( & (mn_23 * mass(5) * mix_sd312) / (mass(24) * cosbe)))) g_yuk_n2_sd1_3_c(1) = conjg (g_yuk_n2_sd1_3(2)) g_yuk_n2_sd1_3_c(2) = conjg (g_yuk_n2_sd1_3(1)) g_yuk_n3_sl1_3(1) = ( - (gcc * ((2.0_default * ( - & q_lep) * conjg (mn_31) * (sinthw / costhw) * mix_sl312) + ( & (conjg (mn_33) * mass(15) * mix_sl311) / (mass(24) * cosbe))))) g_yuk_n3_sl1_3(2) = (gcc * ((1.0_default * (mn_32 + (1.0_default * & (sinthw / costhw) * mn_31)) * mix_sl311) - ( & (mn_33 * mass(15) * mix_sl312) / (mass(24) * cosbe)))) g_yuk_n3_sl1_3_c(1) = conjg (g_yuk_n3_sl1_3(2)) g_yuk_n3_sl1_3_c(2) = conjg (g_yuk_n3_sl1_3(1)) g_yuk_n3_su1_3(1) = ( - (gcc * ((2.0_default * ( - & q_up) * conjg (mn_31) * & (sinthw / costhw) * mix_su312) + ((conjg (mn_34) * mass(6) * mix_su311) / & (mass(24) * sinbe))))) g_yuk_n3_su1_3(2) = (gcc * (((-1.0_default) * (mn_32 + ( & (1.0_default / 3.0_default) * & (sinthw / costhw) * mn_31)) * mix_su311) - ( & (mn_34 * mass(6) * mix_su312) / (mass(24) * sinbe)))) g_yuk_n3_su1_3_c(1) = conjg (g_yuk_n3_su1_3(2)) g_yuk_n3_su1_3_c(2) = conjg (g_yuk_n3_su1_3(1)) g_yuk_n3_sd1_3(1) = ( - (gcc * ((2.0_default * ( - ( - & (1.0_default / 3.0_default))) * conjg (mn_31) * & (sinthw / costhw) * mix_sd312) + ((conjg (mn_33) * mass(5) * mix_sd311) / & (mass(24) * cosbe))))) g_yuk_n3_sd1_3(2) = (gcc * ((1.0_default * (mn_32 + (( - & (1.0_default / 3.0_default)) * & (sinthw / costhw) * mn_31)) * mix_sd311) - ( & (mn_33 * mass(5) * mix_sd312) / (mass(24) * cosbe)))) g_yuk_n3_sd1_3_c(1) = conjg (g_yuk_n3_sd1_3(2)) g_yuk_n3_sd1_3_c(2) = conjg (g_yuk_n3_sd1_3(1)) g_yuk_n4_sl1_3(1) = ( - (gcc * ((2.0_default * ( - & q_lep) * conjg (mn_41) * (sinthw / costhw) * mix_sl312) + ( & (conjg (mn_43) * mass(15) * mix_sl311) / (mass(24) * cosbe))))) g_yuk_n4_sl1_3(2) = (gcc * ((1.0_default * (mn_42 + (1.0_default * & (sinthw / costhw) * mn_41)) * mix_sl311) - ( & (mn_43 * mass(15) * mix_sl312) / (mass(24) * cosbe)))) g_yuk_n4_sl1_3_c(1) = conjg (g_yuk_n4_sl1_3(2)) g_yuk_n4_sl1_3_c(2) = conjg (g_yuk_n4_sl1_3(1)) g_yuk_n4_su1_3(1) = ( - (gcc * ((2.0_default * ( - & q_up) * conjg (mn_41) * & (sinthw / costhw) * mix_su312) + ((conjg (mn_44) * mass(6) * mix_su311) / & (mass(24) * sinbe))))) g_yuk_n4_su1_3(2) = (gcc * (((-1.0_default) * (mn_42 + ( & (1.0_default / 3.0_default) * & (sinthw / costhw) * mn_41)) * mix_su311) - ( & (mn_44 * mass(6) * mix_su312) / (mass(24) * sinbe)))) g_yuk_n4_su1_3_c(1) = conjg (g_yuk_n4_su1_3(2)) g_yuk_n4_su1_3_c(2) = conjg (g_yuk_n4_su1_3(1)) g_yuk_n4_sd1_3(1) = ( - (gcc * ((2.0_default * ( - ( - & (1.0_default / 3.0_default))) * conjg (mn_41) * & (sinthw / costhw) * mix_sd312) + ((conjg (mn_43) * mass(5) * mix_sd311) / & (mass(24) * cosbe))))) g_yuk_n4_sd1_3(2) = (gcc * ((1.0_default * (mn_42 + (( - & (1.0_default / 3.0_default)) * & (sinthw / costhw) * mn_41)) * mix_sd311) - ( & (mn_43 * mass(5) * mix_sd312) / (mass(24) * cosbe)))) g_yuk_n4_sd1_3_c(1) = conjg (g_yuk_n4_sd1_3(2)) g_yuk_n4_sd1_3_c(2) = conjg (g_yuk_n4_sd1_3(1)) g_yuk_n1_sl2_3(1) = ( - (gcc * ((2.0_default * ( - & q_lep) * conjg (mn_11) * (sinthw / costhw) * mix_sl322) + ( & (conjg (mn_13) * mass(15) * mix_sl321) / (mass(24) * cosbe))))) g_yuk_n1_sl2_3(2) = (gcc * ((1.0_default * (mn_12 + (1.0_default * & (sinthw / costhw) * mn_11)) * mix_sl321) - ( & (mn_13 * mass(15) * mix_sl322) / (mass(24) * cosbe)))) g_yuk_n1_sl2_3_c(1) = conjg (g_yuk_n1_sl2_3(2)) g_yuk_n1_sl2_3_c(2) = conjg (g_yuk_n1_sl2_3(1)) g_yuk_n1_su2_3(1) = ( - (gcc * ((2.0_default * ( - & q_up) * conjg (mn_11) * & (sinthw / costhw) * mix_su322) + ((conjg (mn_14) * mass(6) * mix_su321) / & (mass(24) * sinbe))))) g_yuk_n1_su2_3(2) = (gcc * (((-1.0_default) * (mn_12 + ( & (1.0_default / 3.0_default) * & (sinthw / costhw) * mn_11)) * mix_su321) - ( & (mn_14 * mass(6) * mix_su322) / (mass(24) * sinbe)))) g_yuk_n1_su2_3_c(1) = conjg (g_yuk_n1_su2_3(2)) g_yuk_n1_su2_3_c(2) = conjg (g_yuk_n1_su2_3(1)) g_yuk_n1_sd2_3(1) = ( - (gcc * ((2.0_default * ( - ( - & (1.0_default / 3.0_default))) * conjg (mn_11) * & (sinthw / costhw) * mix_sd322) + ((conjg (mn_13) * mass(5) * mix_sd321) / & (mass(24) * cosbe))))) g_yuk_n1_sd2_3(2) = (gcc * ((1.0_default * (mn_12 + (( - & (1.0_default / 3.0_default)) * & (sinthw / costhw) * mn_11)) * mix_sd321) - ( & (mn_13 * mass(5) * mix_sd322) / (mass(24) * cosbe)))) g_yuk_n1_sd2_3_c(1) = conjg (g_yuk_n1_sd2_3(2)) g_yuk_n1_sd2_3_c(2) = conjg (g_yuk_n1_sd2_3(1)) g_yuk_n2_sl2_3(1) = ( - (gcc * ((2.0_default * ( - & q_lep) * conjg (mn_21) * (sinthw / costhw) * mix_sl322) + ( & (conjg (mn_23) * mass(15) * mix_sl321) / (mass(24) * cosbe))))) g_yuk_n2_sl2_3(2) = (gcc * ((1.0_default * (mn_22 + (1.0_default * & (sinthw / costhw) * mn_21)) * mix_sl321) - ( & (mn_23 * mass(15) * mix_sl322) / (mass(24) * cosbe)))) g_yuk_n2_sl2_3_c(1) = conjg (g_yuk_n2_sl2_3(2)) g_yuk_n2_sl2_3_c(2) = conjg (g_yuk_n2_sl2_3(1)) g_yuk_n2_su2_3(1) = ( - (gcc * ((2.0_default * ( - & q_up) * conjg (mn_21) * & (sinthw / costhw) * mix_su322) + ((conjg (mn_24) * mass(6) * mix_su321) / & (mass(24) * sinbe))))) g_yuk_n2_su2_3(2) = (gcc * (((-1.0_default) * (mn_22 + ( & (1.0_default / 3.0_default) * & (sinthw / costhw) * mn_21)) * mix_su321) - ( & (mn_24 * mass(6) * mix_su322) / (mass(24) * sinbe)))) g_yuk_n2_su2_3_c(1) = conjg (g_yuk_n2_su2_3(2)) g_yuk_n2_su2_3_c(2) = conjg (g_yuk_n2_su2_3(1)) g_yuk_n2_sd2_3(1) = ( - (gcc * ((2.0_default * ( - ( - & (1.0_default / 3.0_default))) * conjg (mn_21) * & (sinthw / costhw) * mix_sd322) + ((conjg (mn_23) * mass(5) * mix_sd321) / & (mass(24) * cosbe))))) g_yuk_n2_sd2_3(2) = (gcc * ((1.0_default * (mn_22 + (( - & (1.0_default / 3.0_default)) * & (sinthw / costhw) * mn_21)) * mix_sd321) - ( & (mn_23 * mass(5) * mix_sd322) / (mass(24) * cosbe)))) g_yuk_n2_sd2_3_c(1) = conjg (g_yuk_n2_sd2_3(2)) g_yuk_n2_sd2_3_c(2) = conjg (g_yuk_n2_sd2_3(1)) g_yuk_n3_sl2_3(1) = ( - (gcc * ((2.0_default * ( - & q_lep) * conjg (mn_31) * (sinthw / costhw) * mix_sl322) + ( & (conjg (mn_33) * mass(15) * mix_sl321) / (mass(24) * cosbe))))) g_yuk_n3_sl2_3(2) = (gcc * ((1.0_default * (mn_32 + (1.0_default * & (sinthw / costhw) * mn_31)) * mix_sl321) - ( & (mn_33 * mass(15) * mix_sl322) / (mass(24) * cosbe)))) g_yuk_n3_sl2_3_c(1) = conjg (g_yuk_n3_sl2_3(2)) g_yuk_n3_sl2_3_c(2) = conjg (g_yuk_n3_sl2_3(1)) g_yuk_n3_su2_3(1) = ( - (gcc * ((2.0_default * ( - & q_up) * conjg (mn_31) * & (sinthw / costhw) * mix_su322) + ((conjg (mn_34) * mass(6) * mix_su321) / & (mass(24) * sinbe))))) g_yuk_n3_su2_3(2) = (gcc * (((-1.0_default) * (mn_32 + ( & (1.0_default / 3.0_default) * & (sinthw / costhw) * mn_31)) * mix_su321) - ( & (mn_34 * mass(6) * mix_su322) / (mass(24) * sinbe)))) g_yuk_n3_su2_3_c(1) = conjg (g_yuk_n3_su2_3(2)) g_yuk_n3_su2_3_c(2) = conjg (g_yuk_n3_su2_3(1)) g_yuk_n3_sd2_3(1) = ( - (gcc * ((2.0_default * ( - ( - & (1.0_default / 3.0_default))) * conjg (mn_31) * & (sinthw / costhw) * mix_sd322) + ((conjg (mn_33) * mass(5) * mix_sd321) / & (mass(24) * cosbe))))) g_yuk_n3_sd2_3(2) = (gcc * ((1.0_default * (mn_32 + (( - & (1.0_default / 3.0_default)) * & (sinthw / costhw) * mn_31)) * mix_sd321) - ( & (mn_33 * mass(5) * mix_sd322) / (mass(24) * cosbe)))) g_yuk_n3_sd2_3_c(1) = conjg (g_yuk_n3_sd2_3(2)) g_yuk_n3_sd2_3_c(2) = conjg (g_yuk_n3_sd2_3(1)) g_yuk_n4_sl2_3(1) = ( - (gcc * ((2.0_default * ( - & q_lep) * conjg (mn_41) * (sinthw / costhw) * mix_sl322) + ( & (conjg (mn_43) * mass(15) * mix_sl321) / (mass(24) * cosbe))))) g_yuk_n4_sl2_3(2) = (gcc * ((1.0_default * (mn_42 + (1.0_default * & (sinthw / costhw) * mn_41)) * mix_sl321) - ( & (mn_43 * mass(15) * mix_sl322) / (mass(24) * cosbe)))) g_yuk_n4_sl2_3_c(1) = conjg (g_yuk_n4_sl2_3(2)) g_yuk_n4_sl2_3_c(2) = conjg (g_yuk_n4_sl2_3(1)) g_yuk_n4_su2_3(1) = ( - (gcc * ((2.0_default * ( - & q_up) * conjg (mn_41) * & (sinthw / costhw) * mix_su322) + ((conjg (mn_44) * mass(6) * mix_su321) / & (mass(24) * sinbe))))) g_yuk_n4_su2_3(2) = (gcc * (((-1.0_default) * (mn_42 + ( & (1.0_default / 3.0_default) * & (sinthw / costhw) * mn_41)) * mix_su321) - ( & (mn_44 * mass(6) * mix_su322) / (mass(24) * sinbe)))) g_yuk_n4_su2_3_c(1) = conjg (g_yuk_n4_su2_3(2)) g_yuk_n4_su2_3_c(2) = conjg (g_yuk_n4_su2_3(1)) g_yuk_n4_sd2_3(1) = ( - (gcc * ((2.0_default * ( - ( - & (1.0_default / 3.0_default))) * conjg (mn_41) * & (sinthw / costhw) * mix_sd322) + ((conjg (mn_43) * mass(5) * mix_sd321) / & (mass(24) * cosbe))))) g_yuk_n4_sd2_3(2) = (gcc * ((1.0_default * (mn_42 + (( - & (1.0_default / 3.0_default)) * & (sinthw / costhw) * mn_41)) * mix_sd321) - ( & (mn_43 * mass(5) * mix_sd322) / (mass(24) * cosbe)))) !!! For the adjoint color flow method these constants have to be !!! divided by a factor of sqrt(2). g_yuk_n4_sd2_3_c(1) = conjg (g_yuk_n4_sd2_3(2)) g_yuk_n4_sd2_3_c(2) = conjg (g_yuk_n4_sd2_3(1)) !!! For the diagram-wise color calculation this has not to be !!! divided by an additional factor of sqrt(2) g_yuk_gsu1_3(1) = ( - (mix_su312 * (gs / sqrt (2.0_default)))) g_yuk_gsu1_3(2) = (mix_su311 * (gs / sqrt (2.0_default))) g_yuk_gsu1_3_c(1) = conjg (g_yuk_gsu1_3(2)) g_yuk_gsu1_3_c(2) = conjg (g_yuk_gsu1_3(1)) g_yuk_gsd1_3(1) = ( - (mix_sd312 * (gs / sqrt (2.0_default)))) g_yuk_gsd1_3(2) = (mix_sd311 * (gs / sqrt (2.0_default))) g_yuk_gsd1_3_c(1) = conjg (g_yuk_gsd1_3(2)) g_yuk_gsd1_3_c(2) = conjg (g_yuk_gsd1_3(1)) g_yuk_gsu2_3(1) = ( - (mix_su322 * (gs / sqrt (2.0_default)))) g_yuk_gsu2_3(2) = (mix_su321 * (gs / sqrt (2.0_default))) g_yuk_gsu2_3_c(1) = conjg (g_yuk_gsu2_3(2)) g_yuk_gsu2_3_c(2) = conjg (g_yuk_gsu2_3(1)) g_yuk_gsd2_3(1) = ( - (mix_sd322 * (gs / sqrt (2.0_default)))) g_yuk_gsd2_3(2) = (mix_sd321 * (gs / sqrt (2.0_default))) g_yuk_gsd2_3_c(1) = conjg (g_yuk_gsd2_3(2)) g_yuk_gsd2_3_c(2) = conjg (g_yuk_gsd2_3(1)) end subroutine setup_parameters16 subroutine setup_parameters17 () !!!!!!!!!!!!!!! !!!!!!H-Gluon-Gluon (preliminary) !!!!!!!!!!!!!!! gglglh = & gs**2/(8.0_default * pi**2 * vev) * (& !!! Top loop + sign(one,par%hgg_fac) * sqrt(abs(par%hgg_fac)) * & cosal/sinbe * loop_factor(mass(6), mass(25),'ferh0')& !!! Bottom loop - sign(one,par%hgg_fac) * sqrt(abs(par%hgg_fac)) * & sinal/cosbe * loop_factor(mass(5), mass(25),'ferh0')& !!! Squark loops + sign(one,par%hgg_sq) * sqrt(abs(par%hgg_sq)) * ( & + (vev / mass(41)**2) * gh1sd1sd1_1 * loop_factor(mass(41), mass(25),'squh0') & + (vev / mass(43)**2) * gh1sd1sd1_2 * loop_factor(mass(43), mass(25),'squh0') & + (vev / mass(45)**2) * gh1sd1sd1_3 * loop_factor(mass(45), mass(25),'squh0') & + (vev / mass(47)**2) * gh1sd2sd2_1 * loop_factor(mass(47), mass(25),'squh0') & + (vev / mass(49)**2) * gh1sd2sd2_2 * loop_factor(mass(49), mass(25),'squh0') & + (vev / mass(51)**2) * gh1sd2sd2_3 * loop_factor(mass(51), mass(25),'squh0') & + (vev / mass(42)**2) * gh1su1su1_1 * loop_factor(mass(42), mass(25),'squh0') & + (vev / mass(44)**2) * gh1su1su1_2 * loop_factor(mass(44), mass(25),'squh0') & + (vev / mass(46)**2) * gh1su1su1_3 * loop_factor(mass(46), mass(25),'squh0') & + (vev / mass(48)**2) * gh1su2su2_1 * loop_factor(mass(48), mass(25),'squh0') & + (vev / mass(50)**2) * gh1su2su2_2 * loop_factor(mass(50), mass(25),'squh0') & + (vev / mass(52)**2) * gh1su2su2_3 * loop_factor(mass(52), mass(25),'squh0')) & ) gglglhh = & gs**2/(8.0_default * pi**2 * vev) * (& !!! Top loop + sign(one,par%hgg_fac) * sqrt(abs(par%hgg_fac)) * & one/tanb * loop_factor(mass(6), mass(35),'ferh0')& !!! Bottom loop + sign(one,par%hgg_fac) * sqrt(abs(par%hgg_fac)) * & tanb * loop_factor(mass(5), mass(35),'ferh0')& !!! Squark loops + sign(one,par%hgg_sq) * sqrt(abs(par%hgg_sq)) * ( & + (vev / mass(41)**2) * gh2sd1sd1_1 * loop_factor(mass(41), mass(35),'squh0') & + (vev / mass(43)**2) * gh2sd1sd1_2 * loop_factor(mass(43), mass(35),'squh0') & + (vev / mass(45)**2) * gh2sd1sd1_3 * loop_factor(mass(45), mass(35),'squh0') & + (vev / mass(47)**2) * gh2sd2sd2_1 * loop_factor(mass(47), mass(35),'squh0') & + (vev / mass(49)**2) * gh2sd2sd2_2 * loop_factor(mass(49), mass(35),'squh0') & + (vev / mass(51)**2) * gh2sd2sd2_3 * loop_factor(mass(51), mass(35),'squh0') & + (vev / mass(42)**2) * gh2su1su1_1 * loop_factor(mass(42), mass(35),'squh0') & + (vev / mass(44)**2) * gh2su1su1_2 * loop_factor(mass(44), mass(35),'squh0') & + (vev / mass(46)**2) * gh2su1su1_3 * loop_factor(mass(46), mass(35),'squh0') & + (vev / mass(48)**2) * gh2su2su2_1 * loop_factor(mass(48), mass(35),'squh0') & + (vev / mass(50)**2) * gh2su2su2_2 * loop_factor(mass(50), mass(35),'squh0') & + (vev / mass(52)**2) * gh2su2su2_3 * loop_factor(mass(52), mass(35),'squh0')) & ) gglgla = & - gs**2/(8.0_default * pi**2 * vev) * & sign(one,par%hgg_fac) * sqrt(abs(par%hgg_fac)) * (& !!! Top loop + sinal/sinbe * loop_factor(mass(6), mass(36),'ferA0')& !!! Bottom loop + cosal/cosbe * loop_factor(mass(5), mass(36),'ferA0')& ) !!!!!!!!!!!!!!! !!!!!!H-Photon-Photon (preliminary) !!!!!!!!!!!!!!! gpph = & alpha/(2.0_default * pi * vev) * & sign(one,par%haa_fac) * sqrt(abs(par%haa_fac)) * (& !!! Top loop + cosal/sinbe * q_up**2 * 3.0_default * loop_factor(mass(6), mass(25),'ferh0')& !!! Bottom loop - sinal/cosbe * q_down**2 * 3.0_default * loop_factor(mass(5), mass(25),'ferh0')& !!! Tau loop - sinal/cosbe * loop_factor(mass(15), mass(25),'ferh0') & !!! W loop - sinamb * loop_factor(mass(24), mass(25), 'vech0') & !!! Charged Higgs loop + (vev / mass(37)**2) * gh3_2 * loop_factor(mass(37), mass(25),'squh0') & !!! Chargino loop + (vev / mass(69)) * gch1c_1_1 * loop_factor(mass(69), mass(25), 'ferh0') & + (vev / mass(70)) * gch1c_2_2 * loop_factor(mass(70), mass(25), 'ferh0') & !!! Sfermion loops + q_down**2 * 3.0_default * ( & + (vev / mass(41)**2) * gh1sd1sd1_1 * loop_factor(mass(41), mass(25),'squh0') & + (vev / mass(43)**2) * gh1sd1sd1_2 * loop_factor(mass(43), mass(25),'squh0') & + (vev / mass(45)**2) * gh1sd1sd1_3 * loop_factor(mass(45), mass(25),'squh0') & + (vev / mass(47)**2) * gh1sd2sd2_1 * loop_factor(mass(47), mass(25),'squh0') & + (vev / mass(49)**2) * gh1sd2sd2_2 * loop_factor(mass(49), mass(25),'squh0') & + (vev / mass(51)**2) * gh1sd2sd2_3 * loop_factor(mass(51), mass(25),'squh0')) & + q_up**2 * 3.0_default * ( & + (vev / mass(42)**2) * gh1su1su1_1 * loop_factor(mass(42), mass(25),'squh0') & + (vev / mass(44)**2) * gh1su1su1_2 * loop_factor(mass(44), mass(25),'squh0') & + (vev / mass(46)**2) * gh1su1su1_3 * loop_factor(mass(46), mass(25),'squh0') & + (vev / mass(48)**2) * gh1su2su2_1 * loop_factor(mass(48), mass(25),'squh0') & + (vev / mass(50)**2) * gh1su2su2_2 * loop_factor(mass(50), mass(25),'squh0') & + (vev / mass(52)**2) * gh1su2su2_3 * loop_factor(mass(52), mass(25),'squh0')) & + ( & + (vev / mass(53)**2) * gh1sl1sl1_1 * loop_factor(mass(53), mass(25),'squh0') & + (vev / mass(55)**2) * gh1sl1sl1_2 * loop_factor(mass(55), mass(25),'squh0') & + (vev / mass(57)**2) * gh1sl1sl1_3 * loop_factor(mass(57), mass(25),'squh0') & + (vev / mass(59)**2) * gh1sl2sl2_1 * loop_factor(mass(59), mass(25),'squh0') & + (vev / mass(61)**2) * gh1sl2sl2_2 * loop_factor(mass(61), mass(25),'squh0') & + (vev / mass(63)**2) * gh1sl2sl2_3 * loop_factor(mass(63), mass(25),'squh0')) & ) gpphh = & alpha/(2.0_default * pi * vev) * & sign(one,par%haa_fac) * sqrt(abs(par%haa_fac)) * (& !!! Top loop + sinal/sinbe * q_up**2 * 3.0_default * loop_factor(mass(6), mass(35),'ferh0')& !!! Bottom loop + cosal/cosbe * q_down**2 * 3.0_default * loop_factor(mass(5), mass(35),'ferh0')& !!! Tau loop + cosal/cosbe * loop_factor(mass(15), mass(35),'ferh0') & !!! W loop + cosamb * loop_factor(mass(24), mass(35), 'vech0') & !!! Charged Higgs loop + (vev / mass(37)**2) * gh3_1 * loop_factor(mass(37), mass(35),'squh0') & !!! Chargino loop + (vev / mass(69)) * gch2c_1_1 * loop_factor(mass(69), mass(35), 'ferh0') & + (vev / mass(70)) * gch2c_2_2 * loop_factor(mass(70), mass(35), 'ferh0') & !!! Sfermion loops + q_down**2 * 3.0_default * ( & + (vev / mass(41)**2) * gh2sd1sd1_1 * loop_factor(mass(41), mass(35),'squh0') & + (vev / mass(43)**2) * gh2sd1sd1_2 * loop_factor(mass(43), mass(35),'squh0') & + (vev / mass(45)**2) * gh2sd1sd1_3 * loop_factor(mass(45), mass(35),'squh0') & + (vev / mass(47)**2) * gh2sd2sd2_1 * loop_factor(mass(47), mass(35),'squh0') & + (vev / mass(49)**2) * gh2sd2sd2_2 * loop_factor(mass(49), mass(35),'squh0') & + (vev / mass(51)**2) * gh2sd2sd2_3 * loop_factor(mass(51), mass(35),'squh0')) & + q_up**2 * 3.0_default * ( & + (vev / mass(42)**2) * gh2su1su1_1 * loop_factor(mass(42), mass(35),'squh0') & + (vev / mass(44)**2) * gh2su1su1_2 * loop_factor(mass(44), mass(35),'squh0') & + (vev / mass(46)**2) * gh2su1su1_3 * loop_factor(mass(46), mass(35),'squh0') & + (vev / mass(48)**2) * gh2su2su2_1 * loop_factor(mass(48), mass(35),'squh0') & + (vev / mass(50)**2) * gh2su2su2_2 * loop_factor(mass(50), mass(35),'squh0') & + (vev / mass(52)**2) * gh2su2su2_3 * loop_factor(mass(52), mass(35),'squh0')) & + ( & + (vev / mass(53)**2) * gh2sl1sl1_1 * loop_factor(mass(53), mass(35),'squh0') & + (vev / mass(55)**2) * gh2sl1sl1_2 * loop_factor(mass(55), mass(35),'squh0') & + (vev / mass(57)**2) * gh2sl1sl1_3 * loop_factor(mass(57), mass(35),'squh0') & + (vev / mass(59)**2) * gh2sl2sl2_1 * loop_factor(mass(59), mass(35),'squh0') & + (vev / mass(61)**2) * gh2sl2sl2_2 * loop_factor(mass(61), mass(35),'squh0') & + (vev / mass(63)**2) * gh2sl2sl2_3 * loop_factor(mass(63), mass(35),'squh0')) & ) gppa = & alpha/(2.0_default * pi * vev) * & sign(one,par%haa_fac) * sqrt(abs(par%haa_fac)) * (& !!! Top loop + q_up**2 / tanb * 3.0_default * loop_factor(mass(6), mass(36),'ferA0')& !!! Bottom loop + q_down**2 * tanb * 3.0_default * loop_factor(mass(5), mass(36),'ferA0')& !!! Tau loop + tanb * loop_factor(mass(15), mass(35),'ferA0') & !!! Chargino loop + (vev / mass(69)) * gcac_1_1 * loop_factor(mass(69), mass(36), 'ferA0') & + (vev / mass(70)) * gcac_2_2 * loop_factor(mass(70), mass(36), 'ferA0')) +!!! Couplings for loop-induced neutralino2 decay + if (mass(66) > mass(65)) then + neu2_dec = sqrt (8.0_default * PI * width(66) * mass(66)**5 / & + (mass(66)**2 - mass(65)**2)**3) + else + neu2_dec = 0.0_default + end if + gnna(1) = (par%nna_v_fac * neu2_dec + par%nna_v) / mass(66) + gnna(2) = par%nna_a_fac * neu2_dec + par%nna_a / mass(66) end subroutine setup_parameters17 end subroutine import_from_whizard subroutine model_update_alpha_s (alpha_s) real(default), intent(in) :: alpha_s gs = sqrt(2.0_default * PI * alpha_s) igs = cmplx(0.0_default, 1.0_default, kind=default) * gs gssq = (gs / sqrt (2.0_default)) g_yuk_gsu1_3(1) = ( - (mix_su312 * (gs / sqrt (2.0_default)))) g_yuk_gsu1_3(2) = (mix_su311 * (gs / sqrt (2.0_default))) g_yuk_gsu1_3_c(1) = conjg (g_yuk_gsu1_3(2)) g_yuk_gsu1_3_c(2) = conjg (g_yuk_gsu1_3(1)) g_yuk_gsd1_3(1) = ( - (mix_sd312 * (gs / sqrt (2.0_default)))) g_yuk_gsd1_3(2) = (mix_sd311 * (gs / sqrt (2.0_default))) g_yuk_gsd1_3_c(1) = conjg (g_yuk_gsd1_3(2)) g_yuk_gsd1_3_c(2) = conjg (g_yuk_gsd1_3(1)) g_yuk_gsu2_3(1) = ( - (mix_su322 * (gs / sqrt (2.0_default)))) g_yuk_gsu2_3(2) = (mix_su321 * (gs / sqrt (2.0_default))) g_yuk_gsu2_3_c(1) = conjg (g_yuk_gsu2_3(2)) g_yuk_gsu2_3_c(2) = conjg (g_yuk_gsu2_3(1)) g_yuk_gsd2_3(1) = ( - (mix_sd322 * (gs / sqrt (2.0_default)))) g_yuk_gsd2_3(2) = (mix_sd321 * (gs / sqrt (2.0_default))) g_yuk_gsd2_3_c(1) = conjg (g_yuk_gsd2_3(2)) g_yuk_gsd2_3_c(2) = conjg (g_yuk_gsd2_3(1)) gglglsqsq = (gs**2) gglpsqsq = 2.0_default * e * gs / 3.0_default gglsu1su1_1 = (gz * gs * (((1.0_default / 2.0_default) * & (mix_su111 * conjg (mix_su111))) - (sin2thw * & (2.0_default / 3.0_default)))) gglsu2su2_1 = (gz * gs * (((1.0_default / 2.0_default) * & (mix_su121 * conjg (mix_su121))) - (sin2thw * & (2.0_default / 3.0_default)))) gglsu1su2_1 = (gz * gs * (1.0_default / 2.0_default) * mix_su111 * & conjg (mix_su121)) gglsu2su1_1 = (gz * gs * (1.0_default / 2.0_default) * mix_su121 * & conjg (mix_su111)) gglsd1sd1_1 = ( - (gz * gs * (((1.0_default / 2.0_default) * & (mix_sd111 * conjg (mix_sd111))) - (sin2thw * & (1.0_default / 3.0_default))))) gglsd2sd2_1 = ( - (gz * gs * (((1.0_default / 2.0_default) * & (mix_sd121 * conjg (mix_sd121))) - (sin2thw * & (1.0_default / 3.0_default))))) gglsd1sd2_1 = ( - (gz * gs * & (1.0_default / 2.0_default) * mix_sd111 * conjg (mix_sd121))) gglsd2sd1_1 = ( - (gz * gs * & (1.0_default / 2.0_default) * mix_sd121 * conjg (mix_sd111))) gglsu1su1_2 = (gz * gs * (((1.0_default / 2.0_default) * & (mix_su211 * conjg (mix_su211))) - (sin2thw * & (2.0_default / 3.0_default)))) gglsu2su2_2 = (gz * gs * (((1.0_default / 2.0_default) * & (mix_su221 * conjg (mix_su221))) - (sin2thw * & (2.0_default / 3.0_default)))) gglsu1su2_2 = (gz * gs * (1.0_default / 2.0_default) * mix_su211 * & conjg (mix_su221)) gglsu2su1_2 = (gz * gs * (1.0_default / 2.0_default) * mix_su221 * & conjg (mix_su211)) gglsd1sd1_2 = ( - (gz * gs * (((1.0_default / 2.0_default) * & (mix_sd211 * conjg (mix_sd211))) - (sin2thw * & (1.0_default / 3.0_default))))) gglsd2sd2_2 = ( - (gz * gs * (((1.0_default / 2.0_default) * & (mix_sd221 * conjg (mix_sd221))) - (sin2thw * & (1.0_default / 3.0_default))))) gglsd1sd2_2 = ( - (gz * gs * & (1.0_default / 2.0_default) * mix_sd211 * conjg (mix_sd221))) gglsd2sd1_2 = ( - (gz * gs * & (1.0_default / 2.0_default) * mix_sd221 * conjg (mix_sd211))) gglsu1su1_3 = (gz * gs * (((1.0_default / 2.0_default) * & (mix_su311 * conjg (mix_su311))) - (sin2thw * & (2.0_default / 3.0_default)))) gglsu2su2_3 = (gz * gs * (((1.0_default / 2.0_default) * & (mix_su321 * conjg (mix_su321))) - (sin2thw * & (2.0_default / 3.0_default)))) gglsu1su2_3 = (gz * gs * (1.0_default / 2.0_default) * mix_su311 * & conjg (mix_su321)) gglsu2su1_3 = (gz * gs * (1.0_default / 2.0_default) * mix_su321 * & conjg (mix_su311)) gglsd1sd1_3 = ( - (gz * gs * (((1.0_default / 2.0_default) * & (mix_sd311 * conjg (mix_sd311))) - (sin2thw * & (1.0_default / 3.0_default))))) gglsd2sd2_3 = ( - (gz * gs * (((1.0_default / 2.0_default) * & (mix_sd321 * conjg (mix_sd321))) - (sin2thw * & (1.0_default / 3.0_default))))) gglsd1sd2_3 = ( - (gz * gs * & (1.0_default / 2.0_default) * mix_sd311 * conjg (mix_sd321))) gglsd2sd1_3 = ( - (gz * gs * & (1.0_default / 2.0_default) * mix_sd321 * conjg (mix_sd311))) gglwsu1sd1_1_1 = (g * gs * sqrt (2.0_default) * vckm_11 * & conjg (mix_su111) * mix_sd111) gglwsu2sd2_1_1 = (g * gs * sqrt (2.0_default) * vckm_11 * & conjg (mix_su121) * mix_sd121) gglwsu1sd2_1_1 = (g * gs * sqrt (2.0_default) * vckm_11 * & conjg (mix_su111) * mix_sd121) gglwsu2sd1_1_1 = (g * gs * sqrt (2.0_default) * vckm_11 * & conjg (mix_su121) * mix_sd111) gglwsu1sd1_1_1_c = conjg (gglwsu1sd1_1_1) gglwsu2sd2_1_1_c = conjg (gglwsu2sd2_1_1) gglwsu1sd2_1_1_c = conjg (gglwsu1sd2_1_1) gglwsu2sd1_1_1_c = conjg (gglwsu2sd1_1_1) gglwsu1sd1_1_2 = (g * gs * sqrt (2.0_default) * vckm_12 * & conjg (mix_su111) * mix_sd211) gglwsu2sd2_1_2 = (g * gs * sqrt (2.0_default) * vckm_12 * & conjg (mix_su121) * mix_sd221) gglwsu1sd2_1_2 = (g * gs * sqrt (2.0_default) * vckm_12 * & conjg (mix_su111) * mix_sd221) gglwsu2sd1_1_2 = (g * gs * sqrt (2.0_default) * vckm_12 * & conjg (mix_su121) * mix_sd211) gglwsu1sd1_1_2_c = conjg (gglwsu1sd1_1_2) gglwsu2sd2_1_2_c = conjg (gglwsu2sd2_1_2) gglwsu1sd2_1_2_c = conjg (gglwsu1sd2_1_2) gglwsu2sd1_1_2_c = conjg (gglwsu2sd1_1_2) gglwsu1sd1_1_3 = (g * gs * sqrt (2.0_default) * vckm_13 * & conjg (mix_su111) * mix_sd311) gglwsu2sd2_1_3 = (g * gs * sqrt (2.0_default) * vckm_13 * & conjg (mix_su121) * mix_sd321) gglwsu1sd2_1_3 = (g * gs * sqrt (2.0_default) * vckm_13 * & conjg (mix_su111) * mix_sd321) gglwsu2sd1_1_3 = (g * gs * sqrt (2.0_default) * vckm_13 * & conjg (mix_su121) * mix_sd311) gglwsu1sd1_1_3_c = conjg (gglwsu1sd1_1_3) gglwsu2sd2_1_3_c = conjg (gglwsu2sd2_1_3) gglwsu1sd2_1_3_c = conjg (gglwsu1sd2_1_3) gglwsu2sd1_1_3_c = conjg (gglwsu2sd1_1_3) gglwsu1sd1_2_1 = (g * gs * sqrt (2.0_default) * vckm_21 * & conjg (mix_su211) * mix_sd111) gglwsu2sd2_2_1 = (g * gs * sqrt (2.0_default) * vckm_21 * & conjg (mix_su221) * mix_sd121) gglwsu1sd2_2_1 = (g * gs * sqrt (2.0_default) * vckm_21 * & conjg (mix_su211) * mix_sd121) gglwsu2sd1_2_1 = (g * gs * sqrt (2.0_default) * vckm_21 * & conjg (mix_su221) * mix_sd111) gglwsu1sd1_2_1_c = conjg (gglwsu1sd1_2_1) gglwsu2sd2_2_1_c = conjg (gglwsu2sd2_2_1) gglwsu1sd2_2_1_c = conjg (gglwsu1sd2_2_1) gglwsu2sd1_2_1_c = conjg (gglwsu2sd1_2_1) gglwsu1sd1_2_2 = (g * gs * sqrt (2.0_default) * vckm_22 * & conjg (mix_su211) * mix_sd211) gglwsu2sd2_2_2 = (g * gs * sqrt (2.0_default) * vckm_22 * & conjg (mix_su221) * mix_sd221) gglwsu1sd2_2_2 = (g * gs * sqrt (2.0_default) * vckm_22 * & conjg (mix_su211) * mix_sd221) gglwsu2sd1_2_2 = (g * gs * sqrt (2.0_default) * vckm_22 * & conjg (mix_su221) * mix_sd211) gglwsu1sd1_2_2_c = conjg (gglwsu1sd1_2_2) gglwsu2sd2_2_2_c = conjg (gglwsu2sd2_2_2) gglwsu1sd2_2_2_c = conjg (gglwsu1sd2_2_2) gglwsu2sd1_2_2_c = conjg (gglwsu2sd1_2_2) gglwsu1sd1_2_3 = (g * gs * sqrt (2.0_default) * vckm_23 * & conjg (mix_su211) * mix_sd311) gglwsu2sd2_2_3 = (g * gs * sqrt (2.0_default) * vckm_23 * & conjg (mix_su221) * mix_sd321) gglwsu1sd2_2_3 = (g * gs * sqrt (2.0_default) * vckm_23 * & conjg (mix_su211) * mix_sd321) gglwsu2sd1_2_3 = (g * gs * sqrt (2.0_default) * vckm_23 * & conjg (mix_su221) * mix_sd311) gglwsu1sd1_2_3_c = conjg (gglwsu1sd1_2_3) gglwsu2sd2_2_3_c = conjg (gglwsu2sd2_2_3) gglwsu1sd2_2_3_c = conjg (gglwsu1sd2_2_3) gglwsu2sd1_2_3_c = conjg (gglwsu2sd1_2_3) gglwsu1sd1_3_1 = (g * gs * sqrt (2.0_default) * vckm_31 * & conjg (mix_su311) * mix_sd111) gglwsu2sd2_3_1 = (g * gs * sqrt (2.0_default) * vckm_31 * & conjg (mix_su321) * mix_sd121) gglwsu1sd2_3_1 = (g * gs * sqrt (2.0_default) * vckm_31 * & conjg (mix_su311) * mix_sd121) gglwsu2sd1_3_1 = (g * gs * sqrt (2.0_default) * vckm_31 * & conjg (mix_su321) * mix_sd111) gglwsu1sd1_3_1_c = conjg (gglwsu1sd1_3_1) gglwsu2sd2_3_1_c = conjg (gglwsu2sd2_3_1) gglwsu1sd2_3_1_c = conjg (gglwsu1sd2_3_1) gglwsu2sd1_3_1_c = conjg (gglwsu2sd1_3_1) gglwsu1sd1_3_2 = (g * gs * sqrt (2.0_default) * vckm_32 * & conjg (mix_su311) * mix_sd211) gglwsu2sd2_3_2 = (g * gs * sqrt (2.0_default) * vckm_32 * & conjg (mix_su321) * mix_sd221) gglwsu1sd2_3_2 = (g * gs * sqrt (2.0_default) * vckm_32 * & conjg (mix_su311) * mix_sd221) gglwsu2sd1_3_2 = (g * gs * sqrt (2.0_default) * vckm_32 * & conjg (mix_su321) * mix_sd211) gglwsu1sd1_3_2_c = conjg (gglwsu1sd1_3_2) gglwsu2sd2_3_2_c = conjg (gglwsu2sd2_3_2) gglwsu1sd2_3_2_c = conjg (gglwsu1sd2_3_2) gglwsu2sd1_3_2_c = conjg (gglwsu2sd1_3_2) gglwsu1sd1_3_3 = (g * gs * sqrt (2.0_default) * vckm_33 * & conjg (mix_su311) * mix_sd311) gglwsu2sd2_3_3 = (g * gs * sqrt (2.0_default) * vckm_33 * & conjg (mix_su321) * mix_sd321) gglwsu1sd2_3_3 = (g * gs * sqrt (2.0_default) * vckm_33 * & conjg (mix_su311) * mix_sd321) gglwsu2sd1_3_3 = (g * gs * sqrt (2.0_default) * vckm_33 * & conjg (mix_su321) * mix_sd311) gglwsu1sd1_3_3_c = conjg (gglwsu1sd1_3_3) gglwsu2sd2_3_3_c = conjg (gglwsu2sd2_3_3) gglwsu1sd2_3_3_c = conjg (gglwsu1sd2_3_3) gglwsu2sd1_3_3_c = conjg (gglwsu2sd1_3_3) end subroutine model_update_alpha_s function loop_factor (mloop, mh, type) real(kind=default), intent(in) :: mloop, mh complex(kind=default) :: loop_factor character(5), intent(in) :: type real(kind=default) :: mr if ( mloop .LE. 1.d-06 ) then loop_factor = 0.d0 !!Sorting out the irrelevant ones else mr = mh**2/(4*mloop**2) if (mr .LE. 1.0) then loop_factor = asin( sqrt(mr) )**2 else loop_factor = & -(1.0_default/4.0_default) *& (log( (1.0_default+sqrt(1.0_default-1.0_default/mr))& /(1.0_default-sqrt(1.0_default-1.0_default/mr)) ) & - imago*pi)**2 end if select case (type) case ('ferh0') loop_factor = (2.0_default) *(mr + ( mr - 1.0_default) * loop_factor ) /mr**2 case ('ferA0') loop_factor = loop_factor / mr case ('squh0') loop_factor = - ( mr - loop_factor) / mr**2 case ('vech0') loop_factor = - (2.0_default * mr**2 + 3.0_default * mr + 3.0_default * & (2.0_default * mr - one) * loop_factor) / mr**2 case default loop_factor = 0.0 print *, "Wrong loop factor." end select end if end function loop_factor end module parameters_mssm_hgg Index: trunk/omega/src/modellib_MSSM.ml =================================================================== --- trunk/omega/src/modellib_MSSM.ml (revision 8230) +++ trunk/omega/src/modellib_MSSM.ml (revision 8231) @@ -1,2633 +1,2644 @@ (* modellib_MSSM.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. *) (* modellib_MSSM.ml -- *) (* \thocwmodulesection{Minimal Supersymmetric Standard Model} *) module type MSSM_flags = sig val include_goldstone : bool val include_four : bool val ckm_present : bool val gravitino : bool val higgs_triangle : bool end module MSSM_no_goldstone : MSSM_flags = struct let include_goldstone = false let include_four = true let ckm_present = false let gravitino = false let higgs_triangle = false end module MSSM_goldstone : MSSM_flags = struct let include_goldstone = true let include_four = true let ckm_present = false let gravitino = false let higgs_triangle = false end module MSSM_no_4 : MSSM_flags = struct let include_goldstone = false let include_four = false let ckm_present = false let gravitino = false let higgs_triangle = false end module MSSM_no_4_ckm : MSSM_flags = struct let include_goldstone = false let include_four = false let ckm_present = true let gravitino = false let higgs_triangle = false end module MSSM_Grav : MSSM_flags = struct let include_goldstone = false let include_four = false let ckm_present = false let gravitino = true let higgs_triangle = false end module MSSM_Hgg : MSSM_flags = struct let include_goldstone = false let include_four = false let ckm_present = false let gravitino = false let higgs_triangle = true end module MSSM (Flags : MSSM_flags) = struct open Coupling let default_width = ref Timelike let use_fudged_width = ref false let options = Options.create [ "constant_width", Arg.Unit (fun () -> default_width := Constant), "use constant width (also in t-channel)"; "fudged_width", Arg.Set use_fudged_width, "use fudge factor for charge particle width"; "custom_width", Arg.String (fun f -> default_width := Custom f), "use custom width"; "cancel_widths", Arg.Unit (fun () -> default_width := Vanishing), "use vanishing width"; "cms_width", Arg.Unit (fun () -> default_width := Complex_Mass), "use complex mass scheme"] type gen = | G of int | GG of gen*gen let rec string_of_gen = function | G n when n > 0 -> string_of_int n | G n -> string_of_int (abs n) ^ "c" | GG (g1,g2) -> string_of_gen g1 ^ "_" ^ string_of_gen g2 (* With this we distinguish the flavour. *) type sff = | SL | SN | SU | SD let string_of_sff = function | SL -> "sl" | SN -> "sn" | SU -> "su" | SD -> "sd" (* With this we distinguish the mass eigenstates. At the moment we have to cheat a little bit for the sneutrinos. Because we are dealing with massless neutrinos there is only one sort of sneutrino. *) type sfm = | M1 | M2 let string_of_sfm = function | M1 -> "1" | M2 -> "2" (* We also introduce special types for the charginos and neutralinos. *) type char = | C1 | C2 | C1c | C2c type neu = | N1 | N2 | N3 | N4 let int_of_char = function | C1 -> 1 | C2 -> 2 | C1c -> -1 | C2c -> -2 let string_of_char = function | C1 -> "1" | C2 -> "2" | C1c -> "-1" | C2c -> "-2" let conj_char = function | C1 -> C1c | C2 -> C2c | C1c -> C1 | C2c -> C2 let string_of_neu = function | N1 -> "1" | N2 -> "2" | N3 -> "3" | N4 -> "4" (* Also we need types to distinguish the Higgs bosons. We follow the conventions of Kuroda, which means \begin{align} \label{eq:higgs3} H_1 &= \begin{pmatrix} \frac{1}{\sqrt{2}} \bigl( v_1 + H^0 \cos\alpha - h^0 \sin\alpha + \ii A^0 \sin\beta - \ii \phi^0 \cos\beta \bigr) \\ H^- \sin\beta - \phi^- \cos\beta \end{pmatrix}, \\ & \notag \\ H_2 & = \begin{pmatrix} H^+ \cos\beta + \phi^+ \sin\beta \\ \frac{1}{\sqrt{2}} \bigl( v_2 + H^0 \sin\alpha + h^0 \cos\alpha + \ii A^0 \cos\beta + \ii \phi^0 \sin\beta \bigr) \end{pmatrix} \label{eq:higgs4} \end{align} This is a different sign convention compared to, e.g., Weinberg's volume iii. We will refer to it as [GS+]. *) type higgs = | H1 (* the light scalar Higgs *) | H2 (* the heavy scalar Higgs *) | H3 (* the pseudoscalar Higgs *) | H4 (* the charged Higgs *) | H5 (* the neutral Goldstone boson *) | H6 (* the charged Goldstone boson *) | DH of higgs*higgs let rec string_of_higgs = function | H1 -> "h1" | H2 -> "h2" | H3 -> "h3" | H4 -> "h4" | H5 -> "p1" | H6 -> "p2" | DH (h1,h2) -> string_of_higgs h1 ^ string_of_higgs h2 type flavor = | L of int | N of int | U of int | D of int | Sup of sfm*int | Sdown of sfm*int | Ga | Wp | Wm | Z | Gl | Slepton of sfm*int | Sneutrino of int | Neutralino of neu | Chargino of char | Gluino | Grino | Phip | Phim | Phi0 | H_Heavy | H_Light | Hp | Hm | A type gauge = unit let gauge_symbol () = failwith "Modellib_MSSM.MSSM.gauge_symbol: internal error" (* At this point we will forget graviton and -tino. *) let lep_family g = [ L g; N g; Slepton (M1,g); Slepton (M2,g); Sneutrino g ] let family g = [ L g; N g; Slepton (M1,g); Slepton (M2,g); Sneutrino g; U g; D g; Sup (M1,g); Sup (M2,g); Sdown (M1,g); Sdown (M2,g)] let external_flavors'' = [ "1st Generation", ThoList.flatmap family [1; -1]; "2nd Generation", ThoList.flatmap family [2; -2]; "3rd Generation", ThoList.flatmap family [3; -3]; "Gauge Bosons", [Ga; Z; Wp; Wm; Gl]; "Charginos", [Chargino C1; Chargino C2; Chargino C1c; Chargino C2c]; "Neutralinos", [Neutralino N1; Neutralino N2; Neutralino N3; Neutralino N4]; "Higgs Bosons", [H_Heavy; H_Light; Hp; Hm; A]; "Gluinos", [Gluino]] let external_flavors' = if Flags.gravitino then external_flavors'' @ ["Gravitino", [Grino]] else external_flavors'' let external_flavors () = if Flags.include_goldstone then external_flavors' @ ["Goldstone Bosons", [Phip; Phim; Phi0]] else external_flavors' let flavors () = ThoList.flatmap snd (external_flavors ()) let spinor n = if n >= 0 then Spinor else if n <= 0 then ConjSpinor else invalid_arg "Modellib_MSSM.MSSM.spinor: internal error" let lorentz = function | L g -> spinor g | N g -> spinor g | U g -> spinor g | D g -> spinor g | Chargino c -> spinor (int_of_char c) | Ga -> Vector (*i | Ga -> Ward_Vector i*) | Gl -> Vector | Wp | Wm | Z -> Massive_Vector | H_Heavy | H_Light | Hp | Hm | A -> Scalar | Phip | Phim | Phi0 -> Scalar | Sup _ | Sdown _ | Slepton _ | Sneutrino _ -> Scalar | Neutralino _ -> Majorana | Gluino -> Majorana | Grino -> Vectorspinor let color = function | U g -> Color.SUN (if g > 0 then 3 else -3) | Sup (m,g) -> Color.SUN (if g > 0 then 3 else -3) | D g -> Color.SUN (if g > 0 then 3 else -3) | Sdown (m,g) -> Color.SUN (if g > 0 then 3 else -3) | Gl | Gluino -> Color.AdjSUN 3 | _ -> Color.Singlet let prop_spinor n = if n >= 0 then Prop_Spinor else if n <=0 then Prop_ConjSpinor else invalid_arg "Modellib_MSSM.MSSM.prop_spinor: internal error" let propagator = function | L g -> prop_spinor g | N g -> prop_spinor g | U g -> prop_spinor g | D g -> prop_spinor g | Chargino c -> prop_spinor (int_of_char c) | Ga | Gl -> Prop_Feynman | Wp | Wm | Z -> Prop_Unitarity | H_Heavy | H_Light | Hp | Hm | A -> Prop_Scalar | Phip | Phim | Phi0 -> if Flags.include_goldstone then Prop_Scalar else Only_Insertion | Slepton _ | Sneutrino _ | Sup _ | Sdown _ -> Prop_Scalar | Gluino -> Prop_Majorana | Neutralino _ -> Prop_Majorana | Grino -> Only_Insertion (* Note, that we define the gravitino only as an insertion since when using propagators we are effectively going to a higher order in the gravitational coupling. This would enforce us to also include higher-dimensional vertices with two gravitinos for a consistent power counting in $1/M_{\text{Planck}}$. *) (*i | Grino -> Prop_Vectorspinor i*) (* Optionally, ask for the fudge factor treatment for the widths of charged particles. Currently, this only applies to $W^\pm$ and top. *) let width f = if !use_fudged_width then match f with | Wp | Wm | U 3 | U (-3) -> Fudged | _ -> !default_width else !default_width (* For the Goldstone bosons we adopt the conventions of the Kuroda paper. \begin{subequations} \begin{equation} H_1 \equiv \begin{pmatrix} \left( v_1 + H^0 \cos\alpha - h^0 \sin \alpha + \ii A^0 \sin\beta - \ii \cos\beta \phi^0 \right) / \sqrt{2} \\ H^- \sin\beta - \phi^- \cos\beta \end{pmatrix} \end{equation} \begin{equation} H_2 \equiv \begin{pmatrix} H^+ \cos\beta + \phi^+ \sin\beta \\ \left( v_2 + H^0 \sin\alpha + h^0 \cos\alpha + \ii A^0 \cos\beta + \ii \phi^0 \sin\beta \right) / \sqrt{2} \end{pmatrix} \end{equation} \end{subequations} *) let goldstone = function | Wp -> Some (Phip, Coupling.Const 1) | Wm -> Some (Phim, Coupling.Const 1) | Z -> Some (Phi0, Coupling.Const 1) | _ -> None let conjugate = function | L g -> L (-g) | N g -> N (-g) | U g -> U (-g) | D g -> D (-g) | Sup (m,g) -> Sup (m,-g) | Sdown (m,g) -> Sdown (m,-g) | Slepton (m,g) -> Slepton (m,-g) | Sneutrino g -> Sneutrino (-g) | Gl -> Gl (* | Gl0 -> Gl0 *) | Ga -> Ga | Z -> Z | Wp -> Wm | Wm -> Wp | H_Heavy -> H_Heavy | H_Light -> H_Light | A -> A | Hp -> Hm | Hm -> Hp | Phip -> Phim | Phim -> Phip | Phi0 -> Phi0 | Gluino -> Gluino | Grino -> Grino | Neutralino n -> Neutralino n | Chargino c -> Chargino (conj_char c) let fermion = function | L g -> if g > 0 then 1 else -1 | N g -> if g > 0 then 1 else -1 | U g -> if g > 0 then 1 else -1 | D g -> if g > 0 then 1 else -1 | Gl | Ga | Z | Wp | Wm -> 0 (* | Gl0 -> 0 *) | H_Heavy | H_Light | Hp | Hm | A -> 0 | Phip | Phim | Phi0 -> 0 | Neutralino _ -> 2 | Chargino c -> if (int_of_char c) > 0 then 1 else -1 | Sup _ -> 0 | Sdown _ -> 0 | Slepton _ -> 0 | Sneutrino _ -> 0 | Gluino | Grino -> 2 (* Because the O'Caml compiler only allows 248 constructors we must divide the constants into subgroups of constants, e.g. for the Higgs couplings. In the MSSM there are a lot of angles among the parameters, the Weinberg-angle, the angle describing the Higgs vacuum structure, the mixing angle of the real parts of the Higgs dubletts, the mixing angles of the sfermions. Therefore we are going to define the trigonometric functions of those angles not as constants but as functors of the angels. Sums and differences of angles are only used as arguments for the $\alpha$ and $\beta$ angles, so it makes no sense to define special functions for differences and sums of angles. *) type angle = | Thw | Al | Be | Th_SF of sff*int | Delta | CKM_12 | CKM_13 | CKM_23 let string_of_angle = function | Thw -> "thw" | Al -> "al" | Be -> "be" | Delta -> "d" | CKM_12 -> "ckm12" | CKM_13 -> "ckm13" | CKM_23 -> "ckm23" | Th_SF (f,g) -> "th" ^ string_of_sff f ^ string_of_int g (* We introduce a Boolean type vc as a pseudonym for Vertex Conjugator to distinguish between vertices containing complex mixing matrices like the CKM--matrix or the sfermion or neutralino/chargino--mixing matrices, which have to become complex conjugated. The true--option stands for the conjugated vertex, the false--option for the unconjugated vertex. *) type vc = bool type constant = | Unit | Pi | Alpha_QED | Sin2thw | Sin of angle | Cos of angle | E | G | Vev | Tanb | Tana | Cos2be | Cos2al | Sin2be | Sin2al | Sin4al | Sin4be | Cos4be | Cosapb | Cosamb | Sinapb | Sinamb | Cos2am2b | Sin2am2b | Eidelta | Mu | AU of int | AD of int | AL of int | V_CKM of int*int | M_SF of sff*int*sfm*sfm | M_V of char*char (* left chargino mixing matrix *) | M_U of char*char (* right chargino mixing matrix *) | M_N of neu*neu (* neutralino mixing matrix *) | V_0 of neu*neu | A_0 of neu*neu | V_P of char*char | A_P of char*char | L_CN of char*neu | R_CN of char*neu | L_NC of neu*char | R_NC of neu*char (*i | L_NF of neu*sff*sfm | R_NF of neu*sff*sfm i*) | S_NNH1 of neu*neu | P_NNH1 of neu*neu | S_NNH2 of neu*neu | P_NNH2 of neu*neu | S_NNA of neu*neu | P_NNA of neu*neu | S_NNG of neu*neu | P_NNG of neu*neu | L_CNG of char*neu | R_CNG of char*neu | L_NCH of neu*char | R_NCH of neu*char | Q_lepton | Q_up | Q_down | Q_charg | G_Z | G_CC | G_CCQ of vc*int*int | G_NC_neutrino | G_NC_lepton | G_NC_up | G_NC_down | I_Q_W | I_G_ZWW | G_WWWW | G_ZZWW | G_PZWW | G_PPWW | G_strong | G_SS | I_G_S | G_S_Sqrt | Gs | M of flavor | W of flavor - | G_NZN of neu*neu | G_CZC of char*char + | G_NZN of neu*neu | G_CZC of char*char | G_NNA | G_YUK of int*int | G_YUK_1 of int*int | G_YUK_2 of int*int | G_YUK_3 of int*int | G_YUK_4 of int*int | G_NHC of neu*char | G_CHN of char*neu | G_YUK_C of vc*int*char*sff*sfm | G_YUK_Q of vc*int*int*char*sff*sfm | G_YUK_N of vc*int*neu*sff*sfm | G_YUK_G of vc*int*sff*sfm | G_NGC of neu*char | G_CGN of char*neu | SUM_1 | G_NWC of neu*char | G_CWN of char*neu | G_CH1C of char*char | G_CH2C of char*char | G_CAC of char*char | G_CGC of char*char | G_SWS of vc*int*int*sfm*sfm | G_SLSNW of vc*int*sfm | G_ZSF of sff*int*sfm*sfm | G_CICIH1 of neu*neu | G_CICIH2 of neu*neu | G_CICIA of neu*neu | G_CICIG of neu*neu | G_GH of int | G_GHGo of int | G_GLGLH | G_GLGLHH | G_GLGLA | G_PPH | G_PPHH | G_PPA | G_WWSFSF of sff*int*sfm*sfm | G_WPSLSN of vc*int*sfm | G_H3 of int | G_H4 of int | G_HGo3 of int | G_HGo4 of int | G_GG4 of int | G_H1SFSF of sff*int*sfm*sfm | G_H2SFSF of sff*int*sfm*sfm | G_ASFSF of sff*int*sfm*sfm | G_HSNSL of vc*int*sfm | G_GoSFSF of sff*int*sfm*sfm | G_GoSNSL of vc*int*sfm | G_HSUSD of vc*sfm*sfm*int*int | G_GSUSD of vc*sfm*sfm*int*int | G_WPSUSD of vc*sfm*sfm*int*int | G_WZSUSD of vc*sfm*sfm*int*int | G_WZSLSN of vc*int*sfm | G_GlGlSQSQ | G_PPSFSF of sff | G_ZZSFSF of sff*int*sfm*sfm | G_ZPSFSF of sff*int*sfm*sfm | G_GlZSFSF of sff*int*sfm*sfm | G_GlPSQSQ | G_GlWSUSD of vc*sfm*sfm*int*int | G_GH4 of int | G_GHGo4 of int | G_H1H2SFSF of sff*sfm*sfm*int | G_H1H1SFSF of sff*sfm*sfm*int | G_H2H2SFSF of sff*sfm*sfm*int | G_HHSFSF of sff*sfm*sfm*int | G_AASFSF of sff*sfm*sfm*int | G_HH1SLSN of vc*sfm*int | G_HH2SLSN of vc*sfm*int | G_HASLSN of vc*sfm*int | G_HH1SUSD of vc*sfm*sfm*int*int | G_HH2SUSD of vc*sfm*sfm*int*int | G_HASUSD of vc*sfm*sfm*int*int | G_AG0SFSF of sff*sfm*sfm*int | G_HGSFSF of sff*sfm*sfm*int | G_GGSFSF of sff*sfm*sfm*int | G_G0G0SFSF of sff*sfm*sfm*int | G_HGSNSL of vc*sfm*int | G_H1GSNSL of vc*sfm*int | G_H2GSNSL of vc*sfm*int | G_AGSNSL of vc*sfm*int | G_GGSNSL of vc*sfm*int | G_HGSUSD of vc*sfm*sfm*int*int | G_H1GSUSD of vc*sfm*sfm*int*int | G_H2GSUSD of vc*sfm*sfm*int*int | G_AGSUSD of vc*sfm*sfm*int*int | G_GGSUSD of vc*sfm*sfm*int*int | G_SN4 of int*int | G_SN2SL2_1 of sfm*sfm*int*int | G_SN2SL2_2 of sfm*sfm*int*int | G_SF4 of sff*sff*sfm*sfm*sfm*sfm*int*int | G_SF4_3 of sff*sff*sfm*sfm*sfm*sfm*int*int*int | G_SF4_4 of sff*sff*sfm*sfm*sfm*sfm*int*int*int*int | G_SL4 of sfm*sfm*sfm*sfm*int | G_SL4_2 of sfm*sfm*sfm*sfm*int*int | G_SN2SQ2 of sff*sfm*sfm*int*int | G_SL2SQ2 of sff*sfm*sfm*sfm*sfm*int*int | G_SUSDSNSL of vc*sfm*sfm*sfm*int*int*int | G_SU4 of sfm*sfm*sfm*sfm*int | G_SU4_2 of sfm*sfm*sfm*sfm*int*int | G_SD4 of sfm*sfm*sfm*sfm*int | G_SD4_2 of sfm*sfm*sfm*sfm*int*int | G_SU2SD2 of sfm*sfm*sfm*sfm*int*int*int*int | G_HSF31 of higgs*int*sfm*sfm*sff*sff | G_HSF32 of higgs*int*int*sfm*sfm*sff*sff | G_HSF41 of higgs*int*sfm*sfm*sff*sff | G_HSF42 of higgs*int*int*sfm*sfm*sff*sff | G_Grav | G_Gr_Ch of char | G_Gr_Z_Neu of neu | G_Gr_A_Neu of neu | G_Gr4_Neu of neu | G_Gr4_A_Ch of char | G_Gr4_Z_Ch of char | G_Grav_N | G_Grav_U of int*sfm | G_Grav_D of int*sfm | G_Grav_L of int*sfm | G_Grav_Uc of int*sfm | G_Grav_Dc of int*sfm | G_Grav_Lc of int*sfm | G_GravGl | G_Gr_H_Ch of char | G_Gr_H1_Neu of neu | G_Gr_H2_Neu of neu | G_Gr_H3_Neu of neu | G_Gr4A_Sl of int*sfm | G_Gr4A_Slc of int*sfm | G_Gr4A_Su of int*sfm | G_Gr4A_Suc of int*sfm | G_Gr4A_Sd of int*sfm | G_Gr4A_Sdc of int*sfm | G_Gr4Z_Sn | G_Gr4Z_Snc | G_Gr4Z_Sl of int*sfm | G_Gr4Z_Slc of int*sfm | G_Gr4Z_Su of int*sfm | G_Gr4Z_Suc of int*sfm | G_Gr4Z_Sd of int*sfm | G_Gr4Z_Sdc of int*sfm | G_Gr4W_Sl of int*sfm | G_Gr4W_Slc of int*sfm | G_Gr4W_Su of int*sfm | G_Gr4W_Suc of int*sfm | G_Gr4W_Sd of int*sfm | G_Gr4W_Sdc of int*sfm | G_Gr4W_Sn | G_Gr4W_Snc | G_Gr4Gl_Su of int*sfm | G_Gr4Gl_Suc of int*sfm | G_Gr4Gl_Sd of int*sfm | G_Gr4Gl_Sdc of int*sfm | G_Gr4_Z_H1 of neu | G_Gr4_Z_H2 of neu | G_Gr4_Z_H3 of neu | G_Gr4_W_H of neu | G_Gr4_W_Hc of neu | G_Gr4_H_A of char | G_Gr4_H_Z of char (* Two integer counters for the QCD and EW order of the couplings. *) type orders = int * int let orders = function | _ -> (0,0) let ferm_of_sff = function | SL, g -> (L g) | SN, g -> (N g) | SU, g -> (U g) | SD, g -> (D g) (* \begin{subequations} \begin{align} \alpha_{\text{QED}} &= \frac{1}{137.0359895} \\ \sin^2\theta_w &= 0.23124 \end{align} \end{subequations} Here we must perhaps allow for complex input parameters. So split them into their modulus and their phase. At first, we leave them real; the generalization to complex parameters is obvious. *) module Ch = Charges.QQ let ( // ) = Algebra.Small_Rational.make let generation' = function | 1 -> [ 1//1; 0//1; 0//1] | 2 -> [ 0//1; 1//1; 0//1] | 3 -> [ 0//1; 0//1; 1//1] | -1 -> [-1//1; 0//1; 0//1] | -2 -> [ 0//1; -1//1; 0//1] | -3 -> [ 0//1; 0//1; -1//1] | n -> invalid_arg ("MSSM.generation': " ^ string_of_int n) let generation f = if Flags.ckm_present then [] else match f with | L n | N n | U n | D n | Sup (_,n) | Sdown (_,n) | Slepton (_,n) | Sneutrino n -> generation' n | _ -> [0//1; 0//1; 0//1] let charge = function | L n -> if n > 0 then -1//1 else 1//1 | Slepton (_,n) -> if n > 0 then -1//1 else 1//1 | N n -> 0//1 | Sneutrino n -> 0//1 | U n -> if n > 0 then 2//3 else -2//3 | Sup (_,n) -> if n > 0 then 2//3 else -2//3 | D n -> if n > 0 then -1//3 else 1//3 | Sdown (_,n) -> if n > 0 then -1//3 else 1//3 | Gl | Ga | Z | Neutralino _ | Gluino -> 0//1 | Wp -> 1//1 | Wm -> -1//1 | H_Heavy | H_Light | Phi0 -> 0//1 | Hp | Phip -> 1//1 | Hm | Phim -> -1//1 | Chargino (C1 | C2) -> 1//1 | Chargino (C1c | C2c) -> -1//1 | _ -> 0//1 let lepton = function | L n | N n -> if n > 0 then 1//1 else -1//1 | Slepton (_,n) | Sneutrino n -> if n > 0 then 1//1 else -1//1 | _ -> 0//1 let baryon = function | U n | D n -> if n > 0 then 1//1 else -1//1 | Sup (_,n) | Sdown (_,n) -> if n > 0 then 1//1 else -1//1 | _ -> 0//1 let charges f = [ charge f; lepton f; baryon f] @ generation f let parameters () = { input = []; derived = []; derived_arrays = [] } module F = Modeltools.Fusions (struct type f = flavor type c = constant let compare = compare let conjugate = conjugate end) (* For the couplings there are generally two possibilities concerning the sign of the covariant derivative. \begin{equation} {\rm CD}^\pm = \partial_\mu \pm \ii g T^a A^a_\mu \end{equation} The particle data group defines the signs consistently to be positive. Since the convention for that signs also influence the phase definitions of the gaugino/higgsino fields via the off-diagonal entries in their mass matrices it would be the best to adopt that convention. *) (*** REVISED: Compatible with CD+. ***) let electromagnetic_currents_3 g = [((U (-g), Ga, U g), FBF (1, Psibar, V, Psi), Q_up); ((D (-g), Ga, D g), FBF (1, Psibar, V, Psi), Q_down); ((L (-g), Ga, L g), FBF (1, Psibar, V, Psi), Q_lepton) ] (*** REVISED: Compatible with CD+. ***) let electromagnetic_sfermion_currents g m = [ ((Ga, Slepton (m,-g), Slepton (m,g)), Vector_Scalar_Scalar 1, Q_lepton); ((Ga, Sup (m,-g), Sup (m,g)), Vector_Scalar_Scalar 1, Q_up); ((Ga, Sdown (m,-g), Sdown (m,g)), Vector_Scalar_Scalar 1, Q_down) ] (*** REVISED: Compatible with CD+. ***) let electromagnetic_currents_2 c = let cc = conj_char c in [ ((Chargino cc, Ga, Chargino c), FBF (1, Psibar, V, Psi), Q_charg) ] (*** REVISED: Compatible with CD+. ***) let neutral_currents g = [ ((L (-g), Z, L g), FBF (1, Psibar, VA, Psi), G_NC_lepton); ((N (-g), Z, N g), FBF (1, Psibar, VA, Psi), G_NC_neutrino); ((U (-g), Z, U g), FBF (1, Psibar, VA, Psi), G_NC_up); ((D (-g), Z, D g), FBF (1, Psibar, VA, Psi), G_NC_down) ] (* \begin{equation} \mathcal{L}_{\textrm{CC}} = \mp \frac{g}{2\sqrt2} \sum_i \bar\psi_i \gamma^\mu (1-\gamma_5)(T^+W^+_\mu+T^-W^-_\mu)\psi_i , \end{equation} where the sign corresponds to $\text{CD}_\pm$, respectively. *) (*** REVISED: Compatible with CD+. ***) (* Remark: The definition with the other sign compared to the SM files comes from the fact that $g_{cc} = 1/(2\sqrt{2})$ is used overwhelmingly often in the SUSY Feynman rules, so that JR decided to use a different definiton for [g_cc] in SM and MSSM. *) let charged_currents g = [ ((L (-g), Wm, N g), FBF ((-1), Psibar, VL, Psi), G_CC); ((N (-g), Wp, L g), FBF ((-1), Psibar, VL, Psi), G_CC) ] (* The quark with the inverted generation (the antiparticle) is the outgoing one, the other the incoming. The vertex attached to the outgoing up-quark contains the CKM matrix element {\em not} complex conjugated, while the vertex with the outgoing down-quark has the conjugated CKM matrix element. *) (*** REVISED: Compatible with CD+. ***) let charged_quark_currents g h = [ ((D (-g), Wm, U h), FBF ((-1), Psibar, VL, Psi), G_CCQ (true,g,h)); ((U (-g), Wp, D h), FBF ((-1), Psibar, VL, Psi), G_CCQ (false,h,g))] (*** REVISED: Compatible with CD+. ***) let charged_chargino_currents n c = let cc = conj_char c in [ ((Chargino cc, Wp, Neutralino n), FBF (1, Psibar, VLR, Chi), G_CWN (c,n)); ((Neutralino n, Wm, Chargino c), FBF (1, Chibar, VLR, Psi), G_NWC (n,c)) ] (*** REVISED: Compatible with CD+. ***) let charged_slepton_currents g m = [ ((Wm, Slepton (m,-g), Sneutrino g), Vector_Scalar_Scalar (-1), G_SLSNW (true,g,m)); ((Wp, Slepton (m,g), Sneutrino (-g)), Vector_Scalar_Scalar 1, G_SLSNW (false,g,m)) ] (*** REVISED: Compatible with CD+. ***) let charged_squark_currents' g h m1 m2 = [ ((Wm, Sup (m1,g), Sdown (m2,-h)), Vector_Scalar_Scalar (-1), G_SWS (true,g,h,m1,m2)); ((Wp, Sup (m1,-g), Sdown (m2,h)), Vector_Scalar_Scalar 1, G_SWS (false,g,h,m1,m2)) ] let charged_squark_currents g h = List.flatten (Product.list2 (charged_squark_currents' g h) [M1;M2] [M1;M2]) (*** REVISED: Compatible with CD+. ***) let neutral_sfermion_currents' g m1 m2 = [ ((Z, Slepton (m1,-g), Slepton (m2,g)), Vector_Scalar_Scalar (-1), G_ZSF (SL,g,m1,m2)); ((Z, Sup (m1,-g), Sup (m2,g)), Vector_Scalar_Scalar (-1), G_ZSF (SU,g,m1,m2)); ((Z, Sdown (m1,-g), Sdown (m2,g)), Vector_Scalar_Scalar (-1), G_ZSF (SD,g,m1,m2)) ] let neutral_sfermion_currents g = List.flatten (Product.list2 (neutral_sfermion_currents' g) [M1;M2] [M1;M2]) @ [ ((Z, Sneutrino (-g), Sneutrino g), Vector_Scalar_Scalar (-1), G_ZSF (SN,g,M1,M1)) ] (* The reality of the coupling of the Z-boson to two identical neutralinos makes the vector part of the coupling vanish. So we distinguish them not by the name but by the structure of the couplings. *) (*** REVISED: Compatible with CD+. ***) let neutral_Z_1 (n,m) = [ ((Neutralino n, Z, Neutralino m), FBF (1, Chibar, VA, Chi), (G_NZN (n,m))) ] (*** REVISED: Compatible with CD+. ***) let neutral_Z_2 n = [ ((Neutralino n, Z, Neutralino n), FBF (1, Chibar, Coupling.A, Chi), - (G_NZN (n,n)) )] + (G_NZN (n,n)) )] + +(* For very compressed spectra, radiative decays of the next-to-lightest neutralino + become important. The formula can be found Haber/Wyler, 1989. In abuse, we + include this loop-induced coupling together in the same model variant with the + triangle Higgs couplings. *) + let neutral_A = + if Flags.higgs_triangle then + [ ((Neutralino N2, Ga, Neutralino N1), FBF (1, Chibar, TVAM, Chi), G_NNA) ] + else + [] (*** REVISED: Compatible with CD+. ***) let charged_Z c1 c2 = let cc1 = conj_char c1 in ((Chargino cc1, Z, Chargino c2), FBF ((-1), Psibar, VA, Psi), G_CZC (c1,c2)) (*** REVISED: Compatible with CD+. ***) let yukawa_v = [ ((Gluino, Gl, Gluino), FBF (1, Chibar, V, Chi), Gs) ] (*** REVISED: Independent of the sign of CD. ***) let yukawa_higgs g = [ ((N (-g), Hp, L g), FBF (1, Psibar, Coupling.SR, Psi), G_YUK (6,g)); ((L (-g), Hm, N g), FBF (1, Psibar, Coupling.SL, Psi), G_YUK (6,g)); ((L (-g), H_Heavy, L g), FBF (1, Psibar, S, Psi), G_YUK (7,g)); ((L (-g), H_Light, L g), FBF (1, Psibar, S, Psi), G_YUK (8,g)); ((L (-g), A, L g), FBF (1, Psibar, P, Psi), G_YUK (9,g)); ((U (-g), H_Heavy, U g), FBF (1, Psibar, S, Psi), G_YUK (10,g)); ((U (-g), H_Light, U g), FBF (1, Psibar, S, Psi), G_YUK (11,g)); ((U (-g), A, U g), FBF (1, Psibar, P, Psi), G_YUK (12,g)); ((D (-g), H_Heavy, D g), FBF (1, Psibar, S, Psi), G_YUK (13,g)); ((D (-g), H_Light, D g), FBF (1, Psibar, S, Psi), G_YUK (14,g)); ((D (-g), A, D g), FBF (1, Psibar, P, Psi), G_YUK (15,g)) ] (*** REVISED: Compatible with CD+ and GS+. ***) let yukawa_goldstone g = [ ((N (-g), Phip, L g), FBF (1, Psibar, Coupling.SR, Psi), G_YUK (19,g)); ((L (-g), Phim, N g), FBF (1, Psibar, Coupling.SL, Psi), G_YUK (19,g)); ((L (-g), Phi0, L g), FBF (1, Psibar, P, Psi), G_YUK (16,g)); ((U (-g), Phi0, U g), FBF (1, Psibar, P, Psi), G_YUK (17,g)); ((D (-g), Phi0, D g), FBF (1, Psibar, P, Psi), G_YUK (18,g)) ] (*** REVISED: Independent of the sign of CD. ***) let yukawa_higgs_quark (g,h) = [ ((U (-g), Hp, D h), FBF (1, Psibar, SLR, Psi), G_YUK_1 (g, h)); ((D (-h), Hm, U g), FBF (1, Psibar, SLR, Psi), G_YUK_2 (g, h)) ] (*** REVISED: Compatible with CD+ and GS+. ***) let yukawa_goldstone_quark g h = [ ((U (-g), Phip, D h), FBF (1, Psibar, SLR, Psi), G_YUK_3 (g, h)); ((D (-h), Phim, U g), FBF (1, Psibar, SLR, Psi), G_YUK_4 (g, h)) ] (*** REVISED: Compatible with CD+. *) let yukawa_higgs_2' (c1,c2) = let cc1 = conj_char c1 in [ ((Chargino cc1, H_Heavy, Chargino c2), FBF (1, Psibar, SLR, Psi), G_CH2C (c1,c2)); ((Chargino cc1, H_Light, Chargino c2), FBF (1, Psibar, SLR, Psi), G_CH1C (c1,c2)); ((Chargino cc1, A, Chargino c2), FBF (1, Psibar, SLR, Psi), G_CAC (c1,c2)) ] let yukawa_higgs_2'' c = let cc = conj_char c in [ ((Chargino cc, H_Heavy, Chargino c), FBF (1, Psibar, S, Psi), G_CH2C (c,c)); ((Chargino cc, H_Light, Chargino c), FBF (1, Psibar, S, Psi), G_CH1C (c,c)); ((Chargino cc, A, Chargino c), FBF (1, Psibar, P, Psi), G_CAC (c,c)) ] let yukawa_higgs_2 = ThoList.flatmap yukawa_higgs_2' [(C1,C2);(C2,C1)] @ ThoList.flatmap yukawa_higgs_2'' [C1;C2] (*** REVISED: Compatible with CD+ and GS+. ***) let yukawa_goldstone_2' (c1,c2) = let cc1 = conj_char c1 in [ ((Chargino cc1, Phi0, Chargino c2), FBF (1, Psibar, SLR, Psi), G_CGC (c1,c2)) ] let yukawa_goldstone_2'' c = let cc = conj_char c in [ ((Chargino cc, Phi0, Chargino c), FBF (1, Psibar, P, Psi), G_CGC (c,c)) ] let yukawa_goldstone_2 = ThoList.flatmap yukawa_goldstone_2' [(C1,C2);(C2,C1)] @ ThoList.flatmap yukawa_goldstone_2'' [C1;C2] (*** REVISED: Compatible with CD+. ***) let higgs_charg_neutr n c = let cc = conj_char c in [ ((Neutralino n, Hm, Chargino c), FBF (-1, Chibar, SLR, Psi), G_NHC (n,c)); ((Chargino cc, Hp, Neutralino n), FBF (-1, Psibar, SLR, Chi), G_CHN (c,n)) ] (*** REVISED: Compatible with CD+ and GS+. ***) let goldstone_charg_neutr n c = let cc = conj_char c in [ ((Neutralino n, Phim, Chargino c), FBF (1, Chibar, SLR, Psi), G_NGC (n,c)); ((Chargino cc, Phip, Neutralino n), FBF (1, Psibar, SLR, Chi), G_CGN (c,n)) ] (*** REVISED: Compatible with CD+. ***) let higgs_neutr' (n,m) = [ ((Neutralino n, H_Heavy, Neutralino m), FBF (1, Chibar, SP, Chi), G_CICIH2 (n,m)); ((Neutralino n, H_Light, Neutralino m), FBF (1, Chibar, SP, Chi), G_CICIH1 (n,m)); ((Neutralino n, A, Neutralino m), FBF (1, Chibar, SP, Chi), G_CICIA (n,m)) ] let higgs_neutr'' n = [ ((Neutralino n, H_Heavy, Neutralino n), FBF (1, Chibar, S, Chi), G_CICIH2 (n,n)); ((Neutralino n, H_Light, Neutralino n), FBF (1, Chibar, S, Chi), G_CICIH1 (n,n)); ((Neutralino n, A, Neutralino n), FBF (1, Chibar, P, Chi), G_CICIA (n,n)) ] let higgs_neutr = ThoList.flatmap higgs_neutr' [(N1,N2);(N1,N3);(N1,N4); (N2,N3);(N2,N4);(N3,N4)] @ ThoList.flatmap higgs_neutr'' [N1;N2;N3;N4] (*** REVISED: Compatible with CD+ and GS+. ***) let goldstone_neutr' (n,m) = [ ((Neutralino n, Phi0, Neutralino m), FBF (1, Chibar, SP, Chi), G_CICIG (n,m)) ] let goldstone_neutr'' n = [ ((Neutralino n, Phi0, Neutralino n), FBF (1, Chibar, P, Chi), G_CICIG (n,n)) ] let goldstone_neutr = ThoList.flatmap goldstone_neutr' [(N1,N2);(N1,N3);(N1,N4); (N2,N3);(N2,N4);(N3,N4)] @ ThoList.flatmap goldstone_neutr'' [N1;N2;N3;N4] (*** REVISED: Compatible with CD+. ***) let yukawa_n_1 n g = [ ((Neutralino n, Slepton (M1,-g), L g), FBF (1, Chibar, Coupling.SL, Psi), G_YUK_N (true,g,n,SL,M1)); ((Neutralino n, Slepton (M2,-g), L g), FBF (1, Chibar, SR, Psi), G_YUK_N (true,g,n,SL,M2)); ((L (-g), Slepton (M1,g), Neutralino n), FBF (1, Psibar, SR, Chi), G_YUK_N (false,g,n,SL,M1)); ((L (-g), Slepton (M2,g), Neutralino n), FBF (1, Psibar, Coupling.SL, Chi), G_YUK_N (false,g,n,SL,M2)); ((Neutralino n, Sup (M1,-g), U g), FBF (1, Chibar, Coupling.SL, Psi), G_YUK_N (true,g,n,SU,M1)); ((Neutralino n, Sup (M2,-g), U g), FBF (1, Chibar, SR, Psi), G_YUK_N (true,g,n,SU,M2)); ((U (-g), Sup (M1,g), Neutralino n), FBF (1, Psibar, SR, Chi), G_YUK_N (false,g,n,SU,M1)); ((U (-g), Sup (M2,g), Neutralino n), FBF (1, Psibar, Coupling.SL, Chi), G_YUK_N (false,g,n,SU,M2)); ((Neutralino n, Sdown (M1,-g), D g), FBF (1, Chibar, Coupling.SL, Psi), G_YUK_N (true,g,n,SD,M1)); ((Neutralino n, Sdown (M2,-g), D g), FBF (1, Chibar, SR, Psi), G_YUK_N (true,g,n,SD,M2)); ((D (-g), Sdown (M1,g), Neutralino n), FBF (1, Psibar, SR, Chi), G_YUK_N (false,g,n,SD,M1)); ((D (-g), Sdown (M2,g), Neutralino n), FBF (1, Psibar, Coupling.SL, Chi), G_YUK_N (false,g,n,SD,M2)) ] let yukawa_n_2 n m = [ ((Neutralino n, Slepton (m,-3), L 3), FBF (1, Chibar, SLR, Psi), G_YUK_N (true,3,n,SL,m)); ((L (-3), Slepton (m,3), Neutralino n), FBF (1, Psibar, SLR, Chi), G_YUK_N (false,3,n,SL,m)); ((Neutralino n, Sup (m,-3), U 3), FBF (1, Chibar, SLR, Psi), G_YUK_N (true,3,n,SU,m)); ((U (-3), Sup (m,3), Neutralino n), FBF (1, Psibar, SLR, Chi), G_YUK_N (false,3,n,SU,m)); ((Neutralino n, Sdown (m,-3), D 3), FBF (1, Chibar, SLR, Psi), G_YUK_N (true,3,n,SD,m)); ((D (-3), Sdown (m,3), Neutralino n), FBF (1, Psibar, SLR, Chi), G_YUK_N (false,3,n,SD,m)) ] let yukawa_n_3 n g = [ ((Neutralino n, Sneutrino (-g), N g), FBF (1, Chibar, Coupling.SL, Psi), G_YUK_N (true,g,n,SN,M1)); ((N (-g), Sneutrino g, Neutralino n), FBF (1, Psibar, SR, Chi), G_YUK_N (false,g,n,SN,M1)) ] let yukawa_n_4 g = [ ((U (-g), Sup (M1,g), Gluino), FBF ((-1), Psibar, SR, Chi), G_S_Sqrt); ((D (-g), Sdown (M1,g), Gluino), FBF ((-1), Psibar, SR, Chi), G_S_Sqrt); ((Gluino, Sup (M1,-g), U g), FBF ((-1), Chibar, Coupling.SL, Psi), G_S_Sqrt); ((Gluino, Sdown (M1,-g), D g), FBF ((-1), Chibar, Coupling.SL, Psi), G_S_Sqrt); ((U (-g), Sup (M2,g), Gluino), FBF (1, Psibar, Coupling.SL, Chi), G_S_Sqrt); ((D (-g), Sdown (M2,g), Gluino), FBF (1, Psibar, Coupling.SL, Chi), G_S_Sqrt); ((Gluino, Sup (M2,-g), U g), FBF (1, Chibar, SR, Psi), G_S_Sqrt); ((Gluino, Sdown (M2,-g), D g), FBF (1, Chibar, SR, Psi), G_S_Sqrt)] let yukawa_n_5 m = [ ((U (-3), Sup (m,3), Gluino), FBF (1, Psibar, SLR, Chi), G_YUK_G (false,3,SU,m)); ((D (-3), Sdown (m,3), Gluino), FBF (1, Psibar, SLR, Chi), G_YUK_G (false,3,SD,m)); ((Gluino, Sup (m,-3), U 3), FBF (1, Chibar, SLR, Psi), G_YUK_G (true,3,SU,m)); ((Gluino, Sdown (m,-3), D 3), FBF (1, Chibar, SLR, Psi), G_YUK_G (true,3,SD,m))] let yukawa_n = List.flatten (Product.list2 yukawa_n_1 [N1;N2;N3;N4] [1;2]) @ List.flatten (Product.list2 yukawa_n_2 [N1;N2;N3;N4] [M1;M2]) @ List.flatten (Product.list2 yukawa_n_3 [N1;N2;N3;N4] [1;2;3]) @ ThoList.flatmap yukawa_n_4 [1;2] @ ThoList.flatmap yukawa_n_5 [M1;M2] (*** REVISED: Compatible with CD+. ***) let yukawa_c_1 c g = let cc = conj_char c in [ ((L (-g), Sneutrino g, Chargino cc), BBB (1, Psibar, Coupling.SR, Psibar), G_YUK_C (true,g,c,SN,M1)); ((Chargino c, Sneutrino (-g), L g), PBP (1, Psi, Coupling.SL, Psi), G_YUK_C (false,g,c,SN,M1)) ] let yukawa_c_2 c = let cc = conj_char c in [ ((L (-3), Sneutrino 3, Chargino cc), BBB (1, Psibar, SLR, Psibar), G_YUK_C (true,3,c,SN,M1)); ((Chargino c, Sneutrino (-3), L 3), PBP (1, Psi, SLR, Psi), G_YUK_C (false,3,c,SN,M1)) ] let yukawa_c_3 c m g = let cc = conj_char c in [ ((N (-g), Slepton (m,g), Chargino c), FBF (1, Psibar, Coupling.SR, Psi), G_YUK_C (true,g,c,SL,m)); ((Chargino cc, Slepton (m,-g), N g), FBF (1, Psibar, Coupling.SL, Psi), G_YUK_C (false,g,c,SL,m)) ] let yukawa_c c = ThoList.flatmap (yukawa_c_1 c) [1;2] @ yukawa_c_2 c @ List.flatten (Product.list2 (yukawa_c_3 c) [M1] [1;2]) @ List.flatten (Product.list2 (yukawa_c_3 c) [M1;M2] [3]) (*** REVISED: Compatible with CD+. ***) let yukawa_cq' c (g,h) m = let cc = conj_char c in [ ((Chargino c, Sup (m,-g), D h), PBP (1, Psi, SLR, Psi), G_YUK_Q (false,g,h,c,SU,m)); ((D (-h), Sup (m,g), Chargino cc), BBB (1, Psibar, SLR, Psibar), G_YUK_Q (true,g,h,c,SU,m)); ((Chargino cc, Sdown (m,-h), U g), FBF (1, Psibar, SLR, Psi), G_YUK_Q (true,g,h,c,SD,m)); ((U (-g), Sdown (m,h), Chargino c), FBF (1, Psibar, SLR, Psi), G_YUK_Q (false,g,h,c,SD,m)) ] let yukawa_cq'' c (g,h) = let cc = conj_char c in [ ((Chargino c, Sup (M1,-g), D h), PBP (1, Psi, Coupling.SL, Psi), G_YUK_Q (false,g,h,c,SU,M1)); ((D (-h), Sup (M1,g), Chargino cc), BBB (1, Psibar, Coupling.SR, Psibar), G_YUK_Q (true,g,h,c,SU,M1)); ((Chargino cc, Sdown (M1,-h), U g), FBF (1, Psibar, Coupling.SL, Psi), G_YUK_Q (true,g,h,c,SD,M1)); ((U (-g), Sdown (M1,h), Chargino c), FBF (1, Psibar, Coupling.SR, Psi), G_YUK_Q (false,g,h,c,SD,M1)) ] let yukawa_cq c = if Flags.ckm_present then List.flatten (Product.list2 (yukawa_cq' c) [(1,3);(2,3);(3,3); (3,2);(3,1)] [M1;M2]) @ ThoList.flatmap (yukawa_cq'' c) [(1,1);(1,2);(2,1);(2,2)] else ThoList.flatmap (yukawa_cq' c (3,3)) [M1;M2] @ ThoList.flatmap (yukawa_cq'' c) [(1,1);(2,2)] (*** REVISED: Compatible with CD+. Remark: Singlet and octet gluon exchange. The coupling is divided by sqrt(2) to account for the correct normalization of the Lie algebra generators. ***) let col_currents g = [ ((D (-g), Gl, D g), FBF ((-1), Psibar, V, Psi), Gs); ((U (-g), Gl, U g), FBF ((-1), Psibar, V, Psi), Gs)] (*** REVISED: Compatible with CD+. Remark: Singlet and octet gluon exchange. The coupling is divided by sqrt(2) to account for the correct normalization of the Lie algebra generators. ***) let col_sfermion_currents g m = [ ((Gl, Sup (m,-g), Sup (m,g)), Vector_Scalar_Scalar (-1), Gs); ((Gl, Sdown (m,-g), Sdown (m,g)), Vector_Scalar_Scalar (-1), Gs)] (* The gravitino coupling is generically $1/(4 M_{Pl.})$ *) (*** Triple vertices containing graivitinos. ***) let triple_gravitino' g = [ ((Grino, Sneutrino (-g), N g), GBG (1, Gravbar, Coupling.SL, Psi), G_Grav_N); ((N (-g), Sneutrino g, Grino), GBG (1, Psibar, Coupling.SL, Grav), G_Grav_N)] let triple_gravitino'' g m = [ ((Grino, Slepton (m, -g), L g), GBG (1, Gravbar, SLR, Psi), G_Grav_L (g,m)); ((L (-g), Slepton (m, g), Grino), GBG (1, Psibar, SLR, Grav), G_Grav_Lc (g,m)); ((Grino, Sup (m, -g), U g), GBG (1, Gravbar, SLR, Psi), G_Grav_U (g,m)); ((U (-g), Sup (m, g), Grino), GBG (1, Psibar, SLR, Grav), G_Grav_Uc (g,m)); ((Grino, Sdown (m, -g), D g), GBG (1, Gravbar, SLR, Psi), G_Grav_D (g,m)); ((D (-g), Sdown (m, g), Grino), GBG (1, Psibar, SLR, Grav), G_Grav_Dc (g,m)) ] let higgs_ch_gravitino c = let cc = conj_char c in [ ((Grino, Hm, Chargino c), GBG (1, Gravbar, SLR, Psi), G_Gr_H_Ch c); ((Chargino cc, Hp, Grino), GBG (1, Psibar, SLR, Grav), G_Gr_H_Ch cc) ] let higgs_neu_gravitino n = [ ((Grino, H_Light, Neutralino n), GBG (1, Gravbar, SLR, Chi), G_Gr_H1_Neu n); ((Grino, H_Heavy, Neutralino n), GBG (1, Gravbar, SLR, Chi), G_Gr_H2_Neu n); ((Grino, A, Neutralino n), GBG (1, Gravbar, SLR, Chi), G_Gr_H3_Neu n) ] let gravitino_gaugino_3 = [ ((Grino, Gl, Gluino), GBG (1, Gravbar, V, Chi), G_Grav); ((Gluino, Gl, Grino), GBG (1, Chibar, V, Grav), G_Grav); ((Chargino C1c, Wp, Grino), GBG (1, Psibar, VLR, Grav), G_Gr_Ch C1); ((Chargino C2c, Wp, Grino), GBG (1, Psibar, VLR, Grav), G_Gr_Ch C2); ((Grino, Wm, Chargino C1), GBG (1, Gravbar, VLR, Psi), G_Gr_Ch C1c); ((Grino, Wm, Chargino C2), GBG (1, Gravbar, VLR, Psi), G_Gr_Ch C2c); ((Grino, Z, Neutralino N1), GBG (1, Gravbar, VLR, Chi), G_Gr_Z_Neu N1); ((Grino, Z, Neutralino N2), GBG (1, Gravbar, VLR, Chi), G_Gr_Z_Neu N2); ((Grino, Z, Neutralino N3), GBG (1, Gravbar, VLR, Chi), G_Gr_Z_Neu N3); ((Grino, Z, Neutralino N4), GBG (1, Gravbar, VLR, Chi), G_Gr_Z_Neu N4); ((Grino, Ga, Neutralino N1), GBG (1, Gravbar, VLR, Chi), G_Gr_A_Neu N1); ((Grino, Ga, Neutralino N2), GBG (1, Gravbar, VLR, Chi), G_Gr_A_Neu N2); ((Grino, Ga, Neutralino N3), GBG (1, Gravbar, VLR, Chi), G_Gr_A_Neu N3); ((Grino, Ga, Neutralino N4), GBG (1, Gravbar, VLR, Chi), G_Gr_A_Neu N4) ] let triple_gravitino = ThoList.flatmap triple_gravitino' [1;2;3] @ List.flatten (Product.list2 triple_gravitino'' [1;2;3] [M1; M2]) @ ThoList.flatmap higgs_ch_gravitino [C1; C2] @ ThoList.flatmap higgs_neu_gravitino [N1; N2; N3; N4] @ gravitino_gaugino_3 (*** REVISED: Compatible with CD+. ***) let triple_gauge = [ ((Ga, Wm, Wp), Gauge_Gauge_Gauge 1, I_Q_W); ((Z, Wm, Wp), Gauge_Gauge_Gauge 1, I_G_ZWW); ((Gl, Gl, Gl), Gauge_Gauge_Gauge 1, I_G_S)] (*** REVISED: Independent of the sign of CD. ***) let gauge4 = Vector4 [(2, C_13_42); (-1, C_12_34); (-1, C_14_23)] let gluon4 = Vector4 [(-1, C_13_42); (-1, C_12_34); (-1, C_14_23)] let minus_gauge4 = Vector4 [(-2, C_13_42); (1, C_12_34); (1, C_14_23)] let quartic_gauge = [ (Wm, Wp, Wm, Wp), gauge4, G_WWWW; (Wm, Z, Wp, Z), minus_gauge4, G_ZZWW; (Wm, Z, Wp, Ga), minus_gauge4, G_PZWW; (Wm, Ga, Wp, Ga), minus_gauge4, G_PPWW; (Gl, Gl, Gl, Gl), gauge4, G_SS] (* The [Scalar_Vector_Vector] couplings do not depend on the choice of the sign of the covariant derivative since they are quadratic in the gauge couplings. *) (*** REVISED: Compatible with CD+. ***) (*** Revision: 2005-03-10: first two vertices corrected. ***) let gauge_higgs = [ ((Wm, Hp, A), Vector_Scalar_Scalar 1, G_GH 1); ((Wp, Hm, A), Vector_Scalar_Scalar 1, G_GH 1); ((Z, H_Heavy, A), Vector_Scalar_Scalar 1, G_GH 3); ((Z, H_Light, A), Vector_Scalar_Scalar 1, G_GH 2); ((H_Heavy, Wp, Wm), Scalar_Vector_Vector 1, G_GH 5); ((H_Light, Wp, Wm), Scalar_Vector_Vector 1, G_GH 4); ((Wm, Hp, H_Heavy), Vector_Scalar_Scalar 1, G_GH 7); ((Wp, Hm, H_Heavy), Vector_Scalar_Scalar (-1), G_GH 7); ((Wm, Hp, H_Light), Vector_Scalar_Scalar 1, G_GH 6); ((Wp, Hm, H_Light), Vector_Scalar_Scalar (-1), G_GH 6); ((H_Heavy, Z, Z), Scalar_Vector_Vector 1, G_GH 9); ((H_Light, Z, Z), Scalar_Vector_Vector 1, G_GH 8); ((Z, Hp, Hm), Vector_Scalar_Scalar 1, G_GH 10); ((Ga, Hp, Hm), Vector_Scalar_Scalar 1, G_GH 11) ] @ (if Flags.higgs_triangle then [((H_Light, Gl, Gl), Dim5_Scalar_Gauge2 1, G_GLGLH); ((H_Heavy, Gl, Gl), Dim5_Scalar_Gauge2 1, G_GLGLHH); ((A, Gl, Gl), Dim5_Scalar_Gauge2_Skew 1, G_GLGLA); ((H_Light, Ga, Ga), Dim5_Scalar_Gauge2 1, G_PPH); ((H_Heavy, Ga, Ga), Dim5_Scalar_Gauge2 1, G_PPHH); ((A, Ga, Ga), Dim5_Scalar_Gauge2 1, G_PPA)] else []) (*** REVISED: Compatible with CD+ and GS+. ***) let gauge_higgs_gold = [ ((Wp, Phi0, Phim), Vector_Scalar_Scalar 1, G_GH 1); ((Wm, Phi0, Phip), Vector_Scalar_Scalar 1, G_GH 1); ((Z, H_Heavy, Phi0), Vector_Scalar_Scalar 1, G_GH 2); ((Z, H_Light, Phi0), Vector_Scalar_Scalar (-1), G_GH 3); ((Wp, H_Heavy, Phim), Vector_Scalar_Scalar 1, G_GH 6); ((Wm, H_Heavy, Phip), Vector_Scalar_Scalar (-1), G_GH 6); ((Wp, H_Light, Phim), Vector_Scalar_Scalar (-1), G_GH 7); ((Wm, H_Light, Phip), Vector_Scalar_Scalar 1, G_GH 7); ((Phim, Wp, Ga), Scalar_Vector_Vector 1, G_GHGo 1); ((Phip, Wm, Ga), Scalar_Vector_Vector 1, G_GHGo 1); ((Phim, Wp, Z), Scalar_Vector_Vector 1, G_GHGo 2); ((Phip, Wm, Z), Scalar_Vector_Vector 1, G_GHGo 2); ((Z, Phip, Phim), Vector_Scalar_Scalar 1, G_GH 10); ((Ga, Phip, Phim), Vector_Scalar_Scalar 1, G_GH 11) ] let gauge_higgs4 = [ ((A, A, Z, Z), Scalar2_Vector2 1, G_GH4 1); ((H_Heavy, H_Heavy, Z, Z), Scalar2_Vector2 1, G_GH4 3); ((H_Light, H_Light, Z, Z), Scalar2_Vector2 1, G_GH4 2); ((Hp, Hm, Z, Z), Scalar2_Vector2 1, G_GH4 4); ((Hp, Hm, Ga, Ga), Scalar2_Vector2 1, G_GH4 5); ((Hp, Hm, Ga, Z), Scalar2_Vector2 1, G_GH4 6); ((Hp, H_Heavy, Wm, Z), Scalar2_Vector2 1, G_GH4 8); ((Hm, H_Heavy, Wp, Z), Scalar2_Vector2 1, G_GH4 8); ((Hp, H_Light, Wm, Z), Scalar2_Vector2 1, G_GH4 7); ((Hm, H_Light, Wp, Z), Scalar2_Vector2 1, G_GH4 7); ((Hp, H_Heavy, Wm, Ga), Scalar2_Vector2 1, G_GH4 10); ((Hm, H_Heavy, Wp, Ga), Scalar2_Vector2 1, G_GH4 10); ((Hp, H_Light, Wm, Ga), Scalar2_Vector2 1, G_GH4 9); ((Hm, H_Light, Wp, Ga), Scalar2_Vector2 1, G_GH4 9); ((A, A, Wp, Wm), Scalar2_Vector2 1, G_GH4 11); ((H_Heavy, H_Heavy, Wp, Wm), Scalar2_Vector2 1, G_GH4 13); ((H_Light, H_Light, Wp, Wm), Scalar2_Vector2 1, G_GH4 12); ((Hp, Hm, Wp, Wm), Scalar2_Vector2 1, G_GH4 14); ((Hp, A, Wm, Z), Scalar2_Vector2 1, G_GH4 15); ((Hm, A, Wp, Z), Scalar2_Vector2 (-1), G_GH4 15); ((Hp, A, Wm, Ga), Scalar2_Vector2 1, G_GH4 16); ((Hm, A, Wp, Ga), Scalar2_Vector2 (-1), G_GH4 16) ] let gauge_higgs_gold4 = [ ((Z, Z, Phi0, Phi0), Scalar2_Vector2 1, G_GHGo4 1); ((Z, Z, Phip, Phim), Scalar2_Vector2 1, G_GHGo4 2); ((Ga, Ga, Phip, Phim), Scalar2_Vector2 1, G_GHGo4 3); ((Z, Ga, Phip, Phim), Scalar2_Vector2 1, G_GHGo4 4); ((Wp, Wm, Phip, Phim), Scalar2_Vector2 1, G_GHGo4 5); ((Wp, Wm, Phi0, Phi0), Scalar2_Vector2 1, G_GHGo4 5); ((Wp, Z, Phim, Phi0), Scalar2_Vector2 1, G_GHGo4 6); ((Wm, Z, Phip, Phi0), Scalar2_Vector2 (-1), G_GHGo4 6); ((Wp, Ga, Phim, Phi0), Scalar2_Vector2 1, G_GHGo4 7); ((Wm, Ga, Phip, Phi0), Scalar2_Vector2 (-1), G_GHGo4 7); ((Wp, Z, Phim, H_Heavy), Scalar2_Vector2 1, G_GHGo4 9); ((Wm, Z, Phip, H_Heavy), Scalar2_Vector2 1, G_GHGo4 9); ((Wp, Ga, Phim, H_Heavy), Scalar2_Vector2 1, G_GHGo4 11); ((Wm, Ga, Phip, H_Heavy), Scalar2_Vector2 1, G_GHGo4 11); ((Wp, Z, Phim, H_Light), Scalar2_Vector2 1, G_GHGo4 8); ((Wm, Z, Phip, H_Light), Scalar2_Vector2 1, G_GHGo4 8); ((Wp, Ga, Phim, H_Light), Scalar2_Vector2 1, G_GHGo4 10); ((Wm, Ga, Phip, H_Light), Scalar2_Vector2 1, G_GHGo4 10) ] let gauge_sfermion4' g m1 m2 = [ ((Wp, Wm, Slepton (m1,g), Slepton (m2,-g)), Scalar2_Vector2 1, G_WWSFSF (SL,g,m1,m2)); ((Z, Ga, Slepton (m1,g), Slepton (m2,-g)), Scalar2_Vector2 1, G_ZPSFSF (SL,g,m1,m2)); ((Z, Z, Slepton (m1,g), Slepton (m2,-g)), Scalar2_Vector2 1, G_ZZSFSF (SL,g,m1,m2)); ((Wp, Wm, Sup (m1,g), Sup (m2,-g)), Scalar2_Vector2 1, G_WWSFSF (SU,g,m1,m2)); ((Wp, Wm, Sdown (m1,g), Sdown (m2,-g)), Scalar2_Vector2 1, G_WWSFSF (SD,g,m1,m2)); ((Z, Z, Sup (m1,g), Sup (m2,-g)), Scalar2_Vector2 1, G_ZZSFSF (SU,g,m1,m2)); ((Z, Z, Sdown (m1,g), Sdown (m2,-g)), Scalar2_Vector2 1, G_ZZSFSF (SD,g,m1,m2)); ((Z, Ga, Sup (m1,g), Sup (m2,-g)), Scalar2_Vector2 1, G_ZPSFSF (SU,g,m1,m2)); ((Z, Ga, Sdown (m1,g), Sdown (m2,-g)), Scalar2_Vector2 1, G_ZPSFSF (SD,g,m1,m2)) ] let gauge_sfermion4'' g m = [ ((Wp, Ga, Slepton (m,g), Sneutrino (-g)), Scalar2_Vector2 1, G_WPSLSN (false,g,m)); ((Wm, Ga, Slepton (m,-g), Sneutrino g), Scalar2_Vector2 1, G_WPSLSN (true,g,m)); ((Wp, Z, Slepton (m,g), Sneutrino (-g)), Scalar2_Vector2 1, G_WZSLSN (false,g,m)); ((Wm, Z, Slepton (m,-g), Sneutrino g), Scalar2_Vector2 1, G_WZSLSN (true,g,m)); ((Ga, Ga, Slepton (m,g), Slepton (m,-g)), Scalar2_Vector2 1, G_PPSFSF SL); ((Ga, Ga, Sup (m,g), Sup (m,-g)), Scalar2_Vector2 1, G_PPSFSF SU); ((Ga, Ga, Sdown (m,g), Sdown (m,-g)), Scalar2_Vector2 1, G_PPSFSF SD)] let gauge_sfermion4 g = List.flatten (Product.list2 (gauge_sfermion4' g) [M1;M2] [M1;M2]) @ ThoList.flatmap (gauge_sfermion4'' g) [M1;M2] @ [ ((Wp, Wm, Sneutrino g, Sneutrino (-g)), Scalar2_Vector2 1, G_WWSFSF (SN,g,M1,M1)); ((Z, Z, Sneutrino g, Sneutrino (-g)), Scalar2_Vector2 1, G_ZZSFSF (SN,g,M1,M1)) ] let gauge_squark4'' g h m1 m2 = [ ((Wp, Ga, Sup (m1,-g), Sdown (m2,h)), Scalar2_Vector2 1, G_WPSUSD (false,m1,m2,g,h)); ((Wm, Ga, Sup (m1,g), Sdown (m2,-h)), Scalar2_Vector2 1, G_WPSUSD (true,m1,m2,g,h)); ((Wp, Z, Sup (m1,-g), Sdown (m2,h)), Scalar2_Vector2 1, G_WZSUSD (false,m1,m2,g,h)); ((Wm, Z, Sup (m1,g), Sdown (m2,-h)), Scalar2_Vector2 1, G_WZSUSD (true,m1,m2,g,h)) ] let gauge_squark4' g h = List.flatten (Product.list2 (gauge_squark4'' g h) [M1;M2] [M1;M2]) let gauge_squark4 = if Flags.ckm_present then List.flatten (Product.list2 gauge_squark4' [1;2;3] [1;2;3]) else ThoList.flatmap (fun g -> gauge_squark4' g g) [1;2;3] let gluon_w_squark'' g h m1 m2 = [ ((Gl, Wp, Sup (m1,-g), Sdown (m2,h)), Scalar2_Vector2 1, G_GlWSUSD (false,m1,m2,g,h)); ((Gl, Wm, Sup (m1,g), Sdown (m2,-h)), Scalar2_Vector2 1, G_GlWSUSD (true,m1,m2,g,h)) ] let gluon_w_squark' g h = List.flatten (Product.list2 (gluon_w_squark'' g h) [M1;M2] [M1;M2]) let gluon_w_squark = if Flags.ckm_present then List.flatten (Product.list2 gluon_w_squark' [1;2;3] [1;2;3]) else ThoList.flatmap (fun g -> gluon_w_squark' g g) [1;2;3] let gluon_gauge_squark' g m1 m2 = [ ((Gl, Z, Sup (m1,g), Sup (m2,-g)), Scalar2_Vector2 2, G_GlZSFSF (SU,g,m1,m2)); ((Gl, Z, Sdown (m1,g), Sdown (m2,-g)), Scalar2_Vector2 2, G_GlZSFSF (SD,g,m1,m2)) ] let gluon_gauge_squark'' g m = [ ((Gl, Ga, Sup (m,g), Sup (m,-g)), Scalar2_Vector2 2, G_GlPSQSQ); ((Gl, Ga, Sdown (m,g), Sdown (m,-g)), Scalar2_Vector2 (-1), G_GlPSQSQ) ] let gluon_gauge_squark g = List.flatten (Product.list2 (gluon_gauge_squark' g) [M1;M2] [M1;M2]) @ ThoList.flatmap (gluon_gauge_squark'' g) [M1;M2] let gluon2_squark2 g m = [ ((Gl, Gl, Sup (m,g), Sup (m,-g)), Scalar2_Vector2 1, G_GlGlSQSQ); ((Gl, Gl, Sdown (m,g), Sdown (m,-g)), Scalar2_Vector2 1, G_GlGlSQSQ)] (*** REVISED: Independent of the sign of CD. ***) let higgs = [ ((Hp, Hm, H_Heavy), Scalar_Scalar_Scalar 1, G_H3 1); ((Hp, Hm, H_Light), Scalar_Scalar_Scalar 1, G_H3 2); ((H_Heavy, H_Heavy, H_Light), Scalar_Scalar_Scalar 1, G_H3 3); ((H_Heavy, H_Heavy, H_Heavy), Scalar_Scalar_Scalar 1, G_H3 4); ((H_Light, H_Light, H_Light), Scalar_Scalar_Scalar 1, G_H3 5); ((H_Heavy, H_Light, H_Light), Scalar_Scalar_Scalar 1, G_H3 6); ((H_Heavy, A, A), Scalar_Scalar_Scalar 1, G_H3 7); ((H_Light, A, A), Scalar_Scalar_Scalar 1, G_H3 8) ] (*** REVISED: Compatible with GS+, independent of the sign of CD. ***) let higgs_gold = [ ((H_Heavy, A, Phi0), Scalar_Scalar_Scalar 1, G_HGo3 1); ((H_Light, A, Phi0), Scalar_Scalar_Scalar 1, G_HGo3 2); ((H_Heavy, Hp, Phim), Scalar_Scalar_Scalar 1, G_HGo3 3); ((H_Heavy, Hm, Phip), Scalar_Scalar_Scalar 1, G_HGo3 3); ((H_Light, Hp, Phim), Scalar_Scalar_Scalar 1, G_HGo3 4); ((H_Light, Hm, Phip), Scalar_Scalar_Scalar 1, G_HGo3 4); ((A, Hp, Phim), Scalar_Scalar_Scalar (-1), G_HGo3 5); ((A, Hm, Phip), Scalar_Scalar_Scalar 1, G_HGo3 5); ((H_Heavy, Phi0, Phi0), Scalar_Scalar_Scalar (-1), G_H3 7); ((H_Heavy, Phip, Phim), Scalar_Scalar_Scalar (-1), G_H3 7); ((H_Light, Phi0, Phi0), Scalar_Scalar_Scalar (-1), G_H3 8); ((H_Light, Phip, Phim), Scalar_Scalar_Scalar (-1), G_H3 8) ] (* Here follow purely scalar quartic vertices which are only available for the no-Whizard colored version. *) (*** REVISED: Independent of the sign of CD. ***) let higgs4 = [ ((Hp, Hm, Hp, Hm), Scalar4 1, G_H4 1); ((Hp, Hm, H_Heavy, H_Heavy), Scalar4 1, G_H4 2); ((Hp, Hm, H_Light, H_Light), Scalar4 1, G_H4 3); ((Hp, Hm, H_Heavy, H_Light), Scalar4 1, G_H4 4); ((Hp, Hm, A, A), Scalar4 1, G_H4 5); ((H_Heavy, H_Heavy, H_Heavy, H_Heavy), Scalar4 1, G_H4 6); ((H_Light, H_Light, H_Light, H_Light), Scalar4 1, G_H4 6); ((H_Heavy, H_Heavy, H_Light, H_Light), Scalar4 1, G_H4 7); ((H_Heavy, H_Light, H_Light, H_Light), Scalar4 1, G_H4 8); ((H_Heavy, H_Heavy, H_Heavy, H_Light), Scalar4 (-1), G_H4 8); ((H_Heavy, H_Heavy, A, A), Scalar4 1, G_H4 9); ((H_Light, H_Light, A, A), Scalar4 (-1), G_H4 9); ((H_Heavy, H_Light, A, A), Scalar4 1, G_H4 10); ((A, A, A, A), Scalar4 1, G_H4 11) ] (*** REVISED: Compatible with GS+, independent of the sign of CD. ***) let higgs_gold4 = [ ((H_Heavy, H_Heavy, A, Phi0), Scalar4 1, G_HGo4 1); ((H_Heavy, H_Light, A, Phi0), Scalar4 1, G_HGo4 2); ((H_Light, H_Light, A, Phi0), Scalar4 (-1), G_HGo4 1); ((A, A, A, Phi0), Scalar4 3, G_HGo4 3); ((Hp, Hm, A, Phi0), Scalar4 1, G_HGo4 3); ((H_Heavy, H_Heavy, Hp, Phim), Scalar4 1, G_HGo4 4); ((H_Heavy, H_Heavy, Hm, Phip), Scalar4 1, G_HGo4 4); ((H_Heavy, H_Light, Hp, Phim), Scalar4 1, G_HGo4 5); ((H_Heavy, H_Light, Hm, Phip), Scalar4 1, G_HGo4 5); ((H_Light, H_Light, Hp, Phim), Scalar4 (-1), G_HGo4 4); ((H_Light, H_Light, Hm, Phip), Scalar4 (-1), G_HGo4 4); ((A, A, Hp, Phim), Scalar4 1, G_HGo4 6); ((A, A, Hm, Phip), Scalar4 1, G_HGo4 6); ((H_Heavy, A, Hp, Phim), Scalar4 1, G_HGo4 7); ((H_Heavy, A, Hm, Phip), Scalar4 (-1), G_HGo4 7); ((H_Light, A, Hp, Phim), Scalar4 1, G_HGo4 8); ((H_Light, A, Hm, Phip), Scalar4 (-1), G_HGo4 8); ((Hp, Hm, Hp, Phim), Scalar4 2, G_HGo4 6); ((Hp, Hm, Hm, Phip), Scalar4 2, G_HGo4 6); ((H_Heavy, H_Heavy, Phi0, Phi0), Scalar4 (-1), G_H4 9); ((H_Heavy, H_Light, Phi0, Phi0), Scalar4 (-1), G_H4 10); ((H_Light, H_Light, Phi0, Phi0), Scalar4 1, G_H4 9); ((A, A, Phi0, Phi0), Scalar4 1, G_HGo4 9); ((Hp, Hm, Phi0, Phi0), Scalar4 1, G_HGo4 10); ((H_Heavy, Hp, Phim, Phi0), Scalar4 1, G_HGo4 8); ((H_Heavy, Hm, Phip, Phi0), Scalar4 (-1), G_HGo4 8); ((H_Light, Hp, Phim, Phi0), Scalar4 (-1), G_HGo4 7); ((H_Light, Hm, Phip, Phi0), Scalar4 1, G_HGo4 7); ((A, Hp, Phim, Phi0), Scalar4 1, G_HGo4 11); ((A, Hm, Phip, Phi0), Scalar4 1, G_HGo4 11); ((H_Heavy, H_Heavy, Phip, Phim), Scalar4 1, G_HGo4 12); ((H_Heavy, H_Light, Phip, Phim), Scalar4 1, G_HGo4 13); ((H_Light, H_Light, Phip, Phim), Scalar4 1, G_HGo4 14); ((A, A, Phip, Phim), Scalar4 1, G_HGo4 15); ((Hp, Hm, Phip, Phim), Scalar4 1, G_HGo4 16); ((Hp, Hp, Phim, Phim), Scalar4 1, G_HGo4 17); ((Hm, Hm, Phip, Phip), Scalar4 1, G_HGo4 17); ((Hp, Phim, Phi0, Phi0), Scalar4 (-1), G_HGo4 6); ((Hm, Phip, Phi0, Phi0), Scalar4 (-1), G_HGo4 6); ((A, Phi0, Phi0, Phi0), Scalar4 (-3), G_HGo4 6); ((A, Phi0, Phip, Phim), Scalar4 (-1), G_HGo4 6); ((Hp, Phim, Phip, Phim), Scalar4 (-2), G_HGo4 6); ((Hm, Phip, Phip, Phim), Scalar4 (-2), G_HGo4 6) ] (*** REVISED: Independent of the sign of CD and GS. ***) let goldstone4 = [ ((Phi0, Phi0, Phi0, Phi0), Scalar4 1, G_GG4 1); ((Phip, Phim, Phi0, Phi0), Scalar4 1, G_GG4 2); ((Phip, Phim, Phip, Phim), Scalar4 1, G_GG4 3) ] (* The vertices of the type Higgs - Sfermion - Sfermion are independent of the choice of the CD sign since they are quadratic in the gauge coupling. *) (*** REVISED: Independent of the sign of CD. ***) let higgs_sneutrino' g = [ ((H_Heavy, Sneutrino g, Sneutrino (-g)), Scalar_Scalar_Scalar 1, G_H2SFSF (SN,g,M1,M1)); ((H_Light, Sneutrino g, Sneutrino (-g)), Scalar_Scalar_Scalar 1, G_H1SFSF (SN,g,M1,M1)); ((Hp, Sneutrino (-g), Slepton (M1,g)), Scalar_Scalar_Scalar 1, G_HSNSL (false,g,M1)); ((Hm, Sneutrino g, Slepton (M1,-g)), Scalar_Scalar_Scalar 1, G_HSNSL (true,g,M1)) ] let higgs_sneutrino'' = [ ((Hp, Sneutrino (-3), Slepton (M2,3)), Scalar_Scalar_Scalar 1, G_HSNSL (false,3,M2)); ((Hm, Sneutrino 3, Slepton (M2,-3)), Scalar_Scalar_Scalar 1, G_HSNSL (false,3,M2)) ] let higgs_sneutrino = ThoList.flatmap higgs_sneutrino' [1;2;3] @ higgs_sneutrino'' (* Under the assumption that there is no mixing between the left- and right-handed sfermions for the first two generations there is only a coupling of the form Higgs - sfermion1 - sfermion2 for the third generation. All the others are suppressed by $m_f/M_W$. *) (*** REVISED: Independent of the sign of CD. ***) let higgs_sfermion' g m1 m2 = [ ((H_Heavy, Slepton (m1,g), Slepton (m2,-g)), Scalar_Scalar_Scalar 1, G_H2SFSF (SL,g,m1,m2)); ((H_Light, Slepton (m1,g), Slepton (m2,-g)), Scalar_Scalar_Scalar 1, G_H1SFSF (SL,g,m1,m2)); ((H_Heavy, Sup (m1,g), Sup (m2,-g)), Scalar_Scalar_Scalar 1, G_H2SFSF (SU,g,m1,m2)); ((H_Heavy, Sdown (m1,g), Sdown (m2,-g)), Scalar_Scalar_Scalar 1, G_H2SFSF (SD,g,m1,m2)); ((H_Light, Sup (m1,g), Sup (m2,-g)), Scalar_Scalar_Scalar 1, G_H1SFSF (SU,g,m1,m2)); ((H_Light, Sdown (m1,g), Sdown (m2,-g)), Scalar_Scalar_Scalar 1, G_H1SFSF (SD,g,m1,m2)) ] let higgs_sfermion'' m1 m2 = [ ((A, Slepton (m1,3), Slepton (m2,-3)), Scalar_Scalar_Scalar 1, G_ASFSF (SL,3,m1,m2)); ((A, Sup (m1,3), Sup (m2,-3)), Scalar_Scalar_Scalar 1, G_ASFSF (SU,3,m1,m2)); ((A, Sdown (m1,3), Sdown (m2,-3)), Scalar_Scalar_Scalar 1, G_ASFSF (SD,3,m1,m2)) ] let higgs_sfermion = List.flatten (Product.list2 (higgs_sfermion' 3) [M1;M2] [M1;M2]) @ (higgs_sfermion' 1 M1 M1) @ (higgs_sfermion' 1 M2 M2) @ (higgs_sfermion' 2 M1 M1) @ (higgs_sfermion' 2 M2 M2) @ List.flatten (Product.list2 higgs_sfermion'' [M1;M2] [M1;M2]) (*i let higgs_sfermion g = List.flatten (Product.list2 (higgs_sfermion' g) [M1;M2] [M1;M2]) i*) (*** REVISED: Independent of the sign of CD, compatible with GS+. ***) let goldstone_sfermion' g m1 m2 = [ ((Phi0, Slepton (m1,g), Slepton (m2,-g)), Scalar_Scalar_Scalar 1, G_GoSFSF (SL,g,m1,m2)); ((Phi0, Sup (m1,g), Sup (m2,-g)), Scalar_Scalar_Scalar 1, G_GoSFSF (SU,g,m1,m2)); ((Phi0, Sdown (m1,g), Sdown (m2,-g)), Scalar_Scalar_Scalar 1, G_GoSFSF (SD,g,m1,m2))] let goldstone_sfermion'' g = [ ((Phip, Sneutrino (-g), Slepton (M1,g)), Scalar_Scalar_Scalar 1, G_GoSNSL (false,g,M1)); ((Phim, Sneutrino g, Slepton (M1,-g)), Scalar_Scalar_Scalar 1, G_GoSNSL (true,g,M1)) ] let goldstone_sfermion''' g = [ ((Phip, Sneutrino (-g), Slepton (M2,g)), Scalar_Scalar_Scalar 1, G_GoSNSL (false,g,M2)); ((Phim, Sneutrino g, Slepton (M2,-g)), Scalar_Scalar_Scalar 1, G_GoSNSL (true,g,M2))] let goldstone_sfermion = List.flatten (Product.list2 (goldstone_sfermion' 3) [M1;M2] [M1;M2]) @ ThoList.flatmap goldstone_sfermion'' [1;2;3] @ goldstone_sfermion''' 3 (*** REVISED: Independent of the sign of CD. ***) let higgs_squark' g h m1 m2 = [ ((Hp, Sup (m1,-g), Sdown (m2,h)), Scalar_Scalar_Scalar 1, G_HSUSD (false,m1,m2,g,h)); ((Hm, Sup (m1,g), Sdown (m2,-h)), Scalar_Scalar_Scalar 1, G_HSUSD (true,m1,m2,g,h)) ] let higgs_squark_a g h = higgs_squark' g h M1 M1 let higgs_squark_b (g,h) = List.flatten (Product.list2 (higgs_squark' g h) [M1;M2] [M1;M2]) let higgs_squark = if Flags.ckm_present then List.flatten (Product.list2 higgs_squark_a [1;2] [1;2]) @ ThoList.flatmap higgs_squark_b [(1,3);(2,3);(3,3);(3,1);(3,2)] else higgs_squark_a 1 1 @ higgs_squark_a 2 2 @ higgs_squark_b (3,3) (*** REVISED: Independent of the sign of CD, compatible with GS+. ***) let goldstone_squark' g h m1 m2 = [ ((Phip, Sup (m1,-g), Sdown (m2,h)), Scalar_Scalar_Scalar 1, G_GSUSD (false,m1,m2,g,h)); ((Phim, Sup (m1,g), Sdown (m2,-h)), Scalar_Scalar_Scalar 1, G_GSUSD (true,m1,m2,g,h)) ] let goldstone_squark_a g h = goldstone_squark' g h M1 M1 let goldstone_squark_b (g,h) = List.flatten (Product.list2 (goldstone_squark' g h) [M1;M2] [M1;M2]) let goldstone_squark = List.flatten (Product.list2 goldstone_squark_a [1;2] [1;2]) @ ThoList.flatmap goldstone_squark_b [(1,3);(2,3);(3,3);(3,1);(3,2)] (* BAUSTELLE: For the quartic scalar coupligs we does not allow [whiz_col]. *) let higgs_sneutrino4' g m = [ ((Hp, H_Heavy, Slepton (m,g), Sneutrino (-g)), Scalar4 1, G_HH2SLSN (false,m,g)); ((Hm, H_Heavy, Slepton (m,-g), Sneutrino g), Scalar4 1, G_HH2SLSN (true,m,g)); ((Hp, H_Light, Slepton (m,g), Sneutrino (-g)), Scalar4 1, G_HH1SLSN (false,m,g)); ((Hm, H_Light, Slepton (m,-g), Sneutrino g), Scalar4 1, G_HH1SLSN (true,m,g)); ((Hp, A, Slepton (m,g), Sneutrino (-g)), Scalar4 1, G_HASLSN (false,m,g)); ((Hm, A, Slepton (m,-g), Sneutrino g), Scalar4 1, G_HASLSN (true,m,g)) ] let higgs_sneutrino4 g = ThoList.flatmap (higgs_sneutrino4' g) [M1;M2] @ [ ((H_Heavy, H_Heavy, Sneutrino g, Sneutrino (-g)), Scalar4 1, G_H2H2SFSF (SN,M1,M1,g)); ((H_Heavy, H_Light, Sneutrino g, Sneutrino (-g)), Scalar4 1, G_H1H2SFSF (SN,M1,M1,g)); ((H_Light, H_Light, Sneutrino g, Sneutrino (-g)), Scalar4 1, G_H1H1SFSF (SN,M1,M1,g)); ((Hp, Hm, Sneutrino g, Sneutrino (-g)), Scalar4 1, G_HHSFSF (SN,M1,M1,g)) ] let higgs_sfermion4' g m1 m2 = [ ((H_Heavy, H_Heavy, Slepton (m1,g), Slepton (m2,-g)), Scalar4 1, G_H2H2SFSF (SL,m1,m2,g)); ((H_Heavy, H_Light, Slepton (m1,g), Slepton (m2,-g)), Scalar4 1, G_H1H2SFSF (SL,m1,m2,g)); ((H_Light, H_Light, Slepton (m1,g), Slepton (m2,-g)), Scalar4 1, G_H1H1SFSF (SL,m1,m2,g)); ((A, A, Slepton (m1,g), Slepton (m2,-g)), Scalar4 1, G_AASFSF (SL,m1,m2,g)); ((Hp, Hm, Slepton (m1,g), Slepton (m2,-g)), Scalar4 1, G_HHSFSF (SL,m1,m2,g)); ((H_Heavy, H_Heavy, Sup (m1,g), Sup (m2,-g)), Scalar4 1, G_H2H2SFSF (SU,m1,m2,g)); ((H_Heavy, H_Heavy, Sdown (m1,g), Sdown (m2,-g)), Scalar4 1, G_H2H2SFSF (SD,m1,m2,g)); ((H_Light, H_Light, Sup (m1,g), Sup (m2,-g)), Scalar4 1, G_H1H1SFSF (SU,m1,m2,g)); ((H_Light, H_Light, Sdown (m1,g), Sdown (m2,-g)), Scalar4 1, G_H1H1SFSF (SD,m1,m2,g)); ((H_Light, H_Heavy, Sup (m1,g), Sup (m2,-g)), Scalar4 1, G_H1H2SFSF (SU,m1,m2,g)); ((H_Light, H_Heavy, Sdown (m1,g), Sdown (m2,-g)), Scalar4 1, G_H1H2SFSF (SD,m1,m2,g)); ((Hp, Hm, Sup (m1,g), Sup (m2,-g)), Scalar4 1, G_HHSFSF (SU,m1,m2,g)); ((Hp, Hm, Sdown (m1,g), Sdown (m2,-g)), Scalar4 1, G_HHSFSF (SD,m1,m2,g)); ((A, A, Sup (m1,g), Sup (m2,-g)), Scalar4 1, G_AASFSF (SU,m1,m2,g)); ((A, A, Sdown (m1,g), Sdown (m2,-g)), Scalar4 1, G_AASFSF (SD,m1,m2,g)) ] let higgs_sfermion4 g = List.flatten (Product.list2 (higgs_sfermion4' g) [M1;M2] [M1;M2]) let higgs_squark4' g h m1 m2 = [ ((Hp, H_Light, Sup (m1,-g), Sdown (m2,h)), Scalar4 1, G_HH1SUSD (false,m1,m2,g,h)); ((Hm, H_Light, Sup (m1,g), Sdown (m2,-h)), Scalar4 1, G_HH1SUSD (true,m1,m2,g,h)); ((Hp, H_Heavy, Sup (m1,-g), Sdown (m2,h)), Scalar4 1, G_HH2SUSD (false,m1,m2,g,h)); ((Hm, H_Heavy, Sup (m1,g), Sdown (m2,-h)), Scalar4 1, G_HH2SUSD (true,m1,m2,g,h)); ((Hp, A, Sup (m1,-g), Sdown (m2,h)), Scalar4 1, G_HASUSD (false,m1,m2,g,h)); ((Hm, A, Sup (m1,g), Sdown (m2,-h)), Scalar4 1, G_HASUSD (true,m1,m2,g,h)) ] let higgs_squark4 g h = List.flatten (Product.list2 (higgs_squark4' g h) [M1;M2] [M1;M2]) let higgs_gold_sneutrino' g m = [ ((Hp, Phi0, Sneutrino (-g), Slepton (m,g)), Scalar4 1, G_HGSNSL (false,m,g)); ((Hm, Phi0, Sneutrino g, Slepton (m,-g)), Scalar4 1, G_HGSNSL (true,m,g)); ((H_Heavy, Phip, Sneutrino (-g), Slepton (m,g)), Scalar4 1, G_H2GSNSL (false,m,g)); ((H_Heavy, Phim, Sneutrino g, Slepton (m,-g)), Scalar4 1, G_H2GSNSL (true,m,g)); ((H_Light, Phip, Sneutrino (-g), Slepton (m,g)), Scalar4 1, G_H1GSNSL (false,m,g)); ((H_Light, Phim, Sneutrino g, Slepton (m,-g)), Scalar4 1, G_H1GSNSL (true,m,g)); ((A, Phip, Sneutrino (-g), Slepton (m,g)), Scalar4 1, G_AGSNSL (false,m,g)); ((A, Phim, Sneutrino g, Slepton (m,-g)), Scalar4 1, G_AGSNSL (true,m,g)); ((Phi0, Phip, Sneutrino (-g), Slepton (m,g)), Scalar4 1, G_GGSNSL (false,m,g)); ((Phi0, Phim, Sneutrino g, Slepton (m,-g)), Scalar4 1, G_GGSNSL (true,m,g))] let higgs_gold_sneutrino g = ThoList.flatmap (higgs_gold_sneutrino' g) [M1;M2] @ [ ((A, Phi0, Sneutrino g, Sneutrino (-g)), Scalar4 1, G_AG0SFSF (SN,M1,M1,g)); ((Hp, Phim, Sneutrino g, Sneutrino (-g)), Scalar4 1, G_HGSFSF (SN,M1,M1,g)); ((Hm, Phip, Sneutrino g, Sneutrino (-g)), Scalar4 1, G_HGSFSF (SN,M1,M1,g)); ((Phip, Phim, Sneutrino g, Sneutrino (-g)), Scalar4 1, G_GGSFSF (SN,M1,M1,g)); ((Phi0, Phi0, Sneutrino g, Sneutrino (-g)), Scalar4 1, G_G0G0SFSF (SN,M1,M1,g)) ] let higgs_gold_sfermion' g m1 m2 = [ ((A, Phi0, Slepton (m1,g), Slepton (m2,-g)), Scalar4 1, G_AG0SFSF (SL,m1,m2,g)); ((Hp, Phim, Slepton (m1,g), Slepton (m2,-g)), Scalar4 1, G_HGSFSF (SL,m1,m2,g)); ((Hm, Phip, Slepton (m1,g), Slepton (m2,-g)), Scalar4 1, G_HGSFSF (SL,m1,m2,g)); ((Phip, Phim, Slepton (m1,g), Slepton (m2,-g)), Scalar4 1, G_GGSFSF (SL,m1,m2,g)); ((Phi0, Phi0, Slepton (m1,g), Slepton (m2,-g)), Scalar4 1, G_G0G0SFSF (SL,m1,m2,g)); ((A, Phi0, Sup (m1,g), Sup (m2,-g)), Scalar4 1, G_AG0SFSF (SU,m1,m2,g)); ((A, Phi0, Sdown (m1,g), Sdown (m2,-g)), Scalar4 1, G_AG0SFSF (SD,m1,m2,g)); ((Hp, Phim, Sup (m1,g), Sup (m2,-g)), Scalar4 1, G_HGSFSF (SU,m1,m2,g)); ((Hm, Phip, Sup (m1,g), Sup (m2,-g)), Scalar4 1, G_HGSFSF (SU,m1,m2,g)); ((Hp, Phim, Sdown (m1,g), Sdown (m2,-g)), Scalar4 1, G_HGSFSF (SD,m1,m2,g)); ((Hm, Phip, Sdown (m1,g), Sdown (m2,-g)), Scalar4 1, G_HGSFSF (SD,m1,m2,g)); ((Phip, Phim, Sup (m1,g), Sup (m2,-g)), Scalar4 1, G_GGSFSF (SU,m1,m2,g)); ((Phip, Phim, Sdown (m1,g), Sdown (m2,-g)), Scalar4 1, G_GGSFSF (SD,m1,m2,g)); ((Phi0, Phi0, Sup (m1,g), Sup (m2,-g)), Scalar4 1, G_G0G0SFSF (SU,m1,m2,g)); ((Phi0, Phi0, Sdown (m1,g), Sdown (m2,-g)), Scalar4 1, G_G0G0SFSF (SD,m1,m2,g)) ] let higgs_gold_sfermion g = List.flatten (Product.list2 (higgs_gold_sfermion' g) [M1;M2] [M1;M2]) let higgs_gold_squark' g h m1 m2 = [ ((Hp, Phi0, Sup (m1,-g), Sdown (m2,h)), Scalar4 1, G_HGSUSD (false,m1,m2,g,h)); ((Hm, Phi0, Sup (m1,g), Sdown (m2,-h)), Scalar4 1, G_HGSUSD (true,m1,m2,g,h)); ((H_Heavy, Phip, Sup (m1,-g), Sdown (m2,h)), Scalar4 1, G_H2GSUSD (false,m1,m2,g,h)); ((H_Heavy, Phim, Sup (m1,g), Sdown (m2,-h)), Scalar4 1, G_H2GSUSD (true,m1,m2,g,h)); ((H_Light, Phip, Sup (m1,-g), Sdown (m2,h)), Scalar4 1, G_H1GSUSD (false,m1,m2,g,h)); ((H_Light, Phim, Sup (m1,g), Sdown (m2,-h)), Scalar4 1, G_H1GSUSD (true,m1,m2,g,h)); ((A, Phip, Sup (m1,-g), Sdown (m2,h)), Scalar4 1, G_AGSUSD (false,m1,m2,g,h)); ((A, Phim, Sup (m1,g), Sdown (m2,-h)), Scalar4 1, G_AGSUSD (true,m1,m2,g,h)); ((Phi0, Phip, Sup (m1,-g), Sdown (m2,h)), Scalar4 1, G_GGSUSD (false,m1,m2,g,h)); ((Phi0, Phim, Sup (m1,g), Sdown (m2,-h)), Scalar4 1, G_GGSUSD (true,m1,m2,g,h)) ] let higgs_gold_squark g h = List.flatten (Product.list2 (higgs_gold_squark' g h) [M1;M2] [M1;M2]) let sneutrino4' (g,h) = [ ((Sneutrino g, Sneutrino h, Sneutrino (-g), Sneutrino (-h)), Scalar4 1, G_SN4 (g,h))] let sneutrino4 = ThoList.flatmap sneutrino4' [(1,1);(1,2);(1,3);(2,2);(2,3);(3,3)] let sneu2_slep2_1' g h m1 m2 = ((Sneutrino (-g), Sneutrino g, Slepton (m1,-h), Slepton (m2,h)), Scalar4 1, G_SN2SL2_1 (m1,m2,g,h)) let sneu2_slep2_2' (g,h) m1 m2 = ((Sneutrino g, Sneutrino (-h), Slepton (m1,-g), Slepton (m2,h)), Scalar4 1, G_SN2SL2_2 (m1,m2,g,h)) let sneu2_slep2_1 g h = Product.list2 (sneu2_slep2_1' g h) [M1;M2] [M1;M2] let sneu2_slep2_2 (g,h) = Product.list2 (sneu2_slep2_2' (g,h)) [M1;M2] [M1;M2] (* The 4-slepton-vertices have the following structure: The sleptons come up in pairs of a positive and a negative slepton of the same generation; there is no vertex with e.g. two negative selectrons and two positive smuons, that of course would be a contradiction to the conservation of the separate slepton numbers of each generation which is not implemented in the MSSM. Because there is no CKM-mixing for the sleptons (in case of massless neutrinos) we maximally have two different generations of sleptons in a 4-slepton-vertex. *) let slepton4_1gen' g (m1,m2,m3,m4) = [ ((Slepton (m1,-g), Slepton (m2,g), Slepton (m3,-g), Slepton (m4,g)), Scalar4 1, G_SL4 (m1,m2,m3,m4,g)) ] let slepton4_1gen g = ThoList.flatmap (slepton4_1gen' g) [(M1,M1,M1,M1); (M1,M1,M1,M2); (M1,M1,M2,M1); (M1,M1,M2,M2); (M1,M2,M1,M2); (M1,M2,M2,M1); (M1,M2,M2,M2); (M2,M1,M2,M2); (M2,M2,M2,M2) ] let slepton4_2gen' (g,h) (m1,m2) (m3,m4) = ((Slepton (m1,-g), Slepton (m2,g), Slepton (m3,-h), Slepton (m4,h)), Scalar4 1, G_SL4_2 (m1,m2,m3,m4,g,h)) let slepton4_2gen (g,h) = Product.list2 (slepton4_2gen' (g,h)) [(M1,M1);(M1,M2);(M2,M1);(M2,M2)] [(M1,M1);(M1,M2);(M2,M1);(M2,M2)] let sneu2_squark2' g h m1 m2 = [ ((Sneutrino (-g), Sneutrino g, Sup (m1,-h), Sup (m2,h)), Scalar4 1, G_SN2SQ2 (SU,m1,m2,g,h)); ((Sneutrino (-g), Sneutrino g, Sdown (m1,-h), Sdown (m2,h)), Scalar4 1, G_SN2SQ2 (SD,m1,m2,g,h)) ] let sneu2_squark2 g h = List.flatten (Product.list2 (sneu2_squark2' g h) [M1;M2] [M1;M2]) let slepton2_squark2'' g h m1 m2 m3 m4 = [ ((Slepton (m1,-g), Slepton (m2,g), Sup (m3,-h), Sup (m4,h)), Scalar4 1, G_SL2SQ2 (SU,m1,m2,m3,m4,g,h)); ((Slepton (m1,-g), Slepton (m2,g), Sdown (m3,-h), Sdown (m4,h)), Scalar4 1, G_SL2SQ2 (SD,m1,m2,m3,m4,g,h)) ] let slepton2_squark2' g h m1 m2 = List.flatten (Product.list2 (slepton2_squark2'' g h m1 m2) [M1;M2] [M1;M2]) let slepton2_squark2 g h = List.flatten (Product.list2 (slepton2_squark2' g h) [M1;M2] [M1;M2]) let slep_sneu_squark2'' g1 g2 g3 m1 m2 m3 = [ ((Sup (m1,-g1), Sdown (m2,g2), Slepton (m3,-g3), Sneutrino g3), Scalar4 1, G_SUSDSNSL (false,m1,m2,m3,g1,g2,g3)); ((Sup (m1,g1), Sdown (m2,-g2), Slepton (m3,g3), Sneutrino (-g3)), Scalar4 1, G_SUSDSNSL (true,m1,m2,m3,g1,g2,g3)) ] let slep_sneu_squark2' g1 g2 g3 m1 = List.flatten (Product.list2 (slep_sneu_squark2'' g1 g2 g3 m1) [M1;M2] [M1;M2]) let slep_sneu_squark2 g1 g2 = List.flatten (Product.list2 (slep_sneu_squark2' g1 g2) [1;2;3] [M1;M2]) (* There are three kinds of 4-squark-vertices: Four up-Squarks, four down-squarks or two up- and two down-squarks. *) let sup4_1gen' g (m1,m2,m3,m4) = [ ((Sup (m1,-g), Sup (m2,g), Sup (m3,-g), Sup (m4,g)), Scalar4 1, G_SU4 (m1,m2,m3,m4,g)) ] let sup4_1gen g = ThoList.flatmap (sup4_1gen' g) [(M1,M1,M1,M1); (M1,M1,M1,M2); (M1,M1,M2,M1); (M1,M1,M2,M2); (M1,M2,M1,M2); (M1,M2,M2,M1); (M1,M2,M2,M2); (M2,M1,M2,M2); (M2,M2,M2,M2) ] let sup4_2gen' (g,h) (m1,m2) (m3,m4) = ((Sup (m1,-g), Sup (m2,g), Sup (m3,-h), Sup (m4,h)), Scalar4 1, G_SU4_2 (m1,m2,m3,m4,g,h)) let sup4_2gen (g,h) = Product.list2 (sup4_2gen' (g,h)) [(M1,M1);(M1,M2);(M2,M1);(M2,M2)] [(M1,M1);(M1,M2);(M2,M1);(M2,M2)] let sdown4_1gen' g (m1,m2,m3,m4) = [ ((Sdown (m1,-g), Sdown (m2,g), Sdown (m3,-g), Sdown (m4,g)), Scalar4 1, G_SD4 (m1,m2,m3,m4,g)) ] let sdown4_1gen g = ThoList.flatmap (sdown4_1gen' g) [(M1,M1,M1,M1); (M1,M1,M1,M2); (M1,M1,M2,M1); (M1,M1,M2,M2); (M1,M2,M1,M2); (M1,M2,M2,M1); (M1,M2,M2,M2); (M2,M1,M2,M2); (M2,M2,M2,M2) ] let sdown4_2gen' (g,h) (m1,m2) (m3,m4) = ((Sdown (m1,-g), Sdown (m2,g), Sdown (m3,-h), Sdown (m4,h)), Scalar4 1, G_SD4_2 (m1,m2,m3,m4,g,h)) let sdown4_2gen (g,h) = Product.list2 (sdown4_2gen' (g,h)) [(M1,M1);(M1,M2);(M2,M1);(M2,M2)] [(M1,M1);(M1,M2);(M2,M1);(M2,M2)] let sup2_sdown2_3 g1 g2 g3 g4 m1 m2 m3 m4 = ((Sup (m1,-g1), Sup (m2,g2), Sdown (m3,-g3), Sdown (m4,g4)), Scalar4 1, G_SU2SD2 (m1,m2,m3,m4,g1,g2,g3,g4)) let sup2_sdown2_2 g1 g2 g3 g4 m1 m2 = Product.list2 (sup2_sdown2_3 g1 g2 g3 g4 m1 m2) [M1;M2] [M1;M2] let sup2_sdown2_1 g1 g2 g3 g4 = List.flatten (Product.list2 (sup2_sdown2_2 g1 g2 g3 g4) [M1;M2] [M1;M2]) let sup2_sdown2 g1 g2 = List.flatten (Product.list2 (sup2_sdown2_1 g1 g2) [1;2;3] [1;2;3]) let quartic_grav_gauge g m = [ ((Grino, Slepton (m, -g), Ga, L g), GBBG (1, Gravbar, SLRV, Psi), G_Gr4A_Sl (g,m)); ((L (-g), Slepton (m, g), Ga, Grino), GBBG (1, Psibar, SLRV, Grav), G_Gr4A_Slc (g,m)); ((Grino, Sup (m, -g), Ga, U g), GBBG (1, Gravbar, SLRV, Psi), G_Gr4A_Su (g,m)); ((U (-g), Sup (m, g), Ga, Grino), GBBG (1, Psibar, SLRV, Grav), G_Gr4A_Suc (g,m)); ((Grino, Sdown (m, -g), Ga, D g), GBBG (1, Gravbar, SLRV, Psi), G_Gr4A_Sd (g,m)); ((D (-g), Sdown (m, g), Ga, Grino), GBBG (1, Psibar, SLRV, Grav), G_Gr4A_Sdc (g,m)); ((Grino, Slepton (m, -g), Z, L g), GBBG (1, Gravbar, SLRV, Psi), G_Gr4Z_Sl (g,m)); ((L (-g), Slepton (m, g), Z, Grino), GBBG (1, Psibar, SLRV, Grav), G_Gr4Z_Slc (g,m)); ((Grino, Sup (m, -g), Z, U g), GBBG (1, Gravbar, SLRV, Psi), G_Gr4Z_Su (g,m)); ((U (-g), Sup (m, g), Z, Grino), GBBG (1, Psibar, SLRV, Grav), G_Gr4Z_Suc (g,m)); ((Grino, Sdown (m, -g), Z, D g), GBBG (1, Gravbar, SLRV, Psi), G_Gr4Z_Sd (g,m)); ((D (-g), Sdown (m, g), Z, Grino), GBBG (1, Psibar, SLRV, Grav), G_Gr4Z_Sdc (g,m)); ((Grino, Sup (m, -g), Gl, U g), GBBG (1, Gravbar, SLRV, Psi), G_Gr4Gl_Su (g,m)); ((U (-g), Sup (m, g), Gl, Grino), GBBG (1, Psibar, SLRV, Grav), G_Gr4Gl_Suc (g,m)); ((Grino, Sdown (m, -g), Gl, D g), GBBG (1, Gravbar, SLRV, Psi), G_Gr4Gl_Sd (g,m)); ((D (-g), Sdown (m, g), Gl, Grino), GBBG (1, Psibar, SLRV, Grav), G_Gr4Gl_Sdc (g,m)); ((Grino, Slepton (m, -g), Wm, N g), GBBG (1, Gravbar, SLV, Psi), G_Gr4W_Sl (g,m)); ((N (-g), Slepton (m, g), Wp, Grino), GBBG (1, Psibar, SLV, Grav), G_Gr4Z_Slc (g,m)); ((Grino, Sup (m, -g), Wp, D g), GBBG (1, Gravbar, SLV, Psi), G_Gr4W_Su (g,m)); ((D (-g), Sup (m, g), Wm, Grino), GBBG (1, Psibar, SLV, Grav), G_Gr4W_Suc (g,m)); ((Grino, Sdown (m, -g), Wm, U g), GBBG (1, Gravbar, SLV, Psi), G_Gr4W_Sd (g,m)); ((U (-g), Sdown (m, g), Wp, Grino), GBBG (1, Psibar, SLV, Grav), G_Gr4W_Sdc (g,m)) ] let quartic_grav_sneutrino g = [ ((Grino, Sneutrino (-g), Z, N g), GBBG (1, Gravbar, SLV, Psi), G_Gr4Z_Sn); ((N (-g), Sneutrino g, Z, Grino), GBBG (1, Psibar, SLV, Grav), G_Gr4Z_Snc); ((Grino, Sneutrino (-g), Wp, L g), GBBG (1, Gravbar, SLV, Psi), G_Gr4W_Sn); ((L (-g), Sneutrino g, Wm, Grino), GBBG (1, Psibar, SLV, Grav), G_Gr4W_Snc) ] let quartic_grav_neu n = [ ((Grino, Wp, Wm, Neutralino n), GBBG (1, Gravbar, V2LR, Chi), G_Gr4_Neu n); ((Grino, H_Light, Z, Neutralino n), GBBG (1, Gravbar, SLRV, Chi), G_Gr4_Z_H1 n); ((Grino, H_Heavy, Z, Neutralino n), GBBG (1, Gravbar, SLRV, Chi), G_Gr4_Z_H2 n); ((Grino, A, Z, Neutralino n), GBBG (1, Gravbar, SLRV, Chi), G_Gr4_Z_H3 n); ((Grino, Hm, Wp, Neutralino n), GBBG (1, Gravbar, SLRV, Chi), G_Gr4_W_H n); ((Grino, Hp, Wm, Neutralino n), GBBG (1, Gravbar, SLRV, Chi), G_Gr4_W_Hc n) ] let quartic_grav_char c = let cc = conj_char c in [ ((Grino, Wm, Ga, Chargino c), GBBG (1, Gravbar, V2LR, Psi), G_Gr4_A_Ch c); ((Grino, Wm, Z, Chargino c), GBBG (1, Gravbar, V2LR, Psi), G_Gr4_Z_Ch c); ((Chargino cc, Wp, Ga, Grino), GBBG ((-1), Psibar, V2LR, Grav), G_Gr4_A_Ch cc); ((Chargino cc, Wp, Z, Grino), GBBG ((-1), Psibar, V2LR, Grav), G_Gr4_Z_Ch cc); ((Grino, Hm, Ga, Chargino c), GBBG (1, Gravbar, SLRV, Psi), G_Gr4_H_A c); ((Chargino cc, Hp, Ga, Grino), GBBG (1, Psibar, SLRV, Grav), G_Gr4_H_A cc); ((Grino, Hm, Z, Chargino c), GBBG (1, Gravbar, SLRV, Psi), G_Gr4_H_Z c); ((Chargino cc, Hp, Z, Grino), GBBG (1, Psibar, SLRV, Grav), G_Gr4_H_Z cc)] let quartic_gravitino = [ ((Grino, Gl, Gl, Gluino), GBBG (1, Gravbar, V2, Chi), G_GravGl)] @ ThoList.flatmap quartic_grav_neu [N1; N2; N3; N4] @ ThoList.flatmap quartic_grav_char [C1; C2] @ List.flatten (Product.list2 quartic_grav_gauge [1; 2; 3] [M1; M2]) @ ThoList.flatmap quartic_grav_sneutrino [1; 2; 3] let vertices3'' = if Flags.ckm_present then (ThoList.flatmap electromagnetic_currents_3 [1;2;3] @ ThoList.flatmap electromagnetic_currents_2 [C1;C2] @ List.flatten (Product.list2 electromagnetic_sfermion_currents [1;2;3] [M1;M2]) @ ThoList.flatmap neutral_currents [1;2;3] @ ThoList.flatmap neutral_sfermion_currents [1;2;3] @ ThoList.flatmap charged_currents [1;2;3] @ List.flatten (Product.list2 charged_slepton_currents [1;2;3] [M1;M2]) @ List.flatten (Product.list2 charged_quark_currents [1;2;3] [1;2;3]) @ List.flatten (Product.list2 charged_squark_currents [1;2;3] [1;2;3]) @ ThoList.flatmap yukawa_higgs_quark [(1,3);(2,3);(3,3);(3,1);(3,2)] @ yukawa_higgs 3 @ yukawa_n @ ThoList.flatmap yukawa_c [C1;C2] @ ThoList.flatmap yukawa_cq [C1;C2] @ List.flatten (Product.list2 charged_chargino_currents [N1;N2;N3;N4] [C1;C2]) @ triple_gauge @ ThoList.flatmap neutral_Z_1 [(N1,N2);(N1,N3);(N1,N4);(N2,N3);(N2,N4); (N3,N4)] @ - ThoList.flatmap neutral_Z_2 [N1;N2;N3;N4] @ + ThoList.flatmap neutral_Z_2 [N1;N2;N3;N4] @ neutral_A @ Product.list2 charged_Z [C1;C2] [C1;C2] @ gauge_higgs @ higgs @ yukawa_higgs_2 @ List.flatten (Product.list2 higgs_charg_neutr [N1;N2;N3;N4] [C1;C2]) @ higgs_neutr @ higgs_sneutrino @ higgs_sfermion @ higgs_squark @ yukawa_v @ ThoList.flatmap col_currents [1;2;3] @ List.flatten (Product.list2 col_sfermion_currents [1;2;3] [M1;M2])) else (ThoList.flatmap electromagnetic_currents_3 [1;2;3] @ ThoList.flatmap electromagnetic_currents_2 [C1;C2] @ List.flatten (Product.list2 electromagnetic_sfermion_currents [1;2;3] [M1;M2]) @ ThoList.flatmap neutral_currents [1;2;3] @ ThoList.flatmap neutral_sfermion_currents [1;2;3] @ ThoList.flatmap charged_currents [1;2;3] @ List.flatten (Product.list2 charged_slepton_currents [1;2;3] [M1;M2]) @ charged_quark_currents 1 1 @ charged_quark_currents 2 2 @ charged_quark_currents 3 3 @ charged_squark_currents 1 1 @ charged_squark_currents 2 2 @ charged_squark_currents 3 3 @ ThoList.flatmap yukawa_higgs_quark [(3,3)] @ yukawa_higgs 3 @ yukawa_n @ ThoList.flatmap yukawa_c [C1;C2] @ ThoList.flatmap yukawa_cq [C1;C2] @ List.flatten (Product.list2 charged_chargino_currents [N1;N2;N3;N4] [C1;C2]) @ triple_gauge @ ThoList.flatmap neutral_Z_1 [(N1,N2);(N1,N3);(N1,N4);(N2,N3);(N2,N4); (N3,N4)] @ - ThoList.flatmap neutral_Z_2 [N1;N2;N3;N4] @ + ThoList.flatmap neutral_Z_2 [N1;N2;N3;N4] @ neutral_A @ Product.list2 charged_Z [C1;C2] [C1;C2] @ gauge_higgs @ higgs @ yukawa_higgs_2 @ List.flatten (Product.list2 higgs_charg_neutr [N1;N2;N3;N4] [C1;C2]) @ higgs_neutr @ higgs_sneutrino @ higgs_sfermion @ higgs_squark @ yukawa_v @ ThoList.flatmap col_currents [1;2;3] @ List.flatten (Product.list2 col_sfermion_currents [1;2;3] [M1;M2])) let vertices3' = if Flags.gravitino then (vertices3'' @ triple_gravitino) else vertices3'' let vertices3 = if Flags.include_goldstone then (vertices3' @ yukawa_goldstone 3 @ gauge_higgs_gold @ higgs_gold @ yukawa_goldstone_2 @ (if Flags.ckm_present then List.flatten (Product.list2 yukawa_goldstone_quark [1;2;3] [1;2;3]) @ List.flatten (Product.list2 goldstone_charg_neutr [N1;N2;N3;N4] [C1;C2]) else yukawa_goldstone_quark 1 1 @ yukawa_goldstone_quark 2 2 @ yukawa_goldstone_quark 3 3) @ goldstone_neutr @ goldstone_sfermion @ goldstone_squark) else vertices3' let vertices4''' = (quartic_gauge @ higgs4 @ gauge_higgs4 @ ThoList.flatmap gauge_sfermion4 [1;2;3] @ gauge_squark4 @ gluon_w_squark @ List.flatten (Product.list2 gluon2_squark2 [1;2;3] [M1;M2]) @ ThoList.flatmap gluon_gauge_squark [1;2;3]) let vertices4'' = if Flags.gravitino then (vertices4''' @ quartic_gravitino) else vertices4''' let vertices4' = if Flags.include_four then (vertices4'' @ ThoList.flatmap higgs_sfermion4 [1;2;3] @ ThoList.flatmap higgs_sneutrino4 [1;2;3] @ List.flatten (Product.list2 higgs_squark4 [1;2;3] [1;2;3]) @ sneutrino4 @ List.flatten (Product.list2 sneu2_slep2_1 [1;2;3] [1;2;3]) @ ThoList.flatmap sneu2_slep2_2 [(1,2);(1,3);(2,3);(2,1);(3,1);(3,2)] @ ThoList.flatmap slepton4_1gen [1;2;3] @ ThoList.flatmap slepton4_2gen [(1,2);(1,3);(2,3)] @ List.flatten (Product.list2 sneu2_squark2 [1;2;3] [1;2;3]) @ List.flatten (Product.list2 slepton2_squark2 [1;2;3] [1;2;3]) @ List.flatten (Product.list2 slep_sneu_squark2 [1;2;3] [1;2;3]) @ ThoList.flatmap sup4_1gen [1;2;3] @ ThoList.flatmap sup4_2gen [(1,2);(1,3);(2,3)] @ ThoList.flatmap sdown4_1gen [1;2;3] @ ThoList.flatmap sdown4_2gen [(1,2);(1,3);(2,3)] @ List.flatten (Product.list2 sup2_sdown2 [1;2;3] [1;2;3])) else vertices4'' let vertices4 = if Flags.include_goldstone then (vertices4' @ higgs_gold4 @ gauge_higgs_gold4 @ goldstone4 @ ThoList.flatmap higgs_gold_sneutrino [1;2;3] @ ThoList.flatmap higgs_gold_sfermion [1;2;3] @ List.flatten (Product.list2 higgs_gold_squark [1;2;3] [1;2;3])) else vertices4' let vertices () = (vertices3, vertices4, []) let table = F.of_vertices (vertices ()) let fuse2 = F.fuse2 table let fuse3 = F.fuse3 table let fuse = F.fuse table let max_degree () = 4 let flavor_of_string s = match s with | "e-" -> L 1 | "e+" -> L (-1) | "mu-" -> L 2 | "mu+" -> L (-2) | "tau-" -> L 3 | "tau+" -> L (-3) | "nue" -> N 1 | "nuebar" -> N (-1) | "numu" -> N 2 | "numubar" -> N (-2) | "nutau" -> N 3 | "nutaubar" -> N (-3) | "se1-" -> Slepton (M1,1) | "se1+" -> Slepton (M1,-1) | "smu1-" -> Slepton (M1,2) | "smu1+" -> Slepton (M1,-2) | "stau1-" -> Slepton (M1,3) | "stau1+" -> Slepton (M1,-3) | "se2-" -> Slepton (M2,1) | "se2+" -> Slepton (M2,-1) | "smu2-" -> Slepton (M2,2) | "smu2+" -> Slepton (M2,-2) | "stau2-" -> Slepton (M2,3) | "stau2+" -> Slepton (M2,-3) | "snue" -> Sneutrino 1 | "snue*" -> Sneutrino (-1) | "snumu" -> Sneutrino 2 | "snumu*" -> Sneutrino (-2) | "snutau" -> Sneutrino 3 | "snutau*" -> Sneutrino (-3) | "u" -> U 1 | "ubar" -> U (-1) | "c" -> U 2 | "cbar" -> U (-2) | "t" -> U 3 | "tbar" -> U (-3) | "d" -> D 1 | "dbar" -> D (-1) | "s" -> D 2 | "sbar" -> D (-2) | "b" -> D 3 | "bbar" -> D (-3) | "A" -> Ga | "Z" | "Z0" -> Z | "W+" -> Wp | "W-" -> Wm | "gl" | "g" -> Gl | "H" -> H_Heavy | "h" -> H_Light | "A0" -> A | "H+" -> Hp | "H-" -> Hm | "phi0" -> Phi0 | "phi+" -> Phip | "phim" -> Phim | "su1" -> Sup (M1,1) | "su1c" -> Sup (M1,-1) | "sc1" -> Sup (M1,2) | "sc1c" -> Sup (M1,-2) | "st1" -> Sup (M1,3) | "st1c" -> Sup (M1,-3) | "su2" -> Sup (M2,1) | "su2c" -> Sup (M2,-1) | "sc2" -> Sup (M2,2) | "sc2c" -> Sup (M2,-2) | "st2" -> Sup (M2,3) | "st2c" -> Sup (M2,-3) | "sgl" | "sg" -> Gluino | "sd1" -> Sdown (M1,1) | "sd1c" -> Sdown (M1,-1) | "ss1" -> Sdown (M1,2) | "ss1c" -> Sdown (M1,-2) | "sb1" -> Sdown (M1,3) | "sb1c" -> Sdown (M1,-3) | "sd2" -> Sdown (M2,1) | "sd2c" -> Sdown (M2,-1) | "ss2" -> Sdown (M2,2) | "ss2c" -> Sdown (M2,-2) | "sb2" -> Sdown (M2,3) | "sb2c" -> Sdown (M2,-3) | "neu1" -> Neutralino N1 | "neu2" -> Neutralino N2 | "neu3" -> Neutralino N3 | "neu4" -> Neutralino N4 | "ch1+" -> Chargino C1 | "ch2+" -> Chargino C2 | "ch1-" -> Chargino C1c | "ch2-" -> Chargino C2c | "GR" -> Grino | _ -> invalid_arg "Modellib_MSSM.MSSM.flavor_of_string" let flavor_to_string = function | L 1 -> "e-" | L (-1) -> "e+" | L 2 -> "mu-" | L (-2) -> "mu+" | L 3 -> "tau-" | L (-3) -> "tau+" | N 1 -> "nue" | N (-1) -> "nuebar" | N 2 -> "numu" | N (-2) -> "numubar" | N 3 -> "nutau" | N (-3) -> "nutaubar" | U 1 -> "u" | U (-1) -> "ubar" | U 2 -> "c" | U (-2) -> "cbar" | U 3 -> "t" | U (-3) -> "tbar" | D 1 -> "d" | D (-1) -> "dbar" | D 2 -> "s" | D (-2) -> "sbar" | D 3 -> "b" | D (-3) -> "bbar" | L _ -> invalid_arg "Modellib_MSSM.MSSM.flavor_to_string: invalid lepton" | N _ -> invalid_arg "Modellib_MSSM.MSSM.flavor_to_string: invalid neutrino" | U _ -> invalid_arg "Modellib_MSSM.MSSM.flavor_to_string: invalid up type quark" | D _ -> invalid_arg "Modellib_MSSM.MSSM.flavor_to_string: invalid down type quark" | Gl -> "gl" | Gluino -> "sgl" | Ga -> "A" | Z -> "Z" | Wp -> "W+" | Wm -> "W-" | Phip -> "phi+" | Phim -> "phi-" | Phi0 -> "phi0" | H_Heavy -> "H" | H_Light -> "h" | A -> "A0" | Hp -> "H+" | Hm -> "H-" | Slepton (M1,1) -> "se1-" | Slepton (M1,-1) -> "se1+" | Slepton (M1,2) -> "smu1-" | Slepton (M1,-2) -> "smu1+" | Slepton (M1,3) -> "stau1-" | Slepton (M1,-3) -> "stau1+" | Slepton (M2,1) -> "se2-" | Slepton (M2,-1) -> "se2+" | Slepton (M2,2) -> "smu2-" | Slepton (M2,-2) -> "smu2+" | Slepton (M2,3) -> "stau2-" | Slepton (M2,-3) -> "stau2+" | Sneutrino 1 -> "snue" | Sneutrino (-1) -> "snue*" | Sneutrino 2 -> "snumu" | Sneutrino (-2) -> "snumu*" | Sneutrino 3 -> "snutau" | Sneutrino (-3) -> "snutau*" | Sup (M1,1) -> "su1" | Sup (M1,-1) -> "su1c" | Sup (M1,2) -> "sc1" | Sup (M1,-2) -> "sc1c" | Sup (M1,3) -> "st1" | Sup (M1,-3) -> "st1c" | Sup (M2,1) -> "su2" | Sup (M2,-1) -> "su2c" | Sup (M2,2) -> "sc2" | Sup (M2,-2) -> "sc2c" | Sup (M2,3) -> "st2" | Sup (M2,-3) -> "st2c" | Sdown (M1,1) -> "sd1" | Sdown (M1,-1) -> "sd1c" | Sdown (M1,2) -> "ss1" | Sdown (M1,-2) -> "ss1c" | Sdown (M1,3) -> "sb1" | Sdown (M1,-3) -> "sb1c" | Sdown (M2,1) -> "sd2" | Sdown (M2,-1) -> "sd2c" | Sdown (M2,2) -> "ss2" | Sdown (M2,-2) -> "ss2c" | Sdown (M2,3) -> "sb2" | Sdown (M2,-3) -> "sb2c" | Neutralino N1 -> "neu1" | Neutralino N2 -> "neu2" | Neutralino N3 -> "neu3" | Neutralino N4 -> "neu4" | Slepton _ -> invalid_arg "Modellib_MSSM.MSSM.flavor_to_string: invalid slepton" | Sneutrino _ -> invalid_arg "Modellib_MSSM.MSSM.flavor_to_string: invalid sneutrino" | Sup _ -> invalid_arg "Modellib_MSSM.MSSM.flavor_to_string: invalid up type squark" | Sdown _ -> invalid_arg "Modellib_MSSM.MSSM.flavor_to_string: invalid down type squark" | Chargino C1 -> "ch1+" | Chargino C1c -> "ch1-" | Chargino C2 -> "ch2+" | Chargino C2c -> "ch2-" | Grino -> "GR" let flavor_symbol = function | L g when g > 0 -> "l" ^ string_of_int g | L g -> "l" ^ string_of_int (abs g) ^ "b" | N g when g > 0 -> "n" ^ string_of_int g | N g -> "n" ^ string_of_int (abs g) ^ "b" | U g when g > 0 -> "u" ^ string_of_int g | U g -> "u" ^ string_of_int (abs g) ^ "b" | D g when g > 0 -> "d" ^ string_of_int g | D g -> "d" ^ string_of_int (abs g) ^ "b" | Gl -> "gl" | Ga -> "a" | Z -> "z" | Wp -> "wp" | Wm -> "wm" | Slepton (M1,g) when g > 0 -> "sl1" ^ string_of_int g | Slepton (M1,g) -> "sl1c" ^ string_of_int (abs g) | Slepton (M2,g) when g > 0 -> "sl2" ^ string_of_int g | Slepton (M2,g) -> "sl2c" ^ string_of_int (abs g) | Sneutrino g when g > 0 -> "sn" ^ string_of_int g | Sneutrino g -> "snc" ^ string_of_int (abs g) | Sup (M1,g) when g > 0 -> "su1" ^ string_of_int g | Sup (M1,g) -> "su1c" ^ string_of_int (abs g) | Sup (M2,g) when g > 0 -> "su2" ^ string_of_int g | Sup (M2,g) -> "su2c" ^ string_of_int (abs g) | Sdown (M1,g) when g > 0 -> "sd1" ^ string_of_int g | Sdown (M1,g) -> "sd1c" ^ string_of_int (abs g) | Sdown (M2,g) when g > 0 -> "sd2" ^ string_of_int g | Sdown (M2,g) -> "sd2c" ^ string_of_int (abs g) | Neutralino n -> "neu" ^ (string_of_neu n) | Chargino c when (int_of_char c) > 0 -> "cp" ^ string_of_char c | Chargino c -> "cm" ^ string_of_int (abs (int_of_char c)) | Gluino -> "sgl" | Phip -> "pp" | Phim -> "pm" | Phi0 -> "p0" | H_Heavy -> "h0h" | H_Light -> "h0l" | A -> "a0" | Hp -> "hp" | Hm -> "hm" | Grino -> "gv" let flavor_to_TeX = function | L 1 -> "e^-" | L (-1) -> "e^+" | L 2 -> "\\mu^-" | L (-2) -> "\\mu^+" | L 3 -> "\\tau^-" | L (-3) -> "\\tau^+" | N 1 -> "\\nu_e" | N (-1) -> "\\bar{\\nu}_e" | N 2 -> "\\nu_\\mu" | N (-2) -> "\\bar{\\nu}_\\mu" | N 3 -> "\\nu_\\tau" | N (-3) -> "\\bar{\\nu}_\\tau" | U 1 -> "u" | U (-1) -> "\\bar{u}" | U 2 -> "c" | U (-2) -> "\\bar{c}" | U 3 -> "t" | U (-3) -> "\\bar{t}" | D 1 -> "d" | D (-1) -> "\\bar{d}" | D 2 -> "s" | D (-2) -> "\\bar{s}" | D 3 -> "b" | D (-3) -> "\\bar{b}" | L _ -> invalid_arg "Modellib_MSSM.MSSM.flavor_to_TeX: invalid lepton" | N _ -> invalid_arg "Modellib_MSSM.MSSM.flavor_to_TeX: invalid neutrino" | U _ -> invalid_arg "Modellib_MSSM.MSSM.flavor_to_TeX: invalid up type quark" | D _ -> invalid_arg "Modellib_MSSM.MSSM.flavor_to_TeX: invalid down type quark" | Gl -> "g" | Gluino -> "\\widetilde{g}" | Ga -> "\\gamma" | Z -> "Z" | Wp -> "W^+" | Wm -> "W^-" | Phip -> "\\phi^+" | Phim -> "\\phi^-" | Phi0 -> "\\phi^0" | H_Heavy -> "H^0" | H_Light -> "h^0" | A -> "A^0" | Hp -> "H^+" | Hm -> "H^-" | Slepton (M1,1) -> "\\widetilde{e}_1^-" | Slepton (M1,-1) -> "\\widetilde{e}_1^+" | Slepton (M1,2) -> "\\widetilde{\\mu}_1^-" | Slepton (M1,-2) -> "\\widetilde{\\mu}_1^+" | Slepton (M1,3) -> "\\widetilde{\\tau}_1^-" | Slepton (M1,-3) -> "\\widetilde{\\tau}_1^+" | Slepton (M2,1) -> "\\widetilde{e}_2^-" | Slepton (M2,-1) -> "\\widetilde{e}_2^+" | Slepton (M2,2) -> "\\widetilde{\\mu}_2^-" | Slepton (M2,-2) -> "\\widetilde{\\mu}_2^+" | Slepton (M2,3) -> "\\widetilde{\\tau}_2^-" | Slepton (M2,-3) -> "\\widetilde{\\tau}_2^+" | Sneutrino 1 -> "\\widetilde{\\nu}_e" | Sneutrino (-1) -> "\\widetilde{\\nu}_e^*" | Sneutrino 2 -> "\\widetilde{\\nu}_\\mu" | Sneutrino (-2) -> "\\widetilde{\\nu}_\\mu^*" | Sneutrino 3 -> "\\widetilde{\\nu}_\\tau" | Sneutrino (-3) -> "\\widetilde{\\nu}_\\tau^*" | Sup (M1,1) -> "\\widetilde{u}_1" | Sup (M1,-1) -> "\\widetilde{u}_1^*" | Sup (M1,2) -> "\\widetilde{c}_1" | Sup (M1,-2) -> "\\widetilde{c}_1^*" | Sup (M1,3) -> "\\widetilde{t}_1" | Sup (M1,-3) -> "\\widetilde{t}_1^*" | Sup (M2,1) -> "\\widetilde{u}_2" | Sup (M2,-1) -> "\\widetilde{u}_2^*" | Sup (M2,2) -> "\\widetilde{c}_2" | Sup (M2,-2) -> "\\widetilde{c}_2^*" | Sup (M2,3) -> "\\widetilde{t}_2" | Sup (M2,-3) -> "\\widetilde{t}_2^*" | Sdown (M1,1) -> "\\widetilde{d}_1" | Sdown (M1,-1) -> "\\widetilde{d}_1^*" | Sdown (M1,2) -> "\\widetilde{s}_1" | Sdown (M1,-2) -> "\\widetilde{s}_1^*" | Sdown (M1,3) -> "\\widetilde{b}_1" | Sdown (M1,-3) -> "\\widetilde{b}_1^*" | Sdown (M2,1) -> "\\widetilde{d}_2" | Sdown (M2,-1) -> "\\widetilde{d}_2^*" | Sdown (M2,2) -> "\\widetilde{s}_2" | Sdown (M2,-2) -> "\\widetilde{s}_2^*" | Sdown (M2,3) -> "\\widetilde{b}_2" | Sdown (M2,-3) -> "\\widetilde{b}_2^*" | Neutralino N1 -> "\\widetilde{\\chi}^0_1" | Neutralino N2 -> "\\widetilde{\\chi}^0_2" | Neutralino N3 -> "\\widetilde{\\chi}^0_3" | Neutralino N4 -> "\\widetilde{\\chi}^0_4" | Slepton _ -> invalid_arg "Modellib_MSSM.MSSM.flavor_to_TeX: invalid slepton" | Sneutrino _ -> invalid_arg "Modellib_MSSM.MSSM.flavor_to_TeX: invalid sneutrino" | Sup _ -> invalid_arg "Modellib_MSSM.MSSM.flavor_to_TeX: invalid up type squark" | Sdown _ -> invalid_arg "Modellib_MSSM.MSSM.flavor_to_TeX: invalid down type squark" | Chargino C1 -> "\\widetilde{\\chi}_1^+" | Chargino C1c -> "\\widetilde{\\chi}_1^-" | Chargino C2 -> "\\widetilde{\\chi}_2^+" | Chargino C2c -> "\\widetilde{\\chi}_2^-" | Grino -> "\\widetilde{G}" let pdg = function | L g when g > 0 -> 9 + 2*g | L g -> - 9 + 2*g | N g when g > 0 -> 10 + 2*g | N g -> - 10 + 2*g | U g when g > 0 -> 2*g | U g -> 2*g | D g when g > 0 -> - 1 + 2*g | D g -> 1 + 2*g | Gl -> 21 | Ga -> 22 | Z -> 23 | Wp -> 24 | Wm -> (-24) | H_Light -> 25 | H_Heavy -> 35 | A -> 36 | Hp -> 37 | Hm -> (-37) | Phip | Phim -> 27 | Phi0 -> 26 | Slepton (M1,g) when g > 0 -> 1000009 + 2*g | Slepton (M1,g) -> - 1000009 + 2*g | Slepton (M2,g) when g > 0 -> 2000009 + 2*g | Slepton (M2,g) -> - 2000009 + 2*g | Sneutrino g when g > 0 -> 1000010 + 2*g | Sneutrino g -> - 1000010 + 2*g | Sup (M1,g) when g > 0 -> 1000000 + 2*g | Sup (M1,g) -> - 1000000 + 2*g | Sup (M2,g) when g > 0 -> 2000000 + 2*g | Sup (M2,g) -> - 2000000 + 2*g | Sdown (M1,g) when g > 0 -> 999999 + 2*g | Sdown (M1,g) -> - 999999 + 2*g | Sdown (M2,g) when g > 0 -> 1999999 + 2*g | Sdown (M2,g) -> - 1999999 + 2*g | Gluino -> 1000021 | Grino -> 1000039 | Chargino C1 -> 1000024 | Chargino C1c -> (-1000024) | Chargino C2 -> 1000037 | Chargino C2c -> (-1000037) | Neutralino N1 -> 1000022 | Neutralino N2 -> 1000023 | Neutralino N3 -> 1000025 | Neutralino N4 -> 1000035 (* We must take care of the pdg numbers for the two different kinds of sfermions in the MSSM. The particle data group in its Monte Carlo particle numbering scheme takes only into account mixtures of the third generation squarks and the stau. For the other sfermions we will use the number of the lefthanded field for the lighter mixed state and the one for the righthanded for the heavier. Below are the official pdg numbers from the Particle Data Group. In order not to produce arrays with some million entries in the Fortran code for the masses and the widths we introduce our private pdg numbering scheme which only extends not too far beyond 42. Our private scheme then has the following pdf numbers (for the sparticles the subscripts $L/R$ and $1/2$ are taken synonymously): \begin{center} \renewcommand{\arraystretch}{1.2} \begin{tabular}{|r|l|l|}\hline $d$ & down-quark & 1 \\\hline $u$ & up-quark & 2 \\\hline $s$ & strange-quark & 3 \\\hline $c$ & charm-quark & 4 \\\hline $b$ & bottom-quark & 5 \\\hline $t$ & top-quark & 6 \\\hline\hline $e^-$ & electron & 11 \\\hline $\nu_e$ & electron-neutrino & 12 \\\hline $\mu^-$ & muon & 13 \\\hline $\nu_\mu$ & muon-neutrino & 14 \\\hline $\tau^-$ & tau & 15 \\\hline $\nu_\tau$ & tau-neutrino & 16 \\\hline\hline $g$ & gluon & (9) 21 \\\hline $\gamma$ & photon & 22 \\\hline $Z^0$ & Z-boson & 23 \\\hline $W^+$ & W-boson & 24 \\\hline\hline $h^0$ & light Higgs boson & 25 \\\hline $H^0$ & heavy Higgs boson & 35 \\\hline $A^0$ & pseudoscalar Higgs & 36 \\\hline $H^+$ & charged Higgs & 37 \\\hline\hline $\widetilde{\psi}_\mu$ & gravitino & 39 \\\hline\hline $\widetilde{d}_L$ & down-squark 1 & 41 \\\hline $\widetilde{u}_L$ & up-squark 1 & 42 \\\hline $\widetilde{s}_L$ & strange-squark 1 & 43 \\\hline $\widetilde{c}_L$ & charm-squark 1 & 44 \\\hline $\widetilde{b}_L$ & bottom-squark 1 & 45 \\\hline $\widetilde{t}_L$ & top-squark 1 & 46 \\\hline $\widetilde{d}_R$ & down-squark 2 & 47 \\\hline $\widetilde{u}_R$ & up-squark 2 & 48 \\\hline $\widetilde{s}_R$ & strange-squark 2 & 49 \\\hline $\widetilde{c}_R$ & charm-squark 2 & 50 \\\hline $\widetilde{b}_R$ & bottom-squark 2 & 51 \\\hline $\widetilde{t}_R$ & top-squark 2 & 52 \\\hline\hline $\widetilde{e}_L$ & selectron 1 & 53 \\\hline $\widetilde{\nu}_{e,L}$ & electron-sneutrino & 54 \\\hline $\widetilde{\mu}_L$ & smuon 1 & 55 \\\hline $\widetilde{\nu}_{\mu,L}$ & muon-sneutrino & 56 \\\hline $\widetilde{\tau}_L$ & stau 1 & 57 \\\hline $\widetilde{\nu}_{\tau,L}$ & tau-sneutrino & 58 \\\hline $\widetilde{e}_R$ & selectron 2 & 59 \\\hline $\widetilde{\mu}_R$ & smuon 2 & 61 \\\hline $\widetilde{\tau}_R$ & stau 2 & 63 \\\hline\hline $\widetilde{g}$ & gluino & 64 \\\hline $\widetilde{\chi}^0_1$ & neutralino 1 & 65 \\\hline $\widetilde{\chi}^0_2$ & neutralino 2 & 66 \\\hline $\widetilde{\chi}^0_3$ & neutralino 3 & 67 \\\hline $\widetilde{\chi}^0_4$ & neutralino 4 & 68 \\\hline $\widetilde{\chi}^+_1$ & chargino 1 & 69 \\\hline $\widetilde{\chi}^+_2$ & chargino 2 & 70 \\\hline\hline \end{tabular} \end{center} *) let pdg_mw = function | L g when g > 0 -> 9 + 2*g | L g -> - 9 + 2*g | N g when g > 0 -> 10 + 2*g | N g -> - 10 + 2*g | U g when g > 0 -> 2*g | U g -> 2*g | D g when g > 0 -> - 1 + 2*g | D g -> 1 + 2*g | Gl -> 21 | Ga -> 22 | Z -> 23 | Wp -> 24 | Wm -> (-24) | H_Light -> 25 | H_Heavy -> 35 | A -> 36 | Hp -> 37 | Hm -> (-37) | Phip | Phim -> 27 | Phi0 -> 26 | Sup (M1,g) when g > 0 -> 40 + 2*g | Sup (M1,g) -> - 40 + 2*g | Sup (M2,g) when g > 0 -> 46 + 2*g | Sup (M2,g) -> - 46 + 2*g | Sdown (M1,g) when g > 0 -> 39 + 2*g | Sdown (M1,g) -> - 39 + 2*g | Sdown (M2,g) when g > 0 -> 45 + 2*g | Sdown (M2,g) -> - 45 + 2*g | Slepton (M1,g) when g > 0 -> 51 + 2*g | Slepton (M1,g) -> - 51 + 2*g | Slepton (M2,g) when g > 0 -> 57 + 2*g | Slepton (M2,g) -> - 57 + 2*g | Sneutrino g when g > 0 -> 52 + 2*g | Sneutrino g -> - 52 + 2*g | Grino -> 39 | Gluino -> 64 | Chargino C1 -> 69 | Chargino C1c -> (-69) | Chargino C2 -> 70 | Chargino C2c -> (-70) | Neutralino N1 -> 65 | Neutralino N2 -> 66 | Neutralino N3 -> 67 | Neutralino N4 -> 68 let mass_symbol f = "mass(" ^ string_of_int (abs (pdg_mw f)) ^ ")" let width_symbol f = "width(" ^ string_of_int (abs (pdg_mw f)) ^ ")" let conj_symbol = function | false, str -> str | true, str -> str ^ "_c" let constant_symbol = function | Unit -> "unit" | Pi -> "PI" | Alpha_QED -> "alpha" | E -> "e" | G -> "g" | Vev -> "vev" | Sin2thw -> "sin2thw" | Eidelta -> "eidelta" | Mu -> "mu" | G_Z -> "gz" | Sin a -> "sin" ^ string_of_angle a | Cos a -> "cos" ^ string_of_angle a | Sin2am2b -> "sin2am2b" | Cos2am2b -> "cos2am2b" | Sinamb -> "sinamb" | Sinapb -> "sinapb" | Cosamb -> "cosamb" | Cosapb -> "cosapb" | Cos4be -> "cos4be" | Sin4be -> "sin4be" | Sin4al -> "sin4al" | Sin2al -> "sin2al" | Cos2al -> "cos2al" | Sin2be -> "sin2be" | Cos2be -> "cos2be" | Tana -> "tana" | Tanb -> "tanb" | Q_lepton -> "qlep" | Q_up -> "qup" | Q_down -> "qdwn" | Q_charg -> "qchar" | V_CKM (g1,g2) -> "vckm_" ^ string_of_int g1 ^ string_of_int g2 | M_SF (f,g,m1,m2) -> "mix_" ^ string_of_sff f ^ string_of_int g ^ string_of_sfm m1 ^ string_of_sfm m2 | AL g -> "al_" ^ string_of_int g | AD g -> "ad_" ^ string_of_int g | AU g -> "au_" ^ string_of_int g | A_0 (n1,n2) -> "a0_" ^ string_of_neu n1 ^ string_of_neu n2 | A_P (c1,c2) -> "ap_" ^ string_of_char c1 ^ string_of_char c2 | V_0 (n1,n2) -> "v0_" ^ string_of_neu n1 ^ string_of_neu n2 | V_P (c1,c2) -> "vp_" ^ string_of_char c1 ^ string_of_char c2 | M_N (n1,n2) -> "mn_" ^ string_of_neu n1 ^ string_of_neu n2 | M_U (c1,c2) -> "mu_" ^ string_of_char c1 ^ string_of_char c2 | M_V (c1,c2) -> "mv_" ^ string_of_char c1 ^ string_of_char c2 | L_NC (n,c) -> "lnc_" ^ string_of_neu n ^ string_of_char c | R_NC (n,c) -> "rnc_" ^ string_of_neu n ^ string_of_char c | L_CN (c,n) -> "lcn_" ^ string_of_char c ^ string_of_neu n | R_CN (c,n) -> "rcn_" ^ string_of_char c ^ string_of_neu n | L_NCH (n,c) -> "lnch_" ^ string_of_neu n ^ string_of_char c | R_NCH (n,c) -> "rnch_" ^ string_of_neu n ^ string_of_char c | L_CNG (c,n) -> "lcng_" ^ string_of_char c ^ string_of_neu n | R_CNG (c,n) -> "rcng_" ^ string_of_char c ^ string_of_neu n | S_NNA (n1,n2) -> "snna_" ^ string_of_neu n1 ^ string_of_neu n2 | P_NNA (n1,n2) -> "pnna_" ^ string_of_neu n1 ^ string_of_neu n2 | S_NNG (n1,n2) -> "snng_" ^ string_of_neu n1 ^ string_of_neu n2 | P_NNG (n1,n2) -> "pnng_" ^ string_of_neu n1 ^ string_of_neu n2 | S_NNH1 (n1,n2) -> "snnh1_" ^ string_of_neu n1 ^ string_of_neu n2 | P_NNH1 (n1,n2) -> "pnnh1_" ^ string_of_neu n1 ^ string_of_neu n2 | S_NNH2 (n1,n2) -> "snnh2_" ^ string_of_neu n1 ^ string_of_neu n2 | P_NNH2 (n1,n2) -> "pnnh2_" ^ string_of_neu n1 ^ string_of_neu n2 | G_NC_lepton -> "gnclep" | G_NC_neutrino -> "gncneu" | G_NC_up -> "gncup" | G_NC_down -> "gncdwn" | G_CC -> "gcc" | G_CCQ (vc,g1,g2) -> conj_symbol (vc, "gccq_" ^ string_of_int g1 ^ "_" ^ string_of_int g2) | I_Q_W -> "iqw" | I_G_ZWW -> "igzww" | G_WWWW -> "gw4" | G_ZZWW -> "gzzww" | G_PZWW -> "gpzww" | G_PPWW -> "gppww" | G_GH 1 -> "ghaw" | G_GH 2 -> "gh1az" | G_GH 3 -> "gh2az" | G_GH 4 -> "gh1ww" | G_GH 5 -> "gh2ww" | G_GH 6 -> "ghh1w" | G_GH 7 -> "ghh2w" | G_GH 8 -> "gh1zz" | G_GH 9 -> "gh2zz" | G_GH 10 -> "ghhz" | G_GH 11 -> "ghhp" | G_GH _ -> failwith "this G_GH coupling is not available" | G_GLGLH -> "gglglh" | G_GLGLHH -> "gglglhh" | G_GLGLA -> "gglgla" | G_PPH -> "gpph" | G_PPHH -> "gpphh" | G_PPA -> "gppa" | G_GHGo n -> "g_hgh(" ^ string_of_int n ^ ")" | G_GH4 1 -> "gaazz" | G_GH4 2 -> "gh1h1zz" | G_GH4 3 -> "gh2h2zz" | G_GH4 4 -> "ghphmzz" | G_GH4 5 -> "ghphmpp" | G_GH4 6 -> "ghphmpz" | G_GH4 7 -> "ghh1wz" | G_GH4 8 -> "ghh2wz" | G_GH4 9 -> "ghh1wp" | G_GH4 10 -> "ghh2wp" | G_GH4 11 -> "gaaww" | G_GH4 12 -> "gh1h1ww" | G_GH4 13 -> "gh2h2ww" | G_GH4 14 -> "ghhww" | G_GH4 15 -> "ghawz" | G_GH4 16 -> "ghawp" | G_GH4 _ -> failwith "this G_GH4 coupling is not available" | G_CICIH1 (n1,n2) -> "gcicih1_" ^ string_of_neu n1 ^ "_" ^ string_of_neu n2 | G_CICIH2 (n1,n2) -> "gcicih2_" ^ string_of_neu n1 ^ "_" ^ string_of_neu n2 | G_CICIA (n1,n2) -> "gcicia_" ^ string_of_neu n1 ^ "_" ^ string_of_neu n2 | G_CICIG (n1,n2) -> "gcicig_" ^ string_of_neu n1 ^ "_" ^ string_of_neu n2 | G_H3 n -> "gh3_" ^ string_of_int n | G_H4 n -> "gh4_" ^ string_of_int n | G_HGo3 n -> "ghg3_" ^ string_of_int n | G_HGo4 n -> "ghg4_" ^ string_of_int n | G_GG4 n -> "ggg4_" ^ string_of_int n | G_strong -> "gs" | G_SS -> "gs**2" | Gs -> "gs" | I_G_S -> "igs" | G_S_Sqrt -> "gssq" | G_NWC (n,c) -> "gnwc_" ^ string_of_neu n ^ "_" ^ string_of_char c | G_CWN (c,n) -> "gcwn_" ^ string_of_char c ^ "_" ^ string_of_neu n | G_CH1C (c1,c2) -> "gch1c_" ^ string_of_char c1 ^ "_" ^ string_of_char c2 | G_CH2C (c1,c2) -> "gch2c_" ^ string_of_char c1 ^ "_" ^ string_of_char c2 | G_CAC (c1,c2) -> "gcac_" ^ string_of_char c1 ^ "_" ^ string_of_char c2 | G_CGC (c1,c2) -> "gcgc_" ^ string_of_char c1 ^ "_" ^ string_of_char c2 | G_YUK (i,g) -> "g_yuk" ^ string_of_int i ^ "_" ^ string_of_int g - | G_NZN (n1,n2) -> "gnzn_" ^ string_of_neu n1 ^ "_" ^ string_of_neu n2 + | G_NZN (n1,n2) -> "gnzn_" ^ string_of_neu n1 ^ "_" ^ string_of_neu n2 + | G_NNA -> "gnna" | G_CZC (c1,c2) -> "gczc_" ^ string_of_char c1 ^ "_" ^ string_of_char c2 | G_YUK_1 (n,m) -> "g_yuk1_" ^ string_of_int n ^ "_" ^ string_of_int m | G_YUK_2 (n,m) -> "g_yuk2_" ^ string_of_int n ^ "_" ^ string_of_int m | G_YUK_3 (n,m) -> "g_yuk3_" ^ string_of_int n ^ "_" ^ string_of_int m | G_YUK_4 (n,m) -> "g_yuk4_" ^ string_of_int n ^ "_" ^ string_of_int m | G_YUK_C (vc,g,c,sf,m) -> conj_symbol (vc, "g_yuk_ch" ^ string_of_char c ^ "_" ^ string_of_sff sf ^ string_of_sfm m ^ "_" ^ string_of_int g ) | G_YUK_N (vc,g,n,sf,m) -> conj_symbol (vc, "g_yuk_n" ^ string_of_neu n ^ "_" ^ string_of_sff sf ^ string_of_sfm m ^ "_" ^ string_of_int g ) | G_YUK_G (vc,g,sf,m) -> conj_symbol (vc, "g_yuk_g" ^ string_of_sff sf ^ string_of_sfm m ^ "_" ^ string_of_int g) | G_YUK_Q (vc,g1,g2,c,sf,m) -> conj_symbol (vc, "g_yuk_ch" ^ string_of_char c ^ "_" ^ string_of_sff sf ^ string_of_sfm m ^ "_" ^ string_of_int g1 ^ "_" ^ string_of_int g2) | G_NHC (n,c) -> "g_nhc_" ^ string_of_neu n ^ "_" ^ string_of_char c | G_CHN (c,n) -> "g_chn_" ^ string_of_neu n ^ "_" ^ string_of_char c | G_NGC (n,c) -> "g_ngc_" ^ string_of_neu n ^ string_of_char c | G_CGN (c,n) -> "g_cgn_" ^ string_of_char c ^ string_of_neu n | SUM_1 -> "sum1" | G_SLSNW (vc,g,m) -> conj_symbol (vc, "gsl" ^ string_of_sfm m ^ "_" ^ string_of_int g ^ "snw") | G_ZSF (f,g,m1,m2) -> "g" ^ string_of_sff f ^ string_of_sfm m1 ^ "z" ^ string_of_sff f ^ string_of_sfm m2 ^ "_" ^ string_of_int g | G_WWSFSF (f,g,m1,m2) -> "gww" ^ string_of_sff f ^ string_of_sfm m1 ^ string_of_sff f ^ string_of_sfm m2 ^ "_" ^ string_of_int g | G_WPSLSN (vc,g,m) -> conj_symbol (vc, "gpwsl" ^ string_of_sfm m ^ "sn_" ^ string_of_int g) | G_WZSLSN (vc,g,m) -> conj_symbol (vc, "gwzsl" ^ string_of_sfm m ^ "sn_" ^ string_of_int g) | G_H1SFSF (f,g,m1,m2) -> "gh1" ^ string_of_sff f ^ string_of_sfm m1 ^ string_of_sff f ^ string_of_sfm m2 ^ "_" ^ string_of_int g | G_H2SFSF (f,g,m1,m2) -> "gh2" ^ string_of_sff f ^ string_of_sfm m1 ^ string_of_sff f ^ string_of_sfm m2 ^ "_" ^ string_of_int g | G_ASFSF (f,g,m1,m2) -> "ga" ^ string_of_sff f ^ string_of_sfm m1 ^ string_of_sff f ^ string_of_sfm m2 ^ "_" ^ string_of_int g | G_HSNSL (vc,g,m) -> conj_symbol (vc, "ghsnsl" ^ string_of_sfm m ^ "_" ^ string_of_int g) | G_GoSFSF (f,g,m1,m2) -> "ggo" ^ string_of_sff f ^ string_of_sfm m1 ^ string_of_sff f ^ string_of_sfm m2 ^ "_" ^ string_of_int g | G_GoSNSL (vc,g,m) -> conj_symbol (vc, "ggosnsl" ^ string_of_sfm m ^ "_" ^ string_of_int g) | G_HSUSD (vc,m1,m2,g1,g2) -> conj_symbol (vc, "ghsu" ^ string_of_sfm m1 ^ "sd" ^ string_of_sfm m2 ^ "_" ^ string_of_int g1 ^ "_" ^ string_of_int g2) | G_GSUSD (vc,m1,m2,g1,g2) -> conj_symbol (vc, "ggsu" ^ string_of_sfm m1 ^ "sd" ^ string_of_sfm m2 ^ "_" ^ string_of_int g1 ^ "_" ^ string_of_int g2) | G_WPSUSD (vc,m1,m2,n,m) -> conj_symbol (vc, "gpwpsu" ^ string_of_sfm m1 ^ "sd" ^ string_of_sfm m2 ^ "_" ^ string_of_int n ^ "_" ^ string_of_int m) | G_WZSUSD (vc,m1,m2,n,m) -> conj_symbol (vc, "gzwpsu" ^ string_of_sfm m1 ^ "sd" ^ string_of_sfm m2 ^ "_" ^ string_of_int n ^ "_" ^ string_of_int m) | G_SWS (vc,g1,g2,m1,m2) -> conj_symbol (vc, "gs" ^ string_of_sfm m1 ^ "ws" ^ string_of_sfm m2 ^ "_" ^ string_of_int g1 ^ "_" ^ string_of_int g2) | G_GlGlSQSQ -> "gglglsqsq" | G_PPSFSF f -> "gpp" ^ string_of_sff f ^ string_of_sff f | G_ZZSFSF (f,g,m1,m2) -> "gzz" ^ string_of_sff f ^ string_of_sfm m1 ^ string_of_sff f ^ string_of_sfm m2 ^ "_" ^ string_of_int g | G_ZPSFSF (f,g,m1,m2) -> "gzp" ^ string_of_sff f ^ string_of_sfm m1 ^ string_of_sff f ^ string_of_sfm m2 ^ "_" ^ string_of_int g | G_GlPSQSQ -> "gglpsqsq" | G_GlZSFSF (f,g,m1,m2) -> "ggl" ^ string_of_sff f ^ string_of_sfm m1 ^ string_of_sff f ^ string_of_sfm m2 ^ "_" ^ string_of_int g | G_GlWSUSD (vc,m1,m2,g1,g2) -> conj_symbol (vc, "gglwsu" ^ string_of_sfm m1 ^ "sd" ^ string_of_sfm m2 ^ "_" ^ string_of_int g1 ^ "_" ^ string_of_int g2) | G_GHGo4 1 -> "gzzg0g0" | G_GHGo4 2 -> "gzzgpgm" | G_GHGo4 3 -> "gppgpgm" | G_GHGo4 4 -> "gzpgpgm" | G_GHGo4 5 -> "gwwgpgm" | G_GHGo4 6 -> "gwwg0g0" | G_GHGo4 7 -> "gwzg0g" | G_GHGo4 8 -> "gwzg0g" | G_GHGo4 9 -> "gwzh1g" | G_GHGo4 10 -> "gwzh2g" | G_GHGo4 11 -> "gwph1g" | G_GHGo4 12 -> "gwph2g" | G_GHGo4 _ -> failwith "Coupling G_GHGo4 is not available" | G_HSF31 (h,g,m1,m2,f1,f2) -> "g_" ^ string_of_higgs h ^ string_of_int g ^ string_of_sfm m1 ^ string_of_sfm m2 ^ string_of_sff f1 ^ string_of_sff f2 | G_HSF32 (h,g1,g2,m1,m2,f1,f2) -> "g_" ^ string_of_higgs h ^ string_of_int g1 ^ "_" ^ string_of_int g2 ^ string_of_sfm m1 ^ string_of_sfm m2 ^ string_of_sff f1 ^ string_of_sff f2 | G_HSF41 (h,g,m1,m2,f1,f2) -> "g_" ^ string_of_higgs h ^ string_of_int g ^ string_of_sfm m1 ^ string_of_sfm m2 ^ string_of_sff f1 ^ string_of_sff f2 | G_HSF42 (h,g1,g2,m1,m2,f1,f2) -> "g_" ^ string_of_higgs h ^ string_of_int g1 ^ "_" ^ string_of_int g2 ^ string_of_sfm m1 ^ string_of_sfm m2 ^ string_of_sff f1 ^ string_of_sff f2 | G_H1H1SFSF (f,m1,m2,n) -> "gh1h1" ^ string_of_sff f ^ string_of_sfm m1 ^ string_of_sff f ^ string_of_sfm m2 ^ "_" ^ string_of_int n | G_H1H2SFSF (f,m1,m2,n) -> "gh1h2" ^ string_of_sff f ^ string_of_sfm m1 ^ string_of_sff f ^ string_of_sfm m2 ^ "_" ^ string_of_int n | G_H2H2SFSF (f,m1,m2,n) -> "gh2h2" ^ string_of_sff f ^ string_of_sfm m1 ^ string_of_sff f ^ string_of_sfm m2 ^ "_" ^ string_of_int n | G_HHSFSF (f,m1,m2,n) -> "ghh" ^ string_of_sff f ^ string_of_sfm m1 ^ string_of_sff f ^ string_of_sfm m2 ^ "_" ^ string_of_int n | G_AASFSF (f,m1,m2,n) -> "gaa" ^ string_of_sff f ^ string_of_sfm m1 ^ string_of_sff f ^ string_of_sfm m2 ^ "_" ^ string_of_int n | G_HH1SUSD (vc,m1,m2,g1,g2) -> conj_symbol (vc, "ghh1su" ^ string_of_sfm m1 ^ "sd" ^ string_of_sfm m2 ^ "_" ^ string_of_int g1 ^ "_" ^ string_of_int g2) | G_HH2SUSD (vc,m1,m2,g1,g2) -> conj_symbol (vc, "ghh2su" ^ string_of_sfm m1 ^ "sd" ^ string_of_sfm m2 ^ "_" ^ string_of_int g1 ^ "_" ^ string_of_int g2) | G_HASUSD (vc,m1,m2,g1,g2) -> conj_symbol (vc, "ghasu" ^ string_of_sfm m1 ^ "sd" ^ string_of_sfm m2 ^ "_" ^ string_of_int g1 ^ "_" ^ string_of_int g2 ^ "_c") | G_HH1SLSN (vc,m,g) -> conj_symbol (vc, "ghh1sl" ^ string_of_sfm m ^ "sn_" ^ string_of_int g) | G_HH2SLSN (vc,m,g) -> conj_symbol (vc, "ghh2sl" ^ string_of_sfm m ^ "sn_" ^ string_of_int g) | G_HASLSN (vc,m,g) -> conj_symbol (vc, "ghasl" ^ string_of_sfm m ^ "sn_" ^ string_of_int g) | G_AG0SFSF (f,m1,m2,n) -> "gag0" ^ string_of_sff f ^ string_of_sfm m1 ^ string_of_sff f ^ string_of_sfm m2 ^ "_" ^ string_of_int n | G_HGSFSF (f,m1,m2,n) -> "ghg" ^ string_of_sff f ^ string_of_sfm m1 ^ string_of_sff f ^ string_of_sfm m1 ^ "_" ^ string_of_int n | G_GGSFSF (f,m1,m2,n) -> "ggg" ^ string_of_sff f ^ string_of_sfm m1 ^ string_of_sff f ^ string_of_sfm m2 ^ "_" ^ string_of_int n | G_G0G0SFSF (f,m1,m2,n) -> "gg0g0" ^ string_of_sff f ^ string_of_sfm m1 ^ string_of_sff f ^ string_of_sfm m2 ^ "_" ^ string_of_int n | G_HGSNSL (vc,m,n) -> conj_symbol (vc, "ghgsnsl" ^ string_of_sfm m ^ "_" ^ string_of_int n) | G_H1GSNSL (vc,m,n) -> conj_symbol (vc, "gh1gsnsl" ^ string_of_sfm m ^ "_" ^ string_of_int n) | G_H2GSNSL (vc,m,n) -> conj_symbol (vc, "gh2gsnsl" ^ string_of_sfm m ^ "_" ^ string_of_int n) | G_AGSNSL (vc,m,n) -> conj_symbol (vc, "gagsnsl" ^ string_of_sfm m ^ "_" ^ string_of_int n) | G_GGSNSL (vc,m,n) -> conj_symbol (vc, "gggsnsl" ^ string_of_sfm m ^ "_" ^ string_of_int n) | G_HGSUSD (vc,m1,m2,g1,g2) -> conj_symbol (vc, "gghpsu" ^ string_of_sfm m1 ^ "sd" ^ string_of_sfm m2 ^ "_" ^ string_of_int g1 ^ "_" ^ string_of_int g2) | G_H1GSUSD (vc,m1,m2,g1,g2) -> conj_symbol (vc, "gh1gpsu" ^ string_of_sfm m1 ^ "sd" ^ string_of_sfm m2 ^ "_" ^ string_of_int g1 ^ "_" ^ string_of_int g2) | G_H2GSUSD (vc,m1,m2,g1,g2) -> conj_symbol (vc, "gh2gpsu" ^ string_of_sfm m1 ^ "sd" ^ string_of_sfm m2 ^ "_" ^ string_of_int g1 ^ "_" ^ string_of_int g2) | G_AGSUSD (vc,m1,m2,g1,g2) -> conj_symbol (vc, "gagpsu" ^ string_of_sfm m1 ^ "sd" ^ string_of_sfm m2 ^ "_" ^ string_of_int g1 ^ "_" ^ string_of_int g2) | G_GGSUSD (vc,m1,m2,g1,g2) -> conj_symbol (vc, "gggpsu" ^ string_of_sfm m1 ^ "sd" ^ string_of_sfm m2 ^ "_" ^ string_of_int g1 ^ "_" ^ string_of_int g2) | G_SN4 (g1,g2) -> "gsn4_" ^ string_of_int g1 ^ "_" ^ string_of_int g2 | G_SN2SL2_1 (m1,m2,g1,g2) -> "gsl_" ^ string_of_int g1 ^ "_sl_" ^ string_of_int g1 ^ "_sl" ^ string_of_sfm m1 ^ "_" ^ string_of_int g2 ^ "_sl" ^ string_of_sfm m2 ^ "_" ^ string_of_int g2 | G_SN2SL2_2 (m1,m2,g1,g2) -> "gsl_" ^ string_of_int g1 ^ "_sl_" ^ string_of_int g2 ^ "_sl" ^ string_of_sfm m1 ^ "_" ^ string_of_int g1 ^ "_sl" ^ string_of_sfm m2 ^ "_" ^ string_of_int g2 ^ "_mix" | G_SF4 (f1,f2,m1,m2,m3,m4,g1,g2) -> "gsf" ^ string_of_sff f1 ^ string_of_sff f2 ^ string_of_sfm m1 ^ string_of_sfm m2 ^ string_of_sfm m3 ^ string_of_sfm m4 ^ string_of_int g1 ^ string_of_int g2 | G_SF4_3 (f1,f2,m1,m2,m3,m4,g1,g2,g3) -> "gsf" ^ string_of_sff f1 ^ string_of_sff f2 ^ string_of_sfm m1 ^ string_of_sfm m2 ^ string_of_sfm m3 ^ string_of_sfm m4 ^ string_of_int g1 ^ string_of_int g2 ^ "_" ^ string_of_int g3 | G_SF4_4 (f1,f2,m1,m2,m3,m4,g1,g2,g3,g4) -> "gsf" ^ string_of_sff f1 ^ string_of_sff f2 ^ string_of_sfm m1 ^ string_of_sfm m2 ^ string_of_sfm m3 ^ string_of_sfm m4 ^ string_of_int g1 ^ "_" ^ string_of_int g2 ^ string_of_int g3 ^ "_" ^ string_of_int g4 | G_SL4 (m1,m2,m3,m4,g) -> "gsl" ^ string_of_sfm m1 ^ "_" ^ "sl" ^ string_of_sfm m2 ^ "_" ^ "sl" ^ string_of_sfm m3 ^ "_" ^ "sl" ^ string_of_sfm m4 ^ "_" ^ string_of_int g | G_SL4_2 (m1,m2,m3,m4,g1,g2) -> "gsl" ^ string_of_sfm m1 ^ "_" ^ "sl" ^ string_of_sfm m2 ^ "_" ^ "sl" ^ string_of_sfm m3 ^ "_" ^ "sl" ^ string_of_sfm m4 ^ "_" ^ string_of_int g1 ^ "_" ^ string_of_int g2 | G_SN2SQ2 (f,m1,m2,g1,g2) -> "gsn_" ^ string_of_int g1 ^ "_sn_" ^ string_of_int g1 ^ "_" ^ string_of_sff f ^ string_of_sfm m1 ^ "_" ^ string_of_int g2 ^ "_" ^ string_of_sff f ^ string_of_sfm m2 ^ "_" ^ string_of_int g2 | G_SL2SQ2 (f,m1,m2,m3,m4,g1,g2) -> "gsl" ^ string_of_sfm m1 ^ "_" ^ string_of_int g1 ^ "_sl" ^ string_of_sfm m2 ^ "_" ^ string_of_int g1 ^ "_" ^ string_of_sff f ^ string_of_sfm m3 ^ "_" ^ string_of_int g2 ^ "_" ^ string_of_sff f ^ string_of_sfm m4 ^ "_" ^ string_of_int g2 | G_SUSDSNSL (vc,m1,m2,m3,g1,g2,g3) -> conj_symbol (vc, "gsl" ^ string_of_sfm m3 ^ "_" ^ string_of_int g3 ^ "_sn_" ^ string_of_int g3 ^ "_su" ^ string_of_sfm m1 ^ "_" ^ string_of_int g1 ^ "_sd" ^ string_of_sfm m2 ^ "_" ^ string_of_int g2) | G_SU4 (m1,m2,m3,m4,g) -> "gsu" ^ string_of_sfm m1 ^ "_" ^ "_su" ^ string_of_sfm m2 ^ "_" ^ "_su" ^ string_of_sfm m3 ^ "_" ^ "_su" ^ string_of_sfm m4 ^ "_" ^ string_of_int g | G_SU4_2 (m1,m2,m3,m4,g1,g2) -> "gsu" ^ string_of_sfm m1 ^ "_" ^ "_su" ^ string_of_sfm m2 ^ "_" ^ "_su" ^ string_of_sfm m3 ^ "_" ^ "_su" ^ string_of_sfm m4 ^ "_" ^ string_of_int g1 ^ "_" ^ string_of_int g2 | G_SD4 (m1,m2,m3,m4,g) -> "gsd" ^ string_of_sfm m1 ^ "_" ^ "_sd" ^ string_of_sfm m2 ^ "_" ^ "_sd" ^ string_of_sfm m3 ^ "_" ^ "_sd" ^ string_of_sfm m4 ^ "_" ^ string_of_int g | G_SD4_2 (m1,m2,m3,m4,g1,g2) -> "gsd" ^ string_of_sfm m1 ^ "_" ^ "_sd" ^ string_of_sfm m2 ^ "_" ^ "_sd" ^ string_of_sfm m3 ^ "_" ^ "_sd" ^ string_of_sfm m4 ^ "_" ^ string_of_int g1 ^ "_" ^ string_of_int g2 | G_SU2SD2 (m1,m2,m3,m4,g1,g2,g3,g4) -> "gsu" ^ string_of_sfm m1 ^ "_" ^ string_of_int g1 ^ "_su" ^ string_of_sfm m2 ^ "_" ^ string_of_int g2 ^ "_sd" ^ string_of_sfm m3 ^ "_" ^ string_of_int g3 ^ "_sd" ^ string_of_sfm m4 ^ "_" ^ string_of_int g4 | M f -> "mass" ^ flavor_symbol f | W f -> "width" ^ flavor_symbol f | G_Grav -> "ggrav" | G_Gr_Ch C1 -> "ggrch1" | G_Gr_Ch C2 -> "ggrch2" | G_Gr_Ch C1c -> "ggrch1c" | G_Gr_Ch C2c -> "ggrch2c" | G_Gr_Z_Neu n -> "ggrzneu" ^ string_of_neu n | G_Gr_A_Neu n -> "ggraneu" ^ string_of_neu n | G_Gr4_Neu n -> "ggr4neu" ^ string_of_neu n | G_Gr4_A_Ch C1 -> "ggr4ach1" | G_Gr4_A_Ch C2 -> "ggr4ach2" | G_Gr4_A_Ch C1c -> "ggr4ach1c" | G_Gr4_A_Ch C2c -> "ggr4ach2c" | G_Gr4_Z_Ch C1 -> "ggr4zch1" | G_Gr4_Z_Ch C2 -> "ggr4zch2" | G_Gr4_Z_Ch C1c -> "ggr4zch1c" | G_Gr4_Z_Ch C2c -> "ggr4zch2c" | G_Grav_N -> "ggravn" | G_GravGl -> "gs * ggrav" | G_Grav_L (g,m) -> "ggravl" ^ string_of_int g ^ string_of_sfm m | G_Grav_Lc (g,m) -> "ggravl" ^ string_of_int g ^ string_of_sfm m ^ "c" | G_Grav_U (g,m) -> "ggravu" ^ string_of_int g ^ string_of_sfm m | G_Grav_Uc (g,m) -> "ggravu" ^ string_of_int g ^ string_of_sfm m ^ "c" | G_Grav_D (g,m) -> "ggravd" ^ string_of_int g ^ string_of_sfm m | G_Grav_Dc (g,m) -> "ggravd" ^ string_of_int g ^ string_of_sfm m ^ "c" | G_Gr_H_Ch C1 -> "ggrhch1" | G_Gr_H_Ch C2 -> "ggrhch2" | G_Gr_H_Ch C1c -> "ggrhch1c" | G_Gr_H_Ch C2c -> "ggrhch2c" | G_Gr_H1_Neu n -> "ggrh1neu" ^ string_of_neu n | G_Gr_H2_Neu n -> "ggrh2neu" ^ string_of_neu n | G_Gr_H3_Neu n -> "ggrh3neu" ^ string_of_neu n | G_Gr4A_Sl (g,m) -> "ggr4asl" ^ string_of_int g ^ string_of_sfm m | G_Gr4A_Slc (g,m) -> "ggr4asl" ^ string_of_int g ^ string_of_sfm m ^ "c" | G_Gr4A_Su (g,m) -> "ggr4asu" ^ string_of_int g ^ string_of_sfm m | G_Gr4A_Suc (g,m) -> "ggr4asu" ^ string_of_int g ^ string_of_sfm m ^ "c" | G_Gr4A_Sd (g,m) -> "ggr4asd" ^ string_of_int g ^ string_of_sfm m | G_Gr4A_Sdc (g,m) -> "ggr4asd" ^ string_of_int g ^ string_of_sfm m ^ "c" | G_Gr4Z_Sn -> "ggr4zsn" | G_Gr4Z_Snc -> "ggr4zsnc" | G_Gr4Z_Sl (g,m) -> "ggr4zsl" ^ string_of_int g ^ string_of_sfm m | G_Gr4Z_Slc (g,m) -> "ggr4zsl" ^ string_of_int g ^ string_of_sfm m ^ "c" | G_Gr4Z_Su (g,m) -> "ggr4zsu" ^ string_of_int g ^ string_of_sfm m | G_Gr4Z_Suc (g,m) -> "ggr4zsu" ^ string_of_int g ^ string_of_sfm m ^ "c" | G_Gr4Z_Sd (g,m) -> "ggr4zsd" ^ string_of_int g ^ string_of_sfm m | G_Gr4Z_Sdc (g,m) -> "ggr4zsd" ^ string_of_int g ^ string_of_sfm m ^ "c" | G_Gr4W_Sl (g,m) -> "ggr4wsl" ^ string_of_int g ^ string_of_sfm m | G_Gr4W_Slc (g,m) -> "ggr4wsl" ^ string_of_int g ^ string_of_sfm m ^ "c" | G_Gr4W_Su (g,m) -> "ggr4wsu" ^ string_of_int g ^ string_of_sfm m | G_Gr4W_Suc (g,m) -> "ggr4wsu" ^ string_of_int g ^ string_of_sfm m ^ "c" | G_Gr4W_Sd (g,m) -> "ggr4wsd" ^ string_of_int g ^ string_of_sfm m | G_Gr4W_Sdc (g,m) -> "ggr4wsd" ^ string_of_int g ^ string_of_sfm m ^ "c" | G_Gr4Gl_Su (g,m) -> "ggr4glsu" ^ string_of_int g ^ string_of_sfm m | G_Gr4Gl_Suc (g,m) -> "ggr4glsu" ^ string_of_int g ^ string_of_sfm m ^ "c" | G_Gr4Gl_Sd (g,m) -> "ggr4glsd" ^ string_of_int g ^ string_of_sfm m | G_Gr4Gl_Sdc (g,m) -> "ggr4glsd" ^ string_of_int g ^ string_of_sfm m ^ "c" | G_Gr4_Z_H1 n -> "ggr4zh1_" ^ string_of_neu n | G_Gr4_Z_H2 n -> "ggr4zh2_" ^ string_of_neu n | G_Gr4_Z_H3 n -> "ggr4zh3_" ^ string_of_neu n | G_Gr4_W_H n -> "ggr4wh_" ^ string_of_neu n | G_Gr4_W_Hc n -> "ggr4whc_" ^ string_of_neu n | G_Gr4_H_A C1 -> "ggr4ha1" | G_Gr4_H_A C2 -> "ggr4ha2" | G_Gr4_H_A C1c -> "ggr4ha1c" | G_Gr4_H_A C2c -> "ggr4ha2c" | G_Gr4_H_Z C1 -> "ggr4hz1" | G_Gr4_H_Z C2 -> "ggr4hz2" | G_Gr4_H_Z C1c -> "ggr4hz1c" | G_Gr4_H_Z C2c -> "ggr4hz2c" | G_Gr4W_Sn -> "ggr4wsn" | G_Gr4W_Snc -> "ggr4wsnc" end (*i * Local Variables: * mode:caml * indent-tabs-mode:nil * page-delimiter:"^(\\* .*\n" * End: i*) Index: trunk/omega/src/targets.ml =================================================================== --- trunk/omega/src/targets.ml (revision 8230) +++ trunk/omega/src/targets.ml (revision 8231) @@ -1,8197 +1,8245 @@ (* 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"] (* This is part of OCaml 4.01. *) let (|>) fn x = x fn let (@@) fn x = fn x (* 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" 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: V3: not implemented" | Dim6_AHWW_DPB _ -> failwith "print_current: V3: not implemented" | Dim6_AHWW_DPW _ -> failwith "print_current: V3: not implemented" | Dim6_AHWW_DW _ -> failwith "print_current: V3: not implemented" | Dim6_Vector4_DW _ -> failwith "print_current: V3: not implemented" | Dim6_Vector4_W _ -> failwith "print_current: V3: not implemented" | Dim6_Scalar2_Vector2_D _ -> failwith "print_current: V3: not implemented" | Dim6_Scalar2_Vector2_DP _ -> failwith "print_current: V3: not implemented" | Dim6_HWWZ_DW _ -> failwith "print_current: V3: not implemented" | Dim6_HWWZ_DPB _ -> failwith "print_current: V3: not implemented" | Dim6_HWWZ_DDPW _ -> failwith "print_current: V3: not implemented" | Dim6_HWWZ_DPW _ -> failwith "print_current: V3: not implemented" | Dim6_AHHZ_D _ -> failwith "print_current: V3: not implemented" | Dim6_AHHZ_DP _ -> failwith "print_current: V3: not implemented" | Dim6_AHHZ_PB _ -> failwith "print_current: V3: not implemented" | Dim6_Scalar2_Vector2_PB _ -> failwith "print_current: V3: not implemented" | Dim6_HHZZ_T _ -> failwith "print_current: V3: 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!" 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 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"; "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: *) (* Default function to output spaces (copied from \texttt{format.ml}). *) let blank_line = String.make 80 ' ' let rec display_blanks oc n = if n > 0 then if n <= 80 then output oc blank_line 0 n else begin output oc blank_line 0 80; display_blanks oc (n - 80) end (* Default function to output new lines (copied from \texttt{format.ml}). *) let display_newline oc () = output oc "\n" 0 1 (* [current_continuation_line] \begin{itemize} \item $\le0$: not continuing: print a straight newline, \item $>0$: continuing: append [" &"] until we run up to [!continuation_lines]. NB: [!continuation_lines < 0] means \emph{unlimited} continuation lines. \end{itemize} *) let current_continuation_line = ref 1 exception Continuation_Lines of int let fortran_newline oc () = if !current_continuation_line > 0 then begin if !continuation_lines >= 0 && !current_continuation_line > !continuation_lines then raise (Continuation_Lines !current_continuation_line) else begin output oc " &" 0 2; incr current_continuation_line end end; display_newline oc () let nl () = current_continuation_line := 0; print_newline (); current_continuation_line := 1 (* Make a formatter with default functions to output spaces and new lines. *) let setup_fortran_formatter width oc = set_all_formatter_output_functions ~out:(output oc) ~flush:(fun () -> flush oc) ~newline:(fortran_newline oc) ~spaces:(display_blanks oc); set_margin (width - 2) 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:decl wf ^ "_X" ^ string_of_int i let multiple_variable ?(decl = false) amplitude dictionary wf = try format_multiple_variable ~decl:decl wf (dictionary amplitude wf) with | Not_found -> variable wf let multiple_variables ?(decl = false) multiplicity wf = try List.map (format_multiple_variable ~decl:decl wf) (ThoList.range 1 (multiplicity wf)) with | Not_found -> [variable ~decl: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 -> sprintf "cmplx (0.0_%s, 1.0_%s, kind=%s)" !kind !kind !kind | Const c when c < 0 -> sprintf "(%d.0_%s)" c !kind | Const c -> sprintf "%d.0_%s" c !kind | _ -> invalid_arg "format_constant" let rec eval_parameter' = function | I -> printf "cmplx (0.0_%s,@ 1.0_%s,@ kind=%s)" !kind !kind !kind | Const c when c < 0 -> printf "(%d.0_%s)" c !kind | Const c -> printf "%d.0_%s" c !kind | Atom x -> printf "%s" (CM.constant_symbol x) | Sum [] -> printf "0.0_%s" !kind | Sum [x] -> eval_parameter' x | Sum (x :: xs) -> printf "@,("; eval_parameter' x; List.iter (fun x -> printf "@, + "; eval_parameter' x) xs; printf ")" | Diff (x, y) -> printf "@,("; eval_parameter' x; printf " - "; eval_parameter' y; printf ")" | Neg x -> printf "@,( - "; eval_parameter' x; printf ")" | Prod [] -> printf "1.0_%s" !kind | Prod [x] -> eval_parameter' x | Prod (x :: xs) -> printf "@,("; eval_parameter' x; List.iter (fun x -> printf " * "; eval_parameter' x) xs; printf ")" | Quot (x, y) -> printf "@,("; eval_parameter' x; printf " / "; eval_parameter' y; printf ")" | Rec x -> printf "@, (1.0_%s / " !kind; eval_parameter' x; printf ")" | Pow (x, n) -> printf "@,("; eval_parameter' x; printf "**%d" n; printf ")" | Sqrt x -> printf "@,sqrt ("; eval_parameter' x; printf ")" | Sin x -> printf "@,sin ("; eval_parameter' x; printf ")" | Cos x -> printf "@,cos ("; eval_parameter' x; printf ")" | Tan x -> printf "@,tan ("; eval_parameter' x; printf ")" | Cot x -> printf "@,cot ("; eval_parameter' x; printf ")" | Atan2 (y, x) -> printf "@,atan2 ("; eval_parameter' y; printf ",@ "; eval_parameter' x; printf ")" | Conj x -> printf "@,conjg ("; eval_parameter' x; printf ")" let strip_single_tag = function | Real x -> x | Complex x -> x let strip_array_tag = function | Real_Array x -> x | Complex_Array x -> x let eval_parameter (lhs, rhs) = let x = CM.constant_symbol (strip_single_tag lhs) in printf " @[<2>%s = " x; eval_parameter' rhs; nl () let eval_para_list n l = printf " subroutine setup_parameters_%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 | Const _ -> 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) -> depends_on params e1 || depends_on params e2 | Neg e | Rec e | Pow (e, _) -> depends_on params e | Sqrt e | Sin e | Cos e | Tan e | Cot 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 = setup_fortran_formatter !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 "contains"; nl (); printf " ! derived parameters:"; nl (); let shredded = schisma_num 1 120 params.derived in let shredded_arrays = schisma_num 1 120 params.derived_arrays in let num_sub = List.length shredded in let num_sub_arrays = List.length shredded_arrays in 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 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 (* [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 - | _, Psibar, VLRM, Psi | _, Psibar, SPM, Psi - | _, Psibar, VAM, Psi | _, Psibar, VA3M, Psi - | _, Psibar, TVA, Psi | _, Psibar, TVAM, Psi - | _, Psibar, TLR, Psi | _, Psibar, TLRM, Psi - | _, Psibar, TRL, Psi | _, Psibar, TRLM, Psi -> + | _, _, (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. *) | 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 | 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 (* \begin{dubious} In principle, [p4] could be obtained from the left hand side \ldots \end{dubious} *) | DScalar4 contractions -> let p123 = Printf.sprintf "(-%s-%s-%s)" p1 p2 p3 in begin match contractions with | [] -> invalid_arg "Targets.print_current: DScalar4 []" | head :: tail -> printf "("; print_dscalar4 c wf1 wf2 wf3 p1 p2 p3 p123 fusion head; List.iter (print_add_dscalar4 c wf1 wf2 wf3 p1 p2 p3 p123 fusion) tail; printf ")" end | DScalar2_Vector2 contractions -> let p123 = Printf.sprintf "(-%s-%s-%s)" p1 p2 p3 in begin match contractions with | [] -> invalid_arg "Targets.print_current: DScalar4 []" | head :: tail -> printf "("; print_dscalar2_vector2 c wf1 wf2 wf3 p1 p2 p3 p123 fusion head; List.iter (print_add_dscalar2_vector2 c wf1 wf2 wf3 p1 p2 p3 p123 fusion) tail; printf ")" end end | Vn (_, _, _) -> invalid_arg "Targets.print_current: n-ary fusion" let print_propagator f p m gamma = let minus_third = "(-1.0_" ^ !kind ^ "/3.0_" ^ !kind ^ ")" in let w = begin match CM.width f with | Vanishing | Fudged -> "0.0_" ^ !kind | Constant | 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 "(" 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 "(" 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 "(" | _ -> 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} \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 (); printf "!"; nl (); ThoList.iteri (fun i cflow -> printf "! %3d: %s" i (cflow_to_string cflow); nl ()) 1 (CF.color_flows amplitudes); printf "!"; nl (); printf "! NB: i.g. not all color flows contribute to all flavor"; nl (); printf "! combinations. Consult the array FLV_COL_IS_ALLOWED"; nl (); printf "! below for the allowed combinations."; nl (); printf "!"; nl (); printf "! Color Factors:"; nl (); printf "!"; nl (); 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; 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 setup_fortran_formatter 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 !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 () and print_compute_brakets1 dictionary (n, processes) = 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 () (* \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 (); current_continuation_line := 0; 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); current_continuation_line := 1; 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 (); begin match CF.processes amplitudes with | p :: _ -> print_external_momenta p | _ -> () end; ignore (List.fold_left print_momenta PSet.empty (CF.processes amplitudes)); printf " amp = 0"; nl (); if num_helicities amplitudes > 0 then begin printf " 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; 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{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 setup_fortran_formatter !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 setup_fortran_formatter !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 !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 () in let print_compute_brakets (n, processes) () = 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 () 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 setup_fortran_formatter !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; 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/src/omegalib.nw =================================================================== --- trunk/omega/src/omegalib.nw (revision 8230) +++ trunk/omega/src/omegalib.nw (revision 8231) @@ -1,13953 +1,14097 @@ % -*- ess-noweb-default-code-mode: f90-mode; noweb-default-code-mode: f90-mode; -*- % omegalib.nw -- % % Copyright (C) 1999-2019 by % Wolfgang Kilian % Thorsten Ohl % Juergen Reuter % with contributions from % Fabian Bach % Bijan Chokoufe Nejad % Marco Sekulla % 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. % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @ \section{Trivia} <<[[omega_spinors.f90]]>>= <> module omega_spinors use kinds use constants implicit none private public :: operator (*), operator (+), operator (-) public :: abs <<[[intrinsic :: abs]]>> type, public :: conjspinor ! private (omegalib needs access, but DON'T TOUCH IT!) complex(kind=default), dimension(4) :: a end type conjspinor type, public :: spinor ! private (omegalib needs access, but DON'T TOUCH IT!) complex(kind=default), dimension(4) :: a end type spinor <> integer, parameter, public :: omega_spinors_2010_01_A = 0 contains <> end module omega_spinors @ <<[[intrinsic :: abs]] (if working)>>= intrinsic :: abs @ <<[[intrinsic :: conjg]] (if working)>>= intrinsic :: conjg @ well, the Intel Fortran Compiler chokes on these with an internal error: <<[[intrinsic :: abs]]>>= @ <<[[intrinsic :: conjg]]>>= @ To reenable the pure functions that have been removed for OpenMP, one should set this chunk to [[pure &]] <<[[pure]] unless OpenMP>>= @ \subsection{Inner Product} <>= interface operator (*) module procedure conjspinor_spinor end interface private :: conjspinor_spinor @ \begin{equation} \bar\psi\psi' \end{equation} NB: [[dot_product]] conjugates its first argument, we can either cancel this or inline [[dot_product]]: <>= pure function conjspinor_spinor (psibar, psi) result (psibarpsi) complex(kind=default) :: psibarpsi type(conjspinor), intent(in) :: psibar type(spinor), intent(in) :: psi psibarpsi = psibar%a(1)*psi%a(1) + psibar%a(2)*psi%a(2) & + psibar%a(3)*psi%a(3) + psibar%a(4)*psi%a(4) end function conjspinor_spinor @ \subsection{Spinor Vector Space} \subsubsection{Scalar Multiplication} <>= interface operator (*) module procedure integer_spinor, spinor_integer, & real_spinor, double_spinor, & complex_spinor, dcomplex_spinor, & spinor_real, spinor_double, & spinor_complex, spinor_dcomplex end interface private :: integer_spinor, spinor_integer, real_spinor, & double_spinor, complex_spinor, dcomplex_spinor, & spinor_real, spinor_double, spinor_complex, spinor_dcomplex @ <>= pure function integer_spinor (x, y) result (xy) integer, intent(in) :: x type(spinor), intent(in) :: y type(spinor) :: xy xy%a = x * y%a end function integer_spinor @ <>= pure function real_spinor (x, y) result (xy) real(kind=single), intent(in) :: x type(spinor), intent(in) :: y type(spinor) :: xy xy%a = x * y%a end function real_spinor pure function double_spinor (x, y) result (xy) real(kind=default), intent(in) :: x type(spinor), intent(in) :: y type(spinor) :: xy xy%a = x * y%a end function double_spinor pure function complex_spinor (x, y) result (xy) complex(kind=single), intent(in) :: x type(spinor), intent(in) :: y type(spinor) :: xy xy%a = x * y%a end function complex_spinor pure function dcomplex_spinor (x, y) result (xy) complex(kind=default), intent(in) :: x type(spinor), intent(in) :: y type(spinor) :: xy xy%a = x * y%a end function dcomplex_spinor pure function spinor_integer (y, x) result (xy) integer, intent(in) :: x type(spinor), intent(in) :: y type(spinor) :: xy xy%a = x * y%a end function spinor_integer pure function spinor_real (y, x) result (xy) real(kind=single), intent(in) :: x type(spinor), intent(in) :: y type(spinor) :: xy xy%a = x * y%a end function spinor_real pure function spinor_double (y, x) result (xy) real(kind=default), intent(in) :: x type(spinor), intent(in) :: y type(spinor) :: xy xy%a = x * y%a end function spinor_double pure function spinor_complex (y, x) result (xy) complex(kind=single), intent(in) :: x type(spinor), intent(in) :: y type(spinor) :: xy xy%a = x * y%a end function spinor_complex pure function spinor_dcomplex (y, x) result (xy) complex(kind=default), intent(in) :: x type(spinor), intent(in) :: y type(spinor) :: xy xy%a = x * y%a end function spinor_dcomplex @ <>= interface operator (*) module procedure integer_conjspinor, conjspinor_integer, & real_conjspinor, double_conjspinor, & complex_conjspinor, dcomplex_conjspinor, & conjspinor_real, conjspinor_double, & conjspinor_complex, conjspinor_dcomplex end interface private :: integer_conjspinor, conjspinor_integer, real_conjspinor, & double_conjspinor, complex_conjspinor, dcomplex_conjspinor, & conjspinor_real, conjspinor_double, conjspinor_complex, & conjspinor_dcomplex @ <>= pure function integer_conjspinor (x, y) result (xy) integer, intent(in) :: x type(conjspinor), intent(in) :: y type(conjspinor) :: xy xy%a = x * y%a end function integer_conjspinor pure function real_conjspinor (x, y) result (xy) real(kind=single), intent(in) :: x type(conjspinor), intent(in) :: y type(conjspinor) :: xy xy%a = x * y%a end function real_conjspinor pure function double_conjspinor (x, y) result (xy) real(kind=default), intent(in) :: x type(conjspinor), intent(in) :: y type(conjspinor) :: xy xy%a = x * y%a end function double_conjspinor pure function complex_conjspinor (x, y) result (xy) complex(kind=single), intent(in) :: x type(conjspinor), intent(in) :: y type(conjspinor) :: xy xy%a = x * y%a end function complex_conjspinor pure function dcomplex_conjspinor (x, y) result (xy) complex(kind=default), intent(in) :: x type(conjspinor), intent(in) :: y type(conjspinor) :: xy xy%a = x * y%a end function dcomplex_conjspinor pure function conjspinor_integer (y, x) result (xy) integer, intent(in) :: x type(conjspinor), intent(in) :: y type(conjspinor) :: xy xy%a = x * y%a end function conjspinor_integer pure function conjspinor_real (y, x) result (xy) real(kind=single), intent(in) :: x type(conjspinor), intent(in) :: y type(conjspinor) :: xy xy%a = x * y%a end function conjspinor_real pure function conjspinor_double (y, x) result (xy) real(kind=default), intent(in) :: x type(conjspinor), intent(in) :: y type(conjspinor) :: xy xy%a = x * y%a end function conjspinor_double pure function conjspinor_complex (y, x) result (xy) complex(kind=single), intent(in) :: x type(conjspinor), intent(in) :: y type(conjspinor) :: xy xy%a = x * y%a end function conjspinor_complex pure function conjspinor_dcomplex (y, x) result (xy) complex(kind=default), intent(in) :: x type(conjspinor), intent(in) :: y type(conjspinor) :: xy xy%a = x * y%a end function conjspinor_dcomplex @ \subsubsection{Unary Plus and Minus} <>= interface operator (+) module procedure plus_spinor, plus_conjspinor end interface private :: plus_spinor, plus_conjspinor interface operator (-) module procedure neg_spinor, neg_conjspinor end interface private :: neg_spinor, neg_conjspinor @ <>= pure function plus_spinor (x) result (plus_x) type(spinor), intent(in) :: x type(spinor) :: plus_x plus_x%a = x%a end function plus_spinor pure function neg_spinor (x) result (neg_x) type(spinor), intent(in) :: x type(spinor) :: neg_x neg_x%a = - x%a end function neg_spinor @ <>= pure function plus_conjspinor (x) result (plus_x) type(conjspinor), intent(in) :: x type(conjspinor) :: plus_x plus_x%a = x%a end function plus_conjspinor pure function neg_conjspinor (x) result (neg_x) type(conjspinor), intent(in) :: x type(conjspinor) :: neg_x neg_x%a = - x%a end function neg_conjspinor @ \subsubsection{Addition and Subtraction} <>= interface operator (+) module procedure add_spinor, add_conjspinor end interface private :: add_spinor, add_conjspinor interface operator (-) module procedure sub_spinor, sub_conjspinor end interface private :: sub_spinor, sub_conjspinor @ <>= pure function add_spinor (x, y) result (xy) type(spinor), intent(in) :: x, y type(spinor) :: xy xy%a = x%a + y%a end function add_spinor pure function sub_spinor (x, y) result (xy) type(spinor), intent(in) :: x, y type(spinor) :: xy xy%a = x%a - y%a end function sub_spinor @ <>= pure function add_conjspinor (x, y) result (xy) type(conjspinor), intent(in) :: x, y type(conjspinor) :: xy xy%a = x%a + y%a end function add_conjspinor pure function sub_conjspinor (x, y) result (xy) type(conjspinor), intent(in) :: x, y type(conjspinor) :: xy xy%a = x%a - y%a end function sub_conjspinor @ \subsection{Norm} <>= interface abs module procedure abs_spinor, abs_conjspinor end interface private :: abs_spinor, abs_conjspinor @ <>= pure function abs_spinor (psi) result (x) type(spinor), intent(in) :: psi real(kind=default) :: x x = sqrt (real (dot_product (psi%a, psi%a))) end function abs_spinor @ <>= pure function abs_conjspinor (psibar) result (x) real(kind=default) :: x type(conjspinor), intent(in) :: psibar x = sqrt (real (dot_product (psibar%a, psibar%a))) end function abs_conjspinor @ \section{Spinors Revisited} <<[[omega_bispinors.f90]]>>= <> module omega_bispinors use kinds use constants implicit none private public :: operator (*), operator (+), operator (-) public :: abs type, public :: bispinor ! private (omegalib needs access, but DON'T TOUCH IT!) complex(kind=default), dimension(4) :: a end type bispinor <> integer, parameter, public :: omega_bispinors_2010_01_A = 0 contains <> end module omega_bispinors @ <>= interface operator (*) module procedure spinor_product end interface private :: spinor_product @ \begin{equation} \bar\psi\psi' \end{equation} NB: [[dot_product]] conjugates its first argument, we have to cancel this. <>= pure function spinor_product (psil, psir) result (psilpsir) complex(kind=default) :: psilpsir type(bispinor), intent(in) :: psil, psir type(bispinor) :: psidum psidum%a(1) = psir%a(2) psidum%a(2) = - psir%a(1) psidum%a(3) = - psir%a(4) psidum%a(4) = psir%a(3) psilpsir = dot_product (conjg (psil%a), psidum%a) end function spinor_product @ \subsection{Spinor Vector Space} \subsubsection{Scalar Multiplication} <>= interface operator (*) module procedure integer_bispinor, bispinor_integer, & real_bispinor, double_bispinor, & complex_bispinor, dcomplex_bispinor, & bispinor_real, bispinor_double, & bispinor_complex, bispinor_dcomplex end interface private :: integer_bispinor, bispinor_integer, real_bispinor, & double_bispinor, complex_bispinor, dcomplex_bispinor, & bispinor_real, bispinor_double, bispinor_complex, bispinor_dcomplex @ <>= pure function integer_bispinor (x, y) result (xy) type(bispinor) :: xy integer, intent(in) :: x type(bispinor), intent(in) :: y xy%a = x * y%a end function integer_bispinor @ <>= pure function real_bispinor (x, y) result (xy) type(bispinor) :: xy real(kind=single), intent(in) :: x type(bispinor), intent(in) :: y xy%a = x * y%a end function real_bispinor @ <>= pure function double_bispinor (x, y) result (xy) type(bispinor) :: xy real(kind=default), intent(in) :: x type(bispinor), intent(in) :: y xy%a = x * y%a end function double_bispinor @ <>= pure function complex_bispinor (x, y) result (xy) type(bispinor) :: xy complex(kind=single), intent(in) :: x type(bispinor), intent(in) :: y xy%a = x * y%a end function complex_bispinor @ <>= pure function dcomplex_bispinor (x, y) result (xy) type(bispinor) :: xy complex(kind=default), intent(in) :: x type(bispinor), intent(in) :: y xy%a = x * y%a end function dcomplex_bispinor @ <>= pure function bispinor_integer (y, x) result (xy) type(bispinor) :: xy integer, intent(in) :: x type(bispinor), intent(in) :: y xy%a = x * y%a end function bispinor_integer @ <>= pure function bispinor_real (y, x) result (xy) type(bispinor) :: xy real(kind=single), intent(in) :: x type(bispinor), intent(in) :: y xy%a = x * y%a end function bispinor_real @ <>= pure function bispinor_double (y, x) result (xy) type(bispinor) :: xy real(kind=default), intent(in) :: x type(bispinor), intent(in) :: y xy%a = x * y%a end function bispinor_double @ <>= pure function bispinor_complex (y, x) result (xy) type(bispinor) :: xy complex(kind=single), intent(in) :: x type(bispinor), intent(in) :: y xy%a = x * y%a end function bispinor_complex @ <>= pure function bispinor_dcomplex (y, x) result (xy) type(bispinor) :: xy complex(kind=default), intent(in) :: x type(bispinor), intent(in) :: y xy%a = x * y%a end function bispinor_dcomplex @ \subsubsection{Unary Plus and Minus} <>= interface operator (+) module procedure plus_bispinor end interface private :: plus_bispinor interface operator (-) module procedure neg_bispinor end interface private :: neg_bispinor @ <>= pure function plus_bispinor (x) result (plus_x) type(bispinor) :: plus_x type(bispinor), intent(in) :: x plus_x%a = x%a end function plus_bispinor @ <>= pure function neg_bispinor (x) result (neg_x) type(bispinor) :: neg_x type(bispinor), intent(in) :: x neg_x%a = - x%a end function neg_bispinor @ \subsubsection{Addition and Subtraction} <>= interface operator (+) module procedure add_bispinor end interface private :: add_bispinor interface operator (-) module procedure sub_bispinor end interface private :: sub_bispinor @ <>= pure function add_bispinor (x, y) result (xy) type(bispinor) :: xy type(bispinor), intent(in) :: x, y xy%a = x%a + y%a end function add_bispinor @ <>= pure function sub_bispinor (x, y) result (xy) type(bispinor) :: xy type(bispinor), intent(in) :: x, y xy%a = x%a - y%a end function sub_bispinor @ \subsection{Norm} <>= interface abs module procedure abs_bispinor end interface private :: abs_bispinor @ <>= pure function abs_bispinor (psi) result (x) real(kind=default) :: x type(bispinor), intent(in) :: psi x = sqrt (real (dot_product (psi%a, psi%a))) end function abs_bispinor @ \section{Vectorspinors} <<[[omega_vectorspinors.f90]]>>= <> module omega_vectorspinors use kinds use constants use omega_bispinors use omega_vectors implicit none private public :: operator (*), operator (+), operator (-) public :: abs type, public :: vectorspinor ! private (omegalib needs access, but DON'T TOUCH IT!) type(bispinor), dimension(4) :: psi end type vectorspinor <> integer, parameter, public :: omega_vectorspinors_2010_01_A = 0 contains <> end module omega_vectorspinors @ <>= interface operator (*) module procedure vspinor_product end interface private :: vspinor_product @ \begin{equation} \bar\psi^\mu\psi'_\mu \end{equation} <>= pure function vspinor_product (psil, psir) result (psilpsir) complex(kind=default) :: psilpsir type(vectorspinor), intent(in) :: psil, psir psilpsir = psil%psi(1) * psir%psi(1) & - psil%psi(2) * psir%psi(2) & - psil%psi(3) * psir%psi(3) & - psil%psi(4) * psir%psi(4) end function vspinor_product @ \subsection{Vectorspinor Vector Space} \subsubsection{Scalar Multiplication} <>= interface operator (*) module procedure integer_vectorspinor, vectorspinor_integer, & real_vectorspinor, double_vectorspinor, & complex_vectorspinor, dcomplex_vectorspinor, & vectorspinor_real, vectorspinor_double, & vectorspinor_complex, vectorspinor_dcomplex, & momentum_vectorspinor, vectorspinor_momentum end interface private :: integer_vectorspinor, vectorspinor_integer, real_vectorspinor, & double_vectorspinor, complex_vectorspinor, dcomplex_vectorspinor, & vectorspinor_real, vectorspinor_double, vectorspinor_complex, & vectorspinor_dcomplex @ <>= pure function integer_vectorspinor (x, y) result (xy) type(vectorspinor) :: xy integer, intent(in) :: x type(vectorspinor), intent(in) :: y integer :: k do k = 1,4 xy%psi(k) = x * y%psi(k) end do end function integer_vectorspinor @ <>= pure function real_vectorspinor (x, y) result (xy) type(vectorspinor) :: xy real(kind=single), intent(in) :: x type(vectorspinor), intent(in) :: y integer :: k do k = 1,4 xy%psi(k) = x * y%psi(k) end do end function real_vectorspinor @ <>= pure function double_vectorspinor (x, y) result (xy) type(vectorspinor) :: xy real(kind=default), intent(in) :: x type(vectorspinor), intent(in) :: y integer :: k do k = 1,4 xy%psi(k) = x * y%psi(k) end do end function double_vectorspinor @ <>= pure function complex_vectorspinor (x, y) result (xy) type(vectorspinor) :: xy complex(kind=single), intent(in) :: x type(vectorspinor), intent(in) :: y integer :: k do k = 1,4 xy%psi(k) = x * y%psi(k) end do end function complex_vectorspinor @ <>= pure function dcomplex_vectorspinor (x, y) result (xy) type(vectorspinor) :: xy complex(kind=default), intent(in) :: x type(vectorspinor), intent(in) :: y integer :: k do k = 1,4 xy%psi(k) = x * y%psi(k) end do end function dcomplex_vectorspinor @ <>= pure function vectorspinor_integer (y, x) result (xy) type(vectorspinor) :: xy integer, intent(in) :: x type(vectorspinor), intent(in) :: y integer :: k do k = 1,4 xy%psi(k) = y%psi(k) * x end do end function vectorspinor_integer @ <>= pure function vectorspinor_real (y, x) result (xy) type(vectorspinor) :: xy real(kind=single), intent(in) :: x type(vectorspinor), intent(in) :: y integer :: k do k = 1,4 xy%psi(k) = y%psi(k) * x end do end function vectorspinor_real @ <>= pure function vectorspinor_double (y, x) result (xy) type(vectorspinor) :: xy real(kind=default), intent(in) :: x type(vectorspinor), intent(in) :: y integer :: k do k = 1,4 xy%psi(k) = y%psi(k) * x end do end function vectorspinor_double @ <>= pure function vectorspinor_complex (y, x) result (xy) type(vectorspinor) :: xy complex(kind=single), intent(in) :: x type(vectorspinor), intent(in) :: y integer :: k do k = 1,4 xy%psi(k) = y%psi(k) * x end do end function vectorspinor_complex @ <>= pure function vectorspinor_dcomplex (y, x) result (xy) type(vectorspinor) :: xy complex(kind=default), intent(in) :: x type(vectorspinor), intent(in) :: y integer :: k do k = 1,4 xy%psi(k) = y%psi(k) * x end do end function vectorspinor_dcomplex @ <>= pure function momentum_vectorspinor (y, x) result (xy) type(bispinor) :: xy type(momentum), intent(in) :: y type(vectorspinor), intent(in) :: x integer :: k do k = 1,4 xy%a(k) = y%t * x%psi(1)%a(k) - y%x(1) * x%psi(2)%a(k) - & y%x(2) * x%psi(3)%a(k) - y%x(3) * x%psi(4)%a(k) end do end function momentum_vectorspinor @ <>= pure function vectorspinor_momentum (y, x) result (xy) type(bispinor) :: xy type(momentum), intent(in) :: x type(vectorspinor), intent(in) :: y integer :: k do k = 1,4 xy%a(k) = x%t * y%psi(1)%a(k) - x%x(1) * y%psi(2)%a(k) - & x%x(2) * y%psi(3)%a(k) - x%x(3) * y%psi(4)%a(k) end do end function vectorspinor_momentum @ \subsubsection{Unary Plus and Minus} <>= interface operator (+) module procedure plus_vectorspinor end interface private :: plus_vectorspinor interface operator (-) module procedure neg_vectorspinor end interface private :: neg_vectorspinor @ <>= pure function plus_vectorspinor (x) result (plus_x) type(vectorspinor) :: plus_x type(vectorspinor), intent(in) :: x integer :: k do k = 1,4 plus_x%psi(k) = + x%psi(k) end do end function plus_vectorspinor @ <>= pure function neg_vectorspinor (x) result (neg_x) type(vectorspinor) :: neg_x type(vectorspinor), intent(in) :: x integer :: k do k = 1,4 neg_x%psi(k) = - x%psi(k) end do end function neg_vectorspinor @ \subsubsection{Addition and Subtraction} <>= interface operator (+) module procedure add_vectorspinor end interface private :: add_vectorspinor interface operator (-) module procedure sub_vectorspinor end interface private :: sub_vectorspinor @ <>= pure function add_vectorspinor (x, y) result (xy) type(vectorspinor) :: xy type(vectorspinor), intent(in) :: x, y integer :: k do k = 1,4 xy%psi(k) = x%psi(k) + y%psi(k) end do end function add_vectorspinor @ <>= pure function sub_vectorspinor (x, y) result (xy) type(vectorspinor) :: xy type(vectorspinor), intent(in) :: x, y integer :: k do k = 1,4 xy%psi(k) = x%psi(k) - y%psi(k) end do end function sub_vectorspinor @ \subsection{Norm} <>= interface abs module procedure abs_vectorspinor end interface private :: abs_vectorspinor @ <>= pure function abs_vectorspinor (psi) result (x) real(kind=default) :: x type(vectorspinor), intent(in) :: psi x = sqrt (real (dot_product (psi%psi(1)%a, psi%psi(1)%a) & - dot_product (psi%psi(2)%a, psi%psi(2)%a) & - dot_product (psi%psi(3)%a, psi%psi(3)%a) & - dot_product (psi%psi(4)%a, psi%psi(4)%a))) end function abs_vectorspinor @ \section{Vectors and Tensors} Condensed representation of antisymmetric rank-2 tensors: \begin{equation} \begin{pmatrix} T^{00} & T^{01} & T^{02} & T^{03} \\ T^{10} & T^{11} & T^{12} & T^{13} \\ T^{20} & T^{21} & T^{22} & T^{23} \\ T^{30} & T^{31} & T^{32} & T^{33} \end{pmatrix} = \begin{pmatrix} 0 & T_e^1 & T_e^2 & T_e^3 \\ -T_e^1 & 0 & T_b^3 & -T_b^2 \\ -T_e^2 & -T_b^3 & 0 & T_b^1 \\ -T_e^3 & T_b^2 & -T_b^1 & 0 \end{pmatrix} \end{equation} <<[[omega_vectors.f90]]>>= <> module omega_vectors use kinds use constants implicit none private public :: assignment (=), operator(==) public :: operator (*), operator (+), operator (-), operator (.wedge.) public :: abs, conjg public :: random_momentum <<[[intrinsic :: abs]]>> <<[[intrinsic :: conjg]]>> type, public :: momentum ! private (omegalib needs access, but DON'T TOUCH IT!) real(kind=default) :: t real(kind=default), dimension(3) :: x end type momentum type, public :: vector ! private (omegalib needs access, but DON'T TOUCH IT!) complex(kind=default) :: t complex(kind=default), dimension(3) :: x end type vector type, public :: tensor2odd ! private (omegalib needs access, but DON'T TOUCH IT!) complex(kind=default), dimension(3) :: e complex(kind=default), dimension(3) :: b end type tensor2odd <> integer, parameter, public :: omega_vectors_2010_01_A = 0 contains <> end module omega_vectors @ \subsection{Constructors} <>= interface assignment (=) module procedure momentum_of_array, vector_of_momentum, & vector_of_array, vector_of_double_array, & array_of_momentum, array_of_vector end interface private :: momentum_of_array, vector_of_momentum, vector_of_array, & vector_of_double_array, array_of_momentum, array_of_vector @ <>= pure subroutine momentum_of_array (m, p) type(momentum), intent(out) :: m real(kind=default), dimension(0:), intent(in) :: p m%t = p(0) m%x = p(1:3) end subroutine momentum_of_array pure subroutine array_of_momentum (p, v) real(kind=default), dimension(0:), intent(out) :: p type(momentum), intent(in) :: v p(0) = v%t p(1:3) = v%x end subroutine array_of_momentum @ <>= pure subroutine vector_of_array (v, p) type(vector), intent(out) :: v complex(kind=default), dimension(0:), intent(in) :: p v%t = p(0) v%x = p(1:3) end subroutine vector_of_array pure subroutine vector_of_double_array (v, p) type(vector), intent(out) :: v real(kind=default), dimension(0:), intent(in) :: p v%t = p(0) v%x = p(1:3) end subroutine vector_of_double_array pure subroutine array_of_vector (p, v) complex(kind=default), dimension(0:), intent(out) :: p type(vector), intent(in) :: v p(0) = v%t p(1:3) = v%x end subroutine array_of_vector @ <>= pure subroutine vector_of_momentum (v, p) type(vector), intent(out) :: v type(momentum), intent(in) :: p v%t = p%t v%x = p%x end subroutine vector_of_momentum @ <>= interface operator(==) module procedure momentum_eq end interface @ <>= elemental function momentum_eq (lhs, rhs) result (yorn) logical :: yorn type(momentum), intent(in) :: lhs type(momentum), intent(in) :: rhs yorn = all (abs(lhs%x - rhs%x) < eps0) .and. abs(lhs%t - rhs%t) < eps0 end function momentum_eq @ \subsection{Inner Products} <>= interface operator (*) module procedure momentum_momentum, vector_vector, & vector_momentum, momentum_vector, tensor2odd_tensor2odd end interface private :: momentum_momentum, vector_vector, vector_momentum, & momentum_vector, tensor2odd_tensor2odd @ <>= pure function momentum_momentum (x, y) result (xy) type(momentum), intent(in) :: x type(momentum), intent(in) :: y real(kind=default) :: xy xy = x%t*y%t - x%x(1)*y%x(1) - x%x(2)*y%x(2) - x%x(3)*y%x(3) end function momentum_momentum pure function momentum_vector (x, y) result (xy) type(momentum), intent(in) :: x type(vector), intent(in) :: y complex(kind=default) :: xy xy = x%t*y%t - x%x(1)*y%x(1) - x%x(2)*y%x(2) - x%x(3)*y%x(3) end function momentum_vector pure function vector_momentum (x, y) result (xy) type(vector), intent(in) :: x type(momentum), intent(in) :: y complex(kind=default) :: xy xy = x%t*y%t - x%x(1)*y%x(1) - x%x(2)*y%x(2) - x%x(3)*y%x(3) end function vector_momentum pure function vector_vector (x, y) result (xy) type(vector), intent(in) :: x type(vector), intent(in) :: y complex(kind=default) :: xy xy = x%t*y%t - x%x(1)*y%x(1) - x%x(2)*y%x(2) - x%x(3)*y%x(3) end function vector_vector @ Just like classical electrodynamics: \begin{equation} \frac{1}{2} T_{\mu\nu} U^{\mu\nu} = \frac{1}{2} \left( - T^{0i} U^{0i} - T^{i0} U^{i0} + T^{ij} U^{ij} \right) = T_b^k U_b^k - T_e^k U_e^k \end{equation} <>= pure function tensor2odd_tensor2odd (x, y) result (xy) type(tensor2odd), intent(in) :: x type(tensor2odd), intent(in) :: y complex(kind=default) :: xy xy = x%b(1)*y%b(1) + x%b(2)*y%b(2) + x%b(3)*y%b(3) & - x%e(1)*y%e(1) - x%e(2)*y%e(2) - x%e(3)*y%e(3) end function tensor2odd_tensor2odd @ \subsection{Not Entirely Inner Products} <>= interface operator (*) module procedure momentum_tensor2odd, tensor2odd_momentum, & vector_tensor2odd, tensor2odd_vector end interface private :: momentum_tensor2odd, tensor2odd_momentum, vector_tensor2odd, & tensor2odd_vector @ \begin{subequations} \begin{align} y^\nu = x_\mu T^{\mu\nu}: & y^0 = - x^i T^{i0} = x^i T^{0i} \\ & y^1 = x^0 T^{01} - x^2 T^{21} - x^3 T^{31} \\ & y^2 = x^0 T^{02} - x^1 T^{12} - x^3 T^{32} \\ & y^3 = x^0 T^{03} - x^1 T^{13} - x^2 T^{23} \end{align} \end{subequations} <>= pure function vector_tensor2odd (x, t2) result (xt2) type(vector), intent(in) :: x type(tensor2odd), intent(in) :: t2 type(vector) :: xt2 xt2%t = x%x(1)*t2%e(1) + x%x(2)*t2%e(2) + x%x(3)*t2%e(3) xt2%x(1) = x%t*t2%e(1) + x%x(2)*t2%b(3) - x%x(3)*t2%b(2) xt2%x(2) = x%t*t2%e(2) + x%x(3)*t2%b(1) - x%x(1)*t2%b(3) xt2%x(3) = x%t*t2%e(3) + x%x(1)*t2%b(2) - x%x(2)*t2%b(1) end function vector_tensor2odd pure function momentum_tensor2odd (x, t2) result (xt2) type(momentum), intent(in) :: x type(tensor2odd), intent(in) :: t2 type(vector) :: xt2 xt2%t = x%x(1)*t2%e(1) + x%x(2)*t2%e(2) + x%x(3)*t2%e(3) xt2%x(1) = x%t*t2%e(1) + x%x(2)*t2%b(3) - x%x(3)*t2%b(2) xt2%x(2) = x%t*t2%e(2) + x%x(3)*t2%b(1) - x%x(1)*t2%b(3) xt2%x(3) = x%t*t2%e(3) + x%x(1)*t2%b(2) - x%x(2)*t2%b(1) end function momentum_tensor2odd @ \begin{subequations} \begin{align} y^\mu = T^{\mu\nu} x_\nu : & y^0 = - T^{0i} x^i \\ & y^1 = T^{10} x^0 - T^{12} x^2 - T^{13} x^3 \\ & y^2 = T^{20} x^0 - T^{21} x^1 - T^{23} x^3 \\ & y^3 = T^{30} x^0 - T^{31} x^1 - T^{32} x^2 \end{align} \end{subequations} <>= pure function tensor2odd_vector (t2, x) result (t2x) type(tensor2odd), intent(in) :: t2 type(vector), intent(in) :: x type(vector) :: t2x t2x%t = - t2%e(1)*x%x(1) - t2%e(2)*x%x(2) - t2%e(3)*x%x(3) t2x%x(1) = - t2%e(1)*x%t + t2%b(2)*x%x(3) - t2%b(3)*x%x(2) t2x%x(2) = - t2%e(2)*x%t + t2%b(3)*x%x(1) - t2%b(1)*x%x(3) t2x%x(3) = - t2%e(3)*x%t + t2%b(1)*x%x(2) - t2%b(2)*x%x(1) end function tensor2odd_vector pure function tensor2odd_momentum (t2, x) result (t2x) type(tensor2odd), intent(in) :: t2 type(momentum), intent(in) :: x type(vector) :: t2x t2x%t = - t2%e(1)*x%x(1) - t2%e(2)*x%x(2) - t2%e(3)*x%x(3) t2x%x(1) = - t2%e(1)*x%t + t2%b(2)*x%x(3) - t2%b(3)*x%x(2) t2x%x(2) = - t2%e(2)*x%t + t2%b(3)*x%x(1) - t2%b(1)*x%x(3) t2x%x(3) = - t2%e(3)*x%t + t2%b(1)*x%x(2) - t2%b(2)*x%x(1) end function tensor2odd_momentum @ \subsection{Outer Products} <>= interface operator (.wedge.) module procedure momentum_wedge_momentum, & momentum_wedge_vector, vector_wedge_momentum, vector_wedge_vector end interface private :: momentum_wedge_momentum, momentum_wedge_vector, & vector_wedge_momentum, vector_wedge_vector @ <>= pure function momentum_wedge_momentum (x, y) result (t2) type(momentum), intent(in) :: x type(momentum), intent(in) :: y type(tensor2odd) :: t2 t2%e = x%t * y%x - x%x * y%t t2%b(1) = x%x(2) * y%x(3) - x%x(3) * y%x(2) t2%b(2) = x%x(3) * y%x(1) - x%x(1) * y%x(3) t2%b(3) = x%x(1) * y%x(2) - x%x(2) * y%x(1) end function momentum_wedge_momentum pure function momentum_wedge_vector (x, y) result (t2) type(momentum), intent(in) :: x type(vector), intent(in) :: y type(tensor2odd) :: t2 t2%e = x%t * y%x - x%x * y%t t2%b(1) = x%x(2) * y%x(3) - x%x(3) * y%x(2) t2%b(2) = x%x(3) * y%x(1) - x%x(1) * y%x(3) t2%b(3) = x%x(1) * y%x(2) - x%x(2) * y%x(1) end function momentum_wedge_vector pure function vector_wedge_momentum (x, y) result (t2) type(vector), intent(in) :: x type(momentum), intent(in) :: y type(tensor2odd) :: t2 t2%e = x%t * y%x - x%x * y%t t2%b(1) = x%x(2) * y%x(3) - x%x(3) * y%x(2) t2%b(2) = x%x(3) * y%x(1) - x%x(1) * y%x(3) t2%b(3) = x%x(1) * y%x(2) - x%x(2) * y%x(1) end function vector_wedge_momentum pure function vector_wedge_vector (x, y) result (t2) type(vector), intent(in) :: x type(vector), intent(in) :: y type(tensor2odd) :: t2 t2%e = x%t * y%x - x%x * y%t t2%b(1) = x%x(2) * y%x(3) - x%x(3) * y%x(2) t2%b(2) = x%x(3) * y%x(1) - x%x(1) * y%x(3) t2%b(3) = x%x(1) * y%x(2) - x%x(2) * y%x(1) end function vector_wedge_vector @ \subsection{Vector Space} \subsubsection{Scalar Multiplication} <>= interface operator (*) module procedure integer_momentum, real_momentum, double_momentum, & complex_momentum, dcomplex_momentum, & integer_vector, real_vector, double_vector, & complex_vector, dcomplex_vector, & integer_tensor2odd, real_tensor2odd, double_tensor2odd, & complex_tensor2odd, dcomplex_tensor2odd, & momentum_integer, momentum_real, momentum_double, & momentum_complex, momentum_dcomplex, & vector_integer, vector_real, vector_double, & vector_complex, vector_dcomplex, & tensor2odd_integer, tensor2odd_real, tensor2odd_double, & tensor2odd_complex, tensor2odd_dcomplex end interface private :: integer_momentum, real_momentum, double_momentum, & complex_momentum, dcomplex_momentum, integer_vector, real_vector, & double_vector, complex_vector, dcomplex_vector, & integer_tensor2odd, real_tensor2odd, double_tensor2odd, & complex_tensor2odd, dcomplex_tensor2odd, momentum_integer, & momentum_real, momentum_double, momentum_complex, & momentum_dcomplex, vector_integer, vector_real, vector_double, & vector_complex, vector_dcomplex, tensor2odd_integer, & tensor2odd_real, tensor2odd_double, tensor2odd_complex, & tensor2odd_dcomplex @ <>= pure function integer_momentum (x, y) result (xy) integer, intent(in) :: x type(momentum), intent(in) :: y type(momentum) :: xy xy%t = x * y%t xy%x = x * y%x end function integer_momentum pure function real_momentum (x, y) result (xy) real(kind=single), intent(in) :: x type(momentum), intent(in) :: y type(momentum) :: xy xy%t = x * y%t xy%x = x * y%x end function real_momentum pure function double_momentum (x, y) result (xy) real(kind=default), intent(in) :: x type(momentum), intent(in) :: y type(momentum) :: xy xy%t = x * y%t xy%x = x * y%x end function double_momentum pure function complex_momentum (x, y) result (xy) complex(kind=single), intent(in) :: x type(momentum), intent(in) :: y type(vector) :: xy xy%t = x * y%t xy%x = x * y%x end function complex_momentum pure function dcomplex_momentum (x, y) result (xy) complex(kind=default), intent(in) :: x type(momentum), intent(in) :: y type(vector) :: xy xy%t = x * y%t xy%x = x * y%x end function dcomplex_momentum @ <>= pure function integer_vector (x, y) result (xy) integer, intent(in) :: x type(vector), intent(in) :: y type(vector) :: xy xy%t = x * y%t xy%x = x * y%x end function integer_vector pure function real_vector (x, y) result (xy) real(kind=single), intent(in) :: x type(vector), intent(in) :: y type(vector) :: xy xy%t = x * y%t xy%x = x * y%x end function real_vector pure function double_vector (x, y) result (xy) real(kind=default), intent(in) :: x type(vector), intent(in) :: y type(vector) :: xy xy%t = x * y%t xy%x = x * y%x end function double_vector pure function complex_vector (x, y) result (xy) complex(kind=single), intent(in) :: x type(vector), intent(in) :: y type(vector) :: xy xy%t = x * y%t xy%x = x * y%x end function complex_vector pure function dcomplex_vector (x, y) result (xy) complex(kind=default), intent(in) :: x type(vector), intent(in) :: y type(vector) :: xy xy%t = x * y%t xy%x = x * y%x end function dcomplex_vector @ <>= pure function integer_tensor2odd (x, t2) result (xt2) integer, intent(in) :: x type(tensor2odd), intent(in) :: t2 type(tensor2odd) :: xt2 xt2%e = x * t2%e xt2%b = x * t2%b end function integer_tensor2odd pure function real_tensor2odd (x, t2) result (xt2) real(kind=single), intent(in) :: x type(tensor2odd), intent(in) :: t2 type(tensor2odd) :: xt2 xt2%e = x * t2%e xt2%b = x * t2%b end function real_tensor2odd pure function double_tensor2odd (x, t2) result (xt2) real(kind=default), intent(in) :: x type(tensor2odd), intent(in) :: t2 type(tensor2odd) :: xt2 xt2%e = x * t2%e xt2%b = x * t2%b end function double_tensor2odd pure function complex_tensor2odd (x, t2) result (xt2) complex(kind=single), intent(in) :: x type(tensor2odd), intent(in) :: t2 type(tensor2odd) :: xt2 xt2%e = x * t2%e xt2%b = x * t2%b end function complex_tensor2odd pure function dcomplex_tensor2odd (x, t2) result (xt2) complex(kind=default), intent(in) :: x type(tensor2odd), intent(in) :: t2 type(tensor2odd) :: xt2 xt2%e = x * t2%e xt2%b = x * t2%b end function dcomplex_tensor2odd @ <>= pure function momentum_integer (y, x) result (xy) integer, intent(in) :: x type(momentum), intent(in) :: y type(momentum) :: xy xy%t = x * y%t xy%x = x * y%x end function momentum_integer pure function momentum_real (y, x) result (xy) real(kind=single), intent(in) :: x type(momentum), intent(in) :: y type(momentum) :: xy xy%t = x * y%t xy%x = x * y%x end function momentum_real pure function momentum_double (y, x) result (xy) real(kind=default), intent(in) :: x type(momentum), intent(in) :: y type(momentum) :: xy xy%t = x * y%t xy%x = x * y%x end function momentum_double pure function momentum_complex (y, x) result (xy) complex(kind=single), intent(in) :: x type(momentum), intent(in) :: y type(vector) :: xy xy%t = x * y%t xy%x = x * y%x end function momentum_complex pure function momentum_dcomplex (y, x) result (xy) complex(kind=default), intent(in) :: x type(momentum), intent(in) :: y type(vector) :: xy xy%t = x * y%t xy%x = x * y%x end function momentum_dcomplex @ <>= pure function vector_integer (y, x) result (xy) integer, intent(in) :: x type(vector), intent(in) :: y type(vector) :: xy xy%t = x * y%t xy%x = x * y%x end function vector_integer pure function vector_real (y, x) result (xy) real(kind=single), intent(in) :: x type(vector), intent(in) :: y type(vector) :: xy xy%t = x * y%t xy%x = x * y%x end function vector_real pure function vector_double (y, x) result (xy) real(kind=default), intent(in) :: x type(vector), intent(in) :: y type(vector) :: xy xy%t = x * y%t xy%x = x * y%x end function vector_double pure function vector_complex (y, x) result (xy) complex(kind=single), intent(in) :: x type(vector), intent(in) :: y type(vector) :: xy xy%t = x * y%t xy%x = x * y%x end function vector_complex pure function vector_dcomplex (y, x) result (xy) complex(kind=default), intent(in) :: x type(vector), intent(in) :: y type(vector) :: xy xy%t = x * y%t xy%x = x * y%x end function vector_dcomplex @ <>= pure function tensor2odd_integer (t2, x) result (t2x) type(tensor2odd), intent(in) :: t2 integer, intent(in) :: x type(tensor2odd) :: t2x t2x%e = x * t2%e t2x%b = x * t2%b end function tensor2odd_integer pure function tensor2odd_real (t2, x) result (t2x) type(tensor2odd), intent(in) :: t2 real(kind=single), intent(in) :: x type(tensor2odd) :: t2x t2x%e = x * t2%e t2x%b = x * t2%b end function tensor2odd_real pure function tensor2odd_double (t2, x) result (t2x) type(tensor2odd), intent(in) :: t2 real(kind=default), intent(in) :: x type(tensor2odd) :: t2x t2x%e = x * t2%e t2x%b = x * t2%b end function tensor2odd_double pure function tensor2odd_complex (t2, x) result (t2x) type(tensor2odd), intent(in) :: t2 complex(kind=single), intent(in) :: x type(tensor2odd) :: t2x t2x%e = x * t2%e t2x%b = x * t2%b end function tensor2odd_complex pure function tensor2odd_dcomplex (t2, x) result (t2x) type(tensor2odd), intent(in) :: t2 complex(kind=default), intent(in) :: x type(tensor2odd) :: t2x t2x%e = x * t2%e t2x%b = x * t2%b end function tensor2odd_dcomplex @ \subsubsection{Unary Plus and Minus} <>= interface operator (+) module procedure plus_momentum, plus_vector, plus_tensor2odd end interface private :: plus_momentum, plus_vector, plus_tensor2odd interface operator (-) module procedure neg_momentum, neg_vector, neg_tensor2odd end interface private :: neg_momentum, neg_vector, neg_tensor2odd @ <>= pure function plus_momentum (x) result (plus_x) type(momentum), intent(in) :: x type(momentum) :: plus_x plus_x = x end function plus_momentum pure function neg_momentum (x) result (neg_x) type(momentum), intent(in) :: x type(momentum) :: neg_x neg_x%t = - x%t neg_x%x = - x%x end function neg_momentum @ <>= pure function plus_vector (x) result (plus_x) type(vector), intent(in) :: x type(vector) :: plus_x plus_x = x end function plus_vector pure function neg_vector (x) result (neg_x) type(vector), intent(in) :: x type(vector) :: neg_x neg_x%t = - x%t neg_x%x = - x%x end function neg_vector @ <>= pure function plus_tensor2odd (x) result (plus_x) type(tensor2odd), intent(in) :: x type(tensor2odd) :: plus_x plus_x = x end function plus_tensor2odd pure function neg_tensor2odd (x) result (neg_x) type(tensor2odd), intent(in) :: x type(tensor2odd) :: neg_x neg_x%e = - x%e neg_x%b = - x%b end function neg_tensor2odd @ \subsubsection{Addition and Subtraction} <>= interface operator (+) module procedure add_momentum, add_vector, & add_vector_momentum, add_momentum_vector, add_tensor2odd end interface private :: add_momentum, add_vector, add_vector_momentum, & add_momentum_vector, add_tensor2odd interface operator (-) module procedure sub_momentum, sub_vector, & sub_vector_momentum, sub_momentum_vector, sub_tensor2odd end interface private :: sub_momentum, sub_vector, sub_vector_momentum, & sub_momentum_vector, sub_tensor2odd @ <>= pure function add_momentum (x, y) result (xy) type(momentum), intent(in) :: x, y type(momentum) :: xy xy%t = x%t + y%t xy%x = x%x + y%x end function add_momentum pure function add_vector (x, y) result (xy) type(vector), intent(in) :: x, y type(vector) :: xy xy%t = x%t + y%t xy%x = x%x + y%x end function add_vector pure function add_momentum_vector (x, y) result (xy) type(momentum), intent(in) :: x type(vector), intent(in) :: y type(vector) :: xy xy%t = x%t + y%t xy%x = x%x + y%x end function add_momentum_vector pure function add_vector_momentum (x, y) result (xy) type(vector), intent(in) :: x type(momentum), intent(in) :: y type(vector) :: xy xy%t = x%t + y%t xy%x = x%x + y%x end function add_vector_momentum pure function add_tensor2odd (x, y) result (xy) type(tensor2odd), intent(in) :: x, y type(tensor2odd) :: xy xy%e = x%e + y%e xy%b = x%b + y%b end function add_tensor2odd @ <>= pure function sub_momentum (x, y) result (xy) type(momentum), intent(in) :: x, y type(momentum) :: xy xy%t = x%t - y%t xy%x = x%x - y%x end function sub_momentum pure function sub_vector (x, y) result (xy) type(vector), intent(in) :: x, y type(vector) :: xy xy%t = x%t - y%t xy%x = x%x - y%x end function sub_vector pure function sub_momentum_vector (x, y) result (xy) type(momentum), intent(in) :: x type(vector), intent(in) :: y type(vector) :: xy xy%t = x%t - y%t xy%x = x%x - y%x end function sub_momentum_vector pure function sub_vector_momentum (x, y) result (xy) type(vector), intent(in) :: x type(momentum), intent(in) :: y type(vector) :: xy xy%t = x%t - y%t xy%x = x%x - y%x end function sub_vector_momentum pure function sub_tensor2odd (x, y) result (xy) type(tensor2odd), intent(in) :: x, y type(tensor2odd) :: xy xy%e = x%e - y%e xy%b = x%b - y%b end function sub_tensor2odd @ \subsection{Norm} \emph{Not} the covariant length! <>= interface abs module procedure abs_momentum, abs_vector, abs_tensor2odd end interface private :: abs_momentum, abs_vector, abs_tensor2odd @ <>= pure function abs_momentum (x) result (absx) type(momentum), intent(in) :: x real(kind=default) :: absx absx = sqrt (real (x%t*x%t + dot_product (x%x, x%x))) end function abs_momentum pure function abs_vector (x) result (absx) type(vector), intent(in) :: x real(kind=default) :: absx absx = sqrt (real (conjg(x%t)*x%t + dot_product (x%x, x%x))) end function abs_vector pure function abs_tensor2odd (x) result (absx) type(tensor2odd), intent(in) :: x real(kind=default) :: absx absx = sqrt (real (dot_product (x%e, x%e) + dot_product (x%b, x%b))) end function abs_tensor2odd @ \subsection{Conjugation} <>= interface conjg module procedure conjg_momentum, conjg_vector, conjg_tensor2odd end interface private :: conjg_momentum, conjg_vector, conjg_tensor2odd @ <>= pure function conjg_momentum (x) result (conjg_x) type(momentum), intent(in) :: x type(momentum) :: conjg_x conjg_x = x end function conjg_momentum pure function conjg_vector (x) result (conjg_x) type(vector), intent(in) :: x type(vector) :: conjg_x conjg_x%t = conjg (x%t) conjg_x%x = conjg (x%x) end function conjg_vector pure function conjg_tensor2odd (t2) result (conjg_t2) type(tensor2odd), intent(in) :: t2 type(tensor2odd) :: conjg_t2 conjg_t2%e = conjg (t2%e) conjg_t2%b = conjg (t2%b) end function conjg_tensor2odd @ \subsection{$\epsilon$-Tensors} \begin{equation} \epsilon_{0123} = 1 = - \epsilon^{0123} \end{equation} in particular \begin{equation} \epsilon(p_1,p_2,p_3,p_4) = \epsilon_{\mu_1\mu_2\mu_3\mu_4} p_1^{\mu_1}p_2^{\mu_2}p_3^{\mu_3}p_4^{\mu_4} = p_1^0 p_2^1 p_3^2 p_4^3 \pm \ldots \end{equation} <>= interface pseudo_scalar module procedure pseudo_scalar_momentum, pseudo_scalar_vector, & pseudo_scalar_vec_mom end interface public :: pseudo_scalar private :: pseudo_scalar_momentum, pseudo_scalar_vector @ <>= pure function pseudo_scalar_momentum (p1, p2, p3, p4) result (eps1234) type(momentum), intent(in) :: p1, p2, p3, p4 real(kind=default) :: eps1234 eps1234 = & p1%t * p2%x(1) * (p3%x(2) * p4%x(3) - p3%x(3) * p4%x(2)) & + p1%t * p2%x(2) * (p3%x(3) * p4%x(1) - p3%x(1) * p4%x(3)) & + p1%t * p2%x(3) * (p3%x(1) * p4%x(2) - p3%x(2) * p4%x(1)) & - p1%x(1) * p2%x(2) * (p3%x(3) * p4%t - p3%t * p4%x(3)) & - p1%x(1) * p2%x(3) * (p3%t * p4%x(2) - p3%x(2) * p4%t ) & - p1%x(1) * p2%t * (p3%x(2) * p4%x(3) - p3%x(3) * p4%x(2)) & + p1%x(2) * p2%x(3) * (p3%t * p4%x(1) - p3%x(1) * p4%t ) & + p1%x(2) * p2%t * (p3%x(1) * p4%x(3) - p3%x(3) * p4%x(1)) & + p1%x(2) * p2%x(1) * (p3%x(3) * p4%t - p3%t * p4%x(3)) & - p1%x(3) * p2%t * (p3%x(1) * p4%x(2) - p3%x(2) * p4%x(1)) & - p1%x(3) * p2%x(1) * (p3%x(2) * p4%t - p3%t * p4%x(2)) & - p1%x(3) * p2%x(2) * (p3%t * p4%x(1) - p3%x(1) * p4%t ) end function pseudo_scalar_momentum @ <>= pure function pseudo_scalar_vector (p1, p2, p3, p4) result (eps1234) type(vector), intent(in) :: p1, p2, p3, p4 complex(kind=default) :: eps1234 eps1234 = & p1%t * p2%x(1) * (p3%x(2) * p4%x(3) - p3%x(3) * p4%x(2)) & + p1%t * p2%x(2) * (p3%x(3) * p4%x(1) - p3%x(1) * p4%x(3)) & + p1%t * p2%x(3) * (p3%x(1) * p4%x(2) - p3%x(2) * p4%x(1)) & - p1%x(1) * p2%x(2) * (p3%x(3) * p4%t - p3%t * p4%x(3)) & - p1%x(1) * p2%x(3) * (p3%t * p4%x(2) - p3%x(2) * p4%t ) & - p1%x(1) * p2%t * (p3%x(2) * p4%x(3) - p3%x(3) * p4%x(2)) & + p1%x(2) * p2%x(3) * (p3%t * p4%x(1) - p3%x(1) * p4%t ) & + p1%x(2) * p2%t * (p3%x(1) * p4%x(3) - p3%x(3) * p4%x(1)) & + p1%x(2) * p2%x(1) * (p3%x(3) * p4%t - p3%t * p4%x(3)) & - p1%x(3) * p2%t * (p3%x(1) * p4%x(2) - p3%x(2) * p4%x(1)) & - p1%x(3) * p2%x(1) * (p3%x(2) * p4%t - p3%t * p4%x(2)) & - p1%x(3) * p2%x(2) * (p3%t * p4%x(1) - p3%x(1) * p4%t ) end function pseudo_scalar_vector @ <>= pure function pseudo_scalar_vec_mom (p1, v1, p2, v2) result (eps1234) type(momentum), intent(in) :: p1, p2 type(vector), intent(in) :: v1, v2 complex(kind=default) :: eps1234 eps1234 = & p1%t * v1%x(1) * (p2%x(2) * v2%x(3) - p2%x(3) * v2%x(2)) & + p1%t * v1%x(2) * (p2%x(3) * v2%x(1) - p2%x(1) * v2%x(3)) & + p1%t * v1%x(3) * (p2%x(1) * v2%x(2) - p2%x(2) * v2%x(1)) & - p1%x(1) * v1%x(2) * (p2%x(3) * v2%t - p2%t * v2%x(3)) & - p1%x(1) * v1%x(3) * (p2%t * v2%x(2) - p2%x(2) * v2%t ) & - p1%x(1) * v1%t * (p2%x(2) * v2%x(3) - p2%x(3) * v2%x(2)) & + p1%x(2) * v1%x(3) * (p2%t * v2%x(1) - p2%x(1) * v2%t ) & + p1%x(2) * v1%t * (p2%x(1) * v2%x(3) - p2%x(3) * v2%x(1)) & + p1%x(2) * v1%x(1) * (p2%x(3) * v2%t - p2%t * v2%x(3)) & - p1%x(3) * v1%t * (p2%x(1) * v2%x(2) - p2%x(2) * v2%x(1)) & - p1%x(3) * v1%x(1) * (p2%x(2) * v2%t - p2%t * v2%x(2)) & - p1%x(3) * v1%x(2) * (p2%t * v2%x(1) - p2%x(1) * v2%t ) end function pseudo_scalar_vec_mom @ \begin{equation} \epsilon_\mu(p_1,p_2,p_3) = \epsilon_{\mu\mu_1\mu_2\mu_3} p_1^{\mu_1}p_2^{\mu_2}p_3^{\mu_3} \end{equation} i.\,e. \begin{subequations} \begin{align} \epsilon_0(p_1,p_2,p_3) &= p_1^1 p_2^2 p_3^3 \pm \ldots \\ \epsilon_1(p_1,p_2,p_3) &= p_1^2 p_2^3 p_3^0 \pm \ldots \\ \epsilon_2(p_1,p_2,p_3) &= - p_1^3 p_2^0 p_3^1 \pm \ldots \\ \epsilon_3(p_1,p_2,p_3) &= p_1^0 p_2^1 p_3^2 \pm \ldots \end{align} \end{subequations} <>= interface pseudo_vector module procedure pseudo_vector_momentum, pseudo_vector_vector, & pseudo_vector_vec_mom end interface public :: pseudo_vector private :: pseudo_vector_momentum, pseudo_vector_vector @ <>= pure function pseudo_vector_momentum (p1, p2, p3) result (eps123) type(momentum), intent(in) :: p1, p2, p3 type(momentum) :: eps123 eps123%t = & + p1%x(1) * (p2%x(2) * p3%x(3) - p2%x(3) * p3%x(2)) & + p1%x(2) * (p2%x(3) * p3%x(1) - p2%x(1) * p3%x(3)) & + p1%x(3) * (p2%x(1) * p3%x(2) - p2%x(2) * p3%x(1)) eps123%x(1) = & + p1%x(2) * (p2%x(3) * p3%t - p2%t * p3%x(3)) & + p1%x(3) * (p2%t * p3%x(2) - p2%x(2) * p3%t ) & + p1%t * (p2%x(2) * p3%x(3) - p2%x(3) * p3%x(2)) eps123%x(2) = & - p1%x(3) * (p2%t * p3%x(1) - p2%x(1) * p3%t ) & - p1%t * (p2%x(1) * p3%x(3) - p2%x(3) * p3%x(1)) & - p1%x(1) * (p2%x(3) * p3%t - p2%t * p3%x(3)) eps123%x(3) = & + p1%t * (p2%x(1) * p3%x(2) - p2%x(2) * p3%x(1)) & + p1%x(1) * (p2%x(2) * p3%t - p2%t * p3%x(2)) & + p1%x(2) * (p2%t * p3%x(1) - p2%x(1) * p3%t ) end function pseudo_vector_momentum @ <>= pure function pseudo_vector_vector (p1, p2, p3) result (eps123) type(vector), intent(in) :: p1, p2, p3 type(vector) :: eps123 eps123%t = & + p1%x(1) * (p2%x(2) * p3%x(3) - p2%x(3) * p3%x(2)) & + p1%x(2) * (p2%x(3) * p3%x(1) - p2%x(1) * p3%x(3)) & + p1%x(3) * (p2%x(1) * p3%x(2) - p2%x(2) * p3%x(1)) eps123%x(1) = & + p1%x(2) * (p2%x(3) * p3%t - p2%t * p3%x(3)) & + p1%x(3) * (p2%t * p3%x(2) - p2%x(2) * p3%t ) & + p1%t * (p2%x(2) * p3%x(3) - p2%x(3) * p3%x(2)) eps123%x(2) = & - p1%x(3) * (p2%t * p3%x(1) - p2%x(1) * p3%t ) & - p1%t * (p2%x(1) * p3%x(3) - p2%x(3) * p3%x(1)) & - p1%x(1) * (p2%x(3) * p3%t - p2%t * p3%x(3)) eps123%x(3) = & + p1%t * (p2%x(1) * p3%x(2) - p2%x(2) * p3%x(1)) & + p1%x(1) * (p2%x(2) * p3%t - p2%t * p3%x(2)) & + p1%x(2) * (p2%t * p3%x(1) - p2%x(1) * p3%t ) end function pseudo_vector_vector @ <>= pure function pseudo_vector_vec_mom (p1, p2, v) result (eps123) type(momentum), intent(in) :: p1, p2 type(vector), intent(in) :: v type(vector) :: eps123 eps123%t = & + p1%x(1) * (p2%x(2) * v%x(3) - p2%x(3) * v%x(2)) & + p1%x(2) * (p2%x(3) * v%x(1) - p2%x(1) * v%x(3)) & + p1%x(3) * (p2%x(1) * v%x(2) - p2%x(2) * v%x(1)) eps123%x(1) = & + p1%x(2) * (p2%x(3) * v%t - p2%t * v%x(3)) & + p1%x(3) * (p2%t * v%x(2) - p2%x(2) * v%t ) & + p1%t * (p2%x(2) * v%x(3) - p2%x(3) * v%x(2)) eps123%x(2) = & - p1%x(3) * (p2%t * v%x(1) - p2%x(1) * v%t ) & - p1%t * (p2%x(1) * v%x(3) - p2%x(3) * v%x(1)) & - p1%x(1) * (p2%x(3) * v%t - p2%t * v%x(3)) eps123%x(3) = & + p1%t * (p2%x(1) * v%x(2) - p2%x(2) * v%x(1)) & + p1%x(1) * (p2%x(2) * v%t - p2%t * v%x(2)) & + p1%x(2) * (p2%t * v%x(1) - p2%x(1) * v%t ) end function pseudo_vector_vec_mom @ \subsection{Utilities} <>= @ <>= subroutine random_momentum (p, pabs, m) type(momentum), intent(out) :: p real(kind=default), intent(in) :: pabs, m real(kind=default), dimension(2) :: r real(kind=default) :: phi, cos_th call random_number (r) phi = 2*PI * r(1) cos_th = 2 * r(2) - 1 p%t = sqrt (pabs**2 + m**2) p%x = pabs * (/ cos_th * cos(phi), cos_th * sin(phi), sqrt (1 - cos_th**2) /) end subroutine random_momentum @ \section{Polarization vectors} <<[[omega_polarizations.f90]]>>= <> module omega_polarizations use kinds use constants use omega_vectors implicit none private <> integer, parameter, public :: omega_polarizations_2010_01_A = 0 contains <> end module omega_polarizations @ Here we use a phase convention for the polarization vectors compatible with the angular momentum coupling to spin 3/2 and spin 2. \begin{subequations} \begin{align} \epsilon^\mu_1(k) &= \frac{1}{|\vec k|\sqrt{k_x^2+k_y^2}} \left(0; k_z k_x, k_y k_z, - k_x^2 - k_y^2\right) \\ \epsilon^\mu_2(k) &= \frac{1}{\sqrt{k_x^2+k_y^2}} \left(0; -k_y, k_x, 0\right) \\ \epsilon^\mu_3(k) &= \frac{k_0}{m|\vec k|} \left({\vec k}^2/k_0; k_x, k_y, k_z\right) \end{align} \end{subequations} and \begin{subequations} \begin{align} \epsilon^\mu_\pm(k) &= \frac{1}{\sqrt{2}} (\epsilon^\mu_1(k) \pm \ii\epsilon^\mu_2(k) ) \\ \epsilon^\mu_0(k) &= \epsilon^\mu_3(k) \end{align} \end{subequations} i.\,e. \begin{subequations} \begin{align} \epsilon^\mu_+(k) &= \frac{1}{\sqrt{2}\sqrt{k_x^2+k_y^2}} \left(0; \frac{k_zk_x}{|\vec k|} - \ii k_y, \frac{k_yk_z}{|\vec k|} + \ii k_x, - \frac{k_x^2+k_y^2}{|\vec k|}\right) \\ \epsilon^\mu_-(k) &= \frac{1}{\sqrt{2}\sqrt{k_x^2+k_y^2}} \left(0; \frac{k_zk_x}{|\vec k|} + \ii k_y, \frac{k_yk_z}{|\vec k|} - \ii k_x, -\frac{k_x^2+k_y^2}{|\vec k|}\right) \\ \epsilon^\mu_0(k) &= \frac{k_0}{m|\vec k|} \left({\vec k}^2/k_0; k_x, k_y, k_z\right) \end{align} \end{subequations} Determining the mass from the momenta is a numerically haphazardous for light particles. Therefore, we accept some redundancy and pass the mass explicitely. <>= public :: eps @ <>= pure function eps (m, k, s) result (e) type(vector) :: e real(kind=default), intent(in) :: m type(momentum), intent(in) :: k integer, intent(in) :: s real(kind=default) :: kt, kabs, kabs2, sqrt2 sqrt2 = sqrt (2.0_default) kabs2 = dot_product (k%x, k%x) e%t = 0 e%x = 0 if (kabs2 > 0) then kabs = sqrt (kabs2) select case (s) case (1) kt = sqrt (k%x(1)**2 + k%x(2)**2) if (abs(kt) <= epsilon(kt) * kabs) then if (k%x(3) > 0) then e%x(1) = cmplx ( 1, 0, kind=default) / sqrt2 e%x(2) = cmplx ( 0, 1, kind=default) / sqrt2 else e%x(1) = cmplx ( - 1, 0, kind=default) / sqrt2 e%x(2) = cmplx ( 0, 1, kind=default) / sqrt2 end if else e%x(1) = cmplx ( k%x(3)*k%x(1)/kabs, & - k%x(2), kind=default) / kt / sqrt2 e%x(2) = cmplx ( k%x(2)*k%x(3)/kabs, & k%x(1), kind=default) / kt / sqrt2 e%x(3) = - kt / kabs / sqrt2 end if case (-1) kt = sqrt (k%x(1)**2 + k%x(2)**2) if (abs(kt) <= epsilon(kt) * kabs) then if (k%x(3) > 0) then e%x(1) = cmplx ( 1, 0, kind=default) / sqrt2 e%x(2) = cmplx ( 0, - 1, kind=default) / sqrt2 else e%x(1) = cmplx ( -1, 0, kind=default) / sqrt2 e%x(2) = cmplx ( 0, - 1, kind=default) / sqrt2 end if else e%x(1) = cmplx ( k%x(3)*k%x(1)/kabs, & k%x(2), kind=default) / kt / sqrt2 e%x(2) = cmplx ( k%x(2)*k%x(3)/kabs, & - k%x(1), kind=default) / kt / sqrt2 e%x(3) = - kt / kabs / sqrt2 end if case (0) if (m > 0) then e%t = kabs / m e%x = k%t / (m*kabs) * k%x end if case (3) e = (0,1) * k case (4) if (m > 0) then e = (1 / m) * k else e = (1 / k%t) * k end if end select else !!! for particles in their rest frame defined to be !!! polarized along the 3-direction select case (s) case (1) e%x(1) = cmplx ( 1, 0, kind=default) / sqrt2 e%x(2) = cmplx ( 0, 1, kind=default) / sqrt2 case (-1) e%x(1) = cmplx ( 1, 0, kind=default) / sqrt2 e%x(2) = cmplx ( 0, - 1, kind=default) / sqrt2 case (0) if (m > 0) then e%x(3) = 1 end if case (4) if (m > 0) then e = (1 / m) * k else e = (1 / k%t) * k end if end select end if end function eps @ \section{Polarization vectors revisited} <<[[omega_polarizations_madgraph.f90]]>>= <> module omega_polarizations_madgraph use kinds use constants use omega_vectors implicit none private <> integer, parameter, public :: omega_pols_madgraph_2010_01_A = 0 contains <> end module omega_polarizations_madgraph @ This set of polarization vectors is compatible with HELAS~\cite{HELAS}: \begin{subequations} \begin{align} \epsilon^\mu_1(k) &= \frac{1}{|\vec k|\sqrt{k_x^2+k_y^2}} \left(0; k_z k_x, k_y k_z, - k_x^2 - k_y^2\right) \\ \epsilon^\mu_2(k) &= \frac{1}{\sqrt{k_x^2+k_y^2}} \left(0; -k_y, k_x, 0\right) \\ \epsilon^\mu_3(k) &= \frac{k_0}{m|\vec k|} \left({\vec k}^2/k_0; k_x, k_y, k_z\right) \end{align} \end{subequations} and \begin{subequations} \begin{align} \epsilon^\mu_\pm(k) &= \frac{1}{\sqrt{2}} (\mp \epsilon^\mu_1(k) - \ii\epsilon^\mu_2(k) ) \\ \epsilon^\mu_0(k) &= \epsilon^\mu_3(k) \end{align} \end{subequations} i.\,e. \begin{subequations} \begin{align} \epsilon^\mu_+(k) &= \frac{1}{\sqrt{2}\sqrt{k_x^2+k_y^2}} \left(0; -\frac{k_zk_x}{|\vec k|} + \ii k_y, -\frac{k_yk_z}{|\vec k|} - \ii k_x, \frac{k_x^2+k_y^2}{|\vec k|}\right) \\ \epsilon^\mu_-(k) &= \frac{1}{\sqrt{2}\sqrt{k_x^2+k_y^2}} \left(0; \frac{k_zk_x}{|\vec k|} + \ii k_y, \frac{k_yk_z}{|\vec k|} - \ii k_x, -\frac{k_x^2+k_y^2}{|\vec k|}\right) \\ \epsilon^\mu_0(k) &= \frac{k_0}{m|\vec k|} \left({\vec k}^2/k_0; k_x, k_y, k_z\right) \end{align} \end{subequations} Fortunately, for comparing with squared matrix generated by Madgraph we can also use the modified version, since the difference is only a phase and does \emph{not} mix helicity states. @ Determining the mass from the momenta is a numerically haphazardous for light particles. Therefore, we accept some redundancy and pass the mass explicitely. <>= public :: eps @ <>= pure function eps (m, k, s) result (e) type(vector) :: e real(kind=default), intent(in) :: m type(momentum), intent(in) :: k integer, intent(in) :: s real(kind=default) :: kt, kabs, kabs2, sqrt2 sqrt2 = sqrt (2.0_default) kabs2 = dot_product (k%x, k%x) e%t = 0 e%x = 0 if (kabs2 > 0) then kabs = sqrt (kabs2) select case (s) case (1) kt = sqrt (k%x(1)**2 + k%x(2)**2) if (abs(kt) <= epsilon(kt) * kabs) then if (k%x(3) > 0) then e%x(1) = cmplx ( - 1, 0, kind=default) / sqrt2 e%x(2) = cmplx ( 0, - 1, kind=default) / sqrt2 else e%x(1) = cmplx ( 1, 0, kind=default) / sqrt2 e%x(2) = cmplx ( 0, - 1, kind=default) / sqrt2 end if else e%x(1) = cmplx ( - k%x(3)*k%x(1)/kabs, & k%x(2), kind=default) / kt / sqrt2 e%x(2) = cmplx ( - k%x(2)*k%x(3)/kabs, & - k%x(1), kind=default) / kt / sqrt2 e%x(3) = kt / kabs / sqrt2 end if case (-1) kt = sqrt (k%x(1)**2 + k%x(2)**2) if (abs(kt) <= epsilon(kt) * kabs) then if (k%x(3) > 0) then e%x(1) = cmplx ( 1, 0, kind=default) / sqrt2 e%x(2) = cmplx ( 0, - 1, kind=default) / sqrt2 else e%x(1) = cmplx ( -1, 0, kind=default) / sqrt2 e%x(2) = cmplx ( 0, - 1, kind=default) / sqrt2 end if else e%x(1) = cmplx ( k%x(3)*k%x(1)/kabs, & k%x(2), kind=default) / kt / sqrt2 e%x(2) = cmplx ( k%x(2)*k%x(3)/kabs, & - k%x(1), kind=default) / kt / sqrt2 e%x(3) = - kt / kabs / sqrt2 end if case (0) if (m > 0) then e%t = kabs / m e%x = k%t / (m*kabs) * k%x end if case (3) e = (0,1) * k case (4) if (m > 0) then e = (1 / m) * k else e = (1 / k%t) * k end if end select else !!! for particles in their rest frame defined to be !!! polarized along the 3-direction select case (s) case (1) e%x(1) = cmplx ( - 1, 0, kind=default) / sqrt2 e%x(2) = cmplx ( 0, - 1, kind=default) / sqrt2 case (-1) e%x(1) = cmplx ( 1, 0, kind=default) / sqrt2 e%x(2) = cmplx ( 0, - 1, kind=default) / sqrt2 case (0) if (m > 0) then e%x(3) = 1 end if case (4) if (m > 0) then e = (1 / m) * k else e = (1 / k%t) * k end if end select end if end function eps @ \section{Symmetric Tensors} Spin-2 polarization tensors are symmetric, transversal and traceless \begin{subequations} \begin{align} \epsilon^{\mu\nu}_{m}(k) &= \epsilon^{\nu\mu}_{m}(k) \\ k_\mu \epsilon^{\mu\nu}_{m}(k) &= k_\nu \epsilon^{\mu\nu}_{m}(k) = 0 \\ \epsilon^{\mu}_{m,\mu}(k) &= 0 \end{align} \end{subequations} with $m=1,2,3,4,5$. Our current representation is redundant and does \emph{not} enforce symmetry or tracelessness. <<[[omega_tensors.f90]]>>= <> module omega_tensors use kinds use constants use omega_vectors implicit none private public :: operator (*), operator (+), operator (-), & operator (.tprod.) public :: abs, conjg <<[[intrinsic :: abs]]>> <<[[intrinsic :: conjg]]>> type, public :: tensor ! private (omegalib needs access, but DON'T TOUCH IT!) complex(kind=default), dimension(0:3,0:3) :: t end type tensor <> integer, parameter, public :: omega_tensors_2010_01_A = 0 contains <> end module omega_tensors @ \subsection{Vector Space} \subsubsection{Scalar Multliplication} <>= interface operator (*) module procedure integer_tensor, real_tensor, double_tensor, & complex_tensor, dcomplex_tensor end interface private :: integer_tensor, real_tensor, double_tensor private :: complex_tensor, dcomplex_tensor @ <>= pure function integer_tensor (x, y) result (xy) integer, intent(in) :: x type(tensor), intent(in) :: y type(tensor) :: xy xy%t = x * y%t end function integer_tensor pure function real_tensor (x, y) result (xy) real(kind=single), intent(in) :: x type(tensor), intent(in) :: y type(tensor) :: xy xy%t = x * y%t end function real_tensor pure function double_tensor (x, y) result (xy) real(kind=default), intent(in) :: x type(tensor), intent(in) :: y type(tensor) :: xy xy%t = x * y%t end function double_tensor pure function complex_tensor (x, y) result (xy) complex(kind=single), intent(in) :: x type(tensor), intent(in) :: y type(tensor) :: xy xy%t = x * y%t end function complex_tensor pure function dcomplex_tensor (x, y) result (xy) complex(kind=default), intent(in) :: x type(tensor), intent(in) :: y type(tensor) :: xy xy%t = x * y%t end function dcomplex_tensor @ \subsubsection{Addition and Subtraction} <>= interface operator (+) module procedure plus_tensor end interface private :: plus_tensor interface operator (-) module procedure neg_tensor end interface private :: neg_tensor @ <>= pure function plus_tensor (t1) result (t2) type(tensor), intent(in) :: t1 type(tensor) :: t2 t2 = t1 end function plus_tensor pure function neg_tensor (t1) result (t2) type(tensor), intent(in) :: t1 type(tensor) :: t2 t2%t = - t1%t end function neg_tensor @ <>= interface operator (+) module procedure add_tensor end interface private :: add_tensor interface operator (-) module procedure sub_tensor end interface private :: sub_tensor @ <>= pure function add_tensor (x, y) result (xy) type(tensor), intent(in) :: x, y type(tensor) :: xy xy%t = x%t + y%t end function add_tensor pure function sub_tensor (x, y) result (xy) type(tensor), intent(in) :: x, y type(tensor) :: xy xy%t = x%t - y%t end function sub_tensor @ <>= interface operator (.tprod.) module procedure out_prod_vv, out_prod_vm, & out_prod_mv, out_prod_mm end interface private :: out_prod_vv, out_prod_vm, & out_prod_mv, out_prod_mm @ <>= pure function out_prod_vv (v, w) result (t) type(tensor) :: t type(vector), intent(in) :: v, w integer :: i, j t%t(0,0) = v%t * w%t t%t(0,1:3) = v%t * w%x t%t(1:3,0) = v%x * w%t do i = 1, 3 do j = 1, 3 t%t(i,j) = v%x(i) * w%x(j) end do end do end function out_prod_vv @ <>= pure function out_prod_vm (v, m) result (t) type(tensor) :: t type(vector), intent(in) :: v type(momentum), intent(in) :: m integer :: i, j t%t(0,0) = v%t * m%t t%t(0,1:3) = v%t * m%x t%t(1:3,0) = v%x * m%t do i = 1, 3 do j = 1, 3 t%t(i,j) = v%x(i) * m%x(j) end do end do end function out_prod_vm @ <>= pure function out_prod_mv (m, v) result (t) type(tensor) :: t type(vector), intent(in) :: v type(momentum), intent(in) :: m integer :: i, j t%t(0,0) = m%t * v%t t%t(0,1:3) = m%t * v%x t%t(1:3,0) = m%x * v%t do i = 1, 3 do j = 1, 3 t%t(i,j) = m%x(i) * v%x(j) end do end do end function out_prod_mv @ <>= pure function out_prod_mm (m, n) result (t) type(tensor) :: t type(momentum), intent(in) :: m, n integer :: i, j t%t(0,0) = m%t * n%t t%t(0,1:3) = m%t * n%x t%t(1:3,0) = m%x * n%t do i = 1, 3 do j = 1, 3 t%t(i,j) = m%x(i) * n%x(j) end do end do end function out_prod_mm @ <>= interface abs module procedure abs_tensor end interface private :: abs_tensor @ <>= pure function abs_tensor (t) result (abs_t) type(tensor), intent(in) :: t real(kind=default) :: abs_t abs_t = sqrt (sum ((abs (t%t))**2)) end function abs_tensor @ <>= interface conjg module procedure conjg_tensor end interface private :: conjg_tensor @ <>= pure function conjg_tensor (t) result (conjg_t) type(tensor), intent(in) :: t type(tensor) :: conjg_t conjg_t%t = conjg (t%t) end function conjg_tensor @ <>= interface operator (*) module procedure tensor_tensor, vector_tensor, tensor_vector, & momentum_tensor, tensor_momentum end interface private :: tensor_tensor, vector_tensor, tensor_vector, & momentum_tensor, tensor_momentum @ <>= pure function tensor_tensor (t1, t2) result (t1t2) type(tensor), intent(in) :: t1 type(tensor), intent(in) :: t2 complex(kind=default) :: t1t2 integer :: i1, i2 t1t2 = t1%t(0,0)*t2%t(0,0) & - dot_product (conjg (t1%t(0,1:)), t2%t(0,1:)) & - dot_product (conjg (t1%t(1:,0)), t2%t(1:,0)) do i1 = 1, 3 do i2 = 1, 3 t1t2 = t1t2 + t1%t(i1,i2)*t2%t(i1,i2) end do end do end function tensor_tensor @ <>= pure function tensor_vector (t, v) result (tv) type(tensor), intent(in) :: t type(vector), intent(in) :: v type(vector) :: tv tv%t = t%t(0,0) * v%t - dot_product (conjg (t%t(0,1:)), v%x) tv%x(1) = t%t(0,1) * v%t - dot_product (conjg (t%t(1,1:)), v%x) tv%x(2) = t%t(0,2) * v%t - dot_product (conjg (t%t(2,1:)), v%x) tv%x(3) = t%t(0,3) * v%t - dot_product (conjg (t%t(3,1:)), v%x) end function tensor_vector @ <>= pure function vector_tensor (v, t) result (vt) type(vector), intent(in) :: v type(tensor), intent(in) :: t type(vector) :: vt vt%t = v%t * t%t(0,0) - dot_product (conjg (v%x), t%t(1:,0)) vt%x(1) = v%t * t%t(0,1) - dot_product (conjg (v%x), t%t(1:,1)) vt%x(2) = v%t * t%t(0,2) - dot_product (conjg (v%x), t%t(1:,2)) vt%x(3) = v%t * t%t(0,3) - dot_product (conjg (v%x), t%t(1:,3)) end function vector_tensor @ <>= pure function tensor_momentum (t, p) result (tp) type(tensor), intent(in) :: t type(momentum), intent(in) :: p type(vector) :: tp tp%t = t%t(0,0) * p%t - dot_product (conjg (t%t(0,1:)), p%x) tp%x(1) = t%t(0,1) * p%t - dot_product (conjg (t%t(1,1:)), p%x) tp%x(2) = t%t(0,2) * p%t - dot_product (conjg (t%t(2,1:)), p%x) tp%x(3) = t%t(0,3) * p%t - dot_product (conjg (t%t(3,1:)), p%x) end function tensor_momentum @ <>= pure function momentum_tensor (p, t) result (pt) type(momentum), intent(in) :: p type(tensor), intent(in) :: t type(vector) :: pt pt%t = p%t * t%t(0,0) - dot_product (p%x, t%t(1:,0)) pt%x(1) = p%t * t%t(0,1) - dot_product (p%x, t%t(1:,1)) pt%x(2) = p%t * t%t(0,2) - dot_product (p%x, t%t(1:,2)) pt%x(3) = p%t * t%t(0,3) - dot_product (p%x, t%t(1:,3)) end function momentum_tensor @ \section{Symmetric Polarization Tensors} \begin{subequations} \begin{align} \epsilon^{\mu\nu}_{+2}(k) &= \epsilon^{\mu}_{+}(k)\epsilon^{\nu}_{+}(k) \\ \epsilon^{\mu\nu}_{+1}(k) &= \frac{1}{\sqrt{2}} \left( \epsilon^{\mu}_{+}(k)\epsilon^{\nu}_{0}(k) + \epsilon^{\mu}_{0}(k)\epsilon^{\nu}_{+}(k) \right) \\ \epsilon^{\mu\nu}_{0}(k) &= \frac{1}{\sqrt{6}} \left( \epsilon^{\mu}_{+}(k)\epsilon^{\nu}_{-}(k) + \epsilon^{\mu}_{-}(k)\epsilon^{\nu}_{+}(k) - 2 \epsilon^{\mu}_{0}(k)\epsilon^{\nu}_{0}(k) \right) \\ \epsilon^{\mu\nu}_{-1}(k) &= \frac{1}{\sqrt{2}} \left( \epsilon^{\mu}_{-}(k)\epsilon^{\nu}_{0}(k) + \epsilon^{\mu}_{0}(k)\epsilon^{\nu}_{-}(k) \right) \\ \epsilon^{\mu\nu}_{-2}(k) &= \epsilon^{\mu}_{-}(k)\epsilon^{\nu}_{-}(k) \end{align} \end{subequations} Note that~$\epsilon^{\mu}_{\pm2,\mu}(k) = \epsilon^{\mu}_{\pm}(k)\epsilon_{\pm,\mu}(k) \propto \epsilon^{\mu}_{\pm}(k)\epsilon_{\mp,\mu}^{*}(k) = 0$ and that the sign in $\epsilon^{\mu\nu}_{0}(k)$ insures its tracelessness\footnote{ On the other hand, with the shift operator $L_{-}\ket{+}=\ee^{\ii\phi}\ket{0}$ and $L_{-}\ket{0}=\ee^{\ii\chi}\ket{-}$, we find \begin{equation*} L_{-}^{2}\ket{++} = 2\ee^{2\ii\phi}\ket{00} + \ee^{\ii(\phi+\chi)}(\ket{+-}+\ket{-+}) \end{equation*} i.\,e.~$\chi-\phi=\pi$, if we want to identify $\epsilon^{\mu}_{-,0,+}$ with $\ket{-,0,+}$.}. <<[[omega_tensor_polarizations.f90]]>>= <> module omega_tensor_polarizations use kinds use constants use omega_vectors use omega_tensors use omega_polarizations implicit none private <> integer, parameter, public :: omega_tensor_pols_2010_01_A = 0 contains <> end module omega_tensor_polarizations @ <>= public :: eps2 @ <>= pure function eps2 (m, k, s) result (t) type(tensor) :: t real(kind=default), intent(in) :: m type(momentum), intent(in) :: k integer, intent(in) :: s type(vector) :: ep, em, e0 t%t = 0 select case (s) case (2) ep = eps (m, k, 1) t = ep.tprod.ep case (1) ep = eps (m, k, 1) e0 = eps (m, k, 0) t = (1 / sqrt (2.0_default)) & * ((ep.tprod.e0) + (e0.tprod.ep)) case (0) ep = eps (m, k, 1) e0 = eps (m, k, 0) em = eps (m, k, -1) t = (1 / sqrt (6.0_default)) & * ((ep.tprod.em) + (em.tprod.ep) - 2*(e0.tprod.e0)) case (-1) e0 = eps (m, k, 0) em = eps (m, k, -1) t = (1 / sqrt (2.0_default)) & * ((em.tprod.e0) + (e0.tprod.em)) case (-2) em = eps (m, k, -1) t = em.tprod.em end select end function eps2 @ \section{Couplings} <<[[omega_couplings.f90]]>>= <> module omega_couplings use kinds use constants use omega_vectors use omega_tensors implicit none private <> <> integer, parameter, public :: omega_couplings_2010_01_A = 0 contains <> <> end module omega_couplings @ <>= public :: wd_tl @ <>= public :: gauss @ \begin{equation} \Theta(p^2)\Gamma \end{equation} <>= pure function wd_tl (p, w) result (width) real(kind=default) :: width type(momentum), intent(in) :: p real(kind=default), intent(in) :: w if (p*p > 0) then width = w else width = 0 end if end function wd_tl @ <>= pure function gauss (x, mu, w) result (gg) real(kind=default) :: gg real(kind=default), intent(in) :: x, mu, w if (w > 0) then gg = exp(-(x - mu**2)**2/4.0_default/mu**2/w**2) * & sqrt(sqrt(PI/2)) / w / mu else gg = 1.0_default end if end function gauss @ <>= public :: pr_phi, pr_unitarity, pr_feynman, pr_gauge, pr_rxi public :: pr_vector_pure public :: pj_phi, pj_unitarity public :: pg_phi, pg_unitarity @ \begin{equation} \frac{\ii}{p^2-m^2+\ii m\Gamma}\phi \end{equation} <>= pure function pr_phi (p, m, w, phi) result (pphi) complex(kind=default) :: pphi type(momentum), intent(in) :: p real(kind=default), intent(in) :: m, w complex(kind=default), intent(in) :: phi pphi = (1 / cmplx (p*p - m**2, m*w, kind=default)) * phi end function pr_phi @ \begin{equation} \sqrt{\frac{\pi}{M\Gamma}} \phi \end{equation} <>= pure function pj_phi (m, w, phi) result (pphi) complex(kind=default) :: pphi real(kind=default), intent(in) :: m, w complex(kind=default), intent(in) :: phi pphi = (0, -1) * sqrt (PI / m / w) * phi end function pj_phi @ <>= pure function pg_phi (p, m, w, phi) result (pphi) complex(kind=default) :: pphi type(momentum), intent(in) :: p real(kind=default), intent(in) :: m, w complex(kind=default), intent(in) :: phi pphi = ((0, 1) * gauss (p*p, m, w)) * phi end function pg_phi @ \begin{equation} \frac{\ii}{p^2-m^2+\ii m\Gamma} \left( -g_{\mu\nu} + \frac{p_\mu p_\nu}{m^2} \right) \epsilon^\nu(p) \end{equation} NB: the explicit cast to [[vector]] is required here, because a specific [[complex_momentum]] procedure for [[operator (*)]] would introduce ambiguities. NB: we used to use the constructor [[vector (p%t, p%x)]] instead of the temporary variable, but the Intel Fortran Compiler choked on it. <>= pure function pr_unitarity (p, m, w, cms, e) result (pe) type(vector) :: pe type(momentum), intent(in) :: p real(kind=default), intent(in) :: m, w type(vector), intent(in) :: e logical, intent(in) :: cms type(vector) :: pv complex(kind=default) :: c_mass2 pv = p if (cms) then c_mass2 = cmplx (m**2, -m*w, kind=default) else c_mass2 = m**2 end if pe = - (1 / cmplx (p*p - m**2, m*w, kind=default)) & * (e - (p*e / c_mass2) * pv) end function pr_unitarity @ \begin{equation} \sqrt{\frac{\pi}{M\Gamma}} \left( -g_{\mu\nu} + \frac{p_\mu p_\nu}{m^2} \right) \epsilon^\nu(p) \end{equation} <>= pure function pj_unitarity (p, m, w, e) result (pe) type(vector) :: pe type(momentum), intent(in) :: p real(kind=default), intent(in) :: m, w type(vector), intent(in) :: e type(vector) :: pv pv = p pe = (0, 1) * sqrt (PI / m / w) * (e - (p*e / m**2) * pv) end function pj_unitarity @ <>= pure function pg_unitarity (p, m, w, e) result (pe) type(vector) :: pe type(momentum), intent(in) :: p real(kind=default), intent(in) :: m, w type(vector), intent(in) :: e type(vector) :: pv pv = p pe = - gauss (p*p, m, w) & * (e - (p*e / m**2) * pv) end function pg_unitarity @ \begin{equation} \frac{-i}{p^2} \epsilon^\nu(p) \end{equation} <>= pure function pr_feynman (p, e) result (pe) type(vector) :: pe type(momentum), intent(in) :: p type(vector), intent(in) :: e pe = - (1 / (p*p)) * e end function pr_feynman @ \begin{equation} \frac{\ii}{p^2} \left( -g_{\mu\nu} + (1-\xi)\frac{p_\mu p_\nu}{p^2} \right) \epsilon^\nu(p) \end{equation} <>= pure function pr_gauge (p, xi, e) result (pe) type(vector) :: pe type(momentum), intent(in) :: p real(kind=default), intent(in) :: xi type(vector), intent(in) :: e real(kind=default) :: p2 type(vector) :: pv p2 = p*p pv = p pe = - (1 / p2) * (e - ((1 - xi) * (p*e) / p2) * pv) end function pr_gauge @ \begin{equation} \frac{\ii}{p^2-m^2+\ii m\Gamma} \left( -g_{\mu\nu} + (1-\xi)\frac{p_\mu p_\nu}{p^2-\xi m^2} \right) \epsilon^\nu(p) \end{equation} <>= pure function pr_rxi (p, m, w, xi, e) result (pe) type(vector) :: pe type(momentum), intent(in) :: p real(kind=default), intent(in) :: m, w, xi type(vector), intent(in) :: e real(kind=default) :: p2 type(vector) :: pv p2 = p*p pv = p pe = - (1 / cmplx (p2 - m**2, m*w, kind=default)) & * (e - ((1 - xi) * (p*e) / (p2 - xi * m**2)) * pv) end function pr_rxi @ \begin{equation} \frac{\ii}{p^2-m^2+\ii m\Gamma} \left( -g_{\mu\nu} \right) \epsilon^\nu(p) \end{equation} <>= pure function pr_vector_pure (p, m, w, e) result (pe) type(vector) :: pe type(momentum), intent(in) :: p real(kind=default), intent(in) :: m, w type(vector), intent(in) :: e real(kind=default) :: p2 type(vector) :: pv p2 = p*p pv = p pe = - (1 / cmplx (p2 - m**2, m*w, kind=default)) * e end function pr_vector_pure @ <>= public :: pr_tensor, pr_tensor_pure @ \begin{subequations} \begin{equation} \frac{\ii P^{\mu\nu,\rho\sigma}(p,m)}{p^2-m^2+\ii m\Gamma} T_{\rho\sigma} \end{equation} with \begin{multline} P^{\mu\nu,\rho\sigma}(p,m) = \frac{1}{2} \left(g^{\mu\rho}-\frac{p^{\mu}p^{\nu}}{m^2}\right) \left(g^{\nu\sigma}-\frac{p^{\nu}p^{\sigma}}{m^2}\right) + \frac{1}{2} \left(g^{\mu\sigma}-\frac{p^{\mu}p^{\sigma}}{m^2}\right) \left(g^{\nu\rho}-\frac{p^{\nu}p^{\rho}}{m^2}\right) \\ - \frac{1}{3} \left(g^{\mu\nu}-\frac{p^{\mu}p^{\nu}}{m^2}\right) \left(g^{\rho\sigma}-\frac{p^{\rho}p^{\sigma}}{m^2}\right) \end{multline} \end{subequations} Be careful with raising and lowering of indices: \begin{subequations} \begin{align} g^{\mu\nu}-\frac{k^{\mu}k^{\nu}}{m^2} &= \begin{pmatrix} 1 - k^0k^0 / m^2 & - k^0 \vec k / m^2 \\ - \vec k k^0 / m^2 & - \mathbf{1} - \vec k \otimes \vec k / m^2 \end{pmatrix} \\ g^{\mu}_{\hphantom{\mu}\nu}-\frac{k^{\mu}k_{\nu}}{m^2} &= \begin{pmatrix} 1 - k^0k^0 / m^2 & k^0 \vec k / m^2 \\ - \vec k k^0 / m^2 & \mathbf{1} + \vec k \otimes \vec k / m^2 \end{pmatrix} \end{align} \end{subequations} <>= pure function pr_tensor (p, m, w, t) result (pt) type(tensor) :: pt type(momentum), intent(in) :: p real(kind=default), intent(in) :: m, w type(tensor), intent(in) :: t complex(kind=default) :: p_dd_t real(kind=default), dimension(0:3,0:3) :: p_uu, p_ud, p_du, p_dd integer :: i, j p_uu(0,0) = 1 - p%t * p%t / m**2 p_uu(0,1:3) = - p%t * p%x / m**2 p_uu(1:3,0) = p_uu(0,1:3) do i = 1, 3 do j = 1, 3 p_uu(i,j) = - p%x(i) * p%x(j) / m**2 end do end do do i = 1, 3 p_uu(i,i) = - 1 + p_uu(i,i) end do p_ud(:,0) = p_uu(:,0) p_ud(:,1:3) = - p_uu(:,1:3) p_du = transpose (p_ud) p_dd(:,0) = p_du(:,0) p_dd(:,1:3) = - p_du(:,1:3) p_dd_t = 0 do i = 0, 3 do j = 0, 3 p_dd_t = p_dd_t + p_dd(i,j) * t%t(i,j) end do end do pt%t = matmul (p_ud, matmul (0.5_default * (t%t + transpose (t%t)), p_du)) & - (p_dd_t / 3.0_default) * p_uu pt%t = pt%t / cmplx (p*p - m**2, m*w, kind=default) end function pr_tensor @ \begin{subequations} \begin{equation} \frac{\ii P_p^{\mu\nu,\rho\sigma}}{p^2-m^2+\ii m\Gamma} T_{\rho\sigma} \end{equation} with \begin{multline} P_p^{\mu\nu,\rho\sigma} = \frac{1}{2} g^{\mu\rho} g^{\nu\sigma} + \frac{1}{2} g^{\mu\sigma} g^{\nu\rho} - \frac{1}{2} g^{\mu\nu}g^{\rho\sigma} \end{multline} \end{subequations} <>= pure function pr_tensor_pure (p, m, w, t) result (pt) type(tensor) :: pt type(momentum), intent(in) :: p real(kind=default), intent(in) :: m, w type(tensor), intent(in) :: t complex(kind=default) :: p_dd_t real(kind=default), dimension(0:3,0:3) :: g_uu integer :: i, j g_uu(0,0) = 1 g_uu(0,1:3) = 0 g_uu(1:3,0) = g_uu(0,1:3) do i = 1, 3 do j = 1, 3 g_uu(i,j) = 0 end do end do do i = 1, 3 g_uu(i,i) = - 1 end do p_dd_t = t%t(0,0) - t%t(1,1) - t%t(2,2) - t%t(3,3) pt%t = 0.5_default * ((t%t + transpose (t%t)) & - p_dd_t * g_uu ) pt%t = pt%t / cmplx (p*p - m**2, m*w, kind=default) end function pr_tensor_pure @ \subsection{Triple Gauge Couplings} <>= public :: g_gg @ According to~(\ref{eq:fuse-gauge}) \begin{multline} A^{a,\mu}(k_1+k_2) = - \ii g \bigl( (k_1^{\mu}-k_2^{\mu})A^{a_1}(k_1) \cdot A^{a_2}(k_2) \\ + (2k_2+k_1)\cdot A^{a_1}(k_1)A^{a_2,\mu}(k_2) - A^{a_1,\mu}(k_1)A^{a_2}(k_2)\cdot(2k_1+k_2) \bigr) \end{multline} <>= pure function g_gg (g, a1, k1, a2, k2) result (a) complex(kind=default), intent(in) :: g type(vector), intent(in) :: a1, a2 type(momentum), intent(in) :: k1, k2 type(vector) :: a a = (0, -1) * g * ((k1 - k2) * (a1 * a2) & + ((2*k2 + k1) * a1) * a2 - a1 * ((2*k1 + k2) * a2)) end function g_gg @ \subsection{Quadruple Gauge Couplings} <>= public :: x_gg, g_gx @ \begin{equation} T^{a,\mu\nu}(k_1+k_2) = g \bigl( A^{a_1,\mu}(k_1) A^{a_2,\nu}(k_2) - A^{a_1,\nu}(k_1) A^{a_2,\mu}(k_2) \bigr) \end{equation} <>= pure function x_gg (g, a1, a2) result (x) complex(kind=default), intent(in) :: g type(vector), intent(in) :: a1, a2 type(tensor2odd) :: x x = g * (a1 .wedge. a2) end function x_gg @ \begin{equation} A^{a,\mu}(k_1+k_2) = g A^{a_1}_\nu(k_1) T^{a_2,\nu\mu}(k_2) \end{equation} <>= pure function g_gx (g, a1, x) result (a) complex(kind=default), intent(in) :: g type(vector), intent(in) :: a1 type(tensor2odd), intent(in) :: x type(vector) :: a a = g * (a1 * x) end function g_gx @ \subsection{Scalar Current} <>= public :: v_ss, s_vs @ \begin{equation} V^\mu(k_1+k_2) = g(k_1^\mu - k_2^\mu)\phi_1(k_1)\phi_2(k_2) \end{equation} <>= pure function v_ss (g, phi1, k1, phi2, k2) result (v) complex(kind=default), intent(in) :: g, phi1, phi2 type(momentum), intent(in) :: k1, k2 type(vector) :: v v = (k1 - k2) * (g * phi1 * phi2) end function v_ss @ \begin{equation} \phi(k_1+k_2) = g(k_1^\mu + 2k_2^\mu)V_\mu(k_1)\phi(k_2) \end{equation} <>= pure function s_vs (g, v1, k1, phi2, k2) result (phi) complex(kind=default), intent(in) :: g, phi2 type(vector), intent(in) :: v1 type(momentum), intent(in) :: k1, k2 complex(kind=default) :: phi phi = g * ((k1 + 2*k2) * v1) * phi2 end function s_vs @ \subsection{Transversal Scalar-Vector Coupling} <>= public :: s_vv_t, v_sv_t @ \begin{equation} phi(k_1+k_2) = g((V_1(k_1) V_2(k_2))(k_1 k_2) - (V_1(k_1) k_2)(V_2(k_2) k_1)) \end{equation} <>= pure function s_vv_t (g, v1, k1, v2, k2) result (phi) complex(kind=default), intent(in) :: g type(vector), intent(in) :: v1, v2 type(momentum), intent(in) :: k1, k2 complex(kind=default) :: phi phi = g * ((v1*v2) * (k1*k2) - (v1*k2) * (v2*k1)) end function s_vv_t @ \begin{equation} V_1^\mu(k_\phi+k_V) = g phi(((k_\phi+k_V)k_V)V_2^\mu- (k_\phi+k_V)V_2)k_V^\mu ) \end{equation} <>= pure function v_sv_t (g, phi, kphi,v, kv) result (vout) complex(kind=default), intent(in) :: g, phi type(vector), intent(in) :: v type(momentum), intent(in) :: kv, kphi type(momentum) :: kout type(vector) :: vout kout = - (kv + kphi) vout = g * phi * ((kout*kv) * v - (v * kout) * kv) end function v_sv_t @ \subsection{Transversal TensorScalar-Vector Coupling} <>= public :: tphi_vv, tphi_vv_cf, v_tphiv, v_tphiv_cf @ \begin{equation} phi(k_1 + k_2) = g (V_1(k_1) (k_1 +k_2)) * ( V_2(k_2) (k_1 + k_2)) \end{equation} <>= pure function tphi_vv (g, v1, k1, v2, k2) result (phi) complex(kind=default), intent(in) :: g type(vector), intent(in) :: v1, v2 type(momentum), intent(in) :: k1, k2 complex(kind=default) :: phi type(momentum) :: k k = - (k1 + k2) phi = 2 * g * (v1*k) * (v2*k) end function tphi_vv @ \begin{equation} phi(k_1+k_2) = g((V_1(k_1) V_2(k_2))(k_1 + k_2)^2) \end{equation} <>= pure function tphi_vv_cf (g, v1, k1, v2, k2) result (phi) complex(kind=default), intent(in) :: g type(vector), intent(in) :: v1, v2 type(momentum), intent(in) :: k1, k2 complex(kind=default) :: phi type(momentum) :: k k = - (k1 + k2) phi = - g/2 * (v1*v2) * (k*k) end function tphi_vv_cf @ \begin{equation} V_1^\mu(k_\phi+k_V) = g phi ((k_\phi+k_V)V_2) (k_\phi+k_V)^\mu \end{equation} <>= pure function v_tphiv (g, phi, kphi,v, kv) result (vout) complex(kind=default), intent(in) :: g, phi type(vector), intent(in) :: v type(momentum), intent(in) :: kv, kphi type(momentum) :: kout type(vector) :: vout kout = - (kv + kphi) vout = 2 * g * phi * ((v * kout) * kout) end function v_tphiv @ \begin{equation} V_1^\mu(k_\phi+k_V) = g phi((k_\phi+k_V)(k_\phi+k_V))V_2^\mu \end{equation} <>= pure function v_tphiv_cf (g, phi, kphi,v, kv) result (vout) complex(kind=default), intent(in) :: g, phi type(vector), intent(in) :: v type(momentum), intent(in) :: kv, kphi type(momentum) :: kout type(vector) :: vout kout = - (kv + kphi) vout = -g/2 * phi * (kout*kout) * v end function v_tphiv_cf @ \subsection{Triple Vector Couplings} <>= public :: tkv_vv, lkv_vv, tv_kvv, lv_kvv, kg_kgkg public :: t5kv_vv, l5kv_vv, t5v_kvv, l5v_kvv, kg5_kgkg, kg_kg5kg public :: dv_vv, v_dvv, dv_vv_cf, v_dvv_cf @ \begin{equation} V^\mu(k_1+k_2) = \ii g(k_1-k_2)^\mu V_1^\nu(k_1)V_{2,\nu}(k_2) \end{equation} <>= pure function tkv_vv (g, v1, k1, v2, k2) result (v) complex(kind=default), intent(in) :: g type(vector), intent(in) :: v1, v2 type(momentum), intent(in) :: k1, k2 type(vector) :: v v = (k1 - k2) * ((0, 1) * g * (v1*v2)) end function tkv_vv @ \begin{equation} V^\mu(k_1+k_2) = \ii g \epsilon^{\mu\nu\rho\sigma} (k_1-k_2)_{\nu} V_{1,\rho}(k_1)V_{2,\sigma}(k_2) \end{equation} <>= pure function t5kv_vv (g, v1, k1, v2, k2) result (v) complex(kind=default), intent(in) :: g type(vector), intent(in) :: v1, v2 type(momentum), intent(in) :: k1, k2 type(vector) :: v type(vector) :: k k = k1 - k2 v = (0, 1) * g * pseudo_vector (k, v1, v2) end function t5kv_vv @ \begin{equation} V^\mu(k_1+k_2) = \ii g(k_1+k_2)^\mu V_1^\nu(k_1)V_{2,\nu}(k_2) \end{equation} <>= pure function lkv_vv (g, v1, k1, v2, k2) result (v) complex(kind=default), intent(in) :: g type(vector), intent(in) :: v1, v2 type(momentum), intent(in) :: k1, k2 type(vector) :: v v = (k1 + k2) * ((0, 1) * g * (v1*v2)) end function lkv_vv @ \begin{equation} V^\mu(k_1+k_2) = \ii g \epsilon^{\mu\nu\rho\sigma} (k_1+k_2)_{\nu} V_{1,\rho}(k_1)V_{2,\sigma}(k_2) \end{equation} <>= pure function l5kv_vv (g, v1, k1, v2, k2) result (v) complex(kind=default), intent(in) :: g type(vector), intent(in) :: v1, v2 type(momentum), intent(in) :: k1, k2 type(vector) :: v type(vector) :: k k = k1 + k2 v = (0, 1) * g * pseudo_vector (k, v1, v2) end function l5kv_vv @ \begin{equation} V^\mu(k_1+k_2) = \ii g (k_2-k)^\nu V_{1,\nu}(k_1)V_2^\mu(k_2) = \ii g (2k_2+k_1)^\nu V_{1,\nu}(k_1)V_2^\mu(k_2) \end{equation} using $k=-k_1-k_2$ <>= pure function tv_kvv (g, v1, k1, v2, k2) result (v) complex(kind=default), intent(in) :: g type(vector), intent(in) :: v1, v2 type(momentum), intent(in) :: k1, k2 type(vector) :: v v = v2 * ((0, 1) * g * ((2*k2 + k1)*v1)) end function tv_kvv @ \begin{equation} V^\mu(k_1+k_2) = \ii g \epsilon^{\mu\nu\rho\sigma} (2k_2+k_1)_{\nu} V_{1,\rho}(k_1)V_{2,\sigma}(k_2) \end{equation} <>= pure function t5v_kvv (g, v1, k1, v2, k2) result (v) complex(kind=default), intent(in) :: g type(vector), intent(in) :: v1, v2 type(momentum), intent(in) :: k1, k2 type(vector) :: v type(vector) :: k k = k1 + 2*k2 v = (0, 1) * g * pseudo_vector (k, v1, v2) end function t5v_kvv @ \begin{equation} V^\mu(k_1+k_2) = - \ii g k_1^\nu V_{1,\nu}(k_1)V_2^\mu(k_2) \end{equation} using $k=-k_1-k_2$ <>= pure function lv_kvv (g, v1, k1, v2) result (v) complex(kind=default), intent(in) :: g type(vector), intent(in) :: v1, v2 type(momentum), intent(in) :: k1 type(vector) :: v v = v2 * ((0, -1) * g * (k1*v1)) end function lv_kvv @ \begin{equation} V^\mu(k_1+k_2) = - \ii g \epsilon^{\mu\nu\rho\sigma} k_{1,\nu} V_{1,\rho}(k_1)V_{2,\sigma}(k_2) \end{equation} <>= pure function l5v_kvv (g, v1, k1, v2) result (v) complex(kind=default), intent(in) :: g type(vector), intent(in) :: v1, v2 type(momentum), intent(in) :: k1 type(vector) :: v type(vector) :: k k = k1 v = (0, -1) * g * pseudo_vector (k, v1, v2) end function l5v_kvv @ \begin{equation} A^\mu(k_1+k_2) = \ii g k^\nu \Bigl( F_{1,\nu}^{\hphantom{1,\nu}\rho}(k_1)F_{2,\rho\mu}(k_2) - F_{1,\mu}^{\hphantom{1,\mu}\rho}(k_1)F_{2,\rho\nu}(k_2) \Bigr) \end{equation} with $k=-k_1-k_2$, i.\,e. \begin{multline} A^\mu(k_1+k_2) = -\ii g \Bigl( [(kk_2)(k_1A_2) - (k_1k_2)(kA_2)] A_1^\mu \\ + [(k_1k_2)(kA_1) - (kk_1)(k_2A_1)] A_2^\mu \\ + [(k_2A_1)(kA_2) - (kk_2)(A_1A_2)] k_1^\mu \\ + [(kk_1)(A_1A_2) - (kA_1)(k_1A_2)] k_2^\mu \Bigr) \end{multline} <>= pure function kg_kgkg (g, a1, k1, a2, k2) result (a) complex(kind=default), intent(in) :: g type(vector), intent(in) :: a1, a2 type(momentum), intent(in) :: k1, k2 type(vector) :: a real(kind=default) :: k1k1, k2k2, k1k2, kk1, kk2 complex(kind=default) :: a1a2, k2a1, ka1, k1a2, ka2 k1k1 = k1 * k1 k1k2 = k1 * k2 k2k2 = k2 * k2 kk1 = k1k1 + k1k2 kk2 = k1k2 + k2k2 k2a1 = k2 * a1 ka1 = k2a1 + k1 * a1 k1a2 = k1 * a2 ka2 = k1a2 + k2 * a2 a1a2 = a1 * a2 a = (0, -1) * g * ( (kk2 * k1a2 - k1k2 * ka2 ) * a1 & + (k1k2 * ka1 - kk1 * k2a1) * a2 & + (ka2 * k2a1 - kk2 * a1a2) * k1 & + (kk1 * a1a2 - ka1 * k1a2) * k2 ) end function kg_kgkg @ \begin{equation} A^\mu(k_1+k_2) = \ii g \epsilon^{\mu\nu\rho\sigma} k_{\nu} F_{1,\rho}^{\hphantom{1,\rho}\lambda}(k_1)F_{2,\lambda\sigma}(k_2) \end{equation} with $k=-k_1-k_2$, i.\,e. \begin{multline} A^\mu(k_1+k_2) = -2\ii g \epsilon^{\mu\nu\rho\sigma} k_{\nu} \Bigl( (k_2A_1) k_{1,\rho} A_{2,\sigma} + (k_1A_2) A_{1,\rho} k_{2,\sigma} \\ - (A_1A_2) k_{1,\rho} k_{2,\sigma} - (k_1k_2) A_{1,\rho} A_{2,\sigma} \Bigr) \end{multline} <>= pure function kg5_kgkg (g, a1, k1, a2, k2) result (a) complex(kind=default), intent(in) :: g type(vector), intent(in) :: a1, a2 type(momentum), intent(in) :: k1, k2 type(vector) :: a type(vector) :: kv, k1v, k2v kv = - k1 - k2 k1v = k1 k2v = k2 a = (0, -2) * g * ( (k2*A1) * pseudo_vector (kv, k1v, a2 ) & + (k1*A2) * pseudo_vector (kv, A1 , k2v) & - (A1*A2) * pseudo_vector (kv, k1v, k2v) & - (k1*k2) * pseudo_vector (kv, a1 , a2 ) ) end function kg5_kgkg @ \begin{equation} A^\mu(k_1+k_2) = \ii g k_{\nu} \Bigl( \epsilon^{\mu\rho\lambda\sigma} F_{1,\hphantom{\nu}\rho}^{\hphantom{1,}\nu} - \epsilon^{\nu\rho\lambda\sigma} F_{1,\hphantom{\mu}\rho}^{\hphantom{1,}\mu} \Bigr) \frac{1}{2} F_{1,\lambda\sigma} \end{equation} with $k=-k_1-k_2$, i.\,e. \begin{multline} A^\mu(k_1+k_2) = -\ii g \Bigl( \epsilon^{\mu\rho\lambda\sigma} (kk_2) A_{2,\rho} - \epsilon^{\mu\rho\lambda\sigma} (kA_2) k_{2,\rho} - k_2^\mu \epsilon^{\nu\rho\lambda\sigma} k_nu A_{2,\rho} + A_2^\mu \epsilon^{\nu\rho\lambda\sigma} k_nu k_{2,\rho} \Bigr) k_{1,\lambda} A_{1,\sigma} \end{multline} \begin{dubious} This is not the most efficienct way of doing it: $\epsilon^{\mu\nu\rho\sigma}F_{1,\rho\sigma}$ should be cached! \end{dubious} <>= pure function kg_kg5kg (g, a1, k1, a2, k2) result (a) complex(kind=default), intent(in) :: g type(vector), intent(in) :: a1, a2 type(momentum), intent(in) :: k1, k2 type(vector) :: a type(vector) :: kv, k1v, k2v kv = - k1 - k2 k1v = k1 k2v = k2 a = (0, -1) * g * ( (kv*k2v) * pseudo_vector (a2 , k1v, a1) & - (kv*a2 ) * pseudo_vector (k2v, k1v, a1) & - k2v * pseudo_scalar (kv, a2, k1v, a1) & + a2 * pseudo_scalar (kv, k2v, k1v, a1) ) end function kg_kg5kg @ \begin{equation} V^\mu(k_1+k_2) = - g ((k_1+k_2) V_{1}) V_{2}^\mu + ((k_1+k_2) V_{2}) V_{1}^\mu \end{equation} <>= pure function dv_vv (g, v1, k1, v2, k2) result (v) complex(kind=default), intent(in) :: g type(vector), intent(in) :: v1, v2 type(momentum), intent(in) :: k1, k2 type(vector) :: v type(vector) :: k k = -(k1 + k2) v = g * ((k * v1) * v2 + (k * v2) * v1) end function dv_vv @ \begin{equation} V^\mu(k_1+k_2) = \frac{g}{2} ( V_{1} (k_{1}) V_{2} (k_{2}) ) (k_{1}+k_{2})^\mu \end{equation} <>= pure function dv_vv_cf (g, v1, k1, v2, k2) result (v) complex(kind=default), intent(in) :: g type(vector), intent(in) :: v1, v2 type(momentum), intent(in) :: k1, k2 type(vector) :: v type(vector) :: k k = -(k1 + k2) v = - g/2 * (v1 * v2) * k end function dv_vv_cf @ \begin{equation} V_{1}^\mu = g * ( k V_{2}) V (k) + ( V V_{2}) k \end{equation} <>= pure function v_dvv (g, v, k, v2) result (v1) complex(kind=default), intent(in) :: g type(vector), intent(in) :: v, v2 type(momentum), intent(in) :: k type(vector) :: v1 v1 = g * ((v * v2) * k + (k * v2) * v) end function v_dvv @ \begin{equation} V_{1}^\mu = -\frac{g}{2} ( V (k) k ) V_{2}^\mu \end{equation} <>= pure function v_dvv_cf (g, v, k, v2) result (v1) complex(kind=default), intent(in) :: g type(vector), intent(in) :: v, v2 type(momentum), intent(in) :: k type(vector) :: v1 v1 = - g/2 * (v * k) * v2 end function v_dvv_cf @ \section{Tensorvector - Scalar coupling } <>= public :: dv_phi2,phi_dvphi, dv_phi2_cf, phi_dvphi_cf @ \begin{equation} V^\mu (k_1 + k_2 ) = g* ((k_1 k_2 + k_2 k_2) k_1^\mu + (k_1 k_2 + k_1 k_1) k_2^\mu ) * phi_1 (k_1) phi_2 (k_2) \end{equation} <>= pure function dv_phi2 (g, phi1, k1, phi2, k2) result (v) complex(kind=default), intent(in) :: g, phi1, phi2 type(momentum), intent(in) :: k1, k2 type(vector) :: v v = g * phi1 * phi2 * ( & (k1 * k2 + k2 * k2 ) * k1 + & (k1 * k2 + k1 * k1 ) * k2 ) end function dv_phi2 @ \begin{equation} V^\mu (k_1 + k_2 ) = - \frac{g}{2} * (k_1 k_2) * (k_1 + k_2 )^\mu * phi_1 (k_1) phi_2 (k_2) \end{equation} <>= pure function dv_phi2_cf (g, phi1, k1, phi2, k2) result (v) complex(kind=default), intent(in) :: g, phi1, phi2 type(momentum), intent(in) :: k1, k2 type(vector) :: v v = - g/2 * phi1 * phi2 * (k1 * k2) * (k1 + k2) end function dv_phi2_cf @ \begin{equation} phi_1 (k_1) = g * ((k_1 k_2 + k_2 k_2) (k_1 * V(-k_1 - k_2) ) + (k_1 k_2 + k_1 k_1) (k_2 * V(-k_1 - k_2) ) ) * phi_2 (k_2) \end{equation} <>= pure function phi_dvphi (g, v, k, phi2, k2) result (phi1) complex(kind=default), intent(in) :: g, phi2 type(vector), intent(in) :: v type(momentum), intent(in) :: k, k2 complex(kind=default) :: phi1 type(momentum) :: k1 k1 = - (k + k2) phi1 = g * phi2 * ( & (k1 * k2 + k2 * k2 ) * ( k1 * V ) + & (k1 * k2 + k1 * k1 ) * ( k2 * V ) ) end function phi_dvphi @ \begin{equation} phi_1 (k_1 ) = - \frac{g}{2} * (k_1 k_2) * ((k_1 + k_2 ) V(- k_1 - k_2)) \end{equation} <>= pure function phi_dvphi_cf (g, v, k, phi2, k2) result (phi1) complex(kind=default), intent(in) :: g, phi2 type(vector), intent(in) :: v type(momentum), intent(in) :: k, k2 complex(kind=default) :: phi1 type(momentum) :: k1 k1 = -(k + k2) phi1 = - g/2 * phi2 * (k1 * k2) * ((k1 + k2) * v) end function phi_dvphi_cf @ \section{Scalar-Vector Dim-5 Couplings} <>= public :: phi_vv, v_phiv, phi_u_vv, v_u_phiv @ <>= pure function phi_vv (g, k1, k2, v1, v2) result (phi) complex(kind=default), intent(in) :: g type(momentum), intent(in) :: k1, k2 type(vector), intent(in) :: v1, v2 complex(kind=default) :: phi phi = g * pseudo_scalar (k1, v1, k2, v2) end function phi_vv @ <>= pure function v_phiv (g, phi, k1, k2, v) result (w) complex(kind=default), intent(in) :: g, phi type(vector), intent(in) :: v type(momentum), intent(in) :: k1, k2 type(vector) :: w w = g * phi * pseudo_vector (k1, k2, v) end function v_phiv @ <>= pure function phi_u_vv (g, k1, k2, v1, v2) result (phi) complex(kind=default), intent(in) :: g type(momentum), intent(in) :: k1, k2 type(vector), intent(in) :: v1, v2 complex(kind=default) :: phi phi = g * ((k1*v2)*((-(k1+k2))*v1) + & (k2*v1)*((-(k1+k2))*v2) + & (((k1+k2)*(k1+k2)) * (v1*v2))) end function phi_u_vv @ <>= pure function v_u_phiv (g, phi, k1, k2, v) result (w) complex(kind=default), intent(in) :: g, phi type(vector), intent(in) :: v type(momentum), intent(in) :: k1, k2 type(vector) :: w w = g * phi * ((k1*v)*k2 + & ((-(k1+k2))*v)*k1 + & ((k1*k1)*v)) end function v_u_phiv @ \section{Dim-6 Anoumalous Couplings with Higgs} <>= public :: s_vv_6D, v_sv_6D, s_vv_6DP, v_sv_6DP, a_hz_D, h_az_D, z_ah_D, & a_hz_DP, h_az_DP, z_ah_DP, h_hh_6 <>= pure function s_vv_6D (g, v1, k1, v2, k2) result (phi) complex(kind=default), intent(in) :: g type(vector), intent(in) :: v1, v2 type(momentum), intent(in) :: k1, k2 complex(kind=default) :: phi phi = g * (-(k1 * v1) * (k1 * v2) - (k2 * v1) * (k2 * v2) & + ((k1 * k1) + (k2 * k2)) * (v1 * v2)) end function s_vv_6D <>= pure function v_sv_6D (g, phi, kphi, v, kv) result (vout) complex(kind=default), intent(in) :: g complex(kind=default), intent(in) :: phi type(vector), intent(in) :: v type(momentum), intent(in) :: kphi, kv type(vector) :: vout vout = g * ( - phi * (kv * v) * kv - phi * ((kphi + kv) * v) * (kphi + kv) & + phi * (kv * kv) * v + phi * ((kphi + kv)*(kphi + kv)) * v) end function v_sv_6D <>= pure function s_vv_6DP (g, v1, k1, v2, k2) result (phi) complex(kind=default), intent(in) :: g type(vector), intent(in) :: v1, v2 type(momentum), intent(in) :: k1, k2 complex(kind=default) :: phi phi = g * ( (-(k1+k2)*v1) * (k1*v2) - ((k1+k2)*v2) * (k2*v1) + & ((k1+k2)*(k1+k2))*(v1*v2) ) end function s_vv_6DP <>= pure function v_sv_6DP (g, phi, kphi, v, kv) result (vout) complex(kind=default), intent(in) :: g complex(kind=default), intent(in) :: phi type(vector), intent(in) :: v type(momentum), intent(in) :: kphi, kv type(vector) :: vout vout = g * phi * ((-(kphi + kv)*v) * kphi + (kphi * v) * kv + & (kphi*kphi) * v ) end function v_sv_6DP <>= pure function a_hz_D (g, h1, k1, v2, k2) result (vout) complex(kind=default), intent(in) :: g complex(kind=default), intent(in) :: h1 type(vector), intent(in) :: v2 type(momentum), intent(in) :: k1, k2 type(vector) :: vout vout = g * h1 * (((k1 + k2) * v2) * (k1 + k2) + & ((k1 + k2) * (k1 + k2)) * v2) end function a_hz_D <>= pure function h_az_D (g, v1, k1, v2, k2) result (hout) complex(kind=default), intent(in) :: g type(vector), intent(in) :: v1, v2 type(momentum), intent(in) :: k1, k2 complex(kind=default) :: hout hout = g * ((k1 * v1) * (k1 * v2) + (k1 * k1) * (v1 * v2)) end function h_az_D <>= pure function z_ah_D (g, v1, k1, h2, k2) result (vout) complex(kind=default), intent(in) :: g complex(kind=default), intent(in) :: h2 type(vector), intent(in) :: v1 type(momentum), intent(in) :: k1, k2 type(vector) :: vout vout = g * h2 * ((k1 * v1) * k1 + ((k1 * k1)) *v1) end function z_ah_D <>= pure function a_hz_DP (g, h1, k1, v2, k2) result (vout) complex(kind=default), intent(in) :: g complex(kind=default), intent(in) :: h1 type(vector), intent(in) :: v2 type(momentum), intent(in) :: k1, k2 type(vector) :: vout vout = g * ((- h1 * (k1 + k2) * v2) * (k1) & + h1 * ((k1 + k2) * (k1)) *v2) end function a_hz_DP <>= pure function h_az_DP (g, v1, k1, v2, k2) result (hout) complex(kind=default), intent(in) :: g type(vector), intent(in) :: v1, v2 type(momentum), intent(in) :: k1, k2 complex(kind=default) :: hout hout = g * (- (k1 * v2) * ((k1 + k2) * v1) + (k1 * (k1 + k2)) * (v1 * v2)) end function h_az_DP <>= pure function z_ah_DP (g, v1, k1, h2, k2) result (vout) complex(kind=default), intent(in) :: g complex(kind=default), intent(in) :: h2 type(vector), intent(in) :: v1 type(momentum), intent(in) :: k1, k2 type(vector) :: vout vout = g * h2* ((k2 * v1) * k1 - (k1 * k2) * v1) end function z_ah_DP <>= pure function h_hh_6 (g, h1, k1, h2, k2) result (hout) complex(kind=default), intent(in) :: g complex(kind=default), intent(in) :: h1, h2 type(momentum), intent(in) :: k1, k2 complex(kind=default) :: hout hout = g * ((k1* k1) + (k2 * k2) + (k1* k2)) * h1 * h2 end function h_hh_6 @ \section{Dim-6 Anoumalous Couplings without Higgs} <>= public :: g_gg_13, g_gg_23, g_gg_6, kg_kgkg_i <>= pure function g_gg_23 (g, v1, k1, v2, k2) result (vout) complex(kind=default), intent(in) :: g type(vector), intent(in) :: v1, v2 type(momentum), intent(in) :: k1, k2 type(vector) :: vout vout = g * (v1 * (-2*(k1*v2)) + v2 * (2*k2 * v1) + (k1 - k2) * (v1*v2)) end function g_gg_23 <>= pure function g_gg_13 (g, v1, k1, v2, k2) result (vout) complex(kind=default), intent(in) :: g type(vector), intent(in) :: v1, v2 type(momentum), intent(in) :: k1, k2 type(vector) :: vout vout = g * (v1 * (2*(k1 + k2)*v2) - v2 * ((k1 + 2*k2) * v1) + 2*k2 * (v1 * v2)) end function g_gg_13 <>= pure function g_gg_6 (g, v1, k1, v2, k2) result (vout) complex(kind=default), intent(in) :: g type(vector), intent(in) :: v1, v2 type(momentum), intent(in) :: k1, k2 type(vector) :: vout vout = g * & ( k1 * ((-(k1 + k2) * v2) * (k2 * v1) + ((k1 + k2) * k2) * (v1 * v2)) & + k2 * (((k1 + k2) * v1) * (k1 * v2) - ((k1 + k2) * k1) * (v1 * v2)) & + v1 * (-((k1 + k2) * k2) * (k1 * v2) + (k1 * k2) * ((k1 + k2) * v2)) & + v2 * (((k1 + k2) * k1) * (k2 * v1) - (k1 * k2) * ((k1 + k2) * v1))) end function g_gg_6 <>= pure function kg_kgkg_i (g, a1, k1, a2, k2) result (a) complex(kind=default), intent(in) :: g type(vector), intent(in) :: a1, a2 type(momentum), intent(in) :: k1, k2 type(vector) :: a real(kind=default) :: k1k1, k2k2, k1k2, kk1, kk2 complex(kind=default) :: a1a2, k2a1, ka1, k1a2, ka2 k1k1 = k1 * k1 k1k2 = k1 * k2 k2k2 = k2 * k2 kk1 = k1k1 + k1k2 kk2 = k1k2 + k2k2 k2a1 = k2 * a1 ka1 = k2a1 + k1 * a1 k1a2 = k1 * a2 ka2 = k1a2 + k2 * a2 a1a2 = a1 * a2 a = (-1) * g * ( (kk2 * k1a2 - k1k2 * ka2 ) * a1 & + (k1k2 * ka1 - kk1 * k2a1) * a2 & + (ka2 * k2a1 - kk2 * a1a2) * k1 & + (kk1 * a1a2 - ka1 * k1a2) * k2 ) end function kg_kgkg_i @ \section{Dim-6 Anoumalous Couplings with AWW} <>= public ::a_ww_DP, w_aw_DP, a_ww_DW <>= pure function a_ww_DP (g, v1, k1, v2, k2) result (vout) complex(kind=default), intent(in) :: g type(vector), intent(in) :: v1, v2 type(momentum), intent(in) :: k1, k2 type(vector) :: vout vout = g * ( - ((k1 + k2) * v2) * v1 + ((k1 + k2) * v1) * v2) end function a_ww_DP <>= pure function w_aw_DP (g, v1, k1, v2, k2) result (vout) complex(kind=default), intent(in) :: g type(vector), intent(in) :: v1, v2 type(momentum), intent(in) :: k1, k2 type(vector) :: vout vout = g * ((k1 * v2) * v1 - (v1 * v2) * k1) end function w_aw_DP <>= pure function a_ww_DW (g, v1, k1, v2, k2) result (vout) complex(kind=default), intent(in) :: g type(vector), intent(in) :: v1, v2 type(momentum), intent(in) :: k1, k2 type(vector) :: vout vout = g * (v1 * (- (4*k1 + 2*k2) * v2) & + v2 * ( (2*k1 + 4*k2) * v1) & + (k1 - k2) * (2*v1*v2)) end function a_ww_DW <>= public :: w_wz_DPW, z_ww_DPW, w_wz_DW, z_ww_DW, w_wz_D, z_ww_D <>= pure function w_wz_DPW (g, v1, k1, v2, k2) result (vout) complex(kind=default), intent(in) :: g type(vector), intent(in) :: v1, v2 type(momentum), intent(in) :: k1, k2 type(vector) :: vout vout = g * (v1 * (-(k1+k2)*v2 - k1*v2) + v2 * ((k1+k2)*v1) + k1 * (v1*v2)) end function w_wz_DPW <>= pure function z_ww_DPW (g, v1, k1, v2, k2) result (vout) complex(kind=default), intent(in) :: g type(vector), intent(in) :: v1, v2 type(momentum), intent(in) :: k1, k2 type(vector) :: vout vout = g * (k1*(v1*v2) - k2*(v1*v2) - v1*(k1*v2) + v2*(k2*v1)) end function z_ww_DPW <>= pure function w_wz_DW (g, v1, k1, v2, k2) result (vout) complex(kind=default), intent(in) :: g type(vector), intent(in) :: v1, v2 type(momentum), intent(in) :: k1, k2 type(vector) :: vout vout = g * (v2 * (v1 * k2) - k2 * (v1 * v2)) end function w_wz_DW <>= pure function z_ww_DW (g, v1, k1, v2, k2) result (vout) complex(kind=default), intent(in) :: g type(vector), intent(in) :: v1, v2 type(momentum), intent(in) :: k1, k2 type(vector) :: vout vout = g * (v1 * ((-1)*(k1+k2) * v2) + v2 * ((k1+k2) * v1)) end function z_ww_DW <>= pure function w_wz_D (g, v1, k1, v2, k2) result (vout) complex(kind=default), intent(in) :: g type(vector), intent(in) :: v1, v2 type(momentum), intent(in) :: k1, k2 type(vector) :: vout vout = g * (v2 * (k2*v1) - k2 * (v1*v2)) end function w_wz_D <>= pure function z_ww_D (g, v1, k1, v2, k2) result (vout) complex(kind=default), intent(in) :: g type(vector), intent(in) :: v1, v2 type(momentum), intent(in) :: k1, k2 type(vector) :: vout vout = g * (v1 * (- (k1 + k2) * v2) + v2 * ((k1 + k2) * v1)) end function z_ww_D @ \section{Dim-6 Quartic Couplings} <>= public :: hhhh_p2, a_hww_DPB, h_aww_DPB, w_ahw_DPB, a_hww_DPW, h_aww_DPW, & w_ahw_DPW, a_hww_DW, h_aww_DW, w3_ahw_DW, w4_ahw_DW <>= pure function hhhh_p2 (g, h1, k1, h2, k2, h3, k3) result (hout) complex(kind=default), intent(in) :: g complex(kind=default), intent(in) :: h1, h2, h3 type(momentum), intent(in) :: k1, k2, k3 complex(kind=default) :: hout hout = g * h1*h2*h3* (k1*k1 + k2*k2 +k3*k3 + k1*k3 + k1*k2 + k2*k3) end function hhhh_p2 <>= pure function a_hww_DPB (g, h1, k1, v2, k2, v3, k3) result (vout) complex(kind=default), intent(in) :: g complex(kind=default), intent(in) :: h1 type(vector), intent(in) :: v2, v3 type(momentum), intent(in) :: k1, k2, k3 type(vector) :: vout vout = g * h1 * (v3*((k1+k2+k3)*v2) - v2*((k1+k2+k3)*v3)) end function a_hww_DPB <>= pure function h_aww_DPB (g, v1, k1, v2, k2, v3, k3) result (hout) complex(kind=default), intent(in) :: g type(vector), intent(in) :: v1, v2, v3 type(momentum), intent(in) :: k1, k2, k3 complex(kind=default) :: hout hout = g * ((k1 * v3) * (v1 * v2) - (k1 * v2) * (v1 * v3)) end function h_aww_DPB <>= pure function w_ahw_DPB (g, v1, k1, h2, k2, v3, k3) result (vout) complex(kind=default), intent(in) :: g complex(kind=default), intent(in) :: h2 type(vector), intent(in) :: v1, v3 type(momentum), intent(in) :: k1, k2, k3 type(vector) :: vout vout = g * h2 * (v1 * (k1 * v3) - k1 * (v1 * v3)) end function w_ahw_DPB <>= pure function a_hww_DPW (g, h1, k1, v2, k2, v3, k3) result (vout) complex(kind=default), intent(in) :: g complex(kind=default), intent(in) :: h1 type(vector), intent(in) :: v2, v3 type(momentum), intent(in) :: k1, k2, k3 type(vector) :: vout vout = g * h1 * (v3 * ((2*k1+k2+k3)*v2) - v2 * ((2*k1+k2+k3)*v3)) end function a_hww_DPW <>= pure function h_aww_DPW (g, v1, k1, v2, k2, v3, k3) result (hout) complex(kind=default), intent(in) :: g type(vector), intent(in) :: v1, v2, v3 type(momentum), intent(in) :: k1, k2, k3 complex(kind=default) :: hout hout = g * ((-(2*k1+k2+k3)*v2)*(v1*v3)+((2*k1+k2+k3)*v3)*(v1*v2)) end function h_aww_DPW <>= pure function w_ahw_DPW (g, v1, k1, h2, k2, v3, k3) result (vout) complex(kind=default), intent(in) :: g complex(kind=default), intent(in) :: h2 type(vector), intent(in) :: v1, v3 type(momentum), intent(in) :: k1, k2, k3 type(vector) :: vout vout = g * h2 * ((k2 - k1) * (v1 * v3) + v1 * ((k1 - k2) * v3)) end function w_ahw_DPW <>= pure function a_hww_DW (g, h1, k1, v2, k2, v3, k3) result (vout) complex(kind=default), intent(in) :: g complex(kind=default), intent(in) :: h1 type(vector), intent(in) :: v2, v3 type(momentum), intent(in) :: k1, k2, k3 type(vector) :: vout vout = g * h1 * ( v2 * (-(3*k1 + 4*k2 + 4*k3) * v3) & + v3 * ((3*k1 + 2*k2 + 4*k3) * v2) & + (k2 - k3) *2*(v2 * v3)) end function a_hww_DW <>= pure function h_aww_DW (g, v1, k1, v2, k2, v3, k3) result (hout) complex(kind=default), intent(in) :: g type(vector), intent(in) :: v1, v2, v3 type(momentum), intent(in) :: k1, k2, k3 complex(kind=default) :: hout hout = g * ((v1*v2) * ((3*k1 - k2 - k3)*v3) & + (v1*v3) * ((-3*k1 - k2 + k3)*v2) & + (v2*v3) * (2*(k2-k3)*v1)) end function h_aww_DW <>= pure function w3_ahw_DW (g, v1, k1, h2, k2, v3, k3) result (vout) complex(kind=default), intent(in) :: g complex(kind=default), intent(in) :: h2 type(vector), intent(in) :: v1, v3 type(momentum), intent(in) :: k1, k2, k3 type(vector) :: vout vout = g * h2 * (v1 * ((4*k1 + k2) * v3) & +v3 * (-2*(k1 + k2 + 2*k3) * v1) & +(-2*k1 + k2 + 2*k3) * (v1*v3)) end function w3_ahw_DW <>= pure function w4_ahw_DW (g, v1, k1, h2, k2, v3, k3) result (vout) complex(kind=default), intent(in) :: g complex(kind=default), intent(in) :: h2 type(vector), intent(in) :: v1, v3 type(momentum), intent(in) :: k1, k2, k3 type(vector) :: vout vout = g * h2 * (v1 * (-(4*k1 + k2 + 2*k3) * v3) & + v3 * (2*(k1 + k2 + 2*k3) * v1) & +(4*k1 + k2) * (v1*v3)) end function w4_ahw_DW <>= public ::a_aww_DW, w_aaw_DW, a_aww_W, w_aaw_W <>= pure function a_aww_DW (g, v1, k1, v2, k2, v3, k3) result (vout) complex(kind=default), intent(in) :: g type(vector), intent(in) :: v1, v2, v3 type(momentum), intent(in) :: k1, k2, k3 type(vector) :: vout vout = g * (2*v1*(v2*v3) - v2*(v1*v3) - v3*(v1*v2)) end function a_aww_DW pure function w_aaw_DW (g, v1, k1, v2, k2, v3, k3) result (vout) complex(kind=default), intent(in) :: g type(vector), intent(in) :: v1, v2, v3 type(momentum), intent(in) :: k1, k2, k3 type(vector) :: vout vout = g * (2*v3*(v1*v2) - v2*(v1*v3) - v1*(v2*v3)) end function w_aaw_DW pure function a_aww_W (g, v1, k1, v2, k2, v3, k3) result (vout) complex(kind=default), intent(in) :: g type(vector), intent(in) :: v1, v2, v3 type(momentum), intent(in) :: k1, k2, k3 type(vector) :: vout vout = g * (v1*((-(k2+k3)*v2)*(k2*v3) + (-(k2+k3)*v3)*(k3*v2)) & +v2*((-((k2-k3)*v1)*(k1+k2+k3)*v3) - (k1*v3)*(k2*v1) & + ((k1+k2+k3)*v1)*(k2*v3)) & +v3*(((k2-k3)*v1)*((k1+k2+k3)*v2) - (k1*v2)*(k3*v1) & + ((k1+k2+k3)*v1)*(k3*v2)) & +(v1*v2)*(((2*k1+k2+k3)*v3)*k2 - (k2*v3)*k1 -(k1*v3)*k3) & +(v1*v3)*(((2*k1+k2+k3)*v2)*k3 - (k3*v2)*k1 - (k1*v2)*k3) & +(v2*v3)*((-(k1+k2+k3)*v1)*(k2+k3) + ((k2+k3)*v1)*k1) & +(-(k1+k2+k3)*k3 +k1*k2)*((v1*v3)*v2 - (v2*v3)*v1) & +(-(k1+k2+k3)*k2 + k1*k3)*((v1*v2)*v3 - (v2*v3)*v1)) end function a_aww_W pure function w_aaw_W (g, v1, k1, v2, k2, v3, k3) result (vout) complex(kind=default), intent(in) :: g type(vector), intent(in) :: v1, v2, v3 type(momentum), intent(in) :: k1, k2, k3 type(vector) :: vout vout = g * (v1*((k1*v3)*(-(k1+k2+2*k3)*v2) + (k2*v3)*((k1+k2+k3)*v2) & + (k1*v2)*((k1+k2+k3)*v3)) & + v2*(((k1-k2)*v3)*((k1+k2+k3)*v1) - (k2*v3)*(k3*v1) & + (k2*v1)*((k1+k2+k3)*v3)) & + v3*((k1*v2)*(-(k1+k2)*v1) + (k2*v1)*(-(k1+k2)*v2)) & + (v1*v2)*((k1+k2)*(-(k1+k2+k3)*v3) + k3*((k1+k2)*v3))& + (v1*v3)*(-k2*(k3*v2) - k3*(k1*v2) + k1*((k1+k2+2*k3)*v2)) & + (v2*v3)*(-k1*(k3*v1) - k3*(k2*v1) + k2*((k1+k2+2*k3)*v1)) & + (-k2*(k1+k2+k3) + k1*k3)*(v1*(v2*v3) - v3*(v1*v2)) & + (-k1*(k1+k2+k3) + k2*k3)*(v2*(v1*v3) - v3*(v1*v2)) ) end function w_aaw_W <>= public :: h_hww_D, w_hhw_D, h_hww_DP, w_hhw_DP, h_hvv_PB, v_hhv_PB <>= pure function h_hww_D (g, h1, k1, v2, k2, v3, k3) result (hout) complex(kind=default), intent(in) :: g complex(kind=default), intent(in) :: h1 type(vector), intent(in) :: v2, v3 type(momentum), intent(in) :: k1, k2, k3 complex(kind=default) :: hout hout = g * h1 * ((v2*v3)*((k2*k2)+(k3*k3)) - (k2*v2)*(k2*v3) & - (k3*v2)*(k3*v3)) end function h_hww_D <>= pure function w_hhw_D (g, h1, k1, h2, k2, v3, k3) result (vout) complex(kind=default), intent(in) :: g complex(kind=default), intent(in) :: h1, h2 type(vector), intent(in) :: v3 type(momentum), intent(in) :: k1, k2, k3 type(vector) :: vout vout = g * h1 * h2 * (v3 * ((k1+k2+k3)*(k1+k2+k3)+(k3*k3)) & - (k1+k2+k3) * ((k1+k2+k3)*v3) - k3 * (k3*v3)) end function w_hhw_D <>= pure function h_hww_DP (g, h1, k1, v2, k2, v3, k3) result (hout) complex(kind=default), intent(in) :: g complex(kind=default), intent(in) :: h1 type(vector), intent(in) :: v2, v3 type(momentum), intent(in) :: k1, k2, k3 complex(kind=default) :: hout hout = g * h1 * (-((k2+k3)*v2)*(k2*v3) - & ((k2+k3)*v3)*(k3*v2)+ (v2*v3)*((k2+k3)*(k2+k3))) end function h_hww_DP <>= pure function w_hhw_DP (g, h1, k1, h2, k2, v3, k3) result (vout) complex(kind=default), intent(in) :: g complex(kind=default), intent(in) :: h1, h2 type(vector), intent(in) :: v3 type(momentum), intent(in) :: k1, k2, k3 type(vector) :: vout vout = g * h1 * h2 * (k3*((k1+k2)*v3) + (k1+k2)*(-(k1+k2+k3)*v3) & + v3*((k1+k2)*(k1+k2))) end function w_hhw_DP <>= pure function h_hvv_PB (g, h1, k1, v2, k2, v3, k3) result (hout) complex(kind=default), intent(in) :: g complex(kind=default), intent(in) :: h1 type(vector), intent(in) :: v2, v3 type(momentum), intent(in) :: k1, k2, k3 complex(kind=default) :: hout hout = g * h1 * ((k2*v3)*(k3*v2) - (k2*k3)*(v2*v3)) end function h_hvv_PB <>= pure function v_hhv_PB (g, h1, k1, h2, k2, v3, k3) result (vout) complex(kind=default), intent(in) :: g complex(kind=default), intent(in) :: h1, h2 type(vector), intent(in) :: v3 type(momentum), intent(in) :: k1, k2, k3 type(vector) :: vout vout = g * h1 * h2 * ((-(k1+k2+k3)*v3)*k3 + ((k1+k2+k3)*k3)*v3) end function v_hhv_PB <>= public :: a_hhz_D, h_ahz_D, z_ahh_D, a_hhz_DP, h_ahz_DP, z_ahh_DP, & a_hhz_PB, h_ahz_PB, z_ahh_PB <>= pure function a_hhz_D (g, h1, k1, h2, k2, v3, k3) result (vout) complex(kind=default), intent(in) :: g complex(kind=default), intent(in) :: h1, h2 type(vector), intent(in) :: v3 type(momentum), intent(in) :: k1, k2, k3 type(vector) :: vout vout = g * h1 * h2 * ((k1+k2+k3) * ((k1+k2+k3)*v3) & - v3 * ((k1+k2+k3)*(k1+k2+k3))) end function a_hhz_D <>= pure function h_ahz_D (g, v1, k1, h2, k2, v3, k3) result (hout) complex(kind=default), intent(in) :: g complex(kind=default), intent(in) :: h2 type(vector), intent(in) :: v1, v3 type(momentum), intent(in) :: k1, k2, k3 complex(kind=default) :: hout hout = g * h2 * ((k1*v1)*(k1*v3) - (k1*k1)*(v1*v3)) end function h_ahz_D <>= pure function z_ahh_D (g, v1, k1, h2, k2, h3, k3) result (vout) complex(kind=default), intent(in) :: g type(vector), intent(in) :: v1 complex(kind=default), intent(in) :: h2, h3 type(momentum), intent(in) :: k1, k2, k3 type(vector) :: vout vout = g * h2 * h3 * ((k1*v1)*k1 - (k1*k1)*v1) end function z_ahh_D <>= pure function a_hhz_DP (g, h1, k1, h2, k2, v3, k3) result (vout) complex(kind=default), intent(in) :: g complex(kind=default), intent(in) :: h1, h2 type(vector), intent(in) :: v3 type(momentum), intent(in) :: k1, k2, k3 type(vector) :: vout vout = g * h1 * h2 * ((-(k1+k2+k3)*v3)*(k1+k2) + ((k1+k2+k3)*(k1+k2))*v3) end function a_hhz_DP <>= pure function h_ahz_DP (g, v1, k1, h2, k2, v3, k3) result (hout) complex(kind=default), intent(in) :: g complex(kind=default), intent(in) :: h2 type(vector), intent(in) :: v1, v3 type(momentum), intent(in) :: k1, k2, k3 complex(kind=default) :: hout hout = g * h2 * ( (k1*v3)*(-(k1+k3)*v1) + (k1*(k1+k3))*(v1*v3) ) end function h_ahz_DP <>= pure function z_ahh_DP (g, v1, k1, h2, k2, h3, k3) result (vout) complex(kind=default), intent(in) :: g type(vector), intent(in) :: v1 complex(kind=default), intent(in) :: h2, h3 type(momentum), intent(in) :: k1, k2, k3 type(vector) :: vout vout = g * h2 * h3 * (k1*((k2+k3)*v1) - v1*(k1*(k2+k3))) end function z_ahh_DP <>= pure function a_hhz_PB (g, h1, k1, h2, k2, v3, k3) result (vout) complex(kind=default), intent(in) :: g complex(kind=default), intent(in) :: h1, h2 type(vector), intent(in) :: v3 type(momentum), intent(in) :: k1, k2, k3 type(vector) :: vout vout = g * h1 * h2 * (k3*((k1+k2+k3)*v3) - v3*((k1+k2+k3)*k3)) end function a_hhz_PB <>= pure function h_ahz_PB (g, v1, k1, h2, k2, v3, k3) result (hout) complex(kind=default), intent(in) :: g complex(kind=default), intent(in) :: h2 type(vector), intent(in) :: v1, v3 type(momentum), intent(in) :: k1, k2, k3 complex(kind=default) :: hout hout = g * h2 * ((-k1*v3)*(k3*v1) + (k1*k3)*(v1*v3)) end function h_ahz_PB <>= pure function z_ahh_PB (g, v1, k1, h2, k2, h3, k3) result (vout) complex(kind=default), intent(in) :: g type(vector), intent(in) :: v1 complex(kind=default), intent(in) :: h2, h3 type(momentum), intent(in) :: k1, k2, k3 type(vector) :: vout vout = g * h2 * h3 * (k1*((k1+k2+k3)*v1) - v1*(k1*(k1+k2+k3))) end function z_ahh_PB <>= public :: h_wwz_DW, w_hwz_DW, z_hww_DW, h_wwz_DPB, w_hwz_DPB, z_hww_DPB public :: h_wwz_DDPW, w_hwz_DDPW, z_hww_DDPW, h_wwz_DPW, w_hwz_DPW, z_hww_DPW <>= pure function h_wwz_DW (g, v1, k1, v2, k2, v3, k3) result (hout) complex(kind=default), intent(in) :: g type(vector), intent(in) :: v1, v2, v3 type(momentum), intent(in) :: k1, k2, k3 complex(kind=default) :: hout hout = g * (((k1-k2)*v3)*(v1*v2)-((2*k1+k2)*v2)*(v1*v3) + & ((k1+2*k2)*v1)*(v2*v3)) end function h_wwz_DW <>= pure function w_hwz_DW (g, h1, k1, v2, k2, v3, k3) result (vout) complex(kind=default), intent(in) :: g complex(kind=default), intent(in) :: h1 type(vector), intent(in) :: v2, v3 type(momentum), intent(in) :: k1, k2, k3 type(vector) :: vout vout = g * h1 * ( v2*(-(k1+2*k2+k3)*v3) + v3*((2*k1+k2+2*k3)*v2) - & (k1 - k2 + k3)*(v2*v3)) end function w_hwz_DW <>= pure function z_hww_DW (g, h1, k1, v2, k2, v3, k3) result (vout) complex(kind=default), intent(in) :: g complex(kind=default), intent(in) :: h1 type(vector), intent(in) :: v2, v3 type(momentum), intent(in) :: k1, k2, k3 type(vector) :: vout vout = g * h1 * ((k2-k3)*(v2*v3) - v2*((2*k2+k3)*v3) + v3*((k2+2*k3)*v2)) end function z_hww_DW <>= pure function h_wwz_DPB (g, v1, k1, v2, k2, v3, k3) result (hout) complex(kind=default), intent(in) :: g type(vector), intent(in) :: v1, v2, v3 type(momentum), intent(in) :: k1, k2, k3 complex(kind=default) :: hout hout = g * ((k3*v1)*(v2*v3) - (k3*v2)*(v1*v3)) end function h_wwz_DPB <>= pure function w_hwz_DPB (g, h1, k1, v2, k2, v3, k3) result (vout) complex(kind=default), intent(in) :: g complex(kind=default), intent(in) :: h1 type(vector), intent(in) :: v2, v3 type(momentum), intent(in) :: k1, k2, k3 type(vector) :: vout vout = g * h1 * (k3*(v2*v3) - v3*(k3*v2)) end function w_hwz_DPB <>= pure function z_hww_DPB (g, h1, k1, v2, k2, v3, k3) result (vout) complex(kind=default), intent(in) :: g complex(kind=default), intent(in) :: h1 type(vector), intent(in) :: v2, v3 type(momentum), intent(in) :: k1, k2, k3 type(vector) :: vout vout = g * h1 * (((k1+k2+k3)*v3)*v2 - ((k1+k2+k3)*v2)*v3) end function z_hww_DPB <>= pure function h_wwz_DDPW (g, v1, k1, v2, k2, v3, k3) result (hout) complex(kind=default), intent(in) :: g type(vector), intent(in) :: v1, v2, v3 type(momentum), intent(in) :: k1, k2, k3 complex(kind=default) :: hout hout = g * (((k1-k2)*v3)*(v1*v2)-((k1-k3)*v2)*(v1*v3)+((k2-k3)*v1)*(v2*v3)) end function h_wwz_DDPW <>= pure function w_hwz_DDPW (g, h1, k1, v2, k2, v3, k3) result (vout) complex(kind=default), intent(in) :: g complex(kind=default), intent(in) :: h1 type(vector), intent(in) :: v2, v3 type(momentum), intent(in) :: k1, k2, k3 type(vector) :: vout vout = g * h1 * ((-(k1+2*k2+k3)*v3)*v2 + ((k1+k2+2*k3)*v2)*v3 + & (v2*v3)*(k2-k3)) end function w_hwz_DDPW <>= pure function z_hww_DDPW (g, h1, k1, v2, k2, v3, k3) result (vout) complex(kind=default), intent(in) :: g complex(kind=default), intent(in) :: h1 type(vector), intent(in) :: v2, v3 type(momentum), intent(in) :: k1, k2, k3 type(vector) :: vout vout = g * h1 * ((v2*v3)*(k2-k3) - ((k1+2*k2+k3)*v3) *v2 + & ((k1+k2+2*k3)*v2)*v3 ) end function z_hww_DDPW <>= pure function h_wwz_DPW (g, v1, k1, v2, k2, v3, k3) result (hout) complex(kind=default), intent(in) :: g type(vector), intent(in) :: v1, v2, v3 type(momentum), intent(in) :: k1, k2, k3 complex(kind=default) :: hout hout = g * (((k1-k2)*v3)*(v1*v2) + (-(2*k1+k2+k3)*v2)*(v1*v3) + & ((k1+2*k2+k3)*v1)*(v2*v3)) end function h_wwz_DPW <>= pure function w_hwz_DPW (g, h1, k1, v2, k2, v3, k3) result (vout) complex(kind=default), intent(in) :: g complex(kind=default), intent(in) :: h1 type(vector), intent(in) :: v2, v3 type(momentum), intent(in) :: k1, k2, k3 type(vector) :: vout vout = g * h1 * ((-(k1+2*k2+k3)*v3)*v2 + ((2*k1+k2+k3)*v2)*v3 + & (v2*v3)*(k2-k1)) end function w_hwz_DPW <>= pure function z_hww_DPW (g, h1, k1, v2, k2, v3, k3) result (vout) complex(kind=default), intent(in) :: g complex(kind=default), intent(in) :: h1 type(vector), intent(in) :: v2, v3 type(momentum), intent(in) :: k1, k2, k3 type(vector) :: vout vout = g * h1 * ((v2*v3)*(k2-k3) + ((k1-k2)*v3)*v2 + ((k3-k1)*v2)*v3) end function z_hww_DPW @ \section{Scalar3 Dim-5 Couplings} <>= public :: phi_dim5s2 @ \begin{equation} \phi_1(k_1) = g (k_2 \cdot k_3) \phi_2 (k_2) \phi_3 (k_3) \end{equation} <>= pure function phi_dim5s2 (g, phi2, k2, phi3, k3) result (phi1) complex(kind=default), intent(in) :: g, phi2, phi3 type(momentum), intent(in) :: k2, k3 complex(kind=default) :: phi1 phi1 = g * phi2 * phi3 * (k2 * k3) end function phi_dim5s2 @ \section{Tensorscalar-Scalar Couplings} <>= public :: tphi_ss, tphi_ss_cf, s_tphis, s_tphis_cf @ \begin{equation} \phi(k_1 + k_2) = 2 g ((k_1 \cdot k_2) + (k_1 \cdot k_1)) ((k_1 \cdot k_2) + (k_2 \cdot k_2)) \phi_1 (k_1) \phi_2 (k_2) \end{equation} <>= pure function tphi_ss (g, phi1, k1, phi2, k2) result (phi) complex(kind=default), intent(in) :: g, phi1, phi2 type(momentum), intent(in) :: k1, k2 complex(kind=default) :: phi phi = 2 * g * phi1 * phi2 * & ((k1 * k2)+ (k1 * k1)) * & ((k1 * k2)+ (k2 * k2)) end function tphi_ss @ \begin{equation} \phi(k_1 + k_2) = - g/2 (k_1 \cdot k_2) ((k_1 + k_2) \cdot (k_1 + k_2)) \phi_1 (k_1) \phi_2 (k_2) \end{equation} <>= pure function tphi_ss_cf (g, phi1, k1, phi2, k2) result (phi) complex(kind=default), intent(in) :: g, phi1, phi2 type(momentum), intent(in) :: k1, k2 complex(kind=default) :: phi phi = - g/2 * phi1 * phi2 * & (k1 * k2) * & ((k1 + k2) * (k1 + k2)) end function tphi_ss_cf @ \begin{equation} \phi_1(k_1) = 2 g ((k_1 \cdot k_2) + (k_1 \cdot k_1)) ((k_1 \cdot k_2) + (k_2 \cdot k_2)) \phi(k_2-k_1) \phi_2 (k_2) \end{equation} <>= pure function s_tphis (g, phi, k, phi2, k2) result (phi1) complex(kind=default), intent(in) :: g, phi, phi2 type(momentum), intent(in) :: k, k2 complex(kind=default) :: phi1 type(momentum) :: k1 k1 = - ( k + k2) phi1 = 2 * g * phi * phi2 * & ((k1 * k2)+ (k1 * k1)) * & ((k1 * k2)+ (k2 * k2)) end function s_tphis @ \begin{equation} \phi_1(k_1) = - g/2 (k_1 \cdot k_2) ((k_1 + k_2) \cdot (k_1 + k_2)) \phi (k_2 -k_1) \phi_2 (k_2) \end{equation} <>= pure function s_tphis_cf (g, phi, k, phi2, k2) result (phi1) complex(kind=default), intent(in) :: g, phi, phi2 type(momentum), intent(in) :: k, k2 complex(kind=default) :: phi1 type(momentum) :: k1 k1 = - ( k + k2) phi1 = - g/2 * phi * phi2 * & (k1 * k2) * & ((k1 + k2) * (k1 + k2)) end function s_tphis_cf @ \section{Scalar2-Vector2 Dim-8 Couplings} <>= public :: phi_phi2v_1, v_phi2v_1, phi_phi2v_2, v_phi2v_2 @ \begin{equation} \phi_2(k_2) = g \left (\left ( k_1 \cdot V_1 \right ) \left ( k_2 \cdot V_2 \right ) + \left ( k_1 \cdot V_1 \right )\left ( k_1 \cdot V_2 \right ) \right ) \phi_1 (k_1) \end{equation} <>= pure function phi_phi2v_1 (g, phi1, k1, v1, k_v1, v2, k_v2) result (phi2) complex(kind=default), intent(in) :: g, phi1 type(momentum), intent(in) :: k1, k_v1, k_v2 type(momentum) :: k2 type(vector), intent(in) :: v1, v2 complex(kind=default) :: phi2 k2 = - k1 - k_v1 - k_v2 phi2 = g * phi1 * & ( (k1 * v1) * (k2 * v2) + (k1 * v2) * (k2 * v1) ) end function phi_phi2v_1 @ \begin{equation} V_2^\mu =g \left ( k_1^\mu \left ( k_2 \cdot V_1 \right ) + k_2^\mu \left ( k_1 \cdot V_1 \right ) \right ) \phi_1 (k_1) \phi_2 (k_2) \end{equation} <>= pure function v_phi2v_1 (g, phi1, k1, phi2, k2, v1) result (v2) complex(kind=default), intent(in) :: g, phi1, phi2 type(momentum), intent(in) :: k1, k2 type(vector), intent(in) :: v1 type(vector) :: v2 v2 = g * phi1 * phi2 * & ( k1 * (k2 * v1) + k2 * (k1 * v1) ) end function v_phi2v_1 @ \begin{equation} \phi_2(k_2) = g \left ( k_1 \cdot k_2 \right ) \left ( V_1\cdot V_2 \right) \phi_1 (k_1) \end{equation} <>= pure function phi_phi2v_2 (g, phi1, k1, v1,k_v1, v2, k_v2) result (phi2) complex(kind=default), intent(in) :: g, phi1 type(momentum), intent(in) :: k1, k_v1, k_v2 type(vector), intent(in) :: v1, v2 type(momentum) :: k2 complex(kind=default) :: phi2 k2 = - k1 - k_v1 - k_v2 phi2 = g * phi1 * (k1 * k2) * (v1 * v2) end function phi_phi2v_2 @ \begin{equation} V_2^\mu = g V_1^\mu \left ( k_1 \cdot k_2 \right ) \phi_1 \phi_2 \end{equation} <>= pure function v_phi2v_2 (g, phi1, k1, phi2, k2, v1) result (v2) complex(kind=default), intent(in) :: g, phi1, phi2 type(momentum), intent(in) :: k1, k2 type(vector), intent(in) :: v1 type(vector) :: v2 v2 = g * phi1 * phi2 * & ( k1 * k2 ) * v1 end function v_phi2v_2 @ \section{Scalar4 Dim-8 Couplings} <>= public :: s_dim8s3 @ \begin{equation} \phi(k_1) = g \left [ \left ( k_1 \cdot k_2 \right ) \left ( k_3 \cdot k_4 \right )+ \left ( k_1 \cdot k_3 \right ) \left ( k_2 \cdot k_4 \right ) + \left ( k_1 \cdot k_4 \right )\left ( k_2 \cdot k_3 \right ) \right ] \phi_2 (k_2) \phi_3 (k_3) \phi_4 (k_4) \end{equation} <>= pure function s_dim8s3 (g, phi2, k2, phi3, k3, phi4, k4) result (phi1) complex(kind=default), intent(in) :: g, phi2, phi3, phi4 type(momentum), intent(in) :: k2, k3, k4 type(momentum) :: k1 complex(kind=default) :: phi1 k1 = - k2 - k3 - k4 phi1 = g * ( (k1 * k2) * (k3 * k4) + (k1 * k3) * (k2 * k4) & + (k1 * k4) * (k2 * k3) ) * phi2 * phi3 * phi4 end function s_dim8s3 @ \section{Mixed Scalar2-Vector2 Dim-8 Couplings} <>= public :: phi_phi2v_m_0, v_phi2v_m_0, phi_phi2v_m_1, v_phi2v_m_1, phi_phi2v_m_7, v_phi2v_m_7 @ \begin{equation} \phi_2(k_2) = g \left (\left ( V_1 \cdot k_{V_2} \right ) \left ( V_2 \cdot k_{V_1} \right ) \left ( k_1 \cdot k_2 \right ) - (\left ( V_1 \cdot V_2 \right ) \left ( k_{V_1} \cdot k_{V_2} \right ) \left ( k_1 \cdot k_2 \right ) \right ) \phi_1 (k_1) \end{equation} <>= pure function phi_phi2v_m_0 (g, phi1, k1, v1, k_v1, v2, k_v2) result (phi2) complex(kind=default), intent(in) :: g, phi1 type(momentum), intent(in) :: k1, k_v1, k_v2 type(momentum) :: k2 type(vector), intent(in) :: v1, v2 complex(kind=default) :: phi2 k2 = - k1 - k_v1 - k_v2 phi2 = g * phi1 * & ( (v1 * k_v2) * (v2 * k_v1) * (k1 * k2) & - (v1 * v2) * (k_v1 * k_v2) * (k1 * k2) ) end function phi_phi2v_m_0 @ \begin{equation} V_2^\mu =g \left ( k_{V_1}^\mu \left ( V_1 \cdot k_{V_2} \right ) \left ( k_1 \cdot k_2 \right ) - V_1^\mu \left ( k_{V_1} \cdot k_{V_2} \right ) \left ( k_1 \cdot k_2 \right ) \right ) \phi_1 (k_1) \phi_2 (k_2)) \end{equation} <>= pure function v_phi2v_m_0 (g, phi1, k1, phi2, k2, v1, k_v1) result (v2) complex(kind=default), intent(in) :: g, phi1, phi2 type(momentum), intent(in) :: k1, k2, k_v1 type(vector), intent(in) :: v1 type(momentum) :: k_v2 type(vector) :: v2 k_v2 = - k_v1 - k1 - k2 v2 = g * phi1 * phi2 * & ( k_v1 * (v1 * k_v2) * (k1 * k2) & - v1 * (k_v2 * k_v1) * (k1 * k2) ) end function v_phi2v_m_0 @ \begin{equation} \phi_2(k_2) = g \left (\left ( V_1 \cdot V_2 \right ) \left ( k_1 \cdot k_{V_2} \right ) \left ( k_2 \cdot k_{V_1} \right ) + (\left ( V_1 \cdot V_2 \right ) \left ( k_1 \cdot k_{V_1} \right ) \left ( k_2 \cdot k_{V_2} \right ) \\ + (\left ( V_1 \cdot k_2 \right ) \left ( V_2 \cdot k_1 \right ) \left ( k_{V_1} \cdot k_{V_2} \right ) + (\left ( V_1 \cdot k_1 \right ) \left ( V_2 \cdot k_2 \right ) \left ( k_{V_1} \cdot k_{V_2} \right ) \\ - (\left ( V_1 \cdot k_{V_2} \right ) \left ( V_2 \cdot k_2 \right ) \left ( k_1 \cdot k_{V_1} \right ) - (\left ( V_1 \cdot k_2 \right ) \left ( V_2 \cdot k_{V_1} \right ) \left ( k_1 \cdot k_{V_2} \right ) \\ - (\left ( V_1 \cdot k_{V_2} \right ) \left ( V_2 \cdot k_1 \right ) \left ( k_2 \cdot k_{V_1} \right ) - (\left ( V_1 \cdot k_1 \right ) \left ( V_2 \cdot k_{V_1} \right ) \left ( k_2 \cdot k_{V_2} \right ) \right ) \phi_1 (k_1) \end{equation} <>= pure function phi_phi2v_m_1 (g, phi1, k1, v1, k_v1, v2, k_v2) result (phi2) complex(kind=default), intent(in) :: g, phi1 type(momentum), intent(in) :: k1, k_v1, k_v2 type(momentum) :: k2 type(vector), intent(in) :: v1, v2 complex(kind=default) :: phi2 k2 = - k1 - k_v1 - k_v2 phi2 = g * phi1 * & ( (v1 * v2) * (k1 * k_v2) * (k2 * k_v1) & + (v1 * v2) * (k1 * k_v1) * (k2 * k_v2) & + (v1 * k2) * (v2 * k1) * (k_v1 * k_v2) & + (v1 * k1) * (v2 * k2) * (k_v1 * k_v2) & - (v1 * k_v2) * (v2 * k2) * (k1 * k_v1) & - (v1 * k2) * (v2 * k_v1) * (k1 * k_v2) & - (v1 * k_v2) * (v2 * k1) * (k2 * k_v1) & - (v1 * k1) * (v2 * k_v1) * (k2 * k_v2) ) end function phi_phi2v_m_1 @ \begin{equation} V_2^\mu =g \left ( k_1^\mu \left ( V_1 \cdot k_2 \right ) \left ( k_{V_1} \cdot k_{V_2} \right ) \\ + k_2^\mu \left ( V_1 \cdot k_1 \right ) \left ( k_{V_1} \cdot k_{V_2} \right ) \\ + V_1^\mu \left ( k_{V_1} \cdot k_1 \right ) \left ( k_{V_2} \cdot k_2 \right ) \\ + V_1^\mu \left ( k_{V_1} \cdot k_2 \right ) \left ( k_{V_2} \cdot k_1 \right ) \\ - k_1^\mu \left ( V_1 \cdot k_{V_2} \right ) \left ( k_{V_1} \cdot k_2 \right ) \\ - k_2^\mu \left ( V_1 \cdot k_{V_2} \right ) \left ( k_{V_1} \cdot k_1 \right ) \\ - k_{V_1}^\mu \left ( V_1 \cdot k_1 \right ) \left ( k_{V_2} \cdot k_2 \right ) \\ - k_{V_1}^\mu \left ( V_1 \cdot k_2 \right ) \left ( k_{V_2} \cdot k_1 \right ) \right ) \\ \phi_1 (k_1) \phi_2 (k_2) \end{equation} <>= pure function v_phi2v_m_1 (g, phi1, k1, phi2, k2, v1, k_v1) result (v2) complex(kind=default), intent(in) :: g, phi1, phi2 type(momentum), intent(in) :: k1, k2, k_v1 type(vector), intent(in) :: v1 type(momentum) :: k_v2 type(vector) :: v2 k_v2 = - k_v1 - k1 - k2 v2 = g * phi1 * phi2 * & ( k1 * (v1 * k2) * (k_v1 * k_v2) & + k2 * (v1 * k1) * (k_v1 * k_v2) & + v1 * (k_v1 * k1) * (k_v2 * k2) & + v1 * (k_v1 * k2) * (k_v2 * k1) & - k1 * (v1 * k_v2) * (k_v1 * k2) & - k2 * (v1 * k_v2) * (k_v1 * k1) & - k_v1 * (v1 * k1) * (k_v2 * k2) & - k_v1 * (v1 * k2) * (k_v2 * k1) ) end function v_phi2v_m_1 @ \begin{equation} \phi_2(k_2) = g \left (\left ( V_1 \cdot k_{V_2} \right ) \left ( k_1 \cdot V_2 \right ) \left ( k_2 \cdot k_{V_1} \right ) + (\left ( V_1 \cdot k_{V_2} \right ) \left ( k_1 \cdot k_{V_1} \right ) \left ( k_2 \cdot k_{V_2} \right ) \\ + (\left ( V_1 \cdot k_1 \right ) \left ( V_2 \cdot k_{V_1} \right ) \left ( k_2 \cdot k_{V_2} \right ) + (\left ( V_1 \cdot k_2 \right ) \left ( V_2 \cdot k_{V_1} \right ) \left ( k_1 \cdot k_{V_2} \right ) \\ - (\left ( V_1 \cdot V_2 \right ) \left ( k_1 \cdot k_{V_2} \right ) \left ( k_2 \cdot k_{V_1} \right ) - (\left ( V_1 \cdot V_2 \right ) \left ( k_1 \cdot k_{V_1} \right ) \left ( k_2 \cdot k_{V_2} \right ) \\ - (\left ( V_1 \cdot k_2 \right ) \left ( V_2 \cdot k_1 \right ) \left ( k_{V_1} \cdot k_{V_2} \right ) - (\left ( V_1 \cdot k_1 \right ) \left ( V_2 \cdot k_2 \right ) \left ( k_{V_1} \cdot k_{V_2} \right ) \right ) \phi_1 (k_1) \end{equation} <>= pure function phi_phi2v_m_7 (g, phi1, k1, v1, k_v1, v2, k_v2) result (phi2) complex(kind=default), intent(in) :: g, phi1 type(momentum), intent(in) :: k1, k_v1, k_v2 type(momentum) :: k2 type(vector), intent(in) :: v1, v2 complex(kind=default) :: phi2 k2 = - k1 - k_v1 - k_v2 phi2 = g * phi1 * & ( (v1 * k_v2) * (k1 * v2) * (k2 * k_v1) & + (v1 * k_v2) * (k1 * k_v1) * (k2 * v2) & + (v1 * k1) * (v2 * k_v1) * (k2 * k_v2) & + (v1 * k2) * (v2 * k_v1) * (k1 * k_v2) & - (v1 * v2) * (k1 * k_v2) * (k2 * k_v1) & - (v1 * v2) * (k1 * k_v1) * (k2 * k_v2) & - (v1 * k2) * (v2 * k1) * (k_v1 * k_v2) & - (v1 * k1) * (v2 * k2) * (k_v1 * k_v2) ) end function phi_phi2v_m_7 @ \begin{equation} V_2^\mu =g \left ( k_1^\mu \left ( V_1 \cdot k_{V_2} \right ) \left ( k_2 \cdot k_{V_1} \right ) \\ + k_2^\mu \left ( V_1 \cdot k_{V_2} \right ) \left ( k_1 \cdot k_{V_1} \right ) \\ + k_{V_1}^\mu \left ( V_1 \cdot k_1 \right ) \left ( k_2 \cdot k_{V_2} \right ) \\ + k_{V_1}^\mu \left ( V_1 \cdot k_2 \right ) \left ( k_1 \cdot k_{V_2} \right ) \\ - k_1^\mu \left ( V_1 \cdot k_2 \right ) \left ( k_{V_1} \cdot k_{V_2} \right ) \\ - k_2^\mu \left ( V_1 \cdot k_1 \right ) \left ( k_{V_1} \cdot k_{V_2} \right ) \\ - k_{V_1}^\mu \left ( k_1 \cdot k_{V_2} \right ) \left ( k_2 \cdot k_{V_1} \right ) \\ - k_{V_1}^\mu \left ( k_1 \cdot k_{V_1} \right ) \left ( k_2 \cdot k_{V_2} \right ) \right ) \\ \phi_1 (k_1) \phi_2 (k_2) \end{equation} <>= pure function v_phi2v_m_7 (g, phi1, k1, phi2, k2, v1, k_v1) result (v2) complex(kind=default), intent(in) :: g, phi1, phi2 type(momentum), intent(in) :: k1, k2, k_v1 type(vector), intent(in) :: v1 type(momentum) :: k_v2 type(vector) :: v2 k_v2 = - k_v1 - k1 - k2 v2 = g * phi1 * phi2 * & ( k1 * (v1 * k_v2) * (k2 * k_v1) & + k2 * (v1 * k_v2) * (k1 * k_v1) & + k_v1 * (v1 * k1) * (k2 * k_v2) & + k_v1 * (v1 * k2) * (k1 * k_v2) & - k1 * (v1 * k2) * (k_v1 * k_v2) & - k2 * (v1 * k1) * (k_v1 * k_v2) & - v1 * (k1 * k_v2) * (k2 * k_v1) & - v1 * (k1 * k_v1) * (k2 * k_v2) ) end function v_phi2v_m_7 @ \section{Transversal Gauge4 Dim-8 Couplings} <>= public :: g_dim8g3_t_0, g_dim8g3_t_1, g_dim8g3_t_2 @ \begin{equation} V_1^\mu = g \left [ k_2^\mu \left ( k_1 \cdot V_2 \right ) - V_2^\mu \left ( k_1 \cdot k_2 \right ) \right ] \left [ \left ( k_3 \cdot V_4 \right) \left ( k_4 \cdot V_3 \right ) - \left (V_3 \cdot V_4 \right ) \left ( k_3 \cdot k_4 \right ) \right ] \end{equation} <>= pure function g_dim8g3_t_0 (g, v2, k2, v3, k3, v4, k4) result (v1) complex(kind=default), intent(in) :: g type(vector), intent(in) :: v2, v3, v4 type(momentum), intent(in) :: k2, k3, k4 type(vector) :: v1 type(momentum) :: k1 k1 = - k2 - k3 - k4 v1 = g * (k2 * (k1 * v2) - v2 * (k1 * k2)) & * ((k3 * v4) * (k4 * v3) - (v3 * v4) * (k3 * k4)) end function g_dim8g3_t_0 @ \begin{equation} V_1^\mu = g \left [ k_2^\mu \left ( k_1 \cdot V_2 \right ) - V_2^\mu \left ( k_1 \cdot k_2 \right ) \right ] \left [ \left ( k_3 \cdot V_4 \right) \left ( k_4 \cdot V_3 \right ) - \left (V_3 \cdot V_4 \right ) \left ( k_3 \cdot k_4 \right ) \right ] \end{equation} <>= pure function g_dim8g3_t_1 (g, v2, k2, v3, k3, v4, k4) result (v1) complex(kind=default), intent(in) :: g type(vector), intent(in) :: v2, v3, v4 type(momentum), intent(in) :: k2, k3, k4 type(vector) :: v1 type(momentum) :: k1 k1 = - k2 - k3 - k4 v1 = g * (v3 * (v2 * k4) * (k1 * k3) * (k2 * v4) & + v4 * (v2 * k3) * (k1 * k4) * (k2 * v3) & + k3 * (v2 * v4) * (k1 * v3) * (k2 * k4) & + k4 * (v2 * v3) * (k1 * v4) * (k2 * k3) & - v3 * (v2 * v4) * (k1 * k3) * (k2 * k4) & - v4 * (v2 * v3) * (k1 * k4) * (k2 * k3) & - k3 * (v2 * k4) * (k1 * v3) * (k2 * v4) & - k4 * (v2 * k3) * (k1 * v4) * (k2 * v3)) end function g_dim8g3_t_1 @ \begin{equation} V_1^\mu = g \left [ k_2^\mu \left (V_2 \cdot k_3\right ) \left (V_3 \cdot k_4\right ) \left (V_4 \cdot k_1\right ) \\ + k_3^\mu \left (V_2 \cdot k_1\right ) \left (V_3 \cdot k_4\right ) \left (V_4 \cdot k_2\right ) \\ + k_2^\mu \left (V_2 \cdot k_4\right ) \left (V_3 \cdot k_1\right ) \left (V_4 \cdot k_3\right ) \\ + k_4^\mu \left (V_2 \cdot k_1\right ) \left (V_3 \cdot k_2\right ) \left (V_4 \cdot k_3\right ) \\ + k_4^\mu \left (V_2 \cdot k_3\right ) \left (V_3 \cdot V_4\right ) \left (k_1 \cdot k_2\right ) \\ + k_3^\mu \left (V_2 \cdot k_4\right ) \left (V_3 \cdot V_4\right ) \left (k_1 \cdot k_2\right ) \\ - k_3^\mu \left (V_2 \cdot V_4\right ) \left (V_3 \cdot k_4\right ) \left (k_1 \cdot k_2\right ) \\ - V_4^\mu \left (V_2 \cdot k_3\right ) \left (V_3 \cdot k_4\right ) \left (k_1 \cdot k_2\right ) \\ - k_4^\mu \left (V_2 \cdot V_3\right ) \left (V_4 \cdot k_3\right ) \left (k_1 \cdot k_2\right ) \\ - V_3^\mu \left (V_2 \cdot k_4\right ) \left (V_4 \cdot k_3\right ) \left (k_1 \cdot k_2\right ) \\ - k_2^\mu \left (V_2 \cdot k_4\right ) \left (V_3 \cdot V_4\right ) \left (k_1 \cdot k_3\right ) \\ + k_2^\mu \left (V_2 \cdot V_4\right ) \left (V_3 \cdot k_4\right ) \left (k_1 \cdot k_3\right ) \\ - V_2^\mu \left (V_3 \cdot k_4\right ) \left (V_4 \cdot k_2\right ) \left (k_1 \cdot k_3\right ) \\ - k_2^\mu \left (V_2 \cdot k_3\right ) \left (V_3 \cdot V_4\right ) \left (k_1 \cdot k_4\right ) \\ + k_2^\mu \left (V_2 \cdot V_3\right ) \left (V_4 \cdot k_3\right ) \left (k_1 \cdot k_4\right ) \\ - V_2^\mu \left (V_3 \cdot k_2\right ) \left (V_4 \cdot k_3\right ) \left (k_1 \cdot k_4\right ) \\ - k_4^\mu \left (V_2 \cdot k_1\right ) \left (V_3 \cdot V_4\right ) \left (k_2 \cdot k_3\right ) \\ + V_4^\mu \left (V_2 \cdot k_1\right ) \left (V_3 \cdot k_4\right ) \left (k_2 \cdot k_3\right ) \\ - V_2^\mu \left (V_3 \cdot k_4\right ) \left (V_4 \cdot k_1\right ) \left (k_2 \cdot k_3\right ) \\ + V_2^\mu \left (V_3 \cdot V_4\right ) \left (k_1 \cdot k_4\right ) \left (k_2 \cdot k_3\right ) \\ - k_3^\mu \left (V_2 \cdot k_1\right ) \left (V_3 \cdot V_4\right ) \left (k_2 \cdot k_4\right ) \\ + V_3^\mu \left (V_2 \cdot k_1\right ) \left (V_4 \cdot k_3\right ) \left (k_2 \cdot k_4\right ) \\ - V_2^\mu \left (V_3 \cdot k_1\right ) \left (V_4 \cdot k_3\right ) \left (k_2 \cdot k_4\right ) \\ + V_2^\mu \left (V_3 \cdot V_4\right ) \left (k_1 \cdot k_3\right ) \left (k_2 \cdot k_4\right ) \\ - k_2^\mu \left (V_2 \cdot V_4\right ) \left (V_3 \cdot k_1\right ) \left (k_3 \cdot k_4\right ) \\ - V_4^\mu \left (V_2 \cdot k_1\right ) \left (V_3 \cdot k_2\right ) \left (k_3 \cdot k_4\right ) \\ - k_2^\mu \left (V_2 \cdot V_3\right ) \left (V_4 \cdot k_1\right ) \left (k_3 \cdot k_4\right ) \\ + V_2^\mu \left (V_3 \cdot k_2\right ) \left (V_4 \cdot k_1\right ) \left (k_3 \cdot k_4\right ) \\ - V_3^\mu \left (V_2 \cdot k_1\right ) \left (V_4 \cdot k_2\right ) \left (k_3 \cdot k_4\right ) \\ + V_2^\mu \left (V_3 \cdot k_1\right ) \left (V_4 \cdot k_2\right ) \left (k_3 \cdot k_4\right ) \\ + V_4^\mu \left (V_2 \cdot V_3\right ) \left (k_1 \cdot k_2\right ) \left (k_3 \cdot k_4\right ) \\ + V_3^\mu \left (V_2 \cdot V_4\right ) \left (k_1 \cdot k_2\right ) \left (k_3 \cdot k_4\right ) \right ] \end{equation} <>= pure function g_dim8g3_t_2 (g, v2, k2, v3, k3, v4, k4) result (v1) complex(kind=default), intent(in) :: g type(vector), intent(in) :: v2, v3, v4 type(momentum), intent(in) :: k2, k3, k4 type(vector) :: v1 type(momentum) :: k1 k1 = - k2 - k3 - k4 v1 = g * (k2 * (v2 * k3) * (v3 * k4) * (v4 * k1) & + k3 * (v2 * k1) * (v3 * k4) * (v4 * k2) & + k2 * (v2 * k4) * (v3 * k1) * (v4 * k3) & + k4 * (v2 * k1) * (v3 * k2) * (v4 * k3) & + k4 * (v2 * k3) * (v3 * v4) * (k1 * k2) & + k3 * (v2 * k4) * (v3 * v4) * (k1 * k2) & - k3 * (v2 * v4) * (v3 * k4) * (k1 * k2) & - v4 * (v2 * k3) * (v3 * k4) * (k1 * k2) & - k4 * (v2 * v3) * (v4 * k3) * (k1 * k2) & - v3 * (v2 * k4) * (v4 * k3) * (k1 * k2) & - k2 * (v2 * k4) * (v3 * v4) * (k1 * k3) & + k2 * (v2 * v4) * (v3 * k4) * (k1 * k3) & - v2 * (v3 * k4) * (v4 * k2) * (k1 * k3) & - k2 * (v2 * k3) * (v3 * v4) * (k1 * k4) & + k2 * (v2 * v3) * (v4 * k3) * (k1 * k4) & - v2 * (v3 * k2) * (v4 * k3) * (k1 * k4) & - k4 * (v2 * k1) * (v3 * v4) * (k2 * k3) & + v4 * (v2 * k1) * (v3 * k4) * (k2 * k3) & - v2 * (v3 * k4) * (v4 * k1) * (k2 * k3) & + v2 * (v3 * v4) * (k1 * k4) * (k2 * k3) & - k3 * (v2 * k1) * (v3 * v4) * (k2 * k4) & + v3 * (v2 * k1) * (v4 * k3) * (k2 * k4) & - v2 * (v3 * k1) * (v4 * k3) * (k2 * k4) & + v2 * (v3 * v4) * (k1 * k3) * (k2 * k4) & - k2 * (v2 * v4) * (v3 * k1) * (k3 * k4) & - v4 * (v2 * k1) * (v3 * k2) * (k3 * k4) & - k2 * (v2 * v3) * (v4 * k1) * (k3 * k4) & + v2 * (v3 * k2) * (v4 * k1) * (k3 * k4) & - v3 * (v2 * k1) * (v4 * k2) * (k3 * k4) & + v2 * (v3 * k1) * (v4 * k2) * (k3 * k4) & + v4 * (v2 * v3) * (k1 * k2) * (k3 * k4) & + v3 * (v2 * v4) * (k1 * k2) * (k3 * k4)) end function g_dim8g3_t_2 @ \section{Mixed Gauge4 Dim-8 Couplings} <>= public :: g_dim8g3_m_0, g_dim8g3_m_1, g_dim8g3_m_7 @ \begin{equation} V_1^\mu = g_1 \left [ V_2^\mu \left (V_3 \cdot V_4\right ) \left (k_1 \cdot k_2\right ) \\ - k_2^\mu \left (V_2 \cdot k_1\right ) \left (V_3 \cdot V_4\right ) \\ \right ] \\ + g_2 \left [ V_2^\mu \left (V_3 \cdot V_4\right ) \left (k_3 \cdot k_4\right ) \\ - V_2^\mu \left (V_3 \cdot k_4\right ) \left (V_4 \cdot k_3\right ) \\ \right ] \end{equation} <>= pure function g_dim8g3_m_0 (g1, g2, v2, k2, v3, k3, v4, k4) result (v1) complex(kind=default), intent(in) :: g1, g2 type(vector), intent(in) :: v2, v3, v4 type(momentum), intent(in) :: k2, k3, k4 type(vector) :: v1 type(momentum) :: k1 k1 = - k2 - k3 - k4 v1 = g1 * (v2 * (v3 * v4) * (k1 * k2) & - k2 * (v2 * k1) * (v3 * v4)) & + g2 * (v2 * (v3 * v4) * (k3 * k4) & - v2 * (v3 * k4) * (v4 * k3)) end function g_dim8g3_m_0 @ \begin{equation} V_1^\mu = g_1 \left [ k_2^\mu \left (V_2 \cdot V_4\right ) \left (V_3 \cdot k_1\right ) \\ + V_4^\mu \left (V_2 \cdot k_1\right ) \left (V_3 \cdot k_2\right ) \\ + k_2^\mu \left (V_2 \cdot V_3\right ) \left (V_4 \cdot k_1\right ) \\ + V_3^\mu \left (V_2 \cdot k_1\right ) \left (V_4 \cdot k_2\right ) \\ - V_2^\mu \left (V_3 \cdot k_2\right ) \left (V_4 \cdot k_1\right ) \\ - V_2^\mu \left (V_3 \cdot k_1\right ) \left (V_4 \cdot k_2\right ) \\ - V_4^\mu \left (V_2 \cdot V_3\right ) \left (k_1 \cdot k_2\right ) \\ - V_3^\mu \left (V_2 \cdot V_4\right ) \left (k_1 \cdot k_2\right ) \\ \right ] \\ + g_2 \left [ k_3^\mu \left (V_2 \cdot V_4\right ) \left (V_3 \cdot k_4\right ) \\ - k_4^\mu \left (V_2 \cdot k_3\right ) \left (V_3 \cdot V_4\right ) \\ - k_3^\mu \left (V_2 \cdot k_4\right ) \left (V_3 \cdot V_4\right ) \\ + V_4^\mu \left (V_2 \cdot k_3\right ) \left (V_3 \cdot k_4\right ) \\ + k_4^\mu \left (V_2 \cdot V_3\right ) \left (V_4 \cdot k_3\right ) \\ + V_3^\mu \left (V_2 \cdot k_4\right ) \left (V_4 \cdot k_3\right ) \\ - V_4^\mu \left (V_2 \cdot V_3\right ) \left (k_3 \cdot k_4\right ) \\ - V_3^\mu \left (V_2 \cdot V_4\right ) \left (k_3 \cdot k_4\right ) \\ \right ] \end{equation} <>= pure function g_dim8g3_m_1 (g1, g2, v2, k2, v3, k3, v4, k4) result (v1) complex(kind=default), intent(in) :: g1, g2 type(vector), intent(in) :: v2, v3, v4 type(momentum), intent(in) :: k2, k3, k4 type(vector) :: v1 type(momentum) :: k1 k1 = - k2 - k3 - k4 v1 = g1 * (k2 * (v2 * v4) * (v3 * k1) & + v4 * (v2 * k1) * (v3 * k2) & + k2 * (v2 * v3) * (v4 * k1) & + v3 * (v2 * k1) * (v4 * k2) & - v2 * (v3 * k2) * (v4 * k1) & - v2 * (v3 * k1) * (v4 * k2) & - v4 * (v2 * v3) * (k1 * k2) & - v3 * (v2 * v4) * (k1 * k2)) & + g2 * (k3 * (v2 * v4) * (v3 * k4) & - k4 * (v2 * k3) * (v3 * v4) & - k3 * (v2 * k4) * (v3 * v4) & + v4 * (v2 * k3) * (v3 * k4) & + k4 * (v2 * v3) * (v4 * k3) & + v3 * (v2 * k4) * (v4 * k3) & - v4 * (v2 * v3) * (k3 * k4) & - v3 * (v2 * v4) * (k3 * k4)) end function g_dim8g3_m_1 @ \begin{equation} V_1^\mu = g_1 \left [ V_2^\mu \left (V_3 \cdot k_2\right ) \left (V_4 \cdot k_1\right ) \\ + V_2^\mu \left (V_4 \cdot k_1\right ) \left (V_4 \cdot k_2\right ) \\ + V_4^\mu \left (V_2 \cdot V_3\right ) \left (k_1 \cdot k_2\right ) \\ + V_3^\mu \left (V_2 \cdot V_4\right ) \left (k_1 \cdot k_2\right ) \\ - k_2^\mu \left (V_2 \cdot V_4\right ) \left (V_3 \cdot k_1\right ) \\ - V_4^\mu \left (V_2 \cdot k_1\right ) \left (V_3 \cdot k_2\right ) \\ - k_2^\mu \left (V_2 \cdot V_3\right ) \left (V_4 \cdot k_1\right ) \\ - V_3^\mu \left (V_2 \cdot k_1\right ) \left (V_4 \cdot k_2\right ) \\ \right ] \\ + g_2 \left [ k_3^\mu \left (V_2 \cdot k_1\right ) \left (V_3 \cdot V_4\right ) \\ + k_4^\mu \left (V_2 \cdot k_1\right ) \left (V_3 \cdot V_4\right ) \\ + k_2^\mu \left (V_2 \cdot k_3\right ) \left (V_3 \cdot V_4\right ) \\ + k_2^\mu \left (V_2 \cdot k_4\right ) \left (V_3 \cdot V_4\right ) \\ + V_4^\mu \left (V_2 \cdot k_4\right ) \left (V_3 \cdot k_1\right ) \\ + k_4^\mu \left (V_2 \cdot V_4\right ) \left (V_3 \cdot k_2\right ) \\ + V_3^\mu \left (V_2 \cdot k_3\right ) \left (V_4 \cdot k_1\right ) \\ + V_2^\mu \left (V_3 \cdot k_4\right ) \left (V_4 \cdot k_1\right ) \\ + V_3^\mu \left (V_2 \cdot V_3\right ) \left (V_4 \cdot k_2\right ) \\ + V_2^\mu \left (V_3 \cdot k_4\right ) \left (V_4 \cdot k_2\right ) \\ + V_2^\mu \left (V_3 \cdot k_1\right ) \left (V_4 \cdot k_3\right ) \\ + V_2^\mu \left (V_3 \cdot k_2\right ) \left (V_4 \cdot k_3\right ) \\ + V_4^\mu \left (V_2 \cdot V_3\right ) \left (k_1 \cdot k_3\right ) \\ + V_3^\mu \left (V_2 \cdot V_4\right ) \left (k_1 \cdot k_4\right ) \\ + V_3^\mu \left (V_2 \cdot V_4\right ) \left (k_2 \cdot k_3\right ) \\ + V_4^\mu \left (V_2 \cdot V_3\right ) \left (k_2 \cdot k_4\right ) \\ - k_4^\mu \left (V_2 \cdot V_4\right ) \left (V_3 \cdot k_1\right ) \\ - V_4^\mu \left (V_2 \cdot k_3\right ) \left (V_3 \cdot k_1\right ) \\ - k_3^\mu \left (V_2 \cdot V_4\right ) \left (V_3 \cdot k_2\right ) \\ - V_4^\mu \left (V_2 \cdot k_4\right ) \left (V_3 \cdot k_2\right ) \\ - k_2^\mu \left (V_2 \cdot V_4\right ) \left (V_3 \cdot k_4\right ) \\ - V_4^\mu \left (V_2 \cdot k_1\right ) \left (V_3 \cdot k_4\right ) \\ - k_3^\mu \left (V_2 \cdot V_3\right ) \left (V_4 \cdot k_1\right ) \\ - V_3^\mu \left (V_2 \cdot k_4\right ) \left (V_4 \cdot k_1\right ) \\ - k_4^\mu \left (V_2 \cdot V_3\right ) \left (V_4 \cdot k_2\right ) \\ - V_3^\mu \left (V_2 \cdot k_3\right ) \left (V_4 \cdot k_2\right ) \\ - k_2^\mu \left (V_2 \cdot V_3\right ) \left (V_4 \cdot k_3\right ) \\ - V_3^\mu \left (V_2 \cdot k_1\right ) \left (V_4 \cdot k_3\right ) \\ - V_2^\mu \left (V_3 \cdot V_4\right ) \left (k_1 \cdot k_3\right ) \\ - V_2^\mu \left (V_3 \cdot V_4\right ) \left (k_1 \cdot k_4\right ) \\ - V_2^\mu \left (V_3 \cdot V_4\right ) \left (k_2 \cdot k_3\right ) \\ - V_2^\mu \left (V_3 \cdot V_4\right ) \left (k_2 \cdot k_4\right ) \\ \right ] + g_3 \left [ k_4^\mu \left (V_2 \cdot k_3\right ) \left (V_3 \cdot V_4\right ) \\ + k_3^\mu \left (V_2 \cdot k_4\right ) \left (V_3 \cdot V_4\right ) \\ + V_4^\mu \left (V_2 \cdot V_3\right ) \left (k_3 \cdot k_4\right ) \\ + V_3^\mu \left (V_2 \cdot V_4\right ) \left (k_3 \cdot k_4\right ) \\ - k_3^\mu \left (V_2 \cdot V_4\right ) \left (V_3 \cdot k_4\right ) \\ - V_4^\mu \left (V_2 \cdot k_3\right ) \left (V_3 \cdot k_4\right ) \\ - k_4^\mu \left (V_2 \cdot V_3\right ) \left (V_4 \cdot k_3\right ) \\ - V_3^\mu \left (V_2 \cdot k_4\right ) \left (V_4 \cdot k_3\right ) \\ \right ] \end{equation} <>= pure function g_dim8g3_m_7 (g1, g2, g3, v2, k2, v3, k3, v4, k4) result (v1) complex(kind=default), intent(in) :: g1, g2, g3 type(vector), intent(in) :: v2, v3, v4 type(momentum), intent(in) :: k2, k3, k4 type(vector) :: v1 type(momentum) :: k1 k1 = - k2 - k3 - k4 v1 = g1 * (v2 * (v3 * k2) * (v4 * k1) & + v2 * (v3 * k1) * (v4 * k2) & + v4 * (v2 * v3) * (k1 * k2) & + v3 * (v2 * v4) * (k1 * k2) & - k2 * (v2 * v4) * (v3 * k1) & - v4 * (v2 * k1) * (v3 * k2) & - k2 * (v2 * v3) * (v4 * k1) & - v3 * (v2 * k1) * (v4 * k2)) & + g2 * (k3 * (v2 * k1) * (v3 * v4) & + k4 * (v2 * k1) * (v3 * v4) & + k2 * (v2 * k3) * (v3 * v4) & + k2 * (v2 * k4) * (v3 * v4) & + v4 * (v2 * k4) * (v3 * k1) & + k4 * (v2 * v4) * (v3 * k2) & + v3 * (v2 * k3) * (v4 * k1) & + v2 * (v3 * k4) * (v4 * k1) & + k3 * (v2 * v3) * (v4 * k2) & + v2 * (v3 * k4) * (v4 * k2) & + v2 * (v3 * k1) * (v4 * k3) & + v2 * (v3 * k2) * (v4 * k3) & + v4 * (v2 * v3) * (k1 * k3) & + v3 * (v2 * v4) * (k1 * k4) & + v3 * (v2 * v4) * (k2 * k3) & + v4 * (v2 * v3) * (k2 * k4) & - k4 * (v2 * v4) * (v3 * k1) & - v4 * (v2 * k3) * (v3 * k1) & - k3 * (v2 * v4) * (v3 * k2) & - v4 * (v2 * k4) * (v3 * k2) & - k2 * (v2 * v4) * (v3 * k4) & - v4 * (v2 * k1) * (v3 * k4) & - k3 * (v2 * v3) * (v4 * k1) & - v3 * (v2 * k4) * (v4 * k1) & - k4 * (v2 * v3) * (v4 * k2) & - v3 * (v2 * k3) * (v4 * k2) & - k2 * (v2 * v3) * (v4 * k3) & - v3 * (v2 * k1) * (v4 * k3) & - v2 * (v3 * v4) * (k1 * k3) & - v2 * (v3 * v4) * (k1 * k4) & - v2 * (v3 * v4) * (k2 * k3) & - v2 * (v3 * v4) * (k2 * k4)) & + g3 * (k4 * (v2 * k3) * (v3 * v4) & + k3 * (v2 * k4) * (v3 * v4) & + v4 * (v2 * v3) * (k3 * k4) & + v3 * (v2 * v4) * (k3 * k4) & - k3 * (v2 * v4) * (v3 * k4) & - v4 * (v2 * k3) * (v3 * k4) & - k4 * (v2 * v3) * (v4 * k3) & - v3 * (v2 * k4) * (v4 * k3)) end function g_dim8g3_m_7 @ \section{Graviton Couplings} <>= public :: s_gravs, v_gravv, grav_ss, grav_vv @ <>= pure function s_gravs (g, m, k1, k2, t, s) result (phi) complex(kind=default), intent(in) :: g, s real(kind=default), intent(in) :: m type(momentum), intent(in) :: k1, k2 type(tensor), intent(in) :: t complex(kind=default) :: phi, t_tr t_tr = t%t(0,0) - t%t(1,1) - t%t(2,2) - t%t(3,3) phi = g * s * (((t*k1)*k2) + ((t*k2)*k1) & - g * (m**2 + (k1*k2))*t_tr)/2.0_default end function s_gravs @ <>= pure function grav_ss (g, m, k1, k2, s1, s2) result (t) complex(kind=default), intent(in) :: g, s1, s2 real(kind=default), intent(in) :: m type(momentum), intent(in) :: k1, k2 type(tensor) :: t_metric, t t_metric%t = 0 t_metric%t(0,0) = 1.0_default t_metric%t(1,1) = - 1.0_default t_metric%t(2,2) = - 1.0_default t_metric%t(3,3) = - 1.0_default t = g*s1*s2/2.0_default * (-(m**2 + (k1*k2)) * t_metric & + (k1.tprod.k2) + (k2.tprod.k1)) end function grav_ss @ <>= pure function v_gravv (g, m, k1, k2, t, v) result (vec) complex(kind=default), intent(in) :: g real(kind=default), intent(in) :: m type(momentum), intent(in) :: k1, k2 type(vector), intent(in) :: v type(tensor), intent(in) :: t complex(kind=default) :: t_tr real(kind=default) :: xi type(vector) :: vec xi = 1.0_default t_tr = t%t(0,0) - t%t(1,1) - t%t(2,2) - t%t(3,3) vec = (-g)/ 2.0_default * (((k1*k2) + m**2) * & (t*v + v*t - t_tr * v) + t_tr * (k1*v) * k2 & - (k1*v) * ((k2*t) + (t*k2)) & - ((k1*(t*v)) + (v*(t*k1))) * k2 & + ((k1*(t*k2)) + (k2*(t*k1))) * v) !!! Unitarity gauge: xi -> Infinity !!! + (1.0_default/xi) * (t_tr * ((k1*v)*k2) + & !!! (k2*v)*k2 + (k2*v)*k1 - (k1*(t*v))*k1 + & !!! (k2*v)*(k2*t) - (v*(t*k1))*k1 - (k2*v)*(t*k2))) end function v_gravv @ <>= pure function grav_vv (g, m, k1, k2, v1, v2) result (t) complex(kind=default), intent(in) :: g type(momentum), intent(in) :: k1, k2 real(kind=default), intent(in) :: m real(kind=default) :: xi type(vector), intent (in) :: v1, v2 type(tensor) :: t_metric, t xi = 0.00001_default t_metric%t = 0 t_metric%t(0,0) = 1.0_default t_metric%t(1,1) = - 1.0_default t_metric%t(2,2) = - 1.0_default t_metric%t(3,3) = - 1.0_default t = (-g)/2.0_default * ( & ((k1*k2) + m**2) * ( & (v1.tprod.v2) + (v2.tprod.v1) - (v1*v2) * t_metric) & + (v1*k2)*(v2*k1)*t_metric & - (k2*v1)*((v2.tprod.k1) + (k1.tprod.v2)) & - (k1*v2)*((v1.tprod.k2) + (k2.tprod.v1)) & + (v1*v2)*((k1.tprod.k2) + (k2.tprod.k1))) !!! Unitarity gauge: xi -> Infinity !!! + (1.0_default/xi) * ( & !!! ((k1*v1)*(k1*v2) + (k2*v1)*(k2*v2) + (k1*v1)*(k2*v2))* & !!! t_metric) - (k1*v1) * ((k1.tprod.v2) + (v2.tprod.k1)) & !!! - (k2*v2) * ((k2.tprod.v1) + (v1.tprod.k2))) end function grav_vv @ \section{Tensor Couplings} <>= public :: t2_vv, v_t2v, t2_vv_cf, v_t2v_cf, & t2_vv_1, v_t2v_1, t2_vv_t, v_t2v_t, & t2_phi2, phi_t2phi, t2_phi2_cf, phi_t2phi_cf @ \begin{equation} T_{\mu\nu} = g * V_{1 \,\mu} V_{2\,\nu} + V_{1\,\nu} V_{2\,\mu} \end{equation} <>= pure function t2_vv (g, v1, v2) result (t) complex(kind=default), intent(in) :: g type(vector), intent(in) :: v1, v2 type(tensor) :: t type(tensor) :: tmp tmp = v1.tprod.v2 t%t = g * (tmp%t + transpose (tmp%t)) end function t2_vv @ \begin{equation} V_{1\,\mu} = g * T_{\mu \nu} V_{2}^{\nu}+ T_{\nu \mu} V_{2}^{\nu} \end{equation} <>= pure function v_t2v (g, t, v) result (tv) complex(kind=default), intent(in) :: g type(tensor), intent(in) :: t type(vector), intent(in) :: v type(vector) :: tv type(tensor) :: tmp tmp%t = t%t + transpose (t%t) tv = g * (tmp * v) end function v_t2v @ \begin{equation} T_{\mu\nu} =- \frac{g}{2} V_1^\rho V_{2 \,\rho} \end{equation} <>= pure function t2_vv_cf (g, v1, v2) result (t) complex(kind=default), intent(in) :: g complex(kind=default) :: tmp_s type(vector), intent(in) :: v1, v2 type(tensor) :: t_metric, t t_metric%t = 0 t_metric%t(0,0) = 1.0_default t_metric%t(1,1) = - 1.0_default t_metric%t(2,2) = - 1.0_default t_metric%t(3,3) = - 1.0_default tmp_s = v1 * v2 t%t = - (g /2.0_default) * tmp_s * t_metric%t end function t2_vv_cf @ \begin{equation} V_{1\,\mu} = -\frac{g}{2} T^{\nu}_{ \nu} V_{2}^{\mu} \end{equation} <>= pure function v_t2v_cf (g, t, v) result (tv) complex(kind=default), intent(in) :: g type(tensor), intent(in) :: t type(vector), intent(in) :: v type(vector) :: tv, tmp_tv tmp_tv = ( t%t(0,0)-t%t(1,1)-t%t(2,2)-t%t(3,3) ) * v tv = - ( g /2.0_default) * tmp_tv end function v_t2v_cf @ \begin{equation} T_{\mu\nu} = g * \left ( k_{1 \,\mu} k_{2\,\nu} + k_{1\,\nu} k_{2\,\mu} \right ) \phi_1 \left ( k_1 \right ) \phi_1 \left ( k_2 \right ) \end{equation} <>= pure function t2_phi2 (g, phi1, k1, phi2, k2) result (t) complex(kind=default), intent(in) :: g, phi1, phi2 type(momentum), intent(in) :: k1, k2 type(tensor) :: t type(tensor) :: tmp tmp = k1.tprod.k2 t%t = g * (tmp%t + transpose (tmp%t)) * phi1 * phi2 end function t2_phi2 @ \begin{equation} \phi_{1} (k_1) =g * \left ( T_{\mu \nu} k_{1}^{\mu}k_{2}^{\nu} + T_{\nu \mu} k_{2}^{\mu}k_{1}^{\nu} \right ) \phi_2 \left (k_2 \right ) \end{equation} <>= pure function phi_t2phi (g, t, kt, phi2, k2) result (phi1) complex(kind=default), intent(in) :: g, phi2 type(tensor), intent(in) :: t type(momentum), intent(in) :: kt, k2 type(momentum) :: k1 complex(kind=default) :: phi1 type(tensor) :: tmp k1 = -kt - k2 tmp%t = t%t + transpose (t%t) phi1 = g * ( (tmp * k2) * k1) * phi2 end function phi_t2phi @ \begin{equation} T_{\mu\nu} =- \frac{g}{2} k_1^\rho k_{2 \,\rho} \phi_1 \left ( k_1 \right ) \phi_2 \left ( k_2 \right ) \end{equation} <>= pure function t2_phi2_cf (g, phi1, k1, phi2, k2) result (t) complex(kind=default), intent(in) :: g, phi1, phi2 complex(kind=default) :: tmp_s type(momentum), intent(in) :: k1, k2 type(tensor) :: t_metric, t t_metric%t = 0 t_metric%t(0,0) = 1.0_default t_metric%t(1,1) = - 1.0_default t_metric%t(2,2) = - 1.0_default t_metric%t(3,3) = - 1.0_default tmp_s = (k1 * k2) * phi1 * phi2 t%t = - (g /2.0_default) * tmp_s * t_metric%t end function t2_phi2_cf @ \begin{equation} \phi_1 (k_1) = - \frac{g}{2} T^{\nu}_{ \nu} \left (k_1 \cdot k_2 \right ) \phi_2 (k_2) \end{equation} <>= pure function phi_t2phi_cf (g, t, kt, phi2, k2) result (phi1) complex(kind=default), intent(in) :: g, phi2 type(tensor), intent(in) :: t type(momentum), intent(in) :: kt, k2 type(momentum) :: k1 complex(kind=default) :: tmp_ts, phi1 k1 = - kt - k2 tmp_ts = ( t%t(0,0)-t%t(1,1)-t%t(2,2)-t%t(3,3) ) phi1 = - ( g /2.0_default) * tmp_ts * (k1 * k2) * phi2 end function phi_t2phi_cf @ <>= pure function t2_vv_1 (g, v1, v2) result (t) complex(kind=default), intent(in) :: g complex(kind=default) :: tmp_s type(vector), intent(in) :: v1, v2 type(tensor) :: tmp type(tensor) :: t_metric, t t_metric%t = 0 t_metric%t(0,0) = 1.0_default t_metric%t(1,1) = - 1.0_default t_metric%t(2,2) = - 1.0_default t_metric%t(3,3) = - 1.0_default tmp = v1.tprod.v2 tmp_s = v1 * v2 t%t = g * (tmp%t + transpose (tmp%t) - tmp_s * t_metric%t ) end function t2_vv_1 @ <>= pure function v_t2v_1 (g, t, v) result (tv) complex(kind=default), intent(in) :: g type(tensor), intent(in) :: t type(vector), intent(in) :: v type(vector) :: tv, tmp_tv type(tensor) :: tmp tmp_tv = ( t%t(0,0)-t%t(1,1)-t%t(2,2)-t%t(3,3) ) * v tmp%t = t%t + transpose (t%t) tv = g * (tmp * v - tmp_tv) end function v_t2v_1 @ <>= pure function t2_vv_t (g, v1, k1, v2, k2) result (t) complex(kind=default), intent(in) :: g complex(kind=default) :: tmp_s type(vector), intent(in) :: v1, v2 type(momentum), intent(in) :: k1, k2 type(tensor) :: tmp, tmp_v1k2, tmp_v2k1, tmp_k1k2, tmp2 type(tensor) :: t_metric, t t_metric%t = 0 t_metric%t(0,0) = 1.0_default t_metric%t(1,1) = - 1.0_default t_metric%t(2,2) = - 1.0_default t_metric%t(3,3) = - 1.0_default tmp = v1.tprod.v2 tmp_s = v1 * v2 tmp_v1k2 = (v2 * k1) * (v1.tprod.k2) tmp_v2k1 = (v1 * k2) * (v2.tprod.k1) tmp_k1k2 = tmp_s * (k1.tprod.k2) tmp2%t = tmp_v1k2%t + tmp_v2k1%t - tmp_k1k2%t t%t = g * ( (k1*k2) * (tmp%t + transpose (tmp%t) - tmp_s * t_metric%t ) & + ((v1 * k2) * (v2 * k1)) * t_metric%t & - tmp2%t - transpose(tmp2%t)) end function t2_vv_t @ <>= pure function v_t2v_t (g, t, kt, v, kv) result (tv) complex(kind=default), intent(in) :: g type(tensor), intent(in) :: t type(vector), intent(in) :: v type(momentum), intent(in) :: kt, kv type(momentum) :: kout type(vector) :: tv, tmp_tv type(tensor) :: tmp kout = - (kt + kv) tmp_tv = ( t%t(0,0)-t%t(1,1)-t%t(2,2)-t%t(3,3) ) * v tmp%t = t%t + transpose (t%t) tv = g * ( (tmp * v - tmp_tv) * (kv * kout )& + ( t%t(0,0)-t%t(1,1)-t%t(2,2)-t%t(3,3) ) * (kout * v ) * kv & - (kout * v) * ( tmp * kv) & - (v* (t * kout) + kout * (t * v)) * kv & + (kout* (t * kv) + kv * (t * kout)) * v) end function v_t2v_t @ <>= public :: t2_vv_d5_1, v_t2v_d5_1 @ <>= pure function t2_vv_d5_1 (g, v1, k1, v2, k2) result (t) complex(kind=default), intent(in) :: g type(vector), intent(in) :: v1, v2 type(momentum), intent(in) :: k1, k2 type(tensor) :: t t = (g * (v1 * v2)) * (k1-k2).tprod.(k1-k2) end function t2_vv_d5_1 @ <>= pure function v_t2v_d5_1 (g, t1, k1, v2, k2) result (tv) complex(kind=default), intent(in) :: g type(tensor), intent(in) :: t1 type(vector), intent(in) :: v2 type(momentum), intent(in) :: k1, k2 type(vector) :: tv tv = (g * ((k1+2*k2).tprod.(k1+2*k2) * t1)) * v2 end function v_t2v_d5_1 @ <>= public :: t2_vv_d5_2, v_t2v_d5_2 @ <>= pure function t2_vv_d5_2 (g, v1, k1, v2, k2) result (t) complex(kind=default), intent(in) :: g type(vector), intent(in) :: v1, v2 type(momentum), intent(in) :: k1, k2 type(tensor) :: t t = (g * (k2 * v1)) * (k2-k1).tprod.v2 t%t = t%t + transpose (t%t) end function t2_vv_d5_2 @ <>= pure function v_t2v_d5_2 (g, t1, k1, v2, k2) result (tv) complex(kind=default), intent(in) :: g type(tensor), intent(in) :: t1 type(vector), intent(in) :: v2 type(momentum), intent(in) :: k1, k2 type(vector) :: tv type(tensor) :: tmp type(momentum) :: k1_k2, k1_2k2 k1_k2 = k1 + k2 k1_2k2 = k1_k2 + k2 tmp%t = t1%t + transpose (t1%t) tv = (g * (k1_k2 * v2)) * (k1_2k2 * tmp) end function v_t2v_d5_2 @ <>= public :: t2_vv_d7, v_t2v_d7 @ <>= pure function t2_vv_d7 (g, v1, k1, v2, k2) result (t) complex(kind=default), intent(in) :: g type(vector), intent(in) :: v1, v2 type(momentum), intent(in) :: k1, k2 type(tensor) :: t t = (g * (k2 * v1) * (k1 * v2)) * (k1-k2).tprod.(k1-k2) end function t2_vv_d7 @ <>= pure function v_t2v_d7 (g, t1, k1, v2, k2) result (tv) complex(kind=default), intent(in) :: g type(tensor), intent(in) :: t1 type(vector), intent(in) :: v2 type(momentum), intent(in) :: k1, k2 type(vector) :: tv type(vector) :: k1_k2, k1_2k2 k1_k2 = k1 + k2 k1_2k2 = k1_k2 + k2 tv = (- g * (k1_k2 * v2) * (k1_2k2.tprod.k1_2k2 * t1)) * k2 end function v_t2v_d7 @ \section{Spinor Couplings} <<[[omega_spinor_couplings.f90]]>>= <> module omega_spinor_couplings use kinds use constants use omega_spinors use omega_vectors use omega_tensors use omega_couplings implicit none private <> <> <> <> integer, parameter, public :: omega_spinor_cpls_2010_01_A = 0 contains <> <> <> <> end module omega_spinor_couplings @ See table~\ref{tab:fermionic-currents} for the names of Fortran functions. We could have used long names instead, but this would increase the chance of running past continuation line limits without adding much to the legibility. @ \subsection{Fermionic Vector and Axial Couplings} There's more than one chiral representation. This one is compatible with HELAS~\cite{HELAS}. \begin{equation} \gamma^0 = \begin{pmatrix} 0 & \mathbf{1} \\ \mathbf{1} & 0 \end{pmatrix},\; \gamma^i = \begin{pmatrix} 0 & \sigma^i \\ -\sigma^i & 0 \end{pmatrix},\; \gamma_5 = i\gamma^0\gamma^1\gamma^2\gamma^3 = \begin{pmatrix} -\mathbf{1} & 0 \\ 0 & \mathbf{1} \end{pmatrix} \end{equation} Therefore \begin{subequations} \begin{align} g_S + g_P\gamma_5 &= \begin{pmatrix} g_S - g_P & 0 & 0 & 0 \\ 0 & g_S - g_P & 0 & 0 \\ 0 & 0 & g_S + g_P & 0 \\ 0 & 0 & 0 & g_S + g_P \end{pmatrix} \\ g_V\gamma^0 - g_A\gamma^0\gamma_5 &= \begin{pmatrix} 0 & 0 & g_V - g_A & 0 \\ 0 & 0 & 0 & g_V - g_A \\ g_V + g_A & 0 & 0 & 0 \\ 0 & g_V + g_A & 0 & 0 \end{pmatrix} \\ g_V\gamma^1 - g_A\gamma^1\gamma_5 &= \begin{pmatrix} 0 & 0 & 0 & g_V - g_A \\ 0 & 0 & g_V - g_A & 0 \\ 0 & - g_V - g_A & 0 & 0 \\ - g_V - g_A & 0 & 0 & 0 \end{pmatrix} \\ g_V\gamma^2 - g_A\gamma^2\gamma_5 &= \begin{pmatrix} 0 & 0 & 0 & -\ii(g_V - g_A) \\ 0 & 0 & \ii(g_V - g_A) & 0 \\ 0 & \ii(g_V + g_A) & 0 & 0 \\ -\ii(g_V + g_A) & 0 & 0 & 0 \end{pmatrix} \\ g_V\gamma^3 - g_A\gamma^3\gamma_5 &= \begin{pmatrix} 0 & 0 & g_V - g_A & 0 \\ 0 & 0 & 0 & - g_V + g_A \\ - g_V - g_A & 0 & 0 & 0 \\ 0 & g_V + g_A & 0 & 0 \end{pmatrix} \end{align} \end{subequations} \begin{table} \begin{center} \begin{tabular}{>{$}l<{$}|>{$}l<{$}} \bar\psi(g_V\gamma^\mu - g_A\gamma^\mu\gamma_5)\psi & \text{\texttt{va\_ff}}(g_V,g_A,\bar\psi,\psi) \\ g_V\bar\psi\gamma^\mu\psi & \text{\texttt{v\_ff}}(g_V,\bar\psi,\psi) \\ g_A\bar\psi\gamma_5\gamma^\mu\psi & \text{\texttt{a\_ff}}(g_A,\bar\psi,\psi) \\ g_L\bar\psi\gamma^\mu(1-\gamma_5)\psi & \text{\texttt{vl\_ff}}(g_L,\bar\psi,\psi) \\ g_R\bar\psi\gamma^\mu(1+\gamma_5)\psi & \text{\texttt{vr\_ff}}(g_R,\bar\psi,\psi) \\\hline \fmslash{V}(g_V - g_A\gamma_5)\psi & \text{\texttt{f\_vaf}}(g_V,g_A,V,\psi) \\ g_V\fmslash{V}\psi & \text{\texttt{f\_vf}}(g_V,V,\psi) \\ g_A\gamma_5\fmslash{V}\psi & \text{\texttt{f\_af}}(g_A,V,\psi) \\ g_L\fmslash{V}(1-\gamma_5)\psi & \text{\texttt{f\_vlf}}(g_L,V,\psi) \\ g_R\fmslash{V}(1+\gamma_5)\psi & \text{\texttt{f\_vrf}}(g_R,V,\psi) \\\hline \bar\psi\fmslash{V}(g_V - g_A\gamma_5) & \text{\texttt{f\_fva}}(g_V,g_A,\bar\psi,V) \\ g_V\bar\psi\fmslash{V} & \text{\texttt{f\_fv}}(g_V,\bar\psi,V) \\ g_A\bar\psi\gamma_5\fmslash{V} & \text{\texttt{f\_fa}}(g_A,\bar\psi,V) \\ g_L\bar\psi\fmslash{V}(1-\gamma_5) & \text{\texttt{f\_fvl}}(g_L,\bar\psi,V) \\ g_R\bar\psi\fmslash{V}(1+\gamma_5) & \text{\texttt{f\_fvr}}(g_R,\bar\psi,V) \end{tabular} \end{center} \caption{\label{tab:fermionic-currents} Mnemonically abbreviated names of Fortran functions implementing fermionic vector and axial currents.} \end{table} \begin{table} \begin{center} \begin{tabular}{>{$}l<{$}|>{$}l<{$}} \bar\psi(g_S + g_P\gamma_5)\psi & \text{\texttt{sp\_ff}}(g_S,g_P,\bar\psi,\psi) \\ g_S\bar\psi\psi & \text{\texttt{s\_ff}}(g_S,\bar\psi,\psi) \\ g_P\bar\psi\gamma_5\psi & \text{\texttt{p\_ff}}(g_P,\bar\psi,\psi) \\ g_L\bar\psi(1-\gamma_5)\psi & \text{\texttt{sl\_ff}}(g_L,\bar\psi,\psi) \\ g_R\bar\psi(1+\gamma_5)\psi & \text{\texttt{sr\_ff}}(g_R,\bar\psi,\psi) \\\hline \phi(g_S + g_P\gamma_5)\psi & \text{\texttt{f\_spf}}(g_S,g_P,\phi,\psi) \\ g_S\phi\psi & \text{\texttt{f\_sf}}(g_S,\phi,\psi) \\ g_P\phi\gamma_5\psi & \text{\texttt{f\_pf}}(g_P,\phi,\psi) \\ g_L\phi(1-\gamma_5)\psi & \text{\texttt{f\_slf}}(g_L,\phi,\psi) \\ g_R\phi(1+\gamma_5)\psi & \text{\texttt{f\_srf}}(g_R,\phi,\psi) \\\hline \bar\psi\phi(g_S + g_P\gamma_5) & \text{\texttt{f\_fsp}}(g_S,g_P,\bar\psi,\phi) \\ g_S\bar\psi\phi & \text{\texttt{f\_fs}}(g_S,\bar\psi,\phi) \\ g_P\bar\psi\phi\gamma_5 & \text{\texttt{f\_fp}}(g_P,\bar\psi,\phi) \\ g_L\bar\psi\phi(1-\gamma_5) & \text{\texttt{f\_fsl}}(g_L,\bar\psi,\phi) \\ g_R\bar\psi\phi(1+\gamma_5) & \text{\texttt{f\_fsr}}(g_R,\bar\psi,\phi) \end{tabular} \end{center} \caption{\label{tab:fermionic-scalar currents} Mnemonically abbreviated names of Fortran functions implementing fermionic scalar and pseudo scalar ``currents''.} \end{table} <>= public :: va_ff, v_ff, a_ff, vl_ff, vr_ff, vlr_ff, grav_ff, va2_ff, & tva_ff, tlr_ff, trl_ff, tvam_ff, tlrm_ff, trlm_ff, va3_ff @ <>= pure function va_ff (gv, ga, psibar, psi) result (j) type(vector) :: j complex(kind=default), intent(in) :: gv, ga type(conjspinor), intent(in) :: psibar type(spinor), intent(in) :: psi complex(kind=default) :: gl, gr complex(kind=default) :: g13, g14, g23, g24, g31, g32, g41, g42 gl = gv + ga gr = gv - ga g13 = psibar%a(1)*psi%a(3) g14 = psibar%a(1)*psi%a(4) g23 = psibar%a(2)*psi%a(3) g24 = psibar%a(2)*psi%a(4) g31 = psibar%a(3)*psi%a(1) g32 = psibar%a(3)*psi%a(2) g41 = psibar%a(4)*psi%a(1) g42 = psibar%a(4)*psi%a(2) j%t = gr * ( g13 + g24) + gl * ( g31 + g42) j%x(1) = gr * ( g14 + g23) - gl * ( g32 + g41) j%x(2) = (gr * ( - g14 + g23) + gl * ( g32 - g41)) * (0, 1) j%x(3) = gr * ( g13 - g24) + gl * ( - g31 + g42) end function va_ff @ <>= pure function va2_ff (gva, psibar, psi) result (j) type(vector) :: j complex(kind=default), intent(in), dimension(2) :: gva type(conjspinor), intent(in) :: psibar type(spinor), intent(in) :: psi complex(kind=default) :: gl, gr complex(kind=default) :: g13, g14, g23, g24, g31, g32, g41, g42 gl = gva(1) + gva(2) gr = gva(1) - gva(2) g13 = psibar%a(1)*psi%a(3) g14 = psibar%a(1)*psi%a(4) g23 = psibar%a(2)*psi%a(3) g24 = psibar%a(2)*psi%a(4) g31 = psibar%a(3)*psi%a(1) g32 = psibar%a(3)*psi%a(2) g41 = psibar%a(4)*psi%a(1) g42 = psibar%a(4)*psi%a(2) j%t = gr * ( g13 + g24) + gl * ( g31 + g42) j%x(1) = gr * ( g14 + g23) - gl * ( g32 + g41) j%x(2) = (gr * ( - g14 + g23) + gl * ( g32 - g41)) * (0, 1) j%x(3) = gr * ( g13 - g24) + gl * ( - g31 + g42) end function va2_ff @ <>= pure function va3_ff (gv, ga, psibar, psi) result (j) type(vector) :: j complex(kind=default), intent(in) :: gv, ga type(conjspinor), intent(in) :: psibar type(spinor), intent(in) :: psi j = va_ff (gv, ga, psibar, psi) j%t = 0.0_default end function va3_ff @ <>= pure function tva_ff (gv, ga, psibar, psi) result (t) type(tensor2odd) :: t complex(kind=default), intent(in) :: gv, ga type(conjspinor), intent(in) :: psibar type(spinor), intent(in) :: psi complex(kind=default) :: gl, gr complex(kind=default) :: g12, g21, g1m2, g34, g43, g3m4 gr = gv + ga gl = gv - ga g12 = psibar%a(1)*psi%a(2) g21 = psibar%a(2)*psi%a(1) g1m2 = psibar%a(1)*psi%a(1) - psibar%a(2)*psi%a(2) g34 = psibar%a(3)*psi%a(4) g43 = psibar%a(4)*psi%a(3) g3m4 = psibar%a(3)*psi%a(3) - psibar%a(4)*psi%a(4) t%e(1) = (gl * ( - g12 - g21) + gr * ( g34 + g43)) * (0, 1) t%e(2) = gl * ( - g12 + g21) + gr * ( g34 - g43) t%e(3) = (gl * ( - g1m2 ) + gr * ( g3m4 )) * (0, 1) t%b(1) = gl * ( g12 + g21) + gr * ( g34 + g43) t%b(2) = (gl * ( - g12 + g21) + gr * ( - g34 + g43)) * (0, 1) t%b(3) = gl * ( g1m2 ) + gr * ( g3m4 ) end function tva_ff @ <>= pure function tlr_ff (gl, gr, psibar, psi) result (t) type(tensor2odd) :: t complex(kind=default), intent(in) :: gl, gr type(conjspinor), intent(in) :: psibar type(spinor), intent(in) :: psi t = tva_ff (gr+gl, gr-gl, psibar, psi) end function tlr_ff @ <>= pure function trl_ff (gr, gl, psibar, psi) result (t) type(tensor2odd) :: t complex(kind=default), intent(in) :: gl, gr type(conjspinor), intent(in) :: psibar type(spinor), intent(in) :: psi t = tva_ff (gr+gl, gr-gl, psibar, psi) end function trl_ff @ <>= pure function tvam_ff (gv, ga, psibar, psi, p) result (j) type(vector) :: j complex(kind=default), intent(in) :: gv, ga type(conjspinor), intent(in) :: psibar type(spinor), intent(in) :: psi type(momentum), intent(in) :: p j = (tva_ff(gv, ga, psibar, psi) * p) * (0,1) end function tvam_ff @ <>= pure function tlrm_ff (gl, gr, psibar, psi, p) result (j) type(vector) :: j complex(kind=default), intent(in) :: gl, gr type(conjspinor), intent(in) :: psibar type(spinor), intent(in) :: psi type(momentum), intent(in) :: p j = tvam_ff (gr+gl, gr-gl, psibar, psi, p) end function tlrm_ff @ <>= pure function trlm_ff (gr, gl, psibar, psi, p) result (j) type(vector) :: j complex(kind=default), intent(in) :: gl, gr type(conjspinor), intent(in) :: psibar type(spinor), intent(in) :: psi type(momentum), intent(in) :: p j = tvam_ff (gr+gl, gr-gl, psibar, psi, p) end function trlm_ff @ Special cases that avoid some multiplications <>= pure function v_ff (gv, psibar, psi) result (j) type(vector) :: j complex(kind=default), intent(in) :: gv type(conjspinor), intent(in) :: psibar type(spinor), intent(in) :: psi complex(kind=default) :: g13, g14, g23, g24, g31, g32, g41, g42 g13 = psibar%a(1)*psi%a(3) g14 = psibar%a(1)*psi%a(4) g23 = psibar%a(2)*psi%a(3) g24 = psibar%a(2)*psi%a(4) g31 = psibar%a(3)*psi%a(1) g32 = psibar%a(3)*psi%a(2) g41 = psibar%a(4)*psi%a(1) g42 = psibar%a(4)*psi%a(2) j%t = gv * ( g13 + g24 + g31 + g42) j%x(1) = gv * ( g14 + g23 - g32 - g41) j%x(2) = gv * ( - g14 + g23 + g32 - g41) * (0, 1) j%x(3) = gv * ( g13 - g24 - g31 + g42) end function v_ff @ <>= pure function a_ff (ga, psibar, psi) result (j) type(vector) :: j complex(kind=default), intent(in) :: ga type(conjspinor), intent(in) :: psibar type(spinor), intent(in) :: psi complex(kind=default) :: g13, g14, g23, g24, g31, g32, g41, g42 g13 = psibar%a(1)*psi%a(3) g14 = psibar%a(1)*psi%a(4) g23 = psibar%a(2)*psi%a(3) g24 = psibar%a(2)*psi%a(4) g31 = psibar%a(3)*psi%a(1) g32 = psibar%a(3)*psi%a(2) g41 = psibar%a(4)*psi%a(1) g42 = psibar%a(4)*psi%a(2) j%t = ga * ( - g13 - g24 + g31 + g42) j%x(1) = - ga * ( g14 + g23 + g32 + g41) j%x(2) = ga * ( g14 - g23 + g32 - g41) * (0, 1) j%x(3) = ga * ( - g13 + g24 - g31 + g42) end function a_ff @ <>= pure function vl_ff (gl, psibar, psi) result (j) type(vector) :: j complex(kind=default), intent(in) :: gl type(conjspinor), intent(in) :: psibar type(spinor), intent(in) :: psi complex(kind=default) :: gl2 complex(kind=default) :: g31, g32, g41, g42 gl2 = 2 * gl g31 = psibar%a(3)*psi%a(1) g32 = psibar%a(3)*psi%a(2) g41 = psibar%a(4)*psi%a(1) g42 = psibar%a(4)*psi%a(2) j%t = gl2 * ( g31 + g42) j%x(1) = - gl2 * ( g32 + g41) j%x(2) = gl2 * ( g32 - g41) * (0, 1) j%x(3) = gl2 * ( - g31 + g42) end function vl_ff @ <>= pure function vr_ff (gr, psibar, psi) result (j) type(vector) :: j complex(kind=default), intent(in) :: gr type(conjspinor), intent(in) :: psibar type(spinor), intent(in) :: psi complex(kind=default) :: gr2 complex(kind=default) :: g13, g14, g23, g24 gr2 = 2 * gr g13 = psibar%a(1)*psi%a(3) g14 = psibar%a(1)*psi%a(4) g23 = psibar%a(2)*psi%a(3) g24 = psibar%a(2)*psi%a(4) j%t = gr2 * ( g13 + g24) j%x(1) = gr2 * ( g14 + g23) j%x(2) = gr2 * ( - g14 + g23) * (0, 1) j%x(3) = gr2 * ( g13 - g24) end function vr_ff @ <>= pure function grav_ff (g, m, kb, k, psibar, psi) result (j) type(tensor) :: j complex(kind=default), intent(in) :: g real(kind=default), intent(in) :: m type(conjspinor), intent(in) :: psibar type(spinor), intent(in) :: psi type(momentum), intent(in) :: kb, k complex(kind=default) :: g2, g8, c_dum type(vector) :: v_dum type(tensor) :: t_metric t_metric%t = 0 t_metric%t(0,0) = 1.0_default t_metric%t(1,1) = - 1.0_default t_metric%t(2,2) = - 1.0_default t_metric%t(3,3) = - 1.0_default g2 = g/2.0_default g8 = g/8.0_default v_dum = v_ff(g8, psibar, psi) c_dum = (- m) * s_ff (g2, psibar, psi) - (kb+k)*v_dum j = c_dum*t_metric - (((kb+k).tprod.v_dum) + & (v_dum.tprod.(kb+k))) end function grav_ff @ \begin{equation} g_L\gamma_\mu(1-\gamma_5) + g_R\gamma_\mu(1+\gamma_5) = (g_L+g_R)\gamma_\mu - (g_L-g_R)\gamma_\mu\gamma_5 = g_V\gamma_\mu - g_A\gamma_\mu\gamma_5 \end{equation} \ldots{} give the compiler the benefit of the doubt that it will optimize the function all. If not, we could inline it \ldots <>= pure function vlr_ff (gl, gr, psibar, psi) result (j) type(vector) :: j complex(kind=default), intent(in) :: gl, gr type(conjspinor), intent(in) :: psibar type(spinor), intent(in) :: psi j = va_ff (gl+gr, gl-gr, psibar, psi) end function vlr_ff @ and \begin{equation} \fmslash{v} - \fmslash{a}\gamma_5 = \begin{pmatrix} 0 & 0 & v_- - a_- & - v^* + a^* \\ 0 & 0 & - v + a & v_+ - a_+ \\ v_+ + a_+ & v^* + a^* & 0 & 0 \\ v + a & v_- + a_- & 0 & 0 \end{pmatrix} \end{equation} with $v_\pm=v_0\pm v_3$, $a_\pm=a_0\pm a_3$, $v=v_1+\ii v_2$, $v^*=v_1-\ii v_2$, $a=a_1+\ii a_2$, and $a^*=a_1-\ii a_2$. But note that~$\cdot^*$ is \emph{not} complex conjugation for complex~$v_\mu$ or~$a_\mu$. <>= public :: f_vaf, f_vf, f_af, f_vlf, f_vrf, f_vlrf, f_va2f, & f_tvaf, f_tlrf, f_trlf, f_tvamf, f_tlrmf, f_trlmf, f_va3f @ <>= pure function f_vaf (gv, ga, v, psi) result (vpsi) type(spinor) :: vpsi complex(kind=default), intent(in) :: gv, ga type(vector), intent(in) :: v type(spinor), intent(in) :: psi complex(kind=default) :: gl, gr complex(kind=default) :: vp, vm, v12, v12s gl = gv + ga gr = gv - ga vp = v%t + v%x(3) vm = v%t - v%x(3) v12 = v%x(1) + (0,1)*v%x(2) v12s = v%x(1) - (0,1)*v%x(2) vpsi%a(1) = gr * ( vm * psi%a(3) - v12s * psi%a(4)) vpsi%a(2) = gr * ( - v12 * psi%a(3) + vp * psi%a(4)) vpsi%a(3) = gl * ( vp * psi%a(1) + v12s * psi%a(2)) vpsi%a(4) = gl * ( v12 * psi%a(1) + vm * psi%a(2)) end function f_vaf @ <>= pure function f_va2f (gva, v, psi) result (vpsi) type(spinor) :: vpsi complex(kind=default), intent(in), dimension(2) :: gva type(vector), intent(in) :: v type(spinor), intent(in) :: psi complex(kind=default) :: gl, gr complex(kind=default) :: vp, vm, v12, v12s gl = gva(1) + gva(2) gr = gva(1) - gva(2) vp = v%t + v%x(3) vm = v%t - v%x(3) v12 = v%x(1) + (0,1)*v%x(2) v12s = v%x(1) - (0,1)*v%x(2) vpsi%a(1) = gr * ( vm * psi%a(3) - v12s * psi%a(4)) vpsi%a(2) = gr * ( - v12 * psi%a(3) + vp * psi%a(4)) vpsi%a(3) = gl * ( vp * psi%a(1) + v12s * psi%a(2)) vpsi%a(4) = gl * ( v12 * psi%a(1) + vm * psi%a(2)) end function f_va2f @ <>= pure function f_va3f (gv, ga, v, psi) result (vpsi) type(spinor) :: vpsi complex(kind=default), intent(in) :: gv, ga type(vector), intent(in) :: v type(spinor), intent(in) :: psi complex(kind=default) :: gl, gr complex(kind=default) :: vp, vm, v12, v12s gl = gv + ga gr = gv - ga vp = v%x(3) !+ v%t vm = - v%x(3) !+ v%t v12 = v%x(1) + (0,1)*v%x(2) v12s = v%x(1) - (0,1)*v%x(2) vpsi%a(1) = gr * ( vm * psi%a(3) - v12s * psi%a(4)) vpsi%a(2) = gr * ( - v12 * psi%a(3) + vp * psi%a(4)) vpsi%a(3) = gl * ( vp * psi%a(1) + v12s * psi%a(2)) vpsi%a(4) = gl * ( v12 * psi%a(1) + vm * psi%a(2)) end function f_va3f @ <>= pure function f_tvaf (gv, ga, t, psi) result (tpsi) type(spinor) :: tpsi complex(kind=default), intent(in) :: gv, ga type(tensor2odd), intent(in) :: t type(spinor), intent(in) :: psi complex(kind=default) :: gl, gr complex(kind=default) :: e21, e21s, b12, b12s, be3, be3s gr = gv + ga gl = gv - ga e21 = t%e(2) + t%e(1)*(0,1) e21s = t%e(2) - t%e(1)*(0,1) b12 = t%b(1) + t%b(2)*(0,1) b12s = t%b(1) - t%b(2)*(0,1) be3 = t%b(3) + t%e(3)*(0,1) be3s = t%b(3) - t%e(3)*(0,1) tpsi%a(1) = 2*gl * ( psi%a(1) * be3 + psi%a(2) * ( e21 +b12s)) tpsi%a(2) = 2*gl * ( - psi%a(2) * be3 + psi%a(1) * (-e21s+b12 )) tpsi%a(3) = 2*gr * ( psi%a(3) * be3s + psi%a(4) * (-e21 +b12s)) tpsi%a(4) = 2*gr * ( - psi%a(4) * be3s + psi%a(3) * ( e21s+b12 )) end function f_tvaf @ <>= pure function f_tlrf (gl, gr, t, psi) result (tpsi) type(spinor) :: tpsi complex(kind=default), intent(in) :: gl, gr type(tensor2odd), intent(in) :: t type(spinor), intent(in) :: psi tpsi = f_tvaf (gr+gl, gr-gl, t, psi) end function f_tlrf @ <>= pure function f_trlf (gr, gl, t, psi) result (tpsi) type(spinor) :: tpsi complex(kind=default), intent(in) :: gl, gr type(tensor2odd), intent(in) :: t type(spinor), intent(in) :: psi tpsi = f_tvaf (gr+gl, gr-gl, t, psi) end function f_trlf @ <>= pure function f_tvamf (gv, ga, v, psi, k) result (vpsi) type(spinor) :: vpsi complex(kind=default), intent(in) :: gv, ga type(vector), intent(in) :: v type(spinor), intent(in) :: psi type(momentum), intent(in) :: k type(tensor2odd) :: t t = (v.wedge.k) * (0, 0.5) vpsi = f_tvaf(gv, ga, t, psi) end function f_tvamf @ <>= pure function f_tlrmf (gl, gr, v, psi, k) result (vpsi) type(spinor) :: vpsi complex(kind=default), intent(in) :: gl, gr type(vector), intent(in) :: v type(spinor), intent(in) :: psi type(momentum), intent(in) :: k vpsi = f_tvamf (gr+gl, gr-gl, v, psi, k) end function f_tlrmf @ <>= pure function f_trlmf (gr, gl, v, psi, k) result (vpsi) type(spinor) :: vpsi complex(kind=default), intent(in) :: gl, gr type(vector), intent(in) :: v type(spinor), intent(in) :: psi type(momentum), intent(in) :: k vpsi = f_tvamf (gr+gl, gr-gl, v, psi, k) end function f_trlmf @ <>= pure function f_vf (gv, v, psi) result (vpsi) type(spinor) :: vpsi complex(kind=default), intent(in) :: gv type(vector), intent(in) :: v type(spinor), intent(in) :: psi complex(kind=default) :: vp, vm, v12, v12s vp = v%t + v%x(3) vm = v%t - v%x(3) v12 = v%x(1) + (0,1)*v%x(2) v12s = v%x(1) - (0,1)*v%x(2) vpsi%a(1) = gv * ( vm * psi%a(3) - v12s * psi%a(4)) vpsi%a(2) = gv * ( - v12 * psi%a(3) + vp * psi%a(4)) vpsi%a(3) = gv * ( vp * psi%a(1) + v12s * psi%a(2)) vpsi%a(4) = gv * ( v12 * psi%a(1) + vm * psi%a(2)) end function f_vf @ <>= pure function f_af (ga, v, psi) result (vpsi) type(spinor) :: vpsi complex(kind=default), intent(in) :: ga type(vector), intent(in) :: v type(spinor), intent(in) :: psi complex(kind=default) :: vp, vm, v12, v12s vp = v%t + v%x(3) vm = v%t - v%x(3) v12 = v%x(1) + (0,1)*v%x(2) v12s = v%x(1) - (0,1)*v%x(2) vpsi%a(1) = ga * ( - vm * psi%a(3) + v12s * psi%a(4)) vpsi%a(2) = ga * ( v12 * psi%a(3) - vp * psi%a(4)) vpsi%a(3) = ga * ( vp * psi%a(1) + v12s * psi%a(2)) vpsi%a(4) = ga * ( v12 * psi%a(1) + vm * psi%a(2)) end function f_af @ <>= pure function f_vlf (gl, v, psi) result (vpsi) type(spinor) :: vpsi complex(kind=default), intent(in) :: gl type(vector), intent(in) :: v type(spinor), intent(in) :: psi complex(kind=default) :: gl2 complex(kind=default) :: vp, vm, v12, v12s gl2 = 2 * gl vp = v%t + v%x(3) vm = v%t - v%x(3) v12 = v%x(1) + (0,1)*v%x(2) v12s = v%x(1) - (0,1)*v%x(2) vpsi%a(1) = 0 vpsi%a(2) = 0 vpsi%a(3) = gl2 * ( vp * psi%a(1) + v12s * psi%a(2)) vpsi%a(4) = gl2 * ( v12 * psi%a(1) + vm * psi%a(2)) end function f_vlf @ <>= pure function f_vrf (gr, v, psi) result (vpsi) type(spinor) :: vpsi complex(kind=default), intent(in) :: gr type(vector), intent(in) :: v type(spinor), intent(in) :: psi complex(kind=default) :: gr2 complex(kind=default) :: vp, vm, v12, v12s gr2 = 2 * gr vp = v%t + v%x(3) vm = v%t - v%x(3) v12 = v%x(1) + (0,1)*v%x(2) v12s = v%x(1) - (0,1)*v%x(2) vpsi%a(1) = gr2 * ( vm * psi%a(3) - v12s * psi%a(4)) vpsi%a(2) = gr2 * ( - v12 * psi%a(3) + vp * psi%a(4)) vpsi%a(3) = 0 vpsi%a(4) = 0 end function f_vrf @ <>= pure function f_vlrf (gl, gr, v, psi) result (vpsi) type(spinor) :: vpsi complex(kind=default), intent(in) :: gl, gr type(vector), intent(in) :: v type(spinor), intent(in) :: psi vpsi = f_vaf (gl+gr, gl-gr, v, psi) end function f_vlrf @ <>= public :: f_fva, f_fv, f_fa, f_fvl, f_fvr, f_fvlr, f_fva2, & f_ftva, f_ftlr, f_ftrl, f_ftvam, f_ftlrm, f_ftrlm, f_fva3 @ <>= pure function f_fva (gv, ga, psibar, v) result (psibarv) type(conjspinor) :: psibarv complex(kind=default), intent(in) :: gv, ga type(conjspinor), intent(in) :: psibar type(vector), intent(in) :: v complex(kind=default) :: gl, gr complex(kind=default) :: vp, vm, v12, v12s gl = gv + ga gr = gv - ga vp = v%t + v%x(3) vm = v%t - v%x(3) v12 = v%x(1) + (0,1)*v%x(2) v12s = v%x(1) - (0,1)*v%x(2) psibarv%a(1) = gl * ( psibar%a(3) * vp + psibar%a(4) * v12) psibarv%a(2) = gl * ( psibar%a(3) * v12s + psibar%a(4) * vm ) psibarv%a(3) = gr * ( psibar%a(1) * vm - psibar%a(2) * v12) psibarv%a(4) = gr * ( - psibar%a(1) * v12s + psibar%a(2) * vp ) end function f_fva @ <>= pure function f_fva2 (gva, psibar, v) result (psibarv) type(conjspinor) :: psibarv complex(kind=default), intent(in), dimension(2) :: gva type(conjspinor), intent(in) :: psibar type(vector), intent(in) :: v complex(kind=default) :: gl, gr complex(kind=default) :: vp, vm, v12, v12s gl = gva(1) + gva(2) gr = gva(1) - gva(2) vp = v%t + v%x(3) vm = v%t - v%x(3) v12 = v%x(1) + (0,1)*v%x(2) v12s = v%x(1) - (0,1)*v%x(2) psibarv%a(1) = gl * ( psibar%a(3) * vp + psibar%a(4) * v12) psibarv%a(2) = gl * ( psibar%a(3) * v12s + psibar%a(4) * vm ) psibarv%a(3) = gr * ( psibar%a(1) * vm - psibar%a(2) * v12) psibarv%a(4) = gr * ( - psibar%a(1) * v12s + psibar%a(2) * vp ) end function f_fva2 @ <>= pure function f_fva3 (gv, ga, psibar, v) result (psibarv) type(conjspinor) :: psibarv complex(kind=default), intent(in) :: gv, ga type(conjspinor), intent(in) :: psibar type(vector), intent(in) :: v complex(kind=default) :: gl, gr complex(kind=default) :: vp, vm, v12, v12s gl = gv + ga gr = gv - ga vp = v%x(3) !+ v%t vm = - v%x(3) !+ v%t v12 = v%x(1) + (0,1)*v%x(2) v12s = v%x(1) - (0,1)*v%x(2) psibarv%a(1) = gl * ( psibar%a(3) * vp + psibar%a(4) * v12) psibarv%a(2) = gl * ( psibar%a(3) * v12s + psibar%a(4) * vm ) psibarv%a(3) = gr * ( psibar%a(1) * vm - psibar%a(2) * v12) psibarv%a(4) = gr * ( - psibar%a(1) * v12s + psibar%a(2) * vp ) end function f_fva3 @ <>= pure function f_ftva (gv, ga, psibar, t) result (psibart) type(conjspinor) :: psibart complex(kind=default), intent(in) :: gv, ga type(conjspinor), intent(in) :: psibar type(tensor2odd), intent(in) :: t complex(kind=default) :: gl, gr complex(kind=default) :: e21, e21s, b12, b12s, be3, be3s gr = gv + ga gl = gv - ga e21 = t%e(2) + t%e(1)*(0,1) e21s = t%e(2) - t%e(1)*(0,1) b12 = t%b(1) + t%b(2)*(0,1) b12s = t%b(1) - t%b(2)*(0,1) be3 = t%b(3) + t%e(3)*(0,1) be3s = t%b(3) - t%e(3)*(0,1) psibart%a(1) = 2*gl * ( psibar%a(1) * be3 + psibar%a(2) * (-e21s+b12 )) psibart%a(2) = 2*gl * ( - psibar%a(2) * be3 + psibar%a(1) * ( e21 +b12s)) psibart%a(3) = 2*gr * ( psibar%a(3) * be3s + psibar%a(4) * ( e21s+b12 )) psibart%a(4) = 2*gr * ( - psibar%a(4) * be3s + psibar%a(3) * (-e21 +b12s)) end function f_ftva @ <>= pure function f_ftlr (gl, gr, psibar, t) result (psibart) type(conjspinor) :: psibart complex(kind=default), intent(in) :: gl, gr type(conjspinor), intent(in) :: psibar type(tensor2odd), intent(in) :: t psibart = f_ftva (gr+gl, gr-gl, psibar, t) end function f_ftlr @ <>= pure function f_ftrl (gr, gl, psibar, t) result (psibart) type(conjspinor) :: psibart complex(kind=default), intent(in) :: gl, gr type(conjspinor), intent(in) :: psibar type(tensor2odd), intent(in) :: t psibart = f_ftva (gr+gl, gr-gl, psibar, t) end function f_ftrl @ <>= pure function f_ftvam (gv, ga, psibar, v, k) result (psibarv) type(conjspinor) :: psibarv complex(kind=default), intent(in) :: gv, ga type(conjspinor), intent(in) :: psibar type(vector), intent(in) :: v type(momentum), intent(in) :: k type(tensor2odd) :: t t = (v.wedge.k) * (0, 0.5) psibarv = f_ftva(gv, ga, psibar, t) end function f_ftvam @ <>= pure function f_ftlrm (gl, gr, psibar, v, k) result (psibarv) type(conjspinor) :: psibarv complex(kind=default), intent(in) :: gl, gr type(conjspinor), intent(in) :: psibar type(vector), intent(in) :: v type(momentum), intent(in) :: k psibarv = f_ftvam (gr+gl, gr-gl, psibar, v, k) end function f_ftlrm @ <>= pure function f_ftrlm (gr, gl, psibar, v, k) result (psibarv) type(conjspinor) :: psibarv complex(kind=default), intent(in) :: gl, gr type(conjspinor), intent(in) :: psibar type(vector), intent(in) :: v type(momentum), intent(in) :: k psibarv = f_ftvam (gr+gl, gr-gl, psibar, v, k) end function f_ftrlm @ <>= pure function f_fv (gv, psibar, v) result (psibarv) type(conjspinor) :: psibarv complex(kind=default), intent(in) :: gv type(conjspinor), intent(in) :: psibar type(vector), intent(in) :: v complex(kind=default) :: vp, vm, v12, v12s vp = v%t + v%x(3) vm = v%t - v%x(3) v12 = v%x(1) + (0,1)*v%x(2) v12s = v%x(1) - (0,1)*v%x(2) psibarv%a(1) = gv * ( psibar%a(3) * vp + psibar%a(4) * v12) psibarv%a(2) = gv * ( psibar%a(3) * v12s + psibar%a(4) * vm ) psibarv%a(3) = gv * ( psibar%a(1) * vm - psibar%a(2) * v12) psibarv%a(4) = gv * ( - psibar%a(1) * v12s + psibar%a(2) * vp ) end function f_fv @ <>= pure function f_fa (ga, psibar, v) result (psibarv) type(conjspinor) :: psibarv complex(kind=default), intent(in) :: ga type(vector), intent(in) :: v type(conjspinor), intent(in) :: psibar complex(kind=default) :: vp, vm, v12, v12s vp = v%t + v%x(3) vm = v%t - v%x(3) v12 = v%x(1) + (0,1)*v%x(2) v12s = v%x(1) - (0,1)*v%x(2) psibarv%a(1) = ga * ( psibar%a(3) * vp + psibar%a(4) * v12) psibarv%a(2) = ga * ( psibar%a(3) * v12s + psibar%a(4) * vm ) psibarv%a(3) = ga * ( - psibar%a(1) * vm + psibar%a(2) * v12) psibarv%a(4) = ga * ( psibar%a(1) * v12s - psibar%a(2) * vp ) end function f_fa @ <>= pure function f_fvl (gl, psibar, v) result (psibarv) type(conjspinor) :: psibarv complex(kind=default), intent(in) :: gl type(conjspinor), intent(in) :: psibar type(vector), intent(in) :: v complex(kind=default) :: gl2 complex(kind=default) :: vp, vm, v12, v12s gl2 = 2 * gl vp = v%t + v%x(3) vm = v%t - v%x(3) v12 = v%x(1) + (0,1)*v%x(2) v12s = v%x(1) - (0,1)*v%x(2) psibarv%a(1) = gl2 * ( psibar%a(3) * vp + psibar%a(4) * v12) psibarv%a(2) = gl2 * ( psibar%a(3) * v12s + psibar%a(4) * vm ) psibarv%a(3) = 0 psibarv%a(4) = 0 end function f_fvl @ <>= pure function f_fvr (gr, psibar, v) result (psibarv) type(conjspinor) :: psibarv complex(kind=default), intent(in) :: gr type(conjspinor), intent(in) :: psibar type(vector), intent(in) :: v complex(kind=default) :: gr2 complex(kind=default) :: vp, vm, v12, v12s gr2 = 2 * gr vp = v%t + v%x(3) vm = v%t - v%x(3) v12 = v%x(1) + (0,1)*v%x(2) v12s = v%x(1) - (0,1)*v%x(2) psibarv%a(1) = 0 psibarv%a(2) = 0 psibarv%a(3) = gr2 * ( psibar%a(1) * vm - psibar%a(2) * v12) psibarv%a(4) = gr2 * ( - psibar%a(1) * v12s + psibar%a(2) * vp ) end function f_fvr @ <>= pure function f_fvlr (gl, gr, psibar, v) result (psibarv) type(conjspinor) :: psibarv complex(kind=default), intent(in) :: gl, gr type(conjspinor), intent(in) :: psibar type(vector), intent(in) :: v psibarv = f_fva (gl+gr, gl-gr, psibar, v) end function f_fvlr @ \subsection{Fermionic Scalar and Pseudo Scalar Couplings} <>= public :: sp_ff, s_ff, p_ff, sl_ff, sr_ff, slr_ff @ <>= pure function sp_ff (gs, gp, psibar, psi) result (j) complex(kind=default) :: j complex(kind=default), intent(in) :: gs, gp type(conjspinor), intent(in) :: psibar type(spinor), intent(in) :: psi j = (gs - gp) * (psibar%a(1)*psi%a(1) + psibar%a(2)*psi%a(2)) & + (gs + gp) * (psibar%a(3)*psi%a(3) + psibar%a(4)*psi%a(4)) end function sp_ff @ <>= pure function s_ff (gs, psibar, psi) result (j) complex(kind=default) :: j complex(kind=default), intent(in) :: gs type(conjspinor), intent(in) :: psibar type(spinor), intent(in) :: psi j = gs * (psibar * psi) end function s_ff @ <>= pure function p_ff (gp, psibar, psi) result (j) complex(kind=default) :: j complex(kind=default), intent(in) :: gp type(conjspinor), intent(in) :: psibar type(spinor), intent(in) :: psi j = gp * ( psibar%a(3)*psi%a(3) + psibar%a(4)*psi%a(4) & - psibar%a(1)*psi%a(1) - psibar%a(2)*psi%a(2)) end function p_ff @ <>= pure function sl_ff (gl, psibar, psi) result (j) complex(kind=default) :: j complex(kind=default), intent(in) :: gl type(conjspinor), intent(in) :: psibar type(spinor), intent(in) :: psi j = 2 * gl * (psibar%a(1)*psi%a(1) + psibar%a(2)*psi%a(2)) end function sl_ff @ <>= pure function sr_ff (gr, psibar, psi) result (j) complex(kind=default) :: j complex(kind=default), intent(in) :: gr type(conjspinor), intent(in) :: psibar type(spinor), intent(in) :: psi j = 2 * gr * (psibar%a(3)*psi%a(3) + psibar%a(4)*psi%a(4)) end function sr_ff @ \begin{equation} g_L(1-\gamma_5) + g_R(1+\gamma_5) = (g_R+g_L) + (g_R-g_L)\gamma_5 = g_S + g_P\gamma_5 \end{equation} <>= pure function slr_ff (gl, gr, psibar, psi) result (j) complex(kind=default) :: j complex(kind=default), intent(in) :: gl, gr type(conjspinor), intent(in) :: psibar type(spinor), intent(in) :: psi j = sp_ff (gr+gl, gr-gl, psibar, psi) end function slr_ff @ <>= public :: f_spf, f_sf, f_pf, f_slf, f_srf, f_slrf @ <>= pure function f_spf (gs, gp, phi, psi) result (phipsi) type(spinor) :: phipsi complex(kind=default), intent(in) :: gs, gp complex(kind=default), intent(in) :: phi type(spinor), intent(in) :: psi phipsi%a(1:2) = ((gs - gp) * phi) * psi%a(1:2) phipsi%a(3:4) = ((gs + gp) * phi) * psi%a(3:4) end function f_spf @ <>= pure function f_sf (gs, phi, psi) result (phipsi) type(spinor) :: phipsi complex(kind=default), intent(in) :: gs complex(kind=default), intent(in) :: phi type(spinor), intent(in) :: psi phipsi%a = (gs * phi) * psi%a end function f_sf @ <>= pure function f_pf (gp, phi, psi) result (phipsi) type(spinor) :: phipsi complex(kind=default), intent(in) :: gp complex(kind=default), intent(in) :: phi type(spinor), intent(in) :: psi phipsi%a(1:2) = (- gp * phi) * psi%a(1:2) phipsi%a(3:4) = ( gp * phi) * psi%a(3:4) end function f_pf @ <>= pure function f_slf (gl, phi, psi) result (phipsi) type(spinor) :: phipsi complex(kind=default), intent(in) :: gl complex(kind=default), intent(in) :: phi type(spinor), intent(in) :: psi phipsi%a(1:2) = (2 * gl * phi) * psi%a(1:2) phipsi%a(3:4) = 0 end function f_slf @ <>= pure function f_srf (gr, phi, psi) result (phipsi) type(spinor) :: phipsi complex(kind=default), intent(in) :: gr complex(kind=default), intent(in) :: phi type(spinor), intent(in) :: psi phipsi%a(1:2) = 0 phipsi%a(3:4) = (2 * gr * phi) * psi%a(3:4) end function f_srf @ <>= pure function f_slrf (gl, gr, phi, psi) result (phipsi) type(spinor) :: phipsi complex(kind=default), intent(in) :: gl, gr complex(kind=default), intent(in) :: phi type(spinor), intent(in) :: psi phipsi = f_spf (gr+gl, gr-gl, phi, psi) end function f_slrf @ <>= public :: f_fsp, f_fs, f_fp, f_fsl, f_fsr, f_fslr @ <>= pure function f_fsp (gs, gp, psibar, phi) result (psibarphi) type(conjspinor) :: psibarphi complex(kind=default), intent(in) :: gs, gp type(conjspinor), intent(in) :: psibar complex(kind=default), intent(in) :: phi psibarphi%a(1:2) = ((gs - gp) * phi) * psibar%a(1:2) psibarphi%a(3:4) = ((gs + gp) * phi) * psibar%a(3:4) end function f_fsp @ <>= pure function f_fs (gs, psibar, phi) result (psibarphi) type(conjspinor) :: psibarphi complex(kind=default), intent(in) :: gs type(conjspinor), intent(in) :: psibar complex(kind=default), intent(in) :: phi psibarphi%a = (gs * phi) * psibar%a end function f_fs @ <>= pure function f_fp (gp, psibar, phi) result (psibarphi) type(conjspinor) :: psibarphi complex(kind=default), intent(in) :: gp type(conjspinor), intent(in) :: psibar complex(kind=default), intent(in) :: phi psibarphi%a(1:2) = (- gp * phi) * psibar%a(1:2) psibarphi%a(3:4) = ( gp * phi) * psibar%a(3:4) end function f_fp @ <>= pure function f_fsl (gl, psibar, phi) result (psibarphi) type(conjspinor) :: psibarphi complex(kind=default), intent(in) :: gl type(conjspinor), intent(in) :: psibar complex(kind=default), intent(in) :: phi psibarphi%a(1:2) = (2 * gl * phi) * psibar%a(1:2) psibarphi%a(3:4) = 0 end function f_fsl @ <>= pure function f_fsr (gr, psibar, phi) result (psibarphi) type(conjspinor) :: psibarphi complex(kind=default), intent(in) :: gr type(conjspinor), intent(in) :: psibar complex(kind=default), intent(in) :: phi psibarphi%a(1:2) = 0 psibarphi%a(3:4) = (2 * gr * phi) * psibar%a(3:4) end function f_fsr @ <>= pure function f_fslr (gl, gr, psibar, phi) result (psibarphi) type(conjspinor) :: psibarphi complex(kind=default), intent(in) :: gl, gr type(conjspinor), intent(in) :: psibar complex(kind=default), intent(in) :: phi psibarphi = f_fsp (gr+gl, gr-gl, psibar, phi) end function f_fslr <>= public :: f_gravf, f_fgrav @ <>= pure function f_gravf (g, m, kb, k, t, psi) result (tpsi) type(spinor) :: tpsi complex(kind=default), intent(in) :: g real(kind=default), intent(in) :: m type(spinor), intent(in) :: psi type(tensor), intent(in) :: t type(momentum), intent(in) :: kb, k complex(kind=default) :: g2, g8, t_tr type(vector) :: kkb kkb = k + kb g2 = g / 2.0_default g8 = g / 8.0_default t_tr = t%t(0,0) - t%t(1,1) - t%t(2,2) - t%t(3,3) tpsi = (- f_sf (g2, cmplx (m,0.0, kind=default), psi) & - f_vf ((g8*m), kkb, psi)) * t_tr - & f_vf (g8,(t*kkb + kkb*t),psi) end function f_gravf @ <>= pure function f_fgrav (g, m, kb, k, psibar, t) result (psibart) type(conjspinor) :: psibart complex(kind=default), intent(in) :: g real(kind=default), intent(in) :: m type(conjspinor), intent(in) :: psibar type(tensor), intent(in) :: t type(momentum), intent(in) :: kb, k type(vector) :: kkb complex(kind=default) :: g2, g8, t_tr kkb = k + kb g2 = g / 2.0_default g8 = g / 8.0_default t_tr = t%t(0,0) - t%t(1,1) - t%t(2,2) - t%t(3,3) psibart = (- f_fs (g2, psibar, cmplx (m, 0.0, kind=default)) & - f_fv ((g8 * m), psibar, kkb)) * t_tr - & f_fv (g8,psibar,(t*kkb + kkb*t)) end function f_fgrav @ \subsection{On Shell Wave Functions} <>= public :: u, ubar, v, vbar private :: chi_plus, chi_minus @ \begin{subequations} \begin{align} \chi_+(\vec p) &= \frac{1}{\sqrt{2|\vec p|(|\vec p|+p_3)}} \begin{pmatrix} |\vec p|+p_3 \\ p_1 + \ii p_2 \end{pmatrix} \\ \chi_-(\vec p) &= \frac{1}{\sqrt{2|\vec p|(|\vec p|+p_3)}} \begin{pmatrix} - p_1 + \ii p_2 \\ |\vec p|+p_3 \end{pmatrix} \end{align} \end{subequations} <>= pure function chi_plus (p) result (chi) complex(kind=default), dimension(2) :: chi type(momentum), intent(in) :: p real(kind=default) :: pabs pabs = sqrt (dot_product (p%x, p%x)) if (pabs + p%x(3) <= 1000 * epsilon (pabs) * pabs) then chi = (/ cmplx ( 0.0, 0.0, kind=default), & cmplx ( 1.0, 0.0, kind=default) /) else chi = 1 / sqrt (2*pabs*(pabs + p%x(3))) & * (/ cmplx (pabs + p%x(3), kind=default), & cmplx (p%x(1), p%x(2), kind=default) /) end if end function chi_plus @ <>= pure function chi_minus (p) result (chi) complex(kind=default), dimension(2) :: chi type(momentum), intent(in) :: p real(kind=default) :: pabs pabs = sqrt (dot_product (p%x, p%x)) if (pabs + p%x(3) <= 1000 * epsilon (pabs) * pabs) then chi = (/ cmplx (-1.0, 0.0, kind=default), & cmplx ( 0.0, 0.0, kind=default) /) else chi = 1 / sqrt (2*pabs*(pabs + p%x(3))) & * (/ cmplx (-p%x(1), p%x(2), kind=default), & cmplx (pabs + p%x(3), kind=default) /) end if end function chi_minus @ \begin{equation} u_\pm(p,|m|) = \begin{pmatrix} \sqrt{p_0\mp|\vec p|} \cdot \chi_\pm(\vec p) \\ \sqrt{p_0\pm|\vec p|} \cdot \chi_\pm(\vec p) \end{pmatrix}\qquad u_\pm(p,-|m|) = \begin{pmatrix} - i \sqrt{p_0\mp|\vec p|} \cdot \chi_\pm(\vec p) \\ + i \sqrt{p_0\pm|\vec p|} \cdot \chi_\pm(\vec p) \end{pmatrix} \end{equation} Determining the mass from the momenta is a numerically haphazardous for light particles. Therefore, we accept some redundancy and pass the mass explicitely. Even if the mass is not used in the chiral representation, we do so for symmetry with polarization vectors and to be prepared for other representations. <>= pure function u (mass, p, s) result (psi) type(spinor) :: psi real(kind=default), intent(in) :: mass type(momentum), intent(in) :: p integer, intent(in) :: s complex(kind=default), dimension(2) :: chi real(kind=default) :: pabs, delta, m m = abs(mass) pabs = sqrt (dot_product (p%x, p%x)) if (m < epsilon (m) * pabs) then delta = 0 else delta = sqrt (max (p%t - pabs, 0._default)) end if select case (s) case (1) chi = chi_plus (p) psi%a(1:2) = delta * chi psi%a(3:4) = sqrt (p%t + pabs) * chi case (-1) chi = chi_minus (p) psi%a(1:2) = sqrt (p%t + pabs) * chi psi%a(3:4) = delta * chi case default pabs = m ! make the compiler happy and use m psi%a = 0 end select if (mass < 0) then psi%a(1:2) = - imago * psi%a(1:2) psi%a(3:4) = + imago * psi%a(3:4) end if end function u @ <>= pure function ubar (m, p, s) result (psibar) type(conjspinor) :: psibar real(kind=default), intent(in) :: m type(momentum), intent(in) :: p integer, intent(in) :: s type(spinor) :: psi psi = u (m, p, s) psibar%a(1:2) = conjg (psi%a(3:4)) psibar%a(3:4) = conjg (psi%a(1:2)) end function ubar @ \begin{equation} v_\pm(p) = \begin{pmatrix} \mp\sqrt{p_0\pm|\vec p|} \cdot \chi_\mp(\vec p) \\ \pm\sqrt{p_0\mp|\vec p|} \cdot \chi_\mp(\vec p) \end{pmatrix} \end{equation} <>= pure function v (mass, p, s) result (psi) type(spinor) :: psi real(kind=default), intent(in) :: mass type(momentum), intent(in) :: p integer, intent(in) :: s complex(kind=default), dimension(2) :: chi real(kind=default) :: pabs, delta, m m = abs(mass) pabs = sqrt (dot_product (p%x, p%x)) if (m < epsilon (m) * pabs) then delta = 0 else delta = sqrt (max (p%t - pabs, 0._default)) end if select case (s) case (1) chi = chi_minus (p) psi%a(1:2) = - sqrt (p%t + pabs) * chi psi%a(3:4) = delta * chi case (-1) chi = chi_plus (p) psi%a(1:2) = delta * chi psi%a(3:4) = - sqrt (p%t + pabs) * chi case default pabs = m ! make the compiler happy and use m psi%a = 0 end select if (mass < 0) then psi%a(1:2) = - imago * psi%a(1:2) psi%a(3:4) = + imago * psi%a(3:4) end if end function v @ <>= pure function vbar (m, p, s) result (psibar) type(conjspinor) :: psibar real(kind=default), intent(in) :: m type(momentum), intent(in) :: p integer, intent(in) :: s type(spinor) :: psi psi = v (m, p, s) psibar%a(1:2) = conjg (psi%a(3:4)) psibar%a(3:4) = conjg (psi%a(1:2)) end function vbar @ \subsection{Off Shell Wave Functions} I've just taken this over from Christian Schwinn's version. <>= public :: brs_u, brs_ubar, brs_v, brs_vbar @ The off-shell wave functions needed for gauge checking are obtained from the LSZ-formulas: \begin{subequations} \begin{align} \Braket{\text{Out}|d^\dagger|\text{In}}&=i\int d^4x \bar v e^{-ikx}(i\fmslash\partial-m)\Braket{\text{Out}|\psi|\text{In}}\\ \Braket{\text{Out}|b|\text{In}}&=-i\int d^4x \bar u e^{ikx}(i\fmslash\partial-m)\Braket{\text{Out}|\psi|\text{In}}\\ \Braket{\text{Out}|d|\text{In}}&= i\int d^4x \Braket{\text{Out}|\bar \psi| \text{In}}(-i\fmslash{\overleftarrow\partial}-m)v e^{ikx}\\ \Braket{\text{Out}|b^\dagger|\text{In}}&= -i\int d^4x \Braket{\text{Out}|\bar \psi| \text{In}}(-i\fmslash{\overleftarrow\partial}-m)u e^{-ikx} \end{align} \end{subequations} Since the relative sign between fermions and antifermions is ignored for on-shell amplitudes we must also ignore it here, so all wavefunctions must have a $(-i)$ factor. In momentum space we have: \begin{equation} brs u(p)=(-i) (\fmslash p-m)u(p) \end{equation} <>= pure function brs_u (m, p, s) result (dpsi) type(spinor) :: dpsi,psi real(kind=default), intent(in) :: m type(momentum), intent(in) :: p integer, intent(in) :: s type (vector)::vp complex(kind=default), parameter :: one = (1, 0) vp=p psi=u(m,p,s) dpsi=cmplx(0.0,-1.0)*(f_vf(one,vp,psi)-m*psi) end function brs_u @ \begin{equation} brs v(p)=i (\fmslash p+m)v(p) \end{equation} <>= pure function brs_v (m, p, s) result (dpsi) type(spinor) :: dpsi, psi real(kind=default), intent(in) :: m type(momentum), intent(in) :: p integer, intent(in) :: s type (vector)::vp complex(kind=default), parameter :: one = (1, 0) vp=p psi=v(m,p,s) dpsi=cmplx(0.0,1.0)*(f_vf(one,vp,psi)+m*psi) end function brs_v @ \begin{equation} brs \bar{u}(p)=(-i)\bar u(p)(\fmslash p-m) \end{equation} <>= pure function brs_ubar (m, p, s)result (dpsibar) type(conjspinor) :: dpsibar, psibar real(kind=default), intent(in) :: m type(momentum), intent(in) :: p integer, intent(in) :: s type (vector)::vp complex(kind=default), parameter :: one = (1, 0) vp=p psibar=ubar(m,p,s) dpsibar=cmplx(0.0,-1.0)*(f_fv(one,psibar,vp)-m*psibar) end function brs_ubar @ \begin{equation} brs \bar{v}(p)=(i)\bar v(p)(\fmslash p+m) \end{equation} <>= pure function brs_vbar (m, p, s) result (dpsibar) type(conjspinor) :: dpsibar,psibar real(kind=default), intent(in) :: m type(momentum), intent(in) :: p integer, intent(in) :: s type(vector)::vp complex(kind=default), parameter :: one = (1, 0) vp=p psibar=vbar(m,p,s) dpsibar=cmplx(0.0,1.0)*(f_fv(one,psibar,vp)+m*psibar) end function brs_vbar @ NB: The remarks on momentum flow in the propagators don't apply here since the incoming momenta are flipped for the wave functions. @ \subsection{Propagators} NB: the common factor of~$\ii$ is extracted: <>= public :: pr_psi, pr_psibar public :: pj_psi, pj_psibar public :: pg_psi, pg_psibar @ \begin{equation} \frac{i(-\fmslash{p}+m)}{p^2-m^2+\ii m\Gamma}\psi \end{equation} NB: the sign of the momentum comes about because all momenta are treated as \emph{outgoing} and the particle charge flow is therefore opposite to the momentum. <>= pure function pr_psi (p, m, w, cms, psi) result (ppsi) type(spinor) :: ppsi type(momentum), intent(in) :: p real(kind=default), intent(in) :: m, w type(spinor), intent(in) :: psi logical, intent(in) :: cms type(vector) :: vp complex(kind=default), parameter :: one = (1, 0) complex(kind=default) :: num_mass vp = p if (cms) then num_mass = sqrt(cmplx(m**2, -m*w, kind=default)) else num_mass = cmplx (m, 0, kind=default) end if ppsi = (1 / cmplx (p*p - m**2, m*w, kind=default)) & * (- f_vf (one, vp, psi) + num_mass * psi) end function pr_psi @ \begin{equation} \sqrt{\frac{\pi}{M\Gamma}} (-\fmslash{p}+m)\psi \end{equation} <>= pure function pj_psi (p, m, w, psi) result (ppsi) type(spinor) :: ppsi type(momentum), intent(in) :: p real(kind=default), intent(in) :: m, w type(spinor), intent(in) :: psi type(vector) :: vp complex(kind=default), parameter :: one = (1, 0) vp = p ppsi = (0, -1) * sqrt (PI / m / w) * (- f_vf (one, vp, psi) + m * psi) end function pj_psi @ <>= pure function pg_psi (p, m, w, psi) result (ppsi) type(spinor) :: ppsi type(momentum), intent(in) :: p real(kind=default), intent(in) :: m, w type(spinor), intent(in) :: psi type(vector) :: vp complex(kind=default), parameter :: one = (1, 0) vp = p ppsi = gauss(p*p, m, w) * (- f_vf (one, vp, psi) + m * psi) end function pg_psi @ \begin{equation} \bar\psi \frac{i(\fmslash{p}+m)}{p^2-m^2+\ii m\Gamma} \end{equation} NB: the sign of the momentum comes about because all momenta are treated as \emph{outgoing} and the antiparticle charge flow is therefore parallel to the momentum. <>= pure function pr_psibar (p, m, w, cms, psibar) result (ppsibar) type(conjspinor) :: ppsibar type(momentum), intent(in) :: p real(kind=default), intent(in) :: m, w type(conjspinor), intent(in) :: psibar logical, intent(in) :: cms type(vector) :: vp complex(kind=default), parameter :: one = (1, 0) complex(kind=default) :: num_mass vp = p if (cms) then num_mass = sqrt(cmplx(m**2, -m*w, kind=default)) else num_mass = cmplx (m, 0, kind=default) end if ppsibar = (1 / cmplx (p*p - m**2, m*w, kind=default)) & * (f_fv (one, psibar, vp) + num_mass * psibar) end function pr_psibar @ \begin{equation} \sqrt{\frac{\pi}{M\Gamma}} \bar\psi (\fmslash{p}+m) \end{equation} NB: the sign of the momentum comes about because all momenta are treated as \emph{outgoing} and the antiparticle charge flow is therefore parallel to the momentum. <>= pure function pj_psibar (p, m, w, psibar) result (ppsibar) type(conjspinor) :: ppsibar type(momentum), intent(in) :: p real(kind=default), intent(in) :: m, w type(conjspinor), intent(in) :: psibar type(vector) :: vp complex(kind=default), parameter :: one = (1, 0) vp = p ppsibar = (0, -1) * sqrt (PI / m / w) * (f_fv (one, psibar, vp) + m * psibar) end function pj_psibar @ <>= pure function pg_psibar (p, m, w, psibar) result (ppsibar) type(conjspinor) :: ppsibar type(momentum), intent(in) :: p real(kind=default), intent(in) :: m, w type(conjspinor), intent(in) :: psibar type(vector) :: vp complex(kind=default), parameter :: one = (1, 0) vp = p ppsibar = gauss (p*p, m, w) * (f_fv (one, psibar, vp) + m * psibar) end function pg_psibar @ \begin{equation} \frac{i(-\fmslash{p}+m)}{p^2-m^2+\ii m\Gamma} \sum_n \psi_n\otimes\bar\psi_n \end{equation} NB: the temporary variables [[psi(1:4)]] are not nice, but the compilers should be able to optimize the unnecessary copies away. In any case, even if the copies are performed, they are (probably) negligible compared to the floating point multiplications anyway \ldots <<(Not used yet) Declaration of operations for spinors>>= type, public :: spinordyad ! private (omegalib needs access, but DON'T TOUCH IT!) complex(kind=default), dimension(4,4) :: a end type spinordyad @ <<(Not used yet) Implementation of spinor propagators>>= pure function pr_dyadleft (p, m, w, psipsibar) result (psipsibarp) type(spinordyad) :: psipsibarp type(momentum), intent(in) :: p real(kind=default), intent(in) :: m, w type(spinordyad), intent(in) :: psipsibar integer :: i type(vector) :: vp type(spinor), dimension(4) :: psi complex(kind=default) :: pole complex(kind=default), parameter :: one = (1, 0) vp = p pole = 1 / cmplx (p*p - m**2, m*w, kind=default) do i = 1, 4 psi(i)%a = psipsibar%a(:,i) psi(i) = pole * (- f_vf (one, vp, psi(i)) + m * psi(i)) psipsibarp%a(:,i) = psi(i)%a end do end function pr_dyadleft @ \begin{equation} \sum_n \psi_n\otimes\bar\psi_n \frac{i(\fmslash{p}+m)}{p^2-m^2+\ii m\Gamma} \end{equation} <<(Not used yet) Implementation of spinor propagators>>= pure function pr_dyadright (p, m, w, psipsibar) result (psipsibarp) type(spinordyad) :: psipsibarp type(momentum), intent(in) :: p real(kind=default), intent(in) :: m, w type(spinordyad), intent(in) :: psipsibar integer :: i type(vector) :: vp type(conjspinor), dimension(4) :: psibar complex(kind=default) :: pole complex(kind=default), parameter :: one = (1, 0) vp = p pole = 1 / cmplx (p*p - m**2, m*w, kind=default) do i = 1, 4 psibar(i)%a = psipsibar%a(i,:) psibar(i) = pole * (f_fv (one, psibar(i), vp) + m * psibar(i)) psipsibarp%a(i,:) = psibar(i)%a end do end function pr_dyadright @ \section{Spinor Couplings Revisited} <<[[omega_bispinor_couplings.f90]]>>= <> module omega_bispinor_couplings use kinds use constants use omega_bispinors use omega_vectorspinors use omega_vectors use omega_couplings implicit none private <> <> <> <> integer, parameter, public :: omega_bispinor_cpls_2010_01_A = 0 contains <> <> <> <> end module omega_bispinor_couplings @ See table~\ref{tab:fermionic-currents} for the names of Fortran functions. We could have used long names instead, but this would increase the chance of running past continuation line limits without adding much to the legibility. @ \subsection{Fermionic Vector and Axial Couplings} There's more than one chiral representation. This one is compatible with HELAS~\cite{HELAS}. \begin{subequations} \begin{align} & \gamma^0 = \begin{pmatrix} 0 & \mathbf{1} \\ \mathbf{1} & 0 \end{pmatrix},\; \gamma^i = \begin{pmatrix} 0 & \sigma^i \\ -\sigma^i & 0 \end{pmatrix},\; \gamma_5 = i\gamma^0\gamma^1\gamma^2\gamma^3 = \begin{pmatrix} -\mathbf{1} & 0 \\ 0 & \mathbf{1} \end{pmatrix}, \\ & C = \begin{pmatrix} \epsilon & 0 \\ 0 & - \epsilon \end{pmatrix} \; , \qquad \epsilon = \begin{pmatrix} 0 & 1 \\ -1 & 0 \end{pmatrix} . \end{align} \end{subequations} Therefore \begin{subequations} \begin{align} g_S + g_P\gamma_5 &= \begin{pmatrix} g_S - g_P & 0 & 0 & 0 \\ 0 & g_S - g_P & 0 & 0 \\ 0 & 0 & g_S + g_P & 0 \\ 0 & 0 & 0 & g_S + g_P \end{pmatrix} \\ g_V\gamma^0 - g_A\gamma^0\gamma_5 &= \begin{pmatrix} 0 & 0 & g_V - g_A & 0 \\ 0 & 0 & 0 & g_V - g_A \\ g_V + g_A & 0 & 0 & 0 \\ 0 & g_V + g_A & 0 & 0 \end{pmatrix} \\ g_V\gamma^1 - g_A\gamma^1\gamma_5 &= \begin{pmatrix} 0 & 0 & 0 & g_V - g_A \\ 0 & 0 & g_V - g_A & 0 \\ 0 & - g_V - g_A & 0 & 0 \\ - g_V - g_A & 0 & 0 & 0 \end{pmatrix} \\ g_V\gamma^2 - g_A\gamma^2\gamma_5 &= \begin{pmatrix} 0 & 0 & 0 & -\ii(g_V - g_A) \\ 0 & 0 & \ii(g_V - g_A) & 0 \\ 0 & \ii(g_V + g_A) & 0 & 0 \\ -\ii(g_V + g_A) & 0 & 0 & 0 \end{pmatrix} \\ g_V\gamma^3 - g_A\gamma^3\gamma_5 &= \begin{pmatrix} 0 & 0 & g_V - g_A & 0 \\ 0 & 0 & 0 & - g_V + g_A \\ - g_V - g_A & 0 & 0 & 0 \\ 0 & g_V + g_A & 0 & 0 \end{pmatrix} \end{align} \end{subequations} and \begin{subequations} \begin{align} C(g_S + g_P\gamma_5) &= \begin{pmatrix} 0 & g_S - g_P & 0 & 0 \\ - g_S + g_P & 0 & 0 & 0 \\ 0 & 0 & 0 & - g_S - g_P \\ 0 & 0 & g_S + g_P & 0 \end{pmatrix} \\ C(g_V\gamma^0 - g_A\gamma^0\gamma_5) &= \begin{pmatrix} 0 & 0 & 0 & g_V - g_A \\ 0 & 0 & - g_V + g_A & 0 \\ 0 & - g_V - g_A & 0 & 0 \\ g_V + g_A & 0 & 0 & 0 \end{pmatrix} \\ C(g_V\gamma^1 - g_A\gamma^1\gamma_5) &= \begin{pmatrix} 0 & 0 & g_V - g_A & 0 \\ 0 & 0 & 0 & - g_V + g_A \\ g_V + g_A & 0 & 0 & 0 \\ 0 & - g_V - g_A & 0 & 0 \end{pmatrix} \\ C(g_V\gamma^2 - g_A\gamma^2\gamma_5) &= \begin{pmatrix} 0 & 0 & \ii(g_V - g_A) & 0 \\ 0 & 0 & 0 & \ii(g_V - g_A) \\ \ii(g_V + g_A) & 0 & 0 & 0 \\ 0 & \ii(g_V + g_A) & 0 & 0 \end{pmatrix} \\ C(g_V\gamma^3 - g_A\gamma^3\gamma_5) &= \begin{pmatrix} 0 & 0 & 0 & - g_V + g_A \\ 0 & 0 & - g_V + g_A & 0 \\ 0 & - g_V - g_A & 0 & 0 \\ - g_V - g_A & 0 & 0 & 0 \end{pmatrix} \end{align} \end{subequations} <>= -public :: va_ff, v_ff, a_ff, vl_ff, vr_ff, vlr_ff, va2_ff +public :: va_ff, v_ff, a_ff, vl_ff, vr_ff, vlr_ff, va2_ff, tva_ff, tvam_ff, & + tlr_ff, tlrm_ff @ <>= pure function va_ff (gv, ga, psil, psir) result (j) type(vector) :: j complex(kind=default), intent(in) :: gv, ga type(bispinor), intent(in) :: psil, psir complex(kind=default) :: gl, gr complex(kind=default) :: g13, g14, g23, g24, g31, g32, g41, g42 gl = gv + ga gr = gv - ga g13 = psil%a(1)*psir%a(3) g14 = psil%a(1)*psir%a(4) g23 = psil%a(2)*psir%a(3) g24 = psil%a(2)*psir%a(4) g31 = psil%a(3)*psir%a(1) g32 = psil%a(3)*psir%a(2) g41 = psil%a(4)*psir%a(1) g42 = psil%a(4)*psir%a(2) j%t = gr * ( g14 - g23) + gl * ( - g32 + g41) j%x(1) = gr * ( g13 - g24) + gl * ( g31 - g42) j%x(2) = (gr * ( g13 + g24) + gl * ( g31 + g42)) * (0, 1) j%x(3) = gr * ( - g14 - g23) + gl * ( - g32 - g41) end function va_ff @ <>= pure function va2_ff (gva, psil, psir) result (j) type(vector) :: j complex(kind=default), intent(in), dimension(2) :: gva type(bispinor), intent(in) :: psil, psir complex(kind=default) :: gl, gr complex(kind=default) :: g13, g14, g23, g24, g31, g32, g41, g42 gl = gva(1) + gva(2) gr = gva(1) - gva(2) g13 = psil%a(1)*psir%a(3) g14 = psil%a(1)*psir%a(4) g23 = psil%a(2)*psir%a(3) g24 = psil%a(2)*psir%a(4) g31 = psil%a(3)*psir%a(1) g32 = psil%a(3)*psir%a(2) g41 = psil%a(4)*psir%a(1) g42 = psil%a(4)*psir%a(2) j%t = gr * ( g14 - g23) + gl * ( - g32 + g41) j%x(1) = gr * ( g13 - g24) + gl * ( g31 - g42) j%x(2) = (gr * ( g13 + g24) + gl * ( g31 + g42)) * (0, 1) j%x(3) = gr * ( - g14 - g23) + gl * ( - g32 - g41) end function va2_ff @ <>= pure function v_ff (gv, psil, psir) result (j) type(vector) :: j complex(kind=default), intent(in) :: gv type(bispinor), intent(in) :: psil, psir complex(kind=default) :: g13, g14, g23, g24, g31, g32, g41, g42 g13 = psil%a(1)*psir%a(3) g14 = psil%a(1)*psir%a(4) g23 = psil%a(2)*psir%a(3) g24 = psil%a(2)*psir%a(4) g31 = psil%a(3)*psir%a(1) g32 = psil%a(3)*psir%a(2) g41 = psil%a(4)*psir%a(1) g42 = psil%a(4)*psir%a(2) j%t = gv * ( g14 - g23 - g32 + g41) j%x(1) = gv * ( g13 - g24 + g31 - g42) j%x(2) = gv * ( g13 + g24 + g31 + g42) * (0, 1) j%x(3) = gv * ( - g14 - g23 - g32 - g41) end function v_ff @ <>= pure function a_ff (ga, psil, psir) result (j) type(vector) :: j complex(kind=default), intent(in) :: ga type(bispinor), intent(in) :: psil, psir complex(kind=default) :: g13, g14, g23, g24, g31, g32, g41, g42 g13 = psil%a(1)*psir%a(3) g14 = psil%a(1)*psir%a(4) g23 = psil%a(2)*psir%a(3) g24 = psil%a(2)*psir%a(4) g31 = psil%a(3)*psir%a(1) g32 = psil%a(3)*psir%a(2) g41 = psil%a(4)*psir%a(1) g42 = psil%a(4)*psir%a(2) j%t = -ga * ( g14 - g23 + g32 - g41) j%x(1) = -ga * ( g13 - g24 - g31 + g42) j%x(2) = -ga * ( g13 + g24 - g31 - g42) * (0, 1) j%x(3) = -ga * ( - g14 - g23 + g32 + g41) end function a_ff @ <>= pure function vl_ff (gl, psil, psir) result (j) type(vector) :: j complex(kind=default), intent(in) :: gl type(bispinor), intent(in) :: psil, psir complex(kind=default) :: gl2 complex(kind=default) :: g31, g32, g41, g42 gl2 = 2 * gl g31 = psil%a(3)*psir%a(1) g32 = psil%a(3)*psir%a(2) g41 = psil%a(4)*psir%a(1) g42 = psil%a(4)*psir%a(2) j%t = gl2 * ( - g32 + g41) j%x(1) = gl2 * ( g31 - g42) j%x(2) = gl2 * ( g31 + g42) * (0, 1) j%x(3) = gl2 * ( - g32 - g41) end function vl_ff @ <>= pure function vr_ff (gr, psil, psir) result (j) type(vector) :: j complex(kind=default), intent(in) :: gr type(bispinor), intent(in) :: psil, psir complex(kind=default) :: gr2 complex(kind=default) :: g13, g14, g23, g24 gr2 = 2 * gr g13 = psil%a(1)*psir%a(3) g14 = psil%a(1)*psir%a(4) g23 = psil%a(2)*psir%a(3) g24 = psil%a(2)*psir%a(4) j%t = gr2 * ( g14 - g23) j%x(1) = gr2 * ( g13 - g24) j%x(2) = gr2 * ( g13 + g24) * (0, 1) j%x(3) = gr2 * ( - g14 - g23) end function vr_ff @ <>= pure function vlr_ff (gl, gr, psibar, psi) result (j) type(vector) :: j complex(kind=default), intent(in) :: gl, gr type(bispinor), intent(in) :: psibar type(bispinor), intent(in) :: psi j = va_ff (gl+gr, gl-gr, psibar, psi) end function vlr_ff @ +<>= +pure function tva_ff (gv, ga, psibar, psi) result (t) + type(tensor2odd) :: t + complex(kind=default), intent(in) :: gv, ga + type(bispinor), intent(in) :: psibar + type(bispinor), intent(in) :: psi + complex(kind=default) :: gl, gr + complex(kind=default) :: g11, g22, g33, g44, g1p2, g3p4 + gr = gv + ga + gl = gv - ga + g11 = psibar%a(1)*psi%a(1) + g22 = psibar%a(2)*psi%a(2) + g1p2 = psibar%a(1)*psi%a(2) + psibar%a(2)*psi%a(1) + g3p4 = psibar%a(3)*psi%a(4) + psibar%a(4)*psi%a(3) + g33 = psibar%a(3)*psi%a(3) + g44 = psibar%a(4)*psi%a(4) + t%e(1) = (gl * ( - g11 + g22) + gr * ( - g33 + g44)) * (0, 1) + t%e(2) = gl * ( g11 + g22) + gr * ( g33 + g44) + t%e(3) = (gl * ( g1p2 ) + gr * ( g3p4 )) * (0, 1) + t%b(1) = gl * ( g11 - g22) + gr * ( - g33 + g44) + t%b(2) = (gl * ( g11 + g22) + gr * ( - g33 - g44)) * (0, 1) + t%b(3) = gl * ( - g1p2 ) + gr * ( g3p4 ) +end function tva_ff +@ +<>= +pure function tlr_ff (gl, gr, psibar, psi) result (t) + type(tensor2odd) :: t + complex(kind=default), intent(in) :: gl, gr + type(bispinor), intent(in) :: psibar + type(bispinor), intent(in) :: psi + t = tva_ff (gr+gl, gr-gl, psibar, psi) +end function tlr_ff +@ +<>= +pure function tvam_ff (gv, ga, psibar, psi, p) result (j) + type(vector) :: j + complex(kind=default), intent(in) :: gv, ga + type(bispinor), intent(in) :: psibar + type(bispinor), intent(in) :: psi + type(momentum), intent(in) :: p + j = (tva_ff(gv, ga, psibar, psi) * p) * (0,1) +end function tvam_ff +@ +<>= +pure function tlrm_ff (gl, gr, psibar, psi, p) result (j) + type(vector) :: j + complex(kind=default), intent(in) :: gl, gr + type(bispinor), intent(in) :: psibar + type(bispinor), intent(in) :: psi + type(momentum), intent(in) :: p + j = tvam_ff (gr+gl, gr-gl, psibar, psi, p) +end function tlrm_ff +@ and \begin{equation} \fmslash{v} - \fmslash{a}\gamma_5 = \begin{pmatrix} 0 & 0 & v_- - a_- & - v^* + a^* \\ 0 & 0 & - v + a & v_+ - a_+ \\ v_+ + a_+ & v^* + a^* & 0 & 0 \\ v + a & v_- + a_- & 0 & 0 \end{pmatrix} \end{equation} with $v_\pm=v_0\pm v_3$, $a_\pm=a_0\pm a_3$, $v=v_1+\ii v_2$, $v^*=v_1-\ii v_2$, $a=a_1+\ii a_2$, and $a^*=a_1-\ii a_2$. But note that~$\cdot^*$ is \emph{not} complex conjugation for complex~$v_\mu$ or~$a_\mu$. <>= -public :: f_vaf, f_vf, f_af, f_vlf, f_vrf, f_vlrf, f_va2f +public :: f_vaf, f_vf, f_af, f_vlf, f_vrf, f_vlrf, f_va2f, & + f_tvaf, f_tlrf, f_tvamf, f_tlrmf @ <>= pure function f_vaf (gv, ga, v, psi) result (vpsi) type(bispinor) :: vpsi complex(kind=default), intent(in) :: gv, ga type(vector), intent(in) :: v type(bispinor), intent(in) :: psi complex(kind=default) :: gl, gr complex(kind=default) :: vp, vm, v12, v12s gl = gv + ga gr = gv - ga vp = v%t + v%x(3) vm = v%t - v%x(3) v12 = v%x(1) + (0,1)*v%x(2) v12s = v%x(1) - (0,1)*v%x(2) vpsi%a(1) = gr * ( vm * psi%a(3) - v12s * psi%a(4)) vpsi%a(2) = gr * ( - v12 * psi%a(3) + vp * psi%a(4)) vpsi%a(3) = gl * ( vp * psi%a(1) + v12s * psi%a(2)) vpsi%a(4) = gl * ( v12 * psi%a(1) + vm * psi%a(2)) end function f_vaf @ <>= pure function f_va2f (gva, v, psi) result (vpsi) type(bispinor) :: vpsi complex(kind=default), intent(in), dimension(2) :: gva type(vector), intent(in) :: v type(bispinor), intent(in) :: psi complex(kind=default) :: gl, gr complex(kind=default) :: vp, vm, v12, v12s gl = gva(1) + gva(2) gr = gva(1) - gva(2) vp = v%t + v%x(3) vm = v%t - v%x(3) v12 = v%x(1) + (0,1)*v%x(2) v12s = v%x(1) - (0,1)*v%x(2) vpsi%a(1) = gr * ( vm * psi%a(3) - v12s * psi%a(4)) vpsi%a(2) = gr * ( - v12 * psi%a(3) + vp * psi%a(4)) vpsi%a(3) = gl * ( vp * psi%a(1) + v12s * psi%a(2)) vpsi%a(4) = gl * ( v12 * psi%a(1) + vm * psi%a(2)) end function f_va2f @ <>= pure function f_vf (gv, v, psi) result (vpsi) type(bispinor) :: vpsi complex(kind=default), intent(in) :: gv type(vector), intent(in) :: v type(bispinor), intent(in) :: psi complex(kind=default) :: vp, vm, v12, v12s vp = v%t + v%x(3) vm = v%t - v%x(3) v12 = v%x(1) + (0,1)*v%x(2) v12s = v%x(1) - (0,1)*v%x(2) vpsi%a(1) = gv * ( vm * psi%a(3) - v12s * psi%a(4)) vpsi%a(2) = gv * ( - v12 * psi%a(3) + vp * psi%a(4)) vpsi%a(3) = gv * ( vp * psi%a(1) + v12s * psi%a(2)) vpsi%a(4) = gv * ( v12 * psi%a(1) + vm * psi%a(2)) end function f_vf @ <>= pure function f_af (ga, v, psi) result (vpsi) type(bispinor) :: vpsi complex(kind=default), intent(in) :: ga type(vector), intent(in) :: v type(bispinor), intent(in) :: psi complex(kind=default) :: vp, vm, v12, v12s vp = v%t + v%x(3) vm = v%t - v%x(3) v12 = v%x(1) + (0,1)*v%x(2) v12s = v%x(1) - (0,1)*v%x(2) vpsi%a(1) = ga * ( - vm * psi%a(3) + v12s * psi%a(4)) vpsi%a(2) = ga * ( v12 * psi%a(3) - vp * psi%a(4)) vpsi%a(3) = ga * ( vp * psi%a(1) + v12s * psi%a(2)) vpsi%a(4) = ga * ( v12 * psi%a(1) + vm * psi%a(2)) end function f_af @ <>= pure function f_vlf (gl, v, psi) result (vpsi) type(bispinor) :: vpsi complex(kind=default), intent(in) :: gl type(vector), intent(in) :: v type(bispinor), intent(in) :: psi complex(kind=default) :: gl2 complex(kind=default) :: vp, vm, v12, v12s gl2 = 2 * gl vp = v%t + v%x(3) vm = v%t - v%x(3) v12 = v%x(1) + (0,1)*v%x(2) v12s = v%x(1) - (0,1)*v%x(2) vpsi%a(1) = 0 vpsi%a(2) = 0 vpsi%a(3) = gl2 * ( vp * psi%a(1) + v12s * psi%a(2)) vpsi%a(4) = gl2 * ( v12 * psi%a(1) + vm * psi%a(2)) end function f_vlf @ <>= pure function f_vrf (gr, v, psi) result (vpsi) type(bispinor) :: vpsi complex(kind=default), intent(in) :: gr type(vector), intent(in) :: v type(bispinor), intent(in) :: psi complex(kind=default) :: gr2 complex(kind=default) :: vp, vm, v12, v12s gr2 = 2 * gr vp = v%t + v%x(3) vm = v%t - v%x(3) v12 = v%x(1) + (0,1)*v%x(2) v12s = v%x(1) - (0,1)*v%x(2) vpsi%a(1) = gr2 * ( vm * psi%a(3) - v12s * psi%a(4)) vpsi%a(2) = gr2 * ( - v12 * psi%a(3) + vp * psi%a(4)) vpsi%a(3) = 0 vpsi%a(4) = 0 end function f_vrf @ <>= pure function f_vlrf (gl, gr, v, psi) result (vpsi) type(bispinor) :: vpsi complex(kind=default), intent(in) :: gl, gr type(vector), intent(in) :: v type(bispinor), intent(in) :: psi vpsi = f_vaf (gl+gr, gl-gr, v, psi) end function f_vlrf +@ +<>= +pure function f_tvaf (gv, ga, t, psi) result (tpsi) + type(bispinor) :: tpsi + complex(kind=default), intent(in) :: gv, ga + type(tensor2odd), intent(in) :: t + type(bispinor), intent(in) :: psi + complex(kind=default) :: gl, gr + complex(kind=default) :: e21, e21s, b12, b12s, be3, be3s + gr = gv + ga + gl = gv - ga + e21 = t%e(2) + t%e(1)*(0,1) + e21s = t%e(2) - t%e(1)*(0,1) + b12 = t%b(1) + t%b(2)*(0,1) + b12s = t%b(1) - t%b(2)*(0,1) + be3 = t%b(3) + t%e(3)*(0,1) + be3s = t%b(3) - t%e(3)*(0,1) + tpsi%a(1) = 2*gl * ( psi%a(1) * be3 + psi%a(2) * ( e21 +b12s)) + tpsi%a(2) = 2*gl * ( - psi%a(2) * be3 + psi%a(1) * (-e21s+b12 )) + tpsi%a(3) = 2*gr * ( psi%a(3) * be3s + psi%a(4) * (-e21 +b12s)) + tpsi%a(4) = 2*gr * ( - psi%a(4) * be3s + psi%a(3) * ( e21s+b12 )) +end function f_tvaf +@ +<>= +pure function f_tlrf (gl, gr, t, psi) result (tpsi) + type(bispinor) :: tpsi + complex(kind=default), intent(in) :: gl, gr + type(tensor2odd), intent(in) :: t + type(bispinor), intent(in) :: psi + tpsi = f_tvaf (gr+gl, gr-gl, t, psi) +end function f_tlrf +@ +<>= +pure function f_tvamf (gv, ga, v, psi, k) result (vpsi) + type(bispinor) :: vpsi + complex(kind=default), intent(in) :: gv, ga + type(vector), intent(in) :: v + type(bispinor), intent(in) :: psi + type(momentum), intent(in) :: k + type(tensor2odd) :: t + t = (v.wedge.k) * (0, 0.5) + vpsi = f_tvaf(gv, ga, t, psi) +end function f_tvamf +@ +<>= +pure function f_tlrmf (gl, gr, v, psi, k) result (vpsi) + type(bispinor) :: vpsi + complex(kind=default), intent(in) :: gl, gr + type(vector), intent(in) :: v + type(bispinor), intent(in) :: psi + type(momentum), intent(in) :: k + vpsi = f_tvamf (gr+gl, gr-gl, v, psi, k) +end function f_tlrmf @ \subsection{Fermionic Scalar and Pseudo Scalar Couplings} <>= public :: sp_ff, s_ff, p_ff, sl_ff, sr_ff, slr_ff @ <>= pure function sp_ff (gs, gp, psil, psir) result (j) complex(kind=default) :: j complex(kind=default), intent(in) :: gs, gp type(bispinor), intent(in) :: psil, psir j = (gs - gp) * (psil%a(1)*psir%a(2) - psil%a(2)*psir%a(1)) & + (gs + gp) * (- psil%a(3)*psir%a(4) + psil%a(4)*psir%a(3)) end function sp_ff @ <>= pure function s_ff (gs, psil, psir) result (j) complex(kind=default) :: j complex(kind=default), intent(in) :: gs type(bispinor), intent(in) :: psil, psir j = gs * (psil * psir) end function s_ff @ <>= pure function p_ff (gp, psil, psir) result (j) complex(kind=default) :: j complex(kind=default), intent(in) :: gp type(bispinor), intent(in) :: psil, psir j = gp * (- psil%a(1)*psir%a(2) + psil%a(2)*psir%a(1) & - psil%a(3)*psir%a(4) + psil%a(4)*psir%a(3)) end function p_ff @ <>= pure function sl_ff (gl, psil, psir) result (j) complex(kind=default) :: j complex(kind=default), intent(in) :: gl type(bispinor), intent(in) :: psil, psir j = 2 * gl * (psil%a(1)*psir%a(2) - psil%a(2)*psir%a(1)) end function sl_ff @ <>= pure function sr_ff (gr, psil, psir) result (j) complex(kind=default) :: j complex(kind=default), intent(in) :: gr type(bispinor), intent(in) :: psil, psir j = 2 * gr * (- psil%a(3)*psir%a(4) + psil%a(4)*psir%a(3)) end function sr_ff @ <>= pure function slr_ff (gl, gr, psibar, psi) result (j) complex(kind=default) :: j complex(kind=default), intent(in) :: gl, gr type(bispinor), intent(in) :: psibar type(bispinor), intent(in) :: psi j = sp_ff (gr+gl, gr-gl, psibar, psi) end function slr_ff @ <>= public :: f_spf, f_sf, f_pf, f_slf, f_srf, f_slrf @ <>= pure function f_spf (gs, gp, phi, psi) result (phipsi) type(bispinor) :: phipsi complex(kind=default), intent(in) :: gs, gp complex(kind=default), intent(in) :: phi type(bispinor), intent(in) :: psi phipsi%a(1:2) = ((gs - gp) * phi) * psi%a(1:2) phipsi%a(3:4) = ((gs + gp) * phi) * psi%a(3:4) end function f_spf @ <>= pure function f_sf (gs, phi, psi) result (phipsi) type(bispinor) :: phipsi complex(kind=default), intent(in) :: gs complex(kind=default), intent(in) :: phi type(bispinor), intent(in) :: psi phipsi%a = (gs * phi) * psi%a end function f_sf @ <>= pure function f_pf (gp, phi, psi) result (phipsi) type(bispinor) :: phipsi complex(kind=default), intent(in) :: gp complex(kind=default), intent(in) :: phi type(bispinor), intent(in) :: psi phipsi%a(1:2) = (- gp * phi) * psi%a(1:2) phipsi%a(3:4) = ( gp * phi) * psi%a(3:4) end function f_pf @ <>= pure function f_slf (gl, phi, psi) result (phipsi) type(bispinor) :: phipsi complex(kind=default), intent(in) :: gl complex(kind=default), intent(in) :: phi type(bispinor), intent(in) :: psi phipsi%a(1:2) = (2 * gl * phi) * psi%a(1:2) phipsi%a(3:4) = 0 end function f_slf @ <>= pure function f_srf (gr, phi, psi) result (phipsi) type(bispinor) :: phipsi complex(kind=default), intent(in) :: gr complex(kind=default), intent(in) :: phi type(bispinor), intent(in) :: psi phipsi%a(1:2) = 0 phipsi%a(3:4) = (2 * gr * phi) * psi%a(3:4) end function f_srf @ <>= pure function f_slrf (gl, gr, phi, psi) result (phipsi) type(bispinor) :: phipsi complex(kind=default), intent(in) :: gl, gr complex(kind=default), intent(in) :: phi type(bispinor), intent(in) :: psi phipsi = f_spf (gr+gl, gr-gl, phi, psi) end function f_slrf @ \subsection{Couplings for BRST Transformations} \subsubsection{3-Couplings} The lists of needed gamma matrices can be found in the next subsection with the gravitino couplings. <>= private :: vv_ff, f_vvf @ <>= public :: vmom_ff, mom_ff, mom5_ff, moml_ff, momr_ff, lmom_ff, rmom_ff @ <>= pure function vv_ff (psibar, psi, k) result (psibarpsi) type(vector) :: psibarpsi type(bispinor), intent(in) :: psibar, psi type(vector), intent(in) :: k complex(kind=default) :: kp, km, k12, k12s type(bispinor) :: kgpsi1, kgpsi2, kgpsi3, kgpsi4 kp = k%t + k%x(3) km = k%t - k%x(3) k12 = k%x(1) + (0,1)*k%x(2) k12s = k%x(1) - (0,1)*k%x(2) kgpsi1%a(1) = -k%x(3) * psi%a(1) - k12s * psi%a(2) kgpsi1%a(2) = -k12 * psi%a(1) + k%x(3) * psi%a(2) kgpsi1%a(3) = k%x(3) * psi%a(3) + k12s * psi%a(4) kgpsi1%a(4) = k12 * psi%a(3) - k%x(3) * psi%a(4) kgpsi2%a(1) = ((0,-1) * k%x(2)) * psi%a(1) - km * psi%a(2) kgpsi2%a(2) = - kp * psi%a(1) + ((0,1) * k%x(2)) * psi%a(2) kgpsi2%a(3) = ((0,-1) * k%x(2)) * psi%a(3) + kp * psi%a(4) kgpsi2%a(4) = km * psi%a(3) + ((0,1) * k%x(2)) * psi%a(4) kgpsi3%a(1) = (0,1) * (k%x(1) * psi%a(1) + km * psi%a(2)) kgpsi3%a(2) = (0,-1) * (kp * psi%a(1) + k%x(1) * psi%a(2)) kgpsi3%a(3) = (0,1) * (k%x(1) * psi%a(3) - kp * psi%a(4)) kgpsi3%a(4) = (0,1) * (km * psi%a(3) - k%x(1) * psi%a(4)) kgpsi4%a(1) = -k%t * psi%a(1) - k12s * psi%a(2) kgpsi4%a(2) = k12 * psi%a(1) + k%t * psi%a(2) kgpsi4%a(3) = k%t * psi%a(3) - k12s * psi%a(4) kgpsi4%a(4) = k12 * psi%a(3) - k%t * psi%a(4) psibarpsi%t = 2 * (psibar * kgpsi1) psibarpsi%x(1) = 2 * (psibar * kgpsi2) psibarpsi%x(2) = 2 * (psibar * kgpsi3) psibarpsi%x(3) = 2 * (psibar * kgpsi4) end function vv_ff @ <>= pure function f_vvf (v, psi, k) result (kvpsi) type(bispinor) :: kvpsi type(bispinor), intent(in) :: psi type(vector), intent(in) :: k, v complex(kind=default) :: kv30, kv21, kv01, kv31, kv02, kv32 complex(kind=default) :: ap, am, bp, bm, bps, bms kv30 = k%x(3) * v%t - k%t * v%x(3) kv21 = (0,1) * (k%x(2) * v%x(1) - k%x(1) * v%x(2)) kv01 = k%t * v%x(1) - k%x(1) * v%t kv31 = k%x(3) * v%x(1) - k%x(1) * v%x(3) kv02 = (0,1) * (k%t * v%x(2) - k%x(2) * v%t) kv32 = (0,1) * (k%x(3) * v%x(2) - k%x(2) * v%x(3)) ap = 2 * (kv30 + kv21) am = 2 * (-kv30 + kv21) bp = 2 * (kv01 + kv31 + kv02 + kv32) bm = 2 * (kv01 - kv31 + kv02 - kv32) bps = 2 * (kv01 + kv31 - kv02 - kv32) bms = 2 * (kv01 - kv31 - kv02 + kv32) kvpsi%a(1) = am * psi%a(1) + bms * psi%a(2) kvpsi%a(2) = bp * psi%a(1) - am * psi%a(2) kvpsi%a(3) = ap * psi%a(3) - bps * psi%a(4) kvpsi%a(4) = -bm * psi%a(3) - ap * psi%a(4) end function f_vvf @ <>= pure function vmom_ff (g, psibar, psi, k) result (psibarpsi) type(vector) :: psibarpsi complex(kind=default), intent(in) :: g type(bispinor), intent(in) :: psibar, psi type(momentum), intent(in) :: k type(vector) :: vk vk = k psibarpsi = g * vv_ff (psibar, psi, vk) end function vmom_ff @ <>= pure function mom_ff (g, m, psibar, psi, k) result (psibarpsi) complex(kind=default) :: psibarpsi type(bispinor), intent(in) :: psibar, psi type(momentum), intent(in) :: k complex(kind=default), intent(in) :: g, m type(bispinor) :: kmpsi complex(kind=default) :: kp, km, k12, k12s kp = k%t + k%x(3) km = k%t - k%x(3) k12 = k%x(1) + (0,1)*k%x(2) k12s = k%x(1) - (0,1)*k%x(2) kmpsi%a(1) = km * psi%a(3) - k12s * psi%a(4) kmpsi%a(2) = kp * psi%a(4) - k12 * psi%a(3) kmpsi%a(3) = kp * psi%a(1) + k12s * psi%a(2) kmpsi%a(4) = k12 * psi%a(1) + km * psi%a(2) psibarpsi = g * (psibar * kmpsi) + s_ff (m, psibar, psi) end function mom_ff @ <>= pure function mom5_ff (g, m, psibar, psi, k) result (psibarpsi) complex(kind=default) :: psibarpsi type(bispinor), intent(in) :: psibar, psi type(momentum), intent(in) :: k complex(kind=default), intent(in) :: g, m type(bispinor) :: g5psi g5psi%a(1:2) = - psi%a(1:2) g5psi%a(3:4) = psi%a(3:4) psibarpsi = mom_ff (g, m, psibar, g5psi, k) end function mom5_ff @ <>= pure function moml_ff (g, m, psibar, psi, k) result (psibarpsi) complex(kind=default) :: psibarpsi type(bispinor), intent(in) :: psibar, psi type(momentum), intent(in) :: k complex(kind=default), intent(in) :: g, m type(bispinor) :: leftpsi leftpsi%a(1:2) = 2 * psi%a(1:2) leftpsi%a(3:4) = 0 psibarpsi = mom_ff (g, m, psibar, leftpsi, k) end function moml_ff @ <>= pure function momr_ff (g, m, psibar, psi, k) result (psibarpsi) complex(kind=default) :: psibarpsi type(bispinor), intent(in) :: psibar, psi type(momentum), intent(in) :: k complex(kind=default), intent(in) :: g, m type(bispinor) :: rightpsi rightpsi%a(1:2) = 0 rightpsi%a(3:4) = 2 * psi%a(3:4) psibarpsi = mom_ff (g, m, psibar, rightpsi, k) end function momr_ff @ <>= pure function lmom_ff (g, m, psibar, psi, k) result (psibarpsi) complex(kind=default) :: psibarpsi type(bispinor), intent(in) :: psibar, psi type(momentum), intent(in) :: k complex(kind=default), intent(in) :: g, m psibarpsi = mom_ff (g, m, psibar, psi, k) + & mom5_ff (g,-m, psibar, psi, k) end function lmom_ff @ <>= pure function rmom_ff (g, m, psibar, psi, k) result (psibarpsi) complex(kind=default) :: psibarpsi type(bispinor), intent(in) :: psibar, psi type(momentum), intent(in) :: k complex(kind=default), intent(in) :: g, m psibarpsi = mom_ff (g, m, psibar, psi, k) - & mom5_ff (g,-m, psibar, psi, k) end function rmom_ff @ <>= public :: f_vmomf, f_momf, f_mom5f, f_momlf, f_momrf, f_lmomf, f_rmomf @ <>= pure function f_vmomf (g, v, psi, k) result (kvpsi) type(bispinor) :: kvpsi type(bispinor), intent(in) :: psi complex(kind=default), intent(in) :: g type(momentum), intent(in) :: k type(vector), intent(in) :: v type(vector) :: vk vk = k kvpsi = g * f_vvf (v, psi, vk) end function f_vmomf @ <>= pure function f_momf (g, m, phi, psi, k) result (kmpsi) type(bispinor) :: kmpsi type(bispinor), intent(in) :: psi complex(kind=default), intent(in) :: phi, g, m type(momentum), intent(in) :: k complex(kind=default) :: kp, km, k12, k12s kp = k%t + k%x(3) km = k%t - k%x(3) k12 = k%x(1) + (0,1)*k%x(2) k12s = k%x(1) - (0,1)*k%x(2) kmpsi%a(1) = km * psi%a(3) - k12s * psi%a(4) kmpsi%a(2) = -k12 * psi%a(3) + kp * psi%a(4) kmpsi%a(3) = kp * psi%a(1) + k12s * psi%a(2) kmpsi%a(4) = k12 * psi%a(1) + km * psi%a(2) kmpsi = g * (phi * kmpsi) + f_sf (m, phi, psi) end function f_momf @ <>= pure function f_mom5f (g, m, phi, psi, k) result (kmpsi) type(bispinor) :: kmpsi type(bispinor), intent(in) :: psi complex(kind=default), intent(in) :: phi, g, m type(momentum), intent(in) :: k type(bispinor) :: g5psi g5psi%a(1:2) = - psi%a(1:2) g5psi%a(3:4) = psi%a(3:4) kmpsi = f_momf (g, m, phi, g5psi, k) end function f_mom5f @ <>= pure function f_momlf (g, m, phi, psi, k) result (kmpsi) type(bispinor) :: kmpsi type(bispinor), intent(in) :: psi complex(kind=default), intent(in) :: phi, g, m type(momentum), intent(in) :: k type(bispinor) :: leftpsi leftpsi%a(1:2) = 2 * psi%a(1:2) leftpsi%a(3:4) = 0 kmpsi = f_momf (g, m, phi, leftpsi, k) end function f_momlf @ <>= pure function f_momrf (g, m, phi, psi, k) result (kmpsi) type(bispinor) :: kmpsi type(bispinor), intent(in) :: psi complex(kind=default), intent(in) :: phi, g, m type(momentum), intent(in) :: k type(bispinor) :: rightpsi rightpsi%a(1:2) = 0 rightpsi%a(3:4) = 2 * psi%a(3:4) kmpsi = f_momf (g, m, phi, rightpsi, k) end function f_momrf @ <>= pure function f_lmomf (g, m, phi, psi, k) result (kmpsi) type(bispinor) :: kmpsi type(bispinor), intent(in) :: psi complex(kind=default), intent(in) :: phi, g, m type(momentum), intent(in) :: k kmpsi = f_momf (g, m, phi, psi, k) + & f_mom5f (g,-m, phi, psi, k) end function f_lmomf @ <>= pure function f_rmomf (g, m, phi, psi, k) result (kmpsi) type(bispinor) :: kmpsi type(bispinor), intent(in) :: psi complex(kind=default), intent(in) :: phi, g, m type(momentum), intent(in) :: k kmpsi = f_momf (g, m, phi, psi, k) - & f_mom5f (g,-m, phi, psi, k) end function f_rmomf @ \subsubsection{4-Couplings} <>= public :: v2_ff, sv1_ff, sv2_ff, pv1_ff, pv2_ff, svl1_ff, svl2_ff, & svr1_ff, svr2_ff, svlr1_ff, svlr2_ff @ <>= pure function v2_ff (g, psibar, v, psi) result (v2) type(vector) :: v2 complex (kind=default), intent(in) :: g type(bispinor), intent(in) :: psibar, psi type(vector), intent(in) :: v v2 = (-g) * vv_ff (psibar, psi, v) end function v2_ff @ <>= pure function sv1_ff (g, psibar, v, psi) result (phi) complex(kind=default) :: phi type(bispinor), intent(in) :: psibar, psi type(vector), intent(in) :: v complex(kind=default), intent(in) :: g phi = psibar * f_vf (g, v, psi) end function sv1_ff @ <>= pure function sv2_ff (g, psibar, phi, psi) result (v) type(vector) :: v complex(kind=default), intent(in) :: phi, g type(bispinor), intent(in) :: psibar, psi v = phi * v_ff (g, psibar, psi) end function sv2_ff @ <>= pure function pv1_ff (g, psibar, v, psi) result (phi) complex(kind=default) :: phi type(bispinor), intent(in) :: psibar, psi type(vector), intent(in) :: v complex(kind=default), intent(in) :: g phi = - (psibar * f_af (g, v, psi)) end function pv1_ff @ <>= pure function pv2_ff (g, psibar, phi, psi) result (v) type(vector) :: v complex(kind=default), intent(in) :: phi, g type(bispinor), intent(in) :: psibar, psi v = -(phi * a_ff (g, psibar, psi)) end function pv2_ff @ <>= pure function svl1_ff (g, psibar, v, psi) result (phi) complex(kind=default) :: phi type(bispinor), intent(in) :: psibar, psi type(vector), intent(in) :: v complex(kind=default), intent(in) :: g phi = psibar * f_vlf (g, v, psi) end function svl1_ff @ <>= pure function svl2_ff (g, psibar, phi, psi) result (v) type(vector) :: v complex(kind=default), intent(in) :: phi, g type(bispinor), intent(in) :: psibar, psi v = phi * vl_ff (g, psibar, psi) end function svl2_ff @ <>= pure function svr1_ff (g, psibar, v, psi) result (phi) complex(kind=default) :: phi type(bispinor), intent(in) :: psibar, psi type(vector), intent(in) :: v complex(kind=default), intent(in) :: g phi = psibar * f_vrf (g, v, psi) end function svr1_ff @ <>= pure function svr2_ff (g, psibar, phi, psi) result (v) type(vector) :: v complex(kind=default), intent(in) :: phi, g type(bispinor), intent(in) :: psibar, psi v = phi * vr_ff (g, psibar, psi) end function svr2_ff @ <>= pure function svlr1_ff (gl, gr, psibar, v, psi) result (phi) complex(kind=default) :: phi type(bispinor), intent(in) :: psibar, psi type(vector), intent(in) :: v complex(kind=default), intent(in) :: gl, gr phi = psibar * f_vlrf (gl, gr, v, psi) end function svlr1_ff @ <>= pure function svlr2_ff (gl, gr, psibar, phi, psi) result (v) type(vector) :: v complex(kind=default), intent(in) :: phi, gl, gr type(bispinor), intent(in) :: psibar, psi v = phi * vlr_ff (gl, gr, psibar, psi) end function svlr2_ff @ <>= public :: f_v2f, f_svf, f_pvf, f_svlf, f_svrf, f_svlrf @ <>= pure function f_v2f (g, v1, v2, psi) result (vpsi) type(bispinor) :: vpsi complex(kind=default), intent(in) :: g type(bispinor), intent(in) :: psi type(vector), intent(in) :: v1, v2 vpsi = g * f_vvf (v2, psi, v1) end function f_v2f @ <>= pure function f_svf (g, phi, v, psi) result (pvpsi) type(bispinor) :: pvpsi complex(kind=default), intent(in) :: g, phi type(bispinor), intent(in) :: psi type(vector), intent(in) :: v pvpsi = phi * f_vf (g, v, psi) end function f_svf @ <>= pure function f_pvf (g, phi, v, psi) result (pvpsi) type(bispinor) :: pvpsi complex(kind=default), intent(in) :: g, phi type(bispinor), intent(in) :: psi type(vector), intent(in) :: v pvpsi = -(phi * f_af (g, v, psi)) end function f_pvf @ <>= pure function f_svlf (g, phi, v, psi) result (pvpsi) type(bispinor) :: pvpsi complex(kind=default), intent(in) :: g, phi type(bispinor), intent(in) :: psi type(vector), intent(in) :: v pvpsi = phi * f_vlf (g, v, psi) end function f_svlf @ <>= pure function f_svrf (g, phi, v, psi) result (pvpsi) type(bispinor) :: pvpsi complex(kind=default), intent(in) :: g, phi type(bispinor), intent(in) :: psi type(vector), intent(in) :: v pvpsi = phi * f_vrf (g, v, psi) end function f_svrf @ <>= pure function f_svlrf (gl, gr, phi, v, psi) result (pvpsi) type(bispinor) :: pvpsi complex(kind=default), intent(in) :: gl, gr, phi type(bispinor), intent(in) :: psi type(vector), intent(in) :: v pvpsi = phi * f_vlrf (gl, gr, v, psi) end function f_svlrf @ \subsection{Gravitino Couplings} <>= public :: pot_grf, pot_fgr, s_grf, s_fgr, p_grf, p_fgr, & sl_grf, sl_fgr, sr_grf, sr_fgr, slr_grf, slr_fgr @ <>= private :: fgvgr, fgvg5gr, fggvvgr, grkgf, grkggf, grkkggf, & fgkgr, fg5gkgr, grvgf, grg5vgf, grkgggf, fggkggr @ <>= pure function pot_grf (g, gravbar, psi) result (j) complex(kind=default) :: j complex(kind=default), intent(in) :: g type(vectorspinor), intent(in) :: gravbar type(bispinor), intent(in) :: psi type(vectorspinor) :: gamma_psi gamma_psi%psi(1)%a(1) = psi%a(3) gamma_psi%psi(1)%a(2) = psi%a(4) gamma_psi%psi(1)%a(3) = psi%a(1) gamma_psi%psi(1)%a(4) = psi%a(2) gamma_psi%psi(2)%a(1) = psi%a(4) gamma_psi%psi(2)%a(2) = psi%a(3) gamma_psi%psi(2)%a(3) = - psi%a(2) gamma_psi%psi(2)%a(4) = - psi%a(1) gamma_psi%psi(3)%a(1) = (0,-1) * psi%a(4) gamma_psi%psi(3)%a(2) = (0,1) * psi%a(3) gamma_psi%psi(3)%a(3) = (0,1) * psi%a(2) gamma_psi%psi(3)%a(4) = (0,-1) * psi%a(1) gamma_psi%psi(4)%a(1) = psi%a(3) gamma_psi%psi(4)%a(2) = - psi%a(4) gamma_psi%psi(4)%a(3) = - psi%a(1) gamma_psi%psi(4)%a(4) = psi%a(2) j = g * (gravbar * gamma_psi) end function pot_grf @ <>= pure function pot_fgr (g, psibar, grav) result (j) complex(kind=default) :: j complex(kind=default), intent(in) :: g type(bispinor), intent(in) :: psibar type(vectorspinor), intent(in) :: grav type(bispinor) :: gamma_grav gamma_grav%a(1) = grav%psi(1)%a(3) - grav%psi(2)%a(4) + & ((0,1)*grav%psi(3)%a(4)) - grav%psi(4)%a(3) gamma_grav%a(2) = grav%psi(1)%a(4) - grav%psi(2)%a(3) - & ((0,1)*grav%psi(3)%a(3)) + grav%psi(4)%a(4) gamma_grav%a(3) = grav%psi(1)%a(1) + grav%psi(2)%a(2) - & ((0,1)*grav%psi(3)%a(2)) + grav%psi(4)%a(1) gamma_grav%a(4) = grav%psi(1)%a(2) + grav%psi(2)%a(1) + & ((0,1)*grav%psi(3)%a(1)) - grav%psi(4)%a(2) j = g * (psibar * gamma_grav) end function pot_fgr @ <>= pure function grvgf (gravbar, psi, k) result (j) complex(kind=default) :: j complex(kind=default) :: kp, km, k12, k12s type(vectorspinor), intent(in) :: gravbar type(bispinor), intent(in) :: psi type(vector), intent(in) :: k type(vectorspinor) :: kg_psi kp = k%t + k%x(3) km = k%t - k%x(3) k12 = k%x(1) + (0,1)*k%x(2) k12s = k%x(1) - (0,1)*k%x(2) !!! Since we are taking the spinor product here, NO explicit !!! charge conjugation matrix is needed! kg_psi%psi(1)%a(1) = km * psi%a(1) - k12s * psi%a(2) kg_psi%psi(1)%a(2) = (-k12) * psi%a(1) + kp * psi%a(2) kg_psi%psi(1)%a(3) = kp * psi%a(3) + k12s * psi%a(4) kg_psi%psi(1)%a(4) = k12 * psi%a(3) + km * psi%a(4) kg_psi%psi(2)%a(1) = k12s * psi%a(1) - km * psi%a(2) kg_psi%psi(2)%a(2) = (-kp) * psi%a(1) + k12 * psi%a(2) kg_psi%psi(2)%a(3) = k12s * psi%a(3) + kp * psi%a(4) kg_psi%psi(2)%a(4) = km * psi%a(3) + k12 * psi%a(4) kg_psi%psi(3)%a(1) = (0,1) * (k12s * psi%a(1) + km * psi%a(2)) kg_psi%psi(3)%a(2) = (0,1) * (- kp * psi%a(1) - k12 * psi%a(2)) kg_psi%psi(3)%a(3) = (0,1) * (k12s * psi%a(3) - kp * psi%a(4)) kg_psi%psi(3)%a(4) = (0,1) * (km * psi%a(3) - k12 * psi%a(4)) kg_psi%psi(4)%a(1) = (-km) * psi%a(1) - k12s * psi%a(2) kg_psi%psi(4)%a(2) = k12 * psi%a(1) + kp * psi%a(2) kg_psi%psi(4)%a(3) = kp * psi%a(3) - k12s * psi%a(4) kg_psi%psi(4)%a(4) = k12 * psi%a(3) - km * psi%a(4) j = gravbar * kg_psi end function grvgf @ <>= pure function grg5vgf (gravbar, psi, k) result (j) complex(kind=default) :: j type(vectorspinor), intent(in) :: gravbar type(bispinor), intent(in) :: psi type(vector), intent(in) :: k type(bispinor) :: g5_psi g5_psi%a(1:2) = - psi%a(1:2) g5_psi%a(3:4) = psi%a(3:4) j = grvgf (gravbar, g5_psi, k) end function grg5vgf @ <>= pure function s_grf (g, gravbar, psi, k) result (j) complex(kind=default) :: j complex(kind=default), intent(in) :: g type(vectorspinor), intent(in) :: gravbar type(bispinor), intent(in) :: psi type(momentum), intent(in) :: k type(vector) :: vk vk = k j = g * grvgf (gravbar, psi, vk) end function s_grf @ <>= pure function sl_grf (gl, gravbar, psi, k) result (j) complex(kind=default) :: j complex(kind=default), intent(in) :: gl type(vectorspinor), intent(in) :: gravbar type(bispinor), intent(in) :: psi type(bispinor) :: psi_l type(momentum), intent(in) :: k psi_l%a(1:2) = psi%a(1:2) psi_l%a(3:4) = 0 j = s_grf (gl, gravbar, psi_l, k) end function sl_grf @ <>= pure function sr_grf (gr, gravbar, psi, k) result (j) complex(kind=default) :: j complex(kind=default), intent(in) :: gr type(vectorspinor), intent(in) :: gravbar type(bispinor), intent(in) :: psi type(bispinor) :: psi_r type(momentum), intent(in) :: k psi_r%a(1:2) = 0 psi_r%a(3:4) = psi%a(3:4) j = s_grf (gr, gravbar, psi_r, k) end function sr_grf @ <>= pure function slr_grf (gl, gr, gravbar, psi, k) result (j) complex(kind=default) :: j complex(kind=default), intent(in) :: gl, gr type(vectorspinor), intent(in) :: gravbar type(bispinor), intent(in) :: psi type(momentum), intent(in) :: k j = sl_grf (gl, gravbar, psi, k) + sr_grf (gr, gravbar, psi, k) end function slr_grf @ <>= pure function fgkgr (psibar, grav, k) result (j) complex(kind=default) :: j complex(kind=default) :: kp, km, k12, k12s type(bispinor), intent(in) :: psibar type(vectorspinor), intent(in) :: grav type(vector), intent(in) :: k type(bispinor) :: gk_grav kp = k%t + k%x(3) km = k%t - k%x(3) k12 = k%x(1) + (0,1)*k%x(2) k12s = k%x(1) - (0,1)*k%x(2) !!! Since we are taking the spinor product here, NO explicit !!! charge conjugation matrix is needed! gk_grav%a(1) = kp * grav%psi(1)%a(1) + k12s * grav%psi(1)%a(2) & - k12 * grav%psi(2)%a(1) - km * grav%psi(2)%a(2) & + (0,1) * k12 * grav%psi(3)%a(1) & + (0,1) * km * grav%psi(3)%a(2) & - kp * grav%psi(4)%a(1) - k12s * grav%psi(4)%a(2) gk_grav%a(2) = k12 * grav%psi(1)%a(1) + km * grav%psi(1)%a(2) & - kp * grav%psi(2)%a(1) - k12s * grav%psi(2)%a(2) & - (0,1) * kp * grav%psi(3)%a(1) & - (0,1) * k12s * grav%psi(3)%a(2) & + k12 * grav%psi(4)%a(1) + km * grav%psi(4)%a(2) gk_grav%a(3) = km * grav%psi(1)%a(3) - k12s * grav%psi(1)%a(4) & - k12 * grav%psi(2)%a(3) + kp * grav%psi(2)%a(4) & + (0,1) * k12 * grav%psi(3)%a(3) & - (0,1) * kp * grav%psi(3)%a(4) & + km * grav%psi(4)%a(3) - k12s * grav%psi(4)%a(4) gk_grav%a(4) = - k12 * grav%psi(1)%a(3) + kp * grav%psi(1)%a(4) & + km * grav%psi(2)%a(3) - k12s * grav%psi(2)%a(4) & + (0,1) * km * grav%psi(3)%a(3) & - (0,1) * k12s * grav%psi(3)%a(4) & + k12 * grav%psi(4)%a(3) - kp * grav%psi(4)%a(4) j = psibar * gk_grav end function fgkgr @ <>= pure function fg5gkgr (psibar, grav, k) result (j) complex(kind=default) :: j type(bispinor), intent(in) :: psibar type(vectorspinor), intent(in) :: grav type(vector), intent(in) :: k type(bispinor) :: psibar_g5 psibar_g5%a(1:2) = - psibar%a(1:2) psibar_g5%a(3:4) = psibar%a(3:4) j = fgkgr (psibar_g5, grav, k) end function fg5gkgr @ <>= pure function s_fgr (g, psibar, grav, k) result (j) complex(kind=default) :: j complex(kind=default), intent(in) :: g type(bispinor), intent(in) :: psibar type(vectorspinor), intent(in) :: grav type(momentum), intent(in) :: k type(vector) :: vk vk = k j = g * fgkgr (psibar, grav, vk) end function s_fgr @ <>= pure function sl_fgr (gl, psibar, grav, k) result (j) complex(kind=default) :: j complex(kind=default), intent(in) :: gl type(bispinor), intent(in) :: psibar type(bispinor) :: psibar_l type(vectorspinor), intent(in) :: grav type(momentum), intent(in) :: k psibar_l%a(1:2) = psibar%a(1:2) psibar_l%a(3:4) = 0 j = s_fgr (gl, psibar_l, grav, k) end function sl_fgr @ <>= pure function sr_fgr (gr, psibar, grav, k) result (j) complex(kind=default) :: j complex(kind=default), intent(in) :: gr type(bispinor), intent(in) :: psibar type(bispinor) :: psibar_r type(vectorspinor), intent(in) :: grav type(momentum), intent(in) :: k psibar_r%a(1:2) = 0 psibar_r%a(3:4) = psibar%a(3:4) j = s_fgr (gr, psibar_r, grav, k) end function sr_fgr @ @ <>= pure function slr_fgr (gl, gr, psibar, grav, k) result (j) complex(kind=default) :: j complex(kind=default), intent(in) :: gl, gr type(bispinor), intent(in) :: psibar type(vectorspinor), intent(in) :: grav type(momentum), intent(in) :: k j = sl_fgr (gl, psibar, grav, k) + sr_fgr (gr, psibar, grav, k) end function slr_fgr @ <>= pure function p_grf (g, gravbar, psi, k) result (j) complex(kind=default) :: j complex(kind=default), intent(in) :: g type(vectorspinor), intent(in) :: gravbar type(bispinor), intent(in) :: psi type(momentum), intent(in) :: k type(vector) :: vk vk = k j = g * grg5vgf (gravbar, psi, vk) end function p_grf @ <>= pure function p_fgr (g, psibar, grav, k) result (j) complex(kind=default) :: j complex(kind=default), intent(in) :: g type(bispinor), intent(in) :: psibar type(vectorspinor), intent(in) :: grav type(momentum), intent(in) :: k type(vector) :: vk vk = k j = g * fg5gkgr (psibar, grav, vk) end function p_fgr @ <>= public :: f_potgr, f_sgr, f_pgr, f_vgr, f_vlrgr, f_slgr, f_srgr, f_slrgr @ <>= pure function f_potgr (g, phi, psi) result (phipsi) type(bispinor) :: phipsi complex(kind=default), intent(in) :: g complex(kind=default), intent(in) :: phi type(vectorspinor), intent(in) :: psi phipsi%a(1) = (g * phi) * (psi%psi(1)%a(3) - psi%psi(2)%a(4) + & ((0,1)*psi%psi(3)%a(4)) - psi%psi(4)%a(3)) phipsi%a(2) = (g * phi) * (psi%psi(1)%a(4) - psi%psi(2)%a(3) - & ((0,1)*psi%psi(3)%a(3)) + psi%psi(4)%a(4)) phipsi%a(3) = (g * phi) * (psi%psi(1)%a(1) + psi%psi(2)%a(2) - & ((0,1)*psi%psi(3)%a(2)) + psi%psi(4)%a(1)) phipsi%a(4) = (g * phi) * (psi%psi(1)%a(2) + psi%psi(2)%a(1) + & ((0,1)*psi%psi(3)%a(1)) - psi%psi(4)%a(2)) end function f_potgr @ The slashed notation: \begin{equation} \fmslash{k} = \begin{pmatrix} 0 & 0 & k_- & - k^* \\ 0 & 0 & - k & k_+ \\ k_+ & k^* & 0 & 0 \\ k & k_- & 0 & 0 \end{pmatrix} , \qquad \fmslash{k}\gamma_5 = \begin{pmatrix} 0 & 0 & k_- & - k^* \\ 0 & 0 & - k & k_+ \\ - k_+ & - k^* & 0 & 0 \\ - k & - k_- & 0 & 0 \end{pmatrix} \end{equation} with $k_\pm=k_0\pm k_3$, $k=k_1+\ii k_2$, $k^*=k_1-\ii k_2$. But note that~$\cdot^*$ is \emph{not} complex conjugation for complex~$k_\mu$. \begin{subequations} \begin{alignat}{2} \gamma^0 \fmslash{k} &= \begin{pmatrix} k_+ & k^* & 0 & 0 \\ k & k_- & 0 & 0 \\ 0 & 0 & k_- & - k^* \\ 0 & 0 & - k & k_+ \end{pmatrix} , & \qquad \gamma^0 \fmslash{k} \gamma^5 & = \begin{pmatrix} - k_+ & - k^* & 0 & 0 \\ - k & - k_- & 0 & 0 \\ 0 & 0 & k_- & - k^* \\ 0 & 0 & - k & k_+ \end{pmatrix} \\ \gamma^1 \fmslash{k} &= \begin{pmatrix} k & k_- & 0 & 0 \\ k_+ & k^* & 0 & 0 \\ 0 & 0 & k & - k_+ \\ 0 & 0 & - k_- & k^* \end{pmatrix}, & \qquad \gamma^1 \fmslash{k} \gamma^5 & = \begin{pmatrix} - k & - k_- & 0 & 0 \\ - k_+ & - k^* & 0 & 0 \\ 0 & 0 & k & - k_+ \\ 0 & 0 & - k_- & k^* \end{pmatrix} \\ \gamma^2 \fmslash{k} &= \begin{pmatrix} - \ii k & - \ii k_- & 0 & 0 \\ \ii k_+ & \ii k^* & 0 & 0 \\ 0 & 0 & - \ii k & \ii k_+ \\ 0 & 0 & - \ii k_- & \ii k^* \end{pmatrix}, & \qquad \gamma^2 \fmslash{k} \gamma^5 & = \begin{pmatrix} \ii k & \ii k_- & 0 & 0 \\ - \ii k_+ & - \ii k^* & 0 & 0 \\ 0 & 0 & - \ii k & \ii k_+ \\ 0 & 0 & - \ii k_- & \ii k^* \end{pmatrix} \\ \gamma^3 \fmslash{k} &= \begin{pmatrix} k_+ & k^* & 0 & 0 \\ - k & - k_- & 0 & 0 \\ 0 & 0 & - k_- & k^* \\ 0 & 0 & - k & k_+ \end{pmatrix}, & \qquad \gamma^3 \fmslash{k} \gamma^5 & = \begin{pmatrix} - k_+ & - k^* & 0 & 0 \\ k & k_- & 0 & 0 \\ 0 & 0 & - k_- & k^* \\ 0 & 0 & - k & k_+ \end{pmatrix} \end{alignat} \end{subequations} and \begin{subequations} \begin{alignat}{2} \fmslash{k} \gamma^0&= \begin{pmatrix} k_- & - k^* & 0 & 0 \\ - k & k_+ & 0 & 0 \\ 0 & 0 & k_+ & k^* \\ 0 & 0 & k & k_- \end{pmatrix} , & \qquad \fmslash{k} \gamma^0 \gamma^5 & = \begin{pmatrix} - k_- & k^* & 0 & 0 \\ k & - k_+ & 0 & 0 \\ 0 & 0 & k_+ & k^* \\ 0 & 0 & k & k_- \end{pmatrix} \\ \fmslash{k} \gamma^1 &= \begin{pmatrix} k^* & - k_- & 0 & 0 \\ - k_+ & k & 0 & 0 \\ 0 & 0 & k^* & k_+ \\ 0 & 0 & k_- & k \end{pmatrix}, & \qquad \fmslash{k} \gamma^1 \gamma^5 & = \begin{pmatrix} - k^* & k_- & 0 & 0 \\ k_+ & - k & 0 & 0 \\ 0 & 0 & k^* & k_+ \\ 0 & 0 & k_- & k \end{pmatrix} \\ \fmslash{k} \gamma^2 &= \begin{pmatrix} \ii k^* & \ii k_- & 0 & 0 \\ - \ii k_+ & - \ii k & 0 & 0 \\ 0 & 0 & \ii k^* & - \ii k_+ \\ 0 & 0 & \ii k_- & - \ii k \end{pmatrix}, & \qquad \fmslash{k} \gamma^2 \gamma^5 & = \begin{pmatrix} - \ii k^* & - \ii k_- & 0 & 0 \\ \ii k_+ & \ii k & 0 & 0 \\ 0 & 0 & \ii k^* & - \ii k_+ \\ 0 & 0 & \ii k_- & - \ii k \end{pmatrix} \\ \fmslash{k} \gamma^3 &= \begin{pmatrix} - k_- & - k^* & 0 & 0 \\ k & k_+ & 0 & 0 \\ 0 & 0 & k_+ & - k^* \\ 0 & 0 & k & - k_- \end{pmatrix}, & \qquad \fmslash{k} \gamma^3 \gamma^5 & = \begin{pmatrix} k_- & k^* & 0 & 0 \\ - k & - k_+ & 0 & 0 \\ 0 & 0 & k_+ & - k^* \\ 0 & 0 & k & - k_- \end{pmatrix} \end{alignat} \end{subequations} and \begin{subequations} \begin{alignat}{2} C \gamma^0 \fmslash{k} &= \begin{pmatrix} k & k_- & 0 & 0 \\ - k_+ & - k^* & 0 & 0 \\ 0 & 0 & k & - k_+ \\ 0 & 0 & k_- & - k^* \end{pmatrix} , & \qquad C \gamma^0 \fmslash{k} \gamma^5 & = \begin{pmatrix} - k & - k_- & 0 & 0 \\ k_+ & k^* & 0 & 0 \\ 0 & 0 & k & - k_+ \\ 0 & 0 & k_- & - k^* \end{pmatrix} \\ C \gamma^1 \fmslash{k} &= \begin{pmatrix} k_+ & k^* & 0 & 0 \\ - k & - k_- & 0 & 0 \\ 0 & 0 & k_- & - k^* \\ 0 & 0 & k & - k_+ \end{pmatrix}, & \qquad C \gamma^1 \fmslash{k} \gamma^5 & = \begin{pmatrix} - k_+ & - k^* & 0 & 0 \\ k & k_- & 0 & 0 \\ 0 & 0 & k_- & - k^* \\ 0 & 0 & k & - k_+ \end{pmatrix} \\ C \gamma^2 \fmslash{k} &= \begin{pmatrix} \ii k_+ & \ii k^* & 0 & 0 \\ \ii k & \ii k_- & 0 & 0 \\ 0 & 0 & \ii k_- & - \ii k^* \\ 0 & 0 & - \ii k & \ii k_+ \end{pmatrix}, & \qquad C \gamma^2 \fmslash{k} \gamma^5 & = \begin{pmatrix} - \ii k_+ & - \ii k^* & 0 & 0 \\ - \ii k & - \ii k_- & 0 & 0 \\ 0 & 0 & \ii k_- & - \ii k^* \\ 0 & 0 & - \ii k & \ii k_+ \end{pmatrix} \\ C \gamma^3 \fmslash{k} &= \begin{pmatrix} - k & - k_- & 0 & 0 \\ - k_+ & - k^* & 0 & 0 \\ 0 & 0 & k & - k_+ \\ 0 & 0 & - k_- & k^* \end{pmatrix}, & \qquad C \gamma^3 \fmslash{k} \gamma^5 & = \begin{pmatrix} k & k_- & 0 & 0 \\ k_+ & k^* & 0 & 0 \\ 0 & 0 & k & - k_+ \\ 0 & 0 & - k_- & k^* \end{pmatrix} \end{alignat} \end{subequations} and \begin{subequations} \begin{alignat}{2} C \fmslash{k} \gamma^0&= \begin{pmatrix} - k & k^+ & 0 & 0 \\ - k_- & k^* & 0 & 0 \\ 0 & 0 & - k & - k_- \\ 0 & 0 & k_+ & k^* \end{pmatrix} , & \qquad C \fmslash{k} \gamma^0 \gamma^5 & = \begin{pmatrix} k & - k_+ & 0 & 0 \\ k_- & - k^* & 0 & 0 \\ 0 & 0 & - k & - k_- \\ 0 & 0 & k_+ & k^* \end{pmatrix} \\ C \fmslash{k} \gamma^1 &= \begin{pmatrix} - k_+ & k & 0 & 0 \\ - k^* & k_- & 0 & 0 \\ 0 & 0 & - k_- & - k \\ 0 & 0 & k^* & k_+ \end{pmatrix}, & \qquad C \fmslash{k} \gamma^1 \gamma^5 & = \begin{pmatrix} k_+ & - k & 0 & 0 \\ k^* & - k_- & 0 & 0 \\ 0 & 0 & - k_- & - k \\ 0 & 0 & k^* & k_+ \end{pmatrix} \\ C \fmslash{k} \gamma^2 &= \begin{pmatrix} - \ii k_+ & - \ii k & 0 & 0 \\ - \ii k^* & - \ii k_- & 0 & 0 \\ 0 & 0 & - \ii k_- & \ii k \\ 0 & 0 & \ii k^* & - \ii k_+ \end{pmatrix}, & \qquad C \fmslash{k} \gamma^2 \gamma^5 & = \begin{pmatrix} \ii k_+ & \ii k & 0 & 0 \\ \ii k^* & \ii k_- & 0 & 0 \\ 0 & 0 & - \ii k_- & \ii k \\ 0 & 0 & \ii k^* & - \ii k_+ \end{pmatrix} \\ C \fmslash{k} \gamma^3 &= \begin{pmatrix} k & k_+ & 0 & 0 \\ k_- & k^* & 0 & 0 \\ 0 & 0 & - k & k_- \\ 0 & 0 & k_+ & - k^* \end{pmatrix}, & \qquad C \fmslash{k} \gamma^3 \gamma^5 & = \begin{pmatrix} - k & - k_+ & 0 & 0 \\ - k_- & - k^* & 0 & 0 \\ 0 & 0 & - k & k_- \\ 0 & 0 & k_+ & - k^* \end{pmatrix} \end{alignat} \end{subequations} <>= pure function fgvgr (psi, k) result (kpsi) type(bispinor) :: kpsi complex(kind=default) :: kp, km, k12, k12s type(vector), intent(in) :: k type(vectorspinor), intent(in) :: psi kp = k%t + k%x(3) km = k%t - k%x(3) k12 = k%x(1) + (0,1)*k%x(2) k12s = k%x(1) - (0,1)*k%x(2) kpsi%a(1) = kp * psi%psi(1)%a(1) + k12s * psi%psi(1)%a(2) & - k12 * psi%psi(2)%a(1) - km * psi%psi(2)%a(2) & + (0,1) * k12 * psi%psi(3)%a(1) + (0,1) * km * psi%psi(3)%a(2) & - kp * psi%psi(4)%a(1) - k12s * psi%psi(4)%a(2) kpsi%a(2) = k12 * psi%psi(1)%a(1) + km * psi%psi(1)%a(2) & - kp * psi%psi(2)%a(1) - k12s * psi%psi(2)%a(2) & - (0,1) * kp * psi%psi(3)%a(1) - (0,1) * k12s * psi%psi(3)%a(2) & + k12 * psi%psi(4)%a(1) + km * psi%psi(4)%a(2) kpsi%a(3) = km * psi%psi(1)%a(3) - k12s * psi%psi(1)%a(4) & - k12 * psi%psi(2)%a(3) + kp * psi%psi(2)%a(4) & + (0,1) * k12 * psi%psi(3)%a(3) - (0,1) * kp * psi%psi(3)%a(4) & + km * psi%psi(4)%a(3) - k12s * psi%psi(4)%a(4) kpsi%a(4) = - k12 * psi%psi(1)%a(3) + kp * psi%psi(1)%a(4) & + km * psi%psi(2)%a(3) - k12s * psi%psi(2)%a(4) & + (0,1) * km * psi%psi(3)%a(3) - (0,1) * k12s * psi%psi(3)%a(4) & + k12 * psi%psi(4)%a(3) - kp * psi%psi(4)%a(4) end function fgvgr @ <>= pure function f_sgr (g, phi, psi, k) result (phipsi) type(bispinor) :: phipsi complex(kind=default), intent(in) :: g complex(kind=default), intent(in) :: phi type(momentum), intent(in) :: k type(vectorspinor), intent(in) :: psi type(vector) :: vk vk = k phipsi = (g * phi) * fgvgr (psi, vk) end function f_sgr @ <>= pure function f_slgr (gl, phi, psi, k) result (phipsi) type(bispinor) :: phipsi complex(kind=default), intent(in) :: gl complex(kind=default), intent(in) :: phi type(momentum), intent(in) :: k type(vectorspinor), intent(in) :: psi phipsi = f_sgr (gl, phi, psi, k) phipsi%a(3:4) = 0 end function f_slgr @ <>= pure function f_srgr (gr, phi, psi, k) result (phipsi) type(bispinor) :: phipsi complex(kind=default), intent(in) :: gr complex(kind=default), intent(in) :: phi type(momentum), intent(in) :: k type(vectorspinor), intent(in) :: psi phipsi = f_sgr (gr, phi, psi, k) phipsi%a(1:2) = 0 end function f_srgr @ <>= pure function f_slrgr (gl, gr, phi, psi, k) result (phipsi) type(bispinor) :: phipsi, phipsi_l, phipsi_r complex(kind=default), intent(in) :: gl, gr complex(kind=default), intent(in) :: phi type(momentum), intent(in) :: k type(vectorspinor), intent(in) :: psi phipsi_l = f_slgr (gl, phi, psi, k) phipsi_r = f_srgr (gr, phi, psi, k) phipsi%a(1:2) = phipsi_l%a(1:2) phipsi%a(3:4) = phipsi_r%a(3:4) end function f_slrgr @ <>= pure function fgvg5gr (psi, k) result (kpsi) type(bispinor) :: kpsi type(vector), intent(in) :: k type(vectorspinor), intent(in) :: psi type(bispinor) :: kpsi_dum kpsi_dum = fgvgr (psi, k) kpsi%a(1:2) = - kpsi_dum%a(1:2) kpsi%a(3:4) = kpsi_dum%a(3:4) end function fgvg5gr @ <>= pure function f_pgr (g, phi, psi, k) result (phipsi) type(bispinor) :: phipsi complex(kind=default), intent(in) :: g complex(kind=default), intent(in) :: phi type(momentum), intent(in) :: k type(vectorspinor), intent(in) :: psi type(vector) :: vk vk = k phipsi = (g * phi) * fgvg5gr (psi, vk) end function f_pgr @ The needed construction of gamma matrices involving the commutator of two gamma matrices. For the slashed terms we use as usual the abbreviations $k_\pm=k_0\pm k_3$, $k=k_1+\ii k_2$, $k^*=k_1-\ii k_2$ and analogous expressions for the vector $v^\mu$. We remind you that~$\cdot^*$ is \emph{not} complex conjugation for complex~$k_\mu$. Furthermore we introduce (in what follows the brackets around the vector indices have the usual meaning of antisymmetrizing with respect to the indices inside the brackets, here without a factor two in the denominator) \begin{subequations} \begin{alignat}{2} a_+ &= \; k_+ v_- + k v^* - k_- v_+ - k^* v & \; = & \; 2 (k_{[3} v_{0]} + \ii k_{[2} v_{1]}) \\ a_- &= \; k_- v_+ + k v^* - k_+ v_- - k^* v & \; = & \; 2 (-k_{[3} v_{0]} + \ii k_{[2} v_{1]}) \\ b_+ &= \; 2 (k_+ v - k v_+) & \; = & \; 2 (k_{[0} v_{1]} + k_{[3} v_{1]} + \ii k_{[0} v_{2]} + \ii k_{[3} v_{2]}) \\ b_- &= \; 2 (k_- v - k v_-) & \; = & \; 2 (k_{[0} v_{1]} - k_{[3} v_{1]} + \ii k_{[0} v_{2]} - \ii k_{[3} v_{2]}) \\ b_{+*} &= \; 2 (k_+ v^* - k^* v_+) & \; = & \; 2 (k_{[0} v_{1]} + k_{[3} v_{1]} - \ii k_{[0} v_{2]} - \ii k_{[3} v_{2]}) \\ b_{-*} &= \; 2 (k_- v^* - k^* v_-) & \; = & \; 2 (k_{[0} v_{1]} - k_{[3} v_{1]} - \ii k_{[0} v_{2]} + \ii k_{[3} v_{2]}) \end{alignat} \end{subequations} Of course, one could introduce a more advanced notation, but we don't want to become confused. \begin{subequations} \begin{align} \lbrack \fmslash{k} , \gamma^0 \rbrack &= \begin{pmatrix} -2k_3 & -2 k^* & 0 & 0 \\ -2k & 2k_3 & 0 & 0 \\ 0 & 0 & 2k_3 & 2k^* \\ 0 & 0 & 2k & -2k_3 \end{pmatrix} \\ \lbrack \fmslash{k} , \gamma^1 \rbrack &= \begin{pmatrix} -2\ii k_2 & -2k_- & 0 & 0 \\ -2k_+ & 2\ii k_2 & 0 & 0 \\ 0 & 0 & -2\ii k_2 & 2k_+ \\ 0 & 0 & 2k_- & 2\ii k_2 \end{pmatrix} \\ \lbrack \fmslash{k} , \gamma^2 \rbrack &= \begin{pmatrix} 2\ii k_1 & 2\ii k_- & 0 & 0 \\ -2\ii k_+ & -2\ii k_1 & 0 & 0 \\ 0 & 0 & 2\ii k_1 & -2\ii k_+ \\ 0 & 0 & 2\ii k_- & -2\ii k_1 \end{pmatrix} \\ \lbrack \fmslash{k} , \gamma^3 \rbrack &= \begin{pmatrix} -2k_0 & -2k^* & 0 & 0 \\ 2k & 2k_0 & 0 & 0 \\ 0 & 0 & 2k_0 & -2k^* \\ 0 & 0 & 2k & -2k_0 \end{pmatrix} \\ \lbrack \fmslash{k} , \fmslash{V} \rbrack &= \begin{pmatrix} a_- & b_{-*} & 0 & 0 \\ b_+ & -a_- & 0 & 0 \\ 0 & 0 & a_+ & -b_{+*} \\ 0 & 0 & -b_- & -a_+ \end{pmatrix} \\ \gamma^5\gamma^0 \lbrack \fmslash{k} , \fmslash{V} \rbrack &= \begin{pmatrix} 0 & 0 & - a_+ & b_{+*} \\ 0 & 0 & b_- & a_+ \\ a_- & b_{-*} & 0 & 0 \\ b_+ & - a_- & 0 & 0 \end{pmatrix} \\ \gamma^5\gamma^1 \lbrack \fmslash{k} , \fmslash{V} \rbrack &= \begin{pmatrix} 0 & 0 & b_- & a_+ \\ 0 & 0 & -a_+ & b_{+*} \\ -b_+ & a_- & 0 & 0 & \\ -a_- & -b_{-*} & 0 & 0 \end{pmatrix} \\ \gamma^5\gamma^2 \lbrack \fmslash{k} , \fmslash{V} \rbrack &= \begin{pmatrix} 0 & 0 & -\ii b_- & -\ii a_+ \\ 0 & 0 & -\ii a_+ & \ii b_{+*} \\ \ii b_+ & -\ii a_- & 0 & 0 \\ -\ii a_- & -\ii b_{-*} & 0 & 0 \end{pmatrix} \\ \gamma^5\gamma^3 \lbrack \fmslash{k} , \fmslash{V} \rbrack &= \begin{pmatrix} 0 & 0 & -a_+ & b_{+*} \\ 0 & 0 & -b_- & -a_+ \\ -a_- & -b_{-*} & 0 & 0 \\ b_+ & -a_- & 0 & 0 \end{pmatrix} \end{align} \end{subequations} and \begin{subequations} \begin{align} \lbrack \fmslash{k} , \fmslash{V} \rbrack \gamma^0 \gamma^5 &= \begin{pmatrix} 0 & 0 & a_- & b_{-*} \\ 0 & 0 & b_+ & -a_- \\ -a_+ & b_{+*} & 0 & 0 \\ b_- & a_+ & 0 & 0 \end{pmatrix} \\ \lbrack \fmslash{k} , \fmslash{V} \rbrack \gamma^1 \gamma^5 &= \begin{pmatrix} 0 & 0 & b_{-*} & a_- \\ 0 & 0 & -a_- & b_+ \\ -b_{+*} & a_+ & 0 & 0 \\ -a_+ & -b_- & 0 & 0 \end{pmatrix} \\ \lbrack \fmslash{k} , \fmslash{V} \rbrack \gamma^2 \gamma^5 &= \begin{pmatrix} 0 & 0 & \ii b_{-*} & -\ii a_- \\ 0 & 0 & -\ii a_- & -\ii b_+ \\ -\ii b_{+*} & -\ii a_+ & 0 & 0 \\ -\ii a_+ & \ii b_- & 0 & 0 \end{pmatrix} \\ \lbrack \fmslash{k} , \fmslash{V} \rbrack \gamma^3 \gamma^5 &= \begin{pmatrix} 0 & 0 & a_- & - b_{-*} \\ 0 & 0 & b_+ & a_- \\ a_+ & b_{+*} & 0 & 0 \\ -b_- & a_+ & 0 & 0 \end{pmatrix} \end{align} \end{subequations} In what follows $l$ always means twice the value of $k$, e.g. $l_+$ = $2 k_+$. We use the abbreviation $C^{\mu\nu} \equiv C \lbrack \fmslash{k}, \gamma^\mu \rbrack \gamma^\nu \gamma^5$. \begin{subequations} \begin{alignat}{2} C^{00} &= \begin{pmatrix} 0 & 0 & -l & -l_3 \\ 0 & 0 & l_3 & l^* \\ l & -l_3 & 0 & 0 \\ -l_3 & -l^* & 0 & 0 \end{pmatrix} , & \qquad C^{20} &= \begin{pmatrix} 0 & 0 & -\ii l_+ & -\ii l_1 \\ 0 & 0 & -\ii l_1 & -\ii l_- \\ \ii l_- & -\ii l_1 & 0 & 0 \\ -\ii l_1 & \ii l_+ & 0 & 0 \end{pmatrix} \\ C^{01} &= \begin{pmatrix} 0 & 0 & l_3 & -l \\ 0 & 0 & l^* & l_3 \\ l_3 & -l & 0 & 0 \\ l^* & l_3 & 0 & 0 \end{pmatrix} , & \qquad C^{21} &= \begin{pmatrix} 0 & 0 & -\ii l_1 & -\ii l_+ \\ 0 & 0 & -\ii l_- & -\ii l_1 \\ \ii l_1 & -\ii l_- & 0 & 0 \\ -\ii l_+ & \ii l_1 & 0 & 0 \end{pmatrix} \\ C^{02} &= \begin{pmatrix} 0 & 0 & \ii l_3 & \ii l \\ 0 & 0 & \ii l^* & -\ii l_3 \\ \ii l_3 & \ii l & 0 & 0 \\ \ii l^* & -\ii l_3 & 0 & 0 \end{pmatrix} , & \qquad C^{22} &= \begin{pmatrix} 0 & 0 & l_1 & -l_+ \\ 0 & 0 & l_- & -l_1 \\ -l_1 & -l_- & 0 & 0 \\ l_+ & l_1 & 0 & 0 \end{pmatrix} \\ C^{03} &= \begin{pmatrix} 0 & 0 & -l & -l_3 \\ 0 & 0 & l_3 & -l^* \\ -l & -l_3 & 0 & 0 \\ l_3 & -l^* & 0 & 0 \end{pmatrix} , & \qquad C^{23} &= \begin{pmatrix} 0 & 0 & -\ii l_+ & \ii l_1 \\ 0 & 0 & -\ii l_1 & \ii l_- \\ -\ii l_- & -\ii l_1 & 0 & 0 \\ \ii l_1 & \ii l_+ & 0 & 0 \end{pmatrix} \\ C^{10} &= \begin{pmatrix} 0 & 0 & -l_+ & \ii l_2 \\ 0 & 0 & \ii l_2 & l_- \\ l_- & \ii l_2 & 0 & 0 \\ \ii l_2 & -l_+ & 0 & 0 \end{pmatrix} , & \qquad C^{30} &= \begin{pmatrix} 0 & 0 & l & l_0 \\ 0 & 0 & l_0 & l^* \\ l & -l_0 & 0 & 0 \\ -l_0 & l^* & 0 & 0 \end{pmatrix} \\ C^{11} &= \begin{pmatrix} 0 & 0 & \ii l_2 & -l_+ \\ 0 & 0 & l_- & \ii l_2 \\ -\ii l_2 & -l_- & 0 & 0 \\ l_+ & -\ii l_2 & 0 & 0 \end{pmatrix} , & \qquad C^{31} &= \begin{pmatrix} 0 & 0 & l_0 & l \\ 0 & 0 & l^* & l_0 \\ l_0 & -l & 0 & 0 \\ -l^* & l_0 & 0 & 0 \end{pmatrix} \\ C^{12} &= \begin{pmatrix} 0 & 0 & -l_2 & \ii l_+ \\ 0 & 0 & \ii l_- & l_2 \\ l_2 & \ii l_- & 0 & 0 \\ \ii l_+ & -l_2 & 0 & 0 \end{pmatrix} , & \qquad C^{32} &= \begin{pmatrix} 0 & 0 & \ii l_0 & -\ii l \\ 0 & 0 & \ii l^* & -\ii l_0 \\ \ii l_0 & \ii l & 0 & 0 \\ -\ii l^* & -\ii l_0 & 0 & 0 \end{pmatrix} \\ C^{13} &= \begin{pmatrix} 0 & 0 & -l_+ & -\ii l_2 \\ 0 & 0 & \ii l_2 & - l_- \\ -l_- & \ii l_2 & 0 & 0 \\ -\ii l_2 & -l_+ & 0 & 0 \end{pmatrix} , & \qquad C^{33} &= \begin{pmatrix} 0 & 0 & l & -l_0 \\ 0 & 0 & l_0 & -l^* \\ -l & -l_0 & 0 & 0 \\ l_0 & l^* & 0 & 0 \end{pmatrix} \end{alignat} \end{subequations} and, with the abbreviation $\tilde{C}^{\mu\nu} \equiv C \gamma^5 \gamma^\nu \lbrack \fmslash{k} , \gamma^\mu \rbrack$ (note the reversed order of the indices!) \begin{subequations} \begin{alignat}{2} \tilde{C}^{00} &= \begin{pmatrix} 0 & 0 & -l & l_3 \\ 0 & 0 & l_3 & l^* \\ l & -l_3 & 0 & 0 \\ -l_3 & -l^* & 0 & 0 \end{pmatrix} , & \qquad \tilde{C}^{20} &= \begin{pmatrix} 0 & 0 & -\ii l_- & \ii l_1 \\ 0 & 0 & \ii l_1 & -\ii l_+ \\ \ii l_+ & \ii l_1 & 0 & 0 \\ \ii l_1 & \ii l_- & 0 & 0 \end{pmatrix} \\ \tilde{C}^{01} &= \begin{pmatrix} 0 & 0 & -l_3 & -l^* \\ 0 & 0 & l & -l_3 \\ -l_3 & -l^* & 0 & 0 \\ l & -l_3 & 0 & 0 \end{pmatrix} , & \qquad \tilde{C}^{21} &= \begin{pmatrix} 0 & 0 & -\ii l_1 & \ii l_+ \\ 0 & 0 & \ii l_- & -\ii l_1 \\ \ii l_1 & \ii l_- & 0 & 0 \\ \ii l_+ & \ii l_1 & 0 & 0 \end{pmatrix} \\ \tilde{C}^{02} &= \begin{pmatrix} 0 & 0 & -\ii l_3 & -\ii l^* \\ 0 & 0 & -\ii l & \ii l_3 \\ -\ii l_3 & -\ii l^* & 0 & 0 \\ -\ii l & \ii l_3 & 0 & 0 \end{pmatrix} , & \qquad \tilde{C}^{22} &= \begin{pmatrix} 0 & 0 & l_1 & -l_+ \\ 0 & 0 & l_- & -l_1 \\ -l_1 & -l_- & 0 & 0 \\ l_+ & l_1 & 0 & 0 \end{pmatrix} \\ \tilde{C}^{03} &= \begin{pmatrix} 0 & 0 & l & -l_3 \\ 0 & 0 & l_3 & l^* \\ l & -l_3 & 0 & 0 \\ l_3 & l^* & 0 & 0 \end{pmatrix} , & \qquad \tilde{C}^{23} &= \begin{pmatrix} 0 & 0 & \ii l_- & -\ii l_1 \\ 0 & 0 & \ii l_1 & -\ii l_+ \\ \ii l_+ & \ii l_1 & 0 & 0 \\ -\ii l_1 & -\ii l_- & 0 & 0 \end{pmatrix} \\ \tilde{C}^{10} &= \begin{pmatrix} 0 & 0 & -l_- & -\ii l_2 \\ 0 & 0 & -\ii l_2 & l_+ \\ l_+ & -\ii l_2 & 0 & 0 \\ -\ii l_2 & -l_- & 0 & 0 \end{pmatrix} , & \qquad \tilde{C}^{30} &= \begin{pmatrix} 0 & 0 & -l & l_0 \\ 0 & 0 & l_0 & -l^* \\ -l & -l_0 & 0 & 0 \\ -l_0 & -l^* & 0 & 0 \end{pmatrix} \\ \tilde{C}^{11} &= \begin{pmatrix} 0 & 0 & \ii l_2 & -l_+ \\ 0 & 0 & l_- & \ii l_2 \\ -\ii l_2 & -l_- & 0 & 0 \\ l_+ & -\ii l_2 & 0 & 0 \end{pmatrix} , & \qquad \tilde{C}^{31} &= \begin{pmatrix} 0 & 0 & -l_0 & l^* \\ 0 & 0 & l & -l_0 \\ -l_0 & -l^* & 0 & 0 \\ -l & -l_0 & 0 & 0 \end{pmatrix} \\ \tilde{C}^{12} &= \begin{pmatrix} 0 & 0 & -l_2 & -\ii l_+ \\ 0 & 0 & -\ii l_- & l_2 \\ l_2 & -\ii l_- & 0 & 0 \\ -\ii l_+ & -l_2 & 0 & 0 \end{pmatrix} , & \qquad \tilde{C}^{32} &= \begin{pmatrix} 0 & 0 & -\ii l_0 & \ii l^* \\ 0 & 0 & -\ii l & \ii l_0 \\ -\ii l_0 & -\ii l^* & 0 & 0 \\ \ii l & \ii l_0 & 0 & 0 \end{pmatrix} \\ \tilde{C}^{13} &= \begin{pmatrix} 0 & 0 & l_- & \ii l_2 \\ 0 & 0 & -\ii l_2 & l_+ \\ l_+ & -\ii l_2 & 0 & 0 \\ \ii l_2 & l_- & 0 & 0 \end{pmatrix} , & \qquad \tilde{C}^{33} &= \begin{pmatrix} 0 & 0 & l & -l_0 \\ 0 & 0 & l_0 & -l^* \\ -l & -l_0 & 0 & 0 \\ l_0 & l^* & 0 & 0 \end{pmatrix} \end{alignat} \end{subequations} <>= pure function fggvvgr (v, psi, k) result (psikv) type(bispinor) :: psikv type(vectorspinor), intent(in) :: psi type(vector), intent(in) :: v, k complex(kind=default) :: kv30, kv21, kv01, kv31, kv02, kv32 complex(kind=default) :: ap, am, bp, bm, bps, bms kv30 = k%x(3) * v%t - k%t * v%x(3) kv21 = (0,1) * (k%x(2) * v%x(1) - k%x(1) * v%x(2)) kv01 = k%t * v%x(1) - k%x(1) * v%t kv31 = k%x(3) * v%x(1) - k%x(1) * v%x(3) kv02 = (0,1) * (k%t * v%x(2) - k%x(2) * v%t) kv32 = (0,1) * (k%x(3) * v%x(2) - k%x(2) * v%x(3)) ap = 2 * (kv30 + kv21) am = 2 * (-kv30 + kv21) bp = 2 * (kv01 + kv31 + kv02 + kv32) bm = 2 * (kv01 - kv31 + kv02 - kv32) bps = 2 * (kv01 + kv31 - kv02 - kv32) bms = 2 * (kv01 - kv31 - kv02 + kv32) psikv%a(1) = (-ap) * psi%psi(1)%a(3) + bps * psi%psi(1)%a(4) & + (-bm) * psi%psi(2)%a(3) + (-ap) * psi%psi(2)%a(4) & + (0,1) * (bm * psi%psi(3)%a(3) + ap * psi%psi(3)%a(4)) & + ap * psi%psi(4)%a(3) + (-bps) * psi%psi(4)%a(4) psikv%a(2) = bm * psi%psi(1)%a(3) + ap * psi%psi(1)%a(4) & + ap * psi%psi(2)%a(3) + (-bps) * psi%psi(2)%a(4) & + (0,1) * (ap * psi%psi(3)%a(3) - bps * psi%psi(3)%a(4)) & + bm * psi%psi(4)%a(3) + ap * psi%psi(4)%a(4) psikv%a(3) = am * psi%psi(1)%a(1) + bms * psi%psi(1)%a(2) & + bp * psi%psi(2)%a(1) + (-am) * psi%psi(2)%a(2) & + (0,-1) * (bp * psi%psi(3)%a(1) + (-am) * psi%psi(3)%a(2)) & + am * psi%psi(4)%a(1) + bms * psi%psi(4)%a(2) psikv%a(4) = bp * psi%psi(1)%a(1) + (-am) * psi%psi(1)%a(2) & + am * psi%psi(2)%a(1) + bms * psi%psi(2)%a(2) & + (0,1) * (am * psi%psi(3)%a(1) + bms * psi%psi(3)%a(2)) & + (-bp) * psi%psi(4)%a(1) + am * psi%psi(4)%a(2) end function fggvvgr @ <>= pure function f_vgr (g, v, psi, k) result (psikkkv) type(bispinor) :: psikkkv type(vectorspinor), intent(in) :: psi type(vector), intent(in) :: v type(momentum), intent(in) :: k complex(kind=default), intent(in) :: g type(vector) :: vk vk = k psikkkv = g * (fggvvgr (v, psi, vk)) end function f_vgr @ <>= pure function f_vlrgr (gl, gr, v, psi, k) result (psikv) type(bispinor) :: psikv type(vectorspinor), intent(in) :: psi type(vector), intent(in) :: v type(momentum), intent(in) :: k complex(kind=default), intent(in) :: gl, gr type(vector) :: vk vk = k psikv = fggvvgr (v, psi, vk) psikv%a(1:2) = gl * psikv%a(1:2) psikv%a(3:4) = gr * psikv%a(3:4) end function f_vlrgr @ <>= public :: gr_potf, gr_sf, gr_pf, gr_vf, gr_vlrf, gr_slf, gr_srf, gr_slrf @ <>= pure function gr_potf (g, phi, psi) result (phipsi) type(vectorspinor) :: phipsi complex(kind=default), intent(in) :: g complex(kind=default), intent(in) :: phi type(bispinor), intent(in) :: psi phipsi%psi(1)%a(1) = (g * phi) * psi%a(3) phipsi%psi(1)%a(2) = (g * phi) * psi%a(4) phipsi%psi(1)%a(3) = (g * phi) * psi%a(1) phipsi%psi(1)%a(4) = (g * phi) * psi%a(2) phipsi%psi(2)%a(1) = (g * phi) * psi%a(4) phipsi%psi(2)%a(2) = (g * phi) * psi%a(3) phipsi%psi(2)%a(3) = ((-g) * phi) * psi%a(2) phipsi%psi(2)%a(4) = ((-g) * phi) * psi%a(1) phipsi%psi(3)%a(1) = ((0,-1) * g * phi) * psi%a(4) phipsi%psi(3)%a(2) = ((0,1) * g * phi) * psi%a(3) phipsi%psi(3)%a(3) = ((0,1) * g * phi) * psi%a(2) phipsi%psi(3)%a(4) = ((0,-1) * g * phi) * psi%a(1) phipsi%psi(4)%a(1) = (g * phi) * psi%a(3) phipsi%psi(4)%a(2) = ((-g) * phi) * psi%a(4) phipsi%psi(4)%a(3) = ((-g) * phi) * psi%a(1) phipsi%psi(4)%a(4) = (g * phi) * psi%a(2) end function gr_potf @ <>= pure function grkgf (psi, k) result (kpsi) type(vectorspinor) :: kpsi complex(kind=default) :: kp, km, k12, k12s type(bispinor), intent(in) :: psi type(vector), intent(in) :: k kp = k%t + k%x(3) km = k%t - k%x(3) k12 = k%x(1) + (0,1)*k%x(2) k12s = k%x(1) - (0,1)*k%x(2) kpsi%psi(1)%a(1) = km * psi%a(1) - k12s * psi%a(2) kpsi%psi(1)%a(2) = (-k12) * psi%a(1) + kp * psi%a(2) kpsi%psi(1)%a(3) = kp * psi%a(3) + k12s * psi%a(4) kpsi%psi(1)%a(4) = k12 * psi%a(3) + km * psi%a(4) kpsi%psi(2)%a(1) = k12s * psi%a(1) - km * psi%a(2) kpsi%psi(2)%a(2) = (-kp) * psi%a(1) + k12 * psi%a(2) kpsi%psi(2)%a(3) = k12s * psi%a(3) + kp * psi%a(4) kpsi%psi(2)%a(4) = km * psi%a(3) + k12 * psi%a(4) kpsi%psi(3)%a(1) = (0,1) * (k12s * psi%a(1) + km * psi%a(2)) kpsi%psi(3)%a(2) = (0,-1) * (kp * psi%a(1) + k12 * psi%a(2)) kpsi%psi(3)%a(3) = (0,1) * (k12s * psi%a(3) - kp * psi%a(4)) kpsi%psi(3)%a(4) = (0,1) * (km * psi%a(3) - k12 * psi%a(4)) kpsi%psi(4)%a(1) = -(km * psi%a(1) + k12s * psi%a(2)) kpsi%psi(4)%a(2) = k12 * psi%a(1) + kp * psi%a(2) kpsi%psi(4)%a(3) = kp * psi%a(3) - k12s * psi%a(4) kpsi%psi(4)%a(4) = k12 * psi%a(3) - km * psi%a(4) end function grkgf @ <>= pure function gr_sf (g, phi, psi, k) result (phipsi) type(vectorspinor) :: phipsi complex(kind=default), intent(in) :: g complex(kind=default), intent(in) :: phi type(bispinor), intent(in) :: psi type(momentum), intent(in) :: k type(vector) :: vk vk = k phipsi = (g * phi) * grkgf (psi, vk) end function gr_sf @ <>= pure function gr_slf (gl, phi, psi, k) result (phipsi) type(vectorspinor) :: phipsi complex(kind=default), intent(in) :: gl complex(kind=default), intent(in) :: phi type(bispinor), intent(in) :: psi type(bispinor) :: psi_l type(momentum), intent(in) :: k psi_l%a(1:2) = psi%a(1:2) psi_l%a(3:4) = 0 phipsi = gr_sf (gl, phi, psi_l, k) end function gr_slf @ <>= pure function gr_srf (gr, phi, psi, k) result (phipsi) type(vectorspinor) :: phipsi complex(kind=default), intent(in) :: gr complex(kind=default), intent(in) :: phi type(bispinor), intent(in) :: psi type(bispinor) :: psi_r type(momentum), intent(in) :: k psi_r%a(1:2) = 0 psi_r%a(3:4) = psi%a(3:4) phipsi = gr_sf (gr, phi, psi_r, k) end function gr_srf @ <>= pure function gr_slrf (gl, gr, phi, psi, k) result (phipsi) type(vectorspinor) :: phipsi complex(kind=default), intent(in) :: gl, gr complex(kind=default), intent(in) :: phi type(bispinor), intent(in) :: psi type(momentum), intent(in) :: k phipsi = gr_slf (gl, phi, psi, k) + gr_srf (gr, phi, psi, k) end function gr_slrf @ <>= pure function grkggf (psi, k) result (kpsi) type(vectorspinor) :: kpsi complex(kind=default) :: kp, km, k12, k12s type(bispinor), intent(in) :: psi type(vector), intent(in) :: k kp = k%t + k%x(3) km = k%t - k%x(3) k12 = k%x(1) + (0,1)*k%x(2) k12s = k%x(1) - (0,1)*k%x(2) kpsi%psi(1)%a(1) = (-km) * psi%a(1) + k12s * psi%a(2) kpsi%psi(1)%a(2) = k12 * psi%a(1) - kp * psi%a(2) kpsi%psi(1)%a(3) = kp * psi%a(3) + k12s * psi%a(4) kpsi%psi(1)%a(4) = k12 * psi%a(3) + km * psi%a(4) kpsi%psi(2)%a(1) = (-k12s) * psi%a(1) + km * psi%a(2) kpsi%psi(2)%a(2) = kp * psi%a(1) - k12 * psi%a(2) kpsi%psi(2)%a(3) = k12s * psi%a(3) + kp * psi%a(4) kpsi%psi(2)%a(4) = km * psi%a(3) + k12 * psi%a(4) kpsi%psi(3)%a(1) = (0,-1) * (k12s * psi%a(1) + km * psi%a(2)) kpsi%psi(3)%a(2) = (0,1) * (kp * psi%a(1) + k12 * psi%a(2)) kpsi%psi(3)%a(3) = (0,1) * (k12s * psi%a(3) - kp * psi%a(4)) kpsi%psi(3)%a(4) = (0,1) * (km * psi%a(3) - k12 * psi%a(4)) kpsi%psi(4)%a(1) = km * psi%a(1) + k12s * psi%a(2) kpsi%psi(4)%a(2) = -(k12 * psi%a(1) + kp * psi%a(2)) kpsi%psi(4)%a(3) = kp * psi%a(3) - k12s * psi%a(4) kpsi%psi(4)%a(4) = k12 * psi%a(3) - km * psi%a(4) end function grkggf @ <>= pure function gr_pf (g, phi, psi, k) result (phipsi) type(vectorspinor) :: phipsi complex(kind=default), intent(in) :: g complex(kind=default), intent(in) :: phi type(bispinor), intent(in) :: psi type(momentum), intent(in) :: k type(vector) :: vk vk = k phipsi = (g * phi) * grkggf (psi, vk) end function gr_pf @ <>= pure function grkkggf (v, psi, k) result (psikv) type(vectorspinor) :: psikv type(bispinor), intent(in) :: psi type(vector), intent(in) :: v, k complex(kind=default) :: kv30, kv21, kv01, kv31, kv02, kv32 complex(kind=default) :: ap, am, bp, bm, bps, bms, imago imago = (0.0_default,1.0_default) kv30 = k%x(3) * v%t - k%t * v%x(3) kv21 = imago * (k%x(2) * v%x(1) - k%x(1) * v%x(2)) kv01 = k%t * v%x(1) - k%x(1) * v%t kv31 = k%x(3) * v%x(1) - k%x(1) * v%x(3) kv02 = imago * (k%t * v%x(2) - k%x(2) * v%t) kv32 = imago * (k%x(3) * v%x(2) - k%x(2) * v%x(3)) ap = 2 * (kv30 + kv21) am = 2 * ((-kv30) + kv21) bp = 2 * (kv01 + kv31 + kv02 + kv32) bm = 2 * (kv01 - kv31 + kv02 - kv32) bps = 2 * (kv01 + kv31 - kv02 - kv32) bms = 2 * (kv01 - kv31 - kv02 + kv32) psikv%psi(1)%a(1) = am * psi%a(3) + bms * psi%a(4) psikv%psi(1)%a(2) = bp * psi%a(3) + (-am) * psi%a(4) psikv%psi(1)%a(3) = (-ap) * psi%a(1) + bps * psi%a(2) psikv%psi(1)%a(4) = bm * psi%a(1) + ap * psi%a(2) psikv%psi(2)%a(1) = bms * psi%a(3) + am * psi%a(4) psikv%psi(2)%a(2) = (-am) * psi%a(3) + bp * psi%a(4) psikv%psi(2)%a(3) = (-bps) * psi%a(1) + ap * psi%a(2) psikv%psi(2)%a(4) = (-ap) * psi%a(1) + (-bm) * psi%a(2) psikv%psi(3)%a(1) = imago * (bms * psi%a(3) - am * psi%a(4)) psikv%psi(3)%a(2) = (-imago) * (am * psi%a(3) + bp * psi%a(4)) psikv%psi(3)%a(3) = (-imago) * (bps * psi%a(1) + ap * psi%a(2)) psikv%psi(3)%a(4) = imago * ((-ap) * psi%a(1) + bm * psi%a(2)) psikv%psi(4)%a(1) = am * psi%a(3) + (-bms) * psi%a(4) psikv%psi(4)%a(2) = bp * psi%a(3) + am * psi%a(4) psikv%psi(4)%a(3) = ap * psi%a(1) + bps * psi%a(2) psikv%psi(4)%a(4) = (-bm) * psi%a(1) + ap * psi%a(2) end function grkkggf @ <>= pure function gr_vf (g, v, psi, k) result (psikv) type(vectorspinor) :: psikv type(bispinor), intent(in) :: psi type(vector), intent(in) :: v type(momentum), intent(in) :: k complex(kind=default), intent(in) :: g type(vector) :: vk vk = k psikv = g * (grkkggf (v, psi, vk)) end function gr_vf @ <>= pure function gr_vlrf (gl, gr, v, psi, k) result (psikv) type(vectorspinor) :: psikv type(bispinor), intent(in) :: psi type(bispinor) :: psi_l, psi_r type(vector), intent(in) :: v type(momentum), intent(in) :: k complex(kind=default), intent(in) :: gl, gr type(vector) :: vk vk = k psi_l%a(1:2) = psi%a(1:2) psi_l%a(3:4) = 0 psi_r%a(1:2) = 0 psi_r%a(3:4) = psi%a(3:4) psikv = gl * grkkggf (v, psi_l, vk) + gr * grkkggf (v, psi_r, vk) end function gr_vlrf @ <>= public :: v_grf, v_fgr @ <>= public :: vlr_grf, vlr_fgr @ $V^\mu = \psi_\rho^T C^{\mu\rho} \psi$ <>= pure function grkgggf (psil, psir, k) result (j) type(vector) :: j type(vectorspinor), intent(in) :: psil type(bispinor), intent(in) :: psir type(vector), intent(in) :: k type(vectorspinor) :: c_psir0, c_psir1, c_psir2, c_psir3 complex(kind=default) :: kp, km, k12, k12s, ik2 kp = k%t + k%x(3) km = k%t - k%x(3) k12 = (k%x(1) + (0,1)*k%x(2)) k12s = (k%x(1) - (0,1)*k%x(2)) ik2 = (0,1) * k%x(2) !!! New version: c_psir0%psi(1)%a(1) = (-k%x(3)) * psir%a(3) + (-k12s) * psir%a(4) c_psir0%psi(1)%a(2) = (-k12) * psir%a(3) + k%x(3) * psir%a(4) c_psir0%psi(1)%a(3) = (-k%x(3)) * psir%a(1) + (-k12s) * psir%a(2) c_psir0%psi(1)%a(4) = (-k12) * psir%a(1) + k%x(3) * psir%a(2) c_psir0%psi(2)%a(1) = (-k12s) * psir%a(3) + (-k%x(3)) * psir%a(4) c_psir0%psi(2)%a(2) = k%x(3) * psir%a(3) + (-k12) * psir%a(4) c_psir0%psi(2)%a(3) = k12s * psir%a(1) + k%x(3) * psir%a(2) c_psir0%psi(2)%a(4) = (-k%x(3)) * psir%a(1) + k12 * psir%a(2) c_psir0%psi(3)%a(1) = (0,1) * ((-k12s) * psir%a(3) + k%x(3) * psir%a(4)) c_psir0%psi(3)%a(2) = (0,1) * (k%x(3) * psir%a(3) + k12 * psir%a(4)) c_psir0%psi(3)%a(3) = (0,1) * (k12s * psir%a(1) + (-k%x(3)) * psir%a(2)) c_psir0%psi(3)%a(4) = (0,1) * ((-k%x(3)) * psir%a(1) + (-k12) * psir%a(2)) c_psir0%psi(4)%a(1) = (-k%x(3)) * psir%a(3) + k12s * psir%a(4) c_psir0%psi(4)%a(2) = (-k12) * psir%a(3) + (-k%x(3)) * psir%a(4) c_psir0%psi(4)%a(3) = k%x(3) * psir%a(1) + (-k12s) * psir%a(2) c_psir0%psi(4)%a(4) = k12 * psir%a(1) + k%x(3) * psir%a(2) !!! c_psir1%psi(1)%a(1) = (-ik2) * psir%a(3) + (-km) * psir%a(4) c_psir1%psi(1)%a(2) = (-kp) * psir%a(3) + ik2 * psir%a(4) c_psir1%psi(1)%a(3) = ik2 * psir%a(1) + (-kp) * psir%a(2) c_psir1%psi(1)%a(4) = (-km) * psir%a(1) + (-ik2) * psir%a(2) c_psir1%psi(2)%a(1) = (-km) * psir%a(3) + (-ik2) * psir%a(4) c_psir1%psi(2)%a(2) = ik2 * psir%a(3) + (-kp) * psir%a(4) c_psir1%psi(2)%a(3) = kp * psir%a(1) + (-ik2) * psir%a(2) c_psir1%psi(2)%a(4) = ik2 * psir%a(1) + km * psir%a(2) c_psir1%psi(3)%a(1) = ((0,-1) * km) * psir%a(3) + (-k%x(2)) * psir%a(4) c_psir1%psi(3)%a(2) = (-k%x(2)) * psir%a(3) + ((0,1) * kp) * psir%a(4) c_psir1%psi(3)%a(3) = ((0,1) * kp) * psir%a(1) + (-k%x(2)) * psir%a(2) c_psir1%psi(3)%a(4) = (-k%x(2)) * psir%a(1) + ((0,-1) * km) * psir%a(2) c_psir1%psi(4)%a(1) = (-ik2) * psir%a(3) + km * psir%a(4) c_psir1%psi(4)%a(2) = (-kp) * psir%a(3) + (-ik2) * psir%a(4) c_psir1%psi(4)%a(3) = (-ik2) * psir%a(1) + (-kp) * psir%a(2) c_psir1%psi(4)%a(4) = km * psir%a(1) + (-ik2) * psir%a(2) !!! c_psir2%psi(1)%a(1) = (0,1) * (k%x(1) * psir%a(3) + km * psir%a(4)) c_psir2%psi(1)%a(2) = (0,-1) * (kp * psir%a(3) + k%x(1) * psir%a(4)) c_psir2%psi(1)%a(3) = (0,1) * ((-k%x(1)) * psir%a(1) + kp * psir%a(2)) c_psir2%psi(1)%a(4) = (0,1) * ((-km) * psir%a(1) + k%x(1) * psir%a(2)) c_psir2%psi(2)%a(1) = (0,1) * (km * psir%a(3) + k%x(1) * psir%a(4)) c_psir2%psi(2)%a(2) = (0,-1) * (k%x(1) * psir%a(3) + kp * psir%a(4)) c_psir2%psi(2)%a(3) = (0,-1) * (kp * psir%a(1) + (-k%x(1)) * psir%a(2)) c_psir2%psi(2)%a(4) = (0,-1) * (k%x(1) * psir%a(1) + (-km) * psir%a(2)) c_psir2%psi(3)%a(1) = (-km) * psir%a(3) + k%x(1) * psir%a(4) c_psir2%psi(3)%a(2) = k%x(1) * psir%a(3) + (-kp) * psir%a(4) c_psir2%psi(3)%a(3) = kp * psir%a(1) + k%x(1) * psir%a(2) c_psir2%psi(3)%a(4) = k%x(1) * psir%a(1) + km * psir%a(2) c_psir2%psi(4)%a(1) = (0,1) * (k%x(1) * psir%a(3) + (-km) * psir%a(4)) c_psir2%psi(4)%a(2) = (0,1) * ((-kp) * psir%a(3) + k%x(1) * psir%a(4)) c_psir2%psi(4)%a(3) = (0,1) * (k%x(1) * psir%a(1) + kp * psir%a(2)) c_psir2%psi(4)%a(4) = (0,1) * (km * psir%a(1) + k%x(1) * psir%a(2)) !!! c_psir3%psi(1)%a(1) = (-k%t) * psir%a(3) - k12s * psir%a(4) c_psir3%psi(1)%a(2) = k12 * psir%a(3) + k%t * psir%a(4) c_psir3%psi(1)%a(3) = (-k%t) * psir%a(1) + k12s * psir%a(2) c_psir3%psi(1)%a(4) = (-k12) * psir%a(1) + k%t * psir%a(2) c_psir3%psi(2)%a(1) = (-k12s) * psir%a(3) + (-k%t) * psir%a(4) c_psir3%psi(2)%a(2) = k%t * psir%a(3) + k12 * psir%a(4) c_psir3%psi(2)%a(3) = (-k12s) * psir%a(1) + k%t * psir%a(2) c_psir3%psi(2)%a(4) = (-k%t) * psir%a(1) + k12 * psir%a(2) c_psir3%psi(3)%a(1) = (0,-1) * (k12s * psir%a(3) + (-k%t) * psir%a(4)) c_psir3%psi(3)%a(2) = (0,1) * (k%t * psir%a(3) + (-k12) * psir%a(4)) c_psir3%psi(3)%a(3) = (0,-1) * (k12s * psir%a(1) + k%t * psir%a(2)) c_psir3%psi(3)%a(4) = (0,-1) * (k%t * psir%a(1) + k12 * psir%a(2)) c_psir3%psi(4)%a(1) = (-k%t) * psir%a(3) + k12s * psir%a(4) c_psir3%psi(4)%a(2) = k12 * psir%a(3) + (-k%t) * psir%a(4) c_psir3%psi(4)%a(3) = k%t * psir%a(1) + k12s * psir%a(2) c_psir3%psi(4)%a(4) = k12 * psir%a(1) + k%t * psir%a(2) j%t = 2 * (psil * c_psir0) j%x(1) = 2 * (psil * c_psir1) j%x(2) = 2 * (psil * c_psir2) j%x(3) = 2 * (psil * c_psir3) end function grkgggf @ <>= pure function v_grf (g, psil, psir, k) result (j) type(vector) :: j complex(kind=default), intent(in) :: g type(vectorspinor), intent(in) :: psil type(bispinor), intent(in) :: psir type(momentum), intent(in) :: k type(vector) :: vk vk = k j = g * grkgggf (psil, psir, vk) end function v_grf @ <>= pure function vlr_grf (gl, gr, psil, psir, k) result (j) type(vector) :: j complex(kind=default), intent(in) :: gl, gr type(vectorspinor), intent(in) :: psil type(bispinor), intent(in) :: psir type(bispinor) :: psir_l, psir_r type(momentum), intent(in) :: k type(vector) :: vk vk = k psir_l%a(1:2) = psir%a(1:2) psir_l%a(3:4) = 0 psir_r%a(1:2) = 0 psir_r%a(3:4) = psir%a(3:4) j = gl * grkgggf (psil, psir_l, vk) + gr * grkgggf (psil, psir_r, vk) end function vlr_grf @ $V^\mu = \psi^T \tilde{C}^{\mu\rho} \psi_\rho$; remember the reversed index order in $\tilde{C}$. <>= pure function fggkggr (psil, psir, k) result (j) type(vector) :: j type(vectorspinor), intent(in) :: psir type(bispinor), intent(in) :: psil type(vector), intent(in) :: k type(bispinor) :: c_psir0, c_psir1, c_psir2, c_psir3 complex(kind=default) :: kp, km, k12, k12s, ik1, ik2 kp = k%t + k%x(3) km = k%t - k%x(3) k12 = k%x(1) + (0,1)*k%x(2) k12s = k%x(1) - (0,1)*k%x(2) ik1 = (0,1) * k%x(1) ik2 = (0,1) * k%x(2) c_psir0%a(1) = k%x(3) * (psir%psi(1)%a(4) + psir%psi(4)%a(4) & + psir%psi(2)%a(3) + (0,1) * psir%psi(3)%a(3)) & - k12 * (psir%psi(1)%a(3) + psir%psi(4)%a(3)) & + k12s * (psir%psi(2)%a(4) + (0,1) * psir%psi(3)%a(4)) c_psir0%a(2) = k%x(3) * (psir%psi(1)%a(3) - psir%psi(4)%a(3) + & psir%psi(2)%a(4) - (0,1) * psir%psi(3)%a(4)) + & k12s * (psir%psi(1)%a(4) - psir%psi(4)%a(4)) - & k12 * (psir%psi(2)%a(3) - (0,1) * psir%psi(3)%a(3)) c_psir0%a(3) = k%x(3) * (-psir%psi(1)%a(2) + psir%psi(4)%a(2) + & psir%psi(2)%a(1) + (0,1) * psir%psi(3)%a(1)) + & k12 * (psir%psi(1)%a(1) - psir%psi(4)%a(1)) + & k12s * (psir%psi(2)%a(2) + (0,1) * psir%psi(3)%a(2)) c_psir0%a(4) = k%x(3) * (-psir%psi(1)%a(1) - psir%psi(4)%a(1) + & psir%psi(2)%a(2) - (0,1) * psir%psi(3)%a(2)) - & k12s * (psir%psi(1)%a(2) + psir%psi(4)%a(2)) - & k12 * (psir%psi(2)%a(1) - (0,1) * psir%psi(3)%a(1)) !!! c_psir1%a(1) = ik2 * (-psir%psi(1)%a(4) - psir%psi(4)%a(4) - & psir%psi(2)%a(3) - (0,1) * psir%psi(3)%a(3)) - & km * (psir%psi(1)%a(3) + psir%psi(4)%a(3)) + & kp * (psir%psi(2)%a(4) + (0,1) * psir%psi(3)%a(4)) c_psir1%a(2) = ik2 * (-psir%psi(1)%a(3) - psir%psi(2)%a(4) + & psir%psi(4)%a(3) + (0,1) * psir%psi(3)%a(4)) + & kp * (psir%psi(1)%a(4) - psir%psi(4)%a(4)) - & km * (psir%psi(2)%a(3) - (0,1) * psir%psi(3)%a(3)) c_psir1%a(3) = ik2 * (-psir%psi(1)%a(2) + psir%psi(2)%a(1) + & psir%psi(4)%a(2) + (0,1) * psir%psi(3)%a(1)) + & kp * (psir%psi(1)%a(1) - psir%psi(4)%a(1)) + & km * (psir%psi(2)%a(2) + (0,1) * psir%psi(3)%a(2)) c_psir1%a(4) = ik2 * (-psir%psi(1)%a(1) + psir%psi(2)%a(2) - & psir%psi(4)%a(1) - (0,1) * psir%psi(3)%a(2)) - & km * (psir%psi(1)%a(2) + psir%psi(4)%a(2)) - & kp * (psir%psi(2)%a(1) - (0,1) * psir%psi(3)%a(1)) !!! c_psir2%a(1) = ik1 * (psir%psi(2)%a(3) + psir%psi(1)%a(4) & + psir%psi(4)%a(4) + (0,1) * psir%psi(3)%a(3)) - & ((0,1)*km) * (psir%psi(1)%a(3) + psir%psi(4)%a(3)) & + kp * (psir%psi(3)%a(4) - (0,1) * psir%psi(2)%a(4)) c_psir2%a(2) = ik1 * (psir%psi(1)%a(3) + psir%psi(2)%a(4) - & psir%psi(4)%a(3) - (0,1) * psir%psi(3)%a(4)) - & ((0,1)*kp) * (psir%psi(1)%a(4) - psir%psi(4)%a(4)) & - km * (psir%psi(3)%a(3) + (0,1) * psir%psi(2)%a(3)) c_psir2%a(3) = ik1 * (psir%psi(1)%a(2) - psir%psi(2)%a(1) - & psir%psi(4)%a(2) - (0,1) * psir%psi(3)%a(1)) + & ((0,1)*kp) * (psir%psi(1)%a(1) - psir%psi(4)%a(1)) & + km * (psir%psi(3)%a(2) - (0,1) * psir%psi(2)%a(2)) c_psir2%a(4) = ik1 * (psir%psi(1)%a(1) - psir%psi(2)%a(2) + & psir%psi(4)%a(1) + (0,1) * psir%psi(3)%a(2)) + & ((0,1)*km) * (psir%psi(1)%a(2) + psir%psi(4)%a(2)) - & kp * (psir%psi(3)%a(1) + (0,1) * psir%psi(2)%a(1)) !!! c_psir3%a(1) = k%t * (psir%psi(1)%a(4) + psir%psi(4)%a(4) + & psir%psi(2)%a(3) + (0,1) * psir%psi(3)%a(3)) - & k12 * (psir%psi(1)%a(3) + psir%psi(4)%a(3)) - & k12s * (psir%psi(2)%a(4) + (0,1) * psir%psi(3)%a(4)) c_psir3%a(2) = k%t * (psir%psi(1)%a(3) - psir%psi(4)%a(3) + & psir%psi(2)%a(4) - (0,1) * psir%psi(3)%a(4)) - & k12s * (psir%psi(1)%a(4) - psir%psi(4)%a(4)) - & k12 * (psir%psi(2)%a(3) - (0,1) * psir%psi(3)%a(3)) c_psir3%a(3) = k%t * (-psir%psi(1)%a(2) + psir%psi(2)%a(1) + & psir%psi(4)%a(2) + (0,1) * psir%psi(3)%a(1)) - & k12 * (psir%psi(1)%a(1) - psir%psi(4)%a(1)) + & k12s * (psir%psi(2)%a(2) + (0,1) * psir%psi(3)%a(2)) c_psir3%a(4) = k%t * (-psir%psi(1)%a(1) + psir%psi(2)%a(2) - & psir%psi(4)%a(1) - (0,1) * psir%psi(3)%a(2)) - & k12s * (psir%psi(1)%a(2) + psir%psi(4)%a(2)) + & k12 * (psir%psi(2)%a(1) - (0,1) * psir%psi(3)%a(1)) !!! Because we explicitly multiplied the charge conjugation matrix !!! we have to omit it from the spinor product and take the !!! ordinary product! j%t = 2 * dot_product (conjg (psil%a), c_psir0%a) j%x(1) = 2 * dot_product (conjg (psil%a), c_psir1%a) j%x(2) = 2 * dot_product (conjg (psil%a), c_psir2%a) j%x(3) = 2 * dot_product (conjg (psil%a), c_psir3%a) end function fggkggr @ <>= pure function v_fgr (g, psil, psir, k) result (j) type(vector) :: j complex(kind=default), intent(in) :: g type(vectorspinor), intent(in) :: psir type(bispinor), intent(in) :: psil type(momentum), intent(in) :: k type(vector) :: vk vk = k j = g * fggkggr (psil, psir, vk) end function v_fgr @ <>= pure function vlr_fgr (gl, gr, psil, psir, k) result (j) type(vector) :: j complex(kind=default), intent(in) :: gl, gr type(vectorspinor), intent(in) :: psir type(bispinor), intent(in) :: psil type(bispinor) :: psil_l type(bispinor) :: psil_r type(momentum), intent(in) :: k type(vector) :: vk vk = k psil_l%a(1:2) = psil%a(1:2) psil_l%a(3:4) = 0 psil_r%a(1:2) = 0 psil_r%a(3:4) = psil%a(3:4) j = gl * fggkggr (psil_l, psir, vk) + gr * fggkggr (psil_r, psir, vk) end function vlr_fgr @ \subsection{Gravitino 4-Couplings} <>= public :: f_s2gr, f_svgr, f_slvgr, f_srvgr, f_slrvgr, f_pvgr, f_v2gr, f_v2lrgr @ <>= pure function f_s2gr (g, phi1, phi2, psi) result (phipsi) type(bispinor) :: phipsi type(vectorspinor), intent(in) :: psi complex(kind=default), intent(in) :: g complex(kind=default), intent(in) :: phi1, phi2 phipsi = phi2 * f_potgr (g, phi1, psi) end function f_s2gr @ <>= pure function f_svgr (g, phi, v, grav) result (phigrav) type(bispinor) :: phigrav type(vectorspinor), intent(in) :: grav type(vector), intent(in) :: v complex(kind=default), intent(in) :: g, phi phigrav = (g * phi) * fgvg5gr (grav, v) end function f_svgr @ <>= pure function f_slvgr (gl, phi, v, grav) result (phigrav) type(bispinor) :: phigrav, phidum type(vectorspinor), intent(in) :: grav type(vector), intent(in) :: v complex(kind=default), intent(in) :: gl, phi phidum = (gl * phi) * fgvg5gr (grav, v) phigrav%a(1:2) = phidum%a(1:2) phigrav%a(3:4) = 0 end function f_slvgr @ <>= pure function f_srvgr (gr, phi, v, grav) result (phigrav) type(bispinor) :: phigrav, phidum type(vectorspinor), intent(in) :: grav type(vector), intent(in) :: v complex(kind=default), intent(in) :: gr, phi phidum = (gr * phi) * fgvg5gr (grav, v) phigrav%a(1:2) = 0 phigrav%a(3:4) = phidum%a(3:4) end function f_srvgr @ <>= pure function f_slrvgr (gl, gr, phi, v, grav) result (phigrav) type(bispinor) :: phigrav type(vectorspinor), intent(in) :: grav type(vector), intent(in) :: v complex(kind=default), intent(in) :: gl, gr, phi phigrav = f_slvgr (gl, phi, v, grav) + f_srvgr (gr, phi, v, grav) end function f_slrvgr @ <>= pure function f_pvgr (g, phi, v, grav) result (phigrav) type(bispinor) :: phigrav type(vectorspinor), intent(in) :: grav type(vector), intent(in) :: v complex(kind=default), intent(in) :: g, phi phigrav = (g * phi) * fgvgr (grav, v) end function f_pvgr @ <>= pure function f_v2gr (g, v1, v2, grav) result (psi) type(bispinor) :: psi complex(kind=default), intent(in) :: g type(vectorspinor), intent(in) :: grav type(vector), intent(in) :: v1, v2 psi = g * fggvvgr (v2, grav, v1) end function f_v2gr @ <>= pure function f_v2lrgr (gl, gr, v1, v2, grav) result (psi) type(bispinor) :: psi complex(kind=default), intent(in) :: gl, gr type(vectorspinor), intent(in) :: grav type(vector), intent(in) :: v1, v2 psi = fggvvgr (v2, grav, v1) psi%a(1:2) = gl * psi%a(1:2) psi%a(3:4) = gr * psi%a(3:4) end function f_v2lrgr @ <>= public :: gr_s2f, gr_svf, gr_pvf, gr_slvf, gr_srvf, gr_slrvf, gr_v2f, gr_v2lrf @ <>= pure function gr_s2f (g, phi1, phi2, psi) result (phipsi) type(vectorspinor) :: phipsi type(bispinor), intent(in) :: psi complex(kind=default), intent(in) :: g complex(kind=default), intent(in) :: phi1, phi2 phipsi = phi2 * gr_potf (g, phi1, psi) end function gr_s2f @ <>= pure function gr_svf (g, phi, v, psi) result (phipsi) type(vectorspinor) :: phipsi type(bispinor), intent(in) :: psi type(vector), intent(in) :: v complex(kind=default), intent(in) :: g, phi phipsi = (g * phi) * grkggf (psi, v) end function gr_svf @ <>= pure function gr_slvf (gl, phi, v, psi) result (phipsi) type(vectorspinor) :: phipsi type(bispinor), intent(in) :: psi type(bispinor) :: psi_l type(vector), intent(in) :: v complex(kind=default), intent(in) :: gl, phi psi_l%a(1:2) = psi%a(1:2) psi_l%a(3:4) = 0 phipsi = (gl * phi) * grkggf (psi_l, v) end function gr_slvf @ <>= pure function gr_srvf (gr, phi, v, psi) result (phipsi) type(vectorspinor) :: phipsi type(bispinor), intent(in) :: psi type(bispinor) :: psi_r type(vector), intent(in) :: v complex(kind=default), intent(in) :: gr, phi psi_r%a(1:2) = 0 psi_r%a(3:4) = psi%a(3:4) phipsi = (gr * phi) * grkggf (psi_r, v) end function gr_srvf @ <>= pure function gr_slrvf (gl, gr, phi, v, psi) result (phipsi) type(vectorspinor) :: phipsi type(bispinor), intent(in) :: psi type(vector), intent(in) :: v complex(kind=default), intent(in) :: gl, gr, phi phipsi = gr_slvf (gl, phi, v, psi) + gr_srvf (gr, phi, v, psi) end function gr_slrvf @ <>= pure function gr_pvf (g, phi, v, psi) result (phipsi) type(vectorspinor) :: phipsi type(bispinor), intent(in) :: psi type(vector), intent(in) :: v complex(kind=default), intent(in) :: g, phi phipsi = (g * phi) * grkgf (psi, v) end function gr_pvf @ <>= pure function gr_v2f (g, v1, v2, psi) result (vvpsi) type(vectorspinor) :: vvpsi complex(kind=default), intent(in) :: g type(bispinor), intent(in) :: psi type(vector), intent(in) :: v1, v2 vvpsi = g * grkkggf (v2, psi, v1) end function gr_v2f @ <>= pure function gr_v2lrf (gl, gr, v1, v2, psi) result (vvpsi) type(vectorspinor) :: vvpsi complex(kind=default), intent(in) :: gl, gr type(bispinor), intent(in) :: psi type(bispinor) :: psi_l, psi_r type(vector), intent(in) :: v1, v2 psi_l%a(1:2) = psi%a(1:2) psi_l%a(3:4) = 0 psi_r%a(1:2) = 0 psi_r%a(3:4) = psi%a(3:4) vvpsi = gl * grkkggf (v2, psi_l, v1) + gr * grkkggf (v2, psi_r, v1) end function gr_v2lrf @ <>= public :: s2_grf, s2_fgr, sv1_grf, sv2_grf, sv1_fgr, sv2_fgr, & slv1_grf, slv2_grf, slv1_fgr, slv2_fgr, & srv1_grf, srv2_grf, srv1_fgr, srv2_fgr, & slrv1_grf, slrv2_grf, slrv1_fgr, slrv2_fgr, & pv1_grf, pv2_grf, pv1_fgr, pv2_fgr, v2_grf, v2_fgr, & v2lr_grf, v2lr_fgr @ <>= pure function s2_grf (g, gravbar, phi, psi) result (j) complex(kind=default) :: j complex(kind=default), intent(in) :: g, phi type(vectorspinor), intent(in) :: gravbar type(bispinor), intent(in) :: psi j = phi * pot_grf (g, gravbar, psi) end function s2_grf @ <>= pure function s2_fgr (g, psibar, phi, grav) result (j) complex(kind=default) :: j complex(kind=default), intent(in) :: g, phi type(bispinor), intent(in) :: psibar type(vectorspinor), intent(in) :: grav j = phi * pot_fgr (g, psibar, grav) end function s2_fgr @ <>= pure function sv1_grf (g, gravbar, v, psi) result (j) complex(kind=default) :: j complex(kind=default), intent(in) :: g type(vectorspinor), intent(in) :: gravbar type(bispinor), intent(in) :: psi type(vector), intent(in) :: v j = g * grg5vgf (gravbar, psi, v) end function sv1_grf @ <>= pure function slv1_grf (gl, gravbar, v, psi) result (j) complex(kind=default) :: j complex(kind=default), intent(in) :: gl type(vectorspinor), intent(in) :: gravbar type(bispinor), intent(in) :: psi type(bispinor) :: psi_l type(vector), intent(in) :: v psi_l%a(1:2) = psi%a(1:2) psi_l%a(3:4) = 0 j = gl * grg5vgf (gravbar, psi_l, v) end function slv1_grf @ <>= pure function srv1_grf (gr, gravbar, v, psi) result (j) complex(kind=default) :: j complex(kind=default), intent(in) :: gr type(vectorspinor), intent(in) :: gravbar type(bispinor), intent(in) :: psi type(bispinor) :: psi_r type(vector), intent(in) :: v psi_r%a(1:2) = 0 psi_r%a(3:4) = psi%a(3:4) j = gr * grg5vgf (gravbar, psi_r, v) end function srv1_grf @ <>= pure function slrv1_grf (gl, gr, gravbar, v, psi) result (j) complex(kind=default) :: j complex(kind=default), intent(in) :: gl, gr type(vectorspinor), intent(in) :: gravbar type(bispinor), intent(in) :: psi type(bispinor) :: psi_l, psi_r type(vector), intent(in) :: v psi_l%a(1:2) = psi%a(1:2) psi_l%a(3:4) = 0 psi_r%a(1:2) = 0 psi_r%a(3:4) = psi%a(3:4) j = gl * grg5vgf (gravbar, psi_l, v) + gr * grg5vgf (gravbar, psi_r, v) end function slrv1_grf @ \begin{subequations} \begin{align} C \gamma^0 \gamma^0 = - C \gamma^1 \gamma^1 = - C \gamma^2 \gamma^2 = C \gamma^3 \gamma^3 = C &= \begin{pmatrix} 0 & 1 & 0 & 0 \\ -1 & 0 & 0 & 0 \\ 0 & 0 & 0 & -1 \\ 0 & 0 & 1 & 0 \end{pmatrix} \\ C \gamma^0 \gamma^1 = - C \gamma^1 \gamma^0 &= \begin{pmatrix} -1 & 0 & 0 & 0 \\ 0 & 1 & 0 & 0 \\ 0 & 0 & -1 & 0 \\ 0 & 0 & 0 & 1 \end{pmatrix} \\ C \gamma^0 \gamma^2 = - C \gamma^2 \gamma^0 &= \begin{pmatrix} -\ii & 0 & 0 & 0 \\ 0 & -\ii & 0 & 0 \\ 0 & 0 & -\ii & 0 \\ 0 & 0 & 0 & -\ii \end{pmatrix} \\ C \gamma^0 \gamma^3 = - C \gamma^3 \gamma^0 &= \begin{pmatrix} 0 & 1 & 0 & 0 \\ 1 & 0 & 0 & 0 \\ 0 & 0 & 0 & 1 \\ 0 & 0 & 1 & 0 \end{pmatrix} \\ C \gamma^1 \gamma^2 = - C \gamma^2 \gamma^1 &= \begin{pmatrix} 0 & \ii & 0 & 0 \\ \ii & 0 & 0 & 0 \\ 0 & 0 & 0 & -\ii \\ 0 & 0 & -\ii & 0 \end{pmatrix} \\ C \gamma^1 \gamma^3 = - C \gamma^3 \gamma^1 &= \begin{pmatrix} -1 & 0 & 0 & 0 \\ 0 & -1 & 0 & 0 \\ 0 & 0 & 1 & 0 \\ 0 & 0 & 0 & 1 \end{pmatrix} \\ C \gamma^2 \gamma^3 = - C \gamma^3 \gamma^2 &= \begin{pmatrix} -\ii & 0 & 0 & 0 \\ 0 & \ii & 0 & 0 \\ 0 & 0 & \ii & 0 \\ 0 & 0 & 0 & -\ii \end{pmatrix} \end{align} \end{subequations} @ <>= pure function sv2_grf (g, gravbar, phi, psi) result (j) type(vector) :: j complex(kind=default), intent(in) :: g, phi type(vectorspinor), intent(in) :: gravbar type(bispinor), intent(in) :: psi type(vectorspinor) :: g0_psi, g1_psi, g2_psi, g3_psi g0_psi%psi(1)%a(1:2) = - psi%a(1:2) g0_psi%psi(1)%a(3:4) = psi%a(3:4) g0_psi%psi(2)%a(1) = psi%a(2) g0_psi%psi(2)%a(2) = psi%a(1) g0_psi%psi(2)%a(3) = psi%a(4) g0_psi%psi(2)%a(4) = psi%a(3) g0_psi%psi(3)%a(1) = (0,-1) * psi%a(2) g0_psi%psi(3)%a(2) = (0,1) * psi%a(1) g0_psi%psi(3)%a(3) = (0,-1) * psi%a(4) g0_psi%psi(3)%a(4) = (0,1) * psi%a(3) g0_psi%psi(4)%a(1) = psi%a(1) g0_psi%psi(4)%a(2) = - psi%a(2) g0_psi%psi(4)%a(3) = psi%a(3) g0_psi%psi(4)%a(4) = - psi%a(4) g1_psi%psi(1)%a(1:4) = - g0_psi%psi(2)%a(1:4) g1_psi%psi(2)%a(1:4) = - g0_psi%psi(1)%a(1:4) g1_psi%psi(3)%a(1) = (0,1) * psi%a(1) g1_psi%psi(3)%a(2) = (0,-1) * psi%a(2) g1_psi%psi(3)%a(3) = (0,-1) * psi%a(3) g1_psi%psi(3)%a(4) = (0,1) * psi%a(4) g1_psi%psi(4)%a(1) = - psi%a(2) g1_psi%psi(4)%a(2) = psi%a(1) g1_psi%psi(4)%a(3) = psi%a(4) g1_psi%psi(4)%a(4) = - psi%a(3) g2_psi%psi(1)%a(1:4) = - g0_psi%psi(3)%a(1:4) g2_psi%psi(2)%a(1:4) = - g1_psi%psi(3)%a(1:4) g2_psi%psi(3)%a(1:4) = - g0_psi%psi(1)%a(1:4) g2_psi%psi(4)%a(1) = (0,1) * psi%a(2) g2_psi%psi(4)%a(2) = (0,1) * psi%a(1) g2_psi%psi(4)%a(3) = (0,-1) * psi%a(4) g2_psi%psi(4)%a(4) = (0,-1) * psi%a(3) g3_psi%psi(1)%a(1:4) = - g0_psi%psi(4)%a(1:4) g3_psi%psi(2)%a(1:4) = - g1_psi%psi(4)%a(1:4) g3_psi%psi(3)%a(1:4) = - g2_psi%psi(4)%a(1:4) g3_psi%psi(4)%a(1:4) = - g0_psi%psi(1)%a(1:4) j%t = (g * phi) * (gravbar * g0_psi) j%x(1) = (g * phi) * (gravbar * g1_psi) j%x(2) = (g * phi) * (gravbar * g2_psi) j%x(3) = (g * phi) * (gravbar * g3_psi) end function sv2_grf @ <>= pure function slv2_grf (gl, gravbar, phi, psi) result (j) type(vector) :: j complex(kind=default), intent(in) :: gl, phi type(vectorspinor), intent(in) :: gravbar type(bispinor), intent(in) :: psi type(bispinor) :: psi_l psi_l%a(1:2) = psi%a(1:2) psi_l%a(3:4) = 0 j = sv2_grf (gl, gravbar, phi, psi_l) end function slv2_grf @ <>= pure function srv2_grf (gr, gravbar, phi, psi) result (j) type(vector) :: j complex(kind=default), intent(in) :: gr, phi type(vectorspinor), intent(in) :: gravbar type(bispinor), intent(in) :: psi type(bispinor) :: psi_r psi_r%a(1:2) = 0 psi_r%a(3:4) = psi%a(3:4) j = sv2_grf (gr, gravbar, phi, psi_r) end function srv2_grf @ <>= pure function slrv2_grf (gl, gr, gravbar, phi, psi) result (j) type(vector) :: j complex(kind=default), intent(in) :: gl, gr, phi type(vectorspinor), intent(in) :: gravbar type(bispinor), intent(in) :: psi type(bispinor) :: psi_l, psi_r psi_l%a(1:2) = psi%a(1:2) psi_l%a(3:4) = 0 psi_r%a(1:2) = 0 psi_r%a(3:4) = psi%a(3:4) j = sv2_grf (gl, gravbar, phi, psi_l) + sv2_grf (gr, gravbar, phi, psi_r) end function slrv2_grf @ <>= pure function sv1_fgr (g, psibar, v, grav) result (j) complex(kind=default) :: j complex(kind=default), intent(in) :: g type(bispinor), intent(in) :: psibar type(vectorspinor), intent(in) :: grav type(vector), intent(in) :: v j = g * fg5gkgr (psibar, grav, v) end function sv1_fgr @ <>= pure function slv1_fgr (gl, psibar, v, grav) result (j) complex(kind=default) :: j complex(kind=default), intent(in) :: gl type(bispinor), intent(in) :: psibar type(bispinor) :: psibar_l type(vectorspinor), intent(in) :: grav type(vector), intent(in) :: v psibar_l%a(1:2) = psibar%a(1:2) psibar_l%a(3:4) = 0 j = gl * fg5gkgr (psibar_l, grav, v) end function slv1_fgr @ <>= pure function srv1_fgr (gr, psibar, v, grav) result (j) complex(kind=default) :: j complex(kind=default), intent(in) :: gr type(bispinor), intent(in) :: psibar type(bispinor) :: psibar_r type(vectorspinor), intent(in) :: grav type(vector), intent(in) :: v psibar_r%a(1:2) = 0 psibar_r%a(3:4) = psibar%a(3:4) j = gr * fg5gkgr (psibar_r, grav, v) end function srv1_fgr @ <>= pure function slrv1_fgr (gl, gr, psibar, v, grav) result (j) complex(kind=default) :: j complex(kind=default), intent(in) :: gl, gr type(bispinor), intent(in) :: psibar type(bispinor) :: psibar_l, psibar_r type(vectorspinor), intent(in) :: grav type(vector), intent(in) :: v psibar_l%a(1:2) = psibar%a(1:2) psibar_l%a(3:4) = 0 psibar_r%a(1:2) = 0 psibar_r%a(3:4) = psibar%a(3:4) j = gl * fg5gkgr (psibar_l, grav, v) + gr * fg5gkgr (psibar_r, grav, v) end function slrv1_fgr @ <>= pure function sv2_fgr (g, psibar, phi, grav) result (j) type(vector) :: j complex(kind=default), intent(in) :: g, phi type(bispinor), intent(in) :: psibar type(vectorspinor), intent(in) :: grav type(bispinor) :: g0_grav, g1_grav, g2_grav, g3_grav g0_grav%a(1) = -grav%psi(1)%a(1) + grav%psi(2)%a(2) - & (0,1) * grav%psi(3)%a(2) + grav%psi(4)%a(1) g0_grav%a(2) = -grav%psi(1)%a(2) + grav%psi(2)%a(1) + & (0,1) * grav%psi(3)%a(1) - grav%psi(4)%a(2) g0_grav%a(3) = grav%psi(1)%a(3) + grav%psi(2)%a(4) - & (0,1) * grav%psi(3)%a(4) + grav%psi(4)%a(3) g0_grav%a(4) = grav%psi(1)%a(4) + grav%psi(2)%a(3) + & (0,1) * grav%psi(3)%a(3) - grav%psi(4)%a(4) !!! g1_grav%a(1) = grav%psi(1)%a(2) - grav%psi(2)%a(1) + & (0,1) * grav%psi(3)%a(1) - grav%psi(4)%a(2) g1_grav%a(2) = grav%psi(1)%a(1) - grav%psi(2)%a(2) - & (0,1) * grav%psi(3)%a(2) + grav%psi(4)%a(1) g1_grav%a(3) = grav%psi(1)%a(4) + grav%psi(2)%a(3) - & (0,1) * grav%psi(3)%a(3) + grav%psi(4)%a(4) g1_grav%a(4) = grav%psi(1)%a(3) + grav%psi(2)%a(4) + & (0,1) * grav%psi(3)%a(4) - grav%psi(4)%a(3) !!! g2_grav%a(1) = (0,1) * (-grav%psi(1)%a(2) - grav%psi(2)%a(1) + & grav%psi(4)%a(2)) - grav%psi(3)%a(1) g2_grav%a(2) = (0,1) * (grav%psi(1)%a(1) + grav%psi(2)%a(2) + & grav%psi(4)%a(1)) - grav%psi(3)%a(2) g2_grav%a(3) = (0,1) * (-grav%psi(1)%a(4) + grav%psi(2)%a(3) - & grav%psi(4)%a(4)) + grav%psi(3)%a(3) g2_grav%a(4) = (0,1) * (grav%psi(1)%a(3) - grav%psi(2)%a(4) - & grav%psi(4)%a(3)) + grav%psi(3)%a(4) !!! g3_grav%a(1) = -grav%psi(1)%a(2) + grav%psi(2)%a(2) - & (0,1) * grav%psi(3)%a(2) - grav%psi(4)%a(1) g3_grav%a(2) = grav%psi(1)%a(1) - grav%psi(2)%a(1) - & (0,1) * grav%psi(3)%a(1) - grav%psi(4)%a(2) g3_grav%a(3) = -grav%psi(1)%a(2) - grav%psi(2)%a(4) + & (0,1) * grav%psi(3)%a(4) + grav%psi(4)%a(3) g3_grav%a(4) = -grav%psi(1)%a(4) + grav%psi(2)%a(3) + & (0,1) * grav%psi(3)%a(3) + grav%psi(4)%a(4) j%t = (g * phi) * (psibar * g0_grav) j%x(1) = (g * phi) * (psibar * g1_grav) j%x(2) = (g * phi) * (psibar * g2_grav) j%x(3) = (g * phi) * (psibar * g3_grav) end function sv2_fgr @ <>= pure function slv2_fgr (gl, psibar, phi, grav) result (j) type(vector) :: j complex(kind=default), intent(in) :: gl, phi type(bispinor), intent(in) :: psibar type(bispinor) :: psibar_l type(vectorspinor), intent(in) :: grav psibar_l%a(1:2) = psibar%a(1:2) psibar_l%a(3:4) = 0 j = sv2_fgr (gl, psibar_l, phi, grav) end function slv2_fgr @ <>= pure function srv2_fgr (gr, psibar, phi, grav) result (j) type(vector) :: j complex(kind=default), intent(in) :: gr, phi type(bispinor), intent(in) :: psibar type(bispinor) :: psibar_r type(vectorspinor), intent(in) :: grav psibar_r%a(1:2) = 0 psibar_r%a(3:4) = psibar%a(3:4) j = sv2_fgr (gr, psibar_r, phi, grav) end function srv2_fgr @ <>= pure function slrv2_fgr (gl, gr, psibar, phi, grav) result (j) type(vector) :: j complex(kind=default), intent(in) :: gl, gr, phi type(bispinor), intent(in) :: psibar type(bispinor) :: psibar_l, psibar_r type(vectorspinor), intent(in) :: grav psibar_l%a(1:2) = psibar%a(1:2) psibar_l%a(3:4) = 0 psibar_r%a(1:2) = 0 psibar_r%a(3:4) = psibar%a(3:4) j = sv2_fgr (gl, psibar_l, phi, grav) + sv2_fgr (gr, psibar_r, phi, grav) end function slrv2_fgr @ <>= pure function pv1_grf (g, gravbar, v, psi) result (j) complex(kind=default) :: j complex(kind=default), intent(in) :: g type(vectorspinor), intent(in) :: gravbar type(bispinor), intent(in) :: psi type(vector), intent(in) :: v j = g * grvgf (gravbar, psi, v) end function pv1_grf @ <>= pure function pv2_grf (g, gravbar, phi, psi) result (j) type(vector) :: j complex(kind=default), intent(in) :: g, phi type(vectorspinor), intent(in) :: gravbar type(bispinor), intent(in) :: psi type(bispinor) :: g5_psi g5_psi%a(1:2) = - psi%a(1:2) g5_psi%a(3:4) = psi%a(3:4) j = sv2_grf (g, gravbar, phi, g5_psi) end function pv2_grf @ <>= pure function pv1_fgr (g, psibar, v, grav) result (j) complex(kind=default) :: j complex(kind=default), intent(in) :: g type(bispinor), intent(in) :: psibar type(vectorspinor), intent(in) :: grav type(vector), intent(in) :: v j = g * fgkgr (psibar, grav, v) end function pv1_fgr @ <>= pure function pv2_fgr (g, psibar, phi, grav) result (j) type(vector) :: j complex(kind=default), intent(in) :: g, phi type(vectorspinor), intent(in) :: grav type(bispinor), intent(in) :: psibar type(bispinor) :: psibar_g5 psibar_g5%a(1:2) = - psibar%a(1:2) psibar_g5%a(3:4) = psibar%a(3:4) j = sv2_fgr (g, psibar_g5, phi, grav) end function pv2_fgr @ <>= pure function v2_grf (g, gravbar, v, psi) result (j) type(vector) :: j complex(kind=default), intent(in) :: g type(vectorspinor), intent(in) :: gravbar type(bispinor), intent(in) :: psi type(vector), intent(in) :: v j = -g * grkgggf (gravbar, psi, v) end function v2_grf @ <>= pure function v2lr_grf (gl, gr, gravbar, v, psi) result (j) type(vector) :: j complex(kind=default), intent(in) :: gl, gr type(vectorspinor), intent(in) :: gravbar type(bispinor), intent(in) :: psi type(bispinor) :: psi_l, psi_r type(vector), intent(in) :: v psi_l%a(1:2) = psi%a(1:2) psi_l%a(3:4) = 0 psi_r%a(1:2) = 0 psi_r%a(3:4) = psi%a(3:4) j = -(gl * grkgggf (gravbar, psi_l, v) + gr * grkgggf (gravbar, psi_r, v)) end function v2lr_grf @ <>= pure function v2_fgr (g, psibar, v, grav) result (j) type(vector) :: j complex(kind=default), intent(in) :: g type(vectorspinor), intent(in) :: grav type(bispinor), intent(in) :: psibar type(vector), intent(in) :: v j = -g * fggkggr (psibar, grav, v) end function v2_fgr @ <>= pure function v2lr_fgr (gl, gr, psibar, v, grav) result (j) type(vector) :: j complex(kind=default), intent(in) :: gl, gr type(vectorspinor), intent(in) :: grav type(bispinor), intent(in) :: psibar type(bispinor) :: psibar_l, psibar_r type(vector), intent(in) :: v psibar_l%a(1:2) = psibar%a(1:2) psibar_l%a(3:4) = 0 psibar_r%a(1:2) = 0 psibar_r%a(3:4) = psibar%a(3:4) j = -(gl * fggkggr (psibar_l, grav, v) + gr * fggkggr (psibar_r, grav, v)) end function v2lr_fgr @ \subsection{On Shell Wave Functions} <>= public :: u, v, ghost @ \begin{subequations} \begin{align} \chi_+(\vec p) &= \frac{1}{\sqrt{2|\vec p|(|\vec p|+p_3)}} \begin{pmatrix} |\vec p|+p_3 \\ p_1 + \ii p_2 \end{pmatrix} \\ \chi_-(\vec p) &= \frac{1}{\sqrt{2|\vec p|(|\vec p|+p_3)}} \begin{pmatrix} - p_1 + \ii p_2 \\ |\vec p|+p_3 \end{pmatrix} \end{align} \end{subequations} @ \begin{equation} u_\pm(p) = \begin{pmatrix} \sqrt{p_0\mp|\vec p|} \cdot \chi_\pm(\vec p) \\ \sqrt{p_0\pm|\vec p|} \cdot \chi_\pm(\vec p) \end{pmatrix} \end{equation} <>= pure function u (mass, p, s) result (psi) type(bispinor) :: psi real(kind=default), intent(in) :: mass type(momentum), intent(in) :: p integer, intent(in) :: s complex(kind=default), dimension(2) :: chip, chim real(kind=default) :: pabs, norm, delta, m m = abs(mass) pabs = sqrt (dot_product (p%x, p%x)) if (m < epsilon (m) * pabs) then delta = 0 else delta = sqrt (max (p%t - pabs, 0._default)) end if if (pabs + p%x(3) <= 1000 * epsilon (pabs) * pabs) then chip = (/ cmplx ( 0.0, 0.0, kind=default), & cmplx ( 1.0, 0.0, kind=default) /) chim = (/ cmplx (-1.0, 0.0, kind=default), & cmplx ( 0.0, 0.0, kind=default) /) else norm = 1 / sqrt (2*pabs*(pabs + p%x(3))) chip = norm * (/ cmplx (pabs + p%x(3), kind=default), & cmplx (p%x(1), p%x(2), kind=default) /) chim = norm * (/ cmplx (-p%x(1), p%x(2), kind=default), & cmplx (pabs + p%x(3), kind=default) /) end if if (s > 0) then psi%a(1:2) = delta * chip psi%a(3:4) = sqrt (p%t + pabs) * chip else psi%a(1:2) = sqrt (p%t + pabs) * chim psi%a(3:4) = delta * chim end if pabs = m ! make the compiler happy and use m if (mass < 0) then psi%a(1:2) = - imago * psi%a(1:2) psi%a(3:4) = + imago * psi%a(3:4) end if end function u @ \begin{equation} v_\pm(p) = \begin{pmatrix} \mp\sqrt{p_0\pm|\vec p|} \cdot \chi_\mp(\vec p) \\ \pm\sqrt{p_0\mp|\vec p|} \cdot \chi_\mp(\vec p) \end{pmatrix} \end{equation} <>= pure function v (mass, p, s) result (psi) type(bispinor) :: psi real(kind=default), intent(in) :: mass type(momentum), intent(in) :: p integer, intent(in) :: s complex(kind=default), dimension(2) :: chip, chim real(kind=default) :: pabs, norm, delta, m pabs = sqrt (dot_product (p%x, p%x)) m = abs(mass) if (m < epsilon (m) * pabs) then delta = 0 else delta = sqrt (max (p%t - pabs, 0._default)) end if if (pabs + p%x(3) <= 1000 * epsilon (pabs) * pabs) then chip = (/ cmplx ( 0.0, 0.0, kind=default), & cmplx ( 1.0, 0.0, kind=default) /) chim = (/ cmplx (-1.0, 0.0, kind=default), & cmplx ( 0.0, 0.0, kind=default) /) else norm = 1 / sqrt (2*pabs*(pabs + p%x(3))) chip = norm * (/ cmplx (pabs + p%x(3), kind=default), & cmplx (p%x(1), p%x(2), kind=default) /) chim = norm * (/ cmplx (-p%x(1), p%x(2), kind=default), & cmplx (pabs + p%x(3), kind=default) /) end if if (s > 0) then psi%a(1:2) = - sqrt (p%t + pabs) * chim psi%a(3:4) = delta * chim else psi%a(1:2) = delta * chip psi%a(3:4) = - sqrt (p%t + pabs) * chip end if pabs = m ! make the compiler happy and use m if (mass < 0) then psi%a(1:2) = - imago * psi%a(1:2) psi%a(3:4) = + imago * psi%a(3:4) end if end function v @ <>= pure function ghost (m, p, s) result (psi) type(bispinor) :: psi real(kind=default), intent(in) :: m type(momentum), intent(in) :: p integer, intent(in) :: s psi%a(:) = 0 select case (s) case (1) psi%a(1) = 1 psi%a(2:4) = 0 case (2) psi%a(1) = 0 psi%a(2) = 1 psi%a(3:4) = 0 case (3) psi%a(1:2) = 0 psi%a(3) = 1 psi%a(4) = 0 case (4) psi%a(1:3) = 0 psi%a(4) = 1 case (5) psi%a(1) = 1.4 psi%a(2) = - 2.3 psi%a(3) = - 71.5 psi%a(4) = 0.1 end select end function ghost @ \subsection{Off Shell Wave Functions} This is the same as for the Dirac fermions except that the expressions for [ubar] and [vbar] are missing. <>= public :: brs_u, brs_v @ In momentum space we have: \begin{equation} brs u(p)=(-i) (\fmslash p-m)u(p) \end{equation} <>= pure function brs_u (m, p, s) result (dpsi) type(bispinor) :: dpsi, psi real(kind=default), intent(in) :: m type(momentum), intent(in) :: p integer, intent(in) :: s type (vector)::vp complex(kind=default), parameter :: one = (1, 0) vp=p psi=u(m,p,s) dpsi=cmplx(0.0,-1.0)*(f_vf(one,vp,psi)-m*psi) end function brs_u @ \begin{equation} brs v(p)=i (\fmslash p+m)v(p) \end{equation} <>= pure function brs_v (m, p, s) result (dpsi) type(bispinor) :: dpsi, psi real(kind=default), intent(in) :: m type(momentum), intent(in) :: p integer, intent(in) :: s type (vector)::vp complex(kind=default), parameter :: one = (1, 0) vp=p psi=v(m,p,s) dpsi=cmplx(0.0,1.0)*(f_vf(one,vp,psi)+m*psi) end function brs_v @ \subsection{Propagators} <>= public :: pr_psi, pr_grav public :: pj_psi, pg_psi @ \begin{equation} \frac{\ii(-\fmslash{p}+m)}{p^2-m^2+\ii m\Gamma}\psi \end{equation} NB: the sign of the momentum comes about because all momenta are treated as \emph{outgoing} and the particle charge flow is therefore opposite to the momentum. <>= pure function pr_psi (p, m, w, cms, psi) result (ppsi) type(bispinor) :: ppsi type(momentum), intent(in) :: p real(kind=default), intent(in) :: m, w type(bispinor), intent(in) :: psi logical, intent(in) :: cms type(vector) :: vp complex(kind=default), parameter :: one = (1, 0) complex(kind=default) :: num_mass vp = p if (cms) then num_mass = sqrt(cmplx(m**2, -m*w, kind=default)) else num_mass = cmplx (m, 0, kind=default) end if ppsi = (1 / cmplx (p*p - m**2, m*w, kind=default)) & * (- f_vf (one, vp, psi) + num_mass * psi) end function pr_psi @ \begin{equation} \sqrt{\frac{\pi}{M\Gamma}} (-\fmslash{p}+m)\psi \end{equation} <>= pure function pj_psi (p, m, w, psi) result (ppsi) type(bispinor) :: ppsi type(momentum), intent(in) :: p real(kind=default), intent(in) :: m, w type(bispinor), intent(in) :: psi type(vector) :: vp complex(kind=default), parameter :: one = (1, 0) vp = p ppsi = (0, -1) * sqrt (PI / m / w) * (- f_vf (one, vp, psi) + m * psi) end function pj_psi @ <>= pure function pg_psi (p, m, w, psi) result (ppsi) type(bispinor) :: ppsi type(momentum), intent(in) :: p real(kind=default), intent(in) :: m, w type(bispinor), intent(in) :: psi type(vector) :: vp complex(kind=default), parameter :: one = (1, 0) vp = p ppsi = gauss (p*p, m, w) * (- f_vf (one, vp, psi) + m * psi) end function pg_psi @ \begin{equation} \dfrac{\ii\biggl\{(-\fmslash{p} + m)\left(-\eta_{\mu\nu} + \dfrac{p_\mu p_\nu}{m^2}\right) + \dfrac{1}{3} \left(\gamma_\mu -\dfrac{p_\mu}{m}\right) (\fmslash{p} + m)\left(\gamma_\nu - \dfrac{p_\nu}{m}\right)\biggr\}}{p^2 - m^2 + \ii m \Gamma} \; \psi^\nu \end{equation} <>= pure function pr_grav (p, m, w, grav) result (propgrav) type(vectorspinor) :: propgrav type(momentum), intent(in) :: p real(kind=default), intent(in) :: m, w type(vectorspinor), intent(in) :: grav type(vector) :: vp type(bispinor) :: pgrav, ggrav, ggrav1, ggrav2, ppgrav type(vectorspinor) :: etagrav_dum, etagrav, pppgrav, & gg_grav_dum, gg_grav complex(kind=default), parameter :: one = (1, 0) real(kind=default) :: minv integer :: i vp = p minv = 1/m pgrav = p%t * grav%psi(1) - p%x(1) * grav%psi(2) - & p%x(2) * grav%psi(3) - p%x(3) * grav%psi(4) ggrav%a(1) = grav%psi(1)%a(3) - grav%psi(2)%a(4) + (0,1) * & grav%psi(3)%a(4) - grav%psi(4)%a(3) ggrav%a(2) = grav%psi(1)%a(4) - grav%psi(2)%a(3) - (0,1) * & grav%psi(3)%a(3) + grav%psi(4)%a(4) ggrav%a(3) = grav%psi(1)%a(1) + grav%psi(2)%a(2) - (0,1) * & grav%psi(3)%a(2) + grav%psi(4)%a(1) ggrav%a(4) = grav%psi(1)%a(2) + grav%psi(2)%a(1) + (0,1) * & grav%psi(3)%a(1) - grav%psi(4)%a(2) ggrav1 = ggrav - minv * pgrav ggrav2 = f_vf (one, vp, ggrav1) + m * ggrav - pgrav ppgrav = (-minv**2) * f_vf (one, vp, pgrav) + minv * pgrav do i = 1, 4 etagrav_dum%psi(i) = f_vf (one, vp, grav%psi(i)) end do etagrav = etagrav_dum - m * grav pppgrav%psi(1) = p%t * ppgrav pppgrav%psi(2) = p%x(1) * ppgrav pppgrav%psi(3) = p%x(2) * ppgrav pppgrav%psi(4) = p%x(3) * ppgrav gg_grav_dum%psi(1) = p%t * ggrav2 gg_grav_dum%psi(2) = p%x(1) * ggrav2 gg_grav_dum%psi(3) = p%x(2) * ggrav2 gg_grav_dum%psi(4) = p%x(3) * ggrav2 gg_grav = gr_potf (one, one, ggrav2) - minv * gg_grav_dum propgrav = (1 / cmplx (p*p - m**2, m*w, kind=default)) * & (etagrav + pppgrav + (1/3.0_default) * gg_grav) end function pr_grav @ \section{Polarization vectorspinors} Here we construct the wavefunctions for (massive) gravitinos out of the wavefunctions of (massive) vectorbosons and (massive) Majorana fermions. \begin{subequations} \begin{align} \psi^\mu_{(u; 3/2)} (k) &= \; \epsilon^\mu_+ (k) \cdot u (k, +) \\ \psi^\mu_{(u; 1/2)} (k) &= \; \sqrt{\dfrac{1}{3}} \, \epsilon^\mu_+ (k) \cdot u (k, -) + \sqrt{\dfrac{2}{3}} \, \epsilon^\mu_0 (k) \cdot u (k, +) \\ \psi^\mu_{(u; -1/2)} (k) &= \; \sqrt{\dfrac{2}{3}} \, \epsilon^\mu_0 (k) \cdot u (k, -) + \sqrt{\dfrac{1}{3}} \, \epsilon^\mu_- (k) \cdot u (k, +) \\ \psi^\mu_{(u; -3/2)} (k) &= \; \epsilon^\mu_- (k) \cdot u (k, -) \end{align} \end{subequations} and in the same manner for $\psi^\mu_{(v; s)}$ with $u$ replaced by $v$ and with the conjugated polarization vectors. These gravitino wavefunctions obey the Dirac equation, they are transverse and they fulfill the irreducibility condition \begin{equation} \gamma_\mu \psi^\mu_{(u/v; s)} = 0 . \end{equation} <<[[omega_vspinor_polarizations.f90]]>>= <> module omega_vspinor_polarizations use kinds use constants use omega_vectors use omega_bispinors use omega_bispinor_couplings use omega_vectorspinors implicit none <> integer, parameter, public :: omega_vspinor_pols_2010_01_A = 0 contains <> end module omega_vspinor_polarizations @ <>= public :: ueps, veps private :: eps private :: outer_product @ Here we implement the polarization vectors for vectorbosons with trigonometric functions, without the rotating of components done in HELAS~\cite{HELAS}. These are only used for generating the polarization vectorspinors. \begin{subequations} \begin{align} \epsilon^\mu_+(k) &= \frac{- e^{+\ii\phi}}{\sqrt{2}} \left(0; \cos\theta\cos\phi - \ii\sin\phi, \cos\theta\sin\phi + \ii\cos\phi, -\sin\theta \right) \\ \epsilon^\mu_-(k) &= \frac{e^{-\ii\phi}}{\sqrt{2}} \left(0; \cos\theta\cos\phi + \ii \sin\phi, \cos\theta\sin\phi - \ii \cos\phi, - \sin\theta \right) \\ \epsilon^\mu_0(k) &= \frac{1}{m} \left(|\vec k|; k^0\sin\theta\cos\phi, k^0\sin\theta\sin\phi, k^0\cos\theta\right) \end{align} \end{subequations} Determining the mass from the momenta is a numerically haphazardous for light particles. Therefore, we accept some redundancy and pass the mass explicitely. For the case that the momentum lies totally in the $z$-direction we take the convention $\cos\phi=1$ and $\sin\phi=0$. <>= pure function eps (mass, k, s) result (e) type(vector) :: e real(kind=default), intent(in) :: mass type(momentum), intent(in) :: k integer, intent(in) :: s real(kind=default) :: kabs, kabs2, sqrt2, m real(kind=default) :: cos_phi, sin_phi, cos_th, sin_th complex(kind=default) :: epiphi, emiphi sqrt2 = sqrt (2.0_default) kabs2 = dot_product (k%x, k%x) m = abs(mass) if (kabs2 > 0) then kabs = sqrt (kabs2) if ((k%x(1) == 0) .and. (k%x(2) == 0)) then cos_phi = 1 sin_phi = 0 else cos_phi = k%x(1) / sqrt(k%x(1)**2 + k%x(2)**2) sin_phi = k%x(2) / sqrt(k%x(1)**2 + k%x(2)**2) end if cos_th = k%x(3) / kabs sin_th = sqrt(1 - cos_th**2) epiphi = cos_phi + (0,1) * sin_phi emiphi = cos_phi - (0,1) * sin_phi e%t = 0 e%x = 0 select case (s) case (1) e%x(1) = epiphi * (-cos_th * cos_phi + (0,1) * sin_phi) / sqrt2 e%x(2) = epiphi * (-cos_th * sin_phi - (0,1) * cos_phi) / sqrt2 e%x(3) = epiphi * ( sin_th / sqrt2) case (-1) e%x(1) = emiphi * ( cos_th * cos_phi + (0,1) * sin_phi) / sqrt2 e%x(2) = emiphi * ( cos_th * sin_phi - (0,1) * cos_phi) / sqrt2 e%x(3) = emiphi * (-sin_th / sqrt2) case (0) if (m > 0) then e%t = kabs / m e%x = k%t / (m*kabs) * k%x end if case (4) if (m > 0) then e = (1 / m) * k else e = (1 / k%t) * k end if end select else !!! for particles in their rest frame defined to be !!! polarized along the 3-direction e%t = 0 e%x = 0 select case (s) case (1) e%x(1) = cmplx ( - 1, 0, kind=default) / sqrt2 e%x(2) = cmplx ( 0, 1, kind=default) / sqrt2 case (-1) e%x(1) = cmplx ( 1, 0, kind=default) / sqrt2 e%x(2) = cmplx ( 0, 1, kind=default) / sqrt2 case (0) if (m > 0) then e%x(3) = 1 end if case (4) if (m > 0) then e = (1 / m) * k else e = (1 / k%t) * k end if end select end if end function eps @ <>= pure function ueps (m, k, s) result (t) type(vectorspinor) :: t real(kind=default), intent(in) :: m type(momentum), intent(in) :: k integer, intent(in) :: s integer :: i type(vector) :: ep, e0, em type(bispinor) :: up, um do i = 1, 4 t%psi(i)%a = 0 end do select case (s) case (2) ep = eps (m, k, 1) up = u (m, k, 1) t = outer_product (ep, up) case (1) ep = eps (m, k, 1) e0 = eps (m, k, 0) up = u (m, k, 1) um = u (m, k, -1) t = (1 / sqrt (3.0_default)) * (outer_product (ep, um) & + sqrt (2.0_default) * outer_product (e0, up)) case (-1) e0 = eps (m, k, 0) em = eps (m, k, -1) up = u (m, k, 1) um = u (m, k, -1) t = (1 / sqrt (3.0_default)) * (sqrt (2.0_default) * & outer_product (e0, um) + outer_product (em, up)) case (-2) em = eps (m, k, -1) um = u (m, k, -1) t = outer_product (em, um) end select end function ueps @ <>= pure function veps (m, k, s) result (t) type(vectorspinor) :: t real(kind=default), intent(in) :: m type(momentum), intent(in) :: k integer, intent(in) :: s integer :: i type(vector) :: ep, e0, em type(bispinor) :: vp, vm do i = 1, 4 t%psi(i)%a = 0 end do select case (s) case (2) ep = conjg(eps (m, k, 1)) vp = v (m, k, 1) t = outer_product (ep, vp) case (1) ep = conjg(eps (m, k, 1)) e0 = conjg(eps (m, k, 0)) vp = v (m, k, 1) vm = v (m, k, -1) t = (1 / sqrt (3.0_default)) * (outer_product (ep, vm) & + sqrt (2.0_default) * outer_product (e0, vp)) case (-1) e0 = conjg(eps (m, k, 0)) em = conjg(eps (m, k, -1)) vp = v (m, k, 1) vm = v (m, k, -1) t = (1 / sqrt (3.0_default)) * (sqrt (2.0_default) & * outer_product (e0, vm) + outer_product (em, vp)) case (-2) em = conjg(eps (m, k, -1)) vm = v (m, k, -1) t = outer_product (em, vm) end select end function veps @ <>= pure function outer_product (ve, sp) result (vs) type(vectorspinor) :: vs type(vector), intent(in) :: ve type(bispinor), intent(in) :: sp integer :: i vs%psi(1)%a(1:4) = ve%t * sp%a(1:4) do i = 1, 3 vs%psi((i+1))%a(1:4) = ve%x(i) * sp%a(1:4) end do end function outer_product @ \section{Color} <<[[omega_color.f90]]>>= <> module omega_color use kinds implicit none private <> <> integer, parameter, public :: omega_color_2010_01_A = 0 contains <> end module omega_color @ \subsection{Color Sum} <>= public :: omega_color_factor type omega_color_factor integer :: i1, i2 real(kind=default) :: factor end type omega_color_factor @ <>= public :: omega_color_sum @ The [[!$omp]] instruction will result in parallel code if compiled with support for OpenMP otherwise it is ignored. @ <>= <<[[pure]] unless OpenMP>> function omega_color_sum (flv, hel, amp, cf) result (amp2) complex(kind=default) :: amp2 integer, intent(in) :: flv, hel complex(kind=default), dimension(:,:,:), intent(in) :: amp type(omega_color_factor), dimension(:), intent(in) :: cf integer :: n amp2 = 0 !$omp parallel do reduction(+:amp2) do n = 1, size (cf) amp2 = amp2 + cf(n)%factor * & amp(flv,cf(n)%i1,hel) * conjg (amp(flv,cf(n)%i2,hel)) end do !$omp end parallel do end function omega_color_sum @ In the bytecode for the OVM, we only save the symmetric part of the color factor table. This almost halves the size of $n$ gluon amplitudes for $n>6$. For $2\,\to\,(5,6)\,g$ the reduced color factor table still amounts for $\sim(75,93)\%$ of the bytecode, making it desirable to omit it completely by computing it dynamically to reduce memory requirements. Note that $2\text{Re}(A_{i_1}A_{i_2}^*)=A_{i_1}A_{i_2}^*+A_{i_2}A_{i_1}^*$. <>= public :: ovm_color_sum @ <>= <<[[pure]] unless OpenMP>> function ovm_color_sum (flv, hel, amp, cf) result (amp2) real(kind=default) :: amp2 integer, intent(in) :: flv, hel complex(kind=default), dimension(:,:,:), intent(in) :: amp type(omega_color_factor), dimension(:), intent(in) :: cf integer :: n amp2 = 0 !$omp parallel do reduction(+:amp2) do n = 1, size (cf) if (cf(n)%i1 == cf(n)%i2) then amp2 = amp2 + cf(n)%factor * & real(amp(flv,cf(n)%i1,hel) * conjg(amp(flv,cf(n)%i2,hel))) else amp2 = amp2 + cf(n)%factor * 2 * & real(amp(flv,cf(n)%i1,hel) * conjg(amp(flv,cf(n)%i2,hel))) end if end do !$omp end parallel do end function ovm_color_sum @ \section{Utilities} <<[[omega_utils.f90]]>>= <> module omega_utils use kinds use omega_vectors use omega_polarizations implicit none private <> <> integer, parameter, public :: omega_utils_2010_01_A = 0 contains <> end module omega_utils @ \subsection{Helicity Selection Rule Heuristics} <>= public :: omega_update_helicity_selection @ <>= pure subroutine omega_update_helicity_selection & (count, amp, max_abs, sum_abs, mask, threshold, cutoff, mask_dirty) integer, intent(inout) :: count complex(kind=default), dimension(:,:,:), intent(in) :: amp real(kind=default), dimension(:), intent(inout) :: max_abs real(kind=default), intent(inout) :: sum_abs logical, dimension(:), intent(inout) :: mask real(kind=default), intent(in) :: threshold integer, intent(in) :: cutoff logical, intent(out) :: mask_dirty integer :: h real(kind=default) :: avg mask_dirty = .false. if (threshold > 0) then count = count + 1 if (count <= cutoff) then forall (h = lbound (amp, 3) : ubound (amp, 3)) max_abs(h) = max (max_abs(h), maxval (abs (amp(:,:,h)))) end forall sum_abs = sum_abs + sum (abs (amp)) if (count == cutoff) then avg = sum_abs / size (amp) / cutoff mask = max_abs >= threshold * epsilon (avg) * avg mask_dirty = .true. end if end if end if end subroutine omega_update_helicity_selection @ \subsection{Diagnostics} <>= public :: omega_report_helicity_selection @ We shoul try to use [[msg_message]] from WHIZARD's [[diagnostics]] module, but this would spoil independent builds. <>= subroutine omega_report_helicity_selection (mask, spin_states, threshold, unit) logical, dimension(:), intent(in) :: mask integer, dimension(:,:), intent(in) :: spin_states real(kind=default), intent(in) :: threshold integer, intent(in), optional :: unit integer :: u integer :: h, i if (present(unit)) then u = unit else u = 6 end if if (u >= 0) then write (unit = u, & fmt = "('| ','Contributing Helicity Combinations: ', I5, ' of ', I5)") & count (mask), size (mask) write (unit = u, & fmt = "('| ','Threshold: amp / avg > ', E9.2, ' = ', E9.2, ' * epsilon()')") & threshold * epsilon (threshold), threshold i = 0 do h = 1, size (mask) if (mask(h)) then i = i + 1 write (unit = u, fmt = "('| ',I4,': ',20I4)") i, spin_states (:, h) end if end do end if end subroutine omega_report_helicity_selection @ <>= public :: omega_ward_warn, omega_ward_panic @ The O'Mega amplitudes have only one particle off shell and are the sum of \emph{all} possible diagrams with the other particles on-shell. \begin{dubious} The problem with these gauge checks is that are numerically very small amplitudes that vanish analytically and that violate transversality. The hard part is to determine the thresholds that make threse tests usable. \end{dubious} <>= subroutine omega_ward_warn (name, m, k, e) character(len=*), intent(in) :: name real(kind=default), intent(in) :: m type(momentum), intent(in) :: k type(vector), intent(in) :: e type(vector) :: ek real(kind=default) :: abs_eke, abs_ek_abs_e ek = eps (m, k, 4) abs_eke = abs (ek * e) abs_ek_abs_e = abs (ek) * abs (e) print *, name, ":", abs_eke / abs_ek_abs_e, abs (ek), abs (e) if (abs_eke > 1000 * epsilon (abs_ek_abs_e)) then print *, "O'Mega: warning: non-transverse vector field: ", & name, ":", abs_eke / abs_ek_abs_e, abs (e) end if end subroutine omega_ward_warn @ <>= subroutine omega_ward_panic (name, m, k, e) character(len=*), intent(in) :: name real(kind=default), intent(in) :: m type(momentum), intent(in) :: k type(vector), intent(in) :: e type(vector) :: ek real(kind=default) :: abs_eke, abs_ek_abs_e ek = eps (m, k, 4) abs_eke = abs (ek * e) abs_ek_abs_e = abs (ek) * abs (e) if (abs_eke > 1000 * epsilon (abs_ek_abs_e)) then print *, "O'Mega: panic: non-transverse vector field: ", & name, ":", abs_eke / abs_ek_abs_e, abs (e) stop end if end subroutine omega_ward_panic @ <>= public :: omega_slavnov_warn, omega_slavnov_panic @ <>= subroutine omega_slavnov_warn (name, m, k, e, phi) character(len=*), intent(in) :: name real(kind=default), intent(in) :: m type(momentum), intent(in) :: k type(vector), intent(in) :: e complex(kind=default), intent(in) :: phi type(vector) :: ek real(kind=default) :: abs_eke, abs_ek_abs_e ek = eps (m, k, 4) abs_eke = abs (ek * e - phi) abs_ek_abs_e = abs (ek) * abs (e) print *, name, ":", abs_eke / abs_ek_abs_e, abs (ek), abs (e) if (abs_eke > 1000 * epsilon (abs_ek_abs_e)) then print *, "O'Mega: warning: non-transverse vector field: ", & name, ":", abs_eke / abs_ek_abs_e, abs (e) end if end subroutine omega_slavnov_warn @ <>= subroutine omega_slavnov_panic (name, m, k, e, phi) character(len=*), intent(in) :: name real(kind=default), intent(in) :: m type(momentum), intent(in) :: k type(vector), intent(in) :: e complex(kind=default), intent(in) :: phi type(vector) :: ek real(kind=default) :: abs_eke, abs_ek_abs_e ek = eps (m, k, 4) abs_eke = abs (ek * e - phi) abs_ek_abs_e = abs (ek) * abs (e) if (abs_eke > 1000 * epsilon (abs_ek_abs_e)) then print *, "O'Mega: panic: non-transverse vector field: ", & name, ":", abs_eke / abs_ek_abs_e, abs (e) stop end if end subroutine omega_slavnov_panic @ <>= public :: omega_check_arguments_warn, omega_check_arguments_panic @ <>= subroutine omega_check_arguments_warn (n, k) integer, intent(in) :: n real(kind=default), dimension(0:,:), intent(in) :: k integer :: i i = size(k,dim=1) if (i /= 4) then print *, "O'Mega: warning: wrong # of dimensions:", i end if i = size(k,dim=2) if (i /= n) then print *, "O'Mega: warning: wrong # of momenta:", i, & ", expected", n end if end subroutine omega_check_arguments_warn @ <>= subroutine omega_check_arguments_panic (n, k) integer, intent(in) :: n real(kind=default), dimension(0:,:), intent(in) :: k logical :: error integer :: i error = .false. i = size(k,dim=1) if (i /= n) then print *, "O'Mega: warning: wrong # of dimensions:", i error = .true. end if i = size(k,dim=2) if (i /= n) then print *, "O'Mega: warning: wrong # of momenta:", i, & ", expected", n error = .true. end if if (error) then stop end if end subroutine omega_check_arguments_panic @ <>= public :: omega_check_helicities_warn, omega_check_helicities_panic private :: omega_check_helicity @ <>= function omega_check_helicity (m, smax, s) result (error) real(kind=default), intent(in) :: m integer, intent(in) :: smax, s logical :: error select case (smax) case (0) error = (s /= 0) case (1) error = (abs (s) /= 1) case (2) if (m == 0.0_default) then error = .not. (abs (s) == 1 .or. abs (s) == 4) else error = .not. (abs (s) <= 1 .or. abs (s) == 4) end if case (4) error = .true. case default error = .true. end select end function omega_check_helicity @ <>= subroutine omega_check_helicities_warn (m, smax, s) real(kind=default), dimension(:), intent(in) :: m integer, dimension(:), intent(in) :: smax, s integer :: i do i = 1, size (m) if (omega_check_helicity (m(i), smax(i), s(i))) then print *, "O'Mega: warning: invalid helicity", s(i) end if end do end subroutine omega_check_helicities_warn @ <>= subroutine omega_check_helicities_panic (m, smax, s) real(kind=default), dimension(:), intent(in) :: m integer, dimension(:), intent(in) :: smax, s logical :: error logical :: error1 integer :: i error = .false. do i = 1, size (m) error1 = omega_check_helicity (m(i), smax(i), s(i)) if (error1) then print *, "O'Mega: panic: invalid helicity", s(i) error = .true. end if end do if (error) then stop end if end subroutine omega_check_helicities_panic @ <>= public :: omega_check_momenta_warn, omega_check_momenta_panic private :: check_momentum_conservation, check_mass_shell @ <>= integer, parameter, private :: MOMENTUM_TOLERANCE = 10000 @ <>= function check_momentum_conservation (k) result (error) real(kind=default), dimension(0:,:), intent(in) :: k logical :: error error = any (abs (sum (k(:,3:), dim = 2) - k(:,1) - k(:,2)) > & MOMENTUM_TOLERANCE * epsilon (maxval (abs (k), dim = 2))) if (error) then print *, sum (k(:,3:), dim = 2) - k(:,1) - k(:,2) print *, MOMENTUM_TOLERANCE * epsilon (maxval (abs (k), dim = 2)), & maxval (abs (k), dim = 2) end if end function check_momentum_conservation @ <>= integer, parameter, private :: ON_SHELL_TOLERANCE = 1000000 @ <>= function check_mass_shell (m, k) result (error) real(kind=default), intent(in) :: m real(kind=default), dimension(0:), intent(in) :: k real(kind=default) :: e2 logical :: error e2 = k(1)**2 + k(2)**2 + k(3)**2 + m**2 error = abs (k(0)**2 - e2) > ON_SHELL_TOLERANCE * epsilon (max (k(0)**2, e2)) if (error) then print *, k(0)**2 - e2 print *, ON_SHELL_TOLERANCE * epsilon (max (k(0)**2, e2)), max (k(0)**2, e2) end if end function check_mass_shell @ <>= subroutine omega_check_momenta_warn (m, k) real(kind=default), dimension(:), intent(in) :: m real(kind=default), dimension(0:,:), intent(in) :: k integer :: i if (check_momentum_conservation (k)) then print *, "O'Mega: warning: momentum not conserved" end if do i = 1, size(m) if (check_mass_shell (m(i), k(:,i))) then print *, "O'Mega: warning: particle #", i, "not on-shell" end if end do end subroutine omega_check_momenta_warn @ <>= subroutine omega_check_momenta_panic (m, k) real(kind=default), dimension(:), intent(in) :: m real(kind=default), dimension(0:,:), intent(in) :: k logical :: error logical :: error1 integer :: i error = check_momentum_conservation (k) if (error) then print *, "O'Mega: panic: momentum not conserved" end if do i = 1, size(m) error1 = check_mass_shell (m(i), k(0:,i)) if (error1) then print *, "O'Mega: panic: particle #", i, "not on-shell" error = .true. end if end do if (error) then stop end if end subroutine omega_check_momenta_panic @ \subsection{Obsolete Summation} \subsubsection{Spin/Helicity Summation} <>= public :: omega_sum, omega_sum_nonzero, omega_nonzero private :: state_index @ <>= pure function omega_sum (omega, p, states, fixed) result (sigma) real(kind=default) :: sigma real(kind=default), dimension(0:,:), intent(in) :: p integer, dimension(:), intent(in), optional :: states, fixed <<[[interface]] for O'Mega Amplitude>> integer, dimension(size(p,dim=2)) :: s, nstates integer :: j complex(kind=default) :: a if (present (states)) then nstates = states else nstates = 2 end if sigma = 0 s = -1 sum_spins: do if (present (fixed)) then !!! print *, 's = ', s, ', fixed = ', fixed, ', nstates = ', nstates, & !!! ', fixed|s = ', merge (fixed, s, mask = nstates == 0) a = omega (p, merge (fixed, s, mask = nstates == 0)) else a = omega (p, s) end if sigma = sigma + a * conjg(a) <> end do sum_spins sigma = sigma / num_states (2, nstates(1:2)) end function omega_sum @ We're looping over all spins like a $n$-ary numbers $(-1,\ldots,-1,-1)$, $(-1,\ldots,-1,0)$, $(-1,\ldots,-1,1)$, $(-1,\ldots,0,-1)$, \ldots, $(1,\ldots,1,0)$, $(1,\ldots,1,1)$: <>= do j = size (p, dim = 2), 1, -1 select case (nstates (j)) case (3) ! massive vectors s(j) = modulo (s(j) + 2, 3) - 1 case (2) ! spinors, massless vectors s(j) = - s(j) case (1) ! scalars s(j) = -1 case (0) ! fized spin s(j) = -1 case default ! ??? s(j) = -1 end select if (s(j) /= -1) then cycle sum_spins end if end do exit sum_spins @ The dual operation evaluates an $n$-number: <>= pure function state_index (s, states) result (n) integer, dimension(:), intent(in) :: s integer, dimension(:), intent(in), optional :: states integer :: n integer :: j, p n = 1 p = 1 if (present (states)) then do j = size (s), 1, -1 select case (states(j)) case (3) n = n + p * (s(j) + 1) case (2) n = n + p * (s(j) + 1) / 2 end select p = p * states(j) end do else do j = size (s), 1, -1 n = n + p * (s(j) + 1) / 2 p = p * 2 end do end if end function state_index @ <<[[interface]] for O'Mega Amplitude>>= interface pure function omega (p, s) result (me) use kinds implicit none complex(kind=default) :: me real(kind=default), dimension(0:,:), intent(in) :: p integer, dimension(:), intent(in) :: s end function omega end interface @ <>= public :: num_states @ <>= pure function num_states (n, states) result (ns) integer, intent(in) :: n integer, dimension(:), intent(in), optional :: states integer :: ns if (present (states)) then ns = product (states, mask = states == 2 .or. states == 3) else ns = 2**n end if end function num_states @ \section{\texttt{omega95}} <<[[omega95.f90]]>>= <> module omega95 use constants use omega_spinors use omega_vectors use omega_polarizations use omega_tensors use omega_tensor_polarizations use omega_couplings use omega_spinor_couplings use omega_color use omega_utils public end module omega95 @ \section{\texttt{omega95} Revisited} <<[[omega95_bispinors.f90]]>>= <> module omega95_bispinors use constants use omega_bispinors use omega_vectors use omega_vectorspinors use omega_polarizations use omega_vspinor_polarizations use omega_couplings use omega_bispinor_couplings use omega_color use omega_utils public end module omega95_bispinors @ \section{Testing} <<[[omega_testtools.f90]]>>= <> module omega_testtools use kinds implicit none private real(kind=default), parameter, private :: ABS_THRESHOLD_DEFAULT = 1E-17 real(kind=default), parameter, private :: THRESHOLD_DEFAULT = 0.6 real(kind=default), parameter, private :: THRESHOLD_WARN = 0.8 <> contains <> end module omega_testtools @ Quantify the agreement of two real or complex numbers \begin{equation} \text{agreement}(x,y) = \frac{\ln \Delta(x,y)}{\ln\epsilon} \in[0,1] \end{equation} with \begin{equation} \Delta(x,y) = \frac{|x-y|}{\max(|x|,|y|)} \end{equation} and values outside~$[0,1]$ replaced the closed value in the interval. In other words \begin{itemize} \item $1$ for $x-y=\max(|x|,|y|)\cdot\mathcal{O}(\epsilon)$ and \item $0$~for $x-y=\max(|x|,|y|)\cdot\mathcal{O}(1)$ \end{itemize} with logarithmic interpolation. The cases~$x=0$ and~$y=0$ must be treated separately. <>= public :: agreement interface agreement module procedure agreement_real, agreement_complex, & agreement_real_complex, agreement_complex_real, & agreement_integer_complex, agreement_complex_integer, & agreement_integer_real, agreement_real_integer end interface private :: agreement_real, agreement_complex, & agreement_real_complex, agreement_complex_real, & agreement_integer_complex, agreement_complex_integer, & agreement_integer_real, agreement_real_integer @ <>= elemental function agreement_real (x, y, base) result (a) real(kind=default) :: a real(kind=default), intent(in) :: x, y real(kind=default), intent(in), optional :: base real(kind=default) :: scale, dxy if (present (base)) then scale = max (abs (x), abs (y), abs (base)) else scale = max (abs (x), abs (y)) end if if (ieee_is_nan (x) .or. ieee_is_nan (y)) then a = 0 else if (scale <= 0) then a = -1 else dxy = abs (x - y) / scale if (dxy <= 0.0_default) then a = 1 else a = log (dxy) / log (epsilon (scale)) a = max (0.0_default, min (1.0_default, a)) if (ieee_is_nan (a)) then a = 0 end if end if end if if (ieee_is_nan (a)) then a = 0 end if end function agreement_real @ Poor man's replacement <>= elemental function ieee_is_nan (x) result (yorn) logical :: yorn real (kind=default), intent(in) :: x yorn = (x /= x) end function ieee_is_nan @ <>= elemental function agreement_complex (x, y, base) result (a) real(kind=default) :: a complex(kind=default), intent(in) :: x, y real(kind=default), intent(in), optional :: base real(kind=default) :: scale, dxy if (present (base)) then scale = max (abs (x), abs (y), abs (base)) else scale = max (abs (x), abs (y)) end if if ( ieee_is_nan (real (x, kind=default)) .or. ieee_is_nan (aimag (x)) & .or. ieee_is_nan (real (y, kind=default)) .or. ieee_is_nan (aimag (y))) then a = 0 else if (scale <= 0) then a = -1 else dxy = abs (x - y) / scale if (dxy <= 0.0_default) then a = 1 else a = log (dxy) / log (epsilon (scale)) a = max (0.0_default, min (1.0_default, a)) if (ieee_is_nan (a)) then a = 0 end if end if end if if (ieee_is_nan (a)) then a = 0 end if end function agreement_complex @ <>= elemental function agreement_real_complex (x, y, base) result (a) real(kind=default) :: a real(kind=default), intent(in) :: x complex(kind=default), intent(in) :: y real(kind=default), intent(in), optional :: base a = agreement_complex (cmplx (x, kind=default), y, base) end function agreement_real_complex @ <>= elemental function agreement_complex_real (x, y, base) result (a) real(kind=default) :: a complex(kind=default), intent(in) :: x real(kind=default), intent(in) :: y real(kind=default), intent(in), optional :: base a = agreement_complex (x, cmplx (y, kind=default), base) end function agreement_complex_real @ <>= elemental function agreement_integer_complex (x, y, base) result (a) real(kind=default) :: a integer, intent(in) :: x complex(kind=default), intent(in) :: y real(kind=default), intent(in), optional :: base a = agreement_complex (cmplx (x, kind=default), y, base) end function agreement_integer_complex @ <>= elemental function agreement_complex_integer (x, y, base) result (a) real(kind=default) :: a complex(kind=default), intent(in) :: x integer, intent(in) :: y real(kind=default), intent(in), optional :: base a = agreement_complex (x, cmplx (y, kind=default), base) end function agreement_complex_integer @ <>= elemental function agreement_integer_real (x, y, base) result (a) real(kind=default) :: a integer, intent(in) :: x real(kind=default), intent(in) :: y real(kind=default), intent(in), optional :: base a = agreement_real (real(x, kind=default), y, base) end function agreement_integer_real @ <>= elemental function agreement_real_integer (x, y, base) result (a) real(kind=default) :: a real(kind=default), intent(in) :: x integer, intent(in) :: y real(kind=default), intent(in), optional :: base a = agreement_real (x, real (y, kind=default), base) end function agreement_real_integer @ <>= public:: vanishes interface vanishes module procedure vanishes_real, vanishes_complex end interface private :: vanishes_real, vanishes_complex @ <>= elemental function vanishes_real (x, scale) result (a) real(kind=default) :: a real(kind=default), intent(in) :: x real(kind=default), intent(in), optional :: scale real(kind=default) :: scaled_x if (x == 0.0_default) then a = 1 return else if (ieee_is_nan (x)) then a = 0 return end if scaled_x = x if (present (scale)) then if (scale /= 0) then scaled_x = x / abs (scale) else a = 0 return end if else end if a = log (abs (scaled_x)) / log (epsilon (scaled_x)) a = max (0.0_default, min (1.0_default, a)) if (ieee_is_nan (a)) then a = 0 end if end function vanishes_real @ <>= elemental function vanishes_complex (x, scale) result (a) real(kind=default) :: a complex(kind=default), intent(in) :: x real(kind=default), intent(in), optional :: scale a = vanishes_real (abs (x), scale) end function vanishes_complex @ <>= public :: expect interface expect module procedure expect_integer, expect_real, expect_complex, & expect_real_integer, expect_integer_real, & expect_complex_integer, expect_integer_complex, & expect_complex_real, expect_real_complex end interface private :: expect_integer, expect_real, expect_complex, & expect_real_integer, expect_integer_real, & expect_complex_integer, expect_integer_complex, & expect_complex_real, expect_real_complex @ <>= subroutine expect_integer (x, x0, msg, passed, quiet, buffer, unit) integer, intent(in) :: x, x0 character(len=*), intent(in) :: msg logical, intent(inout), optional :: passed logical, intent(in), optional :: quiet character(len=*), intent(inout), optional :: buffer integer, intent(in), optional :: unit logical :: failed, verbose character(len=*), parameter :: fmt = "(1X,A,': ',A)" character(len=*), parameter :: & fmt_verbose = "(1X,A,': ',A,' [expected ',I6,', got ',I6,']')" failed = .false. verbose = .true. if (present (quiet)) then verbose = .not.quiet end if if (x == x0) then if (verbose) then if (.not. (present (buffer) .or. present (unit))) then write (unit = *, fmt = fmt) msg, "passed" end if if (present (unit)) then write (unit = unit, fmt = fmt) msg, "passed" end if if (present (buffer)) then write (unit = buffer, fmt = fmt) msg, "passed" end if end if else if (.not. (present (buffer) .or. present (unit))) then write (unit = *, fmt = fmt_verbose) msg, "failed", x0, x end if if (present (unit)) then write (unit = unit, fmt = fmt_verbose) msg, "failed", x0, x end if if (present (buffer)) then write (unit = buffer, fmt = fmt_verbose) msg, "failed", x0, x end if failed = .true. end if if (present (passed)) then passed = passed .and. .not.failed end if end subroutine expect_integer @ <>= subroutine expect_real (x, x0, msg, passed, threshold, quiet, abs_threshold) real(kind=default), intent(in) :: x, x0 character(len=*), intent(in) :: msg logical, intent(inout), optional :: passed real(kind=default), intent(in), optional :: threshold real(kind=default), intent(in), optional :: abs_threshold logical, intent(in), optional :: quiet logical :: failed, verbose real(kind=default) :: agreement_threshold, abs_agreement_threshold character(len=*), parameter :: fmt = "(1X,A,': ',A,' at ',I4,'%')" character(len=*), parameter :: fmt_verbose = "(1X,A,': ',A,' at ',I4,'%'," // & "' [expected ',E10.3,', got ',E10.3,']')" real(kind=default) :: a failed = .false. verbose = .true. if (present (quiet)) then verbose = .not.quiet end if if (x == x0) then if (verbose) then write (unit = *, fmt = fmt) msg, "passed", 100 end if else if (x0 == 0) then a = vanishes (x) else a = agreement (x, x0) end if if (present (threshold)) then agreement_threshold = threshold else agreement_threshold = THRESHOLD_DEFAULT end if if (present (abs_threshold)) then abs_agreement_threshold = abs_threshold else abs_agreement_threshold = ABS_THRESHOLD_DEFAULT end if if (a >= agreement_threshold .or. & max(abs(x), abs(x0)) <= abs_agreement_threshold) then if (verbose) then if (a >= THRESHOLD_WARN) then write (unit = *, fmt = fmt) msg, "passed", int (a * 100) else write (unit = *, fmt = fmt_verbose) msg, "passed", int (a * 100), x0, x end if end if else failed = .true. write (unit = *, fmt = fmt_verbose) msg, "failed", int (a * 100), x0, x end if end if if (present (passed)) then passed = passed .and. .not. failed end if end subroutine expect_real @ <>= subroutine expect_complex (x, x0, msg, passed, threshold, quiet, abs_threshold) complex(kind=default), intent(in) :: x, x0 character(len=*), intent(in) :: msg logical, intent(inout), optional :: passed real(kind=default), intent(in), optional :: threshold real(kind=default), intent(in), optional :: abs_threshold logical, intent(in), optional :: quiet logical :: failed, verbose real(kind=default) :: agreement_threshold, abs_agreement_threshold character(len=*), parameter :: fmt = "(1X,A,': ',A,' at ',I4,'%')" character(len=*), parameter :: fmt_verbose = "(1X,A,': ',A,' at ',I4,'%'," // & "' [expected (',E10.3,',',E10.3,'), got (',E10.3,',',E10.3,')]')" character(len=*), parameter :: fmt_phase = "(1X,A,': ',A,' at ',I4,'%'," // & "' [modulus passed at ',I4,'%',', phases ',F5.3,' vs. ',F5.3,']')" real(kind=default) :: a, a_modulus failed = .false. verbose = .true. if (present (quiet)) then verbose = .not.quiet end if if (x == x0) then if (verbose) then write (unit = *, fmt = fmt) msg, "passed", 100 end if else if (x0 == 0) then a = vanishes (x) else a = agreement (x, x0) end if if (present (threshold)) then agreement_threshold = threshold else agreement_threshold = THRESHOLD_DEFAULT end if if (present (abs_threshold)) then abs_agreement_threshold = abs_threshold else abs_agreement_threshold = ABS_THRESHOLD_DEFAULT end if if (a >= agreement_threshold .or. & max(abs(x), abs(x0)) <= abs_agreement_threshold) then if (verbose) then if (a >= THRESHOLD_WARN) then write (unit = *, fmt = fmt) msg, "passed", int (a * 100) else write (unit = *, fmt = fmt_verbose) msg, "passed", int (a * 100), x0, x end if end if else a_modulus = agreement (abs (x), abs (x0)) if (a_modulus >= agreement_threshold) then write (unit = *, fmt = fmt_phase) msg, "failed", int (a * 100), & int (a_modulus * 100), & atan2 (real (x, kind=default), aimag (x)), & atan2 (real (x0, kind=default), aimag (x0)) else write (unit = *, fmt = fmt_verbose) msg, "failed", int (a * 100), x0, x end if failed = .true. end if end if if (present (passed)) then passed = passed .and. .not.failed end if end subroutine expect_complex @ <>= subroutine expect_real_integer (x, x0, msg, passed, threshold, quiet) real(kind=default), intent(in) :: x integer, intent(in) :: x0 character(len=*), intent(in) :: msg real(kind=default), intent(in), optional :: threshold logical, intent(inout), optional :: passed logical, intent(in), optional :: quiet call expect_real (x, real (x0, kind=default), msg, passed, threshold, quiet) end subroutine expect_real_integer @ <>= subroutine expect_integer_real (x, x0, msg, passed, threshold, quiet) integer, intent(in) :: x real(kind=default), intent(in) :: x0 character(len=*), intent(in) :: msg real(kind=default), intent(in), optional :: threshold logical, intent(inout), optional :: passed logical, intent(in), optional :: quiet call expect_real (real (x, kind=default), x0, msg, passed, threshold, quiet) end subroutine expect_integer_real @ <>= subroutine expect_complex_integer (x, x0, msg, passed, threshold, quiet) complex(kind=default), intent(in) :: x integer, intent(in) :: x0 character(len=*), intent(in) :: msg logical, intent(inout), optional :: passed real(kind=default), intent(in), optional :: threshold logical, intent(in), optional :: quiet call expect_complex (x, cmplx (x0, kind=default), msg, passed, threshold, quiet) end subroutine expect_complex_integer @ <>= subroutine expect_integer_complex (x, x0, msg, passed, threshold, quiet) integer, intent(in) :: x complex(kind=default), intent(in) :: x0 character(len=*), intent(in) :: msg logical, intent(inout), optional :: passed real(kind=default), intent(in), optional :: threshold logical, intent(in), optional :: quiet call expect_complex (cmplx (x, kind=default), x0, msg, passed, threshold, quiet) end subroutine expect_integer_complex @ <>= subroutine expect_complex_real (x, x0, msg, passed, threshold, quiet) complex(kind=default), intent(in) :: x real(kind=default), intent(in) :: x0 character(len=*), intent(in) :: msg logical, intent(inout), optional :: passed real(kind=default), intent(in), optional :: threshold logical, intent(in), optional :: quiet call expect_complex (x, cmplx (x0, kind=default), msg, passed, threshold, quiet) end subroutine expect_complex_real @ <>= subroutine expect_real_complex (x, x0, msg, passed, threshold, quiet) real(kind=default), intent(in) :: x complex(kind=default), intent(in) :: x0 character(len=*), intent(in) :: msg logical, intent(inout), optional :: passed real(kind=default), intent(in), optional :: threshold logical, intent(in), optional :: quiet call expect_complex (cmplx (x, kind=default), x0, msg, passed, threshold, quiet) end subroutine expect_real_complex @ <>= public :: expect_zero interface expect_zero module procedure expect_zero_integer, expect_zero_real, expect_zero_complex end interface private :: expect_zero_integer, expect_zero_real, expect_zero_complex @ <>= subroutine expect_zero_integer (x, msg, passed) integer, intent(in) :: x character(len=*), intent(in) :: msg logical, intent(inout), optional :: passed call expect_integer (x, 0, msg, passed) end subroutine expect_zero_integer @ <>= subroutine expect_zero_real (x, scale, msg, passed, threshold, quiet) real(kind=default), intent(in) :: x, scale character(len=*), intent(in) :: msg logical, intent(inout), optional :: passed real(kind=default), intent(in), optional :: threshold logical, intent(in), optional :: quiet logical :: failed, verbose real(kind=default) :: agreement_threshold character(len=*), parameter :: fmt = "(1X,A,': ',A,' at ',I4,'%')" character(len=*), parameter :: fmt_verbose = "(1X,A,': ',A,' at ',I4,'%'," // & "' [expected 0 (relative to ',E10.3,') got ',E10.3,']')" real(kind=default) :: a failed = .false. verbose = .true. if (present (quiet)) then verbose = .not.quiet end if if (x == 0) then if (verbose) then write (unit = *, fmt = fmt) msg, "passed", 100 end if else a = vanishes (x, scale = scale) if (present (threshold)) then agreement_threshold = threshold else agreement_threshold = THRESHOLD_DEFAULT end if if (a >= agreement_threshold) then if (verbose) then if (a >= THRESHOLD_WARN) then write (unit = *, fmt = fmt) msg, "passed", int (a * 100) else write (unit = *, fmt = fmt_verbose) msg, "passed", int (a * 100), scale, x end if end if else failed = .true. write (unit = *, fmt = fmt_verbose) msg, "failed", int (a * 100), scale, x end if end if if (present (passed)) then passed = passed .and. .not.failed end if end subroutine expect_zero_real @ <>= subroutine expect_zero_complex (x, scale, msg, passed, threshold, quiet) complex(kind=default), intent(in) :: x real(kind=default), intent(in) :: scale character(len=*), intent(in) :: msg logical, intent(inout), optional :: passed real(kind=default), intent(in), optional :: threshold logical, intent(in), optional :: quiet call expect_zero_real (abs (x), scale, msg, passed, threshold, quiet) end subroutine expect_zero_complex @ <>= subroutine print_matrix (a) complex(kind=default), dimension(:,:), intent(in) :: a integer :: row do row = 1, size (a, dim=1) write (unit = *, fmt = "(10(tr2, f5.2, '+', f5.2, 'I'))") a(row,:) end do end subroutine print_matrix @ <>= public :: print_matrix @ <<[[test_omega95.f90]]>>= <> program test_omega95 use kinds use omega95 use omega_testtools implicit none real(kind=default) :: m, pabs, qabs, w real(kind=default), dimension(0:3) :: r complex(kind=default) :: c_one, c_nil type(momentum) :: p, q, p0 type(vector) :: vp, vq, vtest, v0 type(tensor) :: ttest type(spinor) :: test_psi, test_spinor1, test_spinor2 type(conjspinor) :: test_psibar, test_conjspinor1, test_conjspinor2 integer, dimension(8) :: date_time integer :: rsize, i logical :: passed call date_and_time (values = date_time) call random_seed (size = rsize) call random_seed (put = spread (product (date_time), dim = 1, ncopies = rsize)) w = 1.4142 c_one = 1.0_default c_nil = 0.0_default m = 13 pabs = 42 qabs = 137 call random_number (r) vtest%t = cmplx (10.0_default * r(0), kind=default) vtest%x(1:3) = cmplx (10.0_default * r(1:3), kind=default) ttest = vtest.tprod.vtest call random_momentum (p, pabs, m) call random_momentum (q, qabs, m) call random_momentum (p0, 0.0_default, m) vp = p vq = q v0 = p0 passed = .true. <> if (.not. passed) then stop 1 end if end program test_omega95 @ <>= print *, "*** Checking the equations of motion ***:" call expect (abs(f_vf(c_one,vp,u(m,p,+1))-m*u(m,p,+1)), 0, "|[p-m]u(+)|=0", passed) call expect (abs(f_vf(c_one,vp,u(m,p,-1))-m*u(m,p,-1)), 0, "|[p-m]u(-)|=0", passed) call expect (abs(f_vf(c_one,vp,v(m,p,+1))+m*v(m,p,+1)), 0, "|[p+m]v(+)|=0", passed) call expect (abs(f_vf(c_one,vp,v(m,p,-1))+m*v(m,p,-1)), 0, "|[p+m]v(-)|=0", passed) call expect (abs(f_fv(c_one,ubar(m,p,+1),vp)-m*ubar(m,p,+1)), 0, "|ubar(+)[p-m]|=0", passed) call expect (abs(f_fv(c_one,ubar(m,p,-1),vp)-m*ubar(m,p,-1)), 0, "|ubar(-)[p-m]|=0", passed) call expect (abs(f_fv(c_one,vbar(m,p,+1),vp)+m*vbar(m,p,+1)), 0, "|vbar(+)[p+m]|=0", passed) call expect (abs(f_fv(c_one,vbar(m,p,-1),vp)+m*vbar(m,p,-1)), 0, "|vbar(-)[p+m]|=0", passed) print *, "*** Checking the equations of motion for negative mass***:" call expect (abs(f_vf(c_one,vp,u(-m,p,+1))+m*u(-m,p,+1)), 0, "|[p+m]u(+)|=0", passed) call expect (abs(f_vf(c_one,vp,u(-m,p,-1))+m*u(-m,p,-1)), 0, "|[p+m]u(-)|=0", passed) call expect (abs(f_vf(c_one,vp,v(-m,p,+1))-m*v(-m,p,+1)), 0, "|[p-m]v(+)|=0", passed) call expect (abs(f_vf(c_one,vp,v(-m,p,-1))-m*v(-m,p,-1)), 0, "|[p-m]v(-)|=0", passed) call expect (abs(f_fv(c_one,ubar(-m,p,+1),vp)+m*ubar(-m,p,+1)), 0, "|ubar(+)[p+m]|=0", passed) call expect (abs(f_fv(c_one,ubar(-m,p,-1),vp)+m*ubar(-m,p,-1)), 0, "|ubar(-)[p+m]|=0", passed) call expect (abs(f_fv(c_one,vbar(-m,p,+1),vp)-m*vbar(-m,p,+1)), 0, "|vbar(+)[p-m]|=0", passed) call expect (abs(f_fv(c_one,vbar(-m,p,-1),vp)-m*vbar(-m,p,-1)), 0, "|vbar(-)[p-m]|=0", passed) @ <>= print *, "*** Spin Sums" test_psi%a = [one, two, three, four] test_spinor1 = f_vf (c_one, vp, test_psi) + m * test_psi test_spinor2 = u (m, p, +1) * (ubar (m, p, +1) * test_psi) + & u (m, p, -1) * (ubar (m, p, -1) * test_psi) do i = 1, 4 call expect (test_spinor1%a(i), test_spinor2%a(i), "(p+m)1=(sum u ubar)1", passed) end do test_spinor1 = f_vf (c_one, vp, test_psi) - m * test_psi test_spinor2 = v (m, p, +1) * (vbar (m, p, +1) * test_psi) + & v (m, p, -1) * (vbar (m, p, -1) * test_psi) do i = 1, 4 call expect (test_spinor1%a(i), test_spinor2%a(i), "(p-m)1=(sum v vbar)1", passed) end do test_psibar%a = [one, two, three, four] test_conjspinor1 = f_fv (c_one, test_psibar, vp) - m * test_psibar test_conjspinor2 = (test_psibar * v (m, p, +1)) * vbar (m, p, +1) + & (test_psibar * v (m, p, -1)) * vbar (m, p, -1) do i = 1, 4 call expect (test_conjspinor1%a(i), test_conjspinor2%a(i), "(p-m)1=(sum v vbar)1", passed) end do @ <>= print *, "*** Checking the normalization ***:" call expect (ubar(m,p,+1)*u(m,p,+1), +2*m, "ubar(+)*u(+)=+2m", passed) call expect (ubar(m,p,-1)*u(m,p,-1), +2*m, "ubar(-)*u(-)=+2m", passed) call expect (vbar(m,p,+1)*v(m,p,+1), -2*m, "vbar(+)*v(+)=-2m", passed) call expect (vbar(m,p,-1)*v(m,p,-1), -2*m, "vbar(-)*v(-)=-2m", passed) call expect (ubar(m,p,+1)*v(m,p,+1), 0, "ubar(+)*v(+)=0 ", passed) call expect (ubar(m,p,-1)*v(m,p,-1), 0, "ubar(-)*v(-)=0 ", passed) call expect (vbar(m,p,+1)*u(m,p,+1), 0, "vbar(+)*u(+)=0 ", passed) call expect (vbar(m,p,-1)*u(m,p,-1), 0, "vbar(-)*u(-)=0 ", passed) print *, "*** Checking the normalization for negative masses***:" call expect (ubar(-m,p,+1)*u(-m,p,+1), -2*m, "ubar(+)*u(+)=-2m", passed) call expect (ubar(-m,p,-1)*u(-m,p,-1), -2*m, "ubar(-)*u(-)=-2m", passed) call expect (vbar(-m,p,+1)*v(-m,p,+1), +2*m, "vbar(+)*v(+)=+2m", passed) call expect (vbar(-m,p,-1)*v(-m,p,-1), +2*m, "vbar(-)*v(-)=+2m", passed) call expect (ubar(-m,p,+1)*v(-m,p,+1), 0, "ubar(+)*v(+)=0 ", passed) call expect (ubar(-m,p,-1)*v(-m,p,-1), 0, "ubar(-)*v(-)=0 ", passed) call expect (vbar(-m,p,+1)*u(-m,p,+1), 0, "vbar(+)*u(+)=0 ", passed) call expect (vbar(-m,p,-1)*u(-m,p,-1), 0, "vbar(-)*u(-)=0 ", passed) @ <>= print *, "*** Checking the currents ***:" call expect (abs(v_ff(c_one,ubar(m,p,+1),u(m,p,+1))-2*vp), 0, "ubar(+).V.u(+)=2p", passed) call expect (abs(v_ff(c_one,ubar(m,p,-1),u(m,p,-1))-2*vp), 0, "ubar(-).V.u(-)=2p", passed) call expect (abs(v_ff(c_one,vbar(m,p,+1),v(m,p,+1))-2*vp), 0, "vbar(+).V.v(+)=2p", passed) call expect (abs(v_ff(c_one,vbar(m,p,-1),v(m,p,-1))-2*vp), 0, "vbar(-).V.v(-)=2p", passed) print *, "*** Checking the currents for negative masses***:" call expect (abs(v_ff(c_one,ubar(-m,p,+1),u(-m,p,+1))-2*vp), 0, "ubar(+).V.u(+)=2p", passed) call expect (abs(v_ff(c_one,ubar(-m,p,-1),u(-m,p,-1))-2*vp), 0, "ubar(-).V.u(-)=2p", passed) call expect (abs(v_ff(c_one,vbar(-m,p,+1),v(-m,p,+1))-2*vp), 0, "vbar(+).V.v(+)=2p", passed) call expect (abs(v_ff(c_one,vbar(-m,p,-1),v(-m,p,-1))-2*vp), 0, "vbar(-).V.v(-)=2p", passed) @ <>= print *, "*** Checking current conservation ***:" call expect ((vp-vq)*v_ff(c_one,ubar(m,p,+1),u(m,q,+1)), 0, "d(ubar(+).V.u(+))=0", passed) call expect ((vp-vq)*v_ff(c_one,ubar(m,p,-1),u(m,q,-1)), 0, "d(ubar(-).V.u(-))=0", passed) call expect ((vp-vq)*v_ff(c_one,vbar(m,p,+1),v(m,q,+1)), 0, "d(vbar(+).V.v(+))=0", passed) call expect ((vp-vq)*v_ff(c_one,vbar(m,p,-1),v(m,q,-1)), 0, "d(vbar(-).V.v(-))=0", passed) print *, "*** Checking current conservation for negative masses***:" call expect ((vp-vq)*v_ff(c_one,ubar(-m,p,+1),u(-m,q,+1)), 0, "d(ubar(+).V.u(+))=0", passed) call expect ((vp-vq)*v_ff(c_one,ubar(-m,p,-1),u(-m,q,-1)), 0, "d(ubar(-).V.u(-))=0", passed) call expect ((vp-vq)*v_ff(c_one,vbar(-m,p,+1),v(-m,q,+1)), 0, "d(vbar(+).V.v(+))=0", passed) call expect ((vp-vq)*v_ff(c_one,vbar(-m,p,-1),v(-m,q,-1)), 0, "d(vbar(-).V.v(-))=0", passed) @ <>= if (m == 0) then print *, "*** Checking axial current conservation ***:" call expect ((vp-vq)*a_ff(c_one,ubar(m,p,+1),u(m,q,+1)), 0, "d(ubar(+).A.u(+))=0", passed) call expect ((vp-vq)*a_ff(c_one,ubar(m,p,-1),u(m,q,-1)), 0, "d(ubar(-).A.u(-))=0", passed) call expect ((vp-vq)*a_ff(c_one,vbar(m,p,+1),v(m,q,+1)), 0, "d(vbar(+).A.v(+))=0", passed) call expect ((vp-vq)*a_ff(c_one,vbar(m,p,-1),v(m,q,-1)), 0, "d(vbar(-).A.v(-))=0", passed) end if @ <>= print *, "*** Checking implementation of the sigma vertex funktions ***:" call expect ((vp*tvam_ff(c_one,c_nil,ubar(m,p,+1),u(m,q,+1),q) - (p*q-m**2)*(ubar(m,p,+1)*u(m,q,+1))), 0, & "p*[ubar(p,+).(Isigma*q).u(q,+)] - (p*q-m^2)*ubar(p,+).u(q,+) = 0", passed) call expect ((vp*tvam_ff(c_one,c_nil,ubar(m,p,-1),u(m,q,-1),q) - (p*q-m**2)*(ubar(m,p,-1)*u(m,q,-1))), 0, & "p*[ubar(p,-).(Isigma*q).u(q,-)] - (p*q-m^2)*ubar(p,-).u(q,-) = 0", passed) call expect ((vp*tvam_ff(c_one,c_nil,vbar(m,p,+1),v(m,q,+1),q) - (p*q-m**2)*(vbar(m,p,+1)*v(m,q,+1))), 0, & "p*[vbar(p,+).(Isigma*q).v(q,+)] - (p*q-m^2)*vbar(p,+).v(q,+) = 0", passed) call expect ((vp*tvam_ff(c_one,c_nil,vbar(m,p,-1),v(m,q,-1),q) - (p*q-m**2)*(vbar(m,p,-1)*v(m,q,-1))), 0, & "p*[vbar(p,-).(Isigma*q).v(q,-)] - (p*q-m^2)*vbar(p,-).v(q,-) = 0", passed) call expect ((ubar(m,p,+1)*f_tvamf(c_one,c_nil,vp,u(m,q,+1),q) - (p*q-m**2)*(ubar(m,p,+1)*u(m,q,+1))), 0, & "ubar(p,+).[p*(Isigma*q).u(q,+)] - (p*q-m^2)*ubar(p,+).u(q,+) = 0", passed) call expect ((ubar(m,p,-1)*f_tvamf(c_one,c_nil,vp,u(m,q,-1),q) - (p*q-m**2)*(ubar(m,p,-1)*u(m,q,-1))), 0, & "ubar(p,-).[p*(Isigma*q).u(q,-)] - (p*q-m^2)*ubar(p,-).u(q,-) = 0", passed) call expect ((vbar(m,p,+1)*f_tvamf(c_one,c_nil,vp,v(m,q,+1),q) - (p*q-m**2)*(vbar(m,p,+1)*v(m,q,+1))), 0, & "vbar(p,+).[p*(Isigma*q).v(q,+)] - (p*q-m^2)*vbar(p,+).v(q,+) = 0", passed) call expect ((vbar(m,p,-1)*f_tvamf(c_one,c_nil,vp,v(m,q,-1),q) - (p*q-m**2)*(vbar(m,p,-1)*v(m,q,-1))), 0, & "vbar(p,-).[p*(Isigma*q).v(q,-)] - (p*q-m^2)*vbar(p,-).v(q,-) = 0", passed) call expect ((f_ftvam(c_one,c_nil,ubar(m,p,+1),vp,q)*u(m,q,+1) - (p*q-m**2)*(ubar(m,p,+1)*u(m,q,+1))), 0, & "[ubar(p,+).p*(Isigma*q)].u(q,+) - (p*q-m^2)*ubar(p,+).u(q,+) = 0", passed) call expect ((f_ftvam(c_one,c_nil,ubar(m,p,-1),vp,q)*u(m,q,-1) - (p*q-m**2)*(ubar(m,p,-1)*u(m,q,-1))), 0, & "[ubar(p,-).p*(Isigma*q)].u(q,-) - (p*q-m^2)*ubar(p,-).u(q,-) = 0", passed) call expect ((f_ftvam(c_one,c_nil,vbar(m,p,+1),vp,q)*v(m,q,+1) - (p*q-m**2)*(vbar(m,p,+1)*v(m,q,+1))), 0, & "[vbar(p,+).p*(Isigma*q)].v(q,+) - (p*q-m^2)*vbar(p,+).v(q,+) = 0", passed) call expect ((f_ftvam(c_one,c_nil,vbar(m,p,-1),vp,q)*v(m,q,-1) - (p*q-m**2)*(vbar(m,p,-1)*v(m,q,-1))), 0, & "[vbar(p,-).p*(Isigma*q)].v(q,-) - (p*q-m^2)*vbar(p,-).v(q,-) = 0", passed) call expect ((vp*tvam_ff(c_nil,c_one,ubar(m,p,+1),u(m,q,+1),q) - (p*q+m**2)*p_ff(c_one,ubar(m,p,+1),u(m,q,+1))), 0, & "p*[ubar(p,+).(Isigma*q).g5.u(q,+)] - (p*q+m^2)*ubar(p,+).g5.u(q,+) = 0", passed) call expect ((vp*tvam_ff(c_nil,c_one,ubar(m,p,-1),u(m,q,-1),q) - (p*q+m**2)*p_ff(c_one,ubar(m,p,-1),u(m,q,-1))), 0, & "p*[ubar(p,-).(Isigma*q).g5.u(q,-)] - (p*q+m^2)*ubar(p,-).g5.u(q,-) = 0", passed) call expect ((vp*tvam_ff(c_nil,c_one,vbar(m,p,+1),v(m,q,+1),q) - (p*q+m**2)*p_ff(c_one,vbar(m,p,+1),v(m,q,+1))), 0, & "p*[vbar(p,+).(Isigma*q).g5.v(q,+)] - (p*q+m^2)*vbar(p,+).g5.v(q,+) = 0", passed) call expect ((vp*tvam_ff(c_nil,c_one,vbar(m,p,-1),v(m,q,-1),q) - (p*q+m**2)*p_ff(c_one,vbar(m,p,-1),v(m,q,-1))), 0, & "p*[vbar(p,-).(Isigma*q).g5.v(q,-)] - (p*q+m^2)*vbar(p,-).g5.v(q,-) = 0", passed) call expect ((ubar(m,p,+1)*f_tvamf(c_nil,c_one,vp,u(m,q,+1),q) - (p*q+m**2)*p_ff(c_one,ubar(m,p,+1),u(m,q,+1))), 0, & "p*[ubar(p,+).(Isigma*q).g5.u(q,+)] - (p*q+m^2)*ubar(p,+).g5.u(q,+) = 0", passed) call expect ((ubar(m,p,-1)*f_tvamf(c_nil,c_one,vp,u(m,q,-1),q) - (p*q+m**2)*p_ff(c_one,ubar(m,p,-1),u(m,q,-1))), 0, & "p*[ubar(p,-).(Isigma*q).g5.u(q,-)] - (p*q+m^2)*ubar(p,-).g5.u(q,-) = 0", passed) call expect ((vbar(m,p,+1)*f_tvamf(c_nil,c_one,vp,v(m,q,+1),q) - (p*q+m**2)*p_ff(c_one,vbar(m,p,+1),v(m,q,+1))), 0, & "p*[vbar(p,+).(Isigma*q).g5.v(q,+)] - (p*q+m^2)*vbar(p,+).g5.v(q,+) = 0", passed) call expect ((vbar(m,p,-1)*f_tvamf(c_nil,c_one,vp,v(m,q,-1),q) - (p*q+m**2)*p_ff(c_one,vbar(m,p,-1),v(m,q,-1))), 0, & "p*[vbar(p,-).(Isigma*q).g5.v(q,-)] - (p*q+m^2)*vbar(p,-).g5.v(q,-) = 0", passed) call expect ((f_ftvam(c_nil,c_one,ubar(m,p,+1),vp,q)*u(m,q,+1) - (p*q+m**2)*p_ff(c_one,ubar(m,p,+1),u(m,q,+1))), 0, & "p*[ubar(p,+).(Isigma*q).g5.u(q,+)] - (p*q+m^2)*ubar(p,+).g5.u(q,+) = 0", passed) call expect ((f_ftvam(c_nil,c_one,ubar(m,p,-1),vp,q)*u(m,q,-1) - (p*q+m**2)*p_ff(c_one,ubar(m,p,-1),u(m,q,-1))), 0, & "p*[ubar(p,-).(Isigma*q).g5.u(q,-)] - (p*q+m^2)*ubar(p,-).g5.u(q,-) = 0", passed) call expect ((f_ftvam(c_nil,c_one,vbar(m,p,+1),vp,q)*v(m,q,+1) - (p*q+m**2)*p_ff(c_one,vbar(m,p,+1),v(m,q,+1))), 0, & "p*[vbar(p,+).(Isigma*q).g5.v(q,+)] - (p*q+m^2)*vbar(p,+).g5.v(q,+) = 0", passed) call expect ((f_ftvam(c_nil,c_one,vbar(m,p,-1),vp,q)*v(m,q,-1) - (p*q+m**2)*p_ff(c_one,vbar(m,p,-1),v(m,q,-1))), 0, & "p*[vbar(p,-).(Isigma*q).g5.v(q,-)] - (p*q+m^2)*vbar(p,-).g5.v(q,-) = 0", passed) @ <>= print *, "*** Checking polarisation vectors: ***" call expect (conjg(eps(m,p, 1))*eps(m,p, 1), -1, "e( 1).e( 1)=-1", passed) call expect (conjg(eps(m,p, 1))*eps(m,p,-1), 0, "e( 1).e(-1)= 0", passed) call expect (conjg(eps(m,p,-1))*eps(m,p, 1), 0, "e(-1).e( 1)= 0", passed) call expect (conjg(eps(m,p,-1))*eps(m,p,-1), -1, "e(-1).e(-1)=-1", passed) call expect ( p*eps(m,p, 1), 0, " p.e( 1)= 0", passed) call expect ( p*eps(m,p,-1), 0, " p.e(-1)= 0", passed) if (m > 0) then call expect (conjg(eps(m,p, 1))*eps(m,p, 0), 0, "e( 1).e( 0)= 0", passed) call expect (conjg(eps(m,p, 0))*eps(m,p, 1), 0, "e( 0).e( 1)= 0", passed) call expect (conjg(eps(m,p, 0))*eps(m,p, 0), -1, "e( 0).e( 0)=-1", passed) call expect (conjg(eps(m,p, 0))*eps(m,p,-1), 0, "e( 0).e(-1)= 0", passed) call expect (conjg(eps(m,p,-1))*eps(m,p, 0), 0, "e(-1).e( 0)= 0", passed) call expect ( p*eps(m,p, 0), 0, " p.e( 0)= 0", passed) end if @ <>= print *, "*** Checking epsilon tensor: ***" call expect ( pseudo_scalar(eps(m,p,1),eps(m,q,1),eps(m,p,0),eps(m,q,0)), & - pseudo_scalar(eps(m,q,1),eps(m,p,1),eps(m,p,0),eps(m,q,0)), "eps(1<->2)", passed) call expect ( pseudo_scalar(eps(m,p,1),eps(m,q,1),eps(m,p,0),eps(m,q,0)), & - pseudo_scalar(eps(m,p,0),eps(m,q,1),eps(m,p,1),eps(m,q,0)), "eps(1<->3)", passed) call expect ( pseudo_scalar(eps(m,p,1),eps(m,q,1),eps(m,p,0),eps(m,q,0)), & - pseudo_scalar(eps(m,q,0),eps(m,q,1),eps(m,p,0),eps(m,p,1)), "eps(1<->4)", passed) call expect ( pseudo_scalar(eps(m,p,1),eps(m,q,1),eps(m,p,0),eps(m,q,0)), & - pseudo_scalar(eps(m,p,1),eps(m,p,0),eps(m,q,1),eps(m,q,0)), "eps(2<->3)", passed) call expect ( pseudo_scalar(eps(m,p,1),eps(m,q,1),eps(m,p,0),eps(m,q,0)), & - pseudo_scalar(eps(m,p,1),eps(m,q,0),eps(m,p,0),eps(m,q,1)), "eps(2<->4)", passed) call expect ( pseudo_scalar(eps(m,p,1),eps(m,q,1),eps(m,p,0),eps(m,q,0)), & - pseudo_scalar(eps(m,p,1),eps(m,q,1),eps(m,q,0),eps(m,p,0)), "eps(3<->4)", passed) call expect ( pseudo_scalar(eps(m,p,1),eps(m,q,1),eps(m,p,0),eps(m,q,0)), & eps(m,p,1)*pseudo_vector(eps(m,q,1),eps(m,p,0),eps(m,q,0)), "eps'", passed) @ \begin{equation} \frac{1}{2} [x\wedge y]^*_{\mu\nu} [x\wedge y]^{\mu\nu} = \frac{1}{2} (x^*_\mu y^*_\nu-x^*_\nu y^*_\mu) (x^\mu y^\nu-x^\nu y^\mu) = (x^*x) (y^*y) - (x^*y) (y^*x) \end{equation} <>= print *, "*** Checking tensors: ***" call expect (conjg(p.wedge.q)*(p.wedge.q), (p*p)*(q*q)-(p*q)**2, & "[p,q].[q,p]=p.p*q.q-p.q^2", passed) call expect (conjg(p.wedge.q)*(q.wedge.p), (p*q)**2-(p*p)*(q*q), & "[p,q].[q,p]=p.q^2-p.p*q.q", passed) @ i.\,e. \begin{equation} \frac{1}{2} [p\wedge\epsilon(p,i)]^*_{\mu\nu} [p\wedge\epsilon(p,j)]^{\mu\nu} = - p^2 \delta_{ij} \end{equation} <>= call expect (conjg(p.wedge.eps(m,p, 1))*(p.wedge.eps(m,p, 1)), -p*p, & "[p,e( 1)].[p,e( 1)]=-p.p", passed) call expect (conjg(p.wedge.eps(m,p, 1))*(p.wedge.eps(m,p,-1)), 0, & "[p,e( 1)].[p,e(-1)]=0", passed) call expect (conjg(p.wedge.eps(m,p,-1))*(p.wedge.eps(m,p, 1)), 0, & "[p,e(-1)].[p,e( 1)]=0", passed) call expect (conjg(p.wedge.eps(m,p,-1))*(p.wedge.eps(m,p,-1)), -p*p, & "[p,e(-1)].[p,e(-1)]=-p.p", passed) if (m > 0) then call expect (conjg(p.wedge.eps(m,p, 1))*(p.wedge.eps(m,p, 0)), 0, & "[p,e( 1)].[p,e( 0)]=0", passed) call expect (conjg(p.wedge.eps(m,p, 0))*(p.wedge.eps(m,p, 1)), 0, & "[p,e( 0)].[p,e( 1)]=0", passed) call expect (conjg(p.wedge.eps(m,p, 0))*(p.wedge.eps(m,p, 0)), -p*p, & "[p,e( 0)].[p,e( 0)]=-p.p", passed) call expect (conjg(p.wedge.eps(m,p, 0))*(p.wedge.eps(m,p,-1)), 0, & "[p,e( 1)].[p,e(-1)]=0", passed) call expect (conjg(p.wedge.eps(m,p,-1))*(p.wedge.eps(m,p, 0)), 0, & "[p,e(-1)].[p,e( 0)]=0", passed) end if @ also \begin{align} [x\wedge y]_{\mu\nu} z^\nu &= x_\mu (yz) - y_\mu (xz) \\ z_\mu [x\wedge y]^{\mu\nu} &= (zx) y^\nu - (zy) x^\nu \end{align} <>= call expect (abs ((p.wedge.eps(m,p, 1))*p + (p*p)*eps(m,p, 1)), 0, & "[p,e( 1)].p=-p.p*e( 1)]", passed) call expect (abs ((p.wedge.eps(m,p, 0))*p + (p*p)*eps(m,p, 0)), 0, & "[p,e( 0)].p=-p.p*e( 0)]", passed) call expect (abs ((p.wedge.eps(m,p,-1))*p + (p*p)*eps(m,p,-1)), 0, & "[p,e(-1)].p=-p.p*e(-1)]", passed) call expect (abs (p*(p.wedge.eps(m,p, 1)) - (p*p)*eps(m,p, 1)), 0, & "p.[p,e( 1)]=p.p*e( 1)]", passed) call expect (abs (p*(p.wedge.eps(m,p, 0)) - (p*p)*eps(m,p, 0)), 0, & "p.[p,e( 0)]=p.p*e( 0)]", passed) call expect (abs (p*(p.wedge.eps(m,p,-1)) - (p*p)*eps(m,p,-1)), 0, & "p.[p,e(-1)]=p.p*e(-1)]", passed) @ <>= print *, "*** Checking polarisation tensors: ***" call expect (conjg(eps2(m,p, 2))*eps2(m,p, 2), 1, "e2( 2).e2( 2)=1", passed) call expect (conjg(eps2(m,p, 2))*eps2(m,p,-2), 0, "e2( 2).e2(-2)=0", passed) call expect (conjg(eps2(m,p,-2))*eps2(m,p, 2), 0, "e2(-2).e2( 2)=0", passed) call expect (conjg(eps2(m,p,-2))*eps2(m,p,-2), 1, "e2(-2).e2(-2)=1", passed) if (m > 0) then call expect (conjg(eps2(m,p, 2))*eps2(m,p, 1), 0, "e2( 2).e2( 1)=0", passed) call expect (conjg(eps2(m,p, 2))*eps2(m,p, 0), 0, "e2( 2).e2( 0)=0", passed) call expect (conjg(eps2(m,p, 2))*eps2(m,p,-1), 0, "e2( 2).e2(-1)=0", passed) call expect (conjg(eps2(m,p, 1))*eps2(m,p, 2), 0, "e2( 1).e2( 2)=0", passed) call expect (conjg(eps2(m,p, 1))*eps2(m,p, 1), 1, "e2( 1).e2( 1)=1", passed) call expect (conjg(eps2(m,p, 1))*eps2(m,p, 0), 0, "e2( 1).e2( 0)=0", passed) call expect (conjg(eps2(m,p, 1))*eps2(m,p,-1), 0, "e2( 1).e2(-1)=0", passed) call expect (conjg(eps2(m,p, 1))*eps2(m,p,-2), 0, "e2( 1).e2(-2)=0", passed) call expect (conjg(eps2(m,p, 0))*eps2(m,p, 2), 0, "e2( 0).e2( 2)=0", passed) call expect (conjg(eps2(m,p, 0))*eps2(m,p, 1), 0, "e2( 0).e2( 1)=0", passed) call expect (conjg(eps2(m,p, 0))*eps2(m,p, 0), 1, "e2( 0).e2( 0)=1", passed) call expect (conjg(eps2(m,p, 0))*eps2(m,p,-1), 0, "e2( 0).e2(-1)=0", passed) call expect (conjg(eps2(m,p, 0))*eps2(m,p,-2), 0, "e2( 0).e2(-2)=0", passed) call expect (conjg(eps2(m,p,-1))*eps2(m,p, 2), 0, "e2(-1).e2( 2)=0", passed) call expect (conjg(eps2(m,p,-1))*eps2(m,p, 1), 0, "e2(-1).e2( 1)=0", passed) call expect (conjg(eps2(m,p,-1))*eps2(m,p, 0), 0, "e2(-1).e2( 0)=0", passed) call expect (conjg(eps2(m,p,-1))*eps2(m,p,-1), 1, "e2(-1).e2(-1)=1", passed) call expect (conjg(eps2(m,p,-1))*eps2(m,p,-2), 0, "e2(-1).e2(-2)=0", passed) call expect (conjg(eps2(m,p,-2))*eps2(m,p, 1), 0, "e2(-2).e2( 1)=0", passed) call expect (conjg(eps2(m,p,-2))*eps2(m,p, 0), 0, "e2(-2).e2( 0)=0", passed) call expect (conjg(eps2(m,p,-2))*eps2(m,p,-1), 0, "e2(-2).e2(-1)=0", passed) end if @ <>= call expect ( abs(p*eps2(m,p, 2) ), 0, " |p.e2( 2)| =0", passed) call expect ( abs(eps2(m,p, 2)*p), 0, " |e2( 2).p|=0", passed) call expect ( abs(p*eps2(m,p,-2) ), 0, " |p.e2(-2)| =0", passed) call expect ( abs(eps2(m,p,-2)*p), 0, " |e2(-2).p|=0", passed) if (m > 0) then call expect ( abs(p*eps2(m,p, 1) ), 0, " |p.e2( 1)| =0", passed) call expect ( abs(eps2(m,p, 1)*p), 0, " |e2( 1).p|=0", passed) call expect ( abs(p*eps2(m,p, 0) ), 0, " |p.e2( 0)| =0", passed) call expect ( abs(eps2(m,p, 0)*p), 0, " |e2( 0).p|=0", passed) call expect ( abs(p*eps2(m,p,-1) ), 0, " |p.e2(-1)| =0", passed) call expect ( abs(eps2(m,p,-1)*p), 0, " |e2(-1).p|=0", passed) end if @ <>= print *, " *** Checking the polarization tensors for massive gravitons:" call expect (abs(p * eps2(m,p,2)), 0, "p.e(+2)=0", passed) call expect (abs(p * eps2(m,p,1)), 0, "p.e(+1)=0", passed) call expect (abs(p * eps2(m,p,0)), 0, "p.e( 0)=0", passed) call expect (abs(p * eps2(m,p,-1)), 0, "p.e(-1)=0", passed) call expect (abs(p * eps2(m,p,-2)), 0, "p.e(-2)=0", passed) call expect (abs(trace(eps2 (m,p,2))), 0, "Tr[e(+2)]=0", passed) call expect (abs(trace(eps2 (m,p,1))), 0, "Tr[e(+1)]=0", passed) call expect (abs(trace(eps2 (m,p,0))), 0, "Tr[e( 0)]=0", passed) call expect (abs(trace(eps2 (m,p,-1))), 0, "Tr[e(-1)]=0", passed) call expect (abs(trace(eps2 (m,p,-2))), 0, "Tr[e(-2)]=0", passed) call expect (abs(eps2(m,p,2) * eps2(m,p,2)), 1, & "e(2).e(2) = 1", passed) call expect (abs(eps2(m,p,2) * eps2(m,p,1)), 0, & "e(2).e(1) = 0", passed) call expect (abs(eps2(m,p,2) * eps2(m,p,0)), 0, & "e(2).e(0) = 0", passed) call expect (abs(eps2(m,p,2) * eps2(m,p,-1)), 0, & "e(2).e(-1) = 0", passed) call expect (abs(eps2(m,p,2) * eps2(m,p,-2)), 0, & "e(2).e(-2) = 0", passed) call expect (abs(eps2(m,p,1) * eps2(m,p,1)), 1, & "e(1).e(1) = 1", passed) call expect (abs(eps2(m,p,1) * eps2(m,p,0)), 0, & "e(1).e(0) = 0", passed) call expect (abs(eps2(m,p,1) * eps2(m,p,-1)), 0, & "e(1).e(-1) = 0", passed) call expect (abs(eps2(m,p,1) * eps2(m,p,-2)), 0, & "e(1).e(-2) = 0", passed) call expect (abs(eps2(m,p,0) * eps2(m,p,0)), 1, & "e(0).e(0) = 1", passed) call expect (abs(eps2(m,p,0) * eps2(m,p,-1)), 0, & "e(0).e(-1) = 0", passed) call expect (abs(eps2(m,p,0) * eps2(m,p,-2)), 0, & "e(0).e(-2) = 0", passed) call expect (abs(eps2(m,p,-1) * eps2(m,p,-1)), 1, & "e(-1).e(-1) = 1", passed) call expect (abs(eps2(m,p,-1) * eps2(m,p,-2)), 0, & "e(-1).e(-2) = 0", passed) call expect (abs(eps2(m,p,-2) * eps2(m,p,-2)), 1, & "e(-2).e(-2) = 1", passed) @ <>= print *, " *** Checking the graviton propagator:" call expect (abs(p * (cmplx (p*p - m**2, m*w, kind=default) * & pr_tensor(p,m,w,eps2(m,p,-2)))), 0, "p.pr.e(-2)", passed) call expect (abs(p * (cmplx (p*p - m**2, m*w, kind=default) * & pr_tensor(p,m,w,eps2(m,p,-1)))), 0, "p.pr.e(-1)", passed) call expect (abs(p * (cmplx (p*p - m**2, m*w, kind=default) * & pr_tensor(p,m,w,eps2(m,p,0)))), 0, "p.pr.e(0)", passed) call expect (abs(p * (cmplx (p*p - m**2, m*w, kind=default) * & pr_tensor(p,m,w,eps2(m,p,1)))), 0, "p.pr.e(1)", passed) call expect (abs(p * (cmplx (p*p - m**2, m*w, kind=default) * & pr_tensor(p,m,w,eps2(m,p,2)))), 0, "p.pr.e(2)", passed) call expect (abs(p * (cmplx (p*p - m**2, m*w, kind=default) * & pr_tensor(p,m,w,ttest))), 0, "p.pr.ttest", passed) @ <<[[test_omega95_bispinors.f90]]>>= <> program test_omega95_bispinors use kinds use omega95_bispinors use omega_vspinor_polarizations use omega_testtools implicit none integer :: i, j real(kind=default) :: m, pabs, qabs, tabs, zabs, w real(kind=default), dimension(4) :: r - complex(kind=default) :: c_one, c_two + complex(kind=default) :: c_nil, c_one, c_two type(momentum) :: p, q, t, z, p_0 type(vector) :: vp, vq, vt, vz type(vectorspinor) :: testv type(bispinor) :: vv logical :: passed call random_seed () - c_one = 1 - c_two = 2 + c_nil = 0.0_default + c_one = 1.0_default + c_two = 2.0_default w = 1.4142 m = 13 pabs = 42 qabs = 137 tabs = 84 zabs = 3.1415 p_0%t = m p_0%x = 0 call random_momentum (p, pabs, m) call random_momentum (q, qabs, m) call random_momentum (t, tabs, m) call random_momentum (z, zabs, m) call random_number (r) do i = 1, 4 testv%psi(1)%a(i) = (0.0_default, 0.0_default) end do do i = 2, 3 do j = 1, 4 testv%psi(i)%a(j) = cmplx (10.0_default * r(j), kind=default) end do end do testv%psi(4)%a(1) = (1.0_default, 0.0_default) testv%psi(4)%a(2) = (0.0_default, 2.0_default) testv%psi(4)%a(3) = (1.0_default, 0.0_default) testv%psi(4)%a(4) = (3.0_default, 0.0_default) vp = p vq = q vt = t vz = z passed = .true. vv%a(1) = (1.0_default, 0.0_default) vv%a(2) = (0.0_default, 2.0_default) vv%a(3) = (1.0_default, 0.0_default) vv%a(4) = (3.0_default, 0.0_default) vv = pr_psi(p, m, w, .false., vv) <> if (.not. passed) then stop 1 end if end program test_omega95_bispinors @ <>= print *, "*** Checking the equations of motion ***:" call expect (abs(f_vf(c_one,vp,u(m,p,+1))-m*u(m,p,+1)), 0, "|[p-m]u(+)|=0", passed) call expect (abs(f_vf(c_one,vp,u(m,p,-1))-m*u(m,p,-1)), 0, "|[p-m]u(-)|=0", passed) call expect (abs(f_vf(c_one,vp,v(m,p,+1))+m*v(m,p,+1)), 0, "|[p+m]v(+)|=0", passed) call expect (abs(f_vf(c_one,vp,v(m,p,-1))+m*v(m,p,-1)), 0, "|[p+m]v(-)|=0", passed) print *, "*** Checking the equations of motion for negative masses***:" call expect (abs(f_vf(c_one,vp,u(-m,p,+1))+m*u(-m,p,+1)), 0, "|[p+m]u(+)|=0", passed) call expect (abs(f_vf(c_one,vp,u(-m,p,-1))+m*u(-m,p,-1)), 0, "|[p+m]u(-)|=0", passed) call expect (abs(f_vf(c_one,vp,v(-m,p,+1))-m*v(-m,p,+1)), 0, "|[p-m]v(+)|=0", passed) call expect (abs(f_vf(c_one,vp,v(-m,p,-1))-m*v(-m,p,-1)), 0, "|[p-m]v(-)|=0", passed) @ <>= print *, "*** Checking the normalization ***:" call expect (s_ff(c_one,v(m,p,+1),u(m,p,+1)), +2*m, "ubar(+)*u(+)=+2m", passed) call expect (s_ff(c_one,v(m,p,-1),u(m,p,-1)), +2*m, "ubar(-)*u(-)=+2m", passed) call expect (s_ff(c_one,u(m,p,+1),v(m,p,+1)), -2*m, "vbar(+)*v(+)=-2m", passed) call expect (s_ff(c_one,u(m,p,-1),v(m,p,-1)), -2*m, "vbar(-)*v(-)=-2m", passed) call expect (s_ff(c_one,v(m,p,+1),v(m,p,+1)), 0, "ubar(+)*v(+)=0 ", passed) call expect (s_ff(c_one,v(m,p,-1),v(m,p,-1)), 0, "ubar(-)*v(-)=0 ", passed) call expect (s_ff(c_one,u(m,p,+1),u(m,p,+1)), 0, "vbar(+)*u(+)=0 ", passed) call expect (s_ff(c_one,u(m,p,-1),u(m,p,-1)), 0, "vbar(-)*u(-)=0 ", passed) print *, "*** Checking the normalization for negative masses***:" call expect (s_ff(c_one,v(-m,p,+1),u(-m,p,+1)), -2*m, "ubar(+)*u(+)=-2m", passed) call expect (s_ff(c_one,v(-m,p,-1),u(-m,p,-1)), -2*m, "ubar(-)*u(-)=-2m", passed) call expect (s_ff(c_one,u(-m,p,+1),v(-m,p,+1)), +2*m, "vbar(+)*v(+)=+2m", passed) call expect (s_ff(c_one,u(-m,p,-1),v(-m,p,-1)), +2*m, "vbar(-)*v(-)=+2m", passed) call expect (s_ff(c_one,v(-m,p,+1),v(-m,p,+1)), 0, "ubar(+)*v(+)=0 ", passed) call expect (s_ff(c_one,v(-m,p,-1),v(-m,p,-1)), 0, "ubar(-)*v(-)=0 ", passed) call expect (s_ff(c_one,u(-m,p,+1),u(-m,p,+1)), 0, "vbar(+)*u(+)=0 ", passed) call expect (s_ff(c_one,u(-m,p,-1),u(-m,p,-1)), 0, "vbar(-)*u(-)=0 ", passed) @ <>= print *, "*** Checking the currents ***:" call expect (abs(v_ff(c_one,v(m,p,+1),u(m,p,+1))-2*vp), 0, "ubar(+).V.u(+)=2p", passed) call expect (abs(v_ff(c_one,v(m,p,-1),u(m,p,-1))-2*vp), 0, "ubar(-).V.u(-)=2p", passed) call expect (abs(v_ff(c_one,u(m,p,+1),v(m,p,+1))-2*vp), 0, "vbar(+).V.v(+)=2p", passed) call expect (abs(v_ff(c_one,u(m,p,-1),v(m,p,-1))-2*vp), 0, "vbar(-).V.v(-)=2p", passed) print *, "*** Checking the currents for negative masses***:" call expect (abs(v_ff(c_one,v(-m,p,+1),u(-m,p,+1))-2*vp), 0, "ubar(+).V.u(+)=2p", passed) call expect (abs(v_ff(c_one,v(-m,p,-1),u(-m,p,-1))-2*vp), 0, "ubar(-).V.u(-)=2p", passed) call expect (abs(v_ff(c_one,u(-m,p,+1),v(-m,p,+1))-2*vp), 0, "vbar(+).V.v(+)=2p", passed) call expect (abs(v_ff(c_one,u(-m,p,-1),v(-m,p,-1))-2*vp), 0, "vbar(-).V.v(-)=2p", passed) @ <>= print *, "*** Checking current conservation ***:" call expect ((vp-vq)*v_ff(c_one,v(m,p,+1),u(m,q,+1)), 0, "d(ubar(+).V.u(+))=0", passed) call expect ((vp-vq)*v_ff(c_one,v(m,p,-1),u(m,q,-1)), 0, "d(ubar(-).V.u(-))=0", passed) call expect ((vp-vq)*v_ff(c_one,u(m,p,+1),v(m,q,+1)), 0, "d(vbar(+).V.v(+))=0", passed) call expect ((vp-vq)*v_ff(c_one,u(m,p,-1),v(m,q,-1)), 0, "d(vbar(-).V.v(-))=0", passed) <>= print *, "*** Checking current conservation for negative masses***:" call expect ((vp-vq)*v_ff(c_one,v(-m,p,+1),u(-m,q,+1)), 0, "d(ubar(+).V.u(+))=0", passed) call expect ((vp-vq)*v_ff(c_one,v(-m,p,-1),u(-m,q,-1)), 0, "d(ubar(-).V.u(-))=0", passed) call expect ((vp-vq)*v_ff(c_one,u(-m,p,+1),v(-m,q,+1)), 0, "d(vbar(+).V.v(+))=0", passed) call expect ((vp-vq)*v_ff(c_one,u(-m,p,-1),v(-m,q,-1)), 0, "d(vbar(-).V.v(-))=0", passed) @ <>= if (m == 0) then print *, "*** Checking axial current conservation ***:" call expect ((vp-vq)*a_ff(c_one,v(m,p,+1),u(m,q,+1)), 0, "d(ubar(+).A.u(+))=0", passed) call expect ((vp-vq)*a_ff(c_one,v(m,p,-1),u(m,q,-1)), 0, "d(ubar(-).A.u(-))=0", passed) call expect ((vp-vq)*a_ff(c_one,u(m,p,+1),v(m,q,+1)), 0, "d(vbar(+).A.v(+))=0", passed) call expect ((vp-vq)*a_ff(c_one,u(m,p,-1),v(m,q,-1)), 0, "d(vbar(-).A.v(-))=0", passed) end if +<>= +print *, "*** Checking implementation of the sigma vertex funktions ***:" +call expect ((vp*tvam_ff(c_one,c_nil,v(m,p,+1),u(m,q,+1),q) - (p*q-m**2)*(v(m,p,+1)*u(m,q,+1))), 0, & + "p*[ubar(p,+).(Isigma*q).u(q,+)] - (p*q-m^2)*ubar(p,+).u(q,+) = 0", passed) +call expect ((vp*tvam_ff(c_one,c_nil,v(m,p,-1),u(m,q,-1),q) - (p*q-m**2)*(v(m,p,-1)*u(m,q,-1))), 0, & + "p*[ubar(p,-).(Isigma*q).u(q,-)] - (p*q-m^2)*ubar(p,-).u(q,-) = 0", passed) +call expect ((vp*tvam_ff(c_one,c_nil,u(m,p,+1),v(m,q,+1),q) - (p*q-m**2)*(u(m,p,+1)*v(m,q,+1))), 0, & + "p*[vbar(p,+).(Isigma*q).v(q,+)] - (p*q-m^2)*vbar(p,+).v(q,+) = 0", passed) +call expect ((vp*tvam_ff(c_one,c_nil,u(m,p,-1),v(m,q,-1),q) - (p*q-m**2)*(u(m,p,-1)*v(m,q,-1))), 0, & + "p*[vbar(p,-).(Isigma*q).v(q,-)] - (p*q-m^2)*vbar(p,-).v(q,-) = 0", passed) +call expect ((v(m,p,+1)*f_tvamf(c_one,c_nil,vp,u(m,q,+1),q) - (p*q-m**2)*(v(m,p,+1)*u(m,q,+1))), 0, & + "ubar(p,+).[p*(Isigma*q).u(q,+)] - (p*q-m^2)*ubar(p,+).u(q,+) = 0", passed) +call expect ((v(m,p,-1)*f_tvamf(c_one,c_nil,vp,u(m,q,-1),q) - (p*q-m**2)*(v(m,p,-1)*u(m,q,-1))), 0, & + "ubar(p,-).[p*(Isigma*q).u(q,-)] - (p*q-m^2)*ubar(p,-).u(q,-) = 0", passed) +call expect ((u(m,p,+1)*f_tvamf(c_one,c_nil,vp,v(m,q,+1),q) - (p*q-m**2)*(u(m,p,+1)*v(m,q,+1))), 0, & + "vbar(p,+).[p*(Isigma*q).v(q,+)] - (p*q-m^2)*vbar(p,+).v(q,+) = 0", passed) +call expect ((u(m,p,-1)*f_tvamf(c_one,c_nil,vp,v(m,q,-1),q) - (p*q-m**2)*(u(m,p,-1)*v(m,q,-1))), 0, & + "vbar(p,-).[p*(Isigma*q).v(q,-)] - (p*q-m^2)*vbar(p,-).v(q,-) = 0", passed) + +call expect ((vp*tvam_ff(c_nil,c_one,v(m,p,+1),u(m,q,+1),q) - (p*q+m**2)*p_ff(c_one,v(m,p,+1),u(m,q,+1))), 0, & + "p*[ubar(p,+).(Isigma*q).g5.u(q,+)] - (p*q+m^2)*ubar(p,+).g5.u(q,+) = 0", passed) +call expect ((vp*tvam_ff(c_nil,c_one,v(m,p,-1),u(m,q,-1),q) - (p*q+m**2)*p_ff(c_one,v(m,p,-1),u(m,q,-1))), 0, & + "p*[ubar(p,-).(Isigma*q).g5.u(q,-)] - (p*q+m^2)*ubar(p,-).g5.u(q,-) = 0", passed) +call expect ((vp*tvam_ff(c_nil,c_one,u(m,p,+1),v(m,q,+1),q) - (p*q+m**2)*p_ff(c_one,u(m,p,+1),v(m,q,+1))), 0, & + "p*[vbar(p,+).(Isigma*q).g5.v(q,+)] - (p*q+m^2)*vbar(p,+).g5.v(q,+) = 0", passed) +call expect ((vp*tvam_ff(c_nil,c_one,u(m,p,-1),v(m,q,-1),q) - (p*q+m**2)*p_ff(c_one,u(m,p,-1),v(m,q,-1))), 0, & + "p*[vbar(p,-).(Isigma*q).g5.v(q,-)] - (p*q+m^2)*vbar(p,-).g5.v(q,-) = 0", passed) +call expect ((v(m,p,+1)*f_tvamf(c_nil,c_one,vp,u(m,q,+1),q) - (p*q+m**2)*p_ff(c_one,v(m,p,+1),u(m,q,+1))), 0, & + "p*[ubar(p,+).(Isigma*q).g5.u(q,+)] - (p*q+m^2)*ubar(p,+).g5.u(q,+) = 0", passed) +call expect ((v(m,p,-1)*f_tvamf(c_nil,c_one,vp,u(m,q,-1),q) - (p*q+m**2)*p_ff(c_one,v(m,p,-1),u(m,q,-1))), 0, & + "p*[ubar(p,-).(Isigma*q).g5.u(q,-)] - (p*q+m^2)*ubar(p,-).g5.u(q,-) = 0", passed) +call expect ((u(m,p,+1)*f_tvamf(c_nil,c_one,vp,v(m,q,+1),q) - (p*q+m**2)*p_ff(c_one,u(m,p,+1),v(m,q,+1))), 0, & + "p*[vbar(p,+).(Isigma*q).g5.v(q,+)] - (p*q+m^2)*vbar(p,+).g5.v(q,+) = 0", passed) +call expect ((u(m,p,-1)*f_tvamf(c_nil,c_one,vp,v(m,q,-1),q) - (p*q+m**2)*p_ff(c_one,u(m,p,-1),v(m,q,-1))), 0, & + "p*[vbar(p,-).(Isigma*q).g5.v(q,-)] - (p*q+m^2)*vbar(p,-).g5.v(q,-) = 0", passed) @ <>= print *, "*** Checking polarization vectors: ***" call expect (conjg(eps(m,p, 1))*eps(m,p, 1), -1, "e( 1).e( 1)=-1", passed) call expect (conjg(eps(m,p, 1))*eps(m,p,-1), 0, "e( 1).e(-1)= 0", passed) call expect (conjg(eps(m,p,-1))*eps(m,p, 1), 0, "e(-1).e( 1)= 0", passed) call expect (conjg(eps(m,p,-1))*eps(m,p,-1), -1, "e(-1).e(-1)=-1", passed) call expect ( p*eps(m,p, 1), 0, " p.e( 1)= 0", passed) call expect ( p*eps(m,p,-1), 0, " p.e(-1)= 0", passed) if (m > 0) then call expect (conjg(eps(m,p, 1))*eps(m,p, 0), 0, "e( 1).e( 0)= 0", passed) call expect (conjg(eps(m,p, 0))*eps(m,p, 1), 0, "e( 0).e( 1)= 0", passed) call expect (conjg(eps(m,p, 0))*eps(m,p, 0), -1, "e( 0).e( 0)=-1", passed) call expect (conjg(eps(m,p, 0))*eps(m,p,-1), 0, "e( 0).e(-1)= 0", passed) call expect (conjg(eps(m,p,-1))*eps(m,p, 0), 0, "e(-1).e( 0)= 0", passed) call expect ( p*eps(m,p, 0), 0, " p.e( 0)= 0", passed) end if @ <>= print *, "*** Checking polarization vectorspinors: ***" call expect (abs(p * ueps(m, p, 2)), 0, "p.ueps ( 2)= 0", passed) call expect (abs(p * ueps(m, p, 1)), 0, "p.ueps ( 1)= 0", passed) call expect (abs(p * ueps(m, p, -1)), 0, "p.ueps (-1)= 0", passed) call expect (abs(p * ueps(m, p, -2)), 0, "p.ueps (-2)= 0", passed) call expect (abs(p * veps(m, p, 2)), 0, "p.veps ( 2)= 0", passed) call expect (abs(p * veps(m, p, 1)), 0, "p.veps ( 1)= 0", passed) call expect (abs(p * veps(m, p, -1)), 0, "p.veps (-1)= 0", passed) call expect (abs(p * veps(m, p, -2)), 0, "p.veps (-2)= 0", passed) print *, "*** Checking polarization vectorspinors (neg. masses): ***" call expect (abs(p * ueps(-m, p, 2)), 0, "p.ueps ( 2)= 0", passed) call expect (abs(p * ueps(-m, p, 1)), 0, "p.ueps ( 1)= 0", passed) call expect (abs(p * ueps(-m, p, -1)), 0, "p.ueps (-1)= 0", passed) call expect (abs(p * ueps(-m, p, -2)), 0, "p.ueps (-2)= 0", passed) call expect (abs(p * veps(-m, p, 2)), 0, "p.veps ( 2)= 0", passed) call expect (abs(p * veps(-m, p, 1)), 0, "p.veps ( 1)= 0", passed) call expect (abs(p * veps(-m, p, -1)), 0, "p.veps (-1)= 0", passed) call expect (abs(p * veps(-m, p, -2)), 0, "p.veps (-2)= 0", passed) print *, "*** in the rest frame ***" call expect (abs(p_0 * ueps(m, p_0, 2)), 0, "p0.ueps ( 2)= 0", passed) call expect (abs(p_0 * ueps(m, p_0, 1)), 0, "p0.ueps ( 1)= 0", passed) call expect (abs(p_0 * ueps(m, p_0, -1)), 0, "p0.ueps (-1)= 0", passed) call expect (abs(p_0 * ueps(m, p_0, -2)), 0, "p0.ueps (-2)= 0", passed) call expect (abs(p_0 * veps(m, p_0, 2)), 0, "p0.veps ( 2)= 0", passed) call expect (abs(p_0 * veps(m, p_0, 1)), 0, "p0.veps ( 1)= 0", passed) call expect (abs(p_0 * veps(m, p_0, -1)), 0, "p0.veps (-1)= 0", passed) call expect (abs(p_0 * veps(m, p_0, -2)), 0, "p0.veps (-2)= 0", passed) print *, "*** in the rest frame (neg. masses) ***" call expect (abs(p_0 * ueps(-m, p_0, 2)), 0, "p0.ueps ( 2)= 0", passed) call expect (abs(p_0 * ueps(-m, p_0, 1)), 0, "p0.ueps ( 1)= 0", passed) call expect (abs(p_0 * ueps(-m, p_0, -1)), 0, "p0.ueps (-1)= 0", passed) call expect (abs(p_0 * ueps(-m, p_0, -2)), 0, "p0.ueps (-2)= 0", passed) call expect (abs(p_0 * veps(-m, p_0, 2)), 0, "p0.veps ( 2)= 0", passed) call expect (abs(p_0 * veps(-m, p_0, 1)), 0, "p0.veps ( 1)= 0", passed) call expect (abs(p_0 * veps(-m, p_0, -1)), 0, "p0.veps (-1)= 0", passed) call expect (abs(p_0 * veps(-m, p_0, -2)), 0, "p0.veps (-2)= 0", passed) @ <>= print *, "*** Checking the irreducibility condition: ***" call expect (abs(f_potgr (c_one, c_one, ueps(m, p, 2))), 0, "g.ueps ( 2)", passed) call expect (abs(f_potgr (c_one, c_one, ueps(m, p, 1))), 0, "g.ueps ( 1)", passed) call expect (abs(f_potgr (c_one, c_one, ueps(m, p, -1))), 0, "g.ueps (-1)", passed) call expect (abs(f_potgr (c_one, c_one, ueps(m, p, -2))), 0, "g.ueps (-2)", passed) call expect (abs(f_potgr (c_one, c_one, veps(m, p, 2))), 0, "g.veps ( 2)", passed) call expect (abs(f_potgr (c_one, c_one, veps(m, p, 1))), 0, "g.veps ( 1)", passed) call expect (abs(f_potgr (c_one, c_one, veps(m, p, -1))), 0, "g.veps (-1)", passed) call expect (abs(f_potgr (c_one, c_one, veps(m, p, -2))), 0, "g.veps (-2)", passed) print *, "*** Checking the irreducibility condition (neg. masses): ***" call expect (abs(f_potgr (c_one, c_one, ueps(-m, p, 2))), 0, "g.ueps ( 2)", passed) call expect (abs(f_potgr (c_one, c_one, ueps(-m, p, 1))), 0, "g.ueps ( 1)", passed) call expect (abs(f_potgr (c_one, c_one, ueps(-m, p, -1))), 0, "g.ueps (-1)", passed) call expect (abs(f_potgr (c_one, c_one, ueps(-m, p, -2))), 0, "g.ueps (-2)", passed) call expect (abs(f_potgr (c_one, c_one, veps(-m, p, 2))), 0, "g.veps ( 2)", passed) call expect (abs(f_potgr (c_one, c_one, veps(-m, p, 1))), 0, "g.veps ( 1)", passed) call expect (abs(f_potgr (c_one, c_one, veps(-m, p, -1))), 0, "g.veps (-1)", passed) call expect (abs(f_potgr (c_one, c_one, veps(-m, p, -2))), 0, "g.veps (-2)", passed) print *, "*** in the rest frame ***" call expect (abs(f_potgr (c_one, c_one, ueps(m, p_0, 2))), 0, "g.ueps ( 2)", passed) call expect (abs(f_potgr (c_one, c_one, ueps(m, p_0, 1))), 0, "g.ueps ( 1)", passed) call expect (abs(f_potgr (c_one, c_one, ueps(m, p_0, -1))), 0, "g.ueps (-1)", passed) call expect (abs(f_potgr (c_one, c_one, ueps(m, p_0, -2))), 0, "g.ueps (-2)", passed) call expect (abs(f_potgr (c_one, c_one, veps(m, p_0, 2))), 0, "g.veps ( 2)", passed) call expect (abs(f_potgr (c_one, c_one, veps(m, p_0, 1))), 0, "g.veps ( 1)", passed) call expect (abs(f_potgr (c_one, c_one, veps(m, p_0, -1))), 0, "g.veps (-1)", passed) call expect (abs(f_potgr (c_one, c_one, veps(m, p_0, -2))), 0, "g.veps (-2)", passed) print *, "*** in the rest frame (neg. masses) ***" call expect (abs(f_potgr (c_one, c_one, ueps(m, p_0, 2))), 0, "g.ueps ( 2)", passed) call expect (abs(f_potgr (c_one, c_one, ueps(m, p_0, 1))), 0, "g.ueps ( 1)", passed) call expect (abs(f_potgr (c_one, c_one, ueps(m, p_0, -1))), 0, "g.ueps (-1)", passed) call expect (abs(f_potgr (c_one, c_one, ueps(m, p_0, -2))), 0, "g.ueps (-2)", passed) call expect (abs(f_potgr (c_one, c_one, veps(m, p_0, 2))), 0, "g.veps ( 2)", passed) call expect (abs(f_potgr (c_one, c_one, veps(m, p_0, 1))), 0, "g.veps ( 1)", passed) call expect (abs(f_potgr (c_one, c_one, veps(m, p_0, -1))), 0, "g.veps (-1)", passed) call expect (abs(f_potgr (c_one, c_one, veps(m, p_0, -2))), 0, "g.veps (-2)", passed) @ <>= print *, "*** Testing vectorspinor normalization ***" call expect (veps(m,p, 2)*ueps(m,p, 2), -2*m, "ueps( 2).ueps( 2)= -2m", passed) call expect (veps(m,p, 1)*ueps(m,p, 1), -2*m, "ueps( 1).ueps( 1)= -2m", passed) call expect (veps(m,p,-1)*ueps(m,p,-1), -2*m, "ueps(-1).ueps(-1)= -2m", passed) call expect (veps(m,p,-2)*ueps(m,p,-2), -2*m, "ueps(-2).ueps(-2)= -2m", passed) call expect (ueps(m,p, 2)*veps(m,p, 2), 2*m, "veps( 2).veps( 2)= +2m", passed) call expect (ueps(m,p, 1)*veps(m,p, 1), 2*m, "veps( 1).veps( 1)= +2m", passed) call expect (ueps(m,p,-1)*veps(m,p,-1), 2*m, "veps(-1).veps(-1)= +2m", passed) call expect (ueps(m,p,-2)*veps(m,p,-2), 2*m, "veps(-2).veps(-2)= +2m", passed) call expect (ueps(m,p, 2)*ueps(m,p, 2), 0, "ueps( 2).veps( 2)= 0", passed) call expect (ueps(m,p, 1)*ueps(m,p, 1), 0, "ueps( 1).veps( 1)= 0", passed) call expect (ueps(m,p,-1)*ueps(m,p,-1), 0, "ueps(-1).veps(-1)= 0", passed) call expect (ueps(m,p,-2)*ueps(m,p,-2), 0, "ueps(-2).veps(-2)= 0", passed) call expect (veps(m,p, 2)*veps(m,p, 2), 0, "veps( 2).ueps( 2)= 0", passed) call expect (veps(m,p, 1)*veps(m,p, 1), 0, "veps( 1).ueps( 1)= 0", passed) call expect (veps(m,p,-1)*veps(m,p,-1), 0, "veps(-1).ueps(-1)= 0", passed) call expect (veps(m,p,-2)*veps(m,p,-2), 0, "veps(-2).ueps(-2)= 0", passed) print *, "*** Testing vectorspinor normalization (neg. masses) ***" call expect (veps(-m,p, 2)*ueps(-m,p, 2), +2*m, "ueps( 2).ueps( 2)= +2m", passed) call expect (veps(-m,p, 1)*ueps(-m,p, 1), +2*m, "ueps( 1).ueps( 1)= +2m", passed) call expect (veps(-m,p,-1)*ueps(-m,p,-1), +2*m, "ueps(-1).ueps(-1)= +2m", passed) call expect (veps(-m,p,-2)*ueps(-m,p,-2), +2*m, "ueps(-2).ueps(-2)= +2m", passed) call expect (ueps(-m,p, 2)*veps(-m,p, 2), -2*m, "veps( 2).veps( 2)= -2m", passed) call expect (ueps(-m,p, 1)*veps(-m,p, 1), -2*m, "veps( 1).veps( 1)= -2m", passed) call expect (ueps(-m,p,-1)*veps(-m,p,-1), -2*m, "veps(-1).veps(-1)= -2m", passed) call expect (ueps(-m,p,-2)*veps(-m,p,-2), -2*m, "veps(-2).veps(-2)= -2m", passed) call expect (ueps(-m,p, 2)*ueps(-m,p, 2), 0, "ueps( 2).veps( 2)= 0", passed) call expect (ueps(-m,p, 1)*ueps(-m,p, 1), 0, "ueps( 1).veps( 1)= 0", passed) call expect (ueps(-m,p,-1)*ueps(-m,p,-1), 0, "ueps(-1).veps(-1)= 0", passed) call expect (ueps(-m,p,-2)*ueps(-m,p,-2), 0, "ueps(-2).veps(-2)= 0", passed) call expect (veps(-m,p, 2)*veps(-m,p, 2), 0, "veps( 2).ueps( 2)= 0", passed) call expect (veps(-m,p, 1)*veps(-m,p, 1), 0, "veps( 1).ueps( 1)= 0", passed) call expect (veps(-m,p,-1)*veps(-m,p,-1), 0, "veps(-1).ueps(-1)= 0", passed) call expect (veps(-m,p,-2)*veps(-m,p,-2), 0, "veps(-2).ueps(-2)= 0", passed) print *, "*** in the rest frame ***" call expect (veps(m,p_0, 2)*ueps(m,p_0, 2), -2*m, "ueps( 2).ueps( 2)= -2m", passed) call expect (veps(m,p_0, 1)*ueps(m,p_0, 1), -2*m, "ueps( 1).ueps( 1)= -2m", passed) call expect (veps(m,p_0,-1)*ueps(m,p_0,-1), -2*m, "ueps(-1).ueps(-1)= -2m", passed) call expect (veps(m,p_0,-2)*ueps(m,p_0,-2), -2*m, "ueps(-2).ueps(-2)= -2m", passed) call expect (ueps(m,p_0, 2)*veps(m,p_0, 2), 2*m, "veps( 2).veps( 2)= +2m", passed) call expect (ueps(m,p_0, 1)*veps(m,p_0, 1), 2*m, "veps( 1).veps( 1)= +2m", passed) call expect (ueps(m,p_0,-1)*veps(m,p_0,-1), 2*m, "veps(-1).veps(-1)= +2m", passed) call expect (ueps(m,p_0,-2)*veps(m,p_0,-2), 2*m, "veps(-2).veps(-2)= +2m", passed) call expect (ueps(m,p_0, 2)*ueps(m,p_0, 2), 0, "ueps( 2).veps( 2)= 0", passed) call expect (ueps(m,p_0, 1)*ueps(m,p_0, 1), 0, "ueps( 1).veps( 1)= 0", passed) call expect (ueps(m,p_0,-1)*ueps(m,p_0,-1), 0, "ueps(-1).veps(-1)= 0", passed) call expect (ueps(m,p_0,-2)*ueps(m,p_0,-2), 0, "ueps(-2).veps(-2)= 0", passed) call expect (veps(m,p_0, 2)*veps(m,p_0, 2), 0, "veps( 2).ueps( 2)= 0", passed) call expect (veps(m,p_0, 1)*veps(m,p_0, 1), 0, "veps( 1).ueps( 1)= 0", passed) call expect (veps(m,p_0,-1)*veps(m,p_0,-1), 0, "veps(-1).ueps(-1)= 0", passed) call expect (veps(m,p_0,-2)*veps(m,p_0,-2), 0, "veps(-2).ueps(-2)= 0", passed) print *, "*** in the rest frame (neg. masses) ***" call expect (veps(-m,p_0, 2)*ueps(-m,p_0, 2), +2*m, "ueps( 2).ueps( 2)= +2m", passed) call expect (veps(-m,p_0, 1)*ueps(-m,p_0, 1), +2*m, "ueps( 1).ueps( 1)= +2m", passed) call expect (veps(-m,p_0,-1)*ueps(-m,p_0,-1), +2*m, "ueps(-1).ueps(-1)= +2m", passed) call expect (veps(-m,p_0,-2)*ueps(-m,p_0,-2), +2*m, "ueps(-2).ueps(-2)= +2m", passed) call expect (ueps(-m,p_0, 2)*veps(-m,p_0, 2), -2*m, "veps( 2).veps( 2)= -2m", passed) call expect (ueps(-m,p_0, 1)*veps(-m,p_0, 1), -2*m, "veps( 1).veps( 1)= -2m", passed) call expect (ueps(-m,p_0,-1)*veps(-m,p_0,-1), -2*m, "veps(-1).veps(-1)= -2m", passed) call expect (ueps(-m,p_0,-2)*veps(-m,p_0,-2), -2*m, "veps(-2).veps(-2)= -2m", passed) call expect (ueps(-m,p_0, 2)*ueps(-m,p_0, 2), 0, "ueps( 2).veps( 2)= 0", passed) call expect (ueps(-m,p_0, 1)*ueps(-m,p_0, 1), 0, "ueps( 1).veps( 1)= 0", passed) call expect (ueps(-m,p_0,-1)*ueps(-m,p_0,-1), 0, "ueps(-1).veps(-1)= 0", passed) call expect (ueps(-m,p_0,-2)*ueps(-m,p_0,-2), 0, "ueps(-2).veps(-2)= 0", passed) call expect (veps(-m,p_0, 2)*veps(-m,p_0, 2), 0, "veps( 2).ueps( 2)= 0", passed) call expect (veps(-m,p_0, 1)*veps(-m,p_0, 1), 0, "veps( 1).ueps( 1)= 0", passed) call expect (veps(-m,p_0,-1)*veps(-m,p_0,-1), 0, "veps(-1).ueps(-1)= 0", passed) call expect (veps(-m,p_0,-2)*veps(-m,p_0,-2), 0, "veps(-2).ueps(-2)= 0", passed) @ <>= print *, "*** Majorana properties of gravitino vertices: ***" call expect (abs(u (m,q,1) * f_sgr (c_one, c_one, ueps(m,p,2), t) + & ueps(m,p,2) * gr_sf(c_one,c_one,u(m,q,1),t)), 0, "f_sgr + gr_sf = 0", passed) !!! call expect (abs(u (m,q,-1) * f_sgr (c_one, c_one, ueps(m,p,2), t) + & !!! ueps(m,p,2) * gr_sf(c_one,c_one,u(m,q,-1),t)), 0, "f_sgr + gr_sf = 0", passed) !!! call expect (abs(u (m,q,1) * f_sgr (c_one, c_one, ueps(m,p,1), t) + & !!! ueps(m,p,1) * gr_sf(c_one,c_one,u(m,q,1),t)), 0, "f_sgr + gr_sf = 0", passed) !!! call expect (abs(u (m,q,-1) * f_sgr (c_one, c_one, ueps(m,p,1), t) + & !!! ueps(m,p,1) * gr_sf(c_one,c_one,u(m,q,-1),t)), 0, "f_sgr + gr_sf = 0", passed) !!! call expect (abs(u (m,q,1) * f_sgr (c_one, c_one, ueps(m,p,-1), t) + & !!! ueps(m,p,-1) * gr_sf(c_one,c_one,u(m,q,1),t)), 0, "f_sgr + gr_sf = 0", passed) !!! call expect (abs(u (m,q,-1) * f_sgr (c_one, c_one, ueps(m,p,-1), t) + & !!! ueps(m,p,-1) * gr_sf(c_one,c_one,u(m,q,-1),t)), 0, "f_sgr + gr_sf = 0", passed) !!! call expect (abs(u (m,q,1) * f_sgr (c_one, c_one, ueps(m,p,-2), t) + & !!! ueps(m,p,-2) * gr_sf(c_one,c_one,u(m,q,1),t)), 0, "f_sgr + gr_sf = 0", passed) !!! call expect (abs(u (m,q,-1) * f_sgr (c_one, c_one, ueps(m,p,-2), t) + & !!! ueps(m,p,-2) * gr_sf(c_one,c_one,u(m,q,-1),t)), 0, "f_sgr + gr_sf = 0", passed) call expect (abs(u (m,q,1) * f_slgr (c_one, c_one, ueps(m,p,2), t) + & ueps(m,p,2) * gr_slf(c_one,c_one,u(m,q,1),t)), 0, "f_slgr + gr_slf = 0", passed, threshold = 0.5_default) call expect (abs(u (m,q,1) * f_srgr (c_one, c_one, ueps(m,p,2), t) + & ueps(m,p,2) * gr_srf(c_one,c_one,u(m,q,1),t)), 0, "f_srgr + gr_srf = 0", passed, threshold = 0.5_default) call expect (abs(u (m,q,1) * f_slrgr (c_one, c_two, c_one, ueps(m,p,2), t) + & ueps(m,p,2) * gr_slrf(c_one,c_two,c_one,u(m,q,1),t)), 0, "f_slrgr + gr_slrf = 0", passed, threshold = 0.5_default) call expect (abs(u (m,q,1) * f_pgr (c_one, c_one, ueps(m,p,2), t) + & ueps(m,p,2) * gr_pf(c_one,c_one,u(m,q,1),t)), 0, "f_pgr + gr_pf = 0", passed, threshold = 0.5_default) call expect (abs(u (m,q,1) * f_vgr (c_one, vt, ueps(m,p,2), p+q) + & ueps(m,p,2) * gr_vf(c_one,vt,u(m,q,1),p+q)), 0, "f_vgr + gr_vf = 0", passed, threshold = 0.5_default) call expect (abs(u (m,q,1) * f_vlrgr (c_one, c_two, vt, ueps(m,p,2), p+q) + & ueps(m,p,2) * gr_vlrf(c_one,c_two,vt,u(m,q,1),p+q)), 0, "f_vlrgr + gr_vlrf = 0", & passed, threshold = 0.5_default) !!! call expect (abs(u (m,q,-1) * f_vgr (c_one, vt, ueps(m,p,2), p+q) + & !!! ueps(m,p,2) * gr_vf(c_one,vt,u(m,q,-1),p+q)), 0, "f_vgr + gr_vf = 0", passed) !!! call expect (abs(u (m,q,1) * f_vgr (c_one, vt, ueps(m,p,1), p+q) + & !!! ueps(m,p,1) * gr_vf(c_one,vt,u(m,q,1),p+q)), 0, "f_vgr + gr_vf = 0", passed) !!! call expect (abs(u (m,q,-1) * f_vgr (c_one, vt, ueps(m,p,1), p+q) + & !!! ueps(m,p,1) * gr_vf(c_one,vt,u(m,q,-1),p+q)), 0, "f_vgr + gr_vf = 0", passed) !!! call expect (abs(u (m,q,1) * f_vgr (c_one, vt, ueps(m,p,-1), p+q) + & !!! ueps(m,p,-1) * gr_vf(c_one,vt,u(m,q,1),p+q)), 0, "f_vgr + gr_vf = 0", passed) !!! call expect (abs(u (m,q,-1) * f_vgr (c_one, vt, veps(m,p,-1), p+q) + & !!! veps(m,p,-1) * gr_vf(c_one,vt,u(m,q,-1),p+q)), 0, "f_vgr + gr_vf = 0", passed) !!! call expect (abs(v (m,q,1) * f_vgr (c_one, vt, ueps(m,p,-2), p+q) + & !!! ueps(m,p,-2) * gr_vf(c_one,vt,v(m,q,1),p+q)), 0, "f_vgr + gr_vf = 0", passed) !!! call expect (abs(u (m,q,-1) * f_vgr (c_one, vt, ueps(m,p,-2), p+q) + & !!! ueps(m,p,-2) * gr_vf(c_one,vt,u(m,q,-1),p+q)), 0, "f_vgr + gr_vf = 0", passed) call expect (abs(s_grf (c_one, ueps(m,p,2), u(m,q,1),t) + & s_fgr(c_one,u(m,q,1),ueps(m,p,2),t)), 0, "s_grf + s_fgr = 0", passed) call expect (abs(sl_grf (c_one, ueps(m,p,2), u(m,q,1),t) + & sl_fgr(c_one,u(m,q,1),ueps(m,p,2),t)), 0, "sl_grf + sl_fgr = 0", passed) call expect (abs(sr_grf (c_one, ueps(m,p,2), u(m,q,1),t) + & sr_fgr(c_one,u(m,q,1),ueps(m,p,2),t)), 0, "sr_grf + sr_fgr = 0", passed) call expect (abs(slr_grf (c_one, c_two, ueps(m,p,2), u(m,q,1),t) + & slr_fgr(c_one,c_two,u(m,q,1),ueps(m,p,2),t)), 0, "slr_grf + slr_fgr = 0", passed) call expect (abs(p_grf (c_one, ueps(m,p,2), u(m,q,1),t) + & p_fgr(c_one,u(m,q,1),ueps(m,p,2),t)), 0, "p_grf + p_fgr = 0", passed) call expect (abs(v_grf (c_one, ueps(m,p,2), u(m,q,1),t) + & v_fgr(c_one,u(m,q,1),ueps(m,p,2),t)), 0, "v_grf + v_fgr = 0", passed) call expect (abs(vlr_grf (c_one, c_two, ueps(m,p,2), u(m,q,1),t) + & vlr_fgr(c_one,c_two,u(m,q,1),ueps(m,p,2),t)), 0, "vlr_grf + vlr_fgr = 0", passed) call expect (abs(u(m,p,1) * f_potgr (c_one,c_one,testv) - testv * gr_potf & (c_one,c_one,u (m,p,1))), 0, "f_potgr - gr_potf = 0", passed) call expect (abs (pot_fgr (c_one,u(m,p,1),testv) - pot_grf(c_one, & testv,u(m,p,1))), 0, "pot_fgr - pot_grf = 0", passed) call expect (abs(u(m,p,1) * f_s2gr (c_one,c_one,c_one,testv) - testv * gr_s2f & (c_one,c_one,c_one,u (m,p,1))), 0, "f_s2gr - gr_s2f = 0", passed) call expect (abs (s2_fgr (c_one,u(m,p,1),c_one,testv) - s2_grf(c_one, & testv,c_one,u(m,p,1))), 0, "s2_fgr - s2_grf = 0", passed) call expect (abs(u (m,q,1) * f_svgr (c_one, c_one, vt, ueps(m,p,2)) + & ueps(m,p,2) * gr_svf(c_one,c_one,vt,u(m,q,1))), 0, "f_svgr + gr_svf = 0", passed) call expect (abs(u (m,q,1) * f_slvgr (c_one, c_one, vt, ueps(m,p,2)) + & ueps(m,p,2) * gr_slvf(c_one,c_one,vt,u(m,q,1))), 0, "f_slvgr + gr_slvf = 0", passed) call expect (abs(u (m,q,1) * f_srvgr (c_one, c_one, vt, ueps(m,p,2)) + & ueps(m,p,2) * gr_srvf(c_one,c_one,vt,u(m,q,1))), 0, "f_srvgr + gr_srvf = 0", passed) call expect (abs(u (m,q,1) * f_slrvgr (c_one, c_two, c_one, vt, ueps(m,p,2)) + & ueps(m,p,2) * gr_slrvf(c_one,c_two,c_one,vt,u(m,q,1))), 0, "f_slrvgr + gr_slrvf = 0", passed) call expect (abs (sv1_fgr (c_one,u(m,p,1),vt,ueps(m,q,2)) + sv1_grf(c_one, & ueps(m,q,2),vt,u(m,p,1))), 0, "sv1_fgr + sv1_grf = 0", passed) call expect (abs (sv2_fgr (c_one,u(m,p,1),c_one,ueps(m,q,2)) + sv2_grf(c_one, & ueps(m,q,2),c_one,u(m,p,1))), 0, "sv2_fgr + sv2_grf = 0", passed) call expect (abs (slv1_fgr (c_one,u(m,p,1),vt,ueps(m,q,2)) + slv1_grf(c_one, & ueps(m,q,2),vt,u(m,p,1))), 0, "slv1_fgr + slv1_grf = 0", passed) call expect (abs (srv2_fgr (c_one,u(m,p,1),c_one,ueps(m,q,2)) + srv2_grf(c_one, & ueps(m,q,2),c_one,u(m,p,1))), 0, "srv2_fgr + srv2_grf = 0", passed) call expect (abs (slrv1_fgr (c_one,c_two,u(m,p,1),vt,ueps(m,q,2)) + slrv1_grf(c_one,c_two, & ueps(m,q,2),vt,u(m,p,1))), 0, "slrv1_fgr + slrv1_grf = 0", passed) call expect (abs (slrv2_fgr (c_one,c_two,u(m,p,1),c_one,ueps(m,q,2)) + slrv2_grf(c_one, & c_two,ueps(m,q,2),c_one,u(m,p,1))), 0, "slrv2_fgr + slrv2_grf = 0", passed) call expect (abs(u (m,q,1) * f_pvgr (c_one, c_one, vt, ueps(m,p,2)) + & ueps(m,p,2) * gr_pvf(c_one,c_one,vt,u(m,q,1))), 0, "f_pvgr + gr_pvf = 0", passed) call expect (abs (pv1_fgr (c_one,u(m,p,1),vt,ueps(m,q,2)) + pv1_grf(c_one, & ueps(m,q,2),vt,u(m,p,1))), 0, "pv1_fgr + pv1_grf = 0", passed) call expect (abs (pv2_fgr (c_one,u(m,p,1),c_one,ueps(m,q,2)) + pv2_grf(c_one, & ueps(m,q,2),c_one,u(m,p,1))), 0, "pv2_fgr + pv2_grf = 0", passed) call expect (abs(u (m,q,1) * f_v2gr (c_one, vt, vz, ueps(m,p,2)) + & ueps(m,p,2) * gr_v2f(c_one,vt,vz,u(m,q,1))), 0, "f_v2gr + gr_v2f = 0", passed) call expect (abs(u (m,q,1) * f_v2lrgr (c_one, c_two, vt, vz, ueps(m,p,2)) + & ueps(m,p,2) * gr_v2lrf(c_one,c_two,vt,vz,u(m,q,1))), 0, "f_v2lrgr + gr_v2lrf = 0", passed) call expect (abs (v2_fgr (c_one,u(m,p,1),vt,ueps(m,q,2)) + v2_grf(c_one, & ueps(m,q,2),vt,u(m,p,1))), 0, "v2_fgr + v2_grf = 0", passed) call expect (abs (v2lr_fgr (c_one,c_two,u(m,p,1),vt,ueps(m,q,2)) + v2lr_grf(c_one, c_two, & ueps(m,q,2),vt,u(m,p,1))), 0, "v2lr_fgr + v2lr_grf = 0", passed) @ <>= print *, "*** Testing the gravitino propagator: ***" print *, "Transversality:" call expect (abs(p * (cmplx (p*p - m**2, m*w, kind=default) * & pr_grav(p,m,w,testv))), 0, "p.pr.test", passed) call expect (abs(p * (cmplx (p*p - m**2, m*w, kind=default) * & pr_grav(p,m,w,ueps(m,p,2)))), 0, "p.pr.ueps ( 2)", passed) call expect (abs(p * (cmplx (p*p - m**2, m*w, kind=default) * & pr_grav(p,m,w,ueps(m,p,1)))), 0, "p.pr.ueps ( 1)", passed) call expect (abs(p * (cmplx (p*p - m**2, m*w, kind=default) * & pr_grav(p,m,w,ueps(m,p,-1)))), 0, "p.pr.ueps (-1)", passed) call expect (abs(p * (cmplx (p*p - m**2, m*w, kind=default) * & pr_grav(p,m,w,ueps(m,p,-2)))), 0, "p.pr.ueps (-2)", passed) call expect (abs(p * (cmplx (p*p - m**2, m*w, kind=default) * & pr_grav(p,m,w,veps(m,p,2)))), 0, "p.pr.veps ( 2)", passed) call expect (abs(p * (cmplx (p*p - m**2, m*w, kind=default) * & pr_grav(p,m,w,veps(m,p,1)))), 0, "p.pr.veps ( 1)", passed) call expect (abs(p * (cmplx (p*p - m**2, m*w, kind=default) * & pr_grav(p,m,w,veps(m,p,-1)))), 0, "p.pr.veps (-1)", passed) call expect (abs(p * (cmplx (p*p - m**2, m*w, kind=default) * & pr_grav(p,m,w,veps(m,p,-2)))), 0, "p.pr.veps (-2)", passed) print *, "Irreducibility:" call expect (abs(f_potgr (c_one, c_one, (cmplx (p*p - m**2, m*w, & kind=default) * pr_grav(p,m,w,testv)))), 0, "g.pr.test", passed) call expect (abs(f_potgr (c_one, c_one, (cmplx (p*p - m**2, m*w, & kind=default) * pr_grav(p,m,w,ueps(m,p,2))))), 0, & "g.pr.ueps ( 2)", passed) call expect (abs(f_potgr (c_one, c_one, (cmplx (p*p - m**2, m*w, & kind=default) * pr_grav(p,m,w,ueps(m,p,1))))), 0, & "g.pr.ueps ( 1)", passed) call expect (abs(f_potgr (c_one, c_one, (cmplx (p*p - m**2, m*w, & kind=default) * pr_grav(p,m,w,ueps(m,p,-1))))), 0, & "g.pr.ueps (-1)", passed) call expect (abs(f_potgr (c_one, c_one, (cmplx (p*p - m**2, m*w, & kind=default) * pr_grav(p,m,w,ueps(m,p,-2))))), 0, & "g.pr.ueps (-2)", passed) call expect (abs(f_potgr (c_one, c_one, (cmplx (p*p - m**2, m*w, & kind=default) * pr_grav(p,m,w,veps(m,p,2))))), 0, & "g.pr.veps ( 2)", passed) call expect (abs(f_potgr (c_one, c_one, (cmplx (p*p - m**2, m*w, & kind=default) * pr_grav(p,m,w,veps(m,p,1))))), 0, & "g.pr.veps ( 1)", passed) call expect (abs(f_potgr (c_one, c_one, (cmplx (p*p - m**2, m*w, & kind=default) * pr_grav(p,m,w,veps(m,p,-1))))), 0, & "g.pr.veps (-1)", passed) call expect (abs(f_potgr (c_one, c_one, (cmplx (p*p - m**2, m*w, & kind=default) * pr_grav(p,m,w,veps(m,p,-2))))), 0, & "g.pr.veps (-2)", passed) @ <<[[omega_bundle.f90]]>>= <<[[omega_vectors.f90]]>> <<[[omega_spinors.f90]]>> <<[[omega_bispinors.f90]]>> <<[[omega_vectorspinors.f90]]>> <<[[omega_polarizations.f90]]>> <<[[omega_tensors.f90]]>> <<[[omega_tensor_polarizations.f90]]>> <<[[omega_couplings.f90]]>> <<[[omega_spinor_couplings.f90]]>> <<[[omega_bispinor_couplings.f90]]>> <<[[omega_vspinor_polarizations.f90]]>> <<[[omega_utils.f90]]>> <<[[omega95.f90]]>> <<[[omega95_bispinors.f90]]>> <<[[omega_parameters.f90]]>> <<[[omega_parameters_madgraph.f90]]>> @ <<[[omega_bundle_whizard.f90]]>>= <<[[omega_bundle.f90]]>> <<[[omega_parameters_whizard.f90]]>> @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{O'Mega Virtual Machine} This module defines the O'Mega Virtual Machine (OVM) completely, whereby all environmental dependencies like masses, widths and couplings have to be given to the constructor [[vm%init]] at runtime. Support for Majorana particles and vectorspinors is only partially, especially all fusions are missing. Maybe it would be easier to make an additional [[omegavm95_bispinors]] to avoid namespace issues. Non-type specific chunks could be reused <<[[omegavm95.f90]]>>= <> module omegavm95 use kinds, only: default use constants use iso_varying_string, string_t => varying_string use, intrinsic :: iso_fortran_env, only : input_unit, output_unit, error_unit use omega95 use omega95_bispinors, only: bispinor, vectorspinor, veps, pr_grav use omega95_bispinors, only: bi_u => u use omega95_bispinors, only: bi_v => v use omega95_bispinors, only: bi_pr_psi => pr_psi use omega_bispinors, only: operator (*), operator (+) use omega_color, only: ovm_color_sum, OCF => omega_color_factor implicit none private <> <> <> contains <> <> end module omegavm95 @ This might not be the proper place but I don't know where to put it <>= integer, parameter, public :: stdin = input_unit integer, parameter, public :: stdout = output_unit integer, parameter, public :: stderr = error_unit integer, parameter :: MIN_UNIT = 11, MAX_UNIT = 99 @ <>= subroutine find_free_unit (u, iostat) integer, intent(out) :: u integer, intent(out), optional :: iostat logical :: exists, is_open integer :: i, status do i = MIN_UNIT, MAX_UNIT inquire (unit = i, exist = exists, opened = is_open, & iostat = status) if (status == 0) then if (exists .and. .not. is_open) then u = i if (present (iostat)) then iostat = 0 end if return end if end if end do if (present (iostat)) then iostat = -1 end if u = -1 end subroutine find_free_unit @ These abstract data types would ideally be the interface to communicate quantum numbers between O'Mega and Whizard. This gives full flexibility to change the representation at any time <>= public :: color_t type color_t contains procedure :: write => color_write end type color_t public :: col_discrete type, extends(color_t) :: col_discrete integer :: i end type col_discrete public :: flavor_t type flavor_t contains procedure :: write => flavor_write end type flavor_t public :: flv_discrete type, extends(flavor_t) :: flv_discrete integer :: i end type flv_discrete public :: helicity_t type :: helicity_t contains procedure :: write => helicity_write end type helicity_t public :: hel_discrete type, extends(helicity_t) :: hel_discrete integer :: i end type hel_discrete public :: hel_trigonometric type, extends(helicity_t) :: hel_trigonometric real :: theta end type hel_trigonometric public :: hel_exponential type, extends(helicity_t) :: hel_exponential real :: phi end type hel_exponential public :: hel_spherical type, extends(helicity_t) :: hel_spherical real :: theta, phi end type hel_spherical <>= subroutine color_write (color, fh) class(color_t), intent(in) :: color integer, intent(in) :: fh select type(color) type is (col_discrete) write(fh, *) 'color_discrete%i = ', color%i end select end subroutine color_write subroutine helicity_write (helicity, fh) class(helicity_t), intent(in) :: helicity integer, intent(in) :: fh select type(helicity) type is (hel_discrete) write(fh, *) 'helicity_discrete%i = ', helicity%i type is (hel_trigonometric) write(fh, *) 'helicity_trigonometric%theta = ', helicity%theta type is (hel_exponential) write(fh, *) 'helicity_exponential%phi = ', helicity%phi type is (hel_spherical) write(fh, *) 'helicity_spherical%phi = ', helicity%phi write(fh, *) 'helicity_spherical%theta = ', helicity%theta end select end subroutine helicity_write subroutine flavor_write (flavor, fh) class(flavor_t), intent(in) :: flavor integer, intent(in) :: fh select type(flavor) type is (flv_discrete) write(fh, *) 'flavor_discrete%i = ', flavor%i end select end subroutine flavor_write @ \subsection{Memory Layout} Some internal parameters <>= integer, parameter :: len_instructions = 8 integer, parameter :: N_version_lines = 2 ! Comment lines including the first header description line integer, parameter :: N_comments = 6 ! Actual data lines plus intermediate description lines ! 'description \n 1 2 3 \n description \n 3 2 1' would count as 3 integer, parameter :: N_header_lines = 5 real(default), parameter, public :: N_ = three @ This is the basic type of a VM <>= type :: basic_vm_t private logical :: verbose type(string_t) :: bytecode_file integer :: bytecode_fh, out_fh integer :: N_instructions, N_levels integer :: N_table_lines integer, dimension(:, :), allocatable :: instructions integer, dimension(:), allocatable :: levels end type @ To allow for a lazy evaluation of amplitudes, we have to keep track whether a wave function has already been computed, to avoid multiple-computing that would arise when the bytecode has redundant fusions, which is necessary for flavor and color MC (and helicity MC when we use Weyl-van-der-Waerden-spinors) <>= type :: vm_scalar logical :: c complex(kind=default) :: v end type type :: vm_spinor logical :: c type(spinor) :: v end type type :: vm_conjspinor logical :: c type(conjspinor) :: v end type type :: vm_bispinor logical :: c type(bispinor) :: v end type type :: vm_vector logical :: c type(vector) :: v end type type :: vm_tensor_2 logical :: c type(tensor) :: v end type type :: vm_tensor_1 logical :: c type(tensor2odd) :: v end type type :: vm_vectorspinor logical :: c type(vectorspinor) :: v end type @ We need a memory pool for all the intermediate results <>= type, public, extends (basic_vm_t) :: vm_t private type(string_t) :: version type(string_t) :: model integer :: N_momenta, N_particles, N_prt_in, N_prt_out, N_amplitudes ! helicities = helicity combinations integer :: N_helicities, N_col_flows, N_col_indices, N_flavors, N_col_factors integer :: N_scalars, N_spinors, N_conjspinors, N_bispinors integer :: N_vectors, N_tensors_2, N_tensors_1, N_vectorspinors integer :: N_coupl_real, N_coupl_real2, N_coupl_cmplx, N_coupl_cmplx2 integer, dimension(:, :), allocatable :: table_flavor integer, dimension(:, :, :), allocatable :: table_color_flows integer, dimension(:, :), allocatable :: table_spin logical, dimension(:, :), allocatable :: table_ghost_flags type(OCF), dimension(:), allocatable :: table_color_factors logical, dimension(:, :), allocatable :: table_flv_col_is_allowed real(default), dimension(:), allocatable :: coupl_real real(default), dimension(:, :), allocatable :: coupl_real2 complex(default), dimension(:), allocatable :: coupl_cmplx complex(default), dimension(:, :), allocatable :: coupl_cmplx2 real(default), dimension(:), allocatable :: mass real(default), dimension(:), allocatable :: width type(momentum), dimension(:), allocatable :: momenta complex(default), dimension(:), allocatable :: amplitudes complex(default), dimension(:, :, :), allocatable :: table_amplitudes class(flavor_t), dimension(:), allocatable :: flavor class(color_t), dimension(:), allocatable :: color ! gfortran 4.7 !class(helicity_t), dimension(:), pointer :: helicity => null() integer, dimension(:), allocatable :: helicity type(vm_scalar), dimension(:), allocatable :: scalars type(vm_spinor), dimension(:), allocatable :: spinors type(vm_conjspinor), dimension(:), allocatable :: conjspinors type(vm_bispinor), dimension(:), allocatable :: bispinors type(vm_vector), dimension(:), allocatable :: vectors type(vm_tensor_2), dimension(:), allocatable :: tensors_2 type(vm_tensor_1), dimension(:), allocatable :: tensors_1 type(vm_vectorspinor), dimension(:), allocatable :: vectorspinors logical, dimension(:), allocatable :: hel_is_allowed real(default), dimension(:), allocatable :: hel_max_abs real(default) :: hel_sum_abs = 0, hel_threshold = 1E10 integer :: hel_count = 0, hel_cutoff = 100 integer, dimension(:), allocatable :: hel_map integer :: hel_finite logical :: cms logical :: openmp contains <> end type @ <>= subroutine alloc_arrays (vm) type(vm_t), intent(inout) :: vm integer :: i allocate (vm%table_flavor(vm%N_particles, vm%N_flavors)) allocate (vm%table_color_flows(vm%N_col_indices, vm%N_particles, & vm%N_col_flows)) allocate (vm%table_spin(vm%N_particles, vm%N_helicities)) allocate (vm%table_ghost_flags(vm%N_particles, vm%N_col_flows)) allocate (vm%table_color_factors(vm%N_col_factors)) allocate (vm%table_flv_col_is_allowed(vm%N_flavors, vm%N_col_flows)) allocate (vm%momenta(vm%N_momenta)) allocate (vm%amplitudes(vm%N_amplitudes)) allocate (vm%table_amplitudes(vm%N_flavors, vm%N_col_flows, & vm%N_helicities)) vm%table_amplitudes = zero allocate (vm%scalars(vm%N_scalars)) allocate (vm%spinors(vm%N_spinors)) allocate (vm%conjspinors(vm%N_conjspinors)) allocate (vm%bispinors(vm%N_bispinors)) allocate (vm%vectors(vm%N_vectors)) allocate (vm%tensors_2(vm%N_tensors_2)) allocate (vm%tensors_1(vm%N_tensors_1)) allocate (vm%vectorspinors(vm%N_vectorspinors)) allocate (vm%hel_is_allowed(vm%N_helicities)) vm%hel_is_allowed = .True. allocate (vm%hel_max_abs(vm%N_helicities)) vm%hel_max_abs = 0 allocate (vm%hel_map(vm%N_helicities)) vm%hel_map = (/(i, i = 1, vm%N_helicities)/) vm%hel_finite = vm%N_helicities end subroutine alloc_arrays @ \subsection{Controlling the VM} These type-bound procedures steer the VM <>= procedure :: init => vm_init procedure :: write => vm_write procedure :: reset => vm_reset procedure :: run => vm_run procedure :: final => vm_final @ The [[init]] completely sets the environment for the OVM. Parameters can be changed with [[reset]] without reloading the bytecode. <>= subroutine vm_init (vm, bytecode_file, version, model, & coupl_real, coupl_real2, coupl_cmplx, coupl_cmplx2, & mass, width, verbose, out_fh, openmp) class(vm_t), intent(out) :: vm type(string_t), intent(in) :: bytecode_file type(string_t), intent(in) :: version type(string_t), intent(in) :: model real(default), dimension(:), optional, intent(in) :: coupl_real real(default), dimension(:, :), optional, intent(in) :: coupl_real2 complex(default), dimension(:), optional, intent(in) :: coupl_cmplx complex(default), dimension(:, :), optional, intent(in) :: coupl_cmplx2 real(default), dimension(:), optional, intent(in) :: mass real(default), dimension(:), optional, intent(in) :: width logical, optional, intent(in) :: verbose integer, optional, intent(in) :: out_fh logical, optional, intent(in) :: openmp vm%bytecode_file = bytecode_file vm%version = version vm%model = model if (present (coupl_real)) then allocate (vm%coupl_real (size (coupl_real)), source=coupl_real) end if if (present (coupl_real2)) then allocate (vm%coupl_real2 (2, size (coupl_real2, 2)), source=coupl_real2) end if if (present (coupl_cmplx)) then allocate (vm%coupl_cmplx (size (coupl_cmplx)), source=coupl_cmplx) end if if (present (coupl_cmplx2)) then allocate (vm%coupl_cmplx2 (2, size (coupl_cmplx2, 2)), & source=coupl_cmplx2) end if if (present (mass)) then allocate (vm%mass(size(mass)), source=mass) end if if (present (width)) then allocate (vm%width(size (width)), source=width) end if if (present (openmp)) then vm%openmp = openmp else vm%openmp = .false. end if vm%cms = .false. call basic_init (vm, verbose, out_fh) end subroutine vm_init @ <>= subroutine vm_reset (vm, & coupl_real, coupl_real2, coupl_cmplx, coupl_cmplx2, & mass, width, verbose, out_fh) class(vm_t), intent(inout) :: vm real(default), dimension(:), optional, intent(in) :: coupl_real real(default), dimension(:, :), optional, intent(in) :: coupl_real2 complex(default), dimension(:), optional, intent(in) :: coupl_cmplx complex(default), dimension(:, :), optional, intent(in) :: coupl_cmplx2 real(default), dimension(:), optional, intent(in) :: mass real(default), dimension(:), optional, intent(in) :: width logical, optional, intent(in) :: verbose integer, optional, intent(in) :: out_fh if (present (coupl_real)) then vm%coupl_real = coupl_real end if if (present (coupl_real2)) then vm%coupl_real2 = coupl_real2 end if if (present (coupl_cmplx)) then vm%coupl_cmplx = coupl_cmplx end if if (present (coupl_cmplx2)) then vm%coupl_cmplx2 = coupl_cmplx2 end if if (present (mass)) then vm%mass = mass end if if (present (width)) then vm%width = width end if if (present (verbose)) then vm%verbose = verbose end if if (present (out_fh)) then vm%out_fh = out_fh end if end subroutine vm_reset @ Mainly for debugging <>= subroutine vm_write (vm) class(vm_t), intent(in) :: vm integer :: i, j, k call basic_write (vm) write(vm%out_fh, *) 'table_flavor = ', vm%table_flavor write(vm%out_fh, *) 'table_color_flows = ', vm%table_color_flows write(vm%out_fh, *) 'table_spin = ', vm%table_spin write(vm%out_fh, *) 'table_ghost_flags = ', vm%table_ghost_flags write(vm%out_fh, *) 'table_color_factors = ' do i = 1, size(vm%table_color_factors) write(vm%out_fh, *) vm%table_color_factors(i)%i1, & vm%table_color_factors(i)%i2, & vm%table_color_factors(i)%factor end do write(vm%out_fh, *) 'table_flv_col_is_allowed = ', & vm%table_flv_col_is_allowed do i = 1, vm%N_flavors do j = 1, vm%N_col_flows do k = 1, vm%N_helicities write(vm%out_fh, *) 'table_amplitudes(f,c,h), f, c, h = ', vm%table_amplitudes(i,j,k), i, j, k end do end do end do if (allocated(vm%coupl_real)) then write(vm%out_fh, *) 'coupl_real = ', vm%coupl_real end if if (allocated(vm%coupl_real2)) then write(vm%out_fh, *) 'coupl_real2 = ', vm%coupl_real2 end if if (allocated(vm%coupl_cmplx)) then write(vm%out_fh, *) 'coupl_cmplx = ', vm%coupl_cmplx end if if (allocated(vm%coupl_cmplx2)) then write(vm%out_fh, *) 'coupl_cmplx2 = ', vm%coupl_cmplx2 end if write(vm%out_fh, *) 'mass = ', vm%mass write(vm%out_fh, *) 'width = ', vm%width write(vm%out_fh, *) 'momenta = ', vm%momenta ! gfortran 4.7 !do i = 1, size(vm%flavor) !call vm%flavor(i)%write (vm%out_fh) !end do !do i = 1, size(vm%color) !call vm%color(i)%write (vm%out_fh) !end do !do i = 1, size(vm%helicity) !call vm%helicity(i)%write (vm%out_fh) !end do write(vm%out_fh, *) 'helicity = ', vm%helicity write(vm%out_fh, *) 'amplitudes = ', vm%amplitudes write(vm%out_fh, *) 'scalars = ', vm%scalars write(vm%out_fh, *) 'spinors = ', vm%spinors write(vm%out_fh, *) 'conjspinors = ', vm%conjspinors write(vm%out_fh, *) 'bispinors = ', vm%bispinors write(vm%out_fh, *) 'vectors = ', vm%vectors write(vm%out_fh, *) 'tensors_2 = ', vm%tensors_2 write(vm%out_fh, *) 'tensors_1 = ', vm%tensors_1 !!! !!! !!! Regression with ifort 16.0.0 !!! write(vm%out_fh, *) 'vectorspinors = ', vm%vectorspinors write(vm%out_fh, *) 'N_momenta = ', vm%N_momenta write(vm%out_fh, *) 'N_particles = ', vm%N_particles write(vm%out_fh, *) 'N_prt_in = ', vm%N_prt_in write(vm%out_fh, *) 'N_prt_out = ', vm%N_prt_out write(vm%out_fh, *) 'N_amplitudes = ', vm%N_amplitudes write(vm%out_fh, *) 'N_helicities = ', vm%N_helicities write(vm%out_fh, *) 'N_col_flows = ', vm%N_col_flows write(vm%out_fh, *) 'N_col_indices = ', vm%N_col_indices write(vm%out_fh, *) 'N_flavors = ', vm%N_flavors write(vm%out_fh, *) 'N_col_factors = ', vm%N_col_factors write(vm%out_fh, *) 'N_scalars = ', vm%N_scalars write(vm%out_fh, *) 'N_spinors = ', vm%N_spinors write(vm%out_fh, *) 'N_conjspinors = ', vm%N_conjspinors write(vm%out_fh, *) 'N_bispinors = ', vm%N_bispinors write(vm%out_fh, *) 'N_vectors = ', vm%N_vectors write(vm%out_fh, *) 'N_tensors_2 = ', vm%N_tensors_2 write(vm%out_fh, *) 'N_tensors_1 = ', vm%N_tensors_1 write(vm%out_fh, *) 'N_vectorspinors = ', vm%N_vectorspinors write(vm%out_fh, *) 'Overall size of VM: ' ! GNU extension ! write(vm%out_fh, *) 'sizeof(wavefunctions) = ', & ! sizeof(vm%scalars) + sizeof(vm%spinors) + sizeof(vm%conjspinors) + & ! sizeof(vm%bispinors) + sizeof(vm%vectors) + sizeof(vm%tensors_2) + & ! sizeof(vm%tensors_1) + sizeof(vm%vectorspinors) ! write(vm%out_fh, *) 'sizeof(mometa) = ', sizeof(vm%momenta) ! write(vm%out_fh, *) 'sizeof(amplitudes) = ', sizeof(vm%amplitudes) ! write(vm%out_fh, *) 'sizeof(tables) = ', & ! sizeof(vm%table_amplitudes) + sizeof(vm%table_spin) + & ! sizeof(vm%table_flavor) + sizeof(vm%table_flv_col_is_allowed) + & ! sizeof(vm%table_color_flows) + sizeof(vm%table_color_factors) + & ! sizeof(vm%table_ghost_flags) end subroutine vm_write @ Most of this is redundant (Fortran will deallocate when we leave the scope) but when we change from [[allocatable]]s to [[pointer]]s, it is necessary to avoid leaks <>= subroutine vm_final (vm) class(vm_t), intent(inout) :: vm deallocate (vm%table_flavor) deallocate (vm%table_color_flows) deallocate (vm%table_spin) deallocate (vm%table_ghost_flags) deallocate (vm%table_color_factors) deallocate (vm%table_flv_col_is_allowed) if (allocated (vm%coupl_real)) then deallocate (vm%coupl_real) end if if (allocated (vm%coupl_real2)) then deallocate (vm%coupl_real2) end if if (allocated (vm%coupl_cmplx)) then deallocate (vm%coupl_cmplx) end if if (allocated (vm%coupl_cmplx2)) then deallocate (vm%coupl_cmplx2) end if if (allocated (vm%mass)) then deallocate (vm%mass) end if if (allocated (vm%width)) then deallocate (vm%width) end if deallocate (vm%momenta) deallocate (vm%flavor) deallocate (vm%color) deallocate (vm%helicity) deallocate (vm%amplitudes) deallocate (vm%table_amplitudes) deallocate (vm%scalars) deallocate (vm%spinors) deallocate (vm%conjspinors) deallocate (vm%bispinors) deallocate (vm%vectors) deallocate (vm%tensors_2) deallocate (vm%tensors_1) deallocate (vm%vectorspinors) end subroutine vm_final @ Handing over the polymorph object helicity didn't work out as planned. A work-around is the use of [[pointer]]s. [[flavor]] and [[color]] are not yet used but would have to be changed to [[pointer]]s as well. At least this potentially avoids copying. Actually, neither the allocatable nor the pointer version works in [[gfortran 4.7]] due to the broken [[select type]]. Back to Stone Age, i.e. integers. <>= subroutine vm_run (vm, mom, flavor, color, helicity) class(vm_t), intent(inout) :: vm real(default), dimension(0:3, *), intent(in) :: mom class(flavor_t), dimension(:), optional, intent(in) :: flavor class(color_t), dimension(:), optional, intent(in) :: color ! gfortran 4.7 !class(helicity_t), dimension(:), optional, target, intent(in) :: helicity integer, dimension(:), optional, intent(in) :: helicity integer :: i, h, hi do i = 1, vm%N_particles if (i <= vm%N_prt_in) then vm%momenta(i) = - mom(:, i) ! incoming, crossing symmetry else vm%momenta(i) = mom(:, i) ! outgoing end if end do if (present (flavor)) then allocate(vm%flavor(size(flavor)), source=flavor) else if (.not. (allocated (vm%flavor))) then allocate(flv_discrete::vm%flavor(vm%N_particles)) end if end if if (present (color)) then allocate(vm%color(size(color)), source=color) else if (.not. (allocated (vm%color))) then allocate(col_discrete::vm%color(vm%N_col_flows)) end if end if ! gfortran 4.7 if (present (helicity)) then !vm%helicity => helicity vm%helicity = helicity call vm_run_one_helicity (vm, 1) else !if (.not. (associated (vm%helicity))) then !allocate(hel_discrete::vm%helicity(vm%N_particles)) !end if if (.not. (allocated (vm%helicity))) then allocate(vm%helicity(vm%N_particles)) end if if (vm%hel_finite == 0) return do hi = 1, vm%hel_finite h = vm%hel_map(hi) !> vm%helicity = vm%table_spin(:,h) call vm_run_one_helicity (vm, h) end do end if end subroutine vm_run @ This only removes the [[ICE]] but still leads to a segmentation fault in [[gfortran 4.7]]. I am running out of ideas how to make this compiler work with arrays of polymorph datatypes. <>= integer :: hj <>= do hj = 1, size(vm%helicity) select type (hel => vm%helicity(hj)) type is (hel_discrete) hel%i = vm%table_spin(hj,h) end select end do @ <>= select type (hel => vm%helicity) type is (hel_discrete) hel(:)%i = vm%table_spin(:,h) end select @ <>= subroutine vm_run_one_helicity (vm, h) class(vm_t), intent(inout) :: vm integer, intent(in) :: h integer :: f, c, i vm%amplitudes = zero if (vm%N_levels > 0) then call null_all_wfs (vm) call iterate_instructions (vm) end if i = 1 do c = 1, vm%N_col_flows do f = 1, vm%N_flavors if (vm%table_flv_col_is_allowed(f,c)) then vm%table_amplitudes(f,c,h) = vm%amplitudes(i) i = i + 1 end if end do end do end subroutine @ <>= subroutine null_all_wfs (vm) type(vm_t), intent(inout) :: vm integer :: i, j vm%scalars%c = .False. vm%scalars%v = zero vm%spinors%c = .False. vm%conjspinors%c = .False. vm%bispinors%c = .False. vm%vectorspinors%c = .False. do i = 1, 4 vm%spinors%v%a(i) = zero vm%conjspinors%v%a(i) = zero vm%bispinors%v%a(i) = zero do j = 1, 4 vm%vectorspinors%v%psi(i)%a(j) = zero end do end do vm%vectors%c = .False. vm%vectors%v%t = zero vm%tensors_1%c = .False. vm%tensors_2%c = .False. do i = 1, 3 vm%vectors%v%x(i) = zero vm%tensors_1%v%e(i) = zero vm%tensors_1%v%b(i) = zero do j = 1, 3 vm%tensors_2%v%t(i,j) = zero end do end do end subroutine @ \subsection{Reading the bytecode} <>= subroutine load_header (vm, IO) type(vm_t), intent(inout) :: vm integer, intent(inout) :: IO integer, dimension(len_instructions) :: line read(vm%bytecode_fh, fmt = *, iostat = IO) line vm%N_momenta = line(1) vm%N_particles = line(2) vm%N_prt_in = line(3) vm%N_prt_out = line(4) vm%N_amplitudes = line(5) vm%N_helicities = line(6) vm%N_col_flows = line(7) if (vm%N_momenta == 0) then vm%N_col_indices = 2 else vm%N_col_indices = line(8) end if read(vm%bytecode_fh, fmt = *, iostat = IO) read(vm%bytecode_fh, fmt = *, iostat = IO) line vm%N_flavors = line(1) vm%N_col_factors = line(2) vm%N_scalars = line(3) vm%N_spinors = line(4) vm%N_conjspinors = line(5) vm%N_bispinors = line(6) vm%N_vectors = line(7) vm%N_tensors_2 = line(8) read(vm%bytecode_fh, fmt = *, iostat = IO) read(vm%bytecode_fh, fmt = *, iostat = IO) line vm%N_tensors_1 = line(1) vm%N_vectorspinors = line(2) ! Add 1 for seperating label lines like 'Another table' vm%N_table_lines = vm%N_helicities + 1 + vm%N_flavors + 1 + vm%N_col_flows & + 1 + vm%N_col_flows + 1 + vm%N_col_factors + 1 + vm%N_col_flows end subroutine load_header @ <>= subroutine read_tables (vm, IO) type(vm_t), intent(inout) :: vm integer, intent(inout) :: IO integer :: i integer, dimension(2) :: tmpcf integer, dimension(3) :: tmpfactor integer, dimension(vm%N_flavors) :: tmpF integer, dimension(vm%N_particles) :: tmpP real(default) :: factor do i = 1, vm%N_helicities read(vm%bytecode_fh, fmt = *, iostat = IO) vm%table_spin(:, i) end do read(vm%bytecode_fh, fmt = *, iostat = IO) do i = 1, vm%N_flavors read(vm%bytecode_fh, fmt = *, iostat = IO) vm%table_flavor(:, i) end do read(vm%bytecode_fh, fmt = *, iostat = IO) do i = 1, vm%N_col_flows read(vm%bytecode_fh, fmt = *, iostat = IO) vm%table_color_flows(:, :, i) end do read(vm%bytecode_fh, fmt = *, iostat = IO) do i = 1, vm%N_col_flows read(vm%bytecode_fh, fmt = *, iostat = IO) tmpP vm%table_ghost_flags(:, i) = int_to_log(tmpP) end do read(vm%bytecode_fh, fmt = *, iostat = IO) do i = 1, vm%N_col_factors read(vm%bytecode_fh, fmt = '(2I9)', iostat = IO, advance='no') tmpcf factor = zero do read(vm%bytecode_fh, fmt = '(3I9)', iostat = IO, advance='no', EOR=10) tmpfactor factor = factor + color_factor(tmpfactor(1), tmpfactor(2), tmpfactor(3)) end do 10 vm%table_color_factors(i) = OCF(tmpcf(1), tmpcf(2), factor) end do read(vm%bytecode_fh, fmt = *, iostat = IO) do i = 1, vm%N_col_flows read(vm%bytecode_fh, fmt = *, iostat = IO) tmpF vm%table_flv_col_is_allowed(:, i) = int_to_log(tmpF) end do end subroutine read_tables @ This checking has proven useful more than once <>= subroutine extended_version_check (vm, IO) type(vm_t), intent(in) :: vm integer, intent(inout) :: IO character(256) :: buffer read(vm%bytecode_fh, fmt = *, iostat = IO) buffer if (vm%model /= buffer) then print *, "Warning: Bytecode has been generated with an older SVN revision." else if (vm%verbose) then write (vm%out_fh, fmt = *) "Using the model: " write (vm%out_fh, fmt = *) char(vm%model) end if end if end subroutine extended_version_check @ This chunk is copied verbatim from the [[basic_vm]] <>= subroutine basic_init (vm, verbose, out_fh) type(vm_t), intent(inout) :: vm logical, optional, intent(in) :: verbose integer, optional, intent(in) :: out_fh if (present (verbose)) then vm%verbose = verbose else vm%verbose = .true. end if if (present (out_fh)) then vm%out_fh = out_fh else vm%out_fh = stdout end if call set_stream (vm) call alloc_and_count (vm) if (vm%N_levels > 0) then call read_bytecode (vm) call sanity_check (vm) end if close (vm%bytecode_fh) end subroutine basic_init subroutine basic_write (vm) type(vm_t), intent(in) :: vm integer :: i write (vm%out_fh, *) '=====> VM ', char(vm%version), ' <=====' write (vm%out_fh, *) 'verbose = ', vm%verbose write (vm%out_fh, *) 'bytecode_file = ', char (vm%bytecode_file) write (vm%out_fh, *) 'N_instructions = ', vm%N_instructions write (vm%out_fh, *) 'N_levels = ', vm%N_levels write (vm%out_fh, *) 'instructions = ' do i = 1, vm%N_instructions write (vm%out_fh, *) vm%instructions(:, i) end do write (vm%out_fh, *) 'levels = ', vm%levels end subroutine basic_write subroutine alloc_and_count (vm) type(vm_t), intent(inout) :: vm integer, dimension(len_instructions) :: line character(256) :: buffer integer :: i, IO read(vm%bytecode_fh, fmt = *, iostat = IO) buffer if (vm%version /= buffer) then print *, "Warning: Bytecode has been generated with an older SVN revision." else if (vm%verbose) then write (vm%out_fh, fmt = *) "Bytecode version fits." end if end if call extended_version_check (vm, IO) if (vm%verbose) then write (vm%out_fh, fmt = *) "Trying to allocate." end if do i = 1, N_comments read(vm%bytecode_fh, fmt = *, iostat = IO) end do call load_header (vm, IO) call alloc_arrays (vm) if (vm%N_momenta /= 0) then do i = 1, vm%N_table_lines + 1 read(vm%bytecode_fh, fmt = *, iostat = IO) end do vm%N_instructions = 0 vm%N_levels = 0 do read(vm%bytecode_fh, fmt = *, end = 42) line if (line(1) /= 0) then vm%N_instructions = vm%N_instructions + 1 else vm%N_levels = vm%N_levels + 1 end if end do 42 rewind(vm%bytecode_fh, iostat = IO) allocate (vm%instructions(len_instructions, vm%N_instructions)) allocate (vm%levels(vm%N_levels)) if (IO /= 0) then print *, "Error: vm.alloc : Couldn't load bytecode!" stop 1 end if end if end subroutine alloc_and_count subroutine read_bytecode (vm) type(vm_t), intent(inout) :: vm integer, dimension(len_instructions) :: line integer :: i, j, IO ! Jump over version number, comments, header and first table description do i = 1, N_version_lines + N_comments + N_header_lines + 1 read (vm%bytecode_fh, fmt = *, iostat = IO) end do call read_tables (vm, IO) read (vm%bytecode_fh, fmt = *, iostat = IO) i = 0; j = 0 do read (vm%bytecode_fh, fmt = *, iostat = IO) line if (IO /= 0) exit if (line(1) == 0) then if (j <= vm%N_levels) then j = j + 1 vm%levels(j) = i ! last index of a level is saved else print *, 'Error: vm.read_bytecode: File has more levels than anticipated!' stop 1 end if else if (i <= vm%N_instructions) then i = i + 1 ! A valid instruction line vm%instructions(:, i) = line else print *, 'Error: vm.read_bytecode: File is larger than anticipated!' stop 1 end if end if end do end subroutine read_bytecode subroutine iterate_instructions (vm) type(vm_t), intent(inout) :: vm integer :: i, j if (vm%openmp) then !$omp parallel do j = 1, vm%N_levels - 1 !$omp do schedule (static) do i = vm%levels (j) + 1, vm%levels (j + 1) call decode (vm, i) end do !$omp end do end do !$omp end parallel else do j = 1, vm%N_levels - 1 do i = vm%levels (j) + 1, vm%levels (j + 1) call decode (vm, i) end do end do end if end subroutine iterate_instructions subroutine set_stream (vm) type(vm_t), intent(inout) :: vm integer :: IO call find_free_unit (vm%bytecode_fh, IO) open (vm%bytecode_fh, file = char (vm%bytecode_file), form = 'formatted', & access = 'sequential', status = 'old', position = 'rewind', iostat = IO, & action = 'read') if (IO /= 0) then print *, "Error: vm.set_stream: Bytecode file '", char(vm%bytecode_file), & "' not found!" stop 1 end if end subroutine set_stream subroutine sanity_check (vm) type(vm_t), intent(in) :: vm if (vm%levels(1) /= 0) then print *, "Error: vm.vm_init: levels(1) != 0" stop 1 end if if (vm%levels(vm%N_levels) /= vm%N_instructions) then print *, "Error: vm.vm_init: levels(N_levels) != N_instructions" stop 1 end if if (vm%verbose) then write(vm%out_fh, *) "vm passed sanity check. Starting calculation." end if end subroutine sanity_check @ \subsection{Main Decode Function} This is the heart of the OVM <>= ! pure & ! if no warnings subroutine decode (vm, instruction_index) type(vm_t), intent(inout) :: vm integer, intent(in) :: instruction_index integer, dimension(len_instructions) :: i, curr complex(default) :: braket integer :: tmp real(default) :: w i = vm%instructions (:, instruction_index) select case (i(1)) case ( : -1) ! Jump over subinstructions <<[[case]]s of [[decode]]>> case (0) print *, 'Error: Levelbreak put in decode! Line:', & instruction_index stop 1 case default print *, "Error: Decode has case not catched! Line: ", & instruction_index stop 1 end select end subroutine decode @ \subsubsection{Momenta} The most trivial instruction <>= integer, parameter :: ovm_ADD_MOMENTA = 1 @ <<[[case]]s of [[decode]]>>= case (ovm_ADD_MOMENTA) vm%momenta(i(4)) = vm%momenta(i(5)) + vm%momenta(i(6)) if (i(7) > 0) then vm%momenta(i(4)) = vm%momenta(i(4)) + vm%momenta(i(7)) end if @ \subsubsection{Loading External states} <>= integer, parameter :: ovm_LOAD_SCALAR = 10 integer, parameter :: ovm_LOAD_SPINOR_INC = 11 integer, parameter :: ovm_LOAD_SPINOR_OUT = 12 integer, parameter :: ovm_LOAD_CONJSPINOR_INC = 13 integer, parameter :: ovm_LOAD_CONJSPINOR_OUT = 14 integer, parameter :: ovm_LOAD_MAJORANA_INC = 15 integer, parameter :: ovm_LOAD_MAJORANA_OUT = 16 integer, parameter :: ovm_LOAD_VECTOR_INC = 17 integer, parameter :: ovm_LOAD_VECTOR_OUT = 18 integer, parameter :: ovm_LOAD_VECTORSPINOR_INC = 19 integer, parameter :: ovm_LOAD_VECTORSPINOR_OUT = 20 integer, parameter :: ovm_LOAD_TENSOR2_INC = 21 integer, parameter :: ovm_LOAD_TENSOR2_OUT = 22 integer, parameter :: ovm_LOAD_BRS_SCALAR = 30 integer, parameter :: ovm_LOAD_BRS_SPINOR_INC = 31 integer, parameter :: ovm_LOAD_BRS_SPINOR_OUT = 32 integer, parameter :: ovm_LOAD_BRS_CONJSPINOR_INC = 33 integer, parameter :: ovm_LOAD_BRS_CONJSPINOR_OUT = 34 integer, parameter :: ovm_LOAD_BRS_VECTOR_INC = 37 integer, parameter :: ovm_LOAD_BRS_VECTOR_OUT = 38 integer, parameter :: ovm_LOAD_MAJORANA_GHOST_INC = 23 integer, parameter :: ovm_LOAD_MAJORANA_GHOST_OUT = 24 integer, parameter :: ovm_LOAD_BRS_MAJORANA_INC = 35 integer, parameter :: ovm_LOAD_BRS_MAJORANA_OUT = 36 @ <<[[case]]s of [[decode]]>>= case (ovm_LOAD_SCALAR) vm%scalars(i(4))%v = one vm%scalars(i(4))%c = .True. case (ovm_LOAD_SPINOR_INC) call load_spinor(vm%spinors(i(4)), - <

>, <>, & vm%helicity(i(5)), ovm_LOAD_SPINOR_INC) case (ovm_LOAD_SPINOR_OUT) call load_spinor(vm%spinors(i(4)), <

>, <>, & vm%helicity(i(5)), ovm_LOAD_SPINOR_OUT) case (ovm_LOAD_CONJSPINOR_INC) call load_conjspinor(vm%conjspinors(i(4)), - <

>, & <>, vm%helicity(i(5)), ovm_LOAD_CONJSPINOR_INC) case (ovm_LOAD_CONJSPINOR_OUT) call load_conjspinor(vm%conjspinors(i(4)), <

>, & <>, vm%helicity(i(5)), ovm_LOAD_CONJSPINOR_OUT) case (ovm_LOAD_MAJORANA_INC) call load_bispinor(vm%bispinors(i(4)), - <

>, & <>, vm%helicity(i(5)), ovm_LOAD_MAJORANA_INC) case (ovm_LOAD_MAJORANA_OUT) call load_bispinor(vm%bispinors(i(4)), <

>, <>, & vm%helicity(i(5)), ovm_LOAD_MAJORANA_OUT) case (ovm_LOAD_VECTOR_INC) call load_vector(vm%vectors(i(4)), - <

>, <>, & vm%helicity(i(5)), ovm_LOAD_VECTOR_INC) case (ovm_LOAD_VECTOR_OUT) call load_vector(vm%vectors(i(4)), <

>, <>, & vm%helicity(i(5)), ovm_LOAD_VECTOR_OUT) case (ovm_LOAD_VECTORSPINOR_INC) !select type (h => vm%helicity(i(5))) !type is (hel_discrete) !vm%vectorspinors(i(4))%v = veps(<>, - <

>, & !h%i) !end select vm%vectorspinors(i(4))%v = veps(<>, - <

>, & vm%helicity(i(5))) vm%vectorspinors(i(4))%c = .True. case (ovm_LOAD_VECTORSPINOR_OUT) !select type (h => vm%helicity(i(5))) !type is (hel_discrete) !vm%vectorspinors(i(4))%v = veps(<>, <

>, & !h%i) !end select vm%vectorspinors(i(4))%v = veps(<>, <

>, & vm%helicity(i(5))) vm%vectorspinors(i(4))%c = .True. case (ovm_LOAD_TENSOR2_INC) !select type (h => vm%helicity(i(5))) !type is (hel_discrete) !vm%tensors_2(i(4))%v = eps2(<>, - <

>, & !h%i) !end select vm%tensors_2(i(4))%c = .True. case (ovm_LOAD_TENSOR2_OUT) !select type (h => vm%helicity(i(5))) !type is (hel_discrete) !vm%tensors_2(i(4))%v = eps2(<>, <

>, h%i) !end select vm%tensors_2(i(4))%c = .True. case (ovm_LOAD_BRS_SCALAR) vm%scalars(i(4))%v = (0, -1) * (<

> * <

> - & <>**2) vm%scalars(i(4))%c = .True. case (ovm_LOAD_BRS_SPINOR_INC) print *, 'not implemented' stop 1 case (ovm_LOAD_BRS_SPINOR_OUT) print *, 'not implemented' stop 1 case (ovm_LOAD_BRS_CONJSPINOR_INC) print *, 'not implemented' stop 1 case (ovm_LOAD_BRS_CONJSPINOR_OUT) print *, 'not implemented' stop 1 case (ovm_LOAD_BRS_VECTOR_INC) print *, 'not implemented' stop 1 case (ovm_LOAD_BRS_VECTOR_OUT) print *, 'not implemented' stop 1 case (ovm_LOAD_MAJORANA_GHOST_INC) print *, 'not implemented' stop 1 case (ovm_LOAD_MAJORANA_GHOST_OUT) print *, 'not implemented' stop 1 case (ovm_LOAD_BRS_MAJORANA_INC) print *, 'not implemented' stop 1 case (ovm_LOAD_BRS_MAJORANA_OUT) print *, 'not implemented' stop 1 @ \subsubsection{Brakets and Fusions} NB: during, execution, the type of the coupling constant is implicit in the instruction <>= integer, parameter :: ovm_CALC_BRAKET = 2 integer, parameter :: ovm_FUSE_V_FF = -1 integer, parameter :: ovm_FUSE_F_VF = -2 integer, parameter :: ovm_FUSE_F_FV = -3 integer, parameter :: ovm_FUSE_VA_FF = -4 integer, parameter :: ovm_FUSE_F_VAF = -5 integer, parameter :: ovm_FUSE_F_FVA = -6 integer, parameter :: ovm_FUSE_VA2_FF = -7 integer, parameter :: ovm_FUSE_F_VA2F = -8 integer, parameter :: ovm_FUSE_F_FVA2 = -9 integer, parameter :: ovm_FUSE_A_FF = -10 integer, parameter :: ovm_FUSE_F_AF = -11 integer, parameter :: ovm_FUSE_F_FA = -12 integer, parameter :: ovm_FUSE_VL_FF = -13 integer, parameter :: ovm_FUSE_F_VLF = -14 integer, parameter :: ovm_FUSE_F_FVL = -15 integer, parameter :: ovm_FUSE_VR_FF = -16 integer, parameter :: ovm_FUSE_F_VRF = -17 integer, parameter :: ovm_FUSE_F_FVR = -18 integer, parameter :: ovm_FUSE_VLR_FF = -19 integer, parameter :: ovm_FUSE_F_VLRF = -20 integer, parameter :: ovm_FUSE_F_FVLR = -21 integer, parameter :: ovm_FUSE_SP_FF = -22 integer, parameter :: ovm_FUSE_F_SPF = -23 integer, parameter :: ovm_FUSE_F_FSP = -24 integer, parameter :: ovm_FUSE_S_FF = -25 integer, parameter :: ovm_FUSE_F_SF = -26 integer, parameter :: ovm_FUSE_F_FS = -27 integer, parameter :: ovm_FUSE_P_FF = -28 integer, parameter :: ovm_FUSE_F_PF = -29 integer, parameter :: ovm_FUSE_F_FP = -30 integer, parameter :: ovm_FUSE_SL_FF = -31 integer, parameter :: ovm_FUSE_F_SLF = -32 integer, parameter :: ovm_FUSE_F_FSL = -33 integer, parameter :: ovm_FUSE_SR_FF = -34 integer, parameter :: ovm_FUSE_F_SRF = -35 integer, parameter :: ovm_FUSE_F_FSR = -36 integer, parameter :: ovm_FUSE_SLR_FF = -37 integer, parameter :: ovm_FUSE_F_SLRF = -38 integer, parameter :: ovm_FUSE_F_FSLR = -39 integer, parameter :: ovm_FUSE_G_GG = -40 integer, parameter :: ovm_FUSE_V_SS = -41 integer, parameter :: ovm_FUSE_S_VV = -42 integer, parameter :: ovm_FUSE_S_VS = -43 integer, parameter :: ovm_FUSE_V_SV = -44 integer, parameter :: ovm_FUSE_S_SS = -45 integer, parameter :: ovm_FUSE_S_SVV = -46 integer, parameter :: ovm_FUSE_V_SSV = -47 integer, parameter :: ovm_FUSE_S_SSS = -48 integer, parameter :: ovm_FUSE_V_VVV = -49 integer, parameter :: ovm_FUSE_S_G2 = -50 integer, parameter :: ovm_FUSE_G_SG = -51 integer, parameter :: ovm_FUSE_G_GS = -52 integer, parameter :: ovm_FUSE_S_G2_SKEW = -53 integer, parameter :: ovm_FUSE_G_SG_SKEW = -54 integer, parameter :: ovm_FUSE_G_GS_SKEW = -55 @ Shorthands <

>= vm%momenta(i(5)) <>= vm%mass(i(2)) <>= vm%momenta(curr(6)) <>= vm%momenta(curr(8)) <>= vm%vectors(curr(5))%v <>= vm%vectors(curr(7))%v <>= vm%scalars(curr(5))%v <>= vm%scalars(curr(7))%v <>= sgn_coupl_cmplx(vm, curr(2)) <>= sgn_coupl_cmplx2(vm, curr(2), 1) <>= sgn_coupl_cmplx2(vm, curr(2), 2) @ <>= if ((i(4) == o%cols(1)) .or. (i(4) == o%cols(2)) .or. & ((mode%col_MC .eq. FULL_SUM) .or. (mode%col_MC .eq. DIAG_COL))) then @ Just a stub for now. Will be reimplemented with the polymorph type [[color]] similar to the [[select type(helicity)]] when we need it. <>= @ <<[[case]]s of [[decode]]>>= case (ovm_CALC_BRAKET) <> tmp = instruction_index + 1 do if (tmp > vm%N_instructions) exit curr = vm%instructions(:, tmp) if (curr(1) >= 0) exit ! End of fusions select case (curr(1)) case (ovm_FUSE_V_FF, ovm_FUSE_VL_FF, ovm_FUSE_VR_FF) braket = vm%vectors(curr(4))%v * vec_ff(vm, curr) case (ovm_FUSE_F_VF, ovm_FUSE_F_VLF, ovm_FUSE_F_VRF) braket = vm%conjspinors(curr(4))%v * ferm_vf(vm, curr) case (ovm_FUSE_F_FV, ovm_FUSE_F_FVL, ovm_FUSE_F_FVR) braket = ferm_fv(vm, curr) * vm%spinors(curr(4))%v case (ovm_FUSE_VA_FF) braket = vm%vectors(curr(4))%v * vec_ff2(vm, curr) case (ovm_FUSE_F_VAF) braket = vm%conjspinors(curr(4))%v * ferm_vf2(vm, curr) case (ovm_FUSE_F_FVA) braket = ferm_fv2(vm, curr) * vm%spinors(curr(4))%v case (ovm_FUSE_S_FF, ovm_FUSE_SP_FF) braket = vm%scalars(curr(4))%v * scal_ff(vm, curr) case (ovm_FUSE_F_SF, ovm_FUSE_F_SPF) braket = vm%conjspinors(curr(4))%v * ferm_sf(vm, curr) case (ovm_FUSE_F_FS, ovm_FUSE_F_FSP) braket = ferm_fs(vm, curr) * vm%spinors(curr(4))%v case (ovm_FUSE_G_GG) braket = vm%vectors(curr(4))%v * & g_gg(<>, & <>, <>, & <>, <>) case (ovm_FUSE_S_VV) braket = vm%scalars(curr(4))%v * <> * & (<> * vm%vectors(curr(6))%v) case (ovm_FUSE_V_SS) braket = vm%vectors(curr(4))%v * & v_ss(<>, <>, <>, & <>, <>) case (ovm_FUSE_S_G2, ovm_FUSE_S_G2_SKEW) braket = vm%scalars(curr(4))%v * scal_g2(vm, curr) case (ovm_FUSE_G_SG, ovm_FUSE_G_GS, ovm_FUSE_G_SG_SKEW, ovm_FUSE_G_GS_SKEW) braket = vm%vectors(curr(4))%v * gauge_sg(vm, curr) case (ovm_FUSE_S_VS) braket = vm%scalars(curr(4))%v * & s_vs(<>, & <>, <>, & <>, <>) case (ovm_FUSE_V_SV) braket = (vm%vectors(curr(4))%v * vm%vectors(curr(6))%v) * & (<> * <>) case (ovm_FUSE_S_SS) braket = vm%scalars(curr(4))%v * & <> * & (<> * vm%scalars(curr(6))%v) case (ovm_FUSE_S_SSS) braket = vm%scalars(curr(4))%v * & <> * & (<> * vm%scalars(curr(6))%v * & <>) case (ovm_FUSE_S_SVV) braket = vm%scalars(curr(4))%v * & <> * & <> * (vm%vectors(curr(6))%v * & <>) case (ovm_FUSE_V_SSV) braket = vm%vectors(curr(4))%v * & (<> * <> * & vm%scalars(curr(6))%v) * <> case (ovm_FUSE_V_VVV) braket = <> * & (<> * vm%vectors(curr(6))%v) * & (vm%vectors(curr(4))%v * <>) case default print *, 'Braket', curr(1), 'not implemented' stop 1 end select vm%amplitudes(i(4)) = vm%amplitudes(i(4)) + curr(3) * braket tmp = tmp + 1 end do vm%amplitudes(i(4)) = vm%amplitudes(i(4)) * i(2) if (i(5) > 1) then vm%amplitudes(i(4)) = vm%amplitudes(i(4)) * & ! Symmetry factor (one / sqrt(real(i(5), kind=default))) end if @ \subsubsection{Propagators} <>= integer, parameter :: ovm_PROPAGATE_SCALAR = 51 integer, parameter :: ovm_PROPAGATE_COL_SCALAR = 52 integer, parameter :: ovm_PROPAGATE_GHOST = 53 integer, parameter :: ovm_PROPAGATE_SPINOR = 54 integer, parameter :: ovm_PROPAGATE_CONJSPINOR = 55 integer, parameter :: ovm_PROPAGATE_MAJORANA = 56 integer, parameter :: ovm_PROPAGATE_COL_MAJORANA = 57 integer, parameter :: ovm_PROPAGATE_UNITARITY = 58 integer, parameter :: ovm_PROPAGATE_COL_UNITARITY = 59 integer, parameter :: ovm_PROPAGATE_FEYNMAN = 60 integer, parameter :: ovm_PROPAGATE_COL_FEYNMAN = 61 integer, parameter :: ovm_PROPAGATE_VECTORSPINOR = 62 integer, parameter :: ovm_PROPAGATE_TENSOR2 = 63 integer, parameter :: ovm_PROPAGATE_NONE = 64 @ <>= if ((mode%col_MC .eq. FULL_SUM) .or. (mode%col_MC .eq. DIAG_COL)) then select case(i(1)) case (ovm_PROPAGATE_PSI) go = .not. vm%spinors%c(i(4)) case (ovm_PROPAGATE_PSIBAR) go = .not. vm%conjspinors%c(i(4)) case (ovm_PROPAGATE_UNITARITY, ovm_PROPAGATE_FEYNMAN, & ovm_PROPAGATE_COL_FEYNMAN) go = .not. vm%vectors%c(i(4)) end select else go = (i(8) == o%cols(1)) .or. (i(8) == o%cols(2)) end if if (go) then <<[[case]]s of [[decode]]>>= <> case (ovm_PROPAGATE_SCALAR : ovm_PROPAGATE_NONE) tmp = instruction_index + 1 do curr = vm%instructions(:,tmp) if (curr(1) >= 0) exit ! End of fusions select case (curr(1)) case (ovm_FUSE_V_FF, ovm_FUSE_VL_FF, ovm_FUSE_VR_FF) vm%vectors(curr(4))%v = vm%vectors(curr(4))%v + curr(3) * & vec_ff(vm, curr) case (ovm_FUSE_F_VF, ovm_FUSE_F_VLF, ovm_FUSE_F_VRF) vm%spinors(curr(4))%v = vm%spinors(curr(4))%v + curr(3) * & ferm_vf(vm, curr) case (ovm_FUSE_F_FV, ovm_FUSE_F_FVL, ovm_FUSE_F_FVR) vm%conjspinors(curr(4))%v = vm%conjspinors(curr(4))%v + curr(3) * & ferm_fv(vm, curr) case (ovm_FUSE_VA_FF) vm%vectors(curr(4))%v = vm%vectors(curr(4))%v + curr(3) * & vec_ff2(vm, curr) case (ovm_FUSE_F_VAF) vm%spinors(curr(4))%v = vm%spinors(curr(4))%v + curr(3) * & ferm_vf2(vm, curr) case (ovm_FUSE_F_FVA) vm%conjspinors(curr(4))%v = vm%conjspinors(curr(4))%v + curr(3) * & ferm_fv2(vm, curr) case (ovm_FUSE_S_FF, ovm_FUSE_SP_FF) vm%scalars(curr(4))%v = vm%scalars(curr(4))%v + curr(3) * & scal_ff(vm, curr) case (ovm_FUSE_F_SF, ovm_FUSE_F_SPF) vm%spinors(curr(4))%v = vm%spinors(curr(4))%v + curr(3) * & ferm_sf(vm, curr) case (ovm_FUSE_F_FS, ovm_FUSE_F_FSP) vm%conjspinors(curr(4))%v = vm%conjspinors(curr(4))%v + curr(3) * & ferm_fs(vm, curr) case (ovm_FUSE_G_GG) vm%vectors(curr(4))%v = vm%vectors(curr(4))%v + curr(3) * & g_gg(<>, <>, & <>, <>, & <>) case (ovm_FUSE_S_VV) vm%scalars(curr(4))%v = vm%scalars(curr(4))%v + curr(3) * & <> * & (<> * vm%vectors(curr(6))%v) case (ovm_FUSE_V_SS) vm%vectors(curr(4))%v = vm%vectors(curr(4))%v + curr(3) * & v_ss(<>, <>, <>, & <>, <>) case (ovm_FUSE_S_G2, ovm_FUSE_S_G2_SKEW) vm%scalars(curr(4))%v = vm%scalars(curr(4))%v + & scal_g2(vm, curr) * curr(3) case (ovm_FUSE_G_SG, ovm_FUSE_G_GS, ovm_FUSE_G_SG_SKEW, ovm_FUSE_G_GS_SKEW) vm%vectors(curr(4))%v = vm%vectors(curr(4))%v + & gauge_sg(vm, curr) * curr(3) case (ovm_FUSE_S_VS) vm%scalars(curr(4))%v = vm%scalars(curr(4))%v + & s_vs(<>, & <>, <>, & <>, <>) * curr(3) case (ovm_FUSE_V_SV) vm%vectors(curr(4))%v = vm%vectors(curr(4))%v + & vm%vectors(curr(6))%v * & (<> * <> * curr(3)) case (ovm_FUSE_S_SS) vm%scalars(curr(4))%v = vm%scalars(curr(4))%v + & <> * & (<> * vm%scalars(curr(6))%v) * curr(3) case (ovm_FUSE_S_SSS) vm%scalars(curr(4))%v = vm%scalars(curr(4))%v + & <> * & (<> * vm%scalars(curr(6))%v * & <>) * curr(3) case (ovm_FUSE_S_SVV) vm%scalars(curr(4))%v = vm%scalars(curr(4))%v + & <> * & <> * (vm%vectors(curr(6))%v * & <>) * curr(3) case (ovm_FUSE_V_SSV) vm%vectors(curr(4))%v = vm%vectors(curr(4))%v + & (<> * <> * & vm%scalars(curr(6))%v) * <> * curr(3) case (ovm_FUSE_V_VVV) vm%vectors(curr(4))%v = vm%vectors(curr(4))%v + & (<> * (<> * & vm%vectors(curr(6))%v)) * curr(3) * <> case default print *, 'Fusion', curr(1), 'not implemented' stop 1 end select tmp = tmp + 1 end do select case (i(3)) case (0) w = zero case (1) w = vm%width(i(2)) vm%cms = .false. case (2) w = wd_tl(<

>, vm%width(i(2))) case (3) w = vm%width(i(2)) vm%cms = .true. case default print *, 'not implemented' stop 1 end select select case (i(1)) <> end select @ <>= case (ovm_PROPAGATE_SCALAR) vm%scalars(i(4))%v = pr_phi(<

>, <>, & w, vm%scalars(i(4))%v) vm%scalars(i(4))%c = .True. case (ovm_PROPAGATE_COL_SCALAR) vm%scalars(i(4))%v = - one / N_ * pr_phi(<

>, & <>, w, vm%scalars(i(4))%v) vm%scalars(i(4))%c = .True. case (ovm_PROPAGATE_GHOST) vm%scalars(i(4))%v = imago * pr_phi(<

>, <>, & w, vm%scalars(i(4))%v) vm%scalars(i(4))%c = .True. case (ovm_PROPAGATE_SPINOR) vm%spinors(i(4))%v = pr_psi(<

>, <>, & w, vm%cms, vm%spinors(i(4))%v) vm%spinors(i(4))%c = .True. case (ovm_PROPAGATE_CONJSPINOR) vm%conjspinors(i(4))%v = pr_psibar(<

>, <>, & w, vm%cms, vm%conjspinors(i(4))%v) vm%conjspinors(i(4))%c = .True. case (ovm_PROPAGATE_MAJORANA) vm%bispinors(i(4))%v = bi_pr_psi(<

>, <>, & w, vm%cms, vm%bispinors(i(4))%v) vm%bispinors(i(4))%c = .True. case (ovm_PROPAGATE_COL_MAJORANA) vm%bispinors(i(4))%v = (- one / N_) * & bi_pr_psi(<

>, <>, & w, vm%cms, vm%bispinors(i(4))%v) vm%bispinors(i(4))%c = .True. case (ovm_PROPAGATE_UNITARITY) vm%vectors(i(4))%v = pr_unitarity(<

>, <>, & w, vm%cms, vm%vectors(i(4))%v) vm%vectors(i(4))%c = .True. case (ovm_PROPAGATE_COL_UNITARITY) vm%vectors(i(4))%v = - one / N_ * pr_unitarity(<

>, & <>, w, vm%cms, vm%vectors(i(4))%v) vm%vectors(i(4))%c = .True. case (ovm_PROPAGATE_FEYNMAN) vm%vectors(i(4))%v = pr_feynman(<

>, vm%vectors(i(4))%v) vm%vectors(i(4))%c = .True. case (ovm_PROPAGATE_COL_FEYNMAN) vm%vectors(i(4))%v = - one / N_ * & pr_feynman(<

>, vm%vectors(i(4))%v) vm%vectors(i(4))%c = .True. case (ovm_PROPAGATE_VECTORSPINOR) vm%vectorspinors(i(4))%v = pr_grav(<

>, <>, & w, vm%vectorspinors(i(4))%v) vm%vectorspinors(i(4))%c = .True. case (ovm_PROPAGATE_TENSOR2) vm%tensors_2(i(4))%v = pr_tensor(<

>, <>, & w, vm%tensors_2(i(4))%v) vm%tensors_2(i(4))%c = .True. case (ovm_PROPAGATE_NONE) ! This will not work with color MC. Appropriate type%c has to be set to ! .True. @ \subsection{Helper functions} Factoring out these parts helps a lot to keep sane but might hurt the performance of the VM noticably. In that case, we have to copy \& paste to avoid the additional function calls. Note that with preprocessor macros, we could maintain this factorized form (and factor out even more since types don't have to match), in case we would decide to allow this <>= !select type (h) !type is (hel_trigonometric) !wf%v = (cos (h%theta) * load_wf (m, p, + 1) + & !sin (h%theta) * load_wf (m, p, - 1)) * sqrt2 !type is (hel_exponential) !wf%v = exp (+ imago * h%phi) * load_wf (m, p, + 1) + & !exp (- imago * h%phi) * load_wf (m, p, - 1) !type is (hel_spherical) !wf%v = (exp (+ imago * h%phi) * cos (h%theta) * load_wf (m, p, + 1) + & !exp (- imago * h%phi) * sin (h%theta) * load_wf (m, p, - 1)) * & !sqrt2 !type is(hel_discrete) !wf%v = load_wf (m, p, h%i) !end select wf%v = load_wf (m, p, h) wf%c = .True. @ Caveat: Helicity MC not tested with Majorana particles but should be fine <>= if ((mode%col_MC .eq. FULL_SUM) .or. (mode%col_MC .eq. DIAG_COL)) then go = .not. vm%spinors%c(i(4)) else go = (i(8) == o%cols(1)) .or. (i(8) == o%cols(2)) end if if (go) .. <>= subroutine load_bispinor(wf, p, m, h, opcode) type(vm_bispinor), intent(out) :: wf type(momentum), intent(in) :: p real(default), intent(in) :: m !class(helicity_t), intent(in) :: h integer, intent(in) :: h integer, intent(in) :: opcode procedure(bi_u), pointer :: load_wf <> select case (opcode) case (ovm_LOAD_MAJORANA_INC) load_wf => bi_u case (ovm_LOAD_MAJORANA_OUT) load_wf => bi_v case default load_wf => null() end select <> end subroutine load_bispinor subroutine load_spinor(wf, p, m, h, opcode) type(vm_spinor), intent(out) :: wf type(momentum), intent(in) :: p real(default), intent(in) :: m !class(helicity_t), intent(in) :: h integer, intent(in) :: h integer, intent(in) :: opcode procedure(u), pointer :: load_wf <> select case (opcode) case (ovm_LOAD_SPINOR_INC) load_wf => u case (ovm_LOAD_SPINOR_OUT) load_wf => v case default load_wf => null() end select <> end subroutine load_spinor subroutine load_conjspinor(wf, p, m, h, opcode) type(vm_conjspinor), intent(out) :: wf type(momentum), intent(in) :: p real(default), intent(in) :: m !class(helicity_t), intent(in) :: h integer, intent(in) :: h integer, intent(in) :: opcode procedure(ubar), pointer :: load_wf <> select case (opcode) case (ovm_LOAD_CONJSPINOR_INC) load_wf => vbar case (ovm_LOAD_CONJSPINOR_OUT) load_wf => ubar case default load_wf => null() end select <> end subroutine load_conjspinor subroutine load_vector(wf, p, m, h, opcode) type(vm_vector), intent(out) :: wf type(momentum), intent(in) :: p real(default), intent(in) :: m !class(helicity_t), intent(in) :: h integer, intent(in) :: h integer, intent(in) :: opcode procedure(eps), pointer :: load_wf <> load_wf => eps <> if (opcode == ovm_LOAD_VECTOR_OUT) then wf%v = conjg(wf%v) end if end subroutine load_vector @ <>= function ferm_vf(vm, curr) result (x) type(spinor) :: x class(vm_t), intent(in) :: vm integer, dimension(:), intent(in) :: curr procedure(f_vf), pointer :: load_wf select case (curr(1)) case (ovm_FUSE_F_VF) load_wf => f_vf case (ovm_FUSE_F_VLF) load_wf => f_vlf case (ovm_FUSE_F_VRF) load_wf => f_vrf case default load_wf => null() end select x = load_wf(<>, <>, vm%spinors(curr(6))%v) end function ferm_vf function ferm_vf2(vm, curr) result (x) type(spinor) :: x class(vm_t), intent(in) :: vm integer, dimension(:), intent(in) :: curr procedure(f_vaf), pointer :: load_wf select case (curr(1)) case (ovm_FUSE_F_VAF) load_wf => f_vaf case default load_wf => null() end select x = f_vaf(<>, <>, <>, vm%spinors(curr(6))%v) end function ferm_vf2 function ferm_sf(vm, curr) result (x) type(spinor) :: x class(vm_t), intent(in) :: vm integer, dimension(:), intent(in) :: curr select case (curr(1)) case (ovm_FUSE_F_SF) x = f_sf(<>, <>, vm%spinors(curr(6))%v) case (ovm_FUSE_F_SPF) x = f_spf(<>, <>, <>, vm%spinors(curr(6))%v) case default end select end function ferm_sf function ferm_fv(vm, curr) result (x) type(conjspinor) :: x class(vm_t), intent(in) :: vm integer, dimension(:), intent(in) :: curr procedure(f_fv), pointer :: load_wf select case (curr(1)) case (ovm_FUSE_F_FV) load_wf => f_fv case (ovm_FUSE_F_FVL) load_wf => f_fvl case (ovm_FUSE_F_FVR) load_wf => f_fvr case default load_wf => null() end select x = load_wf(<>, vm%conjspinors(curr(5))%v, vm%vectors(curr(6))%v) end function ferm_fv function ferm_fv2(vm, curr) result (x) type(conjspinor) :: x class(vm_t), intent(in) :: vm integer, dimension(:), intent(in) :: curr procedure(f_fva), pointer :: load_wf select case (curr(1)) case (ovm_FUSE_F_FVA) load_wf => f_fva case default load_wf => null() end select x = f_fva(<>, <>, & vm%conjspinors(curr(5))%v, vm%vectors(curr(6))%v) end function ferm_fv2 function ferm_fs(vm, curr) result (x) type(conjspinor) :: x class(vm_t), intent(in) :: vm integer, dimension(:), intent(in) :: curr procedure(f_fs), pointer :: load_wf select case (curr(1)) case (ovm_FUSE_F_FS) x = f_fs(<>, vm%conjspinors(curr(5))%v, vm%scalars(curr(6))%v) case (ovm_FUSE_F_FSP) x = f_fsp(<>, <>, & vm%conjspinors(curr(5))%v, vm%scalars(curr(6))%v) case default x%a = zero end select end function ferm_fs function vec_ff(vm, curr) result (x) type(vector) :: x class(vm_t), intent(in) :: vm integer, dimension(:), intent(in) :: curr procedure(v_ff), pointer :: load_wf select case (curr(1)) case (ovm_FUSE_V_FF) load_wf => v_ff case (ovm_FUSE_VL_FF) load_wf => vl_ff case (ovm_FUSE_VR_FF) load_wf => vr_ff case default load_wf => null() end select x = load_wf(<>, vm%conjspinors(curr(5))%v, vm%spinors(curr(6))%v) end function vec_ff function vec_ff2(vm, curr) result (x) type(vector) :: x class(vm_t), intent(in) :: vm integer, dimension(:), intent(in) :: curr procedure(va_ff), pointer :: load_wf select case (curr(1)) case (ovm_FUSE_VA_FF) load_wf => va_ff case default load_wf => null() end select x = load_wf(<>, <>, & vm%conjspinors(curr(5))%v, vm%spinors(curr(6))%v) end function vec_ff2 function scal_ff(vm, curr) result (x) complex(default) :: x class(vm_t), intent(in) :: vm integer, dimension(:), intent(in) :: curr select case (curr(1)) case (ovm_FUSE_S_FF) x = s_ff(<>, & vm%conjspinors(curr(5))%v, vm%spinors(curr(6))%v) case (ovm_FUSE_SP_FF) x = sp_ff(<>, <>, & vm%conjspinors(curr(5))%v, vm%spinors(curr(6))%v) case default x = zero end select end function scal_ff function scal_g2(vm, curr) result (x) complex(default) :: x class(vm_t), intent(in) :: vm integer, dimension(:), intent(in) :: curr select case (curr(1)) case (ovm_FUSE_S_G2) x = <> * ((<> * <>) * & (<> * <>) - & (<> * <>) * & (<> * <>)) case (ovm_FUSE_S_G2_SKEW) x = - phi_vv(<>, <>, <>, & <>, <>) case default x = zero end select end function scal_g2 pure function gauge_sg(vm, curr) result (x) type(vector) :: x class(vm_t), intent(in) :: vm integer, dimension(:), intent(in) :: curr select case (curr(1)) case (ovm_FUSE_G_SG) x = <> * <> * ( & -((<> + <>) * & <>) * <> - & (-(<> + <>) * & <>) * <>) case (ovm_FUSE_G_GS) x = <> * <> * ( & -((<> + <>) * & <>) * <> - & (-(<> + <>) * & <>) * <>) case (ovm_FUSE_G_SG_SKEW) x = - v_phiv(<>, <>, <>, & <>, <>) case (ovm_FUSE_G_GS_SKEW) x = - v_phiv(<>, <>, <>, & <>, <>) case default x = [zero, zero, zero, zero] end select end function gauge_sg @ Some really tiny ones that hopefully get inlined by the compiler <>= elemental function sgn_coupl_cmplx(vm, j) result (s) class(vm_t), intent(in) :: vm integer, intent(in) :: j complex(default) :: s s = isign(1, j) * vm%coupl_cmplx(abs(j)) end function sgn_coupl_cmplx elemental function sgn_coupl_cmplx2(vm, j, i) result (s) class(vm_t), intent(in) :: vm integer, intent(in) :: j, i complex(default) :: s if (i == 1) then s = isign(1, j) * vm%coupl_cmplx2(i, abs(j)) else s = isign(1, j) * vm%coupl_cmplx2(i, abs(j)) end if end function sgn_coupl_cmplx2 elemental function int_to_log(i) result(yorn) integer, intent(in) :: i logical :: yorn if (i /= 0) then yorn = .true. else yorn = .false. end if end function elemental function color_factor(num, den, pwr) result (cf) integer, intent(in) :: num, den, pwr real(kind=default) :: cf if (pwr == 0) then cf = (one * num) / den else cf = (one * num) / den * (N_**pwr) end if end function color_factor @ \subsection{O'Mega Interface} We want to keep the interface close to the native Fortran code but of course one has to hand over the [[vm]] additionally <>= procedure :: number_particles_in => vm_number_particles_in procedure :: number_particles_out => vm_number_particles_out procedure :: number_color_indices => vm_number_color_indices procedure :: reset_helicity_selection => vm_reset_helicity_selection procedure :: new_event => vm_new_event procedure :: color_sum => vm_color_sum procedure :: spin_states => vm_spin_states procedure :: number_spin_states => vm_number_spin_states procedure :: number_color_flows => vm_number_color_flows procedure :: flavor_states => vm_flavor_states procedure :: number_flavor_states => vm_number_flavor_states procedure :: color_flows => vm_color_flows procedure :: color_factors => vm_color_factors procedure :: number_color_factors => vm_number_color_factors procedure :: is_allowed => vm_is_allowed procedure :: get_amplitude => vm_get_amplitude @ <>= elemental function vm_number_particles_in (vm) result (n) class(vm_t), intent(in) :: vm integer :: n n = vm%N_prt_in end function vm_number_particles_in elemental function vm_number_particles_out (vm) result (n) class(vm_t), intent(in) :: vm integer :: n n = vm%N_prt_out end function vm_number_particles_out elemental function vm_number_spin_states (vm) result (n) class(vm_t), intent(in) :: vm integer :: n n = vm%N_helicities end function vm_number_spin_states pure subroutine vm_spin_states (vm, a) class(vm_t), intent(in) :: vm integer, dimension(:,:), intent(out) :: a a = vm%table_spin end subroutine vm_spin_states elemental function vm_number_flavor_states (vm) result (n) class(vm_t), intent(in) :: vm integer :: n n = vm%N_flavors end function vm_number_flavor_states pure subroutine vm_flavor_states (vm, a) class(vm_t), intent(in) :: vm integer, dimension(:,:), intent(out) :: a a = vm%table_flavor end subroutine vm_flavor_states elemental function vm_number_color_indices (vm) result (n) class(vm_t), intent(in) :: vm integer :: n n = vm%N_col_indices end function vm_number_color_indices elemental function vm_number_color_flows (vm) result (n) class(vm_t), intent(in) :: vm integer :: n n = vm%N_col_flows end function vm_number_color_flows pure subroutine vm_color_flows (vm, a, g) class(vm_t), intent(in) :: vm integer, dimension(:,:,:), intent(out) :: a logical, dimension(:,:), intent(out) :: g a = vm%table_color_flows g = vm%table_ghost_flags end subroutine vm_color_flows elemental function vm_number_color_factors (vm) result (n) class(vm_t), intent(in) :: vm integer :: n n = vm%N_col_factors end function vm_number_color_factors pure subroutine vm_color_factors (vm, cf) class(vm_t), intent(in) :: vm type(OCF), dimension(:), intent(out) :: cf cf = vm%table_color_factors end subroutine vm_color_factors ! pure & ! pure unless OpenMp function vm_color_sum (vm, flv, hel) result (amp2) class(vm_t), intent(in) :: vm integer, intent(in) :: flv, hel real(default) :: amp2 amp2 = ovm_color_sum (flv, hel, vm%table_amplitudes, vm%table_color_factors) end function vm_color_sum subroutine vm_new_event (vm, p) class(vm_t), intent(inout) :: vm real(default), dimension(0:3,*), intent(in) :: p logical :: mask_dirty integer :: hel call vm%run (p) if ((vm%hel_threshold .gt. 0) .and. (vm%hel_count .le. vm%hel_cutoff)) then call omega_update_helicity_selection (vm%hel_count, vm%table_amplitudes, & vm%hel_max_abs, vm%hel_sum_abs, vm%hel_is_allowed, vm%hel_threshold, & vm%hel_cutoff, mask_dirty) if (mask_dirty) then vm%hel_finite = 0 do hel = 1, vm%N_helicities if (vm%hel_is_allowed(hel)) then vm%hel_finite = vm%hel_finite + 1 vm%hel_map(vm%hel_finite) = hel end if end do end if end if end subroutine vm_new_event pure subroutine vm_reset_helicity_selection (vm, threshold, cutoff) class(vm_t), intent(inout) :: vm real(kind=default), intent(in) :: threshold integer, intent(in) :: cutoff integer :: i vm%hel_is_allowed = .True. vm%hel_max_abs = 0 vm%hel_sum_abs = 0 vm%hel_count = 0 vm%hel_threshold = threshold vm%hel_cutoff = cutoff vm%hel_map = (/(i, i = 1, vm%N_helicities)/) vm%hel_finite = vm%N_helicities end subroutine vm_reset_helicity_selection pure function vm_is_allowed (vm, flv, hel, col) result (yorn) class(vm_t), intent(in) :: vm logical :: yorn integer, intent(in) :: flv, hel, col yorn = vm%table_flv_col_is_allowed(flv,col) .and. vm%hel_is_allowed(hel) end function vm_is_allowed pure function vm_get_amplitude (vm, flv, hel, col) result (amp_result) class(vm_t), intent(in) :: vm complex(kind=default) :: amp_result integer, intent(in) :: flv, hel, col amp_result = vm%table_amplitudes(flv, col, hel) end function vm_get_amplitude @ @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% <>= ! omegalib.nw -- ! ! Copyright (C) 1999-2019 by ! Wolfgang Kilian ! Thorsten Ohl ! Juergen Reuter ! with contributions from ! Fabian Bach ! Bijan Chokoufe Nejad ! 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. ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% Index: trunk/share/models/MSSM_Hgg.mdl =================================================================== --- trunk/share/models/MSSM_Hgg.mdl (revision 8230) +++ trunk/share/models/MSSM_Hgg.mdl (revision 8231) @@ -1,1142 +1,1150 @@ ######################################################################## # MSSM with unit CKM matrix model "MSSM_Hgg" # Independent parameters ### DO NOT CHANGE THE ORDER OF THESE PARAMETERS parameter GF = 1.16639E-5 # Fermi constant parameter mZ = 91.1882 # Z-boson mass parameter wZ = 2.443 # Z-boson width parameter mW = 80.419 # W-boson mass parameter wW = 2.049 # W-boson width parameter me = 0.000511 # electron mass parameter mmu = 0.1057 # muon mass parameter mtau = 1.777 # tau-lepton mass parameter ms = 0.12 # s-quark mass parameter mc = 1.25 # c-quark mass parameter mb = 4.2 # b-quark mass parameter mtop = 174 # t-quark mass parameter wtop = 1.523 # t-quark width parameter alphas = 0.1178 # Strong coupling constant (Z point) # SUSY: These parameters are not used directly by WHIZARD. # They come into play if an external spectrum generator is invoked. parameter mtype = 1 # MSSM embedding model parameter m_zero = 100 # unified scalar mass (SUGRA/AMSB) parameter m_half = 250 # unified gaugino mass (SUGRA) parameter A0 = -100 # unified trilinear coupling (SUGRA) parameter tanb = 10 # tan(beta) = v2/v1 (MSSM input) parameter sgn_mu = 1 # signum(mu) parameter Lambda = 40000 # SUSY breaking scale (GMSB) parameter M_mes = 80000 # messenger scale (GMSB) parameter N_5 = 3 # messenger index (GMSB) parameter c_grav = 1 # gravitino mass multiplier (GMSB) parameter m_grav = 60000 # gravitino mass (AMSB) # The following parameters are used directly by WHIZARD. # They can be derived from the above, but this is not done by WHIZARD parameter Ae_33 = 0 # Ae soft breaking parameter (3rd gen.) parameter Au_33 = 0 # Au soft breaking parameter (3rd gen.) parameter Ad_33 = 0 # Ad soft breaking parameter (3rd gen.) parameter mh = 125 # light Higgs mass parameter wh = 4.143E-3 # light Higgs width parameter mHH = 1000 # heavy Higgs mass parameter mHA = 1000 # axial Higgs mass parameter mHpm = 1000 # charged Higgs mass parameter wHH = 0 # heavy Higgs width parameter wHpm = 0 # charged Higgs width parameter wHA = 0 # axial Higgs width parameter al_h = 0 # Higgs mixing angle alpha parameter mu_h = 1000 # Higgs mu parameter parameter tanb_h = 10 # Higgs mixing angle tan(beta) parameter msu1 = 1000 # u-squark mass parameter msd1 = 1000 # d-squark mass parameter msc1 = 1000 # c-squark mass parameter mss1 = 1000 # s-squark mass parameter mstop1 = 1000 # t-squark mass parameter msb1 = 1000 # b-squark mass parameter msu2 = 1000 # u-squark mass parameter msd2 = 1000 # d-squark mass parameter msc2 = 1000 # c-squark mass parameter mss2 = 1000 # s-squark mass parameter mstop2 = 1000 # t-squark mass parameter msb2 = 1000 # b-squark mass parameter mse1 = 1000 # selectron1 mass parameter msne = 1000 # electron-sneutrino mass parameter msmu1 = 1000 # smuon1 mass parameter msnmu = 1000 # muon-sneutrino mass parameter mstau1 = 1000 # stau1 mass parameter msntau = 1000 # tau-sneutrino mass parameter mse2 = 1000 # selectron2 mass parameter msmu2 = 1000 # smuon2 mass parameter mstau2 = 1000 # stau2 mass parameter mgg = 1000 # gluino mass parameter mch1 = 1000 # chargino1 mass (signed) parameter mch2 = 1000 # chargino2 mass (signed) parameter mneu1 = 1000 # neutralino1 mass (signed) parameter mneu2 = 1000 # neutralino2 mass (signed) parameter mneu3 = 1000 # neutralino3 mass (signed) parameter mneu4 = 1000 # neutralino4 mass (signed) parameter wsu1 = 0 # u-squark width parameter wsd1 = 0 # d-squark width parameter wsc1 = 0 # c-squark width parameter wss1 = 0 # s-squark width parameter wstop1 = 0 # t-squark width parameter wsb1 = 0 # b-squark width parameter wsu2 = 0 # u-squark width parameter wsd2 = 0 # d-squark width parameter wsc2 = 0 # c-squark width parameter wss2 = 0 # s-squark width parameter wstop2 = 0 # t-squark width parameter wsb2 = 0 # b-squark width parameter wse1 = 0 # selectron1 width parameter wsne = 0 # electron-sneutrino width parameter wsmu1 = 0 # smuon1 width parameter wsnmu = 0 # muon-sneutrino width parameter wstau1 = 0 # stau1 width parameter wsntau = 0 # tau-sneutrino width parameter wse2 = 0 # selectron2 width parameter wsmu2 = 0 # smuon2 width parameter wstau2 = 0 # stau2 width parameter wgg = 0 # gluino width parameter wch1 = 0 # chargino1 width parameter wch2 = 0 # chargino2 width parameter wneu1 = 0 # neutralino1 width parameter wneu2 = 0 # neutralino2 width parameter wneu3 = 0 # neutralino3 width parameter wneu4 = 0 # neutralino4 width parameter mt_11 = 1 # stop mixing matrix parameter mt_12 = 0 # stop mixing matrix parameter mt_21 = 0 # stop mixing matrix parameter mt_22 = 1 # stop mixing matrix parameter mb_11 = 1 # sbottom mixing matrix parameter mb_12 = 0 # sbottom mixing matrix parameter mb_21 = 0 # sbottom mixing matrix parameter mb_22 = 1 # sbottom mixing matrix parameter ml_11 = 1 # stau mixing matrix parameter ml_12 = 0 # stau mixing matrix parameter ml_21 = 0 # stau mixing matrix parameter ml_22 = 1 # stau mixing matrix parameter mn_11 = 1 # neutralino mixing matrix parameter mn_12 = 0 # neutralino mixing matrix parameter mn_13 = 0 # neutralino mixing matrix parameter mn_14 = 0 # neutralino mixing matrix parameter mn_21 = 0 # neutralino mixing matrix parameter mn_22 = 1 # neutralino mixing matrix parameter mn_23 = 0 # neutralino mixing matrix parameter mn_24 = 0 # neutralino mixing matrix parameter mn_31 = 0 # neutralino mixing matrix parameter mn_32 = 0 # neutralino mixing matrix parameter mn_33 = 1 # neutralino mixing matrix parameter mn_34 = 0 # neutralino mixing matrix parameter mn_41 = 0 # neutralino mixing matrix parameter mn_42 = 0 # neutralino mixing matrix parameter mn_43 = 0 # neutralino mixing matrix parameter mn_44 = 1 # neutralino mixing matrix parameter mu_11 = 1 # chargino mixing matrix parameter mu_12 = 0 # chargino mixing matrix parameter mu_21 = 0 # chargino mixing matrix parameter mu_22 = 1 # chargino mixing matrix parameter mv_11 = 1 # chargino mixing matrix parameter mv_12 = 0 # chargino mixing matrix parameter mv_21 = 0 # chargino mixing matrix parameter mv_22 = 1 # chargino mixing matrix parameter hgg_fac= 1 # Hgg K factor parameter hgg_sq = 1 # Squark contribution to Hgg parameter haa_fac= 1 # HAA K factor +# Loop-induced neu2->neu1 A decay +parameter neu_v_fac = 1 # fudge factor for width, vector +parameter neu_a_fac = 0 # explicit vector coupling +parameter neu_v = 0 # fudge factor for width, axial +parameter neu_a = 0 # explicit axial coupling # Dependent parameters derived v = 1 / sqrt (sqrt (2.) * GF) # v (Higgs vev) derived cw = mW / mZ # cos(theta-W) derived sw = sqrt (1-cw*cw) # sin(theta-W) derived ee = 2 * sw * mW / v # em-coupling (GF scheme) derived alpha_em_i = 4 * pi / ee**2 # inverse fine structure const ######################################################################## # Particle content # The quarks particle D_QUARK 1 parton spin 1/2 charge -1/3 isospin -1/2 color 3 name d down anti dbar D "d~" tex_anti "\bar{d}" particle U_QUARK 2 parton spin 1/2 charge 2/3 isospin 1/2 color 3 name u up anti ubar U "u~" tex_anti "\bar{u}" particle S_QUARK 3 like D_QUARK name s strange anti sbar S "s~" tex_anti "\bar{s}" mass ms particle C_QUARK 4 like U_QUARK name c charm anti cbar C "c~" tex_anti "\bar{c}" mass mc particle B_QUARK 5 like D_QUARK name b bottom anti bbar B "b~" tex_anti "\bar{b}" mass mb particle T_QUARK 6 like U_QUARK name t top anti tbar T "t~" tex_anti "\bar{t}" mass mtop width wtop # The leptons particle E_LEPTON 11 spin 1/2 charge -1 isospin -1/2 name "e-" e1 electron e anti "e+" E1 positron tex_name "e^-" tex_anti "e^+" mass me particle E_NEUTRINO 12 left spin 1/2 isospin 1/2 name nue n1 "nu_e" ve "e-neutrino" anti nuebar N1 "ve~" tex_name "\nu_e" tex_anti "\bar\nu_e" particle MU_LEPTON 13 like E_LEPTON name "mu-" e2 mu muon anti "mu+" E2 tex_name "\mu^-" tex_anti "\mu^+" mass mmu particle MU_NEUTRINO 14 like E_NEUTRINO name numu "nu_mu" n2 vm "mu-neutrino" anti numubar N2 "vm~" tex_name "\nu_\mu" tex_anti "\bar\nu_\mu" particle TAU_LEPTON 15 like E_LEPTON name "tau-" e3 tau "ta-" tauon anti "tau+" E3 "ta+" tex_name "\tau^-" tex_anti "\tau^+" mass mtau particle TAU_NEUTRINO 16 like E_NEUTRINO name nutau "nu_tau" n3 vt "tau_neutrino" anti nutaubar N3 "vt~" tex_name "\nu_\tau" tex_anti "\bar\nu_\tau" # The vector bosons particle GLUON 21 parton gauge spin 1 color 8 name gl g G gluon particle PHOTON 22 gauge spin 1 name A gamma photon tex_name "\gamma" particle Z_BOSON 23 gauge spin 1 name Z mass mZ width wZ particle W_BOSON 24 gauge spin 1 charge 1 name "W+" Wp anti "W-" Wm tex_name "W^+" tex_anti "W^-" mass mW width wW # The Higgses particle LIGHT_HIGGS 25 spin 0 name h h0 Higgs tex_name "h^0" mass mh width wh particle HEAVY_HIGGS 35 spin 0 name H HH HH0 H0 tex_name "H^0" mass mHH width wHH particle AXIAL_HIGGS 36 spin 0 name A0 HA HA0 tex_name "A^0" mass mHA width wHA particle CHARGED_HIGGS 37 spin 0 charge +1 name "H+" Hp anti "H-" Hm tex_name "H^+" tex_anti "H^-" mass mHpm width wHpm # The squarks # Left-handed particle D_SQUARK1 1000001 spin 0 charge -1/3 color 3 name sd1 anti sd1c SD1 "sd1~" tex_name "\tilde{d}_L" tex_anti "\tilde{\bar d}_L" mass msd1 width wsd1 particle U_SQUARK1 1000002 spin 0 charge 2/3 color 3 name su1 anti su1c SU1 "su1~" tex_name "\tilde{u}_L" tex_anti "\tilde{\bar u}_L" mass msu1 width wsu1 particle S_SQUARK1 1000003 like D_SQUARK1 name ss1 anti ss1c SS1 "ss1~" tex_name "\tilde{s}_L" tex_anti "\tilde{\bar s}_L" mass mss1 width wss1 particle C_SQUARK1 1000004 like U_SQUARK1 name sc1 anti sc1c SC1 "sc1~" tex_name "\tilde{c}_L" tex_anti "\tilde{\bar c}_L" mass msc1 width wsc1 particle B_SQUARK1 1000005 like D_SQUARK1 name sb1 anti sb1c SB1 "sb1~" tex_name "\tilde{b}_1" tex_anti "\tilde{\bar b}_1" mass msb1 width wsb1 particle T_SQUARK1 1000006 like U_SQUARK1 name st1 anti st1c ST1 "st1~" tex_name "\tilde{t}_1" tex_anti "\tilde{\bar t}_1" mass mstop1 width wstop1 # Right-handed particle D_SQUARK2 2000001 spin 0 charge -1/3 color 3 name sd2 anti sd2c SD2 "sd2~" tex_name "\tilde{d}_R" tex_anti "\tilde{\bar d}_R" mass msd2 width wsd2 particle U_SQUARK2 2000002 spin 0 charge 2/3 color 3 name su2 anti su2c SU2 "su2~" tex_name "\tilde{u}_R" tex_anti "\tilde{\bar u}_R" mass msu2 width wsu2 particle S_SQUARK2 2000003 like D_SQUARK2 name ss2 anti ss2c SS2 "ss2~" tex_name "\tilde{s}_R" tex_anti "\tilde{\bar s}_R" mass mss2 width wss2 particle C_SQUARK2 2000004 like U_SQUARK2 name sc2 anti sc2c SC2 "sc2~" tex_name "\tilde{c}_R" tex_anti "\tilde{\bar c}_R" mass msc2 width wsc2 particle B_SQUARK2 2000005 like D_SQUARK2 name sb2 anti sb2c SB2 "sb2~" tex_name "\tilde{b}_2" tex_anti "\tilde{\bar b}_2" mass msb2 width wsb2 particle T_SQUARK2 2000006 like U_SQUARK2 name st2 anti st2c ST2 "st2~" tex_name "\tilde{t}_2" tex_anti "\tilde{\bar t}_2" mass mstop2 width wstop2 # The sleptons # Left-handed particle E_SLEPTON1 1000011 spin 0 charge -1 name "se1-" se1 se11 anti "se1+" SE1 SE11 tex_name "\tilde{e}_1^-" tex_anti "\tilde{e}_1^+" mass mse1 width wse1 particle E_SNEUTRINO1 1000012 spin 0 name snue "snu_e1" sn11 sve anti "snue*" SN11 "sve~" tex_name "\tilde\nu_e" tex_anti "\tilde\bar\nu_e" mass msne width wsne particle MU_SLEPTON1 1000013 like E_SLEPTON1 name "smu1-" smu1 se21 anti "smu1+" SMU1 SE21 tex_name "\tilde\mu_1^-" tex_anti "\tilde\mu_1^+" mass msmu1 width wsmu1 particle MU_SNEUTRINO1 1000014 like E_SNEUTRINO1 name snumu "snu_mu1" sn21 svm anti "snumu*" SN21 "svm~" tex_name "\tilde\nu_\mu" tex_anti "\tilde\bar\nu_\mu" mass msnmu width wsnmu particle TAU_SLEPTON1 1000015 like E_SLEPTON1 name "stau1-" stau1 se31 anti "stau1+" STAU1 SE31 tex_name "\tilde\tau_1^-" tex_anti "\tilde\tau_1^+" mass mstau1 width wstau1 particle TAU_SNEUTRINO1 1000016 like E_SNEUTRINO1 name snutau "snu_tau" sn31 svt anti "snutau*" SN31 "svt~" tex_name "\tilde\nu_\tau" tex_anti "\tilde\bar\nu_\tau" mass msntau width wsntau # Right-handed particle E_SLEPTON2 2000011 spin 0 charge -1 name "se2-" se2 se12 anti "se2+" SE2 SE12 tex_name "\tilde{e}_2^-" tex_anti "\tilde{e}_2^+" mass mse2 width wse2 particle MU_SLEPTON2 2000013 like E_SLEPTON2 name "smu2-" smu2 se22 anti "smu2+" SMU2 SE22 tex_name "\tilde\mu_2^-" tex_anti "\tilde\mu_2^+" mass msmu2 width wsmu2 particle TAU_SLEPTON2 2000015 like E_SLEPTON2 name "stau2-" stau2 se32 anti "stau2+" STAU2 SE32 tex_name "\tilde\tau_2^-" tex_anti "\tilde\tau_2^+" mass mstau2 width wstau2 # The gauginos particle GLUINO 1000021 spin 1/2 color 8 name sgl gg GG gluino tex_name "\tilde{g}" mass mgg width wgg particle CHARGINO1 1000024 spin 1/2 charge 1 name "ch1+" "CH1+" anti "ch1-" "CH1-" tex_name "\tilde\chi_1^+" tex_anti "\tilde\chi_1^-" mass mch1 width wch1 particle CHARGINO2 1000037 like CHARGINO1 name "ch2+" "CH2+" anti "ch2-" "CH2-" tex_name "\tilde\chi_2^+" tex_anti "\tilde\chi_2^-" mass mch2 width wch2 particle NEUTRALINO1 1000022 spin 1/2 name neu1 NEU1 tex_name "\tilde\chi_1^0" mass mneu1 width wneu1 particle NEUTRALINO2 1000023 like NEUTRALINO1 name neu2 NEU2 tex_name "\tilde\chi_2^0" mass mneu2 width wneu2 particle NEUTRALINO3 1000025 like NEUTRALINO1 name neu3 NEU3 tex_name "\tilde\chi_3^0" mass mneu3 width wneu3 particle NEUTRALINO4 1000035 like NEUTRALINO1 name neu4 NEU4 tex_name "\tilde\chi_4^0" mass mneu4 width wneu4 # Hadrons particle PROTON 2212 spin 1/2 charge 1 name p "p+" anti pbar "p-" # Beam remnants for proton colliders particle HADRON_REMNANT 90 name hr tex_name "had_r" particle HADRON_REMNANT_SINGLET 91 name hr1 tex_name "had_r^{(1)}" particle HADRON_REMNANT_TRIPLET 92 color 3 name hr3 tex_name "had_r^{(3)}" anti hr3bar tex_anti "had_r^{(\bar 3)}" particle HADRON_REMNANT_OCTET 93 color 8 name hr8 tex_name "had_r^{(8)}" ######################################################################## # Vertices of the MSSM # In graphs with identical structure, the first vertex is kept for phase space, # therefore, lighter particles come before heavier ones. ! QED vertex D d A vertex U u A vertex S s A vertex C c A vertex B b A vertex T t A vertex E1 e1 A vertex E2 e2 A vertex E3 e3 A ! QED/SUSY vertex sd1 SD1 A vertex su1 SU1 A vertex ss1 SS1 A vertex sc1 SC1 A vertex sb1 SB1 A vertex st1 ST1 A vertex se11 SE11 A vertex se21 SE21 A vertex se31 SE31 A vertex sd2 SD2 A vertex su2 SU2 A vertex ss2 SS2 A vertex sc2 SC2 A vertex sb2 SB2 A vertex st2 ST2 A vertex se12 SE12 A vertex se22 SE22 A vertex se32 SE32 A # QCD vertex G G G vertex G G G G ! SUSY QCD vertex g gg gg ! QCD fermion-gluon vertex D d G vertex U u G vertex S s G vertex C c G vertex B b G vertex T t G ! SUSY sfermion-gluon vertex sd1 SD1 g vertex sd2 SD2 g vertex su1 SU1 g vertex su2 SU2 g vertex ss1 SS1 g vertex ss2 SS2 g vertex sc1 SC1 g vertex sc2 SC2 g vertex sb1 SB1 g vertex sb2 SB2 g vertex st1 ST1 g vertex st2 ST2 g ! SUSY gluino vertex d SD1 gg vertex d SD2 gg vertex u SU1 gg vertex u SU2 gg vertex s SS1 gg vertex s SS2 gg vertex c SC1 gg vertex c SC2 gg vertex b SB1 gg vertex b SB2 gg vertex t ST1 gg vertex t ST2 gg vertex sd1 D gg vertex sd2 D gg vertex su1 U gg vertex su2 U gg vertex ss1 S gg vertex ss2 S gg vertex sc1 C gg vertex sc2 C gg vertex sb1 B gg vertex sb2 B gg vertex st1 T gg vertex st2 T gg # Neutral currents vertex D d Z vertex U u Z vertex S s Z vertex C c Z vertex B b Z vertex T t Z vertex E1 e1 Z vertex E2 e2 Z vertex E3 e3 Z vertex N1 n1 Z vertex N2 n2 Z vertex N3 n3 Z ! Neutral currents/SUSY vertex sd1 SD1 Z vertex su1 SU1 Z vertex ss1 SS1 Z vertex sc1 SC1 Z vertex sb1 SB1 Z vertex st1 ST1 Z vertex se11 SE11 Z vertex se21 SE21 Z vertex se31 SE31 Z vertex sn11 SN11 Z vertex sn21 SN21 Z vertex sn31 SN31 Z vertex sd2 SD2 Z vertex su2 SU2 Z vertex ss2 SS2 Z vertex sc2 SC2 Z vertex sb2 SB2 Z vertex st2 ST2 Z vertex se12 SE12 Z vertex se22 SE22 Z vertex se32 SE32 Z ! 3rd gen mixing vertex sb1 SB2 Z vertex sb2 SB1 Z vertex st1 ST2 Z vertex st2 ST1 Z vertex se31 SE32 Z vertex se32 SE31 Z # Charged currents vertex U d Wp vertex C s Wp vertex T b Wp vertex D u Wm vertex S c Wm vertex B t Wm vertex N1 e1 Wp vertex N2 e2 Wp vertex N3 e3 Wp vertex E1 n1 Wm vertex E2 n2 Wm vertex E3 n3 Wm ! SUSY vertex su1 SD1 Wm vertex sc1 SS1 Wm vertex st1 SB1 Wm vertex sn11 SE11 Wm vertex sn21 SE21 Wm vertex sn31 SE31 Wm vertex sd1 SU1 Wp vertex ss1 SC1 Wp vertex sb1 ST1 Wp vertex se11 SN11 Wp vertex se21 SN21 Wp vertex se31 SN31 Wp ! 3rd gen mixing vertex st1 SB2 Wm vertex st2 SB1 Wm vertex st2 SB2 Wm vertex sn31 SE32 Wm vertex sb1 ST2 Wp vertex sb2 ST1 Wp vertex sb2 ST2 Wp vertex se32 SN31 Wp # Yukawa (neutral) ### keeping only 3rd generation for the moment # vertex S s h # vertex C c h vertex B b h vertex T t h # vertex E2 e2 h vertex E3 e3 h vertex e3 E3 HH vertex b B HH vertex t T HH vertex e3 E3 HA vertex b B HA vertex t T HA # Yukawa (charged) vertex e3 N3 "H+" vertex E3 n3 "H-" vertex b T "H+" vertex B t "H-" # trilinear couplings vertex se31 SE31 h vertex se31 SE32 h vertex se32 SE31 h vertex se32 SE32 h vertex sb1 SB1 h vertex sb1 SB2 h vertex sb2 SB1 h vertex sb2 SB2 h vertex st1 ST1 h vertex st1 ST2 h vertex st2 ST1 h vertex st2 ST2 h vertex se31 SE31 HH vertex se31 SE32 HH vertex se32 SE31 HH vertex se32 SE32 HH vertex sb1 SB1 HH vertex sb1 SB2 HH vertex sb2 SB1 HH vertex sb2 SB2 HH vertex st1 ST1 HH vertex st1 ST2 HH vertex st2 ST1 HH vertex st2 ST2 HH vertex se31 SE31 HA vertex se31 SE32 HA vertex se32 SE31 HA vertex se32 SE32 HA vertex sb1 SB1 HA vertex sb1 SB2 HA vertex sb2 SB1 HA vertex sb2 SB2 HA vertex st1 ST1 HA vertex st1 ST2 HA vertex st2 ST1 HA vertex st2 ST2 HA vertex se31 SN31 "H+" vertex se32 SN31 "H+" vertex sb1 ST1 "H+" vertex sb1 ST2 "H+" vertex sb2 ST1 "H+" vertex sb2 ST2 "H+" vertex SE31 sn31 "H-" vertex SE32 sn31 "H-" vertex SB1 st1 "H-" vertex SB1 st2 "H-" vertex SB2 st1 "H-" vertex SB2 st2 "H-" # Vector-boson self-interactions vertex Wp Wm A vertex Wp Wm Z vertex Wp Wm Z Z vertex Wp Wp Wm Wm vertex Wp Wm A Z vertex Wp Wm A A # Higgs - vector boson vertex h Wp Wm vertex h Z Z vertex Wp Wm HH vertex Z Z HH vertex A "H+" "H-" vertex Z "H+" "H-" vertex Z Z HH vertex Z h HA vertex Z HH HA vertex Wp "H-" h vertex Wm "H+" h vertex Wp "H-" HH vertex Wm "H+" HH vertex Wp "H-" HA vertex Wm "H+" HA vertex h A A vertex HH A A vertex HA A A vertex h g g vertex HH g g vertex HA g g # Higgs self-interactions vertex h h h vertex h h HH vertex h HH HH vertex HH HH HH vertex h HA HA vertex HH HA HA vertex h "H+" "H-" vertex HH "H+" "H-" vertex h h h h ! Charginos vertex "ch1+" "ch1-" A vertex "ch2+" "ch2-" A vertex "ch1+" "ch1-" Z vertex "ch1+" "ch2-" Z vertex "ch2+" "ch1-" Z vertex "ch2+" "ch2-" Z ! Neutralinos vertex neu1 neu1 Z vertex neu1 neu2 Z vertex neu1 neu3 Z vertex neu1 neu4 Z vertex neu2 neu2 Z vertex neu2 neu3 Z vertex neu2 neu4 Z vertex neu3 neu3 Z vertex neu3 neu4 Z vertex neu4 neu4 Z +! Radiative decay +vertex neu1 neu2 A + ! Charginos + neutralinos vertex "ch1+" neu1 Wm vertex "ch2+" neu1 Wm vertex "ch1+" neu2 Wm vertex "ch2+" neu2 Wm vertex "ch1+" neu3 Wm vertex "ch2+" neu3 Wm vertex "ch1+" neu4 Wm vertex "ch2+" neu4 Wm vertex "ch1-" neu1 Wp vertex "ch2-" neu1 Wp vertex "ch1-" neu2 Wp vertex "ch2-" neu2 Wp vertex "ch1-" neu3 Wp vertex "ch2-" neu3 Wp vertex "ch1-" neu4 Wp vertex "ch2-" neu4 Wp ! Charginos + Higgs vertex "ch1+" "ch1-" h vertex "ch1+" "ch2-" h vertex "ch2+" "ch1-" h vertex "ch2+" "ch2-" h vertex "ch1+" "ch1-" HH vertex "ch1+" "ch2-" HH vertex "ch2+" "ch1-" HH vertex "ch2+" "ch2-" HH vertex "ch1+" "ch1-" HA vertex "ch1+" "ch2-" HA vertex "ch2+" "ch1-" HA vertex "ch2+" "ch2-" HA ! Neutralinos + Higgs vertex neu1 neu1 h vertex neu1 neu2 h vertex neu1 neu3 h vertex neu1 neu4 h vertex neu2 neu2 h vertex neu2 neu3 h vertex neu2 neu4 h vertex neu3 neu3 h vertex neu3 neu4 h vertex neu4 neu4 h vertex neu1 neu1 HH vertex neu1 neu2 HH vertex neu1 neu3 HH vertex neu1 neu4 HH vertex neu2 neu2 HH vertex neu2 neu3 HH vertex neu2 neu4 HH vertex neu3 neu3 HH vertex neu3 neu4 HH vertex neu4 neu4 HH vertex neu1 neu1 HA vertex neu1 neu2 HA vertex neu1 neu3 HA vertex neu1 neu4 HA vertex neu2 neu2 HA vertex neu2 neu3 HA vertex neu2 neu4 HA vertex neu3 neu3 HA vertex neu3 neu4 HA vertex neu4 neu4 HA ! Charginos + neutralinos + Higgs vertex "ch1+" neu1 "H-" vertex "ch2+" neu1 "H-" vertex "ch1+" neu2 "H-" vertex "ch2+" neu2 "H-" vertex "ch1+" neu3 "H-" vertex "ch2+" neu3 "H-" vertex "ch1+" neu4 "H-" vertex "ch2+" neu4 "H-" vertex "ch1-" neu1 "H+" vertex "ch2-" neu1 "H+" vertex "ch1-" neu1 "H+" vertex "ch2-" neu2 "H+" vertex "ch1-" neu3 "H+" vertex "ch2-" neu3 "H+" vertex "ch1-" neu4 "H+" vertex "ch2-" neu4 "H+" ! Lepton-slepton-neutralino vertex e1 SE11 neu1 vertex e1 SE11 neu2 vertex e1 SE11 neu3 vertex e1 SE11 neu4 vertex e1 SE12 neu1 vertex e1 SE12 neu2 vertex e1 SE12 neu3 vertex e1 SE12 neu4 vertex E1 se11 neu1 vertex E1 se11 neu2 vertex E1 se11 neu3 vertex E1 se11 neu4 vertex E1 se12 neu1 vertex E1 se12 neu2 vertex E1 se12 neu3 vertex E1 se12 neu4 vertex e2 SE21 neu1 vertex e2 SE21 neu2 vertex e2 SE21 neu3 vertex e2 SE21 neu4 vertex E2 se21 neu1 vertex E2 se21 neu2 vertex E2 se21 neu3 vertex E2 se21 neu4 vertex e2 SE22 neu1 vertex e2 SE22 neu2 vertex e2 SE22 neu3 vertex e2 SE22 neu4 vertex E2 se22 neu1 vertex E2 se22 neu2 vertex E2 se22 neu3 vertex E2 se22 neu4 vertex e3 SE31 neu1 vertex e3 SE31 neu2 vertex e3 SE31 neu3 vertex e3 SE31 neu4 vertex E3 se31 neu1 vertex E3 se31 neu2 vertex E3 se31 neu3 vertex E3 se31 neu4 vertex e3 SE32 neu1 vertex e3 SE32 neu2 vertex e3 SE32 neu3 vertex e3 SE32 neu4 vertex E3 se32 neu1 vertex E3 se32 neu2 vertex E3 se32 neu3 vertex E3 se32 neu4 ! Neutrino-sneutrino-neutralino vertex n1 SN11 neu1 vertex n1 SN11 neu2 vertex n1 SN11 neu3 vertex n1 SN11 neu4 vertex N1 sn11 neu1 vertex N1 sn11 neu2 vertex N1 sn11 neu3 vertex N1 sn11 neu4 vertex n2 SN21 neu1 vertex n2 SN21 neu2 vertex n2 SN21 neu3 vertex n2 SN21 neu4 vertex N2 sn21 neu1 vertex N2 sn21 neu2 vertex N2 sn21 neu3 vertex N2 sn21 neu4 vertex n3 SN31 neu1 vertex n3 SN31 neu2 vertex n3 SN31 neu3 vertex n3 SN31 neu4 vertex N3 sn31 neu1 vertex N3 sn31 neu2 vertex N3 sn31 neu3 vertex N3 sn31 neu4 ! Quark-squark-neutralino vertex d SD1 neu1 vertex d SD1 neu2 vertex d SD1 neu3 vertex d SD1 neu4 vertex d SD2 neu1 vertex d SD2 neu2 vertex d SD2 neu3 vertex d SD2 neu4 vertex D sd1 neu1 vertex D sd1 neu2 vertex D sd1 neu3 vertex D sd1 neu4 vertex D sd2 neu1 vertex D sd2 neu2 vertex D sd2 neu3 vertex D sd2 neu4 vertex u SU1 neu1 vertex u SU1 neu2 vertex u SU1 neu3 vertex u SU1 neu4 vertex u SU2 neu1 vertex u SU2 neu2 vertex u SU2 neu3 vertex u SU2 neu4 vertex U su1 neu1 vertex U su1 neu2 vertex U su1 neu3 vertex U su1 neu4 vertex U su2 neu1 vertex U su2 neu2 vertex U su2 neu3 vertex U su2 neu4 vertex s SS1 neu1 vertex s SS1 neu2 vertex s SS1 neu3 vertex s SS1 neu4 vertex s SS2 neu1 vertex s SS2 neu2 vertex s SS2 neu3 vertex s SS2 neu4 vertex S ss1 neu1 vertex S ss1 neu2 vertex S ss1 neu3 vertex S ss1 neu4 vertex S ss2 neu1 vertex S ss2 neu2 vertex S ss2 neu3 vertex S ss2 neu4 vertex c SC1 neu1 vertex c SC1 neu2 vertex c SC1 neu3 vertex c SC1 neu4 vertex c SC2 neu1 vertex c SC2 neu2 vertex c SC2 neu3 vertex c SC2 neu4 vertex C sc1 neu1 vertex C sc1 neu2 vertex C sc1 neu3 vertex C sc1 neu4 vertex C sc2 neu1 vertex C sc2 neu2 vertex C sc2 neu3 vertex C sc2 neu4 vertex b SB1 neu1 vertex b SB1 neu2 vertex b SB1 neu3 vertex b SB1 neu4 vertex b SB2 neu1 vertex b SB2 neu2 vertex b SB2 neu3 vertex b SB2 neu4 vertex B sb1 neu1 vertex B sb1 neu2 vertex B sb1 neu3 vertex B sb1 neu4 vertex B sb2 neu1 vertex B sb2 neu2 vertex B sb2 neu3 vertex B sb2 neu4 vertex t ST1 neu1 vertex t ST1 neu2 vertex t ST1 neu3 vertex t ST1 neu4 vertex t ST2 neu1 vertex t ST2 neu2 vertex t ST2 neu3 vertex t ST2 neu4 vertex T st1 neu1 vertex T st1 neu2 vertex T st1 neu3 vertex T st1 neu4 vertex T st2 neu1 vertex T st2 neu2 vertex T st2 neu3 vertex T st2 neu4 ! Lepton-sneutrino-chargino vertex e1 SN11 "ch1+" vertex e1 SN11 "ch2+" vertex E1 sn11 "ch1-" vertex E1 sn11 "ch2-" vertex e2 SN21 "ch1+" vertex e2 SN21 "ch2+" vertex E2 sn21 "ch1-" vertex E2 sn21 "ch2-" vertex e3 SN31 "ch1+" vertex e3 SN31 "ch2+" vertex E3 sn31 "ch1-" vertex E3 sn31 "ch2-" ! Slepton-neutrino-chargino vertex se11 N1 "ch1+" vertex se11 N1 "ch2+" vertex se12 N1 "ch1+" vertex se12 N1 "ch2+" vertex SE11 n1 "ch1-" vertex SE11 n1 "ch2-" vertex SE12 n1 "ch1-" vertex SE12 n1 "ch2-" vertex se21 N2 "ch1+" vertex se21 N2 "ch2+" vertex se22 N2 "ch1+" vertex se22 N2 "ch2+" vertex SE21 n2 "ch1-" vertex SE21 n2 "ch2-" vertex SE22 n2 "ch1-" vertex SE22 n2 "ch2-" vertex se31 N3 "ch1+" vertex se31 N3 "ch2+" vertex se32 N3 "ch1+" vertex se32 N3 "ch2+" vertex SE31 n3 "ch1-" vertex SE31 n3 "ch2-" vertex SE32 n3 "ch1-" vertex SE32 n3 "ch2-" ! Quark-squark-chargino [unit CKM matrix!] vertex d SU1 "ch1+" vertex d SU1 "ch2+" vertex d SU2 "ch1+" vertex d SU2 "ch2+" vertex D su1 "ch1-" vertex D su1 "ch2-" vertex D su2 "ch1-" vertex D su2 "ch2-" vertex sd1 U "ch1+" vertex sd1 U "ch2+" vertex sd2 U "ch1+" vertex sd2 U "ch2+" vertex SD1 u "ch1-" vertex SD1 u "ch2-" vertex SD2 u "ch1-" vertex SD2 u "ch2-" vertex s SC1 "ch1+" vertex s SC1 "ch2+" vertex s SC2 "ch1+" vertex s SC2 "ch2+" vertex S sc1 "ch1-" vertex S sc1 "ch2-" vertex S sc2 "ch1-" vertex S sc2 "ch2-" vertex ss1 C "ch1+" vertex ss1 C "ch2+" vertex ss2 C "ch1+" vertex ss2 C "ch2+" vertex SS1 c "ch1-" vertex SS1 c "ch2-" vertex SS2 c "ch1-" vertex SS2 c "ch2-" vertex b ST1 "ch1+" vertex b ST1 "ch2+" vertex b ST2 "ch1+" vertex b ST2 "ch2+" vertex B st1 "ch1-" vertex B st1 "ch2-" vertex B st2 "ch1-" vertex B st2 "ch2-" vertex sb1 T "ch1+" vertex sb1 T "ch2+" vertex sb2 T "ch1+" vertex sb2 T "ch2+" vertex SB1 t "ch1-" vertex SB1 t "ch2-" vertex SB2 t "ch1-" vertex SB2 t "ch2-"