Index: tags/ohl/attic/omega-000.011beta/src/omega_vectors.f95 =================================================================== --- tags/ohl/attic/omega-000.011beta/src/omega_vectors.f95 (revision 8686) +++ tags/ohl/attic/omega-000.011beta/src/omega_vectors.f95 (revision 8687) @@ -1,738 +0,0 @@ -! $Id: omegalib.nw,v 1.118.4.2 2006/05/15 08:39:27 ohl Exp $ -! -! Copyright (C) 2000-2002 by Thorsten Ohl -! and others -! -! O'Mega is free software; you can redistribute it and/or modify it -! under the terms of the GNU General Public License as published by -! the Free Software Foundation; either version 2, or (at your option) -! any later version. -! -! O'Mega is distributed in the hope that it will be useful, but -! WITHOUT ANY WARRANTY; without even the implied warranty of -! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -! GNU General Public License for more details. -! -! You should have received a copy of the GNU General Public License -! along with this program; if not, write to the Free Software -! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -module omega_vectors - use omega_kinds - use omega_constants - implicit none - private - public :: assignment (=) - public :: operator (*), operator (+), operator (-), operator (.wedge.) - public :: abs, conjg - public :: random_momentum - - - type, public :: momentum - ! private (omegalib needs access, but DON'T TOUCH IT!) - real(kind=omega_prec) :: t - real(kind=omega_prec), dimension(3) :: x - end type momentum - type, public :: vector - ! private (omegalib needs access, but DON'T TOUCH IT!) - complex(kind=omega_prec) :: t - complex(kind=omega_prec), dimension(3) :: x - end type vector - type, public :: tensor2odd - ! private (omegalib needs access, but DON'T TOUCH IT!) - complex(kind=omega_prec), dimension(3) :: e - complex(kind=omega_prec), dimension(3) :: b - end type tensor2odd - 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 - 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 - interface operator (*) - module procedure momentum_tensor2odd, tensor2odd_momentum, & - vector_tensor2odd, tensor2odd_vector - end interface - private :: momentum_tensor2odd, tensor2odd_momentum, vector_tensor2odd, & - tensor2odd_vector - 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 - 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 - 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 - 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 - interface abs - module procedure abs_momentum, abs_vector, abs_tensor2odd - end interface - private :: abs_momentum, abs_vector, abs_tensor2odd - interface conjg - module procedure conjg_momentum, conjg_vector, conjg_tensor2odd - end interface - private :: conjg_momentum, conjg_vector, conjg_tensor2odd - 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 - 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 - integer, parameter, public :: omega_vectors_2003_03_A = 0 -contains - pure subroutine momentum_of_array (m, p) - type(momentum), intent(out) :: m - real(kind=omega_prec), 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=omega_prec), 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=omega_prec), 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=omega_prec), 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=omega_prec), 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 - pure function momentum_momentum (x, y) result (xy) - type(momentum), intent(in) :: x - type(momentum), intent(in) :: y - real(kind=omega_prec) :: 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=omega_prec) :: 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=omega_prec) :: 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=omega_prec) :: 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 - pure function tensor2odd_tensor2odd (x, y) result (xy) - type(tensor2odd), intent(in) :: x - type(tensor2odd), intent(in) :: y - complex(kind=omega_prec) :: 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 - 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 - 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 - 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 - 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=double), 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=double), 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=double), 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=double), 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=double), 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=double), 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=double), 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=double), 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=double), 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=double), 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=double), 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=double), intent(in) :: x - type(tensor2odd) :: t2x - t2x%e = x * t2%e - t2x%b = x * t2%b - end function tensor2odd_dcomplex - 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 - 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 - pure function abs_momentum (x) result (absx) - type(momentum), intent(in) :: x - real(kind=omega_prec) :: absx - absx = sqrt (x%t*x%t + dot_product (x%x, x%x)) - end function abs_momentum - pure function abs_vector (x) result (absx) - type(vector), intent(in) :: x - real(kind=omega_prec) :: absx - absx = sqrt (conjg(x%t)*x%t + dot_product (x%x, x%x)) - end function abs_vector - pure function abs_tensor2odd (x) result (absx) - type(tensor2odd), intent(in) :: x - real(kind=omega_prec) :: absx - absx = sqrt (dot_product (x%e, x%e) + dot_product (x%b, x%b)) - end function abs_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 - pure function pseudo_scalar_momentum (p1, p2, p3, p4) result (eps1234) - type(momentum), intent(in) :: p1, p2, p3, p4 - real(kind=omega_prec) :: 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=omega_prec) :: 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=omega_prec) :: 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 - 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 - subroutine random_momentum (p, pabs, m) - type(momentum), intent(out) :: p - real(kind=omega_prec), intent(in) :: pabs, m - real(kind=omega_prec), dimension(2) :: r - real(kind=omega_prec) :: 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 -end module omega_vectors Index: tags/ohl/attic/omega-000.011beta/src/test_omega95_bispinors.f95 =================================================================== --- tags/ohl/attic/omega-000.011beta/src/test_omega95_bispinors.f95 (revision 8686) +++ tags/ohl/attic/omega-000.011beta/src/test_omega95_bispinors.f95 (revision 8687) @@ -1,291 +0,0 @@ -! $Id: omegalib.nw,v 1.118.4.2 2006/05/15 08:39:27 ohl Exp $ -! -! Copyright (C) 2000-2002 by Thorsten Ohl -! and others -! -! O'Mega is free software; you can redistribute it and/or modify it -! under the terms of the GNU General Public License as published by -! the Free Software Foundation; either version 2, or (at your option) -! any later version. -! -! O'Mega is distributed in the hope that it will be useful, but -! WITHOUT ANY WARRANTY; without even the implied warranty of -! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -! GNU General Public License for more details. -! -! You should have received a copy of the GNU General Public License -! along with this program; if not, write to the Free Software -! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -program test_omega95_bispinors - use omega_kinds - use omega95_bispinors - use omega_vspinor_polarizations - use omega_testtools - implicit none - integer :: i, j - real(kind=omega_prec) :: m, pabs, qabs, tabs, zabs, w - real(kind=omega_prec), dimension(4) :: r - complex(kind=omega_prec) :: one - type(momentum) :: p, q, t, z, p_0 - type(vector) :: vp, vq, vt, vz - type(vectorspinor) :: testv - call random_seed () - one = 1 - w = 0 - m = 13 - pabs = 42 - qabs = 137 - tabs = 84 - zabs = 3.1415 - p_0%t = m - p_0%x = 0 - call random_momentum (p, pabs, m) - call random_momentum (q, qabs, m) - call random_momentum (t, tabs, m) - call random_momentum (z, zabs, m) - call random_number (r) - do i = 1, 4 - testv%psi(1)%a(i) = (0, 0) - end do - do i = 2, 3 - do j = 1, 4 - testv%psi(i)%a(j) = cmplx (10.0_omega_prec * r(j)) - end do - end do - testv%psi(4)%a(1) = 1 - testv%psi(4)%a(1) = (0, 2.0_omega_prec) - testv%psi(4)%a(1) = 1 - testv%psi(4)%a(1) = (3.0_omega_prec, 0) - vp = p - vq = q - vt = t - vz = z -print *, "*** Checking the equations of motion ***:" -call expect (abs(f_vf(one,vp,u(m,p,+1))-m*u(m,p,+1)), 0, "|[p-m]u(+)|=0") -call expect (abs(f_vf(one,vp,u(m,p,-1))-m*u(m,p,-1)), 0, "|[p-m]u(-)|=0") -call expect (abs(f_vf(one,vp,v(m,p,+1))+m*v(m,p,+1)), 0, "|[p+m]v(+)|=0") -call expect (abs(f_vf(one,vp,v(m,p,-1))+m*v(m,p,-1)), 0, "|[p+m]v(-)|=0") -print *, "*** Checking the normalization ***:" -call expect (s_ff(one,v(m,p,+1),u(m,p,+1)), +2*m, "ubar(+)*u(+)=+2m") -call expect (s_ff(one,v(m,p,-1),u(m,p,-1)), +2*m, "ubar(-)*u(-)=+2m") -call expect (s_ff(one,u(m,p,+1),v(m,p,+1)), -2*m, "vbar(+)*v(+)=-2m") -call expect (s_ff(one,u(m,p,-1),v(m,p,-1)), -2*m, "vbar(-)*v(-)=-2m") -call expect (s_ff(one,v(m,p,+1),v(m,p,+1)), 0, "ubar(+)*v(+)=0 ") -call expect (s_ff(one,v(m,p,-1),v(m,p,-1)), 0, "ubar(-)*v(-)=0 ") -call expect (s_ff(one,u(m,p,+1),u(m,p,+1)), 0, "vbar(+)*u(+)=0 ") -call expect (s_ff(one,u(m,p,-1),u(m,p,-1)), 0, "vbar(-)*u(-)=0 ") -print *, "*** Checking the currents ***:" -call expect (abs(v_ff(one,v(m,p,+1),u(m,p,+1))-2*vp), 0, "ubar(+).V.u(+)=2p") -call expect (abs(v_ff(one,v(m,p,-1),u(m,p,-1))-2*vp), 0, "ubar(-).V.u(-)=2p") -call expect (abs(v_ff(one,u(m,p,+1),v(m,p,+1))-2*vp), 0, "vbar(+).V.v(+)=2p") -call expect (abs(v_ff(one,u(m,p,-1),v(m,p,-1))-2*vp), 0, "vbar(-).V.v(-)=2p") -print *, "*** Checking current conservation ***:" -call expect ((vp-vq)*v_ff(one,v(m,p,+1),u(m,q,+1)), 0, "d(ubar(+).V.u(+))=0") -call expect ((vp-vq)*v_ff(one,v(m,p,-1),u(m,q,-1)), 0, "d(ubar(-).V.u(-))=0") -call expect ((vp-vq)*v_ff(one,u(m,p,+1),v(m,q,+1)), 0, "d(vbar(+).V.v(+))=0") -call expect ((vp-vq)*v_ff(one,u(m,p,-1),v(m,q,-1)), 0, "d(vbar(-).V.v(-))=0") -if (m == 0) then - print *, "*** Checking axial current conservation ***:" - call expect ((vp-vq)*a_ff(one,v(m,p,+1),u(m,q,+1)), 0, "d(ubar(+).A.u(+))=0") - call expect ((vp-vq)*a_ff(one,v(m,p,-1),u(m,q,-1)), 0, "d(ubar(-).A.u(-))=0") - call expect ((vp-vq)*a_ff(one,u(m,p,+1),v(m,q,+1)), 0, "d(vbar(+).A.v(+))=0") - call expect ((vp-vq)*a_ff(one,u(m,p,-1),v(m,q,-1)), 0, "d(vbar(-).A.v(-))=0") -end if -print *, "*** Checking polarization vectors: ***" -call expect (conjg(eps(m,p, 1))*eps(m,p, 1), -1, "e( 1).e( 1)=-1") -call expect (conjg(eps(m,p, 1))*eps(m,p,-1), 0, "e( 1).e(-1)= 0") -call expect (conjg(eps(m,p,-1))*eps(m,p, 1), 0, "e(-1).e( 1)= 0") -call expect (conjg(eps(m,p,-1))*eps(m,p,-1), -1, "e(-1).e(-1)=-1") -call expect ( p*eps(m,p, 1), 0, " p.e( 1)= 0") -call expect ( p*eps(m,p,-1), 0, " p.e(-1)= 0") -if (m > 0) then - call expect (conjg(eps(m,p, 1))*eps(m,p, 0), 0, "e( 1).e( 0)= 0") - call expect (conjg(eps(m,p, 0))*eps(m,p, 1), 0, "e( 0).e( 1)= 0") - call expect (conjg(eps(m,p, 0))*eps(m,p, 0), -1, "e( 0).e( 0)=-1") - call expect (conjg(eps(m,p, 0))*eps(m,p,-1), 0, "e( 0).e(-1)= 0") - call expect (conjg(eps(m,p,-1))*eps(m,p, 0), 0, "e(-1).e( 0)= 0") - call expect ( p*eps(m,p, 0), 0, " p.e( 0)= 0") -end if -print *, "*** Checking polarization vectorspinors: ***" -call expect (abs(p * ueps(m, p, 2)), 0, "p.ueps ( 2)= 0") -call expect (abs(p * ueps(m, p, 1)), 0, "p.ueps ( 1)= 0") -call expect (abs(p * ueps(m, p, -1)), 0, "p.ueps (-1)= 0") -call expect (abs(p * ueps(m, p, -2)), 0, "p.ueps (-2)= 0") -call expect (abs(p * veps(m, p, 2)), 0, "p.veps ( 2)= 0") -call expect (abs(p * veps(m, p, 1)), 0, "p.veps ( 1)= 0") -call expect (abs(p * veps(m, p, -1)), 0, "p.veps (-1)= 0") -call expect (abs(p * veps(m, p, -2)), 0, "p.veps (-2)= 0") -print *, "*** in the rest frame ***" -call expect (abs(p_0 * ueps(m, p_0, 2)), 0, "p0.ueps ( 2)= 0") -call expect (abs(p_0 * ueps(m, p_0, 1)), 0, "p0.ueps ( 1)= 0") -call expect (abs(p_0 * ueps(m, p_0, -1)), 0, "p0.ueps (-1)= 0") -call expect (abs(p_0 * ueps(m, p_0, -2)), 0, "p0.ueps (-2)= 0") -call expect (abs(p_0 * veps(m, p_0, 2)), 0, "p0.veps ( 2)= 0") -call expect (abs(p_0 * veps(m, p_0, 1)), 0, "p0.veps ( 1)= 0") -call expect (abs(p_0 * veps(m, p_0, -1)), 0, "p0.veps (-1)= 0") -call expect (abs(p_0 * veps(m, p_0, -2)), 0, "p0.veps (-2)= 0") -print *, "*** Checking the irreducibility condition: ***" -call expect (abs(f_potgr (one, one, ueps(m, p, 2))), 0, "g.ueps ( 2)") -call expect (abs(f_potgr (one, one, ueps(m, p, 1))), 0, "g.ueps ( 1)") -call expect (abs(f_potgr (one, one, ueps(m, p, -1))), 0, "g.ueps (-1)") -call expect (abs(f_potgr (one, one, ueps(m, p, -2))), 0, "g.ueps (-2)") -call expect (abs(f_potgr (one, one, veps(m, p, 2))), 0, "g.veps ( 2)") -call expect (abs(f_potgr (one, one, veps(m, p, 1))), 0, "g.veps ( 1)") -call expect (abs(f_potgr (one, one, veps(m, p, -1))), 0, "g.veps (-1)") -call expect (abs(f_potgr (one, one, veps(m, p, -2))), 0, "g.veps (-2)") -print *, "*** in the rest frame ***" -call expect (abs(f_potgr (one, one, ueps(m, p_0, 2))), 0, "g.ueps ( 2)") -call expect (abs(f_potgr (one, one, ueps(m, p_0, 1))), 0, "g.ueps ( 1)") -call expect (abs(f_potgr (one, one, ueps(m, p_0, -1))), 0, "g.ueps (-1)") -call expect (abs(f_potgr (one, one, ueps(m, p_0, -2))), 0, "g.ueps (-2)") -call expect (abs(f_potgr (one, one, veps(m, p_0, 2))), 0, "g.veps ( 2)") -call expect (abs(f_potgr (one, one, veps(m, p_0, 1))), 0, "g.veps ( 1)") -call expect (abs(f_potgr (one, one, veps(m, p_0, -1))), 0, "g.veps (-1)") -call expect (abs(f_potgr (one, one, veps(m, p_0, -2))), 0, "g.veps (-2)") -print *, "*** Testing vectorspinor normalization ***" -call expect (veps(m,p, 2)*ueps(m,p, 2), -2*m, "ueps( 2).ueps( 2)= -2m") -call expect (veps(m,p, 1)*ueps(m,p, 1), -2*m, "ueps( 1).ueps( 1)= -2m") -call expect (veps(m,p,-1)*ueps(m,p,-1), -2*m, "ueps(-1).ueps(-1)= -2m") -call expect (veps(m,p,-2)*ueps(m,p,-2), -2*m, "ueps(-2).ueps(-2)= -2m") -call expect (ueps(m,p, 2)*veps(m,p, 2), 2*m, "veps( 2).veps( 2)= +2m") -call expect (ueps(m,p, 1)*veps(m,p, 1), 2*m, "veps( 1).veps( 1)= +2m") -call expect (ueps(m,p,-1)*veps(m,p,-1), 2*m, "veps(-1).veps(-1)= +2m") -call expect (ueps(m,p,-2)*veps(m,p,-2), 2*m, "veps(-2).veps(-2)= +2m") -call expect (ueps(m,p, 2)*ueps(m,p, 2), 0, "ueps( 2).veps( 2)= 0") -call expect (ueps(m,p, 1)*ueps(m,p, 1), 0, "ueps( 1).veps( 1)= 0") -call expect (ueps(m,p,-1)*ueps(m,p,-1), 0, "ueps(-1).veps(-1)= 0") -call expect (ueps(m,p,-2)*ueps(m,p,-2), 0, "ueps(-2).veps(-2)= 0") -call expect (veps(m,p, 2)*veps(m,p, 2), 0, "veps( 2).ueps( 2)= 0") -call expect (veps(m,p, 1)*veps(m,p, 1), 0, "veps( 1).ueps( 1)= 0") -call expect (veps(m,p,-1)*veps(m,p,-1), 0, "veps(-1).ueps(-1)= 0") -call expect (veps(m,p,-2)*veps(m,p,-2), 0, "veps(-2).ueps(-2)= 0") -print *, "*** in the rest frame ***" -call expect (veps(m,p_0, 2)*ueps(m,p_0, 2), -2*m, "ueps( 2).ueps( 2)= -2m") -call expect (veps(m,p_0, 1)*ueps(m,p_0, 1), -2*m, "ueps( 1).ueps( 1)= -2m") -call expect (veps(m,p_0,-1)*ueps(m,p_0,-1), -2*m, "ueps(-1).ueps(-1)= -2m") -call expect (veps(m,p_0,-2)*ueps(m,p_0,-2), -2*m, "ueps(-2).ueps(-2)= -2m") -call expect (ueps(m,p_0, 2)*veps(m,p_0, 2), 2*m, "veps( 2).veps( 2)= +2m") -call expect (ueps(m,p_0, 1)*veps(m,p_0, 1), 2*m, "veps( 1).veps( 1)= +2m") -call expect (ueps(m,p_0,-1)*veps(m,p_0,-1), 2*m, "veps(-1).veps(-1)= +2m") -call expect (ueps(m,p_0,-2)*veps(m,p_0,-2), 2*m, "veps(-2).veps(-2)= +2m") -call expect (ueps(m,p_0, 2)*ueps(m,p_0, 2), 0, "ueps( 2).veps( 2)= 0") -call expect (ueps(m,p_0, 1)*ueps(m,p_0, 1), 0, "ueps( 1).veps( 1)= 0") -call expect (ueps(m,p_0,-1)*ueps(m,p_0,-1), 0, "ueps(-1).veps(-1)= 0") -call expect (ueps(m,p_0,-2)*ueps(m,p_0,-2), 0, "ueps(-2).veps(-2)= 0") -call expect (veps(m,p_0, 2)*veps(m,p_0, 2), 0, "veps( 2).ueps( 2)= 0") -call expect (veps(m,p_0, 1)*veps(m,p_0, 1), 0, "veps( 1).ueps( 1)= 0") -call expect (veps(m,p_0,-1)*veps(m,p_0,-1), 0, "veps(-1).ueps(-1)= 0") -call expect (veps(m,p_0,-2)*veps(m,p_0,-2), 0, "veps(-2).ueps(-2)= 0") -print *, "*** Majorana properties of gravitino vertices: ***" -call expect (abs(u (m,q,1) * f_sgr (one, one, ueps(m,p,2), t) + & - ueps(m,p,2) * gr_sf(one,one,u(m,q,1),t)), 0, "f_sgr + gr_sf = 0") -!!! call expect (abs(u (m,q,-1) * f_sgr (one, one, ueps(m,p,2), t) + & -!!! ueps(m,p,2) * gr_sf(one,one,u(m,q,-1),t)), 0, "f_sgr + gr_sf = 0") -!!! call expect (abs(u (m,q,1) * f_sgr (one, one, ueps(m,p,1), t) + & -!!! ueps(m,p,1) * gr_sf(one,one,u(m,q,1),t)), 0, "f_sgr + gr_sf = 0") -!!! call expect (abs(u (m,q,-1) * f_sgr (one, one, ueps(m,p,1), t) + & -!!! ueps(m,p,1) * gr_sf(one,one,u(m,q,-1),t)), 0, "f_sgr + gr_sf = 0") -!!! call expect (abs(u (m,q,1) * f_sgr (one, one, ueps(m,p,-1), t) + & -!!! ueps(m,p,-1) * gr_sf(one,one,u(m,q,1),t)), 0, "f_sgr + gr_sf = 0") -!!! call expect (abs(u (m,q,-1) * f_sgr (one, one, ueps(m,p,-1), t) + & -!!! ueps(m,p,-1) * gr_sf(one,one,u(m,q,-1),t)), 0, "f_sgr + gr_sf = 0") -!!! call expect (abs(u (m,q,1) * f_sgr (one, one, ueps(m,p,-2), t) + & -!!! ueps(m,p,-2) * gr_sf(one,one,u(m,q,1),t)), 0, "f_sgr + gr_sf = 0") -!!! call expect (abs(u (m,q,-1) * f_sgr (one, one, ueps(m,p,-2), t) + & -!!! ueps(m,p,-2) * gr_sf(one,one,u(m,q,-1),t)), 0, "f_sgr + gr_sf = 0") -call expect (abs(u (m,q,1) * f_pgr (one, one, ueps(m,p,2), t) + & - ueps(m,p,2) * gr_pf(one,one,u(m,q,1),t)), 0, "f_pgr + gr_pf = 0") -call expect (abs(u (m,q,1) * f_vgr (one, vt, ueps(m,p,2), p+q) + & - ueps(m,p,2) * gr_vf(one,vt,u(m,q,1),p+q)), 0, "f_vgr + gr_vf = 0") -!!! call expect (abs(u (m,q,-1) * f_vgr (one, vt, ueps(m,p,2), p+q) + & -!!! ueps(m,p,2) * gr_vf(one,vt,u(m,q,-1),p+q)), 0, "f_vgr + gr_vf = 0") -!!! call expect (abs(u (m,q,1) * f_vgr (one, vt, ueps(m,p,1), p+q) + & -!!! ueps(m,p,1) * gr_vf(one,vt,u(m,q,1),p+q)), 0, "f_vgr + gr_vf = 0") -!!! call expect (abs(u (m,q,-1) * f_vgr (one, vt, ueps(m,p,1), p+q) + & -!!! ueps(m,p,1) * gr_vf(one,vt,u(m,q,-1),p+q)), 0, "f_vgr + gr_vf = 0") -!!! call expect (abs(u (m,q,1) * f_vgr (one, vt, ueps(m,p,-1), p+q) + & -!!! ueps(m,p,-1) * gr_vf(one,vt,u(m,q,1),p+q)), 0, "f_vgr + gr_vf = 0") -!!! call expect (abs(u (m,q,-1) * f_vgr (one, vt, veps(m,p,-1), p+q) + & -!!! veps(m,p,-1) * gr_vf(one,vt,u(m,q,-1),p+q)), 0, "f_vgr + gr_vf = 0") -!!! call expect (abs(v (m,q,1) * f_vgr (one, vt, ueps(m,p,-2), p+q) + & -!!! ueps(m,p,-2) * gr_vf(one,vt,v(m,q,1),p+q)), 0, "f_vgr + gr_vf = 0") -!!! call expect (abs(u (m,q,-1) * f_vgr (one, vt, ueps(m,p,-2), p+q) + & -!!! ueps(m,p,-2) * gr_vf(one,vt,u(m,q,-1),p+q)), 0, "f_vgr + gr_vf = 0") -call expect (abs(s_grf (one, ueps(m,p,2), u(m,q,1),t) + & - s_fgr(one,u(m,q,1),ueps(m,p,2),t)), 0, "s_grf + s_fgr = 0") -call expect (abs(p_grf (one, ueps(m,p,2), u(m,q,1),t) + & - p_fgr(one,u(m,q,1),ueps(m,p,2),t)), 0, "p_grf + p_fgr = 0") -call expect (abs(v_grf (one, ueps(m,p,2), u(m,q,1),t) + & - v_fgr(one,u(m,q,1),ueps(m,p,2),t)), 0, "v_grf + v_fgr = 0") -call expect (abs(u(m,p,1) * f_potgr (one,one,testv) - testv * gr_potf & - (one,one,u (m,p,1))), 0, "f_potgr - gr_potf = 0") -call expect (abs (pot_fgr (one,u(m,p,1),testv) - pot_grf(one, & - testv,u(m,p,1))), 0, "pot_fgr - pot_grf = 0") -call expect (abs(u(m,p,1) * f_s2gr (one,one,one,testv) - testv * gr_s2f & - (one,one,one,u (m,p,1))), 0, "f_s2gr - gr_s2f = 0") -call expect (abs (s2_fgr (one,u(m,p,1),one,testv) - s2_grf(one, & - testv,one,u(m,p,1))), 0, "s2_fgr - s2_grf = 0") -call expect (abs(u (m,q,1) * f_svgr (one, one, vt, ueps(m,p,2)) + & - ueps(m,p,2) * gr_svf(one,one,vt,u(m,q,1))), 0, "f_svgr + gr_svf = 0") -call expect (abs (sv1_fgr (one,u(m,p,1),vt,ueps(m,q,2)) + sv1_grf(one, & - ueps(m,q,2),vt,u(m,p,1))), 0, "sv1_fgr + sv1_grf = 0") -call expect (abs (sv2_fgr (one,u(m,p,1),one,ueps(m,q,2)) + sv2_grf(one, & - ueps(m,q,2),one,u(m,p,1))), 0, "sv2_fgr + sv2_grf = 0") -call expect (abs(u (m,q,1) * f_pvgr (one, one, vt, ueps(m,p,2)) + & - ueps(m,p,2) * gr_pvf(one,one,vt,u(m,q,1))), 0, "f_pvgr + gr_pvf = 0") -call expect (abs (pv1_fgr (one,u(m,p,1),vt,ueps(m,q,2)) + pv1_grf(one, & - ueps(m,q,2),vt,u(m,p,1))), 0, "pv1_fgr + pv1_grf = 0") -call expect (abs (pv2_fgr (one,u(m,p,1),one,ueps(m,q,2)) + pv2_grf(one, & - ueps(m,q,2),one,u(m,p,1))), 0, "pv2_fgr + pv2_grf = 0") -call expect (abs(u (m,q,1) * f_v2gr (one, vt, vz, ueps(m,p,2)) + & - ueps(m,p,2) * gr_v2f(one,vt,vz,u(m,q,1))), 0, "f_v2gr + gr_v2f = 0") -call expect (abs (v2_fgr (one,u(m,p,1),vt,ueps(m,q,2)) + v2_grf(one, & - ueps(m,q,2),vt,u(m,p,1))), 0, "v2_fgr + v2_grf = 0") -print *, "*** Testing the gravitino propagator: ***" -print *, "Transversality:" -call expect (abs(p * (cmplx (p*p - m**2, m*w, kind=omega_prec) * & - pr_grav(p,m,w,testv))), 0, "p.pr.test") -call expect (abs(p * (cmplx (p*p - m**2, m*w, kind=omega_prec) * & - pr_grav(p,m,w,ueps(m,p,2)))), 0, "p.pr.ueps ( 2)") -call expect (abs(p * (cmplx (p*p - m**2, m*w, kind=omega_prec) * & - pr_grav(p,m,w,ueps(m,p,1)))), 0, "p.pr.ueps ( 1)") -call expect (abs(p * (cmplx (p*p - m**2, m*w, kind=omega_prec) * & - pr_grav(p,m,w,ueps(m,p,-1)))), 0, "p.pr.ueps (-1)") -call expect (abs(p * (cmplx (p*p - m**2, m*w, kind=omega_prec) * & - pr_grav(p,m,w,ueps(m,p,-2)))), 0, "p.pr.ueps (-2)") -call expect (abs(p * (cmplx (p*p - m**2, m*w, kind=omega_prec) * & - pr_grav(p,m,w,veps(m,p,2)))), 0, "p.pr.veps ( 2)") -call expect (abs(p * (cmplx (p*p - m**2, m*w, kind=omega_prec) * & - pr_grav(p,m,w,veps(m,p,1)))), 0, "p.pr.veps ( 1)") -call expect (abs(p * (cmplx (p*p - m**2, m*w, kind=omega_prec) * & - pr_grav(p,m,w,veps(m,p,-1)))), 0, "p.pr.veps (-1)") -call expect (abs(p * (cmplx (p*p - m**2, m*w, kind=omega_prec) * & - pr_grav(p,m,w,veps(m,p,-2)))), 0, "p.pr.veps (-2)") -print *, "Irreducibility:" -call expect (abs(f_potgr (one, one, (cmplx (p*p - m**2, m*w, & - kind=omega_prec) * pr_grav(p,m,w,testv)))), 0, "g.pr.test") -call expect (abs(f_potgr (one, one, (cmplx (p*p - m**2, m*w, & - kind=omega_prec) * pr_grav(p,m,w,ueps(m,p,2))))), 0, & - "g.pr.ueps ( 2)") -call expect (abs(f_potgr (one, one, (cmplx (p*p - m**2, m*w, & - kind=omega_prec) * pr_grav(p,m,w,ueps(m,p,1))))), 0, & - "g.pr.ueps ( 1)") -call expect (abs(f_potgr (one, one, (cmplx (p*p - m**2, m*w, & - kind=omega_prec) * pr_grav(p,m,w,ueps(m,p,-1))))), 0, & - "g.pr.ueps (-1)") -call expect (abs(f_potgr (one, one, (cmplx (p*p - m**2, m*w, & - kind=omega_prec) * pr_grav(p,m,w,ueps(m,p,-2))))), 0, & - "g.pr.ueps (-2)") -call expect (abs(f_potgr (one, one, (cmplx (p*p - m**2, m*w, & - kind=omega_prec) * pr_grav(p,m,w,veps(m,p,2))))), 0, & - "g.pr.veps ( 2)") -call expect (abs(f_potgr (one, one, (cmplx (p*p - m**2, m*w, & - kind=omega_prec) * pr_grav(p,m,w,veps(m,p,1))))), 0, & - "g.pr.veps ( 1)") -call expect (abs(f_potgr (one, one, (cmplx (p*p - m**2, m*w, & - kind=omega_prec) * pr_grav(p,m,w,veps(m,p,-1))))), 0, & - "g.pr.veps (-1)") -call expect (abs(f_potgr (one, one, (cmplx (p*p - m**2, m*w, & - kind=omega_prec) * pr_grav(p,m,w,veps(m,p,-2))))), 0, & - "g.pr.veps (-2)") -end program test_omega95_bispinors Index: tags/ohl/attic/omega-000.011beta/src/omega_tensor_polarizations.f95 =================================================================== --- tags/ohl/attic/omega-000.011beta/src/omega_tensor_polarizations.f95 (revision 8686) +++ tags/ohl/attic/omega-000.011beta/src/omega_tensor_polarizations.f95 (revision 8687) @@ -1,62 +0,0 @@ -! $Id: omegalib.nw,v 1.118.4.2 2006/05/15 08:39:27 ohl Exp $ -! -! Copyright (C) 2000-2002 by Thorsten Ohl -! and others -! -! O'Mega is free software; you can redistribute it and/or modify it -! under the terms of the GNU General Public License as published by -! the Free Software Foundation; either version 2, or (at your option) -! any later version. -! -! O'Mega is distributed in the hope that it will be useful, but -! WITHOUT ANY WARRANTY; without even the implied warranty of -! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -! GNU General Public License for more details. -! -! You should have received a copy of the GNU General Public License -! along with this program; if not, write to the Free Software -! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -module omega_tensor_polarizations - use omega_kinds - use omega_constants - use omega_vectors - use omega_tensors - use omega_polarizations - implicit none - private - public :: eps2 - integer, parameter, public :: omega_tensor_pols_2003_03_A = 0 -contains - pure function eps2 (m, k, s) result (t) - type(tensor) :: t - real(kind=omega_prec), 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_omega_prec)) & - * ((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_omega_prec)) & - * ((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_omega_prec)) & - * ((em.tprod.e0) + (e0.tprod.em)) - case (-2) - em = eps (m, k, -1) - t = em.tprod.em - end select - end function eps2 -end module omega_tensor_polarizations Index: tags/ohl/attic/omega-000.011beta/src/omega_polarizations.f95 =================================================================== --- tags/ohl/attic/omega-000.011beta/src/omega_polarizations.f95 (revision 8686) +++ tags/ohl/attic/omega-000.011beta/src/omega_polarizations.f95 (revision 8687) @@ -1,176 +0,0 @@ -! $Id: omegalib.nw,v 1.118.4.2 2006/05/15 08:39:27 ohl Exp $ -! -! Copyright (C) 2000-2002 by Thorsten Ohl -! and others -! -! O'Mega is free software; you can redistribute it and/or modify it -! under the terms of the GNU General Public License as published by -! the Free Software Foundation; either version 2, or (at your option) -! any later version. -! -! O'Mega is distributed in the hope that it will be useful, but -! WITHOUT ANY WARRANTY; without even the implied warranty of -! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -! GNU General Public License for more details. -! -! You should have received a copy of the GNU General Public License -! along with this program; if not, write to the Free Software -! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -module omega_polarizations - use omega_kinds - use omega_constants - use omega_vectors - implicit none - private - public :: eps - integer, parameter, public :: omega_polarizations_2003_03_A = 0 -contains - pure function eps (m, k, s) result (e) - type(vector) :: e - real(kind=omega_prec), intent(in) :: m - type(momentum), intent(in) :: k - integer, intent(in) :: s - real(kind=omega_prec) :: kt, kabs, kabs2, sqrt2 - sqrt2 = sqrt (2.0_omega_prec) - 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=omega_prec) / sqrt2 - e%x(2) = cmplx ( 0, 1, kind=omega_prec) / sqrt2 - else - e%x(1) = cmplx ( - 1, 0, kind=omega_prec) / sqrt2 - e%x(2) = cmplx ( 0, 1, kind=omega_prec) / sqrt2 - end if - else - e%x(1) = cmplx ( k%x(3)*k%x(1)/kabs, & - - k%x(2), kind=omega_prec) / kt / sqrt2 - e%x(2) = cmplx ( k%x(2)*k%x(3)/kabs, & - k%x(1), kind=omega_prec) / 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=omega_prec) / sqrt2 - e%x(2) = cmplx ( 0, - 1, kind=omega_prec) / sqrt2 - else - e%x(1) = cmplx ( -1, 0, kind=omega_prec) / sqrt2 - e%x(2) = cmplx ( 0, - 1, kind=omega_prec) / sqrt2 - end if - else - e%x(1) = cmplx ( k%x(3)*k%x(1)/kabs, & - k%x(2), kind=omega_prec) / kt / sqrt2 - e%x(2) = cmplx ( k%x(2)*k%x(3)/kabs, & - - k%x(1), kind=omega_prec) / 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=omega_prec) / sqrt2 - e%x(2) = cmplx ( 0, 1, kind=omega_prec) / sqrt2 - case (-1) - e%x(1) = cmplx ( 1, 0, kind=omega_prec) / sqrt2 - e%x(2) = cmplx ( 0, - 1, kind=omega_prec) / sqrt2 - case (0) - if (m > 0) then - e%x(3) = 1 - end if - case (4) - if (m > 0) then - e = (1 / m) * k - else - e = (1 / k%t) * k - end if - end select - end if - end function eps - !!! OLD VERSION !!!!!! - !!! pure function eps (m, k, s) result (e) - !!! type(vector) :: e - !!! real(kind=omega_prec), intent(in) :: m - !!! type(momentum), intent(in) :: k - !!! integer, intent(in) :: s - !!! real(kind=omega_prec) :: kt, kabs, kabs2, sqrt2 - !!! integer, parameter :: x = 2, y = 3, z = 1 - !!! sqrt2 = sqrt (2.0_omega_prec) - !!! kabs2 = dot_product (k%x, k%x) - !!! e%t = 0 - !!! e%x = 0 - !!! if (kabs2 > 0) then - !!! kabs = sqrt (kabs2) - !!! select case (s) - !!! case (1) - !!! kt = sqrt (k%x(x)**2 + k%x(y)**2) - !!! e%x(x) = cmplx ( k%x(z)*k%x(x)/kabs, & - !!! - k%x(y), kind=omega_prec) / kt / sqrt2 - !!! e%x(y) = cmplx ( k%x(y)*k%x(z)/kabs, & - !!! k%x(x), kind=omega_prec) / kt / sqrt2 - !!! e%x(z) = - kt / kabs / sqrt2 - !!! case (-1) - !!! kt = sqrt (k%x(x)**2 + k%x(y)**2) - !!! e%x(x) = cmplx ( k%x(z)*k%x(x)/kabs, & - !!! k%x(y), kind=omega_prec) / kt / sqrt2 - !!! e%x(y) = cmplx ( k%x(y)*k%x(z)/kabs, & - !!! - k%x(x), kind=omega_prec) / kt / sqrt2 - !!! e%x(z) = - kt / kabs / sqrt2 - !!! case (0) - !!! if (m > 0) then - !!! e%t = kabs / m - !!! e%x = k%t / (m*kabs) * k%x - !!! end if - !!! case (3) - !!! e = (0,1) * k - !!! case (4) - !!! if (m > 0) then - !!! e = (1 / m) * k - !!! else - !!! e = (1 / k%t) * k - !!! end if - !!! end select - !!! else - !!! select case (s) - !!! case (1) - !!! e%x(x) = cmplx ( 1, 0, kind=omega_prec) / sqrt2 - !!! e%x(y) = cmplx ( 0, 1, kind=omega_prec) / sqrt2 - !!! case (-1) - !!! e%x(x) = cmplx ( 1, 0, kind=omega_prec) / sqrt2 - !!! e%x(y) = cmplx ( 0, - 1, kind=omega_prec) / sqrt2 - !!! case (0) - !!! if (m > 0) then - !!! e%x(z) = 1 - !!! end if - !!! case (4) - !!! if (m > 0) then - !!! e = (1 / m) * k - !!! else - !!! e = (1 / k%t) * k - !!! end if - !!! end select - !!! end if - !!! end function eps - !!!!!!!!!!!!!!!!!!!!!!!! -end module omega_polarizations Index: tags/ohl/attic/omega-000.011beta/src/omega_bispinor_couplings.f95 =================================================================== --- tags/ohl/attic/omega-000.011beta/src/omega_bispinor_couplings.f95 (revision 8686) +++ tags/ohl/attic/omega-000.011beta/src/omega_bispinor_couplings.f95 (revision 8687) @@ -1,1721 +0,0 @@ -! $Id: omegalib.nw,v 1.118.4.2 2006/05/15 08:39:27 ohl Exp $ -! -! Copyright (C) 2000-2002 by Thorsten Ohl -! and others -! -! O'Mega is free software; you can redistribute it and/or modify it -! under the terms of the GNU General Public License as published by -! the Free Software Foundation; either version 2, or (at your option) -! any later version. -! -! O'Mega is distributed in the hope that it will be useful, but -! WITHOUT ANY WARRANTY; without even the implied warranty of -! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -! GNU General Public License for more details. -! -! You should have received a copy of the GNU General Public License -! along with this program; if not, write to the Free Software -! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -module omega_bispinor_couplings - use omega_kinds - use omega_constants - use omega_bispinors - use omega_vectorspinors - use omega_vectors - implicit none - private - public :: u, v, ghost - public :: brs_u, brs_v - public :: va_ff, v_ff, a_ff, vl_ff, vr_ff, vlr_ff - public :: f_vaf, f_vf, f_af, f_vlf, f_vrf, f_vlrf - public :: sp_ff, s_ff, p_ff, sl_ff, sr_ff, slr_ff - public :: f_spf, f_sf, f_pf, f_slf, f_srf, f_slrf - private :: vv_ff, f_vvf - public :: vmom_ff, mom_ff, mom5_ff, moml_ff, momr_ff, lmom_ff, rmom_ff - public :: f_vmomf, f_momf, f_mom5f, f_momlf, f_momrf, f_lmomf, f_rmomf - public :: v2_ff, sv1_ff, sv2_ff, pv1_ff, pv2_ff, svl1_ff, svl2_ff, & - svr1_ff, svr2_ff, svlr1_ff, svlr2_ff - public :: f_v2f, f_svf, f_pvf, f_svlf, f_svrf, f_svlrf - public :: pot_grf, pot_fgr, s_grf, s_fgr, p_grf, p_fgr - private :: fgvgr, fgvg5gr, fggvvgr, grkgf, grkggf, grkkggf, & - fgkgr, fg5gkgr, grvgf, grg5vgf, grkgggf, fggkggr - public :: f_potgr, f_sgr, f_pgr, f_vgr - public :: gr_potf, gr_sf, gr_pf, gr_vf - public :: v_grf, v_fgr - public :: f_s2gr, f_svgr, f_pvgr, f_v2gr - public :: gr_s2f, gr_svf, gr_pvf, gr_v2f - public :: s2_grf, s2_fgr, sv1_grf, sv2_grf, sv1_fgr, sv2_fgr, & - pv1_grf, pv2_grf, pv1_fgr, pv2_fgr, v2_grf, v2_fgr - public :: pr_psi, pr_grav - public :: pj_psi - integer, parameter, public :: omega_bispinor_cpls_2003_03_A = 0 -contains - pure function u (m, p, s) result (psi) - type(bispinor) :: psi - real(kind=omega_prec), intent(in) :: m - type(momentum), intent(in) :: p - integer, intent(in) :: s - complex(kind=omega_prec), dimension(2) :: chip, chim - real(kind=omega_prec) :: pabs, norm - pabs = sqrt (dot_product (p%x, p%x)) - if (1 + p%x(3) / pabs <= epsilon (pabs)) then - chip = (/ cmplx ( 0.0, 0.0, kind=omega_prec), & - cmplx ( 1.0, 0.0, kind=omega_prec) /) - chim = (/ cmplx (-1.0, 0.0, kind=omega_prec), & - cmplx ( 0.0, 0.0, kind=omega_prec) /) - else - norm = 1 / sqrt (2*pabs*(pabs + p%x(3))) - chip = norm * (/ cmplx (pabs + p%x(3), kind=omega_prec), & - cmplx (p%x(1), p%x(2), kind=omega_prec) /) - chim = norm * (/ cmplx (-p%x(1), p%x(2), kind=omega_prec), & - cmplx (pabs + p%x(3), kind=omega_prec) /) - end if - if (s > 0) then - psi%a(1:2) = sqrt (max (p%t - pabs, 0.0_omega_prec)) * chip - psi%a(3:4) = sqrt (p%t + pabs) * chip - else - psi%a(1:2) = sqrt (p%t + pabs) * chim - psi%a(3:4) = sqrt (max (p%t - pabs, 0.0_omega_prec)) * chim - end if - pabs = m ! make the compiler happy and use m - end function u - !pure function u (m, p, s) result (psi) - ! type(bispinor) :: psi - ! real(kind=omega_prec), intent(in) :: m - ! type(momentum), intent(in) :: p - ! integer, intent(in) :: s - ! complex(kind=omega_prec), dimension(2) :: chip, chim - ! real(kind=omega_prec) :: pabs, norm - ! pabs = sqrt (dot_product (p%x, p%x)) - ! if (p%x(3) <= epsilon(p%x(3))) then - ! chip = (/ cmplx ( 0.0, 0.0, kind=omega_prec), & - ! cmplx ( 1.0, 0.0, kind=omega_prec) /) - ! chim = (/ cmplx (-1.0, 0.0, kind=omega_prec), & - ! cmplx ( 0.0, 0.0, kind=omega_prec) /) - ! else - ! if (1 + p%x(3) / pabs <= epsilon (pabs)) then - ! chip = (/ cmplx ( 0.0, 0.0, kind=omega_prec), & - ! cmplx ( 1.0, 0.0, kind=omega_prec) /) - ! chim = (/ cmplx (-1.0, 0.0, kind=omega_prec), & - ! cmplx ( 0.0, 0.0, kind=omega_prec) /) - ! else - ! norm = 1 / sqrt (2*pabs*(pabs + p%x(3))) - ! chip = norm * (/ cmplx (pabs + p%x(3), kind=omega_prec), & - ! cmplx (p%x(1), p%x(2), kind=omega_prec) /) - ! chim = norm * (/ cmplx (-p%x(1), p%x(2), kind=omega_prec), & - ! cmplx (pabs + p%x(3), kind=omega_prec) /) - ! end if - ! end if - ! if (s > 0) then - ! psi%a(1:2) = sqrt (max (p%t - pabs, 0.0_omega_prec)) * chip - ! psi%a(3:4) = sqrt (p%t + pabs) * chip - ! else - ! psi%a(1:2) = sqrt (p%t + pabs) * chim - ! psi%a(3:4) = sqrt (max (p%t - pabs, 0.0_omega_prec)) * chim - ! end if - ! pabs = m ! make the compiler happy and use m - !end function u - pure function v (m, p, s) result (psi) - type(bispinor) :: psi - real(kind=omega_prec), intent(in) :: m - type(momentum), intent(in) :: p - integer, intent(in) :: s - complex(kind=omega_prec), dimension(2) :: chip, chim - real(kind=omega_prec) :: pabs, norm - pabs = sqrt (dot_product (p%x, p%x)) - if (1 + p%x(3) / pabs <= epsilon (pabs)) then - chip = (/ cmplx ( 0.0, 0.0, kind=omega_prec), & - cmplx ( 1.0, 0.0, kind=omega_prec) /) - chim = (/ cmplx (-1.0, 0.0, kind=omega_prec), & - cmplx ( 0.0, 0.0, kind=omega_prec) /) - else - norm = 1 / sqrt (2*pabs*(pabs + p%x(3))) - chip = norm * (/ cmplx (pabs + p%x(3), kind=omega_prec), & - cmplx (p%x(1), p%x(2), kind=omega_prec) /) - chim = norm * (/ cmplx (-p%x(1), p%x(2), kind=omega_prec), & - cmplx (pabs + p%x(3), kind=omega_prec) /) - end if - if (s > 0) then - psi%a(1:2) = - sqrt (p%t + pabs) * chim - psi%a(3:4) = sqrt (max (p%t - pabs, 0.0_omega_prec)) * chim - else - psi%a(1:2) = sqrt (max (p%t - pabs, 0.0_omega_prec)) * chip - psi%a(3:4) = - sqrt (p%t + pabs) * chip - end if - pabs = m ! make the compiler happy and use m - end function v - !pure function v (m, p, s) result (psi) - ! type(bispinor) :: psi - ! real(kind=omega_prec), intent(in) :: m - ! type(momentum), intent(in) :: p - ! integer, intent(in) :: s - ! complex(kind=omega_prec), dimension(2) :: chip, chim - ! real(kind=omega_prec) :: pabs, norm - ! pabs = sqrt (dot_product (p%x, p%x)) - ! if (p%x(3) <= epsilon (p%x(3))) then - ! chip = (/ cmplx ( 1.0, 0.0, kind=omega_prec), & - ! cmplx ( 0.0, 0.0, kind=omega_prec) /) - ! chim = (/ cmplx ( 0.0, 0.0, kind=omega_prec), & - ! cmplx ( 1.0, 0.0, kind=omega_prec) /) - ! else - ! if (1 + p%x(3) / pabs <= epsilon (pabs)) then - ! chip = (/ cmplx ( 0.0, 0.0, kind=omega_prec), & - ! cmplx ( 1.0, 0.0, kind=omega_prec) /) - ! chim = (/ cmplx (-1.0, 0.0, kind=omega_prec), & - ! cmplx ( 0.0, 0.0, kind=omega_prec) /) - ! else - ! norm = 1 / sqrt (2*pabs*(pabs + p%x(3))) - ! chip = norm * (/ cmplx (pabs + p%x(3), kind=omega_prec), & - ! cmplx (p%x(1), p%x(2), kind=omega_prec) /) - ! chim = norm * (/ cmplx (-p%x(1), p%x(2), kind=omega_prec), & - ! cmplx (pabs + p%x(3), kind=omega_prec) /) - ! end if - ! end if - ! if (s > 0) then - ! psi%a(1:2) = - sqrt (p%t + pabs) * chim - ! psi%a(3:4) = sqrt (max (p%t - pabs, 0.0_omega_prec)) * chim - ! else - ! psi%a(1:2) = sqrt (max (p%t - pabs, 0.0_omega_prec)) * chip - ! psi%a(3:4) = - sqrt (p%t + pabs) * chip - ! end if - ! pabs = m ! make the compiler happy and use m - !end function v - pure function ghost (m, p, s) result (psi) - type(bispinor) :: psi - real(kind=omega_prec), 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 - pure function brs_u (m, p, s) result (dpsi) - type(bispinor) :: dpsi, psi - real(kind=omega_prec), intent(in) :: m - type(momentum), intent(in) :: p - integer, intent(in) :: s - type (vector)::vp - complex(kind=omega_prec), 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 - pure function brs_v (m, p, s) result (dpsi) - type(bispinor) :: dpsi, psi - real(kind=omega_prec), intent(in) :: m - type(momentum), intent(in) :: p - integer, intent(in) :: s - type (vector)::vp - complex(kind=omega_prec), 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 - pure function va_ff (gv, ga, psil, psir) result (j) - type(vector) :: j - complex(kind=omega_prec), intent(in) :: gv, ga - type(bispinor), intent(in) :: psil, psir - complex(kind=omega_prec) :: gl, gr - complex(kind=omega_prec) :: g13, g14, g23, g24, g31, g32, g41, g42 - gl = gv + ga - gr = gv - ga - g13 = psil%a(1)*psir%a(3) - g14 = psil%a(1)*psir%a(4) - g23 = psil%a(2)*psir%a(3) - g24 = psil%a(2)*psir%a(4) - g31 = psil%a(3)*psir%a(1) - g32 = psil%a(3)*psir%a(2) - g41 = psil%a(4)*psir%a(1) - g42 = psil%a(4)*psir%a(2) - j%t = gr * ( g14 - g23) + gl * ( - g32 + g41) - j%x(1) = gr * ( g13 - g24) + gl * ( g31 - g42) - j%x(2) = (gr * ( g13 + g24) + gl * ( g31 + g42)) * (0, 1) - j%x(3) = gr * ( - g14 - g23) + gl * ( - g32 - g41) - end function va_ff - pure function v_ff (gv, psil, psir) result (j) - type(vector) :: j - complex(kind=omega_prec), intent(in) :: gv - type(bispinor), intent(in) :: psil, psir - complex(kind=omega_prec) :: 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=omega_prec), intent(in) :: ga - type(bispinor), intent(in) :: psil, psir - complex(kind=omega_prec) :: 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=omega_prec), intent(in) :: gl - type(bispinor), intent(in) :: psil, psir - complex(kind=omega_prec) :: gl2 - complex(kind=omega_prec) :: 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=omega_prec), intent(in) :: gr - type(bispinor), intent(in) :: psil, psir - complex(kind=omega_prec) :: gr2 - complex(kind=omega_prec) :: 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=omega_prec), 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 f_vaf (gv, ga, v, psi) result (vpsi) - type(bispinor) :: vpsi - complex(kind=omega_prec), intent(in) :: gv, ga - type(vector), intent(in) :: v - type(bispinor), intent(in) :: psi - complex(kind=omega_prec) :: gl, gr - complex(kind=omega_prec) :: vp, vm, v12, v12s - gl = gv + ga - gr = gv - ga - vp = v%t + v%x(3) - vm = v%t - v%x(3) - v12 = v%x(1) + (0,1)*v%x(2) - v12s = v%x(1) - (0,1)*v%x(2) - vpsi%a(1) = gr * ( vm * psi%a(3) - v12s * psi%a(4)) - vpsi%a(2) = gr * ( - v12 * psi%a(3) + vp * psi%a(4)) - vpsi%a(3) = gl * ( vp * psi%a(1) + v12s * psi%a(2)) - vpsi%a(4) = gl * ( v12 * psi%a(1) + vm * psi%a(2)) - end function f_vaf - pure function f_vf (gv, v, psi) result (vpsi) - type(bispinor) :: vpsi - complex(kind=omega_prec), intent(in) :: gv - type(vector), intent(in) :: v - type(bispinor), intent(in) :: psi - complex(kind=omega_prec) :: 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=omega_prec), intent(in) :: ga - type(vector), intent(in) :: v - type(bispinor), intent(in) :: psi - complex(kind=omega_prec) :: 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=omega_prec), intent(in) :: gl - type(vector), intent(in) :: v - type(bispinor), intent(in) :: psi - complex(kind=omega_prec) :: gl2 - complex(kind=omega_prec) :: 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=omega_prec), intent(in) :: gr - type(vector), intent(in) :: v - type(bispinor), intent(in) :: psi - complex(kind=omega_prec) :: gr2 - complex(kind=omega_prec) :: 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=omega_prec), 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 sp_ff (gs, gp, psil, psir) result (j) - complex(kind=omega_prec) :: j - complex(kind=omega_prec), 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=omega_prec) :: j - complex(kind=omega_prec), 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=omega_prec) :: j - complex(kind=omega_prec), 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=omega_prec) :: j - complex(kind=omega_prec), 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=omega_prec) :: j - complex(kind=omega_prec), 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=omega_prec) :: j - complex(kind=omega_prec), 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 - pure function f_spf (gs, gp, phi, psi) result (phipsi) - type(bispinor) :: phipsi - complex(kind=omega_prec), intent(in) :: gs, gp - complex(kind=omega_prec), 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=omega_prec), intent(in) :: gs - complex(kind=omega_prec), 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=omega_prec), intent(in) :: gp - complex(kind=omega_prec), 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=omega_prec), intent(in) :: gl - complex(kind=omega_prec), 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=omega_prec), intent(in) :: gr - complex(kind=omega_prec), 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=omega_prec), intent(in) :: gl, gr - complex(kind=omega_prec), intent(in) :: phi - type(bispinor), intent(in) :: psi - phipsi = f_spf (gr+gl, gr-gl, phi, psi) - end function f_slrf - 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=omega_prec) :: 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=omega_prec) :: kv30, kv21, kv01, kv31, kv02, kv32 - complex(kind=omega_prec) :: 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=omega_prec), 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=omega_prec) :: psibarpsi - type(bispinor), intent(in) :: psibar, psi - type(momentum), intent(in) :: k - complex(kind=omega_prec), intent(in) :: g, m - type(bispinor) :: kmpsi - complex(kind=omega_prec) :: 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=omega_prec) :: psibarpsi - type(bispinor), intent(in) :: psibar, psi - type(momentum), intent(in) :: k - complex(kind=omega_prec), 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=omega_prec) :: psibarpsi - type(bispinor), intent(in) :: psibar, psi - type(momentum), intent(in) :: k - complex(kind=omega_prec), 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=omega_prec) :: psibarpsi - type(bispinor), intent(in) :: psibar, psi - type(momentum), intent(in) :: k - complex(kind=omega_prec), 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=omega_prec) :: psibarpsi - type(bispinor), intent(in) :: psibar, psi - type(momentum), intent(in) :: k - complex(kind=omega_prec), 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=omega_prec) :: psibarpsi - type(bispinor), intent(in) :: psibar, psi - type(momentum), intent(in) :: k - complex(kind=omega_prec), intent(in) :: g, m - psibarpsi = mom_ff (g, m, psibar, psi, k) - & - mom5_ff (g,-m, psibar, psi, k) - end function rmom_ff - pure function f_vmomf (g, v, psi, k) result (kvpsi) - type(bispinor) :: kvpsi - type(bispinor), intent(in) :: psi - complex(kind=omega_prec), 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=omega_prec), intent(in) :: phi, g, m - type(momentum), intent(in) :: k - complex(kind=omega_prec) :: 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=omega_prec), 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=omega_prec), 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=omega_prec), 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=omega_prec), 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=omega_prec), 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 - pure function v2_ff (g, psibar, v, psi) result (v2) - type(vector) :: v2 - complex (kind=omega_prec), 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=omega_prec) :: phi - type(bispinor), intent(in) :: psibar, psi - type(vector), intent(in) :: v - complex(kind=omega_prec), 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=omega_prec), 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=omega_prec) :: phi - type(bispinor), intent(in) :: psibar, psi - type(vector), intent(in) :: v - complex(kind=omega_prec), 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=omega_prec), 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=omega_prec) :: phi - type(bispinor), intent(in) :: psibar, psi - type(vector), intent(in) :: v - complex(kind=omega_prec), 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=omega_prec), 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=omega_prec) :: phi - type(bispinor), intent(in) :: psibar, psi - type(vector), intent(in) :: v - complex(kind=omega_prec), 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=omega_prec), 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=omega_prec) :: phi - type(bispinor), intent(in) :: psibar, psi - type(vector), intent(in) :: v - complex(kind=omega_prec), 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=omega_prec), intent(in) :: phi, gl, gr - type(bispinor), intent(in) :: psibar, psi - v = phi * vlr_ff (gl, gr, psibar, psi) - end function svlr2_ff - pure function f_v2f (g, v1, v2, psi) result (vpsi) - type(bispinor) :: vpsi - complex(kind=omega_prec), 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=omega_prec), 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=omega_prec), 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=omega_prec), 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=omega_prec), 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=omega_prec), 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 - pure function pot_grf (g, gravbar, psi) result (j) - complex(kind=omega_prec) :: j - complex(kind=omega_prec), 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=omega_prec) :: j - complex(kind=omega_prec), 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=omega_prec) :: j - complex(kind=omega_prec) :: 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=omega_prec) :: 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=omega_prec) :: j - complex(kind=omega_prec), intent(in) :: g - type(vectorspinor), intent(in) :: gravbar - type(bispinor), intent(in) :: psi - type(momentum), intent(in) :: k - type(vector) :: vk - vk = k - j = g * grvgf (gravbar, psi, vk) - end function s_grf - pure function fgkgr (psibar, grav, k) result (j) - complex(kind=omega_prec) :: j - complex(kind=omega_prec) :: 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=omega_prec) :: 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=omega_prec) :: j - complex(kind=omega_prec), intent(in) :: g - type(bispinor), intent(in) :: psibar - type(vectorspinor), intent(in) :: grav - type(momentum), intent(in) :: k - type(vector) :: vk - vk = k - j = g * fgkgr (psibar, grav, vk) - end function s_fgr - pure function p_grf (g, gravbar, psi, k) result (j) - complex(kind=omega_prec) :: j - complex(kind=omega_prec), 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=omega_prec) :: j - complex(kind=omega_prec), 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 - pure function f_potgr (g, phi, psi) result (phipsi) - type(bispinor) :: phipsi - complex(kind=omega_prec), intent(in) :: g - complex(kind=omega_prec), 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 - pure function fgvgr (psi, k) result (kpsi) - type(bispinor) :: kpsi - complex(kind=omega_prec) :: 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=omega_prec), intent(in) :: g - complex(kind=omega_prec), intent(in) :: phi - type(momentum), intent(in) :: k - type(vectorspinor), intent(in) :: psi - type(vector) :: vk - vk = k - phipsi = (g * phi) * fgvgr (psi, vk) - end function f_sgr - pure function fgvg5gr (psi, k) result (kpsi) - type(bispinor) :: kpsi - type(vector), intent(in) :: k - type(vectorspinor), intent(in) :: psi - type(bispinor) :: kpsi_dum - kpsi_dum = fgvgr (psi, k) - kpsi%a(1:2) = - kpsi_dum%a(1:2) - kpsi%a(3:4) = kpsi_dum%a(3:4) - end function fgvg5gr - pure function f_pgr (g, phi, psi, k) result (phipsi) - type(bispinor) :: phipsi - complex(kind=omega_prec), intent(in) :: g - complex(kind=omega_prec), 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 - pure function fggvvgr (v, psi, k) result (psikv) - type(bispinor) :: psikv - type(vectorspinor), intent(in) :: psi - type(vector), intent(in) :: v, k - complex(kind=omega_prec) :: kv30, kv21, kv01, kv31, kv02, kv32 - complex(kind=omega_prec) :: ap, am, bp, bm, bps, bms - kv30 = k%x(3) * v%t - k%t * v%x(3) - kv21 = (0,1) * (k%x(2) * v%x(1) - k%x(1) * v%x(2)) - kv01 = k%t * v%x(1) - k%x(1) * v%t - kv31 = k%x(3) * v%x(1) - k%x(1) * v%x(3) - kv02 = (0,1) * (k%t * v%x(2) - k%x(2) * v%t) - kv32 = (0,1) * (k%x(3) * v%x(2) - k%x(2) * v%x(3)) - ap = 2 * (kv30 + kv21) - am = 2 * (-kv30 + kv21) - bp = 2 * (kv01 + kv31 + kv02 + kv32) - bm = 2 * (kv01 - kv31 + kv02 - kv32) - bps = 2 * (kv01 + kv31 - kv02 - kv32) - bms = 2 * (kv01 - kv31 - kv02 + kv32) - psikv%a(1) = -ap * psi%psi(1)%a(3) + bps * psi%psi(1)%a(4) & - - bm * psi%psi(2)%a(3) - ap * psi%psi(2)%a(4) & - + (0,1) * (bm * psi%psi(3)%a(3) + ap * psi%psi(3)%a(4)) & - + ap * psi%psi(4)%a(3) - bps * psi%psi(4)%a(4) - psikv%a(2) = bm * psi%psi(1)%a(3) + ap * psi%psi(1)%a(4) & - + ap * psi%psi(2)%a(3) - bps * psi%psi(2)%a(4) & - + (0,1) * (ap * psi%psi(3)%a(3) - bps * psi%psi(3)%a(4)) & - + bm * psi%psi(4)%a(3) + ap * psi%psi(4)%a(4) - psikv%a(3) = am * psi%psi(1)%a(1) + bms * psi%psi(1)%a(2) & - + bp * psi%psi(2)%a(1) - am * psi%psi(2)%a(2) & - - (0,1) * (bp * psi%psi(3)%a(1) - am * psi%psi(3)%a(2)) & - + am * psi%psi(4)%a(1) + bms * psi%psi(4)%a(2) - psikv%a(4) = bp * psi%psi(1)%a(1) - am * psi%psi(1)%a(2) & - + am * psi%psi(2)%a(1) + bms * psi%psi(2)%a(2) & - + (0,1) * (am * psi%psi(3)%a(1) + bms * psi%psi(3)%a(2)) & - - bp * psi%psi(4)%a(1) + am * psi%psi(4)%a(2) - end function fggvvgr - pure function f_vgr (g, v, psi, k) result (psikv) - type(bispinor) :: psikv - type(vectorspinor), intent(in) :: psi - type(vector), intent(in) :: v - type(momentum), intent(in) :: k - complex(kind=omega_prec), intent(in) :: g - type(vector) :: vk - vk = k - psikv = g * fggvvgr (v, psi, vk) - end function f_vgr - pure function gr_potf (g, phi, psi) result (phipsi) - type(vectorspinor) :: phipsi - complex(kind=omega_prec), intent(in) :: g - complex(kind=omega_prec), 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=omega_prec) :: 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=omega_prec), intent(in) :: g - complex(kind=omega_prec), intent(in) :: phi - type(bispinor), intent(in) :: psi - type(momentum), intent(in) :: k - type(vector) :: vk - vk = k - phipsi = (g * phi) * grkgf (psi, vk) - end function gr_sf - pure function grkggf (psi, k) result (kpsi) - type(vectorspinor) :: kpsi - complex(kind=omega_prec) :: 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=omega_prec), intent(in) :: g - complex(kind=omega_prec), 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=omega_prec) :: kv30, kv21, kv01, kv31, kv02, kv32 - complex(kind=omega_prec) :: ap, am, bp, bm, bps, bms - kv30 = k%x(3) * v%t - k%t * v%x(3) - kv21 = (0,1) * (k%x(2) * v%x(1) - k%x(1) * v%x(2)) - kv01 = k%t * v%x(1) - k%x(1) * v%t - kv31 = k%x(3) * v%x(1) - k%x(1) * v%x(3) - kv02 = (0,1) * (k%t * v%x(2) - k%x(2) * v%t) - kv32 = (0,1) * (k%x(3) * v%x(2) - k%x(2) * v%x(3)) - ap = 2 * (kv30 + kv21) - am = 2 * (-kv30 + kv21) - bp = 2 * (kv01 + kv31 + kv02 + kv32) - bm = 2 * (kv01 - kv31 + kv02 - kv32) - bps = 2 * (kv01 + kv31 - kv02 - kv32) - bms = 2 * (kv01 - kv31 - kv02 + kv32) - psikv%psi(1)%a(1) = am * psi%a(3) + bms * psi%a(4) - psikv%psi(1)%a(2) = bp * psi%a(3) - am * psi%a(4) - psikv%psi(1)%a(3) = -ap * psi%a(1) + bps * psi%a(2) - psikv%psi(1)%a(4) = bm * psi%a(1) + ap * psi%a(2) - psikv%psi(2)%a(1) = bms * psi%a(3) + am * psi%a(4) - psikv%psi(2)%a(2) = -am * psi%a(3) + bp * psi%a(4) - psikv%psi(2)%a(3) = -bps * psi%a(1) + ap * psi%a(2) - psikv%psi(2)%a(4) = -ap * psi%a(1) - bm * psi%a(2) - psikv%psi(3)%a(1) = (0,1) * (bms * psi%a(3) - am * psi%a(4)) - psikv%psi(3)%a(2) = (0,-1) * (am * psi%a(3) + bp * psi%a(4)) - psikv%psi(3)%a(3) = (0,-1) * (bps * psi%a(1) + ap * psi%a(2)) - psikv%psi(3)%a(4) = (0,1) * (-ap * psi%a(1) + bm * psi%a(2)) - psikv%psi(4)%a(1) = am * psi%a(3) - bms * psi%a(4) - psikv%psi(4)%a(2) = bp * psi%a(3) + am * psi%a(4) - psikv%psi(4)%a(3) = ap * psi%a(1) + bps * psi%a(2) - psikv%psi(4)%a(4) = -bm * psi%a(1) + ap * psi%a(2) - end function grkkggf - pure function gr_vf (g, v, psi, k) result (psikv) - type(vectorspinor) :: psikv - type(bispinor), intent(in) :: psi - type(vector), intent(in) :: v - type(momentum), intent(in) :: k - complex(kind=omega_prec), intent(in) :: g - type(vector) :: vk - vk = k - psikv = g * grkkggf (v, psi, vk) - end function gr_vf - 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=omega_prec) :: 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=omega_prec), 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 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=omega_prec) :: 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=omega_prec), 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 f_s2gr (g, phi1, phi2, psi) result (phipsi) - type(bispinor) :: phipsi - type(vectorspinor), intent(in) :: psi - complex(kind=omega_prec), intent(in) :: g - complex(kind=omega_prec), 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=omega_prec), intent(in) :: g, phi - phigrav = (g * phi) * fgvg5gr (grav, v) - end function f_svgr - pure function f_pvgr (g, phi, v, grav) result (phigrav) - type(bispinor) :: phigrav - type(vectorspinor), intent(in) :: grav - type(vector), intent(in) :: v - complex(kind=omega_prec), 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=omega_prec), 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 gr_s2f (g, phi1, phi2, psi) result (phipsi) - type(vectorspinor) :: phipsi - type(bispinor), intent(in) :: psi - complex(kind=omega_prec), intent(in) :: g - complex(kind=omega_prec), 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=omega_prec), intent(in) :: g, phi - phipsi = (g * phi) * grkggf (psi, v) - end function gr_svf - pure function gr_pvf (g, phi, v, psi) result (phipsi) - type(vectorspinor) :: phipsi - type(bispinor), intent(in) :: psi - type(vector), intent(in) :: v - complex(kind=omega_prec), 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=omega_prec), 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 s2_grf (g, gravbar, phi, psi) result (j) - complex(kind=omega_prec) :: j - complex(kind=omega_prec), 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=omega_prec) :: j - complex(kind=omega_prec), 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=omega_prec) :: j - complex(kind=omega_prec), 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 sv2_grf (g, gravbar, phi, psi) result (j) - type(vector) :: j - complex(kind=omega_prec), intent(in) :: g, phi - type(vectorspinor), intent(in) :: gravbar - type(bispinor), intent(in) :: psi - type(vectorspinor) :: g0_psi, g1_psi, g2_psi, g3_psi - g0_psi%psi(1)%a(1:2) = - psi%a(1:2) - g0_psi%psi(1)%a(3:4) = psi%a(3:4) - g0_psi%psi(2)%a(1) = psi%a(2) - g0_psi%psi(2)%a(2) = psi%a(1) - g0_psi%psi(2)%a(3) = psi%a(4) - g0_psi%psi(2)%a(4) = psi%a(3) - g0_psi%psi(3)%a(1) = (0,-1) * psi%a(2) - g0_psi%psi(3)%a(2) = (0,1) * psi%a(1) - g0_psi%psi(3)%a(3) = (0,-1) * psi%a(4) - g0_psi%psi(3)%a(4) = (0,1) * psi%a(3) - g0_psi%psi(4)%a(1) = psi%a(1) - g0_psi%psi(4)%a(2) = - psi%a(2) - g0_psi%psi(4)%a(3) = psi%a(3) - g0_psi%psi(4)%a(4) = - psi%a(4) - g1_psi%psi(1)%a(1:4) = - g0_psi%psi(2)%a(1:4) - g1_psi%psi(2)%a(1:4) = - g0_psi%psi(1)%a(1:4) - g1_psi%psi(3)%a(1) = (0,1) * psi%a(1) - g1_psi%psi(3)%a(2) = (0,-1) * psi%a(2) - g1_psi%psi(3)%a(3) = (0,-1) * psi%a(3) - g1_psi%psi(3)%a(4) = (0,1) * psi%a(4) - g1_psi%psi(4)%a(1) = - psi%a(2) - g1_psi%psi(4)%a(2) = psi%a(1) - g1_psi%psi(4)%a(3) = psi%a(4) - g1_psi%psi(4)%a(4) = - psi%a(3) - g2_psi%psi(1)%a(1:4) = - g0_psi%psi(3)%a(1:4) - g2_psi%psi(2)%a(1:4) = - g1_psi%psi(3)%a(1:4) - g2_psi%psi(3)%a(1:4) = - g0_psi%psi(1)%a(1:4) - g2_psi%psi(4)%a(1) = (0,1) * psi%a(2) - g2_psi%psi(4)%a(2) = (0,1) * psi%a(1) - g2_psi%psi(4)%a(3) = (0,-1) * psi%a(4) - g2_psi%psi(4)%a(4) = (0,-1) * psi%a(3) - g3_psi%psi(1)%a(1:4) = - g0_psi%psi(4)%a(1:4) - g3_psi%psi(2)%a(1:4) = - g1_psi%psi(4)%a(1:4) - g3_psi%psi(3)%a(1:4) = - g2_psi%psi(4)%a(1:4) - g3_psi%psi(4)%a(1:4) = - g0_psi%psi(1)%a(1:4) - j%t = (g * phi) * (gravbar * g0_psi) - j%x(1) = (g * phi) * (gravbar * g1_psi) - j%x(2) = (g * phi) * (gravbar * g2_psi) - j%x(3) = (g * phi) * (gravbar * g3_psi) - end function sv2_grf - pure function sv1_fgr (g, psibar, v, grav) result (j) - complex(kind=omega_prec) :: j - complex(kind=omega_prec), intent(in) :: g - type(bispinor), intent(in) :: psibar - type(vectorspinor), intent(in) :: grav - type(vector), intent(in) :: v - j = g * fg5gkgr (psibar, grav, v) - end function sv1_fgr - pure function sv2_fgr (g, psibar, phi, grav) result (j) - type(vector) :: j - complex(kind=omega_prec), intent(in) :: g, phi - type(bispinor), intent(in) :: psibar - type(vectorspinor), intent(in) :: grav - type(bispinor) :: g0_grav, g1_grav, g2_grav, g3_grav - g0_grav%a(1) = -grav%psi(1)%a(1) + grav%psi(2)%a(2) - & - (0,1) * grav%psi(3)%a(2) + grav%psi(4)%a(1) - g0_grav%a(2) = -grav%psi(1)%a(2) + grav%psi(2)%a(1) + & - (0,1) * grav%psi(3)%a(1) - grav%psi(4)%a(2) - g0_grav%a(3) = grav%psi(1)%a(3) + grav%psi(2)%a(4) - & - (0,1) * grav%psi(3)%a(4) + grav%psi(4)%a(3) - g0_grav%a(4) = grav%psi(1)%a(4) + grav%psi(2)%a(3) + & - (0,1) * grav%psi(3)%a(3) - grav%psi(4)%a(4) - !!! - g1_grav%a(1) = grav%psi(1)%a(2) - grav%psi(2)%a(1) + & - (0,1) * grav%psi(3)%a(1) - grav%psi(4)%a(2) - g1_grav%a(2) = grav%psi(1)%a(1) - grav%psi(2)%a(2) - & - (0,1) * grav%psi(3)%a(2) + grav%psi(4)%a(1) - g1_grav%a(3) = grav%psi(1)%a(4) + grav%psi(2)%a(3) - & - (0,1) * grav%psi(3)%a(3) + grav%psi(4)%a(4) - g1_grav%a(4) = grav%psi(1)%a(3) + grav%psi(2)%a(4) + & - (0,1) * grav%psi(3)%a(4) - grav%psi(4)%a(3) - !!! - g2_grav%a(1) = (0,1) * (-grav%psi(1)%a(2) - grav%psi(2)%a(1) + & - grav%psi(4)%a(2)) - grav%psi(3)%a(1) - g2_grav%a(2) = (0,1) * (grav%psi(1)%a(1) + grav%psi(2)%a(2) + & - grav%psi(4)%a(1)) - grav%psi(3)%a(2) - g2_grav%a(3) = (0,1) * (-grav%psi(1)%a(4) + grav%psi(2)%a(3) - & - grav%psi(4)%a(4)) + grav%psi(3)%a(3) - g2_grav%a(4) = (0,1) * (grav%psi(1)%a(3) - grav%psi(2)%a(4) - & - grav%psi(4)%a(3)) + grav%psi(3)%a(4) - !!! - g3_grav%a(1) = -grav%psi(1)%a(2) + grav%psi(2)%a(2) - & - (0,1) * grav%psi(3)%a(2) - grav%psi(4)%a(1) - g3_grav%a(2) = grav%psi(1)%a(1) - grav%psi(2)%a(1) - & - (0,1) * grav%psi(3)%a(1) - grav%psi(4)%a(2) - g3_grav%a(3) = -grav%psi(1)%a(2) - grav%psi(2)%a(4) + & - (0,1) * grav%psi(3)%a(4) + grav%psi(4)%a(3) - g3_grav%a(4) = -grav%psi(1)%a(4) + grav%psi(2)%a(3) + & - (0,1) * grav%psi(3)%a(3) + grav%psi(4)%a(4) - j%t = (g * phi) * (psibar * g0_grav) - j%x(1) = (g * phi) * (psibar * g1_grav) - j%x(2) = (g * phi) * (psibar * g2_grav) - j%x(3) = (g * phi) * (psibar * g3_grav) - end function sv2_fgr - pure function pv1_grf (g, gravbar, v, psi) result (j) - complex(kind=omega_prec) :: j - complex(kind=omega_prec), 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=omega_prec), 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=omega_prec) :: j - complex(kind=omega_prec), 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=omega_prec), 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=omega_prec), intent(in) :: g - type(vectorspinor), intent(in) :: gravbar - type(bispinor), intent(in) :: psi - type(vector), intent(in) :: v - j = -g * grkgggf (gravbar, psi, v) - end function v2_grf - pure function v2_fgr (g, psibar, v, grav) result (j) - type(vector) :: j - complex(kind=omega_prec), 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 pr_psi (p, m, w, psi) result (ppsi) - type(bispinor) :: ppsi - type(momentum), intent(in) :: p - real(kind=omega_prec), intent(in) :: m, w - type(bispinor), intent(in) :: psi - type(vector) :: vp - complex(kind=omega_prec), parameter :: one = (1, 0) - vp = p - ppsi = (1 / cmplx (p*p - m**2, m*w, kind=omega_prec)) & - * (- f_vf (one, vp, psi) + m * psi) - end function pr_psi - pure function pj_psi (p, m, w, psi) result (ppsi) - type(bispinor) :: ppsi - type(momentum), intent(in) :: p - real(kind=omega_prec), intent(in) :: m, w - type(bispinor), intent(in) :: psi - type(vector) :: vp - complex(kind=omega_prec), 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 pr_grav (p, m, w, grav) result (propgrav) - type(vectorspinor) :: propgrav - type(momentum), intent(in) :: p - real(kind=omega_prec), 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=omega_prec), parameter :: one = (1, 0) - real(kind=omega_prec) :: 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=omega_prec)) * & - (etagrav + pppgrav + (1/3.0_omega_prec) * gg_grav) - end function pr_grav -end module omega_bispinor_couplings Index: tags/ohl/attic/omega-000.011beta/src/omega95.f95 =================================================================== --- tags/ohl/attic/omega-000.011beta/src/omega95.f95 (revision 8686) +++ tags/ohl/attic/omega-000.011beta/src/omega95.f95 (revision 8687) @@ -1,30 +0,0 @@ -! $Id: omegalib.nw,v 1.118.4.2 2006/05/15 08:39:27 ohl Exp $ -! -! Copyright (C) 2000-2002 by Thorsten Ohl -! and others -! -! O'Mega is free software; you can redistribute it and/or modify it -! under the terms of the GNU General Public License as published by -! the Free Software Foundation; either version 2, or (at your option) -! any later version. -! -! O'Mega is distributed in the hope that it will be useful, but -! WITHOUT ANY WARRANTY; without even the implied warranty of -! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -! GNU General Public License for more details. -! -! You should have received a copy of the GNU General Public License -! along with this program; if not, write to the Free Software -! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -module omega95 - use omega_constants - use omega_spinors - use omega_vectors - use omega_polarizations - use omega_tensors - use omega_tensor_polarizations - use omega_couplings - use omega_spinor_couplings - use omega_utils - public -end module omega95 Index: tags/ohl/attic/omega-000.011beta/src/omega_parameters.f95 =================================================================== --- tags/ohl/attic/omega-000.011beta/src/omega_parameters.f95 (revision 8686) +++ tags/ohl/attic/omega-000.011beta/src/omega_parameters.f95 (revision 8687) @@ -1,280 +0,0 @@ -! $Id: omegalib.nw,v 1.118.4.2 2006/05/15 08:39:27 ohl Exp $ -! -! Copyright (C) 2000-2002 by Thorsten Ohl -! and others -! -! O'Mega is free software; you can redistribute it and/or modify it -! under the terms of the GNU General Public License as published by -! the Free Software Foundation; either version 2, or (at your option) -! any later version. -! -! O'Mega is distributed in the hope that it will be useful, but -! WITHOUT ANY WARRANTY; without even the implied warranty of -! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -! GNU General Public License for more details. -! -! You should have received a copy of the GNU General Public License -! along with this program; if not, write to the Free Software -! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -module omega_parameters - use omega_kinds - use omega_constants - implicit none - private - public :: setup_parameters, print_parameters - real(kind=omega_prec), dimension(37), save, public :: mass = 0, width = 0 - real(kind=omega_prec), parameter, public :: GeV = 1.0_double - real(kind=omega_prec), parameter, public :: MeV = GeV / 1000 - real(kind=omega_prec), parameter, public :: keV = MeV / 1000 - real(kind=omega_prec), parameter, public :: TeV = GeV * 1000 - real(kind=omega_prec), save, public :: & - alpha = 1.0_double / 137.0359895_double, & - sin2thw = 0.23124_double - complex(kind=omega_prec), save, private :: vev - complex(kind=omega_prec), save, public :: & - qlep = 0, qup = 0, qdwn = 0, gcc = 0, qw = 0, & - gzww = 0, gwww = 0, ghww = 0, ghhww = 0, ghzz = 0, ghhzz = 0, & - ghbb = 0, ghtt = 0, ghcc = 0, ghtautau = 0, gh3 = 0, gh4 = 0, & - ghgaga = 0, ghgaz = 0, ghgg = 0, & - iqw = 0, igzww = 0, igwww = 0, & - gw4 = 0, gzzww = 0, gazww = 0, gaaww = 0, & - ig1a = 0, ig1z = 0, rg5a = 0, rg5z = 0, & - ig1pkpg4a = 0, ig1pkpg4z = 0, ig1pkmg4a = 0, ig1pkmg4z = 0, & - ig1mkpg4a = 0, ig1mkpg4z = 0, ig1mkmg4a = 0, ig1mkmg4z = 0, & - ila = 0, ilz = 0, il5a = 0, il5z = 0, ik5a = 0, ik5z = 0, & - ialww0 = 0, ialww2 = 0, ialzw0 = 0, ialzw1 = 0, ialzz = 0, & - alww0 = 0, alww2 = 0, alzw0 = 0, alzw1 = 0, alzz = 0, & - igdh4 = 0, gdh2w2 = 0, gdh2z2 = 0, gdhw2 = 0, gdhz2 = 0, & - gs = 0, igs = 0 - complex(kind=omega_prec), save, public :: & - sinckm12 = 0, sinckm13 = 0, sinckm23 = 0, & - cosckm12 = 0, cosckm13 = 0, cosckm23 = 0 - complex(kind=omega_prec), save, public :: & - vckm_11 = 0, vckm_12 = 0, vckm_13 = 0, vckm_21 = 0, & - vckm_22 = 0, vckm_23 = 0, vckm_31 = 0, vckm_32 = 0, vckm_33 = 0 - complex(kind=omega_prec), save, public :: & - gccq11 = 0, gccq12 = 0, gccq13 = 0, gccq21 = 0, & - gccq22 = 0, gccq23 = 0, gccq31 = 0, gccq32 = 0, gccq33 = 0 - real(kind=omega_prec), save, public :: & - g1a = 1, g1z = 1, kappaa = 1, kappaz = 1, lambdaa = 0, lambdaz = 0, & - g4a = 0, g4z = 0, g5a = 0, g5z = 0, & - kappa5a = 0, kappa5z = 0, lambda5a = 0, lambda5z = 0, & - alpha4 = 0, alpha5 = 0, tau4 = 0, tau5 = 0 - real(kind=omega_prec), save, public :: xia = 1, xi0 = 1, xipm = 1 - complex(kind=omega_prec), dimension(2), save, public :: & - gnclep = 0, gncneu = 0, gncup = 0, gncdwn = 0 - complex(kind=omega_prec), save, public :: & - fudge_o1 = 1, fudge_o2 = 1, fudge_o3 = 1, fudge_o4 = 1 - complex(kind=omega_prec), save, public :: & - ghmumu = 0 - real(kind=omega_prec), save, private :: & - mass2_Z = 0, mass2_W = 0, mass2_h = 0, mass2_H0 = 0, mass2_A0 = 0, & - r_h = 0, r_H0 = 0, eps = 0, & - cos_alpha = 0, sin_alpha = 0, cos_2alpha = 0, sin_2alpha = 0, & - cos_beta = 0, sin_beta = 0, cos_2beta = 0, sin_2beta = 0, & - sin_beta_alpha = 0, cos_beta_alpha = 0, & - tan_beta = 0, cot_beta = 0, & - cos_2thw = 0 - complex(kind=omega_prec), save, public :: & - gh0ww = 0, gh0zz = 0, & - gh0tt = 0, gh0bb = 0, gh0cc = 0, gh0tautau = 0, gh0mumu = 0, & - iga0tt = 0, iga0bb = 0, iga0cc = 0, iga0tautau = 0, iga0mumu = 0, & - gahh = 0, gzhh = 0, igzha = 0, igzh0a = 0 - complex(kind=omega_prec), dimension(2), save, public :: & - ghptb = 0, ghpcs = 0, ghptaunu = 0, ghpmunu = 0 - complex(kind=omega_prec), save, public :: & - gh0wwc1 = 0, gh0wwc2 = 0, & - gh1wwc1 = 0, gh1wwc2 = 0, gh1wwc3h = 0, gh1wwc4h = 0, & - gh2wwc1 = 0, gh2wwc2 = 0, gh2wwc3 = 0, gh2wwc4 = 0, gh2wwc5 = 0, & - gh0zzc1 = 0, gh0zzc2 = 0, & - gh1zzc1 = 0, gh1zzc2 = 0, gh1zzc3h = 0, gh1zzc4h = 0, & - gh2zzc1 = 0, gh2zzc2 = 0, gh2zzc3 = 0, gh2zzc4 = 0, gh2zzc5 = 0 -contains - subroutine setup_parameters () - real(kind=omega_prec) :: e, g, sinthw, costhw, qelep, qeup, qedwn - mass(1) = 5.0 * MeV - mass(2) = 3.0 * MeV - mass(3) = 100.0 * MeV - mass(4) = 1.2 * GeV - mass(5) = 4.2 * GeV - mass(6) = 174.0 * GeV - width(1:5) = 0 - width(6) = 1.3 * GeV - mass(11) = 0.51099907 * MeV - mass(12) = 0 - mass(13) = 105.658389 * MeV - mass(14) = 0 - mass(15) = 1777.05 * MeV - mass(16) = 0 - width(11:16) = 0 - mass(21) = 0 - mass(22) = 0 - width(21:22) = 0 - mass(23) = 91.187 * GeV - width(23) = 2.490 * GeV - mass(24) = 80.41 * GeV - width(24) = 2.06 * GeV - mass(25) = 120.00 * GeV - width(25) = 5.00 * GeV - mass(35) = 10000 * GeV - width(35) = 0 - sinckm12 = 0.0_omega_prec - sinckm13 = 0.0_omega_prec - sinckm23 = 0.0_omega_prec - cosckm12 = sqrt ((1.0_omega_prec - (sinckm12**2))) - cosckm13 = sqrt ((1.0_omega_prec - (sinckm13**2))) - cosckm23 = sqrt ((1.0_omega_prec - (sinckm23**2))) - mass(26) = xi0 * mass(23) - width(26) = 0 - mass(27) = xipm * mass(24) - width(27) = 0 - e = sqrt (4 * PI * alpha) - qelep = - 1 - qeup = 2.0_omega_prec / 3.0_omega_prec - qedwn = - 1.0_omega_prec / 3.0_omega_prec - sinthw = sqrt (sin2thw) - costhw = sqrt (1 - sin2thw) - g = e / sinthw - gcc = - g / 2 / sqrt (2.0_double) - vckm_11 = cosckm12 * cosckm13 - vckm_12 = sinckm12 * cosckm13 - vckm_13 = sinckm13 - vckm_21 = - (sinckm12 * cosckm23 + & - cosckm12 * sinckm23 * sinckm13) - vckm_22 = cosckm12 * cosckm23 - & - sinckm12 * sinckm23 * sinckm13 - vckm_23 = sinckm23 * cosckm13 - vckm_31 = sinckm12 * sinckm23 - & - cosckm12 * cosckm23 * sinckm13 - vckm_32 = - (cosckm12 * sinckm23 + & - sinckm12 * cosckm23 * sinckm13) - vckm_33 = cosckm23 * cosckm13 - gccq11 = gcc * vckm_11 - gccq12 = gcc * vckm_12 - gccq13 = gcc * vckm_13 - gccq21 = gcc * vckm_21 - gccq22 = gcc * vckm_22 - gccq23 = gcc * vckm_23 - gccq31 = gcc * vckm_31 - gccq32 = gcc * vckm_32 - gccq33 = gcc * vckm_33 - gncneu(1) = - g / 2 / costhw * ( + 0.5_double) - gnclep(1) = - g / 2 / costhw * ( - 0.5_double - 2 * qelep * sin2thw) - gncup(1) = - g / 2 / costhw * ( + 0.5_double - 2 * qeup * sin2thw) - gncdwn(1) = - g / 2 / costhw * ( - 0.5_double - 2 * qedwn * sin2thw) - gncneu(2) = - g / 2 / costhw * ( + 0.5_double) - gnclep(2) = - g / 2 / costhw * ( - 0.5_double) - gncup(2) = - g / 2 / costhw * ( + 0.5_double) - gncdwn(2) = - g / 2 / costhw * ( - 0.5_double) - qlep = - e * qelep - qup = - e * qeup - qdwn = - e * qedwn - qw = e - iqw = (0,1)*qw - gzww = g * costhw - igzww = (0,1)*gzww - gwww = g - igwww = (0,1)*gwww - ghww = mass(24) * g - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !!! This is for the old SM3: - !!! ghhww = (0,1) * g / Sqrt(2.0_omega_prec) - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ghhww = g**2 / 2.0_omega_prec - ghzz = mass(23) * g / costhw - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !!! This is for the old SM3: - !!! ghhzz = (0,1) * g / costhw / Sqrt(2.0_omega_prec) - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ghhzz = g**2 / 2.0_omega_prec / costhw**2 - gw4 = g**2 - gzzww = gzww**2 - gazww = gzww*e - gaaww = e**2 - vev = 2.0 * mass(24) / g - ghtt = - mass(6) / vev - ghbb = - mass(5) / vev - ghcc = - mass(4) / vev - ghtautau = - mass(15) / vev - gh3 = - 3 * mass(25)**2 / vev - gh4 = - 3 * mass(25)**2 / vev**2 - !!! gh4 = mass(25) / vev !!! Old SM3 - ig1a = iqw * g1a - ig1z = igzww * g1z - ig1pkpg4a = iqw * (g1a + kappaa + g4a) / 2 - ig1pkpg4z = igzww * (g1z + kappaz + g4z) / 2 - ig1pkmg4a = iqw * (g1a + kappaa - g4a) / 2 - ig1pkmg4z = igzww * (g1z + kappaz - g4z) / 2 - ig1mkpg4a = iqw * (g1a - kappaa + g4a) / 2 - ig1mkpg4z = igzww * (g1z - kappaz + g4z) / 2 - ig1mkmg4a = iqw * (g1a - kappaa - g4a) / 2 - ig1mkmg4z = igzww * (g1z - kappaz - g4z) / 2 - ila = iqw * lambdaa / (mass(24)*mass(24)) - ilz = igzww * lambdaz / (mass(24)*mass(24)) - rg5a = qw * g5a - rg5z = gzww * g5z - ik5a = iqw * kappa5a - ik5z = igzww * kappa5z - il5a = iqw * lambda5a / (mass(24)*mass(24)) - il5z = igzww * lambda5z / (mass(24)*mass(24)) - alww0 = g**4 * (alpha4 + 2 * alpha5) - alww2 = g**4 * 2 * alpha4 - alzw1 = g**4 / costhw**2 * alpha4 - alzw0 = g**4 / costhw**2 * 2 * alpha5 - alzz = g**4 / costhw**4 * 2 * (alpha4 + alpha5) - ialww0 = g**2 * sqrt ( - cmplx (alpha4 + 2 * alpha5, kind=omega_prec)) - ialww2 = g**2 * sqrt ( - cmplx (2 * alpha4, kind=omega_prec)) - ialzw1 = g**2 / costhw * sqrt ( - cmplx (alpha4, kind=omega_prec)) - ialzw0 = g**2 / costhw * sqrt ( - cmplx (2 * alpha5, kind=omega_prec)) - ialzz = g**2 / (costhw*costhw) & - * sqrt ( - cmplx (2 * (alpha4 + alpha5), kind=omega_prec)) - gdh2w2 = g * vev * sqrt (cmplx (tau4, kind=omega_prec)) - gdhw2 = g * vev * sqrt (cmplx (tau5 / 2, kind=omega_prec)) - gdh2z2 = g * vev / costhw * sqrt (cmplx (tau4, kind=omega_prec)) - gdhz2 = g * vev / costhw * sqrt (cmplx (tau5 / 2, kind=omega_prec)) - igdh4 = g**2 * sqrt ( - cmplx (8 * (tau4 + tau5), kind=omega_prec)) - - gh0wwc1 = ghww - gh0zzc1 = ghzz - end subroutine setup_parameters - subroutine print_parameters () - print *, "Quark masses:" - print *, mass(2:6:2) - print *, mass(1:5:2) - print *, "Lepton masses:" - print *, mass(12:16:2) - print *, mass(11:15:2) - print *, "Quark widths:" - print *, width(2:6:2) - print *, width(1:5:2) - print *, "Lepton widths:" - print *, width(12:16:2) - print *, width(11:15:2) - print *, "SU(2)xU(1) Gauge boson masses/widths:" - print *, mass(22:24) - print *, width(22:24) - print *, "Higgs boson and gluon masses/widths:" - print *, mass(25), mass(21) - print *, width(25), width(21) - print *, "Neutral current couplings:" - print *, "U:", gncup - print *, "D:", gncdwn - print *, "N:", gncneu - print *, "L:", gnclep - print *, "Fermion charges:" - print *, "U:", qup - print *, "D:", qdwn - print *, "L:", qlep - print *, "TGC:" - print *, "WWA:", iqw - print *, "WWZ:", igzww - print *, "WWW:", igwww - print *, "WWH:", ghww - !!! print *, "WWHH:", ghhww**2 !!! Old SM3 - print *, "WWHH:", ghhww - !!! print *, "ZZHH:", ghhzz**2 !!! Old SM3 - print *, "ZZHH:", ghhzz - - - end subroutine print_parameters -end module omega_parameters Index: tags/ohl/attic/omega-000.011beta/src/omega_parameters_mssm.f95 =================================================================== --- tags/ohl/attic/omega-000.011beta/src/omega_parameters_mssm.f95 (revision 8686) +++ tags/ohl/attic/omega-000.011beta/src/omega_parameters_mssm.f95 (revision 8687) @@ -1,3406 +0,0 @@ -! At the moment this is a hard-coded file and not extracted from -! omegalib.nw -! -! Copyright (C) 2000-2004 by Thorsten Ohl -! and others -! -! O'Mega is free software; you can redistribute it and/or modify it -! under the terms of the GNU General Public License as published by -! the Free Software Foundation; either version 2, or (at your option) -! any later version. -! -! O'Mega is distributed in the hope that it will be useful, but -! WITHOUT ANY WARRANTY; without even the implied warranty of -! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -! GNU General Public License for more details. -! -! You should have received a copy of the GNU General Public License -! along with this program; if not, write to the Free Software -! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -module omega_parameters_mssm - use omega_kinds - use omega_constants - implicit none - private - public :: setup_parameters! No print_parameters - real(kind=omega_prec), dimension(70), save, public :: mass = 0, width = 0 - real(kind=omega_prec), parameter, public :: GeV = 1.0_double - real(kind=omega_prec), parameter, public :: MeV = GeV / 1000 - real(kind=omega_prec), parameter, public :: keV = MeV / 1000 - real(kind=omega_prec), parameter, public :: TeV = GeV * 1000 - real(kind=omega_prec), save, public :: & - alpha = 1.0_double / 137.0359895_double, & - sin2thw = 0.23124_double - integer, save, public :: & - sign1 = +1, sign2 = +1, sign3 = +1, sign4 = +1 - real(kind=omega_prec), save, public :: & - sigch1 = +1, sigch2 = +1 - complex(kind=omega_prec), save, private :: vev - complex(kind=omega_prec), save, public :: imago - real(kind=omega_prec), public, save :: sind = 0_omega_prec, & - cosd = 1_omega_prec, sinckm12 = 0.223_omega_prec, & - sinckm13 = 0.004_omega_prec, sinckm23 = 0.04_omega_prec, & - tana = 30_omega_prec, tanb = 30_omega_prec, as = 0_omega_prec - real(kind=omega_prec), public, save :: dummy1, cos2am2b, sin2am2b, sinamb, & - sinapb, cosamb, cosapb, cos4be, sin4be, sin4al, sin2al, sin2be, cos2al, & - cos2be, cosbe, sinbe, cosal, sinal, costhw, sinthw - real(kind=omega_prec), public, save :: q_lep, q_up, q_down - complex(kind=omega_prec), public, save :: gcc, qchar, qdwn, qup, qlep, & - gz, g, e, gs - complex(kind=omega_prec), save, public :: xia = 1, xi0 = 1, xipm = 1 - complex(kind=omega_prec), dimension(2), public, save :: gncdwn - complex(kind=omega_prec), dimension(2), public, save :: gncup - complex(kind=omega_prec), dimension(2), public, save :: gnclep - complex(kind=omega_prec), dimension(2), public, save :: gncneu - complex(kind=omega_prec), 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=omega_prec), 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=omega_prec), 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=omega_prec), 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=omega_prec), 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=omega_prec), 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=omega_prec), public, save :: ghsnsl2_1, ghsnsl2_1_c & - !!! ghsnsl2_2_c, ghsnsl2_2, - complex(kind=omega_prec), 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=omega_prec), 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=omega_prec), 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=omega_prec), 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=omega_prec), 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=omega_prec), 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=omega_prec), 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=omega_prec), 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=omega_prec), 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=omega_prec), public, save :: g_h4112slsn, g_h4212slsn, & - complex(kind=omega_prec), 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=omega_prec), public, save :: gch1c_1_1, gch1c_2_2, & - gch2c_1_1, gch2c_2_2, gcac_1_1, gcac_2_2 - complex(kind=omega_prec), 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=omega_prec), public, save :: snnh1_44, a0_44, v0_44, & - pnna_34, snna_34, pnnh2_34, snnh2_34, pnnh1_34, & - snnh1_34, a0_34, v0_34, pnna_33, snna_33, & - pnnh2_33, snnh2_33, pnnh1_33, snnh1_33, a0_33, v0_33 - complex(kind=omega_prec), public, save :: pnna_24, & - snna_24, pnnh2_24, snnh2_24, pnnh1_24, snnh1_24, & - a0_24, v0_24, pnna_23, snna_23, pnnh2_23, snnh2_23, & - pnnh1_23, snnh1_23, a0_23, v0_23, pnna_22, snna_22, & - pnnh2_22, snnh2_22, pnnh1_22, snnh1_22, a0_22, v0_22, & - pnna_14, snna_14, pnnh2_14, snnh2_14, pnnh1_14, snnh1_14, & - a0_14, v0_14, pnna_13, snna_13, pnnh2_13, snnh2_13, & - pnnh1_13, snnh1_13, a0_13, v0_13, pnna_12, snna_12, & - pnnh2_12 - complex(kind=omega_prec), public, save :: snnh2_12, pnnh1_12, snnh1_12, & - a0_12, v0_12, pnna_11, snna_11, pnnh2_11, snnh2_11, & - pnnh1_11, snnh1_11, a0_11, v0_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=omega_prec), 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=omega_prec), 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=omega_prec), 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=omega_prec), 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=omega_prec), 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=omega_prec), 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=omega_prec), 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=omega_prec), 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=omega_prec), 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=omega_prec), public, save :: sinthsu3, & - !!! sinthsu2, sinthsu1, sinthsd3, sinthsd2, sinthsd1, sinthsl3, sinthsl2, & - !!! sinthsl1, costhsu3, costhsu2, costhsu1, costhsd3, costhsd2, costhsd1, & - !!! costhsl3, costhsl2, costhsl1 - complex(kind=omega_prec), public, save :: eta1, eta2, eta3, eta4 - complex(kind=omega_prec), 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=omega_prec), 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=omega_prec), 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=omega_prec), 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=omega_prec), 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 -contains - ! derived parameters: - !length: 1516 - !Num_Sub: 13 - subroutine setup_parameters1 () - mass(1) = 5.0 * MeV - mass(2) = 3.0 * MeV - mass(3) = 100.0 * MeV - mass(4) = 1.2 * GeV - mass(5) = 4.2 * GeV - mass(6) = 174.0 * GeV - width(1:5) = 0 - width(6) = 1.3 * GeV - mass(11) = 0.51099907 * MeV - mass(12) = 0 - mass(13) = 105.658389 * MeV - mass(14) = 0 - mass(15) = 1777.05 * MeV - mass(16) = 0 - width(11:16) = 0 - mass(21) = 0 - mass(22) = 0 - width(21:22) = 0 - mass(23) = 91.187 * GeV - width(23) = 2.490 * GeV - mass(24) = 80.41 * GeV - width(24) = 2.06 * GeV - mass(25) = 120.00 * GeV - width(25) = 5.00 * GeV - mass(26) = xi0 * mass(23) - width(26) = 0 - mass(27) = xipm * mass(24) - width(27) = 0 - mass(28:34) = 0 - width(28:34) = 0 - mass(35) = 200.00 * GeV - width(35) = 5.00 * GeV - mass(36) = 300.00 * GeV - width(36) = 5.00 * GeV - mass(41) = 200.00 * GeV - mass(42) = 200.00 * GeV - mass(43) = 200.00 * GeV - mass(44) = 200.00 * GeV - mass(45) = 200.00 * GeV - mass(46) = 200.00 * GeV - mass(47) = 200.00 * GeV - mass(48) = 200.00 * GeV - mass(49) = 200.00 * GeV - mass(50) = 200.00 * GeV - mass(51) = 200.00 * GeV - mass(52) = 200.00 * GeV - mass(53) = 200.00 * GeV - mass(54) = 200.00 * GeV - mass(55) = 200.00 * GeV - mass(56) = 200.00 * GeV - mass(57) = 200.00 * GeV - mass(58) = 200.00 * GeV - mass(59) = 200.00 * GeV - mass(61) = 200.00 * GeV - mass(63) = 200.00 * GeV - width(41:59) = 5.00 * GeV - width(61) = 5.00 * GeV - width(63:70) = 5.00 * GeV - mass(64) = 300.00 * GeV - mass(65) = 90.00 * GeV - mass(66) = 130.00 * GeV - mass(67) = 170.00 * GeV - mass(68) = 190.00 * GeV - mass(69) = 120.00 * GeV - mass(70) = 220.00 * GeV - width(64:70) = 0 - imago = cmplx (0.0_omega_prec, 1.0_omega_prec, kind=omega_prec) - e = sqrt ((4.0_omega_prec * PI * alpha)) - gs = sqrt ((4.0_omega_prec * PI * as)) - sinthw = sqrt (sin2thw) - costhw = sqrt ((1.0_omega_prec - sin2thw)) - g = (e / sinthw) - gz = (g / costhw) - vev = ((2.0_omega_prec * mass(24)) / g) - q_lep = (- 1.0_omega_prec) - q_up = (2.0_omega_prec / 3.0_omega_prec) - q_down = (- 1.0_omega_prec / 3.0_omega_prec) - qlep = e - qup = ((-2.0_omega_prec / 3.0_omega_prec) * e) - qdwn = ((1.0_omega_prec / 3.0_omega_prec) * e) - qchar = ( - e) - !!! Different sign compared to SM due to different definition in the - !!! O'Mega model file. - gcc = (g / (2.0_omega_prec * sqrt (2.0_omega_prec))) - igs = (imago * gs) - gssq = (gs / sqrt (2.0_omega_prec)) - iqw = imago * e - igzww = imago * g * costhw - gw4 = (g**2) - gzzww = ((g**2) * (costhw**2)) - gppww = (e**2) - gpzww = (e * g * costhw) - sinal = ( - (tana / sqrt ((1.0_omega_prec + (tana**2))))) - cosal = (1.0_omega_prec / sqrt ((1.0_omega_prec + (tana**2)))) - sinbe = (tanb / sqrt ((1.0_omega_prec + (tanb**2)))) - cosbe = (1.0_omega_prec / sqrt ((1.0_omega_prec + (tanb**2)))) - !!! We initialize the CKM matrix as a unit matrix - sinckm12 = 0.0_omega_prec - sinckm13 = 0.0_omega_prec - sinckm23 = 0.0_omega_prec - cosckm12 = sqrt ((1.0_omega_prec - (sinckm12**2))) - cosckm13 = sqrt ((1.0_omega_prec - (sinckm13**2))) - cosckm23 = sqrt ((1.0_omega_prec - (sinckm23**2))) - eidelta = (cosd + (imago * sind)) - cos2be = ((cosbe**2) - (sinbe**2)) - cos2al = ((cosal**2) - (sinal**2)) - sin2be = (2.0_omega_prec * cosbe * sinbe) - sin2al = (2.0_omega_prec * cosal * sinal) - sin4al = (2.0_omega_prec * cos2al * sin2al) - sin4be = (2.0_omega_prec * 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) - (cosal * sinbe)) - sin2am2b = (2.0_omega_prec * sinamb * cosamb) - cos2am2b = ((cosamb**2) - (sinamb**2)) - vckm_11 = (cosckm12 * cosckm13) - vckm_12 = (sinckm12 * cosckm13) - vckm_13 = (sinckm13 * conjg (eidelta)) - vckm_21 = ( - ((sinckm12 * cosckm23) + & - (cosckm12 * sinckm23 * sinckm13 * eidelta))) - vckm_22 = ((cosckm12 * cosckm23) - & - (sinckm12 * sinckm23 * sinckm13 * eidelta)) - vckm_23 = (sinckm23 * cosckm13) - vckm_31 = ((sinckm12 * sinckm23) - & - (cosckm12 * cosckm23 * sinckm13 * eidelta)) - vckm_32 = ( - ((cosckm12 * sinckm23) + & - (sinckm12 * cosckm23 * sinckm13 * eidelta))) - vckm_33 = (cosckm23 * cosckm13) - !!! mix_sl111 = costhsl1 !!! For explicit angles only - !!! mix_sl112 = sinthsl1 !!! For explicit angles only - !!! mix_sl121 = ( - sinthsl1) !!! For explicit angles only - !!! mix_sl122 = costhsl1 !!! For explicit angles only - !!! mix_sl211 = costhsl2 !!! For explicit angles only - !!! mix_sl212 = sinthsl2 !!! For explicit angles only - !!! mix_sl221 = ( - sinthsl2) !!! For explicit angles only - !!! mix_sl222 = costhsl2 !!! For explicit angles only - !!! mix_sl311 = costhsl3 !!! For explicit angles only - !!! mix_sl312 = sinthsl3 !!! For explicit angles only - !!! mix_sl321 = ( - sinthsl3) !!! For explicit angles only - !!! mix_sl322 = costhsl3 !!! For explicit angles only - !!! mix_su111 = costhsu1 !!! For explicit angles only - !!! mix_su112 = sinthsu1 !!! For explicit angles only - !!! mix_su121 = ( - sinthsu1) !!! For explicit angles only - !!! mix_su122 = costhsu1 !!! For explicit angles only - !!! mix_su211 = costhsu2 !!! For explicit angles only - !!! mix_su212 = sinthsu2 !!! For explicit angles only - !!! mix_su221 = ( - sinthsu2) !!! For explicit angles only - !!! mix_su222 = costhsu2 !!! For explicit angles only - !!! mix_su311 = costhsu3 !!! For explicit angles only - !!! mix_su312 = sinthsu3 !!! For explicit angles only - !!! mix_su321 = ( - sinthsu3) !!! For explicit angles only - !!! mix_su322 = costhsu3 !!! For explicit angles only - !!! mix_sd111 = costhsd1 !!! For explicit angles only - !!! mix_sd112 = sinthsd1 !!! For explicit angles only - !!! mix_sd121 = ( - sinthsd1) !!! For explicit angles only - !!! mix_sd122 = costhsd1 !!! For explicit angles only - !!! mix_sd211 = costhsd2 !!! For explicit angles only - !!! mix_sd212 = sinthsd2 !!! For explicit angles only - !!! mix_sd221 = ( - sinthsd2) !!! For explicit angles only - !!! mix_sd222 = costhsd2 !!! For explicit angles only - !!! mix_sd311 = costhsd3 !!! For explicit angles only - !!! mix_sd312 = sinthsd3 !!! For explicit angles only - !!! mix_sd321 = ( - sinthsd3) !!! For explicit angles only - !!! mix_sd322 = costhsd3 !!! For explicit angles only - gh3_1 = ((mass(23) * (gz / 2.0_omega_prec) * cos2be * cosapb) - & - (mass(24) * g * cosamb)) - gh3_2 = ((mass(24) * g * sinamb) - ( & - (gz / 2.0_omega_prec) * mass(23) * cos2be * sinapb)) - gh3_3 = ((gz / 2.0_omega_prec) * mass(23) * ( & - (2.0_omega_prec * sin2al * cosapb) + (cos2al * sinapb))) - gh3_4 = ( - ( & - (3.0_omega_prec / 2.0_omega_prec) * gz * mass(23) * cos2al * cosapb)) - gh3_5 = ( - ( & - (3.0_omega_prec / 2.0_omega_prec) * gz * mass(23) * cos2al * sinapb)) - gh3_6 = ((gz / 2.0_omega_prec) * mass(23) * ((cos2al * cosapb) - & - (2.0_omega_prec * sin2al * sinapb))) - gh3_7 = ((gz / 2.0_omega_prec) * mass(23) * cos2be * cosapb) - gh3_8 = ( - ((gz / 2.0_omega_prec) * mass(23) * cos2be * sinapb)) - gh4_1 = ( - (((gz**2) / 2.0_omega_prec) * (cos2be**2))) - gh4_2 = ((((gz**2) / 4.0_omega_prec) * cos2al * cos2be) - (( & - (g**2) / 2.0_omega_prec) * (cosamb**2))) - gh4_3 = ( - ((((gz**2) / 4.0_omega_prec) * cos2al * cos2be) + (( & - (g**2) / 2.0_omega_prec) * (sinamb**2)))) - gh4_4 = ((((g**2) / 2.0_omega_prec) * cosamb * sinamb) - (( & - (gz**2) / 4.0_omega_prec) * sin2al * cos2be)) - gh4_5 = ( - (((gz**2) / 4.0_omega_prec) * (cos2be**2))) - gh4_6 = ( - ((3.0_omega_prec / 4.0_omega_prec) * (gz**2) * (cos2al**2))) - gh4_7 = (((gz**2) / 4.0_omega_prec) * (1.0_omega_prec - (3.0_omega_prec * & - (sin2al**2)))) - gh4_8 = ( - ((3.0_omega_prec / 8.0_omega_prec) * (gz**2) * sin4al)) - gh4_9 = (((gz**2) / 4.0_omega_prec) * cos2al * cos2be) - gh4_10 = ( - (((gz**2) / 4.0_omega_prec) * sin2al * cos2be)) - gh4_11 = ( - ((3.0_omega_prec / 4.0_omega_prec) * (gz**2) * (cos2be**2))) - ghaw = ( - (imago * (g / 2.0_omega_prec))) - gh1az = (imago * & - (gz / 2.0_omega_prec) * cosamb) - gh2az = (imago * & - (gz / 2.0_omega_prec) * sinamb) - gh1ww = ( - (g * mass(24) * sinamb)) - gh2ww = (g * mass(24) * cosamb) - ghh1w = ((g / 2.0_omega_prec) * cosamb) - ghh2w = ((g / 2.0_omega_prec) * sinamb) - gh1zz = ( - (gz * mass(23) * sinamb)) - gh2zz = (gz * mass(23) * cosamb) - ghhz = ((gz / 2.0_omega_prec) * ((2.0_omega_prec * & - (costhw**2)) - 1.0_omega_prec)) - ghhp = e - gaazz = ((gz**2) / 2.0_omega_prec) - gh1h1zz = gaazz - gh2h2zz = gaazz - ghphmzz = (gaazz * (((2.0_omega_prec * (costhw**2)) - 1.0_omega_prec)**2)) - ghphmpp = (2.0_omega_prec * (e**2)) - ghphmpz = (e * gz * ((2.0_omega_prec * (costhw**2)) - 1.0_omega_prec)) - ghh1wz = ( - ( & - (1.0_omega_prec / 2.0_omega_prec) * g * gz * sin2thw * cosamb)) - ghh2wz = ( - ( & - (1.0_omega_prec / 2.0_omega_prec) * g * gz * sin2thw * sinamb)) - ghh1wp = (e * (g / 2.0_omega_prec) * cosamb) - ghh2wp = (e * (g / 2.0_omega_prec) * sinamb) - gaaww = ((g**2) / 2.0_omega_prec) - gh1h1ww = gaaww - gh2h2ww = gaaww - ghhww = gaaww - ghawz = (imago * g * gz * & - (1.0_omega_prec / 2.0_omega_prec) * sin2thw) - ghawp = ( - (imago * e * g * & - (1.0_omega_prec / 2.0_omega_prec))) - g_yuk6_1 = (gcc * (mass(11) / mass(24)) * tanb) - g_yuk7_1 = ( - ((g / 2.0_omega_prec) * (mass(11) / mass(24)) * & - (cosal / cosbe))) - g_yuk8_1 = ((g / 2.0_omega_prec) * (mass(11) / mass(24)) * (sinal / cosbe)) - g_yuk9_1 = (imago * & - (g / 2.0_omega_prec) * (mass(11) / mass(24)) * tanb) - g_yuk10_1 = ( - ((g / 2.0_omega_prec) * (mass(2) / mass(24)) * & - (sinal / sinbe))) - g_yuk11_1 = ( - ((g / 2.0_omega_prec) * (mass(2) / mass(24)) * & - (cosal / sinbe))) - g_yuk12_1 = (imago * & - (g / 2.0_omega_prec) * (mass(2) / mass(24)) * (1.0_omega_prec / tanb)) - g_yuk13_1 = ( - ((g / 2.0_omega_prec) * (mass(1) / mass(24)) * & - (cosal / cosbe))) - g_yuk14_1 = ((g / 2.0_omega_prec) * (mass(1) / mass(24)) * (sinal / cosbe)) - g_yuk15_1 = (imago * & - (g / 2.0_omega_prec) * (mass(1) / mass(24)) * tanb) - g_yuk6_2 = (gcc * (mass(13) / mass(24)) * tanb) - g_yuk7_2 = ( - ((g / 2.0_omega_prec) * (mass(13) / mass(24)) * & - (cosal / cosbe))) - g_yuk8_2 = ((g / 2.0_omega_prec) * (mass(13) / mass(24)) * (sinal / cosbe)) - g_yuk9_2 = (imago * & - (g / 2.0_omega_prec) * (mass(13) / mass(24)) * tanb) - g_yuk10_2 = ( - ((g / 2.0_omega_prec) * (mass(4) / mass(24)) * & - (sinal / sinbe))) - g_yuk11_2 = ( - ((g / 2.0_omega_prec) * (mass(4) / mass(24)) * & - (cosal / sinbe))) - g_yuk12_2 = (imago * & - (g / 2.0_omega_prec) * (mass(4) / mass(24)) * (1.0_omega_prec / tanb)) - g_yuk13_2 = ( - ((g / 2.0_omega_prec) * (mass(3) / mass(24)) * & - (cosal / cosbe))) - g_yuk14_2 = ((g / 2.0_omega_prec) * (mass(3) / mass(24)) * (sinal / cosbe)) - g_yuk15_2 = (imago * & - (g / 2.0_omega_prec) * (mass(3) / mass(24)) * tanb) - g_yuk6_3 = (gcc * (mass(15) / mass(24)) * tanb) - g_yuk7_3 = ( - ((g / 2.0_omega_prec) * (mass(15) / mass(24)) * & - (cosal / cosbe))) - g_yuk8_3 = ((g / 2.0_omega_prec) * (mass(15) / mass(24)) * (sinal / cosbe)) - g_yuk9_3 = (imago * & - (g / 2.0_omega_prec) * (mass(15) / mass(24)) * tanb) - end subroutine setup_parameters1 - subroutine setup_parameters2 () - g_yuk10_3 = ( - ((g / 2.0_omega_prec) * (mass(6) / mass(24)) * & - (sinal / sinbe))) - g_yuk11_3 = ( - ((g / 2.0_omega_prec) * (mass(6) / mass(24)) * & - (cosal / sinbe))) - g_yuk12_3 = (imago * & - (g / 2.0_omega_prec) * (mass(6) / mass(24)) * (1.0_omega_prec / tanb)) - g_yuk13_3 = ( - ((g / 2.0_omega_prec) * (mass(5) / mass(24)) * & - (cosal / cosbe))) - g_yuk14_3 = ((g / 2.0_omega_prec) * (mass(5) / mass(24)) * (sinal / cosbe)) - g_yuk15_3 = (imago * & - (g / 2.0_omega_prec) * (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_omega_prec * vckm_11 * & - conjg (mix_su111) * mix_sd111)) - gs2ws2_1_1 = ( - (gcc * 2.0_omega_prec * vckm_11 * & - conjg (mix_su121) * mix_sd121)) - gs1ws2_1_1 = ( - (gcc * 2.0_omega_prec * vckm_11 * & - conjg (mix_su111) * mix_sd121)) - gs2ws1_1_1 = ( - (gcc * 2.0_omega_prec * 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_omega_prec * vckm_12 * & - conjg (mix_su111) * mix_sd211)) - gs2ws2_1_2 = ( - (gcc * 2.0_omega_prec * vckm_12 * & - conjg (mix_su121) * mix_sd221)) - gs1ws2_1_2 = ( - (gcc * 2.0_omega_prec * vckm_12 * & - conjg (mix_su111) * mix_sd221)) - gs2ws1_1_2 = ( - (gcc * 2.0_omega_prec * 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_omega_prec * vckm_13 * & - conjg (mix_su111) * mix_sd311)) - gs2ws2_1_3 = ( - (gcc * 2.0_omega_prec * vckm_13 * & - conjg (mix_su121) * mix_sd321)) - gs1ws2_1_3 = ( - (gcc * 2.0_omega_prec * vckm_13 * & - conjg (mix_su111) * mix_sd321)) - gs2ws1_1_3 = ( - (gcc * 2.0_omega_prec * 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_omega_prec * vckm_21 * & - conjg (mix_su211) * mix_sd111)) - gs2ws2_2_1 = ( - (gcc * 2.0_omega_prec * vckm_21 * & - conjg (mix_su221) * mix_sd121)) - gs1ws2_2_1 = ( - (gcc * 2.0_omega_prec * vckm_21 * & - conjg (mix_su211) * mix_sd121)) - gs2ws1_2_1 = ( - (gcc * 2.0_omega_prec * 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_omega_prec * vckm_22 * & - conjg (mix_su211) * mix_sd211)) - gs2ws2_2_2 = ( - (gcc * 2.0_omega_prec * vckm_22 * & - conjg (mix_su221) * mix_sd221)) - gs1ws2_2_2 = ( - (gcc * 2.0_omega_prec * vckm_22 * & - conjg (mix_su211) * mix_sd221)) - gs2ws1_2_2 = ( - (gcc * 2.0_omega_prec * 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_omega_prec * vckm_23 * & - conjg (mix_su211) * mix_sd311)) - gs2ws2_2_3 = ( - (gcc * 2.0_omega_prec * vckm_23 * & - conjg (mix_su221) * mix_sd321)) - gs1ws2_2_3 = ( - (gcc * 2.0_omega_prec * vckm_23 * & - conjg (mix_su211) * mix_sd321)) - gs2ws1_2_3 = ( - (gcc * 2.0_omega_prec * 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_omega_prec * vckm_31 * & - conjg (mix_su311) * mix_sd111)) - gs2ws2_3_1 = ( - (gcc * 2.0_omega_prec * vckm_31 * & - conjg (mix_su321) * mix_sd121)) - gs1ws2_3_1 = ( - (gcc * 2.0_omega_prec * vckm_31 * & - conjg (mix_su311) * mix_sd121)) - gs2ws1_3_1 = ( - (gcc * 2.0_omega_prec * 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_omega_prec * vckm_32 * & - conjg (mix_su311) * mix_sd211)) - gs2ws2_3_2 = ( - (gcc * 2.0_omega_prec * vckm_32 * & - conjg (mix_su321) * mix_sd221)) - gs1ws2_3_2 = ( - (gcc * 2.0_omega_prec * vckm_32 * & - conjg (mix_su311) * mix_sd221)) - gs2ws1_3_2 = ( - (gcc * 2.0_omega_prec * 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_omega_prec * vckm_33 * & - conjg (mix_su311) * mix_sd311)) - gs2ws2_3_3 = ( - (gcc * 2.0_omega_prec * vckm_33 * & - conjg (mix_su321) * mix_sd321)) - gs1ws2_3_3 = ( - (gcc * 2.0_omega_prec * vckm_33 * & - conjg (mix_su311) * mix_sd321)) - gs2ws1_3_3 = ( - (gcc * 2.0_omega_prec * 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_omega_prec) * ((2.0_omega_prec * sin2thw) - & - (mix_sl111 * conjg (mix_sl111)))) - gsl2zsl2_1 = ((gz / 2.0_omega_prec) * ((2.0_omega_prec * sin2thw) - & - (mix_sl121 * conjg (mix_sl121)))) - gsl1zsl2_1 = ((( - gz) / 2.0_omega_prec) * conjg (mix_sl111) * mix_sl121) - gsl2zsl1_1 = conjg (gsl1zsl2_1) - gsn1zsn1_1 = (gz / 2.0_omega_prec) - gsu1zsu1_1 = ((gz / 2.0_omega_prec) * ((mix_su111 * conjg (mix_su111)) - ( & - (4.0_omega_prec / 3.0_omega_prec) * sin2thw))) - gsu2zsu2_1 = ((gz / 2.0_omega_prec) * ((mix_su121 * conjg (mix_su121)) - ( & - (4.0_omega_prec / 3.0_omega_prec) * sin2thw))) - gsu1zsu2_1 = ((gz / 2.0_omega_prec) * conjg (mix_su111) * mix_su121) - gsu2zsu1_1 = conjg (gsu1zsu2_1) - gsd1zsd1_1 = ((gz / 2.0_omega_prec) * (( & - (2.0_omega_prec / 3.0_omega_prec) * sin2thw) - (mix_sd111 * & - conjg (mix_sd111)))) - gsd2zsd2_1 = ((gz / 2.0_omega_prec) * (( & - (2.0_omega_prec / 3.0_omega_prec) * sin2thw) - (mix_sd121 * & - conjg (mix_sd121)))) - gsd1zsd2_1 = ((( - gz) / 2.0_omega_prec) * conjg (mix_sd111) * mix_sd121) - gsd2zsd1_1 = conjg (gsd1zsd2_1) - gsl1_1snw = (gcc * 2.0_omega_prec * mix_sl111) - gsl2_1snw = (gcc * 2.0_omega_prec * mix_sl121) - gsl1_1snw_c = (gcc * 2.0_omega_prec * conjg (mix_sl111)) - gsl2_1snw_c = (gcc * 2.0_omega_prec * conjg (mix_sl121)) - gsl1zsl1_2 = ((gz / 2.0_omega_prec) * ((2.0_omega_prec * sin2thw) - & - (mix_sl211 * conjg (mix_sl211)))) - gsl2zsl2_2 = ((gz / 2.0_omega_prec) * ((2.0_omega_prec * sin2thw) - & - (mix_sl221 * conjg (mix_sl221)))) - gsl1zsl2_2 = ((( - gz) / 2.0_omega_prec) * conjg (mix_sl211) * mix_sl221) - gsl2zsl1_2 = conjg (gsl1zsl2_2) - gsn1zsn1_2 = (gz / 2.0_omega_prec) - gsu1zsu1_2 = ((gz / 2.0_omega_prec) * ((mix_su211 * conjg (mix_su211)) - ( & - (4.0_omega_prec / 3.0_omega_prec) * sin2thw))) - gsu2zsu2_2 = ((gz / 2.0_omega_prec) * ((mix_su221 * conjg (mix_su221)) - ( & - (4.0_omega_prec / 3.0_omega_prec) * sin2thw))) - gsu1zsu2_2 = ((gz / 2.0_omega_prec) * conjg (mix_su211) * mix_su221) - gsu2zsu1_2 = conjg (gsu1zsu2_2) - gsd1zsd1_2 = ((gz / 2.0_omega_prec) * (( & - (2.0_omega_prec / 3.0_omega_prec) * sin2thw) - (mix_sd211 * & - conjg (mix_sd211)))) - gsd2zsd2_2 = ((gz / 2.0_omega_prec) * (( & - (2.0_omega_prec / 3.0_omega_prec) * sin2thw) - (mix_sd221 * & - conjg (mix_sd221)))) - gsd1zsd2_2 = ((( - gz) / 2.0_omega_prec) * conjg (mix_sd211) * mix_sd221) - gsd2zsd1_2 = conjg (gsd1zsd2_2) - gsl1_2snw = (gcc * 2.0_omega_prec * mix_sl211) - gsl2_2snw = (gcc * 2.0_omega_prec * mix_sl221) - gsl1_2snw_c = (gcc * 2.0_omega_prec * conjg (mix_sl211)) - gsl2_2snw_c = (gcc * 2.0_omega_prec * conjg (mix_sl221)) - gsl1zsl1_3 = ((gz / 2.0_omega_prec) * ((2.0_omega_prec * sin2thw) - & - (mix_sl311 * conjg (mix_sl311)))) - gsl2zsl2_3 = ((gz / 2.0_omega_prec) * ((2.0_omega_prec * sin2thw) - & - (mix_sl321 * conjg (mix_sl321)))) - gsl1zsl2_3 = ((( - gz) / 2.0_omega_prec) * conjg (mix_sl311) * mix_sl321) - gsl2zsl1_3 = conjg (gsl1zsl2_3) - end subroutine setup_parameters2 - subroutine setup_parameters3 () - gsn1zsn1_3 = (gz / 2.0_omega_prec) - gsu1zsu1_3 = ((gz / 2.0_omega_prec) * ((mix_su311 * conjg (mix_su311)) - ( & - (4.0_omega_prec / 3.0_omega_prec) * sin2thw))) - gsu2zsu2_3 = ((gz / 2.0_omega_prec) * ((mix_su321 * conjg (mix_su321)) - ( & - (4.0_omega_prec / 3.0_omega_prec) * sin2thw))) - gsu1zsu2_3 = ((gz / 2.0_omega_prec) * conjg (mix_su311) * mix_su321) - gsu2zsu1_3 = conjg (gsu1zsu2_3) - gsd1zsd1_3 = ((gz / 2.0_omega_prec) * (( & - (2.0_omega_prec / 3.0_omega_prec) * sin2thw) - (mix_sd311 * & - conjg (mix_sd311)))) - gsd2zsd2_3 = ((gz / 2.0_omega_prec) * (( & - (2.0_omega_prec / 3.0_omega_prec) * sin2thw) - (mix_sd321 * & - conjg (mix_sd321)))) - gsd1zsd2_3 = ((( - gz) / 2.0_omega_prec) * conjg (mix_sd311) * mix_sd321) - gsd2zsd1_3 = conjg (gsd1zsd2_3) - gsl1_3snw = (gcc * 2.0_omega_prec * mix_sl311) - gsl2_3snw = (gcc * 2.0_omega_prec * mix_sl321) - gsl1_3snw_c = (gcc * 2.0_omega_prec * conjg (mix_sl311)) - gsl2_3snw_c = (gcc * 2.0_omega_prec * conjg (mix_sl321)) - gppslsl = (2.0_omega_prec * (e**2)) - gppsusu = ((8.0_omega_prec / 9.0_omega_prec) * (e**2)) - gppsdsd = ((2.0_omega_prec / 9.0_omega_prec) * (e**2)) - gzzsl1sl1_1 = (((gz**2) / 2.0_omega_prec) * (((1.0_omega_prec - & - (4.0_omega_prec * sin2thw)) * (mix_sl111 * conjg (mix_sl111))) + & - (4.0_omega_prec * (sin2thw**2)))) - gzzsl2sl2_1 = (((gz**2) / 2.0_omega_prec) * (((1.0_omega_prec - & - (4.0_omega_prec * sin2thw)) * (mix_sl121 * conjg (mix_sl121))) + & - (4.0_omega_prec * (sin2thw**2)))) - gzzsl1sl2_1 = (((gz**2) / 2.0_omega_prec) * (1.0_omega_prec - & - (4.0_omega_prec * sin2thw)) * mix_sl111 * conjg (mix_sl121)) - gzzsl2sl1_1 = conjg(gzzsl1sl2_1) - gzzsn1sn1_1 = ((gz**2) / 2.0_omega_prec) - gzzsu1su1_1 = (((gz**2) / 2.0_omega_prec) * (((1.0_omega_prec - ( & - (8.0_omega_prec / 3.0_omega_prec) * sin2thw)) * (mix_su111 * & - conjg (mix_su111))) + ((sin2thw**2) * & - (16.0_omega_prec / 9.0_omega_prec)))) - gzzsu2su2_1 = (((gz**2) / 2.0_omega_prec) * (((1.0_omega_prec - ( & - (8.0_omega_prec / 3.0_omega_prec) * sin2thw)) * (mix_su121 * & - conjg (mix_su121))) + ((sin2thw**2) * & - (16.0_omega_prec / 9.0_omega_prec)))) - gzzsu1su2_1 = (((gz**2) / 2.0_omega_prec) * (1.0_omega_prec - (sin2thw * & - (8.0_omega_prec / 3.0_omega_prec))) * mix_su111 * conjg (mix_su121)) - gzzsu2su1_1 = conjg(gzzsu1su2_1) - gzzsd1sd1_1 = (((gz**2) / 2.0_omega_prec) * (((1.0_omega_prec - (sin2thw * & - (4.0_omega_prec / 3.0_omega_prec))) * (mix_sd111 * conjg (mix_sd111))) + & - ((sin2thw**2) * (4.0_omega_prec / 9.0_omega_prec)))) - gzzsd2sd2_1 = (((gz**2) / 2.0_omega_prec) * (((1.0_omega_prec - (sin2thw * & - (4.0_omega_prec / 3.0_omega_prec))) * (mix_sd121 * conjg (mix_sd121))) + & - ((sin2thw**2) * (4.0_omega_prec / 9.0_omega_prec)))) - gzzsd1sd2_1 = (((gz**2) / 2.0_omega_prec) * (1.0_omega_prec - (sin2thw * & - (4.0_omega_prec / 3.0_omega_prec))) * mix_sd111 * conjg (mix_sd121)) - gzzsd2sd1_1 = conjg(gzzsd1sd2_1) - gzpsl1sl1_1 = (e * gz * ((mix_sl111 * conjg (mix_sl111)) - & - (2.0_omega_prec * sin2thw))) - gzpsl2sl2_1 = (e * gz * ((mix_sl121 * conjg (mix_sl121)) - & - (2.0_omega_prec * 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_omega_prec / 3.0_omega_prec) * ((mix_su111 * & - conjg (mix_su111)) - (sin2thw * (4.0_omega_prec / 3.0_omega_prec)))) - gzpsu2su2_1 = (e * gz * (2.0_omega_prec / 3.0_omega_prec) * ((mix_su121 * & - conjg (mix_su121)) - (sin2thw * (4.0_omega_prec / 3.0_omega_prec)))) - gzpsu1su2_1 = (e * gz * (2.0_omega_prec / 3.0_omega_prec) * mix_su111 * & - conjg (mix_su121)) - gzpsu2su1_1 = (e * gz * (2.0_omega_prec / 3.0_omega_prec) * mix_su121 * & - conjg (mix_su111)) - gzpsd1sd1_1 = (e * gz * (1.0_omega_prec / 3.0_omega_prec) * ((mix_sd111 * & - conjg (mix_sd111)) - (sin2thw * (2.0_omega_prec / 3.0_omega_prec)))) - gzpsd2sd2_1 = (e * gz * (1.0_omega_prec / 3.0_omega_prec) * ((mix_sd121 * & - conjg (mix_sd121)) - (sin2thw * (2.0_omega_prec / 3.0_omega_prec)))) - gzpsd1sd2_1 = (e * gz * (1.0_omega_prec / 3.0_omega_prec) * mix_sd111 * & - conjg (mix_sd121)) - gzpsd2sd1_1 = (e * gz * (1.0_omega_prec / 3.0_omega_prec) * mix_sd121 * & - conjg (mix_sd111)) - gwwsl1sl1_1 = (((g**2) / 2.0_omega_prec) * (mix_sl111 * conjg (mix_sl111))) - gwwsl2sl2_1 = (((g**2) / 2.0_omega_prec) * (mix_sl121 * conjg (mix_sl121))) - gwwsl1sl2_1 = (((g**2) / 2.0_omega_prec) * mix_sl111 * conjg (mix_sl121)) - gwwsl2sl1_1 = (((g**2) / 2.0_omega_prec) * mix_sl121 * conjg (mix_sl111)) - gwwsn1sn1_1 = ((g**2) / 2.0_omega_prec) - gwwsu1su1_1 = (((g**2) / 2.0_omega_prec) * (mix_su111 * conjg (mix_su111))) - gwwsu2su2_1 = (((g**2) / 2.0_omega_prec) * (mix_su121 * conjg (mix_su121))) - gwwsu1su2_1 = (((g**2) / 2.0_omega_prec) * mix_su111 * conjg (mix_su121)) - gwwsu2su1_1 = (((g**2) / 2.0_omega_prec) * mix_su121 * conjg (mix_su111)) - gwwsd1sd1_1 = (((g**2) / 2.0_omega_prec) * (mix_sd111 * conjg (mix_sd111))) - gwwsd2sd2_1 = (((g**2) / 2.0_omega_prec) * (mix_sd121 * conjg (mix_sd121))) - gwwsd1sd2_1 = (((g**2) / 2.0_omega_prec) * mix_sd111 * conjg (mix_sd121)) - gwwsd2sd1_1 = (((g**2) / 2.0_omega_prec) * mix_sd121 * conjg (mix_sd111)) - gpwsl1sn_1 = ( - (e * 2.0_omega_prec * gcc * mix_sl111)) - gpwsl2sn_1 = ( - (e * 2.0_omega_prec * gcc * mix_sl121)) - gpwsl1sn_1_c = ( - (e * 2.0_omega_prec * gcc * conjg (mix_sl111))) - gpwsl2sn_1_c = ( - (e * 2.0_omega_prec * gcc * conjg (mix_sl121))) - gwzsl1sn_1 = (gcc * gz * 2.0_omega_prec * sin2thw * mix_sl111) - gwzsl2sn_1 = (gcc * gz * 2.0_omega_prec * sin2thw * mix_sl121) - gwzsl1sn_1_c = (gcc * gz * 2.0_omega_prec * sin2thw * conjg (mix_sl111)) - gwzsl2sn_1_c = (gcc * gz * 2.0_omega_prec * sin2thw * conjg (mix_sl121)) - gzzsl1sl1_2 = (((gz**2) / 2.0_omega_prec) * (((1.0_omega_prec - & - (4.0_omega_prec * sin2thw)) * (mix_sl211 * conjg (mix_sl211))) + & - (4.0_omega_prec * (sin2thw**2)))) - gzzsl2sl2_2 = (((gz**2) / 2.0_omega_prec) * (((1.0_omega_prec - & - (4.0_omega_prec * sin2thw)) * (mix_sl221 * conjg (mix_sl221))) + & - (4.0_omega_prec * (sin2thw**2)))) - gzzsl1sl2_2 = (((gz**2) / 2.0_omega_prec) * (1.0_omega_prec - & - (4.0_omega_prec * sin2thw)) * mix_sl211 * conjg (mix_sl221)) - gzzsl2sl1_2 = conjg(gzzsl1sl2_2) - gzzsn1sn1_2 = ((gz**2) / 2.0_omega_prec) - gzzsu1su1_2 = (((gz**2) / 2.0_omega_prec) * (((1.0_omega_prec - ( & - (8.0_omega_prec / 3.0_omega_prec) * sin2thw)) * (mix_su211 * & - conjg (mix_su211))) + ((sin2thw**2) * & - (16.0_omega_prec / 9.0_omega_prec)))) - gzzsu2su2_2 = (((gz**2) / 2.0_omega_prec) * (((1.0_omega_prec - ( & - (8.0_omega_prec / 3.0_omega_prec) * sin2thw)) * (mix_su221 * & - conjg (mix_su221))) + ((sin2thw**2) * & - (16.0_omega_prec / 9.0_omega_prec)))) - gzzsu1su2_2 = (((gz**2) / 2.0_omega_prec) * (1.0_omega_prec - (sin2thw * & - (8.0_omega_prec / 3.0_omega_prec))) * mix_su211 * conjg (mix_su221)) - gzzsu2su1_2 = conjg(gzzsu1su2_2) - gzzsd1sd1_2 = (((gz**2) / 2.0_omega_prec) * (((1.0_omega_prec - (sin2thw * & - (4.0_omega_prec / 3.0_omega_prec))) * (mix_sd211 * conjg (mix_sd211))) + & - ((sin2thw**2) * (4.0_omega_prec / 9.0_omega_prec)))) - gzzsd2sd2_2 = (((gz**2) / 2.0_omega_prec) * (((1.0_omega_prec - (sin2thw * & - (4.0_omega_prec / 3.0_omega_prec))) * (mix_sd221 * conjg (mix_sd221))) + & - ((sin2thw**2) * (4.0_omega_prec / 9.0_omega_prec)))) - gzzsd1sd2_2 = (((gz**2) / 2.0_omega_prec) * (1.0_omega_prec - (sin2thw * & - (4.0_omega_prec / 3.0_omega_prec))) * mix_sd211 * conjg (mix_sd221)) - gzzsd2sd1_2 = conjg(gzzsd1sd2_2) - gzpsl1sl1_2 = (e * gz * ((mix_sl211 * conjg (mix_sl211)) - & - (2.0_omega_prec * sin2thw))) - gzpsl2sl2_2 = (e * gz * ((mix_sl221 * conjg (mix_sl221)) - & - (2.0_omega_prec * 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_omega_prec / 3.0_omega_prec) * ((mix_su211 * & - conjg (mix_su211)) - (sin2thw * (4.0_omega_prec / 3.0_omega_prec)))) - gzpsu2su2_2 = (e * gz * (2.0_omega_prec / 3.0_omega_prec) * ((mix_su221 * & - conjg (mix_su221)) - (sin2thw * (4.0_omega_prec / 3.0_omega_prec)))) - gzpsu1su2_2 = (e * gz * (2.0_omega_prec / 3.0_omega_prec) * mix_su211 * & - conjg (mix_su221)) - gzpsu2su1_2 = (e * gz * (2.0_omega_prec / 3.0_omega_prec) * mix_su221 * & - conjg (mix_su211)) - gzpsd1sd1_2 = (e * gz * (1.0_omega_prec / 3.0_omega_prec) * ((mix_sd211 * & - conjg (mix_sd211)) - (sin2thw * (2.0_omega_prec / 3.0_omega_prec)))) - gzpsd2sd2_2 = (e * gz * (1.0_omega_prec / 3.0_omega_prec) * ((mix_sd221 * & - conjg (mix_sd221)) - (sin2thw * (2.0_omega_prec / 3.0_omega_prec)))) - gzpsd1sd2_2 = (e * gz * (1.0_omega_prec / 3.0_omega_prec) * mix_sd211 * & - conjg (mix_sd221)) - gzpsd2sd1_2 = (e * gz * (1.0_omega_prec / 3.0_omega_prec) * mix_sd221 * & - conjg (mix_sd211)) - gwwsl1sl1_2 = (((g**2) / 2.0_omega_prec) * (mix_sl211 * conjg (mix_sl211))) - gwwsl2sl2_2 = (((g**2) / 2.0_omega_prec) * (mix_sl221 * conjg (mix_sl221))) - gwwsl1sl2_2 = (((g**2) / 2.0_omega_prec) * mix_sl211 * conjg (mix_sl221)) - gwwsl2sl1_2 = (((g**2) / 2.0_omega_prec) * mix_sl221 * conjg (mix_sl211)) - gwwsn1sn1_2 = ((g**2) / 2.0_omega_prec) - gwwsu1su1_2 = (((g**2) / 2.0_omega_prec) * (mix_su211 * conjg (mix_su211))) - gwwsu2su2_2 = (((g**2) / 2.0_omega_prec) * (mix_su221 * conjg (mix_su221))) - gwwsu1su2_2 = (((g**2) / 2.0_omega_prec) * mix_su211 * conjg (mix_su221)) - gwwsu2su1_2 = (((g**2) / 2.0_omega_prec) * mix_su221 * conjg (mix_su211)) - gwwsd1sd1_2 = (((g**2) / 2.0_omega_prec) * (mix_sd211 * conjg (mix_sd211))) - gwwsd2sd2_2 = (((g**2) / 2.0_omega_prec) * (mix_sd221 * conjg (mix_sd221))) - gwwsd1sd2_2 = (((g**2) / 2.0_omega_prec) * mix_sd211 * conjg (mix_sd221)) - gwwsd2sd1_2 = (((g**2) / 2.0_omega_prec) * mix_sd221 * conjg (mix_sd211)) - gpwsl1sn_2 = ( - (e * 2.0_omega_prec * gcc * mix_sl211)) - gpwsl2sn_2 = ( - (e * 2.0_omega_prec * gcc * mix_sl221)) - gpwsl1sn_2_c = ( - (e * 2.0_omega_prec * gcc * conjg (mix_sl211))) - gpwsl2sn_2_c = ( - (e * 2.0_omega_prec * gcc * conjg (mix_sl221))) - gwzsl1sn_2 = (gcc * gz * 2.0_omega_prec * sin2thw * mix_sl211) - gwzsl2sn_2 = (gcc * gz * 2.0_omega_prec * sin2thw * mix_sl221) - gwzsl1sn_2_c = (gcc * gz * 2.0_omega_prec * sin2thw * conjg (mix_sl211)) - gwzsl2sn_2_c = (gcc * gz * 2.0_omega_prec * sin2thw * conjg (mix_sl221)) - gzzsl1sl1_3 = (((gz**2) / 2.0_omega_prec) * (((1.0_omega_prec - & - (4.0_omega_prec * sin2thw)) * (mix_sl311 * conjg (mix_sl311))) + & - (4.0_omega_prec * (sin2thw**2)))) - gzzsl2sl2_3 = (((gz**2) / 2.0_omega_prec) * (((1.0_omega_prec - & - (4.0_omega_prec * sin2thw)) * (mix_sl321 * conjg (mix_sl321))) + & - (4.0_omega_prec * (sin2thw**2)))) - gzzsl1sl2_3 = (((gz**2) / 2.0_omega_prec) * (1.0_omega_prec - & - (4.0_omega_prec * sin2thw)) * mix_sl311 * conjg (mix_sl321)) - gzzsl2sl1_3 = conjg(gzzsl1sl2_3) - gzzsn1sn1_3 = ((gz**2) / 2.0_omega_prec) - gzzsu1su1_3 = (((gz**2) / 2.0_omega_prec) * (((1.0_omega_prec - ( & - (8.0_omega_prec / 3.0_omega_prec) * sin2thw)) * (mix_su311 * & - conjg (mix_su311))) + ((sin2thw**2) * & - (16.0_omega_prec / 9.0_omega_prec)))) - gzzsu2su2_3 = (((gz**2) / 2.0_omega_prec) * (((1.0_omega_prec - ( & - (8.0_omega_prec / 3.0_omega_prec) * sin2thw)) * (mix_su321 * & - conjg (mix_su321))) + ((sin2thw**2) * & - (16.0_omega_prec / 9.0_omega_prec)))) - gzzsu1su2_3 = (((gz**2) / 2.0_omega_prec) * (1.0_omega_prec - (sin2thw * & - (8.0_omega_prec / 3.0_omega_prec))) * mix_su311 * conjg (mix_su321)) - gzzsu2su1_3 = conjg(gzzsu1su2_3) - gzzsd1sd1_3 = (((gz**2) / 2.0_omega_prec) * (((1.0_omega_prec - (sin2thw * & - (4.0_omega_prec / 3.0_omega_prec))) * (mix_sd311 * conjg (mix_sd311))) + & - ((sin2thw**2) * (4.0_omega_prec / 9.0_omega_prec)))) - gzzsd2sd2_3 = (((gz**2) / 2.0_omega_prec) * (((1.0_omega_prec - (sin2thw * & - (4.0_omega_prec / 3.0_omega_prec))) * (mix_sd321 * conjg (mix_sd321))) + & - ((sin2thw**2) * (4.0_omega_prec / 9.0_omega_prec)))) - gzzsd1sd2_3 = (((gz**2) / 2.0_omega_prec) * (1.0_omega_prec - (sin2thw * & - (4.0_omega_prec / 3.0_omega_prec))) * mix_sd311 * conjg (mix_sd321)) - end subroutine setup_parameters3 - subroutine setup_parameters4 () - gzzsd2sd1_3 = conjg(gzzsd1sd2_3) - gzpsl1sl1_3 = (e * gz * ((mix_sl311 * conjg (mix_sl311)) - & - (2.0_omega_prec * sin2thw))) - gzpsl2sl2_3 = (e * gz * ((mix_sl321 * conjg (mix_sl321)) - & - (2.0_omega_prec * 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_omega_prec / 3.0_omega_prec) * ((mix_su311 * & - conjg (mix_su311)) - (sin2thw * (4.0_omega_prec / 3.0_omega_prec)))) - gzpsu2su2_3 = (e * gz * (2.0_omega_prec / 3.0_omega_prec) * ((mix_su321 * & - conjg (mix_su321)) - (sin2thw * (4.0_omega_prec / 3.0_omega_prec)))) - gzpsu1su2_3 = (e * gz * (2.0_omega_prec / 3.0_omega_prec) * mix_su311 * & - conjg (mix_su321)) - gzpsu2su1_3 = (e * gz * (2.0_omega_prec / 3.0_omega_prec) * mix_su321 * & - conjg (mix_su311)) - gzpsd1sd1_3 = (e * gz * (1.0_omega_prec / 3.0_omega_prec) * ((mix_sd311 * & - conjg (mix_sd311)) - (sin2thw * (2.0_omega_prec / 3.0_omega_prec)))) - gzpsd2sd2_3 = (e * gz * (1.0_omega_prec / 3.0_omega_prec) * ((mix_sd321 * & - conjg (mix_sd321)) - (sin2thw * (2.0_omega_prec / 3.0_omega_prec)))) - gzpsd1sd2_3 = (e * gz * (1.0_omega_prec / 3.0_omega_prec) * mix_sd311 * & - conjg (mix_sd321)) - gzpsd2sd1_3 = (e * gz * (1.0_omega_prec / 3.0_omega_prec) * mix_sd321 * & - conjg (mix_sd311)) - gwwsl1sl1_3 = (((g**2) / 2.0_omega_prec) * (mix_sl311 * conjg (mix_sl311))) - gwwsl2sl2_3 = (((g**2) / 2.0_omega_prec) * (mix_sl321 * conjg (mix_sl321))) - gwwsl1sl2_3 = (((g**2) / 2.0_omega_prec) * mix_sl311 * conjg (mix_sl321)) - gwwsl2sl1_3 = (((g**2) / 2.0_omega_prec) * mix_sl321 * conjg (mix_sl311)) - gwwsn1sn1_3 = ((g**2) / 2.0_omega_prec) - gwwsu1su1_3 = (((g**2) / 2.0_omega_prec) * (mix_su311 * conjg (mix_su311))) - gwwsu2su2_3 = (((g**2) / 2.0_omega_prec) * (mix_su321 * conjg (mix_su321))) - gwwsu1su2_3 = (((g**2) / 2.0_omega_prec) * mix_su311 * conjg (mix_su321)) - gwwsu2su1_3 = (((g**2) / 2.0_omega_prec) * mix_su321 * conjg (mix_su311)) - gwwsd1sd1_3 = (((g**2) / 2.0_omega_prec) * (mix_sd311 * conjg (mix_sd311))) - gwwsd2sd2_3 = (((g**2) / 2.0_omega_prec) * (mix_sd321 * conjg (mix_sd321))) - gwwsd1sd2_3 = (((g**2) / 2.0_omega_prec) * mix_sd311 * conjg (mix_sd321)) - gwwsd2sd1_3 = (((g**2) / 2.0_omega_prec) * mix_sd321 * conjg (mix_sd311)) - gpwsl1sn_3 = ( - (e * 2.0_omega_prec * gcc * mix_sl311)) - gpwsl2sn_3 = ( - (e * 2.0_omega_prec * gcc * mix_sl321)) - gpwsl1sn_3_c = ( - (e * 2.0_omega_prec * gcc * conjg (mix_sl311))) - gpwsl2sn_3_c = ( - (e * 2.0_omega_prec * gcc * conjg (mix_sl321))) - gwzsl1sn_3 = (gcc * gz * 2.0_omega_prec * sin2thw * mix_sl311) - gwzsl2sn_3 = (gcc * gz * 2.0_omega_prec * sin2thw * mix_sl321) - gwzsl1sn_3_c = (gcc * gz * 2.0_omega_prec * sin2thw * conjg (mix_sl311)) - gwzsl2sn_3_c = (gcc * gz * 2.0_omega_prec * sin2thw * conjg (mix_sl321)) - gpwpsu1sd1_1_1 = (e * gcc * (2.0_omega_prec / 3.0_omega_prec) * vckm_11 * & - conjg (mix_su111) * mix_sd111) - gpwpsu2sd2_1_1 = (e * gcc * (2.0_omega_prec / 3.0_omega_prec) * vckm_11 * & - conjg (mix_su121) * mix_sd121) - gpwpsu1sd2_1_1 = (e * gcc * (2.0_omega_prec / 3.0_omega_prec) * vckm_11 * & - conjg (mix_su111) * mix_sd121) - gpwpsu2sd1_1_1 = (e * gcc * (2.0_omega_prec / 3.0_omega_prec) * 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_omega_prec / 3.0_omega_prec) * sin2thw * vckm_11 * & - conjg (mix_su111) * mix_sd111)) - gzwpsu2sd2_1_1 = ( - (gcc * gz * & - (2.0_omega_prec / 3.0_omega_prec) * sin2thw * vckm_11 * & - conjg (mix_su121) * mix_sd121)) - gzwpsu1sd2_1_1 = ( - (gcc * gz * & - (2.0_omega_prec / 3.0_omega_prec) * sin2thw * vckm_11 * & - conjg (mix_su111) * mix_sd121)) - gzwpsu2sd1_1_1 = ( - (gcc * gz * & - (2.0_omega_prec / 3.0_omega_prec) * 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_omega_prec / 3.0_omega_prec) * vckm_12 * & - conjg (mix_su111) * mix_sd211) - gpwpsu2sd2_1_2 = (e * gcc * (2.0_omega_prec / 3.0_omega_prec) * vckm_12 * & - conjg (mix_su121) * mix_sd221) - gpwpsu1sd2_1_2 = (e * gcc * (2.0_omega_prec / 3.0_omega_prec) * vckm_12 * & - conjg (mix_su111) * mix_sd221) - gpwpsu2sd1_1_2 = (e * gcc * (2.0_omega_prec / 3.0_omega_prec) * 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_omega_prec / 3.0_omega_prec) * sin2thw * vckm_12 * & - conjg (mix_su111) * mix_sd211)) - gzwpsu2sd2_1_2 = ( - (gcc * gz * & - (2.0_omega_prec / 3.0_omega_prec) * sin2thw * vckm_12 * & - conjg (mix_su121) * mix_sd221)) - gzwpsu1sd2_1_2 = ( - (gcc * gz * & - (2.0_omega_prec / 3.0_omega_prec) * sin2thw * vckm_12 * & - conjg (mix_su111) * mix_sd221)) - gzwpsu2sd1_1_2 = ( - (gcc * gz * & - (2.0_omega_prec / 3.0_omega_prec) * 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_omega_prec / 3.0_omega_prec) * vckm_13 * & - conjg (mix_su111) * mix_sd311) - gpwpsu2sd2_1_3 = (e * gcc * (2.0_omega_prec / 3.0_omega_prec) * vckm_13 * & - conjg (mix_su121) * mix_sd321) - gpwpsu1sd2_1_3 = (e * gcc * (2.0_omega_prec / 3.0_omega_prec) * vckm_13 * & - conjg (mix_su111) * mix_sd321) - gpwpsu2sd1_1_3 = (e * gcc * (2.0_omega_prec / 3.0_omega_prec) * 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_omega_prec / 3.0_omega_prec) * sin2thw * vckm_13 * & - conjg (mix_su111) * mix_sd311)) - gzwpsu2sd2_1_3 = ( - (gcc * gz * & - (2.0_omega_prec / 3.0_omega_prec) * sin2thw * vckm_13 * & - conjg (mix_su121) * mix_sd321)) - gzwpsu1sd2_1_3 = ( - (gcc * gz * & - (2.0_omega_prec / 3.0_omega_prec) * sin2thw * vckm_13 * & - conjg (mix_su111) * mix_sd321)) - gzwpsu2sd1_1_3 = ( - (gcc * gz * & - (2.0_omega_prec / 3.0_omega_prec) * 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_omega_prec / 3.0_omega_prec) * vckm_21 * & - conjg (mix_su211) * mix_sd111) - gpwpsu2sd2_2_1 = (e * gcc * (2.0_omega_prec / 3.0_omega_prec) * vckm_21 * & - conjg (mix_su221) * mix_sd121) - gpwpsu1sd2_2_1 = (e * gcc * (2.0_omega_prec / 3.0_omega_prec) * vckm_21 * & - conjg (mix_su211) * mix_sd121) - gpwpsu2sd1_2_1 = (e * gcc * (2.0_omega_prec / 3.0_omega_prec) * 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_omega_prec / 3.0_omega_prec) * sin2thw * vckm_21 * & - conjg (mix_su211) * mix_sd111)) - gzwpsu2sd2_2_1 = ( - (gcc * gz * & - (2.0_omega_prec / 3.0_omega_prec) * sin2thw * vckm_21 * & - conjg (mix_su221) * mix_sd121)) - gzwpsu1sd2_2_1 = ( - (gcc * gz * & - (2.0_omega_prec / 3.0_omega_prec) * sin2thw * vckm_21 * & - conjg (mix_su211) * mix_sd121)) - gzwpsu2sd1_2_1 = ( - (gcc * gz * & - (2.0_omega_prec / 3.0_omega_prec) * 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_omega_prec / 3.0_omega_prec) * vckm_22 * & - conjg (mix_su211) * mix_sd211) - gpwpsu2sd2_2_2 = (e * gcc * (2.0_omega_prec / 3.0_omega_prec) * vckm_22 * & - conjg (mix_su221) * mix_sd221) - gpwpsu1sd2_2_2 = (e * gcc * (2.0_omega_prec / 3.0_omega_prec) * vckm_22 * & - conjg (mix_su211) * mix_sd221) - gpwpsu2sd1_2_2 = (e * gcc * (2.0_omega_prec / 3.0_omega_prec) * 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_omega_prec / 3.0_omega_prec) * sin2thw * vckm_22 * & - conjg (mix_su211) * mix_sd211)) - gzwpsu2sd2_2_2 = ( - (gcc * gz * & - (2.0_omega_prec / 3.0_omega_prec) * sin2thw * vckm_22 * & - conjg (mix_su221) * mix_sd221)) - gzwpsu1sd2_2_2 = ( - (gcc * gz * & - (2.0_omega_prec / 3.0_omega_prec) * sin2thw * vckm_22 * & - conjg (mix_su211) * mix_sd221)) - gzwpsu2sd1_2_2 = ( - (gcc * gz * & - (2.0_omega_prec / 3.0_omega_prec) * 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_omega_prec / 3.0_omega_prec) * vckm_23 * & - conjg (mix_su211) * mix_sd311) - gpwpsu2sd2_2_3 = (e * gcc * (2.0_omega_prec / 3.0_omega_prec) * vckm_23 * & - conjg (mix_su221) * mix_sd321) - gpwpsu1sd2_2_3 = (e * gcc * (2.0_omega_prec / 3.0_omega_prec) * vckm_23 * & - conjg (mix_su211) * mix_sd321) - gpwpsu2sd1_2_3 = (e * gcc * (2.0_omega_prec / 3.0_omega_prec) * vckm_23 * & - conjg (mix_su221) * mix_sd311) - gpwpsu1sd1_2_3_c = conjg (gpwpsu1sd1_2_3) - gpwpsu2sd2_2_3_c = conjg (gpwpsu2sd2_2_3) - end subroutine setup_parameters4 - subroutine setup_parameters5 () - gpwpsu1sd2_2_3_c = conjg (gpwpsu1sd2_2_3) - gpwpsu2sd1_2_3_c = conjg (gpwpsu2sd1_2_3) - gzwpsu1sd1_2_3 = ( - (gcc * gz * & - (2.0_omega_prec / 3.0_omega_prec) * sin2thw * vckm_23 * & - conjg (mix_su211) * mix_sd311)) - gzwpsu2sd2_2_3 = ( - (gcc * gz * & - (2.0_omega_prec / 3.0_omega_prec) * sin2thw * vckm_23 * & - conjg (mix_su221) * mix_sd321)) - gzwpsu1sd2_2_3 = ( - (gcc * gz * & - (2.0_omega_prec / 3.0_omega_prec) * sin2thw * vckm_23 * & - conjg (mix_su211) * mix_sd321)) - gzwpsu2sd1_2_3 = ( - (gcc * gz * & - (2.0_omega_prec / 3.0_omega_prec) * 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_omega_prec / 3.0_omega_prec) * vckm_31 * & - conjg (mix_su311) * mix_sd111) - gpwpsu2sd2_3_1 = (e * gcc * (2.0_omega_prec / 3.0_omega_prec) * vckm_31 * & - conjg (mix_su321) * mix_sd121) - gpwpsu1sd2_3_1 = (e * gcc * (2.0_omega_prec / 3.0_omega_prec) * vckm_31 * & - conjg (mix_su311) * mix_sd121) - gpwpsu2sd1_3_1 = (e * gcc * (2.0_omega_prec / 3.0_omega_prec) * 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_omega_prec / 3.0_omega_prec) * sin2thw * vckm_31 * & - conjg (mix_su311) * mix_sd111)) - gzwpsu2sd2_3_1 = ( - (gcc * gz * & - (2.0_omega_prec / 3.0_omega_prec) * sin2thw * vckm_31 * & - conjg (mix_su321) * mix_sd121)) - gzwpsu1sd2_3_1 = ( - (gcc * gz * & - (2.0_omega_prec / 3.0_omega_prec) * sin2thw * vckm_31 * & - conjg (mix_su311) * mix_sd121)) - gzwpsu2sd1_3_1 = ( - (gcc * gz * & - (2.0_omega_prec / 3.0_omega_prec) * 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_omega_prec / 3.0_omega_prec) * vckm_32 * & - conjg (mix_su311) * mix_sd211) - gpwpsu2sd2_3_2 = (e * gcc * (2.0_omega_prec / 3.0_omega_prec) * vckm_32 * & - conjg (mix_su321) * mix_sd221) - gpwpsu1sd2_3_2 = (e * gcc * (2.0_omega_prec / 3.0_omega_prec) * vckm_32 * & - conjg (mix_su311) * mix_sd221) - gpwpsu2sd1_3_2 = (e * gcc * (2.0_omega_prec / 3.0_omega_prec) * 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_omega_prec / 3.0_omega_prec) * sin2thw * vckm_32 * & - conjg (mix_su311) * mix_sd211)) - gzwpsu2sd2_3_2 = ( - (gcc * gz * & - (2.0_omega_prec / 3.0_omega_prec) * sin2thw * vckm_32 * & - conjg (mix_su321) * mix_sd221)) - gzwpsu1sd2_3_2 = ( - (gcc * gz * & - (2.0_omega_prec / 3.0_omega_prec) * sin2thw * vckm_32 * & - conjg (mix_su311) * mix_sd221)) - gzwpsu2sd1_3_2 = ( - (gcc * gz * & - (2.0_omega_prec / 3.0_omega_prec) * 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_omega_prec / 3.0_omega_prec) * vckm_33 * & - conjg (mix_su311) * mix_sd311) - gpwpsu2sd2_3_3 = (e * gcc * (2.0_omega_prec / 3.0_omega_prec) * vckm_33 * & - conjg (mix_su321) * mix_sd321) - gpwpsu1sd2_3_3 = (e * gcc * (2.0_omega_prec / 3.0_omega_prec) * vckm_33 * & - conjg (mix_su311) * mix_sd321) - gpwpsu2sd1_3_3 = (e * gcc * (2.0_omega_prec / 3.0_omega_prec) * 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_omega_prec / 3.0_omega_prec) * sin2thw * vckm_33 * & - conjg (mix_su311) * mix_sd311)) - gzwpsu2sd2_3_3 = ( - (gcc * gz * & - (2.0_omega_prec / 3.0_omega_prec) * sin2thw * vckm_33 * & - conjg (mix_su321) * mix_sd321)) - gzwpsu1sd2_3_3 = ( - (gcc * gz * & - (2.0_omega_prec / 3.0_omega_prec) * sin2thw * vckm_33 * & - conjg (mix_su311) * mix_sd321)) - gzwpsu2sd1_3_3 = ( - (gcc * gz * & - (2.0_omega_prec / 3.0_omega_prec) * 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) - gglpsqsq = 2.0_omega_prec * e * gs / 3.0_omega_prec - gglsu1su1_1 = (gz * gs * (((1.0_omega_prec / 2.0_omega_prec) * & - (mix_su111 * conjg (mix_su111))) - (sin2thw * & - (2.0_omega_prec / 3.0_omega_prec)))) - gglsu2su2_1 = (gz * gs * (((1.0_omega_prec / 2.0_omega_prec) * & - (mix_su121 * conjg (mix_su121))) - (sin2thw * & - (2.0_omega_prec / 3.0_omega_prec)))) - gglsu1su2_1 = (gz * gs * (1.0_omega_prec / 2.0_omega_prec) * mix_su111 * & - conjg (mix_su121)) - gglsu2su1_1 = (gz * gs * (1.0_omega_prec / 2.0_omega_prec) * mix_su121 * & - conjg (mix_su111)) - gglsd1sd1_1 = ( - (gz * gs * (((1.0_omega_prec / 2.0_omega_prec) * & - (mix_sd111 * conjg (mix_sd111))) - (sin2thw * & - (1.0_omega_prec / 3.0_omega_prec))))) - gglsd2sd2_1 = ( - (gz * gs * (((1.0_omega_prec / 2.0_omega_prec) * & - (mix_sd121 * conjg (mix_sd121))) - (sin2thw * & - (1.0_omega_prec / 3.0_omega_prec))))) - gglsd1sd2_1 = ( - (gz * gs * & - (1.0_omega_prec / 2.0_omega_prec) * mix_sd111 * conjg (mix_sd121))) - gglsd2sd1_1 = ( - (gz * gs * & - (1.0_omega_prec / 2.0_omega_prec) * mix_sd121 * conjg (mix_sd111))) - gglsu1su1_2 = (gz * gs * (((1.0_omega_prec / 2.0_omega_prec) * & - (mix_su211 * conjg (mix_su211))) - (sin2thw * & - (2.0_omega_prec / 3.0_omega_prec)))) - gglsu2su2_2 = (gz * gs * (((1.0_omega_prec / 2.0_omega_prec) * & - (mix_su221 * conjg (mix_su221))) - (sin2thw * & - (2.0_omega_prec / 3.0_omega_prec)))) - gglsu1su2_2 = (gz * gs * (1.0_omega_prec / 2.0_omega_prec) * mix_su211 * & - conjg (mix_su221)) - gglsu2su1_2 = (gz * gs * (1.0_omega_prec / 2.0_omega_prec) * mix_su221 * & - conjg (mix_su211)) - gglsd1sd1_2 = ( - (gz * gs * (((1.0_omega_prec / 2.0_omega_prec) * & - (mix_sd211 * conjg (mix_sd211))) - (sin2thw * & - (1.0_omega_prec / 3.0_omega_prec))))) - gglsd2sd2_2 = ( - (gz * gs * (((1.0_omega_prec / 2.0_omega_prec) * & - (mix_sd221 * conjg (mix_sd221))) - (sin2thw * & - (1.0_omega_prec / 3.0_omega_prec))))) - gglsd1sd2_2 = ( - (gz * gs * & - (1.0_omega_prec / 2.0_omega_prec) * mix_sd211 * conjg (mix_sd221))) - gglsd2sd1_2 = ( - (gz * gs * & - (1.0_omega_prec / 2.0_omega_prec) * mix_sd221 * conjg (mix_sd211))) - gglsu1su1_3 = (gz * gs * (((1.0_omega_prec / 2.0_omega_prec) * & - (mix_su311 * conjg (mix_su311))) - (sin2thw * & - (2.0_omega_prec / 3.0_omega_prec)))) - gglsu2su2_3 = (gz * gs * (((1.0_omega_prec / 2.0_omega_prec) * & - (mix_su321 * conjg (mix_su321))) - (sin2thw * & - (2.0_omega_prec / 3.0_omega_prec)))) - gglsu1su2_3 = (gz * gs * (1.0_omega_prec / 2.0_omega_prec) * mix_su311 * & - conjg (mix_su321)) - gglsu2su1_3 = (gz * gs * (1.0_omega_prec / 2.0_omega_prec) * mix_su321 * & - conjg (mix_su311)) - gglsd1sd1_3 = ( - (gz * gs * (((1.0_omega_prec / 2.0_omega_prec) * & - (mix_sd311 * conjg (mix_sd311))) - (sin2thw * & - (1.0_omega_prec / 3.0_omega_prec))))) - gglsd2sd2_3 = ( - (gz * gs * (((1.0_omega_prec / 2.0_omega_prec) * & - (mix_sd321 * conjg (mix_sd321))) - (sin2thw * & - (1.0_omega_prec / 3.0_omega_prec))))) - gglsd1sd2_3 = ( - (gz * gs * & - (1.0_omega_prec / 2.0_omega_prec) * mix_sd311 * conjg (mix_sd321))) - gglsd2sd1_3 = ( - (gz * gs * & - (1.0_omega_prec / 2.0_omega_prec) * mix_sd321 * conjg (mix_sd311))) - end subroutine setup_parameters5 - subroutine setup_parameters6 () - gglwsu1sd1_1_1 = (g * gs * sqrt (2.0_omega_prec) * vckm_11 * & - conjg (mix_su111) * mix_sd111) - gglwsu2sd2_1_1 = (g * gs * sqrt (2.0_omega_prec) * vckm_11 * & - conjg (mix_su121) * mix_sd121) - gglwsu1sd2_1_1 = (g * gs * sqrt (2.0_omega_prec) * vckm_11 * & - conjg (mix_su111) * mix_sd121) - gglwsu2sd1_1_1 = (g * gs * sqrt (2.0_omega_prec) * 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_omega_prec) * vckm_12 * & - conjg (mix_su111) * mix_sd211) - gglwsu2sd2_1_2 = (g * gs * sqrt (2.0_omega_prec) * vckm_12 * & - conjg (mix_su121) * mix_sd221) - gglwsu1sd2_1_2 = (g * gs * sqrt (2.0_omega_prec) * vckm_12 * & - conjg (mix_su111) * mix_sd221) - gglwsu2sd1_1_2 = (g * gs * sqrt (2.0_omega_prec) * 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_omega_prec) * vckm_13 * & - conjg (mix_su111) * mix_sd311) - gglwsu2sd2_1_3 = (g * gs * sqrt (2.0_omega_prec) * vckm_13 * & - conjg (mix_su121) * mix_sd321) - gglwsu1sd2_1_3 = (g * gs * sqrt (2.0_omega_prec) * vckm_13 * & - conjg (mix_su111) * mix_sd321) - gglwsu2sd1_1_3 = (g * gs * sqrt (2.0_omega_prec) * 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_omega_prec) * vckm_21 * & - conjg (mix_su211) * mix_sd111) - gglwsu2sd2_2_1 = (g * gs * sqrt (2.0_omega_prec) * vckm_21 * & - conjg (mix_su221) * mix_sd121) - gglwsu1sd2_2_1 = (g * gs * sqrt (2.0_omega_prec) * vckm_21 * & - conjg (mix_su211) * mix_sd121) - gglwsu2sd1_2_1 = (g * gs * sqrt (2.0_omega_prec) * 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_omega_prec) * vckm_22 * & - conjg (mix_su211) * mix_sd211) - gglwsu2sd2_2_2 = (g * gs * sqrt (2.0_omega_prec) * vckm_22 * & - conjg (mix_su221) * mix_sd221) - gglwsu1sd2_2_2 = (g * gs * sqrt (2.0_omega_prec) * vckm_22 * & - conjg (mix_su211) * mix_sd221) - gglwsu2sd1_2_2 = (g * gs * sqrt (2.0_omega_prec) * 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_omega_prec) * vckm_23 * & - conjg (mix_su211) * mix_sd311) - gglwsu2sd2_2_3 = (g * gs * sqrt (2.0_omega_prec) * vckm_23 * & - conjg (mix_su221) * mix_sd321) - gglwsu1sd2_2_3 = (g * gs * sqrt (2.0_omega_prec) * vckm_23 * & - conjg (mix_su211) * mix_sd321) - gglwsu2sd1_2_3 = (g * gs * sqrt (2.0_omega_prec) * 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_omega_prec) * vckm_31 * & - conjg (mix_su311) * mix_sd111) - gglwsu2sd2_3_1 = (g * gs * sqrt (2.0_omega_prec) * vckm_31 * & - conjg (mix_su321) * mix_sd121) - gglwsu1sd2_3_1 = (g * gs * sqrt (2.0_omega_prec) * vckm_31 * & - conjg (mix_su311) * mix_sd121) - gglwsu2sd1_3_1 = (g * gs * sqrt (2.0_omega_prec) * 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_omega_prec) * vckm_32 * & - conjg (mix_su311) * mix_sd211) - gglwsu2sd2_3_2 = (g * gs * sqrt (2.0_omega_prec) * vckm_32 * & - conjg (mix_su321) * mix_sd221) - gglwsu1sd2_3_2 = (g * gs * sqrt (2.0_omega_prec) * vckm_32 * & - conjg (mix_su311) * mix_sd221) - gglwsu2sd1_3_2 = (g * gs * sqrt (2.0_omega_prec) * 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_omega_prec) * vckm_33 * & - conjg (mix_su311) * mix_sd311) - gglwsu2sd2_3_3 = (g * gs * sqrt (2.0_omega_prec) * vckm_33 * & - conjg (mix_su321) * mix_sd321) - gglwsu1sd2_3_3 = (g * gs * sqrt (2.0_omega_prec) * vckm_33 * & - conjg (mix_su311) * mix_sd321) - gglwsu2sd1_3_3 = (g * gs * sqrt (2.0_omega_prec) * 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) - a0_11 = real ((mn_14 * conjg (mn_14)) - (mn_13 * conjg (mn_13))) & - / 2.0_omega_prec - snnh1_11 = 2.0_omega_prec * ( - real ((mn_12 - ( & - (sinthw / costhw) * mn_11)) * ((sinal * mn_13) + (cosal * mn_14)))) - snnh2_11 = 2.0_omega_prec * real ((mn_12 - ((sinthw / costhw) * mn_11)) * & - ((cosal * mn_13) - (sinal * mn_14))) - pnna_11 = 2.0_omega_prec * cmplx (0.0_omega_prec, real ((mn_12 - (mn_11 * (sinthw / costhw))) * ( & - (mn_13 * sinbe) - (mn_14 * cosbe))),kind=omega_prec) - v0_12 = cmplx (0.0_omega_prec, aimag ((mn_14 * conjg (mn_24)) - & - (mn_13 * conjg (mn_23))), kind=omega_prec) / 2.0_omega_prec - a0_12 = real ((mn_14 * conjg (mn_24)) - (mn_13 * conjg (mn_23))) & - / 2.0_omega_prec - 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_omega_prec, 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=omega_prec)) - 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_omega_prec, 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=omega_prec) - 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_omega_prec, 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=omega_prec) - v0_13 = cmplx (0.0_omega_prec, aimag ((mn_14 * conjg (mn_34)) - (mn_13 * & - conjg (mn_33))), kind=omega_prec) / 2.0_omega_prec - a0_13 = real ((mn_14 * conjg (mn_34)) - (mn_13 * conjg (mn_33))) & - / 2.0_omega_prec - 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_omega_prec, 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=omega_prec)) - 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_omega_prec, 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=omega_prec) - 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_omega_prec, 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=omega_prec) - v0_14 = cmplx (0.0_omega_prec, aimag ((mn_14 * conjg (mn_44)) - (mn_13 * & - conjg (mn_43))), kind=omega_prec) / 2.0_omega_prec - a0_14 = real ((mn_14 * conjg (mn_44)) - (mn_13 * conjg (mn_43))) & - / 2.0_omega_prec - 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_omega_prec, 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=omega_prec)) - 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_omega_prec, 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=omega_prec) - 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_omega_prec, 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=omega_prec) - end subroutine setup_parameters6 - subroutine setup_parameters7 () - a0_22 = real ((mn_24 * conjg (mn_24)) - (mn_23 * conjg (mn_23))) & - / 2.0_omega_prec - snnh1_22 = 2.0_omega_prec * ( - real ((mn_22 - ( & - (sinthw / costhw) * mn_21)) * ((sinal * mn_23) + (cosal * mn_24)))) - snnh2_22 = 2.0_omega_prec * real ((mn_22 - ((sinthw / costhw) * mn_21)) & - * ((cosal * mn_23) - (sinal * mn_24))) - pnna_22 = 2.0_omega_prec * cmplx (0.0_omega_prec, real ((mn_22 - (mn_21 * (sinthw / costhw))) * ( & - (mn_23 * sinbe) - (mn_24 * cosbe))),kind=omega_prec) - v0_23 = cmplx (0.0_omega_prec, aimag ((mn_24 * conjg (mn_34)) - (mn_23 * & - conjg (mn_33))), kind=omega_prec) / 2.0_omega_prec - a0_23 = real ((mn_24 * conjg (mn_34)) - (mn_23 * conjg (mn_33))) & - / 2.0_omega_prec - 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_omega_prec, 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=omega_prec)) - 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_omega_prec, 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=omega_prec) - 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_omega_prec, 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=omega_prec) - v0_24 = cmplx (0.0_omega_prec, aimag ((mn_24 * conjg (mn_44)) - (mn_23 * & - conjg (mn_43))), kind=omega_prec) / 2.0_omega_prec - a0_24 = real ((mn_24 * conjg (mn_44)) - (mn_23 * conjg (mn_43))) & - / 2.0_omega_prec - 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_omega_prec, 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=omega_prec)) - 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_omega_prec, 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=omega_prec) - 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_omega_prec, 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=omega_prec) - a0_33 = real ((mn_34 * conjg (mn_34)) - (mn_33 * conjg (mn_33))) & - / 2.0_omega_prec - snnh1_33 = 2.0_omega_prec * ( - real ((mn_32 - ( & - (sinthw / costhw) * mn_31)) * ((sinal * mn_33) + (cosal * mn_34)))) - snnh2_33 = 2.0_omega_prec * real ((mn_32 - ((sinthw / costhw) * mn_31)) & - * ((cosal * mn_33) - (sinal * mn_34))) - pnna_33 = 2.0_omega_prec * cmplx (0.0_omega_prec, real ((mn_32 - (mn_31 * (sinthw / costhw))) * ( & - (mn_33 * sinbe) - (mn_34 * cosbe))),kind=omega_prec) - v0_34 = cmplx (0.0_omega_prec, aimag ((mn_34 * conjg (mn_44)) - (mn_33 * & - conjg (mn_43))), kind=omega_prec) / 2.0_omega_prec - a0_34 = real ((mn_34 * conjg (mn_44)) - (mn_33 * conjg (mn_43))) & - / 2.0_omega_prec - 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_omega_prec, 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=omega_prec)) - 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_omega_prec, 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=omega_prec) - 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_omega_prec, 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=omega_prec) - a0_44 = real ((mn_44 * conjg (mn_44)) - (mn_43 * conjg (mn_43))) & - / 2.0_omega_prec - snnh1_44 = 2.0_omega_prec * ( - real ((mn_42 - ( & - (sinthw / costhw) * mn_41)) * ((sinal * mn_43) + (cosal * mn_44)))) - snnh2_44 = 2.0_omega_prec * real ((mn_42 - ((sinthw / costhw) * mn_41)) & - * ((cosal * mn_43) - (sinal * mn_44))) - pnna_44 = 2.0_omega_prec * cmplx (0.0_omega_prec, real ((mn_42 - (mn_41 * (sinthw / costhw))) * ( & - (mn_43 * sinbe) - (mn_44 * cosbe))),kind=omega_prec) - vp_11 = ((((1.0_omega_prec - & - (2.0_omega_prec * sin2thw)) / 4.0_omega_prec) * ((mv_12 * conjg (mv_12)) & - + (conjg (mu_12) * mu_12))) + (((costhw**2) / 2.0_omega_prec) * ( & - (mv_11 * conjg (mv_11)) + (conjg (mu_11) * mu_11)))) - ap_11 = ((((1.0_omega_prec - & - (2.0_omega_prec * sin2thw)) / 4.0_omega_prec) * ((mv_12 * & - conjg (mv_12)) - (conjg (mu_12) * mu_12))) + (( & - (costhw**2) / 2.0_omega_prec) * ((mv_11 * conjg (mv_11)) - ( & - conjg (mu_11) * mu_11)))) - end subroutine setup_parameters7 - subroutine setup_parameters8 () - vp_12 = ((((1.0_omega_prec - & - (2.0_omega_prec * sin2thw)) / 4.0_omega_prec) * ((mv_12 * conjg (mv_22)) & - + (conjg (mu_12) * mu_22))) + (((costhw**2) / 2.0_omega_prec) * ( & - (mv_11 * conjg (mv_21)) + (conjg (mu_11) * mu_21)))) - ap_12 = ((((1.0_omega_prec - & - (2.0_omega_prec * sin2thw)) / 4.0_omega_prec) * ((mv_12 * & - conjg (mv_22)) - (conjg (mu_12) * mu_22))) + (( & - (costhw**2) / 2.0_omega_prec) * ((mv_11 * conjg (mv_21)) - ( & - conjg (mu_11) * mu_21)))) - vp_21 = conjg (vp_12) - ap_21 = conjg (ap_12) - vp_22 = ((((1.0_omega_prec - & - (2.0_omega_prec * sin2thw)) / 4.0_omega_prec) * ((mv_22 * conjg (mv_22)) & - + (conjg (mu_22) * mu_22))) + (((costhw**2) / 2.0_omega_prec) * ( & - (mv_21 * conjg (mv_21)) + (conjg (mu_21) * mu_21)))) - ap_22 = ((((1.0_omega_prec - & - (2.0_omega_prec * sin2thw)) / 4.0_omega_prec) * ((mv_22 * & - conjg (mv_22)) - (conjg (mu_22) * mu_22))) + (( & - (costhw**2) / 2.0_omega_prec) * ((mv_21 * conjg (mv_21)) - ( & - conjg (mu_21) * mu_21)))) - lcn_11 = ((conjg (mn_12) * mv_11 * sqrt (2.0_omega_prec)) - ( & - conjg (mn_14) * mv_12)) - rcn_11 = ((mn_12 * conjg (mu_11) * sqrt (2.0_omega_prec)) + (mn_13 * & - conjg (mu_12))) - lnch_11 = (cosbe * ((conjg (mn_14) * conjg (mv_11)) + ((conjg (mv_12) / & - sqrt (2.0_omega_prec)) * (conjg (mn_12) + ((sinthw / costhw) * & - conjg (mn_11)))))) - rnch_11 = (sinbe * ((mn_13 * mu_11) - ((mu_12 / sqrt (2.0_omega_prec)) * & - (mn_12 + ((sinthw / costhw) * mn_11))))) - lcn_12 = ((conjg (mn_22) * mv_11 * sqrt (2.0_omega_prec)) - ( & - conjg (mn_24) * mv_12)) - rcn_12 = ((mn_22 * conjg (mu_11) * sqrt (2.0_omega_prec)) + (mn_23 * & - conjg (mu_12))) - lnch_21 = (cosbe * ((conjg (mn_24) * conjg (mv_11)) + ((conjg (mv_12) / & - sqrt (2.0_omega_prec)) * (conjg (mn_22) + ((sinthw / costhw) * & - conjg (mn_21)))))) - rnch_21 = (sinbe * ((mn_23 * mu_11) - ((mu_12 / sqrt (2.0_omega_prec)) * & - (mn_22 + ((sinthw / costhw) * mn_21))))) - lcn_13 = ((conjg (mn_32) * mv_11 * sqrt (2.0_omega_prec)) - ( & - conjg (mn_34) * mv_12)) - rcn_13 = ((mn_32 * conjg (mu_11) * sqrt (2.0_omega_prec)) + (mn_33 * & - conjg (mu_12))) - lnch_31 = (cosbe * ((conjg (mn_34) * conjg (mv_11)) + ((conjg (mv_12) / & - sqrt (2.0_omega_prec)) * (conjg (mn_32) + ((sinthw / costhw) * & - conjg (mn_31)))))) - rnch_31 = (sinbe * ((mn_33 * mu_11) - ((mu_12 / sqrt (2.0_omega_prec)) * & - (mn_32 + ((sinthw / costhw) * mn_31))))) - lcn_14 = ((conjg (mn_42) * mv_11 * sqrt (2.0_omega_prec)) - ( & - conjg (mn_44) * mv_12)) - rcn_14 = ((mn_42 * conjg (mu_11) * sqrt (2.0_omega_prec)) + (mn_43 * & - conjg (mu_12))) - lnch_41 = (cosbe * ((conjg (mn_44) * conjg (mv_11)) + ((conjg (mv_12) / & - sqrt (2.0_omega_prec)) * (conjg (mn_42) + ((sinthw / costhw) * & - conjg (mn_41)))))) - rnch_41 = (sinbe * ((mn_43 * mu_11) - ((mu_12 / sqrt (2.0_omega_prec)) * & - (mn_42 + ((sinthw / costhw) * mn_41))))) - lcn_21 = ((conjg (mn_12) * mv_21 * sqrt (2.0_omega_prec)) - ( & - conjg (mn_14) * mv_22)) - rcn_21 = ((mn_12 * conjg (mu_21) * sqrt (2.0_omega_prec)) + (mn_13 * & - conjg (mu_22))) - lnch_12 = (cosbe * ((conjg (mn_14) * conjg (mv_21)) + ((conjg (mv_22) / & - sqrt (2.0_omega_prec)) * (conjg (mn_12) + ((sinthw / costhw) * & - conjg (mn_11)))))) - rnch_12 = (sinbe * ((mn_13 * mu_21) - ((mu_22 / sqrt (2.0_omega_prec)) * & - (mn_12 + ((sinthw / costhw) * mn_11))))) - lcn_22 = ((conjg (mn_22) * mv_21 * sqrt (2.0_omega_prec)) - ( & - conjg (mn_24) * mv_22)) - rcn_22 = ((mn_22 * conjg (mu_21) * sqrt (2.0_omega_prec)) + (mn_23 * & - conjg (mu_22))) - lnch_22 = (cosbe * ((conjg (mn_24) * conjg (mv_21)) + ((conjg (mv_22) / & - sqrt (2.0_omega_prec)) * (conjg (mn_22) + ((sinthw / costhw) * & - conjg (mn_21)))))) - rnch_22 = (sinbe * ((mn_23 * mu_21) - ((mu_22 / sqrt (2.0_omega_prec)) * & - (mn_22 + ((sinthw / costhw) * mn_21))))) - lcn_23 = ((conjg (mn_32) * mv_21 * sqrt (2.0_omega_prec)) - ( & - conjg (mn_34) * mv_22)) - rcn_23 = ((mn_32 * conjg (mu_21) * sqrt (2.0_omega_prec)) + (mn_33 * & - conjg (mu_22))) - lnch_32 = (cosbe * ((conjg (mn_34) * conjg (mv_21)) + ((conjg (mv_22) / & - sqrt (2.0_omega_prec)) * (conjg (mn_32) + ((sinthw / costhw) * & - conjg (mn_31)))))) - rnch_32 = (sinbe * ((mn_33 * mu_21) - ((mu_22 / sqrt (2.0_omega_prec)) * & - (mn_32 + ((sinthw / costhw) * mn_31))))) - lcn_24 = ((conjg (mn_42) * mv_21 * sqrt (2.0_omega_prec)) - ( & - conjg (mn_44) * mv_22)) - rcn_24 = ((mn_42 * conjg (mu_21) * sqrt (2.0_omega_prec)) + (mn_43 * & - conjg (mu_22))) - lnch_42 = (cosbe * ((conjg (mn_44) * conjg (mv_21)) + ((conjg (mv_22) / & - sqrt (2.0_omega_prec)) * (conjg (mn_42) + ((sinthw / costhw) * & - conjg (mn_41)))))) - rnch_42 = (sinbe * ((mn_43 * mu_21) - ((mu_22 / sqrt (2.0_omega_prec)) * & - (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) - end subroutine setup_parameters8 - subroutine setup_parameters9 () - lnc_42 = conjg (lcn_24) - rnc_42 = conjg (rcn_24) - gnzn_1_1 = (gz * a0_11) - gnzn_2_2 = (gz * a0_22) - gnzn_3_3 = (gz * a0_33) - gnzn_4_4 = (gz * a0_44) - dummy1 = ( - gs) - !!! JR check 01.04.2005 - g_h1111susu = (gz * mass(23) * ((1.0_omega_prec / 2.0_omega_prec) - & - (sin2thw * q_up)) * sinapb) - g_h1122susu = (gz * mass(23) * q_up * sinapb * sin2thw) - g_h1111sdsd = (gz * mass(23) * (( - (1.0_omega_prec / 2.0_omega_prec)) - & - (sin2thw * q_down)) * sinapb) - g_h1122sdsd = (gz * mass(23) * q_down * sinapb * sin2thw) - g_h2111susu = ( - (gz * mass(23) * ((1.0_omega_prec / 2.0_omega_prec) - & - (sin2thw * q_up)) * cosapb)) - g_h2122susu = ( - gz * mass(23) * q_up * cosapb * sin2thw) - g_h2111sdsd = ( - (gz * mass(23) * (( - (1.0_omega_prec / 2.0_omega_prec)) - & - (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_omega_prec * mass(24) * sinbe))) - !!! g_h3121susu = conjg (g_h3112susu) - !!! g_h3112sdsd = - (imago * ((g * mass(1) * (( & - !!! conjg (ad_1) * tanb) + mu)) / (2.0_omega_prec * mass(24)))) - !!! g_h3121sdsd = conjg (g_h3112sdsd) - g_h1111snsn = (gz * mass(23) * (1.0_omega_prec / 2.0_omega_prec) * sinapb) - g_h1111slsl = (gz * mass(23) * (( - (1.0_omega_prec / 2.0_omega_prec)) - & - (sin2thw * ( - 1.0_omega_prec))) * sinapb) - g_h1122slsl = (gz * mass(23) * ( - 1.0_omega_prec) * sinapb * sin2thw) - g_h2111snsn = ( - (gz * mass(23) * (1.0_omega_prec / 2.0_omega_prec)) * cosapb) - g_h2111slsl = ( - (gz * mass(23) * (( - (1.0_omega_prec / 2.0_omega_prec)) - & - (sin2thw * ( - 1.0_omega_prec))) * cosapb)) - g_h2122slsl = ( - (gz * mass(23) * ( - 1.0_omega_prec) * cosapb * sin2thw)) - !!! g_h3112slsl = - (imago * ((g * mass(11) * (( & - !!! conjg (al_1) * tanb) + mu)) / (2.0_omega_prec * mass(24)))) - !!! g_h3121slsl = conjg (g_h3112slsl) - g_h4111slsn = ((g / (sqrt (2.0_omega_prec) * mass(24))) * (mass(24)**2) * sin2be) - !!! g_h4112slsn = (sqrt (2.0_omega_prec) * ((g * mass(11) * ((conjg ( & - !!! al_1) * sinbe) + (mu * cosbe))) / & - !!! (2.0_omega_prec * 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_omega_prec / 2.0_omega_prec) - & - !!! (sin2thw * q_up)) * sinapb) - !!! g_h1222susu = (gz * mass(23) * q_up * sinapb * sin2thw) - !!! g_h1211sdsd = (gz * mass(23) * (( - (1.0_omega_prec / 2.0_omega_prec)) - & - !!! (sin2thw * q_down)) * sinapb) - !!! g_h1222sdsd = (gz * mass(23) * q_down * sinapb * sin2thw) - !!! g_h2211susu = ( - (gz * mass(23) * ((1.0_omega_prec / 2.0_omega_prec) - & - !!! (sin2thw * q_up)) * cosapb)) - !!! g_h2222susu = ( - gz * mass(23) * q_up * cosapb * sin2thw) - !!! g_h2211sdsd = ( - (gz * mass(23) * (( - (1.0_omega_prec / 2.0_omega_prec)) - & - !!! (sin2thw * q_down)) * cosapb)) - !!! g_h2222sdsd = ( - gz * mass(23) * q_down * cosapb * sin2thw) - !!! g_h3212susu = - (imago * ((g * mass(4) * (( & - !!! conjg (au_2) * cosbe) + (mu * sinbe)) / & - !!! (2.0_omega_prec * mass(24) * sinbe))) - !!! g_h3221susu = conjg (g_h3212susu) - !!! g_h3212sdsd = - (imago * ((g * mass(3) * (( & - !!! conjg (ad_2) * sinbe) + (mu * cosbe))) / & - !!! (2.0_omega_prec * 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_omega_prec / 2.0_omega_prec))) - !!! g_h1211slsl = (gz * mass(23) * (( - (1.0_omega_prec / 2.0_omega_prec)) - & - !!! (sin2thw * ( - 1.0_omega_prec))) * sinapb) - !!! g_h1222slsl = (gz * mass(23) * ( - 1.0_omega_prec) * sinapb * sin2thw) - !!! g_h2211snsn = ( - (gz * mass(23) * ((1.0_omega_prec / 2.0_omega_prec)))) - !!! g_h2211slsl = ( - (gz * mass(23) * (( - (1.0_omega_prec / 2.0_omega_prec)) - & - !!! (sin2thw * ( - 1.0_omega_prec))) * cosapb)) - !!! g_h2222slsl = ( - (gz * mass(23) * ( - 1.0_omega_prec) * cosapb * sin2thw)) - !!! g_h3212slsl = - (imago * ((g * mass(13) * (( & - !!! conjg (al_2) * sinbe) + (mu * cosbe))) / & - !!! (2.0_omega_prec * mass(24) * cosbe))) - !!! g_h3221slsl = conjg (g_h3212slsl) - g_h4211slsn = ((g / (sqrt (2.0_omega_prec) * mass(24))) * (mass(24)**2) * sin2be) - !!! g_h4212slsn = (sqrt (2.0_omega_prec) * ((g * mass(13) * ((conjg ( & - !!! al_2) * sinbe) + (mu * cosbe))) / & - !!! (2.0_omega_prec * mass(24) * cosbe))) - g_h1311susu = ((gz * mass(23) * ((1.0_omega_prec / 2.0_omega_prec) - & - (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_omega_prec * mass(24) * sinbe)) - g_h1321susu = conjg (g_h1312susu) - g_h1311sdsd = ((gz * mass(23) * (( - (1.0_omega_prec / 2.0_omega_prec)) - & - (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_omega_prec * mass(24) * cosbe)) - g_h1321sdsd = conjg (g_h1312sdsd) - g_h2311susu = ( - ((gz * mass(23) * ((1.0_omega_prec / 2.0_omega_prec) - & - (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_omega_prec * mass(24) * sinbe)) - g_h2321susu = conjg (g_h2312susu) - g_h2311sdsd = ( - ((gz * mass(23) * (( - (1.0_omega_prec / 2.0_omega_prec)) - & - (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_omega_prec * mass(24) * cosbe)) - g_h2321sdsd = conjg (g_h2312sdsd) - g_h3312susu = - (imago * ((g * mass(6) * (( & - conjg (au_3) * cosbe) + (mu * sinbe))) / & - (2.0_omega_prec * mass(24) * sinbe))) - g_h3321susu = conjg (g_h3312susu) - g_h3312sdsd = - (imago * ((g * mass(5) * (( & - conjg (ad_3) * sinbe) + (mu * cosbe))) / & - (2.0_omega_prec * mass(24) * cosbe))) - g_h3321sdsd = conjg (g_h3312sdsd) - g_h1311snsn = (gz * mass(23) * (1.0_omega_prec / 2.0_omega_prec) * sinapb) - g_h1311slsl = ((gz * mass(23) * (( - (1.0_omega_prec / 2.0_omega_prec)) - & - (sin2thw * ( - 1.0_omega_prec))) * sinapb) + ((g * & - (mass(15)**2) * sinal) / (mass(24) * cosbe))) - g_h1322slsl = ((gz * mass(23) * ( - 1.0_omega_prec) * sinapb * sin2thw) + ( & - (g * (mass(15)**2) * sinal) / (mass(24) * cosbe))) - g_h1312slsl = ((g * mass(15) * ((conjg (al_3) * sinal) + ( & - mu * cosal))) / (2.0_omega_prec * mass(24) * cosbe)) - g_h1321slsl = conjg (g_h1312slsl) - g_h2311snsn = ( - (gz * mass(23) * (1.0_omega_prec / 2.0_omega_prec) * cosapb)) - g_h2311slsl = ( - ((gz * mass(23) * (( - (1.0_omega_prec / 2.0_omega_prec)) - & - (sin2thw * ( - 1.0_omega_prec))) * cosapb) + ((g * & - (mass(15)**2) * cosal) / (mass(24) * cosbe)))) - g_h2322slsl = ( - ((gz * mass(23) * ( - 1.0_omega_prec) * cosapb * sin2thw) + ( & - (g * (mass(15)**2) * cosal) / (mass(24) * cosbe)))) - g_h2312slsl = ((g * mass(15) * ((conjg (- al_3) * cosal) + ( & - mu * sinal))) / (2.0_omega_prec * mass(24) * cosbe)) - g_h2321slsl = conjg (g_h2312slsl) - g_h3312slsl = - (imago * ((g * mass(15) * (( & - conjg (al_3) * sinbe) + (mu * cosbe))) / & - (2.0_omega_prec * mass(24) * cosbe))) - g_h3321slsl = conjg (g_h3312slsl) - g_h4311slsn = ((g / (sqrt (2.0_omega_prec) * mass(24))) * (( & - (mass(15)**2) * tanb) - ((mass(24)**2) * sin2be))) - g_h4312slsn = (sqrt (2.0_omega_prec) * ((g * mass(15) * ((conjg ( & - al_3) * sinbe) + (mu * cosbe))) / & - (2.0_omega_prec * mass(24) * cosbe))) - g_h41_111susd = ((g / (sqrt (2.0_omega_prec) * mass(24))) * vckm_11 * ( - ( & - (mass(24)**2) * sin2be))) - g_h41_211susd = ((g / (sqrt (2.0_omega_prec) * mass(24))) * vckm_12 * ( - ( & - (mass(24)**2) * sin2be))) - g_h41_311susd = ((g / (sqrt (2.0_omega_prec) * mass(24))) * vckm_13 * (( - ( & - (mass(24)**2) * sin2be)) + (((mass(5)**2) * tanb) + ((mass(2)**2) / tanb)))) - end subroutine setup_parameters9 - subroutine setup_parameters10 () - g_h41_322susd = ((sqrt (2.0_omega_prec) * g * mass(2) * mass(5) * vckm_13) / & - (mass(24) * sin2be)) - g_h41_312susd = (((g * mass(5)) / ( & - sqrt (2.0_omega_prec) * mass(24))) * vckm_13 * (mu + ( & - conjg (ad_3) * tanb))) - g_h41_321susd = (((g * mass(2)) / ( & - sqrt (2.0_omega_prec) * mass(24))) * vckm_13 * (conjg (mu) + & - (au_1 / tanb))) - g_h42_111susd = ((g / (sqrt (2.0_omega_prec) * mass(24))) * vckm_21 * ( - ( & - (mass(24)**2) * sin2be))) - g_h42_211susd = ((g / (sqrt (2.0_omega_prec) * mass(24))) * vckm_22 * ( - ( & - (mass(24)**2) * sin2be))) - g_h42_311susd = ((g / (sqrt (2.0_omega_prec) * mass(24))) * vckm_23 * (( - ( & - (mass(24)**2) * sin2be)) + (((mass(5)**2) * tanb) + ((mass(4)**2) / tanb)))) - g_h42_322susd = ((sqrt (2.0_omega_prec) * g * mass(4) * mass(5) * vckm_23) / & - (mass(24) * sin2be)) - g_h42_312susd = (((g * mass(5)) / ( & - sqrt (2.0_omega_prec) * mass(24))) * vckm_23 * (mu + ( & - conjg (ad_3) * tanb))) - g_h42_321susd = (((g * mass(4)) / ( & - sqrt (2.0_omega_prec) * mass(24))) * vckm_23 * (conjg (mu) + & - (au_2 / tanb))) - g_h43_111susd = ((g / (sqrt (2.0_omega_prec) * mass(24))) * vckm_31 * (( - ( & - (mass(24)**2) * sin2be)) + (((mass(1)**2) * tanb) + ((mass(6)**2) / tanb)))) - g_h43_122susd = ((sqrt (2.0_omega_prec) * g * mass(6) * mass(1) * vckm_31) / & - (mass(24) * sin2be)) - g_h43_112susd = (((g * mass(1)) / ( & - sqrt (2.0_omega_prec) * mass(24))) * vckm_31 * (mu + ( & - conjg (ad_1) * tanb))) - g_h43_121susd = (((g * mass(6)) / ( & - sqrt (2.0_omega_prec) * mass(24))) * vckm_31 * (conjg (mu) + & - (au_3 / tanb))) - g_h43_211susd = ((g / (sqrt (2.0_omega_prec) * mass(24))) * vckm_32 * (( - ( & - (mass(24)**2) * sin2be)) + (((mass(3)**2) * tanb) + ((mass(6)**2) / tanb)))) - g_h43_222susd = ((sqrt (2.0_omega_prec) * g * mass(6) * mass(3) * vckm_32) / & - (mass(24) * sin2be)) - g_h43_212susd = (((g * mass(3)) / ( & - sqrt (2.0_omega_prec) * mass(24))) * vckm_32 * (mu + ( & - conjg (ad_2) * tanb))) - g_h43_221susd = (((g * mass(6)) / ( & - sqrt (2.0_omega_prec) * mass(24))) * vckm_32 * (conjg (mu) + & - (au_3 / tanb))) - g_h43_311susd = ((g / (sqrt (2.0_omega_prec) * mass(24))) * vckm_33 * (( - ( & - (mass(24)**2) * sin2be)) + (((mass(5)**2) * tanb) + ((mass(6)**2) / tanb)))) - g_h43_322susd = ((sqrt (2.0_omega_prec) * g * mass(6) * mass(5) * vckm_33) / & - (mass(24) * sin2be)) - g_h43_312susd = (((g * mass(5)) / ( & - sqrt (2.0_omega_prec) * mass(24))) * vckm_33 * (mu + ( & - conjg (ad_3) * tanb))) - g_h43_321susd = (((g * mass(6)) / ( & - sqrt (2.0_omega_prec) * 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) - !!! ghsnsl2_1 = g_h4111slsn - !!! ghsnsl2_1_c = conjg (ghsnsl2_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)) - end subroutine setup_parameters11 - subroutine setup_parameters12 () - !!! 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)) - 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) - end subroutine setup_parameters12 - subroutine setup_parameters13 () - 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_omega_prec) * mu_11) - g_yuk_ch1_sl1_1 = conjg (g_yuk_ch1_sl1_1_c) - g_yuk_ch1_sl1_2_c = ((( - g) / 2.0_omega_prec) * mu_11) - g_yuk_ch1_sl1_2 = conjg (g_yuk_ch1_sl1_2_c) - g_yuk_ch1_sl1_3_c = ((((( - g) / 2.0_omega_prec) * 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_omega_prec) * 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_omega_prec) * mv_11)) - g_yuk_ch1_sn1_1 = conjg (g_yuk_ch1_sn1_1_c) - g_yuk_ch1_sn1_2_c = ( - ((g / 2.0_omega_prec) * mv_11)) - g_yuk_ch1_sn1_2 = conjg (g_yuk_ch1_sn1_2_c) - g_yuk_ch2_sl1_1_c = ((( - g) / 2.0_omega_prec) * mu_21) - g_yuk_ch2_sl1_1 = conjg (g_yuk_ch2_sl1_1_c) - g_yuk_ch2_sl1_2_c = ((( - g) / 2.0_omega_prec) * mu_21) - g_yuk_ch2_sl1_2 = conjg (g_yuk_ch2_sl1_2_c) - g_yuk_ch2_sl1_3_c = ((((( - g) / 2.0_omega_prec) * 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_omega_prec) * 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_omega_prec) * mv_21)) - g_yuk_ch2_sn1_1 = conjg (g_yuk_ch2_sn1_1_c) - g_yuk_ch2_sn1_2_c = ( - ((g / 2.0_omega_prec) * mv_21)) - g_yuk_ch2_sn1_2 = conjg (g_yuk_ch2_sn1_2_c) - g_yuk_ch1_sd1_1_1 = ( - ((g / 2.0_omega_prec) * 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_omega_prec) * 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_omega_prec) * 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_omega_prec) * 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_omega_prec) * 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_omega_prec) * 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_omega_prec) * 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_omega_prec) * 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_omega_prec) * 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_omega_prec) * 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_omega_prec) * 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_omega_prec) * 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_omega_prec) * 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_omega_prec) * 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_omega_prec) * 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_omega_prec) * 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) - end subroutine setup_parameters13 - subroutine setup_parameters14 () - 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_omega_prec * 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_omega_prec * costhw)))) - g_yuk_n1_su1_1_c = conjg (g_yuk_n1_su1_1) - g_yuk_n1_su2_1 = ((gcc * 2.0_omega_prec * 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_omega_prec)))) - g_yuk_n1_sd1_1_c = conjg (g_yuk_n1_sd1_1) - g_yuk_n1_sd2_1 = ((gcc * 2.0_omega_prec * 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_omega_prec * 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_omega_prec * costhw)))) - g_yuk_n2_su1_1_c = conjg (g_yuk_n2_su1_1) - g_yuk_n2_su2_1 = ((gcc * 2.0_omega_prec * 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_omega_prec)))) - g_yuk_n2_sd1_1_c = conjg (g_yuk_n2_sd1_1) - g_yuk_n2_sd2_1 = ((gcc * 2.0_omega_prec * 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_omega_prec * 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_omega_prec * costhw)))) - g_yuk_n3_su1_1_c = conjg (g_yuk_n3_su1_1) - g_yuk_n3_su2_1 = ((gcc * 2.0_omega_prec * 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_omega_prec)))) - g_yuk_n3_sd1_1_c = conjg (g_yuk_n3_sd1_1) - g_yuk_n3_sd2_1 = ((gcc * 2.0_omega_prec * 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_omega_prec * 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_omega_prec * costhw)))) - g_yuk_n4_su1_1_c = conjg (g_yuk_n4_su1_1) - g_yuk_n4_su2_1 = ((gcc * 2.0_omega_prec * 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_omega_prec)))) - g_yuk_n4_sd1_1_c = conjg (g_yuk_n4_sd1_1) - g_yuk_n4_sd2_1 = ((gcc * 2.0_omega_prec * 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_omega_prec * 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_omega_prec * costhw)))) - g_yuk_n1_su1_2_c = conjg (g_yuk_n1_su1_2) - g_yuk_n1_su2_2 = ((gcc * 2.0_omega_prec * 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_omega_prec)))) - g_yuk_n1_sd1_2_c = conjg (g_yuk_n1_sd1_2) - g_yuk_n1_sd2_2 = ((gcc * 2.0_omega_prec * 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_omega_prec * 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_omega_prec * costhw)))) - g_yuk_n2_su1_2_c = conjg (g_yuk_n2_su1_2) - g_yuk_n2_su2_2 = ((gcc * 2.0_omega_prec * 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_omega_prec)))) - g_yuk_n2_sd1_2_c = conjg (g_yuk_n2_sd1_2) - g_yuk_n2_sd2_2 = ((gcc * 2.0_omega_prec * 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_omega_prec * 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_omega_prec * costhw)))) - g_yuk_n3_su1_2_c = conjg (g_yuk_n3_su1_2) - g_yuk_n3_su2_2 = ((gcc * 2.0_omega_prec * 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_omega_prec)))) - g_yuk_n3_sd1_2_c = conjg (g_yuk_n3_sd1_2) - g_yuk_n3_sd2_2 = ((gcc * 2.0_omega_prec * 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_omega_prec * 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_omega_prec * costhw)))) - g_yuk_n4_su1_2_c = conjg (g_yuk_n4_su1_2) - g_yuk_n4_su2_2 = ((gcc * 2.0_omega_prec * 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_omega_prec)))) - g_yuk_n4_sd1_2_c = conjg (g_yuk_n4_sd1_2) - g_yuk_n4_sd2_2 = ((gcc * 2.0_omega_prec * q_down * sinthw * & - conjg (mn_41)) / costhw) - g_yuk_n4_sd2_2_c = conjg (g_yuk_n4_sd2_2) - gncneu(1) = ((gz / 2.0_omega_prec) * ( & - (2.0_omega_prec * 0.0_omega_prec * sin2thw) - & - (1.0_omega_prec / 2.0_omega_prec))) - gncneu(2) = ((( - gz) / 2.0_omega_prec) * & - (1.0_omega_prec / 2.0_omega_prec)) - gnclep(1) = ((gz / 2.0_omega_prec) * ( & - (2.0_omega_prec * (-1.0_omega_prec) * sin2thw) - ( - & - (1.0_omega_prec / 2.0_omega_prec)))) - gnclep(2) = ((( - gz) / 2.0_omega_prec) * ( - & - (1.0_omega_prec / 2.0_omega_prec))) - gncup(1) = ((gz / 2.0_omega_prec) * ((2.0_omega_prec * & - (2.0_omega_prec / 3.0_omega_prec) * sin2thw) - & - (1.0_omega_prec / 2.0_omega_prec))) - gncup(2) = ((( - gz) / 2.0_omega_prec) * (1.0_omega_prec / 2.0_omega_prec)) - gncdwn(1) = ((gz / 2.0_omega_prec) * ((2.0_omega_prec * & - ((-1.0_omega_prec) / 3.0_omega_prec) * sin2thw) - ( - & - (1.0_omega_prec / 2.0_omega_prec)))) - gncdwn(2) = ((( - gz) / 2.0_omega_prec) * ( - & - (1.0_omega_prec / 2.0_omega_prec))) - 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 * v0_12) - gnzn_1_2(2) = (gz * a0_12) - gnzn_1_3(1) = (gz * v0_13) - gnzn_1_3(2) = (gz * a0_13) - gnzn_1_4(1) = (gz * v0_14) - gnzn_1_4(2) = (gz * a0_14) - gnzn_2_3(1) = (gz * v0_23) - gnzn_2_3(2) = (gz * a0_23) - gnzn_2_4(1) = (gz * v0_24) - gnzn_2_4(2) = (gz * a0_24) - gnzn_3_4(1) = (gz * v0_34) - gnzn_3_4(2) = (gz * a0_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_omega_prec) * lnch_11) - g_nhc_1_1(2) = ((g / 2.0_omega_prec) * rnch_11) - gnwc_1_2(1) = (gcc * lnc_12) - gnwc_1_2(2) = (gcc * rnc_12) - g_nhc_1_2(1) = ((g / 2.0_omega_prec) * lnch_12) - g_nhc_1_2(2) = ((g / 2.0_omega_prec) * rnch_12) - gnwc_2_1(1) = (gcc * lnc_21) - gnwc_2_1(2) = (gcc * rnc_21) - g_nhc_2_1(1) = ((g / 2.0_omega_prec) * lnch_21) - g_nhc_2_1(2) = ((g / 2.0_omega_prec) * rnch_21) - gnwc_2_2(1) = (gcc * lnc_22) - gnwc_2_2(2) = (gcc * rnc_22) - g_nhc_2_2(1) = ((g / 2.0_omega_prec) * lnch_22) - g_nhc_2_2(2) = ((g / 2.0_omega_prec) * rnch_22) - gnwc_3_1(1) = (gcc * lnc_31) - gnwc_3_1(2) = (gcc * rnc_31) - g_nhc_3_1(1) = ((g / 2.0_omega_prec) * lnch_31) - g_nhc_3_1(2) = ((g / 2.0_omega_prec) * rnch_31) - gnwc_3_2(1) = (gcc * lnc_32) - gnwc_3_2(2) = (gcc * rnc_32) - g_nhc_3_2(1) = ((g / 2.0_omega_prec) * lnch_32) - g_nhc_3_2(2) = ((g / 2.0_omega_prec) * rnch_32) - gnwc_4_1(1) = (gcc * lnc_41) - gnwc_4_1(2) = (gcc * rnc_41) - g_nhc_4_1(1) = ((g / 2.0_omega_prec) * lnch_41) - g_nhc_4_1(2) = ((g / 2.0_omega_prec) * rnch_41) - gnwc_4_2(1) = (gcc * lnc_42) - gnwc_4_2(2) = (gcc * rnc_42) - g_nhc_4_2(1) = ((g / 2.0_omega_prec) * lnch_42) - g_nhc_4_2(2) = ((g / 2.0_omega_prec) * rnch_42) - gcwn_1_1(1) = (gcc * lcn_11) - gcwn_1_1(2) = (gcc * rcn_11) - g_chn_1_1(1) = ((g / 2.0_omega_prec) * conjg (rnch_11)) - g_chn_1_1(2) = ((g / 2.0_omega_prec) * 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_omega_prec) * conjg (rnch_21)) - g_chn_2_1(2) = ((g / 2.0_omega_prec) * 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_omega_prec) * conjg (rnch_31)) - g_chn_3_1(2) = ((g / 2.0_omega_prec) * 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_omega_prec) * conjg (rnch_41)) - g_chn_4_1(2) = ((g / 2.0_omega_prec) * 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_omega_prec) * conjg (rnch_12)) - g_chn_1_2(2) = ((g / 2.0_omega_prec) * 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_omega_prec) * conjg (rnch_22)) - g_chn_2_2(2) = ((g / 2.0_omega_prec) * 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_omega_prec) * conjg (rnch_32)) - g_chn_3_2(2) = ((g / 2.0_omega_prec) * 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_omega_prec) * conjg (rnch_42)) - g_chn_4_2(2) = ((g / 2.0_omega_prec) * conjg (lnch_42)) - gcicih1_1_1 = ((( - g) / 2.0_omega_prec) * snnh1_11) - gcicih2_1_1 = ((( - g) / 2.0_omega_prec) * snnh2_11) - gcicia_1_1 = ((( - g) / 2.0_omega_prec) * pnna_11) - gcicih1_1_2(1) = ((( - g) / 2.0_omega_prec) * snnh1_12) - gcicih1_1_2(2) = ((( - g) / 2.0_omega_prec) * pnnh1_12) - gcicih2_1_2(1) = ((( - g) / 2.0_omega_prec) * snnh2_12) - gcicih2_1_2(2) = ((( - g) / 2.0_omega_prec) * pnnh2_12) - gcicia_1_2(1) = ((( - g) / 2.0_omega_prec) * snna_12) - gcicia_1_2(2) = ((( - g) / 2.0_omega_prec) * pnna_12) - gcicih1_1_3(1) = ((( - g) / 2.0_omega_prec) * snnh1_13) - gcicih1_1_3(2) = ((( - g) / 2.0_omega_prec) * pnnh1_13) - gcicih2_1_3(1) = ((( - g) / 2.0_omega_prec) * snnh2_13) - gcicih2_1_3(2) = ((( - g) / 2.0_omega_prec) * pnnh2_13) - gcicia_1_3(1) = ((( - g) / 2.0_omega_prec) * snna_13) - gcicia_1_3(2) = ((( - g) / 2.0_omega_prec) * pnna_13) - gcicih1_1_4(1) = ((( - g) / 2.0_omega_prec) * snnh1_14) - gcicih1_1_4(2) = ((( - g) / 2.0_omega_prec) * pnnh1_14) - gcicih2_1_4(1) = ((( - g) / 2.0_omega_prec) * snnh2_14) - gcicih2_1_4(2) = ((( - g) / 2.0_omega_prec) * pnnh2_14) - gcicia_1_4(1) = ((( - g) / 2.0_omega_prec) * snna_14) - gcicia_1_4(2) = ((( - g) / 2.0_omega_prec) * pnna_14) - gcicih1_2_2 = ((( - g) / 2.0_omega_prec) * snnh1_22) - gcicih2_2_2 = ((( - g) / 2.0_omega_prec) * snnh2_22) - gcicia_2_2 = ((( - g) / 2.0_omega_prec) * pnna_22) - gcicih1_2_3(1) = ((( - g) / 2.0_omega_prec) * snnh1_23) - gcicih1_2_3(2) = ((( - g) / 2.0_omega_prec) * pnnh1_23) - gcicih2_2_3(1) = ((( - g) / 2.0_omega_prec) * snnh2_23) - gcicih2_2_3(2) = ((( - g) / 2.0_omega_prec) * pnnh2_23) - end subroutine setup_parameters14 - subroutine setup_parameters15 () - gcicia_2_3(1) = ((( - g) / 2.0_omega_prec) * snna_23) - gcicia_2_3(2) = ((( - g) / 2.0_omega_prec) * pnna_23) - gcicih1_2_4(1) = ((( - g) / 2.0_omega_prec) * snnh1_24) - gcicih1_2_4(2) = ((( - g) / 2.0_omega_prec) * pnnh1_24) - gcicih2_2_4(1) = ((( - g) / 2.0_omega_prec) * snnh2_24) - gcicih2_2_4(2) = ((( - g) / 2.0_omega_prec) * pnnh2_24) - gcicia_2_4(1) = ((( - g) / 2.0_omega_prec) * snna_24) - gcicia_2_4(2) = ((( - g) / 2.0_omega_prec) * pnna_24) - gcicih1_3_3 = ((( - g) / 2.0_omega_prec) * snnh1_33) - gcicih2_3_3 = ((( - g) / 2.0_omega_prec) * snnh2_33) - gcicia_3_3 = ((( - g) / 2.0_omega_prec) * pnna_33) - gcicih1_3_4(1) = ((( - g) / 2.0_omega_prec) * snnh1_34) - gcicih1_3_4(2) = ((( - g) / 2.0_omega_prec) * pnnh1_34) - gcicih2_3_4(1) = ((( - g) / 2.0_omega_prec) * snnh2_34) - gcicih2_3_4(2) = ((( - g) / 2.0_omega_prec) * pnnh2_34) - gcicia_3_4(1) = ((( - g) / 2.0_omega_prec) * snna_34) - gcicia_3_4(2) = ((( - g) / 2.0_omega_prec) * pnna_34) - gcicih1_4_4 = ((( - g) / 2.0_omega_prec) * snnh1_44) - gcicih2_4_4 = ((( - g) / 2.0_omega_prec) * snnh2_44) - gcicia_4_4 = ((( - g) / 2.0_omega_prec) * pnna_44) - gch1c_1_1 = (( - (g / sqrt (2.0_omega_prec))) * ((conjg (mu_11) * & - conjg (mv_12) * cosal) - (conjg (mu_12) * conjg (mv_11) * sinal))) - gch2c_1_1 = (( - (g / sqrt (2.0_omega_prec))) * ((conjg (mu_12) * & - conjg (mv_11) * cosal) + (conjg (mu_11) * conjg (mv_12) * sinal))) - gcac_1_1 = (imago * ( - (g / & - sqrt (2.0_omega_prec))) * ((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_omega_prec))) * ((conjg (mu_21) * & - conjg (mv_22) * cosal) - (conjg (mu_22) * conjg (mv_21) * sinal))) - gch2c_2_2 = (( - (g / sqrt (2.0_omega_prec))) * ((conjg (mu_22) * & - conjg (mv_21) * cosal) + (conjg (mu_21) * conjg (mv_22) * sinal))) - gcac_2_2 = (imago * ( - (g / & - sqrt (2.0_omega_prec))) * ((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_omega_prec)) - 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_omega_prec)) - 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_omega_prec) * 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_omega_prec) * 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_parameters15 - subroutine setup_parameters16 () - 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_omega_prec) * 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_omega_prec) * 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_omega_prec) * 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_omega_prec) * 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_omega_prec) * 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_omega_prec) * 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_omega_prec) * 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_omega_prec) * 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_omega_prec) * 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_omega_prec) * 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_omega_prec) * 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_omega_prec) * 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_omega_prec) * 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_omega_prec) * 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_omega_prec) * 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_omega_prec) * 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_omega_prec) * 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_omega_prec) * 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_omega_prec) * 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_omega_prec) * 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_omega_prec) * 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_omega_prec) * 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_omega_prec) * 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_omega_prec) * 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_omega_prec) * 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_omega_prec) * 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_omega_prec) * 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_omega_prec) * 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_omega_prec) * 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_omega_prec) * 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_omega_prec) * 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_omega_prec) * 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_omega_prec) * 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_omega_prec) * 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_omega_prec) * 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_omega_prec) * 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_omega_prec) * 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_omega_prec) * 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_parameters16 - subroutine setup_parameters17 () - g_yuk_n1_sl1_3(1) = ( - (gcc * ((2.0_omega_prec * ( - & - 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_omega_prec * (mn_12 + (1.0_omega_prec * & - (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_omega_prec * ( - & - 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_omega_prec) * (mn_12 + ( & - (1.0_omega_prec / 3.0_omega_prec) * & - (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_omega_prec * ( - ( - & - (1.0_omega_prec / 3.0_omega_prec))) * 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_omega_prec * (mn_12 + (( - & - (1.0_omega_prec / 3.0_omega_prec)) * & - (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_omega_prec * ( - & - 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_omega_prec * (mn_22 + (1.0_omega_prec * & - (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_omega_prec * ( - & - 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_omega_prec) * (mn_22 + ( & - (1.0_omega_prec / 3.0_omega_prec) * & - (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_omega_prec * ( - ( - & - (1.0_omega_prec / 3.0_omega_prec))) * 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_omega_prec * (mn_22 + (( - & - (1.0_omega_prec / 3.0_omega_prec)) * & - (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_omega_prec * ( - & - 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_omega_prec * (mn_32 + (1.0_omega_prec * & - (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_omega_prec * ( - & - 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_omega_prec) * (mn_32 + ( & - (1.0_omega_prec / 3.0_omega_prec) * & - (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_omega_prec * ( - ( - & - (1.0_omega_prec / 3.0_omega_prec))) * 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_omega_prec * (mn_32 + (( - & - (1.0_omega_prec / 3.0_omega_prec)) * & - (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_omega_prec * ( - & - 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_omega_prec * (mn_42 + (1.0_omega_prec * & - (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_omega_prec * ( - & - 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_omega_prec) * (mn_42 + ( & - (1.0_omega_prec / 3.0_omega_prec) * & - (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_omega_prec * ( - ( - & - (1.0_omega_prec / 3.0_omega_prec))) * 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_omega_prec * (mn_42 + (( - & - (1.0_omega_prec / 3.0_omega_prec)) * & - (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_omega_prec * ( - & - 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_omega_prec * (mn_12 + (1.0_omega_prec * & - (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_omega_prec * ( - & - 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_omega_prec) * (mn_12 + ( & - (1.0_omega_prec / 3.0_omega_prec) * & - (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_omega_prec * ( - ( - & - (1.0_omega_prec / 3.0_omega_prec))) * 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_omega_prec * (mn_12 + (( - & - (1.0_omega_prec / 3.0_omega_prec)) * & - (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_omega_prec * ( - & - 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_omega_prec * (mn_22 + (1.0_omega_prec * & - (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_omega_prec * ( - & - 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_omega_prec) * (mn_22 + ( & - (1.0_omega_prec / 3.0_omega_prec) * & - (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_omega_prec * ( - ( - & - (1.0_omega_prec / 3.0_omega_prec))) * 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_omega_prec * (mn_22 + (( - & - (1.0_omega_prec / 3.0_omega_prec)) * & - (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_omega_prec * ( - & - 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_omega_prec * (mn_32 + (1.0_omega_prec * & - (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_omega_prec * ( - & - 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_omega_prec) * (mn_32 + ( & - (1.0_omega_prec / 3.0_omega_prec) * & - (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_omega_prec * ( - ( - & - (1.0_omega_prec / 3.0_omega_prec))) * 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_omega_prec * (mn_32 + (( - & - (1.0_omega_prec / 3.0_omega_prec)) * & - (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_omega_prec * ( - & - 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_omega_prec * (mn_42 + (1.0_omega_prec * & - (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_omega_prec * ( - & - 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_omega_prec) * (mn_42 + ( & - (1.0_omega_prec / 3.0_omega_prec) * & - (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_omega_prec * ( - ( - & - (1.0_omega_prec / 3.0_omega_prec))) * 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_omega_prec * (mn_42 + (( - & - (1.0_omega_prec / 3.0_omega_prec)) * & - (sinthw / costhw) * mn_41)) * mix_sd321) - ( & - (mn_43 * mass(5) * mix_sd322) / (mass(24) * cosbe)))) - 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)) - g_yuk_gsu1_3(1) = ( - (mix_su312 * (gs / sqrt (2.0_omega_prec)))) - g_yuk_gsu1_3(2) = (mix_su311 * (gs / sqrt (2.0_omega_prec))) - 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_omega_prec)))) - g_yuk_gsd1_3(2) = (mix_sd311 * (gs / sqrt (2.0_omega_prec))) - 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_omega_prec)))) - g_yuk_gsu2_3(2) = (mix_su321 * (gs / sqrt (2.0_omega_prec))) - 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_omega_prec)))) - g_yuk_gsd2_3(2) = (mix_sd321 * (gs / sqrt (2.0_omega_prec))) - 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_parameters17 - subroutine setup_parameters () - 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 - end subroutine setup_parameters -! No print_parameters -end module omega_parameters_mssm -! O'Mega revision control information: -! Models.MSSM: -! (Currently Incomplete) MSSM -! file: /home/sources/ohl/ml/omega/src/models2.ml,v -! revision: 1.5 checked in by ohl at 2001/03/09 20:07:09 -! Targets.Common_Fortran(): -! generates Fortran95 code -! file: /home/sources/ohl/ml/omega/src/targets.ml,v -! revision: 1.144 checked in by ohl at 2001/06/22 21:00:29 -!!! program test_parameters -!!! use omega_parameters -!!! call setup_parameters () -!!! call print_parameters () -!!! end program test_parameters Index: tags/ohl/attic/omega-000.011beta/src/omega_vectorspinors.f95 =================================================================== --- tags/ohl/attic/omega-000.011beta/src/omega_vectorspinors.f95 (revision 8686) +++ tags/ohl/attic/omega-000.011beta/src/omega_vectorspinors.f95 (revision 8687) @@ -1,228 +0,0 @@ -! $Id: omegalib.nw,v 1.118.4.2 2006/05/15 08:39:27 ohl Exp $ -! -! Copyright (C) 2000-2002 by Thorsten Ohl -! and others -! -! O'Mega is free software; you can redistribute it and/or modify it -! under the terms of the GNU General Public License as published by -! the Free Software Foundation; either version 2, or (at your option) -! any later version. -! -! O'Mega is distributed in the hope that it will be useful, but -! WITHOUT ANY WARRANTY; without even the implied warranty of -! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -! GNU General Public License for more details. -! -! You should have received a copy of the GNU General Public License -! along with this program; if not, write to the Free Software -! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -module omega_vectorspinors - use omega_kinds - use omega_constants - use omega_bispinors - use omega_vectors - implicit none - private - public :: operator (*), operator (+), operator (-) - public :: abs - type, public :: vectorspinor - ! private (omegalib needs access, but DON'T TOUCH IT!) - type(bispinor), dimension(4) :: psi - end type vectorspinor - interface operator (*) - module procedure vspinor_product - end interface - private :: vspinor_product - 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 - interface operator (+) - module procedure plus_vectorspinor - end interface - private :: plus_vectorspinor - interface operator (-) - module procedure neg_vectorspinor - end interface - private :: neg_vectorspinor - interface operator (+) - module procedure add_vectorspinor - end interface - private :: add_vectorspinor - interface operator (-) - module procedure sub_vectorspinor - end interface - private :: sub_vectorspinor - interface abs - module procedure abs_vectorspinor - end interface - private :: abs_vectorspinor - integer, parameter, public :: omega_vectorspinors_2003_03_A = 0 -contains - pure function vspinor_product (psil, psir) result (psilpsir) - complex(kind=omega_prec) :: 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 - 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=double), 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=double), 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=double), 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=double), 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 - 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 - 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 - pure function abs_vectorspinor (psi) result (x) - real(kind=omega_prec) :: x - type(vectorspinor), intent(in) :: psi - x = sqrt (dot_product (psi%psi(1)%a, psi%psi(1)%a) & - - dot_product (psi%psi(2)%a, psi%psi(2)%a) & - - dot_product (psi%psi(3)%a, psi%psi(3)%a) & - - dot_product (psi%psi(4)%a, psi%psi(4)%a)) - end function abs_vectorspinor -end module omega_vectorspinors Index: tags/ohl/attic/omega-000.011beta/src/omega_parameters_xdim.f95 =================================================================== --- tags/ohl/attic/omega-000.011beta/src/omega_parameters_xdim.f95 (revision 8686) +++ tags/ohl/attic/omega-000.011beta/src/omega_parameters_xdim.f95 (revision 8687) @@ -1,225 +0,0 @@ -! At the moment this is a hard-coded file and not extracted from -! omegalib.nw -! -! Copyright (C) 2000-2004 by Thorsten Ohl -! and others -! -! O'Mega is free software; you can redistribute it and/or modify it -! under the terms of the GNU General Public License as published by -! the Free Software Foundation; either version 2, or (at your option) -! any later version. -! -! O'Mega is distributed in the hope that it will be useful, but -! WITHOUT ANY WARRANTY; without even the implied warranty of -! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -! GNU General Public License for more details. -! -! You should have received a copy of the GNU General Public License -! along with this program; if not, write to the Free Software -! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -module omega_parameters_xdim - use omega_kinds - use omega_constants - implicit none - private - public :: setup_parameters, print_parameters - real(kind=omega_prec), dimension(39), save, public :: mass = 0, width = 0 - real(kind=omega_prec), parameter, public :: GeV = 1.0_double - real(kind=omega_prec), parameter, public :: MeV = GeV / 1000 - real(kind=omega_prec), parameter, public :: keV = MeV / 1000 - real(kind=omega_prec), parameter, public :: TeV = GeV * 1000 - real(kind=omega_prec), save, public :: & - alpha = 1.0_double / 137.0359895_double, & - sin2thw = 0.23124_double - complex(kind=omega_prec), save, private :: vev - complex(kind=omega_prec), save, public :: & - qlep = 0, qup = 0, qdwn = 0, gcc = 0, qw = 0, & - gzww = 0, gwww = 0, ghww = 0, ghhww = 0, ghzz = 0, ghhzz = 0, & - ghbb = 0, ghtt = 0, ghcc = 0, ghtautau = 0, gh3 = 0, gh4 = 0, & - ghgaga = 0, ghgaz = 0, & - iqw = 0, igzww = 0, igwww = 0, & - gw4 = 0, gzzww = 0, gazww = 0, gaaww = 0, & - gs = 0, igs = 0 - complex(kind=omega_prec), save, public :: & - sinckm12 = 0, sinckm13 = 0, sinckm23 = 0, & - cosckm12 = 0, cosckm13 = 0, cosckm23 = 0 - complex(kind=omega_prec), save, public :: & - vckm_11 = 0, vckm_12 = 0, vckm_13 = 0, vckm_21 = 0, & - vckm_22 = 0, vckm_23 = 0, vckm_31 = 0, vckm_32 = 0, vckm_33 = 0 - complex(kind=omega_prec), save, public :: & - gccq11 = 0, gccq12 = 0, gccq13 = 0, gccq21 = 0, & - gccq22 = 0, gccq23 = 0, gccq31 = 0, gccq32 = 0, gccq33 = 0 - real(kind=omega_prec), save, public :: & - g1a = 1, g1z = 1, kappaa = 1, kappaz = 1, lambdaa = 0, lambdaz = 0, & - g4a = 0, g4z = 0, g5a = 0, g5z = 0, & - kappa5a = 0, kappa5z = 0, lambda5a = 0, lambda5z = 0, & - alpha4 = 0, alpha5 = 0, tau4 = 0, tau5 = 0 - real(kind=omega_prec), save, public :: xia = 1, xi0 = 1, xipm = 1 - complex(kind=omega_prec), dimension(2), save, public :: & - gnclep = 0, gncneu = 0, gncup = 0, gncdwn = 0 - complex(kind=omega_prec), save, public :: & - fudge_o1 = 1, fudge_o2 = 1, fudge_o3 = 1, fudge_o4 = 1 - complex(kind=omega_prec), save, public :: & - ghmumu = 0 - complex(kind=omega_prec), save, public :: & - ghaa = 0, ghgg = 0, geaa = 0, geaz = 0, gegg = 0 - complex(kind=omega_prec), save, public :: & - gh0ww = 0, gh0zz = 0, & - gh0tt = 0, gh0bb = 0, gh0cc = 0, gh0tautau = 0, gh0mumu = 0, & - iga0tt = 0, iga0bb = 0, iga0cc = 0, iga0tautau = 0, iga0mumu = 0, & - gahh = 0, gzhh = 0, igzha = 0, igzh0a = 0 - complex(kind=omega_prec), dimension(2), save, public :: & - ghptb = 0, ghpcs = 0, ghptaunu = 0, ghpmunu = 0 - complex(kind=omega_prec), save, public :: & - ggrav = 0 -contains - subroutine setup_parameters () - real(kind=omega_prec) :: e, g, sinthw, costhw, qelep, qeup, qedwn - real(kind=omega_prec) :: sinth, costh, sinthp, costhp, & - sin2th, cos2th, sin2thp, cos2thp - real(kind=omega_prec) :: t_fac, tp_fac - mass(1) = 5.0 * MeV - mass(2) = 3.0 * MeV - mass(3) = 100.0 * MeV - mass(4) = 1.2 * GeV - mass(5) = 4.2 * GeV - mass(6) = 174.0 * GeV - width(1:5) = 0 - width(6) = 1.3 * GeV - mass(11) = 0.51099907 * MeV - mass(12) = 0 - mass(13) = 105.658389 * MeV - mass(14) = 0 - mass(15) = 1777.05 * MeV - mass(16) = 0 - width(11:16) = 0 - mass(21) = 0 - mass(22) = 0 - width(21:22) = 0 - mass(23) = 91.187 * GeV - width(23) = 2.490 * GeV - mass(24) = 80.41 * GeV - width(24) = 2.06 * GeV - mass(25) = 120.00 * GeV - width(25) = 5.00 * GeV - mass(35) = 10000 * GeV - width(35) = 0 - sinckm12 = 0.0_omega_prec - sinckm13 = 0.0_omega_prec - sinckm23 = 0.0_omega_prec - cosckm12 = sqrt ((1.0_omega_prec - (sinckm12**2))) - cosckm13 = sqrt ((1.0_omega_prec - (sinckm13**2))) - cosckm23 = sqrt ((1.0_omega_prec - (sinckm23**2))) - mass(26) = xi0 * mass(23) - width(26) = 0 - mass(27) = xipm * mass(24) - width(27) = 0 - e = sqrt (4 * PI * alpha) - qelep = - 1 - qeup = 2.0_omega_prec / 3.0_omega_prec - qedwn = - 1.0_omega_prec / 3.0_omega_prec - sinthw = sqrt (sin2thw) - costhw = sqrt (1 - sin2thw) - g = e / sinthw - gcc = - g / 2 / sqrt (2.0_double) - vckm_11 = cosckm12 * cosckm13 - vckm_12 = sinckm12 * cosckm13 - vckm_13 = sinckm13 - vckm_21 = - (sinckm12 * cosckm23 + & - cosckm12 * sinckm23 * sinckm13) - vckm_22 = cosckm12 * cosckm23 - & - sinckm12 * sinckm23 * sinckm13 - vckm_23 = sinckm23 * cosckm13 - vckm_31 = sinckm12 * sinckm23 - & - cosckm12 * cosckm23 * sinckm13 - vckm_32 = - (cosckm12 * sinckm23 + & - sinckm12 * cosckm23 * sinckm13) - vckm_33 = cosckm23 * cosckm13 - gccq11 = gcc * vckm_11 - gccq12 = gcc * vckm_12 - gccq13 = gcc * vckm_13 - gccq21 = gcc * vckm_21 - gccq22 = gcc * vckm_22 - gccq23 = gcc * vckm_23 - gccq31 = gcc * vckm_31 - gccq32 = gcc * vckm_32 - gccq33 = gcc * vckm_33 - gncneu(1) = - g / 2 / costhw * ( + 0.5_double) - gnclep(1) = - g / 2 / costhw * ( - 0.5_double - 2 * qelep * sin2thw) - gncup(1) = - g / 2 / costhw * ( + 0.5_double - 2 * qeup * sin2thw) - gncdwn(1) = - g / 2 / costhw * ( - 0.5_double - 2 * qedwn * sin2thw) - gncneu(2) = - g / 2 / costhw * ( + 0.5_double) - gnclep(2) = - g / 2 / costhw * ( - 0.5_double) - gncup(2) = - g / 2 / costhw * ( + 0.5_double) - gncdwn(2) = - g / 2 / costhw * ( - 0.5_double) - qlep = - e * qelep - qup = - e * qeup - qdwn = - e * qedwn - qw = e - iqw = (0,1)*qw - gzww = g * costhw - igzww = (0,1)*gzww - gwww = g - igwww = (0,1)*gwww - ghww = mass(24) * g - ghhww = g**2 / 2.0_omega_prec - ghzz = mass(23) * g / costhw - ghhzz = g**2 / 2.0_omega_prec / costhw**2 - gw4 = g**2 - gzzww = gzww**2 - gazww = gzww*e - gaaww = e**2 - vev = 2.0 * mass(24) / g - ghtt = - mass(6) / vev - ghbb = - mass(5) / vev - ghcc = - mass(4) / vev - ghtautau = - mass(15) / vev - gh3 = - 3 * mass(25)**2 / vev - gh4 = - 3 * mass(25)**2 / vev**2 - !!! Littlest Higgs specific couplings - sin2th = sinth**2 - cos2th = 1.0_omega_prec - sin2th - costh = sqrt(cos2th) - sin2thp = sinthp**2 - cos2thp = 1.0_omega_prec - sin2thp - costhp = sqrt(cos2thp) - t_fac = (cos2th - sin2th)/2.0_omega_prec/sinth/costh - tp_fac = (cos2thp - sin2thp)/2.0_omega_prec/sinthp/costhp - end subroutine setup_parameters - subroutine print_parameters () - print *, "Quark masses:" - print *, mass(2:6:2) - print *, mass(1:5:2) - print *, "Lepton masses:" - print *, mass(12:16:2) - print *, mass(11:15:2) - print *, "Quark widths:" - print *, width(2:6:2) - print *, width(1:5:2) - print *, "Lepton widths:" - print *, width(12:16:2) - print *, width(11:15:2) - print *, "SU(2)xU(1) Gauge boson masses/widths:" - print *, mass(22:24) - print *, width(22:24) - print *, "Higgs boson and gluon masses/widths:" - print *, mass(25), mass(21) - print *, width(25), width(21) - print *, "Neutral current couplings:" - print *, "U:", gncup - print *, "D:", gncdwn - print *, "N:", gncneu - print *, "L:", gnclep - print *, "Fermion charges:" - print *, "U:", qup - print *, "D:", qdwn - print *, "L:", qlep - print *, "TGC:" - print *, "WWA:", iqw - print *, "WWZ:", igzww - print *, "WWW:", igwww - print *, "WWH:", ghww - print *, "WWHH:", ghhww - print *, "ZZHH:", ghhzz - end subroutine print_parameters -end module omega_parameters_xdim Index: tags/ohl/attic/omega-000.011beta/src/omega_spinors.f95 =================================================================== --- tags/ohl/attic/omega-000.011beta/src/omega_spinors.f95 (revision 8686) +++ tags/ohl/attic/omega-000.011beta/src/omega_spinors.f95 (revision 8687) @@ -1,259 +0,0 @@ -! $Id: omegalib.nw,v 1.118.4.2 2006/05/15 08:39:27 ohl Exp $ -! -! Copyright (C) 2000-2002 by Thorsten Ohl -! and others -! -! O'Mega is free software; you can redistribute it and/or modify it -! under the terms of the GNU General Public License as published by -! the Free Software Foundation; either version 2, or (at your option) -! any later version. -! -! O'Mega is distributed in the hope that it will be useful, but -! WITHOUT ANY WARRANTY; without even the implied warranty of -! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -! GNU General Public License for more details. -! -! You should have received a copy of the GNU General Public License -! along with this program; if not, write to the Free Software -! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -module omega_spinors - use omega_kinds - use omega_constants - implicit none - private - public :: operator (*), operator (+), operator (-) - public :: abs - - type, public :: conjspinor - ! private (omegalib needs access, but DON'T TOUCH IT!) - complex(kind=omega_prec), dimension(4) :: a - end type conjspinor - type, public :: spinor - ! private (omegalib needs access, but DON'T TOUCH IT!) - complex(kind=omega_prec), dimension(4) :: a - end type spinor - interface operator (*) - module procedure conjspinor_spinor - end interface - private :: conjspinor_spinor - 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 - 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 - 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 - 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 - interface abs - module procedure abs_spinor, abs_conjspinor - end interface - private :: abs_spinor, abs_conjspinor - integer, parameter, public :: omega_spinors_2003_03_A = 0 -contains - pure function conjspinor_spinor (psibar, psi) result (psibarpsi) - complex(kind=omega_prec) :: 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 - 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=double), 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=double), 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=double), 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=double), intent(in) :: x - type(spinor), intent(in) :: y - type(spinor) :: xy - xy%a = x * y%a - end function spinor_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=double), 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=double), 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=double), 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=double), intent(in) :: x - type(conjspinor), intent(in) :: y - type(conjspinor) :: xy - xy%a = x * y%a - end function conjspinor_dcomplex - 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 - 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 - pure function abs_spinor (psi) result (x) - type(spinor), intent(in) :: psi - real(kind=omega_prec) :: x - x = sqrt (dot_product (psi%a, psi%a)) - end function abs_spinor - pure function abs_conjspinor (psibar) result (x) - real(kind=omega_prec) :: x - type(conjspinor), intent(in) :: psibar - x = sqrt (dot_product (psibar%a, psibar%a)) - end function abs_conjspinor -end module omega_spinors Index: tags/ohl/attic/omega-000.011beta/src/omega_parameters_madgraph.f95 =================================================================== --- tags/ohl/attic/omega-000.011beta/src/omega_parameters_madgraph.f95 (revision 8686) +++ tags/ohl/attic/omega-000.011beta/src/omega_parameters_madgraph.f95 (revision 8687) @@ -1,101 +0,0 @@ -! $Id: omegalib.nw,v 1.118.4.2 2006/05/15 08:39:27 ohl Exp $ -! -! Copyright (C) 2000-2002 by Thorsten Ohl -! and others -! -! O'Mega is free software; you can redistribute it and/or modify it -! under the terms of the GNU General Public License as published by -! the Free Software Foundation; either version 2, or (at your option) -! any later version. -! -! O'Mega is distributed in the hope that it will be useful, but -! WITHOUT ANY WARRANTY; without even the implied warranty of -! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -! GNU General Public License for more details. -! -! You should have received a copy of the GNU General Public License -! along with this program; if not, write to the Free Software -! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -module omega_parameters_madgraph - use omega_kinds - use omega_parameters - implicit none - private - public :: export_parameters_to_madgraph - integer, parameter, private :: D = selected_real_kind (14, 100) - real(kind=D), save, public :: gw = 0, gwwa = 0, gwwz = 0 - real(kind=D), dimension(2), save, public :: gal = 0, gau = 0, gad = 0, gwf = 0 - real(kind=D), dimension(2), save, public :: gzn = 0, gzl = 0, gzu = 0, gzd = 0, g1 = 0 - real(kind=D), save, public :: gwwh = 0, gzzh = 0, ghhh = 0, & - gwwhh = 0, gzzhh = 0, ghhhh = 0 - complex(kind=D), dimension(2,12), save, public :: gh = 0 - real(kind=D), save, public :: wmass = 0, wwidth = 0, zmass = 0, zwidth = 0 - real(kind=D), save, public :: amass = 0, awidth = 0, hmass = 0, hwidth = 0 - real(kind=D), dimension(12), save, public :: fmass = 0, fwidth = 0 - complex(kind=D), save, public :: fudge_m1 = 1, fudge_m2 = 1, fudge_m3 = 1, fudge_m4 = 1 -contains - subroutine export_parameters_to_madgraph () - gal = qlep - gau = qup - gad = qdwn - gzl(1) = gnclep(1) + gnclep(2) - gzl(2) = gnclep(1) - gnclep(2) - gzn(1) = gncneu(1) + gncneu(2) - gzn(2) = gncneu(1) - gncneu(2) - gzu(1) = gncup(1) + gncup(2) - gzu(2) = gncup(1) - gncup(2) - gzd(1) = gncdwn(1) + gncdwn(2) - gzd(2) = gncdwn(1) - gncdwn(2) - gwf(1) = 2 * gcc - gwf(2) = 0 - gwwa = qw - gwwz = gzww - gwwh = ghww - !!! gwwhh = ghhww**2 !!! Old SM3 - gwwhh = ghhww - gzzh = ghzz - !!! gzzhh = ghhzz**2 !!! Old SM3 - gzzhh = ghhzz - ghhh = gh3 - ghhhh = gh4 - ghtt = 0 - ghbb = 0 - ghcc = 0 - ghtautau = 0 - gh3 = 0 - gh4 = 0 - gh(:,1:6) = 0 - gh(:,7) = ghcc - gh(:,8) = 0 - gh(:,9) = ghtautau - gh(:,10) = 0 - gh(:,11) = ghtt - gh(:,12) = ghbb - fmass(1:2) = mass(11:12) - fwidth(1:2) = width(11:12) - fmass(5:6) = mass(13:14) - fwidth(5:6) = width(13:14) - fmass(9:10) = mass(15:16) - fwidth(9:10) = width(15:16) - fmass(4) = mass(1) - fwidth(4) = width(1) - fmass(3) = mass(2) - fwidth(3) = width(2) - fmass(8) = mass(3) - fwidth(8) = width(3) - fmass(7) = mass(4) - fwidth(7) = width(4) - fmass(12) = mass(5) - fwidth(12) = width(5) - fmass(11) = mass(6) - fwidth(11) = width(6) - amass = mass(22) - awidth = width(22) - zmass = mass(23) - zwidth = width(23) - wmass = mass(24) - wwidth = width(24) - hmass = mass(25) - hwidth = width(25) - end subroutine export_parameters_to_madgraph -end module omega_parameters_madgraph Index: tags/ohl/attic/omega-000.011beta/src/omega_spinor_couplings.f95 =================================================================== --- tags/ohl/attic/omega-000.011beta/src/omega_spinor_couplings.f95 (revision 8686) +++ tags/ohl/attic/omega-000.011beta/src/omega_spinor_couplings.f95 (revision 8687) @@ -1,697 +0,0 @@ -! $Id: omegalib.nw,v 1.118.4.2 2006/05/15 08:39:27 ohl Exp $ -! -! Copyright (C) 2000-2002 by Thorsten Ohl -! and others -! -! O'Mega is free software; you can redistribute it and/or modify it -! under the terms of the GNU General Public License as published by -! the Free Software Foundation; either version 2, or (at your option) -! any later version. -! -! O'Mega is distributed in the hope that it will be useful, but -! WITHOUT ANY WARRANTY; without even the implied warranty of -! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -! GNU General Public License for more details. -! -! You should have received a copy of the GNU General Public License -! along with this program; if not, write to the Free Software -! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -module omega_spinor_couplings - use omega_kinds - use omega_constants - use omega_spinors - use omega_vectors - use omega_tensors - use omega_couplings - implicit none - private - public :: u, ubar, v, vbar - private :: chi_plus, chi_minus - public :: brs_u, brs_ubar, brs_v, brs_vbar - public :: va_ff, v_ff, a_ff, vl_ff, vr_ff, vlr_ff, grav_ff - public :: f_vaf, f_vf, f_af, f_vlf, f_vrf, f_vlrf - public :: f_fva, f_fv, f_fa, f_fvl, f_fvr, f_fvlr - public :: sp_ff, s_ff, p_ff, sl_ff, sr_ff, slr_ff - public :: f_spf, f_sf, f_pf, f_slf, f_srf, f_slrf - public :: f_fsp, f_fs, f_fp, f_fsl, f_fsr, f_fslr - public :: f_gravf, f_fgrav - public :: pr_psi, pr_psibar - public :: pj_psi, pj_psibar - integer, parameter, public :: omega_spinor_cpls_2003_03_A = 0 -contains - pure function chi_plus (p) result (chi) - complex(kind=omega_prec), dimension(2) :: chi - type(momentum), intent(in) :: p - real(kind=omega_prec) :: pabs - pabs = sqrt (dot_product (p%x, p%x)) - if (pabs + p%x(3) <= 1000 * epsilon (pabs) * pabs) then - !!! OLD VERSION !!!!!! - !!! if (1 + p%x(3) / pabs <= epsilon (pabs)) then - !!!!!!!!!!!!!!!!!!!!!! - chi = (/ cmplx ( 0.0, 0.0, kind=omega_prec), & - cmplx ( 1.0, 0.0, kind=omega_prec) /) - else - chi = 1 / sqrt (2*pabs*(pabs + p%x(3))) & - * (/ cmplx (pabs + p%x(3), kind=omega_prec), & - cmplx (p%x(1), p%x(2), kind=omega_prec) /) - end if - end function chi_plus - pure function chi_minus (p) result (chi) - complex(kind=omega_prec), dimension(2) :: chi - type(momentum), intent(in) :: p - real(kind=omega_prec) :: pabs - pabs = sqrt (dot_product (p%x, p%x)) - if (pabs + p%x(3) <= 1000 * epsilon (pabs) * pabs) then - !!! OLD VERSION !!!!!!!!!!! - !!! if (1 + p%x(3) / pabs <= epsilon (pabs)) then - !!!!!!!!!!!!!!!!!!!!!!!!!!! - chi = (/ cmplx (-1.0, 0.0, kind=omega_prec), & - cmplx ( 0.0, 0.0, kind=omega_prec) /) - else - chi = 1 / sqrt (2*pabs*(pabs + p%x(3))) & - * (/ cmplx (-p%x(1), p%x(2), kind=omega_prec), & - cmplx (pabs + p%x(3), kind=omega_prec) /) - end if - end function chi_minus - pure function u (m, p, s) result (psi) - type(spinor) :: psi - real(kind=omega_prec), intent(in) :: m - type(momentum), intent(in) :: p - integer, intent(in) :: s - complex(kind=omega_prec), dimension(2) :: chi - real(kind=omega_prec) :: pabs - pabs = sqrt (dot_product (p%x, p%x)) - select case (s) - case (1) - chi = chi_plus (p) - psi%a(1:2) = sqrt (max (p%t - pabs, 0.0_omega_prec)) * chi - psi%a(3:4) = sqrt (p%t + pabs) * chi - case (-1) - chi = chi_minus (p) - psi%a(1:2) = sqrt (p%t + pabs) * chi - psi%a(3:4) = sqrt (max (p%t - pabs, 0.0_omega_prec)) * chi - case default - pabs = m ! make the compiler happy and use m - psi%a = 0 - end select - end function u - pure function ubar (m, p, s) result (psibar) - type(conjspinor) :: psibar - real(kind=omega_prec), 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 - pure function v (m, p, s) result (psi) - type(spinor) :: psi - real(kind=omega_prec), intent(in) :: m - type(momentum), intent(in) :: p - integer, intent(in) :: s - complex(kind=omega_prec), dimension(2) :: chi - real(kind=omega_prec) :: pabs - pabs = sqrt (dot_product (p%x, p%x)) - select case (s) - case (1) - chi = chi_minus (p) - psi%a(1:2) = - sqrt (p%t + pabs) * chi - psi%a(3:4) = sqrt (max (p%t - pabs, 0.0_omega_prec)) * chi - case (-1) - chi = chi_plus (p) - psi%a(1:2) = sqrt (max (p%t - pabs, 0.0_omega_prec)) * chi - psi%a(3:4) = - sqrt (p%t + pabs) * chi - case default - pabs = m ! make the compiler happy and use m - psi%a = 0 - end select - end function v - pure function vbar (m, p, s) result (psibar) - type(conjspinor) :: psibar - real(kind=omega_prec), 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 - pure function brs_u (m, p, s) result (dpsi) - type(spinor) :: dpsi,psi - real(kind=omega_prec), intent(in) :: m - type(momentum), intent(in) :: p - integer, intent(in) :: s - type (vector)::vp - complex(kind=omega_prec), 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 - pure function brs_v (m, p, s) result (dpsi) - type(spinor) :: dpsi, psi - real(kind=omega_prec), intent(in) :: m - type(momentum), intent(in) :: p - integer, intent(in) :: s - type (vector)::vp - complex(kind=omega_prec), 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 - pure function brs_ubar (m, p, s)result (dpsibar) - type(conjspinor) :: dpsibar, psibar - real(kind=omega_prec), intent(in) :: m - type(momentum), intent(in) :: p - integer, intent(in) :: s - type (vector)::vp - complex(kind=omega_prec), 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 - pure function brs_vbar (m, p, s) result (dpsibar) - type(conjspinor) :: dpsibar,psibar - real(kind=omega_prec), intent(in) :: m - type(momentum), intent(in) :: p - integer, intent(in) :: s - type(vector)::vp - complex(kind=omega_prec), 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 - pure function va_ff (gv, ga, psibar, psi) result (j) - type(vector) :: j - complex(kind=omega_prec), intent(in) :: gv, ga - type(conjspinor), intent(in) :: psibar - type(spinor), intent(in) :: psi - complex(kind=omega_prec) :: gl, gr - complex(kind=omega_prec) :: 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 v_ff (gv, psibar, psi) result (j) - type(vector) :: j - complex(kind=omega_prec), intent(in) :: gv - type(conjspinor), intent(in) :: psibar - type(spinor), intent(in) :: psi - complex(kind=omega_prec) :: 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=omega_prec), intent(in) :: ga - type(conjspinor), intent(in) :: psibar - type(spinor), intent(in) :: psi - complex(kind=omega_prec) :: 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=omega_prec), intent(in) :: gl - type(conjspinor), intent(in) :: psibar - type(spinor), intent(in) :: psi - complex(kind=omega_prec) :: gl2 - complex(kind=omega_prec) :: 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=omega_prec), intent(in) :: gr - type(conjspinor), intent(in) :: psibar - type(spinor), intent(in) :: psi - complex(kind=omega_prec) :: gr2 - complex(kind=omega_prec) :: 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=omega_prec), intent(in) :: g - real(kind=omega_prec), intent(in) :: m - type(conjspinor), intent(in) :: psibar - type(spinor), intent(in) :: psi - type(momentum), intent(in) :: kb, k - complex(kind=omega_prec) :: g2, g8, c_dum - type(vector) :: v_dum - type(tensor) :: t_metric - t_metric%t = 0 - t_metric%t(0,0) = 1.0_omega_prec - t_metric%t(1,1) = - 1.0_omega_prec - t_metric%t(2,2) = - 1.0_omega_prec - t_metric%t(3,3) = - 1.0_omega_prec - g2 = g/2.0_omega_prec - g8 = g/8.0_omega_prec - 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 - pure function vlr_ff (gl, gr, psibar, psi) result (j) - type(vector) :: j - complex(kind=omega_prec), 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 - pure function f_vaf (gv, ga, v, psi) result (vpsi) - type(spinor) :: vpsi - complex(kind=omega_prec), intent(in) :: gv, ga - type(vector), intent(in) :: v - type(spinor), intent(in) :: psi - complex(kind=omega_prec) :: gl, gr - complex(kind=omega_prec) :: vp, vm, v12, v12s - gl = gv + ga - gr = gv - ga - vp = v%t + v%x(3) - vm = v%t - v%x(3) - v12 = v%x(1) + (0,1)*v%x(2) - v12s = v%x(1) - (0,1)*v%x(2) - vpsi%a(1) = gr * ( vm * psi%a(3) - v12s * psi%a(4)) - vpsi%a(2) = gr * ( - v12 * psi%a(3) + vp * psi%a(4)) - vpsi%a(3) = gl * ( vp * psi%a(1) + v12s * psi%a(2)) - vpsi%a(4) = gl * ( v12 * psi%a(1) + vm * psi%a(2)) - end function f_vaf - pure function f_vf (gv, v, psi) result (vpsi) - type(spinor) :: vpsi - complex(kind=omega_prec), intent(in) :: gv - type(vector), intent(in) :: v - type(spinor), intent(in) :: psi - complex(kind=omega_prec) :: 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=omega_prec), intent(in) :: ga - type(vector), intent(in) :: v - type(spinor), intent(in) :: psi - complex(kind=omega_prec) :: 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=omega_prec), intent(in) :: gl - type(vector), intent(in) :: v - type(spinor), intent(in) :: psi - complex(kind=omega_prec) :: gl2 - complex(kind=omega_prec) :: 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=omega_prec), intent(in) :: gr - type(vector), intent(in) :: v - type(spinor), intent(in) :: psi - complex(kind=omega_prec) :: gr2 - complex(kind=omega_prec) :: 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=omega_prec), 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 - pure function f_fva (gv, ga, psibar, v) result (psibarv) - type(conjspinor) :: psibarv - complex(kind=omega_prec), intent(in) :: gv, ga - type(conjspinor), intent(in) :: psibar - type(vector), intent(in) :: v - complex(kind=omega_prec) :: gl, gr - complex(kind=omega_prec) :: vp, vm, v12, v12s - gl = gv + ga - gr = gv - ga - vp = v%t + v%x(3) - vm = v%t - v%x(3) - v12 = v%x(1) + (0,1)*v%x(2) - v12s = v%x(1) - (0,1)*v%x(2) - psibarv%a(1) = gl * ( psibar%a(3) * vp + psibar%a(4) * v12) - psibarv%a(2) = gl * ( psibar%a(3) * v12s + psibar%a(4) * vm ) - psibarv%a(3) = gr * ( psibar%a(1) * vm - psibar%a(2) * v12) - psibarv%a(4) = gr * ( - psibar%a(1) * v12s + psibar%a(2) * vp ) - end function f_fva - pure function f_fv (gv, psibar, v) result (psibarv) - type(conjspinor) :: psibarv - complex(kind=omega_prec), intent(in) :: gv - type(conjspinor), intent(in) :: psibar - type(vector), intent(in) :: v - complex(kind=omega_prec) :: 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=omega_prec), intent(in) :: ga - type(vector), intent(in) :: v - type(conjspinor), intent(in) :: psibar - complex(kind=omega_prec) :: 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=omega_prec), intent(in) :: gl - type(conjspinor), intent(in) :: psibar - type(vector), intent(in) :: v - complex(kind=omega_prec) :: gl2 - complex(kind=omega_prec) :: 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=omega_prec), intent(in) :: gr - type(conjspinor), intent(in) :: psibar - type(vector), intent(in) :: v - complex(kind=omega_prec) :: gr2 - complex(kind=omega_prec) :: 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=omega_prec), 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 - pure function sp_ff (gs, gp, psibar, psi) result (j) - complex(kind=omega_prec) :: j - complex(kind=omega_prec), 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=omega_prec) :: j - complex(kind=omega_prec), 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=omega_prec) :: j - complex(kind=omega_prec), 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=omega_prec) :: j - complex(kind=omega_prec), 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=omega_prec) :: j - complex(kind=omega_prec), 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 - pure function slr_ff (gl, gr, psibar, psi) result (j) - complex(kind=omega_prec) :: j - complex(kind=omega_prec), 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 - pure function f_spf (gs, gp, phi, psi) result (phipsi) - type(spinor) :: phipsi - complex(kind=omega_prec), intent(in) :: gs, gp - complex(kind=omega_prec), 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=omega_prec), intent(in) :: gs - complex(kind=omega_prec), 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=omega_prec), intent(in) :: gp - complex(kind=omega_prec), 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=omega_prec), intent(in) :: gl - complex(kind=omega_prec), 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=omega_prec), intent(in) :: gr - complex(kind=omega_prec), 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=omega_prec), intent(in) :: gl, gr - complex(kind=omega_prec), intent(in) :: phi - type(spinor), intent(in) :: psi - phipsi = f_spf (gr+gl, gr-gl, phi, psi) - end function f_slrf - pure function f_fsp (gs, gp, psibar, phi) result (psibarphi) - type(conjspinor) :: psibarphi - complex(kind=omega_prec), intent(in) :: gs, gp - type(conjspinor), intent(in) :: psibar - complex(kind=omega_prec), 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=omega_prec), intent(in) :: gs - type(conjspinor), intent(in) :: psibar - complex(kind=omega_prec), 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=omega_prec), intent(in) :: gp - type(conjspinor), intent(in) :: psibar - complex(kind=omega_prec), 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=omega_prec), intent(in) :: gl - type(conjspinor), intent(in) :: psibar - complex(kind=omega_prec), 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=omega_prec), intent(in) :: gr - type(conjspinor), intent(in) :: psibar - complex(kind=omega_prec), 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=omega_prec), intent(in) :: gl, gr - type(conjspinor), intent(in) :: psibar - complex(kind=omega_prec), intent(in) :: phi - psibarphi = f_fsp (gr+gl, gr-gl, psibar, phi) - end function f_fslr - pure function f_gravf (g, m, kb, k, t, psi) result (tpsi) - type(spinor) :: tpsi - complex(kind=omega_prec), intent(in) :: g - real(kind=omega_prec), intent(in) :: m - type(spinor), intent(in) :: psi - type(tensor), intent(in) :: t - type(momentum), intent(in) :: kb, k - complex(kind=omega_prec) :: g2, g8, t_tr - type(vector) :: kkb - kkb = k + kb - g2 = g / 2.0_omega_prec - g8 = g / 8.0_omega_prec - 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=omega_prec), 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=omega_prec), intent(in) :: g - real(kind=omega_prec), intent(in) :: m - type(conjspinor), intent(in) :: psibar - type(tensor), intent(in) :: t - type(momentum), intent(in) :: kb, k - type(vector) :: kkb - complex(kind=omega_prec) :: g2, g8, t_tr - kkb = k + kb - g2 = g / 2.0_omega_prec - g8 = g / 8.0_omega_prec - 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=omega_prec)) & - - f_fv ((g8 * m), psibar, kkb)) * t_tr - & - f_fv (g8,psibar,(t*kkb + kkb*t)) - end function f_fgrav - pure function pr_psi (p, m, w, psi) result (ppsi) - type(spinor) :: ppsi - type(momentum), intent(in) :: p - real(kind=omega_prec), intent(in) :: m, w - type(spinor), intent(in) :: psi - type(vector) :: vp - complex(kind=omega_prec), parameter :: one = (1, 0) - vp = p - ppsi = (1 / cmplx (p*p - m**2, m*w, kind=omega_prec)) & - * (- f_vf (one, vp, psi) + m * psi) - end function pr_psi - pure function pj_psi (p, m, w, psi) result (ppsi) - type(spinor) :: ppsi - type(momentum), intent(in) :: p - real(kind=omega_prec), intent(in) :: m, w - type(spinor), intent(in) :: psi - type(vector) :: vp - complex(kind=omega_prec), 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 pr_psibar (p, m, w, psibar) result (ppsibar) - type(conjspinor) :: ppsibar - type(momentum), intent(in) :: p - real(kind=omega_prec), intent(in) :: m, w - type(conjspinor), intent(in) :: psibar - type(vector) :: vp - complex(kind=omega_prec), parameter :: one = (1, 0) - vp = p - ppsibar = (1 / cmplx (p*p - m**2, m*w, kind=omega_prec)) & - * (f_fv (one, psibar, vp) + m * psibar) - end function pr_psibar - pure function pj_psibar (p, m, w, psibar) result (ppsibar) - type(conjspinor) :: ppsibar - type(momentum), intent(in) :: p - real(kind=omega_prec), intent(in) :: m, w - type(conjspinor), intent(in) :: psibar - type(vector) :: vp - complex(kind=omega_prec), parameter :: one = (1, 0) - vp = p - ppsibar = (0, -1) * sqrt (PI / m / w) * (f_fv (one, psibar, vp) + m * psibar) - end function pj_psibar -end module omega_spinor_couplings Index: tags/ohl/attic/omega-000.011beta/src/test_omega95.f95 =================================================================== --- tags/ohl/attic/omega-000.011beta/src/test_omega95.f95 (revision 8686) +++ tags/ohl/attic/omega-000.011beta/src/test_omega95.f95 (revision 8687) @@ -1,203 +0,0 @@ -! $Id: omegalib.nw,v 1.118.4.2 2006/05/15 08:39:27 ohl Exp $ -! -! Copyright (C) 2000-2002 by Thorsten Ohl -! and others -! -! O'Mega is free software; you can redistribute it and/or modify it -! under the terms of the GNU General Public License as published by -! the Free Software Foundation; either version 2, or (at your option) -! any later version. -! -! O'Mega is distributed in the hope that it will be useful, but -! WITHOUT ANY WARRANTY; without even the implied warranty of -! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -! GNU General Public License for more details. -! -! You should have received a copy of the GNU General Public License -! along with this program; if not, write to the Free Software -! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -program test_omega95 - use omega_kinds - use omega95 - use omega_testtools - implicit none - real(kind=omega_prec) :: m, pabs, qabs, w - real(kind=omega_prec), dimension(4) :: r - complex(kind=omega_prec) :: one - type(momentum) :: p, q - type(vector) :: vp, vq, vtest - type(tensor) :: ttest - integer, dimension(8) :: date_time - integer :: rsize - call date_and_time (values = date_time) - call random_seed (size = rsize) - call random_seed (put = spread (product (date_time), dim = 1, ncopies = rsize)) - w = 0 - one = 1 - m = 13 - pabs = 42 - qabs = 137 - call random_number (r) - vtest%t = cmplx (10.0_omega_prec * r(0)) - vtest%x(1:3) = cmplx (10.0_omega_prec * r(1:3)) - ttest = vtest.tprod.vtest - call random_momentum (p, pabs, m) - call random_momentum (q, qabs, m) - vp = p - vq = q - print *, "*** Checking the equations of motion ***:" - call expect (abs(f_vf(one,vp,u(m,p,+1))-m*u(m,p,+1)), 0, "|[p-m]u(+)|=0") - call expect (abs(f_vf(one,vp,u(m,p,-1))-m*u(m,p,-1)), 0, "|[p-m]u(-)|=0") - call expect (abs(f_vf(one,vp,v(m,p,+1))+m*v(m,p,+1)), 0, "|[p+m]v(+)|=0") - call expect (abs(f_vf(one,vp,v(m,p,-1))+m*v(m,p,-1)), 0, "|[p+m]v(-)|=0") - call expect (abs(f_fv(one,ubar(m,p,+1),vp)-m*ubar(m,p,+1)), 0, "|ubar(+)[p-m]|=0") - call expect (abs(f_fv(one,ubar(m,p,-1),vp)-m*ubar(m,p,-1)), 0, "|ubar(-)[p-m]|=0") - call expect (abs(f_fv(one,vbar(m,p,+1),vp)+m*vbar(m,p,+1)), 0, "|vbar(+)[p+m]|=0") - call expect (abs(f_fv(one,vbar(m,p,-1),vp)+m*vbar(m,p,-1)), 0, "|vbar(-)[p+m]|=0") - print *, "*** Checking the normalization ***:" - call expect (ubar(m,p,+1)*u(m,p,+1), +2*m, "ubar(+)*u(+)=+2m") - call expect (ubar(m,p,-1)*u(m,p,-1), +2*m, "ubar(-)*u(-)=+2m") - call expect (vbar(m,p,+1)*v(m,p,+1), -2*m, "vbar(+)*v(+)=-2m") - call expect (vbar(m,p,-1)*v(m,p,-1), -2*m, "vbar(-)*v(-)=-2m") - call expect (ubar(m,p,+1)*v(m,p,+1), 0, "ubar(+)*v(+)=0 ") - call expect (ubar(m,p,-1)*v(m,p,-1), 0, "ubar(-)*v(-)=0 ") - call expect (vbar(m,p,+1)*u(m,p,+1), 0, "vbar(+)*u(+)=0 ") - call expect (vbar(m,p,-1)*u(m,p,-1), 0, "vbar(-)*u(-)=0 ") - print *, "*** Checking the currents ***:" - call expect (abs(v_ff(one,ubar(m,p,+1),u(m,p,+1))-2*vp), 0, "ubar(+).V.u(+)=2p") - call expect (abs(v_ff(one,ubar(m,p,-1),u(m,p,-1))-2*vp), 0, "ubar(-).V.u(-)=2p") - call expect (abs(v_ff(one,vbar(m,p,+1),v(m,p,+1))-2*vp), 0, "vbar(+).V.v(+)=2p") - call expect (abs(v_ff(one,vbar(m,p,-1),v(m,p,-1))-2*vp), 0, "vbar(-).V.v(-)=2p") - print *, "*** Checking current conservation ***:" - call expect ((vp-vq)*v_ff(one,ubar(m,p,+1),u(m,q,+1)), 0, "d(ubar(+).V.u(+))=0") - call expect ((vp-vq)*v_ff(one,ubar(m,p,-1),u(m,q,-1)), 0, "d(ubar(-).V.u(-))=0") - call expect ((vp-vq)*v_ff(one,vbar(m,p,+1),v(m,q,+1)), 0, "d(vbar(+).V.v(+))=0") - call expect ((vp-vq)*v_ff(one,vbar(m,p,-1),v(m,q,-1)), 0, "d(vbar(-).V.v(-))=0") - if (m == 0) then - print *, "*** Checking axial current conservation ***:" - call expect ((vp-vq)*a_ff(one,ubar(m,p,+1),u(m,q,+1)), 0, "d(ubar(+).A.u(+))=0") - call expect ((vp-vq)*a_ff(one,ubar(m,p,-1),u(m,q,-1)), 0, "d(ubar(-).A.u(-))=0") - call expect ((vp-vq)*a_ff(one,vbar(m,p,+1),v(m,q,+1)), 0, "d(vbar(+).A.v(+))=0") - call expect ((vp-vq)*a_ff(one,vbar(m,p,-1),v(m,q,-1)), 0, "d(vbar(-).A.v(-))=0") - end if - print *, "*** Checking polarisation vectors: ***" - call expect (conjg(eps(m,p, 1))*eps(m,p, 1), -1, "e( 1).e( 1)=-1") - call expect (conjg(eps(m,p, 1))*eps(m,p,-1), 0, "e( 1).e(-1)= 0") - call expect (conjg(eps(m,p,-1))*eps(m,p, 1), 0, "e(-1).e( 1)= 0") - call expect (conjg(eps(m,p,-1))*eps(m,p,-1), -1, "e(-1).e(-1)=-1") - call expect ( p*eps(m,p, 1), 0, " p.e( 1)= 0") - call expect ( p*eps(m,p,-1), 0, " p.e(-1)= 0") - if (m > 0) then - call expect (conjg(eps(m,p, 1))*eps(m,p, 0), 0, "e( 1).e( 0)= 0") - call expect (conjg(eps(m,p, 0))*eps(m,p, 1), 0, "e( 0).e( 1)= 0") - call expect (conjg(eps(m,p, 0))*eps(m,p, 0), -1, "e( 0).e( 0)=-1") - call expect (conjg(eps(m,p, 0))*eps(m,p,-1), 0, "e( 0).e(-1)= 0") - call expect (conjg(eps(m,p,-1))*eps(m,p, 0), 0, "e(-1).e( 0)= 0") - call expect ( p*eps(m,p, 0), 0, " p.e( 0)= 0") - end if - print *, "*** Checking epsilon tensor: ***" - call expect ( pseudo_scalar(eps(m,p,1),eps(m,q,1),eps(m,p,0),eps(m,q,0)), & - - pseudo_scalar(eps(m,q,1),eps(m,p,1),eps(m,p,0),eps(m,q,0)), "eps(1<->2)") - call expect ( pseudo_scalar(eps(m,p,1),eps(m,q,1),eps(m,p,0),eps(m,q,0)), & - - pseudo_scalar(eps(m,p,0),eps(m,q,1),eps(m,p,1),eps(m,q,0)), "eps(1<->3)") - call expect ( pseudo_scalar(eps(m,p,1),eps(m,q,1),eps(m,p,0),eps(m,q,0)), & - - pseudo_scalar(eps(m,q,0),eps(m,q,1),eps(m,p,0),eps(m,p,1)), "eps(1<->4)") - call expect ( pseudo_scalar(eps(m,p,1),eps(m,q,1),eps(m,p,0),eps(m,q,0)), & - - pseudo_scalar(eps(m,p,1),eps(m,p,0),eps(m,q,1),eps(m,q,0)), "eps(2<->3)") - call expect ( pseudo_scalar(eps(m,p,1),eps(m,q,1),eps(m,p,0),eps(m,q,0)), & - - pseudo_scalar(eps(m,p,1),eps(m,q,0),eps(m,p,0),eps(m,q,1)), "eps(2<->4)") - call expect ( pseudo_scalar(eps(m,p,1),eps(m,q,1),eps(m,p,0),eps(m,q,0)), & - - pseudo_scalar(eps(m,p,1),eps(m,q,1),eps(m,q,0),eps(m,p,0)), "eps(3<->4)") - call expect ( pseudo_scalar(eps(m,p,1),eps(m,q,1),eps(m,p,0),eps(m,q,0)), & - eps(m,p,1)*pseudo_vector(eps(m,q,1),eps(m,p,0),eps(m,q,0)), "eps'") - print *, "*** Checking tensors: ***" - call expect (conjg(p.wedge.q)*(p.wedge.q), (p*p)*(q*q)-(p*q)**2, & - "[p,q].[q,p]=p.p*q.q-p.q^2") - call expect (conjg(p.wedge.q)*(q.wedge.p), (p*q)**2-(p*p)*(q*q), & - "[p,q].[q,p]=p.q^2-p.p*q.q") - call expect (conjg(p.wedge.eps(m,p, 1))*(p.wedge.eps(m,p, 1)), -p*p, & - "[p,e( 1)].[p,e( 1)]=-p.p") - call expect (conjg(p.wedge.eps(m,p, 1))*(p.wedge.eps(m,p,-1)), 0, & - "[p,e( 1)].[p,e(-1)]=0") - call expect (conjg(p.wedge.eps(m,p,-1))*(p.wedge.eps(m,p, 1)), 0, & - "[p,e(-1)].[p,e( 1)]=0") - call expect (conjg(p.wedge.eps(m,p,-1))*(p.wedge.eps(m,p,-1)), -p*p, & - "[p,e(-1)].[p,e(-1)]=-p.p") - if (m > 0) then - call expect (conjg(p.wedge.eps(m,p, 1))*(p.wedge.eps(m,p, 0)), 0, & - "[p,e( 1)].[p,e( 0)]=0") - call expect (conjg(p.wedge.eps(m,p, 0))*(p.wedge.eps(m,p, 1)), 0, & - "[p,e( 0)].[p,e( 1)]=0") - call expect (conjg(p.wedge.eps(m,p, 0))*(p.wedge.eps(m,p, 0)), -p*p, & - "[p,e( 0)].[p,e( 0)]=-p.p") - call expect (conjg(p.wedge.eps(m,p, 0))*(p.wedge.eps(m,p,-1)), 0, & - "[p,e( 1)].[p,e(-1)]=0") - call expect (conjg(p.wedge.eps(m,p,-1))*(p.wedge.eps(m,p, 0)), 0, & - "[p,e(-1)].[p,e( 0)]=0") - end if - call expect (abs ((p.wedge.eps(m,p, 1))*p + (p*p)*eps(m,p, 1)), 0, & - "[p,e( 1)].p=-p.p*e( 1)]") - call expect (abs ((p.wedge.eps(m,p, 0))*p + (p*p)*eps(m,p, 0)), 0, & - "[p,e( 0)].p=-p.p*e( 0)]") - call expect (abs ((p.wedge.eps(m,p,-1))*p + (p*p)*eps(m,p,-1)), 0, & - "[p,e(-1)].p=-p.p*e(-1)]") - call expect (abs (p*(p.wedge.eps(m,p, 1)) - (p*p)*eps(m,p, 1)), 0, & - "p.[p,e( 1)]=p.p*e( 1)]") - call expect (abs (p*(p.wedge.eps(m,p, 0)) - (p*p)*eps(m,p, 0)), 0, & - "p.[p,e( 0)]=p.p*e( 0)]") - call expect (abs (p*(p.wedge.eps(m,p,-1)) - (p*p)*eps(m,p,-1)), 0, & - "p.[p,e(-1)]=p.p*e(-1)]") - print *, "*** Checking polarisation tensors: ***" - call expect (conjg(eps2(m,p, 2))*eps2(m,p, 2), 1, "e2( 2).e2( 2)=1") - call expect (conjg(eps2(m,p, 2))*eps2(m,p,-2), 0, "e2( 2).e2(-2)=0") - call expect (conjg(eps2(m,p,-2))*eps2(m,p, 2), 0, "e2(-2).e2( 2)=0") - call expect (conjg(eps2(m,p,-2))*eps2(m,p,-2), 1, "e2(-2).e2(-2)=1") - if (m > 0) then - call expect (conjg(eps2(m,p, 2))*eps2(m,p, 1), 0, "e2( 2).e2( 1)=0") - call expect (conjg(eps2(m,p, 2))*eps2(m,p, 0), 0, "e2( 2).e2( 0)=0") - call expect (conjg(eps2(m,p, 2))*eps2(m,p,-1), 0, "e2( 2).e2(-1)=0") - call expect (conjg(eps2(m,p, 1))*eps2(m,p, 2), 0, "e2( 1).e2( 2)=0") - call expect (conjg(eps2(m,p, 1))*eps2(m,p, 1), 1, "e2( 1).e2( 1)=1") - call expect (conjg(eps2(m,p, 1))*eps2(m,p, 0), 0, "e2( 1).e2( 0)=0") - call expect (conjg(eps2(m,p, 1))*eps2(m,p,-1), 0, "e2( 1).e2(-1)=0") - call expect (conjg(eps2(m,p, 1))*eps2(m,p,-2), 0, "e2( 1).e2(-2)=0") - call expect (conjg(eps2(m,p, 0))*eps2(m,p, 2), 0, "e2( 0).e2( 2)=0") - call expect (conjg(eps2(m,p, 0))*eps2(m,p, 1), 0, "e2( 0).e2( 1)=0") - call expect (conjg(eps2(m,p, 0))*eps2(m,p, 0), 1, "e2( 0).e2( 0)=1") - call expect (conjg(eps2(m,p, 0))*eps2(m,p,-1), 0, "e2( 0).e2(-1)=0") - call expect (conjg(eps2(m,p, 0))*eps2(m,p,-2), 0, "e2( 0).e2(-2)=0") - call expect (conjg(eps2(m,p,-1))*eps2(m,p, 2), 0, "e2(-1).e2( 2)=0") - call expect (conjg(eps2(m,p,-1))*eps2(m,p, 1), 0, "e2(-1).e2( 1)=0") - call expect (conjg(eps2(m,p,-1))*eps2(m,p, 0), 0, "e2(-1).e2( 0)=0") - call expect (conjg(eps2(m,p,-1))*eps2(m,p,-1), 1, "e2(-1).e2(-1)=1") - call expect (conjg(eps2(m,p,-1))*eps2(m,p,-2), 0, "e2(-1).e2(-2)=0") - call expect (conjg(eps2(m,p,-2))*eps2(m,p, 1), 0, "e2(-2).e2( 1)=0") - call expect (conjg(eps2(m,p,-2))*eps2(m,p, 0), 0, "e2(-2).e2( 0)=0") - call expect (conjg(eps2(m,p,-2))*eps2(m,p,-1), 0, "e2(-2).e2(-1)=0") - end if - call expect ( abs(p*eps2(m,p, 2) ), 0, " |p.e2( 2)| =0") - call expect ( abs(eps2(m,p, 2)*p), 0, " |e2( 2).p|=0") - call expect ( abs(p*eps2(m,p,-2) ), 0, " |p.e2(-2)| =0") - call expect ( abs(eps2(m,p,-2)*p), 0, " |e2(-2).p|=0") - if (m > 0) then - call expect ( abs(p*eps2(m,p, 1) ), 0, " |p.e2( 1)| =0") - call expect ( abs(eps2(m,p, 1)*p), 0, " |e2( 1).p|=0") - call expect ( abs(p*eps2(m,p, 0) ), 0, " |p.e2( 0)| =0") - call expect ( abs(eps2(m,p, 0)*p), 0, " |e2( 0).p|=0") - call expect ( abs(p*eps2(m,p,-1) ), 0, " |p.e2(-1)| =0") - call expect ( abs(eps2(m,p,-1)*p), 0, " |e2(-1).p|=0") - end if - print *, " *** Checking the graviton propagator:" - call expect (abs(p * (cmplx (p*p - m**2, m*w, kind=omega_prec) * & - pr_tensor(p,m,w,eps2(m,p,-2)))), 0, "p.pr.e(-2)") - call expect (abs(p * (cmplx (p*p - m**2, m*w, kind=omega_prec) * & - pr_tensor(p,m,w,eps2(m,p,-1)))), 0, "p.pr.e(-1)") - call expect (abs(p * (cmplx (p*p - m**2, m*w, kind=omega_prec) * & - pr_tensor(p,m,w,eps2(m,p,0)))), 0, "p.pr.e(0)") - call expect (abs(p * (cmplx (p*p - m**2, m*w, kind=omega_prec) * & - pr_tensor(p,m,w,eps2(m,p,1)))), 0, "p.pr.e(1)") - call expect (abs(p * (cmplx (p*p - m**2, m*w, kind=omega_prec) * & - pr_tensor(p,m,w,eps2(m,p,2)))), 0, "p.pr.e(2)") - call expect (abs(p * (cmplx (p*p - m**2, m*w, kind=omega_prec) * & - pr_tensor(p,m,w,ttest))), 0, "p.pr.ttest") -end program test_omega95 Index: tags/ohl/attic/omega-000.011beta/src/omega_bispinors.f95 =================================================================== --- tags/ohl/attic/omega-000.011beta/src/omega_bispinors.f95 (revision 8686) +++ tags/ohl/attic/omega-000.011beta/src/omega_bispinors.f95 (revision 8687) @@ -1,161 +0,0 @@ -! $Id: omegalib.nw,v 1.118.4.2 2006/05/15 08:39:27 ohl Exp $ -! -! Copyright (C) 2000-2002 by Thorsten Ohl -! and others -! -! O'Mega is free software; you can redistribute it and/or modify it -! under the terms of the GNU General Public License as published by -! the Free Software Foundation; either version 2, or (at your option) -! any later version. -! -! O'Mega is distributed in the hope that it will be useful, but -! WITHOUT ANY WARRANTY; without even the implied warranty of -! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -! GNU General Public License for more details. -! -! You should have received a copy of the GNU General Public License -! along with this program; if not, write to the Free Software -! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -module omega_bispinors - use omega_kinds - use omega_constants - implicit none - private - public :: operator (*), operator (+), operator (-) - public :: abs - type, public :: bispinor - ! private (omegalib needs access, but DON'T TOUCH IT!) - complex(kind=omega_prec), dimension(4) :: a - end type bispinor - interface operator (*) - module procedure spinor_product - end interface - private :: spinor_product - 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 - interface operator (+) - module procedure plus_bispinor - end interface - private :: plus_bispinor - interface operator (-) - module procedure neg_bispinor - end interface - private :: neg_bispinor - interface operator (+) - module procedure add_bispinor - end interface - private :: add_bispinor - interface operator (-) - module procedure sub_bispinor - end interface - private :: sub_bispinor - interface abs - module procedure abs_bispinor - end interface - private :: abs_bispinor - integer, parameter, public :: omega_bispinors_2003_03_A = 0 -contains - pure function spinor_product (psil, psir) result (psilpsir) - complex(kind=omega_prec) :: 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 - 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=double), 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=double), 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=double), 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=double), intent(in) :: x - type(bispinor), intent(in) :: y - xy%a = x * y%a - end function bispinor_dcomplex - 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 - 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 - pure function abs_bispinor (psi) result (x) - real(kind=omega_prec) :: x - type(bispinor), intent(in) :: psi - x = sqrt (dot_product (psi%a, psi%a)) - end function abs_bispinor -end module omega_bispinors Index: tags/ohl/attic/omega-000.011beta/src/omega_constants.f95 =================================================================== --- tags/ohl/attic/omega-000.011beta/src/omega_constants.f95 (revision 8686) +++ tags/ohl/attic/omega-000.011beta/src/omega_constants.f95 (revision 8687) @@ -1,25 +0,0 @@ -! $Id: omegalib.nw,v 1.118.4.2 2006/05/15 08:39:27 ohl Exp $ -! -! Copyright (C) 2000-2002 by Thorsten Ohl -! and others -! -! O'Mega is free software; you can redistribute it and/or modify it -! under the terms of the GNU General Public License as published by -! the Free Software Foundation; either version 2, or (at your option) -! any later version. -! -! O'Mega is distributed in the hope that it will be useful, but -! WITHOUT ANY WARRANTY; without even the implied warranty of -! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -! GNU General Public License for more details. -! -! You should have received a copy of the GNU General Public License -! along with this program; if not, write to the Free Software -! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -module omega_constants - use omega_kinds - implicit none - private - real(kind=omega_prec), parameter, public :: & - PI = 3.1415926535897932384626433832795028841972_omega_prec -end module omega_constants Index: tags/ohl/attic/omega-000.011beta/src/omega_parameters_simplest.f95 =================================================================== --- tags/ohl/attic/omega-000.011beta/src/omega_parameters_simplest.f95 (revision 8686) +++ tags/ohl/attic/omega-000.011beta/src/omega_parameters_simplest.f95 (revision 8687) @@ -1,237 +0,0 @@ -! At the moment this is a hard-coded file and not extracted from -! omegalib.nw -! -! Copyright (C) 2000-2004 by Thorsten Ohl -! and others -! -! O'Mega is free software; you can redistribute it and/or modify it -! under the terms of the GNU General Public License as published by -! the Free Software Foundation; either version 2, or (at your option) -! any later version. -! -! O'Mega is distributed in the hope that it will be useful, but -! WITHOUT ANY WARRANTY; without even the implied warranty of -! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -! GNU General Public License for more details. -! -! You should have received a copy of the GNU General Public License -! along with this program; if not, write to the Free Software -! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -module omega_parameters_simplest - use omega_kinds - use omega_constants - implicit none - private - public :: setup_parameters, print_parameters - real(kind=omega_prec), dimension(45), save, public :: mass = 0, width = 0 - real(kind=omega_prec), parameter, public :: GeV = 1.0_double - real(kind=omega_prec), parameter, public :: MeV = GeV / 1000 - real(kind=omega_prec), parameter, public :: keV = MeV / 1000 - real(kind=omega_prec), parameter, public :: TeV = GeV * 1000 - real(kind=omega_prec), save, public :: & - alpha = 1.0_double / 137.0359895_double, & - sin2thw = 0.23124_double - complex(kind=omega_prec), save, private :: vev - complex(kind=omega_prec), save, public :: & - qlep = 0, qup = 0, qdwn = 0, gcc = 0, qw = 0, & - gzww = 0, gwww = 0, ghww = 0, ghhww = 0, ghzz = 0, ghhzz = 0, & - ghbb = 0, ghtt = 0, ghcc = 0, ghtautau = 0, gh3 = 0, gh4 = 0, & - ghgaga = 0, ghgaz = 0, & - iqw = 0, igzww = 0, igwww = 0, & - gw4 = 0, gzzww = 0, gazww = 0, gaaww = 0, & - gs = 0, igs = 0 - complex(kind=omega_prec), save, public :: & - sinckm12 = 0, sinckm13 = 0, sinckm23 = 0, & - cosckm12 = 0, cosckm13 = 0, cosckm23 = 0 - complex(kind=omega_prec), save, public :: & - vckm_11 = 0, vckm_12 = 0, vckm_13 = 0, vckm_21 = 0, & - vckm_22 = 0, vckm_23 = 0, vckm_31 = 0, vckm_32 = 0, vckm_33 = 0 - complex(kind=omega_prec), save, public :: & - gccq11 = 0, gccq12 = 0, gccq13 = 0, gccq21 = 0, & - gccq22 = 0, gccq23 = 0, gccq31 = 0, gccq32 = 0, gccq33 = 0 - real(kind=omega_prec), save, public :: & - g1a = 1, g1z = 1, kappaa = 1, kappaz = 1, lambdaa = 0, lambdaz = 0, & - g4a = 0, g4z = 0, g5a = 0, g5z = 0, & - kappa5a = 0, kappa5z = 0, lambda5a = 0, lambda5z = 0, & - alpha4 = 0, alpha5 = 0, tau4 = 0, tau5 = 0 - real(kind=omega_prec), save, public :: xia = 1, xi0 = 1, xipm = 1 - complex(kind=omega_prec), dimension(2), save, public :: & - gnclep = 0, gncneu = 0, gncup = 0, gncdwn = 0 - complex(kind=omega_prec), save, public :: & - fudge_o1 = 1, fudge_o2 = 1, fudge_o3 = 1, fudge_o4 = 1 - complex(kind=omega_prec), save, public :: & - ghmumu = 0 - complex(kind=omega_prec), save, public :: & - ghaa = 0, ghgg = 0, geaa = 0, geaz = 0, gegg = 0 - complex(kind=omega_prec), save, public :: & - gh0ww = 0, gh0zz = 0, & - gh0tt = 0, gh0bb = 0, gh0cc = 0, gh0tautau = 0, gh0mumu = 0, & - iga0tt = 0, iga0bb = 0, iga0cc = 0, iga0tautau = 0, iga0mumu = 0, & - gahh = 0, gzhh = 0, igzha = 0, igzh0a = 0 - complex(kind=omega_prec), dimension(2), save, public :: & - ghptb = 0, ghpcs = 0, ghptaunu = 0, ghpmunu = 0 - !!! Specific simple group parameters - complex(kind=omega_prec), save, public :: & - gncx = 0, gncxt = 0, gncy = 0, gncyt = 0 - complex(kind=omega_prec), dimension(2), save, public :: & - gnchlep = 0, gnchneu = 0, gnchup = 0, gnchdwn = 0, & - gnchtop = 0, gnchbot = 0, gnchn = 0, & - gnchu = 0, gnchd = 0 - complex(kind=omega_prec), save, public :: & - ghhzzh = 0, iqzh = 0, igz1 = 0, igz2 = 0, igz3 = 0, & - igz4 = 0, igz5 = 0, igz6 = 0, i_gcc = 0, gnch = 0 - complex(kind=omega_prec), save, public :: & - ghtht = 0, ghhthth = 0, gncht = 0, ghqhq = 0, getht = 0 - complex(kind=omega_prec), save, public :: & - gzeh = 0, gzheh = 0, gebb = 0, gett = 0 -contains - subroutine setup_parameters () - real(kind=omega_prec) :: e, g, sinthw, costhw, qelep, qeup, qedwn - real(kind=omega_prec) :: sinth, costh, sinthp, costhp, & - sin2th, cos2th, sin2thp, cos2thp - real(kind=omega_prec) :: t_fac, tp_fac - mass(1) = 5.0 * MeV - mass(2) = 3.0 * MeV - mass(3) = 100.0 * MeV - mass(4) = 1.2 * GeV - mass(5) = 4.2 * GeV - mass(6) = 174.0 * GeV - width(1:5) = 0 - width(6) = 1.3 * GeV - mass(11) = 0.51099907 * MeV - mass(12) = 0 - mass(13) = 105.658389 * MeV - mass(14) = 0 - mass(15) = 1777.05 * MeV - mass(16) = 0 - width(11:16) = 0 - mass(21) = 0 - mass(22) = 0 - width(21:22) = 0 - mass(23) = 91.187 * GeV - width(23) = 2.490 * GeV - mass(24) = 80.41 * GeV - width(24) = 2.06 * GeV - mass(25) = 120.00 * GeV - width(25) = 5.00 * GeV - mass(35) = 10000 * GeV - width(35) = 0 - sinckm12 = 0.0_omega_prec - sinckm13 = 0.0_omega_prec - sinckm23 = 0.0_omega_prec - cosckm12 = sqrt ((1.0_omega_prec - (sinckm12**2))) - cosckm13 = sqrt ((1.0_omega_prec - (sinckm13**2))) - cosckm23 = sqrt ((1.0_omega_prec - (sinckm23**2))) - mass(26) = xi0 * mass(23) - width(26) = 0 - mass(27) = xipm * mass(24) - width(27) = 0 - e = sqrt (4 * PI * alpha) - qelep = - 1 - qeup = 2.0_omega_prec / 3.0_omega_prec - qedwn = - 1.0_omega_prec / 3.0_omega_prec - sinthw = sqrt (sin2thw) - costhw = sqrt (1 - sin2thw) - g = e / sinthw - gcc = - g / 2 / sqrt (2.0_double) - vckm_11 = cosckm12 * cosckm13 - vckm_12 = sinckm12 * cosckm13 - vckm_13 = sinckm13 - vckm_21 = - (sinckm12 * cosckm23 + & - cosckm12 * sinckm23 * sinckm13) - vckm_22 = cosckm12 * cosckm23 - & - sinckm12 * sinckm23 * sinckm13 - vckm_23 = sinckm23 * cosckm13 - vckm_31 = sinckm12 * sinckm23 - & - cosckm12 * cosckm23 * sinckm13 - vckm_32 = - (cosckm12 * sinckm23 + & - sinckm12 * cosckm23 * sinckm13) - vckm_33 = cosckm23 * cosckm13 - gccq11 = gcc * vckm_11 - gccq12 = gcc * vckm_12 - gccq13 = gcc * vckm_13 - gccq21 = gcc * vckm_21 - gccq22 = gcc * vckm_22 - gccq23 = gcc * vckm_23 - gccq31 = gcc * vckm_31 - gccq32 = gcc * vckm_32 - gccq33 = gcc * vckm_33 - gncneu(1) = - g / 2 / costhw * ( + 0.5_double) - gnclep(1) = - g / 2 / costhw * ( - 0.5_double - 2 * qelep * sin2thw) - gncup(1) = - g / 2 / costhw * ( + 0.5_double - 2 * qeup * sin2thw) - gncdwn(1) = - g / 2 / costhw * ( - 0.5_double - 2 * qedwn * sin2thw) - gncneu(2) = - g / 2 / costhw * ( + 0.5_double) - gnclep(2) = - g / 2 / costhw * ( - 0.5_double) - gncup(2) = - g / 2 / costhw * ( + 0.5_double) - gncdwn(2) = - g / 2 / costhw * ( - 0.5_double) - qlep = - e * qelep - qup = - e * qeup - qdwn = - e * qedwn - qw = e - iqw = (0,1)*qw - gzww = g * costhw - igzww = (0,1)*gzww - gwww = g - igwww = (0,1)*gwww - ghww = mass(24) * g - ghhww = g**2 / 2.0_omega_prec - ghzz = mass(23) * g / costhw - ghhzz = g**2 / 2.0_omega_prec / costhw**2 - gw4 = g**2 - gzzww = gzww**2 - gazww = gzww*e - gaaww = e**2 - vev = 2.0 * mass(24) / g - ghtt = - mass(6) / vev - ghbb = - mass(5) / vev - ghcc = - mass(4) / vev - ghtautau = - mass(15) / vev - gh3 = - 3 * mass(25)**2 / vev - gh4 = - 3 * mass(25)**2 / vev**2 - !!! Littlest Higgs specific couplings - sin2th = sinth**2 - cos2th = 1.0_omega_prec - sin2th - costh = sqrt(cos2th) - sin2thp = sinthp**2 - cos2thp = 1.0_omega_prec - sin2thp - costhp = sqrt(cos2thp) - t_fac = (cos2th - sin2th)/2.0_omega_prec/sinth/costh - tp_fac = (cos2thp - sin2thp)/2.0_omega_prec/sinthp/costhp - end subroutine setup_parameters - subroutine print_parameters () - print *, "Quark masses:" - print *, mass(2:6:2) - print *, mass(1:5:2) - print *, "Lepton masses:" - print *, mass(12:16:2) - print *, mass(11:15:2) - print *, "Quark widths:" - print *, width(2:6:2) - print *, width(1:5:2) - print *, "Lepton widths:" - print *, width(12:16:2) - print *, width(11:15:2) - print *, "SU(2)xU(1) Gauge boson masses/widths:" - print *, mass(22:24) - print *, width(22:24) - print *, "Higgs boson and gluon masses/widths:" - print *, mass(25), mass(21) - print *, width(25), width(21) - print *, "Neutral current couplings:" - print *, "U:", gncup - print *, "D:", gncdwn - print *, "N:", gncneu - print *, "L:", gnclep - print *, "Fermion charges:" - print *, "U:", qup - print *, "D:", qdwn - print *, "L:", qlep - print *, "TGC:" - print *, "WWA:", iqw - print *, "WWZ:", igzww - print *, "WWW:", igwww - print *, "WWH:", ghww - print *, "WWHH:", ghhww - print *, "ZZHH:", ghhzz - end subroutine print_parameters -end module omega_parameters_simplest Index: tags/ohl/attic/omega-000.011beta/src/omega_tensors.f95 =================================================================== --- tags/ohl/attic/omega-000.011beta/src/omega_tensors.f95 (revision 8686) +++ tags/ohl/attic/omega-000.011beta/src/omega_tensors.f95 (revision 8687) @@ -1,242 +0,0 @@ -! $Id: omegalib.nw,v 1.118.4.2 2006/05/15 08:39:27 ohl Exp $ -! -! Copyright (C) 2000-2002 by Thorsten Ohl -! and others -! -! O'Mega is free software; you can redistribute it and/or modify it -! under the terms of the GNU General Public License as published by -! the Free Software Foundation; either version 2, or (at your option) -! any later version. -! -! O'Mega is distributed in the hope that it will be useful, but -! WITHOUT ANY WARRANTY; without even the implied warranty of -! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -! GNU General Public License for more details. -! -! You should have received a copy of the GNU General Public License -! along with this program; if not, write to the Free Software -! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -module omega_tensors - use omega_kinds - use omega_constants - use omega_vectors - implicit none - private - public :: operator (*), operator (+), operator (-), & - operator (.tprod.) - public :: abs, conjg - - - type, public :: tensor - ! private (omegalib needs access, but DON'T TOUCH IT!) - complex(kind=omega_prec), dimension(0:3,0:3) :: t - end type tensor - 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 - interface operator (+) - module procedure plus_tensor - end interface - private :: plus_tensor - interface operator (-) - module procedure neg_tensor - end interface - private :: neg_tensor - interface operator (+) - module procedure add_tensor - end interface - private :: add_tensor - interface operator (-) - module procedure sub_tensor - end interface - private :: 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 - interface abs - module procedure abs_tensor - end interface - private :: abs_tensor - interface conjg - module procedure conjg_tensor - end interface - private :: 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 - integer, parameter, public :: omega_tensors_2003_03_A = 0 -contains - 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=double), 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=double), intent(in) :: x - type(tensor), intent(in) :: y - type(tensor) :: xy - xy%t = x * y%t - end function dcomplex_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 - 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 - 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 - pure function abs_tensor (t) result (abs_t) - type(tensor), intent(in) :: t - real(kind=omega_prec) :: abs_t - abs_t = sqrt (sum ((abs (t%t))**2)) - end function abs_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 - pure function tensor_tensor (t1, t2) result (t1t2) - type(tensor), intent(in) :: t1 - type(tensor), intent(in) :: t2 - complex(kind=omega_prec) :: 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 -end module omega_tensors Index: tags/ohl/attic/omega-000.011beta/src/omega_polarizations_madgraph.f95 =================================================================== --- tags/ohl/attic/omega-000.011beta/src/omega_polarizations_madgraph.f95 (revision 8686) +++ tags/ohl/attic/omega-000.011beta/src/omega_polarizations_madgraph.f95 (revision 8687) @@ -1,111 +0,0 @@ -! $Id: omegalib.nw,v 1.118.4.2 2006/05/15 08:39:27 ohl Exp $ -! -! Copyright (C) 2000-2002 by Thorsten Ohl -! and others -! -! O'Mega is free software; you can redistribute it and/or modify it -! under the terms of the GNU General Public License as published by -! the Free Software Foundation; either version 2, or (at your option) -! any later version. -! -! O'Mega is distributed in the hope that it will be useful, but -! WITHOUT ANY WARRANTY; without even the implied warranty of -! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -! GNU General Public License for more details. -! -! You should have received a copy of the GNU General Public License -! along with this program; if not, write to the Free Software -! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -module omega_polarizations_madgraph - use omega_kinds - use omega_constants - use omega_vectors - implicit none - private - public :: eps - integer, parameter, public :: omega_pols_madgraph_2003_03_A = 0 -contains - pure function eps (m, k, s) result (e) - type(vector) :: e - real(kind=omega_prec), intent(in) :: m - type(momentum), intent(in) :: k - integer, intent(in) :: s - real(kind=omega_prec) :: kt, kabs, kabs2, sqrt2 - sqrt2 = sqrt (2.0_omega_prec) - 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=omega_prec) / sqrt2 - e%x(2) = cmplx ( 0, - 1, kind=omega_prec) / sqrt2 - else - e%x(1) = cmplx ( 1, 0, kind=omega_prec) / sqrt2 - e%x(2) = cmplx ( 0, - 1, kind=omega_prec) / sqrt2 - end if - else - e%x(1) = cmplx ( - k%x(3)*k%x(1)/kabs, & - k%x(2), kind=omega_prec) / kt / sqrt2 - e%x(2) = cmplx ( - k%x(2)*k%x(3)/kabs, & - - k%x(1), kind=omega_prec) / 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=omega_prec) / sqrt2 - e%x(2) = cmplx ( 0, - 1, kind=omega_prec) / sqrt2 - else - e%x(1) = cmplx ( -1, 0, kind=omega_prec) / sqrt2 - e%x(2) = cmplx ( 0, - 1, kind=omega_prec) / sqrt2 - end if - else - e%x(1) = cmplx ( k%x(3)*k%x(1)/kabs, & - k%x(2), kind=omega_prec) / kt / sqrt2 - e%x(2) = cmplx ( k%x(2)*k%x(3)/kabs, & - - k%x(1), kind=omega_prec) / 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=omega_prec) / sqrt2 - e%x(2) = cmplx ( 0, - 1, kind=omega_prec) / sqrt2 - case (-1) - e%x(1) = cmplx ( 1, 0, kind=omega_prec) / sqrt2 - e%x(2) = cmplx ( 0, - 1, kind=omega_prec) / 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 -end module omega_polarizations_madgraph Index: tags/ohl/attic/omega-000.011beta/src/omega_vspinor_polarizations.f95 =================================================================== --- tags/ohl/attic/omega-000.011beta/src/omega_vspinor_polarizations.f95 (revision 8686) +++ tags/ohl/attic/omega-000.011beta/src/omega_vspinor_polarizations.f95 (revision 8687) @@ -1,184 +0,0 @@ -! $Id: omegalib.nw,v 1.118.4.2 2006/05/15 08:39:27 ohl Exp $ -! -! Copyright (C) 2000-2002 by Thorsten Ohl -! and others -! -! O'Mega is free software; you can redistribute it and/or modify it -! under the terms of the GNU General Public License as published by -! the Free Software Foundation; either version 2, or (at your option) -! any later version. -! -! O'Mega is distributed in the hope that it will be useful, but -! WITHOUT ANY WARRANTY; without even the implied warranty of -! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -! GNU General Public License for more details. -! -! You should have received a copy of the GNU General Public License -! along with this program; if not, write to the Free Software -! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -module omega_vspinor_polarizations - use omega_kinds - use omega_constants - use omega_vectors - use omega_bispinors - use omega_bispinor_couplings - use omega_vectorspinors - implicit none - public :: ueps, veps - private :: eps - private :: outer_product - integer, parameter, public :: omega_vspinor_pols_2003_03_A = 0 -contains - pure function eps (m, k, s) result (e) - type(vector) :: e - real(kind=omega_prec), intent(in) :: m - type(momentum), intent(in) :: k - integer, intent(in) :: s - real(kind=omega_prec) :: kabs, kabs2, sqrt2 - real(kind=omega_prec) :: cos_phi, sin_phi, cos_th, sin_th - complex(kind=omega_prec) :: epiphi, emiphi - sqrt2 = sqrt (2.0_omega_prec) - kabs2 = dot_product (k%x, k%x) - if (kabs2 > 0) then - kabs = sqrt (kabs2) - if ((k%x(1) == 0) .and. (k%x(2) == 0)) then - cos_phi = 1 - sin_phi = 0 - else - cos_phi = k%x(1) / sqrt(k%x(1)**2 + k%x(2)**2) - sin_phi = k%x(2) / sqrt(k%x(1)**2 + k%x(2)**2) - end if - cos_th = k%x(3) / kabs - sin_th = sqrt(1 - cos_th**2) - epiphi = cos_phi + (0,1) * sin_phi - emiphi = cos_phi - (0,1) * sin_phi - e%t = 0 - e%x = 0 - select case (s) - case (1) - e%x(1) = epiphi * (-cos_th * cos_phi + (0,1) * sin_phi) / sqrt2 - e%x(2) = epiphi * (-cos_th * sin_phi - (0,1) * cos_phi) / sqrt2 - e%x(3) = epiphi * ( sin_th / sqrt2) - case (-1) - e%x(1) = emiphi * ( cos_th * cos_phi + (0,1) * sin_phi) / sqrt2 - e%x(2) = emiphi * ( cos_th * sin_phi - (0,1) * cos_phi) / sqrt2 - e%x(3) = emiphi * (-sin_th / sqrt2) - case (0) - if (m > 0) then - e%t = kabs / m - e%x = k%t / (m*kabs) * k%x - end if - case (4) - if (m > 0) then - e = (1 / m) * k - else - e = (1 / k%t) * k - end if - end select - else !!! for particles in their rest frame defined to be - !!! polarized along the 3-direction - e%t = 0 - e%x = 0 - select case (s) - case (1) - e%x(1) = cmplx ( - 1, 0, kind=omega_prec) / sqrt2 - e%x(2) = cmplx ( 0, 1, kind=omega_prec) / sqrt2 - case (-1) - e%x(1) = cmplx ( 1, 0, kind=omega_prec) / sqrt2 - e%x(2) = cmplx ( 0, 1, kind=omega_prec) / 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=omega_prec), 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_omega_prec)) * (outer_product (ep, um) & - + sqrt (2.0_omega_prec) * 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_omega_prec)) * (sqrt (2.0_omega_prec) * & - 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=omega_prec), 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_omega_prec)) * (outer_product (ep, vm) & - + sqrt (2.0_omega_prec) * 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_omega_prec)) * (sqrt (2.0_omega_prec) & - * 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 -end module omega_vspinor_polarizations Index: tags/ohl/attic/omega-000.011beta/src/omega_testtools.f95 =================================================================== --- tags/ohl/attic/omega-000.011beta/src/omega_testtools.f95 (revision 8686) +++ tags/ohl/attic/omega-000.011beta/src/omega_testtools.f95 (revision 8687) @@ -1,97 +0,0 @@ -! $Id: omegalib.nw,v 1.118.4.2 2006/05/15 08:39:27 ohl Exp $ -! -! Copyright (C) 2000-2002 by Thorsten Ohl -! and others -! -! O'Mega is free software; you can redistribute it and/or modify it -! under the terms of the GNU General Public License as published by -! the Free Software Foundation; either version 2, or (at your option) -! any later version. -! -! O'Mega is distributed in the hope that it will be useful, but -! WITHOUT ANY WARRANTY; without even the implied warranty of -! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -! GNU General Public License for more details. -! -! You should have received a copy of the GNU General Public License -! along with this program; if not, write to the Free Software -! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -module omega_testtools - use omega_kinds - implicit none - private - public :: print_matrix - public :: expect - real(kind=omega_prec), parameter, private :: TOLERANCE = 1.0e8 - interface expect - module procedure expect_integer, expect_real, expect_complex, & - expect_double_integer, expect_complex_integer, expect_complex_real - end interface - private :: expect_integer, expect_real, expect_complex, & - expect_double_integer, expect_complex_integer, expect_complex_real -contains - subroutine print_matrix (a) - complex(kind=omega_prec), 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 - subroutine expect_integer (x, x0, msg) - integer, intent(in) :: x, x0 - character(len=*), intent(in) :: msg - if (x == x0) then - print *, msg, " passed" - else - print *, msg, " FAILED: expected ", x0, " got ", x - end if - end subroutine expect_integer - subroutine expect_real (x, x0, msg) - real(kind=omega_prec), intent(in) :: x, x0 - character(len=*), intent(in) :: msg - if (x == x0) then - print *, msg, " passed exactly" - else if (abs (x - x0) <= epsilon (x)) then - print *, msg, " passed at machine precision" - else if (abs (x - x0) <= TOLERANCE * epsilon (x)) then - print *, msg, " passed at", & - ceiling (abs (x - x0) / epsilon (x)), "* machine precision" - else - print *, msg, " FAILED: expected ", x0, " got ", x, " (", & - (x - x0) / epsilon (x), " epsilon)" - end if - end subroutine expect_real - subroutine expect_complex (x, x0, msg) - complex(kind=omega_prec), intent(in) :: x, x0 - character(len=*), intent(in) :: msg - if (x == x0) then - print *, msg, " passed exactly" - else if (abs (x - x0) <= epsilon (real(x))) then - print *, msg, " passed at machine precision" - else if (abs (x - x0) <= TOLERANCE * epsilon (real(x))) then - print *, msg, " passed at", & - ceiling (abs (x - x0) / epsilon (real(x))), "* machine precision" - else - print *, msg, " FAILED: expected ", x0, " got ", x, " (", & - (x - x0) / epsilon (real(x)), " epsilon)" - end if - end subroutine expect_complex - subroutine expect_double_integer (x, x0, msg) - real(kind=omega_prec), intent(in) :: x - integer, intent(in) :: x0 - character(len=*), intent(in) :: msg - call expect_real (x, real (x0, kind=omega_prec), msg) - end subroutine expect_double_integer - subroutine expect_complex_integer (x, x0, msg) - complex(kind=omega_prec), intent(in) :: x - integer, intent(in) :: x0 - character(len=*), intent(in) :: msg - call expect_complex (x, cmplx (x0, kind=omega_prec), msg) - end subroutine expect_complex_integer - subroutine expect_complex_real (x, x0, msg) - complex(kind=omega_prec), intent(in) :: x - real(kind=omega_prec), intent(in) :: x0 - character(len=*), intent(in) :: msg - call expect_complex (x, cmplx (x0, kind=omega_prec), msg) - end subroutine expect_complex_real -end module omega_testtools Index: tags/ohl/attic/omega-000.011beta/src/omega_utils.f95 =================================================================== --- tags/ohl/attic/omega-000.011beta/src/omega_utils.f95 (revision 8686) +++ tags/ohl/attic/omega-000.011beta/src/omega_utils.f95 (revision 8687) @@ -1,904 +0,0 @@ -! $Id: omega_utils.f95,v 1.6.2.3 2006/05/15 12:52:32 ohl Exp $ -! -! Copyright (C) 2000-2002 by Thorsten Ohl -! and others -! -! O'Mega is free software; you can redistribute it and/or modify it -! under the terms of the GNU General Public License as published by -! the Free Software Foundation; either version 2, or (at your option) -! any later version. -! -! O'Mega is distributed in the hope that it will be useful, but -! WITHOUT ANY WARRANTY; without even the implied warranty of -! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -! GNU General Public License for more details. -! -! You should have received a copy of the GNU General Public License -! along with this program; if not, write to the Free Software -! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -module omega_utils - use omega_kinds - use omega_vectors - use omega_polarizations - implicit none - private - public :: omega_ward_warn, omega_ward_panic - public :: omega_slavnov_warn, omega_slavnov_panic - public :: omega_check_arguments_warn, omega_check_arguments_panic - public :: omega_check_helicities_warn, omega_check_helicities_panic - private :: omega_check_helicity - public :: omega_check_momenta_warn, omega_check_momenta_panic - private :: check_momentum_conservation, check_mass_shell - public :: omega_spin_sum_sqme_1, omega_sum_sqme - public :: omega_spin_sum_sqme_1_nonzero, omega_sum_sqme_nonzero - public :: omega_amplitude_1_nonzero, omega_amplitude_2_nonzero - public :: omega_scatter, omega_scatter_nonzero - public :: omega_scatter_diagonal, omega_scatter_diagonal_nonzero - public :: omega_sum, omega_sum_nonzero, omega_nonzero - private :: state_index - public :: num_states - integer, parameter, private :: MOMENTUM_TOLERANCE = 10000 - integer, parameter, private :: ON_SHELL_TOLERANCE = 1000000 - integer, parameter, private :: REPEAT = 5, SAMPLE = 10 - integer, parameter, public :: omega_utils_2003_03_A = 0 -contains - subroutine omega_ward_warn (name, m, k, e) - character(len=*), intent(in) :: name - real(kind=omega_prec), intent(in) :: m - type(momentum), intent(in) :: k - type(vector), intent(in) :: e - type(vector) :: ek - real(kind=omega_prec) :: 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=omega_prec), intent(in) :: m - type(momentum), intent(in) :: k - type(vector), intent(in) :: e - type(vector) :: ek - real(kind=omega_prec) :: 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 - subroutine omega_slavnov_warn (name, m, k, e, phi) - character(len=*), intent(in) :: name - real(kind=omega_prec), intent(in) :: m - type(momentum), intent(in) :: k - type(vector), intent(in) :: e - complex(kind=omega_prec), intent(in) :: phi - type(vector) :: ek - real(kind=omega_prec) :: 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=omega_prec), intent(in) :: m - type(momentum), intent(in) :: k - type(vector), intent(in) :: e - complex(kind=omega_prec), intent(in) :: phi - type(vector) :: ek - real(kind=omega_prec) :: 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 - subroutine omega_check_arguments_warn (n, k, s) - integer, intent(in) :: n - real(kind=omega_prec), dimension(0:,:), intent(in) :: k - integer, dimension(:), intent(in) :: s - integer :: i - i = size(k,dim=1) - if (i /= 4) then - print *, "O'Mega: warning: wrong # of dimensions:", i - end if - i = size(k,dim=2) - if (i /= n) then - print *, "O'Mega: warning: wrong # of momenta:", i, & - ", expected", n - end if - i = size (s) - if (i /= n) then - print *, "O'Mega: warning: wrong # of spins:", i, & - ", expected", n - end if - end subroutine omega_check_arguments_warn - subroutine omega_check_arguments_panic (n, k, s) - integer, intent(in) :: n - real(kind=omega_prec), dimension(0:,:), intent(in) :: k - integer, dimension(:), intent(in) :: s - logical :: error - integer :: i - error = .false. - i = size(k,dim=1) - if (i /= n) then - print *, "O'Mega: warning: wrong # of dimensions:", i - error = .true. - end if - i = size(k,dim=2) - if (i /= n) then - print *, "O'Mega: warning: wrong # of momenta:", i, & - ", expected", n - error = .true. - end if - i = size (s) - if (i /= n) then - print *, "O'Mega: warning: wrong # of spins:", i, & - ", expected", n - error = .true. - end if - if (error) then - stop - end if - end subroutine omega_check_arguments_panic - function omega_check_helicity (m, smax, s) result (error) - real(kind=omega_prec), 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_omega_prec) 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=omega_prec), 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=omega_prec), 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 - function check_momentum_conservation (k) result (error) - real(kind=omega_prec), 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 - function check_mass_shell (m, k) result (error) - real(kind=omega_prec), intent(in) :: m - real(kind=omega_prec), dimension(0:), intent(in) :: k - real(kind=omega_prec) :: 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=omega_prec), dimension(:), intent(in) :: m - real(kind=omega_prec), 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=omega_prec), dimension(:), intent(in) :: m - real(kind=omega_prec), 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 - pure function omega_spin_sum_sqme_1 & - (amplitude_1, k, f, s_max, smask) result (amp2) - real(kind=omega_prec), dimension(0:,:), intent(in) :: k - integer, intent(in) :: f, s_max - logical, dimension(:), intent(in), optional :: smask - real(kind=omega_prec) :: amp2 - interface - pure function amplitude_1 (k, s, f) result (amp) - use omega_kinds - implicit none - real(kind=omega_prec), dimension(0:,:), intent(in) :: k - integer, intent(in) :: s, f - complex(kind=omega_prec) :: amp - end function amplitude_1 - end interface - complex(kind=omega_prec) :: amp - integer :: s - amp2 = 0 - if (present (smask)) then - do s = 1, s_max - if (smask(s)) then - amp = amplitude_1 (k, s, f) - amp2 = amp2 + amp * conjg (amp) - end if - end do - else - do s = 1, s_max - amp = amplitude_1 (k, s, f) - amp2 = amp2 + amp * conjg (amp) - end do - end if - end function omega_spin_sum_sqme_1 - pure function omega_sum_sqme & - (amplitude_1, k, s_max, f_max, mult, smask, fmask) result (amp2) - real(kind=omega_prec), dimension(0:,:), intent(in) :: k - integer, intent(in) :: s_max, f_max - integer, dimension(:), intent(in) :: mult - logical, dimension(:), intent(in), optional :: smask, fmask - real(kind=omega_prec) :: amp2 - interface - pure function amplitude_1 (k, s, f) result (amp) - use omega_kinds - implicit none - real(kind=omega_prec), dimension(0:,:), intent(in) :: k - integer, intent(in) :: s, f - complex(kind=omega_prec) :: amp - end function amplitude_1 - end interface - complex(kind=omega_prec) :: amp - integer :: s, f - amp2 = 0 - if (present (smask)) then - if (present (fmask)) then - do s = 1, s_max - if (smask(s)) then - do f = 1, f_max - if (fmask(f)) then - amp = amplitude_1 (k, s, f) - amp2 = amp2 + amp * conjg (amp) / mult(f) - end if - end do - end if - end do - else - do s = 1, s_max - if (smask(s)) then - do f = 1, f_max - amp = amplitude_1 (k, s, f) - amp2 = amp2 + amp * conjg (amp) / mult(f) - end do - end if - end do - end if - else - if (present (fmask)) then - do f = 1, f_max - if (fmask(f)) then - do s = 1, s_max - amp = amplitude_1 (k, s, f) - amp2 = amp2 + amp * conjg (amp) / mult(f) - end do - end if - end do - else - do s = 1, s_max - do f = 1, f_max - amp = amplitude_1 (k, s, f) - amp2 = amp2 + amp * conjg (amp) / mult(f) - end do - end do - end if - end if - end function omega_sum_sqme - pure subroutine omega_spin_sum_sqme_1_nonzero & - (amplitude_1, amp2, k, f, zero, n, smask) - real(kind=omega_prec), intent(out) :: amp2 - real(kind=omega_prec), dimension(0:,:), intent(in) :: k - integer, intent(in) :: f - integer, dimension(:,:), intent(inout) :: zero - integer, intent(in) :: n - logical, dimension(:), intent(in), optional :: smask - interface - pure function amplitude_1 (k, s, f) result (amp) - use omega_kinds - implicit none - real(kind=omega_prec), dimension(0:,:), intent(in) :: k - integer, intent(in) :: s, f - complex(kind=omega_prec) :: amp - end function amplitude_1 - end interface - complex(kind=omega_prec) :: amp - real(kind=omega_prec) :: dummy - integer :: s, i - if (n <= SAMPLE) then - call omega_sum_sqme_nonzero & - (amplitude_1, dummy, k, (/ (1, i = 1, size(zero,dim=2)) /), zero, n) - end if - amp2 = 0 - if (present (smask)) then - do s = 1, size(zero,dim=1) - if (smask(s)) then - if (zero(s,f) <= REPEAT) then - amp = amplitude_1 (k, s, f) - amp2 = amp2 + amp * conjg (amp) - end if - end if - end do - else - do s = 1, size(zero,dim=1) - if (zero(s,f) <= REPEAT) then - amp = amplitude_1 (k, s, f) - amp2 = amp2 + amp * conjg (amp) - end if - end do - end if - end subroutine omega_spin_sum_sqme_1_nonzero - pure subroutine omega_sum_sqme_nonzero & - (amplitude_1, amp2, k, mult, zero, n, smask, fmask) - real(kind=omega_prec), intent(out) :: amp2 - real(kind=omega_prec), dimension(0:,:), intent(in) :: k - integer, dimension(:), intent(in) :: mult - integer, dimension(:,:), intent(inout) :: zero - integer, intent(in) :: n - logical, dimension(:), intent(in), optional :: smask, fmask - interface - pure function amplitude_1 (k, s, f) result (amp) - use omega_kinds - implicit none - real(kind=omega_prec), dimension(0:,:), intent(in) :: k - integer, intent(in) :: s, f - complex(kind=omega_prec) :: amp - end function amplitude_1 - end interface - complex(kind=omega_prec) :: amp - integer :: s, f - if (n <= SAMPLE) then - do s = 1, size(zero,dim=1) - do f = 1, size(zero,dim=2) - if (zero(s,f) <= REPEAT) then - amp = amplitude_1 (k, s, f) - if (real (amp * conjg (amp), kind=omega_prec) & - <= tiny (1.0_omega_prec)) then - zero(s,f) = zero(s,f) + 1 - end if - end if - end do - end do - end if - amp2 = 0 - if (present (smask)) then - if (present (fmask)) then - do s = 1, size(zero,dim=1) - if (smask(s)) then - do f = 1, size(zero,dim=2) - if (fmask(f)) then - if (zero(s,f) <= REPEAT) then - amp = amplitude_1 (k, s, f) - amp2 = amp2 + amp * conjg (amp) / mult(f) - end if - end if - end do - end if - end do - else - do s = 1, size(zero,dim=1) - if (smask(s)) then - do f = 1, size(zero,dim=2) - if (zero(s,f) <= REPEAT) then - amp = amplitude_1 (k, s, f) - amp2 = amp2 + amp * conjg (amp) / mult(f) - end if - end do - end if - end do - end if - else - if (present (fmask)) then - do f = 1, size(zero,dim=2) - if (fmask(f)) then - do s = 1, size(zero,dim=1) - if (zero(s,f) <= REPEAT) then - amp = amplitude_1 (k, s, f) - amp2 = amp2 + amp * conjg (amp) / mult(f) - end if - end do - end if - end do - else - do s = 1, size(zero,dim=1) - do f = 1, size(zero,dim=2) - if (zero(s,f) <= REPEAT) then - amp = amplitude_1 (k, s, f) - amp2 = amp2 + amp * conjg (amp) / mult(f) - end if - end do - end do - end if - end if - end subroutine omega_sum_sqme_nonzero - pure subroutine omega_amplitude_1_nonzero & - (amplitude_1, amp, k, s, f, zero, n) - complex(kind=omega_prec), intent(out) :: amp - real(kind=omega_prec), dimension(0:,:), intent(in) :: k - integer, intent(in) :: s, f - integer, dimension(:,:), intent(inout) :: zero - integer, intent(in) :: n - interface - pure function amplitude_1 (k, s, f) result (amp) - use omega_kinds - implicit none - real(kind=omega_prec), dimension(0:,:), intent(in) :: k - integer, intent(in) :: s, f - complex(kind=omega_prec) :: amp - end function amplitude_1 - end interface - integer :: i - real(kind=omega_prec) :: dummy - if (n <= SAMPLE) then - call omega_sum_sqme_nonzero & - (amplitude_1, dummy, k, (/ (1, i = 1, size(zero,dim=2)) /), zero, n) - end if - if (zero(s,f) < REPEAT) then - amp = amplitude_1 (k, s, f) - else - amp = 0 - end if - end subroutine omega_amplitude_1_nonzero - pure subroutine omega_amplitude_2_nonzero & - (amplitude_2, amp, k, s_in, f_in, s_out, f_out, zero, n) - complex(kind=omega_prec), intent(out) :: amp - real(kind=omega_prec), dimension(0:,:), intent(in) :: k - integer, intent(in) :: s_in, f_in, s_out, f_out - integer, dimension(:,:,:,:), intent(inout) :: zero - integer, intent(in) :: n - interface - pure function amplitude_2 (k, s_in, f_in, s_out, f_out) result (amp) - use omega_kinds - implicit none - real(kind=omega_prec), dimension(0:,:), intent(in) :: k - integer, intent(in) :: s_in, f_in, s_out, f_out - complex(kind=omega_prec) :: amp - end function amplitude_2 - end interface - integer :: si, fi, so, fo - if (n <= SAMPLE) then - do si = 1, size(zero,dim=1) - do fi = 1, size(zero,dim=2) - do so = 1, size(zero,dim=3) - do fo = 1, size(zero,dim=4) - if (zero(si,fi,so,fo) <= REPEAT) then - amp = amplitude_2 (k, si, fi, so, fo) - if (real (amp * conjg (amp), kind=omega_prec) & - <= tiny (1.0_omega_prec)) then - zero(si,fi,so,fo) = zero(si,fi,so,fo) + 1 - end if - end if - end do - end do - end do - end do - end if - if (zero(s_in,f_in,s_out,f_out) < REPEAT) then - amp = amplitude_2 (k, s_in, f_in, s_out, f_out) - else - amp = 0 - end if - end subroutine omega_amplitude_2_nonzero - pure subroutine omega_scatter (amplitude_2, k, rho_in, rho_out, mult) - real(kind=omega_prec), dimension(0:,:), intent(in) :: k - complex(kind=omega_prec), dimension(:,:,:,:), intent(in) :: rho_in - complex(kind=omega_prec), dimension(:,:,:,:), intent(inout) :: rho_out - integer, dimension(:), intent(in) :: mult - interface - pure function amplitude_2 (k, s_in, f_in, s_out, f_out) result (amp) - use omega_kinds - implicit none - real(kind=omega_prec), dimension(0:,:), intent(in) :: k - integer, intent(in) :: s_in, f_in, s_out, f_out - complex(kind=omega_prec) :: amp - end function amplitude_2 - end interface - integer :: s_in1, s_in2, f_in1, f_in2, s_out1, s_out2, f_out1, f_out2 - complex(kind=omega_prec), & - dimension(size(rho_in,dim=1),size(rho_in,dim=2),& - size(rho_out,dim=1),size(rho_out,dim=2)) :: a - do s_in1 = 1, size(rho_in,dim=1) - do f_in1 = 1, size(rho_in,dim=2) - do s_out1 = 1, size(rho_out,dim=1) - do f_out1 = 1, size(rho_out,dim=2) - a(s_in1,f_in1,s_out1,f_out1) = & - amplitude_2 (k, s_in1, f_in1, s_out1, f_out1) & - / sqrt (real (mult(f_out1), kind=omega_prec)) - end do - end do - end do - end do - do s_out1 = 1, size(rho_out,dim=1) - do f_out1 = 1, size(rho_out,dim=2) - do s_out2 = 1, size(rho_out,dim=3) - do f_out2 = 1, size(rho_out,dim=4) - rho_out(s_out1,f_out1,s_out2,f_out2) = 0 - do s_in1 = 1, size(rho_in,dim=1) - do f_in1 = 1, size(rho_in,dim=2) - do s_in2 = 1, size(rho_in,dim=3) - do f_in2 = 1, size(rho_in,dim=4) - rho_out(s_out1,f_out1,s_out2,f_out2) = & - rho_out(s_out1,f_out1,s_out2,f_out2) & - + a(s_in1,f_in1,s_out1,f_out1) & - * rho_in(s_in1,f_in1,s_in2,f_in2) & - * conjg (a(s_in2,f_in2,s_out2,f_out2)) - end do - end do - end do - end do - end do - end do - end do - end do - end subroutine omega_scatter - pure subroutine omega_scatter_nonzero & - (amplitude_2, k, rho_in, rho_out, mult, zero, n) - real(kind=omega_prec), dimension(0:,:), intent(in) :: k - complex(kind=omega_prec), dimension(:,:,:,:), intent(in) :: rho_in - complex(kind=omega_prec), dimension(:,:,:,:), intent(inout) :: rho_out - integer, dimension(:), intent(in) :: mult - integer, dimension(:,:,:,:), intent(inout) :: zero - integer, intent(in) :: n - interface - pure subroutine amplitude_2 (amp, k, s_in, f_in, s_out, f_out, zero, n) - use omega_kinds - implicit none - complex(kind=omega_prec), intent(out) :: amp - real(kind=omega_prec), dimension(0:,:), intent(in) :: k - integer, intent(in) :: s_in, f_in, s_out, f_out - integer, dimension(:,:,:,:), intent(inout) :: zero - integer, intent(in) :: n - end subroutine amplitude_2 - end interface - integer :: s_in1, s_in2, f_in1, f_in2, s_out1, s_out2, f_out1, f_out2 - complex(kind=omega_prec), & - dimension(size(rho_in,dim=1),size(rho_in,dim=2),& - size(rho_out,dim=1),size(rho_out,dim=2)) :: a - do s_in1 = 1, size(rho_in,dim=1) - do f_in1 = 1, size(rho_in,dim=2) - do s_out1 = 1, size(rho_out,dim=1) - do f_out1 = 1, size(rho_out,dim=2) - call amplitude_2 (a(s_in1,f_in1,s_out1,f_out1), & - k, s_in1, f_in1, s_out1, f_out1, zero, n) - a(s_in1,f_in1,s_out1,f_out1) = & - a(s_in1,f_in1,s_out1,f_out1) & - / sqrt (real (mult(f_out1), kind=omega_prec)) - end do - end do - end do - end do - do s_out1 = 1, size(rho_out,dim=1) - do f_out1 = 1, size(rho_out,dim=2) - do s_out2 = 1, size(rho_out,dim=3) - do f_out2 = 1, size(rho_out,dim=4) - rho_out(s_out1,f_out1,s_out2,f_out2) = 0 - do s_in1 = 1, size(rho_in,dim=1) - do f_in1 = 1, size(rho_in,dim=2) - do s_in2 = 1, size(rho_in,dim=3) - do f_in2 = 1, size(rho_in,dim=4) - rho_out(s_out1,f_out1,s_out2,f_out2) = & - rho_out(s_out1,f_out1,s_out2,f_out2) & - + a(s_in1,f_in1,s_out1,f_out1) & - * rho_in(s_in1,f_in1,s_in2,f_in2) & - * conjg (a(s_in2,f_in2,s_out2,f_out2)) - end do - end do - end do - end do - end do - end do - end do - end do - end subroutine omega_scatter_nonzero - pure subroutine omega_scatter_diagonal & - (amplitude_2, k, rho_in, rho_out, mult) - real(kind=omega_prec), dimension(0:,:), intent(in) :: k - real(kind=omega_prec), dimension(:,:), intent(in) :: rho_in - real(kind=omega_prec), dimension(:,:), intent(inout) :: rho_out - integer, dimension(:), intent(in) :: mult - interface - pure function amplitude_2 (k, s_in, f_in, s_out, f_out) result (amp) - use omega_kinds - implicit none - real(kind=omega_prec), dimension(0:,:), intent(in) :: k - integer, intent(in) :: s_in, f_in, s_out, f_out - complex(kind=omega_prec) :: amp - end function amplitude_2 - end interface - integer :: s_in, f_in, s_out, f_out - complex(kind=omega_prec) :: a - do s_out = 1, size(rho_out,dim=1) - do f_out = 1, size(rho_out,dim=2) - rho_out(s_out,f_out) = 0 - do s_in = 1, size(rho_in,dim=1) - do f_in = 1, size(rho_in,dim=2) - a = amplitude_2 (k, s_in, f_in, s_out, f_out) - rho_out(s_out,f_out) = rho_out(s_out,f_out) & - + rho_in(s_in,f_in) * real (a*conjg(a), kind=omega_prec) & - / mult(f_out) - end do - end do - end do - end do - end subroutine omega_scatter_diagonal - pure subroutine omega_scatter_diagonal_nonzero & - (amplitude_2, k, rho_in, rho_out, mult, zero, n) - real(kind=omega_prec), dimension(0:,:), intent(in) :: k - real(kind=omega_prec), dimension(:,:), intent(in) :: rho_in - real(kind=omega_prec), dimension(:,:), intent(inout) :: rho_out - integer, dimension(:), intent(in) :: mult - integer, dimension(:,:,:,:), intent(inout) :: zero - integer, intent(in) :: n - interface - pure subroutine amplitude_2 (amp, k, s_in, f_in, s_out, f_out, zero, n) - use omega_kinds - implicit none - complex(kind=omega_prec), intent(out) :: amp - real(kind=omega_prec), dimension(0:,:), intent(in) :: k - integer, intent(in) :: s_in, f_in, s_out, f_out - integer, dimension(:,:,:,:), intent(inout) :: zero - integer, intent(in) :: n - end subroutine amplitude_2 - end interface - integer :: s_in, f_in, s_out, f_out - complex(kind=omega_prec) :: a - do s_out = 1, size(rho_out,dim=1) - do f_out = 1, size(rho_out,dim=2) - rho_out(s_out,f_out) = 0 - do s_in = 1, size(rho_in,dim=1) - do f_in = 1, size(rho_in,dim=2) - call amplitude_2 (a, k, s_in, f_in, s_out, f_out, zero, n) - rho_out(s_out,f_out) = rho_out(s_out,f_out) & - + rho_in(s_in,f_in) * real (a*conjg(a), kind=omega_prec) & - / mult(f_out) - end do - end do - end do - end do - end subroutine omega_scatter_diagonal_nonzero - pure function omega_sum (omega, p, states, fixed) result (sigma) - real(kind=omega_prec) :: sigma - real(kind=omega_prec), dimension(0:,:), intent(in) :: p - integer, dimension(:), intent(in), optional :: states, fixed - interface - pure function omega (p, s) result (me) - use omega_kinds - implicit none - complex(kind=omega_prec) :: me - real(kind=omega_prec), dimension(0:,:), intent(in) :: p - integer, dimension(:), intent(in) :: s - end function omega - end interface - integer, dimension(size(p,dim=2)) :: s, nstates - integer :: j - complex(kind=omega_prec) :: 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) - 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 - end do sum_spins - sigma = sigma / num_states (2, nstates(1:2)) - end function omega_sum - 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 - pure subroutine omega_sum_nonzero (sigma, omega, p, zero, n, states, fixed) - real(kind=omega_prec), intent(out) :: sigma - real(kind=omega_prec), dimension(0:,:), intent(in) :: p - integer, dimension(:), intent(inout) :: zero - integer, intent(in) :: n - integer, dimension(:), intent(in), optional :: states, fixed - interface - pure function omega (p, s) result (me) - use omega_kinds - implicit none - complex(kind=omega_prec) :: me - real(kind=omega_prec), dimension(0:,:), intent(in) :: p - integer, dimension(:), intent(in) :: s - end function omega - end interface - integer, dimension(size(p,dim=2)) :: s, nstates - integer :: j, k - complex(kind=omega_prec) :: a - real(kind=omega_prec) :: a2 - if (present (states)) then - nstates = states - else - nstates = 2 - end if - sigma = 0 - s = -1 - k = 1 - sum_spins: do - if (zero (k) < REPEAT) then - if (present (fixed)) then - a = omega (p, merge (fixed, s, mask = nstates == 0)) - else - a = omega (p, s) - end if - a2 = a * conjg(a) - if (n <= SAMPLE .and. a2 <= tiny (1.0_omega_prec)) then - zero (k) = zero (k) + 1 - end if - sigma = sigma + a2 - end if - k = k + 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 - end do sum_spins - sigma = sigma / num_states (2, nstates(1:2)) - end subroutine omega_sum_nonzero - pure function num_states (n, states) result (ns) - integer, intent(in) :: n - integer, dimension(:), intent(in), optional :: states - integer :: ns - if (present (states)) then - ns = product (states, mask = states == 2 .or. states == 3) - else - ns = 2**n - end if - end function num_states - pure subroutine omega_nonzero (a, omega, p, s, zero, n, states) - complex(kind=omega_prec), intent(out) :: a - real(kind=omega_prec), dimension(0:,:), intent(in) :: p - integer, dimension(:), intent(in) :: s - integer, dimension(:), intent(inout) :: zero - integer, intent(in) :: n - integer, dimension(:), intent(in), optional :: states - interface - pure function omega (p, s) result (me) - use omega_kinds - implicit none - complex(kind=omega_prec) :: me - real(kind=omega_prec), dimension(0:,:), intent(in) :: p - integer, dimension(:), intent(in) :: s - end function omega - end interface - real(kind=omega_prec) :: dummy - if (n < SAMPLE) then - call omega_sum_nonzero (dummy, omega, p, zero, n, states) - end if - if (zero (state_index (s, states)) < REPEAT) then - a = omega (p, s) - else - a = 0 - end if - end subroutine omega_nonzero -end module omega_utils Index: tags/ohl/attic/omega-000.011beta/src/omega_couplings.f95 =================================================================== --- tags/ohl/attic/omega-000.011beta/src/omega_couplings.f95 (revision 8686) +++ tags/ohl/attic/omega-000.011beta/src/omega_couplings.f95 (revision 8687) @@ -1,451 +0,0 @@ -! $Id: omegalib.nw,v 1.118.4.2 2006/05/15 08:39:27 ohl Exp $ -! -! Copyright (C) 2000-2002 by Thorsten Ohl -! and others -! -! O'Mega is free software; you can redistribute it and/or modify it -! under the terms of the GNU General Public License as published by -! the Free Software Foundation; either version 2, or (at your option) -! any later version. -! -! O'Mega is distributed in the hope that it will be useful, but -! WITHOUT ANY WARRANTY; without even the implied warranty of -! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -! GNU General Public License for more details. -! -! You should have received a copy of the GNU General Public License -! along with this program; if not, write to the Free Software -! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -module omega_couplings - use omega_kinds - use omega_constants - use omega_vectors - use omega_tensors - implicit none - private - public :: g_gg - public :: x_gg, g_gx - public :: v_ss, s_vs - 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 :: s_gravs, v_gravv, grav_ss, grav_vv - public :: t2_vv, v_t2v - public :: phi_vv, v_phiv - public :: t2_vv_d5_1, v_t2v_d5_1 - public :: t2_vv_d5_2, v_t2v_d5_2 - public :: t2_vv_d7, v_t2v_d7 - public :: wd_tl - public :: pr_phi, pr_unitarity, pr_feynman, pr_gauge, pr_rxi - public :: pj_phi, pj_unitarity - public :: pr_tensor - integer, parameter, public :: omega_couplings_2003_03_A = 0 -contains - pure function g_gg (g, a1, k1, a2, k2) result (a) - complex(kind=omega_prec), 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 - pure function x_gg (g, a1, a2) result (x) - complex(kind=omega_prec), intent(in) :: g - type(vector), intent(in) :: a1, a2 - type(tensor2odd) :: x - x = g * (a1 .wedge. a2) - end function x_gg - pure function g_gx (g, a1, x) result (a) - complex(kind=omega_prec), intent(in) :: g - type(vector), intent(in) :: a1 - type(tensor2odd), intent(in) :: x - type(vector) :: a - a = g * (a1 * x) - end function g_gx - pure function v_ss (g, phi1, k1, phi2, k2) result (v) - complex(kind=omega_prec), intent(in) :: g, phi1, phi2 - type(momentum), intent(in) :: k1, k2 - type(vector) :: v - v = (k1 - k2) * (g * phi1 * phi2) - end function v_ss - pure function s_vs (g, v1, k1, phi2, k2) result (phi) - complex(kind=omega_prec), intent(in) :: g, phi2 - type(vector), intent(in) :: v1 - type(momentum), intent(in) :: k1, k2 - complex(kind=omega_prec) :: phi - phi = g * ((k1 + 2*k2) * v1) * phi2 - end function s_vs - pure function tkv_vv (g, v1, k1, v2, k2) result (v) - complex(kind=omega_prec), 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 - pure function t5kv_vv (g, v1, k1, v2, k2) result (v) - complex(kind=omega_prec), 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 - pure function lkv_vv (g, v1, k1, v2, k2) result (v) - complex(kind=omega_prec), 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 - pure function l5kv_vv (g, v1, k1, v2, k2) result (v) - complex(kind=omega_prec), 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 - pure function tv_kvv (g, v1, k1, v2, k2) result (v) - complex(kind=omega_prec), 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 - pure function t5v_kvv (g, v1, k1, v2, k2) result (v) - complex(kind=omega_prec), 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 - pure function lv_kvv (g, v1, k1, v2) result (v) - complex(kind=omega_prec), 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 - pure function l5v_kvv (g, v1, k1, v2) result (v) - complex(kind=omega_prec), 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 - pure function kg_kgkg (g, a1, k1, a2, k2) result (a) - complex(kind=omega_prec), intent(in) :: g - type(vector), intent(in) :: a1, a2 - type(momentum), intent(in) :: k1, k2 - type(vector) :: a - real(kind=omega_prec) :: k1k1, k2k2, k1k2, kk1, kk2 - complex(kind=omega_prec) :: 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 - pure function kg5_kgkg (g, a1, k1, a2, k2) result (a) - complex(kind=omega_prec), 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 - pure function kg_kg5kg (g, a1, k1, a2, k2) result (a) - complex(kind=omega_prec), 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 - pure function s_gravs (g, m, k1, k2, t, s) result (phi) - complex(kind=omega_prec), intent(in) :: g, s - real(kind=omega_prec), intent(in) :: m - type(momentum), intent(in) :: k1, k2 - type(tensor), intent(in) :: t - complex(kind=omega_prec) :: 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_omega_prec - end function s_gravs - pure function grav_ss (g, m, k1, k2, s1, s2) result (t) - complex(kind=omega_prec), intent(in) :: g, s1, s2 - real(kind=omega_prec), 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_omega_prec - t_metric%t(1,1) = - 1.0_omega_prec - t_metric%t(2,2) = - 1.0_omega_prec - t_metric%t(3,3) = - 1.0_omega_prec - t = g*s1*s2/2.0_omega_prec * (-(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=omega_prec), intent(in) :: g - real(kind=omega_prec), intent(in) :: m - type(momentum), intent(in) :: k1, k2 - type(vector), intent(in) :: v - type(tensor), intent(in) :: t - complex(kind=omega_prec) :: t_tr - real(kind=omega_prec) :: xi - type(vector) :: vec - xi = 1.0_omega_prec - t_tr = t%t(0,0) - t%t(1,1) - t%t(2,2) - t%t(3,3) - vec = (-g)/ 2.0_omega_prec * (((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_omega_prec/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=omega_prec), intent(in) :: g - type(momentum), intent(in) :: k1, k2 - real(kind=omega_prec), intent(in) :: m - real(kind=omega_prec) :: xi - type(vector), intent (in) :: v1, v2 - type(tensor) :: t_metric, t - xi = 0.00001_omega_prec - t_metric%t = 0 - t_metric%t(0,0) = 1.0_omega_prec - t_metric%t(1,1) = - 1.0_omega_prec - t_metric%t(2,2) = - 1.0_omega_prec - t_metric%t(3,3) = - 1.0_omega_prec - t = (-g)/2.0_omega_prec * ( & - ((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_omega_prec/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 - pure function phi_vv (g, k1, k2, v1, v2) result (phi) - complex(kind=omega_prec), intent(in) :: g - type(momentum), intent(in) :: k1, k2 - type(vector), intent(in) :: v1, v2 - complex(kind=omega_prec) :: 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=omega_prec), intent(in) :: g, phi - type(vector), intent(in) :: v - type(momentum), intent(in) :: k1, k2 - type(vector) :: w - w = g * phi * pseudo_vector (k1, k2, v) - end function v_phiv - pure function t2_vv (g, v1, v2) result (t) - complex(kind=omega_prec), intent(in) :: g - type(vector), intent(in) :: v1, v2 - type(tensor) :: t - type(tensor) :: tmp - tmp = v1.tprod.v2 - t%t = g * (tmp%t + transpose (tmp%t)) - end function t2_vv - pure function v_t2v (g, t, v) result (tv) - complex(kind=omega_prec), 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 - pure function t2_vv_d5_1 (g, v1, k1, v2, k2) result (t) - complex(kind=omega_prec), 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=omega_prec), 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 - pure function t2_vv_d5_2 (g, v1, k1, v2, k2) result (t) - complex(kind=omega_prec), 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=omega_prec), 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 - pure function t2_vv_d7 (g, v1, k1, v2, k2) result (t) - complex(kind=omega_prec), 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=omega_prec), 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 - pure function wd_tl (p, w) result (width) - real(kind=omega_prec) :: width - type(momentum), intent(in) :: p - real(kind=omega_prec), intent(in) :: w - if (p*p > 0) then - width = w - else - width = 0 - end if - end function wd_tl - pure function pr_phi (p, m, w, phi) result (pphi) - complex(kind=omega_prec) :: pphi - type(momentum), intent(in) :: p - real(kind=omega_prec), intent(in) :: m, w - complex(kind=omega_prec), intent(in) :: phi - pphi = (1 / cmplx (p*p - m**2, m*w, kind=omega_prec)) * phi - end function pr_phi - pure function pj_phi (m, w, phi) result (pphi) - complex(kind=omega_prec) :: pphi - real(kind=omega_prec), intent(in) :: m, w - complex(kind=omega_prec), intent(in) :: phi - pphi = (0, -1) * sqrt (PI / m / w) * phi - end function pj_phi - pure function pr_unitarity (p, m, w, e) result (pe) - type(vector) :: pe - type(momentum), intent(in) :: p - real(kind=omega_prec), intent(in) :: m, w - type(vector), intent(in) :: e - type(vector) :: pv - pv = p - pe = - (1 / cmplx (p*p - m**2, m*w, kind=omega_prec)) & - * (e - (p*e / m**2) * pv) - end function pr_unitarity - pure function pj_unitarity (p, m, w, e) result (pe) - type(vector) :: pe - type(momentum), intent(in) :: p - real(kind=omega_prec), 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 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 - pure function pr_gauge (p, xi, e) result (pe) - type(vector) :: pe - type(momentum), intent(in) :: p - real(kind=omega_prec), intent(in) :: xi - type(vector), intent(in) :: e - real(kind=omega_prec) :: p2 - type(vector) :: pv - p2 = p*p - pv = p - pe = - (1 / p2) * (e - ((1 - xi) * (p*e) / p2) * pv) - end function pr_gauge - pure function pr_rxi (p, m, w, xi, e) result (pe) - type(vector) :: pe - type(momentum), intent(in) :: p - real(kind=omega_prec), intent(in) :: m, w, xi - type(vector), intent(in) :: e - real(kind=omega_prec) :: p2 - type(vector) :: pv - p2 = p*p - pv = p - pe = - (1 / cmplx (p2 - m**2, m*w, kind=omega_prec)) & - * (e - ((1 - xi) * (p*e) / (p2 - xi * m**2)) * pv) - end function pr_rxi - pure function pr_tensor (p, m, w, t) result (pt) - type(tensor) :: pt - type(momentum), intent(in) :: p - real(kind=omega_prec), intent(in) :: m, w - type(tensor), intent(in) :: t - complex(kind=omega_prec) :: p_dd_t - real(kind=omega_prec), 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_omega_prec * (t%t + transpose (t%t)), p_du)) & - - (p_dd_t / 3.0_omega_prec) * p_uu - pt%t = pt%t / cmplx (p*p - m**2, m*w, kind=omega_prec) - end function pr_tensor -end module omega_couplings Index: tags/ohl/attic/omega-000.011beta/src/omega_kinds.f95 =================================================================== --- tags/ohl/attic/omega-000.011beta/src/omega_kinds.f95 (revision 8686) +++ tags/ohl/attic/omega-000.011beta/src/omega_kinds.f95 (revision 8687) @@ -1,25 +0,0 @@ -! $Id: omegalib.nw,v 1.118.4.2 2006/05/15 08:39:27 ohl Exp $ -! -! Copyright (C) 2000-2002 by Thorsten Ohl -! and others -! -! O'Mega is free software; you can redistribute it and/or modify it -! under the terms of the GNU General Public License as published by -! the Free Software Foundation; either version 2, or (at your option) -! any later version. -! -! O'Mega is distributed in the hope that it will be useful, but -! WITHOUT ANY WARRANTY; without even the implied warranty of -! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -! GNU General Public License for more details. -! -! You should have received a copy of the GNU General Public License -! along with this program; if not, write to the Free Software -! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -module omega_kinds - implicit none - integer, parameter, public :: & - single = kind (1.0), & - double = selected_real_kind (precision (1.0) + 1, range (1.0) + 1) - integer, parameter, public :: omega_prec = double -end module omega_kinds Index: tags/ohl/attic/omega-000.011beta/src/omega95_bispinors.f95 =================================================================== --- tags/ohl/attic/omega-000.011beta/src/omega95_bispinors.f95 (revision 8686) +++ tags/ohl/attic/omega-000.011beta/src/omega95_bispinors.f95 (revision 8687) @@ -1,30 +0,0 @@ -! $Id: omegalib.nw,v 1.118.4.2 2006/05/15 08:39:27 ohl Exp $ -! -! Copyright (C) 2000-2002 by Thorsten Ohl -! and others -! -! O'Mega is free software; you can redistribute it and/or modify it -! under the terms of the GNU General Public License as published by -! the Free Software Foundation; either version 2, or (at your option) -! any later version. -! -! O'Mega is distributed in the hope that it will be useful, but -! WITHOUT ANY WARRANTY; without even the implied warranty of -! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -! GNU General Public License for more details. -! -! You should have received a copy of the GNU General Public License -! along with this program; if not, write to the Free Software -! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -module omega95_bispinors - use omega_constants - use omega_bispinors - use omega_vectors - use omega_vectorspinors - use omega_polarizations - use omega_vspinor_polarizations - use omega_couplings - use omega_bispinor_couplings - use omega_utils - public -end module omega95_bispinors Index: tags/ohl/attic/omega-000.011beta/src/omega_parameters_littlest.f95 =================================================================== --- tags/ohl/attic/omega-000.011beta/src/omega_parameters_littlest.f95 (revision 8686) +++ tags/ohl/attic/omega-000.011beta/src/omega_parameters_littlest.f95 (revision 8687) @@ -1,281 +0,0 @@ -! At the moment this is a hard-coded file and not extracted from -! omegalib.nw -! -! Copyright (C) 2000-2004 by Thorsten Ohl -! and others -! -! O'Mega is free software; you can redistribute it and/or modify it -! under the terms of the GNU General Public License as published by -! the Free Software Foundation; either version 2, or (at your option) -! any later version. -! -! O'Mega is distributed in the hope that it will be useful, but -! WITHOUT ANY WARRANTY; without even the implied warranty of -! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -! GNU General Public License for more details. -! -! You should have received a copy of the GNU General Public License -! along with this program; if not, write to the Free Software -! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -module omega_parameters_littlest - use omega_kinds - use omega_constants - implicit none - private - public :: setup_parameters, print_parameters - real(kind=omega_prec), dimension(45), save, public :: mass = 0, width = 0 - real(kind=omega_prec), parameter, public :: GeV = 1.0_double - real(kind=omega_prec), parameter, public :: MeV = GeV / 1000 - real(kind=omega_prec), parameter, public :: keV = MeV / 1000 - real(kind=omega_prec), parameter, public :: TeV = GeV * 1000 - real(kind=omega_prec), save, public :: & - alpha = 1.0_double / 137.0359895_double, & - sin2thw = 0.23124_double - complex(kind=omega_prec), save, private :: vev - complex(kind=omega_prec), save, public :: & - qlep = 0, qup = 0, qdwn = 0, gcc = 0, qw = 0, & - gzww = 0, gwww = 0, ghww = 0, ghhww = 0, ghzz = 0, ghhzz = 0, & - ghbb = 0, ghtt = 0, ghcc = 0, ghtautau = 0, gh3 = 0, gh4 = 0, & - ghgaga = 0, ghgaz = 0, & - iqw = 0, igzww = 0, igwww = 0, & - gw4 = 0, gzzww = 0, gazww = 0, gaaww = 0, & - gs = 0, igs = 0 - complex(kind=omega_prec), save, public :: & - sinckm12 = 0, sinckm13 = 0, sinckm23 = 0, & - cosckm12 = 0, cosckm13 = 0, cosckm23 = 0 - complex(kind=omega_prec), save, public :: & - vckm_11 = 0, vckm_12 = 0, vckm_13 = 0, vckm_21 = 0, & - vckm_22 = 0, vckm_23 = 0, vckm_31 = 0, vckm_32 = 0, vckm_33 = 0 - complex(kind=omega_prec), save, public :: & - gccq11 = 0, gccq12 = 0, gccq13 = 0, gccq21 = 0, & - gccq22 = 0, gccq23 = 0, gccq31 = 0, gccq32 = 0, gccq33 = 0 - real(kind=omega_prec), save, public :: & - g1a = 1, g1z = 1, kappaa = 1, kappaz = 1, lambdaa = 0, lambdaz = 0, & - g4a = 0, g4z = 0, g5a = 0, g5z = 0, & - kappa5a = 0, kappa5z = 0, lambda5a = 0, lambda5z = 0, & - alpha4 = 0, alpha5 = 0, tau4 = 0, tau5 = 0 - real(kind=omega_prec), save, public :: xia = 1, xi0 = 1, xipm = 1 - complex(kind=omega_prec), dimension(2), save, public :: & - gnclep = 0, gncneu = 0, gncup = 0, gncdwn = 0 - complex(kind=omega_prec), save, public :: & - fudge_o1 = 1, fudge_o2 = 1, fudge_o3 = 1, fudge_o4 = 1 - complex(kind=omega_prec), save, public :: & - ghmumu = 0 - complex(kind=omega_prec), save, public :: & - gh0ww = 0, gh0zz = 0, & - gh0tt = 0, gh0bb = 0, gh0cc = 0, gh0tautau = 0, gh0mumu = 0, & - iga0tt = 0, iga0bb = 0, iga0cc = 0, iga0tautau = 0, iga0mumu = 0, & - gahh = 0, gzhh = 0, igzha = 0, igzh0a = 0 - complex(kind=omega_prec), dimension(2), save, public :: & - ghptb = 0, ghpcs = 0, ghptaunu = 0, ghpmunu = 0 - !!! Additional Littlest Higgs parameters - complex(kind=omega_prec), save, public :: & - ghwhw = 0, ghwhwh = 0, ghahah = 0, ghzhz = 0, ghzhah = 0, & - ghahz = 0, ghaa = 0, ghgg = 0, geaa = 0, geaz = 0, gegg = 0 - complex(kind=omega_prec), save, public :: & - gpsiww = 0, gpsiwhw = 0, gpsizz = 0, gpsizhzh = 0, & - gpsizhz = 0, gpsizah = 0, gpsizhah = 0, gpsiahah = 0, & - gpsizw = 0, gpsizwh = 0, gpsiahw = 0, gpsiahwh = 0, & - gpsizhw = 0, gpsizhwh = 0, gpsippww = 0, gpsippwhw = 0, & - gpsippwhwh = 0, gpsihw = 0, gpsihwh = 0, gpsi0w = 0, & - gpsi0wh = 0, gpsi1w = 0, gpsi1wh = 0, gpsippw = 0, & - gpsippwh = 0 - complex(kind=omega_prec), save, public :: & - gpsihah = 0, gpsi0ah = 0, gahpsip = 0, & - gpsi1hz = 0, gpsi1hzh = 0, gpsi01z = 0, gpsi01zh = 0, & - gzpsip = 0, gzpsipp = 0, gzhpsipp = 0 - complex(kind=omega_prec), save, public :: & - ghhaa = 0, ghhwhw = 0, ghhzhz = 0, ghhahz = 0, ghhzhah = 0, & - ghpsi0ww = 0, ghpsi0whw = 0, ghpsi0zz = 0, ghpsi0zhzh = 0, & - ghpsi0zhz = 0, ghpsi0ahah = 0, ghpsi0zah = 0, ghpsi0zhah = 0 - complex(kind=omega_prec), save, public :: & - ghpsipwa = 0, ghpsipwha = 0, ghpsipwz = 0, ghpsiwhz = 0, & - ghpsipwah = 0, ghpsipwhah = 0, ghpsipwzh = 0, ghpsipwhzh = 0, & - ghpsippww = 0, ghpsippwhwh = 0, ghpsippwhw = 0, gpsi00zh = 0, & - gpsi00ah = 0, gpsi00zhah = 0, gpsi0pwa = 0, gpsi0pwha = 0, & - gpsi0pwz = 0, gpsi0pwhz = 0, gpsi0pwah = 0, gpsi0pwhah = 0, & - gpsi0pwzh = 0, gpsi0pwhzh = 0, gpsi0ppww = 0, gpsi0ppwhwh = 0, & - gpsi0ppwhw = 0, i_gpsi0pwa = 0, i_gpsi0pwha = 0, & - i_gpsi0pwz = 0, i_gpsi0pwhz = 0, i_gpsi0pwah = 0, i_gpsi0pwhah = 0, & - i_gpsi0pwzh = 0, i_gpsi0pwhzh = 0, i_gpsi0ppww = 0, i_gpsi0ppwhwh = 0, & - i_gpsi0ppwhw = 0 - complex(kind=omega_prec), save, public :: & - gpsippzz = 0, gpsippzhzh = 0, gpsippaz = 0, gpsippaah = 0, & - gpsippzah = 0, gpsippwa = 0, gpsippwha = 0, gpsippwz = 0, & - gpsippwhz = 0, gpsippwah = 0, gpsippwhah = 0, gpsippwzh = 0, & - gpsippwhzh = 0, gpsicczz = 0, gpsiccaz = 0, gpsiccaah = 0, & - gpsicczzh = 0, gpsiccazh = 0, gpsicczah = 0 - complex(kind=omega_prec), save, public :: & - igahww = 0, igzhww = 0, igzwhw = 0, igahwhwh = 0, igzhwhwh = 0, & - igahwhw = 0 - complex(kind=omega_prec), save, public :: & - gwh4 = 0, gwhwhww = 0, gwhwww = 0, gwh3w = 0, gwwaah = 0, & - gwwazh = 0, gwwzzh = 0, gwwzah = 0, gwhwhaah = 0, gwhwhazh = 0, & - gwhwhzzh = 0, gwhwhzah = 0, gwwzhah = 0, gwhwhzhah = 0, & - gwhwzz = 0, gwhwaz = 0, gwhwaah = 0, gwhwzah = 0, gwhwzhzh = 0, & - gwhwzhah = 0, gwhwazh = 0, gwhwzzh = 0 - complex(kind=omega_prec), save, public :: & - qzup = 0, gcch = 0, gcctop = 0, gccw = 0, gccwh = 0, & - gnch = 0, gztht = 0, gzhtht = 0, gah = 0 - complex(kind=omega_prec), dimension(2), save, public :: & - gnchup = 0, gnchdwn = 0, gnchneu = 0, gnchlep = 0, gahtt = 0, & - gahthth = 0, ghtht = 0, gpsipq2 = 0, gpsipq3 = 0, & - ghhtht = 0 - complex(kind=omega_prec), save, public :: & - gahtht = 0, ghthth = 0, & - gpsi0tt = 0, gpsi0bb = 0, gpsi0cc = 0, gpsi0tautau = 0, & - gpsipl3 = 0, gpsi0tth = 0, gpsi1tth = 0, gpsipbth = 0, & - ghhtt = 0, ghhthth = 0 -contains - subroutine setup_parameters () - real(kind=omega_prec) :: e, g, sinthw, costhw, qelep, qeup, qedwn - real(kind=omega_prec) :: sinth, costh, sinthp, costhp, & - sin2th, cos2th, sin2thp, cos2thp - real(kind=omega_prec) :: t_fac, tp_fac - mass(1) = 5.0 * MeV - mass(2) = 3.0 * MeV - mass(3) = 100.0 * MeV - mass(4) = 1.2 * GeV - mass(5) = 4.2 * GeV - mass(6) = 174.0 * GeV - width(1:5) = 0 - width(6) = 1.3 * GeV - mass(11) = 0.51099907 * MeV - mass(12) = 0 - mass(13) = 105.658389 * MeV - mass(14) = 0 - mass(15) = 1777.05 * MeV - mass(16) = 0 - width(11:16) = 0 - mass(21) = 0 - mass(22) = 0 - width(21:22) = 0 - mass(23) = 91.187 * GeV - width(23) = 2.490 * GeV - mass(24) = 80.41 * GeV - width(24) = 2.06 * GeV - mass(25) = 120.00 * GeV - width(25) = 5.00 * GeV - mass(35) = 10000 * GeV - width(35) = 0 - sinckm12 = 0.0_omega_prec - sinckm13 = 0.0_omega_prec - sinckm23 = 0.0_omega_prec - cosckm12 = sqrt ((1.0_omega_prec - (sinckm12**2))) - cosckm13 = sqrt ((1.0_omega_prec - (sinckm13**2))) - cosckm23 = sqrt ((1.0_omega_prec - (sinckm23**2))) - mass(26) = xi0 * mass(23) - width(26) = 0 - mass(27) = xipm * mass(24) - width(27) = 0 - e = sqrt (4 * PI * alpha) - qelep = - 1 - qeup = 2.0_omega_prec / 3.0_omega_prec - qedwn = - 1.0_omega_prec / 3.0_omega_prec - sinthw = sqrt (sin2thw) - costhw = sqrt (1 - sin2thw) - g = e / sinthw - gcc = - g / 2 / sqrt (2.0_double) - vckm_11 = cosckm12 * cosckm13 - vckm_12 = sinckm12 * cosckm13 - vckm_13 = sinckm13 - vckm_21 = - (sinckm12 * cosckm23 + & - cosckm12 * sinckm23 * sinckm13) - vckm_22 = cosckm12 * cosckm23 - & - sinckm12 * sinckm23 * sinckm13 - vckm_23 = sinckm23 * cosckm13 - vckm_31 = sinckm12 * sinckm23 - & - cosckm12 * cosckm23 * sinckm13 - vckm_32 = - (cosckm12 * sinckm23 + & - sinckm12 * cosckm23 * sinckm13) - vckm_33 = cosckm23 * cosckm13 - gccq11 = gcc * vckm_11 - gccq12 = gcc * vckm_12 - gccq13 = gcc * vckm_13 - gccq21 = gcc * vckm_21 - gccq22 = gcc * vckm_22 - gccq23 = gcc * vckm_23 - gccq31 = gcc * vckm_31 - gccq32 = gcc * vckm_32 - gccq33 = gcc * vckm_33 - gncneu(1) = - g / 2 / costhw * ( + 0.5_double) - gnclep(1) = - g / 2 / costhw * ( - 0.5_double - 2 * qelep * sin2thw) - gncup(1) = - g / 2 / costhw * ( + 0.5_double - 2 * qeup * sin2thw) - gncdwn(1) = - g / 2 / costhw * ( - 0.5_double - 2 * qedwn * sin2thw) - gncneu(2) = - g / 2 / costhw * ( + 0.5_double) - gnclep(2) = - g / 2 / costhw * ( - 0.5_double) - gncup(2) = - g / 2 / costhw * ( + 0.5_double) - gncdwn(2) = - g / 2 / costhw * ( - 0.5_double) - qlep = - e * qelep - qup = - e * qeup - qdwn = - e * qedwn - qw = e - iqw = (0,1)*qw - gzww = g * costhw - igzww = (0,1)*gzww - gwww = g - igwww = (0,1)*gwww - ghww = mass(24) * g - ghhww = g**2 / 2.0_omega_prec - ghzz = mass(23) * g / costhw - ghhzz = g**2 / 2.0_omega_prec / costhw**2 - gw4 = g**2 - gzzww = gzww**2 - gazww = gzww*e - gaaww = e**2 - vev = 2.0 * mass(24) / g - ghtt = - mass(6) / vev - ghbb = - mass(5) / vev - ghcc = - mass(4) / vev - ghtautau = - mass(15) / vev - gh3 = - 3 * mass(25)**2 / vev - gh4 = - 3 * mass(25)**2 / vev**2 - !!! Littlest Higgs specific couplings - sin2th = sinth**2 - cos2th = 1.0_omega_prec - sin2th - costh = sqrt(cos2th) - sin2thp = sinthp**2 - cos2thp = 1.0_omega_prec - sin2thp - costhp = sqrt(cos2thp) - t_fac = (cos2th - sin2th)/2.0_omega_prec/sinth/costh - tp_fac = (cos2thp - sin2thp)/2.0_omega_prec/sinthp/costhp - end subroutine setup_parameters - subroutine print_parameters () - print *, "Quark masses:" - print *, mass(2:6:2) - print *, mass(1:5:2) - print *, "Lepton masses:" - print *, mass(12:16:2) - print *, mass(11:15:2) - print *, "Quark widths:" - print *, width(2:6:2) - print *, width(1:5:2) - print *, "Lepton widths:" - print *, width(12:16:2) - print *, width(11:15:2) - print *, "SU(2)xU(1) Gauge boson masses/widths:" - print *, mass(22:24) - print *, width(22:24) - print *, "Higgs boson and gluon masses/widths:" - print *, mass(25), mass(21) - print *, width(25), width(21) - print *, "Neutral current couplings:" - print *, "U:", gncup - print *, "D:", gncdwn - print *, "N:", gncneu - print *, "L:", gnclep - print *, "Fermion charges:" - print *, "U:", qup - print *, "D:", qdwn - print *, "L:", qlep - print *, "TGC:" - print *, "WWA:", iqw - print *, "WWZ:", igzww - print *, "WWW:", igwww - print *, "WWH:", ghww - !!! print *, "WWHH:", ghhww**2 !!! Old SM3 - print *, "WWHH:", ghhww - !!! print *, "ZZHH:", ghhzz**2 !!! Old SM3 - print *, "ZZHH:", ghhzz - end subroutine print_parameters -end module omega_parameters_littlest