|
|
| File test.f90, 51.9 KB (added by Christian Speckner, 14 years ago) |
|
|
| Line | |
|---|
| 1 | ! O'Mega scattering amplitudes for the processes |
|---|
| 2 | ! |
|---|
| 3 | ! allowed: (after merging flavor and color states) |
|---|
| 4 | ! |
|---|
| 5 | ! gl/1/2 gl/2/3 -> gl/4/3 gl/5/4 gl/1/5 |
|---|
| 6 | ! |
|---|
| 7 | ! in Gauged Colorization Functor ( minimal electroweak standard model in unitarity gauge ) |
|---|
| 8 | ! |
|---|
| 9 | module test |
|---|
| 10 | use omega_kinds !NODEP! |
|---|
| 11 | use omega95 !NODEP! |
|---|
| 12 | use omega_parameters !NODEP! |
|---|
| 13 | use parameters |
|---|
| 14 | use omega_parameters_whizard |
|---|
| 15 | implicit none |
|---|
| 16 | private |
|---|
| 17 | public :: scatter_nonzero, scatter_diagonal_nonzero, scatter_diagonal_colored_nz, & |
|---|
| 18 | scatter_colored_nonzero |
|---|
| 19 | public :: allocate_zero |
|---|
| 20 | interface allocate_zero |
|---|
| 21 | module procedure allocate_zero_1, allocate_zero_2 |
|---|
| 22 | end interface |
|---|
| 23 | public :: allocate_zero_1, allocate_zero_2 |
|---|
| 24 | public :: number_particles, number_particles_in, number_particles_out |
|---|
| 25 | public :: number_spin_states, number_spin_states_in, number_spin_states_out, & |
|---|
| 26 | spin_states, spin_states_in, spin_states_out |
|---|
| 27 | public :: number_flavor_states, number_flavor_states_in, number_flavor_states_out, & |
|---|
| 28 | flavor_states, flavor_states_in, flavor_states_out |
|---|
| 29 | public :: number_flavor_zeros, number_flavor_zeros_in, number_flavor_zeros_out, & |
|---|
| 30 | flavor_zeros, flavor_zeros_in, flavor_zeros_out |
|---|
| 31 | public :: number_color_flows, color_flows, anticolor_flows |
|---|
| 32 | public :: create, reset, destroy |
|---|
| 33 | ! DON'T EVEN THINK of removing the following! |
|---|
| 34 | ! If the compiler complains about undeclared |
|---|
| 35 | ! or undefined variables, you are compiling |
|---|
| 36 | ! against an incompatible omega95 module! |
|---|
| 37 | integer, dimension(6), parameter, private :: require = (/ omega_spinors_2003_03_A, & |
|---|
| 38 | omega_spinor_cpls_2003_03_A, omega_vectors_2003_03_A, omega_polarizations_2003_03_A, & |
|---|
| 39 | omega_couplings_2003_03_A, omega_utils_2003_03_A /) |
|---|
| 40 | |
|---|
| 41 | integer, parameter, private :: n_prt = 5 |
|---|
| 42 | integer, parameter, private :: n_in = 2 |
|---|
| 43 | integer, parameter, private :: n_out = 3 |
|---|
| 44 | integer, parameter, private :: n_cflow = 24 |
|---|
| 45 | integer, parameter, private :: n_flv = 1 |
|---|
| 46 | integer, parameter, private :: n_flv_in = 1 |
|---|
| 47 | integer, parameter, private :: n_flv_out = 1 |
|---|
| 48 | integer, parameter, private :: n_hel = 32 |
|---|
| 49 | integer, parameter, private :: n_hel_in = 4 |
|---|
| 50 | integer, parameter, private :: n_hel_out = 8 |
|---|
| 51 | |
|---|
| 52 | logical, parameter, private :: F = .false. |
|---|
| 53 | logical, parameter, private :: T = .true. |
|---|
| 54 | |
|---|
| 55 | integer, dimension(n_prt), parameter, private :: s0001 = (/ -1, -1, -1, -1, & |
|---|
| 56 | -1 /) |
|---|
| 57 | integer, dimension(n_prt), parameter, private :: s0002 = (/ -1, -1, -1, -1, & |
|---|
| 58 | 1 /) |
|---|
| 59 | integer, dimension(n_prt), parameter, private :: s0003 = (/ -1, -1, -1, 1, & |
|---|
| 60 | -1 /) |
|---|
| 61 | integer, dimension(n_prt), parameter, private :: s0004 = (/ -1, -1, -1, 1, & |
|---|
| 62 | 1 /) |
|---|
| 63 | integer, dimension(n_prt), parameter, private :: s0005 = (/ -1, -1, 1, -1, & |
|---|
| 64 | -1 /) |
|---|
| 65 | integer, dimension(n_prt), parameter, private :: s0006 = (/ -1, -1, 1, -1, & |
|---|
| 66 | 1 /) |
|---|
| 67 | integer, dimension(n_prt), parameter, private :: s0007 = (/ -1, -1, 1, 1, & |
|---|
| 68 | -1 /) |
|---|
| 69 | integer, dimension(n_prt), parameter, private :: s0008 = (/ -1, -1, 1, 1, & |
|---|
| 70 | 1 /) |
|---|
| 71 | integer, dimension(n_prt), parameter, private :: s0009 = (/ -1, 1, -1, -1, & |
|---|
| 72 | -1 /) |
|---|
| 73 | integer, dimension(n_prt), parameter, private :: s0010 = (/ -1, 1, -1, -1, & |
|---|
| 74 | 1 /) |
|---|
| 75 | integer, dimension(n_prt), parameter, private :: s0011 = (/ -1, 1, -1, 1, & |
|---|
| 76 | -1 /) |
|---|
| 77 | integer, dimension(n_prt), parameter, private :: s0012 = (/ -1, 1, -1, 1, & |
|---|
| 78 | 1 /) |
|---|
| 79 | integer, dimension(n_prt), parameter, private :: s0013 = (/ -1, 1, 1, -1, & |
|---|
| 80 | -1 /) |
|---|
| 81 | integer, dimension(n_prt), parameter, private :: s0014 = (/ -1, 1, 1, -1, & |
|---|
| 82 | 1 /) |
|---|
| 83 | integer, dimension(n_prt), parameter, private :: s0015 = (/ -1, 1, 1, 1, & |
|---|
| 84 | -1 /) |
|---|
| 85 | integer, dimension(n_prt), parameter, private :: s0016 = (/ -1, 1, 1, 1, & |
|---|
| 86 | 1 /) |
|---|
| 87 | integer, dimension(n_prt), parameter, private :: s0017 = (/ 1, -1, -1, -1, & |
|---|
| 88 | -1 /) |
|---|
| 89 | integer, dimension(n_prt), parameter, private :: s0018 = (/ 1, -1, -1, -1, & |
|---|
| 90 | 1 /) |
|---|
| 91 | integer, dimension(n_prt), parameter, private :: s0019 = (/ 1, -1, -1, 1, & |
|---|
| 92 | -1 /) |
|---|
| 93 | integer, dimension(n_prt), parameter, private :: s0020 = (/ 1, -1, -1, 1, & |
|---|
| 94 | 1 /) |
|---|
| 95 | integer, dimension(n_prt), parameter, private :: s0021 = (/ 1, -1, 1, -1, & |
|---|
| 96 | -1 /) |
|---|
| 97 | integer, dimension(n_prt), parameter, private :: s0022 = (/ 1, -1, 1, -1, & |
|---|
| 98 | 1 /) |
|---|
| 99 | integer, dimension(n_prt), parameter, private :: s0023 = (/ 1, -1, 1, 1, & |
|---|
| 100 | -1 /) |
|---|
| 101 | integer, dimension(n_prt), parameter, private :: s0024 = (/ 1, -1, 1, 1, & |
|---|
| 102 | 1 /) |
|---|
| 103 | integer, dimension(n_prt), parameter, private :: s0025 = (/ 1, 1, -1, -1, & |
|---|
| 104 | -1 /) |
|---|
| 105 | integer, dimension(n_prt), parameter, private :: s0026 = (/ 1, 1, -1, -1, & |
|---|
| 106 | 1 /) |
|---|
| 107 | integer, dimension(n_prt), parameter, private :: s0027 = (/ 1, 1, -1, 1, & |
|---|
| 108 | -1 /) |
|---|
| 109 | integer, dimension(n_prt), parameter, private :: s0028 = (/ 1, 1, -1, 1, & |
|---|
| 110 | 1 /) |
|---|
| 111 | integer, dimension(n_prt), parameter, private :: s0029 = (/ 1, 1, 1, -1, & |
|---|
| 112 | -1 /) |
|---|
| 113 | integer, dimension(n_prt), parameter, private :: s0030 = (/ 1, 1, 1, -1, & |
|---|
| 114 | 1 /) |
|---|
| 115 | integer, dimension(n_prt), parameter, private :: s0031 = (/ 1, 1, 1, 1, & |
|---|
| 116 | -1 /) |
|---|
| 117 | integer, dimension(n_prt), parameter, private :: s0032 = (/ 1, 1, 1, 1, & |
|---|
| 118 | 1 /) |
|---|
| 119 | integer, dimension(n_prt,n_hel), parameter, private :: table_spin_states = & |
|---|
| 120 | reshape ( (/ s0001, s0002, s0003, s0004, s0005, s0006, s0007, s0008, s0009, & |
|---|
| 121 | s0010, s0011, s0012, s0013, s0014, s0015, s0016, s0017, s0018, s0019, & |
|---|
| 122 | s0020, s0021, s0022, s0023, s0024, s0025, s0026, s0027, s0028, s0029, & |
|---|
| 123 | s0030, s0031, s0032 /), (/ n_prt, n_hel /) ) |
|---|
| 124 | integer, dimension(n_in), parameter, private :: si0001 = (/ -1, -1 /) |
|---|
| 125 | integer, dimension(n_in), parameter, private :: si0002 = (/ -1, 1 /) |
|---|
| 126 | integer, dimension(n_in), parameter, private :: si0003 = (/ 1, -1 /) |
|---|
| 127 | integer, dimension(n_in), parameter, private :: si0004 = (/ 1, 1 /) |
|---|
| 128 | integer, dimension(n_in,n_hel_in), parameter, private :: table_spin_states_in & |
|---|
| 129 | = reshape ( (/ si0001, si0002, si0003, si0004 /), (/ n_in, n_hel_in /) ) |
|---|
| 130 | integer, dimension(n_out), parameter, private :: so0001 = (/ -1, -1, -1 /) |
|---|
| 131 | integer, dimension(n_out), parameter, private :: so0002 = (/ -1, -1, 1 /) |
|---|
| 132 | integer, dimension(n_out), parameter, private :: so0003 = (/ -1, 1, -1 /) |
|---|
| 133 | integer, dimension(n_out), parameter, private :: so0004 = (/ -1, 1, 1 /) |
|---|
| 134 | integer, dimension(n_out), parameter, private :: so0005 = (/ 1, -1, -1 /) |
|---|
| 135 | integer, dimension(n_out), parameter, private :: so0006 = (/ 1, -1, 1 /) |
|---|
| 136 | integer, dimension(n_out), parameter, private :: so0007 = (/ 1, 1, -1 /) |
|---|
| 137 | integer, dimension(n_out), parameter, private :: so0008 = (/ 1, 1, 1 /) |
|---|
| 138 | integer, dimension(n_out,n_hel_out), parameter, private :: table_spin_states_out & |
|---|
| 139 | = reshape ( (/ so0001, so0002, so0003, so0004, so0005, so0006, so0007, & |
|---|
| 140 | so0008 /), (/ n_out, n_hel_out/) ) |
|---|
| 141 | |
|---|
| 142 | integer, dimension(n_prt), parameter, private :: f0001 = (/ 21, 21, 21, & |
|---|
| 143 | 21, 21 /) ! gl/1/2 gl/2/3 gl/4/3 gl/5/4 gl/1/5 |
|---|
| 144 | integer, parameter, private :: f0001m = 1 |
|---|
| 145 | integer, dimension(n_prt,n_flv), parameter, private :: table_flavor_states & |
|---|
| 146 | = reshape ( (/ f0001 /), (/ n_prt, n_flv /) ) |
|---|
| 147 | integer, dimension(n_in), parameter, private :: fi0001 = (/ 21, 21 & |
|---|
| 148 | /) ! gl/1/2 gl/2/3 |
|---|
| 149 | integer, parameter, private :: fi0001m = 1 |
|---|
| 150 | integer, dimension(n_in,n_flv_in), parameter, private :: table_flavor_states_in & |
|---|
| 151 | = reshape ( (/ fi0001 /), (/ n_in, n_flv_in /) ) |
|---|
| 152 | integer, dimension(n_out), parameter, private :: fo0001 = (/ 21, 21, 21 & |
|---|
| 153 | /) ! gl/1/3 gl/2/4 gl/3/5 |
|---|
| 154 | integer, parameter, private :: fo0001m = 1 |
|---|
| 155 | integer, dimension(n_out,n_flv_out), parameter, private :: table_flavor_states_out & |
|---|
| 156 | = reshape ( (/ fo0001 /), (/ n_out, n_flv_out /) ) |
|---|
| 157 | |
|---|
| 158 | logical, dimension(n_hel,n_flv) :: flv_hel_flag |
|---|
| 159 | |
|---|
| 160 | integer, dimension(n_prt,0), private :: table_flavor_zeros |
|---|
| 161 | integer, dimension(n_in,0), private :: table_flavor_zeros_in |
|---|
| 162 | integer, dimension(n_out,0), private :: table_flavor_zeros_out |
|---|
| 163 | |
|---|
| 164 | integer, dimension(n_prt), parameter, private :: c0001 = (/ 2, 3, 4, 5, 1 /) |
|---|
| 165 | integer, dimension(n_prt), parameter, private :: c0002 = (/ 2, 3, 5, 1, 4 /) |
|---|
| 166 | integer, dimension(n_prt), parameter, private :: c0003 = (/ 2, 4, 1, 5, 3 /) |
|---|
| 167 | integer, dimension(n_prt), parameter, private :: c0004 = (/ 2, 4, 5, 3, 1 /) |
|---|
| 168 | integer, dimension(n_prt), parameter, private :: c0005 = (/ 2, 5, 1, 3, 4 /) |
|---|
| 169 | integer, dimension(n_prt), parameter, private :: c0006 = (/ 2, 5, 4, 1, 3 /) |
|---|
| 170 | integer, dimension(n_prt), parameter, private :: c0007 = (/ 3, 1, 4, 5, 2 /) |
|---|
| 171 | integer, dimension(n_prt), parameter, private :: c0008 = (/ 3, 1, 5, 2, 4 /) |
|---|
| 172 | integer, dimension(n_prt), parameter, private :: c0009 = (/ 3, 4, 2, 5, 1 /) |
|---|
| 173 | integer, dimension(n_prt), parameter, private :: c0010 = (/ 3, 4, 5, 1, 2 /) |
|---|
| 174 | integer, dimension(n_prt), parameter, private :: c0011 = (/ 3, 5, 2, 1, 4 /) |
|---|
| 175 | integer, dimension(n_prt), parameter, private :: c0012 = (/ 3, 5, 4, 2, 1 /) |
|---|
| 176 | integer, dimension(n_prt), parameter, private :: c0013 = (/ 4, 1, 2, 5, 3 /) |
|---|
| 177 | integer, dimension(n_prt), parameter, private :: c0014 = (/ 4, 1, 5, 3, 2 /) |
|---|
| 178 | integer, dimension(n_prt), parameter, private :: c0015 = (/ 4, 3, 1, 5, 2 /) |
|---|
| 179 | integer, dimension(n_prt), parameter, private :: c0016 = (/ 4, 3, 5, 2, 1 /) |
|---|
| 180 | integer, dimension(n_prt), parameter, private :: c0017 = (/ 4, 5, 1, 2, 3 /) |
|---|
| 181 | integer, dimension(n_prt), parameter, private :: c0018 = (/ 4, 5, 2, 3, 1 /) |
|---|
| 182 | integer, dimension(n_prt), parameter, private :: c0019 = (/ 5, 1, 2, 3, 4 /) |
|---|
| 183 | integer, dimension(n_prt), parameter, private :: c0020 = (/ 5, 1, 4, 2, 3 /) |
|---|
| 184 | integer, dimension(n_prt), parameter, private :: c0021 = (/ 5, 3, 1, 2, 4 /) |
|---|
| 185 | integer, dimension(n_prt), parameter, private :: c0022 = (/ 5, 3, 4, 1, 2 /) |
|---|
| 186 | integer, dimension(n_prt), parameter, private :: c0023 = (/ 5, 4, 1, 3, 2 /) |
|---|
| 187 | integer, dimension(n_prt), parameter, private :: c0024 = (/ 5, 4, 2, 1, 3 /) |
|---|
| 188 | integer, dimension(n_prt,n_cflow), parameter, private :: table_color_flows & |
|---|
| 189 | = reshape ( (/ c0001, c0002, c0003, c0004, c0005, c0006, c0007, c0008, & |
|---|
| 190 | c0009, c0010, c0011, c0012, c0013, c0014, c0015, c0016, c0017, c0018, c0019, & |
|---|
| 191 | c0020, c0021, c0022, c0023, c0024 /), (/ n_prt, n_cflow /) ) |
|---|
| 192 | integer, dimension(n_prt), parameter, private :: a0001 = (/ 5, 1, 2, 3, 4 /) |
|---|
| 193 | integer, dimension(n_prt), parameter, private :: a0002 = (/ 4, 1, 2, 5, 3 /) |
|---|
| 194 | integer, dimension(n_prt), parameter, private :: a0003 = (/ 3, 1, 5, 2, 4 /) |
|---|
| 195 | integer, dimension(n_prt), parameter, private :: a0004 = (/ 5, 1, 4, 2, 3 /) |
|---|
| 196 | integer, dimension(n_prt), parameter, private :: a0005 = (/ 3, 1, 4, 5, 2 /) |
|---|
| 197 | integer, dimension(n_prt), parameter, private :: a0006 = (/ 4, 1, 5, 3, 2 /) |
|---|
| 198 | integer, dimension(n_prt), parameter, private :: a0007 = (/ 2, 5, 1, 3, 4 /) |
|---|
| 199 | integer, dimension(n_prt), parameter, private :: a0008 = (/ 2, 4, 1, 5, 3 /) |
|---|
| 200 | integer, dimension(n_prt), parameter, private :: a0009 = (/ 5, 3, 1, 2, 4 /) |
|---|
| 201 | integer, dimension(n_prt), parameter, private :: a0010 = (/ 4, 5, 1, 2, 3 /) |
|---|
| 202 | integer, dimension(n_prt), parameter, private :: a0011 = (/ 4, 3, 1, 5, 2 /) |
|---|
| 203 | integer, dimension(n_prt), parameter, private :: a0012 = (/ 5, 4, 1, 3, 2 /) |
|---|
| 204 | integer, dimension(n_prt), parameter, private :: a0013 = (/ 2, 3, 5, 1, 4 /) |
|---|
| 205 | integer, dimension(n_prt), parameter, private :: a0014 = (/ 2, 5, 4, 1, 3 /) |
|---|
| 206 | integer, dimension(n_prt), parameter, private :: a0015 = (/ 3, 5, 2, 1, 4 /) |
|---|
| 207 | integer, dimension(n_prt), parameter, private :: a0016 = (/ 5, 4, 2, 1, 3 /) |
|---|
| 208 | integer, dimension(n_prt), parameter, private :: a0017 = (/ 3, 4, 5, 1, 2 /) |
|---|
| 209 | integer, dimension(n_prt), parameter, private :: a0018 = (/ 5, 3, 4, 1, 2 /) |
|---|
| 210 | integer, dimension(n_prt), parameter, private :: a0019 = (/ 2, 3, 4, 5, 1 /) |
|---|
| 211 | integer, dimension(n_prt), parameter, private :: a0020 = (/ 2, 4, 5, 3, 1 /) |
|---|
| 212 | integer, dimension(n_prt), parameter, private :: a0021 = (/ 3, 4, 2, 5, 1 /) |
|---|
| 213 | integer, dimension(n_prt), parameter, private :: a0022 = (/ 4, 5, 2, 3, 1 /) |
|---|
| 214 | integer, dimension(n_prt), parameter, private :: a0023 = (/ 3, 5, 4, 2, 1 /) |
|---|
| 215 | integer, dimension(n_prt), parameter, private :: a0024 = (/ 4, 3, 5, 2, 1 /) |
|---|
| 216 | integer, dimension(n_prt,n_cflow), parameter, private :: table_anticolor_flows & |
|---|
| 217 | = reshape ( (/ a0001, a0002, a0003, a0004, a0005, a0006, a0007, a0008, & |
|---|
| 218 | a0009, a0010, a0011, a0012, a0013, a0014, a0015, a0016, a0017, a0018, a0019, & |
|---|
| 219 | a0020, a0021, a0022, a0023, a0024 /), (/ n_prt, n_cflow/) ) |
|---|
| 220 | integer, dimension(n_cflow), parameter, private :: fn0001 = (/ 243, 27, 27, & |
|---|
| 221 | 27, 27, 27, 27, 3, 27, 3, 3, 27, 27, 3, 27, 27, 3, 27, 3, 27, 27, 27, 3, & |
|---|
| 222 | 3 /) |
|---|
| 223 | integer, dimension(n_cflow), parameter, private :: fd0001 = (/ 64, 64, 64, & |
|---|
| 224 | 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, & |
|---|
| 225 | 64, 64, 64 /) |
|---|
| 226 | logical, dimension(n_cflow), parameter, private :: ff0001 = (/ T, T, T, T, & |
|---|
| 227 | T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T /) |
|---|
| 228 | integer, dimension(n_cflow), parameter, private :: fn0002 = (/ 27, 243, 27, & |
|---|
| 229 | 27, 27, 27, 3, 27, 3, 27, 27, 3, 3, 27, 27, 27, 3, 3, 27, 3, 27, 27, 3, & |
|---|
| 230 | 27 /) |
|---|
| 231 | integer, dimension(n_cflow), parameter, private :: fd0002 = (/ 64, 64, 64, & |
|---|
| 232 | 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, & |
|---|
| 233 | 64, 64, 64 /) |
|---|
| 234 | logical, dimension(n_cflow), parameter, private :: ff0002 = (/ T, T, T, T, & |
|---|
| 235 | T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T /) |
|---|
| 236 | integer, dimension(n_cflow), parameter, private :: fn0003 = (/ 27, 27, 243, & |
|---|
| 237 | 27, 27, 27, 27, 3, 27, 27, 3, 3, 27, 3, 27, 3, 27, 3, 3, 27, 27, 3, 27, & |
|---|
| 238 | 27 /) |
|---|
| 239 | integer, dimension(n_cflow), parameter, private :: fd0003 = (/ 64, 64, 64, & |
|---|
| 240 | 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, & |
|---|
| 241 | 64, 64, 64 /) |
|---|
| 242 | logical, dimension(n_cflow), parameter, private :: ff0003 = (/ T, T, T, T, & |
|---|
| 243 | T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T /) |
|---|
| 244 | integer, dimension(n_cflow), parameter, private :: fn0004 = (/ 27, 27, 27, & |
|---|
| 245 | 243, 27, 27, 3, 27, 27, 27, 3, 27, 3, 27, 3, 27, 3, 27, 27, 3, 3, 3, 27, & |
|---|
| 246 | 27 /) |
|---|
| 247 | integer, dimension(n_cflow), parameter, private :: fd0004 = (/ 64, 64, 64, & |
|---|
| 248 | 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, & |
|---|
| 249 | 64, 64, 64 /) |
|---|
| 250 | logical, dimension(n_cflow), parameter, private :: ff0004 = (/ T, T, T, T, & |
|---|
| 251 | T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T /) |
|---|
| 252 | integer, dimension(n_cflow), parameter, private :: fn0005 = (/ 27, 27, 27, & |
|---|
| 253 | 27, 243, 27, 3, 27, 3, 3, 27, 27, 3, 27, 27, 3, 27, 27, 27, 3, 27, 3, 27, & |
|---|
| 254 | 3 /) |
|---|
| 255 | integer, dimension(n_cflow), parameter, private :: fd0005 = (/ 64, 64, 64, & |
|---|
| 256 | 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, & |
|---|
| 257 | 64, 64, 64 /) |
|---|
| 258 | logical, dimension(n_cflow), parameter, private :: ff0005 = (/ T, T, T, T, & |
|---|
| 259 | T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T /) |
|---|
| 260 | integer, dimension(n_cflow), parameter, private :: fn0006 = (/ 27, 27, 27, & |
|---|
| 261 | 27, 27, 243, 27, 3, 3, 27, 27, 27, 27, 3, 3, 3, 27, 27, 3, 27, 3, 27, 3, & |
|---|
| 262 | 27 /) |
|---|
| 263 | integer, dimension(n_cflow), parameter, private :: fd0006 = (/ 64, 64, 64, & |
|---|
| 264 | 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, & |
|---|
| 265 | 64, 64, 64 /) |
|---|
| 266 | logical, dimension(n_cflow), parameter, private :: ff0006 = (/ T, T, T, T, & |
|---|
| 267 | T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T /) |
|---|
| 268 | integer, dimension(n_cflow), parameter, private :: fn0007 = (/ 27, 3, 27, & |
|---|
| 269 | 3, 3, 27, 243, 27, 27, 27, 27, 27, 27, 27, 27, 3, 3, 3, 27, 27, 3, 27, & |
|---|
| 270 | 27, 3 /) |
|---|
| 271 | integer, dimension(n_cflow), parameter, private :: fd0007 = (/ 64, 64, 64, & |
|---|
| 272 | 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, & |
|---|
| 273 | 64, 64, 64 /) |
|---|
| 274 | logical, dimension(n_cflow), parameter, private :: ff0007 = (/ T, T, T, T, & |
|---|
| 275 | T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T /) |
|---|
| 276 | integer, dimension(n_cflow), parameter, private :: fn0008 = (/ 3, 27, 3, 27, & |
|---|
| 277 | 27, 3, 27, 243, 27, 27, 27, 27, 27, 27, 3, 27, 27, 3, 27, 27, 27, 3, 3, & |
|---|
| 278 | 3 /) |
|---|
| 279 | integer, dimension(n_cflow), parameter, private :: fd0008 = (/ 64, 64, 64, & |
|---|
| 280 | 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, & |
|---|
| 281 | 64, 64, 64 /) |
|---|
| 282 | logical, dimension(n_cflow), parameter, private :: ff0008 = (/ T, T, T, T, & |
|---|
| 283 | T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T /) |
|---|
| 284 | integer, dimension(n_cflow), parameter, private :: fn0009 = (/ 27, 3, 27, & |
|---|
| 285 | 27, 3, 3, 27, 27, 243, 27, 27, 27, 27, 3, 27, 27, 3, 27, 27, 3, 3, 3, 27, & |
|---|
| 286 | 27 /) |
|---|
| 287 | integer, dimension(n_cflow), parameter, private :: fd0009 = (/ 64, 64, 64, & |
|---|
| 288 | 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, & |
|---|
| 289 | 64, 64, 64 /) |
|---|
| 290 | logical, dimension(n_cflow), parameter, private :: ff0009 = (/ T, T, T, T, & |
|---|
| 291 | T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T /) |
|---|
| 292 | integer, dimension(n_cflow), parameter, private :: fn0010 = (/ 3, 27, 27, & |
|---|
| 293 | 27, 3, 27, 27, 27, 27, 243, 27, 27, 3, 27, 27, 27, 3, 3, 3, 3, 3, 27, 27, & |
|---|
| 294 | 27 /) |
|---|
| 295 | integer, dimension(n_cflow), parameter, private :: fd0010 = (/ 64, 64, 64, & |
|---|
| 296 | 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, & |
|---|
| 297 | 64, 64, 64 /) |
|---|
| 298 | logical, dimension(n_cflow), parameter, private :: ff0010 = (/ T, T, T, T, & |
|---|
| 299 | T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T /) |
|---|
| 300 | integer, dimension(n_cflow), parameter, private :: fn0011 = (/ 3, 27, 3, 3, & |
|---|
| 301 | 27, 27, 27, 27, 27, 27, 243, 27, 27, 3, 3, 3, 27, 27, 27, 3, 27, 27, 3, & |
|---|
| 302 | 27 /) |
|---|
| 303 | integer, dimension(n_cflow), parameter, private :: fd0011 = (/ 64, 64, 64, & |
|---|
| 304 | 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, & |
|---|
| 305 | 64, 64, 64 /) |
|---|
| 306 | logical, dimension(n_cflow), parameter, private :: ff0011 = (/ T, T, T, T, & |
|---|
| 307 | T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T /) |
|---|
| 308 | integer, dimension(n_cflow), parameter, private :: fn0012 = (/ 27, 3, 3, 27, & |
|---|
| 309 | 27, 27, 27, 27, 27, 27, 27, 243, 3, 3, 3, 27, 27, 27, 3, 27, 27, 27, 3, & |
|---|
| 310 | 3 /) |
|---|
| 311 | integer, dimension(n_cflow), parameter, private :: fd0012 = (/ 64, 64, 64, & |
|---|
| 312 | 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, & |
|---|
| 313 | 64, 64, 64 /) |
|---|
| 314 | logical, dimension(n_cflow), parameter, private :: ff0012 = (/ T, T, T, T, & |
|---|
| 315 | T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T /) |
|---|
| 316 | integer, dimension(n_cflow), parameter, private :: fn0013 = (/ 27, 3, 27, & |
|---|
| 317 | 3, 3, 27, 27, 27, 27, 3, 27, 3, 243, 27, 27, 27, 27, 27, 27, 27, 3, 3, & |
|---|
| 318 | 3, 27 /) |
|---|
| 319 | integer, dimension(n_cflow), parameter, private :: fd0013 = (/ 64, 64, 64, & |
|---|
| 320 | 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, & |
|---|
| 321 | 64, 64, 64 /) |
|---|
| 322 | logical, dimension(n_cflow), parameter, private :: ff0013 = (/ T, T, T, T, & |
|---|
| 323 | T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T /) |
|---|
| 324 | integer, dimension(n_cflow), parameter, private :: fn0014 = (/ 3, 27, 3, 27, & |
|---|
| 325 | 27, 3, 27, 27, 3, 27, 3, 3, 27, 243, 27, 27, 27, 27, 27, 27, 3, 27, 27, & |
|---|
| 326 | 3 /) |
|---|
| 327 | integer, dimension(n_cflow), parameter, private :: fd0014 = (/ 64, 64, 64, & |
|---|
| 328 | 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, & |
|---|
| 329 | 64, 64, 64 /) |
|---|
| 330 | logical, dimension(n_cflow), parameter, private :: ff0014 = (/ T, T, T, T, & |
|---|
| 331 | T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T /) |
|---|
| 332 | integer, dimension(n_cflow), parameter, private :: fn0015 = (/ 27, 27, 27, & |
|---|
| 333 | 3, 27, 3, 27, 3, 27, 27, 3, 3, 27, 27, 243, 27, 27, 27, 3, 3, 27, 27, 27, & |
|---|
| 334 | 3 /) |
|---|
| 335 | integer, dimension(n_cflow), parameter, private :: fd0015 = (/ 64, 64, 64, & |
|---|
| 336 | 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, & |
|---|
| 337 | 64, 64, 64 /) |
|---|
| 338 | logical, dimension(n_cflow), parameter, private :: ff0015 = (/ T, T, T, T, & |
|---|
| 339 | T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T /) |
|---|
| 340 | integer, dimension(n_cflow), parameter, private :: fn0016 = (/ 27, 27, 3, & |
|---|
| 341 | 27, 3, 3, 3, 27, 27, 27, 3, 27, 27, 27, 27, 243, 27, 27, 3, 27, 27, 27, & |
|---|
| 342 | 3, 3 /) |
|---|
| 343 | integer, dimension(n_cflow), parameter, private :: fd0016 = (/ 64, 64, 64, & |
|---|
| 344 | 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, & |
|---|
| 345 | 64, 64, 64 /) |
|---|
| 346 | logical, dimension(n_cflow), parameter, private :: ff0016 = (/ T, T, T, T, & |
|---|
| 347 | T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T /) |
|---|
| 348 | integer, dimension(n_cflow), parameter, private :: fn0017 = (/ 3, 3, 27, 3, & |
|---|
| 349 | 27, 27, 3, 27, 3, 3, 27, 27, 27, 27, 27, 27, 243, 27, 3, 27, 27, 3, 27, & |
|---|
| 350 | 27 /) |
|---|
| 351 | integer, dimension(n_cflow), parameter, private :: fd0017 = (/ 64, 64, 64, & |
|---|
| 352 | 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, & |
|---|
| 353 | 64, 64, 64 /) |
|---|
| 354 | logical, dimension(n_cflow), parameter, private :: ff0017 = (/ T, T, T, T, & |
|---|
| 355 | T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T /) |
|---|
| 356 | integer, dimension(n_cflow), parameter, private :: fn0018 = (/ 27, 3, 3, 27, & |
|---|
| 357 | 27, 27, 3, 3, 27, 3, 27, 27, 27, 27, 27, 27, 27, 243, 27, 3, 3, 3, 27, & |
|---|
| 358 | 27 /) |
|---|
| 359 | integer, dimension(n_cflow), parameter, private :: fd0018 = (/ 64, 64, 64, & |
|---|
| 360 | 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, & |
|---|
| 361 | 64, 64, 64 /) |
|---|
| 362 | logical, dimension(n_cflow), parameter, private :: ff0018 = (/ T, T, T, T, & |
|---|
| 363 | T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T /) |
|---|
| 364 | integer, dimension(n_cflow), parameter, private :: fn0019 = (/ 3, 27, 3, 27, & |
|---|
| 365 | 27, 3, 27, 27, 27, 3, 27, 3, 27, 27, 3, 3, 3, 27, 243, 27, 27, 27, 27, & |
|---|
| 366 | 27 /) |
|---|
| 367 | integer, dimension(n_cflow), parameter, private :: fd0019 = (/ 64, 64, 64, & |
|---|
| 368 | 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, & |
|---|
| 369 | 64, 64, 64 /) |
|---|
| 370 | logical, dimension(n_cflow), parameter, private :: ff0019 = (/ T, T, T, T, & |
|---|
| 371 | T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T /) |
|---|
| 372 | integer, dimension(n_cflow), parameter, private :: fn0020 = (/ 27, 3, 27, & |
|---|
| 373 | 3, 3, 27, 27, 27, 3, 3, 3, 27, 27, 27, 3, 27, 27, 3, 27, 243, 27, 27, 27, & |
|---|
| 374 | 27 /) |
|---|
| 375 | integer, dimension(n_cflow), parameter, private :: fd0020 = (/ 64, 64, 64, & |
|---|
| 376 | 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, & |
|---|
| 377 | 64, 64, 64 /) |
|---|
| 378 | logical, dimension(n_cflow), parameter, private :: ff0020 = (/ T, T, T, T, & |
|---|
| 379 | T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T /) |
|---|
| 380 | integer, dimension(n_cflow), parameter, private :: fn0021 = (/ 27, 27, 27, & |
|---|
| 381 | 3, 27, 3, 3, 27, 3, 3, 27, 27, 3, 3, 27, 27, 27, 3, 27, 27, 243, 27, 27, & |
|---|
| 382 | 27 /) |
|---|
| 383 | integer, dimension(n_cflow), parameter, private :: fd0021 = (/ 64, 64, 64, & |
|---|
| 384 | 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, & |
|---|
| 385 | 64, 64, 64 /) |
|---|
| 386 | logical, dimension(n_cflow), parameter, private :: ff0021 = (/ T, T, T, T, & |
|---|
| 387 | T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T /) |
|---|
| 388 | integer, dimension(n_cflow), parameter, private :: fn0022 = (/ 27, 27, 3, & |
|---|
| 389 | 3, 3, 27, 27, 3, 3, 27, 27, 27, 3, 27, 27, 27, 3, 3, 27, 27, 27, 243, 27, & |
|---|
| 390 | 27 /) |
|---|
| 391 | integer, dimension(n_cflow), parameter, private :: fd0022 = (/ 64, 64, 64, & |
|---|
| 392 | 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, & |
|---|
| 393 | 64, 64, 64 /) |
|---|
| 394 | logical, dimension(n_cflow), parameter, private :: ff0022 = (/ T, T, T, T, & |
|---|
| 395 | T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T /) |
|---|
| 396 | integer, dimension(n_cflow), parameter, private :: fn0023 = (/ 3, 3, 27, 27, & |
|---|
| 397 | 27, 3, 27, 3, 27, 27, 3, 3, 3, 27, 27, 3, 27, 27, 27, 27, 27, 27, 243, & |
|---|
| 398 | 27 /) |
|---|
| 399 | integer, dimension(n_cflow), parameter, private :: fd0023 = (/ 64, 64, 64, & |
|---|
| 400 | 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, & |
|---|
| 401 | 64, 64, 64 /) |
|---|
| 402 | logical, dimension(n_cflow), parameter, private :: ff0023 = (/ T, T, T, T, & |
|---|
| 403 | T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T /) |
|---|
| 404 | integer, dimension(n_cflow), parameter, private :: fn0024 = (/ 3, 27, 27, & |
|---|
| 405 | 27, 3, 27, 3, 3, 27, 27, 27, 3, 27, 3, 3, 3, 27, 27, 27, 27, 27, 27, 27, & |
|---|
| 406 | 243 /) |
|---|
| 407 | integer, dimension(n_cflow), parameter, private :: fd0024 = (/ 64, 64, 64, & |
|---|
| 408 | 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, & |
|---|
| 409 | 64, 64, 64 /) |
|---|
| 410 | logical, dimension(n_cflow), parameter, private :: ff0024 = (/ T, T, T, T, & |
|---|
| 411 | T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T /) |
|---|
| 412 | integer, dimension(n_cflow,n_cflow), parameter, private :: flow_num = reshape & |
|---|
| 413 | ( (/ fn0001, fn0002, fn0003, fn0004, fn0005, fn0006, fn0007, fn0008, fn0009, & |
|---|
| 414 | fn0010, fn0011, fn0012, fn0013, fn0014, fn0015, fn0016, fn0017, fn0018, & |
|---|
| 415 | fn0019, fn0020, fn0021, fn0022, fn0023, fn0024 /), (/ n_cflow, n_cflow /) ) |
|---|
| 416 | integer, dimension(n_cflow,n_cflow), parameter, private :: flow_den = reshape & |
|---|
| 417 | ( (/ fd0001, fd0002, fd0003, fd0004, fd0005, fd0006, fd0007, fd0008, fd0009, & |
|---|
| 418 | fd0010, fd0011, fd0012, fd0013, fd0014, fd0015, fd0016, fd0017, fd0018, & |
|---|
| 419 | fd0019, fd0020, fd0021, fd0022, fd0023, fd0024 /), (/ n_cflow, n_cflow /) ) |
|---|
| 420 | logical, dimension(n_cflow,n_cflow), parameter, private :: flow_flag = reshape & |
|---|
| 421 | ( (/ ff0001, ff0002, ff0003, ff0004, ff0005, ff0006, ff0007, ff0008, ff0009, & |
|---|
| 422 | ff0010, ff0011, ff0012, ff0013, ff0014, ff0015, ff0016, ff0017, ff0018, & |
|---|
| 423 | ff0019, ff0020, ff0021, ff0022, ff0023, ff0024 /), (/ n_cflow, n_cflow /) ) |
|---|
| 424 | real(kind=omega_prec), dimension(n_cflow,n_cflow), save, private :: flow_coeff |
|---|
| 425 | logical, dimension(n_cflow), parameter, private :: flow_is_physical = (/ T, & |
|---|
| 426 | T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T /) |
|---|
| 427 | |
|---|
| 428 | logical, dimension(n_cflow), parameter, private :: fc0001 = (/T, T, T, T, & |
|---|
| 429 | T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T/) |
|---|
| 430 | logical, dimension(n_cflow,n_flv), parameter, private :: flv_col_flag = reshape & |
|---|
| 431 | ( (/ fc0001 /), (/ n_cflow, n_flv/) ) |
|---|
| 432 | |
|---|
| 433 | integer, dimension(n_flv), parameter, private :: table_symmetry = (/ 1 /) |
|---|
| 434 | |
|---|
| 435 | contains |
|---|
| 436 | |
|---|
| 437 | subroutine allocate_zero_1 (zero) |
|---|
| 438 | integer, dimension(:,:), pointer :: zero |
|---|
| 439 | allocate (zero(size(table_spin_states,dim=2), size(table_flavor_states, & |
|---|
| 440 | dim=2))) |
|---|
| 441 | zero = 0 |
|---|
| 442 | end subroutine allocate_zero_1 |
|---|
| 443 | |
|---|
| 444 | subroutine allocate_zero_2 (zero) |
|---|
| 445 | integer, dimension(:,:,:,:), pointer :: zero |
|---|
| 446 | allocate(zero(size(table_spin_states_in,dim=2), size(table_flavor_states_in, & |
|---|
| 447 | dim=2), size(table_spin_states_out,dim=2), size(table_flavor_states_out, & |
|---|
| 448 | dim=2))) |
|---|
| 449 | zero = 0 |
|---|
| 450 | end subroutine allocate_zero_2 |
|---|
| 451 | |
|---|
| 452 | subroutine create () |
|---|
| 453 | interface |
|---|
| 454 | function omp_get_max_threads () result (res) |
|---|
| 455 | integer :: res |
|---|
| 456 | end function omp_get_max_threads |
|---|
| 457 | end interface |
|---|
| 458 | |
|---|
| 459 | if (omp_get_max_threads () > 8) then |
|---|
| 460 | print * |
|---|
| 461 | print *, "FATAL: trying to run ", omp_get_max_threads (), "threads, but only" |
|---|
| 462 | print *, "8 were provided for at configure and build time. To get rid of" |
|---|
| 463 | print *, "this error, please rebuild with a higher number of threads" |
|---|
| 464 | print *, "(configure --enable-max-threads=nt_max) or reduce the number of" |
|---|
| 465 | print *, "actual threads by setting OMP_MAX_THREADS." |
|---|
| 466 | call exit (1) |
|---|
| 467 | end if |
|---|
| 468 | flow_coeff = real (flow_num, kind=omega_prec) / real (flow_den, kind=omega_prec) |
|---|
| 469 | end subroutine create |
|---|
| 470 | subroutine reset (par) |
|---|
| 471 | type(parameter_set), intent(in) :: par |
|---|
| 472 | call import_from_whizard (par) |
|---|
| 473 | end subroutine reset |
|---|
| 474 | subroutine destroy () |
|---|
| 475 | end subroutine destroy |
|---|
| 476 | |
|---|
| 477 | pure function number_particles () result (n) |
|---|
| 478 | integer :: n |
|---|
| 479 | n = size (table_flavor_states, dim=1) |
|---|
| 480 | end function number_particles |
|---|
| 481 | pure function number_particles_in () result (n) |
|---|
| 482 | integer :: n |
|---|
| 483 | n = size (table_flavor_states_in, dim=1) |
|---|
| 484 | end function number_particles_in |
|---|
| 485 | pure function number_particles_out () result (n) |
|---|
| 486 | integer :: n |
|---|
| 487 | n = size (table_flavor_states_out, dim=1) |
|---|
| 488 | end function number_particles_out |
|---|
| 489 | |
|---|
| 490 | pure function number_spin_states () result (n) |
|---|
| 491 | integer :: n |
|---|
| 492 | n = size (table_spin_states, dim=2) |
|---|
| 493 | end function number_spin_states |
|---|
| 494 | pure subroutine spin_states (a) |
|---|
| 495 | integer, dimension(:,:), intent(inout) :: a |
|---|
| 496 | a = table_spin_states |
|---|
| 497 | end subroutine spin_states |
|---|
| 498 | pure function number_spin_states_in () result (n) |
|---|
| 499 | integer :: n |
|---|
| 500 | n = size (table_spin_states_in, dim=2) |
|---|
| 501 | end function number_spin_states_in |
|---|
| 502 | pure subroutine spin_states_in (a) |
|---|
| 503 | integer, dimension(:,:), intent(inout) :: a |
|---|
| 504 | a = table_spin_states_in |
|---|
| 505 | end subroutine spin_states_in |
|---|
| 506 | pure function number_spin_states_out () result (n) |
|---|
| 507 | integer :: n |
|---|
| 508 | n = size (table_spin_states_out, dim=2) |
|---|
| 509 | end function number_spin_states_out |
|---|
| 510 | pure subroutine spin_states_out (a) |
|---|
| 511 | integer, dimension(:,:), intent(inout) :: a |
|---|
| 512 | a = table_spin_states_out |
|---|
| 513 | end subroutine spin_states_out |
|---|
| 514 | |
|---|
| 515 | pure function number_flavor_states () result (n) |
|---|
| 516 | integer :: n |
|---|
| 517 | n = size (table_flavor_states, dim=2) |
|---|
| 518 | end function number_flavor_states |
|---|
| 519 | pure subroutine flavor_states (a) |
|---|
| 520 | integer, dimension(:,:), intent(inout) :: a |
|---|
| 521 | a = table_flavor_states |
|---|
| 522 | end subroutine flavor_states |
|---|
| 523 | pure function number_flavor_states_in () result (n) |
|---|
| 524 | integer :: n |
|---|
| 525 | n = size (table_flavor_states_in, dim=2) |
|---|
| 526 | end function number_flavor_states_in |
|---|
| 527 | pure subroutine flavor_states_in (a) |
|---|
| 528 | integer, dimension(:,:), intent(inout) :: a |
|---|
| 529 | a = table_flavor_states_in |
|---|
| 530 | end subroutine flavor_states_in |
|---|
| 531 | pure function number_flavor_states_out () result (n) |
|---|
| 532 | integer :: n |
|---|
| 533 | n = size (table_flavor_states_out, dim=2) |
|---|
| 534 | end function number_flavor_states_out |
|---|
| 535 | pure subroutine flavor_states_out (a) |
|---|
| 536 | integer, dimension(:,:), intent(inout) :: a |
|---|
| 537 | a = table_flavor_states_out |
|---|
| 538 | end subroutine flavor_states_out |
|---|
| 539 | |
|---|
| 540 | function number_flavor_zeros () result (n) |
|---|
| 541 | integer :: n |
|---|
| 542 | n = 0 |
|---|
| 543 | end function number_flavor_zeros |
|---|
| 544 | subroutine flavor_zeros (a) |
|---|
| 545 | integer, dimension(:,:) :: a |
|---|
| 546 | a = table_flavor_zeros |
|---|
| 547 | end subroutine flavor_zeros |
|---|
| 548 | function number_flavor_zeros_in () result (n) |
|---|
| 549 | integer :: n |
|---|
| 550 | n = 0 |
|---|
| 551 | end function number_flavor_zeros_in |
|---|
| 552 | subroutine flavor_zeros_in (a) |
|---|
| 553 | integer, dimension(:,:) :: a |
|---|
| 554 | a = table_flavor_zeros_in |
|---|
| 555 | end subroutine flavor_zeros_in |
|---|
| 556 | function number_flavor_zeros_out () result (n) |
|---|
| 557 | integer :: n |
|---|
| 558 | n = 0 |
|---|
| 559 | end function number_flavor_zeros_out |
|---|
| 560 | subroutine flavor_zeros_out (a) |
|---|
| 561 | integer, dimension(:,:) :: a |
|---|
| 562 | a = table_flavor_zeros_out |
|---|
| 563 | end subroutine flavor_zeros_out |
|---|
| 564 | |
|---|
| 565 | function number_color_flows () result (n) |
|---|
| 566 | integer :: n |
|---|
| 567 | n = size (table_color_flows, dim=2) |
|---|
| 568 | end function number_color_flows |
|---|
| 569 | subroutine color_flows (a) |
|---|
| 570 | integer, dimension(:,:), intent(inout) :: a |
|---|
| 571 | a = table_color_flows |
|---|
| 572 | end subroutine color_flows |
|---|
| 573 | subroutine anticolor_flows (a) |
|---|
| 574 | integer, dimension(:,:), intent(inout) :: a |
|---|
| 575 | a = table_anticolor_flows |
|---|
| 576 | end subroutine anticolor_flows |
|---|
| 577 | |
|---|
| 578 | subroutine calculate_amplitudes (amp, k, zero_ct, n) |
|---|
| 579 | use test_decl |
|---|
| 580 | use test_pamp_21_21_21_21_21 |
|---|
| 581 | integer :: nt |
|---|
| 582 | complex(kind=omega_prec), dimension(:,:,:), intent(out) :: amp |
|---|
| 583 | integer, dimension(:,:,:,:), intent(inout) :: zero_ct |
|---|
| 584 | integer, intent(in) :: n |
|---|
| 585 | integer, parameter :: SAMPLE = 10, REPEAT = 5 |
|---|
| 586 | real(kind=omega_prec), dimension(0:,:), intent(in) :: k |
|---|
| 587 | p1 = - k(:,1) ! incoming gl/1/2 |
|---|
| 588 | p2 = - k(:,2) ! incoming gl/2/3 |
|---|
| 589 | p3 = k(:,3) ! outgoing gl/4/3 |
|---|
| 590 | p4 = k(:,4) ! outgoing gl/5/4 |
|---|
| 591 | p5 = k(:,5) ! outgoing gl/1/5 |
|---|
| 592 | p12 = p1 + p2 |
|---|
| 593 | p23 = p2 + p3 |
|---|
| 594 | p34 = p3 + p4 |
|---|
| 595 | p15 = p1 + p5 |
|---|
| 596 | p45 = p4 + p5 |
|---|
| 597 | p14 = p1 + p4 |
|---|
| 598 | p35 = p3 + p5 |
|---|
| 599 | p13 = p1 + p3 |
|---|
| 600 | p24 = p2 + p4 |
|---|
| 601 | p25 = p2 + p5 |
|---|
| 602 | amp = 0 |
|---|
| 603 | flv_hel_flag = .false. |
|---|
| 604 | !$OMP PARALLEL DEFAULT(SHARED) PRIVATE(h, hi, ho, nt) |
|---|
| 605 | !$OMP DO |
|---|
| 606 | do h =1, n_hel |
|---|
| 607 | hi = (h - 1) / n_hel_out + 1 |
|---|
| 608 | ho = mod (h - 1, n_hel_out) + 1 |
|---|
| 609 | nt = omp_get_thread_num () + 1 |
|---|
| 610 | if (zero_ct(hi,1,ho,1) > REPEAT) cycle |
|---|
| 611 | s(:, nt) = table_spin_states (:,h) |
|---|
| 612 | call calc_test_pamp_21_21_21_21_21 (nt) |
|---|
| 613 | ! flavor: [21, 21, 21, 21, 21] color: (2, 3, 4, 5, 1) |
|---|
| 614 | ! (5, 1, 2, 3, 4) |
|---|
| 615 | amp(1,h,1) = + bk1_1_1(nt) + bk1_1_2(nt) + bk1_1_3(nt) + bk1_1_4(nt) + bk1_1_5(nt) + bk1_1_6(nt) & |
|---|
| 616 | + bk1_1_7(nt) + bk1_1_8(nt) |
|---|
| 617 | ! amp(1,h,1) = amp(1,h,1) ! 3 vertices, 2 propagators |
|---|
| 618 | flv_hel_flag(h,1) = flv_hel_flag(h,1) .or. amp(1,h,1) /= 0 |
|---|
| 619 | amp(1,h,1) = amp(1,h,1) / sqrt(6.0_omega_prec) ! symmetry factor |
|---|
| 620 | ! Number of external adjoints: 5 |
|---|
| 621 | ! flavor: [21, 21, 21, 21, 21] color: (2, 3, 5, 1, 4) |
|---|
| 622 | ! (4, 1, 2, 5, 3) |
|---|
| 623 | amp(2,h,1) = + bk2_1_1(nt) + bk2_1_2(nt) + bk2_1_3(nt) + bk2_1_4(nt) + bk2_1_5(nt) + bk2_1_6(nt) & |
|---|
| 624 | + bk2_1_7(nt) + bk2_1_8(nt) |
|---|
| 625 | ! amp(2,h,1) = amp(2,h,1) ! 3 vertices, 2 propagators |
|---|
| 626 | flv_hel_flag(h,1) = flv_hel_flag(h,1) .or. amp(2,h,1) /= 0 |
|---|
| 627 | amp(2,h,1) = amp(2,h,1) / sqrt(6.0_omega_prec) ! symmetry factor |
|---|
| 628 | ! Number of external adjoints: 5 |
|---|
| 629 | ! flavor: [21, 21, 21, 21, 21] color: (2, 4, 1, 5, 3) |
|---|
| 630 | ! (3, 1, 5, 2, 4) |
|---|
| 631 | amp(3,h,1) = + bk3_1_1(nt) + bk3_1_2(nt) + bk3_1_3(nt) + bk3_1_4(nt) + bk3_1_5(nt) + bk3_1_6(nt) & |
|---|
| 632 | + bk3_1_7(nt) + bk3_1_8(nt) |
|---|
| 633 | ! amp(3,h,1) = amp(3,h,1) ! 3 vertices, 2 propagators |
|---|
| 634 | flv_hel_flag(h,1) = flv_hel_flag(h,1) .or. amp(3,h,1) /= 0 |
|---|
| 635 | amp(3,h,1) = amp(3,h,1) / sqrt(6.0_omega_prec) ! symmetry factor |
|---|
| 636 | ! Number of external adjoints: 5 |
|---|
| 637 | ! flavor: [21, 21, 21, 21, 21] color: (2, 4, 5, 3, 1) |
|---|
| 638 | ! (5, 1, 4, 2, 3) |
|---|
| 639 | amp(4,h,1) = + bk4_1_1(nt) + bk4_1_2(nt) + bk4_1_3(nt) + bk4_1_4(nt) + bk4_1_5(nt) + bk4_1_6(nt) & |
|---|
| 640 | + bk4_1_7(nt) + bk4_1_8(nt) |
|---|
| 641 | ! amp(4,h,1) = amp(4,h,1) ! 3 vertices, 2 propagators |
|---|
| 642 | flv_hel_flag(h,1) = flv_hel_flag(h,1) .or. amp(4,h,1) /= 0 |
|---|
| 643 | amp(4,h,1) = amp(4,h,1) / sqrt(6.0_omega_prec) ! symmetry factor |
|---|
| 644 | ! Number of external adjoints: 5 |
|---|
| 645 | ! flavor: [21, 21, 21, 21, 21] color: (2, 5, 1, 3, 4) |
|---|
| 646 | ! (3, 1, 4, 5, 2) |
|---|
| 647 | amp(5,h,1) = + bk5_1_1(nt) + bk5_1_2(nt) + bk5_1_3(nt) + bk5_1_4(nt) + bk5_1_5(nt) + bk5_1_6(nt) & |
|---|
| 648 | + bk5_1_7(nt) + bk5_1_8(nt) |
|---|
| 649 | ! amp(5,h,1) = amp(5,h,1) ! 3 vertices, 2 propagators |
|---|
| 650 | flv_hel_flag(h,1) = flv_hel_flag(h,1) .or. amp(5,h,1) /= 0 |
|---|
| 651 | amp(5,h,1) = amp(5,h,1) / sqrt(6.0_omega_prec) ! symmetry factor |
|---|
| 652 | ! Number of external adjoints: 5 |
|---|
| 653 | ! flavor: [21, 21, 21, 21, 21] color: (2, 5, 4, 1, 3) |
|---|
| 654 | ! (4, 1, 5, 3, 2) |
|---|
| 655 | amp(6,h,1) = + bk6_1_1(nt) + bk6_1_2(nt) + bk6_1_3(nt) + bk6_1_4(nt) + bk6_1_5(nt) + bk6_1_6(nt) & |
|---|
| 656 | + bk6_1_7(nt) + bk6_1_8(nt) |
|---|
| 657 | ! amp(6,h,1) = amp(6,h,1) ! 3 vertices, 2 propagators |
|---|
| 658 | flv_hel_flag(h,1) = flv_hel_flag(h,1) .or. amp(6,h,1) /= 0 |
|---|
| 659 | amp(6,h,1) = amp(6,h,1) / sqrt(6.0_omega_prec) ! symmetry factor |
|---|
| 660 | ! Number of external adjoints: 5 |
|---|
| 661 | ! flavor: [21, 21, 21, 21, 21] color: (3, 1, 4, 5, 2) |
|---|
| 662 | ! (2, 5, 1, 3, 4) |
|---|
| 663 | amp(7,h,1) = + bk7_1_1(nt) + bk7_1_2(nt) + bk7_1_3(nt) + bk7_1_4(nt) + bk7_1_5(nt) + bk7_1_6(nt) & |
|---|
| 664 | + bk7_1_7(nt) + bk7_1_8(nt) |
|---|
| 665 | ! amp(7,h,1) = amp(7,h,1) ! 3 vertices, 2 propagators |
|---|
| 666 | flv_hel_flag(h,1) = flv_hel_flag(h,1) .or. amp(7,h,1) /= 0 |
|---|
| 667 | amp(7,h,1) = amp(7,h,1) / sqrt(6.0_omega_prec) ! symmetry factor |
|---|
| 668 | ! Number of external adjoints: 5 |
|---|
| 669 | ! flavor: [21, 21, 21, 21, 21] color: (3, 1, 5, 2, 4) |
|---|
| 670 | ! (2, 4, 1, 5, 3) |
|---|
| 671 | amp(8,h,1) = + bk8_1_1(nt) + bk8_1_2(nt) + bk8_1_3(nt) + bk8_1_4(nt) + bk8_1_5(nt) + bk8_1_6(nt) & |
|---|
| 672 | + bk8_1_7(nt) + bk8_1_8(nt) |
|---|
| 673 | ! amp(8,h,1) = amp(8,h,1) ! 3 vertices, 2 propagators |
|---|
| 674 | flv_hel_flag(h,1) = flv_hel_flag(h,1) .or. amp(8,h,1) /= 0 |
|---|
| 675 | amp(8,h,1) = amp(8,h,1) / sqrt(6.0_omega_prec) ! symmetry factor |
|---|
| 676 | ! Number of external adjoints: 5 |
|---|
| 677 | ! flavor: [21, 21, 21, 21, 21] color: (3, 4, 2, 5, 1) |
|---|
| 678 | ! (5, 3, 1, 2, 4) |
|---|
| 679 | amp(9,h,1) = + bk9_1_1(nt) + bk9_1_2(nt) + bk9_1_3(nt) + bk9_1_4(nt) + bk9_1_5(nt) + bk9_1_6(nt) & |
|---|
| 680 | + bk9_1_7(nt) + bk9_1_8(nt) |
|---|
| 681 | ! amp(9,h,1) = amp(9,h,1) ! 3 vertices, 2 propagators |
|---|
| 682 | flv_hel_flag(h,1) = flv_hel_flag(h,1) .or. amp(9,h,1) /= 0 |
|---|
| 683 | amp(9,h,1) = amp(9,h,1) / sqrt(6.0_omega_prec) ! symmetry factor |
|---|
| 684 | ! Number of external adjoints: 5 |
|---|
| 685 | ! flavor: [21, 21, 21, 21, 21] color: (3, 4, 5, 1, 2) |
|---|
| 686 | ! (4, 5, 1, 2, 3) |
|---|
| 687 | amp(10,h,1) = + bk10_1_1(nt) + bk10_1_2(nt) + bk10_1_3(nt) + bk10_1_4(nt) + bk10_1_5(nt) & |
|---|
| 688 | + bk10_1_6(nt) + bk10_1_7(nt) + bk10_1_8(nt) |
|---|
| 689 | ! amp(10,h,1) = amp(10,h,1) ! 3 vertices, 2 propagators |
|---|
| 690 | flv_hel_flag(h,1) = flv_hel_flag(h,1) .or. amp(10,h,1) /= 0 |
|---|
| 691 | amp(10,h,1) = amp(10,h,1) / sqrt(6.0_omega_prec) ! symmetry factor |
|---|
| 692 | ! Number of external adjoints: 5 |
|---|
| 693 | ! flavor: [21, 21, 21, 21, 21] color: (3, 5, 2, 1, 4) |
|---|
| 694 | ! (4, 3, 1, 5, 2) |
|---|
| 695 | amp(11,h,1) = + bk11_1_1(nt) + bk11_1_2(nt) + bk11_1_3(nt) + bk11_1_4(nt) + bk11_1_5(nt) & |
|---|
| 696 | + bk11_1_6(nt) + bk11_1_7(nt) + bk11_1_8(nt) |
|---|
| 697 | ! amp(11,h,1) = amp(11,h,1) ! 3 vertices, 2 propagators |
|---|
| 698 | flv_hel_flag(h,1) = flv_hel_flag(h,1) .or. amp(11,h,1) /= 0 |
|---|
| 699 | amp(11,h,1) = amp(11,h,1) / sqrt(6.0_omega_prec) ! symmetry factor |
|---|
| 700 | ! Number of external adjoints: 5 |
|---|
| 701 | ! flavor: [21, 21, 21, 21, 21] color: (3, 5, 4, 2, 1) |
|---|
| 702 | ! (5, 4, 1, 3, 2) |
|---|
| 703 | amp(12,h,1) = + bk12_1_1(nt) + bk12_1_2(nt) + bk12_1_3(nt) + bk12_1_4(nt) + bk12_1_5(nt) & |
|---|
| 704 | + bk12_1_6(nt) + bk12_1_7(nt) + bk12_1_8(nt) |
|---|
| 705 | ! amp(12,h,1) = amp(12,h,1) ! 3 vertices, 2 propagators |
|---|
| 706 | flv_hel_flag(h,1) = flv_hel_flag(h,1) .or. amp(12,h,1) /= 0 |
|---|
| 707 | amp(12,h,1) = amp(12,h,1) / sqrt(6.0_omega_prec) ! symmetry factor |
|---|
| 708 | ! Number of external adjoints: 5 |
|---|
| 709 | ! flavor: [21, 21, 21, 21, 21] color: (4, 1, 2, 5, 3) |
|---|
| 710 | ! (2, 3, 5, 1, 4) |
|---|
| 711 | amp(13,h,1) = + bk13_1_1(nt) + bk13_1_2(nt) + bk13_1_3(nt) + bk13_1_4(nt) + bk13_1_5(nt) & |
|---|
| 712 | + bk13_1_6(nt) + bk13_1_7(nt) + bk13_1_8(nt) |
|---|
| 713 | ! amp(13,h,1) = amp(13,h,1) ! 3 vertices, 2 propagators |
|---|
| 714 | flv_hel_flag(h,1) = flv_hel_flag(h,1) .or. amp(13,h,1) /= 0 |
|---|
| 715 | amp(13,h,1) = amp(13,h,1) / sqrt(6.0_omega_prec) ! symmetry factor |
|---|
| 716 | ! Number of external adjoints: 5 |
|---|
| 717 | ! flavor: [21, 21, 21, 21, 21] color: (4, 1, 5, 3, 2) |
|---|
| 718 | ! (2, 5, 4, 1, 3) |
|---|
| 719 | amp(14,h,1) = + bk14_1_1(nt) + bk14_1_2(nt) + bk14_1_3(nt) + bk14_1_4(nt) + bk14_1_5(nt) & |
|---|
| 720 | + bk14_1_6(nt) + bk14_1_7(nt) + bk14_1_8(nt) |
|---|
| 721 | ! amp(14,h,1) = amp(14,h,1) ! 3 vertices, 2 propagators |
|---|
| 722 | flv_hel_flag(h,1) = flv_hel_flag(h,1) .or. amp(14,h,1) /= 0 |
|---|
| 723 | amp(14,h,1) = amp(14,h,1) / sqrt(6.0_omega_prec) ! symmetry factor |
|---|
| 724 | ! Number of external adjoints: 5 |
|---|
| 725 | ! flavor: [21, 21, 21, 21, 21] color: (4, 3, 1, 5, 2) |
|---|
| 726 | ! (3, 5, 2, 1, 4) |
|---|
| 727 | amp(15,h,1) = + bk15_1_1(nt) + bk15_1_2(nt) + bk15_1_3(nt) + bk15_1_4(nt) + bk15_1_5(nt) & |
|---|
| 728 | + bk15_1_6(nt) + bk15_1_7(nt) + bk15_1_8(nt) |
|---|
| 729 | ! amp(15,h,1) = amp(15,h,1) ! 3 vertices, 2 propagators |
|---|
| 730 | flv_hel_flag(h,1) = flv_hel_flag(h,1) .or. amp(15,h,1) /= 0 |
|---|
| 731 | amp(15,h,1) = amp(15,h,1) / sqrt(6.0_omega_prec) ! symmetry factor |
|---|
| 732 | ! Number of external adjoints: 5 |
|---|
| 733 | ! flavor: [21, 21, 21, 21, 21] color: (4, 3, 5, 2, 1) |
|---|
| 734 | ! (5, 4, 2, 1, 3) |
|---|
| 735 | amp(16,h,1) = + bk16_1_1(nt) + bk16_1_2(nt) + bk16_1_3(nt) + bk16_1_4(nt) + bk16_1_5(nt) & |
|---|
| 736 | + bk16_1_6(nt) + bk16_1_7(nt) + bk16_1_8(nt) |
|---|
| 737 | ! amp(16,h,1) = amp(16,h,1) ! 3 vertices, 2 propagators |
|---|
| 738 | flv_hel_flag(h,1) = flv_hel_flag(h,1) .or. amp(16,h,1) /= 0 |
|---|
| 739 | amp(16,h,1) = amp(16,h,1) / sqrt(6.0_omega_prec) ! symmetry factor |
|---|
| 740 | ! Number of external adjoints: 5 |
|---|
| 741 | ! flavor: [21, 21, 21, 21, 21] color: (4, 5, 1, 2, 3) |
|---|
| 742 | ! (3, 4, 5, 1, 2) |
|---|
| 743 | amp(17,h,1) = + bk17_1_1(nt) + bk17_1_2(nt) + bk17_1_3(nt) + bk17_1_4(nt) + bk17_1_5(nt) & |
|---|
| 744 | + bk17_1_6(nt) + bk17_1_7(nt) + bk17_1_8(nt) |
|---|
| 745 | ! amp(17,h,1) = amp(17,h,1) ! 3 vertices, 2 propagators |
|---|
| 746 | flv_hel_flag(h,1) = flv_hel_flag(h,1) .or. amp(17,h,1) /= 0 |
|---|
| 747 | amp(17,h,1) = amp(17,h,1) / sqrt(6.0_omega_prec) ! symmetry factor |
|---|
| 748 | ! Number of external adjoints: 5 |
|---|
| 749 | ! flavor: [21, 21, 21, 21, 21] color: (4, 5, 2, 3, 1) |
|---|
| 750 | ! (5, 3, 4, 1, 2) |
|---|
| 751 | amp(18,h,1) = + bk18_1_1(nt) + bk18_1_2(nt) + bk18_1_3(nt) + bk18_1_4(nt) + bk18_1_5(nt) & |
|---|
| 752 | + bk18_1_6(nt) + bk18_1_7(nt) + bk18_1_8(nt) |
|---|
| 753 | ! amp(18,h,1) = amp(18,h,1) ! 3 vertices, 2 propagators |
|---|
| 754 | flv_hel_flag(h,1) = flv_hel_flag(h,1) .or. amp(18,h,1) /= 0 |
|---|
| 755 | amp(18,h,1) = amp(18,h,1) / sqrt(6.0_omega_prec) ! symmetry factor |
|---|
| 756 | ! Number of external adjoints: 5 |
|---|
| 757 | ! flavor: [21, 21, 21, 21, 21] color: (5, 1, 2, 3, 4) |
|---|
| 758 | ! (2, 3, 4, 5, 1) |
|---|
| 759 | amp(19,h,1) = + bk19_1_1(nt) + bk19_1_2(nt) + bk19_1_3(nt) + bk19_1_4(nt) + bk19_1_5(nt) & |
|---|
| 760 | + bk19_1_6(nt) + bk19_1_7(nt) + bk19_1_8(nt) |
|---|
| 761 | ! amp(19,h,1) = amp(19,h,1) ! 3 vertices, 2 propagators |
|---|
| 762 | flv_hel_flag(h,1) = flv_hel_flag(h,1) .or. amp(19,h,1) /= 0 |
|---|
| 763 | amp(19,h,1) = amp(19,h,1) / sqrt(6.0_omega_prec) ! symmetry factor |
|---|
| 764 | ! Number of external adjoints: 5 |
|---|
| 765 | ! flavor: [21, 21, 21, 21, 21] color: (5, 1, 4, 2, 3) |
|---|
| 766 | ! (2, 4, 5, 3, 1) |
|---|
| 767 | amp(20,h,1) = + bk20_1_1(nt) + bk20_1_2(nt) + bk20_1_3(nt) + bk20_1_4(nt) + bk20_1_5(nt) & |
|---|
| 768 | + bk20_1_6(nt) + bk20_1_7(nt) + bk20_1_8(nt) |
|---|
| 769 | ! amp(20,h,1) = amp(20,h,1) ! 3 vertices, 2 propagators |
|---|
| 770 | flv_hel_flag(h,1) = flv_hel_flag(h,1) .or. amp(20,h,1) /= 0 |
|---|
| 771 | amp(20,h,1) = amp(20,h,1) / sqrt(6.0_omega_prec) ! symmetry factor |
|---|
| 772 | ! Number of external adjoints: 5 |
|---|
| 773 | ! flavor: [21, 21, 21, 21, 21] color: (5, 3, 1, 2, 4) |
|---|
| 774 | ! (3, 4, 2, 5, 1) |
|---|
| 775 | amp(21,h,1) = + bk21_1_1(nt) + bk21_1_2(nt) + bk21_1_3(nt) + bk21_1_4(nt) + bk21_1_5(nt) & |
|---|
| 776 | + bk21_1_6(nt) + bk21_1_7(nt) + bk21_1_8(nt) |
|---|
| 777 | ! amp(21,h,1) = amp(21,h,1) ! 3 vertices, 2 propagators |
|---|
| 778 | flv_hel_flag(h,1) = flv_hel_flag(h,1) .or. amp(21,h,1) /= 0 |
|---|
| 779 | amp(21,h,1) = amp(21,h,1) / sqrt(6.0_omega_prec) ! symmetry factor |
|---|
| 780 | ! Number of external adjoints: 5 |
|---|
| 781 | ! flavor: [21, 21, 21, 21, 21] color: (5, 3, 4, 1, 2) |
|---|
| 782 | ! (4, 5, 2, 3, 1) |
|---|
| 783 | amp(22,h,1) = + bk22_1_1(nt) + bk22_1_2(nt) + bk22_1_3(nt) + bk22_1_4(nt) + bk22_1_5(nt) & |
|---|
| 784 | + bk22_1_6(nt) + bk22_1_7(nt) + bk22_1_8(nt) |
|---|
| 785 | ! amp(22,h,1) = amp(22,h,1) ! 3 vertices, 2 propagators |
|---|
| 786 | flv_hel_flag(h,1) = flv_hel_flag(h,1) .or. amp(22,h,1) /= 0 |
|---|
| 787 | amp(22,h,1) = amp(22,h,1) / sqrt(6.0_omega_prec) ! symmetry factor |
|---|
| 788 | ! Number of external adjoints: 5 |
|---|
| 789 | ! flavor: [21, 21, 21, 21, 21] color: (5, 4, 1, 3, 2) |
|---|
| 790 | ! (3, 5, 4, 2, 1) |
|---|
| 791 | amp(23,h,1) = + bk23_1_1(nt) + bk23_1_2(nt) + bk23_1_3(nt) + bk23_1_4(nt) + bk23_1_5(nt) & |
|---|
| 792 | + bk23_1_6(nt) + bk23_1_7(nt) + bk23_1_8(nt) |
|---|
| 793 | ! amp(23,h,1) = amp(23,h,1) ! 3 vertices, 2 propagators |
|---|
| 794 | flv_hel_flag(h,1) = flv_hel_flag(h,1) .or. amp(23,h,1) /= 0 |
|---|
| 795 | amp(23,h,1) = amp(23,h,1) / sqrt(6.0_omega_prec) ! symmetry factor |
|---|
| 796 | ! Number of external adjoints: 5 |
|---|
| 797 | ! flavor: [21, 21, 21, 21, 21] color: (5, 4, 2, 1, 3) |
|---|
| 798 | ! (4, 3, 5, 2, 1) |
|---|
| 799 | amp(24,h,1) = + bk24_1_1(nt) + bk24_1_2(nt) + bk24_1_3(nt) + bk24_1_4(nt) + bk24_1_5(nt) & |
|---|
| 800 | + bk24_1_6(nt) + bk24_1_7(nt) + bk24_1_8(nt) |
|---|
| 801 | ! amp(24,h,1) = amp(24,h,1) ! 3 vertices, 2 propagators |
|---|
| 802 | flv_hel_flag(h,1) = flv_hel_flag(h,1) .or. amp(24,h,1) /= 0 |
|---|
| 803 | amp(24,h,1) = amp(24,h,1) / sqrt(6.0_omega_prec) ! symmetry factor |
|---|
| 804 | ! Number of external adjoints: 5 |
|---|
| 805 | if (n <= SAMPLE) then |
|---|
| 806 | if (all (abs(amp(:,h,:)) <= tiny(1._omega_prec))) zero_ct(hi,1,ho, & |
|---|
| 807 | 1) = zero_ct(hi,1,ho,1) + 1 |
|---|
| 808 | end if |
|---|
| 809 | end do |
|---|
| 810 | !$OMP END DO |
|---|
| 811 | !$OMP END PARALLEL |
|---|
| 812 | end subroutine calculate_amplitudes |
|---|
| 813 | |
|---|
| 814 | function flv (fin, fout) |
|---|
| 815 | integer, intent(in) :: fin, fout |
|---|
| 816 | integer :: flv |
|---|
| 817 | flv = 0 |
|---|
| 818 | select case (fin) |
|---|
| 819 | case (1) |
|---|
| 820 | select case (fout) |
|---|
| 821 | case (1); flv = 1 ! (/ 21, 21, 21, 21, 21 /) |
|---|
| 822 | end select |
|---|
| 823 | end select |
|---|
| 824 | end function flv |
|---|
| 825 | |
|---|
| 826 | function flv_pdf (fin) |
|---|
| 827 | integer, intent(in) :: fin |
|---|
| 828 | integer, dimension(2) :: flv_pdf |
|---|
| 829 | flv_pdf = 0 |
|---|
| 830 | select case (fin) |
|---|
| 831 | case (1) |
|---|
| 832 | flv_pdf = (/ 21, 21 /) |
|---|
| 833 | end select |
|---|
| 834 | end function flv_pdf |
|---|
| 835 | |
|---|
| 836 | subroutine scatter_diagonal_nonzero (p, rho_in, rho_out, zero_ct, n) |
|---|
| 837 | real(kind=omega_prec), dimension(0:,:), intent(in) :: p |
|---|
| 838 | real(kind=omega_prec), dimension(:,:), intent(in) :: rho_in |
|---|
| 839 | real(kind=omega_prec), dimension(:,:), intent(inout) :: rho_out |
|---|
| 840 | integer, dimension(:,:,:,:), intent(inout) :: zero_ct |
|---|
| 841 | integer, intent(in) :: n |
|---|
| 842 | integer :: fi, fo, f, hi, ho, h, c |
|---|
| 843 | complex(kind=omega_prec), dimension(n_cflow,n_hel,n_flv) :: amp |
|---|
| 844 | complex(kind=omega_prec), dimension(n_cflow) :: amp1, amp2 |
|---|
| 845 | call calculate_amplitudes (amp, p, zero_ct, n) |
|---|
| 846 | rho_out = 0 |
|---|
| 847 | h = 0 |
|---|
| 848 | do hi = 1, n_hel_in |
|---|
| 849 | do ho = 1, n_hel_out |
|---|
| 850 | h = h + 1 |
|---|
| 851 | do fi = 1, n_flv_in |
|---|
| 852 | do fo = 1, n_flv_out |
|---|
| 853 | f = flv (fi, fo); if (f == 0) cycle |
|---|
| 854 | if (.not. flv_hel_flag(h,f)) cycle |
|---|
| 855 | amp1 = 0 |
|---|
| 856 | forall (c = 1:n_cflow, flv_col_flag(c,f)) |
|---|
| 857 | amp1(c) = sum (amp(:,h,f) * flow_coeff(:,c), flow_flag(:,c) .and. & |
|---|
| 858 | flv_col_flag(:,f)) |
|---|
| 859 | end forall |
|---|
| 860 | amp2 = amp(:,h,f) |
|---|
| 861 | rho_out(ho,fo) = rho_out(ho,fo) + dot_product (amp1, amp2) * rho_in( & |
|---|
| 862 | hi,fi) |
|---|
| 863 | end do |
|---|
| 864 | end do |
|---|
| 865 | end do |
|---|
| 866 | end do |
|---|
| 867 | end subroutine scatter_diagonal_nonzero |
|---|
| 868 | |
|---|
| 869 | subroutine scatter_nonzero (p, rho_in, rho_out, zero_ct, n) |
|---|
| 870 | real(kind=omega_prec), dimension(0:,:), intent(in) :: p |
|---|
| 871 | complex(kind=omega_prec), dimension(:,:,:,:), intent(in) :: rho_in |
|---|
| 872 | complex(kind=omega_prec), dimension(:,:,:,:), intent(inout) :: rho_out |
|---|
| 873 | integer, dimension(:,:,:,:), intent(inout) :: zero_ct |
|---|
| 874 | integer, intent(in) :: n |
|---|
| 875 | integer :: fi, fo, f, hi1, hi2, ho1, ho2, h1, h2, c |
|---|
| 876 | complex(kind=omega_prec), dimension(n_cflow,n_hel,n_flv) :: amp |
|---|
| 877 | complex(kind=omega_prec), dimension(n_cflow) :: amp1, amp2 |
|---|
| 878 | call calculate_amplitudes (amp, p, zero_ct, n) |
|---|
| 879 | rho_out = 0 |
|---|
| 880 | h1 = 0 |
|---|
| 881 | do hi1 = 1, n_hel_in |
|---|
| 882 | do ho1 = 1, n_hel_out |
|---|
| 883 | h1 = h1 + 1 |
|---|
| 884 | do hi2 = 1, n_hel_in |
|---|
| 885 | do ho2 = 1, n_hel_out |
|---|
| 886 | h2 = h2 + 1 |
|---|
| 887 | do fi = 1, n_flv_in |
|---|
| 888 | do fo = 1, n_flv_out |
|---|
| 889 | f = flv (fi, fo); if (f == 0) cycle |
|---|
| 890 | if (.not. (flv_hel_flag(h1,f) .and. flv_hel_flag(h2,f))) cycle |
|---|
| 891 | amp1 = 0 |
|---|
| 892 | forall (c = 1:n_cflow, flv_col_flag(c,f)) |
|---|
| 893 | amp1(c) = sum (amp(:,h1,f) * flow_coeff(:,c), flow_flag(:,c) & |
|---|
| 894 | .and. flv_col_flag(:,f)) |
|---|
| 895 | end forall |
|---|
| 896 | amp2 = amp(:,h2,f) |
|---|
| 897 | rho_out(ho1,fo,ho2,fo) = rho_out(ho1,fo,ho2,fo) + dot_product ( & |
|---|
| 898 | amp1, amp2) * rho_in(hi1,fi,hi2,fi) |
|---|
| 899 | end do |
|---|
| 900 | end do |
|---|
| 901 | end do |
|---|
| 902 | end do |
|---|
| 903 | end do |
|---|
| 904 | end do |
|---|
| 905 | end subroutine scatter_nonzero |
|---|
| 906 | |
|---|
| 907 | subroutine scatter_diagonal_colored_nz (p, rho_in, rho_out, zero_ct, n) |
|---|
| 908 | real(kind=omega_prec), dimension(0:,:), intent(in) :: p |
|---|
| 909 | real(kind=omega_prec), dimension(:,:), intent(in) :: rho_in |
|---|
| 910 | real(kind=omega_prec), dimension(:,:,:), intent(inout) :: rho_out |
|---|
| 911 | integer, dimension(:,:,:,:), intent(inout) :: zero_ct |
|---|
| 912 | integer, intent(in) :: n |
|---|
| 913 | integer :: fi, fo, f, hi, ho, h, c |
|---|
| 914 | complex(kind=omega_prec), dimension(n_cflow,n_hel,n_flv) :: amp |
|---|
| 915 | real(kind=omega_prec), dimension(n_cflow) :: pcol |
|---|
| 916 | real(kind=omega_prec) :: sqme, sum_pcol |
|---|
| 917 | complex(kind=omega_prec), dimension(n_cflow) :: amp1, amp2 |
|---|
| 918 | call calculate_amplitudes (amp, p, zero_ct, n) |
|---|
| 919 | rho_out = 0 |
|---|
| 920 | pcol = 0 |
|---|
| 921 | h = 0 |
|---|
| 922 | do hi = 1, n_hel_in |
|---|
| 923 | do ho = 1, n_hel_out |
|---|
| 924 | h = h + 1 |
|---|
| 925 | do fi = 1, n_flv_in |
|---|
| 926 | do fo = 1, n_flv_out |
|---|
| 927 | f = flv (fi, fo); if (f == 0) cycle |
|---|
| 928 | if (.not. flv_hel_flag(h,f)) cycle |
|---|
| 929 | amp1 = 0 |
|---|
| 930 | forall (c = 1:n_cflow, flv_col_flag(c,f)) |
|---|
| 931 | amp1(c) = sum (amp(:,h,f) * flow_coeff(:,c), flow_flag(:,c) .and. & |
|---|
| 932 | flv_col_flag(:,f)) |
|---|
| 933 | end forall |
|---|
| 934 | amp2 = amp(:,h,f) |
|---|
| 935 | sqme = dot_product (amp1, amp2) * rho_in(hi,fi) |
|---|
| 936 | where (flow_is_physical) |
|---|
| 937 | pcol(:) = abs (amp(:,h,f))**2 |
|---|
| 938 | end where |
|---|
| 939 | sum_pcol = sum (pcol) |
|---|
| 940 | if (sum_pcol /= 0) then |
|---|
| 941 | rho_out(:,ho,fo) = rho_out(:,ho,fo) + sqme * pcol(:) / sum_pcol |
|---|
| 942 | end if |
|---|
| 943 | end do |
|---|
| 944 | end do |
|---|
| 945 | end do |
|---|
| 946 | end do |
|---|
| 947 | end subroutine scatter_diagonal_colored_nz |
|---|
| 948 | |
|---|
| 949 | subroutine scatter_colored_nonzero (p, rho_in, rho_out, rho_col_out, zero_ct, & |
|---|
| 950 | n) |
|---|
| 951 | real(kind=omega_prec), dimension(0:,:), intent(in) :: p |
|---|
| 952 | complex(kind=omega_prec), dimension(:,:,:,:), intent(in) :: rho_in |
|---|
| 953 | complex(kind=omega_prec), dimension(:,:,:,:), intent(inout) :: rho_out |
|---|
| 954 | complex(kind=omega_prec), dimension(:,:,:,:,:), intent(inout) :: rho_col_out |
|---|
| 955 | integer, dimension(:,:,:,:), intent(inout) :: zero_ct |
|---|
| 956 | integer, intent(in) :: n |
|---|
| 957 | integer :: fi, fo, f, hi1, hi2, ho1, ho2, h1, h2, c |
|---|
| 958 | complex(kind=omega_prec), dimension(n_cflow,n_hel,n_flv) :: amp |
|---|
| 959 | complex(kind=omega_prec), dimension(n_cflow) :: amp1, amp2 |
|---|
| 960 | call calculate_amplitudes (amp, p, zero_ct, n) |
|---|
| 961 | rho_out = 0 |
|---|
| 962 | rho_col_out = 0 |
|---|
| 963 | h1 = 0 |
|---|
| 964 | do hi1 = 1, n_hel_in |
|---|
| 965 | do ho1 = 1, n_hel_out |
|---|
| 966 | h1 = h1 + 1 |
|---|
| 967 | do hi2 = 1, n_hel_in |
|---|
| 968 | do ho2 = 1, n_hel_out |
|---|
| 969 | h2 = h2 + 1 |
|---|
| 970 | do fi = 1, n_flv_in |
|---|
| 971 | do fo = 1, n_flv_out |
|---|
| 972 | f = flv (fi, fo); if (f == 0) cycle |
|---|
| 973 | if (.not. (flv_hel_flag(h1,f) .and. flv_hel_flag(h2,f))) cycle |
|---|
| 974 | amp1 = 0 |
|---|
| 975 | forall (c = 1:n_cflow, flv_col_flag(c,f)) |
|---|
| 976 | amp1(c) = sum (amp(:,h1,f) * flow_coeff(:,c), flow_flag(:,c) & |
|---|
| 977 | .and. flv_col_flag(:,f)) |
|---|
| 978 | end forall |
|---|
| 979 | amp2 = amp(:,h2,f) |
|---|
| 980 | rho_out(ho1,fo,ho2,fo) = rho_out(ho1,fo,ho2,fo) + dot_product ( & |
|---|
| 981 | amp1, amp2) * rho_in(hi1,fi,hi2,fi) |
|---|
| 982 | where (flow_is_physical) |
|---|
| 983 | rho_col_out(:,ho1,fo,ho2,fo) = rho_col_out(:,ho1,fo,ho2,fo) & |
|---|
| 984 | + amp(:,h1,f) * conjg (amp2(:)) * rho_in(hi1,fi,hi2,fi) |
|---|
| 985 | end where |
|---|
| 986 | end do |
|---|
| 987 | end do |
|---|
| 988 | end do |
|---|
| 989 | end do |
|---|
| 990 | end do |
|---|
| 991 | end do |
|---|
| 992 | end subroutine scatter_colored_nonzero |
|---|
| 993 | |
|---|
| 994 | end module test |
|---|
| 995 | ! O'Mega revision control information: |
|---|
| 996 | ! Colorize.Gauge(Models.SM): |
|---|
| 997 | ! Gauged Colorization Functor ( minimal electroweak standard model in unitarity gauge ) |
|---|
| 998 | ! URL: /home/sources/ohl/ml/omega/src/models.ml,v |
|---|
| 999 | ! revision: 326 checked in by reuter at 2008-08-17 06:49:19 +0200 (Sun, 17 Aug 2008) |
|---|
| 1000 | ! Targets.Make_Fortran(): |
|---|
| 1001 | ! NB: non-gauge vector couplings are not available yet |
|---|
| 1002 | ! URL: /home/sources/ohl/ml/omega/src/targets.ml,v |
|---|
| 1003 | ! revision: 326 checked in by reuter at 2008-08-17 06:49:19 +0200 (Sun, 17 Aug 2008) |
|---|
| 1004 | ! Targets.Fortran_Fermions(): |
|---|
| 1005 | ! generates Fortran95 code for Dirac fermions |
|---|
| 1006 | ! using revision 2000_10_A of module omega95 |
|---|
| 1007 | ! URL: /home/sources/ohl/ml/omega/src/targets.ml,v |
|---|
| 1008 | ! revision: 326 checked in by reuter at 2008-08-17 06:49:19 +0200 (Sun, 17 Aug 2008) |
|---|
| 1009 | ! DAG.Graded(): |
|---|
| 1010 | ! Graded directed Acyclical Graph |
|---|
| 1011 | ! representing binary or n-ary trees |
|---|
| 1012 | ! URL: svn+ssh://jr_reuter@svn.hepforge.org/hepforge/home/whizard/event-generators/whizard/branches/1.xx/omega-src/bundle/src/dAG.ml |
|---|
| 1013 | ! revision: 68 checked in by ohl at 2007-11-22 12:11:19 +0100 (Thu, 22 Nov 2007) |
|---|
| 1014 | ! Topology.Mixed23: |
|---|
| 1015 | ! phi**3 + phi**4 topology |
|---|
| 1016 | ! URL: svn+ssh://jr_reuter@svn.hepforge.org/hepforge/home/whizard/event-generators/whizard/branches/1.xx/omega-src/bundle/src/topology.ml |
|---|
| 1017 | ! revision: 68 checked in by ohl at 2007-11-22 12:11:19 +0100 (Thu, 22 Nov 2007) |
|---|
| 1018 | ! Momentum.Bits(): |
|---|
| 1019 | ! Finite disjoint sums of momenta |
|---|
| 1020 | ! using bitfields as representation. |
|---|
| 1021 | ! URL: svn+ssh://jr_reuter@svn.hepforge.org/hepforge/home/whizard/event-generators/whizard/branches/1.xx/omega-src/bundle/src/momentum.ml |
|---|
| 1022 | ! revision: 68 checked in by ohl at 2007-11-22 12:11:19 +0100 (Thu, 22 Nov 2007) |
|---|
| 1023 | ! Fusion.Make(): |
|---|
| 1024 | ! Fusions for arbitrary topologies |
|---|
| 1025 | ! URL: svn+ssh://jr_reuter@svn.hepforge.org/hepforge/home/whizard/event-generators/whizard/branches/1.xx/omega-src/bundle/src/fusion.ml |
|---|
| 1026 | ! revision: 326 checked in by reuter at 2008-08-17 06:49:19 +0200 (Sun, 17 Aug 2008) |
|---|
Download in other formats:
|
